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