src/HOL/Transcendental.thy
author wenzelm
Sat Jul 18 22:58:50 2015 +0200 (2015-07-18)
changeset 60758 d8d85a8172b5
parent 60721 c1b7793c23a3
child 60762 bf0c76ccee8d
permissions -rw-r--r--
isabelle update_cartouches;
     1 (*  Title:      HOL/Transcendental.thy
     2     Author:     Jacques D. Fleuriot, University of Cambridge, University of Edinburgh
     3     Author:     Lawrence C Paulson
     4     Author:     Jeremy Avigad
     5 *)
     6 
     7 section\<open>Power Series, Transcendental Functions etc.\<close>
     8 
     9 theory Transcendental
    10 imports Binomial Series Deriv NthRoot
    11 begin
    12 
    13 lemma 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 \<open>x < 1\<close> obtain z where z: "x < z" "z < 1"
    37     by (metis dense)
    38   from f \<open>x < z\<close>
    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 \<open>0 \<le> x\<close> by (auto intro!: summable_comparison_test[OF _  summable_geometric])
    52 qed
    53 
    54 subsection \<open>Properties of Power Series\<close>
    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\<open>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>"}.\<close>
    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 \<open>g sums x\<close>[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 \<open>m div 2 \<ge> no\<close> 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 \<open>odd m\<close> by auto
   231       have "?SUM m = ?SUM (Suc (2 * (m div 2)))" unfolding eq ..
   232       also have "\<dots> = ?SUM (2 * (m div 2))" using \<open>even (2 * (m div 2))\<close> 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 \<open>g sums x\<close>] .
   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 \<open>f sums y\<close>] .
   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 \<open>Alternating series test / Leibniz formula\<close>
   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 \<open>a ----> 0\<close>[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 \<open>?f ----> l\<close>[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 \<open>0 < r\<close> \<open>?g ----> l\<close>[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 \<open>n \<ge> 2 * f_no\<close> 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 \<open>n \<ge> 2 * g_no\<close> 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 \<open>?g ----> l\<close> \<open>l = suminf ?S\<close> by auto
   377   show "?f ----> suminf ?S"
   378     using \<open>?f ----> l\<close> \<open>l = suminf ?S\<close> 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 \<open>a ----> 0\<close> ge0]
   403     from leibniz[OF mono]
   404     show ?thesis using \<open>0 \<le> a 0\<close> by auto
   405   next
   406     let ?a = "\<lambda> n. - a n"
   407     case False
   408     with monoseq_le[OF \<open>monoseq a\<close> \<open>a ----> 0\<close>]
   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 \<open>a ----> 0\<close>, 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 \<open>0 \<le> ?a 0\<close> 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 \<open>Term-by-Term Differentiability of Power Series\<close>
   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\<open>Lemma about distributing negation over it\<close>
   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\<open>FIXME: Long proofs\<close>
   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 \<open>The Derivative of a Power Series Has the Same Radius of Convergence\<close>
   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 \<open>Derivability of power series\<close>
   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 \<open>0 < r/3\<close> \<open>summable L\<close>] 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 \<open>0 < r/3\<close> \<open>summable (f' x0)\<close>] 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 \<open>0 < r\<close> 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 \<open>0 < ?r\<close>, 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 \<open>x = ?s n\<close> .
   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 \<open>0 < S'\<close>
   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 \<open>summable (f' x0)\<close>]
   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 \<open>summable (f' x0)\<close>]]
   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 \<open>x \<noteq> 0\<close> by auto }
   906     note 1 = this and 2 = summable_rabs_comparison_test[OF _ ign[OF \<open>summable L\<close>]]
   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 \<open>summable L\<close>]]])
   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 \<open>\<bar>x\<bar> < S\<close> .
   918       also have "S \<le> S'" using \<open>S \<le> S'\<close> .
   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 \<open>n \<in> {..< ?N}\<close> 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 \<open>0 < ?r\<close>, 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 \<open>x \<noteq> 0\<close> and \<open>\<bar>x\<bar> < ?s n\<close> 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 \<open>summable (f' x0)\<close>, 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 \<open>summable (f' x0)\<close>]]
   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 \<open>?diff_part < r/3\<close> \<open>?L_part \<le> r/3\<close> and \<open>?f'_part < r/3\<close>
   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 \<open>0 < S\<close> 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 \<open>0 < R'\<close> \<open>0 < R\<close> \<open>R' < R\<close> by auto
   980         hence in_Rball: "(R' + R) / 2 \<in> {-R <..< R}"
   981           using \<open>R' < R\<close> by auto
   982         have "norm R' < norm ((R' + R) / 2)"
   983           using \<open>0 < R'\<close> \<open>0 < R\<close> \<open>R' < R\<close> 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 \<open>x \<in> {-R'<..<R'}\<close>, of p] this[OF \<open>y \<in> {-R'<..<R'}\<close>, of "n-p"]] \<open>0 < R'\<close>
  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 \<open>p \<le> n\<close> 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 \<open>0 < R'\<close>]]] .
  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 \<open>R' < R\<close> 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 \<open>R' \<in> {-R <..< R}\<close>] \<open>norm x < norm R'\<close>])
  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 \<open>x0 \<in> {-R <..< R}\<close>] .
  1055       show "x0 \<in> {-R' <..< R'}"
  1056         using \<open>x0 \<in> {-R' <..< R'}\<close> .
  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 \<open>\<bar>x0\<bar> < ?R\<close> 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 \<open>Exponential Function\<close>
  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 \<open>Properties of the Exponential Function\<close>
  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 \<open>Properties of the Exponential Function on Reals\<close>
  1305 
  1306 text \<open>Comparisons of @{term "exp x"} with zero.\<close>
  1307 
  1308 text\<open>Proof: because every exponential can be seen as a square.\<close>
  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 \<open>Strict monotonicity of exponential.\<close>
  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 \<open>0 < x\<close>
  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 \<open>x < y\<close> 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 \<open>Comparisons of @{term "exp x"} with one.\<close>
  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 \<open>Natural Logarithm\<close>
  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   -- \<open>exponentation via ln and exp\<close>
  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 \<open>x \<noteq> 0\<close> 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 \<open>0 < x\<close> and \<open>x < 2\<close> 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 \<open>norm (1 - x) < 1\<close>] 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 \<open>0 < x\<close>] 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 \<open>0 < x\<close> \<open>x < 2\<close> 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 \<open>norm (-x) < 1\<close>])
  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 \<open>x < 1\<close>] obtain a where "x < a" "a < 1" by blast
  1949     from \<open>x < a\<close> 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 \<open>0 < x\<close> \<open>a < 1\<close> 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 \<open>0 < x\<close> \<open>x < a\<close> 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 \<open>a < x\<close> 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 \<open>1 < a\<close> 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 \<open>1 < a\<close> 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 \<open>0 < r\<close> 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 filtermap_ln_at_top: "filtermap (ln::real \<Rightarrow> real) at_top = at_top"
  2020   by (intro filtermap_fun_inverse[of exp] exp_at_top ln_at_top) auto
  2021 
  2022 lemma filtermap_exp_at_top: "filtermap (exp::real \<Rightarrow> real) at_top = at_top"
  2023   by (intro filtermap_fun_inverse[of ln] exp_at_top ln_at_top)
  2024      (auto simp: eventually_at_top_dense)
  2025 
  2026 lemma tendsto_power_div_exp_0: "((\<lambda>x. x ^ k / exp x) ---> (0::real)) at_top"
  2027 proof (induct k)
  2028   case 0
  2029   show "((\<lambda>x. x ^ 0 / exp x) ---> (0::real)) at_top"
  2030     by (simp add: inverse_eq_divide[symmetric])
  2031        (metis filterlim_compose[OF tendsto_inverse_0] exp_at_top filterlim_mono
  2032               at_top_le_at_infinity order_refl)
  2033 next
  2034   case (Suc k)
  2035   show ?case
  2036   proof (rule lhospital_at_top_at_top)
  2037     show "eventually (\<lambda>x. DERIV (\<lambda>x. x ^ Suc k) x :> (real (Suc k) * x^k)) at_top"
  2038       by eventually_elim (intro derivative_eq_intros, auto)
  2039     show "eventually (\<lambda>x. DERIV exp x :> exp x) at_top"
  2040       by eventually_elim auto
  2041     show "eventually (\<lambda>x. exp x \<noteq> 0) at_top"
  2042       by auto
  2043     from tendsto_mult[OF tendsto_const Suc, of "real (Suc k)"]
  2044     show "((\<lambda>x. real (Suc k) * x ^ k / exp x) ---> 0) at_top"
  2045       by simp
  2046   qed (rule exp_at_top)
  2047 qed
  2048 
  2049 
  2050 definition log :: "[real,real] => real"
  2051   -- \<open>logarithm of @{term x} to base @{term a}\<close>
  2052   where "log a x = ln x / ln a"
  2053 
  2054 
  2055 lemma tendsto_log [tendsto_intros]:
  2056   "\<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"
  2057   unfolding log_def by (intro tendsto_intros) auto
  2058 
  2059 lemma continuous_log:
  2060   assumes "continuous F f"
  2061     and "continuous F g"
  2062     and "0 < f (Lim F (\<lambda>x. x))"
  2063     and "f (Lim F (\<lambda>x. x)) \<noteq> 1"
  2064     and "0 < g (Lim F (\<lambda>x. x))"
  2065   shows "continuous F (\<lambda>x. log (f x) (g x))"
  2066   using assms unfolding continuous_def by (rule tendsto_log)
  2067 
  2068 lemma continuous_at_within_log[continuous_intros]:
  2069   assumes "continuous (at a within s) f"
  2070     and "continuous (at a within s) g"
  2071     and "0 < f a"
  2072     and "f a \<noteq> 1"
  2073     and "0 < g a"
  2074   shows "continuous (at a within s) (\<lambda>x. log (f x) (g x))"
  2075   using assms unfolding continuous_within by (rule tendsto_log)
  2076 
  2077 lemma isCont_log[continuous_intros, simp]:
  2078   assumes "isCont f a" "isCont g a" "0 < f a" "f a \<noteq> 1" "0 < g a"
  2079   shows "isCont (\<lambda>x. log (f x) (g x)) a"
  2080   using assms unfolding continuous_at by (rule tendsto_log)
  2081 
  2082 lemma continuous_on_log[continuous_intros]:
  2083   assumes "continuous_on s f" "continuous_on s g"
  2084     and "\<forall>x\<in>s. 0 < f x" "\<forall>x\<in>s. f x \<noteq> 1" "\<forall>x\<in>s. 0 < g x"
  2085   shows "continuous_on s (\<lambda>x. log (f x) (g x))"
  2086   using assms unfolding continuous_on_def by (fast intro: tendsto_log)
  2087 
  2088 lemma powr_one_eq_one [simp]: "1 powr a = 1"
  2089   by (simp add: powr_def)
  2090 
  2091 lemma powr_zero_eq_one [simp]: "x powr 0 = (if x=0 then 0 else 1)"
  2092   by (simp add: powr_def)
  2093 
  2094 lemma powr_one_gt_zero_iff [simp]:
  2095   fixes x::real shows "(x powr 1 = x) = (0 \<le> x)"
  2096   by (auto simp: powr_def)
  2097 declare powr_one_gt_zero_iff [THEN iffD2, simp]
  2098 
  2099 lemma powr_mult:
  2100   fixes x::real shows "0 \<le> x \<Longrightarrow> 0 \<le> y \<Longrightarrow> (x * y) powr a = (x powr a) * (y powr a)"
  2101   by (simp add: powr_def exp_add [symmetric] ln_mult distrib_left)
  2102 
  2103 lemma powr_ge_pzero [simp]:
  2104   fixes x::real shows "0 <= x powr y"
  2105   by (simp add: powr_def)
  2106 
  2107 lemma powr_divide:
  2108   fixes x::real shows "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> (x / y) powr a = (x powr a) / (y powr a)"
  2109   apply (simp add: divide_inverse positive_imp_inverse_positive powr_mult)
  2110   apply (simp add: powr_def exp_minus [symmetric] exp_add [symmetric] ln_inverse)
  2111   done
  2112 
  2113 lemma powr_divide2:
  2114   fixes x::real shows "x powr a / x powr b = x powr (a - b)"
  2115   apply (simp add: powr_def)
  2116   apply (subst exp_diff [THEN sym])
  2117   apply (simp add: left_diff_distrib)
  2118   done
  2119 
  2120 lemma powr_add:
  2121   fixes x::real shows "x powr (a + b) = (x powr a) * (x powr b)"
  2122   by (simp add: powr_def exp_add [symmetric] distrib_right)
  2123 
  2124 lemma powr_mult_base:
  2125   fixes x::real shows "0 < x \<Longrightarrow>x * x powr y = x powr (1 + y)"
  2126   using assms by (auto simp: powr_add)
  2127 
  2128 lemma powr_powr:
  2129   fixes x::real shows "(x powr a) powr b = x powr (a * b)"
  2130   by (simp add: powr_def)
  2131 
  2132 lemma powr_powr_swap:
  2133   fixes x::real shows "(x powr a) powr b = (x powr b) powr a"
  2134   by (simp add: powr_powr mult.commute)
  2135 
  2136 lemma powr_minus:
  2137   fixes x::real shows "x powr (-a) = inverse (x powr a)"
  2138   by (simp add: powr_def exp_minus [symmetric])
  2139 
  2140 lemma powr_minus_divide:
  2141   fixes x::real shows "x powr (-a) = 1/(x powr a)"
  2142   by (simp add: divide_inverse powr_minus)
  2143 
  2144 lemma divide_powr_uminus:
  2145   fixes a::real shows "a / b powr c = a * b powr (- c)"
  2146   by (simp add: powr_minus_divide)
  2147 
  2148 lemma powr_less_mono:
  2149   fixes x::real shows "a < b \<Longrightarrow> 1 < x \<Longrightarrow> x powr a < x powr b"
  2150   by (simp add: powr_def)
  2151 
  2152 lemma powr_less_cancel:
  2153   fixes x::real shows "x powr a < x powr b \<Longrightarrow> 1 < x \<Longrightarrow> a < b"
  2154   by (simp add: powr_def)
  2155 
  2156 lemma powr_less_cancel_iff [simp]:
  2157   fixes x::real shows "1 < x \<Longrightarrow> (x powr a < x powr b) = (a < b)"
  2158   by (blast intro: powr_less_cancel powr_less_mono)
  2159 
  2160 lemma powr_le_cancel_iff [simp]:
  2161   fixes x::real shows "1 < x \<Longrightarrow> (x powr a \<le> x powr b) = (a \<le> b)"
  2162   by (simp add: linorder_not_less [symmetric])
  2163 
  2164 lemma log_ln: "ln x = log (exp(1)) x"
  2165   by (simp add: log_def)
  2166 
  2167 lemma DERIV_log:
  2168   assumes "x > 0"
  2169   shows "DERIV (\<lambda>y. log b y) x :> 1 / (ln b * x)"
  2170 proof -
  2171   def lb \<equiv> "1 / ln b"
  2172   moreover have "DERIV (\<lambda>y. lb * ln y) x :> lb / x"
  2173     using \<open>x > 0\<close> by (auto intro!: derivative_eq_intros)
  2174   ultimately show ?thesis
  2175     by (simp add: log_def)
  2176 qed
  2177 
  2178 lemmas DERIV_log[THEN DERIV_chain2, derivative_intros]
  2179 
  2180 lemma powr_log_cancel [simp]: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow> a powr (log a x) = x"
  2181   by (simp add: powr_def log_def)
  2182 
  2183 lemma log_powr_cancel [simp]: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> log a (a powr y) = y"
  2184   by (simp add: log_def powr_def)
  2185 
  2186 lemma log_mult:
  2187   "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow> 0 < y \<Longrightarrow>
  2188     log a (x * y) = log a x + log a y"
  2189   by (simp add: log_def ln_mult divide_inverse distrib_right)
  2190 
  2191 lemma log_eq_div_ln_mult_log:
  2192   "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> 0 < b \<Longrightarrow> b \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow>
  2193     log a x = (ln b/ln a) * log b x"
  2194   by (simp add: log_def divide_inverse)
  2195 
  2196 text\<open>Base 10 logarithms\<close>
  2197 lemma log_base_10_eq1: "0 < x \<Longrightarrow> log 10 x = (ln (exp 1) / ln 10) * ln x"
  2198   by (simp add: log_def)
  2199 
  2200 lemma log_base_10_eq2: "0 < x \<Longrightarrow> log 10 x = (log 10 (exp 1)) * ln x"
  2201   by (simp add: log_def)
  2202 
  2203 lemma log_one [simp]: "log a 1 = 0"
  2204   by (simp add: log_def)
  2205 
  2206 lemma log_eq_one [simp]: "[| 0 < a; a \<noteq> 1 |] ==> log a a = 1"
  2207   by (simp add: log_def)
  2208 
  2209 lemma log_inverse: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow> log a (inverse x) = - log a x"
  2210   apply (rule_tac a1 = "log a x" in add_left_cancel [THEN iffD1])
  2211   apply (simp add: log_mult [symmetric])
  2212   done
  2213 
  2214 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"
  2215   by (simp add: log_mult divide_inverse log_inverse)
  2216 
  2217 lemma powr_gt_zero [simp]: "0 < x powr a \<longleftrightarrow> (x::real) \<noteq> 0"
  2218   by (simp add: powr_def)
  2219 
  2220 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)"
  2221   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)"
  2222   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)"
  2223   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)"
  2224   by (simp_all add: log_mult log_divide)
  2225 
  2226 lemma log_less_cancel_iff [simp]:
  2227   "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 0 < y \<Longrightarrow> log a x < log a y \<longleftrightarrow> x < y"
  2228   apply safe
  2229   apply (rule_tac [2] powr_less_cancel)
  2230   apply (drule_tac a = "log a x" in powr_less_mono, auto)
  2231   done
  2232 
  2233 lemma log_inj:
  2234   assumes "1 < b"
  2235   shows "inj_on (log b) {0 <..}"
  2236 proof (rule inj_onI, simp)
  2237   fix x y
  2238   assume pos: "0 < x" "0 < y" and *: "log b x = log b y"
  2239   show "x = y"
  2240   proof (cases rule: linorder_cases)
  2241     assume "x = y"
  2242     then show ?thesis by simp
  2243   next
  2244     assume "x < y" hence "log b x < log b y"
  2245       using log_less_cancel_iff[OF \<open>1 < b\<close>] pos by simp
  2246     then show ?thesis using * by simp
  2247   next
  2248     assume "y < x" hence "log b y < log b x"
  2249       using log_less_cancel_iff[OF \<open>1 < b\<close>] pos by simp
  2250     then show ?thesis using * by simp
  2251   qed
  2252 qed
  2253 
  2254 lemma log_le_cancel_iff [simp]:
  2255   "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 0 < y \<Longrightarrow> (log a x \<le> log a y) = (x \<le> y)"
  2256   by (simp add: linorder_not_less [symmetric])
  2257 
  2258 lemma zero_less_log_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 0 < log a x \<longleftrightarrow> 1 < x"
  2259   using log_less_cancel_iff[of a 1 x] by simp
  2260 
  2261 lemma zero_le_log_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 0 \<le> log a x \<longleftrightarrow> 1 \<le> x"
  2262   using log_le_cancel_iff[of a 1 x] by simp
  2263 
  2264 lemma log_less_zero_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> log a x < 0 \<longleftrightarrow> x < 1"
  2265   using log_less_cancel_iff[of a x 1] by simp
  2266 
  2267 lemma log_le_zero_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> log a x \<le> 0 \<longleftrightarrow> x \<le> 1"
  2268   using log_le_cancel_iff[of a x 1] by simp
  2269 
  2270 lemma one_less_log_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 1 < log a x \<longleftrightarrow> a < x"
  2271   using log_less_cancel_iff[of a a x] by simp
  2272 
  2273 lemma one_le_log_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 1 \<le> log a x \<longleftrightarrow> a \<le> x"
  2274   using log_le_cancel_iff[of a a x] by simp
  2275 
  2276 lemma log_less_one_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> log a x < 1 \<longleftrightarrow> x < a"
  2277   using log_less_cancel_iff[of a x a] by simp
  2278 
  2279 lemma log_le_one_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> log a x \<le> 1 \<longleftrightarrow> x \<le> a"
  2280   using log_le_cancel_iff[of a x a] by simp
  2281 
  2282 lemma le_log_iff:
  2283   assumes "1 < b" "x > 0"
  2284   shows "y \<le> log b x \<longleftrightarrow> b powr y \<le> (x::real)"
  2285   using assms 
  2286   apply auto
  2287   apply (metis (no_types, hide_lams) less_irrefl less_le_trans linear powr_le_cancel_iff
  2288                powr_log_cancel zero_less_one)
  2289   apply (metis not_less order.trans order_refl powr_le_cancel_iff powr_log_cancel zero_le_one)
  2290   done
  2291 
  2292 lemma less_log_iff:
  2293   assumes "1 < b" "x > 0"
  2294   shows "y < log b x \<longleftrightarrow> b powr y < x"
  2295   by (metis assms dual_order.strict_trans less_irrefl powr_less_cancel_iff
  2296     powr_log_cancel zero_less_one)
  2297 
  2298 lemma
  2299   assumes "1 < b" "x > 0"
  2300   shows log_less_iff: "log b x < y \<longleftrightarrow> x < b powr y"
  2301     and log_le_iff: "log b x \<le> y \<longleftrightarrow> x \<le> b powr y"
  2302   using le_log_iff[OF assms, of y] less_log_iff[OF assms, of y]
  2303   by auto
  2304 
  2305 lemmas powr_le_iff = le_log_iff[symmetric]
  2306   and powr_less_iff = le_log_iff[symmetric]
  2307   and less_powr_iff = log_less_iff[symmetric]
  2308   and le_powr_iff = log_le_iff[symmetric]
  2309 
  2310 lemma
  2311   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)"
  2312   by (auto simp add: floor_eq_iff powr_le_iff less_powr_iff)
  2313 
  2314 lemma powr_realpow: "0 < x ==> x powr (real n) = x^n"
  2315   apply (induct n)
  2316   apply simp
  2317   by (simp add: add.commute power.simps(2) powr_add real_of_nat_Suc)
  2318 
  2319 lemma powr_realpow_numeral: "0 < x \<Longrightarrow> x powr (numeral n :: real) = x ^ (numeral n)"
  2320   unfolding real_of_nat_numeral [symmetric] by (rule powr_realpow)
  2321 
  2322 lemma powr2_sqrt[simp]: "0 < x \<Longrightarrow> sqrt x powr 2 = x"
  2323 by(simp add: powr_realpow_numeral)
  2324 
  2325 lemma powr_realpow2: "0 <= x ==> 0 < n ==> x^n = (if (x = 0) then 0 else x powr (real n))"
  2326   apply (case_tac "x = 0", simp, simp)
  2327   apply (rule powr_realpow [THEN sym], simp)
  2328   done
  2329 
  2330 lemma powr_int:
  2331   assumes "x > 0"
  2332   shows "x powr i = (if i \<ge> 0 then x ^ nat i else 1 / x ^ nat (-i))"
  2333 proof (cases "i < 0")
  2334   case True
  2335   have r: "x powr i = 1 / x powr (-i)" by (simp add: powr_minus field_simps)
  2336   show ?thesis using \<open>i < 0\<close> \<open>x > 0\<close> by (simp add: r field_simps powr_realpow[symmetric])
  2337 next
  2338   case False
  2339   then show ?thesis by (simp add: assms powr_realpow[symmetric])
  2340 qed
  2341 
  2342 lemma compute_powr[code]:
  2343   fixes i::real
  2344   shows "b powr i =
  2345     (if b \<le> 0 then Code.abort (STR ''op powr with nonpositive base'') (\<lambda>_. b powr i)
  2346     else if floor i = i then (if 0 \<le> i then b ^ nat(floor i) else 1 / b ^ nat(floor (- i)))
  2347     else Code.abort (STR ''op powr with non-integer exponent'') (\<lambda>_. b powr i))"
  2348   by (auto simp: powr_int)
  2349 
  2350 lemma powr_one:
  2351   fixes x::real shows "0 \<le> x \<Longrightarrow> x powr 1 = x"
  2352   using powr_realpow [of x 1]
  2353   by simp
  2354 
  2355 lemma powr_numeral:
  2356   fixes x::real shows "0 < x \<Longrightarrow> x powr numeral n = x ^ numeral n"
  2357   by (fact powr_realpow_numeral)
  2358 
  2359 lemma powr_neg_one:
  2360   fixes x::real shows "0 < x \<Longrightarrow> x powr - 1 = 1 / x"
  2361   using powr_int [of x "- 1"] by simp
  2362 
  2363 lemma powr_neg_numeral:
  2364   fixes x::real shows "0 < x \<Longrightarrow> x powr - numeral n = 1 / x ^ numeral n"
  2365   using powr_int [of x "- numeral n"] by simp
  2366 
  2367 lemma root_powr_inverse: "0 < n \<Longrightarrow> 0 < x \<Longrightarrow> root n x = x powr (1/n)"
  2368   by (rule real_root_pos_unique) (auto simp: powr_realpow[symmetric] powr_powr)
  2369 
  2370 lemma ln_powr:
  2371   fixes x::real shows "x \<noteq> 0 \<Longrightarrow> ln (x powr y) = y * ln x"
  2372   by (simp add: powr_def)
  2373 
  2374 lemma ln_root: "\<lbrakk> n > 0; b > 0 \<rbrakk> \<Longrightarrow> ln (root n b) =  ln b / n"
  2375 by(simp add: root_powr_inverse ln_powr)
  2376 
  2377 lemma ln_sqrt: "0 < x \<Longrightarrow> ln (sqrt x) = ln x / 2"
  2378   by (simp add: ln_powr powr_numeral ln_powr[symmetric] mult.commute)
  2379 
  2380 lemma log_root: "\<lbrakk> n > 0; a > 0 \<rbrakk> \<Longrightarrow> log b (root n a) =  log b a / n"
  2381 by(simp add: log_def ln_root)
  2382 
  2383 lemma log_powr: "x \<noteq> 0 \<Longrightarrow> log b (x powr y) = y * log b x"
  2384   by (simp add: log_def ln_powr)
  2385 
  2386 lemma log_nat_power: "0 < x \<Longrightarrow> log b (x^n) = real n * log b x"
  2387   by (simp add: log_powr powr_realpow [symmetric])
  2388 
  2389 lemma log_base_change: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> log b x = log a x / log a b"
  2390   by (simp add: log_def)
  2391 
  2392 lemma log_base_pow: "0 < a \<Longrightarrow> log (a ^ n) x = log a x / n"
  2393   by (simp add: log_def ln_realpow)
  2394 
  2395 lemma log_base_powr: "a \<noteq> 0 \<Longrightarrow> log (a powr b) x = log a x / b"
  2396   by (simp add: log_def ln_powr)
  2397 
  2398 lemma log_base_root: "\<lbrakk> n > 0; b > 0 \<rbrakk> \<Longrightarrow> log (root n b) x = n * (log b x)"
  2399 by(simp add: log_def ln_root)
  2400 
  2401 lemma ln_bound:
  2402   fixes x::real shows "1 <= x ==> ln x <= x"
  2403   apply (subgoal_tac "ln(1 + (x - 1)) <= x - 1")
  2404   apply simp
  2405   apply (rule ln_add_one_self_le_self, simp)
  2406   done
  2407 
  2408 lemma powr_mono:
  2409   fixes x::real shows "a <= b ==> 1 <= x ==> x powr a <= x powr b"
  2410   apply (cases "x = 1", simp)
  2411   apply (cases "a = b", simp)
  2412   apply (rule order_less_imp_le)
  2413   apply (rule powr_less_mono, auto)
  2414   done
  2415 
  2416 lemma ge_one_powr_ge_zero:
  2417   fixes x::real shows "1 <= x ==> 0 <= a ==> 1 <= x powr a"
  2418 using powr_mono by fastforce
  2419 
  2420 lemma powr_less_mono2:
  2421   fixes x::real shows "0 < a ==> 0 \<le> x ==> x < y ==> x powr a < y powr a"
  2422   by (simp add: powr_def)
  2423 
  2424 lemma powr_less_mono2_neg:
  2425   fixes x::real shows "a < 0 ==> 0 < x ==> x < y ==> y powr a < x powr a"
  2426   by (simp add: powr_def)
  2427 
  2428 lemma powr_mono2:
  2429   fixes x::real shows "0 <= a ==> 0 \<le> x ==> x <= y ==> x powr a <= y powr a"
  2430   apply (case_tac "a = 0", simp)
  2431   apply (case_tac "x = y", simp)
  2432   apply (metis dual_order.strict_iff_order powr_less_mono2)
  2433   done
  2434 
  2435 lemma powr_inj:
  2436   fixes x::real shows "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> a powr x = a powr y \<longleftrightarrow> x = y"
  2437   unfolding powr_def exp_inj_iff by simp
  2438 
  2439 lemma powr_half_sqrt: "0 \<le> x \<Longrightarrow> x powr (1/2) = sqrt x"
  2440   by (simp add: powr_def root_powr_inverse sqrt_def)
  2441 
  2442 lemma ln_powr_bound:
  2443   fixes x::real shows "1 <= x ==> 0 < a ==> ln x <= (x powr a) / a"
  2444 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)
  2445 
  2446 
  2447 lemma ln_powr_bound2:
  2448   fixes x::real
  2449   assumes "1 < x" and "0 < a"
  2450   shows "(ln x) powr a <= (a powr a) * x"
  2451 proof -
  2452   from assms have "ln x <= (x powr (1 / a)) / (1 / a)"
  2453     by (metis less_eq_real_def ln_powr_bound zero_less_divide_1_iff)
  2454   also have "... = a * (x powr (1 / a))"
  2455     by simp
  2456   finally have "(ln x) powr a <= (a * (x powr (1 / a))) powr a"
  2457     by (metis assms less_imp_le ln_gt_zero powr_mono2)
  2458   also have "... = (a powr a) * ((x powr (1 / a)) powr a)"
  2459     using assms powr_mult by auto
  2460   also have "(x powr (1 / a)) powr a = x powr ((1 / a) * a)"
  2461     by (rule powr_powr)
  2462   also have "... = x" using assms
  2463     by auto
  2464   finally show ?thesis .
  2465 qed
  2466 
  2467 lemma tendsto_powr [tendsto_intros]:
  2468   fixes a::real 
  2469   assumes f: "(f ---> a) F" and g: "(g ---> b) F" and a: "a \<noteq> 0"
  2470   shows "((\<lambda>x. f x powr g x) ---> a powr b) F"
  2471   unfolding powr_def
  2472 proof (rule filterlim_If)
  2473   from f show "((\<lambda>x. 0) ---> (if a = 0 then 0 else exp (b * ln a))) (inf F (principal {x. f x = 0}))"
  2474     by simp (auto simp: filterlim_iff eventually_inf_principal elim: eventually_elim1 dest: t1_space_nhds)
  2475 qed (insert f g a, auto intro!: tendsto_intros intro: tendsto_mono inf_le1)
  2476 
  2477 lemma continuous_powr:
  2478   assumes "continuous F f"
  2479     and "continuous F g"
  2480     and "f (Lim F (\<lambda>x. x)) \<noteq> 0"
  2481   shows "continuous F (\<lambda>x. (f x) powr (g x :: real))"
  2482   using assms unfolding continuous_def by (rule tendsto_powr)
  2483 
  2484 lemma continuous_at_within_powr[continuous_intros]:
  2485   assumes "continuous (at a within s) f"
  2486     and "continuous (at a within s) g"
  2487     and "f a \<noteq> 0"
  2488   shows "continuous (at a within s) (\<lambda>x. (f x) powr (g x :: real))"
  2489   using assms unfolding continuous_within by (rule tendsto_powr)
  2490 
  2491 lemma isCont_powr[continuous_intros, simp]:
  2492   assumes "isCont f a" "isCont g a" "f a \<noteq> (0::real)"
  2493   shows "isCont (\<lambda>x. (f x) powr g x) a"
  2494   using assms unfolding continuous_at by (rule tendsto_powr)
  2495 
  2496 lemma continuous_on_powr[continuous_intros]:
  2497   assumes "continuous_on s f" "continuous_on s g" and "\<forall>x\<in>s. f x \<noteq> (0::real)"
  2498   shows "continuous_on s (\<lambda>x. (f x) powr (g x))"
  2499   using assms unfolding continuous_on_def by (fast intro: tendsto_powr)
  2500 
  2501 lemma tendsto_powr2:
  2502   fixes a::real
  2503   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"
  2504   shows "((\<lambda>x. f x powr g x) ---> a powr b) F"
  2505   unfolding powr_def
  2506 proof (rule filterlim_If)
  2507   from f show "((\<lambda>x. 0) ---> (if a = 0 then 0 else exp (b * ln a))) (inf F (principal {x. f x = 0}))"
  2508     by simp (auto simp: filterlim_iff eventually_inf_principal elim: eventually_elim1 dest: t1_space_nhds)
  2509 next
  2510   { assume "a = 0"
  2511     with f f_nonneg have "LIM x inf F (principal {x. f x \<noteq> 0}). f x :> at_right 0"
  2512       by (auto simp add: filterlim_at eventually_inf_principal le_less 
  2513                elim: eventually_elim1 intro: tendsto_mono inf_le1)
  2514     then have "((\<lambda>x. exp (g x * ln (f x))) ---> 0) (inf F (principal {x. f x \<noteq> 0}))"
  2515       by (auto intro!: filterlim_compose[OF exp_at_bot] filterlim_compose[OF ln_at_0]
  2516                        filterlim_tendsto_pos_mult_at_bot[OF _ \<open>0 < b\<close>]
  2517                intro: tendsto_mono inf_le1 g) }
  2518   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}))"
  2519     using f g by (auto intro!: tendsto_intros intro: tendsto_mono inf_le1)
  2520 qed
  2521 
  2522 lemma DERIV_powr:
  2523   fixes r::real
  2524   assumes g: "DERIV g x :> m" and pos: "g x > 0" and f: "DERIV f x :> r"
  2525   shows  "DERIV (\<lambda>x. g x powr f x) x :> (g x powr f x) * (r * ln (g x) + m * f x / g x)"
  2526 proof -
  2527   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)"
  2528     using pos
  2529     by (auto intro!: derivative_eq_intros g pos f simp: powr_def field_simps exp_diff)
  2530   then show ?thesis
  2531   proof (rule DERIV_cong_ev[OF refl _ refl, THEN iffD1, rotated])
  2532     from DERIV_isCont[OF g] pos have "\<forall>\<^sub>F x in at x. 0 < g x"
  2533       unfolding isCont_def by (rule order_tendstoD(1))
  2534     with pos show "\<forall>\<^sub>F x in nhds x. exp (f x * ln (g x)) = g x powr f x"
  2535       by (auto simp: eventually_at_filter powr_def elim: eventually_elim1)
  2536   qed
  2537 qed
  2538 
  2539 lemma DERIV_fun_powr:
  2540   fixes r::real
  2541   assumes g: "DERIV g x :> m" and pos: "g x > 0"
  2542   shows  "DERIV (\<lambda>x. (g x) powr r) x :> r * (g x) powr (r - of_nat 1) * m"
  2543   using DERIV_powr[OF g pos DERIV_const, of r] pos
  2544   by (simp add: powr_divide2[symmetric] field_simps)
  2545 
  2546 lemma tendsto_zero_powrI:
  2547   assumes "(f ---> (0::real)) F" "(g ---> b) F" "\<forall>\<^sub>F x in F. 0 \<le> f x" "0 < b"
  2548   shows "((\<lambda>x. f x powr g x) ---> 0) F"
  2549   using tendsto_powr2[OF assms] by simp
  2550 
  2551 lemma tendsto_neg_powr:
  2552   assumes "s < 0"
  2553     and f: "LIM x F. f x :> at_top"
  2554   shows "((\<lambda>x. f x powr s) ---> (0::real)) F"
  2555 proof -
  2556   have "((\<lambda>x. exp (s * ln (f x))) ---> (0::real)) F" (is "?X")
  2557     by (auto intro!: filterlim_compose[OF exp_at_bot] filterlim_compose[OF ln_at_top]
  2558                      filterlim_tendsto_neg_mult_at_bot assms)
  2559   also have "?X \<longleftrightarrow> ((\<lambda>x. f x powr s) ---> (0::real)) F"
  2560     using f filterlim_at_top_dense[of f F]
  2561     by (intro filterlim_cong[OF refl refl]) (auto simp: neq_iff powr_def elim: eventually_elim1)
  2562   finally show ?thesis .
  2563 qed
  2564 
  2565 lemma tendsto_exp_limit_at_right:
  2566   fixes x :: real
  2567   shows "((\<lambda>y. (1 + x * y) powr (1 / y)) ---> exp x) (at_right 0)"
  2568 proof cases
  2569   assume "x \<noteq> 0"
  2570   have "((\<lambda>y. ln (1 + x * y)::real) has_real_derivative 1 * x) (at 0)"
  2571     by (auto intro!: derivative_eq_intros)
  2572   then have "((\<lambda>y. ln (1 + x * y) / y) ---> x) (at 0)"
  2573     by (auto simp add: has_field_derivative_def field_has_derivative_at)
  2574   then have *: "((\<lambda>y. exp (ln (1 + x * y) / y)) ---> exp x) (at 0)"
  2575     by (rule tendsto_intros)
  2576   then show ?thesis
  2577   proof (rule filterlim_mono_eventually)
  2578     show "eventually (\<lambda>xa. exp (ln (1 + x * xa) / xa) = (1 + x * xa) powr (1 / xa)) (at_right 0)"
  2579       unfolding eventually_at_right[OF zero_less_one]
  2580       using \<open>x \<noteq> 0\<close>
  2581       apply  (intro exI[of _ "1 / \<bar>x\<bar>"])
  2582       apply (auto simp: field_simps powr_def abs_if)
  2583       by (metis add_less_same_cancel1 mult_less_0_iff not_less_iff_gr_or_eq zero_less_one)
  2584   qed (simp_all add: at_eq_sup_left_right)
  2585 qed simp
  2586 
  2587 lemma tendsto_exp_limit_at_top:
  2588   fixes x :: real
  2589   shows "((\<lambda>y. (1 + x / y) powr y) ---> exp x) at_top"
  2590   apply (subst filterlim_at_top_to_right)
  2591   apply (simp add: inverse_eq_divide)
  2592   apply (rule tendsto_exp_limit_at_right)
  2593   done
  2594 
  2595 lemma tendsto_exp_limit_sequentially:
  2596   fixes x :: real
  2597   shows "(\<lambda>n. (1 + x / n) ^ n) ----> exp x"
  2598 proof (rule filterlim_mono_eventually)
  2599   from reals_Archimedean2 [of "abs x"] obtain n :: nat where *: "real n > abs x" ..
  2600   hence "eventually (\<lambda>n :: nat. 0 < 1 + x / real n) at_top"
  2601     apply (intro eventually_sequentiallyI [of n])
  2602     apply (case_tac "x \<ge> 0")
  2603     apply (rule add_pos_nonneg, auto intro: divide_nonneg_nonneg)
  2604     apply (subgoal_tac "x / real xa > -1")
  2605     apply (auto simp add: field_simps)
  2606     done
  2607   then show "eventually (\<lambda>n. (1 + x / n) powr n = (1 + x / n) ^ n) at_top"
  2608     by (rule eventually_elim1) (erule powr_realpow)
  2609   show "(\<lambda>n. (1 + x / real n) powr real n) ----> exp x"
  2610     by (rule filterlim_compose [OF tendsto_exp_limit_at_top filterlim_real_sequentially])
  2611 qed auto
  2612 
  2613 subsection \<open>Sine and Cosine\<close>
  2614 
  2615 definition sin_coeff :: "nat \<Rightarrow> real" where
  2616   "sin_coeff = (\<lambda>n. if even n then 0 else (- 1) ^ ((n - Suc 0) div 2) / (fact n))"
  2617 
  2618 definition cos_coeff :: "nat \<Rightarrow> real" where
  2619   "cos_coeff = (\<lambda>n. if even n then ((- 1) ^ (n div 2)) / (fact n) else 0)"
  2620 
  2621 definition sin :: "'a \<Rightarrow> 'a::{real_normed_algebra_1,banach}"
  2622   where "sin = (\<lambda>x. \<Sum>n. sin_coeff n *\<^sub>R x^n)"
  2623 
  2624 definition cos :: "'a \<Rightarrow> 'a::{real_normed_algebra_1,banach}"
  2625   where "cos = (\<lambda>x. \<Sum>n. cos_coeff n *\<^sub>R x^n)"
  2626 
  2627 lemma sin_coeff_0 [simp]: "sin_coeff 0 = 0"
  2628   unfolding sin_coeff_def by simp
  2629 
  2630 lemma cos_coeff_0 [simp]: "cos_coeff 0 = 1"
  2631   unfolding cos_coeff_def by simp
  2632 
  2633 lemma sin_coeff_Suc: "sin_coeff (Suc n) = cos_coeff n / real (Suc n)"
  2634   unfolding cos_coeff_def sin_coeff_def
  2635   by (simp del: mult_Suc)
  2636 
  2637 lemma cos_coeff_Suc: "cos_coeff (Suc n) = - sin_coeff n / real (Suc n)"
  2638   unfolding cos_coeff_def sin_coeff_def
  2639   by (simp del: mult_Suc) (auto elim: oddE)
  2640 
  2641 lemma summable_norm_sin:
  2642   fixes x :: "'a::{real_normed_algebra_1,banach}"
  2643   shows "summable (\<lambda>n. norm (sin_coeff n *\<^sub>R x^n))"
  2644   unfolding sin_coeff_def
  2645   apply (rule summable_comparison_test [OF _ summable_norm_exp [where x=x]])
  2646   apply (auto simp: divide_inverse abs_mult power_abs [symmetric] zero_le_mult_iff)
  2647   done
  2648 
  2649 lemma summable_norm_cos:
  2650   fixes x :: "'a::{real_normed_algebra_1,banach}"
  2651   shows "summable (\<lambda>n. norm (cos_coeff n *\<^sub>R x^n))"
  2652   unfolding cos_coeff_def
  2653   apply (rule summable_comparison_test [OF _ summable_norm_exp [where x=x]])
  2654   apply (auto simp: divide_inverse abs_mult power_abs [symmetric] zero_le_mult_iff)
  2655   done
  2656 
  2657 lemma sin_converges: "(\<lambda>n. sin_coeff n *\<^sub>R x^n) sums sin(x)"
  2658 unfolding sin_def
  2659   by (metis (full_types) summable_norm_cancel summable_norm_sin summable_sums)
  2660 
  2661 lemma cos_converges: "(\<lambda>n. cos_coeff n *\<^sub>R x^n) sums cos(x)"
  2662 unfolding cos_def
  2663   by (metis (full_types) summable_norm_cancel summable_norm_cos summable_sums)
  2664 
  2665 lemma sin_of_real:
  2666   fixes x::real
  2667   shows "sin (of_real x) = of_real (sin x)"
  2668 proof -
  2669   have "(\<lambda>n. of_real (sin_coeff n *\<^sub>R  x^n)) = (\<lambda>n. sin_coeff n *\<^sub>R  (of_real x)^n)"
  2670   proof
  2671     fix n
  2672     show "of_real (sin_coeff n *\<^sub>R  x^n) = sin_coeff n *\<^sub>R of_real x^n"
  2673       by (simp add: scaleR_conv_of_real)
  2674   qed
  2675   also have "... sums (sin (of_real x))"
  2676     by (rule sin_converges)
  2677   finally have "(\<lambda>n. of_real (sin_coeff n *\<^sub>R x^n)) sums (sin (of_real x))" .
  2678   then show ?thesis
  2679     using sums_unique2 sums_of_real [OF sin_converges]
  2680     by blast
  2681 qed
  2682 
  2683 corollary sin_in_Reals [simp]: "z \<in> \<real> \<Longrightarrow> sin z \<in> \<real>"
  2684   by (metis Reals_cases Reals_of_real sin_of_real)
  2685 
  2686 lemma cos_of_real:
  2687   fixes x::real
  2688   shows "cos (of_real x) = of_real (cos x)"
  2689 proof -
  2690   have "(\<lambda>n. of_real (cos_coeff n *\<^sub>R  x^n)) = (\<lambda>n. cos_coeff n *\<^sub>R  (of_real x)^n)"
  2691   proof
  2692     fix n
  2693     show "of_real (cos_coeff n *\<^sub>R  x^n) = cos_coeff n *\<^sub>R of_real x^n"
  2694       by (simp add: scaleR_conv_of_real)
  2695   qed
  2696   also have "... sums (cos (of_real x))"
  2697     by (rule cos_converges)
  2698   finally have "(\<lambda>n. of_real (cos_coeff n *\<^sub>R x^n)) sums (cos (of_real x))" .
  2699   then show ?thesis
  2700     using sums_unique2 sums_of_real [OF cos_converges]
  2701     by blast
  2702 qed
  2703 
  2704 corollary cos_in_Reals [simp]: "z \<in> \<real> \<Longrightarrow> cos z \<in> \<real>"
  2705   by (metis Reals_cases Reals_of_real cos_of_real)
  2706 
  2707 lemma diffs_sin_coeff: "diffs sin_coeff = cos_coeff"
  2708   by (simp add: diffs_def sin_coeff_Suc real_of_nat_def del: of_nat_Suc)
  2709 
  2710 lemma diffs_cos_coeff: "diffs cos_coeff = (\<lambda>n. - sin_coeff n)"
  2711   by (simp add: diffs_def cos_coeff_Suc real_of_nat_def del: of_nat_Suc)
  2712 
  2713 text\<open>Now at last we can get the derivatives of exp, sin and cos\<close>
  2714 
  2715 lemma DERIV_sin [simp]:
  2716   fixes x :: "'a::{real_normed_field,banach}"
  2717   shows "DERIV sin x :> cos(x)"
  2718   unfolding sin_def cos_def scaleR_conv_of_real
  2719   apply (rule DERIV_cong)
  2720   apply (rule termdiffs [where K="of_real (norm x) + 1 :: 'a"])
  2721   apply (simp_all add: norm_less_p1 diffs_of_real diffs_sin_coeff diffs_cos_coeff
  2722               summable_minus_iff scaleR_conv_of_real [symmetric]
  2723               summable_norm_sin [THEN summable_norm_cancel]
  2724               summable_norm_cos [THEN summable_norm_cancel])
  2725   done
  2726 
  2727 declare DERIV_sin[THEN DERIV_chain2, derivative_intros]
  2728 
  2729 lemma DERIV_cos [simp]:
  2730   fixes x :: "'a::{real_normed_field,banach}"
  2731   shows "DERIV cos x :> -sin(x)"
  2732   unfolding sin_def cos_def scaleR_conv_of_real
  2733   apply (rule DERIV_cong)
  2734   apply (rule termdiffs [where K="of_real (norm x) + 1 :: 'a"])
  2735   apply (simp_all add: norm_less_p1 diffs_of_real diffs_minus suminf_minus
  2736               diffs_sin_coeff diffs_cos_coeff
  2737               summable_minus_iff scaleR_conv_of_real [symmetric]
  2738               summable_norm_sin [THEN summable_norm_cancel]
  2739               summable_norm_cos [THEN summable_norm_cancel])
  2740   done
  2741 
  2742 declare DERIV_cos[THEN DERIV_chain2, derivative_intros]
  2743 
  2744 lemma isCont_sin:
  2745   fixes x :: "'a::{real_normed_field,banach}"
  2746   shows "isCont sin x"
  2747   by (rule DERIV_sin [THEN DERIV_isCont])
  2748 
  2749 lemma isCont_cos:
  2750   fixes x :: "'a::{real_normed_field,banach}"
  2751   shows "isCont cos x"
  2752   by (rule DERIV_cos [THEN DERIV_isCont])
  2753 
  2754 lemma isCont_sin' [simp]:
  2755   fixes f:: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  2756   shows "isCont f a \<Longrightarrow> isCont (\<lambda>x. sin (f x)) a"
  2757   by (rule isCont_o2 [OF _ isCont_sin])
  2758 
  2759 (*FIXME A CONTEXT FOR F WOULD BE BETTER*)
  2760 
  2761 lemma isCont_cos' [simp]:
  2762   fixes f:: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  2763   shows "isCont f a \<Longrightarrow> isCont (\<lambda>x. cos (f x)) a"
  2764   by (rule isCont_o2 [OF _ isCont_cos])
  2765 
  2766 lemma tendsto_sin [tendsto_intros]:
  2767   fixes f:: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  2768   shows "(f ---> a) F \<Longrightarrow> ((\<lambda>x. sin (f x)) ---> sin a) F"
  2769   by (rule isCont_tendsto_compose [OF isCont_sin])
  2770 
  2771 lemma tendsto_cos [tendsto_intros]:
  2772   fixes f:: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  2773   shows "(f ---> a) F \<Longrightarrow> ((\<lambda>x. cos (f x)) ---> cos a) F"
  2774   by (rule isCont_tendsto_compose [OF isCont_cos])
  2775 
  2776 lemma continuous_sin [continuous_intros]:
  2777   fixes f:: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  2778   shows "continuous F f \<Longrightarrow> continuous F (\<lambda>x. sin (f x))"
  2779   unfolding continuous_def by (rule tendsto_sin)
  2780 
  2781 lemma continuous_on_sin [continuous_intros]:
  2782   fixes f:: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  2783   shows "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. sin (f x))"
  2784   unfolding continuous_on_def by (auto intro: tendsto_sin)
  2785 
  2786 lemma continuous_within_sin:
  2787   fixes z :: "'a::{real_normed_field,banach}"
  2788   shows "continuous (at z within s) sin"
  2789   by (simp add: continuous_within tendsto_sin)
  2790 
  2791 lemma continuous_cos [continuous_intros]:
  2792   fixes f:: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  2793   shows "continuous F f \<Longrightarrow> continuous F (\<lambda>x. cos (f x))"
  2794   unfolding continuous_def by (rule tendsto_cos)
  2795 
  2796 lemma continuous_on_cos [continuous_intros]:
  2797   fixes f:: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  2798   shows "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. cos (f x))"
  2799   unfolding continuous_on_def by (auto intro: tendsto_cos)
  2800 
  2801 lemma continuous_within_cos:
  2802   fixes z :: "'a::{real_normed_field,banach}"
  2803   shows "continuous (at z within s) cos"
  2804   by (simp add: continuous_within tendsto_cos)
  2805 
  2806 subsection \<open>Properties of Sine and Cosine\<close>
  2807 
  2808 lemma sin_zero [simp]: "sin 0 = 0"
  2809   unfolding sin_def sin_coeff_def by (simp add: scaleR_conv_of_real powser_zero)
  2810 
  2811 lemma cos_zero [simp]: "cos 0 = 1"
  2812   unfolding cos_def cos_coeff_def by (simp add: scaleR_conv_of_real powser_zero)
  2813 
  2814 lemma DERIV_fun_sin:
  2815      "DERIV g x :> m \<Longrightarrow> DERIV (\<lambda>x. sin(g x)) x :> cos(g x) * m"
  2816   by (auto intro!: derivative_intros)
  2817 
  2818 lemma DERIV_fun_cos:
  2819      "DERIV g x :> m \<Longrightarrow> DERIV (\<lambda>x. cos(g x)) x :> -sin(g x) * m"
  2820   by (auto intro!: derivative_eq_intros simp: real_of_nat_def)
  2821 
  2822 subsection \<open>Deriving the Addition Formulas\<close>
  2823 
  2824 text\<open>The the product of two cosine series\<close>
  2825 lemma cos_x_cos_y:
  2826   fixes x :: "'a::{real_normed_field,banach}"
  2827   shows "(\<lambda>p. \<Sum>n\<le>p.
  2828           if even p \<and> even n
  2829           then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0)
  2830          sums (cos x * cos y)"
  2831 proof -
  2832   { fix n p::nat
  2833     assume "n\<le>p"
  2834     then have *: "even n \<Longrightarrow> even p \<Longrightarrow> (-1) ^ (n div 2) * (-1) ^ ((p - n) div 2) = (-1 :: real) ^ (p div 2)"
  2835       by (metis div_add power_add le_add_diff_inverse odd_add)
  2836     have "(cos_coeff n * cos_coeff (p - n)) *\<^sub>R (x^n * y^(p-n)) =
  2837           (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)"
  2838     using \<open>n\<le>p\<close>
  2839       by (auto simp: * algebra_simps cos_coeff_def binomial_fact real_of_nat_def)
  2840   }
  2841   then have "(\<lambda>p. \<Sum>n\<le>p. if even p \<and> even n
  2842                   then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0) =
  2843              (\<lambda>p. \<Sum>n\<le>p. (cos_coeff n * cos_coeff (p - n)) *\<^sub>R (x^n * y^(p-n)))"
  2844     by simp
  2845   also have "... = (\<lambda>p. \<Sum>n\<le>p. (cos_coeff n *\<^sub>R x^n) * (cos_coeff (p - n) *\<^sub>R y^(p-n)))"
  2846     by (simp add: algebra_simps)
  2847   also have "... sums (cos x * cos y)"
  2848     using summable_norm_cos
  2849     by (auto simp: cos_def scaleR_conv_of_real intro!: Cauchy_product_sums)
  2850   finally show ?thesis .
  2851 qed
  2852 
  2853 text\<open>The product of two sine series\<close>
  2854 lemma sin_x_sin_y:
  2855   fixes x :: "'a::{real_normed_field,banach}"
  2856   shows "(\<lambda>p. \<Sum>n\<le>p.
  2857           if even p \<and> odd n
  2858                then - ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0)
  2859          sums (sin x * sin y)"
  2860 proof -
  2861   { fix n p::nat
  2862     assume "n\<le>p"
  2863     { assume np: "odd n" "even p"
  2864         with \<open>n\<le>p\<close> have "n - Suc 0 + (p - Suc n) = p - Suc (Suc 0)" "Suc (Suc 0) \<le> p"
  2865         by arith+
  2866       moreover have "(p - Suc (Suc 0)) div 2 = p div 2 - Suc 0"
  2867         by simp
  2868       ultimately have *: "(-1) ^ ((n - Suc 0) div 2) * (-1) ^ ((p - Suc n) div 2) = - ((-1 :: real) ^ (p div 2))"
  2869         using np \<open>n\<le>p\<close>
  2870         apply (simp add: power_add [symmetric] div_add [symmetric] del: div_add)
  2871         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)
  2872         done
  2873     } then
  2874     have "(sin_coeff n * sin_coeff (p - n)) *\<^sub>R (x^n * y^(p-n)) =
  2875           (if even p \<and> odd n
  2876           then -((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0)"
  2877     using \<open>n\<le>p\<close>
  2878       by (auto simp:  algebra_simps sin_coeff_def binomial_fact real_of_nat_def)
  2879   }
  2880   then have "(\<lambda>p. \<Sum>n\<le>p. if even p \<and> odd n
  2881                then - ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0) =
  2882              (\<lambda>p. \<Sum>n\<le>p. (sin_coeff n * sin_coeff (p - n)) *\<^sub>R (x^n * y^(p-n)))"
  2883     by simp
  2884   also have "... = (\<lambda>p. \<Sum>n\<le>p. (sin_coeff n *\<^sub>R x^n) * (sin_coeff (p - n) *\<^sub>R y^(p-n)))"
  2885     by (simp add: algebra_simps)
  2886   also have "... sums (sin x * sin y)"
  2887     using summable_norm_sin
  2888     by (auto simp: sin_def scaleR_conv_of_real intro!: Cauchy_product_sums)
  2889   finally show ?thesis .
  2890 qed
  2891 
  2892 lemma sums_cos_x_plus_y:
  2893   fixes x :: "'a::{real_normed_field,banach}"
  2894   shows
  2895   "(\<lambda>p. \<Sum>n\<le>p. if even p
  2896                then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n)
  2897                else 0)
  2898         sums cos (x + y)"
  2899 proof -
  2900   { fix p::nat
  2901     have "(\<Sum>n\<le>p. if even p
  2902                   then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n)
  2903                   else 0) =
  2904           (if even p
  2905                   then \<Sum>n\<le>p. ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n)
  2906                   else 0)"
  2907       by simp
  2908     also have "... = (if even p
  2909                   then of_real ((-1) ^ (p div 2) / (fact p)) * (\<Sum>n\<le>p. (p choose n) *\<^sub>R (x^n) * y^(p-n))
  2910                   else 0)"
  2911       by (auto simp: setsum_right_distrib field_simps scaleR_conv_of_real nonzero_of_real_divide)
  2912     also have "... = cos_coeff p *\<^sub>R ((x + y) ^ p)"
  2913       by (simp add: cos_coeff_def binomial_ring [of x y]  scaleR_conv_of_real real_of_nat_def atLeast0AtMost)
  2914     finally have "(\<Sum>n\<le>p. if even p
  2915                   then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n)
  2916                   else 0) = cos_coeff p *\<^sub>R ((x + y) ^ p)" .
  2917   }
  2918   then have "(\<lambda>p. \<Sum>n\<le>p.
  2919                if even p
  2920                then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n)
  2921                else 0)
  2922         = (\<lambda>p. cos_coeff p *\<^sub>R ((x+y)^p))"
  2923         by simp
  2924    also have "... sums cos (x + y)"
  2925     by (rule cos_converges)
  2926    finally show ?thesis .
  2927 qed
  2928 
  2929 theorem cos_add:
  2930   fixes x :: "'a::{real_normed_field,banach}"
  2931   shows "cos (x + y) = cos x * cos y - sin x * sin y"
  2932 proof -
  2933   { fix n p::nat
  2934     assume "n\<le>p"
  2935     then have "(if even p \<and> even n
  2936                then ((- 1) ^ (p div 2) * int (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0) -
  2937           (if even p \<and> odd n
  2938                then - ((- 1) ^ (p div 2) * int (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0)
  2939           = (if even p
  2940                then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0)"
  2941       by simp
  2942   }
  2943   then have "(\<lambda>p. \<Sum>n\<le>p. (if even p
  2944                then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0))
  2945         sums (cos x * cos y - sin x * sin y)"
  2946     using sums_diff [OF cos_x_cos_y [of x y] sin_x_sin_y [of x y]]
  2947     by (simp add: setsum_subtractf [symmetric])
  2948   then show ?thesis
  2949     by (blast intro: sums_cos_x_plus_y sums_unique2)
  2950 qed
  2951 
  2952 lemma sin_minus_converges: "(\<lambda>n. - (sin_coeff n *\<^sub>R (-x)^n)) sums sin(x)"
  2953 proof -
  2954   have [simp]: "\<And>n. - (sin_coeff n *\<^sub>R (-x)^n) = (sin_coeff n *\<^sub>R x^n)"
  2955     by (auto simp: sin_coeff_def elim!: oddE)
  2956   show ?thesis
  2957     by (simp add: sin_def summable_norm_sin [THEN summable_norm_cancel, THEN summable_sums])
  2958 qed
  2959 
  2960 lemma sin_minus [simp]:
  2961   fixes x :: "'a::{real_normed_algebra_1,banach}"
  2962   shows "sin (-x) = -sin(x)"
  2963 using sin_minus_converges [of x]
  2964 by (auto simp: sin_def summable_norm_sin [THEN summable_norm_cancel] suminf_minus sums_iff equation_minus_iff)
  2965 
  2966 lemma cos_minus_converges: "(\<lambda>n. (cos_coeff n *\<^sub>R (-x)^n)) sums cos(x)"
  2967 proof -
  2968   have [simp]: "\<And>n. (cos_coeff n *\<^sub>R (-x)^n) = (cos_coeff n *\<^sub>R x^n)"
  2969     by (auto simp: Transcendental.cos_coeff_def elim!: evenE)
  2970   show ?thesis
  2971     by (simp add: cos_def summable_norm_cos [THEN summable_norm_cancel, THEN summable_sums])
  2972 qed
  2973 
  2974 lemma cos_minus [simp]:
  2975   fixes x :: "'a::{real_normed_algebra_1,banach}"
  2976   shows "cos (-x) = cos(x)"
  2977 using cos_minus_converges [of x]
  2978 by (simp add: cos_def summable_norm_cos [THEN summable_norm_cancel]
  2979               suminf_minus sums_iff equation_minus_iff)
  2980 
  2981 lemma sin_cos_squared_add [simp]:
  2982   fixes x :: "'a::{real_normed_field,banach}"
  2983   shows "(sin x)\<^sup>2 + (cos x)\<^sup>2 = 1"
  2984 using cos_add [of x "-x"]
  2985 by (simp add: power2_eq_square algebra_simps)
  2986 
  2987 lemma sin_cos_squared_add2 [simp]:
  2988   fixes x :: "'a::{real_normed_field,banach}"
  2989   shows "(cos x)\<^sup>2 + (sin x)\<^sup>2 = 1"
  2990   by (subst add.commute, rule sin_cos_squared_add)
  2991 
  2992 lemma sin_cos_squared_add3 [simp]:
  2993   fixes x :: "'a::{real_normed_field,banach}"
  2994   shows "cos x * cos x + sin x * sin x = 1"
  2995   using sin_cos_squared_add2 [unfolded power2_eq_square] .
  2996 
  2997 lemma sin_squared_eq:
  2998   fixes x :: "'a::{real_normed_field,banach}"
  2999   shows "(sin x)\<^sup>2 = 1 - (cos x)\<^sup>2"
  3000   unfolding eq_diff_eq by (rule sin_cos_squared_add)
  3001 
  3002 lemma cos_squared_eq:
  3003   fixes x :: "'a::{real_normed_field,banach}"
  3004   shows "(cos x)\<^sup>2 = 1 - (sin x)\<^sup>2"
  3005   unfolding eq_diff_eq by (rule sin_cos_squared_add2)
  3006 
  3007 lemma abs_sin_le_one [simp]:
  3008   fixes x :: real
  3009   shows "\<bar>sin x\<bar> \<le> 1"
  3010   by (rule power2_le_imp_le, simp_all add: sin_squared_eq)
  3011 
  3012 lemma sin_ge_minus_one [simp]:
  3013   fixes x :: real
  3014   shows "-1 \<le> sin x"
  3015   using abs_sin_le_one [of x] unfolding abs_le_iff by simp
  3016 
  3017 lemma sin_le_one [simp]:
  3018   fixes x :: real
  3019   shows "sin x \<le> 1"
  3020   using abs_sin_le_one [of x] unfolding abs_le_iff by simp
  3021 
  3022 lemma abs_cos_le_one [simp]:
  3023   fixes x :: real
  3024   shows "\<bar>cos x\<bar> \<le> 1"
  3025   by (rule power2_le_imp_le, simp_all add: cos_squared_eq)
  3026 
  3027 lemma cos_ge_minus_one [simp]:
  3028   fixes x :: real
  3029   shows "-1 \<le> cos x"
  3030   using abs_cos_le_one [of x] unfolding abs_le_iff by simp
  3031 
  3032 lemma cos_le_one [simp]:
  3033   fixes x :: real
  3034   shows "cos x \<le> 1"
  3035   using abs_cos_le_one [of x] unfolding abs_le_iff by simp
  3036 
  3037 lemma cos_diff:
  3038   fixes x :: "'a::{real_normed_field,banach}"
  3039   shows "cos (x - y) = cos x * cos y + sin x * sin y"
  3040   using cos_add [of x "- y"] by simp
  3041 
  3042 lemma cos_double:
  3043   fixes x :: "'a::{real_normed_field,banach}"
  3044   shows "cos(2*x) = (cos x)\<^sup>2 - (sin x)\<^sup>2"
  3045   using cos_add [where x=x and y=x]
  3046   by (simp add: power2_eq_square)
  3047 
  3048 lemma DERIV_fun_pow: "DERIV g x :> m ==>
  3049       DERIV (\<lambda>x. (g x) ^ n) x :> real n * (g x) ^ (n - 1) * m"
  3050   by (auto intro!: derivative_eq_intros simp: real_of_nat_def)
  3051 
  3052 lemma DERIV_fun_exp:
  3053      "DERIV g x :> m ==> DERIV (\<lambda>x. exp(g x)) x :> exp(g x) * m"
  3054   by (auto intro!: derivative_intros)
  3055 
  3056 subsection \<open>The Constant Pi\<close>
  3057 
  3058 definition pi :: real
  3059   where "pi = 2 * (THE x. 0 \<le> (x::real) & x \<le> 2 & cos x = 0)"
  3060 
  3061 text\<open>Show that there's a least positive @{term x} with @{term "cos(x) = 0"};
  3062    hence define pi.\<close>
  3063 
  3064 lemma sin_paired:
  3065   fixes x :: real
  3066   shows "(\<lambda>n. (- 1) ^ n / (fact (2 * n + 1)) * x ^ (2 * n + 1)) sums  sin x"
  3067 proof -
  3068   have "(\<lambda>n. \<Sum>k = n*2..<n * 2 + 2. sin_coeff k * x ^ k) sums sin x"
  3069     apply (rule sums_group)
  3070     using sin_converges [of x, unfolded scaleR_conv_of_real]
  3071     by auto
  3072   thus ?thesis unfolding One_nat_def sin_coeff_def by (simp add: ac_simps)
  3073 qed
  3074 
  3075 lemma sin_gt_zero_02:
  3076   fixes x :: real
  3077   assumes "0 < x" and "x < 2"
  3078   shows "0 < sin x"
  3079 proof -
  3080   let ?f = "\<lambda>n::nat. \<Sum>k = n*2..<n*2+2. (- 1) ^ k / (fact (2*k+1)) * x^(2*k+1)"
  3081   have pos: "\<forall>n. 0 < ?f n"
  3082   proof
  3083     fix n :: nat
  3084     let ?k2 = "real (Suc (Suc (4 * n)))"
  3085     let ?k3 = "real (Suc (Suc (Suc (4 * n))))"
  3086     have "x * x < ?k2 * ?k3"
  3087       using assms by (intro mult_strict_mono', simp_all)
  3088     hence "x * x * x * x ^ (n * 4) < ?k2 * ?k3 * x * x ^ (n * 4)"
  3089       by (intro mult_strict_right_mono zero_less_power \<open>0 < x\<close>)
  3090     thus "0 < ?f n"
  3091       by (simp add: real_of_nat_def divide_simps mult_ac del: mult_Suc)
  3092 qed
  3093   have sums: "?f sums sin x"
  3094     by (rule sin_paired [THEN sums_group], simp)
  3095   show "0 < sin x"
  3096     unfolding sums_unique [OF sums]
  3097     using sums_summable [OF sums] pos
  3098     by (rule suminf_pos)
  3099 qed
  3100 
  3101 lemma cos_double_less_one:
  3102   fixes x :: real
  3103   shows "0 < x \<Longrightarrow> x < 2 \<Longrightarrow> cos (2 * x) < 1"
  3104   using sin_gt_zero_02 [where x = x] by (auto simp: cos_squared_eq cos_double)
  3105 
  3106 lemma cos_paired:
  3107   fixes x :: real
  3108   shows "(\<lambda>n. (- 1) ^ n / (fact (2 * n)) * x ^ (2 * n)) sums cos x"
  3109 proof -
  3110   have "(\<lambda>n. \<Sum>k = n * 2..<n * 2 + 2. cos_coeff k * x ^ k) sums cos x"
  3111     apply (rule sums_group)
  3112     using cos_converges [of x, unfolded scaleR_conv_of_real]
  3113     by auto
  3114   thus ?thesis unfolding cos_coeff_def by (simp add: ac_simps)
  3115 qed
  3116 
  3117 lemmas realpow_num_eq_if = power_eq_if
  3118 
  3119 lemma sumr_pos_lt_pair: 
  3120   fixes f :: "nat \<Rightarrow> real"
  3121   shows "\<lbrakk>summable f;
  3122         \<And>d. 0 < f (k + (Suc(Suc 0) * d)) + f (k + ((Suc(Suc 0) * d) + 1))\<rbrakk>
  3123       \<Longrightarrow> setsum f {..<k} < suminf f"
  3124 unfolding One_nat_def
  3125 apply (subst suminf_split_initial_segment [where k=k], assumption, simp)
  3126 apply (drule_tac k=k in summable_ignore_initial_segment)
  3127 apply (drule_tac k="Suc (Suc 0)" in sums_group [OF summable_sums], simp)
  3128 apply simp
  3129 by (metis (no_types, lifting) add.commute suminf_pos summable_def sums_unique)
  3130 
  3131 lemma cos_two_less_zero [simp]:
  3132   "cos 2 < (0::real)"
  3133 proof -
  3134   note fact.simps(2) [simp del]
  3135   from sums_minus [OF cos_paired]
  3136   have *: "(\<lambda>n. - ((- 1) ^ n * 2 ^ (2 * n) / fact (2 * n))) sums - cos (2::real)"
  3137     by simp
  3138   then have sm: "summable (\<lambda>n. - ((- 1::real) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
  3139     by (rule sums_summable)
  3140   have "0 < (\<Sum>n<Suc (Suc (Suc 0)). - ((- 1::real) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
  3141     by (simp add: fact_num_eq_if realpow_num_eq_if)
  3142   moreover have "(\<Sum>n<Suc (Suc (Suc 0)). - ((- 1::real) ^ n  * 2 ^ (2 * n) / (fact (2 * n))))
  3143                  < (\<Sum>n. - ((- 1) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
  3144   proof -
  3145     { fix d
  3146       let ?six4d = "Suc (Suc (Suc (Suc (Suc (Suc (4 * d))))))"
  3147       have "(4::real) * (fact (?six4d)) < (Suc (Suc (?six4d)) * fact (Suc (?six4d)))"
  3148         unfolding real_of_nat_mult
  3149         by (rule mult_strict_mono) (simp_all add: fact_less_mono)
  3150       then have "(4::real) * (fact (?six4d)) < (fact (Suc (Suc (?six4d))))"
  3151         by (simp only: fact.simps(2) [of "Suc (?six4d)"] real_of_nat_def of_nat_mult of_nat_fact)
  3152       then have "(4::real) * inverse (fact (Suc (Suc (?six4d)))) < inverse (fact (?six4d))"
  3153         by (simp add: inverse_eq_divide less_divide_eq)
  3154     } 
  3155     then show ?thesis
  3156       by (force intro!: sumr_pos_lt_pair [OF sm] simp add: power_Suc divide_inverse algebra_simps)
  3157   qed
  3158   ultimately have "0 < (\<Sum>n. - ((- 1::real) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
  3159     by (rule order_less_trans)
  3160   moreover from * have "- cos 2 = (\<Sum>n. - ((- 1::real) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
  3161     by (rule sums_unique)
  3162   ultimately have "(0::real) < - cos 2" by simp
  3163   then show ?thesis by simp
  3164 qed
  3165 
  3166 lemmas cos_two_neq_zero [simp] = cos_two_less_zero [THEN less_imp_neq]
  3167 lemmas cos_two_le_zero [simp] = cos_two_less_zero [THEN order_less_imp_le]
  3168 
  3169 lemma cos_is_zero: "EX! x::real. 0 \<le> x & x \<le> 2 \<and> cos x = 0"
  3170 proof (rule ex_ex1I)
  3171   show "\<exists>x::real. 0 \<le> x & x \<le> 2 & cos x = 0"
  3172     by (rule IVT2, simp_all)
  3173 next
  3174   fix x::real and y::real
  3175   assume x: "0 \<le> x \<and> x \<le> 2 \<and> cos x = 0"
  3176   assume y: "0 \<le> y \<and> y \<le> 2 \<and> cos y = 0"
  3177   have [simp]: "\<forall>x::real. cos differentiable (at x)"
  3178     unfolding real_differentiable_def by (auto intro: DERIV_cos)
  3179   from x y show "x = y"
  3180     apply (cut_tac less_linear [of x y], auto)
  3181     apply (drule_tac f = cos in Rolle)
  3182     apply (drule_tac [5] f = cos in Rolle)
  3183     apply (auto dest!: DERIV_cos [THEN DERIV_unique])
  3184     apply (metis order_less_le_trans less_le sin_gt_zero_02)
  3185     apply (metis order_less_le_trans less_le sin_gt_zero_02)
  3186     done
  3187 qed
  3188 
  3189 lemma pi_half: "pi/2 = (THE x. 0 \<le> x & x \<le> 2 & cos x = 0)"
  3190   by (simp add: pi_def)
  3191 
  3192 lemma cos_pi_half [simp]: "cos (pi / 2) = 0"
  3193   by (simp add: pi_half cos_is_zero [THEN theI'])
  3194 
  3195 lemma cos_of_real_pi_half [simp]:
  3196   fixes x :: "'a :: {real_field,banach,real_normed_algebra_1}"
  3197   shows "cos ((of_real pi / 2) :: 'a) = 0"
  3198 by (metis cos_pi_half cos_of_real eq_numeral_simps(4) nonzero_of_real_divide of_real_0 of_real_numeral)
  3199 
  3200 lemma pi_half_gt_zero [simp]: "0 < pi / 2"
  3201   apply (rule order_le_neq_trans)
  3202   apply (simp add: pi_half cos_is_zero [THEN theI'])
  3203   apply (metis cos_pi_half cos_zero zero_neq_one)
  3204   done
  3205 
  3206 lemmas pi_half_neq_zero [simp] = pi_half_gt_zero [THEN less_imp_neq, symmetric]
  3207 lemmas pi_half_ge_zero [simp] = pi_half_gt_zero [THEN order_less_imp_le]
  3208 
  3209 lemma pi_half_less_two [simp]: "pi / 2 < 2"
  3210   apply (rule order_le_neq_trans)
  3211   apply (simp add: pi_half cos_is_zero [THEN theI'])
  3212   apply (metis cos_pi_half cos_two_neq_zero)
  3213   done
  3214 
  3215 lemmas pi_half_neq_two [simp] = pi_half_less_two [THEN less_imp_neq]
  3216 lemmas pi_half_le_two [simp] =  pi_half_less_two [THEN order_less_imp_le]
  3217 
  3218 lemma pi_gt_zero [simp]: "0 < pi"
  3219   using pi_half_gt_zero by simp
  3220 
  3221 lemma pi_ge_zero [simp]: "0 \<le> pi"
  3222   by (rule pi_gt_zero [THEN order_less_imp_le])
  3223 
  3224 lemma pi_neq_zero [simp]: "pi \<noteq> 0"
  3225   by (rule pi_gt_zero [THEN less_imp_neq, symmetric])
  3226 
  3227 lemma pi_not_less_zero [simp]: "\<not> pi < 0"
  3228   by (simp add: linorder_not_less)
  3229 
  3230 lemma minus_pi_half_less_zero: "-(pi/2) < 0"
  3231   by simp
  3232 
  3233 lemma m2pi_less_pi: "- (2*pi) < pi"
  3234   by simp
  3235 
  3236 lemma sin_pi_half [simp]: "sin(pi/2) = 1"
  3237   using sin_cos_squared_add2 [where x = "pi/2"]
  3238   using sin_gt_zero_02 [OF pi_half_gt_zero pi_half_less_two]
  3239   by (simp add: power2_eq_1_iff)
  3240 
  3241 lemma sin_of_real_pi_half [simp]:
  3242   fixes x :: "'a :: {real_field,banach,real_normed_algebra_1}"
  3243   shows "sin ((of_real pi / 2) :: 'a) = 1"
  3244   using sin_pi_half
  3245 by (metis sin_pi_half eq_numeral_simps(4) nonzero_of_real_divide of_real_1 of_real_numeral sin_of_real)
  3246 
  3247 lemma sin_cos_eq:
  3248   fixes x :: "'a::{real_normed_field,banach}"
  3249   shows "sin x = cos (of_real pi / 2 - x)"
  3250   by (simp add: cos_diff)
  3251 
  3252 lemma minus_sin_cos_eq:
  3253   fixes x :: "'a::{real_normed_field,banach}"
  3254   shows "-sin x = cos (x + of_real pi / 2)"
  3255   by (simp add: cos_add nonzero_of_real_divide)
  3256 
  3257 lemma cos_sin_eq:
  3258   fixes x :: "'a::{real_normed_field,banach}"
  3259   shows "cos x = sin (of_real pi / 2 - x)"
  3260   using sin_cos_eq [of "of_real pi / 2 - x"]
  3261   by simp
  3262 
  3263 lemma sin_add:
  3264   fixes x :: "'a::{real_normed_field,banach}"
  3265   shows "sin (x + y) = sin x * cos y + cos x * sin y"
  3266   using cos_add [of "of_real pi / 2 - x" "-y"]
  3267   by (simp add: cos_sin_eq) (simp add: sin_cos_eq)
  3268 
  3269 lemma sin_diff:
  3270   fixes x :: "'a::{real_normed_field,banach}"
  3271   shows "sin (x - y) = sin x * cos y - cos x * sin y"
  3272   using sin_add [of x "- y"] by simp
  3273 
  3274 lemma sin_double:
  3275   fixes x :: "'a::{real_normed_field,banach}"
  3276   shows "sin(2 * x) = 2 * sin x * cos x"
  3277   using sin_add [where x=x and y=x] by simp
  3278 
  3279 
  3280 lemma cos_of_real_pi [simp]: "cos (of_real pi) = -1"
  3281   using cos_add [where x = "pi/2" and y = "pi/2"]
  3282   by (simp add: cos_of_real)
  3283 
  3284 lemma sin_of_real_pi [simp]: "sin (of_real pi) = 0"
  3285   using sin_add [where x = "pi/2" and y = "pi/2"]
  3286   by (simp add: sin_of_real)
  3287 
  3288 lemma cos_pi [simp]: "cos pi = -1"
  3289   using cos_add [where x = "pi/2" and y = "pi/2"] by simp
  3290 
  3291 lemma sin_pi [simp]: "sin pi = 0"
  3292   using sin_add [where x = "pi/2" and y = "pi/2"] by simp
  3293 
  3294 lemma sin_periodic_pi [simp]: "sin (x + pi) = - sin x"
  3295   by (simp add: sin_add)
  3296 
  3297 lemma sin_periodic_pi2 [simp]: "sin (pi + x) = - sin x"
  3298   by (simp add: sin_add)
  3299 
  3300 lemma cos_periodic_pi [simp]: "cos (x + pi) = - cos x"
  3301   by (simp add: cos_add)
  3302 
  3303 lemma sin_periodic [simp]: "sin (x + 2*pi) = sin x"
  3304   by (simp add: sin_add sin_double cos_double)
  3305 
  3306 lemma cos_periodic [simp]: "cos (x + 2*pi) = cos x"
  3307   by (simp add: cos_add sin_double cos_double)
  3308 
  3309 lemma cos_npi [simp]: "cos (real n * pi) = (- 1) ^ n"
  3310   by (induct n) (auto simp: real_of_nat_Suc distrib_right)
  3311 
  3312 lemma cos_npi2 [simp]: "cos (pi * real n) = (- 1) ^ n"
  3313   by (metis cos_npi mult.commute)
  3314 
  3315 lemma sin_npi [simp]: "sin (real (n::nat) * pi) = 0"
  3316   by (induct n) (auto simp: real_of_nat_Suc distrib_right)
  3317 
  3318 lemma sin_npi2 [simp]: "sin (pi * real (n::nat)) = 0"
  3319   by (simp add: mult.commute [of pi])
  3320 
  3321 lemma cos_two_pi [simp]: "cos (2*pi) = 1"
  3322   by (simp add: cos_double)
  3323 
  3324 lemma sin_two_pi [simp]: "sin (2*pi) = 0"
  3325   by (simp add: sin_double)
  3326 
  3327 
  3328 lemma sin_times_sin:
  3329   fixes w :: "'a::{real_normed_field,banach}"
  3330   shows "sin(w) * sin(z) = (cos(w - z) - cos(w + z)) / 2"
  3331   by (simp add: cos_diff cos_add)
  3332 
  3333 lemma sin_times_cos:
  3334   fixes w :: "'a::{real_normed_field,banach}"
  3335   shows "sin(w) * cos(z) = (sin(w + z) + sin(w - z)) / 2"
  3336   by (simp add: sin_diff sin_add)
  3337 
  3338 lemma cos_times_sin:
  3339   fixes w :: "'a::{real_normed_field,banach}"
  3340   shows "cos(w) * sin(z) = (sin(w + z) - sin(w - z)) / 2"
  3341   by (simp add: sin_diff sin_add)
  3342 
  3343 lemma cos_times_cos:
  3344   fixes w :: "'a::{real_normed_field,banach}"
  3345   shows "cos(w) * cos(z) = (cos(w - z) + cos(w + z)) / 2"
  3346   by (simp add: cos_diff cos_add)
  3347 
  3348 lemma sin_plus_sin:  (*FIXME field should not be necessary*)
  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 sin_diff_sin: 
  3356   fixes w :: "'a::{real_normed_field,banach,field}"
  3357   shows "sin(w) - sin(z) = 2 * sin((w - z) / 2) * cos((w + z) / 2)"
  3358   apply (simp add: mult.assoc sin_times_cos)
  3359   apply (simp add: field_simps)
  3360   done
  3361 
  3362 lemma cos_plus_cos: 
  3363   fixes w :: "'a::{real_normed_field,banach,field}"
  3364   shows "cos(w) + cos(z) = 2 * cos((w + z) / 2) * cos((w - z) / 2)"
  3365   apply (simp add: mult.assoc cos_times_cos)
  3366   apply (simp add: field_simps)
  3367   done
  3368 
  3369 lemma cos_diff_cos: 
  3370   fixes w :: "'a::{real_normed_field,banach,field}"
  3371   shows "cos(w) - cos(z) = 2 * sin((w + z) / 2) * sin((z - w) / 2)"
  3372   apply (simp add: mult.assoc sin_times_sin)
  3373   apply (simp add: field_simps)
  3374   done
  3375 
  3376 lemma cos_double_cos: 
  3377   fixes z :: "'a::{real_normed_field,banach}"
  3378   shows "cos(2 * z) = 2 * cos z ^ 2 - 1"
  3379 by (simp add: cos_double sin_squared_eq)
  3380 
  3381 lemma cos_double_sin: 
  3382   fixes z :: "'a::{real_normed_field,banach}"
  3383   shows "cos(2 * z) = 1 - 2 * sin z ^ 2"
  3384 by (simp add: cos_double sin_squared_eq)
  3385 
  3386 lemma sin_pi_minus [simp]: "sin (pi - x) = sin x"
  3387   by (metis sin_minus sin_periodic_pi minus_minus uminus_add_conv_diff)
  3388 
  3389 lemma cos_pi_minus [simp]: "cos (pi - x) = -(cos x)"
  3390   by (metis cos_minus cos_periodic_pi uminus_add_conv_diff)
  3391 
  3392 lemma sin_minus_pi [simp]: "sin (x - pi) = - (sin x)"
  3393   by (simp add: sin_diff)
  3394 
  3395 lemma cos_minus_pi [simp]: "cos (x - pi) = -(cos x)"
  3396   by (simp add: cos_diff)
  3397 
  3398 lemma sin_2pi_minus [simp]: "sin (2*pi - x) = -(sin x)"
  3399   by (metis sin_periodic_pi2 add_diff_eq mult_2 sin_pi_minus)
  3400 
  3401 lemma cos_2pi_minus [simp]: "cos (2*pi - x) = cos x"
  3402   by (metis (no_types, hide_lams) cos_add cos_minus cos_two_pi sin_minus sin_two_pi 
  3403            diff_0_right minus_diff_eq mult_1 mult_zero_left uminus_add_conv_diff)
  3404 
  3405 lemma sin_gt_zero2: "\<lbrakk>0 < x; x < pi/2\<rbrakk> \<Longrightarrow> 0 < sin x"
  3406   by (metis sin_gt_zero_02 order_less_trans pi_half_less_two)
  3407 
  3408 lemma sin_less_zero:
  3409   assumes "- pi/2 < x" and "x < 0"
  3410   shows "sin x < 0"
  3411 proof -
  3412   have "0 < sin (- x)" using assms by (simp only: sin_gt_zero2)
  3413   thus ?thesis by simp
  3414 qed
  3415 
  3416 lemma pi_less_4: "pi < 4"
  3417   using pi_half_less_two by auto
  3418 
  3419 lemma cos_gt_zero: "\<lbrakk>0 < x; x < pi/2\<rbrakk> \<Longrightarrow> 0 < cos x"
  3420   by (simp add: cos_sin_eq sin_gt_zero2)
  3421 
  3422 lemma cos_gt_zero_pi: "\<lbrakk>-(pi/2) < x; x < pi/2\<rbrakk> \<Longrightarrow> 0 < cos x"
  3423   using cos_gt_zero [of x] cos_gt_zero [of "-x"]
  3424   by (cases rule: linorder_cases [of x 0]) auto
  3425 
  3426 lemma cos_ge_zero: "\<lbrakk>-(pi/2) \<le> x; x \<le> pi/2\<rbrakk> \<Longrightarrow> 0 \<le> cos x"
  3427   apply (auto simp: order_le_less cos_gt_zero_pi)
  3428   by (metis cos_pi_half eq_divide_eq eq_numeral_simps(4))
  3429 
  3430 lemma sin_gt_zero: "\<lbrakk>0 < x; x < pi \<rbrakk> \<Longrightarrow> 0 < sin x"
  3431   by (simp add: sin_cos_eq cos_gt_zero_pi)
  3432 
  3433 lemma sin_lt_zero: "pi < x \<Longrightarrow> x < 2*pi \<Longrightarrow> sin x < 0"
  3434   using sin_gt_zero [of "x-pi"]
  3435   by (simp add: sin_diff)
  3436 
  3437 lemma pi_ge_two: "2 \<le> pi"
  3438 proof (rule ccontr)
  3439   assume "\<not> 2 \<le> pi" hence "pi < 2" by auto
  3440   have "\<exists>y > pi. y < 2 \<and> y < 2*pi"
  3441   proof (cases "2 < 2*pi")
  3442     case True with dense[OF \<open>pi < 2\<close>] show ?thesis by auto
  3443   next
  3444     case False have "pi < 2*pi" by auto
  3445     from dense[OF this] and False show ?thesis by auto
  3446   qed
  3447   then obtain y where "pi < y" and "y < 2" and "y < 2*pi" by blast
  3448   hence "0 < sin y" using sin_gt_zero_02 by auto
  3449   moreover
  3450   have "sin y < 0" using sin_gt_zero[of "y - pi"] \<open>pi < y\<close> and \<open>y < 2*pi\<close> sin_periodic_pi[of "y - pi"] by auto
  3451   ultimately show False by auto
  3452 qed
  3453 
  3454 lemma sin_ge_zero: "\<lbrakk>0 \<le> x; x \<le> pi\<rbrakk> \<Longrightarrow> 0 \<le> sin x"
  3455   by (auto simp: order_le_less sin_gt_zero)
  3456 
  3457 lemma sin_le_zero: "pi \<le> x \<Longrightarrow> x < 2*pi \<Longrightarrow> sin x \<le> 0"
  3458   using sin_ge_zero [of "x-pi"]
  3459   by (simp add: sin_diff)
  3460 
  3461 text \<open>FIXME: This proof is almost identical to lemma @{text cos_is_zero}.
  3462   It should be possible to factor out some of the common parts.\<close>
  3463 
  3464 lemma cos_total: "\<lbrakk>-1 \<le> y; y \<le> 1\<rbrakk> \<Longrightarrow> EX! x. 0 \<le> x & x \<le> pi & (cos x = y)"
  3465 proof (rule ex_ex1I)
  3466   assume y: "-1 \<le> y" "y \<le> 1"
  3467   show "\<exists>x. 0 \<le> x & x \<le> pi & cos x = y"
  3468     by (rule IVT2, simp_all add: y)
  3469 next
  3470   fix a b
  3471   assume a: "0 \<le> a \<and> a \<le> pi \<and> cos a = y"
  3472   assume b: "0 \<le> b \<and> b \<le> pi \<and> cos b = y"
  3473   have [simp]: "\<forall>x::real. cos differentiable (at x)"
  3474     unfolding real_differentiable_def by (auto intro: DERIV_cos)
  3475   from a b show "a = b"
  3476     apply (cut_tac less_linear [of a b], auto)
  3477     apply (drule_tac f = cos in Rolle)
  3478     apply (drule_tac [5] f = cos in Rolle)
  3479     apply (auto dest!: DERIV_cos [THEN DERIV_unique])
  3480     apply (metis order_less_le_trans less_le sin_gt_zero)
  3481     apply (metis order_less_le_trans less_le sin_gt_zero)
  3482     done
  3483 qed
  3484 
  3485 lemma sin_total:
  3486   assumes y: "-1 \<le> y" "y \<le> 1"
  3487     shows "\<exists>! x. -(pi/2) \<le> x & x \<le> pi/2 & (sin x = y)"
  3488 proof -
  3489   from cos_total [OF y]
  3490   obtain x where x: "0 \<le> x" "x \<le> pi" "cos x = y"
  3491            and uniq: "\<And>x'. 0 \<le> x' \<Longrightarrow> x' \<le> pi \<Longrightarrow> cos x' = y \<Longrightarrow> x' = x "
  3492     by blast
  3493   show ?thesis
  3494     apply (simp add: sin_cos_eq)
  3495     apply (rule ex1I [where a="pi/2 - x"])
  3496     apply (cut_tac [2] x'="pi/2 - xa" in uniq)
  3497     using x
  3498     apply auto
  3499     done
  3500 qed
  3501 
  3502 lemma reals_Archimedean4':
  3503      "\<lbrakk>0 < y; 0 \<le> x\<rbrakk> \<Longrightarrow> \<exists>n. real n * y \<le> x \<and> x < real (Suc n) * y"
  3504 apply (rule_tac x="nat (floor (x/y))" in exI)
  3505 using floor_correct [of "x/y"]
  3506 apply (auto simp: Real.real_of_nat_Suc field_simps)
  3507 done
  3508 
  3509 lemma cos_zero_lemma:
  3510      "\<lbrakk>0 \<le> x; cos x = 0\<rbrakk> \<Longrightarrow>
  3511       \<exists>n::nat. odd n & x = real n * (pi/2)"
  3512 apply (erule reals_Archimedean4 [OF pi_gt_zero])
  3513 apply (auto simp: )
  3514 apply (subgoal_tac "0 \<le> x - real n * pi &
  3515                     (x - real n * pi) \<le> pi & (cos (x - real n * pi) = 0) ")
  3516 apply (auto simp: algebra_simps real_of_nat_Suc)
  3517  prefer 2 apply (simp add: cos_diff)
  3518 apply (simp add: cos_diff)
  3519 apply (subgoal_tac "EX! x. 0 \<le> x & x \<le> pi & cos x = 0")
  3520 apply (rule_tac [2] cos_total, safe)
  3521 apply (drule_tac x = "x - real n * pi" in spec)
  3522 apply (drule_tac x = "pi/2" in spec)
  3523 apply (simp add: cos_diff)
  3524 apply (rule_tac x = "Suc (2 * n)" in exI)
  3525 apply (simp add: real_of_nat_Suc algebra_simps, auto)
  3526 done
  3527 
  3528 lemma sin_zero_lemma:
  3529      "\<lbrakk>0 \<le> x; sin x = 0\<rbrakk> \<Longrightarrow>
  3530       \<exists>n::nat. even n & x = real n * (pi/2)"
  3531 apply (subgoal_tac "\<exists>n::nat. ~ even n & x + pi/2 = real n * (pi/2) ")
  3532  apply (clarify, rule_tac x = "n - 1" in exI)
  3533  apply (auto elim!: oddE simp add: real_of_nat_Suc field_simps)[1]
  3534  apply (rule cos_zero_lemma)
  3535  apply (auto simp: cos_add)
  3536 done
  3537 
  3538 lemma cos_zero_iff:
  3539      "(cos x = 0) =
  3540       ((\<exists>n::nat. odd n & (x = real n * (pi/2))) |
  3541        (\<exists>n::nat. odd n & (x = -(real n * (pi/2)))))"
  3542 proof -
  3543   { fix n :: nat
  3544     assume "odd n"
  3545     then obtain m where "n = 2 * m + 1" ..
  3546     then have "cos (real n * pi / 2) = 0"
  3547       by (simp add: field_simps real_of_nat_Suc) (simp add: cos_add add_divide_distrib)
  3548   } note * = this
  3549   show ?thesis
  3550   apply (rule iffI)
  3551   apply (cut_tac linorder_linear [of 0 x], safe)
  3552   apply (drule cos_zero_lemma, assumption+)
  3553   apply (cut_tac x="-x" in cos_zero_lemma, simp, simp)
  3554   apply (auto dest: *)
  3555   done
  3556 qed
  3557 
  3558 (* ditto: but to a lesser extent *)
  3559 lemma sin_zero_iff:
  3560      "(sin x = 0) =
  3561       ((\<exists>n::nat. even n & (x = real n * (pi/2))) |
  3562        (\<exists>n::nat. even n & (x = -(real n * (pi/2)))))"
  3563 apply (rule iffI)
  3564 apply (cut_tac linorder_linear [of 0 x], safe)
  3565 apply (drule sin_zero_lemma, assumption+)
  3566 apply (cut_tac x="-x" in sin_zero_lemma, simp, simp, safe)
  3567 apply (force simp add: minus_equation_iff [of x])
  3568 apply (auto elim: evenE)
  3569 done
  3570 
  3571 
  3572 lemma cos_zero_iff_int:
  3573      "cos x = 0 \<longleftrightarrow> (\<exists>n::int. odd n & x = real n * (pi/2))"
  3574 proof safe
  3575   assume "cos x = 0"
  3576   then show "\<exists>n::int. odd n & x = real n * (pi/2)"
  3577     apply (simp add: cos_zero_iff, safe)
  3578     apply (metis even_int_iff real_of_int_of_nat_eq)
  3579     apply (rule_tac x="- (int n)" in exI, simp)
  3580     done
  3581 next
  3582   fix n::int
  3583   assume "odd n"
  3584   then show "cos (real n * (pi / 2)) = 0"
  3585     apply (simp add: cos_zero_iff)
  3586     apply (case_tac n rule: int_cases2, simp)
  3587     apply (rule disjI2)
  3588     apply (rule_tac x="nat (-n)" in exI, simp)
  3589     done
  3590 qed
  3591 
  3592 lemma sin_zero_iff_int:
  3593      "sin x = 0 \<longleftrightarrow> (\<exists>n::int. even n & (x = real n * (pi/2)))"
  3594 proof safe
  3595   assume "sin x = 0"
  3596   then show "\<exists>n::int. even n \<and> x = real n * (pi / 2)"
  3597     apply (simp add: sin_zero_iff, safe)
  3598     apply (metis even_int_iff real_of_int_of_nat_eq)
  3599     apply (rule_tac x="- (int n)" in exI, simp)
  3600     done
  3601 next
  3602   fix n::int
  3603   assume "even n"
  3604   then show "sin (real n * (pi / 2)) = 0"
  3605     apply (simp add: sin_zero_iff)
  3606     apply (case_tac n rule: int_cases2, simp)
  3607     apply (rule disjI2)
  3608     apply (rule_tac x="nat (-n)" in exI, simp)
  3609     done
  3610 qed
  3611 
  3612 lemma sin_zero_iff_int2:
  3613   "sin x = 0 \<longleftrightarrow> (\<exists>n::int. x = real n * pi)"
  3614   apply (simp only: sin_zero_iff_int)
  3615   apply (safe elim!: evenE)
  3616   apply (simp_all add: field_simps)
  3617   apply (subst real_numeral(1) [symmetric])
  3618   apply (simp only: real_of_int_mult [symmetric] real_of_int_inject)
  3619   apply auto
  3620   done
  3621 
  3622 lemma cos_monotone_0_pi:
  3623   assumes "0 \<le> y" and "y < x" and "x \<le> pi"
  3624   shows "cos x < cos y"
  3625 proof -
  3626   have "- (x - y) < 0" using assms by auto
  3627 
  3628   from MVT2[OF \<open>y < x\<close> DERIV_cos[THEN impI, THEN allI]]
  3629   obtain z where "y < z" and "z < x" and cos_diff: "cos x - cos y = (x - y) * - sin z"
  3630     by auto
  3631   hence "0 < z" and "z < pi" using assms by auto
  3632   hence "0 < sin z" using sin_gt_zero by auto
  3633   hence "cos x - cos y < 0"
  3634     unfolding cos_diff minus_mult_commute[symmetric]
  3635     using \<open>- (x - y) < 0\<close> by (rule mult_pos_neg2)
  3636   thus ?thesis by auto
  3637 qed
  3638 
  3639 lemma cos_monotone_0_pi_le:
  3640   assumes "0 \<le> y" and "y \<le> x" and "x \<le> pi"
  3641   shows "cos x \<le> cos y"
  3642 proof (cases "y < x")
  3643   case True
  3644   show ?thesis
  3645     using cos_monotone_0_pi[OF \<open>0 \<le> y\<close> True \<open>x \<le> pi\<close>] by auto
  3646 next
  3647   case False
  3648   hence "y = x" using \<open>y \<le> x\<close> by auto
  3649   thus ?thesis by auto
  3650 qed
  3651 
  3652 lemma cos_monotone_minus_pi_0:
  3653   assumes "-pi \<le> y" and "y < x" and "x \<le> 0"
  3654   shows "cos y < cos x"
  3655 proof -
  3656   have "0 \<le> -x" and "-x < -y" and "-y \<le> pi"
  3657     using assms by auto
  3658   from cos_monotone_0_pi[OF this] show ?thesis
  3659     unfolding cos_minus .
  3660 qed
  3661 
  3662 lemma cos_monotone_minus_pi_0':
  3663   assumes "-pi \<le> y" and "y \<le> x" and "x \<le> 0"
  3664   shows "cos y \<le> cos x"
  3665 proof (cases "y < x")
  3666   case True
  3667   show ?thesis using cos_monotone_minus_pi_0[OF \<open>-pi \<le> y\<close> True \<open>x \<le> 0\<close>]
  3668     by auto
  3669 next
  3670   case False
  3671   hence "y = x" using \<open>y \<le> x\<close> by auto
  3672   thus ?thesis by auto
  3673 qed
  3674 
  3675 lemma sin_monotone_2pi:
  3676   assumes "- (pi/2) \<le> y" and "y < x" and "x \<le> pi/2"
  3677   shows "sin y < sin x"
  3678     apply (simp add: sin_cos_eq)
  3679     apply (rule cos_monotone_0_pi)
  3680     using assms
  3681     apply auto
  3682     done
  3683 
  3684 lemma sin_monotone_2pi_le:
  3685   assumes "- (pi / 2) \<le> y" and "y \<le> x" and "x \<le> pi / 2"
  3686   shows "sin y \<le> sin x"
  3687   by (metis assms le_less sin_monotone_2pi)
  3688 
  3689 lemma sin_x_le_x:
  3690   fixes x::real assumes x: "x \<ge> 0" shows "sin x \<le> x"
  3691 proof -
  3692   let ?f = "\<lambda>x. x - sin x"
  3693   from x have "?f x \<ge> ?f 0"
  3694     apply (rule DERIV_nonneg_imp_nondecreasing)
  3695     apply (intro allI impI exI[of _ "1 - cos x" for x])
  3696     apply (auto intro!: derivative_eq_intros simp: field_simps)
  3697     done
  3698   thus "sin x \<le> x" by simp
  3699 qed
  3700 
  3701 lemma sin_x_ge_neg_x:
  3702   fixes x::real assumes x: "x \<ge> 0" shows "sin x \<ge> - x"
  3703 proof -
  3704   let ?f = "\<lambda>x. x + sin x"
  3705   from x have "?f x \<ge> ?f 0"
  3706     apply (rule DERIV_nonneg_imp_nondecreasing)
  3707     apply (intro allI impI exI[of _ "1 + cos x" for x])
  3708     apply (auto intro!: derivative_eq_intros simp: field_simps real_0_le_add_iff)
  3709     done
  3710   thus "sin x \<ge> -x" by simp
  3711 qed
  3712 
  3713 lemma abs_sin_x_le_abs_x:
  3714   fixes x::real shows "\<bar>sin x\<bar> \<le> \<bar>x\<bar>"
  3715   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"]
  3716   by (auto simp: abs_real_def)
  3717 
  3718 
  3719 subsection \<open>More Corollaries about Sine and Cosine\<close>
  3720 
  3721 lemma sin_cos_npi [simp]: "sin (real (Suc (2 * n)) * pi / 2) = (-1) ^ n"
  3722 proof -
  3723   have "sin ((real n + 1/2) * pi) = cos (real n * pi)"
  3724     by (auto simp: algebra_simps sin_add)
  3725   thus ?thesis
  3726     by (simp add: real_of_nat_Suc distrib_right add_divide_distrib
  3727                   mult.commute [of pi])
  3728 qed
  3729 
  3730 lemma cos_2npi [simp]: "cos (2 * real (n::nat) * pi) = 1"
  3731   by (cases "even n") (simp_all add: cos_double mult.assoc)
  3732 
  3733 lemma cos_3over2_pi [simp]: "cos (3/2*pi) = 0"
  3734   apply (subgoal_tac "cos (pi + pi/2) = 0", simp)
  3735   apply (subst cos_add, simp)
  3736   done
  3737 
  3738 lemma sin_2npi [simp]: "sin (2 * real (n::nat) * pi) = 0"
  3739   by (auto simp: mult.assoc sin_double)
  3740 
  3741 lemma sin_3over2_pi [simp]: "sin (3/2*pi) = - 1"
  3742   apply (subgoal_tac "sin (pi + pi/2) = - 1", simp)
  3743   apply (subst sin_add, simp)
  3744   done
  3745 
  3746 lemma cos_pi_eq_zero [simp]: "cos (pi * real (Suc (2 * m)) / 2) = 0"
  3747 by (simp only: cos_add sin_add real_of_nat_Suc distrib_right distrib_left add_divide_distrib, auto)
  3748 
  3749 lemma DERIV_cos_add [simp]: "DERIV (\<lambda>x. cos (x + k)) xa :> - sin (xa + k)"
  3750   by (auto intro!: derivative_eq_intros)
  3751 
  3752 lemma sin_zero_norm_cos_one:
  3753   fixes x :: "'a::{real_normed_field,banach}"
  3754   assumes "sin x = 0" shows "norm (cos x) = 1"
  3755   using sin_cos_squared_add [of x, unfolded assms]
  3756   by (simp add: square_norm_one)
  3757 
  3758 lemma sin_zero_abs_cos_one: "sin x = 0 \<Longrightarrow> \<bar>cos x\<bar> = (1::real)"
  3759   using sin_zero_norm_cos_one by fastforce
  3760 
  3761 lemma cos_one_sin_zero:
  3762   fixes x :: "'a::{real_normed_field,banach}"
  3763   assumes "cos x = 1" shows "sin x = 0"
  3764   using sin_cos_squared_add [of x, unfolded assms]
  3765   by simp
  3766 
  3767 lemma sin_times_pi_eq_0: "sin(x * pi) = 0 \<longleftrightarrow> x \<in> Ints"
  3768   by (simp add: sin_zero_iff_int2) (metis Ints_cases Ints_real_of_int real_of_int_def)
  3769 
  3770 lemma cos_one_2pi: 
  3771     "cos(x) = 1 \<longleftrightarrow> (\<exists>n::nat. x = n * 2*pi) | (\<exists>n::nat. x = -(n * 2*pi))"
  3772     (is "?lhs = ?rhs")
  3773 proof
  3774   assume "cos(x) = 1"
  3775   then have "sin x = 0"
  3776     by (simp add: cos_one_sin_zero)
  3777   then show ?rhs
  3778   proof (simp only: sin_zero_iff, elim exE disjE conjE)
  3779     fix n::nat
  3780     assume n: "even n" "x = real n * (pi/2)"
  3781     then obtain m where m: "n = 2 * m"
  3782       using dvdE by blast
  3783     then have me: "even m" using \<open>?lhs\<close> n
  3784       by (auto simp: field_simps) (metis one_neq_neg_one  power_minus_odd power_one)
  3785     show ?rhs
  3786       using m me n
  3787       by (auto simp: field_simps elim!: evenE)
  3788   next    
  3789     fix n::nat
  3790     assume n: "even n" "x = - (real n * (pi/2))"
  3791     then obtain m where m: "n = 2 * m"
  3792       using dvdE by blast
  3793     then have me: "even m" using \<open>?lhs\<close> n
  3794       by (auto simp: field_simps) (metis one_neq_neg_one  power_minus_odd power_one)
  3795     show ?rhs
  3796       using m me n
  3797       by (auto simp: field_simps elim!: evenE)
  3798   qed
  3799 next
  3800   assume "?rhs"
  3801   then show "cos x = 1"
  3802     by (metis cos_2npi cos_minus mult.assoc mult.left_commute)
  3803 qed
  3804 
  3805 lemma cos_one_2pi_int: "cos(x) = 1 \<longleftrightarrow> (\<exists>n::int. x = n * 2*pi)"
  3806   apply auto  --\<open>FIXME simproc bug\<close>
  3807   apply (auto simp: cos_one_2pi)
  3808   apply (metis real_of_int_of_nat_eq)
  3809   apply (metis mult_minus_right real_of_int_minus real_of_int_of_nat_eq)
  3810   by (metis mult_minus_right of_int_of_nat real_of_int_def real_of_nat_def)
  3811 
  3812 lemma sin_cos_sqrt: "0 \<le> sin(x) \<Longrightarrow> (sin(x) = sqrt(1 - (cos(x) ^ 2)))"
  3813   using sin_squared_eq real_sqrt_unique by fastforce
  3814 
  3815 lemma sin_eq_0_pi: "-pi < x \<Longrightarrow> x < pi \<Longrightarrow> sin(x) = 0 \<Longrightarrow> x = 0"
  3816   by (metis sin_gt_zero sin_minus minus_less_iff neg_0_less_iff_less not_less_iff_gr_or_eq)
  3817 
  3818 lemma cos_treble_cos: 
  3819   fixes x :: "'a::{real_normed_field,banach}"
  3820   shows "cos(3 * x) = 4 * cos(x) ^ 3 - 3 * cos x"
  3821 proof -
  3822   have *: "(sin x * (sin x * 3)) = 3 - (cos x * (cos x * 3))"
  3823     by (simp add: mult.assoc [symmetric] sin_squared_eq [unfolded power2_eq_square])
  3824   have "cos(3 * x) = cos(2*x + x)"
  3825     by simp
  3826   also have "... = 4 * cos(x) ^ 3 - 3 * cos x"
  3827     apply (simp only: cos_add cos_double sin_double)
  3828     apply (simp add: * field_simps power2_eq_square power3_eq_cube)
  3829     done
  3830   finally show ?thesis .
  3831 qed
  3832 
  3833 lemma cos_45: "cos (pi / 4) = sqrt 2 / 2"
  3834 proof -
  3835   let ?c = "cos (pi / 4)" and ?s = "sin (pi / 4)"
  3836   have nonneg: "0 \<le> ?c"
  3837     by (simp add: cos_ge_zero)
  3838   have "0 = cos (pi / 4 + pi / 4)"
  3839     by simp
  3840   also have "cos (pi / 4 + pi / 4) = ?c\<^sup>2 - ?s\<^sup>2"
  3841     by (simp only: cos_add power2_eq_square)
  3842   also have "\<dots> = 2 * ?c\<^sup>2 - 1"
  3843     by (simp add: sin_squared_eq)
  3844   finally have "?c\<^sup>2 = (sqrt 2 / 2)\<^sup>2"
  3845     by (simp add: power_divide)
  3846   thus ?thesis
  3847     using nonneg by (rule power2_eq_imp_eq) simp
  3848 qed
  3849 
  3850 lemma cos_30: "cos (pi / 6) = sqrt 3/2"
  3851 proof -
  3852   let ?c = "cos (pi / 6)" and ?s = "sin (pi / 6)"
  3853   have pos_c: "0 < ?c"
  3854     by (rule cos_gt_zero, simp, simp)
  3855   have "0 = cos (pi / 6 + pi / 6 + pi / 6)"
  3856     by simp
  3857   also have "\<dots> = (?c * ?c - ?s * ?s) * ?c - (?s * ?c + ?c * ?s) * ?s"
  3858     by (simp only: cos_add sin_add)
  3859   also have "\<dots> = ?c * (?c\<^sup>2 - 3 * ?s\<^sup>2)"
  3860     by (simp add: algebra_simps power2_eq_square)
  3861   finally have "?c\<^sup>2 = (sqrt 3/2)\<^sup>2"
  3862     using pos_c by (simp add: sin_squared_eq power_divide)
  3863   thus ?thesis
  3864     using pos_c [THEN order_less_imp_le]
  3865     by (rule power2_eq_imp_eq) simp
  3866 qed
  3867 
  3868 lemma sin_45: "sin (pi / 4) = sqrt 2 / 2"
  3869   by (simp add: sin_cos_eq cos_45)
  3870 
  3871 lemma sin_60: "sin (pi / 3) = sqrt 3/2"
  3872   by (simp add: sin_cos_eq cos_30)
  3873 
  3874 lemma cos_60: "cos (pi / 3) = 1 / 2"
  3875   apply (rule power2_eq_imp_eq)
  3876   apply (simp add: cos_squared_eq sin_60 power_divide)
  3877   apply (rule cos_ge_zero, rule order_trans [where y=0], simp_all)
  3878   done
  3879 
  3880 lemma sin_30: "sin (pi / 6) = 1 / 2"
  3881   by (simp add: sin_cos_eq cos_60)
  3882 
  3883 lemma cos_integer_2pi: "n \<in> Ints \<Longrightarrow> cos(2*pi * n) = 1"
  3884   by (metis Ints_cases cos_one_2pi_int mult.assoc mult.commute real_of_int_def)
  3885 
  3886 lemma sin_integer_2pi: "n \<in> Ints \<Longrightarrow> sin(2*pi * n) = 0"
  3887   by (metis sin_two_pi Ints_mult mult.assoc mult.commute sin_times_pi_eq_0)
  3888 
  3889 lemma cos_int_2npi [simp]: "cos (2 * real (n::int) * pi) = 1"
  3890   by (simp add: cos_one_2pi_int)
  3891 
  3892 lemma sin_int_2npi [simp]: "sin (2 * real (n::int) * pi) = 0"
  3893   by (metis Ints_real_of_int mult.assoc mult.commute sin_integer_2pi)
  3894 
  3895 lemma sincos_principal_value: "\<exists>y. (-pi < y \<and> y \<le> pi) \<and> (sin(y) = sin(x) \<and> cos(y) = cos(x))"
  3896   apply (rule exI [where x="pi - (2*pi) * frac((pi - x) / (2*pi))"])
  3897   apply (auto simp: field_simps frac_lt_1)
  3898   apply (simp_all add: frac_def divide_simps)
  3899   apply (simp_all add: add_divide_distrib diff_divide_distrib)
  3900   apply (simp_all add: sin_diff cos_diff mult.assoc [symmetric] cos_integer_2pi sin_integer_2pi)
  3901   done
  3902 
  3903 
  3904 subsection \<open>Tangent\<close>
  3905 
  3906 definition tan :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  3907   where "tan = (\<lambda>x. sin x / cos x)"
  3908 
  3909 lemma tan_of_real:
  3910   "of_real (tan x) = (tan (of_real x) :: 'a::{real_normed_field,banach})"
  3911   by (simp add: tan_def sin_of_real cos_of_real)
  3912 
  3913 lemma tan_in_Reals [simp]:
  3914   fixes z :: "'a::{real_normed_field,banach}"
  3915   shows "z \<in> \<real> \<Longrightarrow> tan z \<in> \<real>"
  3916   by (simp add: tan_def)
  3917 
  3918 lemma tan_zero [simp]: "tan 0 = 0"
  3919   by (simp add: tan_def)
  3920 
  3921 lemma tan_pi [simp]: "tan pi = 0"
  3922   by (simp add: tan_def)
  3923 
  3924 lemma tan_npi [simp]: "tan (real (n::nat) * pi) = 0"
  3925   by (simp add: tan_def)
  3926 
  3927 lemma tan_minus [simp]: "tan (-x) = - tan x"
  3928   by (simp add: tan_def)
  3929 
  3930 lemma tan_periodic [simp]: "tan (x + 2*pi) = tan x"
  3931   by (simp add: tan_def)
  3932 
  3933 lemma lemma_tan_add1:
  3934   "\<lbrakk>cos x \<noteq> 0; cos y \<noteq> 0\<rbrakk> \<Longrightarrow> 1 - tan x * tan y = cos (x + y)/(cos x * cos y)"
  3935   by (simp add: tan_def cos_add field_simps)
  3936 
  3937 lemma add_tan_eq:
  3938   fixes x :: "'a::{real_normed_field,banach}"
  3939   shows "\<lbrakk>cos x \<noteq> 0; cos y \<noteq> 0\<rbrakk> \<Longrightarrow> tan x + tan y = sin(x + y)/(cos x * cos y)"
  3940   by (simp add: tan_def sin_add field_simps)
  3941 
  3942 lemma tan_add:
  3943   fixes x :: "'a::{real_normed_field,banach}"
  3944   shows
  3945      "\<lbrakk>cos x \<noteq> 0; cos y \<noteq> 0; cos (x + y) \<noteq> 0\<rbrakk>
  3946       \<Longrightarrow> tan(x + y) = (tan(x) + tan(y))/(1 - tan(x) * tan(y))"
  3947       by (simp add: add_tan_eq lemma_tan_add1 field_simps) (simp add: tan_def)
  3948 
  3949 lemma tan_double:
  3950   fixes x :: "'a::{real_normed_field,banach}"
  3951   shows
  3952      "\<lbrakk>cos x \<noteq> 0; cos (2 * x) \<noteq> 0\<rbrakk>
  3953       \<Longrightarrow> tan (2 * x) = (2 * tan x) / (1 - (tan x)\<^sup>2)"
  3954   using tan_add [of x x] by (simp add: power2_eq_square)
  3955 
  3956 lemma tan_gt_zero: "\<lbrakk>0 < x; x < pi/2\<rbrakk> \<Longrightarrow> 0 < tan x"
  3957   by (simp add: tan_def zero_less_divide_iff sin_gt_zero2 cos_gt_zero_pi)
  3958 
  3959 lemma tan_less_zero:
  3960   assumes lb: "- pi/2 < x" and "x < 0"
  3961   shows "tan x < 0"
  3962 proof -
  3963   have "0 < tan (- x)" using assms by (simp only: tan_gt_zero)
  3964   thus ?thesis by simp
  3965 qed
  3966 
  3967 lemma tan_half:
  3968   fixes x :: "'a::{real_normed_field,banach,field}"
  3969   shows  "tan x = sin (2 * x) / (cos (2 * x) + 1)"
  3970   unfolding tan_def sin_double cos_double sin_squared_eq
  3971   by (simp add: power2_eq_square)
  3972 
  3973 lemma tan_30: "tan (pi / 6) = 1 / sqrt 3"
  3974   unfolding tan_def by (simp add: sin_30 cos_30)
  3975 
  3976 lemma tan_45: "tan (pi / 4) = 1"
  3977   unfolding tan_def by (simp add: sin_45 cos_45)
  3978 
  3979 lemma tan_60: "tan (pi / 3) = sqrt 3"
  3980   unfolding tan_def by (simp add: sin_60 cos_60)
  3981 
  3982 lemma DERIV_tan [simp]:
  3983   fixes x :: "'a::{real_normed_field,banach}"
  3984   shows "cos x \<noteq> 0 \<Longrightarrow> DERIV tan x :> inverse ((cos x)\<^sup>2)"
  3985   unfolding tan_def
  3986   by (auto intro!: derivative_eq_intros, simp add: divide_inverse power2_eq_square)
  3987 
  3988 lemma isCont_tan:
  3989   fixes x :: "'a::{real_normed_field,banach}"
  3990   shows "cos x \<noteq> 0 \<Longrightarrow> isCont tan x"
  3991   by (rule DERIV_tan [THEN DERIV_isCont])
  3992 
  3993 lemma isCont_tan' [simp,continuous_intros]:
  3994   fixes a :: "'a::{real_normed_field,banach}" and f :: "'a \<Rightarrow> 'a"
  3995   shows "\<lbrakk>isCont f a; cos (f a) \<noteq> 0\<rbrakk> \<Longrightarrow> isCont (\<lambda>x. tan (f x)) a"
  3996   by (rule isCont_o2 [OF _ isCont_tan])
  3997 
  3998 lemma tendsto_tan [tendsto_intros]:
  3999   fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  4000   shows "\<lbrakk>(f ---> a) F; cos a \<noteq> 0\<rbrakk> \<Longrightarrow> ((\<lambda>x. tan (f x)) ---> tan a) F"
  4001   by (rule isCont_tendsto_compose [OF isCont_tan])
  4002 
  4003 lemma continuous_tan:
  4004   fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  4005   shows "continuous F f \<Longrightarrow> cos (f (Lim F (\<lambda>x. x))) \<noteq> 0 \<Longrightarrow> continuous F (\<lambda>x. tan (f x))"
  4006   unfolding continuous_def by (rule tendsto_tan)
  4007 
  4008 lemma continuous_on_tan [continuous_intros]:
  4009   fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  4010   shows "continuous_on s f \<Longrightarrow> (\<forall>x\<in>s. cos (f x) \<noteq> 0) \<Longrightarrow> continuous_on s (\<lambda>x. tan (f x))"
  4011   unfolding continuous_on_def by (auto intro: tendsto_tan)
  4012 
  4013 lemma continuous_within_tan [continuous_intros]:
  4014   fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  4015   shows
  4016   "continuous (at x within s) f \<Longrightarrow> cos (f x) \<noteq> 0 \<Longrightarrow> continuous (at x within s) (\<lambda>x. tan (f x))"
  4017   unfolding continuous_within by (rule tendsto_tan)
  4018 
  4019 lemma LIM_cos_div_sin: "(\<lambda>x. cos(x)/sin(x)) -- pi/2 --> 0"
  4020   by (rule LIM_cong_limit, (rule tendsto_intros)+, simp_all)
  4021 
  4022 lemma lemma_tan_total: "0 < y ==> \<exists>x. 0 < x & x < pi/2 & y < tan x"
  4023   apply (cut_tac LIM_cos_div_sin)
  4024   apply (simp only: LIM_eq)
  4025   apply (drule_tac x = "inverse y" in spec, safe, force)
  4026   apply (drule_tac ?d1.0 = s in pi_half_gt_zero [THEN [2] real_lbound_gt_zero], safe)
  4027   apply (rule_tac x = "(pi/2) - e" in exI)
  4028   apply (simp (no_asm_simp))
  4029   apply (drule_tac x = "(pi/2) - e" in spec)
  4030   apply (auto simp add: tan_def sin_diff cos_diff)
  4031   apply (rule inverse_less_iff_less [THEN iffD1])
  4032   apply (auto simp add: divide_inverse)
  4033   apply (rule mult_pos_pos)
  4034   apply (subgoal_tac [3] "0 < sin e & 0 < cos e")
  4035   apply (auto intro: cos_gt_zero sin_gt_zero2 simp add: mult.commute)
  4036   done
  4037 
  4038 lemma tan_total_pos: "0 \<le> y ==> \<exists>x. 0 \<le> x & x < pi/2 & tan x = y"
  4039   apply (frule order_le_imp_less_or_eq, safe)
  4040    prefer 2 apply force
  4041   apply (drule lemma_tan_total, safe)
  4042   apply (cut_tac f = tan and a = 0 and b = x and y = y in IVT_objl)
  4043   apply (auto intro!: DERIV_tan [THEN DERIV_isCont])
  4044   apply (drule_tac y = xa in order_le_imp_less_or_eq)
  4045   apply (auto dest: cos_gt_zero)
  4046   done
  4047 
  4048 lemma lemma_tan_total1: "\<exists>x. -(pi/2) < x & x < (pi/2) & tan x = y"
  4049   apply (cut_tac linorder_linear [of 0 y], safe)
  4050   apply (drule tan_total_pos)
  4051   apply (cut_tac [2] y="-y" in tan_total_pos, safe)
  4052   apply (rule_tac [3] x = "-x" in exI)
  4053   apply (auto del: exI intro!: exI)
  4054   done
  4055 
  4056 lemma tan_total: "EX! x. -(pi/2) < x & x < (pi/2) & tan x = y"
  4057   apply (cut_tac y = y in lemma_tan_total1, auto)
  4058   apply hypsubst_thin
  4059   apply (cut_tac x = xa and y = y in linorder_less_linear, auto)
  4060   apply (subgoal_tac [2] "\<exists>z. y < z & z < xa & DERIV tan z :> 0")
  4061   apply (subgoal_tac "\<exists>z. xa < z & z < y & DERIV tan z :> 0")
  4062   apply (rule_tac [4] Rolle)
  4063   apply (rule_tac [2] Rolle)
  4064   apply (auto del: exI intro!: DERIV_tan DERIV_isCont exI
  4065               simp add: real_differentiable_def)
  4066   txt\<open>Now, simulate TRYALL\<close>
  4067   apply (rule_tac [!] DERIV_tan asm_rl)
  4068   apply (auto dest!: DERIV_unique [OF _ DERIV_tan]
  4069               simp add: cos_gt_zero_pi [THEN less_imp_neq, THEN not_sym])
  4070   done
  4071 
  4072 lemma tan_monotone:
  4073   assumes "- (pi / 2) < y" and "y < x" and "x < pi / 2"
  4074   shows "tan y < tan x"
  4075 proof -
  4076   have "\<forall>x'. y \<le> x' \<and> x' \<le> x \<longrightarrow> DERIV tan x' :> inverse ((cos x')\<^sup>2)"
  4077   proof (rule allI, rule impI)
  4078     fix x' :: real
  4079     assume "y \<le> x' \<and> x' \<le> x"
  4080     hence "-(pi/2) < x'" and "x' < pi/2" using assms by auto
  4081     from cos_gt_zero_pi[OF this]
  4082     have "cos x' \<noteq> 0" by auto
  4083     thus "DERIV tan x' :> inverse ((cos x')\<^sup>2)" by (rule DERIV_tan)
  4084   qed
  4085   from MVT2[OF \<open>y < x\<close> this]
  4086   obtain z where "y < z" and "z < x"
  4087     and tan_diff: "tan x - tan y = (x - y) * inverse ((cos z)\<^sup>2)" by auto
  4088   hence "- (pi / 2) < z" and "z < pi / 2" using assms by auto
  4089   hence "0 < cos z" using cos_gt_zero_pi by auto
  4090   hence inv_pos: "0 < inverse ((cos z)\<^sup>2)" by auto
  4091   have "0 < x - y" using \<open>y < x\<close> by auto
  4092   with inv_pos have "0 < tan x - tan y" unfolding tan_diff by auto
  4093   thus ?thesis by auto
  4094 qed
  4095 
  4096 lemma tan_monotone':
  4097   assumes "- (pi / 2) < y"
  4098     and "y < pi / 2"
  4099     and "- (pi / 2) < x"
  4100     and "x < pi / 2"
  4101   shows "(y < x) = (tan y < tan x)"
  4102 proof
  4103   assume "y < x"
  4104   thus "tan y < tan x"
  4105     using tan_monotone and \<open>- (pi / 2) < y\<close> and \<open>x < pi / 2\<close> by auto
  4106 next
  4107   assume "tan y < tan x"
  4108   show "y < x"
  4109   proof (rule ccontr)
  4110     assume "\<not> y < x" hence "x \<le> y" by auto
  4111     hence "tan x \<le> tan y"
  4112     proof (cases "x = y")
  4113       case True thus ?thesis by auto
  4114     next
  4115       case False hence "x < y" using \<open>x \<le> y\<close> by auto
  4116       from tan_monotone[OF \<open>- (pi/2) < x\<close> this \<open>y < pi / 2\<close>] show ?thesis by auto
  4117     qed
  4118     thus False using \<open>tan y < tan x\<close> by auto
  4119   qed
  4120 qed
  4121 
  4122 lemma tan_inverse: "1 / (tan y) = tan (pi / 2 - y)"
  4123   unfolding tan_def sin_cos_eq[of y] cos_sin_eq[of y] by auto
  4124 
  4125 lemma tan_periodic_pi[simp]: "tan (x + pi) = tan x"
  4126   by (simp add: tan_def)
  4127 
  4128 lemma tan_periodic_nat[simp]:
  4129   fixes n :: nat
  4130   shows "tan (x + real n * pi) = tan x"
  4131 proof (induct n arbitrary: x)
  4132   case 0
  4133   then show ?case by simp
  4134 next
  4135   case (Suc n)
  4136   have split_pi_off: "x + real (Suc n) * pi = (x + real n * pi) + pi"
  4137     unfolding Suc_eq_plus1 real_of_nat_add real_of_one distrib_right by auto
  4138   show ?case unfolding split_pi_off using Suc by auto
  4139 qed
  4140 
  4141 lemma tan_periodic_int[simp]: fixes i :: int shows "tan (x + real i * pi) = tan x"
  4142 proof (cases "0 \<le> i")
  4143   case True
  4144   hence i_nat: "real i = real (nat i)" by auto
  4145   show ?thesis unfolding i_nat by auto
  4146 next
  4147   case False
  4148   hence i_nat: "real i = - real (nat (-i))" by auto
  4149   have "tan x = tan (x + real i * pi - real i * pi)"
  4150     by auto
  4151   also have "\<dots> = tan (x + real i * pi)"
  4152     unfolding i_nat mult_minus_left diff_minus_eq_add by (rule tan_periodic_nat)
  4153   finally show ?thesis by auto
  4154 qed
  4155 
  4156 lemma tan_periodic_n[simp]: "tan (x + numeral n * pi) = tan x"
  4157   using tan_periodic_int[of _ "numeral n" ] unfolding real_numeral .
  4158 
  4159 lemma tan_minus_45: "tan (-(pi/4)) = -1"
  4160   unfolding tan_def by (simp add: sin_45 cos_45)
  4161 
  4162 lemma tan_diff:
  4163   fixes x :: "'a::{real_normed_field,banach}"
  4164   shows
  4165      "\<lbrakk>cos x \<noteq> 0; cos y \<noteq> 0; cos (x - y) \<noteq> 0\<rbrakk>
  4166       \<Longrightarrow> tan(x - y) = (tan(x) - tan(y))/(1 + tan(x) * tan(y))"
  4167   using tan_add [of x "-y"]
  4168   by simp
  4169 
  4170 
  4171 lemma tan_pos_pi2_le: "0 \<le> x ==> x < pi/2 \<Longrightarrow> 0 \<le> tan x"
  4172   using less_eq_real_def tan_gt_zero by auto
  4173 
  4174 lemma cos_tan: "abs(x) < pi/2 \<Longrightarrow> cos(x) = 1 / sqrt(1 + tan(x) ^ 2)"
  4175   using cos_gt_zero_pi [of x]
  4176   by (simp add: divide_simps tan_def real_sqrt_divide abs_if split: split_if_asm)
  4177 
  4178 lemma sin_tan: "abs(x) < pi/2 \<Longrightarrow> sin(x) = tan(x) / sqrt(1 + tan(x) ^ 2)"
  4179   using cos_gt_zero [of "x"] cos_gt_zero [of "-x"]
  4180   by (force simp add: divide_simps tan_def real_sqrt_divide abs_if split: split_if_asm)
  4181 
  4182 lemma tan_mono_le: "-(pi/2) < x ==> x \<le> y ==> y < pi/2 \<Longrightarrow> tan(x) \<le> tan(y)"
  4183   using less_eq_real_def tan_monotone by auto
  4184 
  4185 lemma tan_mono_lt_eq: "-(pi/2) < x ==> x < pi/2 ==> -(pi/2) < y ==> y < pi/2
  4186          \<Longrightarrow> (tan(x) < tan(y) \<longleftrightarrow> x < y)"
  4187   using tan_monotone' by blast
  4188 
  4189 lemma tan_mono_le_eq: "-(pi/2) < x ==> x < pi/2 ==> -(pi/2) < y ==> y < pi/2
  4190          \<Longrightarrow> (tan(x) \<le> tan(y) \<longleftrightarrow> x \<le> y)"
  4191   by (meson tan_mono_le not_le tan_monotone)
  4192 
  4193 lemma tan_bound_pi2: "abs(x) < pi/4 \<Longrightarrow> abs(tan x) < 1"
  4194   using tan_45 tan_monotone [of x "pi/4"] tan_monotone [of "-x" "pi/4"]
  4195   by (auto simp: abs_if split: split_if_asm)
  4196 
  4197 lemma tan_cot: "tan(pi/2 - x) = inverse(tan x)"
  4198   by (simp add: tan_def sin_diff cos_diff)
  4199 
  4200 subsection \<open>Inverse Trigonometric Functions\<close>
  4201 
  4202 definition arcsin :: "real => real"
  4203   where "arcsin y = (THE x. -(pi/2) \<le> x & x \<le> pi/2 & sin x = y)"
  4204 
  4205 definition arccos :: "real => real"
  4206   where "arccos y = (THE x. 0 \<le> x & x \<le> pi & cos x = y)"
  4207 
  4208 definition arctan :: "real => real"
  4209   where "arctan y = (THE x. -(pi/2) < x & x < pi/2 & tan x = y)"
  4210 
  4211 lemma arcsin:
  4212   "-1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow>
  4213     -(pi/2) \<le> arcsin y & arcsin y \<le> pi/2 & sin(arcsin y) = y"
  4214   unfolding arcsin_def by (rule theI' [OF sin_total])
  4215 
  4216 lemma arcsin_pi:
  4217   "-1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> -(pi/2) \<le> arcsin y & arcsin y \<le> pi & sin(arcsin y) = y"
  4218   apply (drule (1) arcsin)
  4219   apply (force intro: order_trans)
  4220   done
  4221 
  4222 lemma sin_arcsin [simp]: "-1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> sin(arcsin y) = y"
  4223   by (blast dest: arcsin)
  4224 
  4225 lemma arcsin_bounded: "-1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> -(pi/2) \<le> arcsin y & arcsin y \<le> pi/2"
  4226   by (blast dest: arcsin)
  4227 
  4228 lemma arcsin_lbound: "-1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> -(pi/2) \<le> arcsin y"
  4229   by (blast dest: arcsin)
  4230 
  4231 lemma arcsin_ubound: "-1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> arcsin y \<le> pi/2"
  4232   by (blast dest: arcsin)
  4233 
  4234 lemma arcsin_lt_bounded:
  4235      "\<lbrakk>-1 < y; y < 1\<rbrakk> \<Longrightarrow> -(pi/2) < arcsin y & arcsin y < pi/2"
  4236   apply (frule order_less_imp_le)
  4237   apply (frule_tac y = y in order_less_imp_le)
  4238   apply (frule arcsin_bounded)
  4239   apply (safe, simp)
  4240   apply (drule_tac y = "arcsin y" in order_le_imp_less_or_eq)
  4241   apply (drule_tac [2] y = "pi/2" in order_le_imp_less_or_eq, safe)
  4242   apply (drule_tac [!] f = sin in arg_cong, auto)
  4243   done
  4244 
  4245 lemma arcsin_sin: "\<lbrakk>-(pi/2) \<le> x; x \<le> pi/2\<rbrakk> \<Longrightarrow> arcsin(sin x) = x"
  4246   apply (unfold arcsin_def)
  4247   apply (rule the1_equality)
  4248   apply (rule sin_total, auto)
  4249   done
  4250 
  4251 lemma arcsin_0 [simp]: "arcsin 0 = 0"
  4252   using arcsin_sin [of 0]
  4253   by simp
  4254 
  4255 lemma arcsin_1 [simp]: "arcsin 1 = pi/2"
  4256   using arcsin_sin [of "pi/2"]
  4257   by simp
  4258 
  4259 lemma arcsin_minus_1 [simp]: "arcsin (-1) = - (pi/2)"
  4260   using arcsin_sin [of "-pi/2"]
  4261   by simp
  4262 
  4263 lemma arcsin_minus: "-1 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> arcsin(-x) = -arcsin x"
  4264   by (metis (no_types, hide_lams) arcsin arcsin_sin minus_minus neg_le_iff_le sin_minus)
  4265 
  4266 lemma arcsin_eq_iff: "abs x \<le> 1 \<Longrightarrow> abs y \<le> 1 \<Longrightarrow> (arcsin x = arcsin y \<longleftrightarrow> x = y)"
  4267   by (metis abs_le_interval_iff arcsin)
  4268 
  4269 lemma cos_arcsin_nonzero: "-1 < x \<Longrightarrow> x < 1 \<Longrightarrow> cos(arcsin x) \<noteq> 0"
  4270   using arcsin_lt_bounded cos_gt_zero_pi by force
  4271 
  4272 lemma arccos:
  4273      "\<lbrakk>-1 \<le> y; y \<le> 1\<rbrakk>
  4274       \<Longrightarrow> 0 \<le> arccos y & arccos y \<le> pi & cos(arccos y) = y"
  4275   unfolding arccos_def by (rule theI' [OF cos_total])
  4276 
  4277 lemma cos_arccos [simp]: "\<lbrakk>-1 \<le> y; y \<le> 1\<rbrakk> \<Longrightarrow> cos(arccos y) = y"
  4278   by (blast dest: arccos)
  4279 
  4280 lemma arccos_bounded: "\<lbrakk>-1 \<le> y; y \<le> 1\<rbrakk> \<Longrightarrow> 0 \<le> arccos y & arccos y \<le> pi"
  4281   by (blast dest: arccos)
  4282 
  4283 lemma arccos_lbound: "\<lbrakk>-1 \<le> y; y \<le> 1\<rbrakk> \<Longrightarrow> 0 \<le> arccos y"
  4284   by (blast dest: arccos)
  4285 
  4286 lemma arccos_ubound: "\<lbrakk>-1 \<le> y; y \<le> 1\<rbrakk> \<Longrightarrow> arccos y \<le> pi"
  4287   by (blast dest: arccos)
  4288 
  4289 lemma arccos_lt_bounded:
  4290      "\<lbrakk>-1 < y; y < 1\<rbrakk> \<Longrightarrow> 0 < arccos y & arccos y < pi"
  4291   apply (frule order_less_imp_le)
  4292   apply (frule_tac y = y in order_less_imp_le)
  4293   apply (frule arccos_bounded, auto)
  4294   apply (drule_tac y = "arccos y" in order_le_imp_less_or_eq)
  4295   apply (drule_tac [2] y = pi in order_le_imp_less_or_eq, auto)
  4296   apply (drule_tac [!] f = cos in arg_cong, auto)
  4297   done
  4298 
  4299 lemma arccos_cos: "\<lbrakk>0 \<le> x; x \<le> pi\<rbrakk> \<Longrightarrow> arccos(cos x) = x"
  4300   apply (simp add: arccos_def)
  4301   apply (auto intro!: the1_equality cos_total)
  4302   done
  4303 
  4304 lemma arccos_cos2: "\<lbrakk>x \<le> 0; -pi \<le> x\<rbrakk> \<Longrightarrow> arccos(cos x) = -x"
  4305   apply (simp add: arccos_def)
  4306   apply (auto intro!: the1_equality cos_total)
  4307   done
  4308 
  4309 lemma cos_arcsin: "\<lbrakk>-1 \<le> x; x \<le> 1\<rbrakk> \<Longrightarrow> cos (arcsin x) = sqrt (1 - x\<^sup>2)"
  4310   apply (subgoal_tac "x\<^sup>2 \<le> 1")
  4311   apply (rule power2_eq_imp_eq)
  4312   apply (simp add: cos_squared_eq)
  4313   apply (rule cos_ge_zero)
  4314   apply (erule (1) arcsin_lbound)
  4315   apply (erule (1) arcsin_ubound)
  4316   apply simp
  4317   apply (subgoal_tac "\<bar>x\<bar>\<^sup>2 \<le> 1\<^sup>2", simp)
  4318   apply (rule power_mono, simp, simp)
  4319   done
  4320 
  4321 lemma sin_arccos: "\<lbrakk>-1 \<le> x; x \<le> 1\<rbrakk> \<Longrightarrow> sin (arccos x) = sqrt (1 - x\<^sup>2)"
  4322   apply (subgoal_tac "x\<^sup>2 \<le> 1")
  4323   apply (rule power2_eq_imp_eq)
  4324   apply (simp add: sin_squared_eq)
  4325   apply (rule sin_ge_zero)
  4326   apply (erule (1) arccos_lbound)
  4327   apply (erule (1) arccos_ubound)
  4328   apply simp
  4329   apply (subgoal_tac "\<bar>x\<bar>\<^sup>2 \<le> 1\<^sup>2", simp)
  4330   apply (rule power_mono, simp, simp)
  4331   done
  4332 
  4333 lemma arccos_0 [simp]: "arccos 0 = pi/2"
  4334 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)
  4335 
  4336 lemma arccos_1 [simp]: "arccos 1 = 0"
  4337   using arccos_cos by force
  4338 
  4339 lemma arccos_minus_1 [simp]: "arccos(-1) = pi"
  4340   by (metis arccos_cos cos_pi order_refl pi_ge_zero)
  4341 
  4342 lemma arccos_minus: "-1 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> arccos(-x) = pi - arccos x"
  4343   by (metis arccos_cos arccos_cos2 cos_minus_pi cos_total diff_le_0_iff_le le_add_same_cancel1 
  4344     minus_diff_eq uminus_add_conv_diff)
  4345 
  4346 lemma sin_arccos_nonzero: "-1 < x \<Longrightarrow> x < 1 \<Longrightarrow> ~(sin(arccos x) = 0)"
  4347   using arccos_lt_bounded sin_gt_zero by force
  4348 
  4349 lemma arctan: "- (pi/2) < arctan y  & arctan y < pi/2 & tan (arctan y) = y"
  4350   unfolding arctan_def by (rule theI' [OF tan_total])
  4351 
  4352 lemma tan_arctan: "tan (arctan y) = y"
  4353   by (simp add: arctan)
  4354 
  4355 lemma arctan_bounded: "- (pi/2) < arctan y  & arctan y < pi/2"
  4356   by (auto simp only: arctan)
  4357 
  4358 lemma arctan_lbound: "- (pi/2) < arctan y"
  4359   by (simp add: arctan)
  4360 
  4361 lemma arctan_ubound: "arctan y < pi/2"
  4362   by (auto simp only: arctan)
  4363 
  4364 lemma arctan_unique:
  4365   assumes "-(pi/2) < x"
  4366     and "x < pi/2"
  4367     and "tan x = y"
  4368   shows "arctan y = x"
  4369   using assms arctan [of y] tan_total [of y] by (fast elim: ex1E)
  4370 
  4371 lemma arctan_tan: "-(pi/2) < x \<Longrightarrow> x < pi/2 \<Longrightarrow> arctan (tan x) = x"
  4372   by (rule arctan_unique) simp_all
  4373 
  4374 lemma arctan_zero_zero [simp]: "arctan 0 = 0"
  4375   by (rule arctan_unique) simp_all
  4376 
  4377 lemma arctan_minus: "arctan (- x) = - arctan x"
  4378   apply (rule arctan_unique)
  4379   apply (simp only: neg_less_iff_less arctan_ubound)
  4380   apply (metis minus_less_iff arctan_lbound, simp add: arctan)
  4381   done
  4382 
  4383 lemma cos_arctan_not_zero [simp]: "cos (arctan x) \<noteq> 0"
  4384   by (intro less_imp_neq [symmetric] cos_gt_zero_pi
  4385     arctan_lbound arctan_ubound)
  4386 
  4387 lemma cos_arctan: "cos (arctan x) = 1 / sqrt (1 + x\<^sup>2)"
  4388 proof (rule power2_eq_imp_eq)
  4389   have "0 < 1 + x\<^sup>2" by (simp add: add_pos_nonneg)
  4390   show "0 \<le> 1 / sqrt (1 + x\<^sup>2)" by simp
  4391   show "0 \<le> cos (arctan x)"
  4392     by (intro less_imp_le cos_gt_zero_pi arctan_lbound arctan_ubound)
  4393   have "(cos (arctan x))\<^sup>2 * (1 + (tan (arctan x))\<^sup>2) = 1"
  4394     unfolding tan_def by (simp add: distrib_left power_divide)
  4395   thus "(cos (arctan x))\<^sup>2 = (1 / sqrt (1 + x\<^sup>2))\<^sup>2"
  4396     using \<open>0 < 1 + x\<^sup>2\<close> by (simp add: arctan power_divide eq_divide_eq)
  4397 qed
  4398 
  4399 lemma sin_arctan: "sin (arctan x) = x / sqrt (1 + x\<^sup>2)"
  4400   using add_pos_nonneg [OF zero_less_one zero_le_power2 [of x]]
  4401   using tan_arctan [of x] unfolding tan_def cos_arctan
  4402   by (simp add: eq_divide_eq)
  4403 
  4404 lemma tan_sec:
  4405   fixes x :: "'a::{real_normed_field,banach,field}"
  4406   shows "cos x \<noteq> 0 \<Longrightarrow> 1 + (tan x)\<^sup>2 = (inverse (cos x))\<^sup>2"
  4407   apply (rule power_inverse [THEN subst])
  4408   apply (rule_tac c1 = "(cos x)\<^sup>2" in mult_right_cancel [THEN iffD1])
  4409   apply (auto dest: field_power_not_zero
  4410           simp add: power_mult_distrib distrib_right power_divide tan_def
  4411                     mult.assoc power_inverse [symmetric])
  4412   done
  4413 
  4414 lemma arctan_less_iff: "arctan x < arctan y \<longleftrightarrow> x < y"
  4415   by (metis tan_monotone' arctan_lbound arctan_ubound tan_arctan)
  4416 
  4417 lemma arctan_le_iff: "arctan x \<le> arctan y \<longleftrightarrow> x \<le> y"
  4418   by (simp only: not_less [symmetric] arctan_less_iff)
  4419 
  4420 lemma arctan_eq_iff: "arctan x = arctan y \<longleftrightarrow> x = y"
  4421   by (simp only: eq_iff [where 'a=real] arctan_le_iff)
  4422 
  4423 lemma zero_less_arctan_iff [simp]: "0 < arctan x \<longleftrightarrow> 0 < x"
  4424   using arctan_less_iff [of 0 x] by simp
  4425 
  4426 lemma arctan_less_zero_iff [simp]: "arctan x < 0 \<longleftrightarrow> x < 0"
  4427   using arctan_less_iff [of x 0] by simp
  4428 
  4429 lemma zero_le_arctan_iff [simp]: "0 \<le> arctan x \<longleftrightarrow> 0 \<le> x"
  4430   using arctan_le_iff [of 0 x] by simp
  4431 
  4432 lemma arctan_le_zero_iff [simp]: "arctan x \<le> 0 \<longleftrightarrow> x \<le> 0"
  4433   using arctan_le_iff [of x 0] by simp
  4434 
  4435 lemma arctan_eq_zero_iff [simp]: "arctan x = 0 \<longleftrightarrow> x = 0"
  4436   using arctan_eq_iff [of x 0] by simp
  4437 
  4438 lemma continuous_on_arcsin': "continuous_on {-1 .. 1} arcsin"
  4439 proof -
  4440   have "continuous_on (sin ` {- pi / 2 .. pi / 2}) arcsin"
  4441     by (rule continuous_on_inv) (auto intro: continuous_intros simp: arcsin_sin)
  4442   also have "sin ` {- pi / 2 .. pi / 2} = {-1 .. 1}"
  4443   proof safe
  4444     fix x :: real
  4445     assume "x \<in> {-1..1}"
  4446     then show "x \<in> sin ` {- pi / 2..pi / 2}"
  4447       using arcsin_lbound arcsin_ubound
  4448       by (intro image_eqI[where x="arcsin x"]) auto
  4449   qed simp
  4450   finally show ?thesis .
  4451 qed
  4452 
  4453 lemma continuous_on_arcsin [continuous_intros]:
  4454   "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))"
  4455   using continuous_on_compose[of s f, OF _ continuous_on_subset[OF  continuous_on_arcsin']]
  4456   by (auto simp: comp_def subset_eq)
  4457 
  4458 lemma isCont_arcsin: "-1 < x \<Longrightarrow> x < 1 \<Longrightarrow> isCont arcsin x"
  4459   using continuous_on_arcsin'[THEN continuous_on_subset, of "{ -1 <..< 1 }"]
  4460   by (auto simp: continuous_on_eq_continuous_at subset_eq)
  4461 
  4462 lemma continuous_on_arccos': "continuous_on {-1 .. 1} arccos"
  4463 proof -
  4464   have "continuous_on (cos ` {0 .. pi}) arccos"
  4465     by (rule continuous_on_inv) (auto intro: continuous_intros simp: arccos_cos)
  4466   also have "cos ` {0 .. pi} = {-1 .. 1}"
  4467   proof safe
  4468     fix x :: real
  4469     assume "x \<in> {-1..1}"
  4470     then show "x \<in> cos ` {0..pi}"
  4471       using arccos_lbound arccos_ubound
  4472       by (intro image_eqI[where x="arccos x"]) auto
  4473   qed simp
  4474   finally show ?thesis .
  4475 qed
  4476 
  4477 lemma continuous_on_arccos [continuous_intros]:
  4478   "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))"
  4479   using continuous_on_compose[of s f, OF _ continuous_on_subset[OF  continuous_on_arccos']]
  4480   by (auto simp: comp_def subset_eq)
  4481 
  4482 lemma isCont_arccos: "-1 < x \<Longrightarrow> x < 1 \<Longrightarrow> isCont arccos x"
  4483   using continuous_on_arccos'[THEN continuous_on_subset, of "{ -1 <..< 1 }"]
  4484   by (auto simp: continuous_on_eq_continuous_at subset_eq)
  4485 
  4486 lemma isCont_arctan: "isCont arctan x"
  4487   apply (rule arctan_lbound [of x, THEN dense, THEN exE], clarify)
  4488   apply (rule arctan_ubound [of x, THEN dense, THEN exE], clarify)
  4489   apply (subgoal_tac "isCont arctan (tan (arctan x))", simp add: arctan)
  4490   apply (erule (1) isCont_inverse_function2 [where f=tan])
  4491   apply (metis arctan_tan order_le_less_trans order_less_le_trans)
  4492   apply (metis cos_gt_zero_pi isCont_tan order_less_le_trans less_le)
  4493   done
  4494 
  4495 lemma tendsto_arctan [tendsto_intros]: "(f ---> x) F \<Longrightarrow> ((\<lambda>x. arctan (f x)) ---> arctan x) F"
  4496   by (rule isCont_tendsto_compose [OF isCont_arctan])
  4497 
  4498 lemma continuous_arctan [continuous_intros]: "continuous F f \<Longrightarrow> continuous F (\<lambda>x. arctan (f x))"
  4499   unfolding continuous_def by (rule tendsto_arctan)
  4500 
  4501 lemma continuous_on_arctan [continuous_intros]: "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. arctan (f x))"
  4502   unfolding continuous_on_def by (auto intro: tendsto_arctan)
  4503 
  4504 lemma DERIV_arcsin:
  4505   "\<lbrakk>-1 < x; x < 1\<rbrakk> \<Longrightarrow> DERIV arcsin x :> inverse (sqrt (1 - x\<^sup>2))"
  4506   apply (rule DERIV_inverse_function [where f=sin and a="-1" and b=1])
  4507   apply (rule DERIV_cong [OF DERIV_sin])
  4508   apply (simp add: cos_arcsin)
  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_arcsin)
  4513   done
  4514 
  4515 lemma DERIV_arccos:
  4516   "\<lbrakk>-1 < x; x < 1\<rbrakk> \<Longrightarrow> DERIV arccos x :> inverse (- sqrt (1 - x\<^sup>2))"
  4517   apply (rule DERIV_inverse_function [where f=cos and a="-1" and b=1])
  4518   apply (rule DERIV_cong [OF DERIV_cos])
  4519   apply (simp add: sin_arccos)
  4520   apply (subgoal_tac "\<bar>x\<bar>\<^sup>2 < 1\<^sup>2", simp)
  4521   apply (rule power_strict_mono, simp, simp, simp, assumption, assumption)
  4522   apply simp
  4523   apply (erule (1) isCont_arccos)
  4524   done
  4525 
  4526 lemma DERIV_arctan: "DERIV arctan x :> inverse (1 + x\<^sup>2)"
  4527   apply (rule DERIV_inverse_function [where f=tan and a="x - 1" and b="x + 1"])
  4528   apply (rule DERIV_cong [OF DERIV_tan])
  4529   apply (rule cos_arctan_not_zero)
  4530   apply (simp add: arctan power_inverse tan_sec [symmetric])
  4531   apply (subgoal_tac "0 < 1 + x\<^sup>2", simp)
  4532   apply (simp_all add: add_pos_nonneg arctan isCont_arctan)
  4533   done
  4534 
  4535 declare
  4536   DERIV_arcsin[THEN DERIV_chain2, derivative_intros]
  4537   DERIV_arccos[THEN DERIV_chain2, derivative_intros]
  4538   DERIV_arctan[THEN DERIV_chain2, derivative_intros]
  4539 
  4540 lemma filterlim_tan_at_right: "filterlim tan at_bot (at_right (- pi/2))"
  4541   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])
  4542      (auto simp: arctan le_less eventually_at dist_real_def simp del: less_divide_eq_numeral1
  4543            intro!: tan_monotone exI[of _ "pi/2"])
  4544 
  4545 lemma filterlim_tan_at_left: "filterlim tan at_top (at_left (pi/2))"
  4546   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])
  4547      (auto simp: arctan le_less eventually_at dist_real_def simp del: less_divide_eq_numeral1
  4548            intro!: tan_monotone exI[of _ "pi/2"])
  4549 
  4550 lemma tendsto_arctan_at_top: "(arctan ---> (pi/2)) at_top"
  4551 proof (rule tendstoI)
  4552   fix e :: real
  4553   assume "0 < e"
  4554   def y \<equiv> "pi/2 - min (pi/2) e"
  4555   then have y: "0 \<le> y" "y < pi/2" "pi/2 \<le> e + y"
  4556     using \<open>0 < e\<close> by auto
  4557 
  4558   show "eventually (\<lambda>x. dist (arctan x) (pi / 2) < e) at_top"
  4559   proof (intro eventually_at_top_dense[THEN iffD2] exI allI impI)
  4560     fix x
  4561     assume "tan y < x"
  4562     then have "arctan (tan y) < arctan x"
  4563       by (simp add: arctan_less_iff)
  4564     with y have "y < arctan x"
  4565       by (subst (asm) arctan_tan) simp_all
  4566     with arctan_ubound[of x, arith] y \<open>0 < e\<close>
  4567     show "dist (arctan x) (pi / 2) < e"
  4568       by (simp add: dist_real_def)
  4569   qed
  4570 qed
  4571 
  4572 lemma tendsto_arctan_at_bot: "(arctan ---> - (pi/2)) at_bot"
  4573   unfolding filterlim_at_bot_mirror arctan_minus
  4574   by (intro tendsto_minus tendsto_arctan_at_top)
  4575 
  4576 
  4577 subsection\<open>Prove Totality of the Trigonometric Functions\<close>
  4578 
  4579 lemma cos_arccos_abs: "\<bar>y\<bar> \<le> 1 \<Longrightarrow> cos (arccos y) = y"
  4580   by (simp add: abs_le_iff)
  4581 
  4582 lemma sin_arccos_abs: "\<bar>y\<bar> \<le> 1 \<Longrightarrow> sin (arccos y) = sqrt (1 - y\<^sup>2)"
  4583   by (simp add: sin_arccos abs_le_iff)
  4584 
  4585 lemma sin_mono_less_eq: "\<lbrakk>-(pi/2) \<le> x; x \<le> pi/2; -(pi/2) \<le> y; y \<le> pi/2\<rbrakk>
  4586          \<Longrightarrow> (sin(x) < sin(y) \<longleftrightarrow> x < y)"
  4587 by (metis not_less_iff_gr_or_eq sin_monotone_2pi)
  4588 
  4589 lemma sin_mono_le_eq: "\<lbrakk>-(pi/2) \<le> x; x \<le> pi/2; -(pi/2) \<le> y; y \<le> pi/2\<rbrakk>
  4590          \<Longrightarrow> (sin(x) \<le> sin(y) \<longleftrightarrow> x \<le> y)"
  4591 by (meson leD le_less_linear sin_monotone_2pi sin_monotone_2pi_le)
  4592 
  4593 lemma sin_inj_pi: 
  4594     "\<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"
  4595 by (metis arcsin_sin)
  4596 
  4597 lemma cos_mono_less_eq:
  4598     "0 \<le> x ==> x \<le> pi ==> 0 \<le> y ==> y \<le> pi \<Longrightarrow> (cos(x) < cos(y) \<longleftrightarrow> y < x)"
  4599 by (meson cos_monotone_0_pi cos_monotone_0_pi_le leD le_less_linear)
  4600 
  4601 lemma cos_mono_le_eq: "0 \<le> x ==> x \<le> pi ==> 0 \<le> y ==> y \<le> pi
  4602          \<Longrightarrow> (cos(x) \<le> cos(y) \<longleftrightarrow> y \<le> x)"
  4603   by (metis arccos_cos cos_monotone_0_pi_le eq_iff linear)
  4604 
  4605 lemma cos_inj_pi: "0 \<le> x ==> x \<le> pi ==> 0 \<le> y ==> y \<le> pi ==> cos(x) = cos(y)
  4606          \<Longrightarrow> x = y"
  4607 by (metis arccos_cos)
  4608 
  4609 lemma arccos_le_pi2: "\<lbrakk>0 \<le> y; y \<le> 1\<rbrakk> \<Longrightarrow> arccos y \<le> pi/2"
  4610   by (metis (mono_tags) arccos_0 arccos cos_le_one cos_monotone_0_pi_le
  4611       cos_pi cos_pi_half pi_half_ge_zero antisym_conv less_eq_neg_nonpos linear minus_minus order.trans order_refl)
  4612 
  4613 lemma sincos_total_pi_half:
  4614   assumes "0 \<le> x" "0 \<le> y" "x\<^sup>2 + y\<^sup>2 = 1"
  4615     shows "\<exists>t. 0 \<le> t \<and> t \<le> pi/2 \<and> x = cos t \<and> y = sin t"
  4616 proof -
  4617   have x1: "x \<le> 1"
  4618     using assms
  4619     by (metis le_add_same_cancel1 power2_le_imp_le power_one zero_le_power2) 
  4620   moreover with assms have ax: "0 \<le> arccos x" "cos(arccos x) = x"
  4621     by (auto simp: arccos)
  4622   moreover have "y = sqrt (1 - x\<^sup>2)" using assms
  4623     by (metis abs_of_nonneg add.commute add_diff_cancel real_sqrt_abs)
  4624   ultimately show ?thesis using assms arccos_le_pi2 [of x] 
  4625     by (rule_tac x="arccos x" in exI) (auto simp: sin_arccos)
  4626 qed    
  4627 
  4628 lemma sincos_total_pi:
  4629   assumes "0 \<le> y" and "x\<^sup>2 + y\<^sup>2 = 1"
  4630     shows "\<exists>t. 0 \<le> t \<and> t \<le> pi \<and> x = cos t \<and> y = sin t"
  4631 proof (cases rule: le_cases [of 0 x])
  4632   case le from sincos_total_pi_half [OF le]  
  4633   show ?thesis
  4634     by (metis pi_ge_two pi_half_le_two add.commute add_le_cancel_left add_mono assms)
  4635 next
  4636   case ge 
  4637   then have "0 \<le> -x"
  4638     by simp
  4639   then obtain t where "t\<ge>0" "t \<le> pi/2" "-x = cos t" "y = sin t"
  4640     using sincos_total_pi_half assms
  4641     apply auto
  4642     by (metis \<open>0 \<le> - x\<close> power2_minus)
  4643   then show ?thesis
  4644     by (rule_tac x="pi-t" in exI, auto)
  4645 qed    
  4646     
  4647 lemma sincos_total_2pi_le:
  4648   assumes "x\<^sup>2 + y\<^sup>2 = 1"
  4649     shows "\<exists>t. 0 \<le> t \<and> t \<le> 2*pi \<and> x = cos t \<and> y = sin t"
  4650 proof (cases rule: le_cases [of 0 y])
  4651   case le from sincos_total_pi [OF le]  
  4652   show ?thesis
  4653     by (metis assms le_add_same_cancel1 mult.commute mult_2_right order.trans)
  4654 next
  4655   case ge 
  4656   then have "0 \<le> -y"
  4657     by simp
  4658   then obtain t where "t\<ge>0" "t \<le> pi" "x = cos t" "-y = sin t"
  4659     using sincos_total_pi assms
  4660     apply auto
  4661     by (metis \<open>0 \<le> - y\<close> power2_minus)
  4662   then show ?thesis
  4663     by (rule_tac x="2*pi-t" in exI, auto)
  4664 qed    
  4665 
  4666 lemma sincos_total_2pi:
  4667   assumes "x\<^sup>2 + y\<^sup>2 = 1"
  4668     obtains t where "0 \<le> t" "t < 2*pi" "x = cos t" "y = sin t"
  4669 proof -
  4670   from sincos_total_2pi_le [OF assms]
  4671   obtain t where t: "0 \<le> t" "t \<le> 2*pi" "x = cos t" "y = sin t"
  4672     by blast
  4673   show ?thesis
  4674     apply (cases "t = 2*pi")
  4675     using t that
  4676     apply force+
  4677     done
  4678 qed
  4679 
  4680 lemma arcsin_less_mono: "abs x \<le> 1 \<Longrightarrow> abs y \<le> 1 \<Longrightarrow> arcsin x < arcsin y \<longleftrightarrow> x < y"
  4681   apply (rule trans [OF sin_mono_less_eq [symmetric]])
  4682   using arcsin_ubound arcsin_lbound
  4683   apply auto
  4684   done
  4685 
  4686 lemma arcsin_le_mono: "abs x \<le> 1 \<Longrightarrow> abs y \<le> 1 \<Longrightarrow> arcsin x \<le> arcsin y \<longleftrightarrow> x \<le> y"
  4687   using arcsin_less_mono not_le by blast
  4688 
  4689 lemma arcsin_less_arcsin: "-1 \<le> x \<Longrightarrow> x < y \<Longrightarrow> y \<le> 1 \<Longrightarrow> arcsin x < arcsin y"
  4690   using arcsin_less_mono by auto
  4691 
  4692 lemma arcsin_le_arcsin: "-1 \<le> x \<Longrightarrow> x \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> arcsin x \<le> arcsin y"
  4693   using arcsin_le_mono by auto
  4694 
  4695 lemma arccos_less_mono: "abs x \<le> 1 \<Longrightarrow> abs y \<le> 1 \<Longrightarrow> (arccos x < arccos y \<longleftrightarrow> y < x)"
  4696   apply (rule trans [OF cos_mono_less_eq [symmetric]])
  4697   using arccos_ubound arccos_lbound
  4698   apply auto
  4699   done
  4700 
  4701 lemma arccos_le_mono: "abs x \<le> 1 \<Longrightarrow> abs y \<le> 1 \<Longrightarrow> arccos x \<le> arccos y \<longleftrightarrow> y \<le> x"
  4702   using arccos_less_mono [of y x] 
  4703   by (simp add: not_le [symmetric])
  4704 
  4705 lemma arccos_less_arccos: "-1 \<le> x \<Longrightarrow> x < y \<Longrightarrow> y \<le> 1 \<Longrightarrow> arccos y < arccos x"
  4706   using arccos_less_mono by auto
  4707 
  4708 lemma arccos_le_arccos: "-1 \<le> x \<Longrightarrow> x \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> arccos y \<le> arccos x"
  4709   using arccos_le_mono by auto
  4710 
  4711 lemma arccos_eq_iff: "abs x \<le> 1 & abs y \<le> 1 \<Longrightarrow> (arccos x = arccos y \<longleftrightarrow> x = y)"
  4712   using cos_arccos_abs by fastforce
  4713 
  4714 subsection \<open>Machins formula\<close>
  4715 
  4716 lemma arctan_one: "arctan 1 = pi / 4"
  4717   by (rule arctan_unique, simp_all add: tan_45 m2pi_less_pi)
  4718 
  4719 lemma tan_total_pi4:
  4720   assumes "\<bar>x\<bar> < 1"
  4721   shows "\<exists>z. - (pi / 4) < z \<and> z < pi / 4 \<and> tan z = x"
  4722 proof
  4723   show "- (pi / 4) < arctan x \<and> arctan x < pi / 4 \<and> tan (arctan x) = x"
  4724     unfolding arctan_one [symmetric] arctan_minus [symmetric]
  4725     unfolding arctan_less_iff using assms  by (auto simp add: arctan)
  4726 
  4727 qed
  4728 
  4729 lemma arctan_add:
  4730   assumes "\<bar>x\<bar> \<le> 1" and "\<bar>y\<bar> < 1"
  4731   shows "arctan x + arctan y = arctan ((x + y) / (1 - x * y))"
  4732 proof (rule arctan_unique [symmetric])
  4733   have "- (pi / 4) \<le> arctan x" and "- (pi / 4) < arctan y"
  4734     unfolding arctan_one [symmetric] arctan_minus [symmetric]
  4735     unfolding arctan_le_iff arctan_less_iff using assms by auto
  4736   from add_le_less_mono [OF this]
  4737   show 1: "- (pi / 2) < arctan x + arctan y" by simp
  4738   have "arctan x \<le> pi / 4" and "arctan y < pi / 4"
  4739     unfolding arctan_one [symmetric]
  4740     unfolding arctan_le_iff arctan_less_iff using assms by auto
  4741   from add_le_less_mono [OF this]
  4742   show 2: "arctan x + arctan y < pi / 2" by simp
  4743   show "tan (arctan x + arctan y) = (x + y) / (1 - x * y)"
  4744     using cos_gt_zero_pi [OF 1 2] by (simp add: arctan tan_add)
  4745 qed
  4746 
  4747 lemma arctan_double:
  4748   assumes "\<bar>x\<bar> < 1"
  4749   shows "2 * arctan x = arctan ((2*x) / (1 - x\<^sup>2))"
  4750   by (metis assms arctan_add linear mult_2 not_less power2_eq_square)
  4751 
  4752 theorem machin: "pi / 4 = 4 * arctan (1/5) - arctan (1 / 239)"
  4753 proof -
  4754   have "\<bar>1 / 5\<bar> < (1 :: real)" by auto
  4755   from arctan_add[OF less_imp_le[OF this] this]
  4756   have "2 * arctan (1 / 5) = arctan (5 / 12)" by auto
  4757   moreover
  4758   have "\<bar>5 / 12\<bar> < (1 :: real)" by auto
  4759   from arctan_add[OF less_imp_le[OF this] this]
  4760   have "2 * arctan (5 / 12) = arctan (120 / 119)" by auto
  4761   moreover
  4762   have "\<bar>1\<bar> \<le> (1::real)" and "\<bar>1 / 239\<bar> < (1::real)" by auto
  4763   from arctan_add[OF this]
  4764   have "arctan 1 + arctan (1 / 239) = arctan (120 / 119)" by auto
  4765   ultimately have "arctan 1 + arctan (1 / 239) = 4 * arctan (1 / 5)" by auto
  4766   thus ?thesis unfolding arctan_one by algebra
  4767 qed
  4768 
  4769 lemma machin_Euler: "5 * arctan(1/7) + 2 * arctan(3/79) = pi/4"
  4770 proof -
  4771   have 17: "\<bar>1/7\<bar> < (1 :: real)" by auto
  4772   with arctan_double
  4773   have "2 * arctan (1/7) = arctan (7/24)"  by auto
  4774   moreover
  4775   have "\<bar>7/24\<bar> < (1 :: real)" by auto
  4776   with arctan_double
  4777   have "2 * arctan (7/24) = arctan (336/527)"  by auto
  4778   moreover
  4779   have "\<bar>336/527\<bar> < (1 :: real)" by auto
  4780   from arctan_add[OF less_imp_le[OF 17] this]
  4781   have "arctan(1/7) + arctan (336/527) = arctan (2879/3353)"  by auto 
  4782   ultimately have I: "5 * arctan(1/7) = arctan (2879/3353)"  by auto
  4783   have 379: "\<bar>3/79\<bar> < (1 :: real)" by auto
  4784   with arctan_double
  4785   have II: "2 * arctan (3/79) = arctan (237/3116)"  by auto
  4786   have *: "\<bar>2879/3353\<bar> < (1 :: real)" by auto
  4787   have "\<bar>237/3116\<bar> < (1 :: real)" by auto
  4788   from arctan_add[OF less_imp_le[OF *] this]
  4789   have "arctan (2879/3353) + arctan (237/3116) = pi/4"
  4790     by (simp add: arctan_one)
  4791   then show ?thesis using I II
  4792     by auto
  4793 qed
  4794 
  4795 (*But could also prove MACHIN_GAUSS:
  4796   12 * arctan(1/18) + 8 * arctan(1/57) - 5 * arctan(1/239) = pi/4*)
  4797 
  4798 
  4799 subsection \<open>Introducing the inverse tangent power series\<close>
  4800 
  4801 lemma monoseq_arctan_series:
  4802   fixes x :: real
  4803   assumes "\<bar>x\<bar> \<le> 1"
  4804   shows "monoseq (\<lambda> n. 1 / real (n*2+1) * x^(n*2+1))" (is "monoseq ?a")
  4805 proof (cases "x = 0")
  4806   case True
  4807   thus ?thesis unfolding monoseq_def One_nat_def by auto
  4808 next
  4809   case False
  4810   have "norm x \<le> 1" and "x \<le> 1" and "-1 \<le> x" using assms by auto
  4811   show "monoseq ?a"
  4812   proof -
  4813     {
  4814       fix n
  4815       fix x :: real
  4816       assume "0 \<le> x" and "x \<le> 1"
  4817       have "1 / real (Suc (Suc n * 2)) * x ^ Suc (Suc n * 2) \<le>
  4818         1 / real (Suc (n * 2)) * x ^ Suc (n * 2)"
  4819       proof (rule mult_mono)
  4820         show "1 / real (Suc (Suc n * 2)) \<le> 1 / real (Suc (n * 2))"
  4821           by (rule frac_le) simp_all
  4822         show "0 \<le> 1 / real (Suc (n * 2))"
  4823           by auto
  4824         show "x ^ Suc (Suc n * 2) \<le> x ^ Suc (n * 2)"
  4825           by (rule power_decreasing) (simp_all add: \<open>0 \<le> x\<close> \<open>x \<le> 1\<close>)
  4826         show "0 \<le> x ^ Suc (Suc n * 2)"
  4827           by (rule zero_le_power) (simp add: \<open>0 \<le> x\<close>)
  4828       qed
  4829     } note mono = this
  4830 
  4831     show ?thesis
  4832     proof (cases "0 \<le> x")
  4833       case True from mono[OF this \<open>x \<le> 1\<close>, THEN allI]
  4834       show ?thesis unfolding Suc_eq_plus1[symmetric]
  4835         by (rule mono_SucI2)
  4836     next
  4837       case False
  4838       hence "0 \<le> -x" and "-x \<le> 1" using \<open>-1 \<le> x\<close> by auto
  4839       from mono[OF this]
  4840       have "\<And>n. 1 / real (Suc (Suc n * 2)) * x ^ Suc (Suc n * 2) \<ge>
  4841         1 / real (Suc (n * 2)) * x ^ Suc (n * 2)" using \<open>0 \<le> -x\<close> by auto
  4842       thus ?thesis unfolding Suc_eq_plus1[symmetric] by (rule mono_SucI1[OF allI])
  4843     qed
  4844   qed
  4845 qed
  4846 
  4847 lemma zeroseq_arctan_series:
  4848   fixes x :: real
  4849   assumes "\<bar>x\<bar> \<le> 1"
  4850   shows "(\<lambda> n. 1 / real (n*2+1) * x^(n*2+1)) ----> 0" (is "?a ----> 0")
  4851 proof (cases "x = 0")
  4852   case True
  4853   thus ?thesis
  4854     unfolding One_nat_def by auto
  4855 next
  4856   case False
  4857   have "norm x \<le> 1" and "x \<le> 1" and "-1 \<le> x" using assms by auto
  4858   show "?a ----> 0"
  4859   proof (cases "\<bar>x\<bar> < 1")
  4860     case True
  4861     hence "norm x < 1" by auto
  4862     from tendsto_mult[OF LIMSEQ_inverse_real_of_nat LIMSEQ_power_zero[OF \<open>norm x < 1\<close>, THEN LIMSEQ_Suc]]
  4863     have "(\<lambda>n. 1 / real (n + 1) * x ^ (n + 1)) ----> 0"
  4864       unfolding inverse_eq_divide Suc_eq_plus1 by simp
  4865     then show ?thesis using pos2 by (rule LIMSEQ_linear)
  4866   next
  4867     case False
  4868     hence "x = -1 \<or> x = 1" using \<open>\<bar>x\<bar> \<le> 1\<close> by auto
  4869     hence n_eq: "\<And> n. x ^ (n * 2 + 1) = x"
  4870       unfolding One_nat_def by auto
  4871     from tendsto_mult[OF LIMSEQ_inverse_real_of_nat[THEN LIMSEQ_linear, OF pos2, unfolded inverse_eq_divide] tendsto_const[of x]]
  4872     show ?thesis unfolding n_eq Suc_eq_plus1 by auto
  4873   qed
  4874 qed
  4875 
  4876 text\<open>FIXME: generalise from the reals via type classes?\<close>
  4877 lemma summable_arctan_series:
  4878   fixes x :: real and n :: nat
  4879   assumes "\<bar>x\<bar> \<le> 1"
  4880   shows "summable (\<lambda> k. (-1)^k * (1 / real (k*2+1) * x ^ (k*2+1)))"
  4881   (is "summable (?c x)")
  4882   by (rule summable_Leibniz(1), rule zeroseq_arctan_series[OF assms], rule monoseq_arctan_series[OF assms])
  4883 
  4884 lemma DERIV_arctan_series:
  4885   assumes "\<bar> x \<bar> < 1"
  4886   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))"
  4887   (is "DERIV ?arctan _ :> ?Int")
  4888 proof -
  4889   let ?f = "\<lambda>n. if even n then (-1)^(n div 2) * 1 / real (Suc n) else 0"
  4890 
  4891   have n_even: "\<And>n :: nat. even n \<Longrightarrow> 2 * (n div 2) = n"
  4892     by presburger
  4893   then have if_eq: "\<And>n x'. ?f n * real (Suc n) * x'^n =
  4894     (if even n then (-1)^(n div 2) * x'^(2 * (n div 2)) else 0)"
  4895     by auto
  4896 
  4897   {
  4898     fix x :: real
  4899     assume "\<bar>x\<bar> < 1"
  4900     hence "x\<^sup>2 < 1" by (simp add: abs_square_less_1)
  4901     have "summable (\<lambda> n. (- 1) ^ n * (x\<^sup>2) ^n)"
  4902       by (rule summable_Leibniz(1), auto intro!: LIMSEQ_realpow_zero monoseq_realpow \<open>x\<^sup>2 < 1\<close> order_less_imp_le[OF \<open>x\<^sup>2 < 1\<close>])
  4903     hence "summable (\<lambda> n. (- 1) ^ n * x^(2*n))" unfolding power_mult .
  4904   } note summable_Integral = this
  4905 
  4906   {
  4907     fix f :: "nat \<Rightarrow> real"
  4908     have "\<And>x. f sums x = (\<lambda> n. if even n then f (n div 2) else 0) sums x"
  4909     proof
  4910       fix x :: real
  4911       assume "f sums x"
  4912       from sums_if[OF sums_zero this]
  4913       show "(\<lambda>n. if even n then f (n div 2) else 0) sums x"
  4914         by auto
  4915     next
  4916       fix x :: real
  4917       assume "(\<lambda> n. if even n then f (n div 2) else 0) sums x"
  4918       from LIMSEQ_linear[OF this[unfolded sums_def] pos2, unfolded sum_split_even_odd[unfolded mult.commute]]
  4919       show "f sums x" unfolding sums_def by auto
  4920     qed
  4921     hence "op sums f = op sums (\<lambda> n. if even n then f (n div 2) else 0)" ..
  4922   } note sums_even = this
  4923 
  4924   have Int_eq: "(\<Sum>n. ?f n * real (Suc n) * x^n) = ?Int"
  4925     unfolding if_eq mult.commute[of _ 2] suminf_def sums_even[of "\<lambda> n. (- 1) ^ n * x ^ (2 * n)", symmetric]
  4926     by auto
  4927 
  4928   {
  4929     fix x :: real
  4930     have if_eq': "\<And>n. (if even n then (- 1) ^ (n div 2) * 1 / real (Suc n) else 0) * x ^ Suc n =
  4931       (if even n then (- 1) ^ (n div 2) * (1 / real (Suc (2 * (n div 2))) * x ^ Suc (2 * (n div 2))) else 0)"
  4932       using n_even by auto
  4933     have idx_eq: "\<And>n. n * 2 + 1 = Suc (2 * n)" by auto
  4934     have "(\<Sum>n. ?f n * x^(Suc n)) = ?arctan x"
  4935       unfolding if_eq' idx_eq suminf_def sums_even[of "\<lambda> n. (- 1) ^ n * (1 / real (Suc (2 * n)) * x ^ Suc (2 * n))", symmetric]
  4936       by auto
  4937   } note arctan_eq = this
  4938 
  4939   have "DERIV (\<lambda> x. \<Sum> n. ?f n * x^(Suc n)) x :> (\<Sum> n. ?f n * real (Suc n) * x^n)"
  4940   proof (rule DERIV_power_series')
  4941     show "x \<in> {- 1 <..< 1}" using \<open>\<bar> x \<bar> < 1\<close> by auto
  4942     {
  4943       fix x' :: real
  4944       assume x'_bounds: "x' \<in> {- 1 <..< 1}"
  4945       then have "\<bar>x'\<bar> < 1" by auto
  4946       then
  4947         have *: "summable (\<lambda>n. (- 1) ^ n * x' ^ (2 * n))"
  4948         by (rule summable_Integral)
  4949       let ?S = "\<Sum> n. (-1)^n * x'^(2 * n)"
  4950       show "summable (\<lambda> n. ?f n * real (Suc n) * x'^n)" unfolding if_eq
  4951         apply (rule sums_summable [where l="0 + ?S"])
  4952         apply (rule sums_if)
  4953         apply (rule sums_zero)
  4954         apply (rule summable_sums)
  4955         apply (rule *)
  4956         done
  4957     }
  4958   qed auto
  4959   thus ?thesis unfolding Int_eq arctan_eq .
  4960 qed
  4961 
  4962 lemma arctan_series:
  4963   assumes "\<bar> x \<bar> \<le> 1"
  4964   shows "arctan x = (\<Sum>k. (-1)^k * (1 / real (k*2+1) * x ^ (k*2+1)))"
  4965   (is "_ = suminf (\<lambda> n. ?c x n)")
  4966 proof -
  4967   let ?c' = "\<lambda>x n. (-1)^n * x^(n*2)"
  4968 
  4969   {
  4970     fix r x :: real
  4971     assume "0 < r" and "r < 1" and "\<bar> x \<bar> < r"
  4972     have "\<bar>x\<bar> < 1" using \<open>r < 1\<close> and \<open>\<bar>x\<bar> < r\<close> by auto
  4973     from DERIV_arctan_series[OF this] have "DERIV (\<lambda> x. suminf (?c x)) x :> (suminf (?c' x))" .
  4974   } note DERIV_arctan_suminf = this
  4975 
  4976   {
  4977     fix x :: real
  4978     assume "\<bar>x\<bar> \<le> 1"
  4979     note summable_Leibniz[OF zeroseq_arctan_series[OF this] monoseq_arctan_series[OF this]]
  4980   } note arctan_series_borders = this
  4981 
  4982   {
  4983     fix x :: real
  4984     assume "\<bar>x\<bar> < 1"
  4985     have "arctan x = (\<Sum>k. ?c x k)"
  4986     proof -
  4987       obtain r where "\<bar>x\<bar> < r" and "r < 1"
  4988         using dense[OF \<open>\<bar>x\<bar> < 1\<close>] by blast
  4989       hence "0 < r" and "-r < x" and "x < r" by auto
  4990 
  4991       have suminf_eq_arctan_bounded: "\<And>x a b. \<lbrakk> -r < a ; b < r ; a < b ; a \<le> x ; x \<le> b \<rbrakk> \<Longrightarrow>
  4992         suminf (?c x) - arctan x = suminf (?c a) - arctan a"
  4993       proof -
  4994         fix x a b
  4995         assume "-r < a" and "b < r" and "a < b" and "a \<le> x" and "x \<le> b"
  4996         hence "\<bar>x\<bar> < r" by auto
  4997         show "suminf (?c x) - arctan x = suminf (?c a) - arctan a"
  4998         proof (rule DERIV_isconst2[of "a" "b"])
  4999           show "a < b" and "a \<le> x" and "x \<le> b"
  5000             using \<open>a < b\<close> \<open>a \<le> x\<close> \<open>x \<le> b\<close> by auto
  5001           have "\<forall>x. -r < x \<and> x < r \<longrightarrow> DERIV (\<lambda> x. suminf (?c x) - arctan x) x :> 0"
  5002           proof (rule allI, rule impI)
  5003             fix x
  5004             assume "-r < x \<and> x < r"
  5005             hence "\<bar>x\<bar> < r" by auto
  5006             hence "\<bar>x\<bar> < 1" using \<open>r < 1\<close> by auto
  5007             have "\<bar> - (x\<^sup>2) \<bar> < 1"
  5008               using abs_square_less_1 \<open>\<bar>x\<bar> < 1\<close> by auto
  5009             hence "(\<lambda> n. (- (x\<^sup>2)) ^ n) sums (1 / (1 - (- (x\<^sup>2))))"
  5010               unfolding real_norm_def[symmetric] by (rule geometric_sums)
  5011             hence "(?c' x) sums (1 / (1 - (- (x\<^sup>2))))"
  5012               unfolding power_mult_distrib[symmetric] power_mult mult.commute[of _ 2] by auto
  5013             hence suminf_c'_eq_geom: "inverse (1 + x\<^sup>2) = suminf (?c' x)"
  5014               using sums_unique unfolding inverse_eq_divide by auto
  5015             have "DERIV (\<lambda> x. suminf (?c x)) x :> (inverse (1 + x\<^sup>2))"
  5016               unfolding suminf_c'_eq_geom
  5017               by (rule DERIV_arctan_suminf[OF \<open>0 < r\<close> \<open>r < 1\<close> \<open>\<bar>x\<bar> < r\<close>])
  5018             from DERIV_diff [OF this DERIV_arctan]
  5019             show "DERIV (\<lambda> x. suminf (?c x) - arctan x) x :> 0"
  5020               by auto
  5021           qed
  5022           hence DERIV_in_rball: "\<forall> y. a \<le> y \<and> y \<le> b \<longrightarrow> DERIV (\<lambda> x. suminf (?c x) - arctan x) y :> 0"
  5023             using \<open>-r < a\<close> \<open>b < r\<close> by auto
  5024           thus "\<forall> y. a < y \<and> y < b \<longrightarrow> DERIV (\<lambda> x. suminf (?c x) - arctan x) y :> 0"
  5025             using \<open>\<bar>x\<bar> < r\<close> by auto
  5026           show "\<forall> y. a \<le> y \<and> y \<le> b \<longrightarrow> isCont (\<lambda> x. suminf (?c x) - arctan x) y"
  5027             using DERIV_in_rball DERIV_isCont by auto
  5028         qed
  5029       qed
  5030 
  5031       have suminf_arctan_zero: "suminf (?c 0) - arctan 0 = 0"
  5032         unfolding Suc_eq_plus1[symmetric] power_Suc2 mult_zero_right arctan_zero_zero suminf_zero
  5033         by auto
  5034 
  5035       have "suminf (?c x) - arctan x = 0"
  5036       proof (cases "x = 0")
  5037         case True
  5038         thus ?thesis using suminf_arctan_zero by auto
  5039       next
  5040         case False
  5041         hence "0 < \<bar>x\<bar>" and "- \<bar>x\<bar> < \<bar>x\<bar>" by auto
  5042         have "suminf (?c (-\<bar>x\<bar>)) - arctan (-\<bar>x\<bar>) = suminf (?c 0) - arctan 0"
  5043           by (rule suminf_eq_arctan_bounded[where x1="0" and a1="-\<bar>x\<bar>" and b1="\<bar>x\<bar>", symmetric])
  5044             (simp_all only: \<open>\<bar>x\<bar> < r\<close> \<open>-\<bar>x\<bar> < \<bar>x\<bar>\<close> neg_less_iff_less)
  5045         moreover
  5046         have "suminf (?c x) - arctan x = suminf (?c (-\<bar>x\<bar>)) - arctan (-\<bar>x\<bar>)"
  5047           by (rule suminf_eq_arctan_bounded[where x1="x" and a1="-\<bar>x\<bar>" and b1="\<bar>x\<bar>"])
  5048              (simp_all only: \<open>\<bar>x\<bar> < r\<close> \<open>-\<bar>x\<bar> < \<bar>x\<bar>\<close> neg_less_iff_less)
  5049         ultimately
  5050         show ?thesis using suminf_arctan_zero by auto
  5051       qed
  5052       thus ?thesis by auto
  5053     qed
  5054   } note when_less_one = this
  5055 
  5056   show "arctan x = suminf (\<lambda> n. ?c x n)"
  5057   proof (cases "\<bar>x\<bar> < 1")
  5058     case True
  5059     thus ?thesis by (rule when_less_one)
  5060   next
  5061     case False
  5062     hence "\<bar>x\<bar> = 1" using \<open>\<bar>x\<bar> \<le> 1\<close> by auto
  5063     let ?a = "\<lambda>x n. \<bar>1 / real (n*2+1) * x^(n*2+1)\<bar>"
  5064     let ?diff = "\<lambda> x n. \<bar> arctan x - (\<Sum> i<n. ?c x i)\<bar>"
  5065     {
  5066       fix n :: nat
  5067       have "0 < (1 :: real)" by auto
  5068       moreover
  5069       {
  5070         fix x :: real
  5071         assume "0 < x" and "x < 1"
  5072         hence "\<bar>x\<bar> \<le> 1" and "\<bar>x\<bar> < 1" by auto
  5073         from \<open>0 < x\<close> have "0 < 1 / real (0 * 2 + (1::nat)) * x ^ (0 * 2 + 1)"
  5074           by auto
  5075         note bounds = mp[OF arctan_series_borders(2)[OF \<open>\<bar>x\<bar> \<le> 1\<close>] this, unfolded when_less_one[OF \<open>\<bar>x\<bar> < 1\<close>, symmetric], THEN spec]
  5076         have "0 < 1 / real (n*2+1) * x^(n*2+1)"
  5077           by (rule mult_pos_pos, auto simp only: zero_less_power[OF \<open>0 < x\<close>], auto)
  5078         hence a_pos: "?a x n = 1 / real (n*2+1) * x^(n*2+1)"
  5079           by (rule abs_of_pos)
  5080         have "?diff x n \<le> ?a x n"
  5081         proof (cases "even n")
  5082           case True
  5083           hence sgn_pos: "(-1)^n = (1::real)" by auto
  5084           from \<open>even n\<close> obtain m where "n = 2 * m" ..
  5085           then have "2 * m = n" ..
  5086           from bounds[of m, unfolded this atLeastAtMost_iff]
  5087           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))"
  5088             by auto
  5089           also have "\<dots> = ?c x n" unfolding One_nat_def by auto
  5090           also have "\<dots> = ?a x n" unfolding sgn_pos a_pos by auto
  5091           finally show ?thesis .
  5092         next
  5093           case False
  5094           hence sgn_neg: "(-1)^n = (-1::real)" by auto
  5095           from \<open>odd n\<close> obtain m where "n = 2 * m + 1" ..
  5096           then have m_def: "2 * m + 1 = n" ..
  5097           hence m_plus: "2 * (m + 1) = n + 1" by auto
  5098           from bounds[of "m + 1", unfolded this atLeastAtMost_iff, THEN conjunct1] bounds[of m, unfolded m_def atLeastAtMost_iff, THEN conjunct2]
  5099           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))"
  5100             by auto
  5101           also have "\<dots> = - ?c x n" unfolding One_nat_def by auto
  5102           also have "\<dots> = ?a x n" unfolding sgn_neg a_pos by auto
  5103           finally show ?thesis .
  5104         qed
  5105         hence "0 \<le> ?a x n - ?diff x n" by auto
  5106       }
  5107       hence "\<forall> x \<in> { 0 <..< 1 }. 0 \<le> ?a x n - ?diff x n" by auto
  5108       moreover have "\<And>x. isCont (\<lambda> x. ?a x n - ?diff x n) x"
  5109         unfolding diff_conv_add_uminus divide_inverse
  5110         by (auto intro!: isCont_add isCont_rabs continuous_ident isCont_minus isCont_arctan
  5111           isCont_inverse isCont_mult isCont_power continuous_const isCont_setsum
  5112           simp del: add_uminus_conv_diff)
  5113       ultimately have "0 \<le> ?a 1 n - ?diff 1 n"
  5114         by (rule LIM_less_bound)
  5115       hence "?diff 1 n \<le> ?a 1 n" by auto
  5116     }
  5117     have "?a 1 ----> 0"
  5118       unfolding tendsto_rabs_zero_iff power_one divide_inverse One_nat_def
  5119       by (auto intro!: tendsto_mult LIMSEQ_linear LIMSEQ_inverse_real_of_nat)
  5120     have "?diff 1 ----> 0"
  5121     proof (rule LIMSEQ_I)
  5122       fix r :: real
  5123       assume "0 < r"
  5124       obtain N :: nat where N_I: "\<And>n. N \<le> n \<Longrightarrow> ?a 1 n < r"
  5125         using LIMSEQ_D[OF \<open>?a 1 ----> 0\<close> \<open>0 < r\<close>] by auto
  5126       {
  5127         fix n
  5128         assume "N \<le> n" from \<open>?diff 1 n \<le> ?a 1 n\<close> N_I[OF this]
  5129         have "norm (?diff 1 n - 0) < r" by auto
  5130       }
  5131       thus "\<exists> N. \<forall> n \<ge> N. norm (?diff 1 n - 0) < r" by blast
  5132     qed
  5133     from this [unfolded tendsto_rabs_zero_iff, THEN tendsto_add [OF _ tendsto_const], of "- arctan 1", THEN tendsto_minus]
  5134     have "(?c 1) sums (arctan 1)" unfolding sums_def by auto
  5135     hence "arctan 1 = (\<Sum> i. ?c 1 i)" by (rule sums_unique)
  5136 
  5137     show ?thesis
  5138     proof (cases "x = 1")
  5139       case True
  5140       then show ?thesis by (simp add: \<open>arctan 1 = (\<Sum> i. ?c 1 i)\<close>)
  5141     next
  5142       case False
  5143       hence "x = -1" using \<open>\<bar>x\<bar> = 1\<close> by auto
  5144 
  5145       have "- (pi / 2) < 0" using pi_gt_zero by auto
  5146       have "- (2 * pi) < 0" using pi_gt_zero by auto
  5147 
  5148       have c_minus_minus: "\<And>i. ?c (- 1) i = - ?c 1 i"
  5149         unfolding One_nat_def by auto
  5150 
  5151       have "arctan (- 1) = arctan (tan (-(pi / 4)))"
  5152         unfolding tan_45 tan_minus ..
  5153       also have "\<dots> = - (pi / 4)"
  5154         by (rule arctan_tan, auto simp add: order_less_trans[OF \<open>- (pi / 2) < 0\<close> pi_gt_zero])
  5155       also have "\<dots> = - (arctan (tan (pi / 4)))"
  5156         unfolding neg_equal_iff_equal by (rule arctan_tan[symmetric], auto simp add: order_less_trans[OF \<open>- (2 * pi) < 0\<close> pi_gt_zero])
  5157       also have "\<dots> = - (arctan 1)"
  5158         unfolding tan_45 ..
  5159       also have "\<dots> = - (\<Sum> i. ?c 1 i)"
  5160         using \<open>arctan 1 = (\<Sum> i. ?c 1 i)\<close> by auto
  5161       also have "\<dots> = (\<Sum> i. ?c (- 1) i)"
  5162         using suminf_minus[OF sums_summable[OF \<open>(?c 1) sums (arctan 1)\<close>]]
  5163         unfolding c_minus_minus by auto
  5164       finally show ?thesis using \<open>x = -1\<close> by auto
  5165     qed
  5166   qed
  5167 qed
  5168 
  5169 lemma arctan_half:
  5170   fixes x :: real
  5171   shows "arctan x = 2 * arctan (x / (1 + sqrt(1 + x\<^sup>2)))"
  5172 proof -
  5173   obtain y where low: "- (pi / 2) < y" and high: "y < pi / 2" and y_eq: "tan y = x"
  5174     using tan_total by blast
  5175   hence low2: "- (pi / 2) < y / 2" and high2: "y / 2 < pi / 2"
  5176     by auto
  5177 
  5178   have "0 < cos y" using cos_gt_zero_pi[OF low high] .
  5179   hence "cos y \<noteq> 0" and cos_sqrt: "sqrt ((cos y)\<^sup>2) = cos y"
  5180     by auto
  5181 
  5182   have "1 + (tan y)\<^sup>2 = 1 + (sin y)\<^sup>2 / (cos y)\<^sup>2"
  5183     unfolding tan_def power_divide ..
  5184   also have "\<dots> = (cos y)\<^sup>2 / (cos y)\<^sup>2 + (sin y)\<^sup>2 / (cos y)\<^sup>2"
  5185     using \<open>cos y \<noteq> 0\<close> by auto
  5186   also have "\<dots> = 1 / (cos y)\<^sup>2"
  5187     unfolding add_divide_distrib[symmetric] sin_cos_squared_add2 ..
  5188   finally have "1 + (tan y)\<^sup>2 = 1 / (cos y)\<^sup>2" .
  5189 
  5190   have "sin y / (cos y + 1) = tan y / ((cos y + 1) / cos y)"
  5191     unfolding tan_def using \<open>cos y \<noteq> 0\<close> by (simp add: field_simps)
  5192   also have "\<dots> = tan y / (1 + 1 / cos y)"
  5193     using \<open>cos y \<noteq> 0\<close> unfolding add_divide_distrib by auto
  5194   also have "\<dots> = tan y / (1 + 1 / sqrt ((cos y)\<^sup>2))"
  5195     unfolding cos_sqrt ..
  5196   also have "\<dots> = tan y / (1 + sqrt (1 / (cos y)\<^sup>2))"
  5197     unfolding real_sqrt_divide by auto
  5198   finally have eq: "sin y / (cos y + 1) = tan y / (1 + sqrt(1 + (tan y)\<^sup>2))"
  5199     unfolding \<open>1 + (tan y)\<^sup>2 = 1 / (cos y)\<^sup>2\<close> .
  5200 
  5201   have "arctan x = y"
  5202     using arctan_tan low high y_eq by auto
  5203   also have "\<dots> = 2 * (arctan (tan (y/2)))"
  5204     using arctan_tan[OF low2 high2] by auto
  5205   also have "\<dots> = 2 * (arctan (sin y / (cos y + 1)))"
  5206     unfolding tan_half by auto
  5207   finally show ?thesis
  5208     unfolding eq \<open>tan y = x\<close> .
  5209 qed
  5210 
  5211 lemma arctan_monotone: "x < y \<Longrightarrow> arctan x < arctan y"
  5212   by (simp only: arctan_less_iff)
  5213 
  5214 lemma arctan_monotone': "x \<le> y \<Longrightarrow> arctan x \<le> arctan y"
  5215   by (simp only: arctan_le_iff)
  5216 
  5217 lemma arctan_inverse:
  5218   assumes "x \<noteq> 0"
  5219   shows "arctan (1 / x) = sgn x * pi / 2 - arctan x"
  5220 proof (rule arctan_unique)
  5221   show "- (pi / 2) < sgn x * pi / 2 - arctan x"
  5222     using arctan_bounded [of x] assms
  5223     unfolding sgn_real_def
  5224     apply (auto simp add: arctan algebra_simps)
  5225     apply (drule zero_less_arctan_iff [THEN iffD2])
  5226     apply arith
  5227     done
  5228   show "sgn x * pi / 2 - arctan x < pi / 2"
  5229     using arctan_bounded [of "- x"] assms
  5230     unfolding sgn_real_def arctan_minus
  5231     by (auto simp add: algebra_simps)
  5232   show "tan (sgn x * pi / 2 - arctan x) = 1 / x"
  5233     unfolding tan_inverse [of "arctan x", unfolded tan_arctan]
  5234     unfolding sgn_real_def
  5235     by (simp add: tan_def cos_arctan sin_arctan sin_diff cos_diff)
  5236 qed
  5237 
  5238 theorem pi_series: "pi / 4 = (\<Sum> k. (-1)^k * 1 / real (k*2+1))" (is "_ = ?SUM")
  5239 proof -
  5240   have "pi / 4 = arctan 1" using arctan_one by auto
  5241   also have "\<dots> = ?SUM" using arctan_series[of 1] by auto
  5242   finally show ?thesis by auto
  5243 qed
  5244 
  5245 
  5246 subsection \<open>Existence of Polar Coordinates\<close>
  5247 
  5248 lemma cos_x_y_le_one: "\<bar>x / sqrt (x\<^sup>2 + y\<^sup>2)\<bar> \<le> 1"
  5249   apply (rule power2_le_imp_le [OF _ zero_le_one])
  5250   apply (simp add: power_divide divide_le_eq not_sum_power2_lt_zero)
  5251   done
  5252 
  5253 lemmas cos_arccos_lemma1 = cos_arccos_abs [OF cos_x_y_le_one]
  5254 
  5255 lemmas sin_arccos_lemma1 = sin_arccos_abs [OF cos_x_y_le_one]
  5256 
  5257 lemma polar_Ex: "\<exists>r::real. \<exists>a. x = r * cos a & y = r * sin a"
  5258 proof -
  5259   have polar_ex1: "\<And>y. 0 < y \<Longrightarrow> \<exists>r a. x = r * cos a & y = r * sin a"
  5260     apply (rule_tac x = "sqrt (x\<^sup>2 + y\<^sup>2)" in exI)
  5261     apply (rule_tac x = "arccos (x / sqrt (x\<^sup>2 + y\<^sup>2))" in exI)
  5262     apply (simp add: cos_arccos_lemma1 sin_arccos_lemma1 power_divide
  5263                      real_sqrt_mult [symmetric] right_diff_distrib)
  5264     done
  5265   show ?thesis
  5266   proof (cases "0::real" y rule: linorder_cases)
  5267     case less
  5268       then show ?thesis by (rule polar_ex1)
  5269   next
  5270     case equal
  5271       then show ?thesis
  5272         by (force simp add: intro!: cos_zero sin_zero)
  5273   next
  5274     case greater
  5275       then show ?thesis
  5276      using polar_ex1 [where y="-y"]
  5277     by auto (metis cos_minus minus_minus minus_mult_right sin_minus)
  5278   qed
  5279 qed
  5280 
  5281 
  5282 subsection\<open>Basics about polynomial functions: products, extremal behaviour and root counts\<close>
  5283 
  5284 lemma pairs_le_eq_Sigma:
  5285   fixes m::nat
  5286   shows "{(i,j). i+j \<le> m} = Sigma (atMost m) (\<lambda>r. atMost (m-r))"
  5287 by auto
  5288 
  5289 lemma setsum_up_index_split:
  5290     "(\<Sum>k\<le>m + n. f k) = (\<Sum>k\<le>m. f k) + (\<Sum>k = Suc m..m + n. f k)"
  5291   by (metis atLeast0AtMost Suc_eq_plus1 le0 setsum_ub_add_nat)
  5292 
  5293 lemma Sigma_interval_disjoint:
  5294   fixes w :: "'a::order"
  5295   shows "(SIGMA i:A. {..v i}) \<inter> (SIGMA i:A.{v i<..w}) = {}"
  5296     by auto
  5297 
  5298 lemma product_atMost_eq_Un:
  5299   fixes m :: nat
  5300   shows "A \<times> {..m} = (SIGMA i:A.{..m - i}) \<union> (SIGMA i:A.{m - i<..m})"
  5301     by auto
  5302 
  5303 lemma polynomial_product: (*with thanks to Chaitanya Mangla*)
  5304   fixes x:: "'a :: idom"
  5305   assumes m: "\<And>i. i>m \<Longrightarrow> (a i) = 0" and n: "\<And>j. j>n \<Longrightarrow> (b j) = 0"
  5306   shows "(\<Sum>i\<le>m. (a i) * x ^ i) * (\<Sum>j\<le>n. (b j) * x ^ j) = 
  5307          (\<Sum>r\<le>m + n. (\<Sum>k\<le>r. (a k) * (b (r - k))) * x ^ r)"
  5308 proof -
  5309   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))"
  5310     by (rule setsum_product)
  5311   also have "... = (\<Sum>i\<le>m + n. \<Sum>j\<le>n + m. a i * x ^ i * (b j * x ^ j))"
  5312     using assms by (auto simp: setsum_up_index_split)
  5313   also have "... = (\<Sum>r\<le>m + n. \<Sum>j\<le>m + n - r. a r * x ^ r * (b j * x ^ j))"
  5314     apply (simp add: add_ac setsum.Sigma product_atMost_eq_Un)
  5315     apply (clarsimp simp add: setsum_Un Sigma_interval_disjoint intro!: setsum.neutral)
  5316     by (metis add_diff_assoc2 add.commute add_lessD1 leD m n nat_le_linear neqE)
  5317   also have "... = (\<Sum>(i,j)\<in>{(i,j). i+j \<le> m+n}. (a i * x ^ i) * (b j * x ^ j))"
  5318     by (auto simp: pairs_le_eq_Sigma setsum.Sigma)
  5319   also have "... = (\<Sum>r\<le>m + n. (\<Sum>k\<le>r. (a k) * (b (r - k))) * x ^ r)"
  5320     apply (subst setsum_triangle_reindex_eq)  
  5321     apply (auto simp: algebra_simps setsum_right_distrib intro!: setsum.cong)
  5322     by (metis le_add_diff_inverse power_add)
  5323   finally show ?thesis .
  5324 qed
  5325 
  5326 lemma polynomial_product_nat: 
  5327   fixes x:: nat
  5328   assumes m: "\<And>i. i>m \<Longrightarrow> (a i) = 0" and n: "\<And>j. j>n \<Longrightarrow> (b j) = 0"
  5329   shows "(\<Sum>i\<le>m. (a i) * x ^ i) * (\<Sum>j\<le>n. (b j) * x ^ j) = 
  5330          (\<Sum>r\<le>m + n. (\<Sum>k\<le>r. (a k) * (b (r - k))) * x ^ r)"
  5331   using polynomial_product [of m a n b x] assms
  5332   by (simp add: Int.zpower_int Int.zmult_int Int.int_setsum [symmetric])
  5333 
  5334 lemma polyfun_diff: (*COMPLEX_SUB_POLYFUN in HOL Light*)
  5335     fixes x :: "'a::idom"
  5336   assumes "1 \<le> n"
  5337     shows "(\<Sum>i\<le>n. a i * x^i) - (\<Sum>i\<le>n. a i * y^i) =
  5338            (x - y) * (\<Sum>j<n. (\<Sum>i=Suc j..n. a i * y^(i - j - 1)) * x^j)"
  5339 proof -
  5340   have h: "bij_betw (\<lambda>(i,j). (j,i)) ((SIGMA i : atMost n. lessThan i)) (SIGMA j : lessThan n. {Suc j..n})"
  5341     by (auto simp: bij_betw_def inj_on_def)
  5342   have "(\<Sum>i\<le>n. a i * x^i) - (\<Sum>i\<le>n. a i * y^i) =
  5343         (\<Sum>i\<le>n. a i * (x^i - y^i))"
  5344     by (simp add: right_diff_distrib setsum_subtractf)
  5345   also have "... = (\<Sum>i\<le>n. a i * (x - y) * (\<Sum>j<i. y^(i - Suc j) * x^j))"
  5346     by (simp add: power_diff_sumr2 mult.assoc)
  5347   also have "... = (\<Sum>i\<le>n. \<Sum>j<i. a i * (x - y) * (y^(i - Suc j) * x^j))"
  5348     by (simp add: setsum_right_distrib)
  5349   also have "... = (\<Sum>(i,j) \<in> (SIGMA i : atMost n. lessThan i). a i * (x - y) * (y^(i - Suc j) * x^j))"
  5350     by (simp add: setsum.Sigma)
  5351   also have "... = (\<Sum>(j,i) \<in> (SIGMA j : lessThan n. {Suc j..n}). a i * (x - y) * (y^(i - Suc j) * x^j))"
  5352     by (auto simp add: setsum.reindex_bij_betw [OF h, symmetric] intro: setsum.strong_cong)
  5353   also have "... = (\<Sum>j<n. \<Sum>i=Suc j..n. a i * (x - y) * (y^(i - Suc j) * x^j))"
  5354     by (simp add: setsum.Sigma)
  5355   also have "... = (x - y) * (\<Sum>j<n. (\<Sum>i=Suc j..n. a i * y^(i - j - 1)) * x^j)"
  5356     by (simp add: setsum_right_distrib mult_ac)
  5357   finally show ?thesis .
  5358 qed
  5359 
  5360 lemma polyfun_diff_alt: (*COMPLEX_SUB_POLYFUN_ALT in HOL Light*)
  5361     fixes x :: "'a::idom"
  5362   assumes "1 \<le> n"
  5363     shows "(\<Sum>i\<le>n. a i * x^i) - (\<Sum>i\<le>n. a i * y^i) =
  5364            (x - y) * ((\<Sum>j<n. \<Sum>k<n-j. a(j+k+1) * y^k * x^j))"
  5365 proof -
  5366   { fix j::nat
  5367     assume "j<n"
  5368     have h: "bij_betw (\<lambda>i. i - (j + 1)) {Suc j..n} (lessThan (n-j))"
  5369       apply (auto simp: bij_betw_def inj_on_def)
  5370       apply (rule_tac x="x + Suc j" in image_eqI)
  5371       apply (auto simp: )
  5372       done
  5373     have "(\<Sum>i=Suc j..n. a i * y^(i - j - 1)) = (\<Sum>k<n-j. a(j+k+1) * y^k)"
  5374       by (auto simp add: setsum.reindex_bij_betw [OF h, symmetric] intro: setsum.strong_cong)
  5375   }
  5376   then show ?thesis
  5377     by (simp add: polyfun_diff [OF assms] setsum_left_distrib)
  5378 qed
  5379 
  5380 lemma polyfun_linear_factor:  (*COMPLEX_POLYFUN_LINEAR_FACTOR in HOL Light*)
  5381   fixes a :: "'a::idom"
  5382   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)"
  5383 proof (cases "n=0")
  5384   case True then show ?thesis
  5385     by simp
  5386 next
  5387   case False
  5388   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)) =
  5389         (\<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))"
  5390     by (simp add: algebra_simps)
  5391   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))"
  5392     using False by (simp add: polyfun_diff)
  5393   also have "... = True"
  5394     by auto
  5395   finally show ?thesis
  5396     by simp
  5397 qed
  5398 
  5399 lemma polyfun_linear_factor_root:  (*COMPLEX_POLYFUN_LINEAR_FACTOR_ROOT in HOL Light*)
  5400   fixes a :: "'a::idom"
  5401   assumes "(\<Sum>i\<le>n. c(i) * a^i) = 0"
  5402   obtains b where "\<And>z. (\<Sum>i\<le>n. c(i) * z^i) = (z - a) * (\<Sum>i<n. b(i) * z^i)"
  5403   using polyfun_linear_factor [of c n a] assms
  5404   by auto
  5405 
  5406 (*The material of this section, up until this point, could go into a new theory of polynomials
  5407   based on Main alone. The remaining material involves limits, continuity, series, etc.*)
  5408 
  5409 lemma isCont_polynom:
  5410   fixes c :: "nat \<Rightarrow> 'a::real_normed_div_algebra"
  5411   shows "isCont (\<lambda>w. \<Sum>i\<le>n. c i * w^i) a"
  5412   by simp
  5413 
  5414 lemma zero_polynom_imp_zero_coeffs:
  5415     fixes c :: "nat \<Rightarrow> 'a::{ab_semigroup_mult,real_normed_div_algebra}"
  5416   assumes "\<And>w. (\<Sum>i\<le>n. c i * w^i) = 0"  "k \<le> n"
  5417     shows "c k = 0"
  5418 using assms
  5419 proof (induction n arbitrary: c k)
  5420   case 0
  5421   then show ?case
  5422     by simp
  5423 next
  5424   case (Suc n c k)
  5425   have [simp]: "c 0 = 0" using Suc.prems(1) [of 0]
  5426     by simp
  5427   { fix w
  5428     have "(\<Sum>i\<le>Suc n. c i * w^i) = (\<Sum>i\<le>n. c (Suc i) * w ^ Suc i)"
  5429       unfolding Set_Interval.setsum_atMost_Suc_shift
  5430       by simp
  5431     also have "... = w * (\<Sum>i\<le>n. c (Suc i) * w^i)"
  5432       by (simp add: power_Suc mult_ac setsum_right_distrib del: setsum_atMost_Suc)
  5433     finally have "(\<Sum>i\<le>Suc n. c i * w^i) = w * (\<Sum>i\<le>n. c (Suc i) * w^i)" .
  5434   }
  5435   then have wnz: "\<And>w. w \<noteq> 0 \<Longrightarrow> (\<Sum>i\<le>n. c (Suc i) * w^i) = 0"
  5436     using Suc  by auto
  5437   then have "(\<lambda>h. \<Sum>i\<le>n. c (Suc i) * h^i) -- 0 --> 0"
  5438     by (simp cong: LIM_cong)                   --\<open>the case @{term"w=0"} by continuity\<close>
  5439   then have "(\<Sum>i\<le>n. c (Suc i) * 0^i) = 0"
  5440     using isCont_polynom [of 0 "\<lambda>i. c (Suc i)" n] LIM_unique
  5441     by (force simp add: Limits.isCont_iff)
  5442   then have "\<And>w. (\<Sum>i\<le>n. c (Suc i) * w^i) = 0" using wnz
  5443     by metis
  5444   then have "\<And>i. i\<le>n \<Longrightarrow> c (Suc i) = 0"
  5445     using Suc.IH [of "\<lambda>i. c (Suc i)"]
  5446     by blast
  5447   then show ?case using \<open>k \<le> Suc n\<close>
  5448     by (cases k) auto
  5449 qed
  5450 
  5451 lemma polyfun_rootbound: (*COMPLEX_POLYFUN_ROOTBOUND in HOL Light*)
  5452     fixes c :: "nat \<Rightarrow> 'a::{idom,real_normed_div_algebra}"
  5453   assumes "c k \<noteq> 0" "k\<le>n"
  5454     shows "finite {z. (\<Sum>i\<le>n. c(i) * z^i) = 0} \<and>
  5455              card {z. (\<Sum>i\<le>n. c(i) * z^i) = 0} \<le> n"
  5456 using assms
  5457 proof (induction n arbitrary: c k)
  5458   case 0
  5459   then show ?case
  5460     by simp
  5461 next
  5462   case (Suc m c k)
  5463   let ?succase = ?case
  5464   show ?case
  5465   proof (cases "{z. (\<Sum>i\<le>Suc m. c(i) * z^i) = 0} = {}")
  5466     case True
  5467     then show ?succase
  5468       by simp
  5469   next
  5470     case False
  5471     then obtain z0 where z0: "(\<Sum>i\<le>Suc m. c(i) * z0^i) = 0"
  5472       by blast
  5473     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)"
  5474       using polyfun_linear_factor_root [OF z0, unfolded lessThan_Suc_atMost]
  5475       by blast
  5476     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}"
  5477       by auto
  5478     have "~(\<forall>k\<le>m. b k = 0)"
  5479     proof
  5480       assume [simp]: "\<forall>k\<le>m. b k = 0"
  5481       then have "\<And>w. (\<Sum>i\<le>m. b i * w^i) = 0"
  5482         by simp
  5483       then have "\<And>w. (\<Sum>i\<le>Suc m. c i * w^i) = 0"
  5484         using b by simp
  5485       then have "\<And>k. k \<le> Suc m \<Longrightarrow> c k = 0"
  5486         using zero_polynom_imp_zero_coeffs
  5487         by blast
  5488       then show False using Suc.prems
  5489         by blast
  5490     qed
  5491     then obtain k' where bk': "b k' \<noteq> 0" "k' \<le> m"
  5492       by blast
  5493     show ?succase
  5494       using Suc.IH [of b k'] bk'
  5495       by (simp add: eq card_insert_if del: setsum_atMost_Suc)
  5496     qed
  5497 qed
  5498 
  5499 lemma
  5500     fixes c :: "nat \<Rightarrow> 'a::{idom,real_normed_div_algebra}"
  5501   assumes "c k \<noteq> 0" "k\<le>n"
  5502     shows polyfun_roots_finite: "finite {z. (\<Sum>i\<le>n. c(i) * z^i) = 0}"
  5503       and polyfun_roots_card:   "card {z. (\<Sum>i\<le>n. c(i) * z^i) = 0} \<le> n"
  5504 using polyfun_rootbound assms
  5505   by auto
  5506 
  5507 lemma polyfun_finite_roots: (*COMPLEX_POLYFUN_FINITE_ROOTS in HOL Light*)
  5508   fixes c :: "nat \<Rightarrow> 'a::{idom,real_normed_div_algebra}"
  5509   shows "finite {x. (\<Sum>i\<le>n. c i * x^i) = 0} \<longleftrightarrow> (\<exists>i\<le>n. c i \<noteq> 0)"
  5510         (is "?lhs = ?rhs")
  5511 proof
  5512   assume ?lhs
  5513   moreover
  5514   { assume "\<forall>i\<le>n. c i = 0"
  5515     then have "\<And>x. (\<Sum>i\<le>n. c i * x^i) = 0"
  5516       by simp
  5517     then have "\<not> finite {x. (\<Sum>i\<le>n. c i * x^i) = 0}"
  5518       using ex_new_if_finite [OF infinite_UNIV_char_0 [where 'a='a]]
  5519       by auto
  5520   }
  5521   ultimately show ?rhs
  5522   by metis
  5523 next
  5524   assume ?rhs
  5525   then show ?lhs
  5526     using polyfun_rootbound
  5527     by blast
  5528 qed
  5529 
  5530 lemma polyfun_eq_0: (*COMPLEX_POLYFUN_EQ_0 in HOL Light*)
  5531   fixes c :: "nat \<Rightarrow> 'a::{idom,real_normed_div_algebra}"
  5532   shows "(\<forall>x. (\<Sum>i\<le>n. c i * x^i) = 0) \<longleftrightarrow> (\<forall>i\<le>n. c i = 0)"
  5533   using zero_polynom_imp_zero_coeffs by auto
  5534 
  5535 lemma polyfun_eq_coeffs:
  5536   fixes c :: "nat \<Rightarrow> 'a::{idom,real_normed_div_algebra}"
  5537   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)"
  5538 proof -
  5539   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)"
  5540     by (simp add: left_diff_distrib Groups_Big.setsum_subtractf)
  5541   also have "... \<longleftrightarrow> (\<forall>i\<le>n. c i - d i = 0)"
  5542     by (rule polyfun_eq_0)
  5543   finally show ?thesis
  5544     by simp
  5545 qed
  5546 
  5547 lemma polyfun_eq_const: (*COMPLEX_POLYFUN_EQ_CONST in HOL Light*)
  5548   fixes c :: "nat \<Rightarrow> 'a::{idom,real_normed_div_algebra}"
  5549   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)"
  5550         (is "?lhs = ?rhs")
  5551 proof -
  5552   have *: "\<forall>x. (\<Sum>i\<le>n. (if i=0 then k else 0) * x^i) = k"
  5553     by (induct n) auto
  5554   show ?thesis
  5555   proof
  5556     assume ?lhs
  5557     with * have "(\<forall>i\<le>n. c i = (if i=0 then k else 0))"
  5558       by (simp add: polyfun_eq_coeffs [symmetric])
  5559     then show ?rhs
  5560       by simp
  5561   next
  5562     assume ?rhs then show ?lhs
  5563       by (induct n) auto
  5564   qed
  5565 qed
  5566 
  5567 lemma root_polyfun:
  5568   fixes z:: "'a::idom"
  5569   assumes "1 \<le> n"
  5570     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"
  5571   using assms
  5572   by (cases n; simp add: setsum_head_Suc atLeast0AtMost [symmetric])
  5573 
  5574 lemma
  5575     fixes zz :: "'a::{idom,real_normed_div_algebra}"
  5576   assumes "1 \<le> n"
  5577     shows finite_roots_unity: "finite {z::'a. z^n = 1}"
  5578       and card_roots_unity:   "card {z::'a. z^n = 1} \<le> n"
  5579   using polyfun_rootbound [of "\<lambda>i. if i = 0 then -1 else if i=n then 1 else 0" n n] assms
  5580   by (auto simp add: root_polyfun [OF assms])
  5581 
  5582 end