src/HOL/Transcendental.thy
author wenzelm
Sun Sep 18 20:33:48 2016 +0200 (2016-09-18)
changeset 63915 bab633745c7f
parent 63834 6a757f36997e
child 63918 6bf55e6e0b75
permissions -rw-r--r--
tuned proofs;
     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 Binomial 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_setprod)
    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 setsum.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 setsum_mono3) auto
   201   also have "\<dots> = (2*n) choose n" by (rule choose_square_sum)
   202   also have "(\<Sum>k\<in>{0<..<2*n}. (2*n) choose k) \<le> (\<Sum>k\<in>{0<..<2*n}. (2*n) choose n)"
   203     by (intro setsum_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 (setsum 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)) = setsum 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 setsum_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 setsum_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 setsum_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: "setsum f {..<n} - of_nat n * r = (\<Sum>i<n. f i - r)"
   618   for r :: "'a::ring_1"
   619   by (simp add: setsum_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_setsum_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_setsum h right_diff_distrib [symmetric] mult.assoc
   638       del: power_Suc setsum_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 setsum_right_distrib)
   643   apply (rule setsum.cong [OF refl])
   644   apply (simp add: less_iff_Suc_add)
   645   apply clarify
   646   apply (simp add: setsum_right_distrib diff_power_eq_setsum ac_simps
   647       del: setsum_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_setsum_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 "setsum f {..<n-k} \<le> of_nat n * K"
   657   apply (rule order_trans [OF setsum_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_setsum]
   687           real_setsum_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 setsum_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 setsum_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_setsum 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 setsum_abs)
  1218           also have "\<dots> \<le> (\<Sum>p<Suc n. R' ^ n)"
  1219           proof (rule setsum_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 setsum_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: setsum_right_distrib 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 setsum_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: setsum.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.setsum)
  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: setsum_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 corollary exp_in_Reals [simp]: "z \<in> \<real> \<Longrightarrow> exp z \<in> \<real>"
  1497   by (metis Reals_cases Reals_of_real exp_of_real)
  1498 
  1499 lemma exp_not_eq_zero [simp]: "exp x \<noteq> 0"
  1500 proof
  1501   have "exp x * exp (- x) = 1"
  1502     by (simp add: exp_add_commuting[symmetric])
  1503   also assume "exp x = 0"
  1504   finally show False by simp
  1505 qed
  1506 
  1507 lemma exp_minus_inverse: "exp x * exp (- x) = 1"
  1508   by (simp add: exp_add_commuting[symmetric])
  1509 
  1510 lemma exp_minus: "exp (- x) = inverse (exp x)"
  1511   for x :: "'a::{real_normed_field,banach}"
  1512   by (intro inverse_unique [symmetric] exp_minus_inverse)
  1513 
  1514 lemma exp_diff: "exp (x - y) = exp x / exp y"
  1515   for x :: "'a::{real_normed_field,banach}"
  1516   using exp_add [of x "- y"] by (simp add: exp_minus divide_inverse)
  1517 
  1518 lemma exp_of_nat_mult: "exp (of_nat n * x) = exp x ^ n"
  1519   for x :: "'a::{real_normed_field,banach}"
  1520   by (induct n) (auto simp add: distrib_left exp_add mult.commute)
  1521 
  1522 corollary exp_real_of_nat_mult: "exp (real n * x) = exp x ^ n"
  1523   by (simp add: exp_of_nat_mult)
  1524 
  1525 lemma exp_setsum: "finite I \<Longrightarrow> exp (setsum f I) = setprod (\<lambda>x. exp (f x)) I"
  1526   by (induct I rule: finite_induct) (auto simp: exp_add_commuting mult.commute)
  1527 
  1528 lemma exp_divide_power_eq:
  1529   fixes x :: "'a::{real_normed_field,banach}"
  1530   assumes "n > 0"
  1531   shows "exp (x / of_nat n) ^ n = exp x"
  1532   using assms
  1533 proof (induction n arbitrary: x)
  1534   case 0
  1535   then show ?case by simp
  1536 next
  1537   case (Suc n)
  1538   show ?case
  1539   proof (cases "n = 0")
  1540     case True
  1541     then show ?thesis by simp
  1542   next
  1543     case False
  1544     then have [simp]: "x * of_nat n / (1 + of_nat n) / of_nat n = x / (1 + of_nat n)"
  1545       by simp
  1546     have [simp]: "x / (1 + of_nat n) + x * of_nat n / (1 + of_nat n) = x"
  1547       apply (simp add: divide_simps)
  1548       using of_nat_eq_0_iff apply (fastforce simp: distrib_left)
  1549       done
  1550     show ?thesis
  1551       using Suc.IH [of "x * of_nat n / (1 + of_nat n)"] False
  1552       by (simp add: exp_add [symmetric])
  1553   qed
  1554 qed
  1555 
  1556 
  1557 subsubsection \<open>Properties of the Exponential Function on Reals\<close>
  1558 
  1559 text \<open>Comparisons of @{term "exp x"} with zero.\<close>
  1560 
  1561 text \<open>Proof: because every exponential can be seen as a square.\<close>
  1562 lemma exp_ge_zero [simp]: "0 \<le> exp x"
  1563   for x :: real
  1564 proof -
  1565   have "0 \<le> exp (x/2) * exp (x/2)"
  1566     by simp
  1567   then show ?thesis
  1568     by (simp add: exp_add [symmetric])
  1569 qed
  1570 
  1571 lemma exp_gt_zero [simp]: "0 < exp x"
  1572   for x :: real
  1573   by (simp add: order_less_le)
  1574 
  1575 lemma not_exp_less_zero [simp]: "\<not> exp x < 0"
  1576   for x :: real
  1577   by (simp add: not_less)
  1578 
  1579 lemma not_exp_le_zero [simp]: "\<not> exp x \<le> 0"
  1580   for x :: real
  1581   by (simp add: not_le)
  1582 
  1583 lemma abs_exp_cancel [simp]: "\<bar>exp x\<bar> = exp x"
  1584   for x :: real
  1585   by simp
  1586 
  1587 text \<open>Strict monotonicity of exponential.\<close>
  1588 
  1589 lemma exp_ge_add_one_self_aux:
  1590   fixes x :: real
  1591   assumes "0 \<le> x"
  1592   shows "1 + x \<le> exp x"
  1593   using order_le_imp_less_or_eq [OF assms]
  1594 proof
  1595   assume "0 < x"
  1596   have "1 + x \<le> (\<Sum>n<2. inverse (fact n) * x^n)"
  1597     by (auto simp add: numeral_2_eq_2)
  1598   also have "\<dots> \<le> (\<Sum>n. inverse (fact n) * x^n)"
  1599     apply (rule setsum_le_suminf [OF summable_exp])
  1600     using \<open>0 < x\<close>
  1601     apply (auto  simp add:  zero_le_mult_iff)
  1602     done
  1603   finally show "1 + x \<le> exp x"
  1604     by (simp add: exp_def)
  1605 next
  1606   assume "0 = x"
  1607   then show "1 + x \<le> exp x"
  1608     by auto
  1609 qed
  1610 
  1611 lemma exp_gt_one: "0 < x \<Longrightarrow> 1 < exp x"
  1612   for x :: real
  1613 proof -
  1614   assume x: "0 < x"
  1615   then have "1 < 1 + x" by simp
  1616   also from x have "1 + x \<le> exp x"
  1617     by (simp add: exp_ge_add_one_self_aux)
  1618   finally show ?thesis .
  1619 qed
  1620 
  1621 lemma exp_less_mono:
  1622   fixes x y :: real
  1623   assumes "x < y"
  1624   shows "exp x < exp y"
  1625 proof -
  1626   from \<open>x < y\<close> have "0 < y - x" by simp
  1627   then have "1 < exp (y - x)" by (rule exp_gt_one)
  1628   then have "1 < exp y / exp x" by (simp only: exp_diff)
  1629   then show "exp x < exp y" by simp
  1630 qed
  1631 
  1632 lemma exp_less_cancel: "exp x < exp y \<Longrightarrow> x < y"
  1633   for x y :: real
  1634   unfolding linorder_not_le [symmetric]
  1635   by (auto simp add: order_le_less exp_less_mono)
  1636 
  1637 lemma exp_less_cancel_iff [iff]: "exp x < exp y \<longleftrightarrow> x < y"
  1638   for x y :: real
  1639   by (auto intro: exp_less_mono exp_less_cancel)
  1640 
  1641 lemma exp_le_cancel_iff [iff]: "exp x \<le> exp y \<longleftrightarrow> x \<le> y"
  1642   for x y :: real
  1643   by (auto simp add: linorder_not_less [symmetric])
  1644 
  1645 lemma exp_inj_iff [iff]: "exp x = exp y \<longleftrightarrow> x = y"
  1646   for x y :: real
  1647   by (simp add: order_eq_iff)
  1648 
  1649 text \<open>Comparisons of @{term "exp x"} with one.\<close>
  1650 
  1651 lemma one_less_exp_iff [simp]: "1 < exp x \<longleftrightarrow> 0 < x"
  1652   for x :: real
  1653   using exp_less_cancel_iff [where x = 0 and y = x] by simp
  1654 
  1655 lemma exp_less_one_iff [simp]: "exp x < 1 \<longleftrightarrow> x < 0"
  1656   for x :: real
  1657   using exp_less_cancel_iff [where x = x and y = 0] by simp
  1658 
  1659 lemma one_le_exp_iff [simp]: "1 \<le> exp x \<longleftrightarrow> 0 \<le> x"
  1660   for x :: real
  1661   using exp_le_cancel_iff [where x = 0 and y = x] by simp
  1662 
  1663 lemma exp_le_one_iff [simp]: "exp x \<le> 1 \<longleftrightarrow> x \<le> 0"
  1664   for x :: real
  1665   using exp_le_cancel_iff [where x = x and y = 0] by simp
  1666 
  1667 lemma exp_eq_one_iff [simp]: "exp x = 1 \<longleftrightarrow> x = 0"
  1668   for x :: real
  1669   using exp_inj_iff [where x = x and y = 0] by simp
  1670 
  1671 lemma lemma_exp_total: "1 \<le> y \<Longrightarrow> \<exists>x. 0 \<le> x \<and> x \<le> y - 1 \<and> exp x = y"
  1672   for y :: real
  1673 proof (rule IVT)
  1674   assume "1 \<le> y"
  1675   then have "0 \<le> y - 1" by simp
  1676   then have "1 + (y - 1) \<le> exp (y - 1)"
  1677     by (rule exp_ge_add_one_self_aux)
  1678   then show "y \<le> exp (y - 1)" by simp
  1679 qed (simp_all add: le_diff_eq)
  1680 
  1681 lemma exp_total: "0 < y \<Longrightarrow> \<exists>x. exp x = y"
  1682   for y :: real
  1683 proof (rule linorder_le_cases [of 1 y])
  1684   assume "1 \<le> y"
  1685   then show "\<exists>x. exp x = y"
  1686     by (fast dest: lemma_exp_total)
  1687 next
  1688   assume "0 < y" and "y \<le> 1"
  1689   then have "1 \<le> inverse y"
  1690     by (simp add: one_le_inverse_iff)
  1691   then obtain x where "exp x = inverse y"
  1692     by (fast dest: lemma_exp_total)
  1693   then have "exp (- x) = y"
  1694     by (simp add: exp_minus)
  1695   then show "\<exists>x. exp x = y" ..
  1696 qed
  1697 
  1698 
  1699 subsection \<open>Natural Logarithm\<close>
  1700 
  1701 class ln = real_normed_algebra_1 + banach +
  1702   fixes ln :: "'a \<Rightarrow> 'a"
  1703   assumes ln_one [simp]: "ln 1 = 0"
  1704 
  1705 definition powr :: "'a \<Rightarrow> 'a \<Rightarrow> 'a::ln"  (infixr "powr" 80)
  1706   \<comment> \<open>exponentation via ln and exp\<close>
  1707   where  [code del]: "x powr a \<equiv> if x = 0 then 0 else exp (a * ln x)"
  1708 
  1709 lemma powr_0 [simp]: "0 powr z = 0"
  1710   by (simp add: powr_def)
  1711 
  1712 
  1713 instantiation real :: ln
  1714 begin
  1715 
  1716 definition ln_real :: "real \<Rightarrow> real"
  1717   where "ln_real x = (THE u. exp u = x)"
  1718 
  1719 instance
  1720   by intro_classes (simp add: ln_real_def)
  1721 
  1722 end
  1723 
  1724 lemma powr_eq_0_iff [simp]: "w powr z = 0 \<longleftrightarrow> w = 0"
  1725   by (simp add: powr_def)
  1726 
  1727 lemma ln_exp [simp]: "ln (exp x) = x"
  1728   for x :: real
  1729   by (simp add: ln_real_def)
  1730 
  1731 lemma exp_ln [simp]: "0 < x \<Longrightarrow> exp (ln x) = x"
  1732   for x :: real
  1733   by (auto dest: exp_total)
  1734 
  1735 lemma exp_ln_iff [simp]: "exp (ln x) = x \<longleftrightarrow> 0 < x"
  1736   for x :: real
  1737   by (metis exp_gt_zero exp_ln)
  1738 
  1739 lemma ln_unique: "exp y = x \<Longrightarrow> ln x = y"
  1740   for x :: real
  1741   by (erule subst) (rule ln_exp)
  1742 
  1743 lemma ln_mult: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> ln (x * y) = ln x + ln y"
  1744   for x :: real
  1745   by (rule ln_unique) (simp add: exp_add)
  1746 
  1747 lemma ln_setprod: "finite I \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> f i > 0) \<Longrightarrow> ln (setprod f I) = setsum (\<lambda>x. ln(f x)) I"
  1748   for f :: "'a \<Rightarrow> real"
  1749   by (induct I rule: finite_induct) (auto simp: ln_mult setprod_pos)
  1750 
  1751 lemma ln_inverse: "0 < x \<Longrightarrow> ln (inverse x) = - ln x"
  1752   for x :: real
  1753   by (rule ln_unique) (simp add: exp_minus)
  1754 
  1755 lemma ln_div: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> ln (x / y) = ln x - ln y"
  1756   for x :: real
  1757   by (rule ln_unique) (simp add: exp_diff)
  1758 
  1759 lemma ln_realpow: "0 < x \<Longrightarrow> ln (x^n) = real n * ln x"
  1760   by (rule ln_unique) (simp add: exp_real_of_nat_mult)
  1761 
  1762 lemma ln_less_cancel_iff [simp]: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> ln x < ln y \<longleftrightarrow> x < y"
  1763   for x :: real
  1764   by (subst exp_less_cancel_iff [symmetric]) simp
  1765 
  1766 lemma ln_le_cancel_iff [simp]: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> ln x \<le> ln y \<longleftrightarrow> x \<le> y"
  1767   for x :: real
  1768   by (simp add: linorder_not_less [symmetric])
  1769 
  1770 lemma ln_inj_iff [simp]: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> ln x = ln y \<longleftrightarrow> x = y"
  1771   for x :: real
  1772   by (simp add: order_eq_iff)
  1773 
  1774 lemma ln_add_one_self_le_self [simp]: "0 \<le> x \<Longrightarrow> ln (1 + x) \<le> x"
  1775   for x :: real
  1776   by (rule exp_le_cancel_iff [THEN iffD1]) (simp add: exp_ge_add_one_self_aux)
  1777 
  1778 lemma ln_less_self [simp]: "0 < x \<Longrightarrow> ln x < x"
  1779   for x :: real
  1780   by (rule order_less_le_trans [where y = "ln (1 + x)"]) simp_all
  1781 
  1782 lemma ln_ge_zero [simp]: "1 \<le> x \<Longrightarrow> 0 \<le> ln x"
  1783   for x :: real
  1784   using ln_le_cancel_iff [of 1 x] by simp
  1785 
  1786 lemma ln_ge_zero_imp_ge_one: "0 \<le> ln x \<Longrightarrow> 0 < x \<Longrightarrow> 1 \<le> x"
  1787   for x :: real
  1788   using ln_le_cancel_iff [of 1 x] by simp
  1789 
  1790 lemma ln_ge_zero_iff [simp]: "0 < x \<Longrightarrow> 0 \<le> ln x \<longleftrightarrow> 1 \<le> x"
  1791   for x :: real
  1792   using ln_le_cancel_iff [of 1 x] by simp
  1793 
  1794 lemma ln_less_zero_iff [simp]: "0 < x \<Longrightarrow> ln x < 0 \<longleftrightarrow> x < 1"
  1795   for x :: real
  1796   using ln_less_cancel_iff [of x 1] by simp
  1797 
  1798 lemma ln_gt_zero: "1 < x \<Longrightarrow> 0 < ln x"
  1799   for x :: real
  1800   using ln_less_cancel_iff [of 1 x] by simp
  1801 
  1802 lemma ln_gt_zero_imp_gt_one: "0 < ln x \<Longrightarrow> 0 < x \<Longrightarrow> 1 < x"
  1803   for x :: real
  1804   using ln_less_cancel_iff [of 1 x] by simp
  1805 
  1806 lemma ln_gt_zero_iff [simp]: "0 < x \<Longrightarrow> 0 < ln x \<longleftrightarrow> 1 < x"
  1807   for x :: real
  1808   using ln_less_cancel_iff [of 1 x] by simp
  1809 
  1810 lemma ln_eq_zero_iff [simp]: "0 < x \<Longrightarrow> ln x = 0 \<longleftrightarrow> x = 1"
  1811   for x :: real
  1812   using ln_inj_iff [of x 1] by simp
  1813 
  1814 lemma ln_less_zero: "0 < x \<Longrightarrow> x < 1 \<Longrightarrow> ln x < 0"
  1815   for x :: real
  1816   by simp
  1817 
  1818 lemma ln_neg_is_const: "x \<le> 0 \<Longrightarrow> ln x = (THE x. False)"
  1819   for x :: real
  1820   by (auto simp: ln_real_def intro!: arg_cong[where f = The])
  1821 
  1822 lemma isCont_ln:
  1823   fixes x :: real
  1824   assumes "x \<noteq> 0"
  1825   shows "isCont ln x"
  1826 proof (cases "0 < x")
  1827   case True
  1828   then have "isCont ln (exp (ln x))"
  1829     by (intro isCont_inv_fun[where d = "\<bar>x\<bar>" and f = exp]) auto
  1830   with True show ?thesis
  1831     by simp
  1832 next
  1833   case False
  1834   with \<open>x \<noteq> 0\<close> show "isCont ln x"
  1835     unfolding isCont_def
  1836     by (subst filterlim_cong[OF _ refl, of _ "nhds (ln 0)" _ "\<lambda>_. ln 0"])
  1837        (auto simp: ln_neg_is_const not_less eventually_at dist_real_def
  1838          intro!: exI[of _ "\<bar>x\<bar>"])
  1839 qed
  1840 
  1841 lemma tendsto_ln [tendsto_intros]: "(f \<longlongrightarrow> a) F \<Longrightarrow> a \<noteq> 0 \<Longrightarrow> ((\<lambda>x. ln (f x)) \<longlongrightarrow> ln a) F"
  1842   for a :: real
  1843   by (rule isCont_tendsto_compose [OF isCont_ln])
  1844 
  1845 lemma continuous_ln:
  1846   "continuous F f \<Longrightarrow> f (Lim F (\<lambda>x. x)) \<noteq> 0 \<Longrightarrow> continuous F (\<lambda>x. ln (f x :: real))"
  1847   unfolding continuous_def by (rule tendsto_ln)
  1848 
  1849 lemma isCont_ln' [continuous_intros]:
  1850   "continuous (at x) f \<Longrightarrow> f x \<noteq> 0 \<Longrightarrow> continuous (at x) (\<lambda>x. ln (f x :: real))"
  1851   unfolding continuous_at by (rule tendsto_ln)
  1852 
  1853 lemma continuous_within_ln [continuous_intros]:
  1854   "continuous (at x within s) f \<Longrightarrow> f x \<noteq> 0 \<Longrightarrow> continuous (at x within s) (\<lambda>x. ln (f x :: real))"
  1855   unfolding continuous_within by (rule tendsto_ln)
  1856 
  1857 lemma continuous_on_ln [continuous_intros]:
  1858   "continuous_on s f \<Longrightarrow> (\<forall>x\<in>s. f x \<noteq> 0) \<Longrightarrow> continuous_on s (\<lambda>x. ln (f x :: real))"
  1859   unfolding continuous_on_def by (auto intro: tendsto_ln)
  1860 
  1861 lemma DERIV_ln: "0 < x \<Longrightarrow> DERIV ln x :> inverse x"
  1862   for x :: real
  1863   by (rule DERIV_inverse_function [where f=exp and a=0 and b="x+1"])
  1864     (auto intro: DERIV_cong [OF DERIV_exp exp_ln] isCont_ln)
  1865 
  1866 lemma DERIV_ln_divide: "0 < x \<Longrightarrow> DERIV ln x :> 1 / x"
  1867   for x :: real
  1868   by (rule DERIV_ln[THEN DERIV_cong]) (simp_all add: divide_inverse)
  1869 
  1870 declare DERIV_ln_divide[THEN DERIV_chain2, derivative_intros]
  1871   and DERIV_ln_divide[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]
  1872 
  1873 lemma ln_series:
  1874   assumes "0 < x" and "x < 2"
  1875   shows "ln x = (\<Sum> n. (-1)^n * (1 / real (n + 1)) * (x - 1)^(Suc n))"
  1876     (is "ln x = suminf (?f (x - 1))")
  1877 proof -
  1878   let ?f' = "\<lambda>x n. (-1)^n * (x - 1)^n"
  1879 
  1880   have "ln x - suminf (?f (x - 1)) = ln 1 - suminf (?f (1 - 1))"
  1881   proof (rule DERIV_isconst3 [where x = x])
  1882     fix x :: real
  1883     assume "x \<in> {0 <..< 2}"
  1884     then have "0 < x" and "x < 2" by auto
  1885     have "norm (1 - x) < 1"
  1886       using \<open>0 < x\<close> and \<open>x < 2\<close> by auto
  1887     have "1 / x = 1 / (1 - (1 - x))" by auto
  1888     also have "\<dots> = (\<Sum> n. (1 - x)^n)"
  1889       using geometric_sums[OF \<open>norm (1 - x) < 1\<close>] by (rule sums_unique)
  1890     also have "\<dots> = suminf (?f' x)"
  1891       unfolding power_mult_distrib[symmetric]
  1892       by (rule arg_cong[where f=suminf], rule arg_cong[where f="op ^"], auto)
  1893     finally have "DERIV ln x :> suminf (?f' x)"
  1894       using DERIV_ln[OF \<open>0 < x\<close>] unfolding divide_inverse by auto
  1895     moreover
  1896     have repos: "\<And> h x :: real. h - 1 + x = h + x - 1" by auto
  1897     have "DERIV (\<lambda>x. suminf (?f x)) (x - 1) :>
  1898       (\<Sum>n. (-1)^n * (1 / real (n + 1)) * real (Suc n) * (x - 1) ^ n)"
  1899     proof (rule DERIV_power_series')
  1900       show "x - 1 \<in> {- 1<..<1}" and "(0 :: real) < 1"
  1901         using \<open>0 < x\<close> \<open>x < 2\<close> by auto
  1902     next
  1903       fix x :: real
  1904       assume "x \<in> {- 1<..<1}"
  1905       then have "norm (-x) < 1" by auto
  1906       show "summable (\<lambda>n. (- 1) ^ n * (1 / real (n + 1)) * real (Suc n) * x^n)"
  1907         unfolding One_nat_def
  1908         by (auto simp add: power_mult_distrib[symmetric] summable_geometric[OF \<open>norm (-x) < 1\<close>])
  1909     qed
  1910     then have "DERIV (\<lambda>x. suminf (?f x)) (x - 1) :> suminf (?f' x)"
  1911       unfolding One_nat_def by auto
  1912     then have "DERIV (\<lambda>x. suminf (?f (x - 1))) x :> suminf (?f' x)"
  1913       unfolding DERIV_def repos .
  1914     ultimately have "DERIV (\<lambda>x. ln x - suminf (?f (x - 1))) x :> suminf (?f' x) - suminf (?f' x)"
  1915       by (rule DERIV_diff)
  1916     then show "DERIV (\<lambda>x. ln x - suminf (?f (x - 1))) x :> 0" by auto
  1917   qed (auto simp add: assms)
  1918   then show ?thesis by auto
  1919 qed
  1920 
  1921 lemma exp_first_terms:
  1922   fixes x :: "'a::{real_normed_algebra_1,banach}"
  1923   shows "exp x = (\<Sum>n<k. inverse(fact n) *\<^sub>R (x ^ n)) + (\<Sum>n. inverse(fact (n + k)) *\<^sub>R (x ^ (n + k)))"
  1924 proof -
  1925   have "exp x = suminf (\<lambda>n. inverse(fact n) *\<^sub>R (x^n))"
  1926     by (simp add: exp_def)
  1927   also from summable_exp_generic have "\<dots> = (\<Sum> n. inverse(fact(n+k)) *\<^sub>R (x ^ (n + k))) +
  1928     (\<Sum> n::nat<k. inverse(fact n) *\<^sub>R (x^n))" (is "_ = _ + ?a")
  1929     by (rule suminf_split_initial_segment)
  1930   finally show ?thesis by simp
  1931 qed
  1932 
  1933 lemma exp_first_term: "exp x = 1 + (\<Sum>n. inverse (fact (Suc n)) *\<^sub>R (x ^ Suc n))"
  1934   for x :: "'a::{real_normed_algebra_1,banach}"
  1935   using exp_first_terms[of x 1] by simp
  1936 
  1937 lemma exp_first_two_terms: "exp x = 1 + x + (\<Sum>n. inverse (fact (n + 2)) *\<^sub>R (x ^ (n + 2)))"
  1938   for x :: "'a::{real_normed_algebra_1,banach}"
  1939   using exp_first_terms[of x 2] by (simp add: eval_nat_numeral)
  1940 
  1941 lemma exp_bound:
  1942   fixes x :: real
  1943   assumes a: "0 \<le> x"
  1944     and b: "x \<le> 1"
  1945   shows "exp x \<le> 1 + x + x\<^sup>2"
  1946 proof -
  1947   have aux1: "inverse (fact (n + 2)) * x ^ (n + 2) \<le> (x\<^sup>2/2) * ((1/2)^n)" for n :: nat
  1948   proof -
  1949     have "(2::nat) * 2 ^ n \<le> fact (n + 2)"
  1950       by (induct n) simp_all
  1951     then have "real ((2::nat) * 2 ^ n) \<le> real_of_nat (fact (n + 2))"
  1952       by (simp only: of_nat_le_iff)
  1953     then have "((2::real) * 2 ^ n) \<le> fact (n + 2)"
  1954       unfolding of_nat_fact by simp
  1955     then have "inverse (fact (n + 2)) \<le> inverse ((2::real) * 2 ^ n)"
  1956       by (rule le_imp_inverse_le) simp
  1957     then have "inverse (fact (n + 2)) \<le> 1/(2::real) * (1/2)^n"
  1958       by (simp add: power_inverse [symmetric])
  1959     then have "inverse (fact (n + 2)) * (x^n * x\<^sup>2) \<le> 1/2 * (1/2)^n * (1 * x\<^sup>2)"
  1960       by (rule mult_mono) (rule mult_mono, simp_all add: power_le_one a b)
  1961     then show ?thesis
  1962       unfolding power_add by (simp add: ac_simps del: fact_Suc)
  1963   qed
  1964   have "(\<lambda>n. x\<^sup>2 / 2 * (1 / 2) ^ n) sums (x\<^sup>2 / 2 * (1 / (1 - 1 / 2)))"
  1965     by (intro sums_mult geometric_sums) simp
  1966   then have aux2: "(\<lambda>n. x\<^sup>2 / 2 * (1 / 2) ^ n) sums x\<^sup>2"
  1967     by simp
  1968   have "suminf (\<lambda>n. inverse(fact (n+2)) * (x ^ (n + 2))) \<le> x\<^sup>2"
  1969   proof -
  1970     have "suminf (\<lambda>n. inverse(fact (n+2)) * (x ^ (n + 2))) \<le> suminf (\<lambda>n. (x\<^sup>2/2) * ((1/2)^n))"
  1971       apply (rule suminf_le)
  1972         apply (rule allI)
  1973         apply (rule aux1)
  1974        apply (rule summable_exp [THEN summable_ignore_initial_segment])
  1975       apply (rule sums_summable)
  1976       apply (rule aux2)
  1977       done
  1978     also have "\<dots> = x\<^sup>2"
  1979       by (rule sums_unique [THEN sym]) (rule aux2)
  1980     finally show ?thesis .
  1981   qed
  1982   then show ?thesis
  1983     unfolding exp_first_two_terms by auto
  1984 qed
  1985 
  1986 corollary exp_half_le2: "exp(1/2) \<le> (2::real)"
  1987   using exp_bound [of "1/2"]
  1988   by (simp add: field_simps)
  1989 
  1990 corollary exp_le: "exp 1 \<le> (3::real)"
  1991   using exp_bound [of 1]
  1992   by (simp add: field_simps)
  1993 
  1994 lemma exp_bound_half: "norm z \<le> 1/2 \<Longrightarrow> norm (exp z) \<le> 2"
  1995   by (blast intro: order_trans intro!: exp_half_le2 norm_exp)
  1996 
  1997 lemma exp_bound_lemma:
  1998   assumes "norm z \<le> 1/2"
  1999   shows "norm (exp z) \<le> 1 + 2 * norm z"
  2000 proof -
  2001   have *: "(norm z)\<^sup>2 \<le> norm z * 1"
  2002     unfolding power2_eq_square
  2003     apply (rule mult_left_mono)
  2004     using assms
  2005      apply auto
  2006     done
  2007   show ?thesis
  2008     apply (rule order_trans [OF norm_exp])
  2009     apply (rule order_trans [OF exp_bound])
  2010     using assms *
  2011       apply auto
  2012     done
  2013 qed
  2014 
  2015 lemma real_exp_bound_lemma: "0 \<le> x \<Longrightarrow> x \<le> 1/2 \<Longrightarrow> exp x \<le> 1 + 2 * x"
  2016   for x :: real
  2017   using exp_bound_lemma [of x] by simp
  2018 
  2019 lemma ln_one_minus_pos_upper_bound:
  2020   fixes x :: real
  2021   assumes a: "0 \<le> x" and b: "x < 1"
  2022   shows "ln (1 - x) \<le> - x"
  2023 proof -
  2024   have "(1 - x) * (1 + x + x\<^sup>2) = 1 - x^3"
  2025     by (simp add: algebra_simps power2_eq_square power3_eq_cube)
  2026   also have "\<dots> \<le> 1"
  2027     by (auto simp add: a)
  2028   finally have "(1 - x) * (1 + x + x\<^sup>2) \<le> 1" .
  2029   moreover have c: "0 < 1 + x + x\<^sup>2"
  2030     by (simp add: add_pos_nonneg a)
  2031   ultimately have "1 - x \<le> 1 / (1 + x + x\<^sup>2)"
  2032     by (elim mult_imp_le_div_pos)
  2033   also have "\<dots> \<le> 1 / exp x"
  2034     by (metis a abs_one b exp_bound exp_gt_zero frac_le less_eq_real_def real_sqrt_abs
  2035         real_sqrt_pow2_iff real_sqrt_power)
  2036   also have "\<dots> = exp (- x)"
  2037     by (auto simp add: exp_minus divide_inverse)
  2038   finally have "1 - x \<le> exp (- x)" .
  2039   also have "1 - x = exp (ln (1 - x))"
  2040     by (metis b diff_0 exp_ln_iff less_iff_diff_less_0 minus_diff_eq)
  2041   finally have "exp (ln (1 - x)) \<le> exp (- x)" .
  2042   then show ?thesis
  2043     by (auto simp only: exp_le_cancel_iff)
  2044 qed
  2045 
  2046 lemma exp_ge_add_one_self [simp]: "1 + x \<le> exp x"
  2047   for x :: real
  2048   apply (cases "0 \<le> x")
  2049    apply (erule exp_ge_add_one_self_aux)
  2050   apply (cases "x \<le> -1")
  2051    apply (subgoal_tac "1 + x \<le> 0")
  2052     apply (erule order_trans)
  2053     apply simp
  2054    apply simp
  2055   apply (subgoal_tac "1 + x = exp (ln (1 + x))")
  2056    apply (erule ssubst)
  2057    apply (subst exp_le_cancel_iff)
  2058    apply (subgoal_tac "ln (1 - (- x)) \<le> - (- x)")
  2059     apply simp
  2060    apply (rule ln_one_minus_pos_upper_bound)
  2061     apply auto
  2062   done
  2063 
  2064 lemma ln_one_plus_pos_lower_bound:
  2065   fixes x :: real
  2066   assumes a: "0 \<le> x" and b: "x \<le> 1"
  2067   shows "x - x\<^sup>2 \<le> ln (1 + x)"
  2068 proof -
  2069   have "exp (x - x\<^sup>2) = exp x / exp (x\<^sup>2)"
  2070     by (rule exp_diff)
  2071   also have "\<dots> \<le> (1 + x + x\<^sup>2) / exp (x \<^sup>2)"
  2072     by (metis a b divide_right_mono exp_bound exp_ge_zero)
  2073   also have "\<dots> \<le> (1 + x + x\<^sup>2) / (1 + x\<^sup>2)"
  2074     by (simp add: a divide_left_mono add_pos_nonneg)
  2075   also from a have "\<dots> \<le> 1 + x"
  2076     by (simp add: field_simps add_strict_increasing zero_le_mult_iff)
  2077   finally have "exp (x - x\<^sup>2) \<le> 1 + x" .
  2078   also have "\<dots> = exp (ln (1 + x))"
  2079   proof -
  2080     from a have "0 < 1 + x" by auto
  2081     then show ?thesis
  2082       by (auto simp only: exp_ln_iff [THEN sym])
  2083   qed
  2084   finally have "exp (x - x\<^sup>2) \<le> exp (ln (1 + x))" .
  2085   then show ?thesis
  2086     by (metis exp_le_cancel_iff)
  2087 qed
  2088 
  2089 lemma ln_one_minus_pos_lower_bound:
  2090   fixes x :: real
  2091   assumes a: "0 \<le> x" and b: "x \<le> 1 / 2"
  2092   shows "- x - 2 * x\<^sup>2 \<le> ln (1 - x)"
  2093 proof -
  2094   from b have c: "x < 1" by auto
  2095   then have "ln (1 - x) = - ln (1 + x / (1 - x))"
  2096     apply (subst ln_inverse [symmetric])
  2097      apply (simp add: field_simps)
  2098     apply (rule arg_cong [where f=ln])
  2099     apply (simp add: field_simps)
  2100     done
  2101   also have "- (x / (1 - x)) \<le> \<dots>"
  2102   proof -
  2103     have "ln (1 + x / (1 - x)) \<le> x / (1 - x)"
  2104       using a c by (intro ln_add_one_self_le_self) auto
  2105     then show ?thesis
  2106       by auto
  2107   qed
  2108   also have "- (x / (1 - x)) = - x / (1 - x)"
  2109     by auto
  2110   finally have d: "- x / (1 - x) \<le> ln (1 - x)" .
  2111   have "0 < 1 - x" using a b by simp
  2112   then have e: "- x - 2 * x\<^sup>2 \<le> - x / (1 - x)"
  2113     using mult_right_le_one_le[of "x * x" "2 * x"] a b
  2114     by (simp add: field_simps power2_eq_square)
  2115   from e d show "- x - 2 * x\<^sup>2 \<le> ln (1 - x)"
  2116     by (rule order_trans)
  2117 qed
  2118 
  2119 lemma ln_add_one_self_le_self2:
  2120   fixes x :: real
  2121   shows "-1 < x \<Longrightarrow> ln (1 + x) \<le> x"
  2122   apply (subgoal_tac "ln (1 + x) \<le> ln (exp x)")
  2123    apply simp
  2124   apply (subst ln_le_cancel_iff)
  2125     apply auto
  2126   done
  2127 
  2128 lemma abs_ln_one_plus_x_minus_x_bound_nonneg:
  2129   fixes x :: real
  2130   assumes x: "0 \<le> x" and x1: "x \<le> 1"
  2131   shows "\<bar>ln (1 + x) - x\<bar> \<le> x\<^sup>2"
  2132 proof -
  2133   from x have "ln (1 + x) \<le> x"
  2134     by (rule ln_add_one_self_le_self)
  2135   then have "ln (1 + x) - x \<le> 0"
  2136     by simp
  2137   then have "\<bar>ln(1 + x) - x\<bar> = - (ln(1 + x) - x)"
  2138     by (rule abs_of_nonpos)
  2139   also have "\<dots> = x - ln (1 + x)"
  2140     by simp
  2141   also have "\<dots> \<le> x\<^sup>2"
  2142   proof -
  2143     from x x1 have "x - x\<^sup>2 \<le> ln (1 + x)"
  2144       by (intro ln_one_plus_pos_lower_bound)
  2145     then show ?thesis
  2146       by simp
  2147   qed
  2148   finally show ?thesis .
  2149 qed
  2150 
  2151 lemma abs_ln_one_plus_x_minus_x_bound_nonpos:
  2152   fixes x :: real
  2153   assumes a: "-(1 / 2) \<le> x" and b: "x \<le> 0"
  2154   shows "\<bar>ln (1 + x) - x\<bar> \<le> 2 * x\<^sup>2"
  2155 proof -
  2156   have "\<bar>ln (1 + x) - x\<bar> = x - ln (1 - (- x))"
  2157     apply (subst abs_of_nonpos)
  2158      apply simp
  2159      apply (rule ln_add_one_self_le_self2)
  2160     using a apply auto
  2161     done
  2162   also have "\<dots> \<le> 2 * x\<^sup>2"
  2163     apply (subgoal_tac "- (-x) - 2 * (-x)\<^sup>2 \<le> ln (1 - (- x))")
  2164      apply (simp add: algebra_simps)
  2165     apply (rule ln_one_minus_pos_lower_bound)
  2166     using a b apply auto
  2167     done
  2168   finally show ?thesis .
  2169 qed
  2170 
  2171 lemma abs_ln_one_plus_x_minus_x_bound:
  2172   fixes x :: real
  2173   shows "\<bar>x\<bar> \<le> 1 / 2 \<Longrightarrow> \<bar>ln (1 + x) - x\<bar> \<le> 2 * x\<^sup>2"
  2174   apply (cases "0 \<le> x")
  2175    apply (rule order_trans)
  2176     apply (rule abs_ln_one_plus_x_minus_x_bound_nonneg)
  2177      apply auto
  2178   apply (rule abs_ln_one_plus_x_minus_x_bound_nonpos)
  2179    apply auto
  2180   done
  2181 
  2182 lemma ln_x_over_x_mono:
  2183   fixes x :: real
  2184   assumes x: "exp 1 \<le> x" "x \<le> y"
  2185   shows "ln y / y \<le> ln x / x"
  2186 proof -
  2187   note x
  2188   moreover have "0 < exp (1::real)" by simp
  2189   ultimately have a: "0 < x" and b: "0 < y"
  2190     by (fast intro: less_le_trans order_trans)+
  2191   have "x * ln y - x * ln x = x * (ln y - ln x)"
  2192     by (simp add: algebra_simps)
  2193   also have "\<dots> = x * ln (y / x)"
  2194     by (simp only: ln_div a b)
  2195   also have "y / x = (x + (y - x)) / x"
  2196     by simp
  2197   also have "\<dots> = 1 + (y - x) / x"
  2198     using x a by (simp add: field_simps)
  2199   also have "x * ln (1 + (y - x) / x) \<le> x * ((y - x) / x)"
  2200     using x a
  2201     by (intro mult_left_mono ln_add_one_self_le_self) simp_all
  2202   also have "\<dots> = y - x"
  2203     using a by simp
  2204   also have "\<dots> = (y - x) * ln (exp 1)" by simp
  2205   also have "\<dots> \<le> (y - x) * ln x"
  2206     apply (rule mult_left_mono)
  2207      apply (subst ln_le_cancel_iff)
  2208        apply fact
  2209       apply (rule a)
  2210      apply (rule x)
  2211     using x apply simp
  2212     done
  2213   also have "\<dots> = y * ln x - x * ln x"
  2214     by (rule left_diff_distrib)
  2215   finally have "x * ln y \<le> y * ln x"
  2216     by arith
  2217   then have "ln y \<le> (y * ln x) / x"
  2218     using a by (simp add: field_simps)
  2219   also have "\<dots> = y * (ln x / x)" by simp
  2220   finally show ?thesis
  2221     using b by (simp add: field_simps)
  2222 qed
  2223 
  2224 lemma ln_le_minus_one: "0 < x \<Longrightarrow> ln x \<le> x - 1"
  2225   for x :: real
  2226   using exp_ge_add_one_self[of "ln x"] by simp
  2227 
  2228 corollary ln_diff_le: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> ln x - ln y \<le> (x - y) / y"
  2229   for x :: real
  2230   by (simp add: ln_div [symmetric] diff_divide_distrib ln_le_minus_one)
  2231 
  2232 lemma ln_eq_minus_one:
  2233   fixes x :: real
  2234   assumes "0 < x" "ln x = x - 1"
  2235   shows "x = 1"
  2236 proof -
  2237   let ?l = "\<lambda>y. ln y - y + 1"
  2238   have D: "\<And>x::real. 0 < x \<Longrightarrow> DERIV ?l x :> (1 / x - 1)"
  2239     by (auto intro!: derivative_eq_intros)
  2240 
  2241   show ?thesis
  2242   proof (cases rule: linorder_cases)
  2243     assume "x < 1"
  2244     from dense[OF \<open>x < 1\<close>] obtain a where "x < a" "a < 1" by blast
  2245     from \<open>x < a\<close> have "?l x < ?l a"
  2246     proof (rule DERIV_pos_imp_increasing, safe)
  2247       fix y
  2248       assume "x \<le> y" "y \<le> a"
  2249       with \<open>0 < x\<close> \<open>a < 1\<close> have "0 < 1 / y - 1" "0 < y"
  2250         by (auto simp: field_simps)
  2251       with D show "\<exists>z. DERIV ?l y :> z \<and> 0 < z" by blast
  2252     qed
  2253     also have "\<dots> \<le> 0"
  2254       using ln_le_minus_one \<open>0 < x\<close> \<open>x < a\<close> by (auto simp: field_simps)
  2255     finally show "x = 1" using assms by auto
  2256   next
  2257     assume "1 < x"
  2258     from dense[OF this] obtain a where "1 < a" "a < x" by blast
  2259     from \<open>a < x\<close> have "?l x < ?l a"
  2260     proof (rule DERIV_neg_imp_decreasing, safe)
  2261       fix y
  2262       assume "a \<le> y" "y \<le> x"
  2263       with \<open>1 < a\<close> have "1 / y - 1 < 0" "0 < y"
  2264         by (auto simp: field_simps)
  2265       with D show "\<exists>z. DERIV ?l y :> z \<and> z < 0"
  2266         by blast
  2267     qed
  2268     also have "\<dots> \<le> 0"
  2269       using ln_le_minus_one \<open>1 < a\<close> by (auto simp: field_simps)
  2270     finally show "x = 1" using assms by auto
  2271   next
  2272     assume "x = 1"
  2273     then show ?thesis by simp
  2274   qed
  2275 qed
  2276 
  2277 lemma ln_x_over_x_tendsto_0: "((\<lambda>x::real. ln x / x) \<longlongrightarrow> 0) at_top"
  2278 proof (rule lhospital_at_top_at_top[where f' = inverse and g' = "\<lambda>_. 1"])
  2279   from eventually_gt_at_top[of "0::real"]
  2280   show "\<forall>\<^sub>F x in at_top. (ln has_real_derivative inverse x) (at x)"
  2281     by eventually_elim (auto intro!: derivative_eq_intros simp: field_simps)
  2282 qed (use tendsto_inverse_0 in
  2283       \<open>auto simp: filterlim_ident dest!: tendsto_mono[OF at_top_le_at_infinity]\<close>)
  2284 
  2285 lemma exp_ge_one_plus_x_over_n_power_n:
  2286   assumes "x \<ge> - real n" "n > 0"
  2287   shows "(1 + x / of_nat n) ^ n \<le> exp x"
  2288 proof (cases "x = - of_nat n")
  2289   case False
  2290   from assms False have "(1 + x / of_nat n) ^ n = exp (of_nat n * ln (1 + x / of_nat n))"
  2291     by (subst exp_of_nat_mult, subst exp_ln) (simp_all add: field_simps)
  2292   also from assms False have "ln (1 + x / real n) \<le> x / real n"
  2293     by (intro ln_add_one_self_le_self2) (simp_all add: field_simps)
  2294   with assms have "exp (of_nat n * ln (1 + x / of_nat n)) \<le> exp x"
  2295     by (simp add: field_simps)
  2296   finally show ?thesis .
  2297 next
  2298   case True
  2299   then show ?thesis by (simp add: zero_power)
  2300 qed
  2301 
  2302 lemma exp_ge_one_minus_x_over_n_power_n:
  2303   assumes "x \<le> real n" "n > 0"
  2304   shows "(1 - x / of_nat n) ^ n \<le> exp (-x)"
  2305   using exp_ge_one_plus_x_over_n_power_n[of n "-x"] assms by simp
  2306 
  2307 lemma exp_at_bot: "(exp \<longlongrightarrow> (0::real)) at_bot"
  2308   unfolding tendsto_Zfun_iff
  2309 proof (rule ZfunI, simp add: eventually_at_bot_dense)
  2310   fix r :: real
  2311   assume "0 < r"
  2312   have "exp x < r" if "x < ln r" for x
  2313   proof -
  2314     from that have "exp x < exp (ln r)"
  2315       by simp
  2316     with \<open>0 < r\<close> show ?thesis
  2317       by simp
  2318   qed
  2319   then show "\<exists>k. \<forall>n<k. exp n < r" by auto
  2320 qed
  2321 
  2322 lemma exp_at_top: "LIM x at_top. exp x :: real :> at_top"
  2323   by (rule filterlim_at_top_at_top[where Q="\<lambda>x. True" and P="\<lambda>x. 0 < x" and g="ln"])
  2324     (auto intro: eventually_gt_at_top)
  2325 
  2326 lemma lim_exp_minus_1: "((\<lambda>z::'a. (exp(z) - 1) / z) \<longlongrightarrow> 1) (at 0)"
  2327   for x :: "'a::{real_normed_field,banach}"
  2328 proof -
  2329   have "((\<lambda>z::'a. exp(z) - 1) has_field_derivative 1) (at 0)"
  2330     by (intro derivative_eq_intros | simp)+
  2331   then show ?thesis
  2332     by (simp add: Deriv.DERIV_iff2)
  2333 qed
  2334 
  2335 lemma ln_at_0: "LIM x at_right 0. ln (x::real) :> at_bot"
  2336   by (rule filterlim_at_bot_at_right[where Q="\<lambda>x. 0 < x" and P="\<lambda>x. True" and g="exp"])
  2337      (auto simp: eventually_at_filter)
  2338 
  2339 lemma ln_at_top: "LIM x at_top. ln (x::real) :> at_top"
  2340   by (rule filterlim_at_top_at_top[where Q="\<lambda>x. 0 < x" and P="\<lambda>x. True" and g="exp"])
  2341      (auto intro: eventually_gt_at_top)
  2342 
  2343 lemma filtermap_ln_at_top: "filtermap (ln::real \<Rightarrow> real) at_top = at_top"
  2344   by (intro filtermap_fun_inverse[of exp] exp_at_top ln_at_top) auto
  2345 
  2346 lemma filtermap_exp_at_top: "filtermap (exp::real \<Rightarrow> real) at_top = at_top"
  2347   by (intro filtermap_fun_inverse[of ln] exp_at_top ln_at_top)
  2348      (auto simp: eventually_at_top_dense)
  2349 
  2350 lemma tendsto_power_div_exp_0: "((\<lambda>x. x ^ k / exp x) \<longlongrightarrow> (0::real)) at_top"
  2351 proof (induct k)
  2352   case 0
  2353   show "((\<lambda>x. x ^ 0 / exp x) \<longlongrightarrow> (0::real)) at_top"
  2354     by (simp add: inverse_eq_divide[symmetric])
  2355        (metis filterlim_compose[OF tendsto_inverse_0] exp_at_top filterlim_mono
  2356          at_top_le_at_infinity order_refl)
  2357 next
  2358   case (Suc k)
  2359   show ?case
  2360   proof (rule lhospital_at_top_at_top)
  2361     show "eventually (\<lambda>x. DERIV (\<lambda>x. x ^ Suc k) x :> (real (Suc k) * x^k)) at_top"
  2362       by eventually_elim (intro derivative_eq_intros, auto)
  2363     show "eventually (\<lambda>x. DERIV exp x :> exp x) at_top"
  2364       by eventually_elim auto
  2365     show "eventually (\<lambda>x. exp x \<noteq> 0) at_top"
  2366       by auto
  2367     from tendsto_mult[OF tendsto_const Suc, of "real (Suc k)"]
  2368     show "((\<lambda>x. real (Suc k) * x ^ k / exp x) \<longlongrightarrow> 0) at_top"
  2369       by simp
  2370   qed (rule exp_at_top)
  2371 qed
  2372 
  2373 definition log :: "real \<Rightarrow> real \<Rightarrow> real"
  2374   \<comment> \<open>logarithm of @{term x} to base @{term a}\<close>
  2375   where "log a x = ln x / ln a"
  2376 
  2377 lemma tendsto_log [tendsto_intros]:
  2378   "(f \<longlongrightarrow> a) F \<Longrightarrow> (g \<longlongrightarrow> b) F \<Longrightarrow> 0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> 0 < b \<Longrightarrow>
  2379     ((\<lambda>x. log (f x) (g x)) \<longlongrightarrow> log a b) F"
  2380   unfolding log_def by (intro tendsto_intros) auto
  2381 
  2382 lemma continuous_log:
  2383   assumes "continuous F f"
  2384     and "continuous F g"
  2385     and "0 < f (Lim F (\<lambda>x. x))"
  2386     and "f (Lim F (\<lambda>x. x)) \<noteq> 1"
  2387     and "0 < g (Lim F (\<lambda>x. x))"
  2388   shows "continuous F (\<lambda>x. log (f x) (g x))"
  2389   using assms unfolding continuous_def by (rule tendsto_log)
  2390 
  2391 lemma continuous_at_within_log[continuous_intros]:
  2392   assumes "continuous (at a within s) f"
  2393     and "continuous (at a within s) g"
  2394     and "0 < f a"
  2395     and "f a \<noteq> 1"
  2396     and "0 < g a"
  2397   shows "continuous (at a within s) (\<lambda>x. log (f x) (g x))"
  2398   using assms unfolding continuous_within by (rule tendsto_log)
  2399 
  2400 lemma isCont_log[continuous_intros, simp]:
  2401   assumes "isCont f a" "isCont g a" "0 < f a" "f a \<noteq> 1" "0 < g a"
  2402   shows "isCont (\<lambda>x. log (f x) (g x)) a"
  2403   using assms unfolding continuous_at by (rule tendsto_log)
  2404 
  2405 lemma continuous_on_log[continuous_intros]:
  2406   assumes "continuous_on s f" "continuous_on s g"
  2407     and "\<forall>x\<in>s. 0 < f x" "\<forall>x\<in>s. f x \<noteq> 1" "\<forall>x\<in>s. 0 < g x"
  2408   shows "continuous_on s (\<lambda>x. log (f x) (g x))"
  2409   using assms unfolding continuous_on_def by (fast intro: tendsto_log)
  2410 
  2411 lemma powr_one_eq_one [simp]: "1 powr a = 1"
  2412   by (simp add: powr_def)
  2413 
  2414 lemma powr_zero_eq_one [simp]: "x powr 0 = (if x = 0 then 0 else 1)"
  2415   by (simp add: powr_def)
  2416 
  2417 lemma powr_one_gt_zero_iff [simp]: "x powr 1 = x \<longleftrightarrow> 0 \<le> x"
  2418   for x :: real
  2419   by (auto simp: powr_def)
  2420 declare powr_one_gt_zero_iff [THEN iffD2, simp]
  2421 
  2422 lemma powr_mult: "0 \<le> x \<Longrightarrow> 0 \<le> y \<Longrightarrow> (x * y) powr a = (x powr a) * (y powr a)"
  2423   for a x y :: real
  2424   by (simp add: powr_def exp_add [symmetric] ln_mult distrib_left)
  2425 
  2426 lemma powr_ge_pzero [simp]: "0 \<le> x powr y"
  2427   for x y :: real
  2428   by (simp add: powr_def)
  2429 
  2430 lemma powr_divide: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> (x / y) powr a = (x powr a) / (y powr a)"
  2431   for a b x :: real
  2432   apply (simp add: divide_inverse positive_imp_inverse_positive powr_mult)
  2433   apply (simp add: powr_def exp_minus [symmetric] exp_add [symmetric] ln_inverse)
  2434   done
  2435 
  2436 lemma powr_divide2: "x powr a / x powr b = x powr (a - b)"
  2437   for a b x :: real
  2438   apply (simp add: powr_def)
  2439   apply (subst exp_diff [THEN sym])
  2440   apply (simp add: left_diff_distrib)
  2441   done
  2442 
  2443 lemma powr_add: "x powr (a + b) = (x powr a) * (x powr b)"
  2444   for a b x :: real
  2445   by (simp add: powr_def exp_add [symmetric] distrib_right)
  2446 
  2447 lemma powr_mult_base: "0 < x \<Longrightarrow>x * x powr y = x powr (1 + y)"
  2448   for x :: real
  2449   by (auto simp: powr_add)
  2450 
  2451 lemma powr_powr: "(x powr a) powr b = x powr (a * b)"
  2452   for a b x :: real
  2453   by (simp add: powr_def)
  2454 
  2455 lemma powr_powr_swap: "(x powr a) powr b = (x powr b) powr a"
  2456   for a b x :: real
  2457   by (simp add: powr_powr mult.commute)
  2458 
  2459 lemma powr_minus: "x powr (- a) = inverse (x powr a)"
  2460   for x a :: real
  2461   by (simp add: powr_def exp_minus [symmetric])
  2462 
  2463 lemma powr_minus_divide: "x powr (- a) = 1/(x powr a)"
  2464   for x a :: real
  2465   by (simp add: divide_inverse powr_minus)
  2466 
  2467 lemma divide_powr_uminus: "a / b powr c = a * b powr (- c)"
  2468   for a b c :: real
  2469   by (simp add: powr_minus_divide)
  2470 
  2471 lemma powr_less_mono: "a < b \<Longrightarrow> 1 < x \<Longrightarrow> x powr a < x powr b"
  2472   for a b x :: real
  2473   by (simp add: powr_def)
  2474 
  2475 lemma powr_less_cancel: "x powr a < x powr b \<Longrightarrow> 1 < x \<Longrightarrow> a < b"
  2476   for a b x :: real
  2477   by (simp add: powr_def)
  2478 
  2479 lemma powr_less_cancel_iff [simp]: "1 < x \<Longrightarrow> x powr a < x powr b \<longleftrightarrow> a < b"
  2480   for a b x :: real
  2481   by (blast intro: powr_less_cancel powr_less_mono)
  2482 
  2483 lemma powr_le_cancel_iff [simp]: "1 < x \<Longrightarrow> x powr a \<le> x powr b \<longleftrightarrow> a \<le> b"
  2484   for a b x :: real
  2485   by (simp add: linorder_not_less [symmetric])
  2486 
  2487 lemma log_ln: "ln x = log (exp(1)) x"
  2488   by (simp add: log_def)
  2489 
  2490 lemma DERIV_log:
  2491   assumes "x > 0"
  2492   shows "DERIV (\<lambda>y. log b y) x :> 1 / (ln b * x)"
  2493 proof -
  2494   define lb where "lb = 1 / ln b"
  2495   moreover have "DERIV (\<lambda>y. lb * ln y) x :> lb / x"
  2496     using \<open>x > 0\<close> by (auto intro!: derivative_eq_intros)
  2497   ultimately show ?thesis
  2498     by (simp add: log_def)
  2499 qed
  2500 
  2501 lemmas DERIV_log[THEN DERIV_chain2, derivative_intros]
  2502   and DERIV_log[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]
  2503 
  2504 lemma powr_log_cancel [simp]: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow> a powr (log a x) = x"
  2505   by (simp add: powr_def log_def)
  2506 
  2507 lemma log_powr_cancel [simp]: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> log a (a powr y) = y"
  2508   by (simp add: log_def powr_def)
  2509 
  2510 lemma log_mult:
  2511   "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow> 0 < y \<Longrightarrow>
  2512     log a (x * y) = log a x + log a y"
  2513   by (simp add: log_def ln_mult divide_inverse distrib_right)
  2514 
  2515 lemma log_eq_div_ln_mult_log:
  2516   "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> 0 < b \<Longrightarrow> b \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow>
  2517     log a x = (ln b/ln a) * log b x"
  2518   by (simp add: log_def divide_inverse)
  2519 
  2520 text\<open>Base 10 logarithms\<close>
  2521 lemma log_base_10_eq1: "0 < x \<Longrightarrow> log 10 x = (ln (exp 1) / ln 10) * ln x"
  2522   by (simp add: log_def)
  2523 
  2524 lemma log_base_10_eq2: "0 < x \<Longrightarrow> log 10 x = (log 10 (exp 1)) * ln x"
  2525   by (simp add: log_def)
  2526 
  2527 lemma log_one [simp]: "log a 1 = 0"
  2528   by (simp add: log_def)
  2529 
  2530 lemma log_eq_one [simp]: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> log a a = 1"
  2531   by (simp add: log_def)
  2532 
  2533 lemma log_inverse: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow> log a (inverse x) = - log a x"
  2534   apply (rule add_left_cancel [THEN iffD1, where a1 = "log a x"])
  2535   apply (simp add: log_mult [symmetric])
  2536   done
  2537 
  2538 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"
  2539   by (simp add: log_mult divide_inverse log_inverse)
  2540 
  2541 lemma powr_gt_zero [simp]: "0 < x powr a \<longleftrightarrow> x \<noteq> 0"
  2542   for a x :: real
  2543   by (simp add: powr_def)
  2544 
  2545 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)"
  2546   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)"
  2547   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)"
  2548   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)"
  2549   by (simp_all add: log_mult log_divide)
  2550 
  2551 lemma log_less_cancel_iff [simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 0 < y \<Longrightarrow> log a x < log a y \<longleftrightarrow> x < y"
  2552   apply safe
  2553    apply (rule_tac [2] powr_less_cancel)
  2554     apply (drule_tac a = "log a x" in powr_less_mono)
  2555      apply auto
  2556   done
  2557 
  2558 lemma log_inj:
  2559   assumes "1 < b"
  2560   shows "inj_on (log b) {0 <..}"
  2561 proof (rule inj_onI, simp)
  2562   fix x y
  2563   assume pos: "0 < x" "0 < y" and *: "log b x = log b y"
  2564   show "x = y"
  2565   proof (cases rule: linorder_cases)
  2566     assume "x = y"
  2567     then show ?thesis by simp
  2568   next
  2569     assume "x < y"
  2570     then have "log b x < log b y"
  2571       using log_less_cancel_iff[OF \<open>1 < b\<close>] pos by simp
  2572     then show ?thesis using * by simp
  2573   next
  2574     assume "y < x"
  2575     then have "log b y < log b x"
  2576       using log_less_cancel_iff[OF \<open>1 < b\<close>] pos by simp
  2577     then show ?thesis using * by simp
  2578   qed
  2579 qed
  2580 
  2581 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"
  2582   by (simp add: linorder_not_less [symmetric])
  2583 
  2584 lemma zero_less_log_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 0 < log a x \<longleftrightarrow> 1 < x"
  2585   using log_less_cancel_iff[of a 1 x] by simp
  2586 
  2587 lemma zero_le_log_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 0 \<le> log a x \<longleftrightarrow> 1 \<le> x"
  2588   using log_le_cancel_iff[of a 1 x] by simp
  2589 
  2590 lemma log_less_zero_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> log a x < 0 \<longleftrightarrow> x < 1"
  2591   using log_less_cancel_iff[of a x 1] by simp
  2592 
  2593 lemma log_le_zero_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> log a x \<le> 0 \<longleftrightarrow> x \<le> 1"
  2594   using log_le_cancel_iff[of a x 1] by simp
  2595 
  2596 lemma one_less_log_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 1 < log a x \<longleftrightarrow> a < x"
  2597   using log_less_cancel_iff[of a a x] by simp
  2598 
  2599 lemma one_le_log_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 1 \<le> log a x \<longleftrightarrow> a \<le> x"
  2600   using log_le_cancel_iff[of a a x] by simp
  2601 
  2602 lemma log_less_one_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> log a x < 1 \<longleftrightarrow> x < a"
  2603   using log_less_cancel_iff[of a x a] by simp
  2604 
  2605 lemma log_le_one_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> log a x \<le> 1 \<longleftrightarrow> x \<le> a"
  2606   using log_le_cancel_iff[of a x a] by simp
  2607 
  2608 lemma le_log_iff:
  2609   fixes b x y :: real
  2610   assumes "1 < b" "x > 0"
  2611   shows "y \<le> log b x \<longleftrightarrow> b powr y \<le> x"
  2612   using assms
  2613   apply auto
  2614    apply (metis (no_types, hide_lams) less_irrefl less_le_trans linear powr_le_cancel_iff
  2615       powr_log_cancel zero_less_one)
  2616   apply (metis not_less order.trans order_refl powr_le_cancel_iff powr_log_cancel zero_le_one)
  2617   done
  2618 
  2619 lemma less_log_iff:
  2620   assumes "1 < b" "x > 0"
  2621   shows "y < log b x \<longleftrightarrow> b powr y < x"
  2622   by (metis assms dual_order.strict_trans less_irrefl powr_less_cancel_iff
  2623     powr_log_cancel zero_less_one)
  2624 
  2625 lemma
  2626   assumes "1 < b" "x > 0"
  2627   shows log_less_iff: "log b x < y \<longleftrightarrow> x < b powr y"
  2628     and log_le_iff: "log b x \<le> y \<longleftrightarrow> x \<le> b powr y"
  2629   using le_log_iff[OF assms, of y] less_log_iff[OF assms, of y]
  2630   by auto
  2631 
  2632 lemmas powr_le_iff = le_log_iff[symmetric]
  2633   and powr_less_iff = le_log_iff[symmetric]
  2634   and less_powr_iff = log_less_iff[symmetric]
  2635   and le_powr_iff = log_le_iff[symmetric]
  2636 
  2637 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)"
  2638   by (auto simp add: floor_eq_iff powr_le_iff less_powr_iff)
  2639 
  2640 lemma powr_realpow: "0 < x \<Longrightarrow> x powr (real n) = x^n"
  2641   by (induct n) (simp_all add: ac_simps powr_add)
  2642 
  2643 lemma powr_numeral: "0 < x \<Longrightarrow> x powr (numeral n :: real) = x ^ (numeral n)"
  2644   by (metis of_nat_numeral powr_realpow)
  2645 
  2646 lemma powr_real_of_int:
  2647   "x > 0 \<Longrightarrow> x powr real_of_int n = (if n \<ge> 0 then x ^ nat n else inverse (x ^ nat (- n)))"
  2648   using powr_realpow[of x "nat n"] powr_realpow[of x "nat (-n)"]
  2649   by (auto simp: field_simps powr_minus)
  2650 
  2651 lemma powr2_sqrt[simp]: "0 < x \<Longrightarrow> sqrt x powr 2 = x"
  2652   by (simp add: powr_numeral)
  2653 
  2654 lemma powr_realpow2: "0 \<le> x \<Longrightarrow> 0 < n \<Longrightarrow> x^n = (if (x = 0) then 0 else x powr (real n))"
  2655   apply (cases "x = 0")
  2656    apply simp_all
  2657   apply (rule powr_realpow [THEN sym])
  2658   apply simp
  2659   done
  2660 
  2661 lemma powr_int:
  2662   assumes "x > 0"
  2663   shows "x powr i = (if i \<ge> 0 then x ^ nat i else 1 / x ^ nat (-i))"
  2664 proof (cases "i < 0")
  2665   case True
  2666   have r: "x powr i = 1 / x powr (- i)"
  2667     by (simp add: powr_minus field_simps)
  2668   show ?thesis using \<open>i < 0\<close> \<open>x > 0\<close>
  2669     by (simp add: r field_simps powr_realpow[symmetric])
  2670 next
  2671   case False
  2672   then show ?thesis
  2673     by (simp add: assms powr_realpow[symmetric])
  2674 qed
  2675 
  2676 lemma compute_powr[code]:
  2677   fixes i :: real
  2678   shows "b powr i =
  2679     (if b \<le> 0 then Code.abort (STR ''op powr with nonpositive base'') (\<lambda>_. b powr i)
  2680      else if \<lfloor>i\<rfloor> = i then (if 0 \<le> i then b ^ nat \<lfloor>i\<rfloor> else 1 / b ^ nat \<lfloor>- i\<rfloor>)
  2681      else Code.abort (STR ''op powr with non-integer exponent'') (\<lambda>_. b powr i))"
  2682   by (auto simp: powr_int)
  2683 
  2684 lemma powr_one: "0 \<le> x \<Longrightarrow> x powr 1 = x"
  2685   for x :: real
  2686   using powr_realpow [of x 1] by simp
  2687 
  2688 lemma powr_neg_one: "0 < x \<Longrightarrow> x powr - 1 = 1 / x"
  2689   for x :: real
  2690   using powr_int [of x "- 1"] by simp
  2691 
  2692 lemma powr_neg_numeral: "0 < x \<Longrightarrow> x powr - numeral n = 1 / x ^ numeral n"
  2693   for x :: real
  2694   using powr_int [of x "- numeral n"] by simp
  2695 
  2696 lemma root_powr_inverse: "0 < n \<Longrightarrow> 0 < x \<Longrightarrow> root n x = x powr (1/n)"
  2697   by (rule real_root_pos_unique) (auto simp: powr_realpow[symmetric] powr_powr)
  2698 
  2699 lemma ln_powr: "x \<noteq> 0 \<Longrightarrow> ln (x powr y) = y * ln x"
  2700   for x :: real
  2701   by (simp add: powr_def)
  2702 
  2703 lemma ln_root: "n > 0 \<Longrightarrow> b > 0 \<Longrightarrow> ln (root n b) =  ln b / n"
  2704   by (simp add: root_powr_inverse ln_powr)
  2705 
  2706 lemma ln_sqrt: "0 < x \<Longrightarrow> ln (sqrt x) = ln x / 2"
  2707   by (simp add: ln_powr powr_numeral ln_powr[symmetric] mult.commute)
  2708 
  2709 lemma log_root: "n > 0 \<Longrightarrow> a > 0 \<Longrightarrow> log b (root n a) =  log b a / n"
  2710   by (simp add: log_def ln_root)
  2711 
  2712 lemma log_powr: "x \<noteq> 0 \<Longrightarrow> log b (x powr y) = y * log b x"
  2713   by (simp add: log_def ln_powr)
  2714 
  2715 lemma log_nat_power: "0 < x \<Longrightarrow> log b (x^n) = real n * log b x"
  2716   by (simp add: log_powr powr_realpow [symmetric])
  2717 
  2718 lemma le_log_of_power:
  2719   assumes "1 < b" "b ^ n \<le> m"
  2720   shows "n \<le> log b m"
  2721 proof -
  2722    from assms have "0 < m"
  2723      by (metis less_trans zero_less_power less_le_trans zero_less_one)
  2724    have "n = log b (b ^ n)"
  2725      using assms(1) by (simp add: log_nat_power)
  2726    also have "\<dots> \<le> log b m"
  2727      using assms \<open>0 < m\<close> by simp
  2728    finally show ?thesis .
  2729 qed
  2730 
  2731 lemma le_log2_of_power: "2 ^ n \<le> m \<Longrightarrow> n \<le> log 2 m"
  2732   for m n :: nat
  2733   using le_log_of_power[of 2] by simp
  2734 
  2735 lemma log_base_change: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> log b x = log a x / log a b"
  2736   by (simp add: log_def)
  2737 
  2738 lemma log_base_pow: "0 < a \<Longrightarrow> log (a ^ n) x = log a x / n"
  2739   by (simp add: log_def ln_realpow)
  2740 
  2741 lemma log_base_powr: "a \<noteq> 0 \<Longrightarrow> log (a powr b) x = log a x / b"
  2742   by (simp add: log_def ln_powr)
  2743 
  2744 lemma log_base_root: "n > 0 \<Longrightarrow> b > 0 \<Longrightarrow> log (root n b) x = n * (log b x)"
  2745   by (simp add: log_def ln_root)
  2746 
  2747 lemma ln_bound: "1 \<le> x \<Longrightarrow> ln x \<le> x"
  2748   for x :: real
  2749   apply (subgoal_tac "ln (1 + (x - 1)) \<le> x - 1")
  2750    apply simp
  2751   apply (rule ln_add_one_self_le_self)
  2752   apply simp
  2753   done
  2754 
  2755 lemma powr_mono: "a \<le> b \<Longrightarrow> 1 \<le> x \<Longrightarrow> x powr a \<le> x powr b"
  2756   for x :: real
  2757   apply (cases "x = 1")
  2758    apply simp
  2759   apply (cases "a = b")
  2760    apply simp
  2761   apply (rule order_less_imp_le)
  2762   apply (rule powr_less_mono)
  2763    apply auto
  2764   done
  2765 
  2766 lemma ge_one_powr_ge_zero: "1 \<le> x \<Longrightarrow> 0 \<le> a \<Longrightarrow> 1 \<le> x powr a"
  2767   for x :: real
  2768   using powr_mono by fastforce
  2769 
  2770 lemma powr_less_mono2: "0 < a \<Longrightarrow> 0 \<le> x \<Longrightarrow> x < y \<Longrightarrow> x powr a < y powr a"
  2771   for x :: real
  2772   by (simp add: powr_def)
  2773 
  2774 lemma powr_less_mono2_neg: "a < 0 \<Longrightarrow> 0 < x \<Longrightarrow> x < y \<Longrightarrow> y powr a < x powr a"
  2775   for x :: real
  2776   by (simp add: powr_def)
  2777 
  2778 lemma powr_mono2: "0 \<le> a \<Longrightarrow> 0 \<le> x \<Longrightarrow> x \<le> y \<Longrightarrow> x powr a \<le> y powr a"
  2779   for x :: real
  2780   apply (case_tac "a = 0")
  2781    apply simp
  2782   apply (case_tac "x = y")
  2783    apply simp
  2784   apply (metis dual_order.strict_iff_order powr_less_mono2)
  2785   done
  2786 
  2787 lemma powr_mono2':
  2788   fixes a x y :: real
  2789   assumes "a \<le> 0" "x > 0" "x \<le> y"
  2790   shows "x powr a \<ge> y powr a"
  2791 proof -
  2792   from assms have "x powr - a \<le> y powr - a"
  2793     by (intro powr_mono2) simp_all
  2794   with assms show ?thesis
  2795     by (auto simp add: powr_minus field_simps)
  2796 qed
  2797 
  2798 lemma powr_inj: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> a powr x = a powr y \<longleftrightarrow> x = y"
  2799   for x :: real
  2800   unfolding powr_def exp_inj_iff by simp
  2801 
  2802 lemma powr_half_sqrt: "0 \<le> x \<Longrightarrow> x powr (1/2) = sqrt x"
  2803   by (simp add: powr_def root_powr_inverse sqrt_def)
  2804 
  2805 lemma ln_powr_bound: "1 \<le> x \<Longrightarrow> 0 < a \<Longrightarrow> ln x \<le> (x powr a) / a"
  2806   for x :: real
  2807   by (metis exp_gt_zero linear ln_eq_zero_iff ln_exp ln_less_self ln_powr mult.commute
  2808       mult_imp_le_div_pos not_less powr_gt_zero)
  2809 
  2810 lemma ln_powr_bound2:
  2811   fixes x :: real
  2812   assumes "1 < x" and "0 < a"
  2813   shows "(ln x) powr a \<le> (a powr a) * x"
  2814 proof -
  2815   from assms have "ln x \<le> (x powr (1 / a)) / (1 / a)"
  2816     by (metis less_eq_real_def ln_powr_bound zero_less_divide_1_iff)
  2817   also have "\<dots> = a * (x powr (1 / a))"
  2818     by simp
  2819   finally have "(ln x) powr a \<le> (a * (x powr (1 / a))) powr a"
  2820     by (metis assms less_imp_le ln_gt_zero powr_mono2)
  2821   also have "\<dots> = (a powr a) * ((x powr (1 / a)) powr a)"
  2822     using assms powr_mult by auto
  2823   also have "(x powr (1 / a)) powr a = x powr ((1 / a) * a)"
  2824     by (rule powr_powr)
  2825   also have "\<dots> = x" using assms
  2826     by auto
  2827   finally show ?thesis .
  2828 qed
  2829 
  2830 lemma tendsto_powr:
  2831   fixes a b :: real
  2832   assumes f: "(f \<longlongrightarrow> a) F"
  2833     and g: "(g \<longlongrightarrow> b) F"
  2834     and a: "a \<noteq> 0"
  2835   shows "((\<lambda>x. f x powr g x) \<longlongrightarrow> a powr b) F"
  2836   unfolding powr_def
  2837 proof (rule filterlim_If)
  2838   from f show "((\<lambda>x. 0) \<longlongrightarrow> (if a = 0 then 0 else exp (b * ln a))) (inf F (principal {x. f x = 0}))"
  2839     by simp (auto simp: filterlim_iff eventually_inf_principal elim: eventually_mono dest: t1_space_nhds)
  2840   from f g a show "((\<lambda>x. exp (g x * ln (f x))) \<longlongrightarrow> (if a = 0 then 0 else exp (b * ln a)))
  2841       (inf F (principal {x. f x \<noteq> 0}))"
  2842     by (auto intro!: tendsto_intros intro: tendsto_mono inf_le1)
  2843 qed
  2844 
  2845 lemma tendsto_powr'[tendsto_intros]:
  2846   fixes a :: real
  2847   assumes f: "(f \<longlongrightarrow> a) F"
  2848     and g: "(g \<longlongrightarrow> b) F"
  2849     and a: "a \<noteq> 0 \<or> (b > 0 \<and> eventually (\<lambda>x. f x \<ge> 0) F)"
  2850   shows "((\<lambda>x. f x powr g x) \<longlongrightarrow> a powr b) F"
  2851 proof -
  2852   from a consider "a \<noteq> 0" | "a = 0" "b > 0" "eventually (\<lambda>x. f x \<ge> 0) F"
  2853     by auto
  2854   then show ?thesis
  2855   proof cases
  2856     case 1
  2857     with f g show ?thesis by (rule tendsto_powr)
  2858   next
  2859     case 2
  2860     have "((\<lambda>x. if f x = 0 then 0 else exp (g x * ln (f x))) \<longlongrightarrow> 0) F"
  2861     proof (intro filterlim_If)
  2862       have "filterlim f (principal {0<..}) (inf F (principal {z. f z \<noteq> 0}))"
  2863         using \<open>eventually (\<lambda>x. f x \<ge> 0) F\<close>
  2864         by (auto simp add: filterlim_iff eventually_inf_principal
  2865             eventually_principal elim: eventually_mono)
  2866       moreover have "filterlim f (nhds a) (inf F (principal {z. f z \<noteq> 0}))"
  2867         by (rule tendsto_mono[OF _ f]) simp_all
  2868       ultimately have f: "filterlim f (at_right 0) (inf F (principal {x. f x \<noteq> 0}))"
  2869         by (simp add: at_within_def filterlim_inf \<open>a = 0\<close>)
  2870       have g: "(g \<longlongrightarrow> b) (inf F (principal {z. f z \<noteq> 0}))"
  2871         by (rule tendsto_mono[OF _ g]) simp_all
  2872       show "((\<lambda>x. exp (g x * ln (f x))) \<longlongrightarrow> 0) (inf F (principal {x. f x \<noteq> 0}))"
  2873         by (rule filterlim_compose[OF exp_at_bot] filterlim_tendsto_pos_mult_at_bot
  2874                  filterlim_compose[OF ln_at_0] f g \<open>b > 0\<close>)+
  2875     qed simp_all
  2876     with \<open>a = 0\<close> show ?thesis
  2877       by (simp add: powr_def)
  2878   qed
  2879 qed
  2880 
  2881 lemma continuous_powr:
  2882   assumes "continuous F f"
  2883     and "continuous F g"
  2884     and "f (Lim F (\<lambda>x. x)) \<noteq> 0"
  2885   shows "continuous F (\<lambda>x. (f x) powr (g x :: real))"
  2886   using assms unfolding continuous_def by (rule tendsto_powr)
  2887 
  2888 lemma continuous_at_within_powr[continuous_intros]:
  2889   fixes f g :: "_ \<Rightarrow> real"
  2890   assumes "continuous (at a within s) f"
  2891     and "continuous (at a within s) g"
  2892     and "f a \<noteq> 0"
  2893   shows "continuous (at a within s) (\<lambda>x. (f x) powr (g x))"
  2894   using assms unfolding continuous_within by (rule tendsto_powr)
  2895 
  2896 lemma isCont_powr[continuous_intros, simp]:
  2897   fixes f g :: "_ \<Rightarrow> real"
  2898   assumes "isCont f a" "isCont g a" "f a \<noteq> 0"
  2899   shows "isCont (\<lambda>x. (f x) powr g x) a"
  2900   using assms unfolding continuous_at by (rule tendsto_powr)
  2901 
  2902 lemma continuous_on_powr[continuous_intros]:
  2903   fixes f g :: "_ \<Rightarrow> real"
  2904   assumes "continuous_on s f" "continuous_on s g" and "\<forall>x\<in>s. f x \<noteq> 0"
  2905   shows "continuous_on s (\<lambda>x. (f x) powr (g x))"
  2906   using assms unfolding continuous_on_def by (fast intro: tendsto_powr)
  2907 
  2908 lemma tendsto_powr2:
  2909   fixes a :: real
  2910   assumes f: "(f \<longlongrightarrow> a) F"
  2911     and g: "(g \<longlongrightarrow> b) F"
  2912     and "\<forall>\<^sub>F x in F. 0 \<le> f x"
  2913     and b: "0 < b"
  2914   shows "((\<lambda>x. f x powr g x) \<longlongrightarrow> a powr b) F"
  2915   using tendsto_powr'[of f a F g b] assms by auto
  2916 
  2917 lemma DERIV_powr:
  2918   fixes r :: real
  2919   assumes g: "DERIV g x :> m"
  2920     and pos: "g x > 0"
  2921     and f: "DERIV f x :> r"
  2922   shows "DERIV (\<lambda>x. g x powr f x) x :> (g x powr f x) * (r * ln (g x) + m * f x / g x)"
  2923 proof -
  2924   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)"
  2925     using pos
  2926     by (auto intro!: derivative_eq_intros g pos f simp: powr_def field_simps exp_diff)
  2927   then show ?thesis
  2928   proof (rule DERIV_cong_ev[OF refl _ refl, THEN iffD1, rotated])
  2929     from DERIV_isCont[OF g] pos have "\<forall>\<^sub>F x in at x. 0 < g x"
  2930       unfolding isCont_def by (rule order_tendstoD(1))
  2931     with pos show "\<forall>\<^sub>F x in nhds x. exp (f x * ln (g x)) = g x powr f x"
  2932       by (auto simp: eventually_at_filter powr_def elim: eventually_mono)
  2933   qed
  2934 qed
  2935 
  2936 lemma DERIV_fun_powr:
  2937   fixes r :: real
  2938   assumes g: "DERIV g x :> m"
  2939     and pos: "g x > 0"
  2940   shows "DERIV (\<lambda>x. (g x) powr r) x :> r * (g x) powr (r - of_nat 1) * m"
  2941   using DERIV_powr[OF g pos DERIV_const, of r] pos
  2942   by (simp add: powr_divide2[symmetric] field_simps)
  2943 
  2944 lemma has_real_derivative_powr:
  2945   assumes "z > 0"
  2946   shows "((\<lambda>z. z powr r) has_real_derivative r * z powr (r - 1)) (at z)"
  2947 proof (subst DERIV_cong_ev[OF refl _ refl])
  2948   from assms have "eventually (\<lambda>z. z \<noteq> 0) (nhds z)"
  2949     by (intro t1_space_nhds) auto
  2950   then show "eventually (\<lambda>z. z powr r = exp (r * ln z)) (nhds z)"
  2951     unfolding powr_def by eventually_elim simp
  2952   from assms show "((\<lambda>z. exp (r * ln z)) has_real_derivative r * z powr (r - 1)) (at z)"
  2953     by (auto intro!: derivative_eq_intros simp: powr_def field_simps exp_diff)
  2954 qed
  2955 
  2956 declare has_real_derivative_powr[THEN DERIV_chain2, derivative_intros]
  2957 
  2958 lemma tendsto_zero_powrI:
  2959   assumes "(f \<longlongrightarrow> (0::real)) F" "(g \<longlongrightarrow> b) F" "\<forall>\<^sub>F x in F. 0 \<le> f x" "0 < b"
  2960   shows "((\<lambda>x. f x powr g x) \<longlongrightarrow> 0) F"
  2961   using tendsto_powr2[OF assms] by simp
  2962 
  2963 lemma continuous_on_powr':
  2964   fixes f g :: "_ \<Rightarrow> real"
  2965   assumes "continuous_on s f" "continuous_on s g"
  2966     and "\<forall>x\<in>s. f x \<ge> 0 \<and> (f x = 0 \<longrightarrow> g x > 0)"
  2967   shows "continuous_on s (\<lambda>x. (f x) powr (g x))"
  2968   unfolding continuous_on_def
  2969 proof
  2970   fix x
  2971   assume x: "x \<in> s"
  2972   from assms x show "((\<lambda>x. f x powr g x) \<longlongrightarrow> f x powr g x) (at x within s)"
  2973   proof (cases "f x = 0")
  2974     case True
  2975     from assms(3) have "eventually (\<lambda>x. f x \<ge> 0) (at x within s)"
  2976       by (auto simp: at_within_def eventually_inf_principal)
  2977     with True x assms show ?thesis
  2978       by (auto intro!: tendsto_zero_powrI[of f _ g "g x"] simp: continuous_on_def)
  2979   next
  2980     case False
  2981     with assms x show ?thesis
  2982       by (auto intro!: tendsto_powr' simp: continuous_on_def)
  2983   qed
  2984 qed
  2985 
  2986 lemma tendsto_neg_powr:
  2987   assumes "s < 0"
  2988     and f: "LIM x F. f x :> at_top"
  2989   shows "((\<lambda>x. f x powr s) \<longlongrightarrow> (0::real)) F"
  2990 proof -
  2991   have "((\<lambda>x. exp (s * ln (f x))) \<longlongrightarrow> (0::real)) F" (is "?X")
  2992     by (auto intro!: filterlim_compose[OF exp_at_bot] filterlim_compose[OF ln_at_top]
  2993         filterlim_tendsto_neg_mult_at_bot assms)
  2994   also have "?X \<longleftrightarrow> ((\<lambda>x. f x powr s) \<longlongrightarrow> (0::real)) F"
  2995     using f filterlim_at_top_dense[of f F]
  2996     by (intro filterlim_cong[OF refl refl]) (auto simp: neq_iff powr_def elim: eventually_mono)
  2997   finally show ?thesis .
  2998 qed
  2999 
  3000 lemma tendsto_exp_limit_at_right: "((\<lambda>y. (1 + x * y) powr (1 / y)) \<longlongrightarrow> exp x) (at_right 0)"
  3001   for x :: real
  3002 proof (cases "x = 0")
  3003   case True
  3004   then show ?thesis by simp
  3005 next
  3006   case False
  3007   have "((\<lambda>y. ln (1 + x * y)::real) has_real_derivative 1 * x) (at 0)"
  3008     by (auto intro!: derivative_eq_intros)
  3009   then have "((\<lambda>y. ln (1 + x * y) / y) \<longlongrightarrow> x) (at 0)"
  3010     by (auto simp add: has_field_derivative_def field_has_derivative_at)
  3011   then have *: "((\<lambda>y. exp (ln (1 + x * y) / y)) \<longlongrightarrow> exp x) (at 0)"
  3012     by (rule tendsto_intros)
  3013   then show ?thesis
  3014   proof (rule filterlim_mono_eventually)
  3015     show "eventually (\<lambda>xa. exp (ln (1 + x * xa) / xa) = (1 + x * xa) powr (1 / xa)) (at_right 0)"
  3016       unfolding eventually_at_right[OF zero_less_one]
  3017       using False
  3018       apply (intro exI[of _ "1 / \<bar>x\<bar>"])
  3019       apply (auto simp: field_simps powr_def abs_if)
  3020       apply (metis add_less_same_cancel1 mult_less_0_iff not_less_iff_gr_or_eq zero_less_one)
  3021       done
  3022   qed (simp_all add: at_eq_sup_left_right)
  3023 qed
  3024 
  3025 lemma tendsto_exp_limit_at_top: "((\<lambda>y. (1 + x / y) powr y) \<longlongrightarrow> exp x) at_top"
  3026   for x :: real
  3027   apply (subst filterlim_at_top_to_right)
  3028   apply (simp add: inverse_eq_divide)
  3029   apply (rule tendsto_exp_limit_at_right)
  3030   done
  3031 
  3032 lemma tendsto_exp_limit_sequentially: "(\<lambda>n. (1 + x / n) ^ n) \<longlonglongrightarrow> exp x"
  3033   for x :: real
  3034 proof (rule filterlim_mono_eventually)
  3035   from reals_Archimedean2 [of "\<bar>x\<bar>"] obtain n :: nat where *: "real n > \<bar>x\<bar>" ..
  3036   then have "eventually (\<lambda>n :: nat. 0 < 1 + x / real n) at_top"
  3037     apply (intro eventually_sequentiallyI [of n])
  3038     apply (cases "x \<ge> 0")
  3039      apply (rule add_pos_nonneg)
  3040       apply (auto intro: divide_nonneg_nonneg)
  3041     apply (subgoal_tac "x / real xa > - 1")
  3042      apply (auto simp add: field_simps)
  3043     done
  3044   then show "eventually (\<lambda>n. (1 + x / n) powr n = (1 + x / n) ^ n) at_top"
  3045     by (rule eventually_mono) (erule powr_realpow)
  3046   show "(\<lambda>n. (1 + x / real n) powr real n) \<longlonglongrightarrow> exp x"
  3047     by (rule filterlim_compose [OF tendsto_exp_limit_at_top filterlim_real_sequentially])
  3048 qed auto
  3049 
  3050 
  3051 subsection \<open>Sine and Cosine\<close>
  3052 
  3053 definition sin_coeff :: "nat \<Rightarrow> real"
  3054   where "sin_coeff = (\<lambda>n. if even n then 0 else (- 1) ^ ((n - Suc 0) div 2) / (fact n))"
  3055 
  3056 definition cos_coeff :: "nat \<Rightarrow> real"
  3057   where "cos_coeff = (\<lambda>n. if even n then ((- 1) ^ (n div 2)) / (fact n) else 0)"
  3058 
  3059 definition sin :: "'a \<Rightarrow> 'a::{real_normed_algebra_1,banach}"
  3060   where "sin = (\<lambda>x. \<Sum>n. sin_coeff n *\<^sub>R x^n)"
  3061 
  3062 definition cos :: "'a \<Rightarrow> 'a::{real_normed_algebra_1,banach}"
  3063   where "cos = (\<lambda>x. \<Sum>n. cos_coeff n *\<^sub>R x^n)"
  3064 
  3065 lemma sin_coeff_0 [simp]: "sin_coeff 0 = 0"
  3066   unfolding sin_coeff_def by simp
  3067 
  3068 lemma cos_coeff_0 [simp]: "cos_coeff 0 = 1"
  3069   unfolding cos_coeff_def by simp
  3070 
  3071 lemma sin_coeff_Suc: "sin_coeff (Suc n) = cos_coeff n / real (Suc n)"
  3072   unfolding cos_coeff_def sin_coeff_def
  3073   by (simp del: mult_Suc)
  3074 
  3075 lemma cos_coeff_Suc: "cos_coeff (Suc n) = - sin_coeff n / real (Suc n)"
  3076   unfolding cos_coeff_def sin_coeff_def
  3077   by (simp del: mult_Suc) (auto elim: oddE)
  3078 
  3079 lemma summable_norm_sin: "summable (\<lambda>n. norm (sin_coeff n *\<^sub>R x^n))"
  3080   for x :: "'a::{real_normed_algebra_1,banach}"
  3081   unfolding sin_coeff_def
  3082   apply (rule summable_comparison_test [OF _ summable_norm_exp [where x=x]])
  3083   apply (auto simp: divide_inverse abs_mult power_abs [symmetric] zero_le_mult_iff)
  3084   done
  3085 
  3086 lemma summable_norm_cos: "summable (\<lambda>n. norm (cos_coeff n *\<^sub>R x^n))"
  3087   for x :: "'a::{real_normed_algebra_1,banach}"
  3088   unfolding cos_coeff_def
  3089   apply (rule summable_comparison_test [OF _ summable_norm_exp [where x=x]])
  3090   apply (auto simp: divide_inverse abs_mult power_abs [symmetric] zero_le_mult_iff)
  3091   done
  3092 
  3093 lemma sin_converges: "(\<lambda>n. sin_coeff n *\<^sub>R x^n) sums sin x"
  3094   unfolding sin_def
  3095   by (metis (full_types) summable_norm_cancel summable_norm_sin summable_sums)
  3096 
  3097 lemma cos_converges: "(\<lambda>n. cos_coeff n *\<^sub>R x^n) sums cos x"
  3098   unfolding cos_def
  3099   by (metis (full_types) summable_norm_cancel summable_norm_cos summable_sums)
  3100 
  3101 lemma sin_of_real: "sin (of_real x) = of_real (sin x)"
  3102   for x :: real
  3103 proof -
  3104   have "(\<lambda>n. of_real (sin_coeff n *\<^sub>R  x^n)) = (\<lambda>n. sin_coeff n *\<^sub>R  (of_real x)^n)"
  3105   proof
  3106     show "of_real (sin_coeff n *\<^sub>R  x^n) = sin_coeff n *\<^sub>R of_real x^n" for n
  3107       by (simp add: scaleR_conv_of_real)
  3108   qed
  3109   also have "\<dots> sums (sin (of_real x))"
  3110     by (rule sin_converges)
  3111   finally have "(\<lambda>n. of_real (sin_coeff n *\<^sub>R x^n)) sums (sin (of_real x))" .
  3112   then show ?thesis
  3113     using sums_unique2 sums_of_real [OF sin_converges]
  3114     by blast
  3115 qed
  3116 
  3117 corollary sin_in_Reals [simp]: "z \<in> \<real> \<Longrightarrow> sin z \<in> \<real>"
  3118   by (metis Reals_cases Reals_of_real sin_of_real)
  3119 
  3120 lemma cos_of_real: "cos (of_real x) = of_real (cos x)"
  3121   for x :: real
  3122 proof -
  3123   have "(\<lambda>n. of_real (cos_coeff n *\<^sub>R  x^n)) = (\<lambda>n. cos_coeff n *\<^sub>R  (of_real x)^n)"
  3124   proof
  3125     show "of_real (cos_coeff n *\<^sub>R  x^n) = cos_coeff n *\<^sub>R of_real x^n" for n
  3126       by (simp add: scaleR_conv_of_real)
  3127   qed
  3128   also have "\<dots> sums (cos (of_real x))"
  3129     by (rule cos_converges)
  3130   finally have "(\<lambda>n. of_real (cos_coeff n *\<^sub>R x^n)) sums (cos (of_real x))" .
  3131   then show ?thesis
  3132     using sums_unique2 sums_of_real [OF cos_converges]
  3133     by blast
  3134 qed
  3135 
  3136 corollary cos_in_Reals [simp]: "z \<in> \<real> \<Longrightarrow> cos z \<in> \<real>"
  3137   by (metis Reals_cases Reals_of_real cos_of_real)
  3138 
  3139 lemma diffs_sin_coeff: "diffs sin_coeff = cos_coeff"
  3140   by (simp add: diffs_def sin_coeff_Suc del: of_nat_Suc)
  3141 
  3142 lemma diffs_cos_coeff: "diffs cos_coeff = (\<lambda>n. - sin_coeff n)"
  3143   by (simp add: diffs_def cos_coeff_Suc del: of_nat_Suc)
  3144 
  3145 text \<open>Now at last we can get the derivatives of exp, sin and cos.\<close>
  3146 
  3147 lemma DERIV_sin [simp]: "DERIV sin x :> cos x"
  3148   for x :: "'a::{real_normed_field,banach}"
  3149   unfolding sin_def cos_def scaleR_conv_of_real
  3150   apply (rule DERIV_cong)
  3151    apply (rule termdiffs [where K="of_real (norm x) + 1 :: 'a"])
  3152       apply (simp_all add: norm_less_p1 diffs_of_real diffs_sin_coeff diffs_cos_coeff
  3153               summable_minus_iff scaleR_conv_of_real [symmetric]
  3154               summable_norm_sin [THEN summable_norm_cancel]
  3155               summable_norm_cos [THEN summable_norm_cancel])
  3156   done
  3157 
  3158 declare DERIV_sin[THEN DERIV_chain2, derivative_intros]
  3159   and DERIV_sin[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]
  3160 
  3161 lemma DERIV_cos [simp]: "DERIV cos x :> - sin x"
  3162   for x :: "'a::{real_normed_field,banach}"
  3163   unfolding sin_def cos_def scaleR_conv_of_real
  3164   apply (rule DERIV_cong)
  3165    apply (rule termdiffs [where K="of_real (norm x) + 1 :: 'a"])
  3166       apply (simp_all add: norm_less_p1 diffs_of_real diffs_minus suminf_minus
  3167               diffs_sin_coeff diffs_cos_coeff
  3168               summable_minus_iff scaleR_conv_of_real [symmetric]
  3169               summable_norm_sin [THEN summable_norm_cancel]
  3170               summable_norm_cos [THEN summable_norm_cancel])
  3171   done
  3172 
  3173 declare DERIV_cos[THEN DERIV_chain2, derivative_intros]
  3174   and DERIV_cos[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]
  3175 
  3176 lemma isCont_sin: "isCont sin x"
  3177   for x :: "'a::{real_normed_field,banach}"
  3178   by (rule DERIV_sin [THEN DERIV_isCont])
  3179 
  3180 lemma isCont_cos: "isCont cos x"
  3181   for x :: "'a::{real_normed_field,banach}"
  3182   by (rule DERIV_cos [THEN DERIV_isCont])
  3183 
  3184 lemma isCont_sin' [simp]: "isCont f a \<Longrightarrow> isCont (\<lambda>x. sin (f x)) a"
  3185   for f :: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  3186   by (rule isCont_o2 [OF _ isCont_sin])
  3187 
  3188 (* FIXME a context for f would be better *)
  3189 
  3190 lemma isCont_cos' [simp]: "isCont f a \<Longrightarrow> isCont (\<lambda>x. cos (f x)) a"
  3191   for f :: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  3192   by (rule isCont_o2 [OF _ isCont_cos])
  3193 
  3194 lemma tendsto_sin [tendsto_intros]: "(f \<longlongrightarrow> a) F \<Longrightarrow> ((\<lambda>x. sin (f x)) \<longlongrightarrow> sin a) F"
  3195   for f :: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  3196   by (rule isCont_tendsto_compose [OF isCont_sin])
  3197 
  3198 lemma tendsto_cos [tendsto_intros]: "(f \<longlongrightarrow> a) F \<Longrightarrow> ((\<lambda>x. cos (f x)) \<longlongrightarrow> cos a) F"
  3199   for f :: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  3200   by (rule isCont_tendsto_compose [OF isCont_cos])
  3201 
  3202 lemma continuous_sin [continuous_intros]: "continuous F f \<Longrightarrow> continuous F (\<lambda>x. sin (f x))"
  3203   for f :: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  3204   unfolding continuous_def by (rule tendsto_sin)
  3205 
  3206 lemma continuous_on_sin [continuous_intros]: "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. sin (f x))"
  3207   for f :: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  3208   unfolding continuous_on_def by (auto intro: tendsto_sin)
  3209 
  3210 lemma continuous_within_sin: "continuous (at z within s) sin"
  3211   for z :: "'a::{real_normed_field,banach}"
  3212   by (simp add: continuous_within tendsto_sin)
  3213 
  3214 lemma continuous_cos [continuous_intros]: "continuous F f \<Longrightarrow> continuous F (\<lambda>x. cos (f x))"
  3215   for f :: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  3216   unfolding continuous_def by (rule tendsto_cos)
  3217 
  3218 lemma continuous_on_cos [continuous_intros]: "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. cos (f x))"
  3219   for f :: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  3220   unfolding continuous_on_def by (auto intro: tendsto_cos)
  3221 
  3222 lemma continuous_within_cos: "continuous (at z within s) cos"
  3223   for z :: "'a::{real_normed_field,banach}"
  3224   by (simp add: continuous_within tendsto_cos)
  3225 
  3226 
  3227 subsection \<open>Properties of Sine and Cosine\<close>
  3228 
  3229 lemma sin_zero [simp]: "sin 0 = 0"
  3230   by (simp add: sin_def sin_coeff_def scaleR_conv_of_real)
  3231 
  3232 lemma cos_zero [simp]: "cos 0 = 1"
  3233   by (simp add: cos_def cos_coeff_def scaleR_conv_of_real)
  3234 
  3235 lemma DERIV_fun_sin: "DERIV g x :> m \<Longrightarrow> DERIV (\<lambda>x. sin (g x)) x :> cos (g x) * m"
  3236   by (auto intro!: derivative_intros)
  3237 
  3238 lemma DERIV_fun_cos: "DERIV g x :> m \<Longrightarrow> DERIV (\<lambda>x. cos(g x)) x :> - sin (g x) * m"
  3239   by (auto intro!: derivative_eq_intros)
  3240 
  3241 
  3242 subsection \<open>Deriving the Addition Formulas\<close>
  3243 
  3244 text \<open>The product of two cosine series.\<close>
  3245 lemma cos_x_cos_y:
  3246   fixes x :: "'a::{real_normed_field,banach}"
  3247   shows
  3248     "(\<lambda>p. \<Sum>n\<le>p.
  3249         if even p \<and> even n
  3250         then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0)
  3251       sums (cos x * cos y)"
  3252 proof -
  3253   have "(cos_coeff n * cos_coeff (p - n)) *\<^sub>R (x^n * y^(p - n)) =
  3254     (if even p \<and> even n then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p - n)
  3255      else 0)"
  3256     if "n \<le> p" for n p :: nat
  3257   proof -
  3258     from that have *: "even n \<Longrightarrow> even p \<Longrightarrow>
  3259         (-1) ^ (n div 2) * (-1) ^ ((p - n) div 2) = (-1 :: real) ^ (p div 2)"
  3260       by (metis div_add power_add le_add_diff_inverse odd_add)
  3261     with that show ?thesis
  3262       by (auto simp: algebra_simps cos_coeff_def binomial_fact)
  3263   qed
  3264   then have "(\<lambda>p. \<Sum>n\<le>p. if even p \<and> even n
  3265                   then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0) =
  3266              (\<lambda>p. \<Sum>n\<le>p. (cos_coeff n * cos_coeff (p - n)) *\<^sub>R (x^n * y^(p-n)))"
  3267     by simp
  3268   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)))"
  3269     by (simp add: algebra_simps)
  3270   also have "\<dots> sums (cos x * cos y)"
  3271     using summable_norm_cos
  3272     by (auto simp: cos_def scaleR_conv_of_real intro!: Cauchy_product_sums)
  3273   finally show ?thesis .
  3274 qed
  3275 
  3276 text \<open>The product of two sine series.\<close>
  3277 lemma sin_x_sin_y:
  3278   fixes x :: "'a::{real_normed_field,banach}"
  3279   shows
  3280     "(\<lambda>p. \<Sum>n\<le>p.
  3281         if even p \<and> odd n
  3282         then - ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n)
  3283         else 0)
  3284       sums (sin x * sin y)"
  3285 proof -
  3286   have "(sin_coeff n * sin_coeff (p - n)) *\<^sub>R (x^n * y^(p-n)) =
  3287     (if even p \<and> odd n
  3288      then -((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n)
  3289      else 0)"
  3290     if "n \<le> p" for n p :: nat
  3291   proof -
  3292     have "(-1) ^ ((n - Suc 0) div 2) * (-1) ^ ((p - Suc n) div 2) = - ((-1 :: real) ^ (p div 2))"
  3293       if np: "odd n" "even p"
  3294     proof -
  3295       from \<open>n \<le> p\<close> np have *: "n - Suc 0 + (p - Suc n) = p - Suc (Suc 0)" "Suc (Suc 0) \<le> p"
  3296         by arith+
  3297       have "(p - Suc (Suc 0)) div 2 = p div 2 - Suc 0"
  3298         by simp
  3299       with \<open>n \<le> p\<close> np * show ?thesis
  3300         apply (simp add: power_add [symmetric] div_add [symmetric] del: div_add)
  3301         apply (metis (no_types) One_nat_def Suc_1 le_div_geq minus_minus
  3302             mult.left_neutral mult_minus_left power.simps(2) zero_less_Suc)
  3303         done
  3304     qed
  3305     then show ?thesis
  3306       using \<open>n\<le>p\<close> by (auto simp: algebra_simps sin_coeff_def binomial_fact)
  3307   qed
  3308   then have "(\<lambda>p. \<Sum>n\<le>p. if even p \<and> odd n
  3309                then - ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0) =
  3310              (\<lambda>p. \<Sum>n\<le>p. (sin_coeff n * sin_coeff (p - n)) *\<^sub>R (x^n * y^(p-n)))"
  3311     by simp
  3312   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)))"
  3313     by (simp add: algebra_simps)
  3314   also have "\<dots> sums (sin x * sin y)"
  3315     using summable_norm_sin
  3316     by (auto simp: sin_def scaleR_conv_of_real intro!: Cauchy_product_sums)
  3317   finally show ?thesis .
  3318 qed
  3319 
  3320 lemma sums_cos_x_plus_y:
  3321   fixes x :: "'a::{real_normed_field,banach}"
  3322   shows
  3323     "(\<lambda>p. \<Sum>n\<le>p.
  3324         if even p
  3325         then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n)
  3326         else 0)
  3327       sums cos (x + y)"
  3328 proof -
  3329   have
  3330     "(\<Sum>n\<le>p.
  3331       if even p then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n)
  3332       else 0) = cos_coeff p *\<^sub>R ((x + y) ^ p)"
  3333     for p :: nat
  3334   proof -
  3335     have
  3336       "(\<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) =
  3337        (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)"
  3338       by simp
  3339     also have "\<dots> =
  3340        (if even p
  3341         then of_real ((-1) ^ (p div 2) / (fact p)) * (\<Sum>n\<le>p. (p choose n) *\<^sub>R (x^n) * y^(p-n))
  3342         else 0)"
  3343       by (auto simp: setsum_right_distrib field_simps scaleR_conv_of_real nonzero_of_real_divide)
  3344     also have "\<dots> = cos_coeff p *\<^sub>R ((x + y) ^ p)"
  3345       by (simp add: cos_coeff_def binomial_ring [of x y]  scaleR_conv_of_real atLeast0AtMost)
  3346     finally show ?thesis .
  3347   qed
  3348   then have
  3349     "(\<lambda>p. \<Sum>n\<le>p.
  3350         if even p
  3351         then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n)
  3352         else 0) = (\<lambda>p. cos_coeff p *\<^sub>R ((x+y)^p))"
  3353     by simp
  3354    also have "\<dots> sums cos (x + y)"
  3355     by (rule cos_converges)
  3356    finally show ?thesis .
  3357 qed
  3358 
  3359 theorem cos_add:
  3360   fixes x :: "'a::{real_normed_field,banach}"
  3361   shows "cos (x + y) = cos x * cos y - sin x * sin y"
  3362 proof -
  3363   have
  3364     "(if even p \<and> even n
  3365       then ((- 1) ^ (p div 2) * int (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0) -
  3366      (if even p \<and> odd n
  3367       then - ((- 1) ^ (p div 2) * int (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0) =
  3368      (if even p then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0)"
  3369     if "n \<le> p" for n p :: nat
  3370     by simp
  3371   then have
  3372     "(\<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))
  3373       sums (cos x * cos y - sin x * sin y)"
  3374     using sums_diff [OF cos_x_cos_y [of x y] sin_x_sin_y [of x y]]
  3375     by (simp add: setsum_subtractf [symmetric])
  3376   then show ?thesis
  3377     by (blast intro: sums_cos_x_plus_y sums_unique2)
  3378 qed
  3379 
  3380 lemma sin_minus_converges: "(\<lambda>n. - (sin_coeff n *\<^sub>R (-x)^n)) sums sin x"
  3381 proof -
  3382   have [simp]: "\<And>n. - (sin_coeff n *\<^sub>R (-x)^n) = (sin_coeff n *\<^sub>R x^n)"
  3383     by (auto simp: sin_coeff_def elim!: oddE)
  3384   show ?thesis
  3385     by (simp add: sin_def summable_norm_sin [THEN summable_norm_cancel, THEN summable_sums])
  3386 qed
  3387 
  3388 lemma sin_minus [simp]: "sin (- x) = - sin x"
  3389   for x :: "'a::{real_normed_algebra_1,banach}"
  3390   using sin_minus_converges [of x]
  3391   by (auto simp: sin_def summable_norm_sin [THEN summable_norm_cancel]
  3392       suminf_minus sums_iff equation_minus_iff)
  3393 
  3394 lemma cos_minus_converges: "(\<lambda>n. (cos_coeff n *\<^sub>R (-x)^n)) sums cos x"
  3395 proof -
  3396   have [simp]: "\<And>n. (cos_coeff n *\<^sub>R (-x)^n) = (cos_coeff n *\<^sub>R x^n)"
  3397     by (auto simp: Transcendental.cos_coeff_def elim!: evenE)
  3398   show ?thesis
  3399     by (simp add: cos_def summable_norm_cos [THEN summable_norm_cancel, THEN summable_sums])
  3400 qed
  3401 
  3402 lemma cos_minus [simp]: "cos (-x) = cos x"
  3403   for x :: "'a::{real_normed_algebra_1,banach}"
  3404   using cos_minus_converges [of x]
  3405   by (simp add: cos_def summable_norm_cos [THEN summable_norm_cancel]
  3406       suminf_minus sums_iff equation_minus_iff)
  3407 
  3408 lemma sin_cos_squared_add [simp]: "(sin x)\<^sup>2 + (cos x)\<^sup>2 = 1"
  3409   for x :: "'a::{real_normed_field,banach}"
  3410   using cos_add [of x "-x"]
  3411   by (simp add: power2_eq_square algebra_simps)
  3412 
  3413 lemma sin_cos_squared_add2 [simp]: "(cos x)\<^sup>2 + (sin x)\<^sup>2 = 1"
  3414   for x :: "'a::{real_normed_field,banach}"
  3415   by (subst add.commute, rule sin_cos_squared_add)
  3416 
  3417 lemma sin_cos_squared_add3 [simp]: "cos x * cos x + sin x * sin x = 1"
  3418   for x :: "'a::{real_normed_field,banach}"
  3419   using sin_cos_squared_add2 [unfolded power2_eq_square] .
  3420 
  3421 lemma sin_squared_eq: "(sin x)\<^sup>2 = 1 - (cos x)\<^sup>2"
  3422   for x :: "'a::{real_normed_field,banach}"
  3423   unfolding eq_diff_eq by (rule sin_cos_squared_add)
  3424 
  3425 lemma cos_squared_eq: "(cos x)\<^sup>2 = 1 - (sin x)\<^sup>2"
  3426   for x :: "'a::{real_normed_field,banach}"
  3427   unfolding eq_diff_eq by (rule sin_cos_squared_add2)
  3428 
  3429 lemma abs_sin_le_one [simp]: "\<bar>sin x\<bar> \<le> 1"
  3430   for x :: real
  3431   by (rule power2_le_imp_le) (simp_all add: sin_squared_eq)
  3432 
  3433 lemma sin_ge_minus_one [simp]: "- 1 \<le> sin x"
  3434   for x :: real
  3435   using abs_sin_le_one [of x] by (simp add: abs_le_iff)
  3436 
  3437 lemma sin_le_one [simp]: "sin x \<le> 1"
  3438   for x :: real
  3439   using abs_sin_le_one [of x] by (simp add: abs_le_iff)
  3440 
  3441 lemma abs_cos_le_one [simp]: "\<bar>cos x\<bar> \<le> 1"
  3442   for x :: real
  3443   by (rule power2_le_imp_le) (simp_all add: cos_squared_eq)
  3444 
  3445 lemma cos_ge_minus_one [simp]: "- 1 \<le> cos x"
  3446   for x :: real
  3447   using abs_cos_le_one [of x] by (simp add: abs_le_iff)
  3448 
  3449 lemma cos_le_one [simp]: "cos x \<le> 1"
  3450   for x :: real
  3451   using abs_cos_le_one [of x] by (simp add: abs_le_iff)
  3452 
  3453 lemma cos_diff: "cos (x - y) = cos x * cos y + sin x * sin y"
  3454   for x :: "'a::{real_normed_field,banach}"
  3455   using cos_add [of x "- y"] by simp
  3456 
  3457 lemma cos_double: "cos(2*x) = (cos x)\<^sup>2 - (sin x)\<^sup>2"
  3458   for x :: "'a::{real_normed_field,banach}"
  3459   using cos_add [where x=x and y=x] by (simp add: power2_eq_square)
  3460 
  3461 lemma sin_cos_le1: "\<bar>sin x * sin y + cos x * cos y\<bar> \<le> 1"
  3462   for x :: real
  3463   using cos_diff [of x y] by (metis abs_cos_le_one add.commute)
  3464 
  3465 lemma DERIV_fun_pow: "DERIV g x :> m \<Longrightarrow> DERIV (\<lambda>x. (g x) ^ n) x :> real n * (g x) ^ (n - 1) * m"
  3466   by (auto intro!: derivative_eq_intros simp:)
  3467 
  3468 lemma DERIV_fun_exp: "DERIV g x :> m \<Longrightarrow> DERIV (\<lambda>x. exp (g x)) x :> exp (g x) * m"
  3469   by (auto intro!: derivative_intros)
  3470 
  3471 
  3472 subsection \<open>The Constant Pi\<close>
  3473 
  3474 definition pi :: real
  3475   where "pi = 2 * (THE x. 0 \<le> x \<and> x \<le> 2 \<and> cos x = 0)"
  3476 
  3477 text \<open>Show that there's a least positive @{term x} with @{term "cos x = 0"};
  3478    hence define pi.\<close>
  3479 
  3480 lemma sin_paired: "(\<lambda>n. (- 1) ^ n / (fact (2 * n + 1)) * x ^ (2 * n + 1)) sums  sin x"
  3481   for x :: real
  3482 proof -
  3483   have "(\<lambda>n. \<Sum>k = n*2..<n * 2 + 2. sin_coeff k * x ^ k) sums sin x"
  3484     by (rule sums_group) (use sin_converges [of x, unfolded scaleR_conv_of_real] in auto)
  3485   then show ?thesis
  3486     by (simp add: sin_coeff_def ac_simps)
  3487 qed
  3488 
  3489 lemma sin_gt_zero_02:
  3490   fixes x :: real
  3491   assumes "0 < x" and "x < 2"
  3492   shows "0 < sin x"
  3493 proof -
  3494   let ?f = "\<lambda>n::nat. \<Sum>k = n*2..<n*2+2. (- 1) ^ k / (fact (2*k+1)) * x^(2*k+1)"
  3495   have pos: "\<forall>n. 0 < ?f n"
  3496   proof
  3497     fix n :: nat
  3498     let ?k2 = "real (Suc (Suc (4 * n)))"
  3499     let ?k3 = "real (Suc (Suc (Suc (4 * n))))"
  3500     have "x * x < ?k2 * ?k3"
  3501       using assms by (intro mult_strict_mono', simp_all)
  3502     then have "x * x * x * x ^ (n * 4) < ?k2 * ?k3 * x * x ^ (n * 4)"
  3503       by (intro mult_strict_right_mono zero_less_power \<open>0 < x\<close>)
  3504     then show "0 < ?f n"
  3505       by (simp add: divide_simps mult_ac del: mult_Suc)
  3506 qed
  3507   have sums: "?f sums sin x"
  3508     by (rule sin_paired [THEN sums_group]) simp
  3509   show "0 < sin x"
  3510     unfolding sums_unique [OF sums]
  3511     using sums_summable [OF sums] pos
  3512     by (rule suminf_pos)
  3513 qed
  3514 
  3515 lemma cos_double_less_one: "0 < x \<Longrightarrow> x < 2 \<Longrightarrow> cos (2 * x) < 1"
  3516   for x :: real
  3517   using sin_gt_zero_02 [where x = x] by (auto simp: cos_squared_eq cos_double)
  3518 
  3519 lemma cos_paired: "(\<lambda>n. (- 1) ^ n / (fact (2 * n)) * x ^ (2 * n)) sums cos x"
  3520   for x :: real
  3521 proof -
  3522   have "(\<lambda>n. \<Sum>k = n * 2..<n * 2 + 2. cos_coeff k * x ^ k) sums cos x"
  3523     by (rule sums_group) (use cos_converges [of x, unfolded scaleR_conv_of_real] in auto)
  3524   then show ?thesis
  3525     by (simp add: cos_coeff_def ac_simps)
  3526 qed
  3527 
  3528 lemmas realpow_num_eq_if = power_eq_if
  3529 
  3530 lemma sumr_pos_lt_pair:
  3531   fixes f :: "nat \<Rightarrow> real"
  3532   shows "summable f \<Longrightarrow>
  3533     (\<And>d. 0 < f (k + (Suc(Suc 0) * d)) + f (k + ((Suc (Suc 0) * d) + 1))) \<Longrightarrow>
  3534     setsum f {..<k} < suminf f"
  3535   apply (simp only: One_nat_def)
  3536   apply (subst suminf_split_initial_segment [where k=k])
  3537    apply assumption
  3538   apply simp
  3539   apply (drule_tac k=k in summable_ignore_initial_segment)
  3540   apply (drule_tac k="Suc (Suc 0)" in sums_group [OF summable_sums])
  3541    apply simp
  3542   apply simp
  3543   apply (metis (no_types, lifting) add.commute suminf_pos summable_def sums_unique)
  3544   done
  3545 
  3546 lemma cos_two_less_zero [simp]: "cos 2 < (0::real)"
  3547 proof -
  3548   note fact_Suc [simp del]
  3549   from sums_minus [OF cos_paired]
  3550   have *: "(\<lambda>n. - ((- 1) ^ n * 2 ^ (2 * n) / fact (2 * n))) sums - cos (2::real)"
  3551     by simp
  3552   then have sm: "summable (\<lambda>n. - ((- 1::real) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
  3553     by (rule sums_summable)
  3554   have "0 < (\<Sum>n<Suc (Suc (Suc 0)). - ((- 1::real) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
  3555     by (simp add: fact_num_eq_if realpow_num_eq_if)
  3556   moreover have "(\<Sum>n<Suc (Suc (Suc 0)). - ((- 1::real) ^ n  * 2 ^ (2 * n) / (fact (2 * n)))) <
  3557     (\<Sum>n. - ((- 1) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
  3558   proof -
  3559     {
  3560       fix d
  3561       let ?six4d = "Suc (Suc (Suc (Suc (Suc (Suc (4 * d))))))"
  3562       have "(4::real) * (fact (?six4d)) < (Suc (Suc (?six4d)) * fact (Suc (?six4d)))"
  3563         unfolding of_nat_mult by (rule mult_strict_mono) (simp_all add: fact_less_mono)
  3564       then have "(4::real) * (fact (?six4d)) < (fact (Suc (Suc (?six4d))))"
  3565         by (simp only: fact_Suc [of "Suc (?six4d)"] of_nat_mult of_nat_fact)
  3566       then have "(4::real) * inverse (fact (Suc (Suc (?six4d)))) < inverse (fact (?six4d))"
  3567         by (simp add: inverse_eq_divide less_divide_eq)
  3568     }
  3569     then show ?thesis
  3570       by (force intro!: sumr_pos_lt_pair [OF sm] simp add: divide_inverse algebra_simps)
  3571   qed
  3572   ultimately have "0 < (\<Sum>n. - ((- 1::real) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
  3573     by (rule order_less_trans)
  3574   moreover from * have "- cos 2 = (\<Sum>n. - ((- 1::real) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
  3575     by (rule sums_unique)
  3576   ultimately have "(0::real) < - cos 2" by simp
  3577   then show ?thesis by simp
  3578 qed
  3579 
  3580 lemmas cos_two_neq_zero [simp] = cos_two_less_zero [THEN less_imp_neq]
  3581 lemmas cos_two_le_zero [simp] = cos_two_less_zero [THEN order_less_imp_le]
  3582 
  3583 lemma cos_is_zero: "\<exists>!x::real. 0 \<le> x \<and> x \<le> 2 \<and> cos x = 0"
  3584 proof (rule ex_ex1I)
  3585   show "\<exists>x::real. 0 \<le> x \<and> x \<le> 2 \<and> cos x = 0"
  3586     by (rule IVT2) simp_all
  3587 next
  3588   fix x y :: real
  3589   assume x: "0 \<le> x \<and> x \<le> 2 \<and> cos x = 0"
  3590   assume y: "0 \<le> y \<and> y \<le> 2 \<and> cos y = 0"
  3591   have [simp]: "\<forall>x::real. cos differentiable (at x)"
  3592     unfolding real_differentiable_def by (auto intro: DERIV_cos)
  3593   from x y less_linear [of x y] show "x = y"
  3594     apply auto
  3595      apply (drule_tac f = cos in Rolle)
  3596         apply (drule_tac [5] f = cos in Rolle)
  3597            apply (auto dest!: DERIV_cos [THEN DERIV_unique])
  3598      apply (metis order_less_le_trans less_le sin_gt_zero_02)
  3599     apply (metis order_less_le_trans less_le sin_gt_zero_02)
  3600     done
  3601 qed
  3602 
  3603 lemma pi_half: "pi/2 = (THE x. 0 \<le> x \<and> x \<le> 2 \<and> cos x = 0)"
  3604   by (simp add: pi_def)
  3605 
  3606 lemma cos_pi_half [simp]: "cos (pi / 2) = 0"
  3607   by (simp add: pi_half cos_is_zero [THEN theI'])
  3608 
  3609 lemma cos_of_real_pi_half [simp]: "cos ((of_real pi / 2) :: 'a) = 0"
  3610   if "SORT_CONSTRAINT('a::{real_field,banach,real_normed_algebra_1})"
  3611   by (metis cos_pi_half cos_of_real eq_numeral_simps(4)
  3612       nonzero_of_real_divide of_real_0 of_real_numeral)
  3613 
  3614 lemma pi_half_gt_zero [simp]: "0 < pi / 2"
  3615   apply (rule order_le_neq_trans)
  3616    apply (simp add: pi_half cos_is_zero [THEN theI'])
  3617   apply (metis cos_pi_half cos_zero zero_neq_one)
  3618   done
  3619 
  3620 lemmas pi_half_neq_zero [simp] = pi_half_gt_zero [THEN less_imp_neq, symmetric]
  3621 lemmas pi_half_ge_zero [simp] = pi_half_gt_zero [THEN order_less_imp_le]
  3622 
  3623 lemma pi_half_less_two [simp]: "pi / 2 < 2"
  3624   apply (rule order_le_neq_trans)
  3625    apply (simp add: pi_half cos_is_zero [THEN theI'])
  3626   apply (metis cos_pi_half cos_two_neq_zero)
  3627   done
  3628 
  3629 lemmas pi_half_neq_two [simp] = pi_half_less_two [THEN less_imp_neq]
  3630 lemmas pi_half_le_two [simp] =  pi_half_less_two [THEN order_less_imp_le]
  3631 
  3632 lemma pi_gt_zero [simp]: "0 < pi"
  3633   using pi_half_gt_zero by simp
  3634 
  3635 lemma pi_ge_zero [simp]: "0 \<le> pi"
  3636   by (rule pi_gt_zero [THEN order_less_imp_le])
  3637 
  3638 lemma pi_neq_zero [simp]: "pi \<noteq> 0"
  3639   by (rule pi_gt_zero [THEN less_imp_neq, symmetric])
  3640 
  3641 lemma pi_not_less_zero [simp]: "\<not> pi < 0"
  3642   by (simp add: linorder_not_less)
  3643 
  3644 lemma minus_pi_half_less_zero: "-(pi/2) < 0"
  3645   by simp
  3646 
  3647 lemma m2pi_less_pi: "- (2*pi) < pi"
  3648   by simp
  3649 
  3650 lemma sin_pi_half [simp]: "sin(pi/2) = 1"
  3651   using sin_cos_squared_add2 [where x = "pi/2"]
  3652   using sin_gt_zero_02 [OF pi_half_gt_zero pi_half_less_two]
  3653   by (simp add: power2_eq_1_iff)
  3654 
  3655 lemma sin_of_real_pi_half [simp]: "sin ((of_real pi / 2) :: 'a) = 1"
  3656   if "SORT_CONSTRAINT('a::{real_field,banach,real_normed_algebra_1})"
  3657   using sin_pi_half
  3658   by (metis sin_pi_half eq_numeral_simps(4) nonzero_of_real_divide of_real_1 of_real_numeral sin_of_real)
  3659 
  3660 lemma sin_cos_eq: "sin x = cos (of_real pi / 2 - x)"
  3661   for x :: "'a::{real_normed_field,banach}"
  3662   by (simp add: cos_diff)
  3663 
  3664 lemma minus_sin_cos_eq: "- sin x = cos (x + of_real pi / 2)"
  3665   for x :: "'a::{real_normed_field,banach}"
  3666   by (simp add: cos_add nonzero_of_real_divide)
  3667 
  3668 lemma cos_sin_eq: "cos x = sin (of_real pi / 2 - x)"
  3669   for x :: "'a::{real_normed_field,banach}"
  3670   using sin_cos_eq [of "of_real pi / 2 - x"] by simp
  3671 
  3672 lemma sin_add: "sin (x + y) = sin x * cos y + cos x * sin y"
  3673   for x :: "'a::{real_normed_field,banach}"
  3674   using cos_add [of "of_real pi / 2 - x" "-y"]
  3675   by (simp add: cos_sin_eq) (simp add: sin_cos_eq)
  3676 
  3677 lemma sin_diff: "sin (x - y) = sin x * cos y - cos x * sin y"
  3678   for x :: "'a::{real_normed_field,banach}"
  3679   using sin_add [of x "- y"] by simp
  3680 
  3681 lemma sin_double: "sin(2 * x) = 2 * sin x * cos x"
  3682   for x :: "'a::{real_normed_field,banach}"
  3683   using sin_add [where x=x and y=x] by simp
  3684 
  3685 lemma cos_of_real_pi [simp]: "cos (of_real pi) = -1"
  3686   using cos_add [where x = "pi/2" and y = "pi/2"]
  3687   by (simp add: cos_of_real)
  3688 
  3689 lemma sin_of_real_pi [simp]: "sin (of_real pi) = 0"
  3690   using sin_add [where x = "pi/2" and y = "pi/2"]
  3691   by (simp add: sin_of_real)
  3692 
  3693 lemma cos_pi [simp]: "cos pi = -1"
  3694   using cos_add [where x = "pi/2" and y = "pi/2"] by simp
  3695 
  3696 lemma sin_pi [simp]: "sin pi = 0"
  3697   using sin_add [where x = "pi/2" and y = "pi/2"] by simp
  3698 
  3699 lemma sin_periodic_pi [simp]: "sin (x + pi) = - sin x"
  3700   by (simp add: sin_add)
  3701 
  3702 lemma sin_periodic_pi2 [simp]: "sin (pi + x) = - sin x"
  3703   by (simp add: sin_add)
  3704 
  3705 lemma cos_periodic_pi [simp]: "cos (x + pi) = - cos x"
  3706   by (simp add: cos_add)
  3707 
  3708 lemma cos_periodic_pi2 [simp]: "cos (pi + x) = - cos x"
  3709   by (simp add: cos_add)
  3710 
  3711 lemma sin_periodic [simp]: "sin (x + 2 * pi) = sin x"
  3712   by (simp add: sin_add sin_double cos_double)
  3713 
  3714 lemma cos_periodic [simp]: "cos (x + 2 * pi) = cos x"
  3715   by (simp add: cos_add sin_double cos_double)
  3716 
  3717 lemma cos_npi [simp]: "cos (real n * pi) = (- 1) ^ n"
  3718   by (induct n) (auto simp: distrib_right)
  3719 
  3720 lemma cos_npi2 [simp]: "cos (pi * real n) = (- 1) ^ n"
  3721   by (metis cos_npi mult.commute)
  3722 
  3723 lemma sin_npi [simp]: "sin (real n * pi) = 0"
  3724   for n :: nat
  3725   by (induct n) (auto simp: distrib_right)
  3726 
  3727 lemma sin_npi2 [simp]: "sin (pi * real n) = 0"
  3728   for n :: nat
  3729   by (simp add: mult.commute [of pi])
  3730 
  3731 lemma cos_two_pi [simp]: "cos (2 * pi) = 1"
  3732   by (simp add: cos_double)
  3733 
  3734 lemma sin_two_pi [simp]: "sin (2 * pi) = 0"
  3735   by (simp add: sin_double)
  3736 
  3737 lemma sin_times_sin: "sin w * sin z = (cos (w - z) - cos (w + z)) / 2"
  3738   for w :: "'a::{real_normed_field,banach}"
  3739   by (simp add: cos_diff cos_add)
  3740 
  3741 lemma sin_times_cos: "sin w * cos z = (sin (w + z) + sin (w - z)) / 2"
  3742   for w :: "'a::{real_normed_field,banach}"
  3743   by (simp add: sin_diff sin_add)
  3744 
  3745 lemma cos_times_sin: "cos w * sin z = (sin (w + z) - sin (w - z)) / 2"
  3746   for w :: "'a::{real_normed_field,banach}"
  3747   by (simp add: sin_diff sin_add)
  3748 
  3749 lemma cos_times_cos: "cos w * cos z = (cos (w - z) + cos (w + z)) / 2"
  3750   for w :: "'a::{real_normed_field,banach}"
  3751   by (simp add: cos_diff cos_add)
  3752 
  3753 lemma sin_plus_sin: "sin w + sin z = 2 * sin ((w + z) / 2) * cos ((w - z) / 2)"
  3754   for w :: "'a::{real_normed_field,banach,field}"  (* FIXME field should not be necessary *)
  3755   apply (simp add: mult.assoc sin_times_cos)
  3756   apply (simp add: field_simps)
  3757   done
  3758 
  3759 lemma sin_diff_sin: "sin w - sin z = 2 * sin ((w - z) / 2) * cos ((w + z) / 2)"
  3760   for w :: "'a::{real_normed_field,banach,field}"
  3761   apply (simp add: mult.assoc sin_times_cos)
  3762   apply (simp add: field_simps)
  3763   done
  3764 
  3765 lemma cos_plus_cos: "cos w + cos z = 2 * cos ((w + z) / 2) * cos ((w - z) / 2)"
  3766   for w :: "'a::{real_normed_field,banach,field}"
  3767   apply (simp add: mult.assoc cos_times_cos)
  3768   apply (simp add: field_simps)
  3769   done
  3770 
  3771 lemma cos_diff_cos: "cos w - cos z = 2 * sin ((w + z) / 2) * sin ((z - w) / 2)"
  3772   for w :: "'a::{real_normed_field,banach,field}"
  3773   apply (simp add: mult.assoc sin_times_sin)
  3774   apply (simp add: field_simps)
  3775   done
  3776 
  3777 lemma cos_double_cos: "cos (2 * z) = 2 * cos z ^ 2 - 1"
  3778   for z :: "'a::{real_normed_field,banach}"
  3779   by (simp add: cos_double sin_squared_eq)
  3780 
  3781 lemma cos_double_sin: "cos (2 * z) = 1 - 2 * sin z ^ 2"
  3782   for z :: "'a::{real_normed_field,banach}"
  3783   by (simp add: cos_double sin_squared_eq)
  3784 
  3785 lemma sin_pi_minus [simp]: "sin (pi - x) = sin x"
  3786   by (metis sin_minus sin_periodic_pi minus_minus uminus_add_conv_diff)
  3787 
  3788 lemma cos_pi_minus [simp]: "cos (pi - x) = - (cos x)"
  3789   by (metis cos_minus cos_periodic_pi uminus_add_conv_diff)
  3790 
  3791 lemma sin_minus_pi [simp]: "sin (x - pi) = - (sin x)"
  3792   by (simp add: sin_diff)
  3793 
  3794 lemma cos_minus_pi [simp]: "cos (x - pi) = - (cos x)"
  3795   by (simp add: cos_diff)
  3796 
  3797 lemma sin_2pi_minus [simp]: "sin (2 * pi - x) = - (sin x)"
  3798   by (metis sin_periodic_pi2 add_diff_eq mult_2 sin_pi_minus)
  3799 
  3800 lemma cos_2pi_minus [simp]: "cos (2 * pi - x) = cos x"
  3801   by (metis (no_types, hide_lams) cos_add cos_minus cos_two_pi sin_minus sin_two_pi
  3802       diff_0_right minus_diff_eq mult_1 mult_zero_left uminus_add_conv_diff)
  3803 
  3804 lemma sin_gt_zero2: "0 < x \<Longrightarrow> x < pi/2 \<Longrightarrow> 0 < sin x"
  3805   by (metis sin_gt_zero_02 order_less_trans pi_half_less_two)
  3806 
  3807 lemma sin_less_zero:
  3808   assumes "- pi/2 < x" and "x < 0"
  3809   shows "sin x < 0"
  3810 proof -
  3811   have "0 < sin (- x)"
  3812     using assms by (simp only: sin_gt_zero2)
  3813   then show ?thesis by simp
  3814 qed
  3815 
  3816 lemma pi_less_4: "pi < 4"
  3817   using pi_half_less_two by auto
  3818 
  3819 lemma cos_gt_zero: "0 < x \<Longrightarrow> x < pi/2 \<Longrightarrow> 0 < cos x"
  3820   by (simp add: cos_sin_eq sin_gt_zero2)
  3821 
  3822 lemma cos_gt_zero_pi: "-(pi/2) < x \<Longrightarrow> x < pi/2 \<Longrightarrow> 0 < cos x"
  3823   using cos_gt_zero [of x] cos_gt_zero [of "-x"]
  3824   by (cases rule: linorder_cases [of x 0]) auto
  3825 
  3826 lemma cos_ge_zero: "-(pi/2) \<le> x \<Longrightarrow> x \<le> pi/2 \<Longrightarrow> 0 \<le> cos x"
  3827   by (auto simp: order_le_less cos_gt_zero_pi)
  3828     (metis cos_pi_half eq_divide_eq eq_numeral_simps(4))
  3829 
  3830 lemma sin_gt_zero: "0 < x \<Longrightarrow> x < pi \<Longrightarrow> 0 < sin x"
  3831   by (simp add: sin_cos_eq cos_gt_zero_pi)
  3832 
  3833 lemma sin_lt_zero: "pi < x \<Longrightarrow> x < 2 * pi \<Longrightarrow> sin x < 0"
  3834   using sin_gt_zero [of "x - pi"]
  3835   by (simp add: sin_diff)
  3836 
  3837 lemma pi_ge_two: "2 \<le> pi"
  3838 proof (rule ccontr)
  3839   assume "\<not> ?thesis"
  3840   then have "pi < 2" by auto
  3841   have "\<exists>y > pi. y < 2 \<and> y < 2 * pi"
  3842   proof (cases "2 < 2 * pi")
  3843     case True
  3844     with dense[OF \<open>pi < 2\<close>] show ?thesis by auto
  3845   next
  3846     case False
  3847     have "pi < 2 * pi" by auto
  3848     from dense[OF this] and False show ?thesis by auto
  3849   qed
  3850   then obtain y where "pi < y" and "y < 2" and "y < 2 * pi"
  3851     by blast
  3852   then have "0 < sin y"
  3853     using sin_gt_zero_02 by auto
  3854   moreover have "sin y < 0"
  3855     using sin_gt_zero[of "y - pi"] \<open>pi < y\<close> and \<open>y < 2 * pi\<close> sin_periodic_pi[of "y - pi"]
  3856     by auto
  3857   ultimately show False by auto
  3858 qed
  3859 
  3860 lemma sin_ge_zero: "0 \<le> x \<Longrightarrow> x \<le> pi \<Longrightarrow> 0 \<le> sin x"
  3861   by (auto simp: order_le_less sin_gt_zero)
  3862 
  3863 lemma sin_le_zero: "pi \<le> x \<Longrightarrow> x < 2 * pi \<Longrightarrow> sin x \<le> 0"
  3864   using sin_ge_zero [of "x - pi"] by (simp add: sin_diff)
  3865 
  3866 lemma sin_pi_divide_n_ge_0 [simp]:
  3867   assumes "n \<noteq> 0"
  3868   shows "0 \<le> sin (pi / real n)"
  3869   by (rule sin_ge_zero) (use assms in \<open>simp_all add: divide_simps\<close>)
  3870 
  3871 lemma sin_pi_divide_n_gt_0:
  3872   assumes "2 \<le> n"
  3873   shows "0 < sin (pi / real n)"
  3874   by (rule sin_gt_zero) (use assms in \<open>simp_all add: divide_simps\<close>)
  3875 
  3876 (* FIXME: This proof is almost identical to lemma \<open>cos_is_zero\<close>.
  3877    It should be possible to factor out some of the common parts. *)
  3878 lemma cos_total:
  3879   assumes y: "- 1 \<le> y" "y \<le> 1"
  3880   shows "\<exists>!x. 0 \<le> x \<and> x \<le> pi \<and> cos x = y"
  3881 proof (rule ex_ex1I)
  3882   show "\<exists>x. 0 \<le> x \<and> x \<le> pi \<and> cos x = y"
  3883     by (rule IVT2) (simp_all add: y)
  3884 next
  3885   fix a b
  3886   assume a: "0 \<le> a \<and> a \<le> pi \<and> cos a = y"
  3887   assume b: "0 \<le> b \<and> b \<le> pi \<and> cos b = y"
  3888   have [simp]: "\<forall>x::real. cos differentiable (at x)"
  3889     unfolding real_differentiable_def by (auto intro: DERIV_cos)
  3890   from a b less_linear [of a b] show "a = b"
  3891     apply auto
  3892      apply (drule_tac f = cos in Rolle)
  3893         apply (drule_tac [5] f = cos in Rolle)
  3894            apply (auto dest!: DERIV_cos [THEN DERIV_unique])
  3895      apply (metis order_less_le_trans less_le sin_gt_zero)
  3896     apply (metis order_less_le_trans less_le sin_gt_zero)
  3897     done
  3898 qed
  3899 
  3900 lemma sin_total:
  3901   assumes y: "-1 \<le> y" "y \<le> 1"
  3902   shows "\<exists>!x. - (pi/2) \<le> x \<and> x \<le> pi/2 \<and> sin x = y"
  3903 proof -
  3904   from cos_total [OF y]
  3905   obtain x where x: "0 \<le> x" "x \<le> pi" "cos x = y"
  3906     and uniq: "\<And>x'. 0 \<le> x' \<Longrightarrow> x' \<le> pi \<Longrightarrow> cos x' = y \<Longrightarrow> x' = x "
  3907     by blast
  3908   show ?thesis
  3909     apply (simp add: sin_cos_eq)
  3910     apply (rule ex1I [where a="pi/2 - x"])
  3911      apply (cut_tac [2] x'="pi/2 - xa" in uniq)
  3912     using x
  3913         apply auto
  3914     done
  3915 qed
  3916 
  3917 lemma cos_zero_lemma:
  3918   assumes "0 \<le> x" "cos x = 0"
  3919   shows "\<exists>n. odd n \<and> x = of_nat n * (pi/2) \<and> n > 0"
  3920 proof -
  3921   have xle: "x < (1 + real_of_int \<lfloor>x/pi\<rfloor>) * pi"
  3922     using floor_correct [of "x/pi"]
  3923     by (simp add: add.commute divide_less_eq)
  3924   obtain n where "real n * pi \<le> x" "x < real (Suc n) * pi"
  3925     apply (rule that [of "nat \<lfloor>x/pi\<rfloor>"])
  3926     using assms
  3927      apply (simp_all add: xle)
  3928     apply (metis floor_less_iff less_irrefl mult_imp_div_pos_less not_le pi_gt_zero)
  3929     done
  3930   then have x: "0 \<le> x - n * pi" "(x - n * pi) \<le> pi" "cos (x - n * pi) = 0"
  3931     by (auto simp: algebra_simps cos_diff assms)
  3932   then have "\<exists>!x. 0 \<le> x \<and> x \<le> pi \<and> cos x = 0"
  3933     by (auto simp: intro!: cos_total)
  3934   then obtain \<theta> where \<theta>: "0 \<le> \<theta>" "\<theta> \<le> pi" "cos \<theta> = 0"
  3935     and uniq: "\<And>\<phi>. 0 \<le> \<phi> \<Longrightarrow> \<phi> \<le> pi \<Longrightarrow> cos \<phi> = 0 \<Longrightarrow> \<phi> = \<theta>"
  3936     by blast
  3937   then have "x - real n * pi = \<theta>"
  3938     using x by blast
  3939   moreover have "pi/2 = \<theta>"
  3940     using pi_half_ge_zero uniq by fastforce
  3941   ultimately show ?thesis
  3942     by (rule_tac x = "Suc (2 * n)" in exI) (simp add: algebra_simps)
  3943 qed
  3944 
  3945 lemma sin_zero_lemma: "0 \<le> x \<Longrightarrow> sin x = 0 \<Longrightarrow> \<exists>n::nat. even n \<and> x = real n * (pi/2)"
  3946   using cos_zero_lemma [of "x + pi/2"]
  3947   apply (clarsimp simp add: cos_add)
  3948   apply (rule_tac x = "n - 1" in exI)
  3949   apply (simp add: algebra_simps of_nat_diff)
  3950   done
  3951 
  3952 lemma cos_zero_iff:
  3953   "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))))"
  3954   (is "?lhs = ?rhs")
  3955 proof -
  3956   have *: "cos (real n * pi / 2) = 0" if "odd n" for n :: nat
  3957   proof -
  3958     from that obtain m where "n = 2 * m + 1" ..
  3959     then show ?thesis
  3960       by (simp add: field_simps) (simp add: cos_add add_divide_distrib)
  3961   qed
  3962   show ?thesis
  3963   proof
  3964     show ?rhs if ?lhs
  3965       using that cos_zero_lemma [of x] cos_zero_lemma [of "-x"] by force
  3966     show ?lhs if ?rhs
  3967       using that by (auto dest: * simp del: eq_divide_eq_numeral1)
  3968   qed
  3969 qed
  3970 
  3971 lemma sin_zero_iff:
  3972   "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))))"
  3973   (is "?lhs = ?rhs")
  3974 proof
  3975   show ?rhs if ?lhs
  3976     using that sin_zero_lemma [of x] sin_zero_lemma [of "-x"] by force
  3977   show ?lhs if ?rhs
  3978     using that by (auto elim: evenE)
  3979 qed
  3980 
  3981 lemma cos_zero_iff_int: "cos x = 0 \<longleftrightarrow> (\<exists>n. odd n \<and> x = of_int n * (pi/2))"
  3982 proof safe
  3983   assume "cos x = 0"
  3984   then show "\<exists>n. odd n \<and> x = of_int n * (pi/2)"
  3985     apply (simp add: cos_zero_iff)
  3986     apply safe
  3987      apply (metis even_int_iff of_int_of_nat_eq)
  3988     apply (rule_tac x="- (int n)" in exI)
  3989     apply simp
  3990     done
  3991 next
  3992   fix n :: int
  3993   assume "odd n"
  3994   then show "cos (of_int n * (pi / 2)) = 0"
  3995     apply (simp add: cos_zero_iff)
  3996     apply (cases n rule: int_cases2)
  3997      apply simp_all
  3998     done
  3999 qed
  4000 
  4001 lemma sin_zero_iff_int: "sin x = 0 \<longleftrightarrow> (\<exists>n. even n \<and> x = of_int n * (pi/2))"
  4002 proof safe
  4003   assume "sin x = 0"
  4004   then show "\<exists>n. even n \<and> x = of_int n * (pi / 2)"
  4005     apply (simp add: sin_zero_iff)
  4006     apply safe
  4007      apply (metis even_int_iff of_int_of_nat_eq)
  4008     apply (rule_tac x="- (int n)" in exI)
  4009     apply simp
  4010     done
  4011 next
  4012   fix n :: int
  4013   assume "even n"
  4014   then show "sin (of_int n * (pi / 2)) = 0"
  4015     apply (simp add: sin_zero_iff)
  4016     apply (cases n rule: int_cases2)
  4017      apply simp_all
  4018     done
  4019 qed
  4020 
  4021 lemma sin_zero_iff_int2: "sin x = 0 \<longleftrightarrow> (\<exists>n::int. x = of_int n * pi)"
  4022   apply (simp only: sin_zero_iff_int)
  4023   apply (safe elim!: evenE)
  4024    apply (simp_all add: field_simps)
  4025   using dvd_triv_left apply fastforce
  4026   done
  4027 
  4028 lemma cos_monotone_0_pi:
  4029   assumes "0 \<le> y" and "y < x" and "x \<le> pi"
  4030   shows "cos x < cos y"
  4031 proof -
  4032   have "- (x - y) < 0" using assms by auto
  4033   from MVT2[OF \<open>y < x\<close> DERIV_cos[THEN impI, THEN allI]]
  4034   obtain z where "y < z" and "z < x" and cos_diff: "cos x - cos y = (x - y) * - sin z"
  4035     by auto
  4036   then have "0 < z" and "z < pi"
  4037     using assms by auto
  4038   then have "0 < sin z"
  4039     using sin_gt_zero by auto
  4040   then have "cos x - cos y < 0"
  4041     unfolding cos_diff minus_mult_commute[symmetric]
  4042     using \<open>- (x - y) < 0\<close> by (rule mult_pos_neg2)
  4043   then show ?thesis by auto
  4044 qed
  4045 
  4046 lemma cos_monotone_0_pi_le:
  4047   assumes "0 \<le> y" and "y \<le> x" and "x \<le> pi"
  4048   shows "cos x \<le> cos y"
  4049 proof (cases "y < x")
  4050   case True
  4051   show ?thesis
  4052     using cos_monotone_0_pi[OF \<open>0 \<le> y\<close> True \<open>x \<le> pi\<close>] by auto
  4053 next
  4054   case False
  4055   then have "y = x" using \<open>y \<le> x\<close> by auto
  4056   then show ?thesis by auto
  4057 qed
  4058 
  4059 lemma cos_monotone_minus_pi_0:
  4060   assumes "- pi \<le> y" and "y < x" and "x \<le> 0"
  4061   shows "cos y < cos x"
  4062 proof -
  4063   have "0 \<le> - x" and "- x < - y" and "- y \<le> pi"
  4064     using assms by auto
  4065   from cos_monotone_0_pi[OF this] show ?thesis
  4066     unfolding cos_minus .
  4067 qed
  4068 
  4069 lemma cos_monotone_minus_pi_0':
  4070   assumes "- pi \<le> y" and "y \<le> x" and "x \<le> 0"
  4071   shows "cos y \<le> cos x"
  4072 proof (cases "y < x")
  4073   case True
  4074   show ?thesis using cos_monotone_minus_pi_0[OF \<open>-pi \<le> y\<close> True \<open>x \<le> 0\<close>]
  4075     by auto
  4076 next
  4077   case False
  4078   then have "y = x" using \<open>y \<le> x\<close> by auto
  4079   then show ?thesis by auto
  4080 qed
  4081 
  4082 lemma sin_monotone_2pi:
  4083   assumes "- (pi/2) \<le> y" and "y < x" and "x \<le> pi/2"
  4084   shows "sin y < sin x"
  4085   apply (simp add: sin_cos_eq)
  4086   apply (rule cos_monotone_0_pi)
  4087   using assms
  4088     apply auto
  4089   done
  4090 
  4091 lemma sin_monotone_2pi_le:
  4092   assumes "- (pi / 2) \<le> y" and "y \<le> x" and "x \<le> pi / 2"
  4093   shows "sin y \<le> sin x"
  4094   by (metis assms le_less sin_monotone_2pi)
  4095 
  4096 lemma sin_x_le_x:
  4097   fixes x :: real
  4098   assumes x: "x \<ge> 0"
  4099   shows "sin x \<le> x"
  4100 proof -
  4101   let ?f = "\<lambda>x. x - sin x"
  4102   from x have "?f x \<ge> ?f 0"
  4103     apply (rule DERIV_nonneg_imp_nondecreasing)
  4104     apply (intro allI impI exI[of _ "1 - cos x" for x])
  4105     apply (auto intro!: derivative_eq_intros simp: field_simps)
  4106     done
  4107   then show "sin x \<le> x" by simp
  4108 qed
  4109 
  4110 lemma sin_x_ge_neg_x:
  4111   fixes x :: real
  4112   assumes x: "x \<ge> 0"
  4113   shows "sin x \<ge> - x"
  4114 proof -
  4115   let ?f = "\<lambda>x. x + sin x"
  4116   from x have "?f x \<ge> ?f 0"
  4117     apply (rule DERIV_nonneg_imp_nondecreasing)
  4118     apply (intro allI impI exI[of _ "1 + cos x" for x])
  4119     apply (auto intro!: derivative_eq_intros simp: field_simps real_0_le_add_iff)
  4120     done
  4121   then show "sin x \<ge> -x" by simp
  4122 qed
  4123 
  4124 lemma abs_sin_x_le_abs_x: "\<bar>sin x\<bar> \<le> \<bar>x\<bar>"
  4125   for x :: real
  4126   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"]
  4127   by (auto simp: abs_real_def)
  4128 
  4129 
  4130 subsection \<open>More Corollaries about Sine and Cosine\<close>
  4131 
  4132 lemma sin_cos_npi [simp]: "sin (real (Suc (2 * n)) * pi / 2) = (-1) ^ n"
  4133 proof -
  4134   have "sin ((real n + 1/2) * pi) = cos (real n * pi)"
  4135     by (auto simp: algebra_simps sin_add)
  4136   then show ?thesis
  4137     by (simp add: distrib_right add_divide_distrib add.commute mult.commute [of pi])
  4138 qed
  4139 
  4140 lemma cos_2npi [simp]: "cos (2 * real n * pi) = 1"
  4141   for n :: nat
  4142   by (cases "even n") (simp_all add: cos_double mult.assoc)
  4143 
  4144 lemma cos_3over2_pi [simp]: "cos (3/2*pi) = 0"
  4145   apply (subgoal_tac "cos (pi + pi/2) = 0")
  4146    apply simp
  4147   apply (subst cos_add)
  4148   apply simp
  4149   done
  4150 
  4151 lemma sin_2npi [simp]: "sin (2 * real n * pi) = 0"
  4152   for n :: nat
  4153   by (auto simp: mult.assoc sin_double)
  4154 
  4155 lemma sin_3over2_pi [simp]: "sin (3/2*pi) = - 1"
  4156   apply (subgoal_tac "sin (pi + pi/2) = - 1")
  4157    apply simp
  4158   apply (subst sin_add)
  4159   apply simp
  4160   done
  4161 
  4162 lemma cos_pi_eq_zero [simp]: "cos (pi * real (Suc (2 * m)) / 2) = 0"
  4163   by (simp only: cos_add sin_add of_nat_Suc distrib_right distrib_left add_divide_distrib, auto)
  4164 
  4165 lemma DERIV_cos_add [simp]: "DERIV (\<lambda>x. cos (x + k)) xa :> - sin (xa + k)"
  4166   by (auto intro!: derivative_eq_intros)
  4167 
  4168 lemma sin_zero_norm_cos_one:
  4169   fixes x :: "'a::{real_normed_field,banach}"
  4170   assumes "sin x = 0"
  4171   shows "norm (cos x) = 1"
  4172   using sin_cos_squared_add [of x, unfolded assms]
  4173   by (simp add: square_norm_one)
  4174 
  4175 lemma sin_zero_abs_cos_one: "sin x = 0 \<Longrightarrow> \<bar>cos x\<bar> = (1::real)"
  4176   using sin_zero_norm_cos_one by fastforce
  4177 
  4178 lemma cos_one_sin_zero:
  4179   fixes x :: "'a::{real_normed_field,banach}"
  4180   assumes "cos x = 1"
  4181   shows "sin x = 0"
  4182   using sin_cos_squared_add [of x, unfolded assms]
  4183   by simp
  4184 
  4185 lemma sin_times_pi_eq_0: "sin (x * pi) = 0 \<longleftrightarrow> x \<in> \<int>"
  4186   by (simp add: sin_zero_iff_int2) (metis Ints_cases Ints_of_int)
  4187 
  4188 lemma cos_one_2pi: "cos x = 1 \<longleftrightarrow> (\<exists>n::nat. x = n * 2 * pi) | (\<exists>n::nat. x = - (n * 2 * pi))"
  4189   (is "?lhs = ?rhs")
  4190 proof
  4191   assume ?lhs
  4192   then have "sin x = 0"
  4193     by (simp add: cos_one_sin_zero)
  4194   then show ?rhs
  4195   proof (simp only: sin_zero_iff, elim exE disjE conjE)
  4196     fix n :: nat
  4197     assume n: "even n" "x = real n * (pi/2)"
  4198     then obtain m where m: "n = 2 * m"
  4199       using dvdE by blast
  4200     then have me: "even m" using \<open>?lhs\<close> n
  4201       by (auto simp: field_simps) (metis one_neq_neg_one  power_minus_odd power_one)
  4202     show ?rhs
  4203       using m me n
  4204       by (auto simp: field_simps elim!: evenE)
  4205   next
  4206     fix n :: nat
  4207     assume n: "even n" "x = - (real n * (pi/2))"
  4208     then obtain m where m: "n = 2 * m"
  4209       using dvdE by blast
  4210     then have me: "even m" using \<open>?lhs\<close> n
  4211       by (auto simp: field_simps) (metis one_neq_neg_one  power_minus_odd power_one)
  4212     show ?rhs
  4213       using m me n
  4214       by (auto simp: field_simps elim!: evenE)
  4215   qed
  4216 next
  4217   assume ?rhs
  4218   then show "cos x = 1"
  4219     by (metis cos_2npi cos_minus mult.assoc mult.left_commute)
  4220 qed
  4221 
  4222 lemma cos_one_2pi_int: "cos x = 1 \<longleftrightarrow> (\<exists>n::int. x = n * 2 * pi)"
  4223   apply auto  (* FIXME simproc bug? *)
  4224    apply (auto simp: cos_one_2pi)
  4225     apply (metis of_int_of_nat_eq)
  4226    apply (metis mult_minus_right of_int_minus of_int_of_nat_eq)
  4227   apply (metis mult_minus_right of_int_of_nat)
  4228   done
  4229 
  4230 lemma sin_cos_sqrt: "0 \<le> sin x \<Longrightarrow> sin x = sqrt (1 - (cos(x) ^ 2))"
  4231   using sin_squared_eq real_sqrt_unique by fastforce
  4232 
  4233 lemma sin_eq_0_pi: "- pi < x \<Longrightarrow> x < pi \<Longrightarrow> sin x = 0 \<Longrightarrow> x = 0"
  4234   by (metis sin_gt_zero sin_minus minus_less_iff neg_0_less_iff_less not_less_iff_gr_or_eq)
  4235 
  4236 lemma cos_treble_cos: "cos (3 * x) = 4 * cos x ^ 3 - 3 * cos x"
  4237   for x :: "'a::{real_normed_field,banach}"
  4238 proof -
  4239   have *: "(sin x * (sin x * 3)) = 3 - (cos x * (cos x * 3))"
  4240     by (simp add: mult.assoc [symmetric] sin_squared_eq [unfolded power2_eq_square])
  4241   have "cos(3 * x) = cos(2*x + x)"
  4242     by simp
  4243   also have "\<dots> = 4 * cos x ^ 3 - 3 * cos x"
  4244     apply (simp only: cos_add cos_double sin_double)
  4245     apply (simp add: * field_simps power2_eq_square power3_eq_cube)
  4246     done
  4247   finally show ?thesis .
  4248 qed
  4249 
  4250 lemma cos_45: "cos (pi / 4) = sqrt 2 / 2"
  4251 proof -
  4252   let ?c = "cos (pi / 4)"
  4253   let ?s = "sin (pi / 4)"
  4254   have nonneg: "0 \<le> ?c"
  4255     by (simp add: cos_ge_zero)
  4256   have "0 = cos (pi / 4 + pi / 4)"
  4257     by simp
  4258   also have "cos (pi / 4 + pi / 4) = ?c\<^sup>2 - ?s\<^sup>2"
  4259     by (simp only: cos_add power2_eq_square)
  4260   also have "\<dots> = 2 * ?c\<^sup>2 - 1"
  4261     by (simp add: sin_squared_eq)
  4262   finally have "?c\<^sup>2 = (sqrt 2 / 2)\<^sup>2"
  4263     by (simp add: power_divide)
  4264   then show ?thesis
  4265     using nonneg by (rule power2_eq_imp_eq) simp
  4266 qed
  4267 
  4268 lemma cos_30: "cos (pi / 6) = sqrt 3/2"
  4269 proof -
  4270   let ?c = "cos (pi / 6)"
  4271   let ?s = "sin (pi / 6)"
  4272   have pos_c: "0 < ?c"
  4273     by (rule cos_gt_zero) simp_all
  4274   have "0 = cos (pi / 6 + pi / 6 + pi / 6)"
  4275     by simp
  4276   also have "\<dots> = (?c * ?c - ?s * ?s) * ?c - (?s * ?c + ?c * ?s) * ?s"
  4277     by (simp only: cos_add sin_add)
  4278   also have "\<dots> = ?c * (?c\<^sup>2 - 3 * ?s\<^sup>2)"
  4279     by (simp add: algebra_simps power2_eq_square)
  4280   finally have "?c\<^sup>2 = (sqrt 3/2)\<^sup>2"
  4281     using pos_c by (simp add: sin_squared_eq power_divide)
  4282   then show ?thesis
  4283     using pos_c [THEN order_less_imp_le]
  4284     by (rule power2_eq_imp_eq) simp
  4285 qed
  4286 
  4287 lemma sin_45: "sin (pi / 4) = sqrt 2 / 2"
  4288   by (simp add: sin_cos_eq cos_45)
  4289 
  4290 lemma sin_60: "sin (pi / 3) = sqrt 3/2"
  4291   by (simp add: sin_cos_eq cos_30)
  4292 
  4293 lemma cos_60: "cos (pi / 3) = 1 / 2"
  4294   apply (rule power2_eq_imp_eq)
  4295     apply (simp add: cos_squared_eq sin_60 power_divide)
  4296    apply (rule cos_ge_zero)
  4297     apply (rule order_trans [where y=0])
  4298      apply simp_all
  4299   done
  4300 
  4301 lemma sin_30: "sin (pi / 6) = 1 / 2"
  4302   by (simp add: sin_cos_eq cos_60)
  4303 
  4304 lemma cos_integer_2pi: "n \<in> \<int> \<Longrightarrow> cos(2 * pi * n) = 1"
  4305   by (metis Ints_cases cos_one_2pi_int mult.assoc mult.commute)
  4306 
  4307 lemma sin_integer_2pi: "n \<in> \<int> \<Longrightarrow> sin(2 * pi * n) = 0"
  4308   by (metis sin_two_pi Ints_mult mult.assoc mult.commute sin_times_pi_eq_0)
  4309 
  4310 lemma cos_int_2npi [simp]: "cos (2 * of_int n * pi) = 1"
  4311   for n :: int
  4312   by (simp add: cos_one_2pi_int)
  4313 
  4314 lemma sin_int_2npi [simp]: "sin (2 * of_int n * pi) = 0"
  4315   for n :: int
  4316   by (metis Ints_of_int mult.assoc mult.commute sin_integer_2pi)
  4317 
  4318 lemma sincos_principal_value: "\<exists>y. (- pi < y \<and> y \<le> pi) \<and> (sin y = sin x \<and> cos y = cos x)"
  4319   apply (rule exI [where x="pi - (2 * pi) * frac ((pi - x) / (2 * pi))"])
  4320   apply (auto simp: field_simps frac_lt_1)
  4321    apply (simp_all add: frac_def divide_simps)
  4322    apply (simp_all add: add_divide_distrib diff_divide_distrib)
  4323    apply (simp_all add: sin_diff cos_diff mult.assoc [symmetric] cos_integer_2pi sin_integer_2pi)
  4324   done
  4325 
  4326 
  4327 subsection \<open>Tangent\<close>
  4328 
  4329 definition tan :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  4330   where "tan = (\<lambda>x. sin x / cos x)"
  4331 
  4332 lemma tan_of_real: "of_real (tan x) = (tan (of_real x) :: 'a::{real_normed_field,banach})"
  4333   by (simp add: tan_def sin_of_real cos_of_real)
  4334 
  4335 lemma tan_in_Reals [simp]: "z \<in> \<real> \<Longrightarrow> tan z \<in> \<real>"
  4336   for z :: "'a::{real_normed_field,banach}"
  4337   by (simp add: tan_def)
  4338 
  4339 lemma tan_zero [simp]: "tan 0 = 0"
  4340   by (simp add: tan_def)
  4341 
  4342 lemma tan_pi [simp]: "tan pi = 0"
  4343   by (simp add: tan_def)
  4344 
  4345 lemma tan_npi [simp]: "tan (real n * pi) = 0"
  4346   for n :: nat
  4347   by (simp add: tan_def)
  4348 
  4349 lemma tan_minus [simp]: "tan (- x) = - tan x"
  4350   by (simp add: tan_def)
  4351 
  4352 lemma tan_periodic [simp]: "tan (x + 2 * pi) = tan x"
  4353   by (simp add: tan_def)
  4354 
  4355 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)"
  4356   by (simp add: tan_def cos_add field_simps)
  4357 
  4358 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)"
  4359   for x :: "'a::{real_normed_field,banach}"
  4360   by (simp add: tan_def sin_add field_simps)
  4361 
  4362 lemma tan_add:
  4363   "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)"
  4364   for x :: "'a::{real_normed_field,banach}"
  4365   by (simp add: add_tan_eq lemma_tan_add1 field_simps) (simp add: tan_def)
  4366 
  4367 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)"
  4368   for x :: "'a::{real_normed_field,banach}"
  4369   using tan_add [of x x] by (simp add: power2_eq_square)
  4370 
  4371 lemma tan_gt_zero: "0 < x \<Longrightarrow> x < pi/2 \<Longrightarrow> 0 < tan x"
  4372   by (simp add: tan_def zero_less_divide_iff sin_gt_zero2 cos_gt_zero_pi)
  4373 
  4374 lemma tan_less_zero:
  4375   assumes "- pi/2 < x" and "x < 0"
  4376   shows "tan x < 0"
  4377 proof -
  4378   have "0 < tan (- x)"
  4379     using assms by (simp only: tan_gt_zero)
  4380   then show ?thesis by simp
  4381 qed
  4382 
  4383 lemma tan_half: "tan x = sin (2 * x) / (cos (2 * x) + 1)"
  4384   for x :: "'a::{real_normed_field,banach,field}"
  4385   unfolding tan_def sin_double cos_double sin_squared_eq
  4386   by (simp add: power2_eq_square)
  4387 
  4388 lemma tan_30: "tan (pi / 6) = 1 / sqrt 3"
  4389   unfolding tan_def by (simp add: sin_30 cos_30)
  4390 
  4391 lemma tan_45: "tan (pi / 4) = 1"
  4392   unfolding tan_def by (simp add: sin_45 cos_45)
  4393 
  4394 lemma tan_60: "tan (pi / 3) = sqrt 3"
  4395   unfolding tan_def by (simp add: sin_60 cos_60)
  4396 
  4397 lemma DERIV_tan [simp]: "cos x \<noteq> 0 \<Longrightarrow> DERIV tan x :> inverse ((cos x)\<^sup>2)"
  4398   for x :: "'a::{real_normed_field,banach}"
  4399   unfolding tan_def
  4400   by (auto intro!: derivative_eq_intros, simp add: divide_inverse power2_eq_square)
  4401 
  4402 lemma isCont_tan: "cos x \<noteq> 0 \<Longrightarrow> isCont tan x"
  4403   for x :: "'a::{real_normed_field,banach}"
  4404   by (rule DERIV_tan [THEN DERIV_isCont])
  4405 
  4406 lemma isCont_tan' [simp,continuous_intros]:
  4407   fixes a :: "'a::{real_normed_field,banach}" and f :: "'a \<Rightarrow> 'a"
  4408   shows "isCont f a \<Longrightarrow> cos (f a) \<noteq> 0 \<Longrightarrow> isCont (\<lambda>x. tan (f x)) a"
  4409   by (rule isCont_o2 [OF _ isCont_tan])
  4410 
  4411 lemma tendsto_tan [tendsto_intros]:
  4412   fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  4413   shows "(f \<longlongrightarrow> a) F \<Longrightarrow> cos a \<noteq> 0 \<Longrightarrow> ((\<lambda>x. tan (f x)) \<longlongrightarrow> tan a) F"
  4414   by (rule isCont_tendsto_compose [OF isCont_tan])
  4415 
  4416 lemma continuous_tan:
  4417   fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  4418   shows "continuous F f \<Longrightarrow> cos (f (Lim F (\<lambda>x. x))) \<noteq> 0 \<Longrightarrow> continuous F (\<lambda>x. tan (f x))"
  4419   unfolding continuous_def by (rule tendsto_tan)
  4420 
  4421 lemma continuous_on_tan [continuous_intros]:
  4422   fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  4423   shows "continuous_on s f \<Longrightarrow> (\<forall>x\<in>s. cos (f x) \<noteq> 0) \<Longrightarrow> continuous_on s (\<lambda>x. tan (f x))"
  4424   unfolding continuous_on_def by (auto intro: tendsto_tan)
  4425 
  4426 lemma continuous_within_tan [continuous_intros]:
  4427   fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  4428   shows "continuous (at x within s) f \<Longrightarrow>
  4429     cos (f x) \<noteq> 0 \<Longrightarrow> continuous (at x within s) (\<lambda>x. tan (f x))"
  4430   unfolding continuous_within by (rule tendsto_tan)
  4431 
  4432 lemma LIM_cos_div_sin: "(\<lambda>x. cos(x)/sin(x)) \<midarrow>pi/2\<rightarrow> 0"
  4433   by (rule LIM_cong_limit, (rule tendsto_intros)+, simp_all)
  4434 
  4435 lemma lemma_tan_total: "0 < y \<Longrightarrow> \<exists>x. 0 < x \<and> x < pi/2 \<and> y < tan x"
  4436   apply (insert LIM_cos_div_sin)
  4437   apply (simp only: LIM_eq)
  4438   apply (drule_tac x = "inverse y" in spec)
  4439   apply safe
  4440    apply force
  4441   apply (drule_tac ?d1.0 = s in pi_half_gt_zero [THEN [2] real_lbound_gt_zero])
  4442   apply safe
  4443   apply (rule_tac x = "(pi/2) - e" in exI)
  4444   apply (simp (no_asm_simp))
  4445   apply (drule_tac x = "(pi/2) - e" in spec)
  4446   apply (auto simp add: tan_def sin_diff cos_diff)
  4447   apply (rule inverse_less_iff_less [THEN iffD1])
  4448     apply (auto simp add: divide_inverse)
  4449    apply (rule mult_pos_pos)
  4450     apply (subgoal_tac [3] "0 < sin e \<and> 0 < cos e")
  4451      apply (auto intro: cos_gt_zero sin_gt_zero2 simp: mult.commute)
  4452   done
  4453 
  4454 lemma tan_total_pos: "0 \<le> y \<Longrightarrow> \<exists>x. 0 \<le> x \<and> x < pi/2 \<and> tan x = y"
  4455   apply (frule order_le_imp_less_or_eq)
  4456   apply safe
  4457    prefer 2 apply force
  4458   apply (drule lemma_tan_total)
  4459   apply safe
  4460   apply (cut_tac f = tan and a = 0 and b = x and y = y in IVT_objl)
  4461   apply (auto intro!: DERIV_tan [THEN DERIV_isCont])
  4462   apply (drule_tac y = xa in order_le_imp_less_or_eq)
  4463   apply (auto dest: cos_gt_zero)
  4464   done
  4465 
  4466 lemma lemma_tan_total1: "\<exists>x. -(pi/2) < x \<and> x < (pi/2) \<and> tan x = y"
  4467   apply (insert linorder_linear [of 0 y])
  4468   apply safe
  4469    apply (drule tan_total_pos)
  4470    apply (cut_tac [2] y="-y" in tan_total_pos)
  4471     apply safe
  4472     apply (rule_tac [3] x = "-x" in exI)
  4473     apply (auto del: exI intro!: exI)
  4474   done
  4475 
  4476 lemma tan_total: "\<exists>! x. -(pi/2) < x \<and> x < (pi/2) \<and> tan x = y"
  4477   apply (insert lemma_tan_total1 [where y = y])
  4478   apply auto
  4479   apply hypsubst_thin
  4480   apply (cut_tac x = xa and y = y in linorder_less_linear)
  4481   apply auto
  4482    apply (subgoal_tac [2] "\<exists>z. y < z \<and> z < xa \<and> DERIV tan z :> 0")
  4483     apply (subgoal_tac "\<exists>z. xa < z \<and> z < y \<and> DERIV tan z :> 0")
  4484      apply (rule_tac [4] Rolle)
  4485         apply (rule_tac [2] Rolle)
  4486            apply (auto del: exI intro!: DERIV_tan DERIV_isCont exI
  4487             simp add: real_differentiable_def)
  4488        apply (rule_tac [!] DERIV_tan asm_rl)
  4489        apply (auto dest!: DERIV_unique [OF _ DERIV_tan]
  4490         simp add: cos_gt_zero_pi [THEN less_imp_neq, THEN not_sym])
  4491   done
  4492 
  4493 lemma tan_monotone:
  4494   assumes "- (pi / 2) < y" and "y < x" and "x < pi / 2"
  4495   shows "tan y < tan x"
  4496 proof -
  4497   have "\<forall>x'. y \<le> x' \<and> x' \<le> x \<longrightarrow> DERIV tan x' :> inverse ((cos x')\<^sup>2)"
  4498   proof (rule allI, rule impI)
  4499     fix x' :: real
  4500     assume "y \<le> x' \<and> x' \<le> x"
  4501     then have "-(pi/2) < x'" and "x' < pi/2"
  4502       using assms by auto
  4503     from cos_gt_zero_pi[OF this]
  4504     have "cos x' \<noteq> 0" by auto
  4505     then show "DERIV tan x' :> inverse ((cos x')\<^sup>2)"
  4506       by (rule DERIV_tan)
  4507   qed
  4508   from MVT2[OF \<open>y < x\<close> this]
  4509   obtain z where "y < z" and "z < x"
  4510     and tan_diff: "tan x - tan y = (x - y) * inverse ((cos z)\<^sup>2)" by auto
  4511   then have "- (pi / 2) < z" and "z < pi / 2"
  4512     using assms by auto
  4513   then have "0 < cos z"
  4514     using cos_gt_zero_pi by auto
  4515   then have inv_pos: "0 < inverse ((cos z)\<^sup>2)"
  4516     by auto
  4517   have "0 < x - y" using \<open>y < x\<close> by auto
  4518   with inv_pos have "0 < tan x - tan y"
  4519     unfolding tan_diff by auto
  4520   then show ?thesis by auto
  4521 qed
  4522 
  4523 lemma tan_monotone':
  4524   assumes "- (pi / 2) < y"
  4525     and "y < pi / 2"
  4526     and "- (pi / 2) < x"
  4527     and "x < pi / 2"
  4528   shows "y < x \<longleftrightarrow> tan y < tan x"
  4529 proof
  4530   assume "y < x"
  4531   then show "tan y < tan x"
  4532     using tan_monotone and \<open>- (pi / 2) < y\<close> and \<open>x < pi / 2\<close> by auto
  4533 next
  4534   assume "tan y < tan x"
  4535   show "y < x"
  4536   proof (rule ccontr)
  4537     assume "\<not> ?thesis"
  4538     then have "x \<le> y" by auto
  4539     then have "tan x \<le> tan y"
  4540     proof (cases "x = y")
  4541       case True
  4542       then show ?thesis by auto
  4543     next
  4544       case False
  4545       then have "x < y" using \<open>x \<le> y\<close> by auto
  4546       from tan_monotone[OF \<open>- (pi/2) < x\<close> this \<open>y < pi / 2\<close>] show ?thesis
  4547         by auto
  4548     qed
  4549     then show False
  4550       using \<open>tan y < tan x\<close> by auto
  4551   qed
  4552 qed
  4553 
  4554 lemma tan_inverse: "1 / (tan y) = tan (pi / 2 - y)"
  4555   unfolding tan_def sin_cos_eq[of y] cos_sin_eq[of y] by auto
  4556 
  4557 lemma tan_periodic_pi[simp]: "tan (x + pi) = tan x"
  4558   by (simp add: tan_def)
  4559 
  4560 lemma tan_periodic_nat[simp]: "tan (x + real n * pi) = tan x"
  4561   for n :: nat
  4562 proof (induct n arbitrary: x)
  4563   case 0
  4564   then show ?case by simp
  4565 next
  4566   case (Suc n)
  4567   have split_pi_off: "x + real (Suc n) * pi = (x + real n * pi) + pi"
  4568     unfolding Suc_eq_plus1 of_nat_add  distrib_right by auto
  4569   show ?case
  4570     unfolding split_pi_off using Suc by auto
  4571 qed
  4572 
  4573 lemma tan_periodic_int[simp]: "tan (x + of_int i * pi) = tan x"
  4574 proof (cases "0 \<le> i")
  4575   case True
  4576   then have i_nat: "of_int i = of_int (nat i)" by auto
  4577   show ?thesis unfolding i_nat
  4578     by (metis of_int_of_nat_eq tan_periodic_nat)
  4579 next
  4580   case False
  4581   then have i_nat: "of_int i = - of_int (nat (- i))" by auto
  4582   have "tan x = tan (x + of_int i * pi - of_int i * pi)"
  4583     by auto
  4584   also have "\<dots> = tan (x + of_int i * pi)"
  4585     unfolding i_nat mult_minus_left diff_minus_eq_add
  4586     by (metis of_int_of_nat_eq tan_periodic_nat)
  4587   finally show ?thesis by auto
  4588 qed
  4589 
  4590 lemma tan_periodic_n[simp]: "tan (x + numeral n * pi) = tan x"
  4591   using tan_periodic_int[of _ "numeral n" ] by simp
  4592 
  4593 lemma tan_minus_45: "tan (-(pi/4)) = -1"
  4594   unfolding tan_def by (simp add: sin_45 cos_45)
  4595 
  4596 lemma tan_diff:
  4597   "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)"
  4598   for x :: "'a::{real_normed_field,banach}"
  4599   using tan_add [of x "-y"] by simp
  4600 
  4601 lemma tan_pos_pi2_le: "0 \<le> x \<Longrightarrow> x < pi/2 \<Longrightarrow> 0 \<le> tan x"
  4602   using less_eq_real_def tan_gt_zero by auto
  4603 
  4604 lemma cos_tan: "\<bar>x\<bar> < pi/2 \<Longrightarrow> cos x = 1 / sqrt (1 + tan x ^ 2)"
  4605   using cos_gt_zero_pi [of x]
  4606   by (simp add: divide_simps tan_def real_sqrt_divide abs_if split: if_split_asm)
  4607 
  4608 lemma sin_tan: "\<bar>x\<bar> < pi/2 \<Longrightarrow> sin x = tan x / sqrt (1 + tan x ^ 2)"
  4609   using cos_gt_zero [of "x"] cos_gt_zero [of "-x"]
  4610   by (force simp add: divide_simps tan_def real_sqrt_divide abs_if split: if_split_asm)
  4611 
  4612 lemma tan_mono_le: "-(pi/2) < x \<Longrightarrow> x \<le> y \<Longrightarrow> y < pi/2 \<Longrightarrow> tan x \<le> tan y"
  4613   using less_eq_real_def tan_monotone by auto
  4614 
  4615 lemma tan_mono_lt_eq:
  4616   "-(pi/2) < x \<Longrightarrow> x < pi/2 \<Longrightarrow> -(pi/2) < y \<Longrightarrow> y < pi/2 \<Longrightarrow> tan x < tan y \<longleftrightarrow> x < y"
  4617   using tan_monotone' by blast
  4618 
  4619 lemma tan_mono_le_eq:
  4620   "-(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"
  4621   by (meson tan_mono_le not_le tan_monotone)
  4622 
  4623 lemma tan_bound_pi2: "\<bar>x\<bar> < pi/4 \<Longrightarrow> \<bar>tan x\<bar> < 1"
  4624   using tan_45 tan_monotone [of x "pi/4"] tan_monotone [of "-x" "pi/4"]
  4625   by (auto simp: abs_if split: if_split_asm)
  4626 
  4627 lemma tan_cot: "tan(pi/2 - x) = inverse(tan x)"
  4628   by (simp add: tan_def sin_diff cos_diff)
  4629 
  4630 
  4631 subsection \<open>Cotangent\<close>
  4632 
  4633 definition cot :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  4634   where "cot = (\<lambda>x. cos x / sin x)"
  4635 
  4636 lemma cot_of_real: "of_real (cot x) = (cot (of_real x) :: 'a::{real_normed_field,banach})"
  4637   by (simp add: cot_def sin_of_real cos_of_real)
  4638 
  4639 lemma cot_in_Reals [simp]: "z \<in> \<real> \<Longrightarrow> cot z \<in> \<real>"
  4640   for z :: "'a::{real_normed_field,banach}"
  4641   by (simp add: cot_def)
  4642 
  4643 lemma cot_zero [simp]: "cot 0 = 0"
  4644   by (simp add: cot_def)
  4645 
  4646 lemma cot_pi [simp]: "cot pi = 0"
  4647   by (simp add: cot_def)
  4648 
  4649 lemma cot_npi [simp]: "cot (real n * pi) = 0"
  4650   for n :: nat
  4651   by (simp add: cot_def)
  4652 
  4653 lemma cot_minus [simp]: "cot (- x) = - cot x"
  4654   by (simp add: cot_def)
  4655 
  4656 lemma cot_periodic [simp]: "cot (x + 2 * pi) = cot x"
  4657   by (simp add: cot_def)
  4658 
  4659 lemma cot_altdef: "cot x = inverse (tan x)"
  4660   by (simp add: cot_def tan_def)
  4661 
  4662 lemma tan_altdef: "tan x = inverse (cot x)"
  4663   by (simp add: cot_def tan_def)
  4664 
  4665 lemma tan_cot': "tan (pi/2 - x) = cot x"
  4666   by (simp add: tan_cot cot_altdef)
  4667 
  4668 lemma cot_gt_zero: "0 < x \<Longrightarrow> x < pi/2 \<Longrightarrow> 0 < cot x"
  4669   by (simp add: cot_def zero_less_divide_iff sin_gt_zero2 cos_gt_zero_pi)
  4670 
  4671 lemma cot_less_zero:
  4672   assumes lb: "- pi/2 < x" and "x < 0"
  4673   shows "cot x < 0"
  4674 proof -
  4675   have "0 < cot (- x)"
  4676     using assms by (simp only: cot_gt_zero)
  4677   then show ?thesis by simp
  4678 qed
  4679 
  4680 lemma DERIV_cot [simp]: "sin x \<noteq> 0 \<Longrightarrow> DERIV cot x :> -inverse ((sin x)\<^sup>2)"
  4681   for x :: "'a::{real_normed_field,banach}"
  4682   unfolding cot_def using cos_squared_eq[of x]
  4683   by (auto intro!: derivative_eq_intros) (simp add: divide_inverse power2_eq_square)
  4684 
  4685 lemma isCont_cot: "sin x \<noteq> 0 \<Longrightarrow> isCont cot x"
  4686   for x :: "'a::{real_normed_field,banach}"
  4687   by (rule DERIV_cot [THEN DERIV_isCont])
  4688 
  4689 lemma isCont_cot' [simp,continuous_intros]:
  4690   "isCont f a \<Longrightarrow> sin (f a) \<noteq> 0 \<Longrightarrow> isCont (\<lambda>x. cot (f x)) a"
  4691   for a :: "'a::{real_normed_field,banach}" and f :: "'a \<Rightarrow> 'a"
  4692   by (rule isCont_o2 [OF _ isCont_cot])
  4693 
  4694 lemma tendsto_cot [tendsto_intros]: "(f \<longlongrightarrow> a) F \<Longrightarrow> sin a \<noteq> 0 \<Longrightarrow> ((\<lambda>x. cot (f x)) \<longlongrightarrow> cot a) F"
  4695   for f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  4696   by (rule isCont_tendsto_compose [OF isCont_cot])
  4697 
  4698 lemma continuous_cot:
  4699   "continuous F f \<Longrightarrow> sin (f (Lim F (\<lambda>x. x))) \<noteq> 0 \<Longrightarrow> continuous F (\<lambda>x. cot (f x))"
  4700   for f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  4701   unfolding continuous_def by (rule tendsto_cot)
  4702 
  4703 lemma continuous_on_cot [continuous_intros]:
  4704   fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  4705   shows "continuous_on s f \<Longrightarrow> (\<forall>x\<in>s. sin (f x) \<noteq> 0) \<Longrightarrow> continuous_on s (\<lambda>x. cot (f x))"
  4706   unfolding continuous_on_def by (auto intro: tendsto_cot)
  4707 
  4708 lemma continuous_within_cot [continuous_intros]:
  4709   fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  4710   shows "continuous (at x within s) f \<Longrightarrow> sin (f x) \<noteq> 0 \<Longrightarrow> continuous (at x within s) (\<lambda>x. cot (f x))"
  4711   unfolding continuous_within by (rule tendsto_cot)
  4712 
  4713 
  4714 subsection \<open>Inverse Trigonometric Functions\<close>
  4715 
  4716 definition arcsin :: "real \<Rightarrow> real"
  4717   where "arcsin y = (THE x. -(pi/2) \<le> x \<and> x \<le> pi/2 \<and> sin x = y)"
  4718 
  4719 definition arccos :: "real \<Rightarrow> real"
  4720   where "arccos y = (THE x. 0 \<le> x \<and> x \<le> pi \<and> cos x = y)"
  4721 
  4722 definition arctan :: "real \<Rightarrow> real"
  4723   where "arctan y = (THE x. -(pi/2) < x \<and> x < pi/2 \<and> tan x = y)"
  4724 
  4725 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"
  4726   unfolding arcsin_def by (rule theI' [OF sin_total])
  4727 
  4728 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"
  4729   by (drule (1) arcsin) (force intro: order_trans)
  4730 
  4731 lemma sin_arcsin [simp]: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> sin (arcsin y) = y"
  4732   by (blast dest: arcsin)
  4733 
  4734 lemma arcsin_bounded: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> - (pi/2) \<le> arcsin y \<and> arcsin y \<le> pi/2"
  4735   by (blast dest: arcsin)
  4736 
  4737 lemma arcsin_lbound: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> - (pi/2) \<le> arcsin y"
  4738   by (blast dest: arcsin)
  4739 
  4740 lemma arcsin_ubound: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> arcsin y \<le> pi/2"
  4741   by (blast dest: arcsin)
  4742 
  4743 lemma arcsin_lt_bounded: "- 1 < y \<Longrightarrow> y < 1 \<Longrightarrow> - (pi/2) < arcsin y \<and> arcsin y < pi/2"
  4744   apply (frule order_less_imp_le)
  4745   apply (frule_tac y = y in order_less_imp_le)
  4746   apply (frule arcsin_bounded)
  4747    apply safe
  4748     apply simp
  4749    apply (drule_tac y = "arcsin y" in order_le_imp_less_or_eq)
  4750    apply (drule_tac [2] y = "pi/2" in order_le_imp_less_or_eq)
  4751    apply safe
  4752    apply (drule_tac [!] f = sin in arg_cong)
  4753    apply auto
  4754   done
  4755 
  4756 lemma arcsin_sin: "- (pi/2) \<le> x \<Longrightarrow> x \<le> pi/2 \<Longrightarrow> arcsin (sin x) = x"
  4757   apply (unfold arcsin_def)
  4758   apply (rule the1_equality)
  4759    apply (rule sin_total)
  4760     apply auto
  4761   done
  4762 
  4763 lemma arcsin_0 [simp]: "arcsin 0 = 0"
  4764   using arcsin_sin [of 0] by simp
  4765 
  4766 lemma arcsin_1 [simp]: "arcsin 1 = pi/2"
  4767   using arcsin_sin [of "pi/2"] by simp
  4768 
  4769 lemma arcsin_minus_1 [simp]: "arcsin (- 1) = - (pi/2)"
  4770   using arcsin_sin [of "- pi/2"] by simp
  4771 
  4772 lemma arcsin_minus: "- 1 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> arcsin (- x) = - arcsin x"
  4773   by (metis (no_types, hide_lams) arcsin arcsin_sin minus_minus neg_le_iff_le sin_minus)
  4774 
  4775 lemma arcsin_eq_iff: "\<bar>x\<bar> \<le> 1 \<Longrightarrow> \<bar>y\<bar> \<le> 1 \<Longrightarrow> arcsin x = arcsin y \<longleftrightarrow> x = y"
  4776   by (metis abs_le_iff arcsin minus_le_iff)
  4777 
  4778 lemma cos_arcsin_nonzero: "- 1 < x \<Longrightarrow> x < 1 \<Longrightarrow> cos (arcsin x) \<noteq> 0"
  4779   using arcsin_lt_bounded cos_gt_zero_pi by force
  4780 
  4781 lemma arccos: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> 0 \<le> arccos y \<and> arccos y \<le> pi \<and> cos (arccos y) = y"
  4782   unfolding arccos_def by (rule theI' [OF cos_total])
  4783 
  4784 lemma cos_arccos [simp]: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> cos (arccos y) = y"
  4785   by (blast dest: arccos)
  4786 
  4787 lemma arccos_bounded: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> 0 \<le> arccos y \<and> arccos y \<le> pi"
  4788   by (blast dest: arccos)
  4789 
  4790 lemma arccos_lbound: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> 0 \<le> arccos y"
  4791   by (blast dest: arccos)
  4792 
  4793 lemma arccos_ubound: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> arccos y \<le> pi"
  4794   by (blast dest: arccos)
  4795 
  4796 lemma arccos_lt_bounded: "- 1 < y \<Longrightarrow> y < 1 \<Longrightarrow> 0 < arccos y \<and> arccos y < pi"
  4797   apply (frule order_less_imp_le)
  4798   apply (frule_tac y = y in order_less_imp_le)
  4799   apply (frule arccos_bounded)
  4800    apply auto
  4801    apply (drule_tac y = "arccos y" in order_le_imp_less_or_eq)
  4802    apply (drule_tac [2] y = pi in order_le_imp_less_or_eq)
  4803    apply auto
  4804    apply (drule_tac [!] f = cos in arg_cong)
  4805    apply auto
  4806   done
  4807 
  4808 lemma arccos_cos: "0 \<le> x \<Longrightarrow> x \<le> pi \<Longrightarrow> arccos (cos x) = x"
  4809   by (auto simp: arccos_def intro!: the1_equality cos_total)
  4810 
  4811 lemma arccos_cos2: "x \<le> 0 \<Longrightarrow> - pi \<le> x \<Longrightarrow> arccos (cos x) = -x"
  4812   by (auto simp: arccos_def intro!: the1_equality cos_total)
  4813 
  4814 lemma cos_arcsin: "- 1 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> cos (arcsin x) = sqrt (1 - x\<^sup>2)"
  4815   apply (subgoal_tac "x\<^sup>2 \<le> 1")
  4816    apply (rule power2_eq_imp_eq)
  4817      apply (simp add: cos_squared_eq)
  4818     apply (rule cos_ge_zero)
  4819      apply (erule (1) arcsin_lbound)
  4820     apply (erule (1) arcsin_ubound)
  4821    apply simp
  4822   apply (subgoal_tac "\<bar>x\<bar>\<^sup>2 \<le> 1\<^sup>2")
  4823    apply simp
  4824   apply (rule power_mono)
  4825    apply simp
  4826   apply simp
  4827   done
  4828 
  4829 lemma sin_arccos: "- 1 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> sin (arccos x) = sqrt (1 - x\<^sup>2)"
  4830   apply (subgoal_tac "x\<^sup>2 \<le> 1")
  4831    apply (rule power2_eq_imp_eq)
  4832      apply (simp add: sin_squared_eq)
  4833     apply (rule sin_ge_zero)
  4834      apply (erule (1) arccos_lbound)
  4835     apply (erule (1) arccos_ubound)
  4836    apply simp
  4837   apply (subgoal_tac "\<bar>x\<bar>\<^sup>2 \<le> 1\<^sup>2")
  4838    apply simp
  4839   apply (rule power_mono)
  4840    apply simp
  4841   apply simp
  4842   done
  4843 
  4844 lemma arccos_0 [simp]: "arccos 0 = pi/2"
  4845   by (metis arccos_cos cos_gt_zero cos_pi cos_pi_half pi_gt_zero
  4846       pi_half_ge_zero not_le not_zero_less_neg_numeral numeral_One)
  4847 
  4848 lemma arccos_1 [simp]: "arccos 1 = 0"
  4849   using arccos_cos by force
  4850 
  4851 lemma arccos_minus_1 [simp]: "arccos (- 1) = pi"
  4852   by (metis arccos_cos cos_pi order_refl pi_ge_zero)
  4853 
  4854 lemma arccos_minus: "-1 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> arccos (- x) = pi - arccos x"
  4855   by (metis arccos_cos arccos_cos2 cos_minus_pi cos_total diff_le_0_iff_le le_add_same_cancel1
  4856       minus_diff_eq uminus_add_conv_diff)
  4857 
  4858 lemma sin_arccos_nonzero: "- 1 < x \<Longrightarrow> x < 1 \<Longrightarrow> \<not> sin (arccos x) = 0"
  4859   using arccos_lt_bounded sin_gt_zero by force
  4860 
  4861 lemma arctan: "- (pi/2) < arctan y \<and> arctan y < pi/2 \<and> tan (arctan y) = y"
  4862   unfolding arctan_def by (rule theI' [OF tan_total])
  4863 
  4864 lemma tan_arctan: "tan (arctan y) = y"
  4865   by (simp add: arctan)
  4866 
  4867 lemma arctan_bounded: "- (pi/2) < arctan y \<and> arctan y < pi/2"
  4868   by (auto simp only: arctan)
  4869 
  4870 lemma arctan_lbound: "- (pi/2) < arctan y"
  4871   by (simp add: arctan)
  4872 
  4873 lemma arctan_ubound: "arctan y < pi/2"
  4874   by (auto simp only: arctan)
  4875 
  4876 lemma arctan_unique:
  4877   assumes "-(pi/2) < x"
  4878     and "x < pi/2"
  4879     and "tan x = y"
  4880   shows "arctan y = x"
  4881   using assms arctan [of y] tan_total [of y] by (fast elim: ex1E)
  4882 
  4883 lemma arctan_tan: "-(pi/2) < x \<Longrightarrow> x < pi/2 \<Longrightarrow> arctan (tan x) = x"
  4884   by (rule arctan_unique) simp_all
  4885 
  4886 lemma arctan_zero_zero [simp]: "arctan 0 = 0"
  4887   by (rule arctan_unique) simp_all
  4888 
  4889 lemma arctan_minus: "arctan (- x) = - arctan x"
  4890   apply (rule arctan_unique)
  4891     apply (simp only: neg_less_iff_less arctan_ubound)
  4892    apply (metis minus_less_iff arctan_lbound)
  4893   apply (simp add: arctan)
  4894   done
  4895 
  4896 lemma cos_arctan_not_zero [simp]: "cos (arctan x) \<noteq> 0"
  4897   by (intro less_imp_neq [symmetric] cos_gt_zero_pi arctan_lbound arctan_ubound)
  4898 
  4899 lemma cos_arctan: "cos (arctan x) = 1 / sqrt (1 + x\<^sup>2)"
  4900 proof (rule power2_eq_imp_eq)
  4901   have "0 < 1 + x\<^sup>2" by (simp add: add_pos_nonneg)
  4902   show "0 \<le> 1 / sqrt (1 + x\<^sup>2)" by simp
  4903   show "0 \<le> cos (arctan x)"
  4904     by (intro less_imp_le cos_gt_zero_pi arctan_lbound arctan_ubound)
  4905   have "(cos (arctan x))\<^sup>2 * (1 + (tan (arctan x))\<^sup>2) = 1"
  4906     unfolding tan_def by (simp add: distrib_left power_divide)
  4907   then show "(cos (arctan x))\<^sup>2 = (1 / sqrt (1 + x\<^sup>2))\<^sup>2"
  4908     using \<open>0 < 1 + x\<^sup>2\<close> by (simp add: arctan power_divide eq_divide_eq)
  4909 qed
  4910 
  4911 lemma sin_arctan: "sin (arctan x) = x / sqrt (1 + x\<^sup>2)"
  4912   using add_pos_nonneg [OF zero_less_one zero_le_power2 [of x]]
  4913   using tan_arctan [of x] unfolding tan_def cos_arctan
  4914   by (simp add: eq_divide_eq)
  4915 
  4916 lemma tan_sec: "cos x \<noteq> 0 \<Longrightarrow> 1 + (tan x)\<^sup>2 = (inverse (cos x))\<^sup>2"
  4917   for x :: "'a::{real_normed_field,banach,field}"
  4918   apply (rule power_inverse [THEN subst])
  4919   apply (rule_tac c1 = "(cos x)\<^sup>2" in mult_right_cancel [THEN iffD1])
  4920    apply (auto simp add: tan_def field_simps)
  4921   done
  4922 
  4923 lemma arctan_less_iff: "arctan x < arctan y \<longleftrightarrow> x < y"
  4924   by (metis tan_monotone' arctan_lbound arctan_ubound tan_arctan)
  4925 
  4926 lemma arctan_le_iff: "arctan x \<le> arctan y \<longleftrightarrow> x \<le> y"
  4927   by (simp only: not_less [symmetric] arctan_less_iff)
  4928 
  4929 lemma arctan_eq_iff: "arctan x = arctan y \<longleftrightarrow> x = y"
  4930   by (simp only: eq_iff [where 'a=real] arctan_le_iff)
  4931 
  4932 lemma zero_less_arctan_iff [simp]: "0 < arctan x \<longleftrightarrow> 0 < x"
  4933   using arctan_less_iff [of 0 x] by simp
  4934 
  4935 lemma arctan_less_zero_iff [simp]: "arctan x < 0 \<longleftrightarrow> x < 0"
  4936   using arctan_less_iff [of x 0] by simp
  4937 
  4938 lemma zero_le_arctan_iff [simp]: "0 \<le> arctan x \<longleftrightarrow> 0 \<le> x"
  4939   using arctan_le_iff [of 0 x] by simp
  4940 
  4941 lemma arctan_le_zero_iff [simp]: "arctan x \<le> 0 \<longleftrightarrow> x \<le> 0"
  4942   using arctan_le_iff [of x 0] by simp
  4943 
  4944 lemma arctan_eq_zero_iff [simp]: "arctan x = 0 \<longleftrightarrow> x = 0"
  4945   using arctan_eq_iff [of x 0] by simp
  4946 
  4947 lemma continuous_on_arcsin': "continuous_on {-1 .. 1} arcsin"
  4948 proof -
  4949   have "continuous_on (sin ` {- pi / 2 .. pi / 2}) arcsin"
  4950     by (rule continuous_on_inv) (auto intro: continuous_intros simp: arcsin_sin)
  4951   also have "sin ` {- pi / 2 .. pi / 2} = {-1 .. 1}"
  4952   proof safe
  4953     fix x :: real
  4954     assume "x \<in> {-1..1}"
  4955     then show "x \<in> sin ` {- pi / 2..pi / 2}"
  4956       using arcsin_lbound arcsin_ubound
  4957       by (intro image_eqI[where x="arcsin x"]) auto
  4958   qed simp
  4959   finally show ?thesis .
  4960 qed
  4961 
  4962 lemma continuous_on_arcsin [continuous_intros]:
  4963   "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))"
  4964   using continuous_on_compose[of s f, OF _ continuous_on_subset[OF  continuous_on_arcsin']]
  4965   by (auto simp: comp_def subset_eq)
  4966 
  4967 lemma isCont_arcsin: "-1 < x \<Longrightarrow> x < 1 \<Longrightarrow> isCont arcsin x"
  4968   using continuous_on_arcsin'[THEN continuous_on_subset, of "{ -1 <..< 1 }"]
  4969   by (auto simp: continuous_on_eq_continuous_at subset_eq)
  4970 
  4971 lemma continuous_on_arccos': "continuous_on {-1 .. 1} arccos"
  4972 proof -
  4973   have "continuous_on (cos ` {0 .. pi}) arccos"
  4974     by (rule continuous_on_inv) (auto intro: continuous_intros simp: arccos_cos)
  4975   also have "cos ` {0 .. pi} = {-1 .. 1}"
  4976   proof safe
  4977     fix x :: real
  4978     assume "x \<in> {-1..1}"
  4979     then show "x \<in> cos ` {0..pi}"
  4980       using arccos_lbound arccos_ubound
  4981       by (intro image_eqI[where x="arccos x"]) auto
  4982   qed simp
  4983   finally show ?thesis .
  4984 qed
  4985 
  4986 lemma continuous_on_arccos [continuous_intros]:
  4987   "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))"
  4988   using continuous_on_compose[of s f, OF _ continuous_on_subset[OF  continuous_on_arccos']]
  4989   by (auto simp: comp_def subset_eq)
  4990 
  4991 lemma isCont_arccos: "-1 < x \<Longrightarrow> x < 1 \<Longrightarrow> isCont arccos x"
  4992   using continuous_on_arccos'[THEN continuous_on_subset, of "{ -1 <..< 1 }"]
  4993   by (auto simp: continuous_on_eq_continuous_at subset_eq)
  4994 
  4995 lemma isCont_arctan: "isCont arctan x"
  4996   apply (rule arctan_lbound [of x, THEN dense, THEN exE])
  4997   apply clarify
  4998   apply (rule arctan_ubound [of x, THEN dense, THEN exE])
  4999   apply clarify
  5000   apply (subgoal_tac "isCont arctan (tan (arctan x))")
  5001    apply (simp add: arctan)
  5002   apply (erule (1) isCont_inverse_function2 [where f=tan])
  5003    apply (metis arctan_tan order_le_less_trans order_less_le_trans)
  5004   apply (metis cos_gt_zero_pi isCont_tan order_less_le_trans less_le)
  5005   done
  5006 
  5007 lemma tendsto_arctan [tendsto_intros]: "(f \<longlongrightarrow> x) F \<Longrightarrow> ((\<lambda>x. arctan (f x)) \<longlongrightarrow> arctan x) F"
  5008   by (rule isCont_tendsto_compose [OF isCont_arctan])
  5009 
  5010 lemma continuous_arctan [continuous_intros]: "continuous F f \<Longrightarrow> continuous F (\<lambda>x. arctan (f x))"
  5011   unfolding continuous_def by (rule tendsto_arctan)
  5012 
  5013 lemma continuous_on_arctan [continuous_intros]:
  5014   "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. arctan (f x))"
  5015   unfolding continuous_on_def by (auto intro: tendsto_arctan)
  5016 
  5017 lemma DERIV_arcsin: "- 1 < x \<Longrightarrow> x < 1 \<Longrightarrow> DERIV arcsin x :> inverse (sqrt (1 - x\<^sup>2))"
  5018   apply (rule DERIV_inverse_function [where f=sin and a="-1" and b=1])
  5019        apply (rule DERIV_cong [OF DERIV_sin])
  5020        apply (simp add: cos_arcsin)
  5021       apply (subgoal_tac "\<bar>x\<bar>\<^sup>2 < 1\<^sup>2")
  5022        apply simp
  5023       apply (rule power_strict_mono)
  5024         apply simp
  5025        apply simp
  5026       apply simp
  5027      apply assumption
  5028     apply assumption
  5029    apply simp
  5030   apply (erule (1) isCont_arcsin)
  5031   done
  5032 
  5033 lemma DERIV_arccos: "- 1 < x \<Longrightarrow> x < 1 \<Longrightarrow> DERIV arccos x :> inverse (- sqrt (1 - x\<^sup>2))"
  5034   apply (rule DERIV_inverse_function [where f=cos and a="-1" and b=1])
  5035        apply (rule DERIV_cong [OF DERIV_cos])
  5036        apply (simp add: sin_arccos)
  5037       apply (subgoal_tac "\<bar>x\<bar>\<^sup>2 < 1\<^sup>2")
  5038        apply simp
  5039       apply (rule power_strict_mono)
  5040         apply simp
  5041        apply simp
  5042       apply simp
  5043      apply assumption
  5044     apply assumption
  5045    apply simp
  5046   apply (erule (1) isCont_arccos)
  5047   done
  5048 
  5049 lemma DERIV_arctan: "DERIV arctan x :> inverse (1 + x\<^sup>2)"
  5050   apply (rule DERIV_inverse_function [where f=tan and a="x - 1" and b="x + 1"])
  5051        apply (rule DERIV_cong [OF DERIV_tan])
  5052         apply (rule cos_arctan_not_zero)
  5053        apply (simp_all add: add_pos_nonneg arctan isCont_arctan)
  5054    apply (simp add: arctan power_inverse [symmetric] tan_sec [symmetric])
  5055   apply (subgoal_tac "0 < 1 + x\<^sup>2")
  5056    apply simp
  5057   apply (simp_all add: add_pos_nonneg arctan isCont_arctan)
  5058   done
  5059 
  5060 declare
  5061   DERIV_arcsin[THEN DERIV_chain2, derivative_intros]
  5062   DERIV_arcsin[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]
  5063   DERIV_arccos[THEN DERIV_chain2, derivative_intros]
  5064   DERIV_arccos[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]
  5065   DERIV_arctan[THEN DERIV_chain2, derivative_intros]
  5066   DERIV_arctan[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]
  5067 
  5068 lemma filterlim_tan_at_right: "filterlim tan at_bot (at_right (- (pi/2)))"
  5069   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])
  5070      (auto simp: arctan le_less eventually_at dist_real_def simp del: less_divide_eq_numeral1
  5071            intro!: tan_monotone exI[of _ "pi/2"])
  5072 
  5073 lemma filterlim_tan_at_left: "filterlim tan at_top (at_left (pi/2))"
  5074   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])
  5075      (auto simp: arctan le_less eventually_at dist_real_def simp del: less_divide_eq_numeral1
  5076            intro!: tan_monotone exI[of _ "pi/2"])
  5077 
  5078 lemma tendsto_arctan_at_top: "(arctan \<longlongrightarrow> (pi/2)) at_top"
  5079 proof (rule tendstoI)
  5080   fix e :: real
  5081   assume "0 < e"
  5082   define y where "y = pi/2 - min (pi/2) e"
  5083   then have y: "0 \<le> y" "y < pi/2" "pi/2 \<le> e + y"
  5084     using \<open>0 < e\<close> by auto
  5085   show "eventually (\<lambda>x. dist (arctan x) (pi / 2) < e) at_top"
  5086   proof (intro eventually_at_top_dense[THEN iffD2] exI allI impI)
  5087     fix x
  5088     assume "tan y < x"
  5089     then have "arctan (tan y) < arctan x"
  5090       by (simp add: arctan_less_iff)
  5091     with y have "y < arctan x"
  5092       by (subst (asm) arctan_tan) simp_all
  5093     with arctan_ubound[of x, arith] y \<open>0 < e\<close>
  5094     show "dist (arctan x) (pi / 2) < e"
  5095       by (simp add: dist_real_def)
  5096   qed
  5097 qed
  5098 
  5099 lemma tendsto_arctan_at_bot: "(arctan \<longlongrightarrow> - (pi/2)) at_bot"
  5100   unfolding filterlim_at_bot_mirror arctan_minus
  5101   by (intro tendsto_minus tendsto_arctan_at_top)
  5102 
  5103 
  5104 subsection \<open>Prove Totality of the Trigonometric Functions\<close>
  5105 
  5106 lemma cos_arccos_abs: "\<bar>y\<bar> \<le> 1 \<Longrightarrow> cos (arccos y) = y"
  5107   by (simp add: abs_le_iff)
  5108 
  5109 lemma sin_arccos_abs: "\<bar>y\<bar> \<le> 1 \<Longrightarrow> sin (arccos y) = sqrt (1 - y\<^sup>2)"
  5110   by (simp add: sin_arccos abs_le_iff)
  5111 
  5112 lemma sin_mono_less_eq:
  5113   "- (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"
  5114   by (metis not_less_iff_gr_or_eq sin_monotone_2pi)
  5115 
  5116 lemma sin_mono_le_eq:
  5117   "- (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"
  5118   by (meson leD le_less_linear sin_monotone_2pi sin_monotone_2pi_le)
  5119 
  5120 lemma sin_inj_pi:
  5121   "- (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"
  5122   by (metis arcsin_sin)
  5123 
  5124 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"
  5125   by (meson cos_monotone_0_pi cos_monotone_0_pi_le leD le_less_linear)
  5126 
  5127 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"
  5128   by (metis arccos_cos cos_monotone_0_pi_le eq_iff linear)
  5129 
  5130 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"
  5131   by (metis arccos_cos)
  5132 
  5133 lemma arccos_le_pi2: "\<lbrakk>0 \<le> y; y \<le> 1\<rbrakk> \<Longrightarrow> arccos y \<le> pi/2"
  5134   by (metis (mono_tags) arccos_0 arccos cos_le_one cos_monotone_0_pi_le
  5135       cos_pi cos_pi_half pi_half_ge_zero antisym_conv less_eq_neg_nonpos linear minus_minus order.trans order_refl)
  5136 
  5137 lemma sincos_total_pi_half:
  5138   assumes "0 \<le> x" "0 \<le> y" "x\<^sup>2 + y\<^sup>2 = 1"
  5139   shows "\<exists>t. 0 \<le> t \<and> t \<le> pi/2 \<and> x = cos t \<and> y = sin t"
  5140 proof -
  5141   have x1: "x \<le> 1"
  5142     using assms by (metis le_add_same_cancel1 power2_le_imp_le power_one zero_le_power2)
  5143   with assms have *: "0 \<le> arccos x" "cos (arccos x) = x"
  5144     by (auto simp: arccos)
  5145   from assms have "y = sqrt (1 - x\<^sup>2)"
  5146     by (metis abs_of_nonneg add.commute add_diff_cancel real_sqrt_abs)
  5147   with x1 * assms arccos_le_pi2 [of x] show ?thesis
  5148     by (rule_tac x="arccos x" in exI) (auto simp: sin_arccos)
  5149 qed
  5150 
  5151 lemma sincos_total_pi:
  5152   assumes "0 \<le> y" "x\<^sup>2 + y\<^sup>2 = 1"
  5153   shows "\<exists>t. 0 \<le> t \<and> t \<le> pi \<and> x = cos t \<and> y = sin t"
  5154 proof (cases rule: le_cases [of 0 x])
  5155   case le
  5156   from sincos_total_pi_half [OF le] show ?thesis
  5157     by (metis pi_ge_two pi_half_le_two add.commute add_le_cancel_left add_mono assms)
  5158 next
  5159   case ge
  5160   then have "0 \<le> -x"
  5161     by simp
  5162   then obtain t where t: "t\<ge>0" "t \<le> pi/2" "-x = cos t" "y = sin t"
  5163     using sincos_total_pi_half assms
  5164     by auto (metis \<open>0 \<le> - x\<close> power2_minus)
  5165   show ?thesis
  5166     by (rule exI [where x = "pi -t"]) (use t in auto)
  5167 qed
  5168 
  5169 lemma sincos_total_2pi_le:
  5170   assumes "x\<^sup>2 + y\<^sup>2 = 1"
  5171   shows "\<exists>t. 0 \<le> t \<and> t \<le> 2 * pi \<and> x = cos t \<and> y = sin t"
  5172 proof (cases rule: le_cases [of 0 y])
  5173   case le
  5174   from sincos_total_pi [OF le] show ?thesis
  5175     by (metis assms le_add_same_cancel1 mult.commute mult_2_right order.trans)
  5176 next
  5177   case ge
  5178   then have "0 \<le> -y"
  5179     by simp
  5180   then obtain t where t: "t\<ge>0" "t \<le> pi" "x = cos t" "-y = sin t"
  5181     using sincos_total_pi assms
  5182     by auto (metis \<open>0 \<le> - y\<close> power2_minus)
  5183   show ?thesis
  5184     by (rule exI [where x = "2 * pi - t"]) (use t in auto)
  5185 qed
  5186 
  5187 lemma sincos_total_2pi:
  5188   assumes "x\<^sup>2 + y\<^sup>2 = 1"
  5189   obtains t where "0 \<le> t" "t < 2*pi" "x = cos t" "y = sin t"
  5190 proof -
  5191   from sincos_total_2pi_le [OF assms]
  5192   obtain t where t: "0 \<le> t" "t \<le> 2*pi" "x = cos t" "y = sin t"
  5193     by blast
  5194   show ?thesis
  5195     by (cases "t = 2 * pi") (use t that in \<open>force+\<close>)
  5196 qed
  5197 
  5198 lemma arcsin_less_mono: "\<bar>x\<bar> \<le> 1 \<Longrightarrow> \<bar>y\<bar> \<le> 1 \<Longrightarrow> arcsin x < arcsin y \<longleftrightarrow> x < y"
  5199   by (rule trans [OF sin_mono_less_eq [symmetric]]) (use arcsin_ubound arcsin_lbound in auto)
  5200 
  5201 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"
  5202   using arcsin_less_mono not_le by blast
  5203 
  5204 lemma arcsin_less_arcsin: "- 1 \<le> x \<Longrightarrow> x < y \<Longrightarrow> y \<le> 1 \<Longrightarrow> arcsin x < arcsin y"
  5205   using arcsin_less_mono by auto
  5206 
  5207 lemma arcsin_le_arcsin: "- 1 \<le> x \<Longrightarrow> x \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> arcsin x \<le> arcsin y"
  5208   using arcsin_le_mono by auto
  5209 
  5210 lemma arccos_less_mono: "\<bar>x\<bar> \<le> 1 \<Longrightarrow> \<bar>y\<bar> \<le> 1 \<Longrightarrow> arccos x < arccos y \<longleftrightarrow> y < x"
  5211   by (rule trans [OF cos_mono_less_eq [symmetric]]) (use arccos_ubound arccos_lbound in auto)
  5212 
  5213 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"
  5214   using arccos_less_mono [of y x] by (simp add: not_le [symmetric])
  5215 
  5216 lemma arccos_less_arccos: "- 1 \<le> x \<Longrightarrow> x < y \<Longrightarrow> y \<le> 1 \<Longrightarrow> arccos y < arccos x"
  5217   using arccos_less_mono by auto
  5218 
  5219 lemma arccos_le_arccos: "- 1 \<le> x \<Longrightarrow> x \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> arccos y \<le> arccos x"
  5220   using arccos_le_mono by auto
  5221 
  5222 lemma arccos_eq_iff: "\<bar>x\<bar> \<le> 1 \<and> \<bar>y\<bar> \<le> 1 \<Longrightarrow> arccos x = arccos y \<longleftrightarrow> x = y"
  5223   using cos_arccos_abs by fastforce
  5224 
  5225 
  5226 subsection \<open>Machin's formula\<close>
  5227 
  5228 lemma arctan_one: "arctan 1 = pi / 4"
  5229   by (rule arctan_unique) (simp_all add: tan_45 m2pi_less_pi)
  5230 
  5231 lemma tan_total_pi4:
  5232   assumes "\<bar>x\<bar> < 1"
  5233   shows "\<exists>z. - (pi / 4) < z \<and> z < pi / 4 \<and> tan z = x"
  5234 proof
  5235   show "- (pi / 4) < arctan x \<and> arctan x < pi / 4 \<and> tan (arctan x) = x"
  5236     unfolding arctan_one [symmetric] arctan_minus [symmetric]
  5237     unfolding arctan_less_iff
  5238     using assms by (auto simp add: arctan)
  5239 qed
  5240 
  5241 lemma arctan_add:
  5242   assumes "\<bar>x\<bar> \<le> 1" "\<bar>y\<bar> < 1"
  5243   shows "arctan x + arctan y = arctan ((x + y) / (1 - x * y))"
  5244 proof (rule arctan_unique [symmetric])
  5245   have "- (pi / 4) \<le> arctan x" "- (pi / 4) < arctan y"
  5246     unfolding arctan_one [symmetric] arctan_minus [symmetric]
  5247     unfolding arctan_le_iff arctan_less_iff
  5248     using assms by auto
  5249   from add_le_less_mono [OF this] show 1: "- (pi / 2) < arctan x + arctan y"
  5250     by simp
  5251   have "arctan x \<le> pi / 4" "arctan y < pi / 4"
  5252     unfolding arctan_one [symmetric]
  5253     unfolding arctan_le_iff arctan_less_iff
  5254     using assms by auto
  5255   from add_le_less_mono [OF this] show 2: "arctan x + arctan y < pi / 2"
  5256     by simp
  5257   show "tan (arctan x + arctan y) = (x + y) / (1 - x * y)"
  5258     using cos_gt_zero_pi [OF 1 2] by (simp add: arctan tan_add)
  5259 qed
  5260 
  5261 lemma arctan_double: "\<bar>x\<bar> < 1 \<Longrightarrow> 2 * arctan x = arctan ((2 * x) / (1 - x\<^sup>2))"
  5262   by (metis arctan_add linear mult_2 not_less power2_eq_square)
  5263 
  5264 theorem machin: "pi / 4 = 4 * arctan (1 / 5) - arctan (1 / 239)"
  5265 proof -
  5266   have "\<bar>1 / 5\<bar> < (1 :: real)"
  5267     by auto
  5268   from arctan_add[OF less_imp_le[OF this] this] have "2 * arctan (1 / 5) = arctan (5 / 12)"
  5269     by auto
  5270   moreover
  5271   have "\<bar>5 / 12\<bar> < (1 :: real)"
  5272     by auto
  5273   from arctan_add[OF less_imp_le[OF this] this] have "2 * arctan (5 / 12) = arctan (120 / 119)"
  5274     by auto
  5275   moreover
  5276   have "\<bar>1\<bar> \<le> (1::real)" and "\<bar>1 / 239\<bar> < (1::real)"
  5277     by auto
  5278   from arctan_add[OF this] have "arctan 1 + arctan (1 / 239) = arctan (120 / 119)"
  5279     by auto
  5280   ultimately have "arctan 1 + arctan (1 / 239) = 4 * arctan (1 / 5)"
  5281     by auto
  5282   then show ?thesis
  5283     unfolding arctan_one by algebra
  5284 qed
  5285 
  5286 lemma machin_Euler: "5 * arctan (1 / 7) + 2 * arctan (3 / 79) = pi / 4"
  5287 proof -
  5288   have 17: "\<bar>1 / 7\<bar> < (1 :: real)" by auto
  5289   with arctan_double have "2 * arctan (1 / 7) = arctan (7 / 24)"
  5290     by simp (simp add: field_simps)
  5291   moreover
  5292   have "\<bar>7 / 24\<bar> < (1 :: real)" by auto
  5293   with arctan_double have "2 * arctan (7 / 24) = arctan (336 / 527)"
  5294     by simp (simp add: field_simps)
  5295   moreover
  5296   have "\<bar>336 / 527\<bar> < (1 :: real)" by auto
  5297   from arctan_add[OF less_imp_le[OF 17] this]
  5298   have "arctan(1/7) + arctan (336 / 527) = arctan (2879 / 3353)"
  5299     by auto
  5300   ultimately have I: "5 * arctan (1 / 7) = arctan (2879 / 3353)" by auto
  5301   have 379: "\<bar>3 / 79\<bar> < (1 :: real)" by auto
  5302   with arctan_double have II: "2 * arctan (3 / 79) = arctan (237 / 3116)"
  5303     by simp (simp add: field_simps)
  5304   have *: "\<bar>2879 / 3353\<bar> < (1 :: real)" by auto
  5305   have "\<bar>237 / 3116\<bar> < (1 :: real)" by auto
  5306   from arctan_add[OF less_imp_le[OF *] this] have "arctan (2879/3353) + arctan (237/3116) = pi/4"
  5307     by (simp add: arctan_one)
  5308   with I II show ?thesis by auto
  5309 qed
  5310 
  5311 (*But could also prove MACHIN_GAUSS:
  5312   12 * arctan(1/18) + 8 * arctan(1/57) - 5 * arctan(1/239) = pi/4*)
  5313 
  5314 
  5315 subsection \<open>Introducing the inverse tangent power series\<close>
  5316 
  5317 lemma monoseq_arctan_series:
  5318   fixes x :: real
  5319   assumes "\<bar>x\<bar> \<le> 1"
  5320   shows "monoseq (\<lambda>n. 1 / real (n * 2 + 1) * x^(n * 2 + 1))"
  5321     (is "monoseq ?a")
  5322 proof (cases "x = 0")
  5323   case True
  5324   then show ?thesis by (auto simp: monoseq_def)
  5325 next
  5326   case False
  5327   have "norm x \<le> 1" and "x \<le> 1" and "-1 \<le> x"
  5328     using assms by auto
  5329   show "monoseq ?a"
  5330   proof -
  5331     have mono: "1 / real (Suc (Suc n * 2)) * x ^ Suc (Suc n * 2) \<le>
  5332         1 / real (Suc (n * 2)) * x ^ Suc (n * 2)"
  5333       if "0 \<le> x" and "x \<le> 1" for n and x :: real
  5334     proof (rule mult_mono)
  5335       show "1 / real (Suc (Suc n * 2)) \<le> 1 / real (Suc (n * 2))"
  5336         by (rule frac_le) simp_all
  5337       show "0 \<le> 1 / real (Suc (n * 2))"
  5338         by auto
  5339       show "x ^ Suc (Suc n * 2) \<le> x ^ Suc (n * 2)"
  5340         by (rule power_decreasing) (simp_all add: \<open>0 \<le> x\<close> \<open>x \<le> 1\<close>)
  5341       show "0 \<le> x ^ Suc (Suc n * 2)"
  5342         by (rule zero_le_power) (simp add: \<open>0 \<le> x\<close>)
  5343     qed
  5344     show ?thesis
  5345     proof (cases "0 \<le> x")
  5346       case True
  5347       from mono[OF this \<open>x \<le> 1\<close>, THEN allI]
  5348       show ?thesis
  5349         unfolding Suc_eq_plus1[symmetric] by (rule mono_SucI2)
  5350     next
  5351       case False
  5352       then have "0 \<le> - x" and "- x \<le> 1"
  5353         using \<open>-1 \<le> x\<close> by auto
  5354       from mono[OF this]
  5355       have "1 / real (Suc (Suc n * 2)) * x ^ Suc (Suc n * 2) \<ge>
  5356           1 / real (Suc (n * 2)) * x ^ Suc (n * 2)" for n
  5357         using \<open>0 \<le> -x\<close> by auto
  5358       then show ?thesis
  5359         unfolding Suc_eq_plus1[symmetric] by (rule mono_SucI1[OF allI])
  5360     qed
  5361   qed
  5362 qed
  5363 
  5364 lemma zeroseq_arctan_series:
  5365   fixes x :: real
  5366   assumes "\<bar>x\<bar> \<le> 1"
  5367   shows "(\<lambda>n. 1 / real (n * 2 + 1) * x^(n * 2 + 1)) \<longlonglongrightarrow> 0"
  5368     (is "?a \<longlonglongrightarrow> 0")
  5369 proof (cases "x = 0")
  5370   case True
  5371   then show ?thesis by simp
  5372 next
  5373   case False
  5374   have "norm x \<le> 1" and "x \<le> 1" and "-1 \<le> x"
  5375     using assms by auto
  5376   show "?a \<longlonglongrightarrow> 0"
  5377   proof (cases "\<bar>x\<bar> < 1")
  5378     case True
  5379     then have "norm x < 1" by auto
  5380     from tendsto_mult[OF LIMSEQ_inverse_real_of_nat LIMSEQ_power_zero[OF \<open>norm x < 1\<close>, THEN LIMSEQ_Suc]]
  5381     have "(\<lambda>n. 1 / real (n + 1) * x ^ (n + 1)) \<longlonglongrightarrow> 0"
  5382       unfolding inverse_eq_divide Suc_eq_plus1 by simp
  5383     then show ?thesis
  5384       using pos2 by (rule LIMSEQ_linear)
  5385   next
  5386     case False
  5387     then have "x = -1 \<or> x = 1"
  5388       using \<open>\<bar>x\<bar> \<le> 1\<close> by auto
  5389     then have n_eq: "\<And> n. x ^ (n * 2 + 1) = x"
  5390       unfolding One_nat_def by auto
  5391     from tendsto_mult[OF LIMSEQ_inverse_real_of_nat[THEN LIMSEQ_linear, OF pos2, unfolded inverse_eq_divide] tendsto_const[of x]]
  5392     show ?thesis
  5393       unfolding n_eq Suc_eq_plus1 by auto
  5394   qed
  5395 qed
  5396 
  5397 lemma summable_arctan_series:
  5398   fixes n :: nat
  5399   assumes "\<bar>x\<bar> \<le> 1"
  5400   shows "summable (\<lambda> k. (-1)^k * (1 / real (k*2+1) * x ^ (k*2+1)))"
  5401     (is "summable (?c x)")
  5402   by (rule summable_Leibniz(1),
  5403       rule zeroseq_arctan_series[OF assms],
  5404       rule monoseq_arctan_series[OF assms])
  5405 
  5406 lemma DERIV_arctan_series:
  5407   assumes "\<bar>x\<bar> < 1"
  5408   shows "DERIV (\<lambda>x'. \<Sum>k. (-1)^k * (1 / real (k * 2 + 1) * x' ^ (k * 2 + 1))) x :>
  5409       (\<Sum>k. (-1)^k * x^(k * 2))"
  5410     (is "DERIV ?arctan _ :> ?Int")
  5411 proof -
  5412   let ?f = "\<lambda>n. if even n then (-1)^(n div 2) * 1 / real (Suc n) else 0"
  5413 
  5414   have n_even: "even n \<Longrightarrow> 2 * (n div 2) = n" for n :: nat
  5415     by presburger
  5416   then have if_eq: "?f n * real (Suc n) * x'^n =
  5417       (if even n then (-1)^(n div 2) * x'^(2 * (n div 2)) else 0)"
  5418     for n x'
  5419     by auto
  5420 
  5421   have summable_Integral: "summable (\<lambda> n. (- 1) ^ n * x^(2 * n))" if "\<bar>x\<bar> < 1" for x :: real
  5422   proof -
  5423     from that have "x\<^sup>2 < 1"
  5424       by (simp add: abs_square_less_1)
  5425     have "summable (\<lambda> n. (- 1) ^ n * (x\<^sup>2) ^n)"
  5426       by (rule summable_Leibniz(1))
  5427         (auto intro!: LIMSEQ_realpow_zero monoseq_realpow \<open>x\<^sup>2 < 1\<close> order_less_imp_le[OF \<open>x\<^sup>2 < 1\<close>])
  5428     then show ?thesis
  5429       by (simp only: power_mult)
  5430   qed
  5431 
  5432   have sums_even: "op sums f = op sums (\<lambda> n. if even n then f (n div 2) else 0)"
  5433     for f :: "nat \<Rightarrow> real"
  5434   proof -
  5435     have "f sums x = (\<lambda> n. if even n then f (n div 2) else 0) sums x" for x :: real
  5436     proof
  5437       assume "f sums x"
  5438       from sums_if[OF sums_zero this] show "(\<lambda>n. if even n then f (n div 2) else 0) sums x"
  5439         by auto
  5440     next
  5441       assume "(\<lambda> n. if even n then f (n div 2) else 0) sums x"
  5442       from LIMSEQ_linear[OF this[simplified sums_def] pos2, simplified sum_split_even_odd[simplified mult.commute]]
  5443       show "f sums x"
  5444         unfolding sums_def by auto
  5445     qed
  5446     then show ?thesis ..
  5447   qed
  5448 
  5449   have Int_eq: "(\<Sum>n. ?f n * real (Suc n) * x^n) = ?Int"
  5450     unfolding if_eq mult.commute[of _ 2]
  5451       suminf_def sums_even[of "\<lambda> n. (- 1) ^ n * x ^ (2 * n)", symmetric]
  5452     by auto
  5453 
  5454   have arctan_eq: "(\<Sum>n. ?f n * x^(Suc n)) = ?arctan x" for x
  5455   proof -
  5456     have if_eq': "\<And>n. (if even n then (- 1) ^ (n div 2) * 1 / real (Suc n) else 0) * x ^ Suc n =
  5457       (if even n then (- 1) ^ (n div 2) * (1 / real (Suc (2 * (n div 2))) * x ^ Suc (2 * (n div 2))) else 0)"
  5458       using n_even by auto
  5459     have idx_eq: "\<And>n. n * 2 + 1 = Suc (2 * n)"
  5460       by auto
  5461     then show ?thesis
  5462       unfolding if_eq' idx_eq suminf_def
  5463         sums_even[of "\<lambda> n. (- 1) ^ n * (1 / real (Suc (2 * n)) * x ^ Suc (2 * n))", symmetric]
  5464       by auto
  5465   qed
  5466 
  5467   have "DERIV (\<lambda> x. \<Sum> n. ?f n * x^(Suc n)) x :> (\<Sum>n. ?f n * real (Suc n) * x^n)"
  5468   proof (rule DERIV_power_series')
  5469     show "x \<in> {- 1 <..< 1}"
  5470       using \<open>\<bar> x \<bar> < 1\<close> by auto
  5471     show "summable (\<lambda> n. ?f n * real (Suc n) * x'^n)"
  5472       if x'_bounds: "x' \<in> {- 1 <..< 1}" for x' :: real
  5473     proof -
  5474       from that have "\<bar>x'\<bar> < 1" by auto
  5475       then have *: "summable (\<lambda>n. (- 1) ^ n * x' ^ (2 * n))"
  5476         by (rule summable_Integral)
  5477       show ?thesis
  5478         unfolding if_eq
  5479         apply (rule sums_summable [where l="0 + (\<Sum>n. (-1)^n * x'^(2 * n))"])
  5480         apply (rule sums_if)
  5481          apply (rule sums_zero)
  5482         apply (rule summable_sums)
  5483         apply (rule *)
  5484         done
  5485     qed
  5486   qed auto
  5487   then show ?thesis
  5488     by (simp only: Int_eq arctan_eq)
  5489 qed
  5490 
  5491 lemma arctan_series:
  5492   assumes "\<bar>x\<bar> \<le> 1"
  5493   shows "arctan x = (\<Sum>k. (-1)^k * (1 / real (k * 2 + 1) * x ^ (k * 2 + 1)))"
  5494     (is "_ = suminf (\<lambda> n. ?c x n)")
  5495 proof -
  5496   let ?c' = "\<lambda>x n. (-1)^n * x^(n*2)"
  5497 
  5498   have DERIV_arctan_suminf: "DERIV (\<lambda> x. suminf (?c x)) x :> (suminf (?c' x))"
  5499     if "0 < r" and "r < 1" and "\<bar>x\<bar> < r" for r x :: real
  5500   proof (rule DERIV_arctan_series)
  5501     from that show "\<bar>x\<bar> < 1"
  5502       using \<open>r < 1\<close> and \<open>\<bar>x\<bar> < r\<close> by auto
  5503   qed
  5504 
  5505   {
  5506     fix x :: real
  5507     assume "\<bar>x\<bar> \<le> 1"
  5508     note summable_Leibniz[OF zeroseq_arctan_series[OF this] monoseq_arctan_series[OF this]]
  5509   } note arctan_series_borders = this
  5510 
  5511   have when_less_one: "arctan x = (\<Sum>k. ?c x k)" if "\<bar>x\<bar> < 1" for x :: real
  5512   proof -
  5513     obtain r where "\<bar>x\<bar> < r" and "r < 1"
  5514       using dense[OF \<open>\<bar>x\<bar> < 1\<close>] by blast
  5515     then have "0 < r" and "- r < x" and "x < r" by auto
  5516 
  5517     have suminf_eq_arctan_bounded: "suminf (?c x) - arctan x = suminf (?c a) - arctan a"
  5518       if "-r < a" and "b < r" and "a < b" and "a \<le> x" and "x \<le> b" for x a b
  5519     proof -
  5520       from that have "\<bar>x\<bar> < r" by auto
  5521       show "suminf (?c x) - arctan x = suminf (?c a) - arctan a"
  5522       proof (rule DERIV_isconst2[of "a" "b"])
  5523         show "a < b" and "a \<le> x" and "x \<le> b"
  5524           using \<open>a < b\<close> \<open>a \<le> x\<close> \<open>x \<le> b\<close> by auto
  5525         have "\<forall>x. - r < x \<and> x < r \<longrightarrow> DERIV (\<lambda> x. suminf (?c x) - arctan x) x :> 0"
  5526         proof (rule allI, rule impI)
  5527           fix x
  5528           assume "-r < x \<and> x < r"
  5529           then have "\<bar>x\<bar> < r" by auto
  5530           with \<open>r < 1\<close> have "\<bar>x\<bar> < 1" by auto
  5531           have "\<bar>- (x\<^sup>2)\<bar> < 1" using abs_square_less_1 \<open>\<bar>x\<bar> < 1\<close> by auto
  5532           then have "(\<lambda>n. (- (x\<^sup>2)) ^ n) sums (1 / (1 - (- (x\<^sup>2))))"
  5533             unfolding real_norm_def[symmetric] by (rule geometric_sums)
  5534           then have "(?c' x) sums (1 / (1 - (- (x\<^sup>2))))"
  5535             unfolding power_mult_distrib[symmetric] power_mult mult.commute[of _ 2] by auto
  5536           then have suminf_c'_eq_geom: "inverse (1 + x\<^sup>2) = suminf (?c' x)"
  5537             using sums_unique unfolding inverse_eq_divide by auto
  5538           have "DERIV (\<lambda> x. suminf (?c x)) x :> (inverse (1 + x\<^sup>2))"
  5539             unfolding suminf_c'_eq_geom
  5540             by (rule DERIV_arctan_suminf[OF \<open>0 < r\<close> \<open>r < 1\<close> \<open>\<bar>x\<bar> < r\<close>])
  5541           from DERIV_diff [OF this DERIV_arctan] show "DERIV (\<lambda>x. suminf (?c x) - arctan x) x :> 0"
  5542             by auto
  5543         qed
  5544         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"
  5545           using \<open>-r < a\<close> \<open>b < r\<close> by auto
  5546         then show "\<forall>y. a < y \<and> y < b \<longrightarrow> DERIV (\<lambda>x. suminf (?c x) - arctan x) y :> 0"
  5547           using \<open>\<bar>x\<bar> < r\<close> by auto
  5548         show "\<forall>y. a \<le> y \<and> y \<le> b \<longrightarrow> isCont (\<lambda>x. suminf (?c x) - arctan x) y"
  5549           using DERIV_in_rball DERIV_isCont by auto
  5550       qed
  5551     qed
  5552 
  5553     have suminf_arctan_zero: "suminf (?c 0) - arctan 0 = 0"
  5554       unfolding Suc_eq_plus1[symmetric] power_Suc2 mult_zero_right arctan_zero_zero suminf_zero
  5555       by auto
  5556 
  5557     have "suminf (?c x) - arctan x = 0"
  5558     proof (cases "x = 0")
  5559       case True
  5560       then show ?thesis
  5561         using suminf_arctan_zero by auto
  5562     next
  5563       case False
  5564       then have "0 < \<bar>x\<bar>" and "- \<bar>x\<bar> < \<bar>x\<bar>"
  5565         by auto
  5566       have "suminf (?c (- \<bar>x\<bar>)) - arctan (- \<bar>x\<bar>) = suminf (?c 0) - arctan 0"
  5567         by (rule suminf_eq_arctan_bounded[where x1="0" and a1="-\<bar>x\<bar>" and b1="\<bar>x\<bar>", symmetric])
  5568           (simp_all only: \<open>\<bar>x\<bar> < r\<close> \<open>-\<bar>x\<bar> < \<bar>x\<bar>\<close> neg_less_iff_less)
  5569       moreover
  5570       have "suminf (?c x) - arctan x = suminf (?c (- \<bar>x\<bar>)) - arctan (- \<bar>x\<bar>)"
  5571         by (rule suminf_eq_arctan_bounded[where x1="x" and a1="- \<bar>x\<bar>" and b1="\<bar>x\<bar>"])
  5572            (simp_all only: \<open>\<bar>x\<bar> < r\<close> \<open>- \<bar>x\<bar> < \<bar>x\<bar>\<close> neg_less_iff_less)
  5573       ultimately show ?thesis
  5574         using suminf_arctan_zero by auto
  5575     qed
  5576     then show ?thesis by auto
  5577   qed
  5578 
  5579   show "arctan x = suminf (\<lambda>n. ?c x n)"
  5580   proof (cases "\<bar>x\<bar> < 1")
  5581     case True
  5582     then show ?thesis by (rule when_less_one)
  5583   next
  5584     case False
  5585     then have "\<bar>x\<bar> = 1" using \<open>\<bar>x\<bar> \<le> 1\<close> by auto
  5586     let ?a = "\<lambda>x n. \<bar>1 / real (n * 2 + 1) * x^(n * 2 + 1)\<bar>"
  5587     let ?diff = "\<lambda>x n. \<bar>arctan x - (\<Sum>i<n. ?c x i)\<bar>"
  5588     have "?diff 1 n \<le> ?a 1 n" for n :: nat
  5589     proof -
  5590       have "0 < (1 :: real)" by auto
  5591       moreover
  5592       have "?diff x n \<le> ?a x n" if "0 < x" and "x < 1" for x :: real
  5593       proof -
  5594         from that have "\<bar>x\<bar> \<le> 1" and "\<bar>x\<bar> < 1"
  5595           by auto
  5596         from \<open>0 < x\<close> have "0 < 1 / real (0 * 2 + (1::nat)) * x ^ (0 * 2 + 1)"
  5597           by auto
  5598         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]
  5599         have "0 < 1 / real (n*2+1) * x^(n*2+1)"
  5600           by (rule mult_pos_pos) (simp_all only: zero_less_power[OF \<open>0 < x\<close>], auto)
  5601         then have a_pos: "?a x n = 1 / real (n*2+1) * x^(n*2+1)"
  5602           by (rule abs_of_pos)
  5603         show ?thesis
  5604         proof (cases "even n")
  5605           case True
  5606           then have sgn_pos: "(-1)^n = (1::real)" by auto
  5607           from \<open>even n\<close> obtain m where "n = 2 * m" ..
  5608           then have "2 * m = n" ..
  5609           from bounds[of m, unfolded this atLeastAtMost_iff]
  5610           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))"
  5611             by auto
  5612           also have "\<dots> = ?c x n" by auto
  5613           also have "\<dots> = ?a x n" unfolding sgn_pos a_pos by auto
  5614           finally show ?thesis .
  5615         next
  5616           case False
  5617           then have sgn_neg: "(-1)^n = (-1::real)" by auto
  5618           from \<open>odd n\<close> obtain m where "n = 2 * m + 1" ..
  5619           then have m_def: "2 * m + 1 = n" ..
  5620           then have m_plus: "2 * (m + 1) = n + 1" by auto
  5621           from bounds[of "m + 1", unfolded this atLeastAtMost_iff, THEN conjunct1] bounds[of m, unfolded m_def atLeastAtMost_iff, THEN conjunct2]
  5622           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
  5623           also have "\<dots> = - ?c x n" by auto
  5624           also have "\<dots> = ?a x n" unfolding sgn_neg a_pos by auto
  5625           finally show ?thesis .
  5626         qed
  5627       qed
  5628       hence "\<forall>x \<in> { 0 <..< 1 }. 0 \<le> ?a x n - ?diff x n" by auto
  5629       moreover have "isCont (\<lambda> x. ?a x n - ?diff x n) x" for x
  5630         unfolding diff_conv_add_uminus divide_inverse
  5631         by (auto intro!: isCont_add isCont_rabs continuous_ident isCont_minus isCont_arctan
  5632           isCont_inverse isCont_mult isCont_power continuous_const isCont_setsum
  5633           simp del: add_uminus_conv_diff)
  5634       ultimately have "0 \<le> ?a 1 n - ?diff 1 n"
  5635         by (rule LIM_less_bound)
  5636       then show ?thesis by auto
  5637     qed
  5638     have "?a 1 \<longlonglongrightarrow> 0"
  5639       unfolding tendsto_rabs_zero_iff power_one divide_inverse One_nat_def
  5640       by (auto intro!: tendsto_mult LIMSEQ_linear LIMSEQ_inverse_real_of_nat simp del: of_nat_Suc)
  5641     have "?diff 1 \<longlonglongrightarrow> 0"
  5642     proof (rule LIMSEQ_I)
  5643       fix r :: real
  5644       assume "0 < r"
  5645       obtain N :: nat where N_I: "N \<le> n \<Longrightarrow> ?a 1 n < r" for n
  5646         using LIMSEQ_D[OF \<open>?a 1 \<longlonglongrightarrow> 0\<close> \<open>0 < r\<close>] by auto
  5647       have "norm (?diff 1 n - 0) < r" if "N \<le> n" for n
  5648         using \<open>?diff 1 n \<le> ?a 1 n\<close> N_I[OF that] by auto
  5649       then show "\<exists>N. \<forall> n \<ge> N. norm (?diff 1 n - 0) < r" by blast
  5650     qed
  5651     from this [unfolded tendsto_rabs_zero_iff, THEN tendsto_add [OF _ tendsto_const], of "- arctan 1", THEN tendsto_minus]
  5652     have "(?c 1) sums (arctan 1)" unfolding sums_def by auto
  5653     then have "arctan 1 = (\<Sum>i. ?c 1 i)" by (rule sums_unique)
  5654 
  5655     show ?thesis
  5656     proof (cases "x = 1")
  5657       case True
  5658       then show ?thesis by (simp add: \<open>arctan 1 = (\<Sum> i. ?c 1 i)\<close>)
  5659     next
  5660       case False
  5661       then have "x = -1" using \<open>\<bar>x\<bar> = 1\<close> by auto
  5662 
  5663       have "- (pi / 2) < 0" using pi_gt_zero by auto
  5664       have "- (2 * pi) < 0" using pi_gt_zero by auto
  5665 
  5666       have c_minus_minus: "?c (- 1) i = - ?c 1 i" for i by auto
  5667 
  5668       have "arctan (- 1) = arctan (tan (-(pi / 4)))"
  5669         unfolding tan_45 tan_minus ..
  5670       also have "\<dots> = - (pi / 4)"
  5671         by (rule arctan_tan) (auto simp: order_less_trans[OF \<open>- (pi / 2) < 0\<close> pi_gt_zero])
  5672       also have "\<dots> = - (arctan (tan (pi / 4)))"
  5673         unfolding neg_equal_iff_equal
  5674         by (rule arctan_tan[symmetric]) (auto simp: order_less_trans[OF \<open>- (2 * pi) < 0\<close> pi_gt_zero])
  5675       also have "\<dots> = - (arctan 1)"
  5676         unfolding tan_45 ..
  5677       also have "\<dots> = - (\<Sum> i. ?c 1 i)"
  5678         using \<open>arctan 1 = (\<Sum> i. ?c 1 i)\<close> by auto
  5679       also have "\<dots> = (\<Sum> i. ?c (- 1) i)"
  5680         using suminf_minus[OF sums_summable[OF \<open>(?c 1) sums (arctan 1)\<close>]]
  5681         unfolding c_minus_minus by auto
  5682       finally show ?thesis using \<open>x = -1\<close> by auto
  5683     qed
  5684   qed
  5685 qed
  5686 
  5687 lemma arctan_half: "arctan x = 2 * arctan (x / (1 + sqrt(1 + x\<^sup>2)))"
  5688   for x :: real
  5689 proof -
  5690   obtain y where low: "- (pi / 2) < y" and high: "y < pi / 2" and y_eq: "tan y = x"
  5691     using tan_total by blast
  5692   then have low2: "- (pi / 2) < y / 2" and high2: "y / 2 < pi / 2"
  5693     by auto
  5694 
  5695   have "0 < cos y" by (rule cos_gt_zero_pi[OF low high])
  5696   then have "cos y \<noteq> 0" and cos_sqrt: "sqrt ((cos y)\<^sup>2) = cos y"
  5697     by auto
  5698 
  5699   have "1 + (tan y)\<^sup>2 = 1 + (sin y)\<^sup>2 / (cos y)\<^sup>2"
  5700     unfolding tan_def power_divide ..
  5701   also have "\<dots> = (cos y)\<^sup>2 / (cos y)\<^sup>2 + (sin y)\<^sup>2 / (cos y)\<^sup>2"
  5702     using \<open>cos y \<noteq> 0\<close> by auto
  5703   also have "\<dots> = 1 / (cos y)\<^sup>2"
  5704     unfolding add_divide_distrib[symmetric] sin_cos_squared_add2 ..
  5705   finally have "1 + (tan y)\<^sup>2 = 1 / (cos y)\<^sup>2" .
  5706 
  5707   have "sin y / (cos y + 1) = tan y / ((cos y + 1) / cos y)"
  5708     unfolding tan_def using \<open>cos y \<noteq> 0\<close> by (simp add: field_simps)
  5709   also have "\<dots> = tan y / (1 + 1 / cos y)"
  5710     using \<open>cos y \<noteq> 0\<close> unfolding add_divide_distrib by auto
  5711   also have "\<dots> = tan y / (1 + 1 / sqrt ((cos y)\<^sup>2))"
  5712     unfolding cos_sqrt ..
  5713   also have "\<dots> = tan y / (1 + sqrt (1 / (cos y)\<^sup>2))"
  5714     unfolding real_sqrt_divide by auto
  5715   finally have eq: "sin y / (cos y + 1) = tan y / (1 + sqrt(1 + (tan y)\<^sup>2))"
  5716     unfolding \<open>1 + (tan y)\<^sup>2 = 1 / (cos y)\<^sup>2\<close> .
  5717 
  5718   have "arctan x = y"
  5719     using arctan_tan low high y_eq by auto
  5720   also have "\<dots> = 2 * (arctan (tan (y/2)))"
  5721     using arctan_tan[OF low2 high2] by auto
  5722   also have "\<dots> = 2 * (arctan (sin y / (cos y + 1)))"
  5723     unfolding tan_half by auto
  5724   finally show ?thesis
  5725     unfolding eq \<open>tan y = x\<close> .
  5726 qed
  5727 
  5728 lemma arctan_monotone: "x < y \<Longrightarrow> arctan x < arctan y"
  5729   by (simp only: arctan_less_iff)
  5730 
  5731 lemma arctan_monotone': "x \<le> y \<Longrightarrow> arctan x \<le> arctan y"
  5732   by (simp only: arctan_le_iff)
  5733 
  5734 lemma arctan_inverse:
  5735   assumes "x \<noteq> 0"
  5736   shows "arctan (1 / x) = sgn x * pi / 2 - arctan x"
  5737 proof (rule arctan_unique)
  5738   show "- (pi / 2) < sgn x * pi / 2 - arctan x"
  5739     using arctan_bounded [of x] assms
  5740     unfolding sgn_real_def
  5741     apply (auto simp add: arctan algebra_simps)
  5742     apply (drule zero_less_arctan_iff [THEN iffD2])
  5743     apply arith
  5744     done
  5745   show "sgn x * pi / 2 - arctan x < pi / 2"
  5746     using arctan_bounded [of "- x"] assms
  5747     unfolding sgn_real_def arctan_minus
  5748     by (auto simp add: algebra_simps)
  5749   show "tan (sgn x * pi / 2 - arctan x) = 1 / x"
  5750     unfolding tan_inverse [of "arctan x", unfolded tan_arctan]
  5751     unfolding sgn_real_def
  5752     by (simp add: tan_def cos_arctan sin_arctan sin_diff cos_diff)
  5753 qed
  5754 
  5755 theorem pi_series: "pi / 4 = (\<Sum>k. (-1)^k * 1 / real (k * 2 + 1))"
  5756   (is "_ = ?SUM")
  5757 proof -
  5758   have "pi / 4 = arctan 1"
  5759     using arctan_one by auto
  5760   also have "\<dots> = ?SUM"
  5761     using arctan_series[of 1] by auto
  5762   finally show ?thesis by auto
  5763 qed
  5764 
  5765 
  5766 subsection \<open>Existence of Polar Coordinates\<close>
  5767 
  5768 lemma cos_x_y_le_one: "\<bar>x / sqrt (x\<^sup>2 + y\<^sup>2)\<bar> \<le> 1"
  5769   by (rule power2_le_imp_le [OF _ zero_le_one])
  5770     (simp add: power_divide divide_le_eq not_sum_power2_lt_zero)
  5771 
  5772 lemmas cos_arccos_lemma1 = cos_arccos_abs [OF cos_x_y_le_one]
  5773 
  5774 lemmas sin_arccos_lemma1 = sin_arccos_abs [OF cos_x_y_le_one]
  5775 
  5776 lemma polar_Ex: "\<exists>r::real. \<exists>a. x = r * cos a \<and> y = r * sin a"
  5777 proof -
  5778   have polar_ex1: "0 < y \<Longrightarrow> \<exists>r a. x = r * cos a \<and> y = r * sin a" for y
  5779     apply (rule exI [where x = "sqrt (x\<^sup>2 + y\<^sup>2)"])
  5780     apply (rule exI [where x = "arccos (x / sqrt (x\<^sup>2 + y\<^sup>2))"])
  5781     apply (simp add: cos_arccos_lemma1 sin_arccos_lemma1 power_divide
  5782         real_sqrt_mult [symmetric] right_diff_distrib)
  5783     done
  5784   show ?thesis
  5785   proof (cases "0::real" y rule: linorder_cases)
  5786     case less
  5787     then show ?thesis
  5788       by (rule polar_ex1)
  5789   next
  5790     case equal
  5791     then show ?thesis
  5792       by (force simp add: intro!: cos_zero sin_zero)
  5793   next
  5794     case greater
  5795     with polar_ex1 [where y="-y"] show ?thesis
  5796       by auto (metis cos_minus minus_minus minus_mult_right sin_minus)
  5797   qed
  5798 qed
  5799 
  5800 
  5801 subsection \<open>Basics about polynomial functions: products, extremal behaviour and root counts\<close>
  5802 
  5803 lemma pairs_le_eq_Sigma: "{(i, j). i + j \<le> m} = Sigma (atMost m) (\<lambda>r. atMost (m - r))"
  5804   for m :: nat
  5805   by auto
  5806 
  5807 lemma setsum_up_index_split: "(\<Sum>k\<le>m + n. f k) = (\<Sum>k\<le>m. f k) + (\<Sum>k = Suc m..m + n. f k)"
  5808   by (metis atLeast0AtMost Suc_eq_plus1 le0 setsum_ub_add_nat)
  5809 
  5810 lemma Sigma_interval_disjoint: "(SIGMA i:A. {..v i}) \<inter> (SIGMA i:A.{v i<..w}) = {}"
  5811   for w :: "'a::order"
  5812   by auto
  5813 
  5814 lemma product_atMost_eq_Un: "A \<times> {..m} = (SIGMA i:A.{..m - i}) \<union> (SIGMA i:A.{m - i<..m})"
  5815   for m :: nat
  5816   by auto
  5817 
  5818 lemma polynomial_product: (*with thanks to Chaitanya Mangla*)
  5819   fixes x :: "'a::idom"
  5820   assumes m: "\<And>i. i > m \<Longrightarrow> a i = 0"
  5821     and n: "\<And>j. j > n \<Longrightarrow> b j = 0"
  5822   shows "(\<Sum>i\<le>m. (a i) * x ^ i) * (\<Sum>j\<le>n. (b j) * x ^ j) =
  5823     (\<Sum>r\<le>m + n. (\<Sum>k\<le>r. (a k) * (b (r - k))) * x ^ r)"
  5824 proof -
  5825   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))"
  5826     by (rule setsum_product)
  5827   also have "\<dots> = (\<Sum>i\<le>m + n. \<Sum>j\<le>n + m. a i * x ^ i * (b j * x ^ j))"
  5828     using assms by (auto simp: setsum_up_index_split)
  5829   also have "\<dots> = (\<Sum>r\<le>m + n. \<Sum>j\<le>m + n - r. a r * x ^ r * (b j * x ^ j))"
  5830     apply (simp add: add_ac setsum.Sigma product_atMost_eq_Un)
  5831     apply (clarsimp simp add: setsum_Un Sigma_interval_disjoint intro!: setsum.neutral)
  5832     apply (metis add_diff_assoc2 add.commute add_lessD1 leD m n nat_le_linear neqE)
  5833     done
  5834   also have "\<dots> = (\<Sum>(i,j)\<in>{(i,j). i+j \<le> m+n}. (a i * x ^ i) * (b j * x ^ j))"
  5835     by (auto simp: pairs_le_eq_Sigma setsum.Sigma)
  5836   also have "\<dots> = (\<Sum>r\<le>m + n. (\<Sum>k\<le>r. (a k) * (b (r - k))) * x ^ r)"
  5837     apply (subst setsum_triangle_reindex_eq)
  5838     apply (auto simp: algebra_simps setsum_right_distrib intro!: setsum.cong)
  5839     apply (metis le_add_diff_inverse power_add)
  5840     done
  5841   finally show ?thesis .
  5842 qed
  5843 
  5844 lemma polynomial_product_nat:
  5845   fixes x :: nat
  5846   assumes m: "\<And>i. i > m \<Longrightarrow> a i = 0"
  5847     and n: "\<And>j. j > n \<Longrightarrow> b j = 0"
  5848   shows "(\<Sum>i\<le>m. (a i) * x ^ i) * (\<Sum>j\<le>n. (b j) * x ^ j) =
  5849     (\<Sum>r\<le>m + n. (\<Sum>k\<le>r. (a k) * (b (r - k))) * x ^ r)"
  5850   using polynomial_product [of m a n b x] assms
  5851   by (simp only: of_nat_mult [symmetric] of_nat_power [symmetric]
  5852       of_nat_eq_iff Int.int_setsum [symmetric])
  5853 
  5854 lemma polyfun_diff: (*COMPLEX_SUB_POLYFUN in HOL Light*)
  5855   fixes x :: "'a::idom"
  5856   assumes "1 \<le> n"
  5857   shows "(\<Sum>i\<le>n. a i * x^i) - (\<Sum>i\<le>n. a i * y^i) =
  5858     (x - y) * (\<Sum>j<n. (\<Sum>i=Suc j..n. a i * y^(i - j - 1)) * x^j)"
  5859 proof -
  5860   have h: "bij_betw (\<lambda>(i,j). (j,i)) ((SIGMA i : atMost n. lessThan i)) (SIGMA j : lessThan n. {Suc j..n})"
  5861     by (auto simp: bij_betw_def inj_on_def)
  5862   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))"
  5863     by (simp add: right_diff_distrib setsum_subtractf)
  5864   also have "\<dots> = (\<Sum>i\<le>n. a i * (x - y) * (\<Sum>j<i. y^(i - Suc j) * x^j))"
  5865     by (simp add: power_diff_sumr2 mult.assoc)
  5866   also have "\<dots> = (\<Sum>i\<le>n. \<Sum>j<i. a i * (x - y) * (y^(i - Suc j) * x^j))"
  5867     by (simp add: setsum_right_distrib)
  5868   also have "\<dots> = (\<Sum>(i,j) \<in> (SIGMA i : atMost n. lessThan i). a i * (x - y) * (y^(i - Suc j) * x^j))"
  5869     by (simp add: setsum.Sigma)
  5870   also have "\<dots> = (\<Sum>(j,i) \<in> (SIGMA j : lessThan n. {Suc j..n}). a i * (x - y) * (y^(i - Suc j) * x^j))"
  5871     by (auto simp add: setsum.reindex_bij_betw [OF h, symmetric] intro: setsum.strong_cong)
  5872   also have "\<dots> = (\<Sum>j<n. \<Sum>i=Suc j..n. a i * (x - y) * (y^(i - Suc j) * x^j))"
  5873     by (simp add: setsum.Sigma)
  5874   also have "\<dots> = (x - y) * (\<Sum>j<n. (\<Sum>i=Suc j..n. a i * y^(i - j - 1)) * x^j)"
  5875     by (simp add: setsum_right_distrib mult_ac)
  5876   finally show ?thesis .
  5877 qed
  5878 
  5879 lemma polyfun_diff_alt: (*COMPLEX_SUB_POLYFUN_ALT in HOL Light*)
  5880   fixes x :: "'a::idom"
  5881   assumes "1 \<le> n"
  5882   shows "(\<Sum>i\<le>n. a i * x^i) - (\<Sum>i\<le>n. a i * y^i) =
  5883     (x - y) * ((\<Sum>j<n. \<Sum>k<n-j. a(j + k + 1) * y^k * x^j))"
  5884 proof -
  5885   have "(\<Sum>i=Suc j..n. a i * y^(i - j - 1)) = (\<Sum>k<n-j. a(j+k+1) * y^k)"
  5886     if "j < n" for j :: nat
  5887   proof -
  5888     have h: "bij_betw (\<lambda>i. i - (j + 1)) {Suc j..n} (lessThan (n-j))"
  5889       apply (auto simp: bij_betw_def inj_on_def)
  5890       apply (rule_tac x="x + Suc j" in image_eqI)
  5891        apply (auto simp: )
  5892       done
  5893     then show ?thesis
  5894       by (auto simp add: setsum.reindex_bij_betw [OF h, symmetric] intro: setsum.strong_cong)
  5895   qed
  5896   then show ?thesis
  5897     by (simp add: polyfun_diff [OF assms] setsum_left_distrib)
  5898 qed
  5899 
  5900 lemma polyfun_linear_factor:  (*COMPLEX_POLYFUN_LINEAR_FACTOR in HOL Light*)
  5901   fixes a :: "'a::idom"
  5902   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)"
  5903 proof (cases "n = 0")
  5904   case True then show ?thesis
  5905     by simp
  5906 next
  5907   case False
  5908   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>
  5909         (\<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))"
  5910     by (simp add: algebra_simps)
  5911   also have "\<dots> \<longleftrightarrow>
  5912     (\<exists>b. \<forall>z. (z - a) * (\<Sum>j<n. (\<Sum>i = Suc j..n. c i * a^(i - Suc j)) * z^j) =
  5913       (z - a) * (\<Sum>i<n. b i * z^i))"
  5914     using False by (simp add: polyfun_diff)
  5915   also have "\<dots> = True" by auto
  5916   finally show ?thesis
  5917     by simp
  5918 qed
  5919 
  5920 lemma polyfun_linear_factor_root:  (*COMPLEX_POLYFUN_LINEAR_FACTOR_ROOT in HOL Light*)
  5921   fixes a :: "'a::idom"
  5922   assumes "(\<Sum>i\<le>n. c(i) * a^i) = 0"
  5923   obtains b where "\<And>z. (\<Sum>i\<le>n. c i * z^i) = (z - a) * (\<Sum>i<n. b i * z^i)"
  5924   using polyfun_linear_factor [of c n a] assms by auto
  5925 
  5926 (*The material of this section, up until this point, could go into a new theory of polynomials
  5927   based on Main alone. The remaining material involves limits, continuity, series, etc.*)
  5928 
  5929 lemma isCont_polynom: "isCont (\<lambda>w. \<Sum>i\<le>n. c i * w^i) a"
  5930   for c :: "nat \<Rightarrow> 'a::real_normed_div_algebra"
  5931   by simp
  5932 
  5933 lemma zero_polynom_imp_zero_coeffs:
  5934   fixes c :: "nat \<Rightarrow> 'a::{ab_semigroup_mult,real_normed_div_algebra}"
  5935   assumes "\<And>w. (\<Sum>i\<le>n. c i * w^i) = 0"  "k \<le> n"
  5936   shows "c k = 0"
  5937   using assms
  5938 proof (induction n arbitrary: c k)
  5939   case 0
  5940   then show ?case
  5941     by simp
  5942 next
  5943   case (Suc n c k)
  5944   have [simp]: "c 0 = 0" using Suc.prems(1) [of 0]
  5945     by simp
  5946   have "(\<Sum>i\<le>Suc n. c i * w^i) = w * (\<Sum>i\<le>n. c (Suc i) * w^i)" for w
  5947   proof -
  5948     have "(\<Sum>i\<le>Suc n. c i * w^i) = (\<Sum>i\<le>n. c (Suc i) * w ^ Suc i)"
  5949       unfolding Set_Interval.setsum_atMost_Suc_shift
  5950       by simp
  5951     also have "\<dots> = w * (\<Sum>i\<le>n. c (Suc i) * w^i)"
  5952       by (simp add: setsum_right_distrib ac_simps)
  5953     finally show ?thesis .
  5954   qed
  5955   then have w: "\<And>w. w \<noteq> 0 \<Longrightarrow> (\<Sum>i\<le>n. c (Suc i) * w^i) = 0"
  5956     using Suc  by auto
  5957   then have "(\<lambda>h. \<Sum>i\<le>n. c (Suc i) * h^i) \<midarrow>0\<rightarrow> 0"
  5958     by (simp cong: LIM_cong)  \<comment> \<open>the case \<open>w = 0\<close> by continuity\<close>
  5959   then have "(\<Sum>i\<le>n. c (Suc i) * 0^i) = 0"
  5960     using isCont_polynom [of 0 "\<lambda>i. c (Suc i)" n] LIM_unique
  5961     by (force simp add: Limits.isCont_iff)
  5962   then have "\<And>w. (\<Sum>i\<le>n. c (Suc i) * w^i) = 0"
  5963     using w by metis
  5964   then have "\<And>i. i \<le> n \<Longrightarrow> c (Suc i) = 0"
  5965     using Suc.IH [of "\<lambda>i. c (Suc i)"] by blast
  5966   then show ?case using \<open>k \<le> Suc n\<close>
  5967     by (cases k) auto
  5968 qed
  5969 
  5970 lemma polyfun_rootbound: (*COMPLEX_POLYFUN_ROOTBOUND in HOL Light*)
  5971   fixes c :: "nat \<Rightarrow> 'a::{idom,real_normed_div_algebra}"
  5972   assumes "c k \<noteq> 0" "k\<le>n"
  5973   shows "finite {z. (\<Sum>i\<le>n. c(i) * z^i) = 0} \<and> card {z. (\<Sum>i\<le>n. c(i) * z^i) = 0} \<le> n"
  5974   using assms
  5975 proof (induction n arbitrary: c k)
  5976   case 0
  5977   then show ?case
  5978     by simp
  5979 next
  5980   case (Suc m c k)
  5981   let ?succase = ?case
  5982   show ?case
  5983   proof (cases "{z. (\<Sum>i\<le>Suc m. c(i) * z^i) = 0} = {}")
  5984     case True
  5985     then show ?succase
  5986       by simp
  5987   next
  5988     case False
  5989     then obtain z0 where z0: "(\<Sum>i\<le>Suc m. c(i) * z0^i) = 0"
  5990       by blast
  5991     then obtain b where b: "\<And>w. (\<Sum>i\<le>Suc m. c i * w^i) = (w - z0) * (\<Sum>i\<le>m. b i * w^i)"
  5992       using polyfun_linear_factor_root [OF z0, unfolded lessThan_Suc_atMost]
  5993       by blast
  5994     then have eq: "{z. (\<Sum>i\<le>Suc m. c i * z^i) = 0} = insert z0 {z. (\<Sum>i\<le>m. b i * z^i) = 0}"
  5995       by auto
  5996     have "\<not> (\<forall>k\<le>m. b k = 0)"
  5997     proof
  5998       assume [simp]: "\<forall>k\<le>m. b k = 0"
  5999       then have "\<And>w. (\<Sum>i\<le>m. b i * w^i) = 0"
  6000         by simp
  6001       then have "\<And>w. (\<Sum>i\<le>Suc m. c i * w^i) = 0"
  6002         using b by simp
  6003       then have "\<And>k. k \<le> Suc m \<Longrightarrow> c k = 0"
  6004         using zero_polynom_imp_zero_coeffs by blast
  6005       then show False using Suc.prems by blast
  6006     qed
  6007     then obtain k' where bk': "b k' \<noteq> 0" "k' \<le> m"
  6008       by blast
  6009     show ?succase
  6010       using Suc.IH [of b k'] bk'
  6011       by (simp add: eq card_insert_if del: setsum_atMost_Suc)
  6012     qed
  6013 qed
  6014 
  6015 lemma
  6016   fixes c :: "nat \<Rightarrow> 'a::{idom,real_normed_div_algebra}"
  6017   assumes "c k \<noteq> 0" "k\<le>n"
  6018   shows polyfun_roots_finite: "finite {z. (\<Sum>i\<le>n. c(i) * z^i) = 0}"
  6019     and polyfun_roots_card: "card {z. (\<Sum>i\<le>n. c(i) * z^i) = 0} \<le> n"
  6020   using polyfun_rootbound assms by auto
  6021 
  6022 lemma polyfun_finite_roots: (*COMPLEX_POLYFUN_FINITE_ROOTS in HOL Light*)
  6023   fixes c :: "nat \<Rightarrow> 'a::{idom,real_normed_div_algebra}"
  6024   shows "finite {x. (\<Sum>i\<le>n. c i * x^i) = 0} \<longleftrightarrow> (\<exists>i\<le>n. c i \<noteq> 0)"
  6025     (is "?lhs = ?rhs")
  6026 proof
  6027   assume ?lhs
  6028   moreover have "\<not> finite {x. (\<Sum>i\<le>n. c i * x^i) = 0}" if "\<forall>i\<le>n. c i = 0"
  6029   proof -
  6030     from that have "\<And>x. (\<Sum>i\<le>n. c i * x^i) = 0"
  6031       by simp
  6032     then show ?thesis
  6033       using ex_new_if_finite [OF infinite_UNIV_char_0 [where 'a='a]]
  6034       by auto
  6035   qed
  6036   ultimately show ?rhs by metis
  6037 next
  6038   assume ?rhs
  6039   with polyfun_rootbound show ?lhs by blast
  6040 qed
  6041 
  6042 lemma polyfun_eq_0: "(\<forall>x. (\<Sum>i\<le>n. c i *