src/HOL/Transcendental.thy
author paulson <lp15@cam.ac.uk>
Thu Mar 19 14:24:51 2015 +0000 (2015-03-19)
changeset 59751 916c0f6c83e3
parent 59746 ddae5727c5a9
child 59862 44b3f4fa33ca
permissions -rw-r--r--
New material for complex sin, cos, tan, Ln, also some reorganisation
     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 lemma exp_not_eq_zero [simp]: "exp x \<noteq> 0"
  1134 proof
  1135   have "exp x * exp (- x) = 1" by (simp add: exp_add_commuting[symmetric])
  1136   also assume "exp x = 0"
  1137   finally show "False" by simp
  1138 qed
  1139 
  1140 lemma exp_minus_inverse:
  1141   shows "exp x * exp (- x) = 1"
  1142   by (simp add: exp_add_commuting[symmetric])
  1143 
  1144 lemma exp_minus:
  1145   fixes x :: "'a::{real_normed_field, banach}"
  1146   shows "exp (- x) = inverse (exp x)"
  1147   by (intro inverse_unique [symmetric] exp_minus_inverse)
  1148 
  1149 lemma exp_diff:
  1150   fixes x :: "'a::{real_normed_field, banach}"
  1151   shows "exp (x - y) = exp x / exp y"
  1152   using exp_add [of x "- y"] by (simp add: exp_minus divide_inverse)
  1153 
  1154 lemma exp_of_nat_mult:
  1155   fixes x :: "'a::{real_normed_field,banach}"
  1156   shows "exp(of_nat n * x) = exp(x) ^ n"
  1157     by (induct n) (auto simp add: distrib_left exp_add mult.commute)
  1158 
  1159 lemma exp_setsum: "finite I \<Longrightarrow> exp(setsum f I) = setprod (\<lambda>x. exp(f x)) I"
  1160   by (induction I rule: finite_induct) (auto simp: exp_add_commuting mult.commute)
  1161 
  1162 
  1163 subsubsection {* Properties of the Exponential Function on Reals *}
  1164 
  1165 text {* Comparisons of @{term "exp x"} with zero. *}
  1166 
  1167 text{*Proof: because every exponential can be seen as a square.*}
  1168 lemma exp_ge_zero [simp]: "0 \<le> exp (x::real)"
  1169 proof -
  1170   have "0 \<le> exp (x/2) * exp (x/2)" by simp
  1171   thus ?thesis by (simp add: exp_add [symmetric])
  1172 qed
  1173 
  1174 lemma exp_gt_zero [simp]: "0 < exp (x::real)"
  1175   by (simp add: order_less_le)
  1176 
  1177 lemma not_exp_less_zero [simp]: "\<not> exp (x::real) < 0"
  1178   by (simp add: not_less)
  1179 
  1180 lemma not_exp_le_zero [simp]: "\<not> exp (x::real) \<le> 0"
  1181   by (simp add: not_le)
  1182 
  1183 lemma abs_exp_cancel [simp]: "\<bar>exp x::real\<bar> = exp x"
  1184   by simp
  1185 
  1186 (*FIXME: superseded by exp_of_nat_mult*)
  1187 lemma exp_real_of_nat_mult: "exp(real n * x) = exp(x) ^ n"
  1188   by (induct n) (auto simp add: real_of_nat_Suc distrib_left exp_add mult.commute)
  1189 
  1190 text {* Strict monotonicity of exponential. *}
  1191 
  1192 lemma exp_ge_add_one_self_aux:
  1193   assumes "0 \<le> (x::real)" shows "1+x \<le> exp(x)"
  1194 using order_le_imp_less_or_eq [OF assms]
  1195 proof
  1196   assume "0 < x"
  1197   have "1+x \<le> (\<Sum>n<2. inverse (fact n) * x^n)"
  1198     by (auto simp add: numeral_2_eq_2)
  1199   also have "... \<le> (\<Sum>n. inverse (fact n) * x^n)"
  1200     apply (rule setsum_le_suminf [OF summable_exp])
  1201     using `0 < x`
  1202     apply (auto  simp add:  zero_le_mult_iff)
  1203     done
  1204   finally show "1+x \<le> exp x"
  1205     by (simp add: exp_def)
  1206 next
  1207   assume "0 = x"
  1208   then show "1 + x \<le> exp x"
  1209     by auto
  1210 qed
  1211 
  1212 lemma exp_gt_one: "0 < (x::real) \<Longrightarrow> 1 < exp x"
  1213 proof -
  1214   assume x: "0 < x"
  1215   hence "1 < 1 + x" by simp
  1216   also from x have "1 + x \<le> exp x"
  1217     by (simp add: exp_ge_add_one_self_aux)
  1218   finally show ?thesis .
  1219 qed
  1220 
  1221 lemma exp_less_mono:
  1222   fixes x y :: real
  1223   assumes "x < y"
  1224   shows "exp x < exp y"
  1225 proof -
  1226   from `x < y` have "0 < y - x" by simp
  1227   hence "1 < exp (y - x)" by (rule exp_gt_one)
  1228   hence "1 < exp y / exp x" by (simp only: exp_diff)
  1229   thus "exp x < exp y" by simp
  1230 qed
  1231 
  1232 lemma exp_less_cancel: "exp (x::real) < exp y \<Longrightarrow> x < y"
  1233   unfolding linorder_not_le [symmetric]
  1234   by (auto simp add: order_le_less exp_less_mono)
  1235 
  1236 lemma exp_less_cancel_iff [iff]: "exp (x::real) < exp y \<longleftrightarrow> x < y"
  1237   by (auto intro: exp_less_mono exp_less_cancel)
  1238 
  1239 lemma exp_le_cancel_iff [iff]: "exp (x::real) \<le> exp y \<longleftrightarrow> x \<le> y"
  1240   by (auto simp add: linorder_not_less [symmetric])
  1241 
  1242 lemma exp_inj_iff [iff]: "exp (x::real) = exp y \<longleftrightarrow> x = y"
  1243   by (simp add: order_eq_iff)
  1244 
  1245 text {* Comparisons of @{term "exp x"} with one. *}
  1246 
  1247 lemma one_less_exp_iff [simp]: "1 < exp (x::real) \<longleftrightarrow> 0 < x"
  1248   using exp_less_cancel_iff [where x=0 and y=x] by simp
  1249 
  1250 lemma exp_less_one_iff [simp]: "exp (x::real) < 1 \<longleftrightarrow> x < 0"
  1251   using exp_less_cancel_iff [where x=x and y=0] by simp
  1252 
  1253 lemma one_le_exp_iff [simp]: "1 \<le> exp (x::real) \<longleftrightarrow> 0 \<le> x"
  1254   using exp_le_cancel_iff [where x=0 and y=x] by simp
  1255 
  1256 lemma exp_le_one_iff [simp]: "exp (x::real) \<le> 1 \<longleftrightarrow> x \<le> 0"
  1257   using exp_le_cancel_iff [where x=x and y=0] by simp
  1258 
  1259 lemma exp_eq_one_iff [simp]: "exp (x::real) = 1 \<longleftrightarrow> x = 0"
  1260   using exp_inj_iff [where x=x and y=0] by simp
  1261 
  1262 lemma lemma_exp_total: "1 \<le> y \<Longrightarrow> \<exists>x. 0 \<le> x & x \<le> y - 1 & exp(x::real) = y"
  1263 proof (rule IVT)
  1264   assume "1 \<le> y"
  1265   hence "0 \<le> y - 1" by simp
  1266   hence "1 + (y - 1) \<le> exp (y - 1)" by (rule exp_ge_add_one_self_aux)
  1267   thus "y \<le> exp (y - 1)" by simp
  1268 qed (simp_all add: le_diff_eq)
  1269 
  1270 lemma exp_total: "0 < (y::real) \<Longrightarrow> \<exists>x. exp x = y"
  1271 proof (rule linorder_le_cases [of 1 y])
  1272   assume "1 \<le> y"
  1273   thus "\<exists>x. exp x = y" by (fast dest: lemma_exp_total)
  1274 next
  1275   assume "0 < y" and "y \<le> 1"
  1276   hence "1 \<le> inverse y" by (simp add: one_le_inverse_iff)
  1277   then obtain x where "exp x = inverse y" by (fast dest: lemma_exp_total)
  1278   hence "exp (- x) = y" by (simp add: exp_minus)
  1279   thus "\<exists>x. exp x = y" ..
  1280 qed
  1281 
  1282 
  1283 subsection {* Natural Logarithm *}
  1284 
  1285 definition ln :: "real \<Rightarrow> real"
  1286   where "ln x = (THE u. exp u = x)"
  1287 
  1288 lemma ln_exp [simp]: "ln (exp x) = x"
  1289   by (simp add: ln_def)
  1290 
  1291 lemma exp_ln [simp]: "0 < x \<Longrightarrow> exp (ln x) = x"
  1292   by (auto dest: exp_total)
  1293 
  1294 lemma exp_ln_iff [simp]: "exp (ln x) = x \<longleftrightarrow> 0 < x"
  1295   by (metis exp_gt_zero exp_ln)
  1296 
  1297 lemma ln_unique: "exp y = x \<Longrightarrow> ln x = y"
  1298   by (erule subst, rule ln_exp)
  1299 
  1300 lemma ln_one [simp]: "ln 1 = 0"
  1301   by (rule ln_unique) simp
  1302 
  1303 lemma ln_mult: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> ln (x * y) = ln x + ln y"
  1304   by (rule ln_unique) (simp add: exp_add)
  1305 
  1306 lemma ln_setprod:
  1307     "\<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"
  1308   by (induction I rule: finite_induct) (auto simp: ln_mult setprod_pos)
  1309 
  1310 lemma ln_inverse: "0 < x \<Longrightarrow> ln (inverse x) = - ln x"
  1311   by (rule ln_unique) (simp add: exp_minus)
  1312 
  1313 lemma ln_div: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> ln (x / y) = ln x - ln y"
  1314   by (rule ln_unique) (simp add: exp_diff)
  1315 
  1316 lemma ln_realpow: "0 < x \<Longrightarrow> ln (x^n) = real n * ln x"
  1317   by (rule ln_unique) (simp add: exp_real_of_nat_mult)
  1318 
  1319 lemma ln_less_cancel_iff [simp]: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> ln x < ln y \<longleftrightarrow> x < y"
  1320   by (subst exp_less_cancel_iff [symmetric]) simp
  1321 
  1322 lemma ln_le_cancel_iff [simp]: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> ln x \<le> ln y \<longleftrightarrow> x \<le> y"
  1323   by (simp add: linorder_not_less [symmetric])
  1324 
  1325 lemma ln_inj_iff [simp]: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> ln x = ln y \<longleftrightarrow> x = y"
  1326   by (simp add: order_eq_iff)
  1327 
  1328 lemma ln_add_one_self_le_self [simp]: "0 \<le> x \<Longrightarrow> ln (1 + x) \<le> x"
  1329   apply (rule exp_le_cancel_iff [THEN iffD1])
  1330   apply (simp add: exp_ge_add_one_self_aux)
  1331   done
  1332 
  1333 lemma ln_less_self [simp]: "0 < x \<Longrightarrow> ln x < x"
  1334   by (rule order_less_le_trans [where y="ln (1 + x)"]) simp_all
  1335 
  1336 lemma ln_ge_zero [simp]: "1 \<le> x \<Longrightarrow> 0 \<le> ln x"
  1337   using ln_le_cancel_iff [of 1 x] by simp
  1338 
  1339 lemma ln_ge_zero_imp_ge_one: "0 \<le> ln x \<Longrightarrow> 0 < x \<Longrightarrow> 1 \<le> x"
  1340   using ln_le_cancel_iff [of 1 x] by simp
  1341 
  1342 lemma ln_ge_zero_iff [simp]: "0 < x \<Longrightarrow> 0 \<le> ln x \<longleftrightarrow> 1 \<le> x"
  1343   using ln_le_cancel_iff [of 1 x] by simp
  1344 
  1345 lemma ln_less_zero_iff [simp]: "0 < x \<Longrightarrow> ln x < 0 \<longleftrightarrow> x < 1"
  1346   using ln_less_cancel_iff [of x 1] by simp
  1347 
  1348 lemma ln_gt_zero: "1 < x \<Longrightarrow> 0 < ln x"
  1349   using ln_less_cancel_iff [of 1 x] by simp
  1350 
  1351 lemma ln_gt_zero_imp_gt_one: "0 < ln x \<Longrightarrow> 0 < x \<Longrightarrow> 1 < x"
  1352   using ln_less_cancel_iff [of 1 x] by simp
  1353 
  1354 lemma ln_gt_zero_iff [simp]: "0 < x \<Longrightarrow> 0 < ln x \<longleftrightarrow> 1 < x"
  1355   using ln_less_cancel_iff [of 1 x] by simp
  1356 
  1357 lemma ln_eq_zero_iff [simp]: "0 < x \<Longrightarrow> ln x = 0 \<longleftrightarrow> x = 1"
  1358   using ln_inj_iff [of x 1] by simp
  1359 
  1360 lemma ln_less_zero: "0 < x \<Longrightarrow> x < 1 \<Longrightarrow> ln x < 0"
  1361   by simp
  1362 
  1363 lemma ln_neg_is_const: "x \<le> 0 \<Longrightarrow> ln x = (THE x. False)"
  1364   by (auto simp add: ln_def intro!: arg_cong[where f=The])
  1365 
  1366 lemma isCont_ln: assumes "x \<noteq> 0" shows "isCont ln x"
  1367 proof cases
  1368   assume "0 < x"
  1369   moreover then have "isCont ln (exp (ln x))"
  1370     by (intro isCont_inv_fun[where d="\<bar>x\<bar>" and f=exp]) auto
  1371   ultimately show ?thesis
  1372     by simp
  1373 next
  1374   assume "\<not> 0 < x" with `x \<noteq> 0` show "isCont ln x"
  1375     unfolding isCont_def
  1376     by (subst filterlim_cong[OF _ refl, of _ "nhds (ln 0)" _ "\<lambda>_. ln 0"])
  1377        (auto simp: ln_neg_is_const not_less eventually_at dist_real_def
  1378                 intro!: exI[of _ "\<bar>x\<bar>"])
  1379 qed
  1380 
  1381 lemma tendsto_ln [tendsto_intros]:
  1382   "(f ---> a) F \<Longrightarrow> a \<noteq> 0 \<Longrightarrow> ((\<lambda>x. ln (f x)) ---> ln a) F"
  1383   by (rule isCont_tendsto_compose [OF isCont_ln])
  1384 
  1385 lemma continuous_ln:
  1386   "continuous F f \<Longrightarrow> f (Lim F (\<lambda>x. x)) \<noteq> 0 \<Longrightarrow> continuous F (\<lambda>x. ln (f x))"
  1387   unfolding continuous_def by (rule tendsto_ln)
  1388 
  1389 lemma isCont_ln' [continuous_intros]:
  1390   "continuous (at x) f \<Longrightarrow> f x \<noteq> 0 \<Longrightarrow> continuous (at x) (\<lambda>x. ln (f x))"
  1391   unfolding continuous_at by (rule tendsto_ln)
  1392 
  1393 lemma continuous_within_ln [continuous_intros]:
  1394   "continuous (at x within s) f \<Longrightarrow> f x \<noteq> 0 \<Longrightarrow> continuous (at x within s) (\<lambda>x. ln (f x))"
  1395   unfolding continuous_within by (rule tendsto_ln)
  1396 
  1397 lemma continuous_on_ln [continuous_intros]:
  1398   "continuous_on s f \<Longrightarrow> (\<forall>x\<in>s. f x \<noteq> 0) \<Longrightarrow> continuous_on s (\<lambda>x. ln (f x))"
  1399   unfolding continuous_on_def by (auto intro: tendsto_ln)
  1400 
  1401 lemma DERIV_ln: "0 < x \<Longrightarrow> DERIV ln x :> inverse x"
  1402   apply (rule DERIV_inverse_function [where f=exp and a=0 and b="x+1"])
  1403   apply (auto intro: DERIV_cong [OF DERIV_exp exp_ln] isCont_ln)
  1404   done
  1405 
  1406 lemma DERIV_ln_divide: "0 < x \<Longrightarrow> DERIV ln x :> 1 / x"
  1407   by (rule DERIV_ln[THEN DERIV_cong], simp, simp add: divide_inverse)
  1408 
  1409 declare DERIV_ln_divide[THEN DERIV_chain2, derivative_intros]
  1410 
  1411 lemma ln_series:
  1412   assumes "0 < x" and "x < 2"
  1413   shows "ln x = (\<Sum> n. (-1)^n * (1 / real (n + 1)) * (x - 1)^(Suc n))"
  1414   (is "ln x = suminf (?f (x - 1))")
  1415 proof -
  1416   let ?f' = "\<lambda>x n. (-1)^n * (x - 1)^n"
  1417 
  1418   have "ln x - suminf (?f (x - 1)) = ln 1 - suminf (?f (1 - 1))"
  1419   proof (rule DERIV_isconst3[where x=x])
  1420     fix x :: real
  1421     assume "x \<in> {0 <..< 2}"
  1422     hence "0 < x" and "x < 2" by auto
  1423     have "norm (1 - x) < 1"
  1424       using `0 < x` and `x < 2` by auto
  1425     have "1 / x = 1 / (1 - (1 - x))" by auto
  1426     also have "\<dots> = (\<Sum> n. (1 - x)^n)"
  1427       using geometric_sums[OF `norm (1 - x) < 1`] by (rule sums_unique)
  1428     also have "\<dots> = suminf (?f' x)"
  1429       unfolding power_mult_distrib[symmetric]
  1430       by (rule arg_cong[where f=suminf], rule arg_cong[where f="op ^"], auto)
  1431     finally have "DERIV ln x :> suminf (?f' x)"
  1432       using DERIV_ln[OF `0 < x`] unfolding divide_inverse by auto
  1433     moreover
  1434     have repos: "\<And> h x :: real. h - 1 + x = h + x - 1" by auto
  1435     have "DERIV (\<lambda>x. suminf (?f x)) (x - 1) :>
  1436       (\<Sum>n. (-1)^n * (1 / real (n + 1)) * real (Suc n) * (x - 1) ^ n)"
  1437     proof (rule DERIV_power_series')
  1438       show "x - 1 \<in> {- 1<..<1}" and "(0 :: real) < 1"
  1439         using `0 < x` `x < 2` by auto
  1440       fix x :: real
  1441       assume "x \<in> {- 1<..<1}"
  1442       hence "norm (-x) < 1" by auto
  1443       show "summable (\<lambda>n. (- 1) ^ n * (1 / real (n + 1)) * real (Suc n) * x^n)"
  1444         unfolding One_nat_def
  1445         by (auto simp add: power_mult_distrib[symmetric] summable_geometric[OF `norm (-x) < 1`])
  1446     qed
  1447     hence "DERIV (\<lambda>x. suminf (?f x)) (x - 1) :> suminf (?f' x)"
  1448       unfolding One_nat_def by auto
  1449     hence "DERIV (\<lambda>x. suminf (?f (x - 1))) x :> suminf (?f' x)"
  1450       unfolding DERIV_def repos .
  1451     ultimately have "DERIV (\<lambda>x. ln x - suminf (?f (x - 1))) x :> (suminf (?f' x) - suminf (?f' x))"
  1452       by (rule DERIV_diff)
  1453     thus "DERIV (\<lambda>x. ln x - suminf (?f (x - 1))) x :> 0" by auto
  1454   qed (auto simp add: assms)
  1455   thus ?thesis by auto
  1456 qed
  1457 
  1458 lemma exp_first_two_terms:
  1459   fixes x :: "'a::{real_normed_field,banach}"
  1460   shows "exp x = 1 + x + (\<Sum> n. inverse(fact (n+2)) * (x ^ (n+2)))"
  1461 proof -
  1462   have "exp x = suminf (\<lambda>n. inverse(fact n) * (x^n))"
  1463     by (simp add: exp_def scaleR_conv_of_real nonzero_of_real_inverse)
  1464   also from summable_exp have "... = (\<Sum> n. inverse(fact(n+2)) * (x ^ (n+2))) +
  1465     (\<Sum> n::nat<2. inverse(fact n) * (x^n))" (is "_ = _ + ?a")
  1466     by (rule suminf_split_initial_segment)
  1467   also have "?a = 1 + x"
  1468     by (simp add: numeral_2_eq_2)
  1469   finally show ?thesis
  1470     by simp
  1471 qed
  1472 
  1473 lemma exp_bound: "0 <= (x::real) \<Longrightarrow> x <= 1 \<Longrightarrow> exp x <= 1 + x + x\<^sup>2"
  1474 proof -
  1475   assume a: "0 <= x"
  1476   assume b: "x <= 1"
  1477   {
  1478     fix n :: nat
  1479     have "(2::nat) * 2 ^ n \<le> fact (n + 2)"
  1480       by (induct n) simp_all
  1481     hence "real ((2::nat) * 2 ^ n) \<le> real_of_nat (fact (n + 2))"
  1482       by (simp only: real_of_nat_le_iff)
  1483     hence "((2::real) * 2 ^ n) \<le> fact (n + 2)"
  1484       unfolding of_nat_fact real_of_nat_def
  1485       by (simp add: of_nat_mult of_nat_power)
  1486     hence "inverse (fact (n + 2)) \<le> inverse ((2::real) * 2 ^ n)"
  1487       by (rule le_imp_inverse_le) simp
  1488     hence "inverse (fact (n + 2)) \<le> 1/(2::real) * (1/2)^n"
  1489       by (simp add: power_inverse)
  1490     hence "inverse (fact (n + 2)) * (x^n * x\<^sup>2) \<le> 1/2 * (1/2)^n * (1 * x\<^sup>2)"
  1491       by (rule mult_mono)
  1492         (rule mult_mono, simp_all add: power_le_one a b)
  1493     hence "inverse (fact (n + 2)) * x ^ (n + 2) \<le> (x\<^sup>2/2) * ((1/2)^n)"
  1494       unfolding power_add by (simp add: ac_simps del: fact.simps) }
  1495   note aux1 = this
  1496   have "(\<lambda>n. x\<^sup>2 / 2 * (1 / 2) ^ n) sums (x\<^sup>2 / 2 * (1 / (1 - 1 / 2)))"
  1497     by (intro sums_mult geometric_sums, simp)
  1498   hence aux2: "(\<lambda>n. x\<^sup>2 / 2 * (1 / 2) ^ n) sums x\<^sup>2"
  1499     by simp
  1500   have "suminf (\<lambda>n. inverse(fact (n+2)) * (x ^ (n+2))) <= x\<^sup>2"
  1501   proof -
  1502     have "suminf (\<lambda>n. inverse(fact (n+2)) * (x ^ (n+2))) <=
  1503         suminf (\<lambda>n. (x\<^sup>2/2) * ((1/2)^n))"
  1504       apply (rule suminf_le)
  1505       apply (rule allI, rule aux1)
  1506       apply (rule summable_exp [THEN summable_ignore_initial_segment])
  1507       by (rule sums_summable, rule aux2)
  1508     also have "... = x\<^sup>2"
  1509       by (rule sums_unique [THEN sym], rule aux2)
  1510     finally show ?thesis .
  1511   qed
  1512   thus ?thesis unfolding exp_first_two_terms by auto
  1513 qed
  1514 
  1515 corollary exp_half_le2: "exp(1/2) \<le> (2::real)"
  1516   using exp_bound [of "1/2"]
  1517   by (simp add: field_simps)
  1518 
  1519 corollary exp_le: "exp 1 \<le> (3::real)"
  1520   using exp_bound [of 1]
  1521   by (simp add: field_simps)
  1522 
  1523 lemma exp_bound_half: "norm(z) \<le> 1/2 \<Longrightarrow> norm(exp z) \<le> 2"
  1524   by (blast intro: order_trans intro!: exp_half_le2 norm_exp)
  1525 
  1526 lemma exp_bound_lemma:
  1527   assumes "norm(z) \<le> 1/2" shows "norm(exp z) \<le> 1 + 2 * norm(z)"
  1528 proof -
  1529   have n: "(norm z)\<^sup>2 \<le> norm z * 1"
  1530     unfolding power2_eq_square
  1531     apply (rule mult_left_mono)
  1532     using assms
  1533     apply (auto simp: )
  1534     done
  1535   show ?thesis
  1536     apply (rule order_trans [OF norm_exp])
  1537     apply (rule order_trans [OF exp_bound])
  1538     using assms n
  1539     apply (auto simp: )
  1540     done
  1541 qed
  1542 
  1543 lemma real_exp_bound_lemma:
  1544   fixes x :: real
  1545   shows "0 \<le> x \<Longrightarrow> x \<le> 1/2 \<Longrightarrow> exp(x) \<le> 1 + 2 * x"
  1546 using exp_bound_lemma [of x]
  1547 by simp
  1548 
  1549 lemma ln_one_minus_pos_upper_bound: "0 <= x \<Longrightarrow> x < 1 \<Longrightarrow> ln (1 - x) <= - x"
  1550 proof -
  1551   assume a: "0 <= (x::real)" and b: "x < 1"
  1552   have "(1 - x) * (1 + x + x\<^sup>2) = (1 - x^3)"
  1553     by (simp add: algebra_simps power2_eq_square power3_eq_cube)
  1554   also have "... <= 1"
  1555     by (auto simp add: a)
  1556   finally have "(1 - x) * (1 + x + x\<^sup>2) <= 1" .
  1557   moreover have c: "0 < 1 + x + x\<^sup>2"
  1558     by (simp add: add_pos_nonneg a)
  1559   ultimately have "1 - x <= 1 / (1 + x + x\<^sup>2)"
  1560     by (elim mult_imp_le_div_pos)
  1561   also have "... <= 1 / exp x"
  1562     by (metis a abs_one b exp_bound exp_gt_zero frac_le less_eq_real_def real_sqrt_abs
  1563               real_sqrt_pow2_iff real_sqrt_power)
  1564   also have "... = exp (-x)"
  1565     by (auto simp add: exp_minus divide_inverse)
  1566   finally have "1 - x <= exp (- x)" .
  1567   also have "1 - x = exp (ln (1 - x))"
  1568     by (metis b diff_0 exp_ln_iff less_iff_diff_less_0 minus_diff_eq)
  1569   finally have "exp (ln (1 - x)) <= exp (- x)" .
  1570   thus ?thesis by (auto simp only: exp_le_cancel_iff)
  1571 qed
  1572 
  1573 lemma exp_ge_add_one_self [simp]: "1 + (x::real) <= exp x"
  1574   apply (case_tac "0 <= x")
  1575   apply (erule exp_ge_add_one_self_aux)
  1576   apply (case_tac "x <= -1")
  1577   apply (subgoal_tac "1 + x <= 0")
  1578   apply (erule order_trans)
  1579   apply simp
  1580   apply simp
  1581   apply (subgoal_tac "1 + x = exp(ln (1 + x))")
  1582   apply (erule ssubst)
  1583   apply (subst exp_le_cancel_iff)
  1584   apply (subgoal_tac "ln (1 - (- x)) <= - (- x)")
  1585   apply simp
  1586   apply (rule ln_one_minus_pos_upper_bound)
  1587   apply auto
  1588 done
  1589 
  1590 lemma ln_one_plus_pos_lower_bound: "0 <= x \<Longrightarrow> x <= 1 \<Longrightarrow> x - x\<^sup>2 <= ln (1 + x)"
  1591 proof -
  1592   assume a: "0 <= x" and b: "x <= 1"
  1593   have "exp (x - x\<^sup>2) = exp x / exp (x\<^sup>2)"
  1594     by (rule exp_diff)
  1595   also have "... <= (1 + x + x\<^sup>2) / exp (x \<^sup>2)"
  1596     by (metis a b divide_right_mono exp_bound exp_ge_zero)
  1597   also have "... <= (1 + x + x\<^sup>2) / (1 + x\<^sup>2)"
  1598     by (simp add: a divide_left_mono add_pos_nonneg)
  1599   also from a have "... <= 1 + x"
  1600     by (simp add: field_simps add_strict_increasing zero_le_mult_iff)
  1601   finally have "exp (x - x\<^sup>2) <= 1 + x" .
  1602   also have "... = exp (ln (1 + x))"
  1603   proof -
  1604     from a have "0 < 1 + x" by auto
  1605     thus ?thesis
  1606       by (auto simp only: exp_ln_iff [THEN sym])
  1607   qed
  1608   finally have "exp (x - x\<^sup>2) <= exp (ln (1 + x))" .
  1609   thus ?thesis
  1610     by (metis exp_le_cancel_iff)
  1611 qed
  1612 
  1613 lemma ln_one_minus_pos_lower_bound:
  1614   "0 <= x \<Longrightarrow> x <= (1 / 2) \<Longrightarrow> - x - 2 * x\<^sup>2 <= ln (1 - x)"
  1615 proof -
  1616   assume a: "0 <= x" and b: "x <= (1 / 2)"
  1617   from b have c: "x < 1" by auto
  1618   then have "ln (1 - x) = - ln (1 + x / (1 - x))"
  1619     apply (subst ln_inverse [symmetric])
  1620     apply (simp add: field_simps)
  1621     apply (rule arg_cong [where f=ln])
  1622     apply (simp add: field_simps)
  1623     done
  1624   also have "- (x / (1 - x)) <= ..."
  1625   proof -
  1626     have "ln (1 + x / (1 - x)) <= x / (1 - x)"
  1627       using a c by (intro ln_add_one_self_le_self) auto
  1628     thus ?thesis
  1629       by auto
  1630   qed
  1631   also have "- (x / (1 - x)) = -x / (1 - x)"
  1632     by auto
  1633   finally have d: "- x / (1 - x) <= ln (1 - x)" .
  1634   have "0 < 1 - x" using a b by simp
  1635   hence e: "-x - 2 * x\<^sup>2 <= - x / (1 - x)"
  1636     using mult_right_le_one_le[of "x*x" "2*x"] a b
  1637     by (simp add: field_simps power2_eq_square)
  1638   from e d show "- x - 2 * x\<^sup>2 <= ln (1 - x)"
  1639     by (rule order_trans)
  1640 qed
  1641 
  1642 lemma ln_add_one_self_le_self2: "-1 < x \<Longrightarrow> ln(1 + x) <= x"
  1643   apply (subgoal_tac "ln (1 + x) \<le> ln (exp x)", simp)
  1644   apply (subst ln_le_cancel_iff)
  1645   apply auto
  1646   done
  1647 
  1648 lemma abs_ln_one_plus_x_minus_x_bound_nonneg:
  1649   "0 <= x \<Longrightarrow> x <= 1 \<Longrightarrow> abs(ln (1 + x) - x) <= x\<^sup>2"
  1650 proof -
  1651   assume x: "0 <= x"
  1652   assume x1: "x <= 1"
  1653   from x have "ln (1 + x) <= x"
  1654     by (rule ln_add_one_self_le_self)
  1655   then have "ln (1 + x) - x <= 0"
  1656     by simp
  1657   then have "abs(ln(1 + x) - x) = - (ln(1 + x) - x)"
  1658     by (rule abs_of_nonpos)
  1659   also have "... = x - ln (1 + x)"
  1660     by simp
  1661   also have "... <= x\<^sup>2"
  1662   proof -
  1663     from x x1 have "x - x\<^sup>2 <= ln (1 + x)"
  1664       by (intro ln_one_plus_pos_lower_bound)
  1665     thus ?thesis
  1666       by simp
  1667   qed
  1668   finally show ?thesis .
  1669 qed
  1670 
  1671 lemma abs_ln_one_plus_x_minus_x_bound_nonpos:
  1672   "-(1 / 2) <= x \<Longrightarrow> x <= 0 \<Longrightarrow> abs(ln (1 + x) - x) <= 2 * x\<^sup>2"
  1673 proof -
  1674   assume a: "-(1 / 2) <= x"
  1675   assume b: "x <= 0"
  1676   have "abs(ln (1 + x) - x) = x - ln(1 - (-x))"
  1677     apply (subst abs_of_nonpos)
  1678     apply simp
  1679     apply (rule ln_add_one_self_le_self2)
  1680     using a apply auto
  1681     done
  1682   also have "... <= 2 * x\<^sup>2"
  1683     apply (subgoal_tac "- (-x) - 2 * (-x)\<^sup>2 <= ln (1 - (-x))")
  1684     apply (simp add: algebra_simps)
  1685     apply (rule ln_one_minus_pos_lower_bound)
  1686     using a b apply auto
  1687     done
  1688   finally show ?thesis .
  1689 qed
  1690 
  1691 lemma abs_ln_one_plus_x_minus_x_bound:
  1692     "abs x <= 1 / 2 \<Longrightarrow> abs(ln (1 + x) - x) <= 2 * x\<^sup>2"
  1693   apply (case_tac "0 <= x")
  1694   apply (rule order_trans)
  1695   apply (rule abs_ln_one_plus_x_minus_x_bound_nonneg)
  1696   apply auto
  1697   apply (rule abs_ln_one_plus_x_minus_x_bound_nonpos)
  1698   apply auto
  1699   done
  1700 
  1701 lemma ln_x_over_x_mono: "exp 1 <= x \<Longrightarrow> x <= y \<Longrightarrow> (ln y / y) <= (ln x / x)"
  1702 proof -
  1703   assume x: "exp 1 <= x" "x <= y"
  1704   moreover have "0 < exp (1::real)" by simp
  1705   ultimately have a: "0 < x" and b: "0 < y"
  1706     by (fast intro: less_le_trans order_trans)+
  1707   have "x * ln y - x * ln x = x * (ln y - ln x)"
  1708     by (simp add: algebra_simps)
  1709   also have "... = x * ln(y / x)"
  1710     by (simp only: ln_div a b)
  1711   also have "y / x = (x + (y - x)) / x"
  1712     by simp
  1713   also have "... = 1 + (y - x) / x"
  1714     using x a by (simp add: field_simps)
  1715   also have "x * ln(1 + (y - x) / x) <= x * ((y - x) / x)"
  1716     using x a
  1717     by (intro mult_left_mono ln_add_one_self_le_self) simp_all
  1718   also have "... = y - x" using a by simp
  1719   also have "... = (y - x) * ln (exp 1)" by simp
  1720   also have "... <= (y - x) * ln x"
  1721     apply (rule mult_left_mono)
  1722     apply (subst ln_le_cancel_iff)
  1723     apply fact
  1724     apply (rule a)
  1725     apply (rule x)
  1726     using x apply simp
  1727     done
  1728   also have "... = y * ln x - x * ln x"
  1729     by (rule left_diff_distrib)
  1730   finally have "x * ln y <= y * ln x"
  1731     by arith
  1732   then have "ln y <= (y * ln x) / x" using a by (simp add: field_simps)
  1733   also have "... = y * (ln x / x)" by simp
  1734   finally show ?thesis using b by (simp add: field_simps)
  1735 qed
  1736 
  1737 lemma ln_le_minus_one: "0 < x \<Longrightarrow> ln x \<le> x - 1"
  1738   using exp_ge_add_one_self[of "ln x"] by simp
  1739 
  1740 lemma ln_eq_minus_one:
  1741   assumes "0 < x" "ln x = x - 1"
  1742   shows "x = 1"
  1743 proof -
  1744   let ?l = "\<lambda>y. ln y - y + 1"
  1745   have D: "\<And>x. 0 < x \<Longrightarrow> DERIV ?l x :> (1 / x - 1)"
  1746     by (auto intro!: derivative_eq_intros)
  1747 
  1748   show ?thesis
  1749   proof (cases rule: linorder_cases)
  1750     assume "x < 1"
  1751     from dense[OF `x < 1`] obtain a where "x < a" "a < 1" by blast
  1752     from `x < a` have "?l x < ?l a"
  1753     proof (rule DERIV_pos_imp_increasing, safe)
  1754       fix y
  1755       assume "x \<le> y" "y \<le> a"
  1756       with `0 < x` `a < 1` have "0 < 1 / y - 1" "0 < y"
  1757         by (auto simp: field_simps)
  1758       with D show "\<exists>z. DERIV ?l y :> z \<and> 0 < z"
  1759         by auto
  1760     qed
  1761     also have "\<dots> \<le> 0"
  1762       using ln_le_minus_one `0 < x` `x < a` by (auto simp: field_simps)
  1763     finally show "x = 1" using assms by auto
  1764   next
  1765     assume "1 < x"
  1766     from dense[OF this] obtain a where "1 < a" "a < x" by blast
  1767     from `a < x` have "?l x < ?l a"
  1768     proof (rule DERIV_neg_imp_decreasing, safe)
  1769       fix y
  1770       assume "a \<le> y" "y \<le> x"
  1771       with `1 < a` have "1 / y - 1 < 0" "0 < y"
  1772         by (auto simp: field_simps)
  1773       with D show "\<exists>z. DERIV ?l y :> z \<and> z < 0"
  1774         by blast
  1775     qed
  1776     also have "\<dots> \<le> 0"
  1777       using ln_le_minus_one `1 < a` by (auto simp: field_simps)
  1778     finally show "x = 1" using assms by auto
  1779   next
  1780     assume "x = 1"
  1781     then show ?thesis by simp
  1782   qed
  1783 qed
  1784 
  1785 lemma exp_at_bot: "(exp ---> (0::real)) at_bot"
  1786   unfolding tendsto_Zfun_iff
  1787 proof (rule ZfunI, simp add: eventually_at_bot_dense)
  1788   fix r :: real assume "0 < r"
  1789   {
  1790     fix x
  1791     assume "x < ln r"
  1792     then have "exp x < exp (ln r)"
  1793       by simp
  1794     with `0 < r` have "exp x < r"
  1795       by simp
  1796   }
  1797   then show "\<exists>k. \<forall>n<k. exp n < r" by auto
  1798 qed
  1799 
  1800 lemma exp_at_top: "LIM x at_top. exp x :: real :> at_top"
  1801   by (rule filterlim_at_top_at_top[where Q="\<lambda>x. True" and P="\<lambda>x. 0 < x" and g="ln"])
  1802      (auto intro: eventually_gt_at_top)
  1803 
  1804 lemma lim_exp_minus_1:
  1805   fixes x :: "'a::{real_normed_field,banach}"
  1806   shows "((\<lambda>z::'a. (exp(z) - 1) / z) ---> 1) (at 0)"
  1807 proof -
  1808   have "((\<lambda>z::'a. exp(z) - 1) has_field_derivative 1) (at 0)"
  1809     by (intro derivative_eq_intros | simp)+
  1810   then show ?thesis
  1811     by (simp add: Deriv.DERIV_iff2)
  1812 qed
  1813 
  1814 lemma ln_at_0: "LIM x at_right 0. ln x :> at_bot"
  1815   by (rule filterlim_at_bot_at_right[where Q="\<lambda>x. 0 < x" and P="\<lambda>x. True" and g="exp"])
  1816      (auto simp: eventually_at_filter)
  1817 
  1818 lemma ln_at_top: "LIM x at_top. ln x :> at_top"
  1819   by (rule filterlim_at_top_at_top[where Q="\<lambda>x. 0 < x" and P="\<lambda>x. True" and g="exp"])
  1820      (auto intro: eventually_gt_at_top)
  1821 
  1822 lemma tendsto_power_div_exp_0: "((\<lambda>x. x ^ k / exp x) ---> (0::real)) at_top"
  1823 proof (induct k)
  1824   case 0
  1825   show "((\<lambda>x. x ^ 0 / exp x) ---> (0::real)) at_top"
  1826     by (simp add: inverse_eq_divide[symmetric])
  1827        (metis filterlim_compose[OF tendsto_inverse_0] exp_at_top filterlim_mono
  1828               at_top_le_at_infinity order_refl)
  1829 next
  1830   case (Suc k)
  1831   show ?case
  1832   proof (rule lhospital_at_top_at_top)
  1833     show "eventually (\<lambda>x. DERIV (\<lambda>x. x ^ Suc k) x :> (real (Suc k) * x^k)) at_top"
  1834       by eventually_elim (intro derivative_eq_intros, auto)
  1835     show "eventually (\<lambda>x. DERIV exp x :> exp x) at_top"
  1836       by eventually_elim auto
  1837     show "eventually (\<lambda>x. exp x \<noteq> 0) at_top"
  1838       by auto
  1839     from tendsto_mult[OF tendsto_const Suc, of "real (Suc k)"]
  1840     show "((\<lambda>x. real (Suc k) * x ^ k / exp x) ---> 0) at_top"
  1841       by simp
  1842   qed (rule exp_at_top)
  1843 qed
  1844 
  1845 
  1846 definition powr :: "[real,real] => real"  (infixr "powr" 80)
  1847   -- {*exponentation with real exponent*}
  1848   where "x powr a = exp(a * ln x)"
  1849 
  1850 definition log :: "[real,real] => real"
  1851   -- {*logarithm of @{term x} to base @{term a}*}
  1852   where "log a x = ln x / ln a"
  1853 
  1854 
  1855 lemma tendsto_log [tendsto_intros]:
  1856   "\<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"
  1857   unfolding log_def by (intro tendsto_intros) auto
  1858 
  1859 lemma continuous_log:
  1860   assumes "continuous F f"
  1861     and "continuous F g"
  1862     and "0 < f (Lim F (\<lambda>x. x))"
  1863     and "f (Lim F (\<lambda>x. x)) \<noteq> 1"
  1864     and "0 < g (Lim F (\<lambda>x. x))"
  1865   shows "continuous F (\<lambda>x. log (f x) (g x))"
  1866   using assms unfolding continuous_def by (rule tendsto_log)
  1867 
  1868 lemma continuous_at_within_log[continuous_intros]:
  1869   assumes "continuous (at a within s) f"
  1870     and "continuous (at a within s) g"
  1871     and "0 < f a"
  1872     and "f a \<noteq> 1"
  1873     and "0 < g a"
  1874   shows "continuous (at a within s) (\<lambda>x. log (f x) (g x))"
  1875   using assms unfolding continuous_within by (rule tendsto_log)
  1876 
  1877 lemma isCont_log[continuous_intros, simp]:
  1878   assumes "isCont f a" "isCont g a" "0 < f a" "f a \<noteq> 1" "0 < g a"
  1879   shows "isCont (\<lambda>x. log (f x) (g x)) a"
  1880   using assms unfolding continuous_at by (rule tendsto_log)
  1881 
  1882 lemma continuous_on_log[continuous_intros]:
  1883   assumes "continuous_on s f" "continuous_on s g"
  1884     and "\<forall>x\<in>s. 0 < f x" "\<forall>x\<in>s. f x \<noteq> 1" "\<forall>x\<in>s. 0 < g x"
  1885   shows "continuous_on s (\<lambda>x. log (f x) (g x))"
  1886   using assms unfolding continuous_on_def by (fast intro: tendsto_log)
  1887 
  1888 lemma powr_one_eq_one [simp]: "1 powr a = 1"
  1889   by (simp add: powr_def)
  1890 
  1891 lemma powr_zero_eq_one [simp]: "x powr 0 = 1"
  1892   by (simp add: powr_def)
  1893 
  1894 lemma powr_one_gt_zero_iff [simp]: "(x powr 1 = x) = (0 < x)"
  1895   by (simp add: powr_def)
  1896 declare powr_one_gt_zero_iff [THEN iffD2, simp]
  1897 
  1898 lemma powr_mult: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> (x * y) powr a = (x powr a) * (y powr a)"
  1899   by (simp add: powr_def exp_add [symmetric] ln_mult distrib_left)
  1900 
  1901 lemma powr_gt_zero [simp]: "0 < x powr a"
  1902   by (simp add: powr_def)
  1903 
  1904 lemma powr_ge_pzero [simp]: "0 <= x powr y"
  1905   by (rule order_less_imp_le, rule powr_gt_zero)
  1906 
  1907 lemma powr_not_zero [simp]: "x powr a \<noteq> 0"
  1908   by (simp add: powr_def)
  1909 
  1910 lemma powr_divide: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> (x / y) powr a = (x powr a) / (y powr a)"
  1911   apply (simp add: divide_inverse positive_imp_inverse_positive powr_mult)
  1912   apply (simp add: powr_def exp_minus [symmetric] exp_add [symmetric] ln_inverse)
  1913   done
  1914 
  1915 lemma powr_divide2: "x powr a / x powr b = x powr (a - b)"
  1916   apply (simp add: powr_def)
  1917   apply (subst exp_diff [THEN sym])
  1918   apply (simp add: left_diff_distrib)
  1919   done
  1920 
  1921 lemma powr_add: "x powr (a + b) = (x powr a) * (x powr b)"
  1922   by (simp add: powr_def exp_add [symmetric] distrib_right)
  1923 
  1924 lemma powr_mult_base: "0 < x \<Longrightarrow>x * x powr y = x powr (1 + y)"
  1925   using assms by (auto simp: powr_add)
  1926 
  1927 lemma powr_powr: "(x powr a) powr b = x powr (a * b)"
  1928   by (simp add: powr_def)
  1929 
  1930 lemma powr_powr_swap: "(x powr a) powr b = (x powr b) powr a"
  1931   by (simp add: powr_powr mult.commute)
  1932 
  1933 lemma powr_minus: "x powr (-a) = inverse (x powr a)"
  1934   by (simp add: powr_def exp_minus [symmetric])
  1935 
  1936 lemma powr_minus_divide: "x powr (-a) = 1/(x powr a)"
  1937   by (simp add: divide_inverse powr_minus)
  1938 
  1939 lemma divide_powr_uminus: "a / b powr c = a * b powr (- c)"
  1940   by (simp add: powr_minus_divide)
  1941 
  1942 lemma powr_less_mono: "a < b \<Longrightarrow> 1 < x \<Longrightarrow> x powr a < x powr b"
  1943   by (simp add: powr_def)
  1944 
  1945 lemma powr_less_cancel: "x powr a < x powr b \<Longrightarrow> 1 < x \<Longrightarrow> a < b"
  1946   by (simp add: powr_def)
  1947 
  1948 lemma powr_less_cancel_iff [simp]: "1 < x \<Longrightarrow> (x powr a < x powr b) = (a < b)"
  1949   by (blast intro: powr_less_cancel powr_less_mono)
  1950 
  1951 lemma powr_le_cancel_iff [simp]: "1 < x \<Longrightarrow> (x powr a \<le> x powr b) = (a \<le> b)"
  1952   by (simp add: linorder_not_less [symmetric])
  1953 
  1954 lemma log_ln: "ln x = log (exp(1)) x"
  1955   by (simp add: log_def)
  1956 
  1957 lemma DERIV_log:
  1958   assumes "x > 0"
  1959   shows "DERIV (\<lambda>y. log b y) x :> 1 / (ln b * x)"
  1960 proof -
  1961   def lb \<equiv> "1 / ln b"
  1962   moreover have "DERIV (\<lambda>y. lb * ln y) x :> lb / x"
  1963     using `x > 0` by (auto intro!: derivative_eq_intros)
  1964   ultimately show ?thesis
  1965     by (simp add: log_def)
  1966 qed
  1967 
  1968 lemmas DERIV_log[THEN DERIV_chain2, derivative_intros]
  1969 
  1970 lemma powr_log_cancel [simp]: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow> a powr (log a x) = x"
  1971   by (simp add: powr_def log_def)
  1972 
  1973 lemma log_powr_cancel [simp]: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> log a (a powr y) = y"
  1974   by (simp add: log_def powr_def)
  1975 
  1976 lemma log_mult:
  1977   "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow> 0 < y \<Longrightarrow>
  1978     log a (x * y) = log a x + log a y"
  1979   by (simp add: log_def ln_mult divide_inverse distrib_right)
  1980 
  1981 lemma log_eq_div_ln_mult_log:
  1982   "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> 0 < b \<Longrightarrow> b \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow>
  1983     log a x = (ln b/ln a) * log b x"
  1984   by (simp add: log_def divide_inverse)
  1985 
  1986 text{*Base 10 logarithms*}
  1987 lemma log_base_10_eq1: "0 < x \<Longrightarrow> log 10 x = (ln (exp 1) / ln 10) * ln x"
  1988   by (simp add: log_def)
  1989 
  1990 lemma log_base_10_eq2: "0 < x \<Longrightarrow> log 10 x = (log 10 (exp 1)) * ln x"
  1991   by (simp add: log_def)
  1992 
  1993 lemma log_one [simp]: "log a 1 = 0"
  1994   by (simp add: log_def)
  1995 
  1996 lemma log_eq_one [simp]: "[| 0 < a; a \<noteq> 1 |] ==> log a a = 1"
  1997   by (simp add: log_def)
  1998 
  1999 lemma log_inverse: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow> log a (inverse x) = - log a x"
  2000   apply (rule_tac a1 = "log a x" in add_left_cancel [THEN iffD1])
  2001   apply (simp add: log_mult [symmetric])
  2002   done
  2003 
  2004 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"
  2005   by (simp add: log_mult divide_inverse log_inverse)
  2006 
  2007 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)"
  2008   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)"
  2009   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)"
  2010   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)"
  2011   by (simp_all add: log_mult log_divide)
  2012 
  2013 lemma log_less_cancel_iff [simp]:
  2014   "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 0 < y \<Longrightarrow> log a x < log a y \<longleftrightarrow> x < y"
  2015   apply safe
  2016   apply (rule_tac [2] powr_less_cancel)
  2017   apply (drule_tac a = "log a x" in powr_less_mono, auto)
  2018   done
  2019 
  2020 lemma log_inj:
  2021   assumes "1 < b"
  2022   shows "inj_on (log b) {0 <..}"
  2023 proof (rule inj_onI, simp)
  2024   fix x y
  2025   assume pos: "0 < x" "0 < y" and *: "log b x = log b y"
  2026   show "x = y"
  2027   proof (cases rule: linorder_cases)
  2028     assume "x = y"
  2029     then show ?thesis by simp
  2030   next
  2031     assume "x < y" hence "log b x < log b y"
  2032       using log_less_cancel_iff[OF `1 < b`] pos by simp
  2033     then show ?thesis using * by simp
  2034   next
  2035     assume "y < x" hence "log b y < log b x"
  2036       using log_less_cancel_iff[OF `1 < b`] pos by simp
  2037     then show ?thesis using * by simp
  2038   qed
  2039 qed
  2040 
  2041 lemma log_le_cancel_iff [simp]:
  2042   "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 0 < y \<Longrightarrow> (log a x \<le> log a y) = (x \<le> y)"
  2043   by (simp add: linorder_not_less [symmetric])
  2044 
  2045 lemma zero_less_log_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 0 < log a x \<longleftrightarrow> 1 < x"
  2046   using log_less_cancel_iff[of a 1 x] by simp
  2047 
  2048 lemma zero_le_log_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 0 \<le> log a x \<longleftrightarrow> 1 \<le> x"
  2049   using log_le_cancel_iff[of a 1 x] by simp
  2050 
  2051 lemma log_less_zero_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> log a x < 0 \<longleftrightarrow> x < 1"
  2052   using log_less_cancel_iff[of a x 1] by simp
  2053 
  2054 lemma log_le_zero_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> log a x \<le> 0 \<longleftrightarrow> x \<le> 1"
  2055   using log_le_cancel_iff[of a x 1] by simp
  2056 
  2057 lemma one_less_log_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 1 < log a x \<longleftrightarrow> a < x"
  2058   using log_less_cancel_iff[of a a x] by simp
  2059 
  2060 lemma one_le_log_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 1 \<le> log a x \<longleftrightarrow> a \<le> x"
  2061   using log_le_cancel_iff[of a a x] by simp
  2062 
  2063 lemma log_less_one_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> log a x < 1 \<longleftrightarrow> x < a"
  2064   using log_less_cancel_iff[of a x a] by simp
  2065 
  2066 lemma log_le_one_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> log a x \<le> 1 \<longleftrightarrow> x \<le> a"
  2067   using log_le_cancel_iff[of a x a] by simp
  2068 
  2069 lemma le_log_iff:
  2070   assumes "1 < b" "x > 0"
  2071   shows "y \<le> log b x \<longleftrightarrow> b powr y \<le> x"
  2072   by (metis assms(1) assms(2) dual_order.strict_trans powr_le_cancel_iff powr_log_cancel
  2073     powr_one_eq_one powr_one_gt_zero_iff)
  2074 
  2075 lemma less_log_iff:
  2076   assumes "1 < b" "x > 0"
  2077   shows "y < log b x \<longleftrightarrow> b powr y < x"
  2078   by (metis assms(1) assms(2) dual_order.strict_trans less_irrefl powr_less_cancel_iff
  2079     powr_log_cancel zero_less_one)
  2080 
  2081 lemma
  2082   assumes "1 < b" "x > 0"
  2083   shows log_less_iff: "log b x < y \<longleftrightarrow> x < b powr y"
  2084     and log_le_iff: "log b x \<le> y \<longleftrightarrow> x \<le> b powr y"
  2085   using le_log_iff[OF assms, of y] less_log_iff[OF assms, of y]
  2086   by auto
  2087 
  2088 lemmas powr_le_iff = le_log_iff[symmetric]
  2089   and powr_less_iff = le_log_iff[symmetric]
  2090   and less_powr_iff = log_less_iff[symmetric]
  2091   and le_powr_iff = log_le_iff[symmetric]
  2092 
  2093 lemma
  2094   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)"
  2095   by (auto simp add: floor_eq_iff powr_le_iff less_powr_iff)
  2096 
  2097 lemma powr_realpow: "0 < x ==> x powr (real n) = x^n"
  2098   apply (induct n)
  2099   apply simp
  2100   apply (subgoal_tac "real(Suc n) = real n + 1")
  2101   apply (erule ssubst)
  2102   apply (subst powr_add, simp, simp)
  2103   done
  2104 
  2105 lemma powr_realpow_numeral: "0 < x \<Longrightarrow> x powr (numeral n :: real) = x ^ (numeral n)"
  2106   unfolding real_of_nat_numeral [symmetric] by (rule powr_realpow)
  2107 
  2108 lemma powr2_sqrt[simp]: "0 < x \<Longrightarrow> sqrt x powr 2 = x"
  2109 by(simp add: powr_realpow_numeral)
  2110 
  2111 lemma powr_realpow2: "0 <= x ==> 0 < n ==> x^n = (if (x = 0) then 0 else x powr (real n))"
  2112   apply (case_tac "x = 0", simp, simp)
  2113   apply (rule powr_realpow [THEN sym], simp)
  2114   done
  2115 
  2116 lemma powr_int:
  2117   assumes "x > 0"
  2118   shows "x powr i = (if i \<ge> 0 then x ^ nat i else 1 / x ^ nat (-i))"
  2119 proof (cases "i < 0")
  2120   case True
  2121   have r: "x powr i = 1 / x powr (-i)" by (simp add: powr_minus field_simps)
  2122   show ?thesis using `i < 0` `x > 0` by (simp add: r field_simps powr_realpow[symmetric])
  2123 next
  2124   case False
  2125   then show ?thesis by (simp add: assms powr_realpow[symmetric])
  2126 qed
  2127 
  2128 lemma compute_powr[code]:
  2129   fixes i::real
  2130   shows "b powr i =
  2131     (if b \<le> 0 then Code.abort (STR ''op powr with nonpositive base'') (\<lambda>_. b powr i)
  2132     else if floor i = i then (if 0 \<le> i then b ^ nat(floor i) else 1 / b ^ nat(floor (- i)))
  2133     else Code.abort (STR ''op powr with non-integer exponent'') (\<lambda>_. b powr i))"
  2134   by (auto simp: powr_int)
  2135 
  2136 lemma powr_one: "0 < x \<Longrightarrow> x powr 1 = x"
  2137   using powr_realpow [of x 1] by simp
  2138 
  2139 lemma powr_numeral: "0 < x \<Longrightarrow> x powr numeral n = x ^ numeral n"
  2140   by (fact powr_realpow_numeral)
  2141 
  2142 lemma powr_neg_one: "0 < x \<Longrightarrow> x powr - 1 = 1 / x"
  2143   using powr_int [of x "- 1"] by simp
  2144 
  2145 lemma powr_neg_numeral: "0 < x \<Longrightarrow> x powr - numeral n = 1 / x ^ numeral n"
  2146   using powr_int [of x "- numeral n"] by simp
  2147 
  2148 lemma root_powr_inverse: "0 < n \<Longrightarrow> 0 < x \<Longrightarrow> root n x = x powr (1/n)"
  2149   by (rule real_root_pos_unique) (auto simp: powr_realpow[symmetric] powr_powr)
  2150 
  2151 lemma ln_powr: "ln (x powr y) = y * ln x"
  2152   by (simp add: powr_def)
  2153 
  2154 lemma ln_root: "\<lbrakk> n > 0; b > 0 \<rbrakk> \<Longrightarrow> ln (root n b) =  ln b / n"
  2155 by(simp add: root_powr_inverse ln_powr)
  2156 
  2157 lemma ln_sqrt: "0 < x \<Longrightarrow> ln (sqrt x) = ln x / 2"
  2158   by (simp add: ln_powr powr_numeral ln_powr[symmetric] mult.commute)
  2159 
  2160 lemma log_root: "\<lbrakk> n > 0; a > 0 \<rbrakk> \<Longrightarrow> log b (root n a) =  log b a / n"
  2161 by(simp add: log_def ln_root)
  2162 
  2163 lemma log_powr: "log b (x powr y) = y * log b x"
  2164   by (simp add: log_def ln_powr)
  2165 
  2166 lemma log_nat_power: "0 < x \<Longrightarrow> log b (x^n) = real n * log b x"
  2167   by (simp add: log_powr powr_realpow [symmetric])
  2168 
  2169 lemma log_base_change: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> log b x = log a x / log a b"
  2170   by (simp add: log_def)
  2171 
  2172 lemma log_base_pow: "0 < a \<Longrightarrow> log (a ^ n) x = log a x / n"
  2173   by (simp add: log_def ln_realpow)
  2174 
  2175 lemma log_base_powr: "log (a powr b) x = log a x / b"
  2176   by (simp add: log_def ln_powr)
  2177 
  2178 lemma log_base_root: "\<lbrakk> n > 0; b > 0 \<rbrakk> \<Longrightarrow> log (root n b) x = n * (log b x)"
  2179 by(simp add: log_def ln_root)
  2180 
  2181 lemma ln_bound: "1 <= x ==> ln x <= x"
  2182   apply (subgoal_tac "ln(1 + (x - 1)) <= x - 1")
  2183   apply simp
  2184   apply (rule ln_add_one_self_le_self, simp)
  2185   done
  2186 
  2187 lemma powr_mono: "a <= b ==> 1 <= x ==> x powr a <= x powr b"
  2188   apply (cases "x = 1", simp)
  2189   apply (cases "a = b", simp)
  2190   apply (rule order_less_imp_le)
  2191   apply (rule powr_less_mono, auto)
  2192   done
  2193 
  2194 lemma ge_one_powr_ge_zero: "1 <= x ==> 0 <= a ==> 1 <= x powr a"
  2195   apply (subst powr_zero_eq_one [THEN sym])
  2196   apply (rule powr_mono, assumption+)
  2197   done
  2198 
  2199 lemma powr_less_mono2: "0 < a ==> 0 < x ==> x < y ==> x powr a < y powr a"
  2200   apply (unfold powr_def)
  2201   apply (rule exp_less_mono)
  2202   apply (rule mult_strict_left_mono)
  2203   apply (subst ln_less_cancel_iff, assumption)
  2204   apply (rule order_less_trans)
  2205   prefer 2
  2206   apply assumption+
  2207   done
  2208 
  2209 lemma powr_less_mono2_neg: "a < 0 ==> 0 < x ==> x < y ==> y powr a < x powr a"
  2210   apply (unfold powr_def)
  2211   apply (rule exp_less_mono)
  2212   apply (rule mult_strict_left_mono_neg)
  2213   apply (subst ln_less_cancel_iff)
  2214   apply assumption
  2215   apply (rule order_less_trans)
  2216   prefer 2
  2217   apply assumption+
  2218   done
  2219 
  2220 lemma powr_mono2: "0 <= a ==> 0 < x ==> x <= y ==> x powr a <= y powr a"
  2221   apply (case_tac "a = 0", simp)
  2222   apply (case_tac "x = y", simp)
  2223   apply (metis less_eq_real_def powr_less_mono2)
  2224   done
  2225 
  2226 lemma powr_inj: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> a powr x = a powr y \<longleftrightarrow> x = y"
  2227   unfolding powr_def exp_inj_iff by simp
  2228 
  2229 lemma ln_powr_bound: "1 <= x ==> 0 < a ==> ln x <= (x powr a) / a"
  2230   by (metis less_eq_real_def ln_less_self mult_imp_le_div_pos ln_powr mult.commute
  2231             order.strict_trans2 powr_gt_zero zero_less_one)
  2232 
  2233 lemma ln_powr_bound2:
  2234   assumes "1 < x" and "0 < a"
  2235   shows "(ln x) powr a <= (a powr a) * x"
  2236 proof -
  2237   from assms have "ln x <= (x powr (1 / a)) / (1 / a)"
  2238     by (metis less_eq_real_def ln_powr_bound zero_less_divide_1_iff)
  2239   also have "... = a * (x powr (1 / a))"
  2240     by simp
  2241   finally have "(ln x) powr a <= (a * (x powr (1 / a))) powr a"
  2242     by (metis assms less_imp_le ln_gt_zero powr_mono2)
  2243   also have "... = (a powr a) * ((x powr (1 / a)) powr a)"
  2244     by (metis assms(2) powr_mult powr_gt_zero)
  2245   also have "(x powr (1 / a)) powr a = x powr ((1 / a) * a)"
  2246     by (rule powr_powr)
  2247   also have "... = x" using assms
  2248     by auto
  2249   finally show ?thesis .
  2250 qed
  2251 
  2252 lemma tendsto_powr [tendsto_intros]:
  2253   "\<lbrakk>(f ---> a) F; (g ---> b) F; a \<noteq> 0\<rbrakk> \<Longrightarrow> ((\<lambda>x. f x powr g x) ---> a powr b) F"
  2254   unfolding powr_def by (intro tendsto_intros)
  2255 
  2256 lemma continuous_powr:
  2257   assumes "continuous F f"
  2258     and "continuous F g"
  2259     and "f (Lim F (\<lambda>x. x)) \<noteq> 0"
  2260   shows "continuous F (\<lambda>x. (f x) powr (g x))"
  2261   using assms unfolding continuous_def by (rule tendsto_powr)
  2262 
  2263 lemma continuous_at_within_powr[continuous_intros]:
  2264   assumes "continuous (at a within s) f"
  2265     and "continuous (at a within s) g"
  2266     and "f a \<noteq> 0"
  2267   shows "continuous (at a within s) (\<lambda>x. (f x) powr (g x))"
  2268   using assms unfolding continuous_within by (rule tendsto_powr)
  2269 
  2270 lemma isCont_powr[continuous_intros, simp]:
  2271   assumes "isCont f a" "isCont g a" "f a \<noteq> 0"
  2272   shows "isCont (\<lambda>x. (f x) powr g x) a"
  2273   using assms unfolding continuous_at by (rule tendsto_powr)
  2274 
  2275 lemma continuous_on_powr[continuous_intros]:
  2276   assumes "continuous_on s f" "continuous_on s g" and "\<forall>x\<in>s. f x \<noteq> 0"
  2277   shows "continuous_on s (\<lambda>x. (f x) powr (g x))"
  2278   using assms unfolding continuous_on_def by (fast intro: tendsto_powr)
  2279 
  2280 (* FIXME: generalize by replacing d by with g x and g ---> d? *)
  2281 lemma tendsto_zero_powrI:
  2282   assumes "eventually (\<lambda>x. 0 < f x ) F" and "(f ---> 0) F"
  2283     and "0 < d"
  2284   shows "((\<lambda>x. f x powr d) ---> 0) F"
  2285 proof (rule tendstoI)
  2286   fix e :: real assume "0 < e"
  2287   def Z \<equiv> "e powr (1 / d)"
  2288   with `0 < e` have "0 < Z" by simp
  2289   with assms have "eventually (\<lambda>x. 0 < f x \<and> dist (f x) 0 < Z) F"
  2290     by (intro eventually_conj tendstoD)
  2291   moreover
  2292   from assms have "\<And>x. 0 < x \<and> dist x 0 < Z \<Longrightarrow> x powr d < Z powr d"
  2293     by (intro powr_less_mono2) (auto simp: dist_real_def)
  2294   with assms `0 < e` have "\<And>x. 0 < x \<and> dist x 0 < Z \<Longrightarrow> dist (x powr d) 0 < e"
  2295     unfolding dist_real_def Z_def by (auto simp: powr_powr)
  2296   ultimately
  2297   show "eventually (\<lambda>x. dist (f x powr d) 0 < e) F" by (rule eventually_elim1)
  2298 qed
  2299 
  2300 lemma tendsto_neg_powr:
  2301   assumes "s < 0"
  2302     and "LIM x F. f x :> at_top"
  2303   shows "((\<lambda>x. f x powr s) ---> 0) F"
  2304 proof (rule tendstoI)
  2305   fix e :: real assume "0 < e"
  2306   def Z \<equiv> "e powr (1 / s)"
  2307   from assms have "eventually (\<lambda>x. Z < f x) F"
  2308     by (simp add: filterlim_at_top_dense)
  2309   moreover
  2310   from assms have "\<And>x. Z < x \<Longrightarrow> x powr s < Z powr s"
  2311     by (auto simp: Z_def intro!: powr_less_mono2_neg)
  2312   with assms `0 < e` have "\<And>x. Z < x \<Longrightarrow> dist (x powr s) 0 < e"
  2313     by (simp add: powr_powr Z_def dist_real_def)
  2314   ultimately
  2315   show "eventually (\<lambda>x. dist (f x powr s) 0 < e) F" by (rule eventually_elim1)
  2316 qed
  2317 
  2318 (* it is funny that this isn't in the library! It could go in Transcendental *)
  2319 lemma tendsto_exp_limit_at_right:
  2320   fixes x :: real
  2321   shows "((\<lambda>y. (1 + x * y) powr (1 / y)) ---> exp x) (at_right 0)"
  2322 proof cases
  2323   assume "x \<noteq> 0"
  2324 
  2325   have "((\<lambda>y. ln (1 + x * y)::real) has_real_derivative 1 * x) (at 0)"
  2326     by (auto intro!: derivative_eq_intros)
  2327   then have "((\<lambda>y. ln (1 + x * y) / y) ---> x) (at 0)"
  2328     by (auto simp add: has_field_derivative_def field_has_derivative_at)
  2329   then have *: "((\<lambda>y. exp (ln (1 + x * y) / y)) ---> exp x) (at 0)"
  2330     by (rule tendsto_intros)
  2331   then show ?thesis
  2332   proof (rule filterlim_mono_eventually)
  2333     show "eventually (\<lambda>xa. exp (ln (1 + x * xa) / xa) = (1 + x * xa) powr (1 / xa)) (at_right 0)"
  2334       unfolding eventually_at_right[OF zero_less_one]
  2335       using `x \<noteq> 0` by (intro exI[of _ "1 / \<bar>x\<bar>"]) (auto simp: field_simps powr_def)
  2336   qed (simp_all add: at_eq_sup_left_right)
  2337 qed simp
  2338 
  2339 lemma tendsto_exp_limit_at_top:
  2340   fixes x :: real
  2341   shows "((\<lambda>y. (1 + x / y) powr y) ---> exp x) at_top"
  2342   apply (subst filterlim_at_top_to_right)
  2343   apply (simp add: inverse_eq_divide)
  2344   apply (rule tendsto_exp_limit_at_right)
  2345   done
  2346 
  2347 lemma tendsto_exp_limit_sequentially:
  2348   fixes x :: real
  2349   shows "(\<lambda>n. (1 + x / n) ^ n) ----> exp x"
  2350 proof (rule filterlim_mono_eventually)
  2351   from reals_Archimedean2 [of "abs x"] obtain n :: nat where *: "real n > abs x" ..
  2352   hence "eventually (\<lambda>n :: nat. 0 < 1 + x / real n) at_top"
  2353     apply (intro eventually_sequentiallyI [of n])
  2354     apply (case_tac "x \<ge> 0")
  2355     apply (rule add_pos_nonneg, auto intro: divide_nonneg_nonneg)
  2356     apply (subgoal_tac "x / real xa > -1")
  2357     apply (auto simp add: field_simps)
  2358     done
  2359   then show "eventually (\<lambda>n. (1 + x / n) powr n = (1 + x / n) ^ n) at_top"
  2360     by (rule eventually_elim1) (erule powr_realpow)
  2361   show "(\<lambda>n. (1 + x / real n) powr real n) ----> exp x"
  2362     by (rule filterlim_compose [OF tendsto_exp_limit_at_top filterlim_real_sequentially])
  2363 qed auto
  2364 
  2365 subsection {* Sine and Cosine *}
  2366 
  2367 definition sin_coeff :: "nat \<Rightarrow> real" where
  2368   "sin_coeff = (\<lambda>n. if even n then 0 else (- 1) ^ ((n - Suc 0) div 2) / (fact n))"
  2369 
  2370 definition cos_coeff :: "nat \<Rightarrow> real" where
  2371   "cos_coeff = (\<lambda>n. if even n then ((- 1) ^ (n div 2)) / (fact n) else 0)"
  2372 
  2373 definition sin :: "'a \<Rightarrow> 'a::{real_normed_algebra_1,banach}"
  2374   where "sin = (\<lambda>x. \<Sum>n. sin_coeff n *\<^sub>R x^n)"
  2375 
  2376 definition cos :: "'a \<Rightarrow> 'a::{real_normed_algebra_1,banach}"
  2377   where "cos = (\<lambda>x. \<Sum>n. cos_coeff n *\<^sub>R x^n)"
  2378 
  2379 lemma sin_coeff_0 [simp]: "sin_coeff 0 = 0"
  2380   unfolding sin_coeff_def by simp
  2381 
  2382 lemma cos_coeff_0 [simp]: "cos_coeff 0 = 1"
  2383   unfolding cos_coeff_def by simp
  2384 
  2385 lemma sin_coeff_Suc: "sin_coeff (Suc n) = cos_coeff n / real (Suc n)"
  2386   unfolding cos_coeff_def sin_coeff_def
  2387   by (simp del: mult_Suc)
  2388 
  2389 lemma cos_coeff_Suc: "cos_coeff (Suc n) = - sin_coeff n / real (Suc n)"
  2390   unfolding cos_coeff_def sin_coeff_def
  2391   by (simp del: mult_Suc) (auto elim: oddE)
  2392 
  2393 lemma summable_norm_sin:
  2394   fixes x :: "'a::{real_normed_algebra_1,banach}"
  2395   shows "summable (\<lambda>n. norm (sin_coeff n *\<^sub>R x^n))"
  2396   unfolding sin_coeff_def
  2397   apply (rule summable_comparison_test [OF _ summable_norm_exp [where x=x]])
  2398   apply (auto simp: divide_inverse abs_mult power_abs [symmetric] zero_le_mult_iff)
  2399   done
  2400 
  2401 lemma summable_norm_cos:
  2402   fixes x :: "'a::{real_normed_algebra_1,banach}"
  2403   shows "summable (\<lambda>n. norm (cos_coeff n *\<^sub>R x^n))"
  2404   unfolding cos_coeff_def
  2405   apply (rule summable_comparison_test [OF _ summable_norm_exp [where x=x]])
  2406   apply (auto simp: divide_inverse abs_mult power_abs [symmetric] zero_le_mult_iff)
  2407   done
  2408 
  2409 lemma sin_converges: "(\<lambda>n. sin_coeff n *\<^sub>R x^n) sums sin(x)"
  2410 unfolding sin_def
  2411   by (metis (full_types) summable_norm_cancel summable_norm_sin summable_sums)
  2412 
  2413 lemma cos_converges: "(\<lambda>n. cos_coeff n *\<^sub>R x^n) sums cos(x)"
  2414 unfolding cos_def
  2415   by (metis (full_types) summable_norm_cancel summable_norm_cos summable_sums)
  2416 
  2417 lemma sin_of_real:
  2418   fixes x::real
  2419   shows "sin (of_real x) = of_real (sin x)"
  2420 proof -
  2421   have "(\<lambda>n. of_real (sin_coeff n *\<^sub>R  x^n)) = (\<lambda>n. sin_coeff n *\<^sub>R  (of_real x)^n)"
  2422   proof
  2423     fix n
  2424     show "of_real (sin_coeff n *\<^sub>R  x^n) = sin_coeff n *\<^sub>R of_real x^n"
  2425       by (simp add: scaleR_conv_of_real)
  2426   qed
  2427   also have "... sums (sin (of_real x))"
  2428     by (rule sin_converges)
  2429   finally have "(\<lambda>n. of_real (sin_coeff n *\<^sub>R x^n)) sums (sin (of_real x))" .
  2430   then show ?thesis
  2431     using sums_unique2 sums_of_real [OF sin_converges]
  2432     by blast
  2433 qed
  2434 
  2435 lemma cos_of_real:
  2436   fixes x::real
  2437   shows "cos (of_real x) = of_real (cos x)"
  2438 proof -
  2439   have "(\<lambda>n. of_real (cos_coeff n *\<^sub>R  x^n)) = (\<lambda>n. cos_coeff n *\<^sub>R  (of_real x)^n)"
  2440   proof
  2441     fix n
  2442     show "of_real (cos_coeff n *\<^sub>R  x^n) = cos_coeff n *\<^sub>R of_real x^n"
  2443       by (simp add: scaleR_conv_of_real)
  2444   qed
  2445   also have "... sums (cos (of_real x))"
  2446     by (rule cos_converges)
  2447   finally have "(\<lambda>n. of_real (cos_coeff n *\<^sub>R x^n)) sums (cos (of_real x))" .
  2448   then show ?thesis
  2449     using sums_unique2 sums_of_real [OF cos_converges]
  2450     by blast
  2451 qed
  2452 
  2453 lemma diffs_sin_coeff: "diffs sin_coeff = cos_coeff"
  2454   by (simp add: diffs_def sin_coeff_Suc real_of_nat_def del: of_nat_Suc)
  2455 
  2456 lemma diffs_cos_coeff: "diffs cos_coeff = (\<lambda>n. - sin_coeff n)"
  2457   by (simp add: diffs_def cos_coeff_Suc real_of_nat_def del: of_nat_Suc)
  2458 
  2459 text{*Now at last we can get the derivatives of exp, sin and cos*}
  2460 
  2461 lemma DERIV_sin [simp]:
  2462   fixes x :: "'a::{real_normed_field,banach}"
  2463   shows "DERIV sin x :> cos(x)"
  2464   unfolding sin_def cos_def scaleR_conv_of_real
  2465   apply (rule DERIV_cong)
  2466   apply (rule termdiffs [where K="of_real (norm x) + 1 :: 'a"])
  2467   apply (simp_all add: norm_less_p1 diffs_of_real diffs_sin_coeff diffs_cos_coeff
  2468               summable_minus_iff scaleR_conv_of_real [symmetric]
  2469               summable_norm_sin [THEN summable_norm_cancel]
  2470               summable_norm_cos [THEN summable_norm_cancel])
  2471   done
  2472 
  2473 declare DERIV_sin[THEN DERIV_chain2, derivative_intros]
  2474 
  2475 lemma DERIV_cos [simp]:
  2476   fixes x :: "'a::{real_normed_field,banach}"
  2477   shows "DERIV cos x :> -sin(x)"
  2478   unfolding sin_def cos_def scaleR_conv_of_real
  2479   apply (rule DERIV_cong)
  2480   apply (rule termdiffs [where K="of_real (norm x) + 1 :: 'a"])
  2481   apply (simp_all add: norm_less_p1 diffs_of_real diffs_minus suminf_minus
  2482               diffs_sin_coeff diffs_cos_coeff
  2483               summable_minus_iff scaleR_conv_of_real [symmetric]
  2484               summable_norm_sin [THEN summable_norm_cancel]
  2485               summable_norm_cos [THEN summable_norm_cancel])
  2486   done
  2487 
  2488 declare DERIV_cos[THEN DERIV_chain2, derivative_intros]
  2489 
  2490 lemma isCont_sin:
  2491   fixes x :: "'a::{real_normed_field,banach}"
  2492   shows "isCont sin x"
  2493   by (rule DERIV_sin [THEN DERIV_isCont])
  2494 
  2495 lemma isCont_cos:
  2496   fixes x :: "'a::{real_normed_field,banach}"
  2497   shows "isCont cos x"
  2498   by (rule DERIV_cos [THEN DERIV_isCont])
  2499 
  2500 lemma isCont_sin' [simp]:
  2501   fixes f:: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  2502   shows "isCont f a \<Longrightarrow> isCont (\<lambda>x. sin (f x)) a"
  2503   by (rule isCont_o2 [OF _ isCont_sin])
  2504 
  2505 (*FIXME A CONTEXT FOR F WOULD BE BETTER*)
  2506 
  2507 lemma isCont_cos' [simp]:
  2508   fixes f:: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  2509   shows "isCont f a \<Longrightarrow> isCont (\<lambda>x. cos (f x)) a"
  2510   by (rule isCont_o2 [OF _ isCont_cos])
  2511 
  2512 lemma tendsto_sin [tendsto_intros]:
  2513   fixes f:: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  2514   shows "(f ---> a) F \<Longrightarrow> ((\<lambda>x. sin (f x)) ---> sin a) F"
  2515   by (rule isCont_tendsto_compose [OF isCont_sin])
  2516 
  2517 lemma tendsto_cos [tendsto_intros]:
  2518   fixes f:: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  2519   shows "(f ---> a) F \<Longrightarrow> ((\<lambda>x. cos (f x)) ---> cos a) F"
  2520   by (rule isCont_tendsto_compose [OF isCont_cos])
  2521 
  2522 lemma continuous_sin [continuous_intros]:
  2523   fixes f:: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  2524   shows "continuous F f \<Longrightarrow> continuous F (\<lambda>x. sin (f x))"
  2525   unfolding continuous_def by (rule tendsto_sin)
  2526 
  2527 lemma continuous_on_sin [continuous_intros]:
  2528   fixes f:: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  2529   shows "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. sin (f x))"
  2530   unfolding continuous_on_def by (auto intro: tendsto_sin)
  2531 
  2532 lemma continuous_within_sin:
  2533   fixes z :: "'a::{real_normed_field,banach}"
  2534   shows "continuous (at z within s) sin"
  2535   by (simp add: continuous_within tendsto_sin)
  2536 
  2537 lemma continuous_cos [continuous_intros]:
  2538   fixes f:: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  2539   shows "continuous F f \<Longrightarrow> continuous F (\<lambda>x. cos (f x))"
  2540   unfolding continuous_def by (rule tendsto_cos)
  2541 
  2542 lemma continuous_on_cos [continuous_intros]:
  2543   fixes f:: "_ \<Rightarrow> 'a::{real_normed_field,banach}"
  2544   shows "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. cos (f x))"
  2545   unfolding continuous_on_def by (auto intro: tendsto_cos)
  2546 
  2547 lemma continuous_within_cos:
  2548   fixes z :: "'a::{real_normed_field,banach}"
  2549   shows "continuous (at z within s) cos"
  2550   by (simp add: continuous_within tendsto_cos)
  2551 
  2552 subsection {* Properties of Sine and Cosine *}
  2553 
  2554 lemma sin_zero [simp]: "sin 0 = 0"
  2555   unfolding sin_def sin_coeff_def by (simp add: scaleR_conv_of_real powser_zero)
  2556 
  2557 lemma cos_zero [simp]: "cos 0 = 1"
  2558   unfolding cos_def cos_coeff_def by (simp add: scaleR_conv_of_real powser_zero)
  2559 
  2560 lemma DERIV_fun_sin:
  2561      "DERIV g x :> m \<Longrightarrow> DERIV (\<lambda>x. sin(g x)) x :> cos(g x) * m"
  2562   by (auto intro!: derivative_intros)
  2563 
  2564 lemma DERIV_fun_cos:
  2565      "DERIV g x :> m \<Longrightarrow> DERIV (\<lambda>x. cos(g x)) x :> -sin(g x) * m"
  2566   by (auto intro!: derivative_eq_intros simp: real_of_nat_def)
  2567 
  2568 subsection {*Deriving the Addition Formulas*}
  2569 
  2570 text{*The the product of two cosine series*}
  2571 lemma cos_x_cos_y:
  2572   fixes x :: "'a::{real_normed_field,banach}"
  2573   shows "(\<lambda>p. \<Sum>n\<le>p.
  2574           if even p \<and> even n
  2575           then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0)
  2576          sums (cos x * cos y)"
  2577 proof -
  2578   { fix n p::nat
  2579     assume "n\<le>p"
  2580     then have *: "even n \<Longrightarrow> even p \<Longrightarrow> (-1) ^ (n div 2) * (-1) ^ ((p - n) div 2) = (-1 :: real) ^ (p div 2)"
  2581       by (metis div_add power_add le_add_diff_inverse odd_add)
  2582     have "(cos_coeff n * cos_coeff (p - n)) *\<^sub>R (x^n * y^(p-n)) =
  2583           (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)"
  2584     using `n\<le>p`
  2585       by (auto simp: * algebra_simps cos_coeff_def binomial_fact real_of_nat_def)
  2586   }
  2587   then have "(\<lambda>p. \<Sum>n\<le>p. if even p \<and> even n
  2588                   then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0) =
  2589              (\<lambda>p. \<Sum>n\<le>p. (cos_coeff n * cos_coeff (p - n)) *\<^sub>R (x^n * y^(p-n)))"
  2590     by simp
  2591   also have "... = (\<lambda>p. \<Sum>n\<le>p. (cos_coeff n *\<^sub>R x^n) * (cos_coeff (p - n) *\<^sub>R y^(p-n)))"
  2592     by (simp add: algebra_simps)
  2593   also have "... sums (cos x * cos y)"
  2594     using summable_norm_cos
  2595     by (auto simp: cos_def scaleR_conv_of_real intro!: Cauchy_product_sums)
  2596   finally show ?thesis .
  2597 qed
  2598 
  2599 text{*The product of two sine series*}
  2600 lemma sin_x_sin_y:
  2601   fixes x :: "'a::{real_normed_field,banach}"
  2602   shows "(\<lambda>p. \<Sum>n\<le>p.
  2603           if even p \<and> odd n
  2604                then - ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0)
  2605          sums (sin x * sin y)"
  2606 proof -
  2607   { fix n p::nat
  2608     assume "n\<le>p"
  2609     { assume np: "odd n" "even p"
  2610         with `n\<le>p` have "n - Suc 0 + (p - Suc n) = p - Suc (Suc 0)" "Suc (Suc 0) \<le> p"
  2611         by arith+
  2612       moreover have "(p - Suc (Suc 0)) div 2 = p div 2 - Suc 0"
  2613         by simp
  2614       ultimately have *: "(-1) ^ ((n - Suc 0) div 2) * (-1) ^ ((p - Suc n) div 2) = - ((-1 :: real) ^ (p div 2))"
  2615         using np `n\<le>p`
  2616         apply (simp add: power_add [symmetric] div_add [symmetric] del: div_add)
  2617         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)
  2618         done
  2619     } then
  2620     have "(sin_coeff n * sin_coeff (p - n)) *\<^sub>R (x^n * y^(p-n)) =
  2621           (if even p \<and> odd n
  2622           then -((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0)"
  2623     using `n\<le>p`
  2624       by (auto simp:  algebra_simps sin_coeff_def binomial_fact real_of_nat_def)
  2625   }
  2626   then have "(\<lambda>p. \<Sum>n\<le>p. if even p \<and> odd n
  2627                then - ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0) =
  2628              (\<lambda>p. \<Sum>n\<le>p. (sin_coeff n * sin_coeff (p - n)) *\<^sub>R (x^n * y^(p-n)))"
  2629     by simp
  2630   also have "... = (\<lambda>p. \<Sum>n\<le>p. (sin_coeff n *\<^sub>R x^n) * (sin_coeff (p - n) *\<^sub>R y^(p-n)))"
  2631     by (simp add: algebra_simps)
  2632   also have "... sums (sin x * sin y)"
  2633     using summable_norm_sin
  2634     by (auto simp: sin_def scaleR_conv_of_real intro!: Cauchy_product_sums)
  2635   finally show ?thesis .
  2636 qed
  2637 
  2638 lemma sums_cos_x_plus_y:
  2639   fixes x :: "'a::{real_normed_field,banach}"
  2640   shows
  2641   "(\<lambda>p. \<Sum>n\<le>p. if even p
  2642                then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n)
  2643                else 0)
  2644         sums cos (x + y)"
  2645 proof -
  2646   { fix p::nat
  2647     have "(\<Sum>n\<le>p. if even p
  2648                   then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n)
  2649                   else 0) =
  2650           (if even p
  2651                   then \<Sum>n\<le>p. ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n)
  2652                   else 0)"
  2653       by simp
  2654     also have "... = (if even p
  2655                   then of_real ((-1) ^ (p div 2) / (fact p)) * (\<Sum>n\<le>p. (p choose n) *\<^sub>R (x^n) * y^(p-n))
  2656                   else 0)"
  2657       by (auto simp: setsum_right_distrib field_simps scaleR_conv_of_real nonzero_of_real_divide)
  2658     also have "... = cos_coeff p *\<^sub>R ((x + y) ^ p)"
  2659       by (simp add: cos_coeff_def binomial_ring [of x y]  scaleR_conv_of_real real_of_nat_def atLeast0AtMost)
  2660     finally have "(\<Sum>n\<le>p. if even p
  2661                   then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n)
  2662                   else 0) = cos_coeff p *\<^sub>R ((x + y) ^ p)" .
  2663   }
  2664   then have "(\<lambda>p. \<Sum>n\<le>p.
  2665                if even p
  2666                then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n)
  2667                else 0)
  2668         = (\<lambda>p. cos_coeff p *\<^sub>R ((x+y)^p))"
  2669         by simp
  2670    also have "... sums cos (x + y)"
  2671     by (rule cos_converges)
  2672    finally show ?thesis .
  2673 qed
  2674 
  2675 theorem cos_add:
  2676   fixes x :: "'a::{real_normed_field,banach}"
  2677   shows "cos (x + y) = cos x * cos y - sin x * sin y"
  2678 proof -
  2679   { fix n p::nat
  2680     assume "n\<le>p"
  2681     then have "(if even p \<and> even n
  2682                then ((- 1) ^ (p div 2) * int (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0) -
  2683           (if even p \<and> odd n
  2684                then - ((- 1) ^ (p div 2) * int (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0)
  2685           = (if even p
  2686                then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0)"
  2687       by simp
  2688   }
  2689   then have "(\<lambda>p. \<Sum>n\<le>p. (if even p
  2690                then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0))
  2691         sums (cos x * cos y - sin x * sin y)"
  2692     using sums_diff [OF cos_x_cos_y [of x y] sin_x_sin_y [of x y]]
  2693     by (simp add: setsum_subtractf [symmetric])
  2694   then show ?thesis
  2695     by (blast intro: sums_cos_x_plus_y sums_unique2)
  2696 qed
  2697 
  2698 lemma sin_minus_converges: "(\<lambda>n. - (sin_coeff n *\<^sub>R (-x)^n)) sums sin(x)"
  2699 proof -
  2700   have [simp]: "\<And>n. - (sin_coeff n *\<^sub>R (-x)^n) = (sin_coeff n *\<^sub>R x^n)"
  2701     by (auto simp: sin_coeff_def elim!: oddE)
  2702   show ?thesis
  2703     by (simp add: sin_def summable_norm_sin [THEN summable_norm_cancel, THEN summable_sums])
  2704 qed
  2705 
  2706 lemma sin_minus [simp]:
  2707   fixes x :: "'a::{real_normed_algebra_1,banach}"
  2708   shows "sin (-x) = -sin(x)"
  2709 using sin_minus_converges [of x]
  2710 by (auto simp: sin_def summable_norm_sin [THEN summable_norm_cancel] suminf_minus sums_iff equation_minus_iff)
  2711 
  2712 lemma cos_minus_converges: "(\<lambda>n. (cos_coeff n *\<^sub>R (-x)^n)) sums cos(x)"
  2713 proof -
  2714   have [simp]: "\<And>n. (cos_coeff n *\<^sub>R (-x)^n) = (cos_coeff n *\<^sub>R x^n)"
  2715     by (auto simp: Transcendental.cos_coeff_def elim!: evenE)
  2716   show ?thesis
  2717     by (simp add: cos_def summable_norm_cos [THEN summable_norm_cancel, THEN summable_sums])
  2718 qed
  2719 
  2720 lemma cos_minus [simp]:
  2721   fixes x :: "'a::{real_normed_algebra_1,banach}"
  2722   shows "cos (-x) = cos(x)"
  2723 using cos_minus_converges [of x]
  2724 by (simp add: cos_def summable_norm_cos [THEN summable_norm_cancel]
  2725               suminf_minus sums_iff equation_minus_iff)
  2726 
  2727 lemma sin_cos_squared_add [simp]:
  2728   fixes x :: "'a::{real_normed_field,banach}"
  2729   shows "(sin x)\<^sup>2 + (cos x)\<^sup>2 = 1"
  2730 using cos_add [of x "-x"]
  2731 by (simp add: power2_eq_square algebra_simps)
  2732 
  2733 lemma sin_cos_squared_add2 [simp]:
  2734   fixes x :: "'a::{real_normed_field,banach}"
  2735   shows "(cos x)\<^sup>2 + (sin x)\<^sup>2 = 1"
  2736   by (subst add.commute, rule sin_cos_squared_add)
  2737 
  2738 lemma sin_cos_squared_add3 [simp]:
  2739   fixes x :: "'a::{real_normed_field,banach}"
  2740   shows "cos x * cos x + sin x * sin x = 1"
  2741   using sin_cos_squared_add2 [unfolded power2_eq_square] .
  2742 
  2743 lemma sin_squared_eq:
  2744   fixes x :: "'a::{real_normed_field,banach}"
  2745   shows "(sin x)\<^sup>2 = 1 - (cos x)\<^sup>2"
  2746   unfolding eq_diff_eq by (rule sin_cos_squared_add)
  2747 
  2748 lemma cos_squared_eq:
  2749   fixes x :: "'a::{real_normed_field,banach}"
  2750   shows "(cos x)\<^sup>2 = 1 - (sin x)\<^sup>2"
  2751   unfolding eq_diff_eq by (rule sin_cos_squared_add2)
  2752 
  2753 lemma abs_sin_le_one [simp]:
  2754   fixes x :: real
  2755   shows "\<bar>sin x\<bar> \<le> 1"
  2756   by (rule power2_le_imp_le, simp_all add: sin_squared_eq)
  2757 
  2758 lemma sin_ge_minus_one [simp]:
  2759   fixes x :: real
  2760   shows "-1 \<le> sin x"
  2761   using abs_sin_le_one [of x] unfolding abs_le_iff by simp
  2762 
  2763 lemma sin_le_one [simp]:
  2764   fixes x :: real
  2765   shows "sin x \<le> 1"
  2766   using abs_sin_le_one [of x] unfolding abs_le_iff by simp
  2767 
  2768 lemma abs_cos_le_one [simp]:
  2769   fixes x :: real
  2770   shows "\<bar>cos x\<bar> \<le> 1"
  2771   by (rule power2_le_imp_le, simp_all add: cos_squared_eq)
  2772 
  2773 lemma cos_ge_minus_one [simp]:
  2774   fixes x :: real
  2775   shows "-1 \<le> cos x"
  2776   using abs_cos_le_one [of x] unfolding abs_le_iff by simp
  2777 
  2778 lemma cos_le_one [simp]:
  2779   fixes x :: real
  2780   shows "cos x \<le> 1"
  2781   using abs_cos_le_one [of x] unfolding abs_le_iff by simp
  2782 
  2783 lemma cos_diff:
  2784   fixes x :: "'a::{real_normed_field,banach}"
  2785   shows "cos (x - y) = cos x * cos y + sin x * sin y"
  2786   using cos_add [of x "- y"] by simp
  2787 
  2788 lemma cos_double:
  2789   fixes x :: "'a::{real_normed_field,banach}"
  2790   shows "cos(2*x) = (cos x)\<^sup>2 - (sin x)\<^sup>2"
  2791   using cos_add [where x=x and y=x]
  2792   by (simp add: power2_eq_square)
  2793 
  2794 lemma DERIV_fun_pow: "DERIV g x :> m ==>
  2795       DERIV (\<lambda>x. (g x) ^ n) x :> real n * (g x) ^ (n - 1) * m"
  2796   by (auto intro!: derivative_eq_intros simp: real_of_nat_def)
  2797 
  2798 lemma DERIV_fun_exp:
  2799      "DERIV g x :> m ==> DERIV (\<lambda>x. exp(g x)) x :> exp(g x) * m"
  2800   by (auto intro!: derivative_intros)
  2801 
  2802 subsection {* The Constant Pi *}
  2803 
  2804 definition pi :: real
  2805   where "pi = 2 * (THE x. 0 \<le> (x::real) & x \<le> 2 & cos x = 0)"
  2806 
  2807 text{*Show that there's a least positive @{term x} with @{term "cos(x) = 0"};
  2808    hence define pi.*}
  2809 
  2810 lemma sin_paired:
  2811   fixes x :: real
  2812   shows "(\<lambda>n. (- 1) ^ n / (fact (2 * n + 1)) * x ^ (2 * n + 1)) sums  sin x"
  2813 proof -
  2814   have "(\<lambda>n. \<Sum>k = n*2..<n * 2 + 2. sin_coeff k * x ^ k) sums sin x"
  2815     apply (rule sums_group)
  2816     using sin_converges [of x, unfolded scaleR_conv_of_real]
  2817     by auto
  2818   thus ?thesis unfolding One_nat_def sin_coeff_def by (simp add: ac_simps)
  2819 qed
  2820 
  2821 lemma sin_gt_zero_02:
  2822   fixes x :: real
  2823   assumes "0 < x" and "x < 2"
  2824   shows "0 < sin x"
  2825 proof -
  2826   let ?f = "\<lambda>n::nat. \<Sum>k = n*2..<n*2+2. (- 1) ^ k / (fact (2*k+1)) * x^(2*k+1)"
  2827   have pos: "\<forall>n. 0 < ?f n"
  2828   proof
  2829     fix n :: nat
  2830     let ?k2 = "real (Suc (Suc (4 * n)))"
  2831     let ?k3 = "real (Suc (Suc (Suc (4 * n))))"
  2832     have "x * x < ?k2 * ?k3"
  2833       using assms by (intro mult_strict_mono', simp_all)
  2834     hence "x * x * x * x ^ (n * 4) < ?k2 * ?k3 * x * x ^ (n * 4)"
  2835       by (intro mult_strict_right_mono zero_less_power `0 < x`)
  2836     thus "0 < ?f n"
  2837       by (simp add: real_of_nat_def divide_simps mult_ac del: mult_Suc)
  2838 qed
  2839   have sums: "?f sums sin x"
  2840     by (rule sin_paired [THEN sums_group], simp)
  2841   show "0 < sin x"
  2842     unfolding sums_unique [OF sums]
  2843     using sums_summable [OF sums] pos
  2844     by (rule suminf_pos)
  2845 qed
  2846 
  2847 lemma cos_double_less_one:
  2848   fixes x :: real
  2849   shows "0 < x \<Longrightarrow> x < 2 \<Longrightarrow> cos (2 * x) < 1"
  2850   using sin_gt_zero_02 [where x = x] by (auto simp: cos_squared_eq cos_double)
  2851 
  2852 lemma cos_paired:
  2853   fixes x :: real
  2854   shows "(\<lambda>n. (- 1) ^ n / (fact (2 * n)) * x ^ (2 * n)) sums cos x"
  2855 proof -
  2856   have "(\<lambda>n. \<Sum>k = n * 2..<n * 2 + 2. cos_coeff k * x ^ k) sums cos x"
  2857     apply (rule sums_group)
  2858     using cos_converges [of x, unfolded scaleR_conv_of_real]
  2859     by auto
  2860   thus ?thesis unfolding cos_coeff_def by (simp add: ac_simps)
  2861 qed
  2862 
  2863 lemmas realpow_num_eq_if = power_eq_if
  2864 
  2865 lemma sumr_pos_lt_pair:  (*FIXME A MESS, BUT THE REAL MESS IS THE NEXT THEOREM*)
  2866   fixes f :: "nat \<Rightarrow> real"
  2867   shows "\<lbrakk>summable f;
  2868         \<And>d. 0 < f (k + (Suc(Suc 0) * d)) + f (k + ((Suc(Suc 0) * d) + 1))\<rbrakk>
  2869       \<Longrightarrow> setsum f {..<k} < suminf f"
  2870 unfolding One_nat_def
  2871 apply (subst suminf_split_initial_segment [where k=k], assumption, simp)
  2872 apply (drule_tac k=k in summable_ignore_initial_segment)
  2873 apply (drule_tac k="Suc (Suc 0)" in sums_group [OF summable_sums], simp)
  2874 apply simp
  2875 apply (frule sums_unique)
  2876 apply (drule sums_summable, simp)
  2877 apply (erule suminf_pos)
  2878 apply (simp add: ac_simps)
  2879 done
  2880 
  2881 lemma cos_two_less_zero [simp]:
  2882   "cos 2 < (0::real)"
  2883 proof -
  2884   note fact.simps(2) [simp del]
  2885   from sums_minus [OF cos_paired]
  2886   have *: "(\<lambda>n. - ((- 1) ^ n * 2 ^ (2 * n) / fact (2 * n))) sums - cos (2::real)"
  2887     by simp
  2888   then have **: "summable (\<lambda>n. - ((- 1::real) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
  2889     by (rule sums_summable)
  2890   have "0 < (\<Sum>n<Suc (Suc (Suc 0)). - ((- 1::real) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
  2891     by (simp add: fact_num_eq_if realpow_num_eq_if)
  2892   moreover have "(\<Sum>n<Suc (Suc (Suc 0)). - ((- 1::real) ^ n  * 2 ^ (2 * n) / (fact (2 * n))))
  2893     < (\<Sum>n. - ((- 1) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
  2894   proof -
  2895     { fix d
  2896       have "(4::real) * (fact (Suc (Suc (Suc (Suc (Suc (Suc (4 * d))))))))
  2897             < (Suc (Suc (Suc (Suc (Suc (Suc (Suc (Suc (4 * d)))))))) *
  2898               fact (Suc (Suc (Suc (Suc (Suc (Suc (Suc (4 * d)))))))))"
  2899         unfolding real_of_nat_mult
  2900         by (rule mult_strict_mono) (simp_all add: fact_less_mono)
  2901       then have "(4::real) * (fact (Suc (Suc (Suc (Suc (Suc (Suc (4 * d))))))))
  2902         <  (fact (Suc (Suc (Suc (Suc (Suc (Suc (Suc (Suc (4 * d))))))))))"
  2903         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)
  2904       then have "(4::real) * inverse (fact (Suc (Suc (Suc (Suc (Suc (Suc (Suc (Suc (4 * d))))))))))
  2905         < inverse (fact (Suc (Suc (Suc (Suc (Suc (Suc (4 * d))))))))"
  2906         by (simp add: inverse_eq_divide less_divide_eq)
  2907     }
  2908     note *** = this
  2909     have [simp]: "\<And>x y::real. 0 < x - y \<longleftrightarrow> y < x" by arith
  2910     from ** show ?thesis by (rule sumr_pos_lt_pair)
  2911       (simp add: divide_inverse mult.assoc [symmetric] ***)
  2912   qed
  2913   ultimately have "0 < (\<Sum>n. - ((- 1::real) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
  2914     by (rule order_less_trans)
  2915   moreover from * have "- cos 2 = (\<Sum>n. - ((- 1::real) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
  2916     by (rule sums_unique)
  2917   ultimately have "(0::real) < - cos 2" by simp
  2918   then show ?thesis by simp
  2919 qed
  2920 
  2921 lemmas cos_two_neq_zero [simp] = cos_two_less_zero [THEN less_imp_neq]
  2922 lemmas cos_two_le_zero [simp] = cos_two_less_zero [THEN order_less_imp_le]
  2923 
  2924 lemma cos_is_zero: "EX! x::real. 0 \<le> x & x \<le> 2 \<and> cos x = 0"
  2925 proof (rule ex_ex1I)
  2926   show "\<exists>x::real. 0 \<le> x & x \<le> 2 & cos x = 0"
  2927     by (rule IVT2, simp_all)
  2928 next
  2929   fix x::real and y::real
  2930   assume x: "0 \<le> x \<and> x \<le> 2 \<and> cos x = 0"
  2931   assume y: "0 \<le> y \<and> y \<le> 2 \<and> cos y = 0"
  2932   have [simp]: "\<forall>x::real. cos differentiable (at x)"
  2933     unfolding real_differentiable_def by (auto intro: DERIV_cos)
  2934   from x y show "x = y"
  2935     apply (cut_tac less_linear [of x y], auto)
  2936     apply (drule_tac f = cos in Rolle)
  2937     apply (drule_tac [5] f = cos in Rolle)
  2938     apply (auto dest!: DERIV_cos [THEN DERIV_unique])
  2939     apply (metis order_less_le_trans less_le sin_gt_zero_02)
  2940     apply (metis order_less_le_trans less_le sin_gt_zero_02)
  2941     done
  2942 qed
  2943 
  2944 lemma pi_half: "pi/2 = (THE x. 0 \<le> x & x \<le> 2 & cos x = 0)"
  2945   by (simp add: pi_def)
  2946 
  2947 lemma cos_pi_half [simp]: "cos (pi / 2) = 0"
  2948   by (simp add: pi_half cos_is_zero [THEN theI'])
  2949 
  2950 lemma cos_of_real_pi_half [simp]:
  2951   fixes x :: "'a :: {real_field,banach,real_normed_algebra_1}"
  2952   shows "cos ((of_real pi / 2) :: 'a) = 0"
  2953 by (metis cos_pi_half cos_of_real eq_numeral_simps(4) nonzero_of_real_divide of_real_0 of_real_numeral)
  2954 
  2955 lemma pi_half_gt_zero [simp]: "0 < pi / 2"
  2956   apply (rule order_le_neq_trans)
  2957   apply (simp add: pi_half cos_is_zero [THEN theI'])
  2958   apply (metis cos_pi_half cos_zero zero_neq_one)
  2959   done
  2960 
  2961 lemmas pi_half_neq_zero [simp] = pi_half_gt_zero [THEN less_imp_neq, symmetric]
  2962 lemmas pi_half_ge_zero [simp] = pi_half_gt_zero [THEN order_less_imp_le]
  2963 
  2964 lemma pi_half_less_two [simp]: "pi / 2 < 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_two_neq_zero)
  2968   done
  2969 
  2970 lemmas pi_half_neq_two [simp] = pi_half_less_two [THEN less_imp_neq]
  2971 lemmas pi_half_le_two [simp] =  pi_half_less_two [THEN order_less_imp_le]
  2972 
  2973 lemma pi_gt_zero [simp]: "0 < pi"
  2974   using pi_half_gt_zero by simp
  2975 
  2976 lemma pi_ge_zero [simp]: "0 \<le> pi"
  2977   by (rule pi_gt_zero [THEN order_less_imp_le])
  2978 
  2979 lemma pi_neq_zero [simp]: "pi \<noteq> 0"
  2980   by (rule pi_gt_zero [THEN less_imp_neq, symmetric])
  2981 
  2982 lemma pi_not_less_zero [simp]: "\<not> pi < 0"
  2983   by (simp add: linorder_not_less)
  2984 
  2985 lemma minus_pi_half_less_zero: "-(pi/2) < 0"
  2986   by simp
  2987 
  2988 lemma m2pi_less_pi: "- (2*pi) < pi"
  2989   by simp
  2990 
  2991 lemma sin_pi_half [simp]: "sin(pi/2) = 1"
  2992   using sin_cos_squared_add2 [where x = "pi/2"]
  2993   using sin_gt_zero_02 [OF pi_half_gt_zero pi_half_less_two]
  2994   by (simp add: power2_eq_1_iff)
  2995 
  2996 lemma sin_of_real_pi_half [simp]:
  2997   fixes x :: "'a :: {real_field,banach,real_normed_algebra_1}"
  2998   shows "sin ((of_real pi / 2) :: 'a) = 1"
  2999   using sin_pi_half
  3000 by (metis sin_pi_half eq_numeral_simps(4) nonzero_of_real_divide of_real_1 of_real_numeral sin_of_real)
  3001 
  3002 lemma sin_cos_eq:
  3003   fixes x :: "'a::{real_normed_field,banach}"
  3004   shows "sin x = cos (of_real pi / 2 - x)"
  3005   by (simp add: cos_diff)
  3006 
  3007 lemma minus_sin_cos_eq:
  3008   fixes x :: "'a::{real_normed_field,banach}"
  3009   shows "-sin x = cos (x + of_real pi / 2)"
  3010   by (simp add: cos_add nonzero_of_real_divide)
  3011 
  3012 lemma cos_sin_eq:
  3013   fixes x :: "'a::{real_normed_field,banach}"
  3014   shows "cos x = sin (of_real pi / 2 - x)"
  3015   using sin_cos_eq [of "of_real pi / 2 - x"]
  3016   by simp
  3017 
  3018 lemma sin_add:
  3019   fixes x :: "'a::{real_normed_field,banach}"
  3020   shows "sin (x + y) = sin x * cos y + cos x * sin y"
  3021   using cos_add [of "of_real pi / 2 - x" "-y"]
  3022   by (simp add: cos_sin_eq) (simp add: sin_cos_eq)
  3023 
  3024 lemma sin_diff:
  3025   fixes x :: "'a::{real_normed_field,banach}"
  3026   shows "sin (x - y) = sin x * cos y - cos x * sin y"
  3027   using sin_add [of x "- y"] by simp
  3028 
  3029 lemma sin_double:
  3030   fixes x :: "'a::{real_normed_field,banach}"
  3031   shows "sin(2 * x) = 2 * sin x * cos x"
  3032   using sin_add [where x=x and y=x] by simp
  3033 
  3034 
  3035 lemma cos_of_real_pi [simp]: "cos (of_real pi) = -1"
  3036   using cos_add [where x = "pi/2" and y = "pi/2"]
  3037   by (simp add: cos_of_real)
  3038 
  3039 lemma sin_of_real_pi [simp]: "sin (of_real pi) = 0"
  3040   using sin_add [where x = "pi/2" and y = "pi/2"]
  3041   by (simp add: sin_of_real)
  3042 
  3043 lemma cos_pi [simp]: "cos pi = -1"
  3044   using cos_add [where x = "pi/2" and y = "pi/2"] by simp
  3045 
  3046 lemma sin_pi [simp]: "sin pi = 0"
  3047   using sin_add [where x = "pi/2" and y = "pi/2"] by simp
  3048 
  3049 lemma sin_periodic_pi [simp]: "sin (x + pi) = - sin x"
  3050   by (simp add: sin_add)
  3051 
  3052 lemma sin_periodic_pi2 [simp]: "sin (pi + x) = - sin x"
  3053   by (simp add: sin_add)
  3054 
  3055 lemma cos_periodic_pi [simp]: "cos (x + pi) = - cos x"
  3056   by (simp add: cos_add)
  3057 
  3058 lemma sin_periodic [simp]: "sin (x + 2*pi) = sin x"
  3059   by (simp add: sin_add sin_double cos_double)
  3060 
  3061 lemma cos_periodic [simp]: "cos (x + 2*pi) = cos x"
  3062   by (simp add: cos_add sin_double cos_double)
  3063 
  3064 lemma cos_npi [simp]: "cos (real n * pi) = (- 1) ^ n"
  3065   by (induct n) (auto simp: real_of_nat_Suc distrib_right)
  3066 
  3067 lemma cos_npi2 [simp]: "cos (pi * real n) = (- 1) ^ n"
  3068   by (metis cos_npi mult.commute)
  3069 
  3070 lemma sin_npi [simp]: "sin (real (n::nat) * pi) = 0"
  3071   by (induct n) (auto simp: real_of_nat_Suc distrib_right)
  3072 
  3073 lemma sin_npi2 [simp]: "sin (pi * real (n::nat)) = 0"
  3074   by (simp add: mult.commute [of pi])
  3075 
  3076 lemma cos_two_pi [simp]: "cos (2*pi) = 1"
  3077   by (simp add: cos_double)
  3078 
  3079 lemma sin_two_pi [simp]: "sin (2*pi) = 0"
  3080   by (simp add: sin_double)
  3081 
  3082 
  3083 lemma sin_times_sin:
  3084   fixes w :: "'a::{real_normed_field,banach}"
  3085   shows "sin(w) * sin(z) = (cos(w - z) - cos(w + z)) / 2"
  3086   by (simp add: cos_diff cos_add)
  3087 
  3088 lemma sin_times_cos:
  3089   fixes w :: "'a::{real_normed_field,banach}"
  3090   shows "sin(w) * cos(z) = (sin(w + z) + sin(w - z)) / 2"
  3091   by (simp add: sin_diff sin_add)
  3092 
  3093 lemma cos_times_sin:
  3094   fixes w :: "'a::{real_normed_field,banach}"
  3095   shows "cos(w) * sin(z) = (sin(w + z) - sin(w - z)) / 2"
  3096   by (simp add: sin_diff sin_add)
  3097 
  3098 lemma cos_times_cos:
  3099   fixes w :: "'a::{real_normed_field,banach}"
  3100   shows "cos(w) * cos(z) = (cos(w - z) + cos(w + z)) / 2"
  3101   by (simp add: cos_diff cos_add)
  3102 
  3103 lemma sin_plus_sin:  (*FIXME field_inverse_zero should not be necessary*)
  3104   fixes w :: "'a::{real_normed_field,banach,field_inverse_zero}"
  3105   shows "sin(w) + sin(z) = 2 * sin((w + z) / 2) * cos((w - z) / 2)"
  3106   apply (simp add: mult.assoc sin_times_cos)
  3107   apply (simp add: field_simps)
  3108   done
  3109 
  3110 lemma sin_diff_sin: 
  3111   fixes w :: "'a::{real_normed_field,banach,field_inverse_zero}"
  3112   shows "sin(w) - sin(z) = 2 * sin((w - z) / 2) * cos((w + z) / 2)"
  3113   apply (simp add: mult.assoc sin_times_cos)
  3114   apply (simp add: field_simps)
  3115   done
  3116 
  3117 lemma cos_plus_cos: 
  3118   fixes w :: "'a::{real_normed_field,banach,field_inverse_zero}"
  3119   shows "cos(w) + cos(z) = 2 * cos((w + z) / 2) * cos((w - z) / 2)"
  3120   apply (simp add: mult.assoc cos_times_cos)
  3121   apply (simp add: field_simps)
  3122   done
  3123 
  3124 lemma cos_diff_cos: 
  3125   fixes w :: "'a::{real_normed_field,banach,field_inverse_zero}"
  3126   shows "cos(w) - cos(z) = 2 * sin((w + z) / 2) * sin((z - w) / 2)"
  3127   apply (simp add: mult.assoc sin_times_sin)
  3128   apply (simp add: field_simps)
  3129   done
  3130 
  3131 lemma cos_double_cos: 
  3132   fixes z :: "'a::{real_normed_field,banach}"
  3133   shows "cos(2 * z) = 2 * cos z ^ 2 - 1"
  3134 by (simp add: cos_double sin_squared_eq)
  3135 
  3136 lemma cos_double_sin: 
  3137   fixes z :: "'a::{real_normed_field,banach}"
  3138   shows "cos(2 * z) = 1 - 2 * sin z ^ 2"
  3139 by (simp add: cos_double sin_squared_eq)
  3140 
  3141 lemma sin_pi_minus [simp]: "sin (pi - x) = sin x"
  3142   by (metis sin_minus sin_periodic_pi minus_minus uminus_add_conv_diff)
  3143 
  3144 lemma cos_pi_minus [simp]: "cos (pi - x) = -(cos x)"
  3145   by (metis cos_minus cos_periodic_pi uminus_add_conv_diff)
  3146 
  3147 lemma sin_minus_pi [simp]: "sin (x - pi) = - (sin x)"
  3148   by (simp add: sin_diff)
  3149 
  3150 lemma cos_minus_pi [simp]: "cos (x - pi) = -(cos x)"
  3151   by (simp add: cos_diff)
  3152 
  3153 lemma sin_2pi_minus [simp]: "sin (2*pi - x) = -(sin x)"
  3154   by (metis sin_periodic_pi2 add_diff_eq mult_2 sin_pi_minus)
  3155 
  3156 lemma cos_2pi_minus [simp]: "cos (2*pi - x) = cos x"
  3157   by (metis (no_types, hide_lams) cos_add cos_minus cos_two_pi sin_minus sin_two_pi 
  3158            diff_0_right minus_diff_eq mult_1 mult_zero_left uminus_add_conv_diff)
  3159 
  3160 lemma sin_gt_zero2: "\<lbrakk>0 < x; x < pi/2\<rbrakk> \<Longrightarrow> 0 < sin x"
  3161   by (metis sin_gt_zero_02 order_less_trans pi_half_less_two)
  3162 
  3163 lemma sin_less_zero:
  3164   assumes "- pi/2 < x" and "x < 0"
  3165   shows "sin x < 0"
  3166 proof -
  3167   have "0 < sin (- x)" using assms by (simp only: sin_gt_zero2)
  3168   thus ?thesis by simp
  3169 qed
  3170 
  3171 lemma pi_less_4: "pi < 4"
  3172   using pi_half_less_two by auto
  3173 
  3174 lemma cos_gt_zero: "\<lbrakk>0 < x; x < pi/2\<rbrakk> \<Longrightarrow> 0 < cos x"
  3175   by (simp add: cos_sin_eq sin_gt_zero2)
  3176 
  3177 lemma cos_gt_zero_pi: "\<lbrakk>-(pi/2) < x; x < pi/2\<rbrakk> \<Longrightarrow> 0 < cos x"
  3178   using cos_gt_zero [of x] cos_gt_zero [of "-x"]
  3179   by (cases rule: linorder_cases [of x 0]) auto
  3180 
  3181 lemma cos_ge_zero: "\<lbrakk>-(pi/2) \<le> x; x \<le> pi/2\<rbrakk> \<Longrightarrow> 0 \<le> cos x"
  3182   apply (auto simp: order_le_less cos_gt_zero_pi)
  3183   by (metis cos_pi_half eq_divide_eq eq_numeral_simps(4))
  3184 
  3185 lemma sin_gt_zero: "\<lbrakk>0 < x; x < pi \<rbrakk> \<Longrightarrow> 0 < sin x"
  3186   by (simp add: sin_cos_eq cos_gt_zero_pi)
  3187 
  3188 lemma sin_lt_zero: "pi < x \<Longrightarrow> x < 2*pi \<Longrightarrow> sin x < 0"
  3189   using sin_gt_zero [of "x-pi"]
  3190   by (simp add: sin_diff)
  3191 
  3192 lemma pi_ge_two: "2 \<le> pi"
  3193 proof (rule ccontr)
  3194   assume "\<not> 2 \<le> pi" hence "pi < 2" by auto
  3195   have "\<exists>y > pi. y < 2 \<and> y < 2*pi"
  3196   proof (cases "2 < 2*pi")
  3197     case True with dense[OF `pi < 2`] show ?thesis by auto
  3198   next
  3199     case False have "pi < 2*pi" by auto
  3200     from dense[OF this] and False show ?thesis by auto
  3201   qed
  3202   then obtain y where "pi < y" and "y < 2" and "y < 2*pi" by blast
  3203   hence "0 < sin y" using sin_gt_zero_02 by auto
  3204   moreover
  3205   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
  3206   ultimately show False by auto
  3207 qed
  3208 
  3209 lemma sin_ge_zero: "\<lbrakk>0 \<le> x; x \<le> pi\<rbrakk> \<Longrightarrow> 0 \<le> sin x"
  3210   by (auto simp: order_le_less sin_gt_zero)
  3211 
  3212 lemma sin_le_zero: "pi \<le> x \<Longrightarrow> x < 2*pi \<Longrightarrow> sin x \<le> 0"
  3213   using sin_ge_zero [of "x-pi"]
  3214   by (simp add: sin_diff)
  3215 
  3216 text {* FIXME: This proof is almost identical to lemma @{text cos_is_zero}.
  3217   It should be possible to factor out some of the common parts. *}
  3218 
  3219 lemma cos_total: "\<lbrakk>-1 \<le> y; y \<le> 1\<rbrakk> \<Longrightarrow> EX! x. 0 \<le> x & x \<le> pi & (cos x = y)"
  3220 proof (rule ex_ex1I)
  3221   assume y: "-1 \<le> y" "y \<le> 1"
  3222   show "\<exists>x. 0 \<le> x & x \<le> pi & cos x = y"
  3223     by (rule IVT2, simp_all add: y)
  3224 next
  3225   fix a b
  3226   assume a: "0 \<le> a \<and> a \<le> pi \<and> cos a = y"
  3227   assume b: "0 \<le> b \<and> b \<le> pi \<and> cos b = y"
  3228   have [simp]: "\<forall>x::real. cos differentiable (at x)"
  3229     unfolding real_differentiable_def by (auto intro: DERIV_cos)
  3230   from a b show "a = b"
  3231     apply (cut_tac less_linear [of a b], auto)
  3232     apply (drule_tac f = cos in Rolle)
  3233     apply (drule_tac [5] f = cos in Rolle)
  3234     apply (auto dest!: DERIV_cos [THEN DERIV_unique])
  3235     apply (metis order_less_le_trans less_le sin_gt_zero)
  3236     apply (metis order_less_le_trans less_le sin_gt_zero)
  3237     done
  3238 qed
  3239 
  3240 lemma sin_total:
  3241   assumes y: "-1 \<le> y" "y \<le> 1"
  3242     shows "\<exists>! x. -(pi/2) \<le> x & x \<le> pi/2 & (sin x = y)"
  3243 proof -
  3244   from cos_total [OF y]
  3245   obtain x where x: "0 \<le> x" "x \<le> pi" "cos x = y"
  3246            and uniq: "\<And>x'. 0 \<le> x' \<Longrightarrow> x' \<le> pi \<Longrightarrow> cos x' = y \<Longrightarrow> x' = x "
  3247     by blast
  3248   show ?thesis
  3249     apply (simp add: sin_cos_eq)
  3250     apply (rule ex1I [where a="pi/2 - x"])
  3251     apply (cut_tac [2] x'="pi/2 - xa" in uniq)
  3252     using x
  3253     apply auto
  3254     done
  3255 qed
  3256 
  3257 lemma reals_Archimedean4:
  3258      "\<lbrakk>0 < y; 0 \<le> x\<rbrakk> \<Longrightarrow> \<exists>n. real n * y \<le> x & x < real (Suc n) * y"
  3259 apply (auto dest!: reals_Archimedean3)
  3260 apply (drule_tac x = x in spec, clarify)
  3261 apply (subgoal_tac "x < real(LEAST m::nat. x < real m * y) * y")
  3262  prefer 2 apply (erule LeastI)
  3263 apply (case_tac "LEAST m::nat. x < real m * y", simp)
  3264 apply (rename_tac m)
  3265 apply (subgoal_tac "~ x < real m * y")
  3266  prefer 2 apply (rule not_less_Least, simp, force)
  3267 done
  3268 
  3269 lemma cos_zero_lemma:
  3270      "\<lbrakk>0 \<le> x; cos x = 0\<rbrakk> \<Longrightarrow>
  3271       \<exists>n::nat. odd n & x = real n * (pi/2)"
  3272 apply (drule pi_gt_zero [THEN reals_Archimedean4], safe)
  3273 apply (subgoal_tac "0 \<le> x - real n * pi &
  3274                     (x - real n * pi) \<le> pi & (cos (x - real n * pi) = 0) ")
  3275 apply (auto simp: algebra_simps real_of_nat_Suc)
  3276  prefer 2 apply (simp add: cos_diff)
  3277 apply (simp add: cos_diff)
  3278 apply (subgoal_tac "EX! x. 0 \<le> x & x \<le> pi & cos x = 0")
  3279 apply (rule_tac [2] cos_total, safe)
  3280 apply (drule_tac x = "x - real n * pi" in spec)
  3281 apply (drule_tac x = "pi/2" in spec)
  3282 apply (simp add: cos_diff)
  3283 apply (rule_tac x = "Suc (2 * n)" in exI)
  3284 apply (simp add: real_of_nat_Suc algebra_simps, auto)
  3285 done
  3286 
  3287 lemma sin_zero_lemma:
  3288      "\<lbrakk>0 \<le> x; sin x = 0\<rbrakk> \<Longrightarrow>
  3289       \<exists>n::nat. even n & x = real n * (pi/2)"
  3290 apply (subgoal_tac "\<exists>n::nat. ~ even n & x + pi/2 = real n * (pi/2) ")
  3291  apply (clarify, rule_tac x = "n - 1" in exI)
  3292  apply (auto elim!: oddE simp add: real_of_nat_Suc field_simps)[1]
  3293  apply (rule cos_zero_lemma)
  3294  apply (auto simp: cos_add)
  3295 done
  3296 
  3297 lemma cos_zero_iff:
  3298      "(cos x = 0) =
  3299       ((\<exists>n::nat. odd n & (x = real n * (pi/2))) |
  3300        (\<exists>n::nat. odd n & (x = -(real n * (pi/2)))))"
  3301 proof -
  3302   { fix n :: nat
  3303     assume "odd n"
  3304     then obtain m where "n = 2 * m + 1" ..
  3305     then have "cos (real n * pi / 2) = 0"
  3306       by (simp add: field_simps real_of_nat_Suc) (simp add: cos_add add_divide_distrib)
  3307   } note * = this
  3308   show ?thesis
  3309   apply (rule iffI)
  3310   apply (cut_tac linorder_linear [of 0 x], safe)
  3311   apply (drule cos_zero_lemma, assumption+)
  3312   apply (cut_tac x="-x" in cos_zero_lemma, simp, simp)
  3313   apply (auto dest: *)
  3314   done
  3315 qed
  3316 
  3317 (* ditto: but to a lesser extent *)
  3318 lemma sin_zero_iff:
  3319      "(sin x = 0) =
  3320       ((\<exists>n::nat. even n & (x = real n * (pi/2))) |
  3321        (\<exists>n::nat. even n & (x = -(real n * (pi/2)))))"
  3322 apply (rule iffI)
  3323 apply (cut_tac linorder_linear [of 0 x], safe)
  3324 apply (drule sin_zero_lemma, assumption+)
  3325 apply (cut_tac x="-x" in sin_zero_lemma, simp, simp, safe)
  3326 apply (force simp add: minus_equation_iff [of x])
  3327 apply (auto elim: evenE)
  3328 done
  3329 
  3330 
  3331 lemma cos_zero_iff_int:
  3332      "cos x = 0 \<longleftrightarrow> (\<exists>n::int. odd n & x = real n * (pi/2))"
  3333 proof safe
  3334   assume "cos x = 0"
  3335   then show "\<exists>n::int. odd n & x = real n * (pi/2)"
  3336     apply (simp add: cos_zero_iff, safe)
  3337     apply (metis even_int_iff real_of_int_of_nat_eq)
  3338     apply (rule_tac x="- (int n)" in exI, simp)
  3339     done
  3340 next
  3341   fix n::int
  3342   assume "odd n"
  3343   then show "cos (real n * (pi / 2)) = 0"
  3344     apply (simp add: cos_zero_iff)
  3345     apply (case_tac n rule: int_cases2, simp)
  3346     apply (rule disjI2)
  3347     apply (rule_tac x="nat (-n)" in exI, simp)
  3348     done
  3349 qed
  3350 
  3351 lemma sin_zero_iff_int:
  3352      "sin x = 0 \<longleftrightarrow> (\<exists>n::int. even n & (x = real n * (pi/2)))"
  3353 proof safe
  3354   assume "sin x = 0"
  3355   then show "\<exists>n::int. even n \<and> x = real n * (pi / 2)"
  3356     apply (simp add: sin_zero_iff, safe)
  3357     apply (metis even_int_iff real_of_int_of_nat_eq)
  3358     apply (rule_tac x="- (int n)" in exI, simp)
  3359     done
  3360 next
  3361   fix n::int
  3362   assume "even n"
  3363   then show "sin (real n * (pi / 2)) = 0"
  3364     apply (simp add: sin_zero_iff)
  3365     apply (case_tac n rule: int_cases2, simp)
  3366     apply (rule disjI2)
  3367     apply (rule_tac x="nat (-n)" in exI, simp)
  3368     done
  3369 qed
  3370 
  3371 lemma sin_zero_iff_int2: "sin x = 0 \<longleftrightarrow> (\<exists>n::int. x = real n * pi)"
  3372   apply (simp only: sin_zero_iff_int)
  3373   apply (safe elim!: evenE)
  3374   apply (simp_all add: field_simps)
  3375   using dvd_triv_left by fastforce
  3376 
  3377 lemma cos_monotone_0_pi:
  3378   assumes "0 \<le> y" and "y < x" and "x \<le> pi"
  3379   shows "cos x < cos y"
  3380 proof -
  3381   have "- (x - y) < 0" using assms by auto
  3382 
  3383   from MVT2[OF `y < x` DERIV_cos[THEN impI, THEN allI]]
  3384   obtain z where "y < z" and "z < x" and cos_diff: "cos x - cos y = (x - y) * - sin z"
  3385     by auto
  3386   hence "0 < z" and "z < pi" using assms by auto
  3387   hence "0 < sin z" using sin_gt_zero by auto
  3388   hence "cos x - cos y < 0"
  3389     unfolding cos_diff minus_mult_commute[symmetric]
  3390     using `- (x - y) < 0` by (rule mult_pos_neg2)
  3391   thus ?thesis by auto
  3392 qed
  3393 
  3394 lemma cos_monotone_0_pi_le:
  3395   assumes "0 \<le> y" and "y \<le> x" and "x \<le> pi"
  3396   shows "cos x \<le> cos y"
  3397 proof (cases "y < x")
  3398   case True
  3399   show ?thesis
  3400     using cos_monotone_0_pi[OF `0 \<le> y` True `x \<le> pi`] by auto
  3401 next
  3402   case False
  3403   hence "y = x" using `y \<le> x` by auto
  3404   thus ?thesis by auto
  3405 qed
  3406 
  3407 lemma cos_monotone_minus_pi_0:
  3408   assumes "-pi \<le> y" and "y < x" and "x \<le> 0"
  3409   shows "cos y < cos x"
  3410 proof -
  3411   have "0 \<le> -x" and "-x < -y" and "-y \<le> pi"
  3412     using assms by auto
  3413   from cos_monotone_0_pi[OF this] show ?thesis
  3414     unfolding cos_minus .
  3415 qed
  3416 
  3417 lemma cos_monotone_minus_pi_0':
  3418   assumes "-pi \<le> y" and "y \<le> x" and "x \<le> 0"
  3419   shows "cos y \<le> cos x"
  3420 proof (cases "y < x")
  3421   case True
  3422   show ?thesis using cos_monotone_minus_pi_0[OF `-pi \<le> y` True `x \<le> 0`]
  3423     by auto
  3424 next
  3425   case False
  3426   hence "y = x" using `y \<le> x` by auto
  3427   thus ?thesis by auto
  3428 qed
  3429 
  3430 lemma sin_monotone_2pi:
  3431   assumes "- (pi/2) \<le> y" and "y < x" and "x \<le> pi/2"
  3432   shows "sin y < sin x"
  3433     apply (simp add: sin_cos_eq)
  3434     apply (rule cos_monotone_0_pi)
  3435     using assms
  3436     apply auto
  3437     done
  3438 
  3439 lemma sin_monotone_2pi_le:
  3440   assumes "- (pi / 2) \<le> y" and "y \<le> x" and "x \<le> pi / 2"
  3441   shows "sin y \<le> sin x"
  3442   by (metis assms le_less sin_monotone_2pi)
  3443 
  3444 lemma sin_x_le_x:
  3445   fixes x::real assumes x: "x \<ge> 0" shows "sin x \<le> x"
  3446 proof -
  3447   let ?f = "\<lambda>x. x - sin x"
  3448   from x have "?f x \<ge> ?f 0"
  3449     apply (rule DERIV_nonneg_imp_nondecreasing)
  3450     apply (intro allI impI exI[of _ "1 - cos x" for x])
  3451     apply (auto intro!: derivative_eq_intros simp: field_simps)
  3452     done
  3453   thus "sin x \<le> x" by simp
  3454 qed
  3455 
  3456 lemma sin_x_ge_neg_x:
  3457   fixes x::real assumes x: "x \<ge> 0" shows "sin x \<ge> - x"
  3458 proof -
  3459   let ?f = "\<lambda>x. x + sin x"
  3460   from x have "?f x \<ge> ?f 0"
  3461     apply (rule DERIV_nonneg_imp_nondecreasing)
  3462     apply (intro allI impI exI[of _ "1 + cos x" for x])
  3463     apply (auto intro!: derivative_eq_intros simp: field_simps real_0_le_add_iff)
  3464     done
  3465   thus "sin x \<ge> -x" by simp
  3466 qed
  3467 
  3468 lemma abs_sin_x_le_abs_x:
  3469   fixes x::real shows "\<bar>sin x\<bar> \<le> \<bar>x\<bar>"
  3470   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"]
  3471   by (auto simp: abs_real_def)
  3472 
  3473 
  3474 subsection {* More Corollaries about Sine and Cosine *}
  3475 
  3476 lemma sin_cos_npi [simp]: "sin (real (Suc (2 * n)) * pi / 2) = (-1) ^ n"
  3477 proof -
  3478   have "sin ((real n + 1/2) * pi) = cos (real n * pi)"
  3479     by (auto simp: algebra_simps sin_add)
  3480   thus ?thesis
  3481     by (simp add: real_of_nat_Suc distrib_right add_divide_distrib
  3482                   mult.commute [of pi])
  3483 qed
  3484 
  3485 lemma cos_2npi [simp]: "cos (2 * real (n::nat) * pi) = 1"
  3486   by (cases "even n") (simp_all add: cos_double mult.assoc)
  3487 
  3488 lemma cos_3over2_pi [simp]: "cos (3/2*pi) = 0"
  3489   apply (subgoal_tac "cos (pi + pi/2) = 0", simp)
  3490   apply (subst cos_add, simp)
  3491   done
  3492 
  3493 lemma sin_2npi [simp]: "sin (2 * real (n::nat) * pi) = 0"
  3494   by (auto simp: mult.assoc sin_double)
  3495 
  3496 lemma sin_3over2_pi [simp]: "sin (3/2*pi) = - 1"
  3497   apply (subgoal_tac "sin (pi + pi/2) = - 1", simp)
  3498   apply (subst sin_add, simp)
  3499   done
  3500 
  3501 lemma cos_pi_eq_zero [simp]: "cos (pi * real (Suc (2 * m)) / 2) = 0"
  3502 by (simp only: cos_add sin_add real_of_nat_Suc distrib_right distrib_left add_divide_distrib, auto)
  3503 
  3504 lemma DERIV_cos_add [simp]: "DERIV (\<lambda>x. cos (x + k)) xa :> - sin (xa + k)"
  3505   by (auto intro!: derivative_eq_intros)
  3506 
  3507 lemma sin_zero_norm_cos_one:
  3508   fixes x :: "'a::{real_normed_field,banach}"
  3509   assumes "sin x = 0" shows "norm (cos x) = 1"
  3510   using sin_cos_squared_add [of x, unfolded assms]
  3511   by (simp add: square_norm_one)
  3512 
  3513 lemma sin_zero_abs_cos_one: "sin x = 0 \<Longrightarrow> \<bar>cos x\<bar> = (1::real)"
  3514   using sin_zero_norm_cos_one by fastforce
  3515 
  3516 lemma cos_one_sin_zero:
  3517   fixes x :: "'a::{real_normed_field,banach}"
  3518   assumes "cos x = 1" shows "sin x = 0"
  3519   using sin_cos_squared_add [of x, unfolded assms]
  3520   by simp
  3521 
  3522 lemma sin_times_pi_eq_0: "sin(x * pi) = 0 \<longleftrightarrow> x \<in> Ints"
  3523   by (simp add: sin_zero_iff_int2) (metis Ints_cases Ints_real_of_int real_of_int_def)
  3524 
  3525 lemma cos_one_2pi: 
  3526     "cos(x) = 1 \<longleftrightarrow> (\<exists>n::nat. x = n * 2*pi) | (\<exists>n::nat. x = -(n * 2*pi))"
  3527     (is "?lhs = ?rhs")
  3528 proof
  3529   assume "cos(x) = 1"
  3530   then have "sin x = 0"
  3531     by (simp add: cos_one_sin_zero)
  3532   then show ?rhs
  3533   proof (simp only: sin_zero_iff, elim exE disjE conjE)
  3534     fix n::nat
  3535     assume n: "even n" "x = real n * (pi/2)"
  3536     then obtain m where m: "n = 2 * m"
  3537       using dvdE by blast
  3538     then have me: "even m" using `?lhs` n
  3539       by (auto simp: field_simps) (metis one_neq_neg_one  power_minus_odd power_one)
  3540     show ?rhs
  3541       using m me n
  3542       by (auto simp: field_simps elim!: evenE)
  3543   next    
  3544     fix n::nat
  3545     assume n: "even n" "x = - (real n * (pi/2))"
  3546     then obtain m where m: "n = 2 * m"
  3547       using dvdE by blast
  3548     then have me: "even m" using `?lhs` n
  3549       by (auto simp: field_simps) (metis one_neq_neg_one  power_minus_odd power_one)
  3550     show ?rhs
  3551       using m me n
  3552       by (auto simp: field_simps elim!: evenE)
  3553   qed
  3554 next
  3555   assume "?rhs"
  3556   then show "cos x = 1"
  3557     by (metis cos_2npi cos_minus mult.assoc mult.left_commute)
  3558 qed
  3559 
  3560 lemma cos_one_2pi_int: "cos(x) = 1 \<longleftrightarrow> (\<exists>n::int. x = n * 2*pi)"
  3561   apply auto  --{*FIXME simproc bug*}
  3562   apply (auto simp: cos_one_2pi)
  3563   apply (metis real_of_int_of_nat_eq)
  3564   apply (metis mult_minus_right real_of_int_minus real_of_int_of_nat_eq)
  3565   by (metis mult_minus_right of_int_of_nat real_of_int_def real_of_nat_def)
  3566 
  3567 lemma sin_cos_sqrt: "0 \<le> sin(x) \<Longrightarrow> (sin(x) = sqrt(1 - (cos(x) ^ 2)))"
  3568   using sin_squared_eq real_sqrt_unique by fastforce
  3569 
  3570 lemma sin_eq_0_pi: "-pi < x \<Longrightarrow> x < pi \<Longrightarrow> sin(x) = 0 \<Longrightarrow> x = 0"
  3571   by (metis sin_gt_zero sin_minus minus_less_iff neg_0_less_iff_less not_less_iff_gr_or_eq)
  3572 
  3573 lemma cos_treble_cos: 
  3574   fixes x :: "'a::{real_normed_field,banach}"
  3575   shows "cos(3 * x) = 4 * cos(x) ^ 3 - 3 * cos x"
  3576 proof -
  3577   have *: "(sin x * (sin x * 3)) = 3 - (cos x * (cos x * 3))"
  3578     by (simp add: mult.assoc [symmetric] sin_squared_eq [unfolded power2_eq_square])
  3579   have "cos(3 * x) = cos(2*x + x)"
  3580     by simp
  3581   also have "... = 4 * cos(x) ^ 3 - 3 * cos x"
  3582     apply (simp only: cos_add cos_double sin_double)
  3583     apply (simp add: * field_simps power2_eq_square power3_eq_cube)
  3584     done
  3585   finally show ?thesis .
  3586 qed
  3587 
  3588 lemma cos_45: "cos (pi / 4) = sqrt 2 / 2"
  3589 proof -
  3590   let ?c = "cos (pi / 4)" and ?s = "sin (pi / 4)"
  3591   have nonneg: "0 \<le> ?c"
  3592     by (simp add: cos_ge_zero)
  3593   have "0 = cos (pi / 4 + pi / 4)"
  3594     by simp
  3595   also have "cos (pi / 4 + pi / 4) = ?c\<^sup>2 - ?s\<^sup>2"
  3596     by (simp only: cos_add power2_eq_square)
  3597   also have "\<dots> = 2 * ?c\<^sup>2 - 1"
  3598     by (simp add: sin_squared_eq)
  3599   finally have "?c\<^sup>2 = (sqrt 2 / 2)\<^sup>2"
  3600     by (simp add: power_divide)
  3601   thus ?thesis
  3602     using nonneg by (rule power2_eq_imp_eq) simp
  3603 qed
  3604 
  3605 lemma cos_30: "cos (pi / 6) = sqrt 3/2"
  3606 proof -
  3607   let ?c = "cos (pi / 6)" and ?s = "sin (pi / 6)"
  3608   have pos_c: "0 < ?c"
  3609     by (rule cos_gt_zero, simp, simp)
  3610   have "0 = cos (pi / 6 + pi / 6 + pi / 6)"
  3611     by simp
  3612   also have "\<dots> = (?c * ?c - ?s * ?s) * ?c - (?s * ?c + ?c * ?s) * ?s"
  3613     by (simp only: cos_add sin_add)
  3614   also have "\<dots> = ?c * (?c\<^sup>2 - 3 * ?s\<^sup>2)"
  3615     by (simp add: algebra_simps power2_eq_square)
  3616   finally have "?c\<^sup>2 = (sqrt 3/2)\<^sup>2"
  3617     using pos_c by (simp add: sin_squared_eq power_divide)
  3618   thus ?thesis
  3619     using pos_c [THEN order_less_imp_le]
  3620     by (rule power2_eq_imp_eq) simp
  3621 qed
  3622 
  3623 lemma sin_45: "sin (pi / 4) = sqrt 2 / 2"
  3624   by (simp add: sin_cos_eq cos_45)
  3625 
  3626 lemma sin_60: "sin (pi / 3) = sqrt 3/2"
  3627   by (simp add: sin_cos_eq cos_30)
  3628 
  3629 lemma cos_60: "cos (pi / 3) = 1 / 2"
  3630   apply (rule power2_eq_imp_eq)
  3631   apply (simp add: cos_squared_eq sin_60 power_divide)
  3632   apply (rule cos_ge_zero, rule order_trans [where y=0], simp_all)
  3633   done
  3634 
  3635 lemma sin_30: "sin (pi / 6) = 1 / 2"
  3636   by (simp add: sin_cos_eq cos_60)
  3637 
  3638 lemma cos_integer_2pi: "n \<in> Ints \<Longrightarrow> cos(2*pi * n) = 1"
  3639   by (metis Ints_cases cos_one_2pi_int mult.assoc mult.commute real_of_int_def)
  3640 
  3641 lemma sin_integer_2pi: "n \<in> Ints \<Longrightarrow> sin(2*pi * n) = 0"
  3642   by (metis sin_two_pi Ints_mult mult.assoc mult.commute sin_times_pi_eq_0)
  3643 
  3644 lemma cos_int_2npi [simp]: "cos (2 * real (n::int) * pi) = 1"
  3645   by (simp add: cos_one_2pi_int)
  3646 
  3647 lemma sin_int_2npi [simp]: "sin (2 * real (n::int) * pi) = 0"
  3648   by (metis Ints_real_of_int mult.assoc mult.commute sin_integer_2pi)
  3649 
  3650 lemma sincos_principal_value: "\<exists>y. (-pi < y \<and> y \<le> pi) \<and> (sin(y) = sin(x) \<and> cos(y) = cos(x))"
  3651   apply (rule exI [where x="pi - (2*pi) * frac((pi - x) / (2*pi))"])
  3652   apply (auto simp: field_simps frac_lt_1)
  3653   apply (simp_all add: frac_def divide_simps)
  3654   apply (simp_all add: add_divide_distrib diff_divide_distrib)
  3655   apply (simp_all add: sin_diff cos_diff mult.assoc [symmetric] cos_integer_2pi sin_integer_2pi)
  3656   done
  3657 
  3658 
  3659 subsection {* Tangent *}
  3660 
  3661 definition tan :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  3662   where "tan = (\<lambda>x. sin x / cos x)"
  3663 
  3664 lemma tan_zero [simp]: "tan 0 = 0"
  3665   by (simp add: tan_def)
  3666 
  3667 lemma tan_pi [simp]: "tan pi = 0"
  3668   by (simp add: tan_def)
  3669 
  3670 lemma tan_npi [simp]: "tan (real (n::nat) * pi) = 0"
  3671   by (simp add: tan_def)
  3672 
  3673 lemma tan_minus [simp]: "tan (-x) = - tan x"
  3674   by (simp add: tan_def)
  3675 
  3676 lemma tan_periodic [simp]: "tan (x + 2*pi) = tan x"
  3677   by (simp add: tan_def)
  3678 
  3679 lemma lemma_tan_add1:
  3680   "\<lbrakk>cos x \<noteq> 0; cos y \<noteq> 0\<rbrakk> \<Longrightarrow> 1 - tan x * tan y = cos (x + y)/(cos x * cos y)"
  3681   by (simp add: tan_def cos_add field_simps)
  3682 
  3683 lemma add_tan_eq:
  3684   fixes x :: "'a::{real_normed_field,banach}"
  3685   shows "\<lbrakk>cos x \<noteq> 0; cos y \<noteq> 0\<rbrakk> \<Longrightarrow> tan x + tan y = sin(x + y)/(cos x * cos y)"
  3686   by (simp add: tan_def sin_add field_simps)
  3687 
  3688 lemma tan_add:
  3689   fixes x :: "'a::{real_normed_field,banach}"
  3690   shows
  3691      "\<lbrakk>cos x \<noteq> 0; cos y \<noteq> 0; cos (x + y) \<noteq> 0\<rbrakk>
  3692       \<Longrightarrow> tan(x + y) = (tan(x) + tan(y))/(1 - tan(x) * tan(y))"
  3693       by (simp add: add_tan_eq lemma_tan_add1 field_simps) (simp add: tan_def)
  3694 
  3695 lemma tan_double:
  3696   fixes x :: "'a::{real_normed_field,banach}"
  3697   shows
  3698      "\<lbrakk>cos x \<noteq> 0; cos (2 * x) \<noteq> 0\<rbrakk>
  3699       \<Longrightarrow> tan (2 * x) = (2 * tan x) / (1 - (tan x)\<^sup>2)"
  3700   using tan_add [of x x] by (simp add: power2_eq_square)
  3701 
  3702 lemma tan_gt_zero: "\<lbrakk>0 < x; x < pi/2\<rbrakk> \<Longrightarrow> 0 < tan x"
  3703   by (simp add: tan_def zero_less_divide_iff sin_gt_zero2 cos_gt_zero_pi)
  3704 
  3705 lemma tan_less_zero:
  3706   assumes lb: "- pi/2 < x" and "x < 0"
  3707   shows "tan x < 0"
  3708 proof -
  3709   have "0 < tan (- x)" using assms by (simp only: tan_gt_zero)
  3710   thus ?thesis by simp
  3711 qed
  3712 
  3713 lemma tan_half:
  3714   fixes x :: "'a::{real_normed_field,banach,field_inverse_zero}"
  3715   shows  "tan x = sin (2 * x) / (cos (2 * x) + 1)"
  3716   unfolding tan_def sin_double cos_double sin_squared_eq
  3717   by (simp add: power2_eq_square)
  3718 
  3719 lemma tan_30: "tan (pi / 6) = 1 / sqrt 3"
  3720   unfolding tan_def by (simp add: sin_30 cos_30)
  3721 
  3722 lemma tan_45: "tan (pi / 4) = 1"
  3723   unfolding tan_def by (simp add: sin_45 cos_45)
  3724 
  3725 lemma tan_60: "tan (pi / 3) = sqrt 3"
  3726   unfolding tan_def by (simp add: sin_60 cos_60)
  3727 
  3728 lemma DERIV_tan [simp]:
  3729   fixes x :: "'a::{real_normed_field,banach}"
  3730   shows "cos x \<noteq> 0 \<Longrightarrow> DERIV tan x :> inverse ((cos x)\<^sup>2)"
  3731   unfolding tan_def
  3732   by (auto intro!: derivative_eq_intros, simp add: divide_inverse power2_eq_square)
  3733 
  3734 lemma isCont_tan:
  3735   fixes x :: "'a::{real_normed_field,banach}"
  3736   shows "cos x \<noteq> 0 \<Longrightarrow> isCont tan x"
  3737   by (rule DERIV_tan [THEN DERIV_isCont])
  3738 
  3739 lemma isCont_tan' [simp,continuous_intros]:
  3740   fixes a :: "'a::{real_normed_field,banach}" and f :: "'a \<Rightarrow> 'a"
  3741   shows "\<lbrakk>isCont f a; cos (f a) \<noteq> 0\<rbrakk> \<Longrightarrow> isCont (\<lambda>x. tan (f x)) a"
  3742   by (rule isCont_o2 [OF _ isCont_tan])
  3743 
  3744 lemma tendsto_tan [tendsto_intros]:
  3745   fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  3746   shows "\<lbrakk>(f ---> a) F; cos a \<noteq> 0\<rbrakk> \<Longrightarrow> ((\<lambda>x. tan (f x)) ---> tan a) F"
  3747   by (rule isCont_tendsto_compose [OF isCont_tan])
  3748 
  3749 lemma continuous_tan:
  3750   fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  3751   shows "continuous F f \<Longrightarrow> cos (f (Lim F (\<lambda>x. x))) \<noteq> 0 \<Longrightarrow> continuous F (\<lambda>x. tan (f x))"
  3752   unfolding continuous_def by (rule tendsto_tan)
  3753 
  3754 lemma continuous_on_tan [continuous_intros]:
  3755   fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  3756   shows "continuous_on s f \<Longrightarrow> (\<forall>x\<in>s. cos (f x) \<noteq> 0) \<Longrightarrow> continuous_on s (\<lambda>x. tan (f x))"
  3757   unfolding continuous_on_def by (auto intro: tendsto_tan)
  3758 
  3759 lemma continuous_within_tan [continuous_intros]:
  3760   fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
  3761   shows
  3762   "continuous (at x within s) f \<Longrightarrow> cos (f x) \<noteq> 0 \<Longrightarrow> continuous (at x within s) (\<lambda>x. tan (f x))"
  3763   unfolding continuous_within by (rule tendsto_tan)
  3764 
  3765 lemma LIM_cos_div_sin: "(\<lambda>x. cos(x)/sin(x)) -- pi/2 --> 0"
  3766   by (rule LIM_cong_limit, (rule tendsto_intros)+, simp_all)
  3767 
  3768 lemma lemma_tan_total: "0 < y ==> \<exists>x. 0 < x & x < pi/2 & y < tan x"
  3769   apply (cut_tac LIM_cos_div_sin)
  3770   apply (simp only: LIM_eq)
  3771   apply (drule_tac x = "inverse y" in spec, safe, force)
  3772   apply (drule_tac ?d1.0 = s in pi_half_gt_zero [THEN [2] real_lbound_gt_zero], safe)
  3773   apply (rule_tac x = "(pi/2) - e" in exI)
  3774   apply (simp (no_asm_simp))
  3775   apply (drule_tac x = "(pi/2) - e" in spec)
  3776   apply (auto simp add: tan_def sin_diff cos_diff)
  3777   apply (rule inverse_less_iff_less [THEN iffD1])
  3778   apply (auto simp add: divide_inverse)
  3779   apply (rule mult_pos_pos)
  3780   apply (subgoal_tac [3] "0 < sin e & 0 < cos e")
  3781   apply (auto intro: cos_gt_zero sin_gt_zero2 simp add: mult.commute)
  3782   done
  3783 
  3784 lemma tan_total_pos: "0 \<le> y ==> \<exists>x. 0 \<le> x & x < pi/2 & tan x = y"
  3785   apply (frule order_le_imp_less_or_eq, safe)
  3786    prefer 2 apply force
  3787   apply (drule lemma_tan_total, safe)
  3788   apply (cut_tac f = tan and a = 0 and b = x and y = y in IVT_objl)
  3789   apply (auto intro!: DERIV_tan [THEN DERIV_isCont])
  3790   apply (drule_tac y = xa in order_le_imp_less_or_eq)
  3791   apply (auto dest: cos_gt_zero)
  3792   done
  3793 
  3794 lemma lemma_tan_total1: "\<exists>x. -(pi/2) < x & x < (pi/2) & tan x = y"
  3795   apply (cut_tac linorder_linear [of 0 y], safe)
  3796   apply (drule tan_total_pos)
  3797   apply (cut_tac [2] y="-y" in tan_total_pos, safe)
  3798   apply (rule_tac [3] x = "-x" in exI)
  3799   apply (auto del: exI intro!: exI)
  3800   done
  3801 
  3802 lemma tan_total: "EX! x. -(pi/2) < x & x < (pi/2) & tan x = y"
  3803   apply (cut_tac y = y in lemma_tan_total1, auto)
  3804   apply hypsubst_thin
  3805   apply (cut_tac x = xa and y = y in linorder_less_linear, auto)
  3806   apply (subgoal_tac [2] "\<exists>z. y < z & z < xa & DERIV tan z :> 0")
  3807   apply (subgoal_tac "\<exists>z. xa < z & z < y & DERIV tan z :> 0")
  3808   apply (rule_tac [4] Rolle)
  3809   apply (rule_tac [2] Rolle)
  3810   apply (auto del: exI intro!: DERIV_tan DERIV_isCont exI
  3811               simp add: real_differentiable_def)
  3812   txt{*Now, simulate TRYALL*}
  3813   apply (rule_tac [!] DERIV_tan asm_rl)
  3814   apply (auto dest!: DERIV_unique [OF _ DERIV_tan]
  3815               simp add: cos_gt_zero_pi [THEN less_imp_neq, THEN not_sym])
  3816   done
  3817 
  3818 lemma tan_monotone:
  3819   assumes "- (pi / 2) < y" and "y < x" and "x < pi / 2"
  3820   shows "tan y < tan x"
  3821 proof -
  3822   have "\<forall>x'. y \<le> x' \<and> x' \<le> x \<longrightarrow> DERIV tan x' :> inverse ((cos x')\<^sup>2)"
  3823   proof (rule allI, rule impI)
  3824     fix x' :: real
  3825     assume "y \<le> x' \<and> x' \<le> x"
  3826     hence "-(pi/2) < x'" and "x' < pi/2" using assms by auto
  3827     from cos_gt_zero_pi[OF this]
  3828     have "cos x' \<noteq> 0" by auto
  3829     thus "DERIV tan x' :> inverse ((cos x')\<^sup>2)" by (rule DERIV_tan)
  3830   qed
  3831   from MVT2[OF `y < x` this]
  3832   obtain z where "y < z" and "z < x"
  3833     and tan_diff: "tan x - tan y = (x - y) * inverse ((cos z)\<^sup>2)" by auto
  3834   hence "- (pi / 2) < z" and "z < pi / 2" using assms by auto
  3835   hence "0 < cos z" using cos_gt_zero_pi by auto
  3836   hence inv_pos: "0 < inverse ((cos z)\<^sup>2)" by auto
  3837   have "0 < x - y" using `y < x` by auto
  3838   with inv_pos have "0 < tan x - tan y" unfolding tan_diff by auto
  3839   thus ?thesis by auto
  3840 qed
  3841 
  3842 lemma tan_monotone':
  3843   assumes "- (pi / 2) < y"
  3844     and "y < pi / 2"
  3845     and "- (pi / 2) < x"
  3846     and "x < pi / 2"
  3847   shows "(y < x) = (tan y < tan x)"
  3848 proof
  3849   assume "y < x"
  3850   thus "tan y < tan x"
  3851     using tan_monotone and `- (pi / 2) < y` and `x < pi / 2` by auto
  3852 next
  3853   assume "tan y < tan x"
  3854   show "y < x"
  3855   proof (rule ccontr)
  3856     assume "\<not> y < x" hence "x \<le> y" by auto
  3857     hence "tan x \<le> tan y"
  3858     proof (cases "x = y")
  3859       case True thus ?thesis by auto
  3860     next
  3861       case False hence "x < y" using `x \<le> y` by auto
  3862       from tan_monotone[OF `- (pi/2) < x` this `y < pi / 2`] show ?thesis by auto
  3863     qed
  3864     thus False using `tan y < tan x` by auto
  3865   qed
  3866 qed
  3867 
  3868 lemma tan_inverse: "1 / (tan y) = tan (pi / 2 - y)"
  3869   unfolding tan_def sin_cos_eq[of y] cos_sin_eq[of y] by auto
  3870 
  3871 lemma tan_periodic_pi[simp]: "tan (x + pi) = tan x"
  3872   by (simp add: tan_def)
  3873 
  3874 lemma tan_periodic_nat[simp]:
  3875   fixes n :: nat
  3876   shows "tan (x + real n * pi) = tan x"
  3877 proof (induct n arbitrary: x)
  3878   case 0
  3879   then show ?case by simp
  3880 next
  3881   case (Suc n)
  3882   have split_pi_off: "x + real (Suc n) * pi = (x + real n * pi) + pi"
  3883     unfolding Suc_eq_plus1 real_of_nat_add real_of_one distrib_right by auto
  3884   show ?case unfolding split_pi_off using Suc by auto
  3885 qed
  3886 
  3887 lemma tan_periodic_int[simp]: fixes i :: int shows "tan (x + real i * pi) = tan x"
  3888 proof (cases "0 \<le> i")
  3889   case True
  3890   hence i_nat: "real i = real (nat i)" by auto
  3891   show ?thesis unfolding i_nat by auto
  3892 next
  3893   case False
  3894   hence i_nat: "real i = - real (nat (-i))" by auto
  3895   have "tan x = tan (x + real i * pi - real i * pi)"
  3896     by auto
  3897   also have "\<dots> = tan (x + real i * pi)"
  3898     unfolding i_nat mult_minus_left diff_minus_eq_add by (rule tan_periodic_nat)
  3899   finally show ?thesis by auto
  3900 qed
  3901 
  3902 lemma tan_periodic_n[simp]: "tan (x + numeral n * pi) = tan x"
  3903   using tan_periodic_int[of _ "numeral n" ] unfolding real_numeral .
  3904 
  3905 lemma tan_minus_45: "tan (-(pi/4)) = -1"
  3906   unfolding tan_def by (simp add: sin_45 cos_45)
  3907 
  3908 lemma tan_diff:
  3909   fixes x :: "'a::{real_normed_field,banach}"
  3910   shows
  3911      "\<lbrakk>cos x \<noteq> 0; cos y \<noteq> 0; cos (x - y) \<noteq> 0\<rbrakk>
  3912       \<Longrightarrow> tan(x - y) = (tan(x) - tan(y))/(1 + tan(x) * tan(y))"
  3913   using tan_add [of x "-y"]
  3914   by simp
  3915 
  3916 
  3917 lemma tan_pos_pi2_le: "0 \<le> x ==> x < pi/2 \<Longrightarrow> 0 \<le> tan x"
  3918   using less_eq_real_def tan_gt_zero by auto
  3919 
  3920 lemma cos_tan: "abs(x) < pi/2 \<Longrightarrow> cos(x) = 1 / sqrt(1 + tan(x) ^ 2)"
  3921   using cos_gt_zero_pi [of x]
  3922   by (simp add: divide_simps tan_def real_sqrt_divide abs_if split: split_if_asm)
  3923 
  3924 lemma sin_tan: "abs(x) < pi/2 \<Longrightarrow> sin(x) = tan(x) / sqrt(1 + tan(x) ^ 2)"
  3925   using cos_gt_zero [of "x"] cos_gt_zero [of "-x"]
  3926   by (force simp add: divide_simps tan_def real_sqrt_divide abs_if split: split_if_asm)
  3927 
  3928 lemma tan_mono_le: "-(pi/2) < x ==> x \<le> y ==> y < pi/2 \<Longrightarrow> tan(x) \<le> tan(y)"
  3929   using less_eq_real_def tan_monotone by auto
  3930 
  3931 lemma tan_mono_lt_eq: "-(pi/2) < x ==> x < pi/2 ==> -(pi/2) < y ==> y < pi/2
  3932          \<Longrightarrow> (tan(x) < tan(y) \<longleftrightarrow> x < y)"
  3933   using tan_monotone' by blast
  3934 
  3935 lemma tan_mono_le_eq: "-(pi/2) < x ==> x < pi/2 ==> -(pi/2) < y ==> y < pi/2
  3936          \<Longrightarrow> (tan(x) \<le> tan(y) \<longleftrightarrow> x \<le> y)"
  3937   by (meson tan_mono_le not_le tan_monotone)
  3938 
  3939 lemma tan_bound_pi2: "abs(x) < pi/4 \<Longrightarrow> abs(tan x) < 1"
  3940   using tan_45 tan_monotone [of x "pi/4"] tan_monotone [of "-x" "pi/4"]
  3941   by (auto simp: abs_if split: split_if_asm)
  3942 
  3943 lemma tan_cot: "tan(pi/2 - x) = inverse(tan x)"
  3944   by (simp add: tan_def sin_diff cos_diff)
  3945 
  3946 subsection {* Inverse Trigonometric Functions *}
  3947 
  3948 definition arcsin :: "real => real"
  3949   where "arcsin y = (THE x. -(pi/2) \<le> x & x \<le> pi/2 & sin x = y)"
  3950 
  3951 definition arccos :: "real => real"
  3952   where "arccos y = (THE x. 0 \<le> x & x \<le> pi & cos x = y)"
  3953 
  3954 definition arctan :: "real => real"
  3955   where "arctan y = (THE x. -(pi/2) < x & x < pi/2 & tan x = y)"
  3956 
  3957 lemma arcsin:
  3958   "-1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow>
  3959     -(pi/2) \<le> arcsin y & arcsin y \<le> pi/2 & sin(arcsin y) = y"
  3960   unfolding arcsin_def by (rule theI' [OF sin_total])
  3961 
  3962 lemma arcsin_pi:
  3963   "-1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> -(pi/2) \<le> arcsin y & arcsin y \<le> pi & sin(arcsin y) = y"
  3964   apply (drule (1) arcsin)
  3965   apply (force intro: order_trans)
  3966   done
  3967 
  3968 lemma sin_arcsin [simp]: "-1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> sin(arcsin y) = y"
  3969   by (blast dest: arcsin)
  3970 
  3971 lemma arcsin_bounded: "-1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> -(pi/2) \<le> arcsin y & arcsin y \<le> pi/2"
  3972   by (blast dest: arcsin)
  3973 
  3974 lemma arcsin_lbound: "-1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> -(pi/2) \<le> arcsin y"
  3975   by (blast dest: arcsin)
  3976 
  3977 lemma arcsin_ubound: "-1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> arcsin y \<le> pi/2"
  3978   by (blast dest: arcsin)
  3979 
  3980 lemma arcsin_lt_bounded:
  3981      "\<lbrakk>-1 < y; y < 1\<rbrakk> \<Longrightarrow> -(pi/2) < arcsin y & arcsin y < pi/2"
  3982   apply (frule order_less_imp_le)
  3983   apply (frule_tac y = y in order_less_imp_le)
  3984   apply (frule arcsin_bounded)
  3985   apply (safe, simp)
  3986   apply (drule_tac y = "arcsin y" in order_le_imp_less_or_eq)
  3987   apply (drule_tac [2] y = "pi/2" in order_le_imp_less_or_eq, safe)
  3988   apply (drule_tac [!] f = sin in arg_cong, auto)
  3989   done
  3990 
  3991 lemma arcsin_sin: "\<lbrakk>-(pi/2) \<le> x; x \<le> pi/2\<rbrakk> \<Longrightarrow> arcsin(sin x) = x"
  3992   apply (unfold arcsin_def)
  3993   apply (rule the1_equality)
  3994   apply (rule sin_total, auto)
  3995   done
  3996 
  3997 lemma arccos:
  3998      "\<lbrakk>-1 \<le> y; y \<le> 1\<rbrakk>
  3999       \<Longrightarrow> 0 \<le> arccos y & arccos y \<le> pi & cos(arccos y) = y"
  4000   unfolding arccos_def by (rule theI' [OF cos_total])
  4001 
  4002 lemma cos_arccos [simp]: "\<lbrakk>-1 \<le> y; y \<le> 1\<rbrakk> \<Longrightarrow> cos(arccos y) = y"
  4003   by (blast dest: arccos)
  4004 
  4005 lemma arccos_bounded: "\<lbrakk>-1 \<le> y; y \<le> 1\<rbrakk> \<Longrightarrow> 0 \<le> arccos y & arccos y \<le> pi"
  4006   by (blast dest: arccos)
  4007 
  4008 lemma arccos_lbound: "\<lbrakk>-1 \<le> y; y \<le> 1\<rbrakk> \<Longrightarrow> 0 \<le> arccos y"
  4009   by (blast dest: arccos)
  4010 
  4011 lemma arccos_ubound: "\<lbrakk>-1 \<le> y; y \<le> 1\<rbrakk> \<Longrightarrow> arccos y \<le> pi"
  4012   by (blast dest: arccos)
  4013 
  4014 lemma arccos_lt_bounded:
  4015      "\<lbrakk>-1 < y; y < 1\<rbrakk>
  4016       \<Longrightarrow> 0 < arccos y & arccos y < pi"
  4017   apply (frule order_less_imp_le)
  4018   apply (frule_tac y = y in order_less_imp_le)
  4019   apply (frule arccos_bounded, auto)
  4020   apply (drule_tac y = "arccos y" in order_le_imp_less_or_eq)
  4021   apply (drule_tac [2] y = pi in order_le_imp_less_or_eq, auto)
  4022   apply (drule_tac [!] f = cos in arg_cong, auto)
  4023   done
  4024 
  4025 lemma arccos_cos: "\<lbrakk>0 \<le> x; x \<le> pi\<rbrakk> \<Longrightarrow> arccos(cos x) = x"
  4026   apply (simp add: arccos_def)
  4027   apply (auto intro!: the1_equality cos_total)
  4028   done
  4029 
  4030 lemma arccos_cos2: "\<lbrakk>x \<le> 0; -pi \<le> x\<rbrakk> \<Longrightarrow> arccos(cos x) = -x"
  4031   apply (simp add: arccos_def)
  4032   apply (auto intro!: the1_equality cos_total)
  4033   done
  4034 
  4035 lemma cos_arcsin: "\<lbrakk>-1 \<le> x; x \<le> 1\<rbrakk> \<Longrightarrow> cos (arcsin x) = sqrt (1 - x\<^sup>2)"
  4036   apply (subgoal_tac "x\<^sup>2 \<le> 1")
  4037   apply (rule power2_eq_imp_eq)
  4038   apply (simp add: cos_squared_eq)
  4039   apply (rule cos_ge_zero)
  4040   apply (erule (1) arcsin_lbound)
  4041   apply (erule (1) arcsin_ubound)
  4042   apply simp
  4043   apply (subgoal_tac "\<bar>x\<bar>\<^sup>2 \<le> 1\<^sup>2", simp)
  4044   apply (rule power_mono, simp, simp)
  4045   done
  4046 
  4047 lemma sin_arccos: "\<lbrakk>-1 \<le> x; x \<le> 1\<rbrakk> \<Longrightarrow> sin (arccos x) = sqrt (1 - x\<^sup>2)"
  4048   apply (subgoal_tac "x\<^sup>2 \<le> 1")
  4049   apply (rule power2_eq_imp_eq)
  4050   apply (simp add: sin_squared_eq)
  4051   apply (rule sin_ge_zero)
  4052   apply (erule (1) arccos_lbound)
  4053   apply (erule (1) arccos_ubound)
  4054   apply simp
  4055   apply (subgoal_tac "\<bar>x\<bar>\<^sup>2 \<le> 1\<^sup>2", simp)
  4056   apply (rule power_mono, simp, simp)
  4057   done
  4058 
  4059 lemma arccos_0 [simp]: "arccos 0 = pi/2"
  4060 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)
  4061 
  4062 lemma arccos_1 [simp]: "arccos 1 = 0"
  4063   using arccos_cos by force
  4064 
  4065 lemma arctan [simp]: "- (pi/2) < arctan y  & arctan y < pi/2 & tan (arctan y) = y"
  4066   unfolding arctan_def by (rule theI' [OF tan_total])
  4067 
  4068 lemma tan_arctan: "tan (arctan y) = y"
  4069   by auto
  4070 
  4071 lemma arctan_bounded: "- (pi/2) < arctan y  & arctan y < pi/2"
  4072   by (auto simp only: arctan)
  4073 
  4074 lemma arctan_lbound: "- (pi/2) < arctan y"
  4075   by auto
  4076 
  4077 lemma arctan_ubound: "arctan y < pi/2"
  4078   by (auto simp only: arctan)
  4079 
  4080 lemma arctan_unique:
  4081   assumes "-(pi/2) < x"
  4082     and "x < pi/2"
  4083     and "tan x = y"
  4084   shows "arctan y = x"
  4085   using assms arctan [of y] tan_total [of y] by (fast elim: ex1E)
  4086 
  4087 lemma arctan_tan: "-(pi/2) < x \<Longrightarrow> x < pi/2 \<Longrightarrow> arctan (tan x) = x"
  4088   by (rule arctan_unique) simp_all
  4089 
  4090 lemma arctan_zero_zero [simp]: "arctan 0 = 0"
  4091   by (rule arctan_unique) simp_all
  4092 
  4093 lemma arctan_minus: "arctan (- x) = - arctan x"
  4094   apply (rule arctan_unique)
  4095   apply (simp only: neg_less_iff_less arctan_ubound)
  4096   apply (metis minus_less_iff arctan_lbound, simp)
  4097   done
  4098 
  4099 lemma cos_arctan_not_zero [simp]: "cos (arctan x) \<noteq> 0"
  4100   by (intro less_imp_neq [symmetric] cos_gt_zero_pi
  4101     arctan_lbound arctan_ubound)
  4102 
  4103 lemma cos_arctan: "cos (arctan x) = 1 / sqrt (1 + x\<^sup>2)"
  4104 proof (rule power2_eq_imp_eq)
  4105   have "0 < 1 + x\<^sup>2" by (simp add: add_pos_nonneg)
  4106   show "0 \<le> 1 / sqrt (1 + x\<^sup>2)" by simp
  4107   show "0 \<le> cos (arctan x)"
  4108     by (intro less_imp_le cos_gt_zero_pi arctan_lbound arctan_ubound)
  4109   have "(cos (arctan x))\<^sup>2 * (1 + (tan (arctan x))\<^sup>2) = 1"
  4110     unfolding tan_def by (simp add: distrib_left power_divide)
  4111   thus "(cos (arctan x))\<^sup>2 = (1 / sqrt (1 + x\<^sup>2))\<^sup>2"
  4112     using `0 < 1 + x\<^sup>2` by (simp add: power_divide eq_divide_eq)
  4113 qed
  4114 
  4115 lemma sin_arctan: "sin (arctan x) = x / sqrt (1 + x\<^sup>2)"
  4116   using add_pos_nonneg [OF zero_less_one zero_le_power2 [of x]]
  4117   using tan_arctan [of x] unfolding tan_def cos_arctan
  4118   by (simp add: eq_divide_eq)
  4119 
  4120 lemma tan_sec:
  4121   fixes x :: "'a::{real_normed_field,banach,field_inverse_zero}"
  4122   shows "cos x \<noteq> 0 \<Longrightarrow> 1 + (tan x)\<^sup>2 = (inverse (cos x))\<^sup>2"
  4123   apply (rule power_inverse [THEN subst])
  4124   apply (rule_tac c1 = "(cos x)\<^sup>2" in mult_right_cancel [THEN iffD1])
  4125   apply (auto dest: field_power_not_zero
  4126           simp add: power_mult_distrib distrib_right power_divide tan_def
  4127                     mult.assoc power_inverse [symmetric])
  4128   done
  4129 
  4130 lemma arctan_less_iff: "arctan x < arctan y \<longleftrightarrow> x < y"
  4131   by (metis tan_monotone' arctan_lbound arctan_ubound tan_arctan)
  4132 
  4133 lemma arctan_le_iff: "arctan x \<le> arctan y \<longleftrightarrow> x \<le> y"
  4134   by (simp only: not_less [symmetric] arctan_less_iff)
  4135 
  4136 lemma arctan_eq_iff: "arctan x = arctan y \<longleftrightarrow> x = y"
  4137   by (simp only: eq_iff [where 'a=real] arctan_le_iff)
  4138 
  4139 lemma zero_less_arctan_iff [simp]: "0 < arctan x \<longleftrightarrow> 0 < x"
  4140   using arctan_less_iff [of 0 x] by simp
  4141 
  4142 lemma arctan_less_zero_iff [simp]: "arctan x < 0 \<longleftrightarrow> x < 0"
  4143   using arctan_less_iff [of x 0] by simp
  4144 
  4145 lemma zero_le_arctan_iff [simp]: "0 \<le> arctan x \<longleftrightarrow> 0 \<le> x"
  4146   using arctan_le_iff [of 0 x] by simp
  4147 
  4148 lemma arctan_le_zero_iff [simp]: "arctan x \<le> 0 \<longleftrightarrow> x \<le> 0"
  4149   using arctan_le_iff [of x 0] by simp
  4150 
  4151 lemma arctan_eq_zero_iff [simp]: "arctan x = 0 \<longleftrightarrow> x = 0"
  4152   using arctan_eq_iff [of x 0] by simp
  4153 
  4154 lemma continuous_on_arcsin': "continuous_on {-1 .. 1} arcsin"
  4155 proof -
  4156   have "continuous_on (sin ` {- pi / 2 .. pi / 2}) arcsin"
  4157     by (rule continuous_on_inv) (auto intro: continuous_intros simp: arcsin_sin)
  4158   also have "sin ` {- pi / 2 .. pi / 2} = {-1 .. 1}"
  4159   proof safe
  4160     fix x :: real
  4161     assume "x \<in> {-1..1}"
  4162     then show "x \<in> sin ` {- pi / 2..pi / 2}"
  4163       using arcsin_lbound arcsin_ubound
  4164       by (intro image_eqI[where x="arcsin x"]) auto
  4165   qed simp
  4166   finally show ?thesis .
  4167 qed
  4168 
  4169 lemma continuous_on_arcsin [continuous_intros]:
  4170   "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))"
  4171   using continuous_on_compose[of s f, OF _ continuous_on_subset[OF  continuous_on_arcsin']]
  4172   by (auto simp: comp_def subset_eq)
  4173 
  4174 lemma isCont_arcsin: "-1 < x \<Longrightarrow> x < 1 \<Longrightarrow> isCont arcsin x"
  4175   using continuous_on_arcsin'[THEN continuous_on_subset, of "{ -1 <..< 1 }"]
  4176   by (auto simp: continuous_on_eq_continuous_at subset_eq)
  4177 
  4178 lemma continuous_on_arccos': "continuous_on {-1 .. 1} arccos"
  4179 proof -
  4180   have "continuous_on (cos ` {0 .. pi}) arccos"
  4181     by (rule continuous_on_inv) (auto intro: continuous_intros simp: arccos_cos)
  4182   also have "cos ` {0 .. pi} = {-1 .. 1}"
  4183   proof safe
  4184     fix x :: real
  4185     assume "x \<in> {-1..1}"
  4186     then show "x \<in> cos ` {0..pi}"
  4187       using arccos_lbound arccos_ubound
  4188       by (intro image_eqI[where x="arccos x"]) auto
  4189   qed simp
  4190   finally show ?thesis .
  4191 qed
  4192 
  4193 lemma continuous_on_arccos [continuous_intros]:
  4194   "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))"
  4195   using continuous_on_compose[of s f, OF _ continuous_on_subset[OF  continuous_on_arccos']]
  4196   by (auto simp: comp_def subset_eq)
  4197 
  4198 lemma isCont_arccos: "-1 < x \<Longrightarrow> x < 1 \<Longrightarrow> isCont arccos x"
  4199   using continuous_on_arccos'[THEN continuous_on_subset, of "{ -1 <..< 1 }"]
  4200   by (auto simp: continuous_on_eq_continuous_at subset_eq)
  4201 
  4202 lemma isCont_arctan: "isCont arctan x"
  4203   apply (rule arctan_lbound [of x, THEN dense, THEN exE], clarify)
  4204   apply (rule arctan_ubound [of x, THEN dense, THEN exE], clarify)
  4205   apply (subgoal_tac "isCont arctan (tan (arctan x))", simp)
  4206   apply (erule (1) isCont_inverse_function2 [where f=tan])
  4207   apply (metis arctan_tan order_le_less_trans order_less_le_trans)
  4208   apply (metis cos_gt_zero_pi isCont_tan order_less_le_trans less_le)
  4209   done
  4210 
  4211 lemma tendsto_arctan [tendsto_intros]: "(f ---> x) F \<Longrightarrow> ((\<lambda>x. arctan (f x)) ---> arctan x) F"
  4212   by (rule isCont_tendsto_compose [OF isCont_arctan])
  4213 
  4214 lemma continuous_arctan [continuous_intros]: "continuous F f \<Longrightarrow> continuous F (\<lambda>x. arctan (f x))"
  4215   unfolding continuous_def by (rule tendsto_arctan)
  4216 
  4217 lemma continuous_on_arctan [continuous_intros]: "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. arctan (f x))"
  4218   unfolding continuous_on_def by (auto intro: tendsto_arctan)
  4219 
  4220 lemma DERIV_arcsin:
  4221   "\<lbrakk>-1 < x; x < 1\<rbrakk> \<Longrightarrow> DERIV arcsin x :> inverse (sqrt (1 - x\<^sup>2))"
  4222   apply (rule DERIV_inverse_function [where f=sin and a="-1" and b=1])
  4223   apply (rule DERIV_cong [OF DERIV_sin])
  4224   apply (simp add: cos_arcsin)
  4225   apply (subgoal_tac "\<bar>x\<bar>\<^sup>2 < 1\<^sup>2", simp)
  4226   apply (rule power_strict_mono, simp, simp, simp, assumption, assumption)
  4227   apply simp
  4228   apply (erule (1) isCont_arcsin)
  4229   done
  4230 
  4231 lemma DERIV_arccos:
  4232   "\<lbrakk>-1 < x; x < 1\<rbrakk> \<Longrightarrow> DERIV arccos x :> inverse (- sqrt (1 - x\<^sup>2))"
  4233   apply (rule DERIV_inverse_function [where f=cos and a="-1" and b=1])
  4234   apply (rule DERIV_cong [OF DERIV_cos])
  4235   apply (simp add: sin_arccos)
  4236   apply (subgoal_tac "\<bar>x\<bar>\<^sup>2 < 1\<^sup>2", simp)
  4237   apply (rule power_strict_mono, simp, simp, simp, assumption, assumption)
  4238   apply simp
  4239   apply (erule (1) isCont_arccos)
  4240   done
  4241 
  4242 lemma DERIV_arctan: "DERIV arctan x :> inverse (1 + x\<^sup>2)"
  4243   apply (rule DERIV_inverse_function [where f=tan and a="x - 1" and b="x + 1"])
  4244   apply (rule DERIV_cong [OF DERIV_tan])
  4245   apply (rule cos_arctan_not_zero)
  4246   apply (simp add: power_inverse tan_sec [symmetric])
  4247   apply (subgoal_tac "0 < 1 + x\<^sup>2", simp)
  4248   apply (simp add: add_pos_nonneg)
  4249   apply (simp, simp, simp, rule isCont_arctan)
  4250   done
  4251 
  4252 declare
  4253   DERIV_arcsin[THEN DERIV_chain2, derivative_intros]
  4254   DERIV_arccos[THEN DERIV_chain2, derivative_intros]
  4255   DERIV_arctan[THEN DERIV_chain2, derivative_intros]
  4256 
  4257 lemma filterlim_tan_at_right: "filterlim tan at_bot (at_right (- pi/2))"
  4258   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])
  4259      (auto simp: le_less eventually_at dist_real_def simp del: less_divide_eq_numeral1
  4260            intro!: tan_monotone exI[of _ "pi/2"])
  4261 
  4262 lemma filterlim_tan_at_left: "filterlim tan at_top (at_left (pi/2))"
  4263   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])
  4264      (auto simp: le_less eventually_at dist_real_def simp del: less_divide_eq_numeral1
  4265            intro!: tan_monotone exI[of _ "pi/2"])
  4266 
  4267 lemma tendsto_arctan_at_top: "(arctan ---> (pi/2)) at_top"
  4268 proof (rule tendstoI)
  4269   fix e :: real
  4270   assume "0 < e"
  4271   def y \<equiv> "pi/2 - min (pi/2) e"
  4272   then have y: "0 \<le> y" "y < pi/2" "pi/2 \<le> e + y"
  4273     using `0 < e` by auto
  4274 
  4275   show "eventually (\<lambda>x. dist (arctan x) (pi / 2) < e) at_top"
  4276   proof (intro eventually_at_top_dense[THEN iffD2] exI allI impI)
  4277     fix x
  4278     assume "tan y < x"
  4279     then have "arctan (tan y) < arctan x"
  4280       by (simp add: arctan_less_iff)
  4281     with y have "y < arctan x"
  4282       by (subst (asm) arctan_tan) simp_all
  4283     with arctan_ubound[of x, arith] y `0 < e`
  4284     show "dist (arctan x) (pi / 2) < e"
  4285       by (simp add: dist_real_def)
  4286   qed
  4287 qed
  4288 
  4289 lemma tendsto_arctan_at_bot: "(arctan ---> - (pi/2)) at_bot"
  4290   unfolding filterlim_at_bot_mirror arctan_minus
  4291   by (intro tendsto_minus tendsto_arctan_at_top)
  4292 
  4293 
  4294 subsection{* Prove Totality of the Trigonometric Functions *}
  4295 
  4296 lemma sin_mono_less_eq: "\<lbrakk>-(pi/2) \<le> x; x \<le> pi/2; -(pi/2) \<le> y; y \<le> pi/2\<rbrakk>
  4297          \<Longrightarrow> (sin(x) < sin(y) \<longleftrightarrow> x < y)"
  4298 by (metis not_less_iff_gr_or_eq sin_monotone_2pi)
  4299 
  4300 lemma sin_mono_le_eq: "\<lbrakk>-(pi/2) \<le> x; x \<le> pi/2; -(pi/2) \<le> y; y \<le> pi/2\<rbrakk>
  4301          \<Longrightarrow> (sin(x) \<le> sin(y) \<longleftrightarrow> x \<le> y)"
  4302 by (meson leD le_less_linear sin_monotone_2pi sin_monotone_2pi_le)
  4303 
  4304 lemma sin_inj_pi: "-(pi/2) \<le> x ==> x \<le> pi/2 ==>
  4305          -(pi/2) \<le> y ==> y \<le> pi/2 ==> sin(x) = sin(y) \<Longrightarrow> x = y"
  4306 by (metis arcsin_sin)
  4307 
  4308 lemma cos_mono_lt_eq: "0 \<le> x ==> x \<le> pi ==> 0 \<le> y ==> y \<le> pi
  4309          \<Longrightarrow> (cos(x) < cos(y) \<longleftrightarrow> y < x)"
  4310 by (meson cos_monotone_0_pi cos_monotone_0_pi_le leD le_less_linear)
  4311 
  4312 lemma cos_mono_le_eq: "0 \<le> x ==> x \<le> pi ==> 0 \<le> y ==> y \<le> pi
  4313          \<Longrightarrow> (cos(x) \<le> cos(y) \<longleftrightarrow> y \<le> x)"
  4314   by (metis arccos_cos cos_monotone_0_pi_le eq_iff linear)
  4315 
  4316 lemma cos_inj_pi: "0 \<le> x ==> x \<le> pi ==> 0 \<le> y ==> y \<le> pi ==> cos(x) = cos(y)
  4317          \<Longrightarrow> x = y"
  4318 by (metis arccos_cos)
  4319 
  4320 lemma arccos_le_pi2: "\<lbrakk>0 \<le> y; y \<le> 1\<rbrakk> \<Longrightarrow> arccos y \<le> pi/2"
  4321   by (metis (mono_tags) arccos_0 arccos cos_le_one cos_monotone_0_pi_le
  4322       cos_pi cos_pi_half pi_half_ge_zero antisym_conv less_eq_neg_nonpos linear minus_minus order.trans order_refl)
  4323 
  4324 lemma sincos_total_pi_half:
  4325   assumes "0 \<le> x" "0 \<le> y" "x\<^sup>2 + y\<^sup>2 = 1"
  4326     shows "\<exists>t. 0 \<le> t \<and> t \<le> pi/2 \<and> x = cos t \<and> y = sin t"
  4327 proof -
  4328   have x1: "x \<le> 1"
  4329     using assms
  4330     by (metis le_add_same_cancel1 power2_le_imp_le power_one zero_le_power2) 
  4331   moreover with assms have ax: "0 \<le> arccos x" "cos(arccos x) = x"
  4332     by (auto simp: arccos)
  4333   moreover have "y = sqrt (1 - x\<^sup>2)" using assms
  4334     by (metis abs_of_nonneg add.commute add_diff_cancel real_sqrt_abs)
  4335   ultimately show ?thesis using assms arccos_le_pi2 [of x] 
  4336     by (rule_tac x="arccos x" in exI) (auto simp: sin_arccos)
  4337 qed    
  4338 
  4339 lemma sincos_total_pi:
  4340   assumes "0 \<le> y" and "x\<^sup>2 + y\<^sup>2 = 1"
  4341     shows "\<exists>t. 0 \<le> t \<and> t \<le> pi \<and> x = cos t \<and> y = sin t"
  4342 proof (cases rule: le_cases [of 0 x])
  4343   case le from sincos_total_pi_half [OF le]  
  4344   show ?thesis
  4345     by (metis pi_ge_two pi_half_le_two add.commute add_le_cancel_left add_mono assms)
  4346 next
  4347   case ge 
  4348   then have "0 \<le> -x"
  4349     by simp
  4350   then obtain t where "t\<ge>0" "t \<le> pi/2" "-x = cos t" "y = sin t"
  4351     using sincos_total_pi_half assms
  4352     apply auto
  4353     by (metis `0 \<le> - x` power2_minus)
  4354   then show ?thesis
  4355     by (rule_tac x="pi-t" in exI, auto)
  4356 qed    
  4357     
  4358 lemma sincos_total_2pi_le:
  4359   assumes "x\<^sup>2 + y\<^sup>2 = 1"
  4360     shows "\<exists>t. 0 \<le> t \<and> t \<le> 2*pi \<and> x = cos t \<and> y = sin t"
  4361 proof (cases rule: le_cases [of 0 y])
  4362   case le from sincos_total_pi [OF le]  
  4363   show ?thesis
  4364     by (metis assms le_add_same_cancel1 mult.commute mult_2_right order.trans)
  4365 next
  4366   case ge 
  4367   then have "0 \<le> -y"
  4368     by simp
  4369   then obtain t where "t\<ge>0" "t \<le> pi" "x = cos t" "-y = sin t"
  4370     using sincos_total_pi assms
  4371     apply auto
  4372     by (metis `0 \<le> - y` power2_minus)
  4373   then show ?thesis
  4374     by (rule_tac x="2*pi-t" in exI, auto)
  4375 qed    
  4376 
  4377 lemma sincos_total_2pi:
  4378   assumes "x\<^sup>2 + y\<^sup>2 = 1"
  4379     obtains t where "0 \<le> t" "t < 2*pi" "x = cos t" "y = sin t"
  4380 proof -
  4381   from sincos_total_2pi_le [OF assms]
  4382   obtain t where t: "0 \<le> t" "t \<le> 2*pi" "x = cos t" "y = sin t"
  4383     by blast
  4384   show ?thesis
  4385     apply (cases "t = 2*pi")
  4386     using t that
  4387     apply force+
  4388     done
  4389 qed
  4390 
  4391 subsection {* Machins formula *}
  4392 
  4393 lemma arctan_one: "arctan 1 = pi / 4"
  4394   by (rule arctan_unique, simp_all add: tan_45 m2pi_less_pi)
  4395 
  4396 lemma tan_total_pi4:
  4397   assumes "\<bar>x\<bar> < 1"
  4398   shows "\<exists>z. - (pi / 4) < z \<and> z < pi / 4 \<and> tan z = x"
  4399 proof
  4400   show "- (pi / 4) < arctan x \<and> arctan x < pi / 4 \<and> tan (arctan x) = x"
  4401     unfolding arctan_one [symmetric] arctan_minus [symmetric]
  4402     unfolding arctan_less_iff using assms by auto
  4403 qed
  4404 
  4405 lemma arctan_add:
  4406   assumes "\<bar>x\<bar> \<le> 1" and "\<bar>y\<bar> < 1"
  4407   shows "arctan x + arctan y = arctan ((x + y) / (1 - x * y))"
  4408 proof (rule arctan_unique [symmetric])
  4409   have "- (pi / 4) \<le> arctan x" and "- (pi / 4) < arctan y"
  4410     unfolding arctan_one [symmetric] arctan_minus [symmetric]
  4411     unfolding arctan_le_iff arctan_less_iff using assms by auto
  4412   from add_le_less_mono [OF this]
  4413   show 1: "- (pi / 2) < arctan x + arctan y" by simp
  4414   have "arctan x \<le> pi / 4" and "arctan y < pi / 4"
  4415     unfolding arctan_one [symmetric]
  4416     unfolding arctan_le_iff arctan_less_iff using assms by auto
  4417   from add_le_less_mono [OF this]
  4418   show 2: "arctan x + arctan y < pi / 2" by simp
  4419   show "tan (arctan x + arctan y) = (x + y) / (1 - x * y)"
  4420     using cos_gt_zero_pi [OF 1 2] by (simp add: tan_add)
  4421 qed
  4422 
  4423 theorem machin: "pi / 4 = 4 * arctan (1/5) - arctan (1 / 239)"
  4424 proof -
  4425   have "\<bar>1 / 5\<bar> < (1 :: real)" by auto
  4426   from arctan_add[OF less_imp_le[OF this] this]
  4427   have "2 * arctan (1 / 5) = arctan (5 / 12)" by auto
  4428   moreover
  4429   have "\<bar>5 / 12\<bar> < (1 :: real)" by auto
  4430   from arctan_add[OF less_imp_le[OF this] this]
  4431   have "2 * arctan (5 / 12) = arctan (120 / 119)" by auto
  4432   moreover
  4433   have "\<bar>1\<bar> \<le> (1::real)" and "\<bar>1 / 239\<bar> < (1::real)" by auto
  4434   from arctan_add[OF this]
  4435   have "arctan 1 + arctan (1 / 239) = arctan (120 / 119)" by auto
  4436   ultimately have "arctan 1 + arctan (1 / 239) = 4 * arctan (1 / 5)" by auto
  4437   thus ?thesis unfolding arctan_one by algebra
  4438 qed
  4439 
  4440 
  4441 subsection {* Introducing the inverse tangent power series *}
  4442 
  4443 lemma monoseq_arctan_series:
  4444   fixes x :: real
  4445   assumes "\<bar>x\<bar> \<le> 1"
  4446   shows "monoseq (\<lambda> n. 1 / real (n*2+1) * x^(n*2+1))" (is "monoseq ?a")
  4447 proof (cases "x = 0")
  4448   case True
  4449   thus ?thesis unfolding monoseq_def One_nat_def by auto
  4450 next
  4451   case False
  4452   have "norm x \<le> 1" and "x \<le> 1" and "-1 \<le> x" using assms by auto
  4453   show "monoseq ?a"
  4454   proof -
  4455     {
  4456       fix n
  4457       fix x :: real
  4458       assume "0 \<le> x" and "x \<le> 1"
  4459       have "1 / real (Suc (Suc n * 2)) * x ^ Suc (Suc n * 2) \<le>
  4460         1 / real (Suc (n * 2)) * x ^ Suc (n * 2)"
  4461       proof (rule mult_mono)
  4462         show "1 / real (Suc (Suc n * 2)) \<le> 1 / real (Suc (n * 2))"
  4463           by (rule frac_le) simp_all
  4464         show "0 \<le> 1 / real (Suc (n * 2))"
  4465           by auto
  4466         show "x ^ Suc (Suc n * 2) \<le> x ^ Suc (n * 2)"
  4467           by (rule power_decreasing) (simp_all add: `0 \<le> x` `x \<le> 1`)
  4468         show "0 \<le> x ^ Suc (Suc n * 2)"
  4469           by (rule zero_le_power) (simp add: `0 \<le> x`)
  4470       qed
  4471     } note mono = this
  4472 
  4473     show ?thesis
  4474     proof (cases "0 \<le> x")
  4475       case True from mono[OF this `x \<le> 1`, THEN allI]
  4476       show ?thesis unfolding Suc_eq_plus1[symmetric]
  4477         by (rule mono_SucI2)
  4478     next
  4479       case False
  4480       hence "0 \<le> -x" and "-x \<le> 1" using `-1 \<le> x` by auto
  4481       from mono[OF this]
  4482       have "\<And>n. 1 / real (Suc (Suc n * 2)) * x ^ Suc (Suc n * 2) \<ge>
  4483         1 / real (Suc (n * 2)) * x ^ Suc (n * 2)" using `0 \<le> -x` by auto
  4484       thus ?thesis unfolding Suc_eq_plus1[symmetric] by (rule mono_SucI1[OF allI])
  4485     qed
  4486   qed
  4487 qed
  4488 
  4489 lemma zeroseq_arctan_series:
  4490   fixes x :: real
  4491   assumes "\<bar>x\<bar> \<le> 1"
  4492   shows "(\<lambda> n. 1 / real (n*2+1) * x^(n*2+1)) ----> 0" (is "?a ----> 0")
  4493 proof (cases "x = 0")
  4494   case True
  4495   thus ?thesis
  4496     unfolding One_nat_def by auto
  4497 next
  4498   case False
  4499   have "norm x \<le> 1" and "x \<le> 1" and "-1 \<le> x" using assms by auto
  4500   show "?a ----> 0"
  4501   proof (cases "\<bar>x\<bar> < 1")
  4502     case True
  4503     hence "norm x < 1" by auto
  4504     from tendsto_mult[OF LIMSEQ_inverse_real_of_nat LIMSEQ_power_zero[OF `norm x < 1`, THEN LIMSEQ_Suc]]
  4505     have "(\<lambda>n. 1 / real (n + 1) * x ^ (n + 1)) ----> 0"
  4506       unfolding inverse_eq_divide Suc_eq_plus1 by simp
  4507     then show ?thesis using pos2 by (rule LIMSEQ_linear)
  4508   next
  4509     case False
  4510     hence "x = -1 \<or> x = 1" using `\<bar>x\<bar> \<le> 1` by auto
  4511     hence n_eq: "\<And> n. x ^ (n * 2 + 1) = x"
  4512       unfolding One_nat_def by auto
  4513     from tendsto_mult[OF LIMSEQ_inverse_real_of_nat[THEN LIMSEQ_linear, OF pos2, unfolded inverse_eq_divide] tendsto_const[of x]]
  4514     show ?thesis unfolding n_eq Suc_eq_plus1 by auto
  4515   qed
  4516 qed
  4517 
  4518 text{*FIXME: generalise from the reals via type classes?*}
  4519 lemma summable_arctan_series:
  4520   fixes x :: real and n :: nat
  4521   assumes "\<bar>x\<bar> \<le> 1"
  4522   shows "summable (\<lambda> k. (-1)^k * (1 / real (k*2+1) * x ^ (k*2+1)))"
  4523   (is "summable (?c x)")
  4524   by (rule summable_Leibniz(1), rule zeroseq_arctan_series[OF assms], rule monoseq_arctan_series[OF assms])
  4525 
  4526 lemma less_one_imp_sqr_less_one:
  4527   fixes x :: real
  4528   assumes "\<bar>x\<bar> < 1"
  4529   shows "x\<^sup>2 < 1"
  4530 proof -
  4531   have "\<bar>x\<^sup>2\<bar> < 1"
  4532     by (metis abs_power2 assms pos2 power2_abs power_0 power_strict_decreasing zero_eq_power2 zero_less_abs_iff)
  4533   thus ?thesis using zero_le_power2 by auto
  4534 qed
  4535 
  4536 lemma DERIV_arctan_series:
  4537   assumes "\<bar> x \<bar> < 1"
  4538   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))"
  4539   (is "DERIV ?arctan _ :> ?Int")
  4540 proof -
  4541   let ?f = "\<lambda>n. if even n then (-1)^(n div 2) * 1 / real (Suc n) else 0"
  4542 
  4543   have n_even: "\<And>n :: nat. even n \<Longrightarrow> 2 * (n div 2) = n"
  4544     by presburger
  4545   then have if_eq: "\<And>n x'. ?f n * real (Suc n) * x'^n =
  4546     (if even n then (-1)^(n div 2) * x'^(2 * (n div 2)) else 0)"
  4547     by auto
  4548 
  4549   {
  4550     fix x :: real
  4551     assume "\<bar>x\<bar> < 1"
  4552     hence "x\<^sup>2 < 1" by (rule less_one_imp_sqr_less_one)
  4553     have "summable (\<lambda> n. (- 1) ^ n * (x\<^sup>2) ^n)"
  4554       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`])
  4555     hence "summable (\<lambda> n. (- 1) ^ n * x^(2*n))" unfolding power_mult .
  4556   } note summable_Integral = this
  4557 
  4558   {
  4559     fix f :: "nat \<Rightarrow> real"
  4560     have "\<And>x. f sums x = (\<lambda> n. if even n then f (n div 2) else 0) sums x"
  4561     proof
  4562       fix x :: real
  4563       assume "f sums x"
  4564       from sums_if[OF sums_zero this]
  4565       show "(\<lambda>n. if even n then f (n div 2) else 0) sums x"
  4566         by auto
  4567     next
  4568       fix x :: real
  4569       assume "(\<lambda> n. if even n then f (n div 2) else 0) sums x"
  4570       from LIMSEQ_linear[OF this[unfolded sums_def] pos2, unfolded sum_split_even_odd[unfolded mult.commute]]
  4571       show "f sums x" unfolding sums_def by auto
  4572     qed
  4573     hence "op sums f = op sums (\<lambda> n. if even n then f (n div 2) else 0)" ..
  4574   } note sums_even = this
  4575 
  4576   have Int_eq: "(\<Sum>n. ?f n * real (Suc n) * x^n) = ?Int"
  4577     unfolding if_eq mult.commute[of _ 2] suminf_def sums_even[of "\<lambda> n. (- 1) ^ n * x ^ (2 * n)", symmetric]
  4578     by auto
  4579 
  4580   {
  4581     fix x :: real
  4582     have if_eq': "\<And>n. (if even n then (- 1) ^ (n div 2) * 1 / real (Suc n) else 0) * x ^ Suc n =
  4583       (if even n then (- 1) ^ (n div 2) * (1 / real (Suc (2 * (n div 2))) * x ^ Suc (2 * (n div 2))) else 0)"
  4584       using n_even by auto
  4585     have idx_eq: "\<And>n. n * 2 + 1 = Suc (2 * n)" by auto
  4586     have "(\<Sum>n. ?f n * x^(Suc n)) = ?arctan x"
  4587       unfolding if_eq' idx_eq suminf_def sums_even[of "\<lambda> n. (- 1) ^ n * (1 / real (Suc (2 * n)) * x ^ Suc (2 * n))", symmetric]
  4588       by auto
  4589   } note arctan_eq = this
  4590 
  4591   have "DERIV (\<lambda> x. \<Sum> n. ?f n * x^(Suc n)) x :> (\<Sum> n. ?f n * real (Suc n) * x^n)"
  4592   proof (rule DERIV_power_series')
  4593     show "x \<in> {- 1 <..< 1}" using `\<bar> x \<bar> < 1` by auto
  4594     {
  4595       fix x' :: real
  4596       assume x'_bounds: "x' \<in> {- 1 <..< 1}"
  4597       then have "\<bar>x'\<bar> < 1" by auto
  4598       then
  4599         have *: "summable (\<lambda>n. (- 1) ^ n * x' ^ (2 * n))"
  4600         by (rule summable_Integral)
  4601       let ?S = "\<Sum> n. (-1)^n * x'^(2 * n)"
  4602       show "summable (\<lambda> n. ?f n * real (Suc n) * x'^n)" unfolding if_eq
  4603         apply (rule sums_summable [where l="0 + ?S"])
  4604         apply (rule sums_if)
  4605         apply (rule sums_zero)
  4606         apply (rule summable_sums)
  4607         apply (rule *)
  4608         done
  4609     }
  4610   qed auto
  4611   thus ?thesis unfolding Int_eq arctan_eq .
  4612 qed
  4613 
  4614 lemma arctan_series:
  4615   assumes "\<bar> x \<bar> \<le> 1"
  4616   shows "arctan x = (\<Sum>k. (-1)^k * (1 / real (k*2+1) * x ^ (k*2+1)))"
  4617   (is "_ = suminf (\<lambda> n. ?c x n)")
  4618 proof -
  4619   let ?c' = "\<lambda>x n. (-1)^n * x^(n*2)"
  4620 
  4621   {
  4622     fix r x :: real
  4623     assume "0 < r" and "r < 1" and "\<bar> x \<bar> < r"
  4624     have "\<bar>x\<bar> < 1" using `r < 1` and `\<bar>x\<bar> < r` by auto
  4625     from DERIV_arctan_series[OF this] have "DERIV (\<lambda> x. suminf (?c x)) x :> (suminf (?c' x))" .
  4626   } note DERIV_arctan_suminf = this
  4627 
  4628   {
  4629     fix x :: real
  4630     assume "\<bar>x\<bar> \<le> 1"
  4631     note summable_Leibniz[OF zeroseq_arctan_series[OF this] monoseq_arctan_series[OF this]]
  4632   } note arctan_series_borders = this
  4633 
  4634   {
  4635     fix x :: real
  4636     assume "\<bar>x\<bar> < 1"
  4637     have "arctan x = (\<Sum>k. ?c x k)"
  4638     proof -
  4639       obtain r where "\<bar>x\<bar> < r" and "r < 1"
  4640         using dense[OF `\<bar>x\<bar> < 1`] by blast
  4641       hence "0 < r" and "-r < x" and "x < r" by auto
  4642 
  4643       have suminf_eq_arctan_bounded: "\<And>x a b. \<lbrakk> -r < a ; b < r ; a < b ; a \<le> x ; x \<le> b \<rbrakk> \<Longrightarrow>
  4644         suminf (?c x) - arctan x = suminf (?c a) - arctan a"
  4645       proof -
  4646         fix x a b
  4647         assume "-r < a" and "b < r" and "a < b" and "a \<le> x" and "x \<le> b"
  4648         hence "\<bar>x\<bar> < r" by auto
  4649         show "suminf (?c x) - arctan x = suminf (?c a) - arctan a"
  4650         proof (rule DERIV_isconst2[of "a" "b"])
  4651           show "a < b" and "a \<le> x" and "x \<le> b"
  4652             using `a < b` `a \<le> x` `x \<le> b` by auto
  4653           have "\<forall>x. -r < x \<and> x < r \<longrightarrow> DERIV (\<lambda> x. suminf (?c x) - arctan x) x :> 0"
  4654           proof (rule allI, rule impI)
  4655             fix x
  4656             assume "-r < x \<and> x < r"
  4657             hence "\<bar>x\<bar> < r" by auto
  4658             hence "\<bar>x\<bar> < 1" using `r < 1` by auto
  4659             have "\<bar> - (x\<^sup>2) \<bar> < 1"
  4660               using less_one_imp_sqr_less_one[OF `\<bar>x\<bar> < 1`] by auto
  4661             hence "(\<lambda> n. (- (x\<^sup>2)) ^ n) sums (1 / (1 - (- (x\<^sup>2))))"
  4662               unfolding real_norm_def[symmetric] by (rule geometric_sums)
  4663             hence "(?c' x) sums (1 / (1 - (- (x\<^sup>2))))"
  4664               unfolding power_mult_distrib[symmetric] power_mult mult.commute[of _ 2] by auto
  4665             hence suminf_c'_eq_geom: "inverse (1 + x\<^sup>2) = suminf (?c' x)"
  4666               using sums_unique unfolding inverse_eq_divide by auto
  4667             have "DERIV (\<lambda> x. suminf (?c x)) x :> (inverse (1 + x\<^sup>2))"
  4668               unfolding suminf_c'_eq_geom
  4669               by (rule DERIV_arctan_suminf[OF `0 < r` `r < 1` `\<bar>x\<bar> < r`])
  4670             from DERIV_diff [OF this DERIV_arctan]
  4671             show "DERIV (\<lambda> x. suminf (?c x) - arctan x) x :> 0"
  4672               by auto
  4673           qed
  4674           hence DERIV_in_rball: "\<forall> y. a \<le> y \<and> y \<le> b \<longrightarrow> DERIV (\<lambda> x. suminf (?c x) - arctan x) y :> 0"
  4675             using `-r < a` `b < r` by auto
  4676           thus "\<forall> y. a < y \<and> y < b \<longrightarrow> DERIV (\<lambda> x. suminf (?c x) - arctan x) y :> 0"
  4677             using `\<bar>x\<bar> < r` by auto
  4678           show "\<forall> y. a \<le> y \<and> y \<le> b \<longrightarrow> isCont (\<lambda> x. suminf (?c x) - arctan x) y"
  4679             using DERIV_in_rball DERIV_isCont by auto
  4680         qed
  4681       qed
  4682 
  4683       have suminf_arctan_zero: "suminf (?c 0) - arctan 0 = 0"
  4684         unfolding Suc_eq_plus1[symmetric] power_Suc2 mult_zero_right arctan_zero_zero suminf_zero
  4685         by auto
  4686 
  4687       have "suminf (?c x) - arctan x = 0"
  4688       proof (cases "x = 0")
  4689         case True
  4690         thus ?thesis using suminf_arctan_zero by auto
  4691       next
  4692         case False
  4693         hence "0 < \<bar>x\<bar>" and "- \<bar>x\<bar> < \<bar>x\<bar>" by auto
  4694         have "suminf (?c (-\<bar>x\<bar>)) - arctan (-\<bar>x\<bar>) = suminf (?c 0) - arctan 0"
  4695           by (rule suminf_eq_arctan_bounded[where x1="0" and a1="-\<bar>x\<bar>" and b1="\<bar>x\<bar>", symmetric])
  4696             (simp_all only: `\<bar>x\<bar> < r` `-\<bar>x\<bar> < \<bar>x\<bar>` neg_less_iff_less)
  4697         moreover
  4698         have "suminf (?c x) - arctan x = suminf (?c (-\<bar>x\<bar>)) - arctan (-\<bar>x\<bar>)"
  4699           by (rule suminf_eq_arctan_bounded[where x1="x" and a1="-\<bar>x\<bar>" and b1="\<bar>x\<bar>"])
  4700              (simp_all only: `\<bar>x\<bar> < r` `-\<bar>x\<bar> < \<bar>x\<bar>` neg_less_iff_less)
  4701         ultimately
  4702         show ?thesis using suminf_arctan_zero by auto
  4703       qed
  4704       thus ?thesis by auto
  4705     qed
  4706   } note when_less_one = this
  4707 
  4708   show "arctan x = suminf (\<lambda> n. ?c x n)"
  4709   proof (cases "\<bar>x\<bar> < 1")
  4710     case True
  4711     thus ?thesis by (rule when_less_one)
  4712   next
  4713     case False
  4714     hence "\<bar>x\<bar> = 1" using `\<bar>x\<bar> \<le> 1` by auto
  4715     let ?a = "\<lambda>x n. \<bar>1 / real (n*2+1) * x^(n*2+1)\<bar>"
  4716     let ?diff = "\<lambda> x n. \<bar> arctan x - (\<Sum> i<n. ?c x i)\<bar>"
  4717     {
  4718       fix n :: nat
  4719       have "0 < (1 :: real)" by auto
  4720       moreover
  4721       {
  4722         fix x :: real
  4723         assume "0 < x" and "x < 1"
  4724         hence "\<bar>x\<bar> \<le> 1" and "\<bar>x\<bar> < 1" by auto
  4725         from `0 < x` have "0 < 1 / real (0 * 2 + (1::nat)) * x ^ (0 * 2 + 1)"
  4726           by auto
  4727         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]
  4728         have "0 < 1 / real (n*2+1) * x^(n*2+1)"
  4729           by (rule mult_pos_pos, auto simp only: zero_less_power[OF `0 < x`], auto)
  4730         hence a_pos: "?a x n = 1 / real (n*2+1) * x^(n*2+1)"
  4731           by (rule abs_of_pos)
  4732         have "?diff x n \<le> ?a x n"
  4733         proof (cases "even n")
  4734           case True
  4735           hence sgn_pos: "(-1)^n = (1::real)" by auto
  4736           from `even n` obtain m where "n = 2 * m" ..
  4737           then have "2 * m = n" ..
  4738           from bounds[of m, unfolded this atLeastAtMost_iff]
  4739           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))"
  4740             by auto
  4741           also have "\<dots> = ?c x n" unfolding One_nat_def by auto
  4742           also have "\<dots> = ?a x n" unfolding sgn_pos a_pos by auto
  4743           finally show ?thesis .
  4744         next
  4745           case False
  4746           hence sgn_neg: "(-1)^n = (-1::real)" by auto
  4747           from `odd n` obtain m where "n = 2 * m + 1" ..
  4748           then have m_def: "2 * m + 1 = n" ..
  4749           hence m_plus: "2 * (m + 1) = n + 1" by auto
  4750           from bounds[of "m + 1", unfolded this atLeastAtMost_iff, THEN conjunct1] bounds[of m, unfolded m_def atLeastAtMost_iff, THEN conjunct2]
  4751           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))"
  4752             by auto
  4753           also have "\<dots> = - ?c x n" unfolding One_nat_def by auto
  4754           also have "\<dots> = ?a x n" unfolding sgn_neg a_pos by auto
  4755           finally show ?thesis .
  4756         qed
  4757         hence "0 \<le> ?a x n - ?diff x n" by auto
  4758       }
  4759       hence "\<forall> x \<in> { 0 <..< 1 }. 0 \<le> ?a x n - ?diff x n" by auto
  4760       moreover have "\<And>x. isCont (\<lambda> x. ?a x n - ?diff x n) x"
  4761         unfolding diff_conv_add_uminus divide_inverse
  4762         by (auto intro!: isCont_add isCont_rabs isCont_ident isCont_minus isCont_arctan
  4763           isCont_inverse isCont_mult isCont_power isCont_const isCont_setsum
  4764           simp del: add_uminus_conv_diff)
  4765       ultimately have "0 \<le> ?a 1 n - ?diff 1 n"
  4766         by (rule LIM_less_bound)
  4767       hence "?diff 1 n \<le> ?a 1 n" by auto
  4768     }
  4769     have "?a 1 ----> 0"
  4770       unfolding tendsto_rabs_zero_iff power_one divide_inverse One_nat_def
  4771       by (auto intro!: tendsto_mult LIMSEQ_linear LIMSEQ_inverse_real_of_nat)
  4772     have "?diff 1 ----> 0"
  4773     proof (rule LIMSEQ_I)
  4774       fix r :: real
  4775       assume "0 < r"
  4776       obtain N :: nat where N_I: "\<And>n. N \<le> n \<Longrightarrow> ?a 1 n < r"
  4777         using LIMSEQ_D[OF `?a 1 ----> 0` `0 < r`] by auto
  4778       {
  4779         fix n
  4780         assume "N \<le> n" from `?diff 1 n \<le> ?a 1 n` N_I[OF this]
  4781         have "norm (?diff 1 n - 0) < r" by auto
  4782       }
  4783       thus "\<exists> N. \<forall> n \<ge> N. norm (?diff 1 n - 0) < r" by blast
  4784     qed
  4785     from this [unfolded tendsto_rabs_zero_iff, THEN tendsto_add [OF _ tendsto_const], of "- arctan 1", THEN tendsto_minus]
  4786     have "(?c 1) sums (arctan 1)" unfolding sums_def by auto
  4787     hence "arctan 1 = (\<Sum> i. ?c 1 i)" by (rule sums_unique)
  4788 
  4789     show ?thesis
  4790     proof (cases "x = 1")
  4791       case True
  4792       then show ?thesis by (simp add: `arctan 1 = (\<Sum> i. ?c 1 i)`)
  4793     next
  4794       case False
  4795       hence "x = -1" using `\<bar>x\<bar> = 1` by auto
  4796 
  4797       have "- (pi / 2) < 0" using pi_gt_zero by auto
  4798       have "- (2 * pi) < 0" using pi_gt_zero by auto
  4799 
  4800       have c_minus_minus: "\<And>i. ?c (- 1) i = - ?c 1 i"
  4801         unfolding One_nat_def by auto
  4802 
  4803       have "arctan (- 1) = arctan (tan (-(pi / 4)))"
  4804         unfolding tan_45 tan_minus ..
  4805       also have "\<dots> = - (pi / 4)"
  4806         by (rule arctan_tan, auto simp add: order_less_trans[OF `- (pi / 2) < 0` pi_gt_zero])
  4807       also have "\<dots> = - (arctan (tan (pi / 4)))"
  4808         unfolding neg_equal_iff_equal by (rule arctan_tan[symmetric], auto simp add: order_less_trans[OF `- (2 * pi) < 0` pi_gt_zero])
  4809       also have "\<dots> = - (arctan 1)"
  4810         unfolding tan_45 ..
  4811       also have "\<dots> = - (\<Sum> i. ?c 1 i)"
  4812         using `arctan 1 = (\<Sum> i. ?c 1 i)` by auto
  4813       also have "\<dots> = (\<Sum> i. ?c (- 1) i)"
  4814         using suminf_minus[OF sums_summable[OF `(?c 1) sums (arctan 1)`]]
  4815         unfolding c_minus_minus by auto
  4816       finally show ?thesis using `x = -1` by auto
  4817     qed
  4818   qed
  4819 qed
  4820 
  4821 lemma arctan_half:
  4822   fixes x :: real
  4823   shows "arctan x = 2 * arctan (x / (1 + sqrt(1 + x\<^sup>2)))"
  4824 proof -
  4825   obtain y where low: "- (pi / 2) < y" and high: "y < pi / 2" and y_eq: "tan y = x"
  4826     using tan_total by blast
  4827   hence low2: "- (pi / 2) < y / 2" and high2: "y / 2 < pi / 2"
  4828     by auto
  4829 
  4830   have "0 < cos y" using cos_gt_zero_pi[OF low high] .
  4831   hence "cos y \<noteq> 0" and cos_sqrt: "sqrt ((cos y)\<^sup>2) = cos y"
  4832     by auto
  4833 
  4834   have "1 + (tan y)\<^sup>2 = 1 + (sin y)\<^sup>2 / (cos y)\<^sup>2"
  4835     unfolding tan_def power_divide ..
  4836   also have "\<dots> = (cos y)\<^sup>2 / (cos y)\<^sup>2 + (sin y)\<^sup>2 / (cos y)\<^sup>2"
  4837     using `cos y \<noteq> 0` by auto
  4838   also have "\<dots> = 1 / (cos y)\<^sup>2"
  4839     unfolding add_divide_distrib[symmetric] sin_cos_squared_add2 ..
  4840   finally have "1 + (tan y)\<^sup>2 = 1 / (cos y)\<^sup>2" .
  4841 
  4842   have "sin y / (cos y + 1) = tan y / ((cos y + 1) / cos y)"
  4843     unfolding tan_def using `cos y \<noteq> 0` by (simp add: field_simps)
  4844   also have "\<dots> = tan y / (1 + 1 / cos y)"
  4845     using `cos y \<noteq> 0` unfolding add_divide_distrib by auto
  4846   also have "\<dots> = tan y / (1 + 1 / sqrt ((cos y)\<^sup>2))"
  4847     unfolding cos_sqrt ..
  4848   also have "\<dots> = tan y / (1 + sqrt (1 / (cos y)\<^sup>2))"
  4849     unfolding real_sqrt_divide by auto
  4850   finally have eq: "sin y / (cos y + 1) = tan y / (1 + sqrt(1 + (tan y)\<^sup>2))"
  4851     unfolding `1 + (tan y)\<^sup>2 = 1 / (cos y)\<^sup>2` .
  4852 
  4853   have "arctan x = y"
  4854     using arctan_tan low high y_eq by auto
  4855   also have "\<dots> = 2 * (arctan (tan (y/2)))"
  4856     using arctan_tan[OF low2 high2] by auto
  4857   also have "\<dots> = 2 * (arctan (sin y / (cos y + 1)))"
  4858     unfolding tan_half by auto
  4859   finally show ?thesis
  4860     unfolding eq `tan y = x` .
  4861 qed
  4862 
  4863 lemma arctan_monotone: "x < y \<Longrightarrow> arctan x < arctan y"
  4864   by (simp only: arctan_less_iff)
  4865 
  4866 lemma arctan_monotone': "x \<le> y \<Longrightarrow> arctan x \<le> arctan y"
  4867   by (simp only: arctan_le_iff)
  4868 
  4869 lemma arctan_inverse:
  4870   assumes "x \<noteq> 0"
  4871   shows "arctan (1 / x) = sgn x * pi / 2 - arctan x"
  4872 proof (rule arctan_unique)
  4873   show "- (pi / 2) < sgn x * pi / 2 - arctan x"
  4874     using arctan_bounded [of x] assms
  4875     unfolding sgn_real_def
  4876     apply (auto simp add: algebra_simps)
  4877     apply (drule zero_less_arctan_iff [THEN iffD2])
  4878     apply arith
  4879     done
  4880   show "sgn x * pi / 2 - arctan x < pi / 2"
  4881     using arctan_bounded [of "- x"] assms
  4882     unfolding sgn_real_def arctan_minus
  4883     by (auto simp add: algebra_simps)
  4884   show "tan (sgn x * pi / 2 - arctan x) = 1 / x"
  4885     unfolding tan_inverse [of "arctan x", unfolded tan_arctan]
  4886     unfolding sgn_real_def
  4887     by (simp add: tan_def cos_arctan sin_arctan sin_diff cos_diff)
  4888 qed
  4889 
  4890 theorem pi_series: "pi / 4 = (\<Sum> k. (-1)^k * 1 / real (k*2+1))" (is "_ = ?SUM")
  4891 proof -
  4892   have "pi / 4 = arctan 1" using arctan_one by auto
  4893   also have "\<dots> = ?SUM" using arctan_series[of 1] by auto
  4894   finally show ?thesis by auto
  4895 qed
  4896 
  4897 
  4898 subsection {* Existence of Polar Coordinates *}
  4899 
  4900 lemma cos_x_y_le_one: "\<bar>x / sqrt (x\<^sup>2 + y\<^sup>2)\<bar> \<le> 1"
  4901   apply (rule power2_le_imp_le [OF _ zero_le_one])
  4902   apply (simp add: power_divide divide_le_eq not_sum_power2_lt_zero)
  4903   done
  4904 
  4905 lemma cos_arccos_abs: "\<bar>y\<bar> \<le> 1 \<Longrightarrow> cos (arccos y) = y"
  4906   by (simp add: abs_le_iff)
  4907 
  4908 lemma sin_arccos_abs: "\<bar>y\<bar> \<le> 1 \<Longrightarrow> sin (arccos y) = sqrt (1 - y\<^sup>2)"
  4909   by (simp add: sin_arccos abs_le_iff)
  4910 
  4911 lemmas cos_arccos_lemma1 = cos_arccos_abs [OF cos_x_y_le_one]
  4912 
  4913 lemmas sin_arccos_lemma1 = sin_arccos_abs [OF cos_x_y_le_one]
  4914 
  4915 lemma polar_Ex: "\<exists>r::real. \<exists>a. x = r * cos a & y = r * sin a"
  4916 proof -
  4917   have polar_ex1: "\<And>y. 0 < y \<Longrightarrow> \<exists>r a. x = r * cos a & y = r * sin a"
  4918     apply (rule_tac x = "sqrt (x\<^sup>2 + y\<^sup>2)" in exI)
  4919     apply (rule_tac x = "arccos (x / sqrt (x\<^sup>2 + y\<^sup>2))" in exI)
  4920     apply (simp add: cos_arccos_lemma1 sin_arccos_lemma1 power_divide
  4921                      real_sqrt_mult [symmetric] right_diff_distrib)
  4922     done
  4923   show ?thesis
  4924   proof (cases "0::real" y rule: linorder_cases)
  4925     case less
  4926       then show ?thesis by (rule polar_ex1)
  4927   next
  4928     case equal
  4929       then show ?thesis
  4930         by (force simp add: intro!: cos_zero sin_zero)
  4931   next
  4932     case greater
  4933       then show ?thesis
  4934      using polar_ex1 [where y="-y"]
  4935     by auto (metis cos_minus minus_minus minus_mult_right sin_minus)
  4936   qed
  4937 qed
  4938 
  4939 end