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