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