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