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