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