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