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