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