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