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