diff --git a/src/HOL/Analysis/Complex_Analysis_Basics.thy b/src/HOL/Analysis/Complex_Analysis_Basics.thy
--- a/src/HOL/Analysis/Complex_Analysis_Basics.thy
+++ b/src/HOL/Analysis/Complex_Analysis_Basics.thy
@@ -1,1144 +1,966 @@
 (*  Author: John Harrison, Marco Maggesi, Graziano Gentili, Gianni Ciolli, Valentina Bruno
     Ported from "hol_light/Multivariate/canal.ml" by L C Paulson (2014)
 *)
 
 section \<open>Complex Analysis Basics\<close>
+text \<open>Definitions of analytic and holomorphic functions, limit theorems, complex differentiation\<close>
 
 theory Complex_Analysis_Basics
   imports Derivative "HOL-Library.Nonpos_Ints"
 begin
 
-(* TODO FIXME: A lot of the things in here have nothing to do with complex analysis *)
-
 subsection\<^marker>\<open>tag unimportant\<close>\<open>General lemmas\<close>
 
 lemma nonneg_Reals_cmod_eq_Re: "z \<in> \<real>\<^sub>\<ge>\<^sub>0 \<Longrightarrow> norm z = Re z"
   by (simp add: complex_nonneg_Reals_iff cmod_eq_Re)
 
 lemma fact_cancel:
   fixes c :: "'a::real_field"
   shows "of_nat (Suc n) * c / (fact (Suc n)) = c / (fact n)"
   using of_nat_neq_0 by force
 
 lemma vector_derivative_cnj_within:
   assumes "at x within A \<noteq> bot" and "f differentiable at x within A"
   shows   "vector_derivative (\<lambda>z. cnj (f z)) (at x within A) = 
              cnj (vector_derivative f (at x within A))" (is "_ = cnj ?D")
 proof -
   let ?D = "vector_derivative f (at x within A)"
   from assms have "(f has_vector_derivative ?D) (at x within A)"
     by (subst (asm) vector_derivative_works)
   hence "((\<lambda>x. cnj (f x)) has_vector_derivative cnj ?D) (at x within A)"
     by (rule has_vector_derivative_cnj)
   thus ?thesis using assms by (auto dest: vector_derivative_within)
 qed
 
 lemma vector_derivative_cnj:
   assumes "f differentiable at x"
   shows   "vector_derivative (\<lambda>z. cnj (f z)) (at x) = cnj (vector_derivative f (at x))"
   using assms by (intro vector_derivative_cnj_within) auto
 
-lemma lambda_zero: "(\<lambda>h::'a::mult_zero. 0) = (*) 0"
-  by auto
-
-lemma lambda_one: "(\<lambda>x::'a::monoid_mult. x) = (*) 1"
-  by auto
-
-lemma uniformly_continuous_on_cmul_right [continuous_intros]:
-  fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_algebra"
-  shows "uniformly_continuous_on s f \<Longrightarrow> uniformly_continuous_on s (\<lambda>x. f x * c)"
-  using bounded_linear.uniformly_continuous_on[OF bounded_linear_mult_left] .
-
-lemma uniformly_continuous_on_cmul_left[continuous_intros]:
-  fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_algebra"
-  assumes "uniformly_continuous_on s f"
-    shows "uniformly_continuous_on s (\<lambda>x. c * f x)"
-by (metis assms bounded_linear.uniformly_continuous_on bounded_linear_mult_right)
-
-lemma continuous_on_norm_id [continuous_intros]: "continuous_on S norm"
-  by (intro continuous_on_id continuous_on_norm)
-
 lemma
   shows open_halfspace_Re_lt: "open {z. Re(z) < b}"
     and open_halfspace_Re_gt: "open {z. Re(z) > b}"
     and closed_halfspace_Re_ge: "closed {z. Re(z) \<ge> b}"
     and closed_halfspace_Re_le: "closed {z. Re(z) \<le> b}"
     and closed_halfspace_Re_eq: "closed {z. Re(z) = b}"
     and open_halfspace_Im_lt: "open {z. Im(z) < b}"
     and open_halfspace_Im_gt: "open {z. Im(z) > b}"
     and closed_halfspace_Im_ge: "closed {z. Im(z) \<ge> b}"
     and closed_halfspace_Im_le: "closed {z. Im(z) \<le> b}"
     and closed_halfspace_Im_eq: "closed {z. Im(z) = b}"
   by (intro open_Collect_less closed_Collect_le closed_Collect_eq continuous_on_Re
             continuous_on_Im continuous_on_id continuous_on_const)+
 
 lemma closed_complex_Reals: "closed (\<real> :: complex set)"
 proof -
   have "(\<real> :: complex set) = {z. Im z = 0}"
     by (auto simp: complex_is_Real_iff)
   then show ?thesis
     by (metis closed_halfspace_Im_eq)
 qed
 
 lemma closed_Real_halfspace_Re_le: "closed (\<real> \<inter> {w. Re w \<le> x})"
   by (simp add: closed_Int closed_complex_Reals closed_halfspace_Re_le)
 
 lemma closed_nonpos_Reals_complex [simp]: "closed (\<real>\<^sub>\<le>\<^sub>0 :: complex set)"
 proof -
   have "\<real>\<^sub>\<le>\<^sub>0 = \<real> \<inter> {z. Re(z) \<le> 0}"
     using complex_nonpos_Reals_iff complex_is_Real_iff by auto
   then show ?thesis
     by (metis closed_Real_halfspace_Re_le)
 qed
 
 lemma closed_Real_halfspace_Re_ge: "closed (\<real> \<inter> {w. x \<le> Re(w)})"
   using closed_halfspace_Re_ge
   by (simp add: closed_Int closed_complex_Reals)
 
 lemma closed_nonneg_Reals_complex [simp]: "closed (\<real>\<^sub>\<ge>\<^sub>0 :: complex set)"
 proof -
   have "\<real>\<^sub>\<ge>\<^sub>0 = \<real> \<inter> {z. Re(z) \<ge> 0}"
     using complex_nonneg_Reals_iff complex_is_Real_iff by auto
   then show ?thesis
     by (metis closed_Real_halfspace_Re_ge)
 qed
 
 lemma closed_real_abs_le: "closed {w \<in> \<real>. \<bar>Re w\<bar> \<le> r}"
 proof -
   have "{w \<in> \<real>. \<bar>Re w\<bar> \<le> r} = (\<real> \<inter> {w. Re w \<le> r}) \<inter> (\<real> \<inter> {w. Re w \<ge> -r})"
     by auto
   then show "closed {w \<in> \<real>. \<bar>Re w\<bar> \<le> r}"
     by (simp add: closed_Int closed_Real_halfspace_Re_ge closed_Real_halfspace_Re_le)
 qed
 
 lemma real_lim:
   fixes l::complex
   assumes "(f \<longlongrightarrow> l) F" and "\<not> trivial_limit F" and "eventually P F" and "\<And>a. P a \<Longrightarrow> f a \<in> \<real>"
   shows  "l \<in> \<real>"
 proof (rule Lim_in_closed_set[OF closed_complex_Reals _ assms(2,1)])
   show "eventually (\<lambda>x. f x \<in> \<real>) F"
     using assms(3, 4) by (auto intro: eventually_mono)
 qed
 
 lemma real_lim_sequentially:
   fixes l::complex
   shows "(f \<longlongrightarrow> l) sequentially \<Longrightarrow> (\<exists>N. \<forall>n\<ge>N. f n \<in> \<real>) \<Longrightarrow> l \<in> \<real>"
 by (rule real_lim [where F=sequentially]) (auto simp: eventually_sequentially)
 
 lemma real_series:
   fixes l::complex
   shows "f sums l \<Longrightarrow> (\<And>n. f n \<in> \<real>) \<Longrightarrow> l \<in> \<real>"
 unfolding sums_def
 by (metis real_lim_sequentially sum_in_Reals)
 
 lemma Lim_null_comparison_Re:
   assumes "eventually (\<lambda>x. norm(f x) \<le> Re(g x)) F" "(g \<longlongrightarrow> 0) F" shows "(f \<longlongrightarrow> 0) F"
   by (rule Lim_null_comparison[OF assms(1)] tendsto_eq_intros assms(2))+ simp
 
-
 lemma closed_segment_same_Re:
   assumes "Re a = Re b"
   shows   "closed_segment a b = {z. Re z = Re a \<and> Im z \<in> closed_segment (Im a) (Im b)}"
 proof safe
   fix z assume "z \<in> closed_segment a b"
   then obtain u where u: "u \<in> {0..1}" "z = a + of_real u * (b - a)"
     by (auto simp: closed_segment_def scaleR_conv_of_real algebra_simps)
   from assms show "Re z = Re a" by (auto simp: u)
   from u(1) show "Im z \<in> closed_segment (Im a) (Im b)"
     by (force simp: u closed_segment_def algebra_simps)
 next
   fix z assume [simp]: "Re z = Re a" and "Im z \<in> closed_segment (Im a) (Im b)"
   then obtain u where u: "u \<in> {0..1}" "Im z = Im a + of_real u * (Im b - Im a)"
     by (auto simp: closed_segment_def scaleR_conv_of_real algebra_simps)
   from u(1) show "z \<in> closed_segment a b" using assms
     by (force simp: u closed_segment_def algebra_simps scaleR_conv_of_real complex_eq_iff)
 qed
 
 lemma closed_segment_same_Im:
   assumes "Im a = Im b"
   shows   "closed_segment a b = {z. Im z = Im a \<and> Re z \<in> closed_segment (Re a) (Re b)}"
 proof safe
   fix z assume "z \<in> closed_segment a b"
   then obtain u where u: "u \<in> {0..1}" "z = a + of_real u * (b - a)"
     by (auto simp: closed_segment_def scaleR_conv_of_real algebra_simps)
   from assms show "Im z = Im a" by (auto simp: u)
   from u(1) show "Re z \<in> closed_segment (Re a) (Re b)"
     by (force simp: u closed_segment_def algebra_simps)
 next
   fix z assume [simp]: "Im z = Im a" and "Re z \<in> closed_segment (Re a) (Re b)"
   then obtain u where u: "u \<in> {0..1}" "Re z = Re a + of_real u * (Re b - Re a)"
     by (auto simp: closed_segment_def scaleR_conv_of_real algebra_simps)
   from u(1) show "z \<in> closed_segment a b" using assms
     by (force simp: u closed_segment_def algebra_simps scaleR_conv_of_real complex_eq_iff)
 qed
 
 subsection\<open>Holomorphic functions\<close>
 
 definition\<^marker>\<open>tag important\<close> holomorphic_on :: "[complex \<Rightarrow> complex, complex set] \<Rightarrow> bool"
            (infixl "(holomorphic'_on)" 50)
   where "f holomorphic_on s \<equiv> \<forall>x\<in>s. f field_differentiable (at x within s)"
 
 named_theorems\<^marker>\<open>tag important\<close> holomorphic_intros "structural introduction rules for holomorphic_on"
 
 lemma holomorphic_onI [intro?]: "(\<And>x. x \<in> s \<Longrightarrow> f field_differentiable (at x within s)) \<Longrightarrow> f holomorphic_on s"
   by (simp add: holomorphic_on_def)
 
 lemma holomorphic_onD [dest?]: "\<lbrakk>f holomorphic_on s; x \<in> s\<rbrakk> \<Longrightarrow> f field_differentiable (at x within s)"
   by (simp add: holomorphic_on_def)
 
 lemma holomorphic_on_imp_differentiable_on:
     "f holomorphic_on s \<Longrightarrow> f differentiable_on s"
   unfolding holomorphic_on_def differentiable_on_def
   by (simp add: field_differentiable_imp_differentiable)
 
 lemma holomorphic_on_imp_differentiable_at:
    "\<lbrakk>f holomorphic_on s; open s; x \<in> s\<rbrakk> \<Longrightarrow> f field_differentiable (at x)"
 using at_within_open holomorphic_on_def by fastforce
 
 lemma holomorphic_on_empty [holomorphic_intros]: "f holomorphic_on {}"
   by (simp add: holomorphic_on_def)
 
 lemma holomorphic_on_open:
     "open s \<Longrightarrow> f holomorphic_on s \<longleftrightarrow> (\<forall>x \<in> s. \<exists>f'. DERIV f x :> f')"
   by (auto simp: holomorphic_on_def field_differentiable_def has_field_derivative_def at_within_open [of _ s])
 
 lemma holomorphic_on_imp_continuous_on:
     "f holomorphic_on s \<Longrightarrow> continuous_on s f"
   by (metis field_differentiable_imp_continuous_at continuous_on_eq_continuous_within holomorphic_on_def)
 
 lemma holomorphic_on_subset [elim]:
     "f holomorphic_on s \<Longrightarrow> t \<subseteq> s \<Longrightarrow> f holomorphic_on t"
   unfolding holomorphic_on_def
   by (metis field_differentiable_within_subset subsetD)
 
 lemma holomorphic_transform: "\<lbrakk>f holomorphic_on s; \<And>x. x \<in> s \<Longrightarrow> f x = g x\<rbrakk> \<Longrightarrow> g holomorphic_on s"
   by (metis field_differentiable_transform_within linordered_field_no_ub holomorphic_on_def)
 
 lemma holomorphic_cong: "s = t ==> (\<And>x. x \<in> s \<Longrightarrow> f x = g x) \<Longrightarrow> f holomorphic_on s \<longleftrightarrow> g holomorphic_on t"
   by (metis holomorphic_transform)
 
 lemma holomorphic_on_linear [simp, holomorphic_intros]: "((*) c) holomorphic_on s"
   unfolding holomorphic_on_def by (metis field_differentiable_linear)
 
 lemma holomorphic_on_const [simp, holomorphic_intros]: "(\<lambda>z. c) holomorphic_on s"
   unfolding holomorphic_on_def by (metis field_differentiable_const)
 
 lemma holomorphic_on_ident [simp, holomorphic_intros]: "(\<lambda>x. x) holomorphic_on s"
   unfolding holomorphic_on_def by (metis field_differentiable_ident)
 
 lemma holomorphic_on_id [simp, holomorphic_intros]: "id holomorphic_on s"
   unfolding id_def by (rule holomorphic_on_ident)
 
 lemma holomorphic_on_compose:
   "f holomorphic_on s \<Longrightarrow> g holomorphic_on (f ` s) \<Longrightarrow> (g o f) holomorphic_on s"
   using field_differentiable_compose_within[of f _ s g]
   by (auto simp: holomorphic_on_def)
 
 lemma holomorphic_on_compose_gen:
   "f holomorphic_on s \<Longrightarrow> g holomorphic_on t \<Longrightarrow> f ` s \<subseteq> t \<Longrightarrow> (g o f) holomorphic_on s"
   by (metis holomorphic_on_compose holomorphic_on_subset)
 
 lemma holomorphic_on_balls_imp_entire:
   assumes "\<not>bdd_above A" "\<And>r. r \<in> A \<Longrightarrow> f holomorphic_on ball c r"
   shows   "f holomorphic_on B"
 proof (rule holomorphic_on_subset)
   show "f holomorphic_on UNIV" unfolding holomorphic_on_def
   proof
     fix z :: complex
     from \<open>\<not>bdd_above A\<close> obtain r where r: "r \<in> A" "r > norm (z - c)"
       by (meson bdd_aboveI not_le)
     with assms(2) have "f holomorphic_on ball c r" by blast
     moreover from r have "z \<in> ball c r" by (auto simp: dist_norm norm_minus_commute)
     ultimately show "f field_differentiable at z"
       by (auto simp: holomorphic_on_def at_within_open[of _ "ball c r"])
   qed
 qed auto
 
 lemma holomorphic_on_balls_imp_entire':
   assumes "\<And>r. r > 0 \<Longrightarrow> f holomorphic_on ball c r"
   shows   "f holomorphic_on B"
 proof (rule holomorphic_on_balls_imp_entire)
   {
     fix M :: real
     have "\<exists>x. x > max M 0" by (intro gt_ex)
     hence "\<exists>x>0. x > M" by auto
   }
   thus "\<not>bdd_above {(0::real)<..}" unfolding bdd_above_def
     by (auto simp: not_le)
 qed (insert assms, auto)
 
 lemma holomorphic_on_minus [holomorphic_intros]: "f holomorphic_on s \<Longrightarrow> (\<lambda>z. -(f z)) holomorphic_on s"
   by (metis field_differentiable_minus holomorphic_on_def)
 
 lemma holomorphic_on_add [holomorphic_intros]:
   "\<lbrakk>f holomorphic_on s; g holomorphic_on s\<rbrakk> \<Longrightarrow> (\<lambda>z. f z + g z) holomorphic_on s"
   unfolding holomorphic_on_def by (metis field_differentiable_add)
 
 lemma holomorphic_on_diff [holomorphic_intros]:
   "\<lbrakk>f holomorphic_on s; g holomorphic_on s\<rbrakk> \<Longrightarrow> (\<lambda>z. f z - g z) holomorphic_on s"
   unfolding holomorphic_on_def by (metis field_differentiable_diff)
 
 lemma holomorphic_on_mult [holomorphic_intros]:
   "\<lbrakk>f holomorphic_on s; g holomorphic_on s\<rbrakk> \<Longrightarrow> (\<lambda>z. f z * g z) holomorphic_on s"
   unfolding holomorphic_on_def by (metis field_differentiable_mult)
 
 lemma holomorphic_on_inverse [holomorphic_intros]:
   "\<lbrakk>f holomorphic_on s; \<And>z. z \<in> s \<Longrightarrow> f z \<noteq> 0\<rbrakk> \<Longrightarrow> (\<lambda>z. inverse (f z)) holomorphic_on s"
   unfolding holomorphic_on_def by (metis field_differentiable_inverse)
 
 lemma holomorphic_on_divide [holomorphic_intros]:
   "\<lbrakk>f holomorphic_on s; g holomorphic_on s; \<And>z. z \<in> s \<Longrightarrow> g z \<noteq> 0\<rbrakk> \<Longrightarrow> (\<lambda>z. f z / g z) holomorphic_on s"
   unfolding holomorphic_on_def by (metis field_differentiable_divide)
 
 lemma holomorphic_on_power [holomorphic_intros]:
   "f holomorphic_on s \<Longrightarrow> (\<lambda>z. (f z)^n) holomorphic_on s"
   unfolding holomorphic_on_def by (metis field_differentiable_power)
 
 lemma holomorphic_on_sum [holomorphic_intros]:
   "(\<And>i. i \<in> I \<Longrightarrow> (f i) holomorphic_on s) \<Longrightarrow> (\<lambda>x. sum (\<lambda>i. f i x) I) holomorphic_on s"
   unfolding holomorphic_on_def by (metis field_differentiable_sum)
 
 lemma holomorphic_on_prod [holomorphic_intros]:
   "(\<And>i. i \<in> I \<Longrightarrow> (f i) holomorphic_on s) \<Longrightarrow> (\<lambda>x. prod (\<lambda>i. f i x) I) holomorphic_on s"
   by (induction I rule: infinite_finite_induct) (auto intro: holomorphic_intros)
 
 lemma holomorphic_pochhammer [holomorphic_intros]:
   "f holomorphic_on A \<Longrightarrow> (\<lambda>s. pochhammer (f s) n) holomorphic_on A"
   by (induction n) (auto intro!: holomorphic_intros simp: pochhammer_Suc)
 
 lemma holomorphic_on_scaleR [holomorphic_intros]:
   "f holomorphic_on A \<Longrightarrow> (\<lambda>x. c *\<^sub>R f x) holomorphic_on A"
   by (auto simp: scaleR_conv_of_real intro!: holomorphic_intros)
 
 lemma holomorphic_on_Un [holomorphic_intros]:
   assumes "f holomorphic_on A" "f holomorphic_on B" "open A" "open B"
   shows   "f holomorphic_on (A \<union> B)"
   using assms by (auto simp: holomorphic_on_def  at_within_open[of _ A]
                              at_within_open[of _ B]  at_within_open[of _ "A \<union> B"] open_Un)
 
 lemma holomorphic_on_If_Un [holomorphic_intros]:
   assumes "f holomorphic_on A" "g holomorphic_on B" "open A" "open B"
   assumes "\<And>z. z \<in> A \<Longrightarrow> z \<in> B \<Longrightarrow> f z = g z"
   shows   "(\<lambda>z. if z \<in> A then f z else g z) holomorphic_on (A \<union> B)" (is "?h holomorphic_on _")
 proof (intro holomorphic_on_Un)
   note \<open>f holomorphic_on A\<close>
   also have "f holomorphic_on A \<longleftrightarrow> ?h holomorphic_on A"
     by (intro holomorphic_cong) auto
   finally show \<dots> .
 next
   note \<open>g holomorphic_on B\<close>
   also have "g holomorphic_on B \<longleftrightarrow> ?h holomorphic_on B"
     using assms by (intro holomorphic_cong) auto
   finally show \<dots> .
 qed (insert assms, auto)
 
 lemma DERIV_deriv_iff_field_differentiable:
   "DERIV f x :> deriv f x \<longleftrightarrow> f field_differentiable at x"
   unfolding field_differentiable_def by (metis DERIV_imp_deriv)
 
 lemma holomorphic_derivI:
      "\<lbrakk>f holomorphic_on S; open S; x \<in> S\<rbrakk>
       \<Longrightarrow> (f has_field_derivative deriv f x) (at x within T)"
 by (metis DERIV_deriv_iff_field_differentiable at_within_open  holomorphic_on_def has_field_derivative_at_within)
 
 lemma complex_derivative_chain:
   "f field_differentiable at x \<Longrightarrow> g field_differentiable at (f x)
     \<Longrightarrow> deriv (g o f) x = deriv g (f x) * deriv f x"
   by (metis DERIV_deriv_iff_field_differentiable DERIV_chain DERIV_imp_deriv)
 
 lemma deriv_linear [simp]: "deriv (\<lambda>w. c * w) = (\<lambda>z. c)"
   by (metis DERIV_imp_deriv DERIV_cmult_Id)
 
 lemma deriv_ident [simp]: "deriv (\<lambda>w. w) = (\<lambda>z. 1)"
   by (metis DERIV_imp_deriv DERIV_ident)
 
 lemma deriv_id [simp]: "deriv id = (\<lambda>z. 1)"
   by (simp add: id_def)
 
 lemma deriv_const [simp]: "deriv (\<lambda>w. c) = (\<lambda>z. 0)"
   by (metis DERIV_imp_deriv DERIV_const)
 
 lemma deriv_add [simp]:
   "\<lbrakk>f field_differentiable at z; g field_differentiable at z\<rbrakk>
    \<Longrightarrow> deriv (\<lambda>w. f w + g w) z = deriv f z + deriv g z"
   unfolding DERIV_deriv_iff_field_differentiable[symmetric]
   by (auto intro!: DERIV_imp_deriv derivative_intros)
 
 lemma deriv_diff [simp]:
   "\<lbrakk>f field_differentiable at z; g field_differentiable at z\<rbrakk>
    \<Longrightarrow> deriv (\<lambda>w. f w - g w) z = deriv f z - deriv g z"
   unfolding DERIV_deriv_iff_field_differentiable[symmetric]
   by (auto intro!: DERIV_imp_deriv derivative_intros)
 
 lemma deriv_mult [simp]:
   "\<lbrakk>f field_differentiable at z; g field_differentiable at z\<rbrakk>
    \<Longrightarrow> deriv (\<lambda>w. f w * g w) z = f z * deriv g z + deriv f z * g z"
   unfolding DERIV_deriv_iff_field_differentiable[symmetric]
   by (auto intro!: DERIV_imp_deriv derivative_eq_intros)
 
 lemma deriv_cmult:
   "f field_differentiable at z \<Longrightarrow> deriv (\<lambda>w. c * f w) z = c * deriv f z"
   by simp
 
 lemma deriv_cmult_right:
   "f field_differentiable at z \<Longrightarrow> deriv (\<lambda>w. f w * c) z = deriv f z * c"
   by simp
 
 lemma deriv_inverse [simp]:
   "\<lbrakk>f field_differentiable at z; f z \<noteq> 0\<rbrakk>
    \<Longrightarrow> deriv (\<lambda>w. inverse (f w)) z = - deriv f z / f z ^ 2"
   unfolding DERIV_deriv_iff_field_differentiable[symmetric]
   by (safe intro!: DERIV_imp_deriv derivative_eq_intros) (auto simp: field_split_simps power2_eq_square)
 
 lemma deriv_divide [simp]:
   "\<lbrakk>f field_differentiable at z; g field_differentiable at z; g z \<noteq> 0\<rbrakk>
    \<Longrightarrow> deriv (\<lambda>w. f w / g w) z = (deriv f z * g z - f z * deriv g z) / g z ^ 2"
   by (simp add: field_class.field_divide_inverse field_differentiable_inverse)
      (simp add: field_split_simps power2_eq_square)
 
 lemma deriv_cdivide_right:
   "f field_differentiable at z \<Longrightarrow> deriv (\<lambda>w. f w / c) z = deriv f z / c"
   by (simp add: field_class.field_divide_inverse)
 
 lemma complex_derivative_transform_within_open:
   "\<lbrakk>f holomorphic_on s; g holomorphic_on s; open s; z \<in> s; \<And>w. w \<in> s \<Longrightarrow> f w = g w\<rbrakk>
    \<Longrightarrow> deriv f z = deriv g z"
   unfolding holomorphic_on_def
   by (rule DERIV_imp_deriv)
      (metis DERIV_deriv_iff_field_differentiable has_field_derivative_transform_within_open at_within_open)
 
 lemma deriv_compose_linear:
   "f field_differentiable at (c * z) \<Longrightarrow> deriv (\<lambda>w. f (c * w)) z = c * deriv f (c * z)"
 apply (rule DERIV_imp_deriv)
   unfolding DERIV_deriv_iff_field_differentiable [symmetric]
   by (metis (full_types) DERIV_chain2 DERIV_cmult_Id mult.commute)
 
 
 lemma nonzero_deriv_nonconstant:
   assumes df: "DERIV f \<xi> :> df" and S: "open S" "\<xi> \<in> S" and "df \<noteq> 0"
     shows "\<not> f constant_on S"
 unfolding constant_on_def
 by (metis \<open>df \<noteq> 0\<close> has_field_derivative_transform_within_open [OF df S] DERIV_const DERIV_unique)
 
 lemma holomorphic_nonconstant:
   assumes holf: "f holomorphic_on S" and "open S" "\<xi> \<in> S" "deriv f \<xi> \<noteq> 0"
     shows "\<not> f constant_on S"
   by (rule nonzero_deriv_nonconstant [of f "deriv f \<xi>" \<xi> S])
     (use assms in \<open>auto simp: holomorphic_derivI\<close>)
 
-subsection\<^marker>\<open>tag unimportant\<close>\<open>Caratheodory characterization\<close>
-
-lemma field_differentiable_caratheodory_at:
-  "f field_differentiable (at z) \<longleftrightarrow>
-         (\<exists>g. (\<forall>w. f(w) - f(z) = g(w) * (w - z)) \<and> continuous (at z) g)"
-  using CARAT_DERIV [of f]
-  by (simp add: field_differentiable_def has_field_derivative_def)
-
-lemma field_differentiable_caratheodory_within:
-  "f field_differentiable (at z within s) \<longleftrightarrow>
-         (\<exists>g. (\<forall>w. f(w) - f(z) = g(w) * (w - z)) \<and> continuous (at z within s) g)"
-  using DERIV_caratheodory_within [of f]
-  by (simp add: field_differentiable_def has_field_derivative_def)
-
 subsection\<open>Analyticity on a set\<close>
 
 definition\<^marker>\<open>tag important\<close> analytic_on (infixl "(analytic'_on)" 50)
   where "f analytic_on S \<equiv> \<forall>x \<in> S. \<exists>e. 0 < e \<and> f holomorphic_on (ball x e)"
 
 named_theorems\<^marker>\<open>tag important\<close> analytic_intros "introduction rules for proving analyticity"
 
 lemma analytic_imp_holomorphic: "f analytic_on S \<Longrightarrow> f holomorphic_on S"
   by (simp add: at_within_open [OF _ open_ball] analytic_on_def holomorphic_on_def)
      (metis centre_in_ball field_differentiable_at_within)
 
 lemma analytic_on_open: "open S \<Longrightarrow> f analytic_on S \<longleftrightarrow> f holomorphic_on S"
 apply (auto simp: analytic_imp_holomorphic)
 apply (auto simp: analytic_on_def holomorphic_on_def)
 by (metis holomorphic_on_def holomorphic_on_subset open_contains_ball)
 
 lemma analytic_on_imp_differentiable_at:
   "f analytic_on S \<Longrightarrow> x \<in> S \<Longrightarrow> f field_differentiable (at x)"
  apply (auto simp: analytic_on_def holomorphic_on_def)
 by (metis open_ball centre_in_ball field_differentiable_within_open)
 
 lemma analytic_on_subset: "f analytic_on S \<Longrightarrow> T \<subseteq> S \<Longrightarrow> f analytic_on T"
   by (auto simp: analytic_on_def)
 
 lemma analytic_on_Un: "f analytic_on (S \<union> T) \<longleftrightarrow> f analytic_on S \<and> f analytic_on T"
   by (auto simp: analytic_on_def)
 
 lemma analytic_on_Union: "f analytic_on (\<Union>\<T>) \<longleftrightarrow> (\<forall>T \<in> \<T>. f analytic_on T)"
   by (auto simp: analytic_on_def)
 
 lemma analytic_on_UN: "f analytic_on (\<Union>i\<in>I. S i) \<longleftrightarrow> (\<forall>i\<in>I. f analytic_on (S i))"
   by (auto simp: analytic_on_def)
 
 lemma analytic_on_holomorphic:
   "f analytic_on S \<longleftrightarrow> (\<exists>T. open T \<and> S \<subseteq> T \<and> f holomorphic_on T)"
   (is "?lhs = ?rhs")
 proof -
   have "?lhs \<longleftrightarrow> (\<exists>T. open T \<and> S \<subseteq> T \<and> f analytic_on T)"
   proof safe
     assume "f analytic_on S"
     then show "\<exists>T. open T \<and> S \<subseteq> T \<and> f analytic_on T"
       apply (simp add: analytic_on_def)
       apply (rule exI [where x="\<Union>{U. open U \<and> f analytic_on U}"], auto)
       apply (metis open_ball analytic_on_open centre_in_ball)
       by (metis analytic_on_def)
   next
     fix T
     assume "open T" "S \<subseteq> T" "f analytic_on T"
     then show "f analytic_on S"
         by (metis analytic_on_subset)
   qed
   also have "... \<longleftrightarrow> ?rhs"
     by (auto simp: analytic_on_open)
   finally show ?thesis .
 qed
 
 lemma analytic_on_linear [analytic_intros,simp]: "((*) c) analytic_on S"
   by (auto simp add: analytic_on_holomorphic)
 
 lemma analytic_on_const [analytic_intros,simp]: "(\<lambda>z. c) analytic_on S"
   by (metis analytic_on_def holomorphic_on_const zero_less_one)
 
 lemma analytic_on_ident [analytic_intros,simp]: "(\<lambda>x. x) analytic_on S"
   by (simp add: analytic_on_def gt_ex)
 
 lemma analytic_on_id [analytic_intros]: "id analytic_on S"
   unfolding id_def by (rule analytic_on_ident)
 
 lemma analytic_on_compose:
   assumes f: "f analytic_on S"
       and g: "g analytic_on (f ` S)"
     shows "(g o f) analytic_on S"
 unfolding analytic_on_def
 proof (intro ballI)
   fix x
   assume x: "x \<in> S"
   then obtain e where e: "0 < e" and fh: "f holomorphic_on ball x e" using f
     by (metis analytic_on_def)
   obtain e' where e': "0 < e'" and gh: "g holomorphic_on ball (f x) e'" using g
     by (metis analytic_on_def g image_eqI x)
   have "isCont f x"
     by (metis analytic_on_imp_differentiable_at field_differentiable_imp_continuous_at f x)
   with e' obtain d where d: "0 < d" and fd: "f ` ball x d \<subseteq> ball (f x) e'"
      by (auto simp: continuous_at_ball)
   have "g \<circ> f holomorphic_on ball x (min d e)"
     apply (rule holomorphic_on_compose)
     apply (metis fh holomorphic_on_subset min.bounded_iff order_refl subset_ball)
     by (metis fd gh holomorphic_on_subset image_mono min.cobounded1 subset_ball)
   then show "\<exists>e>0. g \<circ> f holomorphic_on ball x e"
     by (metis d e min_less_iff_conj)
 qed
 
 lemma analytic_on_compose_gen:
   "f analytic_on S \<Longrightarrow> g analytic_on T \<Longrightarrow> (\<And>z. z \<in> S \<Longrightarrow> f z \<in> T)
              \<Longrightarrow> g o f analytic_on S"
 by (metis analytic_on_compose analytic_on_subset image_subset_iff)
 
 lemma analytic_on_neg [analytic_intros]:
   "f analytic_on S \<Longrightarrow> (\<lambda>z. -(f z)) analytic_on S"
 by (metis analytic_on_holomorphic holomorphic_on_minus)
 
 lemma analytic_on_add [analytic_intros]:
   assumes f: "f analytic_on S"
       and g: "g analytic_on S"
     shows "(\<lambda>z. f z + g z) analytic_on S"
 unfolding analytic_on_def
 proof (intro ballI)
   fix z
   assume z: "z \<in> S"
   then obtain e where e: "0 < e" and fh: "f holomorphic_on ball z e" using f
     by (metis analytic_on_def)
   obtain e' where e': "0 < e'" and gh: "g holomorphic_on ball z e'" using g
     by (metis analytic_on_def g z)
   have "(\<lambda>z. f z + g z) holomorphic_on ball z (min e e')"
     apply (rule holomorphic_on_add)
     apply (metis fh holomorphic_on_subset min.bounded_iff order_refl subset_ball)
     by (metis gh holomorphic_on_subset min.bounded_iff order_refl subset_ball)
   then show "\<exists>e>0. (\<lambda>z. f z + g z) holomorphic_on ball z e"
     by (metis e e' min_less_iff_conj)
 qed
 
 lemma analytic_on_diff [analytic_intros]:
   assumes f: "f analytic_on S"
       and g: "g analytic_on S"
     shows "(\<lambda>z. f z - g z) analytic_on S"
 unfolding analytic_on_def
 proof (intro ballI)
   fix z
   assume z: "z \<in> S"
   then obtain e where e: "0 < e" and fh: "f holomorphic_on ball z e" using f
     by (metis analytic_on_def)
   obtain e' where e': "0 < e'" and gh: "g holomorphic_on ball z e'" using g
     by (metis analytic_on_def g z)
   have "(\<lambda>z. f z - g z) holomorphic_on ball z (min e e')"
     apply (rule holomorphic_on_diff)
     apply (metis fh holomorphic_on_subset min.bounded_iff order_refl subset_ball)
     by (metis gh holomorphic_on_subset min.bounded_iff order_refl subset_ball)
   then show "\<exists>e>0. (\<lambda>z. f z - g z) holomorphic_on ball z e"
     by (metis e e' min_less_iff_conj)
 qed
 
 lemma analytic_on_mult [analytic_intros]:
   assumes f: "f analytic_on S"
       and g: "g analytic_on S"
     shows "(\<lambda>z. f z * g z) analytic_on S"
 unfolding analytic_on_def
 proof (intro ballI)
   fix z
   assume z: "z \<in> S"
   then obtain e where e: "0 < e" and fh: "f holomorphic_on ball z e" using f
     by (metis analytic_on_def)
   obtain e' where e': "0 < e'" and gh: "g holomorphic_on ball z e'" using g
     by (metis analytic_on_def g z)
   have "(\<lambda>z. f z * g z) holomorphic_on ball z (min e e')"
     apply (rule holomorphic_on_mult)
     apply (metis fh holomorphic_on_subset min.bounded_iff order_refl subset_ball)
     by (metis gh holomorphic_on_subset min.bounded_iff order_refl subset_ball)
   then show "\<exists>e>0. (\<lambda>z. f z * g z) holomorphic_on ball z e"
     by (metis e e' min_less_iff_conj)
 qed
 
 lemma analytic_on_inverse [analytic_intros]:
   assumes f: "f analytic_on S"
       and nz: "(\<And>z. z \<in> S \<Longrightarrow> f z \<noteq> 0)"
     shows "(\<lambda>z. inverse (f z)) analytic_on S"
 unfolding analytic_on_def
 proof (intro ballI)
   fix z
   assume z: "z \<in> S"
   then obtain e where e: "0 < e" and fh: "f holomorphic_on ball z e" using f
     by (metis analytic_on_def)
   have "continuous_on (ball z e) f"
     by (metis fh holomorphic_on_imp_continuous_on)
   then obtain e' where e': "0 < e'" and nz': "\<And>y. dist z y < e' \<Longrightarrow> f y \<noteq> 0"
     by (metis open_ball centre_in_ball continuous_on_open_avoid e z nz)
   have "(\<lambda>z. inverse (f z)) holomorphic_on ball z (min e e')"
     apply (rule holomorphic_on_inverse)
     apply (metis fh holomorphic_on_subset min.cobounded2 min.commute subset_ball)
     by (metis nz' mem_ball min_less_iff_conj)
   then show "\<exists>e>0. (\<lambda>z. inverse (f z)) holomorphic_on ball z e"
     by (metis e e' min_less_iff_conj)
 qed
 
 lemma analytic_on_divide [analytic_intros]:
   assumes f: "f analytic_on S"
       and g: "g analytic_on S"
       and nz: "(\<And>z. z \<in> S \<Longrightarrow> g z \<noteq> 0)"
     shows "(\<lambda>z. f z / g z) analytic_on S"
 unfolding divide_inverse
 by (metis analytic_on_inverse analytic_on_mult f g nz)
 
 lemma analytic_on_power [analytic_intros]:
   "f analytic_on S \<Longrightarrow> (\<lambda>z. (f z) ^ n) analytic_on S"
 by (induct n) (auto simp: analytic_on_mult)
 
 lemma analytic_on_sum [analytic_intros]:
   "(\<And>i. i \<in> I \<Longrightarrow> (f i) analytic_on S) \<Longrightarrow> (\<lambda>x. sum (\<lambda>i. f i x) I) analytic_on S"
   by (induct I rule: infinite_finite_induct) (auto simp: analytic_on_const analytic_on_add)
 
 lemma deriv_left_inverse:
   assumes "f holomorphic_on S" and "g holomorphic_on T"
       and "open S" and "open T"
       and "f ` S \<subseteq> T"
       and [simp]: "\<And>z. z \<in> S \<Longrightarrow> g (f z) = z"
       and "w \<in> S"
     shows "deriv f w * deriv g (f w) = 1"
 proof -
   have "deriv f w * deriv g (f w) = deriv g (f w) * deriv f w"
     by (simp add: algebra_simps)
   also have "... = deriv (g o f) w"
     using assms
     by (metis analytic_on_imp_differentiable_at analytic_on_open complex_derivative_chain image_subset_iff)
   also have "... = deriv id w"
   proof (rule complex_derivative_transform_within_open [where s=S])
     show "g \<circ> f holomorphic_on S"
       by (rule assms holomorphic_on_compose_gen holomorphic_intros)+
   qed (use assms in auto)
   also have "... = 1"
     by simp
   finally show ?thesis .
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Analyticity at a point\<close>
 
 lemma analytic_at_ball:
   "f analytic_on {z} \<longleftrightarrow> (\<exists>e. 0<e \<and> f holomorphic_on ball z e)"
 by (metis analytic_on_def singleton_iff)
 
 lemma analytic_at:
     "f analytic_on {z} \<longleftrightarrow> (\<exists>s. open s \<and> z \<in> s \<and> f holomorphic_on s)"
 by (metis analytic_on_holomorphic empty_subsetI insert_subset)
 
 lemma analytic_on_analytic_at:
     "f analytic_on s \<longleftrightarrow> (\<forall>z \<in> s. f analytic_on {z})"
 by (metis analytic_at_ball analytic_on_def)
 
 lemma analytic_at_two:
   "f analytic_on {z} \<and> g analytic_on {z} \<longleftrightarrow>
    (\<exists>s. open s \<and> z \<in> s \<and> f holomorphic_on s \<and> g holomorphic_on s)"
   (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then obtain s t
     where st: "open s" "z \<in> s" "f holomorphic_on s"
               "open t" "z \<in> t" "g holomorphic_on t"
     by (auto simp: analytic_at)
   show ?rhs
     apply (rule_tac x="s \<inter> t" in exI)
     using st
     apply (auto simp: holomorphic_on_subset)
     done
 next
   assume ?rhs
   then show ?lhs
     by (force simp add: analytic_at)
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Combining theorems for derivative with ``analytic at'' hypotheses\<close>
 
 lemma
   assumes "f analytic_on {z}" "g analytic_on {z}"
   shows complex_derivative_add_at: "deriv (\<lambda>w. f w + g w) z = deriv f z + deriv g z"
     and complex_derivative_diff_at: "deriv (\<lambda>w. f w - g w) z = deriv f z - deriv g z"
     and complex_derivative_mult_at: "deriv (\<lambda>w. f w * g w) z =
            f z * deriv g z + deriv f z * g z"
 proof -
   obtain s where s: "open s" "z \<in> s" "f holomorphic_on s" "g holomorphic_on s"
     using assms by (metis analytic_at_two)
   show "deriv (\<lambda>w. f w + g w) z = deriv f z + deriv g z"
     apply (rule DERIV_imp_deriv [OF DERIV_add])
     using s
     apply (auto simp: holomorphic_on_open field_differentiable_def DERIV_deriv_iff_field_differentiable)
     done
   show "deriv (\<lambda>w. f w - g w) z = deriv f z - deriv g z"
     apply (rule DERIV_imp_deriv [OF DERIV_diff])
     using s
     apply (auto simp: holomorphic_on_open field_differentiable_def DERIV_deriv_iff_field_differentiable)
     done
   show "deriv (\<lambda>w. f w * g w) z = f z * deriv g z + deriv f z * g z"
     apply (rule DERIV_imp_deriv [OF DERIV_mult'])
     using s
     apply (auto simp: holomorphic_on_open field_differentiable_def DERIV_deriv_iff_field_differentiable)
     done
 qed
 
 lemma deriv_cmult_at:
   "f analytic_on {z} \<Longrightarrow>  deriv (\<lambda>w. c * f w) z = c * deriv f z"
 by (auto simp: complex_derivative_mult_at deriv_const analytic_on_const)
 
 lemma deriv_cmult_right_at:
   "f analytic_on {z} \<Longrightarrow>  deriv (\<lambda>w. f w * c) z = deriv f z * c"
 by (auto simp: complex_derivative_mult_at deriv_const analytic_on_const)
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Complex differentiation of sequences and series\<close>
 
 (* TODO: Could probably be simplified using Uniform_Limit *)
 lemma has_complex_derivative_sequence:
   fixes S :: "complex set"
   assumes cvs: "convex S"
       and df:  "\<And>n x. x \<in> S \<Longrightarrow> (f n has_field_derivative f' n x) (at x within S)"
       and conv: "\<And>e. 0 < e \<Longrightarrow> \<exists>N. \<forall>n x. n \<ge> N \<longrightarrow> x \<in> S \<longrightarrow> norm (f' n x - g' x) \<le> e"
       and "\<exists>x l. x \<in> S \<and> ((\<lambda>n. f n x) \<longlongrightarrow> l) sequentially"
     shows "\<exists>g. \<forall>x \<in> S. ((\<lambda>n. f n x) \<longlongrightarrow> g x) sequentially \<and>
                        (g has_field_derivative (g' x)) (at x within S)"
 proof -
   from assms obtain x l where x: "x \<in> S" and tf: "((\<lambda>n. f n x) \<longlongrightarrow> l) sequentially"
     by blast
   { fix e::real assume e: "e > 0"
     then obtain N where N: "\<forall>n\<ge>N. \<forall>x. x \<in> S \<longrightarrow> cmod (f' n x - g' x) \<le> e"
       by (metis conv)
     have "\<exists>N. \<forall>n\<ge>N. \<forall>x\<in>S. \<forall>h. cmod (f' n x * h - g' x * h) \<le> e * cmod h"
     proof (rule exI [of _ N], clarify)
       fix n y h
       assume "N \<le> n" "y \<in> S"
       then have "cmod (f' n y - g' y) \<le> e"
         by (metis N)
       then have "cmod h * cmod (f' n y - g' y) \<le> cmod h * e"
         by (auto simp: antisym_conv2 mult_le_cancel_left norm_triangle_ineq2)
       then show "cmod (f' n y * h - g' y * h) \<le> e * cmod h"
         by (simp add: norm_mult [symmetric] field_simps)
     qed
   } note ** = this
   show ?thesis
     unfolding has_field_derivative_def
   proof (rule has_derivative_sequence [OF cvs _ _ x])
     show "(\<lambda>n. f n x) \<longlonglongrightarrow> l"
       by (rule tf)
   next show "\<And>e. e > 0 \<Longrightarrow> \<forall>\<^sub>F n in sequentially. \<forall>x\<in>S. \<forall>h. cmod (f' n x * h - g' x * h) \<le> e * cmod h"
       unfolding eventually_sequentially by (blast intro: **)
   qed (metis has_field_derivative_def df)
 qed
 
 lemma has_complex_derivative_series:
   fixes S :: "complex set"
   assumes cvs: "convex S"
       and df:  "\<And>n x. x \<in> S \<Longrightarrow> (f n has_field_derivative f' n x) (at x within S)"
       and conv: "\<And>e. 0 < e \<Longrightarrow> \<exists>N. \<forall>n x. n \<ge> N \<longrightarrow> x \<in> S
                 \<longrightarrow> cmod ((\<Sum>i<n. f' i x) - g' x) \<le> e"
       and "\<exists>x l. x \<in> S \<and> ((\<lambda>n. f n x) sums l)"
     shows "\<exists>g. \<forall>x \<in> S. ((\<lambda>n. f n x) sums g x) \<and> ((g has_field_derivative g' x) (at x within S))"
 proof -
   from assms obtain x l where x: "x \<in> S" and sf: "((\<lambda>n. f n x) sums l)"
     by blast
   { fix e::real assume e: "e > 0"
     then obtain N where N: "\<forall>n x. n \<ge> N \<longrightarrow> x \<in> S
             \<longrightarrow> cmod ((\<Sum>i<n. f' i x) - g' x) \<le> e"
       by (metis conv)
     have "\<exists>N. \<forall>n\<ge>N. \<forall>x\<in>S. \<forall>h. cmod ((\<Sum>i<n. h * f' i x) - g' x * h) \<le> e * cmod h"
     proof (rule exI [of _ N], clarify)
       fix n y h
       assume "N \<le> n" "y \<in> S"
       then have "cmod ((\<Sum>i<n. f' i y) - g' y) \<le> e"
         by (metis N)
       then have "cmod h * cmod ((\<Sum>i<n. f' i y) - g' y) \<le> cmod h * e"
         by (auto simp: antisym_conv2 mult_le_cancel_left norm_triangle_ineq2)
       then show "cmod ((\<Sum>i<n. h * f' i y) - g' y * h) \<le> e * cmod h"
         by (simp add: norm_mult [symmetric] field_simps sum_distrib_left)
     qed
   } note ** = this
   show ?thesis
   unfolding has_field_derivative_def
   proof (rule has_derivative_series [OF cvs _ _ x])
     fix n x
     assume "x \<in> S"
     then show "((f n) has_derivative (\<lambda>z. z * f' n x)) (at x within S)"
       by (metis df has_field_derivative_def mult_commute_abs)
   next show " ((\<lambda>n. f n x) sums l)"
     by (rule sf)
   next show "\<And>e. e>0 \<Longrightarrow> \<forall>\<^sub>F n in sequentially. \<forall>x\<in>S. \<forall>h. cmod ((\<Sum>i<n. h * f' i x) - g' x * h) \<le> e * cmod h"
       unfolding eventually_sequentially by (blast intro: **)
   qed
 qed
 
-
-lemma field_differentiable_series:
-  fixes f :: "nat \<Rightarrow> 'a::{real_normed_field,banach} \<Rightarrow> 'a"
-  assumes "convex S" "open S"
-  assumes "\<And>n x. x \<in> S \<Longrightarrow> (f n has_field_derivative f' n x) (at x)"
-  assumes "uniformly_convergent_on S (\<lambda>n x. \<Sum>i<n. f' i x)"
-  assumes "x0 \<in> S" "summable (\<lambda>n. f n x0)" and x: "x \<in> S"
-  shows  "(\<lambda>x. \<Sum>n. f n x) field_differentiable (at x)"
-proof -
-  from assms(4) obtain g' where A: "uniform_limit S (\<lambda>n x. \<Sum>i<n. f' i x) g' sequentially"
-    unfolding uniformly_convergent_on_def by blast
-  from x and \<open>open S\<close> have S: "at x within S = at x" by (rule at_within_open)
-  have "\<exists>g. \<forall>x\<in>S. (\<lambda>n. f n x) sums g x \<and> (g has_field_derivative g' x) (at x within S)"
-    by (intro has_field_derivative_series[of S f f' g' x0] assms A has_field_derivative_at_within)
-  then obtain g where g: "\<And>x. x \<in> S \<Longrightarrow> (\<lambda>n. f n x) sums g x"
-    "\<And>x. x \<in> S \<Longrightarrow> (g has_field_derivative g' x) (at x within S)" by blast
-  from g(2)[OF x] have g': "(g has_derivative (*) (g' x)) (at x)"
-    by (simp add: has_field_derivative_def S)
-  have "((\<lambda>x. \<Sum>n. f n x) has_derivative (*) (g' x)) (at x)"
-    by (rule has_derivative_transform_within_open[OF g' \<open>open S\<close> x])
-       (insert g, auto simp: sums_iff)
-  thus "(\<lambda>x. \<Sum>n. f n x) field_differentiable (at x)" unfolding differentiable_def
-    by (auto simp: summable_def field_differentiable_def has_field_derivative_def)
-qed
-
-subsection\<^marker>\<open>tag unimportant\<close>\<open>Bound theorem\<close>
-
-lemma field_differentiable_bound:
-  fixes S :: "'a::real_normed_field set"
-  assumes cvs: "convex S"
-      and df:  "\<And>z. z \<in> S \<Longrightarrow> (f has_field_derivative f' z) (at z within S)"
-      and dn:  "\<And>z. z \<in> S \<Longrightarrow> norm (f' z) \<le> B"
-      and "x \<in> S"  "y \<in> S"
-    shows "norm(f x - f y) \<le> B * norm(x - y)"
-  apply (rule differentiable_bound [OF cvs])
-  apply (erule df [unfolded has_field_derivative_def])
-  apply (rule onorm_le, simp_all add: norm_mult mult_right_mono assms)
-  done
-
-subsection\<^marker>\<open>tag unimportant\<close>\<open>Inverse function theorem for complex derivatives\<close>
-
-lemma has_field_derivative_inverse_basic:
-  shows "DERIV f (g y) :> f' \<Longrightarrow>
-        f' \<noteq> 0 \<Longrightarrow>
-        continuous (at y) g \<Longrightarrow>
-        open t \<Longrightarrow>
-        y \<in> t \<Longrightarrow>
-        (\<And>z. z \<in> t \<Longrightarrow> f (g z) = z)
-        \<Longrightarrow> DERIV g y :> inverse (f')"
-  unfolding has_field_derivative_def
-  apply (rule has_derivative_inverse_basic)
-  apply (auto simp:  bounded_linear_mult_right)
-  done
-
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Taylor on Complex Numbers\<close>
 
 lemma sum_Suc_reindex:
   fixes f :: "nat \<Rightarrow> 'a::ab_group_add"
     shows  "sum f {0..n} = f 0 - f (Suc n) + sum (\<lambda>i. f (Suc i)) {0..n}"
 by (induct n) auto
 
 lemma field_Taylor:
   assumes S: "convex S"
       and f: "\<And>i x. x \<in> S \<Longrightarrow> i \<le> n \<Longrightarrow> (f i has_field_derivative f (Suc i) x) (at x within S)"
       and B: "\<And>x. x \<in> S \<Longrightarrow> norm (f (Suc n) x) \<le> B"
       and w: "w \<in> S"
       and z: "z \<in> S"
     shows "norm(f 0 z - (\<Sum>i\<le>n. f i w * (z-w) ^ i / (fact i)))
           \<le> B * norm(z - w)^(Suc n) / fact n"
 proof -
   have wzs: "closed_segment w z \<subseteq> S" using assms
     by (metis convex_contains_segment)
   { fix u
     assume "u \<in> closed_segment w z"
     then have "u \<in> S"
       by (metis wzs subsetD)
     have "(\<Sum>i\<le>n. f i u * (- of_nat i * (z-u)^(i - 1)) / (fact i) +
                       f (Suc i) u * (z-u)^i / (fact i)) =
               f (Suc n) u * (z-u) ^ n / (fact n)"
     proof (induction n)
       case 0 show ?case by simp
     next
       case (Suc n)
       have "(\<Sum>i\<le>Suc n. f i u * (- of_nat i * (z-u) ^ (i - 1)) / (fact i) +
                              f (Suc i) u * (z-u) ^ i / (fact i)) =
            f (Suc n) u * (z-u) ^ n / (fact n) +
            f (Suc (Suc n)) u * ((z-u) * (z-u) ^ n) / (fact (Suc n)) -
            f (Suc n) u * ((1 + of_nat n) * (z-u) ^ n) / (fact (Suc n))"
         using Suc by simp
       also have "... = f (Suc (Suc n)) u * (z-u) ^ Suc n / (fact (Suc n))"
       proof -
         have "(fact(Suc n)) *
              (f(Suc n) u *(z-u) ^ n / (fact n) +
                f(Suc(Suc n)) u *((z-u) *(z-u) ^ n) / (fact(Suc n)) -
                f(Suc n) u *((1 + of_nat n) *(z-u) ^ n) / (fact(Suc n))) =
             ((fact(Suc n)) *(f(Suc n) u *(z-u) ^ n)) / (fact n) +
             ((fact(Suc n)) *(f(Suc(Suc n)) u *((z-u) *(z-u) ^ n)) / (fact(Suc n))) -
             ((fact(Suc n)) *(f(Suc n) u *(of_nat(Suc n) *(z-u) ^ n))) / (fact(Suc n))"
           by (simp add: algebra_simps del: fact_Suc)
         also have "... = ((fact (Suc n)) * (f (Suc n) u * (z-u) ^ n)) / (fact n) +
                          (f (Suc (Suc n)) u * ((z-u) * (z-u) ^ n)) -
                          (f (Suc n) u * ((1 + of_nat n) * (z-u) ^ n))"
           by (simp del: fact_Suc)
         also have "... = (of_nat (Suc n) * (f (Suc n) u * (z-u) ^ n)) +
                          (f (Suc (Suc n)) u * ((z-u) * (z-u) ^ n)) -
                          (f (Suc n) u * ((1 + of_nat n) * (z-u) ^ n))"
           by (simp only: fact_Suc of_nat_mult ac_simps) simp
         also have "... = f (Suc (Suc n)) u * ((z-u) * (z-u) ^ n)"
           by (simp add: algebra_simps)
         finally show ?thesis
         by (simp add: mult_left_cancel [where c = "(fact (Suc n))", THEN iffD1] del: fact_Suc)
       qed
       finally show ?case .
     qed
     then have "((\<lambda>v. (\<Sum>i\<le>n. f i v * (z - v)^i / (fact i)))
                 has_field_derivative f (Suc n) u * (z-u) ^ n / (fact n))
                (at u within S)"
       apply (intro derivative_eq_intros)
       apply (blast intro: assms \<open>u \<in> S\<close>)
       apply (rule refl)+
       apply (auto simp: field_simps)
       done
   } note sum_deriv = this
   { fix u
     assume u: "u \<in> closed_segment w z"
     then have us: "u \<in> S"
       by (metis wzs subsetD)
     have "norm (f (Suc n) u) * norm (z - u) ^ n \<le> norm (f (Suc n) u) * norm (u - z) ^ n"
       by (metis norm_minus_commute order_refl)
     also have "... \<le> norm (f (Suc n) u) * norm (z - w) ^ n"
       by (metis mult_left_mono norm_ge_zero power_mono segment_bound [OF u])
     also have "... \<le> B * norm (z - w) ^ n"
       by (metis norm_ge_zero zero_le_power mult_right_mono  B [OF us])
     finally have "norm (f (Suc n) u) * norm (z - u) ^ n \<le> B * norm (z - w) ^ n" .
   } note cmod_bound = this
   have "(\<Sum>i\<le>n. f i z * (z - z) ^ i / (fact i)) = (\<Sum>i\<le>n. (f i z / (fact i)) * 0 ^ i)"
     by simp
   also have "\<dots> = f 0 z / (fact 0)"
     by (subst sum_zero_power) simp
   finally have "norm (f 0 z - (\<Sum>i\<le>n. f i w * (z - w) ^ i / (fact i)))
                 \<le> norm ((\<Sum>i\<le>n. f i w * (z - w) ^ i / (fact i)) -
                         (\<Sum>i\<le>n. f i z * (z - z) ^ i / (fact i)))"
     by (simp add: norm_minus_commute)
   also have "... \<le> B * norm (z - w) ^ n / (fact n) * norm (w - z)"
     apply (rule field_differentiable_bound
       [where f' = "\<lambda>w. f (Suc n) w * (z - w)^n / (fact n)"
          and S = "closed_segment w z", OF convex_closed_segment])
     apply (auto simp: ends_in_segment DERIV_subset [OF sum_deriv wzs]
                   norm_divide norm_mult norm_power divide_le_cancel cmod_bound)
     done
   also have "...  \<le> B * norm (z - w) ^ Suc n / (fact n)"
     by (simp add: algebra_simps norm_minus_commute)
   finally show ?thesis .
 qed
 
 lemma complex_Taylor:
   assumes S: "convex S"
       and f: "\<And>i x. x \<in> S \<Longrightarrow> i \<le> n \<Longrightarrow> (f i has_field_derivative f (Suc i) x) (at x within S)"
       and B: "\<And>x. x \<in> S \<Longrightarrow> cmod (f (Suc n) x) \<le> B"
       and w: "w \<in> S"
       and z: "z \<in> S"
     shows "cmod(f 0 z - (\<Sum>i\<le>n. f i w * (z-w) ^ i / (fact i)))
           \<le> B * cmod(z - w)^(Suc n) / fact n"
   using assms by (rule field_Taylor)
 
 
 text\<open>Something more like the traditional MVT for real components\<close>
 
 lemma complex_mvt_line:
   assumes "\<And>u. u \<in> closed_segment w z \<Longrightarrow> (f has_field_derivative f'(u)) (at u)"
     shows "\<exists>u. u \<in> closed_segment w z \<and> Re(f z) - Re(f w) = Re(f'(u) * (z - w))"
 proof -
   have twz: "\<And>t. (1 - t) *\<^sub>R w + t *\<^sub>R z = w + t *\<^sub>R (z - w)"
     by (simp add: real_vector.scale_left_diff_distrib real_vector.scale_right_diff_distrib)
   note assms[unfolded has_field_derivative_def, derivative_intros]
   show ?thesis
     apply (cut_tac mvt_simple
                      [of 0 1 "Re o f o (\<lambda>t. (1 - t) *\<^sub>R w +  t *\<^sub>R z)"
                       "\<lambda>u. Re o (\<lambda>h. f'((1 - u) *\<^sub>R w + u *\<^sub>R z) * h) o (\<lambda>t. t *\<^sub>R (z - w))"])
     apply auto
     apply (rule_tac x="(1 - x) *\<^sub>R w + x *\<^sub>R z" in exI)
     apply (auto simp: closed_segment_def twz) []
     apply (intro derivative_eq_intros has_derivative_at_withinI, simp_all)
     apply (simp add: fun_eq_iff real_vector.scale_right_diff_distrib)
     apply (force simp: twz closed_segment_def)
     done
 qed
 
 lemma complex_Taylor_mvt:
   assumes "\<And>i x. \<lbrakk>x \<in> closed_segment w z; i \<le> n\<rbrakk> \<Longrightarrow> ((f i) has_field_derivative f (Suc i) x) (at x)"
     shows "\<exists>u. u \<in> closed_segment w z \<and>
             Re (f 0 z) =
             Re ((\<Sum>i = 0..n. f i w * (z - w) ^ i / (fact i)) +
                 (f (Suc n) u * (z-u)^n / (fact n)) * (z - w))"
 proof -
   { fix u
     assume u: "u \<in> closed_segment w z"
     have "(\<Sum>i = 0..n.
                (f (Suc i) u * (z-u) ^ i - of_nat i * (f i u * (z-u) ^ (i - Suc 0))) /
                (fact i)) =
           f (Suc 0) u -
              (f (Suc (Suc n)) u * ((z-u) ^ Suc n) - (of_nat (Suc n)) * (z-u) ^ n * f (Suc n) u) /
              (fact (Suc n)) +
              (\<Sum>i = 0..n.
                  (f (Suc (Suc i)) u * ((z-u) ^ Suc i) - of_nat (Suc i) * (f (Suc i) u * (z-u) ^ i)) /
                  (fact (Suc i)))"
        by (subst sum_Suc_reindex) simp
     also have "... = f (Suc 0) u -
              (f (Suc (Suc n)) u * ((z-u) ^ Suc n) - (of_nat (Suc n)) * (z-u) ^ n * f (Suc n) u) /
              (fact (Suc n)) +
              (\<Sum>i = 0..n.
                  f (Suc (Suc i)) u * ((z-u) ^ Suc i) / (fact (Suc i))  -
                  f (Suc i) u * (z-u) ^ i / (fact i))"
       by (simp only: diff_divide_distrib fact_cancel ac_simps)
     also have "... = f (Suc 0) u -
              (f (Suc (Suc n)) u * (z-u) ^ Suc n - of_nat (Suc n) * (z-u) ^ n * f (Suc n) u) /
              (fact (Suc n)) +
              f (Suc (Suc n)) u * (z-u) ^ Suc n / (fact (Suc n)) - f (Suc 0) u"
       by (subst sum_Suc_diff) auto
     also have "... = f (Suc n) u * (z-u) ^ n / (fact n)"
       by (simp only: algebra_simps diff_divide_distrib fact_cancel)
     finally have "(\<Sum>i = 0..n. (f (Suc i) u * (z - u) ^ i
                              - of_nat i * (f i u * (z-u) ^ (i - Suc 0))) / (fact i)) =
                   f (Suc n) u * (z - u) ^ n / (fact n)" .
     then have "((\<lambda>u. \<Sum>i = 0..n. f i u * (z - u) ^ i / (fact i)) has_field_derivative
                 f (Suc n) u * (z - u) ^ n / (fact n))  (at u)"
       apply (intro derivative_eq_intros)+
       apply (force intro: u assms)
       apply (rule refl)+
       apply (auto simp: ac_simps)
       done
   }
   then show ?thesis
     apply (cut_tac complex_mvt_line [of w z "\<lambda>u. \<Sum>i = 0..n. f i u * (z-u) ^ i / (fact i)"
                "\<lambda>u. (f (Suc n) u * (z-u)^n / (fact n))"])
     apply (auto simp add: intro: open_closed_segment)
     done
 qed
 
 
-subsection\<^marker>\<open>tag unimportant\<close> \<open>Polynomal function extremal theorem, from HOL Light\<close>
-
-lemma polyfun_extremal_lemma: (*COMPLEX_POLYFUN_EXTREMAL_LEMMA in HOL Light*)
-    fixes c :: "nat \<Rightarrow> 'a::real_normed_div_algebra"
-  assumes "0 < e"
-    shows "\<exists>M. \<forall>z. M \<le> norm(z) \<longrightarrow> norm (\<Sum>i\<le>n. c(i) * z^i) \<le> e * norm(z) ^ (Suc n)"
-proof (induct n)
-  case 0 with assms
-  show ?case
-    apply (rule_tac x="norm (c 0) / e" in exI)
-    apply (auto simp: field_simps)
-    done
-next
-  case (Suc n)
-  obtain M where M: "\<And>z. M \<le> norm z \<Longrightarrow> norm (\<Sum>i\<le>n. c i * z^i) \<le> e * norm z ^ Suc n"
-    using Suc assms by blast
-  show ?case
-  proof (rule exI [where x= "max M (1 + norm(c(Suc n)) / e)"], clarsimp simp del: power_Suc)
-    fix z::'a
-    assume z1: "M \<le> norm z" and "1 + norm (c (Suc n)) / e \<le> norm z"
-    then have z2: "e + norm (c (Suc n)) \<le> e * norm z"
-      using assms by (simp add: field_simps)
-    have "norm (\<Sum>i\<le>n. c i * z^i) \<le> e * norm z ^ Suc n"
-      using M [OF z1] by simp
-    then have "norm (\<Sum>i\<le>n. c i * z^i) + norm (c (Suc n) * z ^ Suc n) \<le> e * norm z ^ Suc n + norm (c (Suc n) * z ^ Suc n)"
-      by simp
-    then have "norm ((\<Sum>i\<le>n. c i * z^i) + c (Suc n) * z ^ Suc n) \<le> e * norm z ^ Suc n + norm (c (Suc n) * z ^ Suc n)"
-      by (blast intro: norm_triangle_le elim: )
-    also have "... \<le> (e + norm (c (Suc n))) * norm z ^ Suc n"
-      by (simp add: norm_power norm_mult algebra_simps)
-    also have "... \<le> (e * norm z) * norm z ^ Suc n"
-      by (metis z2 mult.commute mult_left_mono norm_ge_zero norm_power)
-    finally show "norm ((\<Sum>i\<le>n. c i * z^i) + c (Suc n) * z ^ Suc n) \<le> e * norm z ^ Suc (Suc n)"
-      by simp
-  qed
-qed
-
-lemma polyfun_extremal: (*COMPLEX_POLYFUN_EXTREMAL in HOL Light*)
-    fixes c :: "nat \<Rightarrow> 'a::real_normed_div_algebra"
-  assumes k: "c k \<noteq> 0" "1\<le>k" and kn: "k\<le>n"
-    shows "eventually (\<lambda>z. norm (\<Sum>i\<le>n. c(i) * z^i) \<ge> B) at_infinity"
-using kn
-proof (induction n)
-  case 0
-  then show ?case
-    using k  by simp
-next
-  case (Suc m)
-  let ?even = ?case
-  show ?even
-  proof (cases "c (Suc m) = 0")
-    case True
-    then show ?even using Suc k
-      by auto (metis antisym_conv less_eq_Suc_le not_le)
-  next
-    case False
-    then obtain M where M:
-          "\<And>z. M \<le> norm z \<Longrightarrow> norm (\<Sum>i\<le>m. c i * z^i) \<le> norm (c (Suc m)) / 2 * norm z ^ Suc m"
-      using polyfun_extremal_lemma [of "norm(c (Suc m)) / 2" c m] Suc
-      by auto
-    have "\<exists>b. \<forall>z. b \<le> norm z \<longrightarrow> B \<le> norm (\<Sum>i\<le>Suc m. c i * z^i)"
-    proof (rule exI [where x="max M (max 1 (\<bar>B\<bar> / (norm(c (Suc m)) / 2)))"], clarsimp simp del: power_Suc)
-      fix z::'a
-      assume z1: "M \<le> norm z" "1 \<le> norm z"
-         and "\<bar>B\<bar> * 2 / norm (c (Suc m)) \<le> norm z"
-      then have z2: "\<bar>B\<bar> \<le> norm (c (Suc m)) * norm z / 2"
-        using False by (simp add: field_simps)
-      have nz: "norm z \<le> norm z ^ Suc m"
-        by (metis \<open>1 \<le> norm z\<close> One_nat_def less_eq_Suc_le power_increasing power_one_right zero_less_Suc)
-      have *: "\<And>y x. norm (c (Suc m)) * norm z / 2 \<le> norm y - norm x \<Longrightarrow> B \<le> norm (x + y)"
-        by (metis abs_le_iff add.commute norm_diff_ineq order_trans z2)
-      have "norm z * norm (c (Suc m)) + 2 * norm (\<Sum>i\<le>m. c i * z^i)
-            \<le> norm (c (Suc m)) * norm z + norm (c (Suc m)) * norm z ^ Suc m"
-        using M [of z] Suc z1  by auto
-      also have "... \<le> 2 * (norm (c (Suc m)) * norm z ^ Suc m)"
-        using nz by (simp add: mult_mono del: power_Suc)
-      finally show "B \<le> norm ((\<Sum>i\<le>m. c i * z^i) + c (Suc m) * z ^ Suc m)"
-        using Suc.IH
-        apply (auto simp: eventually_at_infinity)
-        apply (rule *)
-        apply (simp add: field_simps norm_mult norm_power)
-        done
-    qed
-    then show ?even
-      by (simp add: eventually_at_infinity)
-  qed
-qed
-
 end
diff --git a/src/HOL/Analysis/Conformal_Mappings.thy b/src/HOL/Analysis/Conformal_Mappings.thy
--- a/src/HOL/Analysis/Conformal_Mappings.thy
+++ b/src/HOL/Analysis/Conformal_Mappings.thy
@@ -1,5086 +1,5085 @@
 section \<open>Conformal Mappings and Consequences of Cauchy's Integral Theorem\<close>
 
 text\<open>By John Harrison et al.  Ported from HOL Light by L C Paulson (2016)\<close>
 
 text\<open>Also Cauchy's residue theorem by Wenda Li (2016)\<close>
 
 theory Conformal_Mappings
 imports Cauchy_Integral_Theorem
 
 begin
 
 (* FIXME mv to Cauchy_Integral_Theorem.thy *)
 subsection\<open>Cauchy's inequality and more versions of Liouville\<close>
 
 lemma Cauchy_higher_deriv_bound:
     assumes holf: "f holomorphic_on (ball z r)"
         and contf: "continuous_on (cball z r) f"
         and fin : "\<And>w. w \<in> ball z r \<Longrightarrow> f w \<in> ball y B0"
         and "0 < r" and "0 < n"
       shows "norm ((deriv ^^ n) f z) \<le> (fact n) * B0 / r^n"
 proof -
   have "0 < B0" using \<open>0 < r\<close> fin [of z]
     by (metis ball_eq_empty ex_in_conv fin not_less)
   have le_B0: "\<And>w. cmod (w - z) \<le> r \<Longrightarrow> cmod (f w - y) \<le> B0"
     apply (rule continuous_on_closure_norm_le [of "ball z r" "\<lambda>w. f w - y"])
     apply (auto simp: \<open>0 < r\<close>  dist_norm norm_minus_commute)
     apply (rule continuous_intros contf)+
     using fin apply (simp add: dist_commute dist_norm less_eq_real_def)
     done
   have "(deriv ^^ n) f z = (deriv ^^ n) (\<lambda>w. f w) z - (deriv ^^ n) (\<lambda>w. y) z"
     using \<open>0 < n\<close> by simp
   also have "... = (deriv ^^ n) (\<lambda>w. f w - y) z"
     by (rule higher_deriv_diff [OF holf, symmetric]) (auto simp: \<open>0 < r\<close>)
   finally have "(deriv ^^ n) f z = (deriv ^^ n) (\<lambda>w. f w - y) z" .
   have contf': "continuous_on (cball z r) (\<lambda>u. f u - y)"
     by (rule contf continuous_intros)+
   have holf': "(\<lambda>u. (f u - y)) holomorphic_on (ball z r)"
     by (simp add: holf holomorphic_on_diff)
   define a where "a = (2 * pi)/(fact n)"
   have "0 < a"  by (simp add: a_def)
   have "B0/r^(Suc n)*2 * pi * r = a*((fact n)*B0/r^n)"
     using \<open>0 < r\<close> by (simp add: a_def field_split_simps)
   have der_dif: "(deriv ^^ n) (\<lambda>w. f w - y) z = (deriv ^^ n) f z"
     using \<open>0 < r\<close> \<open>0 < n\<close>
     by (auto simp: higher_deriv_diff [OF holf holomorphic_on_const])
   have "norm ((2 * of_real pi * \<i>)/(fact n) * (deriv ^^ n) (\<lambda>w. f w - y) z)
         \<le> (B0/r^(Suc n)) * (2 * pi * r)"
     apply (rule has_contour_integral_bound_circlepath [of "(\<lambda>u. (f u - y)/(u - z)^(Suc n))" _ z])
     using Cauchy_has_contour_integral_higher_derivative_circlepath [OF contf' holf']
     using \<open>0 < B0\<close> \<open>0 < r\<close>
     apply (auto simp: norm_divide norm_mult norm_power divide_simps le_B0)
     done
   then show ?thesis
     using \<open>0 < r\<close>
     by (auto simp: norm_divide norm_mult norm_power field_simps der_dif le_B0)
 qed
 
 lemma Cauchy_inequality:
     assumes holf: "f holomorphic_on (ball \<xi> r)"
         and contf: "continuous_on (cball \<xi> r) f"
         and "0 < r"
         and nof: "\<And>x. norm(\<xi>-x) = r \<Longrightarrow> norm(f x) \<le> B"
       shows "norm ((deriv ^^ n) f \<xi>) \<le> (fact n) * B / r^n"
 proof -
   obtain x where "norm (\<xi>-x) = r"
     by (metis abs_of_nonneg add_diff_cancel_left' \<open>0 < r\<close> diff_add_cancel
                  dual_order.strict_implies_order norm_of_real)
   then have "0 \<le> B"
     by (metis nof norm_not_less_zero not_le order_trans)
   have  "((\<lambda>u. f u / (u - \<xi>) ^ Suc n) has_contour_integral (2 * pi) * \<i> / fact n * (deriv ^^ n) f \<xi>)
          (circlepath \<xi> r)"
     apply (rule Cauchy_has_contour_integral_higher_derivative_circlepath [OF contf holf])
     using \<open>0 < r\<close> by simp
   then have "norm ((2 * pi * \<i>)/(fact n) * (deriv ^^ n) f \<xi>) \<le> (B / r^(Suc n)) * (2 * pi * r)"
     apply (rule has_contour_integral_bound_circlepath)
     using \<open>0 \<le> B\<close> \<open>0 < r\<close>
     apply (simp_all add: norm_divide norm_power nof frac_le norm_minus_commute del: power_Suc)
     done
   then show ?thesis using \<open>0 < r\<close>
     by (simp add: norm_divide norm_mult field_simps)
 qed
 
 lemma Liouville_polynomial:
     assumes holf: "f holomorphic_on UNIV"
         and nof: "\<And>z. A \<le> norm z \<Longrightarrow> norm(f z) \<le> B * norm z ^ n"
       shows "f \<xi> = (\<Sum>k\<le>n. (deriv^^k) f 0 / fact k * \<xi> ^ k)"
 proof (cases rule: le_less_linear [THEN disjE])
   assume "B \<le> 0"
   then have "\<And>z. A \<le> norm z \<Longrightarrow> norm(f z) = 0"
     by (metis nof less_le_trans zero_less_mult_iff neqE norm_not_less_zero norm_power not_le)
   then have f0: "(f \<longlongrightarrow> 0) at_infinity"
     using Lim_at_infinity by force
   then have [simp]: "f = (\<lambda>w. 0)"
     using Liouville_weak [OF holf, of 0]
     by (simp add: eventually_at_infinity f0) meson
   show ?thesis by simp
 next
   assume "0 < B"
   have "((\<lambda>k. (deriv ^^ k) f 0 / (fact k) * (\<xi> - 0)^k) sums f \<xi>)"
     apply (rule holomorphic_power_series [where r = "norm \<xi> + 1"])
     using holf holomorphic_on_subset apply auto
     done
   then have sumsf: "((\<lambda>k. (deriv ^^ k) f 0 / (fact k) * \<xi>^k) sums f \<xi>)" by simp
   have "(deriv ^^ k) f 0 / fact k * \<xi> ^ k = 0" if "k>n" for k
   proof (cases "(deriv ^^ k) f 0 = 0")
     case True then show ?thesis by simp
   next
     case False
     define w where "w = complex_of_real (fact k * B / cmod ((deriv ^^ k) f 0) + (\<bar>A\<bar> + 1))"
     have "1 \<le> abs (fact k * B / cmod ((deriv ^^ k) f 0) + (\<bar>A\<bar> + 1))"
       using \<open>0 < B\<close> by simp
     then have wge1: "1 \<le> norm w"
       by (metis norm_of_real w_def)
     then have "w \<noteq> 0" by auto
     have kB: "0 < fact k * B"
       using \<open>0 < B\<close> by simp
     then have "0 \<le> fact k * B / cmod ((deriv ^^ k) f 0)"
       by simp
     then have wgeA: "A \<le> cmod w"
       by (simp only: w_def norm_of_real)
     have "fact k * B / cmod ((deriv ^^ k) f 0) < abs (fact k * B / cmod ((deriv ^^ k) f 0) + (\<bar>A\<bar> + 1))"
       using \<open>0 < B\<close> by simp
     then have wge: "fact k * B / cmod ((deriv ^^ k) f 0) < norm w"
       by (metis norm_of_real w_def)
     then have "fact k * B / norm w < cmod ((deriv ^^ k) f 0)"
       using False by (simp add: field_split_simps mult.commute split: if_split_asm)
     also have "... \<le> fact k * (B * norm w ^ n) / norm w ^ k"
       apply (rule Cauchy_inequality)
          using holf holomorphic_on_subset apply force
         using holf holomorphic_on_imp_continuous_on holomorphic_on_subset apply blast
        using \<open>w \<noteq> 0\<close> apply simp
        by (metis nof wgeA dist_0_norm dist_norm)
     also have "... = fact k * (B * 1 / cmod w ^ (k-n))"
       apply (simp only: mult_cancel_left times_divide_eq_right [symmetric])
       using \<open>k>n\<close> \<open>w \<noteq> 0\<close> \<open>0 < B\<close> apply (simp add: field_split_simps semiring_normalization_rules)
       done
     also have "... = fact k * B / cmod w ^ (k-n)"
       by simp
     finally have "fact k * B / cmod w < fact k * B / cmod w ^ (k - n)" .
     then have "1 / cmod w < 1 / cmod w ^ (k - n)"
       by (metis kB divide_inverse inverse_eq_divide mult_less_cancel_left_pos)
     then have "cmod w ^ (k - n) < cmod w"
       by (metis frac_le le_less_trans norm_ge_zero norm_one not_less order_refl wge1 zero_less_one)
     with self_le_power [OF wge1] have False
       by (meson diff_is_0_eq not_gr0 not_le that)
     then show ?thesis by blast
   qed
   then have "(deriv ^^ (k + Suc n)) f 0 / fact (k + Suc n) * \<xi> ^ (k + Suc n) = 0" for k
     using not_less_eq by blast
   then have "(\<lambda>i. (deriv ^^ (i + Suc n)) f 0 / fact (i + Suc n) * \<xi> ^ (i + Suc n)) sums 0"
     by (rule sums_0)
   with sums_split_initial_segment [OF sumsf, where n = "Suc n"]
   show ?thesis
     using atLeast0AtMost lessThan_Suc_atMost sums_unique2 by fastforce
 qed
 
 text\<open>Every bounded entire function is a constant function.\<close>
 theorem Liouville_theorem:
     assumes holf: "f holomorphic_on UNIV"
         and bf: "bounded (range f)"
     obtains c where "\<And>z. f z = c"
 proof -
   obtain B where "\<And>z. cmod (f z) \<le> B"
     by (meson bf bounded_pos rangeI)
   then show ?thesis
     using Liouville_polynomial [OF holf, of 0 B 0, simplified] that by blast
 qed
 
 text\<open>A holomorphic function f has only isolated zeros unless f is 0.\<close>
 
 lemma powser_0_nonzero:
   fixes a :: "nat \<Rightarrow> 'a::{real_normed_field,banach}"
   assumes r: "0 < r"
       and sm: "\<And>x. norm (x - \<xi>) < r \<Longrightarrow> (\<lambda>n. a n * (x - \<xi>) ^ n) sums (f x)"
       and [simp]: "f \<xi> = 0"
       and m0: "a m \<noteq> 0" and "m>0"
   obtains s where "0 < s" and "\<And>z. z \<in> cball \<xi> s - {\<xi>} \<Longrightarrow> f z \<noteq> 0"
 proof -
   have "r \<le> conv_radius a"
     using sm sums_summable by (auto simp: le_conv_radius_iff [where \<xi>=\<xi>])
   obtain m where am: "a m \<noteq> 0" and az [simp]: "(\<And>n. n<m \<Longrightarrow> a n = 0)"
     apply (rule_tac m = "LEAST n. a n \<noteq> 0" in that)
     using m0
     apply (rule LeastI2)
     apply (fastforce intro:  dest!: not_less_Least)+
     done
   define b where "b i = a (i+m) / a m" for i
   define g where "g x = suminf (\<lambda>i. b i * (x - \<xi>) ^ i)" for x
   have [simp]: "b 0 = 1"
     by (simp add: am b_def)
   { fix x::'a
     assume "norm (x - \<xi>) < r"
     then have "(\<lambda>n. (a m * (x - \<xi>)^m) * (b n * (x - \<xi>)^n)) sums (f x)"
       using am az sm sums_zero_iff_shift [of m "(\<lambda>n. a n * (x - \<xi>) ^ n)" "f x"]
       by (simp add: b_def monoid_mult_class.power_add algebra_simps)
     then have "x \<noteq> \<xi> \<Longrightarrow> (\<lambda>n. b n * (x - \<xi>)^n) sums (f x / (a m * (x - \<xi>)^m))"
       using am by (simp add: sums_mult_D)
   } note bsums = this
   then have  "norm (x - \<xi>) < r \<Longrightarrow> summable (\<lambda>n. b n * (x - \<xi>)^n)" for x
     using sums_summable by (cases "x=\<xi>") auto
   then have "r \<le> conv_radius b"
     by (simp add: le_conv_radius_iff [where \<xi>=\<xi>])
   then have "r/2 < conv_radius b"
     using not_le order_trans r by fastforce
   then have "continuous_on (cball \<xi> (r/2)) g"
     using powser_continuous_suminf [of "r/2" b \<xi>] by (simp add: g_def)
   then obtain s where "s>0"  "\<And>x. \<lbrakk>norm (x - \<xi>) \<le> s; norm (x - \<xi>) \<le> r/2\<rbrakk> \<Longrightarrow> dist (g x) (g \<xi>) < 1/2"
     apply (rule continuous_onE [where x=\<xi> and e = "1/2"])
     using r apply (auto simp: norm_minus_commute dist_norm)
     done
   moreover have "g \<xi> = 1"
     by (simp add: g_def)
   ultimately have gnz: "\<And>x. \<lbrakk>norm (x - \<xi>) \<le> s; norm (x - \<xi>) \<le> r/2\<rbrakk> \<Longrightarrow> (g x) \<noteq> 0"
     by fastforce
   have "f x \<noteq> 0" if "x \<noteq> \<xi>" "norm (x - \<xi>) \<le> s" "norm (x - \<xi>) \<le> r/2" for x
     using bsums [of x] that gnz [of x]
     apply (auto simp: g_def)
     using r sums_iff by fastforce
   then show ?thesis
     apply (rule_tac s="min s (r/2)" in that)
     using \<open>0 < r\<close> \<open>0 < s\<close> by (auto simp: dist_commute dist_norm)
 qed
 
 subsection \<open>Analytic continuation\<close>
 
 proposition isolated_zeros:
   assumes holf: "f holomorphic_on S"
       and "open S" "connected S" "\<xi> \<in> S" "f \<xi> = 0" "\<beta> \<in> S" "f \<beta> \<noteq> 0"
     obtains r where "0 < r" and "ball \<xi> r \<subseteq> S" and
         "\<And>z. z \<in> ball \<xi> r - {\<xi>} \<Longrightarrow> f z \<noteq> 0"
 proof -
   obtain r where "0 < r" and r: "ball \<xi> r \<subseteq> S"
     using \<open>open S\<close> \<open>\<xi> \<in> S\<close> open_contains_ball_eq by blast
   have powf: "((\<lambda>n. (deriv ^^ n) f \<xi> / (fact n) * (z - \<xi>)^n) sums f z)" if "z \<in> ball \<xi> r" for z
     apply (rule holomorphic_power_series [OF _ that])
     apply (rule holomorphic_on_subset [OF holf r])
     done
   obtain m where m: "(deriv ^^ m) f \<xi> / (fact m) \<noteq> 0"
     using holomorphic_fun_eq_0_on_connected [OF holf \<open>open S\<close> \<open>connected S\<close> _ \<open>\<xi> \<in> S\<close> \<open>\<beta> \<in> S\<close>] \<open>f \<beta> \<noteq> 0\<close>
     by auto
   then have "m \<noteq> 0" using assms(5) funpow_0 by fastforce
   obtain s where "0 < s" and s: "\<And>z. z \<in> cball \<xi> s - {\<xi>} \<Longrightarrow> f z \<noteq> 0"
     apply (rule powser_0_nonzero [OF \<open>0 < r\<close> powf \<open>f \<xi> = 0\<close> m])
     using \<open>m \<noteq> 0\<close> by (auto simp: dist_commute dist_norm)
   have "0 < min r s"  by (simp add: \<open>0 < r\<close> \<open>0 < s\<close>)
   then show ?thesis
     apply (rule that)
     using r s by auto
 qed
 
 proposition analytic_continuation:
   assumes holf: "f holomorphic_on S"
       and "open S" and "connected S"
       and "U \<subseteq> S" and "\<xi> \<in> S"
       and "\<xi> islimpt U"
       and fU0 [simp]: "\<And>z. z \<in> U \<Longrightarrow> f z = 0"
       and "w \<in> S"
     shows "f w = 0"
 proof -
   obtain e where "0 < e" and e: "cball \<xi> e \<subseteq> S"
     using \<open>open S\<close> \<open>\<xi> \<in> S\<close> open_contains_cball_eq by blast
   define T where "T = cball \<xi> e \<inter> U"
   have contf: "continuous_on (closure T) f"
     by (metis T_def closed_cball closure_minimal e holf holomorphic_on_imp_continuous_on
               holomorphic_on_subset inf.cobounded1)
   have fT0 [simp]: "\<And>x. x \<in> T \<Longrightarrow> f x = 0"
     by (simp add: T_def)
   have "\<And>r. \<lbrakk>\<forall>e>0. \<exists>x'\<in>U. x' \<noteq> \<xi> \<and> dist x' \<xi> < e; 0 < r\<rbrakk> \<Longrightarrow> \<exists>x'\<in>cball \<xi> e \<inter> U. x' \<noteq> \<xi> \<and> dist x' \<xi> < r"
     by (metis \<open>0 < e\<close> IntI dist_commute less_eq_real_def mem_cball min_less_iff_conj)
   then have "\<xi> islimpt T" using \<open>\<xi> islimpt U\<close>
     by (auto simp: T_def islimpt_approachable)
   then have "\<xi> \<in> closure T"
     by (simp add: closure_def)
   then have "f \<xi> = 0"
     by (auto simp: continuous_constant_on_closure [OF contf])
   show ?thesis
     apply (rule ccontr)
     apply (rule isolated_zeros [OF holf \<open>open S\<close> \<open>connected S\<close> \<open>\<xi> \<in> S\<close> \<open>f \<xi> = 0\<close> \<open>w \<in> S\<close>], assumption)
     by (metis open_ball \<open>\<xi> islimpt T\<close> centre_in_ball fT0 insertE insert_Diff islimptE)
 qed
 
 corollary analytic_continuation_open:
   assumes "open s" and "open s'" and "s \<noteq> {}" and "connected s'"
       and "s \<subseteq> s'"
   assumes "f holomorphic_on s'" and "g holomorphic_on s'"
       and "\<And>z. z \<in> s \<Longrightarrow> f z = g z"
   assumes "z \<in> s'"
   shows   "f z = g z"
 proof -
   from \<open>s \<noteq> {}\<close> obtain \<xi> where "\<xi> \<in> s" by auto
   with \<open>open s\<close> have \<xi>: "\<xi> islimpt s"
     by (intro interior_limit_point) (auto simp: interior_open)
   have "f z - g z = 0"
     by (rule analytic_continuation[of "\<lambda>z. f z - g z" s' s \<xi>])
        (insert assms \<open>\<xi> \<in> s\<close> \<xi>, auto intro: holomorphic_intros)
   thus ?thesis by simp
 qed
 
 subsection\<open>Open mapping theorem\<close>
 
 lemma holomorphic_contract_to_zero:
   assumes contf: "continuous_on (cball \<xi> r) f"
       and holf: "f holomorphic_on ball \<xi> r"
       and "0 < r"
       and norm_less: "\<And>z. norm(\<xi> - z) = r \<Longrightarrow> norm(f \<xi>) < norm(f z)"
   obtains z where "z \<in> ball \<xi> r" "f z = 0"
 proof -
   { assume fnz: "\<And>w. w \<in> ball \<xi> r \<Longrightarrow> f w \<noteq> 0"
     then have "0 < norm (f \<xi>)"
       by (simp add: \<open>0 < r\<close>)
     have fnz': "\<And>w. w \<in> cball \<xi> r \<Longrightarrow> f w \<noteq> 0"
       by (metis norm_less dist_norm fnz less_eq_real_def mem_ball mem_cball norm_not_less_zero norm_zero)
     have "frontier(cball \<xi> r) \<noteq> {}"
       using \<open>0 < r\<close> by simp
     define g where [abs_def]: "g z = inverse (f z)" for z
     have contg: "continuous_on (cball \<xi> r) g"
       unfolding g_def using contf continuous_on_inverse fnz' by blast
     have holg: "g holomorphic_on ball \<xi> r"
       unfolding g_def using fnz holf holomorphic_on_inverse by blast
     have "frontier (cball \<xi> r) \<subseteq> cball \<xi> r"
       by (simp add: subset_iff)
     then have contf': "continuous_on (frontier (cball \<xi> r)) f"
           and contg': "continuous_on (frontier (cball \<xi> r)) g"
       by (blast intro: contf contg continuous_on_subset)+
     have froc: "frontier(cball \<xi> r) \<noteq> {}"
       using \<open>0 < r\<close> by simp
     moreover have "continuous_on (frontier (cball \<xi> r)) (norm o f)"
       using contf' continuous_on_compose continuous_on_norm_id by blast
     ultimately obtain w where w: "w \<in> frontier(cball \<xi> r)"
                           and now: "\<And>x. x \<in> frontier(cball \<xi> r) \<Longrightarrow> norm (f w) \<le> norm (f x)"
       apply (rule bexE [OF continuous_attains_inf [OF compact_frontier [OF compact_cball]]])
       apply simp
       done
     then have fw: "0 < norm (f w)"
       by (simp add: fnz')
     have "continuous_on (frontier (cball \<xi> r)) (norm o g)"
       using contg' continuous_on_compose continuous_on_norm_id by blast
     then obtain v where v: "v \<in> frontier(cball \<xi> r)"
                and nov: "\<And>x. x \<in> frontier(cball \<xi> r) \<Longrightarrow> norm (g v) \<ge> norm (g x)"
       apply (rule bexE [OF continuous_attains_sup [OF compact_frontier [OF compact_cball] froc]])
       apply simp
       done
     then have fv: "0 < norm (f v)"
       by (simp add: fnz')
     have "norm ((deriv ^^ 0) g \<xi>) \<le> fact 0 * norm (g v) / r ^ 0"
       by (rule Cauchy_inequality [OF holg contg \<open>0 < r\<close>]) (simp add: dist_norm nov)
     then have "cmod (g \<xi>) \<le> norm (g v)"
       by simp
     with w have wr: "norm (\<xi> - w) = r" and nfw: "norm (f w) \<le> norm (f \<xi>)"
       apply (simp_all add: dist_norm)
       by (metis \<open>0 < cmod (f \<xi>)\<close> g_def less_imp_inverse_less norm_inverse not_le now order_trans v)
     with fw have False
       using norm_less by force
   }
   with that show ?thesis by blast
 qed
 
 theorem open_mapping_thm:
   assumes holf: "f holomorphic_on S"
       and S: "open S" and "connected S"
       and "open U" and "U \<subseteq> S"
       and fne: "\<not> f constant_on S"
     shows "open (f ` U)"
 proof -
   have *: "open (f ` U)"
           if "U \<noteq> {}" and U: "open U" "connected U" and "f holomorphic_on U" and fneU: "\<And>x. \<exists>y \<in> U. f y \<noteq> x"
           for U
   proof (clarsimp simp: open_contains_ball)
     fix \<xi> assume \<xi>: "\<xi> \<in> U"
     show "\<exists>e>0. ball (f \<xi>) e \<subseteq> f ` U"
     proof -
       have hol: "(\<lambda>z. f z - f \<xi>) holomorphic_on U"
         by (rule holomorphic_intros that)+
       obtain s where "0 < s" and sbU: "ball \<xi> s \<subseteq> U"
                  and sne: "\<And>z. z \<in> ball \<xi> s - {\<xi>} \<Longrightarrow> (\<lambda>z. f z - f \<xi>) z \<noteq> 0"
         using isolated_zeros [OF hol U \<xi>]  by (metis fneU right_minus_eq)
       obtain r where "0 < r" and r: "cball \<xi> r \<subseteq> ball \<xi> s"
         apply (rule_tac r="s/2" in that)
         using \<open>0 < s\<close> by auto
       have "cball \<xi> r \<subseteq> U"
         using sbU r by blast
       then have frsbU: "frontier (cball \<xi> r) \<subseteq> U"
         using Diff_subset frontier_def order_trans by fastforce
       then have cof: "compact (frontier(cball \<xi> r))"
         by blast
       have frne: "frontier (cball \<xi> r) \<noteq> {}"
         using \<open>0 < r\<close> by auto
       have contfr: "continuous_on (frontier (cball \<xi> r)) (\<lambda>z. norm (f z - f \<xi>))"
-        apply (rule continuous_on_compose2 [OF Complex_Analysis_Basics.continuous_on_norm_id])
-        using hol frsbU holomorphic_on_imp_continuous_on holomorphic_on_subset by blast+
+        by (metis continuous_on_norm continuous_on_subset frsbU hol holomorphic_on_imp_continuous_on)
       obtain w where "norm (\<xi> - w) = r"
                  and w: "(\<And>z. norm (\<xi> - z) = r \<Longrightarrow> norm (f w - f \<xi>) \<le> norm(f z - f \<xi>))"
         apply (rule bexE [OF continuous_attains_inf [OF cof frne contfr]])
         apply (simp add: dist_norm)
         done
       moreover define \<epsilon> where "\<epsilon> \<equiv> norm (f w - f \<xi>) / 3"
       ultimately have "0 < \<epsilon>"
         using \<open>0 < r\<close> dist_complex_def r sne by auto
       have "ball (f \<xi>) \<epsilon> \<subseteq> f ` U"
       proof
         fix \<gamma>
         assume \<gamma>: "\<gamma> \<in> ball (f \<xi>) \<epsilon>"
         have *: "cmod (\<gamma> - f \<xi>) < cmod (\<gamma> - f z)" if "cmod (\<xi> - z) = r" for z
         proof -
           have lt: "cmod (f w - f \<xi>) / 3 < cmod (\<gamma> - f z)"
             using w [OF that] \<gamma>
             using dist_triangle2 [of "f \<xi>" "\<gamma>"  "f z"] dist_triangle2 [of "f \<xi>" "f z" \<gamma>]
             by (simp add: \<epsilon>_def dist_norm norm_minus_commute)
           show ?thesis
             by (metis \<epsilon>_def dist_commute dist_norm less_trans lt mem_ball \<gamma>)
        qed
        have "continuous_on (cball \<xi> r) (\<lambda>z. \<gamma> - f z)"
           apply (rule continuous_intros)+
           using \<open>cball \<xi> r \<subseteq> U\<close> \<open>f holomorphic_on U\<close>
           apply (blast intro: continuous_on_subset holomorphic_on_imp_continuous_on)
           done
         moreover have "(\<lambda>z. \<gamma> - f z) holomorphic_on ball \<xi> r"
           apply (rule holomorphic_intros)+
           apply (metis \<open>cball \<xi> r \<subseteq> U\<close> \<open>f holomorphic_on U\<close> holomorphic_on_subset interior_cball interior_subset)
           done
         ultimately obtain z where "z \<in> ball \<xi> r" "\<gamma> - f z = 0"
           apply (rule holomorphic_contract_to_zero)
           apply (blast intro!: \<open>0 < r\<close> *)+
           done
         then show "\<gamma> \<in> f ` U"
           using \<open>cball \<xi> r \<subseteq> U\<close> by fastforce
       qed
       then show ?thesis using  \<open>0 < \<epsilon>\<close> by blast
     qed
   qed
   have "open (f ` X)" if "X \<in> components U" for X
   proof -
     have holfU: "f holomorphic_on U"
       using \<open>U \<subseteq> S\<close> holf holomorphic_on_subset by blast
     have "X \<noteq> {}"
       using that by (simp add: in_components_nonempty)
     moreover have "open X"
       using that \<open>open U\<close> open_components by auto
     moreover have "connected X"
       using that in_components_maximal by blast
     moreover have "f holomorphic_on X"
       by (meson that holfU holomorphic_on_subset in_components_maximal)
     moreover have "\<exists>y\<in>X. f y \<noteq> x" for x
     proof (rule ccontr)
       assume not: "\<not> (\<exists>y\<in>X. f y \<noteq> x)"
       have "X \<subseteq> S"
         using \<open>U \<subseteq> S\<close> in_components_subset that by blast
       obtain w where w: "w \<in> X" using \<open>X \<noteq> {}\<close> by blast
       have wis: "w islimpt X"
         using w \<open>open X\<close> interior_eq by auto
       have hol: "(\<lambda>z. f z - x) holomorphic_on S"
         by (simp add: holf holomorphic_on_diff)
       with fne [unfolded constant_on_def]
            analytic_continuation[OF hol S \<open>connected S\<close> \<open>X \<subseteq> S\<close> _ wis] not \<open>X \<subseteq> S\<close> w
       show False by auto
     qed
     ultimately show ?thesis
       by (rule *)
   qed
   then have "open (f ` \<Union>(components U))"
     by (metis (no_types, lifting) imageE image_Union open_Union)
   then show ?thesis
     by force
 qed
 
 text\<open>No need for \<^term>\<open>S\<close> to be connected. But the nonconstant condition is stronger.\<close>
 corollary\<^marker>\<open>tag unimportant\<close> open_mapping_thm2:
   assumes holf: "f holomorphic_on S"
       and S: "open S"
       and "open U" "U \<subseteq> S"
       and fnc: "\<And>X. \<lbrakk>open X; X \<subseteq> S; X \<noteq> {}\<rbrakk> \<Longrightarrow> \<not> f constant_on X"
     shows "open (f ` U)"
 proof -
   have "S = \<Union>(components S)" by simp
   with \<open>U \<subseteq> S\<close> have "U = (\<Union>C \<in> components S. C \<inter> U)" by auto
   then have "f ` U = (\<Union>C \<in> components S. f ` (C \<inter> U))"
     using image_UN by fastforce
   moreover
   { fix C assume "C \<in> components S"
     with S \<open>C \<in> components S\<close> open_components in_components_connected
     have C: "open C" "connected C" by auto
     have "C \<subseteq> S"
       by (metis \<open>C \<in> components S\<close> in_components_maximal)
     have nf: "\<not> f constant_on C"
       apply (rule fnc)
       using C \<open>C \<subseteq> S\<close> \<open>C \<in> components S\<close> in_components_nonempty by auto
     have "f holomorphic_on C"
       by (metis holf holomorphic_on_subset \<open>C \<subseteq> S\<close>)
     then have "open (f ` (C \<inter> U))"
       apply (rule open_mapping_thm [OF _ C _ _ nf])
       apply (simp add: C \<open>open U\<close> open_Int, blast)
       done
   } ultimately show ?thesis
     by force
 qed
 
 corollary\<^marker>\<open>tag unimportant\<close> open_mapping_thm3:
   assumes holf: "f holomorphic_on S"
       and "open S" and injf: "inj_on f S"
     shows  "open (f ` S)"
 apply (rule open_mapping_thm2 [OF holf])
 using assms
 apply (simp_all add:)
 using injective_not_constant subset_inj_on by blast
 
 subsection\<open>Maximum modulus principle\<close>
 
 text\<open>If \<^term>\<open>f\<close> is holomorphic, then its norm (modulus) cannot exhibit a true local maximum that is
    properly within the domain of \<^term>\<open>f\<close>.\<close>
 
 proposition maximum_modulus_principle:
   assumes holf: "f holomorphic_on S"
       and S: "open S" and "connected S"
       and "open U" and "U \<subseteq> S" and "\<xi> \<in> U"
       and no: "\<And>z. z \<in> U \<Longrightarrow> norm(f z) \<le> norm(f \<xi>)"
     shows "f constant_on S"
 proof (rule ccontr)
   assume "\<not> f constant_on S"
   then have "open (f ` U)"
     using open_mapping_thm assms by blast
   moreover have "\<not> open (f ` U)"
   proof -
     have "\<exists>t. cmod (f \<xi> - t) < e \<and> t \<notin> f ` U" if "0 < e" for e
       apply (rule_tac x="if 0 < Re(f \<xi>) then f \<xi> + (e/2) else f \<xi> - (e/2)" in exI)
       using that
       apply (simp add: dist_norm)
       apply (fastforce simp: cmod_Re_le_iff dest!: no dest: sym)
       done
     then show ?thesis
       unfolding open_contains_ball by (metis \<open>\<xi> \<in> U\<close> contra_subsetD dist_norm imageI mem_ball)
   qed
   ultimately show False
     by blast
 qed
 
 proposition maximum_modulus_frontier:
   assumes holf: "f holomorphic_on (interior S)"
       and contf: "continuous_on (closure S) f"
       and bos: "bounded S"
       and leB: "\<And>z. z \<in> frontier S \<Longrightarrow> norm(f z) \<le> B"
       and "\<xi> \<in> S"
     shows "norm(f \<xi>) \<le> B"
 proof -
   have "compact (closure S)" using bos
     by (simp add: bounded_closure compact_eq_bounded_closed)
   moreover have "continuous_on (closure S) (cmod \<circ> f)"
     using contf continuous_on_compose continuous_on_norm_id by blast
   ultimately obtain z where zin: "z \<in> closure S" and z: "\<And>y. y \<in> closure S \<Longrightarrow> (cmod \<circ> f) y \<le> (cmod \<circ> f) z"
     using continuous_attains_sup [of "closure S" "norm o f"] \<open>\<xi> \<in> S\<close> by auto
   then consider "z \<in> frontier S" | "z \<in> interior S" using frontier_def by auto
   then have "norm(f z) \<le> B"
   proof cases
     case 1 then show ?thesis using leB by blast
   next
     case 2
     have zin: "z \<in> connected_component_set (interior S) z"
       by (simp add: 2)
     have "f constant_on (connected_component_set (interior S) z)"
       apply (rule maximum_modulus_principle [OF _ _ _ _ _ zin])
       apply (metis connected_component_subset holf holomorphic_on_subset)
       apply (simp_all add: open_connected_component)
       by (metis closure_subset comp_eq_dest_lhs  interior_subset subsetCE z connected_component_in)
     then obtain c where c: "\<And>w. w \<in> connected_component_set (interior S) z \<Longrightarrow> f w = c"
       by (auto simp: constant_on_def)
     have "f ` closure(connected_component_set (interior S) z) \<subseteq> {c}"
       apply (rule image_closure_subset)
       apply (meson closure_mono connected_component_subset contf continuous_on_subset interior_subset)
       using c
       apply auto
       done
     then have cc: "\<And>w. w \<in> closure(connected_component_set (interior S) z) \<Longrightarrow> f w = c" by blast
     have "frontier(connected_component_set (interior S) z) \<noteq> {}"
       apply (simp add: frontier_eq_empty)
       by (metis "2" bos bounded_interior connected_component_eq_UNIV connected_component_refl not_bounded_UNIV)
     then obtain w where w: "w \<in> frontier(connected_component_set (interior S) z)"
        by auto
     then have "norm (f z) = norm (f w)"  by (simp add: "2" c cc frontier_def)
     also have "... \<le> B"
       apply (rule leB)
       using w
 using frontier_interior_subset frontier_of_connected_component_subset by blast
     finally show ?thesis .
   qed
   then show ?thesis
     using z \<open>\<xi> \<in> S\<close> closure_subset by fastforce
 qed
 
 corollary\<^marker>\<open>tag unimportant\<close> maximum_real_frontier:
   assumes holf: "f holomorphic_on (interior S)"
       and contf: "continuous_on (closure S) f"
       and bos: "bounded S"
       and leB: "\<And>z. z \<in> frontier S \<Longrightarrow> Re(f z) \<le> B"
       and "\<xi> \<in> S"
     shows "Re(f \<xi>) \<le> B"
 using maximum_modulus_frontier [of "exp o f" S "exp B"]
       Transcendental.continuous_on_exp holomorphic_on_compose holomorphic_on_exp assms
 by auto
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Factoring out a zero according to its order\<close>
 
 lemma holomorphic_factor_order_of_zero:
   assumes holf: "f holomorphic_on S"
       and os: "open S"
       and "\<xi> \<in> S" "0 < n"
       and dnz: "(deriv ^^ n) f \<xi> \<noteq> 0"
       and dfz: "\<And>i. \<lbrakk>0 < i; i < n\<rbrakk> \<Longrightarrow> (deriv ^^ i) f \<xi> = 0"
    obtains g r where "0 < r"
                 "g holomorphic_on ball \<xi> r"
                 "\<And>w. w \<in> ball \<xi> r \<Longrightarrow> f w - f \<xi> = (w - \<xi>)^n * g w"
                 "\<And>w. w \<in> ball \<xi> r \<Longrightarrow> g w \<noteq> 0"
 proof -
   obtain r where "r>0" and r: "ball \<xi> r \<subseteq> S" using assms by (blast elim!: openE)
   then have holfb: "f holomorphic_on ball \<xi> r"
     using holf holomorphic_on_subset by blast
   define g where "g w = suminf (\<lambda>i. (deriv ^^ (i + n)) f \<xi> / (fact(i + n)) * (w - \<xi>)^i)" for w
   have sumsg: "(\<lambda>i. (deriv ^^ (i + n)) f \<xi> / (fact(i + n)) * (w - \<xi>)^i) sums g w"
    and feq: "f w - f \<xi> = (w - \<xi>)^n * g w"
        if w: "w \<in> ball \<xi> r" for w
   proof -
     define powf where "powf = (\<lambda>i. (deriv ^^ i) f \<xi>/(fact i) * (w - \<xi>)^i)"
     have sing: "{..<n} - {i. powf i = 0} = (if f \<xi> = 0 then {} else {0})"
       unfolding powf_def using \<open>0 < n\<close> dfz by (auto simp: dfz; metis funpow_0 not_gr0)
     have "powf sums f w"
       unfolding powf_def by (rule holomorphic_power_series [OF holfb w])
     moreover have "(\<Sum>i<n. powf i) = f \<xi>"
       apply (subst Groups_Big.comm_monoid_add_class.sum.setdiff_irrelevant [symmetric])
       apply simp
       apply (simp only: dfz sing)
       apply (simp add: powf_def)
       done
     ultimately have fsums: "(\<lambda>i. powf (i+n)) sums (f w - f \<xi>)"
       using w sums_iff_shift' by metis
     then have *: "summable (\<lambda>i. (w - \<xi>) ^ n * ((deriv ^^ (i + n)) f \<xi> * (w - \<xi>) ^ i / fact (i + n)))"
       unfolding powf_def using sums_summable
       by (auto simp: power_add mult_ac)
     have "summable (\<lambda>i. (deriv ^^ (i + n)) f \<xi> * (w - \<xi>) ^ i / fact (i + n))"
     proof (cases "w=\<xi>")
       case False then show ?thesis
         using summable_mult [OF *, of "1 / (w - \<xi>) ^ n"] by simp
     next
       case True then show ?thesis
         by (auto simp: Power.semiring_1_class.power_0_left intro!: summable_finite [of "{0}"]
                  split: if_split_asm)
     qed
     then show sumsg: "(\<lambda>i. (deriv ^^ (i + n)) f \<xi> / (fact(i + n)) * (w - \<xi>)^i) sums g w"
       by (simp add: summable_sums_iff g_def)
     show "f w - f \<xi> = (w - \<xi>)^n * g w"
       apply (rule sums_unique2)
       apply (rule fsums [unfolded powf_def])
       using sums_mult [OF sumsg, of "(w - \<xi>) ^ n"]
       by (auto simp: power_add mult_ac)
   qed
   then have holg: "g holomorphic_on ball \<xi> r"
     by (meson sumsg power_series_holomorphic)
   then have contg: "continuous_on (ball \<xi> r) g"
     by (blast intro: holomorphic_on_imp_continuous_on)
   have "g \<xi> \<noteq> 0"
     using dnz unfolding g_def
     by (subst suminf_finite [of "{0}"]) auto
   obtain d where "0 < d" and d: "\<And>w. w \<in> ball \<xi> d \<Longrightarrow> g w \<noteq> 0"
     apply (rule exE [OF continuous_on_avoid [OF contg _ \<open>g \<xi> \<noteq> 0\<close>]])
     using \<open>0 < r\<close>
     apply force
     by (metis \<open>0 < r\<close> less_trans mem_ball not_less_iff_gr_or_eq)
   show ?thesis
     apply (rule that [where g=g and r ="min r d"])
     using \<open>0 < r\<close> \<open>0 < d\<close> holg
     apply (auto simp: feq holomorphic_on_subset subset_ball d)
     done
 qed
 
 
 lemma holomorphic_factor_order_of_zero_strong:
   assumes holf: "f holomorphic_on S" "open S"  "\<xi> \<in> S" "0 < n"
       and "(deriv ^^ n) f \<xi> \<noteq> 0"
       and "\<And>i. \<lbrakk>0 < i; i < n\<rbrakk> \<Longrightarrow> (deriv ^^ i) f \<xi> = 0"
    obtains g r where "0 < r"
                 "g holomorphic_on ball \<xi> r"
                 "\<And>w. w \<in> ball \<xi> r \<Longrightarrow> f w - f \<xi> = ((w - \<xi>) * g w) ^ n"
                 "\<And>w. w \<in> ball \<xi> r \<Longrightarrow> g w \<noteq> 0"
 proof -
   obtain g r where "0 < r"
                and holg: "g holomorphic_on ball \<xi> r"
                and feq: "\<And>w. w \<in> ball \<xi> r \<Longrightarrow> f w - f \<xi> = (w - \<xi>)^n * g w"
                and gne: "\<And>w. w \<in> ball \<xi> r \<Longrightarrow> g w \<noteq> 0"
     by (auto intro: holomorphic_factor_order_of_zero [OF assms])
   have con: "continuous_on (ball \<xi> r) (\<lambda>z. deriv g z / g z)"
     by (rule continuous_intros) (auto simp: gne holg holomorphic_deriv holomorphic_on_imp_continuous_on)
   have cd: "\<And>x. dist \<xi> x < r \<Longrightarrow> (\<lambda>z. deriv g z / g z) field_differentiable at x"
     apply (rule derivative_intros)+
     using holg mem_ball apply (blast intro: holomorphic_deriv holomorphic_on_imp_differentiable_at)
     apply (metis open_ball at_within_open holg holomorphic_on_def mem_ball)
     using gne mem_ball by blast
   obtain h where h: "\<And>x. x \<in> ball \<xi> r \<Longrightarrow> (h has_field_derivative deriv g x / g x) (at x)"
     apply (rule exE [OF holomorphic_convex_primitive [of "ball \<xi> r" "{}" "\<lambda>z. deriv g z / g z"]])
     apply (auto simp: con cd)
     apply (metis open_ball at_within_open mem_ball)
     done
   then have "continuous_on (ball \<xi> r) h"
     by (metis open_ball holomorphic_on_imp_continuous_on holomorphic_on_open)
   then have con: "continuous_on (ball \<xi> r) (\<lambda>x. exp (h x) / g x)"
     by (auto intro!: continuous_intros simp add: holg holomorphic_on_imp_continuous_on gne)
   have 0: "dist \<xi> x < r \<Longrightarrow> ((\<lambda>x. exp (h x) / g x) has_field_derivative 0) (at x)" for x
     apply (rule h derivative_eq_intros | simp)+
     apply (rule DERIV_deriv_iff_field_differentiable [THEN iffD2])
     using holg apply (auto simp: holomorphic_on_imp_differentiable_at gne h)
     done
   obtain c where c: "\<And>x. x \<in> ball \<xi> r \<Longrightarrow> exp (h x) / g x = c"
     by (rule DERIV_zero_connected_constant [of "ball \<xi> r" "{}" "\<lambda>x. exp(h x) / g x"]) (auto simp: con 0)
   have hol: "(\<lambda>z. exp ((Ln (inverse c) + h z) / of_nat n)) holomorphic_on ball \<xi> r"
     apply (rule holomorphic_on_compose [unfolded o_def, where g = exp])
     apply (rule holomorphic_intros)+
     using h holomorphic_on_open apply blast
     apply (rule holomorphic_intros)+
     using \<open>0 < n\<close> apply simp
     apply (rule holomorphic_intros)+
     done
   show ?thesis
     apply (rule that [where g="\<lambda>z. exp((Ln(inverse c) + h z)/n)" and r =r])
     using \<open>0 < r\<close> \<open>0 < n\<close>
     apply (auto simp: feq power_mult_distrib exp_divide_power_eq c [symmetric])
     apply (rule hol)
     apply (simp add: Transcendental.exp_add gne)
     done
 qed
 
 
 lemma
   fixes k :: "'a::wellorder"
   assumes a_def: "a == LEAST x. P x" and P: "P k"
   shows def_LeastI: "P a" and def_Least_le: "a \<le> k"
 unfolding a_def
 by (rule LeastI Least_le; rule P)+
 
 lemma holomorphic_factor_zero_nonconstant:
   assumes holf: "f holomorphic_on S" and S: "open S" "connected S"
       and "\<xi> \<in> S" "f \<xi> = 0"
       and nonconst: "\<not> f constant_on S"
    obtains g r n
       where "0 < n"  "0 < r"  "ball \<xi> r \<subseteq> S"
             "g holomorphic_on ball \<xi> r"
             "\<And>w. w \<in> ball \<xi> r \<Longrightarrow> f w = (w - \<xi>)^n * g w"
             "\<And>w. w \<in> ball \<xi> r \<Longrightarrow> g w \<noteq> 0"
 proof (cases "\<forall>n>0. (deriv ^^ n) f \<xi> = 0")
   case True then show ?thesis
     using holomorphic_fun_eq_const_on_connected [OF holf S _ \<open>\<xi> \<in> S\<close>] nonconst by (simp add: constant_on_def)
 next
   case False
   then obtain n0 where "n0 > 0" and n0: "(deriv ^^ n0) f \<xi> \<noteq> 0" by blast
   obtain r0 where "r0 > 0" "ball \<xi> r0 \<subseteq> S" using S openE \<open>\<xi> \<in> S\<close> by auto
   define n where "n \<equiv> LEAST n. (deriv ^^ n) f \<xi> \<noteq> 0"
   have n_ne: "(deriv ^^ n) f \<xi> \<noteq> 0"
     by (rule def_LeastI [OF n_def]) (rule n0)
   then have "0 < n" using \<open>f \<xi> = 0\<close>
     using funpow_0 by fastforce
   have n_min: "\<And>k. k < n \<Longrightarrow> (deriv ^^ k) f \<xi> = 0"
     using def_Least_le [OF n_def] not_le by blast
   then obtain g r1
     where  "0 < r1" "g holomorphic_on ball \<xi> r1"
            "\<And>w. w \<in> ball \<xi> r1 \<Longrightarrow> f w = (w - \<xi>) ^ n * g w"
            "\<And>w. w \<in> ball \<xi> r1 \<Longrightarrow> g w \<noteq> 0"
     by (auto intro: holomorphic_factor_order_of_zero [OF holf \<open>open S\<close> \<open>\<xi> \<in> S\<close> \<open>n > 0\<close> n_ne] simp: \<open>f \<xi> = 0\<close>)
   then show ?thesis
     apply (rule_tac g=g and r="min r0 r1" and n=n in that)
     using \<open>0 < n\<close> \<open>0 < r0\<close> \<open>0 < r1\<close> \<open>ball \<xi> r0 \<subseteq> S\<close>
     apply (auto simp: subset_ball intro: holomorphic_on_subset)
     done
 qed
 
 
 lemma holomorphic_lower_bound_difference:
   assumes holf: "f holomorphic_on S" and S: "open S" "connected S"
       and "\<xi> \<in> S" and "\<phi> \<in> S"
       and fne: "f \<phi> \<noteq> f \<xi>"
    obtains k n r
       where "0 < k"  "0 < r"
             "ball \<xi> r \<subseteq> S"
             "\<And>w. w \<in> ball \<xi> r \<Longrightarrow> k * norm(w - \<xi>)^n \<le> norm(f w - f \<xi>)"
 proof -
   define n where "n = (LEAST n. 0 < n \<and> (deriv ^^ n) f \<xi> \<noteq> 0)"
   obtain n0 where "0 < n0" and n0: "(deriv ^^ n0) f \<xi> \<noteq> 0"
     using fne holomorphic_fun_eq_const_on_connected [OF holf S] \<open>\<xi> \<in> S\<close> \<open>\<phi> \<in> S\<close> by blast
   then have "0 < n" and n_ne: "(deriv ^^ n) f \<xi> \<noteq> 0"
     unfolding n_def by (metis (mono_tags, lifting) LeastI)+
   have n_min: "\<And>k. \<lbrakk>0 < k; k < n\<rbrakk> \<Longrightarrow> (deriv ^^ k) f \<xi> = 0"
     unfolding n_def by (blast dest: not_less_Least)
   then obtain g r
     where "0 < r" and holg: "g holomorphic_on ball \<xi> r"
       and fne: "\<And>w. w \<in> ball \<xi> r \<Longrightarrow> f w - f \<xi> = (w - \<xi>) ^ n * g w"
       and gnz: "\<And>w. w \<in> ball \<xi> r \<Longrightarrow> g w \<noteq> 0"
       by (auto intro: holomorphic_factor_order_of_zero  [OF holf \<open>open S\<close> \<open>\<xi> \<in> S\<close> \<open>n > 0\<close> n_ne])
   obtain e where "e>0" and e: "ball \<xi> e \<subseteq> S" using assms by (blast elim!: openE)
   then have holfb: "f holomorphic_on ball \<xi> e"
     using holf holomorphic_on_subset by blast
   define d where "d = (min e r) / 2"
   have "0 < d" using \<open>0 < r\<close> \<open>0 < e\<close> by (simp add: d_def)
   have "d < r"
     using \<open>0 < r\<close> by (auto simp: d_def)
   then have cbb: "cball \<xi> d \<subseteq> ball \<xi> r"
     by (auto simp: cball_subset_ball_iff)
   then have "g holomorphic_on cball \<xi> d"
     by (rule holomorphic_on_subset [OF holg])
   then have "closed (g ` cball \<xi> d)"
     by (simp add: compact_imp_closed compact_continuous_image holomorphic_on_imp_continuous_on)
   moreover have "g ` cball \<xi> d \<noteq> {}"
     using \<open>0 < d\<close> by auto
   ultimately obtain x where x: "x \<in> g ` cball \<xi> d" and "\<And>y. y \<in> g ` cball \<xi> d \<Longrightarrow> dist 0 x \<le> dist 0 y"
     by (rule distance_attains_inf) blast
   then have leg: "\<And>w. w \<in> cball \<xi> d \<Longrightarrow> norm x \<le> norm (g w)"
     by auto
   have "ball \<xi> d \<subseteq> cball \<xi> d" by auto
   also have "... \<subseteq> ball \<xi> e" using \<open>0 < d\<close> d_def by auto
   also have "... \<subseteq> S" by (rule e)
   finally have dS: "ball \<xi> d \<subseteq> S" .
   moreover have "x \<noteq> 0" using gnz x \<open>d < r\<close> by auto
   ultimately show ?thesis
     apply (rule_tac k="norm x" and n=n and r=d in that)
     using \<open>d < r\<close> leg
     apply (auto simp: \<open>0 < d\<close> fne norm_mult norm_power algebra_simps mult_right_mono)
     done
 qed
 
 lemma
   assumes holf: "f holomorphic_on (S - {\<xi>})" and \<xi>: "\<xi> \<in> interior S"
     shows holomorphic_on_extend_lim:
           "(\<exists>g. g holomorphic_on S \<and> (\<forall>z \<in> S - {\<xi>}. g z = f z)) \<longleftrightarrow>
            ((\<lambda>z. (z - \<xi>) * f z) \<longlongrightarrow> 0) (at \<xi>)"
           (is "?P = ?Q")
      and holomorphic_on_extend_bounded:
           "(\<exists>g. g holomorphic_on S \<and> (\<forall>z \<in> S - {\<xi>}. g z = f z)) \<longleftrightarrow>
            (\<exists>B. eventually (\<lambda>z. norm(f z) \<le> B) (at \<xi>))"
           (is "?P = ?R")
 proof -
   obtain \<delta> where "0 < \<delta>" and \<delta>: "ball \<xi> \<delta> \<subseteq> S"
     using \<xi> mem_interior by blast
   have "?R" if holg: "g holomorphic_on S" and gf: "\<And>z. z \<in> S - {\<xi>} \<Longrightarrow> g z = f z" for g
   proof -
     have *: "\<forall>\<^sub>F z in at \<xi>. dist (g z) (g \<xi>) < 1 \<longrightarrow> cmod (f z) \<le> cmod (g \<xi>) + 1"
       apply (simp add: eventually_at)
       apply (rule_tac x="\<delta>" in exI)
       using \<delta> \<open>0 < \<delta>\<close>
       apply (clarsimp simp:)
       apply (drule_tac c=x in subsetD)
       apply (simp add: dist_commute)
       by (metis DiffI add.commute diff_le_eq dist_norm gf le_less_trans less_eq_real_def norm_triangle_ineq2 singletonD)
     have "continuous_on (interior S) g"
       by (meson continuous_on_subset holg holomorphic_on_imp_continuous_on interior_subset)
     then have "\<And>x. x \<in> interior S \<Longrightarrow> (g \<longlongrightarrow> g x) (at x)"
       using continuous_on_interior continuous_within holg holomorphic_on_imp_continuous_on by blast
     then have "(g \<longlongrightarrow> g \<xi>) (at \<xi>)"
       by (simp add: \<xi>)
     then show ?thesis
       apply (rule_tac x="norm(g \<xi>) + 1" in exI)
       apply (rule eventually_mp [OF * tendstoD [where e=1]], auto)
       done
   qed
   moreover have "?Q" if "\<forall>\<^sub>F z in at \<xi>. cmod (f z) \<le> B" for B
     by (rule lim_null_mult_right_bounded [OF _ that]) (simp add: LIM_zero)
   moreover have "?P" if "(\<lambda>z. (z - \<xi>) * f z) \<midarrow>\<xi>\<rightarrow> 0"
   proof -
     define h where [abs_def]: "h z = (z - \<xi>)^2 * f z" for z
     have h0: "(h has_field_derivative 0) (at \<xi>)"
       apply (simp add: h_def has_field_derivative_iff)
       apply (rule Lim_transform_within [OF that, of 1])
       apply (auto simp: field_split_simps power2_eq_square)
       done
     have holh: "h holomorphic_on S"
     proof (simp add: holomorphic_on_def, clarify)
       fix z assume "z \<in> S"
       show "h field_differentiable at z within S"
       proof (cases "z = \<xi>")
         case True then show ?thesis
           using field_differentiable_at_within field_differentiable_def h0 by blast
       next
         case False
         then have "f field_differentiable at z within S"
           using holomorphic_onD [OF holf, of z] \<open>z \<in> S\<close>
           unfolding field_differentiable_def has_field_derivative_iff
           by (force intro: exI [where x="dist \<xi> z"] elim: Lim_transform_within_set [unfolded eventually_at])
         then show ?thesis
           by (simp add: h_def power2_eq_square derivative_intros)
       qed
     qed
     define g where [abs_def]: "g z = (if z = \<xi> then deriv h \<xi> else (h z - h \<xi>) / (z - \<xi>))" for z
     have holg: "g holomorphic_on S"
       unfolding g_def by (rule pole_lemma [OF holh \<xi>])
     show ?thesis
       apply (rule_tac x="\<lambda>z. if z = \<xi> then deriv g \<xi> else (g z - g \<xi>)/(z - \<xi>)" in exI)
       apply (rule conjI)
       apply (rule pole_lemma [OF holg \<xi>])
       apply (auto simp: g_def power2_eq_square divide_simps)
       using h0 apply (simp add: h0 DERIV_imp_deriv h_def power2_eq_square)
       done
   qed
   ultimately show "?P = ?Q" and "?P = ?R"
     by meson+
 qed
 
 lemma pole_at_infinity:
   assumes holf: "f holomorphic_on UNIV" and lim: "((inverse o f) \<longlongrightarrow> l) at_infinity"
   obtains a n where "\<And>z. f z = (\<Sum>i\<le>n. a i * z^i)"
 proof (cases "l = 0")
   case False
   with tendsto_inverse [OF lim] show ?thesis
     apply (rule_tac a="(\<lambda>n. inverse l)" and n=0 in that)
     apply (simp add: Liouville_weak [OF holf, of "inverse l"])
     done
 next
   case True
   then have [simp]: "l = 0" .
   show ?thesis
   proof (cases "\<exists>r. 0 < r \<and> (\<forall>z \<in> ball 0 r - {0}. f(inverse z) \<noteq> 0)")
     case True
       then obtain r where "0 < r" and r: "\<And>z. z \<in> ball 0 r - {0} \<Longrightarrow> f(inverse z) \<noteq> 0"
              by auto
       have 1: "inverse \<circ> f \<circ> inverse holomorphic_on ball 0 r - {0}"
         by (rule holomorphic_on_compose holomorphic_intros holomorphic_on_subset [OF holf] | force simp: r)+
       have 2: "0 \<in> interior (ball 0 r)"
         using \<open>0 < r\<close> by simp
       have "\<exists>B. 0<B \<and> eventually (\<lambda>z. cmod ((inverse \<circ> f \<circ> inverse) z) \<le> B) (at 0)"
         apply (rule exI [where x=1])
         apply simp
         using tendstoD [OF lim [unfolded lim_at_infinity_0] zero_less_one]
         apply (rule eventually_mono)
         apply (simp add: dist_norm)
         done
       with holomorphic_on_extend_bounded [OF 1 2]
       obtain g where holg: "g holomorphic_on ball 0 r"
                  and geq: "\<And>z. z \<in> ball 0 r - {0} \<Longrightarrow> g z = (inverse \<circ> f \<circ> inverse) z"
         by meson
       have ifi0: "(inverse \<circ> f \<circ> inverse) \<midarrow>0\<rightarrow> 0"
         using \<open>l = 0\<close> lim lim_at_infinity_0 by blast
       have g2g0: "g \<midarrow>0\<rightarrow> g 0"
         using \<open>0 < r\<close> centre_in_ball continuous_at continuous_on_eq_continuous_at holg
         by (blast intro: holomorphic_on_imp_continuous_on)
       have g2g1: "g \<midarrow>0\<rightarrow> 0"
         apply (rule Lim_transform_within_open [OF ifi0 open_ball [of 0 r]])
         using \<open>0 < r\<close> by (auto simp: geq)
       have [simp]: "g 0 = 0"
         by (rule tendsto_unique [OF _ g2g0 g2g1]) simp
       have "ball 0 r - {0::complex} \<noteq> {}"
         using \<open>0 < r\<close>
         apply (clarsimp simp: ball_def dist_norm)
         apply (drule_tac c="of_real r/2" in subsetD, auto)
         done
       then obtain w::complex where "w \<noteq> 0" and w: "norm w < r" by force
       then have "g w \<noteq> 0" by (simp add: geq r)
       obtain B n e where "0 < B" "0 < e" "e \<le> r"
                      and leg: "\<And>w. norm w < e \<Longrightarrow> B * cmod w ^ n \<le> cmod (g w)"
         apply (rule holomorphic_lower_bound_difference [OF holg open_ball connected_ball, of 0 w])
         using \<open>0 < r\<close> w \<open>g w \<noteq> 0\<close> by (auto simp: ball_subset_ball_iff)
       have "cmod (f z) \<le> cmod z ^ n / B" if "2/e \<le> cmod z" for z
       proof -
         have ize: "inverse z \<in> ball 0 e - {0}" using that \<open>0 < e\<close>
           by (auto simp: norm_divide field_split_simps algebra_simps)
         then have [simp]: "z \<noteq> 0" and izr: "inverse z \<in> ball 0 r - {0}" using  \<open>e \<le> r\<close>
           by auto
         then have [simp]: "f z \<noteq> 0"
           using r [of "inverse z"] by simp
         have [simp]: "f z = inverse (g (inverse z))"
           using izr geq [of "inverse z"] by simp
         show ?thesis using ize leg [of "inverse z"]  \<open>0 < B\<close>  \<open>0 < e\<close>
           by (simp add: field_split_simps norm_divide algebra_simps)
       qed
       then show ?thesis
         apply (rule_tac a = "\<lambda>k. (deriv ^^ k) f 0 / (fact k)" and n=n in that)
         apply (rule_tac A = "2/e" and B = "1/B" in Liouville_polynomial [OF holf], simp)
         done
   next
     case False
     then have fi0: "\<And>r. r > 0 \<Longrightarrow> \<exists>z\<in>ball 0 r - {0}. f (inverse z) = 0"
       by simp
     have fz0: "f z = 0" if "0 < r" and lt1: "\<And>x. x \<noteq> 0 \<Longrightarrow> cmod x < r \<Longrightarrow> inverse (cmod (f (inverse x))) < 1"
               for z r
     proof -
       have f0: "(f \<longlongrightarrow> 0) at_infinity"
       proof -
         have DIM_complex[intro]: "2 \<le> DIM(complex)"  \<comment> \<open>should not be necessary!\<close>
           by simp
         from lt1 have "f (inverse x) \<noteq> 0 \<Longrightarrow> x \<noteq> 0 \<Longrightarrow> cmod x < r \<Longrightarrow> 1 < cmod (f (inverse x))" for x
           using one_less_inverse by force
         then have **: "cmod (f (inverse x)) \<le> 1 \<Longrightarrow> x \<noteq> 0 \<Longrightarrow> cmod x < r \<Longrightarrow> f (inverse x) = 0" for x
           by force
         then have *: "(f \<circ> inverse) ` (ball 0 r - {0}) \<subseteq> {0} \<union> - ball 0 1"
           by force
         have "continuous_on (inverse ` (ball 0 r - {0})) f"
           using continuous_on_subset holf holomorphic_on_imp_continuous_on by blast
         then have "connected ((f \<circ> inverse) ` (ball 0 r - {0}))"
           apply (intro connected_continuous_image continuous_intros)
           apply (force intro: connected_punctured_ball)+
           done
         then have "{0} \<inter> (f \<circ> inverse) ` (ball 0 r - {0}) = {} \<or> - ball 0 1 \<inter> (f \<circ> inverse) ` (ball 0 r - {0}) = {}"
           by (rule connected_closedD) (use * in auto)
         then have "w \<noteq> 0 \<Longrightarrow> cmod w < r \<Longrightarrow> f (inverse w) = 0" for w
           using fi0 **[of w] \<open>0 < r\<close>
           apply (auto simp add: inf.commute [of "- ball 0 1"] Diff_eq [symmetric] image_subset_iff dest: less_imp_le)
            apply fastforce
           apply (drule bspec [of _ _ w])
            apply (auto dest: less_imp_le)
           done
         then show ?thesis
           apply (simp add: lim_at_infinity_0)
           apply (rule tendsto_eventually)
           apply (simp add: eventually_at)
           apply (rule_tac x=r in exI)
           apply (simp add: \<open>0 < r\<close> dist_norm)
           done
       qed
       obtain w where "w \<in> ball 0 r - {0}" and "f (inverse w) = 0"
         using False \<open>0 < r\<close> by blast
       then show ?thesis
         by (auto simp: f0 Liouville_weak [OF holf, of 0])
     qed
     show ?thesis
       apply (rule that [of "\<lambda>n. 0" 0])
       using lim [unfolded lim_at_infinity_0]
       apply (simp add: Lim_at dist_norm norm_inverse)
       apply (drule_tac x=1 in spec)
       using fz0 apply auto
       done
     qed
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Entire proper functions are precisely the non-trivial polynomials\<close>
 
 lemma proper_map_polyfun:
     fixes c :: "nat \<Rightarrow> 'a::{real_normed_div_algebra,heine_borel}"
   assumes "closed S" and "compact K" and c: "c i \<noteq> 0" "1 \<le> i" "i \<le> n"
     shows "compact (S \<inter> {z. (\<Sum>i\<le>n. c i * z^i) \<in> K})"
 proof -
   obtain B where "B > 0" and B: "\<And>x. x \<in> K \<Longrightarrow> norm x \<le> B"
     by (metis compact_imp_bounded \<open>compact K\<close> bounded_pos)
   have *: "norm x \<le> b"
             if "\<And>x. b \<le> norm x \<Longrightarrow> B + 1 \<le> norm (\<Sum>i\<le>n. c i * x ^ i)"
                "(\<Sum>i\<le>n. c i * x ^ i) \<in> K"  for b x
   proof -
     have "norm (\<Sum>i\<le>n. c i * x ^ i) \<le> B"
       using B that by blast
     moreover have "\<not> B + 1 \<le> B"
       by simp
     ultimately show "norm x \<le> b"
       using that by (metis (no_types) less_eq_real_def not_less order_trans)
   qed
   have "bounded {z. (\<Sum>i\<le>n. c i * z ^ i) \<in> K}"
     using polyfun_extremal [where c=c and B="B+1", OF c]
     by (auto simp: bounded_pos eventually_at_infinity_pos *)
   moreover have "closed ((\<lambda>z. (\<Sum>i\<le>n. c i * z ^ i)) -` K)"
     apply (intro allI continuous_closed_vimage continuous_intros)
     using \<open>compact K\<close> compact_eq_bounded_closed by blast
   ultimately show ?thesis
     using closed_Int_compact [OF \<open>closed S\<close>] compact_eq_bounded_closed
     by (auto simp add: vimage_def)
 qed
 
 lemma proper_map_polyfun_univ:
     fixes c :: "nat \<Rightarrow> 'a::{real_normed_div_algebra,heine_borel}"
   assumes "compact K" "c i \<noteq> 0" "1 \<le> i" "i \<le> n"
     shows "compact ({z. (\<Sum>i\<le>n. c i * z^i) \<in> K})"
   using proper_map_polyfun [of UNIV K c i n] assms by simp
 
 lemma proper_map_polyfun_eq:
   assumes "f holomorphic_on UNIV"
     shows "(\<forall>k. compact k \<longrightarrow> compact {z. f z \<in> k}) \<longleftrightarrow>
            (\<exists>c n. 0 < n \<and> (c n \<noteq> 0) \<and> f = (\<lambda>z. \<Sum>i\<le>n. c i * z^i))"
           (is "?lhs = ?rhs")
 proof
   assume compf [rule_format]: ?lhs
   have 2: "\<exists>k. 0 < k \<and> a k \<noteq> 0 \<and> f = (\<lambda>z. \<Sum>i \<le> k. a i * z ^ i)"
         if "\<And>z. f z = (\<Sum>i\<le>n. a i * z ^ i)" for a n
   proof (cases "\<forall>i\<le>n. 0<i \<longrightarrow> a i = 0")
     case True
     then have [simp]: "\<And>z. f z = a 0"
       by (simp add: that sum.atMost_shift)
     have False using compf [of "{a 0}"] by simp
     then show ?thesis ..
   next
     case False
     then obtain k where k: "0 < k" "k\<le>n" "a k \<noteq> 0" by force
     define m where "m = (GREATEST k. k\<le>n \<and> a k \<noteq> 0)"
     have m: "m\<le>n \<and> a m \<noteq> 0"
       unfolding m_def
       apply (rule GreatestI_nat [where b = n])
       using k apply auto
       done
     have [simp]: "a i = 0" if "m < i" "i \<le> n" for i
       using Greatest_le_nat [where b = "n" and P = "\<lambda>k. k\<le>n \<and> a k \<noteq> 0"]
       using m_def not_le that by auto
     have "k \<le> m"
       unfolding m_def
       apply (rule Greatest_le_nat [where b = "n"])
       using k apply auto
       done
     with k m show ?thesis
       by (rule_tac x=m in exI) (auto simp: that comm_monoid_add_class.sum.mono_neutral_right)
   qed
   have "((inverse \<circ> f) \<longlongrightarrow> 0) at_infinity"
   proof (rule Lim_at_infinityI)
     fix e::real assume "0 < e"
     with compf [of "cball 0 (inverse e)"]
     show "\<exists>B. \<forall>x. B \<le> cmod x \<longrightarrow> dist ((inverse \<circ> f) x) 0 \<le> e"
       apply simp
       apply (clarsimp simp add: compact_eq_bounded_closed bounded_pos norm_inverse)
       apply (rule_tac x="b+1" in exI)
       apply (metis inverse_inverse_eq less_add_same_cancel2 less_imp_inverse_less add.commute not_le not_less_iff_gr_or_eq order_trans zero_less_one)
       done
   qed
   then show ?rhs
     apply (rule pole_at_infinity [OF assms])
     using 2 apply blast
     done
 next
   assume ?rhs
   then obtain c n where "0 < n" "c n \<noteq> 0" "f = (\<lambda>z. \<Sum>i\<le>n. c i * z ^ i)" by blast
   then have "compact {z. f z \<in> k}" if "compact k" for k
     by (auto intro: proper_map_polyfun_univ [OF that])
   then show ?lhs by blast
 qed
 
 subsection \<open>Relating invertibility and nonvanishing of derivative\<close>
 
 lemma has_complex_derivative_locally_injective:
   assumes holf: "f holomorphic_on S"
       and S: "\<xi> \<in> S" "open S"
       and dnz: "deriv f \<xi> \<noteq> 0"
   obtains r where "r > 0" "ball \<xi> r \<subseteq> S" "inj_on f (ball \<xi> r)"
 proof -
   have *: "\<exists>d>0. \<forall>x. dist \<xi> x < d \<longrightarrow> onorm (\<lambda>v. deriv f x * v - deriv f \<xi> * v) < e" if "e > 0" for e
   proof -
     have contdf: "continuous_on S (deriv f)"
       by (simp add: holf holomorphic_deriv holomorphic_on_imp_continuous_on \<open>open S\<close>)
     obtain \<delta> where "\<delta>>0" and \<delta>: "\<And>x. \<lbrakk>x \<in> S; dist x \<xi> \<le> \<delta>\<rbrakk> \<Longrightarrow> cmod (deriv f x - deriv f \<xi>) \<le> e/2"
       using continuous_onE [OF contdf \<open>\<xi> \<in> S\<close>, of "e/2"] \<open>0 < e\<close>
       by (metis dist_complex_def half_gt_zero less_imp_le)
     obtain \<epsilon> where "\<epsilon>>0" "ball \<xi> \<epsilon> \<subseteq> S"
       by (metis openE [OF \<open>open S\<close> \<open>\<xi> \<in> S\<close>])
     with \<open>\<delta>>0\<close> have "\<exists>\<delta>>0. \<forall>x. dist \<xi> x < \<delta> \<longrightarrow> onorm (\<lambda>v. deriv f x * v - deriv f \<xi> * v) \<le> e/2"
       apply (rule_tac x="min \<delta> \<epsilon>" in exI)
       apply (intro conjI allI impI Operator_Norm.onorm_le)
       apply simp
       apply (simp only: Rings.ring_class.left_diff_distrib [symmetric] norm_mult)
       apply (rule mult_right_mono [OF \<delta>])
       apply (auto simp: dist_commute Rings.ordered_semiring_class.mult_right_mono \<delta>)
       done
     with \<open>e>0\<close> show ?thesis by force
   qed
   have "inj ((*) (deriv f \<xi>))"
     using dnz by simp
   then obtain g' where g': "linear g'" "g' \<circ> (*) (deriv f \<xi>) = id"
     using linear_injective_left_inverse [of "(*) (deriv f \<xi>)"]
     by (auto simp: linear_times)
   show ?thesis
     apply (rule has_derivative_locally_injective [OF S, where f=f and f' = "\<lambda>z h. deriv f z * h" and g' = g'])
     using g' *
     apply (simp_all add: linear_conv_bounded_linear that)
     using DERIV_deriv_iff_field_differentiable has_field_derivative_imp_has_derivative holf
         holomorphic_on_imp_differentiable_at \<open>open S\<close> apply blast
     done
 qed
 
 lemma has_complex_derivative_locally_invertible:
   assumes holf: "f holomorphic_on S"
       and S: "\<xi> \<in> S" "open S"
       and dnz: "deriv f \<xi> \<noteq> 0"
   obtains r where "r > 0" "ball \<xi> r \<subseteq> S" "open (f `  (ball \<xi> r))" "inj_on f (ball \<xi> r)"
 proof -
   obtain r where "r > 0" "ball \<xi> r \<subseteq> S" "inj_on f (ball \<xi> r)"
     by (blast intro: that has_complex_derivative_locally_injective [OF assms])
   then have \<xi>: "\<xi> \<in> ball \<xi> r" by simp
   then have nc: "\<not> f constant_on ball \<xi> r"
     using \<open>inj_on f (ball \<xi> r)\<close> injective_not_constant by fastforce
   have holf': "f holomorphic_on ball \<xi> r"
     using \<open>ball \<xi> r \<subseteq> S\<close> holf holomorphic_on_subset by blast
   have "open (f ` ball \<xi> r)"
     apply (rule open_mapping_thm [OF holf'])
     using nc apply auto
     done
   then show ?thesis
     using \<open>0 < r\<close> \<open>ball \<xi> r \<subseteq> S\<close> \<open>inj_on f (ball \<xi> r)\<close> that  by blast
 qed
 
 lemma holomorphic_injective_imp_regular:
   assumes holf: "f holomorphic_on S"
       and "open S" and injf: "inj_on f S"
       and "\<xi> \<in> S"
     shows "deriv f \<xi> \<noteq> 0"
 proof -
   obtain r where "r>0" and r: "ball \<xi> r \<subseteq> S" using assms by (blast elim!: openE)
   have holf': "f holomorphic_on ball \<xi> r"
     using \<open>ball \<xi> r \<subseteq> S\<close> holf holomorphic_on_subset by blast
   show ?thesis
   proof (cases "\<forall>n>0. (deriv ^^ n) f \<xi> = 0")
     case True
     have fcon: "f w = f \<xi>" if "w \<in> ball \<xi> r" for w
       apply (rule holomorphic_fun_eq_const_on_connected [OF holf'])
       using True \<open>0 < r\<close> that by auto
     have False
       using fcon [of "\<xi> + r/2"] \<open>0 < r\<close> r injf unfolding inj_on_def
       by (metis \<open>\<xi> \<in> S\<close> contra_subsetD dist_commute fcon mem_ball perfect_choose_dist)
     then show ?thesis ..
   next
     case False
     then obtain n0 where n0: "n0 > 0 \<and> (deriv ^^ n0) f \<xi> \<noteq> 0" by blast
     define n where [abs_def]: "n = (LEAST n. n > 0 \<and> (deriv ^^ n) f \<xi> \<noteq> 0)"
     have n_ne: "n > 0" "(deriv ^^ n) f \<xi> \<noteq> 0"
       using def_LeastI [OF n_def n0] by auto
     have n_min: "\<And>k. 0 < k \<Longrightarrow> k < n \<Longrightarrow> (deriv ^^ k) f \<xi> = 0"
       using def_Least_le [OF n_def] not_le by auto
     obtain g \<delta> where "0 < \<delta>"
              and holg: "g holomorphic_on ball \<xi> \<delta>"
              and fd: "\<And>w. w \<in> ball \<xi> \<delta> \<Longrightarrow> f w - f \<xi> = ((w - \<xi>) * g w) ^ n"
              and gnz: "\<And>w. w \<in> ball \<xi> \<delta> \<Longrightarrow> g w \<noteq> 0"
       apply (rule holomorphic_factor_order_of_zero_strong [OF holf \<open>open S\<close> \<open>\<xi> \<in> S\<close> n_ne])
       apply (blast intro: n_min)+
       done
     show ?thesis
     proof (cases "n=1")
       case True
       with n_ne show ?thesis by auto
     next
       case False
       have holgw: "(\<lambda>w. (w - \<xi>) * g w) holomorphic_on ball \<xi> (min r \<delta>)"
         apply (rule holomorphic_intros)+
         using holg by (simp add: holomorphic_on_subset subset_ball)
       have gd: "\<And>w. dist \<xi> w < \<delta> \<Longrightarrow> (g has_field_derivative deriv g w) (at w)"
         using holg
         by (simp add: DERIV_deriv_iff_field_differentiable holomorphic_on_def at_within_open_NO_MATCH)
       have *: "\<And>w. w \<in> ball \<xi> (min r \<delta>)
             \<Longrightarrow> ((\<lambda>w. (w - \<xi>) * g w) has_field_derivative ((w - \<xi>) * deriv g w + g w))
                 (at w)"
         by (rule gd derivative_eq_intros | simp)+
       have [simp]: "deriv (\<lambda>w. (w - \<xi>) * g w) \<xi> \<noteq> 0"
         using * [of \<xi>] \<open>0 < \<delta>\<close> \<open>0 < r\<close> by (simp add: DERIV_imp_deriv gnz)
       obtain T where "\<xi> \<in> T" "open T" and Tsb: "T \<subseteq> ball \<xi> (min r \<delta>)" and oimT: "open ((\<lambda>w. (w - \<xi>) * g w) ` T)"
         apply (rule has_complex_derivative_locally_invertible [OF holgw, of \<xi>])
         using \<open>0 < r\<close> \<open>0 < \<delta>\<close>
         apply (simp_all add:)
         by (meson open_ball centre_in_ball)
       define U where "U = (\<lambda>w. (w - \<xi>) * g w) ` T"
       have "open U" by (metis oimT U_def)
       have "0 \<in> U"
         apply (auto simp: U_def)
         apply (rule image_eqI [where x = \<xi>])
         apply (auto simp: \<open>\<xi> \<in> T\<close>)
         done
       then obtain \<epsilon> where "\<epsilon>>0" and \<epsilon>: "cball 0 \<epsilon> \<subseteq> U"
         using \<open>open U\<close> open_contains_cball by blast
       then have "\<epsilon> * exp(2 * of_real pi * \<i> * (0/n)) \<in> cball 0 \<epsilon>"
                 "\<epsilon> * exp(2 * of_real pi * \<i> * (1/n)) \<in> cball 0 \<epsilon>"
         by (auto simp: norm_mult)
       with \<epsilon> have "\<epsilon> * exp(2 * of_real pi * \<i> * (0/n)) \<in> U"
                   "\<epsilon> * exp(2 * of_real pi * \<i> * (1/n)) \<in> U" by blast+
       then obtain y0 y1 where "y0 \<in> T" and y0: "(y0 - \<xi>) * g y0 = \<epsilon> * exp(2 * of_real pi * \<i> * (0/n))"
                           and "y1 \<in> T" and y1: "(y1 - \<xi>) * g y1 = \<epsilon> * exp(2 * of_real pi * \<i> * (1/n))"
         by (auto simp: U_def)
       then have "y0 \<in> ball \<xi> \<delta>" "y1 \<in> ball \<xi> \<delta>" using Tsb by auto
       moreover have "y0 \<noteq> y1"
         using y0 y1 \<open>\<epsilon> > 0\<close> complex_root_unity_eq_1 [of n 1] \<open>n > 0\<close> False by auto
       moreover have "T \<subseteq> S"
         by (meson Tsb min.cobounded1 order_trans r subset_ball)
       ultimately have False
         using inj_onD [OF injf, of y0 y1] \<open>y0 \<in> T\<close> \<open>y1 \<in> T\<close>
         using fd [of y0] fd [of y1] complex_root_unity [of n 1] n_ne
         apply (simp add: y0 y1 power_mult_distrib)
         apply (force simp: algebra_simps)
         done
       then show ?thesis ..
     qed
   qed
 qed
 
 text\<open>Hence a nice clean inverse function theorem\<close>
 
 lemma has_field_derivative_inverse_strong:
   fixes f :: "'a::{euclidean_space,real_normed_field} \<Rightarrow> 'a"
   shows "\<lbrakk>DERIV f x :> f'; f' \<noteq> 0; open S; x \<in> S; continuous_on S f;
          \<And>z. z \<in> S \<Longrightarrow> g (f z) = z\<rbrakk>
          \<Longrightarrow> DERIV g (f x) :> inverse (f')"
   unfolding has_field_derivative_def
   by (rule has_derivative_inverse_strong [of S x f g]) auto
 
 lemma has_field_derivative_inverse_strong_x:
   fixes f :: "'a::{euclidean_space,real_normed_field} \<Rightarrow> 'a"
   shows  "\<lbrakk>DERIV f (g y) :> f'; f' \<noteq> 0; open S; continuous_on S f; g y \<in> S; f(g y) = y;
            \<And>z. z \<in> S \<Longrightarrow> g (f z) = z\<rbrakk>
           \<Longrightarrow> DERIV g y :> inverse (f')"
   unfolding has_field_derivative_def
   by (rule has_derivative_inverse_strong_x [of S g y f]) auto
 
 proposition holomorphic_has_inverse:
   assumes holf: "f holomorphic_on S"
       and "open S" and injf: "inj_on f S"
   obtains g where "g holomorphic_on (f ` S)"
                   "\<And>z. z \<in> S \<Longrightarrow> deriv f z * deriv g (f z) = 1"
                   "\<And>z. z \<in> S \<Longrightarrow> g(f z) = z"
 proof -
   have ofs: "open (f ` S)"
     by (rule open_mapping_thm3 [OF assms])
   have contf: "continuous_on S f"
     by (simp add: holf holomorphic_on_imp_continuous_on)
   have *: "(the_inv_into S f has_field_derivative inverse (deriv f z)) (at (f z))" if "z \<in> S" for z
   proof -
     have 1: "(f has_field_derivative deriv f z) (at z)"
       using DERIV_deriv_iff_field_differentiable \<open>z \<in> S\<close> \<open>open S\<close> holf holomorphic_on_imp_differentiable_at
       by blast
     have 2: "deriv f z \<noteq> 0"
       using \<open>z \<in> S\<close> \<open>open S\<close> holf holomorphic_injective_imp_regular injf by blast
     show ?thesis
       apply (rule has_field_derivative_inverse_strong [OF 1 2 \<open>open S\<close> \<open>z \<in> S\<close>])
        apply (simp add: holf holomorphic_on_imp_continuous_on)
       by (simp add: injf the_inv_into_f_f)
   qed
   show ?thesis
     proof
       show "the_inv_into S f holomorphic_on f ` S"
         by (simp add: holomorphic_on_open ofs) (blast intro: *)
     next
       fix z assume "z \<in> S"
       have "deriv f z \<noteq> 0"
         using \<open>z \<in> S\<close> \<open>open S\<close> holf holomorphic_injective_imp_regular injf by blast
       then show "deriv f z * deriv (the_inv_into S f) (f z) = 1"
         using * [OF \<open>z \<in> S\<close>]  by (simp add: DERIV_imp_deriv)
     next
       fix z assume "z \<in> S"
       show "the_inv_into S f (f z) = z"
         by (simp add: \<open>z \<in> S\<close> injf the_inv_into_f_f)
   qed
 qed
 
 subsection\<open>The Schwarz Lemma\<close>
 
 lemma Schwarz1:
   assumes holf: "f holomorphic_on S"
       and contf: "continuous_on (closure S) f"
       and S: "open S" "connected S"
       and boS: "bounded S"
       and "S \<noteq> {}"
   obtains w where "w \<in> frontier S"
        "\<And>z. z \<in> closure S \<Longrightarrow> norm (f z) \<le> norm (f w)"
 proof -
   have connf: "continuous_on (closure S) (norm o f)"
     using contf continuous_on_compose continuous_on_norm_id by blast
   have coc: "compact (closure S)"
     by (simp add: \<open>bounded S\<close> bounded_closure compact_eq_bounded_closed)
   then obtain x where x: "x \<in> closure S" and xmax: "\<And>z. z \<in> closure S \<Longrightarrow> norm(f z) \<le> norm(f x)"
     apply (rule bexE [OF continuous_attains_sup [OF _ _ connf]])
     using \<open>S \<noteq> {}\<close> apply auto
     done
   then show ?thesis
   proof (cases "x \<in> frontier S")
     case True
     then show ?thesis using that xmax by blast
   next
     case False
     then have "x \<in> S"
       using \<open>open S\<close> frontier_def interior_eq x by auto
     then have "f constant_on S"
       apply (rule maximum_modulus_principle [OF holf S \<open>open S\<close> order_refl])
       using closure_subset apply (blast intro: xmax)
       done
     then have "f constant_on (closure S)"
       by (rule constant_on_closureI [OF _ contf])
     then obtain c where c: "\<And>x. x \<in> closure S \<Longrightarrow> f x = c"
       by (meson constant_on_def)
     obtain w where "w \<in> frontier S"
       by (metis coc all_not_in_conv assms(6) closure_UNIV frontier_eq_empty not_compact_UNIV)
     then show ?thesis
       by (simp add: c frontier_def that)
   qed
 qed
 
 lemma Schwarz2:
  "\<lbrakk>f holomorphic_on ball 0 r;
     0 < s; ball w s \<subseteq> ball 0 r;
     \<And>z. norm (w-z) < s \<Longrightarrow> norm(f z) \<le> norm(f w)\<rbrakk>
     \<Longrightarrow> f constant_on ball 0 r"
 by (rule maximum_modulus_principle [where U = "ball w s" and \<xi> = w]) (simp_all add: dist_norm)
 
 lemma Schwarz3:
   assumes holf: "f holomorphic_on (ball 0 r)" and [simp]: "f 0 = 0"
   obtains h where "h holomorphic_on (ball 0 r)" and "\<And>z. norm z < r \<Longrightarrow> f z = z * (h z)" and "deriv f 0 = h 0"
 proof -
   define h where "h z = (if z = 0 then deriv f 0 else f z / z)" for z
   have d0: "deriv f 0 = h 0"
     by (simp add: h_def)
   moreover have "h holomorphic_on (ball 0 r)"
     by (rule pole_theorem_open_0 [OF holf, of 0]) (auto simp: h_def)
   moreover have "norm z < r \<Longrightarrow> f z = z * h z" for z
     by (simp add: h_def)
   ultimately show ?thesis
     using that by blast
 qed
 
 proposition Schwarz_Lemma:
   assumes holf: "f holomorphic_on (ball 0 1)" and [simp]: "f 0 = 0"
       and no: "\<And>z. norm z < 1 \<Longrightarrow> norm (f z) < 1"
       and \<xi>: "norm \<xi> < 1"
     shows "norm (f \<xi>) \<le> norm \<xi>" and "norm(deriv f 0) \<le> 1"
       and "((\<exists>z. norm z < 1 \<and> z \<noteq> 0 \<and> norm(f z) = norm z)
             \<or> norm(deriv f 0) = 1)
            \<Longrightarrow> \<exists>\<alpha>. (\<forall>z. norm z < 1 \<longrightarrow> f z = \<alpha> * z) \<and> norm \<alpha> = 1"
       (is "?P \<Longrightarrow> ?Q")
 proof -
   obtain h where holh: "h holomorphic_on (ball 0 1)"
              and fz_eq: "\<And>z. norm z < 1 \<Longrightarrow> f z = z * (h z)" and df0: "deriv f 0 = h 0"
     by (rule Schwarz3 [OF holf]) auto
   have noh_le: "norm (h z) \<le> 1" if z: "norm z < 1" for z
   proof -
     have "norm (h z) < a" if a: "1 < a" for a
     proof -
       have "max (inverse a) (norm z) < 1"
         using z a by (simp_all add: inverse_less_1_iff)
       then obtain r where r: "max (inverse a) (norm z) < r" and "r < 1"
         using Rats_dense_in_real by blast
       then have nzr: "norm z < r" and ira: "inverse r < a"
         using z a less_imp_inverse_less by force+
       then have "0 < r"
         by (meson norm_not_less_zero not_le order.strict_trans2)
       have holh': "h holomorphic_on ball 0 r"
         by (meson holh \<open>r < 1\<close> holomorphic_on_subset less_eq_real_def subset_ball)
       have conth': "continuous_on (cball 0 r) h"
         by (meson \<open>r < 1\<close> dual_order.trans holh holomorphic_on_imp_continuous_on holomorphic_on_subset mem_ball_0 mem_cball_0 not_less subsetI)
       obtain w where w: "norm w = r" and lenw: "\<And>z. norm z < r \<Longrightarrow> norm(h z) \<le> norm(h w)"
         apply (rule Schwarz1 [OF holh']) using conth' \<open>0 < r\<close> by auto
       have "h w = f w / w" using fz_eq \<open>r < 1\<close> nzr w by auto
       then have "cmod (h z) < inverse r"
         by (metis \<open>0 < r\<close> \<open>r < 1\<close> divide_strict_right_mono inverse_eq_divide
                   le_less_trans lenw no norm_divide nzr w)
       then show ?thesis using ira by linarith
     qed
     then show "norm (h z) \<le> 1"
       using not_le by blast
   qed
   show "cmod (f \<xi>) \<le> cmod \<xi>"
   proof (cases "\<xi> = 0")
     case True then show ?thesis by auto
   next
     case False
     then show ?thesis
       by (simp add: noh_le fz_eq \<xi> mult_left_le norm_mult)
   qed
   show no_df0: "norm(deriv f 0) \<le> 1"
     by (simp add: \<open>\<And>z. cmod z < 1 \<Longrightarrow> cmod (h z) \<le> 1\<close> df0)
   show "?Q" if "?P"
     using that
   proof
     assume "\<exists>z. cmod z < 1 \<and> z \<noteq> 0 \<and> cmod (f z) = cmod z"
     then obtain \<gamma> where \<gamma>: "cmod \<gamma> < 1" "\<gamma> \<noteq> 0" "cmod (f \<gamma>) = cmod \<gamma>" by blast
     then have [simp]: "norm (h \<gamma>) = 1"
       by (simp add: fz_eq norm_mult)
     have "ball \<gamma> (1 - cmod \<gamma>) \<subseteq> ball 0 1"
       by (simp add: ball_subset_ball_iff)
     moreover have "\<And>z. cmod (\<gamma> - z) < 1 - cmod \<gamma> \<Longrightarrow> cmod (h z) \<le> cmod (h \<gamma>)"
       apply (simp add: algebra_simps)
       by (metis add_diff_cancel_left' diff_diff_eq2 le_less_trans noh_le norm_triangle_ineq4)
     ultimately obtain c where c: "\<And>z. norm z < 1 \<Longrightarrow> h z = c"
       using Schwarz2 [OF holh, of "1 - norm \<gamma>" \<gamma>, unfolded constant_on_def] \<gamma> by auto
     then have "norm c = 1"
       using \<gamma> by force
     with c show ?thesis
       using fz_eq by auto
   next
     assume [simp]: "cmod (deriv f 0) = 1"
     then obtain c where c: "\<And>z. norm z < 1 \<Longrightarrow> h z = c"
       using Schwarz2 [OF holh zero_less_one, of 0, unfolded constant_on_def] df0 noh_le
       by auto
     moreover have "norm c = 1"  using df0 c by auto
     ultimately show ?thesis
       using fz_eq by auto
   qed
 qed
 
 corollary Schwarz_Lemma':
   assumes holf: "f holomorphic_on (ball 0 1)" and [simp]: "f 0 = 0"
       and no: "\<And>z. norm z < 1 \<Longrightarrow> norm (f z) < 1"
     shows "((\<forall>\<xi>. norm \<xi> < 1 \<longrightarrow> norm (f \<xi>) \<le> norm \<xi>)
             \<and> norm(deriv f 0) \<le> 1)
             \<and> (((\<exists>z. norm z < 1 \<and> z \<noteq> 0 \<and> norm(f z) = norm z)
               \<or> norm(deriv f 0) = 1)
               \<longrightarrow> (\<exists>\<alpha>. (\<forall>z. norm z < 1 \<longrightarrow> f z = \<alpha> * z) \<and> norm \<alpha> = 1))"
   using Schwarz_Lemma [OF assms]
   by (metis (no_types) norm_eq_zero zero_less_one)
 
 subsection\<open>The Schwarz reflection principle\<close>
 
 lemma hol_pal_lem0:
   assumes "d \<bullet> a \<le> k" "k \<le> d \<bullet> b"
   obtains c where
      "c \<in> closed_segment a b" "d \<bullet> c = k"
      "\<And>z. z \<in> closed_segment a c \<Longrightarrow> d \<bullet> z \<le> k"
      "\<And>z. z \<in> closed_segment c b \<Longrightarrow> k \<le> d \<bullet> z"
 proof -
   obtain c where cin: "c \<in> closed_segment a b" and keq: "k = d \<bullet> c"
     using connected_ivt_hyperplane [of "closed_segment a b" a b d k]
     by (auto simp: assms)
   have "closed_segment a c \<subseteq> {z. d \<bullet> z \<le> k}"  "closed_segment c b \<subseteq> {z. k \<le> d \<bullet> z}"
     unfolding segment_convex_hull using assms keq
     by (auto simp: convex_halfspace_le convex_halfspace_ge hull_minimal)
   then show ?thesis using cin that by fastforce
 qed
 
 lemma hol_pal_lem1:
   assumes "convex S" "open S"
       and abc: "a \<in> S" "b \<in> S" "c \<in> S"
           "d \<noteq> 0" and lek: "d \<bullet> a \<le> k" "d \<bullet> b \<le> k" "d \<bullet> c \<le> k"
       and holf1: "f holomorphic_on {z. z \<in> S \<and> d \<bullet> z < k}"
       and contf: "continuous_on S f"
     shows "contour_integral (linepath a b) f +
            contour_integral (linepath b c) f +
            contour_integral (linepath c a) f = 0"
 proof -
   have "interior (convex hull {a, b, c}) \<subseteq> interior(S \<inter> {x. d \<bullet> x \<le> k})"
     apply (rule interior_mono)
     apply (rule hull_minimal)
      apply (simp add: abc lek)
     apply (rule convex_Int [OF \<open>convex S\<close> convex_halfspace_le])
     done
   also have "... \<subseteq> {z \<in> S. d \<bullet> z < k}"
     by (force simp: interior_open [OF \<open>open S\<close>] \<open>d \<noteq> 0\<close>)
   finally have *: "interior (convex hull {a, b, c}) \<subseteq> {z \<in> S. d \<bullet> z < k}" .
   have "continuous_on (convex hull {a,b,c}) f"
     using \<open>convex S\<close> contf abc continuous_on_subset subset_hull
     by fastforce
   moreover have "f holomorphic_on interior (convex hull {a,b,c})"
     by (rule holomorphic_on_subset [OF holf1 *])
   ultimately show ?thesis
     using Cauchy_theorem_triangle_interior has_chain_integral_chain_integral3
       by blast
 qed
 
 lemma hol_pal_lem2:
   assumes S: "convex S" "open S"
       and abc: "a \<in> S" "b \<in> S" "c \<in> S"
       and "d \<noteq> 0" and lek: "d \<bullet> a \<le> k" "d \<bullet> b \<le> k"
       and holf1: "f holomorphic_on {z. z \<in> S \<and> d \<bullet> z < k}"
       and holf2: "f holomorphic_on {z. z \<in> S \<and> k < d \<bullet> z}"
       and contf: "continuous_on S f"
     shows "contour_integral (linepath a b) f +
            contour_integral (linepath b c) f +
            contour_integral (linepath c a) f = 0"
 proof (cases "d \<bullet> c \<le> k")
   case True show ?thesis
     by (rule hol_pal_lem1 [OF S abc \<open>d \<noteq> 0\<close> lek True holf1 contf])
 next
   case False
   then have "d \<bullet> c > k" by force
   obtain a' where a': "a' \<in> closed_segment b c" and "d \<bullet> a' = k"
      and ba': "\<And>z. z \<in> closed_segment b a' \<Longrightarrow> d \<bullet> z \<le> k"
      and a'c: "\<And>z. z \<in> closed_segment a' c \<Longrightarrow> k \<le> d \<bullet> z"
     apply (rule hol_pal_lem0 [of d b k c, OF \<open>d \<bullet> b \<le> k\<close>])
     using False by auto
   obtain b' where b': "b' \<in> closed_segment a c" and "d \<bullet> b' = k"
      and ab': "\<And>z. z \<in> closed_segment a b' \<Longrightarrow> d \<bullet> z \<le> k"
      and b'c: "\<And>z. z \<in> closed_segment b' c \<Longrightarrow> k \<le> d \<bullet> z"
     apply (rule hol_pal_lem0 [of d a k c, OF \<open>d \<bullet> a \<le> k\<close>])
     using False by auto
   have a'b': "a' \<in> S \<and> b' \<in> S"
     using a' abc b' convex_contains_segment \<open>convex S\<close> by auto
   have "continuous_on (closed_segment c a) f"
     by (meson abc contf continuous_on_subset convex_contains_segment \<open>convex S\<close>)
   then have 1: "contour_integral (linepath c a) f =
                 contour_integral (linepath c b') f + contour_integral (linepath b' a) f"
     apply (rule contour_integral_split_linepath)
     using b' by (simp add: closed_segment_commute)
   have "continuous_on (closed_segment b c) f"
     by (meson abc contf continuous_on_subset convex_contains_segment \<open>convex S\<close>)
   then have 2: "contour_integral (linepath b c) f =
                 contour_integral (linepath b a') f + contour_integral (linepath a' c) f"
     by (rule contour_integral_split_linepath [OF _ a'])
   have 3: "contour_integral (reversepath (linepath b' a')) f =
                 - contour_integral (linepath b' a') f"
     by (rule contour_integral_reversepath [OF valid_path_linepath])
   have fcd_le: "f field_differentiable at x"
                if "x \<in> interior S \<and> x \<in> interior {x. d \<bullet> x \<le> k}" for x
   proof -
     have "f holomorphic_on S \<inter> {c. d \<bullet> c < k}"
       by (metis (no_types) Collect_conj_eq Collect_mem_eq holf1)
     then have "\<exists>C D. x \<in> interior C \<inter> interior D \<and> f holomorphic_on interior C \<inter> interior D"
       using that
       by (metis Collect_mem_eq Int_Collect \<open>d \<noteq> 0\<close> interior_halfspace_le interior_open \<open>open S\<close>)
     then show "f field_differentiable at x"
       by (metis at_within_interior holomorphic_on_def interior_Int interior_interior)
   qed
   have ab_le: "\<And>x. x \<in> closed_segment a b \<Longrightarrow> d \<bullet> x \<le> k"
   proof -
     fix x :: complex
     assume "x \<in> closed_segment a b"
     then have "\<And>C. x \<in> C \<or> b \<notin> C \<or> a \<notin> C \<or> \<not> convex C"
       by (meson contra_subsetD convex_contains_segment)
     then show "d \<bullet> x \<le> k"
       by (metis lek convex_halfspace_le mem_Collect_eq)
   qed
   have "continuous_on (S \<inter> {x. d \<bullet> x \<le> k}) f" using contf
     by (simp add: continuous_on_subset)
   then have "(f has_contour_integral 0)
          (linepath a b +++ linepath b a' +++ linepath a' b' +++ linepath b' a)"
     apply (rule Cauchy_theorem_convex [where K = "{}"])
     apply (simp_all add: path_image_join convex_Int convex_halfspace_le \<open>convex S\<close> fcd_le ab_le
                 closed_segment_subset abc a'b' ba')
     by (metis \<open>d \<bullet> a' = k\<close> \<open>d \<bullet> b' = k\<close> convex_contains_segment convex_halfspace_le lek(1) mem_Collect_eq order_refl)
   then have 4: "contour_integral (linepath a b) f +
                 contour_integral (linepath b a') f +
                 contour_integral (linepath a' b') f +
                 contour_integral (linepath b' a) f = 0"
     by (rule has_chain_integral_chain_integral4)
   have fcd_ge: "f field_differentiable at x"
                if "x \<in> interior S \<and> x \<in> interior {x. k \<le> d \<bullet> x}" for x
   proof -
     have f2: "f holomorphic_on S \<inter> {c. k < d \<bullet> c}"
       by (metis (full_types) Collect_conj_eq Collect_mem_eq holf2)
     have f3: "interior S = S"
       by (simp add: interior_open \<open>open S\<close>)
     then have "x \<in> S \<inter> interior {c. k \<le> d \<bullet> c}"
       using that by simp
     then show "f field_differentiable at x"
       using f3 f2 unfolding holomorphic_on_def
       by (metis (no_types) \<open>d \<noteq> 0\<close> at_within_interior interior_Int interior_halfspace_ge interior_interior)
   qed
   have "continuous_on (S \<inter> {x. k \<le> d \<bullet> x}) f" using contf
     by (simp add: continuous_on_subset)
   then have "(f has_contour_integral 0) (linepath a' c +++ linepath c b' +++ linepath b' a')"
     apply (rule Cauchy_theorem_convex [where K = "{}"])
     apply (simp_all add: path_image_join convex_Int convex_halfspace_ge \<open>convex S\<close>
                       fcd_ge closed_segment_subset abc a'b' a'c)
     by (metis \<open>d \<bullet> a' = k\<close> b'c closed_segment_commute convex_contains_segment
               convex_halfspace_ge ends_in_segment(2) mem_Collect_eq order_refl)
   then have 5: "contour_integral (linepath a' c) f + contour_integral (linepath c b') f + contour_integral (linepath b' a') f = 0"
     by (rule has_chain_integral_chain_integral3)
   show ?thesis
     using 1 2 3 4 5 by (metis add.assoc eq_neg_iff_add_eq_0 reversepath_linepath)
 qed
 
 lemma hol_pal_lem3:
   assumes S: "convex S" "open S"
       and abc: "a \<in> S" "b \<in> S" "c \<in> S"
       and "d \<noteq> 0" and lek: "d \<bullet> a \<le> k"
       and holf1: "f holomorphic_on {z. z \<in> S \<and> d \<bullet> z < k}"
       and holf2: "f holomorphic_on {z. z \<in> S \<and> k < d \<bullet> z}"
       and contf: "continuous_on S f"
     shows "contour_integral (linepath a b) f +
            contour_integral (linepath b c) f +
            contour_integral (linepath c a) f = 0"
 proof (cases "d \<bullet> b \<le> k")
   case True show ?thesis
     by (rule hol_pal_lem2 [OF S abc \<open>d \<noteq> 0\<close> lek True holf1 holf2 contf])
 next
   case False
   show ?thesis
   proof (cases "d \<bullet> c \<le> k")
     case True
     have "contour_integral (linepath c a) f +
           contour_integral (linepath a b) f +
           contour_integral (linepath b c) f = 0"
       by (rule hol_pal_lem2 [OF S \<open>c \<in> S\<close> \<open>a \<in> S\<close> \<open>b \<in> S\<close> \<open>d \<noteq> 0\<close> \<open>d \<bullet> c \<le> k\<close> lek holf1 holf2 contf])
     then show ?thesis
       by (simp add: algebra_simps)
   next
     case False
     have "contour_integral (linepath b c) f +
           contour_integral (linepath c a) f +
           contour_integral (linepath a b) f = 0"
       apply (rule hol_pal_lem2 [OF S \<open>b \<in> S\<close> \<open>c \<in> S\<close> \<open>a \<in> S\<close>, of "-d" "-k"])
       using \<open>d \<noteq> 0\<close> \<open>\<not> d \<bullet> b \<le> k\<close> False by (simp_all add: holf1 holf2 contf)
     then show ?thesis
       by (simp add: algebra_simps)
   qed
 qed
 
 lemma hol_pal_lem4:
   assumes S: "convex S" "open S"
       and abc: "a \<in> S" "b \<in> S" "c \<in> S" and "d \<noteq> 0"
       and holf1: "f holomorphic_on {z. z \<in> S \<and> d \<bullet> z < k}"
       and holf2: "f holomorphic_on {z. z \<in> S \<and> k < d \<bullet> z}"
       and contf: "continuous_on S f"
     shows "contour_integral (linepath a b) f +
            contour_integral (linepath b c) f +
            contour_integral (linepath c a) f = 0"
 proof (cases "d \<bullet> a \<le> k")
   case True show ?thesis
     by (rule hol_pal_lem3 [OF S abc \<open>d \<noteq> 0\<close> True holf1 holf2 contf])
 next
   case False
   show ?thesis
     apply (rule hol_pal_lem3 [OF S abc, of "-d" "-k"])
     using \<open>d \<noteq> 0\<close> False by (simp_all add: holf1 holf2 contf)
 qed
 
 lemma holomorphic_on_paste_across_line:
   assumes S: "open S" and "d \<noteq> 0"
       and holf1: "f holomorphic_on (S \<inter> {z. d \<bullet> z < k})"
       and holf2: "f holomorphic_on (S \<inter> {z. k < d \<bullet> z})"
       and contf: "continuous_on S f"
     shows "f holomorphic_on S"
 proof -
   have *: "\<exists>t. open t \<and> p \<in> t \<and> continuous_on t f \<and>
                (\<forall>a b c. convex hull {a, b, c} \<subseteq> t \<longrightarrow>
                          contour_integral (linepath a b) f +
                          contour_integral (linepath b c) f +
                          contour_integral (linepath c a) f = 0)"
           if "p \<in> S" for p
   proof -
     obtain e where "e>0" and e: "ball p e \<subseteq> S"
       using \<open>p \<in> S\<close> openE S by blast
     then have "continuous_on (ball p e) f"
       using contf continuous_on_subset by blast
     moreover have "f holomorphic_on {z. dist p z < e \<and> d \<bullet> z < k}"
       apply (rule holomorphic_on_subset [OF holf1])
       using e by auto
     moreover have "f holomorphic_on {z. dist p z < e \<and> k < d \<bullet> z}"
       apply (rule holomorphic_on_subset [OF holf2])
       using e by auto
     ultimately show ?thesis
       apply (rule_tac x="ball p e" in exI)
       using \<open>e > 0\<close> e \<open>d \<noteq> 0\<close>
       apply (simp add:, clarify)
       apply (rule hol_pal_lem4 [of "ball p e" _ _ _ d _ k])
       apply (auto simp: subset_hull)
       done
   qed
   show ?thesis
     by (blast intro: * Morera_local_triangle analytic_imp_holomorphic)
 qed
 
 proposition Schwarz_reflection:
   assumes "open S" and cnjs: "cnj ` S \<subseteq> S"
       and  holf: "f holomorphic_on (S \<inter> {z. 0 < Im z})"
       and contf: "continuous_on (S \<inter> {z. 0 \<le> Im z}) f"
       and f: "\<And>z. \<lbrakk>z \<in> S; z \<in> \<real>\<rbrakk> \<Longrightarrow> (f z) \<in> \<real>"
     shows "(\<lambda>z. if 0 \<le> Im z then f z else cnj(f(cnj z))) holomorphic_on S"
 proof -
   have 1: "(\<lambda>z. if 0 \<le> Im z then f z else cnj (f (cnj z))) holomorphic_on (S \<inter> {z. 0 < Im z})"
     by (force intro: iffD1 [OF holomorphic_cong [OF refl] holf])
   have cont_cfc: "continuous_on (S \<inter> {z. Im z \<le> 0}) (cnj o f o cnj)"
     apply (intro continuous_intros continuous_on_compose continuous_on_subset [OF contf])
     using cnjs apply auto
     done
   have "cnj \<circ> f \<circ> cnj field_differentiable at x within S \<inter> {z. Im z < 0}"
         if "x \<in> S" "Im x < 0" "f field_differentiable at (cnj x) within S \<inter> {z. 0 < Im z}" for x
     using that
     apply (simp add: field_differentiable_def has_field_derivative_iff Lim_within dist_norm, clarify)
     apply (rule_tac x="cnj f'" in exI)
     apply (elim all_forward ex_forward conj_forward imp_forward asm_rl, clarify)
     apply (drule_tac x="cnj xa" in bspec)
     using cnjs apply force
     apply (metis complex_cnj_cnj complex_cnj_diff complex_cnj_divide complex_mod_cnj)
     done
   then have hol_cfc: "(cnj o f o cnj) holomorphic_on (S \<inter> {z. Im z < 0})"
     using holf cnjs
     by (force simp: holomorphic_on_def)
   have 2: "(\<lambda>z. if 0 \<le> Im z then f z else cnj (f (cnj z))) holomorphic_on (S \<inter> {z. Im z < 0})"
     apply (rule iffD1 [OF holomorphic_cong [OF refl]])
     using hol_cfc by auto
   have [simp]: "(S \<inter> {z. 0 \<le> Im z}) \<union> (S \<inter> {z. Im z \<le> 0}) = S"
     by force
   have "continuous_on ((S \<inter> {z. 0 \<le> Im z}) \<union> (S \<inter> {z. Im z \<le> 0}))
                        (\<lambda>z. if 0 \<le> Im z then f z else cnj (f (cnj z)))"
     apply (rule continuous_on_cases_local)
     using cont_cfc contf
     apply (simp_all add: closedin_closed_Int closed_halfspace_Im_le closed_halfspace_Im_ge)
     using f Reals_cnj_iff complex_is_Real_iff apply auto
     done
   then have 3: "continuous_on S (\<lambda>z. if 0 \<le> Im z then f z else cnj (f (cnj z)))"
     by force
   show ?thesis
     apply (rule holomorphic_on_paste_across_line [OF \<open>open S\<close>, of "- \<i>" _ 0])
     using 1 2 3
     apply auto
     done
 qed
 
 subsection\<open>Bloch's theorem\<close>
 
 lemma Bloch_lemma_0:
   assumes holf: "f holomorphic_on cball 0 r" and "0 < r"
       and [simp]: "f 0 = 0"
       and le: "\<And>z. norm z < r \<Longrightarrow> norm(deriv f z) \<le> 2 * norm(deriv f 0)"
     shows "ball 0 ((3 - 2 * sqrt 2) * r * norm(deriv f 0)) \<subseteq> f ` ball 0 r"
 proof -
   have "sqrt 2 < 3/2"
     by (rule real_less_lsqrt) (auto simp: power2_eq_square)
   then have sq3: "0 < 3 - 2 * sqrt 2" by simp
   show ?thesis
   proof (cases "deriv f 0 = 0")
     case True then show ?thesis by simp
   next
     case False
     define C where "C = 2 * norm(deriv f 0)"
     have "0 < C" using False by (simp add: C_def)
     have holf': "f holomorphic_on ball 0 r" using holf
       using ball_subset_cball holomorphic_on_subset by blast
     then have holdf': "deriv f holomorphic_on ball 0 r"
       by (rule holomorphic_deriv [OF _ open_ball])
     have "Le1": "norm(deriv f z - deriv f 0) \<le> norm z / (r - norm z) * C"
                 if "norm z < r" for z
     proof -
       have T1: "norm(deriv f z - deriv f 0) \<le> norm z / (R - norm z) * C"
               if R: "norm z < R" "R < r" for R
       proof -
         have "0 < R" using R
           by (metis less_trans norm_zero zero_less_norm_iff)
         have df_le: "\<And>x. norm x < r \<Longrightarrow> norm (deriv f x) \<le> C"
           using le by (simp add: C_def)
         have hol_df: "deriv f holomorphic_on cball 0 R"
           apply (rule holomorphic_on_subset) using R holdf' by auto
         have *: "((\<lambda>w. deriv f w / (w - z)) has_contour_integral 2 * pi * \<i> * deriv f z) (circlepath 0 R)"
                  if "norm z < R" for z
           using \<open>0 < R\<close> that Cauchy_integral_formula_convex_simple [OF convex_cball hol_df, of _ "circlepath 0 R"]
           by (force simp: winding_number_circlepath)
         have **: "((\<lambda>x. deriv f x / (x - z) - deriv f x / x) has_contour_integral
                    of_real (2 * pi) * \<i> * (deriv f z - deriv f 0))
                   (circlepath 0 R)"
            using has_contour_integral_diff [OF * [of z] * [of 0]] \<open>0 < R\<close> that
            by (simp add: algebra_simps)
         have [simp]: "\<And>x. norm x = R \<Longrightarrow> x \<noteq> z"  using that(1) by blast
         have "norm (deriv f x / (x - z) - deriv f x / x)
                      \<le> C * norm z / (R * (R - norm z))"
                   if "norm x = R" for x
         proof -
           have [simp]: "norm (deriv f x * x - deriv f x * (x - z)) =
                         norm (deriv f x) * norm z"
             by (simp add: norm_mult right_diff_distrib')
           show ?thesis
             using  \<open>0 < R\<close> \<open>0 < C\<close> R that
             apply (simp add: norm_mult norm_divide divide_simps)
             using df_le norm_triangle_ineq2 \<open>0 < C\<close> apply (auto intro!: mult_mono)
             done
         qed
         then show ?thesis
           using has_contour_integral_bound_circlepath
                   [OF **, of "C * norm z/(R*(R - norm z))"]
                 \<open>0 < R\<close> \<open>0 < C\<close> R
           apply (simp add: norm_mult norm_divide)
           apply (simp add: divide_simps mult.commute)
           done
       qed
       obtain r' where r': "norm z < r'" "r' < r"
         using Rats_dense_in_real [of "norm z" r] \<open>norm z < r\<close> by blast
       then have [simp]: "closure {r'<..<r} = {r'..r}" by simp
       show ?thesis
         apply (rule continuous_ge_on_closure
                  [where f = "\<lambda>r. norm z / (r - norm z) * C" and s = "{r'<..<r}",
                   OF _ _ T1])
         apply (intro continuous_intros)
         using that r'
         apply (auto simp: not_le)
         done
     qed
     have "*": "(norm z - norm z^2/(r - norm z)) * norm(deriv f 0) \<le> norm(f z)"
               if r: "norm z < r" for z
     proof -
       have 1: "\<And>x. x \<in> ball 0 r \<Longrightarrow>
               ((\<lambda>z. f z - deriv f 0 * z) has_field_derivative deriv f x - deriv f 0)
                (at x within ball 0 r)"
         by (rule derivative_eq_intros holomorphic_derivI holf' | simp)+
       have 2: "closed_segment 0 z \<subseteq> ball 0 r"
         by (metis \<open>0 < r\<close> convex_ball convex_contains_segment dist_self mem_ball mem_ball_0 that)
       have 3: "(\<lambda>t. (norm z)\<^sup>2 * t / (r - norm z) * C) integrable_on {0..1}"
         apply (rule integrable_on_cmult_right [where 'b=real, simplified])
         apply (rule integrable_on_cdivide [where 'b=real, simplified])
         apply (rule integrable_on_cmult_left [where 'b=real, simplified])
         apply (rule ident_integrable_on)
         done
       have 4: "norm (deriv f (x *\<^sub>R z) - deriv f 0) * norm z \<le> norm z * norm z * x * C / (r - norm z)"
               if x: "0 \<le> x" "x \<le> 1" for x
       proof -
         have [simp]: "x * norm z < r"
           using r x by (meson le_less_trans mult_le_cancel_right2 norm_not_less_zero)
         have "norm (deriv f (x *\<^sub>R z) - deriv f 0) \<le> norm (x *\<^sub>R z) / (r - norm (x *\<^sub>R z)) * C"
           apply (rule Le1) using r x \<open>0 < r\<close> by simp
         also have "... \<le> norm (x *\<^sub>R z) / (r - norm z) * C"
           using r x \<open>0 < r\<close>
           apply (simp add: field_split_simps)
           by (simp add: \<open>0 < C\<close> mult.assoc mult_left_le_one_le ordered_comm_semiring_class.comm_mult_left_mono)
         finally have "norm (deriv f (x *\<^sub>R z) - deriv f 0) * norm z \<le> norm (x *\<^sub>R z)  / (r - norm z) * C * norm z"
           by (rule mult_right_mono) simp
         with x show ?thesis by (simp add: algebra_simps)
       qed
       have le_norm: "abc \<le> norm d - e \<Longrightarrow> norm(f - d) \<le> e \<Longrightarrow> abc \<le> norm f" for abc d e and f::complex
         by (metis add_diff_cancel_left' add_diff_eq diff_left_mono norm_diff_ineq order_trans)
       have "norm (integral {0..1} (\<lambda>x. (deriv f (x *\<^sub>R z) - deriv f 0) * z))
             \<le> integral {0..1} (\<lambda>t. (norm z)\<^sup>2 * t / (r - norm z) * C)"
         apply (rule integral_norm_bound_integral)
         using contour_integral_primitive [OF 1, of "linepath 0 z"] 2
         apply (simp add: has_contour_integral_linepath has_integral_integrable_integral)
         apply (rule 3)
         apply (simp add: norm_mult power2_eq_square 4)
         done
       then have int_le: "norm (f z - deriv f 0 * z) \<le> (norm z)\<^sup>2 * norm(deriv f 0) / ((r - norm z))"
         using contour_integral_primitive [OF 1, of "linepath 0 z"] 2
         apply (simp add: has_contour_integral_linepath has_integral_integrable_integral C_def)
         done
       show ?thesis
         apply (rule le_norm [OF _ int_le])
         using \<open>norm z < r\<close>
         apply (simp add: power2_eq_square divide_simps C_def norm_mult)
         proof -
           have "norm z * (norm (deriv f 0) * (r - norm z - norm z)) \<le> norm z * (norm (deriv f 0) * (r - norm z) - norm (deriv f 0) * norm z)"
             by (simp add: algebra_simps)
           then show "(norm z * (r - norm z) - norm z * norm z) * norm (deriv f 0) \<le> norm (deriv f 0) * norm z * (r - norm z) - norm z * norm z * norm (deriv f 0)"
             by (simp add: algebra_simps)
         qed
     qed
     have sq201 [simp]: "0 < (1 - sqrt 2 / 2)" "(1 - sqrt 2 / 2)  < 1"
       by (auto simp:  sqrt2_less_2)
     have 1: "continuous_on (closure (ball 0 ((1 - sqrt 2 / 2) * r))) f"
       apply (rule continuous_on_subset [OF holomorphic_on_imp_continuous_on [OF holf]])
       apply (subst closure_ball)
       using \<open>0 < r\<close> mult_pos_pos sq201
       apply (auto simp: cball_subset_cball_iff)
       done
     have 2: "open (f ` interior (ball 0 ((1 - sqrt 2 / 2) * r)))"
       apply (rule open_mapping_thm [OF holf' open_ball connected_ball], force)
       using \<open>0 < r\<close> mult_pos_pos sq201 apply (simp add: ball_subset_ball_iff)
       using False \<open>0 < r\<close> centre_in_ball holf' holomorphic_nonconstant by blast
     have "ball 0 ((3 - 2 * sqrt 2) * r * norm (deriv f 0)) =
           ball (f 0) ((3 - 2 * sqrt 2) * r * norm (deriv f 0))"
       by simp
     also have "...  \<subseteq> f ` ball 0 ((1 - sqrt 2 / 2) * r)"
     proof -
       have 3: "(3 - 2 * sqrt 2) * r * norm (deriv f 0) \<le> norm (f z)"
            if "norm z = (1 - sqrt 2 / 2) * r" for z
         apply (rule order_trans [OF _ *])
         using  \<open>0 < r\<close>
         apply (simp_all add: field_simps  power2_eq_square that)
         apply (simp add: mult.assoc [symmetric])
         done
       show ?thesis
         apply (rule ball_subset_open_map_image [OF 1 2 _ bounded_ball])
         using \<open>0 < r\<close> sq201 3 apply simp_all
         using C_def \<open>0 < C\<close> sq3 apply force
         done
      qed
     also have "...  \<subseteq> f ` ball 0 r"
       apply (rule image_subsetI [OF imageI], simp)
       apply (erule less_le_trans)
       using \<open>0 < r\<close> apply (auto simp: field_simps)
       done
     finally show ?thesis .
   qed
 qed
 
 lemma Bloch_lemma:
   assumes holf: "f holomorphic_on cball a r" and "0 < r"
       and le: "\<And>z. z \<in> ball a r \<Longrightarrow> norm(deriv f z) \<le> 2 * norm(deriv f a)"
     shows "ball (f a) ((3 - 2 * sqrt 2) * r * norm(deriv f a)) \<subseteq> f ` ball a r"
 proof -
   have fz: "(\<lambda>z. f (a + z)) = f o (\<lambda>z. (a + z))"
     by (simp add: o_def)
   have hol0: "(\<lambda>z. f (a + z)) holomorphic_on cball 0 r"
     unfolding fz by (intro holomorphic_intros holf holomorphic_on_compose | simp)+
   then have [simp]: "\<And>x. norm x < r \<Longrightarrow> (\<lambda>z. f (a + z)) field_differentiable at x"
     by (metis open_ball at_within_open ball_subset_cball diff_0 dist_norm holomorphic_on_def holomorphic_on_subset mem_ball norm_minus_cancel)
   have [simp]: "\<And>z. norm z < r \<Longrightarrow> f field_differentiable at (a + z)"
     by (metis holf open_ball add_diff_cancel_left' dist_complex_def holomorphic_on_imp_differentiable_at holomorphic_on_subset interior_cball interior_subset mem_ball norm_minus_commute)
   then have [simp]: "f field_differentiable at a"
     by (metis add.comm_neutral \<open>0 < r\<close> norm_eq_zero)
   have hol1: "(\<lambda>z. f (a + z) - f a) holomorphic_on cball 0 r"
     by (intro holomorphic_intros hol0)
   then have "ball 0 ((3 - 2 * sqrt 2) * r * norm (deriv (\<lambda>z. f (a + z) - f a) 0))
              \<subseteq> (\<lambda>z. f (a + z) - f a) ` ball 0 r"
     apply (rule Bloch_lemma_0)
     apply (simp_all add: \<open>0 < r\<close>)
     apply (simp add: fz complex_derivative_chain)
     apply (simp add: dist_norm le)
     done
   then show ?thesis
     apply clarify
     apply (drule_tac c="x - f a" in subsetD)
      apply (force simp: fz \<open>0 < r\<close> dist_norm complex_derivative_chain field_differentiable_compose)+
     done
 qed
 
 proposition Bloch_unit:
   assumes holf: "f holomorphic_on ball a 1" and [simp]: "deriv f a = 1"
   obtains b r where "1/12 < r" and "ball b r \<subseteq> f ` (ball a 1)"
 proof -
   define r :: real where "r = 249/256"
   have "0 < r" "r < 1" by (auto simp: r_def)
   define g where "g z = deriv f z * of_real(r - norm(z - a))" for z
   have "deriv f holomorphic_on ball a 1"
     by (rule holomorphic_deriv [OF holf open_ball])
   then have "continuous_on (ball a 1) (deriv f)"
     using holomorphic_on_imp_continuous_on by blast
   then have "continuous_on (cball a r) (deriv f)"
     by (rule continuous_on_subset) (simp add: cball_subset_ball_iff \<open>r < 1\<close>)
   then have "continuous_on (cball a r) g"
     by (simp add: g_def continuous_intros)
   then have 1: "compact (g ` cball a r)"
     by (rule compact_continuous_image [OF _ compact_cball])
   have 2: "g ` cball a r \<noteq> {}"
     using \<open>r > 0\<close> by auto
   obtain p where pr: "p \<in> cball a r"
              and pge: "\<And>y. y \<in> cball a r \<Longrightarrow> norm (g y) \<le> norm (g p)"
     using distance_attains_sup [OF 1 2, of 0] by force
   define t where "t = (r - norm(p - a)) / 2"
   have "norm (p - a) \<noteq> r"
     using pge [of a] \<open>r > 0\<close> by (auto simp: g_def norm_mult)
   then have "norm (p - a) < r" using pr
     by (simp add: norm_minus_commute dist_norm)
   then have "0 < t"
     by (simp add: t_def)
   have cpt: "cball p t \<subseteq> ball a r"
     using \<open>0 < t\<close> by (simp add: cball_subset_ball_iff dist_norm t_def field_simps)
   have gen_le_dfp: "norm (deriv f y) * (r - norm (y - a)) / (r - norm (p - a)) \<le> norm (deriv f p)"
             if "y \<in> cball a r" for y
   proof -
     have [simp]: "norm (y - a) \<le> r"
       using that by (simp add: dist_norm norm_minus_commute)
     have "norm (g y) \<le> norm (g p)"
       using pge [OF that] by simp
     then have "norm (deriv f y) * abs (r - norm (y - a)) \<le> norm (deriv f p) * abs (r - norm (p - a))"
       by (simp only: dist_norm g_def norm_mult norm_of_real)
     with that \<open>norm (p - a) < r\<close> show ?thesis
       by (simp add: dist_norm field_split_simps)
   qed
   have le_norm_dfp: "r / (r - norm (p - a)) \<le> norm (deriv f p)"
     using gen_le_dfp [of a] \<open>r > 0\<close> by auto
   have 1: "f holomorphic_on cball p t"
     apply (rule holomorphic_on_subset [OF holf])
     using cpt \<open>r < 1\<close> order_subst1 subset_ball by auto
   have 2: "norm (deriv f z) \<le> 2 * norm (deriv f p)" if "z \<in> ball p t" for z
   proof -
     have z: "z \<in> cball a r"
       by (meson ball_subset_cball subsetD cpt that)
     then have "norm(z - a) < r"
       by (metis ball_subset_cball contra_subsetD cpt dist_norm mem_ball norm_minus_commute that)
     have "norm (deriv f z) * (r - norm (z - a)) / (r - norm (p - a)) \<le> norm (deriv f p)"
       using gen_le_dfp [OF z] by simp
     with \<open>norm (z - a) < r\<close> \<open>norm (p - a) < r\<close>
     have "norm (deriv f z) \<le> (r - norm (p - a)) / (r - norm (z - a)) * norm (deriv f p)"
        by (simp add: field_simps)
     also have "... \<le> 2 * norm (deriv f p)"
       apply (rule mult_right_mono)
       using that \<open>norm (p - a) < r\<close> \<open>norm(z - a) < r\<close>
       apply (simp_all add: field_simps t_def dist_norm [symmetric])
       using dist_triangle3 [of z a p] by linarith
     finally show ?thesis .
   qed
   have sqrt2: "sqrt 2 < 2113/1494"
     by (rule real_less_lsqrt) (auto simp: power2_eq_square)
   then have sq3: "0 < 3 - 2 * sqrt 2" by simp
   have "1 / 12 / ((3 - 2 * sqrt 2) / 2) < r"
     using sq3 sqrt2 by (auto simp: field_simps r_def)
   also have "... \<le> cmod (deriv f p) * (r - cmod (p - a))"
     using \<open>norm (p - a) < r\<close> le_norm_dfp   by (simp add: pos_divide_le_eq)
   finally have "1 / 12 < cmod (deriv f p) * (r - cmod (p - a)) * ((3 - 2 * sqrt 2) / 2)"
     using pos_divide_less_eq half_gt_zero_iff sq3 by blast
   then have **: "1 / 12 < (3 - 2 * sqrt 2) * t * norm (deriv f p)"
     using sq3 by (simp add: mult.commute t_def)
   have "ball (f p) ((3 - 2 * sqrt 2) * t * norm (deriv f p)) \<subseteq> f ` ball p t"
     by (rule Bloch_lemma [OF 1 \<open>0 < t\<close> 2])
   also have "... \<subseteq> f ` ball a 1"
     apply (rule image_mono)
     apply (rule order_trans [OF ball_subset_cball])
     apply (rule order_trans [OF cpt])
     using \<open>0 < t\<close> \<open>r < 1\<close> apply (simp add: ball_subset_ball_iff dist_norm)
     done
   finally have "ball (f p) ((3 - 2 * sqrt 2) * t * norm (deriv f p)) \<subseteq> f ` ball a 1" .
   with ** show ?thesis
     by (rule that)
 qed
 
 theorem Bloch:
   assumes holf: "f holomorphic_on ball a r" and "0 < r"
       and r': "r' \<le> r * norm (deriv f a) / 12"
   obtains b where "ball b r' \<subseteq> f ` (ball a r)"
 proof (cases "deriv f a = 0")
   case True with r' show ?thesis
     using ball_eq_empty that by fastforce
 next
   case False
   define C where "C = deriv f a"
   have "0 < norm C" using False by (simp add: C_def)
   have dfa: "f field_differentiable at a"
     apply (rule holomorphic_on_imp_differentiable_at [OF holf])
     using \<open>0 < r\<close> by auto
   have fo: "(\<lambda>z. f (a + of_real r * z)) = f o (\<lambda>z. (a + of_real r * z))"
     by (simp add: o_def)
   have holf': "f holomorphic_on (\<lambda>z. a + complex_of_real r * z) ` ball 0 1"
     apply (rule holomorphic_on_subset [OF holf])
     using \<open>0 < r\<close> apply (force simp: dist_norm norm_mult)
     done
   have 1: "(\<lambda>z. f (a + r * z) / (C * r)) holomorphic_on ball 0 1"
     apply (rule holomorphic_intros holomorphic_on_compose holf' | simp add: fo)+
     using \<open>0 < r\<close> by (simp add: C_def False)
   have "((\<lambda>z. f (a + of_real r * z) / (C * of_real r)) has_field_derivative
         (deriv f (a + of_real r * z) / C)) (at z)"
        if "norm z < 1" for z
   proof -
     have *: "((\<lambda>x. f (a + of_real r * x)) has_field_derivative
            (deriv f (a + of_real r * z) * of_real r)) (at z)"
       apply (simp add: fo)
       apply (rule DERIV_chain [OF field_differentiable_derivI])
       apply (rule holomorphic_on_imp_differentiable_at [OF holf], simp)
       using \<open>0 < r\<close> apply (simp add: dist_norm norm_mult that)
       apply (rule derivative_eq_intros | simp)+
       done
     show ?thesis
       apply (rule derivative_eq_intros * | simp)+
       using \<open>0 < r\<close> by (auto simp: C_def False)
   qed
   have 2: "deriv (\<lambda>z. f (a + of_real r * z) / (C * of_real r)) 0 = 1"
     apply (subst deriv_cdivide_right)
     apply (simp add: field_differentiable_def fo)
     apply (rule exI)
     apply (rule DERIV_chain [OF field_differentiable_derivI])
     apply (simp add: dfa)
     apply (rule derivative_eq_intros | simp add: C_def False fo)+
     using \<open>0 < r\<close>
     apply (simp add: C_def False fo)
     apply (simp add: derivative_intros dfa complex_derivative_chain)
     done
   have sb1: "(*) (C * r) ` (\<lambda>z. f (a + of_real r * z) / (C * r)) ` ball 0 1
              \<subseteq> f ` ball a r"
     using \<open>0 < r\<close> by (auto simp: dist_norm norm_mult C_def False)
   have sb2: "ball (C * r * b) r' \<subseteq> (*) (C * r) ` ball b t"
              if "1 / 12 < t" for b t
   proof -
     have *: "r * cmod (deriv f a) / 12 \<le> r * (t * cmod (deriv f a))"
       using that \<open>0 < r\<close> less_eq_real_def mult.commute mult.right_neutral mult_left_mono norm_ge_zero times_divide_eq_right
       by auto
     show ?thesis
       apply clarify
       apply (rule_tac x="x / (C * r)" in image_eqI)
       using \<open>0 < r\<close>
       apply (simp_all add: dist_norm norm_mult norm_divide C_def False field_simps)
       apply (erule less_le_trans)
       apply (rule order_trans [OF r' *])
       done
   qed
   show ?thesis
     apply (rule Bloch_unit [OF 1 2])
     apply (rename_tac t)
     apply (rule_tac b="(C * of_real r) * b" in that)
     apply (drule image_mono [where f = "\<lambda>z. (C * of_real r) * z"])
     using sb1 sb2
     apply force
     done
 qed
 
 corollary Bloch_general:
   assumes holf: "f holomorphic_on s" and "a \<in> s"
       and tle: "\<And>z. z \<in> frontier s \<Longrightarrow> t \<le> dist a z"
       and rle: "r \<le> t * norm(deriv f a) / 12"
   obtains b where "ball b r \<subseteq> f ` s"
 proof -
   consider "r \<le> 0" | "0 < t * norm(deriv f a) / 12" using rle by force
   then show ?thesis
   proof cases
     case 1 then show ?thesis
       by (simp add: ball_empty that)
   next
     case 2
     show ?thesis
     proof (cases "deriv f a = 0")
       case True then show ?thesis
         using rle by (simp add: ball_empty that)
     next
       case False
       then have "t > 0"
         using 2 by (force simp: zero_less_mult_iff)
       have "\<not> ball a t \<subseteq> s \<Longrightarrow> ball a t \<inter> frontier s \<noteq> {}"
         apply (rule connected_Int_frontier [of "ball a t" s], simp_all)
         using \<open>0 < t\<close> \<open>a \<in> s\<close> centre_in_ball apply blast
         done
       with tle have *: "ball a t \<subseteq> s" by fastforce
       then have 1: "f holomorphic_on ball a t"
         using holf using holomorphic_on_subset by blast
       show ?thesis
         apply (rule Bloch [OF 1 \<open>t > 0\<close> rle])
         apply (rule_tac b=b in that)
         using * apply force
         done
     qed
   qed
 qed
 
 subsection \<open>Cauchy's residue theorem\<close>
 
 text\<open>Wenda Li and LC Paulson (2016). A Formal Proof of Cauchy's Residue Theorem.
     Interactive Theorem Proving\<close>
 
 definition\<^marker>\<open>tag important\<close> residue :: "(complex \<Rightarrow> complex) \<Rightarrow> complex \<Rightarrow> complex" where
   "residue f z = (SOME int. \<exists>e>0. \<forall>\<epsilon>>0. \<epsilon><e
     \<longrightarrow> (f has_contour_integral 2*pi* \<i> *int) (circlepath z \<epsilon>))"
 
 lemma Eps_cong:
   assumes "\<And>x. P x = Q x"
   shows   "Eps P = Eps Q"
   using ext[of P Q, OF assms] by simp
 
 lemma residue_cong:
   assumes eq: "eventually (\<lambda>z. f z = g z) (at z)" and "z = z'"
   shows   "residue f z = residue g z'"
 proof -
   from assms have eq': "eventually (\<lambda>z. g z = f z) (at z)"
     by (simp add: eq_commute)
   let ?P = "\<lambda>f c e. (\<forall>\<epsilon>>0. \<epsilon> < e \<longrightarrow>
    (f has_contour_integral of_real (2 * pi) * \<i> * c) (circlepath z \<epsilon>))"
   have "residue f z = residue g z" unfolding residue_def
   proof (rule Eps_cong)
     fix c :: complex
     have "\<exists>e>0. ?P g c e"
       if "\<exists>e>0. ?P f c e" and "eventually (\<lambda>z. f z = g z) (at z)" for f g
     proof -
       from that(1) obtain e where e: "e > 0" "?P f c e"
         by blast
       from that(2) obtain e' where e': "e' > 0" "\<And>z'. z' \<noteq> z \<Longrightarrow> dist z' z < e' \<Longrightarrow> f z' = g z'"
         unfolding eventually_at by blast
       have "?P g c (min e e')"
       proof (intro allI exI impI, goal_cases)
         case (1 \<epsilon>)
         hence "(f has_contour_integral of_real (2 * pi) * \<i> * c) (circlepath z \<epsilon>)"
           using e(2) by auto
         thus ?case
         proof (rule has_contour_integral_eq)
           fix z' assume "z' \<in> path_image (circlepath z \<epsilon>)"
           hence "dist z' z < e'" and "z' \<noteq> z"
             using 1 by (auto simp: dist_commute)
           with e'(2)[of z'] show "f z' = g z'" by simp
         qed
       qed
       moreover from e and e' have "min e e' > 0" by auto
       ultimately show ?thesis by blast
     qed
     from this[OF _ eq] and this[OF _ eq']
       show "(\<exists>e>0. ?P f c e) \<longleftrightarrow> (\<exists>e>0. ?P g c e)"
       by blast
   qed
   with assms show ?thesis by simp
 qed
 
 lemma contour_integral_circlepath_eq:
   assumes "open s" and f_holo:"f holomorphic_on (s-{z})" and "0<e1" "e1\<le>e2"
     and e2_cball:"cball z e2 \<subseteq> s"
   shows
     "f contour_integrable_on circlepath z e1"
     "f contour_integrable_on circlepath z e2"
     "contour_integral (circlepath z e2) f = contour_integral (circlepath z e1) f"
 proof -
   define l where "l \<equiv> linepath (z+e2) (z+e1)"
   have [simp]:"valid_path l" "pathstart l=z+e2" "pathfinish l=z+e1" unfolding l_def by auto
   have "e2>0" using \<open>e1>0\<close> \<open>e1\<le>e2\<close> by auto
   have zl_img:"z\<notin>path_image l"
     proof
       assume "z \<in> path_image l"
       then have "e2 \<le> cmod (e2 - e1)"
         using segment_furthest_le[of z "z+e2" "z+e1" "z+e2",simplified] \<open>e1>0\<close> \<open>e2>0\<close> unfolding l_def
         by (auto simp add:closed_segment_commute)
       thus False using \<open>e2>0\<close> \<open>e1>0\<close> \<open>e1\<le>e2\<close>
         apply (subst (asm) norm_of_real)
         by auto
     qed
   define g where "g \<equiv> circlepath z e2 +++ l +++ reversepath (circlepath z e1) +++ reversepath l"
   show [simp]: "f contour_integrable_on circlepath z e2" "f contour_integrable_on (circlepath z e1)"
     proof -
       show "f contour_integrable_on circlepath z e2"
         apply (intro contour_integrable_continuous_circlepath[OF
                 continuous_on_subset[OF holomorphic_on_imp_continuous_on[OF f_holo]]])
         using \<open>e2>0\<close> e2_cball by auto
       show "f contour_integrable_on (circlepath z e1)"
         apply (intro contour_integrable_continuous_circlepath[OF
                       continuous_on_subset[OF holomorphic_on_imp_continuous_on[OF f_holo]]])
         using \<open>e1>0\<close> \<open>e1\<le>e2\<close> e2_cball by auto
     qed
   have [simp]:"f contour_integrable_on l"
     proof -
       have "closed_segment (z + e2) (z + e1) \<subseteq> cball z e2" using \<open>e2>0\<close> \<open>e1>0\<close> \<open>e1\<le>e2\<close>
         by (intro closed_segment_subset,auto simp add:dist_norm)
       hence "closed_segment (z + e2) (z + e1) \<subseteq> s - {z}" using zl_img e2_cball unfolding l_def
         by auto
       then show "f contour_integrable_on l" unfolding l_def
         apply (intro contour_integrable_continuous_linepath[OF
                       continuous_on_subset[OF holomorphic_on_imp_continuous_on[OF f_holo]]])
         by auto
     qed
   let ?ig="\<lambda>g. contour_integral g f"
   have "(f has_contour_integral 0) g"
     proof (rule Cauchy_theorem_global[OF _ f_holo])
       show "open (s - {z})" using \<open>open s\<close> by auto
       show "valid_path g" unfolding g_def l_def by auto
       show "pathfinish g = pathstart g" unfolding g_def l_def by auto
     next
       have path_img:"path_image g \<subseteq> cball z e2"
         proof -
           have "closed_segment (z + e2) (z + e1) \<subseteq> cball z e2" using \<open>e2>0\<close> \<open>e1>0\<close> \<open>e1\<le>e2\<close>
             by (intro closed_segment_subset,auto simp add:dist_norm)
           moreover have "sphere z \<bar>e1\<bar> \<subseteq> cball z e2" using \<open>e2>0\<close> \<open>e1\<le>e2\<close> \<open>e1>0\<close> by auto
           ultimately show ?thesis unfolding g_def l_def using \<open>e2>0\<close>
             by (simp add: path_image_join closed_segment_commute)
         qed
       show "path_image g \<subseteq> s - {z}"
         proof -
           have "z\<notin>path_image g" using zl_img
             unfolding g_def l_def by (auto simp add: path_image_join closed_segment_commute)
           moreover note \<open>cball z e2 \<subseteq> s\<close> and path_img
           ultimately show ?thesis by auto
         qed
       show "winding_number g w = 0" when"w \<notin> s - {z}" for w
         proof -
           have "winding_number g w = 0" when "w\<notin>s" using that e2_cball
             apply (intro winding_number_zero_outside[OF _ _ _ _ path_img])
             by (auto simp add:g_def l_def)
           moreover have "winding_number g z=0"
             proof -
               let ?Wz="\<lambda>g. winding_number g z"
               have "?Wz g = ?Wz (circlepath z e2) + ?Wz l + ?Wz (reversepath (circlepath z e1))
                   + ?Wz (reversepath l)"
                 using \<open>e2>0\<close> \<open>e1>0\<close> zl_img unfolding g_def l_def
                 by (subst winding_number_join,auto simp add:path_image_join closed_segment_commute)+
               also have "... = ?Wz (circlepath z e2) + ?Wz (reversepath (circlepath z e1))"
                 using zl_img
                 apply (subst (2) winding_number_reversepath)
                 by (auto simp add:l_def closed_segment_commute)
               also have "... = 0"
                 proof -
                   have "?Wz (circlepath z e2) = 1" using \<open>e2>0\<close>
                     by (auto intro: winding_number_circlepath_centre)
                   moreover have "?Wz (reversepath (circlepath z e1)) = -1" using \<open>e1>0\<close>
                     apply (subst winding_number_reversepath)
                     by (auto intro: winding_number_circlepath_centre)
                   ultimately show ?thesis by auto
                 qed
               finally show ?thesis .
             qed
           ultimately show ?thesis using that by auto
         qed
     qed
   then have "0 = ?ig g" using contour_integral_unique by simp
   also have "... = ?ig (circlepath z e2) + ?ig l + ?ig (reversepath (circlepath z e1))
       + ?ig (reversepath l)"
     unfolding g_def
     by (auto simp add:contour_integrable_reversepath_eq)
   also have "... = ?ig (circlepath z e2)  - ?ig (circlepath z e1)"
     by (auto simp add:contour_integral_reversepath)
   finally show "contour_integral (circlepath z e2) f = contour_integral (circlepath z e1) f"
     by simp
 qed
 
 lemma base_residue:
   assumes "open s" "z\<in>s" "r>0" and f_holo:"f holomorphic_on (s - {z})"
     and r_cball:"cball z r \<subseteq> s"
   shows "(f has_contour_integral 2 * pi * \<i> * (residue f z)) (circlepath z r)"
 proof -
   obtain e where "e>0" and e_cball:"cball z e \<subseteq> s"
     using open_contains_cball[of s] \<open>open s\<close> \<open>z\<in>s\<close> by auto
   define c where "c \<equiv> 2 * pi * \<i>"
   define i where "i \<equiv> contour_integral (circlepath z e) f / c"
   have "(f has_contour_integral c*i) (circlepath z \<epsilon>)" when "\<epsilon>>0" "\<epsilon><e" for \<epsilon>
     proof -
       have "contour_integral (circlepath z e) f = contour_integral (circlepath z \<epsilon>) f"
           "f contour_integrable_on circlepath z \<epsilon>"
           "f contour_integrable_on circlepath z e"
         using \<open>\<epsilon><e\<close>
         by (intro contour_integral_circlepath_eq[OF \<open>open s\<close> f_holo \<open>\<epsilon>>0\<close> _ e_cball],auto)+
       then show ?thesis unfolding i_def c_def
         by (auto intro:has_contour_integral_integral)
     qed
   then have "\<exists>e>0. \<forall>\<epsilon>>0. \<epsilon><e \<longrightarrow> (f has_contour_integral c * (residue f z)) (circlepath z \<epsilon>)"
     unfolding residue_def c_def
     apply (rule_tac someI[of _ i],intro  exI[where x=e])
     by (auto simp add:\<open>e>0\<close> c_def)
   then obtain e' where "e'>0"
       and e'_def:"\<forall>\<epsilon>>0. \<epsilon><e' \<longrightarrow> (f has_contour_integral c * (residue f z)) (circlepath z \<epsilon>)"
     by auto
   let ?int="\<lambda>e. contour_integral (circlepath z e) f"
   define  \<epsilon> where "\<epsilon> \<equiv> Min {r,e'} / 2"
   have "\<epsilon>>0" "\<epsilon>\<le>r" "\<epsilon><e'" using \<open>r>0\<close> \<open>e'>0\<close> unfolding \<epsilon>_def by auto
   have "(f has_contour_integral c * (residue f z)) (circlepath z \<epsilon>)"
     using e'_def[rule_format,OF \<open>\<epsilon>>0\<close> \<open>\<epsilon><e'\<close>] .
   then show ?thesis unfolding c_def
     using contour_integral_circlepath_eq[OF \<open>open s\<close> f_holo \<open>\<epsilon>>0\<close> \<open>\<epsilon>\<le>r\<close> r_cball]
     by (auto elim: has_contour_integral_eqpath[of _ _ "circlepath z \<epsilon>" "circlepath z r"])
 qed
 
 lemma residue_holo:
   assumes "open s" "z \<in> s" and f_holo: "f holomorphic_on s"
   shows "residue f z = 0"
 proof -
   define c where "c \<equiv> 2 * pi * \<i>"
   obtain e where "e>0" and e_cball:"cball z e \<subseteq> s" using \<open>open s\<close> \<open>z\<in>s\<close>
     using open_contains_cball_eq by blast
   have "(f has_contour_integral c*residue f z) (circlepath z e)"
     using f_holo
     by (auto intro: base_residue[OF \<open>open s\<close> \<open>z\<in>s\<close> \<open>e>0\<close> _ e_cball,folded c_def])
   moreover have "(f has_contour_integral 0) (circlepath z e)"
     using f_holo e_cball \<open>e>0\<close>
     by (auto intro: Cauchy_theorem_convex_simple[of _ "cball z e"])
   ultimately have "c*residue f z =0"
     using has_contour_integral_unique by blast
   thus ?thesis unfolding c_def  by auto
 qed
 
 lemma residue_const:"residue (\<lambda>_. c) z = 0"
   by (intro residue_holo[of "UNIV::complex set"],auto intro:holomorphic_intros)
 
 lemma residue_add:
   assumes "open s" "z \<in> s" and f_holo: "f holomorphic_on s - {z}"
       and g_holo:"g holomorphic_on s - {z}"
   shows "residue (\<lambda>z. f z + g z) z= residue f z + residue g z"
 proof -
   define c where "c \<equiv> 2 * pi * \<i>"
   define fg where "fg \<equiv> (\<lambda>z. f z+g z)"
   obtain e where "e>0" and e_cball:"cball z e \<subseteq> s" using \<open>open s\<close> \<open>z\<in>s\<close>
     using open_contains_cball_eq by blast
   have "(fg has_contour_integral c * residue fg z) (circlepath z e)"
     unfolding fg_def using f_holo g_holo
     apply (intro base_residue[OF \<open>open s\<close> \<open>z\<in>s\<close> \<open>e>0\<close> _ e_cball,folded c_def])
     by (auto intro:holomorphic_intros)
   moreover have "(fg has_contour_integral c*residue f z + c* residue g z) (circlepath z e)"
     unfolding fg_def using f_holo g_holo
     by (auto intro: has_contour_integral_add base_residue[OF \<open>open s\<close> \<open>z\<in>s\<close> \<open>e>0\<close> _ e_cball,folded c_def])
   ultimately have "c*(residue f z + residue g z) = c * residue fg z"
     using has_contour_integral_unique by (auto simp add:distrib_left)
   thus ?thesis unfolding fg_def
     by (auto simp add:c_def)
 qed
 
 lemma residue_lmul:
   assumes "open s" "z \<in> s" and f_holo: "f holomorphic_on s - {z}"
   shows "residue (\<lambda>z. c * (f z)) z= c * residue f z"
 proof (cases "c=0")
   case True
   thus ?thesis using residue_const by auto
 next
   case False
   define c' where "c' \<equiv> 2 * pi * \<i>"
   define f' where "f' \<equiv> (\<lambda>z. c * (f z))"
   obtain e where "e>0" and e_cball:"cball z e \<subseteq> s" using \<open>open s\<close> \<open>z\<in>s\<close>
     using open_contains_cball_eq by blast
   have "(f' has_contour_integral c' * residue f' z) (circlepath z e)"
     unfolding f'_def using f_holo
     apply (intro base_residue[OF \<open>open s\<close> \<open>z\<in>s\<close> \<open>e>0\<close> _ e_cball,folded c'_def])
     by (auto intro:holomorphic_intros)
   moreover have "(f' has_contour_integral c * (c' * residue f z)) (circlepath z e)"
     unfolding f'_def using f_holo
     by (auto intro: has_contour_integral_lmul
       base_residue[OF \<open>open s\<close> \<open>z\<in>s\<close> \<open>e>0\<close> _ e_cball,folded c'_def])
   ultimately have "c' * residue f' z  = c * (c' * residue f z)"
     using has_contour_integral_unique by auto
   thus ?thesis unfolding f'_def c'_def using False
     by (auto simp add:field_simps)
 qed
 
 lemma residue_rmul:
   assumes "open s" "z \<in> s" and f_holo: "f holomorphic_on s - {z}"
   shows "residue (\<lambda>z. (f z) * c) z= residue f z * c"
 using residue_lmul[OF assms,of c] by (auto simp add:algebra_simps)
 
 lemma residue_div:
   assumes "open s" "z \<in> s" and f_holo: "f holomorphic_on s - {z}"
   shows "residue (\<lambda>z. (f z) / c) z= residue f z / c "
 using residue_lmul[OF assms,of "1/c"] by (auto simp add:algebra_simps)
 
 lemma residue_neg:
   assumes "open s" "z \<in> s" and f_holo: "f holomorphic_on s - {z}"
   shows "residue (\<lambda>z. - (f z)) z= - residue f z"
 using residue_lmul[OF assms,of "-1"] by auto
 
 lemma residue_diff:
   assumes "open s" "z \<in> s" and f_holo: "f holomorphic_on s - {z}"
       and g_holo:"g holomorphic_on s - {z}"
   shows "residue (\<lambda>z. f z - g z) z= residue f z - residue g z"
 using residue_add[OF assms(1,2,3),of "\<lambda>z. - g z"] residue_neg[OF assms(1,2,4)]
 by (auto intro:holomorphic_intros g_holo)
 
 lemma residue_simple:
   assumes "open s" "z\<in>s" and f_holo:"f holomorphic_on s"
   shows "residue (\<lambda>w. f w / (w - z)) z = f z"
 proof -
   define c where "c \<equiv> 2 * pi * \<i>"
   define f' where "f' \<equiv> \<lambda>w. f w / (w - z)"
   obtain e where "e>0" and e_cball:"cball z e \<subseteq> s" using \<open>open s\<close> \<open>z\<in>s\<close>
     using open_contains_cball_eq by blast
   have "(f' has_contour_integral c * f z) (circlepath z e)"
     unfolding f'_def c_def using \<open>e>0\<close> f_holo e_cball
     by (auto intro!: Cauchy_integral_circlepath_simple holomorphic_intros)
   moreover have "(f' has_contour_integral c * residue f' z) (circlepath z e)"
     unfolding f'_def using f_holo
     apply (intro base_residue[OF \<open>open s\<close> \<open>z\<in>s\<close> \<open>e>0\<close> _ e_cball,folded c_def])
     by (auto intro!:holomorphic_intros)
   ultimately have "c * f z = c * residue f' z"
     using has_contour_integral_unique by blast
   thus ?thesis unfolding c_def f'_def  by auto
 qed
 
 lemma residue_simple':
   assumes s: "open s" "z \<in> s" and holo: "f holomorphic_on (s - {z})"
       and lim: "((\<lambda>w. f w * (w - z)) \<longlongrightarrow> c) (at z)"
   shows   "residue f z = c"
 proof -
   define g where "g = (\<lambda>w. if w = z then c else f w * (w - z))"
   from holo have "(\<lambda>w. f w * (w - z)) holomorphic_on (s - {z})" (is "?P")
     by (force intro: holomorphic_intros)
   also have "?P \<longleftrightarrow> g holomorphic_on (s - {z})"
     by (intro holomorphic_cong refl) (simp_all add: g_def)
   finally have *: "g holomorphic_on (s - {z})" .
 
   note lim
   also have "(\<lambda>w. f w * (w - z)) \<midarrow>z\<rightarrow> c \<longleftrightarrow> g \<midarrow>z\<rightarrow> g z"
     by (intro filterlim_cong refl) (simp_all add: g_def [abs_def] eventually_at_filter)
   finally have **: "g \<midarrow>z\<rightarrow> g z" .
 
   have g_holo: "g holomorphic_on s"
     by (rule no_isolated_singularity'[where K = "{z}"])
        (insert assms * **, simp_all add: at_within_open_NO_MATCH)
   from s and this have "residue (\<lambda>w. g w / (w - z)) z = g z"
     by (rule residue_simple)
   also have "\<forall>\<^sub>F za in at z. g za / (za - z) = f za"
     unfolding eventually_at by (auto intro!: exI[of _ 1] simp: field_simps g_def)
   hence "residue (\<lambda>w. g w / (w - z)) z = residue f z"
     by (intro residue_cong refl)
   finally show ?thesis
     by (simp add: g_def)
 qed
 
 lemma residue_holomorphic_over_power:
   assumes "open A" "z0 \<in> A" "f holomorphic_on A"
   shows   "residue (\<lambda>z. f z / (z - z0) ^ Suc n) z0 = (deriv ^^ n) f z0 / fact n"
 proof -
   let ?f = "\<lambda>z. f z / (z - z0) ^ Suc n"
   from assms(1,2) obtain r where r: "r > 0" "cball z0 r \<subseteq> A"
     by (auto simp: open_contains_cball)
   have "(?f has_contour_integral 2 * pi * \<i> * residue ?f z0) (circlepath z0 r)"
     using r assms by (intro base_residue[of A]) (auto intro!: holomorphic_intros)
   moreover have "(?f has_contour_integral 2 * pi * \<i> / fact n * (deriv ^^ n) f z0) (circlepath z0 r)"
     using assms r
     by (intro Cauchy_has_contour_integral_higher_derivative_circlepath)
        (auto intro!: holomorphic_on_subset[OF assms(3)] holomorphic_on_imp_continuous_on)
   ultimately have "2 * pi * \<i> * residue ?f z0 = 2 * pi * \<i> / fact n * (deriv ^^ n) f z0"
     by (rule has_contour_integral_unique)
   thus ?thesis by (simp add: field_simps)
 qed
 
 lemma residue_holomorphic_over_power':
   assumes "open A" "0 \<in> A" "f holomorphic_on A"
   shows   "residue (\<lambda>z. f z / z ^ Suc n) 0 = (deriv ^^ n) f 0 / fact n"
   using residue_holomorphic_over_power[OF assms] by simp
 
 lemma get_integrable_path:
   assumes "open s" "connected (s-pts)" "finite pts" "f holomorphic_on (s-pts) " "a\<in>s-pts" "b\<in>s-pts"
   obtains g where "valid_path g" "pathstart g = a" "pathfinish g = b"
     "path_image g \<subseteq> s-pts" "f contour_integrable_on g" using assms
 proof (induct arbitrary:s thesis a rule:finite_induct[OF \<open>finite pts\<close>])
   case 1
   obtain g where "valid_path g" "path_image g \<subseteq> s" "pathstart g = a" "pathfinish g = b"
     using connected_open_polynomial_connected[OF \<open>open s\<close>,of a b ] \<open>connected (s - {})\<close>
       valid_path_polynomial_function "1.prems"(6) "1.prems"(7) by auto
   moreover have "f contour_integrable_on g"
     using contour_integrable_holomorphic_simple[OF _ \<open>open s\<close> \<open>valid_path g\<close> \<open>path_image g \<subseteq> s\<close>,of f]
       \<open>f holomorphic_on s - {}\<close>
     by auto
   ultimately show ?case using "1"(1)[of g] by auto
 next
   case idt:(2 p pts)
   obtain e where "e>0" and e:"\<forall>w\<in>ball a e. w \<in> s \<and> (w \<noteq> a \<longrightarrow> w \<notin> insert p pts)"
     using finite_ball_avoid[OF \<open>open s\<close> \<open>finite (insert p pts)\<close>, of a]
       \<open>a \<in> s - insert p pts\<close>
     by auto
   define a' where "a' \<equiv> a+e/2"
   have "a'\<in>s-{p} -pts"  using e[rule_format,of "a+e/2"] \<open>e>0\<close>
     by (auto simp add:dist_complex_def a'_def)
   then obtain g' where g'[simp]:"valid_path g'" "pathstart g' = a'" "pathfinish g' = b"
     "path_image g' \<subseteq> s - {p} - pts" "f contour_integrable_on g'"
     using idt.hyps(3)[of a' "s-{p}"] idt.prems idt.hyps(1)
     by (metis Diff_insert2 open_delete)
   define g where "g \<equiv> linepath a a' +++ g'"
   have "valid_path g" unfolding g_def by (auto intro: valid_path_join)
   moreover have "pathstart g = a" and  "pathfinish g = b" unfolding g_def by auto
   moreover have "path_image g \<subseteq> s - insert p pts" unfolding g_def
     proof (rule subset_path_image_join)
       have "closed_segment a a' \<subseteq> ball a e" using \<open>e>0\<close>
         by (auto dest!:segment_bound1 simp:a'_def dist_complex_def norm_minus_commute)
       then show "path_image (linepath a a') \<subseteq> s - insert p pts" using e idt(9)
         by auto
     next
       show "path_image g' \<subseteq> s - insert p pts" using g'(4) by blast
     qed
   moreover have "f contour_integrable_on g"
     proof -
       have "closed_segment a a' \<subseteq> ball a e" using \<open>e>0\<close>
         by (auto dest!:segment_bound1 simp:a'_def dist_complex_def norm_minus_commute)
       then have "continuous_on (closed_segment a a') f"
         using e idt.prems(6) holomorphic_on_imp_continuous_on[OF idt.prems(5)]
         apply (elim continuous_on_subset)
         by auto
       then have "f contour_integrable_on linepath a a'"
         using contour_integrable_continuous_linepath by auto
       then show ?thesis unfolding g_def
         apply (rule contour_integrable_joinI)
         by (auto simp add: \<open>e>0\<close>)
     qed
   ultimately show ?case using idt.prems(1)[of g] by auto
 qed
 
 lemma Cauchy_theorem_aux:
   assumes "open s" "connected (s-pts)" "finite pts" "pts \<subseteq> s" "f holomorphic_on s-pts"
           "valid_path g" "pathfinish g = pathstart g" "path_image g \<subseteq> s-pts"
           "\<forall>z. (z \<notin> s) \<longrightarrow> winding_number g z  = 0"
           "\<forall>p\<in>s. h p>0 \<and> (\<forall>w\<in>cball p (h p). w\<in>s \<and> (w\<noteq>p \<longrightarrow> w \<notin> pts))"
   shows "contour_integral g f = (\<Sum>p\<in>pts. winding_number g p * contour_integral (circlepath p (h p)) f)"
     using assms
 proof (induct arbitrary:s g rule:finite_induct[OF \<open>finite pts\<close>])
   case 1
   then show ?case by (simp add: Cauchy_theorem_global contour_integral_unique)
 next
   case (2 p pts)
   note fin[simp] = \<open>finite (insert p pts)\<close>
     and connected = \<open>connected (s - insert p pts)\<close>
     and valid[simp] = \<open>valid_path g\<close>
     and g_loop[simp] = \<open>pathfinish g = pathstart g\<close>
     and holo[simp]= \<open>f holomorphic_on s - insert p pts\<close>
     and path_img = \<open>path_image g \<subseteq> s - insert p pts\<close>
     and winding = \<open>\<forall>z. z \<notin> s \<longrightarrow> winding_number g z = 0\<close>
     and h = \<open>\<forall>pa\<in>s. 0 < h pa \<and> (\<forall>w\<in>cball pa (h pa). w \<in> s \<and> (w \<noteq> pa \<longrightarrow> w \<notin> insert p pts))\<close>
   have "h p>0" and "p\<in>s"
     and h_p: "\<forall>w\<in>cball p (h p). w \<in> s \<and> (w \<noteq> p \<longrightarrow> w \<notin> insert p pts)"
     using h \<open>insert p pts \<subseteq> s\<close> by auto
   obtain pg where pg[simp]: "valid_path pg" "pathstart pg = pathstart g" "pathfinish pg=p+h p"
       "path_image pg \<subseteq> s-insert p pts" "f contour_integrable_on pg"
     proof -
       have "p + h p\<in>cball p (h p)" using h[rule_format,of p]
         by (simp add: \<open>p \<in> s\<close> dist_norm)
       then have "p + h p \<in> s - insert p pts" using h[rule_format,of p] \<open>insert p pts \<subseteq> s\<close>
         by fastforce
       moreover have "pathstart g \<in> s - insert p pts " using path_img by auto
       ultimately show ?thesis
         using get_integrable_path[OF \<open>open s\<close> connected fin holo,of "pathstart g" "p+h p"] that
         by blast
     qed
   obtain n::int where "n=winding_number g p"
     using integer_winding_number[OF _ g_loop,of p] valid path_img
     by (metis DiffD2 Ints_cases insertI1 subset_eq valid_path_imp_path)
   define p_circ where "p_circ \<equiv> circlepath p (h p)"
   define p_circ_pt where "p_circ_pt \<equiv> linepath (p+h p) (p+h p)"
   define n_circ where "n_circ \<equiv> \<lambda>n. ((+++) p_circ ^^ n) p_circ_pt"
   define cp where "cp \<equiv> if n\<ge>0 then reversepath (n_circ (nat n)) else n_circ (nat (- n))"
   have n_circ:"valid_path (n_circ k)"
       "winding_number (n_circ k) p = k"
       "pathstart (n_circ k) = p + h p" "pathfinish (n_circ k) = p + h p"
       "path_image (n_circ k) =  (if k=0 then {p + h p} else sphere p (h p))"
       "p \<notin> path_image (n_circ k)"
       "\<And>p'. p'\<notin>s - pts \<Longrightarrow> winding_number (n_circ k) p'=0 \<and> p'\<notin>path_image (n_circ k)"
       "f contour_integrable_on (n_circ k)"
       "contour_integral (n_circ k) f = k *  contour_integral p_circ f"
       for k
     proof (induct k)
       case 0
       show "valid_path (n_circ 0)"
         and "path_image (n_circ 0) =  (if 0=0 then {p + h p} else sphere p (h p))"
         and "winding_number (n_circ 0) p = of_nat 0"
         and "pathstart (n_circ 0) = p + h p"
         and "pathfinish (n_circ 0) = p + h p"
         and "p \<notin> path_image (n_circ 0)"
         unfolding n_circ_def p_circ_pt_def using \<open>h p > 0\<close>
         by (auto simp add: dist_norm)
       show "winding_number (n_circ 0) p'=0 \<and> p'\<notin>path_image (n_circ 0)" when "p'\<notin>s- pts" for p'
         unfolding n_circ_def p_circ_pt_def
         apply (auto intro!:winding_number_trivial)
         by (metis Diff_iff pathfinish_in_path_image pg(3) pg(4) subsetCE subset_insertI that)+
       show "f contour_integrable_on (n_circ 0)"
         unfolding n_circ_def p_circ_pt_def
         by (auto intro!:contour_integrable_continuous_linepath simp add:continuous_on_sing)
       show "contour_integral (n_circ 0) f = of_nat 0  *  contour_integral p_circ f"
         unfolding n_circ_def p_circ_pt_def by auto
     next
       case (Suc k)
       have n_Suc:"n_circ (Suc k) = p_circ +++ n_circ k" unfolding n_circ_def by auto
       have pcirc:"p \<notin> path_image p_circ" "valid_path p_circ" "pathfinish p_circ = pathstart (n_circ k)"
         using Suc(3) unfolding p_circ_def using \<open>h p > 0\<close> by (auto simp add: p_circ_def)
       have pcirc_image:"path_image p_circ \<subseteq> s - insert p pts"
         proof -
           have "path_image p_circ \<subseteq> cball p (h p)" using \<open>0 < h p\<close> p_circ_def by auto
           then show ?thesis using h_p pcirc(1) by auto
         qed
       have pcirc_integrable:"f contour_integrable_on p_circ"
         by (auto simp add:p_circ_def intro!: pcirc_image[unfolded p_circ_def]
           contour_integrable_continuous_circlepath holomorphic_on_imp_continuous_on
           holomorphic_on_subset[OF holo])
       show "valid_path (n_circ (Suc k))"
         using valid_path_join[OF pcirc(2) Suc(1) pcirc(3)] unfolding n_circ_def by auto
       show "path_image (n_circ (Suc k))
           = (if Suc k = 0 then {p + complex_of_real (h p)} else sphere p (h p))"
         proof -
           have "path_image p_circ = sphere p (h p)"
             unfolding p_circ_def using \<open>0 < h p\<close> by auto
           then show ?thesis unfolding n_Suc  using Suc.hyps(5)  \<open>h p>0\<close>
             by (auto simp add:  path_image_join[OF pcirc(3)]  dist_norm)
         qed
       then show "p \<notin> path_image (n_circ (Suc k))" using \<open>h p>0\<close> by auto
       show "winding_number (n_circ (Suc k)) p = of_nat (Suc k)"
         proof -
           have "winding_number p_circ p = 1"
             by (simp add: \<open>h p > 0\<close> p_circ_def winding_number_circlepath_centre)
           moreover have "p \<notin> path_image (n_circ k)" using Suc(5) \<open>h p>0\<close> by auto
           then have "winding_number (p_circ +++ n_circ k) p
               = winding_number p_circ p + winding_number (n_circ k) p"
             using  valid_path_imp_path Suc.hyps(1) Suc.hyps(2) pcirc
             apply (intro winding_number_join)
             by auto
           ultimately show ?thesis using Suc(2) unfolding n_circ_def
             by auto
         qed
       show "pathstart (n_circ (Suc k)) = p + h p"
         by (simp add: n_circ_def p_circ_def)
       show "pathfinish (n_circ (Suc k)) = p + h p"
         using Suc(4) unfolding n_circ_def by auto
       show "winding_number (n_circ (Suc k)) p'=0 \<and>  p'\<notin>path_image (n_circ (Suc k))" when "p'\<notin>s-pts" for p'
         proof -
           have " p' \<notin> path_image p_circ" using \<open>p \<in> s\<close> h p_circ_def that using pcirc_image by blast
           moreover have "p' \<notin> path_image (n_circ k)"
             using Suc.hyps(7) that by blast
           moreover have "winding_number p_circ p' = 0"
             proof -
               have "path_image p_circ \<subseteq> cball p (h p)"
                 using h unfolding p_circ_def using \<open>p \<in> s\<close> by fastforce
               moreover have "p'\<notin>cball p (h p)" using \<open>p \<in> s\<close> h that "2.hyps"(2) by fastforce
               ultimately show ?thesis unfolding p_circ_def
                 apply (intro winding_number_zero_outside)
                 by auto
             qed
           ultimately show ?thesis
             unfolding n_Suc
             apply (subst winding_number_join)
             by (auto simp: valid_path_imp_path pcirc Suc that not_in_path_image_join Suc.hyps(7)[OF that])
         qed
       show "f contour_integrable_on (n_circ (Suc k))"
         unfolding n_Suc
         by (rule contour_integrable_joinI[OF pcirc_integrable Suc(8) pcirc(2) Suc(1)])
       show "contour_integral (n_circ (Suc k)) f = (Suc k) *  contour_integral p_circ f"
         unfolding n_Suc
         by (auto simp add:contour_integral_join[OF pcirc_integrable Suc(8) pcirc(2) Suc(1)]
           Suc(9) algebra_simps)
     qed
   have cp[simp]:"pathstart cp = p + h p"  "pathfinish cp = p + h p"
          "valid_path cp" "path_image cp \<subseteq> s - insert p pts"
          "winding_number cp p = - n"
          "\<And>p'. p'\<notin>s - pts \<Longrightarrow> winding_number cp p'=0 \<and> p' \<notin> path_image cp"
          "f contour_integrable_on cp"
          "contour_integral cp f = - n * contour_integral p_circ f"
     proof -
       show "pathstart cp = p + h p" and "pathfinish cp = p + h p" and "valid_path cp"
         using n_circ unfolding cp_def by auto
     next
       have "sphere p (h p) \<subseteq>  s - insert p pts"
         using h[rule_format,of p] \<open>insert p pts \<subseteq> s\<close> by force
       moreover  have "p + complex_of_real (h p) \<in> s - insert p pts"
         using pg(3) pg(4) by (metis pathfinish_in_path_image subsetCE)
       ultimately show "path_image cp \<subseteq>  s - insert p pts" unfolding cp_def
         using n_circ(5)  by auto
     next
       show "winding_number cp p = - n"
         unfolding cp_def using winding_number_reversepath n_circ \<open>h p>0\<close>
         by (auto simp: valid_path_imp_path)
     next
       show "winding_number cp p'=0 \<and> p' \<notin> path_image cp" when "p'\<notin>s - pts" for p'
         unfolding cp_def
         apply (auto)
         apply (subst winding_number_reversepath)
         by (auto simp add: valid_path_imp_path n_circ(7)[OF that] n_circ(1))
     next
       show "f contour_integrable_on cp" unfolding cp_def
         using contour_integrable_reversepath_eq n_circ(1,8) by auto
     next
       show "contour_integral cp f = - n * contour_integral p_circ f"
         unfolding cp_def using contour_integral_reversepath[OF n_circ(1)] n_circ(9)
         by auto
     qed
   define g' where "g' \<equiv> g +++ pg +++ cp +++ (reversepath pg)"
   have "contour_integral g' f = (\<Sum>p\<in>pts. winding_number g' p * contour_integral (circlepath p (h p)) f)"
     proof (rule "2.hyps"(3)[of "s-{p}" "g'",OF _ _ \<open>finite pts\<close> ])
       show "connected (s - {p} - pts)" using connected by (metis Diff_insert2)
       show "open (s - {p})" using \<open>open s\<close> by auto
       show " pts \<subseteq> s - {p}" using \<open>insert p pts \<subseteq> s\<close> \<open> p \<notin> pts\<close>  by blast
       show "f holomorphic_on s - {p} - pts" using holo \<open>p \<notin> pts\<close> by (metis Diff_insert2)
       show "valid_path g'"
         unfolding g'_def cp_def using n_circ valid pg g_loop
         by (auto intro!:valid_path_join )
       show "pathfinish g' = pathstart g'"
         unfolding g'_def cp_def using pg(2) by simp
       show "path_image g' \<subseteq> s - {p} - pts"
         proof -
           define s' where "s' \<equiv> s - {p} - pts"
           have s':"s' = s-insert p pts " unfolding s'_def by auto
           then show ?thesis using path_img pg(4) cp(4)
             unfolding g'_def
             apply (fold s'_def s')
             apply (intro subset_path_image_join)
             by auto
         qed
       note path_join_imp[simp]
       show "\<forall>z. z \<notin> s - {p} \<longrightarrow> winding_number g' z = 0"
         proof clarify
           fix z assume z:"z\<notin>s - {p}"
           have "winding_number (g +++ pg +++ cp +++ reversepath pg) z = winding_number g z
               + winding_number (pg +++ cp +++ (reversepath pg)) z"
             proof (rule winding_number_join)
               show "path g" using \<open>valid_path g\<close> by (simp add: valid_path_imp_path)
               show "z \<notin> path_image g" using z path_img by auto
               show "path (pg +++ cp +++ reversepath pg)" using pg(3) cp
                 by (simp add: valid_path_imp_path)
             next
               have "path_image (pg +++ cp +++ reversepath pg) \<subseteq> s - insert p pts"
                 using pg(4) cp(4) by (auto simp:subset_path_image_join)
               then show "z \<notin> path_image (pg +++ cp +++ reversepath pg)" using z by auto
             next
               show "pathfinish g = pathstart (pg +++ cp +++ reversepath pg)" using g_loop by auto
             qed
           also have "... = winding_number g z + (winding_number pg z
               + winding_number (cp +++ (reversepath pg)) z)"
             proof (subst add_left_cancel,rule winding_number_join)
               show "path pg" and "path (cp +++ reversepath pg)"
                and "pathfinish pg = pathstart (cp +++ reversepath pg)"
                 by (auto simp add: valid_path_imp_path)
               show "z \<notin> path_image pg" using pg(4) z by blast
               show "z \<notin> path_image (cp +++ reversepath pg)" using z
                 by (metis Diff_iff \<open>z \<notin> path_image pg\<close> contra_subsetD cp(4) insertI1
                   not_in_path_image_join path_image_reversepath singletonD)
             qed
           also have "... = winding_number g z + (winding_number pg z
               + (winding_number cp z + winding_number (reversepath pg) z))"
             apply (auto intro!:winding_number_join simp: valid_path_imp_path)
             apply (metis Diff_iff contra_subsetD cp(4) insertI1 singletonD z)
             by (metis Diff_insert2 Diff_subset contra_subsetD pg(4) z)
           also have "... = winding_number g z + winding_number cp z"
             apply (subst winding_number_reversepath)
             apply (auto simp: valid_path_imp_path)
             by (metis Diff_iff contra_subsetD insertI1 pg(4) singletonD z)
           finally have "winding_number g' z = winding_number g z + winding_number cp z"
             unfolding g'_def .
           moreover have "winding_number g z + winding_number cp z = 0"
             using winding z \<open>n=winding_number g p\<close> by auto
           ultimately show "winding_number g' z = 0" unfolding g'_def by auto
         qed
       show "\<forall>pa\<in>s - {p}. 0 < h pa \<and> (\<forall>w\<in>cball pa (h pa). w \<in> s - {p} \<and> (w \<noteq> pa \<longrightarrow> w \<notin> pts))"
         using h by fastforce
     qed
   moreover have "contour_integral g' f = contour_integral g f
       - winding_number g p * contour_integral p_circ f"
     proof -
       have "contour_integral g' f =  contour_integral g f
         + contour_integral (pg +++ cp +++ reversepath pg) f"
         unfolding g'_def
         apply (subst contour_integral_join)
         by (auto simp add:open_Diff[OF \<open>open s\<close>,OF finite_imp_closed[OF fin]]
           intro!: contour_integrable_holomorphic_simple[OF holo _ _ path_img]
           contour_integrable_reversepath)
       also have "... = contour_integral g f + contour_integral pg f
           + contour_integral (cp +++ reversepath pg) f"
         apply (subst contour_integral_join)
         by (auto simp add:contour_integrable_reversepath)
       also have "... = contour_integral g f + contour_integral pg f
           + contour_integral cp f + contour_integral (reversepath pg) f"
         apply (subst contour_integral_join)
         by (auto simp add:contour_integrable_reversepath)
       also have "... = contour_integral g f + contour_integral cp f"
         using contour_integral_reversepath
         by (auto simp add:contour_integrable_reversepath)
       also have "... = contour_integral g f - winding_number g p * contour_integral p_circ f"
         using \<open>n=winding_number g p\<close> by auto
       finally show ?thesis .
     qed
   moreover have "winding_number g' p' = winding_number g p'" when "p'\<in>pts" for p'
     proof -
       have [simp]: "p' \<notin> path_image g" "p' \<notin> path_image pg" "p'\<notin>path_image cp"
         using "2.prems"(8) that
         apply blast
         apply (metis Diff_iff Diff_insert2 contra_subsetD pg(4) that)
         by (meson DiffD2 cp(4) rev_subsetD subset_insertI that)
       have "winding_number g' p' = winding_number g p'
           + winding_number (pg +++ cp +++ reversepath pg) p'" unfolding g'_def
         apply (subst winding_number_join)
         apply (simp_all add: valid_path_imp_path)
         apply (intro not_in_path_image_join)
         by auto
       also have "... = winding_number g p' + winding_number pg p'
           + winding_number (cp +++ reversepath pg) p'"
         apply (subst winding_number_join)
         apply (simp_all add: valid_path_imp_path)
         apply (intro not_in_path_image_join)
         by auto
       also have "... = winding_number g p' + winding_number pg p'+ winding_number cp p'
           + winding_number (reversepath pg) p'"
         apply (subst winding_number_join)
         by (simp_all add: valid_path_imp_path)
       also have "... = winding_number g p' + winding_number cp p'"
         apply (subst winding_number_reversepath)
         by (simp_all add: valid_path_imp_path)
       also have "... = winding_number g p'" using that by auto
       finally show ?thesis .
     qed
   ultimately show ?case unfolding p_circ_def
     apply (subst (asm) sum.cong[OF refl,
         of pts _ "\<lambda>p. winding_number g p * contour_integral (circlepath p (h p)) f"])
     by (auto simp add:sum.insert[OF \<open>finite pts\<close> \<open>p\<notin>pts\<close>] algebra_simps)
 qed
 
 lemma Cauchy_theorem_singularities:
   assumes "open s" "connected s" "finite pts" and
           holo:"f holomorphic_on s-pts" and
           "valid_path g" and
           loop:"pathfinish g = pathstart g" and
           "path_image g \<subseteq> s-pts" and
           homo:"\<forall>z. (z \<notin> s) \<longrightarrow> winding_number g z  = 0" and
           avoid:"\<forall>p\<in>s. h p>0 \<and> (\<forall>w\<in>cball p (h p). w\<in>s \<and> (w\<noteq>p \<longrightarrow> w \<notin> pts))"
   shows "contour_integral g f = (\<Sum>p\<in>pts. winding_number g p * contour_integral (circlepath p (h p)) f)"
     (is "?L=?R")
 proof -
   define circ where "circ \<equiv> \<lambda>p. winding_number g p * contour_integral (circlepath p (h p)) f"
   define pts1 where "pts1 \<equiv> pts \<inter> s"
   define pts2 where "pts2 \<equiv> pts - pts1"
   have "pts=pts1 \<union> pts2" "pts1 \<inter> pts2 = {}" "pts2 \<inter> s={}" "pts1\<subseteq>s"
     unfolding pts1_def pts2_def by auto
   have "contour_integral g f =  (\<Sum>p\<in>pts1. circ p)" unfolding circ_def
     proof (rule Cauchy_theorem_aux[OF \<open>open s\<close> _ _ \<open>pts1\<subseteq>s\<close> _ \<open>valid_path g\<close> loop _ homo])
       have "finite pts1" unfolding pts1_def using \<open>finite pts\<close> by auto
       then show "connected (s - pts1)"
         using \<open>open s\<close> \<open>connected s\<close> connected_open_delete_finite[of s] by auto
     next
       show "finite pts1" using \<open>pts = pts1 \<union> pts2\<close> assms(3) by auto
       show "f holomorphic_on s - pts1" by (metis Diff_Int2 Int_absorb holo pts1_def)
       show "path_image g \<subseteq> s - pts1" using assms(7) pts1_def by auto
       show "\<forall>p\<in>s. 0 < h p \<and> (\<forall>w\<in>cball p (h p). w \<in> s \<and> (w \<noteq> p \<longrightarrow> w \<notin> pts1))"
         by (simp add: avoid pts1_def)
     qed
   moreover have "sum circ pts2=0"
     proof -
       have "winding_number g p=0" when "p\<in>pts2" for p
         using  \<open>pts2 \<inter> s={}\<close> that homo[rule_format,of p] by auto
       thus ?thesis unfolding circ_def
         apply (intro sum.neutral)
         by auto
     qed
   moreover have "?R=sum circ pts1 + sum circ pts2"
     unfolding circ_def
     using sum.union_disjoint[OF _ _ \<open>pts1 \<inter> pts2 = {}\<close>] \<open>finite pts\<close> \<open>pts=pts1 \<union> pts2\<close>
     by blast
   ultimately show ?thesis
     apply (fold circ_def)
     by auto
 qed
 
 theorem Residue_theorem:
   fixes s pts::"complex set" and f::"complex \<Rightarrow> complex"
     and g::"real \<Rightarrow> complex"
   assumes "open s" "connected s" "finite pts" and
           holo:"f holomorphic_on s-pts" and
           "valid_path g" and
           loop:"pathfinish g = pathstart g" and
           "path_image g \<subseteq> s-pts" and
           homo:"\<forall>z. (z \<notin> s) \<longrightarrow> winding_number g z  = 0"
   shows "contour_integral g f = 2 * pi * \<i> *(\<Sum>p\<in>pts. winding_number g p * residue f p)"
 proof -
   define c where "c \<equiv>  2 * pi * \<i>"
   obtain h where avoid:"\<forall>p\<in>s. h p>0 \<and> (\<forall>w\<in>cball p (h p). w\<in>s \<and> (w\<noteq>p \<longrightarrow> w \<notin> pts))"
     using finite_cball_avoid[OF \<open>open s\<close> \<open>finite pts\<close>] by metis
   have "contour_integral g f
       = (\<Sum>p\<in>pts. winding_number g p * contour_integral (circlepath p (h p)) f)"
     using Cauchy_theorem_singularities[OF assms avoid] .
   also have "... = (\<Sum>p\<in>pts.  c * winding_number g p * residue f p)"
     proof (intro sum.cong)
       show "pts = pts" by simp
     next
       fix x assume "x \<in> pts"
       show "winding_number g x * contour_integral (circlepath x (h x)) f
           = c * winding_number g x * residue f x"
         proof (cases "x\<in>s")
           case False
           then have "winding_number g x=0" using homo by auto
           thus ?thesis by auto
         next
           case True
           have "contour_integral (circlepath x (h x)) f = c* residue f x"
             using \<open>x\<in>pts\<close> \<open>finite pts\<close> avoid[rule_format,OF True]
             apply (intro base_residue[of "s-(pts-{x})",THEN contour_integral_unique,folded c_def])
             by (auto intro:holomorphic_on_subset[OF holo] open_Diff[OF \<open>open s\<close> finite_imp_closed])
           then show ?thesis by auto
         qed
     qed
   also have "... = c * (\<Sum>p\<in>pts. winding_number g p * residue f p)"
     by (simp add: sum_distrib_left algebra_simps)
   finally show ?thesis unfolding c_def .
 qed
 
 subsection \<open>Non-essential singular points\<close>
 
 definition\<^marker>\<open>tag important\<close> is_pole ::
   "('a::topological_space \<Rightarrow> 'b::real_normed_vector) \<Rightarrow> 'a \<Rightarrow> bool" where
   "is_pole f a =  (LIM x (at a). f x :> at_infinity)"
 
 lemma is_pole_cong:
   assumes "eventually (\<lambda>x. f x = g x) (at a)" "a=b"
   shows "is_pole f a \<longleftrightarrow> is_pole g b"
   unfolding is_pole_def using assms by (intro filterlim_cong,auto)
 
 lemma is_pole_transform:
   assumes "is_pole f a" "eventually (\<lambda>x. f x = g x) (at a)" "a=b"
   shows "is_pole g b"
   using is_pole_cong assms by auto
 
 lemma is_pole_tendsto:
   fixes f::"('a::topological_space \<Rightarrow> 'b::real_normed_div_algebra)"
   shows "is_pole f x \<Longrightarrow> ((inverse o f) \<longlongrightarrow> 0) (at x)"
 unfolding is_pole_def
 by (auto simp add:filterlim_inverse_at_iff[symmetric] comp_def filterlim_at)
 
 lemma is_pole_inverse_holomorphic:
   assumes "open s"
     and f_holo:"f holomorphic_on (s-{z})"
     and pole:"is_pole f z"
     and non_z:"\<forall>x\<in>s-{z}. f x\<noteq>0"
   shows "(\<lambda>x. if x=z then 0 else inverse (f x)) holomorphic_on s"
 proof -
   define g where "g \<equiv> \<lambda>x. if x=z then 0 else inverse (f x)"
   have "isCont g z" unfolding isCont_def  using is_pole_tendsto[OF pole]
     apply (subst Lim_cong_at[where b=z and y=0 and g="inverse \<circ> f"])
     by (simp_all add:g_def)
   moreover have "continuous_on (s-{z}) f" using f_holo holomorphic_on_imp_continuous_on by auto
   hence "continuous_on (s-{z}) (inverse o f)" unfolding comp_def
     by (auto elim!:continuous_on_inverse simp add:non_z)
   hence "continuous_on (s-{z}) g" unfolding g_def
     apply (subst continuous_on_cong[where t="s-{z}" and g="inverse o f"])
     by auto
   ultimately have "continuous_on s g" using open_delete[OF \<open>open s\<close>] \<open>open s\<close>
     by (auto simp add:continuous_on_eq_continuous_at)
   moreover have "(inverse o f) holomorphic_on (s-{z})"
     unfolding comp_def using f_holo
     by (auto elim!:holomorphic_on_inverse simp add:non_z)
   hence "g holomorphic_on (s-{z})"
     apply (subst holomorphic_cong[where t="s-{z}" and g="inverse o f"])
     by (auto simp add:g_def)
   ultimately show ?thesis unfolding g_def using \<open>open s\<close>
     by (auto elim!: no_isolated_singularity)
 qed
 
 lemma not_is_pole_holomorphic:
   assumes "open A" "x \<in> A" "f holomorphic_on A"
   shows   "\<not>is_pole f x"
 proof -
   have "continuous_on A f" by (intro holomorphic_on_imp_continuous_on) fact
   with assms have "isCont f x" by (simp add: continuous_on_eq_continuous_at)
   hence "f \<midarrow>x\<rightarrow> f x" by (simp add: isCont_def)
   thus "\<not>is_pole f x" unfolding is_pole_def
     using not_tendsto_and_filterlim_at_infinity[of "at x" f "f x"] by auto
 qed
 
 lemma is_pole_inverse_power: "n > 0 \<Longrightarrow> is_pole (\<lambda>z::complex. 1 / (z - a) ^ n) a"
   unfolding is_pole_def inverse_eq_divide [symmetric]
   by (intro filterlim_compose[OF filterlim_inverse_at_infinity] tendsto_intros)
      (auto simp: filterlim_at eventually_at intro!: exI[of _ 1] tendsto_eq_intros)
 
 lemma is_pole_inverse: "is_pole (\<lambda>z::complex. 1 / (z - a)) a"
   using is_pole_inverse_power[of 1 a] by simp
 
 lemma is_pole_divide:
   fixes f :: "'a :: t2_space \<Rightarrow> 'b :: real_normed_field"
   assumes "isCont f z" "filterlim g (at 0) (at z)" "f z \<noteq> 0"
   shows   "is_pole (\<lambda>z. f z / g z) z"
 proof -
   have "filterlim (\<lambda>z. f z * inverse (g z)) at_infinity (at z)"
     by (intro tendsto_mult_filterlim_at_infinity[of _ "f z"]
                  filterlim_compose[OF filterlim_inverse_at_infinity])+
        (insert assms, auto simp: isCont_def)
   thus ?thesis by (simp add: field_split_simps is_pole_def)
 qed
 
 lemma is_pole_basic:
   assumes "f holomorphic_on A" "open A" "z \<in> A" "f z \<noteq> 0" "n > 0"
   shows   "is_pole (\<lambda>w. f w / (w - z) ^ n) z"
 proof (rule is_pole_divide)
   have "continuous_on A f" by (rule holomorphic_on_imp_continuous_on) fact
   with assms show "isCont f z" by (auto simp: continuous_on_eq_continuous_at)
   have "filterlim (\<lambda>w. (w - z) ^ n) (nhds 0) (at z)"
     using assms by (auto intro!: tendsto_eq_intros)
   thus "filterlim (\<lambda>w. (w - z) ^ n) (at 0) (at z)"
     by (intro filterlim_atI tendsto_eq_intros)
        (insert assms, auto simp: eventually_at_filter)
 qed fact+
 
 lemma is_pole_basic':
   assumes "f holomorphic_on A" "open A" "0 \<in> A" "f 0 \<noteq> 0" "n > 0"
   shows   "is_pole (\<lambda>w. f w / w ^ n) 0"
   using is_pole_basic[of f A 0] assms by simp
 
 text \<open>The proposition
               \<^term>\<open>\<exists>x. ((f::complex\<Rightarrow>complex) \<longlongrightarrow> x) (at z) \<or> is_pole f z\<close>
 can be interpreted as the complex function \<^term>\<open>f\<close> has a non-essential singularity at \<^term>\<open>z\<close>
 (i.e. the singularity is either removable or a pole).\<close>
 definition not_essential::"[complex \<Rightarrow> complex, complex] \<Rightarrow> bool" where
   "not_essential f z = (\<exists>x. f\<midarrow>z\<rightarrow>x \<or> is_pole f z)"
 
 definition isolated_singularity_at::"[complex \<Rightarrow> complex, complex] \<Rightarrow> bool" where
   "isolated_singularity_at f z = (\<exists>r>0. f analytic_on ball z r-{z})"
 
 named_theorems singularity_intros "introduction rules for singularities"
 
 lemma holomorphic_factor_unique:
   fixes f::"complex \<Rightarrow> complex" and z::complex and r::real and m n::int
   assumes "r>0" "g z\<noteq>0" "h z\<noteq>0"
     and asm:"\<forall>w\<in>ball z r-{z}. f w = g w * (w-z) powr n \<and> g w\<noteq>0 \<and> f w =  h w * (w - z) powr m \<and> h w\<noteq>0"
     and g_holo:"g holomorphic_on ball z r" and h_holo:"h holomorphic_on ball z r"
   shows "n=m"
 proof -
   have [simp]:"at z within ball z r \<noteq> bot" using \<open>r>0\<close>
       by (auto simp add:at_within_ball_bot_iff)
   have False when "n>m"
   proof -
     have "(h \<longlongrightarrow> 0) (at z within ball z r)"
     proof (rule Lim_transform_within[OF _ \<open>r>0\<close>, where f="\<lambda>w. (w - z) powr (n - m) * g w"])
       have "\<forall>w\<in>ball z r-{z}. h w = (w-z)powr(n-m) * g w"
         using \<open>n>m\<close> asm \<open>r>0\<close>
         apply (auto simp add:field_simps powr_diff)
         by force
       then show "\<lbrakk>x' \<in> ball z r; 0 < dist x' z;dist x' z < r\<rbrakk>
             \<Longrightarrow> (x' - z) powr (n - m) * g x' = h x'" for x' by auto
     next
       define F where "F \<equiv> at z within ball z r"
       define f' where "f' \<equiv> \<lambda>x. (x - z) powr (n-m)"
       have "f' z=0" using \<open>n>m\<close> unfolding f'_def by auto
       moreover have "continuous F f'" unfolding f'_def F_def continuous_def
         apply (subst Lim_ident_at)
         using \<open>n>m\<close> by (auto intro!:tendsto_powr_complex_0 tendsto_eq_intros)
       ultimately have "(f' \<longlongrightarrow> 0) F" unfolding F_def
         by (simp add: continuous_within)
       moreover have "(g \<longlongrightarrow> g z) F"
         using holomorphic_on_imp_continuous_on[OF g_holo,unfolded continuous_on_def] \<open>r>0\<close>
         unfolding F_def by auto
       ultimately show " ((\<lambda>w. f' w * g w) \<longlongrightarrow> 0) F" using tendsto_mult by fastforce
     qed
     moreover have "(h \<longlongrightarrow> h z) (at z within ball z r)"
       using holomorphic_on_imp_continuous_on[OF h_holo]
       by (auto simp add:continuous_on_def \<open>r>0\<close>)
     ultimately have "h z=0" by (auto intro!: tendsto_unique)
     thus False using \<open>h z\<noteq>0\<close> by auto
   qed
   moreover have False when "m>n"
   proof -
     have "(g \<longlongrightarrow> 0) (at z within ball z r)"
     proof (rule Lim_transform_within[OF _ \<open>r>0\<close>, where f="\<lambda>w. (w - z) powr (m - n) * h w"])
       have "\<forall>w\<in>ball z r -{z}. g w = (w-z) powr (m-n) * h w" using \<open>m>n\<close> asm
         apply (auto simp add:field_simps powr_diff)
         by force
       then show "\<lbrakk>x' \<in> ball z r; 0 < dist x' z;dist x' z < r\<rbrakk>
             \<Longrightarrow> (x' - z) powr (m - n) * h x' = g x'" for x' by auto
     next
       define F where "F \<equiv> at z within ball z r"
       define f' where "f' \<equiv>\<lambda>x. (x - z) powr (m-n)"
       have "f' z=0" using \<open>m>n\<close> unfolding f'_def by auto
       moreover have "continuous F f'" unfolding f'_def F_def continuous_def
         apply (subst Lim_ident_at)
         using \<open>m>n\<close> by (auto intro!:tendsto_powr_complex_0 tendsto_eq_intros)
       ultimately have "(f' \<longlongrightarrow> 0) F" unfolding F_def
         by (simp add: continuous_within)
       moreover have "(h \<longlongrightarrow> h z) F"
         using holomorphic_on_imp_continuous_on[OF h_holo,unfolded continuous_on_def] \<open>r>0\<close>
         unfolding F_def by auto
       ultimately show " ((\<lambda>w. f' w * h w) \<longlongrightarrow> 0) F" using tendsto_mult by fastforce
     qed
     moreover have "(g \<longlongrightarrow> g z) (at z within ball z r)"
       using holomorphic_on_imp_continuous_on[OF g_holo]
       by (auto simp add:continuous_on_def \<open>r>0\<close>)
     ultimately have "g z=0" by (auto intro!: tendsto_unique)
     thus False using \<open>g z\<noteq>0\<close> by auto
   qed
   ultimately show "n=m" by fastforce
 qed
 
 lemma holomorphic_factor_puncture:
   assumes f_iso:"isolated_singularity_at f z"
       and "not_essential f z" \<comment> \<open>\<^term>\<open>f\<close> has either a removable singularity or a pole at \<^term>\<open>z\<close>\<close>
       and non_zero:"\<exists>\<^sub>Fw in (at z). f w\<noteq>0" \<comment> \<open>\<^term>\<open>f\<close> will not be constantly zero in a neighbour of \<^term>\<open>z\<close>\<close>
   shows "\<exists>!n::int. \<exists>g r. 0 < r \<and> g holomorphic_on cball z r \<and> g z\<noteq>0
           \<and> (\<forall>w\<in>cball z r-{z}. f w = g w * (w-z) powr n \<and> g w\<noteq>0)"
 proof -
   define P where "P = (\<lambda>f n g r. 0 < r \<and> g holomorphic_on cball z r \<and> g z\<noteq>0
           \<and> (\<forall>w\<in>cball z r - {z}. f w = g w * (w-z) powr (of_int n)  \<and> g w\<noteq>0))"
   have imp_unique:"\<exists>!n::int. \<exists>g r. P f n g r" when "\<exists>n g r. P f n g r"
   proof (rule ex_ex1I[OF that])
     fix n1 n2 :: int
     assume g1_asm:"\<exists>g1 r1. P f n1 g1 r1" and g2_asm:"\<exists>g2 r2. P f n2 g2 r2"
     define fac where "fac \<equiv> \<lambda>n g r. \<forall>w\<in>cball z r-{z}. f w = g w * (w - z) powr (of_int n) \<and> g w \<noteq> 0"
     obtain g1 r1 where "0 < r1" and g1_holo: "g1 holomorphic_on cball z r1" and "g1 z\<noteq>0"
         and "fac n1 g1 r1" using g1_asm unfolding P_def fac_def by auto
     obtain g2 r2 where "0 < r2" and g2_holo: "g2 holomorphic_on cball z r2" and "g2 z\<noteq>0"
         and "fac n2 g2 r2" using g2_asm unfolding P_def fac_def by auto
     define r where "r \<equiv> min r1 r2"
     have "r>0" using \<open>r1>0\<close> \<open>r2>0\<close> unfolding r_def by auto
     moreover have "\<forall>w\<in>ball z r-{z}. f w = g1 w * (w-z) powr n1 \<and> g1 w\<noteq>0
         \<and> f w = g2 w * (w - z) powr n2  \<and> g2 w\<noteq>0"
       using \<open>fac n1 g1 r1\<close> \<open>fac n2 g2 r2\<close>   unfolding fac_def r_def
       by fastforce
     ultimately show "n1=n2" using g1_holo g2_holo \<open>g1 z\<noteq>0\<close> \<open>g2 z\<noteq>0\<close>
       apply (elim holomorphic_factor_unique)
       by (auto simp add:r_def)
   qed
 
   have P_exist:"\<exists> n g r. P h n g r" when
       "\<exists>z'. (h \<longlongrightarrow> z') (at z)" "isolated_singularity_at h z"  "\<exists>\<^sub>Fw in (at z). h w\<noteq>0"
     for h
   proof -
     from that(2) obtain r where "r>0" "h analytic_on ball z r - {z}"
       unfolding isolated_singularity_at_def by auto
     obtain z' where "(h \<longlongrightarrow> z') (at z)" using \<open>\<exists>z'. (h \<longlongrightarrow> z') (at z)\<close> by auto
     define h' where "h'=(\<lambda>x. if x=z then z' else h x)"
     have "h' holomorphic_on ball z r"
       apply (rule no_isolated_singularity'[of "{z}"])
       subgoal by (metis LIM_equal Lim_at_imp_Lim_at_within \<open>h \<midarrow>z\<rightarrow> z'\<close> empty_iff h'_def insert_iff)
       subgoal using \<open>h analytic_on ball z r - {z}\<close> analytic_imp_holomorphic h'_def holomorphic_transform
         by fastforce
       by auto
     have ?thesis when "z'=0"
     proof -
       have "h' z=0" using that unfolding h'_def by auto
       moreover have "\<not> h' constant_on ball z r"
         using \<open>\<exists>\<^sub>Fw in (at z). h w\<noteq>0\<close> unfolding constant_on_def frequently_def eventually_at h'_def
         apply simp
         by (metis \<open>0 < r\<close> centre_in_ball dist_commute mem_ball that)
       moreover note \<open>h' holomorphic_on ball z r\<close>
       ultimately obtain g r1 n where "0 < n" "0 < r1" "ball z r1 \<subseteq> ball z r" and
           g:"g holomorphic_on ball z r1"
           "\<And>w. w \<in> ball z r1 \<Longrightarrow> h' w = (w - z) ^ n * g w"
           "\<And>w. w \<in> ball z r1 \<Longrightarrow> g w \<noteq> 0"
         using holomorphic_factor_zero_nonconstant[of _ "ball z r" z thesis,simplified,
                 OF \<open>h' holomorphic_on ball z r\<close> \<open>r>0\<close> \<open>h' z=0\<close> \<open>\<not> h' constant_on ball z r\<close>]
         by (auto simp add:dist_commute)
       define rr where "rr=r1/2"
       have "P h' n g rr"
         unfolding P_def rr_def
         using \<open>n>0\<close> \<open>r1>0\<close> g by (auto simp add:powr_nat)
       then have "P h n g rr"
         unfolding h'_def P_def by auto
       then show ?thesis unfolding P_def by blast
     qed
     moreover have ?thesis when "z'\<noteq>0"
     proof -
       have "h' z\<noteq>0" using that unfolding h'_def by auto
       obtain r1 where "r1>0" "cball z r1 \<subseteq> ball z r" "\<forall>x\<in>cball z r1. h' x\<noteq>0"
       proof -
         have "isCont h' z" "h' z\<noteq>0"
           by (auto simp add: Lim_cong_within \<open>h \<midarrow>z\<rightarrow> z'\<close> \<open>z'\<noteq>0\<close> continuous_at h'_def)
         then obtain r2 where r2:"r2>0" "\<forall>x\<in>ball z r2. h' x\<noteq>0"
           using continuous_at_avoid[of z h' 0 ] unfolding ball_def by auto
         define r1 where "r1=min r2 r / 2"
         have "0 < r1" "cball z r1 \<subseteq> ball z r"
           using \<open>r2>0\<close> \<open>r>0\<close> unfolding r1_def by auto
         moreover have "\<forall>x\<in>cball z r1. h' x \<noteq> 0"
           using r2 unfolding r1_def by simp
         ultimately show ?thesis using that by auto
       qed
       then have "P h' 0 h' r1" using \<open>h' holomorphic_on ball z r\<close> unfolding P_def by auto
       then have "P h 0 h' r1" unfolding P_def h'_def by auto
       then show ?thesis unfolding P_def by blast
     qed
     ultimately show ?thesis by auto
   qed
 
   have ?thesis when "\<exists>x. (f \<longlongrightarrow> x) (at z)"
     apply (rule_tac imp_unique[unfolded P_def])
     using P_exist[OF that(1) f_iso non_zero] unfolding P_def .
   moreover have ?thesis when "is_pole f z"
   proof (rule imp_unique[unfolded P_def])
     obtain e where [simp]:"e>0" and e_holo:"f holomorphic_on ball z e - {z}" and e_nz: "\<forall>x\<in>ball z e-{z}. f x\<noteq>0"
     proof -
       have "\<forall>\<^sub>F z in at z. f z \<noteq> 0"
         using \<open>is_pole f z\<close> filterlim_at_infinity_imp_eventually_ne unfolding is_pole_def
         by auto
       then obtain e1 where e1:"e1>0" "\<forall>x\<in>ball z e1-{z}. f x\<noteq>0"
         using that eventually_at[of "\<lambda>x. f x\<noteq>0" z UNIV,simplified] by (auto simp add:dist_commute)
       obtain e2 where e2:"e2>0" "f holomorphic_on ball z e2 - {z}"
         using f_iso analytic_imp_holomorphic unfolding isolated_singularity_at_def by auto
       define e where "e=min e1 e2"
       show ?thesis
         apply (rule that[of e])
         using  e1 e2 unfolding e_def by auto
     qed
 
     define h where "h \<equiv> \<lambda>x. inverse (f x)"
 
     have "\<exists>n g r. P h n g r"
     proof -
       have "h \<midarrow>z\<rightarrow> 0"
         using Lim_transform_within_open assms(2) h_def is_pole_tendsto that by fastforce
       moreover have "\<exists>\<^sub>Fw in (at z). h w\<noteq>0"
         using non_zero
         apply (elim frequently_rev_mp)
         unfolding h_def eventually_at by (auto intro:exI[where x=1])
       moreover have "isolated_singularity_at h z"
         unfolding isolated_singularity_at_def h_def
         apply (rule exI[where x=e])
         using e_holo e_nz \<open>e>0\<close> by (metis open_ball analytic_on_open
             holomorphic_on_inverse open_delete)
       ultimately show ?thesis
         using P_exist[of h] by auto
     qed
     then obtain n g r
       where "0 < r" and
             g_holo:"g holomorphic_on cball z r" and "g z\<noteq>0" and
             g_fac:"(\<forall>w\<in>cball z r-{z}. h w = g w * (w - z) powr of_int n  \<and> g w \<noteq> 0)"
       unfolding P_def by auto
     have "P f (-n) (inverse o g) r"
     proof -
       have "f w = inverse (g w) * (w - z) powr of_int (- n)" when "w\<in>cball z r - {z}" for w
         using g_fac[rule_format,of w] that unfolding h_def
         apply (auto simp add:powr_minus )
         by (metis inverse_inverse_eq inverse_mult_distrib)
       then show ?thesis
         unfolding P_def comp_def
         using \<open>r>0\<close> g_holo g_fac \<open>g z\<noteq>0\<close> by (auto intro:holomorphic_intros)
     qed
     then show "\<exists>x g r. 0 < r \<and> g holomorphic_on cball z r \<and> g z \<noteq> 0
                   \<and> (\<forall>w\<in>cball z r - {z}. f w = g w * (w - z) powr of_int x  \<and> g w \<noteq> 0)"
       unfolding P_def by blast
   qed
   ultimately show ?thesis using \<open>not_essential f z\<close> unfolding not_essential_def  by presburger
 qed
 
 lemma not_essential_transform:
   assumes "not_essential g z"
   assumes "\<forall>\<^sub>F w in (at z). g w = f w"
   shows "not_essential f z"
   using assms unfolding not_essential_def
   by (simp add: filterlim_cong is_pole_cong)
 
 lemma isolated_singularity_at_transform:
   assumes "isolated_singularity_at g z"
   assumes "\<forall>\<^sub>F w in (at z). g w = f w"
   shows "isolated_singularity_at f z"
 proof -
   obtain r1 where "r1>0" and r1:"g analytic_on ball z r1 - {z}"
     using assms(1) unfolding isolated_singularity_at_def by auto
   obtain r2 where "r2>0" and r2:" \<forall>x. x \<noteq> z \<and> dist x z < r2 \<longrightarrow> g x = f x"
     using assms(2) unfolding eventually_at by auto
   define r3 where "r3=min r1 r2"
   have "r3>0" unfolding r3_def using \<open>r1>0\<close> \<open>r2>0\<close> by auto
   moreover have "f analytic_on ball z r3 - {z}"
   proof -
     have "g holomorphic_on ball z r3 - {z}"
       using r1 unfolding r3_def by (subst (asm) analytic_on_open,auto)
     then have "f holomorphic_on ball z r3 - {z}"
       using r2 unfolding r3_def
       by (auto simp add:dist_commute elim!:holomorphic_transform)
     then show ?thesis by (subst analytic_on_open,auto)
   qed
   ultimately show ?thesis unfolding isolated_singularity_at_def by auto
 qed
 
 lemma not_essential_powr[singularity_intros]:
   assumes "LIM w (at z). f w :> (at x)"
   shows "not_essential (\<lambda>w. (f w) powr (of_int n)) z"
 proof -
   define fp where "fp=(\<lambda>w. (f w) powr (of_int n))"
   have ?thesis when "n>0"
   proof -
     have "(\<lambda>w.  (f w) ^ (nat n)) \<midarrow>z\<rightarrow> x ^ nat n"
       using that assms unfolding filterlim_at by (auto intro!:tendsto_eq_intros)
     then have "fp \<midarrow>z\<rightarrow> x ^ nat n" unfolding fp_def
       apply (elim Lim_transform_within[where d=1],simp)
       by (metis less_le powr_0 powr_of_int that zero_less_nat_eq zero_power)
     then show ?thesis unfolding not_essential_def fp_def by auto
   qed
   moreover have ?thesis when "n=0"
   proof -
     have "fp \<midarrow>z\<rightarrow> 1 "
       apply (subst tendsto_cong[where g="\<lambda>_.1"])
       using that filterlim_at_within_not_equal[OF assms,of 0] unfolding fp_def by auto
     then show ?thesis unfolding fp_def not_essential_def by auto
   qed
   moreover have ?thesis when "n<0"
   proof (cases "x=0")
     case True
     have "LIM w (at z). inverse ((f w) ^ (nat (-n))) :> at_infinity"
       apply (subst filterlim_inverse_at_iff[symmetric],simp)
       apply (rule filterlim_atI)
       subgoal using assms True that unfolding filterlim_at by (auto intro!:tendsto_eq_intros)
       subgoal using filterlim_at_within_not_equal[OF assms,of 0]
         by (eventually_elim,insert that,auto)
       done
     then have "LIM w (at z). fp w :> at_infinity"
     proof (elim filterlim_mono_eventually)
       show "\<forall>\<^sub>F x in at z. inverse (f x ^ nat (- n)) = fp x"
         using filterlim_at_within_not_equal[OF assms,of 0] unfolding fp_def
         apply eventually_elim
         using powr_of_int that by auto
     qed auto
     then show ?thesis unfolding fp_def not_essential_def is_pole_def by auto
   next
     case False
     let ?xx= "inverse (x ^ (nat (-n)))"
     have "(\<lambda>w. inverse ((f w) ^ (nat (-n)))) \<midarrow>z\<rightarrow>?xx"
       using assms False unfolding filterlim_at by (auto intro!:tendsto_eq_intros)
     then have "fp \<midarrow>z\<rightarrow>?xx"
       apply (elim Lim_transform_within[where d=1],simp)
       unfolding fp_def by (metis inverse_zero nat_mono_iff nat_zero_as_int neg_0_less_iff_less
           not_le power_eq_0_iff powr_0 powr_of_int that)
     then show ?thesis unfolding fp_def not_essential_def by auto
   qed
   ultimately show ?thesis by linarith
 qed
 
 lemma isolated_singularity_at_powr[singularity_intros]:
   assumes "isolated_singularity_at f z" "\<forall>\<^sub>F w in (at z). f w\<noteq>0"
   shows "isolated_singularity_at (\<lambda>w. (f w) powr (of_int n)) z"
 proof -
   obtain r1 where "r1>0" "f analytic_on ball z r1 - {z}"
     using assms(1) unfolding isolated_singularity_at_def by auto
   then have r1:"f holomorphic_on ball z r1 - {z}"
     using analytic_on_open[of "ball z r1-{z}" f] by blast
   obtain r2 where "r2>0" and r2:"\<forall>w. w \<noteq> z \<and> dist w z < r2 \<longrightarrow> f w \<noteq> 0"
     using assms(2) unfolding eventually_at by auto
   define r3 where "r3=min r1 r2"
   have "(\<lambda>w. (f w) powr of_int n) holomorphic_on ball z r3 - {z}"
     apply (rule holomorphic_on_powr_of_int)
     subgoal unfolding r3_def using r1 by auto
     subgoal unfolding r3_def using r2 by (auto simp add:dist_commute)
     done
   moreover have "r3>0" unfolding r3_def using \<open>0 < r1\<close> \<open>0 < r2\<close> by linarith
   ultimately show ?thesis unfolding isolated_singularity_at_def
     apply (subst (asm) analytic_on_open[symmetric])
     by auto
 qed
 
 lemma non_zero_neighbour:
   assumes f_iso:"isolated_singularity_at f z"
       and f_ness:"not_essential f z"
       and f_nconst:"\<exists>\<^sub>Fw in (at z). f w\<noteq>0"
     shows "\<forall>\<^sub>F w in (at z). f w\<noteq>0"
 proof -
   obtain fn fp fr where [simp]:"fp z \<noteq> 0" and "fr > 0"
           and fr: "fp holomorphic_on cball z fr"
                   "\<forall>w\<in>cball z fr - {z}. f w = fp w * (w - z) powr of_int fn \<and> fp w \<noteq> 0"
     using holomorphic_factor_puncture[OF f_iso f_ness f_nconst,THEN ex1_implies_ex] by auto
   have "f w \<noteq> 0" when " w \<noteq> z" "dist w z < fr" for w
   proof -
     have "f w = fp w * (w - z) powr of_int fn" "fp w \<noteq> 0"
       using fr(2)[rule_format, of w] using that by (auto simp add:dist_commute)
     moreover have "(w - z) powr of_int fn \<noteq>0"
       unfolding powr_eq_0_iff using \<open>w\<noteq>z\<close> by auto
     ultimately show ?thesis by auto
   qed
   then show ?thesis using \<open>fr>0\<close> unfolding eventually_at by auto
 qed
 
 lemma non_zero_neighbour_pole:
   assumes "is_pole f z"
   shows "\<forall>\<^sub>F w in (at z). f w\<noteq>0"
   using assms filterlim_at_infinity_imp_eventually_ne[of f "at z" 0]
   unfolding is_pole_def by auto
 
 lemma non_zero_neighbour_alt:
   assumes holo: "f holomorphic_on S"
       and "open S" "connected S" "z \<in> S"  "\<beta> \<in> S" "f \<beta> \<noteq> 0"
     shows "\<forall>\<^sub>F w in (at z). f w\<noteq>0 \<and> w\<in>S"
 proof (cases "f z = 0")
   case True
   from isolated_zeros[OF holo \<open>open S\<close> \<open>connected S\<close> \<open>z \<in> S\<close> True \<open>\<beta> \<in> S\<close> \<open>f \<beta> \<noteq> 0\<close>]
   obtain r where "0 < r" "ball z r \<subseteq> S" "\<forall>w \<in> ball z r - {z}.f w \<noteq> 0" by metis
   then show ?thesis unfolding eventually_at
     apply (rule_tac x=r in exI)
     by (auto simp add:dist_commute)
 next
   case False
   obtain r1 where r1:"r1>0" "\<forall>y. dist z y < r1 \<longrightarrow> f y \<noteq> 0"
     using continuous_at_avoid[of z f, OF _ False] assms(2,4) continuous_on_eq_continuous_at
       holo holomorphic_on_imp_continuous_on by blast
   obtain r2 where r2:"r2>0" "ball z r2 \<subseteq> S"
     using assms(2) assms(4) openE by blast
   show ?thesis unfolding eventually_at
     apply (rule_tac x="min r1 r2" in exI)
     using r1 r2 by (auto simp add:dist_commute)
 qed
 
 lemma not_essential_times[singularity_intros]:
   assumes f_ness:"not_essential f z" and g_ness:"not_essential g z"
   assumes f_iso:"isolated_singularity_at f z" and g_iso:"isolated_singularity_at g z"
   shows "not_essential (\<lambda>w. f w * g w) z"
 proof -
   define fg where "fg = (\<lambda>w. f w * g w)"
   have ?thesis when "\<not> ((\<exists>\<^sub>Fw in (at z). f w\<noteq>0) \<and> (\<exists>\<^sub>Fw in (at z). g w\<noteq>0))"
   proof -
     have "\<forall>\<^sub>Fw in (at z). fg w=0"
       using that[unfolded frequently_def, simplified] unfolding fg_def
       by (auto elim: eventually_rev_mp)
     from tendsto_cong[OF this] have "fg \<midarrow>z\<rightarrow>0" by auto
     then show ?thesis unfolding not_essential_def fg_def by auto
   qed
   moreover have ?thesis when f_nconst:"\<exists>\<^sub>Fw in (at z). f w\<noteq>0" and g_nconst:"\<exists>\<^sub>Fw in (at z). g w\<noteq>0"
   proof -
     obtain fn fp fr where [simp]:"fp z \<noteq> 0" and "fr > 0"
           and fr: "fp holomorphic_on cball z fr"
                   "\<forall>w\<in>cball z fr - {z}. f w = fp w * (w - z) powr of_int fn \<and> fp w \<noteq> 0"
       using holomorphic_factor_puncture[OF f_iso f_ness f_nconst,THEN ex1_implies_ex] by auto
     obtain gn gp gr where [simp]:"gp z \<noteq> 0" and "gr > 0"
           and gr: "gp holomorphic_on cball z gr"
                   "\<forall>w\<in>cball z gr - {z}. g w = gp w * (w - z) powr of_int gn \<and> gp w \<noteq> 0"
       using holomorphic_factor_puncture[OF g_iso g_ness g_nconst,THEN ex1_implies_ex] by auto
 
     define r1 where "r1=(min fr gr)"
     have "r1>0" unfolding r1_def using  \<open>fr>0\<close> \<open>gr>0\<close> by auto
     have fg_times:"fg w = (fp w * gp w) * (w - z) powr (of_int (fn+gn))" and fgp_nz:"fp w*gp w\<noteq>0"
       when "w\<in>ball z r1 - {z}" for w
     proof -
       have "f w = fp w * (w - z) powr of_int fn" "fp w\<noteq>0"
         using fr(2)[rule_format,of w] that unfolding r1_def by auto
       moreover have "g w = gp w * (w - z) powr of_int gn" "gp w \<noteq> 0"
         using gr(2)[rule_format, of w] that unfolding r1_def by auto
       ultimately show "fg w = (fp w * gp w) * (w - z) powr (of_int (fn+gn))" "fp w*gp w\<noteq>0"
         unfolding fg_def by (auto simp add:powr_add)
     qed
 
     have [intro]: "fp \<midarrow>z\<rightarrow>fp z" "gp \<midarrow>z\<rightarrow>gp z"
         using fr(1) \<open>fr>0\<close> gr(1) \<open>gr>0\<close>
         by (meson open_ball ball_subset_cball centre_in_ball
             continuous_on_eq_continuous_at continuous_within holomorphic_on_imp_continuous_on
             holomorphic_on_subset)+
     have ?thesis when "fn+gn>0"
     proof -
       have "(\<lambda>w. (fp w * gp w) * (w - z) ^ (nat (fn+gn))) \<midarrow>z\<rightarrow>0"
         using that by (auto intro!:tendsto_eq_intros)
       then have "fg \<midarrow>z\<rightarrow> 0"
         apply (elim Lim_transform_within[OF _ \<open>r1>0\<close>])
         by (metis (no_types, hide_lams) Diff_iff cball_trivial dist_commute dist_self
               eq_iff_diff_eq_0 fg_times less_le linorder_not_le mem_ball mem_cball powr_of_int
               that)
       then show ?thesis unfolding not_essential_def fg_def by auto
     qed
     moreover have ?thesis when "fn+gn=0"
     proof -
       have "(\<lambda>w. fp w * gp w) \<midarrow>z\<rightarrow>fp z*gp z"
         using that by (auto intro!:tendsto_eq_intros)
       then have "fg \<midarrow>z\<rightarrow> fp z*gp z"
         apply (elim Lim_transform_within[OF _ \<open>r1>0\<close>])
         apply (subst fg_times)
         by (auto simp add:dist_commute that)
       then show ?thesis unfolding not_essential_def fg_def by auto
     qed
     moreover have ?thesis when "fn+gn<0"
     proof -
       have "LIM w (at z). fp w * gp w / (w-z)^nat (-(fn+gn)) :> at_infinity"
         apply (rule filterlim_divide_at_infinity)
         apply (insert that, auto intro!:tendsto_eq_intros filterlim_atI)
         using eventually_at_topological by blast
       then have "is_pole fg z" unfolding is_pole_def
         apply (elim filterlim_transform_within[OF _ _ \<open>r1>0\<close>],simp)
         apply (subst fg_times,simp add:dist_commute)
         apply (subst powr_of_int)
         using that by (auto simp add:field_split_simps)
       then show ?thesis unfolding not_essential_def fg_def by auto
     qed
     ultimately show ?thesis unfolding not_essential_def fg_def by fastforce
   qed
   ultimately show ?thesis by auto
 qed
 
 lemma not_essential_inverse[singularity_intros]:
   assumes f_ness:"not_essential f z"
   assumes f_iso:"isolated_singularity_at f z"
   shows "not_essential (\<lambda>w. inverse (f w)) z"
 proof -
   define vf where "vf = (\<lambda>w. inverse (f w))"
   have ?thesis when "\<not>(\<exists>\<^sub>Fw in (at z). f w\<noteq>0)"
   proof -
     have "\<forall>\<^sub>Fw in (at z). f w=0"
       using that[unfolded frequently_def, simplified] by (auto elim: eventually_rev_mp)
     then have "\<forall>\<^sub>Fw in (at z). vf w=0"
       unfolding vf_def by auto
     from tendsto_cong[OF this] have "vf \<midarrow>z\<rightarrow>0" unfolding vf_def by auto
     then show ?thesis unfolding not_essential_def vf_def by auto
   qed
   moreover have ?thesis when "is_pole f z"
   proof -
     have "vf \<midarrow>z\<rightarrow>0"
       using that filterlim_at filterlim_inverse_at_iff unfolding is_pole_def vf_def by blast
     then show ?thesis unfolding not_essential_def vf_def by auto
   qed
   moreover have ?thesis when "\<exists>x. f\<midarrow>z\<rightarrow>x " and f_nconst:"\<exists>\<^sub>Fw in (at z). f w\<noteq>0"
   proof -
     from that obtain fz where fz:"f\<midarrow>z\<rightarrow>fz" by auto
     have ?thesis when "fz=0"
     proof -
       have "(\<lambda>w. inverse (vf w)) \<midarrow>z\<rightarrow>0"
         using fz that unfolding vf_def by auto
       moreover have "\<forall>\<^sub>F w in at z. inverse (vf w) \<noteq> 0"
         using non_zero_neighbour[OF f_iso f_ness f_nconst]
         unfolding vf_def by auto
       ultimately have "is_pole vf z"
         using filterlim_inverse_at_iff[of vf "at z"] unfolding filterlim_at is_pole_def by auto
       then show ?thesis unfolding not_essential_def vf_def by auto
     qed
     moreover have ?thesis when "fz\<noteq>0"
     proof -
       have "vf \<midarrow>z\<rightarrow>inverse fz"
         using fz that unfolding vf_def by (auto intro:tendsto_eq_intros)
       then show ?thesis unfolding not_essential_def vf_def by auto
     qed
     ultimately show ?thesis by auto
   qed
   ultimately show ?thesis using f_ness unfolding not_essential_def by auto
 qed
 
 lemma isolated_singularity_at_inverse[singularity_intros]:
   assumes f_iso:"isolated_singularity_at f z"
       and f_ness:"not_essential f z"
   shows "isolated_singularity_at (\<lambda>w. inverse (f w)) z"
 proof -
   define vf where "vf = (\<lambda>w. inverse (f w))"
   have ?thesis when "\<not>(\<exists>\<^sub>Fw in (at z). f w\<noteq>0)"
   proof -
     have "\<forall>\<^sub>Fw in (at z). f w=0"
       using that[unfolded frequently_def, simplified] by (auto elim: eventually_rev_mp)
     then have "\<forall>\<^sub>Fw in (at z). vf w=0"
       unfolding vf_def by auto
     then obtain d1 where "d1>0" and d1:"\<forall>x. x \<noteq> z \<and> dist x z < d1 \<longrightarrow> vf x = 0"
       unfolding eventually_at by auto
     then have "vf holomorphic_on ball z d1-{z}"
       apply (rule_tac holomorphic_transform[of "\<lambda>_. 0"])
       by (auto simp add:dist_commute)
     then have "vf analytic_on ball z d1 - {z}"
       by (simp add: analytic_on_open open_delete)
     then show ?thesis using \<open>d1>0\<close> unfolding isolated_singularity_at_def vf_def by auto
   qed
   moreover have ?thesis when f_nconst:"\<exists>\<^sub>Fw in (at z). f w\<noteq>0"
   proof -
     have "\<forall>\<^sub>F w in at z. f w \<noteq> 0" using non_zero_neighbour[OF f_iso f_ness f_nconst] .
     then obtain d1 where d1:"d1>0" "\<forall>x. x \<noteq> z \<and> dist x z < d1 \<longrightarrow> f x \<noteq> 0"
       unfolding eventually_at by auto
     obtain d2 where "d2>0" and d2:"f analytic_on ball z d2 - {z}"
       using f_iso unfolding isolated_singularity_at_def by auto
     define d3 where "d3=min d1 d2"
     have "d3>0" unfolding d3_def using \<open>d1>0\<close> \<open>d2>0\<close> by auto
     moreover have "vf analytic_on ball z d3 - {z}"
       unfolding vf_def
       apply (rule analytic_on_inverse)
       subgoal using d2 unfolding d3_def by (elim analytic_on_subset) auto
       subgoal for w using d1 unfolding d3_def by (auto simp add:dist_commute)
       done
     ultimately show ?thesis unfolding isolated_singularity_at_def vf_def by auto
   qed
   ultimately show ?thesis by auto
 qed
 
 lemma not_essential_divide[singularity_intros]:
   assumes f_ness:"not_essential f z" and g_ness:"not_essential g z"
   assumes f_iso:"isolated_singularity_at f z" and g_iso:"isolated_singularity_at g z"
   shows "not_essential (\<lambda>w. f w / g w) z"
 proof -
   have "not_essential (\<lambda>w. f w * inverse (g w)) z"
     apply (rule not_essential_times[where g="\<lambda>w. inverse (g w)"])
     using assms by (auto intro: isolated_singularity_at_inverse not_essential_inverse)
   then show ?thesis by (simp add:field_simps)
 qed
 
 lemma
   assumes f_iso:"isolated_singularity_at f z"
       and g_iso:"isolated_singularity_at g z"
     shows isolated_singularity_at_times[singularity_intros]:
               "isolated_singularity_at (\<lambda>w. f w * g w) z" and
           isolated_singularity_at_add[singularity_intros]:
               "isolated_singularity_at (\<lambda>w. f w + g w) z"
 proof -
   obtain d1 d2 where "d1>0" "d2>0"
       and d1:"f analytic_on ball z d1 - {z}" and d2:"g analytic_on ball z d2 - {z}"
     using f_iso g_iso unfolding isolated_singularity_at_def by auto
   define d3 where "d3=min d1 d2"
   have "d3>0" unfolding d3_def using \<open>d1>0\<close> \<open>d2>0\<close> by auto
 
   have "(\<lambda>w. f w * g w) analytic_on ball z d3 - {z}"
     apply (rule analytic_on_mult)
     using d1 d2 unfolding d3_def by (auto elim:analytic_on_subset)
   then show "isolated_singularity_at (\<lambda>w. f w * g w) z"
     using \<open>d3>0\<close> unfolding isolated_singularity_at_def by auto
   have "(\<lambda>w. f w + g w) analytic_on ball z d3 - {z}"
     apply (rule analytic_on_add)
     using d1 d2 unfolding d3_def by (auto elim:analytic_on_subset)
   then show "isolated_singularity_at (\<lambda>w. f w + g w) z"
     using \<open>d3>0\<close> unfolding isolated_singularity_at_def by auto
 qed
 
 lemma isolated_singularity_at_uminus[singularity_intros]:
   assumes f_iso:"isolated_singularity_at f z"
   shows "isolated_singularity_at (\<lambda>w. - f w) z"
   using assms unfolding isolated_singularity_at_def using analytic_on_neg by blast
 
 lemma isolated_singularity_at_id[singularity_intros]:
      "isolated_singularity_at (\<lambda>w. w) z"
   unfolding isolated_singularity_at_def by (simp add: gt_ex)
 
 lemma isolated_singularity_at_minus[singularity_intros]:
   assumes f_iso:"isolated_singularity_at f z"
       and g_iso:"isolated_singularity_at g z"
     shows "isolated_singularity_at (\<lambda>w. f w - g w) z"
   using isolated_singularity_at_uminus[THEN isolated_singularity_at_add[OF f_iso,of "\<lambda>w. - g w"]
         ,OF g_iso] by simp
 
 lemma isolated_singularity_at_divide[singularity_intros]:
   assumes f_iso:"isolated_singularity_at f z"
       and g_iso:"isolated_singularity_at g z"
       and g_ness:"not_essential g z"
     shows "isolated_singularity_at (\<lambda>w. f w / g w) z"
   using isolated_singularity_at_inverse[THEN isolated_singularity_at_times[OF f_iso,
           of "\<lambda>w. inverse (g w)"],OF g_iso g_ness] by (simp add:field_simps)
 
 lemma isolated_singularity_at_const[singularity_intros]:
     "isolated_singularity_at (\<lambda>w. c) z"
   unfolding isolated_singularity_at_def by (simp add: gt_ex)
 
 lemma isolated_singularity_at_holomorphic:
   assumes "f holomorphic_on s-{z}" "open s" "z\<in>s"
   shows "isolated_singularity_at f z"
   using assms unfolding isolated_singularity_at_def
   by (metis analytic_on_holomorphic centre_in_ball insert_Diff openE open_delete subset_insert_iff)
 
 subsubsection \<open>The order of non-essential singularities (i.e. removable singularities or poles)\<close>
 
 
 definition\<^marker>\<open>tag important\<close> zorder :: "(complex \<Rightarrow> complex) \<Rightarrow> complex \<Rightarrow> int" where
   "zorder f z = (THE n. (\<exists>h r. r>0 \<and> h holomorphic_on cball z r \<and> h z\<noteq>0
                    \<and> (\<forall>w\<in>cball z r - {z}. f w =  h w * (w-z) powr (of_int n)
                    \<and> h w \<noteq>0)))"
 
 definition\<^marker>\<open>tag important\<close> zor_poly
     ::"[complex \<Rightarrow> complex, complex] \<Rightarrow> complex \<Rightarrow> complex" where
   "zor_poly f z = (SOME h. \<exists>r. r > 0 \<and> h holomorphic_on cball z r \<and> h z \<noteq> 0
                    \<and> (\<forall>w\<in>cball z r - {z}. f w =  h w * (w - z) powr (zorder f z)
                    \<and> h w \<noteq>0))"
 
 lemma zorder_exist:
   fixes f::"complex \<Rightarrow> complex" and z::complex
   defines "n\<equiv>zorder f z" and "g\<equiv>zor_poly f z"
   assumes f_iso:"isolated_singularity_at f z"
       and f_ness:"not_essential f z"
       and f_nconst:"\<exists>\<^sub>Fw in (at z). f w\<noteq>0"
   shows "g z\<noteq>0 \<and> (\<exists>r. r>0 \<and> g holomorphic_on cball z r
     \<and> (\<forall>w\<in>cball z r - {z}. f w  = g w * (w-z) powr n  \<and> g w \<noteq>0))"
 proof -
   define P where "P = (\<lambda>n g r. 0 < r \<and> g holomorphic_on cball z r \<and> g z\<noteq>0
           \<and> (\<forall>w\<in>cball z r - {z}. f w = g w * (w-z) powr (of_int n) \<and> g w\<noteq>0))"
   have "\<exists>!n. \<exists>g r. P n g r"
     using holomorphic_factor_puncture[OF assms(3-)] unfolding P_def by auto
   then have "\<exists>g r. P n g r"
     unfolding n_def P_def zorder_def
     by (drule_tac theI',argo)
   then have "\<exists>r. P n g r"
     unfolding P_def zor_poly_def g_def n_def
     by (drule_tac someI_ex,argo)
   then obtain r1 where "P n g r1" by auto
   then show ?thesis unfolding P_def by auto
 qed
 
 lemma
   fixes f::"complex \<Rightarrow> complex" and z::complex
   assumes f_iso:"isolated_singularity_at f z"
       and f_ness:"not_essential f z"
       and f_nconst:"\<exists>\<^sub>Fw in (at z). f w\<noteq>0"
     shows zorder_inverse: "zorder (\<lambda>w. inverse (f w)) z = - zorder f z"
       and zor_poly_inverse: "\<forall>\<^sub>Fw in (at z). zor_poly (\<lambda>w. inverse (f w)) z w
                                                 = inverse (zor_poly f z w)"
 proof -
   define vf where "vf = (\<lambda>w. inverse (f w))"
   define fn vfn where
     "fn = zorder f z"  and "vfn = zorder vf z"
   define fp vfp where
     "fp = zor_poly f z" and "vfp = zor_poly vf z"
 
   obtain fr where [simp]:"fp z \<noteq> 0" and "fr > 0"
           and fr: "fp holomorphic_on cball z fr"
                   "\<forall>w\<in>cball z fr - {z}. f w = fp w * (w - z) powr of_int fn \<and> fp w \<noteq> 0"
     using zorder_exist[OF f_iso f_ness f_nconst,folded fn_def fp_def]
     by auto
   have fr_inverse: "vf w = (inverse (fp w)) * (w - z) powr (of_int (-fn))"
         and fr_nz: "inverse (fp w)\<noteq>0"
     when "w\<in>ball z fr - {z}" for w
   proof -
     have "f w = fp w * (w - z) powr of_int fn" "fp w\<noteq>0"
       using fr(2)[rule_format,of w] that by auto
     then show "vf w = (inverse (fp w)) * (w - z) powr (of_int (-fn))" "inverse (fp w)\<noteq>0"
       unfolding vf_def by (auto simp add:powr_minus)
   qed
   obtain vfr where [simp]:"vfp z \<noteq> 0" and "vfr>0" and vfr:"vfp holomorphic_on cball z vfr"
       "(\<forall>w\<in>cball z vfr - {z}. vf w = vfp w * (w - z) powr of_int vfn \<and> vfp w \<noteq> 0)"
   proof -
     have "isolated_singularity_at vf z"
       using isolated_singularity_at_inverse[OF f_iso f_ness] unfolding vf_def .
     moreover have "not_essential vf z"
       using not_essential_inverse[OF f_ness f_iso] unfolding vf_def .
     moreover have "\<exists>\<^sub>F w in at z. vf w \<noteq> 0"
       using f_nconst unfolding vf_def by (auto elim:frequently_elim1)
     ultimately show ?thesis using zorder_exist[of vf z, folded vfn_def vfp_def] that by auto
   qed
 
 
   define r1 where "r1 = min fr vfr"
   have "r1>0" using \<open>fr>0\<close> \<open>vfr>0\<close> unfolding r1_def by simp
   show "vfn = - fn"
     apply (rule holomorphic_factor_unique[of r1 vfp z "\<lambda>w. inverse (fp w)" vf])
     subgoal using \<open>r1>0\<close> by simp
     subgoal by simp
     subgoal by simp
     subgoal
     proof (rule ballI)
       fix w assume "w \<in> ball z r1 - {z}"
       then have "w \<in> ball z fr - {z}" "w \<in> cball z vfr - {z}"  unfolding r1_def by auto
       from fr_inverse[OF this(1)] fr_nz[OF this(1)] vfr(2)[rule_format,OF this(2)]
       show "vf w = vfp w * (w - z) powr of_int vfn \<and> vfp w \<noteq> 0
               \<and> vf w = inverse (fp w) * (w - z) powr of_int (- fn) \<and> inverse (fp w) \<noteq> 0" by auto
     qed
     subgoal using vfr(1) unfolding r1_def by (auto intro!:holomorphic_intros)
     subgoal using fr unfolding r1_def by (auto intro!:holomorphic_intros)
     done
 
   have "vfp w = inverse (fp w)" when "w\<in>ball z r1-{z}" for w
   proof -
     have "w \<in> ball z fr - {z}" "w \<in> cball z vfr - {z}"  "w\<noteq>z" using that unfolding r1_def by auto
     from fr_inverse[OF this(1)] fr_nz[OF this(1)] vfr(2)[rule_format,OF this(2)] \<open>vfn = - fn\<close> \<open>w\<noteq>z\<close>
     show ?thesis by auto
   qed
   then show "\<forall>\<^sub>Fw in (at z). vfp w = inverse (fp w)"
     unfolding eventually_at using \<open>r1>0\<close>
     apply (rule_tac x=r1 in exI)
     by (auto simp add:dist_commute)
 qed
 
 lemma
   fixes f g::"complex \<Rightarrow> complex" and z::complex
   assumes f_iso:"isolated_singularity_at f z" and g_iso:"isolated_singularity_at g z"
       and f_ness:"not_essential f z" and g_ness:"not_essential g z"
       and fg_nconst: "\<exists>\<^sub>Fw in (at z). f w * g w\<noteq> 0"
   shows zorder_times:"zorder (\<lambda>w. f w * g w) z = zorder f z + zorder g z" and
         zor_poly_times:"\<forall>\<^sub>Fw in (at z). zor_poly (\<lambda>w. f w * g w) z w
                                                   = zor_poly f z w *zor_poly g z w"
 proof -
   define fg where "fg = (\<lambda>w. f w * g w)"
   define fn gn fgn where
     "fn = zorder f z" and "gn = zorder g z" and "fgn = zorder fg z"
   define fp gp fgp where
     "fp = zor_poly f z" and "gp = zor_poly g z" and "fgp = zor_poly fg z"
   have f_nconst:"\<exists>\<^sub>Fw in (at z). f w \<noteq> 0" and g_nconst:"\<exists>\<^sub>Fw in (at z).g w\<noteq> 0"
     using fg_nconst by (auto elim!:frequently_elim1)
   obtain fr where [simp]:"fp z \<noteq> 0" and "fr > 0"
           and fr: "fp holomorphic_on cball z fr"
                   "\<forall>w\<in>cball z fr - {z}. f w = fp w * (w - z) powr of_int fn \<and> fp w \<noteq> 0"
     using zorder_exist[OF f_iso f_ness f_nconst,folded fp_def fn_def] by auto
   obtain gr where [simp]:"gp z \<noteq> 0" and "gr > 0"
           and gr: "gp holomorphic_on cball z gr"
                   "\<forall>w\<in>cball z gr - {z}. g w = gp w * (w - z) powr of_int gn \<and> gp w \<noteq> 0"
     using zorder_exist[OF g_iso g_ness g_nconst,folded gn_def gp_def] by auto
   define r1 where "r1=min fr gr"
   have "r1>0" unfolding r1_def using \<open>fr>0\<close> \<open>gr>0\<close> by auto
   have fg_times:"fg w = (fp w * gp w) * (w - z) powr (of_int (fn+gn))" and fgp_nz:"fp w*gp w\<noteq>0"
     when "w\<in>ball z r1 - {z}" for w
   proof -
     have "f w = fp w * (w - z) powr of_int fn" "fp w\<noteq>0"
       using fr(2)[rule_format,of w] that unfolding r1_def by auto
     moreover have "g w = gp w * (w - z) powr of_int gn" "gp w \<noteq> 0"
       using gr(2)[rule_format, of w] that unfolding r1_def by auto
     ultimately show "fg w = (fp w * gp w) * (w - z) powr (of_int (fn+gn))" "fp w*gp w\<noteq>0"
       unfolding fg_def by (auto simp add:powr_add)
   qed
 
   obtain fgr where [simp]:"fgp z \<noteq> 0" and "fgr > 0"
           and fgr: "fgp holomorphic_on cball z fgr"
                   "\<forall>w\<in>cball z fgr - {z}. fg w = fgp w * (w - z) powr of_int fgn \<and> fgp w \<noteq> 0"
   proof -
     have "fgp z \<noteq> 0 \<and> (\<exists>r>0. fgp holomorphic_on cball z r
             \<and> (\<forall>w\<in>cball z r - {z}. fg w = fgp w * (w - z) powr of_int fgn \<and> fgp w \<noteq> 0))"
       apply (rule zorder_exist[of fg z, folded fgn_def fgp_def])
       subgoal unfolding fg_def using isolated_singularity_at_times[OF f_iso g_iso] .
       subgoal unfolding fg_def using not_essential_times[OF f_ness g_ness f_iso g_iso] .
       subgoal unfolding fg_def using fg_nconst .
       done
     then show ?thesis using that by blast
   qed
   define r2 where "r2 = min fgr r1"
   have "r2>0" using \<open>r1>0\<close> \<open>fgr>0\<close> unfolding r2_def by simp
   show "fgn = fn + gn "
     apply (rule holomorphic_factor_unique[of r2 fgp z "\<lambda>w. fp w * gp w" fg])
     subgoal using \<open>r2>0\<close> by simp
     subgoal by simp
     subgoal by simp
     subgoal
     proof (rule ballI)
       fix w assume "w \<in> ball z r2 - {z}"
       then have "w \<in> ball z r1 - {z}" "w \<in> cball z fgr - {z}"  unfolding r2_def by auto
       from fg_times[OF this(1)] fgp_nz[OF this(1)] fgr(2)[rule_format,OF this(2)]
       show "fg w = fgp w * (w - z) powr of_int fgn \<and> fgp w \<noteq> 0
               \<and> fg w = fp w * gp w * (w - z) powr of_int (fn + gn) \<and> fp w * gp w \<noteq> 0" by auto
     qed
     subgoal using fgr(1) unfolding r2_def r1_def by (auto intro!:holomorphic_intros)
     subgoal using fr(1) gr(1) unfolding r2_def r1_def by (auto intro!:holomorphic_intros)
     done
 
   have "fgp w = fp w *gp w" when "w\<in>ball z r2-{z}" for w
   proof -
     have "w \<in> ball z r1 - {z}" "w \<in> cball z fgr - {z}" "w\<noteq>z" using that  unfolding r2_def by auto
     from fg_times[OF this(1)] fgp_nz[OF this(1)] fgr(2)[rule_format,OF this(2)] \<open>fgn = fn + gn\<close> \<open>w\<noteq>z\<close>
     show ?thesis by auto
   qed
   then show "\<forall>\<^sub>Fw in (at z). fgp w = fp w * gp w"
     using \<open>r2>0\<close> unfolding eventually_at by (auto simp add:dist_commute)
 qed
 
 lemma
   fixes f g::"complex \<Rightarrow> complex" and z::complex
   assumes f_iso:"isolated_singularity_at f z" and g_iso:"isolated_singularity_at g z"
       and f_ness:"not_essential f z" and g_ness:"not_essential g z"
       and fg_nconst: "\<exists>\<^sub>Fw in (at z). f w * g w\<noteq> 0"
   shows zorder_divide:"zorder (\<lambda>w. f w / g w) z = zorder f z - zorder g z" and
         zor_poly_divide:"\<forall>\<^sub>Fw in (at z). zor_poly (\<lambda>w. f w / g w) z w
                                                   = zor_poly f z w  / zor_poly g z w"
 proof -
   have f_nconst:"\<exists>\<^sub>Fw in (at z). f w \<noteq> 0" and g_nconst:"\<exists>\<^sub>Fw in (at z).g w\<noteq> 0"
     using fg_nconst by (auto elim!:frequently_elim1)
   define vg where "vg=(\<lambda>w. inverse (g w))"
   have "zorder (\<lambda>w. f w * vg w) z = zorder f z + zorder vg z"
     apply (rule zorder_times[OF f_iso _ f_ness,of vg])
     subgoal unfolding vg_def using isolated_singularity_at_inverse[OF g_iso g_ness] .
     subgoal unfolding vg_def using not_essential_inverse[OF g_ness g_iso] .
     subgoal unfolding vg_def using fg_nconst by (auto elim!:frequently_elim1)
     done
   then show "zorder (\<lambda>w. f w / g w) z = zorder f z - zorder g z"
     using zorder_inverse[OF g_iso g_ness g_nconst,folded vg_def] unfolding vg_def
     by (auto simp add:field_simps)
 
   have "\<forall>\<^sub>F w in at z. zor_poly (\<lambda>w. f w * vg w) z w = zor_poly f z w * zor_poly vg z w"
     apply (rule zor_poly_times[OF f_iso _ f_ness,of vg])
     subgoal unfolding vg_def using isolated_singularity_at_inverse[OF g_iso g_ness] .
     subgoal unfolding vg_def using not_essential_inverse[OF g_ness g_iso] .
     subgoal unfolding vg_def using fg_nconst by (auto elim!:frequently_elim1)
     done
   then show "\<forall>\<^sub>Fw in (at z). zor_poly (\<lambda>w. f w / g w) z w = zor_poly f z w  / zor_poly g z w"
     using zor_poly_inverse[OF g_iso g_ness g_nconst,folded vg_def] unfolding vg_def
     apply eventually_elim
     by (auto simp add:field_simps)
 qed
 
 lemma zorder_exist_zero:
   fixes f::"complex \<Rightarrow> complex" and z::complex
   defines "n\<equiv>zorder f z" and "g\<equiv>zor_poly f z"
   assumes  holo: "f holomorphic_on s" and
           "open s" "connected s" "z\<in>s"
       and non_const: "\<exists>w\<in>s. f w \<noteq> 0"
   shows "(if f z=0 then n > 0 else n=0) \<and> (\<exists>r. r>0 \<and> cball z r \<subseteq> s \<and> g holomorphic_on cball z r
     \<and> (\<forall>w\<in>cball z r. f w  = g w * (w-z) ^ nat n  \<and> g w \<noteq>0))"
 proof -
   obtain r where "g z \<noteq> 0" and r: "r>0" "cball z r \<subseteq> s" "g holomorphic_on cball z r"
             "(\<forall>w\<in>cball z r - {z}. f w = g w * (w - z) powr of_int n \<and> g w \<noteq> 0)"
   proof -
     have "g z \<noteq> 0 \<and> (\<exists>r>0. g holomorphic_on cball z r
             \<and> (\<forall>w\<in>cball z r - {z}. f w = g w * (w - z) powr of_int n \<and> g w \<noteq> 0))"
     proof (rule zorder_exist[of f z,folded g_def n_def])
       show "isolated_singularity_at f z" unfolding isolated_singularity_at_def
         using holo assms(4,6)
         by (meson Diff_subset open_ball analytic_on_holomorphic holomorphic_on_subset openE)
       show "not_essential f z" unfolding not_essential_def
         using assms(4,6) at_within_open continuous_on holo holomorphic_on_imp_continuous_on
         by fastforce
       have "\<forall>\<^sub>F w in at z. f w \<noteq> 0 \<and> w\<in>s"
       proof -
         obtain w where "w\<in>s" "f w\<noteq>0" using non_const by auto
         then show ?thesis
           by (rule non_zero_neighbour_alt[OF holo \<open>open s\<close> \<open>connected s\<close> \<open>z\<in>s\<close>])
       qed
       then show "\<exists>\<^sub>F w in at z. f w \<noteq> 0"
         apply (elim eventually_frequentlyE)
         by auto
     qed
     then obtain r1 where "g z \<noteq> 0" "r1>0" and r1:"g holomorphic_on cball z r1"
             "(\<forall>w\<in>cball z r1 - {z}. f w = g w * (w - z) powr of_int n \<and> g w \<noteq> 0)"
       by auto
     obtain r2 where r2: "r2>0" "cball z r2 \<subseteq> s"
       using assms(4,6) open_contains_cball_eq by blast
     define r3 where "r3=min r1 r2"
     have "r3>0" "cball z r3 \<subseteq> s" using \<open>r1>0\<close> r2 unfolding r3_def by auto
     moreover have "g holomorphic_on cball z r3"
       using r1(1) unfolding r3_def by auto
     moreover have "(\<forall>w\<in>cball z r3 - {z}. f w = g w * (w - z) powr of_int n \<and> g w \<noteq> 0)"
       using r1(2) unfolding r3_def by auto
     ultimately show ?thesis using that[of r3] \<open>g z\<noteq>0\<close> by auto
   qed
 
   have if_0:"if f z=0 then n > 0 else n=0"
   proof -
     have "f\<midarrow> z \<rightarrow> f z"
       by (metis assms(4,6,7) at_within_open continuous_on holo holomorphic_on_imp_continuous_on)
     then have "(\<lambda>w. g w * (w - z) powr of_int n) \<midarrow>z\<rightarrow> f z"
       apply (elim Lim_transform_within_open[where s="ball z r"])
       using r by auto
     moreover have "g \<midarrow>z\<rightarrow>g z"
       by (metis (mono_tags, lifting) open_ball at_within_open_subset
           ball_subset_cball centre_in_ball continuous_on holomorphic_on_imp_continuous_on r(1,3) subsetCE)
     ultimately have "(\<lambda>w. (g w * (w - z) powr of_int n) / g w) \<midarrow>z\<rightarrow> f z/g z"
       apply (rule_tac tendsto_divide)
       using \<open>g z\<noteq>0\<close> by auto
     then have powr_tendsto:"(\<lambda>w. (w - z) powr of_int n) \<midarrow>z\<rightarrow> f z/g z"
       apply (elim Lim_transform_within_open[where s="ball z r"])
       using r by auto
 
     have ?thesis when "n\<ge>0" "f z=0"
     proof -
       have "(\<lambda>w. (w - z) ^ nat n) \<midarrow>z\<rightarrow> f z/g z"
         using powr_tendsto
         apply (elim Lim_transform_within[where d=r])
         by (auto simp add: powr_of_int \<open>n\<ge>0\<close> \<open>r>0\<close>)
       then have *:"(\<lambda>w. (w - z) ^ nat n) \<midarrow>z\<rightarrow> 0" using \<open>f z=0\<close> by simp
       moreover have False when "n=0"
       proof -
         have "(\<lambda>w. (w - z) ^ nat n) \<midarrow>z\<rightarrow> 1"
           using \<open>n=0\<close> by auto
         then show False using * using LIM_unique zero_neq_one by blast
       qed
       ultimately show ?thesis using that by fastforce
     qed
     moreover have ?thesis when "n\<ge>0" "f z\<noteq>0"
     proof -
       have False when "n>0"
       proof -
         have "(\<lambda>w. (w - z) ^ nat n) \<midarrow>z\<rightarrow> f z/g z"
           using powr_tendsto
           apply (elim Lim_transform_within[where d=r])
           by (auto simp add: powr_of_int \<open>n\<ge>0\<close> \<open>r>0\<close>)
         moreover have "(\<lambda>w. (w - z) ^ nat n) \<midarrow>z\<rightarrow> 0"
           using \<open>n>0\<close> by (auto intro!:tendsto_eq_intros)
         ultimately show False using \<open>f z\<noteq>0\<close> \<open>g z\<noteq>0\<close> using LIM_unique divide_eq_0_iff by blast
       qed
       then show ?thesis using that by force
     qed
     moreover have False when "n<0"
     proof -
       have "(\<lambda>w. inverse ((w - z) ^ nat (- n))) \<midarrow>z\<rightarrow> f z/g z"
            "(\<lambda>w.((w - z) ^ nat (- n))) \<midarrow>z\<rightarrow> 0"
         subgoal  using powr_tendsto powr_of_int that
           by (elim Lim_transform_within_open[where s=UNIV],auto)
         subgoal using that by (auto intro!:tendsto_eq_intros)
         done
       from tendsto_mult[OF this,simplified]
       have "(\<lambda>x. inverse ((x - z) ^ nat (- n)) * (x - z) ^ nat (- n)) \<midarrow>z\<rightarrow> 0" .
       then have "(\<lambda>x. 1::complex) \<midarrow>z\<rightarrow> 0"
         by (elim Lim_transform_within_open[where s=UNIV],auto)
       then show False using LIM_const_eq by fastforce
     qed
     ultimately show ?thesis by fastforce
   qed
   moreover have "f w  = g w * (w-z) ^ nat n  \<and> g w \<noteq>0" when "w\<in>cball z r" for w
   proof (cases "w=z")
     case True
     then have "f \<midarrow>z\<rightarrow>f w"
       using assms(4,6) at_within_open continuous_on holo holomorphic_on_imp_continuous_on by fastforce
     then have "(\<lambda>w. g w * (w-z) ^ nat n) \<midarrow>z\<rightarrow>f w"
     proof (elim Lim_transform_within[OF _ \<open>r>0\<close>])
       fix x assume "0 < dist x z" "dist x z < r"
       then have "x \<in> cball z r - {z}" "x\<noteq>z"
         unfolding cball_def by (auto simp add: dist_commute)
       then have "f x = g x * (x - z) powr of_int n"
         using r(4)[rule_format,of x] by simp
       also have "... = g x * (x - z) ^ nat n"
         apply (subst powr_of_int)
         using if_0 \<open>x\<noteq>z\<close> by (auto split:if_splits)
       finally show "f x = g x * (x - z) ^ nat n" .
     qed
     moreover have "(\<lambda>w. g w * (w-z) ^ nat n) \<midarrow>z\<rightarrow> g w * (w-z) ^ nat n"
       using True apply (auto intro!:tendsto_eq_intros)
       by (metis open_ball at_within_open_subset ball_subset_cball centre_in_ball
           continuous_on holomorphic_on_imp_continuous_on r(1) r(3) that)
     ultimately have "f w = g w * (w-z) ^ nat n" using LIM_unique by blast
     then show ?thesis using \<open>g z\<noteq>0\<close> True by auto
   next
     case False
     then have "f w = g w * (w - z) powr of_int n \<and> g w \<noteq> 0"
       using r(4) that by auto
     then show ?thesis using False if_0 powr_of_int by (auto split:if_splits)
   qed
   ultimately show ?thesis using r by auto
 qed
 
 lemma zorder_exist_pole:
   fixes f::"complex \<Rightarrow> complex" and z::complex
   defines "n\<equiv>zorder f z" and "g\<equiv>zor_poly f z"
   assumes  holo: "f holomorphic_on s-{z}" and
           "open s" "z\<in>s"
       and "is_pole f z"
   shows "n < 0 \<and> g z\<noteq>0 \<and> (\<exists>r. r>0 \<and> cball z r \<subseteq> s \<and> g holomorphic_on cball z r
     \<and> (\<forall>w\<in>cball z r - {z}. f w  = g w / (w-z) ^ nat (- n) \<and> g w \<noteq>0))"
 proof -
   obtain r where "g z \<noteq> 0" and r: "r>0" "cball z r \<subseteq> s" "g holomorphic_on cball z r"
             "(\<forall>w\<in>cball z r - {z}. f w = g w * (w - z) powr of_int n \<and> g w \<noteq> 0)"
   proof -
     have "g z \<noteq> 0 \<and> (\<exists>r>0. g holomorphic_on cball z r
             \<and> (\<forall>w\<in>cball z r - {z}. f w = g w * (w - z) powr of_int n \<and> g w \<noteq> 0))"
     proof (rule zorder_exist[of f z,folded g_def n_def])
       show "isolated_singularity_at f z" unfolding isolated_singularity_at_def
         using holo assms(4,5)
         by (metis analytic_on_holomorphic centre_in_ball insert_Diff openE open_delete subset_insert_iff)
       show "not_essential f z" unfolding not_essential_def
         using assms(4,6) at_within_open continuous_on holo holomorphic_on_imp_continuous_on
         by fastforce
       from non_zero_neighbour_pole[OF \<open>is_pole f z\<close>] show "\<exists>\<^sub>F w in at z. f w \<noteq> 0"
         apply (elim eventually_frequentlyE)
         by auto
     qed
     then obtain r1 where "g z \<noteq> 0" "r1>0" and r1:"g holomorphic_on cball z r1"
             "(\<forall>w\<in>cball z r1 - {z}. f w = g w * (w - z) powr of_int n \<and> g w \<noteq> 0)"
       by auto
     obtain r2 where r2: "r2>0" "cball z r2 \<subseteq> s"
       using assms(4,5) open_contains_cball_eq by metis
     define r3 where "r3=min r1 r2"
     have "r3>0" "cball z r3 \<subseteq> s" using \<open>r1>0\<close> r2 unfolding r3_def by auto
     moreover have "g holomorphic_on cball z r3"
       using r1(1) unfolding r3_def by auto
     moreover have "(\<forall>w\<in>cball z r3 - {z}. f w = g w * (w - z) powr of_int n \<and> g w \<noteq> 0)"
       using r1(2) unfolding r3_def by auto
     ultimately show ?thesis using that[of r3] \<open>g z\<noteq>0\<close> by auto
   qed
 
   have "n<0"
   proof (rule ccontr)
     assume " \<not> n < 0"
     define c where "c=(if n=0 then g z else 0)"
     have [simp]:"g \<midarrow>z\<rightarrow> g z"
       by (metis open_ball at_within_open ball_subset_cball centre_in_ball
             continuous_on holomorphic_on_imp_continuous_on holomorphic_on_subset r(1) r(3) )
     have "\<forall>\<^sub>F x in at z. f x = g x * (x - z) ^ nat n"
       unfolding eventually_at_topological
       apply (rule_tac exI[where x="ball z r"])
       using r powr_of_int \<open>\<not> n < 0\<close> by auto
     moreover have "(\<lambda>x. g x * (x - z) ^ nat n) \<midarrow>z\<rightarrow>c"
     proof (cases "n=0")
       case True
       then show ?thesis unfolding c_def by simp
     next
       case False
       then have "(\<lambda>x. (x - z) ^ nat n) \<midarrow>z\<rightarrow> 0" using \<open>\<not> n < 0\<close>
         by (auto intro!:tendsto_eq_intros)
       from tendsto_mult[OF _ this,of g "g z",simplified]
       show ?thesis unfolding c_def using False by simp
     qed
     ultimately have "f \<midarrow>z\<rightarrow>c" using tendsto_cong by fast
     then show False using \<open>is_pole f z\<close> at_neq_bot not_tendsto_and_filterlim_at_infinity
       unfolding is_pole_def by blast
   qed
   moreover have "\<forall>w\<in>cball z r - {z}. f w  = g w / (w-z) ^ nat (- n) \<and> g w \<noteq>0"
     using r(4) \<open>n<0\<close> powr_of_int
     by (metis Diff_iff divide_inverse eq_iff_diff_eq_0 insert_iff linorder_not_le)
   ultimately show ?thesis using r(1-3) \<open>g z\<noteq>0\<close> by auto
 qed
 
 lemma zorder_eqI:
   assumes "open s" "z \<in> s" "g holomorphic_on s" "g z \<noteq> 0"
   assumes fg_eq:"\<And>w. \<lbrakk>w \<in> s;w\<noteq>z\<rbrakk> \<Longrightarrow> f w = g w * (w - z) powr n"
   shows   "zorder f z = n"
 proof -
   have "continuous_on s g" by (rule holomorphic_on_imp_continuous_on) fact
   moreover have "open (-{0::complex})" by auto
   ultimately have "open ((g -` (-{0})) \<inter> s)"
     unfolding continuous_on_open_vimage[OF \<open>open s\<close>] by blast
   moreover from assms have "z \<in> (g -` (-{0})) \<inter> s" by auto
   ultimately obtain r where r: "r > 0" "cball z r \<subseteq>  s \<inter> (g -` (-{0}))"
     unfolding open_contains_cball by blast
 
   let ?gg= "(\<lambda>w. g w * (w - z) powr n)"
   define P where "P = (\<lambda>n g r. 0 < r \<and> g holomorphic_on cball z r \<and> g z\<noteq>0
           \<and> (\<forall>w\<in>cball z r - {z}. f w = g w * (w-z) powr (of_int n) \<and> g w\<noteq>0))"
   have "P n g r"
     unfolding P_def using r assms(3,4,5) by auto
   then have "\<exists>g r. P n g r" by auto
   moreover have unique: "\<exists>!n. \<exists>g r. P n g r" unfolding P_def
   proof (rule holomorphic_factor_puncture)
     have "ball z r-{z} \<subseteq> s" using r using ball_subset_cball by blast
     then have "?gg holomorphic_on ball z r-{z}"
       using \<open>g holomorphic_on s\<close> r by (auto intro!: holomorphic_intros)
     then have "f holomorphic_on ball z r - {z}"
       apply (elim holomorphic_transform)
       using fg_eq \<open>ball z r-{z} \<subseteq> s\<close> by auto
     then show "isolated_singularity_at f z" unfolding isolated_singularity_at_def
       using analytic_on_open open_delete r(1) by blast
   next
     have "not_essential ?gg z"
     proof (intro singularity_intros)
       show "not_essential g z"
         by (meson \<open>continuous_on s g\<close> assms(1) assms(2) continuous_on_eq_continuous_at
             isCont_def not_essential_def)
       show " \<forall>\<^sub>F w in at z. w - z \<noteq> 0" by (simp add: eventually_at_filter)
       then show "LIM w at z. w - z :> at 0"
         unfolding filterlim_at by (auto intro:tendsto_eq_intros)
       show "isolated_singularity_at g z"
         by (meson Diff_subset open_ball analytic_on_holomorphic
             assms(1,2,3) holomorphic_on_subset isolated_singularity_at_def openE)
     qed
     then show "not_essential f z"
       apply (elim not_essential_transform)
       unfolding eventually_at using assms(1,2) assms(5)[symmetric]
       by (metis dist_commute mem_ball openE subsetCE)
     show "\<exists>\<^sub>F w in at z. f w \<noteq> 0" unfolding frequently_at
     proof (rule,rule)
       fix d::real assume "0 < d"
       define z' where "z'=z+min d r / 2"
       have "z' \<noteq> z" " dist z' z < d "
         unfolding z'_def using \<open>d>0\<close> \<open>r>0\<close>
         by (auto simp add:dist_norm)
       moreover have "f z' \<noteq> 0"
       proof (subst fg_eq[OF _ \<open>z'\<noteq>z\<close>])
         have "z' \<in> cball z r" unfolding z'_def using \<open>r>0\<close> \<open>d>0\<close> by (auto simp add:dist_norm)
         then show " z' \<in> s" using r(2) by blast
         show "g z' * (z' - z) powr of_int n \<noteq> 0"
           using P_def \<open>P n g r\<close> \<open>z' \<in> cball z r\<close> calculation(1) by auto
       qed
       ultimately show "\<exists>x\<in>UNIV. x \<noteq> z \<and> dist x z < d \<and> f x \<noteq> 0" by auto
     qed
   qed
   ultimately have "(THE n. \<exists>g r. P n g r) = n"
     by (rule_tac the1_equality)
   then show ?thesis unfolding zorder_def P_def by blast
 qed
 
 lemma residue_pole_order:
   fixes f::"complex \<Rightarrow> complex" and z::complex
   defines "n \<equiv> nat (- zorder f z)" and "h \<equiv> zor_poly f z"
   assumes f_iso:"isolated_singularity_at f z"
     and pole:"is_pole f z"
   shows "residue f z = ((deriv ^^ (n - 1)) h z / fact (n-1))"
 proof -
   define g where "g \<equiv> \<lambda>x. if x=z then 0 else inverse (f x)"
   obtain e where [simp]:"e>0" and f_holo:"f holomorphic_on ball z e - {z}"
     using f_iso analytic_imp_holomorphic unfolding isolated_singularity_at_def by blast
   obtain r where "0 < n" "0 < r" and r_cball:"cball z r \<subseteq> ball z e" and h_holo: "h holomorphic_on cball z r"
       and h_divide:"(\<forall>w\<in>cball z r. (w\<noteq>z \<longrightarrow> f w = h w / (w - z) ^ n) \<and> h w \<noteq> 0)"
   proof -
     obtain r where r:"zorder f z < 0" "h z \<noteq> 0" "r>0" "cball z r \<subseteq> ball z e" "h holomorphic_on cball z r"
         "(\<forall>w\<in>cball z r - {z}. f w = h w / (w - z) ^ n \<and> h w \<noteq> 0)"
       using zorder_exist_pole[OF f_holo,simplified,OF \<open>is_pole f z\<close>,folded n_def h_def] by auto
     have "n>0" using \<open>zorder f z < 0\<close> unfolding n_def by simp
     moreover have "(\<forall>w\<in>cball z r. (w\<noteq>z \<longrightarrow> f w = h w / (w - z) ^ n) \<and> h w \<noteq> 0)"
       using \<open>h z\<noteq>0\<close> r(6) by blast
     ultimately show ?thesis using r(3,4,5) that by blast
   qed
   have r_nonzero:"\<And>w. w \<in> ball z r - {z} \<Longrightarrow> f w \<noteq> 0"
     using h_divide by simp
   define c where "c \<equiv> 2 * pi * \<i>"
   define der_f where "der_f \<equiv> ((deriv ^^ (n - 1)) h z / fact (n-1))"
   define h' where "h' \<equiv> \<lambda>u. h u / (u - z) ^ n"
   have "(h' has_contour_integral c / fact (n - 1) * (deriv ^^ (n - 1)) h z) (circlepath z r)"
     unfolding h'_def
     proof (rule Cauchy_has_contour_integral_higher_derivative_circlepath[of z r h z "n-1",
         folded c_def Suc_pred'[OF \<open>n>0\<close>]])
       show "continuous_on (cball z r) h" using holomorphic_on_imp_continuous_on h_holo by simp
       show "h holomorphic_on ball z r" using h_holo by auto
       show " z \<in> ball z r" using \<open>r>0\<close> by auto
     qed
   then have "(h' has_contour_integral c * der_f) (circlepath z r)" unfolding der_f_def by auto
   then have "(f has_contour_integral c * der_f) (circlepath z r)"
     proof (elim has_contour_integral_eq)
       fix x assume "x \<in> path_image (circlepath z r)"
       hence "x\<in>cball z r - {z}" using \<open>r>0\<close> by auto
       then show "h' x = f x" using h_divide unfolding h'_def by auto
     qed
   moreover have "(f has_contour_integral c * residue f z) (circlepath z r)"
     using base_residue[of \<open>ball z e\<close> z,simplified,OF \<open>r>0\<close> f_holo r_cball,folded c_def]
     unfolding c_def by simp
   ultimately have "c * der_f =  c * residue f z" using has_contour_integral_unique by blast
   hence "der_f = residue f z" unfolding c_def by auto
   thus ?thesis unfolding der_f_def by auto
 qed
 
 lemma simple_zeroI:
   assumes "open s" "z \<in> s" "g holomorphic_on s" "g z \<noteq> 0"
   assumes "\<And>w. w \<in> s \<Longrightarrow> f w = g w * (w - z)"
   shows   "zorder f z = 1"
   using assms(1-4) by (rule zorder_eqI) (use assms(5) in auto)
 
 lemma higher_deriv_power:
   shows   "(deriv ^^ j) (\<lambda>w. (w - z) ^ n) w =
              pochhammer (of_nat (Suc n - j)) j * (w - z) ^ (n - j)"
 proof (induction j arbitrary: w)
   case 0
   thus ?case by auto
 next
   case (Suc j w)
   have "(deriv ^^ Suc j) (\<lambda>w. (w - z) ^ n) w = deriv ((deriv ^^ j) (\<lambda>w. (w - z) ^ n)) w"
     by simp
   also have "(deriv ^^ j) (\<lambda>w. (w - z) ^ n) =
                (\<lambda>w. pochhammer (of_nat (Suc n - j)) j * (w - z) ^ (n - j))"
     using Suc by (intro Suc.IH ext)
   also {
     have "(\<dots> has_field_derivative of_nat (n - j) *
                pochhammer (of_nat (Suc n - j)) j * (w - z) ^ (n - Suc j)) (at w)"
       using Suc.prems by (auto intro!: derivative_eq_intros)
     also have "of_nat (n - j) * pochhammer (of_nat (Suc n - j)) j =
                  pochhammer (of_nat (Suc n - Suc j)) (Suc j)"
       by (cases "Suc j \<le> n", subst pochhammer_rec)
          (insert Suc.prems, simp_all add: algebra_simps Suc_diff_le pochhammer_0_left)
     finally have "deriv (\<lambda>w. pochhammer (of_nat (Suc n - j)) j * (w - z) ^ (n - j)) w =
                     \<dots> * (w - z) ^ (n - Suc j)"
       by (rule DERIV_imp_deriv)
   }
   finally show ?case .
 qed
 
 lemma zorder_zero_eqI:
   assumes  f_holo:"f holomorphic_on s" and "open s" "z \<in> s"
   assumes zero: "\<And>i. i < nat n \<Longrightarrow> (deriv ^^ i) f z = 0"
   assumes nz: "(deriv ^^ nat n) f z \<noteq> 0" and "n\<ge>0"
   shows   "zorder f z = n"
 proof -
   obtain r where [simp]:"r>0" and "ball z r \<subseteq> s"
     using \<open>open s\<close> \<open>z\<in>s\<close> openE by blast
   have nz':"\<exists>w\<in>ball z r. f w \<noteq> 0"
   proof (rule ccontr)
     assume "\<not> (\<exists>w\<in>ball z r. f w \<noteq> 0)"
     then have "eventually (\<lambda>u. f u = 0) (nhds z)"
       using \<open>r>0\<close> unfolding eventually_nhds
       apply (rule_tac x="ball z r" in exI)
       by auto
     then have "(deriv ^^ nat n) f z = (deriv ^^ nat n) (\<lambda>_. 0) z"
       by (intro higher_deriv_cong_ev) auto
     also have "(deriv ^^ nat n) (\<lambda>_. 0) z = 0"
       by (induction n) simp_all
     finally show False using nz by contradiction
   qed
 
   define zn g where "zn = zorder f z" and "g = zor_poly f z"
   obtain e where e_if:"if f z = 0 then 0 < zn else zn = 0" and
             [simp]:"e>0" and "cball z e \<subseteq> ball z r" and
             g_holo:"g holomorphic_on cball z e" and
             e_fac:"(\<forall>w\<in>cball z e. f w = g w * (w - z) ^ nat zn \<and> g w \<noteq> 0)"
   proof -
     have "f holomorphic_on ball z r"
       using f_holo \<open>ball z r \<subseteq> s\<close> by auto
     from that zorder_exist_zero[of f "ball z r" z,simplified,OF this nz',folded zn_def g_def]
     show ?thesis by blast
   qed
   from this(1,2,5) have "zn\<ge>0" "g z\<noteq>0"
     subgoal by (auto split:if_splits)
     subgoal using \<open>0 < e\<close> ball_subset_cball centre_in_ball e_fac by blast
     done
 
   define A where "A = (\<lambda>i. of_nat (i choose (nat zn)) * fact (nat zn) * (deriv ^^ (i - nat zn)) g z)"
   have deriv_A:"(deriv ^^ i) f z = (if zn \<le> int i then A i else 0)" for i
   proof -
     have "eventually (\<lambda>w. w \<in> ball z e) (nhds z)"
       using \<open>cball z e \<subseteq> ball z r\<close> \<open>e>0\<close> by (intro eventually_nhds_in_open) auto
     hence "eventually (\<lambda>w. f w = (w - z) ^ (nat zn) * g w) (nhds z)"
       apply eventually_elim
       by (use e_fac in auto)
     hence "(deriv ^^ i) f z = (deriv ^^ i) (\<lambda>w. (w - z) ^ nat zn * g w) z"
       by (intro higher_deriv_cong_ev) auto
     also have "\<dots> = (\<Sum>j=0..i. of_nat (i choose j) *
                        (deriv ^^ j) (\<lambda>w. (w - z) ^ nat zn) z * (deriv ^^ (i - j)) g z)"
       using g_holo \<open>e>0\<close>
       by (intro higher_deriv_mult[of _ "ball z e"]) (auto intro!: holomorphic_intros)
     also have "\<dots> = (\<Sum>j=0..i. if j = nat zn then
                     of_nat (i choose nat zn) * fact (nat zn) * (deriv ^^ (i - nat zn)) g z else 0)"
     proof (intro sum.cong refl, goal_cases)
       case (1 j)
       have "(deriv ^^ j) (\<lambda>w. (w - z) ^ nat zn) z =
               pochhammer (of_nat (Suc (nat zn) - j)) j * 0 ^ (nat zn - j)"
         by (subst higher_deriv_power) auto
       also have "\<dots> = (if j = nat zn then fact j else 0)"
         by (auto simp: not_less pochhammer_0_left pochhammer_fact)
       also have "of_nat (i choose j) * \<dots> * (deriv ^^ (i - j)) g z =
                    (if j = nat zn then of_nat (i choose (nat zn)) * fact (nat zn)
                         * (deriv ^^ (i - nat zn)) g z else 0)"
         by simp
       finally show ?case .
     qed
     also have "\<dots> = (if i \<ge> zn then A i else 0)"
       by (auto simp: A_def)
     finally show "(deriv ^^ i) f z = \<dots>" .
   qed
 
   have False when "n<zn"
   proof -
     have "(deriv ^^ nat n) f z = 0"
       using deriv_A[of "nat n"] that \<open>n\<ge>0\<close> by auto
     with nz show False by auto
   qed
   moreover have "n\<le>zn"
   proof -
     have "g z \<noteq> 0" using e_fac[rule_format,of z] \<open>e>0\<close> by simp
     then have "(deriv ^^ nat zn) f z \<noteq> 0"
       using deriv_A[of "nat zn"] by(auto simp add:A_def)
     then have "nat zn \<ge> nat n" using zero[of "nat zn"] by linarith
     moreover have "zn\<ge>0" using e_if by (auto split:if_splits)
     ultimately show ?thesis using nat_le_eq_zle by blast
   qed
   ultimately show ?thesis unfolding zn_def by fastforce
 qed
 
 lemma
   assumes "eventually (\<lambda>z. f z = g z) (at z)" "z = z'"
   shows zorder_cong:"zorder f z = zorder g z'" and zor_poly_cong:"zor_poly f z = zor_poly g z'"
 proof -
   define P where "P = (\<lambda>ff n h r. 0 < r \<and> h holomorphic_on cball z r \<and> h z\<noteq>0
                     \<and> (\<forall>w\<in>cball z r - {z}. ff w = h w * (w-z) powr (of_int n) \<and> h w\<noteq>0))"
   have "(\<exists>r. P f n h r) = (\<exists>r. P g n h r)" for n h
   proof -
     have *: "\<exists>r. P g n h r" if "\<exists>r. P f n h r" and "eventually (\<lambda>x. f x = g x) (at z)" for f g
     proof -
       from that(1) obtain r1 where r1_P:"P f n h r1" by auto
       from that(2) obtain r2 where "r2>0" and r2_dist:"\<forall>x. x \<noteq> z \<and> dist x z \<le> r2 \<longrightarrow> f x = g x"
         unfolding eventually_at_le by auto
       define r where "r=min r1 r2"
       have "r>0" "h z\<noteq>0" using r1_P \<open>r2>0\<close> unfolding r_def P_def by auto
       moreover have "h holomorphic_on cball z r"
         using r1_P unfolding P_def r_def by auto
       moreover have "g w = h w * (w - z) powr of_int n \<and> h w \<noteq> 0" when "w\<in>cball z r - {z}" for w
       proof -
         have "f w = h w * (w - z) powr of_int n \<and> h w \<noteq> 0"
           using r1_P that unfolding P_def r_def by auto
         moreover have "f w=g w" using r2_dist[rule_format,of w] that unfolding r_def
           by (simp add: dist_commute)
         ultimately show ?thesis by simp
       qed
       ultimately show ?thesis unfolding P_def by auto
     qed
     from assms have eq': "eventually (\<lambda>z. g z = f z) (at z)"
       by (simp add: eq_commute)
     show ?thesis
       by (rule iffI[OF *[OF _ assms(1)] *[OF _ eq']])
   qed
   then show "zorder f z = zorder g z'" "zor_poly f z = zor_poly g z'"
       using \<open>z=z'\<close> unfolding P_def zorder_def zor_poly_def by auto
 qed
 
 lemma zorder_nonzero_div_power:
   assumes "open s" "z \<in> s" "f holomorphic_on s" "f z \<noteq> 0" "n > 0"
   shows  "zorder (\<lambda>w. f w / (w - z) ^ n) z = - n"
   apply (rule zorder_eqI[OF \<open>open s\<close> \<open>z\<in>s\<close> \<open>f holomorphic_on s\<close> \<open>f z\<noteq>0\<close>])
   apply (subst powr_of_int)
   using \<open>n>0\<close> by (auto simp add:field_simps)
 
 lemma zor_poly_eq:
   assumes "isolated_singularity_at f z" "not_essential f z" "\<exists>\<^sub>F w in at z. f w \<noteq> 0"
   shows "eventually (\<lambda>w. zor_poly f z w = f w * (w - z) powr - zorder f z) (at z)"
 proof -
   obtain r where r:"r>0"
        "(\<forall>w\<in>cball z r - {z}. f w = zor_poly f z w * (w - z) powr of_int (zorder f z))"
     using zorder_exist[OF assms] by blast
   then have *: "\<forall>w\<in>ball z r - {z}. zor_poly f z w = f w * (w - z) powr - zorder f z"
     by (auto simp: field_simps powr_minus)
   have "eventually (\<lambda>w. w \<in> ball z r - {z}) (at z)"
     using r eventually_at_ball'[of r z UNIV] by auto
   thus ?thesis by eventually_elim (insert *, auto)
 qed
 
 lemma zor_poly_zero_eq:
   assumes "f holomorphic_on s" "open s" "connected s" "z \<in> s" "\<exists>w\<in>s. f w \<noteq> 0"
   shows "eventually (\<lambda>w. zor_poly f z w = f w / (w - z) ^ nat (zorder f z)) (at z)"
 proof -
   obtain r where r:"r>0"
        "(\<forall>w\<in>cball z r - {z}. f w = zor_poly f z w * (w - z) ^ nat (zorder f z))"
     using zorder_exist_zero[OF assms] by auto
   then have *: "\<forall>w\<in>ball z r - {z}. zor_poly f z w = f w / (w - z) ^ nat (zorder f z)"
     by (auto simp: field_simps powr_minus)
   have "eventually (\<lambda>w. w \<in> ball z r - {z}) (at z)"
     using r eventually_at_ball'[of r z UNIV] by auto
   thus ?thesis by eventually_elim (insert *, auto)
 qed
 
 lemma zor_poly_pole_eq:
   assumes f_iso:"isolated_singularity_at f z" "is_pole f z"
   shows "eventually (\<lambda>w. zor_poly f z w = f w * (w - z) ^ nat (- zorder f z)) (at z)"
 proof -
   obtain e where [simp]:"e>0" and f_holo:"f holomorphic_on ball z e - {z}"
     using f_iso analytic_imp_holomorphic unfolding isolated_singularity_at_def by blast
   obtain r where r:"r>0"
        "(\<forall>w\<in>cball z r - {z}. f w = zor_poly f z w / (w - z) ^ nat (- zorder f z))"
     using zorder_exist_pole[OF f_holo,simplified,OF \<open>is_pole f z\<close>] by auto
   then have *: "\<forall>w\<in>ball z r - {z}. zor_poly f z w = f w * (w - z) ^ nat (- zorder f z)"
     by (auto simp: field_simps)
   have "eventually (\<lambda>w. w \<in> ball z r - {z}) (at z)"
     using r eventually_at_ball'[of r z UNIV] by auto
   thus ?thesis by eventually_elim (insert *, auto)
 qed
 
 lemma zor_poly_eqI:
   fixes f :: "complex \<Rightarrow> complex" and z0 :: complex
   defines "n \<equiv> zorder f z0"
   assumes "isolated_singularity_at f z0" "not_essential f z0" "\<exists>\<^sub>F w in at z0. f w \<noteq> 0"
   assumes lim: "((\<lambda>x. f (g x) * (g x - z0) powr - n) \<longlongrightarrow> c) F"
   assumes g: "filterlim g (at z0) F" and "F \<noteq> bot"
   shows   "zor_poly f z0 z0 = c"
 proof -
   from zorder_exist[OF assms(2-4)] obtain r where
     r: "r > 0" "zor_poly f z0 holomorphic_on cball z0 r"
        "\<And>w. w \<in> cball z0 r - {z0} \<Longrightarrow> f w = zor_poly f z0 w * (w - z0) powr n"
     unfolding n_def by blast
   from r(1) have "eventually (\<lambda>w. w \<in> ball z0 r \<and> w \<noteq> z0) (at z0)"
     using eventually_at_ball'[of r z0 UNIV] by auto
   hence "eventually (\<lambda>w. zor_poly f z0 w = f w * (w - z0) powr - n) (at z0)"
     by eventually_elim (insert r, auto simp: field_simps powr_minus)
   moreover have "continuous_on (ball z0 r) (zor_poly f z0)"
     using r by (intro holomorphic_on_imp_continuous_on) auto
   with r(1,2) have "isCont (zor_poly f z0) z0"
     by (auto simp: continuous_on_eq_continuous_at)
   hence "(zor_poly f z0 \<longlongrightarrow> zor_poly f z0 z0) (at z0)"
     unfolding isCont_def .
   ultimately have "((\<lambda>w. f w * (w - z0) powr - n) \<longlongrightarrow> zor_poly f z0 z0) (at z0)"
     by (blast intro: Lim_transform_eventually)
   hence "((\<lambda>x. f (g x) * (g x - z0) powr - n) \<longlongrightarrow> zor_poly f z0 z0) F"
     by (rule filterlim_compose[OF _ g])
   from tendsto_unique[OF \<open>F \<noteq> bot\<close> this lim] show ?thesis .
 qed
 
 lemma zor_poly_zero_eqI:
   fixes f :: "complex \<Rightarrow> complex" and z0 :: complex
   defines "n \<equiv> zorder f z0"
   assumes "f holomorphic_on A" "open A" "connected A" "z0 \<in> A" "\<exists>z\<in>A. f z \<noteq> 0"
   assumes lim: "((\<lambda>x. f (g x) / (g x - z0) ^ nat n) \<longlongrightarrow> c) F"
   assumes g: "filterlim g (at z0) F" and "F \<noteq> bot"
   shows   "zor_poly f z0 z0 = c"
 proof -
   from zorder_exist_zero[OF assms(2-6)] obtain r where
     r: "r > 0" "cball z0 r \<subseteq> A" "zor_poly f z0 holomorphic_on cball z0 r"
        "\<And>w. w \<in> cball z0 r \<Longrightarrow> f w = zor_poly f z0 w * (w - z0) ^ nat n"
     unfolding n_def by blast
   from r(1) have "eventually (\<lambda>w. w \<in> ball z0 r \<and> w \<noteq> z0) (at z0)"
     using eventually_at_ball'[of r z0 UNIV] by auto
   hence "eventually (\<lambda>w. zor_poly f z0 w = f w / (w - z0) ^ nat n) (at z0)"
     by eventually_elim (insert r, auto simp: field_simps)
   moreover have "continuous_on (ball z0 r) (zor_poly f z0)"
     using r by (intro holomorphic_on_imp_continuous_on) auto
   with r(1,2) have "isCont (zor_poly f z0) z0"
     by (auto simp: continuous_on_eq_continuous_at)
   hence "(zor_poly f z0 \<longlongrightarrow> zor_poly f z0 z0) (at z0)"
     unfolding isCont_def .
   ultimately have "((\<lambda>w. f w / (w - z0) ^ nat n) \<longlongrightarrow> zor_poly f z0 z0) (at z0)"
     by (blast intro: Lim_transform_eventually)
   hence "((\<lambda>x. f (g x) / (g x - z0) ^ nat n) \<longlongrightarrow> zor_poly f z0 z0) F"
     by (rule filterlim_compose[OF _ g])
   from tendsto_unique[OF \<open>F \<noteq> bot\<close> this lim] show ?thesis .
 qed
 
 lemma zor_poly_pole_eqI:
   fixes f :: "complex \<Rightarrow> complex" and z0 :: complex
   defines "n \<equiv> zorder f z0"
   assumes f_iso:"isolated_singularity_at f z0" and "is_pole f z0"
   assumes lim: "((\<lambda>x. f (g x) * (g x - z0) ^ nat (-n)) \<longlongrightarrow> c) F"
   assumes g: "filterlim g (at z0) F" and "F \<noteq> bot"
   shows   "zor_poly f z0 z0 = c"
 proof -
   obtain r where r: "r > 0"  "zor_poly f z0 holomorphic_on cball z0 r"
   proof -
     have "\<exists>\<^sub>F w in at z0. f w \<noteq> 0"
       using non_zero_neighbour_pole[OF \<open>is_pole f z0\<close>] by (auto elim:eventually_frequentlyE)
     moreover have "not_essential f z0" unfolding not_essential_def using \<open>is_pole f z0\<close> by simp
     ultimately show ?thesis using that zorder_exist[OF f_iso,folded n_def] by auto
   qed
   from r(1) have "eventually (\<lambda>w. w \<in> ball z0 r \<and> w \<noteq> z0) (at z0)"
     using eventually_at_ball'[of r z0 UNIV] by auto
   have "eventually (\<lambda>w. zor_poly f z0 w = f w * (w - z0) ^ nat (-n)) (at z0)"
     using zor_poly_pole_eq[OF f_iso \<open>is_pole f z0\<close>] unfolding n_def .
   moreover have "continuous_on (ball z0 r) (zor_poly f z0)"
     using r by (intro holomorphic_on_imp_continuous_on) auto
   with r(1,2) have "isCont (zor_poly f z0) z0"
     by (auto simp: continuous_on_eq_continuous_at)
   hence "(zor_poly f z0 \<longlongrightarrow> zor_poly f z0 z0) (at z0)"
     unfolding isCont_def .
   ultimately have "((\<lambda>w. f w * (w - z0) ^ nat (-n)) \<longlongrightarrow> zor_poly f z0 z0) (at z0)"
     by (blast intro: Lim_transform_eventually)
   hence "((\<lambda>x. f (g x) * (g x - z0) ^ nat (-n)) \<longlongrightarrow> zor_poly f z0 z0) F"
     by (rule filterlim_compose[OF _ g])
   from tendsto_unique[OF \<open>F \<noteq> bot\<close> this lim] show ?thesis .
 qed
 
 lemma residue_simple_pole:
   assumes "isolated_singularity_at f z0"
   assumes "is_pole f z0" "zorder f z0 = - 1"
   shows   "residue f z0 = zor_poly f z0 z0"
   using assms by (subst residue_pole_order) simp_all
 
 lemma residue_simple_pole_limit:
   assumes "isolated_singularity_at f z0"
   assumes "is_pole f z0" "zorder f z0 = - 1"
   assumes "((\<lambda>x. f (g x) * (g x - z0)) \<longlongrightarrow> c) F"
   assumes "filterlim g (at z0) F" "F \<noteq> bot"
   shows   "residue f z0 = c"
 proof -
   have "residue f z0 = zor_poly f z0 z0"
     by (rule residue_simple_pole assms)+
   also have "\<dots> = c"
     apply (rule zor_poly_pole_eqI)
     using assms by auto
   finally show ?thesis .
 qed
 
 lemma lhopital_complex_simple:
   assumes "(f has_field_derivative f') (at z)"
   assumes "(g has_field_derivative g') (at z)"
   assumes "f z = 0" "g z = 0" "g' \<noteq> 0" "f' / g' = c"
   shows   "((\<lambda>w. f w / g w) \<longlongrightarrow> c) (at z)"
 proof -
   have "eventually (\<lambda>w. w \<noteq> z) (at z)"
     by (auto simp: eventually_at_filter)
   hence "eventually (\<lambda>w. ((f w - f z) / (w - z)) / ((g w - g z) / (w - z)) = f w / g w) (at z)"
     by eventually_elim (simp add: assms field_split_simps)
   moreover have "((\<lambda>w. ((f w - f z) / (w - z)) / ((g w - g z) / (w - z))) \<longlongrightarrow> f' / g') (at z)"
     by (intro tendsto_divide has_field_derivativeD assms)
   ultimately have "((\<lambda>w. f w / g w) \<longlongrightarrow> f' / g') (at z)"
     by (blast intro: Lim_transform_eventually)
   with assms show ?thesis by simp
 qed
 
 lemma
   assumes f_holo:"f holomorphic_on s" and g_holo:"g holomorphic_on s"
           and "open s" "connected s" "z \<in> s"
   assumes g_deriv:"(g has_field_derivative g') (at z)"
   assumes "f z \<noteq> 0" "g z = 0" "g' \<noteq> 0"
   shows   porder_simple_pole_deriv: "zorder (\<lambda>w. f w / g w) z = - 1"
     and   residue_simple_pole_deriv: "residue (\<lambda>w. f w / g w) z = f z / g'"
 proof -
   have [simp]:"isolated_singularity_at f z" "isolated_singularity_at g z"
     using isolated_singularity_at_holomorphic[OF _ \<open>open s\<close> \<open>z\<in>s\<close>] f_holo g_holo
     by (meson Diff_subset holomorphic_on_subset)+
   have [simp]:"not_essential f z" "not_essential g z"
     unfolding not_essential_def using f_holo g_holo assms(3,5)
     by (meson continuous_on_eq_continuous_at continuous_within holomorphic_on_imp_continuous_on)+
   have g_nconst:"\<exists>\<^sub>F w in at z. g w \<noteq>0 "
   proof (rule ccontr)
     assume "\<not> (\<exists>\<^sub>F w in at z. g w \<noteq> 0)"
     then have "\<forall>\<^sub>F w in nhds z. g w = 0"
       unfolding eventually_at eventually_nhds frequently_at using \<open>g z = 0\<close>
       by (metis open_ball UNIV_I centre_in_ball dist_commute mem_ball)
     then have "deriv g z = deriv (\<lambda>_. 0) z"
       by (intro deriv_cong_ev) auto
     then have "deriv g z = 0" by auto
     then have "g' = 0" using g_deriv DERIV_imp_deriv by blast
     then show False using \<open>g'\<noteq>0\<close> by auto
   qed
 
   have "zorder (\<lambda>w. f w / g w) z = zorder f z - zorder g z"
   proof -
     have "\<forall>\<^sub>F w in at z. f w \<noteq>0 \<and> w\<in>s"
       apply (rule non_zero_neighbour_alt)
       using assms by auto
     with g_nconst have "\<exists>\<^sub>F w in at z. f w * g w \<noteq> 0"
       by (elim frequently_rev_mp eventually_rev_mp,auto)
     then show ?thesis using zorder_divide[of f z g] by auto
   qed
   moreover have "zorder f z=0"
     apply (rule zorder_zero_eqI[OF f_holo \<open>open s\<close> \<open>z\<in>s\<close>])
     using \<open>f z\<noteq>0\<close> by auto
   moreover have "zorder g z=1"
     apply (rule zorder_zero_eqI[OF g_holo \<open>open s\<close> \<open>z\<in>s\<close>])
     subgoal using assms(8) by auto
     subgoal using DERIV_imp_deriv assms(9) g_deriv by auto
     subgoal by simp
     done
   ultimately show "zorder (\<lambda>w. f w / g w) z = - 1" by auto
 
   show "residue (\<lambda>w. f w / g w) z = f z / g'"
   proof (rule residue_simple_pole_limit[where g=id and F="at z",simplified])
     show "zorder (\<lambda>w. f w / g w) z = - 1" by fact
     show "isolated_singularity_at (\<lambda>w. f w / g w) z"
       by (auto intro: singularity_intros)
     show "is_pole (\<lambda>w. f w / g w) z"
     proof (rule is_pole_divide)
       have "\<forall>\<^sub>F x in at z. g x \<noteq> 0"
         apply (rule non_zero_neighbour)
         using g_nconst by auto
       moreover have "g \<midarrow>z\<rightarrow> 0"
         using DERIV_isCont assms(8) continuous_at g_deriv by force
       ultimately show "filterlim g (at 0) (at z)" unfolding filterlim_at by simp
       show "isCont f z"
         using assms(3,5) continuous_on_eq_continuous_at f_holo holomorphic_on_imp_continuous_on
         by auto
       show "f z \<noteq> 0" by fact
     qed
     show "filterlim id (at z) (at z)" by (simp add: filterlim_iff)
     have "((\<lambda>w. (f w * (w - z)) / g w) \<longlongrightarrow> f z / g') (at z)"
     proof (rule lhopital_complex_simple)
       show "((\<lambda>w. f w * (w - z)) has_field_derivative f z) (at z)"
         using assms by (auto intro!: derivative_eq_intros holomorphic_derivI[OF f_holo])
       show "(g has_field_derivative g') (at z)" by fact
     qed (insert assms, auto)
     then show "((\<lambda>w. (f w / g w) * (w - z)) \<longlongrightarrow> f z / g') (at z)"
       by (simp add: field_split_simps)
   qed
 qed
 
 subsection \<open>The argument principle\<close>
 
 theorem argument_principle:
   fixes f::"complex \<Rightarrow> complex" and poles s:: "complex set"
   defines "pz \<equiv> {w. f w = 0 \<or> w \<in> poles}" \<comment> \<open>\<^term>\<open>pz\<close> is the set of poles and zeros\<close>
   assumes "open s" and
           "connected s" and
           f_holo:"f holomorphic_on s-poles" and
           h_holo:"h holomorphic_on s" and
           "valid_path g" and
           loop:"pathfinish g = pathstart g" and
           path_img:"path_image g \<subseteq> s - pz" and
           homo:"\<forall>z. (z \<notin> s) \<longrightarrow> winding_number g z = 0" and
           finite:"finite pz" and
           poles:"\<forall>p\<in>poles. is_pole f p"
   shows "contour_integral g (\<lambda>x. deriv f x * h x / f x) = 2 * pi * \<i> *
           (\<Sum>p\<in>pz. winding_number g p * h p * zorder f p)"
     (is "?L=?R")
 proof -
   define c where "c \<equiv> 2 * complex_of_real pi * \<i> "
   define ff where "ff \<equiv> (\<lambda>x. deriv f x * h x / f x)"
   define cont where "cont \<equiv> \<lambda>ff p e. (ff has_contour_integral c * zorder f p * h p ) (circlepath p e)"
   define avoid where "avoid \<equiv> \<lambda>p e. \<forall>w\<in>cball p e. w \<in> s \<and> (w \<noteq> p \<longrightarrow> w \<notin> pz)"
 
   have "\<exists>e>0. avoid p e \<and> (p\<in>pz \<longrightarrow> cont ff p e)" when "p\<in>s" for p
   proof -
     obtain e1 where "e1>0" and e1_avoid:"avoid p e1"
       using finite_cball_avoid[OF \<open>open s\<close> finite] \<open>p\<in>s\<close> unfolding avoid_def by auto
     have "\<exists>e2>0. cball p e2 \<subseteq> ball p e1 \<and> cont ff p e2" when "p\<in>pz"
     proof -
       define po where "po \<equiv> zorder f p"
       define pp where "pp \<equiv> zor_poly f p"
       define f' where "f' \<equiv> \<lambda>w. pp w * (w - p) powr po"
       define ff' where "ff' \<equiv> (\<lambda>x. deriv f' x * h x / f' x)"
       obtain r where "pp p\<noteq>0" "r>0" and
           "r<e1" and
           pp_holo:"pp holomorphic_on cball p r" and
           pp_po:"(\<forall>w\<in>cball p r-{p}. f w = pp w * (w - p) powr po \<and> pp w \<noteq> 0)"
       proof -
         have "isolated_singularity_at f p"
         proof -
           have "f holomorphic_on ball p e1 - {p}"
             apply (intro holomorphic_on_subset[OF f_holo])
             using e1_avoid \<open>p\<in>pz\<close> unfolding avoid_def pz_def by force
           then show ?thesis unfolding isolated_singularity_at_def
             using \<open>e1>0\<close> analytic_on_open open_delete by blast
         qed
         moreover have "not_essential f p"
         proof (cases "is_pole f p")
           case True
           then show ?thesis unfolding not_essential_def by auto
         next
           case False
           then have "p\<in>s-poles" using \<open>p\<in>s\<close> poles unfolding pz_def by auto
           moreover have "open (s-poles)"
             using \<open>open s\<close>
             apply (elim open_Diff)
             apply (rule finite_imp_closed)
             using finite unfolding pz_def by simp
           ultimately have "isCont f p"
             using holomorphic_on_imp_continuous_on[OF f_holo] continuous_on_eq_continuous_at
             by auto
           then show ?thesis unfolding isCont_def not_essential_def by auto
         qed
         moreover have "\<exists>\<^sub>F w in at p. f w \<noteq> 0 "
         proof (rule ccontr)
           assume "\<not> (\<exists>\<^sub>F w in at p. f w \<noteq> 0)"
           then have "\<forall>\<^sub>F w in at p. f w= 0" unfolding frequently_def by auto
           then obtain rr where "rr>0" "\<forall>w\<in>ball p rr - {p}. f w =0"
             unfolding eventually_at by (auto simp add:dist_commute)
           then have "ball p rr - {p} \<subseteq> {w\<in>ball p rr-{p}. f w=0}" by blast
           moreover have "infinite (ball p rr - {p})" using \<open>rr>0\<close> using finite_imp_not_open by fastforce
           ultimately have "infinite {w\<in>ball p rr-{p}. f w=0}" using infinite_super by blast
           then have "infinite pz"
             unfolding pz_def infinite_super by auto
           then show False using \<open>finite pz\<close> by auto
         qed
         ultimately obtain r where "pp p \<noteq> 0" and r:"r>0" "pp holomorphic_on cball p r"
                   "(\<forall>w\<in>cball p r - {p}. f w = pp w * (w - p) powr of_int po \<and> pp w \<noteq> 0)"
           using zorder_exist[of f p,folded po_def pp_def] by auto
         define r1 where "r1=min r e1 / 2"
         have "r1<e1" unfolding r1_def using \<open>e1>0\<close> \<open>r>0\<close> by auto
         moreover have "r1>0" "pp holomorphic_on cball p r1"
                   "(\<forall>w\<in>cball p r1 - {p}. f w = pp w * (w - p) powr of_int po \<and> pp w \<noteq> 0)"
           unfolding r1_def using \<open>e1>0\<close> r by auto
         ultimately show ?thesis using that \<open>pp p\<noteq>0\<close> by auto
       qed
 
       define e2 where "e2 \<equiv> r/2"
       have "e2>0" using \<open>r>0\<close> unfolding e2_def by auto
       define anal where "anal \<equiv> \<lambda>w. deriv pp w * h w / pp w"
       define prin where "prin \<equiv> \<lambda>w. po * h w / (w - p)"
       have "((\<lambda>w.  prin w + anal w) has_contour_integral c * po * h p) (circlepath p e2)"
       proof (rule has_contour_integral_add[of _ _ _ _ 0,simplified])
         have "ball p r \<subseteq> s"
           using \<open>r<e1\<close> avoid_def ball_subset_cball e1_avoid by (simp add: subset_eq)
         then have "cball p e2 \<subseteq> s"
           using \<open>r>0\<close> unfolding e2_def by auto
         then have "(\<lambda>w. po * h w) holomorphic_on cball p e2"
           using h_holo by (auto intro!: holomorphic_intros)
         then show "(prin has_contour_integral c * po * h p ) (circlepath p e2)"
           using Cauchy_integral_circlepath_simple[folded c_def, of "\<lambda>w. po * h w"] \<open>e2>0\<close>
           unfolding prin_def by (auto simp add: mult.assoc)
         have "anal holomorphic_on ball p r" unfolding anal_def
           using pp_holo h_holo pp_po \<open>ball p r \<subseteq> s\<close> \<open>pp p\<noteq>0\<close>
           by (auto intro!: holomorphic_intros)
         then show "(anal has_contour_integral 0) (circlepath p e2)"
           using e2_def \<open>r>0\<close>
           by (auto elim!: Cauchy_theorem_disc_simple)
       qed
       then have "cont ff' p e2" unfolding cont_def po_def
       proof (elim has_contour_integral_eq)
         fix w assume "w \<in> path_image (circlepath p e2)"
         then have "w\<in>ball p r" and "w\<noteq>p" unfolding e2_def using \<open>r>0\<close> by auto
         define wp where "wp \<equiv> w-p"
         have "wp\<noteq>0" and "pp w \<noteq>0"
           unfolding wp_def using \<open>w\<noteq>p\<close> \<open>w\<in>ball p r\<close> pp_po by auto
         moreover have der_f':"deriv f' w = po * pp w * (w-p) powr (po - 1) + deriv pp w * (w-p) powr po"
         proof (rule DERIV_imp_deriv)
           have "(pp has_field_derivative (deriv pp w)) (at w)"
             using DERIV_deriv_iff_has_field_derivative pp_holo \<open>w\<noteq>p\<close>
             by (meson open_ball \<open>w \<in> ball p r\<close> ball_subset_cball holomorphic_derivI holomorphic_on_subset)
           then show " (f' has_field_derivative of_int po * pp w * (w - p) powr of_int (po - 1)
                   + deriv pp w * (w - p) powr of_int po) (at w)"
             unfolding f'_def using \<open>w\<noteq>p\<close>
             by (auto intro!: derivative_eq_intros DERIV_cong[OF has_field_derivative_powr_of_int])
         qed
         ultimately show "prin w + anal w = ff' w"
           unfolding ff'_def prin_def anal_def
           apply simp
           apply (unfold f'_def)
           apply (fold wp_def)
           apply (auto simp add:field_simps)
           by (metis (no_types, lifting) diff_add_cancel mult.commute powr_add powr_to_1)
       qed
       then have "cont ff p e2" unfolding cont_def
       proof (elim has_contour_integral_eq)
         fix w assume "w \<in> path_image (circlepath p e2)"
         then have "w\<in>ball p r" and "w\<noteq>p" unfolding e2_def using \<open>r>0\<close> by auto
         have "deriv f' w =  deriv f w"
         proof (rule complex_derivative_transform_within_open[where s="ball p r - {p}"])
           show "f' holomorphic_on ball p r - {p}" unfolding f'_def using pp_holo
             by (auto intro!: holomorphic_intros)
         next
           have "ball p e1 - {p} \<subseteq> s - poles"
             using ball_subset_cball e1_avoid[unfolded avoid_def] unfolding pz_def
             by auto
           then have "ball p r - {p} \<subseteq> s - poles"
             apply (elim dual_order.trans)
             using \<open>r<e1\<close> by auto
           then show "f holomorphic_on ball p r - {p}" using f_holo
             by auto
         next
           show "open (ball p r - {p})" by auto
           show "w \<in> ball p r - {p}" using \<open>w\<in>ball p r\<close> \<open>w\<noteq>p\<close> by auto
         next
           fix x assume "x \<in> ball p r - {p}"
           then show "f' x = f x"
             using pp_po unfolding f'_def by auto
         qed
         moreover have " f' w  =  f w "
           using \<open>w \<in> ball p r\<close> ball_subset_cball subset_iff pp_po \<open>w\<noteq>p\<close>
           unfolding f'_def by auto
         ultimately show "ff' w = ff w"
           unfolding ff'_def ff_def by simp
       qed
       moreover have "cball p e2 \<subseteq> ball p e1"
         using \<open>0 < r\<close> \<open>r<e1\<close> e2_def by auto
       ultimately show ?thesis using \<open>e2>0\<close> by auto
     qed
     then obtain e2 where e2:"p\<in>pz \<longrightarrow> e2>0 \<and> cball p e2 \<subseteq> ball p e1 \<and> cont ff p e2"
       by auto
     define e4 where "e4 \<equiv> if p\<in>pz then e2 else  e1"
     have "e4>0" using e2 \<open>e1>0\<close> unfolding e4_def by auto
     moreover have "avoid p e4" using e2 \<open>e1>0\<close> e1_avoid unfolding e4_def avoid_def by auto
     moreover have "p\<in>pz \<longrightarrow> cont ff p e4"
       by (auto simp add: e2 e4_def)
     ultimately show ?thesis by auto
   qed
   then obtain get_e where get_e:"\<forall>p\<in>s. get_e p>0 \<and> avoid p (get_e p)
       \<and> (p\<in>pz \<longrightarrow> cont ff p (get_e p))"
     by metis
   define ci where "ci \<equiv> \<lambda>p. contour_integral (circlepath p (get_e p)) ff"
   define w where "w \<equiv> \<lambda>p. winding_number g p"
   have "contour_integral g ff = (\<Sum>p\<in>pz. w p * ci p)" unfolding ci_def w_def
   proof (rule Cauchy_theorem_singularities[OF \<open>open s\<close> \<open>connected s\<close> finite _ \<open>valid_path g\<close> loop
         path_img homo])
     have "open (s - pz)" using open_Diff[OF _ finite_imp_closed[OF finite]] \<open>open s\<close> by auto
     then show "ff holomorphic_on s - pz" unfolding ff_def using f_holo h_holo
       by (auto intro!: holomorphic_intros simp add:pz_def)
   next
     show "\<forall>p\<in>s. 0 < get_e p \<and> (\<forall>w\<in>cball p (get_e p). w \<in> s \<and> (w \<noteq> p \<longrightarrow> w \<notin> pz))"
       using get_e using avoid_def by blast
   qed
   also have "... = (\<Sum>p\<in>pz. c * w p * h p * zorder f p)"
   proof (rule sum.cong[of pz pz,simplified])
     fix p assume "p \<in> pz"
     show "w p * ci p = c * w p * h p * (zorder f p)"
     proof (cases "p\<in>s")
       assume "p \<in> s"
       have "ci p = c * h p * (zorder f p)" unfolding ci_def
         apply (rule contour_integral_unique)
         using get_e \<open>p\<in>s\<close> \<open>p\<in>pz\<close> unfolding cont_def by (metis mult.assoc mult.commute)
       thus ?thesis by auto
     next
       assume "p\<notin>s"
       then have "w p=0" using homo unfolding w_def by auto
       then show ?thesis by auto
     qed
   qed
   also have "... = c*(\<Sum>p\<in>pz. w p * h p * zorder f p)"
     unfolding sum_distrib_left by (simp add:algebra_simps)
   finally have "contour_integral g ff = c * (\<Sum>p\<in>pz. w p * h p * of_int (zorder f p))" .
   then show ?thesis unfolding ff_def c_def w_def by simp
 qed
 
 subsection \<open>Rouche's theorem \<close>
 
 theorem Rouche_theorem:
   fixes f g::"complex \<Rightarrow> complex" and s:: "complex set"
   defines "fg\<equiv>(\<lambda>p. f p + g p)"
   defines "zeros_fg\<equiv>{p. fg p = 0}" and "zeros_f\<equiv>{p. f p = 0}"
   assumes
     "open s" and "connected s" and
     "finite zeros_fg" and
     "finite zeros_f" and
     f_holo:"f holomorphic_on s" and
     g_holo:"g holomorphic_on s" and
     "valid_path \<gamma>" and
     loop:"pathfinish \<gamma> = pathstart \<gamma>" and
     path_img:"path_image \<gamma> \<subseteq> s " and
     path_less:"\<forall>z\<in>path_image \<gamma>. cmod(f z) > cmod(g z)" and
     homo:"\<forall>z. (z \<notin> s) \<longrightarrow> winding_number \<gamma> z = 0"
   shows "(\<Sum>p\<in>zeros_fg. winding_number \<gamma> p * zorder fg p)
           = (\<Sum>p\<in>zeros_f. winding_number \<gamma> p * zorder f p)"
 proof -
   have path_fg:"path_image \<gamma> \<subseteq> s - zeros_fg"
   proof -
     have False when "z\<in>path_image \<gamma>" and "f z + g z=0" for z
     proof -
       have "cmod (f z) > cmod (g z)" using \<open>z\<in>path_image \<gamma>\<close> path_less by auto
       moreover have "f z = - g z"  using \<open>f z + g z =0\<close> by (simp add: eq_neg_iff_add_eq_0)
       then have "cmod (f z) = cmod (g z)" by auto
       ultimately show False by auto
     qed
     then show ?thesis unfolding zeros_fg_def fg_def using path_img by auto
   qed
   have path_f:"path_image \<gamma> \<subseteq> s - zeros_f"
   proof -
     have False when "z\<in>path_image \<gamma>" and "f z =0" for z
     proof -
       have "cmod (g z) < cmod (f z) " using \<open>z\<in>path_image \<gamma>\<close> path_less by auto
       then have "cmod (g z) < 0" using \<open>f z=0\<close> by auto
       then show False by auto
     qed
     then show ?thesis unfolding zeros_f_def using path_img by auto
   qed
   define w where "w \<equiv> \<lambda>p. winding_number \<gamma> p"
   define c where "c \<equiv> 2 * complex_of_real pi * \<i>"
   define h where "h \<equiv> \<lambda>p. g p / f p + 1"
   obtain spikes
     where "finite spikes" and spikes: "\<forall>x\<in>{0..1} - spikes. \<gamma> differentiable at x"
     using \<open>valid_path \<gamma>\<close>
     by (auto simp: valid_path_def piecewise_C1_differentiable_on_def C1_differentiable_on_eq)
   have h_contour:"((\<lambda>x. deriv h x / h x) has_contour_integral 0) \<gamma>"
   proof -
     have outside_img:"0 \<in> outside (path_image (h o \<gamma>))"
     proof -
       have "h p \<in> ball 1 1" when "p\<in>path_image \<gamma>" for p
       proof -
         have "cmod (g p/f p) <1" using path_less[rule_format,OF that]
           apply (cases "cmod (f p) = 0")
           by (auto simp add: norm_divide)
         then show ?thesis unfolding h_def by (auto simp add:dist_complex_def)
       qed
       then have "path_image (h o \<gamma>) \<subseteq> ball 1 1"
         by (simp add: image_subset_iff path_image_compose)
       moreover have " (0::complex) \<notin> ball 1 1" by (simp add: dist_norm)
       ultimately show "?thesis"
         using  convex_in_outside[of "ball 1 1" 0] outside_mono by blast
     qed
     have valid_h:"valid_path (h \<circ> \<gamma>)"
     proof (rule valid_path_compose_holomorphic[OF \<open>valid_path \<gamma>\<close> _ _ path_f])
       show "h holomorphic_on s - zeros_f"
         unfolding h_def using f_holo g_holo
         by (auto intro!: holomorphic_intros simp add:zeros_f_def)
     next
       show "open (s - zeros_f)" using \<open>finite zeros_f\<close> \<open>open s\<close> finite_imp_closed
         by auto
     qed
     have "((\<lambda>z. 1/z) has_contour_integral 0) (h \<circ> \<gamma>)"
     proof -
       have "0 \<notin> path_image (h \<circ> \<gamma>)" using outside_img by (simp add: outside_def)
       then have "((\<lambda>z. 1/z) has_contour_integral c * winding_number (h \<circ> \<gamma>) 0) (h \<circ> \<gamma>)"
         using has_contour_integral_winding_number[of "h o \<gamma>" 0,simplified] valid_h
         unfolding c_def by auto
       moreover have "winding_number (h o \<gamma>) 0 = 0"
       proof -
         have "0 \<in> outside (path_image (h \<circ> \<gamma>))" using outside_img .
         moreover have "path (h o \<gamma>)"
           using valid_h  by (simp add: valid_path_imp_path)
         moreover have "pathfinish (h o \<gamma>) = pathstart (h o \<gamma>)"
           by (simp add: loop pathfinish_compose pathstart_compose)
         ultimately show ?thesis using winding_number_zero_in_outside by auto
       qed
       ultimately show ?thesis by auto
     qed
     moreover have "vector_derivative (h \<circ> \<gamma>) (at x) = vector_derivative \<gamma> (at x) * deriv h (\<gamma> x)"
       when "x\<in>{0..1} - spikes" for x
     proof (rule vector_derivative_chain_at_general)
       show "\<gamma> differentiable at x" using that \<open>valid_path \<gamma>\<close> spikes by auto
     next
       define der where "der \<equiv> \<lambda>p. (deriv g p * f p - g p * deriv f p)/(f p * f p)"
       define t where "t \<equiv> \<gamma> x"
       have "f t\<noteq>0" unfolding zeros_f_def t_def
         by (metis DiffD1 image_eqI norm_not_less_zero norm_zero path_defs(4) path_less that)
       moreover have "t\<in>s"
         using contra_subsetD path_image_def path_fg t_def that by fastforce
       ultimately have "(h has_field_derivative der t) (at t)"
         unfolding h_def der_def using g_holo f_holo \<open>open s\<close>
         by (auto intro!: holomorphic_derivI derivative_eq_intros)
       then show "h field_differentiable at (\<gamma> x)"
         unfolding t_def field_differentiable_def by blast
     qed
     then have " ((/) 1 has_contour_integral 0) (h \<circ> \<gamma>)
                   = ((\<lambda>x. deriv h x / h x) has_contour_integral 0) \<gamma>"
       unfolding has_contour_integral
       apply (intro has_integral_spike_eq[OF negligible_finite, OF \<open>finite spikes\<close>])
       by auto
     ultimately show ?thesis by auto
   qed
   then have "contour_integral \<gamma> (\<lambda>x. deriv h x / h x) = 0"
     using  contour_integral_unique by simp
   moreover have "contour_integral \<gamma> (\<lambda>x. deriv fg x / fg x) = contour_integral \<gamma> (\<lambda>x. deriv f x / f x)
       + contour_integral \<gamma> (\<lambda>p. deriv h p / h p)"
   proof -
     have "(\<lambda>p. deriv f p / f p) contour_integrable_on \<gamma>"
     proof (rule contour_integrable_holomorphic_simple[OF _ _ \<open>valid_path \<gamma>\<close> path_f])
       show "open (s - zeros_f)" using finite_imp_closed[OF \<open>finite zeros_f\<close>] \<open>open s\<close>
         by auto
       then show "(\<lambda>p. deriv f p / f p) holomorphic_on s - zeros_f"
         using f_holo
         by (auto intro!: holomorphic_intros simp add:zeros_f_def)
     qed
     moreover have "(\<lambda>p. deriv h p / h p) contour_integrable_on \<gamma>"
       using h_contour
       by (simp add: has_contour_integral_integrable)
     ultimately have "contour_integral \<gamma> (\<lambda>x. deriv f x / f x + deriv h x / h x) =
                         contour_integral \<gamma> (\<lambda>p. deriv f p / f p) + contour_integral \<gamma> (\<lambda>p. deriv h p / h p)"
       using contour_integral_add[of "(\<lambda>p. deriv f p / f p)" \<gamma> "(\<lambda>p. deriv h p / h p)" ]
       by auto
     moreover have "deriv fg p / fg p =  deriv f p / f p + deriv h p / h p"
                       when "p\<in> path_image \<gamma>" for p
     proof -
       have "fg p\<noteq>0" and "f p\<noteq>0" using path_f path_fg that unfolding zeros_f_def zeros_fg_def
         by auto
       have "h p\<noteq>0"
       proof (rule ccontr)
         assume "\<not> h p \<noteq> 0"
         then have "g p / f p= -1" unfolding h_def by (simp add: add_eq_0_iff2)
         then have "cmod (g p/f p) = 1" by auto
         moreover have "cmod (g p/f p) <1" using path_less[rule_format,OF that]
           apply (cases "cmod (f p) = 0")
           by (auto simp add: norm_divide)
         ultimately show False by auto
       qed
       have der_fg:"deriv fg p =  deriv f p + deriv g p" unfolding fg_def
         using f_holo g_holo holomorphic_on_imp_differentiable_at[OF _  \<open>open s\<close>] path_img that
         by auto
       have der_h:"deriv h p = (deriv g p * f p - g p * deriv f p)/(f p * f p)"
       proof -
         define der where "der \<equiv> \<lambda>p. (deriv g p * f p - g p * deriv f p)/(f p * f p)"
         have "p\<in>s" using path_img that by auto
         then have "(h has_field_derivative der p) (at p)"
           unfolding h_def der_def using g_holo f_holo \<open>open s\<close> \<open>f p\<noteq>0\<close>
           by (auto intro!: derivative_eq_intros holomorphic_derivI)
         then show ?thesis unfolding der_def using DERIV_imp_deriv by auto
       qed
       show ?thesis
         apply (simp only:der_fg der_h)
         apply (auto simp add:field_simps \<open>h p\<noteq>0\<close> \<open>f p\<noteq>0\<close> \<open>fg p\<noteq>0\<close>)
         by (auto simp add:field_simps h_def \<open>f p\<noteq>0\<close> fg_def)
     qed
     then have "contour_integral \<gamma> (\<lambda>p. deriv fg p / fg p)
                   = contour_integral \<gamma> (\<lambda>p. deriv f p / f p + deriv h p / h p)"
       by (elim contour_integral_eq)
     ultimately show ?thesis by auto
   qed
   moreover have "contour_integral \<gamma> (\<lambda>x. deriv fg x / fg x) = c * (\<Sum>p\<in>zeros_fg. w p * zorder fg p)"
     unfolding c_def zeros_fg_def w_def
   proof (rule argument_principle[OF \<open>open s\<close> \<open>connected s\<close> _ _ \<open>valid_path \<gamma>\<close> loop _ homo
         , of _ "{}" "\<lambda>_. 1",simplified])
     show "fg holomorphic_on s" unfolding fg_def using f_holo g_holo holomorphic_on_add by auto
     show "path_image \<gamma> \<subseteq> s - {p. fg p = 0}" using path_fg unfolding zeros_fg_def .
     show " finite {p. fg p = 0}" using \<open>finite zeros_fg\<close> unfolding zeros_fg_def .
   qed
   moreover have "contour_integral \<gamma> (\<lambda>x. deriv f x / f x) = c * (\<Sum>p\<in>zeros_f. w p * zorder f p)"
     unfolding c_def zeros_f_def w_def
   proof (rule argument_principle[OF \<open>open s\<close> \<open>connected s\<close> _ _ \<open>valid_path \<gamma>\<close> loop _ homo
         , of _ "{}" "\<lambda>_. 1",simplified])
     show "f holomorphic_on s" using f_holo g_holo holomorphic_on_add by auto
     show "path_image \<gamma> \<subseteq> s - {p. f p = 0}" using path_f unfolding zeros_f_def .
     show " finite {p. f p = 0}" using \<open>finite zeros_f\<close> unfolding zeros_f_def .
   qed
   ultimately have " c* (\<Sum>p\<in>zeros_fg. w p * (zorder fg p)) = c* (\<Sum>p\<in>zeros_f. w p * (zorder f p))"
     by auto
   then show ?thesis unfolding c_def using w_def by auto
 qed
 
 end
diff --git a/src/HOL/Analysis/Derivative.thy b/src/HOL/Analysis/Derivative.thy
--- a/src/HOL/Analysis/Derivative.thy
+++ b/src/HOL/Analysis/Derivative.thy
@@ -1,2902 +1,2966 @@
 (*  Title:      HOL/Analysis/Derivative.thy
     Author:     John Harrison
     Author:     Robert Himmelmann, TU Muenchen (translation from HOL Light); tidied by LCP
 *)
 
 section \<open>Derivative\<close>
 
 theory Derivative
   imports
     Convex_Euclidean_Space
     Abstract_Limits
     Operator_Norm
     Uniform_Limit
     Bounded_Linear_Function
     Line_Segment
 begin
 
 declare bounded_linear_inner_left [intro]
 
 declare has_derivative_bounded_linear[dest]
 
 subsection \<open>Derivatives\<close>
 
 lemma has_derivative_add_const:
   "(f has_derivative f') net \<Longrightarrow> ((\<lambda>x. f x + c) has_derivative f') net"
   by (intro derivative_eq_intros) auto
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Derivative with composed bilinear function\<close>
 
 text \<open>More explicit epsilon-delta forms.\<close>
 
 proposition has_derivative_within':
   "(f has_derivative f')(at x within s) \<longleftrightarrow>
     bounded_linear f' \<and>
     (\<forall>e>0. \<exists>d>0. \<forall>x'\<in>s. 0 < norm (x' - x) \<and> norm (x' - x) < d \<longrightarrow>
       norm (f x' - f x - f'(x' - x)) / norm (x' - x) < e)"
   unfolding has_derivative_within Lim_within dist_norm
   by (simp add: diff_diff_eq)
 
 lemma has_derivative_at':
   "(f has_derivative f') (at x) 
    \<longleftrightarrow> bounded_linear f' \<and>
        (\<forall>e>0. \<exists>d>0. \<forall>x'. 0 < norm (x' - x) \<and> norm (x' - x) < d \<longrightarrow>
         norm (f x' - f x - f'(x' - x)) / norm (x' - x) < e)"
   using has_derivative_within' [of f f' x UNIV] by simp
 
 lemma has_derivative_componentwise_within:
    "(f has_derivative f') (at a within S) \<longleftrightarrow>
     (\<forall>i \<in> Basis. ((\<lambda>x. f x \<bullet> i) has_derivative (\<lambda>x. f' x \<bullet> i)) (at a within S))"
   apply (simp add: has_derivative_within)
   apply (subst tendsto_componentwise_iff)
   apply (simp add: bounded_linear_componentwise_iff [symmetric] ball_conj_distrib)
   apply (simp add: algebra_simps)
   done
 
 lemma has_derivative_at_withinI:
   "(f has_derivative f') (at x) \<Longrightarrow> (f has_derivative f') (at x within s)"
   unfolding has_derivative_within' has_derivative_at'
   by blast
 
 lemma has_derivative_right:
   fixes f :: "real \<Rightarrow> real"
     and y :: "real"
   shows "(f has_derivative ((*) y)) (at x within ({x <..} \<inter> I)) \<longleftrightarrow>
          ((\<lambda>t. (f x - f t) / (x - t)) \<longlongrightarrow> y) (at x within ({x <..} \<inter> I))"
 proof -
   have "((\<lambda>t. (f t - (f x + y * (t - x))) / \<bar>t - x\<bar>) \<longlongrightarrow> 0) (at x within ({x<..} \<inter> I)) \<longleftrightarrow>
     ((\<lambda>t. (f t - f x) / (t - x) - y) \<longlongrightarrow> 0) (at x within ({x<..} \<inter> I))"
     by (intro Lim_cong_within) (auto simp add: diff_divide_distrib add_divide_distrib)
   also have "\<dots> \<longleftrightarrow> ((\<lambda>t. (f t - f x) / (t - x)) \<longlongrightarrow> y) (at x within ({x<..} \<inter> I))"
     by (simp add: Lim_null[symmetric])
   also have "\<dots> \<longleftrightarrow> ((\<lambda>t. (f x - f t) / (x - t)) \<longlongrightarrow> y) (at x within ({x<..} \<inter> I))"
     by (intro Lim_cong_within) (simp_all add: field_simps)
   finally show ?thesis
     by (simp add: bounded_linear_mult_right has_derivative_within)
 qed
 
 subsubsection \<open>Caratheodory characterization\<close>
 
 lemma DERIV_caratheodory_within:
   "(f has_field_derivative l) (at x within S) \<longleftrightarrow>
    (\<exists>g. (\<forall>z. f z - f x = g z * (z - x)) \<and> continuous (at x within S) g \<and> g x = l)"
       (is "?lhs = ?rhs")
 proof
   assume ?lhs
   show ?rhs
   proof (intro exI conjI)
     let ?g = "(%z. if z = x then l else (f z - f x) / (z-x))"
     show "\<forall>z. f z - f x = ?g z * (z-x)" by simp
     show "continuous (at x within S) ?g" using \<open>?lhs\<close>
       by (auto simp add: continuous_within has_field_derivative_iff cong: Lim_cong_within)
     show "?g x = l" by simp
   qed
 next
   assume ?rhs
   then obtain g where
     "(\<forall>z. f z - f x = g z * (z-x))" and "continuous (at x within S) g" and "g x = l" by blast
   thus ?lhs
     by (auto simp add: continuous_within has_field_derivative_iff cong: Lim_cong_within)
 qed
 
 subsection \<open>Differentiability\<close>
 
 definition\<^marker>\<open>tag important\<close>
   differentiable_on :: "('a::real_normed_vector \<Rightarrow> 'b::real_normed_vector) \<Rightarrow> 'a set \<Rightarrow> bool"
     (infix "differentiable'_on" 50)
   where "f differentiable_on s \<longleftrightarrow> (\<forall>x\<in>s. f differentiable (at x within s))"
 
 lemma differentiableI: "(f has_derivative f') net \<Longrightarrow> f differentiable net"
   unfolding differentiable_def
   by auto
 
 lemma differentiable_onD: "\<lbrakk>f differentiable_on S; x \<in> S\<rbrakk> \<Longrightarrow> f differentiable (at x within S)"
   using differentiable_on_def by blast
 
 lemma differentiable_at_withinI: "f differentiable (at x) \<Longrightarrow> f differentiable (at x within s)"
   unfolding differentiable_def
   using has_derivative_at_withinI
   by blast
 
 lemma differentiable_at_imp_differentiable_on:
   "(\<And>x. x \<in> s \<Longrightarrow> f differentiable at x) \<Longrightarrow> f differentiable_on s"
   by (metis differentiable_at_withinI differentiable_on_def)
 
 corollary\<^marker>\<open>tag unimportant\<close> differentiable_iff_scaleR:
   fixes f :: "real \<Rightarrow> 'a::real_normed_vector"
   shows "f differentiable F \<longleftrightarrow> (\<exists>d. (f has_derivative (\<lambda>x. x *\<^sub>R d)) F)"
   by (auto simp: differentiable_def dest: has_derivative_linear linear_imp_scaleR)
 
 lemma differentiable_on_eq_differentiable_at:
   "open s \<Longrightarrow> f differentiable_on s \<longleftrightarrow> (\<forall>x\<in>s. f differentiable at x)"
   unfolding differentiable_on_def
   by (metis at_within_interior interior_open)
 
 lemma differentiable_transform_within:
   assumes "f differentiable (at x within s)"
     and "0 < d"
     and "x \<in> s"
     and "\<And>x'. \<lbrakk>x'\<in>s; dist x' x < d\<rbrakk> \<Longrightarrow> f x' = g x'"
   shows "g differentiable (at x within s)"
    using assms has_derivative_transform_within unfolding differentiable_def
    by blast
 
 lemma differentiable_on_ident [simp, derivative_intros]: "(\<lambda>x. x) differentiable_on S"
   by (simp add: differentiable_at_imp_differentiable_on)
 
 lemma differentiable_on_id [simp, derivative_intros]: "id differentiable_on S"
   by (simp add: id_def)
 
 lemma differentiable_on_const [simp, derivative_intros]: "(\<lambda>z. c) differentiable_on S"
   by (simp add: differentiable_on_def)
 
 lemma differentiable_on_mult [simp, derivative_intros]:
   fixes f :: "'M::real_normed_vector \<Rightarrow> 'a::real_normed_algebra"
   shows "\<lbrakk>f differentiable_on S; g differentiable_on S\<rbrakk> \<Longrightarrow> (\<lambda>z. f z * g z) differentiable_on S"
   unfolding differentiable_on_def differentiable_def
   using differentiable_def differentiable_mult by blast
 
 lemma differentiable_on_compose:
    "\<lbrakk>g differentiable_on S; f differentiable_on (g ` S)\<rbrakk> \<Longrightarrow> (\<lambda>x. f (g x)) differentiable_on S"
 by (simp add: differentiable_in_compose differentiable_on_def)
 
 lemma bounded_linear_imp_differentiable_on: "bounded_linear f \<Longrightarrow> f differentiable_on S"
   by (simp add: differentiable_on_def bounded_linear_imp_differentiable)
 
 lemma linear_imp_differentiable_on:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   shows "linear f \<Longrightarrow> f differentiable_on S"
 by (simp add: differentiable_on_def linear_imp_differentiable)
 
 lemma differentiable_on_minus [simp, derivative_intros]:
    "f differentiable_on S \<Longrightarrow> (\<lambda>z. -(f z)) differentiable_on S"
 by (simp add: differentiable_on_def)
 
 lemma differentiable_on_add [simp, derivative_intros]:
    "\<lbrakk>f differentiable_on S; g differentiable_on S\<rbrakk> \<Longrightarrow> (\<lambda>z. f z + g z) differentiable_on S"
 by (simp add: differentiable_on_def)
 
 lemma differentiable_on_diff [simp, derivative_intros]:
    "\<lbrakk>f differentiable_on S; g differentiable_on S\<rbrakk> \<Longrightarrow> (\<lambda>z. f z - g z) differentiable_on S"
 by (simp add: differentiable_on_def)
 
 lemma differentiable_on_inverse [simp, derivative_intros]:
   fixes f :: "'a :: real_normed_vector \<Rightarrow> 'b :: real_normed_field"
   shows "f differentiable_on S \<Longrightarrow> (\<And>x. x \<in> S \<Longrightarrow> f x \<noteq> 0) \<Longrightarrow> (\<lambda>x. inverse (f x)) differentiable_on S"
 by (simp add: differentiable_on_def)
 
 lemma differentiable_on_scaleR [derivative_intros, simp]:
    "\<lbrakk>f differentiable_on S; g differentiable_on S\<rbrakk> \<Longrightarrow> (\<lambda>x. f x *\<^sub>R g x) differentiable_on S"
   unfolding differentiable_on_def
   by (blast intro: differentiable_scaleR)
 
 lemma has_derivative_sqnorm_at [derivative_intros, simp]:
   "((\<lambda>x. (norm x)\<^sup>2) has_derivative (\<lambda>x. 2 *\<^sub>R (a \<bullet> x))) (at a)"
   using bounded_bilinear.FDERIV  [of "(\<bullet>)" id id a _ id id]
   by (auto simp: inner_commute dot_square_norm bounded_bilinear_inner)
 
 lemma differentiable_sqnorm_at [derivative_intros, simp]:
   fixes a :: "'a :: {real_normed_vector,real_inner}"
   shows "(\<lambda>x. (norm x)\<^sup>2) differentiable (at a)"
 by (force simp add: differentiable_def intro: has_derivative_sqnorm_at)
 
 lemma differentiable_on_sqnorm [derivative_intros, simp]:
   fixes S :: "'a :: {real_normed_vector,real_inner} set"
   shows "(\<lambda>x. (norm x)\<^sup>2) differentiable_on S"
 by (simp add: differentiable_at_imp_differentiable_on)
 
 lemma differentiable_norm_at [derivative_intros, simp]:
   fixes a :: "'a :: {real_normed_vector,real_inner}"
   shows "a \<noteq> 0 \<Longrightarrow> norm differentiable (at a)"
 using differentiableI has_derivative_norm by blast
 
 lemma differentiable_on_norm [derivative_intros, simp]:
   fixes S :: "'a :: {real_normed_vector,real_inner} set"
   shows "0 \<notin> S \<Longrightarrow> norm differentiable_on S"
 by (metis differentiable_at_imp_differentiable_on differentiable_norm_at)
 
 
 subsection \<open>Frechet derivative and Jacobian matrix\<close>
 
 definition "frechet_derivative f net = (SOME f'. (f has_derivative f') net)"
 
 proposition frechet_derivative_works:
   "f differentiable net \<longleftrightarrow> (f has_derivative (frechet_derivative f net)) net"
   unfolding frechet_derivative_def differentiable_def
   unfolding some_eq_ex[of "\<lambda> f' . (f has_derivative f') net"] ..
 
 lemma linear_frechet_derivative: "f differentiable net \<Longrightarrow> linear (frechet_derivative f net)"
   unfolding frechet_derivative_works has_derivative_def
   by (auto intro: bounded_linear.linear)
 
 lemma frechet_derivative_const [simp]: "frechet_derivative (\<lambda>x. c) (at a) = (\<lambda>x. 0)"
   using differentiable_const frechet_derivative_works has_derivative_const has_derivative_unique by blast
 
 lemma frechet_derivative_id [simp]: "frechet_derivative id (at a) = id"
   using differentiable_def frechet_derivative_works has_derivative_id has_derivative_unique by blast
 
 lemma frechet_derivative_ident [simp]: "frechet_derivative (\<lambda>x. x) (at a) = (\<lambda>x. x)"
   by (metis eq_id_iff frechet_derivative_id)
 
 
 subsection \<open>Differentiability implies continuity\<close>
 
 proposition differentiable_imp_continuous_within:
   "f differentiable (at x within s) \<Longrightarrow> continuous (at x within s) f"
   by (auto simp: differentiable_def intro: has_derivative_continuous)
 
 lemma differentiable_imp_continuous_on:
   "f differentiable_on s \<Longrightarrow> continuous_on s f"
   unfolding differentiable_on_def continuous_on_eq_continuous_within
   using differentiable_imp_continuous_within by blast
 
 lemma differentiable_on_subset:
   "f differentiable_on t \<Longrightarrow> s \<subseteq> t \<Longrightarrow> f differentiable_on s"
   unfolding differentiable_on_def
   using differentiable_within_subset
   by blast
 
 lemma differentiable_on_empty: "f differentiable_on {}"
   unfolding differentiable_on_def
   by auto
 
 lemma has_derivative_continuous_on:
   "(\<And>x. x \<in> s \<Longrightarrow> (f has_derivative f' x) (at x within s)) \<Longrightarrow> continuous_on s f"
   by (auto intro!: differentiable_imp_continuous_on differentiableI simp: differentiable_on_def)
 
 text \<open>Results about neighborhoods filter.\<close>
 
 lemma eventually_nhds_metric_le:
   "eventually P (nhds a) = (\<exists>d>0. \<forall>x. dist x a \<le> d \<longrightarrow> P x)"
   unfolding eventually_nhds_metric by (safe, rule_tac x="d / 2" in exI, auto)
 
 lemma le_nhds: "F \<le> nhds a \<longleftrightarrow> (\<forall>S. open S \<and> a \<in> S \<longrightarrow> eventually (\<lambda>x. x \<in> S) F)"
   unfolding le_filter_def eventually_nhds by (fast elim: eventually_mono)
 
 lemma le_nhds_metric: "F \<le> nhds a \<longleftrightarrow> (\<forall>e>0. eventually (\<lambda>x. dist x a < e) F)"
   unfolding le_filter_def eventually_nhds_metric by (fast elim: eventually_mono)
 
 lemma le_nhds_metric_le: "F \<le> nhds a \<longleftrightarrow> (\<forall>e>0. eventually (\<lambda>x. dist x a \<le> e) F)"
   unfolding le_filter_def eventually_nhds_metric_le by (fast elim: eventually_mono)
 
 text \<open>Several results are easier using a "multiplied-out" variant.
 (I got this idea from Dieudonne's proof of the chain rule).\<close>
 
 lemma has_derivative_within_alt:
   "(f has_derivative f') (at x within s) \<longleftrightarrow> bounded_linear f' \<and>
     (\<forall>e>0. \<exists>d>0. \<forall>y\<in>s. norm(y - x) < d \<longrightarrow> norm (f y - f x - f' (y - x)) \<le> e * norm (y - x))"
   unfolding has_derivative_within filterlim_def le_nhds_metric_le eventually_filtermap
     eventually_at dist_norm diff_diff_eq
   by (force simp add: linear_0 bounded_linear.linear pos_divide_le_eq)
 
 lemma has_derivative_within_alt2:
   "(f has_derivative f') (at x within s) \<longleftrightarrow> bounded_linear f' \<and>
     (\<forall>e>0. eventually (\<lambda>y. norm (f y - f x - f' (y - x)) \<le> e * norm (y - x)) (at x within s))"
   unfolding has_derivative_within filterlim_def le_nhds_metric_le eventually_filtermap
     eventually_at dist_norm diff_diff_eq
   by (force simp add: linear_0 bounded_linear.linear pos_divide_le_eq)
 
 lemma has_derivative_at_alt:
   "(f has_derivative f') (at x) \<longleftrightarrow>
     bounded_linear f' \<and>
     (\<forall>e>0. \<exists>d>0. \<forall>y. norm(y - x) < d \<longrightarrow> norm (f y - f x - f'(y - x)) \<le> e * norm (y - x))"
   using has_derivative_within_alt[where s=UNIV]
   by simp
 
 
 subsection \<open>The chain rule\<close>
 
 proposition diff_chain_within[derivative_intros]:
   assumes "(f has_derivative f') (at x within s)"
     and "(g has_derivative g') (at (f x) within (f ` s))"
   shows "((g \<circ> f) has_derivative (g' \<circ> f'))(at x within s)"
   using has_derivative_in_compose[OF assms]
   by (simp add: comp_def)
 
 lemma diff_chain_at[derivative_intros]:
   "(f has_derivative f') (at x) \<Longrightarrow>
     (g has_derivative g') (at (f x)) \<Longrightarrow> ((g \<circ> f) has_derivative (g' \<circ> f')) (at x)"
   using has_derivative_compose[of f f' x UNIV g g']
   by (simp add: comp_def)
 
 lemma has_vector_derivative_within_open:
   "a \<in> S \<Longrightarrow> open S \<Longrightarrow>
     (f has_vector_derivative f') (at a within S) \<longleftrightarrow> (f has_vector_derivative f') (at a)"
   by (simp only: at_within_interior interior_open)
 
 lemma field_vector_diff_chain_within:
  assumes Df: "(f has_vector_derivative f') (at x within S)"
      and Dg: "(g has_field_derivative g') (at (f x) within f ` S)"
  shows "((g \<circ> f) has_vector_derivative (f' * g')) (at x within S)"
 using diff_chain_within[OF Df[unfolded has_vector_derivative_def]
                        Dg [unfolded has_field_derivative_def]]
  by (auto simp: o_def mult.commute has_vector_derivative_def)
 
 lemma vector_derivative_diff_chain_within:
   assumes Df: "(f has_vector_derivative f') (at x within S)"
      and Dg: "(g has_derivative g') (at (f x) within f`S)"
   shows "((g \<circ> f) has_vector_derivative (g' f')) (at x within S)"
 using diff_chain_within[OF Df[unfolded has_vector_derivative_def] Dg]
   linear.scaleR[OF has_derivative_linear[OF Dg]]
   unfolding has_vector_derivative_def o_def
   by (auto simp: o_def mult.commute has_vector_derivative_def)
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Composition rules stated just for differentiability\<close>
 
 lemma differentiable_chain_at:
   "f differentiable (at x) \<Longrightarrow>
     g differentiable (at (f x)) \<Longrightarrow> (g \<circ> f) differentiable (at x)"
   unfolding differentiable_def
   by (meson diff_chain_at)
 
 lemma differentiable_chain_within:
   "f differentiable (at x within S) \<Longrightarrow>
     g differentiable (at(f x) within (f ` S)) \<Longrightarrow> (g \<circ> f) differentiable (at x within S)"
   unfolding differentiable_def
   by (meson diff_chain_within)
 
 
 subsection \<open>Uniqueness of derivative\<close>
 
 
 text\<^marker>\<open>tag important\<close> \<open>
  The general result is a bit messy because we need approachability of the
  limit point from any direction. But OK for nontrivial intervals etc.
 \<close>
 
 proposition frechet_derivative_unique_within:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   assumes 1: "(f has_derivative f') (at x within S)"
     and 2: "(f has_derivative f'') (at x within S)"
     and S: "\<And>i e. \<lbrakk>i\<in>Basis; e>0\<rbrakk> \<Longrightarrow> \<exists>d. 0 < \<bar>d\<bar> \<and> \<bar>d\<bar> < e \<and> (x + d *\<^sub>R i) \<in> S"
   shows "f' = f''"
 proof -
   note as = assms(1,2)[unfolded has_derivative_def]
   then interpret f': bounded_linear f' by auto
   from as interpret f'': bounded_linear f'' by auto
   have "x islimpt S" unfolding islimpt_approachable
   proof (intro allI impI)
     fix e :: real
     assume "e > 0"
     obtain d where "0 < \<bar>d\<bar>" and "\<bar>d\<bar> < e" and "x + d *\<^sub>R (SOME i. i \<in> Basis) \<in> S"
       using assms(3) SOME_Basis \<open>e>0\<close> by blast
     then show "\<exists>x'\<in>S. x' \<noteq> x \<and> dist x' x < e"
       by (rule_tac x="x + d *\<^sub>R (SOME i. i \<in> Basis)" in bexI) (auto simp: dist_norm SOME_Basis nonzero_Basis)  qed
   then have *: "netlimit (at x within S) = x"
     by (simp add: Lim_ident_at trivial_limit_within)
   show ?thesis
   proof (rule linear_eq_stdbasis)
     show "linear f'" "linear f''"
       unfolding linear_conv_bounded_linear using as by auto
   next
     fix i :: 'a
     assume i: "i \<in> Basis"
     define e where "e = norm (f' i - f'' i)"
     show "f' i = f'' i"
     proof (rule ccontr)
       assume "f' i \<noteq> f'' i"
       then have "e > 0"
         unfolding e_def by auto
       obtain d where d:
         "0 < d"
         "(\<And>y. y\<in>S \<longrightarrow> 0 < dist y x \<and> dist y x < d \<longrightarrow>
           dist ((f y - f x - f' (y - x)) /\<^sub>R norm (y - x) -
               (f y - f x - f'' (y - x)) /\<^sub>R norm (y - x)) (0 - 0) < e)"
         using tendsto_diff [OF as(1,2)[THEN conjunct2]]
         unfolding * Lim_within
         using \<open>e>0\<close> by blast
       obtain c where c: "0 < \<bar>c\<bar>" "\<bar>c\<bar> < d \<and> x + c *\<^sub>R i \<in> S"
         using assms(3) i d(1) by blast
       have *: "norm (- ((1 / \<bar>c\<bar>) *\<^sub>R f' (c *\<^sub>R i)) + (1 / \<bar>c\<bar>) *\<^sub>R f'' (c *\<^sub>R i)) =
         norm ((1 / \<bar>c\<bar>) *\<^sub>R (- (f' (c *\<^sub>R i)) + f'' (c *\<^sub>R i)))"
         unfolding scaleR_right_distrib by auto
       also have "\<dots> = norm ((1 / \<bar>c\<bar>) *\<^sub>R (c *\<^sub>R (- (f' i) + f'' i)))"
         unfolding f'.scaleR f''.scaleR
         unfolding scaleR_right_distrib scaleR_minus_right
         by auto
       also have "\<dots> = e"
         unfolding e_def
         using c(1)
         using norm_minus_cancel[of "f' i - f'' i"]
         by auto
       finally show False
         using c
         using d(2)[of "x + c *\<^sub>R i"]
         unfolding dist_norm
         unfolding f'.scaleR f''.scaleR f'.add f''.add f'.diff f''.diff
           scaleR_scaleR scaleR_right_diff_distrib scaleR_right_distrib
         using i
         by (auto simp: inverse_eq_divide)
     qed
   qed
 qed
 
 proposition frechet_derivative_unique_within_closed_interval:
   fixes f::"'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   assumes ab: "\<And>i. i\<in>Basis \<Longrightarrow> a\<bullet>i < b\<bullet>i"
     and x: "x \<in> cbox a b"
     and "(f has_derivative f' ) (at x within cbox a b)"
     and "(f has_derivative f'') (at x within cbox a b)"
   shows "f' = f''"
 proof (rule frechet_derivative_unique_within)
   fix e :: real
   fix i :: 'a
   assume "e > 0" and i: "i \<in> Basis"
   then show "\<exists>d. 0 < \<bar>d\<bar> \<and> \<bar>d\<bar> < e \<and> x + d *\<^sub>R i \<in> cbox a b"
   proof (cases "x\<bullet>i = a\<bullet>i")
     case True
     with ab[of i] \<open>e>0\<close> x i show ?thesis
       by (rule_tac x="(min (b\<bullet>i - a\<bullet>i) e) / 2" in exI)
          (auto simp add: mem_box field_simps inner_simps inner_Basis)
   next
     case False
     moreover have "a \<bullet> i < x \<bullet> i"
       using False i mem_box(2) x by force
     moreover {
       have "a \<bullet> i * 2 + min (x \<bullet> i - a \<bullet> i) e \<le> a\<bullet>i *2 + x\<bullet>i - a\<bullet>i"
         by auto
       also have "\<dots> = a\<bullet>i + x\<bullet>i"
         by auto
       also have "\<dots> \<le> 2 * (x\<bullet>i)"
         using \<open>a \<bullet> i < x \<bullet> i\<close> by auto
       finally have "a \<bullet> i * 2 + min (x \<bullet> i - a \<bullet> i) e \<le> x \<bullet> i * 2"
         by auto
     }
     moreover have "min (x \<bullet> i - a \<bullet> i) e \<ge> 0"
       by (simp add: \<open>0 < e\<close> \<open>a \<bullet> i < x \<bullet> i\<close> less_eq_real_def)
     then have "x \<bullet> i * 2 \<le> b \<bullet> i * 2 + min (x \<bullet> i - a \<bullet> i) e"
       using i mem_box(2) x by force
     ultimately show ?thesis
     using ab[of i] \<open>e>0\<close> x i 
       by (rule_tac x="- (min (x\<bullet>i - a\<bullet>i) e) / 2" in exI)
          (auto simp add: mem_box field_simps inner_simps inner_Basis)
   qed
 qed (use assms in auto)
 
 lemma frechet_derivative_unique_within_open_interval:
   fixes f::"'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   assumes x: "x \<in> box a b"
     and f: "(f has_derivative f' ) (at x within box a b)" "(f has_derivative f'') (at x within box a b)"
   shows "f' = f''"
 proof -
   have "at x within box a b = at x"
     by (metis x at_within_interior interior_open open_box)
   with f show "f' = f''"
     by (simp add: has_derivative_unique)
 qed
 
 lemma frechet_derivative_at:
   "(f has_derivative f') (at x) \<Longrightarrow> f' = frechet_derivative f (at x)"
   using differentiable_def frechet_derivative_works has_derivative_unique by blast
 
 lemma frechet_derivative_compose:
   "frechet_derivative (f o g) (at x) = frechet_derivative (f) (at (g x)) o frechet_derivative g (at x)"
   if "g differentiable at x" "f differentiable at (g x)"
   by (metis diff_chain_at frechet_derivative_at frechet_derivative_works that)
 
 lemma frechet_derivative_within_cbox:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::real_normed_vector"
   assumes "\<And>i. i\<in>Basis \<Longrightarrow> a\<bullet>i < b\<bullet>i"
     and "x \<in> cbox a b"
     and "(f has_derivative f') (at x within cbox a b)"
   shows "frechet_derivative f (at x within cbox a b) = f'"
   using assms
   by (metis Derivative.differentiableI frechet_derivative_unique_within_closed_interval frechet_derivative_works)
 
 lemma frechet_derivative_transform_within_open:
   "frechet_derivative f (at x) = frechet_derivative g (at x)"
   if "f differentiable at x" "open X" "x \<in> X" "\<And>x. x \<in> X \<Longrightarrow> f x = g x"
   by (meson frechet_derivative_at frechet_derivative_works has_derivative_transform_within_open that)
 
 
 subsection \<open>Derivatives of local minima and maxima are zero\<close>
 
 lemma has_derivative_local_min:
   fixes f :: "'a::real_normed_vector \<Rightarrow> real"
   assumes deriv: "(f has_derivative f') (at x)"
   assumes min: "eventually (\<lambda>y. f x \<le> f y) (at x)"
   shows "f' = (\<lambda>h. 0)"
 proof
   fix h :: 'a
   interpret f': bounded_linear f'
     using deriv by (rule has_derivative_bounded_linear)
   show "f' h = 0"
   proof (cases "h = 0")
     case False
     from min obtain d where d1: "0 < d" and d2: "\<forall>y\<in>ball x d. f x \<le> f y"
       unfolding eventually_at by (force simp: dist_commute)
     have "FDERIV (\<lambda>r. x + r *\<^sub>R h) 0 :> (\<lambda>r. r *\<^sub>R h)"
       by (intro derivative_eq_intros) auto
     then have "FDERIV (\<lambda>r. f (x + r *\<^sub>R h)) 0 :> (\<lambda>k. f' (k *\<^sub>R h))"
       by (rule has_derivative_compose, simp add: deriv)
     then have "DERIV (\<lambda>r. f (x + r *\<^sub>R h)) 0 :> f' h"
       unfolding has_field_derivative_def by (simp add: f'.scaleR mult_commute_abs)
     moreover have "0 < d / norm h" using d1 and \<open>h \<noteq> 0\<close> by simp
     moreover have "\<forall>y. \<bar>0 - y\<bar> < d / norm h \<longrightarrow> f (x + 0 *\<^sub>R h) \<le> f (x + y *\<^sub>R h)"
       using \<open>h \<noteq> 0\<close> by (auto simp add: d2 dist_norm pos_less_divide_eq)
     ultimately show "f' h = 0"
       by (rule DERIV_local_min)
   qed simp
 qed
 
 lemma has_derivative_local_max:
   fixes f :: "'a::real_normed_vector \<Rightarrow> real"
   assumes "(f has_derivative f') (at x)"
   assumes "eventually (\<lambda>y. f y \<le> f x) (at x)"
   shows "f' = (\<lambda>h. 0)"
   using has_derivative_local_min [of "\<lambda>x. - f x" "\<lambda>h. - f' h" "x"]
   using assms unfolding fun_eq_iff by simp
 
 lemma differential_zero_maxmin:
   fixes f::"'a::real_normed_vector \<Rightarrow> real"
   assumes "x \<in> S"
     and "open S"
     and deriv: "(f has_derivative f') (at x)"
     and mono: "(\<forall>y\<in>S. f y \<le> f x) \<or> (\<forall>y\<in>S. f x \<le> f y)"
   shows "f' = (\<lambda>v. 0)"
   using mono
 proof
   assume "\<forall>y\<in>S. f y \<le> f x"
   with \<open>x \<in> S\<close> and \<open>open S\<close> have "eventually (\<lambda>y. f y \<le> f x) (at x)"
     unfolding eventually_at_topological by auto
   with deriv show ?thesis
     by (rule has_derivative_local_max)
 next
   assume "\<forall>y\<in>S. f x \<le> f y"
   with \<open>x \<in> S\<close> and \<open>open S\<close> have "eventually (\<lambda>y. f x \<le> f y) (at x)"
     unfolding eventually_at_topological by auto
   with deriv show ?thesis
     by (rule has_derivative_local_min)
 qed
 
 lemma differential_zero_maxmin_component:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'b::euclidean_space"
   assumes k: "k \<in> Basis"
     and ball: "0 < e" "(\<forall>y \<in> ball x e. (f y)\<bullet>k \<le> (f x)\<bullet>k) \<or> (\<forall>y\<in>ball x e. (f x)\<bullet>k \<le> (f y)\<bullet>k)"
     and diff: "f differentiable (at x)"
   shows "(\<Sum>j\<in>Basis. (frechet_derivative f (at x) j \<bullet> k) *\<^sub>R j) = (0::'a)" (is "?D k = 0")
 proof -
   let ?f' = "frechet_derivative f (at x)"
   have "x \<in> ball x e" using \<open>0 < e\<close> by simp
   moreover have "open (ball x e)" by simp
   moreover have "((\<lambda>x. f x \<bullet> k) has_derivative (\<lambda>h. ?f' h \<bullet> k)) (at x)"
     using bounded_linear_inner_left diff[unfolded frechet_derivative_works]
     by (rule bounded_linear.has_derivative)
   ultimately have "(\<lambda>h. frechet_derivative f (at x) h \<bullet> k) = (\<lambda>v. 0)"
     using ball(2) by (rule differential_zero_maxmin)
   then show ?thesis
     unfolding fun_eq_iff by simp
 qed
 
 subsection \<open>One-dimensional mean value theorem\<close>
 
 lemma mvt_simple:
   fixes f :: "real \<Rightarrow> real"
   assumes "a < b"
     and derf: "\<And>x. \<lbrakk>a \<le> x; x \<le> b\<rbrakk> \<Longrightarrow> (f has_derivative f' x) (at x within {a..b})"
   shows "\<exists>x\<in>{a<..<b}. f b - f a = f' x (b - a)"
 proof (rule mvt)
   have "f differentiable_on {a..b}"
     using derf unfolding differentiable_on_def differentiable_def by force
   then show "continuous_on {a..b} f"
     by (rule differentiable_imp_continuous_on)
   show "(f has_derivative f' x) (at x)" if "a < x" "x < b" for x
     by (metis at_within_Icc_at derf leI order.asym that)
 qed (use assms in auto)
 
 lemma mvt_very_simple:
   fixes f :: "real \<Rightarrow> real"
   assumes "a \<le> b"
     and derf: "\<And>x. \<lbrakk>a \<le> x; x \<le> b\<rbrakk> \<Longrightarrow> (f has_derivative f' x) (at x within {a..b})"
   shows "\<exists>x\<in>{a..b}. f b - f a = f' x (b - a)"
 proof (cases "a = b")
   interpret bounded_linear "f' b"
     using assms(2) assms(1) by auto
   case True
   then show ?thesis
     by force
 next
   case False
   then show ?thesis
     using mvt_simple[OF _ derf]
     by (metis \<open>a \<le> b\<close> atLeastAtMost_iff dual_order.order_iff_strict greaterThanLessThan_iff)
 qed
 
 text \<open>A nice generalization (see Havin's proof of 5.19 from Rudin's book).\<close>
 
 lemma mvt_general:
   fixes f :: "real \<Rightarrow> 'a::real_inner"
   assumes "a < b"
     and contf: "continuous_on {a..b} f"
     and derf: "\<And>x. \<lbrakk>a < x; x < b\<rbrakk> \<Longrightarrow> (f has_derivative f' x) (at x)"
   shows "\<exists>x\<in>{a<..<b}. norm (f b - f a) \<le> norm (f' x (b - a))"
 proof -
   have "\<exists>x\<in>{a<..<b}. (f b - f a) \<bullet> f b - (f b - f a) \<bullet> f a = (f b - f a) \<bullet> f' x (b - a)"
     apply (rule mvt [OF \<open>a < b\<close>, where f = "\<lambda>x. (f b - f a) \<bullet> f x"])
     apply (intro continuous_intros contf)
     using derf apply (auto intro: has_derivative_inner_right)
     done
   then obtain x where x: "x \<in> {a<..<b}"
     "(f b - f a) \<bullet> f b - (f b - f a) \<bullet> f a = (f b - f a) \<bullet> f' x (b - a)" ..
   show ?thesis
   proof (cases "f a = f b")
     case False
     have "norm (f b - f a) * norm (f b - f a) = (norm (f b - f a))\<^sup>2"
       by (simp add: power2_eq_square)
     also have "\<dots> = (f b - f a) \<bullet> (f b - f a)"
       unfolding power2_norm_eq_inner ..
     also have "\<dots> = (f b - f a) \<bullet> f' x (b - a)"
       using x(2) by (simp only: inner_diff_right)
     also have "\<dots> \<le> norm (f b - f a) * norm (f' x (b - a))"
       by (rule norm_cauchy_schwarz)
     finally show ?thesis
       using False x(1)
       by (auto simp add: mult_left_cancel)
   next
     case True
     then show ?thesis
       using \<open>a < b\<close> by (rule_tac x="(a + b) /2" in bexI) auto
   qed
 qed
 
 
 subsection \<open>More general bound theorems\<close>
 
 proposition differentiable_bound_general:
   fixes f :: "real \<Rightarrow> 'a::real_normed_vector"
   assumes "a < b"
     and f_cont: "continuous_on {a..b} f"
     and phi_cont: "continuous_on {a..b} \<phi>"
     and f': "\<And>x. a < x \<Longrightarrow> x < b \<Longrightarrow> (f has_vector_derivative f' x) (at x)"
     and phi': "\<And>x. a < x \<Longrightarrow> x < b \<Longrightarrow> (\<phi> has_vector_derivative \<phi>' x) (at x)"
     and bnd: "\<And>x. a < x \<Longrightarrow> x < b \<Longrightarrow> norm (f' x) \<le> \<phi>' x"
   shows "norm (f b - f a) \<le> \<phi> b - \<phi> a"
 proof -
   {
     fix x assume x: "a < x" "x < b"
     have "0 \<le> norm (f' x)" by simp
     also have "\<dots> \<le> \<phi>' x" using x by (auto intro!: bnd)
     finally have "0 \<le> \<phi>' x" .
   } note phi'_nonneg = this
   note f_tendsto = assms(2)[simplified continuous_on_def, rule_format]
   note phi_tendsto = assms(3)[simplified continuous_on_def, rule_format]
   {
     fix e::real assume "e > 0"
     define e2 where "e2 = e / 2"
     with \<open>e > 0\<close> have "e2 > 0" by simp
     let ?le = "\<lambda>x1. norm (f x1 - f a) \<le> \<phi> x1 - \<phi> a + e * (x1 - a) + e"
     define A where "A = {x2. a \<le> x2 \<and> x2 \<le> b \<and> (\<forall>x1\<in>{a ..< x2}. ?le x1)}"
     have A_subset: "A \<subseteq> {a..b}" by (auto simp: A_def)
     {
       fix x2
       assume a: "a \<le> x2" "x2 \<le> b" and le: "\<forall>x1\<in>{a..<x2}. ?le x1"
       have "?le x2" using \<open>e > 0\<close>
       proof cases
         assume "x2 \<noteq> a" with a have "a < x2" by simp
         have "at x2 within {a <..<x2}\<noteq> bot"
           using \<open>a < x2\<close>
           by (auto simp: trivial_limit_within islimpt_in_closure)
         moreover
         have "((\<lambda>x1. (\<phi> x1 - \<phi> a) + e * (x1 - a) + e) \<longlongrightarrow> (\<phi> x2 - \<phi> a) + e * (x2 - a) + e) (at x2 within {a <..<x2})"
           "((\<lambda>x1. norm (f x1 - f a)) \<longlongrightarrow> norm (f x2 - f a)) (at x2 within {a <..<x2})"
           using a
           by (auto intro!: tendsto_eq_intros f_tendsto phi_tendsto
             intro: tendsto_within_subset[where S="{a..b}"])
         moreover
         have "eventually (\<lambda>x. x > a) (at x2 within {a <..<x2})"
           by (auto simp: eventually_at_filter)
         hence "eventually ?le (at x2 within {a <..<x2})"
           unfolding eventually_at_filter
           by eventually_elim (insert le, auto)
         ultimately
         show ?thesis
           by (rule tendsto_le)
       qed simp
     } note le_cont = this
     have "a \<in> A"
       using assms by (auto simp: A_def)
     hence [simp]: "A \<noteq> {}" by auto
     have A_ivl: "\<And>x1 x2. x2 \<in> A \<Longrightarrow> x1 \<in> {a ..x2} \<Longrightarrow> x1 \<in> A"
       by (simp add: A_def)
     have [simp]: "bdd_above A" by (auto simp: A_def)
     define y where "y = Sup A"
     have "y \<le> b"
       unfolding y_def
       by (simp add: cSup_le_iff) (simp add: A_def)
      have leI: "\<And>x x1. a \<le> x1 \<Longrightarrow> x \<in> A \<Longrightarrow> x1 < x \<Longrightarrow> ?le x1"
        by (auto simp: A_def intro!: le_cont)
     have y_all_le: "\<forall>x1\<in>{a..<y}. ?le x1"
       by (auto simp: y_def less_cSup_iff leI)
     have "a \<le> y"
       by (metis \<open>a \<in> A\<close> \<open>bdd_above A\<close> cSup_upper y_def)
     have "y \<in> A"
       using y_all_le \<open>a \<le> y\<close> \<open>y \<le> b\<close>
       by (auto simp: A_def)
     hence "A = {a .. y}"
       using A_subset by (auto simp: subset_iff y_def cSup_upper intro: A_ivl)
     from le_cont[OF \<open>a \<le> y\<close> \<open>y \<le> b\<close> y_all_le] have le_y: "?le y" .
     have "y = b"
     proof (cases "a = y")
       case True
       with \<open>a < b\<close> have "y < b" by simp
       with \<open>a = y\<close> f_cont phi_cont \<open>e2 > 0\<close>
       have 1: "\<forall>\<^sub>F x in at y within {y..b}. dist (f x) (f y) < e2"
        and 2: "\<forall>\<^sub>F x in at y within {y..b}. dist (\<phi> x) (\<phi> y) < e2"
         by (auto simp: continuous_on_def tendsto_iff)
       have 3: "eventually (\<lambda>x. y < x) (at y within {y..b})"
         by (auto simp: eventually_at_filter)
       have 4: "eventually (\<lambda>x::real. x < b) (at y within {y..b})"
         using _ \<open>y < b\<close>
         by (rule order_tendstoD) (auto intro!: tendsto_eq_intros)
       from 1 2 3 4
       have eventually_le: "eventually (\<lambda>x. ?le x) (at y within {y .. b})"
       proof eventually_elim
         case (elim x1)
         have "norm (f x1 - f a) = norm (f x1 - f y)"
           by (simp add: \<open>a = y\<close>)
         also have "norm (f x1 - f y) \<le> e2"
           using elim \<open>a = y\<close> by (auto simp : dist_norm intro!:  less_imp_le)
         also have "\<dots> \<le> e2 + (\<phi> x1 - \<phi> a + e2 + e * (x1 - a))"
           using \<open>0 < e\<close> elim
           by (intro add_increasing2[OF add_nonneg_nonneg order.refl])
             (auto simp: \<open>a = y\<close> dist_norm intro!: mult_nonneg_nonneg)
         also have "\<dots> = \<phi> x1 - \<phi> a + e * (x1 - a) + e"
           by (simp add: e2_def)
         finally show "?le x1" .
       qed
       from this[unfolded eventually_at_topological] \<open>?le y\<close>
       obtain S where S: "open S" "y \<in> S" "\<And>x. x\<in>S \<Longrightarrow> x \<in> {y..b} \<Longrightarrow> ?le x"
         by metis
       from \<open>open S\<close> obtain d where d: "\<And>x. dist x y < d \<Longrightarrow> x \<in> S" "d > 0"
         by (force simp: dist_commute open_dist ball_def dest!: bspec[OF _ \<open>y \<in> S\<close>])
       define d' where "d' = min b (y + (d/2))"
       have "d' \<in> A"
         unfolding A_def
       proof safe
         show "a \<le> d'" using \<open>a = y\<close> \<open>0 < d\<close> \<open>y < b\<close> by (simp add: d'_def)
         show "d' \<le> b" by (simp add: d'_def)
         fix x1
         assume "x1 \<in> {a..<d'}"
         hence "x1 \<in> S" "x1 \<in> {y..b}"
           by (auto simp: \<open>a = y\<close> d'_def dist_real_def intro!: d )
         thus "?le x1"
           by (rule S)
       qed
       hence "d' \<le> y"
         unfolding y_def
         by (rule cSup_upper) simp
       then show "y = b" using \<open>d > 0\<close> \<open>y < b\<close>
         by (simp add: d'_def)
     next
       case False
       with \<open>a \<le> y\<close> have "a < y" by simp
       show "y = b"
       proof (rule ccontr)
         assume "y \<noteq> b"
         hence "y < b" using \<open>y \<le> b\<close> by simp
         let ?F = "at y within {y..<b}"
         from f' phi'
         have "(f has_vector_derivative f' y) ?F"
           and "(\<phi> has_vector_derivative \<phi>' y) ?F"
           using \<open>a < y\<close> \<open>y < b\<close>
           by (auto simp add: at_within_open[of _ "{a<..<b}"] has_vector_derivative_def
             intro!: has_derivative_subset[where s="{a<..<b}" and t="{y..<b}"])
         hence "\<forall>\<^sub>F x1 in ?F. norm (f x1 - f y - (x1 - y) *\<^sub>R f' y) \<le> e2 * \<bar>x1 - y\<bar>"
             "\<forall>\<^sub>F x1 in ?F. norm (\<phi> x1 - \<phi> y - (x1 - y) *\<^sub>R \<phi>' y) \<le> e2 * \<bar>x1 - y\<bar>"
           using \<open>e2 > 0\<close>
           by (auto simp: has_derivative_within_alt2 has_vector_derivative_def)
         moreover
         have "\<forall>\<^sub>F x1 in ?F. y \<le> x1" "\<forall>\<^sub>F x1 in ?F. x1 < b"
           by (auto simp: eventually_at_filter)
         ultimately
         have "\<forall>\<^sub>F x1 in ?F. norm (f x1 - f y) \<le> (\<phi> x1 - \<phi> y) + e * \<bar>x1 - y\<bar>"
           (is "\<forall>\<^sub>F x1 in ?F. ?le' x1")
         proof eventually_elim
           case (elim x1)
           from norm_triangle_ineq2[THEN order_trans, OF elim(1)]
           have "norm (f x1 - f y) \<le> norm (f' y) * \<bar>x1 - y\<bar> + e2 * \<bar>x1 - y\<bar>"
             by (simp add: ac_simps)
           also have "norm (f' y) \<le> \<phi>' y" using bnd \<open>a < y\<close> \<open>y < b\<close> by simp
           also have "\<phi>' y * \<bar>x1 - y\<bar> \<le> \<phi> x1 - \<phi> y + e2 * \<bar>x1 - y\<bar>"
             using elim by (simp add: ac_simps)
           finally
           have "norm (f x1 - f y) \<le> \<phi> x1 - \<phi> y + e2 * \<bar>x1 - y\<bar> + e2 * \<bar>x1 - y\<bar>"
             by (auto simp: mult_right_mono)
           thus ?case by (simp add: e2_def)
         qed
         moreover have "?le' y" by simp
         ultimately obtain S
         where S: "open S" "y \<in> S" "\<And>x. x\<in>S \<Longrightarrow> x \<in> {y..<b} \<Longrightarrow> ?le' x"
           unfolding eventually_at_topological
           by metis
         from \<open>open S\<close> obtain d where d: "\<And>x. dist x y < d \<Longrightarrow> x \<in> S" "d > 0"
           by (force simp: dist_commute open_dist ball_def dest!: bspec[OF _ \<open>y \<in> S\<close>])
         define d' where "d' = min ((y + b)/2) (y + (d/2))"
         have "d' \<in> A"
           unfolding A_def
         proof safe
           show "a \<le> d'" using \<open>a < y\<close> \<open>0 < d\<close> \<open>y < b\<close> by (simp add: d'_def)
           show "d' \<le> b" using \<open>y < b\<close> by (simp add: d'_def min_def)
           fix x1
           assume x1: "x1 \<in> {a..<d'}"
           show "?le x1"
           proof (cases "x1 < y")
             case True
             then show ?thesis
               using \<open>y \<in> A\<close> local.leI x1 by auto
           next
             case False
             hence x1': "x1 \<in> S" "x1 \<in> {y..<b}" using x1
               by (auto simp: d'_def dist_real_def intro!: d)
             have "norm (f x1 - f a) \<le> norm (f x1 - f y) + norm (f y - f a)"
               by (rule order_trans[OF _ norm_triangle_ineq]) simp
             also note S(3)[OF x1']
             also note le_y
             finally show "?le x1"
               using False by (auto simp: algebra_simps)
           qed
         qed
         hence "d' \<le> y"
           unfolding y_def by (rule cSup_upper) simp
         thus False using \<open>d > 0\<close> \<open>y < b\<close>
           by (simp add: d'_def min_def split: if_split_asm)
       qed
     qed
     with le_y have "norm (f b - f a) \<le> \<phi> b - \<phi> a + e * (b - a + 1)"
       by (simp add: algebra_simps)
   } note * = this
   show ?thesis
   proof (rule field_le_epsilon)
     fix e::real assume "e > 0"
     then show "norm (f b - f a) \<le> \<phi> b - \<phi> a + e"
       using *[of "e / (b - a + 1)"] \<open>a < b\<close> by simp
   qed
 qed
 
 lemma differentiable_bound:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes "convex S"
     and derf: "\<And>x. x\<in>S \<Longrightarrow> (f has_derivative f' x) (at x within S)"
     and B: "\<And>x. x \<in> S \<Longrightarrow> onorm (f' x) \<le> B"
     and x: "x \<in> S"
     and y: "y \<in> S"
   shows "norm (f x - f y) \<le> B * norm (x - y)"
 proof -
   let ?p = "\<lambda>u. x + u *\<^sub>R (y - x)"
   let ?\<phi> = "\<lambda>h. h * B * norm (x - y)"
   have *: "x + u *\<^sub>R (y - x) \<in> S" if "u \<in> {0..1}" for u
   proof -
     have "u *\<^sub>R y = u *\<^sub>R (y - x) + u *\<^sub>R x"
       by (simp add: scale_right_diff_distrib)
     then show "x + u *\<^sub>R (y - x) \<in> S"
       using that \<open>convex S\<close> x y by (simp add: convex_alt)
         (metis pth_b(2) pth_c(1) scaleR_collapse)
   qed
   have "\<And>z. z \<in> (\<lambda>u. x + u *\<^sub>R (y - x)) ` {0..1} \<Longrightarrow>
           (f has_derivative f' z) (at z within (\<lambda>u. x + u *\<^sub>R (y - x)) ` {0..1})"
     by (auto intro: * has_derivative_within_subset [OF derf])
   then have "continuous_on (?p ` {0..1}) f"
     unfolding continuous_on_eq_continuous_within
     by (meson has_derivative_continuous)
   with * have 1: "continuous_on {0 .. 1} (f \<circ> ?p)"
     by (intro continuous_intros)+
   {
     fix u::real assume u: "u \<in>{0 <..< 1}"
     let ?u = "?p u"
     interpret linear "(f' ?u)"
       using u by (auto intro!: has_derivative_linear derf *)
     have "(f \<circ> ?p has_derivative (f' ?u) \<circ> (\<lambda>u. 0 + u *\<^sub>R (y - x))) (at u within box 0 1)"
       by (intro derivative_intros has_derivative_within_subset [OF derf]) (use u * in auto)
     hence "((f \<circ> ?p) has_vector_derivative f' ?u (y - x)) (at u)"
       by (simp add: at_within_open[OF u open_greaterThanLessThan] scaleR has_vector_derivative_def o_def)
   } note 2 = this
   have 3: "continuous_on {0..1} ?\<phi>"
     by (rule continuous_intros)+
   have 4: "(?\<phi> has_vector_derivative B * norm (x - y)) (at u)" for u
     by (auto simp: has_vector_derivative_def intro!: derivative_eq_intros)
   {
     fix u::real assume u: "u \<in>{0 <..< 1}"
     let ?u = "?p u"
     interpret bounded_linear "(f' ?u)"
       using u by (auto intro!: has_derivative_bounded_linear derf *)
     have "norm (f' ?u (y - x)) \<le> onorm (f' ?u) * norm (y - x)"
       by (rule onorm) (rule bounded_linear)
     also have "onorm (f' ?u) \<le> B"
       using u by (auto intro!: assms(3)[rule_format] *)
     finally have "norm ((f' ?u) (y - x)) \<le> B * norm (x - y)"
       by (simp add: mult_right_mono norm_minus_commute)
   } note 5 = this
   have "norm (f x - f y) = norm ((f \<circ> (\<lambda>u. x + u *\<^sub>R (y - x))) 1 - (f \<circ> (\<lambda>u. x + u *\<^sub>R (y - x))) 0)"
     by (auto simp add: norm_minus_commute)
   also
   from differentiable_bound_general[OF zero_less_one 1, OF 3 2 4 5]
   have "norm ((f \<circ> ?p) 1 - (f \<circ> ?p) 0) \<le> B * norm (x - y)"
     by simp
   finally show ?thesis .
 qed
 
+lemma field_differentiable_bound:
+  fixes S :: "'a::real_normed_field set"
+  assumes cvs: "convex S"
+      and df:  "\<And>z. z \<in> S \<Longrightarrow> (f has_field_derivative f' z) (at z within S)"
+      and dn:  "\<And>z. z \<in> S \<Longrightarrow> norm (f' z) \<le> B"
+      and "x \<in> S"  "y \<in> S"
+    shows "norm(f x - f y) \<le> B * norm(x - y)"
+  apply (rule differentiable_bound [OF cvs])
+  apply (erule df [unfolded has_field_derivative_def])
+  apply (rule onorm_le, simp_all add: norm_mult mult_right_mono assms)
+  done
+
 lemma
   differentiable_bound_segment:
   fixes f::"'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes "\<And>t. t \<in> {0..1} \<Longrightarrow> x0 + t *\<^sub>R a \<in> G"
   assumes f': "\<And>x. x \<in> G \<Longrightarrow> (f has_derivative f' x) (at x within G)"
   assumes B: "\<And>x. x \<in> {0..1} \<Longrightarrow> onorm (f' (x0 + x *\<^sub>R a)) \<le> B"
   shows "norm (f (x0 + a) - f x0) \<le> norm a * B"
 proof -
   let ?G = "(\<lambda>x. x0 + x *\<^sub>R a) ` {0..1}"
   have "?G = (+) x0 ` (\<lambda>x. x *\<^sub>R a) ` {0..1}" by auto
   also have "convex \<dots>"
     by (intro convex_translation convex_scaled convex_real_interval)
   finally have "convex ?G" .
   moreover have "?G \<subseteq> G" "x0 \<in> ?G" "x0 + a \<in> ?G" using assms by (auto intro: image_eqI[where x=1])
   ultimately show ?thesis
     using has_derivative_subset[OF f' \<open>?G \<subseteq> G\<close>] B
       differentiable_bound[of "(\<lambda>x. x0 + x *\<^sub>R a) ` {0..1}" f f' B "x0 + a" x0]
     by (force simp: ac_simps)
 qed
 
 lemma differentiable_bound_linearization:
   fixes f::"'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes S: "\<And>t. t \<in> {0..1} \<Longrightarrow> a + t *\<^sub>R (b - a) \<in> S"
   assumes f'[derivative_intros]: "\<And>x. x \<in> S \<Longrightarrow> (f has_derivative f' x) (at x within S)"
   assumes B: "\<And>x. x \<in> S \<Longrightarrow> onorm (f' x - f' x0) \<le> B"
   assumes "x0 \<in> S"
   shows "norm (f b - f a - f' x0 (b - a)) \<le> norm (b - a) * B"
 proof -
   define g where [abs_def]: "g x = f x - f' x0 x" for x
   have g: "\<And>x. x \<in> S \<Longrightarrow> (g has_derivative (\<lambda>i. f' x i - f' x0 i)) (at x within S)"
     unfolding g_def using assms
     by (auto intro!: derivative_eq_intros
       bounded_linear.has_derivative[OF has_derivative_bounded_linear, OF f'])
   from B have "\<forall>x\<in>{0..1}. onorm (\<lambda>i. f' (a + x *\<^sub>R (b - a)) i - f' x0 i) \<le> B"
     using assms by (auto simp: fun_diff_def)
   with differentiable_bound_segment[OF S g] \<open>x0 \<in> S\<close>
   show ?thesis
     by (simp add: g_def field_simps linear_diff[OF has_derivative_linear[OF f']])
 qed
 
 lemma vector_differentiable_bound_linearization:
   fixes f::"real \<Rightarrow> 'b::real_normed_vector"
   assumes f': "\<And>x. x \<in> S \<Longrightarrow> (f has_vector_derivative f' x) (at x within S)"
   assumes "closed_segment a b \<subseteq> S"
   assumes B: "\<And>x. x \<in> S \<Longrightarrow> norm (f' x - f' x0) \<le> B"
   assumes "x0 \<in> S"
   shows "norm (f b - f a - (b - a) *\<^sub>R f' x0) \<le> norm (b - a) * B"
   using assms
   by (intro differentiable_bound_linearization[of a b S f "\<lambda>x h. h *\<^sub>R f' x" x0 B])
     (force simp: closed_segment_real_eq has_vector_derivative_def
       scaleR_diff_right[symmetric] mult.commute[of B]
       intro!: onorm_le mult_left_mono)+
 
 
 text \<open>In particular.\<close>
 
 lemma has_derivative_zero_constant:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes "convex s"
     and "\<And>x. x \<in> s \<Longrightarrow> (f has_derivative (\<lambda>h. 0)) (at x within s)"
   shows "\<exists>c. \<forall>x\<in>s. f x = c"
 proof -
   { fix x y assume "x \<in> s" "y \<in> s"
     then have "norm (f x - f y) \<le> 0 * norm (x - y)"
       using assms by (intro differentiable_bound[of s]) (auto simp: onorm_zero)
     then have "f x = f y"
       by simp }
   then show ?thesis
     by metis
 qed
 
 lemma has_field_derivative_zero_constant:
   assumes "convex s" "\<And>x. x \<in> s \<Longrightarrow> (f has_field_derivative 0) (at x within s)"
   shows   "\<exists>c. \<forall>x\<in>s. f (x) = (c :: 'a :: real_normed_field)"
 proof (rule has_derivative_zero_constant)
   have A: "(*) 0 = (\<lambda>_. 0 :: 'a)" by (intro ext) simp
   fix x assume "x \<in> s" thus "(f has_derivative (\<lambda>h. 0)) (at x within s)"
     using assms(2)[of x] by (simp add: has_field_derivative_def A)
 qed fact
 
 lemma
   has_vector_derivative_zero_constant:
   assumes "convex s"
   assumes "\<And>x. x \<in> s \<Longrightarrow> (f has_vector_derivative 0) (at x within s)"
   obtains c where "\<And>x. x \<in> s \<Longrightarrow> f x = c"
   using has_derivative_zero_constant[of s f] assms
   by (auto simp: has_vector_derivative_def)
 
 lemma has_derivative_zero_unique:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes "convex s"
     and "\<And>x. x \<in> s \<Longrightarrow> (f has_derivative (\<lambda>h. 0)) (at x within s)"
     and "x \<in> s" "y \<in> s"
   shows "f x = f y"
   using has_derivative_zero_constant[OF assms(1,2)] assms(3-) by force
 
 lemma has_derivative_zero_unique_connected:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes "open s" "connected s"
   assumes f: "\<And>x. x \<in> s \<Longrightarrow> (f has_derivative (\<lambda>x. 0)) (at x)"
   assumes "x \<in> s" "y \<in> s"
   shows "f x = f y"
 proof (rule connected_local_const[where f=f, OF \<open>connected s\<close> \<open>x\<in>s\<close> \<open>y\<in>s\<close>])
   show "\<forall>a\<in>s. eventually (\<lambda>b. f a = f b) (at a within s)"
   proof
     fix a assume "a \<in> s"
     with \<open>open s\<close> obtain e where "0 < e" "ball a e \<subseteq> s"
       by (rule openE)
     then have "\<exists>c. \<forall>x\<in>ball a e. f x = c"
       by (intro has_derivative_zero_constant)
          (auto simp: at_within_open[OF _ open_ball] f convex_ball)
     with \<open>0<e\<close> have "\<forall>x\<in>ball a e. f a = f x"
       by auto
     then show "eventually (\<lambda>b. f a = f b) (at a within s)"
       using \<open>0<e\<close> unfolding eventually_at_topological
       by (intro exI[of _ "ball a e"]) auto
   qed
 qed
 
 subsection \<open>Differentiability of inverse function (most basic form)\<close>
 
 lemma has_derivative_inverse_basic:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes derf: "(f has_derivative f') (at (g y))"
     and ling': "bounded_linear g'"
     and "g' \<circ> f' = id"
     and contg: "continuous (at y) g"
     and "open T"
     and "y \<in> T"
     and fg: "\<And>z. z \<in> T \<Longrightarrow> f (g z) = z"
   shows "(g has_derivative g') (at y)"
 proof -
   interpret f': bounded_linear f'
     using assms unfolding has_derivative_def by auto
   interpret g': bounded_linear g'
     using assms by auto
   obtain C where C: "0 < C" "\<And>x. norm (g' x) \<le> norm x * C"
     using bounded_linear.pos_bounded[OF assms(2)] by blast
   have lem1: "\<forall>e>0. \<exists>d>0. \<forall>z.
     norm (z - y) < d \<longrightarrow> norm (g z - g y - g'(z - y)) \<le> e * norm (g z - g y)"
   proof (intro allI impI)
     fix e :: real
     assume "e > 0"
     with C(1) have *: "e / C > 0" by auto
     obtain d0 where  "0 < d0" and d0:
         "\<And>u. norm (u - g y) < d0 \<Longrightarrow> norm (f u - f (g y) - f' (u - g y)) \<le> e / C * norm (u - g y)"
       using derf * unfolding has_derivative_at_alt by blast
     obtain d1 where "0 < d1" and d1: "\<And>x. \<lbrakk>0 < dist x y; dist x y < d1\<rbrakk> \<Longrightarrow> dist (g x) (g y) < d0"
       using contg \<open>0 < d0\<close> unfolding continuous_at Lim_at by blast
     obtain d2 where "0 < d2" and d2: "\<And>u. dist u y < d2 \<Longrightarrow> u \<in> T"
       using \<open>open T\<close> \<open>y \<in> T\<close> unfolding open_dist by blast
     obtain d where d: "0 < d" "d < d1" "d < d2"
       using field_lbound_gt_zero[OF \<open>0 < d1\<close> \<open>0 < d2\<close>] by blast
     show "\<exists>d>0. \<forall>z. norm (z - y) < d \<longrightarrow> norm (g z - g y - g' (z - y)) \<le> e * norm (g z - g y)"
     proof (intro exI allI impI conjI)
       fix z
       assume as: "norm (z - y) < d"
       then have "z \<in> T"
         using d2 d unfolding dist_norm by auto
       have "norm (g z - g y - g' (z - y)) \<le> norm (g' (f (g z) - y - f' (g z - g y)))"
         unfolding g'.diff f'.diff
         unfolding assms(3)[unfolded o_def id_def, THEN fun_cong] fg[OF \<open>z\<in>T\<close>]
         by (simp add: norm_minus_commute)
       also have "\<dots> \<le> norm (f (g z) - y - f' (g z - g y)) * C"
         by (rule C(2))
       also have "\<dots> \<le> (e / C) * norm (g z - g y) * C"
       proof -
         have "norm (g z - g y) < d0"
           by (metis as cancel_comm_monoid_add_class.diff_cancel d(2) \<open>0 < d0\<close> d1 diff_gt_0_iff_gt diff_strict_mono dist_norm dist_self zero_less_dist_iff)
         then show ?thesis
           by (metis C(1) \<open>y \<in> T\<close> d0 fg real_mult_le_cancel_iff1)
       qed
       also have "\<dots> \<le> e * norm (g z - g y)"
         using C by (auto simp add: field_simps)
       finally show "norm (g z - g y - g' (z - y)) \<le> e * norm (g z - g y)"
         by simp
     qed (use d in auto)
   qed
   have *: "(0::real) < 1 / 2"
     by auto
   obtain d where "0 < d" and d:
       "\<And>z. norm (z - y) < d \<Longrightarrow> norm (g z - g y - g' (z - y)) \<le> 1/2 * norm (g z - g y)"
     using lem1 * by blast
   define B where "B = C * 2"
   have "B > 0"
     unfolding B_def using C by auto
   have lem2: "norm (g z - g y) \<le> B * norm (z - y)" if z: "norm(z - y) < d" for z
   proof -
     have "norm (g z - g y) \<le> norm(g' (z - y)) + norm ((g z - g y) - g'(z - y))"
       by (rule norm_triangle_sub)
     also have "\<dots> \<le> norm (g' (z - y)) + 1 / 2 * norm (g z - g y)"
       by (rule add_left_mono) (use d z in auto)
     also have "\<dots> \<le> norm (z - y) * C + 1 / 2 * norm (g z - g y)"
       by (rule add_right_mono) (use C in auto)
     finally show "norm (g z - g y) \<le> B * norm (z - y)"
       unfolding B_def
       by (auto simp add: field_simps)
   qed
   show ?thesis
     unfolding has_derivative_at_alt
   proof (intro conjI assms allI impI)
     fix e :: real
     assume "e > 0"
     then have *: "e / B > 0" by (metis \<open>B > 0\<close> divide_pos_pos)
     obtain d' where "0 < d'" and d':
         "\<And>z. norm (z - y) < d' \<Longrightarrow> norm (g z - g y - g' (z - y)) \<le> e / B * norm (g z - g y)"
       using lem1 * by blast
     obtain k where k: "0 < k" "k < d" "k < d'"
       using field_lbound_gt_zero[OF \<open>0 < d\<close> \<open>0 < d'\<close>] by blast
     show "\<exists>d>0. \<forall>ya. norm (ya - y) < d \<longrightarrow> norm (g ya - g y - g' (ya - y)) \<le> e * norm (ya - y)"
     proof (intro exI allI impI conjI)
       fix z
       assume as: "norm (z - y) < k"
       then have "norm (g z - g y - g' (z - y)) \<le> e / B * norm(g z - g y)"
         using d' k by auto
       also have "\<dots> \<le> e * norm (z - y)"
         unfolding times_divide_eq_left pos_divide_le_eq[OF \<open>B>0\<close>]
         using lem2[of z] k as \<open>e > 0\<close>
         by (auto simp add: field_simps)
       finally show "norm (g z - g y - g' (z - y)) \<le> e * norm (z - y)"
         by simp
     qed (use k in auto)
   qed
 qed
 
+text\<^marker>\<open>tag unimportant\<close>\<open>Inverse function theorem for complex derivatives\<close>
+lemma has_field_derivative_inverse_basic:
+  shows "DERIV f (g y) :> f' \<Longrightarrow>
+        f' \<noteq> 0 \<Longrightarrow>
+        continuous (at y) g \<Longrightarrow>
+        open t \<Longrightarrow>
+        y \<in> t \<Longrightarrow>
+        (\<And>z. z \<in> t \<Longrightarrow> f (g z) = z)
+        \<Longrightarrow> DERIV g y :> inverse (f')"
+  unfolding has_field_derivative_def
+  apply (rule has_derivative_inverse_basic)
+  apply (auto simp:  bounded_linear_mult_right)
+  done
+
 text \<open>Simply rewrite that based on the domain point x.\<close>
 
 lemma has_derivative_inverse_basic_x:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes "(f has_derivative f') (at x)"
     and "bounded_linear g'"
     and "g' \<circ> f' = id"
     and "continuous (at (f x)) g"
     and "g (f x) = x"
     and "open T"
     and "f x \<in> T"
     and "\<And>y. y \<in> T \<Longrightarrow> f (g y) = y"
   shows "(g has_derivative g') (at (f x))"
   by (rule has_derivative_inverse_basic) (use assms in auto)
 
 text \<open>This is the version in Dieudonne', assuming continuity of f and g.\<close>
 
 lemma has_derivative_inverse_dieudonne:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes "open S"
     and "open (f ` S)"
     and "continuous_on S f"
     and "continuous_on (f ` S) g"
     and "\<And>x. x \<in> S \<Longrightarrow> g (f x) = x"
     and "x \<in> S"
     and "(f has_derivative f') (at x)"
     and "bounded_linear g'"
     and "g' \<circ> f' = id"
   shows "(g has_derivative g') (at (f x))"
   apply (rule has_derivative_inverse_basic_x[OF assms(7-9) _ _ assms(2)])
   using assms(3-6)
   unfolding continuous_on_eq_continuous_at[OF assms(1)] continuous_on_eq_continuous_at[OF assms(2)]
   apply auto
   done
 
 text \<open>Here's the simplest way of not assuming much about g.\<close>
 
 proposition has_derivative_inverse:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes "compact S"
     and "x \<in> S"
     and fx: "f x \<in> interior (f ` S)"
     and "continuous_on S f"
     and gf: "\<And>y. y \<in> S \<Longrightarrow> g (f y) = y"
     and "(f has_derivative f') (at x)"
     and "bounded_linear g'"
     and "g' \<circ> f' = id"
   shows "(g has_derivative g') (at (f x))"
 proof -
   have *: "\<And>y. y \<in> interior (f ` S) \<Longrightarrow> f (g y) = y"
     by (metis gf image_iff interior_subset subsetCE)
   show ?thesis
     apply (rule has_derivative_inverse_basic_x[OF assms(6-8), where T = "interior (f ` S)"])
     apply (rule continuous_on_interior[OF _ fx])
     apply (rule continuous_on_inv)
     apply (simp_all add: assms *)
     done
 qed
 
 
 text \<open>Invertible derivative continuous at a point implies local
 injectivity. It's only for this we need continuity of the derivative,
 except of course if we want the fact that the inverse derivative is
 also continuous. So if we know for some other reason that the inverse
 function exists, it's OK.\<close>
 
 proposition has_derivative_locally_injective:
   fixes f :: "'n::euclidean_space \<Rightarrow> 'm::euclidean_space"
   assumes "a \<in> S"
       and "open S"
       and bling: "bounded_linear g'"
       and "g' \<circ> f' a = id"
       and derf: "\<And>x. x \<in> S \<Longrightarrow> (f has_derivative f' x) (at x)"
       and "\<And>e. e > 0 \<Longrightarrow> \<exists>d>0. \<forall>x. dist a x < d \<longrightarrow> onorm (\<lambda>v. f' x v - f' a v) < e"
   obtains r where "r > 0" "ball a r \<subseteq> S" "inj_on f (ball a r)"
 proof -
   interpret bounded_linear g'
     using assms by auto
   note f'g' = assms(4)[unfolded id_def o_def,THEN cong]
   have "g' (f' a (\<Sum>Basis)) = (\<Sum>Basis)" "(\<Sum>Basis) \<noteq> (0::'n)"
     using f'g' by auto
   then have *: "0 < onorm g'"
     unfolding onorm_pos_lt[OF assms(3)]
     by fastforce
   define k where "k = 1 / onorm g' / 2"
   have *: "k > 0"
     unfolding k_def using * by auto
   obtain d1 where d1:
       "0 < d1"
       "\<And>x. dist a x < d1 \<Longrightarrow> onorm (\<lambda>v. f' x v - f' a v) < k"
     using assms(6) * by blast
   from \<open>open S\<close> obtain d2 where "d2 > 0" "ball a d2 \<subseteq> S"
     using \<open>a\<in>S\<close> ..
   obtain d2 where d2: "0 < d2" "ball a d2 \<subseteq> S"
     using \<open>0 < d2\<close> \<open>ball a d2 \<subseteq> S\<close> by blast
   obtain d where d: "0 < d" "d < d1" "d < d2"
     using field_lbound_gt_zero[OF d1(1) d2(1)] by blast
   show ?thesis
   proof
     show "0 < d" by (fact d)
     show "ball a d \<subseteq> S"
       using \<open>d < d2\<close> \<open>ball a d2 \<subseteq> S\<close> by auto
     show "inj_on f (ball a d)"
     unfolding inj_on_def
     proof (intro strip)
       fix x y
       assume as: "x \<in> ball a d" "y \<in> ball a d" "f x = f y"
       define ph where [abs_def]: "ph w = w - g' (f w - f x)" for w
       have ph':"ph = g' \<circ> (\<lambda>w. f' a w - (f w - f x))"
         unfolding ph_def o_def  by (simp add: diff f'g')
       have "norm (ph x - ph y) \<le> (1 / 2) * norm (x - y)"
       proof (rule differentiable_bound[OF convex_ball _ _ as(1-2)])
         fix u
         assume u: "u \<in> ball a d"
         then have "u \<in> S"
           using d d2 by auto
         have *: "(\<lambda>v. v - g' (f' u v)) = g' \<circ> (\<lambda>w. f' a w - f' u w)"
           unfolding o_def and diff
           using f'g' by auto
         have blin: "bounded_linear (f' a)"
           using \<open>a \<in> S\<close> derf by blast
         show "(ph has_derivative (\<lambda>v. v - g' (f' u v))) (at u within ball a d)"
           unfolding ph' * comp_def
           by (rule \<open>u \<in> S\<close> derivative_eq_intros has_derivative_at_withinI [OF derf] bounded_linear.has_derivative [OF blin]  bounded_linear.has_derivative [OF bling] |simp)+
         have **: "bounded_linear (\<lambda>x. f' u x - f' a x)" "bounded_linear (\<lambda>x. f' a x - f' u x)"
           using \<open>u \<in> S\<close> blin bounded_linear_sub derf by auto
         then have "onorm (\<lambda>v. v - g' (f' u v)) \<le> onorm g' * onorm (\<lambda>w. f' a w - f' u w)"
           by (simp add: "*" bounded_linear_axioms onorm_compose)
         also have "\<dots> \<le> onorm g' * k"
           apply (rule mult_left_mono)
           using d1(2)[of u]
           using onorm_neg[where f="\<lambda>x. f' u x - f' a x"] d u onorm_pos_le[OF bling] apply (auto simp: algebra_simps)
           done
         also have "\<dots> \<le> 1 / 2"
           unfolding k_def by auto
         finally show "onorm (\<lambda>v. v - g' (f' u v)) \<le> 1 / 2" .
       qed
       moreover have "norm (ph y - ph x) = norm (y - x)"
         by (simp add: as(3) ph_def)
       ultimately show "x = y"
         unfolding norm_minus_commute by auto
     qed
   qed
 qed
 
 
 subsection \<open>Uniformly convergent sequence of derivatives\<close>
 
 lemma has_derivative_sequence_lipschitz_lemma:
   fixes f :: "nat \<Rightarrow> 'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes "convex S"
     and derf: "\<And>n x. x \<in> S \<Longrightarrow> ((f n) has_derivative (f' n x)) (at x within S)"
     and nle: "\<And>n x h. \<lbrakk>n\<ge>N; x \<in> S\<rbrakk> \<Longrightarrow> norm (f' n x h - g' x h) \<le> e * norm h"
     and "0 \<le> e"
   shows "\<forall>m\<ge>N. \<forall>n\<ge>N. \<forall>x\<in>S. \<forall>y\<in>S. norm ((f m x - f n x) - (f m y - f n y)) \<le> 2 * e * norm (x - y)"
 proof clarify
   fix m n x y
   assume as: "N \<le> m" "N \<le> n" "x \<in> S" "y \<in> S"
   show "norm ((f m x - f n x) - (f m y - f n y)) \<le> 2 * e * norm (x - y)"
   proof (rule differentiable_bound[where f'="\<lambda>x h. f' m x h - f' n x h", OF \<open>convex S\<close> _ _ as(3-4)])
     fix x
     assume "x \<in> S"
     show "((\<lambda>a. f m a - f n a) has_derivative (\<lambda>h. f' m x h - f' n x h)) (at x within S)"
       by (rule derivative_intros derf \<open>x\<in>S\<close>)+
     show "onorm (\<lambda>h. f' m x h - f' n x h) \<le> 2 * e"
     proof (rule onorm_bound)
       fix h
       have "norm (f' m x h - f' n x h) \<le> norm (f' m x h - g' x h) + norm (f' n x h - g' x h)"
         using norm_triangle_ineq[of "f' m x h - g' x h" "- f' n x h + g' x h"]
         by (auto simp add: algebra_simps norm_minus_commute)
       also have "\<dots> \<le> e * norm h + e * norm h"
         using nle[OF \<open>N \<le> m\<close> \<open>x \<in> S\<close>, of h] nle[OF \<open>N \<le> n\<close> \<open>x \<in> S\<close>, of h]
         by (auto simp add: field_simps)
       finally show "norm (f' m x h - f' n x h) \<le> 2 * e * norm h"
         by auto
     qed (simp add: \<open>0 \<le> e\<close>)
   qed
 qed
 
 lemma has_derivative_sequence_Lipschitz:
   fixes f :: "nat \<Rightarrow> 'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   assumes "convex S"
     and "\<And>n x. x \<in> S \<Longrightarrow> ((f n) has_derivative (f' n x)) (at x within S)"
     and nle: "\<And>e. e > 0 \<Longrightarrow> \<forall>\<^sub>F n in sequentially. \<forall>x\<in>S. \<forall>h. norm (f' n x h - g' x h) \<le> e * norm h"
     and "e > 0"
   shows "\<exists>N. \<forall>m\<ge>N. \<forall>n\<ge>N. \<forall>x\<in>S. \<forall>y\<in>S.
     norm ((f m x - f n x) - (f m y - f n y)) \<le> e * norm (x - y)"
 proof -
   have *: "2 * (e/2) = e"
     using \<open>e > 0\<close> by auto
   obtain N where "\<forall>n\<ge>N. \<forall>x\<in>S. \<forall>h. norm (f' n x h - g' x h) \<le> (e/2) * norm h"
     using nle \<open>e > 0\<close>
     unfolding eventually_sequentially
     by (metis less_divide_eq_numeral1(1) mult_zero_left)
   then show "\<exists>N. \<forall>m\<ge>N. \<forall>n\<ge>N. \<forall>x\<in>S. \<forall>y\<in>S. norm (f m x - f n x - (f m y - f n y)) \<le> e * norm (x - y)"
     apply (rule_tac x=N in exI)
     apply (rule has_derivative_sequence_lipschitz_lemma[where e="e/2", unfolded *])
     using assms \<open>e > 0\<close>
     apply auto
     done
 qed
 
 proposition has_derivative_sequence:
   fixes f :: "nat \<Rightarrow> 'a::real_normed_vector \<Rightarrow> 'b::banach"
   assumes "convex S"
     and derf: "\<And>n x. x \<in> S \<Longrightarrow> ((f n) has_derivative (f' n x)) (at x within S)"
     and nle: "\<And>e. e > 0 \<Longrightarrow> \<forall>\<^sub>F n in sequentially. \<forall>x\<in>S. \<forall>h. norm (f' n x h - g' x h) \<le> e * norm h"
     and "x0 \<in> S"
     and lim: "((\<lambda>n. f n x0) \<longlongrightarrow> l) sequentially"
   shows "\<exists>g. \<forall>x\<in>S. (\<lambda>n. f n x) \<longlonglongrightarrow> g x \<and> (g has_derivative g'(x)) (at x within S)"
 proof -
   have lem1: "\<And>e. e > 0 \<Longrightarrow> \<exists>N. \<forall>m\<ge>N. \<forall>n\<ge>N. \<forall>x\<in>S. \<forall>y\<in>S.
       norm ((f m x - f n x) - (f m y - f n y)) \<le> e * norm (x - y)"
     using assms(1,2,3) by (rule has_derivative_sequence_Lipschitz)
   have "\<exists>g. \<forall>x\<in>S. ((\<lambda>n. f n x) \<longlongrightarrow> g x) sequentially"
   proof (intro ballI bchoice)
     fix x
     assume "x \<in> S"
     show "\<exists>y. (\<lambda>n. f n x) \<longlonglongrightarrow> y"
     unfolding convergent_eq_Cauchy
     proof (cases "x = x0")
       case True
       then show "Cauchy (\<lambda>n. f n x)"
         using LIMSEQ_imp_Cauchy[OF lim] by auto
     next
       case False
       show "Cauchy (\<lambda>n. f n x)"
         unfolding Cauchy_def
       proof (intro allI impI)
         fix e :: real
         assume "e > 0"
         hence *: "e / 2 > 0" "e / 2 / norm (x - x0) > 0" using False by auto
         obtain M where M: "\<forall>m\<ge>M. \<forall>n\<ge>M. dist (f m x0) (f n x0) < e / 2"
           using LIMSEQ_imp_Cauchy[OF lim] * unfolding Cauchy_def by blast
         obtain N where N:
           "\<forall>m\<ge>N. \<forall>n\<ge>N.
             \<forall>u\<in>S. \<forall>y\<in>S. norm (f m u - f n u - (f m y - f n y)) \<le>
               e / 2 / norm (x - x0) * norm (u - y)"
         using lem1 *(2) by blast
         show "\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (f m x) (f n x) < e"
         proof (intro exI allI impI)
           fix m n
           assume as: "max M N \<le>m" "max M N\<le>n"
           have "dist (f m x) (f n x) \<le> norm (f m x0 - f n x0) + norm (f m x - f n x - (f m x0 - f n x0))"
             unfolding dist_norm
             by (rule norm_triangle_sub)
           also have "\<dots> \<le> norm (f m x0 - f n x0) + e / 2"
             using N \<open>x\<in>S\<close> \<open>x0\<in>S\<close> as False by fastforce
           also have "\<dots> < e / 2 + e / 2"
             by (rule add_strict_right_mono) (use as M in \<open>auto simp: dist_norm\<close>)
           finally show "dist (f m x) (f n x) < e"
             by auto
         qed
       qed
     qed
   qed
   then obtain g where g: "\<forall>x\<in>S. (\<lambda>n. f n x) \<longlonglongrightarrow> g x" ..
   have lem2: "\<exists>N. \<forall>n\<ge>N. \<forall>x\<in>S. \<forall>y\<in>S. norm ((f n x - f n y) - (g x - g y)) \<le> e * norm (x - y)" if "e > 0" for e
   proof -
     obtain N where
       N: "\<forall>m\<ge>N. \<forall>n\<ge>N. \<forall>x\<in>S. \<forall>y\<in>S. norm (f m x - f n x - (f m y - f n y)) \<le> e * norm (x - y)"
       using lem1 \<open>e > 0\<close> by blast
     show "\<exists>N. \<forall>n\<ge>N. \<forall>x\<in>S. \<forall>y\<in>S. norm (f n x - f n y - (g x - g y)) \<le> e * norm (x - y)"
     proof (intro exI ballI allI impI)
       fix n x y
       assume as: "N \<le> n" "x \<in> S" "y \<in> S"
       have "((\<lambda>m. norm (f n x - f n y - (f m x - f m y))) \<longlongrightarrow> norm (f n x - f n y - (g x - g y))) sequentially"
         by (intro tendsto_intros g[rule_format] as)
       moreover have "eventually (\<lambda>m. norm (f n x - f n y - (f m x - f m y)) \<le> e * norm (x - y)) sequentially"
         unfolding eventually_sequentially
       proof (intro exI allI impI)
         fix m
         assume "N \<le> m"
         then show "norm (f n x - f n y - (f m x - f m y)) \<le> e * norm (x - y)"
           using N as by (auto simp add: algebra_simps)
       qed
       ultimately show "norm (f n x - f n y - (g x - g y)) \<le> e * norm (x - y)"
         by (simp add: tendsto_upperbound)
     qed
   qed
   have "\<forall>x\<in>S. ((\<lambda>n. f n x) \<longlongrightarrow> g x) sequentially \<and> (g has_derivative g' x) (at x within S)"
     unfolding has_derivative_within_alt2
   proof (intro ballI conjI allI impI)
     fix x
     assume "x \<in> S"
     then show "(\<lambda>n. f n x) \<longlonglongrightarrow> g x"
       by (simp add: g)
     have tog': "(\<lambda>n. f' n x u) \<longlonglongrightarrow> g' x u" for u
       unfolding filterlim_def le_nhds_metric_le eventually_filtermap dist_norm
     proof (intro allI impI)
       fix e :: real
       assume "e > 0"
       show "eventually (\<lambda>n. norm (f' n x u - g' x u) \<le> e) sequentially"
       proof (cases "u = 0")
         case True
         have "eventually (\<lambda>n. norm (f' n x u - g' x u) \<le> e * norm u) sequentially"
           using nle \<open>0 < e\<close> \<open>x \<in> S\<close> by (fast elim: eventually_mono)
         then show ?thesis
           using \<open>u = 0\<close> \<open>0 < e\<close> by (auto elim: eventually_mono)
       next
         case False
         with \<open>0 < e\<close> have "0 < e / norm u" by simp
         then have "eventually (\<lambda>n. norm (f' n x u - g' x u) \<le> e / norm u * norm u) sequentially"
           using nle \<open>x \<in> S\<close> by (fast elim: eventually_mono)
         then show ?thesis
           using \<open>u \<noteq> 0\<close> by simp
       qed
     qed
     show "bounded_linear (g' x)"
     proof
       fix x' y z :: 'a
       fix c :: real
       note lin = assms(2)[rule_format,OF \<open>x\<in>S\<close>,THEN has_derivative_bounded_linear]
       show "g' x (c *\<^sub>R x') = c *\<^sub>R g' x x'"
         apply (rule tendsto_unique[OF trivial_limit_sequentially tog'])
         unfolding lin[THEN bounded_linear.linear, THEN linear_cmul]
         apply (intro tendsto_intros tog')
         done
       show "g' x (y + z) = g' x y + g' x z"
         apply (rule tendsto_unique[OF trivial_limit_sequentially tog'])
         unfolding lin[THEN bounded_linear.linear, THEN linear_add]
         apply (rule tendsto_add)
         apply (rule tog')+
         done
       obtain N where N: "\<forall>h. norm (f' N x h - g' x h) \<le> 1 * norm h"
         using nle \<open>x \<in> S\<close> unfolding eventually_sequentially by (fast intro: zero_less_one)
       have "bounded_linear (f' N x)"
         using derf \<open>x \<in> S\<close> by fast
       from bounded_linear.bounded [OF this]
       obtain K where K: "\<forall>h. norm (f' N x h) \<le> norm h * K" ..
       {
         fix h
         have "norm (g' x h) = norm (f' N x h - (f' N x h - g' x h))"
           by simp
         also have "\<dots> \<le> norm (f' N x h) + norm (f' N x h - g' x h)"
           by (rule norm_triangle_ineq4)
         also have "\<dots> \<le> norm h * K + 1 * norm h"
           using N K by (fast intro: add_mono)
         finally have "norm (g' x h) \<le> norm h * (K + 1)"
           by (simp add: ring_distribs)
       }
       then show "\<exists>K. \<forall>h. norm (g' x h) \<le> norm h * K" by fast
     qed
     show "eventually (\<lambda>y. norm (g y - g x - g' x (y - x)) \<le> e * norm (y - x)) (at x within S)"
       if "e > 0" for e
     proof -
       have *: "e / 3 > 0"
         using that by auto
       obtain N1 where N1: "\<forall>n\<ge>N1. \<forall>x\<in>S. \<forall>h. norm (f' n x h - g' x h) \<le> e / 3 * norm h"
         using nle * unfolding eventually_sequentially by blast
       obtain N2 where
           N2[rule_format]: "\<forall>n\<ge>N2. \<forall>x\<in>S. \<forall>y\<in>S. norm (f n x - f n y - (g x - g y)) \<le> e / 3 * norm (x - y)"
         using lem2 * by blast
       let ?N = "max N1 N2"
       have "eventually (\<lambda>y. norm (f ?N y - f ?N x - f' ?N x (y - x)) \<le> e / 3 * norm (y - x)) (at x within S)"
         using derf[unfolded has_derivative_within_alt2] and \<open>x \<in> S\<close> and * by fast
       moreover have "eventually (\<lambda>y. y \<in> S) (at x within S)"
         unfolding eventually_at by (fast intro: zero_less_one)
       ultimately show "\<forall>\<^sub>F y in at x within S. norm (g y - g x - g' x (y - x)) \<le> e * norm (y - x)"
       proof (rule eventually_elim2)
         fix y
         assume "y \<in> S"
         assume "norm (f ?N y - f ?N x - f' ?N x (y - x)) \<le> e / 3 * norm (y - x)"
         moreover have "norm (g y - g x - (f ?N y - f ?N x)) \<le> e / 3 * norm (y - x)"
           using N2[OF _ \<open>y \<in> S\<close> \<open>x \<in> S\<close>]
           by (simp add: norm_minus_commute)
         ultimately have "norm (g y - g x - f' ?N x (y - x)) \<le> 2 * e / 3 * norm (y - x)"
           using norm_triangle_le[of "g y - g x - (f ?N y - f ?N x)" "f ?N y - f ?N x - f' ?N x (y - x)" "2 * e / 3 * norm (y - x)"]
           by (auto simp add: algebra_simps)
         moreover
         have " norm (f' ?N x (y - x) - g' x (y - x)) \<le> e / 3 * norm (y - x)"
           using N1 \<open>x \<in> S\<close> by auto
         ultimately show "norm (g y - g x - g' x (y - x)) \<le> e * norm (y - x)"
           using norm_triangle_le[of "g y - g x - f' (max N1 N2) x (y - x)" "f' (max N1 N2) x (y - x) - g' x (y - x)"]
           by (auto simp add: algebra_simps)
       qed
     qed
   qed
   then show ?thesis by fast
 qed
 
 text \<open>Can choose to line up antiderivatives if we want.\<close>
 
 lemma has_antiderivative_sequence:
   fixes f :: "nat \<Rightarrow> 'a::real_normed_vector \<Rightarrow> 'b::banach"
   assumes "convex S"
     and der: "\<And>n x. x \<in> S \<Longrightarrow> ((f n) has_derivative (f' n x)) (at x within S)"
     and no: "\<And>e. e > 0 \<Longrightarrow> \<forall>\<^sub>F n in sequentially.
        \<forall>x\<in>S. \<forall>h. norm (f' n x h - g' x h) \<le> e * norm h"
   shows "\<exists>g. \<forall>x\<in>S. (g has_derivative g' x) (at x within S)"
 proof (cases "S = {}")
   case False
   then obtain a where "a \<in> S"
     by auto
   have *: "\<And>P Q. \<exists>g. \<forall>x\<in>S. P g x \<and> Q g x \<Longrightarrow> \<exists>g. \<forall>x\<in>S. Q g x"
     by auto
   show ?thesis
     apply (rule *)
     apply (rule has_derivative_sequence [OF \<open>convex S\<close> _ no, of "\<lambda>n x. f n x + (f 0 a - f n a)"])
        apply (metis assms(2) has_derivative_add_const)
     using \<open>a \<in> S\<close> 
       apply auto
     done
 qed auto
 
 lemma has_antiderivative_limit:
   fixes g' :: "'a::real_normed_vector \<Rightarrow> 'a \<Rightarrow> 'b::banach"
   assumes "convex S"
     and "\<And>e. e>0 \<Longrightarrow> \<exists>f f'. \<forall>x\<in>S.
            (f has_derivative (f' x)) (at x within S) \<and> (\<forall>h. norm (f' x h - g' x h) \<le> e * norm h)"
   shows "\<exists>g. \<forall>x\<in>S. (g has_derivative g' x) (at x within S)"
 proof -
   have *: "\<forall>n. \<exists>f f'. \<forall>x\<in>S.
     (f has_derivative (f' x)) (at x within S) \<and>
     (\<forall>h. norm(f' x h - g' x h) \<le> inverse (real (Suc n)) * norm h)"
     by (simp add: assms(2))
   obtain f where
     *: "\<And>x. \<exists>f'. \<forall>xa\<in>S. (f x has_derivative f' xa) (at xa within S) \<and>
         (\<forall>h. norm (f' xa h - g' xa h) \<le> inverse (real (Suc x)) * norm h)"
     using * by metis
   obtain f' where
     f': "\<And>x. \<forall>z\<in>S. (f x has_derivative f' x z) (at z within S) \<and>
             (\<forall>h. norm (f' x z h - g' z h) \<le> inverse (real (Suc x)) * norm h)"
     using * by metis
   show ?thesis
   proof (rule has_antiderivative_sequence[OF \<open>convex S\<close>, of f f'])
     fix e :: real
     assume "e > 0"
     obtain N where N: "inverse (real (Suc N)) < e"
       using reals_Archimedean[OF \<open>e>0\<close>] ..
     show "\<forall>\<^sub>F n in sequentially. \<forall>x\<in>S.  \<forall>h. norm (f' n x h - g' x h) \<le> e * norm h"
         unfolding eventually_sequentially
     proof (intro exI allI ballI impI)
       fix n x h
       assume n: "N \<le> n" and x: "x \<in> S"
       have *: "inverse (real (Suc n)) \<le> e"
         apply (rule order_trans[OF _ N[THEN less_imp_le]])
         using n apply (auto simp add: field_simps)
         done
       show "norm (f' n x h - g' x h) \<le> e * norm h"
         by (meson "*" mult_right_mono norm_ge_zero order.trans x f')
     qed
   qed (use f' in auto)
 qed
 
 
 subsection \<open>Differentiation of a series\<close>
 
 proposition has_derivative_series:
   fixes f :: "nat \<Rightarrow> 'a::real_normed_vector \<Rightarrow> 'b::banach"
   assumes "convex S"
     and "\<And>n x. x \<in> S \<Longrightarrow> ((f n) has_derivative (f' n x)) (at x within S)"
     and "\<And>e. e>0 \<Longrightarrow> \<forall>\<^sub>F n in sequentially. \<forall>x\<in>S. \<forall>h. norm (sum (\<lambda>i. f' i x h) {..<n} - g' x h) \<le> e * norm h"
     and "x \<in> S"
     and "(\<lambda>n. f n x) sums l"
   shows "\<exists>g. \<forall>x\<in>S. (\<lambda>n. f n x) sums (g x) \<and> (g has_derivative g' x) (at x within S)"
   unfolding sums_def
   apply (rule has_derivative_sequence[OF assms(1) _ assms(3)])
   apply (metis assms(2) has_derivative_sum)
   using assms(4-5)
   unfolding sums_def
   apply auto
   done
 
 lemma has_field_derivative_series:
   fixes f :: "nat \<Rightarrow> ('a :: {real_normed_field,banach}) \<Rightarrow> 'a"
   assumes "convex S"
   assumes "\<And>n x. x \<in> S \<Longrightarrow> (f n has_field_derivative f' n x) (at x within S)"
   assumes "uniform_limit S (\<lambda>n x. \<Sum>i<n. f' i x) g' sequentially"
   assumes "x0 \<in> S" "summable (\<lambda>n. f n x0)"
   shows   "\<exists>g. \<forall>x\<in>S. (\<lambda>n. f n x) sums g x \<and> (g has_field_derivative g' x) (at x within S)"
 unfolding has_field_derivative_def
 proof (rule has_derivative_series)
   show "\<forall>\<^sub>F n in sequentially.
        \<forall>x\<in>S. \<forall>h. norm ((\<Sum>i<n. f' i x * h) - g' x * h) \<le> e * norm h" if "e > 0" for e
     unfolding eventually_sequentially
   proof -
     from that assms(3) obtain N where N: "\<And>n x. n \<ge> N \<Longrightarrow> x \<in> S \<Longrightarrow> norm ((\<Sum>i<n. f' i x) - g' x) < e"
       unfolding uniform_limit_iff eventually_at_top_linorder dist_norm by blast
     {
       fix n :: nat and x h :: 'a assume nx: "n \<ge> N" "x \<in> S"
       have "norm ((\<Sum>i<n. f' i x * h) - g' x * h) = norm ((\<Sum>i<n. f' i x) - g' x) * norm h"
         by (simp add: norm_mult [symmetric] ring_distribs sum_distrib_right)
       also from N[OF nx] have "norm ((\<Sum>i<n. f' i x) - g' x) \<le> e" by simp
       hence "norm ((\<Sum>i<n. f' i x) - g' x) * norm h \<le> e * norm h"
         by (intro mult_right_mono) simp_all
       finally have "norm ((\<Sum>i<n. f' i x * h) - g' x * h) \<le> e * norm h" .
     }
     thus "\<exists>N. \<forall>n\<ge>N. \<forall>x\<in>S. \<forall>h. norm ((\<Sum>i<n. f' i x * h) - g' x * h) \<le> e * norm h" by blast
   qed
 qed (use assms in \<open>auto simp: has_field_derivative_def\<close>)
 
 lemma has_field_derivative_series':
   fixes f :: "nat \<Rightarrow> ('a :: {real_normed_field,banach}) \<Rightarrow> 'a"
   assumes "convex S"
   assumes "\<And>n x. x \<in> S \<Longrightarrow> (f n has_field_derivative f' n x) (at x within S)"
   assumes "uniformly_convergent_on S (\<lambda>n x. \<Sum>i<n. f' i x)"
   assumes "x0 \<in> S" "summable (\<lambda>n. f n x0)" "x \<in> interior S"
   shows   "summable (\<lambda>n. f n x)" "((\<lambda>x. \<Sum>n. f n x) has_field_derivative (\<Sum>n. f' n x)) (at x)"
 proof -
   from \<open>x \<in> interior S\<close> have "x \<in> S" using interior_subset by blast
   define g' where [abs_def]: "g' x = (\<Sum>i. f' i x)" for x
   from assms(3) have "uniform_limit S (\<lambda>n x. \<Sum>i<n. f' i x) g' sequentially"
     by (simp add: uniformly_convergent_uniform_limit_iff suminf_eq_lim g'_def)
   from has_field_derivative_series[OF assms(1,2) this assms(4,5)] obtain g where g:
     "\<And>x. x \<in> S \<Longrightarrow> (\<lambda>n. f n x) sums g x"
     "\<And>x. x \<in> S \<Longrightarrow> (g has_field_derivative g' x) (at x within S)" by blast
   from g(1)[OF \<open>x \<in> S\<close>] show "summable (\<lambda>n. f n x)" by (simp add: sums_iff)
   from g(2)[OF \<open>x \<in> S\<close>] \<open>x \<in> interior S\<close> have "(g has_field_derivative g' x) (at x)"
     by (simp add: at_within_interior[of x S])
   also have "(g has_field_derivative g' x) (at x) \<longleftrightarrow>
                 ((\<lambda>x. \<Sum>n. f n x) has_field_derivative g' x) (at x)"
     using eventually_nhds_in_nhd[OF \<open>x \<in> interior S\<close>] interior_subset[of S] g(1)
     by (intro DERIV_cong_ev) (auto elim!: eventually_mono simp: sums_iff)
   finally show "((\<lambda>x. \<Sum>n. f n x) has_field_derivative g' x) (at x)" .
 qed
 
 lemma differentiable_series:
   fixes f :: "nat \<Rightarrow> ('a :: {real_normed_field,banach}) \<Rightarrow> 'a"
   assumes "convex S" "open S"
   assumes "\<And>n x. x \<in> S \<Longrightarrow> (f n has_field_derivative f' n x) (at x)"
   assumes "uniformly_convergent_on S (\<lambda>n x. \<Sum>i<n. f' i x)"
   assumes "x0 \<in> S" "summable (\<lambda>n. f n x0)" and x: "x \<in> S"
   shows   "summable (\<lambda>n. f n x)" and "(\<lambda>x. \<Sum>n. f n x) differentiable (at x)"
 proof -
   from assms(4) obtain g' where A: "uniform_limit S (\<lambda>n x. \<Sum>i<n. f' i x) g' sequentially"
     unfolding uniformly_convergent_on_def by blast
   from x and \<open>open S\<close> have S: "at x within S = at x" by (rule at_within_open)
   have "\<exists>g. \<forall>x\<in>S. (\<lambda>n. f n x) sums g x \<and> (g has_field_derivative g' x) (at x within S)"
     by (intro has_field_derivative_series[of S f f' g' x0] assms A has_field_derivative_at_within)
   then obtain g where g: "\<And>x. x \<in> S \<Longrightarrow> (\<lambda>n. f n x) sums g x"
     "\<And>x. x \<in> S \<Longrightarrow> (g has_field_derivative g' x) (at x within S)" by blast
   from g[OF x] show "summable (\<lambda>n. f n x)" by (auto simp: summable_def)
   from g(2)[OF x] have g': "(g has_derivative (*) (g' x)) (at x)"
     by (simp add: has_field_derivative_def S)
   have "((\<lambda>x. \<Sum>n. f n x) has_derivative (*) (g' x)) (at x)"
     by (rule has_derivative_transform_within_open[OF g' \<open>open S\<close> x])
        (insert g, auto simp: sums_iff)
   thus "(\<lambda>x. \<Sum>n. f n x) differentiable (at x)" unfolding differentiable_def
     by (auto simp: summable_def differentiable_def has_field_derivative_def)
 qed
 
 lemma differentiable_series':
   fixes f :: "nat \<Rightarrow> ('a :: {real_normed_field,banach}) \<Rightarrow> 'a"
   assumes "convex S" "open S"
   assumes "\<And>n x. x \<in> S \<Longrightarrow> (f n has_field_derivative f' n x) (at x)"
   assumes "uniformly_convergent_on S (\<lambda>n x. \<Sum>i<n. f' i x)"
   assumes "x0 \<in> S" "summable (\<lambda>n. f n x0)"
   shows   "(\<lambda>x. \<Sum>n. f n x) differentiable (at x0)"
   using differentiable_series[OF assms, of x0] \<open>x0 \<in> S\<close> by blast+
 
 subsection \<open>Derivative as a vector\<close>
 
 text \<open>Considering derivative \<^typ>\<open>real \<Rightarrow> 'b::real_normed_vector\<close> as a vector.\<close>
 
 definition "vector_derivative f net = (SOME f'. (f has_vector_derivative f') net)"
 
 lemma vector_derivative_unique_within:
   assumes not_bot: "at x within S \<noteq> bot"
     and f': "(f has_vector_derivative f') (at x within S)"
     and f'': "(f has_vector_derivative f'') (at x within S)"
   shows "f' = f''"
 proof -
   have "(\<lambda>x. x *\<^sub>R f') = (\<lambda>x. x *\<^sub>R f'')"
   proof (rule frechet_derivative_unique_within, simp_all)
     show "\<exists>d. d \<noteq> 0 \<and> \<bar>d\<bar> < e \<and> x + d \<in> S" if "0 < e"  for e
     proof -
       from that
       obtain x' where "x' \<in> S" "x' \<noteq> x" "\<bar>x' - x\<bar> < e"
         using islimpt_approachable_real[of x S] not_bot
         by (auto simp add: trivial_limit_within)
       then show ?thesis
         using eq_iff_diff_eq_0 by fastforce
     qed
   qed (use f' f'' in \<open>auto simp: has_vector_derivative_def\<close>)
   then show ?thesis
     unfolding fun_eq_iff by (metis scaleR_one)
 qed
 
 lemma vector_derivative_unique_at:
   "(f has_vector_derivative f') (at x) \<Longrightarrow> (f has_vector_derivative f'') (at x) \<Longrightarrow> f' = f''"
   by (rule vector_derivative_unique_within) auto
 
 lemma differentiableI_vector: "(f has_vector_derivative y) F \<Longrightarrow> f differentiable F"
   by (auto simp: differentiable_def has_vector_derivative_def)
 
 proposition vector_derivative_works:
   "f differentiable net \<longleftrightarrow> (f has_vector_derivative (vector_derivative f net)) net"
     (is "?l = ?r")
 proof
   assume ?l
   obtain f' where f': "(f has_derivative f') net"
     using \<open>?l\<close> unfolding differentiable_def ..
   then interpret bounded_linear f'
     by auto
   show ?r
     unfolding vector_derivative_def has_vector_derivative_def
     by (rule someI[of _ "f' 1"]) (simp add: scaleR[symmetric] f')
 qed (auto simp: vector_derivative_def has_vector_derivative_def differentiable_def)
 
 lemma vector_derivative_within:
   assumes not_bot: "at x within S \<noteq> bot" and y: "(f has_vector_derivative y) (at x within S)"
   shows "vector_derivative f (at x within S) = y"
   using y
   by (intro vector_derivative_unique_within[OF not_bot vector_derivative_works[THEN iffD1] y])
      (auto simp: differentiable_def has_vector_derivative_def)
 
 lemma frechet_derivative_eq_vector_derivative:
   assumes "f differentiable (at x)"
     shows  "(frechet_derivative f (at x)) = (\<lambda>r. r *\<^sub>R vector_derivative f (at x))"
 using assms
 by (auto simp: differentiable_iff_scaleR vector_derivative_def has_vector_derivative_def
          intro: someI frechet_derivative_at [symmetric])
 
 lemma has_real_derivative:
   fixes f :: "real \<Rightarrow> real"
   assumes "(f has_derivative f') F"
   obtains c where "(f has_real_derivative c) F"
 proof -
   obtain c where "f' = (\<lambda>x. x * c)"
     by (metis assms has_derivative_bounded_linear real_bounded_linear)
   then show ?thesis
     by (metis assms that has_field_derivative_def mult_commute_abs)
 qed
 
 lemma has_real_derivative_iff:
   fixes f :: "real \<Rightarrow> real"
   shows "(\<exists>c. (f has_real_derivative c) F) = (\<exists>D. (f has_derivative D) F)"
   by (metis has_field_derivative_def has_real_derivative)
 
 lemma has_vector_derivative_cong_ev:
   assumes *: "eventually (\<lambda>x. x \<in> S \<longrightarrow> f x = g x) (nhds x)" "f x = g x"
   shows "(f has_vector_derivative f') (at x within S) = (g has_vector_derivative f') (at x within S)"
   unfolding has_vector_derivative_def has_derivative_def
   using *
   apply (cases "at x within S \<noteq> bot")
   apply (intro refl conj_cong filterlim_cong)
   apply (auto simp: Lim_ident_at eventually_at_filter elim: eventually_mono)
   done
 
 lemma islimpt_closure_open:
   fixes s :: "'a::perfect_space set"
   assumes "open s" and t: "t = closure s" "x \<in> t"
   shows "x islimpt t"
 proof cases
   assume "x \<in> s"
   { fix T assume "x \<in> T" "open T"
     then have "open (s \<inter> T)"
       using \<open>open s\<close> by auto
     then have "s \<inter> T \<noteq> {x}"
       using not_open_singleton[of x] by auto
     with \<open>x \<in> T\<close> \<open>x \<in> s\<close> have "\<exists>y\<in>t. y \<in> T \<and> y \<noteq> x"
       using closure_subset[of s] by (auto simp: t) }
   then show ?thesis
     by (auto intro!: islimptI)
 next
   assume "x \<notin> s" with t show ?thesis
     unfolding t closure_def by (auto intro: islimpt_subset)
 qed
 
 lemma vector_derivative_unique_within_closed_interval:
   assumes ab: "a < b" "x \<in> cbox a b"
   assumes D: "(f has_vector_derivative f') (at x within cbox a b)" "(f has_vector_derivative f'') (at x within cbox a b)"
   shows "f' = f''"
   using ab
   by (intro vector_derivative_unique_within[OF _ D])
      (auto simp: trivial_limit_within intro!: islimpt_closure_open[where s="{a <..< b}"])
 
 lemma vector_derivative_at:
   "(f has_vector_derivative f') (at x) \<Longrightarrow> vector_derivative f (at x) = f'"
   by (intro vector_derivative_within at_neq_bot)
 
 lemma has_vector_derivative_id_at [simp]: "vector_derivative (\<lambda>x. x) (at a) = 1"
   by (simp add: vector_derivative_at)
 
 lemma vector_derivative_minus_at [simp]:
   "f differentiable at a
    \<Longrightarrow> vector_derivative (\<lambda>x. - f x) (at a) = - vector_derivative f (at a)"
   by (simp add: vector_derivative_at has_vector_derivative_minus vector_derivative_works [symmetric])
 
 lemma vector_derivative_add_at [simp]:
   "\<lbrakk>f differentiable at a; g differentiable at a\<rbrakk>
    \<Longrightarrow> vector_derivative (\<lambda>x. f x + g x) (at a) = vector_derivative f (at a) + vector_derivative g (at a)"
   by (simp add: vector_derivative_at has_vector_derivative_add vector_derivative_works [symmetric])
 
 lemma vector_derivative_diff_at [simp]:
   "\<lbrakk>f differentiable at a; g differentiable at a\<rbrakk>
    \<Longrightarrow> vector_derivative (\<lambda>x. f x - g x) (at a) = vector_derivative f (at a) - vector_derivative g (at a)"
   by (simp add: vector_derivative_at has_vector_derivative_diff vector_derivative_works [symmetric])
 
 lemma vector_derivative_mult_at [simp]:
   fixes f g :: "real \<Rightarrow> 'a :: real_normed_algebra"
   shows  "\<lbrakk>f differentiable at a; g differentiable at a\<rbrakk>
    \<Longrightarrow> vector_derivative (\<lambda>x. f x * g x) (at a) = f a * vector_derivative g (at a) + vector_derivative f (at a) * g a"
   by (simp add: vector_derivative_at has_vector_derivative_mult vector_derivative_works [symmetric])
 
 lemma vector_derivative_scaleR_at [simp]:
     "\<lbrakk>f differentiable at a; g differentiable at a\<rbrakk>
    \<Longrightarrow> vector_derivative (\<lambda>x. f x *\<^sub>R g x) (at a) = f a *\<^sub>R vector_derivative g (at a) + vector_derivative f (at a) *\<^sub>R g a"
 apply (rule vector_derivative_at)
 apply (rule has_vector_derivative_scaleR)
 apply (auto simp: vector_derivative_works has_vector_derivative_def has_field_derivative_def mult_commute_abs)
 done
 
 lemma vector_derivative_within_cbox:
   assumes ab: "a < b" "x \<in> cbox a b"
   assumes f: "(f has_vector_derivative f') (at x within cbox a b)"
   shows "vector_derivative f (at x within cbox a b) = f'"
   by (intro vector_derivative_unique_within_closed_interval[OF ab _ f]
             vector_derivative_works[THEN iffD1] differentiableI_vector)
      fact
 
 lemma vector_derivative_within_closed_interval:
   fixes f::"real \<Rightarrow> 'a::euclidean_space"
   assumes "a < b" and "x \<in> {a..b}"
   assumes "(f has_vector_derivative f') (at x within {a..b})"
   shows "vector_derivative f (at x within {a..b}) = f'"
   using assms vector_derivative_within_cbox
   by fastforce
 
 lemma has_vector_derivative_within_subset:
   "(f has_vector_derivative f') (at x within S) \<Longrightarrow> T \<subseteq> S \<Longrightarrow> (f has_vector_derivative f') (at x within T)"
   by (auto simp: has_vector_derivative_def intro: has_derivative_within_subset)
 
 lemma has_vector_derivative_at_within:
   "(f has_vector_derivative f') (at x) \<Longrightarrow> (f has_vector_derivative f') (at x within S)"
   unfolding has_vector_derivative_def
   by (rule has_derivative_at_withinI)
 
 lemma has_vector_derivative_weaken:
   fixes x D and f g S T
   assumes f: "(f has_vector_derivative D) (at x within T)"
     and "x \<in> S" "S \<subseteq> T"
     and "\<And>x. x \<in> S \<Longrightarrow> f x = g x"
   shows "(g has_vector_derivative D) (at x within S)"
 proof -
   have "(f has_vector_derivative D) (at x within S) \<longleftrightarrow> (g has_vector_derivative D) (at x within S)"
     unfolding has_vector_derivative_def has_derivative_iff_norm
     using assms by (intro conj_cong Lim_cong_within refl) auto
   then show ?thesis
     using has_vector_derivative_within_subset[OF f \<open>S \<subseteq> T\<close>] by simp
 qed
 
 lemma has_vector_derivative_transform_within:
   assumes "(f has_vector_derivative f') (at x within S)"
     and "0 < d"
     and "x \<in> S"
     and "\<And>x'. \<lbrakk>x'\<in>S; dist x' x < d\<rbrakk> \<Longrightarrow> f x' = g x'"
     shows "(g has_vector_derivative f') (at x within S)"
   using assms
   unfolding has_vector_derivative_def
   by (rule has_derivative_transform_within)
 
 lemma has_vector_derivative_transform_within_open:
   assumes "(f has_vector_derivative f') (at x)"
     and "open S"
     and "x \<in> S"
     and "\<And>y. y\<in>S \<Longrightarrow> f y = g y"
   shows "(g has_vector_derivative f') (at x)"
   using assms
   unfolding has_vector_derivative_def
   by (rule has_derivative_transform_within_open)
 
 lemma has_vector_derivative_transform:
   assumes "x \<in> S" "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
   assumes f': "(f has_vector_derivative f') (at x within S)"
   shows "(g has_vector_derivative f') (at x within S)"
   using assms
   unfolding has_vector_derivative_def
   by (rule has_derivative_transform)
 
 lemma vector_diff_chain_at:
   assumes "(f has_vector_derivative f') (at x)"
     and "(g has_vector_derivative g') (at (f x))"
   shows "((g \<circ> f) has_vector_derivative (f' *\<^sub>R g')) (at x)"
   using assms has_vector_derivative_at_within has_vector_derivative_def vector_derivative_diff_chain_within by blast
 
 lemma vector_diff_chain_within:
   assumes "(f has_vector_derivative f') (at x within s)"
     and "(g has_vector_derivative g') (at (f x) within f ` s)"
   shows "((g \<circ> f) has_vector_derivative (f' *\<^sub>R g')) (at x within s)"
   using assms has_vector_derivative_def vector_derivative_diff_chain_within by blast
 
 lemma vector_derivative_const_at [simp]: "vector_derivative (\<lambda>x. c) (at a) = 0"
   by (simp add: vector_derivative_at)
 
 lemma vector_derivative_at_within_ivl:
   "(f has_vector_derivative f') (at x) \<Longrightarrow>
     a \<le> x \<Longrightarrow> x \<le> b \<Longrightarrow> a<b \<Longrightarrow> vector_derivative f (at x within {a..b}) = f'"
   using has_vector_derivative_at_within vector_derivative_within_cbox by fastforce
 
 lemma vector_derivative_chain_at:
   assumes "f differentiable at x" "(g differentiable at (f x))"
   shows "vector_derivative (g \<circ> f) (at x) =
          vector_derivative f (at x) *\<^sub>R vector_derivative g (at (f x))"
 by (metis vector_diff_chain_at vector_derivative_at vector_derivative_works assms)
 
 lemma field_vector_diff_chain_at:  (*thanks to Wenda Li*)
  assumes Df: "(f has_vector_derivative f') (at x)"
      and Dg: "(g has_field_derivative g') (at (f x))"
  shows "((g \<circ> f) has_vector_derivative (f' * g')) (at x)"
 using diff_chain_at[OF Df[unfolded has_vector_derivative_def]
                        Dg [unfolded has_field_derivative_def]]
  by (auto simp: o_def mult.commute has_vector_derivative_def)
 
 lemma vector_derivative_chain_within: 
   assumes "at x within S \<noteq> bot" "f differentiable (at x within S)" 
     "(g has_derivative g') (at (f x) within f ` S)" 
   shows "vector_derivative (g \<circ> f) (at x within S) =
         g' (vector_derivative f (at x within S)) "
   apply (rule vector_derivative_within [OF \<open>at x within S \<noteq> bot\<close>])
   apply (rule vector_derivative_diff_chain_within)
   using assms(2-3) vector_derivative_works
   by auto
 
 subsection \<open>Field differentiability\<close>
 
 definition\<^marker>\<open>tag important\<close> field_differentiable :: "['a \<Rightarrow> 'a::real_normed_field, 'a filter] \<Rightarrow> bool"
            (infixr "(field'_differentiable)" 50)
   where "f field_differentiable F \<equiv> \<exists>f'. (f has_field_derivative f') F"
 
 lemma field_differentiable_imp_differentiable:
   "f field_differentiable F \<Longrightarrow> f differentiable F"
   unfolding field_differentiable_def differentiable_def 
   using has_field_derivative_imp_has_derivative by auto
 
 lemma field_differentiable_imp_continuous_at:
     "f field_differentiable (at x within S) \<Longrightarrow> continuous (at x within S) f"
   by (metis DERIV_continuous field_differentiable_def)
 
 lemma field_differentiable_within_subset:
     "\<lbrakk>f field_differentiable (at x within S); T \<subseteq> S\<rbrakk> \<Longrightarrow> f field_differentiable (at x within T)"
   by (metis DERIV_subset field_differentiable_def)
 
 lemma field_differentiable_at_within:
     "\<lbrakk>f field_differentiable (at x)\<rbrakk>
      \<Longrightarrow> f field_differentiable (at x within S)"
   unfolding field_differentiable_def
   by (metis DERIV_subset top_greatest)
 
 lemma field_differentiable_linear [simp,derivative_intros]: "((*) c) field_differentiable F"
   unfolding field_differentiable_def has_field_derivative_def mult_commute_abs
   by (force intro: has_derivative_mult_right)
 
 lemma field_differentiable_const [simp,derivative_intros]: "(\<lambda>z. c) field_differentiable F"
   unfolding field_differentiable_def has_field_derivative_def
   using DERIV_const has_field_derivative_imp_has_derivative by blast
 
 lemma field_differentiable_ident [simp,derivative_intros]: "(\<lambda>z. z) field_differentiable F"
   unfolding field_differentiable_def has_field_derivative_def
   using DERIV_ident has_field_derivative_def by blast
 
 lemma field_differentiable_id [simp,derivative_intros]: "id field_differentiable F"
   unfolding id_def by (rule field_differentiable_ident)
 
 lemma field_differentiable_minus [derivative_intros]:
   "f field_differentiable F \<Longrightarrow> (\<lambda>z. - (f z)) field_differentiable F"
   unfolding field_differentiable_def
   by (metis field_differentiable_minus)
 
 lemma field_differentiable_add [derivative_intros]:
   assumes "f field_differentiable F" "g field_differentiable F"
     shows "(\<lambda>z. f z + g z) field_differentiable F"
   using assms unfolding field_differentiable_def
   by (metis field_differentiable_add)
 
 lemma field_differentiable_add_const [simp,derivative_intros]:
      "(+) c field_differentiable F"
   by (simp add: field_differentiable_add)
 
 lemma field_differentiable_sum [derivative_intros]:
   "(\<And>i. i \<in> I \<Longrightarrow> (f i) field_differentiable F) \<Longrightarrow> (\<lambda>z. \<Sum>i\<in>I. f i z) field_differentiable F"
   by (induct I rule: infinite_finite_induct)
      (auto intro: field_differentiable_add field_differentiable_const)
 
 lemma field_differentiable_diff [derivative_intros]:
   assumes "f field_differentiable F" "g field_differentiable F"
     shows "(\<lambda>z. f z - g z) field_differentiable F"
   using assms unfolding field_differentiable_def
   by (metis field_differentiable_diff)
 
 lemma field_differentiable_inverse [derivative_intros]:
   assumes "f field_differentiable (at a within S)" "f a \<noteq> 0"
   shows "(\<lambda>z. inverse (f z)) field_differentiable (at a within S)"
   using assms unfolding field_differentiable_def
   by (metis DERIV_inverse_fun)
 
 lemma field_differentiable_mult [derivative_intros]:
   assumes "f field_differentiable (at a within S)"
           "g field_differentiable (at a within S)"
     shows "(\<lambda>z. f z * g z) field_differentiable (at a within S)"
   using assms unfolding field_differentiable_def
   by (metis DERIV_mult [of f _ a S g])
 
 lemma field_differentiable_divide [derivative_intros]:
   assumes "f field_differentiable (at a within S)"
           "g field_differentiable (at a within S)"
           "g a \<noteq> 0"
     shows "(\<lambda>z. f z / g z) field_differentiable (at a within S)"
   using assms unfolding field_differentiable_def
   by (metis DERIV_divide [of f _ a S g])
 
 lemma field_differentiable_power [derivative_intros]:
   assumes "f field_differentiable (at a within S)"
     shows "(\<lambda>z. f z ^ n) field_differentiable (at a within S)"
   using assms unfolding field_differentiable_def
   by (metis DERIV_power)
 
 lemma field_differentiable_transform_within:
   "0 < d \<Longrightarrow>
         x \<in> S \<Longrightarrow>
         (\<And>x'. x' \<in> S \<Longrightarrow> dist x' x < d \<Longrightarrow> f x' = g x') \<Longrightarrow>
         f field_differentiable (at x within S)
         \<Longrightarrow> g field_differentiable (at x within S)"
   unfolding field_differentiable_def has_field_derivative_def
   by (blast intro: has_derivative_transform_within)
 
 lemma field_differentiable_compose_within:
   assumes "f field_differentiable (at a within S)"
           "g field_differentiable (at (f a) within f`S)"
     shows "(g o f) field_differentiable (at a within S)"
   using assms unfolding field_differentiable_def
   by (metis DERIV_image_chain)
 
 lemma field_differentiable_compose:
   "f field_differentiable at z \<Longrightarrow> g field_differentiable at (f z)
           \<Longrightarrow> (g o f) field_differentiable at z"
 by (metis field_differentiable_at_within field_differentiable_compose_within)
 
 lemma field_differentiable_within_open:
      "\<lbrakk>a \<in> S; open S\<rbrakk> \<Longrightarrow> f field_differentiable at a within S \<longleftrightarrow>
                           f field_differentiable at a"
   unfolding field_differentiable_def
   by (metis at_within_open)
 
 lemma exp_scaleR_has_vector_derivative_right:
   "((\<lambda>t. exp (t *\<^sub>R A)) has_vector_derivative exp (t *\<^sub>R A) * A) (at t within T)"
   unfolding has_vector_derivative_def
 proof (rule has_derivativeI)
   let ?F = "at t within (T \<inter> {t - 1 <..< t + 1})"
   have *: "at t within T = ?F"
     by (rule at_within_nhd[where S="{t - 1 <..< t + 1}"]) auto
   let ?e = "\<lambda>i x. (inverse (1 + real i) * inverse (fact i) * (x - t) ^ i) *\<^sub>R (A * A ^ i)"
   have "\<forall>\<^sub>F n in sequentially.
       \<forall>x\<in>T \<inter> {t - 1<..<t + 1}. norm (?e n x) \<le> norm (A ^ (n + 1) /\<^sub>R fact (n + 1))"
     apply (auto simp: algebra_split_simps intro!: eventuallyI)
     apply (rule mult_left_mono)
      apply (auto simp add: field_simps power_abs intro!: divide_right_mono power_le_one)
     done
   then have "uniform_limit (T \<inter> {t - 1<..<t + 1}) (\<lambda>n x. \<Sum>i<n. ?e i x) (\<lambda>x. \<Sum>i. ?e i x) sequentially"
     by (rule Weierstrass_m_test_ev) (intro summable_ignore_initial_segment summable_norm_exp)
   moreover
   have "\<forall>\<^sub>F x in sequentially. x > 0"
     by (metis eventually_gt_at_top)
   then have
     "\<forall>\<^sub>F n in sequentially. ((\<lambda>x. \<Sum>i<n. ?e i x) \<longlongrightarrow> A) ?F"
     by eventually_elim
       (auto intro!: tendsto_eq_intros
         simp: power_0_left if_distrib if_distribR
         cong: if_cong)
   ultimately
   have [tendsto_intros]: "((\<lambda>x. \<Sum>i. ?e i x) \<longlongrightarrow> A) ?F"
     by (auto intro!: swap_uniform_limit[where f="\<lambda>n x. \<Sum>i < n. ?e i x" and F = sequentially])
   have [tendsto_intros]: "((\<lambda>x. if x = t then 0 else 1) \<longlongrightarrow> 1) ?F"
     by (rule tendsto_eventually) (simp add: eventually_at_filter)
   have "((\<lambda>y. ((y - t) / abs (y - t)) *\<^sub>R ((\<Sum>n. ?e n y) - A)) \<longlongrightarrow> 0) (at t within T)"
     unfolding *
     by (rule tendsto_norm_zero_cancel) (auto intro!: tendsto_eq_intros)
 
   moreover have "\<forall>\<^sub>F x in at t within T. x \<noteq> t"
     by (simp add: eventually_at_filter)
   then have "\<forall>\<^sub>F x in at t within T. ((x - t) / \<bar>x - t\<bar>) *\<^sub>R ((\<Sum>n. ?e n x) - A) =
     (exp ((x - t) *\<^sub>R A) - 1 - (x - t) *\<^sub>R A) /\<^sub>R norm (x - t)"
   proof eventually_elim
     case (elim x)
     have "(exp ((x - t) *\<^sub>R A) - 1 - (x - t) *\<^sub>R A) /\<^sub>R norm (x - t) =
       ((\<Sum>n. (x - t) *\<^sub>R ?e n x) - (x - t) *\<^sub>R A) /\<^sub>R norm (x - t)"
       unfolding exp_first_term
       by (simp add: ac_simps)
     also
     have "summable (\<lambda>n. ?e n x)"
     proof -
       from elim have "?e n x = (((x - t) *\<^sub>R A) ^ (n + 1)) /\<^sub>R fact (n + 1) /\<^sub>R (x - t)" for n
         by simp
       then show ?thesis
         by (auto simp only:
           intro!: summable_scaleR_right summable_ignore_initial_segment summable_exp_generic)
     qed
     then have "(\<Sum>n. (x - t) *\<^sub>R ?e n x) = (x - t) *\<^sub>R (\<Sum>n. ?e n x)"
       by (rule suminf_scaleR_right[symmetric])
     also have "(\<dots> - (x - t) *\<^sub>R A) /\<^sub>R norm (x - t) = (x - t) *\<^sub>R ((\<Sum>n. ?e n x) - A) /\<^sub>R norm (x - t)"
       by (simp add: algebra_simps)
     finally show ?case
       by simp (simp add: field_simps)
   qed
 
   ultimately have "((\<lambda>y. (exp ((y - t) *\<^sub>R A) - 1 - (y - t) *\<^sub>R A) /\<^sub>R norm (y - t)) \<longlongrightarrow> 0) (at t within T)"
     by (rule Lim_transform_eventually)
   from tendsto_mult_right_zero[OF this, where c="exp (t *\<^sub>R A)"]
   show "((\<lambda>y. (exp (y *\<^sub>R A) - exp (t *\<^sub>R A) - (y - t) *\<^sub>R (exp (t *\<^sub>R A) * A)) /\<^sub>R norm (y - t)) \<longlongrightarrow> 0)
       (at t within T)"
     by (rule Lim_transform_eventually)
       (auto simp: algebra_simps field_split_simps exp_add_commuting[symmetric])
 qed (rule bounded_linear_scaleR_left)
 
 lemma exp_times_scaleR_commute: "exp (t *\<^sub>R A) * A = A * exp (t *\<^sub>R A)"
   using exp_times_arg_commute[symmetric, of "t *\<^sub>R A"]
   by (auto simp: algebra_simps)
 
 lemma exp_scaleR_has_vector_derivative_left: "((\<lambda>t. exp (t *\<^sub>R A)) has_vector_derivative A * exp (t *\<^sub>R A)) (at t)"
   using exp_scaleR_has_vector_derivative_right[of A t]
   by (simp add: exp_times_scaleR_commute)
 
+lemma field_differentiable_series:
+  fixes f :: "nat \<Rightarrow> 'a::{real_normed_field,banach} \<Rightarrow> 'a"
+  assumes "convex S" "open S"
+  assumes "\<And>n x. x \<in> S \<Longrightarrow> (f n has_field_derivative f' n x) (at x)"
+  assumes "uniformly_convergent_on S (\<lambda>n x. \<Sum>i<n. f' i x)"
+  assumes "x0 \<in> S" "summable (\<lambda>n. f n x0)" and x: "x \<in> S"
+  shows  "(\<lambda>x. \<Sum>n. f n x) field_differentiable (at x)"
+proof -
+  from assms(4) obtain g' where A: "uniform_limit S (\<lambda>n x. \<Sum>i<n. f' i x) g' sequentially"
+    unfolding uniformly_convergent_on_def by blast
+  from x and \<open>open S\<close> have S: "at x within S = at x" by (rule at_within_open)
+  have "\<exists>g. \<forall>x\<in>S. (\<lambda>n. f n x) sums g x \<and> (g has_field_derivative g' x) (at x within S)"
+    by (intro has_field_derivative_series[of S f f' g' x0] assms A has_field_derivative_at_within)
+  then obtain g where g: "\<And>x. x \<in> S \<Longrightarrow> (\<lambda>n. f n x) sums g x"
+    "\<And>x. x \<in> S \<Longrightarrow> (g has_field_derivative g' x) (at x within S)" by blast
+  from g(2)[OF x] have g': "(g has_derivative (*) (g' x)) (at x)"
+    by (simp add: has_field_derivative_def S)
+  have "((\<lambda>x. \<Sum>n. f n x) has_derivative (*) (g' x)) (at x)"
+    by (rule has_derivative_transform_within_open[OF g' \<open>open S\<close> x])
+       (insert g, auto simp: sums_iff)
+  thus "(\<lambda>x. \<Sum>n. f n x) field_differentiable (at x)" unfolding differentiable_def
+    by (auto simp: summable_def field_differentiable_def has_field_derivative_def)
+qed
+
+subsubsection\<^marker>\<open>tag unimportant\<close>\<open>Caratheodory characterization\<close>
+
+lemma field_differentiable_caratheodory_at:
+  "f field_differentiable (at z) \<longleftrightarrow>
+         (\<exists>g. (\<forall>w. f(w) - f(z) = g(w) * (w - z)) \<and> continuous (at z) g)"
+  using CARAT_DERIV [of f]
+  by (simp add: field_differentiable_def has_field_derivative_def)
+
+lemma field_differentiable_caratheodory_within:
+  "f field_differentiable (at z within s) \<longleftrightarrow>
+         (\<exists>g. (\<forall>w. f(w) - f(z) = g(w) * (w - z)) \<and> continuous (at z within s) g)"
+  using DERIV_caratheodory_within [of f]
+  by (simp add: field_differentiable_def has_field_derivative_def)
+
+
 subsection \<open>Field derivative\<close>
 
 definition\<^marker>\<open>tag important\<close> deriv :: "('a \<Rightarrow> 'a::real_normed_field) \<Rightarrow> 'a \<Rightarrow> 'a" where
   "deriv f x \<equiv> SOME D. DERIV f x :> D"
 
 lemma DERIV_imp_deriv: "DERIV f x :> f' \<Longrightarrow> deriv f x = f'"
   unfolding deriv_def by (metis some_equality DERIV_unique)
 
 lemma DERIV_deriv_iff_has_field_derivative:
   "DERIV f x :> deriv f x \<longleftrightarrow> (\<exists>f'. (f has_field_derivative f') (at x))"
   by (auto simp: has_field_derivative_def DERIV_imp_deriv)
 
 lemma DERIV_deriv_iff_real_differentiable:
   fixes x :: real
   shows "DERIV f x :> deriv f x \<longleftrightarrow> f differentiable at x"
   unfolding differentiable_def by (metis DERIV_imp_deriv has_real_derivative_iff)
 
 lemma deriv_cong_ev:
   assumes "eventually (\<lambda>x. f x = g x) (nhds x)" "x = y"
   shows   "deriv f x = deriv g y"
 proof -
   have "(\<lambda>D. (f has_field_derivative D) (at x)) = (\<lambda>D. (g has_field_derivative D) (at y))"
     by (intro ext DERIV_cong_ev refl assms)
   thus ?thesis by (simp add: deriv_def assms)
 qed
 
 lemma higher_deriv_cong_ev:
   assumes "eventually (\<lambda>x. f x = g x) (nhds x)" "x = y"
   shows   "(deriv ^^ n) f x = (deriv ^^ n) g y"
 proof -
   from assms(1) have "eventually (\<lambda>x. (deriv ^^ n) f x = (deriv ^^ n) g x) (nhds x)"
   proof (induction n arbitrary: f g)
     case (Suc n)
     from Suc.prems have "eventually (\<lambda>y. eventually (\<lambda>z. f z = g z) (nhds y)) (nhds x)"
       by (simp add: eventually_eventually)
     hence "eventually (\<lambda>x. deriv f x = deriv g x) (nhds x)"
       by eventually_elim (rule deriv_cong_ev, simp_all)
     thus ?case by (auto intro!: deriv_cong_ev Suc simp: funpow_Suc_right simp del: funpow.simps)
   qed auto
   from eventually_nhds_x_imp_x[OF this] assms(2) show ?thesis by simp
 qed
 
 lemma real_derivative_chain:
   fixes x :: real
   shows "f differentiable at x \<Longrightarrow> g differentiable at (f x)
     \<Longrightarrow> deriv (g o f) x = deriv g (f x) * deriv f x"
   by (metis DERIV_deriv_iff_real_differentiable DERIV_chain DERIV_imp_deriv)
 lemma field_derivative_eq_vector_derivative:
    "(deriv f x) = vector_derivative f (at x)"
 by (simp add: mult.commute deriv_def vector_derivative_def has_vector_derivative_def has_field_derivative_def)
 
 proposition field_differentiable_derivI:
     "f field_differentiable (at x) \<Longrightarrow> (f has_field_derivative deriv f x) (at x)"
 by (simp add: field_differentiable_def DERIV_deriv_iff_has_field_derivative)
 
 lemma vector_derivative_chain_at_general:
   assumes "f differentiable at x" "g field_differentiable at (f x)"
   shows "vector_derivative (g \<circ> f) (at x) = vector_derivative f (at x) * deriv g (f x)"
   apply (rule vector_derivative_at [OF field_vector_diff_chain_at])
   using assms vector_derivative_works by (auto simp: field_differentiable_derivI)
 
-
 subsection \<open>Relation between convexity and derivative\<close>
 
 (* TODO: Generalise to real vector spaces? *)
 proposition convex_on_imp_above_tangent:
   assumes convex: "convex_on A f" and connected: "connected A"
   assumes c: "c \<in> interior A" and x : "x \<in> A"
   assumes deriv: "(f has_field_derivative f') (at c within A)"
   shows   "f x - f c \<ge> f' * (x - c)"
 proof (cases x c rule: linorder_cases)
   assume xc: "x > c"
   let ?A' = "interior A \<inter> {c<..}"
   from c have "c \<in> interior A \<inter> closure {c<..}" by auto
   also have "\<dots> \<subseteq> closure (interior A \<inter> {c<..})" by (intro open_Int_closure_subset) auto
   finally have "at c within ?A' \<noteq> bot" by (subst at_within_eq_bot_iff) auto
   moreover from deriv have "((\<lambda>y. (f y - f c) / (y - c)) \<longlongrightarrow> f') (at c within ?A')"
     unfolding has_field_derivative_iff using interior_subset[of A] by (blast intro: tendsto_mono at_le)
   moreover from eventually_at_right_real[OF xc]
     have "eventually (\<lambda>y. (f y - f c) / (y - c) \<le> (f x - f c) / (x - c)) (at_right c)"
   proof eventually_elim
     fix y assume y: "y \<in> {c<..<x}"
     with convex connected x c have "f y \<le> (f x - f c) / (x - c) * (y - c) + f c"
       using interior_subset[of A]
       by (intro convex_onD_Icc' convex_on_subset[OF convex] connected_contains_Icc) auto
     hence "f y - f c \<le> (f x - f c) / (x - c) * (y - c)" by simp
     thus "(f y - f c) / (y - c) \<le> (f x - f c) / (x - c)" using y xc by (simp add: field_split_simps)
   qed
   hence "eventually (\<lambda>y. (f y - f c) / (y - c) \<le> (f x - f c) / (x - c)) (at c within ?A')"
     by (blast intro: filter_leD at_le)
   ultimately have "f' \<le> (f x - f c) / (x - c)" by (simp add: tendsto_upperbound)
   thus ?thesis using xc by (simp add: field_simps)
 next
   assume xc: "x < c"
   let ?A' = "interior A \<inter> {..<c}"
   from c have "c \<in> interior A \<inter> closure {..<c}" by auto
   also have "\<dots> \<subseteq> closure (interior A \<inter> {..<c})" by (intro open_Int_closure_subset) auto
   finally have "at c within ?A' \<noteq> bot" by (subst at_within_eq_bot_iff) auto
   moreover from deriv have "((\<lambda>y. (f y - f c) / (y - c)) \<longlongrightarrow> f') (at c within ?A')"
     unfolding has_field_derivative_iff using interior_subset[of A] by (blast intro: tendsto_mono at_le)
   moreover from eventually_at_left_real[OF xc]
     have "eventually (\<lambda>y. (f y - f c) / (y - c) \<ge> (f x - f c) / (x - c)) (at_left c)"
   proof eventually_elim
     fix y assume y: "y \<in> {x<..<c}"
     with convex connected x c have "f y \<le> (f x - f c) / (c - x) * (c - y) + f c"
       using interior_subset[of A]
       by (intro convex_onD_Icc'' convex_on_subset[OF convex] connected_contains_Icc) auto
     hence "f y - f c \<le> (f x - f c) * ((c - y) / (c - x))" by simp
     also have "(c - y) / (c - x) = (y - c) / (x - c)" using y xc by (simp add: field_simps)
     finally show "(f y - f c) / (y - c) \<ge> (f x - f c) / (x - c)" using y xc
       by (simp add: field_split_simps)
   qed
   hence "eventually (\<lambda>y. (f y - f c) / (y - c) \<ge> (f x - f c) / (x - c)) (at c within ?A')"
     by (blast intro: filter_leD at_le)
   ultimately have "f' \<ge> (f x - f c) / (x - c)" by (simp add: tendsto_lowerbound)
   thus ?thesis using xc by (simp add: field_simps)
 qed simp_all
 
 
 subsection \<open>Partial derivatives\<close>
 
 lemma eventually_at_Pair_within_TimesI1:
   fixes x::"'a::metric_space"
   assumes "\<forall>\<^sub>F x' in at x within X. P x'"
   assumes "P x"
   shows "\<forall>\<^sub>F (x', y') in at (x, y) within X \<times> Y. P x'"
 proof -
   from assms[unfolded eventually_at_topological]
   obtain S where S: "open S" "x \<in> S" "\<And>x'. x' \<in> X \<Longrightarrow> x' \<in> S \<Longrightarrow> P x'"
     by metis
   show "\<forall>\<^sub>F (x', y') in at (x, y) within X \<times> Y. P x'"
     unfolding eventually_at_topological
     by (auto intro!: exI[where x="S \<times> UNIV"] S open_Times)
 qed
 
 lemma eventually_at_Pair_within_TimesI2:
   fixes x::"'a::metric_space"
   assumes "\<forall>\<^sub>F y' in at y within Y. P y'" "P y"
   shows "\<forall>\<^sub>F (x', y') in at (x, y) within X \<times> Y. P y'"
 proof -
   from assms[unfolded eventually_at_topological]
   obtain S where S: "open S" "y \<in> S" "\<And>y'. y' \<in> Y \<Longrightarrow> y' \<in> S \<Longrightarrow> P y'"
     by metis
   show "\<forall>\<^sub>F (x', y') in at (x, y) within X \<times> Y. P y'"
     unfolding eventually_at_topological
     by (auto intro!: exI[where x="UNIV \<times> S"] S open_Times)
 qed
 
 proposition has_derivative_partialsI:
   fixes f::"'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector \<Rightarrow> 'c::real_normed_vector"
   assumes fx: "((\<lambda>x. f x y) has_derivative fx) (at x within X)"
   assumes fy: "\<And>x y. x \<in> X \<Longrightarrow> y \<in> Y \<Longrightarrow> ((\<lambda>y. f x y) has_derivative blinfun_apply (fy x y)) (at y within Y)"
   assumes fy_cont[unfolded continuous_within]: "continuous (at (x, y) within X \<times> Y) (\<lambda>(x, y). fy x y)"
   assumes "y \<in> Y" "convex Y"
   shows "((\<lambda>(x, y). f x y) has_derivative (\<lambda>(tx, ty). fx tx + fy x y ty)) (at (x, y) within X \<times> Y)"
 proof (safe intro!: has_derivativeI tendstoI, goal_cases)
   case (2 e')
   interpret fx: bounded_linear "fx" using fx by (rule has_derivative_bounded_linear)
   define e where "e = e' / 9"
   have "e > 0" using \<open>e' > 0\<close> by (simp add: e_def)
 
   from fy_cont[THEN tendstoD, OF \<open>e > 0\<close>]
   have "\<forall>\<^sub>F (x', y') in at (x, y) within X \<times> Y. dist (fy x' y') (fy x y) < e"
     by (auto simp: split_beta')
   from this[unfolded eventually_at] obtain d' where
     "d' > 0"
     "\<And>x' y'. x' \<in> X \<Longrightarrow> y' \<in> Y \<Longrightarrow> (x', y') \<noteq> (x, y) \<Longrightarrow> dist (x', y') (x, y) < d' \<Longrightarrow>
       dist (fy x' y') (fy x y) < e"
     by auto
   then
   have d': "x' \<in> X \<Longrightarrow> y' \<in> Y \<Longrightarrow> dist (x', y') (x, y) < d' \<Longrightarrow> dist (fy x' y') (fy x y) < e"
     for x' y'
     using \<open>0 < e\<close>
     by (cases "(x', y') = (x, y)") auto
   define d where "d = d' / sqrt 2"
   have "d > 0" using \<open>0 < d'\<close> by (simp add: d_def)
   have d: "x' \<in> X \<Longrightarrow> y' \<in> Y \<Longrightarrow> dist x' x < d \<Longrightarrow> dist y' y < d \<Longrightarrow> dist (fy x' y') (fy x y) < e"
     for x' y'
     by (auto simp: dist_prod_def d_def intro!: d' real_sqrt_sum_squares_less)
 
   let ?S = "ball y d \<inter> Y"
   have "convex ?S"
     by (auto intro!: convex_Int \<open>convex Y\<close>)
   {
     fix x'::'a and y'::'b
     assume x': "x' \<in> X" and y': "y' \<in> Y"
     assume dx': "dist x' x < d" and dy': "dist y' y < d"
     have "norm (fy x' y' - fy x' y) \<le> dist (fy x' y') (fy x y) + dist (fy x' y) (fy x y)"
       by norm
     also have "dist (fy x' y') (fy x y) < e"
       by (rule d; fact)
     also have "dist (fy x' y) (fy x y) < e"
       by (auto intro!: d simp: dist_prod_def x' \<open>d > 0\<close> \<open>y \<in> Y\<close> dx')
     finally
     have "norm (fy x' y' - fy x' y) < e + e"
       by arith
     then have "onorm (blinfun_apply (fy x' y') - blinfun_apply (fy x' y)) < e + e"
       by (auto simp: norm_blinfun.rep_eq blinfun.diff_left[abs_def] fun_diff_def)
   } note onorm = this
 
   have ev_mem: "\<forall>\<^sub>F (x', y') in at (x, y) within X \<times> Y. (x', y') \<in> X \<times> Y"
     using \<open>y \<in> Y\<close>
     by (auto simp: eventually_at intro!: zero_less_one)
   moreover
   have ev_dist: "\<forall>\<^sub>F xy in at (x, y) within X \<times> Y. dist xy (x, y) < d" if "d > 0" for d
     using eventually_at_ball[OF that]
     by (rule eventually_elim2) (auto simp: dist_commute mem_ball intro!: eventually_True)
   note ev_dist[OF \<open>0 < d\<close>]
   ultimately
   have "\<forall>\<^sub>F (x', y') in at (x, y) within X \<times> Y.
     norm (f x' y' - f x' y - (fy x' y) (y' - y)) \<le> norm (y' - y) * (e + e)"
   proof (eventually_elim, safe)
     fix x' y'
     assume "x' \<in> X" and y': "y' \<in> Y"
     assume dist: "dist (x', y') (x, y) < d"
     then have dx: "dist x' x < d" and dy: "dist y' y < d"
       unfolding dist_prod_def fst_conv snd_conv atomize_conj
       by (metis le_less_trans real_sqrt_sum_squares_ge1 real_sqrt_sum_squares_ge2)
     {
       fix t::real
       assume "t \<in> {0 .. 1}"
       then have "y + t *\<^sub>R (y' - y) \<in> closed_segment y y'"
         by (auto simp: closed_segment_def algebra_simps intro!: exI[where x=t])
       also
       have "\<dots> \<subseteq> ball y d \<inter> Y"
         using \<open>y \<in> Y\<close> \<open>0 < d\<close> dy y'
         by (intro \<open>convex ?S\<close>[unfolded convex_contains_segment, rule_format, of y y'])
           (auto simp: dist_commute)
       finally have "y + t *\<^sub>R (y' - y) \<in> ?S" .
     } note seg = this
 
     have "\<And>x. x \<in> ball y d \<inter> Y \<Longrightarrow> onorm (blinfun_apply (fy x' x) - blinfun_apply (fy x' y)) \<le> e + e"
       by (safe intro!: onorm less_imp_le \<open>x' \<in> X\<close> dx) (auto simp: dist_commute \<open>0 < d\<close> \<open>y \<in> Y\<close>)
     with seg has_derivative_within_subset[OF assms(2)[OF \<open>x' \<in> X\<close>]]
     show "norm (f x' y' - f x' y - (fy x' y) (y' - y)) \<le> norm (y' - y) * (e + e)"
       by (rule differentiable_bound_linearization[where S="?S"])
         (auto intro!: \<open>0 < d\<close> \<open>y \<in> Y\<close>)
   qed
   moreover
   let ?le = "\<lambda>x'. norm (f x' y - f x y - (fx) (x' - x)) \<le> norm (x' - x) * e"
   from fx[unfolded has_derivative_within, THEN conjunct2, THEN tendstoD, OF \<open>0 < e\<close>]
   have "\<forall>\<^sub>F x' in at x within X. ?le x'"
     by eventually_elim (simp, 
       simp add: dist_norm field_split_simps split: if_split_asm)
   then have "\<forall>\<^sub>F (x', y') in at (x, y) within X \<times> Y. ?le x'"
     by (rule eventually_at_Pair_within_TimesI1)
        (simp add: blinfun.bilinear_simps)
   moreover have "\<forall>\<^sub>F (x', y') in at (x, y) within X \<times> Y. norm ((x', y') - (x, y)) \<noteq> 0"
     unfolding norm_eq_zero right_minus_eq
     by (auto simp: eventually_at intro!: zero_less_one)
   moreover
   from fy_cont[THEN tendstoD, OF \<open>0 < e\<close>]
   have "\<forall>\<^sub>F x' in at x within X. norm (fy x' y - fy x y) < e"
     unfolding eventually_at
     using \<open>y \<in> Y\<close>
     by (auto simp: dist_prod_def dist_norm)
   then have "\<forall>\<^sub>F (x', y') in at (x, y) within X \<times> Y. norm (fy x' y - fy x y) < e"
     by (rule eventually_at_Pair_within_TimesI1)
        (simp add: blinfun.bilinear_simps \<open>0 < e\<close>)
   ultimately
   have "\<forall>\<^sub>F (x', y') in at (x, y) within X \<times> Y.
             norm ((f x' y' - f x y - (fx (x' - x) + fy x y (y' - y))) /\<^sub>R
               norm ((x', y') - (x, y)))
             < e'"
     apply eventually_elim
   proof safe
     fix x' y'
     have "norm (f x' y' - f x y - (fx (x' - x) + fy x y (y' - y))) \<le>
         norm (f x' y' - f x' y - fy x' y (y' - y)) +
         norm (fy x y (y' - y) - fy x' y (y' - y)) +
         norm (f x' y - f x y - fx (x' - x))"
       by norm
     also
     assume nz: "norm ((x', y') - (x, y)) \<noteq> 0"
       and nfy: "norm (fy x' y - fy x y) < e"
     assume "norm (f x' y' - f x' y - blinfun_apply (fy x' y) (y' - y)) \<le> norm (y' - y) * (e + e)"
     also assume "norm (f x' y - f x y - (fx) (x' - x)) \<le> norm (x' - x) * e"
     also
     have "norm ((fy x y) (y' - y) - (fy x' y) (y' - y)) \<le> norm ((fy x y) - (fy x' y)) * norm (y' - y)"
       by (auto simp: blinfun.bilinear_simps[symmetric] intro!: norm_blinfun)
     also have "\<dots> \<le> (e + e) * norm (y' - y)"
       using \<open>e > 0\<close> nfy
       by (auto simp: norm_minus_commute intro!: mult_right_mono)
     also have "norm (x' - x) * e \<le> norm (x' - x) * (e + e)"
       using \<open>0 < e\<close> by simp
     also have "norm (y' - y) * (e + e) + (e + e) * norm (y' - y) + norm (x' - x) * (e + e) \<le>
         (norm (y' - y) + norm (x' - x)) * (4 * e)"
       using \<open>e > 0\<close>
       by (simp add: algebra_simps)
     also have "\<dots> \<le> 2 * norm ((x', y') - (x, y)) * (4 * e)"
       using \<open>0 < e\<close> real_sqrt_sum_squares_ge1[of "norm (x' - x)" "norm (y' - y)"]
         real_sqrt_sum_squares_ge2[of "norm (y' - y)" "norm (x' - x)"]
       by (auto intro!: mult_right_mono simp: norm_prod_def
         simp del: real_sqrt_sum_squares_ge1 real_sqrt_sum_squares_ge2)
     also have "\<dots> \<le> norm ((x', y') - (x, y)) * (8 * e)"
       by simp
     also have "\<dots> < norm ((x', y') - (x, y)) * e'"
       using \<open>0 < e'\<close> nz
       by (auto simp: e_def)
     finally show "norm ((f x' y' - f x y - (fx (x' - x) + fy x y (y' - y))) /\<^sub>R norm ((x', y') - (x, y))) < e'"
       by (simp add: dist_norm) (auto simp add: field_split_simps)
   qed
   then show ?case
     by eventually_elim (auto simp: dist_norm field_simps)
 next
   from has_derivative_bounded_linear[OF fx]
   obtain fxb where "fx = blinfun_apply fxb"
     by (metis bounded_linear_Blinfun_apply)
   then show "bounded_linear (\<lambda>(tx, ty). fx tx + blinfun_apply (fy x y) ty)"
     by (auto intro!: bounded_linear_intros simp: split_beta')
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Differentiable case distinction\<close>
 
 lemma has_derivative_within_If_eq:
   "((\<lambda>x. if P x then f x else g x) has_derivative f') (at x within S) =
     (bounded_linear f' \<and>
      ((\<lambda>y.(if P y then (f y - ((if P x then f x else g x) + f' (y - x)))/\<^sub>R norm (y - x)
            else (g y - ((if P x then f x else g x) + f' (y - x)))/\<^sub>R norm (y - x)))
       \<longlongrightarrow> 0) (at x within S))"
   (is "_ = (_ \<and> (?if \<longlongrightarrow> 0) _)")
 proof -
   have "(\<lambda>y. (1 / norm (y - x)) *\<^sub>R
            ((if P y then f y else g y) -
             ((if P x then f x else g x) + f' (y - x)))) = ?if"
     by (auto simp: inverse_eq_divide)
   thus ?thesis by (auto simp: has_derivative_within)
 qed
 
 lemma has_derivative_If_within_closures:
   assumes f': "x \<in> S \<union> (closure S \<inter> closure T) \<Longrightarrow>
     (f has_derivative f' x) (at x within S \<union> (closure S \<inter> closure T))"
   assumes g': "x \<in> T \<union> (closure S \<inter> closure T) \<Longrightarrow>
     (g has_derivative g' x) (at x within T \<union> (closure S \<inter> closure T))"
   assumes connect: "x \<in> closure S \<Longrightarrow> x \<in> closure T \<Longrightarrow> f x = g x"
   assumes connect': "x \<in> closure S \<Longrightarrow> x \<in> closure T \<Longrightarrow> f' x = g' x"
   assumes x_in: "x \<in> S \<union> T"
   shows "((\<lambda>x. if x \<in> S then f x else g x) has_derivative
       (if x \<in> S then f' x else g' x)) (at x within (S \<union> T))"
 proof -
   from f' x_in interpret f': bounded_linear "if x \<in> S then f' x else (\<lambda>x. 0)"
     by (auto simp add: has_derivative_within)
   from g' interpret g': bounded_linear "if x \<in> T then g' x else (\<lambda>x. 0)"
     by (auto simp add: has_derivative_within)
   have bl: "bounded_linear (if x \<in> S then f' x else g' x)"
     using f'.scaleR f'.bounded f'.add g'.scaleR g'.bounded g'.add x_in
     by (unfold_locales; force)
   show ?thesis
     using f' g' closure_subset[of T] closure_subset[of S]
     unfolding has_derivative_within_If_eq
     by (intro conjI bl tendsto_If_within_closures x_in)
       (auto simp: has_derivative_within inverse_eq_divide connect connect' subsetD)
 qed
 
 lemma has_vector_derivative_If_within_closures:
   assumes x_in: "x \<in> S \<union> T"
   assumes "u = S \<union> T"
   assumes f': "x \<in> S \<union> (closure S \<inter> closure T) \<Longrightarrow>
     (f has_vector_derivative f' x) (at x within S \<union> (closure S \<inter> closure T))"
   assumes g': "x \<in> T \<union> (closure S \<inter> closure T) \<Longrightarrow>
     (g has_vector_derivative g' x) (at x within T \<union> (closure S \<inter> closure T))"
   assumes connect: "x \<in> closure S \<Longrightarrow> x \<in> closure T \<Longrightarrow> f x = g x"
   assumes connect': "x \<in> closure S \<Longrightarrow> x \<in> closure T \<Longrightarrow> f' x = g' x"
   shows "((\<lambda>x. if x \<in> S then f x else g x) has_vector_derivative
     (if x \<in> S then f' x else g' x)) (at x within u)"
   unfolding has_vector_derivative_def assms
   using x_in
   apply (intro has_derivative_If_within_closures[where ?f' = "\<lambda>x a. a *\<^sub>R f' x" and ?g' = "\<lambda>x a. a *\<^sub>R g' x",
         THEN has_derivative_eq_rhs])
   subgoal by (rule f'[unfolded has_vector_derivative_def]; assumption)
   subgoal by (rule g'[unfolded has_vector_derivative_def]; assumption)
   by (auto simp: assms)
 
 subsection\<^marker>\<open>tag important\<close>\<open>The Inverse Function Theorem\<close>
 
 lemma linear_injective_contraction:
   assumes "linear f" "c < 1" and le: "\<And>x. norm (f x - x) \<le> c * norm x"
   shows "inj f"
   unfolding linear_injective_0[OF \<open>linear f\<close>]
 proof safe
   fix x
   assume "f x = 0"
   with le [of x] have "norm x \<le> c * norm x"
     by simp
   then show "x = 0"
     using \<open>c < 1\<close> by (simp add: mult_le_cancel_right1)
 qed
 
 text\<open>From an online proof by J. Michael Boardman, Department of Mathematics, Johns Hopkins University\<close>
 lemma inverse_function_theorem_scaled:
   fixes f::"'a::euclidean_space \<Rightarrow> 'a"
     and f'::"'a \<Rightarrow> ('a \<Rightarrow>\<^sub>L 'a)"
   assumes "open U"
     and derf: "\<And>x. x \<in> U \<Longrightarrow> (f has_derivative blinfun_apply (f' x)) (at x)"
     and contf: "continuous_on U f'"
     and "0 \<in> U" and [simp]: "f 0 = 0"
     and id: "f' 0 = id_blinfun"
   obtains U' V g g' where "open U'" "U' \<subseteq> U" "0 \<in> U'" "open V" "0 \<in> V" "homeomorphism U' V f g"
                 "\<And>y. y \<in> V \<Longrightarrow> (g has_derivative (g' y)) (at y)"
                 "\<And>y. y \<in> V \<Longrightarrow> g' y = inv (blinfun_apply (f'(g y)))"
                 "\<And>y. y \<in> V \<Longrightarrow> bij (blinfun_apply (f'(g y)))"
 proof -
   obtain d1 where "cball 0 d1 \<subseteq> U" "d1 > 0"
     using \<open>open U\<close> \<open>0 \<in> U\<close> open_contains_cball by blast
   obtain d2 where d2: "\<And>x. \<lbrakk>x \<in> U; dist x 0 \<le> d2\<rbrakk> \<Longrightarrow> dist (f' x) (f' 0) < 1/2" "0 < d2"
     using continuous_onE [OF contf, of 0 "1/2"] by (metis \<open>0 \<in> U\<close> half_gt_zero_iff zero_less_one)
   obtain \<delta> where le: "\<And>x. norm x \<le> \<delta> \<Longrightarrow> dist (f' x) id_blinfun \<le> 1/2" and "0 < \<delta>"
     and subU: "cball 0 \<delta> \<subseteq> U"
   proof
     show "min d1 d2 > 0"
       by (simp add: \<open>0 < d1\<close> \<open>0 < d2\<close>)
     show "cball 0 (min d1 d2) \<subseteq> U"
       using \<open>cball 0 d1 \<subseteq> U\<close> by auto
     show "dist (f' x) id_blinfun \<le> 1/2" if "norm x \<le> min d1 d2" for x
       using \<open>cball 0 d1 \<subseteq> U\<close> d2 that id by fastforce
   qed
   let ?D = "cball 0 \<delta>"
   define V:: "'a set" where "V \<equiv> ball 0 (\<delta>/2)"
   have 4: "norm (f (x + h) - f x - h) \<le> 1/2 * norm h"
     if "x \<in> ?D" "x+h \<in> ?D" for x h
   proof -
     let ?w = "\<lambda>x. f x - x"
     have B: "\<And>x. x \<in> ?D \<Longrightarrow> onorm (blinfun_apply (f' x - id_blinfun)) \<le> 1/2"
       by (metis dist_norm le mem_cball_0 norm_blinfun.rep_eq)
     have "\<And>x. x \<in> ?D \<Longrightarrow> (?w has_derivative (blinfun_apply (f' x - id_blinfun))) (at x)"
       by (rule derivative_eq_intros derf subsetD [OF subU] | force simp: blinfun.diff_left)+
     then have Dw: "\<And>x. x \<in> ?D \<Longrightarrow> (?w has_derivative (blinfun_apply (f' x - id_blinfun))) (at x within ?D)"
       using has_derivative_at_withinI by blast
     have "norm (?w (x+h) - ?w x) \<le> (1/2) * norm h"
       using differentiable_bound [OF convex_cball Dw B] that by fastforce
     then show ?thesis
       by (auto simp: algebra_simps)
   qed
   have for_g: "\<exists>!x. norm x < \<delta> \<and> f x = y" if y: "norm y < \<delta>/2" for y
   proof -
     let ?u = "\<lambda>x. x + (y - f x)"
     have *: "norm (?u x) < \<delta>" if "x \<in> ?D" for x
     proof -
       have fxx: "norm (f x - x) \<le> \<delta>/2"
         using 4 [of 0 x] \<open>0 < \<delta>\<close> \<open>f 0 = 0\<close> that by auto
       have "norm (?u x) \<le> norm y + norm (f x - x)"
         by (metis add.commute add_diff_eq norm_minus_commute norm_triangle_ineq)
       also have "\<dots> < \<delta>/2 + \<delta>/2"
         using fxx y by auto
       finally show ?thesis
         by simp
     qed
     have "\<exists>!x \<in> ?D. ?u x = x"
     proof (rule banach_fix)
       show "cball 0 \<delta> \<noteq> {}"
         using \<open>0 < \<delta>\<close> by auto
       show "(\<lambda>x. x + (y - f x)) ` cball 0 \<delta> \<subseteq> cball 0 \<delta>"
         using * by force
       have "dist (x + (y - f x)) (xh + (y - f xh)) * 2 \<le> dist x xh"
         if "norm x \<le> \<delta>" and "norm xh \<le> \<delta>" for x xh
         using that 4 [of x "xh-x"] by (auto simp: dist_norm norm_minus_commute algebra_simps)
       then show "\<forall>x\<in>cball 0 \<delta>. \<forall>ya\<in>cball 0 \<delta>. dist (x + (y - f x)) (ya + (y - f ya)) \<le> (1/2) * dist x ya"
         by auto
     qed (auto simp: complete_eq_closed)
     then show ?thesis
       by (metis "*" add_cancel_right_right eq_iff_diff_eq_0 le_less mem_cball_0)
   qed
   define g where "g \<equiv> \<lambda>y. THE x. norm x < \<delta> \<and> f x = y"
   have g: "norm (g y) < \<delta> \<and> f (g y) = y" if "norm y < \<delta>/2" for y
     unfolding g_def using that theI' [OF for_g] by meson
   then have fg[simp]: "f (g y) = y" if "y \<in> V" for y
     using that by (auto simp: V_def)
   have 5: "norm (g y' - g y) \<le> 2 * norm (y' - y)" if "y \<in> V" "y' \<in> V" for y y'
   proof -
     have no: "norm (g y) \<le> \<delta>" "norm (g y') \<le> \<delta>" and [simp]: "f (g y) = y"
       using that g unfolding V_def by force+
     have "norm (g y' - g y) \<le> norm (g y' - g y - (y' - y)) + norm (y' - y)"
       by (simp add: add.commute norm_triangle_sub)
     also have "\<dots> \<le> (1/2) * norm (g y' - g y) + norm (y' - y)"
       using 4 [of "g y" "g y' - g y"] that no by (simp add: g norm_minus_commute V_def)
     finally show ?thesis
       by auto
   qed
   have contg: "continuous_on V g"
   proof
     fix y::'a and e::real
     assume "0 < e" and y: "y \<in> V"
     show "\<exists>d>0. \<forall>x'\<in>V. dist x' y < d \<longrightarrow> dist (g x') (g y) \<le> e"
     proof (intro exI conjI ballI impI)
       show "0 < e/2"
         by (simp add: \<open>0 < e\<close>)
     qed (use 5 y in \<open>force simp: dist_norm\<close>)
   qed
   show thesis
   proof
     define U' where "U' \<equiv> (f -` V) \<inter> ball 0 \<delta>"
     have contf: "continuous_on U f"
       using derf has_derivative_at_withinI by (fast intro: has_derivative_continuous_on)
     then have "continuous_on (ball 0 \<delta>) f"
       by (meson ball_subset_cball continuous_on_subset subU)
     then show "open U'"
       by (simp add: U'_def V_def Int_commute continuous_open_preimage)
     show "0 \<in> U'" "U' \<subseteq> U" "open V" "0 \<in> V"
       using \<open>0 < \<delta>\<close> subU by (auto simp: U'_def V_def)
     show hom: "homeomorphism U' V f g"
     proof
       show "continuous_on U' f"
         using \<open>U' \<subseteq> U\<close> contf continuous_on_subset by blast
       show "continuous_on V g"
         using contg by blast
       show "f ` U' \<subseteq> V"
         using U'_def by blast
       show "g ` V \<subseteq> U'"
         by (simp add: U'_def V_def g image_subset_iff)
       show "g (f x) = x" if "x \<in> U'" for x
         by (metis that fg Int_iff U'_def V_def for_g g mem_ball_0 vimage_eq)
       show "f (g y) = y" if "y \<in> V" for y
         using that by (simp add: g V_def)
     qed
     show bij: "bij (blinfun_apply (f'(g y)))" if "y \<in> V" for y
     proof -
       have inj: "inj (blinfun_apply (f' (g y)))"
       proof (rule linear_injective_contraction)
         show "linear (blinfun_apply (f' (g y)))"
           using blinfun.bounded_linear_right bounded_linear_def by blast
       next
         fix x
         have "norm (blinfun_apply (f' (g y)) x - x) = norm (blinfun_apply (f' (g y) - id_blinfun) x)"
           by (simp add: blinfun.diff_left)
         also have "\<dots> \<le> norm (f' (g y) - id_blinfun) * norm x"
           by (rule norm_blinfun)
         also have "\<dots> \<le> (1/2) * norm x"
         proof (rule mult_right_mono)
           show "norm (f' (g y) - id_blinfun) \<le> 1/2"
             using that g [of y] le by (auto simp: V_def dist_norm)
         qed auto
         finally show "norm (blinfun_apply (f' (g y)) x - x) \<le> (1/2) * norm x" .
       qed auto
       moreover
       have "surj (blinfun_apply (f' (g y)))"
         using blinfun.bounded_linear_right bounded_linear_def
         by (blast intro!: linear_inj_imp_surj [OF _ inj])
       ultimately show ?thesis
         using bijI by blast
     qed
     define g' where "g' \<equiv> \<lambda>y. inv (blinfun_apply (f'(g y)))"
     show "(g has_derivative g' y) (at y)" if "y \<in> V" for y
     proof -
       have gy: "g y \<in> U"
         using g subU that unfolding V_def by fastforce
       obtain e where e: "\<And>h. f (g y + h) = y + blinfun_apply (f' (g y)) h + e h"
         and e0: "(\<lambda>h. norm (e h) / norm h) \<midarrow>0\<rightarrow> 0"
         using iffD1 [OF has_derivative_iff_Ex derf [OF gy]] \<open>y \<in> V\<close> by auto
       have [simp]: "e 0 = 0"
         using e [of 0] that by simp
       let ?INV = "inv (blinfun_apply (f' (g y)))"
       have inj: "inj (blinfun_apply (f' (g y)))"
         using bij bij_betw_def that by blast
       have "(g has_derivative g' y) (at y within V)"
         unfolding has_derivative_at_within_iff_Ex [OF \<open>y \<in> V\<close> \<open>open V\<close>]
       proof
         show blinv: "bounded_linear (g' y)"
           unfolding g'_def using derf gy inj inj_linear_imp_inv_bounded_linear by blast
         define eg where "eg \<equiv> \<lambda>k. - ?INV (e (g (y+k) - g y))"
         have "g (y+k) = g y + g' y k + eg k" if "y + k \<in> V" for k
         proof -
           have "?INV k = ?INV (blinfun_apply (f' (g y)) (g (y+k) - g y) + e (g (y+k) - g y))"
             using e [of "g(y+k) - g y"] that by simp
           then have "g (y+k) = g y + ?INV k - ?INV (e (g (y+k) - g y))"
             using inj blinv by (simp add: linear_simps g'_def)
           then show ?thesis
             by (auto simp: eg_def g'_def)
         qed
         moreover have "(\<lambda>k. norm (eg k) / norm k) \<midarrow>0\<rightarrow> 0"
         proof (rule Lim_null_comparison)
           let ?g = "\<lambda>k. 2 * onorm ?INV * norm (e (g (y+k) - g y)) / norm (g (y+k) - g y)"
           show "\<forall>\<^sub>F k in at 0. norm (norm (eg k) / norm k) \<le> ?g k"
             unfolding eventually_at_topological
           proof (intro exI conjI ballI impI)
             show "open ((+)(-y) ` V)"
               using \<open>open V\<close> open_translation by blast
             show "0 \<in> (+)(-y) ` V"
               by (simp add: that)
             show "norm (norm (eg k) / norm k) \<le> 2 * onorm (inv (blinfun_apply (f' (g y)))) * norm (e (g (y+k) - g y)) / norm (g (y+k) - g y)"
               if "k \<in> (+)(-y) ` V" "k \<noteq> 0" for k
             proof -
               have "y+k \<in> V"
                 using that by auto
               have "norm (norm (eg k) / norm k) \<le> onorm ?INV * norm (e (g (y+k) - g y)) / norm k"
                 using blinv g'_def onorm by (force simp: eg_def divide_simps)
               also have "\<dots> = (norm (g (y+k) - g y) / norm k) * (onorm ?INV * (norm (e (g (y+k) - g y)) / norm (g (y+k) - g y)))"
                 by (simp add: divide_simps)
               also have "\<dots> \<le> 2 * (onorm ?INV * (norm (e (g (y+k) - g y)) / norm (g (y+k) - g y)))"
                 apply (rule mult_right_mono)
                 using 5 [of y "y+k"] \<open>y \<in> V\<close> \<open>y + k \<in> V\<close>  onorm_pos_le [OF blinv]
                  apply (auto simp: divide_simps zero_le_mult_iff zero_le_divide_iff g'_def)
                 done
               finally show "norm (norm (eg k) / norm k) \<le> 2 * onorm ?INV * norm (e (g (y+k) - g y)) / norm (g (y+k) - g y)"
                 by simp
             qed
           qed
           have 1: "(\<lambda>h. norm (e h) / norm h) \<midarrow>0\<rightarrow> (norm (e 0) / norm 0)"
             using e0 by auto
           have 2: "(\<lambda>k. g (y+k) - g y) \<midarrow>0\<rightarrow> 0"
             using contg \<open>open V\<close> \<open>y \<in> V\<close> LIM_offset_zero_iff LIM_zero_iff at_within_open continuous_on_def by fastforce
           from tendsto_compose [OF 1 2, simplified]
           have "(\<lambda>k. norm (e (g (y+k) - g y)) / norm (g (y+k) - g y)) \<midarrow>0\<rightarrow> 0" .
           from tendsto_mult_left [OF this] show "?g \<midarrow>0\<rightarrow> 0" by auto
         qed
         ultimately show "\<exists>e. (\<forall>k. y + k \<in> V \<longrightarrow> g (y+k) = g y + g' y k + e k) \<and> (\<lambda>k. norm (e k) / norm k) \<midarrow>0\<rightarrow> 0"
           by blast
       qed
       then show ?thesis
         by (metis \<open>open V\<close> at_within_open that)
     qed
     show "g' y = inv (blinfun_apply (f' (g y)))"
       if "y \<in> V" for y
       by (simp add: g'_def)
   qed
 qed
 
 
 text\<open>We need all this to justify the scaling and translations.\<close>
 theorem inverse_function_theorem:
   fixes f::"'a::euclidean_space \<Rightarrow> 'a"
     and f'::"'a \<Rightarrow> ('a \<Rightarrow>\<^sub>L 'a)"
   assumes "open U"
     and derf: "\<And>x. x \<in> U \<Longrightarrow> (f has_derivative (blinfun_apply (f' x))) (at x)"
     and contf:  "continuous_on U f'"
     and "x0 \<in> U"
     and invf: "invf o\<^sub>L f' x0 = id_blinfun"
   obtains U' V g g' where "open U'" "U' \<subseteq> U" "x0 \<in> U'" "open V" "f x0 \<in> V" "homeomorphism U' V f g"
     "\<And>y. y \<in> V \<Longrightarrow> (g has_derivative (g' y)) (at y)"
     "\<And>y. y \<in> V \<Longrightarrow> g' y = inv (blinfun_apply (f'(g y)))"
     "\<And>y. y \<in> V \<Longrightarrow> bij (blinfun_apply (f'(g y)))"
 proof -
   have apply1 [simp]: "\<And>i. blinfun_apply invf (blinfun_apply (f' x0) i) = i"
     by (metis blinfun_apply_blinfun_compose blinfun_apply_id_blinfun invf)
   have apply2 [simp]: "\<And>i. blinfun_apply (f' x0) (blinfun_apply invf i) = i"
     by (metis apply1 bij_inv_eq_iff blinfun_bij1 invf)
   have [simp]: "(range (blinfun_apply invf)) = UNIV"
     using apply1 surjI by blast
   let ?f = "invf \<circ> (\<lambda>x. (f \<circ> (+)x0)x - f x0)"
   let ?f' = "\<lambda>x. invf o\<^sub>L (f' (x + x0))"
   obtain U' V g g' where "open U'" and U': "U' \<subseteq> (+)(-x0) ` U" "0 \<in> U'"
     and "open V" "0 \<in> V" and hom: "homeomorphism U' V ?f g"
     and derg: "\<And>y. y \<in> V \<Longrightarrow> (g has_derivative (g' y)) (at y)"
     and g': "\<And>y. y \<in> V \<Longrightarrow> g' y = inv (?f'(g y))"
     and bij: "\<And>y. y \<in> V \<Longrightarrow> bij (?f'(g y))"
   proof (rule inverse_function_theorem_scaled [of "(+)(-x0) ` U" ?f "?f'"])
     show ope: "open ((+) (- x0) ` U)"
       using \<open>open U\<close> open_translation by blast
     show "(?f has_derivative blinfun_apply (?f' x)) (at x)"
       if "x \<in> (+) (- x0) ` U" for x
       using that
       apply clarify
       apply (rule derf derivative_eq_intros | simp add: blinfun_compose.rep_eq)+
       done
     have YY: "(\<lambda>x. f' (x + x0)) \<midarrow>u-x0\<rightarrow> f' u"
       if "f' \<midarrow>u\<rightarrow> f' u" "u \<in> U" for u
       using that LIM_offset [where k = x0] by (auto simp: algebra_simps)
     then have "continuous_on ((+) (- x0) ` U) (\<lambda>x. f' (x + x0))"
       using contf \<open>open U\<close> Lim_at_imp_Lim_at_within
       by (fastforce simp: continuous_on_def at_within_open_NO_MATCH ope)
     then show "continuous_on ((+) (- x0) ` U) ?f'"
       by (intro continuous_intros) simp
   qed (auto simp: invf \<open>x0 \<in> U\<close>)
   show thesis
   proof
     let ?U' = "(+)x0 ` U'"
     let ?V = "((+)(f x0) \<circ> f' x0) ` V"
     let ?g = "(+)x0 \<circ> g \<circ> invf \<circ> (+)(- f x0)"
     let ?g' = "\<lambda>y. inv (blinfun_apply (f' (?g y)))"
     show oU': "open ?U'"
       by (simp add: \<open>open U'\<close> open_translation)
     show subU: "?U' \<subseteq> U"
       using ComplI \<open>U' \<subseteq> (+) (- x0) ` U\<close> by auto
     show "x0 \<in> ?U'"
       by (simp add: \<open>0 \<in> U'\<close>)
     show "open ?V"
       using blinfun_bij2 [OF invf]
       by (metis \<open>open V\<close> bij_is_surj blinfun.bounded_linear_right bounded_linear_def image_comp open_surjective_linear_image open_translation)
     show "f x0 \<in> ?V"
       using \<open>0 \<in> V\<close> image_iff by fastforce
     show "homeomorphism ?U' ?V f ?g"
     proof
       show "continuous_on ?U' f"
         by (meson subU continuous_on_eq_continuous_at derf has_derivative_continuous oU' subsetD)
       have "?f ` U' \<subseteq> V"
         using hom homeomorphism_image1 by blast
       then show "f ` ?U' \<subseteq> ?V"
         unfolding image_subset_iff
         by (clarsimp simp: image_def) (metis apply2 add.commute diff_add_cancel)
       show "?g ` ?V \<subseteq> ?U'"
         using hom invf by (auto simp: image_def homeomorphism_def)
       show "?g (f x) = x"
         if "x \<in> ?U'" for x
         using that hom homeomorphism_apply1 by fastforce
       have "continuous_on V g"
         using hom homeomorphism_def by blast
       then show "continuous_on ?V ?g"
         by (intro continuous_intros) (auto elim!: continuous_on_subset)
       have fg: "?f (g x) = x" if "x \<in> V" for x
         using hom homeomorphism_apply2 that by blast
       show "f (?g y) = y"
         if "y \<in> ?V" for y
         using that fg by (simp add: image_iff) (metis apply2 add.commute diff_add_cancel)
     qed
     show "(?g has_derivative ?g' y) (at y)" "bij (blinfun_apply (f' (?g y)))"
       if "y \<in> ?V" for y
     proof -
       have 1: "bij (blinfun_apply invf)"
         using blinfun_bij1 invf by blast
       then have 2: "bij (blinfun_apply (f' (x0 + g x)))" if "x \<in> V" for x
         by (metis add.commute bij bij_betw_comp_iff2 blinfun_compose.rep_eq that top_greatest)
       then show "bij (blinfun_apply (f' (?g y)))"
         using that by auto
       have "g' x \<circ> blinfun_apply invf = inv (blinfun_apply (f' (x0 + g x)))"
         if "x \<in> V" for x
         using that
         by (simp add: g' o_inv_distrib blinfun_compose.rep_eq 1 2 add.commute bij_is_inj flip: o_assoc)
       then show "(?g has_derivative ?g' y) (at y)"
         using that invf
         by clarsimp (rule derg derivative_eq_intros | simp flip: id_def)+
     qed
   qed auto
 qed
 
 end
diff --git a/src/HOL/Analysis/Elementary_Normed_Spaces.thy b/src/HOL/Analysis/Elementary_Normed_Spaces.thy
--- a/src/HOL/Analysis/Elementary_Normed_Spaces.thy
+++ b/src/HOL/Analysis/Elementary_Normed_Spaces.thy
@@ -1,1783 +1,1794 @@
 (*  Author:     L C Paulson, University of Cambridge
     Author:     Amine Chaieb, University of Cambridge
     Author:     Robert Himmelmann, TU Muenchen
     Author:     Brian Huffman, Portland State University
 *)
 
 section \<open>Elementary Normed Vector Spaces\<close>
 
 theory Elementary_Normed_Spaces
   imports
   "HOL-Library.FuncSet"
   Elementary_Metric_Spaces Cartesian_Space
   Connected
 begin
 subsection \<open>Orthogonal Transformation of Balls\<close>
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Various Lemmas Combining Imports\<close>
 
 lemma open_sums:
   fixes T :: "('b::real_normed_vector) set"
   assumes "open S \<or> open T"
   shows "open (\<Union>x\<in> S. \<Union>y \<in> T. {x + y})"
   using assms
 proof
   assume S: "open S"
   show ?thesis
   proof (clarsimp simp: open_dist)
     fix x y
     assume "x \<in> S" "y \<in> T"
     with S obtain e where "e > 0" and e: "\<And>x'. dist x' x < e \<Longrightarrow> x' \<in> S"
       by (auto simp: open_dist)
     then have "\<And>z. dist z (x + y) < e \<Longrightarrow> \<exists>x\<in>S. \<exists>y\<in>T. z = x + y"
       by (metis \<open>y \<in> T\<close> diff_add_cancel dist_add_cancel2)
     then show "\<exists>e>0. \<forall>z. dist z (x + y) < e \<longrightarrow> (\<exists>x\<in>S. \<exists>y\<in>T. z = x + y)"
       using \<open>0 < e\<close> \<open>x \<in> S\<close> by blast
   qed
 next
   assume T: "open T"
   show ?thesis
   proof (clarsimp simp: open_dist)
     fix x y
     assume "x \<in> S" "y \<in> T"
     with T obtain e where "e > 0" and e: "\<And>x'. dist x' y < e \<Longrightarrow> x' \<in> T"
       by (auto simp: open_dist)
     then have "\<And>z. dist z (x + y) < e \<Longrightarrow> \<exists>x\<in>S. \<exists>y\<in>T. z = x + y"
       by (metis \<open>x \<in> S\<close> add_diff_cancel_left' add_diff_eq diff_diff_add dist_norm)
     then show "\<exists>e>0. \<forall>z. dist z (x + y) < e \<longrightarrow> (\<exists>x\<in>S. \<exists>y\<in>T. z = x + y)"
       using \<open>0 < e\<close> \<open>y \<in> T\<close> by blast
   qed
 qed
 
 lemma image_orthogonal_transformation_ball:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'a"
   assumes "orthogonal_transformation f"
   shows "f ` ball x r = ball (f x) r"
 proof (intro equalityI subsetI)
   fix y assume "y \<in> f ` ball x r"
   with assms show "y \<in> ball (f x) r"
     by (auto simp: orthogonal_transformation_isometry)
 next
   fix y assume y: "y \<in> ball (f x) r"
   then obtain z where z: "y = f z"
     using assms orthogonal_transformation_surj by blast
   with y assms show "y \<in> f ` ball x r"
     by (auto simp: orthogonal_transformation_isometry)
 qed
 
 lemma image_orthogonal_transformation_cball:
   fixes f :: "'a::euclidean_space \<Rightarrow> 'a"
   assumes "orthogonal_transformation f"
   shows "f ` cball x r = cball (f x) r"
 proof (intro equalityI subsetI)
   fix y assume "y \<in> f ` cball x r"
   with assms show "y \<in> cball (f x) r"
     by (auto simp: orthogonal_transformation_isometry)
 next
   fix y assume y: "y \<in> cball (f x) r"
   then obtain z where z: "y = f z"
     using assms orthogonal_transformation_surj by blast
   with y assms show "y \<in> f ` cball x r"
     by (auto simp: orthogonal_transformation_isometry)
 qed
 
 
 subsection \<open>Support\<close>
 
 definition (in monoid_add) support_on :: "'b set \<Rightarrow> ('b \<Rightarrow> 'a) \<Rightarrow> 'b set"
   where "support_on s f = {x\<in>s. f x \<noteq> 0}"
 
 lemma in_support_on: "x \<in> support_on s f \<longleftrightarrow> x \<in> s \<and> f x \<noteq> 0"
   by (simp add: support_on_def)
 
 lemma support_on_simps[simp]:
   "support_on {} f = {}"
   "support_on (insert x s) f =
     (if f x = 0 then support_on s f else insert x (support_on s f))"
   "support_on (s \<union> t) f = support_on s f \<union> support_on t f"
   "support_on (s \<inter> t) f = support_on s f \<inter> support_on t f"
   "support_on (s - t) f = support_on s f - support_on t f"
   "support_on (f ` s) g = f ` (support_on s (g \<circ> f))"
   unfolding support_on_def by auto
 
 lemma support_on_cong:
   "(\<And>x. x \<in> s \<Longrightarrow> f x = 0 \<longleftrightarrow> g x = 0) \<Longrightarrow> support_on s f = support_on s g"
   by (auto simp: support_on_def)
 
 lemma support_on_if: "a \<noteq> 0 \<Longrightarrow> support_on A (\<lambda>x. if P x then a else 0) = {x\<in>A. P x}"
   by (auto simp: support_on_def)
 
 lemma support_on_if_subset: "support_on A (\<lambda>x. if P x then a else 0) \<subseteq> {x \<in> A. P x}"
   by (auto simp: support_on_def)
 
 lemma finite_support[intro]: "finite S \<Longrightarrow> finite (support_on S f)"
   unfolding support_on_def by auto
 
 (* TODO: is supp_sum really needed? TODO: Generalize to Finite_Set.fold *)
 definition (in comm_monoid_add) supp_sum :: "('b \<Rightarrow> 'a) \<Rightarrow> 'b set \<Rightarrow> 'a"
   where "supp_sum f S = (\<Sum>x\<in>support_on S f. f x)"
 
 lemma supp_sum_empty[simp]: "supp_sum f {} = 0"
   unfolding supp_sum_def by auto
 
 lemma supp_sum_insert[simp]:
   "finite (support_on S f) \<Longrightarrow>
     supp_sum f (insert x S) = (if x \<in> S then supp_sum f S else f x + supp_sum f S)"
   by (simp add: supp_sum_def in_support_on insert_absorb)
 
 lemma supp_sum_divide_distrib: "supp_sum f A / (r::'a::field) = supp_sum (\<lambda>n. f n / r) A"
   by (cases "r = 0")
      (auto simp: supp_sum_def sum_divide_distrib intro!: sum.cong support_on_cong)
 
 
 subsection \<open>Intervals\<close>
 
 lemma image_affinity_interval:
   fixes c :: "'a::ordered_real_vector"
   shows "((\<lambda>x. m *\<^sub>R x + c) ` {a..b}) = 
            (if {a..b}={} then {}
             else if 0 \<le> m then {m *\<^sub>R a + c .. m  *\<^sub>R b + c}
             else {m *\<^sub>R b + c .. m *\<^sub>R a + c})"
          (is "?lhs = ?rhs")
 proof (cases "m=0")
   case True
   then show ?thesis
     by force
 next
   case False
   show ?thesis
   proof
     show "?lhs \<subseteq> ?rhs"
       by (auto simp: scaleR_left_mono scaleR_left_mono_neg)
     show "?rhs \<subseteq> ?lhs"
     proof (clarsimp, intro conjI impI subsetI)
       show "\<lbrakk>0 \<le> m; a \<le> b; x \<in> {m *\<^sub>R a + c..m *\<^sub>R b + c}\<rbrakk>
             \<Longrightarrow> x \<in> (\<lambda>x. m *\<^sub>R x + c) ` {a..b}" for x
         apply (rule_tac x="inverse m *\<^sub>R (x-c)" in rev_image_eqI)
         using False apply (auto simp: pos_le_divideR_eq pos_divideR_le_eq le_diff_eq diff_le_eq)
         done
       show "\<lbrakk>\<not> 0 \<le> m; a \<le> b;  x \<in> {m *\<^sub>R b + c..m *\<^sub>R a + c}\<rbrakk>
             \<Longrightarrow> x \<in> (\<lambda>x. m *\<^sub>R x + c) ` {a..b}" for x
         apply (rule_tac x="inverse m *\<^sub>R (x-c)" in rev_image_eqI)
          apply (auto simp add: neg_le_divideR_eq neg_divideR_le_eq not_le le_diff_eq diff_le_eq)
         done
     qed
   qed
 qed
 
 subsection \<open>Limit Points\<close>
 
 lemma islimpt_ball:
   fixes x y :: "'a::{real_normed_vector,perfect_space}"
   shows "y islimpt ball x e \<longleftrightarrow> 0 < e \<and> y \<in> cball x e"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   show ?rhs if ?lhs
   proof
     {
       assume "e \<le> 0"
       then have *: "ball x e = {}"
         using ball_eq_empty[of x e] by auto
       have False using \<open>?lhs\<close>
         unfolding * using islimpt_EMPTY[of y] by auto
     }
     then show "e > 0" by (metis not_less)
     show "y \<in> cball x e"
       using closed_cball[of x e] islimpt_subset[of y "ball x e" "cball x e"]
         ball_subset_cball[of x e] \<open>?lhs\<close>
       unfolding closed_limpt by auto
   qed
   show ?lhs if ?rhs
   proof -
     from that have "e > 0" by auto
     {
       fix d :: real
       assume "d > 0"
       have "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d"
       proof (cases "d \<le> dist x y")
         case True
         then show "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d"
         proof (cases "x = y")
           case True
           then have False
             using \<open>d \<le> dist x y\<close> \<open>d>0\<close> by auto
           then show "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d"
             by auto
         next
           case False
           have "dist x (y - (d / (2 * dist y x)) *\<^sub>R (y - x)) =
             norm (x - y + (d / (2 * norm (y - x))) *\<^sub>R (y - x))"
             unfolding mem_cball mem_ball dist_norm diff_diff_eq2 diff_add_eq[symmetric]
             by auto
           also have "\<dots> = \<bar>- 1 + d / (2 * norm (x - y))\<bar> * norm (x - y)"
             using scaleR_left_distrib[of "- 1" "d / (2 * norm (y - x))", symmetric, of "y - x"]
             unfolding scaleR_minus_left scaleR_one
             by (auto simp: norm_minus_commute)
           also have "\<dots> = \<bar>- norm (x - y) + d / 2\<bar>"
             unfolding abs_mult_pos[of "norm (x - y)", OF norm_ge_zero[of "x - y"]]
             unfolding distrib_right using \<open>x\<noteq>y\<close>  by auto
           also have "\<dots> \<le> e - d/2" using \<open>d \<le> dist x y\<close> and \<open>d>0\<close> and \<open>?rhs\<close>
             by (auto simp: dist_norm)
           finally have "y - (d / (2 * dist y x)) *\<^sub>R (y - x) \<in> ball x e" using \<open>d>0\<close>
             by auto
           moreover
           have "(d / (2*dist y x)) *\<^sub>R (y - x) \<noteq> 0"
             using \<open>x\<noteq>y\<close>[unfolded dist_nz] \<open>d>0\<close> unfolding scaleR_eq_0_iff
             by (auto simp: dist_commute)
           moreover
           have "dist (y - (d / (2 * dist y x)) *\<^sub>R (y - x)) y < d"
             unfolding dist_norm
             apply simp
             unfolding norm_minus_cancel
             using \<open>d > 0\<close> \<open>x\<noteq>y\<close>[unfolded dist_nz] dist_commute[of x y]
             unfolding dist_norm
             apply auto
             done
           ultimately show "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d"
             apply (rule_tac x = "y - (d / (2*dist y x)) *\<^sub>R (y - x)" in bexI)
             apply auto
             done
         qed
       next
         case False
         then have "d > dist x y" by auto
         show "\<exists>x' \<in> ball x e. x' \<noteq> y \<and> dist x' y < d"
         proof (cases "x = y")
           case True
           obtain z where **: "z \<noteq> y" "dist z y < min e d"
             using perfect_choose_dist[of "min e d" y]
             using \<open>d > 0\<close> \<open>e>0\<close> by auto
           show "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d"
             unfolding \<open>x = y\<close>
             using \<open>z \<noteq> y\<close> **
             apply (rule_tac x=z in bexI)
             apply (auto simp: dist_commute)
             done
         next
           case False
           then show "\<exists>x'\<in>ball x e. x' \<noteq> y \<and> dist x' y < d"
             using \<open>d>0\<close> \<open>d > dist x y\<close> \<open>?rhs\<close>
             apply (rule_tac x=x in bexI, auto)
             done
         qed
       qed
     }
     then show ?thesis
       unfolding mem_cball islimpt_approachable mem_ball by auto
   qed
 qed
 
 lemma closure_ball_lemma:
   fixes x y :: "'a::real_normed_vector"
   assumes "x \<noteq> y"
   shows "y islimpt ball x (dist x y)"
 proof (rule islimptI)
   fix T
   assume "y \<in> T" "open T"
   then obtain r where "0 < r" "\<forall>z. dist z y < r \<longrightarrow> z \<in> T"
     unfolding open_dist by fast
   (* choose point between x and y, within distance r of y. *)
   define k where "k = min 1 (r / (2 * dist x y))"
   define z where "z = y + scaleR k (x - y)"
   have z_def2: "z = x + scaleR (1 - k) (y - x)"
     unfolding z_def by (simp add: algebra_simps)
   have "dist z y < r"
     unfolding z_def k_def using \<open>0 < r\<close>
     by (simp add: dist_norm min_def)
   then have "z \<in> T"
     using \<open>\<forall>z. dist z y < r \<longrightarrow> z \<in> T\<close> by simp
   have "dist x z < dist x y"
     unfolding z_def2 dist_norm
     apply (simp add: norm_minus_commute)
     apply (simp only: dist_norm [symmetric])
     apply (subgoal_tac "\<bar>1 - k\<bar> * dist x y < 1 * dist x y", simp)
     apply (rule mult_strict_right_mono)
     apply (simp add: k_def \<open>0 < r\<close> \<open>x \<noteq> y\<close>)
     apply (simp add: \<open>x \<noteq> y\<close>)
     done
   then have "z \<in> ball x (dist x y)"
     by simp
   have "z \<noteq> y"
     unfolding z_def k_def using \<open>x \<noteq> y\<close> \<open>0 < r\<close>
     by (simp add: min_def)
   show "\<exists>z\<in>ball x (dist x y). z \<in> T \<and> z \<noteq> y"
     using \<open>z \<in> ball x (dist x y)\<close> \<open>z \<in> T\<close> \<open>z \<noteq> y\<close>
     by fast
 qed
 
 
 subsection \<open>Balls and Spheres in Normed Spaces\<close>
 
 lemma mem_ball_0 [simp]: "x \<in> ball 0 e \<longleftrightarrow> norm x < e"
   for x :: "'a::real_normed_vector"
   by (simp add: dist_norm)
 
 lemma mem_cball_0 [simp]: "x \<in> cball 0 e \<longleftrightarrow> norm x \<le> e"
   for x :: "'a::real_normed_vector"
   by (simp add: dist_norm)
 
 lemma closure_ball [simp]:
   fixes x :: "'a::real_normed_vector"
   shows "0 < e \<Longrightarrow> closure (ball x e) = cball x e"
   apply (rule equalityI)
   apply (rule closure_minimal)
   apply (rule ball_subset_cball)
   apply (rule closed_cball)
   apply (rule subsetI, rename_tac y)
   apply (simp add: le_less [where 'a=real])
   apply (erule disjE)
   apply (rule subsetD [OF closure_subset], simp)
   apply (simp add: closure_def, clarify)
   apply (rule closure_ball_lemma)
   apply simp
   done
 
 lemma mem_sphere_0 [simp]: "x \<in> sphere 0 e \<longleftrightarrow> norm x = e"
   for x :: "'a::real_normed_vector"
   by (simp add: dist_norm)
 
 (* In a trivial vector space, this fails for e = 0. *)
 lemma interior_cball [simp]:
   fixes x :: "'a::{real_normed_vector, perfect_space}"
   shows "interior (cball x e) = ball x e"
 proof (cases "e \<ge> 0")
   case False note cs = this
   from cs have null: "ball x e = {}"
     using ball_empty[of e x] by auto
   moreover
   have "cball x e = {}"
   proof (rule equals0I)
     fix y
     assume "y \<in> cball x e"
     then show False
       by (metis ball_eq_empty null cs dist_eq_0_iff dist_le_zero_iff empty_subsetI mem_cball
           subset_antisym subset_ball)
   qed
   then have "interior (cball x e) = {}"
     using interior_empty by auto
   ultimately show ?thesis by blast
 next
   case True note cs = this
   have "ball x e \<subseteq> cball x e"
     using ball_subset_cball by auto
   moreover
   {
     fix S y
     assume as: "S \<subseteq> cball x e" "open S" "y\<in>S"
     then obtain d where "d>0" and d: "\<forall>x'. dist x' y < d \<longrightarrow> x' \<in> S"
       unfolding open_dist by blast
     then obtain xa where xa_y: "xa \<noteq> y" and xa: "dist xa y < d"
       using perfect_choose_dist [of d] by auto
     have "xa \<in> S"
       using d[THEN spec[where x = xa]]
       using xa by (auto simp: dist_commute)
     then have xa_cball: "xa \<in> cball x e"
       using as(1) by auto
     then have "y \<in> ball x e"
     proof (cases "x = y")
       case True
       then have "e > 0" using cs order.order_iff_strict xa_cball xa_y by fastforce
       then show "y \<in> ball x e"
         using \<open>x = y \<close> by simp
     next
       case False
       have "dist (y + (d / 2 / dist y x) *\<^sub>R (y - x)) y < d"
         unfolding dist_norm
         using \<open>d>0\<close> norm_ge_zero[of "y - x"] \<open>x \<noteq> y\<close> by auto
       then have *: "y + (d / 2 / dist y x) *\<^sub>R (y - x) \<in> cball x e"
         using d as(1)[unfolded subset_eq] by blast
       have "y - x \<noteq> 0" using \<open>x \<noteq> y\<close> by auto
       hence **:"d / (2 * norm (y - x)) > 0"
         unfolding zero_less_norm_iff[symmetric] using \<open>d>0\<close> by auto
       have "dist (y + (d / 2 / dist y x) *\<^sub>R (y - x)) x =
         norm (y + (d / (2 * norm (y - x))) *\<^sub>R y - (d / (2 * norm (y - x))) *\<^sub>R x - x)"
         by (auto simp: dist_norm algebra_simps)
       also have "\<dots> = norm ((1 + d / (2 * norm (y - x))) *\<^sub>R (y - x))"
         by (auto simp: algebra_simps)
       also have "\<dots> = \<bar>1 + d / (2 * norm (y - x))\<bar> * norm (y - x)"
         using ** by auto
       also have "\<dots> = (dist y x) + d/2"
         using ** by (auto simp: distrib_right dist_norm)
       finally have "e \<ge> dist x y +d/2"
         using *[unfolded mem_cball] by (auto simp: dist_commute)
       then show "y \<in> ball x e"
         unfolding mem_ball using \<open>d>0\<close> by auto
     qed
   }
   then have "\<forall>S \<subseteq> cball x e. open S \<longrightarrow> S \<subseteq> ball x e"
     by auto
   ultimately show ?thesis
     using interior_unique[of "ball x e" "cball x e"]
     using open_ball[of x e]
     by auto
 qed
 
 lemma frontier_ball [simp]:
   fixes a :: "'a::real_normed_vector"
   shows "0 < e \<Longrightarrow> frontier (ball a e) = sphere a e"
   by (force simp: frontier_def)
 
 lemma frontier_cball [simp]:
   fixes a :: "'a::{real_normed_vector, perfect_space}"
   shows "frontier (cball a e) = sphere a e"
   by (force simp: frontier_def)
 
 corollary compact_sphere [simp]:
   fixes a :: "'a::{real_normed_vector,perfect_space,heine_borel}"
   shows "compact (sphere a r)"
 using compact_frontier [of "cball a r"] by simp
 
 corollary bounded_sphere [simp]:
   fixes a :: "'a::{real_normed_vector,perfect_space,heine_borel}"
   shows "bounded (sphere a r)"
 by (simp add: compact_imp_bounded)
 
 corollary closed_sphere  [simp]:
   fixes a :: "'a::{real_normed_vector,perfect_space,heine_borel}"
   shows "closed (sphere a r)"
 by (simp add: compact_imp_closed)
 
 lemma image_add_ball [simp]:
   fixes a :: "'a::real_normed_vector"
   shows "(+) b ` ball a r = ball (a+b) r"
 apply (intro equalityI subsetI)
 apply (force simp: dist_norm)
 apply (rule_tac x="x-b" in image_eqI)
 apply (auto simp: dist_norm algebra_simps)
 done
 
 lemma image_add_cball [simp]:
   fixes a :: "'a::real_normed_vector"
   shows "(+) b ` cball a r = cball (a+b) r"
 apply (intro equalityI subsetI)
 apply (force simp: dist_norm)
 apply (rule_tac x="x-b" in image_eqI)
 apply (auto simp: dist_norm algebra_simps)
 done
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Various Lemmas on Normed Algebras\<close>
 
 
 lemma closed_of_nat_image: "closed (of_nat ` A :: 'a::real_normed_algebra_1 set)"
   by (rule discrete_imp_closed[of 1]) (auto simp: dist_of_nat)
 
 lemma closed_of_int_image: "closed (of_int ` A :: 'a::real_normed_algebra_1 set)"
   by (rule discrete_imp_closed[of 1]) (auto simp: dist_of_int)
 
 lemma closed_Nats [simp]: "closed (\<nat> :: 'a :: real_normed_algebra_1 set)"
   unfolding Nats_def by (rule closed_of_nat_image)
 
 lemma closed_Ints [simp]: "closed (\<int> :: 'a :: real_normed_algebra_1 set)"
   unfolding Ints_def by (rule closed_of_int_image)
 
 lemma closed_subset_Ints:
   fixes A :: "'a :: real_normed_algebra_1 set"
   assumes "A \<subseteq> \<int>"
   shows   "closed A"
 proof (intro discrete_imp_closed[OF zero_less_one] ballI impI, goal_cases)
   case (1 x y)
   with assms have "x \<in> \<int>" and "y \<in> \<int>" by auto
   with \<open>dist y x < 1\<close> show "y = x"
     by (auto elim!: Ints_cases simp: dist_of_int)
 qed
 
 subsection \<open>Filters\<close>
 
 definition indirection :: "'a::real_normed_vector \<Rightarrow> 'a \<Rightarrow> 'a filter"  (infixr "indirection" 70)
   where "a indirection v = at a within {b. \<exists>c\<ge>0. b - a = scaleR c v}"
 
 
 subsection \<open>Trivial Limits\<close>
 
 lemma trivial_limit_at_infinity:
   "\<not> trivial_limit (at_infinity :: ('a::{real_normed_vector,perfect_space}) filter)"
   unfolding trivial_limit_def eventually_at_infinity
   apply clarsimp
   apply (subgoal_tac "\<exists>x::'a. x \<noteq> 0", clarify)
    apply (rule_tac x="scaleR (b / norm x) x" in exI, simp)
   apply (cut_tac islimpt_UNIV [of "0::'a", unfolded islimpt_def])
   apply (drule_tac x=UNIV in spec, simp)
   done
 
 lemma at_within_ball_bot_iff:
   fixes x y :: "'a::{real_normed_vector,perfect_space}"
   shows "at x within ball y r = bot \<longleftrightarrow> (r=0 \<or> x \<notin> cball y r)"
   unfolding trivial_limit_within 
   apply (auto simp add:trivial_limit_within islimpt_ball )
   by (metis le_less_trans less_eq_real_def zero_le_dist)
 
 
 subsection \<open>Limits\<close>
 
 proposition Lim_at_infinity: "(f \<longlongrightarrow> l) at_infinity \<longleftrightarrow> (\<forall>e>0. \<exists>b. \<forall>x. norm x \<ge> b \<longrightarrow> dist (f x) l < e)"
   by (auto simp: tendsto_iff eventually_at_infinity)
 
 corollary Lim_at_infinityI [intro?]:
   assumes "\<And>e. e > 0 \<Longrightarrow> \<exists>B. \<forall>x. norm x \<ge> B \<longrightarrow> dist (f x) l \<le> e"
   shows "(f \<longlongrightarrow> l) at_infinity"
   apply (simp add: Lim_at_infinity, clarify)
   apply (rule ex_forward [OF assms [OF half_gt_zero]], auto)
   done
 
 lemma Lim_transform_within_set_eq:
   fixes a :: "'a::metric_space" and l :: "'b::metric_space"
   shows "eventually (\<lambda>x. x \<in> S \<longleftrightarrow> x \<in> T) (at a)
          \<Longrightarrow> ((f \<longlongrightarrow> l) (at a within S) \<longleftrightarrow> (f \<longlongrightarrow> l) (at a within T))"
   by (force intro: Lim_transform_within_set elim: eventually_mono)
 
 lemma Lim_null:
   fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
   shows "(f \<longlongrightarrow> l) net \<longleftrightarrow> ((\<lambda>x. f(x) - l) \<longlongrightarrow> 0) net"
   by (simp add: Lim dist_norm)
 
 lemma Lim_null_comparison:
   fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
   assumes "eventually (\<lambda>x. norm (f x) \<le> g x) net" "(g \<longlongrightarrow> 0) net"
   shows "(f \<longlongrightarrow> 0) net"
   using assms(2)
 proof (rule metric_tendsto_imp_tendsto)
   show "eventually (\<lambda>x. dist (f x) 0 \<le> dist (g x) 0) net"
     using assms(1) by (rule eventually_mono) (simp add: dist_norm)
 qed
 
 lemma Lim_transform_bound:
   fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
     and g :: "'a \<Rightarrow> 'c::real_normed_vector"
   assumes "eventually (\<lambda>n. norm (f n) \<le> norm (g n)) net"
     and "(g \<longlongrightarrow> 0) net"
   shows "(f \<longlongrightarrow> 0) net"
   using assms(1) tendsto_norm_zero [OF assms(2)]
   by (rule Lim_null_comparison)
 
 lemma lim_null_mult_right_bounded:
   fixes f :: "'a \<Rightarrow> 'b::real_normed_div_algebra"
   assumes f: "(f \<longlongrightarrow> 0) F" and g: "eventually (\<lambda>x. norm(g x) \<le> B) F"
     shows "((\<lambda>z. f z * g z) \<longlongrightarrow> 0) F"
 proof -
   have *: "((\<lambda>x. norm (f x) * B) \<longlongrightarrow> 0) F"
     by (simp add: f tendsto_mult_left_zero tendsto_norm_zero)
   have "((\<lambda>x. norm (f x) * norm (g x)) \<longlongrightarrow> 0) F"
     apply (rule Lim_null_comparison [OF _ *])
     apply (simp add: eventually_mono [OF g] mult_left_mono)
     done
   then show ?thesis
     by (subst tendsto_norm_zero_iff [symmetric]) (simp add: norm_mult)
 qed
 
 lemma lim_null_mult_left_bounded:
   fixes f :: "'a \<Rightarrow> 'b::real_normed_div_algebra"
   assumes g: "eventually (\<lambda>x. norm(g x) \<le> B) F" and f: "(f \<longlongrightarrow> 0) F"
     shows "((\<lambda>z. g z * f z) \<longlongrightarrow> 0) F"
 proof -
   have *: "((\<lambda>x. B * norm (f x)) \<longlongrightarrow> 0) F"
     by (simp add: f tendsto_mult_right_zero tendsto_norm_zero)
   have "((\<lambda>x. norm (g x) * norm (f x)) \<longlongrightarrow> 0) F"
     apply (rule Lim_null_comparison [OF _ *])
     apply (simp add: eventually_mono [OF g] mult_right_mono)
     done
   then show ?thesis
     by (subst tendsto_norm_zero_iff [symmetric]) (simp add: norm_mult)
 qed
 
 lemma lim_null_scaleR_bounded:
   assumes f: "(f \<longlongrightarrow> 0) net" and gB: "eventually (\<lambda>a. f a = 0 \<or> norm(g a) \<le> B) net"
     shows "((\<lambda>n. f n *\<^sub>R g n) \<longlongrightarrow> 0) net"
 proof
   fix \<epsilon>::real
   assume "0 < \<epsilon>"
   then have B: "0 < \<epsilon> / (abs B + 1)" by simp
   have *: "\<bar>f x\<bar> * norm (g x) < \<epsilon>" if f: "\<bar>f x\<bar> * (\<bar>B\<bar> + 1) < \<epsilon>" and g: "norm (g x) \<le> B" for x
   proof -
     have "\<bar>f x\<bar> * norm (g x) \<le> \<bar>f x\<bar> * B"
       by (simp add: mult_left_mono g)
     also have "\<dots> \<le> \<bar>f x\<bar> * (\<bar>B\<bar> + 1)"
       by (simp add: mult_left_mono)
     also have "\<dots> < \<epsilon>"
       by (rule f)
     finally show ?thesis .
   qed
   show "\<forall>\<^sub>F x in net. dist (f x *\<^sub>R g x) 0 < \<epsilon>"
     apply (rule eventually_mono [OF eventually_conj [OF tendstoD [OF f B] gB] ])
     apply (auto simp: \<open>0 < \<epsilon>\<close> field_split_simps * split: if_split_asm)
     done
 qed
 
 lemma Lim_norm_ubound:
   fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
   assumes "\<not>(trivial_limit net)" "(f \<longlongrightarrow> l) net" "eventually (\<lambda>x. norm(f x) \<le> e) net"
   shows "norm(l) \<le> e"
   using assms by (fast intro: tendsto_le tendsto_intros)
 
 lemma Lim_norm_lbound:
   fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
   assumes "\<not> trivial_limit net"
     and "(f \<longlongrightarrow> l) net"
     and "eventually (\<lambda>x. e \<le> norm (f x)) net"
   shows "e \<le> norm l"
   using assms by (fast intro: tendsto_le tendsto_intros)
 
 text\<open>Limit under bilinear function\<close>
 
 lemma Lim_bilinear:
   assumes "(f \<longlongrightarrow> l) net"
     and "(g \<longlongrightarrow> m) net"
     and "bounded_bilinear h"
   shows "((\<lambda>x. h (f x) (g x)) \<longlongrightarrow> (h l m)) net"
   using \<open>bounded_bilinear h\<close> \<open>(f \<longlongrightarrow> l) net\<close> \<open>(g \<longlongrightarrow> m) net\<close>
   by (rule bounded_bilinear.tendsto)
 
 lemma Lim_at_zero:
   fixes a :: "'a::real_normed_vector"
     and l :: "'b::topological_space"
   shows "(f \<longlongrightarrow> l) (at a) \<longleftrightarrow> ((\<lambda>x. f(a + x)) \<longlongrightarrow> l) (at 0)"
   using LIM_offset_zero LIM_offset_zero_cancel ..
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Limit Point of Filter\<close>
 
 lemma netlimit_at_vector:
   fixes a :: "'a::real_normed_vector"
   shows "netlimit (at a) = a"
 proof (cases "\<exists>x. x \<noteq> a")
   case True then obtain x where x: "x \<noteq> a" ..
   have "\<not> trivial_limit (at a)"
     unfolding trivial_limit_def eventually_at dist_norm
     apply clarsimp
     apply (rule_tac x="a + scaleR (d / 2) (sgn (x - a))" in exI)
     apply (simp add: norm_sgn sgn_zero_iff x)
     done
   then show ?thesis
     by (rule Lim_ident_at [of a UNIV])
 qed simp
 
 subsection \<open>Boundedness\<close>
 
 lemma continuous_on_closure_norm_le:
   fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
   assumes "continuous_on (closure s) f"
     and "\<forall>y \<in> s. norm(f y) \<le> b"
     and "x \<in> (closure s)"
   shows "norm (f x) \<le> b"
 proof -
   have *: "f ` s \<subseteq> cball 0 b"
     using assms(2)[unfolded mem_cball_0[symmetric]] by auto
   show ?thesis
     by (meson "*" assms(1) assms(3) closed_cball image_closure_subset image_subset_iff mem_cball_0)
 qed
 
 lemma bounded_pos: "bounded S \<longleftrightarrow> (\<exists>b>0. \<forall>x\<in> S. norm x \<le> b)"
   unfolding bounded_iff 
   by (meson less_imp_le not_le order_trans zero_less_one)
 
 lemma bounded_pos_less: "bounded S \<longleftrightarrow> (\<exists>b>0. \<forall>x\<in> S. norm x < b)"
   apply (simp add: bounded_pos)
   apply (safe; rule_tac x="b+1" in exI; force)
   done
 
 lemma Bseq_eq_bounded:
   fixes f :: "nat \<Rightarrow> 'a::real_normed_vector"
   shows "Bseq f \<longleftrightarrow> bounded (range f)"
   unfolding Bseq_def bounded_pos by auto
 
 lemma bounded_linear_image:
   assumes "bounded S"
     and "bounded_linear f"
   shows "bounded (f ` S)"
 proof -
   from assms(1) obtain b where "b > 0" and b: "\<forall>x\<in>S. norm x \<le> b"
     unfolding bounded_pos by auto
   from assms(2) obtain B where B: "B > 0" "\<forall>x. norm (f x) \<le> B * norm x"
     using bounded_linear.pos_bounded by (auto simp: ac_simps)
   show ?thesis
     unfolding bounded_pos
   proof (intro exI, safe)
     show "norm (f x) \<le> B * b" if "x \<in> S" for x
       by (meson B b less_imp_le mult_left_mono order_trans that)
   qed (use \<open>b > 0\<close> \<open>B > 0\<close> in auto)
 qed
 
 lemma bounded_scaling:
   fixes S :: "'a::real_normed_vector set"
   shows "bounded S \<Longrightarrow> bounded ((\<lambda>x. c *\<^sub>R x) ` S)"
   apply (rule bounded_linear_image, assumption)
   apply (rule bounded_linear_scaleR_right)
   done
 
 lemma bounded_scaleR_comp:
   fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
   assumes "bounded (f ` S)"
   shows "bounded ((\<lambda>x. r *\<^sub>R f x) ` S)"
   using bounded_scaling[of "f ` S" r] assms
   by (auto simp: image_image)
 
 lemma bounded_translation:
   fixes S :: "'a::real_normed_vector set"
   assumes "bounded S"
   shows "bounded ((\<lambda>x. a + x) ` S)"
 proof -
   from assms obtain b where b: "b > 0" "\<forall>x\<in>S. norm x \<le> b"
     unfolding bounded_pos by auto
   {
     fix x
     assume "x \<in> S"
     then have "norm (a + x) \<le> b + norm a"
       using norm_triangle_ineq[of a x] b by auto
   }
   then show ?thesis
     unfolding bounded_pos
     using norm_ge_zero[of a] b(1) and add_strict_increasing[of b 0 "norm a"]
     by (auto intro!: exI[of _ "b + norm a"])
 qed
 
 lemma bounded_translation_minus:
   fixes S :: "'a::real_normed_vector set"
   shows "bounded S \<Longrightarrow> bounded ((\<lambda>x. x - a) ` S)"
 using bounded_translation [of S "-a"] by simp
 
 lemma bounded_uminus [simp]:
   fixes X :: "'a::real_normed_vector set"
   shows "bounded (uminus ` X) \<longleftrightarrow> bounded X"
 by (auto simp: bounded_def dist_norm; rule_tac x="-x" in exI; force simp: add.commute norm_minus_commute)
 
 lemma uminus_bounded_comp [simp]:
   fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
   shows "bounded ((\<lambda>x. - f x) ` S) \<longleftrightarrow> bounded (f ` S)"
   using bounded_uminus[of "f ` S"]
   by (auto simp: image_image)
 
 lemma bounded_plus_comp:
   fixes f g::"'a \<Rightarrow> 'b::real_normed_vector"
   assumes "bounded (f ` S)"
   assumes "bounded (g ` S)"
   shows "bounded ((\<lambda>x. f x + g x) ` S)"
 proof -
   {
     fix B C
     assume "\<And>x. x\<in>S \<Longrightarrow> norm (f x) \<le> B" "\<And>x. x\<in>S \<Longrightarrow> norm (g x) \<le> C"
     then have "\<And>x. x \<in> S \<Longrightarrow> norm (f x + g x) \<le> B + C"
       by (auto intro!: norm_triangle_le add_mono)
   } then show ?thesis
     using assms by (fastforce simp: bounded_iff)
 qed
 
 lemma bounded_plus:
   fixes S ::"'a::real_normed_vector set"
   assumes "bounded S" "bounded T"
   shows "bounded ((\<lambda>(x,y). x + y) ` (S \<times> T))"
   using bounded_plus_comp [of fst "S \<times> T" snd] assms
   by (auto simp: split_def split: if_split_asm)
 
 lemma bounded_minus_comp:
   "bounded (f ` S) \<Longrightarrow> bounded (g ` S) \<Longrightarrow> bounded ((\<lambda>x. f x - g x) ` S)"
   for f g::"'a \<Rightarrow> 'b::real_normed_vector"
   using bounded_plus_comp[of "f" S "\<lambda>x. - g x"]
   by auto
 
 lemma bounded_minus:
   fixes S ::"'a::real_normed_vector set"
   assumes "bounded S" "bounded T"
   shows "bounded ((\<lambda>(x,y). x - y) ` (S \<times> T))"
   using bounded_minus_comp [of fst "S \<times> T" snd] assms
   by (auto simp: split_def split: if_split_asm)
 
 lemma not_bounded_UNIV[simp]:
   "\<not> bounded (UNIV :: 'a::{real_normed_vector, perfect_space} set)"
 proof (auto simp: bounded_pos not_le)
   obtain x :: 'a where "x \<noteq> 0"
     using perfect_choose_dist [OF zero_less_one] by fast
   fix b :: real
   assume b: "b >0"
   have b1: "b +1 \<ge> 0"
     using b by simp
   with \<open>x \<noteq> 0\<close> have "b < norm (scaleR (b + 1) (sgn x))"
     by (simp add: norm_sgn)
   then show "\<exists>x::'a. b < norm x" ..
 qed
 
 corollary cobounded_imp_unbounded:
     fixes S :: "'a::{real_normed_vector, perfect_space} set"
     shows "bounded (- S) \<Longrightarrow> \<not> bounded S"
   using bounded_Un [of S "-S"]  by (simp add: sup_compl_top)
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Relations among convergence and absolute convergence for power series\<close>
 
 lemma summable_imp_bounded:
   fixes f :: "nat \<Rightarrow> 'a::real_normed_vector"
   shows "summable f \<Longrightarrow> bounded (range f)"
 by (frule summable_LIMSEQ_zero) (simp add: convergent_imp_bounded)
 
 lemma summable_imp_sums_bounded:
    "summable f \<Longrightarrow> bounded (range (\<lambda>n. sum f {..<n}))"
 by (auto simp: summable_def sums_def dest: convergent_imp_bounded)
 
 lemma power_series_conv_imp_absconv_weak:
   fixes a:: "nat \<Rightarrow> 'a::{real_normed_div_algebra,banach}" and w :: 'a
   assumes sum: "summable (\<lambda>n. a n * z ^ n)" and no: "norm w < norm z"
     shows "summable (\<lambda>n. of_real(norm(a n)) * w ^ n)"
 proof -
   obtain M where M: "\<And>x. norm (a x * z ^ x) \<le> M"
     using summable_imp_bounded [OF sum] by (force simp: bounded_iff)
   then have *: "summable (\<lambda>n. norm (a n) * norm w ^ n)"
     by (rule_tac M=M in Abel_lemma) (auto simp: norm_mult norm_power intro: no)
   show ?thesis
     apply (rule series_comparison_complex [of "(\<lambda>n. of_real(norm(a n) * norm w ^ n))"])
     apply (simp only: summable_complex_of_real *)
     apply (auto simp: norm_mult norm_power)
     done
 qed
 
 
 subsection \<open>Normed spaces with the Heine-Borel property\<close>
 
 lemma not_compact_UNIV[simp]:
   fixes s :: "'a::{real_normed_vector,perfect_space,heine_borel} set"
   shows "\<not> compact (UNIV::'a set)"
     by (simp add: compact_eq_bounded_closed)
 
 lemma not_compact_space_euclideanreal [simp]: "\<not> compact_space euclideanreal"
   by (simp add: compact_space_def)
 
 text\<open>Representing sets as the union of a chain of compact sets.\<close>
 lemma closed_Union_compact_subsets:
   fixes S :: "'a::{heine_borel,real_normed_vector} set"
   assumes "closed S"
   obtains F where "\<And>n. compact(F n)" "\<And>n. F n \<subseteq> S" "\<And>n. F n \<subseteq> F(Suc n)"
                   "(\<Union>n. F n) = S" "\<And>K. \<lbrakk>compact K; K \<subseteq> S\<rbrakk> \<Longrightarrow> \<exists>N. \<forall>n \<ge> N. K \<subseteq> F n"
 proof
   show "compact (S \<inter> cball 0 (of_nat n))" for n
     using assms compact_eq_bounded_closed by auto
 next
   show "(\<Union>n. S \<inter> cball 0 (real n)) = S"
     by (auto simp: real_arch_simple)
 next
   fix K :: "'a set"
   assume "compact K" "K \<subseteq> S"
   then obtain N where "K \<subseteq> cball 0 N"
     by (meson bounded_pos mem_cball_0 compact_imp_bounded subsetI)
   then show "\<exists>N. \<forall>n\<ge>N. K \<subseteq> S \<inter> cball 0 (real n)"
     by (metis of_nat_le_iff Int_subset_iff \<open>K \<subseteq> S\<close> real_arch_simple subset_cball subset_trans)
 qed auto
 
 subsection \<open>Intersecting chains of compact sets and the Baire property\<close>
 
 proposition bounded_closed_chain:
   fixes \<F> :: "'a::heine_borel set set"
   assumes "B \<in> \<F>" "bounded B" and \<F>: "\<And>S. S \<in> \<F> \<Longrightarrow> closed S" and "{} \<notin> \<F>"
       and chain: "\<And>S T. S \<in> \<F> \<and> T \<in> \<F> \<Longrightarrow> S \<subseteq> T \<or> T \<subseteq> S"
     shows "\<Inter>\<F> \<noteq> {}"
 proof -
   have "B \<inter> \<Inter>\<F> \<noteq> {}"
   proof (rule compact_imp_fip)
     show "compact B" "\<And>T. T \<in> \<F> \<Longrightarrow> closed T"
       by (simp_all add: assms compact_eq_bounded_closed)
     show "\<lbrakk>finite \<G>; \<G> \<subseteq> \<F>\<rbrakk> \<Longrightarrow> B \<inter> \<Inter>\<G> \<noteq> {}" for \<G>
     proof (induction \<G> rule: finite_induct)
       case empty
       with assms show ?case by force
     next
       case (insert U \<G>)
       then have "U \<in> \<F>" and ne: "B \<inter> \<Inter>\<G> \<noteq> {}" by auto
       then consider "B \<subseteq> U" | "U \<subseteq> B"
           using \<open>B \<in> \<F>\<close> chain by blast
         then show ?case
         proof cases
           case 1
           then show ?thesis
             using Int_left_commute ne by auto
         next
           case 2
           have "U \<noteq> {}"
             using \<open>U \<in> \<F>\<close> \<open>{} \<notin> \<F>\<close> by blast
           moreover
           have False if "\<And>x. x \<in> U \<Longrightarrow> \<exists>Y\<in>\<G>. x \<notin> Y"
           proof -
             have "\<And>x. x \<in> U \<Longrightarrow> \<exists>Y\<in>\<G>. Y \<subseteq> U"
               by (metis chain contra_subsetD insert.prems insert_subset that)
             then obtain Y where "Y \<in> \<G>" "Y \<subseteq> U"
               by (metis all_not_in_conv \<open>U \<noteq> {}\<close>)
             moreover obtain x where "x \<in> \<Inter>\<G>"
               by (metis Int_emptyI ne)
             ultimately show ?thesis
               by (metis Inf_lower subset_eq that)
           qed
           with 2 show ?thesis
             by blast
         qed
       qed
   qed
   then show ?thesis by blast
 qed
 
 corollary compact_chain:
   fixes \<F> :: "'a::heine_borel set set"
   assumes "\<And>S. S \<in> \<F> \<Longrightarrow> compact S" "{} \<notin> \<F>"
           "\<And>S T. S \<in> \<F> \<and> T \<in> \<F> \<Longrightarrow> S \<subseteq> T \<or> T \<subseteq> S"
     shows "\<Inter> \<F> \<noteq> {}"
 proof (cases "\<F> = {}")
   case True
   then show ?thesis by auto
 next
   case False
   show ?thesis
     by (metis False all_not_in_conv assms compact_imp_bounded compact_imp_closed bounded_closed_chain)
 qed
 
 lemma compact_nest:
   fixes F :: "'a::linorder \<Rightarrow> 'b::heine_borel set"
   assumes F: "\<And>n. compact(F n)" "\<And>n. F n \<noteq> {}" and mono: "\<And>m n. m \<le> n \<Longrightarrow> F n \<subseteq> F m"
   shows "\<Inter>(range F) \<noteq> {}"
 proof -
   have *: "\<And>S T. S \<in> range F \<and> T \<in> range F \<Longrightarrow> S \<subseteq> T \<or> T \<subseteq> S"
     by (metis mono image_iff le_cases)
   show ?thesis
     apply (rule compact_chain [OF _ _ *])
     using F apply (blast intro: dest: *)+
     done
 qed
 
 text\<open>The Baire property of dense sets\<close>
 theorem Baire:
   fixes S::"'a::{real_normed_vector,heine_borel} set"
   assumes "closed S" "countable \<G>"
       and ope: "\<And>T. T \<in> \<G> \<Longrightarrow> openin (top_of_set S) T \<and> S \<subseteq> closure T"
  shows "S \<subseteq> closure(\<Inter>\<G>)"
 proof (cases "\<G> = {}")
   case True
   then show ?thesis
     using closure_subset by auto
 next
   let ?g = "from_nat_into \<G>"
   case False
   then have gin: "?g n \<in> \<G>" for n
     by (simp add: from_nat_into)
   show ?thesis
   proof (clarsimp simp: closure_approachable)
     fix x and e::real
     assume "x \<in> S" "0 < e"
     obtain TF where opeF: "\<And>n. openin (top_of_set S) (TF n)"
                and ne: "\<And>n. TF n \<noteq> {}"
                and subg: "\<And>n. S \<inter> closure(TF n) \<subseteq> ?g n"
                and subball: "\<And>n. closure(TF n) \<subseteq> ball x e"
                and decr: "\<And>n. TF(Suc n) \<subseteq> TF n"
     proof -
       have *: "\<exists>Y. (openin (top_of_set S) Y \<and> Y \<noteq> {} \<and>
                    S \<inter> closure Y \<subseteq> ?g n \<and> closure Y \<subseteq> ball x e) \<and> Y \<subseteq> U"
         if opeU: "openin (top_of_set S) U" and "U \<noteq> {}" and cloU: "closure U \<subseteq> ball x e" for U n
       proof -
         obtain T where T: "open T" "U = T \<inter> S"
           using \<open>openin (top_of_set S) U\<close> by (auto simp: openin_subtopology)
         with \<open>U \<noteq> {}\<close> have "T \<inter> closure (?g n) \<noteq> {}"
           using gin ope by fastforce
         then have "T \<inter> ?g n \<noteq> {}"
           using \<open>open T\<close> open_Int_closure_eq_empty by blast
         then obtain y where "y \<in> U" "y \<in> ?g n"
           using T ope [of "?g n", OF gin] by (blast dest:  openin_imp_subset)
         moreover have "openin (top_of_set S) (U \<inter> ?g n)"
           using gin ope opeU by blast
         ultimately obtain d where U: "U \<inter> ?g n \<subseteq> S" and "d > 0" and d: "ball y d \<inter> S \<subseteq> U \<inter> ?g n"
           by (force simp: openin_contains_ball)
         show ?thesis
         proof (intro exI conjI)
           show "openin (top_of_set S) (S \<inter> ball y (d/2))"
             by (simp add: openin_open_Int)
           show "S \<inter> ball y (d/2) \<noteq> {}"
             using \<open>0 < d\<close> \<open>y \<in> U\<close> opeU openin_imp_subset by fastforce
           have "S \<inter> closure (S \<inter> ball y (d/2)) \<subseteq> S \<inter> closure (ball y (d/2))"
             using closure_mono by blast
           also have "... \<subseteq> ?g n"
             using \<open>d > 0\<close> d by force
           finally show "S \<inter> closure (S \<inter> ball y (d/2)) \<subseteq> ?g n" .
           have "closure (S \<inter> ball y (d/2)) \<subseteq> S \<inter> ball y d"
           proof -
             have "closure (ball y (d/2)) \<subseteq> ball y d"
               using \<open>d > 0\<close> by auto
             then have "closure (S \<inter> ball y (d/2)) \<subseteq> ball y d"
               by (meson closure_mono inf.cobounded2 subset_trans)
             then show ?thesis
               by (simp add: \<open>closed S\<close> closure_minimal)
           qed
           also have "...  \<subseteq> ball x e"
             using cloU closure_subset d by blast
           finally show "closure (S \<inter> ball y (d/2)) \<subseteq> ball x e" .
           show "S \<inter> ball y (d/2) \<subseteq> U"
             using ball_divide_subset_numeral d by blast
         qed
       qed
       let ?\<Phi> = "\<lambda>n X. openin (top_of_set S) X \<and> X \<noteq> {} \<and>
                       S \<inter> closure X \<subseteq> ?g n \<and> closure X \<subseteq> ball x e"
       have "closure (S \<inter> ball x (e / 2)) \<subseteq> closure(ball x (e/2))"
         by (simp add: closure_mono)
       also have "...  \<subseteq> ball x e"
         using \<open>e > 0\<close> by auto
       finally have "closure (S \<inter> ball x (e / 2)) \<subseteq> ball x e" .
       moreover have"openin (top_of_set S) (S \<inter> ball x (e / 2))" "S \<inter> ball x (e / 2) \<noteq> {}"
         using \<open>0 < e\<close> \<open>x \<in> S\<close> by auto
       ultimately obtain Y where Y: "?\<Phi> 0 Y \<and> Y \<subseteq> S \<inter> ball x (e / 2)"
             using * [of "S \<inter> ball x (e/2)" 0] by metis
       show thesis
       proof (rule exE [OF dependent_nat_choice [of ?\<Phi> "\<lambda>n X Y. Y \<subseteq> X"]])
         show "\<exists>x. ?\<Phi> 0 x"
           using Y by auto
         show "\<exists>Y. ?\<Phi> (Suc n) Y \<and> Y \<subseteq> X" if "?\<Phi> n X" for X n
           using that by (blast intro: *)
       qed (use that in metis)
     qed
     have "(\<Inter>n. S \<inter> closure (TF n)) \<noteq> {}"
     proof (rule compact_nest)
       show "\<And>n. compact (S \<inter> closure (TF n))"
         by (metis closed_closure subball bounded_subset_ballI compact_eq_bounded_closed closed_Int_compact [OF \<open>closed S\<close>])
       show "\<And>n. S \<inter> closure (TF n) \<noteq> {}"
         by (metis Int_absorb1 opeF \<open>closed S\<close> closure_eq_empty closure_minimal ne openin_imp_subset)
       show "\<And>m n. m \<le> n \<Longrightarrow> S \<inter> closure (TF n) \<subseteq> S \<inter> closure (TF m)"
         by (meson closure_mono decr dual_order.refl inf_mono lift_Suc_antimono_le)
     qed
     moreover have "(\<Inter>n. S \<inter> closure (TF n)) \<subseteq> {y \<in> \<Inter>\<G>. dist y x < e}"
     proof (clarsimp, intro conjI)
       fix y
       assume "y \<in> S" and y: "\<forall>n. y \<in> closure (TF n)"
       then show "\<forall>T\<in>\<G>. y \<in> T"
         by (metis Int_iff from_nat_into_surj [OF \<open>countable \<G>\<close>] subsetD subg)
       show "dist y x < e"
         by (metis y dist_commute mem_ball subball subsetCE)
     qed
     ultimately show "\<exists>y \<in> \<Inter>\<G>. dist y x < e"
       by auto
   qed
 qed
 
 
 subsection \<open>Continuity\<close>
 
 subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Structural rules for uniform continuity\<close>
 
 lemma (in bounded_linear) uniformly_continuous_on[continuous_intros]:
   fixes g :: "_::metric_space \<Rightarrow> _"
   assumes "uniformly_continuous_on s g"
   shows "uniformly_continuous_on s (\<lambda>x. f (g x))"
   using assms unfolding uniformly_continuous_on_sequentially
   unfolding dist_norm tendsto_norm_zero_iff diff[symmetric]
   by (auto intro: tendsto_zero)
 
 lemma uniformly_continuous_on_dist[continuous_intros]:
   fixes f g :: "'a::metric_space \<Rightarrow> 'b::metric_space"
   assumes "uniformly_continuous_on s f"
     and "uniformly_continuous_on s g"
   shows "uniformly_continuous_on s (\<lambda>x. dist (f x) (g x))"
 proof -
   {
     fix a b c d :: 'b
     have "\<bar>dist a b - dist c d\<bar> \<le> dist a c + dist b d"
       using dist_triangle2 [of a b c] dist_triangle2 [of b c d]
       using dist_triangle3 [of c d a] dist_triangle [of a d b]
       by arith
   } note le = this
   {
     fix x y
     assume f: "(\<lambda>n. dist (f (x n)) (f (y n))) \<longlonglongrightarrow> 0"
     assume g: "(\<lambda>n. dist (g (x n)) (g (y n))) \<longlonglongrightarrow> 0"
     have "(\<lambda>n. \<bar>dist (f (x n)) (g (x n)) - dist (f (y n)) (g (y n))\<bar>) \<longlonglongrightarrow> 0"
       by (rule Lim_transform_bound [OF _ tendsto_add_zero [OF f g]],
         simp add: le)
   }
   then show ?thesis
     using assms unfolding uniformly_continuous_on_sequentially
     unfolding dist_real_def by simp
 qed
 
+lemma uniformly_continuous_on_cmul_right [continuous_intros]:
+  fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_algebra"
+  shows "uniformly_continuous_on s f \<Longrightarrow> uniformly_continuous_on s (\<lambda>x. f x * c)"
+  using bounded_linear.uniformly_continuous_on[OF bounded_linear_mult_left] .
+
+lemma uniformly_continuous_on_cmul_left[continuous_intros]:
+  fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_algebra"
+  assumes "uniformly_continuous_on s f"
+    shows "uniformly_continuous_on s (\<lambda>x. c * f x)"
+by (metis assms bounded_linear.uniformly_continuous_on bounded_linear_mult_right)
+
 lemma uniformly_continuous_on_norm[continuous_intros]:
   fixes f :: "'a :: metric_space \<Rightarrow> 'b :: real_normed_vector"
   assumes "uniformly_continuous_on s f"
   shows "uniformly_continuous_on s (\<lambda>x. norm (f x))"
   unfolding norm_conv_dist using assms
   by (intro uniformly_continuous_on_dist uniformly_continuous_on_const)
 
 lemma uniformly_continuous_on_cmul[continuous_intros]:
   fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
   assumes "uniformly_continuous_on s f"
   shows "uniformly_continuous_on s (\<lambda>x. c *\<^sub>R f(x))"
   using bounded_linear_scaleR_right assms
   by (rule bounded_linear.uniformly_continuous_on)
 
 lemma dist_minus:
   fixes x y :: "'a::real_normed_vector"
   shows "dist (- x) (- y) = dist x y"
   unfolding dist_norm minus_diff_minus norm_minus_cancel ..
 
 lemma uniformly_continuous_on_minus[continuous_intros]:
   fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
   shows "uniformly_continuous_on s f \<Longrightarrow> uniformly_continuous_on s (\<lambda>x. - f x)"
   unfolding uniformly_continuous_on_def dist_minus .
 
 lemma uniformly_continuous_on_add[continuous_intros]:
   fixes f g :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
   assumes "uniformly_continuous_on s f"
     and "uniformly_continuous_on s g"
   shows "uniformly_continuous_on s (\<lambda>x. f x + g x)"
   using assms
   unfolding uniformly_continuous_on_sequentially
   unfolding dist_norm tendsto_norm_zero_iff add_diff_add
   by (auto intro: tendsto_add_zero)
 
 lemma uniformly_continuous_on_diff[continuous_intros]:
   fixes f :: "'a::metric_space \<Rightarrow> 'b::real_normed_vector"
   assumes "uniformly_continuous_on s f"
     and "uniformly_continuous_on s g"
   shows "uniformly_continuous_on s (\<lambda>x. f x - g x)"
   using assms uniformly_continuous_on_add [of s f "- g"]
     by (simp add: fun_Compl_def uniformly_continuous_on_minus)
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Arithmetic Preserves Topological Properties\<close>
 
 lemma open_scaling[intro]:
   fixes s :: "'a::real_normed_vector set"
   assumes "c \<noteq> 0"
     and "open s"
   shows "open((\<lambda>x. c *\<^sub>R x) ` s)"
 proof -
   {
     fix x
     assume "x \<in> s"
     then obtain e where "e>0"
       and e:"\<forall>x'. dist x' x < e \<longrightarrow> x' \<in> s" using assms(2)[unfolded open_dist, THEN bspec[where x=x]]
       by auto
     have "e * \<bar>c\<bar> > 0"
       using assms(1)[unfolded zero_less_abs_iff[symmetric]] \<open>e>0\<close> by auto
     moreover
     {
       fix y
       assume "dist y (c *\<^sub>R x) < e * \<bar>c\<bar>"
       then have "norm ((1 / c) *\<^sub>R y - x) < e"
         unfolding dist_norm
         using norm_scaleR[of c "(1 / c) *\<^sub>R y - x", unfolded scaleR_right_diff_distrib, unfolded scaleR_scaleR] assms(1)
           assms(1)[unfolded zero_less_abs_iff[symmetric]] by (simp del:zero_less_abs_iff)
       then have "y \<in> (*\<^sub>R) c ` s"
         using rev_image_eqI[of "(1 / c) *\<^sub>R y" s y "(*\<^sub>R) c"]
         using e[THEN spec[where x="(1 / c) *\<^sub>R y"]]
         using assms(1)
         unfolding dist_norm scaleR_scaleR
         by auto
     }
     ultimately have "\<exists>e>0. \<forall>x'. dist x' (c *\<^sub>R x) < e \<longrightarrow> x' \<in> (*\<^sub>R) c ` s"
       apply (rule_tac x="e * \<bar>c\<bar>" in exI, auto)
       done
   }
   then show ?thesis unfolding open_dist by auto
 qed
 
 lemma minus_image_eq_vimage:
   fixes A :: "'a::ab_group_add set"
   shows "(\<lambda>x. - x) ` A = (\<lambda>x. - x) -` A"
   by (auto intro!: image_eqI [where f="\<lambda>x. - x"])
 
 lemma open_negations:
   fixes S :: "'a::real_normed_vector set"
   shows "open S \<Longrightarrow> open ((\<lambda>x. - x) ` S)"
   using open_scaling [of "- 1" S] by simp
 
 lemma open_translation:
   fixes S :: "'a::real_normed_vector set"
   assumes "open S"
   shows "open((\<lambda>x. a + x) ` S)"
 proof -
   {
     fix x
     have "continuous (at x) (\<lambda>x. x - a)"
       by (intro continuous_diff continuous_ident continuous_const)
   }
   moreover have "{x. x - a \<in> S} = (+) a ` S"
     by force
   ultimately show ?thesis
     by (metis assms continuous_open_vimage vimage_def)
 qed
 
 lemma open_translation_subtract:
   fixes S :: "'a::real_normed_vector set"
   assumes "open S"
   shows "open ((\<lambda>x. x - a) ` S)" 
   using assms open_translation [of S "- a"] by (simp cong: image_cong_simp)
 
 lemma open_neg_translation:
   fixes S :: "'a::real_normed_vector set"
   assumes "open S"
   shows "open((\<lambda>x. a - x) ` S)"
   using open_translation[OF open_negations[OF assms], of a]
   by (auto simp: image_image)
 
 lemma open_affinity:
   fixes S :: "'a::real_normed_vector set"
   assumes "open S"  "c \<noteq> 0"
   shows "open ((\<lambda>x. a + c *\<^sub>R x) ` S)"
 proof -
   have *: "(\<lambda>x. a + c *\<^sub>R x) = (\<lambda>x. a + x) \<circ> (\<lambda>x. c *\<^sub>R x)"
     unfolding o_def ..
   have "(+) a ` (*\<^sub>R) c ` S = ((+) a \<circ> (*\<^sub>R) c) ` S"
     by auto
   then show ?thesis
     using assms open_translation[of "(*\<^sub>R) c ` S" a]
     unfolding *
     by auto
 qed
 
 lemma interior_translation:
   "interior ((+) a ` S) = (+) a ` (interior S)" for S :: "'a::real_normed_vector set"
 proof (rule set_eqI, rule)
   fix x
   assume "x \<in> interior ((+) a ` S)"
   then obtain e where "e > 0" and e: "ball x e \<subseteq> (+) a ` S"
     unfolding mem_interior by auto
   then have "ball (x - a) e \<subseteq> S"
     unfolding subset_eq Ball_def mem_ball dist_norm
     by (auto simp: diff_diff_eq)
   then show "x \<in> (+) a ` interior S"
     unfolding image_iff
     apply (rule_tac x="x - a" in bexI)
     unfolding mem_interior
     using \<open>e > 0\<close>
     apply auto
     done
 next
   fix x
   assume "x \<in> (+) a ` interior S"
   then obtain y e where "e > 0" and e: "ball y e \<subseteq> S" and y: "x = a + y"
     unfolding image_iff Bex_def mem_interior by auto
   {
     fix z
     have *: "a + y - z = y + a - z" by auto
     assume "z \<in> ball x e"
     then have "z - a \<in> S"
       using e[unfolded subset_eq, THEN bspec[where x="z - a"]]
       unfolding mem_ball dist_norm y group_add_class.diff_diff_eq2 *
       by auto
     then have "z \<in> (+) a ` S"
       unfolding image_iff by (auto intro!: bexI[where x="z - a"])
   }
   then have "ball x e \<subseteq> (+) a ` S"
     unfolding subset_eq by auto
   then show "x \<in> interior ((+) a ` S)"
     unfolding mem_interior using \<open>e > 0\<close> by auto
 qed
 
 lemma interior_translation_subtract:
   "interior ((\<lambda>x. x - a) ` S) = (\<lambda>x. x - a) ` interior S" for S :: "'a::real_normed_vector set"
   using interior_translation [of "- a"] by (simp cong: image_cong_simp)
 
 
 lemma compact_scaling:
   fixes s :: "'a::real_normed_vector set"
   assumes "compact s"
   shows "compact ((\<lambda>x. c *\<^sub>R x) ` s)"
 proof -
   let ?f = "\<lambda>x. scaleR c x"
   have *: "bounded_linear ?f" by (rule bounded_linear_scaleR_right)
   show ?thesis
     using compact_continuous_image[of s ?f] continuous_at_imp_continuous_on[of s ?f]
     using linear_continuous_at[OF *] assms
     by auto
 qed
 
 lemma compact_negations:
   fixes s :: "'a::real_normed_vector set"
   assumes "compact s"
   shows "compact ((\<lambda>x. - x) ` s)"
   using compact_scaling [OF assms, of "- 1"] by auto
 
 lemma compact_sums:
   fixes s t :: "'a::real_normed_vector set"
   assumes "compact s"
     and "compact t"
   shows "compact {x + y | x y. x \<in> s \<and> y \<in> t}"
 proof -
   have *: "{x + y | x y. x \<in> s \<and> y \<in> t} = (\<lambda>z. fst z + snd z) ` (s \<times> t)"
     apply auto
     unfolding image_iff
     apply (rule_tac x="(xa, y)" in bexI)
     apply auto
     done
   have "continuous_on (s \<times> t) (\<lambda>z. fst z + snd z)"
     unfolding continuous_on by (rule ballI) (intro tendsto_intros)
   then show ?thesis
     unfolding * using compact_continuous_image compact_Times [OF assms] by auto
 qed
 
 lemma compact_differences:
   fixes s t :: "'a::real_normed_vector set"
   assumes "compact s"
     and "compact t"
   shows "compact {x - y | x y. x \<in> s \<and> y \<in> t}"
 proof-
   have "{x - y | x y. x\<in>s \<and> y \<in> t} =  {x + y | x y. x \<in> s \<and> y \<in> (uminus ` t)}"
     apply auto
     apply (rule_tac x= xa in exI, auto)
     done
   then show ?thesis
     using compact_sums[OF assms(1) compact_negations[OF assms(2)]] by auto
 qed
 
 lemma compact_translation:
   "compact ((+) a ` s)" if "compact s" for s :: "'a::real_normed_vector set"
 proof -
   have "{x + y |x y. x \<in> s \<and> y \<in> {a}} = (\<lambda>x. a + x) ` s"
     by auto
   then show ?thesis
     using compact_sums [OF that compact_sing [of a]] by auto
 qed
 
 lemma compact_translation_subtract:
   "compact ((\<lambda>x. x - a) ` s)" if "compact s" for s :: "'a::real_normed_vector set"
   using that compact_translation [of s "- a"] by (simp cong: image_cong_simp)
 
 lemma compact_affinity:
   fixes s :: "'a::real_normed_vector set"
   assumes "compact s"
   shows "compact ((\<lambda>x. a + c *\<^sub>R x) ` s)"
 proof -
   have "(+) a ` (*\<^sub>R) c ` s = (\<lambda>x. a + c *\<^sub>R x) ` s"
     by auto
   then show ?thesis
     using compact_translation[OF compact_scaling[OF assms], of a c] by auto
 qed
 
 lemma closed_scaling:
   fixes S :: "'a::real_normed_vector set"
   assumes "closed S"
   shows "closed ((\<lambda>x. c *\<^sub>R x) ` S)"
 proof (cases "c = 0")
   case True then show ?thesis
     by (auto simp: image_constant_conv)
 next
   case False
   from assms have "closed ((\<lambda>x. inverse c *\<^sub>R x) -` S)"
     by (simp add: continuous_closed_vimage)
   also have "(\<lambda>x. inverse c *\<^sub>R x) -` S = (\<lambda>x. c *\<^sub>R x) ` S"
     using \<open>c \<noteq> 0\<close> by (auto elim: image_eqI [rotated])
   finally show ?thesis .
 qed
 
 lemma closed_negations:
   fixes S :: "'a::real_normed_vector set"
   assumes "closed S"
   shows "closed ((\<lambda>x. -x) ` S)"
   using closed_scaling[OF assms, of "- 1"] by simp
 
 lemma compact_closed_sums:
   fixes S :: "'a::real_normed_vector set"
   assumes "compact S" and "closed T"
   shows "closed (\<Union>x\<in> S. \<Union>y \<in> T. {x + y})"
 proof -
   let ?S = "{x + y |x y. x \<in> S \<and> y \<in> T}"
   {
     fix x l
     assume as: "\<forall>n. x n \<in> ?S"  "(x \<longlongrightarrow> l) sequentially"
     from as(1) obtain f where f: "\<forall>n. x n = fst (f n) + snd (f n)"  "\<forall>n. fst (f n) \<in> S"  "\<forall>n. snd (f n) \<in> T"
       using choice[of "\<lambda>n y. x n = (fst y) + (snd y) \<and> fst y \<in> S \<and> snd y \<in> T"] by auto
     obtain l' r where "l'\<in>S" and r: "strict_mono r" and lr: "(((\<lambda>n. fst (f n)) \<circ> r) \<longlongrightarrow> l') sequentially"
       using assms(1)[unfolded compact_def, THEN spec[where x="\<lambda> n. fst (f n)"]] using f(2) by auto
     have "((\<lambda>n. snd (f (r n))) \<longlongrightarrow> l - l') sequentially"
       using tendsto_diff[OF LIMSEQ_subseq_LIMSEQ[OF as(2) r] lr] and f(1)
       unfolding o_def
       by auto
     then have "l - l' \<in> T"
       using assms(2)[unfolded closed_sequential_limits,
         THEN spec[where x="\<lambda> n. snd (f (r n))"],
         THEN spec[where x="l - l'"]]
       using f(3)
       by auto
     then have "l \<in> ?S"
       using \<open>l' \<in> S\<close>
       apply auto
       apply (rule_tac x=l' in exI)
       apply (rule_tac x="l - l'" in exI, auto)
       done
   }
   moreover have "?S = (\<Union>x\<in> S. \<Union>y \<in> T. {x + y})"
     by force
   ultimately show ?thesis
     unfolding closed_sequential_limits
     by (metis (no_types, lifting))
 qed
 
 lemma closed_compact_sums:
   fixes S T :: "'a::real_normed_vector set"
   assumes "closed S" "compact T"
   shows "closed (\<Union>x\<in> S. \<Union>y \<in> T. {x + y})"
 proof -
   have "(\<Union>x\<in> T. \<Union>y \<in> S. {x + y}) = (\<Union>x\<in> S. \<Union>y \<in> T. {x + y})"
     by auto
   then show ?thesis
     using compact_closed_sums[OF assms(2,1)] by simp
 qed
 
 lemma compact_closed_differences:
   fixes S T :: "'a::real_normed_vector set"
   assumes "compact S" "closed T"
   shows "closed (\<Union>x\<in> S. \<Union>y \<in> T. {x - y})"
 proof -
   have "(\<Union>x\<in> S. \<Union>y \<in> uminus ` T. {x + y}) = (\<Union>x\<in> S. \<Union>y \<in> T. {x - y})"
     by force
   then show ?thesis
     using compact_closed_sums[OF assms(1) closed_negations[OF assms(2)]] by auto
 qed
 
 lemma closed_compact_differences:
   fixes S T :: "'a::real_normed_vector set"
   assumes "closed S" "compact T"
   shows "closed (\<Union>x\<in> S. \<Union>y \<in> T. {x - y})"
 proof -
   have "(\<Union>x\<in> S. \<Union>y \<in> uminus ` T. {x + y}) = {x - y |x y. x \<in> S \<and> y \<in> T}"
     by auto
  then show ?thesis
   using closed_compact_sums[OF assms(1) compact_negations[OF assms(2)]] by simp
 qed
 
 lemma closed_translation:
   "closed ((+) a ` S)" if "closed S" for a :: "'a::real_normed_vector"
 proof -
   have "(\<Union>x\<in> {a}. \<Union>y \<in> S. {x + y}) = ((+) a ` S)" by auto
   then show ?thesis
     using compact_closed_sums [OF compact_sing [of a] that] by auto
 qed
 
 lemma closed_translation_subtract:
   "closed ((\<lambda>x. x - a) ` S)" if "closed S" for a :: "'a::real_normed_vector"
   using that closed_translation [of S "- a"] by (simp cong: image_cong_simp)
 
 lemma closure_translation:
   "closure ((+) a ` s) = (+) a ` closure s" for a :: "'a::real_normed_vector"
 proof -
   have *: "(+) a ` (- s) = - (+) a ` s"
     by (auto intro!: image_eqI [where x = "x - a" for x])
   show ?thesis
     using interior_translation [of a "- s", symmetric]
     by (simp add: closure_interior translation_Compl *)
 qed
 
 lemma closure_translation_subtract:
   "closure ((\<lambda>x. x - a) ` s) = (\<lambda>x. x - a) ` closure s" for a :: "'a::real_normed_vector"
   using closure_translation [of "- a" s] by (simp cong: image_cong_simp)
 
 lemma frontier_translation:
   "frontier ((+) a ` s) = (+) a ` frontier s" for a :: "'a::real_normed_vector"
   by (auto simp add: frontier_def translation_diff interior_translation closure_translation)
 
 lemma frontier_translation_subtract:
   "frontier ((+) a ` s) = (+) a ` frontier s" for a :: "'a::real_normed_vector"
   by (auto simp add: frontier_def translation_diff interior_translation closure_translation)
 
 lemma sphere_translation:
   "sphere (a + c) r = (+) a ` sphere c r" for a :: "'n::real_normed_vector"
   by (auto simp: dist_norm algebra_simps intro!: image_eqI [where x = "x - a" for x])
 
 lemma sphere_translation_subtract:
   "sphere (c - a) r = (\<lambda>x. x - a) ` sphere c r" for a :: "'n::real_normed_vector"
   using sphere_translation [of "- a" c] by (simp cong: image_cong_simp)
 
 lemma cball_translation:
   "cball (a + c) r = (+) a ` cball c r" for a :: "'n::real_normed_vector"
   by (auto simp: dist_norm algebra_simps intro!: image_eqI [where x = "x - a" for x])
 
 lemma cball_translation_subtract:
   "cball (c - a) r = (\<lambda>x. x - a) ` cball c r" for a :: "'n::real_normed_vector"
   using cball_translation [of "- a" c] by (simp cong: image_cong_simp)
 
 lemma ball_translation:
   "ball (a + c) r = (+) a ` ball c r" for a :: "'n::real_normed_vector"
   by (auto simp: dist_norm algebra_simps intro!: image_eqI [where x = "x - a" for x])
 
 lemma ball_translation_subtract:
   "ball (c - a) r = (\<lambda>x. x - a) ` ball c r" for a :: "'n::real_normed_vector"
   using ball_translation [of "- a" c] by (simp cong: image_cong_simp)
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Homeomorphisms\<close>
 
 lemma homeomorphic_scaling:
   fixes s :: "'a::real_normed_vector set"
   assumes "c \<noteq> 0"
   shows "s homeomorphic ((\<lambda>x. c *\<^sub>R x) ` s)"
   unfolding homeomorphic_minimal
   apply (rule_tac x="\<lambda>x. c *\<^sub>R x" in exI)
   apply (rule_tac x="\<lambda>x. (1 / c) *\<^sub>R x" in exI)
   using assms
   apply (auto simp: continuous_intros)
   done
 
 lemma homeomorphic_translation:
   fixes s :: "'a::real_normed_vector set"
   shows "s homeomorphic ((\<lambda>x. a + x) ` s)"
   unfolding homeomorphic_minimal
   apply (rule_tac x="\<lambda>x. a + x" in exI)
   apply (rule_tac x="\<lambda>x. -a + x" in exI)
   using continuous_on_add [OF continuous_on_const continuous_on_id, of s a]
     continuous_on_add [OF continuous_on_const continuous_on_id, of "plus a ` s" "- a"]
   apply auto
   done
 
 lemma homeomorphic_affinity:
   fixes s :: "'a::real_normed_vector set"
   assumes "c \<noteq> 0"
   shows "s homeomorphic ((\<lambda>x. a + c *\<^sub>R x) ` s)"
 proof -
   have *: "(+) a ` (*\<^sub>R) c ` s = (\<lambda>x. a + c *\<^sub>R x) ` s" by auto
   show ?thesis
     using homeomorphic_trans
     using homeomorphic_scaling[OF assms, of s]
     using homeomorphic_translation[of "(\<lambda>x. c *\<^sub>R x) ` s" a]
     unfolding *
     by auto
 qed
 
 lemma homeomorphic_balls:
   fixes a b ::"'a::real_normed_vector"
   assumes "0 < d"  "0 < e"
   shows "(ball a d) homeomorphic  (ball b e)" (is ?th)
     and "(cball a d) homeomorphic (cball b e)" (is ?cth)
 proof -
   show ?th unfolding homeomorphic_minimal
     apply(rule_tac x="\<lambda>x. b + (e/d) *\<^sub>R (x - a)" in exI)
     apply(rule_tac x="\<lambda>x. a + (d/e) *\<^sub>R (x - b)" in exI)
     using assms
     apply (auto intro!: continuous_intros
       simp: dist_commute dist_norm pos_divide_less_eq mult_strict_left_mono)
     done
   show ?cth unfolding homeomorphic_minimal
     apply(rule_tac x="\<lambda>x. b + (e/d) *\<^sub>R (x - a)" in exI)
     apply(rule_tac x="\<lambda>x. a + (d/e) *\<^sub>R (x - b)" in exI)
     using assms
     apply (auto intro!: continuous_intros
       simp: dist_commute dist_norm pos_divide_le_eq mult_strict_left_mono)
     done
 qed
 
 lemma homeomorphic_spheres:
   fixes a b ::"'a::real_normed_vector"
   assumes "0 < d"  "0 < e"
   shows "(sphere a d) homeomorphic (sphere b e)"
 unfolding homeomorphic_minimal
     apply(rule_tac x="\<lambda>x. b + (e/d) *\<^sub>R (x - a)" in exI)
     apply(rule_tac x="\<lambda>x. a + (d/e) *\<^sub>R (x - b)" in exI)
     using assms
     apply (auto intro!: continuous_intros
       simp: dist_commute dist_norm pos_divide_less_eq mult_strict_left_mono)
     done
 
 lemma homeomorphic_ball01_UNIV:
   "ball (0::'a::real_normed_vector) 1 homeomorphic (UNIV:: 'a set)"
   (is "?B homeomorphic ?U")
 proof
   have "x \<in> (\<lambda>z. z /\<^sub>R (1 - norm z)) ` ball 0 1" for x::'a
     apply (rule_tac x="x /\<^sub>R (1 + norm x)" in image_eqI)
      apply (auto simp: field_split_simps)
     using norm_ge_zero [of x] apply linarith+
     done
   then show "(\<lambda>z::'a. z /\<^sub>R (1 - norm z)) ` ?B = ?U"
     by blast
   have "x \<in> range (\<lambda>z. (1 / (1 + norm z)) *\<^sub>R z)" if "norm x < 1" for x::'a
     apply (rule_tac x="x /\<^sub>R (1 - norm x)" in image_eqI)
     using that apply (auto simp: field_split_simps)
     done
   then show "(\<lambda>z::'a. z /\<^sub>R (1 + norm z)) ` ?U = ?B"
     by (force simp: field_split_simps dest: add_less_zeroD)
   show "continuous_on (ball 0 1) (\<lambda>z. z /\<^sub>R (1 - norm z))"
     by (rule continuous_intros | force)+
   show "continuous_on UNIV (\<lambda>z. z /\<^sub>R (1 + norm z))"
     apply (intro continuous_intros)
     apply (metis le_add_same_cancel1 norm_ge_zero not_le zero_less_one)
     done
   show "\<And>x. x \<in> ball 0 1 \<Longrightarrow>
          x /\<^sub>R (1 - norm x) /\<^sub>R (1 + norm (x /\<^sub>R (1 - norm x))) = x"
     by (auto simp: field_split_simps)
   show "\<And>y. y /\<^sub>R (1 + norm y) /\<^sub>R (1 - norm (y /\<^sub>R (1 + norm y))) = y"
     apply (auto simp: field_split_simps)
     apply (metis le_add_same_cancel1 norm_ge_zero not_le zero_less_one)
     done
 qed
 
 proposition homeomorphic_ball_UNIV:
   fixes a ::"'a::real_normed_vector"
   assumes "0 < r" shows "ball a r homeomorphic (UNIV:: 'a set)"
   using assms homeomorphic_ball01_UNIV homeomorphic_balls(1) homeomorphic_trans zero_less_one by blast
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Discrete\<close>
 
 lemma finite_implies_discrete:
   fixes S :: "'a::topological_space set"
   assumes "finite (f ` S)"
   shows "(\<forall>x \<in> S. \<exists>e>0. \<forall>y. y \<in> S \<and> f y \<noteq> f x \<longrightarrow> e \<le> norm (f y - f x))"
 proof -
   have "\<exists>e>0. \<forall>y. y \<in> S \<and> f y \<noteq> f x \<longrightarrow> e \<le> norm (f y - f x)" if "x \<in> S" for x
   proof (cases "f ` S - {f x} = {}")
     case True
     with zero_less_numeral show ?thesis
       by (fastforce simp add: Set.image_subset_iff cong: conj_cong)
   next
     case False
     then obtain z where z: "z \<in> S" "f z \<noteq> f x"
       by blast
     have finn: "finite {norm (z - f x) |z. z \<in> f ` S - {f x}}"
       using assms by simp
     then have *: "0 < Inf{norm(z - f x) | z. z \<in> f ` S - {f x}}"
       apply (rule finite_imp_less_Inf)
       using z apply force+
       done
     show ?thesis
       by (force intro!: * cInf_le_finite [OF finn])
   qed
   with assms show ?thesis
     by blast
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Completeness of "Isometry" (up to constant bounds)\<close>
 
 lemma cauchy_isometric:\<comment> \<open>TODO: rename lemma to \<open>Cauchy_isometric\<close>\<close>
   assumes e: "e > 0"
     and s: "subspace s"
     and f: "bounded_linear f"
     and normf: "\<forall>x\<in>s. norm (f x) \<ge> e * norm x"
     and xs: "\<forall>n. x n \<in> s"
     and cf: "Cauchy (f \<circ> x)"
   shows "Cauchy x"
 proof -
   interpret f: bounded_linear f by fact
   have "\<exists>N. \<forall>n\<ge>N. norm (x n - x N) < d" if "d > 0" for d :: real
   proof -
     from that obtain N where N: "\<forall>n\<ge>N. norm (f (x n) - f (x N)) < e * d"
       using cf[unfolded Cauchy_def o_def dist_norm, THEN spec[where x="e*d"]] e
       by auto
     have "norm (x n - x N) < d" if "n \<ge> N" for n
     proof -
       have "e * norm (x n - x N) \<le> norm (f (x n - x N))"
         using subspace_diff[OF s, of "x n" "x N"]
         using xs[THEN spec[where x=N]] and xs[THEN spec[where x=n]]
         using normf[THEN bspec[where x="x n - x N"]]
         by auto
       also have "norm (f (x n - x N)) < e * d"
         using \<open>N \<le> n\<close> N unfolding f.diff[symmetric] by auto
       finally show ?thesis
         using \<open>e>0\<close> by simp
     qed
     then show ?thesis by auto
   qed
   then show ?thesis
     by (simp add: Cauchy_altdef2 dist_norm)
 qed
 
 lemma complete_isometric_image:
   assumes "0 < e"
     and s: "subspace s"
     and f: "bounded_linear f"
     and normf: "\<forall>x\<in>s. norm(f x) \<ge> e * norm(x)"
     and cs: "complete s"
   shows "complete (f ` s)"
 proof -
   have "\<exists>l\<in>f ` s. (g \<longlongrightarrow> l) sequentially"
     if as:"\<forall>n::nat. g n \<in> f ` s" and cfg:"Cauchy g" for g
   proof -
     from that obtain x where "\<forall>n. x n \<in> s \<and> g n = f (x n)"
       using choice[of "\<lambda> n xa. xa \<in> s \<and> g n = f xa"] by auto
     then have x: "\<forall>n. x n \<in> s" "\<forall>n. g n = f (x n)" by auto
     then have "f \<circ> x = g" by (simp add: fun_eq_iff)
     then obtain l where "l\<in>s" and l:"(x \<longlongrightarrow> l) sequentially"
       using cs[unfolded complete_def, THEN spec[where x=x]]
       using cauchy_isometric[OF \<open>0 < e\<close> s f normf] and cfg and x(1)
       by auto
     then show ?thesis
       using linear_continuous_at[OF f, unfolded continuous_at_sequentially, THEN spec[where x=x], of l]
       by (auto simp: \<open>f \<circ> x = g\<close>)
   qed
   then show ?thesis
     unfolding complete_def by auto
 qed
 
 subsection \<open>Connected Normed Spaces\<close>
 
 lemma compact_components:
   fixes s :: "'a::heine_borel set"
   shows "\<lbrakk>compact s; c \<in> components s\<rbrakk> \<Longrightarrow> compact c"
 by (meson bounded_subset closed_components in_components_subset compact_eq_bounded_closed)
 
 lemma discrete_subset_disconnected:
   fixes S :: "'a::topological_space set"
   fixes t :: "'b::real_normed_vector set"
   assumes conf: "continuous_on S f"
       and no: "\<And>x. x \<in> S \<Longrightarrow> \<exists>e>0. \<forall>y. y \<in> S \<and> f y \<noteq> f x \<longrightarrow> e \<le> norm (f y - f x)"
    shows "f ` S \<subseteq> {y. connected_component_set (f ` S) y = {y}}"
 proof -
   { fix x assume x: "x \<in> S"
     then obtain e where "e>0" and ele: "\<And>y. \<lbrakk>y \<in> S; f y \<noteq> f x\<rbrakk> \<Longrightarrow> e \<le> norm (f y - f x)"
       using conf no [OF x] by auto
     then have e2: "0 \<le> e / 2"
       by simp
     have "f y = f x" if "y \<in> S" and ccs: "f y \<in> connected_component_set (f ` S) (f x)" for y
       apply (rule ccontr)
       using connected_closed [of "connected_component_set (f ` S) (f x)"] \<open>e>0\<close>
       apply (simp add: del: ex_simps)
       apply (drule spec [where x="cball (f x) (e / 2)"])
       apply (drule spec [where x="- ball(f x) e"])
       apply (auto simp: dist_norm open_closed [symmetric] simp del: le_divide_eq_numeral1 dest!: connected_component_in)
         apply (metis diff_self e2 ele norm_minus_commute norm_zero not_less)
        using centre_in_cball connected_component_refl_eq e2 x apply blast
       using ccs
       apply (force simp: cball_def dist_norm norm_minus_commute dest: ele [OF \<open>y \<in> S\<close>])
       done
     moreover have "connected_component_set (f ` S) (f x) \<subseteq> f ` S"
       by (auto simp: connected_component_in)
     ultimately have "connected_component_set (f ` S) (f x) = {f x}"
       by (auto simp: x)
   }
   with assms show ?thesis
     by blast
 qed
 
 lemma continuous_disconnected_range_constant_eq:
       "(connected S \<longleftrightarrow>
            (\<forall>f::'a::topological_space \<Rightarrow> 'b::real_normed_algebra_1.
             \<forall>t. continuous_on S f \<and> f ` S \<subseteq> t \<and> (\<forall>y \<in> t. connected_component_set t y = {y})
             \<longrightarrow> f constant_on S))" (is ?thesis1)
   and continuous_discrete_range_constant_eq:
       "(connected S \<longleftrightarrow>
          (\<forall>f::'a::topological_space \<Rightarrow> 'b::real_normed_algebra_1.
           continuous_on S f \<and>
           (\<forall>x \<in> S. \<exists>e. 0 < e \<and> (\<forall>y. y \<in> S \<and> (f y \<noteq> f x) \<longrightarrow> e \<le> norm(f y - f x)))
           \<longrightarrow> f constant_on S))" (is ?thesis2)
   and continuous_finite_range_constant_eq:
       "(connected S \<longleftrightarrow>
          (\<forall>f::'a::topological_space \<Rightarrow> 'b::real_normed_algebra_1.
           continuous_on S f \<and> finite (f ` S)
           \<longrightarrow> f constant_on S))" (is ?thesis3)
 proof -
   have *: "\<And>s t u v. \<lbrakk>s \<Longrightarrow> t; t \<Longrightarrow> u; u \<Longrightarrow> v; v \<Longrightarrow> s\<rbrakk>
     \<Longrightarrow> (s \<longleftrightarrow> t) \<and> (s \<longleftrightarrow> u) \<and> (s \<longleftrightarrow> v)"
     by blast
   have "?thesis1 \<and> ?thesis2 \<and> ?thesis3"
     apply (rule *)
     using continuous_disconnected_range_constant apply metis
     apply clarify
     apply (frule discrete_subset_disconnected; blast)
     apply (blast dest: finite_implies_discrete)
     apply (blast intro!: finite_range_constant_imp_connected)
     done
   then show ?thesis1 ?thesis2 ?thesis3
     by blast+
 qed
 
 lemma continuous_discrete_range_constant:
   fixes f :: "'a::topological_space \<Rightarrow> 'b::real_normed_algebra_1"
   assumes S: "connected S"
       and "continuous_on S f"
       and "\<And>x. x \<in> S \<Longrightarrow> \<exists>e>0. \<forall>y. y \<in> S \<and> f y \<noteq> f x \<longrightarrow> e \<le> norm (f y - f x)"
     shows "f constant_on S"
   using continuous_discrete_range_constant_eq [THEN iffD1, OF S] assms by blast
 
 lemma continuous_finite_range_constant:
   fixes f :: "'a::topological_space \<Rightarrow> 'b::real_normed_algebra_1"
   assumes "connected S"
       and "continuous_on S f"
       and "finite (f ` S)"
     shows "f constant_on S"
   using assms continuous_finite_range_constant_eq  by blast
 
 end
diff --git a/src/HOL/Limits.thy b/src/HOL/Limits.thy
--- a/src/HOL/Limits.thy
+++ b/src/HOL/Limits.thy
@@ -1,2942 +1,3033 @@
 (*  Title:      HOL/Limits.thy
     Author:     Brian Huffman
     Author:     Jacques D. Fleuriot, University of Cambridge
     Author:     Lawrence C Paulson
     Author:     Jeremy Avigad
 *)
 
 section \<open>Limits on Real Vector Spaces\<close>
 
 theory Limits
   imports Real_Vector_Spaces
 begin
 
 subsection \<open>Filter going to infinity norm\<close>
 
 definition at_infinity :: "'a::real_normed_vector filter"
   where "at_infinity = (INF r. principal {x. r \<le> norm x})"
 
 lemma eventually_at_infinity: "eventually P at_infinity \<longleftrightarrow> (\<exists>b. \<forall>x. b \<le> norm x \<longrightarrow> P x)"
   unfolding at_infinity_def
   by (subst eventually_INF_base)
      (auto simp: subset_eq eventually_principal intro!: exI[of _ "max a b" for a b])
 
 corollary eventually_at_infinity_pos:
   "eventually p at_infinity \<longleftrightarrow> (\<exists>b. 0 < b \<and> (\<forall>x. norm x \<ge> b \<longrightarrow> p x))"
   unfolding eventually_at_infinity
   by (meson le_less_trans norm_ge_zero not_le zero_less_one)
 
 lemma at_infinity_eq_at_top_bot: "(at_infinity :: real filter) = sup at_top at_bot"
 proof -
   have 1: "\<lbrakk>\<forall>n\<ge>u. A n; \<forall>n\<le>v. A n\<rbrakk>
        \<Longrightarrow> \<exists>b. \<forall>x. b \<le> \<bar>x\<bar> \<longrightarrow> A x" for A and u v::real
     by (rule_tac x="max (- v) u" in exI) (auto simp: abs_real_def)
   have 2: "\<forall>x. u \<le> \<bar>x\<bar> \<longrightarrow> A x \<Longrightarrow> \<exists>N. \<forall>n\<ge>N. A n" for A and u::real
     by (meson abs_less_iff le_cases less_le_not_le)
   have 3: "\<forall>x. u \<le> \<bar>x\<bar> \<longrightarrow> A x \<Longrightarrow> \<exists>N. \<forall>n\<le>N. A n" for A and u::real
     by (metis (full_types) abs_ge_self abs_minus_cancel le_minus_iff order_trans)
   show ?thesis
     by (auto simp: filter_eq_iff eventually_sup eventually_at_infinity
       eventually_at_top_linorder eventually_at_bot_linorder intro: 1 2 3)
 qed
 
 lemma at_top_le_at_infinity: "at_top \<le> (at_infinity :: real filter)"
   unfolding at_infinity_eq_at_top_bot by simp
 
 lemma at_bot_le_at_infinity: "at_bot \<le> (at_infinity :: real filter)"
   unfolding at_infinity_eq_at_top_bot by simp
 
 lemma filterlim_at_top_imp_at_infinity: "filterlim f at_top F \<Longrightarrow> filterlim f at_infinity F"
   for f :: "_ \<Rightarrow> real"
   by (rule filterlim_mono[OF _ at_top_le_at_infinity order_refl])
 
 lemma filterlim_real_at_infinity_sequentially: "filterlim real at_infinity sequentially"
   by (simp add: filterlim_at_top_imp_at_infinity filterlim_real_sequentially)
 
 lemma lim_infinity_imp_sequentially: "(f \<longlongrightarrow> l) at_infinity \<Longrightarrow> ((\<lambda>n. f(n)) \<longlongrightarrow> l) sequentially"
   by (simp add: filterlim_at_top_imp_at_infinity filterlim_compose filterlim_real_sequentially)
 
 
 subsubsection \<open>Boundedness\<close>
 
 definition Bfun :: "('a \<Rightarrow> 'b::metric_space) \<Rightarrow> 'a filter \<Rightarrow> bool"
   where Bfun_metric_def: "Bfun f F = (\<exists>y. \<exists>K>0. eventually (\<lambda>x. dist (f x) y \<le> K) F)"
 
 abbreviation Bseq :: "(nat \<Rightarrow> 'a::metric_space) \<Rightarrow> bool"
   where "Bseq X \<equiv> Bfun X sequentially"
 
 lemma Bseq_conv_Bfun: "Bseq X \<longleftrightarrow> Bfun X sequentially" ..
 
 lemma Bseq_ignore_initial_segment: "Bseq X \<Longrightarrow> Bseq (\<lambda>n. X (n + k))"
   unfolding Bfun_metric_def by (subst eventually_sequentially_seg)
 
 lemma Bseq_offset: "Bseq (\<lambda>n. X (n + k)) \<Longrightarrow> Bseq X"
   unfolding Bfun_metric_def by (subst (asm) eventually_sequentially_seg)
 
 lemma Bfun_def: "Bfun f F \<longleftrightarrow> (\<exists>K>0. eventually (\<lambda>x. norm (f x) \<le> K) F)"
   unfolding Bfun_metric_def norm_conv_dist
 proof safe
   fix y K
   assume K: "0 < K" and *: "eventually (\<lambda>x. dist (f x) y \<le> K) F"
   moreover have "eventually (\<lambda>x. dist (f x) 0 \<le> dist (f x) y + dist 0 y) F"
     by (intro always_eventually) (metis dist_commute dist_triangle)
   with * have "eventually (\<lambda>x. dist (f x) 0 \<le> K + dist 0 y) F"
     by eventually_elim auto
   with \<open>0 < K\<close> show "\<exists>K>0. eventually (\<lambda>x. dist (f x) 0 \<le> K) F"
     by (intro exI[of _ "K + dist 0 y"] add_pos_nonneg conjI zero_le_dist) auto
 qed (force simp del: norm_conv_dist [symmetric])
 
 lemma BfunI:
   assumes K: "eventually (\<lambda>x. norm (f x) \<le> K) F"
   shows "Bfun f F"
   unfolding Bfun_def
 proof (intro exI conjI allI)
   show "0 < max K 1" by simp
   show "eventually (\<lambda>x. norm (f x) \<le> max K 1) F"
     using K by (rule eventually_mono) simp
 qed
 
 lemma BfunE:
   assumes "Bfun f F"
   obtains B where "0 < B" and "eventually (\<lambda>x. norm (f x) \<le> B) F"
   using assms unfolding Bfun_def by blast
 
 lemma Cauchy_Bseq:
   assumes "Cauchy X" shows "Bseq X"
 proof -
   have "\<exists>y K. 0 < K \<and> (\<exists>N. \<forall>n\<ge>N. dist (X n) y \<le> K)"
     if "\<And>m n. \<lbrakk>m \<ge> M; n \<ge> M\<rbrakk> \<Longrightarrow> dist (X m) (X n) < 1" for M
     by (meson order.order_iff_strict that zero_less_one)
   with assms show ?thesis
     by (force simp: Cauchy_def Bfun_metric_def eventually_sequentially)
 qed
 
 subsubsection \<open>Bounded Sequences\<close>
 
 lemma BseqI': "(\<And>n. norm (X n) \<le> K) \<Longrightarrow> Bseq X"
   by (intro BfunI) (auto simp: eventually_sequentially)
 
 lemma BseqI2': "\<forall>n\<ge>N. norm (X n) \<le> K \<Longrightarrow> Bseq X"
   by (intro BfunI) (auto simp: eventually_sequentially)
 
 lemma Bseq_def: "Bseq X \<longleftrightarrow> (\<exists>K>0. \<forall>n. norm (X n) \<le> K)"
   unfolding Bfun_def eventually_sequentially
 proof safe
   fix N K
   assume "0 < K" "\<forall>n\<ge>N. norm (X n) \<le> K"
   then show "\<exists>K>0. \<forall>n. norm (X n) \<le> K"
     by (intro exI[of _ "max (Max (norm ` X ` {..N})) K"] max.strict_coboundedI2)
        (auto intro!: imageI not_less[where 'a=nat, THEN iffD1] Max_ge simp: le_max_iff_disj)
 qed auto
 
 lemma BseqE: "Bseq X \<Longrightarrow> (\<And>K. 0 < K \<Longrightarrow> \<forall>n. norm (X n) \<le> K \<Longrightarrow> Q) \<Longrightarrow> Q"
   unfolding Bseq_def by auto
 
 lemma BseqD: "Bseq X \<Longrightarrow> \<exists>K. 0 < K \<and> (\<forall>n. norm (X n) \<le> K)"
   by (simp add: Bseq_def)
 
 lemma BseqI: "0 < K \<Longrightarrow> \<forall>n. norm (X n) \<le> K \<Longrightarrow> Bseq X"
   by (auto simp: Bseq_def)
 
 lemma Bseq_bdd_above: "Bseq X \<Longrightarrow> bdd_above (range X)"
   for X :: "nat \<Rightarrow> real"
 proof (elim BseqE, intro bdd_aboveI2)
   fix K n
   assume "0 < K" "\<forall>n. norm (X n) \<le> K"
   then show "X n \<le> K"
     by (auto elim!: allE[of _ n])
 qed
 
 lemma Bseq_bdd_above': "Bseq X \<Longrightarrow> bdd_above (range (\<lambda>n. norm (X n)))"
   for X :: "nat \<Rightarrow> 'a :: real_normed_vector"
 proof (elim BseqE, intro bdd_aboveI2)
   fix K n
   assume "0 < K" "\<forall>n. norm (X n) \<le> K"
   then show "norm (X n) \<le> K"
     by (auto elim!: allE[of _ n])
 qed
 
 lemma Bseq_bdd_below: "Bseq X \<Longrightarrow> bdd_below (range X)"
   for X :: "nat \<Rightarrow> real"
 proof (elim BseqE, intro bdd_belowI2)
   fix K n
   assume "0 < K" "\<forall>n. norm (X n) \<le> K"
   then show "- K \<le> X n"
     by (auto elim!: allE[of _ n])
 qed
 
 lemma Bseq_eventually_mono:
   assumes "eventually (\<lambda>n. norm (f n) \<le> norm (g n)) sequentially" "Bseq g"
   shows "Bseq f"
 proof -
   from assms(2) obtain K where "0 < K" and "eventually (\<lambda>n. norm (g n) \<le> K) sequentially"
     unfolding Bfun_def by fast
   with assms(1) have "eventually (\<lambda>n. norm (f n) \<le> K) sequentially"
     by (fast elim: eventually_elim2 order_trans)
   with \<open>0 < K\<close> show "Bseq f"
     unfolding Bfun_def by fast
 qed
 
 lemma lemma_NBseq_def: "(\<exists>K > 0. \<forall>n. norm (X n) \<le> K) \<longleftrightarrow> (\<exists>N. \<forall>n. norm (X n) \<le> real(Suc N))"
 proof safe
   fix K :: real
   from reals_Archimedean2 obtain n :: nat where "K < real n" ..
   then have "K \<le> real (Suc n)" by auto
   moreover assume "\<forall>m. norm (X m) \<le> K"
   ultimately have "\<forall>m. norm (X m) \<le> real (Suc n)"
     by (blast intro: order_trans)
   then show "\<exists>N. \<forall>n. norm (X n) \<le> real (Suc N)" ..
 next
   show "\<And>N. \<forall>n. norm (X n) \<le> real (Suc N) \<Longrightarrow> \<exists>K>0. \<forall>n. norm (X n) \<le> K"
     using of_nat_0_less_iff by blast
 qed
 
 text \<open>Alternative definition for \<open>Bseq\<close>.\<close>
 lemma Bseq_iff: "Bseq X \<longleftrightarrow> (\<exists>N. \<forall>n. norm (X n) \<le> real(Suc N))"
   by (simp add: Bseq_def) (simp add: lemma_NBseq_def)
 
 lemma lemma_NBseq_def2: "(\<exists>K > 0. \<forall>n. norm (X n) \<le> K) = (\<exists>N. \<forall>n. norm (X n) < real(Suc N))"
 proof -
   have *: "\<And>N. \<forall>n. norm (X n) \<le> 1 + real N \<Longrightarrow>
          \<exists>N. \<forall>n. norm (X n) < 1 + real N"
     by (metis add.commute le_less_trans less_add_one of_nat_Suc)
   then show ?thesis
     unfolding lemma_NBseq_def
     by (metis less_le_not_le not_less_iff_gr_or_eq of_nat_Suc)
 qed
 
 text \<open>Yet another definition for Bseq.\<close>
 lemma Bseq_iff1a: "Bseq X \<longleftrightarrow> (\<exists>N. \<forall>n. norm (X n) < real (Suc N))"
   by (simp add: Bseq_def lemma_NBseq_def2)
 
 subsubsection \<open>A Few More Equivalence Theorems for Boundedness\<close>
 
 text \<open>Alternative formulation for boundedness.\<close>
 lemma Bseq_iff2: "Bseq X \<longleftrightarrow> (\<exists>k > 0. \<exists>x. \<forall>n. norm (X n + - x) \<le> k)"
   by (metis BseqE BseqI' add.commute add_cancel_right_left add_uminus_conv_diff norm_add_leD
             norm_minus_cancel norm_minus_commute)
 
 text \<open>Alternative formulation for boundedness.\<close>
 lemma Bseq_iff3: "Bseq X \<longleftrightarrow> (\<exists>k>0. \<exists>N. \<forall>n. norm (X n + - X N) \<le> k)"
   (is "?P \<longleftrightarrow> ?Q")
 proof
   assume ?P
   then obtain K where *: "0 < K" and **: "\<And>n. norm (X n) \<le> K"
     by (auto simp: Bseq_def)
   from * have "0 < K + norm (X 0)" by (rule order_less_le_trans) simp
   from ** have "\<forall>n. norm (X n - X 0) \<le> K + norm (X 0)"
     by (auto intro: order_trans norm_triangle_ineq4)
   then have "\<forall>n. norm (X n + - X 0) \<le> K + norm (X 0)"
     by simp
   with \<open>0 < K + norm (X 0)\<close> show ?Q by blast
 next
   assume ?Q
   then show ?P by (auto simp: Bseq_iff2)
 qed
 
 
 subsubsection \<open>Upper Bounds and Lubs of Bounded Sequences\<close>
 
 lemma Bseq_minus_iff: "Bseq (\<lambda>n. - (X n) :: 'a::real_normed_vector) \<longleftrightarrow> Bseq X"
   by (simp add: Bseq_def)
 
 lemma Bseq_add:
   fixes f :: "nat \<Rightarrow> 'a::real_normed_vector"
   assumes "Bseq f"
   shows "Bseq (\<lambda>x. f x + c)"
 proof -
   from assms obtain K where K: "\<And>x. norm (f x) \<le> K"
     unfolding Bseq_def by blast
   {
     fix x :: nat
     have "norm (f x + c) \<le> norm (f x) + norm c" by (rule norm_triangle_ineq)
     also have "norm (f x) \<le> K" by (rule K)
     finally have "norm (f x + c) \<le> K + norm c" by simp
   }
   then show ?thesis by (rule BseqI')
 qed
 
 lemma Bseq_add_iff: "Bseq (\<lambda>x. f x + c) \<longleftrightarrow> Bseq f"
   for f :: "nat \<Rightarrow> 'a::real_normed_vector"
   using Bseq_add[of f c] Bseq_add[of "\<lambda>x. f x + c" "-c"] by auto
 
 lemma Bseq_mult:
   fixes f g :: "nat \<Rightarrow> 'a::real_normed_field"
   assumes "Bseq f" and "Bseq g"
   shows "Bseq (\<lambda>x. f x * g x)"
 proof -
   from assms obtain K1 K2 where K: "norm (f x) \<le> K1" "K1 > 0" "norm (g x) \<le> K2" "K2 > 0"
     for x
     unfolding Bseq_def by blast
   then have "norm (f x * g x) \<le> K1 * K2" for x
     by (auto simp: norm_mult intro!: mult_mono)
   then show ?thesis by (rule BseqI')
 qed
 
 lemma Bfun_const [simp]: "Bfun (\<lambda>_. c) F"
   unfolding Bfun_metric_def by (auto intro!: exI[of _ c] exI[of _ "1::real"])
 
 lemma Bseq_cmult_iff:
   fixes c :: "'a::real_normed_field"
   assumes "c \<noteq> 0"
   shows "Bseq (\<lambda>x. c * f x) \<longleftrightarrow> Bseq f"
 proof
   assume "Bseq (\<lambda>x. c * f x)"
   with Bfun_const have "Bseq (\<lambda>x. inverse c * (c * f x))"
     by (rule Bseq_mult)
   with \<open>c \<noteq> 0\<close> show "Bseq f"
     by (simp add: field_split_simps)
 qed (intro Bseq_mult Bfun_const)
 
 lemma Bseq_subseq: "Bseq f \<Longrightarrow> Bseq (\<lambda>x. f (g x))"
   for f :: "nat \<Rightarrow> 'a::real_normed_vector"
   unfolding Bseq_def by auto
 
 lemma Bseq_Suc_iff: "Bseq (\<lambda>n. f (Suc n)) \<longleftrightarrow> Bseq f"
   for f :: "nat \<Rightarrow> 'a::real_normed_vector"
   using Bseq_offset[of f 1] by (auto intro: Bseq_subseq)
 
 lemma increasing_Bseq_subseq_iff:
   assumes "\<And>x y. x \<le> y \<Longrightarrow> norm (f x :: 'a::real_normed_vector) \<le> norm (f y)" "strict_mono g"
   shows "Bseq (\<lambda>x. f (g x)) \<longleftrightarrow> Bseq f"
 proof
   assume "Bseq (\<lambda>x. f (g x))"
   then obtain K where K: "\<And>x. norm (f (g x)) \<le> K"
     unfolding Bseq_def by auto
   {
     fix x :: nat
     from filterlim_subseq[OF assms(2)] obtain y where "g y \<ge> x"
       by (auto simp: filterlim_at_top eventually_at_top_linorder)
     then have "norm (f x) \<le> norm (f (g y))"
       using assms(1) by blast
     also have "norm (f (g y)) \<le> K" by (rule K)
     finally have "norm (f x) \<le> K" .
   }
   then show "Bseq f" by (rule BseqI')
 qed (use Bseq_subseq[of f g] in simp_all)
 
 lemma nonneg_incseq_Bseq_subseq_iff:
   fixes f :: "nat \<Rightarrow> real"
     and g :: "nat \<Rightarrow> nat"
   assumes "\<And>x. f x \<ge> 0" "incseq f" "strict_mono g"
   shows "Bseq (\<lambda>x. f (g x)) \<longleftrightarrow> Bseq f"
   using assms by (intro increasing_Bseq_subseq_iff) (auto simp: incseq_def)
 
 lemma Bseq_eq_bounded: "range f \<subseteq> {a..b} \<Longrightarrow> Bseq f"
   for a b :: real
 proof (rule BseqI'[where K="max (norm a) (norm b)"])
   fix n assume "range f \<subseteq> {a..b}"
   then have "f n \<in> {a..b}"
     by blast
   then show "norm (f n) \<le> max (norm a) (norm b)"
     by auto
 qed
 
 lemma incseq_bounded: "incseq X \<Longrightarrow> \<forall>i. X i \<le> B \<Longrightarrow> Bseq X"
   for B :: real
   by (intro Bseq_eq_bounded[of X "X 0" B]) (auto simp: incseq_def)
 
 lemma decseq_bounded: "decseq X \<Longrightarrow> \<forall>i. B \<le> X i \<Longrightarrow> Bseq X"
   for B :: real
   by (intro Bseq_eq_bounded[of X B "X 0"]) (auto simp: decseq_def)
 
 
+subsubsection\<^marker>\<open>tag unimportant\<close> \<open>Polynomal function extremal theorem, from HOL Light\<close>
+
+lemma polyfun_extremal_lemma: (*COMPLEX_POLYFUN_EXTREMAL_LEMMA in HOL Light*)
+    fixes c :: "nat \<Rightarrow> 'a::real_normed_div_algebra"
+  assumes "0 < e"
+    shows "\<exists>M. \<forall>z. M \<le> norm(z) \<longrightarrow> norm (\<Sum>i\<le>n. c(i) * z^i) \<le> e * norm(z) ^ (Suc n)"
+proof (induct n)
+  case 0 with assms
+  show ?case
+    apply (rule_tac x="norm (c 0) / e" in exI)
+    apply (auto simp: field_simps)
+    done
+next
+  case (Suc n)
+  obtain M where M: "\<And>z. M \<le> norm z \<Longrightarrow> norm (\<Sum>i\<le>n. c i * z^i) \<le> e * norm z ^ Suc n"
+    using Suc assms by blast
+  show ?case
+  proof (rule exI [where x= "max M (1 + norm(c(Suc n)) / e)"], clarsimp simp del: power_Suc)
+    fix z::'a
+    assume z1: "M \<le> norm z" and "1 + norm (c (Suc n)) / e \<le> norm z"
+    then have z2: "e + norm (c (Suc n)) \<le> e * norm z"
+      using assms by (simp add: field_simps)
+    have "norm (\<Sum>i\<le>n. c i * z^i) \<le> e * norm z ^ Suc n"
+      using M [OF z1] by simp
+    then have "norm (\<Sum>i\<le>n. c i * z^i) + norm (c (Suc n) * z ^ Suc n) \<le> e * norm z ^ Suc n + norm (c (Suc n) * z ^ Suc n)"
+      by simp
+    then have "norm ((\<Sum>i\<le>n. c i * z^i) + c (Suc n) * z ^ Suc n) \<le> e * norm z ^ Suc n + norm (c (Suc n) * z ^ Suc n)"
+      by (blast intro: norm_triangle_le elim: )
+    also have "... \<le> (e + norm (c (Suc n))) * norm z ^ Suc n"
+      by (simp add: norm_power norm_mult algebra_simps)
+    also have "... \<le> (e * norm z) * norm z ^ Suc n"
+      by (metis z2 mult.commute mult_left_mono norm_ge_zero norm_power)
+    finally show "norm ((\<Sum>i\<le>n. c i * z^i) + c (Suc n) * z ^ Suc n) \<le> e * norm z ^ Suc (Suc n)"
+      by simp
+  qed
+qed
+
+lemma polyfun_extremal: (*COMPLEX_POLYFUN_EXTREMAL in HOL Light*)
+    fixes c :: "nat \<Rightarrow> 'a::real_normed_div_algebra"
+  assumes k: "c k \<noteq> 0" "1\<le>k" and kn: "k\<le>n"
+    shows "eventually (\<lambda>z. norm (\<Sum>i\<le>n. c(i) * z^i) \<ge> B) at_infinity"
+using kn
+proof (induction n)
+  case 0
+  then show ?case
+    using k  by simp
+next
+  case (Suc m)
+  let ?even = ?case
+  show ?even
+  proof (cases "c (Suc m) = 0")
+    case True
+    then show ?even using Suc k
+      by auto (metis antisym_conv less_eq_Suc_le not_le)
+  next
+    case False
+    then obtain M where M:
+          "\<And>z. M \<le> norm z \<Longrightarrow> norm (\<Sum>i\<le>m. c i * z^i) \<le> norm (c (Suc m)) / 2 * norm z ^ Suc m"
+      using polyfun_extremal_lemma [of "norm(c (Suc m)) / 2" c m] Suc
+      by auto
+    have "\<exists>b. \<forall>z. b \<le> norm z \<longrightarrow> B \<le> norm (\<Sum>i\<le>Suc m. c i * z^i)"
+    proof (rule exI [where x="max M (max 1 (\<bar>B\<bar> / (norm(c (Suc m)) / 2)))"], clarsimp simp del: power_Suc)
+      fix z::'a
+      assume z1: "M \<le> norm z" "1 \<le> norm z"
+         and "\<bar>B\<bar> * 2 / norm (c (Suc m)) \<le> norm z"
+      then have z2: "\<bar>B\<bar> \<le> norm (c (Suc m)) * norm z / 2"
+        using False by (simp add: field_simps)
+      have nz: "norm z \<le> norm z ^ Suc m"
+        by (metis \<open>1 \<le> norm z\<close> One_nat_def less_eq_Suc_le power_increasing power_one_right zero_less_Suc)
+      have *: "\<And>y x. norm (c (Suc m)) * norm z / 2 \<le> norm y - norm x \<Longrightarrow> B \<le> norm (x + y)"
+        by (metis abs_le_iff add.commute norm_diff_ineq order_trans z2)
+      have "norm z * norm (c (Suc m)) + 2 * norm (\<Sum>i\<le>m. c i * z^i)
+            \<le> norm (c (Suc m)) * norm z + norm (c (Suc m)) * norm z ^ Suc m"
+        using M [of z] Suc z1  by auto
+      also have "... \<le> 2 * (norm (c (Suc m)) * norm z ^ Suc m)"
+        using nz by (simp add: mult_mono del: power_Suc)
+      finally show "B \<le> norm ((\<Sum>i\<le>m. c i * z^i) + c (Suc m) * z ^ Suc m)"
+        using Suc.IH
+        apply (auto simp: eventually_at_infinity)
+        apply (rule *)
+        apply (simp add: field_simps norm_mult norm_power)
+        done
+    qed
+    then show ?even
+      by (simp add: eventually_at_infinity)
+  qed
+qed
+
 subsection \<open>Convergence to Zero\<close>
 
 definition Zfun :: "('a \<Rightarrow> 'b::real_normed_vector) \<Rightarrow> 'a filter \<Rightarrow> bool"
   where "Zfun f F = (\<forall>r>0. eventually (\<lambda>x. norm (f x) < r) F)"
 
 lemma ZfunI: "(\<And>r. 0 < r \<Longrightarrow> eventually (\<lambda>x. norm (f x) < r) F) \<Longrightarrow> Zfun f F"
   by (simp add: Zfun_def)
 
 lemma ZfunD: "Zfun f F \<Longrightarrow> 0 < r \<Longrightarrow> eventually (\<lambda>x. norm (f x) < r) F"
   by (simp add: Zfun_def)
 
 lemma Zfun_ssubst: "eventually (\<lambda>x. f x = g x) F \<Longrightarrow> Zfun g F \<Longrightarrow> Zfun f F"
   unfolding Zfun_def by (auto elim!: eventually_rev_mp)
 
 lemma Zfun_zero: "Zfun (\<lambda>x. 0) F"
   unfolding Zfun_def by simp
 
 lemma Zfun_norm_iff: "Zfun (\<lambda>x. norm (f x)) F = Zfun (\<lambda>x. f x) F"
   unfolding Zfun_def by simp
 
 lemma Zfun_imp_Zfun:
   assumes f: "Zfun f F"
     and g: "eventually (\<lambda>x. norm (g x) \<le> norm (f x) * K) F"
   shows "Zfun (\<lambda>x. g x) F"
 proof (cases "0 < K")
   case K: True
   show ?thesis
   proof (rule ZfunI)
     fix r :: real
     assume "0 < r"
     then have "0 < r / K" using K by simp
     then have "eventually (\<lambda>x. norm (f x) < r / K) F"
       using ZfunD [OF f] by blast
     with g show "eventually (\<lambda>x. norm (g x) < r) F"
     proof eventually_elim
       case (elim x)
       then have "norm (f x) * K < r"
         by (simp add: pos_less_divide_eq K)
       then show ?case
         by (simp add: order_le_less_trans [OF elim(1)])
     qed
   qed
 next
   case False
   then have K: "K \<le> 0" by (simp only: not_less)
   show ?thesis
   proof (rule ZfunI)
     fix r :: real
     assume "0 < r"
     from g show "eventually (\<lambda>x. norm (g x) < r) F"
     proof eventually_elim
       case (elim x)
       also have "norm (f x) * K \<le> norm (f x) * 0"
         using K norm_ge_zero by (rule mult_left_mono)
       finally show ?case
         using \<open>0 < r\<close> by simp
     qed
   qed
 qed
 
 lemma Zfun_le: "Zfun g F \<Longrightarrow> \<forall>x. norm (f x) \<le> norm (g x) \<Longrightarrow> Zfun f F"
   by (erule Zfun_imp_Zfun [where K = 1]) simp
 
 lemma Zfun_add:
   assumes f: "Zfun f F"
     and g: "Zfun g F"
   shows "Zfun (\<lambda>x. f x + g x) F"
 proof (rule ZfunI)
   fix r :: real
   assume "0 < r"
   then have r: "0 < r / 2" by simp
   have "eventually (\<lambda>x. norm (f x) < r/2) F"
     using f r by (rule ZfunD)
   moreover
   have "eventually (\<lambda>x. norm (g x) < r/2) F"
     using g r by (rule ZfunD)
   ultimately
   show "eventually (\<lambda>x. norm (f x + g x) < r) F"
   proof eventually_elim
     case (elim x)
     have "norm (f x + g x) \<le> norm (f x) + norm (g x)"
       by (rule norm_triangle_ineq)
     also have "\<dots> < r/2 + r/2"
       using elim by (rule add_strict_mono)
     finally show ?case
       by simp
   qed
 qed
 
 lemma Zfun_minus: "Zfun f F \<Longrightarrow> Zfun (\<lambda>x. - f x) F"
   unfolding Zfun_def by simp
 
 lemma Zfun_diff: "Zfun f F \<Longrightarrow> Zfun g F \<Longrightarrow> Zfun (\<lambda>x. f x - g x) F"
   using Zfun_add [of f F "\<lambda>x. - g x"] by (simp add: Zfun_minus)
 
 lemma (in bounded_linear) Zfun:
   assumes g: "Zfun g F"
   shows "Zfun (\<lambda>x. f (g x)) F"
 proof -
   obtain K where "norm (f x) \<le> norm x * K" for x
     using bounded by blast
   then have "eventually (\<lambda>x. norm (f (g x)) \<le> norm (g x) * K) F"
     by simp
   with g show ?thesis
     by (rule Zfun_imp_Zfun)
 qed
 
 lemma (in bounded_bilinear) Zfun:
   assumes f: "Zfun f F"
     and g: "Zfun g F"
   shows "Zfun (\<lambda>x. f x ** g x) F"
 proof (rule ZfunI)
   fix r :: real
   assume r: "0 < r"
   obtain K where K: "0 < K"
     and norm_le: "norm (x ** y) \<le> norm x * norm y * K" for x y
     using pos_bounded by blast
   from K have K': "0 < inverse K"
     by (rule positive_imp_inverse_positive)
   have "eventually (\<lambda>x. norm (f x) < r) F"
     using f r by (rule ZfunD)
   moreover
   have "eventually (\<lambda>x. norm (g x) < inverse K) F"
     using g K' by (rule ZfunD)
   ultimately
   show "eventually (\<lambda>x. norm (f x ** g x) < r) F"
   proof eventually_elim
     case (elim x)
     have "norm (f x ** g x) \<le> norm (f x) * norm (g x) * K"
       by (rule norm_le)
     also have "norm (f x) * norm (g x) * K < r * inverse K * K"
       by (intro mult_strict_right_mono mult_strict_mono' norm_ge_zero elim K)
     also from K have "r * inverse K * K = r"
       by simp
     finally show ?case .
   qed
 qed
 
 lemma (in bounded_bilinear) Zfun_left: "Zfun f F \<Longrightarrow> Zfun (\<lambda>x. f x ** a) F"
   by (rule bounded_linear_left [THEN bounded_linear.Zfun])
 
 lemma (in bounded_bilinear) Zfun_right: "Zfun f F \<Longrightarrow> Zfun (\<lambda>x. a ** f x) F"
   by (rule bounded_linear_right [THEN bounded_linear.Zfun])
 
 lemmas Zfun_mult = bounded_bilinear.Zfun [OF bounded_bilinear_mult]
 lemmas Zfun_mult_right = bounded_bilinear.Zfun_right [OF bounded_bilinear_mult]
 lemmas Zfun_mult_left = bounded_bilinear.Zfun_left [OF bounded_bilinear_mult]
 
 lemma tendsto_Zfun_iff: "(f \<longlongrightarrow> a) F = Zfun (\<lambda>x. f x - a) F"
   by (simp only: tendsto_iff Zfun_def dist_norm)
 
 lemma tendsto_0_le:
   "(f \<longlongrightarrow> 0) F \<Longrightarrow> eventually (\<lambda>x. norm (g x) \<le> norm (f x) * K) F \<Longrightarrow> (g \<longlongrightarrow> 0) F"
   by (simp add: Zfun_imp_Zfun tendsto_Zfun_iff)
 
 
 subsubsection \<open>Distance and norms\<close>
 
 lemma tendsto_dist [tendsto_intros]:
   fixes l m :: "'a::metric_space"
   assumes f: "(f \<longlongrightarrow> l) F"
     and g: "(g \<longlongrightarrow> m) F"
   shows "((\<lambda>x. dist (f x) (g x)) \<longlongrightarrow> dist l m) F"
 proof (rule tendstoI)
   fix e :: real
   assume "0 < e"
   then have e2: "0 < e/2" by simp
   from tendstoD [OF f e2] tendstoD [OF g e2]
   show "eventually (\<lambda>x. dist (dist (f x) (g x)) (dist l m) < e) F"
   proof (eventually_elim)
     case (elim x)
     then show "dist (dist (f x) (g x)) (dist l m) < e"
       unfolding dist_real_def
       using dist_triangle2 [of "f x" "g x" "l"]
         and dist_triangle2 [of "g x" "l" "m"]
         and dist_triangle3 [of "l" "m" "f x"]
         and dist_triangle [of "f x" "m" "g x"]
       by arith
   qed
 qed
 
 lemma continuous_dist[continuous_intros]:
   fixes f g :: "_ \<Rightarrow> 'a :: metric_space"
   shows "continuous F f \<Longrightarrow> continuous F g \<Longrightarrow> continuous F (\<lambda>x. dist (f x) (g x))"
   unfolding continuous_def by (rule tendsto_dist)
 
 lemma continuous_on_dist[continuous_intros]:
   fixes f g :: "_ \<Rightarrow> 'a :: metric_space"
   shows "continuous_on s f \<Longrightarrow> continuous_on s g \<Longrightarrow> continuous_on s (\<lambda>x. dist (f x) (g x))"
   unfolding continuous_on_def by (auto intro: tendsto_dist)
 
 lemma continuous_at_dist: "isCont (dist a) b"
   using continuous_on_dist [OF continuous_on_const continuous_on_id] continuous_on_eq_continuous_within by blast
 
 lemma tendsto_norm [tendsto_intros]: "(f \<longlongrightarrow> a) F \<Longrightarrow> ((\<lambda>x. norm (f x)) \<longlongrightarrow> norm a) F"
   unfolding norm_conv_dist by (intro tendsto_intros)
 
 lemma continuous_norm [continuous_intros]: "continuous F f \<Longrightarrow> continuous F (\<lambda>x. norm (f x))"
   unfolding continuous_def by (rule tendsto_norm)
 
 lemma continuous_on_norm [continuous_intros]:
   "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. norm (f x))"
   unfolding continuous_on_def by (auto intro: tendsto_norm)
 
+lemma continuous_on_norm_id [continuous_intros]: "continuous_on S norm"
+  by (intro continuous_on_id continuous_on_norm)
+
 lemma tendsto_norm_zero: "(f \<longlongrightarrow> 0) F \<Longrightarrow> ((\<lambda>x. norm (f x)) \<longlongrightarrow> 0) F"
   by (drule tendsto_norm) simp
 
 lemma tendsto_norm_zero_cancel: "((\<lambda>x. norm (f x)) \<longlongrightarrow> 0) F \<Longrightarrow> (f \<longlongrightarrow> 0) F"
   unfolding tendsto_iff dist_norm by simp
 
 lemma tendsto_norm_zero_iff: "((\<lambda>x. norm (f x)) \<longlongrightarrow> 0) F \<longleftrightarrow> (f \<longlongrightarrow> 0) F"
   unfolding tendsto_iff dist_norm by simp
 
 lemma tendsto_rabs [tendsto_intros]: "(f \<longlongrightarrow> l) F \<Longrightarrow> ((\<lambda>x. \<bar>f x\<bar>) \<longlongrightarrow> \<bar>l\<bar>) F"
   for l :: real
   by (fold real_norm_def) (rule tendsto_norm)
 
 lemma continuous_rabs [continuous_intros]:
   "continuous F f \<Longrightarrow> continuous F (\<lambda>x. \<bar>f x :: real\<bar>)"
   unfolding real_norm_def[symmetric] by (rule continuous_norm)
 
 lemma continuous_on_rabs [continuous_intros]:
   "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. \<bar>f x :: real\<bar>)"
   unfolding real_norm_def[symmetric] by (rule continuous_on_norm)
 
 lemma tendsto_rabs_zero: "(f \<longlongrightarrow> (0::real)) F \<Longrightarrow> ((\<lambda>x. \<bar>f x\<bar>) \<longlongrightarrow> 0) F"
   by (fold real_norm_def) (rule tendsto_norm_zero)
 
 lemma tendsto_rabs_zero_cancel: "((\<lambda>x. \<bar>f x\<bar>) \<longlongrightarrow> (0::real)) F \<Longrightarrow> (f \<longlongrightarrow> 0) F"
   by (fold real_norm_def) (rule tendsto_norm_zero_cancel)
 
 lemma tendsto_rabs_zero_iff: "((\<lambda>x. \<bar>f x\<bar>) \<longlongrightarrow> (0::real)) F \<longleftrightarrow> (f \<longlongrightarrow> 0) F"
   by (fold real_norm_def) (rule tendsto_norm_zero_iff)
 
 
 subsection \<open>Topological Monoid\<close>
 
 class topological_monoid_add = topological_space + monoid_add +
   assumes tendsto_add_Pair: "LIM x (nhds a \<times>\<^sub>F nhds b). fst x + snd x :> nhds (a + b)"
 
 class topological_comm_monoid_add = topological_monoid_add + comm_monoid_add
 
 lemma tendsto_add [tendsto_intros]:
   fixes a b :: "'a::topological_monoid_add"
   shows "(f \<longlongrightarrow> a) F \<Longrightarrow> (g \<longlongrightarrow> b) F \<Longrightarrow> ((\<lambda>x. f x + g x) \<longlongrightarrow> a + b) F"
   using filterlim_compose[OF tendsto_add_Pair, of "\<lambda>x. (f x, g x)" a b F]
   by (simp add: nhds_prod[symmetric] tendsto_Pair)
 
 lemma continuous_add [continuous_intros]:
   fixes f g :: "_ \<Rightarrow> 'b::topological_monoid_add"
   shows "continuous F f \<Longrightarrow> continuous F g \<Longrightarrow> continuous F (\<lambda>x. f x + g x)"
   unfolding continuous_def by (rule tendsto_add)
 
 lemma continuous_on_add [continuous_intros]:
   fixes f g :: "_ \<Rightarrow> 'b::topological_monoid_add"
   shows "continuous_on s f \<Longrightarrow> continuous_on s g \<Longrightarrow> continuous_on s (\<lambda>x. f x + g x)"
   unfolding continuous_on_def by (auto intro: tendsto_add)
 
 lemma tendsto_add_zero:
   fixes f g :: "_ \<Rightarrow> 'b::topological_monoid_add"
   shows "(f \<longlongrightarrow> 0) F \<Longrightarrow> (g \<longlongrightarrow> 0) F \<Longrightarrow> ((\<lambda>x. f x + g x) \<longlongrightarrow> 0) F"
   by (drule (1) tendsto_add) simp
 
 lemma tendsto_sum [tendsto_intros]:
   fixes f :: "'a \<Rightarrow> 'b \<Rightarrow> 'c::topological_comm_monoid_add"
   shows "(\<And>i. i \<in> I \<Longrightarrow> (f i \<longlongrightarrow> a i) F) \<Longrightarrow> ((\<lambda>x. \<Sum>i\<in>I. f i x) \<longlongrightarrow> (\<Sum>i\<in>I. a i)) F"
   by (induct I rule: infinite_finite_induct) (simp_all add: tendsto_add)
 
 lemma tendsto_null_sum:
   fixes f :: "'a \<Rightarrow> 'b \<Rightarrow> 'c::topological_comm_monoid_add"
   assumes "\<And>i. i \<in> I \<Longrightarrow> ((\<lambda>x. f x i) \<longlongrightarrow> 0) F"
   shows "((\<lambda>i. sum (f i) I) \<longlongrightarrow> 0) F"
   using tendsto_sum [of I "\<lambda>x y. f y x" "\<lambda>x. 0"] assms by simp
 
 lemma continuous_sum [continuous_intros]:
   fixes f :: "'a \<Rightarrow> 'b::t2_space \<Rightarrow> 'c::topological_comm_monoid_add"
   shows "(\<And>i. i \<in> I \<Longrightarrow> continuous F (f i)) \<Longrightarrow> continuous F (\<lambda>x. \<Sum>i\<in>I. f i x)"
   unfolding continuous_def by (rule tendsto_sum)
 
 lemma continuous_on_sum [continuous_intros]:
   fixes f :: "'a \<Rightarrow> 'b::topological_space \<Rightarrow> 'c::topological_comm_monoid_add"
   shows "(\<And>i. i \<in> I \<Longrightarrow> continuous_on S (f i)) \<Longrightarrow> continuous_on S (\<lambda>x. \<Sum>i\<in>I. f i x)"
   unfolding continuous_on_def by (auto intro: tendsto_sum)
 
 instance nat :: topological_comm_monoid_add
   by standard
     (simp add: nhds_discrete principal_prod_principal filterlim_principal eventually_principal)
 
 instance int :: topological_comm_monoid_add
   by standard
     (simp add: nhds_discrete principal_prod_principal filterlim_principal eventually_principal)
 
 
 subsubsection \<open>Topological group\<close>
 
 class topological_group_add = topological_monoid_add + group_add +
   assumes tendsto_uminus_nhds: "(uminus \<longlongrightarrow> - a) (nhds a)"
 begin
 
 lemma tendsto_minus [tendsto_intros]: "(f \<longlongrightarrow> a) F \<Longrightarrow> ((\<lambda>x. - f x) \<longlongrightarrow> - a) F"
   by (rule filterlim_compose[OF tendsto_uminus_nhds])
 
 end
 
 class topological_ab_group_add = topological_group_add + ab_group_add
 
 instance topological_ab_group_add < topological_comm_monoid_add ..
 
 lemma continuous_minus [continuous_intros]: "continuous F f \<Longrightarrow> continuous F (\<lambda>x. - f x)"
   for f :: "'a::t2_space \<Rightarrow> 'b::topological_group_add"
   unfolding continuous_def by (rule tendsto_minus)
 
 lemma continuous_on_minus [continuous_intros]: "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. - f x)"
   for f :: "_ \<Rightarrow> 'b::topological_group_add"
   unfolding continuous_on_def by (auto intro: tendsto_minus)
 
 lemma tendsto_minus_cancel: "((\<lambda>x. - f x) \<longlongrightarrow> - a) F \<Longrightarrow> (f \<longlongrightarrow> a) F"
   for a :: "'a::topological_group_add"
   by (drule tendsto_minus) simp
 
 lemma tendsto_minus_cancel_left:
   "(f \<longlongrightarrow> - (y::_::topological_group_add)) F \<longleftrightarrow> ((\<lambda>x. - f x) \<longlongrightarrow> y) F"
   using tendsto_minus_cancel[of f "- y" F]  tendsto_minus[of f "- y" F]
   by auto
 
 lemma tendsto_diff [tendsto_intros]:
   fixes a b :: "'a::topological_group_add"
   shows "(f \<longlongrightarrow> a) F \<Longrightarrow> (g \<longlongrightarrow> b) F \<Longrightarrow> ((\<lambda>x. f x - g x) \<longlongrightarrow> a - b) F"
   using tendsto_add [of f a F "\<lambda>x. - g x" "- b"] by (simp add: tendsto_minus)
 
 lemma continuous_diff [continuous_intros]:
   fixes f g :: "'a::t2_space \<Rightarrow> 'b::topological_group_add"
   shows "continuous F f \<Longrightarrow> continuous F g \<Longrightarrow> continuous F (\<lambda>x. f x - g x)"
   unfolding continuous_def by (rule tendsto_diff)
 
 lemma continuous_on_diff [continuous_intros]:
   fixes f g :: "_ \<Rightarrow> 'b::topological_group_add"
   shows "continuous_on s f \<Longrightarrow> continuous_on s g \<Longrightarrow> continuous_on s (\<lambda>x. f x - g x)"
   unfolding continuous_on_def by (auto intro: tendsto_diff)
 
 lemma continuous_on_op_minus: "continuous_on (s::'a::topological_group_add set) ((-) x)"
   by (rule continuous_intros | simp)+
 
 instance real_normed_vector < topological_ab_group_add
 proof
   fix a b :: 'a
   show "((\<lambda>x. fst x + snd x) \<longlongrightarrow> a + b) (nhds a \<times>\<^sub>F nhds b)"
     unfolding tendsto_Zfun_iff add_diff_add
     using tendsto_fst[OF filterlim_ident, of "(a,b)"] tendsto_snd[OF filterlim_ident, of "(a,b)"]
     by (intro Zfun_add)
        (auto simp: tendsto_Zfun_iff[symmetric] nhds_prod[symmetric] intro!: tendsto_fst)
   show "(uminus \<longlongrightarrow> - a) (nhds a)"
     unfolding tendsto_Zfun_iff minus_diff_minus
     using filterlim_ident[of "nhds a"]
     by (intro Zfun_minus) (simp add: tendsto_Zfun_iff)
 qed
 
 lemmas real_tendsto_sandwich = tendsto_sandwich[where 'a=real]
 
 
 subsubsection \<open>Linear operators and multiplication\<close>
 
 lemma linear_times [simp]: "linear (\<lambda>x. c * x)"
   for c :: "'a::real_algebra"
   by (auto simp: linearI distrib_left)
 
 lemma (in bounded_linear) tendsto: "(g \<longlongrightarrow> a) F \<Longrightarrow> ((\<lambda>x. f (g x)) \<longlongrightarrow> f a) F"
   by (simp only: tendsto_Zfun_iff diff [symmetric] Zfun)
 
 lemma (in bounded_linear) continuous: "continuous F g \<Longrightarrow> continuous F (\<lambda>x. f (g x))"
   using tendsto[of g _ F] by (auto simp: continuous_def)
 
 lemma (in bounded_linear) continuous_on: "continuous_on s g \<Longrightarrow> continuous_on s (\<lambda>x. f (g x))"
   using tendsto[of g] by (auto simp: continuous_on_def)
 
 lemma (in bounded_linear) tendsto_zero: "(g \<longlongrightarrow> 0) F \<Longrightarrow> ((\<lambda>x. f (g x)) \<longlongrightarrow> 0) F"
   by (drule tendsto) (simp only: zero)
 
 lemma (in bounded_bilinear) tendsto:
   "(f \<longlongrightarrow> a) F \<Longrightarrow> (g \<longlongrightarrow> b) F \<Longrightarrow> ((\<lambda>x. f x ** g x) \<longlongrightarrow> a ** b) F"
   by (simp only: tendsto_Zfun_iff prod_diff_prod Zfun_add Zfun Zfun_left Zfun_right)
 
 lemma (in bounded_bilinear) continuous:
   "continuous F f \<Longrightarrow> continuous F g \<Longrightarrow> continuous F (\<lambda>x. f x ** g x)"
   using tendsto[of f _ F g] by (auto simp: continuous_def)
 
 lemma (in bounded_bilinear) continuous_on:
   "continuous_on s f \<Longrightarrow> continuous_on s g \<Longrightarrow> continuous_on s (\<lambda>x. f x ** g x)"
   using tendsto[of f _ _ g] by (auto simp: continuous_on_def)
 
 lemma (in bounded_bilinear) tendsto_zero:
   assumes f: "(f \<longlongrightarrow> 0) F"
     and g: "(g \<longlongrightarrow> 0) F"
   shows "((\<lambda>x. f x ** g x) \<longlongrightarrow> 0) F"
   using tendsto [OF f g] by (simp add: zero_left)
 
 lemma (in bounded_bilinear) tendsto_left_zero:
   "(f \<longlongrightarrow> 0) F \<Longrightarrow> ((\<lambda>x. f x ** c) \<longlongrightarrow> 0) F"
   by (rule bounded_linear.tendsto_zero [OF bounded_linear_left])
 
 lemma (in bounded_bilinear) tendsto_right_zero:
   "(f \<longlongrightarrow> 0) F \<Longrightarrow> ((\<lambda>x. c ** f x) \<longlongrightarrow> 0) F"
   by (rule bounded_linear.tendsto_zero [OF bounded_linear_right])
 
 lemmas tendsto_of_real [tendsto_intros] =
   bounded_linear.tendsto [OF bounded_linear_of_real]
 
 lemmas tendsto_scaleR [tendsto_intros] =
   bounded_bilinear.tendsto [OF bounded_bilinear_scaleR]
 
 
 text\<open>Analogous type class for multiplication\<close>
 class topological_semigroup_mult = topological_space + semigroup_mult +
   assumes tendsto_mult_Pair: "LIM x (nhds a \<times>\<^sub>F nhds b). fst x * snd x :> nhds (a * b)"
 
 instance real_normed_algebra < topological_semigroup_mult
 proof
   fix a b :: 'a
   show "((\<lambda>x. fst x * snd x) \<longlongrightarrow> a * b) (nhds a \<times>\<^sub>F nhds b)"
     unfolding nhds_prod[symmetric]
     using tendsto_fst[OF filterlim_ident, of "(a,b)"] tendsto_snd[OF filterlim_ident, of "(a,b)"]
     by (simp add: bounded_bilinear.tendsto [OF bounded_bilinear_mult])
 qed
 
 lemma tendsto_mult [tendsto_intros]:
   fixes a b :: "'a::topological_semigroup_mult"
   shows "(f \<longlongrightarrow> a) F \<Longrightarrow> (g \<longlongrightarrow> b) F \<Longrightarrow> ((\<lambda>x. f x * g x) \<longlongrightarrow> a * b) F"
   using filterlim_compose[OF tendsto_mult_Pair, of "\<lambda>x. (f x, g x)" a b F]
   by (simp add: nhds_prod[symmetric] tendsto_Pair)
 
 lemma tendsto_mult_left: "(f \<longlongrightarrow> l) F \<Longrightarrow> ((\<lambda>x. c * (f x)) \<longlongrightarrow> c * l) F"
   for c :: "'a::topological_semigroup_mult"
   by (rule tendsto_mult [OF tendsto_const])
 
 lemma tendsto_mult_right: "(f \<longlongrightarrow> l) F \<Longrightarrow> ((\<lambda>x. (f x) * c) \<longlongrightarrow> l * c) F"
   for c :: "'a::topological_semigroup_mult"
   by (rule tendsto_mult [OF _ tendsto_const])
 
 lemma tendsto_mult_left_iff [simp]:
    "c \<noteq> 0 \<Longrightarrow> tendsto(\<lambda>x. c * f x) (c * l) F \<longleftrightarrow> tendsto f l F" for c :: "'a::{topological_semigroup_mult,field}"
   by (auto simp: tendsto_mult_left dest: tendsto_mult_left [where c = "1/c"])
 
 lemma tendsto_mult_right_iff [simp]:
    "c \<noteq> 0 \<Longrightarrow> tendsto(\<lambda>x. f x * c) (l * c) F \<longleftrightarrow> tendsto f l F" for c :: "'a::{topological_semigroup_mult,field}"
   by (auto simp: tendsto_mult_right dest: tendsto_mult_left [where c = "1/c"])
 
 lemma tendsto_zero_mult_left_iff [simp]:
   fixes c::"'a::{topological_semigroup_mult,field}" assumes "c \<noteq> 0" shows "(\<lambda>n. c * a n)\<longlonglongrightarrow> 0 \<longleftrightarrow> a \<longlonglongrightarrow> 0"
   using assms tendsto_mult_left tendsto_mult_left_iff by fastforce
 
 lemma tendsto_zero_mult_right_iff [simp]:
   fixes c::"'a::{topological_semigroup_mult,field}" assumes "c \<noteq> 0" shows "(\<lambda>n. a n * c)\<longlonglongrightarrow> 0 \<longleftrightarrow> a \<longlonglongrightarrow> 0"
   using assms tendsto_mult_right tendsto_mult_right_iff by fastforce
 
 lemma tendsto_zero_divide_iff [simp]:
   fixes c::"'a::{topological_semigroup_mult,field}" assumes "c \<noteq> 0" shows "(\<lambda>n. a n / c)\<longlonglongrightarrow> 0 \<longleftrightarrow> a \<longlonglongrightarrow> 0"
   using tendsto_zero_mult_right_iff [of "1/c" a] assms by (simp add: field_simps)
 
 lemma lim_const_over_n [tendsto_intros]:
   fixes a :: "'a::real_normed_field"
   shows "(\<lambda>n. a / of_nat n) \<longlonglongrightarrow> 0"
   using tendsto_mult [OF tendsto_const [of a] lim_1_over_n] by simp
 
 lemmas continuous_of_real [continuous_intros] =
   bounded_linear.continuous [OF bounded_linear_of_real]
 
 lemmas continuous_scaleR [continuous_intros] =
   bounded_bilinear.continuous [OF bounded_bilinear_scaleR]
 
 lemmas continuous_mult [continuous_intros] =
   bounded_bilinear.continuous [OF bounded_bilinear_mult]
 
 lemmas continuous_on_of_real [continuous_intros] =
   bounded_linear.continuous_on [OF bounded_linear_of_real]
 
 lemmas continuous_on_scaleR [continuous_intros] =
   bounded_bilinear.continuous_on [OF bounded_bilinear_scaleR]
 
 lemmas continuous_on_mult [continuous_intros] =
   bounded_bilinear.continuous_on [OF bounded_bilinear_mult]
 
 lemmas tendsto_mult_zero =
   bounded_bilinear.tendsto_zero [OF bounded_bilinear_mult]
 
 lemmas tendsto_mult_left_zero =
   bounded_bilinear.tendsto_left_zero [OF bounded_bilinear_mult]
 
 lemmas tendsto_mult_right_zero =
   bounded_bilinear.tendsto_right_zero [OF bounded_bilinear_mult]
 
 
 lemma continuous_mult_left:
   fixes c::"'a::real_normed_algebra"
   shows "continuous F f \<Longrightarrow> continuous F (\<lambda>x. c * f x)"
 by (rule continuous_mult [OF continuous_const])
 
 lemma continuous_mult_right:
   fixes c::"'a::real_normed_algebra"
   shows "continuous F f \<Longrightarrow> continuous F (\<lambda>x. f x * c)"
 by (rule continuous_mult [OF _ continuous_const])
 
 lemma continuous_on_mult_left:
   fixes c::"'a::real_normed_algebra"
   shows "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. c * f x)"
 by (rule continuous_on_mult [OF continuous_on_const])
 
 lemma continuous_on_mult_right:
   fixes c::"'a::real_normed_algebra"
   shows "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. f x * c)"
 by (rule continuous_on_mult [OF _ continuous_on_const])
 
 lemma continuous_on_mult_const [simp]:
   fixes c::"'a::real_normed_algebra"
   shows "continuous_on s ((*) c)"
   by (intro continuous_on_mult_left continuous_on_id)
 
 lemma tendsto_divide_zero:
   fixes c :: "'a::real_normed_field"
   shows "(f \<longlongrightarrow> 0) F \<Longrightarrow> ((\<lambda>x. f x / c) \<longlongrightarrow> 0) F"
   by (cases "c=0") (simp_all add: divide_inverse tendsto_mult_left_zero)
 
 lemma tendsto_power [tendsto_intros]: "(f \<longlongrightarrow> a) F \<Longrightarrow> ((\<lambda>x. f x ^ n) \<longlongrightarrow> a ^ n) F"
   for f :: "'a \<Rightarrow> 'b::{power,real_normed_algebra}"
   by (induct n) (simp_all add: tendsto_mult)
 
 lemma tendsto_null_power: "\<lbrakk>(f \<longlongrightarrow> 0) F; 0 < n\<rbrakk> \<Longrightarrow> ((\<lambda>x. f x ^ n) \<longlongrightarrow> 0) F"
     for f :: "'a \<Rightarrow> 'b::{power,real_normed_algebra_1}"
   using tendsto_power [of f 0 F n] by (simp add: power_0_left)
 
 lemma continuous_power [continuous_intros]: "continuous F f \<Longrightarrow> continuous F (\<lambda>x. (f x)^n)"
   for f :: "'a::t2_space \<Rightarrow> 'b::{power,real_normed_algebra}"
   unfolding continuous_def by (rule tendsto_power)
 
 lemma continuous_on_power [continuous_intros]:
   fixes f :: "_ \<Rightarrow> 'b::{power,real_normed_algebra}"
   shows "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. (f x)^n)"
   unfolding continuous_on_def by (auto intro: tendsto_power)
 
 lemma tendsto_prod [tendsto_intros]:
   fixes f :: "'a \<Rightarrow> 'b \<Rightarrow> 'c::{real_normed_algebra,comm_ring_1}"
   shows "(\<And>i. i \<in> S \<Longrightarrow> (f i \<longlongrightarrow> L i) F) \<Longrightarrow> ((\<lambda>x. \<Prod>i\<in>S. f i x) \<longlongrightarrow> (\<Prod>i\<in>S. L i)) F"
   by (induct S rule: infinite_finite_induct) (simp_all add: tendsto_mult)
 
 lemma continuous_prod [continuous_intros]:
   fixes f :: "'a \<Rightarrow> 'b::t2_space \<Rightarrow> 'c::{real_normed_algebra,comm_ring_1}"
   shows "(\<And>i. i \<in> S \<Longrightarrow> continuous F (f i)) \<Longrightarrow> continuous F (\<lambda>x. \<Prod>i\<in>S. f i x)"
   unfolding continuous_def by (rule tendsto_prod)
 
 lemma continuous_on_prod [continuous_intros]:
   fixes f :: "'a \<Rightarrow> _ \<Rightarrow> 'c::{real_normed_algebra,comm_ring_1}"
   shows "(\<And>i. i \<in> S \<Longrightarrow> continuous_on s (f i)) \<Longrightarrow> continuous_on s (\<lambda>x. \<Prod>i\<in>S. f i x)"
   unfolding continuous_on_def by (auto intro: tendsto_prod)
 
 lemma tendsto_of_real_iff:
   "((\<lambda>x. of_real (f x) :: 'a::real_normed_div_algebra) \<longlongrightarrow> of_real c) F \<longleftrightarrow> (f \<longlongrightarrow> c) F"
   unfolding tendsto_iff by simp
 
 lemma tendsto_add_const_iff:
   "((\<lambda>x. c + f x :: 'a::real_normed_vector) \<longlongrightarrow> c + d) F \<longleftrightarrow> (f \<longlongrightarrow> d) F"
   using tendsto_add[OF tendsto_const[of c], of f d]
     and tendsto_add[OF tendsto_const[of "-c"], of "\<lambda>x. c + f x" "c + d"] by auto
 
 
 class topological_monoid_mult = topological_semigroup_mult + monoid_mult
 class topological_comm_monoid_mult = topological_monoid_mult + comm_monoid_mult
 
 lemma tendsto_power_strong [tendsto_intros]:
   fixes f :: "_ \<Rightarrow> 'b :: topological_monoid_mult"
   assumes "(f \<longlongrightarrow> a) F" "(g \<longlongrightarrow> b) F"
   shows   "((\<lambda>x. f x ^ g x) \<longlongrightarrow> a ^ b) F"
 proof -
   have "((\<lambda>x. f x ^ b) \<longlongrightarrow> a ^ b) F"
     by (induction b) (auto intro: tendsto_intros assms)
   also from assms(2) have "eventually (\<lambda>x. g x = b) F"
     by (simp add: nhds_discrete filterlim_principal)
   hence "eventually (\<lambda>x. f x ^ b = f x ^ g x) F"
     by eventually_elim simp
   hence "((\<lambda>x. f x ^ b) \<longlongrightarrow> a ^ b) F \<longleftrightarrow> ((\<lambda>x. f x ^ g x) \<longlongrightarrow> a ^ b) F"
     by (intro filterlim_cong refl)
   finally show ?thesis .
 qed
 
 lemma continuous_mult' [continuous_intros]:
   fixes f g :: "_ \<Rightarrow> 'b::topological_semigroup_mult"
   shows "continuous F f \<Longrightarrow> continuous F g \<Longrightarrow> continuous F (\<lambda>x. f x * g x)"
   unfolding continuous_def by (rule tendsto_mult)
 
 lemma continuous_power' [continuous_intros]:
   fixes f :: "_ \<Rightarrow> 'b::topological_monoid_mult"
   shows "continuous F f \<Longrightarrow> continuous F g \<Longrightarrow> continuous F (\<lambda>x. f x ^ g x)"
   unfolding continuous_def by (rule tendsto_power_strong) auto
 
 lemma continuous_on_mult' [continuous_intros]:
   fixes f g :: "_ \<Rightarrow> 'b::topological_semigroup_mult"
   shows "continuous_on A f \<Longrightarrow> continuous_on A g \<Longrightarrow> continuous_on A (\<lambda>x. f x * g x)"
   unfolding continuous_on_def by (auto intro: tendsto_mult)
 
 lemma continuous_on_power' [continuous_intros]:
   fixes f :: "_ \<Rightarrow> 'b::topological_monoid_mult"
   shows "continuous_on A f \<Longrightarrow> continuous_on A g \<Longrightarrow> continuous_on A (\<lambda>x. f x ^ g x)"
   unfolding continuous_on_def by (auto intro: tendsto_power_strong)
 
 lemma tendsto_mult_one:
   fixes f g :: "_ \<Rightarrow> 'b::topological_monoid_mult"
   shows "(f \<longlongrightarrow> 1) F \<Longrightarrow> (g \<longlongrightarrow> 1) F \<Longrightarrow> ((\<lambda>x. f x * g x) \<longlongrightarrow> 1) F"
   by (drule (1) tendsto_mult) simp
 
 lemma tendsto_prod' [tendsto_intros]:
   fixes f :: "'a \<Rightarrow> 'b \<Rightarrow> 'c::topological_comm_monoid_mult"
   shows "(\<And>i. i \<in> I \<Longrightarrow> (f i \<longlongrightarrow> a i) F) \<Longrightarrow> ((\<lambda>x. \<Prod>i\<in>I. f i x) \<longlongrightarrow> (\<Prod>i\<in>I. a i)) F"
   by (induct I rule: infinite_finite_induct) (simp_all add: tendsto_mult)
 
 lemma tendsto_one_prod':
   fixes f :: "'a \<Rightarrow> 'b \<Rightarrow> 'c::topological_comm_monoid_mult"
   assumes "\<And>i. i \<in> I \<Longrightarrow> ((\<lambda>x. f x i) \<longlongrightarrow> 1) F"
   shows "((\<lambda>i. prod (f i) I) \<longlongrightarrow> 1) F"
   using tendsto_prod' [of I "\<lambda>x y. f y x" "\<lambda>x. 1"] assms by simp
 
 lemma continuous_prod' [continuous_intros]:
   fixes f :: "'a \<Rightarrow> 'b::t2_space \<Rightarrow> 'c::topological_comm_monoid_mult"
   shows "(\<And>i. i \<in> I \<Longrightarrow> continuous F (f i)) \<Longrightarrow> continuous F (\<lambda>x. \<Prod>i\<in>I. f i x)"
   unfolding continuous_def by (rule tendsto_prod')
 
 lemma continuous_on_prod' [continuous_intros]:
   fixes f :: "'a \<Rightarrow> 'b::topological_space \<Rightarrow> 'c::topological_comm_monoid_mult"
   shows "(\<And>i. i \<in> I \<Longrightarrow> continuous_on S (f i)) \<Longrightarrow> continuous_on S (\<lambda>x. \<Prod>i\<in>I. f i x)"
   unfolding continuous_on_def by (auto intro: tendsto_prod')
 
 instance nat :: topological_comm_monoid_mult
   by standard
     (simp add: nhds_discrete principal_prod_principal filterlim_principal eventually_principal)
 
 instance int :: topological_comm_monoid_mult
   by standard
     (simp add: nhds_discrete principal_prod_principal filterlim_principal eventually_principal)
 
 class comm_real_normed_algebra_1 = real_normed_algebra_1 + comm_monoid_mult
 
 context real_normed_field
 begin
 
 subclass comm_real_normed_algebra_1
 proof
   from norm_mult[of "1 :: 'a" 1] show "norm 1 = 1" by simp 
 qed (simp_all add: norm_mult)
 
 end
 
 subsubsection \<open>Inverse and division\<close>
 
 lemma (in bounded_bilinear) Zfun_prod_Bfun:
   assumes f: "Zfun f F"
     and g: "Bfun g F"
   shows "Zfun (\<lambda>x. f x ** g x) F"
 proof -
   obtain K where K: "0 \<le> K"
     and norm_le: "\<And>x y. norm (x ** y) \<le> norm x * norm y * K"
     using nonneg_bounded by blast
   obtain B where B: "0 < B"
     and norm_g: "eventually (\<lambda>x. norm (g x) \<le> B) F"
     using g by (rule BfunE)
   have "eventually (\<lambda>x. norm (f x ** g x) \<le> norm (f x) * (B * K)) F"
   using norm_g proof eventually_elim
     case (elim x)
     have "norm (f x ** g x) \<le> norm (f x) * norm (g x) * K"
       by (rule norm_le)
     also have "\<dots> \<le> norm (f x) * B * K"
       by (intro mult_mono' order_refl norm_g norm_ge_zero mult_nonneg_nonneg K elim)
     also have "\<dots> = norm (f x) * (B * K)"
       by (rule mult.assoc)
     finally show "norm (f x ** g x) \<le> norm (f x) * (B * K)" .
   qed
   with f show ?thesis
     by (rule Zfun_imp_Zfun)
 qed
 
 lemma (in bounded_bilinear) Bfun_prod_Zfun:
   assumes f: "Bfun f F"
     and g: "Zfun g F"
   shows "Zfun (\<lambda>x. f x ** g x) F"
   using flip g f by (rule bounded_bilinear.Zfun_prod_Bfun)
 
 lemma Bfun_inverse:
   fixes a :: "'a::real_normed_div_algebra"
   assumes f: "(f \<longlongrightarrow> a) F"
   assumes a: "a \<noteq> 0"
   shows "Bfun (\<lambda>x. inverse (f x)) F"
 proof -
   from a have "0 < norm a" by simp
   then have "\<exists>r>0. r < norm a" by (rule dense)
   then obtain r where r1: "0 < r" and r2: "r < norm a"
     by blast
   have "eventually (\<lambda>x. dist (f x) a < r) F"
     using tendstoD [OF f r1] by blast
   then have "eventually (\<lambda>x. norm (inverse (f x)) \<le> inverse (norm a - r)) F"
   proof eventually_elim
     case (elim x)
     then have 1: "norm (f x - a) < r"
       by (simp add: dist_norm)
     then have 2: "f x \<noteq> 0" using r2 by auto
     then have "norm (inverse (f x)) = inverse (norm (f x))"
       by (rule nonzero_norm_inverse)
     also have "\<dots> \<le> inverse (norm a - r)"
     proof (rule le_imp_inverse_le)
       show "0 < norm a - r"
         using r2 by simp
       have "norm a - norm (f x) \<le> norm (a - f x)"
         by (rule norm_triangle_ineq2)
       also have "\<dots> = norm (f x - a)"
         by (rule norm_minus_commute)
       also have "\<dots> < r" using 1 .
       finally show "norm a - r \<le> norm (f x)"
         by simp
     qed
     finally show "norm (inverse (f x)) \<le> inverse (norm a - r)" .
   qed
   then show ?thesis by (rule BfunI)
 qed
 
 lemma tendsto_inverse [tendsto_intros]:
   fixes a :: "'a::real_normed_div_algebra"
   assumes f: "(f \<longlongrightarrow> a) F"
     and a: "a \<noteq> 0"
   shows "((\<lambda>x. inverse (f x)) \<longlongrightarrow> inverse a) F"
 proof -
   from a have "0 < norm a" by simp
   with f have "eventually (\<lambda>x. dist (f x) a < norm a) F"
     by (rule tendstoD)
   then have "eventually (\<lambda>x. f x \<noteq> 0) F"
     unfolding dist_norm by (auto elim!: eventually_mono)
   with a have "eventually (\<lambda>x. inverse (f x) - inverse a =
     - (inverse (f x) * (f x - a) * inverse a)) F"
     by (auto elim!: eventually_mono simp: inverse_diff_inverse)
   moreover have "Zfun (\<lambda>x. - (inverse (f x) * (f x - a) * inverse a)) F"
     by (intro Zfun_minus Zfun_mult_left
       bounded_bilinear.Bfun_prod_Zfun [OF bounded_bilinear_mult]
       Bfun_inverse [OF f a] f [unfolded tendsto_Zfun_iff])
   ultimately show ?thesis
     unfolding tendsto_Zfun_iff by (rule Zfun_ssubst)
 qed
 
 lemma continuous_inverse:
   fixes f :: "'a::t2_space \<Rightarrow> 'b::real_normed_div_algebra"
   assumes "continuous F f"
     and "f (Lim F (\<lambda>x. x)) \<noteq> 0"
   shows "continuous F (\<lambda>x. inverse (f x))"
   using assms unfolding continuous_def by (rule tendsto_inverse)
 
 lemma continuous_at_within_inverse[continuous_intros]:
   fixes f :: "'a::t2_space \<Rightarrow> 'b::real_normed_div_algebra"
   assumes "continuous (at a within s) f"
     and "f a \<noteq> 0"
   shows "continuous (at a within s) (\<lambda>x. inverse (f x))"
   using assms unfolding continuous_within by (rule tendsto_inverse)
 
 lemma continuous_on_inverse[continuous_intros]:
   fixes f :: "'a::topological_space \<Rightarrow> 'b::real_normed_div_algebra"
   assumes "continuous_on s f"
     and "\<forall>x\<in>s. f x \<noteq> 0"
   shows "continuous_on s (\<lambda>x. inverse (f x))"
   using assms unfolding continuous_on_def by (blast intro: tendsto_inverse)
 
 lemma tendsto_divide [tendsto_intros]:
   fixes a b :: "'a::real_normed_field"
   shows "(f \<longlongrightarrow> a) F \<Longrightarrow> (g \<longlongrightarrow> b) F \<Longrightarrow> b \<noteq> 0 \<Longrightarrow> ((\<lambda>x. f x / g x) \<longlongrightarrow> a / b) F"
   by (simp add: tendsto_mult tendsto_inverse divide_inverse)
 
 lemma continuous_divide:
   fixes f g :: "'a::t2_space \<Rightarrow> 'b::real_normed_field"
   assumes "continuous F f"
     and "continuous F g"
     and "g (Lim F (\<lambda>x. x)) \<noteq> 0"
   shows "continuous F (\<lambda>x. (f x) / (g x))"
   using assms unfolding continuous_def by (rule tendsto_divide)
 
 lemma continuous_at_within_divide[continuous_intros]:
   fixes f g :: "'a::t2_space \<Rightarrow> 'b::real_normed_field"
   assumes "continuous (at a within s) f" "continuous (at a within s) g"
     and "g a \<noteq> 0"
   shows "continuous (at a within s) (\<lambda>x. (f x) / (g x))"
   using assms unfolding continuous_within by (rule tendsto_divide)
 
 lemma isCont_divide[continuous_intros, simp]:
   fixes f g :: "'a::t2_space \<Rightarrow> 'b::real_normed_field"
   assumes "isCont f a" "isCont g a" "g a \<noteq> 0"
   shows "isCont (\<lambda>x. (f x) / g x) a"
   using assms unfolding continuous_at by (rule tendsto_divide)
 
 lemma continuous_on_divide[continuous_intros]:
   fixes f :: "'a::topological_space \<Rightarrow> 'b::real_normed_field"
   assumes "continuous_on s f" "continuous_on s g"
     and "\<forall>x\<in>s. g x \<noteq> 0"
   shows "continuous_on s (\<lambda>x. (f x) / (g x))"
   using assms unfolding continuous_on_def by (blast intro: tendsto_divide)
 
 lemma tendsto_sgn [tendsto_intros]: "(f \<longlongrightarrow> l) F \<Longrightarrow> l \<noteq> 0 \<Longrightarrow> ((\<lambda>x. sgn (f x)) \<longlongrightarrow> sgn l) F"
   for l :: "'a::real_normed_vector"
   unfolding sgn_div_norm by (simp add: tendsto_intros)
 
 lemma continuous_sgn:
   fixes f :: "'a::t2_space \<Rightarrow> 'b::real_normed_vector"
   assumes "continuous F f"
     and "f (Lim F (\<lambda>x. x)) \<noteq> 0"
   shows "continuous F (\<lambda>x. sgn (f x))"
   using assms unfolding continuous_def by (rule tendsto_sgn)
 
 lemma continuous_at_within_sgn[continuous_intros]:
   fixes f :: "'a::t2_space \<Rightarrow> 'b::real_normed_vector"
   assumes "continuous (at a within s) f"
     and "f a \<noteq> 0"
   shows "continuous (at a within s) (\<lambda>x. sgn (f x))"
   using assms unfolding continuous_within by (rule tendsto_sgn)
 
 lemma isCont_sgn[continuous_intros]:
   fixes f :: "'a::t2_space \<Rightarrow> 'b::real_normed_vector"
   assumes "isCont f a"
     and "f a \<noteq> 0"
   shows "isCont (\<lambda>x. sgn (f x)) a"
   using assms unfolding continuous_at by (rule tendsto_sgn)
 
 lemma continuous_on_sgn[continuous_intros]:
   fixes f :: "'a::topological_space \<Rightarrow> 'b::real_normed_vector"
   assumes "continuous_on s f"
     and "\<forall>x\<in>s. f x \<noteq> 0"
   shows "continuous_on s (\<lambda>x. sgn (f x))"
   using assms unfolding continuous_on_def by (blast intro: tendsto_sgn)
 
 lemma filterlim_at_infinity:
   fixes f :: "_ \<Rightarrow> 'a::real_normed_vector"
   assumes "0 \<le> c"
   shows "(LIM x F. f x :> at_infinity) \<longleftrightarrow> (\<forall>r>c. eventually (\<lambda>x. r \<le> norm (f x)) F)"
   unfolding filterlim_iff eventually_at_infinity
 proof safe
   fix P :: "'a \<Rightarrow> bool"
   fix b
   assume *: "\<forall>r>c. eventually (\<lambda>x. r \<le> norm (f x)) F"
   assume P: "\<forall>x. b \<le> norm x \<longrightarrow> P x"
   have "max b (c + 1) > c" by auto
   with * have "eventually (\<lambda>x. max b (c + 1) \<le> norm (f x)) F"
     by auto
   then show "eventually (\<lambda>x. P (f x)) F"
   proof eventually_elim
     case (elim x)
     with P show "P (f x)" by auto
   qed
 qed force
 
 lemma filterlim_at_infinity_imp_norm_at_top:
   fixes F
   assumes "filterlim f at_infinity F"
   shows   "filterlim (\<lambda>x. norm (f x)) at_top F"
 proof -
   {
     fix r :: real
     have "\<forall>\<^sub>F x in F. r \<le> norm (f x)" using filterlim_at_infinity[of 0 f F] assms
       by (cases "r > 0")
          (auto simp: not_less intro: always_eventually order.trans[OF _ norm_ge_zero])
   }
   thus ?thesis by (auto simp: filterlim_at_top)
 qed
 
 lemma filterlim_norm_at_top_imp_at_infinity:
   fixes F
   assumes "filterlim (\<lambda>x. norm (f x)) at_top F"
   shows   "filterlim f at_infinity F"
   using filterlim_at_infinity[of 0 f F] assms by (auto simp: filterlim_at_top)
 
 lemma filterlim_norm_at_top: "filterlim norm at_top at_infinity"
   by (rule filterlim_at_infinity_imp_norm_at_top) (rule filterlim_ident)
 
 lemma filterlim_at_infinity_conv_norm_at_top:
   "filterlim f at_infinity G \<longleftrightarrow> filterlim (\<lambda>x. norm (f x)) at_top G"
   by (auto simp: filterlim_at_infinity[OF order.refl] filterlim_at_top_gt[of _ _ 0])
 
 lemma eventually_not_equal_at_infinity:
   "eventually (\<lambda>x. x \<noteq> (a :: 'a :: {real_normed_vector})) at_infinity"
 proof -
   from filterlim_norm_at_top[where 'a = 'a]
     have "\<forall>\<^sub>F x in at_infinity. norm a < norm (x::'a)" by (auto simp: filterlim_at_top_dense)
   thus ?thesis by eventually_elim auto
 qed
 
 lemma filterlim_int_of_nat_at_topD:
   fixes F
   assumes "filterlim (\<lambda>x. f (int x)) F at_top"
   shows   "filterlim f F at_top"
 proof -
   have "filterlim (\<lambda>x. f (int (nat x))) F at_top"
     by (rule filterlim_compose[OF assms filterlim_nat_sequentially])
   also have "?this \<longleftrightarrow> filterlim f F at_top"
     by (intro filterlim_cong refl eventually_mono [OF eventually_ge_at_top[of "0::int"]]) auto
   finally show ?thesis .
 qed
 
 lemma filterlim_int_sequentially [tendsto_intros]:
   "filterlim int at_top sequentially"
   unfolding filterlim_at_top
 proof
   fix C :: int
   show "eventually (\<lambda>n. int n \<ge> C) at_top"
     using eventually_ge_at_top[of "nat \<lceil>C\<rceil>"] by eventually_elim linarith
 qed
 
 lemma filterlim_real_of_int_at_top [tendsto_intros]:
   "filterlim real_of_int at_top at_top"
   unfolding filterlim_at_top
 proof
   fix C :: real
   show "eventually (\<lambda>n. real_of_int n \<ge> C) at_top"
     using eventually_ge_at_top[of "\<lceil>C\<rceil>"] by eventually_elim linarith
 qed
 
 lemma filterlim_abs_real: "filterlim (abs::real \<Rightarrow> real) at_top at_top"
 proof (subst filterlim_cong[OF refl refl])
   from eventually_ge_at_top[of "0::real"] show "eventually (\<lambda>x::real. \<bar>x\<bar> = x) at_top"
     by eventually_elim simp
 qed (simp_all add: filterlim_ident)
 
 lemma filterlim_of_real_at_infinity [tendsto_intros]:
   "filterlim (of_real :: real \<Rightarrow> 'a :: real_normed_algebra_1) at_infinity at_top"
   by (intro filterlim_norm_at_top_imp_at_infinity) (auto simp: filterlim_abs_real)
 
 lemma not_tendsto_and_filterlim_at_infinity:
   fixes c :: "'a::real_normed_vector"
   assumes "F \<noteq> bot"
     and "(f \<longlongrightarrow> c) F"
     and "filterlim f at_infinity F"
   shows False
 proof -
   from tendstoD[OF assms(2), of "1/2"]
   have "eventually (\<lambda>x. dist (f x) c < 1/2) F"
     by simp
   moreover
   from filterlim_at_infinity[of "norm c" f F] assms(3)
   have "eventually (\<lambda>x. norm (f x) \<ge> norm c + 1) F" by simp
   ultimately have "eventually (\<lambda>x. False) F"
   proof eventually_elim
     fix x
     assume A: "dist (f x) c < 1/2"
     assume "norm (f x) \<ge> norm c + 1"
     also have "norm (f x) = dist (f x) 0" by simp
     also have "\<dots> \<le> dist (f x) c + dist c 0" by (rule dist_triangle)
     finally show False using A by simp
   qed
   with assms show False by simp
 qed
 
 lemma filterlim_at_infinity_imp_not_convergent:
   assumes "filterlim f at_infinity sequentially"
   shows "\<not> convergent f"
   by (rule notI, rule not_tendsto_and_filterlim_at_infinity[OF _ _ assms])
      (simp_all add: convergent_LIMSEQ_iff)
 
 lemma filterlim_at_infinity_imp_eventually_ne:
   assumes "filterlim f at_infinity F"
   shows "eventually (\<lambda>z. f z \<noteq> c) F"
 proof -
   have "norm c + 1 > 0"
     by (intro add_nonneg_pos) simp_all
   with filterlim_at_infinity[OF order.refl, of f F] assms
   have "eventually (\<lambda>z. norm (f z) \<ge> norm c + 1) F"
     by blast
   then show ?thesis
     by eventually_elim auto
 qed
 
 lemma tendsto_of_nat [tendsto_intros]:
   "filterlim (of_nat :: nat \<Rightarrow> 'a::real_normed_algebra_1) at_infinity sequentially"
 proof (subst filterlim_at_infinity[OF order.refl], intro allI impI)
   fix r :: real
   assume r: "r > 0"
   define n where "n = nat \<lceil>r\<rceil>"
   from r have n: "\<forall>m\<ge>n. of_nat m \<ge> r"
     unfolding n_def by linarith
   from eventually_ge_at_top[of n] show "eventually (\<lambda>m. norm (of_nat m :: 'a) \<ge> r) sequentially"
     by eventually_elim (use n in simp_all)
 qed
 
 
 subsection \<open>Relate \<^const>\<open>at\<close>, \<^const>\<open>at_left\<close> and \<^const>\<open>at_right\<close>\<close>
 
 text \<open>
   This lemmas are useful for conversion between \<^term>\<open>at x\<close> to \<^term>\<open>at_left x\<close> and
   \<^term>\<open>at_right x\<close> and also \<^term>\<open>at_right 0\<close>.
 \<close>
 
 lemmas filterlim_split_at_real = filterlim_split_at[where 'a=real]
 
 lemma filtermap_nhds_shift: "filtermap (\<lambda>x. x - d) (nhds a) = nhds (a - d)"
   for a d :: "'a::real_normed_vector"
   by (rule filtermap_fun_inverse[where g="\<lambda>x. x + d"])
     (auto intro!: tendsto_eq_intros filterlim_ident)
 
 lemma filtermap_nhds_minus: "filtermap (\<lambda>x. - x) (nhds a) = nhds (- a)"
   for a :: "'a::real_normed_vector"
   by (rule filtermap_fun_inverse[where g=uminus])
     (auto intro!: tendsto_eq_intros filterlim_ident)
 
 lemma filtermap_at_shift: "filtermap (\<lambda>x. x - d) (at a) = at (a - d)"
   for a d :: "'a::real_normed_vector"
   by (simp add: filter_eq_iff eventually_filtermap eventually_at_filter filtermap_nhds_shift[symmetric])
 
 lemma filtermap_at_right_shift: "filtermap (\<lambda>x. x - d) (at_right a) = at_right (a - d)"
   for a d :: "real"
   by (simp add: filter_eq_iff eventually_filtermap eventually_at_filter filtermap_nhds_shift[symmetric])
 
 lemma at_right_to_0: "at_right a = filtermap (\<lambda>x. x + a) (at_right 0)"
   for a :: real
   using filtermap_at_right_shift[of "-a" 0] by simp
 
 lemma filterlim_at_right_to_0:
   "filterlim f F (at_right a) \<longleftrightarrow> filterlim (\<lambda>x. f (x + a)) F (at_right 0)"
   for a :: real
   unfolding filterlim_def filtermap_filtermap at_right_to_0[of a] ..
 
 lemma eventually_at_right_to_0:
   "eventually P (at_right a) \<longleftrightarrow> eventually (\<lambda>x. P (x + a)) (at_right 0)"
   for a :: real
   unfolding at_right_to_0[of a] by (simp add: eventually_filtermap)
 
 lemma at_to_0: "at a = filtermap (\<lambda>x. x + a) (at 0)"
   for a :: "'a::real_normed_vector"
   using filtermap_at_shift[of "-a" 0] by simp
 
 lemma filterlim_at_to_0:
   "filterlim f F (at a) \<longleftrightarrow> filterlim (\<lambda>x. f (x + a)) F (at 0)"
   for a :: "'a::real_normed_vector"
   unfolding filterlim_def filtermap_filtermap at_to_0[of a] ..
 
 lemma eventually_at_to_0:
   "eventually P (at a) \<longleftrightarrow> eventually (\<lambda>x. P (x + a)) (at 0)"
   for a ::  "'a::real_normed_vector"
   unfolding at_to_0[of a] by (simp add: eventually_filtermap)
 
 lemma filtermap_at_minus: "filtermap (\<lambda>x. - x) (at a) = at (- a)"
   for a :: "'a::real_normed_vector"
   by (simp add: filter_eq_iff eventually_filtermap eventually_at_filter filtermap_nhds_minus[symmetric])
 
 lemma at_left_minus: "at_left a = filtermap (\<lambda>x. - x) (at_right (- a))"
   for a :: real
   by (simp add: filter_eq_iff eventually_filtermap eventually_at_filter filtermap_nhds_minus[symmetric])
 
 lemma at_right_minus: "at_right a = filtermap (\<lambda>x. - x) (at_left (- a))"
   for a :: real
   by (simp add: filter_eq_iff eventually_filtermap eventually_at_filter filtermap_nhds_minus[symmetric])
 
 
 lemma filterlim_at_left_to_right:
   "filterlim f F (at_left a) \<longleftrightarrow> filterlim (\<lambda>x. f (- x)) F (at_right (-a))"
   for a :: real
   unfolding filterlim_def filtermap_filtermap at_left_minus[of a] ..
 
 lemma eventually_at_left_to_right:
   "eventually P (at_left a) \<longleftrightarrow> eventually (\<lambda>x. P (- x)) (at_right (-a))"
   for a :: real
   unfolding at_left_minus[of a] by (simp add: eventually_filtermap)
 
 lemma filterlim_uminus_at_top_at_bot: "LIM x at_bot. - x :: real :> at_top"
   unfolding filterlim_at_top eventually_at_bot_dense
   by (metis leI minus_less_iff order_less_asym)
 
 lemma filterlim_uminus_at_bot_at_top: "LIM x at_top. - x :: real :> at_bot"
   unfolding filterlim_at_bot eventually_at_top_dense
   by (metis leI less_minus_iff order_less_asym)
 
 lemma at_bot_mirror :
   shows "(at_bot::('a::{ordered_ab_group_add,linorder} filter)) = filtermap uminus at_top"
   apply (rule filtermap_fun_inverse[of uminus, symmetric])
   subgoal unfolding filterlim_at_top filterlim_at_bot eventually_at_bot_linorder using le_minus_iff by auto
   subgoal unfolding filterlim_at_bot eventually_at_top_linorder using minus_le_iff by auto
   by auto
 
 lemma at_top_mirror :
   shows "(at_top::('a::{ordered_ab_group_add,linorder} filter)) = filtermap uminus at_bot"
   apply (subst at_bot_mirror)
   by (auto simp: filtermap_filtermap)
 
 lemma filterlim_at_top_mirror: "(LIM x at_top. f x :> F) \<longleftrightarrow> (LIM x at_bot. f (-x::real) :> F)"
   unfolding filterlim_def at_top_mirror filtermap_filtermap ..
 
 lemma filterlim_at_bot_mirror: "(LIM x at_bot. f x :> F) \<longleftrightarrow> (LIM x at_top. f (-x::real) :> F)"
   unfolding filterlim_def at_bot_mirror filtermap_filtermap ..
 
 lemma filterlim_uminus_at_top: "(LIM x F. f x :> at_top) \<longleftrightarrow> (LIM x F. - (f x) :: real :> at_bot)"
   using filterlim_compose[OF filterlim_uminus_at_bot_at_top, of f F]
     and filterlim_compose[OF filterlim_uminus_at_top_at_bot, of "\<lambda>x. - f x" F]
   by auto
 
 lemma tendsto_at_botI_sequentially:
   fixes f :: "real \<Rightarrow> 'b::first_countable_topology"
   assumes *: "\<And>X. filterlim X at_bot sequentially \<Longrightarrow> (\<lambda>n. f (X n)) \<longlonglongrightarrow> y"
   shows "(f \<longlongrightarrow> y) at_bot"
   unfolding filterlim_at_bot_mirror
 proof (rule tendsto_at_topI_sequentially)
   fix X :: "nat \<Rightarrow> real" assume "filterlim X at_top sequentially"
   thus "(\<lambda>n. f (-X n)) \<longlonglongrightarrow> y" by (intro *) (auto simp: filterlim_uminus_at_top)
 qed
 
 lemma filterlim_at_infinity_imp_filterlim_at_top:
   assumes "filterlim (f :: 'a \<Rightarrow> real) at_infinity F"
   assumes "eventually (\<lambda>x. f x > 0) F"
   shows   "filterlim f at_top F"
 proof -
   from assms(2) have *: "eventually (\<lambda>x. norm (f x) = f x) F" by eventually_elim simp
   from assms(1) show ?thesis unfolding filterlim_at_infinity_conv_norm_at_top
     by (subst (asm) filterlim_cong[OF refl refl *])
 qed
 
 lemma filterlim_at_infinity_imp_filterlim_at_bot:
   assumes "filterlim (f :: 'a \<Rightarrow> real) at_infinity F"
   assumes "eventually (\<lambda>x. f x < 0) F"
   shows   "filterlim f at_bot F"
 proof -
   from assms(2) have *: "eventually (\<lambda>x. norm (f x) = -f x) F" by eventually_elim simp
   from assms(1) have "filterlim (\<lambda>x. - f x) at_top F"
     unfolding filterlim_at_infinity_conv_norm_at_top
     by (subst (asm) filterlim_cong[OF refl refl *])
   thus ?thesis by (simp add: filterlim_uminus_at_top)
 qed
 
 lemma filterlim_uminus_at_bot: "(LIM x F. f x :> at_bot) \<longleftrightarrow> (LIM x F. - (f x) :: real :> at_top)"
   unfolding filterlim_uminus_at_top by simp
 
 lemma filterlim_inverse_at_top_right: "LIM x at_right (0::real). inverse x :> at_top"
   unfolding filterlim_at_top_gt[where c=0] eventually_at_filter
 proof safe
   fix Z :: real
   assume [arith]: "0 < Z"
   then have "eventually (\<lambda>x. x < inverse Z) (nhds 0)"
     by (auto simp: eventually_nhds_metric dist_real_def intro!: exI[of _ "\<bar>inverse Z\<bar>"])
   then show "eventually (\<lambda>x. x \<noteq> 0 \<longrightarrow> x \<in> {0<..} \<longrightarrow> Z \<le> inverse x) (nhds 0)"
     by (auto elim!: eventually_mono simp: inverse_eq_divide field_simps)
 qed
 
 lemma tendsto_inverse_0:
   fixes x :: "_ \<Rightarrow> 'a::real_normed_div_algebra"
   shows "(inverse \<longlongrightarrow> (0::'a)) at_infinity"
   unfolding tendsto_Zfun_iff diff_0_right Zfun_def eventually_at_infinity
 proof safe
   fix r :: real
   assume "0 < r"
   show "\<exists>b. \<forall>x. b \<le> norm x \<longrightarrow> norm (inverse x :: 'a) < r"
   proof (intro exI[of _ "inverse (r / 2)"] allI impI)
     fix x :: 'a
     from \<open>0 < r\<close> have "0 < inverse (r / 2)" by simp
     also assume *: "inverse (r / 2) \<le> norm x"
     finally show "norm (inverse x) < r"
       using * \<open>0 < r\<close>
       by (subst nonzero_norm_inverse) (simp_all add: inverse_eq_divide field_simps)
   qed
 qed
 
 lemma tendsto_add_filterlim_at_infinity:
   fixes c :: "'b::real_normed_vector"
     and F :: "'a filter"
   assumes "(f \<longlongrightarrow> c) F"
     and "filterlim g at_infinity F"
   shows "filterlim (\<lambda>x. f x + g x) at_infinity F"
 proof (subst filterlim_at_infinity[OF order_refl], safe)
   fix r :: real
   assume r: "r > 0"
   from assms(1) have "((\<lambda>x. norm (f x)) \<longlongrightarrow> norm c) F"
     by (rule tendsto_norm)
   then have "eventually (\<lambda>x. norm (f x) < norm c + 1) F"
     by (rule order_tendstoD) simp_all
   moreover from r have "r + norm c + 1 > 0"
     by (intro add_pos_nonneg) simp_all
   with assms(2) have "eventually (\<lambda>x. norm (g x) \<ge> r + norm c + 1) F"
     unfolding filterlim_at_infinity[OF order_refl]
     by (elim allE[of _ "r + norm c + 1"]) simp_all
   ultimately show "eventually (\<lambda>x. norm (f x + g x) \<ge> r) F"
   proof eventually_elim
     fix x :: 'a
     assume A: "norm (f x) < norm c + 1" and B: "r + norm c + 1 \<le> norm (g x)"
     from A B have "r \<le> norm (g x) - norm (f x)"
       by simp
     also have "norm (g x) - norm (f x) \<le> norm (g x + f x)"
       by (rule norm_diff_ineq)
     finally show "r \<le> norm (f x + g x)"
       by (simp add: add_ac)
   qed
 qed
 
 lemma tendsto_add_filterlim_at_infinity':
   fixes c :: "'b::real_normed_vector"
     and F :: "'a filter"
   assumes "filterlim f at_infinity F"
     and "(g \<longlongrightarrow> c) F"
   shows "filterlim (\<lambda>x. f x + g x) at_infinity F"
   by (subst add.commute) (rule tendsto_add_filterlim_at_infinity assms)+
 
 lemma filterlim_inverse_at_right_top: "LIM x at_top. inverse x :> at_right (0::real)"
   unfolding filterlim_at
   by (auto simp: eventually_at_top_dense)
      (metis tendsto_inverse_0 filterlim_mono at_top_le_at_infinity order_refl)
 
 lemma filterlim_inverse_at_top:
   "(f \<longlongrightarrow> (0 :: real)) F \<Longrightarrow> eventually (\<lambda>x. 0 < f x) F \<Longrightarrow> LIM x F. inverse (f x) :> at_top"
   by (intro filterlim_compose[OF filterlim_inverse_at_top_right])
      (simp add: filterlim_def eventually_filtermap eventually_mono at_within_def le_principal)
 
 lemma filterlim_inverse_at_bot_neg:
   "LIM x (at_left (0::real)). inverse x :> at_bot"
   by (simp add: filterlim_inverse_at_top_right filterlim_uminus_at_bot filterlim_at_left_to_right)
 
 lemma filterlim_inverse_at_bot:
   "(f \<longlongrightarrow> (0 :: real)) F \<Longrightarrow> eventually (\<lambda>x. f x < 0) F \<Longrightarrow> LIM x F. inverse (f x) :> at_bot"
   unfolding filterlim_uminus_at_bot inverse_minus_eq[symmetric]
   by (rule filterlim_inverse_at_top) (simp_all add: tendsto_minus_cancel_left[symmetric])
 
 lemma at_right_to_top: "(at_right (0::real)) = filtermap inverse at_top"
   by (intro filtermap_fun_inverse[symmetric, where g=inverse])
      (auto intro: filterlim_inverse_at_top_right filterlim_inverse_at_right_top)
 
 lemma eventually_at_right_to_top:
   "eventually P (at_right (0::real)) \<longleftrightarrow> eventually (\<lambda>x. P (inverse x)) at_top"
   unfolding at_right_to_top eventually_filtermap ..
 
 lemma filterlim_at_right_to_top:
   "filterlim f F (at_right (0::real)) \<longleftrightarrow> (LIM x at_top. f (inverse x) :> F)"
   unfolding filterlim_def at_right_to_top filtermap_filtermap ..
 
 lemma at_top_to_right: "at_top = filtermap inverse (at_right (0::real))"
   unfolding at_right_to_top filtermap_filtermap inverse_inverse_eq filtermap_ident ..
 
 lemma eventually_at_top_to_right:
   "eventually P at_top \<longleftrightarrow> eventually (\<lambda>x. P (inverse x)) (at_right (0::real))"
   unfolding at_top_to_right eventually_filtermap ..
 
 lemma filterlim_at_top_to_right:
   "filterlim f F at_top \<longleftrightarrow> (LIM x (at_right (0::real)). f (inverse x) :> F)"
   unfolding filterlim_def at_top_to_right filtermap_filtermap ..
 
 lemma filterlim_inverse_at_infinity:
   fixes x :: "_ \<Rightarrow> 'a::{real_normed_div_algebra, division_ring}"
   shows "filterlim inverse at_infinity (at (0::'a))"
   unfolding filterlim_at_infinity[OF order_refl]
 proof safe
   fix r :: real
   assume "0 < r"
   then show "eventually (\<lambda>x::'a. r \<le> norm (inverse x)) (at 0)"
     unfolding eventually_at norm_inverse
     by (intro exI[of _ "inverse r"])
        (auto simp: norm_conv_dist[symmetric] field_simps inverse_eq_divide)
 qed
 
 lemma filterlim_inverse_at_iff:
   fixes g :: "'a \<Rightarrow> 'b::{real_normed_div_algebra, division_ring}"
   shows "(LIM x F. inverse (g x) :> at 0) \<longleftrightarrow> (LIM x F. g x :> at_infinity)"
   unfolding filterlim_def filtermap_filtermap[symmetric]
 proof
   assume "filtermap g F \<le> at_infinity"
   then have "filtermap inverse (filtermap g F) \<le> filtermap inverse at_infinity"
     by (rule filtermap_mono)
   also have "\<dots> \<le> at 0"
     using tendsto_inverse_0[where 'a='b]
     by (auto intro!: exI[of _ 1]
         simp: le_principal eventually_filtermap filterlim_def at_within_def eventually_at_infinity)
   finally show "filtermap inverse (filtermap g F) \<le> at 0" .
 next
   assume "filtermap inverse (filtermap g F) \<le> at 0"
   then have "filtermap inverse (filtermap inverse (filtermap g F)) \<le> filtermap inverse (at 0)"
     by (rule filtermap_mono)
   with filterlim_inverse_at_infinity show "filtermap g F \<le> at_infinity"
     by (auto intro: order_trans simp: filterlim_def filtermap_filtermap)
 qed
 
 lemma tendsto_mult_filterlim_at_infinity:
   fixes c :: "'a::real_normed_field"
   assumes  "(f \<longlongrightarrow> c) F" "c \<noteq> 0"
   assumes "filterlim g at_infinity F"
   shows "filterlim (\<lambda>x. f x * g x) at_infinity F"
 proof -
   have "((\<lambda>x. inverse (f x) * inverse (g x)) \<longlongrightarrow> inverse c * 0) F"
     by (intro tendsto_mult tendsto_inverse assms filterlim_compose[OF tendsto_inverse_0])
   then have "filterlim (\<lambda>x. inverse (f x) * inverse (g x)) (at (inverse c * 0)) F"
     unfolding filterlim_at
     using assms
     by (auto intro: filterlim_at_infinity_imp_eventually_ne tendsto_imp_eventually_ne eventually_conj)
   then show ?thesis
     by (subst filterlim_inverse_at_iff[symmetric]) simp_all
 qed
 
 lemma tendsto_inverse_0_at_top: "LIM x F. f x :> at_top \<Longrightarrow> ((\<lambda>x. inverse (f x) :: real) \<longlongrightarrow> 0) F"
  by (metis filterlim_at filterlim_mono[OF _ at_top_le_at_infinity order_refl] filterlim_inverse_at_iff)
 
 lemma real_tendsto_divide_at_top:
   fixes c::"real"
   assumes "(f \<longlongrightarrow> c) F"
   assumes "filterlim g at_top F"
   shows "((\<lambda>x. f x / g x) \<longlongrightarrow> 0) F"
   by (auto simp: divide_inverse_commute
       intro!: tendsto_mult[THEN tendsto_eq_rhs] tendsto_inverse_0_at_top assms)
 
 lemma mult_nat_left_at_top: "c > 0 \<Longrightarrow> filterlim (\<lambda>x. c * x) at_top sequentially"
   for c :: nat
   by (rule filterlim_subseq) (auto simp: strict_mono_def)
 
 lemma mult_nat_right_at_top: "c > 0 \<Longrightarrow> filterlim (\<lambda>x. x * c) at_top sequentially"
   for c :: nat
   by (rule filterlim_subseq) (auto simp: strict_mono_def)
 
 lemma filterlim_times_pos:
   "LIM x F1. c * f x :> at_right l"
   if "filterlim f (at_right p) F1" "0 < c" "l = c * p"
   for c::"'a::{linordered_field, linorder_topology}"
   unfolding filterlim_iff
 proof safe
   fix P
   assume "\<forall>\<^sub>F x in at_right l. P x"
   then obtain d where "c * p < d" "\<And>y. y > c * p \<Longrightarrow> y < d \<Longrightarrow> P y"
     unfolding \<open>l = _ \<close> eventually_at_right_field
     by auto
   then have "\<forall>\<^sub>F a in at_right p. P (c * a)"
     by (auto simp: eventually_at_right_field \<open>0 < c\<close> field_simps intro!: exI[where x="d/c"])
   from that(1)[unfolded filterlim_iff, rule_format, OF this]
   show "\<forall>\<^sub>F x in F1. P (c * f x)" .
 qed
 
 lemma filtermap_nhds_times: "c \<noteq> 0 \<Longrightarrow> filtermap (times c) (nhds a) = nhds (c * a)"
   for a c :: "'a::real_normed_field"
   by (rule filtermap_fun_inverse[where g="\<lambda>x. inverse c * x"])
     (auto intro!: tendsto_eq_intros filterlim_ident)
 
 lemma filtermap_times_pos_at_right:
   fixes c::"'a::{linordered_field, linorder_topology}"
   assumes "c > 0"
   shows "filtermap (times c) (at_right p) = at_right (c * p)"
   using assms
   by (intro filtermap_fun_inverse[where g="\<lambda>x. inverse c * x"])
     (auto intro!: filterlim_ident filterlim_times_pos)
 
 lemma at_to_infinity: "(at (0::'a::{real_normed_field,field})) = filtermap inverse at_infinity"
 proof (rule antisym)
   have "(inverse \<longlongrightarrow> (0::'a)) at_infinity"
     by (fact tendsto_inverse_0)
   then show "filtermap inverse at_infinity \<le> at (0::'a)"
     using filterlim_def filterlim_ident filterlim_inverse_at_iff by fastforce
 next
   have "filtermap inverse (filtermap inverse (at (0::'a))) \<le> filtermap inverse at_infinity"
     using filterlim_inverse_at_infinity unfolding filterlim_def
     by (rule filtermap_mono)
   then show "at (0::'a) \<le> filtermap inverse at_infinity"
     by (simp add: filtermap_ident filtermap_filtermap)
 qed
 
 lemma lim_at_infinity_0:
   fixes l :: "'a::{real_normed_field,field}"
   shows "(f \<longlongrightarrow> l) at_infinity \<longleftrightarrow> ((f \<circ> inverse) \<longlongrightarrow> l) (at (0::'a))"
   by (simp add: tendsto_compose_filtermap at_to_infinity filtermap_filtermap)
 
 lemma lim_zero_infinity:
   fixes l :: "'a::{real_normed_field,field}"
   shows "((\<lambda>x. f(1 / x)) \<longlongrightarrow> l) (at (0::'a)) \<Longrightarrow> (f \<longlongrightarrow> l) at_infinity"
   by (simp add: inverse_eq_divide lim_at_infinity_0 comp_def)
 
 
 text \<open>
   We only show rules for multiplication and addition when the functions are either against a real
   value or against infinity. Further rules are easy to derive by using @{thm
   filterlim_uminus_at_top}.
 \<close>
 
 lemma filterlim_tendsto_pos_mult_at_top:
   assumes f: "(f \<longlongrightarrow> c) F"
     and c: "0 < c"
     and g: "LIM x F. g x :> at_top"
   shows "LIM x F. (f x * g x :: real) :> at_top"
   unfolding filterlim_at_top_gt[where c=0]
 proof safe
   fix Z :: real
   assume "0 < Z"
   from f \<open>0 < c\<close> have "eventually (\<lambda>x. c / 2 < f x) F"
     by (auto dest!: tendstoD[where e="c / 2"] elim!: eventually_mono
         simp: dist_real_def abs_real_def split: if_split_asm)
   moreover from g have "eventually (\<lambda>x. (Z / c * 2) \<le> g x) F"
     unfolding filterlim_at_top by auto
   ultimately show "eventually (\<lambda>x. Z \<le> f x * g x) F"
   proof eventually_elim
     case (elim x)
     with \<open>0 < Z\<close> \<open>0 < c\<close> have "c / 2 * (Z / c * 2) \<le> f x * g x"
       by (intro mult_mono) (auto simp: zero_le_divide_iff)
     with \<open>0 < c\<close> show "Z \<le> f x * g x"
        by simp
   qed
 qed
 
 lemma filterlim_at_top_mult_at_top:
   assumes f: "LIM x F. f x :> at_top"
     and g: "LIM x F. g x :> at_top"
   shows "LIM x F. (f x * g x :: real) :> at_top"
   unfolding filterlim_at_top_gt[where c=0]
 proof safe
   fix Z :: real
   assume "0 < Z"
   from f have "eventually (\<lambda>x. 1 \<le> f x) F"
     unfolding filterlim_at_top by auto
   moreover from g have "eventually (\<lambda>x. Z \<le> g x) F"
     unfolding filterlim_at_top by auto
   ultimately show "eventually (\<lambda>x. Z \<le> f x * g x) F"
   proof eventually_elim
     case (elim x)
     with \<open>0 < Z\<close> have "1 * Z \<le> f x * g x"
       by (intro mult_mono) (auto simp: zero_le_divide_iff)
     then show "Z \<le> f x * g x"
        by simp
   qed
 qed
 
 lemma filterlim_at_top_mult_tendsto_pos:
   assumes f: "(f \<longlongrightarrow> c) F"
     and c: "0 < c"
     and g: "LIM x F. g x :> at_top"
   shows "LIM x F. (g x * f x:: real) :> at_top"
   by (auto simp: mult.commute intro!: filterlim_tendsto_pos_mult_at_top f c g)
 
 lemma filterlim_tendsto_pos_mult_at_bot:
   fixes c :: real
   assumes "(f \<longlongrightarrow> c) F" "0 < c" "filterlim g at_bot F"
   shows "LIM x F. f x * g x :> at_bot"
   using filterlim_tendsto_pos_mult_at_top[OF assms(1,2), of "\<lambda>x. - g x"] assms(3)
   unfolding filterlim_uminus_at_bot by simp
 
 lemma filterlim_tendsto_neg_mult_at_bot:
   fixes c :: real
   assumes c: "(f \<longlongrightarrow> c) F" "c < 0" and g: "filterlim g at_top F"
   shows "LIM x F. f x * g x :> at_bot"
   using c filterlim_tendsto_pos_mult_at_top[of "\<lambda>x. - f x" "- c" F, OF _ _ g]
   unfolding filterlim_uminus_at_bot tendsto_minus_cancel_left by simp
 
 lemma filterlim_pow_at_top:
   fixes f :: "'a \<Rightarrow> real"
   assumes "0 < n"
     and f: "LIM x F. f x :> at_top"
   shows "LIM x F. (f x)^n :: real :> at_top"
   using \<open>0 < n\<close>
 proof (induct n)
   case 0
   then show ?case by simp
 next
   case (Suc n) with f show ?case
     by (cases "n = 0") (auto intro!: filterlim_at_top_mult_at_top)
 qed
 
 lemma filterlim_pow_at_bot_even:
   fixes f :: "real \<Rightarrow> real"
   shows "0 < n \<Longrightarrow> LIM x F. f x :> at_bot \<Longrightarrow> even n \<Longrightarrow> LIM x F. (f x)^n :> at_top"
   using filterlim_pow_at_top[of n "\<lambda>x. - f x" F] by (simp add: filterlim_uminus_at_top)
 
 lemma filterlim_pow_at_bot_odd:
   fixes f :: "real \<Rightarrow> real"
   shows "0 < n \<Longrightarrow> LIM x F. f x :> at_bot \<Longrightarrow> odd n \<Longrightarrow> LIM x F. (f x)^n :> at_bot"
   using filterlim_pow_at_top[of n "\<lambda>x. - f x" F] by (simp add: filterlim_uminus_at_bot)
 
 lemma filterlim_power_at_infinity [tendsto_intros]:
   fixes F and f :: "'a \<Rightarrow> 'b :: real_normed_div_algebra"
   assumes "filterlim f at_infinity F" "n > 0"
   shows   "filterlim (\<lambda>x. f x ^ n) at_infinity F"
   by (rule filterlim_norm_at_top_imp_at_infinity)
      (auto simp: norm_power intro!: filterlim_pow_at_top assms
            intro: filterlim_at_infinity_imp_norm_at_top)
 
 lemma filterlim_tendsto_add_at_top:
   assumes f: "(f \<longlongrightarrow> c) F"
     and g: "LIM x F. g x :> at_top"
   shows "LIM x F. (f x + g x :: real) :> at_top"
   unfolding filterlim_at_top_gt[where c=0]
 proof safe
   fix Z :: real
   assume "0 < Z"
   from f have "eventually (\<lambda>x. c - 1 < f x) F"
     by (auto dest!: tendstoD[where e=1] elim!: eventually_mono simp: dist_real_def)
   moreover from g have "eventually (\<lambda>x. Z - (c - 1) \<le> g x) F"
     unfolding filterlim_at_top by auto
   ultimately show "eventually (\<lambda>x. Z \<le> f x + g x) F"
     by eventually_elim simp
 qed
 
 lemma LIM_at_top_divide:
   fixes f g :: "'a \<Rightarrow> real"
   assumes f: "(f \<longlongrightarrow> a) F" "0 < a"
     and g: "(g \<longlongrightarrow> 0) F" "eventually (\<lambda>x. 0 < g x) F"
   shows "LIM x F. f x / g x :> at_top"
   unfolding divide_inverse
   by (rule filterlim_tendsto_pos_mult_at_top[OF f]) (rule filterlim_inverse_at_top[OF g])
 
 lemma filterlim_at_top_add_at_top:
   assumes f: "LIM x F. f x :> at_top"
     and g: "LIM x F. g x :> at_top"
   shows "LIM x F. (f x + g x :: real) :> at_top"
   unfolding filterlim_at_top_gt[where c=0]
 proof safe
   fix Z :: real
   assume "0 < Z"
   from f have "eventually (\<lambda>x. 0 \<le> f x) F"
     unfolding filterlim_at_top by auto
   moreover from g have "eventually (\<lambda>x. Z \<le> g x) F"
     unfolding filterlim_at_top by auto
   ultimately show "eventually (\<lambda>x. Z \<le> f x + g x) F"
     by eventually_elim simp
 qed
 
 lemma tendsto_divide_0:
   fixes f :: "_ \<Rightarrow> 'a::{real_normed_div_algebra, division_ring}"
   assumes f: "(f \<longlongrightarrow> c) F"
     and g: "LIM x F. g x :> at_infinity"
   shows "((\<lambda>x. f x / g x) \<longlongrightarrow> 0) F"
   using tendsto_mult[OF f filterlim_compose[OF tendsto_inverse_0 g]]
   by (simp add: divide_inverse)
 
 lemma linear_plus_1_le_power:
   fixes x :: real
   assumes x: "0 \<le> x"
   shows "real n * x + 1 \<le> (x + 1) ^ n"
 proof (induct n)
   case 0
   then show ?case by simp
 next
   case (Suc n)
   from x have "real (Suc n) * x + 1 \<le> (x + 1) * (real n * x + 1)"
     by (simp add: field_simps)
   also have "\<dots> \<le> (x + 1)^Suc n"
     using Suc x by (simp add: mult_left_mono)
   finally show ?case .
 qed
 
 lemma filterlim_realpow_sequentially_gt1:
   fixes x :: "'a :: real_normed_div_algebra"
   assumes x[arith]: "1 < norm x"
   shows "LIM n sequentially. x ^ n :> at_infinity"
 proof (intro filterlim_at_infinity[THEN iffD2] allI impI)
   fix y :: real
   assume "0 < y"
   have "0 < norm x - 1" by simp
   then obtain N :: nat where "y < real N * (norm x - 1)"
     by (blast dest: reals_Archimedean3)
   also have "\<dots> \<le> real N * (norm x - 1) + 1"
     by simp
   also have "\<dots> \<le> (norm x - 1 + 1) ^ N"
     by (rule linear_plus_1_le_power) simp
   also have "\<dots> = norm x ^ N"
     by simp
   finally have "\<forall>n\<ge>N. y \<le> norm x ^ n"
     by (metis order_less_le_trans power_increasing order_less_imp_le x)
   then show "eventually (\<lambda>n. y \<le> norm (x ^ n)) sequentially"
     unfolding eventually_sequentially
     by (auto simp: norm_power)
 qed simp
 
 
 lemma filterlim_divide_at_infinity:
   fixes f g :: "'a \<Rightarrow> 'a :: real_normed_field"
   assumes "filterlim f (nhds c) F" "filterlim g (at 0) F" "c \<noteq> 0"
   shows   "filterlim (\<lambda>x. f x / g x) at_infinity F"
 proof -
   have "filterlim (\<lambda>x. f x * inverse (g x)) at_infinity F"
     by (intro tendsto_mult_filterlim_at_infinity[OF assms(1,3)]
           filterlim_compose [OF filterlim_inverse_at_infinity assms(2)])
   thus ?thesis by (simp add: field_simps)
 qed
 
 subsection \<open>Floor and Ceiling\<close>
 
 lemma eventually_floor_less:
   fixes f :: "'a \<Rightarrow> 'b::{order_topology,floor_ceiling}"
   assumes f: "(f \<longlongrightarrow> l) F"
     and l: "l \<notin> \<int>"
   shows "\<forall>\<^sub>F x in F. of_int (floor l) < f x"
   by (intro order_tendstoD[OF f]) (metis Ints_of_int antisym_conv2 floor_correct l)
 
 lemma eventually_less_ceiling:
   fixes f :: "'a \<Rightarrow> 'b::{order_topology,floor_ceiling}"
   assumes f: "(f \<longlongrightarrow> l) F"
     and l: "l \<notin> \<int>"
   shows "\<forall>\<^sub>F x in F. f x < of_int (ceiling l)"
   by (intro order_tendstoD[OF f]) (metis Ints_of_int l le_of_int_ceiling less_le)
 
 lemma eventually_floor_eq:
   fixes f::"'a \<Rightarrow> 'b::{order_topology,floor_ceiling}"
   assumes f: "(f \<longlongrightarrow> l) F"
     and l: "l \<notin> \<int>"
   shows "\<forall>\<^sub>F x in F. floor (f x) = floor l"
   using eventually_floor_less[OF assms] eventually_less_ceiling[OF assms]
   by eventually_elim (meson floor_less_iff less_ceiling_iff not_less_iff_gr_or_eq)
 
 lemma eventually_ceiling_eq:
   fixes f::"'a \<Rightarrow> 'b::{order_topology,floor_ceiling}"
   assumes f: "(f \<longlongrightarrow> l) F"
     and l: "l \<notin> \<int>"
   shows "\<forall>\<^sub>F x in F. ceiling (f x) = ceiling l"
   using eventually_floor_less[OF assms] eventually_less_ceiling[OF assms]
   by eventually_elim (meson floor_less_iff less_ceiling_iff not_less_iff_gr_or_eq)
 
 lemma tendsto_of_int_floor:
   fixes f::"'a \<Rightarrow> 'b::{order_topology,floor_ceiling}"
   assumes "(f \<longlongrightarrow> l) F"
     and "l \<notin> \<int>"
   shows "((\<lambda>x. of_int (floor (f x)) :: 'c::{ring_1,topological_space}) \<longlongrightarrow> of_int (floor l)) F"
   using eventually_floor_eq[OF assms]
   by (simp add: eventually_mono topological_tendstoI)
 
 lemma tendsto_of_int_ceiling:
   fixes f::"'a \<Rightarrow> 'b::{order_topology,floor_ceiling}"
   assumes "(f \<longlongrightarrow> l) F"
     and "l \<notin> \<int>"
   shows "((\<lambda>x. of_int (ceiling (f x)):: 'c::{ring_1,topological_space}) \<longlongrightarrow> of_int (ceiling l)) F"
   using eventually_ceiling_eq[OF assms]
   by (simp add: eventually_mono topological_tendstoI)
 
 lemma continuous_on_of_int_floor:
   "continuous_on (UNIV - \<int>::'a::{order_topology, floor_ceiling} set)
     (\<lambda>x. of_int (floor x)::'b::{ring_1, topological_space})"
   unfolding continuous_on_def
   by (auto intro!: tendsto_of_int_floor)
 
 lemma continuous_on_of_int_ceiling:
   "continuous_on (UNIV - \<int>::'a::{order_topology, floor_ceiling} set)
     (\<lambda>x. of_int (ceiling x)::'b::{ring_1, topological_space})"
   unfolding continuous_on_def
   by (auto intro!: tendsto_of_int_ceiling)
 
 
 subsection \<open>Limits of Sequences\<close>
 
 lemma [trans]: "X = Y \<Longrightarrow> Y \<longlonglongrightarrow> z \<Longrightarrow> X \<longlonglongrightarrow> z"
   by simp
 
 lemma LIMSEQ_iff:
   fixes L :: "'a::real_normed_vector"
   shows "(X \<longlonglongrightarrow> L) = (\<forall>r>0. \<exists>no. \<forall>n \<ge> no. norm (X n - L) < r)"
 unfolding lim_sequentially dist_norm ..
 
 lemma LIMSEQ_I: "(\<And>r. 0 < r \<Longrightarrow> \<exists>no. \<forall>n\<ge>no. norm (X n - L) < r) \<Longrightarrow> X \<longlonglongrightarrow> L"
   for L :: "'a::real_normed_vector"
   by (simp add: LIMSEQ_iff)
 
 lemma LIMSEQ_D: "X \<longlonglongrightarrow> L \<Longrightarrow> 0 < r \<Longrightarrow> \<exists>no. \<forall>n\<ge>no. norm (X n - L) < r"
   for L :: "'a::real_normed_vector"
   by (simp add: LIMSEQ_iff)
 
 lemma LIMSEQ_linear: "X \<longlonglongrightarrow> x \<Longrightarrow> l > 0 \<Longrightarrow> (\<lambda> n. X (n * l)) \<longlonglongrightarrow> x"
   unfolding tendsto_def eventually_sequentially
   by (metis div_le_dividend div_mult_self1_is_m le_trans mult.commute)
 
 
 text \<open>Transformation of limit.\<close>
 
 lemma Lim_transform: "(g \<longlongrightarrow> a) F \<Longrightarrow> ((\<lambda>x. f x - g x) \<longlongrightarrow> 0) F \<Longrightarrow> (f \<longlongrightarrow> a) F"
   for a b :: "'a::real_normed_vector"
   using tendsto_add [of g a F "\<lambda>x. f x - g x" 0] by simp
 
 lemma Lim_transform2: "(f \<longlongrightarrow> a) F \<Longrightarrow> ((\<lambda>x. f x - g x) \<longlongrightarrow> 0) F \<Longrightarrow> (g \<longlongrightarrow> a) F"
   for a b :: "'a::real_normed_vector"
   by (erule Lim_transform) (simp add: tendsto_minus_cancel)
 
 proposition Lim_transform_eq: "((\<lambda>x. f x - g x) \<longlongrightarrow> 0) F \<Longrightarrow> (f \<longlongrightarrow> a) F \<longleftrightarrow> (g \<longlongrightarrow> a) F"
   for a :: "'a::real_normed_vector"
   using Lim_transform Lim_transform2 by blast
 
 lemma Lim_transform_eventually:
   "\<lbrakk>(f \<longlongrightarrow> l) F; eventually (\<lambda>x. f x = g x) F\<rbrakk> \<Longrightarrow> (g \<longlongrightarrow> l) F"
   using eventually_elim2 by (fastforce simp add: tendsto_def)
 
 lemma Lim_transform_within:
   assumes "(f \<longlongrightarrow> l) (at x within S)"
     and "0 < d"
     and "\<And>x'. x'\<in>S \<Longrightarrow> 0 < dist x' x \<Longrightarrow> dist x' x < d \<Longrightarrow> f x' = g x'"
   shows "(g \<longlongrightarrow> l) (at x within S)"
 proof (rule Lim_transform_eventually)
   show "eventually (\<lambda>x. f x = g x) (at x within S)"
     using assms by (auto simp: eventually_at)
   show "(f \<longlongrightarrow> l) (at x within S)"
     by fact
 qed
 
 lemma filterlim_transform_within:
   assumes "filterlim g G (at x within S)"
   assumes "G \<le> F" "0<d" "(\<And>x'. x' \<in> S \<Longrightarrow> 0 < dist x' x \<Longrightarrow> dist x' x < d \<Longrightarrow> f x' = g x') "
   shows "filterlim f F (at x within S)"
   using assms
   apply (elim filterlim_mono_eventually)
   unfolding eventually_at by auto
 
 text \<open>Common case assuming being away from some crucial point like 0.\<close>
 lemma Lim_transform_away_within:
   fixes a b :: "'a::t1_space"
   assumes "a \<noteq> b"
     and "\<forall>x\<in>S. x \<noteq> a \<and> x \<noteq> b \<longrightarrow> f x = g x"
     and "(f \<longlongrightarrow> l) (at a within S)"
   shows "(g \<longlongrightarrow> l) (at a within S)"
 proof (rule Lim_transform_eventually)
   show "(f \<longlongrightarrow> l) (at a within S)"
     by fact
   show "eventually (\<lambda>x. f x = g x) (at a within S)"
     unfolding eventually_at_topological
     by (rule exI [where x="- {b}"]) (simp add: open_Compl assms)
 qed
 
 lemma Lim_transform_away_at:
   fixes a b :: "'a::t1_space"
   assumes ab: "a \<noteq> b"
     and fg: "\<forall>x. x \<noteq> a \<and> x \<noteq> b \<longrightarrow> f x = g x"
     and fl: "(f \<longlongrightarrow> l) (at a)"
   shows "(g \<longlongrightarrow> l) (at a)"
   using Lim_transform_away_within[OF ab, of UNIV f g l] fg fl by simp
 
 text \<open>Alternatively, within an open set.\<close>
 lemma Lim_transform_within_open:
   assumes "(f \<longlongrightarrow> l) (at a within T)"
     and "open s" and "a \<in> s"
     and "\<And>x. x\<in>s \<Longrightarrow> x \<noteq> a \<Longrightarrow> f x = g x"
   shows "(g \<longlongrightarrow> l) (at a within T)"
 proof (rule Lim_transform_eventually)
   show "eventually (\<lambda>x. f x = g x) (at a within T)"
     unfolding eventually_at_topological
     using assms by auto
   show "(f \<longlongrightarrow> l) (at a within T)" by fact
 qed
 
 
 text \<open>A congruence rule allowing us to transform limits assuming not at point.\<close>
 
 (* FIXME: Only one congruence rule for tendsto can be used at a time! *)
 
 lemma Lim_cong_within(*[cong add]*):
   assumes "a = b"
     and "x = y"
     and "S = T"
     and "\<And>x. x \<noteq> b \<Longrightarrow> x \<in> T \<Longrightarrow> f x = g x"
   shows "(f \<longlongrightarrow> x) (at a within S) \<longleftrightarrow> (g \<longlongrightarrow> y) (at b within T)"
   unfolding tendsto_def eventually_at_topological
   using assms by simp
 
 lemma Lim_cong_at(*[cong add]*):
   assumes "a = b" "x = y"
     and "\<And>x. x \<noteq> a \<Longrightarrow> f x = g x"
   shows "((\<lambda>x. f x) \<longlongrightarrow> x) (at a) \<longleftrightarrow> ((g \<longlongrightarrow> y) (at a))"
   unfolding tendsto_def eventually_at_topological
   using assms by simp
 
 text \<open>An unbounded sequence's inverse tends to 0.\<close>
 lemma LIMSEQ_inverse_zero:
   assumes "\<And>r::real. \<exists>N. \<forall>n\<ge>N. r < X n"
   shows "(\<lambda>n. inverse (X n)) \<longlonglongrightarrow> 0"
   apply (rule filterlim_compose[OF tendsto_inverse_0])
   by (metis assms eventually_at_top_linorderI filterlim_at_top_dense filterlim_at_top_imp_at_infinity)
 
 text \<open>The sequence \<^term>\<open>1/n\<close> tends to 0 as \<^term>\<open>n\<close> tends to infinity.\<close>
 lemma LIMSEQ_inverse_real_of_nat: "(\<lambda>n. inverse (real (Suc n))) \<longlonglongrightarrow> 0"
   by (metis filterlim_compose tendsto_inverse_0 filterlim_mono order_refl filterlim_Suc
       filterlim_compose[OF filterlim_real_sequentially] at_top_le_at_infinity)
 
 text \<open>
   The sequence \<^term>\<open>r + 1/n\<close> tends to \<^term>\<open>r\<close> as \<^term>\<open>n\<close> tends to
   infinity is now easily proved.
 \<close>
 
 lemma LIMSEQ_inverse_real_of_nat_add: "(\<lambda>n. r + inverse (real (Suc n))) \<longlonglongrightarrow> r"
   using tendsto_add [OF tendsto_const LIMSEQ_inverse_real_of_nat] by auto
 
 lemma LIMSEQ_inverse_real_of_nat_add_minus: "(\<lambda>n. r + -inverse (real (Suc n))) \<longlonglongrightarrow> r"
   using tendsto_add [OF tendsto_const tendsto_minus [OF LIMSEQ_inverse_real_of_nat]]
   by auto
 
 lemma LIMSEQ_inverse_real_of_nat_add_minus_mult: "(\<lambda>n. r * (1 + - inverse (real (Suc n)))) \<longlonglongrightarrow> r"
   using tendsto_mult [OF tendsto_const LIMSEQ_inverse_real_of_nat_add_minus [of 1]]
   by auto
 
 lemma lim_inverse_n: "((\<lambda>n. inverse(of_nat n)) \<longlongrightarrow> (0::'a::real_normed_field)) sequentially"
   using lim_1_over_n by (simp add: inverse_eq_divide)
 
 lemma lim_inverse_n': "((\<lambda>n. 1 / n) \<longlongrightarrow> 0) sequentially"
   using lim_inverse_n
   by (simp add: inverse_eq_divide)
 
 lemma LIMSEQ_Suc_n_over_n: "(\<lambda>n. of_nat (Suc n) / of_nat n :: 'a :: real_normed_field) \<longlonglongrightarrow> 1"
 proof (rule Lim_transform_eventually)
   show "eventually (\<lambda>n. 1 + inverse (of_nat n :: 'a) = of_nat (Suc n) / of_nat n) sequentially"
     using eventually_gt_at_top[of "0::nat"]
     by eventually_elim (simp add: field_simps)
   have "(\<lambda>n. 1 + inverse (of_nat n) :: 'a) \<longlonglongrightarrow> 1 + 0"
     by (intro tendsto_add tendsto_const lim_inverse_n)
   then show "(\<lambda>n. 1 + inverse (of_nat n) :: 'a) \<longlonglongrightarrow> 1"
     by simp
 qed
 
 lemma LIMSEQ_n_over_Suc_n: "(\<lambda>n. of_nat n / of_nat (Suc n) :: 'a :: real_normed_field) \<longlonglongrightarrow> 1"
 proof (rule Lim_transform_eventually)
   show "eventually (\<lambda>n. inverse (of_nat (Suc n) / of_nat n :: 'a) =
       of_nat n / of_nat (Suc n)) sequentially"
     using eventually_gt_at_top[of "0::nat"]
     by eventually_elim (simp add: field_simps del: of_nat_Suc)
   have "(\<lambda>n. inverse (of_nat (Suc n) / of_nat n :: 'a)) \<longlonglongrightarrow> inverse 1"
     by (intro tendsto_inverse LIMSEQ_Suc_n_over_n) simp_all
   then show "(\<lambda>n. inverse (of_nat (Suc n) / of_nat n :: 'a)) \<longlonglongrightarrow> 1"
     by simp
 qed
 
 
 subsection \<open>Convergence on sequences\<close>
 
 lemma convergent_cong:
   assumes "eventually (\<lambda>x. f x = g x) sequentially"
   shows "convergent f \<longleftrightarrow> convergent g"
   unfolding convergent_def
   by (subst filterlim_cong[OF refl refl assms]) (rule refl)
 
 lemma convergent_Suc_iff: "convergent (\<lambda>n. f (Suc n)) \<longleftrightarrow> convergent f"
   by (auto simp: convergent_def LIMSEQ_Suc_iff)
 
 lemma convergent_ignore_initial_segment: "convergent (\<lambda>n. f (n + m)) = convergent f"
 proof (induct m arbitrary: f)
   case 0
   then show ?case by simp
 next
   case (Suc m)
   have "convergent (\<lambda>n. f (n + Suc m)) \<longleftrightarrow> convergent (\<lambda>n. f (Suc n + m))"
     by simp
   also have "\<dots> \<longleftrightarrow> convergent (\<lambda>n. f (n + m))"
     by (rule convergent_Suc_iff)
   also have "\<dots> \<longleftrightarrow> convergent f"
     by (rule Suc)
   finally show ?case .
 qed
 
 lemma convergent_add:
   fixes X Y :: "nat \<Rightarrow> 'a::topological_monoid_add"
   assumes "convergent (\<lambda>n. X n)"
     and "convergent (\<lambda>n. Y n)"
   shows "convergent (\<lambda>n. X n + Y n)"
   using assms unfolding convergent_def by (blast intro: tendsto_add)
 
 lemma convergent_sum:
   fixes X :: "'a \<Rightarrow> nat \<Rightarrow> 'b::topological_comm_monoid_add"
   shows "(\<And>i. i \<in> A \<Longrightarrow> convergent (\<lambda>n. X i n)) \<Longrightarrow> convergent (\<lambda>n. \<Sum>i\<in>A. X i n)"
   by (induct A rule: infinite_finite_induct) (simp_all add: convergent_const convergent_add)
 
 lemma (in bounded_linear) convergent:
   assumes "convergent (\<lambda>n. X n)"
   shows "convergent (\<lambda>n. f (X n))"
   using assms unfolding convergent_def by (blast intro: tendsto)
 
 lemma (in bounded_bilinear) convergent:
   assumes "convergent (\<lambda>n. X n)"
     and "convergent (\<lambda>n. Y n)"
   shows "convergent (\<lambda>n. X n ** Y n)"
   using assms unfolding convergent_def by (blast intro: tendsto)
 
 lemma convergent_minus_iff:
   fixes X :: "nat \<Rightarrow> 'a::topological_group_add"
   shows "convergent X \<longleftrightarrow> convergent (\<lambda>n. - X n)"
   unfolding convergent_def by (force dest: tendsto_minus)
 
 lemma convergent_diff:
   fixes X Y :: "nat \<Rightarrow> 'a::topological_group_add"
   assumes "convergent (\<lambda>n. X n)"
   assumes "convergent (\<lambda>n. Y n)"
   shows "convergent (\<lambda>n. X n - Y n)"
   using assms unfolding convergent_def by (blast intro: tendsto_diff)
 
 lemma convergent_norm:
   assumes "convergent f"
   shows "convergent (\<lambda>n. norm (f n))"
 proof -
   from assms have "f \<longlonglongrightarrow> lim f"
     by (simp add: convergent_LIMSEQ_iff)
   then have "(\<lambda>n. norm (f n)) \<longlonglongrightarrow> norm (lim f)"
     by (rule tendsto_norm)
   then show ?thesis
     by (auto simp: convergent_def)
 qed
 
 lemma convergent_of_real:
   "convergent f \<Longrightarrow> convergent (\<lambda>n. of_real (f n) :: 'a::real_normed_algebra_1)"
   unfolding convergent_def by (blast intro!: tendsto_of_real)
 
 lemma convergent_add_const_iff:
   "convergent (\<lambda>n. c + f n :: 'a::topological_ab_group_add) \<longleftrightarrow> convergent f"
 proof
   assume "convergent (\<lambda>n. c + f n)"
   from convergent_diff[OF this convergent_const[of c]] show "convergent f"
     by simp
 next
   assume "convergent f"
   from convergent_add[OF convergent_const[of c] this] show "convergent (\<lambda>n. c + f n)"
     by simp
 qed
 
 lemma convergent_add_const_right_iff:
   "convergent (\<lambda>n. f n + c :: 'a::topological_ab_group_add) \<longleftrightarrow> convergent f"
   using convergent_add_const_iff[of c f] by (simp add: add_ac)
 
 lemma convergent_diff_const_right_iff:
   "convergent (\<lambda>n. f n - c :: 'a::topological_ab_group_add) \<longleftrightarrow> convergent f"
   using convergent_add_const_right_iff[of f "-c"] by (simp add: add_ac)
 
 lemma convergent_mult:
   fixes X Y :: "nat \<Rightarrow> 'a::topological_semigroup_mult"
   assumes "convergent (\<lambda>n. X n)"
     and "convergent (\<lambda>n. Y n)"
   shows "convergent (\<lambda>n. X n * Y n)"
   using assms unfolding convergent_def by (blast intro: tendsto_mult)
 
 lemma convergent_mult_const_iff:
   assumes "c \<noteq> 0"
   shows "convergent (\<lambda>n. c * f n :: 'a::{field,topological_semigroup_mult}) \<longleftrightarrow> convergent f"
 proof
   assume "convergent (\<lambda>n. c * f n)"
   from assms convergent_mult[OF this convergent_const[of "inverse c"]]
     show "convergent f" by (simp add: field_simps)
 next
   assume "convergent f"
   from convergent_mult[OF convergent_const[of c] this] show "convergent (\<lambda>n. c * f n)"
     by simp
 qed
 
 lemma convergent_mult_const_right_iff:
   fixes c :: "'a::{field,topological_semigroup_mult}"
   assumes "c \<noteq> 0"
   shows "convergent (\<lambda>n. f n * c) \<longleftrightarrow> convergent f"
   using convergent_mult_const_iff[OF assms, of f] by (simp add: mult_ac)
 
 lemma convergent_imp_Bseq: "convergent f \<Longrightarrow> Bseq f"
   by (simp add: Cauchy_Bseq convergent_Cauchy)
 
 
 text \<open>A monotone sequence converges to its least upper bound.\<close>
 
 lemma LIMSEQ_incseq_SUP:
   fixes X :: "nat \<Rightarrow> 'a::{conditionally_complete_linorder,linorder_topology}"
   assumes u: "bdd_above (range X)"
     and X: "incseq X"
   shows "X \<longlonglongrightarrow> (SUP i. X i)"
   by (rule order_tendstoI)
     (auto simp: eventually_sequentially u less_cSUP_iff
       intro: X[THEN incseqD] less_le_trans cSUP_lessD[OF u])
 
 lemma LIMSEQ_decseq_INF:
   fixes X :: "nat \<Rightarrow> 'a::{conditionally_complete_linorder, linorder_topology}"
   assumes u: "bdd_below (range X)"
     and X: "decseq X"
   shows "X \<longlonglongrightarrow> (INF i. X i)"
   by (rule order_tendstoI)
      (auto simp: eventually_sequentially u cINF_less_iff
        intro: X[THEN decseqD] le_less_trans less_cINF_D[OF u])
 
 text \<open>Main monotonicity theorem.\<close>
 
 lemma Bseq_monoseq_convergent: "Bseq X \<Longrightarrow> monoseq X \<Longrightarrow> convergent X"
   for X :: "nat \<Rightarrow> real"
   by (auto simp: monoseq_iff convergent_def intro: LIMSEQ_decseq_INF LIMSEQ_incseq_SUP
       dest: Bseq_bdd_above Bseq_bdd_below)
 
 lemma Bseq_mono_convergent: "Bseq X \<Longrightarrow> (\<forall>m n. m \<le> n \<longrightarrow> X m \<le> X n) \<Longrightarrow> convergent X"
   for X :: "nat \<Rightarrow> real"
   by (auto intro!: Bseq_monoseq_convergent incseq_imp_monoseq simp: incseq_def)
 
 lemma monoseq_imp_convergent_iff_Bseq: "monoseq f \<Longrightarrow> convergent f \<longleftrightarrow> Bseq f"
   for f :: "nat \<Rightarrow> real"
   using Bseq_monoseq_convergent[of f] convergent_imp_Bseq[of f] by blast
 
 lemma Bseq_monoseq_convergent'_inc:
   fixes f :: "nat \<Rightarrow> real"
   shows "Bseq (\<lambda>n. f (n + M)) \<Longrightarrow> (\<And>m n. M \<le> m \<Longrightarrow> m \<le> n \<Longrightarrow> f m \<le> f n) \<Longrightarrow> convergent f"
   by (subst convergent_ignore_initial_segment [symmetric, of _ M])
      (auto intro!: Bseq_monoseq_convergent simp: monoseq_def)
 
 lemma Bseq_monoseq_convergent'_dec:
   fixes f :: "nat \<Rightarrow> real"
   shows "Bseq (\<lambda>n. f (n + M)) \<Longrightarrow> (\<And>m n. M \<le> m \<Longrightarrow> m \<le> n \<Longrightarrow> f m \<ge> f n) \<Longrightarrow> convergent f"
   by (subst convergent_ignore_initial_segment [symmetric, of _ M])
     (auto intro!: Bseq_monoseq_convergent simp: monoseq_def)
 
 lemma Cauchy_iff: "Cauchy X \<longleftrightarrow> (\<forall>e>0. \<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. norm (X m - X n) < e)"
   for X :: "nat \<Rightarrow> 'a::real_normed_vector"
   unfolding Cauchy_def dist_norm ..
 
 lemma CauchyI: "(\<And>e. 0 < e \<Longrightarrow> \<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. norm (X m - X n) < e) \<Longrightarrow> Cauchy X"
   for X :: "nat \<Rightarrow> 'a::real_normed_vector"
   by (simp add: Cauchy_iff)
 
 lemma CauchyD: "Cauchy X \<Longrightarrow> 0 < e \<Longrightarrow> \<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. norm (X m - X n) < e"
   for X :: "nat \<Rightarrow> 'a::real_normed_vector"
   by (simp add: Cauchy_iff)
 
 lemma incseq_convergent:
   fixes X :: "nat \<Rightarrow> real"
   assumes "incseq X"
     and "\<forall>i. X i \<le> B"
   obtains L where "X \<longlonglongrightarrow> L" "\<forall>i. X i \<le> L"
 proof atomize_elim
   from incseq_bounded[OF assms] \<open>incseq X\<close> Bseq_monoseq_convergent[of X]
   obtain L where "X \<longlonglongrightarrow> L"
     by (auto simp: convergent_def monoseq_def incseq_def)
   with \<open>incseq X\<close> show "\<exists>L. X \<longlonglongrightarrow> L \<and> (\<forall>i. X i \<le> L)"
     by (auto intro!: exI[of _ L] incseq_le)
 qed
 
 lemma decseq_convergent:
   fixes X :: "nat \<Rightarrow> real"
   assumes "decseq X"
     and "\<forall>i. B \<le> X i"
   obtains L where "X \<longlonglongrightarrow> L" "\<forall>i. L \<le> X i"
 proof atomize_elim
   from decseq_bounded[OF assms] \<open>decseq X\<close> Bseq_monoseq_convergent[of X]
   obtain L where "X \<longlonglongrightarrow> L"
     by (auto simp: convergent_def monoseq_def decseq_def)
   with \<open>decseq X\<close> show "\<exists>L. X \<longlonglongrightarrow> L \<and> (\<forall>i. L \<le> X i)"
     by (auto intro!: exI[of _ L] decseq_ge)
 qed
 
 lemma monoseq_convergent:
   fixes X :: "nat \<Rightarrow> real"
   assumes X: "monoseq X" and B: "\<And>i. \<bar>X i\<bar> \<le> B"
   obtains L where "X \<longlonglongrightarrow> L"
   using X unfolding monoseq_iff
 proof
   assume "incseq X"
   show thesis
     using abs_le_D1 [OF B] incseq_convergent [OF \<open>incseq X\<close>] that by meson
 next
   assume "decseq X"
   show thesis
     using decseq_convergent [OF \<open>decseq X\<close>] that
     by (metis B abs_le_iff add.inverse_inverse neg_le_iff_le)
 qed
 
 subsection \<open>Power Sequences\<close>
 
 lemma Bseq_realpow: "0 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> Bseq (\<lambda>n. x ^ n)"
   for x :: real
   by (metis decseq_bounded decseq_def power_decreasing zero_le_power)
 
 lemma monoseq_realpow: "0 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> monoseq (\<lambda>n. x ^ n)"
   for x :: real
   using monoseq_def power_decreasing by blast
 
 lemma convergent_realpow: "0 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> convergent (\<lambda>n. x ^ n)"
   for x :: real
   by (blast intro!: Bseq_monoseq_convergent Bseq_realpow monoseq_realpow)
 
 lemma LIMSEQ_inverse_realpow_zero: "1 < x \<Longrightarrow> (\<lambda>n. inverse (x ^ n)) \<longlonglongrightarrow> 0"
   for x :: real
   by (rule filterlim_compose[OF tendsto_inverse_0 filterlim_realpow_sequentially_gt1]) simp
 
 lemma LIMSEQ_realpow_zero:
   fixes x :: real
   assumes "0 \<le> x" "x < 1"
   shows "(\<lambda>n. x ^ n) \<longlonglongrightarrow> 0"
 proof (cases "x = 0")
   case False
   with \<open>0 \<le> x\<close> have x0: "0 < x" by simp
   then have "1 < inverse x"
     using \<open>x < 1\<close> by (rule one_less_inverse)
   then have "(\<lambda>n. inverse (inverse x ^ n)) \<longlonglongrightarrow> 0"
     by (rule LIMSEQ_inverse_realpow_zero)
   then show ?thesis by (simp add: power_inverse)
 next
   case True
   show ?thesis
     by (rule LIMSEQ_imp_Suc) (simp add: True)
 qed
 
 lemma LIMSEQ_power_zero [tendsto_intros]: "norm x < 1 \<Longrightarrow> (\<lambda>n. x ^ n) \<longlonglongrightarrow> 0"
   for x :: "'a::real_normed_algebra_1"
   apply (drule LIMSEQ_realpow_zero [OF norm_ge_zero])
   by (simp add: Zfun_le norm_power_ineq tendsto_Zfun_iff)
 
 lemma LIMSEQ_divide_realpow_zero: "1 < x \<Longrightarrow> (\<lambda>n. a / (x ^ n) :: real) \<longlonglongrightarrow> 0"
   by (rule tendsto_divide_0 [OF tendsto_const filterlim_realpow_sequentially_gt1]) simp
 
 lemma
   tendsto_power_zero:
   fixes x::"'a::real_normed_algebra_1"
   assumes "filterlim f at_top F"
   assumes "norm x < 1"
   shows "((\<lambda>y. x ^ (f y)) \<longlongrightarrow> 0) F"
 proof (rule tendstoI)
   fix e::real assume "0 < e"
   from tendstoD[OF LIMSEQ_power_zero[OF \<open>norm x < 1\<close>] \<open>0 < e\<close>]
   have "\<forall>\<^sub>F xa in sequentially. norm (x ^ xa) < e"
     by simp
   then obtain N where N: "norm (x ^ n) < e" if "n \<ge> N" for n
     by (auto simp: eventually_sequentially)
   have "\<forall>\<^sub>F i in F. f i \<ge> N"
     using \<open>filterlim f sequentially F\<close>
     by (simp add: filterlim_at_top)
   then show "\<forall>\<^sub>F i in F. dist (x ^ f i) 0 < e"
     by eventually_elim (auto simp: N)
 qed
 
 text \<open>Limit of \<^term>\<open>c^n\<close> for \<^term>\<open>\<bar>c\<bar> < 1\<close>.\<close>
 
 lemma LIMSEQ_abs_realpow_zero: "\<bar>c\<bar> < 1 \<Longrightarrow> (\<lambda>n. \<bar>c\<bar> ^ n :: real) \<longlonglongrightarrow> 0"
   by (rule LIMSEQ_realpow_zero [OF abs_ge_zero])
 
 lemma LIMSEQ_abs_realpow_zero2: "\<bar>c\<bar> < 1 \<Longrightarrow> (\<lambda>n. c ^ n :: real) \<longlonglongrightarrow> 0"
   by (rule LIMSEQ_power_zero) simp
 
 
 subsection \<open>Limits of Functions\<close>
 
 lemma LIM_eq: "f \<midarrow>a\<rightarrow> L = (\<forall>r>0. \<exists>s>0. \<forall>x. x \<noteq> a \<and> norm (x - a) < s \<longrightarrow> norm (f x - L) < r)"
   for a :: "'a::real_normed_vector" and L :: "'b::real_normed_vector"
   by (simp add: LIM_def dist_norm)
 
 lemma LIM_I:
   "(\<And>r. 0 < r \<Longrightarrow> \<exists>s>0. \<forall>x. x \<noteq> a \<and> norm (x - a) < s \<longrightarrow> norm (f x - L) < r) \<Longrightarrow> f \<midarrow>a\<rightarrow> L"
   for a :: "'a::real_normed_vector" and L :: "'b::real_normed_vector"
   by (simp add: LIM_eq)
 
 lemma LIM_D: "f \<midarrow>a\<rightarrow> L \<Longrightarrow> 0 < r \<Longrightarrow> \<exists>s>0.\<forall>x. x \<noteq> a \<and> norm (x - a) < s \<longrightarrow> norm (f x - L) < r"
   for a :: "'a::real_normed_vector" and L :: "'b::real_normed_vector"
   by (simp add: LIM_eq)
 
 lemma LIM_offset: "f \<midarrow>a\<rightarrow> L \<Longrightarrow> (\<lambda>x. f (x + k)) \<midarrow>(a - k)\<rightarrow> L"
   for a :: "'a::real_normed_vector"
   by (simp add: filtermap_at_shift[symmetric, of a k] filterlim_def filtermap_filtermap)
 
 lemma LIM_offset_zero: "f \<midarrow>a\<rightarrow> L \<Longrightarrow> (\<lambda>h. f (a + h)) \<midarrow>0\<rightarrow> L"
   for a :: "'a::real_normed_vector"
   by (drule LIM_offset [where k = a]) (simp add: add.commute)
 
 lemma LIM_offset_zero_cancel: "(\<lambda>h. f (a + h)) \<midarrow>0\<rightarrow> L \<Longrightarrow> f \<midarrow>a\<rightarrow> L"
   for a :: "'a::real_normed_vector"
   by (drule LIM_offset [where k = "- a"]) simp
 
 lemma LIM_offset_zero_iff: "f \<midarrow>a\<rightarrow> L \<longleftrightarrow> (\<lambda>h. f (a + h)) \<midarrow>0\<rightarrow> L"
   for f :: "'a :: real_normed_vector \<Rightarrow> _"
   using LIM_offset_zero_cancel[of f a L] LIM_offset_zero[of f L a] by auto
 
 lemma tendsto_offset_zero_iff:
   fixes f :: "'a :: real_normed_vector \<Rightarrow> _"
   assumes "a \<in> S" "open S"
   shows "(f \<longlongrightarrow> L) (at a within S) \<longleftrightarrow> ((\<lambda>h. f (a + h)) \<longlongrightarrow> L) (at 0)"
   by (metis LIM_offset_zero_iff assms tendsto_within_open)
 
 lemma LIM_zero: "(f \<longlongrightarrow> l) F \<Longrightarrow> ((\<lambda>x. f x - l) \<longlongrightarrow> 0) F"
   for f :: "'a \<Rightarrow> 'b::real_normed_vector"
   unfolding tendsto_iff dist_norm by simp
 
 lemma LIM_zero_cancel:
   fixes f :: "'a \<Rightarrow> 'b::real_normed_vector"
   shows "((\<lambda>x. f x - l) \<longlongrightarrow> 0) F \<Longrightarrow> (f \<longlongrightarrow> l) F"
 unfolding tendsto_iff dist_norm by simp
 
 lemma LIM_zero_iff: "((\<lambda>x. f x - l) \<longlongrightarrow> 0) F = (f \<longlongrightarrow> l) F"
   for f :: "'a \<Rightarrow> 'b::real_normed_vector"
   unfolding tendsto_iff dist_norm by simp
 
 lemma LIM_imp_LIM:
   fixes f :: "'a::topological_space \<Rightarrow> 'b::real_normed_vector"
   fixes g :: "'a::topological_space \<Rightarrow> 'c::real_normed_vector"
   assumes f: "f \<midarrow>a\<rightarrow> l"
     and le: "\<And>x. x \<noteq> a \<Longrightarrow> norm (g x - m) \<le> norm (f x - l)"
   shows "g \<midarrow>a\<rightarrow> m"
   by (rule metric_LIM_imp_LIM [OF f]) (simp add: dist_norm le)
 
 lemma LIM_equal2:
   fixes f g :: "'a::real_normed_vector \<Rightarrow> 'b::topological_space"
   assumes "0 < R"
     and "\<And>x. x \<noteq> a \<Longrightarrow> norm (x - a) < R \<Longrightarrow> f x = g x"
   shows "g \<midarrow>a\<rightarrow> l \<Longrightarrow> f \<midarrow>a\<rightarrow> l"
   by (rule metric_LIM_equal2 [OF _ assms]) (simp_all add: dist_norm)
 
 lemma LIM_compose2:
   fixes a :: "'a::real_normed_vector"
   assumes f: "f \<midarrow>a\<rightarrow> b"
     and g: "g \<midarrow>b\<rightarrow> c"
     and inj: "\<exists>d>0. \<forall>x. x \<noteq> a \<and> norm (x - a) < d \<longrightarrow> f x \<noteq> b"
   shows "(\<lambda>x. g (f x)) \<midarrow>a\<rightarrow> c"
   by (rule metric_LIM_compose2 [OF f g inj [folded dist_norm]])
 
 lemma real_LIM_sandwich_zero:
   fixes f g :: "'a::topological_space \<Rightarrow> real"
   assumes f: "f \<midarrow>a\<rightarrow> 0"
     and 1: "\<And>x. x \<noteq> a \<Longrightarrow> 0 \<le> g x"
     and 2: "\<And>x. x \<noteq> a \<Longrightarrow> g x \<le> f x"
   shows "g \<midarrow>a\<rightarrow> 0"
 proof (rule LIM_imp_LIM [OF f]) (* FIXME: use tendsto_sandwich *)
   fix x
   assume x: "x \<noteq> a"
   with 1 have "norm (g x - 0) = g x" by simp
   also have "g x \<le> f x" by (rule 2 [OF x])
   also have "f x \<le> \<bar>f x\<bar>" by (rule abs_ge_self)
   also have "\<bar>f x\<bar> = norm (f x - 0)" by simp
   finally show "norm (g x - 0) \<le> norm (f x - 0)" .
 qed
 
 
 subsection \<open>Continuity\<close>
 
 lemma LIM_isCont_iff: "(f \<midarrow>a\<rightarrow> f a) = ((\<lambda>h. f (a + h)) \<midarrow>0\<rightarrow> f a)"
   for f :: "'a::real_normed_vector \<Rightarrow> 'b::topological_space"
   by (rule iffI [OF LIM_offset_zero LIM_offset_zero_cancel])
 
 lemma isCont_iff: "isCont f x = (\<lambda>h. f (x + h)) \<midarrow>0\<rightarrow> f x"
   for f :: "'a::real_normed_vector \<Rightarrow> 'b::topological_space"
   by (simp add: isCont_def LIM_isCont_iff)
 
 lemma isCont_LIM_compose2:
   fixes a :: "'a::real_normed_vector"
   assumes f [unfolded isCont_def]: "isCont f a"
     and g: "g \<midarrow>f a\<rightarrow> l"
     and inj: "\<exists>d>0. \<forall>x. x \<noteq> a \<and> norm (x - a) < d \<longrightarrow> f x \<noteq> f a"
   shows "(\<lambda>x. g (f x)) \<midarrow>a\<rightarrow> l"
   by (rule LIM_compose2 [OF f g inj])
 
 lemma isCont_norm [simp]: "isCont f a \<Longrightarrow> isCont (\<lambda>x. norm (f x)) a"
   for f :: "'a::t2_space \<Rightarrow> 'b::real_normed_vector"
   by (fact continuous_norm)
 
 lemma isCont_rabs [simp]: "isCont f a \<Longrightarrow> isCont (\<lambda>x. \<bar>f x\<bar>) a"
   for f :: "'a::t2_space \<Rightarrow> real"
   by (fact continuous_rabs)
 
 lemma isCont_add [simp]: "isCont f a \<Longrightarrow> isCont g a \<Longrightarrow> isCont (\<lambda>x. f x + g x) a"
   for f :: "'a::t2_space \<Rightarrow> 'b::topological_monoid_add"
   by (fact continuous_add)
 
 lemma isCont_minus [simp]: "isCont f a \<Longrightarrow> isCont (\<lambda>x. - f x) a"
   for f :: "'a::t2_space \<Rightarrow> 'b::real_normed_vector"
   by (fact continuous_minus)
 
 lemma isCont_diff [simp]: "isCont f a \<Longrightarrow> isCont g a \<Longrightarrow> isCont (\<lambda>x. f x - g x) a"
   for f :: "'a::t2_space \<Rightarrow> 'b::real_normed_vector"
   by (fact continuous_diff)
 
 lemma isCont_mult [simp]: "isCont f a \<Longrightarrow> isCont g a \<Longrightarrow> isCont (\<lambda>x. f x * g x) a"
   for f g :: "'a::t2_space \<Rightarrow> 'b::real_normed_algebra"
   by (fact continuous_mult)
 
 lemma (in bounded_linear) isCont: "isCont g a \<Longrightarrow> isCont (\<lambda>x. f (g x)) a"
   by (fact continuous)
 
 lemma (in bounded_bilinear) isCont: "isCont f a \<Longrightarrow> isCont g a \<Longrightarrow> isCont (\<lambda>x. f x ** g x) a"
   by (fact continuous)
 
 lemmas isCont_scaleR [simp] =
   bounded_bilinear.isCont [OF bounded_bilinear_scaleR]
 
 lemmas isCont_of_real [simp] =
   bounded_linear.isCont [OF bounded_linear_of_real]
 
 lemma isCont_power [simp]: "isCont f a \<Longrightarrow> isCont (\<lambda>x. f x ^ n) a"
   for f :: "'a::t2_space \<Rightarrow> 'b::{power,real_normed_algebra}"
   by (fact continuous_power)
 
 lemma isCont_sum [simp]: "\<forall>i\<in>A. isCont (f i) a \<Longrightarrow> isCont (\<lambda>x. \<Sum>i\<in>A. f i x) a"
   for f :: "'a \<Rightarrow> 'b::t2_space \<Rightarrow> 'c::topological_comm_monoid_add"
   by (auto intro: continuous_sum)
 
 
 subsection \<open>Uniform Continuity\<close>
 
 lemma uniformly_continuous_on_def:
   fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space"
   shows "uniformly_continuous_on s f \<longleftrightarrow>
     (\<forall>e>0. \<exists>d>0. \<forall>x\<in>s. \<forall>x'\<in>s. dist x' x < d \<longrightarrow> dist (f x') (f x) < e)"
   unfolding uniformly_continuous_on_uniformity
     uniformity_dist filterlim_INF filterlim_principal eventually_inf_principal
   by (force simp: Ball_def uniformity_dist[symmetric] eventually_uniformity_metric)
 
 abbreviation isUCont :: "['a::metric_space \<Rightarrow> 'b::metric_space] \<Rightarrow> bool"
   where "isUCont f \<equiv> uniformly_continuous_on UNIV f"
 
 lemma isUCont_def: "isUCont f \<longleftrightarrow> (\<forall>r>0. \<exists>s>0. \<forall>x y. dist x y < s \<longrightarrow> dist (f x) (f y) < r)"
   by (auto simp: uniformly_continuous_on_def dist_commute)
 
 lemma isUCont_isCont: "isUCont f \<Longrightarrow> isCont f x"
   by (drule uniformly_continuous_imp_continuous) (simp add: continuous_on_eq_continuous_at)
 
 lemma uniformly_continuous_on_Cauchy:
   fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space"
   assumes "uniformly_continuous_on S f" "Cauchy X" "\<And>n. X n \<in> S"
   shows "Cauchy (\<lambda>n. f (X n))"
   using assms
   unfolding uniformly_continuous_on_def  by (meson Cauchy_def)
 
 lemma isUCont_Cauchy: "isUCont f \<Longrightarrow> Cauchy X \<Longrightarrow> Cauchy (\<lambda>n. f (X n))"
   by (rule uniformly_continuous_on_Cauchy[where S=UNIV and f=f]) simp_all
 
 lemma uniformly_continuous_imp_Cauchy_continuous:
   fixes f :: "'a::metric_space \<Rightarrow> 'b::metric_space"
   shows "\<lbrakk>uniformly_continuous_on S f; Cauchy \<sigma>; \<And>n. (\<sigma> n) \<in> S\<rbrakk> \<Longrightarrow> Cauchy(f \<circ> \<sigma>)"
   by (simp add: uniformly_continuous_on_def Cauchy_def) meson
 
 lemma (in bounded_linear) isUCont: "isUCont f"
   unfolding isUCont_def dist_norm
 proof (intro allI impI)
   fix r :: real
   assume r: "0 < r"
   obtain K where K: "0 < K" and norm_le: "norm (f x) \<le> norm x * K" for x
     using pos_bounded by blast
   show "\<exists>s>0. \<forall>x y. norm (x - y) < s \<longrightarrow> norm (f x - f y) < r"
   proof (rule exI, safe)
     from r K show "0 < r / K" by simp
   next
     fix x y :: 'a
     assume xy: "norm (x - y) < r / K"
     have "norm (f x - f y) = norm (f (x - y))" by (simp only: diff)
     also have "\<dots> \<le> norm (x - y) * K" by (rule norm_le)
     also from K xy have "\<dots> < r" by (simp only: pos_less_divide_eq)
     finally show "norm (f x - f y) < r" .
   qed
 qed
 
 lemma (in bounded_linear) Cauchy: "Cauchy X \<Longrightarrow> Cauchy (\<lambda>n. f (X n))"
   by (rule isUCont [THEN isUCont_Cauchy])
 
 lemma LIM_less_bound:
   fixes f :: "real \<Rightarrow> real"
   assumes ev: "b < x" "\<forall> x' \<in> { b <..< x}. 0 \<le> f x'" and "isCont f x"
   shows "0 \<le> f x"
 proof (rule tendsto_lowerbound)
   show "(f \<longlongrightarrow> f x) (at_left x)"
     using \<open>isCont f x\<close> by (simp add: filterlim_at_split isCont_def)
   show "eventually (\<lambda>x. 0 \<le> f x) (at_left x)"
     using ev by (auto simp: eventually_at dist_real_def intro!: exI[of _ "x - b"])
 qed simp
 
 
 subsection \<open>Nested Intervals and Bisection -- Needed for Compactness\<close>
 
 lemma nested_sequence_unique:
   assumes "\<forall>n. f n \<le> f (Suc n)" "\<forall>n. g (Suc n) \<le> g n" "\<forall>n. f n \<le> g n" "(\<lambda>n. f n - g n) \<longlonglongrightarrow> 0"
   shows "\<exists>l::real. ((\<forall>n. f n \<le> l) \<and> f \<longlonglongrightarrow> l) \<and> ((\<forall>n. l \<le> g n) \<and> g \<longlonglongrightarrow> l)"
 proof -
   have "incseq f" unfolding incseq_Suc_iff by fact
   have "decseq g" unfolding decseq_Suc_iff by fact
   have "f n \<le> g 0" for n
   proof -
     from \<open>decseq g\<close> have "g n \<le> g 0"
       by (rule decseqD) simp
     with \<open>\<forall>n. f n \<le> g n\<close>[THEN spec, of n] show ?thesis
       by auto
   qed
   then obtain u where "f \<longlonglongrightarrow> u" "\<forall>i. f i \<le> u"
     using incseq_convergent[OF \<open>incseq f\<close>] by auto
   moreover have "f 0 \<le> g n" for n
   proof -
     from \<open>incseq f\<close> have "f 0 \<le> f n" by (rule incseqD) simp
     with \<open>\<forall>n. f n \<le> g n\<close>[THEN spec, of n] show ?thesis
       by simp
   qed
   then obtain l where "g \<longlonglongrightarrow> l" "\<forall>i. l \<le> g i"
     using decseq_convergent[OF \<open>decseq g\<close>] by auto
   moreover note LIMSEQ_unique[OF assms(4) tendsto_diff[OF \<open>f \<longlonglongrightarrow> u\<close> \<open>g \<longlonglongrightarrow> l\<close>]]
   ultimately show ?thesis by auto
 qed
 
 lemma Bolzano[consumes 1, case_names trans local]:
   fixes P :: "real \<Rightarrow> real \<Rightarrow> bool"
   assumes [arith]: "a \<le> b"
     and trans: "\<And>a b c. P a b \<Longrightarrow> P b c \<Longrightarrow> a \<le> b \<Longrightarrow> b \<le> c \<Longrightarrow> P a c"
     and local: "\<And>x. a \<le> x \<Longrightarrow> x \<le> b \<Longrightarrow> \<exists>d>0. \<forall>a b. a \<le> x \<and> x \<le> b \<and> b - a < d \<longrightarrow> P a b"
   shows "P a b"
 proof -
   define bisect where "bisect =
     rec_nat (a, b) (\<lambda>n (x, y). if P x ((x+y) / 2) then ((x+y)/2, y) else (x, (x+y)/2))"
   define l u where "l n = fst (bisect n)" and "u n = snd (bisect n)" for n
   have l[simp]: "l 0 = a" "\<And>n. l (Suc n) = (if P (l n) ((l n + u n) / 2) then (l n + u n) / 2 else l n)"
     and u[simp]: "u 0 = b" "\<And>n. u (Suc n) = (if P (l n) ((l n + u n) / 2) then u n else (l n + u n) / 2)"
     by (simp_all add: l_def u_def bisect_def split: prod.split)
 
   have [simp]: "l n \<le> u n" for n by (induct n) auto
 
   have "\<exists>x. ((\<forall>n. l n \<le> x) \<and> l \<longlonglongrightarrow> x) \<and> ((\<forall>n. x \<le> u n) \<and> u \<longlonglongrightarrow> x)"
   proof (safe intro!: nested_sequence_unique)
     show "l n \<le> l (Suc n)" "u (Suc n) \<le> u n" for n
       by (induct n) auto
   next
     have "l n - u n = (a - b) / 2^n" for n
       by (induct n) (auto simp: field_simps)
     then show "(\<lambda>n. l n - u n) \<longlonglongrightarrow> 0"
       by (simp add: LIMSEQ_divide_realpow_zero)
   qed fact
   then obtain x where x: "\<And>n. l n \<le> x" "\<And>n. x \<le> u n" and "l \<longlonglongrightarrow> x" "u \<longlonglongrightarrow> x"
     by auto
   obtain d where "0 < d" and d: "a \<le> x \<Longrightarrow> x \<le> b \<Longrightarrow> b - a < d \<Longrightarrow> P a b" for a b
     using \<open>l 0 \<le> x\<close> \<open>x \<le> u 0\<close> local[of x] by auto
 
   show "P a b"
   proof (rule ccontr)
     assume "\<not> P a b"
     have "\<not> P (l n) (u n)" for n
     proof (induct n)
       case 0
       then show ?case
         by (simp add: \<open>\<not> P a b\<close>)
     next
       case (Suc n)
       with trans[of "l n" "(l n + u n) / 2" "u n"] show ?case
         by auto
     qed
     moreover
     {
       have "eventually (\<lambda>n. x - d / 2 < l n) sequentially"
         using \<open>0 < d\<close> \<open>l \<longlonglongrightarrow> x\<close> by (intro order_tendstoD[of _ x]) auto
       moreover have "eventually (\<lambda>n. u n < x + d / 2) sequentially"
         using \<open>0 < d\<close> \<open>u \<longlonglongrightarrow> x\<close> by (intro order_tendstoD[of _ x]) auto
       ultimately have "eventually (\<lambda>n. P (l n) (u n)) sequentially"
       proof eventually_elim
         case (elim n)
         from add_strict_mono[OF this] have "u n - l n < d" by simp
         with x show "P (l n) (u n)" by (rule d)
       qed
     }
     ultimately show False by simp
   qed
 qed
 
 lemma compact_Icc[simp, intro]: "compact {a .. b::real}"
 proof (cases "a \<le> b", rule compactI)
   fix C
   assume C: "a \<le> b" "\<forall>t\<in>C. open t" "{a..b} \<subseteq> \<Union>C"
   define T where "T = {a .. b}"
   from C(1,3) show "\<exists>C'\<subseteq>C. finite C' \<and> {a..b} \<subseteq> \<Union>C'"
   proof (induct rule: Bolzano)
     case (trans a b c)
     then have *: "{a..c} = {a..b} \<union> {b..c}"
       by auto
     with trans obtain C1 C2
       where "C1\<subseteq>C" "finite C1" "{a..b} \<subseteq> \<Union>C1" "C2\<subseteq>C" "finite C2" "{b..c} \<subseteq> \<Union>C2"
       by auto
     with trans show ?case
       unfolding * by (intro exI[of _ "C1 \<union> C2"]) auto
   next
     case (local x)
     with C have "x \<in> \<Union>C" by auto
     with C(2) obtain c where "x \<in> c" "open c" "c \<in> C"
       by auto
     then obtain e where "0 < e" "{x - e <..< x + e} \<subseteq> c"
       by (auto simp: open_dist dist_real_def subset_eq Ball_def abs_less_iff)
     with \<open>c \<in> C\<close> show ?case
       by (safe intro!: exI[of _ "e/2"] exI[of _ "{c}"]) auto
   qed
 qed simp
 
 
 lemma continuous_image_closed_interval:
   fixes a b and f :: "real \<Rightarrow> real"
   defines "S \<equiv> {a..b}"
   assumes "a \<le> b" and f: "continuous_on S f"
   shows "\<exists>c d. f`S = {c..d} \<and> c \<le> d"
 proof -
   have S: "compact S" "S \<noteq> {}"
     using \<open>a \<le> b\<close> by (auto simp: S_def)
   obtain c where "c \<in> S" "\<forall>d\<in>S. f d \<le> f c"
     using continuous_attains_sup[OF S f] by auto
   moreover obtain d where "d \<in> S" "\<forall>c\<in>S. f d \<le> f c"
     using continuous_attains_inf[OF S f] by auto
   moreover have "connected (f`S)"
     using connected_continuous_image[OF f] connected_Icc by (auto simp: S_def)
   ultimately have "f ` S = {f d .. f c} \<and> f d \<le> f c"
     by (auto simp: connected_iff_interval)
   then show ?thesis
     by auto
 qed
 
 lemma open_Collect_positive:
   fixes f :: "'a::topological_space \<Rightarrow> real"
   assumes f: "continuous_on s f"
   shows "\<exists>A. open A \<and> A \<inter> s = {x\<in>s. 0 < f x}"
   using continuous_on_open_invariant[THEN iffD1, OF f, rule_format, of "{0 <..}"]
   by (auto simp: Int_def field_simps)
 
 lemma open_Collect_less_Int:
   fixes f g :: "'a::topological_space \<Rightarrow> real"
   assumes f: "continuous_on s f"
     and g: "continuous_on s g"
   shows "\<exists>A. open A \<and> A \<inter> s = {x\<in>s. f x < g x}"
   using open_Collect_positive[OF continuous_on_diff[OF g f]] by (simp add: field_simps)
 
 
 subsection \<open>Boundedness of continuous functions\<close>
 
 text\<open>By bisection, function continuous on closed interval is bounded above\<close>
 
 lemma isCont_eq_Ub:
   fixes f :: "real \<Rightarrow> 'a::linorder_topology"
   shows "a \<le> b \<Longrightarrow> \<forall>x::real. a \<le> x \<and> x \<le> b \<longrightarrow> isCont f x \<Longrightarrow>
     \<exists>M. (\<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> f x \<le> M) \<and> (\<exists>x. a \<le> x \<and> x \<le> b \<and> f x = M)"
   using continuous_attains_sup[of "{a..b}" f]
   by (auto simp: continuous_at_imp_continuous_on Ball_def Bex_def)
 
 lemma isCont_eq_Lb:
   fixes f :: "real \<Rightarrow> 'a::linorder_topology"
   shows "a \<le> b \<Longrightarrow> \<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> isCont f x \<Longrightarrow>
     \<exists>M. (\<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> M \<le> f x) \<and> (\<exists>x. a \<le> x \<and> x \<le> b \<and> f x = M)"
   using continuous_attains_inf[of "{a..b}" f]
   by (auto simp: continuous_at_imp_continuous_on Ball_def Bex_def)
 
 lemma isCont_bounded:
   fixes f :: "real \<Rightarrow> 'a::linorder_topology"
   shows "a \<le> b \<Longrightarrow> \<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> isCont f x \<Longrightarrow> \<exists>M. \<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> f x \<le> M"
   using isCont_eq_Ub[of a b f] by auto
 
 lemma isCont_has_Ub:
   fixes f :: "real \<Rightarrow> 'a::linorder_topology"
   shows "a \<le> b \<Longrightarrow> \<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> isCont f x \<Longrightarrow>
     \<exists>M. (\<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> f x \<le> M) \<and> (\<forall>N. N < M \<longrightarrow> (\<exists>x. a \<le> x \<and> x \<le> b \<and> N < f x))"
   using isCont_eq_Ub[of a b f] by auto
 
 (*HOL style here: object-level formulations*)
 lemma IVT_objl:
   "(f a \<le> y \<and> y \<le> f b \<and> a \<le> b \<and> (\<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> isCont f x)) \<longrightarrow>
     (\<exists>x. a \<le> x \<and> x \<le> b \<and> f x = y)"
   for a y :: real
   by (blast intro: IVT)
 
 lemma IVT2_objl:
   "(f b \<le> y \<and> y \<le> f a \<and> a \<le> b \<and> (\<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> isCont f x)) \<longrightarrow>
     (\<exists>x. a \<le> x \<and> x \<le> b \<and> f x = y)"
   for b y :: real
   by (blast intro: IVT2)
 
 lemma isCont_Lb_Ub:
   fixes f :: "real \<Rightarrow> real"
   assumes "a \<le> b" "\<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> isCont f x"
   shows "\<exists>L M. (\<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> L \<le> f x \<and> f x \<le> M) \<and>
     (\<forall>y. L \<le> y \<and> y \<le> M \<longrightarrow> (\<exists>x. a \<le> x \<and> x \<le> b \<and> (f x = y)))"
 proof -
   obtain M where M: "a \<le> M" "M \<le> b" "\<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> f x \<le> f M"
     using isCont_eq_Ub[OF assms] by auto
   obtain L where L: "a \<le> L" "L \<le> b" "\<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> f L \<le> f x"
     using isCont_eq_Lb[OF assms] by auto
   have "(\<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> f L \<le> f x \<and> f x \<le> f M)"
     using M L by simp
   moreover
   have "(\<forall>y. f L \<le> y \<and> y \<le> f M \<longrightarrow> (\<exists>x\<ge>a. x \<le> b \<and> f x = y))"
   proof (cases "L \<le> M")
     case True then show ?thesis
     using IVT[of f L _ M] M L assms by (metis order.trans)
   next
     case False then show ?thesis
     using IVT2[of f L _ M]
     by (metis L(2) M(1) assms(2) le_cases order.trans)
 qed
   ultimately show ?thesis
     by blast
 qed
 
 
 text \<open>Continuity of inverse function.\<close>
 
 lemma isCont_inverse_function:
   fixes f g :: "real \<Rightarrow> real"
   assumes d: "0 < d"
     and inj: "\<And>z. \<bar>z-x\<bar> \<le> d \<Longrightarrow> g (f z) = z"
     and cont: "\<And>z. \<bar>z-x\<bar> \<le> d \<Longrightarrow> isCont f z"
   shows "isCont g (f x)"
 proof -
   let ?A = "f (x - d)"
   let ?B = "f (x + d)"
   let ?D = "{x - d..x + d}"
 
   have f: "continuous_on ?D f"
     using cont by (intro continuous_at_imp_continuous_on ballI) auto
   then have g: "continuous_on (f`?D) g"
     using inj by (intro continuous_on_inv) auto
 
   from d f have "{min ?A ?B <..< max ?A ?B} \<subseteq> f ` ?D"
     by (intro connected_contains_Ioo connected_continuous_image) (auto split: split_min split_max)
   with g have "continuous_on {min ?A ?B <..< max ?A ?B} g"
     by (rule continuous_on_subset)
   moreover
   have "(?A < f x \<and> f x < ?B) \<or> (?B < f x \<and> f x < ?A)"
     using d inj by (intro continuous_inj_imp_mono[OF _ _ f] inj_on_imageI2[of g, OF inj_onI]) auto
   then have "f x \<in> {min ?A ?B <..< max ?A ?B}"
     by auto
   ultimately show ?thesis
     by (simp add: continuous_on_eq_continuous_at)
 qed
 
 lemma isCont_inverse_function2:
   fixes f g :: "real \<Rightarrow> real"
   shows
     "\<lbrakk>a < x; x < b;
       \<And>z. \<lbrakk>a \<le> z; z \<le> b\<rbrakk> \<Longrightarrow> g (f z) = z;
       \<And>z. \<lbrakk>a \<le> z; z \<le> b\<rbrakk> \<Longrightarrow> isCont f z\<rbrakk> \<Longrightarrow> isCont g (f x)"
   apply (rule isCont_inverse_function [where f=f and d="min (x - a) (b - x)"])
   apply (simp_all add: abs_le_iff)
   done
 
 text \<open>Bartle/Sherbert: Introduction to Real Analysis, Theorem 4.2.9, p. 110.\<close>
 lemma LIM_fun_gt_zero: "f \<midarrow>c\<rightarrow> l \<Longrightarrow> 0 < l \<Longrightarrow> \<exists>r. 0 < r \<and> (\<forall>x. x \<noteq> c \<and> \<bar>c - x\<bar> < r \<longrightarrow> 0 < f x)"
   for f :: "real \<Rightarrow> real"
   by (force simp: dest: LIM_D)
 
 lemma LIM_fun_less_zero: "f \<midarrow>c\<rightarrow> l \<Longrightarrow> l < 0 \<Longrightarrow> \<exists>r. 0 < r \<and> (\<forall>x. x \<noteq> c \<and> \<bar>c - x\<bar> < r \<longrightarrow> f x < 0)"
   for f :: "real \<Rightarrow> real"
   by (drule LIM_D [where r="-l"]) force+
 
 lemma LIM_fun_not_zero: "f \<midarrow>c\<rightarrow> l \<Longrightarrow> l \<noteq> 0 \<Longrightarrow> \<exists>r. 0 < r \<and> (\<forall>x. x \<noteq> c \<and> \<bar>c - x\<bar> < r \<longrightarrow> f x \<noteq> 0)"
   for f :: "real \<Rightarrow> real"
   using LIM_fun_gt_zero[of f l c] LIM_fun_less_zero[of f l c] by (auto simp: neq_iff)
 
 end
diff --git a/src/HOL/Rings.thy b/src/HOL/Rings.thy
--- a/src/HOL/Rings.thy
+++ b/src/HOL/Rings.thy
@@ -1,2626 +1,2631 @@
 (*  Title:      HOL/Rings.thy
     Author:     Gertrud Bauer
     Author:     Steven Obua
     Author:     Tobias Nipkow
     Author:     Lawrence C Paulson
     Author:     Markus Wenzel
     Author:     Jeremy Avigad
 *)
 
 section \<open>Rings\<close>
 
 theory Rings
   imports Groups Set Fun
 begin
 
 subsection \<open>Semirings and rings\<close>
 
 class semiring = ab_semigroup_add + semigroup_mult +
   assumes distrib_right [algebra_simps, algebra_split_simps]: "(a + b) * c = a * c + b * c"
   assumes distrib_left [algebra_simps, algebra_split_simps]: "a * (b + c) = a * b + a * c"
 begin
 
 text \<open>For the \<open>combine_numerals\<close> simproc\<close>
 lemma combine_common_factor: "a * e + (b * e + c) = (a + b) * e + c"
   by (simp add: distrib_right ac_simps)
 
 end
 
 class mult_zero = times + zero +
   assumes mult_zero_left [simp]: "0 * a = 0"
   assumes mult_zero_right [simp]: "a * 0 = 0"
 begin
 
 lemma mult_not_zero: "a * b \<noteq> 0 \<Longrightarrow> a \<noteq> 0 \<and> b \<noteq> 0"
   by auto
 
 end
 
 class semiring_0 = semiring + comm_monoid_add + mult_zero
 
 class semiring_0_cancel = semiring + cancel_comm_monoid_add
 begin
 
 subclass semiring_0
 proof
   fix a :: 'a
   have "0 * a + 0 * a = 0 * a + 0"
     by (simp add: distrib_right [symmetric])
   then show "0 * a = 0"
     by (simp only: add_left_cancel)
   have "a * 0 + a * 0 = a * 0 + 0"
     by (simp add: distrib_left [symmetric])
   then show "a * 0 = 0"
     by (simp only: add_left_cancel)
 qed
 
 end
 
 class comm_semiring = ab_semigroup_add + ab_semigroup_mult +
   assumes distrib: "(a + b) * c = a * c + b * c"
 begin
 
 subclass semiring
 proof
   fix a b c :: 'a
   show "(a + b) * c = a * c + b * c"
     by (simp add: distrib)
   have "a * (b + c) = (b + c) * a"
     by (simp add: ac_simps)
   also have "\<dots> = b * a + c * a"
     by (simp only: distrib)
   also have "\<dots> = a * b + a * c"
     by (simp add: ac_simps)
   finally show "a * (b + c) = a * b + a * c"
     by blast
 qed
 
 end
 
 class comm_semiring_0 = comm_semiring + comm_monoid_add + mult_zero
 begin
 
 subclass semiring_0 ..
 
 end
 
 class comm_semiring_0_cancel = comm_semiring + cancel_comm_monoid_add
 begin
 
 subclass semiring_0_cancel ..
 
 subclass comm_semiring_0 ..
 
 end
 
 class zero_neq_one = zero + one +
   assumes zero_neq_one [simp]: "0 \<noteq> 1"
 begin
 
 lemma one_neq_zero [simp]: "1 \<noteq> 0"
   by (rule not_sym) (rule zero_neq_one)
 
 definition of_bool :: "bool \<Rightarrow> 'a"
   where "of_bool p = (if p then 1 else 0)"
 
 lemma of_bool_eq [simp, code]:
   "of_bool False = 0"
   "of_bool True = 1"
   by (simp_all add: of_bool_def)
 
 lemma of_bool_eq_iff: "of_bool p = of_bool q \<longleftrightarrow> p = q"
   by (simp add: of_bool_def)
 
 lemma split_of_bool [split]: "P (of_bool p) \<longleftrightarrow> (p \<longrightarrow> P 1) \<and> (\<not> p \<longrightarrow> P 0)"
   by (cases p) simp_all
 
 lemma split_of_bool_asm: "P (of_bool p) \<longleftrightarrow> \<not> (p \<and> \<not> P 1 \<or> \<not> p \<and> \<not> P 0)"
   by (cases p) simp_all
 
 end
 
 class semiring_1 = zero_neq_one + semiring_0 + monoid_mult
 begin
 
 lemma of_bool_conj:
   "of_bool (P \<and> Q) = of_bool P * of_bool Q"
   by auto
 
 end
 
+lemma lambda_zero: "(\<lambda>h::'a::mult_zero. 0) = (*) 0"
+  by auto
+
+lemma lambda_one: "(\<lambda>x::'a::monoid_mult. x) = (*) 1"
+  by auto
 
 subsection \<open>Abstract divisibility\<close>
 
 class dvd = times
 begin
 
 definition dvd :: "'a \<Rightarrow> 'a \<Rightarrow> bool" (infix "dvd" 50)
   where "b dvd a \<longleftrightarrow> (\<exists>k. a = b * k)"
 
 lemma dvdI [intro?]: "a = b * k \<Longrightarrow> b dvd a"
   unfolding dvd_def ..
 
 lemma dvdE [elim]: "b dvd a \<Longrightarrow> (\<And>k. a = b * k \<Longrightarrow> P) \<Longrightarrow> P"
   unfolding dvd_def by blast
 
 end
 
 context comm_monoid_mult
 begin
 
 subclass dvd .
 
 lemma dvd_refl [simp]: "a dvd a"
 proof
   show "a = a * 1" by simp
 qed
 
 lemma dvd_trans [trans]:
   assumes "a dvd b" and "b dvd c"
   shows "a dvd c"
 proof -
   from assms obtain v where "b = a * v"
     by auto
   moreover from assms obtain w where "c = b * w"
     by auto
   ultimately have "c = a * (v * w)"
     by (simp add: mult.assoc)
   then show ?thesis ..
 qed
 
 lemma subset_divisors_dvd: "{c. c dvd a} \<subseteq> {c. c dvd b} \<longleftrightarrow> a dvd b"
   by (auto simp add: subset_iff intro: dvd_trans)
 
 lemma strict_subset_divisors_dvd: "{c. c dvd a} \<subset> {c. c dvd b} \<longleftrightarrow> a dvd b \<and> \<not> b dvd a"
   by (auto simp add: subset_iff intro: dvd_trans)
 
 lemma one_dvd [simp]: "1 dvd a"
   by (auto intro: dvdI)
 
 lemma dvd_mult [simp]: "a dvd (b * c)" if "a dvd c"
   using that by rule (auto intro: mult.left_commute dvdI)
 
 lemma dvd_mult2 [simp]: "a dvd (b * c)" if "a dvd b"
   using that dvd_mult [of a b c] by (simp add: ac_simps)
 
 lemma dvd_triv_right [simp]: "a dvd b * a"
   by (rule dvd_mult) (rule dvd_refl)
 
 lemma dvd_triv_left [simp]: "a dvd a * b"
   by (rule dvd_mult2) (rule dvd_refl)
 
 lemma mult_dvd_mono:
   assumes "a dvd b"
     and "c dvd d"
   shows "a * c dvd b * d"
 proof -
   from \<open>a dvd b\<close> obtain b' where "b = a * b'" ..
   moreover from \<open>c dvd d\<close> obtain d' where "d = c * d'" ..
   ultimately have "b * d = (a * c) * (b' * d')"
     by (simp add: ac_simps)
   then show ?thesis ..
 qed
 
 lemma dvd_mult_left: "a * b dvd c \<Longrightarrow> a dvd c"
   by (simp add: dvd_def mult.assoc) blast
 
 lemma dvd_mult_right: "a * b dvd c \<Longrightarrow> b dvd c"
   using dvd_mult_left [of b a c] by (simp add: ac_simps)
 
 end
 
 class comm_semiring_1 = zero_neq_one + comm_semiring_0 + comm_monoid_mult
 begin
 
 subclass semiring_1 ..
 
 lemma dvd_0_left_iff [simp]: "0 dvd a \<longleftrightarrow> a = 0"
   by auto
 
 lemma dvd_0_right [iff]: "a dvd 0"
 proof
   show "0 = a * 0" by simp
 qed
 
 lemma dvd_0_left: "0 dvd a \<Longrightarrow> a = 0"
   by simp
 
 lemma dvd_add [simp]:
   assumes "a dvd b" and "a dvd c"
   shows "a dvd (b + c)"
 proof -
   from \<open>a dvd b\<close> obtain b' where "b = a * b'" ..
   moreover from \<open>a dvd c\<close> obtain c' where "c = a * c'" ..
   ultimately have "b + c = a * (b' + c')"
     by (simp add: distrib_left)
   then show ?thesis ..
 qed
 
 end
 
 class semiring_1_cancel = semiring + cancel_comm_monoid_add
   + zero_neq_one + monoid_mult
 begin
 
 subclass semiring_0_cancel ..
 
 subclass semiring_1 ..
 
 end
 
 class comm_semiring_1_cancel =
   comm_semiring + cancel_comm_monoid_add + zero_neq_one + comm_monoid_mult +
   assumes right_diff_distrib' [algebra_simps, algebra_split_simps]:
     "a * (b - c) = a * b - a * c"
 begin
 
 subclass semiring_1_cancel ..
 subclass comm_semiring_0_cancel ..
 subclass comm_semiring_1 ..
 
 lemma left_diff_distrib' [algebra_simps, algebra_split_simps]:
   "(b - c) * a = b * a - c * a"
   by (simp add: algebra_simps)
 
 lemma dvd_add_times_triv_left_iff [simp]: "a dvd c * a + b \<longleftrightarrow> a dvd b"
 proof -
   have "a dvd a * c + b \<longleftrightarrow> a dvd b" (is "?P \<longleftrightarrow> ?Q")
   proof
     assume ?Q
     then show ?P by simp
   next
     assume ?P
     then obtain d where "a * c + b = a * d" ..
     then have "a * c + b - a * c = a * d - a * c" by simp
     then have "b = a * d - a * c" by simp
     then have "b = a * (d - c)" by (simp add: algebra_simps)
     then show ?Q ..
   qed
   then show "a dvd c * a + b \<longleftrightarrow> a dvd b" by (simp add: ac_simps)
 qed
 
 lemma dvd_add_times_triv_right_iff [simp]: "a dvd b + c * a \<longleftrightarrow> a dvd b"
   using dvd_add_times_triv_left_iff [of a c b] by (simp add: ac_simps)
 
 lemma dvd_add_triv_left_iff [simp]: "a dvd a + b \<longleftrightarrow> a dvd b"
   using dvd_add_times_triv_left_iff [of a 1 b] by simp
 
 lemma dvd_add_triv_right_iff [simp]: "a dvd b + a \<longleftrightarrow> a dvd b"
   using dvd_add_times_triv_right_iff [of a b 1] by simp
 
 lemma dvd_add_right_iff:
   assumes "a dvd b"
   shows "a dvd b + c \<longleftrightarrow> a dvd c" (is "?P \<longleftrightarrow> ?Q")
 proof
   assume ?P
   then obtain d where "b + c = a * d" ..
   moreover from \<open>a dvd b\<close> obtain e where "b = a * e" ..
   ultimately have "a * e + c = a * d" by simp
   then have "a * e + c - a * e = a * d - a * e" by simp
   then have "c = a * d - a * e" by simp
   then have "c = a * (d - e)" by (simp add: algebra_simps)
   then show ?Q ..
 next
   assume ?Q
   with assms show ?P by simp
 qed
 
 lemma dvd_add_left_iff: "a dvd c \<Longrightarrow> a dvd b + c \<longleftrightarrow> a dvd b"
   using dvd_add_right_iff [of a c b] by (simp add: ac_simps)
 
 end
 
 class ring = semiring + ab_group_add
 begin
 
 subclass semiring_0_cancel ..
 
 text \<open>Distribution rules\<close>
 
 lemma minus_mult_left: "- (a * b) = - a * b"
   by (rule minus_unique) (simp add: distrib_right [symmetric])
 
 lemma minus_mult_right: "- (a * b) = a * - b"
   by (rule minus_unique) (simp add: distrib_left [symmetric])
 
 text \<open>Extract signs from products\<close>
 lemmas mult_minus_left [simp] = minus_mult_left [symmetric]
 lemmas mult_minus_right [simp] = minus_mult_right [symmetric]
 
 lemma minus_mult_minus [simp]: "- a * - b = a * b"
   by simp
 
 lemma minus_mult_commute: "- a * b = a * - b"
   by simp
 
 lemma right_diff_distrib [algebra_simps, algebra_split_simps]:
   "a * (b - c) = a * b - a * c"
   using distrib_left [of a b "-c "] by simp
 
 lemma left_diff_distrib [algebra_simps, algebra_split_simps]:
   "(a - b) * c = a * c - b * c"
   using distrib_right [of a "- b" c] by simp
 
 lemmas ring_distribs = distrib_left distrib_right left_diff_distrib right_diff_distrib
 
 lemma eq_add_iff1: "a * e + c = b * e + d \<longleftrightarrow> (a - b) * e + c = d"
   by (simp add: algebra_simps)
 
 lemma eq_add_iff2: "a * e + c = b * e + d \<longleftrightarrow> c = (b - a) * e + d"
   by (simp add: algebra_simps)
 
 end
 
 lemmas ring_distribs = distrib_left distrib_right left_diff_distrib right_diff_distrib
 
 class comm_ring = comm_semiring + ab_group_add
 begin
 
 subclass ring ..
 subclass comm_semiring_0_cancel ..
 
 lemma square_diff_square_factored: "x * x - y * y = (x + y) * (x - y)"
   by (simp add: algebra_simps)
 
 end
 
 class ring_1 = ring + zero_neq_one + monoid_mult
 begin
 
 subclass semiring_1_cancel ..
 
 lemma square_diff_one_factored: "x * x - 1 = (x + 1) * (x - 1)"
   by (simp add: algebra_simps)
 
 end
 
 class comm_ring_1 = comm_ring + zero_neq_one + comm_monoid_mult
 begin
 
 subclass ring_1 ..
 subclass comm_semiring_1_cancel
   by standard (simp add: algebra_simps)
 
 lemma dvd_minus_iff [simp]: "x dvd - y \<longleftrightarrow> x dvd y"
 proof
   assume "x dvd - y"
   then have "x dvd - 1 * - y" by (rule dvd_mult)
   then show "x dvd y" by simp
 next
   assume "x dvd y"
   then have "x dvd - 1 * y" by (rule dvd_mult)
   then show "x dvd - y" by simp
 qed
 
 lemma minus_dvd_iff [simp]: "- x dvd y \<longleftrightarrow> x dvd y"
 proof
   assume "- x dvd y"
   then obtain k where "y = - x * k" ..
   then have "y = x * - k" by simp
   then show "x dvd y" ..
 next
   assume "x dvd y"
   then obtain k where "y = x * k" ..
   then have "y = - x * - k" by simp
   then show "- x dvd y" ..
 qed
 
 lemma dvd_diff [simp]: "x dvd y \<Longrightarrow> x dvd z \<Longrightarrow> x dvd (y - z)"
   using dvd_add [of x y "- z"] by simp
 
 end
 
 
 subsection \<open>Towards integral domains\<close>
 
 class semiring_no_zero_divisors = semiring_0 +
   assumes no_zero_divisors: "a \<noteq> 0 \<Longrightarrow> b \<noteq> 0 \<Longrightarrow> a * b \<noteq> 0"
 begin
 
 lemma divisors_zero:
   assumes "a * b = 0"
   shows "a = 0 \<or> b = 0"
 proof (rule classical)
   assume "\<not> ?thesis"
   then have "a \<noteq> 0" and "b \<noteq> 0" by auto
   with no_zero_divisors have "a * b \<noteq> 0" by blast
   with assms show ?thesis by simp
 qed
 
 lemma mult_eq_0_iff [simp]: "a * b = 0 \<longleftrightarrow> a = 0 \<or> b = 0"
 proof (cases "a = 0 \<or> b = 0")
   case False
   then have "a \<noteq> 0" and "b \<noteq> 0" by auto
     then show ?thesis using no_zero_divisors by simp
 next
   case True
   then show ?thesis by auto
 qed
 
 end
 
 class semiring_1_no_zero_divisors = semiring_1 + semiring_no_zero_divisors
 
 class semiring_no_zero_divisors_cancel = semiring_no_zero_divisors +
   assumes mult_cancel_right [simp]: "a * c = b * c \<longleftrightarrow> c = 0 \<or> a = b"
     and mult_cancel_left [simp]: "c * a = c * b \<longleftrightarrow> c = 0 \<or> a = b"
 begin
 
 lemma mult_left_cancel: "c \<noteq> 0 \<Longrightarrow> c * a = c * b \<longleftrightarrow> a = b"
   by simp
 
 lemma mult_right_cancel: "c \<noteq> 0 \<Longrightarrow> a * c = b * c \<longleftrightarrow> a = b"
   by simp
 
 end
 
 class ring_no_zero_divisors = ring + semiring_no_zero_divisors
 begin
 
 subclass semiring_no_zero_divisors_cancel
 proof
   fix a b c
   have "a * c = b * c \<longleftrightarrow> (a - b) * c = 0"
     by (simp add: algebra_simps)
   also have "\<dots> \<longleftrightarrow> c = 0 \<or> a = b"
     by auto
   finally show "a * c = b * c \<longleftrightarrow> c = 0 \<or> a = b" .
   have "c * a = c * b \<longleftrightarrow> c * (a - b) = 0"
     by (simp add: algebra_simps)
   also have "\<dots> \<longleftrightarrow> c = 0 \<or> a = b"
     by auto
   finally show "c * a = c * b \<longleftrightarrow> c = 0 \<or> a = b" .
 qed
 
 end
 
 class ring_1_no_zero_divisors = ring_1 + ring_no_zero_divisors
 begin
 
 subclass semiring_1_no_zero_divisors ..
 
 lemma square_eq_1_iff: "x * x = 1 \<longleftrightarrow> x = 1 \<or> x = - 1"
 proof -
   have "(x - 1) * (x + 1) = x * x - 1"
     by (simp add: algebra_simps)
   then have "x * x = 1 \<longleftrightarrow> (x - 1) * (x + 1) = 0"
     by simp
   then show ?thesis
     by (simp add: eq_neg_iff_add_eq_0)
 qed
 
 lemma mult_cancel_right1 [simp]: "c = b * c \<longleftrightarrow> c = 0 \<or> b = 1"
   using mult_cancel_right [of 1 c b] by auto
 
 lemma mult_cancel_right2 [simp]: "a * c = c \<longleftrightarrow> c = 0 \<or> a = 1"
   using mult_cancel_right [of a c 1] by simp
 
 lemma mult_cancel_left1 [simp]: "c = c * b \<longleftrightarrow> c = 0 \<or> b = 1"
   using mult_cancel_left [of c 1 b] by force
 
 lemma mult_cancel_left2 [simp]: "c * a = c \<longleftrightarrow> c = 0 \<or> a = 1"
   using mult_cancel_left [of c a 1] by simp
 
 end
 
 class semidom = comm_semiring_1_cancel + semiring_no_zero_divisors
 begin
 
 subclass semiring_1_no_zero_divisors ..
 
 end
 
 class idom = comm_ring_1 + semiring_no_zero_divisors
 begin
 
 subclass semidom ..
 
 subclass ring_1_no_zero_divisors ..
 
 lemma dvd_mult_cancel_right [simp]:
   "a * c dvd b * c \<longleftrightarrow> c = 0 \<or> a dvd b"
 proof -
   have "a * c dvd b * c \<longleftrightarrow> (\<exists>k. b * c = (a * k) * c)"
     by (auto simp add: ac_simps)
   also have "(\<exists>k. b * c = (a * k) * c) \<longleftrightarrow> c = 0 \<or> a dvd b"
     by auto
   finally show ?thesis .
 qed
 
 lemma dvd_mult_cancel_left [simp]:
   "c * a dvd c * b \<longleftrightarrow> c = 0 \<or> a dvd b"
   using dvd_mult_cancel_right [of a c b] by (simp add: ac_simps)
 
 lemma square_eq_iff: "a * a = b * b \<longleftrightarrow> a = b \<or> a = - b"
 proof
   assume "a * a = b * b"
   then have "(a - b) * (a + b) = 0"
     by (simp add: algebra_simps)
   then show "a = b \<or> a = - b"
     by (simp add: eq_neg_iff_add_eq_0)
 next
   assume "a = b \<or> a = - b"
   then show "a * a = b * b" by auto
 qed
 
 end
 
 class idom_abs_sgn = idom + abs + sgn +
   assumes sgn_mult_abs: "sgn a * \<bar>a\<bar> = a"
     and sgn_sgn [simp]: "sgn (sgn a) = sgn a"
     and abs_abs [simp]: "\<bar>\<bar>a\<bar>\<bar> = \<bar>a\<bar>"
     and abs_0 [simp]: "\<bar>0\<bar> = 0"
     and sgn_0 [simp]: "sgn 0 = 0"
     and sgn_1 [simp]: "sgn 1 = 1"
     and sgn_minus_1: "sgn (- 1) = - 1"
     and sgn_mult: "sgn (a * b) = sgn a * sgn b"
 begin
 
 lemma sgn_eq_0_iff:
   "sgn a = 0 \<longleftrightarrow> a = 0"
 proof -
   { assume "sgn a = 0"
     then have "sgn a * \<bar>a\<bar> = 0"
       by simp
     then have "a = 0"
       by (simp add: sgn_mult_abs)
   } then show ?thesis
     by auto
 qed
 
 lemma abs_eq_0_iff:
   "\<bar>a\<bar> = 0 \<longleftrightarrow> a = 0"
 proof -
   { assume "\<bar>a\<bar> = 0"
     then have "sgn a * \<bar>a\<bar> = 0"
       by simp
     then have "a = 0"
       by (simp add: sgn_mult_abs)
   } then show ?thesis
     by auto
 qed
 
 lemma abs_mult_sgn:
   "\<bar>a\<bar> * sgn a = a"
   using sgn_mult_abs [of a] by (simp add: ac_simps)
 
 lemma abs_1 [simp]:
   "\<bar>1\<bar> = 1"
   using sgn_mult_abs [of 1] by simp
 
 lemma sgn_abs [simp]:
   "\<bar>sgn a\<bar> = of_bool (a \<noteq> 0)"
   using sgn_mult_abs [of "sgn a"] mult_cancel_left [of "sgn a" "\<bar>sgn a\<bar>" 1]
   by (auto simp add: sgn_eq_0_iff)
 
 lemma abs_sgn [simp]:
   "sgn \<bar>a\<bar> = of_bool (a \<noteq> 0)"
   using sgn_mult_abs [of "\<bar>a\<bar>"] mult_cancel_right [of "sgn \<bar>a\<bar>" "\<bar>a\<bar>" 1]
   by (auto simp add: abs_eq_0_iff)
 
 lemma abs_mult:
   "\<bar>a * b\<bar> = \<bar>a\<bar> * \<bar>b\<bar>"
 proof (cases "a = 0 \<or> b = 0")
   case True
   then show ?thesis
     by auto
 next
   case False
   then have *: "sgn (a * b) \<noteq> 0"
     by (simp add: sgn_eq_0_iff)
   from abs_mult_sgn [of "a * b"] abs_mult_sgn [of a] abs_mult_sgn [of b]
   have "\<bar>a * b\<bar> * sgn (a * b) = \<bar>a\<bar> * sgn a * \<bar>b\<bar> * sgn b"
     by (simp add: ac_simps)
   then have "\<bar>a * b\<bar> * sgn (a * b) = \<bar>a\<bar> * \<bar>b\<bar> * sgn (a * b)"
     by (simp add: sgn_mult ac_simps)
   with * show ?thesis
     by simp
 qed
 
 lemma sgn_minus [simp]:
   "sgn (- a) = - sgn a"
 proof -
   from sgn_minus_1 have "sgn (- 1 * a) = - 1 * sgn a"
     by (simp only: sgn_mult)
   then show ?thesis
     by simp
 qed
 
 lemma abs_minus [simp]:
   "\<bar>- a\<bar> = \<bar>a\<bar>"
 proof -
   have [simp]: "\<bar>- 1\<bar> = 1"
     using sgn_mult_abs [of "- 1"] by simp
   then have "\<bar>- 1 * a\<bar> = 1 * \<bar>a\<bar>"
     by (simp only: abs_mult)
   then show ?thesis
     by simp
 qed
 
 end
 
 
 subsection \<open>(Partial) Division\<close>
 
 class divide =
   fixes divide :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"  (infixl "div" 70)
 
 setup \<open>Sign.add_const_constraint (\<^const_name>\<open>divide\<close>, SOME \<^typ>\<open>'a \<Rightarrow> 'a \<Rightarrow> 'a\<close>)\<close>
 
 context semiring
 begin
 
 lemma [field_simps, field_split_simps]:
   shows distrib_left_NO_MATCH: "NO_MATCH (x div y) a \<Longrightarrow> a * (b + c) = a * b + a * c"
     and distrib_right_NO_MATCH: "NO_MATCH (x div y) c \<Longrightarrow> (a + b) * c = a * c + b * c"
   by (rule distrib_left distrib_right)+
 
 end
 
 context ring
 begin
 
 lemma [field_simps, field_split_simps]:
   shows left_diff_distrib_NO_MATCH: "NO_MATCH (x div y) c \<Longrightarrow> (a - b) * c = a * c - b * c"
     and right_diff_distrib_NO_MATCH: "NO_MATCH (x div y) a \<Longrightarrow> a * (b - c) = a * b - a * c"
   by (rule left_diff_distrib right_diff_distrib)+
 
 end
 
 setup \<open>Sign.add_const_constraint (\<^const_name>\<open>divide\<close>, SOME \<^typ>\<open>'a::divide \<Rightarrow> 'a \<Rightarrow> 'a\<close>)\<close>
 
 text \<open>Algebraic classes with division\<close>
   
 class semidom_divide = semidom + divide +
   assumes nonzero_mult_div_cancel_right [simp]: "b \<noteq> 0 \<Longrightarrow> (a * b) div b = a"
   assumes div_by_0 [simp]: "a div 0 = 0"
 begin
 
 lemma nonzero_mult_div_cancel_left [simp]: "a \<noteq> 0 \<Longrightarrow> (a * b) div a = b"
   using nonzero_mult_div_cancel_right [of a b] by (simp add: ac_simps)
 
 subclass semiring_no_zero_divisors_cancel
 proof
   show *: "a * c = b * c \<longleftrightarrow> c = 0 \<or> a = b" for a b c
   proof (cases "c = 0")
     case True
     then show ?thesis by simp
   next
     case False
     have "a = b" if "a * c = b * c"
     proof -
       from that have "a * c div c = b * c div c"
         by simp
       with False show ?thesis
         by simp
     qed
     then show ?thesis by auto
   qed
   show "c * a = c * b \<longleftrightarrow> c = 0 \<or> a = b" for a b c
     using * [of a c b] by (simp add: ac_simps)
 qed
 
 lemma div_self [simp]: "a \<noteq> 0 \<Longrightarrow> a div a = 1"
   using nonzero_mult_div_cancel_left [of a 1] by simp
 
 lemma div_0 [simp]: "0 div a = 0"
 proof (cases "a = 0")
   case True
   then show ?thesis by simp
 next
   case False
   then have "a * 0 div a = 0"
     by (rule nonzero_mult_div_cancel_left)
   then show ?thesis by simp
 qed
 
 lemma div_by_1 [simp]: "a div 1 = a"
   using nonzero_mult_div_cancel_left [of 1 a] by simp
 
 lemma dvd_div_eq_0_iff:
   assumes "b dvd a"
   shows "a div b = 0 \<longleftrightarrow> a = 0"
   using assms by (elim dvdE, cases "b = 0") simp_all  
 
 lemma dvd_div_eq_cancel:
   "a div c = b div c \<Longrightarrow> c dvd a \<Longrightarrow> c dvd b \<Longrightarrow> a = b"
   by (elim dvdE, cases "c = 0") simp_all
 
 lemma dvd_div_eq_iff:
   "c dvd a \<Longrightarrow> c dvd b \<Longrightarrow> a div c = b div c \<longleftrightarrow> a = b"
   by (elim dvdE, cases "c = 0") simp_all
 
 lemma inj_on_mult:
   "inj_on ((*) a) A" if "a \<noteq> 0"
 proof (rule inj_onI)
   fix b c
   assume "a * b = a * c"
   then have "a * b div a = a * c div a"
     by (simp only:)
   with that show "b = c"
     by simp
 qed
 
 end
 
 class idom_divide = idom + semidom_divide
 begin
 
 lemma dvd_neg_div:
   assumes "b dvd a"
   shows "- a div b = - (a div b)"
 proof (cases "b = 0")
   case True
   then show ?thesis by simp
 next
   case False
   from assms obtain c where "a = b * c" ..
   then have "- a div b = (b * - c) div b"
     by simp
   from False also have "\<dots> = - c"
     by (rule nonzero_mult_div_cancel_left)  
   with False \<open>a = b * c\<close> show ?thesis
     by simp
 qed
 
 lemma dvd_div_neg:
   assumes "b dvd a"
   shows "a div - b = - (a div b)"
 proof (cases "b = 0")
   case True
   then show ?thesis by simp
 next
   case False
   then have "- b \<noteq> 0"
     by simp
   from assms obtain c where "a = b * c" ..
   then have "a div - b = (- b * - c) div - b"
     by simp
   from \<open>- b \<noteq> 0\<close> also have "\<dots> = - c"
     by (rule nonzero_mult_div_cancel_left)  
   with False \<open>a = b * c\<close> show ?thesis
     by simp
 qed
 
 end
 
 class algebraic_semidom = semidom_divide
 begin
 
 text \<open>
   Class \<^class>\<open>algebraic_semidom\<close> enriches a integral domain
   by notions from algebra, like units in a ring.
   It is a separate class to avoid spoiling fields with notions
   which are degenerated there.
 \<close>
 
 lemma dvd_times_left_cancel_iff [simp]:
   assumes "a \<noteq> 0"
   shows "a * b dvd a * c \<longleftrightarrow> b dvd c"
     (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume ?lhs
   then obtain d where "a * c = a * b * d" ..
   with assms have "c = b * d" by (simp add: ac_simps)
   then show ?rhs ..
 next
   assume ?rhs
   then obtain d where "c = b * d" ..
   then have "a * c = a * b * d" by (simp add: ac_simps)
   then show ?lhs ..
 qed
 
 lemma dvd_times_right_cancel_iff [simp]:
   assumes "a \<noteq> 0"
   shows "b * a dvd c * a \<longleftrightarrow> b dvd c"
   using dvd_times_left_cancel_iff [of a b c] assms by (simp add: ac_simps)
 
 lemma div_dvd_iff_mult:
   assumes "b \<noteq> 0" and "b dvd a"
   shows "a div b dvd c \<longleftrightarrow> a dvd c * b"
 proof -
   from \<open>b dvd a\<close> obtain d where "a = b * d" ..
   with \<open>b \<noteq> 0\<close> show ?thesis by (simp add: ac_simps)
 qed
 
 lemma dvd_div_iff_mult:
   assumes "c \<noteq> 0" and "c dvd b"
   shows "a dvd b div c \<longleftrightarrow> a * c dvd b"
 proof -
   from \<open>c dvd b\<close> obtain d where "b = c * d" ..
   with \<open>c \<noteq> 0\<close> show ?thesis by (simp add: mult.commute [of a])
 qed
 
 lemma div_dvd_div [simp]:
   assumes "a dvd b" and "a dvd c"
   shows "b div a dvd c div a \<longleftrightarrow> b dvd c"
 proof (cases "a = 0")
   case True
   with assms show ?thesis by simp
 next
   case False
   moreover from assms obtain k l where "b = a * k" and "c = a * l"
     by blast
   ultimately show ?thesis by simp
 qed
 
 lemma div_add [simp]:
   assumes "c dvd a" and "c dvd b"
   shows "(a + b) div c = a div c + b div c"
 proof (cases "c = 0")
   case True
   then show ?thesis by simp
 next
   case False
   moreover from assms obtain k l where "a = c * k" and "b = c * l"
     by blast
   moreover have "c * k + c * l = c * (k + l)"
     by (simp add: algebra_simps)
   ultimately show ?thesis
     by simp
 qed
 
 lemma div_mult_div_if_dvd:
   assumes "b dvd a" and "d dvd c"
   shows "(a div b) * (c div d) = (a * c) div (b * d)"
 proof (cases "b = 0 \<or> c = 0")
   case True
   with assms show ?thesis by auto
 next
   case False
   moreover from assms obtain k l where "a = b * k" and "c = d * l"
     by blast
   moreover have "b * k * (d * l) div (b * d) = (b * d) * (k * l) div (b * d)"
     by (simp add: ac_simps)
   ultimately show ?thesis by simp
 qed
 
 lemma dvd_div_eq_mult:
   assumes "a \<noteq> 0" and "a dvd b"
   shows "b div a = c \<longleftrightarrow> b = c * a"
     (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume ?rhs
   then show ?lhs by (simp add: assms)
 next
   assume ?lhs
   then have "b div a * a = c * a" by simp
   moreover from assms have "b div a * a = b"
     by (auto simp add: ac_simps)
   ultimately show ?rhs by simp
 qed
 
 lemma dvd_div_mult_self [simp]: "a dvd b \<Longrightarrow> b div a * a = b"
   by (cases "a = 0") (auto simp add: ac_simps)
 
 lemma dvd_mult_div_cancel [simp]: "a dvd b \<Longrightarrow> a * (b div a) = b"
   using dvd_div_mult_self [of a b] by (simp add: ac_simps)
 
 lemma div_mult_swap:
   assumes "c dvd b"
   shows "a * (b div c) = (a * b) div c"
 proof (cases "c = 0")
   case True
   then show ?thesis by simp
 next
   case False
   from assms obtain d where "b = c * d" ..
   moreover from False have "a * divide (d * c) c = ((a * d) * c) div c"
     by simp
   ultimately show ?thesis by (simp add: ac_simps)
 qed
 
 lemma dvd_div_mult: "c dvd b \<Longrightarrow> b div c * a = (b * a) div c"
   using div_mult_swap [of c b a] by (simp add: ac_simps)
 
 lemma dvd_div_mult2_eq:
   assumes "b * c dvd a"
   shows "a div (b * c) = a div b div c"
 proof -
   from assms obtain k where "a = b * c * k" ..
   then show ?thesis
     by (cases "b = 0 \<or> c = 0") (auto, simp add: ac_simps)
 qed
 
 lemma dvd_div_div_eq_mult:
   assumes "a \<noteq> 0" "c \<noteq> 0" and "a dvd b" "c dvd d"
   shows "b div a = d div c \<longleftrightarrow> b * c = a * d"
     (is "?lhs \<longleftrightarrow> ?rhs")
 proof -
   from assms have "a * c \<noteq> 0" by simp
   then have "?lhs \<longleftrightarrow> b div a * (a * c) = d div c * (a * c)"
     by simp
   also have "\<dots> \<longleftrightarrow> (a * (b div a)) * c = (c * (d div c)) * a"
     by (simp add: ac_simps)
   also have "\<dots> \<longleftrightarrow> (a * b div a) * c = (c * d div c) * a"
     using assms by (simp add: div_mult_swap)
   also have "\<dots> \<longleftrightarrow> ?rhs"
     using assms by (simp add: ac_simps)
   finally show ?thesis .
 qed
 
 lemma dvd_mult_imp_div:
   assumes "a * c dvd b"
   shows "a dvd b div c"
 proof (cases "c = 0")
   case True then show ?thesis by simp
 next
   case False
   from \<open>a * c dvd b\<close> obtain d where "b = a * c * d" ..
   with False show ?thesis
     by (simp add: mult.commute [of a] mult.assoc)
 qed
 
 lemma div_div_eq_right:
   assumes "c dvd b" "b dvd a"
   shows   "a div (b div c) = a div b * c"
 proof (cases "c = 0 \<or> b = 0")
   case True
   then show ?thesis
     by auto
 next
   case False
   from assms obtain r s where "b = c * r" and "a = c * r * s"
     by blast
   moreover with False have "r \<noteq> 0"
     by auto
   ultimately show ?thesis using False
     by simp (simp add: mult.commute [of _ r] mult.assoc mult.commute [of c])
 qed
 
 lemma div_div_div_same:
   assumes "d dvd b" "b dvd a"
   shows   "(a div d) div (b div d) = a div b"
 proof (cases "b = 0 \<or> d = 0")
   case True
   with assms show ?thesis
     by auto
 next
   case False
   from assms obtain r s
     where "a = d * r * s" and "b = d * r"
     by blast
   with False show ?thesis
     by simp (simp add: ac_simps)
 qed
 
 
 text \<open>Units: invertible elements in a ring\<close>
 
 abbreviation is_unit :: "'a \<Rightarrow> bool"
   where "is_unit a \<equiv> a dvd 1"
 
 lemma not_is_unit_0 [simp]: "\<not> is_unit 0"
   by simp
 
 lemma unit_imp_dvd [dest]: "is_unit b \<Longrightarrow> b dvd a"
   by (rule dvd_trans [of _ 1]) simp_all
 
 lemma unit_dvdE:
   assumes "is_unit a"
   obtains c where "a \<noteq> 0" and "b = a * c"
 proof -
   from assms have "a dvd b" by auto
   then obtain c where "b = a * c" ..
   moreover from assms have "a \<noteq> 0" by auto
   ultimately show thesis using that by blast
 qed
 
 lemma dvd_unit_imp_unit: "a dvd b \<Longrightarrow> is_unit b \<Longrightarrow> is_unit a"
   by (rule dvd_trans)
 
 lemma unit_div_1_unit [simp, intro]:
   assumes "is_unit a"
   shows "is_unit (1 div a)"
 proof -
   from assms have "1 = 1 div a * a" by simp
   then show "is_unit (1 div a)" by (rule dvdI)
 qed
 
 lemma is_unitE [elim?]:
   assumes "is_unit a"
   obtains b where "a \<noteq> 0" and "b \<noteq> 0"
     and "is_unit b" and "1 div a = b" and "1 div b = a"
     and "a * b = 1" and "c div a = c * b"
 proof (rule that)
   define b where "b = 1 div a"
   then show "1 div a = b" by simp
   from assms b_def show "is_unit b" by simp
   with assms show "a \<noteq> 0" and "b \<noteq> 0" by auto
   from assms b_def show "a * b = 1" by simp
   then have "1 = a * b" ..
   with b_def \<open>b \<noteq> 0\<close> show "1 div b = a" by simp
   from assms have "a dvd c" ..
   then obtain d where "c = a * d" ..
   with \<open>a \<noteq> 0\<close> \<open>a * b = 1\<close> show "c div a = c * b"
     by (simp add: mult.assoc mult.left_commute [of a])
 qed
 
 lemma unit_prod [intro]: "is_unit a \<Longrightarrow> is_unit b \<Longrightarrow> is_unit (a * b)"
   by (subst mult_1_left [of 1, symmetric]) (rule mult_dvd_mono)
 
 lemma is_unit_mult_iff: "is_unit (a * b) \<longleftrightarrow> is_unit a \<and> is_unit b"
   by (auto dest: dvd_mult_left dvd_mult_right)
 
 lemma unit_div [intro]: "is_unit a \<Longrightarrow> is_unit b \<Longrightarrow> is_unit (a div b)"
   by (erule is_unitE [of b a]) (simp add: ac_simps unit_prod)
 
 lemma mult_unit_dvd_iff:
   assumes "is_unit b"
   shows "a * b dvd c \<longleftrightarrow> a dvd c"
 proof
   assume "a * b dvd c"
   with assms show "a dvd c"
     by (simp add: dvd_mult_left)
 next
   assume "a dvd c"
   then obtain k where "c = a * k" ..
   with assms have "c = (a * b) * (1 div b * k)"
     by (simp add: mult_ac)
   then show "a * b dvd c" by (rule dvdI)
 qed
 
 lemma mult_unit_dvd_iff': "is_unit a \<Longrightarrow> (a * b) dvd c \<longleftrightarrow> b dvd c"
   using mult_unit_dvd_iff [of a b c] by (simp add: ac_simps)
 
 lemma dvd_mult_unit_iff:
   assumes "is_unit b"
   shows "a dvd c * b \<longleftrightarrow> a dvd c"
 proof
   assume "a dvd c * b"
   with assms have "c * b dvd c * (b * (1 div b))"
     by (subst mult_assoc [symmetric]) simp
   also from assms have "b * (1 div b) = 1"
     by (rule is_unitE) simp
   finally have "c * b dvd c" by simp
   with \<open>a dvd c * b\<close> show "a dvd c" by (rule dvd_trans)
 next
   assume "a dvd c"
   then show "a dvd c * b" by simp
 qed
 
 lemma dvd_mult_unit_iff': "is_unit b \<Longrightarrow> a dvd b * c \<longleftrightarrow> a dvd c"
   using dvd_mult_unit_iff [of b a c] by (simp add: ac_simps)
 
 lemma div_unit_dvd_iff: "is_unit b \<Longrightarrow> a div b dvd c \<longleftrightarrow> a dvd c"
   by (erule is_unitE [of _ a]) (auto simp add: mult_unit_dvd_iff)
 
 lemma dvd_div_unit_iff: "is_unit b \<Longrightarrow> a dvd c div b \<longleftrightarrow> a dvd c"
   by (erule is_unitE [of _ c]) (simp add: dvd_mult_unit_iff)
 
 lemmas unit_dvd_iff = mult_unit_dvd_iff mult_unit_dvd_iff'
   dvd_mult_unit_iff dvd_mult_unit_iff' 
   div_unit_dvd_iff dvd_div_unit_iff (* FIXME consider named_theorems *)
 
 lemma unit_mult_div_div [simp]: "is_unit a \<Longrightarrow> b * (1 div a) = b div a"
   by (erule is_unitE [of _ b]) simp
 
 lemma unit_div_mult_self [simp]: "is_unit a \<Longrightarrow> b div a * a = b"
   by (rule dvd_div_mult_self) auto
 
 lemma unit_div_1_div_1 [simp]: "is_unit a \<Longrightarrow> 1 div (1 div a) = a"
   by (erule is_unitE) simp
 
 lemma unit_div_mult_swap: "is_unit c \<Longrightarrow> a * (b div c) = (a * b) div c"
   by (erule unit_dvdE [of _ b]) (simp add: mult.left_commute [of _ c])
 
 lemma unit_div_commute: "is_unit b \<Longrightarrow> (a div b) * c = (a * c) div b"
   using unit_div_mult_swap [of b c a] by (simp add: ac_simps)
 
 lemma unit_eq_div1: "is_unit b \<Longrightarrow> a div b = c \<longleftrightarrow> a = c * b"
   by (auto elim: is_unitE)
 
 lemma unit_eq_div2: "is_unit b \<Longrightarrow> a = c div b \<longleftrightarrow> a * b = c"
   using unit_eq_div1 [of b c a] by auto
 
 lemma unit_mult_left_cancel: "is_unit a \<Longrightarrow> a * b = a * c \<longleftrightarrow> b = c"
   using mult_cancel_left [of a b c] by auto
 
 lemma unit_mult_right_cancel: "is_unit a \<Longrightarrow> b * a = c * a \<longleftrightarrow> b = c"
   using unit_mult_left_cancel [of a b c] by (auto simp add: ac_simps)
 
 lemma unit_div_cancel:
   assumes "is_unit a"
   shows "b div a = c div a \<longleftrightarrow> b = c"
 proof -
   from assms have "is_unit (1 div a)" by simp
   then have "b * (1 div a) = c * (1 div a) \<longleftrightarrow> b = c"
     by (rule unit_mult_right_cancel)
   with assms show ?thesis by simp
 qed
 
 lemma is_unit_div_mult2_eq:
   assumes "is_unit b" and "is_unit c"
   shows "a div (b * c) = a div b div c"
 proof -
   from assms have "is_unit (b * c)"
     by (simp add: unit_prod)
   then have "b * c dvd a"
     by (rule unit_imp_dvd)
   then show ?thesis
     by (rule dvd_div_mult2_eq)
 qed
 
 lemma is_unit_div_mult_cancel_left:
   assumes "a \<noteq> 0" and "is_unit b"
   shows "a div (a * b) = 1 div b"
 proof -
   from assms have "a div (a * b) = a div a div b"
     by (simp add: mult_unit_dvd_iff dvd_div_mult2_eq)
   with assms show ?thesis by simp
 qed
 
 lemma is_unit_div_mult_cancel_right:
   assumes "a \<noteq> 0" and "is_unit b"
   shows "a div (b * a) = 1 div b"
   using assms is_unit_div_mult_cancel_left [of a b] by (simp add: ac_simps)
 
 lemma unit_div_eq_0_iff:
   assumes "is_unit b"
   shows "a div b = 0 \<longleftrightarrow> a = 0"
   by (rule dvd_div_eq_0_iff) (insert assms, auto)  
 
 lemma div_mult_unit2:
   "is_unit c \<Longrightarrow> b dvd a \<Longrightarrow> a div (b * c) = a div b div c"
   by (rule dvd_div_mult2_eq) (simp_all add: mult_unit_dvd_iff)
 
 
 text \<open>Coprimality\<close>
 
 definition coprime :: "'a \<Rightarrow> 'a \<Rightarrow> bool"
   where "coprime a b \<longleftrightarrow> (\<forall>c. c dvd a \<longrightarrow> c dvd b \<longrightarrow> is_unit c)"
 
 lemma coprimeI:
   assumes "\<And>c. c dvd a \<Longrightarrow> c dvd b \<Longrightarrow> is_unit c"
   shows "coprime a b"
   using assms by (auto simp: coprime_def)
 
 lemma not_coprimeI:
   assumes "c dvd a" and "c dvd b" and "\<not> is_unit c"
   shows "\<not> coprime a b"
   using assms by (auto simp: coprime_def)
 
 lemma coprime_common_divisor:
   "is_unit c" if "coprime a b" and "c dvd a" and "c dvd b"
   using that by (auto simp: coprime_def)
 
 lemma not_coprimeE:
   assumes "\<not> coprime a b"
   obtains c where "c dvd a" and "c dvd b" and "\<not> is_unit c"
   using assms by (auto simp: coprime_def)
 
 lemma coprime_imp_coprime:
   "coprime a b" if "coprime c d"
     and "\<And>e. \<not> is_unit e \<Longrightarrow> e dvd a \<Longrightarrow> e dvd b \<Longrightarrow> e dvd c"
     and "\<And>e. \<not> is_unit e \<Longrightarrow> e dvd a \<Longrightarrow> e dvd b \<Longrightarrow> e dvd d"
 proof (rule coprimeI)
   fix e
   assume "e dvd a" and "e dvd b"
   with that have "e dvd c" and "e dvd d"
     by (auto intro: dvd_trans)
   with \<open>coprime c d\<close> show "is_unit e"
     by (rule coprime_common_divisor)
 qed
 
 lemma coprime_divisors:
   "coprime a b" if "a dvd c" "b dvd d" and "coprime c d"
 using \<open>coprime c d\<close> proof (rule coprime_imp_coprime)
   fix e
   assume "e dvd a" then show "e dvd c"
     using \<open>a dvd c\<close> by (rule dvd_trans)
   assume "e dvd b" then show "e dvd d"
     using \<open>b dvd d\<close> by (rule dvd_trans)
 qed
 
 lemma coprime_self [simp]:
   "coprime a a \<longleftrightarrow> is_unit a" (is "?P \<longleftrightarrow> ?Q")
 proof
   assume ?P
   then show ?Q
     by (rule coprime_common_divisor) simp_all
 next
   assume ?Q
   show ?P
     by (rule coprimeI) (erule dvd_unit_imp_unit, rule \<open>?Q\<close>)
 qed
 
 lemma coprime_commute [ac_simps]:
   "coprime b a \<longleftrightarrow> coprime a b"
   unfolding coprime_def by auto
 
 lemma is_unit_left_imp_coprime:
   "coprime a b" if "is_unit a"
 proof (rule coprimeI)
   fix c
   assume "c dvd a"
   with that show "is_unit c"
     by (auto intro: dvd_unit_imp_unit)
 qed
 
 lemma is_unit_right_imp_coprime:
   "coprime a b" if "is_unit b"
   using that is_unit_left_imp_coprime [of b a] by (simp add: ac_simps)
 
 lemma coprime_1_left [simp]:
   "coprime 1 a"
   by (rule coprimeI)
 
 lemma coprime_1_right [simp]:
   "coprime a 1"
   by (rule coprimeI)
 
 lemma coprime_0_left_iff [simp]:
   "coprime 0 a \<longleftrightarrow> is_unit a"
   by (auto intro: coprimeI dvd_unit_imp_unit coprime_common_divisor [of 0 a a])
 
 lemma coprime_0_right_iff [simp]:
   "coprime a 0 \<longleftrightarrow> is_unit a"
   using coprime_0_left_iff [of a] by (simp add: ac_simps)
 
 lemma coprime_mult_self_left_iff [simp]:
   "coprime (c * a) (c * b) \<longleftrightarrow> is_unit c \<and> coprime a b"
   by (auto intro: coprime_common_divisor)
     (rule coprimeI, auto intro: coprime_common_divisor simp add: dvd_mult_unit_iff')+
 
 lemma coprime_mult_self_right_iff [simp]:
   "coprime (a * c) (b * c) \<longleftrightarrow> is_unit c \<and> coprime a b"
   using coprime_mult_self_left_iff [of c a b] by (simp add: ac_simps)
 
 lemma coprime_absorb_left:
   assumes "x dvd y"
   shows   "coprime x y \<longleftrightarrow> is_unit x"
   using assms coprime_common_divisor is_unit_left_imp_coprime by auto
 
 lemma coprime_absorb_right:
   assumes "y dvd x"
   shows   "coprime x y \<longleftrightarrow> is_unit y"
   using assms coprime_common_divisor is_unit_right_imp_coprime by auto
 
 end
 
 class unit_factor =
   fixes unit_factor :: "'a \<Rightarrow> 'a"
 
 class semidom_divide_unit_factor = semidom_divide + unit_factor +
   assumes unit_factor_0 [simp]: "unit_factor 0 = 0"
     and is_unit_unit_factor: "a dvd 1 \<Longrightarrow> unit_factor a = a"
     and unit_factor_is_unit: "a \<noteq> 0 \<Longrightarrow> unit_factor a dvd 1"
     and unit_factor_mult: "unit_factor (a * b) = unit_factor a * unit_factor b"
   \<comment> \<open>This fine-grained hierarchy will later on allow lean normalization of polynomials\<close>
   
 class normalization_semidom = algebraic_semidom + semidom_divide_unit_factor +
   fixes normalize :: "'a \<Rightarrow> 'a"
   assumes unit_factor_mult_normalize [simp]: "unit_factor a * normalize a = a"
     and normalize_0 [simp]: "normalize 0 = 0"
 begin
 
 text \<open>
   Class \<^class>\<open>normalization_semidom\<close> cultivates the idea that each integral
   domain can be split into equivalence classes whose representants are
   associated, i.e. divide each other. \<^const>\<open>normalize\<close> specifies a canonical
   representant for each equivalence class. The rationale behind this is that
   it is easier to reason about equality than equivalences, hence we prefer to
   think about equality of normalized values rather than associated elements.
 \<close>
 
 declare unit_factor_is_unit [iff]
   
 lemma unit_factor_dvd [simp]: "a \<noteq> 0 \<Longrightarrow> unit_factor a dvd b"
   by (rule unit_imp_dvd) simp
 
 lemma unit_factor_self [simp]: "unit_factor a dvd a"
   by (cases "a = 0") simp_all
 
 lemma normalize_mult_unit_factor [simp]: "normalize a * unit_factor a = a"
   using unit_factor_mult_normalize [of a] by (simp add: ac_simps)
 
 lemma normalize_eq_0_iff [simp]: "normalize a = 0 \<longleftrightarrow> a = 0"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume ?lhs
   moreover have "unit_factor a * normalize a = a" by simp
   ultimately show ?rhs by simp
 next
   assume ?rhs
   then show ?lhs by simp
 qed
 
 lemma unit_factor_eq_0_iff [simp]: "unit_factor a = 0 \<longleftrightarrow> a = 0"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume ?lhs
   moreover have "unit_factor a * normalize a = a" by simp
   ultimately show ?rhs by simp
 next
   assume ?rhs
   then show ?lhs by simp
 qed
 
 lemma div_unit_factor [simp]: "a div unit_factor a = normalize a"
 proof (cases "a = 0")
   case True
   then show ?thesis by simp
 next
   case False
   then have "unit_factor a \<noteq> 0"
     by simp
   with nonzero_mult_div_cancel_left
   have "unit_factor a * normalize a div unit_factor a = normalize a"
     by blast
   then show ?thesis by simp
 qed
 
 lemma normalize_div [simp]: "normalize a div a = 1 div unit_factor a"
 proof (cases "a = 0")
   case True
   then show ?thesis by simp
 next
   case False
   have "normalize a div a = normalize a div (unit_factor a * normalize a)"
     by simp
   also have "\<dots> = 1 div unit_factor a"
     using False by (subst is_unit_div_mult_cancel_right) simp_all
   finally show ?thesis .
 qed
 
 lemma is_unit_normalize:
   assumes "is_unit a"
   shows "normalize a = 1"
 proof -
   from assms have "unit_factor a = a"
     by (rule is_unit_unit_factor)
   moreover from assms have "a \<noteq> 0"
     by auto
   moreover have "normalize a = a div unit_factor a"
     by simp
   ultimately show ?thesis
     by simp
 qed
 
 lemma unit_factor_1 [simp]: "unit_factor 1 = 1"
   by (rule is_unit_unit_factor) simp
 
 lemma normalize_1 [simp]: "normalize 1 = 1"
   by (rule is_unit_normalize) simp
 
 lemma normalize_1_iff: "normalize a = 1 \<longleftrightarrow> is_unit a"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume ?rhs
   then show ?lhs by (rule is_unit_normalize)
 next
   assume ?lhs
   then have "unit_factor a * normalize a = unit_factor a * 1"
     by simp
   then have "unit_factor a = a"
     by simp
   moreover
   from \<open>?lhs\<close> have "a \<noteq> 0" by auto
   then have "is_unit (unit_factor a)" by simp
   ultimately show ?rhs by simp
 qed
 
 lemma div_normalize [simp]: "a div normalize a = unit_factor a"
 proof (cases "a = 0")
   case True
   then show ?thesis by simp
 next
   case False
   then have "normalize a \<noteq> 0" by simp
   with nonzero_mult_div_cancel_right
   have "unit_factor a * normalize a div normalize a = unit_factor a" by blast
   then show ?thesis by simp
 qed
 
 lemma mult_one_div_unit_factor [simp]: "a * (1 div unit_factor b) = a div unit_factor b"
   by (cases "b = 0") simp_all
 
 lemma inv_unit_factor_eq_0_iff [simp]:
   "1 div unit_factor a = 0 \<longleftrightarrow> a = 0"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume ?lhs
   then have "a * (1 div unit_factor a) = a * 0"
     by simp
   then show ?rhs
     by simp
 next
   assume ?rhs
   then show ?lhs by simp
 qed
 
 lemma normalize_mult: "normalize (a * b) = normalize a * normalize b"
 proof (cases "a = 0 \<or> b = 0")
   case True
   then show ?thesis by auto
 next
   case False
   have "unit_factor (a * b) * normalize (a * b) = a * b"
     by (rule unit_factor_mult_normalize)
   then have "normalize (a * b) = a * b div unit_factor (a * b)"
     by simp
   also have "\<dots> = a * b div unit_factor (b * a)"
     by (simp add: ac_simps)
   also have "\<dots> = a * b div unit_factor b div unit_factor a"
     using False by (simp add: unit_factor_mult is_unit_div_mult2_eq [symmetric])
   also have "\<dots> = a * (b div unit_factor b) div unit_factor a"
     using False by (subst unit_div_mult_swap) simp_all
   also have "\<dots> = normalize a * normalize b"
     using False
     by (simp add: mult.commute [of a] mult.commute [of "normalize a"] unit_div_mult_swap [symmetric])
   finally show ?thesis .
 qed
 
 lemma unit_factor_idem [simp]: "unit_factor (unit_factor a) = unit_factor a"
   by (cases "a = 0") (auto intro: is_unit_unit_factor)
 
 lemma normalize_unit_factor [simp]: "a \<noteq> 0 \<Longrightarrow> normalize (unit_factor a) = 1"
   by (rule is_unit_normalize) simp
 
 lemma normalize_idem [simp]: "normalize (normalize a) = normalize a"
 proof (cases "a = 0")
   case True
   then show ?thesis by simp
 next
   case False
   have "normalize a = normalize (unit_factor a * normalize a)"
     by simp
   also have "\<dots> = normalize (unit_factor a) * normalize (normalize a)"
     by (simp only: normalize_mult)
   finally show ?thesis
     using False by simp_all
 qed
 
 lemma unit_factor_normalize [simp]:
   assumes "a \<noteq> 0"
   shows "unit_factor (normalize a) = 1"
 proof -
   from assms have *: "normalize a \<noteq> 0"
     by simp
   have "unit_factor (normalize a) * normalize (normalize a) = normalize a"
     by (simp only: unit_factor_mult_normalize)
   then have "unit_factor (normalize a) * normalize a = normalize a"
     by simp
   with * have "unit_factor (normalize a) * normalize a div normalize a = normalize a div normalize a"
     by simp
   with * show ?thesis
     by simp
 qed
 
 lemma dvd_unit_factor_div:
   assumes "b dvd a"
   shows "unit_factor (a div b) = unit_factor a div unit_factor b"
 proof -
   from assms have "a = a div b * b"
     by simp
   then have "unit_factor a = unit_factor (a div b * b)"
     by simp
   then show ?thesis
     by (cases "b = 0") (simp_all add: unit_factor_mult)
 qed
 
 lemma dvd_normalize_div:
   assumes "b dvd a"
   shows "normalize (a div b) = normalize a div normalize b"
 proof -
   from assms have "a = a div b * b"
     by simp
   then have "normalize a = normalize (a div b * b)"
     by simp
   then show ?thesis
     by (cases "b = 0") (simp_all add: normalize_mult)
 qed
 
 lemma normalize_dvd_iff [simp]: "normalize a dvd b \<longleftrightarrow> a dvd b"
 proof -
   have "normalize a dvd b \<longleftrightarrow> unit_factor a * normalize a dvd b"
     using mult_unit_dvd_iff [of "unit_factor a" "normalize a" b]
       by (cases "a = 0") simp_all
   then show ?thesis by simp
 qed
 
 lemma dvd_normalize_iff [simp]: "a dvd normalize b \<longleftrightarrow> a dvd b"
 proof -
   have "a dvd normalize  b \<longleftrightarrow> a dvd normalize b * unit_factor b"
     using dvd_mult_unit_iff [of "unit_factor b" a "normalize b"]
       by (cases "b = 0") simp_all
   then show ?thesis by simp
 qed
 
 lemma normalize_idem_imp_unit_factor_eq:
   assumes "normalize a = a"
   shows "unit_factor a = of_bool (a \<noteq> 0)"
 proof (cases "a = 0")
   case True
   then show ?thesis
     by simp
 next
   case False
   then show ?thesis
     using assms unit_factor_normalize [of a] by simp
 qed
 
 lemma normalize_idem_imp_is_unit_iff:
   assumes "normalize a = a"
   shows "is_unit a \<longleftrightarrow> a = 1"
   using assms by (cases "a = 0") (auto dest: is_unit_normalize)
 
 lemma coprime_normalize_left_iff [simp]:
   "coprime (normalize a) b \<longleftrightarrow> coprime a b"
   by (rule; rule coprimeI) (auto intro: coprime_common_divisor)
 
 lemma coprime_normalize_right_iff [simp]:
   "coprime a (normalize b) \<longleftrightarrow> coprime a b"
   using coprime_normalize_left_iff [of b a] by (simp add: ac_simps)
 
 text \<open>
   We avoid an explicit definition of associated elements but prefer explicit
   normalisation instead. In theory we could define an abbreviation like \<^prop>\<open>associated a b \<longleftrightarrow> normalize a = normalize b\<close> but this is counterproductive
   without suggestive infix syntax, which we do not want to sacrifice for this
   purpose here.
 \<close>
 
 lemma associatedI:
   assumes "a dvd b" and "b dvd a"
   shows "normalize a = normalize b"
 proof (cases "a = 0 \<or> b = 0")
   case True
   with assms show ?thesis by auto
 next
   case False
   from \<open>a dvd b\<close> obtain c where b: "b = a * c" ..
   moreover from \<open>b dvd a\<close> obtain d where a: "a = b * d" ..
   ultimately have "b * 1 = b * (c * d)"
     by (simp add: ac_simps)
   with False have "1 = c * d"
     unfolding mult_cancel_left by simp
   then have "is_unit c" and "is_unit d"
     by auto
   with a b show ?thesis
     by (simp add: normalize_mult is_unit_normalize)
 qed
 
 lemma associatedD1: "normalize a = normalize b \<Longrightarrow> a dvd b"
   using dvd_normalize_iff [of _ b, symmetric] normalize_dvd_iff [of a _, symmetric]
   by simp
 
 lemma associatedD2: "normalize a = normalize b \<Longrightarrow> b dvd a"
   using dvd_normalize_iff [of _ a, symmetric] normalize_dvd_iff [of b _, symmetric]
   by simp
 
 lemma associated_unit: "normalize a = normalize b \<Longrightarrow> is_unit a \<Longrightarrow> is_unit b"
   using dvd_unit_imp_unit by (auto dest!: associatedD1 associatedD2)
 
 lemma associated_iff_dvd: "normalize a = normalize b \<longleftrightarrow> a dvd b \<and> b dvd a"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume ?rhs
   then show ?lhs by (auto intro!: associatedI)
 next
   assume ?lhs
   then have "unit_factor a * normalize a = unit_factor a * normalize b"
     by simp
   then have *: "normalize b * unit_factor a = a"
     by (simp add: ac_simps)
   show ?rhs
   proof (cases "a = 0 \<or> b = 0")
     case True
     with \<open>?lhs\<close> show ?thesis by auto
   next
     case False
     then have "b dvd normalize b * unit_factor a" and "normalize b * unit_factor a dvd b"
       by (simp_all add: mult_unit_dvd_iff dvd_mult_unit_iff)
     with * show ?thesis by simp
   qed
 qed
 
 lemma associated_eqI:
   assumes "a dvd b" and "b dvd a"
   assumes "normalize a = a" and "normalize b = b"
   shows "a = b"
 proof -
   from assms have "normalize a = normalize b"
     unfolding associated_iff_dvd by simp
   with \<open>normalize a = a\<close> have "a = normalize b"
     by simp
   with \<open>normalize b = b\<close> show "a = b"
     by simp
 qed
 
 lemma normalize_unit_factor_eqI:
   assumes "normalize a = normalize b"
     and "unit_factor a = unit_factor b"
   shows "a = b"
 proof -
   from assms have "unit_factor a * normalize a = unit_factor b * normalize b"
     by simp
   then show ?thesis
     by simp
 qed
 
 end
 
 
 text \<open>Syntactic division remainder operator\<close>
 
 class modulo = dvd + divide +
   fixes modulo :: "'a \<Rightarrow> 'a \<Rightarrow> 'a"  (infixl "mod" 70)
 
 text \<open>Arbitrary quotient and remainder partitions\<close>
 
 class semiring_modulo = comm_semiring_1_cancel + divide + modulo +
   assumes div_mult_mod_eq: "a div b * b + a mod b = a"
 begin
 
 lemma mod_div_decomp:
   fixes a b
   obtains q r where "q = a div b" and "r = a mod b"
     and "a = q * b + r"
 proof -
   from div_mult_mod_eq have "a = a div b * b + a mod b" by simp
   moreover have "a div b = a div b" ..
   moreover have "a mod b = a mod b" ..
   note that ultimately show thesis by blast
 qed
 
 lemma mult_div_mod_eq: "b * (a div b) + a mod b = a"
   using div_mult_mod_eq [of a b] by (simp add: ac_simps)
 
 lemma mod_div_mult_eq: "a mod b + a div b * b = a"
   using div_mult_mod_eq [of a b] by (simp add: ac_simps)
 
 lemma mod_mult_div_eq: "a mod b + b * (a div b) = a"
   using div_mult_mod_eq [of a b] by (simp add: ac_simps)
 
 lemma minus_div_mult_eq_mod: "a - a div b * b = a mod b"
   by (rule add_implies_diff [symmetric]) (fact mod_div_mult_eq)
 
 lemma minus_mult_div_eq_mod: "a - b * (a div b) = a mod b"
   by (rule add_implies_diff [symmetric]) (fact mod_mult_div_eq)
 
 lemma minus_mod_eq_div_mult: "a - a mod b = a div b * b"
   by (rule add_implies_diff [symmetric]) (fact div_mult_mod_eq)
 
 lemma minus_mod_eq_mult_div: "a - a mod b = b * (a div b)"
   by (rule add_implies_diff [symmetric]) (fact mult_div_mod_eq)
 
 lemma mod_0_imp_dvd [dest!]:
   "b dvd a" if "a mod b = 0"
 proof -
   have "b dvd (a div b) * b" by simp
   also have "(a div b) * b = a"
     using div_mult_mod_eq [of a b] by (simp add: that)
   finally show ?thesis .
 qed
 
 lemma [nitpick_unfold]:
   "a mod b = a - a div b * b"
   by (fact minus_div_mult_eq_mod [symmetric])
 
 end
 
 
 subsection \<open>Quotient and remainder in integral domains\<close>
 
 class semidom_modulo = algebraic_semidom + semiring_modulo
 begin
 
 lemma mod_0 [simp]: "0 mod a = 0"
   using div_mult_mod_eq [of 0 a] by simp
 
 lemma mod_by_0 [simp]: "a mod 0 = a"
   using div_mult_mod_eq [of a 0] by simp
 
 lemma mod_by_1 [simp]:
   "a mod 1 = 0"
 proof -
   from div_mult_mod_eq [of a one] div_by_1 have "a + a mod 1 = a" by simp
   then have "a + a mod 1 = a + 0" by simp
   then show ?thesis by (rule add_left_imp_eq)
 qed
 
 lemma mod_self [simp]:
   "a mod a = 0"
   using div_mult_mod_eq [of a a] by simp
 
 lemma dvd_imp_mod_0 [simp]:
   "b mod a = 0" if "a dvd b"
   using that minus_div_mult_eq_mod [of b a] by simp
 
 lemma mod_eq_0_iff_dvd:
   "a mod b = 0 \<longleftrightarrow> b dvd a"
   by (auto intro: mod_0_imp_dvd)
 
 lemma dvd_eq_mod_eq_0 [nitpick_unfold, code]:
   "a dvd b \<longleftrightarrow> b mod a = 0"
   by (simp add: mod_eq_0_iff_dvd)
 
 lemma dvd_mod_iff: 
   assumes "c dvd b"
   shows "c dvd a mod b \<longleftrightarrow> c dvd a"
 proof -
   from assms have "(c dvd a mod b) \<longleftrightarrow> (c dvd ((a div b) * b + a mod b))" 
     by (simp add: dvd_add_right_iff)
   also have "(a div b) * b + a mod b = a"
     using div_mult_mod_eq [of a b] by simp
   finally show ?thesis .
 qed
 
 lemma dvd_mod_imp_dvd:
   assumes "c dvd a mod b" and "c dvd b"
   shows "c dvd a"
   using assms dvd_mod_iff [of c b a] by simp
 
 lemma dvd_minus_mod [simp]:
   "b dvd a - a mod b"
   by (simp add: minus_mod_eq_div_mult)
 
 lemma cancel_div_mod_rules:
   "((a div b) * b + a mod b) + c = a + c"
   "(b * (a div b) + a mod b) + c = a + c"
   by (simp_all add: div_mult_mod_eq mult_div_mod_eq)
 
 end
 
 class idom_modulo = idom + semidom_modulo
 begin
 
 subclass idom_divide ..
 
 lemma div_diff [simp]:
   "c dvd a \<Longrightarrow> c dvd b \<Longrightarrow> (a - b) div c = a div c - b div c"
   using div_add [of _  _ "- b"] by (simp add: dvd_neg_div)
 
 end
 
 
 subsection \<open>Interlude: basic tool support for algebraic and arithmetic calculations\<close>
 
 named_theorems arith "arith facts -- only ground formulas"
 ML_file \<open>Tools/arith_data.ML\<close>
 
 ML_file \<open>~~/src/Provers/Arith/cancel_div_mod.ML\<close>
 
 ML \<open>
 structure Cancel_Div_Mod_Ring = Cancel_Div_Mod
 (
   val div_name = \<^const_name>\<open>divide\<close>;
   val mod_name = \<^const_name>\<open>modulo\<close>;
   val mk_binop = HOLogic.mk_binop;
   val mk_sum = Arith_Data.mk_sum;
   val dest_sum = Arith_Data.dest_sum;
 
   val div_mod_eqs = map mk_meta_eq @{thms cancel_div_mod_rules};
 
   val prove_eq_sums = Arith_Data.prove_conv2 all_tac (Arith_Data.simp_all_tac
     @{thms diff_conv_add_uminus add_0_left add_0_right ac_simps})
 )
 \<close>
 
 simproc_setup cancel_div_mod_int ("(a::'a::semidom_modulo) + b") =
   \<open>K Cancel_Div_Mod_Ring.proc\<close>
 
 
 subsection \<open>Ordered semirings and rings\<close>
 
 text \<open>
   The theory of partially ordered rings is taken from the books:
     \<^item> \<^emph>\<open>Lattice Theory\<close> by Garret Birkhoff, American Mathematical Society, 1979
     \<^item> \<^emph>\<open>Partially Ordered Algebraic Systems\<close>, Pergamon Press, 1963
 
   Most of the used notions can also be looked up in
     \<^item> \<^url>\<open>http://www.mathworld.com\<close> by Eric Weisstein et. al.
     \<^item> \<^emph>\<open>Algebra I\<close> by van der Waerden, Springer
 \<close>
 
 class ordered_semiring = semiring + ordered_comm_monoid_add +
   assumes mult_left_mono: "a \<le> b \<Longrightarrow> 0 \<le> c \<Longrightarrow> c * a \<le> c * b"
   assumes mult_right_mono: "a \<le> b \<Longrightarrow> 0 \<le> c \<Longrightarrow> a * c \<le> b * c"
 begin
 
 lemma mult_mono: "a \<le> b \<Longrightarrow> c \<le> d \<Longrightarrow> 0 \<le> b \<Longrightarrow> 0 \<le> c \<Longrightarrow> a * c \<le> b * d"
   apply (erule (1) mult_right_mono [THEN order_trans])
   apply (erule (1) mult_left_mono)
   done
 
 lemma mult_mono': "a \<le> b \<Longrightarrow> c \<le> d \<Longrightarrow> 0 \<le> a \<Longrightarrow> 0 \<le> c \<Longrightarrow> a * c \<le> b * d"
   by (rule mult_mono) (fast intro: order_trans)+
 
 end
 
 class ordered_semiring_0 = semiring_0 + ordered_semiring
 begin
 
 lemma mult_nonneg_nonneg [simp]: "0 \<le> a \<Longrightarrow> 0 \<le> b \<Longrightarrow> 0 \<le> a * b"
   using mult_left_mono [of 0 b a] by simp
 
 lemma mult_nonneg_nonpos: "0 \<le> a \<Longrightarrow> b \<le> 0 \<Longrightarrow> a * b \<le> 0"
   using mult_left_mono [of b 0 a] by simp
 
 lemma mult_nonpos_nonneg: "a \<le> 0 \<Longrightarrow> 0 \<le> b \<Longrightarrow> a * b \<le> 0"
   using mult_right_mono [of a 0 b] by simp
 
 text \<open>Legacy -- use @{thm [source] mult_nonpos_nonneg}.\<close>
 lemma mult_nonneg_nonpos2: "0 \<le> a \<Longrightarrow> b \<le> 0 \<Longrightarrow> b * a \<le> 0"
   by (drule mult_right_mono [of b 0]) auto
 
 lemma split_mult_neg_le: "(0 \<le> a \<and> b \<le> 0) \<or> (a \<le> 0 \<and> 0 \<le> b) \<Longrightarrow> a * b \<le> 0"
   by (auto simp add: mult_nonneg_nonpos mult_nonneg_nonpos2)
 
 end
 
 class ordered_cancel_semiring = ordered_semiring + cancel_comm_monoid_add
 begin
 
 subclass semiring_0_cancel ..
 
 subclass ordered_semiring_0 ..
 
 end
 
 class linordered_semiring = ordered_semiring + linordered_cancel_ab_semigroup_add
 begin
 
 subclass ordered_cancel_semiring ..
 
 subclass ordered_cancel_comm_monoid_add ..
 
 subclass ordered_ab_semigroup_monoid_add_imp_le ..
 
 lemma mult_left_less_imp_less: "c * a < c * b \<Longrightarrow> 0 \<le> c \<Longrightarrow> a < b"
   by (force simp add: mult_left_mono not_le [symmetric])
 
 lemma mult_right_less_imp_less: "a * c < b * c \<Longrightarrow> 0 \<le> c \<Longrightarrow> a < b"
   by (force simp add: mult_right_mono not_le [symmetric])
 
 end
 
 class zero_less_one = order + zero + one +
   assumes zero_less_one [simp]: "0 < 1"
 
 class linordered_semiring_1 = linordered_semiring + semiring_1 + zero_less_one
 begin
 
 lemma convex_bound_le:
   assumes "x \<le> a" "y \<le> a" "0 \<le> u" "0 \<le> v" "u + v = 1"
   shows "u * x + v * y \<le> a"
 proof-
   from assms have "u * x + v * y \<le> u * a + v * a"
     by (simp add: add_mono mult_left_mono)
   with assms show ?thesis
     unfolding distrib_right[symmetric] by simp
 qed
 
 end
 
 class linordered_semiring_strict = semiring + comm_monoid_add + linordered_cancel_ab_semigroup_add +
   assumes mult_strict_left_mono: "a < b \<Longrightarrow> 0 < c \<Longrightarrow> c * a < c * b"
   assumes mult_strict_right_mono: "a < b \<Longrightarrow> 0 < c \<Longrightarrow> a * c < b * c"
 begin
 
 subclass semiring_0_cancel ..
 
 subclass linordered_semiring
 proof
   fix a b c :: 'a
   assume *: "a \<le> b" "0 \<le> c"
   then show "c * a \<le> c * b"
     unfolding le_less
     using mult_strict_left_mono by (cases "c = 0") auto
   from * show "a * c \<le> b * c"
     unfolding le_less
     using mult_strict_right_mono by (cases "c = 0") auto
 qed
 
 lemma mult_left_le_imp_le: "c * a \<le> c * b \<Longrightarrow> 0 < c \<Longrightarrow> a \<le> b"
   by (auto simp add: mult_strict_left_mono _not_less [symmetric])
 
 lemma mult_right_le_imp_le: "a * c \<le> b * c \<Longrightarrow> 0 < c \<Longrightarrow> a \<le> b"
   by (auto simp add: mult_strict_right_mono not_less [symmetric])
 
 lemma mult_pos_pos[simp]: "0 < a \<Longrightarrow> 0 < b \<Longrightarrow> 0 < a * b"
   using mult_strict_left_mono [of 0 b a] by simp
 
 lemma mult_pos_neg: "0 < a \<Longrightarrow> b < 0 \<Longrightarrow> a * b < 0"
   using mult_strict_left_mono [of b 0 a] by simp
 
 lemma mult_neg_pos: "a < 0 \<Longrightarrow> 0 < b \<Longrightarrow> a * b < 0"
   using mult_strict_right_mono [of a 0 b] by simp
 
 text \<open>Legacy -- use @{thm [source] mult_neg_pos}.\<close>
 lemma mult_pos_neg2: "0 < a \<Longrightarrow> b < 0 \<Longrightarrow> b * a < 0"
   by (drule mult_strict_right_mono [of b 0]) auto
 
 lemma zero_less_mult_pos: "0 < a * b \<Longrightarrow> 0 < a \<Longrightarrow> 0 < b"
   apply (cases "b \<le> 0")
    apply (auto simp add: le_less not_less)
   apply (drule_tac mult_pos_neg [of a b])
    apply (auto dest: less_not_sym)
   done
 
 lemma zero_less_mult_pos2: "0 < b * a \<Longrightarrow> 0 < a \<Longrightarrow> 0 < b"
   apply (cases "b \<le> 0")
    apply (auto simp add: le_less not_less)
   apply (drule_tac mult_pos_neg2 [of a b])
    apply (auto dest: less_not_sym)
   done
 
 text \<open>Strict monotonicity in both arguments\<close>
 lemma mult_strict_mono:
   assumes "a < b" and "c < d" and "0 < b" and "0 \<le> c"
   shows "a * c < b * d"
   using assms
   apply (cases "c = 0")
    apply simp
   apply (erule mult_strict_right_mono [THEN less_trans])
    apply (auto simp add: le_less)
   apply (erule (1) mult_strict_left_mono)
   done
 
 text \<open>This weaker variant has more natural premises\<close>
 lemma mult_strict_mono':
   assumes "a < b" and "c < d" and "0 \<le> a" and "0 \<le> c"
   shows "a * c < b * d"
   by (rule mult_strict_mono) (insert assms, auto)
 
 lemma mult_less_le_imp_less:
   assumes "a < b" and "c \<le> d" and "0 \<le> a" and "0 < c"
   shows "a * c < b * d"
   using assms
   apply (subgoal_tac "a * c < b * c")
    apply (erule less_le_trans)
    apply (erule mult_left_mono)
    apply simp
   apply (erule (1) mult_strict_right_mono)
   done
 
 lemma mult_le_less_imp_less:
   assumes "a \<le> b" and "c < d" and "0 < a" and "0 \<le> c"
   shows "a * c < b * d"
   using assms
   apply (subgoal_tac "a * c \<le> b * c")
    apply (erule le_less_trans)
    apply (erule mult_strict_left_mono)
    apply simp
   apply (erule (1) mult_right_mono)
   done
 
 end
 
 class linordered_semiring_1_strict = linordered_semiring_strict + semiring_1 + zero_less_one
 begin
 
 subclass linordered_semiring_1 ..
 
 lemma convex_bound_lt:
   assumes "x < a" "y < a" "0 \<le> u" "0 \<le> v" "u + v = 1"
   shows "u * x + v * y < a"
 proof -
   from assms have "u * x + v * y < u * a + v * a"
     by (cases "u = 0") (auto intro!: add_less_le_mono mult_strict_left_mono mult_left_mono)
   with assms show ?thesis
     unfolding distrib_right[symmetric] by simp
 qed
 
 end
 
 class ordered_comm_semiring = comm_semiring_0 + ordered_ab_semigroup_add +
   assumes comm_mult_left_mono: "a \<le> b \<Longrightarrow> 0 \<le> c \<Longrightarrow> c * a \<le> c * b"
 begin
 
 subclass ordered_semiring
 proof
   fix a b c :: 'a
   assume "a \<le> b" "0 \<le> c"
   then show "c * a \<le> c * b" by (rule comm_mult_left_mono)
   then show "a * c \<le> b * c" by (simp only: mult.commute)
 qed
 
 end
 
 class ordered_cancel_comm_semiring = ordered_comm_semiring + cancel_comm_monoid_add
 begin
 
 subclass comm_semiring_0_cancel ..
 subclass ordered_comm_semiring ..
 subclass ordered_cancel_semiring ..
 
 end
 
 class linordered_comm_semiring_strict = comm_semiring_0 + linordered_cancel_ab_semigroup_add +
   assumes comm_mult_strict_left_mono: "a < b \<Longrightarrow> 0 < c \<Longrightarrow> c * a < c * b"
 begin
 
 subclass linordered_semiring_strict
 proof
   fix a b c :: 'a
   assume "a < b" "0 < c"
   then show "c * a < c * b"
     by (rule comm_mult_strict_left_mono)
   then show "a * c < b * c"
     by (simp only: mult.commute)
 qed
 
 subclass ordered_cancel_comm_semiring
 proof
   fix a b c :: 'a
   assume "a \<le> b" "0 \<le> c"
   then show "c * a \<le> c * b"
     unfolding le_less
     using mult_strict_left_mono by (cases "c = 0") auto
 qed
 
 end
 
 class ordered_ring = ring + ordered_cancel_semiring
 begin
 
 subclass ordered_ab_group_add ..
 
 lemma less_add_iff1: "a * e + c < b * e + d \<longleftrightarrow> (a - b) * e + c < d"
   by (simp add: algebra_simps)
 
 lemma less_add_iff2: "a * e + c < b * e + d \<longleftrightarrow> c < (b - a) * e + d"
   by (simp add: algebra_simps)
 
 lemma le_add_iff1: "a * e + c \<le> b * e + d \<longleftrightarrow> (a - b) * e + c \<le> d"
   by (simp add: algebra_simps)
 
 lemma le_add_iff2: "a * e + c \<le> b * e + d \<longleftrightarrow> c \<le> (b - a) * e + d"
   by (simp add: algebra_simps)
 
 lemma mult_left_mono_neg: "b \<le> a \<Longrightarrow> c \<le> 0 \<Longrightarrow> c * a \<le> c * b"
   apply (drule mult_left_mono [of _ _ "- c"])
   apply simp_all
   done
 
 lemma mult_right_mono_neg: "b \<le> a \<Longrightarrow> c \<le> 0 \<Longrightarrow> a * c \<le> b * c"
   apply (drule mult_right_mono [of _ _ "- c"])
   apply simp_all
   done
 
 lemma mult_nonpos_nonpos: "a \<le> 0 \<Longrightarrow> b \<le> 0 \<Longrightarrow> 0 \<le> a * b"
   using mult_right_mono_neg [of a 0 b] by simp
 
 lemma split_mult_pos_le: "(0 \<le> a \<and> 0 \<le> b) \<or> (a \<le> 0 \<and> b \<le> 0) \<Longrightarrow> 0 \<le> a * b"
   by (auto simp add: mult_nonpos_nonpos)
 
 end
 
 class abs_if = minus + uminus + ord + zero + abs +
   assumes abs_if: "\<bar>a\<bar> = (if a < 0 then - a else a)"
 
 class linordered_ring = ring + linordered_semiring + linordered_ab_group_add + abs_if
 begin
 
 subclass ordered_ring ..
 
 subclass ordered_ab_group_add_abs
 proof
   fix a b
   show "\<bar>a + b\<bar> \<le> \<bar>a\<bar> + \<bar>b\<bar>"
     by (auto simp add: abs_if not_le not_less algebra_simps
         simp del: add.commute dest: add_neg_neg add_nonneg_nonneg)
 qed (auto simp: abs_if)
 
 lemma zero_le_square [simp]: "0 \<le> a * a"
   using linear [of 0 a] by (auto simp add: mult_nonpos_nonpos)
 
 lemma not_square_less_zero [simp]: "\<not> (a * a < 0)"
   by (simp add: not_less)
 
 proposition abs_eq_iff: "\<bar>x\<bar> = \<bar>y\<bar> \<longleftrightarrow> x = y \<or> x = -y"
   by (auto simp add: abs_if split: if_split_asm)
 
 lemma abs_eq_iff':
   "\<bar>a\<bar> = b \<longleftrightarrow> b \<ge> 0 \<and> (a = b \<or> a = - b)"
   by (cases "a \<ge> 0") auto
 
 lemma eq_abs_iff':
   "a = \<bar>b\<bar> \<longleftrightarrow> a \<ge> 0 \<and> (b = a \<or> b = - a)"
   using abs_eq_iff' [of b a] by auto
 
 lemma sum_squares_ge_zero: "0 \<le> x * x + y * y"
   by (intro add_nonneg_nonneg zero_le_square)
 
 lemma not_sum_squares_lt_zero: "\<not> x * x + y * y < 0"
   by (simp add: not_less sum_squares_ge_zero)
 
 end
 
 class linordered_ring_strict = ring + linordered_semiring_strict
   + ordered_ab_group_add + abs_if
 begin
 
 subclass linordered_ring ..
 
 lemma mult_strict_left_mono_neg: "b < a \<Longrightarrow> c < 0 \<Longrightarrow> c * a < c * b"
   using mult_strict_left_mono [of b a "- c"] by simp
 
 lemma mult_strict_right_mono_neg: "b < a \<Longrightarrow> c < 0 \<Longrightarrow> a * c < b * c"
   using mult_strict_right_mono [of b a "- c"] by simp
 
 lemma mult_neg_neg: "a < 0 \<Longrightarrow> b < 0 \<Longrightarrow> 0 < a * b"
   using mult_strict_right_mono_neg [of a 0 b] by simp
 
 subclass ring_no_zero_divisors
 proof
   fix a b
   assume "a \<noteq> 0"
   then have a: "a < 0 \<or> 0 < a" by (simp add: neq_iff)
   assume "b \<noteq> 0"
   then have b: "b < 0 \<or> 0 < b" by (simp add: neq_iff)
   have "a * b < 0 \<or> 0 < a * b"
   proof (cases "a < 0")
     case True
     show ?thesis
     proof (cases "b < 0")
       case True
       with \<open>a < 0\<close> show ?thesis by (auto dest: mult_neg_neg)
     next
       case False
       with b have "0 < b" by auto
       with \<open>a < 0\<close> show ?thesis by (auto dest: mult_strict_right_mono)
     qed
   next
     case False
     with a have "0 < a" by auto
     show ?thesis
     proof (cases "b < 0")
       case True
       with \<open>0 < a\<close> show ?thesis
         by (auto dest: mult_strict_right_mono_neg)
     next
       case False
       with b have "0 < b" by auto
       with \<open>0 < a\<close> show ?thesis by auto
     qed
   qed
   then show "a * b \<noteq> 0"
     by (simp add: neq_iff)
 qed
 
 lemma zero_less_mult_iff [algebra_split_simps, field_split_simps]:
   "0 < a * b \<longleftrightarrow> 0 < a \<and> 0 < b \<or> a < 0 \<and> b < 0"
   by (cases a 0 b 0 rule: linorder_cases[case_product linorder_cases])
      (auto simp add: mult_neg_neg not_less le_less dest: zero_less_mult_pos zero_less_mult_pos2)
 
 lemma zero_le_mult_iff [algebra_split_simps, field_split_simps]:
   "0 \<le> a * b \<longleftrightarrow> 0 \<le> a \<and> 0 \<le> b \<or> a \<le> 0 \<and> b \<le> 0"
   by (auto simp add: eq_commute [of 0] le_less not_less zero_less_mult_iff)
 
 lemma mult_less_0_iff [algebra_split_simps, field_split_simps]:
   "a * b < 0 \<longleftrightarrow> 0 < a \<and> b < 0 \<or> a < 0 \<and> 0 < b"
   using zero_less_mult_iff [of "- a" b] by auto
 
 lemma mult_le_0_iff [algebra_split_simps, field_split_simps]:
   "a * b \<le> 0 \<longleftrightarrow> 0 \<le> a \<and> b \<le> 0 \<or> a \<le> 0 \<and> 0 \<le> b"
   using zero_le_mult_iff [of "- a" b] by auto
 
 text \<open>
   Cancellation laws for \<^term>\<open>c * a < c * b\<close> and \<^term>\<open>a * c < b * c\<close>,
   also with the relations \<open>\<le>\<close> and equality.
 \<close>
 
 text \<open>
   These ``disjunction'' versions produce two cases when the comparison is
   an assumption, but effectively four when the comparison is a goal.
 \<close>
 
 lemma mult_less_cancel_right_disj: "a * c < b * c \<longleftrightarrow> 0 < c \<and> a < b \<or> c < 0 \<and>  b < a"
   apply (cases "c = 0")
    apply (auto simp add: neq_iff mult_strict_right_mono mult_strict_right_mono_neg)
      apply (auto simp add: not_less not_le [symmetric, of "a*c"] not_le [symmetric, of a])
      apply (erule_tac [!] notE)
      apply (auto simp add: less_imp_le mult_right_mono mult_right_mono_neg)
   done
 
 lemma mult_less_cancel_left_disj: "c * a < c * b \<longleftrightarrow> 0 < c \<and> a < b \<or> c < 0 \<and>  b < a"
   apply (cases "c = 0")
    apply (auto simp add: neq_iff mult_strict_left_mono mult_strict_left_mono_neg)
      apply (auto simp add: not_less not_le [symmetric, of "c * a"] not_le [symmetric, of a])
      apply (erule_tac [!] notE)
      apply (auto simp add: less_imp_le mult_left_mono mult_left_mono_neg)
   done
 
 text \<open>
   The ``conjunction of implication'' lemmas produce two cases when the
   comparison is a goal, but give four when the comparison is an assumption.
 \<close>
 
 lemma mult_less_cancel_right: "a * c < b * c \<longleftrightarrow> (0 \<le> c \<longrightarrow> a < b) \<and> (c \<le> 0 \<longrightarrow> b < a)"
   using mult_less_cancel_right_disj [of a c b] by auto
 
 lemma mult_less_cancel_left: "c * a < c * b \<longleftrightarrow> (0 \<le> c \<longrightarrow> a < b) \<and> (c \<le> 0 \<longrightarrow> b < a)"
   using mult_less_cancel_left_disj [of c a b] by auto
 
 lemma mult_le_cancel_right: "a * c \<le> b * c \<longleftrightarrow> (0 < c \<longrightarrow> a \<le> b) \<and> (c < 0 \<longrightarrow> b \<le> a)"
   by (simp add: not_less [symmetric] mult_less_cancel_right_disj)
 
 lemma mult_le_cancel_left: "c * a \<le> c * b \<longleftrightarrow> (0 < c \<longrightarrow> a \<le> b) \<and> (c < 0 \<longrightarrow> b \<le> a)"
   by (simp add: not_less [symmetric] mult_less_cancel_left_disj)
 
 lemma mult_le_cancel_left_pos: "0 < c \<Longrightarrow> c * a \<le> c * b \<longleftrightarrow> a \<le> b"
   by (auto simp: mult_le_cancel_left)
 
 lemma mult_le_cancel_left_neg: "c < 0 \<Longrightarrow> c * a \<le> c * b \<longleftrightarrow> b \<le> a"
   by (auto simp: mult_le_cancel_left)
 
 lemma mult_less_cancel_left_pos: "0 < c \<Longrightarrow> c * a < c * b \<longleftrightarrow> a < b"
   by (auto simp: mult_less_cancel_left)
 
 lemma mult_less_cancel_left_neg: "c < 0 \<Longrightarrow> c * a < c * b \<longleftrightarrow> b < a"
   by (auto simp: mult_less_cancel_left)
 
 end
 
 lemmas mult_sign_intros =
   mult_nonneg_nonneg mult_nonneg_nonpos
   mult_nonpos_nonneg mult_nonpos_nonpos
   mult_pos_pos mult_pos_neg
   mult_neg_pos mult_neg_neg
 
 class ordered_comm_ring = comm_ring + ordered_comm_semiring
 begin
 
 subclass ordered_ring ..
 subclass ordered_cancel_comm_semiring ..
 
 end
 
 class linordered_nonzero_semiring = ordered_comm_semiring + monoid_mult + linorder + zero_less_one +
   assumes add_mono1: "a < b \<Longrightarrow> a + 1 < b + 1"
 begin
 
 subclass zero_neq_one
   by standard (insert zero_less_one, blast)
 
 subclass comm_semiring_1
   by standard (rule mult_1_left)
 
 lemma zero_le_one [simp]: "0 \<le> 1"
   by (rule zero_less_one [THEN less_imp_le])
 
 lemma not_one_le_zero [simp]: "\<not> 1 \<le> 0"
   by (simp add: not_le)
 
 lemma not_one_less_zero [simp]: "\<not> 1 < 0"
   by (simp add: not_less)
 
 lemma mult_left_le: "c \<le> 1 \<Longrightarrow> 0 \<le> a \<Longrightarrow> a * c \<le> a"
   using mult_left_mono[of c 1 a] by simp
 
 lemma mult_le_one: "a \<le> 1 \<Longrightarrow> 0 \<le> b \<Longrightarrow> b \<le> 1 \<Longrightarrow> a * b \<le> 1"
   using mult_mono[of a 1 b 1] by simp
 
 lemma zero_less_two: "0 < 1 + 1"
   using add_pos_pos[OF zero_less_one zero_less_one] .
 
 end
 
 class linordered_semidom = semidom + linordered_comm_semiring_strict + zero_less_one +
   assumes le_add_diff_inverse2 [simp]: "b \<le> a \<Longrightarrow> a - b + b = a"
 begin
 
 subclass linordered_nonzero_semiring 
 proof
   show "a + 1 < b + 1" if "a < b" for a b
   proof (rule ccontr, simp add: not_less)
     assume "b \<le> a"
     with that show False
       by (simp add: )
   qed
 qed
 
 text \<open>Addition is the inverse of subtraction.\<close>
 
 lemma le_add_diff_inverse [simp]: "b \<le> a \<Longrightarrow> b + (a - b) = a"
   by (frule le_add_diff_inverse2) (simp add: add.commute)
 
 lemma add_diff_inverse: "\<not> a < b \<Longrightarrow> b + (a - b) = a"
   by simp
 
 lemma add_le_imp_le_diff: "i + k \<le> n \<Longrightarrow> i \<le> n - k"
   apply (subst add_le_cancel_right [where c=k, symmetric])
   apply (frule le_add_diff_inverse2)
   apply (simp only: add.assoc [symmetric])
   using add_implies_diff
   apply fastforce
   done
 
 lemma add_le_add_imp_diff_le:
   assumes 1: "i + k \<le> n"
     and 2: "n \<le> j + k"
   shows "i + k \<le> n \<Longrightarrow> n \<le> j + k \<Longrightarrow> n - k \<le> j"
 proof -
   have "n - (i + k) + (i + k) = n"
     using 1 by simp
   moreover have "n - k = n - k - i + i"
     using 1 by (simp add: add_le_imp_le_diff)
   ultimately show ?thesis
     using 2
     apply (simp add: add.assoc [symmetric])
     apply (rule add_le_imp_le_diff [of _ k "j + k", simplified add_diff_cancel_right'])
     apply (simp add: add.commute diff_diff_add)
     done
 qed
 
 lemma less_1_mult: "1 < m \<Longrightarrow> 1 < n \<Longrightarrow> 1 < m * n"
   using mult_strict_mono [of 1 m 1 n] by (simp add: less_trans [OF zero_less_one])
 
 end
 
 class linordered_idom = comm_ring_1 + linordered_comm_semiring_strict +
   ordered_ab_group_add + abs_if + sgn +
   assumes sgn_if: "sgn x = (if x = 0 then 0 else if 0 < x then 1 else - 1)"
 begin
 
 subclass linordered_ring_strict ..
 
 subclass linordered_semiring_1_strict
 proof
   have "0 \<le> 1 * 1"
     by (fact zero_le_square)
   then show "0 < 1" 
     by (simp add: le_less)
 qed
 
 subclass ordered_comm_ring ..
 subclass idom ..
 
 subclass linordered_semidom
   by standard simp
 
 subclass idom_abs_sgn
   by standard
     (auto simp add: sgn_if abs_if zero_less_mult_iff)
 
 lemma linorder_neqE_linordered_idom:
   assumes "x \<noteq> y"
   obtains "x < y" | "y < x"
   using assms by (rule neqE)
 
 text \<open>These cancellation simp rules also produce two cases when the comparison is a goal.\<close>
 
 lemma mult_le_cancel_right1: "c \<le> b * c \<longleftrightarrow> (0 < c \<longrightarrow> 1 \<le> b) \<and> (c < 0 \<longrightarrow> b \<le> 1)"
   using mult_le_cancel_right [of 1 c b] by simp
 
 lemma mult_le_cancel_right2: "a * c \<le> c \<longleftrightarrow> (0 < c \<longrightarrow> a \<le> 1) \<and> (c < 0 \<longrightarrow> 1 \<le> a)"
   using mult_le_cancel_right [of a c 1] by simp
 
 lemma mult_le_cancel_left1: "c \<le> c * b \<longleftrightarrow> (0 < c \<longrightarrow> 1 \<le> b) \<and> (c < 0 \<longrightarrow> b \<le> 1)"
   using mult_le_cancel_left [of c 1 b] by simp
 
 lemma mult_le_cancel_left2: "c * a \<le> c \<longleftrightarrow> (0 < c \<longrightarrow> a \<le> 1) \<and> (c < 0 \<longrightarrow> 1 \<le> a)"
   using mult_le_cancel_left [of c a 1] by simp
 
 lemma mult_less_cancel_right1: "c < b * c \<longleftrightarrow> (0 \<le> c \<longrightarrow> 1 < b) \<and> (c \<le> 0 \<longrightarrow> b < 1)"
   using mult_less_cancel_right [of 1 c b] by simp
 
 lemma mult_less_cancel_right2: "a * c < c \<longleftrightarrow> (0 \<le> c \<longrightarrow> a < 1) \<and> (c \<le> 0 \<longrightarrow> 1 < a)"
   using mult_less_cancel_right [of a c 1] by simp
 
 lemma mult_less_cancel_left1: "c < c * b \<longleftrightarrow> (0 \<le> c \<longrightarrow> 1 < b) \<and> (c \<le> 0 \<longrightarrow> b < 1)"
   using mult_less_cancel_left [of c 1 b] by simp
 
 lemma mult_less_cancel_left2: "c * a < c \<longleftrightarrow> (0 \<le> c \<longrightarrow> a < 1) \<and> (c \<le> 0 \<longrightarrow> 1 < a)"
   using mult_less_cancel_left [of c a 1] by simp
 
 lemma sgn_0_0: "sgn a = 0 \<longleftrightarrow> a = 0"
   by (fact sgn_eq_0_iff)
 
 lemma sgn_1_pos: "sgn a = 1 \<longleftrightarrow> a > 0"
   unfolding sgn_if by simp
 
 lemma sgn_1_neg: "sgn a = - 1 \<longleftrightarrow> a < 0"
   unfolding sgn_if by auto
 
 lemma sgn_pos [simp]: "0 < a \<Longrightarrow> sgn a = 1"
   by (simp only: sgn_1_pos)
 
 lemma sgn_neg [simp]: "a < 0 \<Longrightarrow> sgn a = - 1"
   by (simp only: sgn_1_neg)
 
 lemma abs_sgn: "\<bar>k\<bar> = k * sgn k"
   unfolding sgn_if abs_if by auto
 
 lemma sgn_greater [simp]: "0 < sgn a \<longleftrightarrow> 0 < a"
   unfolding sgn_if by auto
 
 lemma sgn_less [simp]: "sgn a < 0 \<longleftrightarrow> a < 0"
   unfolding sgn_if by auto
 
 lemma abs_sgn_eq_1 [simp]:
   "a \<noteq> 0 \<Longrightarrow> \<bar>sgn a\<bar> = 1"
   by simp
 
 lemma abs_sgn_eq: "\<bar>sgn a\<bar> = (if a = 0 then 0 else 1)"
   by (simp add: sgn_if)
 
 lemma sgn_mult_self_eq [simp]:
   "sgn a * sgn a = of_bool (a \<noteq> 0)"
   by (cases "a > 0") simp_all
 
 lemma abs_mult_self_eq [simp]:
   "\<bar>a\<bar> * \<bar>a\<bar> = a * a"
   by (cases "a > 0") simp_all
 
 lemma same_sgn_sgn_add:
   "sgn (a + b) = sgn a" if "sgn b = sgn a"
 proof (cases a 0 rule: linorder_cases)
   case equal
   with that show ?thesis
     by simp
 next
   case less
   with that have "b < 0"
     by (simp add: sgn_1_neg)
   with \<open>a < 0\<close> have "a + b < 0"
     by (rule add_neg_neg)
   with \<open>a < 0\<close> show ?thesis
     by simp
 next
   case greater
   with that have "b > 0"
     by (simp add: sgn_1_pos)
   with \<open>a > 0\<close> have "a + b > 0"
     by (rule add_pos_pos)
   with \<open>a > 0\<close> show ?thesis
     by simp
 qed
 
 lemma same_sgn_abs_add:
   "\<bar>a + b\<bar> = \<bar>a\<bar> + \<bar>b\<bar>" if "sgn b = sgn a"
 proof -
   have "a + b = sgn a * \<bar>a\<bar> + sgn b * \<bar>b\<bar>"
     by (simp add: sgn_mult_abs)
   also have "\<dots> = sgn a * (\<bar>a\<bar> + \<bar>b\<bar>)"
     using that by (simp add: algebra_simps)
   finally show ?thesis
     by (auto simp add: abs_mult)
 qed
 
 lemma sgn_not_eq_imp:
   "sgn a = - sgn b" if "sgn b \<noteq> sgn a" and "sgn a \<noteq> 0" and "sgn b \<noteq> 0"
   using that by (cases "a < 0") (auto simp add: sgn_0_0 sgn_1_pos sgn_1_neg)
 
 lemma abs_dvd_iff [simp]: "\<bar>m\<bar> dvd k \<longleftrightarrow> m dvd k"
   by (simp add: abs_if)
 
 lemma dvd_abs_iff [simp]: "m dvd \<bar>k\<bar> \<longleftrightarrow> m dvd k"
   by (simp add: abs_if)
 
 lemma dvd_if_abs_eq: "\<bar>l\<bar> = \<bar>k\<bar> \<Longrightarrow> l dvd k"
   by (subst abs_dvd_iff [symmetric]) simp
 
 text \<open>
   The following lemmas can be proven in more general structures, but
   are dangerous as simp rules in absence of @{thm neg_equal_zero},
   @{thm neg_less_pos}, @{thm neg_less_eq_nonneg}.
 \<close>
 
 lemma equation_minus_iff_1 [simp, no_atp]: "1 = - a \<longleftrightarrow> a = - 1"
   by (fact equation_minus_iff)
 
 lemma minus_equation_iff_1 [simp, no_atp]: "- a = 1 \<longleftrightarrow> a = - 1"
   by (subst minus_equation_iff, auto)
 
 lemma le_minus_iff_1 [simp, no_atp]: "1 \<le> - b \<longleftrightarrow> b \<le> - 1"
   by (fact le_minus_iff)
 
 lemma minus_le_iff_1 [simp, no_atp]: "- a \<le> 1 \<longleftrightarrow> - 1 \<le> a"
   by (fact minus_le_iff)
 
 lemma less_minus_iff_1 [simp, no_atp]: "1 < - b \<longleftrightarrow> b < - 1"
   by (fact less_minus_iff)
 
 lemma minus_less_iff_1 [simp, no_atp]: "- a < 1 \<longleftrightarrow> - 1 < a"
   by (fact minus_less_iff)
 
 lemma add_less_zeroD:
   shows "x+y < 0 \<Longrightarrow> x<0 \<or> y<0"
   by (auto simp: not_less intro: le_less_trans [of _ "x+y"])
 
 end
 
 text \<open>Reasoning about inequalities with division\<close>
 
 context linordered_semidom
 begin
 
 lemma less_add_one: "a < a + 1"
 proof -
   have "a + 0 < a + 1"
     by (blast intro: zero_less_one add_strict_left_mono)
   then show ?thesis by simp
 qed
 
 end
 
 context linordered_idom
 begin
 
 lemma mult_right_le_one_le: "0 \<le> x \<Longrightarrow> 0 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> x * y \<le> x"
   by (rule mult_left_le)
 
 lemma mult_left_le_one_le: "0 \<le> x \<Longrightarrow> 0 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> y * x \<le> x"
   by (auto simp add: mult_le_cancel_right2)
 
 end
 
 text \<open>Absolute Value\<close>
 
 context linordered_idom
 begin
 
 lemma mult_sgn_abs: "sgn x * \<bar>x\<bar> = x"
   by (fact sgn_mult_abs)
 
 lemma abs_one: "\<bar>1\<bar> = 1"
   by (fact abs_1)
 
 end
 
 class ordered_ring_abs = ordered_ring + ordered_ab_group_add_abs +
   assumes abs_eq_mult:
     "(0 \<le> a \<or> a \<le> 0) \<and> (0 \<le> b \<or> b \<le> 0) \<Longrightarrow> \<bar>a * b\<bar> = \<bar>a\<bar> * \<bar>b\<bar>"
 
 context linordered_idom
 begin
 
 subclass ordered_ring_abs
   by standard (auto simp: abs_if not_less mult_less_0_iff)
 
 lemma abs_mult_self: "\<bar>a\<bar> * \<bar>a\<bar> = a * a"
   by (fact abs_mult_self_eq)
 
 lemma abs_mult_less:
   assumes ac: "\<bar>a\<bar> < c"
     and bd: "\<bar>b\<bar> < d"
   shows "\<bar>a\<bar> * \<bar>b\<bar> < c * d"
 proof -
   from ac have "0 < c"
     by (blast intro: le_less_trans abs_ge_zero)
   with bd show ?thesis by (simp add: ac mult_strict_mono)
 qed
 
 lemma abs_less_iff: "\<bar>a\<bar> < b \<longleftrightarrow> a < b \<and> - a < b"
   by (simp add: less_le abs_le_iff) (auto simp add: abs_if)
 
 lemma abs_mult_pos: "0 \<le> x \<Longrightarrow> \<bar>y\<bar> * x = \<bar>y * x\<bar>"
   by (simp add: abs_mult)
 
 lemma abs_diff_less_iff: "\<bar>x - a\<bar> < r \<longleftrightarrow> a - r < x \<and> x < a + r"
   by (auto simp add: diff_less_eq ac_simps abs_less_iff)
 
 lemma abs_diff_le_iff: "\<bar>x - a\<bar> \<le> r \<longleftrightarrow> a - r \<le> x \<and> x \<le> a + r"
   by (auto simp add: diff_le_eq ac_simps abs_le_iff)
 
 lemma abs_add_one_gt_zero: "0 < 1 + \<bar>x\<bar>"
   by (auto simp: abs_if not_less intro: zero_less_one add_strict_increasing less_trans)
 
 end
 
 
 subsection \<open>Dioids\<close>
 
 text \<open>
   Dioids are the alternative extensions of semirings, a semiring can
   either be a ring or a dioid but never both.
 \<close>
 
 class dioid = semiring_1 + canonically_ordered_monoid_add
 begin
 
 subclass ordered_semiring
   by standard (auto simp: le_iff_add distrib_left distrib_right)
 
 end
 
 
 hide_fact (open) comm_mult_left_mono comm_mult_strict_left_mono distrib
 
 code_identifier
   code_module Rings \<rightharpoonup> (SML) Arith and (OCaml) Arith and (Haskell) Arith
 
 end
diff --git a/src/HOL/Set_Interval.thy b/src/HOL/Set_Interval.thy
--- a/src/HOL/Set_Interval.thy
+++ b/src/HOL/Set_Interval.thy
@@ -1,2490 +1,2493 @@
 (*  Title:      HOL/Set_Interval.thy
     Author:     Tobias Nipkow, Clemens Ballarin, Jeremy Avigad
 
 lessThan, greaterThan, atLeast, atMost and two-sided intervals
 
 Modern convention: Ixy stands for an interval where x and y
 describe the lower and upper bound and x,y : {c,o,i}
 where c = closed, o = open, i = infinite.
 Examples: Ico = {_ ..< _} and Ici = {_ ..}
 *)
 
 section \<open>Set intervals\<close>
 
 theory Set_Interval
 imports Divides
 begin
 
 context ord
 begin
 
 definition
   lessThan    :: "'a => 'a set" ("(1{..<_})") where
   "{..<u} == {x. x < u}"
 
 definition
   atMost      :: "'a => 'a set" ("(1{.._})") where
   "{..u} == {x. x \<le> u}"
 
 definition
   greaterThan :: "'a => 'a set" ("(1{_<..})") where
   "{l<..} == {x. l<x}"
 
 definition
   atLeast     :: "'a => 'a set" ("(1{_..})") where
   "{l..} == {x. l\<le>x}"
 
 definition
   greaterThanLessThan :: "'a => 'a => 'a set"  ("(1{_<..<_})") where
   "{l<..<u} == {l<..} Int {..<u}"
 
 definition
   atLeastLessThan :: "'a => 'a => 'a set"      ("(1{_..<_})") where
   "{l..<u} == {l..} Int {..<u}"
 
 definition
   greaterThanAtMost :: "'a => 'a => 'a set"    ("(1{_<.._})") where
   "{l<..u} == {l<..} Int {..u}"
 
 definition
   atLeastAtMost :: "'a => 'a => 'a set"        ("(1{_.._})") where
   "{l..u} == {l..} Int {..u}"
 
 end
 
 
 text\<open>A note of warning when using \<^term>\<open>{..<n}\<close> on type \<^typ>\<open>nat\<close>: it is equivalent to \<^term>\<open>{0::nat..<n}\<close> but some lemmas involving
 \<^term>\<open>{m..<n}\<close> may not exist in \<^term>\<open>{..<n}\<close>-form as well.\<close>
 
 syntax (ASCII)
   "_UNION_le"   :: "'a => 'a => 'b set => 'b set"       ("(3UN _<=_./ _)" [0, 0, 10] 10)
   "_UNION_less" :: "'a => 'a => 'b set => 'b set"       ("(3UN _<_./ _)" [0, 0, 10] 10)
   "_INTER_le"   :: "'a => 'a => 'b set => 'b set"       ("(3INT _<=_./ _)" [0, 0, 10] 10)
   "_INTER_less" :: "'a => 'a => 'b set => 'b set"       ("(3INT _<_./ _)" [0, 0, 10] 10)
 
 syntax (latex output)
   "_UNION_le"   :: "'a \<Rightarrow> 'a => 'b set => 'b set"       ("(3\<Union>(\<open>unbreakable\<close>_ \<le> _)/ _)" [0, 0, 10] 10)
   "_UNION_less" :: "'a \<Rightarrow> 'a => 'b set => 'b set"       ("(3\<Union>(\<open>unbreakable\<close>_ < _)/ _)" [0, 0, 10] 10)
   "_INTER_le"   :: "'a \<Rightarrow> 'a => 'b set => 'b set"       ("(3\<Inter>(\<open>unbreakable\<close>_ \<le> _)/ _)" [0, 0, 10] 10)
   "_INTER_less" :: "'a \<Rightarrow> 'a => 'b set => 'b set"       ("(3\<Inter>(\<open>unbreakable\<close>_ < _)/ _)" [0, 0, 10] 10)
 
 syntax
   "_UNION_le"   :: "'a => 'a => 'b set => 'b set"       ("(3\<Union>_\<le>_./ _)" [0, 0, 10] 10)
   "_UNION_less" :: "'a => 'a => 'b set => 'b set"       ("(3\<Union>_<_./ _)" [0, 0, 10] 10)
   "_INTER_le"   :: "'a => 'a => 'b set => 'b set"       ("(3\<Inter>_\<le>_./ _)" [0, 0, 10] 10)
   "_INTER_less" :: "'a => 'a => 'b set => 'b set"       ("(3\<Inter>_<_./ _)" [0, 0, 10] 10)
 
 translations
   "\<Union>i\<le>n. A" \<rightleftharpoons> "\<Union>i\<in>{..n}. A"
   "\<Union>i<n. A" \<rightleftharpoons> "\<Union>i\<in>{..<n}. A"
   "\<Inter>i\<le>n. A" \<rightleftharpoons> "\<Inter>i\<in>{..n}. A"
   "\<Inter>i<n. A" \<rightleftharpoons> "\<Inter>i\<in>{..<n}. A"
 
 
 subsection \<open>Various equivalences\<close>
 
 lemma (in ord) lessThan_iff [iff]: "(i \<in> lessThan k) = (i<k)"
 by (simp add: lessThan_def)
 
 lemma Compl_lessThan [simp]:
     "!!k:: 'a::linorder. -lessThan k = atLeast k"
   by (auto simp add: lessThan_def atLeast_def)
 
 lemma single_Diff_lessThan [simp]: "!!k:: 'a::preorder. {k} - lessThan k = {k}"
   by auto
 
 lemma (in ord) greaterThan_iff [iff]: "(i \<in> greaterThan k) = (k<i)"
   by (simp add: greaterThan_def)
 
 lemma Compl_greaterThan [simp]:
     "!!k:: 'a::linorder. -greaterThan k = atMost k"
   by (auto simp add: greaterThan_def atMost_def)
 
 lemma Compl_atMost [simp]: "!!k:: 'a::linorder. -atMost k = greaterThan k"
   apply (subst Compl_greaterThan [symmetric])
   apply (rule double_complement)
   done
 
 lemma (in ord) atLeast_iff [iff]: "(i \<in> atLeast k) = (k<=i)"
 by (simp add: atLeast_def)
 
 lemma Compl_atLeast [simp]: "!!k:: 'a::linorder. -atLeast k = lessThan k"
   by (auto simp add: lessThan_def atLeast_def)
 
 lemma (in ord) atMost_iff [iff]: "(i \<in> atMost k) = (i<=k)"
 by (simp add: atMost_def)
 
 lemma atMost_Int_atLeast: "!!n:: 'a::order. atMost n Int atLeast n = {n}"
 by (blast intro: order_antisym)
 
 lemma (in linorder) lessThan_Int_lessThan: "{ a <..} \<inter> { b <..} = { max a b <..}"
   by auto
 
 lemma (in linorder) greaterThan_Int_greaterThan: "{..< a} \<inter> {..< b} = {..< min a b}"
   by auto
 
 subsection \<open>Logical Equivalences for Set Inclusion and Equality\<close>
 
 lemma atLeast_empty_triv [simp]: "{{}..} = UNIV"
   by auto
 
 lemma atMost_UNIV_triv [simp]: "{..UNIV} = UNIV"
   by auto
 
 lemma atLeast_subset_iff [iff]:
      "(atLeast x \<subseteq> atLeast y) = (y \<le> (x::'a::preorder))"
 by (blast intro: order_trans)
 
 lemma atLeast_eq_iff [iff]:
      "(atLeast x = atLeast y) = (x = (y::'a::order))"
 by (blast intro: order_antisym order_trans)
 
 lemma greaterThan_subset_iff [iff]:
      "(greaterThan x \<subseteq> greaterThan y) = (y \<le> (x::'a::linorder))"
   unfolding greaterThan_def by (auto simp: linorder_not_less [symmetric])
 
 lemma greaterThan_eq_iff [iff]:
      "(greaterThan x = greaterThan y) = (x = (y::'a::linorder))"
   by (auto simp: elim!: equalityE)
 
 lemma atMost_subset_iff [iff]: "(atMost x \<subseteq> atMost y) = (x \<le> (y::'a::preorder))"
   by (blast intro: order_trans)
 
 lemma atMost_eq_iff [iff]: "(atMost x = atMost y) = (x = (y::'a::order))"
   by (blast intro: order_antisym order_trans)
 
 lemma lessThan_subset_iff [iff]:
      "(lessThan x \<subseteq> lessThan y) = (x \<le> (y::'a::linorder))"
   unfolding lessThan_def by (auto simp: linorder_not_less [symmetric])
 
 lemma lessThan_eq_iff [iff]:
      "(lessThan x = lessThan y) = (x = (y::'a::linorder))"
   by (auto simp: elim!: equalityE)
 
 lemma lessThan_strict_subset_iff:
   fixes m n :: "'a::linorder"
   shows "{..<m} < {..<n} \<longleftrightarrow> m < n"
   by (metis leD lessThan_subset_iff linorder_linear not_less_iff_gr_or_eq psubset_eq)
 
 lemma (in linorder) Ici_subset_Ioi_iff: "{a ..} \<subseteq> {b <..} \<longleftrightarrow> b < a"
   by auto
 
 lemma (in linorder) Iic_subset_Iio_iff: "{.. a} \<subseteq> {..< b} \<longleftrightarrow> a < b"
   by auto
 
 lemma (in preorder) Ioi_le_Ico: "{a <..} \<subseteq> {a ..}"
   by (auto intro: less_imp_le)
 
 subsection \<open>Two-sided intervals\<close>
 
 context ord
 begin
 
 lemma greaterThanLessThan_iff [simp]: "(i \<in> {l<..<u}) = (l < i \<and> i < u)"
   by (simp add: greaterThanLessThan_def)
 
 lemma atLeastLessThan_iff [simp]: "(i \<in> {l..<u}) = (l \<le> i \<and> i < u)"
   by (simp add: atLeastLessThan_def)
 
 lemma greaterThanAtMost_iff [simp]: "(i \<in> {l<..u}) = (l < i \<and> i \<le> u)"
   by (simp add: greaterThanAtMost_def)
 
 lemma atLeastAtMost_iff [simp]: "(i \<in> {l..u}) = (l \<le> i \<and> i \<le> u)"
   by (simp add: atLeastAtMost_def)
 
 text \<open>The above four lemmas could be declared as iffs. Unfortunately this
 breaks many proofs. Since it only helps blast, it is better to leave them
 alone.\<close>
 
 lemma greaterThanLessThan_eq: "{ a <..< b} = { a <..} \<inter> {..< b }"
   by auto
 
 lemma (in order) atLeastLessThan_eq_atLeastAtMost_diff:
   "{a..<b} = {a..b} - {b}"
   by (auto simp add: atLeastLessThan_def atLeastAtMost_def)
 
 lemma (in order) greaterThanAtMost_eq_atLeastAtMost_diff:
   "{a<..b} = {a..b} - {a}"
   by (auto simp add: greaterThanAtMost_def atLeastAtMost_def)
 
 end
 
 subsubsection\<open>Emptyness, singletons, subset\<close>
 
 context preorder
 begin
 
 lemma atLeastatMost_empty_iff[simp]:
   "{a..b} = {} \<longleftrightarrow> (\<not> a \<le> b)"
   by auto (blast intro: order_trans)
 
 lemma atLeastatMost_empty_iff2[simp]:
   "{} = {a..b} \<longleftrightarrow> (\<not> a \<le> b)"
   by auto (blast intro: order_trans)
 
 lemma atLeastLessThan_empty_iff[simp]:
   "{a..<b} = {} \<longleftrightarrow> (\<not> a < b)"
   by auto (blast intro: le_less_trans)
 
 lemma atLeastLessThan_empty_iff2[simp]:
   "{} = {a..<b} \<longleftrightarrow> (\<not> a < b)"
   by auto (blast intro: le_less_trans)
 
 lemma greaterThanAtMost_empty_iff[simp]: "{k<..l} = {} \<longleftrightarrow> \<not> k < l"
   by auto (blast intro: less_le_trans)
 
 lemma greaterThanAtMost_empty_iff2[simp]: "{} = {k<..l} \<longleftrightarrow> \<not> k < l"
   by auto (blast intro: less_le_trans)
 
 lemma atLeastatMost_subset_iff[simp]:
   "{a..b} \<le> {c..d} \<longleftrightarrow> (\<not> a \<le> b) \<or> c \<le> a \<and> b \<le> d"
   unfolding atLeastAtMost_def atLeast_def atMost_def
   by (blast intro: order_trans)
 
 lemma atLeastatMost_psubset_iff:
   "{a..b} < {c..d} \<longleftrightarrow>
    ((\<not> a \<le> b) \<or> c \<le> a \<and> b \<le> d \<and> (c < a \<or> b < d)) \<and> c \<le> d"
   by(simp add: psubset_eq set_eq_iff less_le_not_le)(blast intro: order_trans)
 
 lemma atLeastAtMost_subseteq_atLeastLessThan_iff:
   "{a..b} \<subseteq> {c ..< d} \<longleftrightarrow> (a \<le> b \<longrightarrow> c \<le> a \<and> b < d)" 
   by auto (blast intro: local.order_trans local.le_less_trans elim: )+
 
 lemma Icc_subset_Ici_iff[simp]:
   "{l..h} \<subseteq> {l'..} = (\<not> l\<le>h \<or> l\<ge>l')"
   by(auto simp: subset_eq intro: order_trans)
 
 lemma Icc_subset_Iic_iff[simp]:
   "{l..h} \<subseteq> {..h'} = (\<not> l\<le>h \<or> h\<le>h')"
   by(auto simp: subset_eq intro: order_trans)
 
 lemma not_Ici_eq_empty[simp]: "{l..} \<noteq> {}"
   by(auto simp: set_eq_iff)
 
 lemma not_Iic_eq_empty[simp]: "{..h} \<noteq> {}"
   by(auto simp: set_eq_iff)
 
 lemmas not_empty_eq_Ici_eq_empty[simp] = not_Ici_eq_empty[symmetric]
 lemmas not_empty_eq_Iic_eq_empty[simp] = not_Iic_eq_empty[symmetric]
 
 end
 
 context order
 begin
 
 lemma atLeastatMost_empty[simp]:
   "b < a \<Longrightarrow> {a..b} = {}"
   by(auto simp: atLeastAtMost_def atLeast_def atMost_def)
 
 lemma atLeastLessThan_empty[simp]:
   "b \<le> a \<Longrightarrow> {a..<b} = {}"
   by(auto simp: atLeastLessThan_def)
 
 lemma greaterThanAtMost_empty[simp]: "l \<le> k ==> {k<..l} = {}"
   by(auto simp:greaterThanAtMost_def greaterThan_def atMost_def)
 
 lemma greaterThanLessThan_empty[simp]:"l \<le> k ==> {k<..<l} = {}"
   by(auto simp:greaterThanLessThan_def greaterThan_def lessThan_def)
 
 lemma atLeastAtMost_singleton [simp]: "{a..a} = {a}"
   by (auto simp add: atLeastAtMost_def atMost_def atLeast_def)
 
 lemma atLeastAtMost_singleton': "a = b \<Longrightarrow> {a .. b} = {a}" by simp
 
 lemma Icc_eq_Icc[simp]:
   "{l..h} = {l'..h'} = (l=l' \<and> h=h' \<or> \<not> l\<le>h \<and> \<not> l'\<le>h')"
   by(simp add: order_class.eq_iff)(auto intro: order_trans)
 
 lemma atLeastAtMost_singleton_iff[simp]:
   "{a .. b} = {c} \<longleftrightarrow> a = b \<and> b = c"
 proof
   assume "{a..b} = {c}"
   hence *: "\<not> (\<not> a \<le> b)" unfolding atLeastatMost_empty_iff[symmetric] by simp
   with \<open>{a..b} = {c}\<close> have "c \<le> a \<and> b \<le> c" by auto
   with * show "a = b \<and> b = c" by auto
 qed simp
 
 end
 
 context no_top
 begin
 
 (* also holds for no_bot but no_top should suffice *)
 lemma not_UNIV_le_Icc[simp]: "\<not> UNIV \<subseteq> {l..h}"
 using gt_ex[of h] by(auto simp: subset_eq less_le_not_le)
 
 lemma not_UNIV_le_Iic[simp]: "\<not> UNIV \<subseteq> {..h}"
 using gt_ex[of h] by(auto simp: subset_eq less_le_not_le)
 
 lemma not_Ici_le_Icc[simp]: "\<not> {l..} \<subseteq> {l'..h'}"
 using gt_ex[of h']
 by(auto simp: subset_eq less_le)(blast dest:antisym_conv intro: order_trans)
 
 lemma not_Ici_le_Iic[simp]: "\<not> {l..} \<subseteq> {..h'}"
 using gt_ex[of h']
 by(auto simp: subset_eq less_le)(blast dest:antisym_conv intro: order_trans)
 
 end
 
 context no_bot
 begin
 
 lemma not_UNIV_le_Ici[simp]: "\<not> UNIV \<subseteq> {l..}"
 using lt_ex[of l] by(auto simp: subset_eq less_le_not_le)
 
 lemma not_Iic_le_Icc[simp]: "\<not> {..h} \<subseteq> {l'..h'}"
 using lt_ex[of l']
 by(auto simp: subset_eq less_le)(blast dest:antisym_conv intro: order_trans)
 
 lemma not_Iic_le_Ici[simp]: "\<not> {..h} \<subseteq> {l'..}"
 using lt_ex[of l']
 by(auto simp: subset_eq less_le)(blast dest:antisym_conv intro: order_trans)
 
 end
 
 
 context no_top
 begin
 
 (* also holds for no_bot but no_top should suffice *)
 lemma not_UNIV_eq_Icc[simp]: "\<not> UNIV = {l'..h'}"
 using gt_ex[of h'] by(auto simp: set_eq_iff  less_le_not_le)
 
 lemmas not_Icc_eq_UNIV[simp] = not_UNIV_eq_Icc[symmetric]
 
 lemma not_UNIV_eq_Iic[simp]: "\<not> UNIV = {..h'}"
 using gt_ex[of h'] by(auto simp: set_eq_iff  less_le_not_le)
 
 lemmas not_Iic_eq_UNIV[simp] = not_UNIV_eq_Iic[symmetric]
 
 lemma not_Icc_eq_Ici[simp]: "\<not> {l..h} = {l'..}"
 unfolding atLeastAtMost_def using not_Ici_le_Iic[of l'] by blast
 
 lemmas not_Ici_eq_Icc[simp] = not_Icc_eq_Ici[symmetric]
 
 (* also holds for no_bot but no_top should suffice *)
 lemma not_Iic_eq_Ici[simp]: "\<not> {..h} = {l'..}"
 using not_Ici_le_Iic[of l' h] by blast
 
 lemmas not_Ici_eq_Iic[simp] = not_Iic_eq_Ici[symmetric]
 
 end
 
 context no_bot
 begin
 
 lemma not_UNIV_eq_Ici[simp]: "\<not> UNIV = {l'..}"
 using lt_ex[of l'] by(auto simp: set_eq_iff  less_le_not_le)
 
 lemmas not_Ici_eq_UNIV[simp] = not_UNIV_eq_Ici[symmetric]
 
 lemma not_Icc_eq_Iic[simp]: "\<not> {l..h} = {..h'}"
 unfolding atLeastAtMost_def using not_Iic_le_Ici[of h'] by blast
 
 lemmas not_Iic_eq_Icc[simp] = not_Icc_eq_Iic[symmetric]
 
 end
 
 
 context dense_linorder
 begin
 
 lemma greaterThanLessThan_empty_iff[simp]:
   "{ a <..< b } = {} \<longleftrightarrow> b \<le> a"
   using dense[of a b] by (cases "a < b") auto
 
 lemma greaterThanLessThan_empty_iff2[simp]:
   "{} = { a <..< b } \<longleftrightarrow> b \<le> a"
   using dense[of a b] by (cases "a < b") auto
 
 lemma atLeastLessThan_subseteq_atLeastAtMost_iff:
   "{a ..< b} \<subseteq> { c .. d } \<longleftrightarrow> (a < b \<longrightarrow> c \<le> a \<and> b \<le> d)"
   using dense[of "max a d" "b"]
   by (force simp: subset_eq Ball_def not_less[symmetric])
 
 lemma greaterThanAtMost_subseteq_atLeastAtMost_iff:
   "{a <.. b} \<subseteq> { c .. d } \<longleftrightarrow> (a < b \<longrightarrow> c \<le> a \<and> b \<le> d)"
   using dense[of "a" "min c b"]
   by (force simp: subset_eq Ball_def not_less[symmetric])
 
 lemma greaterThanLessThan_subseteq_atLeastAtMost_iff:
   "{a <..< b} \<subseteq> { c .. d } \<longleftrightarrow> (a < b \<longrightarrow> c \<le> a \<and> b \<le> d)"
   using dense[of "a" "min c b"] dense[of "max a d" "b"]
   by (force simp: subset_eq Ball_def not_less[symmetric])
 
 lemma greaterThanLessThan_subseteq_greaterThanLessThan:
   "{a <..< b} \<subseteq> {c <..< d} \<longleftrightarrow> (a < b \<longrightarrow> a \<ge> c \<and> b \<le> d)"
   using dense[of "a" "min c b"] dense[of "max a d" "b"]
   by (force simp: subset_eq Ball_def not_less[symmetric])
 
 lemma greaterThanAtMost_subseteq_atLeastLessThan_iff:
   "{a <.. b} \<subseteq> { c ..< d } \<longleftrightarrow> (a < b \<longrightarrow> c \<le> a \<and> b < d)"
   using dense[of "a" "min c b"]
   by (force simp: subset_eq Ball_def not_less[symmetric])
 
 lemma greaterThanLessThan_subseteq_atLeastLessThan_iff:
   "{a <..< b} \<subseteq> { c ..< d } \<longleftrightarrow> (a < b \<longrightarrow> c \<le> a \<and> b \<le> d)"
   using dense[of "a" "min c b"] dense[of "max a d" "b"]
   by (force simp: subset_eq Ball_def not_less[symmetric])
 
 lemma greaterThanLessThan_subseteq_greaterThanAtMost_iff:
   "{a <..< b} \<subseteq> { c <.. d } \<longleftrightarrow> (a < b \<longrightarrow> c \<le> a \<and> b \<le> d)"
   using dense[of "a" "min c b"] dense[of "max a d" "b"]
   by (force simp: subset_eq Ball_def not_less[symmetric])
 
 end
 
 context no_top
 begin
 
 lemma greaterThan_non_empty[simp]: "{x <..} \<noteq> {}"
   using gt_ex[of x] by auto
 
 end
 
 context no_bot
 begin
 
 lemma lessThan_non_empty[simp]: "{..< x} \<noteq> {}"
   using lt_ex[of x] by auto
 
 end
 
 lemma (in linorder) atLeastLessThan_subset_iff:
   "{a..<b} \<subseteq> {c..<d} \<Longrightarrow> b \<le> a \<or> c\<le>a \<and> b\<le>d"
   apply (auto simp:subset_eq Ball_def not_le)
   apply(frule_tac x=a in spec)
   apply(erule_tac x=d in allE)
   apply (auto simp: )
   done
 
 lemma atLeastLessThan_inj:
   fixes a b c d :: "'a::linorder"
   assumes eq: "{a ..< b} = {c ..< d}" and "a < b" "c < d"
   shows "a = c" "b = d"
 using assms by (metis atLeastLessThan_subset_iff eq less_le_not_le antisym_conv2 subset_refl)+
 
 lemma atLeastLessThan_eq_iff:
   fixes a b c d :: "'a::linorder"
   assumes "a < b" "c < d"
   shows "{a ..< b} = {c ..< d} \<longleftrightarrow> a = c \<and> b = d"
   using atLeastLessThan_inj assms by auto
 
 lemma (in linorder) Ioc_inj: "{a <.. b} = {c <.. d} \<longleftrightarrow> (b \<le> a \<and> d \<le> c) \<or> a = c \<and> b = d"
   by (metis eq_iff greaterThanAtMost_empty_iff2 greaterThanAtMost_iff le_cases not_le)
 
 lemma (in order) Iio_Int_singleton: "{..<k} \<inter> {x} = (if x < k then {x} else {})"
   by auto
 
 lemma (in linorder) Ioc_subset_iff: "{a<..b} \<subseteq> {c<..d} \<longleftrightarrow> (b \<le> a \<or> c \<le> a \<and> b \<le> d)"
   by (auto simp: subset_eq Ball_def) (metis less_le not_less)
 
 lemma (in order_bot) atLeast_eq_UNIV_iff: "{x..} = UNIV \<longleftrightarrow> x = bot"
 by (auto simp: set_eq_iff intro: le_bot)
 
 lemma (in order_top) atMost_eq_UNIV_iff: "{..x} = UNIV \<longleftrightarrow> x = top"
 by (auto simp: set_eq_iff intro: top_le)
 
 lemma (in bounded_lattice) atLeastAtMost_eq_UNIV_iff:
   "{x..y} = UNIV \<longleftrightarrow> (x = bot \<and> y = top)"
 by (auto simp: set_eq_iff intro: top_le le_bot)
 
 lemma Iio_eq_empty_iff: "{..< n::'a::{linorder, order_bot}} = {} \<longleftrightarrow> n = bot"
   by (auto simp: set_eq_iff not_less le_bot)
 
 lemma lessThan_empty_iff: "{..< n::nat} = {} \<longleftrightarrow> n = 0"
   by (simp add: Iio_eq_empty_iff bot_nat_def)
 
 lemma mono_image_least:
   assumes f_mono: "mono f" and f_img: "f ` {m ..< n} = {m' ..< n'}" "m < n"
   shows "f m = m'"
 proof -
   from f_img have "{m' ..< n'} \<noteq> {}"
     by (metis atLeastLessThan_empty_iff image_is_empty)
   with f_img have "m' \<in> f ` {m ..< n}" by auto
   then obtain k where "f k = m'" "m \<le> k" by auto
   moreover have "m' \<le> f m" using f_img by auto
   ultimately show "f m = m'"
     using f_mono by (auto elim: monoE[where x=m and y=k])
 qed
 
 
 subsection \<open>Infinite intervals\<close>
 
 context dense_linorder
 begin
 
 lemma infinite_Ioo:
   assumes "a < b"
   shows "\<not> finite {a<..<b}"
 proof
   assume fin: "finite {a<..<b}"
   moreover have ne: "{a<..<b} \<noteq> {}"
     using \<open>a < b\<close> by auto
   ultimately have "a < Max {a <..< b}" "Max {a <..< b} < b"
     using Max_in[of "{a <..< b}"] by auto
   then obtain x where "Max {a <..< b} < x" "x < b"
     using dense[of "Max {a<..<b}" b] by auto
   then have "x \<in> {a <..< b}"
     using \<open>a < Max {a <..< b}\<close> by auto
   then have "x \<le> Max {a <..< b}"
     using fin by auto
   with \<open>Max {a <..< b} < x\<close> show False by auto
 qed
 
 lemma infinite_Icc: "a < b \<Longrightarrow> \<not> finite {a .. b}"
   using greaterThanLessThan_subseteq_atLeastAtMost_iff[of a b a b] infinite_Ioo[of a b]
   by (auto dest: finite_subset)
 
 lemma infinite_Ico: "a < b \<Longrightarrow> \<not> finite {a ..< b}"
   using greaterThanLessThan_subseteq_atLeastLessThan_iff[of a b a b] infinite_Ioo[of a b]
   by (auto dest: finite_subset)
 
 lemma infinite_Ioc: "a < b \<Longrightarrow> \<not> finite {a <.. b}"
   using greaterThanLessThan_subseteq_greaterThanAtMost_iff[of a b a b] infinite_Ioo[of a b]
   by (auto dest: finite_subset)
 
 lemma infinite_Ioo_iff [simp]: "infinite {a<..<b} \<longleftrightarrow> a < b"
   using not_less_iff_gr_or_eq by (fastforce simp: infinite_Ioo)
 
 lemma infinite_Icc_iff [simp]: "infinite {a .. b} \<longleftrightarrow> a < b"
   using not_less_iff_gr_or_eq by (fastforce simp: infinite_Icc)
 
 lemma infinite_Ico_iff [simp]: "infinite {a..<b} \<longleftrightarrow> a < b"
   using not_less_iff_gr_or_eq by (fastforce simp: infinite_Ico)
 
 lemma infinite_Ioc_iff [simp]: "infinite {a<..b} \<longleftrightarrow> a < b"
   using not_less_iff_gr_or_eq by (fastforce simp: infinite_Ioc)
 
 end
 
 lemma infinite_Iio: "\<not> finite {..< a :: 'a :: {no_bot, linorder}}"
 proof
   assume "finite {..< a}"
   then have *: "\<And>x. x < a \<Longrightarrow> Min {..< a} \<le> x"
     by auto
   obtain x where "x < a"
     using lt_ex by auto
 
   obtain y where "y < Min {..< a}"
     using lt_ex by auto
   also have "Min {..< a} \<le> x"
     using \<open>x < a\<close> by fact
   also note \<open>x < a\<close>
   finally have "Min {..< a} \<le> y"
     by fact
   with \<open>y < Min {..< a}\<close> show False by auto
 qed
 
 lemma infinite_Iic: "\<not> finite {.. a :: 'a :: {no_bot, linorder}}"
   using infinite_Iio[of a] finite_subset[of "{..< a}" "{.. a}"]
   by (auto simp: subset_eq less_imp_le)
 
 lemma infinite_Ioi: "\<not> finite {a :: 'a :: {no_top, linorder} <..}"
 proof
   assume "finite {a <..}"
   then have *: "\<And>x. a < x \<Longrightarrow> x \<le> Max {a <..}"
     by auto
 
   obtain y where "Max {a <..} < y"
     using gt_ex by auto
 
   obtain x where x: "a < x"
     using gt_ex by auto
   also from x have "x \<le> Max {a <..}"
     by fact
   also note \<open>Max {a <..} < y\<close>
   finally have "y \<le> Max { a <..}"
     by fact
   with \<open>Max {a <..} < y\<close> show False by auto
 qed
 
 lemma infinite_Ici: "\<not> finite {a :: 'a :: {no_top, linorder} ..}"
   using infinite_Ioi[of a] finite_subset[of "{a <..}" "{a ..}"]
   by (auto simp: subset_eq less_imp_le)
 
 subsubsection \<open>Intersection\<close>
 
 context linorder
 begin
 
 lemma Int_atLeastAtMost[simp]: "{a..b} Int {c..d} = {max a c .. min b d}"
 by auto
 
 lemma Int_atLeastAtMostR1[simp]: "{..b} Int {c..d} = {c .. min b d}"
 by auto
 
 lemma Int_atLeastAtMostR2[simp]: "{a..} Int {c..d} = {max a c .. d}"
 by auto
 
 lemma Int_atLeastAtMostL1[simp]: "{a..b} Int {..d} = {a .. min b d}"
 by auto
 
 lemma Int_atLeastAtMostL2[simp]: "{a..b} Int {c..} = {max a c .. b}"
 by auto
 
 lemma Int_atLeastLessThan[simp]: "{a..<b} Int {c..<d} = {max a c ..< min b d}"
 by auto
 
 lemma Int_greaterThanAtMost[simp]: "{a<..b} Int {c<..d} = {max a c <.. min b d}"
 by auto
 
 lemma Int_greaterThanLessThan[simp]: "{a<..<b} Int {c<..<d} = {max a c <..< min b d}"
 by auto
 
 lemma Int_atMost[simp]: "{..a} \<inter> {..b} = {.. min a b}"
   by (auto simp: min_def)
 
 lemma Ioc_disjoint: "{a<..b} \<inter> {c<..d} = {} \<longleftrightarrow> b \<le> a \<or> d \<le> c \<or> b \<le> c \<or> d \<le> a"
   by auto
 
 end
 
 context complete_lattice
 begin
 
 lemma
   shows Sup_atLeast[simp]: "Sup {x ..} = top"
     and Sup_greaterThanAtLeast[simp]: "x < top \<Longrightarrow> Sup {x <..} = top"
     and Sup_atMost[simp]: "Sup {.. y} = y"
     and Sup_atLeastAtMost[simp]: "x \<le> y \<Longrightarrow> Sup { x .. y} = y"
     and Sup_greaterThanAtMost[simp]: "x < y \<Longrightarrow> Sup { x <.. y} = y"
   by (auto intro!: Sup_eqI)
 
 lemma
   shows Inf_atMost[simp]: "Inf {.. x} = bot"
     and Inf_atMostLessThan[simp]: "top < x \<Longrightarrow> Inf {..< x} = bot"
     and Inf_atLeast[simp]: "Inf {x ..} = x"
     and Inf_atLeastAtMost[simp]: "x \<le> y \<Longrightarrow> Inf { x .. y} = x"
     and Inf_atLeastLessThan[simp]: "x < y \<Longrightarrow> Inf { x ..< y} = x"
   by (auto intro!: Inf_eqI)
 
 end
 
 lemma
   fixes x y :: "'a :: {complete_lattice, dense_linorder}"
   shows Sup_lessThan[simp]: "Sup {..< y} = y"
     and Sup_atLeastLessThan[simp]: "x < y \<Longrightarrow> Sup { x ..< y} = y"
     and Sup_greaterThanLessThan[simp]: "x < y \<Longrightarrow> Sup { x <..< y} = y"
     and Inf_greaterThan[simp]: "Inf {x <..} = x"
     and Inf_greaterThanAtMost[simp]: "x < y \<Longrightarrow> Inf { x <.. y} = x"
     and Inf_greaterThanLessThan[simp]: "x < y \<Longrightarrow> Inf { x <..< y} = x"
   by (auto intro!: Inf_eqI Sup_eqI intro: dense_le dense_le_bounded dense_ge dense_ge_bounded)
 
 subsection \<open>Intervals of natural numbers\<close>
 
 subsubsection \<open>The Constant \<^term>\<open>lessThan\<close>\<close>
 
 lemma lessThan_0 [simp]: "lessThan (0::nat) = {}"
 by (simp add: lessThan_def)
 
 lemma lessThan_Suc: "lessThan (Suc k) = insert k (lessThan k)"
 by (simp add: lessThan_def less_Suc_eq, blast)
 
 text \<open>The following proof is convenient in induction proofs where
 new elements get indices at the beginning. So it is used to transform
 \<^term>\<open>{..<Suc n}\<close> to \<^term>\<open>0::nat\<close> and \<^term>\<open>{..< n}\<close>.\<close>
 
 lemma zero_notin_Suc_image [simp]: "0 \<notin> Suc ` A"
   by auto
 
 lemma lessThan_Suc_eq_insert_0: "{..<Suc n} = insert 0 (Suc ` {..<n})"
   by (auto simp: image_iff less_Suc_eq_0_disj)
 
 lemma lessThan_Suc_atMost: "lessThan (Suc k) = atMost k"
 by (simp add: lessThan_def atMost_def less_Suc_eq_le)
 
 lemma atMost_Suc_eq_insert_0: "{.. Suc n} = insert 0 (Suc ` {.. n})"
   unfolding lessThan_Suc_atMost[symmetric] lessThan_Suc_eq_insert_0[of "Suc n"] ..
 
 lemma UN_lessThan_UNIV: "(\<Union>m::nat. lessThan m) = UNIV"
 by blast
 
 subsubsection \<open>The Constant \<^term>\<open>greaterThan\<close>\<close>
 
 lemma greaterThan_0: "greaterThan 0 = range Suc"
   unfolding greaterThan_def
   by (blast dest: gr0_conv_Suc [THEN iffD1])
 
 lemma greaterThan_Suc: "greaterThan (Suc k) = greaterThan k - {Suc k}"
   unfolding greaterThan_def
   by (auto elim: linorder_neqE)
 
 lemma INT_greaterThan_UNIV: "(\<Inter>m::nat. greaterThan m) = {}"
   by blast
 
 subsubsection \<open>The Constant \<^term>\<open>atLeast\<close>\<close>
 
 lemma atLeast_0 [simp]: "atLeast (0::nat) = UNIV"
 by (unfold atLeast_def UNIV_def, simp)
 
 lemma atLeast_Suc: "atLeast (Suc k) = atLeast k - {k}"
   unfolding atLeast_def by (auto simp: order_le_less Suc_le_eq)
 
 lemma atLeast_Suc_greaterThan: "atLeast (Suc k) = greaterThan k"
   by (auto simp add: greaterThan_def atLeast_def less_Suc_eq_le)
 
 lemma UN_atLeast_UNIV: "(\<Union>m::nat. atLeast m) = UNIV"
   by blast
 
 subsubsection \<open>The Constant \<^term>\<open>atMost\<close>\<close>
 
 lemma atMost_0 [simp]: "atMost (0::nat) = {0}"
   by (simp add: atMost_def)
 
 lemma atMost_Suc: "atMost (Suc k) = insert (Suc k) (atMost k)"
   unfolding atMost_def by (auto simp add: less_Suc_eq order_le_less)
 
 lemma UN_atMost_UNIV: "(\<Union>m::nat. atMost m) = UNIV"
   by blast
 
 subsubsection \<open>The Constant \<^term>\<open>atLeastLessThan\<close>\<close>
 
 text\<open>The orientation of the following 2 rules is tricky. The lhs is
 defined in terms of the rhs.  Hence the chosen orientation makes sense
 in this theory --- the reverse orientation complicates proofs (eg
 nontermination). But outside, when the definition of the lhs is rarely
 used, the opposite orientation seems preferable because it reduces a
 specific concept to a more general one.\<close>
 
 lemma atLeast0LessThan [code_abbrev]: "{0::nat..<n} = {..<n}"
   by(simp add:lessThan_def atLeastLessThan_def)
 
 lemma atLeast0AtMost [code_abbrev]: "{0..n::nat} = {..n}"
   by(simp add:atMost_def atLeastAtMost_def)
 
 lemma lessThan_atLeast0: "{..<n} = {0::nat..<n}"
   by (simp add: atLeast0LessThan)
 
 lemma atMost_atLeast0: "{..n} = {0::nat..n}"
   by (simp add: atLeast0AtMost)
 
 lemma atLeastLessThan0: "{m..<0::nat} = {}"
   by (simp add: atLeastLessThan_def)
 
 lemma atLeast0_lessThan_Suc: "{0..<Suc n} = insert n {0..<n}"
   by (simp add: atLeast0LessThan lessThan_Suc)
 
 lemma atLeast0_lessThan_Suc_eq_insert_0: "{0..<Suc n} = insert 0 (Suc ` {0..<n})"
   by (simp add: atLeast0LessThan lessThan_Suc_eq_insert_0)
 
 
 subsubsection \<open>The Constant \<^term>\<open>atLeastAtMost\<close>\<close>
 
 lemma Icc_eq_insert_lb_nat: "m \<le> n \<Longrightarrow> {m..n} = insert m {Suc m..n}"
 by auto
 
 lemma atLeast0_atMost_Suc:
   "{0..Suc n} = insert (Suc n) {0..n}"
   by (simp add: atLeast0AtMost atMost_Suc)
 
 lemma atLeast0_atMost_Suc_eq_insert_0:
   "{0..Suc n} = insert 0 (Suc ` {0..n})"
   by (simp add: atLeast0AtMost atMost_Suc_eq_insert_0)
 
 
 subsubsection \<open>Intervals of nats with \<^term>\<open>Suc\<close>\<close>
 
 text\<open>Not a simprule because the RHS is too messy.\<close>
 lemma atLeastLessThanSuc:
     "{m..<Suc n} = (if m \<le> n then insert n {m..<n} else {})"
 by (auto simp add: atLeastLessThan_def)
 
 lemma atLeastLessThan_singleton [simp]: "{m..<Suc m} = {m}"
 by (auto simp add: atLeastLessThan_def)
 
 lemma atLeastLessThanSuc_atLeastAtMost: "{l..<Suc u} = {l..u}"
   by (simp add: lessThan_Suc_atMost atLeastAtMost_def atLeastLessThan_def)
 
 lemma atLeastSucAtMost_greaterThanAtMost: "{Suc l..u} = {l<..u}"
   by (simp add: atLeast_Suc_greaterThan atLeastAtMost_def
       greaterThanAtMost_def)
 
 lemma atLeastSucLessThan_greaterThanLessThan: "{Suc l..<u} = {l<..<u}"
   by (simp add: atLeast_Suc_greaterThan atLeastLessThan_def
     greaterThanLessThan_def)
 
 lemma atLeastAtMostSuc_conv: "m \<le> Suc n \<Longrightarrow> {m..Suc n} = insert (Suc n) {m..n}"
 by (auto simp add: atLeastAtMost_def)
 
 lemma atLeastAtMost_insertL: "m \<le> n \<Longrightarrow> insert m {Suc m..n} = {m ..n}"
 by auto
 
 text \<open>The analogous result is useful on \<^typ>\<open>int\<close>:\<close>
 (* here, because we don't have an own int section *)
 lemma atLeastAtMostPlus1_int_conv:
   "m \<le> 1+n \<Longrightarrow> {m..1+n} = insert (1+n) {m..n::int}"
   by (auto intro: set_eqI)
 
 lemma atLeastLessThan_add_Un: "i \<le> j \<Longrightarrow> {i..<j+k} = {i..<j} \<union> {j..<j+k::nat}"
   by (induct k) (simp_all add: atLeastLessThanSuc)
 
 
 subsubsection \<open>Intervals and numerals\<close>
 
 lemma lessThan_nat_numeral:  \<comment> \<open>Evaluation for specific numerals\<close>
   "lessThan (numeral k :: nat) = insert (pred_numeral k) (lessThan (pred_numeral k))"
   by (simp add: numeral_eq_Suc lessThan_Suc)
 
 lemma atMost_nat_numeral:  \<comment> \<open>Evaluation for specific numerals\<close>
   "atMost (numeral k :: nat) = insert (numeral k) (atMost (pred_numeral k))"
   by (simp add: numeral_eq_Suc atMost_Suc)
 
 lemma atLeastLessThan_nat_numeral:  \<comment> \<open>Evaluation for specific numerals\<close>
   "atLeastLessThan m (numeral k :: nat) =
      (if m \<le> (pred_numeral k) then insert (pred_numeral k) (atLeastLessThan m (pred_numeral k))
                  else {})"
   by (simp add: numeral_eq_Suc atLeastLessThanSuc)
 
 
 subsubsection \<open>Image\<close>
 
 context linordered_semidom
 begin
 
 lemma image_add_atLeast[simp]: "plus k ` {i..} = {k + i..}"
 proof -
   have "n = k + (n - k)" if "i + k \<le> n" for n
   proof -
     have "n = (n - (k + i)) + (k + i)" using that
       by (metis add_commute le_add_diff_inverse)
     then show "n = k + (n - k)"
       by (metis local.add_diff_cancel_left' add_assoc add_commute)
   qed
   then show ?thesis
     by (fastforce simp: add_le_imp_le_diff add.commute)
 qed
 
 lemma image_add_atLeastAtMost [simp]:
   "plus k ` {i..j} = {i + k..j + k}" (is "?A = ?B")
 proof
   show "?A \<subseteq> ?B"
     by (auto simp add: ac_simps)
 next
   show "?B \<subseteq> ?A"
   proof
     fix n
     assume "n \<in> ?B"
     then have "i \<le> n - k"
       by (simp add: add_le_imp_le_diff)
     have "n = n - k + k"
     proof -
       from \<open>n \<in> ?B\<close> have "n = n - (i + k) + (i + k)"
         by simp
       also have "\<dots> = n - k - i + i + k"
         by (simp add: algebra_simps)
       also have "\<dots> = n - k + k"
         using \<open>i \<le> n - k\<close> by simp
       finally show ?thesis .
     qed
     moreover have "n - k \<in> {i..j}"
       using \<open>n \<in> ?B\<close>
       by (auto simp: add_le_imp_le_diff add_le_add_imp_diff_le)
     ultimately show "n \<in> ?A"
       by (simp add: ac_simps) 
   qed
 qed
 
 lemma image_add_atLeastAtMost' [simp]:
   "(\<lambda>n. n + k) ` {i..j} = {i + k..j + k}"
   by (simp add: add.commute [of _ k])
 
 lemma image_add_atLeastLessThan [simp]:
   "plus k ` {i..<j} = {i + k..<j + k}"
   by (simp add: image_set_diff atLeastLessThan_eq_atLeastAtMost_diff ac_simps)
 
 lemma image_add_atLeastLessThan' [simp]:
   "(\<lambda>n. n + k) ` {i..<j} = {i + k..<j + k}"
   by (simp add: add.commute [of _ k])
 
 lemma image_add_greaterThanAtMost[simp]: "(+) c ` {a<..b} = {c + a<..c + b}"
   by (simp add: image_set_diff greaterThanAtMost_eq_atLeastAtMost_diff ac_simps)
 
 end
 
 context ordered_ab_group_add
 begin
 
 lemma
   fixes x :: 'a
   shows image_uminus_greaterThan[simp]: "uminus ` {x<..} = {..<-x}"
   and image_uminus_atLeast[simp]: "uminus ` {x..} = {..-x}"
 proof safe
   fix y assume "y < -x"
   hence *:  "x < -y" using neg_less_iff_less[of "-y" x] by simp
   have "- (-y) \<in> uminus ` {x<..}"
     by (rule imageI) (simp add: *)
   thus "y \<in> uminus ` {x<..}" by simp
 next
   fix y assume "y \<le> -x"
   have "- (-y) \<in> uminus ` {x..}"
     by (rule imageI) (insert \<open>y \<le> -x\<close>[THEN le_imp_neg_le], simp)
   thus "y \<in> uminus ` {x..}" by simp
 qed simp_all
 
 lemma
   fixes x :: 'a
   shows image_uminus_lessThan[simp]: "uminus ` {..<x} = {-x<..}"
   and image_uminus_atMost[simp]: "uminus ` {..x} = {-x..}"
 proof -
   have "uminus ` {..<x} = uminus ` uminus ` {-x<..}"
     and "uminus ` {..x} = uminus ` uminus ` {-x..}" by simp_all
   thus "uminus ` {..<x} = {-x<..}" and "uminus ` {..x} = {-x..}"
     by (simp_all add: image_image
         del: image_uminus_greaterThan image_uminus_atLeast)
 qed
 
 lemma
   fixes x :: 'a
   shows image_uminus_atLeastAtMost[simp]: "uminus ` {x..y} = {-y..-x}"
   and image_uminus_greaterThanAtMost[simp]: "uminus ` {x<..y} = {-y..<-x}"
   and image_uminus_atLeastLessThan[simp]: "uminus ` {x..<y} = {-y<..-x}"
   and image_uminus_greaterThanLessThan[simp]: "uminus ` {x<..<y} = {-y<..<-x}"
   by (simp_all add: atLeastAtMost_def greaterThanAtMost_def atLeastLessThan_def
       greaterThanLessThan_def image_Int[OF inj_uminus] Int_commute)
 
 lemma image_add_atMost[simp]: "(+) c ` {..a} = {..c + a}"
   by (auto intro!: image_eqI[where x="x - c" for x] simp: algebra_simps)
 
 end
 
 lemma image_Suc_atLeastAtMost [simp]:
   "Suc ` {i..j} = {Suc i..Suc j}"
   using image_add_atLeastAtMost [of 1 i j]
     by (simp only: plus_1_eq_Suc) simp
 
 lemma image_Suc_atLeastLessThan [simp]:
   "Suc ` {i..<j} = {Suc i..<Suc j}"
   using image_add_atLeastLessThan [of 1 i j]
     by (simp only: plus_1_eq_Suc) simp
 
 corollary image_Suc_atMost:
   "Suc ` {..n} = {1..Suc n}"
   by (simp add: atMost_atLeast0 atLeastLessThanSuc_atLeastAtMost)
 
 corollary image_Suc_lessThan:
   "Suc ` {..<n} = {1..n}"
   by (simp add: lessThan_atLeast0 atLeastLessThanSuc_atLeastAtMost)
 
 lemma image_diff_atLeastAtMost [simp]:
   fixes d::"'a::linordered_idom" shows "((-) d ` {a..b}) = {d-b..d-a}"
   apply auto
   apply (rule_tac x="d-x" in rev_image_eqI, auto)
   done
 
 lemma image_diff_atLeastLessThan [simp]:
   fixes a b c::"'a::linordered_idom"
   shows "(-) c ` {a..<b} = {c - b<..c - a}"
 proof -
   have "(-) c ` {a..<b} = (+) c ` uminus ` {a ..<b}"
     unfolding image_image by simp
   also have "\<dots> = {c - b<..c - a}" by simp
   finally show ?thesis by simp
 qed
 
 lemma image_minus_const_greaterThanAtMost[simp]:
   fixes a b c::"'a::linordered_idom"
   shows "(-) c ` {a<..b} = {c - b..<c - a}"
 proof -
   have "(-) c ` {a<..b} = (+) c ` uminus ` {a<..b}"
     unfolding image_image by simp
   also have "\<dots> = {c - b..<c - a}" by simp
   finally show ?thesis by simp
 qed
 
 lemma image_minus_const_atLeast[simp]:
   fixes a c::"'a::linordered_idom"
   shows "(-) c ` {a..} = {..c - a}"
 proof -
   have "(-) c ` {a..} = (+) c ` uminus ` {a ..}"
     unfolding image_image by simp
   also have "\<dots> = {..c - a}" by simp
   finally show ?thesis by simp
 qed
 
 lemma image_minus_const_AtMost[simp]:
   fixes b c::"'a::linordered_idom"
   shows "(-) c ` {..b} = {c - b..}"
 proof -
   have "(-) c ` {..b} = (+) c ` uminus ` {..b}"
     unfolding image_image by simp
   also have "\<dots> = {c - b..}" by simp
   finally show ?thesis by simp
 qed
 
 lemma image_minus_const_atLeastAtMost' [simp]:
   "(\<lambda>t. t-d)`{a..b} = {a-d..b-d}" for d::"'a::linordered_idom"
   by (metis (no_types, lifting) diff_conv_add_uminus image_add_atLeastAtMost' image_cong)
 
 context linordered_field
 begin
 
 lemma image_mult_atLeastAtMost [simp]:
   "((*) d ` {a..b}) = {d*a..d*b}" if "d>0"
   using that
   by (auto simp: field_simps mult_le_cancel_right intro: rev_image_eqI [where x="x/d" for x])
 
 lemma image_divide_atLeastAtMost [simp]:
   "((\<lambda>c. c / d) ` {a..b}) = {a/d..b/d}" if "d>0"
 proof -
   from that have "inverse d > 0"
     by simp
   with image_mult_atLeastAtMost [of "inverse d" a b]
   have "(*) (inverse d) ` {a..b} = {inverse d * a..inverse d * b}"
     by blast
   moreover have "(*) (inverse d) = (\<lambda>c. c / d)"
     by (simp add: fun_eq_iff field_simps)
   ultimately show ?thesis
     by simp
 qed
 
 lemma image_mult_atLeastAtMost_if:
   "(*) c ` {x .. y} =
     (if c > 0 then {c * x .. c * y} else if x \<le> y then {c * y .. c * x} else {})"
 proof (cases "c = 0 \<or> x > y")
   case True
   then show ?thesis
     by auto
 next
   case False
   then have "x \<le> y"
     by auto
   from False consider "c < 0"| "c > 0"
     by (auto simp add: neq_iff)
   then show ?thesis
   proof cases
     case 1
     have "(*) c ` {x..y} = {c * y..c * x}"
     proof (rule set_eqI)
       fix d
       from 1 have "inj (\<lambda>z. z / c)"
         by (auto intro: injI)
       then have "d \<in> (*) c ` {x..y} \<longleftrightarrow> d / c \<in> (\<lambda>z. z div c) ` (*) c ` {x..y}"
         by (subst inj_image_mem_iff) simp_all
       also have "\<dots> \<longleftrightarrow> d / c \<in> {x..y}"
         using 1 by (simp add: image_image)
       also have "\<dots> \<longleftrightarrow> d \<in> {c * y..c * x}"
         by (auto simp add: field_simps 1)
       finally show "d \<in> (*) c ` {x..y} \<longleftrightarrow> d \<in> {c * y..c * x}" .
     qed
     with \<open>x \<le> y\<close> show ?thesis
       by auto
   qed (simp add: mult_left_mono_neg)
 qed
 
 lemma image_mult_atLeastAtMost_if':
   "(\<lambda>x. x * c) ` {x..y} =
     (if x \<le> y then if c > 0 then {x * c .. y * c} else {y * c .. x * c} else {})"
   using image_mult_atLeastAtMost_if [of c x y] by (auto simp add: ac_simps)
 
 lemma image_affinity_atLeastAtMost:
   "((\<lambda>x. m * x + c) ` {a..b}) = (if {a..b} = {} then {}
             else if 0 \<le> m then {m * a + c .. m * b + c}
             else {m * b + c .. m * a + c})"
 proof -
   have *: "(\<lambda>x. m * x + c) = ((\<lambda>x. x + c) \<circ> (*) m)"
     by (simp add: fun_eq_iff)
   show ?thesis by (simp only: * image_comp [symmetric] image_mult_atLeastAtMost_if)
     (auto simp add: mult_le_cancel_left)
 qed
 
 lemma image_affinity_atLeastAtMost_diff:
   "((\<lambda>x. m*x - c) ` {a..b}) = (if {a..b}={} then {}
             else if 0 \<le> m then {m*a - c .. m*b - c}
             else {m*b - c .. m*a - c})"
   using image_affinity_atLeastAtMost [of m "-c" a b]
   by simp
 
 lemma image_affinity_atLeastAtMost_div:
   "((\<lambda>x. x/m + c) ` {a..b}) = (if {a..b}={} then {}
             else if 0 \<le> m then {a/m + c .. b/m + c}
             else {b/m + c .. a/m + c})"
   using image_affinity_atLeastAtMost [of "inverse m" c a b]
   by (simp add: field_class.field_divide_inverse algebra_simps inverse_eq_divide)
 
 lemma image_affinity_atLeastAtMost_div_diff:
   "((\<lambda>x. x/m - c) ` {a..b}) = (if {a..b}={} then {}
             else if 0 \<le> m then {a/m - c .. b/m - c}
             else {b/m - c .. a/m - c})"
   using image_affinity_atLeastAtMost_diff [of "inverse m" c a b]
   by (simp add: field_class.field_divide_inverse algebra_simps inverse_eq_divide)
 
 end
 
 lemma atLeast1_lessThan_eq_remove0:
   "{Suc 0..<n} = {..<n} - {0}"
   by auto
 
 lemma atLeast1_atMost_eq_remove0:
   "{Suc 0..n} = {..n} - {0}"
   by auto
 
 lemma image_add_int_atLeastLessThan:
     "(\<lambda>x. x + (l::int)) ` {0..<u-l} = {l..<u}"
   apply (auto simp add: image_def)
   apply (rule_tac x = "x - l" in bexI)
   apply auto
   done
 
 lemma image_minus_const_atLeastLessThan_nat:
   fixes c :: nat
   shows "(\<lambda>i. i - c) ` {x ..< y} =
       (if c < y then {x - c ..< y - c} else if x < y then {0} else {})"
     (is "_ = ?right")
 proof safe
   fix a assume a: "a \<in> ?right"
   show "a \<in> (\<lambda>i. i - c) ` {x ..< y}"
   proof cases
     assume "c < y" with a show ?thesis
       by (auto intro!: image_eqI[of _ _ "a + c"])
   next
     assume "\<not> c < y" with a show ?thesis
       by (auto intro!: image_eqI[of _ _ x] split: if_split_asm)
   qed
 qed auto
 
 lemma image_int_atLeastLessThan:
   "int ` {a..<b} = {int a..<int b}"
   by (auto intro!: image_eqI [where x = "nat x" for x])
 
 lemma image_int_atLeastAtMost:
   "int ` {a..b} = {int a..int b}"
   by (auto intro!: image_eqI [where x = "nat x" for x])
 
 
 subsubsection \<open>Finiteness\<close>
 
 lemma finite_lessThan [iff]: fixes k :: nat shows "finite {..<k}"
   by (induct k) (simp_all add: lessThan_Suc)
 
 lemma finite_atMost [iff]: fixes k :: nat shows "finite {..k}"
   by (induct k) (simp_all add: atMost_Suc)
 
 lemma finite_greaterThanLessThan [iff]:
   fixes l :: nat shows "finite {l<..<u}"
   by (simp add: greaterThanLessThan_def)
 
 lemma finite_atLeastLessThan [iff]:
   fixes l :: nat shows "finite {l..<u}"
   by (simp add: atLeastLessThan_def)
 
 lemma finite_greaterThanAtMost [iff]:
   fixes l :: nat shows "finite {l<..u}"
   by (simp add: greaterThanAtMost_def)
 
 lemma finite_atLeastAtMost [iff]:
   fixes l :: nat shows "finite {l..u}"
   by (simp add: atLeastAtMost_def)
 
 text \<open>A bounded set of natural numbers is finite.\<close>
 lemma bounded_nat_set_is_finite: "(\<forall>i\<in>N. i < (n::nat)) \<Longrightarrow> finite N"
   by (rule finite_subset [OF _ finite_lessThan]) auto
 
 text \<open>A set of natural numbers is finite iff it is bounded.\<close>
 lemma finite_nat_set_iff_bounded:
   "finite(N::nat set) = (\<exists>m. \<forall>n\<in>N. n<m)" (is "?F = ?B")
 proof
   assume f:?F  show ?B
     using Max_ge[OF \<open>?F\<close>, simplified less_Suc_eq_le[symmetric]] by blast
 next
   assume ?B show ?F using \<open>?B\<close> by(blast intro:bounded_nat_set_is_finite)
 qed
 
 lemma finite_nat_set_iff_bounded_le: "finite(N::nat set) = (\<exists>m. \<forall>n\<in>N. n\<le>m)"
   unfolding finite_nat_set_iff_bounded
   by (blast dest:less_imp_le_nat le_imp_less_Suc)
 
 lemma finite_less_ub:
      "!!f::nat=>nat. (!!n. n \<le> f n) ==> finite {n. f n \<le> u}"
 by (rule_tac B="{..u}" in finite_subset, auto intro: order_trans)
 
 lemma bounded_Max_nat:
   fixes P :: "nat \<Rightarrow> bool"
   assumes x: "P x" and M: "\<And>x. P x \<Longrightarrow> x \<le> M"
   obtains m where "P m" "\<And>x. P x \<Longrightarrow> x \<le> m"
 proof -
   have "finite {x. P x}"
     using M finite_nat_set_iff_bounded_le by auto
   then have "Max {x. P x} \<in> {x. P x}"
     using Max_in x by auto
   then show ?thesis
     by (simp add: \<open>finite {x. P x}\<close> that)
 qed
 
 
 text\<open>Any subset of an interval of natural numbers the size of the
 subset is exactly that interval.\<close>
 
 lemma subset_card_intvl_is_intvl:
   assumes "A \<subseteq> {k..<k + card A}"
   shows "A = {k..<k + card A}"
 proof (cases "finite A")
   case True
   from this and assms show ?thesis
   proof (induct A rule: finite_linorder_max_induct)
     case empty thus ?case by auto
   next
     case (insert b A)
     hence *: "b \<notin> A" by auto
     with insert have "A \<le> {k..<k + card A}" and "b = k + card A"
       by fastforce+
     with insert * show ?case by auto
   qed
 next
   case False
   with assms show ?thesis by simp
 qed
 
 
 subsubsection \<open>Proving Inclusions and Equalities between Unions\<close>
 
 lemma UN_le_eq_Un0:
   "(\<Union>i\<le>n::nat. M i) = (\<Union>i\<in>{1..n}. M i) \<union> M 0" (is "?A = ?B")
 proof
   show "?A \<subseteq> ?B"
   proof
     fix x assume "x \<in> ?A"
     then obtain i where i: "i\<le>n" "x \<in> M i" by auto
     show "x \<in> ?B"
     proof(cases i)
       case 0 with i show ?thesis by simp
     next
       case (Suc j) with i show ?thesis by auto
     qed
   qed
 next
   show "?B \<subseteq> ?A" by fastforce
 qed
 
 lemma UN_le_add_shift:
   "(\<Union>i\<le>n::nat. M(i+k)) = (\<Union>i\<in>{k..n+k}. M i)" (is "?A = ?B")
 proof
   show "?A \<subseteq> ?B" by fastforce
 next
   show "?B \<subseteq> ?A"
   proof
     fix x assume "x \<in> ?B"
     then obtain i where i: "i \<in> {k..n+k}" "x \<in> M(i)" by auto
     hence "i-k\<le>n \<and> x \<in> M((i-k)+k)" by auto
     thus "x \<in> ?A" by blast
   qed
 qed
 
 lemma UN_le_add_shift_strict:
   "(\<Union>i<n::nat. M(i+k)) = (\<Union>i\<in>{k..<n+k}. M i)" (is "?A = ?B")
 proof
   show "?B \<subseteq> ?A"
   proof
     fix x assume "x \<in> ?B"
     then obtain i where i: "i \<in> {k..<n+k}" "x \<in> M(i)" by auto
     then have "i - k < n \<and> x \<in> M((i-k) + k)" by auto
     then show "x \<in> ?A" using UN_le_add_shift by blast
   qed
 qed (fastforce)
 
 lemma UN_UN_finite_eq: "(\<Union>n::nat. \<Union>i\<in>{0..<n}. A i) = (\<Union>n. A n)"
   by (auto simp add: atLeast0LessThan)
 
 lemma UN_finite_subset:
   "(\<And>n::nat. (\<Union>i\<in>{0..<n}. A i) \<subseteq> C) \<Longrightarrow> (\<Union>n. A n) \<subseteq> C"
   by (subst UN_UN_finite_eq [symmetric]) blast
 
 lemma UN_finite2_subset:
   assumes "\<And>n::nat. (\<Union>i\<in>{0..<n}. A i) \<subseteq> (\<Union>i\<in>{0..<n + k}. B i)"
   shows "(\<Union>n. A n) \<subseteq> (\<Union>n. B n)"
 proof (rule UN_finite_subset, rule)
   fix n and a
   from assms have "(\<Union>i\<in>{0..<n}. A i) \<subseteq> (\<Union>i\<in>{0..<n + k}. B i)" .
   moreover assume "a \<in> (\<Union>i\<in>{0..<n}. A i)"
   ultimately have "a \<in> (\<Union>i\<in>{0..<n + k}. B i)" by blast
   then show "a \<in> (\<Union>i. B i)" by (auto simp add: UN_UN_finite_eq)
 qed
 
 lemma UN_finite2_eq:
   "(\<And>n::nat. (\<Union>i\<in>{0..<n}. A i) = (\<Union>i\<in>{0..<n + k}. B i)) \<Longrightarrow>
     (\<Union>n. A n) = (\<Union>n. B n)"
   apply (rule subset_antisym [OF UN_finite_subset UN_finite2_subset])
    apply auto
   apply (force simp add: atLeastLessThan_add_Un [of 0])+
   done
 
 
 subsubsection \<open>Cardinality\<close>
 
 lemma card_lessThan [simp]: "card {..<u} = u"
   by (induct u, simp_all add: lessThan_Suc)
 
 lemma card_atMost [simp]: "card {..u} = Suc u"
   by (simp add: lessThan_Suc_atMost [THEN sym])
 
 lemma card_atLeastLessThan [simp]: "card {l..<u} = u - l"
 proof -
   have "{l..<u} = (\<lambda>x. x + l) ` {..<u-l}"
     apply (auto simp add: image_def atLeastLessThan_def lessThan_def)
     apply (rule_tac x = "x - l" in exI)
     apply arith
     done
   then have "card {l..<u} = card {..<u-l}"
     by (simp add: card_image inj_on_def)
   then show ?thesis
     by simp
 qed
 
 lemma card_atLeastAtMost [simp]: "card {l..u} = Suc u - l"
   by (subst atLeastLessThanSuc_atLeastAtMost [THEN sym], simp)
 
 lemma card_greaterThanAtMost [simp]: "card {l<..u} = u - l"
   by (subst atLeastSucAtMost_greaterThanAtMost [THEN sym], simp)
 
 lemma card_greaterThanLessThan [simp]: "card {l<..<u} = u - Suc l"
   by (subst atLeastSucLessThan_greaterThanLessThan [THEN sym], simp)
 
 lemma subset_eq_atLeast0_lessThan_finite:
   fixes n :: nat
   assumes "N \<subseteq> {0..<n}"
   shows "finite N"
   using assms finite_atLeastLessThan by (rule finite_subset)
 
 lemma subset_eq_atLeast0_atMost_finite:
   fixes n :: nat
   assumes "N \<subseteq> {0..n}"
   shows "finite N"
   using assms finite_atLeastAtMost by (rule finite_subset)
 
 lemma ex_bij_betw_nat_finite:
   "finite M \<Longrightarrow> \<exists>h. bij_betw h {0..<card M} M"
   apply(drule finite_imp_nat_seg_image_inj_on)
   apply(auto simp:atLeast0LessThan[symmetric] lessThan_def[symmetric] card_image bij_betw_def)
   done
 
 lemma ex_bij_betw_finite_nat:
   "finite M \<Longrightarrow> \<exists>h. bij_betw h M {0..<card M}"
   by (blast dest: ex_bij_betw_nat_finite bij_betw_inv)
 
 lemma finite_same_card_bij:
   "finite A \<Longrightarrow> finite B \<Longrightarrow> card A = card B \<Longrightarrow> \<exists>h. bij_betw h A B"
   apply(drule ex_bij_betw_finite_nat)
   apply(drule ex_bij_betw_nat_finite)
   apply(auto intro!:bij_betw_trans)
   done
 
 lemma ex_bij_betw_nat_finite_1:
   "finite M \<Longrightarrow> \<exists>h. bij_betw h {1 .. card M} M"
   by (rule finite_same_card_bij) auto
 
 lemma bij_betw_iff_card:
   assumes "finite A" "finite B"
   shows "(\<exists>f. bij_betw f A B) \<longleftrightarrow> (card A = card B)"
 proof
   assume "card A = card B"
   moreover obtain f where "bij_betw f A {0 ..< card A}"
     using assms ex_bij_betw_finite_nat by blast
   moreover obtain g where "bij_betw g {0 ..< card B} B"
     using assms ex_bij_betw_nat_finite by blast
   ultimately have "bij_betw (g \<circ> f) A B"
     by (auto simp: bij_betw_trans)
   thus "(\<exists>f. bij_betw f A B)" by blast
 qed (auto simp: bij_betw_same_card)
 
 lemma subset_eq_atLeast0_lessThan_card:
   fixes n :: nat
   assumes "N \<subseteq> {0..<n}"
   shows "card N \<le> n"
 proof -
   from assms finite_lessThan have "card N \<le> card {0..<n}"
     using card_mono by blast
   then show ?thesis by simp
 qed
 
 text \<open>Relational version of @{thm [source] card_inj_on_le}:\<close>
 lemma card_le_if_inj_on_rel:
 assumes "finite B"
   "\<And>a. a \<in> A \<Longrightarrow> \<exists>b. b\<in>B \<and> r a b"
   "\<And>a1 a2 b. \<lbrakk> a1 \<in> A;  a2 \<in> A;  b \<in> B;  r a1 b;  r a2 b \<rbrakk> \<Longrightarrow> a1 = a2"
 shows "card A \<le> card B"
 proof -
   let ?P = "\<lambda>a b. b \<in> B \<and> r a b"
   let ?f = "\<lambda>a. SOME b. ?P a b"
   have 1: "?f ` A \<subseteq> B"  by (auto intro: someI2_ex[OF assms(2)])
   have "inj_on ?f A"
   proof (auto simp: inj_on_def)
     fix a1 a2 assume asms: "a1 \<in> A" "a2 \<in> A" "?f a1 = ?f a2"
     have 0: "?f a1 \<in> B" using "1" \<open>a1 \<in> A\<close> by blast
     have 1: "r a1 (?f a1)" using someI_ex[OF assms(2)[OF \<open>a1 \<in> A\<close>]] by blast
     have 2: "r a2 (?f a1)" using someI_ex[OF assms(2)[OF \<open>a2 \<in> A\<close>]] asms(3) by auto
     show "a1 = a2" using assms(3)[OF asms(1,2) 0 1 2] .
   qed
   with 1 show ?thesis using card_inj_on_le[of ?f A B] assms(1) by simp
 qed
 
 
 subsection \<open>Intervals of integers\<close>
 
 lemma atLeastLessThanPlusOne_atLeastAtMost_int: "{l..<u+1} = {l..(u::int)}"
   by (auto simp add: atLeastAtMost_def atLeastLessThan_def)
 
 lemma atLeastPlusOneAtMost_greaterThanAtMost_int: "{l+1..u} = {l<..(u::int)}"
   by (auto simp add: atLeastAtMost_def greaterThanAtMost_def)
 
 lemma atLeastPlusOneLessThan_greaterThanLessThan_int:
     "{l+1..<u} = {l<..<u::int}"
   by (auto simp add: atLeastLessThan_def greaterThanLessThan_def)
 
 subsubsection \<open>Finiteness\<close>
 
 lemma image_atLeastZeroLessThan_int: "0 \<le> u ==>
     {(0::int)..<u} = int ` {..<nat u}"
   unfolding image_def lessThan_def
   apply auto
   apply (rule_tac x = "nat x" in exI)
   apply (auto simp add: zless_nat_eq_int_zless [THEN sym])
   done
 
 lemma finite_atLeastZeroLessThan_int: "finite {(0::int)..<u}"
 proof (cases "0 \<le> u")
   case True
   then show ?thesis
     by (auto simp: image_atLeastZeroLessThan_int)
 qed auto
 
 lemma finite_atLeastLessThan_int [iff]: "finite {l..<u::int}"
   by (simp only: image_add_int_atLeastLessThan [symmetric, of l] finite_imageI finite_atLeastZeroLessThan_int)
 
 lemma finite_atLeastAtMost_int [iff]: "finite {l..(u::int)}"
   by (subst atLeastLessThanPlusOne_atLeastAtMost_int [THEN sym], simp)
 
 lemma finite_greaterThanAtMost_int [iff]: "finite {l<..(u::int)}"
   by (subst atLeastPlusOneAtMost_greaterThanAtMost_int [THEN sym], simp)
 
 lemma finite_greaterThanLessThan_int [iff]: "finite {l<..<u::int}"
   by (subst atLeastPlusOneLessThan_greaterThanLessThan_int [THEN sym], simp)
 
 
 subsubsection \<open>Cardinality\<close>
 
 lemma card_atLeastZeroLessThan_int: "card {(0::int)..<u} = nat u"
 proof (cases "0 \<le> u")
   case True
   then show ?thesis
     by (auto simp: image_atLeastZeroLessThan_int card_image inj_on_def)    
 qed auto
 
 lemma card_atLeastLessThan_int [simp]: "card {l..<u} = nat (u - l)"
 proof -
   have "card {l..<u} = card {0..<u-l}"
     apply (subst image_add_int_atLeastLessThan [symmetric])
     apply (rule card_image)
     apply (simp add: inj_on_def)
     done
   then show ?thesis
     by (simp add: card_atLeastZeroLessThan_int)
 qed
 
 lemma card_atLeastAtMost_int [simp]: "card {l..u} = nat (u - l + 1)"
   apply (subst atLeastLessThanPlusOne_atLeastAtMost_int [THEN sym])
   apply (auto simp add: algebra_simps)
   done
 
 lemma card_greaterThanAtMost_int [simp]: "card {l<..u} = nat (u - l)"
   by (subst atLeastPlusOneAtMost_greaterThanAtMost_int [THEN sym], simp)
 
 lemma card_greaterThanLessThan_int [simp]: "card {l<..<u} = nat (u - (l + 1))"
   by (subst atLeastPlusOneLessThan_greaterThanLessThan_int [THEN sym], simp)
 
 lemma finite_M_bounded_by_nat: "finite {k. P k \<and> k < (i::nat)}"
 proof -
   have "{k. P k \<and> k < i} \<subseteq> {..<i}" by auto
   with finite_lessThan[of "i"] show ?thesis by (simp add: finite_subset)
 qed
 
 lemma card_less:
   assumes zero_in_M: "0 \<in> M"
   shows "card {k \<in> M. k < Suc i} \<noteq> 0"
 proof -
   from zero_in_M have "{k \<in> M. k < Suc i} \<noteq> {}" by auto
   with finite_M_bounded_by_nat show ?thesis by (auto simp add: card_eq_0_iff)
 qed
 
 lemma card_less_Suc2: 
   assumes "0 \<notin> M" shows "card {k. Suc k \<in> M \<and> k < i} = card {k \<in> M. k < Suc i}"
 proof -
   have *: "\<lbrakk>j \<in> M; j < Suc i\<rbrakk> \<Longrightarrow> j - Suc 0 < i \<and> Suc (j - Suc 0) \<in> M \<and> Suc 0 \<le> j" for j
     by (cases j) (use assms in auto)
   show ?thesis
   proof (rule card_bij_eq)
     show "inj_on Suc {k. Suc k \<in> M \<and> k < i}"
       by force
     show "inj_on (\<lambda>x. x - Suc 0) {k \<in> M. k < Suc i}"
       by (rule inj_on_diff_nat) (use * in blast)
   qed (use * in auto)
 qed
 
 lemma card_less_Suc:
   assumes "0 \<in> M"
     shows "Suc (card {k. Suc k \<in> M \<and> k < i}) = card {k \<in> M. k < Suc i}"
 proof -
   have "Suc (card {k. Suc k \<in> M \<and> k < i}) = Suc (card {k. Suc k \<in> M - {0} \<and> k < i})"
     by simp
   also have "\<dots> = Suc (card {k \<in> M - {0}. k < Suc i})"
     apply (subst card_less_Suc2)
     using assms by auto
   also have "\<dots> = Suc (card ({k \<in> M. k < Suc i} - {0}))"
     by (force intro: arg_cong [where f=card])
   also have "\<dots> = card (insert 0 ({k \<in> M. k < Suc i} - {0}))"
     by (simp add: card_insert)
   also have "... = card {k \<in> M. k < Suc i}"
     using assms
     by (force simp add: intro: arg_cong [where f=card])
   finally show ?thesis.
 qed
 
 
 subsection \<open>Lemmas useful with the summation operator sum\<close>
 
 text \<open>For examples, see Algebra/poly/UnivPoly2.thy\<close>
 
 subsubsection \<open>Disjoint Unions\<close>
 
 text \<open>Singletons and open intervals\<close>
 
 lemma ivl_disj_un_singleton:
   "{l::'a::linorder} Un {l<..} = {l..}"
   "{..<u} Un {u::'a::linorder} = {..u}"
   "(l::'a::linorder) < u ==> {l} Un {l<..<u} = {l..<u}"
   "(l::'a::linorder) < u ==> {l<..<u} Un {u} = {l<..u}"
   "(l::'a::linorder) \<le> u ==> {l} Un {l<..u} = {l..u}"
   "(l::'a::linorder) \<le> u ==> {l..<u} Un {u} = {l..u}"
 by auto
 
 text \<open>One- and two-sided intervals\<close>
 
 lemma ivl_disj_un_one:
   "(l::'a::linorder) < u ==> {..l} Un {l<..<u} = {..<u}"
   "(l::'a::linorder) \<le> u ==> {..<l} Un {l..<u} = {..<u}"
   "(l::'a::linorder) \<le> u ==> {..l} Un {l<..u} = {..u}"
   "(l::'a::linorder) \<le> u ==> {..<l} Un {l..u} = {..u}"
   "(l::'a::linorder) \<le> u ==> {l<..u} Un {u<..} = {l<..}"
   "(l::'a::linorder) < u ==> {l<..<u} Un {u..} = {l<..}"
   "(l::'a::linorder) \<le> u ==> {l..u} Un {u<..} = {l..}"
   "(l::'a::linorder) \<le> u ==> {l..<u} Un {u..} = {l..}"
 by auto
 
 text \<open>Two- and two-sided intervals\<close>
 
 lemma ivl_disj_un_two:
   "[| (l::'a::linorder) < m; m \<le> u |] ==> {l<..<m} Un {m..<u} = {l<..<u}"
   "[| (l::'a::linorder) \<le> m; m < u |] ==> {l<..m} Un {m<..<u} = {l<..<u}"
   "[| (l::'a::linorder) \<le> m; m \<le> u |] ==> {l..<m} Un {m..<u} = {l..<u}"
   "[| (l::'a::linorder) \<le> m; m < u |] ==> {l..m} Un {m<..<u} = {l..<u}"
   "[| (l::'a::linorder) < m; m \<le> u |] ==> {l<..<m} Un {m..u} = {l<..u}"
   "[| (l::'a::linorder) \<le> m; m \<le> u |] ==> {l<..m} Un {m<..u} = {l<..u}"
   "[| (l::'a::linorder) \<le> m; m \<le> u |] ==> {l..<m} Un {m..u} = {l..u}"
   "[| (l::'a::linorder) \<le> m; m \<le> u |] ==> {l..m} Un {m<..u} = {l..u}"
 by auto
 
 lemma ivl_disj_un_two_touch:
   "[| (l::'a::linorder) < m; m < u |] ==> {l<..m} Un {m..<u} = {l<..<u}"
   "[| (l::'a::linorder) \<le> m; m < u |] ==> {l..m} Un {m..<u} = {l..<u}"
   "[| (l::'a::linorder) < m; m \<le> u |] ==> {l<..m} Un {m..u} = {l<..u}"
   "[| (l::'a::linorder) \<le> m; m \<le> u |] ==> {l..m} Un {m..u} = {l..u}"
 by auto
 
 lemmas ivl_disj_un = ivl_disj_un_singleton ivl_disj_un_one ivl_disj_un_two ivl_disj_un_two_touch
 
 subsubsection \<open>Disjoint Intersections\<close>
 
 text \<open>One- and two-sided intervals\<close>
 
 lemma ivl_disj_int_one:
   "{..l::'a::order} Int {l<..<u} = {}"
   "{..<l} Int {l..<u} = {}"
   "{..l} Int {l<..u} = {}"
   "{..<l} Int {l..u} = {}"
   "{l<..u} Int {u<..} = {}"
   "{l<..<u} Int {u..} = {}"
   "{l..u} Int {u<..} = {}"
   "{l..<u} Int {u..} = {}"
   by auto
 
 text \<open>Two- and two-sided intervals\<close>
 
 lemma ivl_disj_int_two:
   "{l::'a::order<..<m} Int {m..<u} = {}"
   "{l<..m} Int {m<..<u} = {}"
   "{l..<m} Int {m..<u} = {}"
   "{l..m} Int {m<..<u} = {}"
   "{l<..<m} Int {m..u} = {}"
   "{l<..m} Int {m<..u} = {}"
   "{l..<m} Int {m..u} = {}"
   "{l..m} Int {m<..u} = {}"
   by auto
 
 lemmas ivl_disj_int = ivl_disj_int_one ivl_disj_int_two
 
 subsubsection \<open>Some Differences\<close>
 
 lemma ivl_diff[simp]:
  "i \<le> n \<Longrightarrow> {i..<m} - {i..<n} = {n..<(m::'a::linorder)}"
 by(auto)
 
 lemma (in linorder) lessThan_minus_lessThan [simp]:
   "{..< n} - {..< m} = {m ..< n}"
   by auto
 
 lemma (in linorder) atLeastAtMost_diff_ends:
   "{a..b} - {a, b} = {a<..<b}"
   by auto
 
 
 subsubsection \<open>Some Subset Conditions\<close>
 
 lemma ivl_subset [simp]: "({i..<j} \<subseteq> {m..<n}) = (j \<le> i \<or> m \<le> i \<and> j \<le> (n::'a::linorder))"
   using linorder_class.le_less_linear[of i n]
   apply (auto simp: linorder_not_le)
    apply (force intro: leI)+
   done
 
 
 subsection \<open>Generic big monoid operation over intervals\<close>
 
 context semiring_char_0
 begin
 
 lemma inj_on_of_nat [simp]:
   "inj_on of_nat N"
   by rule simp
 
 lemma bij_betw_of_nat [simp]:
   "bij_betw of_nat N A \<longleftrightarrow> of_nat ` N = A"
   by (simp add: bij_betw_def)
 
 end
 
 context comm_monoid_set
 begin
 
 lemma atLeastLessThan_reindex:
   "F g {h m..<h n} = F (g \<circ> h) {m..<n}"
   if "bij_betw h {m..<n} {h m..<h n}" for m n ::nat
 proof -
   from that have "inj_on h {m..<n}" and "h ` {m..<n} = {h m..<h n}"
     by (simp_all add: bij_betw_def)
   then show ?thesis
     using reindex [of h "{m..<n}" g] by simp
 qed
 
 lemma atLeastAtMost_reindex:
   "F g {h m..h n} = F (g \<circ> h) {m..n}"
   if "bij_betw h {m..n} {h m..h n}" for m n ::nat
 proof -
   from that have "inj_on h {m..n}" and "h ` {m..n} = {h m..h n}"
     by (simp_all add: bij_betw_def)
   then show ?thesis
     using reindex [of h "{m..n}" g] by simp
 qed
 
 lemma atLeastLessThan_shift_bounds:
   "F g {m + k..<n + k} = F (g \<circ> plus k) {m..<n}"
   for m n k :: nat
   using atLeastLessThan_reindex [of "plus k" m n g]
   by (simp add: ac_simps)
 
 lemma atLeastAtMost_shift_bounds:
   "F g {m + k..n + k} = F (g \<circ> plus k) {m..n}"
   for m n k :: nat
   using atLeastAtMost_reindex [of "plus k" m n g]
   by (simp add: ac_simps)
 
 lemma atLeast_Suc_lessThan_Suc_shift:
   "F g {Suc m..<Suc n} = F (g \<circ> Suc) {m..<n}"
   using atLeastLessThan_shift_bounds [of _ _ 1]
   by (simp add: plus_1_eq_Suc)
 
 lemma atLeast_Suc_atMost_Suc_shift:
   "F g {Suc m..Suc n} = F (g \<circ> Suc) {m..n}"
   using atLeastAtMost_shift_bounds [of _ _ 1]
   by (simp add: plus_1_eq_Suc)
 
 lemma atLeast_int_lessThan_int_shift:
   "F g {int m..<int n} = F (g \<circ> int) {m..<n}"
   by (rule atLeastLessThan_reindex)
     (simp add: image_int_atLeastLessThan)
 
 lemma atLeast_int_atMost_int_shift:
   "F g {int m..int n} = F (g \<circ> int) {m..n}"
   by (rule atLeastAtMost_reindex)
     (simp add: image_int_atLeastAtMost)
 
 lemma atLeast0_lessThan_Suc:
   "F g {0..<Suc n} = F g {0..<n} \<^bold>* g n"
   by (simp add: atLeast0_lessThan_Suc ac_simps)
 
 lemma atLeast0_atMost_Suc:
   "F g {0..Suc n} = F g {0..n} \<^bold>* g (Suc n)"
   by (simp add: atLeast0_atMost_Suc ac_simps)
 
 lemma atLeast0_lessThan_Suc_shift:
   "F g {0..<Suc n} = g 0 \<^bold>* F (g \<circ> Suc) {0..<n}"
   by (simp add: atLeast0_lessThan_Suc_eq_insert_0 atLeast_Suc_lessThan_Suc_shift)
 
 lemma atLeast0_atMost_Suc_shift:
   "F g {0..Suc n} = g 0 \<^bold>* F (g \<circ> Suc) {0..n}"
   by (simp add: atLeast0_atMost_Suc_eq_insert_0 atLeast_Suc_atMost_Suc_shift)
 
 lemma atLeast_Suc_lessThan:
   "F g {m..<n} = g m \<^bold>* F g {Suc m..<n}" if "m < n"
 proof -
   from that have "{m..<n} = insert m {Suc m..<n}"
     by auto
   then show ?thesis by simp
 qed
 
 lemma atLeast_Suc_atMost:
   "F g {m..n} = g m \<^bold>* F g {Suc m..n}" if "m \<le> n"
 proof -
   from that have "{m..n} = insert m {Suc m..n}"
     by auto
   then show ?thesis by simp
 qed
 
 lemma ivl_cong:
   "a = c \<Longrightarrow> b = d \<Longrightarrow> (\<And>x. c \<le> x \<Longrightarrow> x < d \<Longrightarrow> g x = h x)
     \<Longrightarrow> F g {a..<b} = F h {c..<d}"
   by (rule cong) simp_all
 
 lemma atLeastLessThan_shift_0:
   fixes m n p :: nat
   shows "F g {m..<n} = F (g \<circ> plus m) {0..<n - m}"
   using atLeastLessThan_shift_bounds [of g 0 m "n - m"]
   by (cases "m \<le> n") simp_all
 
 lemma atLeastAtMost_shift_0:
   fixes m n p :: nat
   assumes "m \<le> n"
   shows "F g {m..n} = F (g \<circ> plus m) {0..n - m}"
   using assms atLeastAtMost_shift_bounds [of g 0 m "n - m"] by simp
 
 lemma atLeastLessThan_concat:
   fixes m n p :: nat
   shows "m \<le> n \<Longrightarrow> n \<le> p \<Longrightarrow> F g {m..<n} \<^bold>* F g {n..<p} = F g {m..<p}"
   by (simp add: union_disjoint [symmetric] ivl_disj_un)
 
 lemma atLeastLessThan_rev:
   "F g {n..<m} = F (\<lambda>i. g (m + n - Suc i)) {n..<m}"
   by (rule reindex_bij_witness [where i="\<lambda>i. m + n - Suc i" and j="\<lambda>i. m + n - Suc i"], auto)
 
 lemma atLeastAtMost_rev:
   fixes n m :: nat
   shows "F g {n..m} = F (\<lambda>i. g (m + n - i)) {n..m}"
   by (rule reindex_bij_witness [where i="\<lambda>i. m + n - i" and j="\<lambda>i. m + n - i"]) auto
 
 lemma atLeastLessThan_rev_at_least_Suc_atMost:
   "F g {n..<m} = F (\<lambda>i. g (m + n - i)) {Suc n..m}"
   unfolding atLeastLessThan_rev [of g n m]
   by (cases m) (simp_all add: atLeast_Suc_atMost_Suc_shift atLeastLessThanSuc_atLeastAtMost)
 
 end
 
 
 subsection \<open>Summation indexed over intervals\<close>
 
 syntax (ASCII)
   "_from_to_sum" :: "idt \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"  ("(SUM _ = _.._./ _)" [0,0,0,10] 10)
   "_from_upto_sum" :: "idt \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"  ("(SUM _ = _..<_./ _)" [0,0,0,10] 10)
   "_upt_sum" :: "idt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"  ("(SUM _<_./ _)" [0,0,10] 10)
   "_upto_sum" :: "idt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"  ("(SUM _<=_./ _)" [0,0,10] 10)
 
 syntax (latex_sum output)
   "_from_to_sum" :: "idt \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"
  ("(3\<^latex>\<open>$\\sum_{\<close>_ = _\<^latex>\<open>}^{\<close>_\<^latex>\<open>}$\<close> _)" [0,0,0,10] 10)
   "_from_upto_sum" :: "idt \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"
  ("(3\<^latex>\<open>$\\sum_{\<close>_ = _\<^latex>\<open>}^{<\<close>_\<^latex>\<open>}$\<close> _)" [0,0,0,10] 10)
   "_upt_sum" :: "idt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"
  ("(3\<^latex>\<open>$\\sum_{\<close>_ < _\<^latex>\<open>}$\<close> _)" [0,0,10] 10)
   "_upto_sum" :: "idt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"
  ("(3\<^latex>\<open>$\\sum_{\<close>_ \<le> _\<^latex>\<open>}$\<close> _)" [0,0,10] 10)
 
 syntax
   "_from_to_sum" :: "idt \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"  ("(3\<Sum>_ = _.._./ _)" [0,0,0,10] 10)
   "_from_upto_sum" :: "idt \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"  ("(3\<Sum>_ = _..<_./ _)" [0,0,0,10] 10)
   "_upt_sum" :: "idt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"  ("(3\<Sum>_<_./ _)" [0,0,10] 10)
   "_upto_sum" :: "idt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"  ("(3\<Sum>_\<le>_./ _)" [0,0,10] 10)
 
 translations
   "\<Sum>x=a..b. t" == "CONST sum (\<lambda>x. t) {a..b}"
   "\<Sum>x=a..<b. t" == "CONST sum (\<lambda>x. t) {a..<b}"
   "\<Sum>i\<le>n. t" == "CONST sum (\<lambda>i. t) {..n}"
   "\<Sum>i<n. t" == "CONST sum (\<lambda>i. t) {..<n}"
 
 text\<open>The above introduces some pretty alternative syntaxes for
 summation over intervals:
 \begin{center}
 \begin{tabular}{lll}
 Old & New & \LaTeX\\
 @{term[source]"\<Sum>x\<in>{a..b}. e"} & \<^term>\<open>\<Sum>x=a..b. e\<close> & @{term[mode=latex_sum]"\<Sum>x=a..b. e"}\\
 @{term[source]"\<Sum>x\<in>{a..<b}. e"} & \<^term>\<open>\<Sum>x=a..<b. e\<close> & @{term[mode=latex_sum]"\<Sum>x=a..<b. e"}\\
 @{term[source]"\<Sum>x\<in>{..b}. e"} & \<^term>\<open>\<Sum>x\<le>b. e\<close> & @{term[mode=latex_sum]"\<Sum>x\<le>b. e"}\\
 @{term[source]"\<Sum>x\<in>{..<b}. e"} & \<^term>\<open>\<Sum>x<b. e\<close> & @{term[mode=latex_sum]"\<Sum>x<b. e"}
 \end{tabular}
 \end{center}
 The left column shows the term before introduction of the new syntax,
 the middle column shows the new (default) syntax, and the right column
 shows a special syntax. The latter is only meaningful for latex output
 and has to be activated explicitly by setting the print mode to
 \<open>latex_sum\<close> (e.g.\ via \<open>mode = latex_sum\<close> in
 antiquotations). It is not the default \LaTeX\ output because it only
 works well with italic-style formulae, not tt-style.
 
 Note that for uniformity on \<^typ>\<open>nat\<close> it is better to use
 \<^term>\<open>\<Sum>x::nat=0..<n. e\<close> rather than \<open>\<Sum>x<n. e\<close>: \<open>sum\<close> may
 not provide all lemmas available for \<^term>\<open>{m..<n}\<close> also in the
 special form for \<^term>\<open>{..<n}\<close>.\<close>
 
 text\<open>This congruence rule should be used for sums over intervals as
 the standard theorem @{text[source]sum.cong} does not work well
 with the simplifier who adds the unsimplified premise \<^term>\<open>x\<in>B\<close> to
 the context.\<close>
 
 context comm_monoid_set
 begin
 
 lemma zero_middle:
   assumes "1 \<le> p" "k \<le> p"
   shows "F (\<lambda>j. if j < k then g j else if j = k then \<^bold>1 else h (j - Suc 0)) {..p}
        = F (\<lambda>j. if j < k then g j else h j) {..p - Suc 0}"  (is "?lhs = ?rhs")
 proof -
   have [simp]: "{..p - Suc 0} \<inter> {j. j < k} = {..<k}" "{..p - Suc 0} \<inter> - {j. j < k} = {k..p - Suc 0}"
     using assms by auto
   have "?lhs = F g {..<k} \<^bold>* F (\<lambda>j. if j = k then \<^bold>1 else h (j - Suc 0)) {k..p}"
     using union_disjoint [of "{..<k}" "{k..p}"] assms
     by (simp add: ivl_disj_int_one ivl_disj_un_one)
   also have "\<dots> = F g {..<k} \<^bold>* F (\<lambda>j.  h (j - Suc 0)) {Suc k..p}"
     by (simp add: atLeast_Suc_atMost [of k p] assms)
   also have "\<dots> = F g {..<k} \<^bold>* F h {k .. p - Suc 0}"
     using reindex [of Suc "{k..p - Suc 0}"] assms by simp
   also have "\<dots> = ?rhs"
     by (simp add: If_cases)
   finally show ?thesis .
 qed
 
 lemma atMost_Suc [simp]:
   "F g {..Suc n} = F g {..n} \<^bold>* g (Suc n)"
   by (simp add: atMost_Suc ac_simps)
 
 lemma lessThan_Suc [simp]:
   "F g {..<Suc n} = F g {..<n} \<^bold>* g n"
   by (simp add: lessThan_Suc ac_simps)
 
 lemma cl_ivl_Suc [simp]:
   "F g {m..Suc n} = (if Suc n < m then \<^bold>1 else F g {m..n} \<^bold>* g(Suc n))"
   by (auto simp: ac_simps atLeastAtMostSuc_conv)
 
 lemma op_ivl_Suc [simp]:
   "F g {m..<Suc n} = (if n < m then \<^bold>1 else F g {m..<n} \<^bold>* g(n))"
   by (auto simp: ac_simps atLeastLessThanSuc)
 
 lemma head:
   fixes n :: nat
   assumes mn: "m \<le> n"
   shows "F g {m..n} = g m \<^bold>* F g {m<..n}" (is "?lhs = ?rhs")
 proof -
   from mn
   have "{m..n} = {m} \<union> {m<..n}"
     by (auto intro: ivl_disj_un_singleton)
   hence "?lhs = F g ({m} \<union> {m<..n})"
     by (simp add: atLeast0LessThan)
   also have "\<dots> = ?rhs" by simp
   finally show ?thesis .
 qed
 
 lemma ub_add_nat: 
   assumes "(m::nat) \<le> n + 1"
   shows "F g {m..n + p} = F g {m..n} \<^bold>* F g {n + 1..n + p}"
 proof-
   have "{m .. n+p} = {m..n} \<union> {n+1..n+p}" using \<open>m \<le> n+1\<close> by auto
   thus ?thesis by (auto simp: ivl_disj_int union_disjoint atLeastSucAtMost_greaterThanAtMost)
 qed
 
 lemma nat_group: 
   fixes k::nat shows "F (\<lambda>m. F g {m * k ..< m*k + k}) {..<n} = F g {..< n * k}"
 proof (cases k)
   case (Suc l)
   then have "k > 0"
     by auto
   then show ?thesis
     by (induct n) (simp_all add: atLeastLessThan_concat add.commute atLeast0LessThan[symmetric])
 qed auto   
 
 lemma triangle_reindex:
   fixes n :: nat
   shows "F (\<lambda>(i,j). g i j) {(i,j). i+j < n} = F (\<lambda>k. F (\<lambda>i. g i (k - i)) {..k}) {..<n}"
   apply (simp add: Sigma)
   apply (rule reindex_bij_witness[where j="\<lambda>(i, j). (i+j, i)" and i="\<lambda>(k, i). (i, k - i)"])
   apply auto
   done
 
 lemma triangle_reindex_eq:
   fixes n :: nat
   shows "F (\<lambda>(i,j). g i j) {(i,j). i+j \<le> n} = F (\<lambda>k. F (\<lambda>i. g i (k - i)) {..k}) {..n}"
 using triangle_reindex [of g "Suc n"]
 by (simp only: Nat.less_Suc_eq_le lessThan_Suc_atMost)
 
 lemma nat_diff_reindex: "F (\<lambda>i. g (n - Suc i)) {..<n} = F g {..<n}"
   by (rule reindex_bij_witness[where i="\<lambda>i. n - Suc i" and j="\<lambda>i. n - Suc i"]) auto
 
 lemma shift_bounds_nat_ivl:
   "F g {m+k..<n+k} = F (\<lambda>i. g(i + k)){m..<n::nat}"
 by (induct "n", auto simp: atLeastLessThanSuc)
 
 lemma shift_bounds_cl_nat_ivl:
   "F g {m+k..n+k} = F (\<lambda>i. g(i + k)){m..n::nat}"
   by (rule reindex_bij_witness[where i="\<lambda>i. i + k" and j="\<lambda>i. i - k"]) auto
 
 corollary shift_bounds_cl_Suc_ivl:
   "F g {Suc m..Suc n} = F (\<lambda>i. g(Suc i)){m..n}"
 by (simp add: shift_bounds_cl_nat_ivl[where k="Suc 0", simplified])
 
+corollary Suc_reindex_ivl: "m \<le> n \<Longrightarrow> F g {m..n} \<^bold>* g (Suc n) = g m \<^bold>* F (\<lambda>i. g (Suc i)) {m..n}"
+  by (simp add: assoc atLeast_Suc_atMost flip: shift_bounds_cl_Suc_ivl)
+
 corollary shift_bounds_Suc_ivl:
   "F g {Suc m..<Suc n} = F (\<lambda>i. g(Suc i)){m..<n}"
 by (simp add: shift_bounds_nat_ivl[where k="Suc 0", simplified])
 
 lemma atMost_Suc_shift:
   shows "F g {..Suc n} = g 0 \<^bold>* F (\<lambda>i. g (Suc i)) {..n}"
 proof (induct n)
   case 0 show ?case by simp
 next
   case (Suc n) note IH = this
   have "F g {..Suc (Suc n)} = F g {..Suc n} \<^bold>* g (Suc (Suc n))"
     by (rule atMost_Suc)
   also have "F g {..Suc n}  = g 0 \<^bold>* F (\<lambda>i. g (Suc i)) {..n}"
     by (rule IH)
   also have "g 0 \<^bold>* F (\<lambda>i. g (Suc i)) {..n} \<^bold>* g (Suc (Suc n)) =
              g 0 \<^bold>* (F (\<lambda>i. g (Suc i)) {..n} \<^bold>* g (Suc (Suc n)))"
     by (rule assoc)
   also have "F (\<lambda>i. g (Suc i)) {..n} \<^bold>* g (Suc (Suc n)) = F (\<lambda>i. g (Suc i)) {..Suc n}"
     by (rule atMost_Suc [symmetric])
   finally show ?case .
 qed
 
 lemma lessThan_Suc_shift:
   "F g {..<Suc n} = g 0 \<^bold>* F (\<lambda>i. g (Suc i)) {..<n}"
   by (induction n) (simp_all add: ac_simps)
 
 lemma atMost_shift:
   "F g {..n} = g 0 \<^bold>* F (\<lambda>i. g (Suc i)) {..<n}"
   by (metis atLeast0AtMost atLeast0LessThan atLeastLessThanSuc_atLeastAtMost 
        atLeastSucAtMost_greaterThanAtMost le0 head shift_bounds_Suc_ivl)
 
 lemma last_plus: 
   fixes n::nat  shows "m \<le> n \<Longrightarrow> F g {m..n} = g n \<^bold>* F g {m..<n}"
   by (cases n) (auto simp: atLeastLessThanSuc_atLeastAtMost commute)
 
 lemma nested_swap:
      "F (\<lambda>i. F (\<lambda>j. a i j) {0..<i}) {0..n} = F (\<lambda>j. F (\<lambda>i. a i j) {Suc j..n}) {0..<n}"
   by (induction n) (auto simp: distrib)
 
 lemma nested_swap':
      "F (\<lambda>i. F (\<lambda>j. a i j) {..<i}) {..n} = F (\<lambda>j. F (\<lambda>i. a i j) {Suc j..n}) {..<n}"
   by (induction n) (auto simp: distrib)
 
 lemma atLeast1_atMost_eq:
   "F g {Suc 0..n} = F (\<lambda>k. g (Suc k)) {..<n}"
 proof -
   have "F g {Suc 0..n} = F g (Suc ` {..<n})"
     by (simp add: image_Suc_lessThan)
   also have "\<dots> = F (\<lambda>k. g (Suc k)) {..<n}"
     by (simp add: reindex)
   finally show ?thesis .
 qed
 
 lemma atLeastLessThan_Suc: "a \<le> b \<Longrightarrow> F g {a..<Suc b} = F g {a..<b} \<^bold>* g b"
   by (simp add: atLeastLessThanSuc commute)
 
 lemma nat_ivl_Suc':
   assumes "m \<le> Suc n"
   shows   "F g {m..Suc n} = g (Suc n) \<^bold>* F g {m..n}"
 proof -
   from assms have "{m..Suc n} = insert (Suc n) {m..n}" by auto
   also have "F g \<dots> = g (Suc n) \<^bold>* F g {m..n}" by simp
   finally show ?thesis .
 qed
 
 lemma in_pairs: "F g {2*m..Suc(2*n)} = F (\<lambda>i. g(2*i) \<^bold>* g(Suc(2*i))) {m..n}"
 proof (induction n)
   case 0
   show ?case
     by (cases "m=0") auto
 next
   case (Suc n)
   then show ?case
     by (auto simp: assoc split: if_split_asm)
 qed
 
 lemma in_pairs_0: "F g {..Suc(2*n)} = F (\<lambda>i. g(2*i) \<^bold>* g(Suc(2*i))) {..n}"
   using in_pairs [of _ 0 n] by (simp add: atLeast0AtMost)
 
 end
 
 lemma sum_natinterval_diff:
   fixes f:: "nat \<Rightarrow> ('a::ab_group_add)"
   shows  "sum (\<lambda>k. f k - f(k + 1)) {(m::nat) .. n} =
           (if m \<le> n then f m - f(n + 1) else 0)"
 by (induct n, auto simp add: algebra_simps not_le le_Suc_eq)
 
 lemma sum_diff_nat_ivl:
   fixes f :: "nat \<Rightarrow> 'a::ab_group_add"
   shows "\<lbrakk> m \<le> n; n \<le> p \<rbrakk> \<Longrightarrow> sum f {m..<p} - sum f {m..<n} = sum f {n..<p}"
   using sum.atLeastLessThan_concat [of m n p f,symmetric]
   by (simp add: ac_simps)
 
 lemma sum_diff_distrib: "\<forall>x. Q x \<le> P x  \<Longrightarrow> (\<Sum>x<n. P x) - (\<Sum>x<n. Q x) = (\<Sum>x<n. P x - Q x :: nat)"
   by (subst sum_subtractf_nat) auto
 
 
 context unique_euclidean_semiring_with_bit_shifts
 begin
 
 lemma take_bit_sum:
   "take_bit n a = (\<Sum>k = 0..<n. push_bit k (of_bool (odd (drop_bit k a))))"
   for n :: nat
 proof (induction n arbitrary: a)
   case 0
   then show ?case
     by simp
 next
   case (Suc n)
   have "(\<Sum>k = 0..<Suc n. push_bit k (of_bool (odd (drop_bit k a)))) = 
     of_bool (odd a) + (\<Sum>k = Suc 0..<Suc n. push_bit k (of_bool (odd (drop_bit k a))))"
     by (simp add: sum.atLeast_Suc_lessThan ac_simps)
   also have "(\<Sum>k = Suc 0..<Suc n. push_bit k (of_bool (odd (drop_bit k a))))
     = (\<Sum>k = 0..<n. push_bit k (of_bool (odd (drop_bit k (a div 2))))) * 2"
     by (simp only: sum.atLeast_Suc_lessThan_Suc_shift) (simp add: sum_distrib_right push_bit_double)
   finally show ?case
     using Suc [of "a div 2"] by (simp add: ac_simps)
 qed
 
 end
 
 
 subsubsection \<open>Shifting bounds\<close>
 
 context comm_monoid_add
 begin
 
 context
   fixes f :: "nat \<Rightarrow> 'a"
   assumes "f 0 = 0"
 begin
 
 lemma sum_shift_lb_Suc0_0_upt:
   "sum f {Suc 0..<k} = sum f {0..<k}"
 proof (cases k)
   case 0
   then show ?thesis
     by simp
 next
   case (Suc k)
   moreover have "{0..<Suc k} = insert 0 {Suc 0..<Suc k}"
     by auto
   ultimately show ?thesis
     using \<open>f 0 = 0\<close> by simp
 qed
 
 lemma sum_shift_lb_Suc0_0: "sum f {Suc 0..k} = sum f {0..k}"
 proof (cases k)
   case 0
   with \<open>f 0 = 0\<close> show ?thesis
     by simp
 next
   case (Suc k)
   moreover have "{0..Suc k} = insert 0 {Suc 0..Suc k}"
     by auto
   ultimately show ?thesis
     using \<open>f 0 = 0\<close> by simp
 qed
 
 end
 
 end
 
 lemma sum_Suc_diff:
   fixes f :: "nat \<Rightarrow> 'a::ab_group_add"
   assumes "m \<le> Suc n"
   shows "(\<Sum>i = m..n. f(Suc i) - f i) = f (Suc n) - f m"
 using assms by (induct n) (auto simp: le_Suc_eq)
 
 lemma sum_Suc_diff':
   fixes f :: "nat \<Rightarrow> 'a::ab_group_add"
   assumes "m \<le> n"
   shows "(\<Sum>i = m..<n. f (Suc i) - f i) = f n - f m"
 using assms by (induct n) (auto simp: le_Suc_eq)
 
 
 subsubsection \<open>Telescoping\<close>
 
 lemma sum_telescope:
   fixes f::"nat \<Rightarrow> 'a::ab_group_add"
   shows "sum (\<lambda>i. f i - f (Suc i)) {.. i} = f 0 - f (Suc i)"
   by (induct i) simp_all
 
 lemma sum_telescope'':
   assumes "m \<le> n"
   shows   "(\<Sum>k\<in>{Suc m..n}. f k - f (k - 1)) = f n - (f m :: 'a :: ab_group_add)"
   by (rule dec_induct[OF assms]) (simp_all add: algebra_simps)
 
 lemma sum_lessThan_telescope:
   "(\<Sum>n<m. f (Suc n) - f n :: 'a :: ab_group_add) = f m - f 0"
   by (induction m) (simp_all add: algebra_simps)
 
 lemma sum_lessThan_telescope':
   "(\<Sum>n<m. f n - f (Suc n) :: 'a :: ab_group_add) = f 0 - f m"
   by (induction m) (simp_all add: algebra_simps)
 
 
 subsubsection \<open>The formula for geometric sums\<close>
 
 lemma sum_power2: "(\<Sum>i=0..<k. (2::nat)^i) = 2^k-1"
 by (induction k) (auto simp: mult_2)
 
 lemma geometric_sum:
   assumes "x \<noteq> 1"
   shows "(\<Sum>i<n. x ^ i) = (x ^ n - 1) / (x - 1::'a::field)"
 proof -
   from assms obtain y where "y = x - 1" and "y \<noteq> 0" by simp_all
   moreover have "(\<Sum>i<n. (y + 1) ^ i) = ((y + 1) ^ n - 1) / y"
     by (induct n) (simp_all add: field_simps \<open>y \<noteq> 0\<close>)
   ultimately show ?thesis by simp
 qed
 
 lemma diff_power_eq_sum:
   fixes y :: "'a::{comm_ring,monoid_mult}"
   shows
     "x ^ (Suc n) - y ^ (Suc n) =
       (x - y) * (\<Sum>p<Suc n. (x ^ p) * y ^ (n - p))"
 proof (induct n)
   case (Suc n)
   have "x ^ Suc (Suc n) - y ^ Suc (Suc n) = x * (x * x^n) - y * (y * y ^ n)"
     by simp
   also have "... = y * (x ^ (Suc n) - y ^ (Suc n)) + (x - y) * (x * x^n)"
     by (simp add: algebra_simps)
   also have "... = y * ((x - y) * (\<Sum>p<Suc n. (x ^ p) * y ^ (n - p))) + (x - y) * (x * x^n)"
     by (simp only: Suc)
   also have "... = (x - y) * (y * (\<Sum>p<Suc n. (x ^ p) * y ^ (n - p))) + (x - y) * (x * x^n)"
     by (simp only: mult.left_commute)
   also have "... = (x - y) * (\<Sum>p<Suc (Suc n). x ^ p * y ^ (Suc n - p))"
     by (simp add: field_simps Suc_diff_le sum_distrib_right sum_distrib_left)
   finally show ?case .
 qed simp
 
 corollary power_diff_sumr2: \<comment> \<open>\<open>COMPLEX_POLYFUN\<close> in HOL Light\<close>
   fixes x :: "'a::{comm_ring,monoid_mult}"
   shows   "x^n - y^n = (x - y) * (\<Sum>i<n. y^(n - Suc i) * x^i)"
 using diff_power_eq_sum[of x "n - 1" y]
 by (cases "n = 0") (simp_all add: field_simps)
 
 lemma power_diff_1_eq:
   fixes x :: "'a::{comm_ring,monoid_mult}"
   shows "n \<noteq> 0 \<Longrightarrow> x^n - 1 = (x - 1) * (\<Sum>i<n. (x^i))"
 using diff_power_eq_sum [of x _ 1]
   by (cases n) auto
 
 lemma one_diff_power_eq':
   fixes x :: "'a::{comm_ring,monoid_mult}"
   shows "n \<noteq> 0 \<Longrightarrow> 1 - x^n = (1 - x) * (\<Sum>i<n. x^(n - Suc i))"
 using diff_power_eq_sum [of 1 _ x]
   by (cases n) auto
 
 lemma one_diff_power_eq:
   fixes x :: "'a::{comm_ring,monoid_mult}"
   shows "n \<noteq> 0 \<Longrightarrow> 1 - x^n = (1 - x) * (\<Sum>i<n. x^i)"
 by (metis one_diff_power_eq' [of n x] sum.nat_diff_reindex)
 
 lemma sum_gp_basic:
   fixes x :: "'a::{comm_ring,monoid_mult}"
   shows "(1 - x) * (\<Sum>i\<le>n. x^i) = 1 - x^Suc n"
   by (simp only: one_diff_power_eq [of "Suc n" x] lessThan_Suc_atMost)
 
 lemma sum_power_shift:
   fixes x :: "'a::{comm_ring,monoid_mult}"
   assumes "m \<le> n"
   shows "(\<Sum>i=m..n. x^i) = x^m * (\<Sum>i\<le>n-m. x^i)"
 proof -
   have "(\<Sum>i=m..n. x^i) = x^m * (\<Sum>i=m..n. x^(i-m))"
     by (simp add: sum_distrib_left power_add [symmetric])
   also have "(\<Sum>i=m..n. x^(i-m)) = (\<Sum>i\<le>n-m. x^i)"
     using \<open>m \<le> n\<close> by (intro sum.reindex_bij_witness[where j="\<lambda>i. i - m" and i="\<lambda>i. i + m"]) auto
   finally show ?thesis .
 qed
 
 lemma sum_gp_multiplied:
   fixes x :: "'a::{comm_ring,monoid_mult}"
   assumes "m \<le> n"
   shows "(1 - x) * (\<Sum>i=m..n. x^i) = x^m - x^Suc n"
 proof -
   have  "(1 - x) * (\<Sum>i=m..n. x^i) = x^m * (1 - x) * (\<Sum>i\<le>n-m. x^i)"
     by (metis mult.assoc mult.commute assms sum_power_shift)
   also have "... =x^m * (1 - x^Suc(n-m))"
     by (metis mult.assoc sum_gp_basic)
   also have "... = x^m - x^Suc n"
     using assms
     by (simp add: algebra_simps) (metis le_add_diff_inverse power_add)
   finally show ?thesis .
 qed
 
 lemma sum_gp:
   fixes x :: "'a::{comm_ring,division_ring}"
   shows   "(\<Sum>i=m..n. x^i) =
                (if n < m then 0
                 else if x = 1 then of_nat((n + 1) - m)
                 else (x^m - x^Suc n) / (1 - x))"
 using sum_gp_multiplied [of m n x] apply auto
 by (metis eq_iff_diff_eq_0 mult.commute nonzero_divide_eq_eq)
 
 
 subsubsection\<open>Geometric progressions\<close>
 
 lemma sum_gp0:
   fixes x :: "'a::{comm_ring,division_ring}"
   shows "(\<Sum>i\<le>n. x^i) = (if x = 1 then of_nat(n + 1) else (1 - x^Suc n) / (1 - x))"
   using sum_gp_basic[of x n]
   by (simp add: mult.commute field_split_simps)
 
 lemma sum_power_add:
   fixes x :: "'a::{comm_ring,monoid_mult}"
   shows "(\<Sum>i\<in>I. x^(m+i)) = x^m * (\<Sum>i\<in>I. x^i)"
   by (simp add: sum_distrib_left power_add)
 
 lemma sum_gp_offset:
   fixes x :: "'a::{comm_ring,division_ring}"
   shows   "(\<Sum>i=m..m+n. x^i) =
        (if x = 1 then of_nat n + 1 else x^m * (1 - x^Suc n) / (1 - x))"
   using sum_gp [of x m "m+n"]
   by (auto simp: power_add algebra_simps)
 
 lemma sum_gp_strict:
   fixes x :: "'a::{comm_ring,division_ring}"
   shows "(\<Sum>i<n. x^i) = (if x = 1 then of_nat n else (1 - x^n) / (1 - x))"
   by (induct n) (auto simp: algebra_simps field_split_simps)
 
 
 subsubsection \<open>The formulae for arithmetic sums\<close>
 
 context comm_semiring_1
 begin
 
 lemma double_gauss_sum:
   "2 * (\<Sum>i = 0..n. of_nat i) = of_nat n * (of_nat n + 1)"
   by (induct n) (simp_all add: sum.atLeast0_atMost_Suc algebra_simps left_add_twice)
 
 lemma double_gauss_sum_from_Suc_0:
   "2 * (\<Sum>i = Suc 0..n. of_nat i) = of_nat n * (of_nat n + 1)"
 proof -
   have "sum of_nat {Suc 0..n} = sum of_nat (insert 0 {Suc 0..n})"
     by simp
   also have "\<dots> = sum of_nat {0..n}"
     by (cases n) (simp_all add: atLeast0_atMost_Suc_eq_insert_0)
   finally show ?thesis
     by (simp add: double_gauss_sum)
 qed
 
 lemma double_arith_series:
   "2 * (\<Sum>i = 0..n. a + of_nat i * d) = (of_nat n + 1) * (2 * a + of_nat n * d)"
 proof -
   have "(\<Sum>i = 0..n. a + of_nat i * d) = ((\<Sum>i = 0..n. a) + (\<Sum>i = 0..n. of_nat i * d))"
     by (rule sum.distrib)
   also have "\<dots> = (of_nat (Suc n) * a + d * (\<Sum>i = 0..n. of_nat i))"
     by (simp add: sum_distrib_left algebra_simps)
   finally show ?thesis
     by (simp add: algebra_simps double_gauss_sum left_add_twice)
 qed
 
 end
 
 context unique_euclidean_semiring_with_nat
 begin
 
 lemma gauss_sum:
   "(\<Sum>i = 0..n. of_nat i) = of_nat n * (of_nat n + 1) div 2"
   using double_gauss_sum [of n, symmetric] by simp
 
 lemma gauss_sum_from_Suc_0:
   "(\<Sum>i = Suc 0..n. of_nat i) = of_nat n * (of_nat n + 1) div 2"
   using double_gauss_sum_from_Suc_0 [of n, symmetric] by simp
 
 lemma arith_series:
   "(\<Sum>i = 0..n. a + of_nat i * d) = (of_nat n + 1) * (2 * a + of_nat n * d) div 2"
   using double_arith_series [of a d n, symmetric] by simp
 
 end
 
 lemma gauss_sum_nat:
   "\<Sum>{0..n} = (n * Suc n) div 2"
   using gauss_sum [of n, where ?'a = nat] by simp
 
 lemma arith_series_nat:
   "(\<Sum>i = 0..n. a + i * d) = Suc n * (2 * a + n * d) div 2"
   using arith_series [of a d n] by simp
 
 lemma Sum_Icc_int:
   "\<Sum>{m..n} = (n * (n + 1) - m * (m - 1)) div 2"
   if "m \<le> n" for m n :: int
 using that proof (induct i \<equiv> "nat (n - m)" arbitrary: m n)
   case 0
   then have "m = n"
     by arith
   then show ?case
     by (simp add: algebra_simps mult_2 [symmetric])
 next
   case (Suc i)
   have 0: "i = nat((n-1) - m)" "m \<le> n-1" using Suc(2,3) by arith+
   have "\<Sum> {m..n} = \<Sum> {m..1+(n-1)}" by simp
   also have "\<dots> = \<Sum> {m..n-1} + n" using \<open>m \<le> n\<close>
     by(subst atLeastAtMostPlus1_int_conv) simp_all
   also have "\<dots> = ((n-1)*(n-1+1) - m*(m-1)) div 2 + n"
     by(simp add: Suc(1)[OF 0])
   also have "\<dots> = ((n-1)*(n-1+1) - m*(m-1) + 2*n) div 2" by simp
   also have "\<dots> = (n*(n+1) - m*(m-1)) div 2"
     by (simp add: algebra_simps mult_2_right)
   finally show ?case .
 qed
 
 lemma Sum_Icc_nat:
   "\<Sum>{m..n} = (n * (n + 1) - m * (m - 1)) div 2" for m n :: nat
 proof (cases "m \<le> n")
   case True
   then have *: "m * (m - 1) \<le> n * (n + 1)"
     by (meson diff_le_self order_trans le_add1 mult_le_mono)
   have "int (\<Sum>{m..n}) = (\<Sum>{int m..int n})"
     by (simp add: sum.atLeast_int_atMost_int_shift)
   also have "\<dots> = (int n * (int n + 1) - int m * (int m - 1)) div 2"
     using \<open>m \<le> n\<close> by (simp add: Sum_Icc_int)
   also have "\<dots> = int ((n * (n + 1) - m * (m - 1)) div 2)"
     using le_square * by (simp add: algebra_simps of_nat_div of_nat_diff)
   finally show ?thesis
     by (simp only: of_nat_eq_iff)
 next
   case False
   then show ?thesis
     by (auto dest: less_imp_Suc_add simp add: not_le algebra_simps)
 qed
 
 lemma Sum_Ico_nat: 
   "\<Sum>{m..<n} = (n * (n - 1) - m * (m - 1)) div 2" for m n :: nat
   by (cases n) (simp_all add: atLeastLessThanSuc_atLeastAtMost Sum_Icc_nat)
 
 
 subsubsection \<open>Division remainder\<close>
 
 lemma range_mod:
   fixes n :: nat
   assumes "n > 0"
   shows "range (\<lambda>m. m mod n) = {0..<n}" (is "?A = ?B")
 proof (rule set_eqI)
   fix m
   show "m \<in> ?A \<longleftrightarrow> m \<in> ?B"
   proof
     assume "m \<in> ?A"
     with assms show "m \<in> ?B"
       by auto
   next
     assume "m \<in> ?B"
     moreover have "m mod n \<in> ?A"
       by (rule rangeI)
     ultimately show "m \<in> ?A"
       by simp
   qed
 qed
 
 
 subsection \<open>Products indexed over intervals\<close>
 
 syntax (ASCII)
   "_from_to_prod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"  ("(PROD _ = _.._./ _)" [0,0,0,10] 10)
   "_from_upto_prod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"  ("(PROD _ = _..<_./ _)" [0,0,0,10] 10)
   "_upt_prod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"  ("(PROD _<_./ _)" [0,0,10] 10)
   "_upto_prod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"  ("(PROD _<=_./ _)" [0,0,10] 10)
 
 syntax (latex_prod output)
   "_from_to_prod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"
  ("(3\<^latex>\<open>$\\prod_{\<close>_ = _\<^latex>\<open>}^{\<close>_\<^latex>\<open>}$\<close> _)" [0,0,0,10] 10)
   "_from_upto_prod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"
  ("(3\<^latex>\<open>$\\prod_{\<close>_ = _\<^latex>\<open>}^{<\<close>_\<^latex>\<open>}$\<close> _)" [0,0,0,10] 10)
   "_upt_prod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"
  ("(3\<^latex>\<open>$\\prod_{\<close>_ < _\<^latex>\<open>}$\<close> _)" [0,0,10] 10)
   "_upto_prod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"
  ("(3\<^latex>\<open>$\\prod_{\<close>_ \<le> _\<^latex>\<open>}$\<close> _)" [0,0,10] 10)
 
 syntax
   "_from_to_prod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"  ("(3\<Prod>_ = _.._./ _)" [0,0,0,10] 10)
   "_from_upto_prod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"  ("(3\<Prod>_ = _..<_./ _)" [0,0,0,10] 10)
   "_upt_prod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"  ("(3\<Prod>_<_./ _)" [0,0,10] 10)
   "_upto_prod" :: "idt \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> 'b"  ("(3\<Prod>_\<le>_./ _)" [0,0,10] 10)
 
 translations
   "\<Prod>x=a..b. t" \<rightleftharpoons> "CONST prod (\<lambda>x. t) {a..b}"
   "\<Prod>x=a..<b. t" \<rightleftharpoons> "CONST prod (\<lambda>x. t) {a..<b}"
   "\<Prod>i\<le>n. t" \<rightleftharpoons> "CONST prod (\<lambda>i. t) {..n}"
   "\<Prod>i<n. t" \<rightleftharpoons> "CONST prod (\<lambda>i. t) {..<n}"
 
 lemma prod_int_plus_eq: "prod int {i..i+j} =  \<Prod>{int i..int (i+j)}"
   by (induct j) (auto simp add: atLeastAtMostSuc_conv atLeastAtMostPlus1_int_conv)
 
 lemma prod_int_eq: "prod int {i..j} =  \<Prod>{int i..int j}"
 proof (cases "i \<le> j")
   case True
   then show ?thesis
     by (metis le_iff_add prod_int_plus_eq)
 next
   case False
   then show ?thesis
     by auto
 qed
 
 subsection \<open>Efficient folding over intervals\<close>
 
 function fold_atLeastAtMost_nat where
   [simp del]: "fold_atLeastAtMost_nat f a (b::nat) acc =
                  (if a > b then acc else fold_atLeastAtMost_nat f (a+1) b (f a acc))"
 by pat_completeness auto
 termination by (relation "measure (\<lambda>(_,a,b,_). Suc b - a)") auto
 
 lemma fold_atLeastAtMost_nat:
   assumes "comp_fun_commute f"
   shows   "fold_atLeastAtMost_nat f a b acc = Finite_Set.fold f acc {a..b}"
 using assms
 proof (induction f a b acc rule: fold_atLeastAtMost_nat.induct, goal_cases)
   case (1 f a b acc)
   interpret comp_fun_commute f by fact
   show ?case
   proof (cases "a > b")
     case True
     thus ?thesis by (subst fold_atLeastAtMost_nat.simps) auto
   next
     case False
     with 1 show ?thesis
       by (subst fold_atLeastAtMost_nat.simps)
          (auto simp: atLeastAtMost_insertL[symmetric] fold_fun_left_comm)
   qed
 qed
 
 lemma sum_atLeastAtMost_code:
   "sum f {a..b} = fold_atLeastAtMost_nat (\<lambda>a acc. f a + acc) a b 0"
 proof -
   have "comp_fun_commute (\<lambda>a. (+) (f a))"
     by unfold_locales (auto simp: o_def add_ac)
   thus ?thesis
     by (simp add: sum.eq_fold fold_atLeastAtMost_nat o_def)
 qed
 
 lemma prod_atLeastAtMost_code:
   "prod f {a..b} = fold_atLeastAtMost_nat (\<lambda>a acc. f a * acc) a b 1"
 proof -
   have "comp_fun_commute (\<lambda>a. (*) (f a))"
     by unfold_locales (auto simp: o_def mult_ac)
   thus ?thesis
     by (simp add: prod.eq_fold fold_atLeastAtMost_nat o_def)
 qed
 
 (* TODO: Add support for folding over more kinds of intervals here *)
 
 end