Impressum Transcendental.thy

Sprache: Isabelle

(* Title: HOL/Transcendental.thy
Author: Jacques D. Fleuriot, University of Cambridge, University of Edinburgh
Author: Lawrence C Paulson
Author: Jeremy Avigad
*)

section ‹Power Series, Transcendental Functions etc.›

theory Transcendental
imports Series Deriv NthRoot
begin

text ‹A theorem about the factcorial function on the reals.›

lemma square_fact_le_2_fact: "fact n * fact n ≤ (fact (2 * n) :: real)"
proof (induct n)
 case 0
 then show ?case by simp
next
 case (Suc n)
 have "(fact (Suc n)) * (fact (Suc n)) = of_nat (Suc n) * of_nat (Suc n) * (fact n * fact n :: real)"
 by (simp add: field_simps)
 also have "… ≤ of_nat (Suc n) * of_nat (Suc n) * fact (2 * n)"
 by (rule mult_left_mono [OF Suc]) simp
 also have "… ≤ of_nat (Suc (Suc (2 * n))) * of_nat (Suc (2 * n)) * fact (2 * n)"
 by (rule mult_right_mono)+ (auto simp: field_simps)
 also have "… = fact (2 * Suc n)" by (simp add: field_simps)
 finally show ?case .
qed

lemma fact_in_Reals: "fact n ∈ ℝ"
 by (induction n) auto

lemma of_real_fact [simp]: "of_real (fact n) = fact n"
 by (metis of_nat_fact of_real_of_nat_eq)

lemma pochhammer_of_real: "pochhammer (of_real x) n = of_real (pochhammer x n)"
 by (simp add: pochhammer_prod)

lemma norm_fact [simp]: "norm (fact n :: 'a::real_normed_algebra_1) = fact n"
proof -
 have "(fact n :: 'a) = of_real (fact n)"
 by simp
 also have "norm … = fact n"
 by (subst norm_of_real) simp
 finally show ?thesis .
qed

lemma root_test_convergence:
 fixes f :: "nat ==> 'a::banach"
 assumes f: "(λn. root n (norm (f n))) <---- x" 🍋 ‹could be weakened to lim sup›
 and "x < 1"
 shows "summable f"
proof -
 have "0 ≤ x"
 by (rule LIMSEQ_le[OF tendsto_const f]) (auto intro!: exI[of _ 1])
 from ‹x 🚫› obtain z where z: "x < z" "z < 1"
 by (metis dense)
 from f ‹x 🚫› have "eventually (λn. root n (norm (f n)) < z) sequentially"
 by (rule order_tendstoD)
 then have "eventually (λn. norm (f n) ≤ z^n) sequentially"
 using eventually_ge_at_top
 proof eventually_elim
 fix n
 assume less: "root n (norm (f n)) < z" and n: "1 ≤ n"
 from power_strict_mono[OF less, of n] n show "norm (f n) ≤ z ^ n"
 by simp
 qed
 then show "summable f"
 unfolding eventually_sequentially
 using z ‹0 ≤ x› by (auto intro!: summable_comparison_test[OF _ summable_geometric])
qed

subsection ‹Properties of Power Series›

lemma powser_zero [simp]: "(∑n. f n * 0 ^ n) = f 0"
 for f :: "nat ==> 'a::real_normed_algebra_1"
proof -
 have "(∑n<1. f n * 0 ^ n) = (∑n. f n * 0 ^ n)"
 by (subst suminf_finite[where N="{0}"]) (auto simp: power_0_left)
 then show ?thesis by simp
qed

lemma powser_sums_zero: "(λn. a n * 0^n) sums a 0"
 for a :: "nat ==> 'a::real_normed_div_algebra"
 using sums_finite [of "{0}" "λn. a n * 0 ^ n"]
 by simp

lemma powser_sums_zero_iff [simp]: "(λn. a n * 0^n) sums x ⟷ a 0 = x"
 for a :: "nat ==> 'a::real_normed_div_algebra"
 using powser_sums_zero sums_unique2 by blast

text ‹
Power series has a circle or radius of convergence: if it sums for ‹x›,
then it sums absolutely for ‹z› with 🍋‹∣z∣ 🚫∣x∣›.›

lemma powser_insidea:
 fixes x z :: "'a::real_normed_div_algebra"
 assumes 1: "summable (λn. f n * x^n)"
 and 2: "norm z < norm x"
 shows "summable (λn. norm (f n * z ^ n))"
proof -
 from 2 have x_neq_0: "x ≠ 0" by clarsimp
 from 1 have "(λn. f n * x^n) <---- 0"
 by (rule summable_LIMSEQ_zero)
 then have "convergent (λn. f n * x^n)"
 by (rule convergentI)
 then have "Cauchy (λn. f n * x^n)"
 by (rule convergent_Cauchy)
 then have "Bseq (λn. f n * x^n)"
 by (rule Cauchy_Bseq)
 then obtain K where 3: "0 < K" and 4: "∀n. norm (f n * x^n) ≤ K"
 by (auto simp: Bseq_def)
 have "∃N. ∀n≥N. norm (norm (f n * z ^ n)) ≤ K * norm (z ^ n) * inverse (norm (x^n))"
 proof (intro exI allI impI)
 fix n :: nat
 assume "0 ≤ n"
 have "norm (norm (f n * z ^ n)) * norm (x^n) =
 norm (f n * x^n) * norm (z ^ n)"
 by (simp add: norm_mult abs_mult)
 also have "… ≤ K * norm (z ^ n)"
 by (simp only: mult_right_mono 4 norm_ge_zero)
 also have "… = K * norm (z ^ n) * (inverse (norm (x^n)) * norm (x^n))"
 by (simp add: x_neq_0)
 also have "… = K * norm (z ^ n) * inverse (norm (x^n)) * norm (x^n)"
 by (simp only: mult.assoc)
 finally show "norm (norm (f n * z ^ n)) ≤ K * norm (z ^ n) * inverse (norm (x^n))"
 by (simp add: mult_le_cancel_right x_neq_0)
 qed
 moreover have "summable (λn. K * norm (z ^ n) * inverse (norm (x^n)))"
 proof -
 from 2 have "norm (norm (z * inverse x)) < 1"
 using x_neq_0
 by (simp add: norm_mult nonzero_norm_inverse divide_inverse [where 'a=real, symmetric])
 then have "summable (λn. norm (z * inverse x) ^ n)"
 by (rule summable_geometric)
 then have "summable (λn. K * norm (z * inverse x) ^ n)"
 by (rule summable_mult)
 then show "summable (λn. K * norm (z ^ n) * inverse (norm (x^n)))"
 using x_neq_0
 by (simp add: norm_mult nonzero_norm_inverse power_mult_distrib
 power_inverse norm_power mult.assoc)
 qed
 ultimately show "summable (λn. norm (f n * z ^ n))"
 by (rule summable_comparison_test)
qed

lemma powser_inside:
 fixes f :: "nat ==> 'a::{real_normed_div_algebra,banach}"
 shows
 "summable (λn. f n * (x^n)) ==> norm z < norm x ==>
 summable (λn. f n * (z ^ n))"
 by (rule powser_insidea [THEN summable_norm_cancel])

lemma powser_times_n_limit_0:
 fixes x :: "'a::{real_normed_div_algebra,banach}"
 assumes "norm x < 1"
 shows "(λn. of_nat n * x ^ n) <---- 0"
proof -
 have "norm x / (1 - norm x) ≥ 0"
 using assms by (auto simp: field_split_simps)
 moreover obtain N where N: "norm x / (1 - norm x) < of_int N"
 using ex_le_of_int by (meson ex_less_of_int)
 ultimately have N0: "N>0"
 by auto
 then have *: "real_of_int (N + 1) * norm x / real_of_int N < 1"
 using N assms by (auto simp: field_simps)
 have **: "real_of_int N * (norm x * (real_of_nat (Suc n) * norm (x ^ n))) ≤
 real_of_nat n * (norm x * ((1 + N) * norm (x ^ n)))" if "N ≤ int n" for n :: nat
 proof -
 from that have "real_of_int N * real_of_nat (Suc n) ≤ real_of_nat n * real_of_int (1 + N)"
 by (simp add: algebra_simps)
 then have "(real_of_int N * real_of_nat (Suc n)) * (norm x * norm (x ^ n)) ≤
 (real_of_nat n * (1 + N)) * (norm x * norm (x ^ n))"
 using N0 mult_mono by fastforce
 then show ?thesis
 by (simp add: algebra_simps)
 qed
 show ?thesis using *
 by (rule summable_LIMSEQ_zero [OF summable_ratio_test, where N1="nat N"])
 (simp add: N0 norm_mult field_simps ** del: of_nat_Suc of_int_add)
qed

corollary lim_n_over_pown:
 fixes x :: "'a::{real_normed_field,banach}"
 shows "1 < norm x ==> ((λn. of_nat n / x^n) ---> 0) sequentially"
 using powser_times_n_limit_0 [of "inverse x"]
 by (simp add: norm_divide field_split_simps)

lemma sum_split_even_odd:
 fixes f :: "nat ==> real"
 shows "(∑i<2 * n. if even i then f i else g i) = (∑i∑i
proof (induct n)
 case 0
 then show ?case by simp
next
 case (Suc n)
 have "(∑i<2 * Suc n. if even i then f i else g i) =
 (∑i∑i
 using Suc.hyps unfolding One_nat_def by auto
 also have "… = (∑i∑i
 by auto
 finally show ?case .
qed

lemma sums_if':
 fixes g :: "nat ==> real"
 assumes "g sums x"
 shows "(λ n. if even n then 0 else g ((n - 1) div 2)) sums x"
 unfolding sums_def
proof (rule LIMSEQ_I)
 fix r :: real
 assume "0 < r"
 from ‹g sums x›[unfolded sums_def, THEN LIMSEQ_D, OF this]
 obtain no where no_eq: "∧n. n ≥ no ==> (norm (sum g {..
 by blast

 let ?SUM = "λ m. ∑i
 have "(norm (?SUM m - x) < r)" if "m ≥ 2 * no" for m
 proof -
 from that have "m div 2 ≥ no" by auto
 have sum_eq: "?SUM (2 * (m div 2)) = sum g {..< m div 2}"
 using sum_split_even_odd by auto
 then have "(norm (?SUM (2 * (m div 2)) - x) < r)"
 using no_eq unfolding sum_eq using ‹m div 2 ≥ no› by auto
 moreover
 have "?SUM (2 * (m div 2)) = ?SUM m"
 proof (cases "even m")
 case True
 then show ?thesis
 by (auto simp: even_two_times_div_two)
 next
 case False
 then have eq: "Suc (2 * (m div 2)) = m" by simp
 then have "even (2 * (m div 2))" using ‹odd m› by auto
 have "?SUM m = ?SUM (Suc (2 * (m div 2)))" unfolding eq ..
 also have "… = ?SUM (2 * (m div 2))" using ‹even (2 * (m div 2))› by auto
 finally show ?thesis by auto
 qed
 ultimately show ?thesis by auto
 qed
 then show "∃no. ∀ m ≥ no. norm (?SUM m - x) < r"
 by blast
qed

lemma sums_if:
 fixes g :: "nat ==> real"
 assumes "g sums x" and "f sums y"
 shows "(λ n. if even n then f (n div 2) else g ((n - 1) div 2)) sums (x + y)"
proof -
 let ?s = "λ n. if even n then 0 else f ((n - 1) div 2)"
 have if_sum: "(if B then (0 :: real) else E) + (if B then T else 0) = (if B then T else E)"
 for B T E
 by (cases B) auto
 have g_sums: "(λ n. if even n then 0 else g ((n - 1) div 2)) sums x"
 using sums_if'[OF ‹g sums x›] .
 have if_eq: "∧B T E. (if ¬ B then T else E) = (if B then E else T)"
 by auto
 have "?s sums y" using sums_if'[OF ‹f sums y›] .
 from this[unfolded sums_def, THEN LIMSEQ_Suc]
 have "(λn. if even n then f (n div 2) else 0) sums y"
 by (simp add: lessThan_Suc_eq_insert_0 sum.atLeast1_atMost_eq image_Suc_lessThan
 if_eq sums_def cong del: if_weak_cong)
 from sums_add[OF g_sums this] show ?thesis
 by (simp only: if_sum)
qed

subsection ‹Alternating series test / Leibniz formula›
(* FIXME: generalise these results from the reals via type classes? *)

lemma sums_alternating_upper_lower:
 fixes a :: "nat ==> real"
 assumes mono: "∧n. a (Suc n) ≤ a n"
 and a_pos: "∧n. 0 ≤ a n"
 and "a <---- 0"
 shows "∃l. ((∀n. (∑i<2*n. (- 1)^i*a i) ≤ l) ∧ (λ n. ∑i<2*n. (- 1)^i*a i) <---- l) ∧
 ((∀n. l ≤ (∑i<2*n + 1. (- 1)^i*a i)) ∧ (λ n. ∑i<2*n + 1. (- 1)^i*a i) <---- l)"
 (is "∃l. ((∀n. ?f n ≤ l) ∧ _) ∧ ((∀n. l ≤ ?g n) ∧ _)")
proof (rule nested_sequence_unique)
 have fg_diff: "∧n. ?f n - ?g n = - a (2 * n)" by auto

 show "∀n. ?f n ≤ ?f (Suc n)"
 proof
 show "?f n ≤ ?f (Suc n)" for n
 using mono[of "2*n"] by auto
 qed
 show "∀n. ?g (Suc n) ≤ ?g n"
 proof
 show "?g (Suc n) ≤ ?g n" for n
 using mono[of "Suc (2*n)"] by auto
 qed
 show "∀n. ?f n ≤ ?g n"
 proof
 show "?f n ≤ ?g n" for n
 using fg_diff a_pos by auto
 qed
 show "(λn. ?f n - ?g n) <---- 0"
 unfolding fg_diff
 proof (rule LIMSEQ_I)
 fix r :: real
 assume "0 < r"
 with ‹a <---- 0›[THEN LIMSEQ_D] obtain N where "∧ n. n ≥ N ==> norm (a n - 0) < r"
 by auto
 then have "∀n ≥ N. norm (- a (2 * n) - 0) < r"
 by auto
 then show "∃N. ∀n ≥ N. norm (- a (2 * n) - 0) < r"
 by auto
 qed
qed

lemma summable_Leibniz':
 fixes a :: "nat ==> real"
 assumes a_zero: "a <---- 0"
 and a_pos: "∧n. 0 ≤ a n"
 and a_monotone: "∧n. a (Suc n) ≤ a n"
 shows summable: "summable (λ n. (-1)^n * a n)"
 and "∧n. (∑i<2*n. (-1)^i*a i) ≤ (∑i. (-1)^i*a i)"
 and "(λn. ∑i<2*n. (-1)^i*a i) <---- (∑i. (-1)^i*a i)"
 and "∧n. (∑i. (-1)^i*a i) ≤ (∑i<2*n+1. (-1)^i*a i)"
 and "(λn. ∑i<2*n+1. (-1)^i*a i) <---- (∑i. (-1)^i*a i)"
proof -
 let ?S = "λn. (-1)^n * a n"
 let ?P = "λn. ∑i
 let ?f = "λn. ?P (2 * n)"
 let ?g = "λn. ?P (2 * n + 1)"
 obtain l :: real
 where below_l: "∀ n. ?f n ≤ l"
 and "?f <---- l"
 and above_l: "∀ n. l ≤ ?g n"
 and "?g <---- l"
 using sums_alternating_upper_lower[OF a_monotone a_pos a_zero] by blast

 let ?Sa = "λm. ∑n
 have "?Sa <---- l"
 proof (rule LIMSEQ_I)
 fix r :: real
 assume "0 < r"
 with ‹?f <---- l›[THEN LIMSEQ_D]
 obtain f_no where f: "∧n. n ≥ f_no ==> norm (?f n - l) < r"
 by auto
 from ‹0 🚫› ‹?g <---- l›[THEN LIMSEQ_D]
 obtain g_no where g: "∧n. n ≥ g_no ==> norm (?g n - l) < r"
 by auto
 have "norm (?Sa n - l) < r" if "n ≥ (max (2 * f_no) (2 * g_no))" for n
 proof -
 from that have "n ≥ 2 * f_no" and "n ≥ 2 * g_no" by auto
 show ?thesis
 proof (cases "even n")
 case True
 then have n_eq: "2 * (n div 2) = n"
 by (simp add: even_two_times_div_two)
 with ‹n ≥ 2 * f_no› have "n div 2 ≥ f_no"
 by auto
 from f[OF this] show ?thesis
 unfolding n_eq atLeastLessThanSuc_atLeastAtMost .
 next
 case False
 then have "even (n - 1)" by simp
 then have n_eq: "2 * ((n - 1) div 2) = n - 1"
 by (simp add: even_two_times_div_two)
 then have range_eq: "n - 1 + 1 = n"
 using odd_pos[OF False] by auto
 from n_eq ‹n ≥ 2 * g_no› have "(n - 1) div 2 ≥ g_no"
 by auto
 from g[OF this] show ?thesis
 by (simp only: n_eq range_eq)
 qed
 qed
 then show "∃no. ∀n ≥ no. norm (?Sa n - l) < r" by blast
 qed
 then have sums_l: "(λi. (-1)^i * a i) sums l"
 by (simp only: sums_def)
 then show "summable ?S"
 by (auto simp: summable_def)

 have "l = suminf ?S" by (rule sums_unique[OF sums_l])

 fix n
 show "suminf ?S ≤ ?g n"
 unfolding sums_unique[OF sums_l, symmetric] using above_l by auto
 show "?f n ≤ suminf ?S"
 unfolding sums_unique[OF sums_l, symmetric] using below_l by auto
 show "?g <---- suminf ?S"
 using ‹?g <---- l› ‹l = suminf ?S› by auto
 show "?f <---- suminf ?S"
 using ‹?f <---- l› ‹l = suminf ?S› by auto
qed

theorem summable_Leibniz:
 fixes a :: "nat ==> real"
 assumes a_zero: "a <---- 0"
 and "monoseq a"
 shows "summable (λ n. (-1)^n * a n)" (is "?summable")
 and "0 < a 0 ⟶
 (∀n. (∑i. (- 1)^i*a i) ∈ { ∑i<2*n. (- 1)^i * a i .. ∑i<2*n+1. (- 1)^i * a i})" (is "?pos")
 and "a 0 < 0 ⟶
 (∀n. (∑i. (- 1)^i*a i) ∈ { ∑i<2*n+1. (- 1)^i * a i .. ∑i<2*n. (- 1)^i * a i})" (is "?neg")
 and "(λn. ∑i<2*n. (- 1)^i*a i) <---- (∑i. (- 1)^i*a i)" (is "?f")
 and "(λn. ∑i<2*n+1. (- 1)^i*a i) <---- (∑i. (- 1)^i*a i)" (is "?g")
proof -
 have "?summable ∧ ?pos ∧ ?neg ∧ ?f ∧ ?g"
 proof (cases "(∀n. 0 ≤ a n) ∧ (∀m. ∀n≥m. a n ≤ a m)")
 case True
 then have ord: "∧n m. m ≤ n ==> a n ≤ a m"
 and ge0: "∧n. 0 ≤ a n"
 by auto
 have mono: "a (Suc n) ≤ a n" for n
 using ord[where n="Suc n" and m=n] by auto
 note leibniz = summable_Leibniz'[OF ‹a <---- 0› ge0]
 from leibniz[OF mono]
 show ?thesis using ‹0 ≤ a 0› by auto
 next
 let ?a = "λn. - a n"
 case False
 with monoseq_le[OF ‹monoseq a› ‹a <---- 0›]
 have "(∀ n. a n ≤ 0) ∧ (∀m. ∀n≥m. a m ≤ a n)" by auto
 then have ord: "∧n m. m ≤ n ==> ?a n ≤ ?a m" and ge0: "∧ n. 0 ≤ ?a n"
 by auto
 have monotone: "?a (Suc n) ≤ ?a n" for n
 using ord[where n="Suc n" and m=n] by auto
 note leibniz =
 summable_Leibniz'[OF _ ge0, of "λx. x",
 OF tendsto_minus[OF ‹a <---- 0›, unfolded minus_zero] monotone]
 have "summable (λ n. (-1)^n * ?a n)"
 using leibniz(1) by auto
 then obtain l where "(λ n. (-1)^n * ?a n) sums l"
 unfolding summable_def by auto
 from this[THEN sums_minus] have "(λ n. (-1)^n * a n) sums -l"
 by auto
 then have ?summable by (auto simp: summable_def)
 moreover
 have "∣- a - - b∣ = ∣a - b∣" for a b :: real
 unfolding minus_diff_minus by auto

 from suminf_minus[OF leibniz(1), unfolded mult_minus_right minus_minus]
 have move_minus: "(∑n. - ((- 1) ^ n * a n)) = - (∑n. (- 1) ^ n * a n)"
 by auto

 have ?pos using ‹0 ≤ ?a 0› by auto
 moreover have ?neg
 using leibniz(2,4)
 unfolding mult_minus_right sum_negf move_minus neg_le_iff_le
 by auto
 moreover have ?f and ?g
 using leibniz(3,5)[unfolded mult_minus_right sum_negf move_minus, THEN tendsto_minus_cancel]
 by auto
 ultimately show ?thesis by auto
 qed
 then show ?summable and ?pos and ?neg and ?f and ?g
 by safe
qed

subsection ‹Term-by-Term Differentiability of Power Series›

definition diffs :: "(nat ==> 'a::ring_1) ==> nat ==> 'a"
 where "diffs c = (λn. of_nat (Suc n) * c (Suc n))"

text ‹Lemma about distributing negation over it.›
lemma diffs_minus: "diffs (λn. - c n) = (λn. - diffs c n)"
 by (simp add: diffs_def)

lemma diffs_equiv:
 fixes x :: "'a::{real_normed_vector,ring_1}"
 shows "summable (λn. diffs c n * x^n) ==>
 (λn. of_nat n * c n * x^(n - Suc 0)) sums (∑n. diffs c n * x^n)"
 unfolding diffs_def
 by (simp add: summable_sums sums_Suc_imp)

lemma lemma_termdiff1:
 fixes z :: "'a :: {monoid_mult,comm_ring}"
 shows "(∑p
 (∑p
 by (auto simp: algebra_simps power_add [symmetric])

lemma sumr_diff_mult_const2: "sum f {..∑i
 for r :: "'a::ring_1"
 by (simp add: sum_subtractf)

lemma lemma_termdiff2:
 fixes h :: "'a::field"
 assumes h: "h ≠ 0"
 shows "((z + h) ^ n - z ^ n) / h - of_nat n * z ^ (n - Suc 0) =
 h * (∑p< n - Suc 0. ∑q< n - Suc 0 - p. (z + h) ^ q * z ^ (n - 2 - q))"
 (is "?lhs = ?rhs")
proof (cases n)
 case (Suc m)
 have 0: "∧x k. (∑n
 (∑j
 by (auto simp add: power_add [symmetric] mult.commute intro: sum.cong)
 have *: "(∑i
 (∑i∑j
 by (force simp add: less_iff_Suc_add sum_distrib_left diff_power_eq_sum ac_simps 0
 simp del: sum.lessThan_Suc power_Suc intro: sum.cong)
 have "h * ?lhs = (z + h) ^ n - z ^ n - h * of_nat n * z ^ (n - Suc 0)"
 by (simp add: right_diff_distrib diff_divide_distrib h mult.assoc [symmetric])
 also have "... = h * ((∑p
 by (simp add: Suc diff_power_eq_sum h right_diff_distrib [symmetric] mult.assoc
 del: power_Suc sum.lessThan_Suc of_nat_Suc)
 also have "... = h * ((∑p
 by (subst sum.nat_diff_reindex[symmetric]) simp
 also have "... = h * (∑i
 by (simp add: sum_subtractf)
 also have "... = h * ?rhs"
 by (simp add: lemma_termdiff1 sum_distrib_left Suc *)
 finally have "h * ?lhs = h * ?rhs" .
 then show ?thesis
 by (simp add: h)
qed auto

lemma real_sum_nat_ivl_bounded2:
 fixes K :: "'a::linordered_semidom"
 assumes f: "∧p::nat. p < n ==> f p ≤ K" and K: "0 ≤ K"
 shows "sum f {..≤ of_nat n * K"
proof -
 have "sum f {..≤ (∑i
 by (rule sum_mono [OF f]) auto
 also have "... ≤ of_nat n * K"
 by (auto simp: mult_right_mono K)
 finally show ?thesis .
qed

lemma lemma_termdiff3:
 fixes h z :: "'a::real_normed_field"
 assumes 1: "h ≠ 0"
 and 2: "norm z ≤ K"
 and 3: "norm (z + h) ≤ K"
 shows "norm (((z + h) ^ n - z ^ n) / h - of_nat n * z ^ (n - Suc 0)) ≤
 of_nat n * of_nat (n - Suc 0) * K ^ (n - 2) * norm h"
proof -
 have "norm (((z + h) ^ n - z ^ n) / h - of_nat n * z ^ (n - Suc 0)) =
 norm (∑p∑q
 by (metis (lifting, no_types) lemma_termdiff2 [OF 1] mult.commute norm_mult)
 also have "… ≤ of_nat n * (of_nat (n - Suc 0) * K ^ (n - 2)) * norm h"
 proof (rule mult_right_mono [OF _ norm_ge_zero])
 from norm_ge_zero 2 have K: "0 ≤ K"
 by (rule order_trans)
 have le_Kn: "norm ((z + h) ^ i * z ^ j) ≤ K ^ n" if "i + j = n" for i j n
 proof -
 have "norm (z + h) ^ i * norm z ^ j ≤ K ^ i * K ^ j"
 by (intro mult_mono power_mono 2 3 norm_ge_zero zero_le_power K)
 also have "... = K^n"
 by (metis power_add that)
 finally show ?thesis
 by (simp add: norm_mult norm_power)
 qed
 then have "∧p q.
 [p < n; q < n - Suc 0] ==> norm ((z + h) ^ q * z ^ (n - 2 - q)) ≤ K ^ (n - 2)"
 by (simp del: subst_all)
 then
 show "norm (∑p∑q≤
 of_nat n * (of_nat (n - Suc 0) * K ^ (n - 2))"
 by (intro order_trans [OF norm_sum]
 real_sum_nat_ivl_bounded2 mult_nonneg_nonneg of_nat_0_le_iff zero_le_power K)
 qed
 also have "… = of_nat n * of_nat (n - Suc 0) * K ^ (n - 2) * norm h"
 by (simp only: mult.assoc)
 finally show ?thesis .
qed

lemma lemma_termdiff4:
 fixes f :: "'a::real_normed_vector ==> 'b::real_normed_vector"
 and k :: real
 assumes k: "0 < k"
 and le: "∧h. h ≠ 0 ==> norm h < k ==> norm (f h) ≤ K * norm h"
 shows "f ←-0→ 0"
proof (rule tendsto_norm_zero_cancel)
 show "(λh. norm (f h)) ←-0→ 0"
 proof (rule real_tendsto_sandwich)
 show "eventually (λh. 0 ≤ norm (f h)) (at 0)"
 by simp
 show "eventually (λh. norm (f h) ≤ K * norm h) (at 0)"
 using k by (auto simp: eventually_at dist_norm le)
 show "(λh. 0) ←-(0::'a)→ (0::real)"
 by (rule tendsto_const)
 have "(λh. K * norm h) ←-(0::'a)→ K * norm (0::'a)"
 by (intro tendsto_intros)
 then show "(λh. K * norm h) ←-(0::'a)→ 0"
 by simp
 qed
qed

lemma lemma_termdiff5:
 fixes g :: "'a::real_normed_vector ==> nat ==> 'b::banach"
 and k :: real
 assumes k: "0 < k"
 and f: "summable f"
 and le: "∧h n. h ≠ 0 ==> norm h < k ==> norm (g h n) ≤ f n * norm h"
 shows "(λh. suminf (g h)) ←-0→ 0"
proof (rule lemma_termdiff4 [OF k])
 fix h :: 'a
 assume "h ≠ 0" and "norm h < k"
 then have 1: "∀n. norm (g h n) ≤ f n * norm h"
 by (simp add: le)
 then have "∃N. ∀n≥N. norm (norm (g h n)) ≤ f n * norm h"
 by simp
 moreover from f have 2: "summable (λn. f n * norm h)"
 by (rule summable_mult2)
 ultimately have 3: "summable (λn. norm (g h n))"
 by (rule summable_comparison_test)
 then have "norm (suminf (g h)) ≤ (∑n. norm (g h n))"
 by (rule summable_norm)
 also from 1 3 2 have "(∑n. norm (g h n)) ≤ (∑n. f n * norm h)"
 by (simp add: suminf_le)
 also from f have "(∑n. f n * norm h) = suminf f * norm h"
 by (rule suminf_mult2 [symmetric])
 finally show "norm (suminf (g h)) ≤ suminf f * norm h" .
qed

(* FIXME: Long proofs *)

lemma termdiffs_aux:
 fixes x :: "'a::{real_normed_field,banach}"
 assumes 1: "summable (λn. diffs (diffs c) n * K ^ n)"
 and 2: "norm x < norm K"
 shows "(λh. ∑n. c n * (((x + h) ^ n - x^n) / h - of_nat n * x ^ (n - Suc 0))) ←-0→ 0"
proof -
 from dense [OF 2] obtain r where r1: "norm x < r" and r2: "r < norm K"
 by fast
 from norm_ge_zero r1 have r: "0 < r"
 by (rule order_le_less_trans)
 then have r_neq_0: "r ≠ 0" by simp
 show ?thesis
 proof (rule lemma_termdiff5)
 show "0 < r - norm x"
 using r1 by simp
 from r r2 have "norm (of_real r::'a) < norm K"
 by simp
 with 1 have "summable (λn. norm (diffs (diffs c) n * (of_real r ^ n)))"
 by (rule powser_insidea)
 then have "summable (λn. diffs (diffs (λn. norm (c n))) n * r ^ n)"
 using r by (simp add: diffs_def norm_mult norm_power del: of_nat_Suc)
 then have "summable (λn. of_nat n * diffs (λn. norm (c n)) n * r ^ (n - Suc 0))"
 by (rule diffs_equiv [THEN sums_summable])
 also have "(λn. of_nat n * diffs (λn. norm (c n)) n * r ^ (n - Suc 0)) =
 (λn. diffs (λm. of_nat (m - Suc 0) * norm (c m) * inverse r) n * (r ^ n))"
 by (simp add: diffs_def r_neq_0 fun_eq_iff split: nat_diff_split)
 finally have "summable
 (λn. of_nat n * (of_nat (n - Suc 0) * norm (c n) * inverse r) * r ^ (n - Suc 0))"
 by (rule diffs_equiv [THEN sums_summable])
 also have
 "(λn. of_nat n * (of_nat (n - Suc 0) * norm (c n) * inverse r) * r ^ (n - Suc 0)) =
 (λn. norm (c n) * of_nat n * of_nat (n - Suc 0) * r ^ (n - 2))"
 by (rule ext) (simp add: r_neq_0 split: nat_diff_split)
 finally show "summable (λn. norm (c n) * of_nat n * of_nat (n - Suc 0) * r ^ (n - 2))" .
 next
 fix h :: 'a and n
 assume h: "h ≠ 0"
 assume "norm h < r - norm x"
 then have "norm x + norm h < r" by simp
 with norm_triangle_ineq
 have xh: "norm (x + h) < r"
 by (rule order_le_less_trans)
 have "norm (((x + h) ^ n - x ^ n) / h - of_nat n * x ^ (n - Suc 0))
 ≤ real n * (real (n - Suc 0) * (r ^ (n - 2) * norm h))"
 by (metis (mono_tags, lifting) h mult.assoc lemma_termdiff3 less_eq_real_def r1 xh)
 then show "norm (c n * (((x + h) ^ n - x^n) / h - of_nat n * x ^ (n - Suc 0))) ≤
 norm (c n) * of_nat n * of_nat (n - Suc 0) * r ^ (n - 2) * norm h"
 by (simp only: norm_mult mult.assoc mult_left_mono [OF _ norm_ge_zero])
 qed
qed

lemma termdiffs:
 fixes K x :: "'a::{real_normed_field,banach}"
 assumes 1: "summable (λn. c n * K ^ n)"
 and 2: "summable (λn. (diffs c) n * K ^ n)"
 and 3: "summable (λn. (diffs (diffs c)) n * K ^ n)"
 and 4: "norm x < norm K"
 shows "DERIV (λx. ∑n. c n * x^n) x :> (∑n. (diffs c) n * x^n)"
 unfolding DERIV_def
proof (rule LIM_zero_cancel)
 show "(λh. (suminf (λn. c n * (x + h) ^ n) - suminf (λn. c n * x^n)) / h
 - suminf (λn. diffs c n * x^n)) ←-0→ 0"
 proof (rule LIM_equal2)
 show "0 < norm K - norm x"
 using 4 by (simp add: less_diff_eq)
 next
 fix h :: 'a
 assume "norm (h - 0) < norm K - norm x"
 then have "norm x + norm h < norm K" by simp
 then have 5: "norm (x + h) < norm K"
 by (rule norm_triangle_ineq [THEN order_le_less_trans])
 have "summable (λn. c n * x^n)"
 and "summable (λn. c n * (x + h) ^ n)"
 and "summable (λn. diffs c n * x^n)"
 using 1 2 4 5 by (auto elim: powser_inside)
 then have "((∑n. c n * (x + h) ^ n) - (∑n. c n * x^n)) / h - (∑n. diffs c n * x^n) =
 (∑n. (c n * (x + h) ^ n - c n * x^n) / h - of_nat n * c n * x ^ (n - Suc 0))"
 by (intro sums_unique sums_diff sums_divide diffs_equiv summable_sums)
 then show "((∑n. c n * (x + h) ^ n) - (∑n. c n * x^n)) / h - (∑n. diffs c n * x^n) =
 (∑n. c n * (((x + h) ^ n - x^n) / h - of_nat n * x ^ (n - Suc 0)))"
 by (simp add: algebra_simps)
 next
 show "(λh. ∑n. c n * (((x + h) ^ n - x^n) / h - of_nat n * x ^ (n - Suc 0))) ←-0→ 0"
 by (rule termdiffs_aux [OF 3 4])
 qed
qed

subsection ‹The Derivative of a Power Series Has the Same Radius of Convergence›

lemma termdiff_converges:
 fixes x :: "'a::{real_normed_field,banach}"
 assumes K: "norm x < K"
 and sm: "∧x. norm x < K ==> summable(λn. c n * x ^ n)"
 shows "summable (λn. diffs c n * x ^ n)"
proof (cases "x = 0")
 case True
 then show ?thesis
 using powser_sums_zero sums_summable by auto
next
 case False
 then have "K > 0"
 using K less_trans zero_less_norm_iff by blast
 then obtain r :: real where r: "norm x < norm r" "norm r < K" "r > 0"
 using K False
 by (auto simp: field_simps abs_less_iff add_pos_pos intro: that [of "(norm x + K) / 2"])
 have to0: "(λn. of_nat n * (x / of_real r) ^ n) <---- 0"
 using r by (simp add: norm_divide powser_times_n_limit_0 [of "x / of_real r"])
 obtain N where N: "∧n. n≥N ==> real_of_nat n * norm x ^ n < r ^ n"
 using r LIMSEQ_D [OF to0, of 1]
 by (auto simp: norm_divide norm_mult norm_power field_simps)
 have "summable (λn. (of_nat n * c n) * x ^ n)"
 proof (rule summable_comparison_test')
 show "summable (λn. norm (c n * of_real r ^ n))"
 apply (rule powser_insidea [OF sm [of "of_real ((r+K)/2)"]])
 using N r norm_of_real [of "r + K", where 'a = 'a] by auto
 show "∧n. N ≤ n ==> norm (of_nat n * c n * x ^ n) ≤ norm (c n * of_real r ^ n)"
 using N r by (fastforce simp add: norm_mult norm_power less_eq_real_def)
 qed
 then have "summable (λn. (of_nat (Suc n) * c(Suc n)) * x ^ Suc n)"
 using summable_iff_shift [of "λn. of_nat n * c n * x ^ n" 1]
 by simp
 then have "summable (λn. (of_nat (Suc n) * c(Suc n)) * x ^ n)"
 using False summable_mult2 [of "λn. (of_nat (Suc n) * c(Suc n) * x ^ n) * x" "inverse x"]
 by (simp add: mult.assoc) (auto simp: ac_simps)
 then show ?thesis
 by (simp add: diffs_def)
qed

lemma termdiff_converges_all:
 fixes x :: "'a::{real_normed_field,banach}"
 assumes "∧x. summable (λn. c n * x^n)"
 shows "summable (λn. diffs c n * x^n)"
 by (rule termdiff_converges [where K = "1 + norm x"]) (use assms in auto)

lemma termdiffs_strong:
 fixes K x :: "'a::{real_normed_field,banach}"
 assumes sm: "summable (λn. c n * K ^ n)"
 and K: "norm x < norm K"
 shows "DERIV (λx. ∑n. c n * x^n) x :> (∑n. diffs c n * x^n)"
proof -
 have "norm K + norm x < norm K + norm K"
 using K by force
 then have K2: "norm ((of_real (norm K) + of_real (norm x)) / 2 :: 'a) < norm K"
 by (auto simp: norm_triangle_lt norm_divide field_simps)
 then have [simp]: "norm ((of_real (norm K) + of_real (norm x)) :: 'a) < norm K * 2"
 by simp
 have "summable (λn. c n * (of_real (norm x + norm K) / 2) ^ n)"
 by (metis K2 summable_norm_cancel [OF powser_insidea [OF sm]] add.commute of_real_add)
 moreover have "∧x. norm x < norm K ==> summable (λn. diffs c n * x ^ n)"
 by (blast intro: sm termdiff_converges powser_inside)
 moreover have "∧x. norm x < norm K ==> summable (λn. diffs(diffs c) n * x ^ n)"
 by (blast intro: sm termdiff_converges powser_inside)
 ultimately show ?thesis
 by (rule termdiffs [where K = "of_real (norm x + norm K) / 2"])
 (use K in ‹auto simp: field_simps simp flip: of_real_add›)
qed

lemma termdiffs_strong_converges_everywhere:
 fixes K x :: "'a::{real_normed_field,banach}"
 assumes "∧y. summable (λn. c n * y ^ n)"
 shows "((λx. ∑n. c n * x^n) has_field_derivative (∑n. diffs c n * x^n)) (at x)"
 using termdiffs_strong[OF assms[of "of_real (norm x + 1)"], of x]
 by (force simp del: of_real_add)

lemma termdiffs_strong':
 fixes z :: "'a :: {real_normed_field,banach}"
 assumes "∧z. norm z < K ==> summable (λn. c n * z ^ n)"
 assumes "norm z < K"
 shows "((λz. ∑n. c n * z^n) has_field_derivative (∑n. diffs c n * z^n)) (at z)"
proof (rule termdiffs_strong)
 define L :: real where "L = (norm z + K) / 2"
 have "0 ≤ norm z" by simp
 also note ‹norm z 🚫›
 finally have K: "K ≥ 0" by simp
 from assms K have L: "L ≥ 0" "norm z < L" "L < K" by (simp_all add: L_def)
 from L show "norm z < norm (of_real L :: 'a)" by simp
 from L show "summable (λn. c n * of_real L ^ n)" by (intro assms(1)) simp_all
qed

lemma termdiffs_sums_strong:
 fixes z :: "'a :: {banach,real_normed_field}"
 assumes sums: "∧z. norm z < K ==> (λn. c n * z ^ n) sums f z"
 assumes deriv: "(f has_field_derivative f') (at z)"
 assumes norm: "norm z < K"
 shows "(λn. diffs c n * z ^ n) sums f'"
proof -
 have summable: "summable (λn. diffs c n * z^n)"
 by (intro termdiff_converges[OF norm] sums_summable[OF sums])
 from norm have "eventually (λz. z ∈ norm -` {..
 by (intro eventually_nhds_in_open open_vimage)
 (simp_all add: continuous_on_norm)
 hence eq: "eventually (λz. (∑n. c n * z^n) = f z) (nhds z)"
 by eventually_elim (insert sums, simp add: sums_iff)

 have "((λz. ∑n. c n * z^n) has_field_derivative (∑n. diffs c n * z^n)) (at z)"
 by (intro termdiffs_strong'[OF _ norm] sums_summable[OF sums])
 hence "(f has_field_derivative (∑n. diffs c n * z^n)) (at z)"
 by (subst (asm) DERIV_cong_ev[OF refl eq refl])
 from this and deriv have "(∑n. diffs c n * z^n) = f'" by (rule DERIV_unique)
 with summable show ?thesis by (simp add: sums_iff)
qed

lemma isCont_powser:
 fixes K x :: "'a::{real_normed_field,banach}"
 assumes "summable (λn. c n * K ^ n)"
 assumes "norm x < norm K"
 shows "isCont (λx. ∑n. c n * x^n) x"
 using termdiffs_strong[OF assms] by (blast intro!: DERIV_isCont)

lemmas isCont_powser' = isCont_o2[OF _ isCont_powser]

lemma isCont_powser_converges_everywhere:
 fixes K x :: "'a::{real_normed_field,banach}"
 assumes "∧y. summable (λn. c n * y ^ n)"
 shows "isCont (λx. ∑n. c n * x^n) x"
 using termdiffs_strong[OF assms[of "of_real (norm x + 1)"], of x]
 by (force intro!: DERIV_isCont simp del: of_real_add)

lemma powser_limit_0:
 fixes a :: "nat ==> 'a::{real_normed_field,banach}"
 assumes s: "0 < s"
 and sm: "∧x. norm x < s ==> (λn. a n * x ^ n) sums (f x)"
 shows "(f ---> a 0) (at 0)"
proof -
 have "norm (of_real s / 2 :: 'a) < s"
 using s by (auto simp: norm_divide)
 then have "summable (λn. a n * (of_real s / 2) ^ n)"
 by (rule sums_summable [OF sm])
 then have "((λx. ∑n. a n * x ^ n) has_field_derivative (∑n. diffs a n * 0 ^ n)) (at 0)"
 by (rule termdiffs_strong) (use s in ‹auto simp: norm_divide›)
 then have "isCont (λx. ∑n. a n * x ^ n) 0"
 by (blast intro: DERIV_continuous)
 then have "((λx. ∑n. a n * x ^ n) ---> a 0) (at 0)"
 by (simp add: continuous_within)
 moreover have "(λx. f x - (∑n. a n * x ^ n)) ←-0→ 0"
 apply (clarsimp simp: LIM_eq)
 apply (rule_tac x=s in exI)
 using s sm sums_unique by fastforce
 ultimately show ?thesis
 by (rule Lim_transform)
qed

lemma powser_limit_0_strong:
 fixes a :: "nat ==> 'a::{real_normed_field,banach}"
 assumes s: "0 < s"
 and sm: "∧x. x ≠ 0 ==> norm x < s ==> (λn. a n * x ^ n) sums (f x)"
 shows "(f ---> a 0) (at 0)"
proof -
 have *: "((λx. if x = 0 then a 0 else f x) ---> a 0) (at 0)"
 by (rule powser_limit_0 [OF s]) (auto simp: powser_sums_zero sm)
 show ?thesis
 using "*" by (auto cong: Lim_cong_within)
qed

subsection ‹Derivability of power series›

lemma DERIV_series':
 fixes f :: "real ==> nat ==> real"
 assumes DERIV_f: "∧ n. DERIV (λ x. f x n) x0 :> (f' x0 n)"
 and allf_summable: "∧ x. x ∈ {a <..< b} ==> summable (f x)"
 and x0_in_I: "x0 ∈ {a <..< b}"
 and "summable (f' x0)"
 and "summable L"
 and L_def: "∧n x y. x ∈ {a <..< b} ==> y ∈ {a <..< b} ==> ∣f x n - f y n∣ ≤ L n * ∣x - y∣"
 shows "DERIV (λ x. suminf (f x)) x0 :> (suminf (f' x0))"
 unfolding DERIV_def
proof (rule LIM_I)
 fix r :: real
 assume "0 < r" then have "0 < r/3" by auto

 obtain N_L where N_L: "∧ n. N_L ≤ n ==> ∣ ∑ i. L (i + n) ∣ < r/3"
 using suminf_exist_split[OF ‹0 🚫/3› ‹summable L›] by auto

 obtain N_f' where N_f': "∧ n. N_f' ≤ n ==> ∣ ∑ i. f' x0 (i + n) ∣ < r/3"
 using suminf_exist_split[OF ‹0 🚫/3› ‹summable (f' x0)›] by auto

 let ?N = "Suc (max N_L N_f')"
 have "∣ ∑ i. f' x0 (i + ?N) ∣ < r/3" (is "?f'_part < r/3")
 and L_estimate: "∣ ∑ i. L (i + ?N) ∣ < r/3"
 using N_L[of "?N"] and N_f' [of "?N"] by auto

 let ?diff = "λi x. (f (x0 + x) i - f x0 i) / x"

 let ?r = "r / (3 * real ?N)"
 from ‹0 🚫› have "0 < ?r" by simp

 let ?s = "λn. SOME s. 0 < s ∧ (∀ x. x ≠ 0 ∧ ∣ x ∣ < s ⟶ ∣ ?diff n x - f' x0 n ∣ < ?r)"
 define S' where "S' = Min (?s ` {..< ?N })"

 have "0 < S'"
 unfolding S'_def
 proof (rule iffD2[OF Min_gr_iff])
 show "∀x ∈ (?s ` {..< ?N }). 0 < x"
 proof
 fix x
 assume "x ∈ ?s ` {..
 then obtain n where "x = ?s n" and "n ∈ {..
 using image_iff[THEN iffD1] by blast
 from DERIV_D[OF DERIV_f[where n=n], THEN LIM_D, OF ‹0 🚫r›, unfolded real_norm_def]
 obtain s where s_bound: "0 < s ∧ (∀x. x ≠ 0 ∧ ∣x∣ < s ⟶ ∣?diff n x - f' x0 n∣ < ?r)"
 by auto
 have "0 < ?s n"
 by (rule someI2[where a=s]) (auto simp: s_bound simp del: of_nat_Suc)
 then show "0 < x" by (simp only: ‹x = ?s n›)
 qed
 qed auto

 define S where "S = min (min (x0 - a) (b - x0)) S'"
 then have "0 < S" and S_a: "S ≤ x0 - a" and S_b: "S ≤ b - x0"
 and "S ≤ S'" using x0_in_I and ‹0 🚫'›
 by auto

 have "∣(suminf (f (x0 + x)) - suminf (f x0)) / x - suminf (f' x0)∣ < r"
 if "x ≠ 0" and "∣x∣ < S" for x
 proof -
 from that have x_in_I: "x0 + x ∈ {a <..< b}"
 using S_a S_b by auto

 note diff_smbl = summable_diff[OF allf_summable[OF x_in_I] allf_summable[OF x0_in_I]]
 note div_smbl = summable_divide[OF diff_smbl]
 note all_smbl = summable_diff[OF div_smbl ‹summable (f' x0)›]
 note ign = summable_ignore_initial_segment[where k="?N"]
 note diff_shft_smbl = summable_diff[OF ign[OF allf_summable[OF x_in_I]] ign[OF allf_summable[OF x0_in_I]]]
 note div_shft_smbl = summable_divide[OF diff_shft_smbl]
 note all_shft_smbl = summable_diff[OF div_smbl ign[OF ‹summable (f' x0)›]]

 have 1: "∣(∣?diff (n + ?N) x∣)∣ ≤ L (n + ?N)" for n
 proof -
 have "∣?diff (n + ?N) x∣ ≤ L (n + ?N) * ∣(x0 + x) - x0∣ / ∣x∣"
 using divide_right_mono[OF L_def[OF x_in_I x0_in_I] abs_ge_zero]
 by (simp only: abs_divide)
 with ‹x ≠ 0› show ?thesis by auto
 qed
 note 2 = summable_rabs_comparison_test[OF _ ign[OF ‹summable L›]]
 from 1 have "∣ ∑ i. ?diff (i + ?N) x ∣ ≤ (∑ i. L (i + ?N))"
 by (metis (lifting) abs_idempotent
 order_trans[OF summable_rabs[OF 2] suminf_le[OF _ 2 ign[OF ‹summable L›]]])
 then have "∣∑i. ?diff (i + ?N) x∣ ≤ r / 3" (is "?L_part ≤ r/3")
 using L_estimate by auto

 have "∣∑n∣ ≤ (∑n∣?diff n x - f' x0 n∣)" ..
 also have "… < (∑n
 proof (rule sum_strict_mono)
 fix n
 assume "n ∈ {..< ?N}"
 have "∣x∣ < S" using ‹∣x∣ 🚫› .
 also have "S ≤ S'" using ‹S ≤ S'› .
 also have "S' ≤ ?s n"
 unfolding S'_def
 proof (rule Min_le_iff[THEN iffD2])
 have "?s n ∈ (?s ` {..∧ ?s n ≤ ?s n"
 using ‹n ∈ {..🚫N}› by auto
 then show "∃ a ∈ (?s ` {..≤ ?s n"
 by blast
 qed auto
 finally have "∣x∣ < ?s n" .

 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]
 have "∀x. x ≠ 0 ∧ ∣x∣ < ?s n ⟶ ∣?diff n x - f' x0 n∣ < ?r" .
 with ‹x ≠ 0› and ‹∣x∣ 🚫s n› show "∣?diff n x - f' x0 n∣ < ?r"
 by blast
 qed auto
 also have "… = of_nat (card {..
 by (rule sum_constant)
 also have "… = real ?N * ?r"
 by simp
 also have "… = r/3"
 by (auto simp del: of_nat_Suc)
 finally have "∣∑n∣ < r / 3" (is "?diff_part < r / 3") .

 from suminf_diff[OF allf_summable[OF x_in_I] allf_summable[OF x0_in_I]]
 have "∣(suminf (f (x0 + x)) - (suminf (f x0))) / x - suminf (f' x0)∣ =
 ∣∑n. ?diff n x - f' x0 n∣"
 unfolding suminf_diff[OF div_smbl ‹summable (f' x0)›, symmetric]
 using suminf_divide[OF diff_smbl, symmetric] by auto
 also have "… ≤ ?diff_part + ∣(∑n. ?diff (n + ?N) x) - (∑ n. f' x0 (n + ?N))∣"
 unfolding suminf_split_initial_segment[OF all_smbl, where k="?N"]
 unfolding suminf_diff[OF div_shft_smbl ign[OF ‹summable (f' x0)›]]
 apply (simp only: add.commute)
 using abs_triangle_ineq by blast
 also have "… ≤ ?diff_part + ?L_part + ?f'_part"
 using abs_triangle_ineq4 by auto
 also have "… < r /3 + r/3 + r/3"
 using ‹?diff_part 🚫/3› ‹?L_part ≤ r/3› and ‹?f'_part 🚫/3›
 by (rule add_strict_mono [OF add_less_le_mono])
 finally show ?thesis
 by auto
 qed
 then show "∃s > 0. ∀ x. x ≠ 0 ∧ norm (x - 0) < s ⟶
 norm (((∑n. f (x0 + x) n) - (∑n. f x0 n)) / x - (∑n. f' x0 n)) < r"
 using ‹0 🚫› by auto
qed

lemma DERIV_power_series':
 fixes f :: "nat ==> real"
 assumes converges: "∧x. x ∈ {-R <..< R} ==> summable (λn. f n * real (Suc n) * x^n)"
 and x0_in_I: "x0 ∈ {-R <..< R}"
 and "0 < R"
 shows "DERIV (λx. (∑n. f n * x^(Suc n))) x0 :> (∑n. f n * real (Suc n) * x0^n)"
 (is "DERIV (λx. suminf (?f x)) x0 :> suminf (?f' x0)")
proof -
 have for_subinterval: "DERIV (λx. suminf (?f x)) x0 :> suminf (?f' x0)"
 if "0 < R'" and "R' < R" and "-R' < x0" and "x0 < R'" for R'
 proof -
 from that have "x0 ∈ {-R' <..< R'}" and "R' ∈ {-R <..< R}" and "x0 ∈ {-R <..< R}"
 by auto
 show ?thesis
 proof (rule DERIV_series')
 show "summable (λ n. ∣f n * real (Suc n) * R'^n∣)"
 proof -
 have "(R' + R) / 2 < R" and "0 < (R' + R) / 2"
 using ‹0 🚫'› ‹0 🚫› ‹R' 🚫› by (auto simp: field_simps)
 then have in_Rball: "(R' + R) / 2 ∈ {-R <..< R}"
 using ‹R' 🚫› by auto
 have "norm R' < norm ((R' + R) / 2)"
 using ‹0 🚫'› ‹0 🚫› ‹R' 🚫› by (auto simp: field_simps)
 from powser_insidea[OF converges[OF in_Rball] this] show ?thesis
 by auto
 qed
 next
 fix n x y
 assume "x ∈ {-R' <..< R'}" and "y ∈ {-R' <..< R'}"
 show "∣?f x n - ?f y n∣ ≤ ∣f n * real (Suc n) * R'^n∣ * ∣x-y∣"
 proof -
 have "∣f n * x ^ (Suc n) - f n * y ^ (Suc n)∣ =
 (∣f n∣ * ∣x-y∣) * ∣∑p∣"
 unfolding right_diff_distrib[symmetric] diff_power_eq_sum abs_mult
 by auto
 also have "… ≤ (∣f n∣ * ∣x-y∣) * (∣real (Suc n)∣ * ∣R' ^ n∣)"
 proof (rule mult_left_mono)
 have "∣∑p∣ ≤ (∑p∣x ^ p * y ^ (n - p)∣)"
 by (rule sum_abs)
 also have "… ≤ (∑p
 proof (rule sum_mono)
 fix p
 assume "p ∈ {..
 then have "p ≤ n" by auto
 have "∣x^n∣ ≤ R'^n" if "x ∈ {-R'<.. for n and x :: real
 proof -
 from that have "∣x∣ ≤ R'" by auto
 then show ?thesis
 unfolding power_abs by (rule power_mono) auto
 qed
 from mult_mono[OF this[OF ‹x ∈ {-R'🚫🚫}›, of p] this[OF ‹y ∈ {-R'🚫🚫}›, of "n-p"]]
 and ‹0 🚫'›
 have "∣x^p * y^(n - p)∣ ≤ R'^p * R'^(n - p)"
 unfolding abs_mult by auto
 then show "∣x^p * y^(n - p)∣ ≤ R'^n"
 unfolding power_add[symmetric] using ‹p ≤ n› by auto
 qed
 also have "… = real (Suc n) * R' ^ n"
 unfolding sum_constant card_atLeastLessThan by auto
 finally show "∣∑p∣ ≤ ∣real (Suc n)∣ * ∣R' ^ n∣"
 unfolding abs_of_nonneg[OF zero_le_power[OF less_imp_le[OF ‹0 🚫'›]]]
 by linarith
 show "0 ≤ ∣f n∣ * ∣x - y∣"
 unfolding abs_mult[symmetric] by auto
 qed
 also have "… = ∣f n * real (Suc n) * R' ^ n∣ * ∣x - y∣"
 unfolding abs_mult mult.assoc[symmetric] by algebra
 finally show ?thesis .
 qed
 next
 show "DERIV (λx. ?f x n) x0 :> ?f' x0 n" for n
 by (auto intro!: derivative_eq_intros simp del: power_Suc)
 next
 fix x
 assume "x ∈ {-R' <..< R'}"
 then have "R' ∈ {-R <..< R}" and "norm x < norm R'"
 using assms ‹R' 🚫› by auto
 have "summable (λn. f n * x^n)"
 proof (rule summable_comparison_test, intro exI allI impI)
 fix n
 have le: "∣f n∣ * 1 ≤ ∣f n∣ * real (Suc n)"
 by (rule mult_left_mono) auto
 show "norm (f n * x^n) ≤ norm (f n * real (Suc n) * x^n)"
 unfolding real_norm_def abs_mult
 using le mult_right_mono by fastforce
 qed (rule powser_insidea[OF converges[OF ‹R' ∈ {-R 🚫🚫}›] ‹norm x 🚫 R'›])
 from this[THEN summable_mult2[where c=x], simplified mult.assoc, simplified mult.commute]
 show "summable (?f x)" by auto
 next
 show "summable (?f' x0)"
 using converges[OF ‹x0 ∈ {-R 🚫🚫}›] .
 show "x0 ∈ {-R' <..< R'}"
 using ‹x0 ∈ {-R' 🚫🚫'}› .
 qed
 qed
 let ?R = "(R + ∣x0∣) / 2"
 have "∣x0∣ < ?R"
 using assms by (auto simp: field_simps)
 then have "- ?R < x0"
 proof (cases "x0 < 0")
 case True
 then have "- x0 < ?R"
 using ‹∣x0∣ 🚫R› by auto
 then show ?thesis
 unfolding neg_less_iff_less[symmetric, of "- x0"] by auto
 next
 case False
 have "- ?R < 0" using assms by auto
 also have "… ≤ x0" using False by auto
 finally show ?thesis .
 qed
 then have "0 < ?R" "?R < R" "- ?R < x0" and "x0 < ?R"
 using assms by (auto simp: field_simps)
 from for_subinterval[OF this] show ?thesis .
qed

lemma geometric_deriv_sums:
 fixes z :: "'a :: {real_normed_field,banach}"
 assumes "norm z < 1"
 shows "(λn. of_nat (Suc n) * z ^ n) sums (1 / (1 - z)^2)"
proof -
 have "(λn. diffs (λn. 1) n * z^n) sums (1 / (1 - z)^2)"
 proof (rule termdiffs_sums_strong)
 fix z :: 'a assume "norm z < 1"
 thus "(λn. 1 * z^n) sums (1 / (1 - z))" by (simp add: geometric_sums)
 qed (insert assms, auto intro!: derivative_eq_intros simp: power2_eq_square)
 thus ?thesis unfolding diffs_def by simp
qed

lemma isCont_pochhammer [continuous_intros]: "isCont (λz. pochhammer z n) z"
 for z :: "'a::real_normed_field"
 by (induct n) (auto simp: pochhammer_rec')

lemma continuous_on_pochhammer [continuous_intros]: "continuous_on A (λz. pochhammer z n)"
 for A :: "'a::real_normed_field set"
 by (intro continuous_at_imp_continuous_on ballI isCont_pochhammer)

lemmas continuous_on_pochhammer' [continuous_intros] =
 continuous_on_compose2[OF continuous_on_pochhammer _ subset_UNIV]

subsection ‹Exponential Function›

definition exp :: "'a ==> 'a::{real_normed_algebra_1,banach}"
 where "exp = (λx. ∑n. x^n /🪙R fact n)"

lemma summable_exp_generic:
 fixes x :: "'a::{real_normed_algebra_1,banach}"
 defines S_def: "S ≡ λn. x^n /🪙R fact n"
 shows "summable S"
proof -
 have S_Suc: "∧n. S (Suc n) = (x * S n) /🪙R (Suc n)"
 unfolding S_def by (simp del: mult_Suc)
 obtain r :: real where r0: "0 < r" and r1: "r < 1"
 using dense [OF zero_less_one] by fast
 obtain N :: nat where N: "norm x < real N * r"
 using ex_less_of_nat_mult r0 by auto
 from r1 show ?thesis
 proof (rule summable_ratio_test [rule_format])
 fix n :: nat
 assume n: "N ≤ n"
 have "norm x ≤ real N * r"
 using N by (rule order_less_imp_le)
 also have "real N * r ≤ real (Suc n) * r"
 using r0 n by (simp add: mult_right_mono)
 finally have "norm x * norm (S n) ≤ real (Suc n) * r * norm (S n)"
 using norm_ge_zero by (rule mult_right_mono)
 then have "norm (x * S n) ≤ real (Suc n) * r * norm (S n)"
 by (rule order_trans [OF norm_mult_ineq])
 then have "norm (x * S n) / real (Suc n) ≤ r * norm (S n)"
 by (simp add: pos_divide_le_eq ac_simps)
 then show "norm (S (Suc n)) ≤ r * norm (S n)"
 by (simp add: S_Suc inverse_eq_divide)
 qed
qed

lemma summable_norm_exp: "summable (λn. norm (x^n /🪙R fact n))"
 for x :: "'a::{real_normed_algebra_1,banach}"
proof (rule summable_norm_comparison_test [OF exI, rule_format])
 show "summable (λn. norm x^n /🪙R fact n)"
 by (rule summable_exp_generic)
 show "norm (x^n /🪙R fact n) ≤ norm x^n /🪙R fact n" for n
 by (simp add: norm_power_ineq)
qed

lemma summable_exp: "summable (λn. inverse (fact n) * x^n)"
 for x :: "'a::{real_normed_field,banach}"
 using summable_exp_generic [where x=x]
 by (simp add: scaleR_conv_of_real nonzero_of_real_inverse)

lemma exp_converges: "(λn. x^n /🪙R fact n) sums exp x"
 unfolding exp_def by (rule summable_exp_generic [THEN summable_sums])

lemma exp_fdiffs:
 "diffs (λn. inverse (fact n)) = (λn. inverse (fact n :: 'a::{real_normed_field,banach}))"
 by (simp add: diffs_def mult_ac nonzero_inverse_mult_distrib nonzero_of_real_inverse
 del: mult_Suc of_nat_Suc)

lemma diffs_of_real: "diffs (λn. of_real (f n)) = (λn. of_real (diffs f n))"
 by (simp add: diffs_def)

lemma DERIV_exp [simp]: "DERIV exp x :> exp x"
 unfolding exp_def scaleR_conv_of_real
proof (rule DERIV_cong)
 have sinv: "summable (λn. of_real (inverse (fact n)) * x ^ n)" for x::'a
 by (rule exp_converges [THEN sums_summable, unfolded scaleR_conv_of_real])
 note xx = exp_converges [THEN sums_summable, unfolded scaleR_conv_of_real]
 show "((λx. ∑n. of_real (inverse (fact n)) * x ^ n) has_field_derivative
 (∑n. diffs (λn. of_real (inverse (fact n))) n * x ^ n)) (at x)"
 by (rule termdiffs [where K="of_real (1 + norm x)"]) (simp_all only: diffs_of_real exp_fdiffs sinv norm_of_real)
 show "(∑n. diffs (λn. of_real (inverse (fact n))) n * x ^ n) = (∑n. of_real (inverse (fact n)) * x ^ n)"
 by (simp add: diffs_of_real exp_fdiffs)
qed

declare DERIV_exp[THEN DERIV_chain2, derivative_intros]
 and DERIV_exp[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]

lemmas has_derivative_exp[derivative_intros] = DERIV_exp[THEN DERIV_compose_FDERIV]

lemma norm_exp: "norm (exp x) ≤ exp (norm x)"
proof -
 from summable_norm[OF summable_norm_exp, of x]
 have "norm (exp x) ≤ (∑n. inverse (fact n) * norm (x^n))"
 by (simp add: exp_def)
 also have "… ≤ exp (norm x)"
 using summable_exp_generic[of "norm x"] summable_norm_exp[of x]
 by (auto simp: exp_def intro!: suminf_le norm_power_ineq)
 finally show ?thesis .
qed

lemma isCont_exp: "isCont exp x"
 for x :: "'a::{real_normed_field,banach}"
 by (rule DERIV_exp [THEN DERIV_isCont])

lemma isCont_exp' [simp]: "isCont f a ==> isCont (λx. exp (f x)) a"
 for f :: "_ ==>'a::{real_normed_field,banach}"
 by (rule isCont_o2 [OF _ isCont_exp])

lemma tendsto_exp [tendsto_intros]: "(f ---> a) F ==> ((λx. exp (f x)) ---> exp a) F"
 for f:: "_ ==>'a::{real_normed_field,banach}"
 by (rule isCont_tendsto_compose [OF isCont_exp])

lemma continuous_exp [continuous_intros]: "continuous F f ==> continuous F (λx. exp (f x))"
 for f :: "_ ==>'a::{real_normed_field,banach}"
 unfolding continuous_def by (rule tendsto_exp)

lemma continuous_on_exp [continuous_intros]: "continuous_on s f ==> continuous_on s (λx. exp (f x))"
 for f :: "_ ==>'a::{real_normed_field,banach}"
 unfolding continuous_on_def by (auto intro: tendsto_exp)

subsubsection ‹Properties of the Exponential Function›

lemma exp_zero [simp]: "exp 0 = 1"
 unfolding exp_def by (simp add: scaleR_conv_of_real)

lemma exp_series_add_commuting:
 fixes x y :: "'a::{real_normed_algebra_1,banach}"
 defines S_def: "S ≡ λx n. x^n /🪙R fact n"
 assumes comm: "x * y = y * x"
 shows "S (x + y) n = (∑i≤n. S x i * S y (n - i))"
proof (induct n)
 case 0
 show ?case
 unfolding S_def by simp
next
 case (Suc n)
 have S_Suc: "∧x n. S x (Suc n) = (x * S x n) /🪙R real (Suc n)"
 unfolding S_def by (simp del: mult_Suc)
 then have times_S: "∧x n. x * S x n = real (Suc n) *🪙R S x (Suc n)"
 by simp
 have S_comm: "∧n. S x n * y = y * S x n"
 by (simp add: power_commuting_commutes comm S_def)

 have "real (Suc n) *🪙R S (x + y) (Suc n) = (x + y) * (∑i≤n. S x i * S y (n - i))"
 by (metis Suc.hyps times_S)
 also have "… = x * (∑i≤n. S x i * S y (n - i)) + y * (∑i≤n. S x i * S y (n - i))"
 by (rule distrib_right)
 also have "… = (∑i≤n. x * S x i * S y (n - i)) + (∑i≤n. S x i * y * S y (n - i))"
 by (simp add: sum_distrib_left ac_simps S_comm)
 also have "… = (∑i≤n. x * S x i * S y (n - i)) + (∑i≤n. S x i * (y * S y (n - i)))"
 by (simp add: ac_simps)
 also have "… = (∑i≤n. real (Suc i) *🪙R (S x (Suc i) * S y (n - i)))
 + (∑i≤n. real (Suc n - i) *🪙R (S x i * S y (Suc n - i)))"
 by (simp add: times_S Suc_diff_le)
 also have "(∑i≤n. real (Suc i) *🪙R (S x (Suc i) * S y (n - i)))
 = (∑i≤Suc n. real i *🪙R (S x i * S y (Suc n - i)))"
 by (subst sum.atMost_Suc_shift) simp
 also have "(∑i≤n. real (Suc n - i) *🪙R (S x i * S y (Suc n - i)))
 = (∑i≤Suc n. real (Suc n - i) *🪙R (S x i * S y (Suc n - i)))"
 by simp
 also have "(∑i≤Suc n. real i *🪙R (S x i * S y (Suc n - i)))
 + (∑i≤Suc n. real (Suc n - i) *🪙R (S x i * S y (Suc n - i)))
 = (∑i≤Suc n. real (Suc n) *🪙R (S x i * S y (Suc n - i)))"
 by (simp flip: sum.distrib scaleR_add_left of_nat_add)
 also have "… = real (Suc n) *🪙R (∑i≤Suc n. S x i * S y (Suc n - i))"
 by (simp only: scaleR_right.sum)
 finally show "S (x + y) (Suc n) = (∑i≤Suc n. S x i * S y (Suc n - i))"
 by (simp del: sum.cl_ivl_Suc)
qed

lemma exp_add_commuting: "x * y = y * x ==> exp (x + y) = exp x * exp y"
 by (simp only: exp_def Cauchy_product summable_norm_exp exp_series_add_commuting)

lemma exp_times_arg_commute: "exp A * A = A * exp A"
 by (simp add: exp_def suminf_mult[symmetric] summable_exp_generic power_commutes suminf_mult2)

lemma exp_add: "exp (x + y) = exp x * exp y"
 for x y :: "'a::{real_normed_field,banach}"
 by (rule exp_add_commuting) (simp add: ac_simps)

lemma exp_double: "exp(2 * z) = exp z ^ 2"
 by (simp add: exp_add_commuting mult_2 power2_eq_square)

lemmas mult_exp_exp = exp_add [symmetric]

lemma exp_of_real: "exp (of_real x) = of_real (exp x)"
 unfolding exp_def
 apply (subst suminf_of_real [OF summable_exp_generic])
 apply (simp add: scaleR_conv_of_real)
 done

lemmas of_real_exp = exp_of_real[symmetric]

corollary exp_in_Reals [simp]: "z ∈ ℝ ==> exp z ∈ ℝ"
 by (metis Reals_cases Reals_of_real exp_of_real)

lemma exp_not_eq_zero [simp]: "exp x ≠ 0"
proof
 have "exp x * exp (- x) = 1"
 by (simp add: exp_add_commuting[symmetric])
 also assume "exp x = 0"
 finally show False by simp
qed

lemma exp_minus_inverse: "exp x * exp (- x) = 1"
 by (simp add: exp_add_commuting[symmetric])

lemma exp_minus: "exp (- x) = inverse (exp x)"
 for x :: "'a::{real_normed_field,banach}"
 by (intro inverse_unique [symmetric] exp_minus_inverse)

lemma exp_diff: "exp (x - y) = exp x / exp y"
 for x :: "'a::{real_normed_field,banach}"
 using exp_add [of x "- y"] by (simp add: exp_minus divide_inverse)

lemma exp_of_nat_mult: "exp (of_nat n * x) = exp x ^ n"
 for x :: "'a::{real_normed_field,banach}"
 by (induct n) (auto simp: distrib_left exp_add mult.commute)

corollary exp_of_nat2_mult: "exp (x * of_nat n) = exp x ^ n"
 for x :: "'a::{real_normed_field,banach}"
 by (metis exp_of_nat_mult mult_of_nat_commute)

lemma exp_sum: "finite I ==> exp (sum f I) = prod (λx. exp (f x)) I"
 by (induct I rule: finite_induct) (auto simp: exp_add_commuting mult.commute)

lemma exp_divide_power_eq:
 fixes x :: "'a::{real_normed_field,banach}"
 assumes "n > 0"
 shows "exp (x / of_nat n) ^ n = exp x"
 using assms
proof (induction n arbitrary: x)
 case (Suc n)
 show ?case
 proof (cases "n = 0")
 case True
 then show ?thesis by simp
 next
 case False
 have [simp]: "1 + (of_nat n * of_nat n + of_nat n * 2) ≠ (0::'a)"
 using of_nat_eq_iff [of "1 + n * n + n * 2" "0"]
 by simp
 from False have [simp]: "x * of_nat n / (1 + of_nat n) / of_nat n = x / (1 + of_nat n)"
 by simp
 have [simp]: "x / (1 + of_nat n) + x * of_nat n / (1 + of_nat n) = x"
 using of_nat_neq_0
 by (auto simp add: field_split_simps)
 show ?thesis
 using Suc.IH [of "x * of_nat n / (1 + of_nat n)"] False
 by (simp add: exp_add [symmetric])
 qed
qed simp

lemma exp_power_int:
 fixes x :: "'a::{real_normed_field,banach}"
 shows "exp x powi n = exp (of_int n * x)"
proof (cases "n ≥ 0")
 case True
 have "exp x powi n = exp x ^ nat n"
 using True by (simp add: power_int_def)
 thus ?thesis
 using True by (subst (asm) exp_of_nat_mult [symmetric]) auto
next
 case False
 have "exp x powi n = inverse (exp x ^ nat (-n))"
 using False by (simp add: power_int_def field_simps)
 also have "exp x ^ nat (-n) = exp (of_nat (nat (-n)) * x)"
 using False by (subst exp_of_nat_mult) auto
 also have "inverse … = exp (-(of_nat (nat (-n)) * x))"
 by (subst exp_minus) (auto simp: field_simps)
 also have "-(of_nat (nat (-n)) * x) = of_int n * x"
 using False by simp
 finally show ?thesis .
qed

subsubsection ‹Properties of the Exponential Function on Reals›

text ‹Comparisons of 🍋‹exp x› with zero.›

text ‹Proof: because every exponential can be seen as a square.›
lemma exp_ge_zero [simp]: "0 ≤ exp x"
 for x :: real
proof -
 have "0 ≤ exp (x/2) * exp (x/2)"
 by simp
 then show ?thesis
 by (simp add: exp_add [symmetric])
qed

lemma exp_gt_zero [simp]: "0 < exp x"
 for x :: real
 by (simp add: order_less_le)

lemma not_exp_less_zero [simp]: "¬ exp x < 0"
 for x :: real
 by (simp add: not_less)

lemma not_exp_le_zero [simp]: "¬ exp x ≤ 0"
 for x :: real
 by (simp add: not_le)

lemma abs_exp_cancel [simp]: "∣exp x∣ = exp x"
 for x :: real
 by simp

text ‹Strict monotonicity of exponential.›

lemma exp_ge_add_one_self_aux:
 fixes x :: real
 assumes "0 ≤ x"
 shows "1 + x ≤ exp x"
 using order_le_imp_less_or_eq [OF assms]
proof
 assume "0 < x"
 have "1 + x ≤ (∑n<2. inverse (fact n) * x^n)"
 by (auto simp: numeral_2_eq_2)
 also have "… ≤ (∑n. inverse (fact n) * x^n)"
 using ‹0 🚫› by (auto simp add: zero_le_mult_iff intro: sum_le_suminf [OF summable_exp])
 finally show "1 + x ≤ exp x"
 by (simp add: exp_def)
qed auto

lemma exp_gt_one: "0 < x ==> 1 < exp x"
 for x :: real
proof -
 assume x: "0 < x"
 then have "1 < 1 + x" by simp
 also from x have "1 + x ≤ exp x"
 by (simp add: exp_ge_add_one_self_aux)
 finally show ?thesis .
qed

lemma exp_less_mono:
 fixes x y :: real
 assumes "x < y"
 shows "exp x < exp y"
proof -
 from ‹x 🚫› have "0 < y - x" by simp
 then have "1 < exp (y - x)" by (rule exp_gt_one)
 then have "1 < exp y / exp x" by (simp only: exp_diff)
 then show "exp x < exp y" by simp
qed

lemma exp_less_cancel: "exp x < exp y ==> x < y"
 for x y :: real
 unfolding linorder_not_le [symmetric]
 by (auto simp: order_le_less exp_less_mono)

lemma exp_less_cancel_iff [iff]: "exp x < exp y ⟷ x < y"
 for x y :: real
 by (auto intro: exp_less_mono exp_less_cancel)

lemma exp_le_cancel_iff [iff]: "exp x ≤ exp y ⟷ x ≤ y"
 for x y :: real
 by (auto simp: linorder_not_less [symmetric])

lemma exp_mono:
 fixes x y :: real
 assumes "x ≤ y"
 shows "exp x ≤ exp y"
 using assms exp_le_cancel_iff by fastforce

lemma exp_minus': "exp (-x) = 1 / (exp x)"
 for x :: "'a::{real_normed_field,banach}"
 by (simp add: exp_minus inverse_eq_divide)

lemma exp_inj_iff [iff]: "exp x = exp y ⟷ x = y"
 for x y :: real
 by (simp add: order_eq_iff)

text ‹Comparisons of 🍋‹exp x› with one.›

lemma one_less_exp_iff [simp]: "1 < exp x ⟷ 0 < x"
 for x :: real
 using exp_less_cancel_iff [where x = 0 and y = x] by simp

lemma exp_less_one_iff [simp]: "exp x < 1 ⟷ x < 0"
 for x :: real
 using exp_less_cancel_iff [where x = x and y = 0] by simp

lemma one_le_exp_iff [simp]: "1 ≤ exp x ⟷ 0 ≤ x"
 for x :: real
 using exp_le_cancel_iff [where x = 0 and y = x] by simp

lemma exp_le_one_iff [simp]: "exp x ≤ 1 ⟷ x ≤ 0"
 for x :: real
 using exp_le_cancel_iff [where x = x and y = 0] by simp

lemma exp_eq_one_iff [simp]: "exp x = 1 ⟷ x = 0"
 for x :: real
 using exp_inj_iff [where x = x and y = 0] by simp

lemma lemma_exp_total: "1 ≤ y ==> ∃x. 0 ≤ x ∧ x ≤ y - 1 ∧ exp x = y"
 for y :: real
proof (rule IVT)
 assume "1 ≤ y"
 then have "0 ≤ y - 1" by simp
 then have "1 + (y - 1) ≤ exp (y - 1)"
 by (rule exp_ge_add_one_self_aux)
 then show "y ≤ exp (y - 1)" by simp
qed (simp_all add: le_diff_eq)

lemma exp_total: "0 < y ==> ∃x. exp x = y"
 for y :: real
proof (rule linorder_le_cases [of 1 y])
 assume "1 ≤ y"
 then show "∃x. exp x = y"
 by (fast dest: lemma_exp_total)
next
 assume "0 < y" and "y ≤ 1"
 then have "1 ≤ inverse y"
 by (simp add: one_le_inverse_iff)
 then obtain x where "exp x = inverse y"
 by (fast dest: lemma_exp_total)
 then have "exp (- x) = y"
 by (simp add: exp_minus)
 then show "∃x. exp x = y" ..
qed

subsection ‹Natural Logarithm›

class ln = real_normed_algebra_1 + banach +
 fixes ln :: "'a ==> 'a"
 assumes ln_one [simp]: "ln 1 = 0"

definition powr :: "'a ==> 'a ==> 'a::ln" (infixr ‹powr› 80)
 🍋 ‹exponentation via ln and exp›
 where "x powr a ≡ if x = 0 then 0 else exp (a * ln x)"

lemma powr_0 [simp]: "0 powr z = 0"
 by (simp add: powr_def)

text ‹We totalise @{term ln} over all reals exactly as done in Mathlib›
instantiation real :: ln
begin

definition raw_ln_real :: "real ==> real"
 where "raw_ln_real x ≡ (THE u. exp u = x)"

definition ln_real :: "real ==> real"
 where "ln_real ≡ λx. if x=0 then 0 else raw_ln_real ∣x∣"

instance
 by intro_classes (simp add: ln_real_def raw_ln_real_def)

end

lemma powr_eq_0_iff [simp]: "w powr z = 0 ⟷ w = 0"
 by (simp add: powr_def)

lemma raw_ln_exp [simp]: "raw_ln_real (exp x) = x"
 by (simp add: raw_ln_real_def)

lemma exp_raw_ln [simp]: "0 < x ==> exp (raw_ln_real x) = x"
 by (auto dest: exp_total)

lemma raw_ln_unique: "exp y = x ==> raw_ln_real x = y"
 by auto

lemma abs_raw_ln: "x ≠ 0 ==> raw_ln_real∣x∣ = ln x"
 by (simp add: ln_real_def)

lemma ln_0 [simp]: "ln (0::real) = 0"
 by (simp add: ln_real_def)

lemma ln_minus: "ln (-x) = ln x"
 for x :: real
 by (simp add: ln_real_def)

lemma ln_exp [simp]: "ln (exp x) = x"
 for x :: real
 by (simp add: ln_real_def)

lemma exp_ln_abs:
 fixes x::real
 shows "x ≠ 0 ==> exp (ln x) = ∣x∣"
 by (simp add: ln_real_def)

lemma exp_ln [simp]: "0 < x ==> exp (ln x) = x"
 for x :: real
 using exp_ln_abs by fastforce

lemma exp_ln_iff [simp]: "exp (ln x) = x ⟷ 0 < x"
 for x :: real
 by (metis exp_gt_zero exp_ln)

lemma ln_unique: "exp y = x ==> ln x = y"
 for x :: real
 by auto

lemma ln_unique': "exp y = ∣x∣ ==> ln x = y"
 for x :: real
 by (metis abs_raw_ln abs_zero exp_not_eq_zero raw_ln_exp)

lemma raw_ln_mult: "x>0 ==> y>0 ==> raw_ln_real (x * y) = raw_ln_real x + raw_ln_real y"
 by (metis exp_add exp_ln raw_ln_exp)

lemma ln_mult: "ln (x * y) = (if x≠0 ∧ y≠0 then ln x + ln y else 0)"
 for x :: real
 by (simp add: ln_real_def abs_mult raw_ln_mult)

lemma ln_mult_pos: "x>0 ==> y>0 ==> ln (x * y) = ln x + ln y"
 for x :: real
 by (simp add: ln_mult)

lemma ln_prod: "finite I ==> (∧i. i ∈ I ==> f i ≠ 0) ==> ln (prod f I) = sum (λx. ln(f x)) I"
 for f :: "'a ==> real"
 by (induct I rule: finite_induct) (auto simp: ln_mult prod_pos)

lemma ln_inverse: "ln (inverse x) = - ln x"
 for x :: real
 by (smt (verit) inverse_nonzero_iff_nonzero ln_mult ln_one ln_real_def right_inverse)

lemma ln_div: "ln (x/y) = (if x≠0 ∧ y≠0 then ln x - ln y else 0)"
 for x :: real
 by (simp add: divide_inverse ln_inverse ln_mult)

lemma ln_divide_pos: "x>0 ==> y>0 ==> ln (x/y) = ln x - ln y"
 for x :: real
 by (simp add: divide_inverse ln_inverse ln_mult)

lemma ln_realpow: "ln (x^n) = real n * ln x"
proof (cases "x=0")
 case True
 then show ?thesis by (auto simp: power_0_left)
next
 case False
 then show ?thesis
 by (induction n) (auto simp: ln_mult distrib_right)
qed

lemma ln_less_cancel_iff [simp]: "0 < x ==> 0 < y ==> ln x < ln y ⟷ x < y"
 for x :: real
 by (subst exp_less_cancel_iff [symmetric]) simp

lemma ln_le_cancel_iff [simp]: "0 < x ==> 0 < y ==> ln x ≤ ln y ⟷ x ≤ y"
 for x :: real
 by (simp add: linorder_not_less [symmetric])

lemma ln_mono: "∧x::real. [x ≤ y; 0 < x] ==> ln x ≤ ln y"
 by simp

lemma ln_strict_mono: "∧x::real. [x < y; 0 < x] ==> ln x < ln y"
 by simp

lemma ln_inj_iff [simp]: "0 < x ==> 0 < y ==> ln x = ln y ⟷ x = y"
 for x :: real
 by (simp add: order_eq_iff)

lemma ln_add_one_self_le_self: "0 ≤ x ==> ln (1 + x) ≤ x"
 for x :: real
 by (rule exp_le_cancel_iff [THEN iffD1]) (simp add: exp_ge_add_one_self_aux)

lemma ln_less_self [simp]: "0 < x ==> ln x < x"
 for x :: real
 by (rule order_less_le_trans [where y = "ln (1 + x)"]) (simp_all add: ln_add_one_self_le_self)

lemma ln_ge_iff: "∧x::real. 0 < x ==> y ≤ ln x ⟷ exp y ≤ x"
 using exp_le_cancel_iff exp_total by force

lemma ln_ge_zero [simp]: "1 ≤ x ==> 0 ≤ ln x"
 for x :: real
 using ln_le_cancel_iff [of 1 x] by simp

lemma ln_ge_zero_imp_ge_one: "0 ≤ ln x ==> 0 < x ==> 1 ≤ x"
 for x :: real
 using ln_le_cancel_iff [of 1 x] by simp

lemma ln_ge_zero_iff [simp]: "0 < x ==> 0 ≤ ln x ⟷ 1 ≤ x"
 for x :: real
 using ln_le_cancel_iff [of 1 x] by simp

lemma ln_less_zero_iff [simp]: "0 < x ==> ln x < 0 ⟷ x < 1"
 for x :: real
 using ln_less_cancel_iff [of x 1] by simp

lemma ln_le_zero_iff [simp]: "0 < x ==> ln x ≤ 0 ⟷ x ≤ 1"
 for x :: real
 by (metis less_numeral_extra(1) ln_le_cancel_iff ln_one)

lemma ln_gt_zero: "1 < x ==> 0 < ln x"
 for x :: real
 using ln_less_cancel_iff [of 1 x] by simp

lemma ln_gt_zero_imp_gt_one: "0 < ln x ==> 0 < x ==> 1 < x"
 for x :: real
 using ln_less_cancel_iff [of 1 x] by simp

lemma ln_gt_zero_iff [simp]: "0 < x ==> 0 < ln x ⟷ 1 < x"
 for x :: real
 using ln_less_cancel_iff [of 1 x] by simp

lemma ln_eq_zero_iff [simp]: "0 < x ==> ln x = 0 ⟷ x = 1"
 for x :: real
 using ln_inj_iff [of x 1] by simp

lemma ln_less_zero: "0 < x ==> x < 1 ==> ln x < 0"
 for x :: real
 by simp

lemma powr_eq_one_iff [simp]:
 "a powr x = 1 ⟷ x = 0" if "a > 1" for a x :: real
 using that by (auto simp: powr_def split: if_splits)

text ‹A consequence of our "totalising" of ln›
lemma uminus_powr_eq: "(-a) powr x = a powr x" for x::real
 by (simp add: powr_def ln_minus)

lemma isCont_ln_pos:
 fixes x :: real
 assumes "x > 0"
 shows "isCont ln x"
 by (metis assms exp_ln isCont_exp isCont_inverse_function ln_exp)

lemma isCont_ln:
 fixes x :: real
 assumes "x ≠ 0"
 shows "isCont ln x"
proof (cases "0 < x")
 case False
 then have "isCont (ln o uminus) x"
 using isCont_minus [OF continuous_ident] assms continuous_at_compose isCont_ln_pos
 by force
 then show ?thesis
 by (simp add: comp_def ln_minus)
qed (simp add: isCont_ln_pos)

lemma tendsto_ln [tendsto_intros]: "(f ---> a) F ==> a ≠ 0 ==> ((λx. ln (f x)) ---> ln a) F"
 for a :: real
 by (rule isCont_tendsto_compose [OF isCont_ln])

lemma continuous_ln:
 "continuous F f ==> f (Lim F (λx. x)) ≠ 0 ==> continuous F (λx. ln (f x :: real))"
 unfolding continuous_def by (rule tendsto_ln)

lemma isCont_ln' [continuous_intros]:
 "continuous (at x) f ==> f x ≠ 0 ==> continuous (at x) (λx. ln (f x :: real))"
 unfolding continuous_at by (rule tendsto_ln)

lemma continuous_within_ln [continuous_intros]:
 "continuous (at x within s) f ==> f x ≠ 0 ==> continuous (at x within s) (λx. ln (f x :: real))"
 unfolding continuous_within by (rule tendsto_ln)

lemma continuous_on_ln [continuous_intros]:
 "continuous_on s f ==> (∀x∈s. f x ≠ 0) ==> continuous_on s (λx. ln (f x :: real))"
 unfolding continuous_on_def by (auto intro: tendsto_ln)

lemma DERIV_ln: "0 < x ==> DERIV ln x :> inverse x"
 for x :: real
 by (rule DERIV_inverse_function [where f=exp and a=0 and b="x+1"])
 (auto intro: DERIV_cong [OF DERIV_exp exp_ln] isCont_ln)

lemma DERIV_ln_divide: "0 < x ==> DERIV ln x :> 1/x"
 for x :: real
 by (rule DERIV_ln[THEN DERIV_cong]) (simp_all add: divide_inverse)

declare DERIV_ln_divide[THEN DERIV_chain2, derivative_intros]
 and DERIV_ln_divide[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]

lemmas has_derivative_ln[derivative_intros] = DERIV_ln[THEN DERIV_compose_FDERIV]

lemma ln_series:
 assumes "0 < x" and "x < 2"
 shows "ln x = (∑ n. (-1)^n * (1 / real (n + 1)) * (x - 1)^(Suc n))"
 (is "ln x = suminf (?f (x - 1))")
proof -
 let ?f' = "λx n. (-1)^n * (x - 1)^n"

 have "ln x - suminf (?f (x - 1)) = ln 1 - suminf (?f (1 - 1))"
 proof (rule DERIV_isconst3 [where x = x])
 fix x :: real
 assume "x ∈ {0 <..< 2}"
 then have "0 < x" and "x < 2" by auto
 have "norm (1 - x) < 1"
 using ‹0 🚫› and ‹x 🚫› by auto
 have "1/x = 1 / (1 - (1 - x))" by auto
 also have "… = (∑ n. (1 - x)^n)"
 using geometric_sums[OF ‹norm (1 - x) 🚫›] by (rule sums_unique)
 also have "… = suminf (?f' x)"
 unfolding power_mult_distrib[symmetric]
 by (rule arg_cong[where f=suminf], rule arg_cong[where f="(^)"], auto)
 finally have "DERIV ln x :> suminf (?f' x)"
 using DERIV_ln[OF ‹0 🚫›] unfolding divide_inverse by auto
 moreover
 have repos: "∧ h x :: real. h - 1 + x = h + x - 1" by auto
 have "DERIV (λx. suminf (?f x)) (x - 1) :>
 (∑n. (-1)^n * (1 / real (n + 1)) * real (Suc n) * (x - 1) ^ n)"
 proof (rule DERIV_power_series')
 show "x - 1 ∈ {- 1<..<1}" and "(0 :: real) < 1"
 using ‹0 🚫› ‹x 🚫› by auto
 next
 fix x :: real
 assume "x ∈ {- 1<..<1}"
 then show "summable (λn. (- 1) ^ n * (1 / real (n + 1)) * real (Suc n) * x^n)"
 by (simp add: abs_if flip: power_mult_distrib)
 qed
 then have "DERIV (λx. suminf (?f x)) (x - 1) :> suminf (?f' x)"
 unfolding One_nat_def by auto
 then have "DERIV (λx. suminf (?f (x - 1))) x :> suminf (?f' x)"
 unfolding DERIV_def repos .
 ultimately have "DERIV (λx. ln x - suminf (?f (x - 1))) x :> suminf (?f' x) - suminf (?f' x)"
 by (rule DERIV_diff)
 then show "DERIV (λx. ln x - suminf (?f (x - 1))) x :> 0" by auto
 qed (auto simp: assms)
 then show ?thesis by auto
qed

lemma exp_first_terms:
 fixes x :: "'a::{real_normed_algebra_1,banach}"
 shows "exp x = (∑n🪙R (x ^ n)) + (∑n. inverse(fact (n + k)) *🪙R (x ^ (n + k)))"
proof -
 have "exp x = suminf (λn. inverse(fact n) *🪙R (x^n))"
 by (simp add: exp_def)
 also from summable_exp_generic have "… = (∑ n. inverse(fact(n+k)) *🪙R (x ^ (n + k))) +
 (∑ n::nat🪙R (x^n))" (is "_ = _ + ?a")
 by (rule suminf_split_initial_segment)
 finally show ?thesis by simp
qed

lemma exp_first_term: "exp x = 1 + (∑n. inverse (fact (Suc n)) *🪙R (x ^ Suc n))"
 for x :: "'a::{real_normed_algebra_1,banach}"
 using exp_first_terms[of x 1] by simp

lemma exp_first_two_terms: "exp x = 1 + x + (∑n. inverse (fact (n + 2)) *🪙R (x ^ (n + 2)))"
 for x :: "'a::{real_normed_algebra_1,banach}"
 using exp_first_terms[of x 2] by (simp add: eval_nat_numeral)

lemma exp_bound:
 fixes x :: real
 assumes a: "0 ≤ x"
 and b: "x ≤ 1"
 shows "exp x ≤ 1 + x + x🪙2"
proof -
 have "suminf (λn. inverse(fact (n+2)) * (x ^ (n + 2))) ≤ x🪙2"
 proof -
 have "(λn. x🪙2 / 2 * (1/2) ^ n) sums (x🪙2 / 2 * (1 / (1 - 1/2)))"
 by (intro sums_mult geometric_sums) simp
 then have sumsx: "(λn. x🪙2 / 2 * (1/2) ^ n) sums x🪙2"
 by simp
 have "suminf (λn. inverse(fact (n+2)) * (x ^ (n + 2))) ≤ suminf (λn. (x🪙2/2) * ((1/2)^n))"
 proof (intro suminf_le allI)
 show "inverse (fact (n + 2)) * x ^ (n + 2) ≤ (x🪙2/2) * ((1/2)^n)" for n :: nat
 proof -
 have "(2::nat) * 2 ^ n ≤ fact (n + 2)"
 by (induct n) simp_all
 then have "real ((2::nat) * 2 ^ n) ≤ real_of_nat (fact (n + 2))"
 by (simp only: of_nat_le_iff)
 then have "((2::real) * 2 ^ n) ≤ fact (n + 2)"
 unfolding of_nat_fact by simp
 then have "inverse (fact (n + 2)) ≤ inverse ((2::real) * 2 ^ n)"
 by (rule le_imp_inverse_le) simp
 then have "inverse (fact (n + 2)) ≤ 1/(2::real) * (1/2)^n"
 by (simp add: power_inverse [symmetric])
 then have "inverse (fact (n + 2)) * (x^n * x🪙2) ≤ 1/2 * (1/2)^n * (1 * x🪙2)"
 by (rule mult_mono) (rule mult_mono, simp_all add: power_le_one a b)
 then show ?thesis
 unfolding power_add by (simp add: ac_simps del: fact_Suc)
 qed
 show "summable (λn. inverse (fact (n + 2)) * x ^ (n + 2))"
 by (rule summable_exp [THEN summable_ignore_initial_segment])
 show "summable (λn. x🪙2 / 2 * (1/2) ^ n)"
 by (rule sums_summable [OF sumsx])
 qed
 also have "… = x🪙2"
 by (rule sums_unique [THEN sym]) (rule sumsx)
 finally show ?thesis .
 qed
 then show ?thesis
 unfolding exp_first_two_terms by auto
qed

corollary exp_half_le2: "exp(1/2) ≤ (2::real)"
 using exp_bound [of "1/2"]
 by (simp add: field_simps)

corollary exp_le: "exp 1 ≤ (3::real)"
 using exp_bound [of 1]
 by (simp add: field_simps)

lemma exp_bound_half: "norm z ≤ 1/2 ==> norm (exp z) ≤ 2"
 by (blast intro: order_trans intro!: exp_half_le2 norm_exp)

lemma exp_bound_lemma:
 assumes "norm z ≤ 1/2"
 shows "norm (exp z) ≤ 1 + 2 * norm z"
proof -
 have *: "(norm z)🪙2 ≤ norm z * 1"
 unfolding power2_eq_square
 by (rule mult_left_mono) (use assms in auto)
 have "norm (exp z) ≤ exp (norm z)"
 by (rule norm_exp)
 also have "… ≤ 1 + (norm z) + (norm z)🪙2"
 using assms exp_bound by auto
 also have "… ≤ 1 + 2 * norm z"
 using * by auto
 finally show ?thesis .
qed

lemma real_exp_bound_lemma: "0 ≤ x ==> x ≤ 1/2 ==> exp x ≤ 1 + 2 * x"
 for x :: real
 using exp_bound_lemma [of x] by simp

lemma ln_one_minus_pos_upper_bound:
 fixes x :: real
 assumes a: "0 ≤ x" and b: "x < 1"
 shows "ln (1 - x) ≤ - x"
proof -
 have "(1 - x) * (1 + x + x🪙2) = 1 - x^3"
 by (simp add: algebra_simps power2_eq_square power3_eq_cube)
 also have "… ≤ 1"
 by (auto simp: a)
 finally have "(1 - x) * (1 + x + x🪙2) ≤ 1" .
 moreover have c: "0 < 1 + x + x🪙2"
 by (simp add: add_pos_nonneg a)
 ultimately have "1 - x ≤ 1 / (1 + x + x🪙2)"
 by (elim mult_imp_le_div_pos)
 also have "… ≤ 1 / exp x"
 by (metis a abs_one b exp_bound exp_gt_zero frac_le less_eq_real_def real_sqrt_abs
 real_sqrt_pow2_iff real_sqrt_power)
 also have "… = exp (- x)"
 by (auto simp: exp_minus divide_inverse)
 finally have "1 - x ≤ exp (- x)" .
 also have "1 - x = exp (ln (1 - x))"
 by (metis b diff_0 exp_ln_iff less_iff_diff_less_0 minus_diff_eq)
 finally have "exp (ln (1 - x)) ≤ exp (- x)" .
 then show ?thesis
 by (auto simp only: exp_le_cancel_iff)
qed

lemma exp_ge_add_one_self [simp]: "1 + x ≤ exp x"
 for x :: real
proof (cases "0 ≤ x ∨ x ≤ -1")
 case True
 then show ?thesis
 by (meson exp_ge_add_one_self_aux exp_ge_zero order.trans real_add_le_0_iff)
next
 case False
 then have ln1: "ln (1 + x) ≤ x"
 using ln_one_minus_pos_upper_bound [of "-x"] by simp
 have "1 + x = exp (ln (1 + x))"
 using False by auto
 also have "… ≤ exp x"
 by (simp add: ln1)
 finally show ?thesis .
qed

lemma exp_gt_self: "x < exp (x::real)"
 using exp_gt_zero ln_less_self by fastforce

lemma ln_one_plus_pos_lower_bound:
 fixes x :: real
 assumes a: "0 ≤ x" and b: "x ≤ 1"
 shows "x - x🪙2 ≤ ln (1 + x)"
proof -
 have "exp (x - x🪙2) = exp x / exp (x🪙2)"
 by (rule exp_diff)
 also have "… ≤ (1 + x + x🪙2) / exp (x 🪙2)"
 by (metis a b divide_right_mono exp_bound exp_ge_zero)
 also have "… ≤ (1 + x + x🪙2) / (1 + x🪙2)"
 by (simp add: a divide_left_mono add_pos_nonneg)
 also from a have "… ≤ 1 + x"
 by (simp add: field_simps add_strict_increasing zero_le_mult_iff)
 finally have "exp (x - x🪙2) ≤ 1 + x" .
 also have "… = exp (ln (1 + x))"
 proof -
 from a have "0 < 1 + x" by auto
 then show ?thesis
 by (auto simp only: exp_ln_iff [THEN sym])
 qed
 finally have "exp (x - x🪙2) ≤ exp (ln (1 + x))" .
 then show ?thesis
 by (metis exp_le_cancel_iff)
qed

lemma ln_one_minus_pos_lower_bound:
 fixes x :: real
 assumes a: "0 ≤ x" and b: "x ≤ 1/2"
 shows "- x - 2 * x🪙2 ≤ ln (1 - x)"
proof -
 from b have c: "x < 1" by auto
 then have "ln (1 - x) = - ln (1 + x / (1 - x))"
 by (auto simp: ln_inverse [symmetric] field_simps intro: arg_cong [where f=ln])
 also have "- (x / (1 - x)) ≤ …"
 proof -
 have "ln (1 + x / (1 - x)) ≤ x / (1 - x)"
 using a c by (intro ln_add_one_self_le_self) auto
 then show ?thesis
 by auto
 qed
 also have "- (x / (1 - x)) = - x / (1 - x)"
 by auto
 finally have d: "- x / (1 - x) ≤ ln (1 - x)" .
 have "0 < 1 - x" using a b by simp
 then have e: "- x - 2 * x🪙2 ≤ - x / (1 - x)"
 using mult_right_le_one_le[of "x * x" "2 * x"] a b
 by (simp add: field_simps power2_eq_square)
 from e d show "- x - 2 * x🪙2 ≤ ln (1 - x)"
 by (rule order_trans)
qed

lemma ln_add_one_self_le_self2:
 fixes x :: real
 shows "-1 < x ==> ln (1 + x) ≤ x"
 by (metis diff_gt_0_iff_gt diff_minus_eq_add exp_ge_add_one_self exp_le_cancel_iff exp_ln minus_less_iff)

lemma abs_ln_one_plus_x_minus_x_bound_nonneg:
 fixes x :: real
 assumes x: "0 ≤ x" and x1: "x ≤ 1"
 shows "∣ln (1 + x) - x∣ ≤ x🪙2"
proof -
 from x have "ln (1 + x) ≤ x"
 by (rule ln_add_one_self_le_self)
 then have "ln (1 + x) - x ≤ 0"
 by simp
 then have "∣ln(1 + x) - x∣ = - (ln(1 + x) - x)"
 by (rule abs_of_nonpos)
 also have "… = x - ln (1 + x)"
 by simp
 also have "… ≤ x🪙2"
 proof -
 from x x1 have "x - x🪙2 ≤ ln (1 + x)"
 by (intro ln_one_plus_pos_lower_bound)
 then show ?thesis
 by simp
 qed
 finally show ?thesis .
qed

lemma abs_ln_one_plus_x_minus_x_bound_nonpos:
 fixes x :: real
 assumes a: "-(1/2) ≤ x" and b: "x ≤ 0"
 shows "∣ln (1 + x) - x∣ ≤ 2 * x🪙2"
proof -
 have *: "- (-x) - 2 * (-x)🪙2 ≤ ln (1 - (- x))"
 by (metis a b diff_zero ln_one_minus_pos_lower_bound minus_diff_eq neg_le_iff_le)
 have "∣ln (1 + x) - x∣ = x - ln (1 - (- x))"
 using a ln_add_one_self_le_self2 [of x] by (simp add: abs_if)
 also have "… ≤ 2 * x🪙2"
 using * by (simp add: algebra_simps)
 finally show ?thesis .
qed

lemma abs_ln_one_plus_x_minus_x_bound:
 fixes x :: real
 assumes "∣x∣ ≤ 1/2"
 shows "∣ln (1 + x) - x∣ ≤ 2 * x🪙2"
proof (cases "0 ≤ x")
 case True
 then show ?thesis
 using abs_ln_one_plus_x_minus_x_bound_nonneg assms by fastforce
next
 case False
 then show ?thesis
 using abs_ln_one_plus_x_minus_x_bound_nonpos assms by auto
qed

lemma ln_x_over_x_mono:
 fixes x :: real
 assumes x: "exp 1 ≤ x" "x ≤ y"
 shows "ln y / y ≤ ln x / x"
proof -
 note x
 moreover have "0 < exp (1::real)" by simp
 ultimately have a: "0 < x" and b: "0 < y"
 by (fast intro: less_le_trans order_trans)+
 have "x * ln y - x * ln x = x * (ln y - ln x)"
 by (simp add: algebra_simps)
 also have "… = x * ln (y / x)"
 using a b ln_div by force
 also have "y / x = (x + (y - x)) / x"
 by simp
 also have "… = 1 + (y - x) / x"
 using x a by (simp add: field_simps)
 also have "x * ln (1 + (y - x) / x) ≤ x * ((y - x) / x)"
 using x a
 by (intro mult_left_mono ln_add_one_self_le_self) simp_all
 also have "… = y - x"
 using a by simp
 also have "… = (y - x) * ln (exp 1)" by simp
 also have "… ≤ (y - x) * ln x"
 using a x exp_total of_nat_1 x(1) by (fastforce intro: mult_left_mono)
 also have "… = y * ln x - x * ln x"
 by (rule left_diff_distrib)
 finally have "x * ln y ≤ y * ln x"
 by arith
 then have "ln y ≤ (y * ln x) / x"
 using a by (simp add: field_simps)
 also have "… = y * (ln x / x)" by simp
 finally show ?thesis
 using b by (simp add: field_simps)
qed

lemma ln_le_minus_one: "0 < x ==> ln x ≤ x - 1"
 for x :: real
using exp_ge_add_one_self[of "ln x"] by simp

corollary ln_diff_le: "0 < x ==> 0 < y ==> ln x - ln y ≤ (x - y) / y"
 for x :: real
by (metis diff_divide_distrib divide_pos_pos divide_self ln_divide_pos ln_le_minus_one order_less_irrefl)

lemma ln_add1_ge:
 fixes t::real
 shows "t≥0 ==> ln (t+1) ≥ t / (1+t)"
using ln_diff_le [of 1 "t+1"] by (simp add: add.commute)

lemma ln_eq_minus_one:
 fixes x :: real
 assumes "0 < x" "ln x = x - 1"
 shows "x = 1"
proof -
 let ?l = "λy. ln y - y + 1"
 have D: "∧x::real. 0 < x ==> DERIV ?l x :> (1/x - 1)"
 by (auto intro!: derivative_eq_intros)
 show ?thesis
 proof (cases rule: linorder_cases)
 assume "x < 1"
 from dense[OF ‹x 🚫›] obtain a where "x < a" "a < 1" by blast
 from ‹x 🚫› have "?l x < ?l a"
 proof (rule DERIV_pos_imp_increasing)
 fix y
 assume "x ≤ y" "y ≤ a"
 with ‹0 🚫› ‹a 🚫› have "0 < 1 / y - 1" "0 < y"
 by (auto simp: field_simps)
 with D show "∃z. DERIV ?l y :> z ∧ 0 < z" by blast
 qed
 also have "… ≤ 0"
 using ln_le_minus_one ‹0 🚫› ‹x 🚫› by (auto simp: field_simps)
 finally show "x = 1" using assms by auto
 next
 assume "1 < x"
 from dense[OF this] obtain a where "1 < a" "a < x" by blast
 from ‹a 🚫› have "?l x < ?l a"
 proof (rule DERIV_neg_imp_decreasing)
 fix y
 assume "a ≤ y" "y ≤ x"
 with ‹1 🚫› have "1 / y - 1 < 0" "0 < y"
 by (auto simp: field_simps)
 with D show "∃z. DERIV ?l y :> z ∧ z < 0"
 by blast
 qed
 also have "… ≤ 0"
 using ln_le_minus_one ‹1 🚫› by (auto simp: field_simps)
 finally show "x = 1" using assms by auto
 next
 assume "x = 1"
 then show ?thesis by simp
 qed
qed

corollary ln_diff_less: "0 < x ==> 0 < y ==> x ≠ y ==> ln x - ln y < (x - y) / y" for x :: real
using ln_eq_minus_one[of "x/y"] ln_diff_le[of x y]
by (fastforce simp: diff_divide_distrib ln_divide_pos)

lemma ln_add1_gt:
 fixes t::real
 shows "t>0 ==> ln (t+1) > t / (1+t)"
using ln_diff_less [of 1 "t+1"] ln_one by(simp add: diff_divide_distrib add.commute)

lemma ln_add_one_self_less_self:
 fixes x :: real
 assumes "x > 0"
 shows "ln (1 + x) < x"
 by (smt (verit, best) assms ln_eq_minus_one ln_le_minus_one)

lemma ln_x_over_x_tendsto_0: "((λx::real. ln x / x) ---> 0) at_top"
proof (rule lhospital_at_top_at_top[where f' = inverse and g' = "λ_. 1"])
 from eventually_gt_at_top[of "0::real"]
 show "∀🪙F x in at_top. (ln has_real_derivative inverse x) (at x)"
 by eventually_elim (auto intro!: derivative_eq_intros simp: field_simps)
qed (use tendsto_inverse_0 in
 ‹auto simp: filterlim_ident dest!: tendsto_mono[OF at_top_le_at_infinity]›)

corollary exp_1_gt_powr:
 assumes "x > (0::real)"
 shows "exp 1 > (1 + 1/x) powr x"
proof -
 have "ln (1 + 1/x) < 1/x"
 using ln_add_one_self_less_self assms by simp
 thus "exp 1 > (1 + 1/x) powr x" using assms
 by (simp add: field_simps powr_def)
qed

lemma exp_ge_one_plus_x_over_n_power_n:
 assumes "x ≥ - real n" "n > 0"
 shows "(1 + x / of_nat n) ^ n ≤ exp x"
proof (cases "x = - of_nat n")
 case False
 from assms False have "(1 + x / of_nat n) ^ n = exp (of_nat n * ln (1 + x / of_nat n))"
 by (subst exp_of_nat_mult, subst exp_ln) (simp_all add: field_simps)
 also from assms False have "ln (1 + x / real n) ≤ x / real n"
 by (intro ln_add_one_self_le_self2) (simp_all add: field_simps)
 with assms have "exp (of_nat n * ln (1 + x / of_nat n)) ≤ exp x"
 by (simp add: field_simps)
 finally show ?thesis .
next
 case True
 then show ?thesis by (simp add: zero_power)
qed

lemma exp_ge_one_minus_x_over_n_power_n:
 assumes "x ≤ real n" "n > 0"
 shows "(1 - x / of_nat n) ^ n ≤ exp (-x)"
 using exp_ge_one_plus_x_over_n_power_n[of n "-x"] assms by simp

lemma exp_at_bot: "(exp ---> (0::real)) at_bot"
 unfolding tendsto_Zfun_iff
proof (rule ZfunI, simp add: eventually_at_bot_dense)
 fix r :: real
 assume "0 < r"
 have "exp x < r" if "x < ln r" for x
 by (metis ‹0 🚫› exp_less_mono exp_ln that)
 then show "∃k. ∀n by auto
qed

lemma exp_at_top: "LIM x at_top. exp x :: real :> at_top"
 by (rule filterlim_at_top_at_top[where Q="λx. True" and P="λx. 0 < x" and g=ln])
 (auto intro: eventually_gt_at_top)

lemma lim_exp_minus_1: "((λz::'a. (exp(z) - 1) / z) ---> 1) (at 0)"
 for x :: "'a::{real_normed_field,banach}"
proof -
 have "((λz::'a. exp(z) - 1) has_field_derivative 1) (at 0)"
 by (intro derivative_eq_intros | simp)+
 then show ?thesis
 by (simp add: Deriv.has_field_derivative_iff)
qed

lemma ln_at_0: "LIM x at_right 0. ln (x::real) :> at_bot"
 by (rule filterlim_at_bot_at_right[where Q="λx. 0 < x" and P="λx. True" and g=exp])
 (auto simp: eventually_at_filter)

lemma ln_at_top: "LIM x at_top. ln (x::real) :> at_top"
 by (rule filterlim_at_top_at_top[where Q="λx. 0 < x" and P="λx. True" and g=exp])
 (auto intro: eventually_gt_at_top)

lemma filtermap_ln_at_top: "filtermap (ln::real ==> real) at_top = at_top"
 by (intro filtermap_fun_inverse[of exp] exp_at_top ln_at_top) auto

lemma filtermap_exp_at_top: "filtermap (exp::real ==> real) at_top = at_top"
 by (intro filtermap_fun_inverse[of ln] exp_at_top ln_at_top)
 (auto simp: eventually_at_top_dense)

lemma filtermap_ln_at_right: "filtermap ln (at_right (0::real)) = at_bot"
 by (auto intro!: filtermap_fun_inverse[where g="λx. exp x"] ln_at_0
 simp: filterlim_at exp_at_bot)

lemma tendsto_power_div_exp_0: "((λx. x ^ k / exp x) ---> (0::real)) at_top"
proof (induct k)
 case 0
 show "((λx. x ^ 0 / exp x) ---> (0::real)) at_top"
 by (simp add: inverse_eq_divide[symmetric])
 (metis filterlim_compose[OF tendsto_inverse_0] exp_at_top filterlim_mono
 at_top_le_at_infinity order_refl)
next
 case (Suc k)
 show ?case
 proof (rule lhospital_at_top_at_top)
 show "eventually (λx. DERIV (λx. x ^ Suc k) x :> (real (Suc k) * x^k)) at_top"
 by eventually_elim (intro derivative_eq_intros, auto)
 show "eventually (λx. DERIV exp x :> exp x) at_top"
 by eventually_elim auto
 show "eventually (λx. exp x ≠ 0) at_top"
 by auto
 from tendsto_mult[OF tendsto_const Suc, of "real (Suc k)"]
 show "((λx. real (Suc k) * x ^ k / exp x) ---> 0) at_top"
 by simp
 qed (rule exp_at_top)
qed

subsubsection‹ A couple of simple bounds›

lemma exp_plus_inverse_exp:
 fixes x::real
 shows "2 ≤ exp x + inverse (exp x)"
proof -
 have "2 ≤ exp x + exp (-x)"
 using exp_ge_add_one_self [of x] exp_ge_add_one_self [of "-x"]
 by linarith
 then show ?thesis
 by (simp add: exp_minus)
qed

lemma real_le_x_sinh:
 fixes x::real
 assumes "0 ≤ x"
 shows "x ≤ (exp x - inverse(exp x)) / 2"
proof -
 have *: "exp a - inverse(exp a) - 2*a ≤ exp b - inverse(exp b) - 2*b" if "a ≤ b" for a b::real
 using exp_plus_inverse_exp
 by (fastforce intro: derivative_eq_intros DERIV_nonneg_imp_nondecreasing [OF that])
 show ?thesis
 using*[OF assms] by simp
qed

lemma real_le_abs_sinh:
 fixes x::real
 shows "abs x ≤ abs((exp x - inverse(exp x)) / 2)"
proof (cases "0 ≤ x")
 case True
 show ?thesis
 using real_le_x_sinh [OF True] True by (simp add: abs_if)
next
 case False
 have "-x ≤ (exp(-x) - inverse(exp(-x))) / 2"
 by (meson False linear neg_le_0_iff_le real_le_x_sinh)
 also have "… ≤ ∣(exp x - inverse (exp x)) / 2∣"
 by (metis (no_types, opaque_lifting) abs_divide abs_le_iff abs_minus_cancel
 add.inverse_inverse exp_minus minus_diff_eq order_refl)
 finally show ?thesis
 using False by linarith
qed

subsection‹The general logarithm›

definition log :: "real ==> real ==> real"
 🍋 ‹logarithm of 🍋‹x› to base 🍋‹a›\<close>
 where "log a x = ln x / ln a"

lemma log_exp [simp]: "log b (exp x) = x / ln b"
 by (simp add: log_def)

lemma tendsto_log [tendsto_intros]:
 "(f ---> a) F ==> (g ---> b) F ==> 0 < a ==> a ≠ 1 ==> b≠0 ==>
 ((λx. log (f x) (g x)) ---> log a b) F"
 unfolding log_def by (intro tendsto_intros) auto

lemma continuous_log:
 assumes "continuous F f"
 and "continuous F g"
 and "f (Lim F (λx. x)) > 0"
 and "f (Lim F (λx. x)) ≠ 1"
 and "g (Lim F (λx. x)) ≠ 0"
 shows "continuous F (λx. log (f x) (g x))"
 using assms by (simp add: continuous_def tendsto_log)

lemma continuous_at_within_log[continuous_intros]:
 assumes "continuous (at a within s) f"
 and "continuous (at a within s) g"
 and "0 < f a"
 and "f a ≠ 1"
 and "g a ≠ 0"
 shows "continuous (at a within s) (λx. log (f x) (g x))"
 using assms unfolding continuous_within by (rule tendsto_log)

lemma continuous_on_log[continuous_intros]:
 assumes "continuous_on S f" "continuous_on S g"
 and "∀x∈S. 0 < f x" "∀x∈S. f x ≠ 1" "∀x∈S. g x ≠ 0"
 shows "continuous_on S (λx. log (f x) (g x))"
 using assms unfolding continuous_on_def by (fast intro: tendsto_log)

lemma exp_powr_real:
 fixes x::real shows "exp x powr y = exp (x*y)"
 by (simp add: powr_def)

lemma powr_one_eq_one [simp]: "1 powr a = 1"
 by (simp add: powr_def)

lemma powr_zero_eq_one [simp]: "x powr 0 = (if x = 0 then 0 else 1)"
 by (simp add: powr_def)

lemma powr_eq_one_iff_gen[simp]: "a powr x = 1 ⟷ x = 0" if "a > 0" "a ≠ 1" for a x :: real
 using that by (simp add: powr_def)

lemma powr_one_gt_zero_iff [simp]: "x powr 1 = x ⟷ 0 ≤ x"
 for x :: real
 by (auto simp: powr_def)
declare powr_one_gt_zero_iff [THEN iffD2, simp]

lemma powr_diff:
 fixes w:: "'a::{ln,real_normed_field}"
 shows "w powr (z1 - z2) = w powr z1 / w powr z2"
 by (simp add: powr_def algebra_simps exp_diff)

lemma powr_mult: "(x * y) powr a = (x powr a) * (y powr a)"
 for a x y :: real
 by (simp add: powr_def exp_add [symmetric] ln_mult distrib_left)

lemma prod_powr_distrib:
 fixes x :: "'a ==> real"
 shows "(prod x I) powr r = (∏i∈I. x i powr r)"
 by (induction I rule: infinite_finite_induct) (auto simp add: powr_mult prod_nonneg)

lemma powr_ge_zero [simp]: "0 ≤ x powr y"
 for x y :: real
 by (simp add: powr_def)

lemma powr_non_neg[simp]: "¬ a powr x < 0" for a x::real
 using powr_ge_zero[of a x] by arith

lemma inverse_powr: "∧y::real. inverse y powr a = inverse (y powr a)"
 by (simp add: exp_minus ln_inverse powr_def)

lemma powr_divide: "(x / y) powr a = (x powr a) / (y powr a)"
 for a b x :: real
 by (simp add: divide_inverse powr_mult inverse_powr)

lemma powr_add: "x powr (a + b) = (x powr a) * (x powr b)"
 for a b x :: "'a::{ln,real_normed_field}"
 by (simp add: powr_def exp_add [symmetric] distrib_right)

lemma powr_mult_base: "0 ≤ x ==>x * x powr y = x powr (1 + y)"
 for x :: real
 by (auto simp: powr_add)

lemma powr_mult_base': "abs x * x powr y = x powr (1 + y)"
 for x :: real
 by (smt (verit) powr_mult_base uminus_powr_eq)

lemma powr_powr: "(x powr a) powr b = x powr (a * b)"
 for a b x :: real
 by (simp add: powr_def)

lemma powr_power:
 fixes z:: "'a::{real_normed_field,ln}"
 shows "z ≠ 0 ==> (z powr u) ^ n = z powr (of_nat n * u)"
 by (induction n) (auto simp: algebra_simps powr_add)

lemma powr_powr_swap: "(x powr a) powr b = (x powr b) powr a"
 for a b x :: real
 by (simp add: powr_powr mult.commute)

lemma powr_minus: "x powr (- a) = inverse (x powr a)"
 for a x :: "'a::{ln,real_normed_field}"
 by (simp add: powr_def exp_minus [symmetric])

lemma powr_minus_divide: "x powr (- a) = 1/(x powr a)"
 for a x :: "'a::{ln,real_normed_field}"
 by (simp add: divide_inverse powr_minus)

lemma powr_sum:
 assumes "x ≠ 0"
 shows "x powr sum f A = (∏y∈A. x powr f y)"
proof (cases "finite A")
 case True
 with assms show ?thesis
 by (simp add: powr_def exp_sum sum_distrib_right)
next
 case False
 with assms show ?thesis by auto
qed

lemma divide_powr_uminus: "a / b powr c = a * b powr (- c)"
 for a b c :: real
 by (simp add: powr_minus_divide)

lemma powr_less_mono: "a 1 < x ==> x powr a < x powr b"
 for a b x :: real
 by (simp add: powr_def)

lemma powr_less_cancel: "x powr a < x powr b ==> 1 < x ==> a < b"
 for a b x :: real
 by (simp add: powr_def)

lemma powr_less_cancel_iff [simp]: "1 < x ==> x powr a < x powr b ⟷ a < b"
 for a b x :: real
 by (blast intro: powr_less_cancel powr_less_mono)

lemma powr_le_cancel_iff [simp]: "1 < x ==> x powr a ≤ x powr b ⟷ a ≤ b"
 for a b x :: real
 by (simp add: linorder_not_less [symmetric])

lemma powr_realpow: "0 < x ==> x powr (real n) = x^n"
 by (induction n) (simp_all add: ac_simps powr_add)

lemma powr_realpow': "(z :: real) ≥ 0 ==> n ≠ 0 ==> z powr of_nat n = z ^ n"
 by (cases "z = 0") (auto simp: powr_realpow)

lemma powr_real_of_int':
 assumes "x ≥ 0" "x ≠ 0 ∨ n > 0"
 shows "x powr real_of_int n = power_int x n"
 by (metis assms exp_ln_iff exp_power_int nless_le power_int_eq_0_iff powr_def)

lemma exp_minus_ge:
 fixes x::real shows "1 - x ≤ exp (-x)"
 by (smt (verit) exp_ge_add_one_self)

lemma exp_minus_greater:
 fixes x::real shows "1 - x < exp (-x) ⟷ x ≠ 0"
 by (smt (verit) exp_minus_ge exp_eq_one_iff exp_gt_zero ln_eq_minus_one ln_exp)

lemma log_ln: "ln x = log (exp 1) x"
 by (simp add: log_def)

lemma DERIV_log:
 assumes "x > 0"
 shows "DERIV (λy. log b y) x :> 1 / (ln b * x)"
proof -
 define lb where "lb = 1 / ln b"
 moreover have "DERIV (λy. lb * ln y) x :> lb / x"
 using ‹x > 0› by (auto intro!: derivative_eq_intros)
 ultimately show ?thesis
 by (simp add: log_def)
qed

lemmas DERIV_log[THEN DERIV_chain2, derivative_intros]
 and DERIV_log[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]

lemma powr_log_cancel [simp]: "0 < a ==> a ≠ 1 ==> 0 < x ==> a powr (log a x) = x"
 by (simp add: powr_def log_def)

lemma log_powr_cancel [simp]: "0 < a ==> a ≠ 1 ==> log a (a powr x) = x"
 by (simp add: log_def powr_def)

lemma powr_eq_iff: "[y>0; a>1] ==> a powr x = y ⟷ log a y = x"
 by auto

lemma log_mult:
 "log a (x * y) = (if x≠0 ∧ y≠0 then log a x + log a y else 0)"
 by (simp add: log_def ln_mult divide_inverse distrib_right)

lemma log_mult_pos:
 "x>0 ==> y>0 ==> log a (x * y) = log a x + log a y"
 by (simp add: log_def ln_mult divide_inverse distrib_right)

lemma log_eq_div_ln_mult_log:
 "0 b ≠ 1 ==> 0 < x ==> log a x = (ln b/ln a) * log b x"
 by (simp add: log_def divide_inverse)

text‹Base 10 logarithms›
lemma log_base_10_eq1: "0 < x ==> log 10 x = (ln (exp 1) / ln 10) * ln x"
 by (simp add: log_def)

lemma log_base_10_eq2: "0 < x ==> log 10 x = (log 10 (exp 1)) * ln x"
 by (simp add: log_def)

lemma log_one [simp]: "log a 1 = 0"
 by (simp add: log_def)

lemma log_eq_one [simp]: "0 < a ==> a ≠ 1 ==> log a a = 1"
 by (simp add: log_def)

lemma log_inverse: "log a (inverse x) = - log a x"
 by (simp add: ln_inverse log_def)

lemma log_recip: "log a (1/x) = - log a x"
 by (simp add: divide_inverse log_inverse)

lemma log_divide:
 "log a (x / y) = (if x≠0 ∧ y≠0 then log a x - log a y else 0)"
 by (simp add: diff_divide_distrib ln_div log_def)

lemma log_divide_pos:
 "x>0 ==> y>0 ==> log a (x / y) = log a x - log a y"
 using log_divide by auto

lemma powr_gt_zero [simp]: "0 < x powr a ⟷ x ≠ 0"
 for a x :: real
 by (simp add: powr_def)

lemma powr_nonneg_iff[simp]: "a powr x ≤ 0 ⟷ a = 0"
 for a x::real
 by (meson not_less powr_gt_zero)

lemma log_add_eq_powr: "0 b ≠ 1 ==> x≠0 ==> log b x + y = log b (x * b powr y)"
 and add_log_eq_powr: "0 b ≠ 1 ==> x≠0 ==> y + log b x = log b (b powr y * x)"
 and log_minus_eq_powr: "0 b ≠ 1 ==> x≠0 ==> log b x - y = log b (x * b powr -y)"
 by (simp_all add: log_mult log_divide)

lemma minus_log_eq_powr: "0 b ≠ 1 ==> x≠0 ==> y - log b x = log b (b powr y / x)"
 by (simp add: diff_divide_eq_iff ln_div log_def powr_def)

lemma log_less_cancel_iff [simp]: "1 < a ==> 0 < x ==> 0 < y ==> log a x < log a y ⟷ x < y"
 using powr_less_cancel_iff [of a] powr_log_cancel [of a x] powr_log_cancel [of a y]
 by (metis less_eq_real_def less_trans not_le zero_less_one)

lemma log_inj:
 assumes "1 < b"
 shows "inj_on (log b) {0 <..}"
proof (rule inj_onI, simp)
 fix x y
 assume pos: "0 < x" "0 < y" and *: "log b x = log b y"
 show "x = y"
 proof (cases rule: linorder_cases)
 assume "x = y"
 then show ?thesis by simp
 next
 assume "x < y"
 then have "log b x < log b y"
 using log_less_cancel_iff[OF ‹1 🚫›] pos by simp
 then show ?thesis using * by simp
 next
 assume "y < x"
 then have "log b y < log b x"
 using log_less_cancel_iff[OF ‹1 🚫›] pos by simp
 then show ?thesis using * by simp
 qed
qed

lemma log_le_cancel_iff [simp]: "1 < a ==> 0 < x ==> 0 < y ==> log a x ≤ log a y ⟷ x ≤ y"
 by (simp flip: linorder_not_less)

lemma log_mono: "1 < a ==> 0 < x ==> x ≤ y ==> log a x ≤ log a y"
 by simp

lemma log_less: "1 < a ==> 0 < x ==> x < y ==> log a x < log a y"
 by simp

lemma zero_less_log_cancel_iff[simp]: "1 < a ==> 0 < x ==> 0 < log a x ⟷ 1 < x"
 using log_less_cancel_iff[of a 1 x] by simp

lemma zero_le_log_cancel_iff[simp]: "1 < a ==> 0 < x ==> 0 ≤ log a x ⟷ 1 ≤ x"
 using log_le_cancel_iff[of a 1 x] by simp

lemma log_less_zero_cancel_iff[simp]: "1 < a ==> 0 < x ==> log a x < 0 ⟷ x < 1"
 using log_less_cancel_iff[of a x 1] by simp

lemma log_le_zero_cancel_iff[simp]: "1 < a ==> 0 < x ==> log a x ≤ 0 ⟷ x ≤ 1"
 using log_le_cancel_iff[of a x 1] by simp

lemma one_less_log_cancel_iff[simp]: "1 < a ==> 0 < x ==> 1 < log a x ⟷ a < x"
 using log_less_cancel_iff[of a a x] by simp

lemma one_le_log_cancel_iff[simp]: "1 < a ==> 0 < x ==> 1 ≤ log a x ⟷ a ≤ x"
 using log_le_cancel_iff[of a a x] by simp

lemma log_less_one_cancel_iff[simp]: "1 < a ==> 0 < x ==> log a x < 1 ⟷ x < a"
 using log_less_cancel_iff[of a x a] by simp

lemma log_le_one_cancel_iff[simp]: "1 < a ==> 0 < x ==> log a x ≤ 1 ⟷ x ≤ a"
 using log_le_cancel_iff[of a x a] by simp

lemma le_log_iff:
 fixes b x y :: real
 assumes "1 < b" "x > 0"
 shows "y ≤ log b x ⟷ b powr y ≤ x"
 using assms
 by (metis less_irrefl less_trans powr_le_cancel_iff powr_log_cancel zero_less_one)

lemma less_log_iff:
 assumes "1 < b" "x > 0"
 shows "y < log b x ⟷ b powr y < x"
 by (metis assms dual_order.strict_trans less_irrefl powr_less_cancel_iff
 powr_log_cancel zero_less_one)

lemma
 assumes "1 < b" "x > 0"
 shows log_less_iff: "log b x < y ⟷ x < b powr y"
 and log_le_iff: "log b x ≤ y ⟷ x ≤ b powr y"
 using le_log_iff[OF assms, of y] less_log_iff[OF assms, of y]
 by auto

lemmas powr_le_iff = le_log_iff[symmetric]
 and powr_less_iff = less_log_iff[symmetric]
 and less_powr_iff = log_less_iff[symmetric]
 and le_powr_iff = log_le_iff[symmetric]

lemma le_log_of_power:
 assumes "b ^ n ≤ m" "1 < b"
 shows "n ≤ log b m"
proof -
 from assms have "0 < m" by (metis less_trans zero_less_power less_le_trans zero_less_one)
 thus ?thesis using assms by (simp add: le_log_iff powr_realpow)
qed

lemma le_log2_of_power: "2 ^ n ≤ m ==> n ≤ log 2 m" for m n :: nat
using le_log_of_power[of 2] by simp

lemma log_of_power_le: "[ m ≤ b ^ n; b > 1; m > 0 ] ==> log b (real m) ≤ n"
by (simp add: log_le_iff powr_realpow)

lemma log2_of_power_le: "[ m ≤ 2 ^ n; m > 0 ] ==> log 2 m ≤ n" for m n :: nat
using log_of_power_le[of _ 2] by simp

lemma log_of_power_less: "[ m 1; m > 0 ] ==> log b (real m) < n"
by (simp add: log_less_iff powr_realpow)

lemma log2_of_power_less: "[ m < 2 ^ n; m > 0 ] ==> log 2 m < n" for m n :: nat
using log_of_power_less[of _ 2] by simp

lemma less_log_of_power:
 assumes "b ^ n < m" "1 < b"
 shows "n < log b m"
proof -
 have "0 < m" by (metis assms less_trans zero_less_power zero_less_one)
 thus ?thesis using assms by (simp add: less_log_iff powr_realpow)
qed

lemma less_log2_of_power: "2 ^ n < m ==> n < log 2 m" for m n :: nat
 using less_log_of_power[of 2] by simp

lemma gr_one_powr[simp]:
 fixes x y :: real shows "[ x > 1; y > 0 ] ==> 1 < x powr y"
 by(simp add: less_powr_iff)

lemma log_pow_cancel [simp]:
 "a > 0 ==> a ≠ 1 ==> log a (a ^ b) = b"
 by (simp add: ln_realpow log_def)

lemma floor_log_eq_powr_iff: "x > 0 ==> b > 1 ==> ⌊log b x⌋ = k ⟷ b powr k ≤ x ∧ x 0 ] ==> floor (log b (real k)) = n ⟷ b^n ≤ k ∧ k < b^(n+1)"
by (auto simp: floor_log_eq_powr_iff powr_add powr_realpow
 of_nat_power[symmetric] of_nat_mult[symmetric] ac_simps
 simp del: of_nat_power of_nat_mult)

lemma floor_log_nat_eq_if:
 fixes b n k :: nat
 assumes "b^n ≤ k" "k < b^(n+1)" "b ≥ 2"
 shows "floor (log b (real k)) = n"
proof -
 have "k ≥ 1"
 using assms linorder_le_less_linear by force
 with assms show ?thesis
 by(simp add: floor_log_nat_eq_powr_iff)
qed

lemma ceiling_log_eq_powr_iff:
 "[ x > 0; b > 1 ] ==> ⌈log b x⌉ = int k + 1 ⟷ b powr k < x ∧ x ≤ b powr (k + 1)"
 by (auto simp: ceiling_eq_iff powr_less_iff le_powr_iff)

lemma ceiling_log_nat_eq_powr_iff:
 fixes b n k :: nat
 shows "[ b ≥ 2; k > 0 ] ==> ⌈log b (real k)⌉ = int n + 1 ⟷ (b^n < k ∧ k ≤ b^(n+1))"
 using ceiling_log_eq_powr_iff
 by (auto simp: powr_add powr_realpow of_nat_power[symmetric] of_nat_mult[symmetric] ac_simps
 simp del: of_nat_power of_nat_mult)

lemma ceiling_log_nat_eq_if:
 fixes b n k :: nat
 assumes "b^n < k" "k ≤ b^(n+1)" "b ≥ 2"
 shows "⌈log (real b) (real k)⌉ = int n + 1"
 using assms ceiling_log_nat_eq_powr_iff by force

lemma floor_log2_div2:
 fixes n :: nat
 assumes "n ≥ 2"
 shows "⌊log 2 (real n)⌋ = ⌊log 2 (n div 2)⌋ + 1"
proof cases
 assume "n=2" thus ?thesis by simp
next
 let ?m = "n div 2"
 assume "n≠2"
 hence "1 ≤ ?m" using assms by arith
 then obtain i where i: "2 ^ i ≤ ?m" "?m < 2 ^ (i + 1)"
 using ex_power_ivl1[of 2 ?m] by auto
 have "2^(i+1) ≤ 2*?m" using i(1) by simp
 also have "2*?m ≤ n" by arith
 finally have *: "2^(i+1) ≤ …" .
 have "n < 2^(i+1+1)" using i(2) by simp
 from floor_log_nat_eq_if[OF * this] floor_log_nat_eq_if[OF i]
 show ?thesis by simp
qed

lemma ceiling_log2_div2:
 assumes "n ≥ 2"
 shows "⌈log 2 (real n)⌉ = ⌈log 2 ((n-1) div 2 + 1)⌉ + 1"
proof cases
 assume "n=2" thus ?thesis by simp
next
 let ?m = "(n-1) div 2 + 1"
 assume "n≠2"
 hence "2 ≤ ?m" using assms by arith
 then obtain i where i: "2 ^ i < ?m" "?m ≤ 2 ^ (i + 1)"
 using ex_power_ivl2[of 2 ?m] by auto
 have "n ≤ 2*?m" by arith
 also have "2*?m ≤ 2 ^ ((i+1)+1)" using i(2) by simp
 finally have *: "n ≤ …" .
 have "2^(i+1) < n" using i(1) by (auto simp: less_Suc_eq_0_disj)
 from ceiling_log_nat_eq_if[OF this *] ceiling_log_nat_eq_if[OF i]
 show ?thesis by simp
qed

lemma powr_real_of_int:
 "x > 0 ==> x powr real_of_int n = (if n ≥ 0 then x ^ nat n else inverse (x ^ nat (- n)))"
 using powr_realpow[of x "nat n"] powr_realpow[of x "nat (-n)"]
 by (auto simp: field_simps powr_minus)

lemma powr_numeral [simp]: "0 ≤ x ==> x powr (numeral n :: real) = x ^ (numeral n)"
 by (metis less_le power_zero_numeral powr_0 of_nat_numeral powr_realpow)

lemma powr_int:
 assumes "x > 0"
 shows "x powr i = (if i ≥ 0 then x ^ nat i else 1/x ^ nat (-i))"
 by (simp add: assms inverse_eq_divide powr_real_of_int)

lemma power_of_nat_log_ge: "b > 1 ==> b ^ nat ⌈log b x⌉ ≥ x"
 by (smt (verit) less_log_of_power of_nat_ceiling)

lemma power_of_nat_log_le:
 assumes "b > 1" "x≥1"
 shows "b ^ nat ⌊log b x⌋ ≤ x"
proof -
 have "⌊log b x⌋ ≥ 0"
 using assms by auto
 then show ?thesis
 by (smt (verit) assms le_log_iff of_int_floor_le powr_int)
qed

definition powr_real :: "real ==> real ==> real"
 where [code_abbrev, simp]: "powr_real = Transcendental.powr"

lemma compute_powr_real [code]:
 "powr_real b i =
 (if b ≤ 0 then Code.abort (STR ''powr_real with nonpositive base'') (λ_. powr_real b i)
 else if ⌊i⌋ = i then (if 0 ≤ i then b ^ nat ⌊i⌋ else 1 / b ^ nat ⌊- i⌋)
 else Code.abort (STR ''powr_real with non-integer exponent'') (λ_. powr_real b i))"
 for b i :: real
 by (auto simp: powr_int)

lemma powr_one: "0 ≤ x ==> x powr 1 = x"
 for x :: real
 using powr_realpow [of x 1] by simp

lemma powr_one' [simp]: "x powr 1 = ∣x∣"
 for x :: real
 by (simp add: ln_real_def powr_def)

lemma powr_neg_one: "0 < x ==> x powr -1 = 1/x"
 for x :: real
 using powr_int [of x "- 1"] by simp

lemma powr_neg_one' [simp]: "x powr -1 = 1/∣x∣"
 for x :: real
 by (simp add: powr_minus_divide)

lemma powr_neg_numeral: "0 < x ==> x powr - numeral n = 1/x ^ numeral n"
 for x :: real
 using powr_int [of x "- numeral n"] by simp

lemma root_powr_inverse: "0 < n ==> 0 ≤ x ==> root n x = x powr (1/n)"
 by (simp add: exp_divide_power_eq powr_def real_root_pos_unique)

lemma powr_inverse_root: "0 < n ==> x powr (1/n) = ∣root n x∣"
 by (metis abs_ge_zero mult_1 powr_one' powr_powr real_root_abs root_powr_inverse)

lemma ln_powr [simp]: "ln (x powr y) = y * ln x"
 for x :: real
 by (simp add: powr_def)

lemma ln_root: "n > 0 ==> ln (root n b) = ln b / n"
 by (metis ln_powr mult_1 powr_inverse_root powr_one' times_divide_eq_left)

lemma ln_sqrt: "0 ≤ x ==> ln (sqrt x) = ln x / 2"
 by (metis (full_types) divide_inverse inverse_eq_divide ln_powr mult.commute of_nat_numeral pos2 root_powr_inverse sqrt_def)

lemma log_root: "n > 0 ==> a ≥ 0 ==> log b (root n a) = log b a / n"
 by (simp add: log_def ln_root)

lemma log_powr: "log b (x powr y) = y * log b x"
 by (simp add: log_def)

(* [simp] is not worth it, interferes with some proofs *)
lemma log_nat_power: "0 ≤ x ==> log b (x^n) = real n * log b x"
 by (simp add: ln_realpow log_def)

lemma log_of_power_eq:
 assumes "m = b ^ n" "b > 1"
 shows "n = log b (real m)"
proof -
 have "n = log b (b ^ n)" using assms(2) by (simp add: log_nat_power)
 also have "… = log b m" using assms by simp
 finally show ?thesis .
qed

lemma log2_of_power_eq: "m = 2 ^ n ==> n = log 2 m" for m n :: nat
 using log_of_power_eq[of _ 2] by simp

lemma log_base_change: "0 < a ==> a ≠ 1 ==> log b x = log a x / log a b"
 by (simp add: log_def)

lemma log_base_pow: "0 < a ==> log (a ^ n) x = log a x / n"
 by (simp add: log_def ln_realpow)

lemma log_base_powr: "a ≠ 0 ==> log (a powr b) x = log a x / b"
 by (simp add: log_def ln_powr)

lemma log_base_root: "n > 0 ==> log (root n b) x = n * (log b x)"
 by (simp add: log_def ln_root)

lemma ln_bound: "0 < x ==> ln x ≤ x" for x :: real
 using ln_le_minus_one by force

lemma powr_less_one:
 fixes x::real
 assumes "1 < x" "y < 0"
 shows "x powr y < 1"
using assms less_log_iff by force

lemma powr_le_one_le: "∧x y::real. 0 < x ==> x ≤ 1 ==> 1 ≤ y ==> x powr y ≤ x"
 by (smt (verit) ln_gt_zero_imp_gt_one ln_le_cancel_iff ln_powr mult_le_cancel_right2)

lemma powr_mono:
 fixes x :: real
 assumes "a ≤ b" and "1 ≤ x" shows "x powr a ≤ x powr b"
 using assms less_eq_real_def by auto

lemma ge_one_powr_ge_zero: "1 ≤ x ==> 0 ≤ a ==> 1 ≤ x powr a"
 for x :: real
 using powr_mono by fastforce

lemma powr_less_mono2: "0 < a ==> 0 ≤ x ==> x < y ==> x powr a < y powr a"
 for x :: real
 by (simp add: powr_def)

lemma powr_less_mono2_neg: "a < 0 ==> 0 < x ==> x < y ==> y powr a < x powr a"
 for x :: real
 by (simp add: powr_def)

lemma powr_mono2: "x powr a ≤ y powr a" if "0 ≤ a" "0 ≤ x" "x ≤ y"
 for x :: real
 using less_eq_real_def powr_less_mono2 that by auto

lemma powr_less_cancel2: "0 < a ==> 0 < x ==> 0 < y ==> x powr a < y powr a ==> x < y"
 for a x y ::real
 by (metis less_le not_less_iff_gr_or_eq powr_less_mono2)

lemma powr01_less_one:
 fixes x::real
 assumes "0 < x" "x < 1"
 shows "x powr a < 1 ⟷ a>0"
proof
 show "x powr a < 1 ==> a>0"
 using assms not_less_iff_gr_or_eq powr_less_mono2_neg by fastforce
 show "a>0 ==> x powr a < 1"
 by (metis assms less_eq_real_def powr_less_mono2 powr_one_eq_one)
qed

lemma powr_le1: "0 ≤ a ==> ∣x∣ ≤ 1 ==> x powr a ≤ 1"
 for x :: real
 by (smt (verit, best) powr_mono2 powr_one_eq_one uminus_powr_eq)

lemma powr_mono2':
 fixes a x y :: real
 assumes "a ≤ 0" "x > 0" "x ≤ y"
 shows "x powr a ≥ y powr a"
proof -
 from assms have "x powr - a ≤ y powr - a"
 by (intro powr_mono2) simp_all
 with assms show ?thesis
 by (auto simp: powr_minus field_simps)
qed

lemma powr_mono': "a ≤ (b::real) ==> x ≥ 0 ==> x ≤ 1 ==> x powr b ≤ x powr a"
 using powr_mono[of "-b" "-a" "inverse x"] by (auto simp: powr_def ln_inverse ln_div field_split_simps)

lemma powr_mono_both:
 fixes x :: real
 assumes "0 ≤ a" "a ≤ b" "1 ≤ x" "x ≤ y"
 shows "x powr a ≤ y powr b"
 by (meson assms order.trans powr_mono powr_mono2 zero_le_one)

lemma powr_mono_both':
 fixes x :: real
 assumes "a ≥ b" "b≥0" "0 < x" "x ≤ y" "y ≤ 1"
 shows "x powr a ≤ y powr b"
 by (meson assms nless_le order.trans powr_mono' powr_mono2)

lemma powr_less_mono':
 assumes "(x::real) > 0" "x < 1" "a < b"
 shows "x powr b < x powr a"
 by (metis assms log_powr_cancel order.strict_iff_order powr_mono')

lemma powr_inj: "0 < a ==> a ≠ 1 ==> a powr x = a powr y ⟷ x = y"
 for x :: real
 by (metis log_powr_cancel)

lemma powr_half_sqrt: "0 ≤ x ==> x powr (1/2) = sqrt x"
 by (simp add: powr_def root_powr_inverse sqrt_def)

lemma powr_half_sqrt_powr: "0 ≤ x ==> x powr (a/2) = sqrt(x powr a)"
 by (metis divide_inverse mult.left_neutral powr_ge_zero powr_half_sqrt powr_powr)

lemma square_powr_half [simp]:
 fixes x::real shows "x🪙2 powr (1/2) = ∣x∣"
 by (simp add: powr_half_sqrt)

lemma ln_powr_bound: "1 ≤ x ==> 0 < a ==> ln x ≤ (x powr a) / a"
 for x :: real
 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)

lemma ln_powr_bound2:
 fixes x :: real
 assumes "1 < x" and "0 < a"
 shows "(ln x) powr a ≤ (a powr a) * x"
proof -
 from assms have "ln x ≤ (x powr (1 / a)) / (1 / a)"
 by (metis less_eq_real_def ln_powr_bound zero_less_divide_1_iff)
 also have "… = a * (x powr (1 / a))"
 by simp
 finally have "(ln x) powr a ≤ (a * (x powr (1 / a))) powr a"
 by (metis assms less_imp_le ln_gt_zero powr_mono2)
 also have "… = (a powr a) * ((x powr (1 / a)) powr a)"
 using assms powr_mult by auto
 also have "(x powr (1 / a)) powr a = x powr ((1 / a) * a)"
 by (rule powr_powr)
 also have "… = x" using assms
 by auto
 finally show ?thesis .
qed

lemma tendsto_powr:
 fixes a b :: real
 assumes f: "(f ---> a) F"
 and g: "(g ---> b) F"
 and a: "a ≠ 0"
 shows "((λx. f x powr g x) ---> a powr b) F"
 unfolding powr_def
proof (rule filterlim_If)
 show "((λx. 0) ---> (if a = 0 then 0 else exp (b * ln a))) (inf F (principal {x. f x = 0}))"
 using tendsto_imp_eventually_ne [OF f] a
 by (simp add: filterlim_iff eventually_inf_principal frequently_def)
 from f g a show "((λx. exp (g x * ln (f x))) ---> (if a = 0 then 0 else exp (b * ln a)))
 (inf F (principal {x. f x ≠ 0}))"
 by (auto intro!: tendsto_intros intro: tendsto_mono inf_le1)
qed

lemma tendsto_powr'[tendsto_intros]:
 fixes a :: real
 assumes f: "(f ---> a) F"
 and g: "(g ---> b) F"
 and a: "a ≠ 0 ∨ (b > 0 ∧ eventually (λx. f x ≥ 0) F)"
 shows "((λx. f x powr g x) ---> a powr b) F"
proof -
 from a consider "a ≠ 0" | "a = 0" "b > 0" "eventually (λx. f x ≥ 0) F"
 by auto
 then show ?thesis
 proof cases
 case 1
 with f g show ?thesis by (rule tendsto_powr)
 next
 case 2
 have "((λx. if f x = 0 then 0 else exp (g x * ln (f x))) ---> 0) F"
 proof (intro filterlim_If)
 have "filterlim f (principal {0<..}) (inf F (principal {z. f z ≠ 0}))"
 using ‹eventually (λx. f x ≥ 0) F›
 by (auto simp: filterlim_iff eventually_inf_principal
 eventually_principal elim: eventually_mono)
 moreover have "filterlim f (nhds a) (inf F (principal {z. f z ≠ 0}))"
 by (rule tendsto_mono[OF _ f]) simp_all
 ultimately have f: "filterlim f (at_right 0) (inf F (principal {x. f x ≠ 0}))"
 by (simp add: at_within_def filterlim_inf ‹a = 0›)
 have g: "(g ---> b) (inf F (principal {z. f z ≠ 0}))"
 by (rule tendsto_mono[OF _ g]) simp_all
 show "((λx. exp (g x * ln (f x))) ---> 0) (inf F (principal {x. f x ≠ 0}))"
 by (rule filterlim_compose[OF exp_at_bot] filterlim_tendsto_pos_mult_at_bot
 filterlim_compose[OF ln_at_0] f g ‹b > 0›)+
 qed simp_all
 with ‹a = 0› show ?thesis
 by (simp add: powr_def)
 qed
qed

lemma continuous_powr:
 assumes "continuous F f"
 and "continuous F g"
 and "f (Lim F (λx. x)) ≠ 0"
 shows "continuous F (λx. (f x) powr (g x :: real))"
 using assms unfolding continuous_def by (rule tendsto_powr)

lemma continuous_at_within_powr[continuous_intros]:
 fixes f g :: "_ ==> real"
 assumes "continuous (at a within s) f"
 and "continuous (at a within s) g"
 and "f a ≠ 0"
 shows "continuous (at a within s) (λx. (f x) powr (g x))"
 using assms unfolding continuous_within by (rule tendsto_powr)

lemma continuous_on_powr[continuous_intros]:
 fixes f g :: "_ ==> real"
 assumes "continuous_on s f" "continuous_on s g" and "∀x∈s. f x ≠ 0"
 shows "continuous_on s (λx. (f x) powr (g x))"
 using assms unfolding continuous_on_def by (fast intro: tendsto_powr)

lemma tendsto_powr2:
 fixes a :: real
 assumes f: "(f ---> a) F"
 and g: "(g ---> b) F"
 and "∀🪙F x in F. 0 ≤ f x"
 and b: "0 < b"
 shows "((λx. f x powr g x) ---> a powr b) F"
 using tendsto_powr'[of f a F g b] assms by auto

lemma has_derivative_powr[derivative_intros]:
 assumes g[derivative_intros]: "(g has_derivative g') (at x within X)"
 and f[derivative_intros]:"(f has_derivative f') (at x within X)"
 assumes pos: "0 < g x" and "x ∈ X"
 shows "((λx. g x powr f x::real) has_derivative (λh. (g x powr f x) * (f' h * ln (g x) + g' h * f x / g x))) (at x within X)"
proof -
 have "∀🪙F x in at x within X. g x > 0"
 by (rule order_tendstoD[OF _ pos])
 (rule has_derivative_continuous[OF g, unfolded continuous_within])
 then obtain d where "d > 0" and pos': "∧x'. x' ∈ X ==> dist x' x < d ==> 0 < g x'"
 using pos unfolding eventually_at by force
 have "((λx. exp (f x * ln (g x))) has_derivative
 (λh. (g x powr f x) * (f' h * ln (g x) + g' h * f x / g x))) (at x within X)"
 using pos
 by (auto intro!: derivative_eq_intros simp: field_split_simps powr_def)
 then show ?thesis
 by (rule has_derivative_transform_within[OF _ ‹d > 0› ‹x ∈ X›]) (auto simp: powr_def dest: pos')
qed

lemma has_derivative_const_powr [derivative_intros]:
 fixes a::real
 assumes "∧x. (f has_derivative f') (at x)"
 shows "((λx. a powr (f x)) has_derivative (λy. f' y * ln a * a powr (f x))) (at x)"
 using assms
 apply (simp add: powr_def)
 using DERIV_compose_FDERIV DERIV_exp has_derivative_mult_left by blast

lemma has_real_derivative_const_powr [derivative_intros]:
 fixes a::real
 assumes "∧x. (f has_real_derivative f' x) (at x)"
 shows "((λx. a powr (f x)) has_real_derivative (f' x * ln a * a powr (f x))) (at x)"
 using assms
 apply (simp add: powr_def)
 apply (rule assms impI derivative_eq_intros refl | simp)+
 done

lemma DERIV_powr:
 fixes r :: real
 assumes g: "DERIV g x :> m"
 and pos: "g x > 0"
 and f: "DERIV f x :> r"
 shows "DERIV (λx. g x powr f x) x :> (g x powr f x) * (r * ln (g x) + m * f x / g x)"
 using assms
 by (auto intro!: derivative_eq_intros ext simp: has_field_derivative_def algebra_simps)

lemma DERIV_fun_powr:
 fixes r :: real
 assumes g: "DERIV g x :> m"
 and pos: "g x > 0"
 shows "DERIV (λx. (g x) powr r) x :> r * (g x) powr (r - of_nat 1) * m"
 using DERIV_powr[OF g pos DERIV_const, of r] pos
 by (simp add: powr_diff field_simps)

lemma has_real_derivative_powr:
 assumes "z > 0"
 shows "((λz. z powr r) has_real_derivative r * z powr (r - 1)) (at z)"
proof (subst DERIV_cong_ev[OF refl _ refl])
 from assms have "eventually (λz. z ≠ 0) (nhds z)"
 by (intro t1_space_nhds) auto
 then show "eventually (λz. z powr r = exp (r * ln z)) (nhds z)"
 unfolding powr_def by eventually_elim simp
 from assms show "((λz. exp (r * ln z)) has_real_derivative r * z powr (r - 1)) (at z)"
 by (auto intro!: derivative_eq_intros simp: powr_def field_simps exp_diff)
qed

declare has_real_derivative_powr[THEN DERIV_chain2, derivative_intros]

text ‹A more general version, by Johannes Hölzl›
lemma has_real_derivative_powr':
 fixes f g :: "real ==> real"
 assumes "(f has_real_derivative f') (at x)"
 assumes "(g has_real_derivative g') (at x)"
 assumes "f x > 0"
 defines "h ≡ λx. f x powr g x * (g' * ln (f x) + f' * g x / f x)"
 shows "((λx. f x powr g x) has_real_derivative h x) (at x)"
proof (subst DERIV_cong_ev[OF refl _ refl])
 from assms have "isCont f x"
 by (simp add: DERIV_continuous)
 hence "f ←-x→ f x" by (simp add: continuous_at)
 with ‹f x > 0› have "eventually (λx. f x > 0) (nhds x)"
 by (auto simp: tendsto_at_iff_tendsto_nhds dest: order_tendstoD)
 thus "eventually (λx. f x powr g x = exp (g x * ln (f x))) (nhds x)"
 by eventually_elim (simp add: powr_def)
next
 from assms show "((λx. exp (g x * ln (f x))) has_real_derivative h x) (at x)"
 by (auto intro!: derivative_eq_intros simp: h_def powr_def)
qed

lemma tendsto_zero_powrI:
 assumes "(f ---> (0::real)) F" "(g ---> b) F" "∀🪙F x in F. 0 ≤ f x" "0 < b"
 shows "((λx. f x powr g x) ---> 0) F"
 using tendsto_powr2[OF assms] by simp

lemma continuous_on_powr':
 fixes f g :: "_ ==> real"
 assumes "continuous_on s f" "continuous_on s g"
 and "∀x∈s. f x ≥ 0 ∧ (f x = 0 ⟶ g x > 0)"
 shows "continuous_on s (λx. (f x) powr (g x))"
 unfolding continuous_on_def
proof
 fix x
 assume x: "x ∈ s"
 from assms x show "((λx. f x powr g x) ---> f x powr g x) (at x within s)"
 proof (cases "f x = 0")
 case True
 from assms(3) have "eventually (λx. f x ≥ 0) (at x within s)"
 by (auto simp: at_within_def eventually_inf_principal)
 with True x assms show ?thesis
 by (auto intro!: tendsto_zero_powrI[of f _ g "g x"] simp: continuous_on_def)
 next
 case False
 with assms x show ?thesis
 by (auto intro!: tendsto_powr' simp: continuous_on_def)
 qed
qed

lemma tendsto_neg_powr:
 assumes "s < 0"
 and f: "LIM x F. f x :> at_top"
 shows "((λx. f x powr s) ---> (0::real)) F"
proof -
 have "((λx. exp (s * ln (f x))) ---> (0::real)) F" (is "?X")
 by (auto intro!: filterlim_compose[OF exp_at_bot] filterlim_compose[OF ln_at_top]
 filterlim_tendsto_neg_mult_at_bot assms)
 also have "?X ⟷ ((λx. f x powr s) ---> (0::real)) F"
 using f filterlim_at_top_dense[of f F]
 by (intro filterlim_cong[OF refl refl]) (auto simp: neq_iff powr_def elim: eventually_mono)
 finally show ?thesis .
qed

lemma tendsto_exp_limit_at_right: "((λy. (1 + x * y) powr (1 / y)) ---> exp x) (at_right 0)"
 for x :: real
proof (cases "x = 0")
 case True
 then show ?thesis by simp
next
 case False
 have "((λy. ln (1 + x * y)::real) has_real_derivative 1 * x) (at 0)"
 by (auto intro!: derivative_eq_intros)
 then have "((λy. ln (1 + x * y) / y) ---> x) (at 0)"
 by (auto simp: has_field_derivative_def field_has_derivative_at)
 then have *: "((λy. exp (ln (1 + x * y) / y)) ---> exp x) (at 0)"
 by (rule tendsto_intros)
 then show ?thesis
 proof (rule filterlim_mono_eventually)
 show "eventually (λxa. exp (ln (1 + x * xa) / xa) = (1 + x * xa) powr (1 / xa)) (at_right 0)"
 unfolding eventually_at_right[OF zero_less_one]
 using False
 by (intro exI[of _ "1 / ∣x∣"]) (auto simp: field_simps powr_def abs_if add_nonneg_eq_0_iff)
 qed (simp_all add: at_eq_sup_left_right)
qed

lemma tendsto_exp_limit_at_top: "((λy. (1 + x / y) powr y) ---> exp x) at_top"
 for x :: real
 by (simp add: filterlim_at_top_to_right inverse_eq_divide tendsto_exp_limit_at_right)

lemma tendsto_exp_limit_sequentially: "(λn. (1 + x / n) ^ n) <---- exp x"
 for x :: real
proof (rule filterlim_mono_eventually)
 from reals_Archimedean2 [of "∣x∣"] obtain n :: nat where *: "real n > ∣x∣" ..
 then have "eventually (λn :: nat. 0 < 1 + x / real n) at_top"
 by (intro eventually_sequentiallyI [of n]) (auto simp: field_split_simps)
 then show "eventually (λn. (1 + x / n) powr n = (1 + x / n) ^ n) at_top"
 by (rule eventually_mono) (erule powr_realpow)
 show "(λn. (1 + x / real n) powr real n) <---- exp x"
 by (rule filterlim_compose [OF tendsto_exp_limit_at_top filterlim_real_sequentially])
qed auto

subsection ‹Sine and Cosine›

definition sin_coeff :: "nat ==> real"
 where "sin_coeff = (λn. if even n then 0 else (- 1) ^ ((n - Suc 0) div 2) / (fact n))"

definition cos_coeff :: "nat ==> real"
 where "cos_coeff = (λn. if even n then ((- 1) ^ (n div 2)) / (fact n) else 0)"

definition sin :: "'a ==> 'a::{real_normed_algebra_1,banach}"
 where "sin = (λx. ∑n. sin_coeff n *🪙R x^n)"

definition cos :: "'a ==> 'a::{real_normed_algebra_1,banach}"
 where "cos = (λx. ∑n. cos_coeff n *🪙R x^n)"

lemma sin_coeff_0 [simp]: "sin_coeff 0 = 0"
 unfolding sin_coeff_def by simp

lemma cos_coeff_0 [simp]: "cos_coeff 0 = 1"
 unfolding cos_coeff_def by simp

lemma sin_coeff_Suc: "sin_coeff (Suc n) = cos_coeff n / real (Suc n)"
 unfolding cos_coeff_def sin_coeff_def
 by (simp del: mult_Suc)

lemma cos_coeff_Suc: "cos_coeff (Suc n) = - sin_coeff n / real (Suc n)"
 unfolding cos_coeff_def sin_coeff_def
 by (simp del: mult_Suc) (auto elim: oddE)

lemma summable_norm_sin: "summable (λn. norm (sin_coeff n *🪙R x^n))"
 for x :: "'a::{real_normed_algebra_1,banach}"
proof (rule summable_comparison_test [OF _ summable_norm_exp])
 show "∃N. ∀n≥N. norm (norm (sin_coeff n *🪙R x ^ n)) ≤ norm (x ^ n /🪙R fact n)"
 unfolding sin_coeff_def
 by (auto simp: divide_inverse abs_mult power_abs [symmetric] zero_le_mult_iff)
qed

lemma summable_norm_cos: "summable (λn. norm (cos_coeff n *🪙R x^n))"
 for x :: "'a::{real_normed_algebra_1,banach}"
proof (rule summable_comparison_test [OF _ summable_norm_exp])
 show "∃N. ∀n≥N. norm (norm (cos_coeff n *🪙R x ^ n)) ≤ norm (x ^ n /🪙R fact n)"
 unfolding cos_coeff_def
 by (auto simp: divide_inverse abs_mult power_abs [symmetric] zero_le_mult_iff)
qed

lemma sin_converges: "(λn. sin_coeff n *🪙R x^n) sums sin x"
 unfolding sin_def
 by (metis (full_types) summable_norm_cancel summable_norm_sin summable_sums)

lemma cos_converges: "(λn. cos_coeff n *🪙R x^n) sums cos x"
 unfolding cos_def
 by (metis (full_types) summable_norm_cancel summable_norm_cos summable_sums)

lemma sin_of_real: "sin (of_real x) = of_real (sin x)"
 for x :: real
proof -
 have "(λn. of_real (sin_coeff n *🪙R x^n)) = (λn. sin_coeff n *🪙R (of_real x)^n)"
 proof
 show "of_real (sin_coeff n *🪙R x^n) = sin_coeff n *🪙R of_real x^n" for n
 by (simp add: scaleR_conv_of_real)
 qed
 also have "… sums (sin (of_real x))"
 by (rule sin_converges)
 finally have "(λn. of_real (sin_coeff n *🪙R x^n)) sums (sin (of_real x))" .
 then show ?thesis
 using sums_unique2 sums_of_real [OF sin_converges] by blast
qed

corollary sin_in_Reals [simp]: "z ∈ ℝ ==> sin z ∈ ℝ"
 by (metis Reals_cases Reals_of_real sin_of_real)

lemma cos_of_real: "cos (of_real x) = of_real (cos x)"
 for x :: real
proof -
 have "(λn. of_real (cos_coeff n *🪙R x^n)) = (λn. cos_coeff n *🪙R (of_real x)^n)"
 proof
 show "of_real (cos_coeff n *🪙R x^n) = cos_coeff n *🪙R of_real x^n" for n
 by (simp add: scaleR_conv_of_real)
 qed
 also have "… sums (cos (of_real x))"
 by (rule cos_converges)
 finally have "(λn. of_real (cos_coeff n *🪙R x^n)) sums (cos (of_real x))" .
 then show ?thesis
 using sums_unique2 sums_of_real [OF cos_converges]
 by blast
qed

corollary cos_in_Reals [simp]: "z ∈ ℝ ==> cos z ∈ ℝ"
 by (metis Reals_cases Reals_of_real cos_of_real)

lemma diffs_sin_coeff: "diffs sin_coeff = cos_coeff"
 by (simp add: diffs_def sin_coeff_Suc del: of_nat_Suc)

lemma diffs_cos_coeff: "diffs cos_coeff = (λn. - sin_coeff n)"
 by (simp add: diffs_def cos_coeff_Suc del: of_nat_Suc)

lemma sin_int_times_real: "sin (of_int m * of_real x) = of_real (sin (of_int m * x))"
 by (metis sin_of_real of_real_mult of_real_of_int_eq)

lemma cos_int_times_real: "cos (of_int m * of_real x) = of_real (cos (of_int m * x))"
 by (metis cos_of_real of_real_mult of_real_of_int_eq)

text ‹Now at last we can get the derivatives of exp, sin and cos.›

lemma DERIV_sin [simp]: "DERIV sin x :> cos x"
 for x :: "'a::{real_normed_field,banach}"
 unfolding sin_def cos_def scaleR_conv_of_real
 apply (rule DERIV_cong)
 apply (rule termdiffs [where K="of_real (norm x) + 1 :: 'a"])
 apply (simp_all add: norm_less_p1 diffs_of_real diffs_sin_coeff diffs_cos_coeff
 summable_minus_iff scaleR_conv_of_real [symmetric]
 summable_norm_sin [THEN summable_norm_cancel]
 summable_norm_cos [THEN summable_norm_cancel])
 done

declare DERIV_sin[THEN DERIV_chain2, derivative_intros]
 and DERIV_sin[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]

lemmas has_derivative_sin[derivative_intros] = DERIV_sin[THEN DERIV_compose_FDERIV]

lemma DERIV_cos [simp]: "DERIV cos x :> - sin x"
 for x :: "'a::{real_normed_field,banach}"
 unfolding sin_def cos_def scaleR_conv_of_real
 apply (rule DERIV_cong)
 apply (rule termdiffs [where K="of_real (norm x) + 1 :: 'a"])
 apply (simp_all add: norm_less_p1 diffs_of_real diffs_minus suminf_minus
 diffs_sin_coeff diffs_cos_coeff
 summable_minus_iff scaleR_conv_of_real [symmetric]
 summable_norm_sin [THEN summable_norm_cancel]
 summable_norm_cos [THEN summable_norm_cancel])
 done

declare DERIV_cos[THEN DERIV_chain2, derivative_intros]
 and DERIV_cos[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]

lemmas has_derivative_cos[derivative_intros] = DERIV_cos[THEN DERIV_compose_FDERIV]

lemma isCont_sin: "isCont sin x"
 for x :: "'a::{real_normed_field,banach}"
 by (rule DERIV_sin [THEN DERIV_isCont])

lemma continuous_on_sin_real: "continuous_on {a..b} sin" for a::real
 using continuous_at_imp_continuous_on isCont_sin by blast

lemma isCont_cos: "isCont cos x"
 for x :: "'a::{real_normed_field,banach}"
 by (rule DERIV_cos [THEN DERIV_isCont])

lemma continuous_on_cos_real: "continuous_on {a..b} cos" for a::real
 using continuous_at_imp_continuous_on isCont_cos by blast

context
 fixes f :: "'a::t2_space ==> 'b::{real_normed_field,banach}"
begin

lemma isCont_sin' [simp]: "isCont f a ==> isCont (λx. sin (f x)) a"
 by (rule isCont_o2 [OF _ isCont_sin])

lemma isCont_cos' [simp]: "isCont f a ==> isCont (λx. cos (f x)) a"
 by (rule isCont_o2 [OF _ isCont_cos])

lemma tendsto_sin [tendsto_intros]: "(f ---> a) F ==> ((λx. sin (f x)) ---> sin a) F"
 by (rule isCont_tendsto_compose [OF isCont_sin])

lemma tendsto_cos [tendsto_intros]: "(f ---> a) F ==> ((λx. cos (f x)) ---> cos a) F"
 by (rule isCont_tendsto_compose [OF isCont_cos])

lemma continuous_sin [continuous_intros]: "continuous F f ==> continuous F (λx. sin (f x))"
 unfolding continuous_def by (rule tendsto_sin)

lemma continuous_on_sin [continuous_intros]: "continuous_on s f ==> continuous_on s (λx. sin (f x))"
 unfolding continuous_on_def by (auto intro: tendsto_sin)

lemma continuous_cos [continuous_intros]: "continuous F f ==> continuous F (λx. cos (f x))"
 unfolding continuous_def by (rule tendsto_cos)

lemma continuous_on_cos [continuous_intros]: "continuous_on s f ==> continuous_on s (λx. cos (f x))"
 unfolding continuous_on_def by (auto intro: tendsto_cos)

end

lemma continuous_within_sin: "continuous (at z within s) sin"
 for z :: "'a::{real_normed_field,banach}"
 by (simp add: continuous_within tendsto_sin)

lemma continuous_within_cos: "continuous (at z within s) cos"
 for z :: "'a::{real_normed_field,banach}"
 by (simp add: continuous_within tendsto_cos)

subsection ‹Properties of Sine and Cosine›

lemma sin_zero [simp]: "sin 0 = 0"
 by (simp add: sin_def sin_coeff_def scaleR_conv_of_real)

lemma cos_zero [simp]: "cos 0 = 1"
 by (simp add: cos_def cos_coeff_def scaleR_conv_of_real)

lemma DERIV_fun_sin: "DERIV g x :> m ==> DERIV (λx. sin (g x)) x :> cos (g x) * m"
 by (fact derivative_intros)

lemma DERIV_fun_cos: "DERIV g x :> m ==> DERIV (λx. cos(g x)) x :> - sin (g x) * m"
 by (fact derivative_intros)

subsection ‹Deriving the Addition Formulas›

text ‹The product of two cosine series.›
lemma cos_x_cos_y:
 fixes x :: "'a::{real_normed_field,banach}"
 shows
 "(λp. ∑n≤p.
 if even p ∧ even n
 then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *🪙R (x^n) * y^(p-n) else 0)
 sums (cos x * cos y)"
proof -
 have "(cos_coeff n * cos_coeff (p - n)) *🪙R (x^n * y^(p - n)) =
 (if even p ∧ even n then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *🪙R (x^n) * y^(p - n)
 else 0)"
 if "n ≤ p" for n p :: nat
 proof -
 from that have *: "even n ==> even p ==>
 (-1) ^ (n div 2) * (-1) ^ ((p - n) div 2) = (-1 :: real) ^ (p div 2)"
 by (metis div_add power_add le_add_diff_inverse odd_add)
 with that show ?thesis
 by (auto simp: algebra_simps cos_coeff_def binomial_fact)
 qed
 then have "(λp. ∑n≤p. if even p ∧ even n
 then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *🪙R (x^n) * y^(p-n) else 0) =
 (λp. ∑n≤p. (cos_coeff n * cos_coeff (p - n)) *🪙R (x^n * y^(p-n)))"
 by simp
 also have "… = (λp. ∑n≤p. (cos_coeff n *🪙R x^n) * (cos_coeff (p - n) *🪙R y^(p-n)))"
 by (simp add: algebra_simps)
 also have "… sums (cos x * cos y)"
 using summable_norm_cos
 by (auto simp: cos_def scaleR_conv_of_real intro!: Cauchy_product_sums)
 finally show ?thesis .
qed

text ‹The product of two sine series.›
lemma sin_x_sin_y:
 fixes x :: "'a::{real_normed_field,banach}"
 shows
 "(λp. ∑n≤p.
 if even p ∧ odd n
 then - ((-1) ^ (p div 2) * (p choose n) / (fact p)) *🪙R (x^n) * y^(p-n)
 else 0)
 sums (sin x * sin y)"
proof -
 have "(sin_coeff n * sin_coeff (p - n)) *🪙R (x^n * y^(p-n)) =
 (if even p ∧ odd n
 then -((-1) ^ (p div 2) * (p choose n) / (fact p)) *🪙R (x^n) * y^(p-n)
 else 0)"
 if "n ≤ p" for n p :: nat
 proof -
 have "(-1) ^ ((n - Suc 0) div 2) * (-1) ^ ((p - Suc n) div 2) = - ((-1 :: real) ^ (p div 2))"
 if np: "odd n" "even p"
 proof -
 have "p > 0"
 using ‹n ≤ p› neq0_conv that(1) by blast
 then have 🍋: "(- 1::real) ^ (p div 2 - Suc 0) = - ((- 1) ^ (p div 2))"
 using ‹even p› by (auto simp add: dvd_def power_eq_if)
 from ‹n ≤ p› np have *: "n - Suc 0 + (p - Suc n) = p - Suc (Suc 0)" "Suc (Suc 0) ≤ p"
 by arith+
 have "(p - Suc (Suc 0)) div 2 = p div 2 - Suc 0"
 by simp
 with ‹n ≤ p› np 🍋 * show ?thesis
 by (simp add: flip: div_add power_add)
 qed
 then show ?thesis
 using ‹n≤p› by (auto simp: algebra_simps sin_coeff_def binomial_fact)
 qed
 then have "(λp. ∑n≤p. if even p ∧ odd n
 then - ((-1) ^ (p div 2) * (p choose n) / (fact p)) *🪙R (x^n) * y^(p-n) else 0) =
 (λp. ∑n≤p. (sin_coeff n * sin_coeff (p - n)) *🪙R (x^n * y^(p-n)))"
 by simp
 also have "… = (λp. ∑n≤p. (sin_coeff n *🪙R x^n) * (sin_coeff (p - n) *🪙R y^(p-n)))"
 by (simp add: algebra_simps)
 also have "… sums (sin x * sin y)"
 using summable_norm_sin
 by (auto simp: sin_def scaleR_conv_of_real intro!: Cauchy_product_sums)
 finally show ?thesis .
qed

lemma sums_cos_x_plus_y:
 fixes x :: "'a::{real_normed_field,banach}"
 shows
 "(λp. ∑n≤p.
 if even p
 then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *🪙R (x^n) * y^(p-n)
 else 0)
 sums cos (x + y)"
proof -
 have
 "(∑n≤p.
 if even p then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *🪙R (x^n) * y^(p-n)
 else 0) = cos_coeff p *🪙R ((x + y) ^ p)"
 for p :: nat
 proof -
 have
 "(∑n≤p. if even p then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *🪙R (x^n) * y^(p-n) else 0) =
 (if even p then ∑n≤p. ((-1) ^ (p div 2) * (p choose n) / (fact p)) *🪙R (x^n) * y^(p-n) else 0)"
 by simp
 also have "… =
 (if even p
 then of_real ((-1) ^ (p div 2) / (fact p)) * (∑n≤p. (p choose n) *🪙R (x^n) * y^(p-n))
 else 0)"
 by (auto simp: sum_distrib_left field_simps scaleR_conv_of_real nonzero_of_real_divide)
 also have "… = cos_coeff p *🪙R ((x + y) ^ p)"
 by (simp add: cos_coeff_def binomial_ring [of x y] scaleR_conv_of_real atLeast0AtMost)
 finally show ?thesis .
 qed
 then have
 "(λp. ∑n≤p.
 if even p
 then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *🪙R (x^n) * y^(p-n)
 else 0) = (λp. cos_coeff p *🪙R ((x+y)^p))"
 by simp
 also have "… sums cos (x + y)"
 by (rule cos_converges)
 finally show ?thesis .
qed

theorem cos_add:
 fixes x :: "'a::{real_normed_field,banach}"
 shows "cos (x + y) = cos x * cos y - sin x * sin y"
proof -
 have
 "(if even p ∧ even n
 then ((- 1) ^ (p div 2) * int (p choose n) / (fact p)) *🪙R (x^n) * y^(p-n) else 0) -
 (if even p ∧ odd n
 then - ((- 1) ^ (p div 2) * int (p choose n) / (fact p)) *🪙R (x^n) * y^(p-n) else 0) =
 (if even p then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *🪙R (x^n) * y^(p-n) else 0)"
 if "n ≤ p" for n p :: nat
 by simp
 then have
 "(λp. ∑n≤p. (if even p then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *🪙R (x^n) * y^(p-n) else 0))
 sums (cos x * cos y - sin x * sin y)"
 using sums_diff [OF cos_x_cos_y [of x y] sin_x_sin_y [of x y]]
 by (simp add: sum_subtractf [symmetric])
 then show ?thesis
 by (blast intro: sums_cos_x_plus_y sums_unique2)
qed

lemma sin_minus_converges: "(λn. - (sin_coeff n *🪙R (-x)^n)) sums sin x"
proof -
 have [simp]: "∧n. - (sin_coeff n *🪙R (-x)^n) = (sin_coeff n *🪙R x^n)"
 by (auto simp: sin_coeff_def elim!: oddE)
 show ?thesis
 by (simp add: sin_def summable_norm_sin [THEN summable_norm_cancel, THEN summable_sums])
qed

lemma sin_minus [simp]: "sin (- x) = - sin x"
 for x :: "'a::{real_normed_algebra_1,banach}"
 using sin_minus_converges [of x]
 by (auto simp: sin_def summable_norm_sin [THEN summable_norm_cancel]
 suminf_minus sums_iff equation_minus_iff)

lemma cos_minus_converges: "(λn. (cos_coeff n *🪙R (-x)^n)) sums cos x"
proof -
 have [simp]: "∧n. (cos_coeff n *🪙R (-x)^n) = (cos_coeff n *🪙R x^n)"
 by (auto simp: Transcendental.cos_coeff_def elim!: evenE)
 show ?thesis
 by (simp add: cos_def summable_norm_cos [THEN summable_norm_cancel, THEN summable_sums])
qed

lemma cos_minus [simp]: "cos (-x) = cos x"
 for x :: "'a::{real_normed_algebra_1,banach}"
 using cos_minus_converges [of x] by (metis cos_def sums_unique)

lemma cos_abs_real [simp]: "cos ∣x :: real∣ = cos x"
 by (simp add: abs_if)

lemma sin_cos_squared_add [simp]: "(sin x)🪙2 + (cos x)🪙2 = 1"
 for x :: "'a::{real_normed_field,banach}"
 using cos_add [of x "-x"]
 by (simp add: power2_eq_square algebra_simps)

lemma sin_cos_squared_add2 [simp]: "(cos x)🪙2 + (sin x)🪙2 = 1"
 for x :: "'a::{real_normed_field,banach}"
 by (subst add.commute, rule sin_cos_squared_add)

lemma sin_cos_squared_add3 [simp]: "cos x * cos x + sin x * sin x = 1"
 for x :: "'a::{real_normed_field,banach}"
 using sin_cos_squared_add2 [unfolded power2_eq_square] .

lemma sin_squared_eq: "(sin x)🪙2 = 1 - (cos x)🪙2"
 for x :: "'a::{real_normed_field,banach}"
 unfolding eq_diff_eq by (rule sin_cos_squared_add)

lemma cos_squared_eq: "(cos x)🪙2 = 1 - (sin x)🪙2"
 for x :: "'a::{real_normed_field,banach}"
 unfolding eq_diff_eq by (rule sin_cos_squared_add2)

lemma abs_sin_le_one [simp]: "∣sin x∣ ≤ 1"
 for x :: real
 by (rule power2_le_imp_le) (simp_all add: sin_squared_eq)

lemma sin_ge_minus_one [simp]: "- 1 ≤ sin x"
 for x :: real
 using abs_sin_le_one [of x] by (simp add: abs_le_iff)

lemma sin_le_one [simp]: "sin x ≤ 1"
 for x :: real
 using abs_sin_le_one [of x] by (simp add: abs_le_iff)

lemma abs_cos_le_one [simp]: "∣cos x∣ ≤ 1"
 for x :: real
 by (rule power2_le_imp_le) (simp_all add: cos_squared_eq)

lemma cos_ge_minus_one [simp]: "- 1 ≤ cos x"
 for x :: real
 using abs_cos_le_one [of x] by (simp add: abs_le_iff)

lemma cos_le_one [simp]: "cos x ≤ 1"
 for x :: real
 using abs_cos_le_one [of x] by (simp add: abs_le_iff)

lemma cos_diff: "cos (x - y) = cos x * cos y + sin x * sin y"
 for x :: "'a::{real_normed_field,banach}"
 using cos_add [of x "- y"] by simp

lemma cos_double: "cos(2*x) = (cos x)🪙2 - (sin x)🪙2"
 for x :: "'a::{real_normed_field,banach}"
 using cos_add [where x=x and y=x] by (simp add: power2_eq_square)

lemma sin_cos_le1: "∣sin x * sin y + cos x * cos y∣ ≤ 1"
 for x :: real
 using cos_diff [of x y] by (metis abs_cos_le_one add.commute)

lemma DERIV_fun_pow: "DERIV g x :> m ==> DERIV (λx. (g x) ^ n) x :> real n * (g x) ^ (n - 1) * m"
 by (auto intro!: derivative_eq_intros simp:)

lemma DERIV_fun_exp: "DERIV g x :> m ==> DERIV (λx. exp (g x)) x :> exp (g x) * m"
 by (auto intro!: derivative_intros)

subsection ‹The Constant Pi›

definition pi :: real
 where "pi = 2 * (THE x. 0 ≤ x ∧ x ≤ 2 ∧ cos x = 0)"

text ‹Show that there's a least positive 🍋‹x› with 🍋‹cos x = 0›;
 hence define pi.›

lemma sin_paired: "(λn. (- 1) ^ n / (fact (2 * n + 1)) * x ^ (2 * n + 1)) sums sin x"
 for x :: real
proof -
 have "(λn. ∑k = n*2..
 by (rule sums_group) (use sin_converges [of x, unfolded scaleR_conv_of_real] in auto)
 then show ?thesis
 by (simp add: sin_coeff_def ac_simps)
qed

lemma sin_gt_zero_02:
 fixes x :: real
 assumes "0 < x" and "x < 2"
 shows "0 < sin x"
proof -
 let ?f = "λn::nat. ∑k = n*2..
 have pos: "∀n. 0 < ?f n"
 proof
 fix n :: nat
 let ?k2 = "real (Suc (Suc (4 * n)))"
 let ?k3 = "real (Suc (Suc (Suc (4 * n))))"
 have "x * x < ?k2 * ?k3"
 using assms by (intro mult_strict_mono', simp_all)
 then have "x * x * x * x ^ (n * 4) < ?k2 * ?k3 * x * x ^ (n * 4)"
 by (intro mult_strict_right_mono zero_less_power ‹0 🚫›)
 then show "0 < ?f n"
 by (simp add: ac_simps divide_less_eq)
qed
 have sums: "?f sums sin x"
 by (rule sin_paired [THEN sums_group]) simp
 show "0 < sin x"
 unfolding sums_unique [OF sums] using sums_summable [OF sums] pos by (simp add: suminf_pos)
qed

lemma cos_double_less_one: "0 < x ==> x < 2 ==> cos (2 * x) < 1"
 for x :: real
 using sin_gt_zero_02 [where x = x] by (auto simp: cos_squared_eq cos_double)

lemma cos_paired: "(λn. (- 1) ^ n / (fact (2 * n)) * x ^ (2 * n)) sums cos x"
 for x :: real
proof -
 have "(λn. ∑k = n * 2..
 by (rule sums_group) (use cos_converges [of x, unfolded scaleR_conv_of_real] in auto)
 then show ?thesis
 by (simp add: cos_coeff_def ac_simps)
qed

lemma sum_pos_lt_pair:
 fixes f :: "nat ==> real"
 assumes f: "summable f" and fplus: "∧d. 0 < f (k + (Suc(Suc 0) * d)) + f (k + ((Suc (Suc 0) * d) + 1))"
 shows "sum f {..
proof -
 have "(λn. ∑n = n * Suc (Suc 0)..
 sums (∑n. f (n + k))"
 proof (rule sums_group)
 show "(λn. f (n + k)) sums (∑n. f (n + k))"
 by (simp add: f summable_iff_shift summable_sums)
 qed auto
 with fplus have "0 < (∑n. f (n + k))"
 apply (simp add: add.commute)
 apply (metis (no_types, lifting) suminf_pos summable_def sums_unique)
 done
 then show ?thesis
 by (simp add: f suminf_minus_initial_segment)
qed

lemma cos_two_less_zero [simp]: "cos 2 < (0::real)"
proof -
 note fact_Suc [simp del]
 from sums_minus [OF cos_paired]
 have *: "(λn. - ((- 1) ^ n * 2 ^ (2 * n) / fact (2 * n))) sums - cos (2::real)"
 by simp
 then have sm: "summable (λn. - ((- 1::real) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
 by (rule sums_summable)
 have "0 < (∑n
 by (simp add: fact_num_eq_if power_eq_if)
 moreover have "(∑n
 (∑n. - ((- 1) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
 proof -
 {
 fix d
 let ?six4d = "Suc (Suc (Suc (Suc (Suc (Suc (4 * d))))))"
 have "(4::real) * (fact (?six4d)) < (Suc (Suc (?six4d)) * fact (Suc (?six4d)))"
 unfolding of_nat_mult by (rule mult_strict_mono) (simp_all add: fact_less_mono)
 then have "(4::real) * (fact (?six4d)) < (fact (Suc (Suc (?six4d))))"
 by (simp only: fact_Suc [of "Suc (?six4d)"] of_nat_mult of_nat_fact)
 then have "(4::real) * inverse (fact (Suc (Suc (?six4d)))) < inverse (fact (?six4d))"
 by (simp add: inverse_eq_divide less_divide_eq)
 }
 then show ?thesis
 by (force intro!: sum_pos_lt_pair [OF sm] simp add: divide_inverse algebra_simps)
 qed
 ultimately have "0 < (∑n. - ((- 1::real) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
 by (rule order_less_trans)
 moreover from * have "- cos 2 = (∑n. - ((- 1::real) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
 by (rule sums_unique)
 ultimately have "(0::real) < - cos 2" by simp
 then show ?thesis by simp
qed

lemmas cos_two_neq_zero [simp] = cos_two_less_zero [THEN less_imp_neq]
lemmas cos_two_le_zero [simp] = cos_two_less_zero [THEN order_less_imp_le]

lemma cos_is_zero: "∃!x::real. 0 ≤ x ∧ x ≤ 2 ∧ cos x = 0"
proof (rule ex_ex1I)
 show "∃x::real. 0 ≤ x ∧ x ≤ 2 ∧ cos x = 0"
 by (rule IVT2) simp_all
next
 fix a b :: real
 assume ab: "0 ≤ a ∧ a ≤ 2 ∧ cos a = 0" "0 ≤ b ∧ b ≤ 2 ∧ cos b = 0"
 have cosd: "∧x::real. cos differentiable (at x)"
 unfolding real_differentiable_def by (auto intro: DERIV_cos)
 show "a = b"
 proof (cases a b rule: linorder_cases)
 case less
 then obtain z where "a < z" "z < b" "(cos has_real_derivative 0) (at z)"
 using Rolle by (metis cosd continuous_on_cos_real ab)
 then have "sin z = 0"
 using DERIV_cos DERIV_unique neg_equal_0_iff_equal by blast
 then show ?thesis
 by (metis ‹a 🚫› ‹z 🚫› ab order_less_le_trans less_le sin_gt_zero_02)
 next
 case greater
 then obtain z where "b < z" "z < a" "(cos has_real_derivative 0) (at z)"
 using Rolle by (metis cosd continuous_on_cos_real ab)
 then have "sin z = 0"
 using DERIV_cos DERIV_unique neg_equal_0_iff_equal by blast
 then show ?thesis
 by (metis ‹b 🚫› ‹z 🚫› ab order_less_le_trans less_le sin_gt_zero_02)
 qed auto
qed

lemma pi_half: "pi/2 = (THE x. 0 ≤ x ∧ x ≤ 2 ∧ cos x = 0)"
 by (simp add: pi_def)

lemma cos_pi_half [simp]: "cos (pi/2) = 0"
 by (simp add: pi_half cos_is_zero [THEN theI'])

lemma cos_of_real_pi_half [simp]: "cos ((of_real pi/2) :: 'a) = 0"
 if "SORT_CONSTRAINT('a::{real_field,banach,real_normed_algebra_1})"
 by (metis cos_pi_half cos_of_real eq_numeral_simps(4)
 nonzero_of_real_divide of_real_0 of_real_numeral)

lemma pi_half_gt_zero [simp]: "0 < pi/2"
proof -
 have "0 ≤ pi/2"
 by (simp add: pi_half cos_is_zero [THEN theI'])
 then show ?thesis
 by (metis cos_pi_half cos_zero less_eq_real_def one_neq_zero)
qed

lemmas pi_half_neq_zero [simp] = pi_half_gt_zero [THEN less_imp_neq, symmetric]
lemmas pi_half_ge_zero [simp] = pi_half_gt_zero [THEN order_less_imp_le]

lemma pi_half_less_two [simp]: "pi/2 < 2"
proof -
 have "pi/2 ≤ 2"
 by (simp add: pi_half cos_is_zero [THEN theI'])
 then show ?thesis
 by (metis cos_pi_half cos_two_neq_zero le_less)
qed

lemmas pi_half_neq_two [simp] = pi_half_less_two [THEN less_imp_neq]
lemmas pi_half_le_two [simp] = pi_half_less_two [THEN order_less_imp_le]

lemma pi_gt_zero [simp]: "0 < pi"
 using pi_half_gt_zero by simp

lemma pi_ge_zero [simp]: "0 ≤ pi"
 by (rule pi_gt_zero [THEN order_less_imp_le])

lemma pi_neq_zero [simp]: "pi ≠ 0"
 by (rule pi_gt_zero [THEN less_imp_neq, symmetric])

lemma pi_not_less_zero [simp]: "¬ pi < 0"
 by (simp add: linorder_not_less)

lemma minus_pi_half_less_zero: "-(pi/2) < 0"
 by simp

lemma m2pi_less_pi: "- (2*pi) < pi"
 by simp

lemma sin_pi_half [simp]: "sin(pi/2) = 1"
 using sin_cos_squared_add2 [where x = "pi/2"]
 using sin_gt_zero_02 [OF pi_half_gt_zero pi_half_less_two]
 by (simp add: power2_eq_1_iff)

lemma sin_of_real_pi_half [simp]: "sin ((of_real pi/2) :: 'a) = 1"
 if "SORT_CONSTRAINT('a::{real_field,banach,real_normed_algebra_1})"
 using sin_pi_half
 by (metis sin_pi_half eq_numeral_simps(4) nonzero_of_real_divide of_real_1 of_real_numeral sin_of_real)

lemma sin_cos_eq: "sin x = cos (of_real pi/2 - x)"
 for x :: "'a::{real_normed_field,banach}"
 by (simp add: cos_diff)

lemma minus_sin_cos_eq: "- sin x = cos (x + of_real pi/2)"
 for x :: "'a::{real_normed_field,banach}"
 by (simp add: cos_add nonzero_of_real_divide)

lemma cos_sin_eq: "cos x = sin (of_real pi/2 - x)"
 for x :: "'a::{real_normed_field,banach}"
 using sin_cos_eq [of "of_real pi/2 - x"] by simp

lemma sin_add: "sin (x + y) = sin x * cos y + cos x * sin y"
 for x :: "'a::{real_normed_field,banach}"
 using cos_add [of "of_real pi/2 - x" "-y"]
 by (simp add: cos_sin_eq) (simp add: sin_cos_eq)

lemma sin_diff: "sin (x - y) = sin x * cos y - cos x * sin y"
 for x :: "'a::{real_normed_field,banach}"
 using sin_add [of x "- y"] by simp

lemma sin_double: "sin(2 * x) = 2 * sin x * cos x"
 for x :: "'a::{real_normed_field,banach}"
 using sin_add [where x=x and y=x] by simp

lemma cos_of_real_pi [simp]: "cos (of_real pi) = -1"
 using cos_add [where x = "pi/2" and y = "pi/2"]
 by (simp add: cos_of_real)

lemma sin_of_real_pi [simp]: "sin (of_real pi) = 0"
 using sin_add [where x = "pi/2" and y = "pi/2"]
 by (simp add: sin_of_real)

lemma cos_pi [simp]: "cos pi = -1"
 using cos_add [where x = "pi/2" and y = "pi/2"] by simp

lemma sin_pi [simp]: "sin pi = 0"
 using sin_add [where x = "pi/2" and y = "pi/2"] by simp

lemma sin_periodic_pi [simp]: "sin (x + pi) = - sin x"
 by (simp add: sin_add)

lemma sin_periodic_pi2 [simp]: "sin (pi + x) = - sin x"
 by (simp add: sin_add)

lemma cos_periodic_pi [simp]: "cos (x + pi) = - cos x"
 by (simp add: cos_add)

lemma cos_periodic_pi2 [simp]: "cos (pi + x) = - cos x"
 by (simp add: cos_add)

lemma sin_periodic [simp]: "sin (x + 2 * pi) = sin x"
 by (simp add: sin_add sin_double cos_double)

lemma cos_periodic [simp]: "cos (x + 2 * pi) = cos x"
 by (simp add: cos_add sin_double cos_double)

lemma cos_npi [simp]: "cos (real n * pi) = (- 1) ^ n"
 by (induct n) (auto simp: distrib_right)

lemma cos_npi2 [simp]: "cos (pi * real n) = (- 1) ^ n"
 by (metis cos_npi mult.commute)

lemma sin_npi [simp]: "sin (real n * pi) = 0"
 for n :: nat
 by (induct n) (auto simp: distrib_right)

lemma sin_npi2 [simp]: "sin (pi * real n) = 0"
 for n :: nat
 by (simp add: mult.commute [of pi])

lemma sin_npi_numeral [simp]: "sin(Num.numeral n * pi) = 0"
 by (metis of_nat_numeral sin_npi)

lemma sin_npi2_numeral [simp]: "sin (pi * Num.numeral n) = 0"
 by (metis of_nat_numeral sin_npi2)

lemma sin_npi_complex' [simp]: "sin (of_nat n * of_real pi) = 0"
 by (metis of_real_0 of_real_mult of_real_of_nat_eq sin_npi sin_of_real)

lemma cos_npi_numeral [simp]: "cos (Num.numeral n * pi) = (- 1) ^ Num.numeral n"
 by (metis cos_npi of_nat_numeral)

lemma cos_npi2_numeral [simp]: "cos (pi * Num.numeral n) = (- 1) ^ Num.numeral n"
 by (metis cos_npi2 of_nat_numeral)

lemma cos_npi_complex' [simp]: "cos (of_nat n * of_real pi) = (-1) ^ n" for n
proof -
 have "cos (of_nat n * of_real pi :: 'a) = of_real (cos (real n * pi))"
 by (subst cos_of_real [symmetric]) simp
 also have "cos (real n * pi) = (-1) ^ n"
 by simp
 finally show ?thesis by simp
qed

lemma cos_two_pi [simp]: "cos (2 * pi) = 1"
 by (simp add: cos_double)

lemma sin_two_pi [simp]: "sin (2 * pi) = 0"
 by (simp add: sin_double)

context
 fixes w :: "'a::{real_normed_field,banach}"

begin

lemma sin_times_sin: "sin w * sin z = (cos (w - z) - cos (w + z)) / 2"
 by (simp add: cos_diff cos_add)

lemma sin_times_cos: "sin w * cos z = (sin (w + z) + sin (w - z)) / 2"
 by (simp add: sin_diff sin_add)

lemma cos_times_sin: "cos w * sin z = (sin (w + z) - sin (w - z)) / 2"
 by (simp add: sin_diff sin_add)

lemma cos_times_cos: "cos w * cos z = (cos (w - z) + cos (w + z)) / 2"
 by (simp add: cos_diff cos_add)

lemma cos_double_cos: "cos (2 * w) = 2 * cos w ^ 2 - 1"
 by (simp add: cos_double sin_squared_eq)

lemma cos_double_sin: "cos (2 * w) = 1 - 2 * sin w ^ 2"
 by (simp add: cos_double sin_squared_eq)

end

lemma sin_plus_sin: "sin w + sin z = 2 * sin ((w + z) / 2) * cos ((w - z) / 2)"
 for w :: "'a::{real_normed_field,banach}"
 apply (simp add: mult.assoc sin_times_cos)
 apply (simp add: field_simps)
 done

lemma sin_diff_sin: "sin w - sin z = 2 * sin ((w - z) / 2) * cos ((w + z) / 2)"
 for w :: "'a::{real_normed_field,banach}"
 apply (simp add: mult.assoc sin_times_cos)
 apply (simp add: field_simps)
 done

lemma cos_plus_cos: "cos w + cos z = 2 * cos ((w + z) / 2) * cos ((w - z) / 2)"
 for w :: "'a::{real_normed_field,banach,field}"
 apply (simp add: mult.assoc cos_times_cos)
 apply (simp add: field_simps)
 done

lemma cos_diff_cos: "cos w - cos z = 2 * sin ((w + z) / 2) * sin ((z - w) / 2)"
 for w :: "'a::{real_normed_field,banach,field}"
 apply (simp add: mult.assoc sin_times_sin)
 apply (simp add: field_simps)
 done

lemma sin_pi_minus [simp]: "sin (pi - x) = sin x"
 by (metis sin_minus sin_periodic_pi minus_minus uminus_add_conv_diff)

lemma cos_pi_minus [simp]: "cos (pi - x) = - (cos x)"
 by (metis cos_minus cos_periodic_pi uminus_add_conv_diff)

lemma sin_minus_pi [simp]: "sin (x - pi) = - (sin x)"
 by (simp add: sin_diff)

lemma cos_minus_pi [simp]: "cos (x - pi) = - (cos x)"
 by (simp add: cos_diff)

lemma sin_2pi_minus [simp]: "sin (2 * pi - x) = - (sin x)"
 by (metis sin_periodic_pi2 add_diff_eq mult_2 sin_pi_minus)

lemma cos_2pi_minus [simp]: "cos (2 * pi - x) = cos x"
 by (metis (no_types, opaque_lifting) cos_add cos_minus cos_two_pi sin_minus sin_two_pi
 diff_0_right minus_diff_eq mult_1 mult_zero_left uminus_add_conv_diff)

lemma sin_gt_zero2: "0 < x ==> x < pi/2 ==> 0 < sin x"
 by (metis sin_gt_zero_02 order_less_trans pi_half_less_two)

lemma sin_less_zero:
 assumes "- pi/2 < x" and "x < 0"
 shows "sin x < 0"
proof -
 have "0 < sin (- x)"
 using assms by (simp only: sin_gt_zero2)
 then show ?thesis by simp
qed

lemma pi_less_4: "pi < 4"
 using pi_half_less_two by auto

lemma cos_gt_zero: "0 < x ==> x < pi/2 ==> 0 < cos x"
 by (simp add: cos_sin_eq sin_gt_zero2)

lemma cos_gt_zero_pi: "-(pi/2) < x ==> x < pi/2 ==> 0 < cos x"
 using cos_gt_zero [of x] cos_gt_zero [of "-x"]
 by (cases rule: linorder_cases [of x 0]) auto

lemma cos_ge_zero: "-(pi/2) ≤ x ==> x ≤ pi/2 ==> 0 ≤ cos x"
 by (auto simp: order_le_less cos_gt_zero_pi)
 (metis cos_pi_half eq_divide_eq eq_numeral_simps(4))

lemma sin_gt_zero: "0 < x ==> x < pi ==> 0 < sin x"
 by (simp add: sin_cos_eq cos_gt_zero_pi)

lemma sin_lt_zero: "pi < x ==> x < 2 * pi ==> sin x < 0"
 using sin_gt_zero [of "x - pi"]
 by (simp add: sin_diff)

lemma pi_ge_two: "2 ≤ pi"
proof (rule ccontr)
 assume "¬ ?thesis"
 then have "pi < 2" by auto
 have "∃y > pi. y < 2 ∧ y < 2 * pi"
 proof (cases "2 < 2 * pi")
 case True
 with dense[OF ‹pi 🚫›] show ?thesis by auto
 next
 case False
 have "pi < 2 * pi" by auto
 from dense[OF this] and False show ?thesis by auto
 qed
 then obtain y where "pi < y" and "y < 2" and "y < 2 * pi"
 by blast
 then have "0 < sin y"
 using sin_gt_zero_02 by auto
 moreover have "sin y < 0"
 using sin_gt_zero[of "y - pi"] ‹pi 🚫› and ‹y 🚫 * pi› sin_periodic_pi[of "y - pi"]
 by auto
 ultimately show False by auto
qed

lemma sin_ge_zero: "0 ≤ x ==> x ≤ pi ==> 0 ≤ sin x"
 by (auto simp: order_le_less sin_gt_zero)

lemma sin_le_zero: "pi ≤ x ==> x < 2 * pi ==> sin x ≤ 0"
 using sin_ge_zero [of "x - pi"] by (simp add: sin_diff)

lemma sin_pi_divide_n_ge_0 [simp]:
 assumes "n ≠ 0"
 shows "0 ≤ sin (pi/real n)"
 by (rule sin_ge_zero) (use assms in ‹simp_all add: field_split_simps›)

lemma sin_pi_divide_n_gt_0:
 assumes "2 ≤ n"
 shows "0 < sin (pi/real n)"
 by (rule sin_gt_zero) (use assms in ‹simp_all add: field_split_simps›)

text‹Proof resembles that of ‹cos_is_zero› but with 🍋‹pi› for the upper bound›
lemma cos_total:
 assumes y: "-1 ≤ y" "y ≤ 1"
 shows "∃!x. 0 ≤ x ∧ x ≤ pi ∧ cos x = y"
proof (rule ex_ex1I)
 show "∃x::real. 0 ≤ x ∧ x ≤ pi ∧ cos x = y"
 by (rule IVT2) (simp_all add: y)
next
 fix a b :: real
 assume ab: "0 ≤ a ∧ a ≤ pi ∧ cos a = y" "0 ≤ b ∧ b ≤ pi ∧ cos b = y"
 have cosd: "∧x::real. cos differentiable (at x)"
 unfolding real_differentiable_def by (auto intro: DERIV_cos)
 show "a = b"
 proof (cases a b rule: linorder_cases)
 case less
 then obtain z where "a < z" "z < b" "(cos has_real_derivative 0) (at z)"
 using Rolle by (metis cosd continuous_on_cos_real ab)
 then have "sin z = 0"
 using DERIV_cos DERIV_unique neg_equal_0_iff_equal by blast
 then show ?thesis
 by (metis ‹a 🚫› ‹z 🚫› ab order_less_le_trans less_le sin_gt_zero)
 next
 case greater
 then obtain z where "b < z" "z < a" "(cos has_real_derivative 0) (at z)"
 using Rolle by (metis cosd continuous_on_cos_real ab)
 then have "sin z = 0"
 using DERIV_cos DERIV_unique neg_equal_0_iff_equal by blast
 then show ?thesis
 by (metis ‹b 🚫› ‹z 🚫› ab order_less_le_trans less_le sin_gt_zero)
 qed auto
qed

lemma sin_total:
 assumes y: "-1 ≤ y" "y ≤ 1"
 shows "∃!x. - (pi/2) ≤ x ∧ x ≤ pi/2 ∧ sin x = y"
proof -
 from cos_total [OF y]
 obtain x where x: "0 ≤ x" "x ≤ pi" "cos x = y"
 and uniq: "∧x'. 0 ≤ x' ==> x' ≤ pi ==> cos x' = y ==> x' = x "
 by blast
 show ?thesis
 unfolding sin_cos_eq
 proof (rule ex1I [where a="pi/2 - x"])
 show "- (pi/2) ≤ z ∧ z ≤ pi/2 ∧ cos (of_real pi/2 - z) = y ==>
 z = pi/2 - x" for z
 using uniq [of "pi/2 -z"] by auto
 qed (use x in auto)
qed

lemma cos_zero_lemma:
 assumes "0 ≤ x" "cos x = 0"
 shows "∃n. odd n ∧ x = of_nat n * (pi/2)"
proof -
 have xle: "x < (1 + real_of_int ⌊x/pi⌋) * pi"
 using floor_correct [of "x/pi"]
 by (simp add: add.commute divide_less_eq)
 obtain n where "real n * pi ≤ x" "x < real (Suc n) * pi"
 proof
 show "real (nat ⌊x / pi⌋) * pi ≤ x"
 using assms floor_divide_lower [of pi x] by auto
 show "x < real (Suc (nat ⌊x / pi⌋)) * pi"
 using assms floor_divide_upper [of pi x] by (simp add: xle)
 qed
 then have x: "0 ≤ x - n * pi" "(x - n * pi) ≤ pi" "cos (x - n * pi) = 0"
 by (auto simp: algebra_simps cos_diff assms)
 then have "∃!x. 0 ≤ x ∧ x ≤ pi ∧ cos x = 0"
 by (auto simp: intro!: cos_total)
 then obtain θ where θ: "0 ≤ θ" "θ ≤ pi" "cos θ = 0"
 and uniq: "∧φ. 0 ≤ φ ==> φ ≤ pi ==> cos φ = 0 ==> φ = θ"
 by blast
 then have "x - real n * pi = θ"
 using x by blast
 moreover have "pi/2 = θ"
 using pi_half_ge_zero uniq by fastforce
 ultimately show ?thesis
 by (rule_tac x = "Suc (2 * n)" in exI) (simp add: algebra_simps)
qed

lemma sin_zero_lemma:
 assumes "0 ≤ x" "sin x = 0"
 shows "∃n::nat. even n ∧ x = real n * (pi/2)"
proof -
 obtain n where "odd n" and n: "x + pi/2 = of_nat n * (pi/2)" "n > 0"
 using cos_zero_lemma [of "x + pi/2"] assms by (auto simp add: cos_add)
 then have "x = real (n - 1) * (pi/2)"
 by (simp add: algebra_simps of_nat_diff)
 then show ?thesis
 by (simp add: ‹odd n›)
qed

lemma cos_zero_iff:
 "cos x = 0 ⟷ ((∃n. odd n ∧ x = real n * (pi/2)) ∨ (∃n. odd n ∧ x = - (real n * (pi/2))))"
 (is "?lhs = ?rhs")
proof -
 have *: "cos (real n * pi/2) = 0" if "odd n" for n :: nat
 proof -
 from that obtain m where "n = 2 * m + 1" ..
 then show ?thesis
 by (simp add: field_simps) (simp add: cos_add add_divide_distrib)
 qed
 show ?thesis
 proof
 show ?rhs if ?lhs
 using that cos_zero_lemma [of x] cos_zero_lemma [of "-x"] by force
 show ?lhs if ?rhs
 using that by (auto dest: * simp del: eq_divide_eq_numeral1)
 qed
qed

lemma sin_zero_iff:
 "sin x = 0 ⟷ ((∃n. even n ∧ x = real n * (pi/2)) ∨ (∃n. even n ∧ x = - (real n * (pi/2))))"
 (is "?lhs = ?rhs")
proof
 show ?rhs if ?lhs
 using that sin_zero_lemma [of x] sin_zero_lemma [of "-x"] by force
 show ?lhs if ?rhs
 using that by (auto elim: evenE)
qed

lemma sin_zero_pi_iff:
 fixes x::real
 assumes "∣x∣ < pi"
 shows "sin x = 0 ⟷ x = 0"
proof
 show "x = 0" if "sin x = 0"
 using that assms by (auto simp: sin_zero_iff)
qed auto

lemma cos_zero_iff_int: "cos x = 0 ⟷ (∃i. odd i ∧ x = of_int i * (pi/2))"
proof -
 have 1: "∧n. odd n ==> ∃i. odd i ∧ int n = i"
 by (metis even_of_nat_iff)
 have 2: "∧n. odd n ==> ∃i. odd i ∧ - (real n * pi) = real_of_int i * pi"
 by (metis even_minus even_of_nat_iff mult.commute mult_minus_right of_int_minus of_int_of_nat_eq)
 have 3: "[odd i; ∀n. even n ∨ i ≠ - (int n)] ==> ∃n. odd n ∧ i = int n" for i
 by (cases i rule: int_cases2) auto
 show ?thesis
 by (force simp: of_nat_of_int_iff cos_zero_iff intro!: 1 2 3)
qed

lemma sin_zero_iff_int: "sin x = 0 ⟷ (∃i. even i ∧ x = of_int i * (pi/2))" (is "?lhs = ?rhs")
proof safe
 assume ?lhs
 then consider (plus) n where "even n" "x = real n * (pi/2)" | (minus) n where "even n" "x = - (real n * (pi/2))"
 using sin_zero_iff by auto
 then show "∃n. even n ∧ x = of_int n * (pi/2)"
 proof cases
 case plus
 then show ?rhs
 by (metis even_of_nat_iff of_int_of_nat_eq)
 next
 case minus
 then show ?thesis
 by (rule_tac x="- (int n)" in exI) simp
 qed
next
 fix i :: int
 assume "even i"
 then show "sin (of_int i * (pi/2)) = 0"
 by (cases i rule: int_cases2, simp_all add: sin_zero_iff)
qed

lemma sin_zero_iff_int2: "sin x = 0 ⟷ (∃i::int. x = of_int i * pi)"
proof -
 have "sin x = 0 ⟷ (∃i. even i ∧ x = real_of_int i * (pi/2))"
 by (auto simp: sin_zero_iff_int)
 also have "... = (∃j. x = real_of_int (2*j) * (pi/2))"
 using dvd_triv_left by blast
 also have "... = (∃i::int. x = of_int i * pi)"
 by auto
 finally show ?thesis .
qed

lemma cos_zero_iff_int2:
 fixes x::real
 shows "cos x = 0 ⟷ (∃n::int. x = n * pi + pi/2)"
 using sin_zero_iff_int2[of "x-pi/2"] unfolding sin_cos_eq
 by (auto simp add: algebra_simps)

lemma sin_npi_int [simp]: "sin (pi * of_int n) = 0"
 by (simp add: sin_zero_iff_int2)

lemma cos_monotone_0_pi:
 assumes "0 ≤ y" and "y < x" and "x ≤ pi"
 shows "cos x < cos y"
proof -
 have "- (x - y) < 0" using assms by auto
 from MVT2[OF ‹y 🚫› DERIV_cos]
 obtain z where "y < z" and "z < x" and cos_diff: "cos x - cos y = (x - y) * - sin z"
 by auto
 then have "0 < z" and "z < pi"
 using assms by auto
 then have "0 < sin z"
 using sin_gt_zero by auto
 then have "cos x - cos y < 0"
 unfolding cos_diff minus_mult_commute[symmetric]
 using ‹- (x - y) 🚫›
 using mult_neg_pos by blast
 then show ?thesis by auto
qed

lemma cos_monotone_0_pi_le:
 assumes "0 ≤ y" and "y ≤ x" and "x ≤ pi"
 shows "cos x ≤ cos y"
proof (cases "y < x")
 case True
 show ?thesis
 using cos_monotone_0_pi[OF ‹0 ≤ y› True ‹x ≤ pi›] by auto
next
 case False
 then have "y = x" using ‹y ≤ x› by auto
 then show ?thesis by auto
qed

lemma cos_monotone_minus_pi_0:
 assumes "- pi ≤ y" and "y < x" and "x ≤ 0"
 shows "cos y < cos x"
proof -
 have "0 ≤ - x" and "- x < - y" and "- y ≤ pi"
 using assms by auto
 from cos_monotone_0_pi[OF this] show ?thesis
 unfolding cos_minus .
qed

lemma cos_monotone_minus_pi_0':
 assumes "- pi ≤ y" and "y ≤ x" and "x ≤ 0"
 shows "cos y ≤ cos x"
proof (cases "y < x")
 case True
 show ?thesis using cos_monotone_minus_pi_0[OF ‹-pi ≤ y› True ‹x ≤ 0›]
 by auto
next
 case False
 then have "y = x" using ‹y ≤ x› by auto
 then show ?thesis by auto
qed

lemma sin_monotone_2pi:
 assumes "- (pi/2) ≤ y" and "y < x" and "x ≤ pi/2"
 shows "sin y < sin x"
 unfolding sin_cos_eq
 using assms by (auto intro: cos_monotone_0_pi)

lemma sin_monotone_2pi_le:
 assumes "- (pi/2) ≤ y" and "y ≤ x" and "x ≤ pi/2"
 shows "sin y ≤ sin x"
 by (metis assms le_less sin_monotone_2pi)

lemma sin_x_le_x:
 fixes x :: real
 assumes "x ≥ 0"
 shows "sin x ≤ x"
proof -
 let ?f = "λx. x - sin x"
 have "∧u. [0 ≤ u; u ≤ x] ==> ∃y. (?f has_real_derivative 1 - cos u) (at u)"
 by (auto intro!: derivative_eq_intros simp: field_simps)
 then have "?f x ≥ ?f 0"
 by (metis cos_le_one diff_ge_0_iff_ge DERIV_nonneg_imp_nondecreasing [OF assms])
 then show "sin x ≤ x" by simp
qed

lemma sin_x_ge_neg_x:
 fixes x :: real
 assumes x: "x ≥ 0"
 shows "sin x ≥ - x"
proof -
 let ?f = "λx. x + sin x"
 have 🍋: "∧u. [0 ≤ u; u ≤ x] ==> ∃y. (?f has_real_derivative 1 + cos u) (at u)"
 by (auto intro!: derivative_eq_intros simp: field_simps)
 have "?f x ≥ ?f 0"
 by (rule DERIV_nonneg_imp_nondecreasing [OF assms]) (use 🍋 real_0_le_add_iff in force)
 then show "sin x ≥ -x" by simp
qed

lemma abs_sin_x_le_abs_x: "∣sin x∣ ≤ ∣x∣"
 for x :: real
 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"]
 by (auto simp: abs_real_def)

subsection ‹More Corollaries about Sine and Cosine›

lemma sin_cos_npi [simp]: "sin (real (Suc (2 * n)) * pi/2) = (-1) ^ n"
proof -
 have "sin ((real n + 1/2) * pi) = cos (real n * pi)"
 by (auto simp: algebra_simps sin_add)
 then show ?thesis
 by (simp add: distrib_right add_divide_distrib add.commute mult.commute [of pi])
qed

lemma cos_2npi [simp]: "cos (2 * real n * pi) = 1"
 for n :: nat
 by (cases "even n") (simp_all add: cos_double mult.assoc)

lemma cos_3over2_pi [simp]: "cos (3/2*pi) = 0"
proof -
 have "cos (3/2*pi) = cos (pi + pi/2)"
 by simp
 also have "... = 0"
 by (subst cos_add, simp)
 finally show ?thesis .
qed

lemma sin_2npi [simp]: "sin (2 * real n * pi) = 0"
 for n :: nat
 by (auto simp: mult.assoc sin_double)

lemma sin_3over2_pi [simp]: "sin (3/2*pi) = - 1"
proof -
 have "sin (3/2*pi) = sin (pi + pi/2)"
 by simp
 also have "... = -1"
 by (subst sin_add, simp)
 finally show ?thesis .
qed

lemma cos_pi_eq_zero [simp]: "cos (pi * real (Suc (2 * m)) / 2) = 0"
 by (simp only: cos_add sin_add of_nat_Suc distrib_right distrib_left add_divide_distrib, auto)

lemma DERIV_cos_add [simp]: "DERIV (λx. cos (x + k)) xa :> - sin (xa + k)"
 by (auto intro!: derivative_eq_intros)

lemma sin_zero_norm_cos_one:
 fixes x :: "'a::{real_normed_field,banach}"
 assumes "sin x = 0"
 shows "norm (cos x) = 1"
 using sin_cos_squared_add [of x, unfolded assms]
 by (simp add: square_norm_one)

lemma sin_zero_abs_cos_one: "sin x = 0 ==> ∣cos x∣ = (1::real)"
 using sin_zero_norm_cos_one by fastforce

lemma cos_one_sin_zero:
 fixes x :: "'a::{real_normed_field,banach}"
 assumes "cos x = 1"
 shows "sin x = 0"
 using sin_cos_squared_add [of x, unfolded assms]
 by simp

lemma sin_times_pi_eq_0: "sin (x * pi) = 0 ⟷ x ∈ ℤ"
 by (simp add: sin_zero_iff_int2) (metis Ints_cases Ints_of_int)

lemma cos_one_2pi: "cos x = 1 ⟷ (∃n::nat. x = n * 2 * pi) ∨ (∃n::nat. x = - (n * 2 * pi))"
 (is "?lhs = ?rhs")
proof
 assume ?lhs
 then have "sin x = 0"
 by (simp add: cos_one_sin_zero)
 then show ?rhs
 proof (simp only: sin_zero_iff, elim exE disjE conjE)
 fix n :: nat
 assume n: "even n" "x = real n * (pi/2)"
 then obtain m where m: "n = 2 * m"
 using dvdE by blast
 then have me: "even m" using ‹?lhs› n
 by (auto simp: field_simps) (metis one_neq_neg_one power_minus_odd power_one)
 show ?rhs
 using m me n
 by (auto simp: field_simps elim!: evenE)
 next
 fix n :: nat
 assume n: "even n" "x = - (real n * (pi/2))"
 then obtain m where m: "n = 2 * m"
 using dvdE by blast
 then have me: "even m" using ‹?lhs› n
 by (auto simp: field_simps) (metis one_neq_neg_one power_minus_odd power_one)
 show ?rhs
 using m me n
 by (auto simp: field_simps elim!: evenE)
 qed
next
 assume ?rhs
 then show "cos x = 1"
 by (metis cos_2npi cos_minus mult.assoc mult.left_commute)
qed

lemma cos_one_2pi_int: "cos x = 1 ⟷ (∃n::int. x = n * 2 * pi)" (is "?lhs = ?rhs")
proof
 assume "cos x = 1"
 then show ?rhs
 by (metis cos_one_2pi mult.commute mult_minus_right of_int_minus of_int_of_nat_eq)
next
 assume ?rhs
 then obtain i where "x = real_of_int i * 2 * pi"
 by blast
 then show "cos x = 1"
 using int_cases2 [of i]
 unfolding cos_one_2pi by fastforce
qed

lemma cos_npi_int [simp]:
 fixes n::int shows "cos (pi * of_int n) = (if even n then 1 else -1)"
 by (auto simp: algebra_simps cos_one_2pi_int elim!: oddE evenE)

lemma sin_cos_sqrt: "0 ≤ sin x ==> sin x = sqrt (1 - (cos(x) ^ 2))"
 using sin_squared_eq real_sqrt_unique by fastforce

lemma sin_eq_0_pi: "- pi < x ==> x < pi ==> sin x = 0 ==> x = 0"
 by (metis sin_gt_zero sin_minus minus_less_iff neg_0_less_iff_less not_less_iff_gr_or_eq)

lemma cos_treble_cos: "cos (3 * x) = 4 * cos x ^ 3 - 3 * cos x"
 for x :: "'a::{real_normed_field,banach}"
proof -
 have *: "(sin x * (sin x * 3)) = 3 - (cos x * (cos x * 3))"
 by (simp add: mult.assoc [symmetric] sin_squared_eq [unfolded power2_eq_square])
 have "cos(3 * x) = cos(2*x + x)"
 by simp
 also have "… = 4 * cos x ^ 3 - 3 * cos x"
 unfolding cos_add cos_double sin_double
 by (simp add: * field_simps power2_eq_square power3_eq_cube)
 finally show ?thesis .
qed

lemma cos_45: "cos (pi/4) = sqrt 2 / 2"
proof -
 let ?c = "cos (pi/4)"
 let ?s = "sin (pi/4)"
 have nonneg: "0 ≤ ?c"
 by (simp add: cos_ge_zero)
 have "0 = cos (pi/4 + pi/4)"
 by simp
 also have "cos (pi/4 + pi/4) = ?c🪙2 - ?s🪙2"
 by (simp only: cos_add power2_eq_square)
 also have "… = 2 * ?c🪙2 - 1"
 by (simp add: sin_squared_eq)
 finally have "?c🪙2 = (sqrt 2 / 2)🪙2"
 by (simp add: power_divide)
 then show ?thesis
 using nonneg by (rule power2_eq_imp_eq) simp
qed

lemma cos_30: "cos (pi/6) = sqrt 3/2"
proof -
 let ?c = "cos (pi/6)"
 let ?s = "sin (pi/6)"
 have pos_c: "0 < ?c"
 by (rule cos_gt_zero) simp_all
 have "0 = cos (pi/6 + pi/6 + pi/6)"
 by simp
 also have "… = (?c * ?c - ?s * ?s) * ?c - (?s * ?c + ?c * ?s) * ?s"
 by (simp only: cos_add sin_add)
 also have "… = ?c * (?c🪙2 - 3 * ?s🪙2)"
 by (simp add: algebra_simps power2_eq_square)
 finally have "?c🪙2 = (sqrt 3/2)🪙2"
 using pos_c by (simp add: sin_squared_eq power_divide)
 then show ?thesis
 using pos_c [THEN order_less_imp_le]
 by (rule power2_eq_imp_eq) simp
qed

lemma sin_45: "sin (pi/4) = sqrt 2 / 2"
 by (simp add: sin_cos_eq cos_45)

lemma sin_60: "sin (pi/3) = sqrt 3/2"
 by (simp add: sin_cos_eq cos_30)

lemma cos_60: "cos (pi/3) = 1/2"
proof -
 have "0 ≤ cos (pi/3)"
 by (rule cos_ge_zero) (use pi_half_ge_zero in ‹linarith+›)
 then show ?thesis
 by (simp add: cos_squared_eq sin_60 power_divide power2_eq_imp_eq)
qed

lemma sin_30: "sin (pi/6) = 1/2"
 by (simp add: sin_cos_eq cos_60)

lemma cos_120: "cos (2 * pi/3) = -1/2"
 and sin_120: "sin (2 * pi/3) = sqrt 3 / 2"
 using sin_double[of "pi/3"] cos_double[of "pi/3"]
 by (simp_all add: power2_eq_square sin_60 cos_60)

lemma cos_120': "cos (pi * 2 / 3) = -1/2"
 using cos_120 by (subst mult.commute)

lemma sin_120': "sin (pi * 2 / 3) = sqrt 3 / 2"
 using sin_120 by (subst mult.commute)

lemma cos_integer_2pi: "n ∈ ℤ ==> cos(2 * pi * n) = 1"
 by (metis Ints_cases cos_one_2pi_int mult.assoc mult.commute)

lemma sin_integer_2pi: "n ∈ ℤ ==> sin(2 * pi * n) = 0"
 by (metis sin_two_pi Ints_mult mult.assoc mult.commute sin_times_pi_eq_0)

lemma cos_int_2pin [simp]: "cos ((2 * pi) * of_int n) = 1"
 by (simp add: cos_one_2pi_int)

lemma sin_int_2pin [simp]: "sin ((2 * pi) * of_int n) = 0"
 by (metis Ints_of_int sin_integer_2pi)

lemma sin_cos_eq_iff: "sin y = sin x ∧ cos y = cos x ⟷ (∃n::int. y = x + 2 * pi * n)" (is "?L=?R")
proof
 assume ?L
 then have "cos (y-x) = 1"
 using cos_add [of y "-x"] by simp
 then show ?R
 by (metis cos_one_2pi_int add.commute diff_add_cancel mult.assoc mult.commute)
next
 assume ?R
 then show ?L
 by (auto simp: sin_add cos_add)
qed

lemma sincos_principal_value: "∃y. (- pi < y ∧ y ≤ pi) ∧ (sin y = sin x ∧ cos y = cos x)"
proof -
 define y where "y ≡ pi - (2 * pi) * frac ((pi - x) / (2 * pi))"
 have "-pi < y"" y ≤ pi"
 by (auto simp: field_simps frac_lt_1 y_def)
 moreover
 have "sin y = sin x" "cos y = cos x"
 by (simp_all add: y_def frac_def divide_simps sin_add cos_add mult_of_int_commute)
 ultimately
 show ?thesis by metis
qed

subsection ‹Tangent›

definition tan :: "'a ==> 'a::{real_normed_field,banach}"
 where "tan = (λx. sin x / cos x)"

lemma tan_of_real: "of_real (tan x) = (tan (of_real x) :: 'a::{real_normed_field,banach})"
 by (simp add: tan_def sin_of_real cos_of_real)

lemma tan_in_Reals [simp]: "z ∈ ℝ ==> tan z ∈ ℝ"
 for z :: "'a::{real_normed_field,banach}"
 by (simp add: tan_def)

lemma tan_zero [simp]: "tan 0 = 0"
 by (simp add: tan_def)

lemma tan_pi [simp]: "tan pi = 0"
 by (simp add: tan_def)

lemma tan_npi [simp]: "tan (real n * pi) = 0"
 for n :: nat
 by (simp add: tan_def)

lemma tan_pi_half [simp]: "tan (pi / 2) = 0"
 by (simp add: tan_def)

lemma tan_minus [simp]: "tan (- x) = - tan x"
 by (simp add: tan_def)

lemma tan_periodic [simp]: "tan (x + 2 * pi) = tan x"
 by (simp add: tan_def)

lemma lemma_tan_add1: "cos x ≠ 0 ==> cos y ≠ 0 ==> 1 - tan x * tan y = cos (x + y)/(cos x * cos y)"
 by (simp add: tan_def cos_add field_simps)

lemma add_tan_eq: "cos x ≠ 0 ==> cos y ≠ 0 ==> tan x + tan y = sin(x + y)/(cos x * cos y)"
 for x :: "'a::{real_normed_field,banach}"
 by (simp add: tan_def sin_add field_simps)

lemma tan_eq_0_cos_sin: "tan x = 0 ⟷ cos x = 0 ∨ sin x = 0"
 by (auto simp: tan_def)

text ‹Note: half of these zeros would normally be regarded as undefined cases.›
lemma tan_eq_0_Ex:
 assumes "tan x = 0"
 obtains k::int where "x = (k/2) * pi"
 using assms
 by (metis cos_zero_iff_int mult.commute sin_zero_iff_int tan_eq_0_cos_sin times_divide_eq_left)

lemma tan_add:
 "cos x ≠ 0 ==> cos y ≠ 0 ==> cos (x + y) ≠ 0 ==> tan (x + y) = (tan x + tan y)/(1 - tan x * tan y)"
 for x :: "'a::{real_normed_field,banach}"
 by (simp add: add_tan_eq lemma_tan_add1 field_simps) (simp add: tan_def)

lemma tan_double: "cos x ≠ 0 ==> cos (2 * x) ≠ 0 ==> tan (2 * x) = (2 * tan x) / (1 - (tan x)🪙2)"
 for x :: "'a::{real_normed_field,banach}"
 using tan_add [of x x] by (simp add: power2_eq_square)

lemma tan_gt_zero: "0 < x ==> x < pi/2 ==> 0 < tan x"
 by (simp add: tan_def zero_less_divide_iff sin_gt_zero2 cos_gt_zero_pi)

lemma tan_less_zero:
 assumes "- pi/2 < x" and "x < 0"
 shows "tan x < 0"
proof -
 have "0 < tan (- x)"
 using assms by (simp only: tan_gt_zero)
 then show ?thesis by simp
qed

lemma tan_half: "tan x = sin (2 * x) / (cos (2 * x) + 1)"
 for x :: "'a::{real_normed_field,banach,field}"
 unfolding tan_def sin_double cos_double sin_squared_eq
 by (simp add: power2_eq_square)

lemma tan_30: "tan (pi/6) = 1 / sqrt 3"
 unfolding tan_def by (simp add: sin_30 cos_30)

lemma tan_45: "tan (pi/4) = 1"
 unfolding tan_def by (simp add: sin_45 cos_45)

lemma tan_60: "tan (pi/3) = sqrt 3"
 unfolding tan_def by (simp add: sin_60 cos_60)

lemma DERIV_tan [simp]: "cos x ≠ 0 ==> DERIV tan x :> inverse ((cos x)🪙2)"
 for x :: "'a::{real_normed_field,banach}"
 unfolding tan_def
 by (auto intro!: derivative_eq_intros, simp add: divide_inverse power2_eq_square)

declare DERIV_tan[THEN DERIV_chain2, derivative_intros]
 and DERIV_tan[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]

lemmas has_derivative_tan[derivative_intros] = DERIV_tan[THEN DERIV_compose_FDERIV]

lemma isCont_tan: "cos x ≠ 0 ==> isCont tan x"
 for x :: "'a::{real_normed_field,banach}"
 by (rule DERIV_tan [THEN DERIV_isCont])

lemma isCont_tan' [simp,continuous_intros]:
 fixes a :: "'a::{real_normed_field,banach}" and f :: "'a ==> 'a"
 shows "isCont f a ==> cos (f a) ≠ 0 ==> isCont (λx. tan (f x)) a"
 by (rule isCont_o2 [OF _ isCont_tan])

lemma tendsto_tan [tendsto_intros]:
 fixes f :: "'a ==> 'a::{real_normed_field,banach}"
 shows "(f ---> a) F ==> cos a ≠ 0 ==> ((λx. tan (f x)) ---> tan a) F"
 by (rule isCont_tendsto_compose [OF isCont_tan])

lemma continuous_tan:
 fixes f :: "'a ==> 'a::{real_normed_field,banach}"
 shows "continuous F f ==> cos (f (Lim F (λx. x))) ≠ 0 ==> continuous F (λx. tan (f x))"
 unfolding continuous_def by (rule tendsto_tan)

lemma continuous_on_tan [continuous_intros]:
 fixes f :: "'a ==> 'a::{real_normed_field,banach}"
 shows "continuous_on s f ==> (∀x∈s. cos (f x) ≠ 0) ==> continuous_on s (λx. tan (f x))"
 unfolding continuous_on_def by (auto intro: tendsto_tan)

lemma continuous_within_tan [continuous_intros]:
 fixes f :: "'a ==> 'a::{real_normed_field,banach}"
 shows "continuous (at x within s) f ==>
 cos (f x) ≠ 0 ==> continuous (at x within s) (λx. tan (f x))"
 unfolding continuous_within by (rule tendsto_tan)

lemma LIM_cos_div_sin: "(λx. cos(x)/sin(x)) ←-pi/2→ 0"
 by (rule tendsto_cong_limit, (rule tendsto_intros)+, simp_all)

lemma lemma_tan_total:
 assumes "0 < y" shows "∃x. 0 < x ∧ x < pi/2 ∧ y < tan x"
proof -
 obtain s where "0 < s"
 and s: "∧x. [x ≠ pi/2; norm (x - pi/2) < s] ==> norm (cos x / sin x - 0) < inverse y"
 using LIM_D [OF LIM_cos_div_sin, of "inverse y"] that assms by force
 obtain e where e: "0 < e" "e < s" "e < pi/2"
 using ‹0 🚫› field_lbound_gt_zero pi_half_gt_zero by blast
 show ?thesis
 proof (intro exI conjI)
 have "0 < sin e" "0 < cos e"
 using e by (auto intro: cos_gt_zero sin_gt_zero2 simp: mult.commute)
 then
 show "y < tan (pi/2 - e)"
 using s [of "pi/2 - e"] e assms
 by (simp add: tan_def sin_diff cos_diff) (simp add: field_simps split: if_split_asm)
 qed (use e in auto)
qed

lemma tan_total_pos:
 assumes "0 ≤ y" shows "∃x. 0 ≤ x ∧ x < pi/2 ∧ tan x = y"
proof (cases "y = 0")
 case True
 then show ?thesis
 using pi_half_gt_zero tan_zero by blast
next
 case False
 with assms have "y > 0"
 by linarith
 obtain x where x: "0 < x" "x < pi/2" "y < tan x"
 using lemma_tan_total ‹0 🚫› by blast
 have "∃u≥0. u ≤ x ∧ tan u = y"
 proof (intro IVT allI impI)
 show "isCont tan u" if "0 ≤ u ∧ u ≤ x" for u
 proof -
 have "cos u ≠ 0"
 using antisym_conv2 cos_gt_zero that x(2) by fastforce
 with assms show ?thesis
 by (auto intro!: DERIV_tan [THEN DERIV_isCont])
 qed
 qed (use assms x in auto)
 then show ?thesis
 using x(2) by auto
qed

lemma lemma_tan_total1: "∃x. -(pi/2) < x ∧ x < (pi/2) ∧ tan x = y"
proof (cases "0::real" y rule: le_cases)
 case le
 then show ?thesis
 by (meson less_le_trans minus_pi_half_less_zero tan_total_pos)
next
 case ge
 with tan_total_pos [of "-y"] obtain x where "0 ≤ x" "x < pi/2" "tan x = - y"
 by force
 then show ?thesis
 by (rule_tac x="-x" in exI) auto
qed

proposition tan_total: "∃! x. -(pi/2) < x ∧ x < (pi/2) ∧ tan x = y"
proof -
 have "u = v" if u: "- (pi/2) < u" "u < pi/2" and v: "- (pi/2) < v" "v < pi/2"
 and eq: "tan u = tan v" for u v
 proof (cases u v rule: linorder_cases)
 case less
 have "∧x. u ≤ x ∧ x ≤ v ⟶ isCont tan x"
 by (metis cos_gt_zero_pi isCont_tan le_less_trans less_irrefl less_le_trans u(1) v(2))
 then have "continuous_on {u..v} tan"
 by (simp add: continuous_at_imp_continuous_on)
 moreover have "∧x. u < x ∧ x < v ==> tan differentiable (at x)"
 by (metis DERIV_tan cos_gt_zero_pi real_differentiable_def less_numeral_extra(3) order.strict_trans u(1) v(2))
 ultimately obtain z where "u < z" "z < v" "DERIV tan z :> 0"
 by (metis less Rolle eq)
 moreover have "cos z ≠ 0"
 by (metis (no_types) ‹u 🚫› ‹z 🚫› cos_gt_zero_pi less_le_trans linorder_not_less not_less_iff_gr_or_eq u(1) v(2))
 ultimately show ?thesis
 using DERIV_unique [OF _ DERIV_tan] by fastforce
 next
 case greater
 have "∧x. v ≤ x ∧ x ≤ u ==> isCont tan x"
 by (metis cos_gt_zero_pi isCont_tan le_less_trans less_irrefl less_le_trans u(2) v(1))
 then have "continuous_on {v..u} tan"
 by (simp add: continuous_at_imp_continuous_on)
 moreover have "∧x. v < x ∧ x tan differentiable (at x)"
 by (metis DERIV_tan cos_gt_zero_pi real_differentiable_def less_numeral_extra(3) order.strict_trans u(2) v(1))
 ultimately obtain z where "v < z" "z < u" "DERIV tan z :> 0"
 by (metis greater Rolle eq)
 moreover have "cos z ≠ 0"
 by (metis ‹v 🚫› ‹z 🚫› cos_gt_zero_pi less_eq_real_def less_le_trans order_less_irrefl u(2) v(1))
 ultimately show ?thesis
 using DERIV_unique [OF _ DERIV_tan] by fastforce
 qed auto
 then have "∃!x. - (pi/2) < x ∧ x < pi/2 ∧ tan x = y"
 if x: "- (pi/2) < x" "x < pi/2" "tan x = y" for x
 using that by auto
 then show ?thesis
 using lemma_tan_total1 [where y = y]
 by auto
qed

lemma tan_monotone:
 assumes "- (pi/2) < y" and "y < x" and "x < pi/2"
 shows "tan y < tan x"
proof -
 have "DERIV tan x' :> inverse ((cos x')🪙2)" if "y ≤ x'" "x' ≤ x" for x'
 proof -
 have "-(pi/2) < x'" and "x' < pi/2"
 using that assms by auto
 with cos_gt_zero_pi have "cos x' ≠ 0" by force
 then show "DERIV tan x' :> inverse ((cos x')🪙2)"
 by (rule DERIV_tan)
 qed
 from MVT2[OF ‹y 🚫› this]
 obtain z where "y < z" and "z < x"
 and tan_diff: "tan x - tan y = (x - y) * inverse ((cos z)🪙2)" by auto
 then have "- (pi/2) < z" and "z < pi/2"
 using assms by auto
 then have "0 < cos z"
 using cos_gt_zero_pi by auto
 then have inv_pos: "0 < inverse ((cos z)🪙2)"
 by auto
 have "0 < x - y" using ‹y 🚫› by auto
 with inv_pos have "0 < tan x - tan y"
 unfolding tan_diff by auto
 then show ?thesis by auto
qed

lemma tan_monotone':
 assumes "- (pi/2) < y"
 and "y < pi/2"
 and "- (pi/2) < x"
 and "x < pi/2"
 shows "y < x ⟷ tan y < tan x"
proof
 assume "y < x"
 then show "tan y < tan x"
 using tan_monotone and ‹- (pi/2) 🚫› and ‹x 🚫/2› by auto
next
 assume "tan y < tan x"
 show "y < x"
 proof (rule ccontr)
 assume "¬ ?thesis"
 then have "x ≤ y" by auto
 then have "tan x ≤ tan y"
 proof (cases "x = y")
 case True
 then show ?thesis by auto
 next
 case False
 then have "x < y" using ‹x ≤ y› by auto
 from tan_monotone[OF ‹- (pi/2) 🚫› this ‹y 🚫/2›] show ?thesis
 by auto
 qed
 then show False
 using ‹tan y 🚫 x› by auto
 qed
qed

lemma tan_inverse: "1 / (tan y) = tan (pi/2 - y)"
 unfolding tan_def sin_cos_eq[of y] cos_sin_eq[of y] by auto

lemma tan_periodic_pi[simp]: "tan (x + pi) = tan x"
 by (simp add: tan_def)

lemma tan_periodic_nat[simp]: "tan (x + real n * pi) = tan x"
proof (induct n arbitrary: x)
 case 0
 then show ?case by simp
next
 case (Suc n)
 have split_pi_off: "x + real (Suc n) * pi = (x + real n * pi) + pi"
 unfolding Suc_eq_plus1 of_nat_add distrib_right by auto
 show ?case
 unfolding split_pi_off using Suc by auto
qed

lemma tan_periodic_int[simp]: "tan (x + of_int i * pi) = tan x"
proof (cases "0 ≤ i")
 case False
 then have i_nat: "of_int i = - of_int (nat (- i))" by auto
 then show ?thesis
 by (smt (verit, best) mult_minus_left of_int_of_nat_eq tan_periodic_nat)
qed (use zero_le_imp_eq_int in fastforce)

lemma tan_periodic_n[simp]: "tan (x + numeral n * pi) = tan x"
 using tan_periodic_int[of _ "numeral n" ] by simp

lemma tan_minus_45 [simp]: "tan (-(pi/4)) = -1"
 unfolding tan_def by (simp add: sin_45 cos_45)

lemma tan_diff:
 "cos x ≠ 0 ==> cos y ≠ 0 ==> cos (x - y) ≠ 0 ==> tan (x - y) = (tan x - tan y)/(1 + tan x * tan y)"
 for x :: "'a::{real_normed_field,banach}"
 using tan_add [of x "-y"] by simp

lemma tan_pos_pi2_le: "0 ≤ x ==> x < pi/2 ==> 0 ≤ tan x"
 using less_eq_real_def tan_gt_zero by auto

lemma cos_tan: "∣x∣ < pi/2 ==> cos x = 1 / sqrt (1 + tan x ^ 2)"
 using cos_gt_zero_pi [of x]
 by (simp add: field_split_simps tan_def real_sqrt_divide abs_if split: if_split_asm)

lemma cos_tan_half: "cos x ≠0 ==> cos (2*x) = (1 - (tan x)^2) / (1 + (tan x)^2)"
 unfolding cos_double tan_def by (auto simp add:field_simps )

lemma sin_tan: "∣x∣ < pi/2 ==> sin x = tan x / sqrt (1 + tan x ^ 2)"
 using cos_gt_zero [of "x"] cos_gt_zero [of "-x"]
 by (force simp: field_split_simps tan_def real_sqrt_divide abs_if split: if_split_asm)

lemma sin_tan_half: "sin (2*x) = 2 * tan x / (1 + (tan x)^2)"
 unfolding sin_double tan_def
 by (cases "cos x=0") (auto simp add:field_simps power2_eq_square)

lemma tan_mono_le: "-(pi/2) < x ==> x ≤ y ==> y < pi/2 ==> tan x ≤ tan y"
 using less_eq_real_def tan_monotone by auto

lemma tan_mono_lt_eq:
 "-(pi/2) < x ==> x < pi/2 ==> -(pi/2) < y ==> y < pi/2 ==> tan x < tan y ⟷ x < y"
 using tan_monotone' by blast

lemma tan_mono_le_eq:
 "-(pi/2) < x ==> x < pi/2 ==> -(pi/2) < y ==> y < pi/2 ==> tan x ≤ tan y ⟷ x ≤ y"
 by (meson tan_mono_le not_le tan_monotone)

lemma tan_bound_pi2: "∣x∣ < pi/4 ==> ∣tan x∣ < 1"
 using tan_45 tan_monotone [of x "pi/4"] tan_monotone [of "-x" "pi/4"]
 by (auto simp: abs_if split: if_split_asm)

lemma tan_cot: "tan(pi/2 - x) = inverse(tan x)"
 by (simp add: tan_def sin_diff cos_diff)

subsection ‹Cotangent›

definition cot :: "'a ==> 'a::{real_normed_field,banach}"
 where "cot = (λx. cos x / sin x)"

lemma cot_of_real: "of_real (cot x) = (cot (of_real x) :: 'a::{real_normed_field,banach})"
 by (simp add: cot_def sin_of_real cos_of_real)

lemma cot_in_Reals [simp]: "z ∈ ℝ ==> cot z ∈ ℝ"
 for z :: "'a::{real_normed_field,banach}"
 by (simp add: cot_def)

lemma cot_zero [simp]: "cot 0 = 0"
 by (simp add: cot_def)

lemma cot_pi [simp]: "cot pi = 0"
 by (simp add: cot_def)

lemma cot_npi [simp]: "cot (real n * pi) = 0"
 for n :: nat
 by (simp add: cot_def)

lemma cot_minus [simp]: "cot (- x) = - cot x"
 by (simp add: cot_def)

lemma cot_periodic [simp]: "cot (x + 2 * pi) = cot x"
 by (simp add: cot_def)

lemma cot_altdef: "cot x = inverse (tan x)"
 by (simp add: cot_def tan_def)

lemma tan_altdef: "tan x = inverse (cot x)"
 by (simp add: cot_def tan_def)

lemma tan_cot': "tan (pi/2 - x) = cot x"
 by (simp add: tan_cot cot_altdef)

lemma cot_gt_zero: "0 < x ==> x < pi/2 ==> 0 < cot x"
 by (simp add: cot_def zero_less_divide_iff sin_gt_zero2 cos_gt_zero_pi)

lemma cot_less_zero:
 assumes lb: "- pi/2 < x" and "x < 0"
 shows "cot x < 0"
 by (smt (verit) assms cot_gt_zero cot_minus divide_minus_left)

lemma DERIV_cot [simp]: "sin x ≠ 0 ==> DERIV cot x :> -inverse ((sin x)🪙2)"
 for x :: "'a::{real_normed_field,banach}"
 unfolding cot_def using cos_squared_eq[of x]
 by (auto intro!: derivative_eq_intros) (simp add: divide_inverse power2_eq_square)

lemma isCont_cot: "sin x ≠ 0 ==> isCont cot x"
 for x :: "'a::{real_normed_field,banach}"
 by (rule DERIV_cot [THEN DERIV_isCont])

lemma isCont_cot' [simp,continuous_intros]:
 "isCont f a ==> sin (f a) ≠ 0 ==> isCont (λx. cot (f x)) a"
 for a :: "'a::{real_normed_field,banach}" and f :: "'a ==> 'a"
 by (rule isCont_o2 [OF _ isCont_cot])

lemma tendsto_cot [tendsto_intros]: "(f ---> a) F ==> sin a ≠ 0 ==> ((λx. cot (f x)) ---> cot a) F"
 for f :: "'a ==> 'a::{real_normed_field,banach}"
 by (rule isCont_tendsto_compose [OF isCont_cot])

lemma continuous_cot:
 "continuous F f ==> sin (f (Lim F (λx. x))) ≠ 0 ==> continuous F (λx. cot (f x))"
 for f :: "'a ==> 'a::{real_normed_field,banach}"
 unfolding continuous_def by (rule tendsto_cot)

lemma continuous_on_cot [continuous_intros]:
 fixes f :: "'a ==> 'a::{real_normed_field,banach}"
 shows "continuous_on s f ==> (∀x∈s. sin (f x) ≠ 0) ==> continuous_on s (λx. cot (f x))"
 unfolding continuous_on_def by (auto intro: tendsto_cot)

lemma continuous_within_cot [continuous_intros]:
 fixes f :: "'a ==> 'a::{real_normed_field,banach}"
 shows "continuous (at x within s) f ==> sin (f x) ≠ 0 ==> continuous (at x within s) (λx. cot (f x))"
 unfolding continuous_within by (rule tendsto_cot)

subsection ‹Inverse Trigonometric Functions›

definition arcsin :: "real ==> real"
 where "arcsin y = (THE x. -(pi/2) ≤ x ∧ x ≤ pi/2 ∧ sin x = y)"

definition arccos :: "real ==> real"
 where "arccos y = (THE x. 0 ≤ x ∧ x ≤ pi ∧ cos x = y)"

definition arctan :: "real ==> real"
 where "arctan y = (THE x. -(pi/2) < x ∧ x < pi/2 ∧ tan x = y)"

lemma arcsin: "- 1 ≤ y ==> y ≤ 1 ==> - (pi/2) ≤ arcsin y ∧ arcsin y ≤ pi/2 ∧ sin (arcsin y) = y"
 unfolding arcsin_def by (rule theI' [OF sin_total])

lemma arcsin_pi: "- 1 ≤ y ==> y ≤ 1 ==> - (pi/2) ≤ arcsin y ∧ arcsin y ≤ pi ∧ sin (arcsin y) = y"
 by (drule (1) arcsin) (force intro: order_trans)

lemma sin_arcsin [simp]: "- 1 ≤ y ==> y ≤ 1 ==> sin (arcsin y) = y"
 by (blast dest: arcsin)

lemma arcsin_bounded: "- 1 ≤ y ==> y ≤ 1 ==> - (pi/2) ≤ arcsin y ∧ arcsin y ≤ pi/2"
 by (blast dest: arcsin)

lemma arcsin_lbound: "- 1 ≤ y ==> y ≤ 1 ==> - (pi/2) ≤ arcsin y"
 by (blast dest: arcsin)

lemma arcsin_ubound: "- 1 ≤ y ==> y ≤ 1 ==> arcsin y ≤ pi/2"
 by (blast dest: arcsin)

lemma arcsin_lt_bounded:
 assumes "- 1 < y" "y < 1"
 shows "- (pi/2) < arcsin y ∧ arcsin y < pi/2"
proof -
 have "arcsin y ≠ pi/2"
 by (metis arcsin assms not_less not_less_iff_gr_or_eq sin_pi_half)
 moreover have "arcsin y ≠ - pi/2"
 by (metis arcsin assms minus_divide_left not_less not_less_iff_gr_or_eq sin_minus sin_pi_half)
 ultimately show ?thesis
 using arcsin_bounded [of y] assms by auto
qed

lemma arcsin_sin: "- (pi/2) ≤ x ==> x ≤ pi/2 ==> arcsin (sin x) = x"
 unfolding arcsin_def
 using the1_equality [OF sin_total] by simp

lemma arcsin_unique:
 assumes "-pi/2 ≤ x" and "x ≤ pi/2" and "sin x = y" shows "arcsin y = x"
 using arcsin_sin[of x] assms by force

lemma arcsin_0 [simp]: "arcsin 0 = 0"
 using arcsin_sin [of 0] by simp

lemma arcsin_1 [simp]: "arcsin 1 = pi/2"
 using arcsin_sin [of "pi/2"] by simp

lemma arcsin_minus_1 [simp]: "arcsin (- 1) = - (pi/2)"
 using arcsin_sin [of "- pi/2"] by simp

lemma arcsin_minus: "- 1 ≤ x ==> x ≤ 1 ==> arcsin (- x) = - arcsin x"
 by (metis (no_types, opaque_lifting) arcsin arcsin_sin minus_minus neg_le_iff_le sin_minus)

lemma arcsin_one_half [simp]: "arcsin (1/2) = pi / 6"
 and arcsin_minus_one_half [simp]: "arcsin (-(1/2)) = -pi / 6"
 by (intro arcsin_unique; simp add: sin_30 field_simps)+

lemma arcsin_one_over_sqrt_2: "arcsin (1 / sqrt 2) = pi / 4"
 by (rule arcsin_unique) (auto simp: sin_45 field_simps)

lemma arcsin_eq_iff: "∣x∣ ≤ 1 ==> ∣y∣ ≤ 1 ==> arcsin x = arcsin y ⟷ x = y"
 by (metis abs_le_iff arcsin minus_le_iff)

lemma cos_arcsin_nonzero: "- 1 < x ==> x < 1 ==> cos (arcsin x) ≠ 0"
 using arcsin_lt_bounded cos_gt_zero_pi by force

lemma arccos: "- 1 ≤ y ==> y ≤ 1 ==> 0 ≤ arccos y ∧ arccos y ≤ pi ∧ cos (arccos y) = y"
 unfolding arccos_def by (rule theI' [OF cos_total])

lemma cos_arccos [simp]: "- 1 ≤ y ==> y ≤ 1 ==> cos (arccos y) = y"
 by (blast dest: arccos)

lemma arccos_bounded: "- 1 ≤ y ==> y ≤ 1 ==> 0 ≤ arccos y ∧ arccos y ≤ pi"
 by (blast dest: arccos)

lemma arccos_lbound: "- 1 ≤ y ==> y ≤ 1 ==> 0 ≤ arccos y"
 by (blast dest: arccos)

lemma arccos_ubound: "- 1 ≤ y ==> y ≤ 1 ==> arccos y ≤ pi"
 by (blast dest: arccos)

lemma arccos_lt_bounded:
 assumes "- 1 < y" "y < 1"
 shows "0 < arccos y ∧ arccos y < pi"
proof -
 have "arccos y ≠ 0"
 by (metis (no_types) arccos assms(1) assms(2) cos_zero less_eq_real_def less_irrefl)
 moreover have "arccos y ≠ -pi"
 by (metis arccos assms(1) assms(2) cos_minus cos_pi not_less not_less_iff_gr_or_eq)
 ultimately show ?thesis
 using arccos_bounded [of y] assms
 by (metis arccos cos_pi not_less not_less_iff_gr_or_eq)
qed

lemma arccos_cos: "0 ≤ x ==> x ≤ pi ==> arccos (cos x) = x"
 by (auto simp: arccos_def intro!: the1_equality cos_total)

lemma arccos_cos2: "x ≤ 0 ==> - pi ≤ x ==> arccos (cos x) = -x"
 by (auto simp: arccos_def intro!: the1_equality cos_total)

lemma arccos_unique:
 assumes "0 ≤ x" and "x ≤ pi" and "cos x = y" shows "arccos y = x"
 using arccos_cos assms by blast

lemma cos_arcsin:
 assumes "- 1 ≤ x" "x ≤ 1"
 shows "cos (arcsin x) = sqrt (1 - x🪙2)"
proof (rule power2_eq_imp_eq)
 show "(cos (arcsin x))🪙2 = (sqrt (1 - x🪙2))🪙2"
 by (simp add: square_le_1 assms cos_squared_eq)
 show "0 ≤ cos (arcsin x)"
 using arcsin assms cos_ge_zero by blast
 show "0 ≤ sqrt (1 - x🪙2)"
 by (simp add: square_le_1 assms)
qed

lemma sin_arccos:
 assumes "- 1 ≤ x" "x ≤ 1"
 shows "sin (arccos x) = sqrt (1 - x🪙2)"
proof (rule power2_eq_imp_eq)
 show "(sin (arccos x))🪙2 = (sqrt (1 - x🪙2))🪙2"
 by (simp add: square_le_1 assms sin_squared_eq)
 show "0 ≤ sin (arccos x)"
 by (simp add: arccos_bounded assms sin_ge_zero)
 show "0 ≤ sqrt (1 - x🪙2)"
 by (simp add: square_le_1 assms)
qed

lemma arccos_0 [simp]: "arccos 0 = pi/2"
 using arccos_cos pi_half_ge_zero by fastforce

lemma arccos_1 [simp]: "arccos 1 = 0"
 using arccos_cos by force

lemma arccos_minus_1 [simp]: "arccos (- 1) = pi"
 by (metis arccos_cos cos_pi order_refl pi_ge_zero)

lemma arccos_minus: "-1 ≤ x ==> x ≤ 1 ==> arccos (- x) = pi - arccos x"
 by (smt (verit, ccfv_threshold) arccos arccos_cos cos_minus cos_minus_pi)

lemma arccos_one_half [simp]: "arccos (1/2) = pi / 3"
 and arccos_minus_one_half [simp]: "arccos (-(1/2)) = 2 * pi / 3"
 by (intro arccos_unique; simp add: cos_60 cos_120)+

lemma arccos_one_over_sqrt_2: "arccos (1 / sqrt 2) = pi / 4"
 by (rule arccos_unique) (auto simp: cos_45 field_simps)

corollary arccos_minus_abs:
 assumes "∣x∣ ≤ 1"
 shows "arccos (- x) = pi - arccos x"
using assms by (simp add: arccos_minus)

lemma sin_arccos_nonzero: "- 1 < x ==> x < 1 ==> sin (arccos x) ≠ 0"
 using arccos_lt_bounded sin_gt_zero by force

lemma arctan: "- (pi/2) < arctan y ∧ arctan y < pi/2 ∧ tan (arctan y) = y"
 unfolding arctan_def by (rule theI' [OF tan_total])

lemma tan_arctan: "tan (arctan y) = y"
 by (simp add: arctan)

lemma arctan_bounded: "- (pi/2) < arctan y ∧ arctan y < pi/2"
 by (auto simp only: arctan)

lemma arctan_lbound: "- (pi/2) < arctan y"
 by (simp add: arctan)

lemma arctan_ubound: "arctan y < pi/2"
 by (auto simp only: arctan)

lemma arctan_unique:
 assumes "-(pi/2) < x"
 and "x < pi/2"
 and "tan x = y"
 shows "arctan y = x"
 using assms arctan [of y] tan_total [of y] by (fast elim: ex1E)

lemma arctan_tan: "-(pi/2) < x ==> x < pi/2 ==> arctan (tan x) = x"
 by (rule arctan_unique) simp_all

lemma arctan_zero_zero [simp]: "arctan 0 = 0"
 by (rule arctan_unique) simp_all

lemma arctan_minus: "arctan (- x) = - arctan x"
 using arctan [of "x"] by (auto simp: arctan_unique)

lemma cos_arctan_not_zero [simp]: "cos (arctan x) ≠ 0"
 by (intro less_imp_neq [symmetric] cos_gt_zero_pi arctan_lbound arctan_ubound)

lemma tan_eq_arctan_Ex:
 shows "tan x = y ⟷ (∃k::int. x = arctan y + k*pi ∨ (x = pi/2 + k*pi ∧ y=0))"
proof
 assume lhs: "tan x = y"
 obtain k::int where k:"-pi/2 < x-k*pi" "x-k*pi ≤ pi/2"
 proof
 define k where "k ≡ ceiling (x/pi - 1/2)"
 show "- pi / 2 < x - real_of_int k * pi"
 using ceiling_divide_lower [of "pi*2" "(x * 2 - pi)"] by (auto simp: k_def field_simps)
 show "x-k*pi ≤ pi/2"
 using ceiling_divide_upper [of "pi*2" "(x * 2 - pi)"] by (auto simp: k_def field_simps)
 qed
 have "x = arctan y + of_int k * pi" when "x ≠ pi/2 + k*pi"
 proof -
 have "tan (x - k * pi) = y" using lhs tan_periodic_int[of _ "-k"] by auto
 then have "arctan y = x - real_of_int k * pi"
 by (smt (verit) arctan_tan lhs divide_minus_left k mult_minus_left of_int_minus tan_periodic_int that)
 then show ?thesis by auto
 qed
 then show "∃k. x = arctan y + of_int k * pi ∨ (x = pi/2 + k*pi ∧ y=0)"
 using lhs k by force
qed (auto simp: arctan)

lemma arctan_tan_eq_abs_pi:
 assumes "cos θ ≠ 0"
 obtains k where "arctan (tan θ) = θ - of_int k * pi"
 by (metis add.commute assms cos_zero_iff_int2 eq_diff_eq tan_eq_arctan_Ex)

lemma tan_eq:
 assumes "tan x = tan y" "tan x ≠ 0"
 obtains k::int where "x = y + k * pi"
proof -
 obtain k0 where k0: "x = arctan (tan y) + real_of_int k0 * pi"
 using assms tan_eq_arctan_Ex[of x "tan y"] by auto
 obtain k1 where k1: "arctan (tan y) = y - of_int k1 * pi"
 using arctan_tan_eq_abs_pi assms tan_eq_0_cos_sin by auto
 have "x = y + (k0-k1)*pi"
 using k0 k1 by (auto simp: algebra_simps)
 with that show ?thesis
 by blast
qed

lemma cos_arctan: "cos (arctan x) = 1 / sqrt (1 + x🪙2)"
proof (rule power2_eq_imp_eq)
 have "0 < 1 + x🪙2" by (simp add: add_pos_nonneg)
 show "0 ≤ 1 / sqrt (1 + x🪙2)" by simp
 show "0 ≤ cos (arctan x)"
 by (intro less_imp_le cos_gt_zero_pi arctan_lbound arctan_ubound)
 have "(cos (arctan x))🪙2 * (1 + (tan (arctan x))🪙2) = 1"
 unfolding tan_def by (simp add: distrib_left power_divide)
 then show "(cos (arctan x))🪙2 = (1 / sqrt (1 + x🪙2))🪙2"
 using ‹0 🚫 + x🪙2› by (simp add: arctan power_divide eq_divide_eq)
qed

lemma sin_arctan: "sin (arctan x) = x / sqrt (1 + x🪙2)"
 using add_pos_nonneg [OF zero_less_one zero_le_power2 [of x]]
 using tan_arctan [of x] unfolding tan_def cos_arctan
 by (simp add: eq_divide_eq)

lemma tan_sec: "cos x ≠ 0 ==> 1 + (tan x)🪙2 = (inverse (cos x))🪙2"
 for x :: "'a::{real_normed_field,banach,field}"
 by (simp add: add_divide_eq_iff inverse_eq_divide power2_eq_square tan_def)

lemma arctan_less_iff: "arctan x < arctan y ⟷ x < y"
 by (metis tan_monotone' arctan_lbound arctan_ubound tan_arctan)

lemma arctan_le_iff: "arctan x ≤ arctan y ⟷ x ≤ y"
 by (simp only: not_less [symmetric] arctan_less_iff)

lemma arctan_eq_iff: "arctan x = arctan y ⟷ x = y"
 by (simp only: eq_iff [where 'a=real] arctan_le_iff)

lemma zero_less_arctan_iff [simp]: "0 < arctan x ⟷ 0 < x"
 using arctan_less_iff [of 0 x] by simp

lemma arctan_less_zero_iff [simp]: "arctan x < 0 ⟷ x < 0"
 using arctan_less_iff [of x 0] by simp

lemma zero_le_arctan_iff [simp]: "0 ≤ arctan x ⟷ 0 ≤ x"
 using arctan_le_iff [of 0 x] by simp

lemma arctan_le_zero_iff [simp]: "arctan x ≤ 0 ⟷ x ≤ 0"
 using arctan_le_iff [of x 0] by simp

lemma arctan_eq_zero_iff [simp]: "arctan x = 0 ⟷ x = 0"
 using arctan_eq_iff [of x 0] by simp

lemma continuous_on_arcsin': "continuous_on {-1 .. 1} arcsin"
proof -
 have "continuous_on (sin ` {- pi/2 .. pi/2}) arcsin"
 by (rule continuous_on_inv) (auto intro: continuous_intros simp: arcsin_sin)
 also have "sin ` {- pi/2 .. pi/2} = {-1 .. 1}"
 proof safe
 fix x :: real
 assume "x ∈ {-1..1}"
 then show "x ∈ sin ` {- pi/2..pi/2}"
 using arcsin_lbound arcsin_ubound
 by (intro image_eqI[where x="arcsin x"]) auto
 qed simp
 finally show ?thesis .
qed

lemma continuous_on_arcsin [continuous_intros]:
 "continuous_on s f ==> (∀x∈s. -1 ≤ f x ∧ f x ≤ 1) ==> continuous_on s (λx. arcsin (f x))"
 using continuous_on_compose[of s f, OF _ continuous_on_subset[OF continuous_on_arcsin']]
 by (auto simp: comp_def subset_eq)

lemma isCont_arcsin: "-1 < x ==> x < 1 ==> isCont arcsin x"
 using continuous_on_arcsin'[THEN continuous_on_subset, of "{ -1 <..< 1 }"]
 by (auto simp: continuous_on_eq_continuous_at subset_eq)

lemma continuous_on_arccos': "continuous_on {-1 .. 1} arccos"
proof -
 have "continuous_on (cos ` {0 .. pi}) arccos"
 by (rule continuous_on_inv) (auto intro: continuous_intros simp: arccos_cos)
 also have "cos ` {0 .. pi} = {-1 .. 1}"
 proof safe
 fix x :: real
 assume "x ∈ {-1..1}"
 then show "x ∈ cos ` {0..pi}"
 using arccos_lbound arccos_ubound
 by (intro image_eqI[where x="arccos x"]) auto
 qed simp
 finally show ?thesis .
qed

lemma continuous_on_arccos [continuous_intros]:
 "continuous_on s f ==> (∀x∈s. -1 ≤ f x ∧ f x ≤ 1) ==> continuous_on s (λx. arccos (f x))"
 using continuous_on_compose[of s f, OF _ continuous_on_subset[OF continuous_on_arccos']]
 by (auto simp: comp_def subset_eq)

lemma isCont_arccos: "-1 < x ==> x < 1 ==> isCont arccos x"
 using continuous_on_arccos'[THEN continuous_on_subset, of "{ -1 <..< 1 }"]
 by (auto simp: continuous_on_eq_continuous_at subset_eq)

lemma isCont_arctan: "isCont arctan x"
proof -
 obtain u where u: "- (pi/2) < u" "u < arctan x"
 by (meson arctan arctan_less_iff linordered_field_no_lb)
 obtain v where v: "arctan x < v" "v < pi/2"
 by (meson arctan_less_iff arctan_ubound linordered_field_no_ub)
 have "isCont arctan (tan (arctan x))"
 proof (rule isCont_inverse_function2 [of u "arctan x" v])
 show "∧z. [u ≤ z; z ≤ v] ==> arctan (tan z) = z"
 using arctan_unique u(1) v(2) by auto
 then show "∧z. [u ≤ z; z ≤ v] ==> isCont tan z"
 by (metis arctan cos_gt_zero_pi isCont_tan less_irrefl)
 qed (use u v in auto)
 then show ?thesis
 by (simp add: arctan)
qed

lemma tendsto_arctan [tendsto_intros]: "(f ---> x) F ==> ((λx. arctan (f x)) ---> arctan x) F"
 by (rule isCont_tendsto_compose [OF isCont_arctan])

lemma continuous_arctan [continuous_intros]: "continuous F f ==> continuous F (λx. arctan (f x))"
 unfolding continuous_def by (rule tendsto_arctan)

lemma continuous_on_arctan [continuous_intros]:
 "continuous_on s f ==> continuous_on s (λx. arctan (f x))"
 unfolding continuous_on_def by (auto intro: tendsto_arctan)

lemma DERIV_arcsin:
 assumes "- 1 < x" "x < 1"
 shows "DERIV arcsin x :> inverse (sqrt (1 - x🪙2))"
proof (rule DERIV_inverse_function)
 show "(sin has_real_derivative sqrt (1 - x🪙2)) (at (arcsin x))"
 by (rule derivative_eq_intros | use assms cos_arcsin in force)+
 show "sqrt (1 - x🪙2) ≠ 0"
 using abs_square_eq_1 assms by force
qed (use assms isCont_arcsin in auto)

lemma DERIV_arccos:
 assumes "- 1 < x" "x < 1"
 shows "DERIV arccos x :> inverse (- sqrt (1 - x🪙2))"
proof (rule DERIV_inverse_function)
 show "(cos has_real_derivative - sqrt (1 - x🪙2)) (at (arccos x))"
 by (rule derivative_eq_intros | use assms sin_arccos in force)+
 show "- sqrt (1 - x🪙2) ≠ 0"
 using abs_square_eq_1 assms by force
qed (use assms isCont_arccos in auto)

lemma DERIV_arctan: "DERIV arctan x :> inverse (1 + x🪙2)"
proof (rule DERIV_inverse_function)
 have "inverse ((cos (arctan x))🪙2) = 1 + x🪙2"
 by (metis arctan cos_arctan_not_zero power_inverse tan_sec)
 then show "(tan has_real_derivative 1 + x🪙2) (at (arctan x))"
 by (auto intro!: derivative_eq_intros)
 show "∧y. [x - 1 < y; y < x + 1] ==> tan (arctan y) = y"
 using tan_arctan by blast
 show "1 + x🪙2 ≠ 0"
 by (metis power_one sum_power2_eq_zero_iff zero_neq_one)
qed (use isCont_arctan in auto)

declare
 DERIV_arcsin[THEN DERIV_chain2, derivative_intros]
 DERIV_arcsin[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]
 DERIV_arccos[THEN DERIV_chain2, derivative_intros]
 DERIV_arccos[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]
 DERIV_arctan[THEN DERIV_chain2, derivative_intros]
 DERIV_arctan[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]

lemmas has_derivative_arctan[derivative_intros] = DERIV_arctan[THEN DERIV_compose_FDERIV]
 and has_derivative_arccos[derivative_intros] = DERIV_arccos[THEN DERIV_compose_FDERIV]
 and has_derivative_arcsin[derivative_intros] = DERIV_arcsin[THEN DERIV_compose_FDERIV]

lemma filterlim_tan_at_right: "filterlim tan at_bot (at_right (- (pi/2)))"
 by (rule filterlim_at_bot_at_right[where Q="λx. - pi/2 < x ∧ x < pi/2" and P="λx. True" and g=arctan])
 (auto simp: arctan le_less eventually_at dist_real_def simp del: less_divide_eq_numeral1
 intro!: tan_monotone exI[of _ "pi/2"])

lemma filterlim_tan_at_left: "filterlim tan at_top (at_left (pi/2))"
 by (rule filterlim_at_top_at_left[where Q="λx. - pi/2 < x ∧ x < pi/2" and P="λx. True" and g=arctan])
 (auto simp: arctan le_less eventually_at dist_real_def simp del: less_divide_eq_numeral1
 intro!: tan_monotone exI[of _ "pi/2"])

lemma tendsto_arctan_at_top: "(arctan ---> (pi/2)) at_top"
proof (rule tendstoI)
 fix e :: real
 assume "0 < e"
 define y where "y = pi/2 - min (pi/2) e"
 then have y: "0 ≤ y" "y < pi/2" "pi/2 ≤ e + y"
 using ‹0 🚫› by auto
 show "eventually (λx. dist (arctan x) (pi/2) < e) at_top"
 proof (intro eventually_at_top_dense[THEN iffD2] exI allI impI)
 fix x
 assume "tan y < x"
 then have "arctan (tan y) < arctan x"
 by (simp add: arctan_less_iff)
 with y have "y < arctan x"
 by (subst (asm) arctan_tan) simp_all
 with arctan_ubound[of x, arith] y ‹0 🚫›
 show "dist (arctan x) (pi/2) < e"
 by (simp add: dist_real_def)
 qed
qed

lemma tendsto_arctan_at_bot: "(arctan ---> - (pi/2)) at_bot"
 unfolding filterlim_at_bot_mirror arctan_minus
 by (intro tendsto_minus tendsto_arctan_at_top)

lemma sin_multiple_reduce:
 "sin (x * numeral n :: 'a :: {real_normed_field, banach}) =
 sin x * cos (x * of_nat (pred_numeral n)) + cos x * sin (x * of_nat (pred_numeral n))"
proof -
 have "numeral n = of_nat (pred_numeral n) + (1 :: 'a)"
 by (metis add.commute numeral_eq_Suc of_nat_Suc of_nat_numeral)
 also have "sin (x * …) = sin (x * of_nat (pred_numeral n) + x)"
 unfolding of_nat_Suc by (simp add: ring_distribs)
 finally show ?thesis
 by (simp add: sin_add)
qed

lemma cos_multiple_reduce:
 "cos (x * numeral n :: 'a :: {real_normed_field, banach}) =
 cos (x * of_nat (pred_numeral n)) * cos x - sin (x * of_nat (pred_numeral n)) * sin x"
proof -
 have "numeral n = of_nat (pred_numeral n) + (1 :: 'a)"
 by (metis add.commute numeral_eq_Suc of_nat_Suc of_nat_numeral)
 also have "cos (x * …) = cos (x * of_nat (pred_numeral n) + x)"
 unfolding of_nat_Suc by (simp add: ring_distribs)
 finally show ?thesis
 by (simp add: cos_add)
qed

lemma arccos_eq_pi_iff: "x ∈ {-1..1} ==> arccos x = pi ⟷ x = -1"
 by (metis arccos arccos_minus_1 atLeastAtMost_iff cos_pi)

lemma arccos_eq_0_iff: "x ∈ {-1..1} ==> arccos x = 0 ⟷ x = 1"
 by (metis arccos arccos_1 atLeastAtMost_iff cos_zero)

subsection ‹Prove Totality of the Trigonometric Functions›

lemma cos_arccos_abs: "∣y∣ ≤ 1 ==> cos (arccos y) = y"
 by (simp add: abs_le_iff)

lemma sin_arccos_abs: "∣y∣ ≤ 1 ==> sin (arccos y) = sqrt (1 - y🪙2)"
 by (simp add: sin_arccos abs_le_iff)

lemma sin_mono_less_eq:
 "- (pi/2) ≤ x ==> x ≤ pi/2 ==> - (pi/2) ≤ y ==> y ≤ pi/2 ==> sin x < sin y ⟷ x < y"
 by (metis not_less_iff_gr_or_eq sin_monotone_2pi)

lemma sin_mono_le_eq:
 "- (pi/2) ≤ x ==> x ≤ pi/2 ==> - (pi/2) ≤ y ==> y ≤ pi/2 ==> sin x ≤ sin y ⟷ x ≤ y"
 by (meson leD le_less_linear sin_monotone_2pi sin_monotone_2pi_le)

lemma sin_inj_pi:
 "- (pi/2) ≤ x ==> x ≤ pi/2 ==> - (pi/2) ≤ y ==> y ≤ pi/2 ==> sin x = sin y ==> x = y"
 by (metis arcsin_sin)

lemma arcsin_le_iff:
 assumes "x ≥ -1" "x ≤ 1" "y ≥ -pi/2" "y ≤ pi/2"
 shows "arcsin x ≤ y ⟷ x ≤ sin y"
proof -
 have "arcsin x ≤ y ⟷ sin (arcsin x) ≤ sin y"
 using arcsin_bounded[of x] assms by (subst sin_mono_le_eq) auto
 also from assms have "sin (arcsin x) = x" by simp
 finally show ?thesis .
qed

lemma le_arcsin_iff:
 assumes "x ≥ -1" "x ≤ 1" "y ≥ -pi/2" "y ≤ pi/2"
 shows "arcsin x ≥ y ⟷ x ≥ sin y"
proof -
 have "arcsin x ≥ y ⟷ sin (arcsin x) ≥ sin y"
 using arcsin_bounded[of x] assms by (subst sin_mono_le_eq) auto
 also from assms have "sin (arcsin x) = x" by simp
 finally show ?thesis .
qed

lemma cos_mono_less_eq: "0 ≤ x ==> x ≤ pi ==> 0 ≤ y ==> y ≤ pi ==> cos x < cos y ⟷ y < x"
 by (meson cos_monotone_0_pi cos_monotone_0_pi_le leD le_less_linear)

lemma cos_mono_le_eq: "0 ≤ x ==> x ≤ pi ==> 0 ≤ y ==> y ≤ pi ==> cos x ≤ cos y ⟷ y ≤ x"
 by (metis arccos_cos cos_monotone_0_pi_le eq_iff linear)

lemma cos_inj_pi: "0 ≤ x ==> x ≤ pi ==> 0 ≤ y ==> y ≤ pi ==> cos x = cos y ==> x = y"
 by (metis arccos_cos)

lemma arccos_le_pi2: "[0 ≤ y; y ≤ 1] ==> arccos y ≤ pi/2"
 by (metis (mono_tags) arccos_0 arccos cos_le_one cos_monotone_0_pi_le
 cos_pi cos_pi_half pi_half_ge_zero antisym_conv less_eq_neg_nonpos linear minus_minus order.trans order_refl)

lemma sincos_total_pi_half:
 assumes "0 ≤ x" "0 ≤ y" "x🪙2 + y🪙2 = 1"
 shows "∃t. 0 ≤ t ∧ t ≤ pi/2 ∧ x = cos t ∧ y = sin t"
proof -
 have x1: "x ≤ 1"
 using assms by (metis le_add_same_cancel1 power2_le_imp_le power_one zero_le_power2)
 with assms have *: "0 ≤ arccos x" "cos (arccos x) = x"
 by (auto simp: arccos)
 from assms have "y = sqrt (1 - x🪙2)"
 by (metis abs_of_nonneg add.commute add_diff_cancel real_sqrt_abs)
 with x1 * assms arccos_le_pi2 [of x] show ?thesis
 by (rule_tac x="arccos x" in exI) (auto simp: sin_arccos)
qed

lemma sincos_total_pi:
 assumes "0 ≤ y" "x🪙2 + y🪙2 = 1"
 shows "∃t. 0 ≤ t ∧ t ≤ pi ∧ x = cos t ∧ y = sin t"
proof (cases rule: le_cases [of 0 x])
 case le
 from sincos_total_pi_half [OF le] show ?thesis
 by (metis pi_ge_two pi_half_le_two add.commute add_le_cancel_left add_mono assms)
next
 case ge
 then have "0 ≤ -x"
 by simp
 then obtain t where t: "t≥0" "t ≤ pi/2" "-x = cos t" "y = sin t"
 using sincos_total_pi_half assms
 by auto (metis ‹0 ≤ - x› power2_minus)
 show ?thesis
 by (rule exI [where x = "pi -t"]) (use t in auto)
qed

lemma sincos_total_2pi_le:
 assumes "x🪙2 + y🪙2 = 1"
 shows "∃t. 0 ≤ t ∧ t ≤ 2 * pi ∧ x = cos t ∧ y = sin t"
proof (cases rule: le_cases [of 0 y])
 case le
 from sincos_total_pi [OF le] show ?thesis
 by (metis assms le_add_same_cancel1 mult.commute mult_2_right order.trans)
next
 case ge
 then have "0 ≤ -y"
 by simp
 then obtain t where t: "t≥0" "t ≤ pi" "x = cos t" "-y = sin t"
 using sincos_total_pi assms
 by auto (metis ‹0 ≤ - y› power2_minus)
 show ?thesis
 by (rule exI [where x = "2 * pi - t"]) (use t in auto)
qed

lemma sincos_total_2pi:
 assumes "x🪙2 + y🪙2 = 1"
 obtains t where "0 ≤ t" "t < 2*pi" "x = cos t" "y = sin t"
proof -
 from sincos_total_2pi_le [OF assms]
 obtain t where t: "0 ≤ t" "t ≤ 2*pi" "x = cos t" "y = sin t"
 by blast
 show ?thesis
 by (cases "t = 2 * pi") (use t that in ‹force+›)
qed

lemma arcsin_less_mono: "∣x∣ ≤ 1 ==> ∣y∣ ≤ 1 ==> arcsin x < arcsin y ⟷ x < y"
 by (rule trans [OF sin_mono_less_eq [symmetric]]) (use arcsin_ubound arcsin_lbound in auto)

lemma arcsin_le_mono: "∣x∣ ≤ 1 ==> ∣y∣ ≤ 1 ==> arcsin x ≤ arcsin y ⟷ x ≤ y"
 using arcsin_less_mono not_le by blast

lemma arcsin_less_arcsin: "- 1 ≤ x ==> x < y ==> y ≤ 1 ==> arcsin x < arcsin y"
 using arcsin_less_mono by auto

lemma arcsin_le_arcsin: "- 1 ≤ x ==> x ≤ y ==> y ≤ 1 ==> arcsin x ≤ arcsin y"
 using arcsin_le_mono by auto

lemma arcsin_nonneg: "x ∈ {0..1} ==> arcsin x ≥ 0"
 using arcsin_le_arcsin[of 0 x] by simp

lemma arccos_less_mono: "∣x∣ ≤ 1 ==> ∣y∣ ≤ 1 ==> arccos x < arccos y ⟷ y < x"
 by (rule trans [OF cos_mono_less_eq [symmetric]]) (use arccos_ubound arccos_lbound in auto)

lemma arccos_le_mono: "∣x∣ ≤ 1 ==> ∣y∣ ≤ 1 ==> arccos x ≤ arccos y ⟷ y ≤ x"
 using arccos_less_mono [of y x] by (simp add: not_le [symmetric])

lemma arccos_less_arccos: "- 1 ≤ x ==> x < y ==> y ≤ 1 ==> arccos y < arccos x"
 using arccos_less_mono by auto

lemma arccos_le_arccos: "- 1 ≤ x ==> x ≤ y ==> y ≤ 1 ==> arccos y ≤ arccos x"
 using arccos_le_mono by auto

lemma arccos_eq_iff: "∣x∣ ≤ 1 ∧ ∣y∣ ≤ 1 ==> arccos x = arccos y ⟷ x = y"
 using cos_arccos_abs by fastforce

lemma arccos_cos_eq_abs:
 assumes "∣θ∣ ≤ pi"
 shows "arccos (cos θ) = ∣θ∣"
 unfolding arccos_def
proof (intro the_equality conjI; clarify?)
 show "cos ∣θ∣ = cos θ"
 by (simp add: abs_real_def)
 show "x = ∣θ∣" if "cos x = cos θ" "0 ≤ x" "x ≤ pi" for x
 by (simp add: ‹cos ∣θ∣ = cos θ› assms cos_inj_pi that)
qed (use assms in auto)

lemma arccos_cos_eq_abs_2pi:
 obtains k where "arccos (cos θ) = ∣θ - of_int k * (2 * pi)∣"
proof -
 define k where "k ≡ ⌊(θ + pi) / (2 * pi)⌋"
 have lepi: "∣θ - of_int k * (2 * pi)∣ ≤ pi"
 using floor_divide_lower [of "2*pi" "θ + pi"] floor_divide_upper [of "2*pi" "θ + pi"]
 by (auto simp: k_def abs_if algebra_simps)
 have "arccos (cos θ) = arccos (cos (θ - of_int k * (2 * pi)))"
 using cos_int_2pin sin_int_2pin by (simp add: cos_diff mult.commute)
 also have "… = ∣θ - of_int k * (2 * pi)∣"
 using arccos_cos_eq_abs lepi by blast
 finally show ?thesis
 using that by metis
qed

lemma arccos_arctan:
 assumes "-1 < x" "x < 1"
 shows "arccos x = pi/2 - arctan(x / sqrt(1 - x🪙2))"
proof -
 have "arctan(x / sqrt(1 - x🪙2)) - (pi/2 - arccos x) = 0"
 proof (rule sin_eq_0_pi)
 show "- pi < arctan (x / sqrt (1 - x🪙2)) - (pi/2 - arccos x)"
 using arctan_lbound [of "x / sqrt(1 - x🪙2)"] arccos_bounded [of x] assms
 by (simp add: algebra_simps)
 next
 show "arctan (x / sqrt (1 - x🪙2)) - (pi/2 - arccos x) < pi"
 using arctan_ubound [of "x / sqrt(1 - x🪙2)"] arccos_bounded [of x] assms
 by (simp add: algebra_simps)
 next
 show "sin (arctan (x / sqrt (1 - x🪙2)) - (pi/2 - arccos x)) = 0"
 using assms
 by (simp add: algebra_simps sin_diff cos_add sin_arccos sin_arctan cos_arctan
 power2_eq_square square_eq_1_iff)
 qed
 then show ?thesis
 by simp
qed

lemma arcsin_plus_arccos:
 assumes "-1 ≤ x" "x ≤ 1"
 shows "arcsin x + arccos x = pi/2"
proof -
 have "arcsin x = pi/2 - arccos x"
 apply (rule sin_inj_pi)
 using assms arcsin [OF assms] arccos [OF assms]
 by (auto simp: algebra_simps sin_diff)
 then show ?thesis
 by (simp add: algebra_simps)
qed

lemma arcsin_arccos_eq: "-1 ≤ x ==> x ≤ 1 ==> arcsin x = pi/2 - arccos x"
 using arcsin_plus_arccos by force

lemma arccos_arcsin_eq: "-1 ≤ x ==> x ≤ 1 ==> arccos x = pi/2 - arcsin x"
 using arcsin_plus_arccos by force

lemma arcsin_arctan: "-1 < x ==> x < 1 ==> arcsin x = arctan(x / sqrt(1 - x🪙2))"
 by (simp add: arccos_arctan arcsin_arccos_eq)

lemma arcsin_arccos_sqrt_pos: "0 ≤ x ==> x ≤ 1 ==> arcsin x = arccos(sqrt(1 - x🪙2))"
 by (smt (verit, del_insts) arccos_cos arcsin_0 arcsin_le_arcsin arcsin_pi cos_arcsin)

lemma arcsin_arccos_sqrt_neg: "-1 ≤ x ==> x ≤ 0 ==> arcsin x = -arccos(sqrt(1 - x??2))"
 using arcsin_arccos_sqrt_pos [of "-x"]
 by (simp add: arcsin_minus)

lemma arccos_arcsin_sqrt_pos: "0 ≤ x ==> x ≤ 1 ==> arccos x = arcsin(sqrt(1 - x🪙2))"
 by (smt (verit, del_insts) arccos_lbound arccos_le_pi2 arcsin_sin sin_arccos)

lemma arccos_arcsin_sqrt_neg: "-1 ≤ x ==> x ≤ 0 ==> arccos x = pi - arcsin(sqrt(1 - x🪙2))"
 using arccos_arcsin_sqrt_pos [of "-x"]
 by (simp add: arccos_minus)

lemma cos_limit_1:
 assumes "(λj. cos (θ j)) <---- 1"
 shows "∃k. (λj. θ j - of_int (k j) * (2 * pi)) <---- 0"
proof -
 have "∀🪙F j in sequentially. cos (θ j) ∈ {- 1..1}"
 by auto
 then have "(λj. arccos (cos (θ j))) <---- arccos 1"
 using continuous_on_tendsto_compose [OF continuous_on_arccos' assms] by auto
 moreover have "∧j. ∃k. arccos (cos (θ j)) = ∣θ j - of_int k * (2 * pi)∣"
 using arccos_cos_eq_abs_2pi by metis
 then have "∃k. ∀j. arccos (cos (θ j)) = ∣θ j - of_int (k j) * (2 * pi)∣"
 by metis
 ultimately have "∃k. (λj. ∣θ j - of_int (k j) * (2 * pi)∣) <---- 0"
 by auto
 then show ?thesis
 by (simp add: tendsto_rabs_zero_iff)
qed

lemma cos_diff_limit_1:
 assumes "(λj. cos (θ j - Θ)) <---- 1"
 obtains k where "(λj. θ j - of_int (k j) * (2 * pi)) <---- Θ"
proof -
 obtain k where "(λj. (θ j - Θ) - of_int (k j) * (2 * pi)) <---- 0"
 using cos_limit_1 [OF assms] by auto
 then have "(λj. Θ + ((θ j - Θ) - of_int (k j) * (2 * pi))) <---- Θ + 0"
 by (rule tendsto_add [OF tendsto_const])
 with that show ?thesis
 by auto
qed

subsection ‹Machin's formula›

lemma arctan_one: "arctan 1 = pi/4"
 by (rule arctan_unique) (simp_all add: tan_45 m2pi_less_pi)

lemma tan_total_pi4:
 assumes "∣x∣ < 1"
 shows "∃z. - (pi/4) < z ∧ z < pi/4 ∧ tan z = x"
proof
 show "- (pi/4) < arctan x ∧ arctan x < pi/4 ∧ tan (arctan x) = x"
 unfolding arctan_one [symmetric] arctan_minus [symmetric]
 unfolding arctan_less_iff
 using assms by (auto simp: arctan)
qed

lemma arctan_add:
 assumes "∣x∣ ≤ 1" "∣y∣ < 1"
 shows "arctan x + arctan y = arctan ((x + y) / (1 - x * y))"
proof (rule arctan_unique [symmetric])
 have "- (pi/4) ≤ arctan x" "- (pi/4) < arctan y"
 unfolding arctan_one [symmetric] arctan_minus [symmetric]
 unfolding arctan_le_iff arctan_less_iff
 using assms by auto
 from add_le_less_mono [OF this] show 1: "- (pi/2) < arctan x + arctan y"
 by simp
 have "arctan x ≤ pi/4" "arctan y < pi/4"
 unfolding arctan_one [symmetric]
 unfolding arctan_le_iff arctan_less_iff
 using assms by auto
 from add_le_less_mono [OF this] show 2: "arctan x + arctan y < pi/2"
 by simp
 show "tan (arctan x + arctan y) = (x + y) / (1 - x * y)"
 using cos_gt_zero_pi [OF 1 2] by (simp add: arctan tan_add)
qed

lemma arctan_double: "∣x∣ < 1 ==> 2 * arctan x = arctan ((2 * x) / (1 - x🪙2))"
 by (metis arctan_add linear mult_2 not_less power2_eq_square)

theorem machin: "pi/4 = 4 * arctan (1 / 5) - arctan (1/239)"
proof -
 have "∣1 / 5∣ < (1 :: real)"
 by auto
 from arctan_add[OF less_imp_le[OF this] this] have "2 * arctan (1 / 5) = arctan (5 / 12)"
 by auto
 moreover
 have "∣5 / 12∣ < (1 :: real)"
 by auto
 from arctan_add[OF less_imp_le[OF this] this] have "2 * arctan (5 / 12) = arctan (120 / 119)"
 by auto
 moreover
 have "∣1∣ ≤ (1::real)" and "∣1/239∣ < (1::real)"
 by auto
 from arctan_add[OF this] have "arctan 1 + arctan (1/239) = arctan (120 / 119)"
 by auto
 ultimately have "arctan 1 + arctan (1/239) = 4 * arctan (1 / 5)"
 by auto
 then show ?thesis
 unfolding arctan_one by algebra
qed

lemma machin_Euler: "5 * arctan (1 / 7) + 2 * arctan (3 / 79) = pi/4"
proof -
 have 17: "∣1 / 7∣ < (1 :: real)" by auto
 with arctan_double have "2 * arctan (1 / 7) = arctan (7 / 24)"
 by simp (simp add: field_simps)
 moreover
 have "∣7 / 24∣ < (1 :: real)" by auto
 with arctan_double have "2 * arctan (7 / 24) = arctan (336 / 527)"
 by simp (simp add: field_simps)
 moreover
 have "∣336 / 527∣ < (1 :: real)" by auto
 from arctan_add[OF less_imp_le[OF 17] this]
 have "arctan(1/7) + arctan (336 / 527) = arctan (2879 / 3353)"
 by auto
 ultimately have I: "5 * arctan (1 / 7) = arctan (2879 / 3353)" by auto
 have 379: "∣3 / 79∣ < (1 :: real)" by auto
 with arctan_double have II: "2 * arctan (3 / 79) = arctan (237 / 3116)"
 by simp (simp add: field_simps)
 have *: "∣2879 / 3353∣ < (1 :: real)" by auto
 have "∣237 / 3116∣ < (1 :: real)" by auto
 from arctan_add[OF less_imp_le[OF *] this] have "arctan (2879/3353) + arctan (237/3116) = pi/4"
 by (simp add: arctan_one)
 with I II show ?thesis by auto
qed

(*But could also prove MACHIN_GAUSS:
 12 * arctan(1/18) + 8 * arctan(1/57) - 5 * arctan(1/239) = pi/4*)

subsection ‹Introducing the inverse tangent power series›

lemma monoseq_arctan_series:
 fixes x :: real
 assumes "∣x∣ ≤ 1"
 shows "monoseq (λn. 1 / real (n * 2 + 1) * x^(n * 2 + 1))"
 (is "monoseq ?a")
proof (cases "x = 0")
 case True
 then show ?thesis by (auto simp: monoseq_def)
next
 case False
 have "norm x ≤ 1" and "x ≤ 1" and "-1 ≤ x"
 using assms by auto
 show "monoseq ?a"
 proof -
 have mono: "1 / real (Suc (Suc n * 2)) * x ^ Suc (Suc n * 2) ≤
 1 / real (Suc (n * 2)) * x ^ Suc (n * 2)"
 if "0 ≤ x" and "x ≤ 1" for n and x :: real
 proof (rule mult_mono)
 show "1 / real (Suc (Suc n * 2)) ≤ 1 / real (Suc (n * 2))"
 by (rule frac_le) simp_all
 show "0 ≤ 1 / real (Suc (n * 2))"
 by auto
 show "x ^ Suc (Suc n * 2) ≤ x ^ Suc (n * 2)"
 by (rule power_decreasing) (simp_all add: ‹0 ≤ x› ‹x ≤ 1›)
 show "0 ≤ x ^ Suc (Suc n * 2)"
 by (rule zero_le_power) (simp add: ‹0 ≤ x›)
 qed
 show ?thesis
 proof (cases "0 ≤ x")
 case True
 from mono[OF this ‹x ≤ 1›, THEN allI]
 show ?thesis
 unfolding Suc_eq_plus1[symmetric] by (rule mono_SucI2)
 next
 case False
 then have "0 ≤ - x" and "- x ≤ 1"
 using ‹-1 ≤ x› by auto
 from mono[OF this]
 have "1 / real (Suc (Suc n * 2)) * x ^ Suc (Suc n * 2) ≥
 1 / real (Suc (n * 2)) * x ^ Suc (n * 2)" for n
 using ‹0 ≤ -x› by auto
 then show ?thesis
 unfolding Suc_eq_plus1[symmetric] by (rule mono_SucI1[OF allI])
 qed
 qed
qed

lemma zeroseq_arctan_series:
 fixes x :: real
 assumes "∣x∣ ≤ 1"
 shows "(λn. 1 / real (n * 2 + 1) * x^(n * 2 + 1)) <---- 0"
 (is "?a <---- 0")
proof (cases "x = 0")
 case True
 then show ?thesis by simp
next
 case False
 have "norm x ≤ 1" and "x ≤ 1" and "-1 ≤ x"
 using assms by auto
 show "?a <---- 0"
 proof (cases "∣x∣ < 1")
 case True
 then have "norm x < 1" by auto
 from tendsto_mult[OF LIMSEQ_inverse_real_of_nat LIMSEQ_power_zero[OF ‹norm x 🚫›, THEN LIMSEQ_Suc]]
 have "(λn. 1 / real (n + 1) * x ^ (n + 1)) <---- 0"
 unfolding inverse_eq_divide Suc_eq_plus1 by simp
 then show ?thesis
 using pos2 by (rule LIMSEQ_linear)
 next
 case False
 then have "x = -1 ∨ x = 1"
 using ‹∣x∣ ≤ 1› by auto
 then have n_eq: "∧ n. x ^ (n * 2 + 1) = x"
 unfolding One_nat_def by auto
 from tendsto_mult[OF LIMSEQ_inverse_real_of_nat[THEN LIMSEQ_linear, OF pos2, unfolded inverse_eq_divide] tendsto_const[of x]]
 show ?thesis
 unfolding n_eq Suc_eq_plus1 by auto
 qed
qed

lemma summable_arctan_series:
 fixes n :: nat
 assumes "∣x∣ ≤ 1"
 shows "summable (λ k. (-1)^k * (1 / real (k*2+1) * x ^ (k*2+1)))"
 (is "summable (?c x)")
 by (rule summable_Leibniz(1),
 rule zeroseq_arctan_series[OF assms],
 rule monoseq_arctan_series[OF assms])

lemma DERIV_arctan_series:
 assumes "∣x∣ < 1"
 shows "DERIV (λx'. ∑k. (-1)^k * (1 / real (k * 2 + 1) * x' ^ (k * 2 + 1))) x :>
 (∑k. (-1)^k * x^(k * 2))"
 (is "DERIV ?arctan _ :> ?Int")
proof -
 let ?f = "λn. if even n then (-1)^(n div 2) * 1 / real (Suc n) else 0"

 have n_even: "even n ==> 2 * (n div 2) = n" for n :: nat
 by presburger
 then have if_eq: "?f n * real (Suc n) * x'^n =
 (if even n then (-1)^(n div 2) * x'^(2 * (n div 2)) else 0)"
 for n x'
 by auto

 have summable_Integral: "summable (λ n. (- 1) ^ n * x^(2 * n))" if "∣x∣ < 1" for x :: real
 proof -
 from that have "x🪙2 < 1"
 by (simp add: abs_square_less_1)
 have "summable (λ n. (- 1) ^ n * (x🪙2) ^n)"
 by (rule summable_Leibniz(1))
 (auto intro!: LIMSEQ_realpow_zero monoseq_realpow ‹x🪙2 🚫› order_less_imp_le[OF ‹x🪙2 🚫›])
 then show ?thesis
 by (simp only: power_mult)
 qed

 have sums_even: "(sums) f = (sums) (λ n. if even n then f (n div 2) else 0)"
 for f :: "nat ==> real"
 proof -
 have "f sums x = (λ n. if even n then f (n div 2) else 0) sums x" for x :: real
 proof
 assume "f sums x"
 from sums_if[OF sums_zero this] show "(λn. if even n then f (n div 2) else 0) sums x"
 by auto
 next
 assume "(λ n. if even n then f (n div 2) else 0) sums x"
 from LIMSEQ_linear[OF this[simplified sums_def] pos2, simplified sum_split_even_odd[simplified mult.commute]]
 show "f sums x"
 unfolding sums_def by auto
 qed
 then show ?thesis ..
 qed

 have Int_eq: "(∑n. ?f n * real (Suc n) * x^n) = ?Int"
 unfolding if_eq mult.commute[of _ 2]
 suminf_def sums_even[of "λ n. (- 1) ^ n * x ^ (2 * n)", symmetric]
 by auto

 have arctan_eq: "(∑n. ?f n * x^(Suc n)) = ?arctan x" for x
 proof -
 have if_eq': "∧n. (if even n then (- 1) ^ (n div 2) * 1 / real (Suc n) else 0) * x ^ Suc n =
 (if even n then (- 1) ^ (n div 2) * (1 / real (Suc (2 * (n div 2))) * x ^ Suc (2 * (n div 2))) else 0)"
 using n_even by auto
 have idx_eq: "∧n. n * 2 + 1 = Suc (2 * n)"
 by auto
 then show ?thesis
 unfolding if_eq' idx_eq suminf_def
 sums_even[of "λ n. (- 1) ^ n * (1 / real (Suc (2 * n)) * x ^ Suc (2 * n))", symmetric]
 by auto
 qed

 have "DERIV (λ x. ∑ n. ?f n * x^(Suc n)) x :> (∑n. ?f n * real (Suc n) * x^n)"
 proof (rule DERIV_power_series')
 show "x ∈ {- 1 <..< 1}"
 using ‹∣ x ∣ 🚫› by auto
 show "summable (λ n. ?f n * real (Suc n) * x'^n)"
 if x'_bounds: "x' ∈ {- 1 <..< 1}" for x' :: real
 proof -
 from that have "∣x'∣ < 1" by auto
 then show ?thesis
 using that sums_summable sums_if [OF sums_0 [of "λx. 0"] summable_sums [OF summable_Integral]]
 by (auto simp add: if_distrib [of "λx. x * y" for y] cong: if_cong)
 qed
 qed auto
 then show ?thesis
 by (simp only: Int_eq arctan_eq)
qed

lemma arctan_series:
 assumes "∣x∣ ≤ 1"
 shows "arctan x = (∑k. (-1)^k * (1 / real (k * 2 + 1) * x ^ (k * 2 + 1)))"
 (is "_ = suminf (λ n. ?c x n)")
proof -
 let ?c' = "λx n. (-1)^n * x^(n*2)"

 have DERIV_arctan_suminf: "DERIV (λ x. suminf (?c x)) x :> (suminf (?c' x))"
 if "0 < r" and "r < 1" and "∣x∣ < r" for r x :: real
 proof (rule DERIV_arctan_series)
 from that show "∣x∣ < 1"
 using ‹r 🚫› and ‹∣x∣ 🚫› by auto
 qed

 {
 fix x :: real
 assume "∣x∣ ≤ 1"
 note summable_Leibniz[OF zeroseq_arctan_series[OF this] monoseq_arctan_series[OF this]]
 } note arctan_series_borders = this

 have when_less_one: "arctan x = (∑k. ?c x k)" if "∣x∣ < 1" for x :: real
 proof -
 obtain r where "∣x∣ < r" and "r < 1"
 using dense[OF ‹∣x∣ 🚫›] by blast
 then have "0 < r" and "- r < x" and "x < r" by auto

 have suminf_eq_arctan_bounded: "suminf (?c x) - arctan x = suminf (?c a) - arctan a"
 if "-r < a" and "b < r" and "a < b" and "a ≤ x" and "x ≤ b" for x a b
 proof -
 from that have "∣x∣ < r" by auto
 show "suminf (?c x) - arctan x = suminf (?c a) - arctan a"
 proof (rule DERIV_isconst2[of "a" "b"])
 show "a < b" and "a ≤ x" and "x ≤ b"
 using ‹a 🚫› ‹a ≤ x› ‹x ≤ b› by auto
 have "∀x. - r < x ∧ x < r ⟶ DERIV (λ x. suminf (?c x) - arctan x) x :> 0"
 proof (rule allI, rule impI)
 fix x
 assume "-r < x ∧ x < r"
 then have "∣x∣ < r" by auto
 with ‹r 🚫› have "∣x∣ < 1" by auto
 have "∣- (x🪙2)∣ < 1" using abs_square_less_1 ‹∣x∣ 🚫› by auto
 then have "(λn. (- (x🪙2)) ^ n) sums (1 / (1 - (- (x🪙2))))"
 unfolding real_norm_def[symmetric] by (rule geometric_sums)
 then have "(?c' x) sums (1 / (1 - (- (x🪙2))))"
 unfolding power_mult_distrib[symmetric] power_mult mult.commute[of _ 2] by auto
 then have suminf_c'_eq_geom: "inverse (1 + x🪙2) = suminf (?c' x)"
 using sums_unique unfolding inverse_eq_divide by auto
 have "DERIV (λ x. suminf (?c x)) x :> (inverse (1 + x🪙2))"
 unfolding suminf_c'_eq_geom
 by (rule DERIV_arctan_suminf[OF ‹0 🚫› ‹r 🚫› ‹∣x∣ 🚫›])
 from DERIV_diff [OF this DERIV_arctan] show "DERIV (λx. suminf (?c x) - arctan x) x :> 0"
 by auto
 qed
 then have DERIV_in_rball: "∀y. a ≤ y ∧ y ≤ b ⟶ DERIV (λx. suminf (?c x) - arctan x) y :> 0"
 using ‹-r 🚫› ‹b 🚫› by auto
 then show "∧y. [a < y; y < b] ==> DERIV (λx. suminf (?c x) - arctan x) y :> 0"
 using ‹∣x∣ 🚫› by auto
 show "continuous_on {a..b} (λx. suminf (?c x) - arctan x)"
 using DERIV_in_rball DERIV_atLeastAtMost_imp_continuous_on by blast
 qed
 qed

 have suminf_arctan_zero: "suminf (?c 0) - arctan 0 = 0"
 unfolding Suc_eq_plus1[symmetric] power_Suc2 mult_zero_right arctan_zero_zero suminf_zero
 by auto

 have "suminf (?c x) - arctan x = 0"
 proof (cases "x = 0")
 case True
 then show ?thesis
 using suminf_arctan_zero by auto
 next
 case False
 then have "0 < ∣x∣" and "- ∣x∣ < ∣x∣"
 by auto
 have "suminf (?c (- ∣x∣)) - arctan (- ∣x∣) = suminf (?c 0) - arctan 0"
 by (rule suminf_eq_arctan_bounded[where x1=0 and a1="-∣x∣" and b1="∣x∣", symmetric])
 (simp_all only: ‹∣x∣ 🚫› ‹-∣x∣ 🚫∣x∣› neg_less_iff_less)
 moreover
 have "suminf (?c x) - arctan x = suminf (?c (- ∣x∣)) - arctan (- ∣x∣)"
 by (rule suminf_eq_arctan_bounded[where x1=x and a1="- ∣x∣" and b1="∣x∣"])
 (simp_all only: ‹∣x∣ 🚫› ‹- ∣x∣ 🚫∣x∣› neg_less_iff_less)
 ultimately show ?thesis
 using suminf_arctan_zero by auto
 qed
 then show ?thesis by auto
 qed

 show "arctan x = suminf (λn. ?c x n)"
 proof (cases "∣x∣ < 1")
 case True
 then show ?thesis by (rule when_less_one)
 next
 case False
 then have "∣x∣ = 1" using ‹∣x∣ ≤ 1› by auto
 let ?a = "λx n. ∣1 / real (n * 2 + 1) * x^(n * 2 + 1)∣"
 let ?diff = "λx n. ∣arctan x - (∑i∣"
 have "?diff 1 n ≤ ?a 1 n" for n :: nat
 proof -
 have "0 < (1 :: real)" by auto
 moreover
 have "?diff x n ≤ ?a x n" if "0 < x" and "x < 1" for x :: real
 proof -
 from that have "∣x∣ ≤ 1" and "∣x∣ < 1"
 by auto
 from ‹0 🚫› have "0 < 1 / real (0 * 2 + (1::nat)) * x ^ (0 * 2 + 1)"
 by auto
 note bounds = mp[OF arctan_series_borders(2)[OF ‹∣x∣ ≤ 1›] this, unfolded when_less_one[OF ‹∣x∣ 🚫›, symmetric], THEN spec]
 have "0 < 1 / real (n*2+1) * x^(n*2+1)"
 by (rule mult_pos_pos) (simp_all only: zero_less_power[OF ‹0 🚫›], auto)
 then have a_pos: "?a x n = 1 / real (n*2+1) * x^(n*2+1)"
 by (rule abs_of_pos)
 show ?thesis
 proof (cases "even n")
 case True
 then have sgn_pos: "(-1)^n = (1::real)" by auto
 from ‹even n› obtain m where "n = 2 * m" ..
 then have "2 * m = n" ..
 from bounds[of m, unfolded this atLeastAtMost_iff]
 have "∣arctan x - (∑i∣ ≤ (∑i∑i
 by auto
 also have "… = ?c x n" by auto
 also have "… = ?a x n" unfolding sgn_pos a_pos by auto
 finally show ?thesis .
 next
 case False
 then have sgn_neg: "(-1)^n = (-1::real)" by auto
 from ‹odd n› obtain m where "n = 2 * m + 1" ..
 then have m_def: "2 * m + 1 = n" ..
 then have m_plus: "2 * (m + 1) = n + 1" by auto
 from bounds[of "m + 1", unfolded this atLeastAtMost_iff, THEN conjunct1] bounds[of m, unfolded m_def atLeastAtMost_iff, THEN conjunct2]
 have "∣arctan x - (∑i∣ ≤ (∑i∑i by auto
 also have "… = - ?c x n" by auto
 also have "… = ?a x n" unfolding sgn_neg a_pos by auto
 finally show ?thesis .
 qed
 qed
 hence "∀x ∈ { 0 <..< 1 }. 0 ≤ ?a x n - ?diff x n" by auto
 moreover have "isCont (λ x. ?a x n - ?diff x n) x" for x
 unfolding diff_conv_add_uminus divide_inverse
 by (auto intro!: isCont_add isCont_rabs continuous_ident isCont_minus isCont_arctan
 continuous_at_within_inverse isCont_mult isCont_power continuous_const isCont_sum
 simp del: add_uminus_conv_diff)
 ultimately have "0 ≤ ?a 1 n - ?diff 1 n"
 by (rule LIM_less_bound)
 then show ?thesis by auto
 qed
 have "?a 1 <---- 0"
 unfolding tendsto_rabs_zero_iff power_one divide_inverse One_nat_def
 by (auto intro!: tendsto_mult LIMSEQ_linear LIMSEQ_inverse_real_of_nat simp del: of_nat_Suc)
 have "?diff 1 <---- 0"
 proof (rule LIMSEQ_I)
 fix r :: real
 assume "0 < r"
 obtain N :: nat where N_I: "N ≤ n ==> ?a 1 n < r" for n
 using LIMSEQ_D[OF ‹?a 1 <---- 0› ‹0 🚫›] by auto
 have "norm (?diff 1 n - 0) < r" if "N ≤ n" for n
 using ‹?diff 1 n ≤ ?a 1 n› N_I[OF that] by auto
 then show "∃N. ∀ n ≥ N. norm (?diff 1 n - 0) < r" by blast
 qed
 from this [unfolded tendsto_rabs_zero_iff, THEN tendsto_add [OF _ tendsto_const], of "- arctan 1", THEN tendsto_minus]
 have "(?c 1) sums (arctan 1)" unfolding sums_def by auto
 then have "arctan 1 = (∑i. ?c 1 i)" by (rule sums_unique)

 show ?thesis
 proof (cases "x = 1")
 case True
 then show ?thesis by (simp add: ‹arctan 1 = (∑ i. ?c 1 i)›)
 next
 case False
 then have "x = -1" using ‹∣x∣ = 1› by auto

 have "- (pi/2) < 0" using pi_gt_zero by auto
 have "- (2 * pi) < 0" using pi_gt_zero by auto

 have c_minus_minus: "?c (- 1) i = - ?c 1 i" for i by auto

 have "arctan (- 1) = arctan (tan (-(pi/4)))"
 unfolding tan_45 tan_minus ..
 also have "… = - (pi/4)"
 by (rule arctan_tan) (auto simp: order_less_trans[OF ‹- (pi/2) 🚫› pi_gt_zero])
 also have "… = - (arctan (tan (pi/4)))"
 unfolding neg_equal_iff_equal
 by (rule arctan_tan[symmetric]) (auto simp: order_less_trans[OF ‹- (2 * pi) 🚫› pi_gt_zero])
 also have "… = - (arctan 1)"
 unfolding tan_45 ..
 also have "… = - (∑ i. ?c 1 i)"
 using ‹arctan 1 = (∑ i. ?c 1 i)› by auto
 also have "… = (∑ i. ?c (- 1) i)"
 using suminf_minus[OF sums_summable[OF ‹(?c 1) sums (arctan 1)›]]
 unfolding c_minus_minus by auto
 finally show ?thesis using ‹x = -1› by auto
 qed
 qed
qed

lemma arctan_half: "arctan x = 2 * arctan (x / (1 + sqrt(1 + x🪙2)))"
 for x :: real
proof -
 obtain y where low: "- (pi/2) < y" and high: "y < pi/2" and y_eq: "tan y = x"
 using tan_total by blast
 then have low2: "- (pi/2) < y / 2" and high2: "y / 2 < pi/2"
 by auto

 have "0 < cos y" by (rule cos_gt_zero_pi[OF low high])
 then have "cos y ≠ 0" and cos_sqrt: "sqrt ((cos y)🪙2) = cos y"
 by auto

 have "1 + (tan y)🪙2 = 1 + (sin y)🪙2 / (cos y)🪙2"
 unfolding tan_def power_divide ..
 also have "… = (cos y)🪙2 / (cos y)🪙2 + (sin y)🪙2 / (cos y)🪙2"
 using ‹cos y ≠ 0› by auto
 also have "… = 1 / (cos y)🪙2"
 unfolding add_divide_distrib[symmetric] sin_cos_squared_add2 ..
 finally have "1 + (tan y)🪙2 = 1 / (cos y)🪙2" .

 have "sin y / (cos y + 1) = tan y / ((cos y + 1) / cos y)"
 unfolding tan_def using ‹cos y ≠ 0› by (simp add: field_simps)
 also have "… = tan y / (1 + 1 / cos y)"
 using ‹cos y ≠ 0› unfolding add_divide_distrib by auto
 also have "… = tan y / (1 + 1 / sqrt ((cos y)🪙2))"
 unfolding cos_sqrt ..
 also have "… = tan y / (1 + sqrt (1 / (cos y)🪙2))"
 unfolding real_sqrt_divide by auto
 finally have eq: "sin y / (cos y + 1) = tan y / (1 + sqrt(1 + (tan y)🪙2))"
 unfolding ‹1 + (tan y)🪙2 = 1 / (cos y)🪙2› .

 have "arctan x = y"
 using arctan_tan low high y_eq by auto
 also have "… = 2 * (arctan (tan (y/2)))"
 using arctan_tan[OF low2 high2] by auto
 also have "… = 2 * (arctan (sin y / (cos y + 1)))"
 unfolding tan_half by auto
 finally show ?thesis
 unfolding eq ‹tan y = x› .
qed

lemma arctan_monotone: "x < y ==> arctan x < arctan y"
 by (simp only: arctan_less_iff)

lemma arctan_monotone': "x ≤ y ==> arctan x ≤ arctan y"
 by (simp only: arctan_le_iff)

lemma arctan_inverse:
 assumes "x ≠ 0"
 shows "arctan (1/x) = sgn x * pi/2 - arctan x"
proof (rule arctan_unique)
 have 🍋: "x > 0 ==> arctan x < pi"
 using arctan_bounded [of x] by linarith
 show "- (pi/2) < sgn x * pi/2 - arctan x"
 using assms by (auto simp: sgn_real_def arctan algebra_simps 🍋)
 show "sgn x * pi/2 - arctan x < pi/2"
 using arctan_bounded [of "- x"] assms
 by (auto simp: algebra_simps sgn_real_def arctan_minus)
 show "tan (sgn x * pi/2 - arctan x) = 1/x"
 unfolding tan_inverse [of "arctan x", unfolded tan_arctan] sgn_real_def
 by (simp add: tan_def cos_arctan sin_arctan sin_diff cos_diff)
qed

theorem pi_series: "pi/4 = (∑k. (-1)^k * 1 / real (k * 2 + 1))"
 (is "_ = ?SUM")
proof -
 have "pi/4 = arctan 1"
 using arctan_one by auto
 also have "… = ?SUM"
 using arctan_series[of 1] by auto
 finally show ?thesis by auto
qed

subsection ‹Existence of Polar Coordinates›

lemma cos_x_y_le_one: "∣x / sqrt (x🪙2 + y🪙2)∣ ≤ 1"
 by (rule power2_le_imp_le [OF _ zero_le_one])
 (simp add: power_divide divide_le_eq not_sum_power2_lt_zero)

lemma polar_Ex: "∃r::real. ∃a. x = r * cos a ∧ y = r * sin a"
proof -
 have polar_ex1: "∃r a. x = r * cos a ∧ y = r * sin a" if "0 < y" for y
 proof -
 have "x = sqrt (x🪙2 + y🪙2) * cos (arccos (x / sqrt (x🪙2 + y🪙2)))"
 by (simp add: cos_arccos_abs [OF cos_x_y_le_one])
 moreover have "y = sqrt (x🪙2 + y🪙2) * sin (arccos (x / sqrt (x🪙2 + y🪙2)))"
 using that
 by (simp add: sin_arccos_abs [OF cos_x_y_le_one] power_divide right_diff_distrib flip: real_sqrt_mult)
 ultimately show ?thesis
 by blast
 qed
 show ?thesis
 proof (cases "0::real" y rule: linorder_cases)
 case less
 then show ?thesis
 by (rule polar_ex1)
 next
 case equal
 then show ?thesis
 by (force simp: intro!: cos_zero sin_zero)
 next
 case greater
 with polar_ex1 [where y="-y"] show ?thesis
 by auto (metis cos_minus minus_minus minus_mult_right sin_minus)
 qed
qed

subsection ‹Basics about polynomial functions: products, extremal behaviour and root counts›

lemma polynomial_product_nat:
 fixes x :: nat
 assumes m: "∧i. i > m ==> int (a i) = 0"
 and n: "∧j. j > n ==> int (b j) = 0"
 shows "(∑i≤m. (a i) * x ^ i) * (∑j≤n. (b j) * x ^ j) =
 (∑r≤m + n. (∑k≤r. (a k) * (b (r - k))) * x ^ r)"
 using polynomial_product [of m a n b x] assms
 by (simp only: of_nat_mult [symmetric] of_nat_power [symmetric]
 of_nat_eq_iff Int.int_sum [symmetric])

lemma polyfun_diff: (*COMPLEX_SUB_POLYFUN in HOL Light*)
 fixes x :: "'a::idom"
 assumes "1 ≤ n"
 shows "(∑i≤n. a i * x^i) - (∑i≤n. a i * y^i) =
 (x - y) * (∑j∑i=Suc j..n. a i * y^(i - j - 1)) * x^j)"
proof -
 have h: "bij_betw (λ(i,j). (j,i)) ((SIGMA i : atMost n. lessThan i)) (SIGMA j : lessThan n. {Suc j..n})"
 by (auto simp: bij_betw_def inj_on_def)
 have "(∑i≤n. a i * x^i) - (∑i≤n. a i * y^i) = (∑i≤n. a i * (x^i - y^i))"
 by (simp add: right_diff_distrib sum_subtractf)
 also have "… = (∑i≤n. a i * (x - y) * (∑j
 by (simp add: power_diff_sumr2 mult.assoc)
 also have "… = (∑i≤n. ∑j
 by (simp add: sum_distrib_left)
 also have "… = (∑(i,j) ∈ (SIGMA i : atMost n. lessThan i). a i * (x - y) * (y^(i - Suc j) * x^j))"
 by (simp add: sum.Sigma)
 also have "… = (∑(j,i) ∈ (SIGMA j : lessThan n. {Suc j..n}). a i * (x - y) * (y^(i - Suc j) * x^j))"
 by (auto simp: sum.reindex_bij_betw [OF h, symmetric] intro: sum.cong_simp)
 also have "… = (∑j∑i=Suc j..n. a i * (x - y) * (y^(i - Suc j) * x^j))"
 by (simp add: sum.Sigma)
 also have "… = (x - y) * (∑j∑i=Suc j..n. a i * y^(i - j - 1)) * x^j)"
 by (simp add: sum_distrib_left mult_ac)
 finally show ?thesis .
qed

lemma polyfun_diff_alt: (*COMPLEX_SUB_POLYFUN_ALT in HOL Light*)
 fixes x :: "'a::idom"
 assumes "1 ≤ n"
 shows "(∑i≤n. a i * x^i) - (∑i≤n. a i * y^i) =
 (x - y) * ((∑j∑k
proof -
 have "(∑i=Suc j..n. a i * y^(i - j - 1)) = (∑k
 if "j < n" for j :: nat
 proof -
 have "∧k. k < n - j ==> k ∈ (λi. i - Suc j) ` {Suc j..n}"
 by (rule_tac x="k + Suc j" in image_eqI, auto)
 then have h: "bij_betw (λi. i - (j + 1)) {Suc j..n} (lessThan (n-j))"
 by (auto simp: bij_betw_def inj_on_def)
 then show ?thesis
 by (auto simp: sum.reindex_bij_betw [OF h, symmetric] intro: sum.cong_simp)
 qed
 then show ?thesis
 by (simp add: polyfun_diff [OF assms] sum_distrib_right)
qed

lemma polyfun_linear_factor: (*COMPLEX_POLYFUN_LINEAR_FACTOR in HOL Light*)
 fixes a :: "'a::idom"
 shows "∃b. ∀z. (∑i≤n. c(i) * z^i) = (z - a) * (∑i∑i≤n. c(i) * a^i)"
proof (cases "n = 0")
 case True then show ?thesis
 by simp
next
 case False
 have "(∃b. ∀z. (∑i≤n. c i * z^i) = (z - a) * (∑i∑i≤n. c i * a^i)) ⟷
 (∃b. ∀z. (∑i≤n. c i * z^i) - (∑i≤n. c i * a^i) = (z - a) * (∑i
 by (simp add: algebra_simps)
 also have "… ⟷
 (∃b. ∀z. (z - a) * (∑j∑i = Suc j..n. c i * a^(i - Suc j)) * z^j) =
 (z - a) * (∑i
 using False by (simp add: polyfun_diff)
 also have "… = True" by auto
 finally show ?thesis
 by simp
qed

lemma polyfun_linear_factor_root: (*COMPLEX_POLYFUN_LINEAR_FACTOR_ROOT in HOL Light*)
 fixes a :: "'a::idom"
 assumes "(∑i≤n. c(i) * a^i) = 0"
 obtains b where "∧z. (∑i≤n. c i * z^i) = (z - a) * (∑i
 using polyfun_linear_factor [of c n a] assms by auto

(*The material of this section, up until this point, could go into a new theory of polynomials
 based on Main alone. The remaining material involves limits, continuity, series, etc.*)

lemma isCont_polynom: "isCont (λw. ∑i≤n. c i * w^i) a"
 for c :: "nat ==> 'a::real_normed_div_algebra"
 by simp

lemma zero_polynom_imp_zero_coeffs:
 fixes c :: "nat ==> 'a::{ab_semigroup_mult,real_normed_div_algebra}"
 assumes "∧w. (∑i≤n. c i * w^i) = 0" "k ≤ n"
 shows "c k = 0"
 using assms
proof (induction n arbitrary: c k)
 case 0
 then show ?case
 by simp
next
 case (Suc n c k)
 have [simp]: "c 0 = 0" using Suc.prems(1) [of 0]
 by simp
 have "(∑i≤Suc n. c i * w^i) = w * (∑i≤n. c (Suc i) * w^i)" for w
 proof -
 have "(∑i≤Suc n. c i * w^i) = (∑i≤n. c (Suc i) * w ^ Suc i)"
 unfolding Set_Interval.sum.atMost_Suc_shift
 by simp
 also have "… = w * (∑i≤n. c (Suc i) * w^i)"
 by (simp add: sum_distrib_left ac_simps)
 finally show ?thesis .
 qed
 then have w: "∧w. w ≠ 0 ==> (∑i≤n. c (Suc i) * w^i) = 0"
 using Suc by auto
 then have "(λh. ∑i≤n. c (Suc i) * h^i) ←-0→ 0"
 by (simp cong: LIM_cong) 🍋 ‹the case ‹w = 0› by continuity›
 then have "(∑i≤n. c (Suc i) * 0^i) = 0"
 using isCont_polynom [of 0 "λi. c (Suc i)" n] LIM_unique
 by (force simp: Limits.isCont_iff)
 then have "∧w. (∑i≤n. c (Suc i) * w^i) = 0"
 using w by metis
 then have "∧i. i ≤ n ==> c (Suc i) = 0"
 using Suc.IH [of "λi. c (Suc i)"] by blast
 then show ?case using ‹k ≤ Suc n›
 by (cases k) auto
qed

lemma polyfun_rootbound: (*COMPLEX_POLYFUN_ROOTBOUND in HOL Light*)
 fixes c :: "nat ==> 'a::{idom,real_normed_div_algebra}"
 assumes "c k ≠ 0" "k≤n"
 shows "finite {z. (∑i≤n. c(i) * z^i) = 0} ∧ card {z. (∑i≤n. c(i) * z^i) = 0} ≤ n"
 using assms
proof (induction n arbitrary: c k)
 case 0
 then show ?case
 by simp
next
 case (Suc m c k)
 let ?succase = ?case
 show ?case
 proof (cases "{z. (∑i≤Suc m. c(i) * z^i) = 0} = {}")
 case True
 then show ?succase
 by simp
 next
 case False
 then obtain z0 where z0: "(∑i≤Suc m. c(i) * z0^i) = 0"
 by blast
 then obtain b where b: "∧w. (∑i≤Suc m. c i * w^i) = (w - z0) * (∑i≤m. b i * w^i)"
 using polyfun_linear_factor_root [OF z0, unfolded lessThan_Suc_atMost]
 by blast
 then have eq: "{z. (∑i≤Suc m. c i * z^i) = 0} = insert z0 {z. (∑i≤m. b i * z^i) = 0}"
 by auto
 have "¬ (∀k≤m. b k = 0)"
 proof
 assume [simp]: "∀k≤m. b k = 0"
 then have "∧w. (∑i≤m. b i * w^i) = 0"
 by simp
 then have "∧w. (∑i≤Suc m. c i * w^i) = 0"
 using b by simp
 then have "∧k. k ≤ Suc m ==> c k = 0"
 using zero_polynom_imp_zero_coeffs by blast
 then show False using Suc.prems by blast
 qed
 then obtain k' where bk': "b k' ≠ 0" "k' ≤ m"
 by blast
 show ?succase
 using Suc.IH [of b k'] bk'
 by (simp add: eq card_insert_if del: sum.atMost_Suc)
 qed
qed

lemma
 fixes c :: "nat ==> 'a::{idom,real_normed_div_algebra}"
 assumes "c k ≠ 0" "k≤n"
 shows polyfun_roots_finite: "finite {z. (∑i≤n. c(i) * z^i) = 0}"
 and polyfun_roots_card: "card {z. (∑i≤n. c(i) * z^i) = 0} ≤ n"
 using polyfun_rootbound assms by auto

lemma polyfun_finite_roots: (*COMPLEX_POLYFUN_FINITE_ROOTS in HOL Light*)
 fixes c :: "nat ==> 'a::{idom,real_normed_div_algebra}"
 shows "finite {x. (∑i≤n. c i * x^i) = 0} ⟷ (∃i≤n. c i ≠ 0)"
 (is "?lhs = ?rhs")
proof
 assume ?lhs
 moreover have "¬ finite {x. (∑i≤n. c i * x^i) = 0}" if "∀i≤n. c i = 0"
 proof -
 from that have "∧x. (∑i≤n. c i * x^i) = 0"
 by simp
 then show ?thesis
 using ex_new_if_finite [OF infinite_UNIV_char_0 [where 'a='a]]
 by auto
 qed
 ultimately show ?rhs by metis
next
 assume ?rhs
 with polyfun_rootbound show ?lhs by blast
qed

lemma polyfun_eq_0: "(∀x. (∑i≤n. c i * x^i) = 0) ⟷ (∀i≤n. c i = 0)"
 for c :: "nat ==> 'a::{idom,real_normed_div_algebra}"
 (*COMPLEX_POLYFUN_EQ_0 in HOL Light*)
 using zero_polynom_imp_zero_coeffs by auto

lemma polyfun_eq_coeffs: "(∀x. (∑i≤n. c i * x^i) = (∑i≤n. d i * x^i)) ⟷ (∀i≤n. c i = d i)"
 for c :: "nat ==> 'a::{idom,real_normed_div_algebra}"
proof -
 have "(∀x. (∑i≤n. c i * x^i) = (∑i≤n. d i * x^i)) ⟷ (∀x. (∑i≤n. (c i - d i) * x^i) = 0)"
 by (simp add: left_diff_distrib Groups_Big.sum_subtractf)
 also have "… ⟷ (∀i≤n. c i - d i = 0)"
 by (rule polyfun_eq_0)
 finally show ?thesis
 by simp
qed

lemma polyfun_eq_const: (*COMPLEX_POLYFUN_EQ_CONST in HOL Light*)
 fixes c :: "nat ==> 'a::{idom,real_normed_div_algebra}"
 shows "(∀x. (∑i≤n. c i * x^i) = k) ⟷ c 0 = k ∧ (∀i ∈ {1..n}. c i = 0)"
 (is "?lhs = ?rhs")
proof -
 have *: "∀x. (∑i≤n. (if i=0 then k else 0) * x^i) = k"
 by (induct n) auto
 show ?thesis
 proof
 assume ?lhs
 with * have "(∀i≤n. c i = (if i=0 then k else 0))"
 by (simp add: polyfun_eq_coeffs [symmetric])
 then show ?rhs by simp
 next
 assume ?rhs
 then show ?lhs by (induct n) auto
 qed
qed

lemma root_polyfun:
 fixes z :: "'a::idom"
 assumes "1 ≤ n"
 shows "z^n = a ⟷ (∑i≤n. (if i = 0 then -a else if i=n then 1 else 0) * z^i) = 0"
 using assms by (cases n) (simp_all add: sum.atLeast_Suc_atMost atLeast0AtMost [symmetric])

lemma
 assumes "SORT_CONSTRAINT('a::{idom,real_normed_div_algebra})"
 and "1 ≤ n"
 shows finite_roots_unity: "finite {z::'a. z^n = 1}"
 and card_roots_unity: "card {z::'a. z^n = 1} ≤ n"
 using polyfun_rootbound [of "λi. if i = 0 then -1 else if i=n then 1 else 0" n n] assms(2)
 by (auto simp: root_polyfun [OF assms(2)])

subsection ‹Hyperbolic functions›

definition sinh :: "'a :: {banach, real_normed_algebra_1} ==> 'a" where
 "sinh x = (exp x - exp (-x)) /🪙R 2"

definition cosh :: "'a :: {banach, real_normed_algebra_1} ==> 'a" where
 "cosh x = (exp x + exp (-x)) /🪙R 2"

definition tanh :: "'a :: {banach, real_normed_field} ==> 'a" where
 "tanh x = sinh x / cosh x"

definition arsinh :: "'a :: {banach, real_normed_algebra_1, ln} ==> 'a" where
 "arsinh x = ln (x + (x^2 + 1) powr of_real (1/2))"

definition arcosh :: "'a :: {banach, real_normed_algebra_1, ln} ==> 'a" where
 "arcosh x = ln (x + (x^2 - 1) powr of_real (1/2))"

definition artanh :: "'a :: {banach, real_normed_field, ln} ==> 'a" where
 "artanh x = ln ((1 + x) / (1 - x)) / 2"

lemma arsinh_0 [simp]: "arsinh 0 = 0"
 by (simp add: arsinh_def)

lemma arcosh_1 [simp]: "arcosh 1 = 0"
 by (simp add: arcosh_def)

lemma artanh_0 [simp]: "artanh 0 = 0"
 by (simp add: artanh_def)

lemma tanh_altdef:
 "tanh x = (exp x - exp (-x)) / (exp x + exp (-x))"
proof -
 have "tanh x = (2 *🪙R sinh x) / (2 *🪙R cosh x)"
 by (simp add: tanh_def scaleR_conv_of_real)
 also have "2 *🪙R sinh x = exp x - exp (-x)"
 by (simp add: sinh_def)
 also have "2 *🪙R cosh x = exp x + exp (-x)"
 by (simp add: cosh_def)
 finally show ?thesis .
qed

lemma tanh_real_altdef: "tanh (x::real) = (1 - exp (- 2 * x)) / (1 + exp (- 2 * x))"
proof -
 have [simp]: "exp (2 * x) = exp x * exp x" "exp (x * 2) = exp x * exp x"
 by (subst exp_add [symmetric]; simp)+
 have "tanh x = (2 * exp (-x) * sinh x) / (2 * exp (-x) * cosh x)"
 by (simp add: tanh_def)
 also have "2 * exp (-x) * sinh x = 1 - exp (-2*x)"
 by (simp add: exp_minus field_simps sinh_def)
 also have "2 * exp (-x) * cosh x = 1 + exp (-2*x)"
 by (simp add: exp_minus field_simps cosh_def)
 finally show ?thesis .
qed

lemma sinh_converges: "(λn. if even n then 0 else x ^ n /🪙R fact n) sums sinh x"
proof -
 have "(λn. (x ^ n /🪙R fact n - (-x) ^ n /🪙R fact n) /🪙R 2) sums sinh x"
 unfolding sinh_def by (intro sums_scaleR_right sums_diff exp_converges)
 also have "(λn. (x ^ n /🪙R fact n - (-x) ^ n /🪙R fact n) /🪙R 2) =
 (λn. if even n then 0 else x ^ n /🪙R fact n)" by auto
 finally show ?thesis .
qed

lemma cosh_converges: "(λn. if even n then x ^ n /🪙R fact n else 0) sums cosh x"
proof -
 have "(λn. (x ^ n /🪙R fact n + (-x) ^ n /🪙R fact n) /🪙R 2) sums cosh x"
 unfolding cosh_def by (intro sums_scaleR_right sums_add exp_converges)
 also have "(λn. (x ^ n /🪙R fact n + (-x) ^ n /🪙R fact n) /🪙R 2) =
 (λn. if even n then x ^ n /🪙R fact n else 0)" by auto
 finally show ?thesis .
qed

lemma sinh_0 [simp]: "sinh 0 = 0"
 by (simp add: sinh_def)

lemma cosh_0 [simp]: "cosh 0 = 1"
proof -
 have "cosh 0 = (1/2) *🪙R (1 + 1)" by (simp add: cosh_def)
 also have "… = 1" by (rule scaleR_half_double)
 finally show ?thesis .
qed

lemma tanh_0 [simp]: "tanh 0 = 0"
 by (simp add: tanh_def)

lemma sinh_minus [simp]: "sinh (- x) = -sinh x"
 by (simp add: sinh_def algebra_simps)

lemma cosh_minus [simp]: "cosh (- x) = cosh x"
 by (simp add: cosh_def algebra_simps)

lemma tanh_minus [simp]: "tanh (-x) = -tanh x"
 by (simp add: tanh_def)

lemma sinh_ln_real: "x > 0 ==> sinh (ln x :: real) = (x - inverse x) / 2"
 by (simp add: sinh_def exp_minus)

lemma cosh_ln_real: "x > 0 ==> cosh (ln x :: real) = (x + inverse x) / 2"
 by (simp add: cosh_def exp_minus)

lemma tanh_ln_real:
 "tanh (ln x :: real) = (x ^ 2 - 1) / (x ^ 2 + 1)" if "x > 0"
proof -
 from that have "(x * 2 - inverse x * 2) * (x🪙2 + 1) =
 (x🪙2 - 1) * (2 * x + 2 * inverse x)"
 by (simp add: field_simps power2_eq_square)
 moreover have "x🪙2 + 1 > 0"
 using that by (simp add: ac_simps add_pos_nonneg)
 moreover have "2 * x + 2 * inverse x > 0"
 using that by (simp add: add_pos_pos)
 ultimately have "(x * 2 - inverse x * 2) /
 (2 * x + 2 * inverse x) =
 (x🪙2 - 1) / (x🪙2 + 1)"
 by (simp add: frac_eq_eq)
 with that show ?thesis
 by (simp add: tanh_def sinh_ln_real cosh_ln_real)
qed

lemma has_field_derivative_scaleR_right [derivative_intros]:
 "(f has_field_derivative D) F ==> ((λx. c *🪙R f x) has_field_derivative (c *🪙R D)) F"
 unfolding has_field_derivative_def
 using has_derivative_scaleR_right[of f "λx. D * x" F c]
 by (simp add: mult_scaleR_left [symmetric] del: mult_scaleR_left)

lemma has_field_derivative_sinh [THEN DERIV_chain2, derivative_intros]:
 "(sinh has_field_derivative cosh x) (at (x :: 'a :: {banach, real_normed_field}))"
 unfolding sinh_def cosh_def by (auto intro!: derivative_eq_intros)

lemma has_field_derivative_cosh [THEN DERIV_chain2, derivative_intros]:
 "(cosh has_field_derivative sinh x) (at (x :: 'a :: {banach, real_normed_field}))"
 unfolding sinh_def cosh_def by (auto intro!: derivative_eq_intros)

lemma has_field_derivative_tanh [THEN DERIV_chain2, derivative_intros]:
 "cosh x ≠ 0 ==> (tanh has_field_derivative 1 - tanh x ^ 2)
 (at (x :: 'a :: {banach, real_normed_field}))"
 unfolding tanh_def by (auto intro!: derivative_eq_intros simp: power2_eq_square field_split_simps)

lemma has_derivative_sinh [derivative_intros]:
 fixes g :: "'a ==> ('a :: {banach, real_normed_field})"
 assumes "(g has_derivative (λx. Db * x)) (at x within s)"
 shows "((λx. sinh (g x)) has_derivative (λy. (cosh (g x) * Db) * y)) (at x within s)"
proof -
 have "((λx. - g x) has_derivative (λy. -(Db * y))) (at x within s)"
 using assms by (intro derivative_intros)
 also have "(λy. -(Db * y)) = (λx. (-Db) * x)" by (simp add: fun_eq_iff)
 finally have "((λx. sinh (g x)) has_derivative
 (λy. (exp (g x) * Db * y - exp (-g x) * (-Db) * y) /🪙R 2)) (at x within s)"
 unfolding sinh_def by (intro derivative_intros assms)
 also have "(λy. (exp (g x) * Db * y - exp (-g x) * (-Db) * y) /🪙R 2) = (λy. (cosh (g x) * Db) * y)"
 by (simp add: fun_eq_iff cosh_def algebra_simps)
 finally show ?thesis .
qed

lemma has_derivative_cosh [derivative_intros]:
 fixes g :: "'a ==> ('a :: {banach, real_normed_field})"
 assumes "(g has_derivative (λy. Db * y)) (at x within s)"
 shows "((λx. cosh (g x)) has_derivative (λy. (sinh (g x) * Db) * y)) (at x within s)"
proof -
 have "((λx. - g x) has_derivative (λy. -(Db * y))) (at x within s)"
 using assms by (intro derivative_intros)
 also have "(λy. -(Db * y)) = (λy. (-Db) * y)" by (simp add: fun_eq_iff)
 finally have "((λx. cosh (g x)) has_derivative
 (λy. (exp (g x) * Db * y + exp (-g x) * (-Db) * y) /🪙R 2)) (at x within s)"
 unfolding cosh_def by (intro derivative_intros assms)
 also have "(λy. (exp (g x) * Db * y + exp (-g x) * (-Db) * y) /🪙R 2) = (λy. (sinh (g x) * Db) * y)"
 by (simp add: fun_eq_iff sinh_def algebra_simps)
 finally show ?thesis .
qed

lemma sinh_plus_cosh: "sinh x + cosh x = exp x"
proof -
 have "sinh x + cosh x = (1/2) *🪙R (exp x + exp x)"
 by (simp add: sinh_def cosh_def algebra_simps)
 also have "… = exp x" by (rule scaleR_half_double)
 finally show ?thesis .
qed

lemma cosh_plus_sinh: "cosh x + sinh x = exp x"
 by (subst add.commute) (rule sinh_plus_cosh)

lemma cosh_minus_sinh: "cosh x - sinh x = exp (-x)"
proof -
 have "cosh x - sinh x = (1/2) *🪙R (exp (-x) + exp (-x))"
 by (simp add: sinh_def cosh_def algebra_simps)
 also have "… = exp (-x)" by (rule scaleR_half_double)
 finally show ?thesis .
qed

lemma sinh_minus_cosh: "sinh x - cosh x = -exp (-x)"
 using cosh_minus_sinh[of x] by (simp add: algebra_simps)

context
 fixes x :: "'a :: {real_normed_field, banach}"
begin

lemma sinh_zero_iff: "sinh x = 0 ⟷ exp x ∈ {1, -1}"
 by (auto simp: sinh_def field_simps exp_minus power2_eq_square square_eq_1_iff)

lemma cosh_zero_iff: "cosh x = 0 ⟷ exp x ^ 2 = -1"
 by (auto simp: cosh_def exp_minus field_simps power2_eq_square eq_neg_iff_add_eq_0)

lemma cosh_square_eq: "cosh x ^ 2 = sinh x ^ 2 + 1"
 by (simp add: cosh_def sinh_def algebra_simps power2_eq_square exp_add [symmetric]
 scaleR_conv_of_real)

lemma sinh_square_eq: "sinh x ^ 2 = cosh x ^ 2 - 1"
 by (simp add: cosh_square_eq)

lemma hyperbolic_pythagoras: "cosh x ^ 2 - sinh x ^ 2 = 1"
 by (simp add: cosh_square_eq)

lemma sinh_add: "sinh (x + y) = sinh x * cosh y + cosh x * sinh y"
 by (simp add: sinh_def cosh_def algebra_simps scaleR_conv_of_real exp_add [symmetric])

lemma sinh_diff: "sinh (x - y) = sinh x * cosh y - cosh x * sinh y"
 by (simp add: sinh_def cosh_def algebra_simps scaleR_conv_of_real exp_add [symmetric])

lemma cosh_add: "cosh (x + y) = cosh x * cosh y + sinh x * sinh y"
 by (simp add: sinh_def cosh_def algebra_simps scaleR_conv_of_real exp_add [symmetric])

lemma cosh_diff: "cosh (x - y) = cosh x * cosh y - sinh x * sinh y"
 by (simp add: sinh_def cosh_def algebra_simps scaleR_conv_of_real exp_add [symmetric])

lemma tanh_add:
 "tanh (x + y) = (tanh x + tanh y) / (1 + tanh x * tanh y)"
 if "cosh x ≠ 0" "cosh y ≠ 0"
proof -
 have "(sinh x * cosh y + cosh x * sinh y) * (1 + sinh x * sinh y / (cosh x * cosh y)) =
 (cosh x * cosh y + sinh x * sinh y) * ((sinh x * cosh y + sinh y * cosh x) / (cosh y * cosh x))"
 using that by (simp add: field_split_simps)
 also have "(sinh x * cosh y + sinh y * cosh x) / (cosh y * cosh x) = sinh x / cosh x + sinh y / cosh y"
 using that by (simp add: field_split_simps)
 finally have "(sinh x * cosh y + cosh x * sinh y) * (1 + sinh x * sinh y / (cosh x * cosh y)) =
 (sinh x / cosh x + sinh y / cosh y) * (cosh x * cosh y + sinh x * sinh y)"
 by simp
 then show ?thesis
 using that by (auto simp add: tanh_def sinh_add cosh_add eq_divide_eq)
 (simp_all add: field_split_simps)
qed

lemma sinh_double: "sinh (2 * x) = 2 * sinh x * cosh x"
 using sinh_add[of x] by simp

lemma cosh_double: "cosh (2 * x) = cosh x ^ 2 + sinh x ^ 2"
 using cosh_add[of x] by (simp add: power2_eq_square)

end

lemma sinh_field_def: "sinh z = (exp z - exp (-z)) / (2 :: 'a :: {banach, real_normed_field})"
 by (simp add: sinh_def scaleR_conv_of_real)

lemma cosh_field_def: "cosh z = (exp z + exp (-z)) / (2 :: 'a :: {banach, real_normed_field})"
 by (simp add: cosh_def scaleR_conv_of_real)

subsubsection ‹More specific properties of the real functions›

lemma plus_inverse_ge_2:
 fixes x :: real
 assumes "x > 0"
 shows "x + inverse x ≥ 2"
proof -
 have "0 ≤ (x - 1) ^ 2" by simp
 also have "… = x^2 - 2*x + 1" by (simp add: power2_eq_square algebra_simps)
 finally show ?thesis using assms by (simp add: field_simps power2_eq_square)
qed

lemma sinh_real_nonneg_iff [simp]: "sinh (x :: real) ≥ 0 ⟷ x ≥ 0"
 by (simp add: sinh_def)

lemma sinh_real_pos_iff [simp]: "sinh (x :: real) > 0 ⟷ x > 0"
 by (simp add: sinh_def)

lemma sinh_real_nonpos_iff [simp]: "sinh (x :: real) ≤ 0 ⟷ x ≤ 0"
 by (simp add: sinh_def)

lemma sinh_real_neg_iff [simp]: "sinh (x :: real) < 0 ⟷ x < 0"
 by (simp add: sinh_def)

lemma cosh_real_ge_1: "cosh (x :: real) ≥ 1"
 using plus_inverse_ge_2[of "exp x"] by (simp add: cosh_def exp_minus)

lemma cosh_real_pos [simp]: "cosh (x :: real) > 0"
 using cosh_real_ge_1[of x] by simp

lemma cosh_real_nonneg[simp]: "cosh (x :: real) ≥ 0"
 using cosh_real_ge_1[of x] by simp

lemma cosh_real_nonzero [simp]: "cosh (x :: real) ≠ 0"
 using cosh_real_ge_1[of x] by simp

lemma arsinh_real_def: "arsinh (x::real) = ln (x + sqrt (x^2 + 1))"
 by (simp add: arsinh_def powr_half_sqrt)

lemma arcosh_real_def: "x ≥ 1 ==> arcosh (x::real) = ln (x + sqrt (x^2 - 1))"
 by (simp add: arcosh_def powr_half_sqrt)

lemma arsinh_real_aux: "0 < x + sqrt (x ^ 2 + 1 :: real)"
proof (cases "x < 0")
 case True
 have "(-x) ^ 2 = x ^ 2" by simp
 also have "x ^ 2 < x ^ 2 + 1" by simp
 finally have "sqrt ((-x) ^ 2) < sqrt (x ^ 2 + 1)"
 by (rule real_sqrt_less_mono)
 thus ?thesis using True by simp
qed (auto simp: add_nonneg_pos)

lemma arsinh_minus_real [simp]: "arsinh (-x::real) = -arsinh x"
proof -
 have "arsinh (-x) = ln (sqrt (x🪙2 + 1) - x)"
 by (simp add: arsinh_real_def)
 also have "sqrt (x^2 + 1) - x = inverse (sqrt (x^2 + 1) + x)"
 using arsinh_real_aux[of x] by (simp add: field_split_simps algebra_simps power2_eq_square)
 also have "ln … = -arsinh x"
 using arsinh_real_aux[of x] by (simp add: arsinh_real_def ln_inverse)
 finally show ?thesis .
qed

lemma artanh_minus_real [simp]:
 assumes "abs x < 1"
 shows "artanh (-x::real) = -artanh x"
 by (smt (verit) artanh_def assms field_sum_of_halves ln_div)

lemma sinh_less_cosh_real: "sinh (x :: real) < cosh x"
 by (simp add: sinh_def cosh_def)

lemma sinh_le_cosh_real: "sinh (x :: real) ≤ cosh x"
 by (simp add: sinh_def cosh_def)

lemma tanh_real_lt_1: "tanh (x :: real) < 1"
 by (simp add: tanh_def sinh_less_cosh_real)

lemma tanh_real_gt_neg1: "tanh (x :: real) > -1"
proof -
 have "- cosh x < sinh x" by (simp add: sinh_def cosh_def field_split_simps)
 thus ?thesis by (simp add: tanh_def field_simps)
qed

lemma tanh_real_bounds: "tanh (x :: real) ∈ {-1<..<1}"
 using tanh_real_lt_1 tanh_real_gt_neg1 by simp

context
 fixes x :: real
begin

lemma arsinh_sinh_real: "arsinh (sinh x) = x"
 by (simp add: arsinh_real_def powr_def sinh_square_eq sinh_plus_cosh)

lemma arcosh_cosh_real: "x ≥ 0 ==> arcosh (cosh x) = x"
 by (simp add: arcosh_real_def powr_def cosh_square_eq cosh_real_ge_1 cosh_plus_sinh)

lemma artanh_tanh_real: "artanh (tanh x) = x"
proof -
 have "artanh (tanh x) = ln (cosh x * (cosh x + sinh x) / (cosh x * (cosh x - sinh x))) / 2"
 by (simp add: artanh_def tanh_def field_split_simps)
 also have "cosh x * (cosh x + sinh x) / (cosh x * (cosh x - sinh x)) =
 (cosh x + sinh x) / (cosh x - sinh x)" by simp
 also have "… = (exp x)^2"
 by (simp add: cosh_plus_sinh cosh_minus_sinh exp_minus field_simps power2_eq_square)
 also have "ln ((exp x)^2) / 2 = x" by (simp add: ln_realpow)
 finally show ?thesis .
qed

lemma sinh_real_zero_iff [simp]: "sinh x = 0 ⟷ x = 0"
 by (metis arsinh_0 arsinh_sinh_real sinh_0)

lemma cosh_real_one_iff [simp]: "cosh x = 1 ⟷ x = 0"
 by (smt (verit, best) Transcendental.arcosh_cosh_real cosh_0 cosh_minus)

lemma tanh_real_nonneg_iff [simp]: "tanh x ≥ 0 ⟷ x ≥ 0"
 by (simp add: tanh_def field_simps)

lemma tanh_real_pos_iff [simp]: "tanh x > 0 ⟷ x > 0"
 by (simp add: tanh_def field_simps)

lemma tanh_real_nonpos_iff [simp]: "tanh x ≤ 0 ⟷ x ≤ 0"
 by (simp add: tanh_def field_simps)

lemma tanh_real_neg_iff [simp]: "tanh x < 0 ⟷ x < 0"
 by (simp add: tanh_def field_simps)

lemma tanh_real_zero_iff [simp]: "tanh x = 0 ⟷ x = 0"
 by (simp add: tanh_def field_simps)

end

lemma sinh_real_strict_mono: "strict_mono (sinh :: real ==> real)"
 by (force intro: strict_monoI DERIV_pos_imp_increasing [where f=sinh] derivative_intros)

lemma cosh_real_strict_mono:
 assumes "0 ≤ x" and "x < (y::real)"
 shows "cosh x < cosh y"
proof -
 from assms have "∃z>x. z < y ∧ cosh y - cosh x = (y - x) * sinh z"
 by (intro MVT2) (auto dest: connectedD_interval intro!: derivative_eq_intros)
 then obtain z where z: "z > x" "z < y" "cosh y - cosh x = (y - x) * sinh z" by blast
 note ‹cosh y - cosh x = (y - x) * sinh z›
 also from ‹z > x› and assms have "(y - x) * sinh z > 0" by (intro mult_pos_pos) auto
 finally show "cosh x < cosh y" by simp
qed

lemma tanh_real_strict_mono: "strict_mono (tanh :: real ==> real)"
proof -
 have "tanh x ^ 2 < 1" for x :: real
 using tanh_real_bounds[of x] by (simp add: abs_square_less_1 abs_if)
 then show ?thesis
 by (force intro!: strict_monoI DERIV_pos_imp_increasing [where f=tanh] derivative_intros)
qed

lemma sinh_real_abs [simp]: "sinh (abs x :: real) = abs (sinh x)"
 by (simp add: abs_if)

lemma cosh_real_abs [simp]: "cosh (abs x :: real) = cosh x"
 by (simp add: abs_if)

lemma tanh_real_abs [simp]: "tanh (abs x :: real) = abs (tanh x)"
 by (auto simp: abs_if)

lemma sinh_real_eq_iff [simp]: "sinh x = sinh y ⟷ x = (y :: real)"
 using sinh_real_strict_mono by (simp add: strict_mono_eq)

lemma tanh_real_eq_iff [simp]: "tanh x = tanh y ⟷ x = (y :: real)"
 using tanh_real_strict_mono by (simp add: strict_mono_eq)

lemma cosh_real_eq_iff [simp]: "cosh x = cosh y ⟷ abs x = abs (y :: real)"
proof -
 have "cosh x = cosh y ⟷ x = y" if "x ≥ 0" "y ≥ 0" for x y :: real
 using cosh_real_strict_mono[of x y] cosh_real_strict_mono[of y x] that
 by (cases x y rule: linorder_cases) auto
 from this[of "abs x" "abs y"] show ?thesis by simp
qed

lemma sinh_real_le_iff [simp]: "sinh x ≤ sinh y ⟷ x ≤ (y::real)"
 using sinh_real_strict_mono by (simp add: strict_mono_less_eq)

lemma cosh_real_nonneg_le_iff: "x ≥ 0 ==> y ≥ 0 ==> cosh x ≤ cosh y ⟷ x ≤ (y::real)"
 using cosh_real_strict_mono[of x y] cosh_real_strict_mono[of y x]
 by (cases x y rule: linorder_cases) auto

lemma cosh_real_nonpos_le_iff: "x ≤ 0 ==> y ≤ 0 ==> cosh x ≤ cosh y ⟷ x ≥ (y::real)"
 using cosh_real_nonneg_le_iff[of "-x" "-y"] by simp

lemma tanh_real_le_iff [simp]: "tanh x ≤ tanh y ⟷ x ≤ (y::real)"
 using tanh_real_strict_mono by (simp add: strict_mono_less_eq)

lemma sinh_real_less_iff [simp]: "sinh x < sinh y ⟷ x < (y::real)"
 using sinh_real_strict_mono by (simp add: strict_mono_less)

lemma cosh_real_nonneg_less_iff: "x ≥ 0 ==> y ≥ 0 ==> cosh x < cosh y ⟷ x < (y::real)"
 using cosh_real_strict_mono[of x y] cosh_real_strict_mono[of y x]
 by (cases x y rule: linorder_cases) auto

lemma cosh_real_nonpos_less_iff: "x ≤ 0 ==> y ≤ 0 ==> cosh x < cosh y ⟷ x > (y::real)"
 using cosh_real_nonneg_less_iff[of "-x" "-y"] by simp

lemma tanh_real_less_iff [simp]: "tanh x < tanh y ⟷ x < (y::real)"
 using tanh_real_strict_mono by (simp add: strict_mono_less)

subsubsection ‹Limits›

lemma sinh_real_at_top: "filterlim (sinh :: real ==> real) at_top at_top"
proof -
 have *: "((λx. - exp (- x)) ---> (-0::real)) at_top"
 by (intro tendsto_minus filterlim_compose[OF exp_at_bot] filterlim_uminus_at_bot_at_top)
 have "filterlim (λx. (1/2) * (-exp (-x) + exp x) :: real) at_top at_top"
 by (rule filterlim_tendsto_pos_mult_at_top[OF _ _
 filterlim_tendsto_add_at_top[OF *]] tendsto_const)+ (auto simp: exp_at_top)
 also have "(λx. (1/2) * (-exp (-x) + exp x) :: real) = sinh"
 by (simp add: fun_eq_iff sinh_def)
 finally show ?thesis .
qed

lemma sinh_real_at_bot: "filterlim (sinh :: real ==> real) at_bot at_bot"
proof -
 have "filterlim (λx. -sinh x :: real) at_bot at_top"
 by (simp add: filterlim_uminus_at_top [symmetric] sinh_real_at_top)
 also have "(λx. -sinh x :: real) = (λx. sinh (-x))" by simp
 finally show ?thesis by (subst filterlim_at_bot_mirror)
qed

lemma cosh_real_at_top: "filterlim (cosh :: real ==> real) at_top at_top"
proof -
 have *: "((λx. exp (- x)) ---> (0::real)) at_top"
 by (intro filterlim_compose[OF exp_at_bot] filterlim_uminus_at_bot_at_top)
 have "filterlim (λx. (1/2) * (exp (-x) + exp x) :: real) at_top at_top"
 by (rule filterlim_tendsto_pos_mult_at_top[OF _ _
 filterlim_tendsto_add_at_top[OF *]] tendsto_const)+ (auto simp: exp_at_top)
 also have "(λx. (1/2) * (exp (-x) + exp x) :: real) = cosh"
 by (simp add: fun_eq_iff cosh_def)
 finally show ?thesis .
qed

lemma cosh_real_at_bot: "filterlim (cosh :: real ==> real) at_top at_bot"
proof -
 have "filterlim (λx. cosh (-x) :: real) at_top at_top"
 by (simp add: cosh_real_at_top)
 thus ?thesis by (subst filterlim_at_bot_mirror)
qed

lemma tanh_real_at_top: "(tanh ---> (1::real)) at_top"
proof -
 have "((λx::real. (1 - exp (- 2 * x)) / (1 + exp (- 2 * x))) ---> (1 - 0) / (1 + 0)) at_top"
 by (intro tendsto_intros filterlim_compose[OF exp_at_bot]
 filterlim_tendsto_neg_mult_at_bot[OF tendsto_const] filterlim_ident) auto
 also have "(λx::real. (1 - exp (- 2 * x)) / (1 + exp (- 2 * x))) = tanh"
 by (rule ext) (simp add: tanh_real_altdef)
 finally show ?thesis by simp
qed

lemma tanh_real_at_bot: "(tanh ---> (-1::real)) at_bot"
proof -
 have "((λx::real. -tanh x) ---> -1) at_top"
 by (intro tendsto_minus tanh_real_at_top)
 also have "(λx. -tanh x :: real) = (λx. tanh (-x))" by simp
 finally show ?thesis by (subst filterlim_at_bot_mirror)
qed

subsubsection ‹Properties of the inverse hyperbolic functions›

lemma isCont_sinh: "isCont sinh (x :: 'a :: {real_normed_field, banach})"
 unfolding sinh_def [abs_def] by (auto intro!: continuous_intros)

lemma isCont_cosh: "isCont cosh (x :: 'a :: {real_normed_field, banach})"
 unfolding cosh_def [abs_def] by (auto intro!: continuous_intros)

lemma isCont_tanh: "cosh x ≠ 0 ==> isCont tanh (x :: 'a :: {real_normed_field, banach})"
 unfolding tanh_def [abs_def]
 by (auto intro!: continuous_intros isCont_divide isCont_sinh isCont_cosh)

lemma continuous_on_sinh [continuous_intros]:
 fixes f :: "_ ==>'a::{real_normed_field,banach}"
 assumes "continuous_on A f"
 shows "continuous_on A (λx. sinh (f x))"
 unfolding sinh_def using assms by (intro continuous_intros)

lemma continuous_on_cosh [continuous_intros]:
 fixes f :: "_ ==>'a::{real_normed_field,banach}"
 assumes "continuous_on A f"
 shows "continuous_on A (λx. cosh (f x))"
 unfolding cosh_def using assms by (intro continuous_intros)

lemma continuous_sinh [continuous_intros]:
 fixes f :: "_ ==>'a::{real_normed_field,banach}"
 assumes "continuous F f"
 shows "continuous F (λx. sinh (f x))"
 unfolding sinh_def using assms by (intro continuous_intros)

lemma continuous_cosh [continuous_intros]:
 fixes f :: "_ ==>'a::{real_normed_field,banach}"
 assumes "continuous F f"
 shows "continuous F (λx. cosh (f x))"
 unfolding cosh_def using assms by (intro continuous_intros)

lemma continuous_on_tanh [continuous_intros]:
 fixes f :: "_ ==>'a::{real_normed_field,banach}"
 assumes "continuous_on A f" "∧x. x ∈ A ==> cosh (f x) ≠ 0"
 shows "continuous_on A (λx. tanh (f x))"
 unfolding tanh_def using assms by (intro continuous_intros) auto

lemma continuous_at_within_tanh [continuous_intros]:
 fixes f :: "_ ==>'a::{real_normed_field,banach}"
 assumes "continuous (at x within A) f" "cosh (f x) ≠ 0"
 shows "continuous (at x within A) (λx. tanh (f x))"
 unfolding tanh_def using assms by (intro continuous_intros continuous_divide) auto

lemma continuous_tanh [continuous_intros]:
 fixes f :: "_ ==>'a::{real_normed_field,banach}"
 assumes "continuous F f" "cosh (f (Lim F (λx. x))) ≠ 0"
 shows "continuous F (λx. tanh (f x))"
 unfolding tanh_def using assms by (intro continuous_intros continuous_divide) auto

lemma tendsto_sinh [tendsto_intros]:
 fixes f :: "_ ==>'a::{real_normed_field,banach}"
 shows "(f ---> a) F ==> ((λx. sinh (f x)) ---> sinh a) F"
 by (rule isCont_tendsto_compose [OF isCont_sinh])

lemma tendsto_cosh [tendsto_intros]:
 fixes f :: "_ ==>'a::{real_normed_field,banach}"
 shows "(f ---> a) F ==> ((λx. cosh (f x)) ---> cosh a) F"
 by (rule isCont_tendsto_compose [OF isCont_cosh])

lemma tendsto_tanh [tendsto_intros]:
 fixes f :: "_ ==>'a::{real_normed_field,banach}"
 shows "(f ---> a) F ==> cosh a ≠ 0 ==> ((λx. tanh (f x)) ---> tanh a) F"
 by (rule isCont_tendsto_compose [OF isCont_tanh])

lemma arsinh_real_has_field_derivative [derivative_intros]:
 fixes x :: real
 shows "(arsinh has_field_derivative (1 / (sqrt (x ^ 2 + 1)))) (at x within A)"
proof -
 have pos: "1 + x ^ 2 > 0" by (intro add_pos_nonneg) auto
 from pos arsinh_real_aux[of x] show ?thesis unfolding arsinh_def [abs_def]
 by (auto intro!: derivative_eq_intros simp: powr_minus powr_half_sqrt field_split_simps)
qed

lemma arcosh_real_has_field_derivative [derivative_intros]:
 fixes x :: real
 assumes "x > 1"
 shows "(arcosh has_field_derivative (1 / (sqrt (x ^ 2 - 1)))) (at x within A)"
proof -
 from assms have "x + sqrt (x🪙2 - 1) > 0" by (simp add: add_pos_pos)
 thus ?thesis using assms unfolding arcosh_def [abs_def]
 by (auto intro!: derivative_eq_intros
 simp: powr_minus powr_half_sqrt field_split_simps power2_eq_1_iff)
qed

lemma artanh_real_has_field_derivative [derivative_intros]:
 "(artanh has_field_derivative (1 / (1 - x ^ 2))) (at x within A)" if
 "∣x∣ < 1" for x :: real
proof -
 from that have "- 1 < x" "x < 1" by linarith+
 hence "(artanh has_field_derivative (4 - 4 * x) / ((1 + x) * (1 - x) * (1 - x) * 4))
 (at x within A)" unfolding artanh_def [abs_def]
 by (auto intro!: derivative_eq_intros simp: powr_minus powr_half_sqrt)
 also have "(4 - 4 * x) / ((1 + x) * (1 - x) * (1 - x) * 4) = 1 / ((1 + x) * (1 - x))"
 using ‹-1 🚫› ‹x 🚫› by (simp add: frac_eq_eq)
 also have "(1 + x) * (1 - x) = 1 - x ^ 2"
 by (simp add: algebra_simps power2_eq_square)
 finally show ?thesis .
qed

lemma cosh_double_cosh: "cosh (2 * x :: 'a :: {banach, real_normed_field}) = 2 * (cosh x)🪙2 - 1"
 using cosh_double[of x] by (simp add: sinh_square_eq)

lemma sinh_multiple_reduce:
 "sinh (x * numeral n :: 'a :: {real_normed_field, banach}) =
 sinh x * cosh (x * of_nat (pred_numeral n)) + cosh x * sinh (x * of_nat (pred_numeral n))"
proof -
 have "numeral n = of_nat (pred_numeral n) + (1 :: 'a)"
 by (metis add.commute numeral_eq_Suc of_nat_Suc of_nat_numeral)
 also have "sinh (x * …) = sinh (x * of_nat (pred_numeral n) + x)"
 unfolding of_nat_Suc by (simp add: ring_distribs)
 finally show ?thesis
 by (simp add: sinh_add)
qed

lemma cosh_multiple_reduce:
 "cosh (x * numeral n :: 'a :: {real_normed_field, banach}) =
 cosh (x * of_nat (pred_numeral n)) * cosh x + sinh (x * of_nat (pred_numeral n)) * sinh x"
proof -
 have "numeral n = of_nat (pred_numeral n) + (1 :: 'a)"
 by (metis add.commute numeral_eq_Suc of_nat_Suc of_nat_numeral)
 also have "cosh (x * …) = cosh (x * of_nat (pred_numeral n) + x)"
 unfolding of_nat_Suc by (simp add: ring_distribs)
 finally show ?thesis
 by (simp add: cosh_add)
qed

lemma cosh_arcosh_real [simp]:
 assumes "x ≥ (1 :: real)"
 shows "cosh (arcosh x) = x"
proof -
 have "eventually (λt::real. cosh t ≥ x) at_top"
 using cosh_real_at_top by (simp add: filterlim_at_top)
 then obtain t where "t ≥ 1" "cosh t ≥ x"
 by (metis eventually_at_top_linorder linorder_not_le order_le_less)
 moreover have "isCont cosh (y :: real)" for y
 by (intro continuous_intros)
 ultimately obtain y where "y ≥ 0" "x = cosh y"
 using IVT[of cosh 0 x t] assms by auto
 thus ?thesis
 by (simp add: arcosh_cosh_real)
qed

lemma arcosh_eq_0_iff_real [simp]: "x ≥ 1 ==> arcosh x = 0 ⟷ x = (1 :: real)"
 using cosh_arcosh_real by fastforce

lemma arcosh_nonneg_real [simp]:
 assumes "x ≥ 1"
 shows "arcosh (x :: real) ≥ 0"
proof -
 have "1 + 0 ≤ x + (x🪙2 - 1) powr (1 / 2)"
 using assms by (intro add_mono) auto
 thus ?thesis unfolding arcosh_def by simp
qed

lemma arcosh_real_strict_mono:
 fixes x y :: real
 assumes "1 ≤ x" "x < y"
 shows "arcosh x < arcosh y"
proof -
 have "cosh (arcosh x) < cosh (arcosh y)"
 by (subst (1 2) cosh_arcosh_real) (use assms in auto)
 thus ?thesis
 using assms by (subst (asm) cosh_real_nonneg_less_iff) auto
qed

lemma arcosh_less_iff_real [simp]:
 fixes x y :: real
 assumes "1 ≤ x" "1 ≤ y"
 shows "arcosh x < arcosh y ⟷ x < y"
 using arcosh_real_strict_mono[of x y] arcosh_real_strict_mono[of y x] assms
 by (cases x y rule: linorder_cases) auto

lemma arcosh_real_gt_1_iff [simp]: "x ≥ 1 ==> arcosh x > 0 ⟷ x ≠ (1 :: real)"
 using arcosh_less_iff_real[of 1 x] by (auto simp del: arcosh_less_iff_real)

lemma sinh_arcosh_real: "x ≥ 1 ==> sinh (arcosh x) = sqrt (x🪙2 - 1)"
 by (rule sym, rule real_sqrt_unique) (auto simp: sinh_square_eq)

lemma sinh_arsinh_real [simp]: "sinh (arsinh x :: real) = x"
proof -
 have "eventually (λt::real. sinh t ≥ x) at_top"
 using sinh_real_at_top by (simp add: filterlim_at_top)
 then obtain t where "sinh t ≥ x"
 by (metis eventually_at_top_linorder linorder_not_le order_le_less)
 moreover have "eventually (λt::real. sinh t ≤ x) at_bot"
 using sinh_real_at_bot by (simp add: filterlim_at_bot)
 then obtain t' where "t' ≤ t" "sinh t' ≤ x"
 by (metis eventually_at_bot_linorder nle_le)
 moreover have "isCont sinh (y :: real)" for y
 by (intro continuous_intros)
 ultimately obtain y where "x = sinh y"
 using IVT[of sinh t' x t] by auto
 thus ?thesis
 by (simp add: arsinh_sinh_real)
qed

lemma arsinh_real_strict_mono:
 fixes x y :: real
 assumes "x < y"
 shows "arsinh x < arsinh y"
proof -
 have "sinh (arsinh x) < sinh (arsinh y)"
 by (subst (1 2) sinh_arsinh_real) (use assms in auto)
 thus ?thesis
 using assms by (subst (asm) sinh_real_less_iff) auto
qed

lemma arsinh_less_iff_real [simp]:
 fixes x y :: real
 shows "arsinh x < arsinh y ⟷ x < y"
 using arsinh_real_strict_mono[of x y] arsinh_real_strict_mono[of y x]
 by (cases x y rule: linorder_cases) auto

lemma arsinh_real_eq_0_iff [simp]: "arsinh x = 0 ⟷ x = (0 :: real)"
 by (metis arsinh_0 sinh_arsinh_real)

lemma arsinh_real_pos_iff [simp]: "arsinh x > 0 ⟷ x > (0 :: real)"
 using arsinh_less_iff_real[of 0 x] by (simp del: arsinh_less_iff_real)

lemma arsinh_real_neg_iff [simp]: "arsinh x < 0 ⟷ x < (0 :: real)"
 using arsinh_less_iff_real[of x 0] by (simp del: arsinh_less_iff_real)

lemma cosh_arsinh_real: "cosh (arsinh x) = sqrt (x🪙2 + 1)"
 by (rule sym, rule real_sqrt_unique) (auto simp: cosh_square_eq)

lemma continuous_on_arsinh [continuous_intros]: "continuous_on A (arsinh :: real ==> real)"
 by (rule DERIV_continuous_on derivative_intros)+

lemma continuous_on_arcosh [continuous_intros]:
 assumes "A ⊆ {1..}"
 shows "continuous_on A (arcosh :: real ==> real)"
proof -
 have pos: "x + sqrt (x ^ 2 - 1) > 0" if "x ≥ 1" for x
 using that by (intro add_pos_nonneg) auto
 show ?thesis
 unfolding arcosh_def [abs_def]
 by (intro continuous_on_subset [OF _ assms] continuous_on_ln continuous_on_add
 continuous_on_id continuous_on_powr')
 (auto dest: pos simp: powr_half_sqrt intro!: continuous_intros)
qed

lemma continuous_on_artanh [continuous_intros]:
 assumes "A ⊆ {-1<..<1}"
 shows "continuous_on A (artanh :: real ==> real)"
 unfolding artanh_def [abs_def]
 by (intro continuous_on_subset [OF _ assms]) (auto intro!: continuous_intros)

lemma continuous_on_arsinh' [continuous_intros]:
 fixes f :: "real ==> real"
 assumes "continuous_on A f"
 shows "continuous_on A (λx. arsinh (f x))"
 by (rule continuous_on_compose2[OF continuous_on_arsinh assms]) auto

lemma continuous_on_arcosh' [continuous_intros]:
 fixes f :: "real ==> real"
 assumes "continuous_on A f" "∧x. x ∈ A ==> f x ≥ 1"
 shows "continuous_on A (λx. arcosh (f x))"
 by (rule continuous_on_compose2[OF continuous_on_arcosh assms(1) order.refl])
 (use assms(2) in auto)

lemma continuous_on_artanh' [continuous_intros]:
 fixes f :: "real ==> real"
 assumes "continuous_on A f" "∧x. x ∈ A ==> f x ∈ {-1<..<1}"
 shows "continuous_on A (λx. artanh (f x))"
 by (rule continuous_on_compose2[OF continuous_on_artanh assms(1) order.refl])
 (use assms(2) in auto)

lemma isCont_arsinh [continuous_intros]: "isCont arsinh (x :: real)"
 using continuous_on_arsinh[of UNIV] by (auto simp: continuous_on_eq_continuous_at)

lemma isCont_arcosh [continuous_intros]:
 assumes "x > 1"
 shows "isCont arcosh (x :: real)"
proof -
 have "continuous_on {1::real<..} arcosh"
 by (rule continuous_on_arcosh) auto
 with assms show ?thesis by (auto simp: continuous_on_eq_continuous_at)
qed

lemma isCont_artanh [continuous_intros]:
 assumes "x > -1" "x < 1"
 shows "isCont artanh (x :: real)"
proof -
 have "continuous_on {-1<..<(1::real)} artanh"
 by (rule continuous_on_artanh) auto
 with assms show ?thesis by (auto simp: continuous_on_eq_continuous_at)
qed

lemma tendsto_arsinh [tendsto_intros]: "(f ---> a) F ==> ((λx. arsinh (f x)) ---> arsinh a) F"
 for f :: "_ ==> real"
 by (rule isCont_tendsto_compose [OF isCont_arsinh])

lemma tendsto_arcosh_strong [tendsto_intros]:
 fixes f :: "_ ==> real"
 assumes "(f ---> a) F" "a ≥ 1" "eventually (λx. f x ≥ 1) F"
 shows "((λx. arcosh (f x)) ---> arcosh a) F"
 by (rule continuous_on_tendsto_compose[OF continuous_on_arcosh[OF order.refl]])
 (use assms in auto)

lemma tendsto_arcosh:
 fixes f :: "_ ==> real"
 assumes "(f ---> a) F" "a > 1"
 shows "((λx. arcosh (f x)) ---> arcosh a) F"
 by (rule isCont_tendsto_compose [OF isCont_arcosh]) (use assms in auto)

lemma tendsto_arcosh_at_left_1: "(arcosh ---> 0) (at_right (1::real))"
proof -
 have "(arcosh ---> arcosh 1) (at_right (1::real))"
 by (rule tendsto_arcosh_strong) (auto simp: eventually_at intro!: exI[of _ 1])
 thus ?thesis by simp
qed

lemma tendsto_artanh [tendsto_intros]:
 fixes f :: "'a ==> real"
 assumes "(f ---> a) F" "a > -1" "a < 1"
 shows "((λx. artanh (f x)) ---> artanh a) F"
 by (rule isCont_tendsto_compose [OF isCont_artanh]) (use assms in auto)

lemma continuous_arsinh [continuous_intros]:
 "continuous F f ==> continuous F (λx. arsinh (f x :: real))"
 unfolding continuous_def by (rule tendsto_arsinh)

(* TODO: This rule does not work for one-sided continuity at 1 *)
lemma continuous_arcosh_strong [continuous_intros]:
 assumes "continuous F f" "eventually (λx. f x ≥ 1) F"
 shows "continuous F (λx. arcosh (f x :: real))"
proof (cases "F = bot")
 case False
 show ?thesis
 unfolding continuous_def
 proof (intro tendsto_arcosh_strong)
 show "1 ≤ f (Lim F (λx. x))"
 using assms False unfolding continuous_def by (rule tendsto_lowerbound)
 qed (insert assms, auto simp: continuous_def)
qed auto

lemma continuous_arcosh:
 "continuous F f ==> f (Lim F (λx. x)) > 1 ==> continuous F (λx. arcosh (f x :: real))"
 unfolding continuous_def by (rule tendsto_arcosh) auto

lemma continuous_artanh [continuous_intros]:
 "continuous F f ==> f (Lim F (λx. x)) ∈ {-1<..<1} ==> continuous F (λx. artanh (f x :: real))"
 unfolding continuous_def by (rule tendsto_artanh) auto

lemma arsinh_real_at_top:
 "filterlim (arsinh :: real ==> real) at_top at_top"
proof (subst filterlim_cong[OF refl refl])
 show "filterlim (λx. ln (x + sqrt (1 + x🪙2))) at_top at_top"
 by (intro filterlim_compose[OF ln_at_top filterlim_at_top_add_at_top] filterlim_ident
 filterlim_compose[OF sqrt_at_top] filterlim_tendsto_add_at_top[OF tendsto_const]
 filterlim_pow_at_top) auto
qed (auto intro!: eventually_mono[OF eventually_ge_at_top[of 1]] simp: arsinh_real_def add_ac)

lemma arsinh_real_at_bot:
 "filterlim (arsinh :: real ==> real) at_bot at_bot"
proof -
 have "filterlim (λx::real. -arsinh x) at_bot at_top"
 by (subst filterlim_uminus_at_top [symmetric]) (rule arsinh_real_at_top)
 also have "(λx::real. -arsinh x) = (λx. arsinh (-x))" by simp
 finally show ?thesis
 by (subst filterlim_at_bot_mirror)
qed

lemma arcosh_real_at_top:
 "filterlim (arcosh :: real ==> real) at_top at_top"
proof (subst filterlim_cong[OF refl refl])
 show "filterlim (λx. ln (x + sqrt (-1 + x🪙2))) at_top at_top"
 by (intro filterlim_compose[OF ln_at_top filterlim_at_top_add_at_top] filterlim_ident
 filterlim_compose[OF sqrt_at_top] filterlim_tendsto_add_at_top[OF tendsto_const]
 filterlim_pow_at_top) auto
qed (auto intro!: eventually_mono[OF eventually_ge_at_top[of 1]] simp: arcosh_real_def)

lemma artanh_real_at_left_1:
 "filterlim (artanh :: real ==> real) at_top (at_left 1)"
proof -
 have *: "filterlim (λx::real. (1 + x) / (1 - x)) at_top (at_left 1)"
 by (rule LIM_at_top_divide)
 (auto intro!: tendsto_eq_intros eventually_mono[OF eventually_at_left_real[of 0]])
 have "filterlim (λx::real. (1/2) * ln ((1 + x) / (1 - x))) at_top (at_left 1)"
 by (intro filterlim_tendsto_pos_mult_at_top[OF tendsto_const] *
 filterlim_compose[OF ln_at_top]) auto
 also have "(λx::real. (1/2) * ln ((1 + x) / (1 - x))) = artanh"
 by (simp add: artanh_def [abs_def])
 finally show ?thesis .
qed

lemma artanh_real_at_right_1:
 "filterlim (artanh :: real ==> real) at_bot (at_right (-1))"
proof -
 have "?thesis ⟷ filterlim (λx::real. -artanh x) at_top (at_right (-1))"
 by (simp add: filterlim_uminus_at_bot)
 also have "… ⟷ filterlim (λx::real. artanh (-x)) at_top (at_right (-1))"
 by (intro filterlim_cong refl eventually_mono[OF eventually_at_right_real[of "-1" "1"]]) auto
 also have "… ⟷ filterlim (artanh :: real ==> real) at_top (at_left 1)"
 by (simp add: filterlim_at_left_to_right)
 also have … by (rule artanh_real_at_left_1)
 finally show ?thesis .
qed

subsection ‹Simprocs for root and power literals›

lemma numeral_powr_numeral_real [simp]:
 "numeral m powr numeral n = (numeral m ^ numeral n :: real)"
 by (simp add: powr_numeral)

context
begin

private lemma sqrt_numeral_simproc_aux:
 assumes "m * m ≡ n"
 shows "sqrt (numeral n :: real) ≡ numeral m"
proof -
 have "numeral n ≡ numeral m * (numeral m :: real)" by (simp add: assms [symmetric])
 moreover have "sqrt … ≡ numeral m" by (subst real_sqrt_abs2) simp
 ultimately show "sqrt (numeral n :: real) ≡ numeral m" by simp
qed

private lemma root_numeral_simproc_aux:
 assumes "Num.pow m n ≡ x"
 shows "root (numeral n) (numeral x :: real) ≡ numeral m"
 by (subst assms [symmetric], subst numeral_pow, subst real_root_pos2) simp_all

private lemma powr_numeral_simproc_aux:
 assumes "Num.pow y n = x"
 shows "numeral x powr (m / numeral n :: real) ≡ numeral y powr m"
 by (subst assms [symmetric], subst numeral_pow, subst powr_numeral [symmetric])
 (simp, subst powr_powr, simp_all)

private lemma numeral_powr_inverse_eq:
 "numeral x powr (inverse (numeral n)) = numeral x powr (1 / numeral n :: real)"
 by simp

ML ‹

signature ROOT_NUMERAL_SIMPROC = sig

val sqrt : int option -> int -> int option
val sqrt' : int option -> int -> int option
val nth_root : int option -> int -> int -> int option
val nth_root' : int option -> int -> int -> int option
val sqrt_proc : Simplifier.proc
val root_proc : int * int -> Simplifier.proc
val powr_proc : int * int -> Simplifier.proc

end

structure Root_Numeral_Simproc : ROOT_NUMERAL_SIMPROC = struct

fun iterate NONE p f x =
let
fun go x = if p x then x else go (f x)
in
SOME (go x)
end
| iterate (SOME threshold) p f x =
let
fun go (threshold, x) =
if p x then SOME x else if threshold = 0 then NONE else go (threshold - 1, f x)
in
go (threshold, x)
end

fun nth_root _ 1 x = SOME x
| nth_root _ _ 0 = SOME 0
| nth_root _ _ 1 = SOME 1
| nth_root threshold n x =
let
fun newton_step y = ((n - 1) * y + x div Integer.pow (n - 1) y) div n
fun is_root y = Integer.pow n y 🚫x andalso x 🚫.pow n (y + 1)
in
if x 🚫 then
SOME 1
else if x 🚫.pow n 2 then
SOME 1
else
let
val y = Real.floor (Math.pow (Real.fromInt x, Real.fromInt 1 / Real.fromInt n))
in
if is_root y then
SOME y
else
iterate threshold is_root newton_step ((x + n - 1) div n)
end
end

fun nth_root' _ 1 x = SOME x
| nth_root' _ _ 0 = SOME 0
| nth_root' _ _ 1 = SOME 1
| nth_root' threshold n x = if x 🚫 then NONE else if x 🚫.pow n 2 then NONE else
case nth_root threshold n x of
NONE => NONE
| SOME y => if Integer.pow n y = x then SOME y else NONE

fun sqrt _ 0 = SOME 0
| sqrt _ 1 = SOME 1
| sqrt threshold n =
let
fun aux (a, b) = if n >= b * b then aux (b, b * b) else (a, b)
val (lower_root, lower_n) = aux (1, 2)
fun newton_step x = (x + n div x) div 2
fun is_sqrt r = r*r 🚫n andalso n 🚫r+1)*(r+1)
val y = Real.floor (Math.sqrt (Real.fromInt n))
in
if is_sqrt y then
SOME y
else
Option.mapPartial (iterate threshold is_sqrt newton_step o (fn x => x * lower_root))
(sqrt threshold (n div lower_n))
end

fun sqrt' threshold x =
case sqrt threshold x of
NONE => NONE
| SOME y => if y * y = x then SOME y else NONE

fun sqrt_proc ctxt ct =
let
val n = ct |> Thm.term_of |> dest_comb |> snd |> dest_comb |> snd |> HOLogic.dest_numeral
in
case sqrt' (SOME 10000) n of
NONE => NONE
| SOME m =>
SOME (Thm.instantiate' [] (map (SOME o Thm.cterm_of ctxt o HOLogic.mk_numeral) [m, n])
@{thm sqrt_numeral_simproc_aux})
end
handle TERM _ => NONE

fun root_proc (threshold1, threshold2) ctxt ct =
let
val [n, x] =
ct |> Thm.term_of |> strip_comb |> snd |> map (dest_comb #> snd #> HOLogic.dest_numeral)
in
if n > threshold1 orelse x > threshold2 then NONE else
case nth_root' (SOME 100) n x of
NONE => NONE
| SOME m =>
SOME (Thm.instantiate' [] (map (SOME o Thm.cterm_of ctxt o HOLogic.mk_numeral) [m, n, x])
@{thm root_numeral_simproc_aux})
end
handle TERM _ => NONE
| Match => NONE

fun powr_proc (threshold1, threshold2) ctxt ct =
let
val eq_thm = Conv.try_conv (Conv.rewr_conv @{thm numeral_powr_inverse_eq}) ct
val ct = Thm.dest_equals_rhs (Thm.cprop_of eq_thm)
val (_, [x, t]) = strip_comb (Thm.term_of ct)
val (_, [m, n]) = strip_comb t
val [x, n] = map (dest_comb #> snd #> HOLogic.dest_numeral) [x, n]
in
if n > threshold1 orelse x > threshold2 then NONE else
case nth_root' (SOME 100) n x of
NONE => NONE
| SOME y =>
let
val [y, n, x] = map HOLogic.mk_numeral [y, n, x]
val thm = Thm.instantiate' [] (map (SOME o Thm.cterm_of ctxt) [y, n, x, m])
@{thm powr_numeral_simproc_aux}
in
SOME (@{thm transitive} OF [eq_thm, thm])
end
end
handle TERM _ => NONE
| Match => NONE

end
›

end

simproc_setup sqrt_numeral ("sqrt (numeral n)") =
 ‹K Root_Numeral_Simproc.sqrt_proc›

simproc_setup root_numeral ("root (numeral n) (numeral x)") =
 ‹K (Root_Numeral_Simproc.root_proc (200, Integer.pow 200 2))›

simproc_setup powr_divide_numeral
 ("numeral x powr (m / numeral n :: real)" | "numeral x powr (inverse (numeral n) :: real)") =
 ‹K (Root_Numeral_Simproc.powr_proc (200, Integer.pow 200 2))›

lemma "root 100 1267650600228229401496703205376 = 2"
 by simp

lemma "sqrt 196 = 14"
 by simp

lemma "256 powr (7 / 4 :: real) = 16384"
 by simp

lemma "27 powr (inverse 3) = (3::real)"
 by simp

end

Messung V0.5 in Prozent

¤ Die Informationen auf dieser Webseite wurden nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit, noch Qualität der bereit gestellten Informationen zugesichert.0.692Bemerkung: (vorverarbeitet am 2026-05-03) ¤

*Bot Zugriff

Wurzel

Suchen

Beweissystem der NASA

Beweissystem Isabelle

NIST Cobol Testsuite

Cephes Mathematical Library

Wiener Entwicklungsmethode

Haftungshinweis

Die Informationen auf dieser Webseite wurden nach bestem Wissen sorgfältig zusammengestellt. Es wird jedoch weder Vollständigkeit, noch Richtigkeit, noch Qualität der bereit gestellten Informationen zugesichert.

Bemerkung:

Die farbliche Syntaxdarstellung und die Messung sind noch experimentell.