diff --git a/src/HOL/Algebra/QuotRing.thy b/src/HOL/Algebra/QuotRing.thy
--- a/src/HOL/Algebra/QuotRing.thy
+++ b/src/HOL/Algebra/QuotRing.thy
@@ -1,1088 +1,1086 @@
 (*  Title:      HOL/Algebra/QuotRing.thy
     Author:     Stephan Hohe
     Author:     Paulo Emílio de Vilhena
 *)
 
 theory QuotRing
 imports RingHom
 begin
 
 section \<open>Quotient Rings\<close>
 
 subsection \<open>Multiplication on Cosets\<close>
 
 definition rcoset_mult :: "[('a, _) ring_scheme, 'a set, 'a set, 'a set] \<Rightarrow> 'a set"
     ("[mod _:] _ \<Otimes>\<index> _" [81,81,81] 80)
   where "rcoset_mult R I A B = (\<Union>a\<in>A. \<Union>b\<in>B. I +>\<^bsub>R\<^esub> (a \<otimes>\<^bsub>R\<^esub> b))"
 
 
 text \<open>\<^const>\<open>rcoset_mult\<close> fulfils the properties required by congruences\<close>
 lemma (in ideal) rcoset_mult_add:
   assumes "x \<in> carrier R" "y \<in> carrier R"
   shows "[mod I:] (I +> x) \<Otimes> (I +> y) = I +> (x \<otimes> y)"
 proof -
   have 1: "z \<in> I +> x \<otimes> y" 
     if x'rcos: "x' \<in> I +> x" and y'rcos: "y' \<in> I +> y" and zrcos: "z \<in> I +> x' \<otimes> y'" for z x' y'
   proof -
     from that
     obtain hx hy hz where hxI: "hx \<in> I" and x': "x' = hx \<oplus> x" and hyI: "hy \<in> I" and y': "y' = hy \<oplus> y"
       and hzI: "hz \<in> I" and z: "z = hz \<oplus> (x' \<otimes> y')"
       by (auto simp: a_r_coset_def r_coset_def)
     note carr = assms hxI[THEN a_Hcarr] hyI[THEN a_Hcarr] hzI[THEN a_Hcarr]
     from z  x' y' have "z = hz \<oplus> ((hx \<oplus> x) \<otimes> (hy \<oplus> y))" by simp
     also from carr have "\<dots> = (hz \<oplus> (hx \<otimes> (hy \<oplus> y)) \<oplus> x \<otimes> hy) \<oplus> x \<otimes> y" by algebra
     finally have z2: "z = (hz \<oplus> (hx \<otimes> (hy \<oplus> y)) \<oplus> x \<otimes> hy) \<oplus> x \<otimes> y" .
     from hxI hyI hzI carr have "hz \<oplus> (hx \<otimes> (hy \<oplus> y)) \<oplus> x \<otimes> hy \<in> I"
       by (simp add: I_l_closed I_r_closed)
     with z2 show ?thesis
       by (auto simp add: a_r_coset_def r_coset_def)
   qed
   have 2: "\<exists>a\<in>I +> x. \<exists>b\<in>I +> y. z \<in> I +> a \<otimes> b" if "z \<in> I +> x \<otimes> y" for z
     using assms a_rcos_self that by blast
   show ?thesis
     unfolding rcoset_mult_def using assms
     by (auto simp: intro!: 1 2)
 qed
 
 subsection \<open>Quotient Ring Definition\<close>
 
 definition FactRing :: "[('a,'b) ring_scheme, 'a set] \<Rightarrow> ('a set) ring"
     (infixl "Quot" 65)
   where "FactRing R I =
     \<lparr>carrier = a_rcosets\<^bsub>R\<^esub> I, mult = rcoset_mult R I,
       one = (I +>\<^bsub>R\<^esub> \<one>\<^bsub>R\<^esub>), zero = I, add = set_add R\<rparr>"
 
 lemmas FactRing_simps = FactRing_def A_RCOSETS_defs a_r_coset_def[symmetric]
 
 subsection \<open>Factorization over General Ideals\<close>
 
 text \<open>The quotient is a ring\<close>
 lemma (in ideal) quotient_is_ring: "ring (R Quot I)"
 proof (rule ringI)
   show "abelian_group (R Quot I)"
     apply (rule comm_group_abelian_groupI)
     apply (simp add: FactRing_def a_factorgroup_is_comm_group[unfolded A_FactGroup_def'])
     done
   show "Group.monoid (R Quot I)"
     by (rule monoidI)
       (auto simp add: FactRing_simps rcoset_mult_add m_assoc)
 qed (auto simp: FactRing_simps rcoset_mult_add a_rcos_sum l_distr r_distr)
 
 
 text \<open>This is a ring homomorphism\<close>
 
 lemma (in ideal) rcos_ring_hom: "((+>) I) \<in> ring_hom R (R Quot I)"
   by (simp add: ring_hom_memI FactRing_def a_rcosetsI[OF a_subset] rcoset_mult_add a_rcos_sum)
 
 lemma (in ideal) rcos_ring_hom_ring: "ring_hom_ring R (R Quot I) ((+>) I)"
   by (simp add: local.ring_axioms quotient_is_ring rcos_ring_hom ring_hom_ringI2)
 
 text \<open>The quotient of a cring is also commutative\<close>
 lemma (in ideal) quotient_is_cring:
   assumes "cring R"
   shows "cring (R Quot I)"
 proof -
   interpret cring R by fact
   show ?thesis
     apply (intro cring.intro comm_monoid.intro comm_monoid_axioms.intro quotient_is_ring)
      apply (rule ring.axioms[OF quotient_is_ring])
     apply (auto simp add: FactRing_simps rcoset_mult_add m_comm)
     done
 qed
 
 text \<open>Cosets as a ring homomorphism on crings\<close>
 lemma (in ideal) rcos_ring_hom_cring:
   assumes "cring R"
   shows "ring_hom_cring R (R Quot I) ((+>) I)"
 proof -
   interpret cring R by fact
   show ?thesis
     apply (rule ring_hom_cringI)
       apply (rule rcos_ring_hom_ring)
      apply (rule is_cring)
     apply (rule quotient_is_cring)
    apply (rule is_cring)
    done
 qed
 
 
 subsection \<open>Factorization over Prime Ideals\<close>
 
 text \<open>The quotient ring generated by a prime ideal is a domain\<close>
 lemma (in primeideal) quotient_is_domain: "domain (R Quot I)"
 proof -
   have 1: "I +> \<one> = I \<Longrightarrow> False"
     using I_notcarr a_rcos_self one_imp_carrier by blast
   have 2: "I +> x = I"
     if  carr: "x \<in> carrier R" "y \<in> carrier R"
     and a: "I +> x \<otimes> y = I"
     and b: "I +> y \<noteq> I" for x y
     by (metis I_prime a a_rcos_const a_rcos_self b m_closed that)
   show ?thesis
     apply (intro domain.intro quotient_is_cring is_cring domain_axioms.intro)
      apply (metis "1" FactRing_def monoid.simps(2) ring.simps(1))
     apply (simp add: FactRing_simps)
     by (metis "2" rcoset_mult_add)
 qed
 
 text \<open>Generating right cosets of a prime ideal is a homomorphism
         on commutative rings\<close>
 lemma (in primeideal) rcos_ring_hom_cring: "ring_hom_cring R (R Quot I) ((+>) I)"
   by (rule rcos_ring_hom_cring) (rule is_cring)
 
 
 subsection \<open>Factorization over Maximal Ideals\<close>
 
 text \<open>In a commutative ring, the quotient ring over a maximal ideal is a field.
         The proof follows ``W. Adkins, S. Weintraub: Algebra -- An Approach via Module Theory''\<close>
 proposition (in maximalideal) quotient_is_field:
   assumes "cring R"
   shows "field (R Quot I)"
 proof -
   interpret cring R by fact
   have 1: "\<zero>\<^bsub>R Quot I\<^esub> \<noteq> \<one>\<^bsub>R Quot I\<^esub>"  \<comment> \<open>Quotient is not empty\<close>
   proof
     assume "\<zero>\<^bsub>R Quot I\<^esub> = \<one>\<^bsub>R Quot I\<^esub>"
     then have II1: "I = I +> \<one>" by (simp add: FactRing_def)
     then have "I = carrier R"
       using a_rcos_self one_imp_carrier by blast 
     with I_notcarr show False by simp
   qed
   have 2: "\<exists>y\<in>carrier R. I +> a \<otimes> y = I +> \<one>" if IanI: "I +> a \<noteq> I" and acarr: "a \<in> carrier R" for a
     \<comment> \<open>Existence of Inverse\<close>
   proof -
     \<comment> \<open>Helper ideal \<open>J\<close>\<close>
     define J :: "'a set" where "J = (carrier R #> a) <+> I"
     have idealJ: "ideal J R"
       using J_def acarr add_ideals cgenideal_eq_rcos cgenideal_ideal is_ideal by auto
     have IinJ: "I \<subseteq> J"
     proof (clarsimp simp: J_def r_coset_def set_add_defs)
       fix x
       assume xI: "x \<in> I"
       have "x = \<zero> \<otimes> a \<oplus> x"
         by (simp add: acarr xI)
       with xI show "\<exists>xa\<in>carrier R. \<exists>k\<in>I. x = xa \<otimes> a \<oplus> k" by fast
     qed
     have JnI: "J \<noteq> I" 
     proof -
       have "a \<notin> I"
         using IanI a_rcos_const by blast
       moreover have "a \<in> J"
       proof (simp add: J_def r_coset_def set_add_defs)
         from acarr
         have "a = \<one> \<otimes> a \<oplus> \<zero>" by algebra
         with one_closed and additive_subgroup.zero_closed[OF is_additive_subgroup]
         show "\<exists>x\<in>carrier R. \<exists>k\<in>I. a = x \<otimes> a \<oplus> k" by fast
       qed
       ultimately show ?thesis by blast
     qed
     then have Jcarr: "J = carrier R"
       using I_maximal IinJ additive_subgroup.a_subset idealJ ideal_def by blast
 
     \<comment> \<open>Calculating an inverse for \<^term>\<open>a\<close>\<close>
     from one_closed[folded Jcarr]
     obtain r i where rcarr: "r \<in> carrier R"
       and iI: "i \<in> I" and one: "\<one> = r \<otimes> a \<oplus> i" 
       by (auto simp add: J_def r_coset_def set_add_defs)
 
     from one and rcarr and acarr and iI[THEN a_Hcarr]
     have rai1: "a \<otimes> r = \<ominus>i \<oplus> \<one>" by algebra
 
     \<comment> \<open>Lifting to cosets\<close>
     from iI have "\<ominus>i \<oplus> \<one> \<in> I +> \<one>"
       by (intro a_rcosI, simp, intro a_subset, simp)
     with rai1 have "a \<otimes> r \<in> I +> \<one>" by simp
     then have "I +> \<one> = I +> a \<otimes> r"
       by (rule a_repr_independence, simp) (rule a_subgroup)
 
     from rcarr and this[symmetric]
     show "\<exists>r\<in>carrier R. I +> a \<otimes> r = I +> \<one>" by fast
   qed
   show ?thesis
     apply (intro cring.cring_fieldI2 quotient_is_cring is_cring 1)
      apply (clarsimp simp add: FactRing_simps rcoset_mult_add 2)
     done
 qed
 
 
 lemma (in ring_hom_ring) trivial_hom_iff:
   "(h ` (carrier R) = { \<zero>\<^bsub>S\<^esub> }) = (a_kernel R S h = carrier R)"
   using group_hom.trivial_hom_iff[OF a_group_hom] by (simp add: a_kernel_def)
 
 lemma (in ring_hom_ring) trivial_ker_imp_inj:
   assumes "a_kernel R S h = { \<zero> }"
   shows "inj_on h (carrier R)"
   using group_hom.trivial_ker_imp_inj[OF a_group_hom] assms a_kernel_def[of R S h] by simp 
 
 (* NEW ========================================================================== *)
 lemma (in ring_hom_ring) inj_iff_trivial_ker:
   shows "inj_on h (carrier R) \<longleftrightarrow> a_kernel R S h = { \<zero> }"
   using group_hom.inj_iff_trivial_ker[OF a_group_hom] a_kernel_def[of R S h] by simp
 
 (* NEW ========================================================================== *)
 corollary ring_hom_in_hom:
   assumes "h \<in> ring_hom R S" shows "h \<in> hom R S" and "h \<in> hom (add_monoid R) (add_monoid S)"
   using assms unfolding ring_hom_def hom_def by auto 
 
 (* NEW ========================================================================== *)
 corollary set_add_hom:
   assumes "h \<in> ring_hom R S" "I \<subseteq> carrier R" and "J \<subseteq> carrier R"
   shows "h ` (I <+>\<^bsub>R\<^esub> J) = h ` I <+>\<^bsub>S\<^esub> h ` J"
   using set_mult_hom[OF ring_hom_in_hom(2)[OF assms(1)]] assms(2-3)
   unfolding a_kernel_def[of R S h] set_add_def by simp
 
 (* NEW ========================================================================== *)
 corollary a_coset_hom:
   assumes "h \<in> ring_hom R S" "I \<subseteq> carrier R" "a \<in> carrier R"
   shows "h ` (a <+\<^bsub>R\<^esub> I) = h a <+\<^bsub>S\<^esub> (h ` I)" and "h ` (I +>\<^bsub>R\<^esub> a) = (h ` I) +>\<^bsub>S\<^esub> h a"
   using assms coset_hom[OF ring_hom_in_hom(2)[OF assms(1)], of I a]
   unfolding a_l_coset_def l_coset_eq_set_mult
             a_r_coset_def r_coset_eq_set_mult
   by simp_all
 
 (* NEW ========================================================================== *)
 corollary (in ring_hom_ring) set_add_ker_hom:
   assumes "I \<subseteq> carrier R"
   shows "h ` (I <+> (a_kernel R S h)) = h ` I" and "h ` ((a_kernel R S h) <+> I) = h ` I"
   using group_hom.set_mult_ker_hom[OF a_group_hom] assms
   unfolding a_kernel_def[of R S h] set_add_def by simp+
 
 lemma (in ring_hom_ring) non_trivial_field_hom_imp_inj:
   assumes "field R"
   shows "h ` (carrier R) \<noteq> { \<zero>\<^bsub>S\<^esub> } \<Longrightarrow> inj_on h (carrier R)"
 proof -
   assume "h ` (carrier R) \<noteq> { \<zero>\<^bsub>S\<^esub> }"
   hence "a_kernel R S h \<noteq> carrier R"
     using trivial_hom_iff by linarith
   hence "a_kernel R S h = { \<zero> }"
     using field.all_ideals[OF assms] kernel_is_ideal by blast
   thus "inj_on h (carrier R)"
     using trivial_ker_imp_inj by blast
 qed
 lemma "field R \<Longrightarrow> cring R"
   using fieldE(1) by blast
 
 lemma non_trivial_field_hom_is_inj:
   assumes "h \<in> ring_hom R S" and "field R" and "field S" shows "inj_on h (carrier R)"
 proof -
   interpret ring_hom_cring R S h
     using assms(1) ring_hom_cring.intro[OF assms(2-3)[THEN fieldE(1)]]
     unfolding symmetric[OF ring_hom_cring_axioms_def] by simp
 
   have "h \<one>\<^bsub>R\<^esub> = \<one>\<^bsub>S\<^esub>" and "\<one>\<^bsub>S\<^esub> \<noteq> \<zero>\<^bsub>S\<^esub>"
     using domain.one_not_zero[OF field.axioms(1)[OF assms(3)]] by auto 
   hence "h ` (carrier R) \<noteq> { \<zero>\<^bsub>S\<^esub> }"
     using ring.kernel_zero ring.trivial_hom_iff by fastforce
   thus ?thesis
     using ring.non_trivial_field_hom_imp_inj[OF assms(2)] by simp
 qed    
 
 lemma (in ring_hom_ring) img_is_add_subgroup:
   assumes "subgroup H (add_monoid R)"
   shows "subgroup (h ` H) (add_monoid S)"
 proof -
   have "group ((add_monoid R) \<lparr> carrier := H \<rparr>)"
     using assms R.add.subgroup_imp_group by blast
   moreover have "H \<subseteq> carrier R" by (simp add: R.add.subgroupE(1) assms)
   hence "h \<in> hom ((add_monoid R) \<lparr> carrier := H \<rparr>) (add_monoid S)"
     unfolding hom_def by (auto simp add: subsetD)
   ultimately have "subgroup (h ` carrier ((add_monoid R) \<lparr> carrier := H \<rparr>)) (add_monoid S)"
     using group_hom.img_is_subgroup[of "(add_monoid R) \<lparr> carrier := H \<rparr>" "add_monoid S" h]
     using a_group_hom group_hom_axioms.intro group_hom_def by blast
   thus "subgroup (h ` H) (add_monoid S)" by simp
 qed
 
 lemma (in ring) ring_ideal_imp_quot_ideal:
   assumes "ideal I R"
   shows "ideal J R \<Longrightarrow> ideal ((+>) I ` J) (R Quot I)"
 proof -
   assume A: "ideal J R" show "ideal (((+>) I) ` J) (R Quot I)"
   proof (rule idealI)
     show "ring (R Quot I)"
       by (simp add: assms(1) ideal.quotient_is_ring) 
   next
     have "subgroup J (add_monoid R)"
       by (simp add: additive_subgroup.a_subgroup A ideal.axioms(1))
     moreover have "((+>) I) \<in> ring_hom R (R Quot I)"
       by (simp add: assms(1) ideal.rcos_ring_hom)
     ultimately show "subgroup ((+>) I ` J) (add_monoid (R Quot I))"
       using assms(1) ideal.rcos_ring_hom_ring ring_hom_ring.img_is_add_subgroup by blast
   next
     fix a x assume "a \<in> (+>) I ` J" "x \<in> carrier (R Quot I)"
     then obtain i j where i: "i \<in> carrier R" "x = I +> i"
                       and j: "j \<in> J" "a = I +> j"
       unfolding FactRing_def using A_RCOSETS_def'[of R I] by auto
     hence "a \<otimes>\<^bsub>R Quot I\<^esub> x = [mod I:] (I +> j) \<Otimes> (I +> i)"
       unfolding FactRing_def by simp
     hence "a \<otimes>\<^bsub>R Quot I\<^esub> x = I +> (j \<otimes> i)"
       using ideal.rcoset_mult_add[OF assms(1), of j i] i(1) j(1) A ideal.Icarr by force
     thus "a \<otimes>\<^bsub>R Quot I\<^esub> x \<in> (+>) I ` J"
       using A i(1) j(1) by (simp add: ideal.I_r_closed)
   
     have "x \<otimes>\<^bsub>R Quot I\<^esub> a = [mod I:] (I +> i) \<Otimes> (I +> j)"
       unfolding FactRing_def i j by simp
     hence "x \<otimes>\<^bsub>R Quot I\<^esub> a = I +> (i \<otimes> j)"
       using ideal.rcoset_mult_add[OF assms(1), of i j] i(1) j(1) A ideal.Icarr by force
     thus "x \<otimes>\<^bsub>R Quot I\<^esub> a \<in> (+>) I ` J"
       using A i(1) j(1) by (simp add: ideal.I_l_closed)
   qed
 qed
 
 lemma (in ring_hom_ring) ideal_vimage:
   assumes "ideal I S"
   shows "ideal { r \<in> carrier R. h r \<in> I } R" (* or (carrier R) \<inter> (h -` I) *)
 proof
   show "{ r \<in> carrier R. h r \<in> I } \<subseteq> carrier (add_monoid R)" by auto
 next
   show "\<one>\<^bsub>add_monoid R\<^esub> \<in> { r \<in> carrier R. h r \<in> I }"
     by (simp add: additive_subgroup.zero_closed assms ideal.axioms(1))
 next
   fix a b
   assume "a \<in> { r \<in> carrier R. h r \<in> I }"
      and "b \<in> { r \<in> carrier R. h r \<in> I }"
   hence a: "a \<in> carrier R" "h a \<in> I"
     and b: "b \<in> carrier R" "h b \<in> I" by auto
   hence "h (a \<oplus> b) = (h a) \<oplus>\<^bsub>S\<^esub> (h b)" using hom_add by blast
   moreover have "(h a) \<oplus>\<^bsub>S\<^esub> (h b) \<in> I" using a b assms
     by (simp add: additive_subgroup.a_closed ideal.axioms(1))
   ultimately show "a \<otimes>\<^bsub>add_monoid R\<^esub> b \<in> { r \<in> carrier R. h r \<in> I }"
     using a(1) b (1) by auto
 
   have "h (\<ominus> a) = \<ominus>\<^bsub>S\<^esub> (h a)" by (simp add: a)
   moreover have "\<ominus>\<^bsub>S\<^esub> (h a) \<in> I"
     by (simp add: a(2) additive_subgroup.a_inv_closed assms ideal.axioms(1))
   ultimately show "inv\<^bsub>add_monoid R\<^esub> a \<in> { r \<in> carrier R. h r \<in> I }"
     using a by (simp add: a_inv_def)
 next
   fix a r
   assume "a \<in> { r \<in> carrier R. h r \<in> I }" and r: "r \<in> carrier R"
   hence a: "a \<in> carrier R" "h a \<in> I" by auto
 
   have "h a \<otimes>\<^bsub>S\<^esub> h r \<in> I"
     using assms a r by (simp add: ideal.I_r_closed)
   thus "a \<otimes> r \<in> { r \<in> carrier R. h r \<in> I }" by (simp add: a(1) r)
 
   have "h r \<otimes>\<^bsub>S\<^esub> h a \<in> I"
     using assms a r by (simp add: ideal.I_l_closed)
   thus "r \<otimes> a \<in> { r \<in> carrier R. h r \<in> I }" by (simp add: a(1) r)
 qed
 
 lemma (in ring) canonical_proj_vimage_in_carrier:
   assumes "ideal I R"
   shows "J \<subseteq> carrier (R Quot I) \<Longrightarrow> \<Union> J \<subseteq> carrier R"
 proof -
   assume A: "J \<subseteq> carrier (R Quot I)" show "\<Union> J \<subseteq> carrier R"
   proof
     fix j assume j: "j \<in> \<Union> J"
     then obtain j' where j': "j' \<in> J" "j \<in> j'" by blast
     then obtain r where r: "r \<in> carrier R" "j' = I +> r"
       using A j' unfolding FactRing_def using A_RCOSETS_def'[of R I] by auto
     thus "j \<in> carrier R" using j' assms
       by (meson a_r_coset_subset_G additive_subgroup.a_subset contra_subsetD ideal.axioms(1)) 
   qed
 qed
 
 lemma (in ring) canonical_proj_vimage_mem_iff:
   assumes "ideal I R" "J \<subseteq> carrier (R Quot I)"
   shows "\<And>a. a \<in> carrier R \<Longrightarrow> (a \<in> (\<Union> J)) = (I +> a \<in> J)"
 proof -
   fix a assume a: "a \<in> carrier R" show "(a \<in> (\<Union> J)) = (I +> a \<in> J)"
   proof
     assume "a \<in> \<Union> J"
     then obtain j where j: "j \<in> J" "a \<in> j" by blast
     then obtain r where r: "r \<in> carrier R" "j = I +> r"
       using assms j unfolding FactRing_def using A_RCOSETS_def'[of R I] by auto
     hence "I +> r = I +> a"
       using add.repr_independence[of a I r] j r
       by (metis a_r_coset_def additive_subgroup.a_subgroup assms(1) ideal.axioms(1))
     thus "I +> a \<in> J" using r j by simp
   next
     assume "I +> a \<in> J"
     hence "\<zero> \<oplus> a \<in> I +> a"
       using additive_subgroup.zero_closed[OF ideal.axioms(1)[OF assms(1)]]
             a_r_coset_def'[of R I a] by blast
     thus "a \<in> \<Union> J" using a \<open>I +> a \<in> J\<close> by auto 
   qed
 qed
 
 corollary (in ring) quot_ideal_imp_ring_ideal:
   assumes "ideal I R"
   shows "ideal J (R Quot I) \<Longrightarrow> ideal (\<Union> J) R"
 proof -
   assume A: "ideal J (R Quot I)"
   have "\<Union> J = { r \<in> carrier R. I +> r \<in> J }"
     using canonical_proj_vimage_in_carrier[OF assms, of J]
           canonical_proj_vimage_mem_iff[OF assms, of J]
           additive_subgroup.a_subset[OF ideal.axioms(1)[OF A]] by blast
   thus "ideal (\<Union> J) R"
     using ring_hom_ring.ideal_vimage[OF ideal.rcos_ring_hom_ring[OF assms] A] by simp
 qed
 
 lemma (in ring) ideal_incl_iff:
   assumes "ideal I R" "ideal J R"
   shows "(I \<subseteq> J) = (J = (\<Union> j \<in> J. I +> j))"
 proof
   assume A: "J = (\<Union> j \<in> J. I +> j)" hence "I +> \<zero> \<subseteq> J"
     using additive_subgroup.zero_closed[OF ideal.axioms(1)[OF assms(2)]] by blast
   thus "I \<subseteq> J" using additive_subgroup.a_subset[OF ideal.axioms(1)[OF assms(1)]] by simp 
 next
   assume A: "I \<subseteq> J" show "J = (\<Union>j\<in>J. I +> j)"
   proof
     show "J \<subseteq> (\<Union> j \<in> J. I +> j)"
     proof
       fix j assume j: "j \<in> J"
       have "\<zero> \<in> I" by (simp add: additive_subgroup.zero_closed assms(1) ideal.axioms(1))
       hence "\<zero> \<oplus> j \<in> I +> j"
         using a_r_coset_def'[of R I j] by blast
       thus "j \<in> (\<Union>j\<in>J. I +> j)"
         using assms(2) j additive_subgroup.a_Hcarr ideal.axioms(1) by fastforce 
     qed
   next
     show "(\<Union> j \<in> J. I +> j) \<subseteq> J"
     proof
       fix x assume "x \<in> (\<Union> j \<in> J. I +> j)"
       then obtain j where j: "j \<in> J" "x \<in> I +> j" by blast
       then obtain i where i: "i \<in> I" "x = i \<oplus> j"
         using a_r_coset_def'[of R I j] by blast
       thus "x \<in> J"
         using assms(2) j A additive_subgroup.a_closed[OF ideal.axioms(1)[OF assms(2)]] by blast
     qed
   qed
 qed
 
 theorem (in ring) quot_ideal_correspondence:
   assumes "ideal I R"
   shows "bij_betw (\<lambda>J. (+>) I ` J) { J. ideal J R \<and> I \<subseteq> J } { J . ideal J (R Quot I) }"
 proof (rule bij_betw_byWitness[where ?f' = "\<lambda>X. \<Union> X"])
   show "\<forall>J \<in> { J. ideal J R \<and> I \<subseteq> J }. (\<lambda>X. \<Union> X) ((+>) I ` J) = J"
     using assms ideal_incl_iff by blast
 next
   show "(\<lambda>J. (+>) I ` J) ` { J. ideal J R \<and> I \<subseteq> J } \<subseteq> { J. ideal J (R Quot I) }"
     using assms ring_ideal_imp_quot_ideal by auto
 next
   show "(\<lambda>X. \<Union> X) ` { J. ideal J (R Quot I) } \<subseteq> { J. ideal J R \<and> I \<subseteq> J }"
   proof
     fix J assume "J \<in> ((\<lambda>X. \<Union> X) ` { J. ideal J (R Quot I) })"
     then obtain J' where J': "ideal J' (R Quot I)" "J = \<Union> J'" by blast
     hence "ideal J R"
       using assms quot_ideal_imp_ring_ideal by auto
     moreover have "I \<in> J'"
       using additive_subgroup.zero_closed[OF ideal.axioms(1)[OF J'(1)]] unfolding FactRing_def by simp
     ultimately show "J \<in> { J. ideal J R \<and> I \<subseteq> J }" using J'(2) by auto
   qed
 next
   show "\<forall>J' \<in> { J. ideal J (R Quot I) }. ((+>) I ` (\<Union> J')) = J'"
   proof
     fix J' assume "J' \<in> { J. ideal J (R Quot I) }"
     hence subset: "J' \<subseteq> carrier (R Quot I) \<and> ideal J' (R Quot I)"
       using additive_subgroup.a_subset ideal_def by blast
     hence "((+>) I ` (\<Union> J')) \<subseteq> J'"
       using canonical_proj_vimage_in_carrier canonical_proj_vimage_mem_iff
       by (meson assms contra_subsetD image_subsetI)
     moreover have "J' \<subseteq> ((+>) I ` (\<Union> J'))"
     proof
       fix x assume "x \<in> J'"
       then obtain r where r: "r \<in> carrier R" "x = I +> r"
         using subset unfolding FactRing_def A_RCOSETS_def'[of R I] by auto
       hence "r \<in> (\<Union> J')"
         using \<open>x \<in> J'\<close> assms canonical_proj_vimage_mem_iff subset by blast
       thus "x \<in> ((+>) I ` (\<Union> J'))" using r(2) by blast
     qed
     ultimately show "((+>) I ` (\<Union> J')) = J'" by blast
   qed
 qed
 
 lemma (in cring) quot_domain_imp_primeideal:
   assumes "ideal P R"
   shows "domain (R Quot P) \<Longrightarrow> primeideal P R"
 proof -
   assume A: "domain (R Quot P)" show "primeideal P R"
   proof (rule primeidealI)
     show "ideal P R" using assms .
     show "cring R" using is_cring .
   next
     show "carrier R \<noteq> P"
     proof (rule ccontr)
       assume "\<not> carrier R \<noteq> P" hence "carrier R = P" by simp
       hence "\<And>I. I \<in> carrier (R Quot P) \<Longrightarrow> I = P"
         unfolding FactRing_def A_RCOSETS_def' apply simp
         using a_coset_join2 additive_subgroup.a_subgroup assms ideal.axioms(1) by blast
       hence "\<one>\<^bsub>(R Quot P)\<^esub> = \<zero>\<^bsub>(R Quot P)\<^esub>"
         by (metis assms ideal.quotient_is_ring ring.ring_simprules(2) ring.ring_simprules(6))
       thus False using domain.one_not_zero[OF A] by simp
     qed
   next
     fix a b assume a: "a \<in> carrier R" and b: "b \<in> carrier R" and ab: "a \<otimes> b \<in> P"
     hence "P +> (a \<otimes> b) = \<zero>\<^bsub>(R Quot P)\<^esub>" unfolding FactRing_def
       by (simp add: a_coset_join2 additive_subgroup.a_subgroup assms ideal.axioms(1))
     moreover have "(P +> a) \<otimes>\<^bsub>(R Quot P)\<^esub> (P +> b) = P +> (a \<otimes> b)" unfolding FactRing_def
       using a b by (simp add: assms ideal.rcoset_mult_add)
     moreover have "P +> a \<in> carrier (R Quot P) \<and> P +> b \<in> carrier (R Quot P)"
       by (simp add: a b FactRing_def a_rcosetsI additive_subgroup.a_subset assms ideal.axioms(1))
     ultimately have "P +> a = \<zero>\<^bsub>(R Quot P)\<^esub> \<or> P +> b = \<zero>\<^bsub>(R Quot P)\<^esub>"
       using domain.integral[OF A, of "P +> a" "P +> b"] by auto
     thus "a \<in> P \<or> b \<in> P" unfolding FactRing_def apply simp
       using a b assms a_coset_join1 additive_subgroup.a_subgroup ideal.axioms(1) by blast
   qed
 qed
 
 lemma (in cring) quot_domain_iff_primeideal:
   assumes "ideal P R"
   shows "domain (R Quot P) = primeideal P R"
   using quot_domain_imp_primeideal[OF assms] primeideal.quotient_is_domain[of P R] by auto
 
 
 subsection \<open>Isomorphism\<close>
 
 definition
   ring_iso :: "_ \<Rightarrow> _ \<Rightarrow> ('a \<Rightarrow> 'b) set"
   where "ring_iso R S = { h. h \<in> ring_hom R S \<and> bij_betw h (carrier R) (carrier S) }"
 
 definition
   is_ring_iso :: "_ \<Rightarrow> _ \<Rightarrow> bool" (infixr "\<simeq>" 60)
   where "R \<simeq> S = (ring_iso R S \<noteq> {})"
 
 definition
   morphic_prop :: "_ \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> bool"
   where "morphic_prop R P =
            ((P \<one>\<^bsub>R\<^esub>) \<and>
             (\<forall>r \<in> carrier R. P r) \<and>
             (\<forall>r1 \<in> carrier R. \<forall>r2 \<in> carrier R. P (r1 \<otimes>\<^bsub>R\<^esub> r2)) \<and>
             (\<forall>r1 \<in> carrier R. \<forall>r2 \<in> carrier R. P (r1 \<oplus>\<^bsub>R\<^esub> r2)))"
 
 lemma ring_iso_memI:
   fixes R (structure) and S (structure)
   assumes "\<And>x. x \<in> carrier R \<Longrightarrow> h x \<in> carrier S"
       and "\<And>x y. \<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> h (x \<otimes> y) = h x \<otimes>\<^bsub>S\<^esub> h y"
       and "\<And>x y. \<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> h (x \<oplus> y) = h x \<oplus>\<^bsub>S\<^esub> h y"
       and "h \<one> = \<one>\<^bsub>S\<^esub>"
       and "bij_betw h (carrier R) (carrier S)"
   shows "h \<in> ring_iso R S"
   by (auto simp add: ring_hom_memI assms ring_iso_def)
 
 lemma ring_iso_memE:
   fixes R (structure) and S (structure)
   assumes "h \<in> ring_iso R S"
   shows "\<And>x. x \<in> carrier R \<Longrightarrow> h x \<in> carrier S"
    and "\<And>x y. \<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> h (x \<otimes> y) = h x \<otimes>\<^bsub>S\<^esub> h y"
    and "\<And>x y. \<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> h (x \<oplus> y) = h x \<oplus>\<^bsub>S\<^esub> h y"
    and "h \<one> = \<one>\<^bsub>S\<^esub>"
    and "bij_betw h (carrier R) (carrier S)"
   using assms unfolding ring_iso_def ring_hom_def by auto
 
 lemma morphic_propI:
   fixes R (structure)
   assumes "P \<one>"
     and "\<And>r. r \<in> carrier R \<Longrightarrow> P r"
     and "\<And>r1 r2. \<lbrakk> r1 \<in> carrier R; r2 \<in> carrier R \<rbrakk> \<Longrightarrow> P (r1 \<otimes> r2)"
     and "\<And>r1 r2. \<lbrakk> r1 \<in> carrier R; r2 \<in> carrier R \<rbrakk> \<Longrightarrow> P (r1 \<oplus> r2)"
   shows "morphic_prop R P"
   unfolding morphic_prop_def using assms by auto
 
 lemma morphic_propE:
   fixes R (structure)
   assumes "morphic_prop R P"
   shows "P \<one>"
     and "\<And>r. r \<in> carrier R \<Longrightarrow> P r"
     and "\<And>r1 r2. \<lbrakk> r1 \<in> carrier R; r2 \<in> carrier R \<rbrakk> \<Longrightarrow> P (r1 \<otimes> r2)"
     and "\<And>r1 r2. \<lbrakk> r1 \<in> carrier R; r2 \<in> carrier R \<rbrakk> \<Longrightarrow> P (r1 \<oplus> r2)"
   using assms unfolding morphic_prop_def by auto
 
 (* NEW ============================================================================ *)
 lemma (in ring) ring_hom_restrict:
   assumes "f \<in> ring_hom R S" and "\<And>r. r \<in> carrier R \<Longrightarrow> f r = g r" shows "g \<in> ring_hom R S"
   using assms(2) ring_hom_memE[OF assms(1)] by (auto intro: ring_hom_memI)
 
 (* PROOF ========================================================================== *)
 lemma (in ring) ring_iso_restrict:
   assumes "f \<in> ring_iso R S" and "\<And>r. r \<in> carrier R \<Longrightarrow> f r = g r" shows "g \<in> ring_iso R S"
 proof -
   have hom: "g \<in> ring_hom R S"
     using ring_hom_restrict assms unfolding ring_iso_def by auto 
   have "bij_betw g (carrier R) (carrier S)"
     using bij_betw_cong[of "carrier R" f g] ring_iso_memE(5)[OF assms(1)] assms(2) by simp
   thus ?thesis
     using ring_hom_memE[OF hom] by (auto intro!: ring_iso_memI)
 qed
 
 lemma ring_iso_morphic_prop:
   assumes "f \<in> ring_iso R S"
     and "morphic_prop R P"
     and "\<And>r. P r \<Longrightarrow> f r = g r"
   shows "g \<in> ring_iso R S"
 proof -
   have eq0: "\<And>r. r \<in> carrier R \<Longrightarrow> f r = g r"
    and eq1: "f \<one>\<^bsub>R\<^esub> = g \<one>\<^bsub>R\<^esub>"
    and eq2: "\<And>r1 r2. \<lbrakk> r1 \<in> carrier R; r2 \<in> carrier R \<rbrakk> \<Longrightarrow> f (r1 \<otimes>\<^bsub>R\<^esub> r2) = g (r1 \<otimes>\<^bsub>R\<^esub> r2)"
    and eq3: "\<And>r1 r2. \<lbrakk> r1 \<in> carrier R; r2 \<in> carrier R \<rbrakk> \<Longrightarrow> f (r1 \<oplus>\<^bsub>R\<^esub> r2) = g (r1 \<oplus>\<^bsub>R\<^esub> r2)"
     using assms(2-3) unfolding morphic_prop_def by auto
   show ?thesis
     apply (rule ring_iso_memI)
     using assms(1) eq0 ring_iso_memE(1) apply fastforce
     apply (metis assms(1) eq0 eq2 ring_iso_memE(2))
     apply (metis assms(1) eq0 eq3 ring_iso_memE(3))
     using assms(1) eq1 ring_iso_memE(4) apply fastforce
     using assms(1) bij_betw_cong eq0 ring_iso_memE(5) by blast
 qed
 
 lemma (in ring) ring_hom_imp_img_ring:
   assumes "h \<in> ring_hom R S"
   shows "ring (S \<lparr> carrier := h ` (carrier R), zero := h \<zero> \<rparr>)" (is "ring ?h_img")
 proof -
   have "h \<in> hom (add_monoid R) (add_monoid S)"
     using assms unfolding hom_def ring_hom_def by auto
   hence "comm_group ((add_monoid S) \<lparr>  carrier := h ` (carrier R), one := h \<zero> \<rparr>)"
     using add.hom_imp_img_comm_group[of h "add_monoid S"] by simp
   hence comm_group: "comm_group (add_monoid ?h_img)"
     by (auto intro: comm_monoidI simp add: monoid.defs)
 
   moreover have "h \<in> hom R S"
     using assms unfolding ring_hom_def hom_def by auto
   hence "monoid (S \<lparr>  carrier := h ` (carrier R), one := h \<one> \<rparr>)"
     using hom_imp_img_monoid[of h S] by simp
   hence monoid: "monoid ?h_img"
     using ring_hom_memE(4)[OF assms] unfolding monoid_def by (simp add: monoid.defs)
   show ?thesis
   proof (rule ringI, simp_all add: comm_group_abelian_groupI[OF comm_group] monoid)
     fix x y z assume "x \<in> h ` carrier R" "y \<in> h ` carrier R" "z \<in> h ` carrier R"
     then obtain r1 r2 r3
       where r1: "r1 \<in> carrier R" "x = h r1"
         and r2: "r2 \<in> carrier R" "y = h r2"
         and r3: "r3 \<in> carrier R" "z = h r3" by blast
     hence "(x \<oplus>\<^bsub>S\<^esub> y) \<otimes>\<^bsub>S\<^esub> z = h ((r1 \<oplus> r2) \<otimes> r3)"
       using ring_hom_memE[OF assms] by auto
     also have " ... = h ((r1 \<otimes> r3) \<oplus> (r2 \<otimes> r3))"
       using l_distr[OF r1(1) r2(1) r3(1)] by simp
     also have " ... = (x \<otimes>\<^bsub>S\<^esub> z) \<oplus>\<^bsub>S\<^esub> (y \<otimes>\<^bsub>S\<^esub> z)"
       using ring_hom_memE[OF assms] r1 r2 r3 by auto
     finally show "(x \<oplus>\<^bsub>S\<^esub> y) \<otimes>\<^bsub>S\<^esub> z = (x \<otimes>\<^bsub>S\<^esub> z) \<oplus>\<^bsub>S\<^esub> (y \<otimes>\<^bsub>S\<^esub> z)" .
 
     have "z \<otimes>\<^bsub>S\<^esub> (x \<oplus>\<^bsub>S\<^esub> y) = h (r3 \<otimes> (r1 \<oplus> r2))"
       using ring_hom_memE[OF assms] r1 r2 r3 by auto
     also have " ... =  h ((r3 \<otimes> r1) \<oplus> (r3 \<otimes> r2))"
       using r_distr[OF r1(1) r2(1) r3(1)] by simp
     also have " ... = (z \<otimes>\<^bsub>S\<^esub> x) \<oplus>\<^bsub>S\<^esub> (z \<otimes>\<^bsub>S\<^esub> y)"
       using ring_hom_memE[OF assms] r1 r2 r3 by auto
     finally show "z \<otimes>\<^bsub>S\<^esub> (x \<oplus>\<^bsub>S\<^esub> y) = (z \<otimes>\<^bsub>S\<^esub> x) \<oplus>\<^bsub>S\<^esub> (z \<otimes>\<^bsub>S\<^esub> y)" .
   qed
 qed
 
 lemma (in ring) ring_iso_imp_img_ring:
   assumes "h \<in> ring_iso R S"
   shows "ring (S \<lparr> zero := h \<zero> \<rparr>)"
 proof -
   have "ring (S \<lparr> carrier := h ` (carrier R), zero := h \<zero> \<rparr>)"
     using ring_hom_imp_img_ring[of h S] assms unfolding ring_iso_def by auto
   moreover have "h ` (carrier R) = carrier S"
     using assms unfolding ring_iso_def bij_betw_def by auto
   ultimately show ?thesis by simp
 qed
 
 lemma (in cring) ring_iso_imp_img_cring:
   assumes "h \<in> ring_iso R S"
   shows "cring (S \<lparr> zero := h \<zero> \<rparr>)" (is "cring ?h_img")
 proof -
   note m_comm
   interpret h_img?: ring ?h_img
     using ring_iso_imp_img_ring[OF assms] .
   show ?thesis 
   proof (unfold_locales)
     fix x y assume "x \<in> carrier ?h_img" "y \<in> carrier ?h_img"
     then obtain r1 r2
       where r1: "r1 \<in> carrier R" "x = h r1"
         and r2: "r2 \<in> carrier R" "y = h r2"
       using assms image_iff[where ?f = h and ?A = "carrier R"]
       unfolding ring_iso_def bij_betw_def by auto
     have "x \<otimes>\<^bsub>(?h_img)\<^esub> y = h (r1 \<otimes> r2)"
       using assms r1 r2 unfolding ring_iso_def ring_hom_def by auto
     also have " ... = h (r2 \<otimes> r1)"
       using m_comm[OF r1(1) r2(1)] by simp
     also have " ... = y \<otimes>\<^bsub>(?h_img)\<^esub> x"
       using assms r1 r2 unfolding ring_iso_def ring_hom_def by auto
     finally show "x \<otimes>\<^bsub>(?h_img)\<^esub> y = y \<otimes>\<^bsub>(?h_img)\<^esub> x" .
   qed
 qed
 
 lemma (in domain) ring_iso_imp_img_domain:
   assumes "h \<in> ring_iso R S"
   shows "domain (S \<lparr> zero := h \<zero> \<rparr>)" (is "domain ?h_img")
 proof -
   note aux = m_closed integral one_not_zero one_closed zero_closed
   interpret h_img?: cring ?h_img
     using ring_iso_imp_img_cring[OF assms] .
   show ?thesis 
   proof (unfold_locales)
     have "\<one>\<^bsub>?h_img\<^esub> = \<zero>\<^bsub>?h_img\<^esub> \<Longrightarrow> h \<one> = h \<zero>"
       using ring_iso_memE(4)[OF assms] by simp
     moreover have "h \<one> \<noteq> h \<zero>"
       using ring_iso_memE(5)[OF assms] aux(3-4)
       unfolding bij_betw_def inj_on_def by force
     ultimately show "\<one>\<^bsub>?h_img\<^esub> \<noteq> \<zero>\<^bsub>?h_img\<^esub>"
       by auto
   next
     fix a b
     assume A: "a \<otimes>\<^bsub>?h_img\<^esub> b = \<zero>\<^bsub>?h_img\<^esub>" "a \<in> carrier ?h_img" "b \<in> carrier ?h_img"
     then obtain r1 r2
       where r1: "r1 \<in> carrier R" "a = h r1"
         and r2: "r2 \<in> carrier R" "b = h r2"
       using assms image_iff[where ?f = h and ?A = "carrier R"]
       unfolding ring_iso_def bij_betw_def by auto
     hence "a \<otimes>\<^bsub>?h_img\<^esub> b = h (r1 \<otimes> r2)"
       using assms r1 r2 unfolding ring_iso_def ring_hom_def by auto
     hence "h (r1 \<otimes> r2) = h \<zero>"
       using A(1) by simp
     hence "r1 \<otimes> r2 = \<zero>"
       using ring_iso_memE(5)[OF assms] aux(1)[OF r1(1) r2(1)] aux(5)
       unfolding bij_betw_def inj_on_def by force
     hence "r1 = \<zero> \<or> r2 = \<zero>"
       using aux(2)[OF _ r1(1) r2(1)] by simp
     thus "a = \<zero>\<^bsub>?h_img\<^esub> \<or> b = \<zero>\<^bsub>?h_img\<^esub>"
       unfolding r1 r2 by auto
   qed
 qed
 
 lemma (in field) ring_iso_imp_img_field:
   assumes "h \<in> ring_iso R S"
   shows "field (S \<lparr> zero := h \<zero> \<rparr>)" (is "field ?h_img")
 proof -
   interpret h_img?: domain ?h_img
     using ring_iso_imp_img_domain[OF assms] .
   show ?thesis
   proof (unfold_locales, auto simp add: Units_def)
     interpret field R using field_axioms .
     fix a assume a: "a \<in> carrier S" "a \<otimes>\<^bsub>S\<^esub> h \<zero> = \<one>\<^bsub>S\<^esub>"
     then obtain r where r: "r \<in> carrier R" "a = h r"
       using assms image_iff[where ?f = h and ?A = "carrier R"]
       unfolding ring_iso_def bij_betw_def by auto
     have "a \<otimes>\<^bsub>S\<^esub> h \<zero> = h (r \<otimes> \<zero>)" unfolding r(2)
       using ring_iso_memE(2)[OF assms r(1)] by simp
     hence "h \<one> = h \<zero>"
       using ring_iso_memE(4)[OF assms] r(1) a(2) by simp
     thus False
       using ring_iso_memE(5)[OF assms]
       unfolding bij_betw_def inj_on_def by force
   next
     interpret field R using field_axioms .
     fix s assume s: "s \<in> carrier S" "s \<noteq> h \<zero>"
     then obtain r where r: "r \<in> carrier R" "s = h r"
       using assms image_iff[where ?f = h and ?A = "carrier R"]
       unfolding ring_iso_def bij_betw_def by auto
     hence "r \<noteq> \<zero>" using s(2) by auto 
     hence inv_r: "inv r \<in> carrier R" "inv r \<noteq> \<zero>" "r \<otimes> inv r = \<one>" "inv r \<otimes> r = \<one>"
       using field_Units r(1) by auto
     have "h (inv r) \<otimes>\<^bsub>S\<^esub> h r = h \<one>" and "h r \<otimes>\<^bsub>S\<^esub> h (inv r) = h \<one>"
       using ring_iso_memE(2)[OF assms inv_r(1) r(1)] inv_r(3-4)
             ring_iso_memE(2)[OF assms r(1) inv_r(1)] by auto
     thus "\<exists>s' \<in> carrier S. s' \<otimes>\<^bsub>S\<^esub> s = \<one>\<^bsub>S\<^esub> \<and> s \<otimes>\<^bsub>S\<^esub> s' = \<one>\<^bsub>S\<^esub>"
       using ring_iso_memE(1,4)[OF assms] inv_r(1) r(2) by auto
   qed
 qed
 
 lemma ring_iso_same_card: "R \<simeq> S \<Longrightarrow> card (carrier R) = card (carrier S)"
   using bij_betw_same_card unfolding is_ring_iso_def ring_iso_def by auto 
 (* ========================================================================== *)
 
 lemma ring_iso_set_refl: "id \<in> ring_iso R R"
   by (rule ring_iso_memI) (auto)
 
 corollary ring_iso_refl: "R \<simeq> R"
   using is_ring_iso_def ring_iso_set_refl by auto 
 
 lemma ring_iso_set_trans:
   "\<lbrakk> f \<in> ring_iso R S; g \<in> ring_iso S Q \<rbrakk> \<Longrightarrow> (g \<circ> f) \<in> ring_iso R Q"
   unfolding ring_iso_def using bij_betw_trans ring_hom_trans by fastforce 
 
 corollary ring_iso_trans: "\<lbrakk> R \<simeq> S; S \<simeq> Q \<rbrakk> \<Longrightarrow> R \<simeq> Q"
   using ring_iso_set_trans unfolding is_ring_iso_def by blast 
 
 lemma ring_iso_set_sym:
   assumes "ring R" and h: "h \<in> ring_iso R S"
   shows "(inv_into (carrier R) h) \<in> ring_iso S R"
 proof -
   have h_hom: "h \<in> ring_hom R S"
     and h_surj: "h ` (carrier R) = (carrier S)"
     and h_inj:  "\<And> x1 x2. \<lbrakk> x1 \<in> carrier R; x2 \<in> carrier R \<rbrakk> \<Longrightarrow>  h x1 = h x2 \<Longrightarrow> x1 = x2"
     using h unfolding ring_iso_def bij_betw_def inj_on_def by auto
 
   have h_inv_bij: "bij_betw (inv_into (carrier R) h) (carrier S) (carrier R)"
-      using bij_betw_inv_into h ring_iso_def by fastforce
+    by (simp add: bij_betw_inv_into h ring_iso_memE(5))
 
-  show "inv_into (carrier R) h \<in> ring_iso S R"
-    apply (rule ring_iso_memI)
-    apply (simp add: h_surj inv_into_into)
-       apply (auto simp add: h_inv_bij)
-    using ring_iso_memE [OF h] bij_betwE [OF h_inv_bij] 
-    apply (simp_all add: \<open>ring R\<close> bij_betw_def bij_betw_inv_into_right inv_into_f_eq ring.ring_simprules(5))
-    using ring_iso_memE [OF h] bij_betw_inv_into_right [of h "carrier R" "carrier S"]
-    apply (simp add: \<open>ring R\<close> inv_into_f_eq ring.ring_simprules(1))
-    by (simp add: \<open>ring R\<close> inv_into_f_eq ring.ring_simprules(6))
+  have "inv_into (carrier R) h \<in> ring_hom S R"
+    using ring_iso_memE [OF h] bij_betwE [OF h_inv_bij] \<open>ring R\<close>
+    by (simp add: bij_betw_imp_inj_on bij_betw_inv_into_right inv_into_f_eq ring.ring_simprules ring_hom_memI)
+  moreover have "bij_betw (inv_into (carrier R) h) (carrier S) (carrier R)"
+    using h_inv_bij by force
+    ultimately show "inv_into (carrier R) h \<in> ring_iso S R"
+      by (simp add: ring_iso_def)
 qed
 
 corollary ring_iso_sym:
   assumes "ring R"
   shows "R \<simeq> S \<Longrightarrow> S \<simeq> R"
   using assms ring_iso_set_sym unfolding is_ring_iso_def by auto 
 
 lemma (in ring_hom_ring) the_elem_simp [simp]:
   "\<And>x. x \<in> carrier R \<Longrightarrow> the_elem (h ` ((a_kernel R S h) +> x)) = h x"
 proof -
   fix x assume x: "x \<in> carrier R"
   hence "h x \<in> h ` ((a_kernel R S h) +> x)"
     using homeq_imp_rcos by blast
   thus "the_elem (h ` ((a_kernel R S h) +> x)) = h x"
     by (metis (no_types, lifting) x empty_iff homeq_imp_rcos rcos_imp_homeq the_elem_image_unique)
 qed
 
 lemma (in ring_hom_ring) the_elem_inj:
   "\<And>X Y. \<lbrakk> X \<in> carrier (R Quot (a_kernel R S h)); Y \<in> carrier (R Quot (a_kernel R S h)) \<rbrakk> \<Longrightarrow>
            the_elem (h ` X) = the_elem (h ` Y) \<Longrightarrow> X = Y"
 proof -
   fix X Y
   assume "X \<in> carrier (R Quot (a_kernel R S h))"
      and "Y \<in> carrier (R Quot (a_kernel R S h))"
      and Eq: "the_elem (h ` X) = the_elem (h ` Y)"
   then obtain x y where x: "x \<in> carrier R" "X = (a_kernel R S h) +> x"
                     and y: "y \<in> carrier R" "Y = (a_kernel R S h) +> y"
     unfolding FactRing_def A_RCOSETS_def' by auto
   hence "h x = h y" using Eq by simp
   hence "x \<ominus> y \<in> (a_kernel R S h)"
     by (simp add: a_minus_def abelian_subgroup.a_rcos_module_imp
                   abelian_subgroup_a_kernel homeq_imp_rcos x(1) y(1))
   thus "X = Y"
     by (metis R.a_coset_add_inv1 R.minus_eq abelian_subgroup.a_rcos_const
         abelian_subgroup_a_kernel additive_subgroup.a_subset additive_subgroup_a_kernel x y)
 qed
 
 lemma (in ring_hom_ring) quot_mem:
   "\<And>X. X \<in> carrier (R Quot (a_kernel R S h)) \<Longrightarrow> \<exists>x \<in> carrier R. X = (a_kernel R S h) +> x"
 proof -
   fix X assume "X \<in> carrier (R Quot (a_kernel R S h))"
   thus "\<exists>x \<in> carrier R. X = (a_kernel R S h) +> x"
     unfolding FactRing_simps by (simp add: a_r_coset_def)
 qed
 
 lemma (in ring_hom_ring) the_elem_wf:
   "\<And>X. X \<in> carrier (R Quot (a_kernel R S h)) \<Longrightarrow> \<exists>y \<in> carrier S. (h ` X) = { y }"
 proof -
   fix X assume "X \<in> carrier (R Quot (a_kernel R S h))"
   then obtain x where x: "x \<in> carrier R" and X: "X = (a_kernel R S h) +> x"
     using quot_mem by blast
   hence "\<And>x'. x' \<in> X \<Longrightarrow> h x' = h x"
   proof -
     fix x' assume "x' \<in> X" hence "x' \<in> (a_kernel R S h) +> x" using X by simp
     then obtain k where k: "k \<in> a_kernel R S h" "x' = k \<oplus> x"
       by (metis R.add.inv_closed R.add.m_assoc R.l_neg R.r_zero
           abelian_subgroup.a_elemrcos_carrier
           abelian_subgroup.a_rcos_module_imp abelian_subgroup_a_kernel x)
     hence "h x' = h k \<oplus>\<^bsub>S\<^esub> h x"
       by (meson additive_subgroup.a_Hcarr additive_subgroup_a_kernel hom_add x)
     also have " ... =  h x"
       using k by (auto simp add: x)
     finally show "h x' = h x" .
   qed
   moreover have "h x \<in> h ` X"
     by (simp add: X homeq_imp_rcos x)
   ultimately have "(h ` X) = { h x }"
     by blast
   thus "\<exists>y \<in> carrier S. (h ` X) = { y }" using x by simp
 qed
 
 corollary (in ring_hom_ring) the_elem_wf':
   "\<And>X. X \<in> carrier (R Quot (a_kernel R S h)) \<Longrightarrow> \<exists>r \<in> carrier R. (h ` X) = { h r }"
   using the_elem_wf by (metis quot_mem the_elem_eq the_elem_simp) 
 
 lemma (in ring_hom_ring) the_elem_hom:
   "(\<lambda>X. the_elem (h ` X)) \<in> ring_hom (R Quot (a_kernel R S h)) S"
 proof (rule ring_hom_memI)
   show "\<And>x. x \<in> carrier (R Quot a_kernel R S h) \<Longrightarrow> the_elem (h ` x) \<in> carrier S"
     using the_elem_wf by fastforce
   
   show "the_elem (h ` \<one>\<^bsub>R Quot a_kernel R S h\<^esub>) = \<one>\<^bsub>S\<^esub>"
     unfolding FactRing_def  using the_elem_simp[of "\<one>\<^bsub>R\<^esub>"] by simp
 
   fix X Y
   assume "X \<in> carrier (R Quot a_kernel R S h)"
      and "Y \<in> carrier (R Quot a_kernel R S h)"
   then obtain x y where x: "x \<in> carrier R" "X = (a_kernel R S h) +> x"
                     and y: "y \<in> carrier R" "Y = (a_kernel R S h) +> y"
     using quot_mem by blast
 
   have "X \<otimes>\<^bsub>R Quot a_kernel R S h\<^esub> Y = (a_kernel R S h) +> (x \<otimes> y)"
     by (simp add: FactRing_def ideal.rcoset_mult_add kernel_is_ideal x y)
   thus "the_elem (h ` (X \<otimes>\<^bsub>R Quot a_kernel R S h\<^esub> Y)) = the_elem (h ` X) \<otimes>\<^bsub>S\<^esub> the_elem (h ` Y)"
     by (simp add: x y)
 
   have "X \<oplus>\<^bsub>R Quot a_kernel R S h\<^esub> Y = (a_kernel R S h) +> (x \<oplus> y)"
     using ideal.rcos_ring_hom kernel_is_ideal ring_hom_add x y by fastforce
   thus "the_elem (h ` (X \<oplus>\<^bsub>R Quot a_kernel R S h\<^esub> Y)) = the_elem (h ` X) \<oplus>\<^bsub>S\<^esub> the_elem (h ` Y)"
     by (simp add: x y)
 qed
 
 lemma (in ring_hom_ring) the_elem_surj:
     "(\<lambda>X. (the_elem (h ` X))) ` carrier (R Quot (a_kernel R S h)) = (h ` (carrier R))"
 proof
   show "(\<lambda>X. the_elem (h ` X)) ` carrier (R Quot a_kernel R S h) \<subseteq> h ` carrier R"
     using the_elem_wf' by fastforce
 next
   show "h ` carrier R \<subseteq> (\<lambda>X. the_elem (h ` X)) ` carrier (R Quot a_kernel R S h)"
   proof
     fix y assume "y \<in> h ` carrier R"
     then obtain x where x: "x \<in> carrier R" "h x = y"
       by (metis image_iff)
     hence "the_elem (h ` ((a_kernel R S h) +> x)) = y" by simp
     moreover have "(a_kernel R S h) +> x \<in> carrier (R Quot (a_kernel R S h))"
      unfolding FactRing_simps by (auto simp add: x a_r_coset_def)
     ultimately show "y \<in> (\<lambda>X. (the_elem (h ` X))) ` carrier (R Quot (a_kernel R S h))" by blast
   qed
 qed
 
 proposition (in ring_hom_ring) FactRing_iso_set_aux:
   "(\<lambda>X. the_elem (h ` X)) \<in> ring_iso (R Quot (a_kernel R S h)) (S \<lparr> carrier := h ` (carrier R) \<rparr>)"
 proof -
   have "bij_betw (\<lambda>X. the_elem (h ` X)) (carrier (R Quot a_kernel R S h)) (h ` (carrier R))"
     unfolding bij_betw_def inj_on_def using the_elem_surj the_elem_inj by simp
 
   moreover
   have "(\<lambda>X. the_elem (h ` X)): carrier (R Quot (a_kernel R S h)) \<rightarrow> h ` (carrier R)"
     using the_elem_wf' by fastforce
   hence "(\<lambda>X. the_elem (h ` X)) \<in> ring_hom (R Quot (a_kernel R S h)) (S \<lparr> carrier := h ` (carrier R) \<rparr>)"
     using the_elem_hom the_elem_wf' unfolding ring_hom_def by simp
 
   ultimately show ?thesis unfolding ring_iso_def using the_elem_hom by simp
 qed
 
 theorem (in ring_hom_ring) FactRing_iso_set:
   assumes "h ` carrier R = carrier S"
   shows "(\<lambda>X. the_elem (h ` X)) \<in> ring_iso (R Quot (a_kernel R S h)) S"
   using FactRing_iso_set_aux assms by auto
 
 corollary (in ring_hom_ring) FactRing_iso:
   assumes "h ` carrier R = carrier S"
   shows "R Quot (a_kernel R S h) \<simeq> S"
   using FactRing_iso_set assms is_ring_iso_def by auto
 
 corollary (in ring) FactRing_zeroideal:
   shows "R Quot { \<zero> } \<simeq> R" and "R \<simeq> R Quot { \<zero> }"
 proof -
   have "ring_hom_ring R R id"
     using ring_axioms by (auto intro: ring_hom_ringI)
   moreover have "a_kernel R R id = { \<zero> }"
     unfolding a_kernel_def' by auto
   ultimately show "R Quot { \<zero> } \<simeq> R" and "R \<simeq> R Quot { \<zero> }"
     using ring_hom_ring.FactRing_iso[of R R id]
           ring_iso_sym[OF ideal.quotient_is_ring[OF zeroideal], of R] by auto
 qed
 
 lemma (in ring_hom_ring) img_is_ring: "ring (S \<lparr> carrier := h ` (carrier R) \<rparr>)"
 proof -
   let ?the_elem = "\<lambda>X. the_elem (h ` X)"
   have FactRing_is_ring: "ring (R Quot (a_kernel R S h))"
     by (simp add: ideal.quotient_is_ring kernel_is_ideal)
   have "ring ((S \<lparr> carrier := ?the_elem ` (carrier (R Quot (a_kernel R S h))) \<rparr>)
                  \<lparr>    zero := ?the_elem \<zero>\<^bsub>(R Quot (a_kernel R S h))\<^esub> \<rparr>)"
     using ring.ring_iso_imp_img_ring[OF FactRing_is_ring, of ?the_elem
           "S \<lparr> carrier := ?the_elem ` (carrier (R Quot (a_kernel R S h))) \<rparr>"]
           FactRing_iso_set_aux the_elem_surj by auto
 
   moreover
   have "\<zero> \<in> (a_kernel R S h)"
     using a_kernel_def'[of R S h] by auto
   hence "\<one> \<in> (a_kernel R S h) +> \<one>"
     using a_r_coset_def'[of R "a_kernel R S h" \<one>] by force
   hence "\<one>\<^bsub>S\<^esub> \<in> (h ` ((a_kernel R S h) +> \<one>))"
     using hom_one by force
   hence "?the_elem \<one>\<^bsub>(R Quot (a_kernel R S h))\<^esub> = \<one>\<^bsub>S\<^esub>"
     using the_elem_wf[of "(a_kernel R S h) +> \<one>"] by (simp add: FactRing_def)
   
   moreover
   have "\<zero>\<^bsub>S\<^esub> \<in> (h ` (a_kernel R S h))"
     using a_kernel_def'[of R S h] hom_zero by force
   hence "\<zero>\<^bsub>S\<^esub> \<in> (h ` \<zero>\<^bsub>(R Quot (a_kernel R S h))\<^esub>)"
     by (simp add: FactRing_def)
   hence "?the_elem \<zero>\<^bsub>(R Quot (a_kernel R S h))\<^esub> = \<zero>\<^bsub>S\<^esub>"
     using the_elem_wf[OF ring.ring_simprules(2)[OF FactRing_is_ring]]
     by (metis singletonD the_elem_eq) 
 
   ultimately
   have "ring ((S \<lparr> carrier := h ` (carrier R) \<rparr>) \<lparr> one := \<one>\<^bsub>S\<^esub>, zero := \<zero>\<^bsub>S\<^esub> \<rparr>)"
     using the_elem_surj by simp
   thus ?thesis
     by auto
 qed
 
 lemma (in ring_hom_ring) img_is_cring:
   assumes "cring S"
   shows "cring (S \<lparr> carrier := h ` (carrier R) \<rparr>)"
 proof -
   interpret ring "S \<lparr> carrier := h ` (carrier R) \<rparr>"
     using img_is_ring .
   show ?thesis
     apply unfold_locales
     using assms unfolding cring_def comm_monoid_def comm_monoid_axioms_def by auto
 qed
 
 lemma (in ring_hom_ring) img_is_domain:
   assumes "domain S"
   shows "domain (S \<lparr> carrier := h ` (carrier R) \<rparr>)"
 proof -
   interpret cring "S \<lparr> carrier := h ` (carrier R) \<rparr>"
     using img_is_cring assms unfolding domain_def by simp
   show ?thesis
     apply unfold_locales
     using assms unfolding domain_def domain_axioms_def apply auto
     using hom_closed by blast 
 qed
 
 proposition (in ring_hom_ring) primeideal_vimage:
   assumes "cring R"
   shows "primeideal P S \<Longrightarrow> primeideal { r \<in> carrier R. h r \<in> P } R"
 proof -
   assume A: "primeideal P S"
   hence is_ideal: "ideal P S" unfolding primeideal_def by simp
   have "ring_hom_ring R (S Quot P) (((+>\<^bsub>S\<^esub>) P) \<circ> h)" (is "ring_hom_ring ?A ?B ?h")
     using ring_hom_trans[OF homh, of "(+>\<^bsub>S\<^esub>) P" "S Quot P"]
           ideal.rcos_ring_hom_ring[OF is_ideal] assms
     unfolding ring_hom_ring_def ring_hom_ring_axioms_def cring_def by simp
   then interpret hom: ring_hom_ring R "S Quot P" "((+>\<^bsub>S\<^esub>) P) \<circ> h" by simp
   
   have "inj_on (\<lambda>X. the_elem (?h ` X)) (carrier (R Quot (a_kernel R (S Quot P) ?h)))"
     using hom.the_elem_inj unfolding inj_on_def by simp
   moreover
   have "ideal (a_kernel R (S Quot P) ?h) R"
     using hom.kernel_is_ideal by auto
   have hom': "ring_hom_ring (R Quot (a_kernel R (S Quot P) ?h)) (S Quot P) (\<lambda>X. the_elem (?h ` X))"
     using hom.the_elem_hom hom.kernel_is_ideal
     by (meson hom.ring_hom_ring_axioms ideal.rcos_ring_hom_ring ring_hom_ring_axioms_def ring_hom_ring_def)
   
   ultimately
   have "primeideal (a_kernel R (S Quot P) ?h) R"
     using ring_hom_ring.inj_on_domain[OF hom'] primeideal.quotient_is_domain[OF A]
           cring.quot_domain_imp_primeideal[OF assms hom.kernel_is_ideal] by simp
   
   moreover have "a_kernel R (S Quot P) ?h = { r \<in> carrier R. h r \<in> P }"
   proof
     show "a_kernel R (S Quot P) ?h \<subseteq> { r \<in> carrier R. h r \<in> P }"
     proof 
       fix r assume "r \<in> a_kernel R (S Quot P) ?h"
       hence r: "r \<in> carrier R" "P +>\<^bsub>S\<^esub> (h r) = P"
         unfolding a_kernel_def kernel_def FactRing_def by auto
       hence "h r \<in> P"
         using S.a_rcosI R.l_zero S.l_zero additive_subgroup.a_subset[OF ideal.axioms(1)[OF is_ideal]]
               additive_subgroup.zero_closed[OF ideal.axioms(1)[OF is_ideal]] hom_closed by metis
       thus "r \<in> { r \<in> carrier R. h r \<in> P }" using r by simp
     qed
   next
     show "{ r \<in> carrier R. h r \<in> P } \<subseteq> a_kernel R (S Quot P) ?h"
     proof
       fix r assume "r \<in> { r \<in> carrier R. h r \<in> P }"
       hence r: "r \<in> carrier R" "h r \<in> P" by simp_all
       hence "?h r = P"
         by (simp add: S.a_coset_join2 additive_subgroup.a_subgroup ideal.axioms(1) is_ideal)
       thus "r \<in> a_kernel R (S Quot P) ?h"
         unfolding a_kernel_def kernel_def FactRing_def using r(1) by auto
     qed
   qed
   ultimately show "primeideal { r \<in> carrier R. h r \<in> P } R" by simp
 qed
 
 end
diff --git a/src/HOL/Analysis/Abstract_Topology_2.thy b/src/HOL/Analysis/Abstract_Topology_2.thy
--- a/src/HOL/Analysis/Abstract_Topology_2.thy
+++ b/src/HOL/Analysis/Abstract_Topology_2.thy
@@ -1,1580 +1,1594 @@
 (*  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>Abstract Topology 2\<close>
 
 theory Abstract_Topology_2
   imports
     Elementary_Topology
     Abstract_Topology
     "HOL-Library.Indicator_Function"
 begin
 
 text \<open>Combination of Elementary and Abstract Topology\<close>
 
 lemma approachable_lt_le2: 
     "(\<exists>(d::real) > 0. \<forall>x. Q x \<longrightarrow> f x < d \<longrightarrow> P x) \<longleftrightarrow> (\<exists>d>0. \<forall>x. f x \<le> d \<longrightarrow> Q x \<longrightarrow> P x)"
 by (meson dense less_eq_real_def order_le_less_trans)
 
 lemma triangle_lemma:
   fixes x y z :: real
   assumes x: "0 \<le> x"
     and y: "0 \<le> y"
     and z: "0 \<le> z"
     and xy: "x\<^sup>2 \<le> y\<^sup>2 + z\<^sup>2"
   shows "x \<le> y + z"
 proof -
   have "y\<^sup>2 + z\<^sup>2 \<le> y\<^sup>2 + 2 * y * z + z\<^sup>2"
     using z y by simp
   with xy have th: "x\<^sup>2 \<le> (y + z)\<^sup>2"
     by (simp add: power2_eq_square field_simps)
   from y z have yz: "y + z \<ge> 0"
     by arith
   from power2_le_imp_le[OF th yz] show ?thesis .
 qed
 
 lemma isCont_indicator:
   fixes x :: "'a::t2_space"
   shows "isCont (indicator A :: 'a \<Rightarrow> real) x = (x \<notin> frontier A)"
 proof auto
   fix x
   assume cts_at: "isCont (indicator A :: 'a \<Rightarrow> real) x" and fr: "x \<in> frontier A"
   with continuous_at_open have 1: "\<forall>V::real set. open V \<and> indicator A x \<in> V \<longrightarrow>
     (\<exists>U::'a set. open U \<and> x \<in> U \<and> (\<forall>y\<in>U. indicator A y \<in> V))" by auto
   show False
   proof (cases "x \<in> A")
     assume x: "x \<in> A"
     hence "indicator A x \<in> ({0<..<2} :: real set)" by simp
     with 1 obtain U where U: "open U" "x \<in> U" "\<forall>y\<in>U. indicator A y \<in> ({0<..<2} :: real set)"
       using open_greaterThanLessThan by metis
     hence "\<forall>y\<in>U. indicator A y > (0::real)"
       unfolding greaterThanLessThan_def by auto
     hence "U \<subseteq> A" using indicator_eq_0_iff by force
     hence "x \<in> interior A" using U interiorI by auto
     thus ?thesis using fr unfolding frontier_def by simp
   next
     assume x: "x \<notin> A"
     hence "indicator A x \<in> ({-1<..<1} :: real set)" by simp
     with 1 obtain U where U: "open U" "x \<in> U" "\<forall>y\<in>U. indicator A y \<in> ({-1<..<1} :: real set)"
       using 1 open_greaterThanLessThan by metis
     hence "\<forall>y\<in>U. indicator A y < (1::real)"
       unfolding greaterThanLessThan_def by auto
     hence "U \<subseteq> -A" by auto
     hence "x \<in> interior (-A)" using U interiorI by auto
     thus ?thesis using fr interior_complement unfolding frontier_def by auto
   qed
 next
   assume nfr: "x \<notin> frontier A"
   hence "x \<in> interior A \<or> x \<in> interior (-A)"
     by (auto simp: frontier_def closure_interior)
   thus "isCont ((indicator A)::'a \<Rightarrow> real) x"
   proof
     assume int: "x \<in> interior A"
     then obtain U where U: "open U" "x \<in> U" "U \<subseteq> A" unfolding interior_def by auto
     hence "\<forall>y\<in>U. indicator A y = (1::real)" unfolding indicator_def by auto
     hence "continuous_on U (indicator A)" by (simp add: indicator_eq_1_iff)
     thus ?thesis using U continuous_on_eq_continuous_at by auto
   next
     assume ext: "x \<in> interior (-A)"
     then obtain U where U: "open U" "x \<in> U" "U \<subseteq> -A" unfolding interior_def by auto
     then have "continuous_on U (indicator A)"
       using continuous_on_topological by (auto simp: subset_iff)
     thus ?thesis using U continuous_on_eq_continuous_at by auto
   qed
 qed
 
 lemma islimpt_closure:
   "\<lbrakk>S \<subseteq> T; \<And>x. \<lbrakk>x islimpt S; x \<in> T\<rbrakk> \<Longrightarrow> x \<in> S\<rbrakk> \<Longrightarrow> S = T \<inter> closure S"
   using closure_def by fastforce
 
 lemma closedin_limpt:
   "closedin (top_of_set T) S \<longleftrightarrow> S \<subseteq> T \<and> (\<forall>x. x islimpt S \<and> x \<in> T \<longrightarrow> x \<in> S)"
 proof -
   have "\<And>U x. \<lbrakk>closed U; S = T \<inter> U; x islimpt S; x \<in> T\<rbrakk> \<Longrightarrow> x \<in> S"
     by (meson IntI closed_limpt inf_le2 islimpt_subset)
   then show ?thesis
     by (metis closed_closure closedin_closed closedin_imp_subset islimpt_closure)
 qed
 
 lemma closedin_closed_eq: "closed S \<Longrightarrow> closedin (top_of_set S) T \<longleftrightarrow> closed T \<and> T \<subseteq> S"
   by (meson closedin_limpt closed_subset closedin_closed_trans)
 
 lemma connected_closed_set:
    "closed S
     \<Longrightarrow> connected S \<longleftrightarrow> (\<nexists>A B. closed A \<and> closed B \<and> A \<noteq> {} \<and> B \<noteq> {} \<and> A \<union> B = S \<and> A \<inter> B = {})"
   unfolding connected_closedin_eq closedin_closed_eq connected_closedin_eq by blast
 
 text \<open>If a connnected set is written as the union of two nonempty closed sets, 
   then these sets have to intersect.\<close>
 
 lemma connected_as_closed_union:
   assumes "connected C" "C = A \<union> B" "closed A" "closed B" "A \<noteq> {}" "B \<noteq> {}"
   shows "A \<inter> B \<noteq> {}"
 by (metis assms closed_Un connected_closed_set)
 
 lemma closedin_subset_trans:
   "closedin (top_of_set U) S \<Longrightarrow> S \<subseteq> T \<Longrightarrow> T \<subseteq> U \<Longrightarrow>
     closedin (top_of_set T) S"
   by (meson closedin_limpt subset_iff)
 
 lemma openin_subset_trans:
   "openin (top_of_set U) S \<Longrightarrow> S \<subseteq> T \<Longrightarrow> T \<subseteq> U \<Longrightarrow>
     openin (top_of_set T) S"
   by (auto simp: openin_open)
 
 lemma closedin_compact:
    "\<lbrakk>compact S; closedin (top_of_set S) T\<rbrakk> \<Longrightarrow> compact T"
 by (metis closedin_closed compact_Int_closed)
 
 lemma closedin_compact_eq:
   fixes S :: "'a::t2_space set"
   shows "compact S \<Longrightarrow> (closedin (top_of_set S) T \<longleftrightarrow> compact T \<and> T \<subseteq> S)"
 by (metis closedin_imp_subset closedin_compact closed_subset compact_imp_closed)
 
 
 subsection \<open>Closure\<close>
 
 lemma euclidean_closure_of [simp]: "euclidean closure_of S = closure S"
   by (auto simp: closure_of_def closure_def islimpt_def)
 
 lemma closure_openin_Int_closure:
   assumes ope: "openin (top_of_set U) S" and "T \<subseteq> U"
   shows "closure(S \<inter> closure T) = closure(S \<inter> T)"
 proof
   obtain V where "open V" and S: "S = U \<inter> V"
     using ope using openin_open by metis
   show "closure (S \<inter> closure T) \<subseteq> closure (S \<inter> T)"
     proof (clarsimp simp: S)
       fix x
       assume  "x \<in> closure (U \<inter> V \<inter> closure T)"
       then have "V \<inter> closure T \<subseteq> A \<Longrightarrow> x \<in> closure A" for A
           by (metis closure_mono subsetD inf.coboundedI2 inf_assoc)
       then have "x \<in> closure (T \<inter> V)"
          by (metis \<open>open V\<close> closure_closure inf_commute open_Int_closure_subset)
       then show "x \<in> closure (U \<inter> V \<inter> T)"
         by (metis \<open>T \<subseteq> U\<close> inf.absorb_iff2 inf_assoc inf_commute)
     qed
 next
   show "closure (S \<inter> T) \<subseteq> closure (S \<inter> closure T)"
     by (meson Int_mono closure_mono closure_subset order_refl)
 qed
 
 corollary infinite_openin:
   fixes S :: "'a :: t1_space set"
   shows "\<lbrakk>openin (top_of_set U) S; x \<in> S; x islimpt U\<rbrakk> \<Longrightarrow> infinite S"
   by (clarsimp simp add: openin_open islimpt_eq_acc_point inf_commute)
 
 lemma closure_Int_ballI:
   assumes "\<And>U. \<lbrakk>openin (top_of_set S) U; U \<noteq> {}\<rbrakk> \<Longrightarrow> T \<inter> U \<noteq> {}"
   shows "S \<subseteq> closure T"
 proof (clarsimp simp: closure_iff_nhds_not_empty)
   fix x and A and V
   assume "x \<in> S" "V \<subseteq> A" "open V" "x \<in> V" "T \<inter> A = {}"
   then have "openin (top_of_set S) (A \<inter> V \<inter> S)"
     by (simp add: inf_absorb2 openin_subtopology_Int)
   moreover have "A \<inter> V \<inter> S \<noteq> {}" using \<open>x \<in> V\<close> \<open>V \<subseteq> A\<close> \<open>x \<in> S\<close>
     by auto
   ultimately show False
     using \<open>T \<inter> A = {}\<close> assms by fastforce
 qed
 
 
 subsection \<open>Frontier\<close>
 
 lemma euclidean_interior_of [simp]: "euclidean interior_of S = interior S"
   by (auto simp: interior_of_def interior_def)
 
 lemma euclidean_frontier_of [simp]: "euclidean frontier_of S = frontier S"
   by (auto simp: frontier_of_def frontier_def)
 
 lemma connected_Int_frontier:
      "\<lbrakk>connected S; S \<inter> T \<noteq> {}; S - T \<noteq> {}\<rbrakk> \<Longrightarrow> S \<inter> frontier T \<noteq> {}"
   apply (simp add: frontier_interiors connected_openin, safe)
   apply (drule_tac x="S \<inter> interior T" in spec, safe)
    apply (drule_tac [2] x="S \<inter> interior (-T)" in spec)
    apply (auto simp: disjoint_eq_subset_Compl dest: interior_subset [THEN subsetD])
   done
 
 subsection \<open>Compactness\<close>
 
 lemma openin_delete:
   fixes a :: "'a :: t1_space"
   shows "openin (top_of_set u) S \<Longrightarrow> openin (top_of_set u) (S - {a})"
 by (metis Int_Diff open_delete openin_open)
 
 lemma compact_eq_openin_cover:
   "compact S \<longleftrightarrow>
     (\<forall>C. (\<forall>c\<in>C. openin (top_of_set S) c) \<and> S \<subseteq> \<Union>C \<longrightarrow>
       (\<exists>D\<subseteq>C. finite D \<and> S \<subseteq> \<Union>D))"
 proof safe
   fix C
   assume "compact S" and "\<forall>c\<in>C. openin (top_of_set S) c" and "S \<subseteq> \<Union>C"
   then have "\<forall>c\<in>{T. open T \<and> S \<inter> T \<in> C}. open c" and "S \<subseteq> \<Union>{T. open T \<and> S \<inter> T \<in> C}"
     unfolding openin_open by force+
   with \<open>compact S\<close> obtain D where "D \<subseteq> {T. open T \<and> S \<inter> T \<in> C}" and "finite D" and "S \<subseteq> \<Union>D"
     by (meson compactE)
   then have "image (\<lambda>T. S \<inter> T) D \<subseteq> C \<and> finite (image (\<lambda>T. S \<inter> T) D) \<and> S \<subseteq> \<Union>(image (\<lambda>T. S \<inter> T) D)"
     by auto
   then show "\<exists>D\<subseteq>C. finite D \<and> S \<subseteq> \<Union>D" ..
 next
   assume 1: "\<forall>C. (\<forall>c\<in>C. openin (top_of_set S) c) \<and> S \<subseteq> \<Union>C \<longrightarrow>
         (\<exists>D\<subseteq>C. finite D \<and> S \<subseteq> \<Union>D)"
   show "compact S"
   proof (rule compactI)
     fix C
     let ?C = "image (\<lambda>T. S \<inter> T) C"
     assume "\<forall>t\<in>C. open t" and "S \<subseteq> \<Union>C"
     then have "(\<forall>c\<in>?C. openin (top_of_set S) c) \<and> S \<subseteq> \<Union>?C"
       unfolding openin_open by auto
     with 1 obtain D where "D \<subseteq> ?C" and "finite D" and "S \<subseteq> \<Union>D"
       by metis
     let ?D = "inv_into C (\<lambda>T. S \<inter> T) ` D"
     have "?D \<subseteq> C \<and> finite ?D \<and> S \<subseteq> \<Union>?D"
     proof (intro conjI)
       from \<open>D \<subseteq> ?C\<close> show "?D \<subseteq> C"
         by (fast intro: inv_into_into)
       from \<open>finite D\<close> show "finite ?D"
         by (rule finite_imageI)
       from \<open>S \<subseteq> \<Union>D\<close> show "S \<subseteq> \<Union>?D"
         by (metis \<open>D \<subseteq> (\<inter>) S ` C\<close> image_inv_into_cancel inf_Sup le_infE)
     qed
     then show "\<exists>D\<subseteq>C. finite D \<and> S \<subseteq> \<Union>D" ..
   qed
 qed
 
 
 subsection \<open>Continuity\<close>
 
 lemma interior_image_subset:
   assumes "inj f" "\<And>x. continuous (at x) f"
   shows "interior (f ` S) \<subseteq> f ` (interior S)"
 proof
   fix x assume "x \<in> interior (f ` S)"
   then obtain T where as: "open T" "x \<in> T" "T \<subseteq> f ` S" ..
   then have "x \<in> f ` S" by auto
   then obtain y where y: "y \<in> S" "x = f y" by auto
   have "open (f -` T)"
     using assms \<open>open T\<close> by (simp add: continuous_at_imp_continuous_on open_vimage)
   moreover have "y \<in> vimage f T"
     using \<open>x = f y\<close> \<open>x \<in> T\<close> by simp
   moreover have "vimage f T \<subseteq> S"
     using \<open>T \<subseteq> image f S\<close> \<open>inj f\<close> unfolding inj_on_def subset_eq by auto
   ultimately have "y \<in> interior S" ..
   with \<open>x = f y\<close> show "x \<in> f ` interior S" ..
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Equality of continuous functions on closure and related results\<close>
 
 lemma continuous_closedin_preimage_constant:
   fixes f :: "_ \<Rightarrow> 'b::t1_space"
   shows "continuous_on S f \<Longrightarrow> closedin (top_of_set S) {x \<in> S. f x = a}"
   using continuous_closedin_preimage[of S f "{a}"] by (simp add: vimage_def Collect_conj_eq)
 
 lemma continuous_closed_preimage_constant:
   fixes f :: "_ \<Rightarrow> 'b::t1_space"
   shows "continuous_on S f \<Longrightarrow> closed S \<Longrightarrow> closed {x \<in> S. f x = a}"
   using continuous_closed_preimage[of S f "{a}"] by (simp add: vimage_def Collect_conj_eq)
 
 lemma continuous_constant_on_closure:
   fixes f :: "_ \<Rightarrow> 'b::t1_space"
   assumes "continuous_on (closure S) f"
       and "\<And>x. x \<in> S \<Longrightarrow> f x = a"
       and "x \<in> closure S"
   shows "f x = a"
     using continuous_closed_preimage_constant[of "closure S" f a]
       assms closure_minimal[of S "{x \<in> closure S. f x = a}"] closure_subset
     unfolding subset_eq
     by auto
 
 lemma image_closure_subset:
   assumes contf: "continuous_on (closure S) f"
     and "closed T"
     and "(f ` S) \<subseteq> T"
   shows "f ` (closure S) \<subseteq> T"
 proof -
   have "S \<subseteq> {x \<in> closure S. f x \<in> T}"
     using assms(3) closure_subset by auto
   moreover have "closed (closure S \<inter> f -` T)"
     using continuous_closed_preimage[OF contf] \<open>closed T\<close> by auto
   ultimately have "closure S = (closure S \<inter> f -` T)"
     using closure_minimal[of S "(closure S \<inter> f -` T)"] by auto
   then show ?thesis by auto
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>A function constant on a set\<close>
 
 definition constant_on  (infixl "(constant'_on)" 50)
   where "f constant_on A \<equiv> \<exists>y. \<forall>x\<in>A. f x = y"
 
 lemma constant_on_subset: "\<lbrakk>f constant_on A; B \<subseteq> A\<rbrakk> \<Longrightarrow> f constant_on B"
   unfolding constant_on_def by blast
 
 lemma injective_not_constant:
   fixes S :: "'a::{perfect_space} set"
   shows "\<lbrakk>open S; inj_on f S; f constant_on S\<rbrakk> \<Longrightarrow> S = {}"
 unfolding constant_on_def
 by (metis equals0I inj_on_contraD islimpt_UNIV islimpt_def)
 
+lemma constant_on_compose:
+  assumes "f constant_on A"
+  shows   "g \<circ> f constant_on A"
+  using assms by (auto simp: constant_on_def)
+
+lemma not_constant_onI:
+  "f x \<noteq> f y \<Longrightarrow> x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> \<not>f constant_on A"
+  unfolding constant_on_def by metis
+
+lemma constant_onE:
+  assumes "f constant_on S" and "\<And>x. x\<in>S \<Longrightarrow> f x = g x"
+  shows "g constant_on S"
+  using assms unfolding constant_on_def by simp
+
 lemma constant_on_closureI:
   fixes f :: "_ \<Rightarrow> 'b::t1_space"
   assumes cof: "f constant_on S" and contf: "continuous_on (closure S) f"
-    shows "f constant_on (closure S)"
-using continuous_constant_on_closure [OF contf] cof unfolding constant_on_def
-by metis
+  shows "f constant_on (closure S)"
+  using continuous_constant_on_closure [OF contf] cof unfolding constant_on_def
+  by metis
 
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Continuity relative to a union.\<close>
 
 lemma continuous_on_Un_local:
     "\<lbrakk>closedin (top_of_set (S \<union> T)) S; closedin (top_of_set (S \<union> T)) T;
       continuous_on S f; continuous_on T f\<rbrakk>
      \<Longrightarrow> continuous_on (S \<union> T) f"
   unfolding continuous_on closedin_limpt
   by (metis Lim_trivial_limit Lim_within_union Un_iff trivial_limit_within)
 
 lemma continuous_on_cases_local:
      "\<lbrakk>closedin (top_of_set (S \<union> T)) S; closedin (top_of_set (S \<union> T)) T;
        continuous_on S f; continuous_on T g;
        \<And>x. \<lbrakk>x \<in> S \<and> \<not>P x \<or> x \<in> T \<and> P x\<rbrakk> \<Longrightarrow> f x = g x\<rbrakk>
       \<Longrightarrow> continuous_on (S \<union> T) (\<lambda>x. if P x then f x else g x)"
   by (rule continuous_on_Un_local) (auto intro: continuous_on_eq)
 
 lemma continuous_on_cases_le:
   fixes h :: "'a :: topological_space \<Rightarrow> real"
   assumes "continuous_on {x \<in> S. h x \<le> a} f"
       and "continuous_on {x \<in> S. a \<le> h x} g"
       and h: "continuous_on S h"
       and "\<And>x. \<lbrakk>x \<in> S; h x = a\<rbrakk> \<Longrightarrow> f x = g x"
     shows "continuous_on S (\<lambda>x. if h x \<le> a then f(x) else g(x))"
 proof -
   have S: "S = (S \<inter> h -` atMost a) \<union> (S \<inter> h -` atLeast a)"
     by force
   have 1: "closedin (top_of_set S) (S \<inter> h -` atMost a)"
     by (rule continuous_closedin_preimage [OF h closed_atMost])
   have 2: "closedin (top_of_set S) (S \<inter> h -` atLeast a)"
     by (rule continuous_closedin_preimage [OF h closed_atLeast])
   have [simp]: "S \<inter> h -` {..a} = {x \<in> S. h x \<le> a}" "S \<inter> h -` {a..} = {x \<in> S. a \<le> h x}"
     by auto
   have "continuous_on (S \<inter> h -` {..a} \<union> S \<inter> h -` {a..}) (\<lambda>x. if h x \<le> a then f x else g x)"
     by (intro continuous_on_cases_local) (use 1 2 S assms in auto)
   then show ?thesis
     using S by force
 qed
 
 lemma continuous_on_cases_1:
   fixes S :: "real set"
   assumes "continuous_on {t \<in> S. t \<le> a} f"
       and "continuous_on {t \<in> S. a \<le> t} g"
       and "a \<in> S \<Longrightarrow> f a = g a"
     shows "continuous_on S (\<lambda>t. if t \<le> a then f(t) else g(t))"
 using assms
 by (auto intro: continuous_on_cases_le [where h = id, simplified])
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Inverse function property for open/closed maps\<close>
 
 lemma continuous_on_inverse_open_map:
   assumes contf: "continuous_on S f"
     and imf: "f ` S = T"
     and injf: "\<And>x. x \<in> S \<Longrightarrow> g (f x) = x"
     and oo: "\<And>U. openin (top_of_set S) U \<Longrightarrow> openin (top_of_set T) (f ` U)"
   shows "continuous_on T g"
 proof -
   from imf injf have gTS: "g ` T = S"
     by force
   from imf injf have fU: "U \<subseteq> S \<Longrightarrow> (f ` U) = T \<inter> g -` U" for U
     by force
   show ?thesis
     by (simp add: continuous_on_open [of T g] gTS) (metis openin_imp_subset fU oo)
 qed
 
 lemma continuous_on_inverse_closed_map:
   assumes contf: "continuous_on S f"
     and imf: "f ` S = T"
     and injf: "\<And>x. x \<in> S \<Longrightarrow> g(f x) = x"
     and oo: "\<And>U. closedin (top_of_set S) U \<Longrightarrow> closedin (top_of_set T) (f ` U)"
   shows "continuous_on T g"
 proof -
   from imf injf have gTS: "g ` T = S"
     by force
   from imf injf have fU: "U \<subseteq> S \<Longrightarrow> (f ` U) = T \<inter> g -` U" for U
     by force
   show ?thesis
     by (simp add: continuous_on_closed [of T g] gTS) (metis closedin_imp_subset fU oo)
 qed
 
 lemma homeomorphism_injective_open_map:
   assumes contf: "continuous_on S f"
     and imf: "f ` S = T"
     and injf: "inj_on f S"
     and oo: "\<And>U. openin (top_of_set S) U \<Longrightarrow> openin (top_of_set T) (f ` U)"
   obtains g where "homeomorphism S T f g"
 proof
   have "continuous_on T (inv_into S f)"
     by (metis contf continuous_on_inverse_open_map imf injf inv_into_f_f oo)
   with imf injf contf show "homeomorphism S T f (inv_into S f)"
     by (auto simp: homeomorphism_def)
 qed
 
 lemma homeomorphism_injective_closed_map:
   assumes contf: "continuous_on S f"
     and imf: "f ` S = T"
     and injf: "inj_on f S"
     and oo: "\<And>U. closedin (top_of_set S) U \<Longrightarrow> closedin (top_of_set T) (f ` U)"
   obtains g where "homeomorphism S T f g"
 proof
   have "continuous_on T (inv_into S f)"
     by (metis contf continuous_on_inverse_closed_map imf injf inv_into_f_f oo)
   with imf injf contf show "homeomorphism S T f (inv_into S f)"
     by (auto simp: homeomorphism_def)
 qed
 
 lemma homeomorphism_imp_open_map:
   assumes hom: "homeomorphism S T f g"
     and oo: "openin (top_of_set S) U"
   shows "openin (top_of_set T) (f ` U)"
 proof -
   from hom oo have [simp]: "f ` U = T \<inter> g -` U"
     using openin_subset by (fastforce simp: homeomorphism_def rev_image_eqI)
   from hom have "continuous_on T g"
     unfolding homeomorphism_def by blast
   moreover have "g ` T = S"
     by (metis hom homeomorphism_def)
   ultimately show ?thesis
     by (simp add: continuous_on_open oo)
 qed
 
 lemma homeomorphism_imp_closed_map:
   assumes hom: "homeomorphism S T f g"
     and oo: "closedin (top_of_set S) U"
   shows "closedin (top_of_set T) (f ` U)"
 proof -
   from hom oo have [simp]: "f ` U = T \<inter> g -` U"
     using closedin_subset by (fastforce simp: homeomorphism_def rev_image_eqI)
   from hom have "continuous_on T g"
     unfolding homeomorphism_def by blast
   moreover have "g ` T = S"
     by (metis hom homeomorphism_def)
   ultimately show ?thesis
     by (simp add: continuous_on_closed oo)
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close> \<open>Seperability\<close>
 
 lemma subset_second_countable:
   obtains \<B> :: "'a:: second_countable_topology set set"
     where "countable \<B>"
           "{} \<notin> \<B>"
           "\<And>C. C \<in> \<B> \<Longrightarrow> openin(top_of_set S) C"
           "\<And>T. openin(top_of_set S) T \<Longrightarrow> \<exists>\<U>. \<U> \<subseteq> \<B> \<and> T = \<Union>\<U>"
 proof -
   obtain \<B> :: "'a set set"
     where "countable \<B>"
       and opeB: "\<And>C. C \<in> \<B> \<Longrightarrow> openin(top_of_set S) C"
       and \<B>:    "\<And>T. openin(top_of_set S) T \<Longrightarrow> \<exists>\<U>. \<U> \<subseteq> \<B> \<and> T = \<Union>\<U>"
   proof -
     obtain \<C> :: "'a set set"
       where "countable \<C>" and ope: "\<And>C. C \<in> \<C> \<Longrightarrow> open C"
         and \<C>: "\<And>S. open S \<Longrightarrow> \<exists>U. U \<subseteq> \<C> \<and> S = \<Union>U"
       by (metis univ_second_countable that)
     show ?thesis
     proof
       show "countable ((\<lambda>C. S \<inter> C) ` \<C>)"
         by (simp add: \<open>countable \<C>\<close>)
       show "\<And>C. C \<in> (\<inter>) S ` \<C> \<Longrightarrow> openin (top_of_set S) C"
         using ope by auto
       show "\<And>T. openin (top_of_set S) T \<Longrightarrow> \<exists>\<U>\<subseteq>(\<inter>) S ` \<C>. T = \<Union>\<U>"
         by (metis \<C> image_mono inf_Sup openin_open)
     qed
   qed
   show ?thesis
   proof
     show "countable (\<B> - {{}})"
       using \<open>countable \<B>\<close> by blast
     show "\<And>C. \<lbrakk>C \<in> \<B> - {{}}\<rbrakk> \<Longrightarrow> openin (top_of_set S) C"
       by (simp add: \<open>\<And>C. C \<in> \<B> \<Longrightarrow> openin (top_of_set S) C\<close>)
     show "\<exists>\<U>\<subseteq>\<B> - {{}}. T = \<Union>\<U>" if "openin (top_of_set S) T" for T
       using \<B> [OF that]
       apply clarify
       by (rule_tac x="\<U> - {{}}" in exI, auto)
   qed auto
 qed
 
 lemma Lindelof_openin:
   fixes \<F> :: "'a::second_countable_topology set set"
   assumes "\<And>S. S \<in> \<F> \<Longrightarrow> openin (top_of_set U) S"
   obtains \<F>' where "\<F>' \<subseteq> \<F>" "countable \<F>'" "\<Union>\<F>' = \<Union>\<F>"
 proof -
   have "\<And>S. S \<in> \<F> \<Longrightarrow> \<exists>T. open T \<and> S = U \<inter> T"
     using assms by (simp add: openin_open)
   then obtain tf where tf: "\<And>S. S \<in> \<F> \<Longrightarrow> open (tf S) \<and> (S = U \<inter> tf S)"
     by metis
   have [simp]: "\<And>\<F>'. \<F>' \<subseteq> \<F> \<Longrightarrow> \<Union>\<F>' = U \<inter> \<Union>(tf ` \<F>')"
     using tf by fastforce
   obtain \<G> where "countable \<G> \<and> \<G> \<subseteq> tf ` \<F>" "\<Union>\<G> = \<Union>(tf ` \<F>)"
     using tf by (force intro: Lindelof [of "tf ` \<F>"])
   then obtain \<F>' where \<F>': "\<F>' \<subseteq> \<F>" "countable \<F>'" "\<Union>\<F>' = \<Union>\<F>"
     by (clarsimp simp add: countable_subset_image)
   then show ?thesis ..
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Closed Maps\<close>
 
 lemma continuous_imp_closed_map:
   fixes f :: "'a::t2_space \<Rightarrow> 'b::t2_space"
   assumes "closedin (top_of_set S) U"
           "continuous_on S f" "f ` S = T" "compact S"
     shows "closedin (top_of_set T) (f ` U)"
   by (metis assms closedin_compact_eq compact_continuous_image continuous_on_subset subset_image_iff)
 
 lemma closed_map_restrict:
   assumes cloU: "closedin (top_of_set (S \<inter> f -` T')) U"
     and cc: "\<And>U. closedin (top_of_set S) U \<Longrightarrow> closedin (top_of_set T) (f ` U)"
     and "T' \<subseteq> T"
   shows "closedin (top_of_set T') (f ` U)"
 proof -
   obtain V where "closed V" "U = S \<inter> f -` T' \<inter> V"
     using cloU by (auto simp: closedin_closed)
   with cc [of "S \<inter> V"] \<open>T' \<subseteq> T\<close> show ?thesis
     by (fastforce simp add: closedin_closed)
 qed
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Open Maps\<close>
 
 lemma open_map_restrict:
   assumes opeU: "openin (top_of_set (S \<inter> f -` T')) U"
     and oo: "\<And>U. openin (top_of_set S) U \<Longrightarrow> openin (top_of_set T) (f ` U)"
     and "T' \<subseteq> T"
   shows "openin (top_of_set T') (f ` U)"
 proof -
   obtain V where "open V" "U = S \<inter> f -` T' \<inter> V"
     using opeU by (auto simp: openin_open)
   with oo [of "S \<inter> V"] \<open>T' \<subseteq> T\<close> show ?thesis
     by (fastforce simp add: openin_open)
 qed
 
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Quotient maps\<close>
 
 lemma quotient_map_imp_continuous_open:
   assumes T: "f ` S \<subseteq> T"
       and ope: "\<And>U. U \<subseteq> T
               \<Longrightarrow> (openin (top_of_set S) (S \<inter> f -` U) \<longleftrightarrow>
                    openin (top_of_set T) U)"
     shows "continuous_on S f"
 proof -
   have [simp]: "S \<inter> f -` f ` S = S" by auto
   show ?thesis
     by (meson T continuous_on_open_gen ope openin_imp_subset)
 qed
 
 lemma quotient_map_imp_continuous_closed:
   assumes T: "f ` S \<subseteq> T"
       and ope: "\<And>U. U \<subseteq> T
                   \<Longrightarrow> (closedin (top_of_set S) (S \<inter> f -` U) \<longleftrightarrow>
                        closedin (top_of_set T) U)"
     shows "continuous_on S f"
 proof -
   have [simp]: "S \<inter> f -` f ` S = S" by auto
   show ?thesis
     by (meson T closedin_imp_subset continuous_on_closed_gen ope)
 qed
 
 lemma open_map_imp_quotient_map:
   assumes contf: "continuous_on S f"
       and T: "T \<subseteq> f ` S"
       and ope: "\<And>T. openin (top_of_set S) T
                    \<Longrightarrow> openin (top_of_set (f ` S)) (f ` T)"
     shows "openin (top_of_set S) (S \<inter> f -` T) =
            openin (top_of_set (f ` S)) T"
 proof -
   have "T = f ` (S \<inter> f -` T)"
     using T by blast
   then show ?thesis
     using "ope" contf continuous_on_open by metis
 qed
 
 lemma closed_map_imp_quotient_map:
   assumes contf: "continuous_on S f"
       and T: "T \<subseteq> f ` S"
       and ope: "\<And>T. closedin (top_of_set S) T
               \<Longrightarrow> closedin (top_of_set (f ` S)) (f ` T)"
     shows "openin (top_of_set S) (S \<inter> f -` T) \<longleftrightarrow>
            openin (top_of_set (f ` S)) T"
           (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then have *: "closedin (top_of_set S) (S - (S \<inter> f -` T))"
     using closedin_diff by fastforce
   have [simp]: "(f ` S - f ` (S - (S \<inter> f -` T))) = T"
     using T by blast
   show ?rhs
     using ope [OF *, unfolded closedin_def] by auto
 next
   assume ?rhs
   with contf show ?lhs
     by (auto simp: continuous_on_open)
 qed
 
 lemma continuous_right_inverse_imp_quotient_map:
   assumes contf: "continuous_on S f" and imf: "f ` S \<subseteq> T"
       and contg: "continuous_on T g" and img: "g ` T \<subseteq> S"
       and fg [simp]: "\<And>y. y \<in> T \<Longrightarrow> f(g y) = y"
       and U: "U \<subseteq> T"
     shows "openin (top_of_set S) (S \<inter> f -` U) \<longleftrightarrow>
            openin (top_of_set T) U"
           (is "?lhs = ?rhs")
 proof -
   have f: "\<And>Z. openin (top_of_set (f ` S)) Z \<Longrightarrow>
                 openin (top_of_set S) (S \<inter> f -` Z)"
   and  g: "\<And>Z. openin (top_of_set (g ` T)) Z \<Longrightarrow>
                 openin (top_of_set T) (T \<inter> g -` Z)"
     using contf contg by (auto simp: continuous_on_open)
   show ?thesis
   proof
     have "T \<inter> g -` (g ` T \<inter> (S \<inter> f -` U)) = {x \<in> T. f (g x) \<in> U}"
       using imf img by blast
     also have "... = U"
       using U by auto
     finally have eq: "T \<inter> g -` (g ` T \<inter> (S \<inter> f -` U)) = U" .
     assume ?lhs
     then have *: "openin (top_of_set (g ` T)) (g ` T \<inter> (S \<inter> f -` U))"
       by (meson img openin_Int openin_subtopology_Int_subset openin_subtopology_self)
     show ?rhs
       using g [OF *] eq by auto
   next
     assume rhs: ?rhs
     show ?lhs
       by (metis f fg image_eqI image_subset_iff imf img openin_subopen openin_subtopology_self openin_trans rhs)
   qed
 qed
 
 lemma continuous_left_inverse_imp_quotient_map:
   assumes "continuous_on S f"
       and "continuous_on (f ` S) g"
       and  "\<And>x. x \<in> S \<Longrightarrow> g(f x) = x"
       and "U \<subseteq> f ` S"
     shows "openin (top_of_set S) (S \<inter> f -` U) \<longleftrightarrow>
            openin (top_of_set (f ` S)) U"
   using assms 
   by (intro continuous_right_inverse_imp_quotient_map) auto
 
 lemma continuous_imp_quotient_map:
   fixes f :: "'a::t2_space \<Rightarrow> 'b::t2_space"
   assumes "continuous_on S f" "f ` S = T" "compact S" "U \<subseteq> T"
     shows "openin (top_of_set S) (S \<inter> f -` U) \<longleftrightarrow>
            openin (top_of_set T) U"
   by (simp add: assms closed_map_imp_quotient_map continuous_imp_closed_map)
 
 subsection\<^marker>\<open>tag unimportant\<close>\<open>Pasting lemmas for functions, for of casewise definitions\<close>
 
 subsubsection\<open>on open sets\<close>
 
 lemma pasting_lemma:
   assumes ope: "\<And>i. i \<in> I \<Longrightarrow> openin X (T i)"
       and cont: "\<And>i. i \<in> I \<Longrightarrow> continuous_map(subtopology X (T i)) Y (f i)"
       and f: "\<And>i j x. \<lbrakk>i \<in> I; j \<in> I; x \<in> topspace X \<inter> T i \<inter> T j\<rbrakk> \<Longrightarrow> f i x = f j x"
       and g: "\<And>x. x \<in> topspace X \<Longrightarrow> \<exists>j. j \<in> I \<and> x \<in> T j \<and> g x = f j x"
     shows "continuous_map X Y g"
   unfolding continuous_map_openin_preimage_eq
 proof (intro conjI allI impI)
   show "g ` topspace X \<subseteq> topspace Y"
     using g cont continuous_map_image_subset_topspace by fastforce
 next
   fix U
   assume Y: "openin Y U"
   have T: "T i \<subseteq> topspace X" if "i \<in> I" for i
     using ope by (simp add: openin_subset that)
   have *: "topspace X \<inter> g -` U = (\<Union>i \<in> I. T i \<inter> f i -` U)"
     using f g T by fastforce
   have "\<And>i. i \<in> I \<Longrightarrow> openin X (T i \<inter> f i -` U)"
     using cont unfolding continuous_map_openin_preimage_eq
     by (metis Y T inf.commute inf_absorb1 ope topspace_subtopology openin_trans_full)
   then show "openin X (topspace X \<inter> g -` U)"
     by (auto simp: *)
 qed
 
 lemma pasting_lemma_exists:
   assumes X: "topspace X \<subseteq> (\<Union>i \<in> I. T i)"
       and ope: "\<And>i. i \<in> I \<Longrightarrow> openin X (T i)"
       and cont: "\<And>i. i \<in> I \<Longrightarrow> continuous_map (subtopology X (T i)) Y (f i)"
       and f: "\<And>i j x. \<lbrakk>i \<in> I; j \<in> I; x \<in> topspace X \<inter> T i \<inter> T j\<rbrakk> \<Longrightarrow> f i x = f j x"
     obtains g where "continuous_map X Y g" "\<And>x i. \<lbrakk>i \<in> I; x \<in> topspace X \<inter> T i\<rbrakk> \<Longrightarrow> g x = f i x"
 proof
   let ?h = "\<lambda>x. f (SOME i. i \<in> I \<and> x \<in> T i) x"
   show "continuous_map X Y ?h"
     apply (rule pasting_lemma [OF ope cont])
      apply (blast intro: f)+
     by (metis (no_types, lifting) UN_E X subsetD someI_ex)
   show "f (SOME i. i \<in> I \<and> x \<in> T i) x = f i x" if "i \<in> I" "x \<in> topspace X \<inter> T i" for i x
     by (metis (no_types, lifting) IntD2 IntI f someI_ex that)
 qed
 
 lemma pasting_lemma_locally_finite:
   assumes fin: "\<And>x. x \<in> topspace X \<Longrightarrow> \<exists>V. openin X V \<and> x \<in> V \<and> finite {i \<in> I. T i \<inter> V \<noteq> {}}"
     and clo: "\<And>i. i \<in> I \<Longrightarrow> closedin X (T i)"
     and cont:  "\<And>i. i \<in> I \<Longrightarrow> continuous_map(subtopology X (T i)) Y (f i)"
     and f: "\<And>i j x. \<lbrakk>i \<in> I; j \<in> I; x \<in> topspace X \<inter> T i \<inter> T j\<rbrakk> \<Longrightarrow> f i x = f j x"
     and g: "\<And>x. x \<in> topspace X \<Longrightarrow> \<exists>j. j \<in> I \<and> x \<in> T j \<and> g x = f j x"
   shows "continuous_map X Y g"
   unfolding continuous_map_closedin_preimage_eq
 proof (intro conjI allI impI)
   show "g ` topspace X \<subseteq> topspace Y"
     using g cont continuous_map_image_subset_topspace by fastforce
 next
   fix U
   assume Y: "closedin Y U"
   have T: "T i \<subseteq> topspace X" if "i \<in> I" for i
     using clo by (simp add: closedin_subset that)
   have *: "topspace X \<inter> g -` U = (\<Union>i \<in> I. T i \<inter> f i -` U)"
     using f g T by fastforce
   have cTf: "\<And>i. i \<in> I \<Longrightarrow> closedin X (T i \<inter> f i -` U)"
     using cont unfolding continuous_map_closedin_preimage_eq topspace_subtopology
     by (simp add: Int_absorb1 T Y clo closedin_closed_subtopology)
   have sub: "{Z \<in> (\<lambda>i. T i \<inter> f i -` U) ` I. Z \<inter> V \<noteq> {}}
            \<subseteq> (\<lambda>i. T i \<inter> f i -` U) ` {i \<in> I. T i \<inter> V \<noteq> {}}" for V
     by auto
   have 1: "(\<Union>i\<in>I. T i \<inter> f i -` U) \<subseteq> topspace X"
     using T by blast
   then have "locally_finite_in X ((\<lambda>i. T i \<inter> f i -` U) ` I)"
     unfolding locally_finite_in_def
     using finite_subset [OF sub] fin by force
   then show "closedin X (topspace X \<inter> g -` U)"
     by (smt (verit, best) * cTf closedin_locally_finite_Union image_iff)
 qed
 
 subsubsection\<open>Likewise on closed sets, with a finiteness assumption\<close>
 
 lemma pasting_lemma_closed:
   assumes fin: "finite I"
     and clo: "\<And>i. i \<in> I \<Longrightarrow> closedin X (T i)"
     and cont:  "\<And>i. i \<in> I \<Longrightarrow> continuous_map(subtopology X (T i)) Y (f i)"
     and f: "\<And>i j x. \<lbrakk>i \<in> I; j \<in> I; x \<in> topspace X \<inter> T i \<inter> T j\<rbrakk> \<Longrightarrow> f i x = f j x"
     and g: "\<And>x. x \<in> topspace X \<Longrightarrow> \<exists>j. j \<in> I \<and> x \<in> T j \<and> g x = f j x"
   shows "continuous_map X Y g"
   using pasting_lemma_locally_finite [OF _ clo cont f g] fin by auto
 
 lemma pasting_lemma_exists_locally_finite:
   assumes fin: "\<And>x. x \<in> topspace X \<Longrightarrow> \<exists>V. openin X V \<and> x \<in> V \<and> finite {i \<in> I. T i \<inter> V \<noteq> {}}"
     and X: "topspace X \<subseteq> \<Union>(T ` I)"
     and clo: "\<And>i. i \<in> I \<Longrightarrow> closedin X (T i)"
     and cont:  "\<And>i. i \<in> I \<Longrightarrow> continuous_map(subtopology X (T i)) Y (f i)"
     and f: "\<And>i j x. \<lbrakk>i \<in> I; j \<in> I; x \<in> topspace X \<inter> T i \<inter> T j\<rbrakk> \<Longrightarrow> f i x = f j x"
     and g: "\<And>x. x \<in> topspace X \<Longrightarrow> \<exists>j. j \<in> I \<and> x \<in> T j \<and> g x = f j x"
   obtains g where "continuous_map X Y g" "\<And>x i. \<lbrakk>i \<in> I; x \<in> topspace X \<inter> T i\<rbrakk> \<Longrightarrow> g x = f i x"
 proof
   show "continuous_map X Y (\<lambda>x. f(@i. i \<in> I \<and> x \<in> T i) x)"
     apply (rule pasting_lemma_locally_finite [OF fin])
         apply (blast intro: assms)+
     by (metis (no_types, lifting) UN_E X set_rev_mp someI_ex)
 next
   fix x i
   assume "i \<in> I" and "x \<in> topspace X \<inter> T i"
   then show "f (SOME i. i \<in> I \<and> x \<in> T i) x = f i x"
     by (metis (mono_tags, lifting) IntE IntI f someI2)
 qed
 
 lemma pasting_lemma_exists_closed:
   assumes fin: "finite I"
     and X: "topspace X \<subseteq> \<Union>(T ` I)"
     and clo: "\<And>i. i \<in> I \<Longrightarrow> closedin X (T i)"
     and cont:  "\<And>i. i \<in> I \<Longrightarrow> continuous_map(subtopology X (T i)) Y (f i)"
     and f: "\<And>i j x. \<lbrakk>i \<in> I; j \<in> I; x \<in> topspace X \<inter> T i \<inter> T j\<rbrakk> \<Longrightarrow> f i x = f j x"
   obtains g where "continuous_map X Y g" "\<And>x i. \<lbrakk>i \<in> I; x \<in> topspace X \<inter> T i\<rbrakk> \<Longrightarrow> g x = f i x"
 proof
   show "continuous_map X Y (\<lambda>x. f (SOME i. i \<in> I \<and> x \<in> T i) x)"
     apply (rule pasting_lemma_closed [OF \<open>finite I\<close> clo cont])
      apply (blast intro: f)+
     by (metis (mono_tags, lifting) UN_iff X someI_ex subset_iff)
 next
   fix x i
   assume "i \<in> I" "x \<in> topspace X \<inter> T i"
   then show "f (SOME i. i \<in> I \<and> x \<in> T i) x = f i x"
     by (metis (no_types, lifting) IntD2 IntI f someI_ex)
 qed
 
 lemma continuous_map_cases:
   assumes f: "continuous_map (subtopology X (X closure_of {x. P x})) Y f"
       and g: "continuous_map (subtopology X (X closure_of {x. \<not> P x})) Y g"
       and fg: "\<And>x. x \<in> X frontier_of {x. P x} \<Longrightarrow> f x = g x"
   shows "continuous_map X Y (\<lambda>x. if P x then f x else g x)"
 proof (rule pasting_lemma_closed)
   let ?f = "\<lambda>b. if b then f else g"
   let ?g = "\<lambda>x. if P x then f x else g x"
   let ?T = "\<lambda>b. if b then X closure_of {x. P x} else X closure_of {x. ~P x}"
   show "finite {True,False}" by auto
   have eq: "topspace X - Collect P = topspace X \<inter> {x. \<not> P x}"
     by blast
   show "?f i x = ?f j x"
     if "i \<in> {True,False}" "j \<in> {True,False}" and x: "x \<in> topspace X \<inter> ?T i \<inter> ?T j" for i j x
   proof -
     have "f x = g x" if "i" "\<not> j"
       by (smt (verit, best) Diff_Diff_Int closure_of_interior_of closure_of_restrict eq fg 
           frontier_of_closures interior_of_complement that x)
     moreover
     have "g x = f x"
       if "x \<in> X closure_of {x. \<not> P x}" "x \<in> X closure_of Collect P" "\<not> i" "j" for x
       by (metis IntI closure_of_restrict eq fg frontier_of_closures that)
     ultimately show ?thesis
       using that by (auto simp flip: closure_of_restrict)
   qed
   show "\<exists>j. j \<in> {True,False} \<and> x \<in> ?T j \<and> (if P x then f x else g x) = ?f j x"
     if "x \<in> topspace X" for x
     by simp (metis in_closure_of mem_Collect_eq that)
 qed (auto simp: f g)
 
 lemma continuous_map_cases_alt:
   assumes f: "continuous_map (subtopology X (X closure_of {x \<in> topspace X. P x})) Y f"
       and g: "continuous_map (subtopology X (X closure_of {x \<in> topspace X. ~P x})) Y g"
       and fg: "\<And>x. x \<in> X frontier_of {x \<in> topspace X. P x} \<Longrightarrow> f x = g x"
     shows "continuous_map X Y (\<lambda>x. if P x then f x else g x)"
   apply (rule continuous_map_cases)
   using assms
     apply (simp_all add: Collect_conj_eq closure_of_restrict [symmetric] frontier_of_restrict [symmetric])
   done
 
 lemma continuous_map_cases_function:
   assumes contp: "continuous_map X Z p"
     and contf: "continuous_map (subtopology X {x \<in> topspace X. p x \<in> Z closure_of U}) Y f"
     and contg: "continuous_map (subtopology X {x \<in> topspace X. p x \<in> Z closure_of (topspace Z - U)}) Y g"
     and fg: "\<And>x. \<lbrakk>x \<in> topspace X; p x \<in> Z frontier_of U\<rbrakk> \<Longrightarrow> f x = g x"
   shows "continuous_map X Y (\<lambda>x. if p x \<in> U then f x else g x)"
 proof (rule continuous_map_cases_alt)
   show "continuous_map (subtopology X (X closure_of {x \<in> topspace X. p x \<in> U})) Y f"
   proof (rule continuous_map_from_subtopology_mono)
     let ?T = "{x \<in> topspace X. p x \<in> Z closure_of U}"
     show "continuous_map (subtopology X ?T) Y f"
       by (simp add: contf)
     show "X closure_of {x \<in> topspace X. p x \<in> U} \<subseteq> ?T"
       by (rule continuous_map_closure_preimage_subset [OF contp])
   qed
   show "continuous_map (subtopology X (X closure_of {x \<in> topspace X. p x \<notin> U})) Y g"
   proof (rule continuous_map_from_subtopology_mono)
     let ?T = "{x \<in> topspace X. p x \<in> Z closure_of (topspace Z - U)}"
     show "continuous_map (subtopology X ?T) Y g"
       by (simp add: contg)
     have "X closure_of {x \<in> topspace X. p x \<notin> U} \<subseteq> X closure_of {x \<in> topspace X. p x \<in> topspace Z - U}"
       by (smt (verit, del_insts) DiffI mem_Collect_eq subset_iff closure_of_mono continuous_map_closedin contp) 
     then show "X closure_of {x \<in> topspace X. p x \<notin> U} \<subseteq> ?T"
       by (rule order_trans [OF _ continuous_map_closure_preimage_subset [OF contp]])
   qed
 next
   show "f x = g x" if "x \<in> X frontier_of {x \<in> topspace X. p x \<in> U}" for x
     using that continuous_map_frontier_frontier_preimage_subset [OF contp, of U] fg by blast
 qed
 
 subsection \<open>Retractions\<close>
 
 definition\<^marker>\<open>tag important\<close> retraction :: "('a::topological_space) set \<Rightarrow> 'a set \<Rightarrow> ('a \<Rightarrow> 'a) \<Rightarrow> bool"
 where "retraction S T r \<longleftrightarrow>
   T \<subseteq> S \<and> continuous_on S r \<and> r ` S \<subseteq> T \<and> (\<forall>x\<in>T. r x = x)"
 
 definition\<^marker>\<open>tag important\<close> retract_of (infixl "retract'_of" 50) where
 "T retract_of S  \<longleftrightarrow>  (\<exists>r. retraction S T r)"
 
 lemma retraction_idempotent: "retraction S T r \<Longrightarrow> x \<in> S \<Longrightarrow>  r (r x) = r x"
   unfolding retraction_def by auto
 
 text \<open>Preservation of fixpoints under (more general notion of) retraction\<close>
 
 lemma invertible_fixpoint_property:
   fixes S :: "'a::topological_space set"
     and T :: "'b::topological_space set"
   assumes contt: "continuous_on T i"
     and "i ` T \<subseteq> S"
     and contr: "continuous_on S r"
     and "r ` S \<subseteq> T"
     and ri: "\<And>y. y \<in> T \<Longrightarrow> r (i y) = y"
     and FP: "\<And>f. \<lbrakk>continuous_on S f; f ` S \<subseteq> S\<rbrakk> \<Longrightarrow> \<exists>x\<in>S. f x = x"
     and contg: "continuous_on T g"
     and "g ` T \<subseteq> T"
   obtains y where "y \<in> T" and "g y = y"
 proof -
   have "\<exists>x\<in>S. (i \<circ> g \<circ> r) x = x"
   proof (rule FP)
     show "continuous_on S (i \<circ> g \<circ> r)"
       by (meson contt contr assms(4) contg assms(8) continuous_on_compose continuous_on_subset)
     show "(i \<circ> g \<circ> r) ` S \<subseteq> S"
       using assms(2,4,8) by force
   qed
   then obtain x where x: "x \<in> S" "(i \<circ> g \<circ> r) x = x" ..
   then have *: "g (r x) \<in> T"
     using assms(4,8) by auto
   have "r ((i \<circ> g \<circ> r) x) = r x"
     using x by auto
   then show ?thesis
     using "*" ri that by auto
 qed
 
 lemma homeomorphic_fixpoint_property:
   fixes S :: "'a::topological_space set"
     and T :: "'b::topological_space set"
   assumes "S homeomorphic T"
   shows "(\<forall>f. continuous_on S f \<and> f ` S \<subseteq> S \<longrightarrow> (\<exists>x\<in>S. f x = x)) \<longleftrightarrow>
          (\<forall>g. continuous_on T g \<and> g ` T \<subseteq> T \<longrightarrow> (\<exists>y\<in>T. g y = y))"
          (is "?lhs = ?rhs")
 proof -
   obtain r i where r:
       "\<forall>x\<in>S. i (r x) = x" "r ` S = T" "continuous_on S r"
       "\<forall>y\<in>T. r (i y) = y" "i ` T = S" "continuous_on T i"
     using assms unfolding homeomorphic_def homeomorphism_def  by blast
   show ?thesis
   proof
     assume ?lhs
     with r show ?rhs
       by (metis invertible_fixpoint_property[of T i S r] order_refl)
   next
     assume ?rhs
     with r show ?lhs
       by (metis invertible_fixpoint_property[of S r T i] order_refl)
   qed
 qed
 
 lemma retract_fixpoint_property:
   fixes f :: "'a::topological_space \<Rightarrow> 'b::topological_space"
     and S :: "'a set"
   assumes "T retract_of S"
     and FP: "\<And>f. \<lbrakk>continuous_on S f; f ` S \<subseteq> S\<rbrakk> \<Longrightarrow> \<exists>x\<in>S. f x = x"
     and contg: "continuous_on T g"
     and "g ` T \<subseteq> T"
   obtains y where "y \<in> T" and "g y = y"
 proof -
   obtain h where "retraction S T h"
     using assms(1) unfolding retract_of_def ..
   then show ?thesis
     unfolding retraction_def
     using invertible_fixpoint_property[OF continuous_on_id _ _ _ _ FP]
     by (metis assms(4) contg image_ident that)
 qed
 
 lemma retraction:
   "retraction S T r \<longleftrightarrow>
     T \<subseteq> S \<and> continuous_on S r \<and> r ` S = T \<and> (\<forall>x \<in> T. r x = x)"
   by (force simp: retraction_def)
 
 lemma retractionE: \<comment> \<open>yields properties normalized wrt. simp -- less likely to loop\<close>
   assumes "retraction S T r"
   obtains "T = r ` S" "r ` S \<subseteq> S" "continuous_on S r" "\<And>x. x \<in> S \<Longrightarrow> r (r x) = r x"
 proof (rule that)
   from retraction [of S T r] assms
   have "T \<subseteq> S" "continuous_on S r" "r ` S = T" and "\<forall>x \<in> T. r x = x"
     by simp_all
   then show "T = r ` S" "r ` S \<subseteq> S" "continuous_on S r"
     by simp_all
   from \<open>\<forall>x \<in> T. r x = x\<close> have "r x = x" if "x \<in> T" for x
     using that by simp
   with \<open>r ` S = T\<close> show "r (r x) = r x" if "x \<in> S" for x
     using that by auto
 qed
 
 lemma retract_ofE: \<comment> \<open>yields properties normalized wrt. simp -- less likely to loop\<close>
   assumes "T retract_of S"
   obtains r where "T = r ` S" "r ` S \<subseteq> S" "continuous_on S r" "\<And>x. x \<in> S \<Longrightarrow> r (r x) = r x"
 proof -
   from assms obtain r where "retraction S T r"
     by (auto simp add: retract_of_def)
   with that show thesis
     by (auto elim: retractionE)
 qed
 
 lemma retract_of_imp_extensible:
   assumes "S retract_of T" and "continuous_on S f" and "f ` S \<subseteq> U"
   obtains g where "continuous_on T g" "g ` T \<subseteq> U" "\<And>x. x \<in> S \<Longrightarrow> g x = f x"
 proof -
   from \<open>S retract_of T\<close> obtain r where "retraction T S r"
     by (auto simp add: retract_of_def)
   show thesis
     by (rule that [of "f \<circ> r"])
       (use \<open>continuous_on S f\<close> \<open>f ` S \<subseteq> U\<close> \<open>retraction T S r\<close> in \<open>auto simp: continuous_on_compose2 retraction\<close>)
 qed
 
 lemma idempotent_imp_retraction:
   assumes "continuous_on S f" and "f ` S \<subseteq> S" and "\<And>x. x \<in> S \<Longrightarrow> f(f x) = f x"
     shows "retraction S (f ` S) f"
 by (simp add: assms retraction)
 
 lemma retraction_subset:
   assumes "retraction S T r" and "T \<subseteq> s'" and "s' \<subseteq> S"
   shows "retraction s' T r"
   unfolding retraction_def
   by (metis assms continuous_on_subset image_mono retraction)
 
 lemma retract_of_subset:
   assumes "T retract_of S" and "T \<subseteq> s'" and "s' \<subseteq> S"
     shows "T retract_of s'"
 by (meson assms retract_of_def retraction_subset)
 
 lemma retraction_refl [simp]: "retraction S S (\<lambda>x. x)"
 by (simp add: retraction)
 
 lemma retract_of_refl [iff]: "S retract_of S"
   unfolding retract_of_def retraction_def
   using continuous_on_id by blast
 
 lemma retract_of_imp_subset:
    "S retract_of T \<Longrightarrow> S \<subseteq> T"
 by (simp add: retract_of_def retraction_def)
 
 lemma retract_of_empty [simp]:
      "({} retract_of S) \<longleftrightarrow> S = {}"  "(S retract_of {}) \<longleftrightarrow> S = {}"
 by (auto simp: retract_of_def retraction_def)
 
 lemma retract_of_singleton [iff]: "({x} retract_of S) \<longleftrightarrow> x \<in> S"
   unfolding retract_of_def retraction_def by force
 
 lemma retraction_comp:
    "\<lbrakk>retraction S T f; retraction T U g\<rbrakk> \<Longrightarrow> retraction S U (g \<circ> f)"
   by (smt (verit, best) comp_apply continuous_on_compose image_comp retraction subset_iff)
 
 lemma retract_of_trans [trans]:
   assumes "S retract_of T" and "T retract_of U"
     shows "S retract_of U"
 using assms by (auto simp: retract_of_def intro: retraction_comp)
 
 lemma closedin_retract:
   fixes S :: "'a :: t2_space set"
   assumes "S retract_of T"
     shows "closedin (top_of_set T) S"
 proof -
   obtain r where r: "S \<subseteq> T" "continuous_on T r" "r ` T \<subseteq> S" "\<And>x. x \<in> S \<Longrightarrow> r x = x"
     using assms by (auto simp: retract_of_def retraction_def)
   have "S = {x\<in>T. x = r x}"
     using r by auto
   also have "\<dots> = T \<inter> ((\<lambda>x. (x, r x)) -` ({y. \<exists>x. y = (x, x)}))"
     unfolding vimage_def mem_Times_iff fst_conv snd_conv
     using r
     by auto
   also have "closedin (top_of_set T) \<dots>"
     by (rule continuous_closedin_preimage) (auto intro!: closed_diagonal continuous_on_Pair r)
   finally show ?thesis .
 qed
 
 lemma closedin_self [simp]: "closedin (top_of_set S) S"
   by simp
 
 lemma retract_of_closed:
     fixes S :: "'a :: t2_space set"
     shows "\<lbrakk>closed T; S retract_of T\<rbrakk> \<Longrightarrow> closed S"
   by (metis closedin_retract closedin_closed_eq)
 
 lemma retract_of_compact:
      "\<lbrakk>compact T; S retract_of T\<rbrakk> \<Longrightarrow> compact S"
   by (metis compact_continuous_image retract_of_def retraction)
 
 lemma retract_of_connected:
     "\<lbrakk>connected T; S retract_of T\<rbrakk> \<Longrightarrow> connected S"
   by (metis Topological_Spaces.connected_continuous_image retract_of_def retraction)
 
 lemma retraction_openin_vimage_iff:
   assumes r: "retraction S T r" and "U \<subseteq> T"
   shows "openin (top_of_set S) (S \<inter> r -` U) \<longleftrightarrow> openin (top_of_set T) U" (is "?lhs = ?rhs")
 proof
   show "?lhs \<Longrightarrow> ?rhs"
     using r retraction_def retractionE
     by (smt (verit, best) continuous_right_inverse_imp_quotient_map retraction_subset \<open>U \<subseteq> T\<close>)
   show "?rhs \<Longrightarrow> ?lhs"
     by (meson continuous_openin_preimage r retraction_def)
 qed
 
 lemma retract_of_Times:
    "\<lbrakk>S retract_of s'; T retract_of t'\<rbrakk> \<Longrightarrow> (S \<times> T) retract_of (s' \<times> t')"
 apply (simp add: retract_of_def retraction_def Sigma_mono, clarify)
 apply (rename_tac f g)
 apply (rule_tac x="\<lambda>z. ((f \<circ> fst) z, (g \<circ> snd) z)" in exI)
 apply (rule conjI continuous_intros | erule continuous_on_subset | force)+
 done
 
 subsection\<open>Retractions on a topological space\<close>
 
 definition retract_of_space :: "'a set \<Rightarrow> 'a topology \<Rightarrow> bool" (infix "retract'_of'_space" 50)
   where "S retract_of_space X
          \<equiv> S \<subseteq> topspace X \<and> (\<exists>r. continuous_map X (subtopology X S) r \<and> (\<forall>x \<in> S. r x = x))"
 
 lemma retract_of_space_retraction_maps:
    "S retract_of_space X \<longleftrightarrow> S \<subseteq> topspace X \<and> (\<exists>r. retraction_maps X (subtopology X S) r id)"
   by (auto simp: retract_of_space_def retraction_maps_def)
 
 lemma retract_of_space_section_map:
    "S retract_of_space X \<longleftrightarrow> S \<subseteq> topspace X \<and> section_map (subtopology X S) X id"
   unfolding retract_of_space_def retraction_maps_def section_map_def
   by (auto simp: continuous_map_from_subtopology)
 
 lemma retract_of_space_imp_subset:
    "S retract_of_space X \<Longrightarrow> S \<subseteq> topspace X"
   by (simp add: retract_of_space_def)
 
 lemma retract_of_space_topspace:
    "topspace X retract_of_space X"
   using retract_of_space_def by force
 
 lemma retract_of_space_empty [simp]:
    "{} retract_of_space X \<longleftrightarrow> topspace X = {}"
   by (auto simp: continuous_map_def retract_of_space_def)
 
 lemma retract_of_space_singleton [simp]:
   "{a} retract_of_space X \<longleftrightarrow> a \<in> topspace X"
 proof -
   have "continuous_map X (subtopology X {a}) (\<lambda>x. a) \<and> (\<lambda>x. a) a = a" if "a \<in> topspace X"
     using that by simp
   then show ?thesis
     by (force simp: retract_of_space_def)
 qed
 
 lemma retract_of_space_clopen:
   assumes "openin X S" "closedin X S" "S = {} \<Longrightarrow> topspace X = {}"
   shows "S retract_of_space X"
 proof (cases "S = {}")
   case False
   then obtain a where "a \<in> S"
     by blast
   show ?thesis
     unfolding retract_of_space_def
   proof (intro exI conjI)
     show "S \<subseteq> topspace X"
       by (simp add: assms closedin_subset)
     have "continuous_map X X (\<lambda>x. if x \<in> S then x else a)"
     proof (rule continuous_map_cases)
       show "continuous_map (subtopology X (X closure_of {x. x \<in> S})) X (\<lambda>x. x)"
         by (simp add: continuous_map_from_subtopology)
       show "continuous_map (subtopology X (X closure_of {x. x \<notin> S})) X (\<lambda>x. a)"
         using \<open>S \<subseteq> topspace X\<close> \<open>a \<in> S\<close> by force
       show "x = a" if "x \<in> X frontier_of {x. x \<in> S}" for x
         using assms that clopenin_eq_frontier_of by fastforce
     qed
     then show "continuous_map X (subtopology X S) (\<lambda>x. if x \<in> S then x else a)"
       using \<open>S \<subseteq> topspace X\<close> \<open>a \<in> S\<close>  by (auto simp: continuous_map_in_subtopology)
   qed auto
 qed (use assms in auto)
 
 lemma retract_of_space_disjoint_union:
   assumes "openin X S" "openin X T" and ST: "disjnt S T" "S \<union> T = topspace X" and "S = {} \<Longrightarrow> topspace X = {}"
   shows "S retract_of_space X"
 proof (rule retract_of_space_clopen)
   have "S \<inter> T = {}"
     by (meson ST disjnt_def)
   then have "S = topspace X - T"
     using ST by auto
   then show "closedin X S"
     using \<open>openin X T\<close> by blast
 qed (auto simp: assms)
 
 lemma retraction_maps_section_image1:
   assumes "retraction_maps X Y r s"
   shows "s ` (topspace Y) retract_of_space X"
   unfolding retract_of_space_section_map
 proof
   show "s ` topspace Y \<subseteq> topspace X"
     using assms continuous_map_image_subset_topspace retraction_maps_def by blast
   show "section_map (subtopology X (s ` topspace Y)) X id"
     unfolding section_map_def
     using assms retraction_maps_to_retract_maps by blast
 qed
 
 lemma retraction_maps_section_image2:
    "retraction_maps X Y r s
         \<Longrightarrow> subtopology X (s ` (topspace Y)) homeomorphic_space Y"
   using embedding_map_imp_homeomorphic_space homeomorphic_space_sym section_imp_embedding_map
         section_map_def by blast
 
 subsection\<open>Paths and path-connectedness\<close>
 
 definition pathin :: "'a topology \<Rightarrow> (real \<Rightarrow> 'a) \<Rightarrow> bool" where
    "pathin X g \<equiv> continuous_map (subtopology euclideanreal {0..1}) X g"
 
 lemma pathin_compose:
      "\<lbrakk>pathin X g; continuous_map X Y f\<rbrakk> \<Longrightarrow> pathin Y (f \<circ> g)"
    by (simp add: continuous_map_compose pathin_def)
 
 lemma pathin_subtopology:
      "pathin (subtopology X S) g \<longleftrightarrow> pathin X g \<and> (\<forall>x \<in> {0..1}. g x \<in> S)"
   by (auto simp: pathin_def continuous_map_in_subtopology)
 
 lemma pathin_const:
    "pathin X (\<lambda>x. a) \<longleftrightarrow> a \<in> topspace X"
   by (simp add: pathin_def)
    
 lemma path_start_in_topspace: "pathin X g \<Longrightarrow> g 0 \<in> topspace X"
   by (force simp: pathin_def continuous_map)
 
 lemma path_finish_in_topspace: "pathin X g \<Longrightarrow> g 1 \<in> topspace X"
   by (force simp: pathin_def continuous_map)
 
 lemma path_image_subset_topspace: "pathin X g \<Longrightarrow> g ` ({0..1}) \<subseteq> topspace X"
   by (force simp: pathin_def continuous_map)
 
 definition path_connected_space :: "'a topology \<Rightarrow> bool"
   where "path_connected_space X \<equiv> \<forall>x \<in> topspace X. \<forall> y \<in> topspace X. \<exists>g. pathin X g \<and> g 0 = x \<and> g 1 = y"
 
 definition path_connectedin :: "'a topology \<Rightarrow> 'a set \<Rightarrow> bool"
   where "path_connectedin X S \<equiv> S \<subseteq> topspace X \<and> path_connected_space(subtopology X S)"
 
 lemma path_connectedin_absolute [simp]:
      "path_connectedin (subtopology X S) S \<longleftrightarrow> path_connectedin X S"
   by (simp add: path_connectedin_def subtopology_subtopology)
 
 lemma path_connectedin_subset_topspace:
      "path_connectedin X S \<Longrightarrow> S \<subseteq> topspace X"
   by (simp add: path_connectedin_def)
 
 lemma path_connectedin_subtopology:
      "path_connectedin (subtopology X S) T \<longleftrightarrow> path_connectedin X T \<and> T \<subseteq> S"
   by (auto simp: path_connectedin_def subtopology_subtopology inf.absorb2)
 
 lemma path_connectedin:
      "path_connectedin X S \<longleftrightarrow>
         S \<subseteq> topspace X \<and>
         (\<forall>x \<in> S. \<forall>y \<in> S. \<exists>g. pathin X g \<and> g ` {0..1} \<subseteq> S \<and> g 0 = x \<and> g 1 = y)"
   unfolding path_connectedin_def path_connected_space_def pathin_def continuous_map_in_subtopology
   by (intro conj_cong refl ball_cong) (simp_all add: inf.absorb_iff2)
 
 lemma path_connectedin_topspace:
      "path_connectedin X (topspace X) \<longleftrightarrow> path_connected_space X"
   by (simp add: path_connectedin_def)
 
 lemma path_connected_imp_connected_space:
   assumes "path_connected_space X"
   shows "connected_space X"
 proof -
   have *: "\<exists>S. connectedin X S \<and> g 0 \<in> S \<and> g 1 \<in> S" if "pathin X g" for g
   proof (intro exI conjI)
     have "continuous_map (subtopology euclideanreal {0..1}) X g"
       using connectedin_absolute that by (simp add: pathin_def)
     then show "connectedin X (g ` {0..1})"
       by (rule connectedin_continuous_map_image) auto
   qed auto
   show ?thesis
     using assms
     by (auto intro: * simp add: path_connected_space_def connected_space_subconnected Ball_def)
 qed
 
 lemma path_connectedin_imp_connectedin:
      "path_connectedin X S \<Longrightarrow> connectedin X S"
   by (simp add: connectedin_def path_connected_imp_connected_space path_connectedin_def)
 
 lemma path_connected_space_topspace_empty:
      "topspace X = {} \<Longrightarrow> path_connected_space X"
   by (simp add: path_connected_space_def)
 
 lemma path_connectedin_empty [simp]: "path_connectedin X {}"
   by (simp add: path_connectedin)
 
 lemma path_connectedin_singleton [simp]: "path_connectedin X {a} \<longleftrightarrow> a \<in> topspace X"
 proof
   show "path_connectedin X {a} \<Longrightarrow> a \<in> topspace X"
     by (simp add: path_connectedin)
   show "a \<in> topspace X \<Longrightarrow> path_connectedin X {a}"
     unfolding path_connectedin
     using pathin_const by fastforce
 qed
 
 lemma path_connectedin_continuous_map_image:
   assumes f: "continuous_map X Y f" and S: "path_connectedin X S"
   shows "path_connectedin Y (f ` S)"
 proof -
   have fX: "f ` (topspace X) \<subseteq> topspace Y"
     by (metis f continuous_map_image_subset_topspace)
   show ?thesis
     unfolding path_connectedin
   proof (intro conjI ballI; clarify?)
     fix x
     assume "x \<in> S"
     show "f x \<in> topspace Y"
       by (meson S fX \<open>x \<in> S\<close> image_subset_iff path_connectedin_subset_topspace set_mp)
   next
     fix x y
     assume "x \<in> S" and "y \<in> S"
     then obtain g where g: "pathin X g" "g ` {0..1} \<subseteq> S" "g 0 = x" "g 1 = y"
       using S  by (force simp: path_connectedin)
     show "\<exists>g. pathin Y g \<and> g ` {0..1} \<subseteq> f ` S \<and> g 0 = f x \<and> g 1 = f y"
     proof (intro exI conjI)
       show "pathin Y (f \<circ> g)"
         using \<open>pathin X g\<close> f pathin_compose by auto
     qed (use g in auto)
   qed
 qed
 
 lemma path_connectedin_discrete_topology:
   "path_connectedin (discrete_topology U) S \<longleftrightarrow> S \<subseteq> U \<and> (\<exists>a. S \<subseteq> {a})" (is "?lhs = ?rhs")
 proof
   show "?lhs \<Longrightarrow> ?rhs"
     by (meson connectedin_discrete_topology path_connectedin_imp_connectedin)
   show "?rhs \<Longrightarrow> ?lhs"
     using subset_singletonD by fastforce
 qed
 
 lemma path_connected_space_discrete_topology:
    "path_connected_space (discrete_topology U) \<longleftrightarrow> (\<exists>a. U \<subseteq> {a})"
   by (metis path_connectedin_discrete_topology path_connectedin_topspace path_connected_space_topspace_empty
             subset_singletonD topspace_discrete_topology)
 
 
 lemma homeomorphic_path_connected_space_imp:
      "\<lbrakk>path_connected_space X; X homeomorphic_space Y\<rbrakk> \<Longrightarrow> path_connected_space Y"
   unfolding homeomorphic_space_def homeomorphic_maps_def
   by (metis (no_types, opaque_lifting) continuous_map_closedin continuous_map_image_subset_topspace imageI order_class.order.antisym path_connectedin_continuous_map_image path_connectedin_topspace subsetI)
 
 lemma homeomorphic_path_connected_space:
    "X homeomorphic_space Y \<Longrightarrow> path_connected_space X \<longleftrightarrow> path_connected_space Y"
   by (meson homeomorphic_path_connected_space_imp homeomorphic_space_sym)
 
 lemma homeomorphic_map_path_connectedness:
   assumes "homeomorphic_map X Y f" "U \<subseteq> topspace X"
   shows "path_connectedin Y (f ` U) \<longleftrightarrow> path_connectedin X U"
   unfolding path_connectedin_def
 proof (intro conj_cong homeomorphic_path_connected_space)
   show "(f ` U \<subseteq> topspace Y) = (U \<subseteq> topspace X)"
     using assms homeomorphic_imp_surjective_map by blast
 next
   assume "U \<subseteq> topspace X"
   show "subtopology Y (f ` U) homeomorphic_space subtopology X U"
     using assms unfolding homeomorphic_eq_everything_map
     by (metis (no_types, opaque_lifting) assms homeomorphic_map_subtopologies homeomorphic_space homeomorphic_space_sym image_mono inf.absorb_iff2)
 qed
 
 lemma homeomorphic_map_path_connectedness_eq:
    "homeomorphic_map X Y f \<Longrightarrow> path_connectedin X U \<longleftrightarrow> U \<subseteq> topspace X \<and> path_connectedin Y (f ` U)"
   by (meson homeomorphic_map_path_connectedness path_connectedin_def)
 
 subsection\<open>Connected components\<close>
 
 definition connected_component_of :: "'a topology \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool"
   where "connected_component_of X x y \<equiv>
         \<exists>T. connectedin X T \<and> x \<in> T \<and> y \<in> T"
 
 abbreviation connected_component_of_set
   where "connected_component_of_set X x \<equiv> Collect (connected_component_of X x)"
 
 definition connected_components_of :: "'a topology \<Rightarrow> ('a set) set"
   where "connected_components_of X \<equiv> connected_component_of_set X ` topspace X"
 
 lemma connected_component_in_topspace:
    "connected_component_of X x y \<Longrightarrow> x \<in> topspace X \<and> y \<in> topspace X"
   by (meson connected_component_of_def connectedin_subset_topspace in_mono)
 
 lemma connected_component_of_refl:
    "connected_component_of X x x \<longleftrightarrow> x \<in> topspace X"
   by (meson connected_component_in_topspace connected_component_of_def connectedin_sing insertI1)
 
 lemma connected_component_of_sym:
    "connected_component_of X x y \<longleftrightarrow> connected_component_of X y x"
   by (meson connected_component_of_def)
 
 lemma connected_component_of_trans:
    "\<lbrakk>connected_component_of X x y; connected_component_of X y z\<rbrakk>
         \<Longrightarrow> connected_component_of X x z"
   unfolding connected_component_of_def
   using connectedin_Un by blast
 
 lemma connected_component_of_mono:
    "\<lbrakk>connected_component_of (subtopology X S) x y; S \<subseteq> T\<rbrakk>
         \<Longrightarrow> connected_component_of (subtopology X T) x y"
   by (metis connected_component_of_def connectedin_subtopology inf.absorb_iff2 subtopology_subtopology)
 
 lemma connected_component_of_set:
    "connected_component_of_set X x = {y. \<exists>T. connectedin X T \<and> x \<in> T \<and> y \<in> T}"
   by (meson connected_component_of_def)
 
 lemma connected_component_of_subset_topspace:
    "connected_component_of_set X x \<subseteq> topspace X"
   using connected_component_in_topspace by force
 
 lemma connected_component_of_eq_empty:
    "connected_component_of_set X x = {} \<longleftrightarrow> (x \<notin> topspace X)"
   using connected_component_in_topspace connected_component_of_refl by fastforce
 
 lemma connected_space_iff_connected_component:
    "connected_space X \<longleftrightarrow> (\<forall>x \<in> topspace X. \<forall>y \<in> topspace X. connected_component_of X x y)"
   by (simp add: connected_component_of_def connected_space_subconnected)
 
 lemma connected_space_imp_connected_component_of:
    "\<lbrakk>connected_space X; a \<in> topspace X; b \<in> topspace X\<rbrakk>
     \<Longrightarrow> connected_component_of X a b"
   by (simp add: connected_space_iff_connected_component)
 
 lemma connected_space_connected_component_set:
    "connected_space X \<longleftrightarrow> (\<forall>x \<in> topspace X. connected_component_of_set X x = topspace X)"
   using connected_component_of_subset_topspace connected_space_iff_connected_component by fastforce
 
 lemma connected_component_of_maximal:
    "\<lbrakk>connectedin X S; x \<in> S\<rbrakk> \<Longrightarrow> S \<subseteq> connected_component_of_set X x"
   by (meson Ball_Collect connected_component_of_def)
 
 lemma connected_component_of_equiv:
    "connected_component_of X x y \<longleftrightarrow>
     x \<in> topspace X \<and> y \<in> topspace X \<and> connected_component_of X x = connected_component_of X y"
   apply (simp add: connected_component_in_topspace fun_eq_iff)
   by (meson connected_component_of_refl connected_component_of_sym connected_component_of_trans)
 
 lemma connected_component_of_disjoint:
    "disjnt (connected_component_of_set X x) (connected_component_of_set X y)
     \<longleftrightarrow> ~(connected_component_of X x y)"
   using connected_component_of_equiv unfolding disjnt_iff by force
 
 lemma connected_component_of_eq:
    "connected_component_of X x = connected_component_of X y \<longleftrightarrow>
         (x \<notin> topspace X) \<and> (y \<notin> topspace X) \<or>
         x \<in> topspace X \<and> y \<in> topspace X \<and>
         connected_component_of X x y"
   by (metis Collect_empty_eq_bot connected_component_of_eq_empty connected_component_of_equiv)
 
 lemma connectedin_connected_component_of:
    "connectedin X (connected_component_of_set X x)"
 proof -
   have "connected_component_of_set X x = \<Union> {T. connectedin X T \<and> x \<in> T}"
     by (auto simp: connected_component_of_def)
   then show ?thesis
     by (metis (no_types, lifting) InterI connectedin_Union emptyE mem_Collect_eq)
 qed
 
 
 lemma Union_connected_components_of:
    "\<Union>(connected_components_of X) = topspace X"
   unfolding connected_components_of_def
   using connected_component_in_topspace connected_component_of_refl by fastforce
 
 lemma connected_components_of_maximal:
    "\<lbrakk>C \<in> connected_components_of X; connectedin X S; ~disjnt C S\<rbrakk> \<Longrightarrow> S \<subseteq> C"
   unfolding connected_components_of_def disjnt_def
   apply clarify
   by (metis Int_emptyI connected_component_of_def connected_component_of_trans mem_Collect_eq)
 
 lemma pairwise_disjoint_connected_components_of:
    "pairwise disjnt (connected_components_of X)"
   unfolding connected_components_of_def pairwise_def
   by (smt (verit, best) connected_component_of_disjoint connected_component_of_eq imageE)
 
 lemma complement_connected_components_of_Union:
    "C \<in> connected_components_of X
       \<Longrightarrow> topspace X - C = \<Union> (connected_components_of X - {C})"
   by (metis Union_connected_components_of bot.extremum ccpo_Sup_singleton diff_Union_pairwise_disjoint
       insert_subset pairwise_disjoint_connected_components_of)
 
 lemma nonempty_connected_components_of:
    "C \<in> connected_components_of X \<Longrightarrow> C \<noteq> {}"
   unfolding connected_components_of_def
   by (metis (no_types, lifting) connected_component_of_eq_empty imageE)
 
 lemma connected_components_of_subset:
    "C \<in> connected_components_of X \<Longrightarrow> C \<subseteq> topspace X"
   using Union_connected_components_of by fastforce
 
 lemma connectedin_connected_components_of:
   assumes "C \<in> connected_components_of X"
   shows "connectedin X C"
 proof -
   have "C \<in> connected_component_of_set X ` topspace X"
     using assms connected_components_of_def by blast
 then show ?thesis
   using connectedin_connected_component_of by fastforce
 qed
 
 lemma connected_component_in_connected_components_of:
   "connected_component_of_set X a \<in> connected_components_of X \<longleftrightarrow> a \<in> topspace X"
   by (metis (no_types, lifting) connected_component_of_eq_empty connected_components_of_def image_iff)
 
 lemma connected_space_iff_components_eq:
    "connected_space X \<longleftrightarrow> (\<forall>C \<in> connected_components_of X. \<forall>C' \<in> connected_components_of X. C = C')"
           (is "?lhs = ?rhs")
 proof
   show "?lhs \<Longrightarrow> ?rhs"
     by (simp add: connected_components_of_def connected_space_connected_component_set)
   show "?rhs \<Longrightarrow> ?lhs"
     by (metis Union_connected_components_of Union_iff connected_space_subconnected connectedin_connected_components_of)
 qed
 
 lemma connected_components_of_eq_empty:
    "connected_components_of X = {} \<longleftrightarrow> topspace X = {}"
   by (simp add: connected_components_of_def)
 
 lemma connected_components_of_empty_space:
    "topspace X = {} \<Longrightarrow> connected_components_of X = {}"
   by (simp add: connected_components_of_eq_empty)
 
 lemma connected_components_of_subset_sing:
    "connected_components_of X \<subseteq> {S} \<longleftrightarrow> connected_space X \<and> (topspace X = {} \<or> topspace X = S)"
 proof (cases "topspace X = {}")
   case True
   then show ?thesis
     by (simp add: connected_components_of_empty_space connected_space_topspace_empty)
 next
   case False
   then have "\<lbrakk>connected_components_of X \<subseteq> {S}\<rbrakk> \<Longrightarrow> topspace X = S"
     by (metis Sup_empty Union_connected_components_of ccpo_Sup_singleton subset_singleton_iff)
   with False show ?thesis
     unfolding connected_components_of_def
     by (metis connected_space_connected_component_set empty_iff image_subset_iff insert_iff)
 qed
 
 lemma connected_space_iff_components_subset_singleton:
    "connected_space X \<longleftrightarrow> (\<exists>a. connected_components_of X \<subseteq> {a})"
   by (simp add: connected_components_of_subset_sing)
 
 lemma connected_components_of_eq_singleton:
    "connected_components_of X = {S}
 \<longleftrightarrow> connected_space X \<and> topspace X \<noteq> {} \<and> S = topspace X"
   by (metis ccpo_Sup_singleton connected_components_of_subset_sing insert_not_empty subset_singleton_iff)
 
 lemma connected_components_of_connected_space:
    "connected_space X \<Longrightarrow> connected_components_of X = (if topspace X = {} then {} else {topspace X})"
   by (simp add: connected_components_of_eq_empty connected_components_of_eq_singleton)
 
 lemma exists_connected_component_of_superset:
   assumes "connectedin X S" and ne: "topspace X \<noteq> {}"
   shows "\<exists>C. C \<in> connected_components_of X \<and> S \<subseteq> C"
 proof (cases "S = {}")
   case True
   then show ?thesis
     using ne connected_components_of_def by blast
 next
   case False
   then show ?thesis
     by (meson all_not_in_conv assms(1) connected_component_in_connected_components_of connected_component_of_maximal connectedin_subset_topspace in_mono)
 qed
 
 lemma closedin_connected_components_of:
   assumes "C \<in> connected_components_of X"
   shows   "closedin X C"
 proof -
   obtain x where "x \<in> topspace X" and x: "C = connected_component_of_set X x"
     using assms by (auto simp: connected_components_of_def)
   have "connected_component_of_set X x \<subseteq> topspace X"
     by (simp add: connected_component_of_subset_topspace)
   moreover have "X closure_of connected_component_of_set X x \<subseteq> connected_component_of_set X x"
   proof (rule connected_component_of_maximal)
     show "connectedin X (X closure_of connected_component_of_set X x)"
       by (simp add: connectedin_closure_of connectedin_connected_component_of)
     show "x \<in> X closure_of connected_component_of_set X x"
       by (simp add: \<open>x \<in> topspace X\<close> closure_of connected_component_of_refl)
   qed
   ultimately
   show ?thesis
     using closure_of_subset_eq x by auto
 qed
 
 lemma closedin_connected_component_of:
    "closedin X (connected_component_of_set X x)"
   by (metis closedin_connected_components_of closedin_empty connected_component_in_connected_components_of connected_component_of_eq_empty)
 
 lemma connected_component_of_eq_overlap:
    "connected_component_of_set X x = connected_component_of_set X y \<longleftrightarrow>
       (x \<notin> topspace X) \<and> (y \<notin> topspace X) \<or>
       ~(connected_component_of_set X x \<inter> connected_component_of_set X y = {})"
   using connected_component_of_equiv by fastforce
 
 lemma connected_component_of_nonoverlap:
    "connected_component_of_set X x \<inter> connected_component_of_set X y = {} \<longleftrightarrow>
      (x \<notin> topspace X) \<or> (y \<notin> topspace X) \<or>
      ~(connected_component_of_set X x = connected_component_of_set X y)"
   by (metis connected_component_of_eq_empty connected_component_of_eq_overlap inf.idem)
 
 lemma connected_component_of_overlap:
    "~(connected_component_of_set X x \<inter> connected_component_of_set X y = {}) \<longleftrightarrow>
     x \<in> topspace X \<and> y \<in> topspace X \<and>
     connected_component_of_set X x = connected_component_of_set X y"
   by (meson connected_component_of_nonoverlap)
 
 end
\ No newline at end of file
diff --git a/src/HOL/Complex.thy b/src/HOL/Complex.thy
--- a/src/HOL/Complex.thy
+++ b/src/HOL/Complex.thy
@@ -1,1354 +1,1377 @@
 (*  Title:       HOL/Complex.thy
     Author:      Jacques D. Fleuriot, 2001 University of Edinburgh
     Author:      Lawrence C Paulson, 2003/4
 *)
 
 section \<open>Complex Numbers: Rectangular and Polar Representations\<close>
 
 theory Complex
 imports Transcendental Real_Vector_Spaces
 begin
 
 text \<open>
   We use the \<^theory_text>\<open>codatatype\<close> command to define the type of complex numbers. This
   allows us to use \<^theory_text>\<open>primcorec\<close> to define complex functions by defining their
   real and imaginary result separately.
 \<close>
 
 codatatype complex = Complex (Re: real) (Im: real)
 
 lemma complex_surj: "Complex (Re z) (Im z) = z"
   by (rule complex.collapse)
 
 lemma complex_eqI [intro?]: "Re x = Re y \<Longrightarrow> Im x = Im y \<Longrightarrow> x = y"
   by (rule complex.expand) simp
 
 lemma complex_eq_iff: "x = y \<longleftrightarrow> Re x = Re y \<and> Im x = Im y"
   by (auto intro: complex.expand)
 
 subsection \<open>Addition and Subtraction\<close>
 
 instantiation complex :: ab_group_add
 begin
 
 primcorec zero_complex
   where
     "Re 0 = 0"
   | "Im 0 = 0"
 
 primcorec plus_complex
   where
     "Re (x + y) = Re x + Re y"
   | "Im (x + y) = Im x + Im y"
 
 primcorec uminus_complex
   where
     "Re (- x) = - Re x"
   | "Im (- x) = - Im x"
 
 primcorec minus_complex
   where
     "Re (x - y) = Re x - Re y"
   | "Im (x - y) = Im x - Im y"
 
 instance
   by standard (simp_all add: complex_eq_iff)
 
 end
 
 
 subsection \<open>Multiplication and Division\<close>
 
 instantiation complex :: field
 begin
 
 primcorec one_complex
   where
     "Re 1 = 1"
   | "Im 1 = 0"
 
 primcorec times_complex
   where
     "Re (x * y) = Re x * Re y - Im x * Im y"
   | "Im (x * y) = Re x * Im y + Im x * Re y"
 
 primcorec inverse_complex
   where
     "Re (inverse x) = Re x / ((Re x)\<^sup>2 + (Im x)\<^sup>2)"
   | "Im (inverse x) = - Im x / ((Re x)\<^sup>2 + (Im x)\<^sup>2)"
 
 definition "x div y = x * inverse y" for x y :: complex
 
 instance
   by standard
      (simp_all add: complex_eq_iff divide_complex_def
       distrib_left distrib_right right_diff_distrib left_diff_distrib
       power2_eq_square add_divide_distrib [symmetric])
 
 end
 
 lemma Re_divide: "Re (x / y) = (Re x * Re y + Im x * Im y) / ((Re y)\<^sup>2 + (Im y)\<^sup>2)"
   by (simp add: divide_complex_def add_divide_distrib)
 
 lemma Im_divide: "Im (x / y) = (Im x * Re y - Re x * Im y) / ((Re y)\<^sup>2 + (Im y)\<^sup>2)"
   by (simp add: divide_complex_def diff_divide_distrib)
 
 lemma Complex_divide:
     "(x / y) = Complex ((Re x * Re y + Im x * Im y) / ((Re y)\<^sup>2 + (Im y)\<^sup>2))
                        ((Im x * Re y - Re x * Im y) / ((Re y)\<^sup>2 + (Im y)\<^sup>2))"
   by (metis Im_divide Re_divide complex_surj)
 
 lemma Re_power2: "Re (x ^ 2) = (Re x)^2 - (Im x)^2"
   by (simp add: power2_eq_square)
 
 lemma Im_power2: "Im (x ^ 2) = 2 * Re x * Im x"
   by (simp add: power2_eq_square)
 
 lemma Re_power_real [simp]: "Im x = 0 \<Longrightarrow> Re (x ^ n) = Re x ^ n "
   by (induct n) simp_all
 
 lemma Im_power_real [simp]: "Im x = 0 \<Longrightarrow> Im (x ^ n) = 0"
   by (induct n) simp_all
 
 
 subsection \<open>Scalar Multiplication\<close>
 
 instantiation complex :: real_field
 begin
 
 primcorec scaleR_complex
   where
     "Re (scaleR r x) = r * Re x"
   | "Im (scaleR r x) = r * Im x"
 
 instance
 proof
   fix a b :: real and x y :: complex
   show "scaleR a (x + y) = scaleR a x + scaleR a y"
     by (simp add: complex_eq_iff distrib_left)
   show "scaleR (a + b) x = scaleR a x + scaleR b x"
     by (simp add: complex_eq_iff distrib_right)
   show "scaleR a (scaleR b x) = scaleR (a * b) x"
     by (simp add: complex_eq_iff mult.assoc)
   show "scaleR 1 x = x"
     by (simp add: complex_eq_iff)
   show "scaleR a x * y = scaleR a (x * y)"
     by (simp add: complex_eq_iff algebra_simps)
   show "x * scaleR a y = scaleR a (x * y)"
     by (simp add: complex_eq_iff algebra_simps)
 qed
 
 end
 
 
 subsection \<open>Numerals, Arithmetic, and Embedding from R\<close>
 
 declare [[coercion "of_real :: real \<Rightarrow> complex"]]
 declare [[coercion "of_rat :: rat \<Rightarrow> complex"]]
 declare [[coercion "of_int :: int \<Rightarrow> complex"]]
 declare [[coercion "of_nat :: nat \<Rightarrow> complex"]]
 
 abbreviation complex_of_nat::"nat \<Rightarrow> complex"
   where "complex_of_nat \<equiv> of_nat"
 
 abbreviation complex_of_int::"int \<Rightarrow> complex"
   where "complex_of_int \<equiv> of_int"
 
 abbreviation complex_of_rat::"rat \<Rightarrow> complex"
   where "complex_of_rat \<equiv> of_rat"
 
 abbreviation complex_of_real :: "real \<Rightarrow> complex"
   where "complex_of_real \<equiv> of_real"
 
 lemma complex_Re_of_nat [simp]: "Re (of_nat n) = of_nat n"
   by (induct n) simp_all
 
 lemma complex_Im_of_nat [simp]: "Im (of_nat n) = 0"
   by (induct n) simp_all
 
 lemma complex_Re_of_int [simp]: "Re (of_int z) = of_int z"
   by (cases z rule: int_diff_cases) simp
 
 lemma complex_Im_of_int [simp]: "Im (of_int z) = 0"
   by (cases z rule: int_diff_cases) simp
 
 lemma complex_Re_numeral [simp]: "Re (numeral v) = numeral v"
   using complex_Re_of_int [of "numeral v"] by simp
 
 lemma complex_Im_numeral [simp]: "Im (numeral v) = 0"
   using complex_Im_of_int [of "numeral v"] by simp
 
 lemma Re_complex_of_real [simp]: "Re (complex_of_real z) = z"
   by (simp add: of_real_def)
 
 lemma Im_complex_of_real [simp]: "Im (complex_of_real z) = 0"
   by (simp add: of_real_def)
 
 lemma Re_divide_numeral [simp]: "Re (z / numeral w) = Re z / numeral w"
   by (simp add: Re_divide sqr_conv_mult)
 
 lemma Im_divide_numeral [simp]: "Im (z / numeral w) = Im z / numeral w"
   by (simp add: Im_divide sqr_conv_mult)
 
 lemma Re_divide_of_nat [simp]: "Re (z / of_nat n) = Re z / of_nat n"
   by (cases n) (simp_all add: Re_divide field_split_simps power2_eq_square del: of_nat_Suc)
 
 lemma Im_divide_of_nat [simp]: "Im (z / of_nat n) = Im z / of_nat n"
   by (cases n) (simp_all add: Im_divide field_split_simps power2_eq_square del: of_nat_Suc)
 
 lemma Re_inverse [simp]: "r \<in> \<real> \<Longrightarrow> Re (inverse r) = inverse (Re r)"
   by (metis Re_complex_of_real Reals_cases of_real_inverse)
 
 lemma Im_inverse [simp]: "r \<in> \<real> \<Longrightarrow> Im (inverse r) = 0"
   by (metis Im_complex_of_real Reals_cases of_real_inverse)
 
 lemma of_real_Re [simp]: "z \<in> \<real> \<Longrightarrow> of_real (Re z) = z"
   by (auto simp: Reals_def)
 
 lemma complex_Re_fact [simp]: "Re (fact n) = fact n"
 proof -
   have "(fact n :: complex) = of_real (fact n)"
     by simp
   also have "Re \<dots> = fact n"
     by (subst Re_complex_of_real) simp_all
   finally show ?thesis .
 qed
 
 lemma complex_Im_fact [simp]: "Im (fact n) = 0"
   by (subst of_nat_fact [symmetric]) (simp only: complex_Im_of_nat)
 
 lemma Re_prod_Reals: "(\<And>x. x \<in> A \<Longrightarrow> f x \<in> \<real>) \<Longrightarrow> Re (prod f A) = prod (\<lambda>x. Re (f x)) A"
 proof (induction A rule: infinite_finite_induct)
   case (insert x A)
   hence "Re (prod f (insert x A)) = Re (f x) * Re (prod f A) - Im (f x) * Im (prod f A)"
     by simp
   also from insert.prems have "f x \<in> \<real>" by simp
   hence "Im (f x) = 0" by (auto elim!: Reals_cases)
   also have "Re (prod f A) = (\<Prod>x\<in>A. Re (f x))"
     by (intro insert.IH insert.prems) auto
   finally show ?case using insert.hyps by simp
 qed auto
 
 
 subsection \<open>The Complex Number $i$\<close>
 
 primcorec imaginary_unit :: complex  ("\<i>")
   where
     "Re \<i> = 0"
   | "Im \<i> = 1"
 
 lemma Complex_eq: "Complex a b = a + \<i> * b"
   by (simp add: complex_eq_iff)
 
 lemma complex_eq: "a = Re a + \<i> * Im a"
   by (simp add: complex_eq_iff)
 
 lemma fun_complex_eq: "f = (\<lambda>x. Re (f x) + \<i> * Im (f x))"
   by (simp add: fun_eq_iff complex_eq)
 
 lemma i_squared [simp]: "\<i> * \<i> = -1"
   by (simp add: complex_eq_iff)
 
 lemma power2_i [simp]: "\<i>\<^sup>2 = -1"
   by (simp add: power2_eq_square)
 
 lemma inverse_i [simp]: "inverse \<i> = - \<i>"
   by (rule inverse_unique) simp
 
 lemma divide_i [simp]: "x / \<i> = - \<i> * x"
   by (simp add: divide_complex_def)
 
 lemma complex_i_mult_minus [simp]: "\<i> * (\<i> * x) = - x"
   by (simp add: mult.assoc [symmetric])
 
 lemma complex_i_not_zero [simp]: "\<i> \<noteq> 0"
   by (simp add: complex_eq_iff)
 
 lemma complex_i_not_one [simp]: "\<i> \<noteq> 1"
   by (simp add: complex_eq_iff)
 
 lemma complex_i_not_numeral [simp]: "\<i> \<noteq> numeral w"
   by (simp add: complex_eq_iff)
 
 lemma complex_i_not_neg_numeral [simp]: "\<i> \<noteq> - numeral w"
   by (simp add: complex_eq_iff)
 
 lemma complex_split_polar: "\<exists>r a. z = complex_of_real r * (cos a + \<i> * sin a)"
   by (simp add: complex_eq_iff polar_Ex)
 
 lemma i_even_power [simp]: "\<i> ^ (n * 2) = (-1) ^ n"
   by (metis mult.commute power2_i power_mult)
 
 lemma Re_i_times [simp]: "Re (\<i> * z) = - Im z"
   by simp
 
 lemma Im_i_times [simp]: "Im (\<i> * z) = Re z"
   by simp
 
 lemma i_times_eq_iff: "\<i> * w = z \<longleftrightarrow> w = - (\<i> * z)"
   by auto
 
 lemma divide_numeral_i [simp]: "z / (numeral n * \<i>) = - (\<i> * z) / numeral n"
   by (metis divide_divide_eq_left divide_i mult.commute mult_minus_right)
 
 lemma imaginary_eq_real_iff [simp]:
   assumes "y \<in> Reals" "x \<in> Reals"
   shows "\<i> * y = x \<longleftrightarrow> x=0 \<and> y=0"
   by (metis Im_complex_of_real Im_i_times assms mult_zero_right of_real_0 of_real_Re)
 
 lemma real_eq_imaginary_iff [simp]:
   assumes "y \<in> Reals" "x \<in> Reals"
   shows "x = \<i> * y  \<longleftrightarrow> x=0 \<and> y=0"
     using assms imaginary_eq_real_iff by fastforce
 
 subsection \<open>Vector Norm\<close>
 
 instantiation complex :: real_normed_field
 begin
 
 definition "norm z = sqrt ((Re z)\<^sup>2 + (Im z)\<^sup>2)"
 
 abbreviation cmod :: "complex \<Rightarrow> real"
   where "cmod \<equiv> norm"
 
 definition complex_sgn_def: "sgn x = x /\<^sub>R cmod x"
 
 definition dist_complex_def: "dist x y = cmod (x - y)"
 
 definition uniformity_complex_def [code del]:
   "(uniformity :: (complex \<times> complex) filter) = (INF e\<in>{0 <..}. principal {(x, y). dist x y < e})"
 
 definition open_complex_def [code del]:
   "open (U :: complex set) \<longleftrightarrow> (\<forall>x\<in>U. eventually (\<lambda>(x', y). x' = x \<longrightarrow> y \<in> U) uniformity)"
 
 instance
 proof
   fix r :: real and x y :: complex and S :: "complex set"
   show "(norm x = 0) = (x = 0)"
     by (simp add: norm_complex_def complex_eq_iff)
   show "norm (x + y) \<le> norm x + norm y"
     by (simp add: norm_complex_def complex_eq_iff real_sqrt_sum_squares_triangle_ineq)
   show "norm (scaleR r x) = \<bar>r\<bar> * norm x"
     by (simp add: norm_complex_def complex_eq_iff power_mult_distrib distrib_left [symmetric]
         real_sqrt_mult)
   show "norm (x * y) = norm x * norm y"
     by (simp add: norm_complex_def complex_eq_iff real_sqrt_mult [symmetric]
         power2_eq_square algebra_simps)
 qed (rule complex_sgn_def dist_complex_def open_complex_def uniformity_complex_def)+
 
 end
 
 declare uniformity_Abort[where 'a = complex, code]
 
 lemma norm_ii [simp]: "norm \<i> = 1"
   by (simp add: norm_complex_def)
 
 lemma cmod_unit_one: "cmod (cos a + \<i> * sin a) = 1"
   by (simp add: norm_complex_def)
 
 lemma cmod_complex_polar: "cmod (r * (cos a + \<i> * sin a)) = \<bar>r\<bar>"
   by (simp add: norm_mult cmod_unit_one)
 
 lemma complex_Re_le_cmod: "Re x \<le> cmod x"
   unfolding norm_complex_def by (rule real_sqrt_sum_squares_ge1)
 
 lemma complex_mod_minus_le_complex_mod: "- cmod x \<le> cmod x"
   by (rule order_trans [OF _ norm_ge_zero]) simp
 
 lemma complex_mod_triangle_ineq2: "cmod (b + a) - cmod b \<le> cmod a"
   by (rule ord_le_eq_trans [OF norm_triangle_ineq2]) simp
 
 lemma abs_Re_le_cmod: "\<bar>Re x\<bar> \<le> cmod x"
   by (simp add: norm_complex_def)
 
 lemma abs_Im_le_cmod: "\<bar>Im x\<bar> \<le> cmod x"
   by (simp add: norm_complex_def)
 
 lemma cmod_le: "cmod z \<le> \<bar>Re z\<bar> + \<bar>Im z\<bar>"
   using norm_complex_def sqrt_sum_squares_le_sum_abs by presburger
 
 lemma cmod_eq_Re: "Im z = 0 \<Longrightarrow> cmod z = \<bar>Re z\<bar>"
   by (simp add: norm_complex_def)
 
 lemma cmod_eq_Im: "Re z = 0 \<Longrightarrow> cmod z = \<bar>Im z\<bar>"
   by (simp add: norm_complex_def)
 
 lemma cmod_power2: "(cmod z)\<^sup>2 = (Re z)\<^sup>2 + (Im z)\<^sup>2"
   by (simp add: norm_complex_def)
 
 lemma cmod_plus_Re_le_0_iff: "cmod z + Re z \<le> 0 \<longleftrightarrow> Re z = - cmod z"
   using abs_Re_le_cmod[of z] by auto
 
 lemma cmod_Re_le_iff: "Im x = Im y \<Longrightarrow> cmod x \<le> cmod y \<longleftrightarrow> \<bar>Re x\<bar> \<le> \<bar>Re y\<bar>"
   by (metis add.commute add_le_cancel_left norm_complex_def real_sqrt_abs real_sqrt_le_iff)
 
 lemma cmod_Im_le_iff: "Re x = Re y \<Longrightarrow> cmod x \<le> cmod y \<longleftrightarrow> \<bar>Im x\<bar> \<le> \<bar>Im y\<bar>"
   by (metis add_le_cancel_left norm_complex_def real_sqrt_abs real_sqrt_le_iff)
 
 lemma Im_eq_0: "\<bar>Re z\<bar> = cmod z \<Longrightarrow> Im z = 0"
   by (subst (asm) power_eq_iff_eq_base[symmetric, where n=2]) (auto simp add: norm_complex_def)
 
 lemma abs_sqrt_wlog: "(\<And>x. x \<ge> 0 \<Longrightarrow> P x (x\<^sup>2)) \<Longrightarrow> P \<bar>x\<bar> (x\<^sup>2)"
   for x::"'a::linordered_idom"
   by (metis abs_ge_zero power2_abs)
 
 lemma complex_abs_le_norm: "\<bar>Re z\<bar> + \<bar>Im z\<bar> \<le> sqrt 2 * norm z"
   unfolding norm_complex_def
   apply (rule abs_sqrt_wlog [where x="Re z"])
   apply (rule abs_sqrt_wlog [where x="Im z"])
   apply (rule power2_le_imp_le)
    apply (simp_all add: power2_sum add.commute sum_squares_bound real_sqrt_mult [symmetric])
   done
 
 lemma complex_unit_circle: "z \<noteq> 0 \<Longrightarrow> (Re z / cmod z)\<^sup>2 + (Im z / cmod z)\<^sup>2 = 1"
   by (simp add: norm_complex_def complex_eq_iff power2_eq_square add_divide_distrib [symmetric])
 
 
 text \<open>Properties of complex signum.\<close>
 
 lemma sgn_eq: "sgn z = z / complex_of_real (cmod z)"
   by (simp add: sgn_div_norm divide_inverse scaleR_conv_of_real mult.commute)
 
 lemma Re_sgn [simp]: "Re(sgn z) = Re(z)/cmod z"
   by (simp add: complex_sgn_def divide_inverse)
 
 lemma Im_sgn [simp]: "Im(sgn z) = Im(z)/cmod z"
   by (simp add: complex_sgn_def divide_inverse)
 
 
 subsection \<open>Absolute value\<close>
 
 
 instantiation complex :: field_abs_sgn
 begin
 
 definition abs_complex :: "complex \<Rightarrow> complex"
   where "abs_complex = of_real \<circ> norm"
 
 instance
   proof qed (auto simp add: abs_complex_def complex_sgn_def norm_divide norm_mult scaleR_conv_of_real field_simps)
 end
 
 
 subsection \<open>Completeness of the Complexes\<close>
 
 lemma bounded_linear_Re: "bounded_linear Re"
   by (rule bounded_linear_intro [where K=1]) (simp_all add: norm_complex_def)
 
 lemma bounded_linear_Im: "bounded_linear Im"
   by (rule bounded_linear_intro [where K=1]) (simp_all add: norm_complex_def)
 
 lemmas Cauchy_Re = bounded_linear.Cauchy [OF bounded_linear_Re]
 lemmas Cauchy_Im = bounded_linear.Cauchy [OF bounded_linear_Im]
 lemmas tendsto_Re [tendsto_intros] = bounded_linear.tendsto [OF bounded_linear_Re]
 lemmas tendsto_Im [tendsto_intros] = bounded_linear.tendsto [OF bounded_linear_Im]
 lemmas isCont_Re [simp] = bounded_linear.isCont [OF bounded_linear_Re]
 lemmas isCont_Im [simp] = bounded_linear.isCont [OF bounded_linear_Im]
 lemmas continuous_Re [simp] = bounded_linear.continuous [OF bounded_linear_Re]
 lemmas continuous_Im [simp] = bounded_linear.continuous [OF bounded_linear_Im]
 lemmas continuous_on_Re [continuous_intros] = bounded_linear.continuous_on[OF bounded_linear_Re]
 lemmas continuous_on_Im [continuous_intros] = bounded_linear.continuous_on[OF bounded_linear_Im]
 lemmas has_derivative_Re [derivative_intros] = bounded_linear.has_derivative[OF bounded_linear_Re]
 lemmas has_derivative_Im [derivative_intros] = bounded_linear.has_derivative[OF bounded_linear_Im]
 lemmas sums_Re = bounded_linear.sums [OF bounded_linear_Re]
 lemmas sums_Im = bounded_linear.sums [OF bounded_linear_Im]
 lemmas Re_suminf = bounded_linear.suminf[OF bounded_linear_Re]
 lemmas Im_suminf = bounded_linear.suminf[OF bounded_linear_Im]
 
 lemma tendsto_Complex [tendsto_intros]:
   "(f \<longlongrightarrow> a) F \<Longrightarrow> (g \<longlongrightarrow> b) F \<Longrightarrow> ((\<lambda>x. Complex (f x) (g x)) \<longlongrightarrow> Complex a b) F"
   unfolding Complex_eq by (auto intro!: tendsto_intros)
 
 lemma tendsto_complex_iff:
   "(f \<longlongrightarrow> x) F \<longleftrightarrow> (((\<lambda>x. Re (f x)) \<longlongrightarrow> Re x) F \<and> ((\<lambda>x. Im (f x)) \<longlongrightarrow> Im x) F)"
 proof safe
   assume "((\<lambda>x. Re (f x)) \<longlongrightarrow> Re x) F" "((\<lambda>x. Im (f x)) \<longlongrightarrow> Im x) F"
   from tendsto_Complex[OF this] show "(f \<longlongrightarrow> x) F"
     unfolding complex.collapse .
 qed (auto intro: tendsto_intros)
 
 lemma continuous_complex_iff:
   "continuous F f \<longleftrightarrow> continuous F (\<lambda>x. Re (f x)) \<and> continuous F (\<lambda>x. Im (f x))"
   by (simp only: continuous_def tendsto_complex_iff)
 
 lemma continuous_on_of_real_o_iff [simp]:
      "continuous_on S (\<lambda>x. complex_of_real (g x)) = continuous_on S g"
   using continuous_on_Re continuous_on_of_real  by fastforce
 
 lemma continuous_on_of_real_id [simp]:
      "continuous_on S (of_real :: real \<Rightarrow> 'a::real_normed_algebra_1)"
   by (rule continuous_on_of_real [OF continuous_on_id])
 
 lemma has_vector_derivative_complex_iff: "(f has_vector_derivative x) F \<longleftrightarrow>
     ((\<lambda>x. Re (f x)) has_field_derivative (Re x)) F \<and>
     ((\<lambda>x. Im (f x)) has_field_derivative (Im x)) F"
   by (simp add: has_vector_derivative_def has_field_derivative_def has_derivative_def
       tendsto_complex_iff algebra_simps bounded_linear_scaleR_left bounded_linear_mult_right)
 
 lemma has_field_derivative_Re[derivative_intros]:
   "(f has_vector_derivative D) F \<Longrightarrow> ((\<lambda>x. Re (f x)) has_field_derivative (Re D)) F"
   unfolding has_vector_derivative_complex_iff by safe
 
 lemma has_field_derivative_Im[derivative_intros]:
   "(f has_vector_derivative D) F \<Longrightarrow> ((\<lambda>x. Im (f x)) has_field_derivative (Im D)) F"
   unfolding has_vector_derivative_complex_iff by safe
 
 instance complex :: banach
 proof
   fix X :: "nat \<Rightarrow> complex"
   assume X: "Cauchy X"
   then have "(\<lambda>n. Complex (Re (X n)) (Im (X n))) \<longlonglongrightarrow>
     Complex (lim (\<lambda>n. Re (X n))) (lim (\<lambda>n. Im (X n)))"
     by (intro tendsto_Complex convergent_LIMSEQ_iff[THEN iffD1]
         Cauchy_convergent_iff[THEN iffD1] Cauchy_Re Cauchy_Im)
   then show "convergent X"
     unfolding complex.collapse by (rule convergentI)
 qed
 
 declare DERIV_power[where 'a=complex, unfolded of_nat_def[symmetric], derivative_intros]
 
 
 subsection \<open>Complex Conjugation\<close>
 
 primcorec cnj :: "complex \<Rightarrow> complex"
   where
     "Re (cnj z) = Re z"
   | "Im (cnj z) = - Im z"
 
 lemma complex_cnj_cancel_iff [simp]: "cnj x = cnj y \<longleftrightarrow> x = y"
   by (simp add: complex_eq_iff)
 
 lemma complex_cnj_cnj [simp]: "cnj (cnj z) = z"
   by (simp add: complex_eq_iff)
 
+lemma in_image_cnj_iff: "z \<in> cnj ` A \<longleftrightarrow> cnj z \<in> A"
+  by (metis complex_cnj_cnj image_iff)
+
+lemma image_cnj_conv_vimage_cnj: "cnj ` A = cnj -` A"
+  using in_image_cnj_iff by blast
+
 lemma complex_cnj_zero [simp]: "cnj 0 = 0"
   by (simp add: complex_eq_iff)
 
 lemma complex_cnj_zero_iff [iff]: "cnj z = 0 \<longleftrightarrow> z = 0"
   by (simp add: complex_eq_iff)
 
 lemma complex_cnj_one_iff [simp]: "cnj z = 1 \<longleftrightarrow> z = 1"
   by (simp add: complex_eq_iff)
 
 lemma complex_cnj_add [simp]: "cnj (x + y) = cnj x + cnj y"
   by (simp add: complex_eq_iff)
 
 lemma cnj_sum [simp]: "cnj (sum f s) = (\<Sum>x\<in>s. cnj (f x))"
   by (induct s rule: infinite_finite_induct) auto
 
 lemma complex_cnj_diff [simp]: "cnj (x - y) = cnj x - cnj y"
   by (simp add: complex_eq_iff)
 
 lemma complex_cnj_minus [simp]: "cnj (- x) = - cnj x"
   by (simp add: complex_eq_iff)
 
 lemma complex_cnj_one [simp]: "cnj 1 = 1"
   by (simp add: complex_eq_iff)
 
 lemma complex_cnj_mult [simp]: "cnj (x * y) = cnj x * cnj y"
   by (simp add: complex_eq_iff)
 
 lemma cnj_prod [simp]: "cnj (prod f s) = (\<Prod>x\<in>s. cnj (f x))"
   by (induct s rule: infinite_finite_induct) auto
 
 lemma complex_cnj_inverse [simp]: "cnj (inverse x) = inverse (cnj x)"
   by (simp add: complex_eq_iff)
 
 lemma complex_cnj_divide [simp]: "cnj (x / y) = cnj x / cnj y"
   by (simp add: divide_complex_def)
 
 lemma complex_cnj_power [simp]: "cnj (x ^ n) = cnj x ^ n"
   by (induct n) simp_all
 
 lemma complex_cnj_of_nat [simp]: "cnj (of_nat n) = of_nat n"
   by (simp add: complex_eq_iff)
 
 lemma complex_cnj_of_int [simp]: "cnj (of_int z) = of_int z"
   by (simp add: complex_eq_iff)
 
 lemma complex_cnj_numeral [simp]: "cnj (numeral w) = numeral w"
   by (simp add: complex_eq_iff)
 
 lemma complex_cnj_neg_numeral [simp]: "cnj (- numeral w) = - numeral w"
   by (simp add: complex_eq_iff)
 
 lemma complex_cnj_scaleR [simp]: "cnj (scaleR r x) = scaleR r (cnj x)"
   by (simp add: complex_eq_iff)
 
 lemma complex_mod_cnj [simp]: "cmod (cnj z) = cmod z"
   by (simp add: norm_complex_def)
 
 lemma complex_cnj_complex_of_real [simp]: "cnj (of_real x) = of_real x"
   by (simp add: complex_eq_iff)
 
 lemma complex_cnj_i [simp]: "cnj \<i> = - \<i>"
   by (simp add: complex_eq_iff)
 
 lemma complex_add_cnj: "z + cnj z = complex_of_real (2 * Re z)"
   by (simp add: complex_eq_iff)
 
 lemma complex_diff_cnj: "z - cnj z = complex_of_real (2 * Im z) * \<i>"
   by (simp add: complex_eq_iff)
 
 lemma Ints_cnj [intro]: "x \<in> \<int> \<Longrightarrow> cnj x \<in> \<int>"
   by (auto elim!: Ints_cases)
 
 lemma cnj_in_Ints_iff [simp]: "cnj x \<in> \<int> \<longleftrightarrow> x \<in> \<int>"
   using Ints_cnj[of x] Ints_cnj[of "cnj x"] by auto
 
 lemma complex_mult_cnj: "z * cnj z = complex_of_real ((Re z)\<^sup>2 + (Im z)\<^sup>2)"
   by (simp add: complex_eq_iff power2_eq_square)
 
 lemma cnj_add_mult_eq_Re: "z * cnj w + cnj z * w = 2 * Re (z * cnj w)"
   by (rule complex_eqI) auto
 
 lemma complex_mod_mult_cnj: "cmod (z * cnj z) = (cmod z)\<^sup>2"
   by (simp add: norm_mult power2_eq_square)
 
 lemma complex_mod_sqrt_Re_mult_cnj: "cmod z = sqrt (Re (z * cnj z))"
   by (simp add: norm_complex_def power2_eq_square)
 
 lemma complex_In_mult_cnj_zero [simp]: "Im (z * cnj z) = 0"
   by simp
 
 lemma complex_cnj_fact [simp]: "cnj (fact n) = fact n"
   by (subst of_nat_fact [symmetric], subst complex_cnj_of_nat) simp
 
 lemma complex_cnj_pochhammer [simp]: "cnj (pochhammer z n) = pochhammer (cnj z) n"
   by (induct n arbitrary: z) (simp_all add: pochhammer_rec)
 
 lemma bounded_linear_cnj: "bounded_linear cnj"
   using complex_cnj_add complex_cnj_scaleR by (rule bounded_linear_intro [where K=1]) simp
 
 lemma linear_cnj: "linear cnj"
   using bounded_linear.linear[OF bounded_linear_cnj] .
 
 lemmas tendsto_cnj [tendsto_intros] = bounded_linear.tendsto [OF bounded_linear_cnj]
   and isCont_cnj [simp] = bounded_linear.isCont [OF bounded_linear_cnj]
   and continuous_cnj [simp, continuous_intros] = bounded_linear.continuous [OF bounded_linear_cnj]
   and continuous_on_cnj [simp, continuous_intros] = bounded_linear.continuous_on [OF bounded_linear_cnj]
   and has_derivative_cnj [simp, derivative_intros] = bounded_linear.has_derivative [OF bounded_linear_cnj]
 
 lemma lim_cnj: "((\<lambda>x. cnj(f x)) \<longlongrightarrow> cnj l) F \<longleftrightarrow> (f \<longlongrightarrow> l) F"
   by (simp add: tendsto_iff dist_complex_def complex_cnj_diff [symmetric] del: complex_cnj_diff)
 
 lemma sums_cnj: "((\<lambda>x. cnj(f x)) sums cnj l) \<longleftrightarrow> (f sums l)"
   by (simp add: sums_def lim_cnj cnj_sum [symmetric] del: cnj_sum)
 
 lemma differentiable_cnj_iff:
   "(\<lambda>z. cnj (f z)) differentiable at x within A \<longleftrightarrow> f differentiable at x within A"
 proof
   assume "(\<lambda>z. cnj (f z)) differentiable at x within A"
   then obtain D where "((\<lambda>z. cnj (f z)) has_derivative D) (at x within A)"
     by (auto simp: differentiable_def)
   from has_derivative_cnj[OF this] show "f differentiable at x within A"
     by (auto simp: differentiable_def)
 next
   assume "f differentiable at x within A"
   then obtain D where "(f has_derivative D) (at x within A)"
     by (auto simp: differentiable_def)
   from has_derivative_cnj[OF this] show "(\<lambda>z. cnj (f z)) differentiable at x within A"
     by (auto simp: differentiable_def)
 qed
 
 lemma has_vector_derivative_cnj [derivative_intros]:
   assumes "(f has_vector_derivative f') (at z within A)"
   shows   "((\<lambda>z. cnj (f z)) has_vector_derivative cnj f') (at z within A)"
   using assms by (auto simp: has_vector_derivative_complex_iff intro: derivative_intros)
 
 
 subsection \<open>Basic Lemmas\<close>
 
 lemma complex_of_real_code[code_unfold]: "of_real = (\<lambda>x. Complex x 0)" 
   by (intro ext, auto simp: complex_eq_iff)
 
 lemma complex_eq_0: "z=0 \<longleftrightarrow> (Re z)\<^sup>2 + (Im z)\<^sup>2 = 0"
   by (metis zero_complex.sel complex_eqI sum_power2_eq_zero_iff)
 
 lemma complex_neq_0: "z\<noteq>0 \<longleftrightarrow> (Re z)\<^sup>2 + (Im z)\<^sup>2 > 0"
   by (metis complex_eq_0 less_numeral_extra(3) sum_power2_gt_zero_iff)
 
 lemma complex_norm_square: "of_real ((norm z)\<^sup>2) = z * cnj z"
   by (cases z)
     (auto simp: complex_eq_iff norm_complex_def power2_eq_square[symmetric] of_real_power[symmetric]
       simp del: of_real_power)
 
 lemma complex_div_cnj: "a / b = (a * cnj b) / (norm b)\<^sup>2"
   using complex_norm_square by auto
 
 lemma Re_complex_div_eq_0: "Re (a / b) = 0 \<longleftrightarrow> Re (a * cnj b) = 0"
   by (auto simp add: Re_divide)
 
 lemma Im_complex_div_eq_0: "Im (a / b) = 0 \<longleftrightarrow> Im (a * cnj b) = 0"
   by (auto simp add: Im_divide)
 
 lemma complex_div_gt_0: "(Re (a / b) > 0 \<longleftrightarrow> Re (a * cnj b) > 0) \<and> (Im (a / b) > 0 \<longleftrightarrow> Im (a * cnj b) > 0)"
 proof (cases "b = 0")
   case True
   then show ?thesis by auto
 next
   case False
   then have "0 < (Re b)\<^sup>2 + (Im b)\<^sup>2"
     by (simp add: complex_eq_iff sum_power2_gt_zero_iff)
   then show ?thesis
     by (simp add: Re_divide Im_divide zero_less_divide_iff)
 qed
 
 lemma Re_complex_div_gt_0: "Re (a / b) > 0 \<longleftrightarrow> Re (a * cnj b) > 0"
   and Im_complex_div_gt_0: "Im (a / b) > 0 \<longleftrightarrow> Im (a * cnj b) > 0"
   using complex_div_gt_0 by auto
 
 lemma Re_complex_div_ge_0: "Re (a / b) \<ge> 0 \<longleftrightarrow> Re (a * cnj b) \<ge> 0"
   by (metis le_less Re_complex_div_eq_0 Re_complex_div_gt_0)
 
 lemma Im_complex_div_ge_0: "Im (a / b) \<ge> 0 \<longleftrightarrow> Im (a * cnj b) \<ge> 0"
   by (metis Im_complex_div_eq_0 Im_complex_div_gt_0 le_less)
 
 lemma Re_complex_div_lt_0: "Re (a / b) < 0 \<longleftrightarrow> Re (a * cnj b) < 0"
   by (metis less_asym neq_iff Re_complex_div_eq_0 Re_complex_div_gt_0)
 
 lemma Im_complex_div_lt_0: "Im (a / b) < 0 \<longleftrightarrow> Im (a * cnj b) < 0"
   by (metis Im_complex_div_eq_0 Im_complex_div_gt_0 less_asym neq_iff)
 
 lemma Re_complex_div_le_0: "Re (a / b) \<le> 0 \<longleftrightarrow> Re (a * cnj b) \<le> 0"
   by (metis not_le Re_complex_div_gt_0)
 
 lemma Im_complex_div_le_0: "Im (a / b) \<le> 0 \<longleftrightarrow> Im (a * cnj b) \<le> 0"
   by (metis Im_complex_div_gt_0 not_le)
 
 lemma Re_divide_of_real [simp]: "Re (z / of_real r) = Re z / r"
   by (simp add: Re_divide power2_eq_square)
 
 lemma Im_divide_of_real [simp]: "Im (z / of_real r) = Im z / r"
   by (simp add: Im_divide power2_eq_square)
 
 lemma Re_divide_Reals [simp]: "r \<in> \<real> \<Longrightarrow> Re (z / r) = Re z / Re r"
   by (metis Re_divide_of_real of_real_Re)
 
 lemma Im_divide_Reals [simp]: "r \<in> \<real> \<Longrightarrow> Im (z / r) = Im z / Re r"
   by (metis Im_divide_of_real of_real_Re)
 
 lemma Re_sum[simp]: "Re (sum f s) = (\<Sum>x\<in>s. Re (f x))"
   by (induct s rule: infinite_finite_induct) auto
 
 lemma Im_sum[simp]: "Im (sum f s) = (\<Sum>x\<in>s. Im(f x))"
   by (induct s rule: infinite_finite_induct) auto
 
 lemma sum_Re_le_cmod: "(\<Sum>i\<in>I. Re (z i)) \<le> cmod (\<Sum>i\<in>I. z i)"
   by (metis Re_sum complex_Re_le_cmod)
 
 lemma sum_Im_le_cmod: "(\<Sum>i\<in>I. Im (z i)) \<le> cmod (\<Sum>i\<in>I. z i)"
   by (smt (verit, best) Im_sum abs_Im_le_cmod sum.cong)
 
 lemma sums_complex_iff: "f sums x \<longleftrightarrow> ((\<lambda>x. Re (f x)) sums Re x) \<and> ((\<lambda>x. Im (f x)) sums Im x)"
   unfolding sums_def tendsto_complex_iff Im_sum Re_sum ..
 
 lemma summable_complex_iff: "summable f \<longleftrightarrow> summable (\<lambda>x. Re (f x)) \<and>  summable (\<lambda>x. Im (f x))"
   unfolding summable_def sums_complex_iff[abs_def] by (metis complex.sel)
 
 lemma summable_complex_of_real [simp]: "summable (\<lambda>n. complex_of_real (f n)) \<longleftrightarrow> summable f"
   unfolding summable_complex_iff by simp
 
 lemma summable_Re: "summable f \<Longrightarrow> summable (\<lambda>x. Re (f x))"
   unfolding summable_complex_iff by blast
 
 lemma summable_Im: "summable f \<Longrightarrow> summable (\<lambda>x. Im (f x))"
   unfolding summable_complex_iff by blast
 
 lemma complex_is_Nat_iff: "z \<in> \<nat> \<longleftrightarrow> Im z = 0 \<and> (\<exists>i. Re z = of_nat i)"
   by (auto simp: Nats_def complex_eq_iff)
 
 lemma complex_is_Int_iff: "z \<in> \<int> \<longleftrightarrow> Im z = 0 \<and> (\<exists>i. Re z = of_int i)"
   by (auto simp: Ints_def complex_eq_iff)
 
 lemma complex_is_Real_iff: "z \<in> \<real> \<longleftrightarrow> Im z = 0"
   by (auto simp: Reals_def complex_eq_iff)
 
 lemma Reals_cnj_iff: "z \<in> \<real> \<longleftrightarrow> cnj z = z"
   by (auto simp: complex_is_Real_iff complex_eq_iff)
 
 lemma in_Reals_norm: "z \<in> \<real> \<Longrightarrow> norm z = \<bar>Re z\<bar>"
   by (simp add: complex_is_Real_iff norm_complex_def)
 
 lemma Re_Reals_divide: "r \<in> \<real> \<Longrightarrow> Re (r / z) = Re r * Re z / (norm z)\<^sup>2"
   by (simp add: Re_divide complex_is_Real_iff cmod_power2)
 
 lemma Im_Reals_divide: "r \<in> \<real> \<Longrightarrow> Im (r / z) = -Re r * Im z / (norm z)\<^sup>2"
   by (simp add: Im_divide complex_is_Real_iff cmod_power2)
 
 lemma series_comparison_complex:
   fixes f:: "nat \<Rightarrow> 'a::banach"
   assumes sg: "summable g"
     and "\<And>n. g n \<in> \<real>" "\<And>n. Re (g n) \<ge> 0"
     and fg: "\<And>n. n \<ge> N \<Longrightarrow> norm(f n) \<le> norm(g n)"
   shows "summable f"
 proof -
   have g: "\<And>n. cmod (g n) = Re (g n)"
     using assms by (metis abs_of_nonneg in_Reals_norm)
   show ?thesis
     by (metis fg g sg summable_comparison_test summable_complex_iff)
 qed
 
 
 subsection \<open>Polar Form for Complex Numbers\<close>
 
 lemma complex_unimodular_polar:
   assumes "norm z = 1"
   obtains t where "0 \<le> t" "t < 2 * pi" "z = Complex (cos t) (sin t)"
   by (metis cmod_power2 one_power2 complex_surj sincos_total_2pi [of "Re z" "Im z"] assms)
 
 
 subsubsection \<open>$\cos \theta + i \sin \theta$\<close>
 
 primcorec cis :: "real \<Rightarrow> complex"
   where
     "Re (cis a) = cos a"
   | "Im (cis a) = sin a"
 
 lemma cis_zero [simp]: "cis 0 = 1"
   by (simp add: complex_eq_iff)
 
 lemma norm_cis [simp]: "norm (cis a) = 1"
   by (simp add: norm_complex_def)
 
 lemma sgn_cis [simp]: "sgn (cis a) = cis a"
   by (simp add: sgn_div_norm)
 
 lemma cis_2pi [simp]: "cis (2 * pi) = 1"
   by (simp add: cis.ctr complex_eq_iff)
 
 lemma cis_neq_zero [simp]: "cis a \<noteq> 0"
   by (metis norm_cis norm_zero zero_neq_one)
 
 lemma cis_cnj: "cnj (cis t) = cis (-t)"
   by (simp add: complex_eq_iff)
 
 lemma cis_mult: "cis a * cis b = cis (a + b)"
   by (simp add: complex_eq_iff cos_add sin_add)
 
 lemma DeMoivre: "(cis a) ^ n = cis (real n * a)"
   by (induct n) (simp_all add: algebra_simps cis_mult)
 
 lemma cis_inverse [simp]: "inverse (cis a) = cis (- a)"
   by (simp add: complex_eq_iff)
 
 lemma cis_divide: "cis a / cis b = cis (a - b)"
   by (simp add: divide_complex_def cis_mult)
 
+lemma divide_conv_cnj: "norm z = 1 \<Longrightarrow> x / z = x * cnj z"
+  by (metis complex_div_cnj div_by_1 mult_1 of_real_1 power2_eq_square)
+
+lemma i_not_in_Reals [simp, intro]: "\<i> \<notin> \<real>"
+  by (auto simp: complex_is_Real_iff)
+
+lemma powr_power_complex: "z \<noteq> 0 \<or> n \<noteq> 0 \<Longrightarrow> (z powr u :: complex) ^ n = z powr (of_nat n * u)"
+  by (induction n) (auto simp: algebra_simps powr_add)
+  
 lemma cos_n_Re_cis_pow_n: "cos (real n * a) = Re (cis a ^ n)"
   by (auto simp add: DeMoivre)
 
 lemma sin_n_Im_cis_pow_n: "sin (real n * a) = Im (cis a ^ n)"
   by (auto simp add: DeMoivre)
 
 lemma cis_pi [simp]: "cis pi = -1"
   by (simp add: complex_eq_iff)
 
 lemma cis_pi_half[simp]: "cis (pi / 2) = \<i>"
   by (simp add: cis.ctr complex_eq_iff)
 
 lemma cis_minus_pi_half[simp]: "cis (-(pi / 2)) = -\<i>"
   by (simp add: cis.ctr complex_eq_iff)
 
 lemma cis_multiple_2pi[simp]: "n \<in> \<int> \<Longrightarrow> cis (2 * pi * n) = 1"
   by (auto elim!: Ints_cases simp: cis.ctr one_complex.ctr)
 
+lemma minus_cis: "-cis x = cis (x + pi)"
+  by (simp flip: cis_mult)
+
+lemma minus_cis': "-cis x = cis (x - pi)"
+  by (simp flip: cis_divide)
 
 subsubsection \<open>$r(\cos \theta + i \sin \theta)$\<close>
 
 definition rcis :: "real \<Rightarrow> real \<Rightarrow> complex"
   where "rcis r a = complex_of_real r * cis a"
 
 lemma Re_rcis [simp]: "Re(rcis r a) = r * cos a"
   by (simp add: rcis_def)
 
 lemma Im_rcis [simp]: "Im(rcis r a) = r * sin a"
   by (simp add: rcis_def)
 
 lemma rcis_Ex: "\<exists>r a. z = rcis r a"
   by (simp add: complex_eq_iff polar_Ex)
 
 lemma complex_mod_rcis [simp]: "cmod (rcis r a) = \<bar>r\<bar>"
   by (simp add: rcis_def norm_mult)
 
 lemma cis_rcis_eq: "cis a = rcis 1 a"
   by (simp add: rcis_def)
 
 lemma rcis_mult: "rcis r1 a * rcis r2 b = rcis (r1 * r2) (a + b)"
   by (simp add: rcis_def cis_mult)
 
 lemma rcis_zero_mod [simp]: "rcis 0 a = 0"
   by (simp add: rcis_def)
 
 lemma rcis_zero_arg [simp]: "rcis r 0 = complex_of_real r"
   by (simp add: rcis_def)
 
 lemma rcis_eq_zero_iff [simp]: "rcis r a = 0 \<longleftrightarrow> r = 0"
   by (simp add: rcis_def)
 
 lemma DeMoivre2: "(rcis r a) ^ n = rcis (r ^ n) (real n * a)"
   by (simp add: rcis_def power_mult_distrib DeMoivre)
 
 lemma rcis_inverse: "inverse(rcis r a) = rcis (1 / r) (- a)"
   by (simp add: divide_inverse rcis_def)
 
 lemma rcis_divide: "rcis r1 a / rcis r2 b = rcis (r1 / r2) (a - b)"
   by (simp add: rcis_def cis_divide [symmetric])
 
 subsubsection \<open>Complex exponential\<close>
 
 lemma exp_Reals_eq:
   assumes "z \<in> \<real>"
   shows   "exp z = of_real (exp (Re z))"
   using assms by (auto elim!: Reals_cases simp: exp_of_real)
 
 lemma cis_conv_exp: "cis b = exp (\<i> * b)"
 proof -
   have "(\<i> * complex_of_real b) ^ n /\<^sub>R fact n =
       of_real (cos_coeff n * b^n) + \<i> * of_real (sin_coeff n * b^n)"
     for n :: nat
   proof -
     have "\<i> ^ n = fact n *\<^sub>R (cos_coeff n + \<i> * sin_coeff n)"
       by (induct n)
         (simp_all add: sin_coeff_Suc cos_coeff_Suc complex_eq_iff Re_divide Im_divide field_simps
           power2_eq_square add_nonneg_eq_0_iff)
     then show ?thesis
       by (simp add: field_simps)
   qed
   then show ?thesis
     using sin_converges [of b] cos_converges [of b]
     by (auto simp add: Complex_eq cis.ctr exp_def simp del: of_real_mult
         intro!: sums_unique sums_add sums_mult sums_of_real)
 qed
 
 lemma exp_eq_polar: "exp z = exp (Re z) * cis (Im z)"
   unfolding cis_conv_exp exp_of_real [symmetric] mult_exp_exp
   by (cases z) (simp add: Complex_eq)
 
 lemma Re_exp: "Re (exp z) = exp (Re z) * cos (Im z)"
   unfolding exp_eq_polar by simp
 
 lemma Im_exp: "Im (exp z) = exp (Re z) * sin (Im z)"
   unfolding exp_eq_polar by simp
 
 lemma norm_cos_sin [simp]: "norm (Complex (cos t) (sin t)) = 1"
   by (simp add: norm_complex_def)
 
 lemma norm_exp_eq_Re [simp]: "norm (exp z) = exp (Re z)"
   by (simp add: cis.code cmod_complex_polar exp_eq_polar Complex_eq)
 
 lemma complex_exp_exists: "\<exists>a r. z = complex_of_real r * exp a"
   using cis_conv_exp rcis_Ex rcis_def by force
 
 lemma exp_pi_i [simp]: "exp (of_real pi * \<i>) = -1"
   by (metis cis_conv_exp cis_pi mult.commute)
 
 lemma exp_pi_i' [simp]: "exp (\<i> * of_real pi) = -1"
   using cis_conv_exp cis_pi by auto
 
 lemma exp_two_pi_i [simp]: "exp (2 * of_real pi * \<i>) = 1"
   by (simp add: exp_eq_polar complex_eq_iff)
 
 lemma exp_two_pi_i' [simp]: "exp (\<i> * (of_real pi * 2)) = 1"
   by (metis exp_two_pi_i mult.commute)
 
 lemma continuous_on_cis [continuous_intros]:
   "continuous_on A f \<Longrightarrow> continuous_on A (\<lambda>x. cis (f x))"
   by (auto simp: cis_conv_exp intro!: continuous_intros)
 
 
 subsubsection \<open>Complex argument\<close>
 
 definition Arg :: "complex \<Rightarrow> real"
   where "Arg z = (if z = 0 then 0 else (SOME a. sgn z = cis a \<and> - pi < a \<and> a \<le> pi))"
 
 lemma Arg_zero: "Arg 0 = 0"
   by (simp add: Arg_def)
 
 lemma cis_Arg_unique:
   assumes "sgn z = cis x" and "-pi < x" and "x \<le> pi"
   shows "Arg z = x"
 proof -
   from assms have "z \<noteq> 0" by auto
   have "(SOME a. sgn z = cis a \<and> -pi < a \<and> a \<le> pi) = x"
   proof
     fix a
     define d where "d = a - x"
     assume a: "sgn z = cis a \<and> - pi < a \<and> a \<le> pi"
     from a assms have "- (2*pi) < d \<and> d < 2*pi"
       unfolding d_def by simp
     moreover
     from a assms have "cos a = cos x" and "sin a = sin x"
       by (simp_all add: complex_eq_iff)
     then have cos: "cos d = 1"
       by (simp add: d_def cos_diff)
     moreover from cos have "sin d = 0"
       by (rule cos_one_sin_zero)
     ultimately have "d = 0"
       by (auto simp: sin_zero_iff elim!: evenE dest!: less_2_cases)
     then show "a = x"
       by (simp add: d_def)
   qed (simp add: assms del: Re_sgn Im_sgn)
   with \<open>z \<noteq> 0\<close> show "Arg z = x"
     by (simp add: Arg_def)
 qed
 
 lemma Arg_correct:
   assumes "z \<noteq> 0"
   shows "sgn z = cis (Arg z) \<and> -pi < Arg z \<and> Arg z \<le> pi"
 proof (simp add: Arg_def assms, rule someI_ex)
   obtain r a where z: "z = rcis r a"
     using rcis_Ex by fast
   with assms have "r \<noteq> 0" by auto
   define b where "b = (if 0 < r then a else a + pi)"
   have b: "sgn z = cis b"
     using \<open>r \<noteq> 0\<close> by (simp add: z b_def rcis_def of_real_def sgn_scaleR sgn_if complex_eq_iff)
   have cis_2pi_nat: "cis (2 * pi * real_of_nat n) = 1" for n
     by (induct n) (simp_all add: distrib_left cis_mult [symmetric] complex_eq_iff)
   have cis_2pi_int: "cis (2 * pi * real_of_int x) = 1" for x
     by (cases x rule: int_diff_cases)
       (simp add: right_diff_distrib cis_divide [symmetric] cis_2pi_nat)
   define c where "c = b - 2 * pi * of_int \<lceil>(b - pi) / (2 * pi)\<rceil>"
   have "sgn z = cis c"
     by (simp add: b c_def cis_divide [symmetric] cis_2pi_int)
   moreover have "- pi < c \<and> c \<le> pi"
     using ceiling_correct [of "(b - pi) / (2*pi)"]
     by (simp add: c_def less_divide_eq divide_le_eq algebra_simps del: le_of_int_ceiling)
   ultimately show "\<exists>a. sgn z = cis a \<and> -pi < a \<and> a \<le> pi"
     by fast
 qed
 
 lemma Arg_bounded: "- pi < Arg z \<and> Arg z \<le> pi"
   by (cases "z = 0") (simp_all add: Arg_zero Arg_correct)
 
 lemma cis_Arg: "z \<noteq> 0 \<Longrightarrow> cis (Arg z) = sgn z"
   by (simp add: Arg_correct)
 
 lemma rcis_cmod_Arg: "rcis (cmod z) (Arg z) = z"
   by (cases "z = 0") (simp_all add: rcis_def cis_Arg sgn_div_norm of_real_def)
 
 lemma rcis_cnj:
   shows "cnj a = rcis (cmod a) (- Arg a)"
   by (metis cis_cnj complex_cnj_complex_of_real complex_cnj_mult rcis_cmod_Arg rcis_def)
 
 lemma cos_Arg_i_mult_zero [simp]: "y \<noteq> 0 \<Longrightarrow> Re y = 0 \<Longrightarrow> cos (Arg y) = 0"
   using cis_Arg [of y] by (simp add: complex_eq_iff)
 
 lemma Arg_ii [simp]: "Arg \<i> = pi/2"
   by (rule cis_Arg_unique; simp add: sgn_eq)
 
 lemma Arg_minus_ii [simp]: "Arg (-\<i>) = -pi/2"
 proof (rule cis_Arg_unique)
   show "sgn (- \<i>) = cis (- pi / 2)"
     by (simp add: sgn_eq)
   show "- pi / 2 \<le> pi"
     using pi_not_less_zero by linarith
 qed auto
 
 subsection \<open>Complex n-th roots\<close>
 
 lemma bij_betw_roots_unity:
   assumes "n > 0"
   shows   "bij_betw (\<lambda>k. cis (2 * pi * real k / real n)) {..<n} {z. z ^ n = 1}"
     (is "bij_betw ?f _ _")
   unfolding bij_betw_def
 proof (intro conjI)
   show inj: "inj_on ?f {..<n}" unfolding inj_on_def
   proof (safe, goal_cases)
     case (1 k l)
     hence kl: "k < n" "l < n" by simp_all
     from 1 have "1 = ?f k / ?f l" by simp
     also have "\<dots> = cis (2*pi*(real k - real l)/n)"
       using assms by (simp add: field_simps cis_divide)
     finally have "cos (2*pi*(real k - real l) / n) = 1"
       by (simp add: complex_eq_iff)
     then obtain m :: int where "2 * pi * (real k - real l) / real n = real_of_int m * 2 * pi"
       by (subst (asm) cos_one_2pi_int) blast
     hence "real_of_int (int k - int l) = real_of_int (m * int n)"
       unfolding of_int_diff of_int_mult using assms
       by (simp add: nonzero_divide_eq_eq)
     also note of_int_eq_iff
     finally have *: "abs m * n = abs (int k - int l)" by (simp add: abs_mult)
     also have "\<dots> < int n" using kl by linarith
     finally have "m = 0" using assms by simp
     with * show "k = l" by simp
   qed
 
   have subset: "?f ` {..<n} \<subseteq> {z. z ^ n = 1}"
   proof safe
     fix k :: nat
     have "cis (2 * pi * real k / real n) ^ n = cis (2 * pi) ^ k"
       using assms by (simp add: DeMoivre mult_ac)
     also have "cis (2 * pi) = 1" by (simp add: complex_eq_iff)
     finally show "?f k ^ n = 1" by simp
   qed
 
   have "n = card {..<n}" by simp
   also from assms and subset have "\<dots> \<le> card {z::complex. z ^ n = 1}"
     by (intro card_inj_on_le[OF inj]) (auto simp: finite_roots_unity)
   finally have card: "card {z::complex. z ^ n = 1} = n"
     using assms by (intro antisym card_roots_unity) auto
 
   have "card (?f ` {..<n}) = card {z::complex. z ^ n = 1}"
     using card inj by (subst card_image) auto
   with subset and assms show "?f ` {..<n} = {z::complex. z ^ n = 1}"
     by (intro card_subset_eq finite_roots_unity) auto
 qed
 
 lemma card_roots_unity_eq:
   assumes "n > 0"
   shows   "card {z::complex. z ^ n = 1} = n"
   using bij_betw_same_card [OF bij_betw_roots_unity [OF assms]] by simp
 
 lemma bij_betw_nth_root_unity:
   fixes c :: complex and n :: nat
   assumes c: "c \<noteq> 0" and n: "n > 0"
   defines "c' \<equiv> root n (norm c) * cis (Arg c / n)"
   shows "bij_betw (\<lambda>z. c' * z) {z. z ^ n = 1} {z. z ^ n = c}"
 proof -
   have "c' ^ n = of_real (root n (norm c) ^ n) * cis (Arg c)"
     unfolding of_real_power using n by (simp add: c'_def power_mult_distrib DeMoivre)
   also from n have "root n (norm c) ^ n = norm c" by simp
   also from c have "of_real \<dots> * cis (Arg c) = c" by (simp add: cis_Arg Complex.sgn_eq)
   finally have [simp]: "c' ^ n = c" .
 
   show ?thesis unfolding bij_betw_def inj_on_def
   proof safe
     fix z :: complex assume "z ^ n = 1"
     hence "(c' * z) ^ n = c' ^ n" by (simp add: power_mult_distrib)
     also have "c' ^ n = of_real (root n (norm c) ^ n) * cis (Arg c)"
       unfolding of_real_power using n by (simp add: c'_def power_mult_distrib DeMoivre)
     also from n have "root n (norm c) ^ n = norm c" by simp
     also from c have "\<dots> * cis (Arg c) = c" by (simp add: cis_Arg Complex.sgn_eq)
     finally show "(c' * z) ^ n = c" .
   next
     fix z assume z: "c = z ^ n"
     define z' where "z' = z / c'"
     from c and n have "c' \<noteq> 0" by (auto simp: c'_def)
     with n c have "z = c' * z'" and "z' ^ n = 1"
       by (auto simp: z'_def power_divide z)
     thus "z \<in> (\<lambda>z. c' * z) ` {z. z ^ n = 1}" by blast
   qed (insert c n, auto simp: c'_def)
 qed
 
 lemma finite_nth_roots [intro]:
   assumes "n > 0"
   shows   "finite {z::complex. z ^ n = c}"
 proof (cases "c = 0")
   case True
   with assms have "{z::complex. z ^ n = c} = {0}" by auto
   thus ?thesis by simp
 next
   case False
   from assms have "finite {z::complex. z ^ n = 1}" by (intro finite_roots_unity) simp_all
   also have "?this \<longleftrightarrow> ?thesis"
     by (rule bij_betw_finite, rule bij_betw_nth_root_unity) fact+
   finally show ?thesis .
 qed
 
 lemma card_nth_roots:
   assumes "c \<noteq> 0" "n > 0"
   shows   "card {z::complex. z ^ n = c} = n"
 proof -
   have "card {z. z ^ n = c} = card {z::complex. z ^ n = 1}"
     by (rule sym, rule bij_betw_same_card, rule bij_betw_nth_root_unity) fact+
   also have "\<dots> = n" by (rule card_roots_unity_eq) fact+
   finally show ?thesis .
 qed
 
 lemma sum_roots_unity:
   assumes "n > 1"
   shows   "\<Sum>{z::complex. z ^ n = 1} = 0"
 proof -
   define \<omega> where "\<omega> = cis (2 * pi / real n)"
   have [simp]: "\<omega> \<noteq> 1"
   proof
     assume "\<omega> = 1"
     with assms obtain k :: int where "2 * pi / real n = 2 * pi * of_int k"
       by (auto simp: \<omega>_def complex_eq_iff cos_one_2pi_int)
     with assms have "real n * of_int k = 1" by (simp add: field_simps)
     also have "real n * of_int k = of_int (int n * k)" by simp
     also have "1 = (of_int 1 :: real)" by simp
     also note of_int_eq_iff
     finally show False using assms by (auto simp: zmult_eq_1_iff)
   qed
 
   have "(\<Sum>z | z ^ n = 1. z :: complex) = (\<Sum>k<n. cis (2 * pi * real k / real n))"
     using assms by (intro sum.reindex_bij_betw [symmetric] bij_betw_roots_unity) auto
   also have "\<dots> = (\<Sum>k<n. \<omega> ^ k)"
     by (intro sum.cong refl) (auto simp: \<omega>_def DeMoivre mult_ac)
   also have "\<dots> = (\<omega> ^ n - 1) / (\<omega> - 1)"
     by (subst geometric_sum) auto
   also have "\<omega> ^ n - 1 = cis (2 * pi) - 1" using assms by (auto simp: \<omega>_def DeMoivre)
   also have "\<dots> = 0" by (simp add: complex_eq_iff)
   finally show ?thesis by simp
 qed
 
 lemma sum_nth_roots:
   assumes "n > 1"
   shows   "\<Sum>{z::complex. z ^ n = c} = 0"
 proof (cases "c = 0")
   case True
   with assms have "{z::complex. z ^ n = c} = {0}" by auto
   also have "\<Sum>\<dots> = 0" by simp
   finally show ?thesis .
 next
   case False
   define c' where "c' = root n (norm c) * cis (Arg c / n)"
   from False and assms have "(\<Sum>{z. z ^ n = c}) = (\<Sum>z | z ^ n = 1. c' * z)"
     by (subst sum.reindex_bij_betw [OF bij_betw_nth_root_unity, symmetric])
        (auto simp: sum_distrib_left finite_roots_unity c'_def)
   also from assms have "\<dots> = 0"
     by (simp add: sum_distrib_left [symmetric] sum_roots_unity)
   finally show ?thesis .
 qed
 
 subsection \<open>Square root of complex numbers\<close>
 
 primcorec csqrt :: "complex \<Rightarrow> complex"
   where
     "Re (csqrt z) = sqrt ((cmod z + Re z) / 2)"
   | "Im (csqrt z) = (if Im z = 0 then 1 else sgn (Im z)) * sqrt ((cmod z - Re z) / 2)"
 
 lemma csqrt_of_real_nonneg [simp]: "Im x = 0 \<Longrightarrow> Re x \<ge> 0 \<Longrightarrow> csqrt x = sqrt (Re x)"
   by (simp add: complex_eq_iff norm_complex_def)
 
 lemma csqrt_of_real_nonpos [simp]: "Im x = 0 \<Longrightarrow> Re x \<le> 0 \<Longrightarrow> csqrt x = \<i> * sqrt \<bar>Re x\<bar>"
   by (simp add: complex_eq_iff norm_complex_def)
 
 lemma of_real_sqrt: "x \<ge> 0 \<Longrightarrow> of_real (sqrt x) = csqrt (of_real x)"
   by (simp add: complex_eq_iff norm_complex_def)
 
 lemma csqrt_0 [simp]: "csqrt 0 = 0"
   by simp
 
 lemma csqrt_1 [simp]: "csqrt 1 = 1"
   by simp
 
 lemma csqrt_ii [simp]: "csqrt \<i> = (1 + \<i>) / sqrt 2"
   by (simp add: complex_eq_iff Re_divide Im_divide real_sqrt_divide real_div_sqrt)
 
 lemma power2_csqrt[simp,algebra]: "(csqrt z)\<^sup>2 = z"
 proof (cases "Im z = 0")
   case True
   then show ?thesis
     using real_sqrt_pow2[of "Re z"] real_sqrt_pow2[of "- Re z"]
     by (cases "0::real" "Re z" rule: linorder_cases)
       (simp_all add: complex_eq_iff Re_power2 Im_power2 power2_eq_square cmod_eq_Re)
 next
   case False
   moreover have "cmod z * cmod z - Re z * Re z = Im z * Im z"
     by (simp add: norm_complex_def power2_eq_square)
   moreover have "\<bar>Re z\<bar> \<le> cmod z"
     by (simp add: norm_complex_def)
   ultimately show ?thesis
     by (simp add: Re_power2 Im_power2 complex_eq_iff real_sgn_eq
         field_simps real_sqrt_mult[symmetric] real_sqrt_divide)
 qed
 
+lemma norm_csqrt [simp]: "norm (csqrt z) = sqrt (norm z)"
+  by (metis abs_of_nonneg norm_ge_zero norm_mult power2_csqrt power2_eq_square real_sqrt_abs)
+
 lemma csqrt_eq_0 [simp]: "csqrt z = 0 \<longleftrightarrow> z = 0"
   by auto (metis power2_csqrt power_eq_0_iff)
 
 lemma csqrt_eq_1 [simp]: "csqrt z = 1 \<longleftrightarrow> z = 1"
   by auto (metis power2_csqrt power2_eq_1_iff)
 
 lemma csqrt_principal: "0 < Re (csqrt z) \<or> Re (csqrt z) = 0 \<and> 0 \<le> Im (csqrt z)"
   by (auto simp add: not_less cmod_plus_Re_le_0_iff Im_eq_0)
 
 lemma Re_csqrt: "0 \<le> Re (csqrt z)"
   by (metis csqrt_principal le_less)
 
 lemma csqrt_square:
   assumes "0 < Re b \<or> (Re b = 0 \<and> 0 \<le> Im b)"
   shows "csqrt (b^2) = b"
 proof -
   have "csqrt (b^2) = b \<or> csqrt (b^2) = - b"
     by (simp add: power2_eq_iff[symmetric])
   moreover have "csqrt (b^2) \<noteq> -b \<or> b = 0"
     using csqrt_principal[of "b ^ 2"] assms
     by (intro disjCI notI) (auto simp: complex_eq_iff)
   ultimately show ?thesis
     by auto
 qed
 
 lemma csqrt_unique: "w\<^sup>2 = z \<Longrightarrow> 0 < Re w \<or> Re w = 0 \<and> 0 \<le> Im w \<Longrightarrow> csqrt z = w"
   by (auto simp: csqrt_square)
 
 lemma csqrt_minus [simp]:
   assumes "Im x < 0 \<or> (Im x = 0 \<and> 0 \<le> Re x)"
   shows "csqrt (- x) = \<i> * csqrt x"
 proof -
   have "csqrt ((\<i> * csqrt x)^2) = \<i> * csqrt x"
   proof (rule csqrt_square)
     have "Im (csqrt x) \<le> 0"
       using assms by (auto simp add: cmod_eq_Re mult_le_0_iff field_simps complex_Re_le_cmod)
     then show "0 < Re (\<i> * csqrt x) \<or> Re (\<i> * csqrt x) = 0 \<and> 0 \<le> Im (\<i> * csqrt x)"
       by (auto simp add: Re_csqrt simp del: csqrt.simps)
   qed
   also have "(\<i> * csqrt x)^2 = - x"
     by (simp add: power_mult_distrib)
   finally show ?thesis .
 qed
 
 
 text \<open>Legacy theorem names\<close>
 
 lemmas cmod_def = norm_complex_def
 
 lemma legacy_Complex_simps:
   shows Complex_eq_0: "Complex a b = 0 \<longleftrightarrow> a = 0 \<and> b = 0"
     and complex_add: "Complex a b + Complex c d = Complex (a + c) (b + d)"
     and complex_minus: "- (Complex a b) = Complex (- a) (- b)"
     and complex_diff: "Complex a b - Complex c d = Complex (a - c) (b - d)"
     and Complex_eq_1: "Complex a b = 1 \<longleftrightarrow> a = 1 \<and> b = 0"
     and Complex_eq_neg_1: "Complex a b = - 1 \<longleftrightarrow> a = - 1 \<and> b = 0"
     and complex_mult: "Complex a b * Complex c d = Complex (a * c - b * d) (a * d + b * c)"
     and complex_inverse: "inverse (Complex a b) = Complex (a / (a\<^sup>2 + b\<^sup>2)) (- b / (a\<^sup>2 + b\<^sup>2))"
     and Complex_eq_numeral: "Complex a b = numeral w \<longleftrightarrow> a = numeral w \<and> b = 0"
     and Complex_eq_neg_numeral: "Complex a b = - numeral w \<longleftrightarrow> a = - numeral w \<and> b = 0"
     and complex_scaleR: "scaleR r (Complex a b) = Complex (r * a) (r * b)"
     and Complex_eq_i: "Complex x y = \<i> \<longleftrightarrow> x = 0 \<and> y = 1"
     and i_mult_Complex: "\<i> * Complex a b = Complex (- b) a"
     and Complex_mult_i: "Complex a b * \<i> = Complex (- b) a"
     and i_complex_of_real: "\<i> * complex_of_real r = Complex 0 r"
     and complex_of_real_i: "complex_of_real r * \<i> = Complex 0 r"
     and Complex_add_complex_of_real: "Complex x y + complex_of_real r = Complex (x+r) y"
     and complex_of_real_add_Complex: "complex_of_real r + Complex x y = Complex (r+x) y"
     and Complex_mult_complex_of_real: "Complex x y * complex_of_real r = Complex (x*r) (y*r)"
     and complex_of_real_mult_Complex: "complex_of_real r * Complex x y = Complex (r*x) (r*y)"
     and complex_eq_cancel_iff2: "(Complex x y = complex_of_real xa) = (x = xa \<and> y = 0)"
     and complex_cnj: "cnj (Complex a b) = Complex a (- b)"
     and Complex_sum': "sum (\<lambda>x. Complex (f x) 0) s = Complex (sum f s) 0"
     and Complex_sum: "Complex (sum f s) 0 = sum (\<lambda>x. Complex (f x) 0) s"
     and complex_of_real_def: "complex_of_real r = Complex r 0"
     and complex_norm: "cmod (Complex x y) = sqrt (x\<^sup>2 + y\<^sup>2)"
   by (simp_all add: norm_complex_def field_simps complex_eq_iff Re_divide Im_divide)
 
 lemma Complex_in_Reals: "Complex x 0 \<in> \<real>"
   by (metis Reals_of_real complex_of_real_def)
 
 text \<open>Express a complex number as a linear combination of two others, not collinear with the origin\<close>
 lemma complex_axes:
   assumes "Im (y/x) \<noteq> 0"
   obtains a b where "z = of_real a * x + of_real b * y"
 proof -
   define dd where "dd \<equiv> Re y * Im x -  Im y * Re x"
   define a where "a = (Im z * Re y - Re z * Im y) / dd"
   define b where "b = (Re z * Im x - Im z * Re x) / dd"
   have "dd \<noteq> 0" 
     using assms by (auto simp: dd_def Im_complex_div_eq_0)
   have "a * Re x + b * Re y = Re z"
     using \<open>dd \<noteq> 0\<close>  
     apply (simp add: a_def b_def field_simps)
     by (metis dd_def diff_add_cancel distrib_right mult.assoc mult.commute)
   moreover have "a * Im x + b * Im y = Im z"
     using \<open>dd \<noteq> 0\<close> 
     apply (simp add: a_def b_def field_simps)
     by (metis (no_types) dd_def diff_add_cancel distrib_right mult.assoc mult.commute)
   ultimately have "z = of_real a * x + of_real b * y"
     by (simp add: complex_eqI)
   then show ?thesis using that by simp
 qed
 
 
 end
diff --git a/src/HOL/Deriv.thy b/src/HOL/Deriv.thy
--- a/src/HOL/Deriv.thy
+++ b/src/HOL/Deriv.thy
@@ -1,2427 +1,2430 @@
 (*  Title:      HOL/Deriv.thy
     Author:     Jacques D. Fleuriot, University of Cambridge, 1998
     Author:     Brian Huffman
     Author:     Lawrence C Paulson, 2004
     Author:     Benjamin Porter, 2005
 *)
 
 section \<open>Differentiation\<close>
 
 theory Deriv
   imports Limits
 begin
 
 subsection \<open>Frechet derivative\<close>
 
 definition has_derivative :: "('a::real_normed_vector \<Rightarrow> 'b::real_normed_vector) \<Rightarrow>
     ('a \<Rightarrow> 'b) \<Rightarrow> 'a filter \<Rightarrow> bool"  (infix "(has'_derivative)" 50)
   where "(f has_derivative f') F \<longleftrightarrow>
     bounded_linear f' \<and>
     ((\<lambda>y. ((f y - f (Lim F (\<lambda>x. x))) - f' (y - Lim F (\<lambda>x. x))) /\<^sub>R norm (y - Lim F (\<lambda>x. x))) \<longlongrightarrow> 0) F"
 
 text \<open>
   Usually the filter \<^term>\<open>F\<close> is \<^term>\<open>at x within s\<close>.  \<^term>\<open>(f has_derivative D)
   (at x within s)\<close> means: \<^term>\<open>D\<close> is the derivative of function \<^term>\<open>f\<close> at point \<^term>\<open>x\<close>
   within the set \<^term>\<open>s\<close>. Where \<^term>\<open>s\<close> is used to express left or right sided derivatives. In
   most cases \<^term>\<open>s\<close> is either a variable or \<^term>\<open>UNIV\<close>.
 \<close>
 
 text \<open>These are the only cases we'll care about, probably.\<close>
 
 lemma has_derivative_within: "(f has_derivative f') (at x within s) \<longleftrightarrow>
     bounded_linear f' \<and> ((\<lambda>y. (1 / norm(y - x)) *\<^sub>R (f y - (f x + f' (y - x)))) \<longlongrightarrow> 0) (at x within s)"
   unfolding has_derivative_def tendsto_iff
   by (subst eventually_Lim_ident_at) (auto simp add: field_simps)
 
 lemma has_derivative_eq_rhs: "(f has_derivative f') F \<Longrightarrow> f' = g' \<Longrightarrow> (f has_derivative g') F"
   by simp
 
 definition has_field_derivative :: "('a::real_normed_field \<Rightarrow> 'a) \<Rightarrow> 'a \<Rightarrow> 'a filter \<Rightarrow> bool"
     (infix "(has'_field'_derivative)" 50)
   where "(f has_field_derivative D) F \<longleftrightarrow> (f has_derivative (*) D) F"
 
 lemma DERIV_cong: "(f has_field_derivative X) F \<Longrightarrow> X = Y \<Longrightarrow> (f has_field_derivative Y) F"
   by simp
 
 definition has_vector_derivative :: "(real \<Rightarrow> 'b::real_normed_vector) \<Rightarrow> 'b \<Rightarrow> real filter \<Rightarrow> bool"
     (infix "has'_vector'_derivative" 50)
   where "(f has_vector_derivative f') net \<longleftrightarrow> (f has_derivative (\<lambda>x. x *\<^sub>R f')) net"
 
 lemma has_vector_derivative_eq_rhs:
   "(f has_vector_derivative X) F \<Longrightarrow> X = Y \<Longrightarrow> (f has_vector_derivative Y) F"
   by simp
 
 named_theorems derivative_intros "structural introduction rules for derivatives"
 setup \<open>
   let
     val eq_thms = @{thms has_derivative_eq_rhs DERIV_cong has_vector_derivative_eq_rhs}
     fun eq_rule thm = get_first (try (fn eq_thm => eq_thm OF [thm])) eq_thms
   in
     Global_Theory.add_thms_dynamic
       (\<^binding>\<open>derivative_eq_intros\<close>,
         fn context =>
           Named_Theorems.get (Context.proof_of context) \<^named_theorems>\<open>derivative_intros\<close>
           |> map_filter eq_rule)
   end
 \<close>
 
 text \<open>
   The following syntax is only used as a legacy syntax.
 \<close>
 abbreviation (input)
   FDERIV :: "('a::real_normed_vector \<Rightarrow> 'b::real_normed_vector) \<Rightarrow> 'a \<Rightarrow>  ('a \<Rightarrow> 'b) \<Rightarrow> bool"
   ("(FDERIV (_)/ (_)/ :> (_))" [1000, 1000, 60] 60)
   where "FDERIV f x :> f' \<equiv> (f has_derivative f') (at x)"
 
 lemma has_derivative_bounded_linear: "(f has_derivative f') F \<Longrightarrow> bounded_linear f'"
   by (simp add: has_derivative_def)
 
 lemma has_derivative_linear: "(f has_derivative f') F \<Longrightarrow> linear f'"
   using bounded_linear.linear[OF has_derivative_bounded_linear] .
 
 lemma has_derivative_ident[derivative_intros, simp]: "((\<lambda>x. x) has_derivative (\<lambda>x. x)) F"
   by (simp add: has_derivative_def)
 
-lemma has_derivative_id [derivative_intros, simp]: "(id has_derivative id) (at a)"
+lemma has_derivative_id [derivative_intros, simp]: "(id has_derivative id) F"
   by (metis eq_id_iff has_derivative_ident)
 
+lemma shift_has_derivative_id: "((+) d has_derivative (\<lambda>x. x)) F"
+  using has_derivative_def by fastforce
+
 lemma has_derivative_const[derivative_intros, simp]: "((\<lambda>x. c) has_derivative (\<lambda>x. 0)) F"
   by (simp add: has_derivative_def)
 
 lemma (in bounded_linear) bounded_linear: "bounded_linear f" ..
 
 lemma (in bounded_linear) has_derivative:
   "(g has_derivative g') F \<Longrightarrow> ((\<lambda>x. f (g x)) has_derivative (\<lambda>x. f (g' x))) F"
   unfolding has_derivative_def
   by (auto simp add: bounded_linear_compose [OF bounded_linear] scaleR diff dest: tendsto)
 
 lemmas has_derivative_scaleR_right [derivative_intros] =
   bounded_linear.has_derivative [OF bounded_linear_scaleR_right]
 
 lemmas has_derivative_scaleR_left [derivative_intros] =
   bounded_linear.has_derivative [OF bounded_linear_scaleR_left]
 
 lemmas has_derivative_mult_right [derivative_intros] =
   bounded_linear.has_derivative [OF bounded_linear_mult_right]
 
 lemmas has_derivative_mult_left [derivative_intros] =
   bounded_linear.has_derivative [OF bounded_linear_mult_left]
 
 lemmas has_derivative_of_real[derivative_intros, simp] = 
   bounded_linear.has_derivative[OF bounded_linear_of_real] 
 
 lemma has_derivative_add[simp, derivative_intros]:
   assumes f: "(f has_derivative f') F"
     and g: "(g has_derivative g') F"
   shows "((\<lambda>x. f x + g x) has_derivative (\<lambda>x. f' x + g' x)) F"
   unfolding has_derivative_def
 proof safe
   let ?x = "Lim F (\<lambda>x. x)"
   let ?D = "\<lambda>f f' y. ((f y - f ?x) - f' (y - ?x)) /\<^sub>R norm (y - ?x)"
   have "((\<lambda>x. ?D f f' x + ?D g g' x) \<longlongrightarrow> (0 + 0)) F"
     using f g by (intro tendsto_add) (auto simp: has_derivative_def)
   then show "(?D (\<lambda>x. f x + g x) (\<lambda>x. f' x + g' x) \<longlongrightarrow> 0) F"
     by (simp add: field_simps scaleR_add_right scaleR_diff_right)
 qed (blast intro: bounded_linear_add f g has_derivative_bounded_linear)
 
 lemma has_derivative_sum[simp, derivative_intros]:
   "(\<And>i. i \<in> I \<Longrightarrow> (f i has_derivative f' i) F) \<Longrightarrow>
     ((\<lambda>x. \<Sum>i\<in>I. f i x) has_derivative (\<lambda>x. \<Sum>i\<in>I. f' i x)) F"
   by (induct I rule: infinite_finite_induct) simp_all
 
 lemma has_derivative_minus[simp, derivative_intros]:
   "(f has_derivative f') F \<Longrightarrow> ((\<lambda>x. - f x) has_derivative (\<lambda>x. - f' x)) F"
   using has_derivative_scaleR_right[of f f' F "-1"] by simp
 
 lemma has_derivative_diff[simp, derivative_intros]:
   "(f has_derivative f') F \<Longrightarrow> (g has_derivative g') F \<Longrightarrow>
     ((\<lambda>x. f x - g x) has_derivative (\<lambda>x. f' x - g' x)) F"
   by (simp only: diff_conv_add_uminus has_derivative_add has_derivative_minus)
 
 lemma has_derivative_at_within:
   "(f has_derivative f') (at x within s) \<longleftrightarrow>
     (bounded_linear f' \<and> ((\<lambda>y. ((f y - f x) - f' (y - x)) /\<^sub>R norm (y - x)) \<longlongrightarrow> 0) (at x within s))"
 proof (cases "at x within s = bot")
   case True
   then show ?thesis
     by (metis (no_types, lifting) has_derivative_within tendsto_bot)
 next
   case False
   then show ?thesis
   by (simp add: Lim_ident_at has_derivative_def)
 qed
 
 lemma has_derivative_iff_norm:
   "(f has_derivative f') (at x within s) \<longleftrightarrow>
     bounded_linear f' \<and> ((\<lambda>y. norm ((f y - f x) - f' (y - x)) / norm (y - x)) \<longlongrightarrow> 0) (at x within s)"
   using tendsto_norm_zero_iff[of _ "at x within s", where 'b="'b", symmetric]
   by (simp add: has_derivative_at_within divide_inverse ac_simps)
 
 lemma has_derivative_at:
   "(f has_derivative D) (at x) \<longleftrightarrow>
     (bounded_linear D \<and> (\<lambda>h. norm (f (x + h) - f x - D h) / norm h) \<midarrow>0\<rightarrow> 0)"
   by (simp add: has_derivative_iff_norm LIM_offset_zero_iff)
 
 lemma field_has_derivative_at:
   fixes x :: "'a::real_normed_field"
   shows "(f has_derivative (*) D) (at x) \<longleftrightarrow> (\<lambda>h. (f (x + h) - f x) / h) \<midarrow>0\<rightarrow> D" (is "?lhs = ?rhs")
 proof -
   have "?lhs = (\<lambda>h. norm (f (x + h) - f x - D * h) / norm h) \<midarrow>0 \<rightarrow> 0"
     by (simp add: bounded_linear_mult_right has_derivative_at)
   also have "... = (\<lambda>y. norm ((f (x + y) - f x - D * y) / y)) \<midarrow>0\<rightarrow> 0"
     by (simp cong: LIM_cong flip: nonzero_norm_divide)
   also have "... = (\<lambda>y. norm ((f (x + y) - f x) / y - D / y * y)) \<midarrow>0\<rightarrow> 0"
     by (simp only: diff_divide_distrib times_divide_eq_left [symmetric])
   also have "... = ?rhs"
     by (simp add: tendsto_norm_zero_iff LIM_zero_iff cong: LIM_cong)
   finally show ?thesis .
 qed
 
 lemma has_derivative_iff_Ex:
   "(f has_derivative f') (at x) \<longleftrightarrow>
     bounded_linear f' \<and> (\<exists>e. (\<forall>h. f (x+h) = f x + f' h + e h) \<and> ((\<lambda>h. norm (e h) / norm h) \<longlongrightarrow> 0) (at 0))"
   unfolding has_derivative_at by force
 
 lemma has_derivative_at_within_iff_Ex:
   assumes "x \<in> S" "open S"
   shows "(f has_derivative f') (at x within S) \<longleftrightarrow>
          bounded_linear f' \<and> (\<exists>e. (\<forall>h. x+h \<in> S \<longrightarrow> f (x+h) = f x + f' h + e h) \<and> ((\<lambda>h. norm (e h) / norm h) \<longlongrightarrow> 0) (at 0))"
     (is "?lhs = ?rhs")
 proof safe
   show "bounded_linear f'"
     if "(f has_derivative f') (at x within S)"
     using has_derivative_bounded_linear that by blast
   show "\<exists>e. (\<forall>h. x + h \<in> S \<longrightarrow> f (x + h) = f x + f' h + e h) \<and> (\<lambda>h. norm (e h) / norm h) \<midarrow>0\<rightarrow> 0"
     if "(f has_derivative f') (at x within S)"
     by (metis (full_types) assms that has_derivative_iff_Ex at_within_open)
   show "(f has_derivative f') (at x within S)"
     if "bounded_linear f'"
       and eq [rule_format]: "\<forall>h. x + h \<in> S \<longrightarrow> f (x + h) = f x + f' h + e h"
       and 0: "(\<lambda>h. norm (e (h::'a)::'b) / norm h) \<midarrow>0\<rightarrow> 0"
     for e 
   proof -
     have 1: "f y - f x = f' (y-x) + e (y-x)" if "y \<in> S" for y
       using eq [of "y-x"] that by simp
     have 2: "((\<lambda>y. norm (e (y-x)) / norm (y - x)) \<longlongrightarrow> 0) (at x within S)"
       by (simp add: "0" assms tendsto_offset_zero_iff)
     have "((\<lambda>y. norm (f y - f x - f' (y - x)) / norm (y - x)) \<longlongrightarrow> 0) (at x within S)"
       by (simp add: Lim_cong_within 1 2)
     then show ?thesis
       by (simp add: has_derivative_iff_norm \<open>bounded_linear f'\<close>)
   qed
 qed
 
 lemma has_derivativeI:
   "bounded_linear f' \<Longrightarrow>
     ((\<lambda>y. ((f y - f x) - f' (y - x)) /\<^sub>R norm (y - x)) \<longlongrightarrow> 0) (at x within s) \<Longrightarrow>
     (f has_derivative f') (at x within s)"
   by (simp add: has_derivative_at_within)
 
 lemma has_derivativeI_sandwich:
   assumes e: "0 < e"
     and bounded: "bounded_linear f'"
     and sandwich: "(\<And>y. y \<in> s \<Longrightarrow> y \<noteq> x \<Longrightarrow> dist y x < e \<Longrightarrow>
       norm ((f y - f x) - f' (y - x)) / norm (y - x) \<le> H y)"
     and "(H \<longlongrightarrow> 0) (at x within s)"
   shows "(f has_derivative f') (at x within s)"
   unfolding has_derivative_iff_norm
 proof safe
   show "((\<lambda>y. norm (f y - f x - f' (y - x)) / norm (y - x)) \<longlongrightarrow> 0) (at x within s)"
   proof (rule tendsto_sandwich[where f="\<lambda>x. 0"])
     show "(H \<longlongrightarrow> 0) (at x within s)" by fact
     show "eventually (\<lambda>n. norm (f n - f x - f' (n - x)) / norm (n - x) \<le> H n) (at x within s)"
       unfolding eventually_at using e sandwich by auto
   qed (auto simp: le_divide_eq)
 qed fact
 
 lemma has_derivative_subset:
   "(f has_derivative f') (at x within s) \<Longrightarrow> t \<subseteq> s \<Longrightarrow> (f has_derivative f') (at x within t)"
   by (auto simp add: has_derivative_iff_norm intro: tendsto_within_subset)
 
 lemma has_derivative_within_singleton_iff:
   "(f has_derivative g) (at x within {x}) \<longleftrightarrow> bounded_linear g"
   by (auto intro!: has_derivativeI_sandwich[where e=1] has_derivative_bounded_linear)
 
 
 subsubsection \<open>Limit transformation for derivatives\<close>
 
 lemma has_derivative_transform_within:
   assumes "(f has_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_derivative f') (at x within s)"
   using assms
   unfolding has_derivative_within
   by (force simp add: intro: Lim_transform_within)
 
 lemma has_derivative_transform_within_open:
   assumes "(f has_derivative f') (at x within t)"
     and "open s"
     and "x \<in> s"
     and "\<And>x. x\<in>s \<Longrightarrow> f x = g x"
   shows "(g has_derivative f') (at x within t)"
   using assms unfolding has_derivative_within
   by (force simp add: intro: Lim_transform_within_open)
 
 lemma has_derivative_transform:
   assumes "x \<in> s" "\<And>x. x \<in> s \<Longrightarrow> g x = f x"
   assumes "(f has_derivative f') (at x within s)"
   shows "(g has_derivative f') (at x within s)"
   using assms
   by (intro has_derivative_transform_within[OF _ zero_less_one, where g=g]) auto
 
 lemma has_derivative_transform_eventually:
   assumes "(f has_derivative f') (at x within s)"
     "(\<forall>\<^sub>F x' in at x within s. f x' = g x')"
   assumes "f x = g x" "x \<in> s"
   shows "(g has_derivative f') (at x within s)"
   using assms
 proof -
   from assms(2,3) obtain d where "d > 0" "\<And>x'. x' \<in> s \<Longrightarrow> dist x' x < d \<Longrightarrow> f x' = g x'"
     by (force simp: eventually_at)
   from has_derivative_transform_within[OF assms(1) this(1) assms(4) this(2)]
   show ?thesis .
 qed
 
 lemma has_field_derivative_transform_within:
   assumes "(f has_field_derivative f') (at a within S)"
     and "0 < d"
     and "a \<in> S"
     and "\<And>x. \<lbrakk>x \<in> S; dist x a < d\<rbrakk> \<Longrightarrow> f x = g x"
   shows "(g has_field_derivative f') (at a within S)"
   using assms unfolding has_field_derivative_def
   by (metis has_derivative_transform_within)
 
 lemma has_field_derivative_transform_within_open:
   assumes "(f has_field_derivative f') (at a)"
     and "open S" "a \<in> S"
     and "\<And>x. x \<in> S \<Longrightarrow> f x = g x"
   shows "(g has_field_derivative f') (at a)"
   using assms unfolding has_field_derivative_def
   by (metis has_derivative_transform_within_open)
 
 
 subsection \<open>Continuity\<close>
 
 lemma has_derivative_continuous:
   assumes f: "(f has_derivative f') (at x within s)"
   shows "continuous (at x within s) f"
 proof -
   from f interpret F: bounded_linear f'
     by (rule has_derivative_bounded_linear)
   note F.tendsto[tendsto_intros]
   let ?L = "\<lambda>f. (f \<longlongrightarrow> 0) (at x within s)"
   have "?L (\<lambda>y. norm ((f y - f x) - f' (y - x)) / norm (y - x))"
     using f unfolding has_derivative_iff_norm by blast
   then have "?L (\<lambda>y. norm ((f y - f x) - f' (y - x)) / norm (y - x) * norm (y - x))" (is ?m)
     by (rule tendsto_mult_zero) (auto intro!: tendsto_eq_intros)
   also have "?m \<longleftrightarrow> ?L (\<lambda>y. norm ((f y - f x) - f' (y - x)))"
     by (intro filterlim_cong) (simp_all add: eventually_at_filter)
   finally have "?L (\<lambda>y. (f y - f x) - f' (y - x))"
     by (rule tendsto_norm_zero_cancel)
   then have "?L (\<lambda>y. ((f y - f x) - f' (y - x)) + f' (y - x))"
     by (rule tendsto_eq_intros) (auto intro!: tendsto_eq_intros simp: F.zero)
   then have "?L (\<lambda>y. f y - f x)"
     by simp
   from tendsto_add[OF this tendsto_const, of "f x"] show ?thesis
     by (simp add: continuous_within)
 qed
 
 
 subsection \<open>Composition\<close>
 
 lemma tendsto_at_iff_tendsto_nhds_within:
   "f x = y \<Longrightarrow> (f \<longlongrightarrow> y) (at x within s) \<longleftrightarrow> (f \<longlongrightarrow> y) (inf (nhds x) (principal s))"
   unfolding tendsto_def eventually_inf_principal eventually_at_filter
   by (intro ext all_cong imp_cong) (auto elim!: eventually_mono)
 
 lemma has_derivative_in_compose:
   assumes f: "(f has_derivative f') (at x within s)"
     and g: "(g has_derivative g') (at (f x) within (f`s))"
   shows "((\<lambda>x. g (f x)) has_derivative (\<lambda>x. g' (f' x))) (at x within s)"
 proof -
   from f interpret F: bounded_linear f'
     by (rule has_derivative_bounded_linear)
   from g interpret G: bounded_linear g'
     by (rule has_derivative_bounded_linear)
   from F.bounded obtain kF where kF: "\<And>x. norm (f' x) \<le> norm x * kF"
     by fast
   from G.bounded obtain kG where kG: "\<And>x. norm (g' x) \<le> norm x * kG"
     by fast
   note G.tendsto[tendsto_intros]
 
   let ?L = "\<lambda>f. (f \<longlongrightarrow> 0) (at x within s)"
   let ?D = "\<lambda>f f' x y. (f y - f x) - f' (y - x)"
   let ?N = "\<lambda>f f' x y. norm (?D f f' x y) / norm (y - x)"
   let ?gf = "\<lambda>x. g (f x)" and ?gf' = "\<lambda>x. g' (f' x)"
   define Nf where "Nf = ?N f f' x"
   define Ng where [abs_def]: "Ng y = ?N g g' (f x) (f y)" for y
 
   show ?thesis
   proof (rule has_derivativeI_sandwich[of 1])
     show "bounded_linear (\<lambda>x. g' (f' x))"
       using f g by (blast intro: bounded_linear_compose has_derivative_bounded_linear)
   next
     fix y :: 'a
     assume neq: "y \<noteq> x"
     have "?N ?gf ?gf' x y = norm (g' (?D f f' x y) + ?D g g' (f x) (f y)) / norm (y - x)"
       by (simp add: G.diff G.add field_simps)
     also have "\<dots> \<le> norm (g' (?D f f' x y)) / norm (y - x) + Ng y * (norm (f y - f x) / norm (y - x))"
       by (simp add: add_divide_distrib[symmetric] divide_right_mono norm_triangle_ineq G.zero Ng_def)
     also have "\<dots> \<le> Nf y * kG + Ng y * (Nf y + kF)"
     proof (intro add_mono mult_left_mono)
       have "norm (f y - f x) = norm (?D f f' x y + f' (y - x))"
         by simp
       also have "\<dots> \<le> norm (?D f f' x y) + norm (f' (y - x))"
         by (rule norm_triangle_ineq)
       also have "\<dots> \<le> norm (?D f f' x y) + norm (y - x) * kF"
         using kF by (intro add_mono) simp
       finally show "norm (f y - f x) / norm (y - x) \<le> Nf y + kF"
         by (simp add: neq Nf_def field_simps)
     qed (use kG in \<open>simp_all add: Ng_def Nf_def neq zero_le_divide_iff field_simps\<close>)
     finally show "?N ?gf ?gf' x y \<le> Nf y * kG + Ng y * (Nf y + kF)" .
   next
     have [tendsto_intros]: "?L Nf"
       using f unfolding has_derivative_iff_norm Nf_def ..
     from f have "(f \<longlongrightarrow> f x) (at x within s)"
       by (blast intro: has_derivative_continuous continuous_within[THEN iffD1])
     then have f': "LIM x at x within s. f x :> inf (nhds (f x)) (principal (f`s))"
       unfolding filterlim_def
       by (simp add: eventually_filtermap eventually_at_filter le_principal)
 
     have "((?N g  g' (f x)) \<longlongrightarrow> 0) (at (f x) within f`s)"
       using g unfolding has_derivative_iff_norm ..
     then have g': "((?N g  g' (f x)) \<longlongrightarrow> 0) (inf (nhds (f x)) (principal (f`s)))"
       by (rule tendsto_at_iff_tendsto_nhds_within[THEN iffD1, rotated]) simp
 
     have [tendsto_intros]: "?L Ng"
       unfolding Ng_def by (rule filterlim_compose[OF g' f'])
     show "((\<lambda>y. Nf y * kG + Ng y * (Nf y + kF)) \<longlongrightarrow> 0) (at x within s)"
       by (intro tendsto_eq_intros) auto
   qed simp
 qed
 
 lemma has_derivative_compose:
   "(f has_derivative f') (at x within s) \<Longrightarrow> (g has_derivative g') (at (f x)) \<Longrightarrow>
   ((\<lambda>x. g (f x)) has_derivative (\<lambda>x. g' (f' x))) (at x within s)"
   by (blast intro: has_derivative_in_compose has_derivative_subset)
 
 lemma has_derivative_in_compose2:
   assumes "\<And>x. x \<in> t \<Longrightarrow> (g has_derivative g' x) (at x within t)"
   assumes "f ` s \<subseteq> t" "x \<in> s"
   assumes "(f has_derivative f') (at x within s)"
   shows "((\<lambda>x. g (f x)) has_derivative (\<lambda>y. g' (f x) (f' y))) (at x within s)"
   using assms
   by (auto intro: has_derivative_subset intro!: has_derivative_in_compose[of f f' x s g])
 
 lemma (in bounded_bilinear) FDERIV:
   assumes f: "(f has_derivative f') (at x within s)" and g: "(g has_derivative g') (at x within s)"
   shows "((\<lambda>x. f x ** g x) has_derivative (\<lambda>h. f x ** g' h + f' h ** g x)) (at x within s)"
 proof -
   from bounded_linear.bounded [OF has_derivative_bounded_linear [OF f]]
   obtain KF where norm_F: "\<And>x. norm (f' x) \<le> norm x * KF" by fast
 
   from pos_bounded obtain K
     where K: "0 < K" and norm_prod: "\<And>a b. norm (a ** b) \<le> norm a * norm b * K"
     by fast
   let ?D = "\<lambda>f f' y. f y - f x - f' (y - x)"
   let ?N = "\<lambda>f f' y. norm (?D f f' y) / norm (y - x)"
   define Ng where "Ng = ?N g g'"
   define Nf where "Nf = ?N f f'"
 
   let ?fun1 = "\<lambda>y. norm (f y ** g y - f x ** g x - (f x ** g' (y - x) + f' (y - x) ** g x)) / norm (y - x)"
   let ?fun2 = "\<lambda>y. norm (f x) * Ng y * K + Nf y * norm (g y) * K + KF * norm (g y - g x) * K"
   let ?F = "at x within s"
 
   show ?thesis
   proof (rule has_derivativeI_sandwich[of 1])
     show "bounded_linear (\<lambda>h. f x ** g' h + f' h ** g x)"
       by (intro bounded_linear_add
         bounded_linear_compose [OF bounded_linear_right] bounded_linear_compose [OF bounded_linear_left]
         has_derivative_bounded_linear [OF g] has_derivative_bounded_linear [OF f])
   next
     from g have "(g \<longlongrightarrow> g x) ?F"
       by (intro continuous_within[THEN iffD1] has_derivative_continuous)
     moreover from f g have "(Nf \<longlongrightarrow> 0) ?F" "(Ng \<longlongrightarrow> 0) ?F"
       by (simp_all add: has_derivative_iff_norm Ng_def Nf_def)
     ultimately have "(?fun2 \<longlongrightarrow> norm (f x) * 0 * K + 0 * norm (g x) * K + KF * norm (0::'b) * K) ?F"
       by (intro tendsto_intros) (simp_all add: LIM_zero_iff)
     then show "(?fun2 \<longlongrightarrow> 0) ?F"
       by simp
   next
     fix y :: 'd
     assume "y \<noteq> x"
     have "?fun1 y =
         norm (f x ** ?D g g' y + ?D f f' y ** g y + f' (y - x) ** (g y - g x)) / norm (y - x)"
       by (simp add: diff_left diff_right add_left add_right field_simps)
     also have "\<dots> \<le> (norm (f x) * norm (?D g g' y) * K + norm (?D f f' y) * norm (g y) * K +
         norm (y - x) * KF * norm (g y - g x) * K) / norm (y - x)"
       by (intro divide_right_mono mult_mono'
                 order_trans [OF norm_triangle_ineq add_mono]
                 order_trans [OF norm_prod mult_right_mono]
                 mult_nonneg_nonneg order_refl norm_ge_zero norm_F
                 K [THEN order_less_imp_le])
     also have "\<dots> = ?fun2 y"
       by (simp add: add_divide_distrib Ng_def Nf_def)
     finally show "?fun1 y \<le> ?fun2 y" .
   qed simp
 qed
 
 lemmas has_derivative_mult[simp, derivative_intros] = bounded_bilinear.FDERIV[OF bounded_bilinear_mult]
 lemmas has_derivative_scaleR[simp, derivative_intros] = bounded_bilinear.FDERIV[OF bounded_bilinear_scaleR]
 
 lemma has_derivative_prod[simp, derivative_intros]:
   fixes f :: "'i \<Rightarrow> 'a::real_normed_vector \<Rightarrow> 'b::real_normed_field"
   shows "(\<And>i. i \<in> I \<Longrightarrow> (f i has_derivative f' i) (at x within S)) \<Longrightarrow>
     ((\<lambda>x. \<Prod>i\<in>I. f i x) has_derivative (\<lambda>y. \<Sum>i\<in>I. f' i y * (\<Prod>j\<in>I - {i}. f j x))) (at x within S)"
 proof (induct I rule: infinite_finite_induct)
   case infinite
   then show ?case by simp
 next
   case empty
   then show ?case by simp
 next
   case (insert i I)
   let ?P = "\<lambda>y. f i x * (\<Sum>i\<in>I. f' i y * (\<Prod>j\<in>I - {i}. f j x)) + (f' i y) * (\<Prod>i\<in>I. f i x)"
   have "((\<lambda>x. f i x * (\<Prod>i\<in>I. f i x)) has_derivative ?P) (at x within S)"
     using insert by (intro has_derivative_mult) auto
   also have "?P = (\<lambda>y. \<Sum>i'\<in>insert i I. f' i' y * (\<Prod>j\<in>insert i I - {i'}. f j x))"
     using insert(1,2)
     by (auto simp add: sum_distrib_left insert_Diff_if intro!: ext sum.cong)
   finally show ?case
     using insert by simp
 qed
 
 lemma has_derivative_power[simp, derivative_intros]:
   fixes f :: "'a :: real_normed_vector \<Rightarrow> 'b :: real_normed_field"
   assumes f: "(f has_derivative f') (at x within S)"
   shows "((\<lambda>x. f x^n) has_derivative (\<lambda>y. of_nat n * f' y * f x^(n - 1))) (at x within S)"
   using has_derivative_prod[OF f, of "{..< n}"] by (simp add: prod_constant ac_simps)
 
 lemma has_derivative_inverse':
   fixes x :: "'a::real_normed_div_algebra"
   assumes x: "x \<noteq> 0"
   shows "(inverse has_derivative (\<lambda>h. - (inverse x * h * inverse x))) (at x within S)"
     (is "(_ has_derivative ?f) _")
 proof (rule has_derivativeI_sandwich)
   show "bounded_linear (\<lambda>h. - (inverse x * h * inverse x))"
     by (simp add: bounded_linear_minus bounded_linear_mult_const bounded_linear_mult_right)
   show "0 < norm x" using x by simp
   have "(inverse \<longlongrightarrow> inverse x) (at x within S)"
     using tendsto_inverse tendsto_ident_at x by auto
   then show "((\<lambda>y. norm (inverse y - inverse x) * norm (inverse x)) \<longlongrightarrow> 0) (at x within S)"
     by (simp add: LIM_zero_iff tendsto_mult_left_zero tendsto_norm_zero)
 next
   fix y :: 'a
   assume h: "y \<noteq> x" "dist y x < norm x"
   then have "y \<noteq> 0" by auto
   have "norm (inverse y - inverse x - ?f (y -x)) / norm (y - x) 
         = norm (- (inverse y * (y - x) * inverse x - inverse x * (y - x) * inverse x)) /
                 norm (y - x)"
     by (simp add: \<open>y \<noteq> 0\<close> inverse_diff_inverse x)
   also have "... = norm ((inverse y - inverse x) * (y - x) * inverse x) / norm (y - x)"
     by (simp add: left_diff_distrib norm_minus_commute)
   also have "\<dots> \<le> norm (inverse y - inverse x) * norm (y - x) * norm (inverse x) / norm (y - x)"
     by (simp add: norm_mult)
   also have "\<dots> = norm (inverse y - inverse x) * norm (inverse x)"
     by simp
   finally show "norm (inverse y - inverse x - ?f (y -x)) / norm (y - x) \<le>
     norm (inverse y - inverse x) * norm (inverse x)" .
 qed
 
 lemma has_derivative_inverse[simp, derivative_intros]:
   fixes f :: "_ \<Rightarrow> 'a::real_normed_div_algebra"
   assumes x:  "f x \<noteq> 0"
     and f: "(f has_derivative f') (at x within S)"
   shows "((\<lambda>x. inverse (f x)) has_derivative (\<lambda>h. - (inverse (f x) * f' h * inverse (f x))))
     (at x within S)"
   using has_derivative_compose[OF f has_derivative_inverse', OF x] .
 
 lemma has_derivative_divide[simp, derivative_intros]:
   fixes f :: "_ \<Rightarrow> 'a::real_normed_div_algebra"
   assumes f: "(f has_derivative f') (at x within S)"
     and g: "(g has_derivative g') (at x within S)"
   assumes x: "g x \<noteq> 0"
   shows "((\<lambda>x. f x / g x) has_derivative
                 (\<lambda>h. - f x * (inverse (g x) * g' h * inverse (g x)) + f' h / g x)) (at x within S)"
   using has_derivative_mult[OF f has_derivative_inverse[OF x g]]
   by (simp add: field_simps)
 
 lemma has_derivative_power_int':
   fixes x :: "'a::real_normed_field"
   assumes x: "x \<noteq> 0"
   shows "((\<lambda>x. power_int x n) has_derivative (\<lambda>y. y * (of_int n * power_int x (n - 1)))) (at x within S)"
 proof (cases n rule: int_cases4)
   case (nonneg n)
   thus ?thesis using x
     by (cases "n = 0") (auto intro!: derivative_eq_intros simp: field_simps power_int_diff fun_eq_iff
                              simp flip: power_Suc)
 next
   case (neg n)
   thus ?thesis using x
     by (auto intro!: derivative_eq_intros simp: field_simps power_int_diff power_int_minus
              simp flip: power_Suc power_Suc2 power_add)
 qed
 
 lemma has_derivative_power_int[simp, derivative_intros]:
   fixes f :: "_ \<Rightarrow> 'a::real_normed_field"
   assumes x:  "f x \<noteq> 0"
     and f: "(f has_derivative f') (at x within S)"
   shows "((\<lambda>x. power_int (f x) n) has_derivative (\<lambda>h. f' h * (of_int n * power_int (f x) (n - 1))))
            (at x within S)"
   using has_derivative_compose[OF f has_derivative_power_int', OF x] .
 
 
 text \<open>Conventional form requires mult-AC laws. Types real and complex only.\<close>
 
 lemma has_derivative_divide'[derivative_intros]:
   fixes f :: "_ \<Rightarrow> 'a::real_normed_field"
   assumes f: "(f has_derivative f') (at x within S)"
     and g: "(g has_derivative g') (at x within S)"
     and x: "g x \<noteq> 0"
   shows "((\<lambda>x. f x / g x) has_derivative (\<lambda>h. (f' h * g x - f x * g' h) / (g x * g x))) (at x within S)"
 proof -
   have "f' h / g x - f x * (inverse (g x) * g' h * inverse (g x)) =
       (f' h * g x - f x * g' h) / (g x * g x)" for h
     by (simp add: field_simps x)
   then show ?thesis
     using has_derivative_divide [OF f g] x
     by simp
 qed
 
 
 subsection \<open>Uniqueness\<close>
 
 text \<open>
 This can not generally shown for \<^const>\<open>has_derivative\<close>, as we need to approach the point from
 all directions. There is a proof in \<open>Analysis\<close> for \<open>euclidean_space\<close>.
 \<close>
 
 lemma has_derivative_at2: "(f has_derivative f') (at x) \<longleftrightarrow>
     bounded_linear f' \<and> ((\<lambda>y. (1 / (norm(y - x))) *\<^sub>R (f y - (f x + f' (y - x)))) \<longlongrightarrow> 0) (at x)"
   using has_derivative_within [of f f' x UNIV]
   by simp
 
 lemma has_derivative_zero_unique:
   assumes "((\<lambda>x. 0) has_derivative F) (at x)"
   shows "F = (\<lambda>h. 0)"
 proof -
   interpret F: bounded_linear F
     using assms by (rule has_derivative_bounded_linear)
   let ?r = "\<lambda>h. norm (F h) / norm h"
   have *: "?r \<midarrow>0\<rightarrow> 0"
     using assms unfolding has_derivative_at by simp
   show "F = (\<lambda>h. 0)"
   proof
     show "F h = 0" for h
     proof (rule ccontr)
       assume **: "\<not> ?thesis"
       then have h: "h \<noteq> 0"
         by (auto simp add: F.zero)
       with ** have "0 < ?r h"
         by simp
       from LIM_D [OF * this] obtain S
         where S: "0 < S" and r: "\<And>x. x \<noteq> 0 \<Longrightarrow> norm x < S \<Longrightarrow> ?r x < ?r h"
         by auto
       from dense [OF S] obtain t where t: "0 < t \<and> t < S" ..
       let ?x = "scaleR (t / norm h) h"
       have "?x \<noteq> 0" and "norm ?x < S"
         using t h by simp_all
       then have "?r ?x < ?r h"
         by (rule r)
       then show False
         using t h by (simp add: F.scaleR)
     qed
   qed
 qed
 
 lemma has_derivative_unique:
   assumes "(f has_derivative F) (at x)"
     and "(f has_derivative F') (at x)"
   shows "F = F'"
 proof -
   have "((\<lambda>x. 0) has_derivative (\<lambda>h. F h - F' h)) (at x)"
     using has_derivative_diff [OF assms] by simp
   then have "(\<lambda>h. F h - F' h) = (\<lambda>h. 0)"
     by (rule has_derivative_zero_unique)
   then show "F = F'"
     unfolding fun_eq_iff right_minus_eq .
 qed
 
 lemma has_derivative_Uniq: "\<exists>\<^sub>\<le>\<^sub>1F. (f has_derivative F) (at x)"
   by (simp add: Uniq_def has_derivative_unique)
 
 
 subsection \<open>Differentiability predicate\<close>
 
 definition differentiable :: "('a::real_normed_vector \<Rightarrow> 'b::real_normed_vector) \<Rightarrow> 'a filter \<Rightarrow> bool"
     (infix "differentiable" 50)
   where "f differentiable F \<longleftrightarrow> (\<exists>D. (f has_derivative D) F)"
 
 lemma differentiable_subset:
   "f differentiable (at x within s) \<Longrightarrow> t \<subseteq> s \<Longrightarrow> f differentiable (at x within t)"
   unfolding differentiable_def by (blast intro: has_derivative_subset)
 
 lemmas differentiable_within_subset = differentiable_subset
 
 lemma differentiable_ident [simp, derivative_intros]: "(\<lambda>x. x) differentiable F"
   unfolding differentiable_def by (blast intro: has_derivative_ident)
 
 lemma differentiable_const [simp, derivative_intros]: "(\<lambda>z. a) differentiable F"
   unfolding differentiable_def by (blast intro: has_derivative_const)
 
 lemma differentiable_in_compose:
   "f differentiable (at (g x) within (g`s)) \<Longrightarrow> g differentiable (at x within s) \<Longrightarrow>
     (\<lambda>x. f (g x)) differentiable (at x within s)"
   unfolding differentiable_def by (blast intro: has_derivative_in_compose)
 
 lemma differentiable_compose:
   "f differentiable (at (g x)) \<Longrightarrow> g differentiable (at x within s) \<Longrightarrow>
     (\<lambda>x. f (g x)) differentiable (at x within s)"
   by (blast intro: differentiable_in_compose differentiable_subset)
 
 lemma differentiable_add [simp, derivative_intros]:
   "f differentiable F \<Longrightarrow> g differentiable F \<Longrightarrow> (\<lambda>x. f x + g x) differentiable F"
   unfolding differentiable_def by (blast intro: has_derivative_add)
 
 lemma differentiable_sum[simp, derivative_intros]:
   assumes "finite s" "\<forall>a\<in>s. (f a) differentiable net"
   shows "(\<lambda>x. sum (\<lambda>a. f a x) s) differentiable net"
 proof -
   from bchoice[OF assms(2)[unfolded differentiable_def]]
   show ?thesis
     by (auto intro!: has_derivative_sum simp: differentiable_def)
 qed
 
 lemma differentiable_minus [simp, derivative_intros]:
   "f differentiable F \<Longrightarrow> (\<lambda>x. - f x) differentiable F"
   unfolding differentiable_def by (blast intro: has_derivative_minus)
 
 lemma differentiable_diff [simp, derivative_intros]:
   "f differentiable F \<Longrightarrow> g differentiable F \<Longrightarrow> (\<lambda>x. f x - g x) differentiable F"
   unfolding differentiable_def by (blast intro: has_derivative_diff)
 
 lemma differentiable_mult [simp, derivative_intros]:
   fixes f g :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_algebra"
   shows "f differentiable (at x within s) \<Longrightarrow> g differentiable (at x within s) \<Longrightarrow>
     (\<lambda>x. f x * g x) differentiable (at x within s)"
   unfolding differentiable_def by (blast intro: has_derivative_mult)
 
 lemma differentiable_cmult_left_iff [simp]:
   fixes c::"'a::real_normed_field" 
   shows "(\<lambda>t. c * q t) differentiable at t \<longleftrightarrow> c = 0 \<or> (\<lambda>t. q t) differentiable at t" (is "?lhs = ?rhs")
 proof
   assume L: ?lhs
   {assume "c \<noteq> 0"
     then have "q differentiable at t"
       using differentiable_mult [OF differentiable_const L, of concl: "1/c"] by auto
   } then show ?rhs
     by auto
 qed auto
 
 lemma differentiable_cmult_right_iff [simp]:
   fixes c::"'a::real_normed_field" 
   shows "(\<lambda>t. q t * c) differentiable at t \<longleftrightarrow> c = 0 \<or> (\<lambda>t. q t) differentiable at t" (is "?lhs = ?rhs")
   by (simp add: mult.commute flip: differentiable_cmult_left_iff)
 
 lemma differentiable_inverse [simp, derivative_intros]:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_field"
   shows "f differentiable (at x within s) \<Longrightarrow> f x \<noteq> 0 \<Longrightarrow>
     (\<lambda>x. inverse (f x)) differentiable (at x within s)"
   unfolding differentiable_def by (blast intro: has_derivative_inverse)
 
 lemma differentiable_divide [simp, derivative_intros]:
   fixes f g :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_field"
   shows "f differentiable (at x within s) \<Longrightarrow> g differentiable (at x within s) \<Longrightarrow>
     g x \<noteq> 0 \<Longrightarrow> (\<lambda>x. f x / g x) differentiable (at x within s)"
   unfolding divide_inverse by simp
 
 lemma differentiable_power [simp, derivative_intros]:
   fixes f g :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_field"
   shows "f differentiable (at x within s) \<Longrightarrow> (\<lambda>x. f x ^ n) differentiable (at x within s)"
   unfolding differentiable_def by (blast intro: has_derivative_power)
 
 lemma differentiable_power_int [simp, derivative_intros]:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_field"
   shows "f differentiable (at x within s) \<Longrightarrow> f x \<noteq> 0 \<Longrightarrow>
            (\<lambda>x. power_int (f x) n) differentiable (at x within s)"
   unfolding differentiable_def by (blast intro: has_derivative_power_int)
 
 lemma differentiable_scaleR [simp, derivative_intros]:
   "f differentiable (at x within s) \<Longrightarrow> g differentiable (at x within s) \<Longrightarrow>
     (\<lambda>x. f x *\<^sub>R g x) differentiable (at x within s)"
   unfolding differentiable_def by (blast intro: has_derivative_scaleR)
 
 lemma has_derivative_imp_has_field_derivative:
   "(f has_derivative D) F \<Longrightarrow> (\<And>x. x * D' = D x) \<Longrightarrow> (f has_field_derivative D') F"
   unfolding has_field_derivative_def
   by (rule has_derivative_eq_rhs[of f D]) (simp_all add: fun_eq_iff mult.commute)
 
 lemma has_field_derivative_imp_has_derivative:
   "(f has_field_derivative D) F \<Longrightarrow> (f has_derivative (*) D) F"
   by (simp add: has_field_derivative_def)
 
 lemma DERIV_subset:
   "(f has_field_derivative f') (at x within s) \<Longrightarrow> t \<subseteq> s \<Longrightarrow>
     (f has_field_derivative f') (at x within t)"
   by (simp add: has_field_derivative_def has_derivative_subset)
 
 lemma has_field_derivative_at_within:
   "(f has_field_derivative f') (at x) \<Longrightarrow> (f has_field_derivative f') (at x within s)"
   using DERIV_subset by blast
 
 abbreviation (input)
   DERIV :: "('a::real_normed_field \<Rightarrow> 'a) \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> bool"
     ("(DERIV (_)/ (_)/ :> (_))" [1000, 1000, 60] 60)
   where "DERIV f x :> D \<equiv> (f has_field_derivative D) (at x)"
 
 abbreviation has_real_derivative :: "(real \<Rightarrow> real) \<Rightarrow> real \<Rightarrow> real filter \<Rightarrow> bool"
     (infix "(has'_real'_derivative)" 50)
   where "(f has_real_derivative D) F \<equiv> (f has_field_derivative D) F"
 
 lemma real_differentiable_def:
   "f differentiable at x within s \<longleftrightarrow> (\<exists>D. (f has_real_derivative D) (at x within s))"
 proof safe
   assume "f differentiable at x within s"
   then obtain f' where *: "(f has_derivative f') (at x within s)"
     unfolding differentiable_def by auto
   then obtain c where "f' = ((*) c)"
     by (metis real_bounded_linear has_derivative_bounded_linear mult.commute fun_eq_iff)
   with * show "\<exists>D. (f has_real_derivative D) (at x within s)"
     unfolding has_field_derivative_def by auto
 qed (auto simp: differentiable_def has_field_derivative_def)
 
 lemma real_differentiableE [elim?]:
   assumes f: "f differentiable (at x within s)"
   obtains df where "(f has_real_derivative df) (at x within s)"
   using assms by (auto simp: real_differentiable_def)
 
 lemma has_field_derivative_iff:
   "(f has_field_derivative D) (at x within S) \<longleftrightarrow>
     ((\<lambda>y. (f y - f x) / (y - x)) \<longlongrightarrow> D) (at x within S)"
 proof -
   have "((\<lambda>y. norm (f y - f x - D * (y - x)) / norm (y - x)) \<longlongrightarrow> 0) (at x within S) 
       = ((\<lambda>y. (f y - f x) / (y - x) - D) \<longlongrightarrow> 0) (at x within S)"
     by (smt (verit, best) Lim_cong_within divide_diff_eq_iff norm_divide right_minus_eq tendsto_norm_zero_iff)
   then show ?thesis
     by (simp add: has_field_derivative_def has_derivative_iff_norm bounded_linear_mult_right LIM_zero_iff)
 qed
 
 lemma DERIV_def: "DERIV f x :> D \<longleftrightarrow> (\<lambda>h. (f (x + h) - f x) / h) \<midarrow>0\<rightarrow> D"
   unfolding field_has_derivative_at has_field_derivative_def has_field_derivative_iff ..
 
 text \<open>due to Christian Pardillo Laursen, replacing a proper epsilon-delta horror\<close>
 lemma field_derivative_lim_unique:
   assumes f: "(f has_field_derivative df) (at z)"
     and s: "s \<longlonglongrightarrow> 0"  "\<And>n. s n \<noteq> 0" 
     and a: "(\<lambda>n. (f (z + s n) - f z) / s n) \<longlonglongrightarrow> a"
   shows "df = a"
 proof -
   have "((\<lambda>k. (f (z + k) - f z) / k) \<longlongrightarrow> df) (at 0)"
     using f by (simp add: DERIV_def)
   with s have "((\<lambda>n. (f (z + s n) - f z) / s n) \<longlonglongrightarrow> df)"
     by (simp flip: LIMSEQ_SEQ_conv)
   then show ?thesis
     using a by (rule LIMSEQ_unique)
 qed
 
 lemma mult_commute_abs: "(\<lambda>x. x * c) = (*) c"
   for c :: "'a::ab_semigroup_mult"
   by (simp add: fun_eq_iff mult.commute)
 
 lemma DERIV_compose_FDERIV:
   fixes f::"real\<Rightarrow>real"
   assumes "DERIV f (g x) :> f'"
   assumes "(g has_derivative g') (at x within s)"
   shows "((\<lambda>x. f (g x)) has_derivative (\<lambda>x. g' x * f')) (at x within s)"
   using assms has_derivative_compose[of g g' x s f "(*) f'"]
   by (auto simp: has_field_derivative_def ac_simps)
 
 
 subsection \<open>Vector derivative\<close>
 
 text \<open>It's for real derivatives only, and not obviously generalisable to field derivatives\<close>
 lemma has_real_derivative_iff_has_vector_derivative:
   "(f has_real_derivative y) F \<longleftrightarrow> (f has_vector_derivative y) F"
   unfolding has_vector_derivative_def has_field_derivative_def real_scaleR_def mult_commute_abs ..
 
 lemma has_field_derivative_subset:
   "(f has_field_derivative y) (at x within s) \<Longrightarrow> t \<subseteq> s \<Longrightarrow>
     (f has_field_derivative y) (at x within t)"
   by (fact DERIV_subset)
 
 lemma has_vector_derivative_const[simp, derivative_intros]: "((\<lambda>x. c) has_vector_derivative 0) net"
   by (auto simp: has_vector_derivative_def)
 
 lemma has_vector_derivative_id[simp, derivative_intros]: "((\<lambda>x. x) has_vector_derivative 1) net"
   by (auto simp: has_vector_derivative_def)
 
 lemma has_vector_derivative_minus[derivative_intros]:
   "(f has_vector_derivative f') net \<Longrightarrow> ((\<lambda>x. - f x) has_vector_derivative (- f')) net"
   by (auto simp: has_vector_derivative_def)
 
 lemma has_vector_derivative_add[derivative_intros]:
   "(f has_vector_derivative f') net \<Longrightarrow> (g has_vector_derivative g') net \<Longrightarrow>
     ((\<lambda>x. f x + g x) has_vector_derivative (f' + g')) net"
   by (auto simp: has_vector_derivative_def scaleR_right_distrib)
 
 lemma has_vector_derivative_sum[derivative_intros]:
   "(\<And>i. i \<in> I \<Longrightarrow> (f i has_vector_derivative f' i) net) \<Longrightarrow>
     ((\<lambda>x. \<Sum>i\<in>I. f i x) has_vector_derivative (\<Sum>i\<in>I. f' i)) net"
   by (auto simp: has_vector_derivative_def fun_eq_iff scaleR_sum_right intro!: derivative_eq_intros)
 
 lemma has_vector_derivative_diff[derivative_intros]:
   "(f has_vector_derivative f') net \<Longrightarrow> (g has_vector_derivative g') net \<Longrightarrow>
     ((\<lambda>x. f x - g x) has_vector_derivative (f' - g')) net"
   by (auto simp: has_vector_derivative_def scaleR_diff_right)
 
 lemma has_vector_derivative_add_const:
   "((\<lambda>t. g t + z) has_vector_derivative f') net = ((\<lambda>t. g t) has_vector_derivative f') net"
   apply (intro iffI)
    apply (force dest: has_vector_derivative_diff [where g = "\<lambda>t. z", OF _ has_vector_derivative_const])
   apply (force dest: has_vector_derivative_add [OF _ has_vector_derivative_const])
   done
 
 lemma has_vector_derivative_diff_const:
   "((\<lambda>t. g t - z) has_vector_derivative f') net = ((\<lambda>t. g t) has_vector_derivative f') net"
   using has_vector_derivative_add_const [where z = "-z"]
   by simp
 
 lemma (in bounded_linear) has_vector_derivative:
   assumes "(g has_vector_derivative g') F"
   shows "((\<lambda>x. f (g x)) has_vector_derivative f g') F"
   using has_derivative[OF assms[unfolded has_vector_derivative_def]]
   by (simp add: has_vector_derivative_def scaleR)
 
 lemma (in bounded_bilinear) has_vector_derivative:
   assumes "(f has_vector_derivative f') (at x within s)"
     and "(g has_vector_derivative g') (at x within s)"
   shows "((\<lambda>x. f x ** g x) has_vector_derivative (f x ** g' + f' ** g x)) (at x within s)"
   using FDERIV[OF assms(1-2)[unfolded has_vector_derivative_def]]
   by (simp add: has_vector_derivative_def scaleR_right scaleR_left scaleR_right_distrib)
 
 lemma has_vector_derivative_scaleR[derivative_intros]:
   "(f has_field_derivative f') (at x within s) \<Longrightarrow> (g has_vector_derivative g') (at x within s) \<Longrightarrow>
     ((\<lambda>x. f x *\<^sub>R g x) has_vector_derivative (f x *\<^sub>R g' + f' *\<^sub>R g x)) (at x within s)"
   unfolding has_real_derivative_iff_has_vector_derivative
   by (rule bounded_bilinear.has_vector_derivative[OF bounded_bilinear_scaleR])
 
 lemma has_vector_derivative_mult[derivative_intros]:
   "(f has_vector_derivative f') (at x within s) \<Longrightarrow> (g has_vector_derivative g') (at x within s) \<Longrightarrow>
     ((\<lambda>x. f x * g x) has_vector_derivative (f x * g' + f' * g x)) (at x within s)"
   for f g :: "real \<Rightarrow> 'a::real_normed_algebra"
   by (rule bounded_bilinear.has_vector_derivative[OF bounded_bilinear_mult])
 
 lemma has_vector_derivative_of_real[derivative_intros]:
   "(f has_field_derivative D) F \<Longrightarrow> ((\<lambda>x. of_real (f x)) has_vector_derivative (of_real D)) F"
   by (rule bounded_linear.has_vector_derivative[OF bounded_linear_of_real])
     (simp add: has_real_derivative_iff_has_vector_derivative)
 
 lemma has_vector_derivative_real_field:
   "(f has_field_derivative f') (at (of_real a)) \<Longrightarrow> ((\<lambda>x. f (of_real x)) has_vector_derivative f') (at a within s)"
   using has_derivative_compose[of of_real of_real a _ f "(*) f'"] 
   by (simp add: scaleR_conv_of_real ac_simps has_vector_derivative_def has_field_derivative_def)
 
 lemma has_vector_derivative_continuous:
   "(f has_vector_derivative D) (at x within s) \<Longrightarrow> continuous (at x within s) f"
   by (auto intro: has_derivative_continuous simp: has_vector_derivative_def)
 
 lemma continuous_on_vector_derivative:
   "(\<And>x. x \<in> S \<Longrightarrow> (f has_vector_derivative f' x) (at x within S)) \<Longrightarrow> continuous_on S f"
   by (auto simp: continuous_on_eq_continuous_within intro!: has_vector_derivative_continuous)
 
 lemma has_vector_derivative_mult_right[derivative_intros]:
   fixes a :: "'a::real_normed_algebra"
   shows "(f has_vector_derivative x) F \<Longrightarrow> ((\<lambda>x. a * f x) has_vector_derivative (a * x)) F"
   by (rule bounded_linear.has_vector_derivative[OF bounded_linear_mult_right])
 
 lemma has_vector_derivative_mult_left[derivative_intros]:
   fixes a :: "'a::real_normed_algebra"
   shows "(f has_vector_derivative x) F \<Longrightarrow> ((\<lambda>x. f x * a) has_vector_derivative (x * a)) F"
   by (rule bounded_linear.has_vector_derivative[OF bounded_linear_mult_left])
 
 lemma has_vector_derivative_divide[derivative_intros]:
   fixes a :: "'a::real_normed_field"
   shows "(f has_vector_derivative x) F \<Longrightarrow> ((\<lambda>x. f x / a) has_vector_derivative (x / a)) F"
   using has_vector_derivative_mult_left [of f x F "inverse a"]
   by (simp add: field_class.field_divide_inverse)
 
 
 subsection \<open>Derivatives\<close>
 
 lemma DERIV_D: "DERIV f x :> D \<Longrightarrow> (\<lambda>h. (f (x + h) - f x) / h) \<midarrow>0\<rightarrow> D"
   by (simp add: DERIV_def)
 
 lemma has_field_derivativeD:
   "(f has_field_derivative D) (at x within S) \<Longrightarrow>
     ((\<lambda>y. (f y - f x) / (y - x)) \<longlongrightarrow> D) (at x within S)"
   by (simp add: has_field_derivative_iff)
 
 lemma DERIV_const [simp, derivative_intros]: "((\<lambda>x. k) has_field_derivative 0) F"
   by (rule has_derivative_imp_has_field_derivative[OF has_derivative_const]) auto
 
 lemma DERIV_ident [simp, derivative_intros]: "((\<lambda>x. x) has_field_derivative 1) F"
   by (rule has_derivative_imp_has_field_derivative[OF has_derivative_ident]) auto
 
 lemma field_differentiable_add[derivative_intros]:
   "(f has_field_derivative f') F \<Longrightarrow> (g has_field_derivative g') F \<Longrightarrow>
     ((\<lambda>z. f z + g z) has_field_derivative f' + g') F"
   by (rule has_derivative_imp_has_field_derivative[OF has_derivative_add])
      (auto simp: has_field_derivative_def field_simps mult_commute_abs)
 
 corollary DERIV_add:
   "(f has_field_derivative D) (at x within s) \<Longrightarrow> (g has_field_derivative E) (at x within s) \<Longrightarrow>
     ((\<lambda>x. f x + g x) has_field_derivative D + E) (at x within s)"
   by (rule field_differentiable_add)
 
 lemma field_differentiable_minus[derivative_intros]:
   "(f has_field_derivative f') F \<Longrightarrow> ((\<lambda>z. - (f z)) has_field_derivative -f') F"
   by (rule has_derivative_imp_has_field_derivative[OF has_derivative_minus])
      (auto simp: has_field_derivative_def field_simps mult_commute_abs)
 
 corollary DERIV_minus:
   "(f has_field_derivative D) (at x within s) \<Longrightarrow>
     ((\<lambda>x. - f x) has_field_derivative -D) (at x within s)"
   by (rule field_differentiable_minus)
 
 lemma field_differentiable_diff[derivative_intros]:
   "(f has_field_derivative f') F \<Longrightarrow>
     (g has_field_derivative g') F \<Longrightarrow> ((\<lambda>z. f z - g z) has_field_derivative f' - g') F"
   by (simp only: diff_conv_add_uminus field_differentiable_add field_differentiable_minus)
 
 corollary DERIV_diff:
   "(f has_field_derivative D) (at x within s) \<Longrightarrow>
     (g has_field_derivative E) (at x within s) \<Longrightarrow>
     ((\<lambda>x. f x - g x) has_field_derivative D - E) (at x within s)"
   by (rule field_differentiable_diff)
 
 lemma DERIV_continuous: "(f has_field_derivative D) (at x within s) \<Longrightarrow> continuous (at x within s) f"
   by (drule has_derivative_continuous[OF has_field_derivative_imp_has_derivative]) simp
 
 corollary DERIV_isCont: "DERIV f x :> D \<Longrightarrow> isCont f x"
   by (rule DERIV_continuous)
 
 lemma DERIV_atLeastAtMost_imp_continuous_on:
   assumes "\<And>x. \<lbrakk>a \<le> x; x \<le> b\<rbrakk> \<Longrightarrow> \<exists>y. DERIV f x :> y"
   shows "continuous_on {a..b} f"
   by (meson DERIV_isCont assms atLeastAtMost_iff continuous_at_imp_continuous_at_within continuous_on_eq_continuous_within)
 
 lemma DERIV_continuous_on:
   "(\<And>x. x \<in> s \<Longrightarrow> (f has_field_derivative (D x)) (at x within s)) \<Longrightarrow> continuous_on s f"
   unfolding continuous_on_eq_continuous_within
   by (intro continuous_at_imp_continuous_on ballI DERIV_continuous)
 
 lemma DERIV_mult':
   "(f has_field_derivative D) (at x within s) \<Longrightarrow> (g has_field_derivative E) (at x within s) \<Longrightarrow>
     ((\<lambda>x. f x * g x) has_field_derivative f x * E + D * g x) (at x within s)"
   by (rule has_derivative_imp_has_field_derivative[OF has_derivative_mult])
      (auto simp: field_simps mult_commute_abs dest: has_field_derivative_imp_has_derivative)
 
 lemma DERIV_mult[derivative_intros]:
   "(f has_field_derivative Da) (at x within s) \<Longrightarrow> (g has_field_derivative Db) (at x within s) \<Longrightarrow>
     ((\<lambda>x. f x * g x) has_field_derivative Da * g x + Db * f x) (at x within s)"
   by (rule has_derivative_imp_has_field_derivative[OF has_derivative_mult])
      (auto simp: field_simps dest: has_field_derivative_imp_has_derivative)
 
 text \<open>Derivative of linear multiplication\<close>
 
 lemma DERIV_cmult:
   "(f has_field_derivative D) (at x within s) \<Longrightarrow>
     ((\<lambda>x. c * f x) has_field_derivative c * D) (at x within s)"
   by (drule DERIV_mult' [OF DERIV_const]) simp
 
 lemma DERIV_cmult_right:
   "(f has_field_derivative D) (at x within s) \<Longrightarrow>
     ((\<lambda>x. f x * c) has_field_derivative D * c) (at x within s)"
   using DERIV_cmult by (auto simp add: ac_simps)
 
 lemma DERIV_cmult_Id [simp]: "((*) c has_field_derivative c) (at x within s)"
   using DERIV_ident [THEN DERIV_cmult, where c = c and x = x] by simp
 
 lemma DERIV_cdivide:
   "(f has_field_derivative D) (at x within s) \<Longrightarrow>
     ((\<lambda>x. f x / c) has_field_derivative D / c) (at x within s)"
   using DERIV_cmult_right[of f D x s "1 / c"] by simp
 
 lemma DERIV_unique: "DERIV f x :> D \<Longrightarrow> DERIV f x :> E \<Longrightarrow> D = E"
   unfolding DERIV_def by (rule LIM_unique)
 
 lemma DERIV_Uniq: "\<exists>\<^sub>\<le>\<^sub>1D. DERIV f x :> D"
   by (simp add: DERIV_unique Uniq_def)
 
 lemma DERIV_sum[derivative_intros]:
   "(\<And> n. n \<in> S \<Longrightarrow> ((\<lambda>x. f x n) has_field_derivative (f' x n)) F) \<Longrightarrow>
     ((\<lambda>x. sum (f x) S) has_field_derivative sum (f' x) S) F"
   by (rule has_derivative_imp_has_field_derivative [OF has_derivative_sum])
      (auto simp: sum_distrib_left mult_commute_abs dest: has_field_derivative_imp_has_derivative)
 
 lemma DERIV_inverse'[derivative_intros]:
   assumes "(f has_field_derivative D) (at x within s)"
     and "f x \<noteq> 0"
   shows "((\<lambda>x. inverse (f x)) has_field_derivative - (inverse (f x) * D * inverse (f x)))
     (at x within s)"
 proof -
   have "(f has_derivative (\<lambda>x. x * D)) = (f has_derivative (*) D)"
     by (rule arg_cong [of "\<lambda>x. x * D"]) (simp add: fun_eq_iff)
   with assms have "(f has_derivative (\<lambda>x. x * D)) (at x within s)"
     by (auto dest!: has_field_derivative_imp_has_derivative)
   then show ?thesis using \<open>f x \<noteq> 0\<close>
     by (auto intro: has_derivative_imp_has_field_derivative has_derivative_inverse)
 qed
 
 text \<open>Power of \<open>-1\<close>\<close>
 
 lemma DERIV_inverse:
   "x \<noteq> 0 \<Longrightarrow> ((\<lambda>x. inverse(x)) has_field_derivative - (inverse x ^ Suc (Suc 0))) (at x within s)"
   by (drule DERIV_inverse' [OF DERIV_ident]) simp
 
 text \<open>Derivative of inverse\<close>
 
 lemma DERIV_inverse_fun:
   "(f has_field_derivative d) (at x within s) \<Longrightarrow> f x \<noteq> 0 \<Longrightarrow>
     ((\<lambda>x. inverse (f x)) has_field_derivative (- (d * inverse(f x ^ Suc (Suc 0))))) (at x within s)"
   by (drule (1) DERIV_inverse') (simp add: ac_simps nonzero_inverse_mult_distrib)
 
 text \<open>Derivative of quotient\<close>
 
 lemma DERIV_divide[derivative_intros]:
   "(f has_field_derivative D) (at x within s) \<Longrightarrow>
     (g has_field_derivative E) (at x within s) \<Longrightarrow> g x \<noteq> 0 \<Longrightarrow>
     ((\<lambda>x. f x / g x) has_field_derivative (D * g x - f x * E) / (g x * g x)) (at x within s)"
   by (rule has_derivative_imp_has_field_derivative[OF has_derivative_divide])
      (auto dest: has_field_derivative_imp_has_derivative simp: field_simps)
 
 lemma DERIV_quotient:
   "(f has_field_derivative d) (at x within s) \<Longrightarrow>
     (g has_field_derivative e) (at x within s)\<Longrightarrow> g x \<noteq> 0 \<Longrightarrow>
     ((\<lambda>y. f y / g y) has_field_derivative (d * g x - (e * f x)) / (g x ^ Suc (Suc 0))) (at x within s)"
   by (drule (2) DERIV_divide) (simp add: mult.commute)
 
 lemma DERIV_power_Suc:
   "(f has_field_derivative D) (at x within s) \<Longrightarrow>
     ((\<lambda>x. f x ^ Suc n) has_field_derivative (1 + of_nat n) * (D * f x ^ n)) (at x within s)"
   by (rule has_derivative_imp_has_field_derivative[OF has_derivative_power])
      (auto simp: has_field_derivative_def)
 
 lemma DERIV_power[derivative_intros]:
   "(f has_field_derivative D) (at x within s) \<Longrightarrow>
     ((\<lambda>x. f x ^ n) has_field_derivative of_nat n * (D * f x ^ (n - Suc 0))) (at x within s)"
   by (rule has_derivative_imp_has_field_derivative[OF has_derivative_power])
      (auto simp: has_field_derivative_def)
 
 lemma DERIV_pow: "((\<lambda>x. x ^ n) has_field_derivative real n * (x ^ (n - Suc 0))) (at x within s)"
   using DERIV_power [OF DERIV_ident] by simp
 
 lemma DERIV_power_int [derivative_intros]:
   assumes [derivative_intros]: "(f has_field_derivative d) (at x within s)" and [simp]: "f x \<noteq> 0"
   shows   "((\<lambda>x. power_int (f x) n) has_field_derivative
              (of_int n * power_int (f x) (n - 1) * d)) (at x within s)"
 proof (cases n rule: int_cases4)
   case (nonneg n)
   thus ?thesis 
     by (cases "n = 0")
        (auto intro!: derivative_eq_intros simp: field_simps power_int_diff
              simp flip: power_Suc power_Suc2 power_add)
 next
   case (neg n)
   thus ?thesis
     by (auto intro!: derivative_eq_intros simp: field_simps power_int_diff power_int_minus
              simp flip: power_Suc power_Suc2 power_add)
 qed
 
 lemma DERIV_chain': "(f has_field_derivative D) (at x within s) \<Longrightarrow> DERIV g (f x) :> E \<Longrightarrow>
   ((\<lambda>x. g (f x)) has_field_derivative E * D) (at x within s)"
   using has_derivative_compose[of f "(*) D" x s g "(*) E"]
   by (simp only: has_field_derivative_def mult_commute_abs ac_simps)
 
 corollary DERIV_chain2: "DERIV f (g x) :> Da \<Longrightarrow> (g has_field_derivative Db) (at x within s) \<Longrightarrow>
   ((\<lambda>x. f (g x)) has_field_derivative Da * Db) (at x within s)"
   by (rule DERIV_chain')
 
 text \<open>Standard version\<close>
 
 lemma DERIV_chain:
   "DERIV f (g x) :> Da \<Longrightarrow> (g has_field_derivative Db) (at x within s) \<Longrightarrow>
     (f \<circ> g has_field_derivative Da * Db) (at x within s)"
   by (drule (1) DERIV_chain', simp add: o_def mult.commute)
 
 lemma DERIV_image_chain:
   "(f has_field_derivative Da) (at (g x) within (g ` s)) \<Longrightarrow>
     (g has_field_derivative Db) (at x within s) \<Longrightarrow>
     (f \<circ> g has_field_derivative Da * Db) (at x within s)"
   using has_derivative_in_compose [of g "(*) Db" x s f "(*) Da "]
   by (simp add: has_field_derivative_def o_def mult_commute_abs ac_simps)
 
 (*These two are from HOL Light: HAS_COMPLEX_DERIVATIVE_CHAIN*)
 lemma DERIV_chain_s:
   assumes "(\<And>x. x \<in> s \<Longrightarrow> DERIV g x :> g'(x))"
     and "DERIV f x :> f'"
     and "f x \<in> s"
   shows "DERIV (\<lambda>x. g(f x)) x :> f' * g'(f x)"
   by (metis (full_types) DERIV_chain' mult.commute assms)
 
 lemma DERIV_chain3: (*HAS_COMPLEX_DERIVATIVE_CHAIN_UNIV*)
   assumes "(\<And>x. DERIV g x :> g'(x))"
     and "DERIV f x :> f'"
   shows "DERIV (\<lambda>x. g(f x)) x :> f' * g'(f x)"
   by (metis UNIV_I DERIV_chain_s [of UNIV] assms)
 
 text \<open>Alternative definition for differentiability\<close>
 
 lemma DERIV_LIM_iff:
   fixes f :: "'a::{real_normed_vector,inverse} \<Rightarrow> 'a"
   shows "((\<lambda>h. (f (a + h) - f a) / h) \<midarrow>0\<rightarrow> D) = ((\<lambda>x. (f x - f a) / (x - a)) \<midarrow>a\<rightarrow> D)" (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then have "(\<lambda>x. (f (a + (x + - a)) - f a) / (x + - a)) \<midarrow>0 - - a\<rightarrow> D"
     by (rule LIM_offset)
   then show ?rhs
     by simp
 next
   assume ?rhs
   then have "(\<lambda>x. (f (x+a) - f a) / ((x+a) - a)) \<midarrow>a-a\<rightarrow> D"
     by (rule LIM_offset)
   then show ?lhs
     by (simp add: add.commute)
 qed
 
 lemma has_field_derivative_cong_ev:
   assumes "x = y"
     and *: "eventually (\<lambda>x. x \<in> S \<longrightarrow> f x = g x) (nhds x)"
     and "u = v" "S = t" "x \<in> S"
   shows "(f has_field_derivative u) (at x within S) = (g has_field_derivative v) (at y within t)"
   unfolding has_field_derivative_iff
 proof (rule filterlim_cong)
   from assms have "f y = g y"
     by (auto simp: eventually_nhds)
   with * show "\<forall>\<^sub>F z in at x within S. (f z - f x) / (z - x) = (g z - g y) / (z - y)"
     unfolding eventually_at_filter
     by eventually_elim (auto simp: assms \<open>f y = g y\<close>)
 qed (simp_all add: assms)
 
 lemma has_field_derivative_cong_eventually:
   assumes "eventually (\<lambda>x. f x = g x) (at x within S)" "f x = g x"
   shows "(f has_field_derivative u) (at x within S) = (g has_field_derivative u) (at x within S)"
   unfolding has_field_derivative_iff
 proof (rule tendsto_cong)
   show "\<forall>\<^sub>F y in at x within S. (f y - f x) / (y - x) = (g y - g x) / (y - x)"
     using assms by (auto elim: eventually_mono)
 qed
 
 lemma DERIV_cong_ev:
   "x = y \<Longrightarrow> eventually (\<lambda>x. f x = g x) (nhds x) \<Longrightarrow> u = v \<Longrightarrow>
     DERIV f x :> u \<longleftrightarrow> DERIV g y :> v"
   by (rule has_field_derivative_cong_ev) simp_all
 
 lemma DERIV_mirror: "(DERIV f (- x) :> y) \<longleftrightarrow> (DERIV (\<lambda>x. f (- x)) x :> - y)"
   for f :: "real \<Rightarrow> real" and x y :: real
   by (simp add: DERIV_def filterlim_at_split filterlim_at_left_to_right
       tendsto_minus_cancel_left field_simps conj_commute)
 
 lemma DERIV_shift:
   "(f has_field_derivative y) (at (x + z)) = ((\<lambda>x. f (x + z)) has_field_derivative y) (at x)"
   by (simp add: DERIV_def field_simps)
 
 lemma DERIV_at_within_shift_lemma:
   assumes "(f has_field_derivative y) (at (z+x) within (+) z ` S)"
   shows "(f \<circ> (+)z has_field_derivative y) (at x within S)"
 proof -
   have "((+)z has_field_derivative 1) (at x within S)"
     by (rule derivative_eq_intros | simp)+
   with assms DERIV_image_chain show ?thesis
     by (metis mult.right_neutral)
 qed
 
 lemma DERIV_at_within_shift:
   "(f has_field_derivative y) (at (z+x) within (+) z ` S) \<longleftrightarrow> 
    ((\<lambda>x. f (z+x)) has_field_derivative y) (at x within S)"   (is "?lhs = ?rhs")
 proof
   assume ?lhs then show ?rhs
     using DERIV_at_within_shift_lemma unfolding o_def by blast
 next
   have [simp]: "(\<lambda>x. x - z) ` (+) z ` S = S"
     by force
   assume R: ?rhs
   have "(f \<circ> (+) z \<circ> (+) (- z) has_field_derivative y) (at (z + x) within (+) z ` S)"
     by (rule DERIV_at_within_shift_lemma) (use R in \<open>simp add: o_def\<close>)
   then show ?lhs
     by (simp add: o_def)
 qed
 
 lemma floor_has_real_derivative:
   fixes f :: "real \<Rightarrow> 'a::{floor_ceiling,order_topology}"
   assumes "isCont f x"
     and "f x \<notin> \<int>"
   shows "((\<lambda>x. floor (f x)) has_real_derivative 0) (at x)"
 proof (subst DERIV_cong_ev[OF refl _ refl])
   show "((\<lambda>_. floor (f x)) has_real_derivative 0) (at x)"
     by simp
   have "\<forall>\<^sub>F y in at x. \<lfloor>f y\<rfloor> = \<lfloor>f x\<rfloor>"
     by (rule eventually_floor_eq[OF assms[unfolded continuous_at]])
   then show "\<forall>\<^sub>F y in nhds x. real_of_int \<lfloor>f y\<rfloor> = real_of_int \<lfloor>f x\<rfloor>"
     unfolding eventually_at_filter
     by eventually_elim auto
 qed
 
 lemmas has_derivative_floor[derivative_intros] =
   floor_has_real_derivative[THEN DERIV_compose_FDERIV]
 
 lemma continuous_floor:
   fixes x::real
   shows "x \<notin> \<int> \<Longrightarrow> continuous (at x) (real_of_int \<circ> floor)"
   using floor_has_real_derivative [where f=id]
   by (auto simp: o_def has_field_derivative_def intro: has_derivative_continuous)
 
 lemma continuous_frac:
   fixes x::real
   assumes "x \<notin> \<int>"
   shows "continuous (at x) frac"
 proof -
   have "isCont (\<lambda>x. real_of_int \<lfloor>x\<rfloor>) x"
     using continuous_floor [OF assms] by (simp add: o_def)
   then have *: "continuous (at x) (\<lambda>x. x - real_of_int \<lfloor>x\<rfloor>)"
     by (intro continuous_intros)
   moreover have "\<forall>\<^sub>F x in nhds x. frac x = x - real_of_int \<lfloor>x\<rfloor>"
     by (simp add: frac_def)
   ultimately show ?thesis
     by (simp add: LIM_imp_LIM frac_def isCont_def)
 qed
 
 text \<open>Caratheodory formulation of derivative at a point\<close>
 
 lemma CARAT_DERIV:
   "(DERIV f x :> l) \<longleftrightarrow> (\<exists>g. (\<forall>z. f z - f x = g z * (z - x)) \<and> isCont g x \<and> g x = l)"
   (is "?lhs = ?rhs")
 proof
   assume ?lhs
   show "\<exists>g. (\<forall>z. f z - f x = g z * (z - x)) \<and> isCont g x \<and> g x = l"
   proof (intro exI conjI)
     let ?g = "(\<lambda>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 "isCont ?g x"
       using \<open>?lhs\<close> by (simp add: isCont_iff DERIV_def cong: LIM_equal [rule_format])
     show "?g x = l"
       by simp
   qed
 next
   assume ?rhs
   then show ?lhs
     by (auto simp add: isCont_iff DERIV_def cong: LIM_cong)
 qed
 
 
 subsection \<open>Local extrema\<close>
 
 text \<open>If \<^term>\<open>0 < f' x\<close> then \<^term>\<open>x\<close> is Locally Strictly Increasing At The Right.\<close>
 
 lemma has_real_derivative_pos_inc_right:
   fixes f :: "real \<Rightarrow> real"
   assumes der: "(f has_real_derivative l) (at x within S)"
     and l: "0 < l"
   shows "\<exists>d > 0. \<forall>h > 0. x + h \<in> S \<longrightarrow> h < d \<longrightarrow> f x < f (x + h)"
   using assms
 proof -
   from der [THEN has_field_derivativeD, THEN tendstoD, OF l, unfolded eventually_at]
   obtain s where s: "0 < s"
     and all: "\<And>xa. xa\<in>S \<Longrightarrow> xa \<noteq> x \<and> dist xa x < s \<longrightarrow> \<bar>(f xa - f x) / (xa - x) - l\<bar> < l"
     by (auto simp: dist_real_def)
   then show ?thesis
   proof (intro exI conjI strip)
     show "0 < s" by (rule s)
   next
     fix h :: real
     assume "0 < h" "h < s" "x + h \<in> S"
     with all [of "x + h"] show "f x < f (x+h)"
     proof (simp add: abs_if dist_real_def pos_less_divide_eq split: if_split_asm)
       assume "\<not> (f (x + h) - f x) / h < l" and h: "0 < h"
       with l have "0 < (f (x + h) - f x) / h"
         by arith
       then show "f x < f (x + h)"
         by (simp add: pos_less_divide_eq h)
     qed
   qed
 qed
 
 lemma DERIV_pos_inc_right:
   fixes f :: "real \<Rightarrow> real"
   assumes der: "DERIV f x :> l"
     and l: "0 < l"
   shows "\<exists>d > 0. \<forall>h > 0. h < d \<longrightarrow> f x < f (x + h)"
   using has_real_derivative_pos_inc_right[OF assms]
   by auto
 
 lemma has_real_derivative_neg_dec_left:
   fixes f :: "real \<Rightarrow> real"
   assumes der: "(f has_real_derivative l) (at x within S)"
     and "l < 0"
   shows "\<exists>d > 0. \<forall>h > 0. x - h \<in> S \<longrightarrow> h < d \<longrightarrow> f x < f (x - h)"
 proof -
   from \<open>l < 0\<close> have l: "- l > 0"
     by simp
   from der [THEN has_field_derivativeD, THEN tendstoD, OF l, unfolded eventually_at]
   obtain s where s: "0 < s"
     and all: "\<And>xa. xa\<in>S \<Longrightarrow> xa \<noteq> x \<and> dist xa x < s \<longrightarrow> \<bar>(f xa - f x) / (xa - x) - l\<bar> < - l"
     by (auto simp: dist_real_def)
   then show ?thesis
   proof (intro exI conjI strip)
     show "0 < s" by (rule s)
   next
     fix h :: real
     assume "0 < h" "h < s" "x - h \<in> S"
     with all [of "x - h"] show "f x < f (x-h)"
     proof (simp add: abs_if pos_less_divide_eq dist_real_def split: if_split_asm)
       assume "- ((f (x-h) - f x) / h) < l" and h: "0 < h"
       with l have "0 < (f (x-h) - f x) / h"
         by arith
       then show "f x < f (x - h)"
         by (simp add: pos_less_divide_eq h)
     qed
   qed
 qed
 
 lemma DERIV_neg_dec_left:
   fixes f :: "real \<Rightarrow> real"
   assumes der: "DERIV f x :> l"
     and l: "l < 0"
   shows "\<exists>d > 0. \<forall>h > 0. h < d \<longrightarrow> f x < f (x - h)"
   using has_real_derivative_neg_dec_left[OF assms]
   by auto
 
 lemma has_real_derivative_pos_inc_left:
   fixes f :: "real \<Rightarrow> real"
   shows "(f has_real_derivative l) (at x within S) \<Longrightarrow> 0 < l \<Longrightarrow>
     \<exists>d>0. \<forall>h>0. x - h \<in> S \<longrightarrow> h < d \<longrightarrow> f (x - h) < f x"
   by (rule has_real_derivative_neg_dec_left [of "\<lambda>x. - f x" "-l" x S, simplified])
       (auto simp add: DERIV_minus)
 
 lemma DERIV_pos_inc_left:
   fixes f :: "real \<Rightarrow> real"
   shows "DERIV f x :> l \<Longrightarrow> 0 < l \<Longrightarrow> \<exists>d > 0. \<forall>h > 0. h < d \<longrightarrow> f (x - h) < f x"
   using has_real_derivative_pos_inc_left
   by blast
 
 lemma has_real_derivative_neg_dec_right:
   fixes f :: "real \<Rightarrow> real"
   shows "(f has_real_derivative l) (at x within S) \<Longrightarrow> l < 0 \<Longrightarrow>
     \<exists>d > 0. \<forall>h > 0. x + h \<in> S \<longrightarrow> h < d \<longrightarrow> f x > f (x + h)"
   by (rule has_real_derivative_pos_inc_right [of "\<lambda>x. - f x" "-l" x S, simplified])
       (auto simp add: DERIV_minus)
 
 lemma DERIV_neg_dec_right:
   fixes f :: "real \<Rightarrow> real"
   shows "DERIV f x :> l \<Longrightarrow> l < 0 \<Longrightarrow> \<exists>d > 0. \<forall>h > 0. h < d \<longrightarrow> f x > f (x + h)"
   using has_real_derivative_neg_dec_right by blast
 
 lemma DERIV_local_max:
   fixes f :: "real \<Rightarrow> real"
   assumes der: "DERIV f x :> l"
     and d: "0 < d"
     and le: "\<forall>y. \<bar>x - y\<bar> < d \<longrightarrow> f y \<le> f x"
   shows "l = 0"
 proof (cases rule: linorder_cases [of l 0])
   case equal
   then show ?thesis .
 next
   case less
   from DERIV_neg_dec_left [OF der less]
   obtain d' where d': "0 < d'" and lt: "\<forall>h > 0. h < d' \<longrightarrow> f x < f (x - h)"
     by blast
   obtain e where "0 < e \<and> e < d \<and> e < d'"
     using field_lbound_gt_zero [OF d d']  ..
   with lt le [THEN spec [where x="x - e"]] show ?thesis
     by (auto simp add: abs_if)
 next
   case greater
   from DERIV_pos_inc_right [OF der greater]
   obtain d' where d': "0 < d'" and lt: "\<forall>h > 0. h < d' \<longrightarrow> f x < f (x + h)"
     by blast
   obtain e where "0 < e \<and> e < d \<and> e < d'"
     using field_lbound_gt_zero [OF d d'] ..
   with lt le [THEN spec [where x="x + e"]] show ?thesis
     by (auto simp add: abs_if)
 qed
 
 text \<open>Similar theorem for a local minimum\<close>
 lemma DERIV_local_min:
   fixes f :: "real \<Rightarrow> real"
   shows "DERIV f x :> l \<Longrightarrow> 0 < d \<Longrightarrow> \<forall>y. \<bar>x - y\<bar> < d \<longrightarrow> f x \<le> f y \<Longrightarrow> l = 0"
   by (drule DERIV_minus [THEN DERIV_local_max]) auto
 
 
 text\<open>In particular, if a function is locally flat\<close>
 lemma DERIV_local_const:
   fixes f :: "real \<Rightarrow> real"
   shows "DERIV f x :> l \<Longrightarrow> 0 < d \<Longrightarrow> \<forall>y. \<bar>x - y\<bar> < d \<longrightarrow> f x = f y \<Longrightarrow> l = 0"
   by (auto dest!: DERIV_local_max)
 
 
 subsection \<open>Rolle's Theorem\<close>
 
 text \<open>Lemma about introducing open ball in open interval\<close>
 lemma lemma_interval_lt: 
   fixes a b x :: real
   assumes "a < x" "x < b"
   shows "\<exists>d. 0 < d \<and> (\<forall>y. \<bar>x - y\<bar> < d \<longrightarrow> a < y \<and> y < b)"
   using linorder_linear [of "x - a" "b - x"]
 proof 
   assume "x - a \<le> b - x"
   with assms show ?thesis
     by (rule_tac x = "x - a" in exI) auto
 next
   assume "b - x \<le> x - a"
   with assms show ?thesis
     by (rule_tac x = "b - x" in exI) auto
 qed
 
 lemma lemma_interval: "a < x \<Longrightarrow> x < b \<Longrightarrow> \<exists>d. 0 < d \<and> (\<forall>y. \<bar>x - y\<bar> < d \<longrightarrow> a \<le> y \<and> y \<le> b)"
   for a b x :: real
   by (force dest: lemma_interval_lt)
 
 text \<open>Rolle's Theorem.
    If \<^term>\<open>f\<close> is defined and continuous on the closed interval
    \<open>[a,b]\<close> and differentiable on the open interval \<open>(a,b)\<close>,
    and \<^term>\<open>f a = f b\<close>,
    then there exists \<open>x0 \<in> (a,b)\<close> such that \<^term>\<open>f' x0 = 0\<close>\<close>
 theorem Rolle_deriv:
   fixes f :: "real \<Rightarrow> real"
   assumes "a < b"
     and fab: "f a = f 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>z. a < z \<and> z < b \<and> f' z = (\<lambda>v. 0)"
 proof -
   have le: "a \<le> b"
     using \<open>a < b\<close> by simp
     have "(a + b) / 2 \<in> {a..b}"
       using assms(1) by auto
     then have *: "{a..b} \<noteq> {}"
       by auto
   obtain x where x_max: "\<forall>z. a \<le> z \<and> z \<le> b \<longrightarrow> f z \<le> f x" and "a \<le> x" "x \<le> b"
     using continuous_attains_sup[OF compact_Icc * contf]
     by (meson atLeastAtMost_iff)
   obtain x' where x'_min: "\<forall>z. a \<le> z \<and> z \<le> b \<longrightarrow> f x' \<le> f z" and "a \<le> x'" "x' \<le> b"
     using continuous_attains_inf[OF compact_Icc * contf] by (meson atLeastAtMost_iff)
   consider "a < x" "x < b" | "x = a \<or> x = b"
     using \<open>a \<le> x\<close> \<open>x \<le> b\<close> by arith
   then show ?thesis
   proof cases
     case 1
     \<comment> \<open>\<^term>\<open>f\<close> attains its maximum within the interval\<close>
     then obtain l where der: "DERIV f x :> l"
       using derf differentiable_def real_differentiable_def by blast
     obtain d where d: "0 < d" and bound: "\<forall>y. \<bar>x - y\<bar> < d \<longrightarrow> a \<le> y \<and> y \<le> b"
       using lemma_interval [OF 1] by blast
     then have bound': "\<forall>y. \<bar>x - y\<bar> < d \<longrightarrow> f y \<le> f x"
       using x_max by blast
     \<comment> \<open>the derivative at a local maximum is zero\<close>
     have "l = 0"
       by (rule DERIV_local_max [OF der d bound'])
     with 1 der derf [of x] show ?thesis
       by (metis has_derivative_unique has_field_derivative_def mult_zero_left)
   next
     case 2
     then have fx: "f b = f x" by (auto simp add: fab)
     consider "a < x'" "x' < b" | "x' = a \<or> x' = b"
       using \<open>a \<le> x'\<close> \<open>x' \<le> b\<close> by arith
     then show ?thesis
     proof cases
       case 1
         \<comment> \<open>\<^term>\<open>f\<close> attains its minimum within the interval\<close>
       then obtain l where der: "DERIV f x' :> l"
         using derf differentiable_def real_differentiable_def by blast 
       from lemma_interval [OF 1]
       obtain d where d: "0<d" and bound: "\<forall>y. \<bar>x'-y\<bar> < d \<longrightarrow> a \<le> y \<and> y \<le> b"
         by blast
       then have bound': "\<forall>y. \<bar>x' - y\<bar> < d \<longrightarrow> f x' \<le> f y"
         using x'_min by blast
       have "l = 0" by (rule DERIV_local_min [OF der d bound'])
         \<comment> \<open>the derivative at a local minimum is zero\<close>
       then show ?thesis using 1 der derf [of x'] 
         by (metis has_derivative_unique has_field_derivative_def mult_zero_left)
     next
       case 2
         \<comment> \<open>\<^term>\<open>f\<close> is constant throughout the interval\<close>
       then have fx': "f b = f x'" by (auto simp: fab)
       from dense [OF \<open>a < b\<close>] obtain r where r: "a < r" "r < b" by blast
       obtain d where d: "0 < d" and bound: "\<forall>y. \<bar>r - y\<bar> < d \<longrightarrow> a \<le> y \<and> y \<le> b"
         using lemma_interval [OF r] by blast
       have eq_fb: "f z = f b" if "a \<le> z" and "z \<le> b" for z
       proof (rule order_antisym)
         show "f z \<le> f b" by (simp add: fx x_max that)
         show "f b \<le> f z" by (simp add: fx' x'_min that)
       qed
       have bound': "\<forall>y. \<bar>r - y\<bar> < d \<longrightarrow> f r = f y"
       proof (intro strip)
         fix y :: real
         assume lt: "\<bar>r - y\<bar> < d"
         then have "f y = f b" by (simp add: eq_fb bound)
         then show "f r = f y" by (simp add: eq_fb r order_less_imp_le)
       qed
       obtain l where der: "DERIV f r :> l"
         using derf differentiable_def r(1) r(2) real_differentiable_def by blast
       have "l = 0"
         by (rule DERIV_local_const [OF der d bound'])
         \<comment> \<open>the derivative of a constant function is zero\<close>
       with r der derf [of r] show ?thesis
         by (metis has_derivative_unique has_field_derivative_def mult_zero_left)
     qed
   qed
 qed
 
 corollary Rolle:
   fixes a b :: real
   assumes ab: "a < b" "f a = f b" "continuous_on {a..b} f"
     and dif [rule_format]: "\<And>x. \<lbrakk>a < x; x < b\<rbrakk> \<Longrightarrow> f differentiable (at x)"
   shows "\<exists>z. a < z \<and> z < b \<and> DERIV f z :> 0"
 proof -
   obtain f' where f': "\<And>x. \<lbrakk>a < x; x < b\<rbrakk> \<Longrightarrow> (f has_derivative f' x) (at x)"
     using dif unfolding differentiable_def by metis
   then have "\<exists>z. a < z \<and> z < b \<and> f' z = (\<lambda>v. 0)"
     by (metis Rolle_deriv [OF ab])
   then show ?thesis
     using f' has_derivative_imp_has_field_derivative by fastforce
 qed
 
 subsection \<open>Mean Value Theorem\<close>
 
 theorem mvt:
   fixes f :: "real \<Rightarrow> real"
   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)"
   obtains \<xi> where "a < \<xi>" "\<xi> < b" "f b - f a = (f' \<xi>) (b - a)"
 proof -
   have "\<exists>\<xi>. a < \<xi> \<and> \<xi> < b \<and> (\<lambda>y. f' \<xi> y - (f b - f a) / (b - a) * y) = (\<lambda>v. 0)"
   proof (intro Rolle_deriv[OF \<open>a < b\<close>])
     fix x
     assume x: "a < x" "x < b"
     show "((\<lambda>x. f x - (f b - f a) / (b - a) * x) 
           has_derivative (\<lambda>y. f' x y - (f b - f a) / (b - a) * y)) (at x)"
       by (intro derivative_intros derf[OF x])
   qed (use assms in \<open>auto intro!: continuous_intros simp: field_simps\<close>)
   then show ?thesis
     by (smt (verit, ccfv_SIG) pos_le_divide_eq pos_less_divide_eq that)
 qed
 
 theorem MVT:
   fixes a b :: real
   assumes lt: "a < b"
     and contf: "continuous_on {a..b} f"
     and dif: "\<And>x. \<lbrakk>a < x; x < b\<rbrakk> \<Longrightarrow> f differentiable (at x)"
   shows "\<exists>l z. a < z \<and> z < b \<and> DERIV f z :> l \<and> f b - f a = (b - a) * l"
 proof -
   obtain f' :: "real \<Rightarrow> real \<Rightarrow> real"
     where derf: "\<And>x. a < x \<Longrightarrow> x < b \<Longrightarrow> (f has_derivative f' x) (at x)"
     using dif unfolding differentiable_def by metis
   then obtain z where "a < z" "z < b" "f b - f a = (f' z) (b - a)"
     using mvt [OF lt contf] by blast
   then show ?thesis
     by (simp add: ac_simps)
       (metis derf dif has_derivative_unique has_field_derivative_imp_has_derivative real_differentiable_def)
 qed
 
 corollary MVT2:
   assumes "a < b" and der: "\<And>x. \<lbrakk>a \<le> x; x \<le> b\<rbrakk> \<Longrightarrow> DERIV f x :> f' x"
   shows "\<exists>z::real. a < z \<and> z < b \<and> (f b - f a = (b - a) * f' z)"
 proof -
   have "\<exists>l z. a < z \<and>
            z < b \<and>
            (f has_real_derivative l) (at z) \<and>
            f b - f a = (b - a) * l"
   proof (rule MVT [OF \<open>a < b\<close>])
     show "continuous_on {a..b} f"
       by (meson DERIV_continuous atLeastAtMost_iff continuous_at_imp_continuous_on der) 
     show "\<And>x. \<lbrakk>a < x; x < b\<rbrakk> \<Longrightarrow> f differentiable (at x)"
       using assms by (force dest: order_less_imp_le simp add: real_differentiable_def)
   qed
   with assms show ?thesis
     by (blast dest: DERIV_unique order_less_imp_le)
 qed
 
 lemma pos_deriv_imp_strict_mono:
   assumes "\<And>x. (f has_real_derivative f' x) (at x)"
   assumes "\<And>x. f' x > 0"
   shows   "strict_mono f"
 proof (rule strict_monoI)
   fix x y :: real assume xy: "x < y"
   from assms and xy have "\<exists>z>x. z < y \<and> f y - f x = (y - x) * f' z"
     by (intro MVT2) (auto dest: connectedD_interval)
   then obtain z where z: "z > x" "z < y" "f y - f x = (y - x) * f' z" by blast
   note \<open>f y - f x = (y - x) * f' z\<close>
   also have "(y - x) * f' z > 0" using xy assms by (intro mult_pos_pos) auto
   finally show "f x < f y" by simp
 qed
 
 proposition  deriv_nonneg_imp_mono:
   assumes deriv: "\<And>x. x \<in> {a..b} \<Longrightarrow> (g has_real_derivative g' x) (at x)"
   assumes nonneg: "\<And>x. x \<in> {a..b} \<Longrightarrow> g' x \<ge> 0"
   assumes ab: "a \<le> b"
   shows "g a \<le> g b"
 proof (cases "a < b")
   assume "a < b"
   from deriv have "\<And>x. \<lbrakk>x \<ge> a; x \<le> b\<rbrakk> \<Longrightarrow> (g has_real_derivative g' x) (at x)" by simp
   with MVT2[OF \<open>a < b\<close>] and deriv
     obtain \<xi> where \<xi>_ab: "\<xi> > a" "\<xi> < b" and g_ab: "g b - g a = (b - a) * g' \<xi>" by blast
   from \<xi>_ab ab nonneg have "(b - a) * g' \<xi> \<ge> 0" by simp
   with g_ab show ?thesis by simp
 qed (insert ab, simp)
 
 
 subsubsection \<open>A function is constant if its derivative is 0 over an interval.\<close>
 
 lemma DERIV_isconst_end:
   fixes f :: "real \<Rightarrow> real"
   assumes "a < b" and contf: "continuous_on {a..b} f"
     and 0: "\<And>x. \<lbrakk>a < x; x < b\<rbrakk> \<Longrightarrow> DERIV f x :> 0"
   shows "f b = f a"
   using MVT [OF \<open>a < b\<close>] "0" DERIV_unique contf real_differentiable_def
   by (fastforce simp: algebra_simps)
 
 lemma DERIV_isconst2:
   fixes f :: "real \<Rightarrow> real"
   assumes "a < b" and contf: "continuous_on {a..b} f" and derf: "\<And>x. \<lbrakk>a < x; x < b\<rbrakk> \<Longrightarrow> DERIV f x :> 0"
     and "a \<le> x" "x \<le> b"
 shows "f x = f a"
 proof (cases "a < x")
   case True
   have *: "continuous_on {a..x} f"
     using \<open>x \<le> b\<close> contf continuous_on_subset by fastforce
   show ?thesis
     by (rule DERIV_isconst_end [OF True *]) (use \<open>x \<le> b\<close> derf in auto)
 qed (use \<open>a \<le> x\<close> in auto)
 
 lemma DERIV_isconst3:
   fixes a b x y :: real
   assumes "a < b"
     and "x \<in> {a <..< b}"
     and "y \<in> {a <..< b}"
     and derivable: "\<And>x. x \<in> {a <..< b} \<Longrightarrow> DERIV f x :> 0"
   shows "f x = f y"
 proof (cases "x = y")
   case False
   let ?a = "min x y"
   let ?b = "max x y"
   have *: "DERIV f z :> 0" if "?a \<le> z" "z \<le> ?b" for z
   proof -
     have "a < z" and "z < b"
       using that \<open>x \<in> {a <..< b}\<close> and \<open>y \<in> {a <..< b}\<close> by auto
     then have "z \<in> {a<..<b}" by auto
     then show "DERIV f z :> 0" by (rule derivable)
   qed
   have isCont: "continuous_on {?a..?b} f"
     by (meson * DERIV_continuous_on atLeastAtMost_iff has_field_derivative_at_within)
   have DERIV: "\<And>z. \<lbrakk>?a < z; z < ?b\<rbrakk> \<Longrightarrow> DERIV f z :> 0"
     using * by auto
   have "?a < ?b" using \<open>x \<noteq> y\<close> by auto
   from DERIV_isconst2[OF this isCont DERIV, of x] and DERIV_isconst2[OF this isCont DERIV, of y]
   show ?thesis by auto
 qed auto
 
 lemma DERIV_isconst_all:
   fixes f :: "real \<Rightarrow> real"
   shows "\<forall>x. DERIV f x :> 0 \<Longrightarrow> f x = f y"
   apply (rule linorder_cases [of x y])
   apply (metis DERIV_continuous DERIV_isconst_end continuous_at_imp_continuous_on)+
   done
 
 lemma DERIV_const_ratio_const:
   fixes f :: "real \<Rightarrow> real"
   assumes "a \<noteq> b" and df: "\<And>x. DERIV f x :> k"
   shows "f b - f a = (b - a) * k"
 proof (cases a b rule: linorder_cases)
   case less
   show ?thesis
     using MVT [OF less] df
     by (metis DERIV_continuous DERIV_unique continuous_at_imp_continuous_on real_differentiable_def)
 next
   case greater
   have  "f a - f b = (a - b) * k"
     using MVT [OF greater] df
     by (metis DERIV_continuous DERIV_unique continuous_at_imp_continuous_on real_differentiable_def)
   then show ?thesis
     by (simp add: algebra_simps)
 qed auto
 
 lemma DERIV_const_ratio_const2:
   fixes f :: "real \<Rightarrow> real"
   assumes "a \<noteq> b" and df: "\<And>x. DERIV f x :> k"
   shows "(f b - f a) / (b - a) = k"
   using DERIV_const_ratio_const [OF assms] \<open>a \<noteq> b\<close> by auto
 
 lemma real_average_minus_first [simp]: "(a + b) / 2 - a = (b - a) / 2"
   for a b :: real
   by simp
 
 lemma real_average_minus_second [simp]: "(b + a) / 2 - a = (b - a) / 2"
   for a b :: real
   by simp
 
 text \<open>Gallileo's "trick": average velocity = av. of end velocities.\<close>
 
 lemma DERIV_const_average:
   fixes v :: "real \<Rightarrow> real"
     and a b :: real
   assumes neq: "a \<noteq> b"
     and der: "\<And>x. DERIV v x :> k"
   shows "v ((a + b) / 2) = (v a + v b) / 2"
 proof (cases rule: linorder_cases [of a b])
   case equal
   with neq show ?thesis by simp
 next
   case less
   have "(v b - v a) / (b - a) = k"
     by (rule DERIV_const_ratio_const2 [OF neq der])
   then have "(b - a) * ((v b - v a) / (b - a)) = (b - a) * k"
     by simp
   moreover have "(v ((a + b) / 2) - v a) / ((a + b) / 2 - a) = k"
     by (rule DERIV_const_ratio_const2 [OF _ der]) (simp add: neq)
   ultimately show ?thesis
     using neq by force
 next
   case greater
   have "(v b - v a) / (b - a) = k"
     by (rule DERIV_const_ratio_const2 [OF neq der])
   then have "(b - a) * ((v b - v a) / (b - a)) = (b - a) * k"
     by simp
   moreover have " (v ((b + a) / 2) - v a) / ((b + a) / 2 - a) = k"
     by (rule DERIV_const_ratio_const2 [OF _ der]) (simp add: neq)
   ultimately show ?thesis
     using neq by (force simp add: add.commute)
 qed
 
 subsubsection\<open>A function with positive derivative is increasing\<close>
 text \<open>A simple proof using the MVT, by Jeremy Avigad. And variants.\<close>
 lemma DERIV_pos_imp_increasing_open:
   fixes a b :: real
     and f :: "real \<Rightarrow> real"
   assumes "a < b"
     and "\<And>x. a < x \<Longrightarrow> x < b \<Longrightarrow> (\<exists>y. DERIV f x :> y \<and> y > 0)"
     and con: "continuous_on {a..b} f"
   shows "f a < f b"
 proof (rule ccontr)
   assume f: "\<not> ?thesis"
   have "\<exists>l z. a < z \<and> z < b \<and> DERIV f z :> l \<and> f b - f a = (b - a) * l"
     by (rule MVT) (use assms real_differentiable_def in \<open>force+\<close>)
   then obtain l z where z: "a < z" "z < b" "DERIV f z :> l" and "f b - f a = (b - a) * l"
     by auto
   with assms f have "\<not> l > 0"
     by (metis linorder_not_le mult_le_0_iff diff_le_0_iff_le)
   with assms z show False
     by (metis DERIV_unique)
 qed
 
 lemma DERIV_pos_imp_increasing:
   fixes a b :: real and f :: "real \<Rightarrow> real"
   assumes "a < b"
     and der: "\<And>x. \<lbrakk>a \<le> x; x \<le> b\<rbrakk> \<Longrightarrow> \<exists>y. DERIV f x :> y \<and> y > 0"
   shows "f a < f b"
   by (metis less_le_not_le DERIV_atLeastAtMost_imp_continuous_on DERIV_pos_imp_increasing_open [OF \<open>a < b\<close>] der)
 
 lemma DERIV_nonneg_imp_nondecreasing:
   fixes a b :: real
     and f :: "real \<Rightarrow> real"
   assumes "a \<le> b"
     and "\<And>x. \<lbrakk>a \<le> x; x \<le> b\<rbrakk> \<Longrightarrow> \<exists>y. DERIV f x :> y \<and> y \<ge> 0"
   shows "f a \<le> f b"
 proof (rule ccontr, cases "a = b")
   assume "\<not> ?thesis" and "a = b"
   then show False by auto
 next
   assume *: "\<not> ?thesis"
   assume "a \<noteq> b"
   with \<open>a \<le> b\<close> have "a < b"
     by linarith
   moreover have "continuous_on {a..b} f"
     by (meson DERIV_isCont assms(2) atLeastAtMost_iff continuous_at_imp_continuous_on)
   ultimately have "\<exists>l z. a < z \<and> z < b \<and> DERIV f z :> l \<and> f b - f a = (b - a) * l"
     using assms MVT [OF \<open>a < b\<close>, of f] real_differentiable_def less_eq_real_def by blast
   then obtain l z where lz: "a < z" "z < b" "DERIV f z :> l" and **: "f b - f a = (b - a) * l"
     by auto
   with * have "a < b" "f b < f a" by auto
   with ** have "\<not> l \<ge> 0" by (auto simp add: not_le algebra_simps)
     (metis * add_le_cancel_right assms(1) less_eq_real_def mult_right_mono add_left_mono linear order_refl)
   with assms lz show False
     by (metis DERIV_unique order_less_imp_le)
 qed
 
 lemma DERIV_neg_imp_decreasing_open:
   fixes a b :: real
     and f :: "real \<Rightarrow> real"
   assumes "a < b"
     and "\<And>x. a < x \<Longrightarrow> x < b \<Longrightarrow> \<exists>y. DERIV f x :> y \<and> y < 0"
     and con: "continuous_on {a..b} f"
   shows "f a > f b"
 proof -
   have "(\<lambda>x. -f x) a < (\<lambda>x. -f x) b"
   proof (rule DERIV_pos_imp_increasing_open [of a b])
     show "\<And>x. \<lbrakk>a < x; x < b\<rbrakk> \<Longrightarrow> \<exists>y. ((\<lambda>x. - f x) has_real_derivative y) (at x) \<and> 0 < y"
       using assms
       by simp (metis field_differentiable_minus neg_0_less_iff_less)
     show "continuous_on {a..b} (\<lambda>x. - f x)"
       using con continuous_on_minus by blast
   qed (use assms in auto)
   then show ?thesis
     by simp
 qed
 
 lemma DERIV_neg_imp_decreasing:
   fixes a b :: real and f :: "real \<Rightarrow> real"
   assumes "a < b"
     and der: "\<And>x. \<lbrakk>a \<le> x; x \<le> b\<rbrakk> \<Longrightarrow> \<exists>y. DERIV f x :> y \<and> y < 0"
   shows "f a > f b"
   by (metis less_le_not_le DERIV_atLeastAtMost_imp_continuous_on DERIV_neg_imp_decreasing_open [OF \<open>a < b\<close>] der)
 
 lemma DERIV_nonpos_imp_nonincreasing:
   fixes a b :: real
     and f :: "real \<Rightarrow> real"
   assumes "a \<le> b"
     and "\<And>x. \<lbrakk>a \<le> x; x \<le> b\<rbrakk> \<Longrightarrow> \<exists>y. DERIV f x :> y \<and> y \<le> 0"
   shows "f a \<ge> f b"
 proof -
   have "(\<lambda>x. -f x) a \<le> (\<lambda>x. -f x) b"
     using DERIV_nonneg_imp_nondecreasing [of a b "\<lambda>x. -f x"] assms DERIV_minus by fastforce
   then show ?thesis
     by simp
 qed
 
 lemma DERIV_pos_imp_increasing_at_bot:
   fixes f :: "real \<Rightarrow> real"
   assumes "\<And>x. x \<le> b \<Longrightarrow> (\<exists>y. DERIV f x :> y \<and> y > 0)"
     and lim: "(f \<longlongrightarrow> flim) at_bot"
   shows "flim < f b"
 proof -
   have "\<exists>N. \<forall>n\<le>N. f n \<le> f (b - 1)"
     by (rule_tac x="b - 2" in exI) (force intro: order.strict_implies_order DERIV_pos_imp_increasing assms)
   then have "flim \<le> f (b - 1)"
      by (auto simp: eventually_at_bot_linorder tendsto_upperbound [OF lim])
   also have "\<dots> < f b"
     by (force intro: DERIV_pos_imp_increasing [where f=f] assms)
   finally show ?thesis .
 qed
 
 lemma DERIV_neg_imp_decreasing_at_top:
   fixes f :: "real \<Rightarrow> real"
   assumes der: "\<And>x. x \<ge> b \<Longrightarrow> \<exists>y. DERIV f x :> y \<and> y < 0"
     and lim: "(f \<longlongrightarrow> flim) at_top"
   shows "flim < f b"
   apply (rule DERIV_pos_imp_increasing_at_bot [where f = "\<lambda>i. f (-i)" and b = "-b", simplified])
    apply (metis DERIV_mirror der le_minus_iff neg_0_less_iff_less)
   apply (metis filterlim_at_top_mirror lim)
   done
 
 text \<open>Derivative of inverse function\<close>
 
 lemma DERIV_inverse_function:
   fixes f g :: "real \<Rightarrow> real"
   assumes der: "DERIV f (g x) :> D"
     and neq: "D \<noteq> 0"
     and x: "a < x" "x < b"
     and inj: "\<And>y. \<lbrakk>a < y; y < b\<rbrakk> \<Longrightarrow> f (g y) = y"
     and cont: "isCont g x"
   shows "DERIV g x :> inverse D"
 unfolding has_field_derivative_iff
 proof (rule LIM_equal2)
   show "0 < min (x - a) (b - x)"
     using x by arith
 next
   fix y
   assume "norm (y - x) < min (x - a) (b - x)"
   then have "a < y" and "y < b"
     by (simp_all add: abs_less_iff)
   then show "(g y - g x) / (y - x) = inverse ((f (g y) - x) / (g y - g x))"
     by (simp add: inj)
 next
   have "(\<lambda>z. (f z - f (g x)) / (z - g x)) \<midarrow>g x\<rightarrow> D"
     by (rule der [unfolded has_field_derivative_iff])
   then have 1: "(\<lambda>z. (f z - x) / (z - g x)) \<midarrow>g x\<rightarrow> D"
     using inj x by simp
   have 2: "\<exists>d>0. \<forall>y. y \<noteq> x \<and> norm (y - x) < d \<longrightarrow> g y \<noteq> g x"
   proof (rule exI, safe)
     show "0 < min (x - a) (b - x)"
       using x by simp
   next
     fix y
     assume "norm (y - x) < min (x - a) (b - x)"
     then have y: "a < y" "y < b"
       by (simp_all add: abs_less_iff)
     assume "g y = g x"
     then have "f (g y) = f (g x)" by simp
     then have "y = x" using inj y x by simp
     also assume "y \<noteq> x"
     finally show False by simp
   qed
   have "(\<lambda>y. (f (g y) - x) / (g y - g x)) \<midarrow>x\<rightarrow> D"
     using cont 1 2 by (rule isCont_LIM_compose2)
   then show "(\<lambda>y. inverse ((f (g y) - x) / (g y - g x))) \<midarrow>x\<rightarrow> inverse D"
     using neq by (rule tendsto_inverse)
 qed
 
 subsection \<open>Generalized Mean Value Theorem\<close>
 
 theorem GMVT:
   fixes a b :: real
   assumes alb: "a < b"
     and fc: "\<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> isCont f x"
     and fd: "\<forall>x. a < x \<and> x < b \<longrightarrow> f differentiable (at x)"
     and gc: "\<forall>x. a \<le> x \<and> x \<le> b \<longrightarrow> isCont g x"
     and gd: "\<forall>x. a < x \<and> x < b \<longrightarrow> g differentiable (at x)"
   shows "\<exists>g'c f'c c.
     DERIV g c :> g'c \<and> DERIV f c :> f'c \<and> a < c \<and> c < b \<and> (f b - f a) * g'c = (g b - g a) * f'c"
 proof -
   let ?h = "\<lambda>x. (f b - f a) * g x - (g b - g a) * f x"
   have "\<exists>l z. a < z \<and> z < b \<and> DERIV ?h z :> l \<and> ?h b - ?h a = (b - a) * l"
   proof (rule MVT)
     from assms show "a < b" by simp
     show "continuous_on {a..b} ?h"
       by (simp add: continuous_at_imp_continuous_on fc gc)
     show "\<And>x. \<lbrakk>a < x; x < b\<rbrakk> \<Longrightarrow> ?h differentiable (at x)"
       using fd gd by simp
   qed
   then obtain l where l: "\<exists>z. a < z \<and> z < b \<and> DERIV ?h z :> l \<and> ?h b - ?h a = (b - a) * l" ..
   then obtain c where c: "a < c \<and> c < b \<and> DERIV ?h c :> l \<and> ?h b - ?h a = (b - a) * l" ..
 
   from c have cint: "a < c \<and> c < b" by auto
   then obtain g'c where g'c: "DERIV g c :> g'c"
     using gd real_differentiable_def by blast 
   from c have "a < c \<and> c < b" by auto
   then obtain f'c where f'c: "DERIV f c :> f'c"
     using fd real_differentiable_def by blast 
 
   from c have "DERIV ?h c :> l" by auto
   moreover have "DERIV ?h c :>  g'c * (f b - f a) - f'c * (g b - g a)"
     using g'c f'c by (auto intro!: derivative_eq_intros)
   ultimately have leq: "l =  g'c * (f b - f a) - f'c * (g b - g a)" by (rule DERIV_unique)
 
   have "?h b - ?h a = (b - a) * (g'c * (f b - f a) - f'c * (g b - g a))"
   proof -
     from c have "?h b - ?h a = (b - a) * l" by auto
     also from leq have "\<dots> = (b - a) * (g'c * (f b - f a) - f'c * (g b - g a))" by simp
     finally show ?thesis by simp
   qed
   moreover have "?h b - ?h a = 0"
   proof -
     have "?h b - ?h a =
       ((f b)*(g b) - (f a)*(g b) - (g b)*(f b) + (g a)*(f b)) -
       ((f b)*(g a) - (f a)*(g a) - (g b)*(f a) + (g a)*(f a))"
       by (simp add: algebra_simps)
     then show ?thesis  by auto
   qed
   ultimately have "(b - a) * (g'c * (f b - f a) - f'c * (g b - g a)) = 0" by auto
   with alb have "g'c * (f b - f a) - f'c * (g b - g a) = 0" by simp
   then have "g'c * (f b - f a) = f'c * (g b - g a)" by simp
   then have "(f b - f a) * g'c = (g b - g a) * f'c" by (simp add: ac_simps)
   with g'c f'c cint show ?thesis by auto
 qed
 
 lemma GMVT':
   fixes f g :: "real \<Rightarrow> real"
   assumes "a < b"
     and isCont_f: "\<And>z. a \<le> z \<Longrightarrow> z \<le> b \<Longrightarrow> isCont f z"
     and isCont_g: "\<And>z. a \<le> z \<Longrightarrow> z \<le> b \<Longrightarrow> isCont g z"
     and DERIV_g: "\<And>z. a < z \<Longrightarrow> z < b \<Longrightarrow> DERIV g z :> (g' z)"
     and DERIV_f: "\<And>z. a < z \<Longrightarrow> z < b \<Longrightarrow> DERIV f z :> (f' z)"
   shows "\<exists>c. a < c \<and> c < b \<and> (f b - f a) * g' c = (g b - g a) * f' c"
 proof -
   have "\<exists>g'c f'c c. DERIV g c :> g'c \<and> DERIV f c :> f'c \<and>
       a < c \<and> c < b \<and> (f b - f a) * g'c = (g b - g a) * f'c"
     using assms by (intro GMVT) (force simp: real_differentiable_def)+
   then obtain c where "a < c" "c < b" "(f b - f a) * g' c = (g b - g a) * f' c"
     using DERIV_f DERIV_g by (force dest: DERIV_unique)
   then show ?thesis
     by auto
 qed
 
 
 subsection \<open>L'Hopitals rule\<close>
 
 lemma isCont_If_ge:
   fixes a :: "'a :: linorder_topology"
   assumes "continuous (at_left a) g" and f: "(f \<longlongrightarrow> g a) (at_right a)"
   shows "isCont (\<lambda>x. if x \<le> a then g x else f x) a" (is "isCont ?gf a")
 proof -
   have g: "(g \<longlongrightarrow> g a) (at_left a)"
     using assms continuous_within by blast
   show ?thesis
     unfolding isCont_def continuous_within
   proof (intro filterlim_split_at; simp)
     show "(?gf \<longlongrightarrow> g a) (at_left a)"
       by (subst filterlim_cong[OF refl refl, where g=g]) (simp_all add: eventually_at_filter less_le g)
     show "(?gf \<longlongrightarrow> g a) (at_right a)"
       by (subst filterlim_cong[OF refl refl, where g=f]) (simp_all add: eventually_at_filter less_le f)
   qed
 qed
 
 lemma lhopital_right_0:
   fixes f0 g0 :: "real \<Rightarrow> real"
   assumes f_0: "(f0 \<longlongrightarrow> 0) (at_right 0)"
     and g_0: "(g0 \<longlongrightarrow> 0) (at_right 0)"
     and ev:
       "eventually (\<lambda>x. g0 x \<noteq> 0) (at_right 0)"
       "eventually (\<lambda>x. g' x \<noteq> 0) (at_right 0)"
       "eventually (\<lambda>x. DERIV f0 x :> f' x) (at_right 0)"
       "eventually (\<lambda>x. DERIV g0 x :> g' x) (at_right 0)"
     and lim: "filterlim (\<lambda> x. (f' x / g' x)) F (at_right 0)"
   shows "filterlim (\<lambda> x. f0 x / g0 x) F (at_right 0)"
 proof -
   define f where [abs_def]: "f x = (if x \<le> 0 then 0 else f0 x)" for x
   then have "f 0 = 0" by simp
 
   define g where [abs_def]: "g x = (if x \<le> 0 then 0 else g0 x)" for x
   then have "g 0 = 0" by simp
 
   have "eventually (\<lambda>x. g0 x \<noteq> 0 \<and> g' x \<noteq> 0 \<and>
       DERIV f0 x :> (f' x) \<and> DERIV g0 x :> (g' x)) (at_right 0)"
     using ev by eventually_elim auto
   then obtain a where [arith]: "0 < a"
     and g0_neq_0: "\<And>x. 0 < x \<Longrightarrow> x < a \<Longrightarrow> g0 x \<noteq> 0"
     and g'_neq_0: "\<And>x. 0 < x \<Longrightarrow> x < a \<Longrightarrow> g' x \<noteq> 0"
     and f0: "\<And>x. 0 < x \<Longrightarrow> x < a \<Longrightarrow> DERIV f0 x :> (f' x)"
     and g0: "\<And>x. 0 < x \<Longrightarrow> x < a \<Longrightarrow> DERIV g0 x :> (g' x)"
     unfolding eventually_at by (auto simp: dist_real_def)
 
   have g_neq_0: "\<And>x. 0 < x \<Longrightarrow> x < a \<Longrightarrow> g x \<noteq> 0"
     using g0_neq_0 by (simp add: g_def)
 
   have f: "DERIV f x :> (f' x)" if x: "0 < x" "x < a" for x
     using that
     by (intro DERIV_cong_ev[THEN iffD1, OF _ _ _ f0[OF x]])
       (auto simp: f_def eventually_nhds_metric dist_real_def intro!: exI[of _ x])
 
   have g: "DERIV g x :> (g' x)" if x: "0 < x" "x < a" for x
     using that
     by (intro DERIV_cong_ev[THEN iffD1, OF _ _ _ g0[OF x]])
          (auto simp: g_def eventually_nhds_metric dist_real_def intro!: exI[of _ x])
 
   have "isCont f 0"
     unfolding f_def by (intro isCont_If_ge f_0 continuous_const)
 
   have "isCont g 0"
     unfolding g_def by (intro isCont_If_ge g_0 continuous_const)
 
   have "\<exists>\<zeta>. \<forall>x\<in>{0 <..< a}. 0 < \<zeta> x \<and> \<zeta> x < x \<and> f x / g x = f' (\<zeta> x) / g' (\<zeta> x)"
   proof (rule bchoice, rule ballI)
     fix x
     assume "x \<in> {0 <..< a}"
     then have x[arith]: "0 < x" "x < a" by auto
     with g'_neq_0 g_neq_0 \<open>g 0 = 0\<close> have g': "\<And>x. 0 < x \<Longrightarrow> x < a  \<Longrightarrow> 0 \<noteq> g' x" "g 0 \<noteq> g x"
       by auto
     have "\<And>x. 0 \<le> x \<Longrightarrow> x < a \<Longrightarrow> isCont f x"
       using \<open>isCont f 0\<close> f by (auto intro: DERIV_isCont simp: le_less)
     moreover have "\<And>x. 0 \<le> x \<Longrightarrow> x < a \<Longrightarrow> isCont g x"
       using \<open>isCont g 0\<close> g by (auto intro: DERIV_isCont simp: le_less)
     ultimately have "\<exists>c. 0 < c \<and> c < x \<and> (f x - f 0) * g' c = (g x - g 0) * f' c"
       using f g \<open>x < a\<close> by (intro GMVT') auto
     then obtain c where *: "0 < c" "c < x" "(f x - f 0) * g' c = (g x - g 0) * f' c"
       by blast
     moreover
     from * g'(1)[of c] g'(2) have "(f x - f 0)  / (g x - g 0) = f' c / g' c"
       by (simp add: field_simps)
     ultimately show "\<exists>y. 0 < y \<and> y < x \<and> f x / g x = f' y / g' y"
       using \<open>f 0 = 0\<close> \<open>g 0 = 0\<close> by (auto intro!: exI[of _ c])
   qed
   then obtain \<zeta> where "\<forall>x\<in>{0 <..< a}. 0 < \<zeta> x \<and> \<zeta> x < x \<and> f x / g x = f' (\<zeta> x) / g' (\<zeta> x)" ..
   then have \<zeta>: "eventually (\<lambda>x. 0 < \<zeta> x \<and> \<zeta> x < x \<and> f x / g x = f' (\<zeta> x) / g' (\<zeta> x)) (at_right 0)"
     unfolding eventually_at by (intro exI[of _ a]) (auto simp: dist_real_def)
   moreover
   from \<zeta> have "eventually (\<lambda>x. norm (\<zeta> x) \<le> x) (at_right 0)"
     by eventually_elim auto
   then have "((\<lambda>x. norm (\<zeta> x)) \<longlongrightarrow> 0) (at_right 0)"
     by (rule_tac real_tendsto_sandwich[where f="\<lambda>x. 0" and h="\<lambda>x. x"]) auto
   then have "(\<zeta> \<longlongrightarrow> 0) (at_right 0)"
     by (rule tendsto_norm_zero_cancel)
   with \<zeta> have "filterlim \<zeta> (at_right 0) (at_right 0)"
     by (auto elim!: eventually_mono simp: filterlim_at)
   from this lim have "filterlim (\<lambda>t. f' (\<zeta> t) / g' (\<zeta> t)) F (at_right 0)"
     by (rule_tac filterlim_compose[of _ _ _ \<zeta>])
   ultimately have "filterlim (\<lambda>t. f t / g t) F (at_right 0)" (is ?P)
     by (rule_tac filterlim_cong[THEN iffD1, OF refl refl])
        (auto elim: eventually_mono)
   also have "?P \<longleftrightarrow> ?thesis"
     by (rule filterlim_cong) (auto simp: f_def g_def eventually_at_filter)
   finally show ?thesis .
 qed
 
 lemma lhopital_right:
   "(f \<longlongrightarrow> 0) (at_right x) \<Longrightarrow> (g \<longlongrightarrow> 0) (at_right x) \<Longrightarrow>
     eventually (\<lambda>x. g x \<noteq> 0) (at_right x) \<Longrightarrow>
     eventually (\<lambda>x. g' x \<noteq> 0) (at_right x) \<Longrightarrow>
     eventually (\<lambda>x. DERIV f x :> f' x) (at_right x) \<Longrightarrow>
     eventually (\<lambda>x. DERIV g x :> g' x) (at_right x) \<Longrightarrow>
     filterlim (\<lambda> x. (f' x / g' x)) F (at_right x) \<Longrightarrow>
   filterlim (\<lambda> x. f x / g x) F (at_right x)"
   for x :: real
   unfolding eventually_at_right_to_0[of _ x] filterlim_at_right_to_0[of _ _ x] DERIV_shift
   by (rule lhopital_right_0)
 
 lemma lhopital_left:
   "(f \<longlongrightarrow> 0) (at_left x) \<Longrightarrow> (g \<longlongrightarrow> 0) (at_left x) \<Longrightarrow>
     eventually (\<lambda>x. g x \<noteq> 0) (at_left x) \<Longrightarrow>
     eventually (\<lambda>x. g' x \<noteq> 0) (at_left x) \<Longrightarrow>
     eventually (\<lambda>x. DERIV f x :> f' x) (at_left x) \<Longrightarrow>
     eventually (\<lambda>x. DERIV g x :> g' x) (at_left x) \<Longrightarrow>
     filterlim (\<lambda> x. (f' x / g' x)) F (at_left x) \<Longrightarrow>
   filterlim (\<lambda> x. f x / g x) F (at_left x)"
   for x :: real
   unfolding eventually_at_left_to_right filterlim_at_left_to_right DERIV_mirror
   by (rule lhopital_right[where f'="\<lambda>x. - f' (- x)"]) (auto simp: DERIV_mirror)
 
 lemma lhopital:
   "(f \<longlongrightarrow> 0) (at x) \<Longrightarrow> (g \<longlongrightarrow> 0) (at x) \<Longrightarrow>
     eventually (\<lambda>x. g x \<noteq> 0) (at x) \<Longrightarrow>
     eventually (\<lambda>x. g' x \<noteq> 0) (at x) \<Longrightarrow>
     eventually (\<lambda>x. DERIV f x :> f' x) (at x) \<Longrightarrow>
     eventually (\<lambda>x. DERIV g x :> g' x) (at x) \<Longrightarrow>
     filterlim (\<lambda> x. (f' x / g' x)) F (at x) \<Longrightarrow>
   filterlim (\<lambda> x. f x / g x) F (at x)"
   for x :: real
   unfolding eventually_at_split filterlim_at_split
   by (auto intro!: lhopital_right[of f x g g' f'] lhopital_left[of f x g g' f'])
 
 
 lemma lhopital_right_0_at_top:
   fixes f g :: "real \<Rightarrow> real"
   assumes g_0: "LIM x at_right 0. g x :> at_top"
     and ev:
       "eventually (\<lambda>x. g' x \<noteq> 0) (at_right 0)"
       "eventually (\<lambda>x. DERIV f x :> f' x) (at_right 0)"
       "eventually (\<lambda>x. DERIV g x :> g' x) (at_right 0)"
     and lim: "((\<lambda> x. (f' x / g' x)) \<longlongrightarrow> x) (at_right 0)"
   shows "((\<lambda> x. f x / g x) \<longlongrightarrow> x) (at_right 0)"
   unfolding tendsto_iff
 proof safe
   fix e :: real
   assume "0 < e"
   with lim[unfolded tendsto_iff, rule_format, of "e / 4"]
   have "eventually (\<lambda>t. dist (f' t / g' t) x < e / 4) (at_right 0)"
     by simp
   from eventually_conj[OF eventually_conj[OF ev(1) ev(2)] eventually_conj[OF ev(3) this]]
   obtain a where [arith]: "0 < a"
     and g'_neq_0: "\<And>x. 0 < x \<Longrightarrow> x < a \<Longrightarrow> g' x \<noteq> 0"
     and f0: "\<And>x. 0 < x \<Longrightarrow> x \<le> a \<Longrightarrow> DERIV f x :> (f' x)"
     and g0: "\<And>x. 0 < x \<Longrightarrow> x \<le> a \<Longrightarrow> DERIV g x :> (g' x)"
     and Df: "\<And>t. 0 < t \<Longrightarrow> t < a \<Longrightarrow> dist (f' t / g' t) x < e / 4"
     unfolding eventually_at_le by (auto simp: dist_real_def)
 
   from Df have "eventually (\<lambda>t. t < a) (at_right 0)" "eventually (\<lambda>t::real. 0 < t) (at_right 0)"
     unfolding eventually_at by (auto intro!: exI[of _ a] simp: dist_real_def)
 
   moreover
   have "eventually (\<lambda>t. 0 < g t) (at_right 0)" "eventually (\<lambda>t. g a < g t) (at_right 0)"
     using g_0 by (auto elim: eventually_mono simp: filterlim_at_top_dense)
 
   moreover
   have inv_g: "((\<lambda>x. inverse (g x)) \<longlongrightarrow> 0) (at_right 0)"
     using tendsto_inverse_0 filterlim_mono[OF g_0 at_top_le_at_infinity order_refl]
     by (rule filterlim_compose)
   then have "((\<lambda>x. norm (1 - g a * inverse (g x))) \<longlongrightarrow> norm (1 - g a * 0)) (at_right 0)"
     by (intro tendsto_intros)
   then have "((\<lambda>x. norm (1 - g a / g x)) \<longlongrightarrow> 1) (at_right 0)"
     by (simp add: inverse_eq_divide)
   from this[unfolded tendsto_iff, rule_format, of 1]
   have "eventually (\<lambda>x. norm (1 - g a / g x) < 2) (at_right 0)"
     by (auto elim!: eventually_mono simp: dist_real_def)
 
   moreover
   from inv_g have "((\<lambda>t. norm ((f a - x * g a) * inverse (g t))) \<longlongrightarrow> norm ((f a - x * g a) * 0))
       (at_right 0)"
     by (intro tendsto_intros)
   then have "((\<lambda>t. norm (f a - x * g a) / norm (g t)) \<longlongrightarrow> 0) (at_right 0)"
     by (simp add: inverse_eq_divide)
   from this[unfolded tendsto_iff, rule_format, of "e / 2"] \<open>0 < e\<close>
   have "eventually (\<lambda>t. norm (f a - x * g a) / norm (g t) < e / 2) (at_right 0)"
     by (auto simp: dist_real_def)
 
   ultimately show "eventually (\<lambda>t. dist (f t / g t) x < e) (at_right 0)"
   proof eventually_elim
     fix t assume t[arith]: "0 < t" "t < a" "g a < g t" "0 < g t"
     assume ineq: "norm (1 - g a / g t) < 2" "norm (f a - x * g a) / norm (g t) < e / 2"
 
     have "\<exists>y. t < y \<and> y < a \<and> (g a - g t) * f' y = (f a - f t) * g' y"
       using f0 g0 t(1,2) by (intro GMVT') (force intro!: DERIV_isCont)+
     then obtain y where [arith]: "t < y" "y < a"
       and D_eq0: "(g a - g t) * f' y = (f a - f t) * g' y"
       by blast
     from D_eq0 have D_eq: "(f t - f a) / (g t - g a) = f' y / g' y"
       using \<open>g a < g t\<close> g'_neq_0[of y] by (auto simp add: field_simps)
 
     have *: "f t / g t - x = ((f t - f a) / (g t - g a) - x) * (1 - g a / g t) + (f a - x * g a) / g t"
       by (simp add: field_simps)
     have "norm (f t / g t - x) \<le>
         norm (((f t - f a) / (g t - g a) - x) * (1 - g a / g t)) + norm ((f a - x * g a) / g t)"
       unfolding * by (rule norm_triangle_ineq)
     also have "\<dots> = dist (f' y / g' y) x * norm (1 - g a / g t) + norm (f a - x * g a) / norm (g t)"
       by (simp add: abs_mult D_eq dist_real_def)
     also have "\<dots> < (e / 4) * 2 + e / 2"
       using ineq Df[of y] \<open>0 < e\<close> by (intro add_le_less_mono mult_mono) auto
     finally show "dist (f t / g t) x < e"
       by (simp add: dist_real_def)
   qed
 qed
 
 lemma lhopital_right_at_top:
   "LIM x at_right x. (g::real \<Rightarrow> real) x :> at_top \<Longrightarrow>
     eventually (\<lambda>x. g' x \<noteq> 0) (at_right x) \<Longrightarrow>
     eventually (\<lambda>x. DERIV f x :> f' x) (at_right x) \<Longrightarrow>
     eventually (\<lambda>x. DERIV g x :> g' x) (at_right x) \<Longrightarrow>
     ((\<lambda> x. (f' x / g' x)) \<longlongrightarrow> y) (at_right x) \<Longrightarrow>
     ((\<lambda> x. f x / g x) \<longlongrightarrow> y) (at_right x)"
   unfolding eventually_at_right_to_0[of _ x] filterlim_at_right_to_0[of _ _ x] DERIV_shift
   by (rule lhopital_right_0_at_top)
 
 lemma lhopital_left_at_top:
   "LIM x at_left x. g x :> at_top \<Longrightarrow>
     eventually (\<lambda>x. g' x \<noteq> 0) (at_left x) \<Longrightarrow>
     eventually (\<lambda>x. DERIV f x :> f' x) (at_left x) \<Longrightarrow>
     eventually (\<lambda>x. DERIV g x :> g' x) (at_left x) \<Longrightarrow>
     ((\<lambda> x. (f' x / g' x)) \<longlongrightarrow> y) (at_left x) \<Longrightarrow>
     ((\<lambda> x. f x / g x) \<longlongrightarrow> y) (at_left x)"
   for x :: real
   unfolding eventually_at_left_to_right filterlim_at_left_to_right DERIV_mirror
   by (rule lhopital_right_at_top[where f'="\<lambda>x. - f' (- x)"]) (auto simp: DERIV_mirror)
 
 lemma lhopital_at_top:
   "LIM x at x. (g::real \<Rightarrow> real) x :> at_top \<Longrightarrow>
     eventually (\<lambda>x. g' x \<noteq> 0) (at x) \<Longrightarrow>
     eventually (\<lambda>x. DERIV f x :> f' x) (at x) \<Longrightarrow>
     eventually (\<lambda>x. DERIV g x :> g' x) (at x) \<Longrightarrow>
     ((\<lambda> x. (f' x / g' x)) \<longlongrightarrow> y) (at x) \<Longrightarrow>
     ((\<lambda> x. f x / g x) \<longlongrightarrow> y) (at x)"
   unfolding eventually_at_split filterlim_at_split
   by (auto intro!: lhopital_right_at_top[of g x g' f f'] lhopital_left_at_top[of g x g' f f'])
 
 lemma lhospital_at_top_at_top:
   fixes f g :: "real \<Rightarrow> real"
   assumes g_0: "LIM x at_top. g x :> at_top"
     and g': "eventually (\<lambda>x. g' x \<noteq> 0) at_top"
     and Df: "eventually (\<lambda>x. DERIV f x :> f' x) at_top"
     and Dg: "eventually (\<lambda>x. DERIV g x :> g' x) at_top"
     and lim: "((\<lambda> x. (f' x / g' x)) \<longlongrightarrow> x) at_top"
   shows "((\<lambda> x. f x / g x) \<longlongrightarrow> x) at_top"
   unfolding filterlim_at_top_to_right
 proof (rule lhopital_right_0_at_top)
   let ?F = "\<lambda>x. f (inverse x)"
   let ?G = "\<lambda>x. g (inverse x)"
   let ?R = "at_right (0::real)"
   let ?D = "\<lambda>f' x. f' (inverse x) * - (inverse x ^ Suc (Suc 0))"
   show "LIM x ?R. ?G x :> at_top"
     using g_0 unfolding filterlim_at_top_to_right .
   show "eventually (\<lambda>x. DERIV ?G x  :> ?D g' x) ?R"
     unfolding eventually_at_right_to_top
     using Dg eventually_ge_at_top[where c=1]
     by eventually_elim (rule derivative_eq_intros DERIV_chain'[where f=inverse] | simp)+
   show "eventually (\<lambda>x. DERIV ?F x  :> ?D f' x) ?R"
     unfolding eventually_at_right_to_top
     using Df eventually_ge_at_top[where c=1]
     by eventually_elim (rule derivative_eq_intros DERIV_chain'[where f=inverse] | simp)+
   show "eventually (\<lambda>x. ?D g' x \<noteq> 0) ?R"
     unfolding eventually_at_right_to_top
     using g' eventually_ge_at_top[where c=1]
     by eventually_elim auto
   show "((\<lambda>x. ?D f' x / ?D g' x) \<longlongrightarrow> x) ?R"
     unfolding filterlim_at_right_to_top
     apply (intro filterlim_cong[THEN iffD2, OF refl refl _ lim])
     using eventually_ge_at_top[where c=1]
     by eventually_elim simp
 qed
 
 lemma lhopital_right_at_top_at_top:
   fixes f g :: "real \<Rightarrow> real"
   assumes f_0: "LIM x at_right a. f x :> at_top"
   assumes g_0: "LIM x at_right a. g x :> at_top"
     and ev:
       "eventually (\<lambda>x. DERIV f x :> f' x) (at_right a)"
       "eventually (\<lambda>x. DERIV g x :> g' x) (at_right a)"
     and lim: "filterlim (\<lambda> x. (f' x / g' x)) at_top (at_right a)"
   shows "filterlim (\<lambda> x. f x / g x) at_top (at_right a)"
 proof -
   from lim have pos: "eventually (\<lambda>x. f' x / g' x > 0) (at_right a)"
     unfolding filterlim_at_top_dense by blast
   have "((\<lambda>x. g x / f x) \<longlongrightarrow> 0) (at_right a)"
   proof (rule lhopital_right_at_top)
     from pos show "eventually (\<lambda>x. f' x \<noteq> 0) (at_right a)" by eventually_elim auto
     from tendsto_inverse_0_at_top[OF lim]
       show "((\<lambda>x. g' x / f' x) \<longlongrightarrow> 0) (at_right a)" by simp
   qed fact+
   moreover from f_0 g_0 
     have "eventually (\<lambda>x. f x > 0) (at_right a)" "eventually (\<lambda>x. g x > 0) (at_right a)"
     unfolding filterlim_at_top_dense by blast+
   hence "eventually (\<lambda>x. g x / f x > 0) (at_right a)" by eventually_elim simp
   ultimately have "filterlim (\<lambda>x. inverse (g x / f x)) at_top (at_right a)"
     by (rule filterlim_inverse_at_top)
   thus ?thesis by simp
 qed
 
 lemma lhopital_right_at_top_at_bot:
   fixes f g :: "real \<Rightarrow> real"
   assumes f_0: "LIM x at_right a. f x :> at_top"
   assumes g_0: "LIM x at_right a. g x :> at_bot"
     and ev:
       "eventually (\<lambda>x. DERIV f x :> f' x) (at_right a)"
       "eventually (\<lambda>x. DERIV g x :> g' x) (at_right a)"
     and lim: "filterlim (\<lambda> x. (f' x / g' x)) at_bot (at_right a)"
   shows "filterlim (\<lambda> x. f x / g x) at_bot (at_right a)"
 proof -
   from ev(2) have ev': "eventually (\<lambda>x. DERIV (\<lambda>x. -g x) x :> -g' x) (at_right a)"
     by eventually_elim (auto intro: derivative_intros)
   have "filterlim (\<lambda>x. f x / (-g x)) at_top (at_right a)"
     by (rule lhopital_right_at_top_at_top[where f' = f' and g' = "\<lambda>x. -g' x"])
        (insert assms ev', auto simp: filterlim_uminus_at_bot)
   hence "filterlim (\<lambda>x. -(f x / g x)) at_top (at_right a)" by simp
   thus ?thesis by (simp add: filterlim_uminus_at_bot)
 qed
 
 lemma lhopital_left_at_top_at_top:
   fixes f g :: "real \<Rightarrow> real"
   assumes f_0: "LIM x at_left a. f x :> at_top"
   assumes g_0: "LIM x at_left a. g x :> at_top"
     and ev:
       "eventually (\<lambda>x. DERIV f x :> f' x) (at_left a)"
       "eventually (\<lambda>x. DERIV g x :> g' x) (at_left a)"
     and lim: "filterlim (\<lambda> x. (f' x / g' x)) at_top (at_left a)"
   shows "filterlim (\<lambda> x. f x / g x) at_top (at_left a)"
   by (insert assms, unfold eventually_at_left_to_right filterlim_at_left_to_right DERIV_mirror,
       rule lhopital_right_at_top_at_top[where f'="\<lambda>x. - f' (- x)"]) 
      (insert assms, auto simp: DERIV_mirror)
 
 lemma lhopital_left_at_top_at_bot:
   fixes f g :: "real \<Rightarrow> real"
   assumes f_0: "LIM x at_left a. f x :> at_top"
   assumes g_0: "LIM x at_left a. g x :> at_bot"
     and ev:
       "eventually (\<lambda>x. DERIV f x :> f' x) (at_left a)"
       "eventually (\<lambda>x. DERIV g x :> g' x) (at_left a)"
     and lim: "filterlim (\<lambda> x. (f' x / g' x)) at_bot (at_left a)"
   shows "filterlim (\<lambda> x. f x / g x) at_bot (at_left a)"
   by (insert assms, unfold eventually_at_left_to_right filterlim_at_left_to_right DERIV_mirror,
       rule lhopital_right_at_top_at_bot[where f'="\<lambda>x. - f' (- x)"]) 
      (insert assms, auto simp: DERIV_mirror)
 
 lemma lhopital_at_top_at_top:
   fixes f g :: "real \<Rightarrow> real"
   assumes f_0: "LIM x at a. f x :> at_top"
   assumes g_0: "LIM x at a. g x :> at_top"
     and ev:
       "eventually (\<lambda>x. DERIV f x :> f' x) (at a)"
       "eventually (\<lambda>x. DERIV g x :> g' x) (at a)"
     and lim: "filterlim (\<lambda> x. (f' x / g' x)) at_top (at a)"
   shows "filterlim (\<lambda> x. f x / g x) at_top (at a)"
   using assms unfolding eventually_at_split filterlim_at_split
   by (auto intro!: lhopital_right_at_top_at_top[of f a g f' g'] 
                    lhopital_left_at_top_at_top[of f a g f' g'])
 
 lemma lhopital_at_top_at_bot:
   fixes f g :: "real \<Rightarrow> real"
   assumes f_0: "LIM x at a. f x :> at_top"
   assumes g_0: "LIM x at a. g x :> at_bot"
     and ev:
       "eventually (\<lambda>x. DERIV f x :> f' x) (at a)"
       "eventually (\<lambda>x. DERIV g x :> g' x) (at a)"
     and lim: "filterlim (\<lambda> x. (f' x / g' x)) at_bot (at a)"
   shows "filterlim (\<lambda> x. f x / g x) at_bot (at a)"
   using assms unfolding eventually_at_split filterlim_at_split
   by (auto intro!: lhopital_right_at_top_at_bot[of f a g f' g'] 
                    lhopital_left_at_top_at_bot[of f a g f' g'])
 
 end
diff --git a/src/HOL/Fun.thy b/src/HOL/Fun.thy
--- a/src/HOL/Fun.thy
+++ b/src/HOL/Fun.thy
@@ -1,1367 +1,1378 @@
 (*  Title:      HOL/Fun.thy
     Author:     Tobias Nipkow, Cambridge University Computer Laboratory
     Author:     Andrei Popescu, TU Muenchen
     Copyright   1994, 2012
 *)
 
 section \<open>Notions about functions\<close>
 
 theory Fun
   imports Set
   keywords "functor" :: thy_goal_defn
 begin
 
 lemma apply_inverse: "f x = u \<Longrightarrow> (\<And>x. P x \<Longrightarrow> g (f x) = x) \<Longrightarrow> P x \<Longrightarrow> x = g u"
   by auto
 
 text \<open>Uniqueness, so NOT the axiom of choice.\<close>
 lemma uniq_choice: "\<forall>x. \<exists>!y. Q x y \<Longrightarrow> \<exists>f. \<forall>x. Q x (f x)"
   by (force intro: theI')
 
 lemma b_uniq_choice: "\<forall>x\<in>S. \<exists>!y. Q x y \<Longrightarrow> \<exists>f. \<forall>x\<in>S. Q x (f x)"
   by (force intro: theI')
 
 
 subsection \<open>The Identity Function \<open>id\<close>\<close>
 
 definition id :: "'a \<Rightarrow> 'a"
   where "id = (\<lambda>x. x)"
 
 lemma id_apply [simp]: "id x = x"
   by (simp add: id_def)
 
 lemma image_id [simp]: "image id = id"
   by (simp add: id_def fun_eq_iff)
 
 lemma vimage_id [simp]: "vimage id = id"
   by (simp add: id_def fun_eq_iff)
 
 lemma eq_id_iff: "(\<forall>x. f x = x) \<longleftrightarrow> f = id"
   by auto
 
 code_printing
   constant id \<rightharpoonup> (Haskell) "id"
 
 
 subsection \<open>The Composition Operator \<open>f \<circ> g\<close>\<close>
 
 definition comp :: "('b \<Rightarrow> 'c) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'c"  (infixl "\<circ>" 55)
   where "f \<circ> g = (\<lambda>x. f (g x))"
 
 notation (ASCII)
   comp  (infixl "o" 55)
 
 lemma comp_apply [simp]: "(f \<circ> g) x = f (g x)"
   by (simp add: comp_def)
 
 lemma comp_assoc: "(f \<circ> g) \<circ> h = f \<circ> (g \<circ> h)"
   by (simp add: fun_eq_iff)
 
 lemma id_comp [simp]: "id \<circ> g = g"
   by (simp add: fun_eq_iff)
 
 lemma comp_id [simp]: "f \<circ> id = f"
   by (simp add: fun_eq_iff)
 
 lemma comp_eq_dest: "a \<circ> b = c \<circ> d \<Longrightarrow> a (b v) = c (d v)"
   by (simp add: fun_eq_iff)
 
 lemma comp_eq_elim: "a \<circ> b = c \<circ> d \<Longrightarrow> ((\<And>v. a (b v) = c (d v)) \<Longrightarrow> R) \<Longrightarrow> R"
   by (simp add: fun_eq_iff)
 
 lemma comp_eq_dest_lhs: "a \<circ> b = c \<Longrightarrow> a (b v) = c v"
   by clarsimp
 
 lemma comp_eq_id_dest: "a \<circ> b = id \<circ> c \<Longrightarrow> a (b v) = c v"
   by clarsimp
 
 lemma image_comp: "f ` (g ` r) = (f \<circ> g) ` r"
   by auto
 
 lemma vimage_comp: "f -` (g -` x) = (g \<circ> f) -` x"
   by auto
 
 lemma image_eq_imp_comp: "f ` A = g ` B \<Longrightarrow> (h \<circ> f) ` A = (h \<circ> g) ` B"
   by (auto simp: comp_def elim!: equalityE)
 
 lemma image_bind: "f ` (Set.bind A g) = Set.bind A ((`) f \<circ> g)"
   by (auto simp add: Set.bind_def)
 
 lemma bind_image: "Set.bind (f ` A) g = Set.bind A (g \<circ> f)"
   by (auto simp add: Set.bind_def)
 
 lemma (in group_add) minus_comp_minus [simp]: "uminus \<circ> uminus = id"
   by (simp add: fun_eq_iff)
 
 lemma (in boolean_algebra) minus_comp_minus [simp]: "uminus \<circ> uminus = id"
   by (simp add: fun_eq_iff)
 
 code_printing
   constant comp \<rightharpoonup> (SML) infixl 5 "o" and (Haskell) infixr 9 "."
 
 
 subsection \<open>The Forward Composition Operator \<open>fcomp\<close>\<close>
 
 definition fcomp :: "('a \<Rightarrow> 'b) \<Rightarrow> ('b \<Rightarrow> 'c) \<Rightarrow> 'a \<Rightarrow> 'c"  (infixl "\<circ>>" 60)
   where "f \<circ>> g = (\<lambda>x. g (f x))"
 
 lemma fcomp_apply [simp]:  "(f \<circ>> g) x = g (f x)"
   by (simp add: fcomp_def)
 
 lemma fcomp_assoc: "(f \<circ>> g) \<circ>> h = f \<circ>> (g \<circ>> h)"
   by (simp add: fcomp_def)
 
 lemma id_fcomp [simp]: "id \<circ>> g = g"
   by (simp add: fcomp_def)
 
 lemma fcomp_id [simp]: "f \<circ>> id = f"
   by (simp add: fcomp_def)
 
 lemma fcomp_comp: "fcomp f g = comp g f"
   by (simp add: ext)
 
 code_printing
   constant fcomp \<rightharpoonup> (Eval) infixl 1 "#>"
 
 no_notation fcomp (infixl "\<circ>>" 60)
 
 
 subsection \<open>Mapping functions\<close>
 
 definition map_fun :: "('c \<Rightarrow> 'a) \<Rightarrow> ('b \<Rightarrow> 'd) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'c \<Rightarrow> 'd"
   where "map_fun f g h = g \<circ> h \<circ> f"
 
 lemma map_fun_apply [simp]: "map_fun f g h x = g (h (f x))"
   by (simp add: map_fun_def)
 
 
 subsection \<open>Injectivity and Bijectivity\<close>
 
 definition inj_on :: "('a \<Rightarrow> 'b) \<Rightarrow> 'a set \<Rightarrow> bool"  \<comment> \<open>injective\<close>
   where "inj_on f A \<longleftrightarrow> (\<forall>x\<in>A. \<forall>y\<in>A. f x = f y \<longrightarrow> x = y)"
 
 definition bij_betw :: "('a \<Rightarrow> 'b) \<Rightarrow> 'a set \<Rightarrow> 'b set \<Rightarrow> bool"  \<comment> \<open>bijective\<close>
   where "bij_betw f A B \<longleftrightarrow> inj_on f A \<and> f ` A = B"
 
 text \<open>
   A common special case: functions injective, surjective or bijective over
   the entire domain type.
 \<close>
 
 abbreviation inj :: "('a \<Rightarrow> 'b) \<Rightarrow> bool"
   where "inj f \<equiv> inj_on f UNIV"
 
 abbreviation surj :: "('a \<Rightarrow> 'b) \<Rightarrow> bool"
   where "surj f \<equiv> range f = UNIV"
 
 translations \<comment> \<open>The negated case:\<close>
   "\<not> CONST surj f" \<leftharpoondown> "CONST range f \<noteq> CONST UNIV"
 
 abbreviation bij :: "('a \<Rightarrow> 'b) \<Rightarrow> bool"
   where "bij f \<equiv> bij_betw f UNIV UNIV"
 
 lemma inj_def: "inj f \<longleftrightarrow> (\<forall>x y. f x = f y \<longrightarrow> x = y)"
   unfolding inj_on_def by blast
 
 lemma injI: "(\<And>x y. f x = f y \<Longrightarrow> x = y) \<Longrightarrow> inj f"
   unfolding inj_def by blast
 
 theorem range_ex1_eq: "inj f \<Longrightarrow> b \<in> range f \<longleftrightarrow> (\<exists>!x. b = f x)"
   unfolding inj_def by blast
 
 lemma injD: "inj f \<Longrightarrow> f x = f y \<Longrightarrow> x = y"
   by (simp add: inj_def)
 
 lemma inj_on_eq_iff: "inj_on f A \<Longrightarrow> x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> f x = f y \<longleftrightarrow> x = y"
   by (auto simp: inj_on_def)
 
 lemma inj_on_cong: "(\<And>a. a \<in> A \<Longrightarrow> f a = g a) \<Longrightarrow> inj_on f A \<longleftrightarrow> inj_on g A"
   by (auto simp: inj_on_def)
 
 lemma image_strict_mono: "inj_on f B \<Longrightarrow> A \<subset> B \<Longrightarrow> f ` A \<subset> f ` B"
   unfolding inj_on_def by blast
 
 lemma inj_compose: "inj f \<Longrightarrow> inj g \<Longrightarrow> inj (f \<circ> g)"
   by (simp add: inj_def)
 
 lemma inj_fun: "inj f \<Longrightarrow> inj (\<lambda>x y. f x)"
   by (simp add: inj_def fun_eq_iff)
 
 lemma inj_eq: "inj f \<Longrightarrow> f x = f y \<longleftrightarrow> x = y"
   by (simp add: inj_on_eq_iff)
 
 lemma inj_on_iff_Uniq: "inj_on f A \<longleftrightarrow> (\<forall>x\<in>A. \<exists>\<^sub>\<le>\<^sub>1y. y\<in>A \<and> f x = f y)"
   by (auto simp: Uniq_def inj_on_def)
 
 lemma inj_on_id[simp]: "inj_on id A"
   by (simp add: inj_on_def)
 
 lemma inj_on_id2[simp]: "inj_on (\<lambda>x. x) A"
   by (simp add: inj_on_def)
 
 lemma inj_on_Int: "inj_on f A \<or> inj_on f B \<Longrightarrow> inj_on f (A \<inter> B)"
   unfolding inj_on_def by blast
 
 lemma surj_id: "surj id"
   by simp
 
 lemma bij_id[simp]: "bij id"
   by (simp add: bij_betw_def)
 
 lemma bij_uminus: "bij (uminus :: 'a \<Rightarrow> 'a::group_add)"
   unfolding bij_betw_def inj_on_def
   by (force intro: minus_minus [symmetric])
 
 lemma bij_betwE: "bij_betw f A B \<Longrightarrow> \<forall>a\<in>A. f a \<in> B"
   unfolding bij_betw_def by auto
 
 lemma inj_onI [intro?]: "(\<And>x y. x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> f x = f y \<Longrightarrow> x = y) \<Longrightarrow> inj_on f A"
   by (simp add: inj_on_def)
 
 lemma inj_on_inverseI: "(\<And>x. x \<in> A \<Longrightarrow> g (f x) = x) \<Longrightarrow> inj_on f A"
   by (auto dest: arg_cong [of concl: g] simp add: inj_on_def)
 
 lemma inj_onD: "inj_on f A \<Longrightarrow> f x = f y \<Longrightarrow> x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> x = y"
   unfolding inj_on_def by blast
 
 lemma inj_on_subset:
   assumes "inj_on f A"
     and "B \<subseteq> A"
   shows "inj_on f B"
 proof (rule inj_onI)
   fix a b
   assume "a \<in> B" and "b \<in> B"
   with assms have "a \<in> A" and "b \<in> A"
     by auto
   moreover assume "f a = f b"
   ultimately show "a = b"
     using assms by (auto dest: inj_onD)
 qed
 
 lemma comp_inj_on: "inj_on f A \<Longrightarrow> inj_on g (f ` A) \<Longrightarrow> inj_on (g \<circ> f) A"
   by (simp add: comp_def inj_on_def)
 
 lemma inj_on_imageI: "inj_on (g \<circ> f) A \<Longrightarrow> inj_on g (f ` A)"
   by (auto simp add: inj_on_def)
 
 lemma inj_on_image_iff:
   "\<forall>x\<in>A. \<forall>y\<in>A. g (f x) = g (f y) \<longleftrightarrow> g x = g y \<Longrightarrow> inj_on f A \<Longrightarrow> inj_on g (f ` A) \<longleftrightarrow> inj_on g A"
   unfolding inj_on_def by blast
 
 lemma inj_on_contraD: "inj_on f A \<Longrightarrow> x \<noteq> y \<Longrightarrow> x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> f x \<noteq> f y"
   unfolding inj_on_def by blast
 
 lemma inj_singleton [simp]: "inj_on (\<lambda>x. {x}) A"
   by (simp add: inj_on_def)
 
 lemma inj_on_empty[iff]: "inj_on f {}"
   by (simp add: inj_on_def)
 
 lemma subset_inj_on: "inj_on f B \<Longrightarrow> A \<subseteq> B \<Longrightarrow> inj_on f A"
   unfolding inj_on_def by blast
 
 lemma inj_on_Un: "inj_on f (A \<union> B) \<longleftrightarrow> inj_on f A \<and> inj_on f B \<and> f ` (A - B) \<inter> f ` (B - A) = {}"
   unfolding inj_on_def by (blast intro: sym)
 
 lemma inj_on_insert [iff]: "inj_on f (insert a A) \<longleftrightarrow> inj_on f A \<and> f a \<notin> f ` (A - {a})"
   unfolding inj_on_def by (blast intro: sym)
 
 lemma inj_on_diff: "inj_on f A \<Longrightarrow> inj_on f (A - B)"
   unfolding inj_on_def by blast
 
 lemma comp_inj_on_iff: "inj_on f A \<Longrightarrow> inj_on f' (f ` A) \<longleftrightarrow> inj_on (f' \<circ> f) A"
   by (auto simp: comp_inj_on inj_on_def)
 
 lemma inj_on_imageI2: "inj_on (f' \<circ> f) A \<Longrightarrow> inj_on f A"
   by (auto simp: comp_inj_on inj_on_def)
 
 lemma inj_img_insertE:
   assumes "inj_on f A"
   assumes "x \<notin> B"
     and "insert x B = f ` A"
   obtains x' A' where "x' \<notin> A'" and "A = insert x' A'" and "x = f x'" and "B = f ` A'"
 proof -
   from assms have "x \<in> f ` A" by auto
   then obtain x' where *: "x' \<in> A" "x = f x'" by auto
   then have A: "A = insert x' (A - {x'})" by auto
   with assms * have B: "B = f ` (A - {x'})" by (auto dest: inj_on_contraD)
   have "x' \<notin> A - {x'}" by simp
   from this A \<open>x = f x'\<close> B show ?thesis ..
 qed
 
 lemma linorder_inj_onI:
   fixes A :: "'a::order set"
   assumes ne: "\<And>x y. \<lbrakk>x < y; x\<in>A; y\<in>A\<rbrakk> \<Longrightarrow> f x \<noteq> f y" and lin: "\<And>x y. \<lbrakk>x\<in>A; y\<in>A\<rbrakk> \<Longrightarrow> x\<le>y \<or> y\<le>x"
   shows "inj_on f A"
 proof (rule inj_onI)
   fix x y
   assume eq: "f x = f y" and "x\<in>A" "y\<in>A"
   then show "x = y"
     using lin [of x y] ne by (force simp: dual_order.order_iff_strict)
 qed
 
 lemma linorder_inj_onI':
   fixes A :: "'a :: linorder set"
   assumes "\<And>i j. i \<in> A \<Longrightarrow> j \<in> A \<Longrightarrow> i < j \<Longrightarrow> f i \<noteq> f j"
   shows   "inj_on f A"
   by (intro linorder_inj_onI) (auto simp add: assms)
 
 lemma linorder_injI:
   assumes "\<And>x y::'a::linorder. x < y \<Longrightarrow> f x \<noteq> f y"
   shows "inj f"
     \<comment> \<open>Courtesy of Stephan Merz\<close>
 using assms by (simp add: linorder_inj_onI')
 
 lemma inj_on_image_Pow: "inj_on f A \<Longrightarrow>inj_on (image f) (Pow A)"
   unfolding Pow_def inj_on_def by blast
 
 lemma bij_betw_image_Pow: "bij_betw f A B \<Longrightarrow> bij_betw (image f) (Pow A) (Pow B)"
   by (auto simp add: bij_betw_def inj_on_image_Pow image_Pow_surj)
 
 lemma surj_def: "surj f \<longleftrightarrow> (\<forall>y. \<exists>x. y = f x)"
   by auto
 
 lemma surjI:
   assumes "\<And>x. g (f x) = x"
   shows "surj g"
   using assms [symmetric] by auto
 
 lemma surjD: "surj f \<Longrightarrow> \<exists>x. y = f x"
   by (simp add: surj_def)
 
 lemma surjE: "surj f \<Longrightarrow> (\<And>x. y = f x \<Longrightarrow> C) \<Longrightarrow> C"
   by (simp add: surj_def) blast
 
 lemma comp_surj: "surj f \<Longrightarrow> surj g \<Longrightarrow> surj (g \<circ> f)"
   using image_comp [of g f UNIV] by simp
 
 lemma bij_betw_imageI: "inj_on f A \<Longrightarrow> f ` A = B \<Longrightarrow> bij_betw f A B"
   unfolding bij_betw_def by clarify
 
 lemma bij_betw_imp_surj_on: "bij_betw f A B \<Longrightarrow> f ` A = B"
   unfolding bij_betw_def by clarify
 
 lemma bij_betw_imp_surj: "bij_betw f A UNIV \<Longrightarrow> surj f"
   unfolding bij_betw_def by auto
 
 lemma bij_betw_empty1: "bij_betw f {} A \<Longrightarrow> A = {}"
   unfolding bij_betw_def by blast
 
 lemma bij_betw_empty2: "bij_betw f A {} \<Longrightarrow> A = {}"
   unfolding bij_betw_def by blast
 
 lemma inj_on_imp_bij_betw: "inj_on f A \<Longrightarrow> bij_betw f A (f ` A)"
   unfolding bij_betw_def by simp
 
+lemma bij_betw_DiffI:
+  assumes "bij_betw f A B" "bij_betw f C D" "C \<subseteq> A" "D \<subseteq> B"
+  shows   "bij_betw f (A - C) (B - D)"
+  using assms unfolding bij_betw_def inj_on_def by auto
+
+lemma bij_betw_singleton_iff [simp]: "bij_betw f {x} {y} \<longleftrightarrow> f x = y"
+  by (auto simp: bij_betw_def)
+
+lemma bij_betw_singletonI [intro]: "f x = y \<Longrightarrow> bij_betw f {x} {y}"
+  by auto
+
 lemma bij_betw_apply: "\<lbrakk>bij_betw f A B; a \<in> A\<rbrakk> \<Longrightarrow> f a \<in> B"
   unfolding bij_betw_def by auto
 
 lemma bij_def: "bij f \<longleftrightarrow> inj f \<and> surj f"
   by (rule bij_betw_def)
 
 lemma bijI: "inj f \<Longrightarrow> surj f \<Longrightarrow> bij f"
   by (rule bij_betw_imageI)
 
 lemma bij_is_inj: "bij f \<Longrightarrow> inj f"
   by (simp add: bij_def)
 
 lemma bij_is_surj: "bij f \<Longrightarrow> surj f"
   by (simp add: bij_def)
 
 lemma bij_betw_imp_inj_on: "bij_betw f A B \<Longrightarrow> inj_on f A"
   by (simp add: bij_betw_def)
 
 lemma bij_betw_trans: "bij_betw f A B \<Longrightarrow> bij_betw g B C \<Longrightarrow> bij_betw (g \<circ> f) A C"
   by (auto simp add:bij_betw_def comp_inj_on)
 
 lemma bij_comp: "bij f \<Longrightarrow> bij g \<Longrightarrow> bij (g \<circ> f)"
   by (rule bij_betw_trans)
 
 lemma bij_betw_comp_iff: "bij_betw f A A' \<Longrightarrow> bij_betw f' A' A'' \<longleftrightarrow> bij_betw (f' \<circ> f) A A''"
   by (auto simp add: bij_betw_def inj_on_def)
 
 lemma bij_betw_comp_iff2:
   assumes bij: "bij_betw f' A' A''"
     and img: "f ` A \<le> A'"
   shows "bij_betw f A A' \<longleftrightarrow> bij_betw (f' \<circ> f) A A''" (is "?L \<longleftrightarrow> ?R")
 proof
   assume "?L"
   then show "?R"
     using assms by (auto simp add: bij_betw_comp_iff)
   next
     assume *: "?R"
     have "inj_on (f' \<circ> f) A \<Longrightarrow> inj_on f A"
       using inj_on_imageI2 by blast
     moreover have "A' \<subseteq> f ` A"
     proof
       fix a'
       assume **: "a' \<in> A'"
       with bij have "f' a' \<in> A''"
         unfolding bij_betw_def by auto
       with * obtain a where 1: "a \<in> A \<and> f' (f a) = f' a'"
         unfolding bij_betw_def by force
       with img have "f a \<in> A'" by auto
       with bij ** 1 have "f a = a'"
         unfolding bij_betw_def inj_on_def by auto
       with 1 show "a' \<in> f ` A" by auto
     qed
     ultimately show "?L"
       using img * by (auto simp add: bij_betw_def)
 qed
 
 lemma bij_betw_inv:
   assumes "bij_betw f A B"
   shows "\<exists>g. bij_betw g B A"
 proof -
   have i: "inj_on f A" and s: "f ` A = B"
     using assms by (auto simp: bij_betw_def)
   let ?P = "\<lambda>b a. a \<in> A \<and> f a = b"
   let ?g = "\<lambda>b. The (?P b)"
   have g: "?g b = a" if P: "?P b a" for a b
   proof -
     from that s have ex1: "\<exists>a. ?P b a" by blast
     then have uex1: "\<exists>!a. ?P b a" by (blast dest:inj_onD[OF i])
     then show ?thesis
       using the1_equality[OF uex1, OF P] P by simp
   qed
   have "inj_on ?g B"
   proof (rule inj_onI)
     fix x y
     assume "x \<in> B" "y \<in> B" "?g x = ?g y"
     from s \<open>x \<in> B\<close> obtain a1 where a1: "?P x a1" by blast
     from s \<open>y \<in> B\<close> obtain a2 where a2: "?P y a2" by blast
     from g [OF a1] a1 g [OF a2] a2 \<open>?g x = ?g y\<close> show "x = y" by simp
   qed
   moreover have "?g ` B = A"
   proof safe
     fix b
     assume "b \<in> B"
     with s obtain a where P: "?P b a" by blast
     with g[OF P] show "?g b \<in> A" by auto
   next
     fix a
     assume "a \<in> A"
     with s obtain b where P: "?P b a" by blast
     with s have "b \<in> B" by blast
     with g[OF P] have "\<exists>b\<in>B. a = ?g b" by blast
     then show "a \<in> ?g ` B"
       by auto
   qed
   ultimately show ?thesis
     by (auto simp: bij_betw_def)
 qed
 
 lemma bij_betw_cong: "(\<And>a. a \<in> A \<Longrightarrow> f a = g a) \<Longrightarrow> bij_betw f A A' = bij_betw g A A'"
   unfolding bij_betw_def inj_on_def by safe force+  (* somewhat slow *)
 
 lemma bij_betw_id[intro, simp]: "bij_betw id A A"
   unfolding bij_betw_def id_def by auto
 
 lemma bij_betw_id_iff: "bij_betw id A B \<longleftrightarrow> A = B"
   by (auto simp add: bij_betw_def)
 
 lemma bij_betw_combine:
   "bij_betw f A B \<Longrightarrow> bij_betw f C D \<Longrightarrow> B \<inter> D = {} \<Longrightarrow> bij_betw f (A \<union> C) (B \<union> D)"
   unfolding bij_betw_def inj_on_Un image_Un by auto
 
 lemma bij_betw_subset: "bij_betw f A A' \<Longrightarrow> B \<subseteq> A \<Longrightarrow> f ` B = B' \<Longrightarrow> bij_betw f B B'"
   by (auto simp add: bij_betw_def inj_on_def)
 
 lemma bij_betw_ball: "bij_betw f A B \<Longrightarrow> (\<forall>b \<in> B. phi b) = (\<forall>a \<in> A. phi (f a))"
   unfolding bij_betw_def inj_on_def by blast
 
 lemma bij_pointE:
   assumes "bij f"
   obtains x where "y = f x" and "\<And>x'. y = f x' \<Longrightarrow> x' = x"
 proof -
   from assms have "inj f" by (rule bij_is_inj)
   moreover from assms have "surj f" by (rule bij_is_surj)
   then have "y \<in> range f" by simp
   ultimately have "\<exists>!x. y = f x" by (simp add: range_ex1_eq)
   with that show thesis by blast
 qed
 
 lemma bij_iff: \<^marker>\<open>contributor \<open>Amine Chaieb\<close>\<close>
   \<open>bij f \<longleftrightarrow> (\<forall>x. \<exists>!y. f y = x)\<close>  (is \<open>?P \<longleftrightarrow> ?Q\<close>)
 proof
   assume ?P
   then have \<open>inj f\<close> \<open>surj f\<close>
     by (simp_all add: bij_def)
   show ?Q
   proof
     fix y
     from \<open>surj f\<close> obtain x where \<open>y = f x\<close>
       by (auto simp add: surj_def)
     with \<open>inj f\<close> show \<open>\<exists>!x. f x = y\<close>
       by (auto simp add: inj_def)
   qed
 next
   assume ?Q
   then have \<open>inj f\<close>
     by (auto simp add: inj_def)
   moreover have \<open>\<exists>x. y = f x\<close> for y
   proof -
     from \<open>?Q\<close> obtain x where \<open>f x = y\<close>
       by blast
     then have \<open>y = f x\<close>
       by simp
     then show ?thesis ..
   qed
   then have \<open>surj f\<close>
     by (auto simp add: surj_def)
   ultimately show ?P
     by (rule bijI)
 qed
 
 lemma bij_betw_partition:
   \<open>bij_betw f A B\<close>
   if \<open>bij_betw f (A \<union> C) (B \<union> D)\<close> \<open>bij_betw f C D\<close> \<open>A \<inter> C = {}\<close> \<open>B \<inter> D = {}\<close>
 proof -
   from that have \<open>inj_on f (A \<union> C)\<close> \<open>inj_on f C\<close> \<open>f ` (A \<union> C) = B \<union> D\<close> \<open>f ` C = D\<close>
     by (simp_all add: bij_betw_def)
   then have \<open>inj_on f A\<close> and \<open>f ` (A - C) \<inter> f ` (C - A) = {}\<close>
     by (simp_all add: inj_on_Un)
   with \<open>A \<inter> C = {}\<close> have \<open>f ` A \<inter> f ` C = {}\<close>
     by auto
   with \<open>f ` (A \<union> C) = B \<union> D\<close> \<open>f ` C = D\<close>  \<open>B \<inter> D = {}\<close>
   have \<open>f ` A = B\<close>
     by blast
   with \<open>inj_on f A\<close> show ?thesis
     by (simp add: bij_betw_def)
 qed
 
 lemma surj_image_vimage_eq: "surj f \<Longrightarrow> f ` (f -` A) = A"
   by simp
 
 lemma surj_vimage_empty:
   assumes "surj f"
   shows "f -` A = {} \<longleftrightarrow> A = {}"
   using surj_image_vimage_eq [OF \<open>surj f\<close>, of A]
   by (intro iffI) fastforce+
 
 lemma inj_vimage_image_eq: "inj f \<Longrightarrow> f -` (f ` A) = A"
   unfolding inj_def by blast
 
 lemma vimage_subsetD: "surj f \<Longrightarrow> f -` B \<subseteq> A \<Longrightarrow> B \<subseteq> f ` A"
   by (blast intro: sym)
 
 lemma vimage_subsetI: "inj f \<Longrightarrow> B \<subseteq> f ` A \<Longrightarrow> f -` B \<subseteq> A"
   unfolding inj_def by blast
 
 lemma vimage_subset_eq: "bij f \<Longrightarrow> f -` B \<subseteq> A \<longleftrightarrow> B \<subseteq> f ` A"
   unfolding bij_def by (blast del: subsetI intro: vimage_subsetI vimage_subsetD)
 
 lemma inj_on_image_eq_iff: "inj_on f C \<Longrightarrow> A \<subseteq> C \<Longrightarrow> B \<subseteq> C \<Longrightarrow> f ` A = f ` B \<longleftrightarrow> A = B"
   by (fastforce simp: inj_on_def)
 
 lemma inj_on_Un_image_eq_iff: "inj_on f (A \<union> B) \<Longrightarrow> f ` A = f ` B \<longleftrightarrow> A = B"
   by (erule inj_on_image_eq_iff) simp_all
 
 lemma inj_on_image_Int: "inj_on f C \<Longrightarrow> A \<subseteq> C \<Longrightarrow> B \<subseteq> C \<Longrightarrow> f ` (A \<inter> B) = f ` A \<inter> f ` B"
   unfolding inj_on_def by blast
 
 lemma inj_on_image_set_diff: "inj_on f C \<Longrightarrow> A - B \<subseteq> C \<Longrightarrow> B \<subseteq> C \<Longrightarrow> f ` (A - B) = f ` A - f ` B"
   unfolding inj_on_def by blast
 
 lemma image_Int: "inj f \<Longrightarrow> f ` (A \<inter> B) = f ` A \<inter> f ` B"
   unfolding inj_def by blast
 
 lemma image_set_diff: "inj f \<Longrightarrow> f ` (A - B) = f ` A - f ` B"
   unfolding inj_def by blast
 
 lemma inj_on_image_mem_iff: "inj_on f B \<Longrightarrow> a \<in> B \<Longrightarrow> A \<subseteq> B \<Longrightarrow> f a \<in> f ` A \<longleftrightarrow> a \<in> A"
   by (auto simp: inj_on_def)
 
 lemma inj_image_mem_iff: "inj f \<Longrightarrow> f a \<in> f ` A \<longleftrightarrow> a \<in> A"
   by (blast dest: injD)
 
 lemma inj_image_subset_iff: "inj f \<Longrightarrow> f ` A \<subseteq> f ` B \<longleftrightarrow> A \<subseteq> B"
   by (blast dest: injD)
 
 lemma inj_image_eq_iff: "inj f \<Longrightarrow> f ` A = f ` B \<longleftrightarrow> A = B"
   by (blast dest: injD)
 
 lemma surj_Compl_image_subset: "surj f \<Longrightarrow> - (f ` A) \<subseteq> f ` (- A)"
   by auto
 
 lemma inj_image_Compl_subset: "inj f \<Longrightarrow> f ` (- A) \<subseteq> - (f ` A)"
   by (auto simp: inj_def)
 
 lemma bij_image_Compl_eq: "bij f \<Longrightarrow> f ` (- A) = - (f ` A)"
   by (simp add: bij_def inj_image_Compl_subset surj_Compl_image_subset equalityI)
 
 lemma inj_vimage_singleton: "inj f \<Longrightarrow> f -` {a} \<subseteq> {THE x. f x = a}"
   \<comment> \<open>The inverse image of a singleton under an injective function is included in a singleton.\<close>
   by (simp add: inj_def) (blast intro: the_equality [symmetric])
 
 lemma inj_on_vimage_singleton: "inj_on f A \<Longrightarrow> f -` {a} \<inter> A \<subseteq> {THE x. x \<in> A \<and> f x = a}"
   by (auto simp add: inj_on_def intro: the_equality [symmetric])
 
 lemma bij_betw_byWitness:
   assumes left: "\<forall>a \<in> A. f' (f a) = a"
     and right: "\<forall>a' \<in> A'. f (f' a') = a'"
     and "f ` A \<subseteq> A'"
     and img2: "f' ` A' \<subseteq> A"
   shows "bij_betw f A A'"
   using assms
   unfolding bij_betw_def inj_on_def
 proof safe
   fix a b
   assume "a \<in> A" "b \<in> A"
   with left have "a = f' (f a) \<and> b = f' (f b)" by simp
   moreover assume "f a = f b"
   ultimately show "a = b" by simp
 next
   fix a' assume *: "a' \<in> A'"
   with img2 have "f' a' \<in> A" by blast
   moreover from * right have "a' = f (f' a')" by simp
   ultimately show "a' \<in> f ` A" by blast
 qed
 
 corollary notIn_Un_bij_betw:
   assumes "b \<notin> A"
     and "f b \<notin> A'"
     and "bij_betw f A A'"
   shows "bij_betw f (A \<union> {b}) (A' \<union> {f b})"
 proof -
   have "bij_betw f {b} {f b}"
     unfolding bij_betw_def inj_on_def by simp
   with assms show ?thesis
     using bij_betw_combine[of f A A' "{b}" "{f b}"] by blast
 qed
 
 lemma notIn_Un_bij_betw3:
   assumes "b \<notin> A"
     and "f b \<notin> A'"
   shows "bij_betw f A A' = bij_betw f (A \<union> {b}) (A' \<union> {f b})"
 proof
   assume "bij_betw f A A'"
   then show "bij_betw f (A \<union> {b}) (A' \<union> {f b})"
     using assms notIn_Un_bij_betw [of b A f A'] by blast
 next
   assume *: "bij_betw f (A \<union> {b}) (A' \<union> {f b})"
   have "f ` A = A'"
   proof safe
     fix a
     assume **: "a \<in> A"
     then have "f a \<in> A' \<union> {f b}"
       using * unfolding bij_betw_def by blast
     moreover
     have False if "f a = f b"
     proof -
       have "a = b"
         using * ** that unfolding bij_betw_def inj_on_def by blast
       with \<open>b \<notin> A\<close> ** show ?thesis by blast
     qed
     ultimately show "f a \<in> A'" by blast
   next
     fix a'
     assume **: "a' \<in> A'"
     then have "a' \<in> f ` (A \<union> {b})"
       using * by (auto simp add: bij_betw_def)
     then obtain a where 1: "a \<in> A \<union> {b} \<and> f a = a'" by blast
     moreover
     have False if "a = b" using 1 ** \<open>f b \<notin> A'\<close> that by blast
     ultimately have "a \<in> A" by blast
     with 1 show "a' \<in> f ` A" by blast
   qed
   then show "bij_betw f A A'"
     using * bij_betw_subset[of f "A \<union> {b}" _ A] by blast
 qed
 
 lemma inj_on_disjoint_Un:
   assumes "inj_on f A" and "inj_on g B" 
   and "f ` A \<inter> g ` B = {}"
   shows "inj_on (\<lambda>x. if x \<in> A then f x else g x) (A \<union> B)"
   using assms by (simp add: inj_on_def disjoint_iff) (blast)
 
 lemma bij_betw_disjoint_Un:
   assumes "bij_betw f A C" and "bij_betw g B D" 
   and "A \<inter> B = {}"
   and "C \<inter> D = {}"
   shows "bij_betw (\<lambda>x. if x \<in> A then f x else g x) (A \<union> B) (C \<union> D)"
   using assms by (auto simp: inj_on_disjoint_Un bij_betw_def)
 
 lemma involuntory_imp_bij:
   \<open>bij f\<close> if \<open>\<And>x. f (f x) = x\<close>
 proof (rule bijI)
   from that show \<open>surj f\<close>
     by (rule surjI)
   show \<open>inj f\<close>
   proof (rule injI)
     fix x y
     assume \<open>f x = f y\<close>
     then have \<open>f (f x) = f (f y)\<close>
       by simp
     then show \<open>x = y\<close>
       by (simp add: that)
   qed
 qed
 
 
 subsubsection \<open>Inj/surj/bij of Algebraic Operations\<close>
 
 context cancel_semigroup_add
 begin
 
 lemma inj_on_add [simp]:
   "inj_on ((+) a) A"
   by (rule inj_onI) simp
 
 lemma inj_on_add' [simp]:
   "inj_on (\<lambda>b. b + a) A"
   by (rule inj_onI) simp
 
 lemma bij_betw_add [simp]:
   "bij_betw ((+) a) A B \<longleftrightarrow> (+) a ` A = B"
   by (simp add: bij_betw_def)
 
 end
 
 context group_add
 begin
 
 lemma diff_left_imp_eq: "a - b = a - c \<Longrightarrow> b = c"
 unfolding add_uminus_conv_diff[symmetric]
 by(drule local.add_left_imp_eq) simp
 
 lemma inj_uminus[simp, intro]: "inj_on uminus A"
   by (auto intro!: inj_onI)
 
 lemma surj_uminus[simp]: "surj uminus"
 using surjI minus_minus by blast
 
 lemma surj_plus [simp]:
   "surj ((+) a)"
 proof (standard, simp, standard, simp)
   fix x
   have "x = a + (-a + x)" by (simp add: add.assoc)
   thus "x \<in> range ((+) a)" by blast
 qed
 
 lemma surj_plus_right [simp]:
   "surj (\<lambda>b. b+a)"
 proof (standard, simp, standard, simp)
   fix b show "b \<in> range (\<lambda>b. b+a)"
     using diff_add_cancel[of b a, symmetric] by blast
 qed
 
 lemma inj_on_diff_left [simp]:
   \<open>inj_on ((-) a) A\<close>
 by (auto intro: inj_onI dest!: diff_left_imp_eq)
 
 lemma inj_on_diff_right [simp]:
   \<open>inj_on (\<lambda>b. b - a) A\<close>
 by (auto intro: inj_onI simp add: algebra_simps)
 
 lemma surj_diff [simp]:
   "surj ((-) a)"
 proof (standard, simp, standard, simp)
   fix x
   have "x = a - (- x + a)" by (simp add: algebra_simps)
   thus "x \<in> range ((-) a)" by blast
 qed
 
 lemma surj_diff_right [simp]:
   "surj (\<lambda>x. x - a)"
 proof (standard, simp, standard, simp)
   fix x
   have "x = x + a - a" by simp
   thus "x \<in> range (\<lambda>x. x - a)" by fast
 qed
 
 lemma shows bij_plus: "bij ((+) a)" and bij_plus_right: "bij (\<lambda>x. x + a)"
   and bij_uminus: "bij uminus"
   and bij_diff: "bij ((-) a)" and bij_diff_right: "bij (\<lambda>x. x - a)"
 by(simp_all add: bij_def)
 
 lemma translation_subtract_Compl:
   "(\<lambda>x. x - a) ` (- t) = - ((\<lambda>x. x - a) ` t)"
 by(rule bij_image_Compl_eq)
   (auto simp add: bij_def surj_def inj_def diff_eq_eq intro!: add_diff_cancel[symmetric])
 
 lemma translation_diff:
   "(+) a ` (s - t) = ((+) a ` s) - ((+) a ` t)"
   by auto
 
 lemma translation_subtract_diff:
   "(\<lambda>x. x - a) ` (s - t) = ((\<lambda>x. x - a) ` s) - ((\<lambda>x. x - a) ` t)"
 by(rule image_set_diff)(simp add: inj_on_def diff_eq_eq)
 
 lemma translation_Int:
   "(+) a ` (s \<inter> t) = ((+) a ` s) \<inter> ((+) a ` t)"
   by auto
 
 lemma translation_subtract_Int:
   "(\<lambda>x. x - a) ` (s \<inter> t) = ((\<lambda>x. x - a) ` s) \<inter> ((\<lambda>x. x - a) ` t)"
 by(rule image_Int)(simp add: inj_on_def diff_eq_eq)
 
 end
 
 (* TODO: prove in group_add *)
 context ab_group_add
 begin
 
 lemma translation_Compl:
   "(+) a ` (- t) = - ((+) a ` t)"
 proof (rule set_eqI)
   fix b
   show "b \<in> (+) a ` (- t) \<longleftrightarrow> b \<in> - (+) a ` t"
     by (auto simp: image_iff algebra_simps intro!: bexI [of _ "b - a"])
 qed
 
 end
 
 
 subsection \<open>Function Updating\<close>
 
 definition fun_upd :: "('a \<Rightarrow> 'b) \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> ('a \<Rightarrow> 'b)"
   where "fun_upd f a b = (\<lambda>x. if x = a then b else f x)"
 
 nonterminal updbinds and updbind
 
 syntax
   "_updbind" :: "'a \<Rightarrow> 'a \<Rightarrow> updbind"             ("(2_ :=/ _)")
   ""         :: "updbind \<Rightarrow> updbinds"             ("_")
   "_updbinds":: "updbind \<Rightarrow> updbinds \<Rightarrow> updbinds" ("_,/ _")
   "_Update"  :: "'a \<Rightarrow> updbinds \<Rightarrow> 'a"            ("_/'((_)')" [1000, 0] 900)
 
 translations
   "_Update f (_updbinds b bs)" \<rightleftharpoons> "_Update (_Update f b) bs"
   "f(x:=y)" \<rightleftharpoons> "CONST fun_upd f x y"
 
 (* Hint: to define the sum of two functions (or maps), use case_sum.
          A nice infix syntax could be defined by
 notation
   case_sum  (infixr "'(+')"80)
 *)
 
 lemma fun_upd_idem_iff: "f(x:=y) = f \<longleftrightarrow> f x = y"
   unfolding fun_upd_def
   apply safe
    apply (erule subst)
    apply auto
   done
 
 lemma fun_upd_idem: "f x = y \<Longrightarrow> f(x := y) = f"
   by (simp only: fun_upd_idem_iff)
 
 lemma fun_upd_triv [iff]: "f(x := f x) = f"
   by (simp only: fun_upd_idem)
 
 lemma fun_upd_apply [simp]: "(f(x := y)) z = (if z = x then y else f z)"
   by (simp add: fun_upd_def)
 
 (* fun_upd_apply supersedes these two, but they are useful
    if fun_upd_apply is intentionally removed from the simpset *)
 lemma fun_upd_same: "(f(x := y)) x = y"
   by simp
 
 lemma fun_upd_other: "z \<noteq> x \<Longrightarrow> (f(x := y)) z = f z"
   by simp
 
 lemma fun_upd_upd [simp]: "f(x := y, x := z) = f(x := z)"
   by (simp add: fun_eq_iff)
 
 lemma fun_upd_twist: "a \<noteq> c \<Longrightarrow> (m(a := b))(c := d) = (m(c := d))(a := b)"
   by auto
 
 lemma inj_on_fun_updI: "inj_on f A \<Longrightarrow> y \<notin> f ` A \<Longrightarrow> inj_on (f(x := y)) A"
   by (auto simp: inj_on_def)
 
 lemma fun_upd_image: "f(x := y) ` A = (if x \<in> A then insert y (f ` (A - {x})) else f ` A)"
   by auto
 
 lemma fun_upd_comp: "f \<circ> (g(x := y)) = (f \<circ> g)(x := f y)"
   by auto
 
 lemma fun_upd_eqD: "f(x := y) = g(x := z) \<Longrightarrow> y = z"
   by (simp add: fun_eq_iff split: if_split_asm)
 
 
 subsection \<open>\<open>override_on\<close>\<close>
 
 definition override_on :: "('a \<Rightarrow> 'b) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> 'a set \<Rightarrow> 'a \<Rightarrow> 'b"
   where "override_on f g A = (\<lambda>a. if a \<in> A then g a else f a)"
 
 lemma override_on_emptyset[simp]: "override_on f g {} = f"
   by (simp add: override_on_def)
 
 lemma override_on_apply_notin[simp]: "a \<notin> A \<Longrightarrow> (override_on f g A) a = f a"
   by (simp add: override_on_def)
 
 lemma override_on_apply_in[simp]: "a \<in> A \<Longrightarrow> (override_on f g A) a = g a"
   by (simp add: override_on_def)
 
 lemma override_on_insert: "override_on f g (insert x X) = (override_on f g X)(x:=g x)"
   by (simp add: override_on_def fun_eq_iff)
 
 lemma override_on_insert': "override_on f g (insert x X) = (override_on (f(x:=g x)) g X)"
   by (simp add: override_on_def fun_eq_iff)
 
 
 subsection \<open>Inversion of injective functions\<close>
 
 definition the_inv_into :: "'a set \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> ('b \<Rightarrow> 'a)"
   where "the_inv_into A f = (\<lambda>x. THE y. y \<in> A \<and> f y = x)"
 
 lemma the_inv_into_f_f: "inj_on f A \<Longrightarrow> x \<in> A \<Longrightarrow> the_inv_into A f (f x) = x"
   unfolding the_inv_into_def inj_on_def by blast
 
 lemma f_the_inv_into_f: "inj_on f A \<Longrightarrow> y \<in> f ` A  \<Longrightarrow> f (the_inv_into A f y) = y"
   unfolding the_inv_into_def
   by (rule the1I2; blast dest: inj_onD)
 
 lemma f_the_inv_into_f_bij_betw:
   "bij_betw f A B \<Longrightarrow> (bij_betw f A B \<Longrightarrow> x \<in> B) \<Longrightarrow> f (the_inv_into A f x) = x"
   unfolding bij_betw_def by (blast intro: f_the_inv_into_f)
 
 lemma the_inv_into_into: "inj_on f A \<Longrightarrow> x \<in> f ` A \<Longrightarrow> A \<subseteq> B \<Longrightarrow> the_inv_into A f x \<in> B"
   unfolding the_inv_into_def
   by (rule the1I2; blast dest: inj_onD)
 
 lemma the_inv_into_onto [simp]: "inj_on f A \<Longrightarrow> the_inv_into A f ` (f ` A) = A"
   by (fast intro: the_inv_into_into the_inv_into_f_f [symmetric])
 
 lemma the_inv_into_f_eq: "inj_on f A \<Longrightarrow> f x = y \<Longrightarrow> x \<in> A \<Longrightarrow> the_inv_into A f y = x"
   by (force simp add: the_inv_into_f_f)
 
 lemma the_inv_into_comp:
   "inj_on f (g ` A) \<Longrightarrow> inj_on g A \<Longrightarrow> x \<in> f ` g ` A \<Longrightarrow>
     the_inv_into A (f \<circ> g) x = (the_inv_into A g \<circ> the_inv_into (g ` A) f) x"
   apply (rule the_inv_into_f_eq)
     apply (fast intro: comp_inj_on)
    apply (simp add: f_the_inv_into_f the_inv_into_into)
   apply (simp add: the_inv_into_into)
   done
 
 lemma inj_on_the_inv_into: "inj_on f A \<Longrightarrow> inj_on (the_inv_into A f) (f ` A)"
   by (auto intro: inj_onI simp: the_inv_into_f_f)
 
 lemma bij_betw_the_inv_into: "bij_betw f A B \<Longrightarrow> bij_betw (the_inv_into A f) B A"
   by (auto simp add: bij_betw_def inj_on_the_inv_into the_inv_into_into)
 
 lemma bij_betw_iff_bijections:
   "bij_betw f A B \<longleftrightarrow> (\<exists>g. (\<forall>x \<in> A. f x \<in> B \<and> g(f x) = x) \<and> (\<forall>y \<in> B. g y \<in> A \<and> f(g y) = y))"
   (is "?lhs = ?rhs")
 proof
   show "?lhs \<Longrightarrow> ?rhs"
     by (auto simp: bij_betw_def f_the_inv_into_f the_inv_into_f_f the_inv_into_into
         exI[where ?x="the_inv_into A f"])
 next
   show "?rhs \<Longrightarrow> ?lhs"
     by (force intro: bij_betw_byWitness)
 qed
 
 abbreviation the_inv :: "('a \<Rightarrow> 'b) \<Rightarrow> ('b \<Rightarrow> 'a)"
   where "the_inv f \<equiv> the_inv_into UNIV f"
 
 lemma the_inv_f_f: "the_inv f (f x) = x" if "inj f"
   using that UNIV_I by (rule the_inv_into_f_f)
 
 
 subsection \<open>Monotonicity\<close>
 
 definition monotone_on :: "'a set \<Rightarrow> ('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> ('b \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> bool"
   where "monotone_on A orda ordb f \<longleftrightarrow> (\<forall>x\<in>A. \<forall>y\<in>A. orda x y \<longrightarrow> ordb (f x) (f y))"
 
 abbreviation monotone :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> ('b \<Rightarrow> 'b \<Rightarrow> bool) \<Rightarrow> ('a \<Rightarrow> 'b) \<Rightarrow> bool"
   where "monotone \<equiv> monotone_on UNIV"
 
 lemma monotone_def[no_atp]: "monotone orda ordb f \<longleftrightarrow> (\<forall>x y. orda x y \<longrightarrow> ordb (f x) (f y))"
   by (simp add: monotone_on_def)
 
 text \<open>Lemma @{thm [source] monotone_def} is provided for backward compatibility.\<close>
 
 lemma monotone_onI:
   "(\<And>x y. x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> orda x y \<Longrightarrow> ordb (f x) (f y)) \<Longrightarrow> monotone_on A orda ordb f"
   by (simp add: monotone_on_def)
 
 lemma monotoneI[intro?]: "(\<And>x y. orda x y \<Longrightarrow> ordb (f x) (f y)) \<Longrightarrow> monotone orda ordb f"
   by (rule monotone_onI)
 
 lemma monotone_onD:
   "monotone_on A orda ordb f \<Longrightarrow> x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> orda x y \<Longrightarrow> ordb (f x) (f y)"
   by (simp add: monotone_on_def)
 
 lemma monotoneD[dest?]: "monotone orda ordb f \<Longrightarrow> orda x y \<Longrightarrow> ordb (f x) (f y)"
   by (rule monotone_onD[of UNIV, simplified])
 
 lemma monotone_on_subset: "monotone_on A orda ordb f \<Longrightarrow> B \<subseteq> A \<Longrightarrow> monotone_on B orda ordb f"
   by (auto intro: monotone_onI dest: monotone_onD)
 
 lemma monotone_on_empty[simp]: "monotone_on {} orda ordb f"
   by (auto intro: monotone_onI dest: monotone_onD)
 
 lemma monotone_on_o:
   assumes
     mono_f: "monotone_on A orda ordb f" and
     mono_g: "monotone_on B ordc orda g" and
     "g ` B \<subseteq> A"
   shows "monotone_on B ordc ordb (f \<circ> g)"
 proof (rule monotone_onI)
   fix x y assume "x \<in> B" and "y \<in> B" and "ordc x y"
   hence "orda (g x) (g y)"
     by (rule mono_g[THEN monotone_onD])
   moreover from \<open>g ` B \<subseteq> A\<close> \<open>x \<in> B\<close> \<open>y \<in> B\<close> have "g x \<in> A" and "g y \<in> A"
     unfolding image_subset_iff by simp_all
   ultimately show "ordb ((f \<circ> g) x) ((f \<circ> g) y)"
     using mono_f[THEN monotone_onD] by simp
 qed
 
 
 subsubsection \<open>Specializations For @{class ord} Type Class And More\<close>
 
 context ord begin
 
 abbreviation mono_on :: "'a set \<Rightarrow> ('a \<Rightarrow> 'b :: ord) \<Rightarrow> bool"
   where "mono_on A \<equiv> monotone_on A (\<le>) (\<le>)"
 
 abbreviation strict_mono_on :: "'a set \<Rightarrow> ('a \<Rightarrow> 'b :: ord) \<Rightarrow> bool"
   where "strict_mono_on A \<equiv> monotone_on A (<) (<)"
 
 lemma mono_on_def[no_atp]: "mono_on A f \<longleftrightarrow> (\<forall>r s. r \<in> A \<and> s \<in> A \<and> r \<le> s \<longrightarrow> f r \<le> f s)"
   by (auto simp add: monotone_on_def)
 
 lemma strict_mono_on_def[no_atp]:
   "strict_mono_on A f \<longleftrightarrow> (\<forall>r s. r \<in> A \<and> s \<in> A \<and> r < s \<longrightarrow> f r < f s)"
   by (auto simp add: monotone_on_def)
 
 text \<open>Lemmas @{thm [source] mono_on_def} and @{thm [source] strict_mono_on_def} are provided for
 backward compatibility.\<close>
 
 lemma mono_onI:
   "(\<And>r s. r \<in> A \<Longrightarrow> s \<in> A \<Longrightarrow> r \<le> s \<Longrightarrow> f r \<le> f s) \<Longrightarrow> mono_on A f"
   by (rule monotone_onI)
 
 lemma strict_mono_onI:
   "(\<And>r s. r \<in> A \<Longrightarrow> s \<in> A \<Longrightarrow> r < s \<Longrightarrow> f r < f s) \<Longrightarrow> strict_mono_on A f"
   by (rule monotone_onI)
 
 lemma mono_onD: "\<lbrakk>mono_on A f; r \<in> A; s \<in> A; r \<le> s\<rbrakk> \<Longrightarrow> f r \<le> f s"
   by (rule monotone_onD)
 
 lemma strict_mono_onD: "\<lbrakk>strict_mono_on A f; r \<in> A; s \<in> A; r < s\<rbrakk> \<Longrightarrow> f r < f s"
   by (rule monotone_onD)
 
 lemma mono_on_subset: "mono_on A f \<Longrightarrow> B \<subseteq> A \<Longrightarrow> mono_on B f"
   by (rule monotone_on_subset)
 
 end
 
 lemma mono_on_greaterD:
   assumes "mono_on A g" "x \<in> A" "y \<in> A" "g x > (g (y::_::linorder) :: _ :: linorder)"
   shows "x > y"
 proof (rule ccontr)
   assume "\<not>x > y"
   hence "x \<le> y" by (simp add: not_less)
   from assms(1-3) and this have "g x \<le> g y" by (rule mono_onD)
   with assms(4) show False by simp
 qed
 
 context order begin
 
 abbreviation mono :: "('a \<Rightarrow> 'b::order) \<Rightarrow> bool"
   where "mono \<equiv> mono_on UNIV"
 
 abbreviation strict_mono :: "('a \<Rightarrow> 'b::order) \<Rightarrow> bool"
   where "strict_mono \<equiv> strict_mono_on UNIV"
 
 abbreviation antimono :: "('a \<Rightarrow> 'b::order) \<Rightarrow> bool"
   where "antimono \<equiv> monotone (\<le>) (\<lambda>x y. y \<le> x)"
 
 lemma mono_def[no_atp]: "mono f \<longleftrightarrow> (\<forall>x y. x \<le> y \<longrightarrow> f x \<le> f y)"
   by (simp add: monotone_on_def)
 
 lemma strict_mono_def[no_atp]: "strict_mono f \<longleftrightarrow> (\<forall>x y. x < y \<longrightarrow> f x < f y)"
   by (simp add: monotone_on_def)
 
 lemma antimono_def[no_atp]: "antimono f \<longleftrightarrow> (\<forall>x y. x \<le> y \<longrightarrow> f x \<ge> f y)"
   by (simp add: monotone_on_def)
 
 text \<open>Lemmas @{thm [source] mono_def}, @{thm [source] strict_mono_def}, and
 @{thm [source] antimono_def} are provided for backward compatibility.\<close>
 
 lemma monoI [intro?]: "(\<And>x y. x \<le> y \<Longrightarrow> f x \<le> f y) \<Longrightarrow> mono f"
   by (rule monotoneI)
 
 lemma strict_monoI [intro?]: "(\<And>x y. x < y \<Longrightarrow> f x < f y) \<Longrightarrow> strict_mono f"
   by (rule monotoneI)
 
 lemma antimonoI [intro?]: "(\<And>x y. x \<le> y \<Longrightarrow> f x \<ge> f y) \<Longrightarrow> antimono f"
   by (rule monotoneI)
 
 lemma monoD [dest?]: "mono f \<Longrightarrow> x \<le> y \<Longrightarrow> f x \<le> f y"
   by (rule monotoneD)
 
 lemma strict_monoD [dest?]: "strict_mono f \<Longrightarrow> x < y \<Longrightarrow> f x < f y"
   by (rule monotoneD)
 
 lemma antimonoD [dest?]: "antimono f \<Longrightarrow> x \<le> y \<Longrightarrow> f x \<ge> f y"
   by (rule monotoneD)
 
 lemma monoE:
   assumes "mono f"
   assumes "x \<le> y"
   obtains "f x \<le> f y"
 proof
   from assms show "f x \<le> f y" by (simp add: mono_def)
 qed
 
 lemma antimonoE:
   fixes f :: "'a \<Rightarrow> 'b::order"
   assumes "antimono f"
   assumes "x \<le> y"
   obtains "f x \<ge> f y"
 proof
   from assms show "f x \<ge> f y" by (simp add: antimono_def)
 qed
 
 lemma mono_imp_mono_on: "mono f \<Longrightarrow> mono_on A f"
   by (rule monotone_on_subset[OF _ subset_UNIV])
 
 lemma strict_mono_mono [dest?]:
   assumes "strict_mono f"
   shows "mono f"
 proof (rule monoI)
   fix x y
   assume "x \<le> y"
   show "f x \<le> f y"
   proof (cases "x = y")
     case True then show ?thesis by simp
   next
     case False with \<open>x \<le> y\<close> have "x < y" by simp
     with assms strict_monoD have "f x < f y" by auto
     then show ?thesis by simp
 
   qed
 qed
 
 end
 
 context linorder begin
 
 lemma mono_invE:
   fixes f :: "'a \<Rightarrow> 'b::order"
   assumes "mono f"
   assumes "f x < f y"
   obtains "x \<le> y"
 proof
   show "x \<le> y"
   proof (rule ccontr)
     assume "\<not> x \<le> y"
     then have "y \<le> x" by simp
     with \<open>mono f\<close> obtain "f y \<le> f x" by (rule monoE)
     with \<open>f x < f y\<close> show False by simp
   qed
 qed
 
 lemma mono_strict_invE:
   fixes f :: "'a \<Rightarrow> 'b::order"
   assumes "mono f"
   assumes "f x < f y"
   obtains "x < y"
 proof
   show "x < y"
   proof (rule ccontr)
     assume "\<not> x < y"
     then have "y \<le> x" by simp
     with \<open>mono f\<close> obtain "f y \<le> f x" by (rule monoE)
     with \<open>f x < f y\<close> show False by simp
   qed
 qed
 
 lemma strict_mono_eq:
   assumes "strict_mono f"
   shows "f x = f y \<longleftrightarrow> x = y"
 proof
   assume "f x = f y"
   show "x = y" proof (cases x y rule: linorder_cases)
     case less with assms strict_monoD have "f x < f y" by auto
     with \<open>f x = f y\<close> show ?thesis by simp
   next
     case equal then show ?thesis .
   next
     case greater with assms strict_monoD have "f y < f x" by auto
     with \<open>f x = f y\<close> show ?thesis by simp
   qed
 qed simp
 
 lemma strict_mono_less_eq:
   assumes "strict_mono f"
   shows "f x \<le> f y \<longleftrightarrow> x \<le> y"
 proof
   assume "x \<le> y"
   with assms strict_mono_mono monoD show "f x \<le> f y" by auto
 next
   assume "f x \<le> f y"
   show "x \<le> y" proof (rule ccontr)
     assume "\<not> x \<le> y" then have "y < x" by simp
     with assms strict_monoD have "f y < f x" by auto
     with \<open>f x \<le> f y\<close> show False by simp
   qed
 qed
 
 lemma strict_mono_less:
   assumes "strict_mono f"
   shows "f x < f y \<longleftrightarrow> x < y"
   using assms
     by (auto simp add: less_le Orderings.less_le strict_mono_eq strict_mono_less_eq)
 
 end
 
 lemma strict_mono_inv:
   fixes f :: "('a::linorder) \<Rightarrow> ('b::linorder)"
   assumes "strict_mono f" and "surj f" and inv: "\<And>x. g (f x) = x"
   shows "strict_mono g"
 proof
   fix x y :: 'b assume "x < y"
   from \<open>surj f\<close> obtain x' y' where [simp]: "x = f x'" "y = f y'" by blast
   with \<open>x < y\<close> and \<open>strict_mono f\<close> have "x' < y'" by (simp add: strict_mono_less)
   with inv show "g x < g y" by simp
 qed
 
 lemma strict_mono_on_imp_inj_on:
   assumes "strict_mono_on A (f :: (_ :: linorder) \<Rightarrow> (_ :: preorder))"
   shows "inj_on f A"
 proof (rule inj_onI)
   fix x y assume "x \<in> A" "y \<in> A" "f x = f y"
   thus "x = y"
     by (cases x y rule: linorder_cases)
        (auto dest: strict_mono_onD[OF assms, of x y] strict_mono_onD[OF assms, of y x])
 qed
 
 lemma strict_mono_on_leD:
   assumes "strict_mono_on A (f :: (_ :: linorder) \<Rightarrow> _ :: preorder)" "x \<in> A" "y \<in> A" "x \<le> y"
   shows "f x \<le> f y"
 proof (cases "x = y")
   case True
   then show ?thesis by simp
 next
   case False
   with assms have "f x < f y"
     using strict_mono_onD[OF assms(1)] by simp
   then show ?thesis by (rule less_imp_le)
 qed
 
 lemma strict_mono_on_eqD:
   fixes f :: "(_ :: linorder) \<Rightarrow> (_ :: preorder)"
   assumes "strict_mono_on A f" "f x = f y" "x \<in> A" "y \<in> A"
   shows "y = x"
   using assms by (cases rule: linorder_cases) (auto dest: strict_mono_onD)
 
 lemma strict_mono_on_imp_mono_on:
   "strict_mono_on A (f :: (_ :: linorder) \<Rightarrow> _ :: preorder) \<Longrightarrow> mono_on A f"
   by (rule mono_onI, rule strict_mono_on_leD)
 
 lemma mono_compose: "mono Q \<Longrightarrow> mono (\<lambda>i x. Q i (f x))"
   unfolding mono_def le_fun_def by auto
 
 lemma mono_add:
   fixes a :: "'a::ordered_ab_semigroup_add" 
   shows "mono ((+) a)"
   by (simp add: add_left_mono monoI)
 
 lemma (in semilattice_inf) mono_inf: "mono f \<Longrightarrow> f (A \<sqinter> B) \<le> f A \<sqinter> f B"
   for f :: "'a \<Rightarrow> 'b::semilattice_inf"
   by (auto simp add: mono_def intro: Lattices.inf_greatest)
 
 lemma (in semilattice_sup) mono_sup: "mono f \<Longrightarrow> f A \<squnion> f B \<le> f (A \<squnion> B)"
   for f :: "'a \<Rightarrow> 'b::semilattice_sup"
   by (auto simp add: mono_def intro: Lattices.sup_least)
 
 lemma (in linorder) min_of_mono: "mono f \<Longrightarrow> min (f m) (f n) = f (min m n)"
   by (auto simp: mono_def Orderings.min_def min_def intro: Orderings.antisym)
 
 lemma (in linorder) max_of_mono: "mono f \<Longrightarrow> max (f m) (f n) = f (max m n)"
   by (auto simp: mono_def Orderings.max_def max_def intro: Orderings.antisym)
 
 lemma (in linorder)
   max_of_antimono: "antimono f \<Longrightarrow> max (f x) (f y) = f (min x y)" and
   min_of_antimono: "antimono f \<Longrightarrow> min (f x) (f y) = f (max x y)"
   by (auto simp: antimono_def Orderings.max_def max_def Orderings.min_def min_def intro!: antisym)
 
 lemma (in linorder) strict_mono_imp_inj_on: "strict_mono f \<Longrightarrow> inj_on f A"
   by (auto intro!: inj_onI dest: strict_mono_eq)
 
 lemma mono_Int: "mono f \<Longrightarrow> f (A \<inter> B) \<subseteq> f A \<inter> f B"
   by (fact mono_inf)
 
 lemma mono_Un: "mono f \<Longrightarrow> f A \<union> f B \<subseteq> f (A \<union> B)"
   by (fact mono_sup)
 
 
 subsubsection \<open>Least value operator\<close>
 
 lemma Least_mono: "mono f \<Longrightarrow> \<exists>x\<in>S. \<forall>y\<in>S. x \<le> y \<Longrightarrow> (LEAST y. y \<in> f ` S) = f (LEAST x. x \<in> S)"
   for f :: "'a::order \<Rightarrow> 'b::order"
   \<comment> \<open>Courtesy of Stephan Merz\<close>
   apply clarify
   apply (erule_tac P = "\<lambda>x. x \<in> S" in LeastI2_order)
    apply fast
   apply (rule LeastI2_order)
     apply (auto elim: monoD intro!: order_antisym)
   done
 
 
 subsection \<open>Setup\<close>
 
 subsubsection \<open>Proof tools\<close>
 
 text \<open>Simplify terms of the form \<open>f(\<dots>,x:=y,\<dots>,x:=z,\<dots>)\<close> to \<open>f(\<dots>,x:=z,\<dots>)\<close>\<close>
 
 simproc_setup fun_upd2 ("f(v := w, x := y)") = \<open>fn _ =>
   let
     fun gen_fun_upd NONE T _ _ = NONE
       | gen_fun_upd (SOME f) T x y = SOME (Const (\<^const_name>\<open>fun_upd\<close>, T) $ f $ x $ y)
     fun dest_fun_T1 (Type (_, T :: Ts)) = T
     fun find_double (t as Const (\<^const_name>\<open>fun_upd\<close>,T) $ f $ x $ y) =
       let
         fun find (Const (\<^const_name>\<open>fun_upd\<close>,T) $ g $ v $ w) =
               if v aconv x then SOME g else gen_fun_upd (find g) T v w
           | find t = NONE
       in (dest_fun_T1 T, gen_fun_upd (find f) T x y) end
 
     val ss = simpset_of \<^context>
 
     fun proc ctxt ct =
       let
         val t = Thm.term_of ct
       in
         (case find_double t of
           (T, NONE) => NONE
         | (T, SOME rhs) =>
             SOME (Goal.prove ctxt [] [] (Logic.mk_equals (t, rhs))
               (fn _ =>
                 resolve_tac ctxt [eq_reflection] 1 THEN
                 resolve_tac ctxt @{thms ext} 1 THEN
                 simp_tac (put_simpset ss ctxt) 1)))
       end
   in proc end
 \<close>
 
 
 subsubsection \<open>Functorial structure of types\<close>
 
 ML_file \<open>Tools/functor.ML\<close>
 
 functor map_fun: map_fun
   by (simp_all add: fun_eq_iff)
 
 functor vimage
   by (simp_all add: fun_eq_iff vimage_comp)
 
 
 text \<open>Legacy theorem names\<close>
 
 lemmas o_def = comp_def
 lemmas o_apply = comp_apply
 lemmas o_assoc = comp_assoc [symmetric]
 lemmas id_o = id_comp
 lemmas o_id = comp_id
 lemmas o_eq_dest = comp_eq_dest
 lemmas o_eq_elim = comp_eq_elim
 lemmas o_eq_dest_lhs = comp_eq_dest_lhs
 lemmas o_eq_id_dest = comp_eq_id_dest
 
 end
diff --git a/src/HOL/Library/Countable_Set.thy b/src/HOL/Library/Countable_Set.thy
--- a/src/HOL/Library/Countable_Set.thy
+++ b/src/HOL/Library/Countable_Set.thy
@@ -1,470 +1,470 @@
 (*  Title:      HOL/Library/Countable_Set.thy
     Author:     Johannes Hölzl
     Author:     Andrei Popescu
 *)
 
 section \<open>Countable sets\<close>
 
 theory Countable_Set
 imports Countable Infinite_Set
 begin
 
 subsection \<open>Predicate for countable sets\<close>
 
 definition countable :: "'a set \<Rightarrow> bool" where
   "countable S \<longleftrightarrow> (\<exists>f::'a \<Rightarrow> nat. inj_on f S)"
 
 lemma countableE:
   assumes S: "countable S" obtains f :: "'a \<Rightarrow> nat" where "inj_on f S"
   using S by (auto simp: countable_def)
 
 lemma countableI: "inj_on (f::'a \<Rightarrow> nat) S \<Longrightarrow> countable S"
   by (auto simp: countable_def)
 
 lemma countableI': "inj_on (f::'a \<Rightarrow> 'b::countable) S \<Longrightarrow> countable S"
   using comp_inj_on[of f S to_nat] by (auto intro: countableI)
 
 lemma countableE_bij:
   assumes S: "countable S" obtains f :: "nat \<Rightarrow> 'a" and C :: "nat set" where "bij_betw f C S"
   using S by (blast elim: countableE dest: inj_on_imp_bij_betw bij_betw_inv)
 
 lemma countableI_bij: "bij_betw f (C::nat set) S \<Longrightarrow> countable S"
   by (blast intro: countableI bij_betw_inv_into bij_betw_imp_inj_on)
 
 lemma countable_finite: "finite S \<Longrightarrow> countable S"
   by (blast dest: finite_imp_inj_to_nat_seg countableI)
 
 lemma countableI_bij1: "bij_betw f A B \<Longrightarrow> countable A \<Longrightarrow> countable B"
   by (blast elim: countableE_bij intro: bij_betw_trans countableI_bij)
 
 lemma countableI_bij2: "bij_betw f B A \<Longrightarrow> countable A \<Longrightarrow> countable B"
   by (blast elim: countableE_bij intro: bij_betw_trans bij_betw_inv_into countableI_bij)
 
 lemma countable_iff_bij[simp]: "bij_betw f A B \<Longrightarrow> countable A \<longleftrightarrow> countable B"
   by (blast intro: countableI_bij1 countableI_bij2)
 
 lemma countable_subset: "A \<subseteq> B \<Longrightarrow> countable B \<Longrightarrow> countable A"
   by (auto simp: countable_def intro: subset_inj_on)
 
 lemma countableI_type[intro, simp]: "countable (A:: 'a :: countable set)"
   using countableI[of to_nat A] by auto
 
 subsection \<open>Enumerate a countable set\<close>
 
 lemma countableE_infinite:
   assumes "countable S" "infinite S"
   obtains e :: "'a \<Rightarrow> nat" where "bij_betw e S UNIV"
 proof -
   obtain f :: "'a \<Rightarrow> nat" where "inj_on f S"
     using \<open>countable S\<close> by (rule countableE)
   then have "bij_betw f S (f`S)"
     unfolding bij_betw_def by simp
   moreover
   from \<open>inj_on f S\<close> \<open>infinite S\<close> have inf_fS: "infinite (f`S)"
     by (auto dest: finite_imageD)
   then have "bij_betw (the_inv_into UNIV (enumerate (f`S))) (f`S) UNIV"
     by (intro bij_betw_the_inv_into bij_enumerate)
   ultimately have "bij_betw (the_inv_into UNIV (enumerate (f`S)) \<circ> f) S UNIV"
     by (rule bij_betw_trans)
   then show thesis ..
 qed
 
 lemma countable_infiniteE':
   assumes "countable A" "infinite A"
   obtains g where "bij_betw g (UNIV :: nat set) A"
-  using bij_betw_inv[OF countableE_infinite[OF assms]] that by blast
+  by (meson assms bij_betw_inv countableE_infinite)
 
 lemma countable_enum_cases:
   assumes "countable S"
   obtains (finite) f :: "'a \<Rightarrow> nat" where "finite S" "bij_betw f S {..<card S}"
         | (infinite) f :: "'a \<Rightarrow> nat" where "infinite S" "bij_betw f S UNIV"
   using ex_bij_betw_finite_nat[of S] countableE_infinite \<open>countable S\<close>
   by (cases "finite S") (auto simp add: atLeast0LessThan)
 
 definition to_nat_on :: "'a set \<Rightarrow> 'a \<Rightarrow> nat" where
   "to_nat_on S = (SOME f. if finite S then bij_betw f S {..< card S} else bij_betw f S UNIV)"
 
 definition from_nat_into :: "'a set \<Rightarrow> nat \<Rightarrow> 'a" where
   "from_nat_into S n = (if n \<in> to_nat_on S ` S then inv_into S (to_nat_on S) n else SOME s. s\<in>S)"
 
 lemma to_nat_on_finite: "finite S \<Longrightarrow> bij_betw (to_nat_on S) S {..< card S}"
   using ex_bij_betw_finite_nat unfolding to_nat_on_def
   by (intro someI2_ex[where Q="\<lambda>f. bij_betw f S {..<card S}"]) (auto simp add: atLeast0LessThan)
 
 lemma to_nat_on_infinite: "countable S \<Longrightarrow> infinite S \<Longrightarrow> bij_betw (to_nat_on S) S UNIV"
   using countableE_infinite unfolding to_nat_on_def
   by (intro someI2_ex[where Q="\<lambda>f. bij_betw f S UNIV"]) auto
 
 lemma bij_betw_from_nat_into_finite: "finite S \<Longrightarrow> bij_betw (from_nat_into S) {..< card S} S"
   unfolding from_nat_into_def[abs_def]
   using to_nat_on_finite[of S]
   apply (subst bij_betw_cong)
   apply (split if_split)
   apply (simp add: bij_betw_def)
   apply (auto cong: bij_betw_cong
               intro: bij_betw_inv_into to_nat_on_finite)
   done
 
 lemma bij_betw_from_nat_into: "countable S \<Longrightarrow> infinite S \<Longrightarrow> bij_betw (from_nat_into S) UNIV S"
   unfolding from_nat_into_def[abs_def]
   using to_nat_on_infinite[of S, unfolded bij_betw_def]
   by (auto cong: bij_betw_cong intro: bij_betw_inv_into to_nat_on_infinite)
 
 text \<open>
   The sum/product over the enumeration of a finite set equals simply the sum/product over the set
 \<close>
 context comm_monoid_set
 begin
 
 lemma card_from_nat_into:
   "F (\<lambda>i. h (from_nat_into A i)) {..<card A} = F h A"
 proof (cases "finite A")
   case True
   have "F (\<lambda>i. h (from_nat_into A i)) {..<card A} = F h (from_nat_into A ` {..<card A})"
     by (metis True bij_betw_def bij_betw_from_nat_into_finite reindex_cong)
   also have "... = F h A"
     by (metis True bij_betw_def bij_betw_from_nat_into_finite)
   finally show ?thesis .
 qed auto
 
 end
 
 lemma countable_as_injective_image:
   assumes "countable A" "infinite A"
   obtains f :: "nat \<Rightarrow> 'a" where "A = range f" "inj f"
 by (metis bij_betw_def bij_betw_from_nat_into [OF assms])
 
 lemma inj_on_to_nat_on[intro]: "countable A \<Longrightarrow> inj_on (to_nat_on A) A"
   using to_nat_on_infinite[of A] to_nat_on_finite[of A]
   by (cases "finite A") (auto simp: bij_betw_def)
 
 lemma to_nat_on_inj[simp]:
   "countable A \<Longrightarrow> a \<in> A \<Longrightarrow> b \<in> A \<Longrightarrow> to_nat_on A a = to_nat_on A b \<longleftrightarrow> a = b"
   using inj_on_to_nat_on[of A] by (auto dest: inj_onD)
 
 lemma from_nat_into_to_nat_on[simp]: "countable A \<Longrightarrow> a \<in> A \<Longrightarrow> from_nat_into A (to_nat_on A a) = a"
   by (auto simp: from_nat_into_def intro!: inv_into_f_f)
 
 lemma subset_range_from_nat_into: "countable A \<Longrightarrow> A \<subseteq> range (from_nat_into A)"
   by (auto intro: from_nat_into_to_nat_on[symmetric])
 
 lemma from_nat_into: "A \<noteq> {} \<Longrightarrow> from_nat_into A n \<in> A"
   unfolding from_nat_into_def by (metis equals0I inv_into_into someI_ex)
 
 lemma range_from_nat_into_subset: "A \<noteq> {} \<Longrightarrow> range (from_nat_into A) \<subseteq> A"
   using from_nat_into[of A] by auto
 
 lemma range_from_nat_into[simp]: "A \<noteq> {} \<Longrightarrow> countable A \<Longrightarrow> range (from_nat_into A) = A"
   by (metis equalityI range_from_nat_into_subset subset_range_from_nat_into)
 
 lemma image_to_nat_on: "countable A \<Longrightarrow> infinite A \<Longrightarrow> to_nat_on A ` A = UNIV"
   using to_nat_on_infinite[of A] by (simp add: bij_betw_def)
 
 lemma to_nat_on_surj: "countable A \<Longrightarrow> infinite A \<Longrightarrow> \<exists>a\<in>A. to_nat_on A a = n"
   by (metis (no_types) image_iff iso_tuple_UNIV_I image_to_nat_on)
 
 lemma to_nat_on_from_nat_into[simp]: "n \<in> to_nat_on A ` A \<Longrightarrow> to_nat_on A (from_nat_into A n) = n"
   by (simp add: f_inv_into_f from_nat_into_def)
 
 lemma to_nat_on_from_nat_into_infinite[simp]:
   "countable A \<Longrightarrow> infinite A \<Longrightarrow> to_nat_on A (from_nat_into A n) = n"
   by (metis image_iff to_nat_on_surj to_nat_on_from_nat_into)
 
 lemma from_nat_into_inj:
   "countable A \<Longrightarrow> m \<in> to_nat_on A ` A \<Longrightarrow> n \<in> to_nat_on A ` A \<Longrightarrow>
     from_nat_into A m = from_nat_into A n \<longleftrightarrow> m = n"
   by (subst to_nat_on_inj[symmetric, of A]) auto
 
 lemma from_nat_into_inj_infinite[simp]:
   "countable A \<Longrightarrow> infinite A \<Longrightarrow> from_nat_into A m = from_nat_into A n \<longleftrightarrow> m = n"
   using image_to_nat_on[of A] from_nat_into_inj[of A m n] by simp
 
 lemma eq_from_nat_into_iff:
   "countable A \<Longrightarrow> x \<in> A \<Longrightarrow> i \<in> to_nat_on A ` A \<Longrightarrow> x = from_nat_into A i \<longleftrightarrow> i = to_nat_on A x"
   by auto
 
 lemma from_nat_into_surj: "countable A \<Longrightarrow> a \<in> A \<Longrightarrow> \<exists>n. from_nat_into A n = a"
   by (rule exI[of _ "to_nat_on A a"]) simp
 
 lemma from_nat_into_inject[simp]:
   "A \<noteq> {} \<Longrightarrow> countable A \<Longrightarrow> B \<noteq> {} \<Longrightarrow> countable B \<Longrightarrow> from_nat_into A = from_nat_into B \<longleftrightarrow> A = B"
   by (metis range_from_nat_into)
 
 lemma inj_on_from_nat_into: "inj_on from_nat_into ({A. A \<noteq> {} \<and> countable A})"
   unfolding inj_on_def by auto
 
 subsection \<open>Closure properties of countability\<close>
 
 lemma countable_SIGMA[intro, simp]:
   "countable I \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> countable (A i)) \<Longrightarrow> countable (SIGMA i : I. A i)"
   by (intro countableI'[of "\<lambda>(i, a). (to_nat_on I i, to_nat_on (A i) a)"]) (auto simp: inj_on_def)
 
 lemma countable_image[intro, simp]:
   assumes "countable A"
   shows "countable (f`A)"
 proof -
   obtain g :: "'a \<Rightarrow> nat" where "inj_on g A"
     using assms by (rule countableE)
   moreover have "inj_on (inv_into A f) (f`A)" "inv_into A f ` f ` A \<subseteq> A"
     by (auto intro: inj_on_inv_into inv_into_into)
   ultimately show ?thesis
     by (blast dest: comp_inj_on subset_inj_on intro: countableI)
 qed
 
 lemma countable_image_inj_on: "countable (f ` A) \<Longrightarrow> inj_on f A \<Longrightarrow> countable A"
   by (metis countable_image the_inv_into_onto)
 
 lemma countable_image_inj_Int_vimage:
    "\<lbrakk>inj_on f S; countable A\<rbrakk> \<Longrightarrow> countable (S \<inter> f -` A)"
   by (meson countable_image_inj_on countable_subset image_subset_iff_subset_vimage inf_le2 inj_on_Int)
 
 lemma countable_image_inj_gen:
    "\<lbrakk>inj_on f S; countable A\<rbrakk> \<Longrightarrow> countable {x \<in> S. f x \<in> A}"
   using countable_image_inj_Int_vimage
   by (auto simp: vimage_def Collect_conj_eq)
 
 lemma countable_image_inj_eq:
    "inj_on f S \<Longrightarrow> countable(f ` S) \<longleftrightarrow> countable S"
   using countable_image_inj_on by blast
 
 lemma countable_image_inj:
    "\<lbrakk>countable A; inj f\<rbrakk> \<Longrightarrow> countable {x. f x \<in> A}"
   by (metis (mono_tags, lifting) countable_image_inj_eq countable_subset image_Collect_subsetI inj_on_inverseI the_inv_f_f)
 
 lemma countable_UN[intro, simp]:
   fixes I :: "'i set" and A :: "'i => 'a set"
   assumes I: "countable I"
   assumes A: "\<And>i. i \<in> I \<Longrightarrow> countable (A i)"
   shows "countable (\<Union>i\<in>I. A i)"
 proof -
   have "(\<Union>i\<in>I. A i) = snd ` (SIGMA i : I. A i)" by (auto simp: image_iff)
   then show ?thesis by (simp add: assms)
 qed
 
 lemma countable_Un[intro]: "countable A \<Longrightarrow> countable B \<Longrightarrow> countable (A \<union> B)"
   by (rule countable_UN[of "{True, False}" "\<lambda>True \<Rightarrow> A | False \<Rightarrow> B", simplified])
      (simp split: bool.split)
 
 lemma countable_Un_iff[simp]: "countable (A \<union> B) \<longleftrightarrow> countable A \<and> countable B"
   by (metis countable_Un countable_subset inf_sup_ord(3,4))
 
 lemma countable_Plus[intro, simp]:
   "countable A \<Longrightarrow> countable B \<Longrightarrow> countable (A <+> B)"
   by (simp add: Plus_def)
 
 lemma countable_empty[intro, simp]: "countable {}"
   by (blast intro: countable_finite)
 
 lemma countable_insert[intro, simp]: "countable A \<Longrightarrow> countable (insert a A)"
   using countable_Un[of "{a}" A] by (auto simp: countable_finite)
 
 lemma countable_Int1[intro, simp]: "countable A \<Longrightarrow> countable (A \<inter> B)"
   by (force intro: countable_subset)
 
 lemma countable_Int2[intro, simp]: "countable B \<Longrightarrow> countable (A \<inter> B)"
   by (blast intro: countable_subset)
 
 lemma countable_INT[intro, simp]: "i \<in> I \<Longrightarrow> countable (A i) \<Longrightarrow> countable (\<Inter>i\<in>I. A i)"
   by (blast intro: countable_subset)
 
 lemma countable_Diff[intro, simp]: "countable A \<Longrightarrow> countable (A - B)"
   by (blast intro: countable_subset)
 
 lemma countable_insert_eq [simp]: "countable (insert x A) = countable A"
     by auto (metis Diff_insert_absorb countable_Diff insert_absorb)
 
 lemma countable_vimage: "B \<subseteq> range f \<Longrightarrow> countable (f -` B) \<Longrightarrow> countable B"
   by (metis Int_absorb2 countable_image image_vimage_eq)
 
 lemma surj_countable_vimage: "surj f \<Longrightarrow> countable (f -` B) \<Longrightarrow> countable B"
   by (metis countable_vimage top_greatest)
 
 lemma countable_Collect[simp]: "countable A \<Longrightarrow> countable {a \<in> A. \<phi> a}"
   by (metis Collect_conj_eq Int_absorb Int_commute Int_def countable_Int1)
 
 lemma countable_Image:
   assumes "\<And>y. y \<in> Y \<Longrightarrow> countable (X `` {y})"
   assumes "countable Y"
   shows "countable (X `` Y)"
 proof -
   have "countable (X `` (\<Union>y\<in>Y. {y}))"
     unfolding Image_UN by (intro countable_UN assms)
   then show ?thesis by simp
 qed
 
 lemma countable_relpow:
   fixes X :: "'a rel"
   assumes Image_X: "\<And>Y. countable Y \<Longrightarrow> countable (X `` Y)"
   assumes Y: "countable Y"
   shows "countable ((X ^^ i) `` Y)"
   using Y by (induct i arbitrary: Y) (auto simp: relcomp_Image Image_X)
 
 lemma countable_funpow:
   fixes f :: "'a set \<Rightarrow> 'a set"
   assumes "\<And>A. countable A \<Longrightarrow> countable (f A)"
   and "countable A"
   shows "countable ((f ^^ n) A)"
 by(induction n)(simp_all add: assms)
 
 lemma countable_rtrancl:
   "(\<And>Y. countable Y \<Longrightarrow> countable (X `` Y)) \<Longrightarrow> countable Y \<Longrightarrow> countable (X\<^sup>* `` Y)"
   unfolding rtrancl_is_UN_relpow UN_Image by (intro countable_UN countableI_type countable_relpow)
 
 lemma countable_lists[intro, simp]:
   assumes A: "countable A" shows "countable (lists A)"
 proof -
   have "countable (lists (range (from_nat_into A)))"
     by (auto simp: lists_image)
   with A show ?thesis
     by (auto dest: subset_range_from_nat_into countable_subset lists_mono)
 qed
 
 lemma Collect_finite_eq_lists: "Collect finite = set ` lists UNIV"
   using finite_list by auto
 
 lemma countable_Collect_finite: "countable (Collect (finite::'a::countable set\<Rightarrow>bool))"
   by (simp add: Collect_finite_eq_lists)
 
 lemma countable_int: "countable \<int>"
   unfolding Ints_def by auto
 
 lemma countable_rat: "countable \<rat>"
   unfolding Rats_def by auto
 
 lemma Collect_finite_subset_eq_lists: "{A. finite A \<and> A \<subseteq> T} = set ` lists T"
   using finite_list by (auto simp: lists_eq_set)
 
 lemma countable_Collect_finite_subset:
   "countable T \<Longrightarrow> countable {A. finite A \<and> A \<subseteq> T}"
   unfolding Collect_finite_subset_eq_lists by auto
 
 lemma countable_Fpow: "countable S \<Longrightarrow> countable (Fpow S)"
   using countable_Collect_finite_subset
   by (force simp add: Fpow_def conj_commute)
 
 lemma countable_set_option [simp]: "countable (set_option x)"
   by (cases x) auto
 
 subsection \<open>Misc lemmas\<close>
 
 lemma countable_subset_image:
    "countable B \<and> B \<subseteq> (f ` A) \<longleftrightarrow> (\<exists>A'. countable A' \<and> A' \<subseteq> A \<and> (B = f ` A'))"
    (is "?lhs = ?rhs")
 proof
   assume ?lhs
   show ?rhs
     by (rule exI [where x="inv_into A f ` B"])
       (use \<open>?lhs\<close> in \<open>auto simp: f_inv_into_f subset_iff image_inv_into_cancel inv_into_into\<close>)
 next
   assume ?rhs
   then show ?lhs by force
 qed
 
 lemma ex_subset_image_inj:
    "(\<exists>T. T \<subseteq> f ` S \<and> P T) \<longleftrightarrow> (\<exists>T. T \<subseteq> S \<and> inj_on f T \<and> P (f ` T))"
   by (auto simp: subset_image_inj)
 
 lemma all_subset_image_inj:
    "(\<forall>T. T \<subseteq> f ` S \<longrightarrow> P T) \<longleftrightarrow> (\<forall>T. T \<subseteq> S \<and> inj_on f T \<longrightarrow> P(f ` T))"
   by (metis subset_image_inj)
 
 lemma ex_countable_subset_image_inj:
    "(\<exists>T. countable T \<and> T \<subseteq> f ` S \<and> P T) \<longleftrightarrow>
     (\<exists>T. countable T \<and> T \<subseteq> S \<and> inj_on f T \<and> P (f ` T))"
   by (metis countable_image_inj_eq subset_image_inj)
 
 lemma all_countable_subset_image_inj:
    "(\<forall>T. countable T \<and> T \<subseteq> f ` S \<longrightarrow> P T) \<longleftrightarrow> (\<forall>T. countable T \<and> T \<subseteq> S \<and> inj_on f T \<longrightarrow>P(f ` T))"
   by (metis countable_image_inj_eq subset_image_inj)
 
 lemma ex_countable_subset_image:
    "(\<exists>T. countable T \<and> T \<subseteq> f ` S \<and> P T) \<longleftrightarrow> (\<exists>T. countable T \<and> T \<subseteq> S \<and> P (f ` T))"
   by (metis countable_subset_image)
 
 lemma all_countable_subset_image:
    "(\<forall>T. countable T \<and> T \<subseteq> f ` S \<longrightarrow> P T) \<longleftrightarrow> (\<forall>T. countable T \<and> T \<subseteq> S \<longrightarrow> P(f ` T))"
   by (metis countable_subset_image)
 
 lemma countable_image_eq:
    "countable(f ` S) \<longleftrightarrow> (\<exists>T. countable T \<and> T \<subseteq> S \<and> f ` S = f ` T)"
   by (metis countable_image countable_image_inj_eq order_refl subset_image_inj)
 
 lemma countable_image_eq_inj:
    "countable(f ` S) \<longleftrightarrow> (\<exists>T. countable T \<and> T \<subseteq> S \<and> f ` S = f ` T \<and> inj_on f T)"
   by (metis countable_image_inj_eq order_refl subset_image_inj)
 
 lemma infinite_countable_subset':
   assumes X: "infinite X" shows "\<exists>C\<subseteq>X. countable C \<and> infinite C"
 proof -
   obtain f :: "nat \<Rightarrow> 'a" where "inj f" "range f \<subseteq> X"
     using infinite_countable_subset [OF X] by blast
   then show ?thesis
     by (intro exI[of _ "range f"]) (auto simp: range_inj_infinite)
 qed
 
 lemma countable_all:
   assumes S: "countable S"
   shows "(\<forall>s\<in>S. P s) \<longleftrightarrow> (\<forall>n::nat. from_nat_into S n \<in> S \<longrightarrow> P (from_nat_into S n))"
   using S[THEN subset_range_from_nat_into] by auto
 
 lemma finite_sequence_to_countable_set:
   assumes "countable X"
   obtains F where "\<And>i. F i \<subseteq> X" "\<And>i. F i \<subseteq> F (Suc i)" "\<And>i. finite (F i)" "(\<Union>i. F i) = X"
 proof -
   show thesis
     apply (rule that[of "\<lambda>i. if X = {} then {} else from_nat_into X ` {..i}"])
        apply (auto simp add: image_iff intro: from_nat_into split: if_splits)
     using assms from_nat_into_surj by (fastforce cong: image_cong)
 qed
 
 lemma transfer_countable[transfer_rule]:
   "bi_unique R \<Longrightarrow> rel_fun (rel_set R) (=) countable countable"
   by (rule rel_funI, erule (1) bi_unique_rel_set_lemma)
      (auto dest: countable_image_inj_on)
 
 subsection \<open>Uncountable\<close>
 
 abbreviation uncountable where
   "uncountable A \<equiv> \<not> countable A"
 
 lemma uncountable_def: "uncountable A \<longleftrightarrow> A \<noteq> {} \<and> \<not> (\<exists>f::(nat \<Rightarrow> 'a). range f = A)"
   by (auto intro: inj_on_inv_into simp: countable_def)
      (metis all_not_in_conv inj_on_iff_surj subset_UNIV)
 
 lemma uncountable_bij_betw: "bij_betw f A B \<Longrightarrow> uncountable B \<Longrightarrow> uncountable A"
   unfolding bij_betw_def by (metis countable_image)
 
 lemma uncountable_infinite: "uncountable A \<Longrightarrow> infinite A"
   by (metis countable_finite)
 
 lemma uncountable_minus_countable:
   "uncountable A \<Longrightarrow> countable B \<Longrightarrow> uncountable (A - B)"
   using countable_Un[of B "A - B"] by auto
 
 lemma countable_Diff_eq [simp]: "countable (A - {x}) = countable A"
   by (meson countable_Diff countable_empty countable_insert uncountable_minus_countable)
 
 text \<open>Every infinite set can be covered by a pairwise disjoint family of infinite sets.
       This version doesn't achieve equality, as it only covers a countable subset\<close>
 lemma infinite_infinite_partition:
   assumes "infinite A"
   obtains C :: "nat \<Rightarrow> 'a set" 
     where "pairwise (\<lambda>i j. disjnt (C i) (C j)) UNIV" "(\<Union>i. C i) \<subseteq> A" "\<And>i. infinite (C i)"
 proof -
   obtain f :: "nat\<Rightarrow>'a" where "range f \<subseteq> A" "inj f"
     using assms infinite_countable_subset by blast
   let ?C = "\<lambda>i. range (\<lambda>j. f (prod_encode (i,j)))"
   show thesis
   proof
     show "pairwise (\<lambda>i j. disjnt (?C i) (?C j)) UNIV"
       by (auto simp: pairwise_def disjnt_def inj_on_eq_iff [OF \<open>inj f\<close>] inj_on_eq_iff [OF inj_prod_encode, of _ UNIV])
     show "(\<Union>i. ?C i) \<subseteq> A"
       using \<open>range f \<subseteq> A\<close> by blast
     have "infinite (range (\<lambda>j. f (prod_encode (i, j))))" for i
       by (rule range_inj_infinite) (meson Pair_inject \<open>inj f\<close> inj_def prod_encode_eq)
     then show "\<And>i. infinite (?C i)"
       using that by auto
   qed
 qed
 
 end
diff --git a/src/HOL/Library/Product_Order.thy b/src/HOL/Library/Product_Order.thy
--- a/src/HOL/Library/Product_Order.thy
+++ b/src/HOL/Library/Product_Order.thy
@@ -1,310 +1,313 @@
 (*  Title:      HOL/Library/Product_Order.thy
     Author:     Brian Huffman
 *)
 
 section \<open>Pointwise order on product types\<close>
 
 theory Product_Order
 imports Product_Plus
 begin
 
 subsection \<open>Pointwise ordering\<close>
 
 instantiation prod :: (ord, ord) ord
 begin
 
 definition
   "x \<le> y \<longleftrightarrow> fst x \<le> fst y \<and> snd x \<le> snd y"
 
 definition
   "(x::'a \<times> 'b) < y \<longleftrightarrow> x \<le> y \<and> \<not> y \<le> x"
 
 instance ..
 
 end
 
 lemma fst_mono: "x \<le> y \<Longrightarrow> fst x \<le> fst y"
   unfolding less_eq_prod_def by simp
 
 lemma snd_mono: "x \<le> y \<Longrightarrow> snd x \<le> snd y"
   unfolding less_eq_prod_def by simp
 
 lemma Pair_mono: "x \<le> x' \<Longrightarrow> y \<le> y' \<Longrightarrow> (x, y) \<le> (x', y')"
   unfolding less_eq_prod_def by simp
 
 lemma Pair_le [simp]: "(a, b) \<le> (c, d) \<longleftrightarrow> a \<le> c \<and> b \<le> d"
   unfolding less_eq_prod_def by simp
 
+lemma atLeastAtMost_prod_eq: "{a..b} = {fst a..fst b} \<times> {snd a..snd b}"
+  by (auto simp: less_eq_prod_def)
+
 instance prod :: (preorder, preorder) preorder
 proof
   fix x y z :: "'a \<times> 'b"
   show "x < y \<longleftrightarrow> x \<le> y \<and> \<not> y \<le> x"
     by (rule less_prod_def)
   show "x \<le> x"
     unfolding less_eq_prod_def
     by fast
   assume "x \<le> y" and "y \<le> z" thus "x \<le> z"
     unfolding less_eq_prod_def
     by (fast elim: order_trans)
 qed
 
 instance prod :: (order, order) order
   by standard auto
 
 
 subsection \<open>Binary infimum and supremum\<close>
 
 instantiation prod :: (inf, inf) inf
 begin
 
 definition "inf x y = (inf (fst x) (fst y), inf (snd x) (snd y))"
 
 lemma inf_Pair_Pair [simp]: "inf (a, b) (c, d) = (inf a c, inf b d)"
   unfolding inf_prod_def by simp
 
 lemma fst_inf [simp]: "fst (inf x y) = inf (fst x) (fst y)"
   unfolding inf_prod_def by simp
 
 lemma snd_inf [simp]: "snd (inf x y) = inf (snd x) (snd y)"
   unfolding inf_prod_def by simp
 
 instance ..
 
 end
 
 instance prod :: (semilattice_inf, semilattice_inf) semilattice_inf
   by standard auto
 
 
 instantiation prod :: (sup, sup) sup
 begin
 
 definition
   "sup x y = (sup (fst x) (fst y), sup (snd x) (snd y))"
 
 lemma sup_Pair_Pair [simp]: "sup (a, b) (c, d) = (sup a c, sup b d)"
   unfolding sup_prod_def by simp
 
 lemma fst_sup [simp]: "fst (sup x y) = sup (fst x) (fst y)"
   unfolding sup_prod_def by simp
 
 lemma snd_sup [simp]: "snd (sup x y) = sup (snd x) (snd y)"
   unfolding sup_prod_def by simp
 
 instance ..
 
 end
 
 instance prod :: (semilattice_sup, semilattice_sup) semilattice_sup
   by standard auto
 
 instance prod :: (lattice, lattice) lattice ..
 
 instance prod :: (distrib_lattice, distrib_lattice) distrib_lattice
   by standard (auto simp add: sup_inf_distrib1)
 
 
 subsection \<open>Top and bottom elements\<close>
 
 instantiation prod :: (top, top) top
 begin
 
 definition
   "top = (top, top)"
 
 instance ..
 
 end
 
 lemma fst_top [simp]: "fst top = top"
   unfolding top_prod_def by simp
 
 lemma snd_top [simp]: "snd top = top"
   unfolding top_prod_def by simp
 
 lemma Pair_top_top: "(top, top) = top"
   unfolding top_prod_def by simp
 
 instance prod :: (order_top, order_top) order_top
   by standard (auto simp add: top_prod_def)
 
 instantiation prod :: (bot, bot) bot
 begin
 
 definition
   "bot = (bot, bot)"
 
 instance ..
 
 end
 
 lemma fst_bot [simp]: "fst bot = bot"
   unfolding bot_prod_def by simp
 
 lemma snd_bot [simp]: "snd bot = bot"
   unfolding bot_prod_def by simp
 
 lemma Pair_bot_bot: "(bot, bot) = bot"
   unfolding bot_prod_def by simp
 
 instance prod :: (order_bot, order_bot) order_bot
   by standard (auto simp add: bot_prod_def)
 
 instance prod :: (bounded_lattice, bounded_lattice) bounded_lattice ..
 
 instance prod :: (boolean_algebra, boolean_algebra) boolean_algebra
   by standard (auto simp add: prod_eqI diff_eq)
 
 
 subsection \<open>Complete lattice operations\<close>
 
 instantiation prod :: (Inf, Inf) Inf
 begin
 
 definition "Inf A = (INF x\<in>A. fst x, INF x\<in>A. snd x)"
 
 instance ..
 
 end
 
 instantiation prod :: (Sup, Sup) Sup
 begin
 
 definition "Sup A = (SUP x\<in>A. fst x, SUP x\<in>A. snd x)"
 
 instance ..
 
 end
 
 instance prod :: (conditionally_complete_lattice, conditionally_complete_lattice)
     conditionally_complete_lattice
   by standard (force simp: less_eq_prod_def Inf_prod_def Sup_prod_def bdd_below_def bdd_above_def
     intro!: cInf_lower cSup_upper cInf_greatest cSup_least)+
 
 instance prod :: (complete_lattice, complete_lattice) complete_lattice
   by standard (simp_all add: less_eq_prod_def Inf_prod_def Sup_prod_def
     INF_lower SUP_upper le_INF_iff SUP_le_iff bot_prod_def top_prod_def)
 
 lemma fst_Inf: "fst (Inf A) = (INF x\<in>A. fst x)"
   by (simp add: Inf_prod_def)
 
 lemma fst_INF: "fst (INF x\<in>A. f x) = (INF x\<in>A. fst (f x))"
   by (simp add: fst_Inf image_image)
 
 lemma fst_Sup: "fst (Sup A) = (SUP x\<in>A. fst x)"
   by (simp add: Sup_prod_def)
 
 lemma fst_SUP: "fst (SUP x\<in>A. f x) = (SUP x\<in>A. fst (f x))"
   by (simp add: fst_Sup image_image)
 
 lemma snd_Inf: "snd (Inf A) = (INF x\<in>A. snd x)"
   by (simp add: Inf_prod_def)
 
 lemma snd_INF: "snd (INF x\<in>A. f x) = (INF x\<in>A. snd (f x))"
   by (simp add: snd_Inf image_image)
 
 lemma snd_Sup: "snd (Sup A) = (SUP x\<in>A. snd x)"
   by (simp add: Sup_prod_def)
 
 lemma snd_SUP: "snd (SUP x\<in>A. f x) = (SUP x\<in>A. snd (f x))"
   by (simp add: snd_Sup image_image)
 
 lemma INF_Pair: "(INF x\<in>A. (f x, g x)) = (INF x\<in>A. f x, INF x\<in>A. g x)"
   by (simp add: Inf_prod_def image_image)
 
 lemma SUP_Pair: "(SUP x\<in>A. (f x, g x)) = (SUP x\<in>A. f x, SUP x\<in>A. g x)"
   by (simp add: Sup_prod_def image_image)
 
 
 text \<open>Alternative formulations for set infima and suprema over the product
 of two complete lattices:\<close>
 
 lemma INF_prod_alt_def: \<^marker>\<open>contributor \<open>Alessandro Coglio\<close>\<close>
   "Inf (f ` A) = (Inf ((fst \<circ> f) ` A), Inf ((snd \<circ> f) ` A))"
   by (simp add: Inf_prod_def image_image)
 
 lemma SUP_prod_alt_def: \<^marker>\<open>contributor \<open>Alessandro Coglio\<close>\<close>
   "Sup (f ` A) = (Sup ((fst \<circ> f) ` A), Sup((snd \<circ> f) ` A))"
   by (simp add: Sup_prod_def image_image)
 
 
 subsection \<open>Complete distributive lattices\<close>
 
 instance prod :: (complete_distrib_lattice, complete_distrib_lattice) complete_distrib_lattice \<^marker>\<open>contributor \<open>Alessandro Coglio\<close>\<close>
 proof
   fix A::"('a\<times>'b) set set"
   show "Inf (Sup ` A) \<le> Sup (Inf ` {f ` A |f. \<forall>Y\<in>A. f Y \<in> Y})"
     by (simp add: Inf_prod_def Sup_prod_def INF_SUP_set image_image)
 qed
 
 subsection \<open>Bekic's Theorem\<close>
 text \<open>
   Simultaneous fixed points over pairs can be written in terms of separate fixed points.
   Transliterated from HOLCF.Fix by Peter Gammie
 \<close>
 
 lemma lfp_prod:
   fixes F :: "'a::complete_lattice \<times> 'b::complete_lattice \<Rightarrow> 'a \<times> 'b"
   assumes "mono F"
   shows "lfp F = (lfp (\<lambda>x. fst (F (x, lfp (\<lambda>y. snd (F (x, y)))))),
                  (lfp (\<lambda>y. snd (F (lfp (\<lambda>x. fst (F (x, lfp (\<lambda>y. snd (F (x, y)))))), y)))))"
   (is "lfp F = (?x, ?y)")
 proof(rule lfp_eqI[OF assms])
   have 1: "fst (F (?x, ?y)) = ?x"
     by (rule trans [symmetric, OF lfp_unfold])
        (blast intro!: monoI monoD[OF assms(1)] fst_mono snd_mono Pair_mono lfp_mono)+
   have 2: "snd (F (?x, ?y)) = ?y"
     by (rule trans [symmetric, OF lfp_unfold])
        (blast intro!: monoI monoD[OF assms(1)] fst_mono snd_mono Pair_mono lfp_mono)+
   from 1 2 show "F (?x, ?y) = (?x, ?y)" by (simp add: prod_eq_iff)
 next
   fix z assume F_z: "F z = z"
   obtain x y where z: "z = (x, y)" by (rule prod.exhaust)
   from F_z z have F_x: "fst (F (x, y)) = x" by simp
   from F_z z have F_y: "snd (F (x, y)) = y" by simp
   let ?y1 = "lfp (\<lambda>y. snd (F (x, y)))"
   have "?y1 \<le> y" by (rule lfp_lowerbound, simp add: F_y)
   hence "fst (F (x, ?y1)) \<le> fst (F (x, y))"
     by (simp add: assms fst_mono monoD)
   hence "fst (F (x, ?y1)) \<le> x" using F_x by simp
   hence 1: "?x \<le> x" by (simp add: lfp_lowerbound)
   hence "snd (F (?x, y)) \<le> snd (F (x, y))"
     by (simp add: assms snd_mono monoD)
   hence "snd (F (?x, y)) \<le> y" using F_y by simp
   hence 2: "?y \<le> y" by (simp add: lfp_lowerbound)
   show "(?x, ?y) \<le> z" using z 1 2 by simp
 qed
 
 lemma gfp_prod:
   fixes F :: "'a::complete_lattice \<times> 'b::complete_lattice \<Rightarrow> 'a \<times> 'b"
   assumes "mono F"
   shows "gfp F = (gfp (\<lambda>x. fst (F (x, gfp (\<lambda>y. snd (F (x, y)))))),
                  (gfp (\<lambda>y. snd (F (gfp (\<lambda>x. fst (F (x, gfp (\<lambda>y. snd (F (x, y)))))), y)))))"
   (is "gfp F = (?x, ?y)")
 proof(rule gfp_eqI[OF assms])
   have 1: "fst (F (?x, ?y)) = ?x"
     by (rule trans [symmetric, OF gfp_unfold])
        (blast intro!: monoI monoD[OF assms(1)] fst_mono snd_mono Pair_mono gfp_mono)+
   have 2: "snd (F (?x, ?y)) = ?y"
     by (rule trans [symmetric, OF gfp_unfold])
        (blast intro!: monoI monoD[OF assms(1)] fst_mono snd_mono Pair_mono gfp_mono)+
   from 1 2 show "F (?x, ?y) = (?x, ?y)" by (simp add: prod_eq_iff)
 next
   fix z assume F_z: "F z = z"
   obtain x y where z: "z = (x, y)" by (rule prod.exhaust)
   from F_z z have F_x: "fst (F (x, y)) = x" by simp
   from F_z z have F_y: "snd (F (x, y)) = y" by simp
   let ?y1 = "gfp (\<lambda>y. snd (F (x, y)))"
   have "y \<le> ?y1" by (rule gfp_upperbound, simp add: F_y)
   hence "fst (F (x, y)) \<le> fst (F (x, ?y1))"
     by (simp add: assms fst_mono monoD)
   hence "x \<le> fst (F (x, ?y1))" using F_x by simp
   hence 1: "x \<le> ?x" by (simp add: gfp_upperbound)
   hence "snd (F (x, y)) \<le> snd (F (?x, y))"
     by (simp add: assms snd_mono monoD)
   hence "y \<le> snd (F (?x, y))" using F_y by simp
   hence 2: "y \<le> ?y" by (simp add: gfp_upperbound)
   show "z \<le> (?x, ?y)" using z 1 2 by simp
 qed
 
 end
diff --git a/src/HOL/Power.thy b/src/HOL/Power.thy
--- a/src/HOL/Power.thy
+++ b/src/HOL/Power.thy
@@ -1,1016 +1,1027 @@
 (*  Title:      HOL/Power.thy
     Author:     Lawrence C Paulson, Cambridge University Computer Laboratory
     Copyright   1997  University of Cambridge
 *)
 
 section \<open>Exponentiation\<close>
 
 theory Power
   imports Num
 begin
 
 subsection \<open>Powers for Arbitrary Monoids\<close>
 
 class power = one + times
 begin
 
 primrec power :: "'a \<Rightarrow> nat \<Rightarrow> 'a"  (infixr "^" 80)
   where
     power_0: "a ^ 0 = 1"
   | power_Suc: "a ^ Suc n = a * a ^ n"
 
 notation (latex output)
   power ("(_\<^bsup>_\<^esup>)" [1000] 1000)
 
 text \<open>Special syntax for squares.\<close>
 abbreviation power2 :: "'a \<Rightarrow> 'a"  ("(_\<^sup>2)" [1000] 999)
   where "x\<^sup>2 \<equiv> x ^ 2"
 
 end
 
 context
   includes lifting_syntax
 begin
 
 lemma power_transfer [transfer_rule]:
   \<open>(R ===> (=) ===> R) (^) (^)\<close>
     if [transfer_rule]: \<open>R 1 1\<close>
       \<open>(R ===> R ===> R) (*) (*)\<close>
     for R :: \<open>'a::power \<Rightarrow> 'b::power \<Rightarrow> bool\<close>
   by (simp only: power_def [abs_def]) transfer_prover
 
 end
 
 context monoid_mult
 begin
 
 subclass power .
 
 lemma power_one [simp]: "1 ^ n = 1"
   by (induct n) simp_all
 
 lemma power_one_right [simp]: "a ^ 1 = a"
   by simp
 
 lemma power_Suc0_right [simp]: "a ^ Suc 0 = a"
   by simp
 
 lemma power_commutes: "a ^ n * a = a * a ^ n"
   by (induct n) (simp_all add: mult.assoc)
 
 lemma power_Suc2: "a ^ Suc n = a ^ n * a"
   by (simp add: power_commutes)
 
 lemma power_add: "a ^ (m + n) = a ^ m * a ^ n"
   by (induct m) (simp_all add: algebra_simps)
 
 lemma power_mult: "a ^ (m * n) = (a ^ m) ^ n"
   by (induct n) (simp_all add: power_add)
 
 lemma power_even_eq: "a ^ (2 * n) = (a ^ n)\<^sup>2"
   by (subst mult.commute) (simp add: power_mult)
 
 lemma power_odd_eq: "a ^ Suc (2*n) = a * (a ^ n)\<^sup>2"
   by (simp add: power_even_eq)
 
 lemma power_numeral_even: "z ^ numeral (Num.Bit0 w) = (let w = z ^ (numeral w) in w * w)"
   by (simp only: numeral_Bit0 power_add Let_def)
 
 lemma power_numeral_odd: "z ^ numeral (Num.Bit1 w) = (let w = z ^ (numeral w) in z * w * w)"
   by (simp only: numeral_Bit1 One_nat_def add_Suc_right add_0_right
       power_Suc power_add Let_def mult.assoc)
 
 lemma power2_eq_square: "a\<^sup>2 = a * a"
   by (simp add: numeral_2_eq_2)
 
 lemma power3_eq_cube: "a ^ 3 = a * a * a"
   by (simp add: numeral_3_eq_3 mult.assoc)
 
 lemma power4_eq_xxxx: "x^4 = x * x * x * x"
   by (simp add: mult.assoc power_numeral_even)
 
 lemma funpow_times_power: "(times x ^^ f x) = times (x ^ f x)"
 proof (induct "f x" arbitrary: f)
   case 0
   then show ?case by (simp add: fun_eq_iff)
 next
   case (Suc n)
   define g where "g x = f x - 1" for x
   with Suc have "n = g x" by simp
   with Suc have "times x ^^ g x = times (x ^ g x)" by simp
   moreover from Suc g_def have "f x = g x + 1" by simp
   ultimately show ?case
     by (simp add: power_add funpow_add fun_eq_iff mult.assoc)
 qed
 
 lemma power_commuting_commutes:
   assumes "x * y = y * x"
   shows "x ^ n * y = y * x ^n"
 proof (induct n)
   case 0
   then show ?case by simp
 next
   case (Suc n)
   have "x ^ Suc n * y = x ^ n * y * x"
     by (subst power_Suc2) (simp add: assms ac_simps)
   also have "\<dots> = y * x ^ Suc n"
     by (simp only: Suc power_Suc2) (simp add: ac_simps)
   finally show ?case .
 qed
 
 lemma power_minus_mult: "0 < n \<Longrightarrow> a ^ (n - 1) * a = a ^ n"
   by (simp add: power_commutes split: nat_diff_split)
 
 lemma left_right_inverse_power:
   assumes "x * y = 1"
   shows   "x ^ n * y ^ n = 1"
 proof (induct n)
   case (Suc n)
   moreover have "x ^ Suc n * y ^ Suc n = x^n * (x * y) * y^n"
     by (simp add: power_Suc2[symmetric] mult.assoc[symmetric])
   ultimately show ?case by (simp add: assms)
 qed simp
 
 end
 
 context comm_monoid_mult
 begin
 
 lemma power_mult_distrib [algebra_simps, algebra_split_simps, field_simps, field_split_simps, divide_simps]:
   "(a * b) ^ n = (a ^ n) * (b ^ n)"
   by (induction n) (simp_all add: ac_simps)
 
 end
 
 text \<open>Extract constant factors from powers.\<close>
 declare power_mult_distrib [where a = "numeral w" for w, simp]
 declare power_mult_distrib [where b = "numeral w" for w, simp]
 
 lemma power_add_numeral [simp]: "a^numeral m * a^numeral n = a^numeral (m + n)"
   for a :: "'a::monoid_mult"
   by (simp add: power_add [symmetric])
 
 lemma power_add_numeral2 [simp]: "a^numeral m * (a^numeral n * b) = a^numeral (m + n) * b"
   for a :: "'a::monoid_mult"
   by (simp add: mult.assoc [symmetric])
 
 lemma power_mult_numeral [simp]: "(a^numeral m)^numeral n = a^numeral (m * n)"
   for a :: "'a::monoid_mult"
   by (simp only: numeral_mult power_mult)
 
 context semiring_numeral
 begin
 
 lemma numeral_sqr: "numeral (Num.sqr k) = numeral k * numeral k"
   by (simp only: sqr_conv_mult numeral_mult)
 
 lemma numeral_pow: "numeral (Num.pow k l) = numeral k ^ numeral l"
   by (induct l)
     (simp_all only: numeral_class.numeral.simps pow.simps
       numeral_sqr numeral_mult power_add power_one_right)
 
 lemma power_numeral [simp]: "numeral k ^ numeral l = numeral (Num.pow k l)"
   by (rule numeral_pow [symmetric])
 
 end
 
 context semiring_1
 begin
 
 lemma of_nat_power [simp]: "of_nat (m ^ n) = of_nat m ^ n"
   by (induct n) simp_all
 
 lemma zero_power: "0 < n \<Longrightarrow> 0 ^ n = 0"
   by (cases n) simp_all
 
 lemma power_zero_numeral [simp]: "0 ^ numeral k = 0"
   by (simp add: numeral_eq_Suc)
 
 lemma zero_power2: "0\<^sup>2 = 0" (* delete? *)
   by (rule power_zero_numeral)
 
 lemma one_power2: "1\<^sup>2 = 1" (* delete? *)
   by (rule power_one)
 
 lemma power_0_Suc [simp]: "0 ^ Suc n = 0"
   by simp
 
 text \<open>It looks plausible as a simprule, but its effect can be strange.\<close>
 lemma power_0_left: "0 ^ n = (if n = 0 then 1 else 0)"
   by (cases n) simp_all
 
 end
 
 context semiring_char_0 begin
 
 lemma numeral_power_eq_of_nat_cancel_iff [simp]:
   "numeral x ^ n = of_nat y \<longleftrightarrow> numeral x ^ n = y"
   using of_nat_eq_iff by fastforce
 
 lemma real_of_nat_eq_numeral_power_cancel_iff [simp]:
   "of_nat y = numeral x ^ n \<longleftrightarrow> y = numeral x ^ n"
   using numeral_power_eq_of_nat_cancel_iff [of x n y] by (metis (mono_tags))
 
 lemma of_nat_eq_of_nat_power_cancel_iff[simp]: "(of_nat b) ^ w = of_nat x \<longleftrightarrow> b ^ w = x"
   by (metis of_nat_power of_nat_eq_iff)
 
 lemma of_nat_power_eq_of_nat_cancel_iff[simp]: "of_nat x = (of_nat b) ^ w \<longleftrightarrow> x = b ^ w"
   by (metis of_nat_eq_of_nat_power_cancel_iff)
 
 end
 
 context comm_semiring_1
 begin
 
 text \<open>The divides relation.\<close>
 
 lemma le_imp_power_dvd:
   assumes "m \<le> n"
   shows "a ^ m dvd a ^ n"
 proof
   from assms have "a ^ n = a ^ (m + (n - m))" by simp
   also have "\<dots> = a ^ m * a ^ (n - m)" by (rule power_add)
   finally show "a ^ n = a ^ m * a ^ (n - m)" .
 qed
 
 lemma power_le_dvd: "a ^ n dvd b \<Longrightarrow> m \<le> n \<Longrightarrow> a ^ m dvd b"
   by (rule dvd_trans [OF le_imp_power_dvd])
 
 lemma dvd_power_same: "x dvd y \<Longrightarrow> x ^ n dvd y ^ n"
   by (induct n) (auto simp add: mult_dvd_mono)
 
 lemma dvd_power_le: "x dvd y \<Longrightarrow> m \<ge> n \<Longrightarrow> x ^ n dvd y ^ m"
   by (rule power_le_dvd [OF dvd_power_same])
 
 lemma dvd_power [simp]:
   fixes n :: nat
   assumes "n > 0 \<or> x = 1"
   shows "x dvd (x ^ n)"
   using assms
 proof
   assume "0 < n"
   then have "x ^ n = x ^ Suc (n - 1)" by simp
   then show "x dvd (x ^ n)" by simp
 next
   assume "x = 1"
   then show "x dvd (x ^ n)" by simp
 qed
 
 end
 
 context semiring_1_no_zero_divisors
 begin
 
 subclass power .
 
 lemma power_eq_0_iff [simp]: "a ^ n = 0 \<longleftrightarrow> a = 0 \<and> n > 0"
   by (induct n) auto
 
 lemma power_not_zero: "a \<noteq> 0 \<Longrightarrow> a ^ n \<noteq> 0"
   by (induct n) auto
 
 lemma zero_eq_power2 [simp]: "a\<^sup>2 = 0 \<longleftrightarrow> a = 0"
   unfolding power2_eq_square by simp
 
 end
 
 context ring_1
 begin
 
 lemma power_minus: "(- a) ^ n = (- 1) ^ n * a ^ n"
 proof (induct n)
   case 0
   show ?case by simp
 next
   case (Suc n)
   then show ?case
     by (simp del: power_Suc add: power_Suc2 mult.assoc)
 qed
 
 lemma power_minus': "NO_MATCH 1 x \<Longrightarrow> (-x) ^ n = (-1)^n * x ^ n"
   by (rule power_minus)
 
 lemma power_minus_Bit0: "(- x) ^ numeral (Num.Bit0 k) = x ^ numeral (Num.Bit0 k)"
   by (induct k, simp_all only: numeral_class.numeral.simps power_add
     power_one_right mult_minus_left mult_minus_right minus_minus)
 
 lemma power_minus_Bit1: "(- x) ^ numeral (Num.Bit1 k) = - (x ^ numeral (Num.Bit1 k))"
   by (simp only: eval_nat_numeral(3) power_Suc power_minus_Bit0 mult_minus_left)
 
 lemma power2_minus [simp]: "(- a)\<^sup>2 = a\<^sup>2"
   by (fact power_minus_Bit0)
 
 lemma power_minus1_even [simp]: "(- 1) ^ (2*n) = 1"
 proof (induct n)
   case 0
   show ?case by simp
 next
   case (Suc n)
   then show ?case by (simp add: power_add power2_eq_square)
 qed
 
 lemma power_minus1_odd: "(- 1) ^ Suc (2*n) = -1"
   by simp
 
 lemma power_minus_even [simp]: "(-a) ^ (2*n) = a ^ (2*n)"
   by (simp add: power_minus [of a])
 
 end
 
 context ring_1_no_zero_divisors
 begin
 
 lemma power2_eq_1_iff: "a\<^sup>2 = 1 \<longleftrightarrow> a = 1 \<or> a = - 1"
   using square_eq_1_iff [of a] by (simp add: power2_eq_square)
 
 end
 
 context idom
 begin
 
 lemma power2_eq_iff: "x\<^sup>2 = y\<^sup>2 \<longleftrightarrow> x = y \<or> x = - y"
   unfolding power2_eq_square by (rule square_eq_iff)
 
 end
 
 context semidom_divide
 begin
 
 lemma power_diff:
   "a ^ (m - n) = (a ^ m) div (a ^ n)" if "a \<noteq> 0" and "n \<le> m"
 proof -
   define q where "q = m - n"
   with \<open>n \<le> m\<close> have "m = q + n" by simp
   with \<open>a \<noteq> 0\<close> q_def show ?thesis
     by (simp add: power_add)
 qed
 
 end
 
 context algebraic_semidom
 begin
 
 lemma div_power: "b dvd a \<Longrightarrow> (a div b) ^ n = a ^ n div b ^ n"
   by (induct n) (simp_all add: div_mult_div_if_dvd dvd_power_same)
 
 lemma is_unit_power_iff: "is_unit (a ^ n) \<longleftrightarrow> is_unit a \<or> n = 0"
   by (induct n) (auto simp add: is_unit_mult_iff)
 
 lemma dvd_power_iff:
   assumes "x \<noteq> 0"
   shows   "x ^ m dvd x ^ n \<longleftrightarrow> is_unit x \<or> m \<le> n"
 proof
   assume *: "x ^ m dvd x ^ n"
   {
     assume "m > n"
     note *
     also have "x ^ n = x ^ n * 1" by simp
     also from \<open>m > n\<close> have "m = n + (m - n)" by simp
     also have "x ^ \<dots> = x ^ n * x ^ (m - n)" by (rule power_add)
     finally have "x ^ (m - n) dvd 1"
       using assms by (subst (asm) dvd_times_left_cancel_iff) simp_all
     with \<open>m > n\<close> have "is_unit x" by (simp add: is_unit_power_iff)
   }
   thus "is_unit x \<or> m \<le> n" by force
 qed (auto intro: unit_imp_dvd simp: is_unit_power_iff le_imp_power_dvd)
 
 
 end
 
 context normalization_semidom_multiplicative
 begin
 
 lemma normalize_power: "normalize (a ^ n) = normalize a ^ n"
   by (induct n) (simp_all add: normalize_mult)
 
 lemma unit_factor_power: "unit_factor (a ^ n) = unit_factor a ^ n"
   by (induct n) (simp_all add: unit_factor_mult)
 
 end
 
 context division_ring
 begin
 
 text \<open>Perhaps these should be simprules.\<close>
 lemma power_inverse [field_simps, field_split_simps, divide_simps]: "inverse a ^ n = inverse (a ^ n)"
 proof (cases "a = 0")
   case True
   then show ?thesis by (simp add: power_0_left)
 next
   case False
   then have "inverse (a ^ n) = inverse a ^ n"
     by (induct n) (simp_all add: nonzero_inverse_mult_distrib power_commutes)
   then show ?thesis by simp
 qed
 
 lemma power_one_over [field_simps, field_split_simps, divide_simps]: "(1 / a) ^ n = 1 / a ^ n"
   using power_inverse [of a] by (simp add: divide_inverse)
 
 end
 
 context field
 begin
 
 lemma power_divide [field_simps, field_split_simps, divide_simps]: "(a / b) ^ n = a ^ n / b ^ n"
   by (induct n) simp_all
 
 end
 
 
 subsection \<open>Exponentiation on ordered types\<close>
 
 context linordered_semidom
 begin
 
 lemma zero_less_power [simp]: "0 < a \<Longrightarrow> 0 < a ^ n"
   by (induct n) simp_all
 
 lemma zero_le_power [simp]: "0 \<le> a \<Longrightarrow> 0 \<le> a ^ n"
   by (induct n) simp_all
 
 lemma power_mono: "a \<le> b \<Longrightarrow> 0 \<le> a \<Longrightarrow> a ^ n \<le> b ^ n"
   by (induct n) (auto intro: mult_mono order_trans [of 0 a b])
 
 lemma one_le_power [simp]: "1 \<le> a \<Longrightarrow> 1 \<le> a ^ n"
   using power_mono [of 1 a n] by simp
 
 lemma power_le_one: "0 \<le> a \<Longrightarrow> a \<le> 1 \<Longrightarrow> a ^ n \<le> 1"
   using power_mono [of a 1 n] by simp
 
 lemma power_gt1_lemma:
   assumes gt1: "1 < a"
   shows "1 < a * a ^ n"
 proof -
   from gt1 have "0 \<le> a"
     by (fact order_trans [OF zero_le_one less_imp_le])
   from gt1 have "1 * 1 < a * 1" by simp
   also from gt1 have "\<dots> \<le> a * a ^ n"
     by (simp only: mult_mono \<open>0 \<le> a\<close> one_le_power order_less_imp_le zero_le_one order_refl)
   finally show ?thesis by simp
 qed
 
 lemma power_gt1: "1 < a \<Longrightarrow> 1 < a ^ Suc n"
   by (simp add: power_gt1_lemma)
 
 lemma one_less_power [simp]: "1 < a \<Longrightarrow> 0 < n \<Longrightarrow> 1 < a ^ n"
   by (cases n) (simp_all add: power_gt1_lemma)
 
 lemma power_le_imp_le_exp:
   assumes gt1: "1 < a"
   shows "a ^ m \<le> a ^ n \<Longrightarrow> m \<le> n"
 proof (induct m arbitrary: n)
   case 0
   show ?case by simp
 next
   case (Suc m)
   show ?case
   proof (cases n)
     case 0
     with Suc have "a * a ^ m \<le> 1" by simp
     with gt1 show ?thesis
       by (force simp only: power_gt1_lemma not_less [symmetric])
   next
     case (Suc n)
     with Suc.prems Suc.hyps show ?thesis
       by (force dest: mult_left_le_imp_le simp add: less_trans [OF zero_less_one gt1])
   qed
 qed
 
 lemma of_nat_zero_less_power_iff [simp]: "of_nat x ^ n > 0 \<longleftrightarrow> x > 0 \<or> n = 0"
   by (induct n) auto
 
 text \<open>Surely we can strengthen this? It holds for \<open>0<a<1\<close> too.\<close>
 lemma power_inject_exp [simp]:
   \<open>a ^ m = a ^ n \<longleftrightarrow> m = n\<close> if \<open>1 < a\<close>
   using that by (force simp add: order_class.order.antisym power_le_imp_le_exp)
 
 text \<open>
   Can relax the first premise to \<^term>\<open>0<a\<close> in the case of the
   natural numbers.
 \<close>
 lemma power_less_imp_less_exp: "1 < a \<Longrightarrow> a ^ m < a ^ n \<Longrightarrow> m < n"
   by (simp add: order_less_le [of m n] less_le [of "a^m" "a^n"] power_le_imp_le_exp)
                                
 lemma power_strict_mono: "a < b \<Longrightarrow> 0 \<le> a \<Longrightarrow> 0 < n \<Longrightarrow> a ^ n < b ^ n"
 proof (induct n)
   case 0
   then show ?case by simp
 next
   case (Suc n)
   then show ?case
     by (cases "n = 0") (auto simp: mult_strict_mono le_less_trans [of 0 a b])
 qed
 
 lemma power_mono_iff [simp]:
   shows "\<lbrakk>a \<ge> 0; b \<ge> 0; n>0\<rbrakk> \<Longrightarrow> a ^ n \<le> b ^ n \<longleftrightarrow> a \<le> b"
   using power_mono [of a b] power_strict_mono [of b a] not_le by auto
 
 text\<open>Lemma for \<open>power_strict_decreasing\<close>\<close>
 lemma power_Suc_less: "0 < a \<Longrightarrow> a < 1 \<Longrightarrow> a * a ^ n < a ^ n"
   by (induct n) (auto simp: mult_strict_left_mono)
 
 lemma power_strict_decreasing: "n < N \<Longrightarrow> 0 < a \<Longrightarrow> a < 1 \<Longrightarrow> a ^ N < a ^ n"
 proof (induction N)
    case 0
    then show ?case by simp
  next
    case (Suc N)
    then show ?case
      using mult_strict_mono[of a 1 "a ^ N" "a ^ n"]
      by (auto simp add: power_Suc_less less_Suc_eq)
  qed
 
 text \<open>Proof resembles that of \<open>power_strict_decreasing\<close>.\<close>
 lemma power_decreasing: "n \<le> N \<Longrightarrow> 0 \<le> a \<Longrightarrow> a \<le> 1 \<Longrightarrow> a ^ N \<le> a ^ n"
 proof (induction N)
   case 0
   then show ?case by simp
 next
   case (Suc N)
   then show ?case
     using mult_mono[of a 1 "a^N" "a ^ n"]
     by (auto simp add: le_Suc_eq)
 qed
 
 lemma power_decreasing_iff [simp]: "\<lbrakk>0 < b; b < 1\<rbrakk> \<Longrightarrow> b ^ m \<le> b ^ n \<longleftrightarrow> n \<le> m"
   using power_strict_decreasing [of m n b]
   by (auto intro: power_decreasing ccontr)
 
 lemma power_strict_decreasing_iff [simp]: "\<lbrakk>0 < b; b < 1\<rbrakk> \<Longrightarrow> b ^ m < b ^ n \<longleftrightarrow> n < m"
   using power_decreasing_iff [of b m n] unfolding le_less
   by (auto dest: power_strict_decreasing le_neq_implies_less)
 
 lemma power_Suc_less_one: "0 < a \<Longrightarrow> a < 1 \<Longrightarrow> a ^ Suc n < 1"
   using power_strict_decreasing [of 0 "Suc n" a] by simp
 
 text \<open>Proof again resembles that of \<open>power_strict_decreasing\<close>.\<close>
 lemma power_increasing: "n \<le> N \<Longrightarrow> 1 \<le> a \<Longrightarrow> a ^ n \<le> a ^ N"
 proof (induct N)
   case 0
   then show ?case by simp
 next
   case (Suc N)
   then show ?case
     using mult_mono[of 1 a "a ^ n" "a ^ N"]
     by (auto simp add: le_Suc_eq order_trans [OF zero_le_one])
 qed
 
 text \<open>Lemma for \<open>power_strict_increasing\<close>.\<close>
 lemma power_less_power_Suc: "1 < a \<Longrightarrow> a ^ n < a * a ^ n"
   by (induct n) (auto simp: mult_strict_left_mono less_trans [OF zero_less_one])
 
 lemma power_strict_increasing: "n < N \<Longrightarrow> 1 < a \<Longrightarrow> a ^ n < a ^ N"
 proof (induct N)
   case 0
   then show ?case by simp
 next
   case (Suc N)
   then show ?case
     using mult_strict_mono[of 1 a "a^n" "a^N"]
     by (auto simp add: power_less_power_Suc less_Suc_eq less_trans [OF zero_less_one] less_imp_le)
 qed
 
 lemma power_increasing_iff [simp]: "1 < b \<Longrightarrow> b ^ x \<le> b ^ y \<longleftrightarrow> x \<le> y"
   by (blast intro: power_le_imp_le_exp power_increasing less_imp_le)
 
 lemma power_strict_increasing_iff [simp]: "1 < b \<Longrightarrow> b ^ x < b ^ y \<longleftrightarrow> x < y"
   by (blast intro: power_less_imp_less_exp power_strict_increasing)
 
 lemma power_le_imp_le_base:
   assumes le: "a ^ Suc n \<le> b ^ Suc n"
     and "0 \<le> b"
   shows "a \<le> b"
 proof (rule ccontr)
   assume "\<not> ?thesis"
   then have "b < a" by (simp only: linorder_not_le)
   then have "b ^ Suc n < a ^ Suc n"
     by (simp only: assms(2) power_strict_mono)
   with le show False
     by (simp add: linorder_not_less [symmetric])
 qed
 
 lemma power_less_imp_less_base:
   assumes less: "a ^ n < b ^ n"
   assumes nonneg: "0 \<le> b"
   shows "a < b"
 proof (rule contrapos_pp [OF less])
   assume "\<not> ?thesis"
   then have "b \<le> a" by (simp only: linorder_not_less)
   from this nonneg have "b ^ n \<le> a ^ n" by (rule power_mono)
   then show "\<not> a ^ n < b ^ n" by (simp only: linorder_not_less)
 qed
 
 lemma power_inject_base: "a ^ Suc n = b ^ Suc n \<Longrightarrow> 0 \<le> a \<Longrightarrow> 0 \<le> b \<Longrightarrow> a = b"
   by (blast intro: power_le_imp_le_base order.antisym eq_refl sym)
 
 lemma power_eq_imp_eq_base: "a ^ n = b ^ n \<Longrightarrow> 0 \<le> a \<Longrightarrow> 0 \<le> b \<Longrightarrow> 0 < n \<Longrightarrow> a = b"
   by (cases n) (simp_all del: power_Suc, rule power_inject_base)
 
 lemma power_eq_iff_eq_base: "0 < n \<Longrightarrow> 0 \<le> a \<Longrightarrow> 0 \<le> b \<Longrightarrow> a ^ n = b ^ n \<longleftrightarrow> a = b"
   using power_eq_imp_eq_base [of a n b] by auto
 
 lemma power2_le_imp_le: "x\<^sup>2 \<le> y\<^sup>2 \<Longrightarrow> 0 \<le> y \<Longrightarrow> x \<le> y"
   unfolding numeral_2_eq_2 by (rule power_le_imp_le_base)
 
 lemma power2_less_imp_less: "x\<^sup>2 < y\<^sup>2 \<Longrightarrow> 0 \<le> y \<Longrightarrow> x < y"
   by (rule power_less_imp_less_base)
 
 lemma power2_eq_imp_eq: "x\<^sup>2 = y\<^sup>2 \<Longrightarrow> 0 \<le> x \<Longrightarrow> 0 \<le> y \<Longrightarrow> x = y"
   unfolding numeral_2_eq_2 by (erule (2) power_eq_imp_eq_base) simp
 
 lemma power_Suc_le_self: "0 \<le> a \<Longrightarrow> a \<le> 1 \<Longrightarrow> a ^ Suc n \<le> a"
   using power_decreasing [of 1 "Suc n" a] by simp
 
 lemma power2_eq_iff_nonneg [simp]:
   assumes "0 \<le> x" "0 \<le> y"
   shows "(x ^ 2 = y ^ 2) \<longleftrightarrow> x = y"
 using assms power2_eq_imp_eq by blast
 
 lemma of_nat_less_numeral_power_cancel_iff[simp]:
   "of_nat x < numeral i ^ n \<longleftrightarrow> x < numeral i ^ n"
   using of_nat_less_iff[of x "numeral i ^ n", unfolded of_nat_numeral of_nat_power] .
 
 lemma of_nat_le_numeral_power_cancel_iff[simp]:
   "of_nat x \<le> numeral i ^ n \<longleftrightarrow> x \<le> numeral i ^ n"
   using of_nat_le_iff[of x "numeral i ^ n", unfolded of_nat_numeral of_nat_power] .
 
 lemma numeral_power_less_of_nat_cancel_iff[simp]:
   "numeral i ^ n < of_nat x \<longleftrightarrow> numeral i ^ n < x"
   using of_nat_less_iff[of "numeral i ^ n" x, unfolded of_nat_numeral of_nat_power] .
 
 lemma numeral_power_le_of_nat_cancel_iff[simp]:
   "numeral i ^ n \<le> of_nat x \<longleftrightarrow> numeral i ^ n \<le> x"
   using of_nat_le_iff[of "numeral i ^ n" x, unfolded of_nat_numeral of_nat_power] .
 
 lemma of_nat_le_of_nat_power_cancel_iff[simp]: "(of_nat b) ^ w \<le> of_nat x \<longleftrightarrow> b ^ w \<le> x"
   by (metis of_nat_le_iff of_nat_power)
 
 lemma of_nat_power_le_of_nat_cancel_iff[simp]: "of_nat x \<le> (of_nat b) ^ w \<longleftrightarrow> x \<le> b ^ w"
   by (metis of_nat_le_iff of_nat_power)
 
 lemma of_nat_less_of_nat_power_cancel_iff[simp]: "(of_nat b) ^ w < of_nat x \<longleftrightarrow> b ^ w < x"
   by (metis of_nat_less_iff of_nat_power)
 
 lemma of_nat_power_less_of_nat_cancel_iff[simp]: "of_nat x < (of_nat b) ^ w \<longleftrightarrow> x < b ^ w"
   by (metis of_nat_less_iff of_nat_power)
 
+lemma power2_nonneg_ge_1_iff: 
+  assumes "x \<ge> 0"
+  shows   "x ^ 2 \<ge> 1 \<longleftrightarrow> x \<ge> 1"
+  using assms by (auto intro: power2_le_imp_le)
+
+lemma power2_nonneg_gt_1_iff: 
+  assumes "x \<ge> 0"
+  shows   "x ^ 2 > 1 \<longleftrightarrow> x > 1"
+  using assms  by (auto intro: power_less_imp_less_base)
+
 end
 
-
 text \<open>Some @{typ nat}-specific lemmas:\<close>
 
 lemma mono_ge2_power_minus_self:
   assumes "k \<ge> 2" shows "mono (\<lambda>m. k ^ m - m)"
 unfolding mono_iff_le_Suc
 proof
   fix n
   have "k ^ n < k ^ Suc n" using power_strict_increasing_iff[of k "n" "Suc n"] assms by linarith
   thus "k ^ n - n \<le> k ^ Suc n - Suc n" by linarith
 qed
 
 lemma self_le_ge2_pow[simp]:
   assumes "k \<ge> 2" shows "m \<le> k ^ m"
 proof (induction m)
   case 0 show ?case by simp
 next
   case (Suc m)
   hence "Suc m \<le> Suc (k ^ m)" by simp
   also have "... \<le> k^m + k^m" using one_le_power[of k m] assms by linarith
   also have "... \<le> k * k^m" by (metis mult_2 mult_le_mono1[OF assms])
   finally show ?case by simp
 qed
 
 lemma diff_le_diff_pow[simp]:
   assumes "k \<ge> 2" shows "m - n \<le> k ^ m - k ^ n"
 proof (cases "n \<le> m")
   case True
   thus ?thesis
     using monoD[OF mono_ge2_power_minus_self[OF assms] True] self_le_ge2_pow[OF assms, of m]
     by (simp add: le_diff_conv le_diff_conv2)
 qed auto
 
 
 context linordered_ring_strict
 begin
 
 lemma sum_squares_eq_zero_iff: "x * x + y * y = 0 \<longleftrightarrow> x = 0 \<and> y = 0"
   by (simp add: add_nonneg_eq_0_iff)
 
 lemma sum_squares_le_zero_iff: "x * x + y * y \<le> 0 \<longleftrightarrow> x = 0 \<and> y = 0"
   by (simp add: le_less not_sum_squares_lt_zero sum_squares_eq_zero_iff)
 
 lemma sum_squares_gt_zero_iff: "0 < x * x + y * y \<longleftrightarrow> x \<noteq> 0 \<or> y \<noteq> 0"
   by (simp add: not_le [symmetric] sum_squares_le_zero_iff)
 
 end
 
 context linordered_idom
 begin
 
 lemma zero_le_power2 [simp]: "0 \<le> a\<^sup>2"
   by (simp add: power2_eq_square)
 
 lemma zero_less_power2 [simp]: "0 < a\<^sup>2 \<longleftrightarrow> a \<noteq> 0"
   by (force simp add: power2_eq_square zero_less_mult_iff linorder_neq_iff)
 
 lemma power2_less_0 [simp]: "\<not> a\<^sup>2 < 0"
   by (force simp add: power2_eq_square mult_less_0_iff)
 
 lemma power_abs: "\<bar>a ^ n\<bar> = \<bar>a\<bar> ^ n" \<comment> \<open>FIXME simp?\<close>
   by (induct n) (simp_all add: abs_mult)
 
 lemma power_sgn [simp]: "sgn (a ^ n) = sgn a ^ n"
   by (induct n) (simp_all add: sgn_mult)
 
 lemma abs_power_minus [simp]: "\<bar>(- a) ^ n\<bar> = \<bar>a ^ n\<bar>"
   by (simp add: power_abs)
 
 lemma zero_less_power_abs_iff [simp]: "0 < \<bar>a\<bar> ^ n \<longleftrightarrow> a \<noteq> 0 \<or> n = 0"
 proof (induct n)
   case 0
   show ?case by simp
 next
   case Suc
   then show ?case by (auto simp: zero_less_mult_iff)
 qed
 
 lemma zero_le_power_abs [simp]: "0 \<le> \<bar>a\<bar> ^ n"
   by (rule zero_le_power [OF abs_ge_zero])
 
 lemma power2_less_eq_zero_iff [simp]: "a\<^sup>2 \<le> 0 \<longleftrightarrow> a = 0"
   by (simp add: le_less)
 
 lemma abs_power2 [simp]: "\<bar>a\<^sup>2\<bar> = a\<^sup>2"
   by (simp add: power2_eq_square)
 
 lemma power2_abs [simp]: "\<bar>a\<bar>\<^sup>2 = a\<^sup>2"
   by (simp add: power2_eq_square)
 
 lemma odd_power_less_zero: "a < 0 \<Longrightarrow> a ^ Suc (2 * n) < 0"
 proof (induct n)
   case 0
   then show ?case by simp
 next
   case (Suc n)
   have "a ^ Suc (2 * Suc n) = (a*a) * a ^ Suc(2*n)"
     by (simp add: ac_simps power_add power2_eq_square)
   then show ?case
     by (simp del: power_Suc add: Suc mult_less_0_iff mult_neg_neg)
 qed
 
 lemma odd_0_le_power_imp_0_le: "0 \<le> a ^ Suc (2 * n) \<Longrightarrow> 0 \<le> a"
   using odd_power_less_zero [of a n]
   by (force simp add: linorder_not_less [symmetric])
 
 lemma zero_le_even_power'[simp]: "0 \<le> a ^ (2 * n)"
 proof (induct n)
   case 0
   show ?case by simp
 next
   case (Suc n)
   have "a ^ (2 * Suc n) = (a*a) * a ^ (2*n)"
     by (simp add: ac_simps power_add power2_eq_square)
   then show ?case
     by (simp add: Suc zero_le_mult_iff)
 qed
 
 lemma sum_power2_ge_zero: "0 \<le> x\<^sup>2 + y\<^sup>2"
   by (intro add_nonneg_nonneg zero_le_power2)
 
 lemma not_sum_power2_lt_zero: "\<not> x\<^sup>2 + y\<^sup>2 < 0"
   unfolding not_less by (rule sum_power2_ge_zero)
 
 lemma sum_power2_eq_zero_iff: "x\<^sup>2 + y\<^sup>2 = 0 \<longleftrightarrow> x = 0 \<and> y = 0"
   unfolding power2_eq_square by (simp add: add_nonneg_eq_0_iff)
 
 lemma sum_power2_le_zero_iff: "x\<^sup>2 + y\<^sup>2 \<le> 0 \<longleftrightarrow> x = 0 \<and> y = 0"
   by (simp add: le_less sum_power2_eq_zero_iff not_sum_power2_lt_zero)
 
 lemma sum_power2_gt_zero_iff: "0 < x\<^sup>2 + y\<^sup>2 \<longleftrightarrow> x \<noteq> 0 \<or> y \<noteq> 0"
   unfolding not_le [symmetric] by (simp add: sum_power2_le_zero_iff)
 
 lemma abs_le_square_iff: "\<bar>x\<bar> \<le> \<bar>y\<bar> \<longleftrightarrow> x\<^sup>2 \<le> y\<^sup>2"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume ?lhs
   then have "\<bar>x\<bar>\<^sup>2 \<le> \<bar>y\<bar>\<^sup>2" by (rule power_mono) simp
   then show ?rhs by simp
 next
   assume ?rhs
   then show ?lhs
     by (auto intro!: power2_le_imp_le [OF _ abs_ge_zero])
 qed
 
 lemma power2_le_iff_abs_le:
   "y \<ge> 0 \<Longrightarrow> x\<^sup>2 \<le> y\<^sup>2 \<longleftrightarrow> \<bar>x\<bar> \<le> y"
   by (metis abs_le_square_iff abs_of_nonneg)
 
 lemma abs_square_le_1:"x\<^sup>2 \<le> 1 \<longleftrightarrow> \<bar>x\<bar> \<le> 1"
   using abs_le_square_iff [of x 1] by simp
 
 lemma abs_square_eq_1: "x\<^sup>2 = 1 \<longleftrightarrow> \<bar>x\<bar> = 1"
   by (auto simp add: abs_if power2_eq_1_iff)
 
 lemma abs_square_less_1: "x\<^sup>2 < 1 \<longleftrightarrow> \<bar>x\<bar> < 1"
   using  abs_square_eq_1 [of x] abs_square_le_1 [of x] by (auto simp add: le_less)
 
 lemma square_le_1:
   assumes "- 1 \<le> x" "x \<le> 1"
   shows "x\<^sup>2 \<le> 1"
     using assms
     by (metis add.inverse_inverse linear mult_le_one neg_equal_0_iff_equal neg_le_iff_le power2_eq_square power_minus_Bit0)
 
 end
 
-
 subsection \<open>Miscellaneous rules\<close>
 
 lemma (in linordered_semidom) self_le_power: "1 \<le> a \<Longrightarrow> 0 < n \<Longrightarrow> a \<le> a ^ n"
   using power_increasing [of 1 n a] power_one_right [of a] by auto
 
+lemma power2_ge_1_iff: "x ^ 2 \<ge> 1 \<longleftrightarrow> x \<ge> 1 \<or> x \<le> (-1 :: 'a :: linordered_idom)"
+  using abs_le_square_iff[of 1 x] by (auto simp: abs_if split: if_splits)
+
 lemma (in power) power_eq_if: "p ^ m = (if m=0 then 1 else p * (p ^ (m - 1)))"
   unfolding One_nat_def by (cases m) simp_all
 
 lemma (in comm_semiring_1) power2_sum: "(x + y)\<^sup>2 = x\<^sup>2 + y\<^sup>2 + 2 * x * y"
   by (simp add: algebra_simps power2_eq_square mult_2_right)
 
 context comm_ring_1
 begin
 
 lemma power2_diff: "(x - y)\<^sup>2 = x\<^sup>2 + y\<^sup>2 - 2 * x * y"
   by (simp add: algebra_simps power2_eq_square mult_2_right)
 
 lemma power2_commute: "(x - y)\<^sup>2 = (y - x)\<^sup>2"
   by (simp add: algebra_simps power2_eq_square)
 
 lemma minus_power_mult_self: "(- a) ^ n * (- a) ^ n = a ^ (2 * n)"
   by (simp add: power_mult_distrib [symmetric])
     (simp add: power2_eq_square [symmetric] power_mult [symmetric])
 
 lemma minus_one_mult_self [simp]: "(- 1) ^ n * (- 1) ^ n = 1"
   using minus_power_mult_self [of 1 n] by simp
 
 lemma left_minus_one_mult_self [simp]: "(- 1) ^ n * ((- 1) ^ n * a) = a"
   by (simp add: mult.assoc [symmetric])
 
 end
 
 text \<open>Simprules for comparisons where common factors can be cancelled.\<close>
 
 lemmas zero_compare_simps =
   add_strict_increasing add_strict_increasing2 add_increasing
   zero_le_mult_iff zero_le_divide_iff
   zero_less_mult_iff zero_less_divide_iff
   mult_le_0_iff divide_le_0_iff
   mult_less_0_iff divide_less_0_iff
   zero_le_power2 power2_less_0
 
 
 subsection \<open>Exponentiation for the Natural Numbers\<close>
 
 lemma nat_one_le_power [simp]: "Suc 0 \<le> i \<Longrightarrow> Suc 0 \<le> i ^ n"
   by (rule one_le_power [of i n, unfolded One_nat_def])
 
 lemma nat_zero_less_power_iff [simp]: "x ^ n > 0 \<longleftrightarrow> x > 0 \<or> n = 0"
   for x :: nat
   by (induct n) auto
 
 lemma nat_power_eq_Suc_0_iff [simp]: "x ^ m = Suc 0 \<longleftrightarrow> m = 0 \<or> x = Suc 0"
   by (induct m) auto
 
 lemma power_Suc_0 [simp]: "Suc 0 ^ n = Suc 0"
   by simp
 
 text \<open>
   Valid for the naturals, but what if \<open>0 < i < 1\<close>? Premises cannot be
   weakened: consider the case where \<open>i = 0\<close>, \<open>m = 1\<close> and \<open>n = 0\<close>.
 \<close>
 
 lemma nat_power_less_imp_less:
   fixes i :: nat
   assumes nonneg: "0 < i"
   assumes less: "i ^ m < i ^ n"
   shows "m < n"
 proof (cases "i = 1")
   case True
   with less power_one [where 'a = nat] show ?thesis by simp
 next
   case False
   with nonneg have "1 < i" by auto
   from power_strict_increasing_iff [OF this] less show ?thesis ..
 qed
 
 lemma power_gt_expt: "n > Suc 0 \<Longrightarrow> n^k > k"
   by (induction k) (auto simp: less_trans_Suc n_less_m_mult_n)
 
 lemma less_exp [simp]:
   \<open>n < 2 ^ n\<close>
   by (simp add: power_gt_expt)
 
 lemma power_dvd_imp_le:
   fixes i :: nat
   assumes "i ^ m dvd i ^ n" "1 < i"
   shows "m \<le> n"
   using assms by (auto intro: power_le_imp_le_exp [OF \<open>1 < i\<close> dvd_imp_le])
 
 lemma dvd_power_iff_le:
   fixes k::nat
   shows "2 \<le> k \<Longrightarrow> ((k ^ m) dvd (k ^ n) \<longleftrightarrow> m \<le> n)"
   using le_imp_power_dvd power_dvd_imp_le by force
 
 lemma power2_nat_le_eq_le: "m\<^sup>2 \<le> n\<^sup>2 \<longleftrightarrow> m \<le> n"
   for m n :: nat
   by (auto intro: power2_le_imp_le power_mono)
 
 lemma power2_nat_le_imp_le:
   fixes m n :: nat
   assumes "m\<^sup>2 \<le> n"
   shows "m \<le> n"
 proof (cases m)
   case 0
   then show ?thesis by simp
 next
   case (Suc k)
   show ?thesis
   proof (rule ccontr)
     assume "\<not> ?thesis"
     then have "n < m" by simp
     with assms Suc show False
       by (simp add: power2_eq_square)
   qed
 qed
 
 lemma ex_power_ivl1: fixes b k :: nat assumes "b \<ge> 2"
 shows "k \<ge> 1 \<Longrightarrow> \<exists>n. b^n \<le> k \<and> k < b^(n+1)" (is "_ \<Longrightarrow> \<exists>n. ?P k n")
 proof(induction k)
   case 0 thus ?case by simp
 next
   case (Suc k)
   show ?case
   proof cases
     assume "k=0"
     hence "?P (Suc k) 0" using assms by simp
     thus ?case ..
   next
     assume "k\<noteq>0"
     with Suc obtain n where IH: "?P k n" by auto
     show ?case
     proof (cases "k = b^(n+1) - 1")
       case True
       hence "?P (Suc k) (n+1)" using assms
         by (simp add: power_less_power_Suc)
       thus ?thesis ..
     next
       case False
       hence "?P (Suc k) n" using IH by auto
       thus ?thesis ..
     qed
   qed
 qed
 
 lemma ex_power_ivl2: fixes b k :: nat assumes "b \<ge> 2" "k \<ge> 2"
   shows "\<exists>n. b^n < k \<and> k \<le> b^(n+1)"
 proof -
   have "1 \<le> k - 1" using assms(2) by arith
   from ex_power_ivl1[OF assms(1) this]
   obtain n where "b ^ n \<le> k - 1 \<and> k - 1 < b ^ (n + 1)" ..
   hence "b^n < k \<and> k \<le> b^(n+1)" using assms by auto
   thus ?thesis ..
 qed
 
 
 subsubsection \<open>Cardinality of the Powerset\<close>
 
 lemma card_UNIV_bool [simp]: "card (UNIV :: bool set) = 2"
   unfolding UNIV_bool by simp
 
 lemma card_Pow: "finite A \<Longrightarrow> card (Pow A) = 2 ^ card A"
 proof (induct rule: finite_induct)
   case empty
   show ?case by simp
 next
   case (insert x A)
   from \<open>x \<notin> A\<close> have disjoint: "Pow A \<inter> insert x ` Pow A = {}" by blast
   from \<open>x \<notin> A\<close> have inj_on: "inj_on (insert x) (Pow A)"
     unfolding inj_on_def by auto
 
   have "card (Pow (insert x A)) = card (Pow A \<union> insert x ` Pow A)"
     by (simp only: Pow_insert)
   also have "\<dots> = card (Pow A) + card (insert x ` Pow A)"
     by (rule card_Un_disjoint) (use \<open>finite A\<close> disjoint in simp_all)
   also from inj_on have "card (insert x ` Pow A) = card (Pow A)"
     by (rule card_image)
   also have "\<dots> + \<dots> = 2 * \<dots>" by (simp add: mult_2)
   also from insert(3) have "\<dots> = 2 ^ Suc (card A)" by simp
   also from insert(1,2) have "Suc (card A) = card (insert x A)"
     by (rule card_insert_disjoint [symmetric])
   finally show ?case .
 qed
 
 
 subsection \<open>Code generator tweak\<close>
 
 code_identifier
   code_module Power \<rightharpoonup> (SML) Arith and (OCaml) Arith and (Haskell) Arith
 
 end
diff --git a/src/HOL/Real_Vector_Spaces.thy b/src/HOL/Real_Vector_Spaces.thy
--- a/src/HOL/Real_Vector_Spaces.thy
+++ b/src/HOL/Real_Vector_Spaces.thy
@@ -1,2482 +1,2487 @@
 (*  Title:      HOL/Real_Vector_Spaces.thy
     Author:     Brian Huffman
     Author:     Johannes Hölzl
 *)
 
 section \<open>Vector Spaces and Algebras over the Reals\<close>
 
 theory Real_Vector_Spaces              
 imports Real Topological_Spaces Vector_Spaces
 begin                                   
 
 subsection \<open>Real vector spaces\<close>
 
 class scaleR =
   fixes scaleR :: "real \<Rightarrow> 'a \<Rightarrow> 'a" (infixr "*\<^sub>R" 75)
 begin
 
 abbreviation divideR :: "'a \<Rightarrow> real \<Rightarrow> 'a"  (infixl "'/\<^sub>R" 70)
   where "x /\<^sub>R r \<equiv> inverse r *\<^sub>R x"
 
 end
 
 class real_vector = scaleR + ab_group_add +
   assumes scaleR_add_right: "a *\<^sub>R (x + y) = a *\<^sub>R x + a *\<^sub>R y"
   and scaleR_add_left: "(a + b) *\<^sub>R x = a *\<^sub>R x + b *\<^sub>R x"
   and scaleR_scaleR: "a *\<^sub>R b *\<^sub>R x = (a * b) *\<^sub>R x"
   and scaleR_one: "1 *\<^sub>R x = x"
 
 class real_algebra = real_vector + ring +
   assumes mult_scaleR_left [simp]: "a *\<^sub>R x * y = a *\<^sub>R (x * y)"
     and mult_scaleR_right [simp]: "x * a *\<^sub>R y = a *\<^sub>R (x * y)"
 
 class real_algebra_1 = real_algebra + ring_1
 
 class real_div_algebra = real_algebra_1 + division_ring
 
 class real_field = real_div_algebra + field
 
 instantiation real :: real_field
 begin
 
 definition real_scaleR_def [simp]: "scaleR a x = a * x"
 
 instance
   by standard (simp_all add: algebra_simps)
 
 end
 
 locale linear = Vector_Spaces.linear "scaleR::_\<Rightarrow>_\<Rightarrow>'a::real_vector" "scaleR::_\<Rightarrow>_\<Rightarrow>'b::real_vector"
 begin
 
 lemmas scaleR = scale
 
 end
 
 global_interpretation real_vector?: vector_space "scaleR :: real \<Rightarrow> 'a \<Rightarrow> 'a :: real_vector"
   rewrites "Vector_Spaces.linear (*\<^sub>R) (*\<^sub>R) = linear"
     and "Vector_Spaces.linear (*) (*\<^sub>R) = linear"
   defines dependent_raw_def: dependent = real_vector.dependent
     and representation_raw_def: representation = real_vector.representation
     and subspace_raw_def: subspace = real_vector.subspace
     and span_raw_def: span = real_vector.span
     and extend_basis_raw_def: extend_basis = real_vector.extend_basis
     and dim_raw_def: dim = real_vector.dim
 proof unfold_locales
   show "Vector_Spaces.linear (*\<^sub>R) (*\<^sub>R) = linear" "Vector_Spaces.linear (*) (*\<^sub>R) = linear"
     by (force simp: linear_def real_scaleR_def[abs_def])+
 qed (use scaleR_add_right scaleR_add_left scaleR_scaleR scaleR_one in auto)
 
 hide_const (open)\<comment> \<open>locale constants\<close>
   real_vector.dependent
   real_vector.independent
   real_vector.representation
   real_vector.subspace
   real_vector.span
   real_vector.extend_basis
   real_vector.dim
 
 abbreviation "independent x \<equiv> \<not> dependent x"
 
 global_interpretation real_vector?: vector_space_pair "scaleR::_\<Rightarrow>_\<Rightarrow>'a::real_vector" "scaleR::_\<Rightarrow>_\<Rightarrow>'b::real_vector"
   rewrites  "Vector_Spaces.linear (*\<^sub>R) (*\<^sub>R) = linear"
     and "Vector_Spaces.linear (*) (*\<^sub>R) = linear"
   defines construct_raw_def: construct = real_vector.construct
 proof unfold_locales
   show "Vector_Spaces.linear (*) (*\<^sub>R) = linear"
   unfolding linear_def real_scaleR_def by auto
 qed (auto simp: linear_def)
 
 hide_const (open)\<comment> \<open>locale constants\<close>
   real_vector.construct
 
 lemma linear_compose: "linear f \<Longrightarrow> linear g \<Longrightarrow> linear (g \<circ> f)"
   unfolding linear_def by (rule Vector_Spaces.linear_compose)
 
 text \<open>Recover original theorem names\<close>
 
 lemmas scaleR_left_commute = real_vector.scale_left_commute
 lemmas scaleR_zero_left = real_vector.scale_zero_left
 lemmas scaleR_minus_left = real_vector.scale_minus_left
 lemmas scaleR_diff_left = real_vector.scale_left_diff_distrib
 lemmas scaleR_sum_left = real_vector.scale_sum_left
 lemmas scaleR_zero_right = real_vector.scale_zero_right
 lemmas scaleR_minus_right = real_vector.scale_minus_right
 lemmas scaleR_diff_right = real_vector.scale_right_diff_distrib
 lemmas scaleR_sum_right = real_vector.scale_sum_right
 lemmas scaleR_eq_0_iff = real_vector.scale_eq_0_iff
 lemmas scaleR_left_imp_eq = real_vector.scale_left_imp_eq
 lemmas scaleR_right_imp_eq = real_vector.scale_right_imp_eq
 lemmas scaleR_cancel_left = real_vector.scale_cancel_left
 lemmas scaleR_cancel_right = real_vector.scale_cancel_right
 
 lemma [field_simps]:
   "c \<noteq> 0 \<Longrightarrow> a = b /\<^sub>R c \<longleftrightarrow> c *\<^sub>R a = b"
   "c \<noteq> 0 \<Longrightarrow> b /\<^sub>R c = a \<longleftrightarrow> b = c *\<^sub>R a"
   "c \<noteq> 0 \<Longrightarrow> a + b /\<^sub>R c = (c *\<^sub>R a + b) /\<^sub>R c"
   "c \<noteq> 0 \<Longrightarrow> a /\<^sub>R c + b = (a + c *\<^sub>R b) /\<^sub>R c"
   "c \<noteq> 0 \<Longrightarrow> a - b /\<^sub>R c = (c *\<^sub>R a - b) /\<^sub>R c"
   "c \<noteq> 0 \<Longrightarrow> a /\<^sub>R c - b = (a - c *\<^sub>R b) /\<^sub>R c"
   "c \<noteq> 0 \<Longrightarrow> - (a /\<^sub>R c) + b = (- a + c *\<^sub>R b) /\<^sub>R c"
   "c \<noteq> 0 \<Longrightarrow> - (a /\<^sub>R c) - b = (- a - c *\<^sub>R b) /\<^sub>R c"
   for a b :: "'a :: real_vector"
   by (auto simp add: scaleR_add_right scaleR_add_left scaleR_diff_right scaleR_diff_left)
 
 
 text \<open>Legacy names\<close>
 
 lemmas scaleR_left_distrib = scaleR_add_left
 lemmas scaleR_right_distrib = scaleR_add_right
 lemmas scaleR_left_diff_distrib = scaleR_diff_left
 lemmas scaleR_right_diff_distrib = scaleR_diff_right
 
 lemmas linear_injective_0 = linear_inj_iff_eq_0
   and linear_injective_on_subspace_0 = linear_inj_on_iff_eq_0
   and linear_cmul = linear_scale
   and linear_scaleR = linear_scale_self
   and subspace_mul = subspace_scale
   and span_linear_image = linear_span_image
   and span_0 = span_zero
   and span_mul = span_scale
   and injective_scaleR = injective_scale
 
 lemma scaleR_minus1_left [simp]: "scaleR (-1) x = - x"
   for x :: "'a::real_vector"
   using scaleR_minus_left [of 1 x] by simp
 
 lemma scaleR_2:
   fixes x :: "'a::real_vector"
   shows "scaleR 2 x = x + x"
   unfolding one_add_one [symmetric] scaleR_left_distrib by simp
 
 lemma scaleR_half_double [simp]:
   fixes a :: "'a::real_vector"
   shows "(1 / 2) *\<^sub>R (a + a) = a"
 proof -
   have "\<And>r. r *\<^sub>R (a + a) = (r * 2) *\<^sub>R a"
     by (metis scaleR_2 scaleR_scaleR)
   then show ?thesis
     by simp
 qed
 
+lemma shift_zero_ident [simp]:
+  fixes f :: "'a \<Rightarrow> 'b::real_vector"
+  shows "(+)0 \<circ> f = f"
+  by force
+  
 lemma linear_scale_real:
   fixes r::real shows "linear f \<Longrightarrow> f (r * b) = r * f b"
   using linear_scale by fastforce
 
 interpretation scaleR_left: additive "(\<lambda>a. scaleR a x :: 'a::real_vector)"
   by standard (rule scaleR_left_distrib)
 
 interpretation scaleR_right: additive "(\<lambda>x. scaleR a x :: 'a::real_vector)"
   by standard (rule scaleR_right_distrib)
 
 lemma nonzero_inverse_scaleR_distrib:
   "a \<noteq> 0 \<Longrightarrow> x \<noteq> 0 \<Longrightarrow> inverse (scaleR a x) = scaleR (inverse a) (inverse x)"
   for x :: "'a::real_div_algebra"
   by (rule inverse_unique) simp
 
 lemma inverse_scaleR_distrib: "inverse (scaleR a x) = scaleR (inverse a) (inverse x)"
   for x :: "'a::{real_div_algebra,division_ring}"
   by (metis inverse_zero nonzero_inverse_scaleR_distrib scale_eq_0_iff)
 
 lemmas sum_constant_scaleR = real_vector.sum_constant_scale\<comment> \<open>legacy name\<close>
 
 named_theorems vector_add_divide_simps "to simplify sums of scaled vectors"
 
 lemma [vector_add_divide_simps]:
   "v + (b / z) *\<^sub>R w = (if z = 0 then v else (z *\<^sub>R v + b *\<^sub>R w) /\<^sub>R z)"
   "a *\<^sub>R v + (b / z) *\<^sub>R w = (if z = 0 then a *\<^sub>R v else ((a * z) *\<^sub>R v + b *\<^sub>R w) /\<^sub>R z)"
   "(a / z) *\<^sub>R v + w = (if z = 0 then w else (a *\<^sub>R v + z *\<^sub>R w) /\<^sub>R z)"
   "(a / z) *\<^sub>R v + b *\<^sub>R w = (if z = 0 then b *\<^sub>R w else (a *\<^sub>R v + (b * z) *\<^sub>R w) /\<^sub>R z)"
   "v - (b / z) *\<^sub>R w = (if z = 0 then v else (z *\<^sub>R v - b *\<^sub>R w) /\<^sub>R z)"
   "a *\<^sub>R v - (b / z) *\<^sub>R w = (if z = 0 then a *\<^sub>R v else ((a * z) *\<^sub>R v - b *\<^sub>R w) /\<^sub>R z)"
   "(a / z) *\<^sub>R v - w = (if z = 0 then -w else (a *\<^sub>R v - z *\<^sub>R w) /\<^sub>R z)"
   "(a / z) *\<^sub>R v - b *\<^sub>R w = (if z = 0 then -b *\<^sub>R w else (a *\<^sub>R v - (b * z) *\<^sub>R w) /\<^sub>R z)"
   for v :: "'a :: real_vector"
   by (simp_all add: divide_inverse_commute scaleR_add_right scaleR_diff_right)
 
 
 lemma eq_vector_fraction_iff [vector_add_divide_simps]:
   fixes x :: "'a :: real_vector"
   shows "(x = (u / v) *\<^sub>R a) \<longleftrightarrow> (if v=0 then x = 0 else v *\<^sub>R x = u *\<^sub>R a)"
 by auto (metis (no_types) divide_eq_1_iff divide_inverse_commute scaleR_one scaleR_scaleR)
 
 lemma vector_fraction_eq_iff [vector_add_divide_simps]:
   fixes x :: "'a :: real_vector"
   shows "((u / v) *\<^sub>R a = x) \<longleftrightarrow> (if v=0 then x = 0 else u *\<^sub>R a = v *\<^sub>R x)"
 by (metis eq_vector_fraction_iff)
 
 lemma real_vector_affinity_eq:
   fixes x :: "'a :: real_vector"
   assumes m0: "m \<noteq> 0"
   shows "m *\<^sub>R x + c = y \<longleftrightarrow> x = inverse m *\<^sub>R y - (inverse m *\<^sub>R c)"
     (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume ?lhs
   then have "m *\<^sub>R x = y - c" by (simp add: field_simps)
   then have "inverse m *\<^sub>R (m *\<^sub>R x) = inverse m *\<^sub>R (y - c)" by simp
   then show "x = inverse m *\<^sub>R y - (inverse m *\<^sub>R c)"
     using m0
   by (simp add: scaleR_diff_right)
 next
   assume ?rhs
   with m0 show "m *\<^sub>R x + c = y"
     by (simp add: scaleR_diff_right)
 qed
 
 lemma real_vector_eq_affinity: "m \<noteq> 0 \<Longrightarrow> y = m *\<^sub>R x + c \<longleftrightarrow> inverse m *\<^sub>R y - (inverse m *\<^sub>R c) = x"
   for x :: "'a::real_vector"
   using real_vector_affinity_eq[where m=m and x=x and y=y and c=c]
   by metis
 
 lemma scaleR_eq_iff [simp]: "b + u *\<^sub>R a = a + u *\<^sub>R b \<longleftrightarrow> a = b \<or> u = 1"
   for a :: "'a::real_vector"
 proof (cases "u = 1")
   case True
   then show ?thesis by auto
 next
   case False
   have "a = b" if "b + u *\<^sub>R a = a + u *\<^sub>R b"
   proof -
     from that have "(u - 1) *\<^sub>R a = (u - 1) *\<^sub>R b"
       by (simp add: algebra_simps)
     with False show ?thesis
       by auto
   qed
   then show ?thesis by auto
 qed
 
 lemma scaleR_collapse [simp]: "(1 - u) *\<^sub>R a + u *\<^sub>R a = a"
   for a :: "'a::real_vector"
   by (simp add: algebra_simps)
 
 
 subsection \<open>Embedding of the Reals into any \<open>real_algebra_1\<close>: \<open>of_real\<close>\<close>
 
 definition of_real :: "real \<Rightarrow> 'a::real_algebra_1"
   where "of_real r = scaleR r 1"
 
 lemma scaleR_conv_of_real: "scaleR r x = of_real r * x"
   by (simp add: of_real_def)
 
 lemma of_real_0 [simp]: "of_real 0 = 0"
   by (simp add: of_real_def)
 
 lemma of_real_1 [simp]: "of_real 1 = 1"
   by (simp add: of_real_def)
 
 lemma of_real_add [simp]: "of_real (x + y) = of_real x + of_real y"
   by (simp add: of_real_def scaleR_left_distrib)
 
 lemma of_real_minus [simp]: "of_real (- x) = - of_real x"
   by (simp add: of_real_def)
 
 lemma of_real_diff [simp]: "of_real (x - y) = of_real x - of_real y"
   by (simp add: of_real_def scaleR_left_diff_distrib)
 
 lemma of_real_mult [simp]: "of_real (x * y) = of_real x * of_real y"
   by (simp add: of_real_def)
 
 lemma of_real_sum[simp]: "of_real (sum f s) = (\<Sum>x\<in>s. of_real (f x))"
   by (induct s rule: infinite_finite_induct) auto
 
 lemma of_real_prod[simp]: "of_real (prod f s) = (\<Prod>x\<in>s. of_real (f x))"
   by (induct s rule: infinite_finite_induct) auto
 
 lemma nonzero_of_real_inverse:
   "x \<noteq> 0 \<Longrightarrow> of_real (inverse x) = inverse (of_real x :: 'a::real_div_algebra)"
   by (simp add: of_real_def nonzero_inverse_scaleR_distrib)
 
 lemma of_real_inverse [simp]:
   "of_real (inverse x) = inverse (of_real x :: 'a::{real_div_algebra,division_ring})"
   by (simp add: of_real_def inverse_scaleR_distrib)
 
 lemma nonzero_of_real_divide:
   "y \<noteq> 0 \<Longrightarrow> of_real (x / y) = (of_real x / of_real y :: 'a::real_field)"
   by (simp add: divide_inverse nonzero_of_real_inverse)
 
 lemma of_real_divide [simp]:
   "of_real (x / y) = (of_real x / of_real y :: 'a::real_div_algebra)"
   by (simp add: divide_inverse)
 
 lemma of_real_power [simp]:
   "of_real (x ^ n) = (of_real x :: 'a::{real_algebra_1}) ^ n"
   by (induct n) simp_all
 
 lemma of_real_power_int [simp]:
   "of_real (power_int x n) = power_int (of_real x :: 'a :: {real_div_algebra,division_ring}) n"
   by (auto simp: power_int_def)
 
 lemma of_real_eq_iff [simp]: "of_real x = of_real y \<longleftrightarrow> x = y"
   by (simp add: of_real_def)
 
 lemma inj_of_real: "inj of_real"
   by (auto intro: injI)
 
 lemmas of_real_eq_0_iff [simp] = of_real_eq_iff [of _ 0, simplified]
 lemmas of_real_eq_1_iff [simp] = of_real_eq_iff [of _ 1, simplified]
 
 lemma minus_of_real_eq_of_real_iff [simp]: "-of_real x = of_real y \<longleftrightarrow> -x = y"
   using of_real_eq_iff[of "-x" y] by (simp only: of_real_minus)
 
 lemma of_real_eq_minus_of_real_iff [simp]: "of_real x = -of_real y \<longleftrightarrow> x = -y"
   using of_real_eq_iff[of x "-y"] by (simp only: of_real_minus)
 
 lemma of_real_eq_id [simp]: "of_real = (id :: real \<Rightarrow> real)"
   by (rule ext) (simp add: of_real_def)
 
 text \<open>Collapse nested embeddings.\<close>
 lemma of_real_of_nat_eq [simp]: "of_real (of_nat n) = of_nat n"
   by (induct n) auto
 
 lemma of_real_of_int_eq [simp]: "of_real (of_int z) = of_int z"
   by (cases z rule: int_diff_cases) simp
 
 lemma of_real_numeral [simp]: "of_real (numeral w) = numeral w"
   using of_real_of_int_eq [of "numeral w"] by simp
 
 lemma of_real_neg_numeral [simp]: "of_real (- numeral w) = - numeral w"
   using of_real_of_int_eq [of "- numeral w"] by simp
 
 lemma numeral_power_int_eq_of_real_cancel_iff [simp]:
   "power_int (numeral x) n = (of_real y :: 'a :: {real_div_algebra, division_ring}) \<longleftrightarrow>
      power_int (numeral x) n = y"
 proof -
   have "power_int (numeral x) n = (of_real (power_int (numeral x) n) :: 'a)"
     by simp
   also have "\<dots> = of_real y \<longleftrightarrow> power_int (numeral x) n = y"
     by (subst of_real_eq_iff) auto
   finally show ?thesis .
 qed
 
 lemma of_real_eq_numeral_power_int_cancel_iff [simp]:
   "(of_real y :: 'a :: {real_div_algebra, division_ring}) = power_int (numeral x) n \<longleftrightarrow>
      y = power_int (numeral x) n"
   by (subst (1 2) eq_commute) simp
 
 lemma of_real_eq_of_real_power_int_cancel_iff [simp]:
   "power_int (of_real b :: 'a :: {real_div_algebra, division_ring}) w = of_real x \<longleftrightarrow>
      power_int b w = x"
   by (metis of_real_power_int of_real_eq_iff)
 
 lemma of_real_in_Ints_iff [simp]: "of_real x \<in> \<int> \<longleftrightarrow> x \<in> \<int>"
 proof safe
   fix x assume "(of_real x :: 'a) \<in> \<int>"
   then obtain n where "(of_real x :: 'a) = of_int n"
     by (auto simp: Ints_def)
   also have "of_int n = of_real (real_of_int n)"
     by simp
   finally have "x = real_of_int n"
     by (subst (asm) of_real_eq_iff)
   thus "x \<in> \<int>"
     by auto
 qed (auto simp: Ints_def)
 
 lemma Ints_of_real [intro]: "x \<in> \<int> \<Longrightarrow> of_real x \<in> \<int>"
   by simp
 
 
 text \<open>Every real algebra has characteristic zero.\<close>
 instance real_algebra_1 < ring_char_0
 proof
   from inj_of_real inj_of_nat have "inj (of_real \<circ> of_nat)"
     by (rule inj_compose)
   then show "inj (of_nat :: nat \<Rightarrow> 'a)"
     by (simp add: comp_def)
 qed
 
 lemma fraction_scaleR_times [simp]:
   fixes a :: "'a::real_algebra_1"
   shows "(numeral u / numeral v) *\<^sub>R (numeral w * a) = (numeral u * numeral w / numeral v) *\<^sub>R a"
 by (metis (no_types, lifting) of_real_numeral scaleR_conv_of_real scaleR_scaleR times_divide_eq_left)
 
 lemma inverse_scaleR_times [simp]:
   fixes a :: "'a::real_algebra_1"
   shows "(1 / numeral v) *\<^sub>R (numeral w * a) = (numeral w / numeral v) *\<^sub>R a"
 by (metis divide_inverse_commute inverse_eq_divide of_real_numeral scaleR_conv_of_real scaleR_scaleR)
 
 lemma scaleR_times [simp]:
   fixes a :: "'a::real_algebra_1"
   shows "(numeral u) *\<^sub>R (numeral w * a) = (numeral u * numeral w) *\<^sub>R a"
 by (simp add: scaleR_conv_of_real)
 
 instance real_field < field_char_0 ..
 
 
 subsection \<open>The Set of Real Numbers\<close>
 
 definition Reals :: "'a::real_algebra_1 set"  ("\<real>")
   where "\<real> = range of_real"
 
 lemma Reals_of_real [simp]: "of_real r \<in> \<real>"
   by (simp add: Reals_def)
 
 lemma Reals_of_int [simp]: "of_int z \<in> \<real>"
   by (subst of_real_of_int_eq [symmetric], rule Reals_of_real)
 
 lemma Reals_of_nat [simp]: "of_nat n \<in> \<real>"
   by (subst of_real_of_nat_eq [symmetric], rule Reals_of_real)
 
 lemma Reals_numeral [simp]: "numeral w \<in> \<real>"
   by (subst of_real_numeral [symmetric], rule Reals_of_real)
 
 lemma Reals_0 [simp]: "0 \<in> \<real>" and Reals_1 [simp]: "1 \<in> \<real>"
   by (simp_all add: Reals_def)
 
 lemma Reals_add [simp]: "a \<in> \<real> \<Longrightarrow> b \<in> \<real> \<Longrightarrow> a + b \<in> \<real>"
   by (metis (no_types, opaque_lifting) Reals_def Reals_of_real imageE of_real_add)
 
 lemma Reals_minus [simp]: "a \<in> \<real> \<Longrightarrow> - a \<in> \<real>"
   by (auto simp: Reals_def)
 
 lemma Reals_minus_iff [simp]: "- a \<in> \<real> \<longleftrightarrow> a \<in> \<real>"
   using Reals_minus by fastforce
 
 lemma Reals_diff [simp]: "a \<in> \<real> \<Longrightarrow> b \<in> \<real> \<Longrightarrow> a - b \<in> \<real>"
   by (metis Reals_add Reals_minus_iff add_uminus_conv_diff)
 
 lemma Reals_mult [simp]: "a \<in> \<real> \<Longrightarrow> b \<in> \<real> \<Longrightarrow> a * b \<in> \<real>"
   by (metis (no_types, lifting) Reals_def Reals_of_real imageE of_real_mult)
 
 lemma nonzero_Reals_inverse: "a \<in> \<real> \<Longrightarrow> a \<noteq> 0 \<Longrightarrow> inverse a \<in> \<real>"
   for a :: "'a::real_div_algebra"
   by (metis Reals_def Reals_of_real imageE of_real_inverse)
 
 lemma Reals_inverse: "a \<in> \<real> \<Longrightarrow> inverse a \<in> \<real>"
   for a :: "'a::{real_div_algebra,division_ring}"
   using nonzero_Reals_inverse by fastforce
 
 lemma Reals_inverse_iff [simp]: "inverse x \<in> \<real> \<longleftrightarrow> x \<in> \<real>"
   for x :: "'a::{real_div_algebra,division_ring}"
   by (metis Reals_inverse inverse_inverse_eq)
 
 lemma nonzero_Reals_divide: "a \<in> \<real> \<Longrightarrow> b \<in> \<real> \<Longrightarrow> b \<noteq> 0 \<Longrightarrow> a / b \<in> \<real>"
   for a b :: "'a::real_field"
   by (simp add: divide_inverse)
 
 lemma Reals_divide [simp]: "a \<in> \<real> \<Longrightarrow> b \<in> \<real> \<Longrightarrow> a / b \<in> \<real>"
   for a b :: "'a::{real_field,field}"
   using nonzero_Reals_divide by fastforce
 
 lemma Reals_power [simp]: "a \<in> \<real> \<Longrightarrow> a ^ n \<in> \<real>"
   for a :: "'a::real_algebra_1"
   by (metis Reals_def Reals_of_real imageE of_real_power)
 
 lemma Reals_cases [cases set: Reals]:
   assumes "q \<in> \<real>"
   obtains (of_real) r where "q = of_real r"
   unfolding Reals_def
 proof -
   from \<open>q \<in> \<real>\<close> have "q \<in> range of_real" unfolding Reals_def .
   then obtain r where "q = of_real r" ..
   then show thesis ..
 qed
 
 lemma sum_in_Reals [intro,simp]: "(\<And>i. i \<in> s \<Longrightarrow> f i \<in> \<real>) \<Longrightarrow> sum f s \<in> \<real>"
 proof (induct s rule: infinite_finite_induct)
   case infinite
   then show ?case by (metis Reals_0 sum.infinite)
 qed simp_all
 
 lemma prod_in_Reals [intro,simp]: "(\<And>i. i \<in> s \<Longrightarrow> f i \<in> \<real>) \<Longrightarrow> prod f s \<in> \<real>"
 proof (induct s rule: infinite_finite_induct)
   case infinite
   then show ?case by (metis Reals_1 prod.infinite)
 qed simp_all
 
 lemma Reals_induct [case_names of_real, induct set: Reals]:
   "q \<in> \<real> \<Longrightarrow> (\<And>r. P (of_real r)) \<Longrightarrow> P q"
   by (rule Reals_cases) auto
 
 
 subsection \<open>Ordered real vector spaces\<close>
 
 class ordered_real_vector = real_vector + ordered_ab_group_add +
   assumes scaleR_left_mono: "x \<le> y \<Longrightarrow> 0 \<le> a \<Longrightarrow> a *\<^sub>R x \<le> a *\<^sub>R y"
     and scaleR_right_mono: "a \<le> b \<Longrightarrow> 0 \<le> x \<Longrightarrow> a *\<^sub>R x \<le> b *\<^sub>R x"
 begin
 
 lemma scaleR_mono:
   "a \<le> b \<Longrightarrow> x \<le> y \<Longrightarrow> 0 \<le> b \<Longrightarrow> 0 \<le> x \<Longrightarrow> a *\<^sub>R x \<le> b *\<^sub>R y"
   by (meson order_trans scaleR_left_mono scaleR_right_mono)
   
 lemma scaleR_mono':
   "a \<le> b \<Longrightarrow> c \<le> d \<Longrightarrow> 0 \<le> a \<Longrightarrow> 0 \<le> c \<Longrightarrow> a *\<^sub>R c \<le> b *\<^sub>R d"
   by (rule scaleR_mono) (auto intro: order.trans)
 
 lemma pos_le_divideR_eq [field_simps]:
   "a \<le> b /\<^sub>R c \<longleftrightarrow> c *\<^sub>R a \<le> b" (is "?P \<longleftrightarrow> ?Q") if "0 < c"
 proof
   assume ?P
   with scaleR_left_mono that have "c *\<^sub>R a \<le> c *\<^sub>R (b /\<^sub>R c)"
     by simp
   with that show ?Q
     by (simp add: scaleR_one scaleR_scaleR inverse_eq_divide)
 next
   assume ?Q
   with scaleR_left_mono that have "c *\<^sub>R a /\<^sub>R c \<le> b /\<^sub>R c"
     by simp
   with that show ?P
     by (simp add: scaleR_one scaleR_scaleR inverse_eq_divide)
 qed
 
 lemma pos_less_divideR_eq [field_simps]:
   "a < b /\<^sub>R c \<longleftrightarrow> c *\<^sub>R a < b" if "c > 0"
   using that pos_le_divideR_eq [of c a b]
   by (auto simp add: le_less scaleR_scaleR scaleR_one)
 
 lemma pos_divideR_le_eq [field_simps]:
   "b /\<^sub>R c \<le> a \<longleftrightarrow> b \<le> c *\<^sub>R a" if "c > 0"
   using that pos_le_divideR_eq [of "inverse c" b a] by simp
 
 lemma pos_divideR_less_eq [field_simps]:
   "b /\<^sub>R c < a \<longleftrightarrow> b < c *\<^sub>R a" if "c > 0"
   using that pos_less_divideR_eq [of "inverse c" b a] by simp
 
 lemma pos_le_minus_divideR_eq [field_simps]:
   "a \<le> - (b /\<^sub>R c) \<longleftrightarrow> c *\<^sub>R a \<le> - b" if "c > 0"
   using that by (metis add_minus_cancel diff_0 left_minus minus_minus neg_le_iff_le
     scaleR_add_right uminus_add_conv_diff pos_le_divideR_eq)
   
 lemma pos_less_minus_divideR_eq [field_simps]:
   "a < - (b /\<^sub>R c) \<longleftrightarrow> c *\<^sub>R a < - b" if "c > 0"
   using that by (metis le_less less_le_not_le pos_divideR_le_eq
     pos_divideR_less_eq pos_le_minus_divideR_eq)
 
 lemma pos_minus_divideR_le_eq [field_simps]:
   "- (b /\<^sub>R c) \<le> a \<longleftrightarrow> - b \<le> c *\<^sub>R a" if "c > 0"
   using that by (metis pos_divideR_le_eq pos_le_minus_divideR_eq that
     inverse_positive_iff_positive le_imp_neg_le minus_minus)
 
 lemma pos_minus_divideR_less_eq [field_simps]:
   "- (b /\<^sub>R c) < a \<longleftrightarrow> - b < c *\<^sub>R a" if "c > 0"
   using that by (simp add: less_le_not_le pos_le_minus_divideR_eq pos_minus_divideR_le_eq) 
 
 lemma scaleR_image_atLeastAtMost: "c > 0 \<Longrightarrow> scaleR c ` {x..y} = {c *\<^sub>R x..c *\<^sub>R y}"
   apply (auto intro!: scaleR_left_mono simp: image_iff Bex_def)
   using pos_divideR_le_eq [of c] pos_le_divideR_eq [of c]
   apply (meson local.order_eq_iff) 
   done
 
 end
 
 lemma neg_le_divideR_eq [field_simps]:
   "a \<le> b /\<^sub>R c \<longleftrightarrow> b \<le> c *\<^sub>R a" (is "?P \<longleftrightarrow> ?Q") if "c < 0"
     for a b :: "'a :: ordered_real_vector"
   using that pos_le_divideR_eq [of "- c" a "- b"] by simp
 
 lemma neg_less_divideR_eq [field_simps]:
   "a < b /\<^sub>R c \<longleftrightarrow> b < c *\<^sub>R a" if "c < 0"
     for a b :: "'a :: ordered_real_vector"
   using that neg_le_divideR_eq [of c a b] by (auto simp add: le_less)
 
 lemma neg_divideR_le_eq [field_simps]:
   "b /\<^sub>R c \<le> a \<longleftrightarrow> c *\<^sub>R a \<le> b" if "c < 0"
     for a b :: "'a :: ordered_real_vector"
   using that pos_divideR_le_eq [of "- c" "- b" a] by simp
 
 lemma neg_divideR_less_eq [field_simps]:
   "b /\<^sub>R c < a \<longleftrightarrow> c *\<^sub>R a < b" if "c < 0"
     for a b :: "'a :: ordered_real_vector"
   using that neg_divideR_le_eq [of c b a] by (auto simp add: le_less)
 
 lemma neg_le_minus_divideR_eq [field_simps]:
   "a \<le> - (b /\<^sub>R c) \<longleftrightarrow> - b \<le> c *\<^sub>R a" if "c < 0"
     for a b :: "'a :: ordered_real_vector"
   using that pos_le_minus_divideR_eq [of "- c" a "- b"] by (simp add: minus_le_iff)
   
 lemma neg_less_minus_divideR_eq [field_simps]:
   "a < - (b /\<^sub>R c) \<longleftrightarrow> - b < c *\<^sub>R a" if "c < 0"
    for a b :: "'a :: ordered_real_vector"
 proof -
   have *: "- b = c *\<^sub>R a \<longleftrightarrow> b = - (c *\<^sub>R a)"
     by (metis add.inverse_inverse)
   from that neg_le_minus_divideR_eq [of c a b]
   show ?thesis by (auto simp add: le_less *)
 qed
 
 lemma neg_minus_divideR_le_eq [field_simps]:
   "- (b /\<^sub>R c) \<le> a \<longleftrightarrow> c *\<^sub>R a \<le> - b" if "c < 0"
     for a b :: "'a :: ordered_real_vector"
   using that pos_minus_divideR_le_eq [of "- c" "- b" a] by (simp add: le_minus_iff) 
 
 lemma neg_minus_divideR_less_eq [field_simps]:
   "- (b /\<^sub>R c) < a \<longleftrightarrow> c *\<^sub>R a < - b" if "c < 0"
     for a b :: "'a :: ordered_real_vector"
   using that by (simp add: less_le_not_le neg_le_minus_divideR_eq neg_minus_divideR_le_eq)
 
 lemma [field_split_simps]:
   "a = b /\<^sub>R c \<longleftrightarrow> (if c = 0 then a = 0 else c *\<^sub>R a = b)"
   "b /\<^sub>R c = a \<longleftrightarrow> (if c = 0 then a = 0 else b = c *\<^sub>R a)"
   "a + b /\<^sub>R c = (if c = 0 then a else (c *\<^sub>R a + b) /\<^sub>R c)"
   "a /\<^sub>R c + b = (if c = 0 then b else (a + c *\<^sub>R b) /\<^sub>R c)"
   "a - b /\<^sub>R c = (if c = 0 then a else (c *\<^sub>R a - b) /\<^sub>R c)"
   "a /\<^sub>R c - b = (if c = 0 then - b else (a - c *\<^sub>R b) /\<^sub>R c)"
   "- (a /\<^sub>R c) + b = (if c = 0 then b else (- a + c *\<^sub>R b) /\<^sub>R c)"
   "- (a /\<^sub>R c) - b = (if c = 0 then - b else (- a - c *\<^sub>R b) /\<^sub>R c)"
     for a b :: "'a :: real_vector"
   by (auto simp add: field_simps)
 
 lemma [field_split_simps]:
   "0 < c \<Longrightarrow> a \<le> b /\<^sub>R c \<longleftrightarrow> (if c > 0 then c *\<^sub>R a \<le> b else if c < 0 then b \<le> c *\<^sub>R a else a \<le> 0)"
   "0 < c \<Longrightarrow> a < b /\<^sub>R c \<longleftrightarrow> (if c > 0 then c *\<^sub>R a < b else if c < 0 then b < c *\<^sub>R a else a < 0)"
   "0 < c \<Longrightarrow> b /\<^sub>R c \<le> a \<longleftrightarrow> (if c > 0 then b \<le> c *\<^sub>R a else if c < 0 then c *\<^sub>R a \<le> b else a \<ge> 0)"
   "0 < c \<Longrightarrow> b /\<^sub>R c < a \<longleftrightarrow> (if c > 0 then b < c *\<^sub>R a else if c < 0 then c *\<^sub>R a < b else a > 0)"
   "0 < c \<Longrightarrow> a \<le> - (b /\<^sub>R c) \<longleftrightarrow> (if c > 0 then c *\<^sub>R a \<le> - b else if c < 0 then - b \<le> c *\<^sub>R a else a \<le> 0)"
   "0 < c \<Longrightarrow> a < - (b /\<^sub>R c) \<longleftrightarrow> (if c > 0 then c *\<^sub>R a < - b else if c < 0 then - b < c *\<^sub>R a else a < 0)"
   "0 < c \<Longrightarrow> - (b /\<^sub>R c) \<le> a \<longleftrightarrow> (if c > 0 then - b \<le> c *\<^sub>R a else if c < 0 then c *\<^sub>R a \<le> - b else a \<ge> 0)"
   "0 < c \<Longrightarrow> - (b /\<^sub>R c) < a \<longleftrightarrow> (if c > 0 then - b < c *\<^sub>R a else if c < 0 then c *\<^sub>R a < - b else a > 0)"
   for a b :: "'a :: ordered_real_vector"
   by (clarsimp intro!: field_simps)+
 
 lemma scaleR_nonneg_nonneg: "0 \<le> a \<Longrightarrow> 0 \<le> x \<Longrightarrow> 0 \<le> a *\<^sub>R x"
   for x :: "'a::ordered_real_vector"
   using scaleR_left_mono [of 0 x a] by simp
 
 lemma scaleR_nonneg_nonpos: "0 \<le> a \<Longrightarrow> x \<le> 0 \<Longrightarrow> a *\<^sub>R x \<le> 0"
   for x :: "'a::ordered_real_vector"
   using scaleR_left_mono [of x 0 a] by simp
 
 lemma scaleR_nonpos_nonneg: "a \<le> 0 \<Longrightarrow> 0 \<le> x \<Longrightarrow> a *\<^sub>R x \<le> 0"
   for x :: "'a::ordered_real_vector"
   using scaleR_right_mono [of a 0 x] by simp
 
 lemma split_scaleR_neg_le: "(0 \<le> a \<and> x \<le> 0) \<or> (a \<le> 0 \<and> 0 \<le> x) \<Longrightarrow> a *\<^sub>R x \<le> 0"
   for x :: "'a::ordered_real_vector"
   by (auto simp: scaleR_nonneg_nonpos scaleR_nonpos_nonneg)
 
 lemma le_add_iff1: "a *\<^sub>R e + c \<le> b *\<^sub>R e + d \<longleftrightarrow> (a - b) *\<^sub>R e + c \<le> d"
   for c d e :: "'a::ordered_real_vector"
   by (simp add: algebra_simps)
 
 lemma le_add_iff2: "a *\<^sub>R e + c \<le> b *\<^sub>R e + d \<longleftrightarrow> c \<le> (b - a) *\<^sub>R e + d"
   for c d e :: "'a::ordered_real_vector"
   by (simp add: algebra_simps)
 
 lemma scaleR_left_mono_neg: "b \<le> a \<Longrightarrow> c \<le> 0 \<Longrightarrow> c *\<^sub>R a \<le> c *\<^sub>R b"
   for a b :: "'a::ordered_real_vector"
   by (drule scaleR_left_mono [of _ _ "- c"], simp_all)
 
 lemma scaleR_right_mono_neg: "b \<le> a \<Longrightarrow> c \<le> 0 \<Longrightarrow> a *\<^sub>R c \<le> b *\<^sub>R c"
   for c :: "'a::ordered_real_vector"
   by (drule scaleR_right_mono [of _ _ "- c"], simp_all)
 
 lemma scaleR_nonpos_nonpos: "a \<le> 0 \<Longrightarrow> b \<le> 0 \<Longrightarrow> 0 \<le> a *\<^sub>R b"
   for b :: "'a::ordered_real_vector"
   using scaleR_right_mono_neg [of a 0 b] by simp
 
 lemma split_scaleR_pos_le: "(0 \<le> a \<and> 0 \<le> b) \<or> (a \<le> 0 \<and> b \<le> 0) \<Longrightarrow> 0 \<le> a *\<^sub>R b"
   for b :: "'a::ordered_real_vector"
   by (auto simp: scaleR_nonneg_nonneg scaleR_nonpos_nonpos)
 
 lemma zero_le_scaleR_iff:
   fixes b :: "'a::ordered_real_vector"
   shows "0 \<le> a *\<^sub>R b \<longleftrightarrow> 0 < a \<and> 0 \<le> b \<or> a < 0 \<and> b \<le> 0 \<or> a = 0"
     (is "?lhs = ?rhs")
 proof (cases "a = 0")
   case True
   then show ?thesis by simp
 next
   case False
   show ?thesis
   proof
     assume ?lhs
     from \<open>a \<noteq> 0\<close> consider "a > 0" | "a < 0" by arith
     then show ?rhs
     proof cases
       case 1
       with \<open>?lhs\<close> have "inverse a *\<^sub>R 0 \<le> inverse a *\<^sub>R (a *\<^sub>R b)"
         by (intro scaleR_mono) auto
       with 1 show ?thesis
         by simp
     next
       case 2
       with \<open>?lhs\<close> have "- inverse a *\<^sub>R 0 \<le> - inverse a *\<^sub>R (a *\<^sub>R b)"
         by (intro scaleR_mono) auto
       with 2 show ?thesis
         by simp
     qed
   next
     assume ?rhs
     then show ?lhs
       by (auto simp: not_le \<open>a \<noteq> 0\<close> intro!: split_scaleR_pos_le)
   qed
 qed
 
 lemma scaleR_le_0_iff: "a *\<^sub>R b \<le> 0 \<longleftrightarrow> 0 < a \<and> b \<le> 0 \<or> a < 0 \<and> 0 \<le> b \<or> a = 0"
   for b::"'a::ordered_real_vector"
   by (insert zero_le_scaleR_iff [of "-a" b]) force
 
 lemma scaleR_le_cancel_left: "c *\<^sub>R a \<le> c *\<^sub>R b \<longleftrightarrow> (0 < c \<longrightarrow> a \<le> b) \<and> (c < 0 \<longrightarrow> b \<le> a)"
   for b :: "'a::ordered_real_vector"
   by (auto simp: neq_iff scaleR_left_mono scaleR_left_mono_neg
       dest: scaleR_left_mono[where a="inverse c"] scaleR_left_mono_neg[where c="inverse c"])
 
 lemma scaleR_le_cancel_left_pos: "0 < c \<Longrightarrow> c *\<^sub>R a \<le> c *\<^sub>R b \<longleftrightarrow> a \<le> b"
   for b :: "'a::ordered_real_vector"
   by (auto simp: scaleR_le_cancel_left)
 
 lemma scaleR_le_cancel_left_neg: "c < 0 \<Longrightarrow> c *\<^sub>R a \<le> c *\<^sub>R b \<longleftrightarrow> b \<le> a"
   for b :: "'a::ordered_real_vector"
   by (auto simp: scaleR_le_cancel_left)
 
 lemma scaleR_left_le_one_le: "0 \<le> x \<Longrightarrow> a \<le> 1 \<Longrightarrow> a *\<^sub>R x \<le> x"
   for x :: "'a::ordered_real_vector" and a :: real
   using scaleR_right_mono[of a 1 x] by simp
 
 
 subsection \<open>Real normed vector spaces\<close>
 
 class dist =
   fixes dist :: "'a \<Rightarrow> 'a \<Rightarrow> real"
 
 class norm =
   fixes norm :: "'a \<Rightarrow> real"
 
 class sgn_div_norm = scaleR + norm + sgn +
   assumes sgn_div_norm: "sgn x = x /\<^sub>R norm x"
 
 class dist_norm = dist + norm + minus +
   assumes dist_norm: "dist x y = norm (x - y)"
 
 class uniformity_dist = dist + uniformity +
   assumes uniformity_dist: "uniformity = (INF e\<in>{0 <..}. principal {(x, y). dist x y < e})"
 begin
 
 lemma eventually_uniformity_metric:
   "eventually P uniformity \<longleftrightarrow> (\<exists>e>0. \<forall>x y. dist x y < e \<longrightarrow> P (x, y))"
   unfolding uniformity_dist
   by (subst eventually_INF_base)
      (auto simp: eventually_principal subset_eq intro: bexI[of _ "min _ _"])
 
 end
 
 class real_normed_vector = real_vector + sgn_div_norm + dist_norm + uniformity_dist + open_uniformity +
   assumes norm_eq_zero [simp]: "norm x = 0 \<longleftrightarrow> x = 0"
     and norm_triangle_ineq: "norm (x + y) \<le> norm x + norm y"
     and norm_scaleR [simp]: "norm (scaleR a x) = \<bar>a\<bar> * norm x"
 begin
 
 lemma norm_ge_zero [simp]: "0 \<le> norm x"
 proof -
   have "0 = norm (x + -1 *\<^sub>R x)"
     using scaleR_add_left[of 1 "-1" x] norm_scaleR[of 0 x] by (simp add: scaleR_one)
   also have "\<dots> \<le> norm x + norm (-1 *\<^sub>R x)" by (rule norm_triangle_ineq)
   finally show ?thesis by simp
 qed
 
 lemma bdd_below_norm_image: "bdd_below (norm ` A)"
   by (meson bdd_belowI2 norm_ge_zero)
 
 end
 
 class real_normed_algebra = real_algebra + real_normed_vector +
   assumes norm_mult_ineq: "norm (x * y) \<le> norm x * norm y"
 
 class real_normed_algebra_1 = real_algebra_1 + real_normed_algebra +
   assumes norm_one [simp]: "norm 1 = 1"
 
 lemma (in real_normed_algebra_1) scaleR_power [simp]: "(scaleR x y) ^ n = scaleR (x^n) (y^n)"
   by (induct n) (simp_all add: scaleR_one scaleR_scaleR mult_ac)
 
 class real_normed_div_algebra = real_div_algebra + real_normed_vector +
   assumes norm_mult: "norm (x * y) = norm x * norm y"
 
 class real_normed_field = real_field + real_normed_div_algebra
 
 instance real_normed_div_algebra < real_normed_algebra_1
 proof
   show "norm (x * y) \<le> norm x * norm y" for x y :: 'a
     by (simp add: norm_mult)
 next
   have "norm (1 * 1::'a) = norm (1::'a) * norm (1::'a)"
     by (rule norm_mult)
   then show "norm (1::'a) = 1" by simp
 qed
 
 context real_normed_vector begin
 
 lemma norm_zero [simp]: "norm (0::'a) = 0"
   by simp
 
 lemma zero_less_norm_iff [simp]: "norm x > 0 \<longleftrightarrow> x \<noteq> 0"
   by (simp add: order_less_le)
 
 lemma norm_not_less_zero [simp]: "\<not> norm x < 0"
   by (simp add: linorder_not_less)
 
 lemma norm_le_zero_iff [simp]: "norm x \<le> 0 \<longleftrightarrow> x = 0"
   by (simp add: order_le_less)
 
 lemma norm_minus_cancel [simp]: "norm (- x) = norm x"
 proof -
   have "- 1 *\<^sub>R x = - (1 *\<^sub>R x)"
     unfolding add_eq_0_iff2[symmetric] scaleR_add_left[symmetric]
     using norm_eq_zero
     by fastforce
   then have "norm (- x) = norm (scaleR (- 1) x)"
     by (simp only: scaleR_one)
   also have "\<dots> = \<bar>- 1\<bar> * norm x"
     by (rule norm_scaleR)
   finally show ?thesis by simp
 qed
 
 lemma norm_minus_commute: "norm (a - b) = norm (b - a)"
 proof -
   have "norm (- (b - a)) = norm (b - a)"
     by (rule norm_minus_cancel)
   then show ?thesis by simp
 qed
 
 lemma dist_add_cancel [simp]: "dist (a + b) (a + c) = dist b c"
   by (simp add: dist_norm)
 
 lemma dist_add_cancel2 [simp]: "dist (b + a) (c + a) = dist b c"
   by (simp add: dist_norm)
 
 lemma norm_uminus_minus: "norm (- x - y) = norm (x + y)"
   by (subst (2) norm_minus_cancel[symmetric], subst minus_add_distrib) simp
 
 lemma norm_triangle_ineq2: "norm a - norm b \<le> norm (a - b)"
 proof -
   have "norm (a - b + b) \<le> norm (a - b) + norm b"
     by (rule norm_triangle_ineq)
   then show ?thesis by simp
 qed
 
 lemma norm_triangle_ineq3: "\<bar>norm a - norm b\<bar> \<le> norm (a - b)"
 proof -
   have "norm a - norm b \<le> norm (a - b)"
     by (simp add: norm_triangle_ineq2)
   moreover have "norm b - norm a \<le> norm (a - b)"
     by (metis norm_minus_commute norm_triangle_ineq2)
   ultimately show ?thesis
     by (simp add: abs_le_iff)
 qed
 
 lemma norm_triangle_ineq4: "norm (a - b) \<le> norm a + norm b"
 proof -
   have "norm (a + - b) \<le> norm a + norm (- b)"
     by (rule norm_triangle_ineq)
   then show ?thesis by simp
 qed
 
 lemma norm_triangle_le_diff: "norm x + norm y \<le> e \<Longrightarrow> norm (x - y) \<le> e"
     by (meson norm_triangle_ineq4 order_trans)
 
 lemma norm_diff_ineq: "norm a - norm b \<le> norm (a + b)"
 proof -
   have "norm a - norm (- b) \<le> norm (a - - b)"
     by (rule norm_triangle_ineq2)
   then show ?thesis by simp
 qed
 
 lemma norm_triangle_sub: "norm x \<le> norm y + norm (x - y)"
   using norm_triangle_ineq[of "y" "x - y"] by (simp add: field_simps)
 
 lemma norm_triangle_le: "norm x + norm y \<le> e \<Longrightarrow> norm (x + y) \<le> e"
   by (rule norm_triangle_ineq [THEN order_trans])
 
 lemma norm_triangle_lt: "norm x + norm y < e \<Longrightarrow> norm (x + y) < e"
   by (rule norm_triangle_ineq [THEN le_less_trans])
 
 lemma norm_add_leD: "norm (a + b) \<le> c \<Longrightarrow> norm b \<le> norm a + c"
   by (metis ab_semigroup_add_class.add.commute add_commute diff_le_eq norm_diff_ineq order_trans)
 
 lemma norm_diff_triangle_ineq: "norm ((a + b) - (c + d)) \<le> norm (a - c) + norm (b - d)"
 proof -
   have "norm ((a + b) - (c + d)) = norm ((a - c) + (b - d))"
     by (simp add: algebra_simps)
   also have "\<dots> \<le> norm (a - c) + norm (b - d)"
     by (rule norm_triangle_ineq)
   finally show ?thesis .
 qed
 
 lemma norm_diff_triangle_le: "norm (x - z) \<le> e1 + e2"
   if "norm (x - y) \<le> e1"  "norm (y - z) \<le> e2"
 proof -
   have "norm (x - (y + z - y)) \<le> norm (x - y) + norm (y - z)"
     using norm_diff_triangle_ineq that diff_diff_eq2 by presburger
   with that show ?thesis by simp
 qed
 
 lemma norm_diff_triangle_less: "norm (x - z) < e1 + e2"
   if "norm (x - y) < e1"  "norm (y - z) < e2"
 proof -
   have "norm (x - z) \<le> norm (x - y) + norm (y - z)"
     by (metis norm_diff_triangle_ineq add_diff_cancel_left' diff_diff_eq2)
   with that show ?thesis by auto
 qed
 
 lemma norm_triangle_mono:
   "norm a \<le> r \<Longrightarrow> norm b \<le> s \<Longrightarrow> norm (a + b) \<le> r + s"
   by (metis (mono_tags) add_mono_thms_linordered_semiring(1) norm_triangle_ineq order.trans)
 
 lemma norm_sum: "norm (sum f A) \<le> (\<Sum>i\<in>A. norm (f i))"
   for f::"'b \<Rightarrow> 'a"
   by (induct A rule: infinite_finite_induct) (auto intro: norm_triangle_mono)
 
 lemma sum_norm_le: "norm (sum f S) \<le> sum g S"
   if "\<And>x. x \<in> S \<Longrightarrow> norm (f x) \<le> g x"
   for f::"'b \<Rightarrow> 'a"
   by (rule order_trans [OF norm_sum sum_mono]) (simp add: that)
 
 lemma abs_norm_cancel [simp]: "\<bar>norm a\<bar> = norm a"
   by (rule abs_of_nonneg [OF norm_ge_zero])
 
 lemma sum_norm_bound:
   "norm (sum f S) \<le> of_nat (card S)*K"
   if "\<And>x. x \<in> S \<Longrightarrow> norm (f x) \<le> K"
   for f :: "'b \<Rightarrow> 'a"
   using sum_norm_le[OF that] sum_constant[symmetric]
   by simp
 
 lemma norm_add_less: "norm x < r \<Longrightarrow> norm y < s \<Longrightarrow> norm (x + y) < r + s"
   by (rule order_le_less_trans [OF norm_triangle_ineq add_strict_mono])
 
 end
 
 lemma dist_scaleR [simp]: "dist (x *\<^sub>R a) (y *\<^sub>R a) = \<bar>x - y\<bar> * norm a"
   for a :: "'a::real_normed_vector"
   by (metis dist_norm norm_scaleR scaleR_left.diff)
 
 lemma norm_mult_less: "norm x < r \<Longrightarrow> norm y < s \<Longrightarrow> norm (x * y) < r * s"
   for x y :: "'a::real_normed_algebra"
   by (rule order_le_less_trans [OF norm_mult_ineq]) (simp add: mult_strict_mono')
 
 lemma norm_of_real [simp]: "norm (of_real r :: 'a::real_normed_algebra_1) = \<bar>r\<bar>"
   by (simp add: of_real_def)
 
 lemma norm_numeral [simp]: "norm (numeral w::'a::real_normed_algebra_1) = numeral w"
   by (subst of_real_numeral [symmetric], subst norm_of_real, simp)
 
 lemma norm_neg_numeral [simp]: "norm (- numeral w::'a::real_normed_algebra_1) = numeral w"
   by (subst of_real_neg_numeral [symmetric], subst norm_of_real, simp)
 
 lemma norm_of_real_add1 [simp]: "norm (of_real x + 1 :: 'a :: real_normed_div_algebra) = \<bar>x + 1\<bar>"
   by (metis norm_of_real of_real_1 of_real_add)
 
 lemma norm_of_real_addn [simp]:
   "norm (of_real x + numeral b :: 'a :: real_normed_div_algebra) = \<bar>x + numeral b\<bar>"
   by (metis norm_of_real of_real_add of_real_numeral)
 
 lemma norm_of_int [simp]: "norm (of_int z::'a::real_normed_algebra_1) = \<bar>of_int z\<bar>"
   by (subst of_real_of_int_eq [symmetric], rule norm_of_real)
 
 lemma norm_of_nat [simp]: "norm (of_nat n::'a::real_normed_algebra_1) = of_nat n"
   by (metis abs_of_nat norm_of_real of_real_of_nat_eq)
 
 lemma nonzero_norm_inverse: "a \<noteq> 0 \<Longrightarrow> norm (inverse a) = inverse (norm a)"
   for a :: "'a::real_normed_div_algebra"
   by (metis inverse_unique norm_mult norm_one right_inverse)
 
 lemma norm_inverse: "norm (inverse a) = inverse (norm a)"
   for a :: "'a::{real_normed_div_algebra,division_ring}"
   by (metis inverse_zero nonzero_norm_inverse norm_zero)
 
 lemma nonzero_norm_divide: "b \<noteq> 0 \<Longrightarrow> norm (a / b) = norm a / norm b"
   for a b :: "'a::real_normed_field"
   by (simp add: divide_inverse norm_mult nonzero_norm_inverse)
 
 lemma norm_divide: "norm (a / b) = norm a / norm b"
   for a b :: "'a::{real_normed_field,field}"
   by (simp add: divide_inverse norm_mult norm_inverse)
 
 lemma norm_inverse_le_norm:
   fixes x :: "'a::real_normed_div_algebra"
   shows "r \<le> norm x \<Longrightarrow> 0 < r \<Longrightarrow> norm (inverse x) \<le> inverse r"
   by (simp add: le_imp_inverse_le norm_inverse)
 
 lemma norm_power_ineq: "norm (x ^ n) \<le> norm x ^ n"
   for x :: "'a::real_normed_algebra_1"
 proof (induct n)
   case 0
   show "norm (x ^ 0) \<le> norm x ^ 0" by simp
 next
   case (Suc n)
   have "norm (x * x ^ n) \<le> norm x * norm (x ^ n)"
     by (rule norm_mult_ineq)
   also from Suc have "\<dots> \<le> norm x * norm x ^ n"
     using norm_ge_zero by (rule mult_left_mono)
   finally show "norm (x ^ Suc n) \<le> norm x ^ Suc n"
     by simp
 qed
 
 lemma norm_power: "norm (x ^ n) = norm x ^ n"
   for x :: "'a::real_normed_div_algebra"
   by (induct n) (simp_all add: norm_mult)
 
 lemma norm_power_int: "norm (power_int x n) = power_int (norm x) n"
   for x :: "'a::real_normed_div_algebra"
   by (cases n rule: int_cases4) (auto simp: norm_power power_int_minus norm_inverse)
 
 lemma power_eq_imp_eq_norm:
   fixes w :: "'a::real_normed_div_algebra"
   assumes eq: "w ^ n = z ^ n" and "n > 0"
     shows "norm w = norm z"
 proof -
   have "norm w ^ n = norm z ^ n"
     by (metis (no_types) eq norm_power)
   then show ?thesis
     using assms by (force intro: power_eq_imp_eq_base)
 qed
 
 lemma power_eq_1_iff:
   fixes w :: "'a::real_normed_div_algebra"
   shows "w ^ n = 1 \<Longrightarrow> norm w = 1 \<or> n = 0"
   by (metis norm_one power_0_left power_eq_0_iff power_eq_imp_eq_norm power_one)
 
 lemma norm_mult_numeral1 [simp]: "norm (numeral w * a) = numeral w * norm a"
   for a b :: "'a::{real_normed_field,field}"
   by (simp add: norm_mult)
 
 lemma norm_mult_numeral2 [simp]: "norm (a * numeral w) = norm a * numeral w"
   for a b :: "'a::{real_normed_field,field}"
   by (simp add: norm_mult)
 
 lemma norm_divide_numeral [simp]: "norm (a / numeral w) = norm a / numeral w"
   for a b :: "'a::{real_normed_field,field}"
   by (simp add: norm_divide)
 
 lemma norm_of_real_diff [simp]:
   "norm (of_real b - of_real a :: 'a::real_normed_algebra_1) \<le> \<bar>b - a\<bar>"
   by (metis norm_of_real of_real_diff order_refl)
 
 text \<open>Despite a superficial resemblance, \<open>norm_eq_1\<close> is not relevant.\<close>
 lemma square_norm_one:
   fixes x :: "'a::real_normed_div_algebra"
   assumes "x\<^sup>2 = 1"
   shows "norm x = 1"
   by (metis assms norm_minus_cancel norm_one power2_eq_1_iff)
 
 lemma norm_less_p1: "norm x < norm (of_real (norm x) + 1 :: 'a)"
   for x :: "'a::real_normed_algebra_1"
 proof -
   have "norm x < norm (of_real (norm x + 1) :: 'a)"
     by (simp add: of_real_def)
   then show ?thesis
     by simp
 qed
 
 lemma prod_norm: "prod (\<lambda>x. norm (f x)) A = norm (prod f A)"
   for f :: "'a \<Rightarrow> 'b::{comm_semiring_1,real_normed_div_algebra}"
   by (induct A rule: infinite_finite_induct) (auto simp: norm_mult)
 
 lemma norm_prod_le:
   "norm (prod f A) \<le> (\<Prod>a\<in>A. norm (f a :: 'a :: {real_normed_algebra_1,comm_monoid_mult}))"
 proof (induct A rule: infinite_finite_induct)
   case empty
   then show ?case by simp
 next
   case (insert a A)
   then have "norm (prod f (insert a A)) \<le> norm (f a) * norm (prod f A)"
     by (simp add: norm_mult_ineq)
   also have "norm (prod f A) \<le> (\<Prod>a\<in>A. norm (f a))"
     by (rule insert)
   finally show ?case
     by (simp add: insert mult_left_mono)
 next
   case infinite
   then show ?case by simp
 qed
 
 lemma norm_prod_diff:
   fixes z w :: "'i \<Rightarrow> 'a::{real_normed_algebra_1, comm_monoid_mult}"
   shows "(\<And>i. i \<in> I \<Longrightarrow> norm (z i) \<le> 1) \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> norm (w i) \<le> 1) \<Longrightarrow>
     norm ((\<Prod>i\<in>I. z i) - (\<Prod>i\<in>I. w i)) \<le> (\<Sum>i\<in>I. norm (z i - w i))"
 proof (induction I rule: infinite_finite_induct)
   case empty
   then show ?case by simp
 next
   case (insert i I)
   note insert.hyps[simp]
 
   have "norm ((\<Prod>i\<in>insert i I. z i) - (\<Prod>i\<in>insert i I. w i)) =
     norm ((\<Prod>i\<in>I. z i) * (z i - w i) + ((\<Prod>i\<in>I. z i) - (\<Prod>i\<in>I. w i)) * w i)"
     (is "_ = norm (?t1 + ?t2)")
     by (auto simp: field_simps)
   also have "\<dots> \<le> norm ?t1 + norm ?t2"
     by (rule norm_triangle_ineq)
   also have "norm ?t1 \<le> norm (\<Prod>i\<in>I. z i) * norm (z i - w i)"
     by (rule norm_mult_ineq)
   also have "\<dots> \<le> (\<Prod>i\<in>I. norm (z i)) * norm(z i - w i)"
     by (rule mult_right_mono) (auto intro: norm_prod_le)
   also have "(\<Prod>i\<in>I. norm (z i)) \<le> (\<Prod>i\<in>I. 1)"
     by (intro prod_mono) (auto intro!: insert)
   also have "norm ?t2 \<le> norm ((\<Prod>i\<in>I. z i) - (\<Prod>i\<in>I. w i)) * norm (w i)"
     by (rule norm_mult_ineq)
   also have "norm (w i) \<le> 1"
     by (auto intro: insert)
   also have "norm ((\<Prod>i\<in>I. z i) - (\<Prod>i\<in>I. w i)) \<le> (\<Sum>i\<in>I. norm (z i - w i))"
     using insert by auto
   finally show ?case
     by (auto simp: ac_simps mult_right_mono mult_left_mono)
 next
   case infinite
   then show ?case by simp
 qed
 
 lemma norm_power_diff:
   fixes z w :: "'a::{real_normed_algebra_1, comm_monoid_mult}"
   assumes "norm z \<le> 1" "norm w \<le> 1"
   shows "norm (z^m - w^m) \<le> m * norm (z - w)"
 proof -
   have "norm (z^m - w^m) = norm ((\<Prod> i < m. z) - (\<Prod> i < m. w))"
     by simp
   also have "\<dots> \<le> (\<Sum>i<m. norm (z - w))"
     by (intro norm_prod_diff) (auto simp: assms)
   also have "\<dots> = m * norm (z - w)"
     by simp
   finally show ?thesis .
 qed
 
 
 subsection \<open>Metric spaces\<close>
 
 class metric_space = uniformity_dist + open_uniformity +
   assumes dist_eq_0_iff [simp]: "dist x y = 0 \<longleftrightarrow> x = y"
     and dist_triangle2: "dist x y \<le> dist x z + dist y z"
 begin
 
 lemma dist_self [simp]: "dist x x = 0"
   by simp
 
 lemma zero_le_dist [simp]: "0 \<le> dist x y"
   using dist_triangle2 [of x x y] by simp
 
 lemma zero_less_dist_iff: "0 < dist x y \<longleftrightarrow> x \<noteq> y"
   by (simp add: less_le)
 
 lemma dist_not_less_zero [simp]: "\<not> dist x y < 0"
   by (simp add: not_less)
 
 lemma dist_le_zero_iff [simp]: "dist x y \<le> 0 \<longleftrightarrow> x = y"
   by (simp add: le_less)
 
 lemma dist_commute: "dist x y = dist y x"
 proof (rule order_antisym)
   show "dist x y \<le> dist y x"
     using dist_triangle2 [of x y x] by simp
   show "dist y x \<le> dist x y"
     using dist_triangle2 [of y x y] by simp
 qed
 
 lemma dist_commute_lessI: "dist y x < e \<Longrightarrow> dist x y < e"
   by (simp add: dist_commute)
 
 lemma dist_triangle: "dist x z \<le> dist x y + dist y z"
   using dist_triangle2 [of x z y] by (simp add: dist_commute)
 
 lemma dist_triangle3: "dist x y \<le> dist a x + dist a y"
   using dist_triangle2 [of x y a] by (simp add: dist_commute)
 
 lemma abs_dist_diff_le: "\<bar>dist a b - dist b c\<bar> \<le> dist a c"
   using dist_triangle3[of b c a] dist_triangle2[of a b c] by simp
 
 lemma dist_pos_lt: "x \<noteq> y \<Longrightarrow> 0 < dist x y"
   by (simp add: zero_less_dist_iff)
 
 lemma dist_nz: "x \<noteq> y \<longleftrightarrow> 0 < dist x y"
   by (simp add: zero_less_dist_iff)
 
 declare dist_nz [symmetric, simp]
 
 lemma dist_triangle_le: "dist x z + dist y z \<le> e \<Longrightarrow> dist x y \<le> e"
   by (rule order_trans [OF dist_triangle2])
 
 lemma dist_triangle_lt: "dist x z + dist y z < e \<Longrightarrow> dist x y < e"
   by (rule le_less_trans [OF dist_triangle2])
 
 lemma dist_triangle_less_add: "dist x1 y < e1 \<Longrightarrow> dist x2 y < e2 \<Longrightarrow> dist x1 x2 < e1 + e2"
   by (rule dist_triangle_lt [where z=y]) simp
 
 lemma dist_triangle_half_l: "dist x1 y < e / 2 \<Longrightarrow> dist x2 y < e / 2 \<Longrightarrow> dist x1 x2 < e"
   by (rule dist_triangle_lt [where z=y]) simp
 
 lemma dist_triangle_half_r: "dist y x1 < e / 2 \<Longrightarrow> dist y x2 < e / 2 \<Longrightarrow> dist x1 x2 < e"
   by (rule dist_triangle_half_l) (simp_all add: dist_commute)
 
 lemma dist_triangle_third:
   assumes "dist x1 x2 < e/3" "dist x2 x3 < e/3" "dist x3 x4 < e/3"
   shows "dist x1 x4 < e"
 proof -
   have "dist x1 x3 < e/3 + e/3"
     by (metis assms(1) assms(2) dist_commute dist_triangle_less_add)
   then have "dist x1 x4 < (e/3 + e/3) + e/3"
     by (metis assms(3) dist_commute dist_triangle_less_add)
   then show ?thesis
     by simp
 qed
   
 subclass uniform_space
 proof
   fix E x
   assume "eventually E uniformity"
   then obtain e where E: "0 < e" "\<And>x y. dist x y < e \<Longrightarrow> E (x, y)"
     by (auto simp: eventually_uniformity_metric)
   then show "E (x, x)" "\<forall>\<^sub>F (x, y) in uniformity. E (y, x)"
     by (auto simp: eventually_uniformity_metric dist_commute)
   show "\<exists>D. eventually D uniformity \<and> (\<forall>x y z. D (x, y) \<longrightarrow> D (y, z) \<longrightarrow> E (x, z))"
     using E dist_triangle_half_l[where e=e]
     unfolding eventually_uniformity_metric
     by (intro exI[of _ "\<lambda>(x, y). dist x y < e / 2"] exI[of _ "e/2"] conjI)
       (auto simp: dist_commute)
 qed
 
 lemma open_dist: "open S \<longleftrightarrow> (\<forall>x\<in>S. \<exists>e>0. \<forall>y. dist y x < e \<longrightarrow> y \<in> S)"
   by (simp add: dist_commute open_uniformity eventually_uniformity_metric)
 
 lemma open_ball: "open {y. dist x y < d}"
   unfolding open_dist
 proof (intro ballI)
   fix y
   assume *: "y \<in> {y. dist x y < d}"
   then show "\<exists>e>0. \<forall>z. dist z y < e \<longrightarrow> z \<in> {y. dist x y < d}"
     by (auto intro!: exI[of _ "d - dist x y"] simp: field_simps dist_triangle_lt)
 qed
 
 subclass first_countable_topology
 proof
   fix x
   show "\<exists>A::nat \<Rightarrow> 'a set. (\<forall>i. x \<in> A i \<and> open (A i)) \<and> (\<forall>S. open S \<and> x \<in> S \<longrightarrow> (\<exists>i. A i \<subseteq> S))"
   proof (safe intro!: exI[of _ "\<lambda>n. {y. dist x y < inverse (Suc n)}"])
     fix S
     assume "open S" "x \<in> S"
     then obtain e where e: "0 < e" and "{y. dist x y < e} \<subseteq> S"
       by (auto simp: open_dist subset_eq dist_commute)
     moreover
     from e obtain i where "inverse (Suc i) < e"
       by (auto dest!: reals_Archimedean)
     then have "{y. dist x y < inverse (Suc i)} \<subseteq> {y. dist x y < e}"
       by auto
     ultimately show "\<exists>i. {y. dist x y < inverse (Suc i)} \<subseteq> S"
       by blast
   qed (auto intro: open_ball)
 qed
 
 end
 
 instance metric_space \<subseteq> t2_space
 proof
   fix x y :: "'a::metric_space"
   assume xy: "x \<noteq> y"
   let ?U = "{y'. dist x y' < dist x y / 2}"
   let ?V = "{x'. dist y x' < dist x y / 2}"
   have *: "d x z \<le> d x y + d y z \<Longrightarrow> d y z = d z y \<Longrightarrow> \<not> (d x y * 2 < d x z \<and> d z y * 2 < d x z)"
     for d :: "'a \<Rightarrow> 'a \<Rightarrow> real" and x y z :: 'a
     by arith
   have "open ?U \<and> open ?V \<and> x \<in> ?U \<and> y \<in> ?V \<and> ?U \<inter> ?V = {}"
     using dist_pos_lt[OF xy] *[of dist, OF dist_triangle dist_commute]
     using open_ball[of _ "dist x y / 2"] by auto
   then show "\<exists>U V. open U \<and> open V \<and> x \<in> U \<and> y \<in> V \<and> U \<inter> V = {}"
     by blast
 qed
 
 text \<open>Every normed vector space is a metric space.\<close>
 instance real_normed_vector < metric_space
 proof
   fix x y z :: 'a
   show "dist x y = 0 \<longleftrightarrow> x = y"
     by (simp add: dist_norm)
   show "dist x y \<le> dist x z + dist y z"
     using norm_triangle_ineq4 [of "x - z" "y - z"] by (simp add: dist_norm)
 qed
 
 
 subsection \<open>Class instances for real numbers\<close>
 
 instantiation real :: real_normed_field
 begin
 
 definition dist_real_def: "dist x y = \<bar>x - y\<bar>"
 
 definition uniformity_real_def [code del]:
   "(uniformity :: (real \<times> real) filter) = (INF e\<in>{0 <..}. principal {(x, y). dist x y < e})"
 
 definition open_real_def [code del]:
   "open (U :: real set) \<longleftrightarrow> (\<forall>x\<in>U. eventually (\<lambda>(x', y). x' = x \<longrightarrow> y \<in> U) uniformity)"
 
 definition real_norm_def [simp]: "norm r = \<bar>r\<bar>"
 
 instance
   by intro_classes (auto simp: abs_mult open_real_def dist_real_def sgn_real_def uniformity_real_def)
 
 end
 
 declare uniformity_Abort[where 'a=real, code]
 
 lemma dist_of_real [simp]: "dist (of_real x :: 'a) (of_real y) = dist x y"
   for a :: "'a::real_normed_div_algebra"
   by (metis dist_norm norm_of_real of_real_diff real_norm_def)
 
 declare [[code abort: "open :: real set \<Rightarrow> bool"]]
 
 instance real :: linorder_topology
 proof
   show "(open :: real set \<Rightarrow> bool) = generate_topology (range lessThan \<union> range greaterThan)"
   proof (rule ext, safe)
     fix S :: "real set"
     assume "open S"
     then obtain f where "\<forall>x\<in>S. 0 < f x \<and> (\<forall>y. dist y x < f x \<longrightarrow> y \<in> S)"
       unfolding open_dist bchoice_iff ..
     then have *: "(\<Union>x\<in>S. {x - f x <..} \<inter> {..< x + f x}) = S" (is "?S = S")
       by (fastforce simp: dist_real_def)
     moreover have "generate_topology (range lessThan \<union> range greaterThan) ?S"
       by (force intro: generate_topology.Basis generate_topology_Union generate_topology.Int)
     ultimately show "generate_topology (range lessThan \<union> range greaterThan) S"
       by simp
   next
     fix S :: "real set"
     assume "generate_topology (range lessThan \<union> range greaterThan) S"
     moreover have "\<And>a::real. open {..<a}"
       unfolding open_dist dist_real_def
     proof clarify
       fix x a :: real
       assume "x < a"
       then have "0 < a - x \<and> (\<forall>y. \<bar>y - x\<bar> < a - x \<longrightarrow> y \<in> {..<a})" by auto
       then show "\<exists>e>0. \<forall>y. \<bar>y - x\<bar> < e \<longrightarrow> y \<in> {..<a}" ..
     qed
     moreover have "\<And>a::real. open {a <..}"
       unfolding open_dist dist_real_def
     proof clarify
       fix x a :: real
       assume "a < x"
       then have "0 < x - a \<and> (\<forall>y. \<bar>y - x\<bar> < x - a \<longrightarrow> y \<in> {a<..})" by auto
       then show "\<exists>e>0. \<forall>y. \<bar>y - x\<bar> < e \<longrightarrow> y \<in> {a<..}" ..
     qed
     ultimately show "open S"
       by induct auto
   qed
 qed
 
 instance real :: linear_continuum_topology ..
 
 lemmas open_real_greaterThan = open_greaterThan[where 'a=real]
 lemmas open_real_lessThan = open_lessThan[where 'a=real]
 lemmas open_real_greaterThanLessThan = open_greaterThanLessThan[where 'a=real]
 lemmas closed_real_atMost = closed_atMost[where 'a=real]
 lemmas closed_real_atLeast = closed_atLeast[where 'a=real]
 lemmas closed_real_atLeastAtMost = closed_atLeastAtMost[where 'a=real]
 
 instance real :: ordered_real_vector
   by standard (auto intro: mult_left_mono mult_right_mono)
 
 
 subsection \<open>Extra type constraints\<close>
 
 text \<open>Only allow \<^term>\<open>open\<close> in class \<open>topological_space\<close>.\<close>
 setup \<open>Sign.add_const_constraint
   (\<^const_name>\<open>open\<close>, SOME \<^typ>\<open>'a::topological_space set \<Rightarrow> bool\<close>)\<close>
 
 text \<open>Only allow \<^term>\<open>uniformity\<close> in class \<open>uniform_space\<close>.\<close>
 setup \<open>Sign.add_const_constraint
   (\<^const_name>\<open>uniformity\<close>, SOME \<^typ>\<open>('a::uniformity \<times> 'a) filter\<close>)\<close>
 
 text \<open>Only allow \<^term>\<open>dist\<close> in class \<open>metric_space\<close>.\<close>
 setup \<open>Sign.add_const_constraint
   (\<^const_name>\<open>dist\<close>, SOME \<^typ>\<open>'a::metric_space \<Rightarrow> 'a \<Rightarrow> real\<close>)\<close>
 
 text \<open>Only allow \<^term>\<open>norm\<close> in class \<open>real_normed_vector\<close>.\<close>
 setup \<open>Sign.add_const_constraint
   (\<^const_name>\<open>norm\<close>, SOME \<^typ>\<open>'a::real_normed_vector \<Rightarrow> real\<close>)\<close>
 
 
 subsection \<open>Sign function\<close>
 
 lemma norm_sgn: "norm (sgn x) = (if x = 0 then 0 else 1)"
   for x :: "'a::real_normed_vector"
   by (simp add: sgn_div_norm)
 
 lemma sgn_zero [simp]: "sgn (0::'a::real_normed_vector) = 0"
   by (simp add: sgn_div_norm)
 
 lemma sgn_zero_iff: "sgn x = 0 \<longleftrightarrow> x = 0"
   for x :: "'a::real_normed_vector"
   by (simp add: sgn_div_norm)
 
 lemma sgn_minus: "sgn (- x) = - sgn x"
   for x :: "'a::real_normed_vector"
   by (simp add: sgn_div_norm)
 
 lemma sgn_scaleR: "sgn (scaleR r x) = scaleR (sgn r) (sgn x)"
   for x :: "'a::real_normed_vector"
   by (simp add: sgn_div_norm ac_simps)
 
 lemma sgn_one [simp]: "sgn (1::'a::real_normed_algebra_1) = 1"
   by (simp add: sgn_div_norm)
 
 lemma sgn_of_real: "sgn (of_real r :: 'a::real_normed_algebra_1) = of_real (sgn r)"
   unfolding of_real_def by (simp only: sgn_scaleR sgn_one)
 
 lemma sgn_mult: "sgn (x * y) = sgn x * sgn y"
   for x y :: "'a::real_normed_div_algebra"
   by (simp add: sgn_div_norm norm_mult)
 
 hide_fact (open) sgn_mult
 
 lemma real_sgn_eq: "sgn x = x / \<bar>x\<bar>"
   for x :: real
   by (simp add: sgn_div_norm divide_inverse)
 
 lemma zero_le_sgn_iff [simp]: "0 \<le> sgn x \<longleftrightarrow> 0 \<le> x"
   for x :: real
   by (cases "0::real" x rule: linorder_cases) simp_all
 
 lemma sgn_le_0_iff [simp]: "sgn x \<le> 0 \<longleftrightarrow> x \<le> 0"
   for x :: real
   by (cases "0::real" x rule: linorder_cases) simp_all
 
 lemma norm_conv_dist: "norm x = dist x 0"
   unfolding dist_norm by simp
 
 declare norm_conv_dist [symmetric, simp]
 
 lemma dist_0_norm [simp]: "dist 0 x = norm x"
   for x :: "'a::real_normed_vector"
   by (simp add: dist_norm)
 
 lemma dist_diff [simp]: "dist a (a - b) = norm b"  "dist (a - b) a = norm b"
   by (simp_all add: dist_norm)
 
 lemma dist_of_int: "dist (of_int m) (of_int n :: 'a :: real_normed_algebra_1) = of_int \<bar>m - n\<bar>"
 proof -
   have "dist (of_int m) (of_int n :: 'a) = dist (of_int m :: 'a) (of_int m - (of_int (m - n)))"
     by simp
   also have "\<dots> = of_int \<bar>m - n\<bar>" by (subst dist_diff, subst norm_of_int) simp
   finally show ?thesis .
 qed
 
 lemma dist_of_nat:
   "dist (of_nat m) (of_nat n :: 'a :: real_normed_algebra_1) = of_int \<bar>int m - int n\<bar>"
   by (subst (1 2) of_int_of_nat_eq [symmetric]) (rule dist_of_int)
 
 
 subsection \<open>Bounded Linear and Bilinear Operators\<close>
 
 lemma linearI: "linear f"
   if "\<And>b1 b2. f (b1 + b2) = f b1 + f b2"
     "\<And>r b. f (r *\<^sub>R b) = r *\<^sub>R f b"
   using that
   by unfold_locales (auto simp: algebra_simps)
 
 lemma linear_iff:
   "linear f \<longleftrightarrow> (\<forall>x y. f (x + y) = f x + f y) \<and> (\<forall>c x. f (c *\<^sub>R x) = c *\<^sub>R f x)"
   (is "linear f \<longleftrightarrow> ?rhs")
 proof
   assume "linear f"
   then interpret f: linear f .
   show "?rhs" by (simp add: f.add f.scale)
 next
   assume "?rhs"
   then show "linear f" by (intro linearI) auto
 qed
 
 lemmas linear_scaleR_left = linear_scale_left
 lemmas linear_imp_scaleR = linear_imp_scale
 
 corollary real_linearD:
   fixes f :: "real \<Rightarrow> real"
   assumes "linear f" obtains c where "f = (*) c"
   by (rule linear_imp_scaleR [OF assms]) (force simp: scaleR_conv_of_real)
 
 lemma linear_times_of_real: "linear (\<lambda>x. a * of_real x)"
   by (auto intro!: linearI simp: distrib_left)
     (metis mult_scaleR_right scaleR_conv_of_real)
 
 locale bounded_linear = linear f for f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector" +
   assumes bounded: "\<exists>K. \<forall>x. norm (f x) \<le> norm x * K"
 begin
 
 lemma pos_bounded: "\<exists>K>0. \<forall>x. norm (f x) \<le> norm x * K"
 proof -
   obtain K where K: "\<And>x. norm (f x) \<le> norm x * K"
     using bounded by blast
   show ?thesis
   proof (intro exI impI conjI allI)
     show "0 < max 1 K"
       by (rule order_less_le_trans [OF zero_less_one max.cobounded1])
   next
     fix x
     have "norm (f x) \<le> norm x * K" using K .
     also have "\<dots> \<le> norm x * max 1 K"
       by (rule mult_left_mono [OF max.cobounded2 norm_ge_zero])
     finally show "norm (f x) \<le> norm x * max 1 K" .
   qed
 qed
 
 lemma nonneg_bounded: "\<exists>K\<ge>0. \<forall>x. norm (f x) \<le> norm x * K"
   using pos_bounded by (auto intro: order_less_imp_le)
 
 lemma linear: "linear f"
   by (fact local.linear_axioms)
 
 end
 
 lemma bounded_linear_intro:
   assumes "\<And>x y. f (x + y) = f x + f y"
     and "\<And>r x. f (scaleR r x) = scaleR r (f x)"
     and "\<And>x. norm (f x) \<le> norm x * K"
   shows "bounded_linear f"
   by standard (blast intro: assms)+
 
 locale bounded_bilinear =
   fixes prod :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector \<Rightarrow> 'c::real_normed_vector"
     (infixl "**" 70)
   assumes add_left: "prod (a + a') b = prod a b + prod a' b"
     and add_right: "prod a (b + b') = prod a b + prod a b'"
     and scaleR_left: "prod (scaleR r a) b = scaleR r (prod a b)"
     and scaleR_right: "prod a (scaleR r b) = scaleR r (prod a b)"
     and bounded: "\<exists>K. \<forall>a b. norm (prod a b) \<le> norm a * norm b * K"
 begin
 
 lemma pos_bounded: "\<exists>K>0. \<forall>a b. norm (a ** b) \<le> norm a * norm b * K"
 proof -
   obtain K where "\<And>a b. norm (a ** b) \<le> norm a * norm b * K"
     using bounded by blast
   then have "norm (a ** b) \<le> norm a * norm b * (max 1 K)" for a b
     by (rule order.trans) (simp add: mult_left_mono)
   then show ?thesis
     by force
 qed
 
 lemma nonneg_bounded: "\<exists>K\<ge>0. \<forall>a b. norm (a ** b) \<le> norm a * norm b * K"
   using pos_bounded by (auto intro: order_less_imp_le)
 
 lemma additive_right: "additive (\<lambda>b. prod a b)"
   by (rule additive.intro, rule add_right)
 
 lemma additive_left: "additive (\<lambda>a. prod a b)"
   by (rule additive.intro, rule add_left)
 
 lemma zero_left: "prod 0 b = 0"
   by (rule additive.zero [OF additive_left])
 
 lemma zero_right: "prod a 0 = 0"
   by (rule additive.zero [OF additive_right])
 
 lemma minus_left: "prod (- a) b = - prod a b"
   by (rule additive.minus [OF additive_left])
 
 lemma minus_right: "prod a (- b) = - prod a b"
   by (rule additive.minus [OF additive_right])
 
 lemma diff_left: "prod (a - a') b = prod a b - prod a' b"
   by (rule additive.diff [OF additive_left])
 
 lemma diff_right: "prod a (b - b') = prod a b - prod a b'"
   by (rule additive.diff [OF additive_right])
 
 lemma sum_left: "prod (sum g S) x = sum ((\<lambda>i. prod (g i) x)) S"
   by (rule additive.sum [OF additive_left])
 
 lemma sum_right: "prod x (sum g S) = sum ((\<lambda>i. (prod x (g i)))) S"
   by (rule additive.sum [OF additive_right])
 
 
 lemma bounded_linear_left: "bounded_linear (\<lambda>a. a ** b)"
 proof -
   obtain K where "\<And>a b. norm (a ** b) \<le> norm a * norm b * K"
     using pos_bounded by blast
   then show ?thesis
     by (rule_tac K="norm b * K" in bounded_linear_intro) (auto simp: algebra_simps scaleR_left add_left)
 qed
 
 lemma bounded_linear_right: "bounded_linear (\<lambda>b. a ** b)"
 proof -
   obtain K where "\<And>a b. norm (a ** b) \<le> norm a * norm b * K"
     using pos_bounded by blast
   then show ?thesis
     by (rule_tac K="norm a * K" in bounded_linear_intro) (auto simp: algebra_simps scaleR_right add_right)
 qed
 
 lemma prod_diff_prod: "(x ** y - a ** b) = (x - a) ** (y - b) + (x - a) ** b + a ** (y - b)"
   by (simp add: diff_left diff_right)
 
 lemma flip: "bounded_bilinear (\<lambda>x y. y ** x)"
 proof
   show "\<exists>K. \<forall>a b. norm (b ** a) \<le> norm a * norm b * K"
     by (metis bounded mult.commute)
 qed (simp_all add: add_right add_left scaleR_right scaleR_left)
 
 lemma comp1:
   assumes "bounded_linear g"
   shows "bounded_bilinear (\<lambda>x. (**) (g x))"
 proof unfold_locales
   interpret g: bounded_linear g by fact
   show "\<And>a a' b. g (a + a') ** b = g a ** b + g a' ** b"
     "\<And>a b b'. g a ** (b + b') = g a ** b + g a ** b'"
     "\<And>r a b. g (r *\<^sub>R a) ** b = r *\<^sub>R (g a ** b)"
     "\<And>a r b. g a ** (r *\<^sub>R b) = r *\<^sub>R (g a ** b)"
     by (auto simp: g.add add_left add_right g.scaleR scaleR_left scaleR_right)
   from g.nonneg_bounded nonneg_bounded obtain K L
     where nn: "0 \<le> K" "0 \<le> L"
       and K: "\<And>x. norm (g x) \<le> norm x * K"
       and L: "\<And>a b. norm (a ** b) \<le> norm a * norm b * L"
     by auto
   have "norm (g a ** b) \<le> norm a * K * norm b * L" for a b
     by (auto intro!:  order_trans[OF K] order_trans[OF L] mult_mono simp: nn)
   then show "\<exists>K. \<forall>a b. norm (g a ** b) \<le> norm a * norm b * K"
     by (auto intro!: exI[where x="K * L"] simp: ac_simps)
 qed
 
 lemma comp: "bounded_linear f \<Longrightarrow> bounded_linear g \<Longrightarrow> bounded_bilinear (\<lambda>x y. f x ** g y)"
   by (rule bounded_bilinear.flip[OF bounded_bilinear.comp1[OF bounded_bilinear.flip[OF comp1]]])
 
 end
 
 lemma bounded_linear_ident[simp]: "bounded_linear (\<lambda>x. x)"
   by standard (auto intro!: exI[of _ 1])
 
 lemma bounded_linear_zero[simp]: "bounded_linear (\<lambda>x. 0)"
   by standard (auto intro!: exI[of _ 1])
 
 lemma bounded_linear_add:
   assumes "bounded_linear f"
     and "bounded_linear g"
   shows "bounded_linear (\<lambda>x. f x + g x)"
 proof -
   interpret f: bounded_linear f by fact
   interpret g: bounded_linear g by fact
   show ?thesis
   proof
     from f.bounded obtain Kf where Kf: "norm (f x) \<le> norm x * Kf" for x
       by blast
     from g.bounded obtain Kg where Kg: "norm (g x) \<le> norm x * Kg" for x
       by blast
     show "\<exists>K. \<forall>x. norm (f x + g x) \<le> norm x * K"
       using add_mono[OF Kf Kg]
       by (intro exI[of _ "Kf + Kg"]) (auto simp: field_simps intro: norm_triangle_ineq order_trans)
   qed (simp_all add: f.add g.add f.scaleR g.scaleR scaleR_right_distrib)
 qed
 
 lemma bounded_linear_minus:
   assumes "bounded_linear f"
   shows "bounded_linear (\<lambda>x. - f x)"
 proof -
   interpret f: bounded_linear f by fact
   show ?thesis
     by unfold_locales (simp_all add: f.add f.scaleR f.bounded)
 qed
 
 lemma bounded_linear_sub: "bounded_linear f \<Longrightarrow> bounded_linear g \<Longrightarrow> bounded_linear (\<lambda>x. f x - g x)"
   using bounded_linear_add[of f "\<lambda>x. - g x"] bounded_linear_minus[of g]
   by (auto simp: algebra_simps)
 
 lemma bounded_linear_sum:
   fixes f :: "'i \<Rightarrow> 'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
   shows "(\<And>i. i \<in> I \<Longrightarrow> bounded_linear (f i)) \<Longrightarrow> bounded_linear (\<lambda>x. \<Sum>i\<in>I. f i x)"
   by (induct I rule: infinite_finite_induct) (auto intro!: bounded_linear_add)
 
 lemma bounded_linear_compose:
   assumes "bounded_linear f"
     and "bounded_linear g"
   shows "bounded_linear (\<lambda>x. f (g x))"
 proof -
   interpret f: bounded_linear f by fact
   interpret g: bounded_linear g by fact
   show ?thesis
   proof unfold_locales
     show "f (g (x + y)) = f (g x) + f (g y)" for x y
       by (simp only: f.add g.add)
     show "f (g (scaleR r x)) = scaleR r (f (g x))" for r x
       by (simp only: f.scaleR g.scaleR)
     from f.pos_bounded obtain Kf where f: "\<And>x. norm (f x) \<le> norm x * Kf" and Kf: "0 < Kf"
       by blast
     from g.pos_bounded obtain Kg where g: "\<And>x. norm (g x) \<le> norm x * Kg"
       by blast
     show "\<exists>K. \<forall>x. norm (f (g x)) \<le> norm x * K"
     proof (intro exI allI)
       fix x
       have "norm (f (g x)) \<le> norm (g x) * Kf"
         using f .
       also have "\<dots> \<le> (norm x * Kg) * Kf"
         using g Kf [THEN order_less_imp_le] by (rule mult_right_mono)
       also have "(norm x * Kg) * Kf = norm x * (Kg * Kf)"
         by (rule mult.assoc)
       finally show "norm (f (g x)) \<le> norm x * (Kg * Kf)" .
     qed
   qed
 qed
 
 lemma bounded_bilinear_mult: "bounded_bilinear ((*) :: 'a \<Rightarrow> 'a \<Rightarrow> 'a::real_normed_algebra)"
 proof (rule bounded_bilinear.intro)
   show "\<exists>K. \<forall>a b::'a. norm (a * b) \<le> norm a * norm b * K"
     by (rule_tac x=1 in exI) (simp add: norm_mult_ineq)
 qed (auto simp: algebra_simps)
 
 lemma bounded_linear_mult_left: "bounded_linear (\<lambda>x::'a::real_normed_algebra. x * y)"
   using bounded_bilinear_mult
   by (rule bounded_bilinear.bounded_linear_left)
 
 lemma bounded_linear_mult_right: "bounded_linear (\<lambda>y::'a::real_normed_algebra. x * y)"
   using bounded_bilinear_mult
   by (rule bounded_bilinear.bounded_linear_right)
 
 lemmas bounded_linear_mult_const =
   bounded_linear_mult_left [THEN bounded_linear_compose]
 
 lemmas bounded_linear_const_mult =
   bounded_linear_mult_right [THEN bounded_linear_compose]
 
 lemma bounded_linear_divide: "bounded_linear (\<lambda>x. x / y)"
   for y :: "'a::real_normed_field"
   unfolding divide_inverse by (rule bounded_linear_mult_left)
 
 lemma bounded_bilinear_scaleR: "bounded_bilinear scaleR"
 proof (rule bounded_bilinear.intro)
   show "\<exists>K. \<forall>a b. norm (a *\<^sub>R b) \<le> norm a * norm b * K"
     using less_eq_real_def by auto
 qed (auto simp: algebra_simps)
 
 lemma bounded_linear_scaleR_left: "bounded_linear (\<lambda>r. scaleR r x)"
   using bounded_bilinear_scaleR
   by (rule bounded_bilinear.bounded_linear_left)
 
 lemma bounded_linear_scaleR_right: "bounded_linear (\<lambda>x. scaleR r x)"
   using bounded_bilinear_scaleR
   by (rule bounded_bilinear.bounded_linear_right)
 
 lemmas bounded_linear_scaleR_const =
   bounded_linear_scaleR_left[THEN bounded_linear_compose]
 
 lemmas bounded_linear_const_scaleR =
   bounded_linear_scaleR_right[THEN bounded_linear_compose]
 
 lemma bounded_linear_of_real: "bounded_linear (\<lambda>r. of_real r)"
   unfolding of_real_def by (rule bounded_linear_scaleR_left)
 
 lemma real_bounded_linear: "bounded_linear f \<longleftrightarrow> (\<exists>c::real. f = (\<lambda>x. x * c))"
   for f :: "real \<Rightarrow> real"
 proof -
   {
     fix x
     assume "bounded_linear f"
     then interpret bounded_linear f .
     from scaleR[of x 1] have "f x = x * f 1"
       by simp
   }
   then show ?thesis
     by (auto intro: exI[of _ "f 1"] bounded_linear_mult_left)
 qed
 
 instance real_normed_algebra_1 \<subseteq> perfect_space
 proof
   fix x::'a
   have "\<And>e. 0 < e \<Longrightarrow> \<exists>y. norm (y - x) < e \<and> y \<noteq> x"
     by (rule_tac x = "x + of_real (e/2)" in exI) auto
   then show "\<not> open {x}" 
     by (clarsimp simp: open_dist dist_norm)
 qed
 
 
 subsection \<open>Filters and Limits on Metric Space\<close>
 
 lemma (in metric_space) nhds_metric: "nhds x = (INF e\<in>{0 <..}. principal {y. dist y x < e})"
   unfolding nhds_def
 proof (safe intro!: INF_eq)
   fix S
   assume "open S" "x \<in> S"
   then obtain e where "{y. dist y x < e} \<subseteq> S" "0 < e"
     by (auto simp: open_dist subset_eq)
   then show "\<exists>e\<in>{0<..}. principal {y. dist y x < e} \<le> principal S"
     by auto
 qed (auto intro!: exI[of _ "{y. dist x y < e}" for e] open_ball simp: dist_commute)
 
 (* Contributed by Dominique Unruh *)
 lemma tendsto_iff_uniformity:
     \<comment> \<open>More general analogus of \<open>tendsto_iff\<close> below. Applies to all uniform spaces, not just metric ones.\<close>
   fixes l :: \<open>'b :: uniform_space\<close>
   shows \<open>(f \<longlongrightarrow> l) F \<longleftrightarrow> (\<forall>E. eventually E uniformity \<longrightarrow> (\<forall>\<^sub>F x in F. E (f x, l)))\<close>
 proof (intro iffI allI impI)
   fix E :: \<open>('b \<times> 'b) \<Rightarrow> bool\<close>
   assume \<open>(f \<longlongrightarrow> l) F\<close> and \<open>eventually E uniformity\<close>
   from \<open>eventually E uniformity\<close>
   have \<open>eventually (\<lambda>(x, y). E (y, x)) uniformity\<close>
     by (simp add: uniformity_sym)
   then have \<open>\<forall>\<^sub>F (y, x) in uniformity. y = l \<longrightarrow> E (x, y)\<close>
     using eventually_mono by fastforce
   with \<open>(f \<longlongrightarrow> l) F\<close> have \<open>eventually (\<lambda>x. E (x ,l)) (filtermap f F)\<close>
     by (simp add: filterlim_def le_filter_def eventually_nhds_uniformity)
   then show \<open>\<forall>\<^sub>F x in F. E (f x, l)\<close>
     by (simp add: eventually_filtermap)
 next
   assume assm: \<open>\<forall>E. eventually E uniformity \<longrightarrow> (\<forall>\<^sub>F x in F. E (f x, l))\<close>
   have \<open>eventually P (filtermap f F)\<close> if \<open>\<forall>\<^sub>F (x, y) in uniformity. x = l \<longrightarrow> P y\<close> for P
   proof -
     from that have \<open>\<forall>\<^sub>F (y, x) in uniformity. x = l \<longrightarrow> P y\<close> 
       using uniformity_sym[where E=\<open>\<lambda>(x,y). x=l \<longrightarrow> P y\<close>] by auto
     with assm have \<open>\<forall>\<^sub>F x in F. P (f x)\<close>
       by auto
     then show ?thesis
       by (auto simp: eventually_filtermap)
   qed
   then show \<open>(f \<longlongrightarrow> l) F\<close>
     by (simp add: filterlim_def le_filter_def eventually_nhds_uniformity)
 qed
 
 lemma (in metric_space) tendsto_iff: "(f \<longlongrightarrow> l) F \<longleftrightarrow> (\<forall>e>0. eventually (\<lambda>x. dist (f x) l < e) F)"
   unfolding nhds_metric filterlim_INF filterlim_principal by auto
 
 lemma tendsto_dist_iff:
   "((f \<longlongrightarrow> l) F) \<longleftrightarrow> (((\<lambda>x. dist (f x) l) \<longlongrightarrow> 0) F)"
   unfolding tendsto_iff by simp
 
 lemma (in metric_space) tendstoI [intro?]:
   "(\<And>e. 0 < e \<Longrightarrow> eventually (\<lambda>x. dist (f x) l < e) F) \<Longrightarrow> (f \<longlongrightarrow> l) F"
   by (auto simp: tendsto_iff)
 
 lemma (in metric_space) tendstoD: "(f \<longlongrightarrow> l) F \<Longrightarrow> 0 < e \<Longrightarrow> eventually (\<lambda>x. dist (f x) l < e) F"
   by (auto simp: tendsto_iff)
 
 lemma (in metric_space) eventually_nhds_metric:
   "eventually P (nhds a) \<longleftrightarrow> (\<exists>d>0. \<forall>x. dist x a < d \<longrightarrow> P x)"
   unfolding nhds_metric
   by (subst eventually_INF_base)
      (auto simp: eventually_principal Bex_def subset_eq intro: exI[of _ "min a b" for a b])
 
 lemma eventually_at: "eventually P (at a within S) \<longleftrightarrow> (\<exists>d>0. \<forall>x\<in>S. x \<noteq> a \<and> dist x a < d \<longrightarrow> P x)"
   for a :: "'a :: metric_space"
   by (auto simp: eventually_at_filter eventually_nhds_metric)
 
 lemma frequently_at: "frequently P (at a within S) \<longleftrightarrow> (\<forall>d>0. \<exists>x\<in>S. x \<noteq> a \<and> dist x a < d \<and> P x)"
   for a :: "'a :: metric_space"
   unfolding frequently_def eventually_at by auto
 
 lemma eventually_at_le: "eventually P (at a within S) \<longleftrightarrow> (\<exists>d>0. \<forall>x\<in>S. x \<noteq> a \<and> dist x a \<le> d \<longrightarrow> P x)"
   for a :: "'a::metric_space"
   unfolding eventually_at_filter eventually_nhds_metric
   apply safe
   apply (rule_tac x="d / 2" in exI, auto)
   done
 
 lemma eventually_at_left_real: "a > (b :: real) \<Longrightarrow> eventually (\<lambda>x. x \<in> {b<..<a}) (at_left a)"
   by (subst eventually_at, rule exI[of _ "a - b"]) (force simp: dist_real_def)
 
 lemma eventually_at_right_real: "a < (b :: real) \<Longrightarrow> eventually (\<lambda>x. x \<in> {a<..<b}) (at_right a)"
   by (subst eventually_at, rule exI[of _ "b - a"]) (force simp: dist_real_def)
 
 lemma metric_tendsto_imp_tendsto:
   fixes a :: "'a :: metric_space"
     and b :: "'b :: metric_space"
   assumes f: "(f \<longlongrightarrow> a) F"
     and le: "eventually (\<lambda>x. dist (g x) b \<le> dist (f x) a) F"
   shows "(g \<longlongrightarrow> b) F"
 proof (rule tendstoI)
   fix e :: real
   assume "0 < e"
   with f have "eventually (\<lambda>x. dist (f x) a < e) F" by (rule tendstoD)
   with le show "eventually (\<lambda>x. dist (g x) b < e) F"
     using le_less_trans by (rule eventually_elim2)
 qed
 
 lemma filterlim_real_sequentially: "LIM x sequentially. real x :> at_top"
 proof (clarsimp simp: filterlim_at_top)
   fix Z
   show "\<forall>\<^sub>F x in sequentially. Z \<le> real x"
     by (meson eventually_sequentiallyI nat_ceiling_le_eq)
 qed
 
 lemma filterlim_nat_sequentially: "filterlim nat sequentially at_top"
 proof -
   have "\<forall>\<^sub>F x in at_top. Z \<le> nat x" for Z
     by (auto intro!: eventually_at_top_linorderI[where c="int Z"])
   then show ?thesis
     unfolding filterlim_at_top ..
 qed
 
 lemma filterlim_floor_sequentially: "filterlim floor at_top at_top"
 proof -
   have "\<forall>\<^sub>F x in at_top. Z \<le> \<lfloor>x\<rfloor>" for Z
     by (auto simp: le_floor_iff intro!: eventually_at_top_linorderI[where c="of_int Z"])
   then show ?thesis
     unfolding filterlim_at_top ..
 qed
 
 lemma filterlim_sequentially_iff_filterlim_real:
   "filterlim f sequentially F \<longleftrightarrow> filterlim (\<lambda>x. real (f x)) at_top F" (is "?lhs = ?rhs")
 proof
   assume ?lhs then show ?rhs
     using filterlim_compose filterlim_real_sequentially by blast
 next
   assume R: ?rhs
   show ?lhs
   proof -
     have "filterlim (\<lambda>x. nat (floor (real (f x)))) sequentially F"
       by (intro filterlim_compose[OF filterlim_nat_sequentially]
           filterlim_compose[OF filterlim_floor_sequentially] R)
     then show ?thesis by simp
   qed
 qed
 
 
 subsubsection \<open>Limits of Sequences\<close>
 
 lemma lim_sequentially: "X \<longlonglongrightarrow> L \<longleftrightarrow> (\<forall>r>0. \<exists>no. \<forall>n\<ge>no. dist (X n) L < r)"
   for L :: "'a::metric_space"
   unfolding tendsto_iff eventually_sequentially ..
 
 lemmas LIMSEQ_def = lim_sequentially  (*legacy binding*)
 
 lemma LIMSEQ_iff_nz: "X \<longlonglongrightarrow> L \<longleftrightarrow> (\<forall>r>0. \<exists>no>0. \<forall>n\<ge>no. dist (X n) L < r)"
   for L :: "'a::metric_space"
   unfolding lim_sequentially by (metis Suc_leD zero_less_Suc)
 
 lemma metric_LIMSEQ_I: "(\<And>r. 0 < r \<Longrightarrow> \<exists>no. \<forall>n\<ge>no. dist (X n) L < r) \<Longrightarrow> X \<longlonglongrightarrow> L"
   for L :: "'a::metric_space"
   by (simp add: lim_sequentially)
 
 lemma metric_LIMSEQ_D: "X \<longlonglongrightarrow> L \<Longrightarrow> 0 < r \<Longrightarrow> \<exists>no. \<forall>n\<ge>no. dist (X n) L < r"
   for L :: "'a::metric_space"
   by (simp add: lim_sequentially)
 
 lemma LIMSEQ_norm_0:
   assumes  "\<And>n::nat. norm (f n) < 1 / real (Suc n)"
   shows "f \<longlonglongrightarrow> 0"
 proof (rule metric_LIMSEQ_I)
   fix \<epsilon> :: "real"
   assume "\<epsilon> > 0"
   then obtain N::nat where "\<epsilon> > inverse N" "N > 0"
     by (metis neq0_conv real_arch_inverse)
   then have "norm (f n) < \<epsilon>" if "n \<ge> N" for n
   proof -
     have "1 / (Suc n) \<le> 1 / N"
       using \<open>0 < N\<close> inverse_of_nat_le le_SucI that by blast
     also have "\<dots> < \<epsilon>"
       by (metis (no_types) \<open>inverse (real N) < \<epsilon>\<close> inverse_eq_divide)
     finally show ?thesis
       by (meson assms less_eq_real_def not_le order_trans)
   qed
   then show "\<exists>no. \<forall>n\<ge>no. dist (f n) 0 < \<epsilon>"
     by auto
 qed
 
 
 subsubsection \<open>Limits of Functions\<close>
 
 lemma LIM_def: "f \<midarrow>a\<rightarrow> L \<longleftrightarrow> (\<forall>r > 0. \<exists>s > 0. \<forall>x. x \<noteq> a \<and> dist x a < s \<longrightarrow> dist (f x) L < r)"
   for a :: "'a::metric_space" and L :: "'b::metric_space"
   unfolding tendsto_iff eventually_at by simp
 
 lemma metric_LIM_I:
   "(\<And>r. 0 < r \<Longrightarrow> \<exists>s>0. \<forall>x. x \<noteq> a \<and> dist x a < s \<longrightarrow> dist (f x) L < r) \<Longrightarrow> f \<midarrow>a\<rightarrow> L"
   for a :: "'a::metric_space" and L :: "'b::metric_space"
   by (simp add: LIM_def)
 
 lemma metric_LIM_D: "f \<midarrow>a\<rightarrow> L \<Longrightarrow> 0 < r \<Longrightarrow> \<exists>s>0. \<forall>x. x \<noteq> a \<and> dist x a < s \<longrightarrow> dist (f x) L < r"
   for a :: "'a::metric_space" and L :: "'b::metric_space"
   by (simp add: LIM_def)
 
 lemma metric_LIM_imp_LIM:
   fixes l :: "'a::metric_space"
     and m :: "'b::metric_space"
   assumes f: "f \<midarrow>a\<rightarrow> l"
     and le: "\<And>x. x \<noteq> a \<Longrightarrow> dist (g x) m \<le> dist (f x) l"
   shows "g \<midarrow>a\<rightarrow> m"
   by (rule metric_tendsto_imp_tendsto [OF f]) (auto simp: eventually_at_topological le)
 
 lemma metric_LIM_equal2:
   fixes a :: "'a::metric_space"
   assumes "g \<midarrow>a\<rightarrow> l" "0 < R"
     and "\<And>x. x \<noteq> a \<Longrightarrow> dist x a < R \<Longrightarrow> f x = g x"
   shows "f \<midarrow>a\<rightarrow> l"
 proof -
   have "\<And>S. \<lbrakk>open S; l \<in> S; \<forall>\<^sub>F x in at a. g x \<in> S\<rbrakk> \<Longrightarrow> \<forall>\<^sub>F x in at a. f x \<in> S"
     apply (simp add: eventually_at)
     by (metis assms(2) assms(3) dual_order.strict_trans linorder_neqE_linordered_idom)
   then show ?thesis
     using assms by (simp add: tendsto_def)
 qed
 
 lemma metric_LIM_compose2:
   fixes a :: "'a::metric_space"
   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> dist x a < d \<longrightarrow> f x \<noteq> b"
   shows "(\<lambda>x. g (f x)) \<midarrow>a\<rightarrow> c"
   using inj by (intro tendsto_compose_eventually[OF g f]) (auto simp: eventually_at)
 
 lemma metric_isCont_LIM_compose2:
   fixes f :: "'a :: metric_space \<Rightarrow> _"
   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> dist x a < d \<longrightarrow> f x \<noteq> f a"
   shows "(\<lambda>x. g (f x)) \<midarrow>a\<rightarrow> l"
   by (rule metric_LIM_compose2 [OF f g inj])
 
 
 subsection \<open>Complete metric spaces\<close>
 
 subsection \<open>Cauchy sequences\<close>
 
 lemma (in metric_space) Cauchy_def: "Cauchy X = (\<forall>e>0. \<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (X m) (X n) < e)"
 proof -
   have *: "eventually P (INF M. principal {(X m, X n) | n m. m \<ge> M \<and> n \<ge> M}) \<longleftrightarrow>
     (\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. P (X m, X n))" for P
     apply (subst eventually_INF_base)
     subgoal by simp
     subgoal for a b
       by (intro bexI[of _ "max a b"]) (auto simp: eventually_principal subset_eq)
     subgoal by (auto simp: eventually_principal, blast)
     done
   have "Cauchy X \<longleftrightarrow> (INF M. principal {(X m, X n) | n m. m \<ge> M \<and> n \<ge> M}) \<le> uniformity"
     unfolding Cauchy_uniform_iff le_filter_def * ..
   also have "\<dots> = (\<forall>e>0. \<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (X m) (X n) < e)"
     unfolding uniformity_dist le_INF_iff by (auto simp: * le_principal)
   finally show ?thesis .
 qed
 
 lemma (in metric_space) Cauchy_altdef: "Cauchy f \<longleftrightarrow> (\<forall>e>0. \<exists>M. \<forall>m\<ge>M. \<forall>n>m. dist (f m) (f n) < e)"
   (is "?lhs \<longleftrightarrow> ?rhs")
 proof
   assume ?rhs
   show ?lhs
     unfolding Cauchy_def
   proof (intro allI impI)
     fix e :: real assume e: "e > 0"
     with \<open>?rhs\<close> obtain M where M: "m \<ge> M \<Longrightarrow> n > m \<Longrightarrow> dist (f m) (f n) < e" for m n
       by blast
     have "dist (f m) (f n) < e" if "m \<ge> M" "n \<ge> M" for m n
       using M[of m n] M[of n m] e that by (cases m n rule: linorder_cases) (auto simp: dist_commute)
     then show "\<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (f m) (f n) < e"
       by blast
   qed
 next
   assume ?lhs
   show ?rhs
   proof (intro allI impI)
     fix e :: real
     assume e: "e > 0"
     with \<open>Cauchy f\<close> obtain M where "\<And>m n. m \<ge> M \<Longrightarrow> n \<ge> M \<Longrightarrow> dist (f m) (f n) < e"
       unfolding Cauchy_def by blast
     then show "\<exists>M. \<forall>m\<ge>M. \<forall>n>m. dist (f m) (f n) < e"
       by (intro exI[of _ M]) force
   qed
 qed
 
 lemma (in metric_space) Cauchy_altdef2: "Cauchy s \<longleftrightarrow> (\<forall>e>0. \<exists>N::nat. \<forall>n\<ge>N. dist(s n)(s N) < e)" (is "?lhs = ?rhs")
 proof 
   assume "Cauchy s"
   then show ?rhs by (force simp: Cauchy_def)
 next
     assume ?rhs
     {
       fix e::real
       assume "e>0"
       with \<open>?rhs\<close> obtain N where N: "\<forall>n\<ge>N. dist (s n) (s N) < e/2"
         by (erule_tac x="e/2" in allE) auto
       {
         fix n m
         assume nm: "N \<le> m \<and> N \<le> n"
         then have "dist (s m) (s n) < e" using N
           using dist_triangle_half_l[of "s m" "s N" "e" "s n"]
           by blast
       }
       then have "\<exists>N. \<forall>m n. N \<le> m \<and> N \<le> n \<longrightarrow> dist (s m) (s n) < e"
         by blast
     }
     then have ?lhs
       unfolding Cauchy_def by blast
   then show ?lhs
     by blast
 qed
 
 lemma (in metric_space) metric_CauchyI:
   "(\<And>e. 0 < e \<Longrightarrow> \<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (X m) (X n) < e) \<Longrightarrow> Cauchy X"
   by (simp add: Cauchy_def)
 
 lemma (in metric_space) CauchyI':
   "(\<And>e. 0 < e \<Longrightarrow> \<exists>M. \<forall>m\<ge>M. \<forall>n>m. dist (X m) (X n) < e) \<Longrightarrow> Cauchy X"
   unfolding Cauchy_altdef by blast
 
 lemma (in metric_space) metric_CauchyD:
   "Cauchy X \<Longrightarrow> 0 < e \<Longrightarrow> \<exists>M. \<forall>m\<ge>M. \<forall>n\<ge>M. dist (X m) (X n) < e"
   by (simp add: Cauchy_def)
 
 lemma (in metric_space) metric_Cauchy_iff2:
   "Cauchy X = (\<forall>j. (\<exists>M. \<forall>m \<ge> M. \<forall>n \<ge> M. dist (X m) (X n) < inverse(real (Suc j))))"
   apply (auto simp add: Cauchy_def)
   by (metis less_trans of_nat_Suc reals_Archimedean)
 
 lemma Cauchy_iff2: "Cauchy X \<longleftrightarrow> (\<forall>j. (\<exists>M. \<forall>m \<ge> M. \<forall>n \<ge> M. \<bar>X m - X n\<bar> < inverse (real (Suc j))))"
   by (simp only: metric_Cauchy_iff2 dist_real_def)
 
 lemma lim_1_over_n [tendsto_intros]: "((\<lambda>n. 1 / of_nat n) \<longlongrightarrow> (0::'a::real_normed_field)) sequentially"
 proof (subst lim_sequentially, intro allI impI exI)
   fix e::real and n
   assume e: "e > 0" 
   have "inverse e < of_nat (nat \<lceil>inverse e + 1\<rceil>)" by linarith
   also assume "n \<ge> nat \<lceil>inverse e + 1\<rceil>"
   finally show "dist (1 / of_nat n :: 'a) 0 < e"
     using e by (simp add: field_split_simps norm_divide)
 qed
 
 lemma (in metric_space) complete_def:
   shows "complete S = (\<forall>f. (\<forall>n. f n \<in> S) \<and> Cauchy f \<longrightarrow> (\<exists>l\<in>S. f \<longlonglongrightarrow> l))"
   unfolding complete_uniform
 proof safe
   fix f :: "nat \<Rightarrow> 'a"
   assume f: "\<forall>n. f n \<in> S" "Cauchy f"
     and *: "\<forall>F\<le>principal S. F \<noteq> bot \<longrightarrow> cauchy_filter F \<longrightarrow> (\<exists>x\<in>S. F \<le> nhds x)"
   then show "\<exists>l\<in>S. f \<longlonglongrightarrow> l"
     unfolding filterlim_def using f
     by (intro *[rule_format])
        (auto simp: filtermap_sequentually_ne_bot le_principal eventually_filtermap Cauchy_uniform)
 next
   fix F :: "'a filter"
   assume "F \<le> principal S" "F \<noteq> bot" "cauchy_filter F"
   assume seq: "\<forall>f. (\<forall>n. f n \<in> S) \<and> Cauchy f \<longrightarrow> (\<exists>l\<in>S. f \<longlonglongrightarrow> l)"
 
   from \<open>F \<le> principal S\<close> \<open>cauchy_filter F\<close>
   have FF_le: "F \<times>\<^sub>F F \<le> uniformity_on S"
     by (simp add: cauchy_filter_def principal_prod_principal[symmetric] prod_filter_mono)
 
   let ?P = "\<lambda>P e. eventually P F \<and> (\<forall>x. P x \<longrightarrow> x \<in> S) \<and> (\<forall>x y. P x \<longrightarrow> P y \<longrightarrow> dist x y < e)"
   have P: "\<exists>P. ?P P \<epsilon>" if "0 < \<epsilon>" for \<epsilon> :: real
   proof -
     from that have "eventually (\<lambda>(x, y). x \<in> S \<and> y \<in> S \<and> dist x y < \<epsilon>) (uniformity_on S)"
       by (auto simp: eventually_inf_principal eventually_uniformity_metric)
     from filter_leD[OF FF_le this] show ?thesis
       by (auto simp: eventually_prod_same)
   qed
 
   have "\<exists>P. \<forall>n. ?P (P n) (1 / Suc n) \<and> P (Suc n) \<le> P n"
   proof (rule dependent_nat_choice)
     show "\<exists>P. ?P P (1 / Suc 0)"
       using P[of 1] by auto
   next
     fix P n assume "?P P (1/Suc n)"
     moreover obtain Q where "?P Q (1 / Suc (Suc n))"
       using P[of "1/Suc (Suc n)"] by auto
     ultimately show "\<exists>Q. ?P Q (1 / Suc (Suc n)) \<and> Q \<le> P"
       by (intro exI[of _ "\<lambda>x. P x \<and> Q x"]) (auto simp: eventually_conj_iff)
   qed
   then obtain P where P: "eventually (P n) F" "P n x \<Longrightarrow> x \<in> S"
     "P n x \<Longrightarrow> P n y \<Longrightarrow> dist x y < 1 / Suc n" "P (Suc n) \<le> P n"
     for n x y
     by metis
   have "antimono P"
     using P(4) by (rule decseq_SucI)
 
   obtain X where X: "P n (X n)" for n
     using P(1)[THEN eventually_happens'[OF \<open>F \<noteq> bot\<close>]] by metis
   have "Cauchy X"
     unfolding metric_Cauchy_iff2 inverse_eq_divide
   proof (intro exI allI impI)
     fix j m n :: nat
     assume "j \<le> m" "j \<le> n"
     with \<open>antimono P\<close> X have "P j (X m)" "P j (X n)"
       by (auto simp: antimono_def)
     then show "dist (X m) (X n) < 1 / Suc j"
       by (rule P)
   qed
   moreover have "\<forall>n. X n \<in> S"
     using P(2) X by auto
   ultimately obtain x where "X \<longlonglongrightarrow> x" "x \<in> S"
     using seq by blast
 
   show "\<exists>x\<in>S. F \<le> nhds x"
   proof (rule bexI)
     have "eventually (\<lambda>y. dist y x < e) F" if "0 < e" for e :: real
     proof -
       from that have "(\<lambda>n. 1 / Suc n :: real) \<longlonglongrightarrow> 0 \<and> 0 < e / 2"
         by (subst filterlim_sequentially_Suc) (auto intro!: lim_1_over_n)
       then have "\<forall>\<^sub>F n in sequentially. dist (X n) x < e / 2 \<and> 1 / Suc n < e / 2"
         using \<open>X \<longlonglongrightarrow> x\<close>
         unfolding tendsto_iff order_tendsto_iff[where 'a=real] eventually_conj_iff
         by blast
       then obtain n where "dist x (X n) < e / 2" "1 / Suc n < e / 2"
         by (auto simp: eventually_sequentially dist_commute)
       show ?thesis
         using \<open>eventually (P n) F\<close>
       proof eventually_elim
         case (elim y)
         then have "dist y (X n) < 1 / Suc n"
           by (intro X P)
         also have "\<dots> < e / 2" by fact
         finally show "dist y x < e"
           by (rule dist_triangle_half_l) fact
       qed
     qed
     then show "F \<le> nhds x"
       unfolding nhds_metric le_INF_iff le_principal by auto
   qed fact
 qed
 
 text\<open>apparently unused\<close>
 lemma (in metric_space) totally_bounded_metric:
   "totally_bounded S \<longleftrightarrow> (\<forall>e>0. \<exists>k. finite k \<and> S \<subseteq> (\<Union>x\<in>k. {y. dist x y < e}))"
   unfolding totally_bounded_def eventually_uniformity_metric imp_ex
   apply (subst all_comm)
   apply (intro arg_cong[where f=All] ext, safe)
   subgoal for e
     apply (erule allE[of _ "\<lambda>(x, y). dist x y < e"])
     apply auto
     done
   subgoal for e P k
     apply (intro exI[of _ k])
     apply (force simp: subset_eq)
     done
   done
 
 
 setup \<open>Sign.add_const_constraint (\<^const_name>\<open>dist\<close>, SOME \<^typ>\<open>'a::dist \<Rightarrow> 'a \<Rightarrow> real\<close>)\<close>
 
 (* Contributed by Dominique Unruh *)
 lemma cauchy_filter_metric:
   fixes F :: "'a::{uniformity_dist,uniform_space} filter"
   shows "cauchy_filter F \<longleftrightarrow> (\<forall>e. e>0 \<longrightarrow> (\<exists>P. eventually P F \<and> (\<forall>x y. P x \<and> P y \<longrightarrow> dist x y < e)))"
 proof (unfold cauchy_filter_def le_filter_def, auto)
   assume assm: \<open>\<forall>e>0. \<exists>P. eventually P F \<and> (\<forall>x y. P x \<and> P y \<longrightarrow> dist x y < e)\<close>
   then show \<open>eventually P uniformity \<Longrightarrow> eventually P (F \<times>\<^sub>F F)\<close> for P
     apply (auto simp: eventually_uniformity_metric)
     using eventually_prod_same by blast
 next
   fix e :: real
   assume \<open>e > 0\<close>
   assume asm: \<open>\<forall>P. eventually P uniformity \<longrightarrow> eventually P (F \<times>\<^sub>F F)\<close>
 
   define P where \<open>P \<equiv> \<lambda>(x,y :: 'a). dist x y < e\<close>
   with asm \<open>e > 0\<close> have \<open>eventually P (F \<times>\<^sub>F F)\<close>
     by (metis case_prod_conv eventually_uniformity_metric)
   then
   show \<open>\<exists>P. eventually P F \<and> (\<forall>x y. P x \<and> P y \<longrightarrow> dist x y < e)\<close>
     by (auto simp add: eventually_prod_same P_def)
 qed
 
 (* Contributed by Dominique Unruh *)
 lemma cauchy_filter_metric_filtermap:
   fixes f :: "'a \<Rightarrow> 'b::{uniformity_dist,uniform_space}"
   shows "cauchy_filter (filtermap f F) \<longleftrightarrow> (\<forall>e. e>0 \<longrightarrow> (\<exists>P. eventually P F \<and> (\<forall>x y. P x \<and> P y \<longrightarrow> dist (f x) (f y) < e)))"
 proof (subst cauchy_filter_metric, intro iffI allI impI)
   assume \<open>\<forall>e>0. \<exists>P. eventually P (filtermap f F) \<and> (\<forall>x y. P x \<and> P y \<longrightarrow> dist x y < e)\<close>
   then show \<open>e>0 \<Longrightarrow> \<exists>P. eventually P F \<and> (\<forall>x y. P x \<and> P y \<longrightarrow> dist (f x) (f y) < e)\<close> for e
     unfolding eventually_filtermap by blast
 next
   assume asm: \<open>\<forall>e>0. \<exists>P. eventually P F \<and> (\<forall>x y. P x \<and> P y \<longrightarrow> dist (f x) (f y) < e)\<close>
   fix e::real assume \<open>e > 0\<close>
   then obtain P where \<open>eventually P F\<close> and PPe: \<open>P x \<and> P y \<longrightarrow> dist (f x) (f y) < e\<close> for x y
     using asm by blast
 
   show \<open>\<exists>P. eventually P (filtermap f F) \<and> (\<forall>x y. P x \<and> P y \<longrightarrow> dist x y < e)\<close>
     apply (rule exI[of _ \<open>\<lambda>x. \<exists>y. P y \<and> x = f y\<close>])
     using PPe \<open>eventually P F\<close> apply (auto simp: eventually_filtermap)
     by (smt (verit, ccfv_SIG) eventually_elim2)
 qed
 
 setup \<open>Sign.add_const_constraint (\<^const_name>\<open>dist\<close>, SOME \<^typ>\<open>'a::metric_space \<Rightarrow> 'a \<Rightarrow> real\<close>)\<close>
 
 subsubsection \<open>Cauchy Sequences are Convergent\<close>
 
 (* TODO: update to uniform_space *)
 class complete_space = metric_space +
   assumes Cauchy_convergent: "Cauchy X \<Longrightarrow> convergent X"
 
 lemma Cauchy_convergent_iff: "Cauchy X \<longleftrightarrow> convergent X"
   for X :: "nat \<Rightarrow> 'a::complete_space"
   by (blast intro: Cauchy_convergent convergent_Cauchy)
 
 text \<open>To prove that a Cauchy sequence converges, it suffices to show that a subsequence converges.\<close>
 
 lemma Cauchy_converges_subseq:
   fixes u::"nat \<Rightarrow> 'a::metric_space"
   assumes "Cauchy u"
     "strict_mono r"
     "(u \<circ> r) \<longlonglongrightarrow> l"
   shows "u \<longlonglongrightarrow> l"
 proof -
   have *: "eventually (\<lambda>n. dist (u n) l < e) sequentially" if "e > 0" for e
   proof -
     have "e/2 > 0" using that by auto
     then obtain N1 where N1: "\<And>m n. m \<ge> N1 \<Longrightarrow> n \<ge> N1 \<Longrightarrow> dist (u m) (u n) < e/2"
       using \<open>Cauchy u\<close> unfolding Cauchy_def by blast
     obtain N2 where N2: "\<And>n. n \<ge> N2 \<Longrightarrow> dist ((u \<circ> r) n) l < e / 2"
       using order_tendstoD(2)[OF iffD1[OF tendsto_dist_iff \<open>(u \<circ> r) \<longlonglongrightarrow> l\<close>] \<open>e/2 > 0\<close>]
       unfolding eventually_sequentially by auto
     have "dist (u n) l < e" if "n \<ge> max N1 N2" for n
     proof -
       have "dist (u n) l \<le> dist (u n) ((u \<circ> r) n) + dist ((u \<circ> r) n) l"
         by (rule dist_triangle)
       also have "\<dots> < e/2 + e/2"
       proof (intro add_strict_mono)
         show "dist (u n) ((u \<circ> r) n) < e / 2"
           using N1[of n "r n"] N2[of n] that unfolding comp_def
           by (meson assms(2) le_trans max.bounded_iff strict_mono_imp_increasing)
         show "dist ((u \<circ> r) n) l < e / 2"
           using N2 that by auto
       qed
       finally show ?thesis by simp
     qed 
     then show ?thesis unfolding eventually_sequentially by blast
   qed
   have "(\<lambda>n. dist (u n) l) \<longlonglongrightarrow> 0"
     by (simp add: less_le_trans * order_tendstoI)
   then show ?thesis using tendsto_dist_iff by auto
 qed
 
 subsection \<open>The set of real numbers is a complete metric space\<close>
 
 text \<open>
   Proof that Cauchy sequences converge based on the one from
   \<^url>\<open>http://pirate.shu.edu/~wachsmut/ira/numseq/proofs/cauconv.html\<close>
 \<close>
 
 text \<open>
   If sequence \<^term>\<open>X\<close> is Cauchy, then its limit is the lub of
   \<^term>\<open>{r::real. \<exists>N. \<forall>n\<ge>N. r < X n}\<close>
 \<close>
 lemma increasing_LIMSEQ:
   fixes f :: "nat \<Rightarrow> real"
   assumes inc: "\<And>n. f n \<le> f (Suc n)"
     and bdd: "\<And>n. f n \<le> l"
     and en: "\<And>e. 0 < e \<Longrightarrow> \<exists>n. l \<le> f n + e"
   shows "f \<longlonglongrightarrow> l"
 proof (rule increasing_tendsto)
   fix x
   assume "x < l"
   with dense[of 0 "l - x"] obtain e where "0 < e" "e < l - x"
     by auto
   from en[OF \<open>0 < e\<close>] obtain n where "l - e \<le> f n"
     by (auto simp: field_simps)
   with \<open>e < l - x\<close> \<open>0 < e\<close> have "x < f n"
     by simp
   with incseq_SucI[of f, OF inc] show "eventually (\<lambda>n. x < f n) sequentially"
     by (auto simp: eventually_sequentially incseq_def intro: less_le_trans)
 qed (use bdd in auto)
 
 lemma real_Cauchy_convergent:
   fixes X :: "nat \<Rightarrow> real"
   assumes X: "Cauchy X"
   shows "convergent X"
 proof -
   define S :: "real set" where "S = {x. \<exists>N. \<forall>n\<ge>N. x < X n}"
   then have mem_S: "\<And>N x. \<forall>n\<ge>N. x < X n \<Longrightarrow> x \<in> S"
     by auto
 
   have bound_isUb: "y \<le> x" if N: "\<forall>n\<ge>N. X n < x" and "y \<in> S" for N and x y :: real
   proof -
     from that have "\<exists>M. \<forall>n\<ge>M. y < X n"
       by (simp add: S_def)
     then obtain M where "\<forall>n\<ge>M. y < X n" ..
     then have "y < X (max M N)" by simp
     also have "\<dots> < x" using N by simp
     finally show ?thesis by (rule order_less_imp_le)
   qed
 
   obtain N where "\<forall>m\<ge>N. \<forall>n\<ge>N. dist (X m) (X n) < 1"
     using X[THEN metric_CauchyD, OF zero_less_one] by auto
   then have N: "\<forall>n\<ge>N. dist (X n) (X N) < 1" by simp
   have [simp]: "S \<noteq> {}"
   proof (intro exI ex_in_conv[THEN iffD1])
     from N have "\<forall>n\<ge>N. X N - 1 < X n"
       by (simp add: abs_diff_less_iff dist_real_def)
     then show "X N - 1 \<in> S" by (rule mem_S)
   qed
   have [simp]: "bdd_above S"
   proof
     from N have "\<forall>n\<ge>N. X n < X N + 1"
       by (simp add: abs_diff_less_iff dist_real_def)
     then show "\<And>s. s \<in> S \<Longrightarrow>  s \<le> X N + 1"
       by (rule bound_isUb)
   qed
   have "X \<longlonglongrightarrow> Sup S"
   proof (rule metric_LIMSEQ_I)
     fix r :: real
     assume "0 < r"
     then have r: "0 < r/2" by simp
     obtain N where "\<forall>n\<ge>N. \<forall>m\<ge>N. dist (X n) (X m) < r/2"
       using metric_CauchyD [OF X r] by auto
     then have "\<forall>n\<ge>N. dist (X n) (X N) < r/2" by simp
     then have N: "\<forall>n\<ge>N. X N - r/2 < X n \<and> X n < X N + r/2"
       by (simp only: dist_real_def abs_diff_less_iff)
 
     from N have "\<forall>n\<ge>N. X N - r/2 < X n" by blast
     then have "X N - r/2 \<in> S" by (rule mem_S)
     then have 1: "X N - r/2 \<le> Sup S" by (simp add: cSup_upper)
 
     from N have "\<forall>n\<ge>N. X n < X N + r/2" by blast
     from bound_isUb[OF this]
     have 2: "Sup S \<le> X N + r/2"
       by (intro cSup_least) simp_all
 
     show "\<exists>N. \<forall>n\<ge>N. dist (X n) (Sup S) < r"
     proof (intro exI allI impI)
       fix n
       assume n: "N \<le> n"
       from N n have "X n < X N + r/2" and "X N - r/2 < X n"
         by simp_all
       then show "dist (X n) (Sup S) < r" using 1 2
         by (simp add: abs_diff_less_iff dist_real_def)
     qed
   qed
   then show ?thesis by (auto simp: convergent_def)
 qed
 
 instance real :: complete_space
   by intro_classes (rule real_Cauchy_convergent)
 
 class banach = real_normed_vector + complete_space
 
 instance real :: banach ..
 
 lemma tendsto_at_topI_sequentially:
   fixes f :: "real \<Rightarrow> 'b::first_countable_topology"
   assumes *: "\<And>X. filterlim X at_top sequentially \<Longrightarrow> (\<lambda>n. f (X n)) \<longlonglongrightarrow> y"
   shows "(f \<longlongrightarrow> y) at_top"
 proof -
   obtain A where A: "decseq A" "open (A n)" "y \<in> A n" "nhds y = (INF n. principal (A n))" for n
     by (rule nhds_countable[of y]) (rule that)
 
   have "\<forall>m. \<exists>k. \<forall>x\<ge>k. f x \<in> A m"
   proof (rule ccontr)
     assume "\<not> (\<forall>m. \<exists>k. \<forall>x\<ge>k. f x \<in> A m)"
     then obtain m where "\<And>k. \<exists>x\<ge>k. f x \<notin> A m"
       by auto
     then have "\<exists>X. \<forall>n. (f (X n) \<notin> A m) \<and> max n (X n) + 1 \<le> X (Suc n)"
       by (intro dependent_nat_choice) (auto simp del: max.bounded_iff)
     then obtain X where X: "\<And>n. f (X n) \<notin> A m" "\<And>n. max n (X n) + 1 \<le> X (Suc n)"
       by auto
     have "1 \<le> n \<Longrightarrow> real n \<le> X n" for n
       using X[of "n - 1"] by auto
     then have "filterlim X at_top sequentially"
       by (force intro!: filterlim_at_top_mono[OF filterlim_real_sequentially]
           simp: eventually_sequentially)
     from topological_tendstoD[OF *[OF this] A(2, 3), of m] X(1) show False
       by auto
   qed
   then obtain k where "k m \<le> x \<Longrightarrow> f x \<in> A m" for m x
     by metis
   then show ?thesis
     unfolding at_top_def A by (intro filterlim_base[where i=k]) auto
 qed
 
 lemma tendsto_at_topI_sequentially_real:
   fixes f :: "real \<Rightarrow> real"
   assumes mono: "mono f"
     and limseq: "(\<lambda>n. f (real n)) \<longlonglongrightarrow> y"
   shows "(f \<longlongrightarrow> y) at_top"
 proof (rule tendstoI)
   fix e :: real
   assume "0 < e"
   with limseq obtain N :: nat where N: "N \<le> n \<Longrightarrow> \<bar>f (real n) - y\<bar> < e" for n
     by (auto simp: lim_sequentially dist_real_def)
   have le: "f x \<le> y" for x :: real
   proof -
     obtain n where "x \<le> real_of_nat n"
       using real_arch_simple[of x] ..
     note monoD[OF mono this]
     also have "f (real_of_nat n) \<le> y"
       by (rule LIMSEQ_le_const[OF limseq]) (auto intro!: exI[of _ n] monoD[OF mono])
     finally show ?thesis .
   qed
   have "eventually (\<lambda>x. real N \<le> x) at_top"
     by (rule eventually_ge_at_top)
   then show "eventually (\<lambda>x. dist (f x) y < e) at_top"
   proof eventually_elim
     case (elim x)
     with N[of N] le have "y - f (real N) < e" by auto
     moreover note monoD[OF mono elim]
     ultimately show "dist (f x) y < e"
       using le[of x] by (auto simp: dist_real_def field_simps)
   qed
 qed
 
 end
diff --git a/src/HOL/Topological_Spaces.thy b/src/HOL/Topological_Spaces.thy
--- a/src/HOL/Topological_Spaces.thy
+++ b/src/HOL/Topological_Spaces.thy
@@ -1,3819 +1,3833 @@
 (*  Title:      HOL/Topological_Spaces.thy
     Author:     Brian Huffman
     Author:     Johannes Hölzl
 *)
 
 section \<open>Topological Spaces\<close>
 
 theory Topological_Spaces
   imports Main
 begin
 
 named_theorems continuous_intros "structural introduction rules for continuity"
 
 subsection \<open>Topological space\<close>
 
 class "open" =
   fixes "open" :: "'a set \<Rightarrow> bool"
 
 class topological_space = "open" +
   assumes open_UNIV [simp, intro]: "open UNIV"
   assumes open_Int [intro]: "open S \<Longrightarrow> open T \<Longrightarrow> open (S \<inter> T)"
   assumes open_Union [intro]: "\<forall>S\<in>K. open S \<Longrightarrow> open (\<Union>K)"
 begin
 
 definition closed :: "'a set \<Rightarrow> bool"
   where "closed S \<longleftrightarrow> open (- S)"
 
 lemma open_empty [continuous_intros, intro, simp]: "open {}"
   using open_Union [of "{}"] by simp
 
 lemma open_Un [continuous_intros, intro]: "open S \<Longrightarrow> open T \<Longrightarrow> open (S \<union> T)"
   using open_Union [of "{S, T}"] by simp
 
 lemma open_UN [continuous_intros, intro]: "\<forall>x\<in>A. open (B x) \<Longrightarrow> open (\<Union>x\<in>A. B x)"
   using open_Union [of "B ` A"] by simp
 
 lemma open_Inter [continuous_intros, intro]: "finite S \<Longrightarrow> \<forall>T\<in>S. open T \<Longrightarrow> open (\<Inter>S)"
   by (induction set: finite) auto
 
 lemma open_INT [continuous_intros, intro]: "finite A \<Longrightarrow> \<forall>x\<in>A. open (B x) \<Longrightarrow> open (\<Inter>x\<in>A. B x)"
   using open_Inter [of "B ` A"] by simp
 
 lemma openI:
   assumes "\<And>x. x \<in> S \<Longrightarrow> \<exists>T. open T \<and> x \<in> T \<and> T \<subseteq> S"
   shows "open S"
 proof -
   have "open (\<Union>{T. open T \<and> T \<subseteq> S})" by auto
   moreover have "\<Union>{T. open T \<and> T \<subseteq> S} = S" by (auto dest!: assms)
   ultimately show "open S" by simp
 qed
 
 lemma open_subopen: "open S \<longleftrightarrow> (\<forall>x\<in>S. \<exists>T. open T \<and> x \<in> T \<and> T \<subseteq> S)"
 by (auto intro: openI)
 
 lemma closed_empty [continuous_intros, intro, simp]: "closed {}"
   unfolding closed_def by simp
 
 lemma closed_Un [continuous_intros, intro]: "closed S \<Longrightarrow> closed T \<Longrightarrow> closed (S \<union> T)"
   unfolding closed_def by auto
 
 lemma closed_UNIV [continuous_intros, intro, simp]: "closed UNIV"
   unfolding closed_def by simp
 
 lemma closed_Int [continuous_intros, intro]: "closed S \<Longrightarrow> closed T \<Longrightarrow> closed (S \<inter> T)"
   unfolding closed_def by auto
 
 lemma closed_INT [continuous_intros, intro]: "\<forall>x\<in>A. closed (B x) \<Longrightarrow> closed (\<Inter>x\<in>A. B x)"
   unfolding closed_def by auto
 
 lemma closed_Inter [continuous_intros, intro]: "\<forall>S\<in>K. closed S \<Longrightarrow> closed (\<Inter>K)"
   unfolding closed_def uminus_Inf by auto
 
 lemma closed_Union [continuous_intros, intro]: "finite S \<Longrightarrow> \<forall>T\<in>S. closed T \<Longrightarrow> closed (\<Union>S)"
   by (induct set: finite) auto
 
 lemma closed_UN [continuous_intros, intro]:
   "finite A \<Longrightarrow> \<forall>x\<in>A. closed (B x) \<Longrightarrow> closed (\<Union>x\<in>A. B x)"
   using closed_Union [of "B ` A"] by simp
 
 lemma open_closed: "open S \<longleftrightarrow> closed (- S)"
   by (simp add: closed_def)
 
 lemma closed_open: "closed S \<longleftrightarrow> open (- S)"
   by (rule closed_def)
 
 lemma open_Diff [continuous_intros, intro]: "open S \<Longrightarrow> closed T \<Longrightarrow> open (S - T)"
   by (simp add: closed_open Diff_eq open_Int)
 
 lemma closed_Diff [continuous_intros, intro]: "closed S \<Longrightarrow> open T \<Longrightarrow> closed (S - T)"
   by (simp add: open_closed Diff_eq closed_Int)
 
 lemma open_Compl [continuous_intros, intro]: "closed S \<Longrightarrow> open (- S)"
   by (simp add: closed_open)
 
 lemma closed_Compl [continuous_intros, intro]: "open S \<Longrightarrow> closed (- S)"
   by (simp add: open_closed)
 
 lemma open_Collect_neg: "closed {x. P x} \<Longrightarrow> open {x. \<not> P x}"
   unfolding Collect_neg_eq by (rule open_Compl)
 
 lemma open_Collect_conj:
   assumes "open {x. P x}" "open {x. Q x}"
   shows "open {x. P x \<and> Q x}"
   using open_Int[OF assms] by (simp add: Int_def)
 
 lemma open_Collect_disj:
   assumes "open {x. P x}" "open {x. Q x}"
   shows "open {x. P x \<or> Q x}"
   using open_Un[OF assms] by (simp add: Un_def)
 
 lemma open_Collect_ex: "(\<And>i. open {x. P i x}) \<Longrightarrow> open {x. \<exists>i. P i x}"
   using open_UN[of UNIV "\<lambda>i. {x. P i x}"] unfolding Collect_ex_eq by simp
 
 lemma open_Collect_imp: "closed {x. P x} \<Longrightarrow> open {x. Q x} \<Longrightarrow> open {x. P x \<longrightarrow> Q x}"
   unfolding imp_conv_disj by (intro open_Collect_disj open_Collect_neg)
 
 lemma open_Collect_const: "open {x. P}"
   by (cases P) auto
 
 lemma closed_Collect_neg: "open {x. P x} \<Longrightarrow> closed {x. \<not> P x}"
   unfolding Collect_neg_eq by (rule closed_Compl)
 
 lemma closed_Collect_conj:
   assumes "closed {x. P x}" "closed {x. Q x}"
   shows "closed {x. P x \<and> Q x}"
   using closed_Int[OF assms] by (simp add: Int_def)
 
 lemma closed_Collect_disj:
   assumes "closed {x. P x}" "closed {x. Q x}"
   shows "closed {x. P x \<or> Q x}"
   using closed_Un[OF assms] by (simp add: Un_def)
 
 lemma closed_Collect_all: "(\<And>i. closed {x. P i x}) \<Longrightarrow> closed {x. \<forall>i. P i x}"
   using closed_INT[of UNIV "\<lambda>i. {x. P i x}"] by (simp add: Collect_all_eq)
 
 lemma closed_Collect_imp: "open {x. P x} \<Longrightarrow> closed {x. Q x} \<Longrightarrow> closed {x. P x \<longrightarrow> Q x}"
   unfolding imp_conv_disj by (intro closed_Collect_disj closed_Collect_neg)
 
 lemma closed_Collect_const: "closed {x. P}"
   by (cases P) auto
 
 end
 
 
 subsection \<open>Hausdorff and other separation properties\<close>
 
 class t0_space = topological_space +
   assumes t0_space: "x \<noteq> y \<Longrightarrow> \<exists>U. open U \<and> \<not> (x \<in> U \<longleftrightarrow> y \<in> U)"
 
 class t1_space = topological_space +
   assumes t1_space: "x \<noteq> y \<Longrightarrow> \<exists>U. open U \<and> x \<in> U \<and> y \<notin> U"
 
 instance t1_space \<subseteq> t0_space
   by standard (fast dest: t1_space)
 
 context t1_space begin
 
 lemma separation_t1: "x \<noteq> y \<longleftrightarrow> (\<exists>U. open U \<and> x \<in> U \<and> y \<notin> U)"
   using t1_space[of x y] by blast
 
 lemma closed_singleton [iff]: "closed {a}"
 proof -
   let ?T = "\<Union>{S. open S \<and> a \<notin> S}"
   have "open ?T"
     by (simp add: open_Union)
   also have "?T = - {a}"
     by (auto simp add: set_eq_iff separation_t1)
   finally show "closed {a}"
     by (simp only: closed_def)
 qed
 
 lemma closed_insert [continuous_intros, simp]:
   assumes "closed S"
   shows "closed (insert a S)"
 proof -
   from closed_singleton assms have "closed ({a} \<union> S)"
     by (rule closed_Un)
   then show "closed (insert a S)"
     by simp
 qed
 
 lemma finite_imp_closed: "finite S \<Longrightarrow> closed S"
   by (induct pred: finite) simp_all
 
 end
 
 text \<open>T2 spaces are also known as Hausdorff spaces.\<close>
 
 class t2_space = topological_space +
   assumes hausdorff: "x \<noteq> y \<Longrightarrow> \<exists>U V. open U \<and> open V \<and> x \<in> U \<and> y \<in> V \<and> U \<inter> V = {}"
 
 instance t2_space \<subseteq> t1_space
   by standard (fast dest: hausdorff)
 
 lemma (in t2_space) separation_t2: "x \<noteq> y \<longleftrightarrow> (\<exists>U V. open U \<and> open V \<and> x \<in> U \<and> y \<in> V \<and> U \<inter> V = {})"
   using hausdorff [of x y] by blast
 
 lemma (in t0_space) separation_t0: "x \<noteq> y \<longleftrightarrow> (\<exists>U. open U \<and> \<not> (x \<in> U \<longleftrightarrow> y \<in> U))"
   using t0_space [of x y] by blast
 
 
 text \<open>A classical separation axiom for topological space, the T3 axiom -- also called regularity:
 if a point is not in a closed set, then there are open sets separating them.\<close>
 
 class t3_space = t2_space +
   assumes t3_space: "closed S \<Longrightarrow> y \<notin> S \<Longrightarrow> \<exists>U V. open U \<and> open V \<and> y \<in> U \<and> S \<subseteq> V \<and> U \<inter> V = {}"
 
 text \<open>A classical separation axiom for topological space, the T4 axiom -- also called normality:
 if two closed sets are disjoint, then there are open sets separating them.\<close>
 
 class t4_space = t2_space +
   assumes t4_space: "closed S \<Longrightarrow> closed T \<Longrightarrow> S \<inter> T = {} \<Longrightarrow> \<exists>U V. open U \<and> open V \<and> S \<subseteq> U \<and> T \<subseteq> V \<and> U \<inter> V = {}"
 
 text \<open>T4 is stronger than T3, and weaker than metric.\<close>
 
 instance t4_space \<subseteq> t3_space
 proof
   fix S and y::'a assume "closed S" "y \<notin> S"
   then show "\<exists>U V. open U \<and> open V \<and> y \<in> U \<and> S \<subseteq> V \<and> U \<inter> V = {}"
     using t4_space[of "{y}" S] by auto
 qed
 
 text \<open>A perfect space is a topological space with no isolated points.\<close>
 
 class perfect_space = topological_space +
   assumes not_open_singleton: "\<not> open {x}"
 
 lemma (in perfect_space) UNIV_not_singleton: "UNIV \<noteq> {x}"
   for x::'a
   by (metis (no_types) open_UNIV not_open_singleton)
 
 
 subsection \<open>Generators for toplogies\<close>
 
 inductive generate_topology :: "'a set set \<Rightarrow> 'a set \<Rightarrow> bool" for S :: "'a set set"
   where
     UNIV: "generate_topology S UNIV"
   | Int: "generate_topology S (a \<inter> b)" if "generate_topology S a" and "generate_topology S b"
   | UN: "generate_topology S (\<Union>K)" if "(\<And>k. k \<in> K \<Longrightarrow> generate_topology S k)"
   | Basis: "generate_topology S s" if "s \<in> S"
 
 hide_fact (open) UNIV Int UN Basis
 
 lemma generate_topology_Union:
   "(\<And>k. k \<in> I \<Longrightarrow> generate_topology S (K k)) \<Longrightarrow> generate_topology S (\<Union>k\<in>I. K k)"
   using generate_topology.UN [of "K ` I"] by auto
 
 lemma topological_space_generate_topology: "class.topological_space (generate_topology S)"
   by standard (auto intro: generate_topology.intros)
 
 
 subsection \<open>Order topologies\<close>
 
 class order_topology = order + "open" +
   assumes open_generated_order: "open = generate_topology (range (\<lambda>a. {..< a}) \<union> range (\<lambda>a. {a <..}))"
 begin
 
 subclass topological_space
   unfolding open_generated_order
   by (rule topological_space_generate_topology)
 
 lemma open_greaterThan [continuous_intros, simp]: "open {a <..}"
   unfolding open_generated_order by (auto intro: generate_topology.Basis)
 
 lemma open_lessThan [continuous_intros, simp]: "open {..< a}"
   unfolding open_generated_order by (auto intro: generate_topology.Basis)
 
 lemma open_greaterThanLessThan [continuous_intros, simp]: "open {a <..< b}"
    unfolding greaterThanLessThan_eq by (simp add: open_Int)
 
 end
 
 class linorder_topology = linorder + order_topology
 
 lemma closed_atMost [continuous_intros, simp]: "closed {..a}"
   for a :: "'a::linorder_topology"
   by (simp add: closed_open)
 
 lemma closed_atLeast [continuous_intros, simp]: "closed {a..}"
   for a :: "'a::linorder_topology"
   by (simp add: closed_open)
 
 lemma closed_atLeastAtMost [continuous_intros, simp]: "closed {a..b}"
   for a b :: "'a::linorder_topology"
 proof -
   have "{a .. b} = {a ..} \<inter> {.. b}"
     by auto
   then show ?thesis
     by (simp add: closed_Int)
 qed
 
 lemma (in order) less_separate:
   assumes "x < y"
   shows "\<exists>a b. x \<in> {..< a} \<and> y \<in> {b <..} \<and> {..< a} \<inter> {b <..} = {}"
 proof (cases "\<exists>z. x < z \<and> z < y")
   case True
   then obtain z where "x < z \<and> z < y" ..
   then have "x \<in> {..< z} \<and> y \<in> {z <..} \<and> {z <..} \<inter> {..< z} = {}"
     by auto
   then show ?thesis by blast
 next
   case False
   with \<open>x < y\<close> have "x \<in> {..< y}" "y \<in> {x <..}" "{x <..} \<inter> {..< y} = {}"
     by auto
   then show ?thesis by blast
 qed
 
 instance linorder_topology \<subseteq> t2_space
 proof
   fix x y :: 'a
   show "x \<noteq> y \<Longrightarrow> \<exists>U V. open U \<and> open V \<and> x \<in> U \<and> y \<in> V \<and> U \<inter> V = {}"
     using less_separate [of x y] less_separate [of y x]
     by (elim neqE; metis open_lessThan open_greaterThan Int_commute)
 qed
 
 lemma (in linorder_topology) open_right:
   assumes "open S" "x \<in> S"
     and gt_ex: "x < y"
   shows "\<exists>b>x. {x ..< b} \<subseteq> S"
   using assms unfolding open_generated_order
 proof induct
   case UNIV
   then show ?case by blast
 next
   case (Int A B)
   then obtain a b where "a > x" "{x ..< a} \<subseteq> A"  "b > x" "{x ..< b} \<subseteq> B"
     by auto
   then show ?case
     by (auto intro!: exI[of _ "min a b"])
 next
   case UN
   then show ?case by blast
 next
   case Basis
   then show ?case
     by (fastforce intro: exI[of _ y] gt_ex)
 qed
 
 lemma (in linorder_topology) open_left:
   assumes "open S" "x \<in> S"
     and lt_ex: "y < x"
   shows "\<exists>b<x. {b <.. x} \<subseteq> S"
   using assms unfolding open_generated_order
 proof induction
   case UNIV
   then show ?case by blast
 next
   case (Int A B)
   then obtain a b where "a < x" "{a <.. x} \<subseteq> A"  "b < x" "{b <.. x} \<subseteq> B"
     by auto
   then show ?case
     by (auto intro!: exI[of _ "max a b"])
 next
   case UN
   then show ?case by blast
 next
   case Basis
   then show ?case
     by (fastforce intro: exI[of _ y] lt_ex)
 qed
 
 
 subsection \<open>Setup some topologies\<close>
 
 subsubsection \<open>Boolean is an order topology\<close>
 
 class discrete_topology = topological_space +
   assumes open_discrete: "\<And>A. open A"
 
 instance discrete_topology < t2_space
 proof
   fix x y :: 'a
   assume "x \<noteq> y"
   then show "\<exists>U V. open U \<and> open V \<and> x \<in> U \<and> y \<in> V \<and> U \<inter> V = {}"
     by (intro exI[of _ "{_}"]) (auto intro!: open_discrete)
 qed
 
 instantiation bool :: linorder_topology
 begin
 
 definition open_bool :: "bool set \<Rightarrow> bool"
   where "open_bool = generate_topology (range (\<lambda>a. {..< a}) \<union> range (\<lambda>a. {a <..}))"
 
 instance
   by standard (rule open_bool_def)
 
 end
 
 instance bool :: discrete_topology
 proof
   fix A :: "bool set"
   have *: "{False <..} = {True}" "{..< True} = {False}"
     by auto
   have "A = UNIV \<or> A = {} \<or> A = {False <..} \<or> A = {..< True}"
     using subset_UNIV[of A] unfolding UNIV_bool * by blast
   then show "open A"
     by auto
 qed
 
 instantiation nat :: linorder_topology
 begin
 
 definition open_nat :: "nat set \<Rightarrow> bool"
   where "open_nat = generate_topology (range (\<lambda>a. {..< a}) \<union> range (\<lambda>a. {a <..}))"
 
 instance
   by standard (rule open_nat_def)
 
 end
 
 instance nat :: discrete_topology
 proof
   fix A :: "nat set"
   have "open {n}" for n :: nat
   proof (cases n)
     case 0
     moreover have "{0} = {..<1::nat}"
       by auto
     ultimately show ?thesis
        by auto
   next
     case (Suc n')
     then have "{n} = {..<Suc n} \<inter> {n' <..}"
       by auto
     with Suc show ?thesis
       by (auto intro: open_lessThan open_greaterThan)
   qed
   then have "open (\<Union>a\<in>A. {a})"
     by (intro open_UN) auto
   then show "open A"
     by simp
 qed
 
 instantiation int :: linorder_topology
 begin
 
 definition open_int :: "int set \<Rightarrow> bool"
   where "open_int = generate_topology (range (\<lambda>a. {..< a}) \<union> range (\<lambda>a. {a <..}))"
 
 instance
   by standard (rule open_int_def)
 
 end
 
 instance int :: discrete_topology
 proof
   fix A :: "int set"
   have "{..<i + 1} \<inter> {i-1 <..} = {i}" for i :: int
     by auto
   then have "open {i}" for i :: int
     using open_Int[OF open_lessThan[of "i + 1"] open_greaterThan[of "i - 1"]] by auto
   then have "open (\<Union>a\<in>A. {a})"
     by (intro open_UN) auto
   then show "open A"
     by simp
 qed
 
 
 subsubsection \<open>Topological filters\<close>
 
 definition (in topological_space) nhds :: "'a \<Rightarrow> 'a filter"
   where "nhds a = (INF S\<in>{S. open S \<and> a \<in> S}. principal S)"
 
 definition (in topological_space) at_within :: "'a \<Rightarrow> 'a set \<Rightarrow> 'a filter"
     ("at (_)/ within (_)" [1000, 60] 60)
   where "at a within s = inf (nhds a) (principal (s - {a}))"
 
 abbreviation (in topological_space) at :: "'a \<Rightarrow> 'a filter"  ("at")
   where "at x \<equiv> at x within (CONST UNIV)"
 
 abbreviation (in order_topology) at_right :: "'a \<Rightarrow> 'a filter"
   where "at_right x \<equiv> at x within {x <..}"
 
 abbreviation (in order_topology) at_left :: "'a \<Rightarrow> 'a filter"
   where "at_left x \<equiv> at x within {..< x}"
 
 lemma (in topological_space) nhds_generated_topology:
   "open = generate_topology T \<Longrightarrow> nhds x = (INF S\<in>{S\<in>T. x \<in> S}. principal S)"
   unfolding nhds_def
 proof (safe intro!: antisym INF_greatest)
   fix S
   assume "generate_topology T S" "x \<in> S"
   then show "(INF S\<in>{S \<in> T. x \<in> S}. principal S) \<le> principal S"
     by induct
       (auto intro: INF_lower order_trans simp: inf_principal[symmetric] simp del: inf_principal)
 qed (auto intro!: INF_lower intro: generate_topology.intros)
 
 lemma (in topological_space) eventually_nhds:
   "eventually P (nhds a) \<longleftrightarrow> (\<exists>S. open S \<and> a \<in> S \<and> (\<forall>x\<in>S. P x))"
   unfolding nhds_def by (subst eventually_INF_base) (auto simp: eventually_principal)
 
 lemma eventually_eventually:
   "eventually (\<lambda>y. eventually P (nhds y)) (nhds x) = eventually P (nhds x)"
   by (auto simp: eventually_nhds)
 
 lemma (in topological_space) eventually_nhds_in_open:
   "open s \<Longrightarrow> x \<in> s \<Longrightarrow> eventually (\<lambda>y. y \<in> s) (nhds x)"
   by (subst eventually_nhds) blast
 
 lemma (in topological_space) eventually_nhds_x_imp_x: "eventually P (nhds x) \<Longrightarrow> P x"
   by (subst (asm) eventually_nhds) blast
 
 lemma (in topological_space) nhds_neq_bot [simp]: "nhds a \<noteq> bot"
   by (simp add: trivial_limit_def eventually_nhds)
 
 lemma (in t1_space) t1_space_nhds: "x \<noteq> y \<Longrightarrow> (\<forall>\<^sub>F x in nhds x. x \<noteq> y)"
   by (drule t1_space) (auto simp: eventually_nhds)
 
 lemma (in topological_space) nhds_discrete_open: "open {x} \<Longrightarrow> nhds x = principal {x}"
   by (auto simp: nhds_def intro!: antisym INF_greatest INF_lower2[of "{x}"])
 
 lemma (in discrete_topology) nhds_discrete: "nhds x = principal {x}"
   by (simp add: nhds_discrete_open open_discrete)
 
 lemma (in discrete_topology) at_discrete: "at x within S = bot"
   unfolding at_within_def nhds_discrete by simp
 
 lemma (in discrete_topology) tendsto_discrete:
   "filterlim (f :: 'b \<Rightarrow> 'a) (nhds y) F \<longleftrightarrow> eventually (\<lambda>x. f x = y) F"
   by (auto simp: nhds_discrete filterlim_principal)
 
 lemma (in topological_space) at_within_eq:
   "at x within s = (INF S\<in>{S. open S \<and> x \<in> S}. principal (S \<inter> s - {x}))"
   unfolding nhds_def at_within_def
   by (subst INF_inf_const2[symmetric]) (auto simp: Diff_Int_distrib)
 
 lemma (in topological_space) eventually_at_filter:
   "eventually P (at a within s) \<longleftrightarrow> eventually (\<lambda>x. x \<noteq> a \<longrightarrow> x \<in> s \<longrightarrow> P x) (nhds a)"
   by (simp add: at_within_def eventually_inf_principal imp_conjL[symmetric] conj_commute)
 
 lemma (in topological_space) at_le: "s \<subseteq> t \<Longrightarrow> at x within s \<le> at x within t"
   unfolding at_within_def by (intro inf_mono) auto
 
 lemma (in topological_space) eventually_at_topological:
   "eventually P (at a within s) \<longleftrightarrow> (\<exists>S. open S \<and> a \<in> S \<and> (\<forall>x\<in>S. x \<noteq> a \<longrightarrow> x \<in> s \<longrightarrow> P x))"
   by (simp add: eventually_nhds eventually_at_filter)
 
+lemma eventually_at_in_open:
+  assumes "open A" "x \<in> A"
+  shows   "eventually (\<lambda>y. y \<in> A - {x}) (at x)"
+  using assms eventually_at_topological by blast
+
+lemma eventually_at_in_open':
+  assumes "open A" "x \<in> A"
+  shows   "eventually (\<lambda>y. y \<in> A) (at x)"
+  using assms eventually_at_topological by blast
+
 lemma (in topological_space) at_within_open: "a \<in> S \<Longrightarrow> open S \<Longrightarrow> at a within S = at a"
   unfolding filter_eq_iff eventually_at_topological by (metis open_Int Int_iff UNIV_I)
 
 lemma (in topological_space) at_within_open_NO_MATCH:
   "a \<in> s \<Longrightarrow> open s \<Longrightarrow> NO_MATCH UNIV s \<Longrightarrow> at a within s = at a"
   by (simp only: at_within_open)
 
 lemma (in topological_space) at_within_open_subset:
   "a \<in> S \<Longrightarrow> open S \<Longrightarrow> S \<subseteq> T \<Longrightarrow> at a within T = at a"
   by (metis at_le at_within_open dual_order.antisym subset_UNIV)
 
 lemma (in topological_space) at_within_nhd:
   assumes "x \<in> S" "open S" "T \<inter> S - {x} = U \<inter> S - {x}"
   shows "at x within T = at x within U"
   unfolding filter_eq_iff eventually_at_filter
 proof (intro allI eventually_subst)
   have "eventually (\<lambda>x. x \<in> S) (nhds x)"
     using \<open>x \<in> S\<close> \<open>open S\<close> by (auto simp: eventually_nhds)
   then show "\<forall>\<^sub>F n in nhds x. (n \<noteq> x \<longrightarrow> n \<in> T \<longrightarrow> P n) = (n \<noteq> x \<longrightarrow> n \<in> U \<longrightarrow> P n)" for P
     by eventually_elim (insert \<open>T \<inter> S - {x} = U \<inter> S - {x}\<close>, blast)
 qed
 
 lemma (in topological_space) at_within_empty [simp]: "at a within {} = bot"
   unfolding at_within_def by simp
 
 lemma (in topological_space) at_within_union:
   "at x within (S \<union> T) = sup (at x within S) (at x within T)"
   unfolding filter_eq_iff eventually_sup eventually_at_filter
   by (auto elim!: eventually_rev_mp)
 
 lemma (in topological_space) at_eq_bot_iff: "at a = bot \<longleftrightarrow> open {a}"
   unfolding trivial_limit_def eventually_at_topological
   by (metis UNIV_I empty_iff is_singletonE is_singletonI' singleton_iff)
 
+lemma (in t1_space) eventually_neq_at_within:
+  "eventually (\<lambda>w. w \<noteq> x) (at z within A)"
+  by (smt (verit, ccfv_threshold) eventually_True eventually_at_topological separation_t1)
+
 lemma (in perfect_space) at_neq_bot [simp]: "at a \<noteq> bot"
   by (simp add: at_eq_bot_iff not_open_singleton)
 
 lemma (in order_topology) nhds_order:
   "nhds x = inf (INF a\<in>{x <..}. principal {..< a}) (INF a\<in>{..< x}. principal {a <..})"
 proof -
   have 1: "{S \<in> range lessThan \<union> range greaterThan. x \<in> S} =
       (\<lambda>a. {..< a}) ` {x <..} \<union> (\<lambda>a. {a <..}) ` {..< x}"
     by auto
   show ?thesis
     by (simp only: nhds_generated_topology[OF open_generated_order] INF_union 1 INF_image comp_def)
 qed
 
 lemma (in topological_space) filterlim_at_within_If:
   assumes "filterlim f G (at x within (A \<inter> {x. P x}))"
     and "filterlim g G (at x within (A \<inter> {x. \<not>P x}))"
   shows "filterlim (\<lambda>x. if P x then f x else g x) G (at x within A)"
 proof (rule filterlim_If)
   note assms(1)
   also have "at x within (A \<inter> {x. P x}) = inf (nhds x) (principal (A \<inter> Collect P - {x}))"
     by (simp add: at_within_def)
   also have "A \<inter> Collect P - {x} = (A - {x}) \<inter> Collect P"
     by blast
   also have "inf (nhds x) (principal \<dots>) = inf (at x within A) (principal (Collect P))"
     by (simp add: at_within_def inf_assoc)
   finally show "filterlim f G (inf (at x within A) (principal (Collect P)))" .
 next
   note assms(2)
   also have "at x within (A \<inter> {x. \<not> P x}) = inf (nhds x) (principal (A \<inter> {x. \<not> P x} - {x}))"
     by (simp add: at_within_def)
   also have "A \<inter> {x. \<not> P x} - {x} = (A - {x}) \<inter> {x. \<not> P x}"
     by blast
   also have "inf (nhds x) (principal \<dots>) = inf (at x within A) (principal {x. \<not> P x})"
     by (simp add: at_within_def inf_assoc)
   finally show "filterlim g G (inf (at x within A) (principal {x. \<not> P x}))" .
 qed
 
 lemma (in topological_space) filterlim_at_If:
   assumes "filterlim f G (at x within {x. P x})"
     and "filterlim g G (at x within {x. \<not>P x})"
   shows "filterlim (\<lambda>x. if P x then f x else g x) G (at x)"
   using assms by (intro filterlim_at_within_If) simp_all
 lemma (in linorder_topology) at_within_order:
   assumes "UNIV \<noteq> {x}"
   shows "at x within s =
     inf (INF a\<in>{x <..}. principal ({..< a} \<inter> s - {x}))
         (INF a\<in>{..< x}. principal ({a <..} \<inter> s - {x}))"
 proof (cases "{x <..} = {}" "{..< x} = {}" rule: case_split [case_product case_split])
   case True_True
   have "UNIV = {..< x} \<union> {x} \<union> {x <..}"
     by auto
   with assms True_True show ?thesis
     by auto
 qed (auto simp del: inf_principal simp: at_within_def nhds_order Int_Diff
       inf_principal[symmetric] INF_inf_const2 inf_sup_aci[where 'a="'a filter"])
 
 lemma (in linorder_topology) at_left_eq:
   "y < x \<Longrightarrow> at_left x = (INF a\<in>{..< x}. principal {a <..< x})"
   by (subst at_within_order)
      (auto simp: greaterThan_Int_greaterThan greaterThanLessThan_eq[symmetric] min.absorb2 INF_constant
            intro!: INF_lower2 inf_absorb2)
 
 lemma (in linorder_topology) eventually_at_left:
   "y < x \<Longrightarrow> eventually P (at_left x) \<longleftrightarrow> (\<exists>b<x. \<forall>y>b. y < x \<longrightarrow> P y)"
   unfolding at_left_eq
   by (subst eventually_INF_base) (auto simp: eventually_principal Ball_def)
 
 lemma (in linorder_topology) at_right_eq:
   "x < y \<Longrightarrow> at_right x = (INF a\<in>{x <..}. principal {x <..< a})"
   by (subst at_within_order)
      (auto simp: lessThan_Int_lessThan greaterThanLessThan_eq[symmetric] max.absorb2 INF_constant Int_commute
            intro!: INF_lower2 inf_absorb1)
 
 lemma (in linorder_topology) eventually_at_right:
   "x < y \<Longrightarrow> eventually P (at_right x) \<longleftrightarrow> (\<exists>b>x. \<forall>y>x. y < b \<longrightarrow> P y)"
   unfolding at_right_eq
   by (subst eventually_INF_base) (auto simp: eventually_principal Ball_def)
 
 lemma eventually_at_right_less: "\<forall>\<^sub>F y in at_right (x::'a::{linorder_topology, no_top}). x < y"
   using gt_ex[of x] eventually_at_right[of x] by auto
 
 lemma trivial_limit_at_right_top: "at_right (top::_::{order_top,linorder_topology}) = bot"
   by (auto simp: filter_eq_iff eventually_at_topological)
 
 lemma trivial_limit_at_left_bot: "at_left (bot::_::{order_bot,linorder_topology}) = bot"
   by (auto simp: filter_eq_iff eventually_at_topological)
 
 lemma trivial_limit_at_left_real [simp]: "\<not> trivial_limit (at_left x)"
   for x :: "'a::{no_bot,dense_order,linorder_topology}"
   using lt_ex [of x]
   by safe (auto simp add: trivial_limit_def eventually_at_left dest: dense)
 
 lemma trivial_limit_at_right_real [simp]: "\<not> trivial_limit (at_right x)"
   for x :: "'a::{no_top,dense_order,linorder_topology}"
   using gt_ex[of x]
   by safe (auto simp add: trivial_limit_def eventually_at_right dest: dense)
 
 lemma (in linorder_topology) at_eq_sup_left_right: "at x = sup (at_left x) (at_right x)"
   by (auto simp: eventually_at_filter filter_eq_iff eventually_sup
       elim: eventually_elim2 eventually_mono)
 
 lemma (in linorder_topology) eventually_at_split:
   "eventually P (at x) \<longleftrightarrow> eventually P (at_left x) \<and> eventually P (at_right x)"
   by (subst at_eq_sup_left_right) (simp add: eventually_sup)
 
 lemma (in order_topology) eventually_at_leftI:
   assumes "\<And>x. x \<in> {a<..<b} \<Longrightarrow> P x" "a < b"
   shows   "eventually P (at_left b)"
   using assms unfolding eventually_at_topological by (intro exI[of _ "{a<..}"]) auto
 
 lemma (in order_topology) eventually_at_rightI:
   assumes "\<And>x. x \<in> {a<..<b} \<Longrightarrow> P x" "a < b"
   shows   "eventually P (at_right a)"
   using assms unfolding eventually_at_topological by (intro exI[of _ "{..<b}"]) auto
 
 lemma eventually_filtercomap_nhds:
   "eventually P (filtercomap f (nhds x)) \<longleftrightarrow> (\<exists>S. open S \<and> x \<in> S \<and> (\<forall>x. f x \<in> S \<longrightarrow> P x))"
   unfolding eventually_filtercomap eventually_nhds by auto
 
 lemma eventually_filtercomap_at_topological:
   "eventually P (filtercomap f (at A within B)) \<longleftrightarrow> 
      (\<exists>S. open S \<and> A \<in> S \<and> (\<forall>x. f x \<in> S \<inter> B - {A} \<longrightarrow> P x))" (is "?lhs = ?rhs")
   unfolding at_within_def filtercomap_inf eventually_inf_principal filtercomap_principal 
           eventually_filtercomap_nhds eventually_principal by blast
 
 lemma eventually_at_right_field:
   "eventually P (at_right x) \<longleftrightarrow> (\<exists>b>x. \<forall>y>x. y < b \<longrightarrow> P y)"
   for x :: "'a::{linordered_field, linorder_topology}"
   using linordered_field_no_ub[rule_format, of x]
   by (auto simp: eventually_at_right)
 
 lemma eventually_at_left_field:
   "eventually P (at_left x) \<longleftrightarrow> (\<exists>b<x. \<forall>y>b. y < x \<longrightarrow> P y)"
   for x :: "'a::{linordered_field, linorder_topology}"
   using linordered_field_no_lb[rule_format, of x]
   by (auto simp: eventually_at_left)
 
 
 subsubsection \<open>Tendsto\<close>
 
 abbreviation (in topological_space)
   tendsto :: "('b \<Rightarrow> 'a) \<Rightarrow> 'a \<Rightarrow> 'b filter \<Rightarrow> bool"  (infixr "\<longlongrightarrow>" 55)
   where "(f \<longlongrightarrow> l) F \<equiv> filterlim f (nhds l) F"
 
 definition (in t2_space) Lim :: "'f filter \<Rightarrow> ('f \<Rightarrow> 'a) \<Rightarrow> 'a"
   where "Lim A f = (THE l. (f \<longlongrightarrow> l) A)"
 
 lemma (in topological_space) tendsto_eq_rhs: "(f \<longlongrightarrow> x) F \<Longrightarrow> x = y \<Longrightarrow> (f \<longlongrightarrow> y) F"
   by simp
 
 named_theorems tendsto_intros "introduction rules for tendsto"
 setup \<open>
   Global_Theory.add_thms_dynamic (\<^binding>\<open>tendsto_eq_intros\<close>,
     fn context =>
       Named_Theorems.get (Context.proof_of context) \<^named_theorems>\<open>tendsto_intros\<close>
       |> map_filter (try (fn thm => @{thm tendsto_eq_rhs} OF [thm])))
 \<close>
 
 context topological_space begin
 
 lemma tendsto_def:
    "(f \<longlongrightarrow> l) F \<longleftrightarrow> (\<forall>S. open S \<longrightarrow> l \<in> S \<longrightarrow> eventually (\<lambda>x. f x \<in> S) F)"
    unfolding nhds_def filterlim_INF filterlim_principal by auto
 
 lemma tendsto_cong: "(f \<longlongrightarrow> c) F \<longleftrightarrow> (g \<longlongrightarrow> c) F" if "eventually (\<lambda>x. f x = g x) F"
   by (rule filterlim_cong [OF refl refl that])
 
 lemma tendsto_mono: "F \<le> F' \<Longrightarrow> (f \<longlongrightarrow> l) F' \<Longrightarrow> (f \<longlongrightarrow> l) F"
   unfolding tendsto_def le_filter_def by fast
 
 lemma tendsto_ident_at [tendsto_intros, simp, intro]: "((\<lambda>x. x) \<longlongrightarrow> a) (at a within s)"
   by (auto simp: tendsto_def eventually_at_topological)
 
 lemma tendsto_const [tendsto_intros, simp, intro]: "((\<lambda>x. k) \<longlongrightarrow> k) F"
   by (simp add: tendsto_def)
 
 lemma filterlim_at:
   "(LIM x F. f x :> at b within s) \<longleftrightarrow> eventually (\<lambda>x. f x \<in> s \<and> f x \<noteq> b) F \<and> (f \<longlongrightarrow> b) F"
   by (simp add: at_within_def filterlim_inf filterlim_principal conj_commute)
 
 lemma (in -)
   assumes "filterlim f (nhds L) F"
   shows tendsto_imp_filterlim_at_right:
           "eventually (\<lambda>x. f x > L) F \<Longrightarrow> filterlim f (at_right L) F"
     and tendsto_imp_filterlim_at_left:
           "eventually (\<lambda>x. f x < L) F \<Longrightarrow> filterlim f (at_left L) F"
   using assms by (auto simp: filterlim_at elim: eventually_mono)
 
 lemma  filterlim_at_withinI:
   assumes "filterlim f (nhds c) F"
   assumes "eventually (\<lambda>x. f x \<in> A - {c}) F"
   shows   "filterlim f (at c within A) F"
   using assms by (simp add: filterlim_at)
 
 lemma filterlim_atI:
   assumes "filterlim f (nhds c) F"
   assumes "eventually (\<lambda>x. f x \<noteq> c) F"
   shows   "filterlim f (at c) F"
   using assms by (intro filterlim_at_withinI) simp_all
 
 lemma topological_tendstoI:
   "(\<And>S. open S \<Longrightarrow> l \<in> S \<Longrightarrow> eventually (\<lambda>x. f x \<in> S) F) \<Longrightarrow> (f \<longlongrightarrow> l) F"
   by (auto simp: tendsto_def)
 
 lemma topological_tendstoD:
   "(f \<longlongrightarrow> l) F \<Longrightarrow> open S \<Longrightarrow> l \<in> S \<Longrightarrow> eventually (\<lambda>x. f x \<in> S) F"
   by (auto simp: tendsto_def)
 
 lemma tendsto_bot [simp]: "(f \<longlongrightarrow> a) bot"
   by (simp add: tendsto_def)
 
 lemma tendsto_eventually: "eventually (\<lambda>x. f x = l) net \<Longrightarrow> ((\<lambda>x. f x) \<longlongrightarrow> l) net"
   by (rule topological_tendstoI) (auto elim: eventually_mono)
 
 (* Contributed by Dominique Unruh *)
 lemma tendsto_principal_singleton[simp]:
   shows "(f \<longlongrightarrow> f x) (principal {x})"
   unfolding tendsto_def eventually_principal by simp
 
 end
 
 lemma (in topological_space) filterlim_within_subset:
   "filterlim f l (at x within S) \<Longrightarrow> T \<subseteq> S \<Longrightarrow> filterlim f l (at x within T)"
   by (blast intro: filterlim_mono at_le)
 
 lemmas tendsto_within_subset = filterlim_within_subset
 
 lemma (in order_topology) order_tendsto_iff:
   "(f \<longlongrightarrow> x) F \<longleftrightarrow> (\<forall>l<x. eventually (\<lambda>x. l < f x) F) \<and> (\<forall>u>x. eventually (\<lambda>x. f x < u) F)"
   by (auto simp: nhds_order filterlim_inf filterlim_INF filterlim_principal)
 
 lemma (in order_topology) order_tendstoI:
   "(\<And>a. a < y \<Longrightarrow> eventually (\<lambda>x. a < f x) F) \<Longrightarrow> (\<And>a. y < a \<Longrightarrow> eventually (\<lambda>x. f x < a) F) \<Longrightarrow>
     (f \<longlongrightarrow> y) F"
   by (auto simp: order_tendsto_iff)
 
 lemma (in order_topology) order_tendstoD:
   assumes "(f \<longlongrightarrow> y) F"
   shows "a < y \<Longrightarrow> eventually (\<lambda>x. a < f x) F"
     and "y < a \<Longrightarrow> eventually (\<lambda>x. f x < a) F"
   using assms by (auto simp: order_tendsto_iff)
 
 lemma (in linorder_topology) tendsto_max[tendsto_intros]:
   assumes X: "(X \<longlongrightarrow> x) net"
     and Y: "(Y \<longlongrightarrow> y) net"
   shows "((\<lambda>x. max (X x) (Y x)) \<longlongrightarrow> max x y) net"
 proof (rule order_tendstoI)
   fix a
   assume "a < max x y"
   then show "eventually (\<lambda>x. a < max (X x) (Y x)) net"
     using order_tendstoD(1)[OF X, of a] order_tendstoD(1)[OF Y, of a]
     by (auto simp: less_max_iff_disj elim: eventually_mono)
 next
   fix a
   assume "max x y < a"
   then show "eventually (\<lambda>x. max (X x) (Y x) < a) net"
     using order_tendstoD(2)[OF X, of a] order_tendstoD(2)[OF Y, of a]
     by (auto simp: eventually_conj_iff)
 qed
 
 lemma (in linorder_topology) tendsto_min[tendsto_intros]:
   assumes X: "(X \<longlongrightarrow> x) net"
     and Y: "(Y \<longlongrightarrow> y) net"
   shows "((\<lambda>x. min (X x) (Y x)) \<longlongrightarrow> min x y) net"
 proof (rule order_tendstoI)
   fix a
   assume "a < min x y"
   then show "eventually (\<lambda>x. a < min (X x) (Y x)) net"
     using order_tendstoD(1)[OF X, of a] order_tendstoD(1)[OF Y, of a]
     by (auto simp: eventually_conj_iff)
 next
   fix a
   assume "min x y < a"
   then show "eventually (\<lambda>x. min (X x) (Y x) < a) net"
     using order_tendstoD(2)[OF X, of a] order_tendstoD(2)[OF Y, of a]
     by (auto simp: min_less_iff_disj elim: eventually_mono)
 qed
 
 lemma (in order_topology)
   assumes "a < b"
   shows at_within_Icc_at_right: "at a within {a..b} = at_right a"
     and at_within_Icc_at_left:  "at b within {a..b} = at_left b"
   using order_tendstoD(2)[OF tendsto_ident_at assms, of "{a<..}"]
   using order_tendstoD(1)[OF tendsto_ident_at assms, of "{..<b}"]
   by (auto intro!: order_class.order_antisym filter_leI
       simp: eventually_at_filter less_le
       elim: eventually_elim2)
 
 lemma (in order_topology) at_within_Icc_at: "a < x \<Longrightarrow> x < b \<Longrightarrow> at x within {a..b} = at x"
   by (rule at_within_open_subset[where S="{a<..<b}"]) auto
 
 lemma (in t2_space) tendsto_unique:
   assumes "F \<noteq> bot"
     and "(f \<longlongrightarrow> a) F"
     and "(f \<longlongrightarrow> b) F"
   shows "a = b"
 proof (rule ccontr)
   assume "a \<noteq> b"
   obtain U V where "open U" "open V" "a \<in> U" "b \<in> V" "U \<inter> V = {}"
     using hausdorff [OF \<open>a \<noteq> b\<close>] by fast
   have "eventually (\<lambda>x. f x \<in> U) F"
     using \<open>(f \<longlongrightarrow> a) F\<close> \<open>open U\<close> \<open>a \<in> U\<close> by (rule topological_tendstoD)
   moreover
   have "eventually (\<lambda>x. f x \<in> V) F"
     using \<open>(f \<longlongrightarrow> b) F\<close> \<open>open V\<close> \<open>b \<in> V\<close> by (rule topological_tendstoD)
   ultimately
   have "eventually (\<lambda>x. False) F"
   proof eventually_elim
     case (elim x)
     then have "f x \<in> U \<inter> V" by simp
     with \<open>U \<inter> V = {}\<close> show ?case by simp
   qed
   with \<open>\<not> trivial_limit F\<close> show "False"
     by (simp add: trivial_limit_def)
 qed
 
 lemma (in t2_space) tendsto_const_iff:
   fixes a b :: 'a
   assumes "\<not> trivial_limit F"
   shows "((\<lambda>x. a) \<longlongrightarrow> b) F \<longleftrightarrow> a = b"
   by (auto intro!: tendsto_unique [OF assms tendsto_const])
 
 lemma (in t2_space) tendsto_unique':
  assumes "F \<noteq> bot"
  shows "\<exists>\<^sub>\<le>\<^sub>1l. (f \<longlongrightarrow> l) F"
  using Uniq_def assms local.tendsto_unique by fastforce
 
 lemma Lim_in_closed_set:
   assumes "closed S" "eventually (\<lambda>x. f(x) \<in> S) F" "F \<noteq> bot" "(f \<longlongrightarrow> l) F"
   shows "l \<in> S"
 proof (rule ccontr)
   assume "l \<notin> S"
   with \<open>closed S\<close> have "open (- S)" "l \<in> - S"
     by (simp_all add: open_Compl)
   with assms(4) have "eventually (\<lambda>x. f x \<in> - S) F"
     by (rule topological_tendstoD)
   with assms(2) have "eventually (\<lambda>x. False) F"
     by (rule eventually_elim2) simp
   with assms(3) show "False"
     by (simp add: eventually_False)
 qed
 
 lemma (in t3_space) nhds_closed:
   assumes "x \<in> A" and "open A"
   shows   "\<exists>A'. x \<in> A' \<and> closed A' \<and> A' \<subseteq> A \<and> eventually (\<lambda>y. y \<in> A') (nhds x)"
 proof -
   from assms have "\<exists>U V. open U \<and> open V \<and> x \<in> U \<and> - A \<subseteq> V \<and> U \<inter> V = {}"
     by (intro t3_space) auto
   then obtain U V where UV: "open U" "open V" "x \<in> U" "-A \<subseteq> V" "U \<inter> V = {}"
     by auto
   have "eventually (\<lambda>y. y \<in> U) (nhds x)"
     using \<open>open U\<close> and \<open>x \<in> U\<close> by (intro eventually_nhds_in_open)
   hence "eventually (\<lambda>y. y \<in> -V) (nhds x)"
     by eventually_elim (use UV in auto)
   with UV show ?thesis by (intro exI[of _ "-V"]) auto
 qed
 
 lemma (in order_topology) increasing_tendsto:
   assumes bdd: "eventually (\<lambda>n. f n \<le> l) F"
     and en: "\<And>x. x < l \<Longrightarrow> eventually (\<lambda>n. x < f n) F"
   shows "(f \<longlongrightarrow> l) F"
   using assms by (intro order_tendstoI) (auto elim!: eventually_mono)
 
 lemma (in order_topology) decreasing_tendsto:
   assumes bdd: "eventually (\<lambda>n. l \<le> f n) F"
     and en: "\<And>x. l < x \<Longrightarrow> eventually (\<lambda>n. f n < x) F"
   shows "(f \<longlongrightarrow> l) F"
   using assms by (intro order_tendstoI) (auto elim!: eventually_mono)
 
 lemma (in order_topology) tendsto_sandwich:
   assumes ev: "eventually (\<lambda>n. f n \<le> g n) net" "eventually (\<lambda>n. g n \<le> h n) net"
   assumes lim: "(f \<longlongrightarrow> c) net" "(h \<longlongrightarrow> c) net"
   shows "(g \<longlongrightarrow> c) net"
 proof (rule order_tendstoI)
   fix a
   show "a < c \<Longrightarrow> eventually (\<lambda>x. a < g x) net"
     using order_tendstoD[OF lim(1), of a] ev by (auto elim: eventually_elim2)
 next
   fix a
   show "c < a \<Longrightarrow> eventually (\<lambda>x. g x < a) net"
     using order_tendstoD[OF lim(2), of a] ev by (auto elim: eventually_elim2)
 qed
 
 lemma (in t1_space) limit_frequently_eq:
   assumes "F \<noteq> bot"
     and "frequently (\<lambda>x. f x = c) F"
     and "(f \<longlongrightarrow> d) F"
   shows "d = c"
 proof (rule ccontr)
   assume "d \<noteq> c"
   from t1_space[OF this] obtain U where "open U" "d \<in> U" "c \<notin> U"
     by blast
   with assms have "eventually (\<lambda>x. f x \<in> U) F"
     unfolding tendsto_def by blast
   then have "eventually (\<lambda>x. f x \<noteq> c) F"
     by eventually_elim (insert \<open>c \<notin> U\<close>, blast)
   with assms(2) show False
     unfolding frequently_def by contradiction
 qed
 
 lemma (in t1_space) tendsto_imp_eventually_ne:
   assumes  "(f \<longlongrightarrow> c) F" "c \<noteq> c'"
   shows "eventually (\<lambda>z. f z \<noteq> c') F"
 proof (cases "F=bot")
   case True
   thus ?thesis by auto
 next
   case False
   show ?thesis
   proof (rule ccontr)
     assume "\<not> eventually (\<lambda>z. f z \<noteq> c') F"
     then have "frequently (\<lambda>z. f z = c') F"
       by (simp add: frequently_def)
     from limit_frequently_eq[OF False this \<open>(f \<longlongrightarrow> c) F\<close>] and \<open>c \<noteq> c'\<close> show False
       by contradiction
   qed
 qed
 
 lemma (in linorder_topology) tendsto_le:
   assumes F: "\<not> trivial_limit F"
     and x: "(f \<longlongrightarrow> x) F"
     and y: "(g \<longlongrightarrow> y) F"
     and ev: "eventually (\<lambda>x. g x \<le> f x) F"
   shows "y \<le> x"
 proof (rule ccontr)
   assume "\<not> y \<le> x"
   with less_separate[of x y] obtain a b where xy: "x < a" "b < y" "{..<a} \<inter> {b<..} = {}"
     by (auto simp: not_le)
   then have "eventually (\<lambda>x. f x < a) F" "eventually (\<lambda>x. b < g x) F"
     using x y by (auto intro: order_tendstoD)
   with ev have "eventually (\<lambda>x. False) F"
     by eventually_elim (insert xy, fastforce)
   with F show False
     by (simp add: eventually_False)
 qed
 
 lemma (in linorder_topology) tendsto_lowerbound:
   assumes x: "(f \<longlongrightarrow> x) F"
       and ev: "eventually (\<lambda>i. a \<le> f i) F"
       and F: "\<not> trivial_limit F"
   shows "a \<le> x"
   using F x tendsto_const ev by (rule tendsto_le)
 
 lemma (in linorder_topology) tendsto_upperbound:
   assumes x: "(f \<longlongrightarrow> x) F"
       and ev: "eventually (\<lambda>i. a \<ge> f i) F"
       and F: "\<not> trivial_limit F"
   shows "a \<ge> x"
   by (rule tendsto_le [OF F tendsto_const x ev])
 
 lemma filterlim_at_within_not_equal:
   fixes f::"'a \<Rightarrow> 'b::t2_space"
   assumes "filterlim f (at a within s) F"
   shows "eventually (\<lambda>w. f w\<in>s \<and> f w \<noteq>b) F"
 proof (cases "a=b")
   case True
   then show ?thesis using assms by (simp add: filterlim_at)
 next
   case False
   from hausdorff[OF this] obtain U V where UV:"open U" "open V" "a \<in> U" "b \<in> V" "U \<inter> V = {}"
     by auto  
   have "(f \<longlongrightarrow> a) F" using assms filterlim_at by auto
   then have "\<forall>\<^sub>F x in F. f x \<in> U" using UV unfolding tendsto_def by auto
   moreover have  "\<forall>\<^sub>F x in F. f x \<in> s \<and> f x\<noteq>a" using assms filterlim_at by auto
   ultimately show ?thesis 
     apply eventually_elim
     using UV by auto
 qed
 
 subsubsection \<open>Rules about \<^const>\<open>Lim\<close>\<close>
 
 lemma tendsto_Lim: "\<not> trivial_limit net \<Longrightarrow> (f \<longlongrightarrow> l) net \<Longrightarrow> Lim net f = l"
   unfolding Lim_def using tendsto_unique [of net f] by auto
 
 lemma Lim_ident_at: "\<not> trivial_limit (at x within s) \<Longrightarrow> Lim (at x within s) (\<lambda>x. x) = x"
   by (rule tendsto_Lim[OF _ tendsto_ident_at]) auto
 
 lemma eventually_Lim_ident_at:
   "(\<forall>\<^sub>F y in at x within X. P (Lim (at x within X) (\<lambda>x. x)) y) \<longleftrightarrow>
     (\<forall>\<^sub>F y in at x within X. P x y)" for x::"'a::t2_space"
   by (cases "at x within X = bot") (auto simp: Lim_ident_at)
 
 lemma filterlim_at_bot_at_right:
   fixes f :: "'a::linorder_topology \<Rightarrow> 'b::linorder"
   assumes mono: "\<And>x y. Q x \<Longrightarrow> Q y \<Longrightarrow> x \<le> y \<Longrightarrow> f x \<le> f y"
     and bij: "\<And>x. P x \<Longrightarrow> f (g x) = x" "\<And>x. P x \<Longrightarrow> Q (g x)"
     and Q: "eventually Q (at_right a)"
     and bound: "\<And>b. Q b \<Longrightarrow> a < b"
     and P: "eventually P at_bot"
   shows "filterlim f at_bot (at_right a)"
 proof -
   from P obtain x where x: "\<And>y. y \<le> x \<Longrightarrow> P y"
     unfolding eventually_at_bot_linorder by auto
   show ?thesis
   proof (intro filterlim_at_bot_le[THEN iffD2] allI impI)
     fix z
     assume "z \<le> x"
     with x have "P z" by auto
     have "eventually (\<lambda>x. x \<le> g z) (at_right a)"
       using bound[OF bij(2)[OF \<open>P z\<close>]]
       unfolding eventually_at_right[OF bound[OF bij(2)[OF \<open>P z\<close>]]]
       by (auto intro!: exI[of _ "g z"])
     with Q show "eventually (\<lambda>x. f x \<le> z) (at_right a)"
       by eventually_elim (metis bij \<open>P z\<close> mono)
   qed
 qed
 
 lemma filterlim_at_top_at_left:
   fixes f :: "'a::linorder_topology \<Rightarrow> 'b::linorder"
   assumes mono: "\<And>x y. Q x \<Longrightarrow> Q y \<Longrightarrow> x \<le> y \<Longrightarrow> f x \<le> f y"
     and bij: "\<And>x. P x \<Longrightarrow> f (g x) = x" "\<And>x. P x \<Longrightarrow> Q (g x)"
     and Q: "eventually Q (at_left a)"
     and bound: "\<And>b. Q b \<Longrightarrow> b < a"
     and P: "eventually P at_top"
   shows "filterlim f at_top (at_left a)"
 proof -
   from P obtain x where x: "\<And>y. x \<le> y \<Longrightarrow> P y"
     unfolding eventually_at_top_linorder by auto
   show ?thesis
   proof (intro filterlim_at_top_ge[THEN iffD2] allI impI)
     fix z
     assume "x \<le> z"
     with x have "P z" by auto
     have "eventually (\<lambda>x. g z \<le> x) (at_left a)"
       using bound[OF bij(2)[OF \<open>P z\<close>]]
       unfolding eventually_at_left[OF bound[OF bij(2)[OF \<open>P z\<close>]]]
       by (auto intro!: exI[of _ "g z"])
     with Q show "eventually (\<lambda>x. z \<le> f x) (at_left a)"
       by eventually_elim (metis bij \<open>P z\<close> mono)
   qed
 qed
 
 lemma filterlim_split_at:
   "filterlim f F (at_left x) \<Longrightarrow> filterlim f F (at_right x) \<Longrightarrow>
     filterlim f F (at x)"
   for x :: "'a::linorder_topology"
   by (subst at_eq_sup_left_right) (rule filterlim_sup)
 
 lemma filterlim_at_split:
   "filterlim f F (at x) \<longleftrightarrow> filterlim f F (at_left x) \<and> filterlim f F (at_right x)"
   for x :: "'a::linorder_topology"
   by (subst at_eq_sup_left_right) (simp add: filterlim_def filtermap_sup)
 
 lemma eventually_nhds_top:
   fixes P :: "'a :: {order_top,linorder_topology} \<Rightarrow> bool"
     and b :: 'a
   assumes "b < top"
   shows "eventually P (nhds top) \<longleftrightarrow> (\<exists>b<top. (\<forall>z. b < z \<longrightarrow> P z))"
   unfolding eventually_nhds
 proof safe
   fix S :: "'a set"
   assume "open S" "top \<in> S"
   note open_left[OF this \<open>b < top\<close>]
   moreover assume "\<forall>s\<in>S. P s"
   ultimately show "\<exists>b<top. \<forall>z>b. P z"
     by (auto simp: subset_eq Ball_def)
 next
   fix b
   assume "b < top" "\<forall>z>b. P z"
   then show "\<exists>S. open S \<and> top \<in> S \<and> (\<forall>xa\<in>S. P xa)"
     by (intro exI[of _ "{b <..}"]) auto
 qed
 
 lemma tendsto_at_within_iff_tendsto_nhds:
   "(g \<longlongrightarrow> g l) (at l within S) \<longleftrightarrow> (g \<longlongrightarrow> g l) (inf (nhds l) (principal S))"
   unfolding tendsto_def eventually_at_filter eventually_inf_principal
   by (intro ext all_cong imp_cong) (auto elim!: eventually_mono)
 
 
 subsection \<open>Limits on sequences\<close>
 
 abbreviation (in topological_space)
   LIMSEQ :: "[nat \<Rightarrow> 'a, 'a] \<Rightarrow> bool"  ("((_)/ \<longlonglongrightarrow> (_))" [60, 60] 60)
   where "X \<longlonglongrightarrow> L \<equiv> (X \<longlongrightarrow> L) sequentially"
 
 abbreviation (in t2_space) lim :: "(nat \<Rightarrow> 'a) \<Rightarrow> 'a"
   where "lim X \<equiv> Lim sequentially X"
 
 definition (in topological_space) convergent :: "(nat \<Rightarrow> 'a) \<Rightarrow> bool"
   where "convergent X = (\<exists>L. X \<longlonglongrightarrow> L)"
 
 lemma lim_def: "lim X = (THE L. X \<longlonglongrightarrow> L)"
   unfolding Lim_def ..
 
 lemma lim_explicit:
   "f \<longlonglongrightarrow> f0 \<longleftrightarrow> (\<forall>S. open S \<longrightarrow> f0 \<in> S \<longrightarrow> (\<exists>N. \<forall>n\<ge>N. f n \<in> S))"
   unfolding tendsto_def eventually_sequentially by auto
 
 
 subsection \<open>Monotone sequences and subsequences\<close>
 
 text \<open>
   Definition of monotonicity.
   The use of disjunction here complicates proofs considerably.
   One alternative is to add a Boolean argument to indicate the direction.
   Another is to develop the notions of increasing and decreasing first.
 \<close>
 definition monoseq :: "(nat \<Rightarrow> 'a::order) \<Rightarrow> bool"
   where "monoseq X \<longleftrightarrow> (\<forall>m. \<forall>n\<ge>m. X m \<le> X n) \<or> (\<forall>m. \<forall>n\<ge>m. X n \<le> X m)"
 
 abbreviation incseq :: "(nat \<Rightarrow> 'a::order) \<Rightarrow> bool"
   where "incseq X \<equiv> mono X"
 
 lemma incseq_def: "incseq X \<longleftrightarrow> (\<forall>m. \<forall>n\<ge>m. X n \<ge> X m)"
   unfolding mono_def ..
 
 abbreviation decseq :: "(nat \<Rightarrow> 'a::order) \<Rightarrow> bool"
   where "decseq X \<equiv> antimono X"
 
 lemma decseq_def: "decseq X \<longleftrightarrow> (\<forall>m. \<forall>n\<ge>m. X n \<le> X m)"
   unfolding antimono_def ..
 
 subsubsection \<open>Definition of subsequence.\<close>
 
 (* For compatibility with the old "subseq" *)
 lemma strict_mono_leD: "strict_mono r \<Longrightarrow> m \<le> n \<Longrightarrow> r m \<le> r n"
   by (erule (1) monoD [OF strict_mono_mono])
 
 lemma strict_mono_id: "strict_mono id"
   by (simp add: strict_mono_def)
 
 lemma incseq_SucI: "(\<And>n. X n \<le> X (Suc n)) \<Longrightarrow> incseq X"
   using lift_Suc_mono_le[of X] by (auto simp: incseq_def)
 
 lemma incseqD: "incseq f \<Longrightarrow> i \<le> j \<Longrightarrow> f i \<le> f j"
   by (auto simp: incseq_def)
 
 lemma incseq_SucD: "incseq A \<Longrightarrow> A i \<le> A (Suc i)"
   using incseqD[of A i "Suc i"] by auto
 
 lemma incseq_Suc_iff: "incseq f \<longleftrightarrow> (\<forall>n. f n \<le> f (Suc n))"
   by (auto intro: incseq_SucI dest: incseq_SucD)
 
 lemma incseq_const[simp, intro]: "incseq (\<lambda>x. k)"
   unfolding incseq_def by auto
 
 lemma decseq_SucI: "(\<And>n. X (Suc n) \<le> X n) \<Longrightarrow> decseq X"
   using order.lift_Suc_mono_le[OF dual_order, of X] by (auto simp: decseq_def)
 
 lemma decseqD: "decseq f \<Longrightarrow> i \<le> j \<Longrightarrow> f j \<le> f i"
   by (auto simp: decseq_def)
 
 lemma decseq_SucD: "decseq A \<Longrightarrow> A (Suc i) \<le> A i"
   using decseqD[of A i "Suc i"] by auto
 
 lemma decseq_Suc_iff: "decseq f \<longleftrightarrow> (\<forall>n. f (Suc n) \<le> f n)"
   by (auto intro: decseq_SucI dest: decseq_SucD)
 
 lemma decseq_const[simp, intro]: "decseq (\<lambda>x. k)"
   unfolding decseq_def by auto
 
 lemma monoseq_iff: "monoseq X \<longleftrightarrow> incseq X \<or> decseq X"
   unfolding monoseq_def incseq_def decseq_def ..
 
 lemma monoseq_Suc: "monoseq X \<longleftrightarrow> (\<forall>n. X n \<le> X (Suc n)) \<or> (\<forall>n. X (Suc n) \<le> X n)"
   unfolding monoseq_iff incseq_Suc_iff decseq_Suc_iff ..
 
 lemma monoI1: "\<forall>m. \<forall>n \<ge> m. X m \<le> X n \<Longrightarrow> monoseq X"
   by (simp add: monoseq_def)
 
 lemma monoI2: "\<forall>m. \<forall>n \<ge> m. X n \<le> X m \<Longrightarrow> monoseq X"
   by (simp add: monoseq_def)
 
 lemma mono_SucI1: "\<forall>n. X n \<le> X (Suc n) \<Longrightarrow> monoseq X"
   by (simp add: monoseq_Suc)
 
 lemma mono_SucI2: "\<forall>n. X (Suc n) \<le> X n \<Longrightarrow> monoseq X"
   by (simp add: monoseq_Suc)
 
 lemma monoseq_minus:
   fixes a :: "nat \<Rightarrow> 'a::ordered_ab_group_add"
   assumes "monoseq a"
   shows "monoseq (\<lambda> n. - a n)"
 proof (cases "\<forall>m. \<forall>n \<ge> m. a m \<le> a n")
   case True
   then have "\<forall>m. \<forall>n \<ge> m. - a n \<le> - a m" by auto
   then show ?thesis by (rule monoI2)
 next
   case False
   then have "\<forall>m. \<forall>n \<ge> m. - a m \<le> - a n"
     using \<open>monoseq a\<close>[unfolded monoseq_def] by auto
   then show ?thesis by (rule monoI1)
 qed
 
 
 subsubsection \<open>Subsequence (alternative definition, (e.g. Hoskins)\<close>
 
 lemma strict_mono_Suc_iff: "strict_mono f \<longleftrightarrow> (\<forall>n. f n < f (Suc n))"
 proof (intro iffI strict_monoI)
   assume *: "\<forall>n. f n < f (Suc n)"
   fix m n :: nat assume "m < n"
   thus "f m < f n"
     by (induction rule: less_Suc_induct) (use * in auto)
 qed (auto simp: strict_mono_def)
 
 lemma strict_mono_add: "strict_mono (\<lambda>n::'a::linordered_semidom. n + k)"
   by (auto simp: strict_mono_def)
 
 text \<open>For any sequence, there is a monotonic subsequence.\<close>
 lemma seq_monosub:
   fixes s :: "nat \<Rightarrow> 'a::linorder"
   shows "\<exists>f. strict_mono f \<and> monoseq (\<lambda>n. (s (f n)))"
 proof (cases "\<forall>n. \<exists>p>n. \<forall>m\<ge>p. s m \<le> s p")
   case True
   then have "\<exists>f. \<forall>n. (\<forall>m\<ge>f n. s m \<le> s (f n)) \<and> f n < f (Suc n)"
     by (intro dependent_nat_choice) (auto simp: conj_commute)
   then obtain f :: "nat \<Rightarrow> nat" 
     where f: "strict_mono f" and mono: "\<And>n m. f n \<le> m \<Longrightarrow> s m \<le> s (f n)"
     by (auto simp: strict_mono_Suc_iff)
   then have "incseq f"
     unfolding strict_mono_Suc_iff incseq_Suc_iff by (auto intro: less_imp_le)
   then have "monoseq (\<lambda>n. s (f n))"
     by (auto simp add: incseq_def intro!: mono monoI2)
   with f show ?thesis
     by auto
 next
   case False
   then obtain N where N: "p > N \<Longrightarrow> \<exists>m>p. s p < s m" for p
     by (force simp: not_le le_less)
   have "\<exists>f. \<forall>n. N < f n \<and> f n < f (Suc n) \<and> s (f n) \<le> s (f (Suc n))"
   proof (intro dependent_nat_choice)
     fix x
     assume "N < x" with N[of x]
     show "\<exists>y>N. x < y \<and> s x \<le> s y"
       by (auto intro: less_trans)
   qed auto
   then show ?thesis
     by (auto simp: monoseq_iff incseq_Suc_iff strict_mono_Suc_iff)
 qed
 
 lemma seq_suble:
   assumes sf: "strict_mono (f :: nat \<Rightarrow> nat)"
   shows "n \<le> f n"
 proof (induct n)
   case 0
   show ?case by simp
 next
   case (Suc n)
   with sf [unfolded strict_mono_Suc_iff, rule_format, of n] have "n < f (Suc n)"
      by arith
   then show ?case by arith
 qed
 
 lemma eventually_subseq:
   "strict_mono r \<Longrightarrow> eventually P sequentially \<Longrightarrow> eventually (\<lambda>n. P (r n)) sequentially"
   unfolding eventually_sequentially by (metis seq_suble le_trans)
 
 lemma not_eventually_sequentiallyD:
   assumes "\<not> eventually P sequentially"
   shows "\<exists>r::nat\<Rightarrow>nat. strict_mono r \<and> (\<forall>n. \<not> P (r n))"
 proof -
   from assms have "\<forall>n. \<exists>m\<ge>n. \<not> P m"
     unfolding eventually_sequentially by (simp add: not_less)
   then obtain r where "\<And>n. r n \<ge> n" "\<And>n. \<not> P (r n)"
     by (auto simp: choice_iff)
   then show ?thesis
     by (auto intro!: exI[of _ "\<lambda>n. r (((Suc \<circ> r) ^^ Suc n) 0)"]
              simp: less_eq_Suc_le strict_mono_Suc_iff)
 qed
 
 lemma sequentially_offset: 
   assumes "eventually (\<lambda>i. P i) sequentially"
   shows "eventually (\<lambda>i. P (i + k)) sequentially"
   using assms by (rule eventually_sequentially_seg [THEN iffD2])
 
 lemma seq_offset_neg: 
   "(f \<longlongrightarrow> l) sequentially \<Longrightarrow> ((\<lambda>i. f(i - k)) \<longlongrightarrow> l) sequentially"
   apply (erule filterlim_compose)
   apply (simp add: filterlim_def le_sequentially eventually_filtermap eventually_sequentially, arith)
   done
 
 lemma filterlim_subseq: "strict_mono f \<Longrightarrow> filterlim f sequentially sequentially"
   unfolding filterlim_iff by (metis eventually_subseq)
 
 lemma strict_mono_o: "strict_mono r \<Longrightarrow> strict_mono s \<Longrightarrow> strict_mono (r \<circ> s)"
   unfolding strict_mono_def by simp
 
 lemma strict_mono_compose: "strict_mono r \<Longrightarrow> strict_mono s \<Longrightarrow> strict_mono (\<lambda>x. r (s x))"
   using strict_mono_o[of r s] by (simp add: o_def)
 
 lemma incseq_imp_monoseq:  "incseq X \<Longrightarrow> monoseq X"
   by (simp add: incseq_def monoseq_def)
 
 lemma decseq_imp_monoseq:  "decseq X \<Longrightarrow> monoseq X"
   by (simp add: decseq_def monoseq_def)
 
 lemma decseq_eq_incseq: "decseq X = incseq (\<lambda>n. - X n)"
   for X :: "nat \<Rightarrow> 'a::ordered_ab_group_add"
   by (simp add: decseq_def incseq_def)
 
 lemma INT_decseq_offset:
   assumes "decseq F"
   shows "(\<Inter>i. F i) = (\<Inter>i\<in>{n..}. F i)"
 proof safe
   fix x i
   assume x: "x \<in> (\<Inter>i\<in>{n..}. F i)"
   show "x \<in> F i"
   proof cases
     from x have "x \<in> F n" by auto
     also assume "i \<le> n" with \<open>decseq F\<close> have "F n \<subseteq> F i"
       unfolding decseq_def by simp
     finally show ?thesis .
   qed (insert x, simp)
 qed auto
 
 lemma LIMSEQ_const_iff: "(\<lambda>n. k) \<longlonglongrightarrow> l \<longleftrightarrow> k = l"
   for k l :: "'a::t2_space"
   using trivial_limit_sequentially by (rule tendsto_const_iff)
 
 lemma LIMSEQ_SUP: "incseq X \<Longrightarrow> X \<longlonglongrightarrow> (SUP i. X i :: 'a::{complete_linorder,linorder_topology})"
   by (intro increasing_tendsto)
     (auto simp: SUP_upper less_SUP_iff incseq_def eventually_sequentially intro: less_le_trans)
 
 lemma LIMSEQ_INF: "decseq X \<Longrightarrow> X \<longlonglongrightarrow> (INF i. X i :: 'a::{complete_linorder,linorder_topology})"
   by (intro decreasing_tendsto)
     (auto simp: INF_lower INF_less_iff decseq_def eventually_sequentially intro: le_less_trans)
 
 lemma LIMSEQ_ignore_initial_segment: "f \<longlonglongrightarrow> a \<Longrightarrow> (\<lambda>n. f (n + k)) \<longlonglongrightarrow> a"
   unfolding tendsto_def by (subst eventually_sequentially_seg[where k=k])
 
 lemma LIMSEQ_offset: "(\<lambda>n. f (n + k)) \<longlonglongrightarrow> a \<Longrightarrow> f \<longlonglongrightarrow> a"
   unfolding tendsto_def
   by (subst (asm) eventually_sequentially_seg[where k=k])
 
 lemma LIMSEQ_Suc: "f \<longlonglongrightarrow> l \<Longrightarrow> (\<lambda>n. f (Suc n)) \<longlonglongrightarrow> l"
   by (drule LIMSEQ_ignore_initial_segment [where k="Suc 0"]) simp
 
 lemma LIMSEQ_imp_Suc: "(\<lambda>n. f (Suc n)) \<longlonglongrightarrow> l \<Longrightarrow> f \<longlonglongrightarrow> l"
   by (rule LIMSEQ_offset [where k="Suc 0"]) simp
 
 lemma LIMSEQ_lessThan_iff_atMost:
   shows "(\<lambda>n. f {..<n}) \<longlonglongrightarrow> x \<longleftrightarrow> (\<lambda>n. f {..n}) \<longlonglongrightarrow> x"
   apply (subst filterlim_sequentially_Suc [symmetric])
   apply (simp only: lessThan_Suc_atMost)
   done
 
 lemma (in t2_space) LIMSEQ_Uniq: "\<exists>\<^sub>\<le>\<^sub>1l. X \<longlonglongrightarrow> l"
  by (simp add: tendsto_unique')
 
 lemma (in t2_space) LIMSEQ_unique: "X \<longlonglongrightarrow> a \<Longrightarrow> X \<longlonglongrightarrow> b \<Longrightarrow> a = b"
   using trivial_limit_sequentially by (rule tendsto_unique)
 
 lemma LIMSEQ_le_const: "X \<longlonglongrightarrow> x \<Longrightarrow> \<exists>N. \<forall>n\<ge>N. a \<le> X n \<Longrightarrow> a \<le> x"
   for a x :: "'a::linorder_topology"
   by (simp add: eventually_at_top_linorder tendsto_lowerbound)
 
 lemma LIMSEQ_le: "X \<longlonglongrightarrow> x \<Longrightarrow> Y \<longlonglongrightarrow> y \<Longrightarrow> \<exists>N. \<forall>n\<ge>N. X n \<le> Y n \<Longrightarrow> x \<le> y"
   for x y :: "'a::linorder_topology"
   using tendsto_le[of sequentially Y y X x] by (simp add: eventually_sequentially)
 
 lemma LIMSEQ_le_const2: "X \<longlonglongrightarrow> x \<Longrightarrow> \<exists>N. \<forall>n\<ge>N. X n \<le> a \<Longrightarrow> x \<le> a"
   for a x :: "'a::linorder_topology"
   by (rule LIMSEQ_le[of X x "\<lambda>n. a"]) auto
 
 lemma Lim_bounded: "f \<longlonglongrightarrow> l \<Longrightarrow> \<forall>n\<ge>M. f n \<le> C \<Longrightarrow> l \<le> C"
   for l :: "'a::linorder_topology"
   by (intro LIMSEQ_le_const2) auto
 
 lemma Lim_bounded2:
   fixes f :: "nat \<Rightarrow> 'a::linorder_topology"
   assumes lim:"f \<longlonglongrightarrow> l" and ge: "\<forall>n\<ge>N. f n \<ge> C"
   shows "l \<ge> C"
   using ge
   by (intro tendsto_le[OF trivial_limit_sequentially lim tendsto_const])
      (auto simp: eventually_sequentially)
 
 lemma lim_mono:
   fixes X Y :: "nat \<Rightarrow> 'a::linorder_topology"
   assumes "\<And>n. N \<le> n \<Longrightarrow> X n \<le> Y n"
     and "X \<longlonglongrightarrow> x"
     and "Y \<longlonglongrightarrow> y"
   shows "x \<le> y"
   using assms(1) by (intro LIMSEQ_le[OF assms(2,3)]) auto
 
 lemma Sup_lim:
   fixes a :: "'a::{complete_linorder,linorder_topology}"
   assumes "\<And>n. b n \<in> s"
     and "b \<longlonglongrightarrow> a"
   shows "a \<le> Sup s"
   by (metis Lim_bounded assms complete_lattice_class.Sup_upper)
 
 lemma Inf_lim:
   fixes a :: "'a::{complete_linorder,linorder_topology}"
   assumes "\<And>n. b n \<in> s"
     and "b \<longlonglongrightarrow> a"
   shows "Inf s \<le> a"
   by (metis Lim_bounded2 assms complete_lattice_class.Inf_lower)
 
 lemma SUP_Lim:
   fixes X :: "nat \<Rightarrow> 'a::{complete_linorder,linorder_topology}"
   assumes inc: "incseq X"
     and l: "X \<longlonglongrightarrow> l"
   shows "(SUP n. X n) = l"
   using LIMSEQ_SUP[OF inc] tendsto_unique[OF trivial_limit_sequentially l]
   by simp
 
 lemma INF_Lim:
   fixes X :: "nat \<Rightarrow> 'a::{complete_linorder,linorder_topology}"
   assumes dec: "decseq X"
     and l: "X \<longlonglongrightarrow> l"
   shows "(INF n. X n) = l"
   using LIMSEQ_INF[OF dec] tendsto_unique[OF trivial_limit_sequentially l]
   by simp
 
 lemma convergentD: "convergent X \<Longrightarrow> \<exists>L. X \<longlonglongrightarrow> L"
   by (simp add: convergent_def)
 
 lemma convergentI: "X \<longlonglongrightarrow> L \<Longrightarrow> convergent X"
   by (auto simp add: convergent_def)
 
 lemma convergent_LIMSEQ_iff: "convergent X \<longleftrightarrow> X \<longlonglongrightarrow> lim X"
   by (auto intro: theI LIMSEQ_unique simp add: convergent_def lim_def)
 
 lemma convergent_const: "convergent (\<lambda>n. c)"
   by (rule convergentI) (rule tendsto_const)
 
 lemma monoseq_le:
   "monoseq a \<Longrightarrow> a \<longlonglongrightarrow> x \<Longrightarrow>
     (\<forall>n. a n \<le> x) \<and> (\<forall>m. \<forall>n\<ge>m. a m \<le> a n) \<or>
     (\<forall>n. x \<le> a n) \<and> (\<forall>m. \<forall>n\<ge>m. a n \<le> a m)"
   for x :: "'a::linorder_topology"
   by (metis LIMSEQ_le_const LIMSEQ_le_const2 decseq_def incseq_def monoseq_iff)
 
 lemma LIMSEQ_subseq_LIMSEQ: "X \<longlonglongrightarrow> L \<Longrightarrow> strict_mono f \<Longrightarrow> (X \<circ> f) \<longlonglongrightarrow> L"
   unfolding comp_def by (rule filterlim_compose [of X, OF _ filterlim_subseq])
 
 lemma convergent_subseq_convergent: "convergent X \<Longrightarrow> strict_mono f \<Longrightarrow> convergent (X \<circ> f)"
   by (auto simp: convergent_def intro: LIMSEQ_subseq_LIMSEQ)
 
 lemma limI: "X \<longlonglongrightarrow> L \<Longrightarrow> lim X = L"
   by (rule tendsto_Lim) (rule trivial_limit_sequentially)
 
 lemma lim_le: "convergent f \<Longrightarrow> (\<And>n. f n \<le> x) \<Longrightarrow> lim f \<le> x"
   for x :: "'a::linorder_topology"
   using LIMSEQ_le_const2[of f "lim f" x] by (simp add: convergent_LIMSEQ_iff)
 
 lemma lim_const [simp]: "lim (\<lambda>m. a) = a"
   by (simp add: limI)
 
 
 subsubsection \<open>Increasing and Decreasing Series\<close>
 
 lemma incseq_le: "incseq X \<Longrightarrow> X \<longlonglongrightarrow> L \<Longrightarrow> X n \<le> L"
   for L :: "'a::linorder_topology"
   by (metis incseq_def LIMSEQ_le_const)
 
 lemma decseq_ge: "decseq X \<Longrightarrow> X \<longlonglongrightarrow> L \<Longrightarrow> L \<le> X n"
   for L :: "'a::linorder_topology"
   by (metis decseq_def LIMSEQ_le_const2)
 
 
 subsection \<open>First countable topologies\<close>
 
 class first_countable_topology = topological_space +
   assumes first_countable_basis:
     "\<exists>A::nat \<Rightarrow> 'a set. (\<forall>i. x \<in> A i \<and> open (A i)) \<and> (\<forall>S. open S \<and> x \<in> S \<longrightarrow> (\<exists>i. A i \<subseteq> S))"
 
 lemma (in first_countable_topology) countable_basis_at_decseq:
   obtains A :: "nat \<Rightarrow> 'a set" where
     "\<And>i. open (A i)" "\<And>i. x \<in> (A i)"
     "\<And>S. open S \<Longrightarrow> x \<in> S \<Longrightarrow> eventually (\<lambda>i. A i \<subseteq> S) sequentially"
 proof atomize_elim
   from first_countable_basis[of x] obtain A :: "nat \<Rightarrow> 'a set"
     where nhds: "\<And>i. open (A i)" "\<And>i. x \<in> A i"
       and incl: "\<And>S. open S \<Longrightarrow> x \<in> S \<Longrightarrow> \<exists>i. A i \<subseteq> S"
     by auto
   define F where "F n = (\<Inter>i\<le>n. A i)" for n
   show "\<exists>A. (\<forall>i. open (A i)) \<and> (\<forall>i. x \<in> A i) \<and>
     (\<forall>S. open S \<longrightarrow> x \<in> S \<longrightarrow> eventually (\<lambda>i. A i \<subseteq> S) sequentially)"
   proof (safe intro!: exI[of _ F])
     fix i
     show "open (F i)"
       using nhds(1) by (auto simp: F_def)
     show "x \<in> F i"
       using nhds(2) by (auto simp: F_def)
   next
     fix S
     assume "open S" "x \<in> S"
     from incl[OF this] obtain i where "F i \<subseteq> S"
       unfolding F_def by auto
     moreover have "\<And>j. i \<le> j \<Longrightarrow> F j \<subseteq> F i"
       by (simp add: Inf_superset_mono F_def image_mono)
     ultimately show "eventually (\<lambda>i. F i \<subseteq> S) sequentially"
       by (auto simp: eventually_sequentially)
   qed
 qed
 
 lemma (in first_countable_topology) nhds_countable:
   obtains X :: "nat \<Rightarrow> 'a set"
   where "decseq X" "\<And>n. open (X n)" "\<And>n. x \<in> X n" "nhds x = (INF n. principal (X n))"
 proof -
   from first_countable_basis obtain A :: "nat \<Rightarrow> 'a set"
     where *: "\<And>n. x \<in> A n" "\<And>n. open (A n)" "\<And>S. open S \<Longrightarrow> x \<in> S \<Longrightarrow> \<exists>i. A i \<subseteq> S"
     by metis
   show thesis
   proof
     show "decseq (\<lambda>n. \<Inter>i\<le>n. A i)"
       by (simp add: antimono_iff_le_Suc atMost_Suc)
     show "x \<in> (\<Inter>i\<le>n. A i)" "\<And>n. open (\<Inter>i\<le>n. A i)" for n
       using * by auto
     with * show "nhds x = (INF n. principal (\<Inter>i\<le>n. A i))"
       unfolding nhds_def
       apply (intro INF_eq)
        apply fastforce
       apply blast
       done
   qed
 qed
 
 lemma (in first_countable_topology) countable_basis:
   obtains A :: "nat \<Rightarrow> 'a set" where
     "\<And>i. open (A i)" "\<And>i. x \<in> A i"
     "\<And>F. (\<forall>n. F n \<in> A n) \<Longrightarrow> F \<longlonglongrightarrow> x"
 proof atomize_elim
   obtain A :: "nat \<Rightarrow> 'a set" where *:
     "\<And>i. open (A i)"
     "\<And>i. x \<in> A i"
     "\<And>S. open S \<Longrightarrow> x \<in> S \<Longrightarrow> eventually (\<lambda>i. A i \<subseteq> S) sequentially"
     by (rule countable_basis_at_decseq) blast
   have "eventually (\<lambda>n. F n \<in> S) sequentially"
     if "\<forall>n. F n \<in> A n" "open S" "x \<in> S" for F S
     using *(3)[of S] that by (auto elim: eventually_mono simp: subset_eq)
   with * show "\<exists>A. (\<forall>i. open (A i)) \<and> (\<forall>i. x \<in> A i) \<and> (\<forall>F. (\<forall>n. F n \<in> A n) \<longrightarrow> F \<longlonglongrightarrow> x)"
     by (intro exI[of _ A]) (auto simp: tendsto_def)
 qed
 
 lemma (in first_countable_topology) sequentially_imp_eventually_nhds_within:
   assumes "\<forall>f. (\<forall>n. f n \<in> s) \<and> f \<longlonglongrightarrow> a \<longrightarrow> eventually (\<lambda>n. P (f n)) sequentially"
   shows "eventually P (inf (nhds a) (principal s))"
 proof (rule ccontr)
   obtain A :: "nat \<Rightarrow> 'a set" where *:
     "\<And>i. open (A i)"
     "\<And>i. a \<in> A i"
     "\<And>F. \<forall>n. F n \<in> A n \<Longrightarrow> F \<longlonglongrightarrow> a"
     by (rule countable_basis) blast
   assume "\<not> ?thesis"
   with * have "\<exists>F. \<forall>n. F n \<in> s \<and> F n \<in> A n \<and> \<not> P (F n)"
     unfolding eventually_inf_principal eventually_nhds
     by (intro choice) fastforce
   then obtain F where F: "\<forall>n. F n \<in> s" and "\<forall>n. F n \<in> A n" and F': "\<forall>n. \<not> P (F n)"
     by blast
   with * have "F \<longlonglongrightarrow> a"
     by auto
   then have "eventually (\<lambda>n. P (F n)) sequentially"
     using assms F by simp
   then show False
     by (simp add: F')
 qed
 
 lemma (in first_countable_topology) eventually_nhds_within_iff_sequentially:
   "eventually P (inf (nhds a) (principal s)) \<longleftrightarrow>
     (\<forall>f. (\<forall>n. f n \<in> s) \<and> f \<longlonglongrightarrow> a \<longrightarrow> eventually (\<lambda>n. P (f n)) sequentially)"
 proof (safe intro!: sequentially_imp_eventually_nhds_within)
   assume "eventually P (inf (nhds a) (principal s))"
   then obtain S where "open S" "a \<in> S" "\<forall>x\<in>S. x \<in> s \<longrightarrow> P x"
     by (auto simp: eventually_inf_principal eventually_nhds)
   moreover
   fix f
   assume "\<forall>n. f n \<in> s" "f \<longlonglongrightarrow> a"
   ultimately show "eventually (\<lambda>n. P (f n)) sequentially"
     by (auto dest!: topological_tendstoD elim: eventually_mono)
 qed
 
 lemma (in first_countable_topology) eventually_nhds_iff_sequentially:
   "eventually P (nhds a) \<longleftrightarrow> (\<forall>f. f \<longlonglongrightarrow> a \<longrightarrow> eventually (\<lambda>n. P (f n)) sequentially)"
   using eventually_nhds_within_iff_sequentially[of P a UNIV] by simp
 
 (*Thanks to Sébastien Gouëzel*)
 lemma Inf_as_limit:
   fixes A::"'a::{linorder_topology, first_countable_topology, complete_linorder} set"
   assumes "A \<noteq> {}"
   shows "\<exists>u. (\<forall>n. u n \<in> A) \<and> u \<longlonglongrightarrow> Inf A"
 proof (cases "Inf A \<in> A")
   case True
   show ?thesis
     by (rule exI[of _ "\<lambda>n. Inf A"], auto simp add: True)
 next
   case False
   obtain y where "y \<in> A" using assms by auto
   then have "Inf A < y" using False Inf_lower less_le by auto
   obtain F :: "nat \<Rightarrow> 'a set" where F: "\<And>i. open (F i)" "\<And>i. Inf A \<in> F i"
                                        "\<And>u. (\<forall>n. u n \<in> F n) \<Longrightarrow> u \<longlonglongrightarrow> Inf A"
     by (metis first_countable_topology_class.countable_basis)
   define u where "u = (\<lambda>n. SOME z. z \<in> F n \<and> z \<in> A)"
   have "\<exists>z. z \<in> U \<and> z \<in> A" if "Inf A \<in> U" "open U" for U
   proof -
     obtain b where "b > Inf A" "{Inf A ..<b} \<subseteq> U"
       using open_right[OF \<open>open U\<close> \<open>Inf A \<in> U\<close> \<open>Inf A < y\<close>] by auto
     obtain z where "z < b" "z \<in> A"
       using \<open>Inf A < b\<close> Inf_less_iff by auto
     then have "z \<in> {Inf A ..<b}"
       by (simp add: Inf_lower)
     then show ?thesis using \<open>z \<in> A\<close> \<open>{Inf A ..<b} \<subseteq> U\<close> by auto
   qed
   then have *: "u n \<in> F n \<and> u n \<in> A" for n
     using \<open>Inf A \<in> F n\<close> \<open>open (F n)\<close> unfolding u_def by (metis (no_types, lifting) someI_ex)
   then have "u \<longlonglongrightarrow> Inf A" using F(3) by simp
   then show ?thesis using * by auto
 qed
 
 lemma tendsto_at_iff_sequentially:
   "(f \<longlongrightarrow> a) (at x within s) \<longleftrightarrow> (\<forall>X. (\<forall>i. X i \<in> s - {x}) \<longrightarrow> X \<longlonglongrightarrow> x \<longrightarrow> ((f \<circ> X) \<longlonglongrightarrow> a))"
   for f :: "'a::first_countable_topology \<Rightarrow> _"
   unfolding filterlim_def[of _ "nhds a"] le_filter_def eventually_filtermap
     at_within_def eventually_nhds_within_iff_sequentially comp_def
   by metis
 
 lemma approx_from_above_dense_linorder:
   fixes x::"'a::{dense_linorder, linorder_topology, first_countable_topology}"
   assumes "x < y"
   shows "\<exists>u. (\<forall>n. u n > x) \<and> (u \<longlonglongrightarrow> x)"
 proof -
   obtain A :: "nat \<Rightarrow> 'a set" where A: "\<And>i. open (A i)" "\<And>i. x \<in> A i"
                                       "\<And>F. (\<forall>n. F n \<in> A n) \<Longrightarrow> F \<longlonglongrightarrow> x"
     by (metis first_countable_topology_class.countable_basis)
   define u where "u = (\<lambda>n. SOME z. z \<in> A n \<and> z > x)"
   have "\<exists>z. z \<in> U \<and> x < z" if "x \<in> U" "open U" for U
     using open_right[OF \<open>open U\<close> \<open>x \<in> U\<close> \<open>x < y\<close>]
     by (meson atLeastLessThan_iff dense less_imp_le subset_eq)
   then have *: "u n \<in> A n \<and> x < u n" for n
     using \<open>x \<in> A n\<close> \<open>open (A n)\<close> unfolding u_def by (metis (no_types, lifting) someI_ex)
   then have "u \<longlonglongrightarrow> x" using A(3) by simp
   then show ?thesis using * by auto
 qed
 
 lemma approx_from_below_dense_linorder:
   fixes x::"'a::{dense_linorder, linorder_topology, first_countable_topology}"
   assumes "x > y"
   shows "\<exists>u. (\<forall>n. u n < x) \<and> (u \<longlonglongrightarrow> x)"
 proof -
   obtain A :: "nat \<Rightarrow> 'a set" where A: "\<And>i. open (A i)" "\<And>i. x \<in> A i"
                                       "\<And>F. (\<forall>n. F n \<in> A n) \<Longrightarrow> F \<longlonglongrightarrow> x"
     by (metis first_countable_topology_class.countable_basis)
   define u where "u = (\<lambda>n. SOME z. z \<in> A n \<and> z < x)"
   have "\<exists>z. z \<in> U \<and> z < x" if "x \<in> U" "open U" for U
     using open_left[OF \<open>open U\<close> \<open>x \<in> U\<close> \<open>x > y\<close>]
     by (meson dense greaterThanAtMost_iff less_imp_le subset_eq)
   then have *: "u n \<in> A n \<and> u n < x" for n
     using \<open>x \<in> A n\<close> \<open>open (A n)\<close> unfolding u_def by (metis (no_types, lifting) someI_ex)
   then have "u \<longlonglongrightarrow> x" using A(3) by simp
   then show ?thesis using * by auto
 qed
 
 
 subsection \<open>Function limit at a point\<close>
 
 abbreviation LIM :: "('a::topological_space \<Rightarrow> 'b::topological_space) \<Rightarrow> 'a \<Rightarrow> 'b \<Rightarrow> bool"
     ("((_)/ \<midarrow>(_)/\<rightarrow> (_))" [60, 0, 60] 60)
   where "f \<midarrow>a\<rightarrow> L \<equiv> (f \<longlongrightarrow> L) (at a)"
 
 lemma tendsto_within_open: "a \<in> S \<Longrightarrow> open S \<Longrightarrow> (f \<longlongrightarrow> l) (at a within S) \<longleftrightarrow> (f \<midarrow>a\<rightarrow> l)"
   by (simp add: tendsto_def at_within_open[where S = S])
 
 lemma tendsto_within_open_NO_MATCH:
   "a \<in> S \<Longrightarrow> NO_MATCH UNIV S \<Longrightarrow> open S \<Longrightarrow> (f \<longlongrightarrow> l)(at a within S) \<longleftrightarrow> (f \<longlongrightarrow> l)(at a)"
   for f :: "'a::topological_space \<Rightarrow> 'b::topological_space"
   using tendsto_within_open by blast
 
 lemma LIM_const_not_eq[tendsto_intros]: "k \<noteq> L \<Longrightarrow> \<not> (\<lambda>x. k) \<midarrow>a\<rightarrow> L"
   for a :: "'a::perfect_space" and k L :: "'b::t2_space"
   by (simp add: tendsto_const_iff)
 
 lemmas LIM_not_zero = LIM_const_not_eq [where L = 0]
 
 lemma LIM_const_eq: "(\<lambda>x. k) \<midarrow>a\<rightarrow> L \<Longrightarrow> k = L"
   for a :: "'a::perfect_space" and k L :: "'b::t2_space"
   by (simp add: tendsto_const_iff)
 
 lemma LIM_unique: "f \<midarrow>a\<rightarrow> L \<Longrightarrow> f \<midarrow>a\<rightarrow> M \<Longrightarrow> L = M"
   for a :: "'a::perfect_space" and L M :: "'b::t2_space"
   using at_neq_bot by (rule tendsto_unique)
 
 lemma LIM_Uniq: "\<exists>\<^sub>\<le>\<^sub>1L::'b::t2_space. f \<midarrow>a\<rightarrow> L"
   for a :: "'a::perfect_space"
  by (auto simp add: Uniq_def LIM_unique)
 
 
 text \<open>Limits are equal for functions equal except at limit point.\<close>
 lemma LIM_equal: "\<forall>x. x \<noteq> a \<longrightarrow> f x = g x \<Longrightarrow> (f \<midarrow>a\<rightarrow> l) \<longleftrightarrow> (g \<midarrow>a\<rightarrow> l)"
   by (simp add: tendsto_def eventually_at_topological)
 
 lemma LIM_cong: "a = b \<Longrightarrow> (\<And>x. x \<noteq> b \<Longrightarrow> f x = g x) \<Longrightarrow> l = m \<Longrightarrow> (f \<midarrow>a\<rightarrow> l) \<longleftrightarrow> (g \<midarrow>b\<rightarrow> m)"
   by (simp add: LIM_equal)
 
 lemma tendsto_cong_limit: "(f \<longlongrightarrow> l) F \<Longrightarrow> k = l \<Longrightarrow> (f \<longlongrightarrow> k) F"
   by simp
 
 lemma tendsto_at_iff_tendsto_nhds: "g \<midarrow>l\<rightarrow> g l \<longleftrightarrow> (g \<longlongrightarrow> g l) (nhds l)"
   unfolding tendsto_def eventually_at_filter
   by (intro ext all_cong imp_cong) (auto elim!: eventually_mono)
 
 lemma tendsto_compose: "g \<midarrow>l\<rightarrow> g l \<Longrightarrow> (f \<longlongrightarrow> l) F \<Longrightarrow> ((\<lambda>x. g (f x)) \<longlongrightarrow> g l) F"
   unfolding tendsto_at_iff_tendsto_nhds by (rule filterlim_compose[of g])
 
 lemma tendsto_compose_eventually:
   "g \<midarrow>l\<rightarrow> m \<Longrightarrow> (f \<longlongrightarrow> l) F \<Longrightarrow> eventually (\<lambda>x. f x \<noteq> l) F \<Longrightarrow> ((\<lambda>x. g (f x)) \<longlongrightarrow> m) F"
   by (rule filterlim_compose[of g _ "at l"]) (auto simp add: filterlim_at)
 
 lemma LIM_compose_eventually:
   assumes "f \<midarrow>a\<rightarrow> b"
     and "g \<midarrow>b\<rightarrow> c"
     and "eventually (\<lambda>x. f x \<noteq> b) (at a)"
   shows "(\<lambda>x. g (f x)) \<midarrow>a\<rightarrow> c"
   using assms(2,1,3) by (rule tendsto_compose_eventually)
 
 lemma tendsto_compose_filtermap: "((g \<circ> f) \<longlongrightarrow> T) F \<longleftrightarrow> (g \<longlongrightarrow> T) (filtermap f F)"
   by (simp add: filterlim_def filtermap_filtermap comp_def)
 
 lemma tendsto_compose_at:
   assumes f: "(f \<longlongrightarrow> y) F" and g: "(g \<longlongrightarrow> z) (at y)" and fg: "eventually (\<lambda>w. f w = y \<longrightarrow> g y = z) F"
   shows "((g \<circ> f) \<longlongrightarrow> z) F"
 proof -
   have "(\<forall>\<^sub>F a in F. f a \<noteq> y) \<or> g y = z"
     using fg by force
   moreover have "(g \<longlongrightarrow> z) (filtermap f F) \<or> \<not> (\<forall>\<^sub>F a in F. f a \<noteq> y)"
     by (metis (no_types) filterlim_atI filterlim_def tendsto_mono f g)
   ultimately show ?thesis
     by (metis (no_types) f filterlim_compose filterlim_filtermap g tendsto_at_iff_tendsto_nhds tendsto_compose_filtermap)
 qed
 
 
 subsubsection \<open>Relation of \<open>LIM\<close> and \<open>LIMSEQ\<close>\<close>
 
 lemma (in first_countable_topology) sequentially_imp_eventually_within:
   "(\<forall>f. (\<forall>n. f n \<in> s \<and> f n \<noteq> a) \<and> f \<longlonglongrightarrow> a \<longrightarrow> eventually (\<lambda>n. P (f n)) sequentially) \<Longrightarrow>
     eventually P (at a within s)"
   unfolding at_within_def
   by (intro sequentially_imp_eventually_nhds_within) auto
 
 lemma (in first_countable_topology) sequentially_imp_eventually_at:
   "(\<forall>f. (\<forall>n. f n \<noteq> a) \<and> f \<longlonglongrightarrow> a \<longrightarrow> eventually (\<lambda>n. P (f n)) sequentially) \<Longrightarrow> eventually P (at a)"
   using sequentially_imp_eventually_within [where s=UNIV] by simp
 
 lemma LIMSEQ_SEQ_conv:
   "(\<forall>S. (\<forall>n. S n \<noteq> a) \<and> S \<longlonglongrightarrow> a \<longrightarrow> (\<lambda>n. X (S n)) \<longlonglongrightarrow> L)  \<longleftrightarrow>  X \<midarrow>a\<rightarrow> L"  (is "?lhs=?rhs")
   for a :: "'a::first_countable_topology" and L :: "'b::topological_space"
 proof
   assume ?lhs then show ?rhs
     by (simp add: sequentially_imp_eventually_within tendsto_def) 
 next
   assume ?rhs then show ?lhs
     using tendsto_compose_eventually eventuallyI by blast
 qed    
 
 lemma sequentially_imp_eventually_at_left:
   fixes a :: "'a::{linorder_topology,first_countable_topology}"
   assumes b[simp]: "b < a"
     and *: "\<And>f. (\<And>n. b < f n) \<Longrightarrow> (\<And>n. f n < a) \<Longrightarrow> incseq f \<Longrightarrow> f \<longlonglongrightarrow> a \<Longrightarrow>
       eventually (\<lambda>n. P (f n)) sequentially"
   shows "eventually P (at_left a)"
 proof (safe intro!: sequentially_imp_eventually_within)
   fix X
   assume X: "\<forall>n. X n \<in> {..< a} \<and> X n \<noteq> a" "X \<longlonglongrightarrow> a"
   show "eventually (\<lambda>n. P (X n)) sequentially"
   proof (rule ccontr)
     assume neg: "\<not> ?thesis"
     have "\<exists>s. \<forall>n. (\<not> P (X (s n)) \<and> b < X (s n)) \<and> (X (s n) \<le> X (s (Suc n)) \<and> Suc (s n) \<le> s (Suc n))"
       (is "\<exists>s. ?P s")
     proof (rule dependent_nat_choice)
       have "\<not> eventually (\<lambda>n. b < X n \<longrightarrow> P (X n)) sequentially"
         by (intro not_eventually_impI neg order_tendstoD(1) [OF X(2) b])
       then show "\<exists>x. \<not> P (X x) \<and> b < X x"
         by (auto dest!: not_eventuallyD)
     next
       fix x n
       have "\<not> eventually (\<lambda>n. Suc x \<le> n \<longrightarrow> b < X n \<longrightarrow> X x < X n \<longrightarrow> P (X n)) sequentially"
         using X
         by (intro not_eventually_impI order_tendstoD(1)[OF X(2)] eventually_ge_at_top neg) auto
       then show "\<exists>n. (\<not> P (X n) \<and> b < X n) \<and> (X x \<le> X n \<and> Suc x \<le> n)"
         by (auto dest!: not_eventuallyD)
     qed
     then obtain s where "?P s" ..
     with X have "b < X (s n)"
       and "X (s n) < a"
       and "incseq (\<lambda>n. X (s n))"
       and "(\<lambda>n. X (s n)) \<longlonglongrightarrow> a"
       and "\<not> P (X (s n))"
       for n
       by (auto simp: strict_mono_Suc_iff Suc_le_eq incseq_Suc_iff
           intro!: LIMSEQ_subseq_LIMSEQ[OF \<open>X \<longlonglongrightarrow> a\<close>, unfolded comp_def])
     from *[OF this(1,2,3,4)] this(5) show False
       by auto
   qed
 qed
 
 lemma tendsto_at_left_sequentially:
   fixes a b :: "'b::{linorder_topology,first_countable_topology}"
   assumes "b < a"
   assumes *: "\<And>S. (\<And>n. S n < a) \<Longrightarrow> (\<And>n. b < S n) \<Longrightarrow> incseq S \<Longrightarrow> S \<longlonglongrightarrow> a \<Longrightarrow>
     (\<lambda>n. X (S n)) \<longlonglongrightarrow> L"
   shows "(X \<longlongrightarrow> L) (at_left a)"
   using assms by (simp add: tendsto_def [where l=L] sequentially_imp_eventually_at_left)
 
 lemma sequentially_imp_eventually_at_right:
   fixes a b :: "'a::{linorder_topology,first_countable_topology}"
   assumes b[simp]: "a < b"
   assumes *: "\<And>f. (\<And>n. a < f n) \<Longrightarrow> (\<And>n. f n < b) \<Longrightarrow> decseq f \<Longrightarrow> f \<longlonglongrightarrow> a \<Longrightarrow>
     eventually (\<lambda>n. P (f n)) sequentially"
   shows "eventually P (at_right a)"
 proof (safe intro!: sequentially_imp_eventually_within)
   fix X
   assume X: "\<forall>n. X n \<in> {a <..} \<and> X n \<noteq> a" "X \<longlonglongrightarrow> a"
   show "eventually (\<lambda>n. P (X n)) sequentially"
   proof (rule ccontr)
     assume neg: "\<not> ?thesis"
     have "\<exists>s. \<forall>n. (\<not> P (X (s n)) \<and> X (s n) < b) \<and> (X (s (Suc n)) \<le> X (s n) \<and> Suc (s n) \<le> s (Suc n))"
       (is "\<exists>s. ?P s")
     proof (rule dependent_nat_choice)
       have "\<not> eventually (\<lambda>n. X n < b \<longrightarrow> P (X n)) sequentially"
         by (intro not_eventually_impI neg order_tendstoD(2) [OF X(2) b])
       then show "\<exists>x. \<not> P (X x) \<and> X x < b"
         by (auto dest!: not_eventuallyD)
     next
       fix x n
       have "\<not> eventually (\<lambda>n. Suc x \<le> n \<longrightarrow> X n < b \<longrightarrow> X n < X x \<longrightarrow> P (X n)) sequentially"
         using X
         by (intro not_eventually_impI order_tendstoD(2)[OF X(2)] eventually_ge_at_top neg) auto
       then show "\<exists>n. (\<not> P (X n) \<and> X n < b) \<and> (X n \<le> X x \<and> Suc x \<le> n)"
         by (auto dest!: not_eventuallyD)
     qed
     then obtain s where "?P s" ..
     with X have "a < X (s n)"
       and "X (s n) < b"
       and "decseq (\<lambda>n. X (s n))"
       and "(\<lambda>n. X (s n)) \<longlonglongrightarrow> a"
       and "\<not> P (X (s n))"
       for n
       by (auto simp: strict_mono_Suc_iff Suc_le_eq decseq_Suc_iff
           intro!: LIMSEQ_subseq_LIMSEQ[OF \<open>X \<longlonglongrightarrow> a\<close>, unfolded comp_def])
     from *[OF this(1,2,3,4)] this(5) show False
       by auto
   qed
 qed
 
 lemma tendsto_at_right_sequentially:
   fixes a :: "_ :: {linorder_topology, first_countable_topology}"
   assumes "a < b"
     and *: "\<And>S. (\<And>n. a < S n) \<Longrightarrow> (\<And>n. S n < b) \<Longrightarrow> decseq S \<Longrightarrow> S \<longlonglongrightarrow> a \<Longrightarrow>
       (\<lambda>n. X (S n)) \<longlonglongrightarrow> L"
   shows "(X \<longlongrightarrow> L) (at_right a)"
   using assms by (simp add: tendsto_def [where l=L] sequentially_imp_eventually_at_right)
 
 
 subsection \<open>Continuity\<close>
 
 subsubsection \<open>Continuity on a set\<close>
 
 definition continuous_on :: "'a set \<Rightarrow> ('a::topological_space \<Rightarrow> 'b::topological_space) \<Rightarrow> bool"
   where "continuous_on s f \<longleftrightarrow> (\<forall>x\<in>s. (f \<longlongrightarrow> f x) (at x within s))"
 
 lemma continuous_on_cong [cong]:
   "s = t \<Longrightarrow> (\<And>x. x \<in> t \<Longrightarrow> f x = g x) \<Longrightarrow> continuous_on s f \<longleftrightarrow> continuous_on t g"
   unfolding continuous_on_def
   by (intro ball_cong filterlim_cong) (auto simp: eventually_at_filter)
 
 lemma continuous_on_cong_simp:
   "s = t \<Longrightarrow> (\<And>x. x \<in> t =simp=> f x = g x) \<Longrightarrow> continuous_on s f \<longleftrightarrow> continuous_on t g"
   unfolding simp_implies_def by (rule continuous_on_cong)
 
 lemma continuous_on_topological:
   "continuous_on s f \<longleftrightarrow>
     (\<forall>x\<in>s. \<forall>B. open B \<longrightarrow> f x \<in> B \<longrightarrow> (\<exists>A. open A \<and> x \<in> A \<and> (\<forall>y\<in>s. y \<in> A \<longrightarrow> f y \<in> B)))"
   unfolding continuous_on_def tendsto_def eventually_at_topological by metis
 
 lemma continuous_on_open_invariant:
   "continuous_on s f \<longleftrightarrow> (\<forall>B. open B \<longrightarrow> (\<exists>A. open A \<and> A \<inter> s = f -` B \<inter> s))"
 proof safe
   fix B :: "'b set"
   assume "continuous_on s f" "open B"
   then have "\<forall>x\<in>f -` B \<inter> s. (\<exists>A. open A \<and> x \<in> A \<and> s \<inter> A \<subseteq> f -` B)"
     by (auto simp: continuous_on_topological subset_eq Ball_def imp_conjL)
   then obtain A where "\<forall>x\<in>f -` B \<inter> s. open (A x) \<and> x \<in> A x \<and> s \<inter> A x \<subseteq> f -` B"
     unfolding bchoice_iff ..
   then show "\<exists>A. open A \<and> A \<inter> s = f -` B \<inter> s"
     by (intro exI[of _ "\<Union>x\<in>f -` B \<inter> s. A x"]) auto
 next
   assume B: "\<forall>B. open B \<longrightarrow> (\<exists>A. open A \<and> A \<inter> s = f -` B \<inter> s)"
   show "continuous_on s f"
     unfolding continuous_on_topological
   proof safe
     fix x B
     assume "x \<in> s" "open B" "f x \<in> B"
     with B obtain A where A: "open A" "A \<inter> s = f -` B \<inter> s"
       by auto
     with \<open>x \<in> s\<close> \<open>f x \<in> B\<close> show "\<exists>A. open A \<and> x \<in> A \<and> (\<forall>y\<in>s. y \<in> A \<longrightarrow> f y \<in> B)"
       by (intro exI[of _ A]) auto
   qed
 qed
 
 lemma continuous_on_open_vimage:
   "open s \<Longrightarrow> continuous_on s f \<longleftrightarrow> (\<forall>B. open B \<longrightarrow> open (f -` B \<inter> s))"
   unfolding continuous_on_open_invariant
   by (metis open_Int Int_absorb Int_commute[of s] Int_assoc[of _ _ s])
 
 corollary continuous_imp_open_vimage:
   assumes "continuous_on s f" "open s" "open B" "f -` B \<subseteq> s"
   shows "open (f -` B)"
   by (metis assms continuous_on_open_vimage le_iff_inf)
 
 corollary open_vimage[continuous_intros]:
   assumes "open s"
     and "continuous_on UNIV f"
   shows "open (f -` s)"
   using assms by (simp add: continuous_on_open_vimage [OF open_UNIV])
 
 lemma continuous_on_closed_invariant:
   "continuous_on s f \<longleftrightarrow> (\<forall>B. closed B \<longrightarrow> (\<exists>A. closed A \<and> A \<inter> s = f -` B \<inter> s))"
 proof -
   have *: "(\<And>A. P A \<longleftrightarrow> Q (- A)) \<Longrightarrow> (\<forall>A. P A) \<longleftrightarrow> (\<forall>A. Q A)"
     for P Q :: "'b set \<Rightarrow> bool"
     by (metis double_compl)
   show ?thesis
     unfolding continuous_on_open_invariant
     by (intro *) (auto simp: open_closed[symmetric])
 qed
 
 lemma continuous_on_closed_vimage:
   "closed s \<Longrightarrow> continuous_on s f \<longleftrightarrow> (\<forall>B. closed B \<longrightarrow> closed (f -` B \<inter> s))"
   unfolding continuous_on_closed_invariant
   by (metis closed_Int Int_absorb Int_commute[of s] Int_assoc[of _ _ s])
 
 corollary closed_vimage_Int[continuous_intros]:
   assumes "closed s"
     and "continuous_on t f"
     and t: "closed t"
   shows "closed (f -` s \<inter> t)"
   using assms by (simp add: continuous_on_closed_vimage [OF t])
 
 corollary closed_vimage[continuous_intros]:
   assumes "closed s"
     and "continuous_on UNIV f"
   shows "closed (f -` s)"
   using closed_vimage_Int [OF assms] by simp
 
 lemma continuous_on_empty [simp]: "continuous_on {} f"
   by (simp add: continuous_on_def)
 
 lemma continuous_on_sing [simp]: "continuous_on {x} f"
   by (simp add: continuous_on_def at_within_def)
 
 lemma continuous_on_open_Union:
   "(\<And>s. s \<in> S \<Longrightarrow> open s) \<Longrightarrow> (\<And>s. s \<in> S \<Longrightarrow> continuous_on s f) \<Longrightarrow> continuous_on (\<Union>S) f"
   unfolding continuous_on_def
   by safe (metis open_Union at_within_open UnionI)
 
 lemma continuous_on_open_UN:
   "(\<And>s. s \<in> S \<Longrightarrow> open (A s)) \<Longrightarrow> (\<And>s. s \<in> S \<Longrightarrow> continuous_on (A s) f) \<Longrightarrow>
     continuous_on (\<Union>s\<in>S. A s) f"
   by (rule continuous_on_open_Union) auto
 
 lemma continuous_on_open_Un:
   "open s \<Longrightarrow> open t \<Longrightarrow> continuous_on s f \<Longrightarrow> continuous_on t f \<Longrightarrow> continuous_on (s \<union> t) f"
   using continuous_on_open_Union [of "{s,t}"] by auto
 
 lemma continuous_on_closed_Un:
   "closed s \<Longrightarrow> closed t \<Longrightarrow> continuous_on s f \<Longrightarrow> continuous_on t f \<Longrightarrow> continuous_on (s \<union> t) f"
   by (auto simp add: continuous_on_closed_vimage closed_Un Int_Un_distrib)
 
 lemma continuous_on_closed_Union:
   assumes "finite I"
     "\<And>i. i \<in> I \<Longrightarrow> closed (U i)"
     "\<And>i. i \<in> I \<Longrightarrow> continuous_on (U i) f"
   shows "continuous_on (\<Union> i \<in> I. U i) f"
   using assms
   by (induction I) (auto intro!: continuous_on_closed_Un)
 
 lemma continuous_on_If:
   assumes closed: "closed s" "closed t"
     and cont: "continuous_on s f" "continuous_on t g"
     and P: "\<And>x. x \<in> s \<Longrightarrow> \<not> P x \<Longrightarrow> f x = g x" "\<And>x. x \<in> t \<Longrightarrow> P x \<Longrightarrow> f x = g x"
   shows "continuous_on (s \<union> t) (\<lambda>x. if P x then f x else g x)"
     (is "continuous_on _ ?h")
 proof-
   from P have "\<forall>x\<in>s. f x = ?h x" "\<forall>x\<in>t. g x = ?h x"
     by auto
   with cont have "continuous_on s ?h" "continuous_on t ?h"
     by simp_all
   with closed show ?thesis
     by (rule continuous_on_closed_Un)
 qed
 
 lemma continuous_on_cases:
   "closed s \<Longrightarrow> closed t \<Longrightarrow> continuous_on s f \<Longrightarrow> continuous_on t g \<Longrightarrow>
     \<forall>x. (x\<in>s \<and> \<not> P x) \<or> (x \<in> t \<and> P x) \<longrightarrow> f x = g x \<Longrightarrow>
     continuous_on (s \<union> t) (\<lambda>x. if P x then f x else g x)"
   by (rule continuous_on_If) auto
 
 lemma continuous_on_id[continuous_intros,simp]: "continuous_on s (\<lambda>x. x)"
   unfolding continuous_on_def by fast
 
 lemma continuous_on_id'[continuous_intros,simp]: "continuous_on s id"
   unfolding continuous_on_def id_def by fast
 
 lemma continuous_on_const[continuous_intros,simp]: "continuous_on s (\<lambda>x. c)"
   unfolding continuous_on_def by auto
 
 lemma continuous_on_subset: "continuous_on s f \<Longrightarrow> t \<subseteq> s \<Longrightarrow> continuous_on t f"
   unfolding continuous_on_def
   by (metis subset_eq tendsto_within_subset)
 
 lemma continuous_on_compose[continuous_intros]:
   "continuous_on s f \<Longrightarrow> continuous_on (f ` s) g \<Longrightarrow> continuous_on s (g \<circ> f)"
   unfolding continuous_on_topological by simp metis
 
 lemma continuous_on_compose2:
   "continuous_on t g \<Longrightarrow> continuous_on s f \<Longrightarrow> f ` s \<subseteq> t \<Longrightarrow> continuous_on s (\<lambda>x. g (f x))"
   using continuous_on_compose[of s f g] continuous_on_subset by (force simp add: comp_def)
 
 lemma continuous_on_generate_topology:
   assumes *: "open = generate_topology X"
     and **: "\<And>B. B \<in> X \<Longrightarrow> \<exists>C. open C \<and> C \<inter> A = f -` B \<inter> A"
   shows "continuous_on A f"
   unfolding continuous_on_open_invariant
 proof safe
   fix B :: "'a set"
   assume "open B"
   then show "\<exists>C. open C \<and> C \<inter> A = f -` B \<inter> A"
     unfolding *
   proof induct
     case (UN K)
     then obtain C where "\<And>k. k \<in> K \<Longrightarrow> open (C k)" "\<And>k. k \<in> K \<Longrightarrow> C k \<inter> A = f -` k \<inter> A"
       by metis
     then show ?case
       by (intro exI[of _ "\<Union>k\<in>K. C k"]) blast
   qed (auto intro: **)
 qed
 
 lemma continuous_onI_mono:
   fixes f :: "'a::linorder_topology \<Rightarrow> 'b::{dense_order,linorder_topology}"
   assumes "open (f`A)"
     and mono: "\<And>x y. x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> x \<le> y \<Longrightarrow> f x \<le> f y"
   shows "continuous_on A f"
 proof (rule continuous_on_generate_topology[OF open_generated_order], safe)
   have monoD: "\<And>x y. x \<in> A \<Longrightarrow> y \<in> A \<Longrightarrow> f x < f y \<Longrightarrow> x < y"
     by (auto simp: not_le[symmetric] mono)
   have "\<exists>x. x \<in> A \<and> f x < b \<and> a < x" if a: "a \<in> A" and fa: "f a < b" for a b
   proof -
     obtain y where "f a < y" "{f a ..< y} \<subseteq> f`A"
       using open_right[OF \<open>open (f`A)\<close>, of "f a" b] a fa
       by auto
     obtain z where z: "f a < z" "z < min b y"
       using dense[of "f a" "min b y"] \<open>f a < y\<close> \<open>f a < b\<close> by auto
     then obtain c where "z = f c" "c \<in> A"
       using \<open>{f a ..< y} \<subseteq> f`A\<close>[THEN subsetD, of z] by (auto simp: less_imp_le)
     with a z show ?thesis
       by (auto intro!: exI[of _ c] simp: monoD)
   qed
   then show "\<exists>C. open C \<and> C \<inter> A = f -` {..<b} \<inter> A" for b
     by (intro exI[of _ "(\<Union>x\<in>{x\<in>A. f x < b}. {..< x})"])
        (auto intro: le_less_trans[OF mono] less_imp_le)
 
   have "\<exists>x. x \<in> A \<and> b < f x \<and> x < a" if a: "a \<in> A" and fa: "b < f a" for a b
   proof -
     note a fa
     moreover
     obtain y where "y < f a" "{y <.. f a} \<subseteq> f`A"
       using open_left[OF \<open>open (f`A)\<close>, of "f a" b]  a fa
       by auto
     then obtain z where z: "max b y < z" "z < f a"
       using dense[of "max b y" "f a"] \<open>y < f a\<close> \<open>b < f a\<close> by auto
     then obtain c where "z = f c" "c \<in> A"
       using \<open>{y <.. f a} \<subseteq> f`A\<close>[THEN subsetD, of z] by (auto simp: less_imp_le)
     with a z show ?thesis
       by (auto intro!: exI[of _ c] simp: monoD)
   qed
   then show "\<exists>C. open C \<and> C \<inter> A = f -` {b <..} \<inter> A" for b
     by (intro exI[of _ "(\<Union>x\<in>{x\<in>A. b < f x}. {x <..})"])
        (auto intro: less_le_trans[OF _ mono] less_imp_le)
 qed
 
 lemma continuous_on_IccI:
   "\<lbrakk>(f \<longlongrightarrow> f a) (at_right a);
     (f \<longlongrightarrow> f b) (at_left b);
     (\<And>x. a < x \<Longrightarrow> x < b \<Longrightarrow> f \<midarrow>x\<rightarrow> f x); a < b\<rbrakk> \<Longrightarrow>
     continuous_on {a .. b} f"
   for a::"'a::linorder_topology"
   using at_within_open[of _ "{a<..<b}"]
   by (auto simp: continuous_on_def at_within_Icc_at_right at_within_Icc_at_left le_less
       at_within_Icc_at)
 
 lemma
   fixes a b::"'a::linorder_topology"
   assumes "continuous_on {a .. b} f" "a < b"
   shows continuous_on_Icc_at_rightD: "(f \<longlongrightarrow> f a) (at_right a)"
     and continuous_on_Icc_at_leftD: "(f \<longlongrightarrow> f b) (at_left b)"
   using assms
   by (auto simp: at_within_Icc_at_right at_within_Icc_at_left continuous_on_def
       dest: bspec[where x=a] bspec[where x=b])
 
 lemma continuous_on_discrete [simp]:
   "continuous_on A (f :: 'a :: discrete_topology \<Rightarrow> _)"
   by (auto simp: continuous_on_def at_discrete)
 
 subsubsection \<open>Continuity at a point\<close>
 
 definition continuous :: "'a::t2_space filter \<Rightarrow> ('a \<Rightarrow> 'b::topological_space) \<Rightarrow> bool"
   where "continuous F f \<longleftrightarrow> (f \<longlongrightarrow> f (Lim F (\<lambda>x. x))) F"
 
 lemma continuous_bot[continuous_intros, simp]: "continuous bot f"
   unfolding continuous_def by auto
 
 lemma continuous_trivial_limit: "trivial_limit net \<Longrightarrow> continuous net f"
   by simp
 
 lemma continuous_within: "continuous (at x within s) f \<longleftrightarrow> (f \<longlongrightarrow> f x) (at x within s)"
   by (cases "trivial_limit (at x within s)") (auto simp add: Lim_ident_at continuous_def)
 
 lemma continuous_within_topological:
   "continuous (at x within s) f \<longleftrightarrow>
     (\<forall>B. open B \<longrightarrow> f x \<in> B \<longrightarrow> (\<exists>A. open A \<and> x \<in> A \<and> (\<forall>y\<in>s. y \<in> A \<longrightarrow> f y \<in> B)))"
   unfolding continuous_within tendsto_def eventually_at_topological by metis
 
 lemma continuous_within_compose[continuous_intros]:
   "continuous (at x within s) f \<Longrightarrow> continuous (at (f x) within f ` s) g \<Longrightarrow>
     continuous (at x within s) (g \<circ> f)"
   by (simp add: continuous_within_topological) metis
 
 lemma continuous_within_compose2:
   "continuous (at x within s) f \<Longrightarrow> continuous (at (f x) within f ` s) g \<Longrightarrow>
     continuous (at x within s) (\<lambda>x. g (f x))"
   using continuous_within_compose[of x s f g] by (simp add: comp_def)
 
 lemma continuous_at: "continuous (at x) f \<longleftrightarrow> f \<midarrow>x\<rightarrow> f x"
   using continuous_within[of x UNIV f] by simp
 
 lemma continuous_ident[continuous_intros, simp]: "continuous (at x within S) (\<lambda>x. x)"
   unfolding continuous_within by (rule tendsto_ident_at)
 
 lemma continuous_id[continuous_intros, simp]: "continuous (at x within S) id"
   by (simp add: id_def)
 
 lemma continuous_const[continuous_intros, simp]: "continuous F (\<lambda>x. c)"
   unfolding continuous_def by (rule tendsto_const)
 
 lemma continuous_on_eq_continuous_within:
   "continuous_on s f \<longleftrightarrow> (\<forall>x\<in>s. continuous (at x within s) f)"
   unfolding continuous_on_def continuous_within ..
 
 lemma continuous_discrete [simp]:
   "continuous (at x within A) (f :: 'a :: discrete_topology \<Rightarrow> _)"
   by (auto simp: continuous_def at_discrete)
 
 abbreviation isCont :: "('a::t2_space \<Rightarrow> 'b::topological_space) \<Rightarrow> 'a \<Rightarrow> bool"
   where "isCont f a \<equiv> continuous (at a) f"
 
 lemma isCont_def: "isCont f a \<longleftrightarrow> f \<midarrow>a\<rightarrow> f a"
   by (rule continuous_at)
 
 lemma isContD: "isCont f x \<Longrightarrow> f \<midarrow>x\<rightarrow> f x"
   by (simp add: isCont_def)
 
 lemma isCont_cong:
   assumes "eventually (\<lambda>x. f x = g x) (nhds x)"
   shows "isCont f x \<longleftrightarrow> isCont g x"
 proof -
   from assms have [simp]: "f x = g x"
     by (rule eventually_nhds_x_imp_x)
   from assms have "eventually (\<lambda>x. f x = g x) (at x)"
     by (auto simp: eventually_at_filter elim!: eventually_mono)
   with assms have "isCont f x \<longleftrightarrow> isCont g x" unfolding isCont_def
     by (intro filterlim_cong) (auto elim!: eventually_mono)
   with assms show ?thesis by simp
 qed
 
 lemma continuous_at_imp_continuous_at_within: "isCont f x \<Longrightarrow> continuous (at x within s) f"
   by (auto intro: tendsto_mono at_le simp: continuous_at continuous_within)
 
 lemma continuous_on_eq_continuous_at: "open s \<Longrightarrow> continuous_on s f \<longleftrightarrow> (\<forall>x\<in>s. isCont f x)"
   by (simp add: continuous_on_def continuous_at at_within_open[of _ s])
 
 lemma continuous_within_open: "a \<in> A \<Longrightarrow> open A \<Longrightarrow> continuous (at a within A) f \<longleftrightarrow> isCont f a"
   by (simp add: at_within_open_NO_MATCH)
 
 lemma continuous_at_imp_continuous_on: "\<forall>x\<in>s. isCont f x \<Longrightarrow> continuous_on s f"
   by (auto intro: continuous_at_imp_continuous_at_within simp: continuous_on_eq_continuous_within)
 
 lemma isCont_o2: "isCont f a \<Longrightarrow> isCont g (f a) \<Longrightarrow> isCont (\<lambda>x. g (f x)) a"
   unfolding isCont_def by (rule tendsto_compose)
 
 lemma continuous_at_compose[continuous_intros]: "isCont f a \<Longrightarrow> isCont g (f a) \<Longrightarrow> isCont (g \<circ> f) a"
   unfolding o_def by (rule isCont_o2)
 
 lemma isCont_tendsto_compose: "isCont g l \<Longrightarrow> (f \<longlongrightarrow> l) F \<Longrightarrow> ((\<lambda>x. g (f x)) \<longlongrightarrow> g l) F"
   unfolding isCont_def by (rule tendsto_compose)
 
 lemma continuous_on_tendsto_compose:
   assumes f_cont: "continuous_on s f"
     and g: "(g \<longlongrightarrow> l) F"
     and l: "l \<in> s"
     and ev: "\<forall>\<^sub>Fx in F. g x \<in> s"
   shows "((\<lambda>x. f (g x)) \<longlongrightarrow> f l) F"
 proof -
   from f_cont l have f: "(f \<longlongrightarrow> f l) (at l within s)"
     by (simp add: continuous_on_def)
   have i: "((\<lambda>x. if g x = l then f l else f (g x)) \<longlongrightarrow> f l) F"
     by (rule filterlim_If)
        (auto intro!: filterlim_compose[OF f] eventually_conj tendsto_mono[OF _ g]
              simp: filterlim_at eventually_inf_principal eventually_mono[OF ev])
   show ?thesis
     by (rule filterlim_cong[THEN iffD1[OF _ i]]) auto
 qed
 
 lemma continuous_within_compose3:
   "isCont g (f x) \<Longrightarrow> continuous (at x within s) f \<Longrightarrow> continuous (at x within s) (\<lambda>x. g (f x))"
   using continuous_at_imp_continuous_at_within continuous_within_compose2 by blast
 
 lemma filtermap_nhds_open_map:
   assumes cont: "isCont f a"
     and open_map: "\<And>S. open S \<Longrightarrow> open (f`S)"
   shows "filtermap f (nhds a) = nhds (f a)"
   unfolding filter_eq_iff
 proof safe
   fix P
   assume "eventually P (filtermap f (nhds a))"
   then obtain S where "open S" "a \<in> S" "\<forall>x\<in>S. P (f x)"
     by (auto simp: eventually_filtermap eventually_nhds)
   then show "eventually P (nhds (f a))"
     unfolding eventually_nhds by (intro exI[of _ "f`S"]) (auto intro!: open_map)
 qed (metis filterlim_iff tendsto_at_iff_tendsto_nhds isCont_def eventually_filtermap cont)
 
 lemma continuous_at_split:
   "continuous (at x) f \<longleftrightarrow> continuous (at_left x) f \<and> continuous (at_right x) f"
   for x :: "'a::linorder_topology"
   by (simp add: continuous_within filterlim_at_split)
 
 lemma continuous_on_max [continuous_intros]:
   fixes f g :: "'a::topological_space \<Rightarrow> 'b::linorder_topology"
   shows "continuous_on A f \<Longrightarrow> continuous_on A g \<Longrightarrow> continuous_on A (\<lambda>x. max (f x) (g x))"
   by (auto simp: continuous_on_def intro!: tendsto_max)
 
 lemma continuous_on_min [continuous_intros]:
   fixes f g :: "'a::topological_space \<Rightarrow> 'b::linorder_topology"
   shows "continuous_on A f \<Longrightarrow> continuous_on A g \<Longrightarrow> continuous_on A (\<lambda>x. min (f x) (g x))"
   by (auto simp: continuous_on_def intro!: tendsto_min)
 
 lemma continuous_max [continuous_intros]:
   fixes f :: "'a::t2_space \<Rightarrow> 'b::linorder_topology"
   shows "\<lbrakk>continuous F f; continuous F g\<rbrakk> \<Longrightarrow> continuous F (\<lambda>x. (max (f x) (g x)))"
   by (simp add: tendsto_max continuous_def)
 
 lemma continuous_min [continuous_intros]:
   fixes f :: "'a::t2_space \<Rightarrow> 'b::linorder_topology"
   shows "\<lbrakk>continuous F f; continuous F g\<rbrakk> \<Longrightarrow> continuous F (\<lambda>x. (min (f x) (g x)))"
   by (simp add: tendsto_min continuous_def)
 
 text \<open>
   The following open/closed Collect lemmas are ported from
   Sébastien Gouëzel's \<open>Ergodic_Theory\<close>.
 \<close>
 lemma open_Collect_neq:
   fixes f g :: "'a::topological_space \<Rightarrow> 'b::t2_space"
   assumes f: "continuous_on UNIV f" and g: "continuous_on UNIV g"
   shows "open {x. f x \<noteq> g x}"
 proof (rule openI)
   fix t
   assume "t \<in> {x. f x \<noteq> g x}"
   then obtain U V where *: "open U" "open V" "f t \<in> U" "g t \<in> V" "U \<inter> V = {}"
     by (auto simp add: separation_t2)
   with open_vimage[OF \<open>open U\<close> f] open_vimage[OF \<open>open V\<close> g]
   show "\<exists>T. open T \<and> t \<in> T \<and> T \<subseteq> {x. f x \<noteq> g x}"
     by (intro exI[of _ "f -` U \<inter> g -` V"]) auto
 qed
 
 lemma closed_Collect_eq:
   fixes f g :: "'a::topological_space \<Rightarrow> 'b::t2_space"
   assumes f: "continuous_on UNIV f" and g: "continuous_on UNIV g"
   shows "closed {x. f x = g x}"
   using open_Collect_neq[OF f g] by (simp add: closed_def Collect_neg_eq)
 
 lemma open_Collect_less:
   fixes f g :: "'a::topological_space \<Rightarrow> 'b::linorder_topology"
   assumes f: "continuous_on UNIV f" and g: "continuous_on UNIV g"
   shows "open {x. f x < g x}"
 proof (rule openI)
   fix t
   assume t: "t \<in> {x. f x < g x}"
   show "\<exists>T. open T \<and> t \<in> T \<and> T \<subseteq> {x. f x < g x}"
   proof (cases "\<exists>z. f t < z \<and> z < g t")
     case True
     then obtain z where "f t < z \<and> z < g t" by blast
     then show ?thesis
       using open_vimage[OF _ f, of "{..< z}"] open_vimage[OF _ g, of "{z <..}"]
       by (intro exI[of _ "f -` {..<z} \<inter> g -` {z<..}"]) auto
   next
     case False
     then have *: "{g t ..} = {f t <..}" "{..< g t} = {.. f t}"
       using t by (auto intro: leI)
     show ?thesis
       using open_vimage[OF _ f, of "{..< g t}"] open_vimage[OF _ g, of "{f t <..}"] t
       apply (intro exI[of _ "f -` {..< g t} \<inter> g -` {f t<..}"])
       apply (simp add: open_Int)
       apply (auto simp add: *)
       done
   qed
 qed
 
 lemma closed_Collect_le:
   fixes f g :: "'a :: topological_space \<Rightarrow> 'b::linorder_topology"
   assumes f: "continuous_on UNIV f"
     and g: "continuous_on UNIV g"
   shows "closed {x. f x \<le> g x}"
   using open_Collect_less [OF g f]
   by (simp add: closed_def Collect_neg_eq[symmetric] not_le)
 
 
 subsubsection \<open>Open-cover compactness\<close>
 
 context topological_space
 begin
 
 definition compact :: "'a set \<Rightarrow> bool" where
 compact_eq_Heine_Borel:  (* This name is used for backwards compatibility *)
     "compact S \<longleftrightarrow> (\<forall>C. (\<forall>c\<in>C. open c) \<and> S \<subseteq> \<Union>C \<longrightarrow> (\<exists>D\<subseteq>C. finite D \<and> S \<subseteq> \<Union>D))"
 
 lemma compactI:
   assumes "\<And>C. \<forall>t\<in>C. open t \<Longrightarrow> s \<subseteq> \<Union>C \<Longrightarrow> \<exists>C'. C' \<subseteq> C \<and> finite C' \<and> s \<subseteq> \<Union>C'"
   shows "compact s"
   unfolding compact_eq_Heine_Borel using assms by metis
 
 lemma compact_empty[simp]: "compact {}"
   by (auto intro!: compactI)
 
 lemma compactE: (*related to COMPACT_IMP_HEINE_BOREL in HOL Light*)
   assumes "compact S" "S \<subseteq> \<Union>\<T>" "\<And>B. B \<in> \<T> \<Longrightarrow> open B"
   obtains \<T>' where "\<T>' \<subseteq> \<T>" "finite \<T>'" "S \<subseteq> \<Union>\<T>'"
   by (meson assms compact_eq_Heine_Borel)
 
 lemma compactE_image:
   assumes "compact S"
     and opn: "\<And>T. T \<in> C \<Longrightarrow> open (f T)"
     and S: "S \<subseteq> (\<Union>c\<in>C. f c)"
   obtains C' where "C' \<subseteq> C" and "finite C'" and "S \<subseteq> (\<Union>c\<in>C'. f c)"
     apply (rule compactE[OF \<open>compact S\<close> S])
     using opn apply force
     by (metis finite_subset_image)
 
 lemma compact_Int_closed [intro]:
   assumes "compact S"
     and "closed T"
   shows "compact (S \<inter> T)"
 proof (rule compactI)
   fix C
   assume C: "\<forall>c\<in>C. open c"
   assume cover: "S \<inter> T \<subseteq> \<Union>C"
   from C \<open>closed T\<close> have "\<forall>c\<in>C \<union> {- T}. open c"
     by auto
   moreover from cover have "S \<subseteq> \<Union>(C \<union> {- T})"
     by auto
   ultimately have "\<exists>D\<subseteq>C \<union> {- T}. finite D \<and> S \<subseteq> \<Union>D"
     using \<open>compact S\<close> unfolding compact_eq_Heine_Borel by auto
   then obtain D where "D \<subseteq> C \<union> {- T} \<and> finite D \<and> S \<subseteq> \<Union>D" ..
   then show "\<exists>D\<subseteq>C. finite D \<and> S \<inter> T \<subseteq> \<Union>D"
     by (intro exI[of _ "D - {-T}"]) auto
 qed
 
 lemma compact_diff: "\<lbrakk>compact S; open T\<rbrakk> \<Longrightarrow> compact(S - T)"
   by (simp add: Diff_eq compact_Int_closed open_closed)
 
 lemma inj_setminus: "inj_on uminus (A::'a set set)"
   by (auto simp: inj_on_def)
 
 
 subsection \<open>Finite intersection property\<close>
 
 lemma compact_fip:
   "compact U \<longleftrightarrow>
     (\<forall>A. (\<forall>a\<in>A. closed a) \<longrightarrow> (\<forall>B \<subseteq> A. finite B \<longrightarrow> U \<inter> \<Inter>B \<noteq> {}) \<longrightarrow> U \<inter> \<Inter>A \<noteq> {})"
   (is "_ \<longleftrightarrow> ?R")
 proof (safe intro!: compact_eq_Heine_Borel[THEN iffD2])
   fix A
   assume "compact U"
   assume A: "\<forall>a\<in>A. closed a" "U \<inter> \<Inter>A = {}"
   assume fin: "\<forall>B \<subseteq> A. finite B \<longrightarrow> U \<inter> \<Inter>B \<noteq> {}"
   from A have "(\<forall>a\<in>uminus`A. open a) \<and> U \<subseteq> \<Union>(uminus`A)"
     by auto
   with \<open>compact U\<close> obtain B where "B \<subseteq> A" "finite (uminus`B)" "U \<subseteq> \<Union>(uminus`B)"
     unfolding compact_eq_Heine_Borel by (metis subset_image_iff)
   with fin[THEN spec, of B] show False
     by (auto dest: finite_imageD intro: inj_setminus)
 next
   fix A
   assume ?R
   assume "\<forall>a\<in>A. open a" "U \<subseteq> \<Union>A"
   then have "U \<inter> \<Inter>(uminus`A) = {}" "\<forall>a\<in>uminus`A. closed a"
     by auto
   with \<open>?R\<close> obtain B where "B \<subseteq> A" "finite (uminus`B)" "U \<inter> \<Inter>(uminus`B) = {}"
     by (metis subset_image_iff)
   then show "\<exists>T\<subseteq>A. finite T \<and> U \<subseteq> \<Union>T"
     by (auto intro!: exI[of _ B] inj_setminus dest: finite_imageD)
 qed
 
 lemma compact_imp_fip:
   assumes "compact S"
     and "\<And>T. T \<in> F \<Longrightarrow> closed T"
     and "\<And>F'. finite F' \<Longrightarrow> F' \<subseteq> F \<Longrightarrow> S \<inter> (\<Inter>F') \<noteq> {}"
   shows "S \<inter> (\<Inter>F) \<noteq> {}"
   using assms unfolding compact_fip by auto
 
 lemma compact_imp_fip_image:
   assumes "compact s"
     and P: "\<And>i. i \<in> I \<Longrightarrow> closed (f i)"
     and Q: "\<And>I'. finite I' \<Longrightarrow> I' \<subseteq> I \<Longrightarrow> (s \<inter> (\<Inter>i\<in>I'. f i) \<noteq> {})"
   shows "s \<inter> (\<Inter>i\<in>I. f i) \<noteq> {}"
 proof -
   from P have "\<forall>i \<in> f ` I. closed i"
     by blast
   moreover have "\<forall>A. finite A \<and> A \<subseteq> f ` I \<longrightarrow> (s \<inter> (\<Inter>A) \<noteq> {})"
     by (metis Q finite_subset_image)
   ultimately show "s \<inter> (\<Inter>(f ` I)) \<noteq> {}"
     by (metis \<open>compact s\<close> compact_imp_fip)
 qed
 
 end
 
 lemma (in t2_space) compact_imp_closed:
   assumes "compact s"
   shows "closed s"
   unfolding closed_def
 proof (rule openI)
   fix y
   assume "y \<in> - s"
   let ?C = "\<Union>x\<in>s. {u. open u \<and> x \<in> u \<and> eventually (\<lambda>y. y \<notin> u) (nhds y)}"
   have "s \<subseteq> \<Union>?C"
   proof
     fix x
     assume "x \<in> s"
     with \<open>y \<in> - s\<close> have "x \<noteq> y" by clarsimp
     then have "\<exists>u v. open u \<and> open v \<and> x \<in> u \<and> y \<in> v \<and> u \<inter> v = {}"
       by (rule hausdorff)
     with \<open>x \<in> s\<close> show "x \<in> \<Union>?C"
       unfolding eventually_nhds by auto
   qed
   then obtain D where "D \<subseteq> ?C" and "finite D" and "s \<subseteq> \<Union>D"
     by (rule compactE [OF \<open>compact s\<close>]) auto
   from \<open>D \<subseteq> ?C\<close> have "\<forall>x\<in>D. eventually (\<lambda>y. y \<notin> x) (nhds y)"
     by auto
   with \<open>finite D\<close> have "eventually (\<lambda>y. y \<notin> \<Union>D) (nhds y)"
     by (simp add: eventually_ball_finite)
   with \<open>s \<subseteq> \<Union>D\<close> have "eventually (\<lambda>y. y \<notin> s) (nhds y)"
     by (auto elim!: eventually_mono)
   then show "\<exists>t. open t \<and> y \<in> t \<and> t \<subseteq> - s"
     by (simp add: eventually_nhds subset_eq)
 qed
 
 lemma compact_continuous_image:
   assumes f: "continuous_on s f"
     and s: "compact s"
   shows "compact (f ` s)"
 proof (rule compactI)
   fix C
   assume "\<forall>c\<in>C. open c" and cover: "f`s \<subseteq> \<Union>C"
   with f have "\<forall>c\<in>C. \<exists>A. open A \<and> A \<inter> s = f -` c \<inter> s"
     unfolding continuous_on_open_invariant by blast
   then obtain A where A: "\<forall>c\<in>C. open (A c) \<and> A c \<inter> s = f -` c \<inter> s"
     unfolding bchoice_iff ..
   with cover have "\<And>c. c \<in> C \<Longrightarrow> open (A c)" "s \<subseteq> (\<Union>c\<in>C. A c)"
     by (fastforce simp add: subset_eq set_eq_iff)+
   from compactE_image[OF s this] obtain D where "D \<subseteq> C" "finite D" "s \<subseteq> (\<Union>c\<in>D. A c)" .
   with A show "\<exists>D \<subseteq> C. finite D \<and> f`s \<subseteq> \<Union>D"
     by (intro exI[of _ D]) (fastforce simp add: subset_eq set_eq_iff)+
 qed
 
 lemma continuous_on_inv:
   fixes f :: "'a::topological_space \<Rightarrow> 'b::t2_space"
   assumes "continuous_on s f"
     and "compact s"
     and "\<forall>x\<in>s. g (f x) = x"
   shows "continuous_on (f ` s) g"
   unfolding continuous_on_topological
 proof (clarsimp simp add: assms(3))
   fix x :: 'a and B :: "'a set"
   assume "x \<in> s" and "open B" and "x \<in> B"
   have 1: "\<forall>x\<in>s. f x \<in> f ` (s - B) \<longleftrightarrow> x \<in> s - B"
     using assms(3) by (auto, metis)
   have "continuous_on (s - B) f"
     using \<open>continuous_on s f\<close> Diff_subset
     by (rule continuous_on_subset)
   moreover have "compact (s - B)"
     using \<open>open B\<close> and \<open>compact s\<close>
     unfolding Diff_eq by (intro compact_Int_closed closed_Compl)
   ultimately have "compact (f ` (s - B))"
     by (rule compact_continuous_image)
   then have "closed (f ` (s - B))"
     by (rule compact_imp_closed)
   then have "open (- f ` (s - B))"
     by (rule open_Compl)
   moreover have "f x \<in> - f ` (s - B)"
     using \<open>x \<in> s\<close> and \<open>x \<in> B\<close> by (simp add: 1)
   moreover have "\<forall>y\<in>s. f y \<in> - f ` (s - B) \<longrightarrow> y \<in> B"
     by (simp add: 1)
   ultimately show "\<exists>A. open A \<and> f x \<in> A \<and> (\<forall>y\<in>s. f y \<in> A \<longrightarrow> y \<in> B)"
     by fast
 qed
 
 lemma continuous_on_inv_into:
   fixes f :: "'a::topological_space \<Rightarrow> 'b::t2_space"
   assumes s: "continuous_on s f" "compact s"
     and f: "inj_on f s"
   shows "continuous_on (f ` s) (the_inv_into s f)"
   by (rule continuous_on_inv[OF s]) (auto simp: the_inv_into_f_f[OF f])
 
 lemma (in linorder_topology) compact_attains_sup:
   assumes "compact S" "S \<noteq> {}"
   shows "\<exists>s\<in>S. \<forall>t\<in>S. t \<le> s"
 proof (rule classical)
   assume "\<not> (\<exists>s\<in>S. \<forall>t\<in>S. t \<le> s)"
   then obtain t where t: "\<forall>s\<in>S. t s \<in> S" and "\<forall>s\<in>S. s < t s"
     by (metis not_le)
   then have "\<And>s. s\<in>S \<Longrightarrow> open {..< t s}" "S \<subseteq> (\<Union>s\<in>S. {..< t s})"
     by auto
   with \<open>compact S\<close> obtain C where "C \<subseteq> S" "finite C" and C: "S \<subseteq> (\<Union>s\<in>C. {..< t s})"
     by (metis compactE_image)
   with \<open>S \<noteq> {}\<close> have Max: "Max (t`C) \<in> t`C" and "\<forall>s\<in>t`C. s \<le> Max (t`C)"
     by (auto intro!: Max_in)
   with C have "S \<subseteq> {..< Max (t`C)}"
     by (auto intro: less_le_trans simp: subset_eq)
   with t Max \<open>C \<subseteq> S\<close> show ?thesis
     by fastforce
 qed
 
 lemma (in linorder_topology) compact_attains_inf:
   assumes "compact S" "S \<noteq> {}"
   shows "\<exists>s\<in>S. \<forall>t\<in>S. s \<le> t"
 proof (rule classical)
   assume "\<not> (\<exists>s\<in>S. \<forall>t\<in>S. s \<le> t)"
   then obtain t where t: "\<forall>s\<in>S. t s \<in> S" and "\<forall>s\<in>S. t s < s"
     by (metis not_le)
   then have "\<And>s. s\<in>S \<Longrightarrow> open {t s <..}" "S \<subseteq> (\<Union>s\<in>S. {t s <..})"
     by auto
   with \<open>compact S\<close> obtain C where "C \<subseteq> S" "finite C" and C: "S \<subseteq> (\<Union>s\<in>C. {t s <..})"
     by (metis compactE_image)
   with \<open>S \<noteq> {}\<close> have Min: "Min (t`C) \<in> t`C" and "\<forall>s\<in>t`C. Min (t`C) \<le> s"
     by (auto intro!: Min_in)
   with C have "S \<subseteq> {Min (t`C) <..}"
     by (auto intro: le_less_trans simp: subset_eq)
   with t Min \<open>C \<subseteq> S\<close> show ?thesis
     by fastforce
 qed
 
 lemma continuous_attains_sup:
   fixes f :: "'a::topological_space \<Rightarrow> 'b::linorder_topology"
   shows "compact s \<Longrightarrow> s \<noteq> {} \<Longrightarrow> continuous_on s f \<Longrightarrow> (\<exists>x\<in>s. \<forall>y\<in>s.  f y \<le> f x)"
   using compact_attains_sup[of "f ` s"] compact_continuous_image[of s f] by auto
 
 lemma continuous_attains_inf:
   fixes f :: "'a::topological_space \<Rightarrow> 'b::linorder_topology"
   shows "compact s \<Longrightarrow> s \<noteq> {} \<Longrightarrow> continuous_on s f \<Longrightarrow> (\<exists>x\<in>s. \<forall>y\<in>s. f x \<le> f y)"
   using compact_attains_inf[of "f ` s"] compact_continuous_image[of s f] by auto
 
 
 subsection \<open>Connectedness\<close>
 
 context topological_space
 begin
 
 definition "connected S \<longleftrightarrow>
   \<not> (\<exists>A B. open A \<and> open B \<and> S \<subseteq> A \<union> B \<and> A \<inter> B \<inter> S = {} \<and> A \<inter> S \<noteq> {} \<and> B \<inter> S \<noteq> {})"
 
 lemma connectedI:
   "(\<And>A B. open A \<Longrightarrow> open B \<Longrightarrow> A \<inter> U \<noteq> {} \<Longrightarrow> B \<inter> U \<noteq> {} \<Longrightarrow> A \<inter> B \<inter> U = {} \<Longrightarrow> U \<subseteq> A \<union> B \<Longrightarrow> False)
   \<Longrightarrow> connected U"
   by (auto simp: connected_def)
 
 lemma connected_empty [simp]: "connected {}"
   by (auto intro!: connectedI)
 
 lemma connected_sing [simp]: "connected {x}"
   by (auto intro!: connectedI)
 
 lemma connectedD:
   "connected A \<Longrightarrow> open U \<Longrightarrow> open V \<Longrightarrow> U \<inter> V \<inter> A = {} \<Longrightarrow> A \<subseteq> U \<union> V \<Longrightarrow> U \<inter> A = {} \<or> V \<inter> A = {}"
   by (auto simp: connected_def)
 
 end
 
 lemma connected_closed:
   "connected s \<longleftrightarrow>
     \<not> (\<exists>A B. closed A \<and> closed B \<and> s \<subseteq> A \<union> B \<and> A \<inter> B \<inter> s = {} \<and> A \<inter> s \<noteq> {} \<and> B \<inter> s \<noteq> {})"
   apply (simp add: connected_def del: ex_simps, safe)
    apply (drule_tac x="-A" in spec)
    apply (drule_tac x="-B" in spec)
    apply (fastforce simp add: closed_def [symmetric])
   apply (drule_tac x="-A" in spec)
   apply (drule_tac x="-B" in spec)
   apply (fastforce simp add: open_closed [symmetric])
   done
 
 lemma connected_closedD:
   "\<lbrakk>connected s; A \<inter> B \<inter> s = {}; s \<subseteq> A \<union> B; closed A; closed B\<rbrakk> \<Longrightarrow> A \<inter> s = {} \<or> B \<inter> s = {}"
   by (simp add: connected_closed)
 
 lemma connected_Union:
   assumes cs: "\<And>s. s \<in> S \<Longrightarrow> connected s"
     and ne: "\<Inter>S \<noteq> {}"
   shows "connected(\<Union>S)"
 proof (rule connectedI)
   fix A B
   assume A: "open A" and B: "open B" and Alap: "A \<inter> \<Union>S \<noteq> {}" and Blap: "B \<inter> \<Union>S \<noteq> {}"
     and disj: "A \<inter> B \<inter> \<Union>S = {}" and cover: "\<Union>S \<subseteq> A \<union> B"
   have disjs:"\<And>s. s \<in> S \<Longrightarrow> A \<inter> B \<inter> s = {}"
     using disj by auto
   obtain sa where sa: "sa \<in> S" "A \<inter> sa \<noteq> {}"
     using Alap by auto
   obtain sb where sb: "sb \<in> S" "B \<inter> sb \<noteq> {}"
     using Blap by auto
   obtain x where x: "\<And>s. s \<in> S \<Longrightarrow> x \<in> s"
     using ne by auto
   then have "x \<in> \<Union>S"
     using \<open>sa \<in> S\<close> by blast
   then have "x \<in> A \<or> x \<in> B"
     using cover by auto
   then show False
     using cs [unfolded connected_def]
     by (metis A B IntI Sup_upper sa sb disjs x cover empty_iff subset_trans)
 qed
 
 lemma connected_Un: "connected s \<Longrightarrow> connected t \<Longrightarrow> s \<inter> t \<noteq> {} \<Longrightarrow> connected (s \<union> t)"
   using connected_Union [of "{s,t}"] by auto
 
 lemma connected_diff_open_from_closed:
   assumes st: "s \<subseteq> t"
     and tu: "t \<subseteq> u"
     and s: "open s"
     and t: "closed t"
     and u: "connected u"
     and ts: "connected (t - s)"
   shows "connected(u - s)"
 proof (rule connectedI)
   fix A B
   assume AB: "open A" "open B" "A \<inter> (u - s) \<noteq> {}" "B \<inter> (u - s) \<noteq> {}"
     and disj: "A \<inter> B \<inter> (u - s) = {}"
     and cover: "u - s \<subseteq> A \<union> B"
   then consider "A \<inter> (t - s) = {}" | "B \<inter> (t - s) = {}"
     using st ts tu connectedD [of "t-s" "A" "B"] by auto
   then show False
   proof cases
     case 1
     then have "(A - t) \<inter> (B \<union> s) \<inter> u = {}"
       using disj st by auto
     moreover have "u \<subseteq> (A - t) \<union> (B \<union> s)"
       using 1 cover by auto
     ultimately show False
       using connectedD [of u "A - t" "B \<union> s"] AB s t 1 u by auto
   next
     case 2
     then have "(A \<union> s) \<inter> (B - t) \<inter> u = {}"
       using disj st by auto
     moreover have "u \<subseteq> (A \<union> s) \<union> (B - t)"
       using 2 cover by auto
     ultimately show False
       using connectedD [of u "A \<union> s" "B - t"] AB s t 2 u by auto
   qed
 qed
 
 lemma connected_iff_const:
   fixes S :: "'a::topological_space set"
   shows "connected S \<longleftrightarrow> (\<forall>P::'a \<Rightarrow> bool. continuous_on S P \<longrightarrow> (\<exists>c. \<forall>s\<in>S. P s = c))"
 proof safe
   fix P :: "'a \<Rightarrow> bool"
   assume "connected S" "continuous_on S P"
   then have "\<And>b. \<exists>A. open A \<and> A \<inter> S = P -` {b} \<inter> S"
     unfolding continuous_on_open_invariant by (simp add: open_discrete)
   from this[of True] this[of False]
   obtain t f where "open t" "open f" and *: "f \<inter> S = P -` {False} \<inter> S" "t \<inter> S = P -` {True} \<inter> S"
     by meson
   then have "t \<inter> S = {} \<or> f \<inter> S = {}"
     by (intro connectedD[OF \<open>connected S\<close>])  auto
   then show "\<exists>c. \<forall>s\<in>S. P s = c"
   proof (rule disjE)
     assume "t \<inter> S = {}"
     then show ?thesis
       unfolding * by (intro exI[of _ False]) auto
   next
     assume "f \<inter> S = {}"
     then show ?thesis
       unfolding * by (intro exI[of _ True]) auto
   qed
 next
   assume P: "\<forall>P::'a \<Rightarrow> bool. continuous_on S P \<longrightarrow> (\<exists>c. \<forall>s\<in>S. P s = c)"
   show "connected S"
   proof (rule connectedI)
     fix A B
     assume *: "open A" "open B" "A \<inter> S \<noteq> {}" "B \<inter> S \<noteq> {}" "A \<inter> B \<inter> S = {}" "S \<subseteq> A \<union> B"
     have "continuous_on S (\<lambda>x. x \<in> A)"
       unfolding continuous_on_open_invariant
     proof safe
       fix C :: "bool set"
       have "C = UNIV \<or> C = {True} \<or> C = {False} \<or> C = {}"
         using subset_UNIV[of C] unfolding UNIV_bool by auto
       with * show "\<exists>T. open T \<and> T \<inter> S = (\<lambda>x. x \<in> A) -` C \<inter> S"
         by (intro exI[of _ "(if True \<in> C then A else {}) \<union> (if False \<in> C then B else {})"]) auto
     qed
     from P[rule_format, OF this] obtain c where "\<And>s. s \<in> S \<Longrightarrow> (s \<in> A) = c"
       by blast
     with * show False
       by (cases c) auto
   qed
 qed
 
 lemma connectedD_const: "connected S \<Longrightarrow> continuous_on S P \<Longrightarrow> \<exists>c. \<forall>s\<in>S. P s = c"
   for P :: "'a::topological_space \<Rightarrow> bool"
   by (auto simp: connected_iff_const)
 
 lemma connectedI_const:
   "(\<And>P::'a::topological_space \<Rightarrow> bool. continuous_on S P \<Longrightarrow> \<exists>c. \<forall>s\<in>S. P s = c) \<Longrightarrow> connected S"
   by (auto simp: connected_iff_const)
 
 lemma connected_local_const:
   assumes "connected A" "a \<in> A" "b \<in> A"
     and *: "\<forall>a\<in>A. eventually (\<lambda>b. f a = f b) (at a within A)"
   shows "f a = f b"
 proof -
   obtain S where S: "\<And>a. a \<in> A \<Longrightarrow> a \<in> S a" "\<And>a. a \<in> A \<Longrightarrow> open (S a)"
     "\<And>a x. a \<in> A \<Longrightarrow> x \<in> S a \<Longrightarrow> x \<in> A \<Longrightarrow> f a = f x"
     using * unfolding eventually_at_topological by metis
   let ?P = "\<Union>b\<in>{b\<in>A. f a = f b}. S b" and ?N = "\<Union>b\<in>{b\<in>A. f a \<noteq> f b}. S b"
   have "?P \<inter> A = {} \<or> ?N \<inter> A = {}"
     using \<open>connected A\<close> S \<open>a\<in>A\<close>
     by (intro connectedD) (auto, metis)
   then show "f a = f b"
   proof
     assume "?N \<inter> A = {}"
     then have "\<forall>x\<in>A. f a = f x"
       using S(1) by auto
     with \<open>b\<in>A\<close> show ?thesis by auto
   next
     assume "?P \<inter> A = {}" then show ?thesis
       using \<open>a \<in> A\<close> S(1)[of a] by auto
   qed
 qed
 
 lemma (in linorder_topology) connectedD_interval:
   assumes "connected U"
     and xy: "x \<in> U" "y \<in> U"
     and "x \<le> z" "z \<le> y"
   shows "z \<in> U"
 proof -
   have eq: "{..<z} \<union> {z<..} = - {z}"
     by auto
   have "\<not> connected U" if "z \<notin> U" "x < z" "z < y"
     using xy that
     apply (simp only: connected_def simp_thms)
     apply (rule_tac exI[of _ "{..< z}"])
     apply (rule_tac exI[of _ "{z <..}"])
     apply (auto simp add: eq)
     done
   with assms show "z \<in> U"
     by (metis less_le)
 qed
 
 lemma (in linorder_topology) not_in_connected_cases:
   assumes conn: "connected S"
   assumes nbdd: "x \<notin> S"
   assumes ne: "S \<noteq> {}"
   obtains "bdd_above S" "\<And>y. y \<in> S \<Longrightarrow> x \<ge> y" | "bdd_below S" "\<And>y. y \<in> S \<Longrightarrow> x \<le> y"
 proof -
   obtain s where "s \<in> S" using ne by blast
   {
     assume "s \<le> x"
     have "False" if "x \<le> y" "y \<in> S" for y
       using connectedD_interval[OF conn \<open>s \<in> S\<close> \<open>y \<in> S\<close> \<open>s \<le> x\<close> \<open>x \<le> y\<close>] \<open>x \<notin> S\<close>
       by simp
     then have wit: "y \<in> S \<Longrightarrow> x \<ge> y" for y
       using le_cases by blast
     then have "bdd_above S"
       by (rule local.bdd_aboveI)
     note this wit
   } moreover {
     assume "x \<le> s"
     have "False" if "x \<ge> y" "y \<in> S" for y
       using connectedD_interval[OF conn \<open>y \<in> S\<close> \<open>s \<in> S\<close> \<open>x \<ge> y\<close> \<open>s \<ge> x\<close> ] \<open>x \<notin> S\<close>
       by simp
     then have wit: "y \<in> S \<Longrightarrow> x \<le> y" for y
       using le_cases by blast
     then have "bdd_below S"
       by (rule bdd_belowI)
     note this wit
   } ultimately show ?thesis
     by (meson le_cases that)
 qed
 
 lemma connected_continuous_image:
   assumes *: "continuous_on s f"
     and "connected s"
   shows "connected (f ` s)"
 proof (rule connectedI_const)
   fix P :: "'b \<Rightarrow> bool"
   assume "continuous_on (f ` s) P"
   then have "continuous_on s (P \<circ> f)"
     by (rule continuous_on_compose[OF *])
   from connectedD_const[OF \<open>connected s\<close> this] show "\<exists>c. \<forall>s\<in>f ` s. P s = c"
     by auto
 qed
 
 
 section \<open>Linear Continuum Topologies\<close>
 
 class linear_continuum_topology = linorder_topology + linear_continuum
 begin
 
 lemma Inf_notin_open:
   assumes A: "open A"
     and bnd: "\<forall>a\<in>A. x < a"
   shows "Inf A \<notin> A"
 proof
   assume "Inf A \<in> A"
   then obtain b where "b < Inf A" "{b <.. Inf A} \<subseteq> A"
     using open_left[of A "Inf A" x] assms by auto
   with dense[of b "Inf A"] obtain c where "c < Inf A" "c \<in> A"
     by (auto simp: subset_eq)
   then show False
     using cInf_lower[OF \<open>c \<in> A\<close>] bnd
     by (metis not_le less_imp_le bdd_belowI)
 qed
 
 lemma Sup_notin_open:
   assumes A: "open A"
     and bnd: "\<forall>a\<in>A. a < x"
   shows "Sup A \<notin> A"
 proof
   assume "Sup A \<in> A"
   with assms obtain b where "Sup A < b" "{Sup A ..< b} \<subseteq> A"
     using open_right[of A "Sup A" x] by auto
   with dense[of "Sup A" b] obtain c where "Sup A < c" "c \<in> A"
     by (auto simp: subset_eq)
   then show False
     using cSup_upper[OF \<open>c \<in> A\<close>] bnd
     by (metis less_imp_le not_le bdd_aboveI)
 qed
 
 end
 
 instance linear_continuum_topology \<subseteq> perfect_space
 proof
   fix x :: 'a
   obtain y where "x < y \<or> y < x"
     using ex_gt_or_lt [of x] ..
   with Inf_notin_open[of "{x}" y] Sup_notin_open[of "{x}" y] show "\<not> open {x}"
     by auto
 qed
 
 lemma connectedI_interval:
   fixes U :: "'a :: linear_continuum_topology set"
   assumes *: "\<And>x y z. x \<in> U \<Longrightarrow> y \<in> U \<Longrightarrow> x \<le> z \<Longrightarrow> z \<le> y \<Longrightarrow> z \<in> U"
   shows "connected U"
 proof (rule connectedI)
   {
     fix A B
     assume "open A" "open B" "A \<inter> B \<inter> U = {}" "U \<subseteq> A \<union> B"
     fix x y
     assume "x < y" "x \<in> A" "y \<in> B" "x \<in> U" "y \<in> U"
 
     let ?z = "Inf (B \<inter> {x <..})"
 
     have "x \<le> ?z" "?z \<le> y"
       using \<open>y \<in> B\<close> \<open>x < y\<close> by (auto intro: cInf_lower cInf_greatest)
     with \<open>x \<in> U\<close> \<open>y \<in> U\<close> have "?z \<in> U"
       by (rule *)
     moreover have "?z \<notin> B \<inter> {x <..}"
       using \<open>open B\<close> by (intro Inf_notin_open) auto
     ultimately have "?z \<in> A"
       using \<open>x \<le> ?z\<close> \<open>A \<inter> B \<inter> U = {}\<close> \<open>x \<in> A\<close> \<open>U \<subseteq> A \<union> B\<close> by auto
     have "\<exists>b\<in>B. b \<in> A \<and> b \<in> U" if "?z < y"
     proof -
       obtain a where "?z < a" "{?z ..< a} \<subseteq> A"
         using open_right[OF \<open>open A\<close> \<open>?z \<in> A\<close> \<open>?z < y\<close>] by auto
       moreover obtain b where "b \<in> B" "x < b" "b < min a y"
         using cInf_less_iff[of "B \<inter> {x <..}" "min a y"] \<open>?z < a\<close> \<open>?z < y\<close> \<open>x < y\<close> \<open>y \<in> B\<close>
         by auto
       moreover have "?z \<le> b"
         using \<open>b \<in> B\<close> \<open>x < b\<close>
         by (intro cInf_lower) auto
       moreover have "b \<in> U"
         using \<open>x \<le> ?z\<close> \<open>?z \<le> b\<close> \<open>b < min a y\<close>
         by (intro *[OF \<open>x \<in> U\<close> \<open>y \<in> U\<close>]) (auto simp: less_imp_le)
       ultimately show ?thesis
         by (intro bexI[of _ b]) auto
     qed
     then have False
       using \<open>?z \<le> y\<close> \<open>?z \<in> A\<close> \<open>y \<in> B\<close> \<open>y \<in> U\<close> \<open>A \<inter> B \<inter> U = {}\<close>
       unfolding le_less by blast
   }
   note not_disjoint = this
 
   fix A B assume AB: "open A" "open B" "U \<subseteq> A \<union> B" "A \<inter> B \<inter> U = {}"
   moreover assume "A \<inter> U \<noteq> {}" then obtain x where x: "x \<in> U" "x \<in> A" by auto
   moreover assume "B \<inter> U \<noteq> {}" then obtain y where y: "y \<in> U" "y \<in> B" by auto
   moreover note not_disjoint[of B A y x] not_disjoint[of A B x y]
   ultimately show False
     by (cases x y rule: linorder_cases) auto
 qed
 
 lemma connected_iff_interval: "connected U \<longleftrightarrow> (\<forall>x\<in>U. \<forall>y\<in>U. \<forall>z. x \<le> z \<longrightarrow> z \<le> y \<longrightarrow> z \<in> U)"
   for U :: "'a::linear_continuum_topology set"
   by (auto intro: connectedI_interval dest: connectedD_interval)
 
 lemma connected_UNIV[simp]: "connected (UNIV::'a::linear_continuum_topology set)"
   by (simp add: connected_iff_interval)
 
 lemma connected_Ioi[simp]: "connected {a<..}"
   for a :: "'a::linear_continuum_topology"
   by (auto simp: connected_iff_interval)
 
 lemma connected_Ici[simp]: "connected {a..}"
   for a :: "'a::linear_continuum_topology"
   by (auto simp: connected_iff_interval)
 
 lemma connected_Iio[simp]: "connected {..<a}"
   for a :: "'a::linear_continuum_topology"
   by (auto simp: connected_iff_interval)
 
 lemma connected_Iic[simp]: "connected {..a}"
   for a :: "'a::linear_continuum_topology"
   by (auto simp: connected_iff_interval)
 
 lemma connected_Ioo[simp]: "connected {a<..<b}"
   for a b :: "'a::linear_continuum_topology"
   unfolding connected_iff_interval by auto
 
 lemma connected_Ioc[simp]: "connected {a<..b}"
   for a b :: "'a::linear_continuum_topology"
   by (auto simp: connected_iff_interval)
 
 lemma connected_Ico[simp]: "connected {a..<b}"
   for a b :: "'a::linear_continuum_topology"
   by (auto simp: connected_iff_interval)
 
 lemma connected_Icc[simp]: "connected {a..b}"
   for a b :: "'a::linear_continuum_topology"
   by (auto simp: connected_iff_interval)
 
 lemma connected_contains_Ioo:
   fixes A :: "'a :: linorder_topology set"
   assumes "connected A" "a \<in> A" "b \<in> A" shows "{a <..< b} \<subseteq> A"
   using connectedD_interval[OF assms] by (simp add: subset_eq Ball_def less_imp_le)
 
 lemma connected_contains_Icc:
   fixes A :: "'a::linorder_topology set"
   assumes "connected A" "a \<in> A" "b \<in> A"
   shows "{a..b} \<subseteq> A"
 proof
   fix x assume "x \<in> {a..b}"
   then have "x = a \<or> x = b \<or> x \<in> {a<..<b}"
     by auto
   then show "x \<in> A"
     using assms connected_contains_Ioo[of A a b] by auto
 qed
 
 
 subsection \<open>Intermediate Value Theorem\<close>
 
 lemma IVT':
   fixes f :: "'a::linear_continuum_topology \<Rightarrow> 'b::linorder_topology"
   assumes y: "f a \<le> y" "y \<le> f b" "a \<le> b"
     and *: "continuous_on {a .. b} f"
   shows "\<exists>x. a \<le> x \<and> x \<le> b \<and> f x = y"
 proof -
   have "connected {a..b}"
     unfolding connected_iff_interval by auto
   from connected_continuous_image[OF * this, THEN connectedD_interval, of "f a" "f b" y] y
   show ?thesis
     by (auto simp add: atLeastAtMost_def atLeast_def atMost_def)
 qed
 
 lemma IVT2':
   fixes f :: "'a :: linear_continuum_topology \<Rightarrow> 'b :: linorder_topology"
   assumes y: "f b \<le> y" "y \<le> f a" "a \<le> b"
     and *: "continuous_on {a .. b} f"
   shows "\<exists>x. a \<le> x \<and> x \<le> b \<and> f x = y"
 proof -
   have "connected {a..b}"
     unfolding connected_iff_interval by auto
   from connected_continuous_image[OF * this, THEN connectedD_interval, of "f b" "f a" y] y
   show ?thesis
     by (auto simp add: atLeastAtMost_def atLeast_def atMost_def)
 qed
 
 lemma IVT:
   fixes f :: "'a::linear_continuum_topology \<Rightarrow> 'b::linorder_topology"
   shows "f a \<le> y \<Longrightarrow> y \<le> f b \<Longrightarrow> a \<le> b \<Longrightarrow> (\<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"
   by (rule IVT') (auto intro: continuous_at_imp_continuous_on)
 
 lemma IVT2:
   fixes f :: "'a::linear_continuum_topology \<Rightarrow> 'b::linorder_topology"
   shows "f b \<le> y \<Longrightarrow> y \<le> f a \<Longrightarrow> a \<le> b \<Longrightarrow> (\<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"
   by (rule IVT2') (auto intro: continuous_at_imp_continuous_on)
 
 lemma continuous_inj_imp_mono:
   fixes f :: "'a::linear_continuum_topology \<Rightarrow> 'b::linorder_topology"
   assumes x: "a < x" "x < b"
     and cont: "continuous_on {a..b} f"
     and inj: "inj_on f {a..b}"
   shows "(f a < f x \<and> f x < f b) \<or> (f b < f x \<and> f x < f a)"
 proof -
   note I = inj_on_eq_iff[OF inj]
   {
     assume "f x < f a" "f x < f b"
     then obtain s t where "x \<le> s" "s \<le> b" "a \<le> t" "t \<le> x" "f s = f t" "f x < f s"
       using IVT'[of f x "min (f a) (f b)" b] IVT2'[of f x "min (f a) (f b)" a] x
       by (auto simp: continuous_on_subset[OF cont] less_imp_le)
     with x I have False by auto
   }
   moreover
   {
     assume "f a < f x" "f b < f x"
     then obtain s t where "x \<le> s" "s \<le> b" "a \<le> t" "t \<le> x" "f s = f t" "f s < f x"
       using IVT'[of f a "max (f a) (f b)" x] IVT2'[of f b "max (f a) (f b)" x] x
       by (auto simp: continuous_on_subset[OF cont] less_imp_le)
     with x I have False by auto
   }
   ultimately show ?thesis
     using I[of a x] I[of x b] x less_trans[OF x]
     by (auto simp add: le_less less_imp_neq neq_iff)
 qed
 
 lemma continuous_at_Sup_mono:
   fixes f :: "'a::{linorder_topology,conditionally_complete_linorder} \<Rightarrow>
     'b::{linorder_topology,conditionally_complete_linorder}"
   assumes "mono f"
     and cont: "continuous (at_left (Sup S)) f"
     and S: "S \<noteq> {}" "bdd_above S"
   shows "f (Sup S) = (SUP s\<in>S. f s)"
 proof (rule antisym)
   have f: "(f \<longlongrightarrow> f (Sup S)) (at_left (Sup S))"
     using cont unfolding continuous_within .
   show "f (Sup S) \<le> (SUP s\<in>S. f s)"
   proof cases
     assume "Sup S \<in> S"
     then show ?thesis
       by (rule cSUP_upper) (auto intro: bdd_above_image_mono S \<open>mono f\<close>)
   next
     assume "Sup S \<notin> S"
     from \<open>S \<noteq> {}\<close> obtain s where "s \<in> S"
       by auto
     with \<open>Sup S \<notin> S\<close> S have "s < Sup S"
       unfolding less_le by (blast intro: cSup_upper)
     show ?thesis
     proof (rule ccontr)
       assume "\<not> ?thesis"
       with order_tendstoD(1)[OF f, of "SUP s\<in>S. f s"] obtain b where "b < Sup S"
         and *: "\<And>y. b < y \<Longrightarrow> y < Sup S \<Longrightarrow> (SUP s\<in>S. f s) < f y"
         by (auto simp: not_le eventually_at_left[OF \<open>s < Sup S\<close>])
       with \<open>S \<noteq> {}\<close> obtain c where "c \<in> S" "b < c"
         using less_cSupD[of S b] by auto
       with \<open>Sup S \<notin> S\<close> S have "c < Sup S"
         unfolding less_le by (blast intro: cSup_upper)
       from *[OF \<open>b < c\<close> \<open>c < Sup S\<close>] cSUP_upper[OF \<open>c \<in> S\<close> bdd_above_image_mono[of f]]
       show False
         by (auto simp: assms)
     qed
   qed
 qed (intro cSUP_least \<open>mono f\<close>[THEN monoD] cSup_upper S)
 
 lemma continuous_at_Sup_antimono:
   fixes f :: "'a::{linorder_topology,conditionally_complete_linorder} \<Rightarrow>
     'b::{linorder_topology,conditionally_complete_linorder}"
   assumes "antimono f"
     and cont: "continuous (at_left (Sup S)) f"
     and S: "S \<noteq> {}" "bdd_above S"
   shows "f (Sup S) = (INF s\<in>S. f s)"
 proof (rule antisym)
   have f: "(f \<longlongrightarrow> f (Sup S)) (at_left (Sup S))"
     using cont unfolding continuous_within .
   show "(INF s\<in>S. f s) \<le> f (Sup S)"
   proof cases
     assume "Sup S \<in> S"
     then show ?thesis
       by (intro cINF_lower) (auto intro: bdd_below_image_antimono S \<open>antimono f\<close>)
   next
     assume "Sup S \<notin> S"
     from \<open>S \<noteq> {}\<close> obtain s where "s \<in> S"
       by auto
     with \<open>Sup S \<notin> S\<close> S have "s < Sup S"
       unfolding less_le by (blast intro: cSup_upper)
     show ?thesis
     proof (rule ccontr)
       assume "\<not> ?thesis"
       with order_tendstoD(2)[OF f, of "INF s\<in>S. f s"] obtain b where "b < Sup S"
         and *: "\<And>y. b < y \<Longrightarrow> y < Sup S \<Longrightarrow> f y < (INF s\<in>S. f s)"
         by (auto simp: not_le eventually_at_left[OF \<open>s < Sup S\<close>])
       with \<open>S \<noteq> {}\<close> obtain c where "c \<in> S" "b < c"
         using less_cSupD[of S b] by auto
       with \<open>Sup S \<notin> S\<close> S have "c < Sup S"
         unfolding less_le by (blast intro: cSup_upper)
       from *[OF \<open>b < c\<close> \<open>c < Sup S\<close>] cINF_lower[OF bdd_below_image_antimono, of f S c] \<open>c \<in> S\<close>
       show False
         by (auto simp: assms)
     qed
   qed
 qed (intro cINF_greatest \<open>antimono f\<close>[THEN antimonoD] cSup_upper S)
 
 lemma continuous_at_Inf_mono:
   fixes f :: "'a::{linorder_topology,conditionally_complete_linorder} \<Rightarrow>
     'b::{linorder_topology,conditionally_complete_linorder}"
   assumes "mono f"
     and cont: "continuous (at_right (Inf S)) f"
     and S: "S \<noteq> {}" "bdd_below S"
   shows "f (Inf S) = (INF s\<in>S. f s)"
 proof (rule antisym)
   have f: "(f \<longlongrightarrow> f (Inf S)) (at_right (Inf S))"
     using cont unfolding continuous_within .
   show "(INF s\<in>S. f s) \<le> f (Inf S)"
   proof cases
     assume "Inf S \<in> S"
     then show ?thesis
       by (rule cINF_lower[rotated]) (auto intro: bdd_below_image_mono S \<open>mono f\<close>)
   next
     assume "Inf S \<notin> S"
     from \<open>S \<noteq> {}\<close> obtain s where "s \<in> S"
       by auto
     with \<open>Inf S \<notin> S\<close> S have "Inf S < s"
       unfolding less_le by (blast intro: cInf_lower)
     show ?thesis
     proof (rule ccontr)
       assume "\<not> ?thesis"
       with order_tendstoD(2)[OF f, of "INF s\<in>S. f s"] obtain b where "Inf S < b"
         and *: "\<And>y. Inf S < y \<Longrightarrow> y < b \<Longrightarrow> f y < (INF s\<in>S. f s)"
         by (auto simp: not_le eventually_at_right[OF \<open>Inf S < s\<close>])
       with \<open>S \<noteq> {}\<close> obtain c where "c \<in> S" "c < b"
         using cInf_lessD[of S b] by auto
       with \<open>Inf S \<notin> S\<close> S have "Inf S < c"
         unfolding less_le by (blast intro: cInf_lower)
       from *[OF \<open>Inf S < c\<close> \<open>c < b\<close>] cINF_lower[OF bdd_below_image_mono[of f] \<open>c \<in> S\<close>]
       show False
         by (auto simp: assms)
     qed
   qed
 qed (intro cINF_greatest \<open>mono f\<close>[THEN monoD] cInf_lower \<open>bdd_below S\<close> \<open>S \<noteq> {}\<close>)
 
 lemma continuous_at_Inf_antimono:
   fixes f :: "'a::{linorder_topology,conditionally_complete_linorder} \<Rightarrow>
     'b::{linorder_topology,conditionally_complete_linorder}"
   assumes "antimono f"
     and cont: "continuous (at_right (Inf S)) f"
     and S: "S \<noteq> {}" "bdd_below S"
   shows "f (Inf S) = (SUP s\<in>S. f s)"
 proof (rule antisym)
   have f: "(f \<longlongrightarrow> f (Inf S)) (at_right (Inf S))"
     using cont unfolding continuous_within .
   show "f (Inf S) \<le> (SUP s\<in>S. f s)"
   proof cases
     assume "Inf S \<in> S"
     then show ?thesis
       by (rule cSUP_upper) (auto intro: bdd_above_image_antimono S \<open>antimono f\<close>)
   next
     assume "Inf S \<notin> S"
     from \<open>S \<noteq> {}\<close> obtain s where "s \<in> S"
       by auto
     with \<open>Inf S \<notin> S\<close> S have "Inf S < s"
       unfolding less_le by (blast intro: cInf_lower)
     show ?thesis
     proof (rule ccontr)
       assume "\<not> ?thesis"
       with order_tendstoD(1)[OF f, of "SUP s\<in>S. f s"] obtain b where "Inf S < b"
         and *: "\<And>y. Inf S < y \<Longrightarrow> y < b \<Longrightarrow> (SUP s\<in>S. f s) < f y"
         by (auto simp: not_le eventually_at_right[OF \<open>Inf S < s\<close>])
       with \<open>S \<noteq> {}\<close> obtain c where "c \<in> S" "c < b"
         using cInf_lessD[of S b] by auto
       with \<open>Inf S \<notin> S\<close> S have "Inf S < c"
         unfolding less_le by (blast intro: cInf_lower)
       from *[OF \<open>Inf S < c\<close> \<open>c < b\<close>] cSUP_upper[OF \<open>c \<in> S\<close> bdd_above_image_antimono[of f]]
       show False
         by (auto simp: assms)
     qed
   qed
 qed (intro cSUP_least \<open>antimono f\<close>[THEN antimonoD] cInf_lower S)
 
 
 subsection \<open>Uniform spaces\<close>
 
 class uniformity =
   fixes uniformity :: "('a \<times> 'a) filter"
 begin
 
 abbreviation uniformity_on :: "'a set \<Rightarrow> ('a \<times> 'a) filter"
   where "uniformity_on s \<equiv> inf uniformity (principal (s\<times>s))"
 
 end
 
 lemma uniformity_Abort:
   "uniformity =
     Filter.abstract_filter (\<lambda>u. Code.abort (STR ''uniformity is not executable'') (\<lambda>u. uniformity))"
   by simp
 
 class open_uniformity = "open" + uniformity +
   assumes open_uniformity:
     "\<And>U. open U \<longleftrightarrow> (\<forall>x\<in>U. eventually (\<lambda>(x', y). x' = x \<longrightarrow> y \<in> U) uniformity)"
 begin
 
 subclass topological_space
   by standard (force elim: eventually_mono eventually_elim2 simp: split_beta' open_uniformity)+
 
 end
 
 class uniform_space = open_uniformity +
   assumes uniformity_refl: "eventually E uniformity \<Longrightarrow> E (x, x)"
     and uniformity_sym: "eventually E uniformity \<Longrightarrow> eventually (\<lambda>(x, y). E (y, x)) uniformity"
     and uniformity_trans:
       "eventually E uniformity \<Longrightarrow>
         \<exists>D. eventually D uniformity \<and> (\<forall>x y z. D (x, y) \<longrightarrow> D (y, z) \<longrightarrow> E (x, z))"
 begin
 
 lemma uniformity_bot: "uniformity \<noteq> bot"
   using uniformity_refl by auto
 
 lemma uniformity_trans':
   "eventually E uniformity \<Longrightarrow>
     eventually (\<lambda>((x, y), (y', z)). y = y' \<longrightarrow> E (x, z)) (uniformity \<times>\<^sub>F uniformity)"
   by (drule uniformity_trans) (auto simp add: eventually_prod_same)
 
 lemma uniformity_transE:
   assumes "eventually E uniformity"
   obtains D where "eventually D uniformity" "\<And>x y z. D (x, y) \<Longrightarrow> D (y, z) \<Longrightarrow> E (x, z)"
   using uniformity_trans [OF assms] by auto
 
 lemma eventually_nhds_uniformity:
   "eventually P (nhds x) \<longleftrightarrow> eventually (\<lambda>(x', y). x' = x \<longrightarrow> P y) uniformity"
   (is "_ \<longleftrightarrow> ?N P x")
   unfolding eventually_nhds
 proof safe
   assume *: "?N P x"
   have "?N (?N P) x" if "?N P x" for x
   proof -
     from that obtain D where ev: "eventually D uniformity"
       and D: "D (a, b) \<Longrightarrow> D (b, c) \<Longrightarrow> case (a, c) of (x', y) \<Rightarrow> x' = x \<longrightarrow> P y" for a b c
       by (rule uniformity_transE) simp
     from ev show ?thesis
       by eventually_elim (insert ev D, force elim: eventually_mono split: prod.split)
   qed
   then have "open {x. ?N P x}"
     by (simp add: open_uniformity)
   then show "\<exists>S. open S \<and> x \<in> S \<and> (\<forall>x\<in>S. P x)"
     by (intro exI[of _ "{x. ?N P x}"]) (auto dest: uniformity_refl simp: *)
 qed (force simp add: open_uniformity elim: eventually_mono)
 
 
 subsubsection \<open>Totally bounded sets\<close>
 
 definition totally_bounded :: "'a set \<Rightarrow> bool"
   where "totally_bounded S \<longleftrightarrow>
     (\<forall>E. eventually E uniformity \<longrightarrow> (\<exists>X. finite X \<and> (\<forall>s\<in>S. \<exists>x\<in>X. E (x, s))))"
 
 lemma totally_bounded_empty[iff]: "totally_bounded {}"
   by (auto simp add: totally_bounded_def)
 
 lemma totally_bounded_subset: "totally_bounded S \<Longrightarrow> T \<subseteq> S \<Longrightarrow> totally_bounded T"
   by (fastforce simp add: totally_bounded_def)
 
 lemma totally_bounded_Union[intro]:
   assumes M: "finite M" "\<And>S. S \<in> M \<Longrightarrow> totally_bounded S"
   shows "totally_bounded (\<Union>M)"
   unfolding totally_bounded_def
 proof safe
   fix E
   assume "eventually E uniformity"
   with M obtain X where "\<forall>S\<in>M. finite (X S) \<and> (\<forall>s\<in>S. \<exists>x\<in>X S. E (x, s))"
     by (metis totally_bounded_def)
   with \<open>finite M\<close> show "\<exists>X. finite X \<and> (\<forall>s\<in>\<Union>M. \<exists>x\<in>X. E (x, s))"
     by (intro exI[of _ "\<Union>S\<in>M. X S"]) force
 qed
 
 
 subsubsection \<open>Cauchy filter\<close>
 
 definition cauchy_filter :: "'a filter \<Rightarrow> bool"
   where "cauchy_filter F \<longleftrightarrow> F \<times>\<^sub>F F \<le> uniformity"
 
 definition Cauchy :: "(nat \<Rightarrow> 'a) \<Rightarrow> bool"
   where Cauchy_uniform: "Cauchy X = cauchy_filter (filtermap X sequentially)"
 
 lemma Cauchy_uniform_iff:
   "Cauchy X \<longleftrightarrow> (\<forall>P. eventually P uniformity \<longrightarrow> (\<exists>N. \<forall>n\<ge>N. \<forall>m\<ge>N. P (X n, X m)))"
   unfolding Cauchy_uniform cauchy_filter_def le_filter_def eventually_prod_same
     eventually_filtermap eventually_sequentially
 proof safe
   let ?U = "\<lambda>P. eventually P uniformity"
   {
     fix P
     assume "?U P" "\<forall>P. ?U P \<longrightarrow> (\<exists>Q. (\<exists>N. \<forall>n\<ge>N. Q (X n)) \<and> (\<forall>x y. Q x \<longrightarrow> Q y \<longrightarrow> P (x, y)))"
     then obtain Q N where "\<And>n. n \<ge> N \<Longrightarrow> Q (X n)" "\<And>x y. Q x \<Longrightarrow> Q y \<Longrightarrow> P (x, y)"
       by metis
     then show "\<exists>N. \<forall>n\<ge>N. \<forall>m\<ge>N. P (X n, X m)"
       by blast
   next
     fix P
     assume "?U P" and P: "\<forall>P. ?U P \<longrightarrow> (\<exists>N. \<forall>n\<ge>N. \<forall>m\<ge>N. P (X n, X m))"
     then obtain Q where "?U Q" and Q: "\<And>x y z. Q (x, y) \<Longrightarrow> Q (y, z) \<Longrightarrow> P (x, z)"
       by (auto elim: uniformity_transE)
     then have "?U (\<lambda>x. Q x \<and> (\<lambda>(x, y). Q (y, x)) x)"
       unfolding eventually_conj_iff by (simp add: uniformity_sym)
     from P[rule_format, OF this]
     obtain N where N: "\<And>n m. n \<ge> N \<Longrightarrow> m \<ge> N \<Longrightarrow> Q (X n, X m) \<and> Q (X m, X n)"
       by auto
     show "\<exists>Q. (\<exists>N. \<forall>n\<ge>N. Q (X n)) \<and> (\<forall>x y. Q x \<longrightarrow> Q y \<longrightarrow> P (x, y))"
     proof (safe intro!: exI[of _ "\<lambda>x. \<forall>n\<ge>N. Q (x, X n) \<and> Q (X n, x)"] exI[of _ N] N)
       fix x y
       assume "\<forall>n\<ge>N. Q (x, X n) \<and> Q (X n, x)" "\<forall>n\<ge>N. Q (y, X n) \<and> Q (X n, y)"
       then have "Q (x, X N)" "Q (X N, y)" by auto
       then show "P (x, y)"
         by (rule Q)
     qed
   }
 qed
 
 lemma nhds_imp_cauchy_filter:
   assumes *: "F \<le> nhds x"
   shows "cauchy_filter F"
 proof -
   have "F \<times>\<^sub>F F \<le> nhds x \<times>\<^sub>F nhds x"
     by (intro prod_filter_mono *)
   also have "\<dots> \<le> uniformity"
     unfolding le_filter_def eventually_nhds_uniformity eventually_prod_same
   proof safe
     fix P
     assume "eventually P uniformity"
     then obtain Ql where ev: "eventually Ql uniformity"
       and "Ql (x, y) \<Longrightarrow> Ql (y, z) \<Longrightarrow> P (x, z)" for x y z
       by (rule uniformity_transE) simp
     with ev[THEN uniformity_sym]
     show "\<exists>Q. eventually (\<lambda>(x', y). x' = x \<longrightarrow> Q y) uniformity \<and>
         (\<forall>x y. Q x \<longrightarrow> Q y \<longrightarrow> P (x, y))"
       by (rule_tac exI[of _ "\<lambda>y. Ql (y, x) \<and> Ql (x, y)"]) (fastforce elim: eventually_elim2)
   qed
   finally show ?thesis
     by (simp add: cauchy_filter_def)
 qed
 
 lemma LIMSEQ_imp_Cauchy: "X \<longlonglongrightarrow> x \<Longrightarrow> Cauchy X"
   unfolding Cauchy_uniform filterlim_def by (intro nhds_imp_cauchy_filter)
 
 lemma Cauchy_subseq_Cauchy:
   assumes "Cauchy X" "strict_mono f"
   shows "Cauchy (X \<circ> f)"
   unfolding Cauchy_uniform comp_def filtermap_filtermap[symmetric] cauchy_filter_def
   by (rule order_trans[OF _ \<open>Cauchy X\<close>[unfolded Cauchy_uniform cauchy_filter_def]])
      (intro prod_filter_mono filtermap_mono filterlim_subseq[OF \<open>strict_mono f\<close>, unfolded filterlim_def])
 
 lemma convergent_Cauchy: "convergent X \<Longrightarrow> Cauchy X"
   unfolding convergent_def by (erule exE, erule LIMSEQ_imp_Cauchy)
 
 definition complete :: "'a set \<Rightarrow> bool"
   where complete_uniform: "complete S \<longleftrightarrow>
     (\<forall>F \<le> principal S. F \<noteq> bot \<longrightarrow> cauchy_filter F \<longrightarrow> (\<exists>x\<in>S. F \<le> nhds x))"
 
 lemma (in uniform_space) cauchy_filter_complete_converges:
   assumes "cauchy_filter F" "complete A" "F \<le> principal A" "F \<noteq> bot"
   shows   "\<exists>c. F \<le> nhds c"
   using assms unfolding complete_uniform by blast
 
 end
 
 subsubsection \<open>Uniformly continuous functions\<close>
 
 definition uniformly_continuous_on :: "'a set \<Rightarrow> ('a::uniform_space \<Rightarrow> 'b::uniform_space) \<Rightarrow> bool"
   where uniformly_continuous_on_uniformity: "uniformly_continuous_on s f \<longleftrightarrow>
     (LIM (x, y) (uniformity_on s). (f x, f y) :> uniformity)"
 
 lemma uniformly_continuous_onD:
   "uniformly_continuous_on s f \<Longrightarrow> eventually E uniformity \<Longrightarrow>
     eventually (\<lambda>(x, y). x \<in> s \<longrightarrow> y \<in> s \<longrightarrow> E (f x, f y)) uniformity"
   by (simp add: uniformly_continuous_on_uniformity filterlim_iff
       eventually_inf_principal split_beta' mem_Times_iff imp_conjL)
 
 lemma uniformly_continuous_on_const[continuous_intros]: "uniformly_continuous_on s (\<lambda>x. c)"
   by (auto simp: uniformly_continuous_on_uniformity filterlim_iff uniformity_refl)
 
 lemma uniformly_continuous_on_id[continuous_intros]: "uniformly_continuous_on s (\<lambda>x. x)"
   by (auto simp: uniformly_continuous_on_uniformity filterlim_def)
 
 lemma uniformly_continuous_on_compose:
   "uniformly_continuous_on s g \<Longrightarrow> uniformly_continuous_on (g`s) f \<Longrightarrow>
     uniformly_continuous_on s (\<lambda>x. f (g x))"
   using filterlim_compose[of "\<lambda>(x, y). (f x, f y)" uniformity
       "uniformity_on (g`s)"  "\<lambda>(x, y). (g x, g y)" "uniformity_on s"]
   by (simp add: split_beta' uniformly_continuous_on_uniformity
       filterlim_inf filterlim_principal eventually_inf_principal mem_Times_iff)
 
 lemma uniformly_continuous_imp_continuous:
   assumes f: "uniformly_continuous_on s f"
   shows "continuous_on s f"
   by (auto simp: filterlim_iff eventually_at_filter eventually_nhds_uniformity continuous_on_def
            elim: eventually_mono dest!: uniformly_continuous_onD[OF f])
 
 
 section \<open>Product Topology\<close>
 
 subsection \<open>Product is a topological space\<close>
 
 instantiation prod :: (topological_space, topological_space) topological_space
 begin
 
 definition open_prod_def[code del]:
   "open (S :: ('a \<times> 'b) set) \<longleftrightarrow>
     (\<forall>x\<in>S. \<exists>A B. open A \<and> open B \<and> x \<in> A \<times> B \<and> A \<times> B \<subseteq> S)"
 
 lemma open_prod_elim:
   assumes "open S" and "x \<in> S"
   obtains A B where "open A" and "open B" and "x \<in> A \<times> B" and "A \<times> B \<subseteq> S"
   using assms unfolding open_prod_def by fast
 
 lemma open_prod_intro:
   assumes "\<And>x. x \<in> S \<Longrightarrow> \<exists>A B. open A \<and> open B \<and> x \<in> A \<times> B \<and> A \<times> B \<subseteq> S"
   shows "open S"
   using assms unfolding open_prod_def by fast
 
 instance
 proof
   show "open (UNIV :: ('a \<times> 'b) set)"
     unfolding open_prod_def by auto
 next
   fix S T :: "('a \<times> 'b) set"
   assume "open S" "open T"
   show "open (S \<inter> T)"
   proof (rule open_prod_intro)
     fix x
     assume x: "x \<in> S \<inter> T"
     from x have "x \<in> S" by simp
     obtain Sa Sb where A: "open Sa" "open Sb" "x \<in> Sa \<times> Sb" "Sa \<times> Sb \<subseteq> S"
       using \<open>open S\<close> and \<open>x \<in> S\<close> by (rule open_prod_elim)
     from x have "x \<in> T" by simp
     obtain Ta Tb where B: "open Ta" "open Tb" "x \<in> Ta \<times> Tb" "Ta \<times> Tb \<subseteq> T"
       using \<open>open T\<close> and \<open>x \<in> T\<close> by (rule open_prod_elim)
     let ?A = "Sa \<inter> Ta" and ?B = "Sb \<inter> Tb"
     have "open ?A \<and> open ?B \<and> x \<in> ?A \<times> ?B \<and> ?A \<times> ?B \<subseteq> S \<inter> T"
       using A B by (auto simp add: open_Int)
     then show "\<exists>A B. open A \<and> open B \<and> x \<in> A \<times> B \<and> A \<times> B \<subseteq> S \<inter> T"
       by fast
   qed
 next
   fix K :: "('a \<times> 'b) set set"
   assume "\<forall>S\<in>K. open S"
   then show "open (\<Union>K)"
     unfolding open_prod_def by fast
 qed
 
 end
 
 declare [[code abort: "open :: ('a::topological_space \<times> 'b::topological_space) set \<Rightarrow> bool"]]
 
 lemma open_Times: "open S \<Longrightarrow> open T \<Longrightarrow> open (S \<times> T)"
   unfolding open_prod_def by auto
 
 lemma fst_vimage_eq_Times: "fst -` S = S \<times> UNIV"
   by auto
 
 lemma snd_vimage_eq_Times: "snd -` S = UNIV \<times> S"
   by auto
 
 lemma open_vimage_fst: "open S \<Longrightarrow> open (fst -` S)"
   by (simp add: fst_vimage_eq_Times open_Times)
 
 lemma open_vimage_snd: "open S \<Longrightarrow> open (snd -` S)"
   by (simp add: snd_vimage_eq_Times open_Times)
 
 lemma closed_vimage_fst: "closed S \<Longrightarrow> closed (fst -` S)"
   unfolding closed_open vimage_Compl [symmetric]
   by (rule open_vimage_fst)
 
 lemma closed_vimage_snd: "closed S \<Longrightarrow> closed (snd -` S)"
   unfolding closed_open vimage_Compl [symmetric]
   by (rule open_vimage_snd)
 
 lemma closed_Times: "closed S \<Longrightarrow> closed T \<Longrightarrow> closed (S \<times> T)"
 proof -
   have "S \<times> T = (fst -` S) \<inter> (snd -` T)"
     by auto
   then show "closed S \<Longrightarrow> closed T \<Longrightarrow> closed (S \<times> T)"
     by (simp add: closed_vimage_fst closed_vimage_snd closed_Int)
 qed
 
 lemma subset_fst_imageI: "A \<times> B \<subseteq> S \<Longrightarrow> y \<in> B \<Longrightarrow> A \<subseteq> fst ` S"
   unfolding image_def subset_eq by force
 
 lemma subset_snd_imageI: "A \<times> B \<subseteq> S \<Longrightarrow> x \<in> A \<Longrightarrow> B \<subseteq> snd ` S"
   unfolding image_def subset_eq by force
 
 lemma open_image_fst:
   assumes "open S"
   shows "open (fst ` S)"
 proof (rule openI)
   fix x
   assume "x \<in> fst ` S"
   then obtain y where "(x, y) \<in> S"
     by auto
   then obtain A B where "open A" "open B" "x \<in> A" "y \<in> B" "A \<times> B \<subseteq> S"
     using \<open>open S\<close> unfolding open_prod_def by auto
   from \<open>A \<times> B \<subseteq> S\<close> \<open>y \<in> B\<close> have "A \<subseteq> fst ` S"
     by (rule subset_fst_imageI)
   with \<open>open A\<close> \<open>x \<in> A\<close> have "open A \<and> x \<in> A \<and> A \<subseteq> fst ` S"
     by simp
   then show "\<exists>T. open T \<and> x \<in> T \<and> T \<subseteq> fst ` S" ..
 qed
 
 lemma open_image_snd:
   assumes "open S"
   shows "open (snd ` S)"
 proof (rule openI)
   fix y
   assume "y \<in> snd ` S"
   then obtain x where "(x, y) \<in> S"
     by auto
   then obtain A B where "open A" "open B" "x \<in> A" "y \<in> B" "A \<times> B \<subseteq> S"
     using \<open>open S\<close> unfolding open_prod_def by auto
   from \<open>A \<times> B \<subseteq> S\<close> \<open>x \<in> A\<close> have "B \<subseteq> snd ` S"
     by (rule subset_snd_imageI)
   with \<open>open B\<close> \<open>y \<in> B\<close> have "open B \<and> y \<in> B \<and> B \<subseteq> snd ` S"
     by simp
   then show "\<exists>T. open T \<and> y \<in> T \<and> T \<subseteq> snd ` S" ..
 qed
 
 lemma nhds_prod: "nhds (a, b) = nhds a \<times>\<^sub>F nhds b"
   unfolding nhds_def
 proof (subst prod_filter_INF, auto intro!: antisym INF_greatest simp: principal_prod_principal)
   fix S T
   assume "open S" "a \<in> S" "open T" "b \<in> T"
   then show "(INF x \<in> {S. open S \<and> (a, b) \<in> S}. principal x) \<le> principal (S \<times> T)"
     by (intro INF_lower) (auto intro!: open_Times)
 next
   fix S'
   assume "open S'" "(a, b) \<in> S'"
   then obtain S T where "open S" "a \<in> S" "open T" "b \<in> T" "S \<times> T \<subseteq> S'"
     by (auto elim: open_prod_elim)
   then show "(INF x \<in> {S. open S \<and> a \<in> S}. INF y \<in> {S. open S \<and> b \<in> S}.
       principal (x \<times> y)) \<le> principal S'"
     by (auto intro!: INF_lower2)
 qed
 
 
 subsubsection \<open>Continuity of operations\<close>
 
 lemma tendsto_fst [tendsto_intros]:
   assumes "(f \<longlongrightarrow> a) F"
   shows "((\<lambda>x. fst (f x)) \<longlongrightarrow> fst a) F"
 proof (rule topological_tendstoI)
   fix S
   assume "open S" and "fst a \<in> S"
   then have "open (fst -` S)" and "a \<in> fst -` S"
     by (simp_all add: open_vimage_fst)
   with assms have "eventually (\<lambda>x. f x \<in> fst -` S) F"
     by (rule topological_tendstoD)
   then show "eventually (\<lambda>x. fst (f x) \<in> S) F"
     by simp
 qed
 
 lemma tendsto_snd [tendsto_intros]:
   assumes "(f \<longlongrightarrow> a) F"
   shows "((\<lambda>x. snd (f x)) \<longlongrightarrow> snd a) F"
 proof (rule topological_tendstoI)
   fix S
   assume "open S" and "snd a \<in> S"
   then have "open (snd -` S)" and "a \<in> snd -` S"
     by (simp_all add: open_vimage_snd)
   with assms have "eventually (\<lambda>x. f x \<in> snd -` S) F"
     by (rule topological_tendstoD)
   then show "eventually (\<lambda>x. snd (f x) \<in> S) F"
     by simp
 qed
 
 lemma tendsto_Pair [tendsto_intros]:
   assumes "(f \<longlongrightarrow> a) F" and "(g \<longlongrightarrow> b) F"
   shows "((\<lambda>x. (f x, g x)) \<longlongrightarrow> (a, b)) F"
   unfolding nhds_prod using assms by (rule filterlim_Pair)
 
 lemma continuous_fst[continuous_intros]: "continuous F f \<Longrightarrow> continuous F (\<lambda>x. fst (f x))"
   unfolding continuous_def by (rule tendsto_fst)
 
 lemma continuous_snd[continuous_intros]: "continuous F f \<Longrightarrow> continuous F (\<lambda>x. snd (f x))"
   unfolding continuous_def by (rule tendsto_snd)
 
 lemma continuous_Pair[continuous_intros]:
   "continuous F f \<Longrightarrow> continuous F g \<Longrightarrow> continuous F (\<lambda>x. (f x, g x))"
   unfolding continuous_def by (rule tendsto_Pair)
 
 lemma continuous_on_fst[continuous_intros]:
   "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. fst (f x))"
   unfolding continuous_on_def by (auto intro: tendsto_fst)
 
 lemma continuous_on_snd[continuous_intros]:
   "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. snd (f x))"
   unfolding continuous_on_def by (auto intro: tendsto_snd)
 
 lemma continuous_on_Pair[continuous_intros]:
   "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_Pair)
 
 lemma continuous_on_swap[continuous_intros]: "continuous_on A prod.swap"
   by (simp add: prod.swap_def continuous_on_fst continuous_on_snd
       continuous_on_Pair continuous_on_id)
 
 lemma continuous_on_swap_args:
   assumes "continuous_on (A\<times>B) (\<lambda>(x,y). d x y)"
     shows "continuous_on (B\<times>A) (\<lambda>(x,y). d y x)"
 proof -
   have "(\<lambda>(x,y). d y x) = (\<lambda>(x,y). d x y) \<circ> prod.swap"
     by force
   then show ?thesis
     by (metis assms continuous_on_compose continuous_on_swap product_swap)
 qed
 
 lemma isCont_fst [simp]: "isCont f a \<Longrightarrow> isCont (\<lambda>x. fst (f x)) a"
   by (fact continuous_fst)
 
 lemma isCont_snd [simp]: "isCont f a \<Longrightarrow> isCont (\<lambda>x. snd (f x)) a"
   by (fact continuous_snd)
 
 lemma isCont_Pair [simp]: "\<lbrakk>isCont f a; isCont g a\<rbrakk> \<Longrightarrow> isCont (\<lambda>x. (f x, g x)) a"
   by (fact continuous_Pair)
 
 lemma continuous_on_compose_Pair:
   assumes f: "continuous_on (Sigma A B) (\<lambda>(a, b). f a b)"
   assumes g: "continuous_on C g"
   assumes h: "continuous_on C h"
   assumes subset: "\<And>c. c \<in> C \<Longrightarrow> g c \<in> A" "\<And>c. c \<in> C \<Longrightarrow> h c \<in> B (g c)"
   shows "continuous_on C (\<lambda>c. f (g c) (h c))"
   using continuous_on_compose2[OF f continuous_on_Pair[OF g h]] subset
   by auto
 
 
 subsubsection \<open>Connectedness of products\<close>
 
 proposition connected_Times:
   assumes S: "connected S" and T: "connected T"
   shows "connected (S \<times> T)"
 proof (rule connectedI_const)
   fix P::"'a \<times> 'b \<Rightarrow> bool"
   assume P[THEN continuous_on_compose2, continuous_intros]: "continuous_on (S \<times> T) P"
   have "continuous_on S (\<lambda>s. P (s, t))" if "t \<in> T" for t
     by (auto intro!: continuous_intros that)
   from connectedD_const[OF S this]
   obtain c1 where c1: "\<And>s t. t \<in> T \<Longrightarrow> s \<in> S \<Longrightarrow> P (s, t) = c1 t"
     by metis
   moreover
   have "continuous_on T (\<lambda>t. P (s, t))" if "s \<in> S" for s
     by (auto intro!: continuous_intros that)
   from connectedD_const[OF T this]
   obtain c2 where "\<And>s t. t \<in> T \<Longrightarrow> s \<in> S \<Longrightarrow> P (s, t) = c2 s"
     by metis
   ultimately show "\<exists>c. \<forall>s\<in>S \<times> T. P s = c"
     by auto
 qed
 
 corollary connected_Times_eq [simp]:
    "connected (S \<times> T) \<longleftrightarrow> S = {} \<or> T = {} \<or> connected S \<and> connected T"  (is "?lhs = ?rhs")
 proof
   assume L: ?lhs
   show ?rhs
   proof cases
     assume "S \<noteq> {} \<and> T \<noteq> {}"
     moreover
     have "connected (fst ` (S \<times> T))" "connected (snd ` (S \<times> T))"
       using continuous_on_fst continuous_on_snd continuous_on_id
       by (blast intro: connected_continuous_image [OF _ L])+
     ultimately show ?thesis
       by auto
   qed auto
 qed (auto simp: connected_Times)
 
 
 subsubsection \<open>Separation axioms\<close>
 
 instance prod :: (t0_space, t0_space) t0_space
 proof
   fix x y :: "'a \<times> 'b"
   assume "x \<noteq> y"
   then have "fst x \<noteq> fst y \<or> snd x \<noteq> snd y"
     by (simp add: prod_eq_iff)
   then show "\<exists>U. open U \<and> (x \<in> U) \<noteq> (y \<in> U)"
     by (fast dest: t0_space elim: open_vimage_fst open_vimage_snd)
 qed
 
 instance prod :: (t1_space, t1_space) t1_space
 proof
   fix x y :: "'a \<times> 'b"
   assume "x \<noteq> y"
   then have "fst x \<noteq> fst y \<or> snd x \<noteq> snd y"
     by (simp add: prod_eq_iff)
   then show "\<exists>U. open U \<and> x \<in> U \<and> y \<notin> U"
     by (fast dest: t1_space elim: open_vimage_fst open_vimage_snd)
 qed
 
 instance prod :: (t2_space, t2_space) t2_space
 proof
   fix x y :: "'a \<times> 'b"
   assume "x \<noteq> y"
   then have "fst x \<noteq> fst y \<or> snd x \<noteq> snd y"
     by (simp add: prod_eq_iff)
   then show "\<exists>U V. open U \<and> open V \<and> x \<in> U \<and> y \<in> V \<and> U \<inter> V = {}"
     by (fast dest: hausdorff elim: open_vimage_fst open_vimage_snd)
 qed
 
 lemma isCont_swap[continuous_intros]: "isCont prod.swap a"
   using continuous_on_eq_continuous_within continuous_on_swap by blast
 
 lemma open_diagonal_complement:
   "open {(x,y) |x y. x \<noteq> (y::('a::t2_space))}"
 proof -
   have "open {(x, y). x \<noteq> (y::'a)}"
     unfolding split_def by (intro open_Collect_neq continuous_intros)
   also have "{(x, y). x \<noteq> (y::'a)} = {(x, y) |x y. x \<noteq> (y::'a)}"
     by auto
   finally show ?thesis .
 qed
 
 lemma closed_diagonal:
   "closed {y. \<exists> x::('a::t2_space). y = (x,x)}"
 proof -
   have "{y. \<exists> x::'a. y = (x,x)} = UNIV - {(x,y) | x y. x \<noteq> y}" by auto
   then show ?thesis using open_diagonal_complement closed_Diff by auto
 qed
 
 lemma open_superdiagonal:
   "open {(x,y) | x y. x > (y::'a::{linorder_topology})}"
 proof -
   have "open {(x, y). x > (y::'a)}"
     unfolding split_def by (intro open_Collect_less continuous_intros)
   also have "{(x, y). x > (y::'a)} = {(x, y) |x y. x > (y::'a)}"
     by auto
   finally show ?thesis .
 qed
 
 lemma closed_subdiagonal:
   "closed {(x,y) | x y. x \<le> (y::'a::{linorder_topology})}"
 proof -
   have "{(x,y) | x y. x \<le> (y::'a)} = UNIV - {(x,y) | x y. x > (y::'a)}" by auto
   then show ?thesis using open_superdiagonal closed_Diff by auto
 qed
 
 lemma open_subdiagonal:
   "open {(x,y) | x y. x < (y::'a::{linorder_topology})}"
 proof -
   have "open {(x, y). x < (y::'a)}"
     unfolding split_def by (intro open_Collect_less continuous_intros)
   also have "{(x, y). x < (y::'a)} = {(x, y) |x y. x < (y::'a)}"
     by auto
   finally show ?thesis .
 qed
 
 lemma closed_superdiagonal:
   "closed {(x,y) | x y. x \<ge> (y::('a::{linorder_topology}))}"
 proof -
   have "{(x,y) | x y. x \<ge> (y::'a)} = UNIV - {(x,y) | x y. x < y}" by auto
   then show ?thesis using open_subdiagonal closed_Diff by auto
 qed
 
 
 end
diff --git a/src/HOL/Transcendental.thy b/src/HOL/Transcendental.thy
--- a/src/HOL/Transcendental.thy
+++ b/src/HOL/Transcendental.thy
@@ -1,7428 +1,7463 @@
 (*  Title:      HOL/Transcendental.thy
     Author:     Jacques D. Fleuriot, University of Cambridge, University of Edinburgh
     Author:     Lawrence C Paulson
     Author:     Jeremy Avigad
 *)
 
 section \<open>Power Series, Transcendental Functions etc.\<close>
 
 theory Transcendental
 imports Series Deriv NthRoot
 begin
 
 text \<open>A theorem about the factcorial function on the reals.\<close>
 
 lemma square_fact_le_2_fact: "fact n * fact n \<le> (fact (2 * n) :: real)"
 proof (induct n)
   case 0
   then show ?case by simp
 next
   case (Suc n)
   have "(fact (Suc n)) * (fact (Suc n)) = of_nat (Suc n) * of_nat (Suc n) * (fact n * fact n :: real)"
     by (simp add: field_simps)
   also have "\<dots> \<le> of_nat (Suc n) * of_nat (Suc n) * fact (2 * n)"
     by (rule mult_left_mono [OF Suc]) simp
   also have "\<dots> \<le> of_nat (Suc (Suc (2 * n))) * of_nat (Suc (2 * n)) * fact (2 * n)"
     by (rule mult_right_mono)+ (auto simp: field_simps)
   also have "\<dots> = fact (2 * Suc n)" by (simp add: field_simps)
   finally show ?case .
 qed
 
 lemma fact_in_Reals: "fact n \<in> \<real>"
   by (induction n) auto
 
 lemma of_real_fact [simp]: "of_real (fact n) = fact n"
   by (metis of_nat_fact of_real_of_nat_eq)
 
 lemma pochhammer_of_real: "pochhammer (of_real x) n = of_real (pochhammer x n)"
   by (simp add: pochhammer_prod)
 
 lemma norm_fact [simp]: "norm (fact n :: 'a::real_normed_algebra_1) = fact n"
 proof -
   have "(fact n :: 'a) = of_real (fact n)"
     by simp
   also have "norm \<dots> = fact n"
     by (subst norm_of_real) simp
   finally show ?thesis .
 qed
 
 lemma root_test_convergence:
   fixes f :: "nat \<Rightarrow> 'a::banach"
   assumes f: "(\<lambda>n. root n (norm (f n))) \<longlonglongrightarrow> x" \<comment> \<open>could be weakened to lim sup\<close>
     and "x < 1"
   shows "summable f"
 proof -
   have "0 \<le> x"
     by (rule LIMSEQ_le[OF tendsto_const f]) (auto intro!: exI[of _ 1])
   from \<open>x < 1\<close> obtain z where z: "x < z" "z < 1"
     by (metis dense)
   from f \<open>x < z\<close> have "eventually (\<lambda>n. root n (norm (f n)) < z) sequentially"
     by (rule order_tendstoD)
   then have "eventually (\<lambda>n. norm (f n) \<le> z^n) sequentially"
     using eventually_ge_at_top
   proof eventually_elim
     fix n
     assume less: "root n (norm (f n)) < z" and n: "1 \<le> n"
     from power_strict_mono[OF less, of n] n show "norm (f n) \<le> z ^ n"
       by simp
   qed
   then show "summable f"
     unfolding eventually_sequentially
     using z \<open>0 \<le> x\<close> by (auto intro!: summable_comparison_test[OF _  summable_geometric])
 qed
 
 subsection \<open>More facts about binomial coefficients\<close>
 
 text \<open>
   These facts could have been proven before, but having real numbers
   makes the proofs a lot easier.
 \<close>
 
 lemma central_binomial_odd:
   "odd n \<Longrightarrow> n choose (Suc (n div 2)) = n choose (n div 2)"
 proof -
   assume "odd n"
   hence "Suc (n div 2) \<le> n" by presburger
   hence "n choose (Suc (n div 2)) = n choose (n - Suc (n div 2))"
     by (rule binomial_symmetric)
   also from \<open>odd n\<close> have "n - Suc (n div 2) = n div 2" by presburger
   finally show ?thesis .
 qed
 
 lemma binomial_less_binomial_Suc:
   assumes k: "k < n div 2"
   shows   "n choose k < n choose (Suc k)"
 proof -
   from k have k': "k \<le> n" "Suc k \<le> n" by simp_all
   from k' have "real (n choose k) = fact n / (fact k * fact (n - k))"
     by (simp add: binomial_fact)
   also from k' have "n - k = Suc (n - Suc k)" by simp
   also from k' have "fact \<dots> = (real n - real k) * fact (n - Suc k)"
     by (subst fact_Suc) (simp_all add: of_nat_diff)
   also from k have "fact k = fact (Suc k) / (real k + 1)" by (simp add: field_simps)
   also have "fact n / (fact (Suc k) / (real k + 1) * ((real n - real k) * fact (n - Suc k))) =
                (n choose (Suc k)) * ((real k + 1) / (real n - real k))"
     using k by (simp add: field_split_simps binomial_fact)
   also from assms have "(real k + 1) / (real n - real k) < 1" by simp
   finally show ?thesis using k by (simp add: mult_less_cancel_left)
 qed
 
 lemma binomial_strict_mono:
   assumes "k < k'" "2*k' \<le> n"
   shows   "n choose k < n choose k'"
 proof -
   from assms have "k \<le> k' - 1" by simp
   thus ?thesis
   proof (induction rule: inc_induct)
     case base
     with assms binomial_less_binomial_Suc[of "k' - 1" n]
       show ?case by simp
   next
     case (step k)
     from step.prems step.hyps assms have "n choose k < n choose (Suc k)"
       by (intro binomial_less_binomial_Suc) simp_all
     also have "\<dots> < n choose k'" by (rule step.IH)
     finally show ?case .
   qed
 qed
 
 lemma binomial_mono:
   assumes "k \<le> k'" "2*k' \<le> n"
   shows   "n choose k \<le> n choose k'"
   using assms binomial_strict_mono[of k k' n] by (cases "k = k'") simp_all
 
 lemma binomial_strict_antimono:
   assumes "k < k'" "2 * k \<ge> n" "k' \<le> n"
   shows   "n choose k > n choose k'"
 proof -
   from assms have "n choose (n - k) > n choose (n - k')"
     by (intro binomial_strict_mono) (simp_all add: algebra_simps)
   with assms show ?thesis by (simp add: binomial_symmetric [symmetric])
 qed
 
 lemma binomial_antimono:
   assumes "k \<le> k'" "k \<ge> n div 2" "k' \<le> n"
   shows   "n choose k \<ge> n choose k'"
 proof (cases "k = k'")
   case False
   note not_eq = False
   show ?thesis
   proof (cases "k = n div 2 \<and> odd n")
     case False
     with assms(2) have "2*k \<ge> n" by presburger
     with not_eq assms binomial_strict_antimono[of k k' n]
       show ?thesis by simp
   next
     case True
     have "n choose k' \<le> n choose (Suc (n div 2))"
     proof (cases "k' = Suc (n div 2)")
       case False
       with assms True not_eq have "Suc (n div 2) < k'" by simp
       with assms binomial_strict_antimono[of "Suc (n div 2)" k' n] True
         show ?thesis by auto
     qed simp_all
     also from True have "\<dots> = n choose k" by (simp add: central_binomial_odd)
     finally show ?thesis .
   qed
 qed simp_all
 
 lemma binomial_maximum: "n choose k \<le> n choose (n div 2)"
 proof -
   have "k \<le> n div 2 \<longleftrightarrow> 2*k \<le> n" by linarith
   consider "2*k \<le> n" | "2*k \<ge> n" "k \<le> n" | "k > n" by linarith
   thus ?thesis
   proof cases
     case 1
     thus ?thesis by (intro binomial_mono) linarith+
   next
     case 2
     thus ?thesis by (intro binomial_antimono) simp_all
   qed (simp_all add: binomial_eq_0)
 qed
 
 lemma binomial_maximum': "(2*n) choose k \<le> (2*n) choose n"
   using binomial_maximum[of "2*n"] by simp
 
 lemma central_binomial_lower_bound:
   assumes "n > 0"
   shows   "4^n / (2*real n) \<le> real ((2*n) choose n)"
 proof -
   from binomial[of 1 1 "2*n"]
     have "4 ^ n = (\<Sum>k\<le>2*n. (2*n) choose k)"
     by (simp add: power_mult power2_eq_square One_nat_def [symmetric] del: One_nat_def)
   also have "{..2*n} = {0<..<2*n} \<union> {0,2*n}" by auto
   also have "(\<Sum>k\<in>\<dots>. (2*n) choose k) =
              (\<Sum>k\<in>{0<..<2*n}. (2*n) choose k) + (\<Sum>k\<in>{0,2*n}. (2*n) choose k)"
     by (subst sum.union_disjoint) auto
   also have "(\<Sum>k\<in>{0,2*n}. (2*n) choose k) \<le> (\<Sum>k\<le>1. (n choose k)\<^sup>2)"
     by (cases n) simp_all
   also from assms have "\<dots> \<le> (\<Sum>k\<le>n. (n choose k)\<^sup>2)"
     by (intro sum_mono2) auto
   also have "\<dots> = (2*n) choose n" by (rule choose_square_sum)
   also have "(\<Sum>k\<in>{0<..<2*n}. (2*n) choose k) \<le> (\<Sum>k\<in>{0<..<2*n}. (2*n) choose n)"
     by (intro sum_mono binomial_maximum')
   also have "\<dots> = card {0<..<2*n} * ((2*n) choose n)" by simp
   also have "card {0<..<2*n} \<le> 2*n - 1" by (cases n) simp_all
   also have "(2 * n - 1) * (2 * n choose n) + (2 * n choose n) = ((2*n) choose n) * (2*n)"
     using assms by (simp add: algebra_simps)
   finally have "4 ^ n \<le> (2 * n choose n) * (2 * n)" by simp_all
   hence "real (4 ^ n) \<le> real ((2 * n choose n) * (2 * n))"
     by (subst of_nat_le_iff)
   with assms show ?thesis by (simp add: field_simps)
 qed
 
 
 subsection \<open>Properties of Power Series\<close>
 
 lemma powser_zero [simp]: "(\<Sum>n. f n * 0 ^ n) = f 0"
   for f :: "nat \<Rightarrow> 'a::real_normed_algebra_1"
 proof -
   have "(\<Sum>n<1. f n * 0 ^ n) = (\<Sum>n. f n * 0 ^ n)"
     by (subst suminf_finite[where N="{0}"]) (auto simp: power_0_left)
   then show ?thesis by simp
 qed
 
 lemma powser_sums_zero: "(\<lambda>n. a n * 0^n) sums a 0"
   for a :: "nat \<Rightarrow> 'a::real_normed_div_algebra"
   using sums_finite [of "{0}" "\<lambda>n. a n * 0 ^ n"]
   by simp
 
 lemma powser_sums_zero_iff [simp]: "(\<lambda>n. a n * 0^n) sums x \<longleftrightarrow> a 0 = x"
   for a :: "nat \<Rightarrow> 'a::real_normed_div_algebra"
   using powser_sums_zero sums_unique2 by blast
 
 text \<open>
   Power series has a circle or radius of convergence: if it sums for \<open>x\<close>,
   then it sums absolutely for \<open>z\<close> with \<^term>\<open>\<bar>z\<bar> < \<bar>x\<bar>\<close>.\<close>
 
 lemma powser_insidea:
   fixes x z :: "'a::real_normed_div_algebra"
   assumes 1: "summable (\<lambda>n. f n * x^n)"
     and 2: "norm z < norm x"
   shows "summable (\<lambda>n. norm (f n * z ^ n))"
 proof -
   from 2 have x_neq_0: "x \<noteq> 0" by clarsimp
   from 1 have "(\<lambda>n. f n * x^n) \<longlonglongrightarrow> 0"
     by (rule summable_LIMSEQ_zero)
   then have "convergent (\<lambda>n. f n * x^n)"
     by (rule convergentI)
   then have "Cauchy (\<lambda>n. f n * x^n)"
     by (rule convergent_Cauchy)
   then have "Bseq (\<lambda>n. f n * x^n)"
     by (rule Cauchy_Bseq)
   then obtain K where 3: "0 < K" and 4: "\<forall>n. norm (f n * x^n) \<le> K"
     by (auto simp: Bseq_def)
   have "\<exists>N. \<forall>n\<ge>N. norm (norm (f n * z ^ n)) \<le> K * norm (z ^ n) * inverse (norm (x^n))"
   proof (intro exI allI impI)
     fix n :: nat
     assume "0 \<le> n"
     have "norm (norm (f n * z ^ n)) * norm (x^n) =
           norm (f n * x^n) * norm (z ^ n)"
       by (simp add: norm_mult abs_mult)
     also have "\<dots> \<le> K * norm (z ^ n)"
       by (simp only: mult_right_mono 4 norm_ge_zero)
     also have "\<dots> = K * norm (z ^ n) * (inverse (norm (x^n)) * norm (x^n))"
       by (simp add: x_neq_0)
     also have "\<dots> = K * norm (z ^ n) * inverse (norm (x^n)) * norm (x^n)"
       by (simp only: mult.assoc)
     finally show "norm (norm (f n * z ^ n)) \<le> K * norm (z ^ n) * inverse (norm (x^n))"
       by (simp add: mult_le_cancel_right x_neq_0)
   qed
   moreover have "summable (\<lambda>n. K * norm (z ^ n) * inverse (norm (x^n)))"
   proof -
     from 2 have "norm (norm (z * inverse x)) < 1"
       using x_neq_0
       by (simp add: norm_mult nonzero_norm_inverse divide_inverse [where 'a=real, symmetric])
     then have "summable (\<lambda>n. norm (z * inverse x) ^ n)"
       by (rule summable_geometric)
     then have "summable (\<lambda>n. K * norm (z * inverse x) ^ n)"
       by (rule summable_mult)
     then show "summable (\<lambda>n. K * norm (z ^ n) * inverse (norm (x^n)))"
       using x_neq_0
       by (simp add: norm_mult nonzero_norm_inverse power_mult_distrib
           power_inverse norm_power mult.assoc)
   qed
   ultimately show "summable (\<lambda>n. norm (f n * z ^ n))"
     by (rule summable_comparison_test)
 qed
 
 lemma powser_inside:
   fixes f :: "nat \<Rightarrow> 'a::{real_normed_div_algebra,banach}"
   shows
     "summable (\<lambda>n. f n * (x^n)) \<Longrightarrow> norm z < norm x \<Longrightarrow>
       summable (\<lambda>n. f n * (z ^ n))"
   by (rule powser_insidea [THEN summable_norm_cancel])
 
 lemma powser_times_n_limit_0:
   fixes x :: "'a::{real_normed_div_algebra,banach}"
   assumes "norm x < 1"
     shows "(\<lambda>n. of_nat n * x ^ n) \<longlonglongrightarrow> 0"
 proof -
   have "norm x / (1 - norm x) \<ge> 0"
     using assms by (auto simp: field_split_simps)
   moreover obtain N where N: "norm x / (1 - norm x) < of_int N"
     using ex_le_of_int by (meson ex_less_of_int)
   ultimately have N0: "N>0"
     by auto
   then have *: "real_of_int (N + 1) * norm x / real_of_int N < 1"
     using N assms by (auto simp: field_simps)
   have **: "real_of_int N * (norm x * (real_of_nat (Suc n) * norm (x ^ n))) \<le>
       real_of_nat n * (norm x * ((1 + N) * norm (x ^ n)))" if "N \<le> int n" for n :: nat
   proof -
     from that have "real_of_int N * real_of_nat (Suc n) \<le> real_of_nat n * real_of_int (1 + N)"
       by (simp add: algebra_simps)
     then have "(real_of_int N * real_of_nat (Suc n)) * (norm x * norm (x ^ n)) \<le>
         (real_of_nat n *  (1 + N)) * (norm x * norm (x ^ n))"
       using N0 mult_mono by fastforce
     then show ?thesis
       by (simp add: algebra_simps)
   qed
   show ?thesis using *
     by (rule summable_LIMSEQ_zero [OF summable_ratio_test, where N1="nat N"])
       (simp add: N0 norm_mult field_simps ** del: of_nat_Suc of_int_add)
 qed
 
 corollary lim_n_over_pown:
   fixes x :: "'a::{real_normed_field,banach}"
   shows "1 < norm x \<Longrightarrow> ((\<lambda>n. of_nat n / x^n) \<longlongrightarrow> 0) sequentially"
   using powser_times_n_limit_0 [of "inverse x"]
   by (simp add: norm_divide field_split_simps)
 
 lemma sum_split_even_odd:
   fixes f :: "nat \<Rightarrow> real"
   shows "(\<Sum>i<2 * n. if even i then f i else g i) = (\<Sum>i<n. f (2 * i)) + (\<Sum>i<n. g (2 * i + 1))"
 proof (induct n)
   case 0
   then show ?case by simp
 next
   case (Suc n)
   have "(\<Sum>i<2 * Suc n. if even i then f i else g i) =
     (\<Sum>i<n. f (2 * i)) + (\<Sum>i<n. g (2 * i + 1)) + (f (2 * n) + g (2 * n + 1))"
     using Suc.hyps unfolding One_nat_def by auto
   also have "\<dots> = (\<Sum>i<Suc n. f (2 * i)) + (\<Sum>i<Suc n. g (2 * i + 1))"
     by auto
   finally show ?case .
 qed
 
 lemma sums_if':
   fixes g :: "nat \<Rightarrow> real"
   assumes "g sums x"
   shows "(\<lambda> n. if even n then 0 else g ((n - 1) div 2)) sums x"
   unfolding sums_def
 proof (rule LIMSEQ_I)
   fix r :: real
   assume "0 < r"
   from \<open>g sums x\<close>[unfolded sums_def, THEN LIMSEQ_D, OF this]
   obtain no where no_eq: "\<And>n. n \<ge> no \<Longrightarrow> (norm (sum g {..<n} - x) < r)"
     by blast
 
   let ?SUM = "\<lambda> m. \<Sum>i<m. if even i then 0 else g ((i - 1) div 2)"
   have "(norm (?SUM m - x) < r)" if "m \<ge> 2 * no" for m
   proof -
     from that have "m div 2 \<ge> no" by auto
     have sum_eq: "?SUM (2 * (m div 2)) = sum g {..< m div 2}"
       using sum_split_even_odd by auto
     then have "(norm (?SUM (2 * (m div 2)) - x) < r)"
       using no_eq unfolding sum_eq using \<open>m div 2 \<ge> no\<close> by auto
     moreover
     have "?SUM (2 * (m div 2)) = ?SUM m"
     proof (cases "even m")
       case True
       then show ?thesis
         by (auto simp: even_two_times_div_two)
     next
       case False
       then have eq: "Suc (2 * (m div 2)) = m" by simp
       then have "even (2 * (m div 2))" using \<open>odd m\<close> by auto
       have "?SUM m = ?SUM (Suc (2 * (m div 2)))" unfolding eq ..
       also have "\<dots> = ?SUM (2 * (m div 2))" using \<open>even (2 * (m div 2))\<close> by auto
       finally show ?thesis by auto
     qed
     ultimately show ?thesis by auto
   qed
   then show "\<exists>no. \<forall> m \<ge> no. norm (?SUM m - x) < r"
     by blast
 qed
 
 lemma sums_if:
   fixes g :: "nat \<Rightarrow> real"
   assumes "g sums x" and "f sums y"
   shows "(\<lambda> n. if even n then f (n div 2) else g ((n - 1) div 2)) sums (x + y)"
 proof -
   let ?s = "\<lambda> n. if even n then 0 else f ((n - 1) div 2)"
   have if_sum: "(if B then (0 :: real) else E) + (if B then T else 0) = (if B then T else E)"
     for B T E
     by (cases B) auto
   have g_sums: "(\<lambda> n. if even n then 0 else g ((n - 1) div 2)) sums x"
     using sums_if'[OF \<open>g sums x\<close>] .
   have if_eq: "\<And>B T E. (if \<not> B then T else E) = (if B then E else T)"
     by auto
   have "?s sums y" using sums_if'[OF \<open>f sums y\<close>] .
   from this[unfolded sums_def, THEN LIMSEQ_Suc]
   have "(\<lambda>n. if even n then f (n div 2) else 0) sums y"
     by (simp add: lessThan_Suc_eq_insert_0 sum.atLeast1_atMost_eq image_Suc_lessThan
         if_eq sums_def cong del: if_weak_cong)
   from sums_add[OF g_sums this] show ?thesis
     by (simp only: if_sum)
 qed
 
 subsection \<open>Alternating series test / Leibniz formula\<close>
 (* FIXME: generalise these results from the reals via type classes? *)
 
 lemma sums_alternating_upper_lower:
   fixes a :: "nat \<Rightarrow> real"
   assumes mono: "\<And>n. a (Suc n) \<le> a n"
     and a_pos: "\<And>n. 0 \<le> a n"
     and "a \<longlonglongrightarrow> 0"
   shows "\<exists>l. ((\<forall>n. (\<Sum>i<2*n. (- 1)^i*a i) \<le> l) \<and> (\<lambda> n. \<Sum>i<2*n. (- 1)^i*a i) \<longlonglongrightarrow> l) \<and>
              ((\<forall>n. l \<le> (\<Sum>i<2*n + 1. (- 1)^i*a i)) \<and> (\<lambda> n. \<Sum>i<2*n + 1. (- 1)^i*a i) \<longlonglongrightarrow> l)"
   (is "\<exists>l. ((\<forall>n. ?f n \<le> l) \<and> _) \<and> ((\<forall>n. l \<le> ?g n) \<and> _)")
 proof (rule nested_sequence_unique)
   have fg_diff: "\<And>n. ?f n - ?g n = - a (2 * n)" by auto
 
   show "\<forall>n. ?f n \<le> ?f (Suc n)"
   proof
     show "?f n \<le> ?f (Suc n)" for n
       using mono[of "2*n"] by auto
   qed
   show "\<forall>n. ?g (Suc n) \<le> ?g n"
   proof
     show "?g (Suc n) \<le> ?g n" for n
       using mono[of "Suc (2*n)"] by auto
   qed
   show "\<forall>n. ?f n \<le> ?g n"
   proof
     show "?f n \<le> ?g n" for n
       using fg_diff a_pos by auto
   qed
   show "(\<lambda>n. ?f n - ?g n) \<longlonglongrightarrow> 0"
     unfolding fg_diff
   proof (rule LIMSEQ_I)
     fix r :: real
     assume "0 < r"
     with \<open>a \<longlonglongrightarrow> 0\<close>[THEN LIMSEQ_D] obtain N where "\<And> n. n \<ge> N \<Longrightarrow> norm (a n - 0) < r"
       by auto
     then have "\<forall>n \<ge> N. norm (- a (2 * n) - 0) < r"
       by auto
     then show "\<exists>N. \<forall>n \<ge> N. norm (- a (2 * n) - 0) < r"
       by auto
   qed
 qed
 
 lemma summable_Leibniz':
   fixes a :: "nat \<Rightarrow> real"
   assumes a_zero: "a \<longlonglongrightarrow> 0"
     and a_pos: "\<And>n. 0 \<le> a n"
     and a_monotone: "\<And>n. a (Suc n) \<le> a n"
   shows summable: "summable (\<lambda> n. (-1)^n * a n)"
     and "\<And>n. (\<Sum>i<2*n. (-1)^i*a i) \<le> (\<Sum>i. (-1)^i*a i)"
     and "(\<lambda>n. \<Sum>i<2*n. (-1)^i*a i) \<longlonglongrightarrow> (\<Sum>i. (-1)^i*a i)"
     and "\<And>n. (\<Sum>i. (-1)^i*a i) \<le> (\<Sum>i<2*n+1. (-1)^i*a i)"
     and "(\<lambda>n. \<Sum>i<2*n+1. (-1)^i*a i) \<longlonglongrightarrow> (\<Sum>i. (-1)^i*a i)"
 proof -
   let ?S = "\<lambda>n. (-1)^n * a n"
   let ?P = "\<lambda>n. \<Sum>i<n. ?S i"
   let ?f = "\<lambda>n. ?P (2 * n)"
   let ?g = "\<lambda>n. ?P (2 * n + 1)"
   obtain l :: real
     where below_l: "\<forall> n. ?f n \<le> l"
       and "?f \<longlonglongrightarrow> l"
       and above_l: "\<forall> n. l \<le> ?g n"
       and "?g \<longlonglongrightarrow> l"
     using sums_alternating_upper_lower[OF a_monotone a_pos a_zero] by blast
 
   let ?Sa = "\<lambda>m. \<Sum>n<m. ?S n"
   have "?Sa \<longlonglongrightarrow> l"
   proof (rule LIMSEQ_I)
     fix r :: real
     assume "0 < r"
     with \<open>?f \<longlonglongrightarrow> l\<close>[THEN LIMSEQ_D]
     obtain f_no where f: "\<And>n. n \<ge> f_no \<Longrightarrow> norm (?f n - l) < r"
       by auto
     from \<open>0 < r\<close> \<open>?g \<longlonglongrightarrow> l\<close>[THEN LIMSEQ_D]
     obtain g_no where g: "\<And>n. n \<ge> g_no \<Longrightarrow> norm (?g n - l) < r"
       by auto
     have "norm (?Sa n - l) < r" if "n \<ge> (max (2 * f_no) (2 * g_no))" for n
     proof -
       from that have "n \<ge> 2 * f_no" and "n \<ge> 2 * g_no" by auto
       show ?thesis
       proof (cases "even n")
         case True
         then have n_eq: "2 * (n div 2) = n"
           by (simp add: even_two_times_div_two)
         with \<open>n \<ge> 2 * f_no\<close> have "n div 2 \<ge> f_no"
           by auto
         from f[OF this] show ?thesis
           unfolding n_eq atLeastLessThanSuc_atLeastAtMost .
       next
         case False
         then have "even (n - 1)" by simp
         then have n_eq: "2 * ((n - 1) div 2) = n - 1"
           by (simp add: even_two_times_div_two)
         then have range_eq: "n - 1 + 1 = n"
           using odd_pos[OF False] by auto
         from n_eq \<open>n \<ge> 2 * g_no\<close> have "(n - 1) div 2 \<ge> g_no"
           by auto
         from g[OF this] show ?thesis
           by (simp only: n_eq range_eq)
       qed
     qed
     then show "\<exists>no. \<forall>n \<ge> no. norm (?Sa n - l) < r" by blast
   qed
   then have sums_l: "(\<lambda>i. (-1)^i * a i) sums l"
     by (simp only: sums_def)
   then show "summable ?S"
     by (auto simp: summable_def)
 
   have "l = suminf ?S" by (rule sums_unique[OF sums_l])
 
   fix n
   show "suminf ?S \<le> ?g n"
     unfolding sums_unique[OF sums_l, symmetric] using above_l by auto
   show "?f n \<le> suminf ?S"
     unfolding sums_unique[OF sums_l, symmetric] using below_l by auto
   show "?g \<longlonglongrightarrow> suminf ?S"
     using \<open>?g \<longlonglongrightarrow> l\<close> \<open>l = suminf ?S\<close> by auto
   show "?f \<longlonglongrightarrow> suminf ?S"
     using \<open>?f \<longlonglongrightarrow> l\<close> \<open>l = suminf ?S\<close> by auto
 qed
 
 theorem summable_Leibniz:
   fixes a :: "nat \<Rightarrow> real"
   assumes a_zero: "a \<longlonglongrightarrow> 0"
     and "monoseq a"
   shows "summable (\<lambda> n. (-1)^n * a n)" (is "?summable")
     and "0 < a 0 \<longrightarrow>
       (\<forall>n. (\<Sum>i. (- 1)^i*a i) \<in> { \<Sum>i<2*n. (- 1)^i * a i .. \<Sum>i<2*n+1. (- 1)^i * a i})" (is "?pos")
     and "a 0 < 0 \<longrightarrow>
       (\<forall>n. (\<Sum>i. (- 1)^i*a i) \<in> { \<Sum>i<2*n+1. (- 1)^i * a i .. \<Sum>i<2*n. (- 1)^i * a i})" (is "?neg")
     and "(\<lambda>n. \<Sum>i<2*n. (- 1)^i*a i) \<longlonglongrightarrow> (\<Sum>i. (- 1)^i*a i)" (is "?f")
     and "(\<lambda>n. \<Sum>i<2*n+1. (- 1)^i*a i) \<longlonglongrightarrow> (\<Sum>i. (- 1)^i*a i)" (is "?g")
 proof -
   have "?summable \<and> ?pos \<and> ?neg \<and> ?f \<and> ?g"
   proof (cases "(\<forall>n. 0 \<le> a n) \<and> (\<forall>m. \<forall>n\<ge>m. a n \<le> a m)")
     case True
     then have ord: "\<And>n m. m \<le> n \<Longrightarrow> a n \<le> a m"
       and ge0: "\<And>n. 0 \<le> a n"
       by auto
     have mono: "a (Suc n) \<le> a n" for n
       using ord[where n="Suc n" and m=n] by auto
     note leibniz = summable_Leibniz'[OF \<open>a \<longlonglongrightarrow> 0\<close> ge0]
     from leibniz[OF mono]
     show ?thesis using \<open>0 \<le> a 0\<close> by auto
   next
     let ?a = "\<lambda>n. - a n"
     case False
     with monoseq_le[OF \<open>monoseq a\<close> \<open>a \<longlonglongrightarrow> 0\<close>]
     have "(\<forall> n. a n \<le> 0) \<and> (\<forall>m. \<forall>n\<ge>m. a m \<le> a n)" by auto
     then have ord: "\<And>n m. m \<le> n \<Longrightarrow> ?a n \<le> ?a m" and ge0: "\<And> n. 0 \<le> ?a n"
       by auto
     have monotone: "?a (Suc n) \<le> ?a n" for n
       using ord[where n="Suc n" and m=n] by auto
     note leibniz =
       summable_Leibniz'[OF _ ge0, of "\<lambda>x. x",
         OF tendsto_minus[OF \<open>a \<longlonglongrightarrow> 0\<close>, unfolded minus_zero] monotone]
     have "summable (\<lambda> n. (-1)^n * ?a n)"
       using leibniz(1) by auto
     then obtain l where "(\<lambda> n. (-1)^n * ?a n) sums l"
       unfolding summable_def by auto
     from this[THEN sums_minus] have "(\<lambda> n. (-1)^n * a n) sums -l"
       by auto
     then have ?summable by (auto simp: summable_def)
     moreover
     have "\<bar>- a - - b\<bar> = \<bar>a - b\<bar>" for a b :: real
       unfolding minus_diff_minus by auto
 
     from suminf_minus[OF leibniz(1), unfolded mult_minus_right minus_minus]
     have move_minus: "(\<Sum>n. - ((- 1) ^ n * a n)) = - (\<Sum>n. (- 1) ^ n * a n)"
       by auto
 
     have ?pos using \<open>0 \<le> ?a 0\<close> by auto
     moreover have ?neg
       using leibniz(2,4)
       unfolding mult_minus_right sum_negf move_minus neg_le_iff_le
       by auto
     moreover have ?f and ?g
       using leibniz(3,5)[unfolded mult_minus_right sum_negf move_minus, THEN tendsto_minus_cancel]
       by auto
     ultimately show ?thesis by auto
   qed
   then show ?summable and ?pos and ?neg and ?f and ?g
     by safe
 qed
 
 
 subsection \<open>Term-by-Term Differentiability of Power Series\<close>
 
 definition diffs :: "(nat \<Rightarrow> 'a::ring_1) \<Rightarrow> nat \<Rightarrow> 'a"
   where "diffs c = (\<lambda>n. of_nat (Suc n) * c (Suc n))"
 
 text \<open>Lemma about distributing negation over it.\<close>
 lemma diffs_minus: "diffs (\<lambda>n. - c n) = (\<lambda>n. - diffs c n)"
   by (simp add: diffs_def)
 
 lemma diffs_equiv:
   fixes x :: "'a::{real_normed_vector,ring_1}"
   shows "summable (\<lambda>n. diffs c n * x^n) \<Longrightarrow>
     (\<lambda>n. of_nat n * c n * x^(n - Suc 0)) sums (\<Sum>n. diffs c n * x^n)"
   unfolding diffs_def
   by (simp add: summable_sums sums_Suc_imp)
 
 lemma lemma_termdiff1:
   fixes z :: "'a :: {monoid_mult,comm_ring}"
   shows "(\<Sum>p<m. (((z + h) ^ (m - p)) * (z ^ p)) - (z ^ m)) =
     (\<Sum>p<m. (z ^ p) * (((z + h) ^ (m - p)) - (z ^ (m - p))))"
   by (auto simp: algebra_simps power_add [symmetric])
 
 lemma sumr_diff_mult_const2: "sum f {..<n} - of_nat n * r = (\<Sum>i<n. f i - r)"
   for r :: "'a::ring_1"
   by (simp add: sum_subtractf)
 
 lemma lemma_termdiff2:
   fixes h :: "'a::field"
   assumes h: "h \<noteq> 0"
   shows "((z + h) ^ n - z ^ n) / h - of_nat n * z ^ (n - Suc 0) =
          h * (\<Sum>p< n - Suc 0. \<Sum>q< n - Suc 0 - p. (z + h) ^ q * z ^ (n - 2 - q))"
     (is "?lhs = ?rhs")
 proof (cases n)
   case (Suc m)
   have 0: "\<And>x k. (\<Sum>n<Suc k. h * (z ^ x * (z ^ (k - n) * (h + z) ^ n))) =
                  (\<Sum>j<Suc k.  h * ((h + z) ^ j * z ^ (x + k - j)))"
     by (auto simp add: power_add [symmetric] mult.commute intro: sum.cong)
   have *: "(\<Sum>i<m. z ^ i * ((z + h) ^ (m - i) - z ^ (m - i))) =
            (\<Sum>i<m. \<Sum>j<m - i. h * ((z + h) ^ j * z ^ (m - Suc j)))"
     by (force simp add: less_iff_Suc_add sum_distrib_left diff_power_eq_sum ac_simps 0
         simp del: sum.lessThan_Suc power_Suc intro: sum.cong)
   have "h * ?lhs = (z + h) ^ n - z ^ n - h * of_nat n * z ^ (n - Suc 0)"
     by (simp add: right_diff_distrib diff_divide_distrib h mult.assoc [symmetric])
   also have "... = h * ((\<Sum>p<Suc m. (z + h) ^ p * z ^ (m - p)) - of_nat (Suc m) * z ^ m)"
     by (simp add: Suc diff_power_eq_sum h right_diff_distrib [symmetric] mult.assoc
         del: power_Suc sum.lessThan_Suc of_nat_Suc)
   also have "... = h * ((\<Sum>p<Suc m. (z + h) ^ (m - p) * z ^ p) - of_nat (Suc m) * z ^ m)"
     by (subst sum.nat_diff_reindex[symmetric]) simp
   also have "... = h * (\<Sum>i<Suc m. (z + h) ^ (m - i) * z ^ i - z ^ m)"
     by (simp add: sum_subtractf)
   also have "... = h * ?rhs"
     by (simp add: lemma_termdiff1 sum_distrib_left Suc *)
   finally have "h * ?lhs = h * ?rhs" .
   then show ?thesis
     by (simp add: h)
 qed auto
 
 
 lemma real_sum_nat_ivl_bounded2:
   fixes K :: "'a::linordered_semidom"
   assumes f: "\<And>p::nat. p < n \<Longrightarrow> f p \<le> K" and K: "0 \<le> K"
   shows "sum f {..<n-k} \<le> of_nat n * K"
 proof -
   have "sum f {..<n-k} \<le> (\<Sum>i<n - k. K)"
     by (rule sum_mono [OF f]) auto
   also have "... \<le> of_nat n * K"
     by (auto simp: mult_right_mono K)
   finally show ?thesis .
 qed
 
 lemma lemma_termdiff3:
   fixes h z :: "'a::real_normed_field"
   assumes 1: "h \<noteq> 0"
     and 2: "norm z \<le> K"
     and 3: "norm (z + h) \<le> K"
   shows "norm (((z + h) ^ n - z ^ n) / h - of_nat n * z ^ (n - Suc 0)) \<le>
     of_nat n * of_nat (n - Suc 0) * K ^ (n - 2) * norm h"
 proof -
   have "norm (((z + h) ^ n - z ^ n) / h - of_nat n * z ^ (n - Suc 0)) =
     norm (\<Sum>p<n - Suc 0. \<Sum>q<n - Suc 0 - p. (z + h) ^ q * z ^ (n - 2 - q)) * norm h"
     by (metis (lifting, no_types) lemma_termdiff2 [OF 1] mult.commute norm_mult)
   also have "\<dots> \<le> of_nat n * (of_nat (n - Suc 0) * K ^ (n - 2)) * norm h"
   proof (rule mult_right_mono [OF _ norm_ge_zero])
     from norm_ge_zero 2 have K: "0 \<le> K"
       by (rule order_trans)
     have le_Kn: "norm ((z + h) ^ i * z ^ j) \<le> K ^ n" if "i + j = n" for i j n
     proof -
       have "norm (z + h) ^ i * norm z ^ j \<le> K ^ i * K ^ j"
         by (intro mult_mono power_mono 2 3 norm_ge_zero zero_le_power K)
       also have "... = K^n"
         by (metis power_add that)
       finally show ?thesis
         by (simp add: norm_mult norm_power) 
     qed
     then have "\<And>p q.
        \<lbrakk>p < n; q < n - Suc 0\<rbrakk> \<Longrightarrow> norm ((z + h) ^ q * z ^ (n - 2 - q)) \<le> K ^ (n - 2)"
       by (simp del: subst_all)
     then
     show "norm (\<Sum>p<n - Suc 0. \<Sum>q<n - Suc 0 - p. (z + h) ^ q * z ^ (n - 2 - q)) \<le>
         of_nat n * (of_nat (n - Suc 0) * K ^ (n - 2))"
       by (intro order_trans [OF norm_sum]
           real_sum_nat_ivl_bounded2 mult_nonneg_nonneg of_nat_0_le_iff zero_le_power K)
   qed
   also have "\<dots> = of_nat n * of_nat (n - Suc 0) * K ^ (n - 2) * norm h"
     by (simp only: mult.assoc)
   finally show ?thesis .
 qed
 
 lemma lemma_termdiff4:
   fixes f :: "'a::real_normed_vector \<Rightarrow> 'b::real_normed_vector"
     and k :: real
   assumes k: "0 < k"
     and le: "\<And>h. h \<noteq> 0 \<Longrightarrow> norm h < k \<Longrightarrow> norm (f h) \<le> K * norm h"
   shows "f \<midarrow>0\<rightarrow> 0"
 proof (rule tendsto_norm_zero_cancel)
   show "(\<lambda>h. norm (f h)) \<midarrow>0\<rightarrow> 0"
   proof (rule real_tendsto_sandwich)
     show "eventually (\<lambda>h. 0 \<le> norm (f h)) (at 0)"
       by simp
     show "eventually (\<lambda>h. norm (f h) \<le> K * norm h) (at 0)"
       using k by (auto simp: eventually_at dist_norm le)
     show "(\<lambda>h. 0) \<midarrow>(0::'a)\<rightarrow> (0::real)"
       by (rule tendsto_const)
     have "(\<lambda>h. K * norm h) \<midarrow>(0::'a)\<rightarrow> K * norm (0::'a)"
       by (intro tendsto_intros)
     then show "(\<lambda>h. K * norm h) \<midarrow>(0::'a)\<rightarrow> 0"
       by simp
   qed
 qed
 
 lemma lemma_termdiff5:
   fixes g :: "'a::real_normed_vector \<Rightarrow> nat \<Rightarrow> 'b::banach"
     and k :: real
   assumes k: "0 < k"
     and f: "summable f"
     and le: "\<And>h n. h \<noteq> 0 \<Longrightarrow> norm h < k \<Longrightarrow> norm (g h n) \<le> f n * norm h"
   shows "(\<lambda>h. suminf (g h)) \<midarrow>0\<rightarrow> 0"
 proof (rule lemma_termdiff4 [OF k])
   fix h :: 'a
   assume "h \<noteq> 0" and "norm h < k"
   then have 1: "\<forall>n. norm (g h n) \<le> f n * norm h"
     by (simp add: le)
   then have "\<exists>N. \<forall>n\<ge>N. norm (norm (g h n)) \<le> f n * norm h"
     by simp
   moreover from f have 2: "summable (\<lambda>n. f n * norm h)"
     by (rule summable_mult2)
   ultimately have 3: "summable (\<lambda>n. norm (g h n))"
     by (rule summable_comparison_test)
   then have "norm (suminf (g h)) \<le> (\<Sum>n. norm (g h n))"
     by (rule summable_norm)
   also from 1 3 2 have "(\<Sum>n. norm (g h n)) \<le> (\<Sum>n. f n * norm h)"
     by (simp add: suminf_le)
   also from f have "(\<Sum>n. f n * norm h) = suminf f * norm h"
     by (rule suminf_mult2 [symmetric])
   finally show "norm (suminf (g h)) \<le> suminf f * norm h" .
 qed
 
 
 (* FIXME: Long proofs *)
 
 lemma termdiffs_aux:
   fixes x :: "'a::{real_normed_field,banach}"
   assumes 1: "summable (\<lambda>n. diffs (diffs c) n * K ^ n)"
     and 2: "norm x < norm K"
   shows "(\<lambda>h. \<Sum>n. c n * (((x + h) ^ n - x^n) / h - of_nat n * x ^ (n - Suc 0))) \<midarrow>0\<rightarrow> 0"
 proof -
   from dense [OF 2] obtain r where r1: "norm x < r" and r2: "r < norm K"
     by fast
   from norm_ge_zero r1 have r: "0 < r"
     by (rule order_le_less_trans)
   then have r_neq_0: "r \<noteq> 0" by simp
   show ?thesis
   proof (rule lemma_termdiff5)
     show "0 < r - norm x"
       using r1 by simp
     from r r2 have "norm (of_real r::'a) < norm K"
       by simp
     with 1 have "summable (\<lambda>n. norm (diffs (diffs c) n * (of_real r ^ n)))"
       by (rule powser_insidea)
     then have "summable (\<lambda>n. diffs (diffs (\<lambda>n. norm (c n))) n * r ^ n)"
       using r by (simp add: diffs_def norm_mult norm_power del: of_nat_Suc)
     then have "summable (\<lambda>n. of_nat n * diffs (\<lambda>n. norm (c n)) n * r ^ (n - Suc 0))"
       by (rule diffs_equiv [THEN sums_summable])
     also have "(\<lambda>n. of_nat n * diffs (\<lambda>n. norm (c n)) n * r ^ (n - Suc 0)) =
                (\<lambda>n. diffs (\<lambda>m. of_nat (m - Suc 0) * norm (c m) * inverse r) n * (r ^ n))"
       by (simp add: diffs_def r_neq_0 fun_eq_iff split: nat_diff_split)
     finally have "summable
       (\<lambda>n. of_nat n * (of_nat (n - Suc 0) * norm (c n) * inverse r) * r ^ (n - Suc 0))"
       by (rule diffs_equiv [THEN sums_summable])
     also have
       "(\<lambda>n. of_nat n * (of_nat (n - Suc 0) * norm (c n) * inverse r) * r ^ (n - Suc 0)) =
        (\<lambda>n. norm (c n) * of_nat n * of_nat (n - Suc 0) * r ^ (n - 2))"
       by (rule ext) (simp add: r_neq_0 split: nat_diff_split)
     finally show "summable (\<lambda>n. norm (c n) * of_nat n * of_nat (n - Suc 0) * r ^ (n - 2))" .
   next
     fix h :: 'a and n
     assume h: "h \<noteq> 0"
     assume "norm h < r - norm x"
     then have "norm x + norm h < r" by simp
     with norm_triangle_ineq 
     have xh: "norm (x + h) < r"
       by (rule order_le_less_trans)
     have "norm (((x + h) ^ n - x ^ n) / h - of_nat n * x ^ (n - Suc 0))
     \<le> real n * (real (n - Suc 0) * (r ^ (n - 2) * norm h))"
       by (metis (mono_tags, lifting) h mult.assoc lemma_termdiff3 less_eq_real_def r1 xh)
     then show "norm (c n * (((x + h) ^ n - x^n) / h - of_nat n * x ^ (n - Suc 0))) \<le>
       norm (c n) * of_nat n * of_nat (n - Suc 0) * r ^ (n - 2) * norm h"
       by (simp only: norm_mult mult.assoc mult_left_mono [OF _ norm_ge_zero])
   qed
 qed
 
 lemma termdiffs:
   fixes K x :: "'a::{real_normed_field,banach}"
   assumes 1: "summable (\<lambda>n. c n * K ^ n)"
     and 2: "summable (\<lambda>n. (diffs c) n * K ^ n)"
     and 3: "summable (\<lambda>n. (diffs (diffs c)) n * K ^ n)"
     and 4: "norm x < norm K"
   shows "DERIV (\<lambda>x. \<Sum>n. c n * x^n) x :> (\<Sum>n. (diffs c) n * x^n)"
   unfolding DERIV_def
 proof (rule LIM_zero_cancel)
   show "(\<lambda>h. (suminf (\<lambda>n. c n * (x + h) ^ n) - suminf (\<lambda>n. c n * x^n)) / h
             - suminf (\<lambda>n. diffs c n * x^n)) \<midarrow>0\<rightarrow> 0"
   proof (rule LIM_equal2)
     show "0 < norm K - norm x"
       using 4 by (simp add: less_diff_eq)
   next
     fix h :: 'a
     assume "norm (h - 0) < norm K - norm x"
     then have "norm x + norm h < norm K" by simp
     then have 5: "norm (x + h) < norm K"
       by (rule norm_triangle_ineq [THEN order_le_less_trans])
     have "summable (\<lambda>n. c n * x^n)"
       and "summable (\<lambda>n. c n * (x + h) ^ n)"
       and "summable (\<lambda>n. diffs c n * x^n)"
       using 1 2 4 5 by (auto elim: powser_inside)
     then have "((\<Sum>n. c n * (x + h) ^ n) - (\<Sum>n. c n * x^n)) / h - (\<Sum>n. diffs c n * x^n) =
           (\<Sum>n. (c n * (x + h) ^ n - c n * x^n) / h - of_nat n * c n * x ^ (n - Suc 0))"
       by (intro sums_unique sums_diff sums_divide diffs_equiv summable_sums)
     then show "((\<Sum>n. c n * (x + h) ^ n) - (\<Sum>n. c n * x^n)) / h - (\<Sum>n. diffs c n * x^n) =
           (\<Sum>n. c n * (((x + h) ^ n - x^n) / h - of_nat n * x ^ (n - Suc 0)))"
       by (simp add: algebra_simps)
   next
     show "(\<lambda>h. \<Sum>n. c n * (((x + h) ^ n - x^n) / h - of_nat n * x ^ (n - Suc 0))) \<midarrow>0\<rightarrow> 0"
       by (rule termdiffs_aux [OF 3 4])
   qed
 qed
 
 subsection \<open>The Derivative of a Power Series Has the Same Radius of Convergence\<close>
 
 lemma termdiff_converges:
   fixes x :: "'a::{real_normed_field,banach}"
   assumes K: "norm x < K"
     and sm: "\<And>x. norm x < K \<Longrightarrow> summable(\<lambda>n. c n * x ^ n)"
   shows "summable (\<lambda>n. diffs c n * x ^ n)"
 proof (cases "x = 0")
   case True
   then show ?thesis
     using powser_sums_zero sums_summable by auto
 next
   case False
   then have "K > 0"
     using K less_trans zero_less_norm_iff by blast
   then obtain r :: real where r: "norm x < norm r" "norm r < K" "r > 0"
     using K False
     by (auto simp: field_simps abs_less_iff add_pos_pos intro: that [of "(norm x + K) / 2"])
   have to0: "(\<lambda>n. of_nat n * (x / of_real r) ^ n) \<longlonglongrightarrow> 0"
     using r by (simp add: norm_divide powser_times_n_limit_0 [of "x / of_real r"])
   obtain N where N: "\<And>n. n\<ge>N \<Longrightarrow> real_of_nat n * norm x ^ n < r ^ n"
     using r LIMSEQ_D [OF to0, of 1]
     by (auto simp: norm_divide norm_mult norm_power field_simps)
   have "summable (\<lambda>n. (of_nat n * c n) * x ^ n)"
   proof (rule summable_comparison_test')
     show "summable (\<lambda>n. norm (c n * of_real r ^ n))"
       apply (rule powser_insidea [OF sm [of "of_real ((r+K)/2)"]])
       using N r norm_of_real [of "r + K", where 'a = 'a] by auto
     show "\<And>n. N \<le> n \<Longrightarrow> norm (of_nat n * c n * x ^ n) \<le> norm (c n * of_real r ^ n)"
       using N r by (fastforce simp add: norm_mult norm_power less_eq_real_def)
   qed
   then have "summable (\<lambda>n. (of_nat (Suc n) * c(Suc n)) * x ^ Suc n)"
     using summable_iff_shift [of "\<lambda>n. of_nat n * c n * x ^ n" 1]
     by simp
   then have "summable (\<lambda>n. (of_nat (Suc n) * c(Suc n)) * x ^ n)"
     using False summable_mult2 [of "\<lambda>n. (of_nat (Suc n) * c(Suc n) * x ^ n) * x" "inverse x"]
     by (simp add: mult.assoc) (auto simp: ac_simps)
   then show ?thesis
     by (simp add: diffs_def)
 qed
 
 lemma termdiff_converges_all:
   fixes x :: "'a::{real_normed_field,banach}"
   assumes "\<And>x. summable (\<lambda>n. c n * x^n)"
   shows "summable (\<lambda>n. diffs c n * x^n)"
   by (rule termdiff_converges [where K = "1 + norm x"]) (use assms in auto)
 
 lemma termdiffs_strong:
   fixes K x :: "'a::{real_normed_field,banach}"
   assumes sm: "summable (\<lambda>n. c n * K ^ n)"
     and K: "norm x < norm K"
   shows "DERIV (\<lambda>x. \<Sum>n. c n * x^n) x :> (\<Sum>n. diffs c n * x^n)"
 proof -
   have "norm K + norm x < norm K + norm K"
     using K by force
   then have K2: "norm ((of_real (norm K) + of_real (norm x)) / 2 :: 'a) < norm K"
     by (auto simp: norm_triangle_lt norm_divide field_simps)
   then have [simp]: "norm ((of_real (norm K) + of_real (norm x)) :: 'a) < norm K * 2"
     by simp
   have "summable (\<lambda>n. c n * (of_real (norm x + norm K) / 2) ^ n)"
     by (metis K2 summable_norm_cancel [OF powser_insidea [OF sm]] add.commute of_real_add)
   moreover have "\<And>x. norm x < norm K \<Longrightarrow> summable (\<lambda>n. diffs c n * x ^ n)"
     by (blast intro: sm termdiff_converges powser_inside)
   moreover have "\<And>x. norm x < norm K \<Longrightarrow> summable (\<lambda>n. diffs(diffs c) n * x ^ n)"
     by (blast intro: sm termdiff_converges powser_inside)
   ultimately show ?thesis
     by (rule termdiffs [where K = "of_real (norm x + norm K) / 2"])
        (use K in \<open>auto simp: field_simps simp flip: of_real_add\<close>)
 qed
 
 lemma termdiffs_strong_converges_everywhere:
   fixes K x :: "'a::{real_normed_field,banach}"
   assumes "\<And>y. summable (\<lambda>n. c n * y ^ n)"
   shows "((\<lambda>x. \<Sum>n. c n * x^n) has_field_derivative (\<Sum>n. diffs c n * x^n)) (at x)"
   using termdiffs_strong[OF assms[of "of_real (norm x + 1)"], of x]
   by (force simp del: of_real_add)
 
 lemma termdiffs_strong':
   fixes z :: "'a :: {real_normed_field,banach}"
   assumes "\<And>z. norm z < K \<Longrightarrow> summable (\<lambda>n. c n * z ^ n)"
   assumes "norm z < K"
   shows   "((\<lambda>z. \<Sum>n. c n * z^n) has_field_derivative (\<Sum>n. diffs c n * z^n)) (at z)"
 proof (rule termdiffs_strong)
   define L :: real where "L =  (norm z + K) / 2"
   have "0 \<le> norm z" by simp
   also note \<open>norm z < K\<close>
   finally have K: "K \<ge> 0" by simp
   from assms K have L: "L \<ge> 0" "norm z < L" "L < K" by (simp_all add: L_def)
   from L show "norm z < norm (of_real L :: 'a)" by simp
   from L show "summable (\<lambda>n. c n * of_real L ^ n)" by (intro assms(1)) simp_all
 qed
 
 lemma termdiffs_sums_strong:
   fixes z :: "'a :: {banach,real_normed_field}"
   assumes sums: "\<And>z. norm z < K \<Longrightarrow> (\<lambda>n. c n * z ^ n) sums f z"
   assumes deriv: "(f has_field_derivative f') (at z)"
   assumes norm: "norm z < K"
   shows   "(\<lambda>n. diffs c n * z ^ n) sums f'"
 proof -
   have summable: "summable (\<lambda>n. diffs c n * z^n)"
     by (intro termdiff_converges[OF norm] sums_summable[OF sums])
   from norm have "eventually (\<lambda>z. z \<in> norm -` {..<K}) (nhds z)"
     by (intro eventually_nhds_in_open open_vimage)
        (simp_all add: continuous_on_norm)
   hence eq: "eventually (\<lambda>z. (\<Sum>n. c n * z^n) = f z) (nhds z)"
     by eventually_elim (insert sums, simp add: sums_iff)
 
   have "((\<lambda>z. \<Sum>n. c n * z^n) has_field_derivative (\<Sum>n. diffs c n * z^n)) (at z)"
     by (intro termdiffs_strong'[OF _ norm] sums_summable[OF sums])
   hence "(f has_field_derivative (\<Sum>n. diffs c n * z^n)) (at z)"
     by (subst (asm) DERIV_cong_ev[OF refl eq refl])
   from this and deriv have "(\<Sum>n. diffs c n * z^n) = f'" by (rule DERIV_unique)
   with summable show ?thesis by (simp add: sums_iff)
 qed
 
 lemma isCont_powser:
   fixes K x :: "'a::{real_normed_field,banach}"
   assumes "summable (\<lambda>n. c n * K ^ n)"
   assumes "norm x < norm K"
   shows "isCont (\<lambda>x. \<Sum>n. c n * x^n) x"
   using termdiffs_strong[OF assms] by (blast intro!: DERIV_isCont)
 
 lemmas isCont_powser' = isCont_o2[OF _ isCont_powser]
 
 lemma isCont_powser_converges_everywhere:
   fixes K x :: "'a::{real_normed_field,banach}"
   assumes "\<And>y. summable (\<lambda>n. c n * y ^ n)"
   shows "isCont (\<lambda>x. \<Sum>n. c n * x^n) x"
   using termdiffs_strong[OF assms[of "of_real (norm x + 1)"], of x]
   by (force intro!: DERIV_isCont simp del: of_real_add)
 
 lemma powser_limit_0:
   fixes a :: "nat \<Rightarrow> 'a::{real_normed_field,banach}"
   assumes s: "0 < s"
     and sm: "\<And>x. norm x < s \<Longrightarrow> (\<lambda>n. a n * x ^ n) sums (f x)"
   shows "(f \<longlongrightarrow> a 0) (at 0)"
 proof -
   have "norm (of_real s / 2 :: 'a) < s"
     using s  by (auto simp: norm_divide)
   then have "summable (\<lambda>n. a n * (of_real s / 2) ^ n)"
     by (rule sums_summable [OF sm])
   then have "((\<lambda>x. \<Sum>n. a n * x ^ n) has_field_derivative (\<Sum>n. diffs a n * 0 ^ n)) (at 0)"
     by (rule termdiffs_strong) (use s in \<open>auto simp: norm_divide\<close>)
   then have "isCont (\<lambda>x. \<Sum>n. a n * x ^ n) 0"
     by (blast intro: DERIV_continuous)
   then have "((\<lambda>x. \<Sum>n. a n * x ^ n) \<longlongrightarrow> a 0) (at 0)"
     by (simp add: continuous_within)
   moreover have "(\<lambda>x. f x - (\<Sum>n. a n * x ^ n)) \<midarrow>0\<rightarrow> 0"
     apply (clarsimp simp: LIM_eq)
     apply (rule_tac x=s in exI)
     using s sm sums_unique by fastforce
   ultimately show ?thesis
     by (rule Lim_transform)
 qed
 
 lemma powser_limit_0_strong:
   fixes a :: "nat \<Rightarrow> 'a::{real_normed_field,banach}"
   assumes s: "0 < s"
     and sm: "\<And>x. x \<noteq> 0 \<Longrightarrow> norm x < s \<Longrightarrow> (\<lambda>n. a n * x ^ n) sums (f x)"
   shows "(f \<longlongrightarrow> a 0) (at 0)"
 proof -
   have *: "((\<lambda>x. if x = 0 then a 0 else f x) \<longlongrightarrow> a 0) (at 0)"
     by (rule powser_limit_0 [OF s]) (auto simp: powser_sums_zero sm)
   show ?thesis
     using "*" by (auto cong: Lim_cong_within)
 qed
 
 
 subsection \<open>Derivability of power series\<close>
 
 lemma DERIV_series':
   fixes f :: "real \<Rightarrow> nat \<Rightarrow> real"
   assumes DERIV_f: "\<And> n. DERIV (\<lambda> x. f x n) x0 :> (f' x0 n)"
     and allf_summable: "\<And> x. x \<in> {a <..< b} \<Longrightarrow> summable (f x)"
     and x0_in_I: "x0 \<in> {a <..< b}"
     and "summable (f' x0)"
     and "summable L"
     and L_def: "\<And>n x y. x \<in> {a <..< b} \<Longrightarrow> y \<in> {a <..< b} \<Longrightarrow> \<bar>f x n - f y n\<bar> \<le> L n * \<bar>x - y\<bar>"
   shows "DERIV (\<lambda> x. suminf (f x)) x0 :> (suminf (f' x0))"
   unfolding DERIV_def
 proof (rule LIM_I)
   fix r :: real
   assume "0 < r" then have "0 < r/3" by auto
 
   obtain N_L where N_L: "\<And> n. N_L \<le> n \<Longrightarrow> \<bar> \<Sum> i. L (i + n) \<bar> < r/3"
     using suminf_exist_split[OF \<open>0 < r/3\<close> \<open>summable L\<close>] by auto
 
   obtain N_f' where N_f': "\<And> n. N_f' \<le> n \<Longrightarrow> \<bar> \<Sum> i. f' x0 (i + n) \<bar> < r/3"
     using suminf_exist_split[OF \<open>0 < r/3\<close> \<open>summable (f' x0)\<close>] by auto
 
   let ?N = "Suc (max N_L N_f')"
   have "\<bar> \<Sum> i. f' x0 (i + ?N) \<bar> < r/3" (is "?f'_part < r/3")
     and L_estimate: "\<bar> \<Sum> i. L (i + ?N) \<bar> < r/3"
     using N_L[of "?N"] and N_f' [of "?N"] by auto
 
   let ?diff = "\<lambda>i x. (f (x0 + x) i - f x0 i) / x"
 
   let ?r = "r / (3 * real ?N)"
   from \<open>0 < r\<close> have "0 < ?r" by simp
 
   let ?s = "\<lambda>n. SOME s. 0 < s \<and> (\<forall> x. x \<noteq> 0 \<and> \<bar> x \<bar> < s \<longrightarrow> \<bar> ?diff n x - f' x0 n \<bar> < ?r)"
   define S' where "S' = Min (?s ` {..< ?N })"
 
   have "0 < S'"
     unfolding S'_def
   proof (rule iffD2[OF Min_gr_iff])
     show "\<forall>x \<in> (?s ` {..< ?N }). 0 < x"
     proof
       fix x
       assume "x \<in> ?s ` {..<?N}"
       then obtain n where "x = ?s n" and "n \<in> {..<?N}"
         using image_iff[THEN iffD1] by blast
       from DERIV_D[OF DERIV_f[where n=n], THEN LIM_D, OF \<open>0 < ?r\<close>, unfolded real_norm_def]
       obtain s where s_bound: "0 < s \<and> (\<forall>x. x \<noteq> 0 \<and> \<bar>x\<bar> < s \<longrightarrow> \<bar>?diff n x - f' x0 n\<bar> < ?r)"
         by auto
       have "0 < ?s n"
         by (rule someI2[where a=s]) (auto simp: s_bound simp del: of_nat_Suc)
       then show "0 < x" by (simp only: \<open>x = ?s n\<close>)
     qed
   qed auto
 
   define S where "S = min (min (x0 - a) (b - x0)) S'"
   then have "0 < S" and S_a: "S \<le> x0 - a" and S_b: "S \<le> b - x0"
     and "S \<le> S'" using x0_in_I and \<open>0 < S'\<close>
     by auto
 
   have "\<bar>(suminf (f (x0 + x)) - suminf (f x0)) / x - suminf (f' x0)\<bar> < r"
     if "x \<noteq> 0" and "\<bar>x\<bar> < S" for x
   proof -
     from that have x_in_I: "x0 + x \<in> {a <..< b}"
       using S_a S_b by auto
 
     note diff_smbl = summable_diff[OF allf_summable[OF x_in_I] allf_summable[OF x0_in_I]]
     note div_smbl = summable_divide[OF diff_smbl]
     note all_smbl = summable_diff[OF div_smbl \<open>summable (f' x0)\<close>]
     note ign = summable_ignore_initial_segment[where k="?N"]
     note diff_shft_smbl = summable_diff[OF ign[OF allf_summable[OF x_in_I]] ign[OF allf_summable[OF x0_in_I]]]
     note div_shft_smbl = summable_divide[OF diff_shft_smbl]
     note all_shft_smbl = summable_diff[OF div_smbl ign[OF \<open>summable (f' x0)\<close>]]
 
     have 1: "\<bar>(\<bar>?diff (n + ?N) x\<bar>)\<bar> \<le> L (n + ?N)" for n
     proof -
       have "\<bar>?diff (n + ?N) x\<bar> \<le> L (n + ?N) * \<bar>(x0 + x) - x0\<bar> / \<bar>x\<bar>"
         using divide_right_mono[OF L_def[OF x_in_I x0_in_I] abs_ge_zero]
         by (simp only: abs_divide)
       with \<open>x \<noteq> 0\<close> show ?thesis by auto
     qed
     note 2 = summable_rabs_comparison_test[OF _ ign[OF \<open>summable L\<close>]]
     from 1 have "\<bar> \<Sum> i. ?diff (i + ?N) x \<bar> \<le> (\<Sum> i. L (i + ?N))"
       by (metis (lifting) abs_idempotent
           order_trans[OF summable_rabs[OF 2] suminf_le[OF _ 2 ign[OF \<open>summable L\<close>]]])
     then have "\<bar>\<Sum>i. ?diff (i + ?N) x\<bar> \<le> r / 3" (is "?L_part \<le> r/3")
       using L_estimate by auto
 
     have "\<bar>\<Sum>n<?N. ?diff n x - f' x0 n\<bar> \<le> (\<Sum>n<?N. \<bar>?diff n x - f' x0 n\<bar>)" ..
     also have "\<dots> < (\<Sum>n<?N. ?r)"
     proof (rule sum_strict_mono)
       fix n
       assume "n \<in> {..< ?N}"
       have "\<bar>x\<bar> < S" using \<open>\<bar>x\<bar> < S\<close> .
       also have "S \<le> S'" using \<open>S \<le> S'\<close> .
       also have "S' \<le> ?s n"
         unfolding S'_def
       proof (rule Min_le_iff[THEN iffD2])
         have "?s n \<in> (?s ` {..<?N}) \<and> ?s n \<le> ?s n"
           using \<open>n \<in> {..< ?N}\<close> by auto
         then show "\<exists> a \<in> (?s ` {..<?N}). a \<le> ?s n"
           by blast
       qed auto
       finally have "\<bar>x\<bar> < ?s n" .
 
       from DERIV_D[OF DERIV_f[where n=n], THEN LIM_D, OF \<open>0 < ?r\<close>,
           unfolded real_norm_def diff_0_right, unfolded some_eq_ex[symmetric], THEN conjunct2]
       have "\<forall>x. x \<noteq> 0 \<and> \<bar>x\<bar> < ?s n \<longrightarrow> \<bar>?diff n x - f' x0 n\<bar> < ?r" .
       with \<open>x \<noteq> 0\<close> and \<open>\<bar>x\<bar> < ?s n\<close> show "\<bar>?diff n x - f' x0 n\<bar> < ?r"
         by blast
     qed auto
     also have "\<dots> = of_nat (card {..<?N}) * ?r"
       by (rule sum_constant)
     also have "\<dots> = real ?N * ?r"
       by simp
     also have "\<dots> = r/3"
       by (auto simp del: of_nat_Suc)
     finally have "\<bar>\<Sum>n<?N. ?diff n x - f' x0 n \<bar> < r / 3" (is "?diff_part < r / 3") .
 
     from suminf_diff[OF allf_summable[OF x_in_I] allf_summable[OF x0_in_I]]
     have "\<bar>(suminf (f (x0 + x)) - (suminf (f x0))) / x - suminf (f' x0)\<bar> =
         \<bar>\<Sum>n. ?diff n x - f' x0 n\<bar>"
       unfolding suminf_diff[OF div_smbl \<open>summable (f' x0)\<close>, symmetric]
       using suminf_divide[OF diff_smbl, symmetric] by auto
     also have "\<dots> \<le> ?diff_part + \<bar>(\<Sum>n. ?diff (n + ?N) x) - (\<Sum> n. f' x0 (n + ?N))\<bar>"
       unfolding suminf_split_initial_segment[OF all_smbl, where k="?N"]
       unfolding suminf_diff[OF div_shft_smbl ign[OF \<open>summable (f' x0)\<close>]]
       apply (simp only: add.commute)
       using abs_triangle_ineq by blast
     also have "\<dots> \<le> ?diff_part + ?L_part + ?f'_part"
       using abs_triangle_ineq4 by auto
     also have "\<dots> < r /3 + r/3 + r/3"
       using \<open>?diff_part < r/3\<close> \<open>?L_part \<le> r/3\<close> and \<open>?f'_part < r/3\<close>
       by (rule add_strict_mono [OF add_less_le_mono])
     finally show ?thesis
       by auto
   qed
   then show "\<exists>s > 0. \<forall> x. x \<noteq> 0 \<and> norm (x - 0) < s \<longrightarrow>
       norm (((\<Sum>n. f (x0 + x) n) - (\<Sum>n. f x0 n)) / x - (\<Sum>n. f' x0 n)) < r"
     using \<open>0 < S\<close> by auto
 qed
 
 lemma DERIV_power_series':
   fixes f :: "nat \<Rightarrow> real"
   assumes converges: "\<And>x. x \<in> {-R <..< R} \<Longrightarrow> summable (\<lambda>n. f n * real (Suc n) * x^n)"
     and x0_in_I: "x0 \<in> {-R <..< R}"
     and "0 < R"
   shows "DERIV (\<lambda>x. (\<Sum>n. f n * x^(Suc n))) x0 :> (\<Sum>n. f n * real (Suc n) * x0^n)"
     (is "DERIV (\<lambda>x. suminf (?f x)) x0 :> suminf (?f' x0)")
 proof -
   have for_subinterval: "DERIV (\<lambda>x. suminf (?f x)) x0 :> suminf (?f' x0)"
     if "0 < R'" and "R' < R" and "-R' < x0" and "x0 < R'" for R'
   proof -
     from that have "x0 \<in> {-R' <..< R'}" and "R' \<in> {-R <..< R}" and "x0 \<in> {-R <..< R}"
       by auto
     show ?thesis
     proof (rule DERIV_series')
       show "summable (\<lambda> n. \<bar>f n * real (Suc n) * R'^n\<bar>)"
       proof -
         have "(R' + R) / 2 < R" and "0 < (R' + R) / 2"
           using \<open>0 < R'\<close> \<open>0 < R\<close> \<open>R' < R\<close> by (auto simp: field_simps)
         then have in_Rball: "(R' + R) / 2 \<in> {-R <..< R}"
           using \<open>R' < R\<close> by auto
         have "norm R' < norm ((R' + R) / 2)"
           using \<open>0 < R'\<close> \<open>0 < R\<close> \<open>R' < R\<close> by (auto simp: field_simps)
         from powser_insidea[OF converges[OF in_Rball] this] show ?thesis
           by auto
       qed
     next
       fix n x y
       assume "x \<in> {-R' <..< R'}" and "y \<in> {-R' <..< R'}"
       show "\<bar>?f x n - ?f y n\<bar> \<le> \<bar>f n * real (Suc n) * R'^n\<bar> * \<bar>x-y\<bar>"
       proof -
         have "\<bar>f n * x ^ (Suc n) - f n * y ^ (Suc n)\<bar> =
           (\<bar>f n\<bar> * \<bar>x-y\<bar>) * \<bar>\<Sum>p<Suc n. x ^ p * y ^ (n - p)\<bar>"
           unfolding right_diff_distrib[symmetric] diff_power_eq_sum abs_mult
           by auto
         also have "\<dots> \<le> (\<bar>f n\<bar> * \<bar>x-y\<bar>) * (\<bar>real (Suc n)\<bar> * \<bar>R' ^ n\<bar>)"
         proof (rule mult_left_mono)
           have "\<bar>\<Sum>p<Suc n. x ^ p * y ^ (n - p)\<bar> \<le> (\<Sum>p<Suc n. \<bar>x ^ p * y ^ (n - p)\<bar>)"
             by (rule sum_abs)
           also have "\<dots> \<le> (\<Sum>p<Suc n. R' ^ n)"
           proof (rule sum_mono)
             fix p
             assume "p \<in> {..<Suc n}"
             then have "p \<le> n" by auto
             have "\<bar>x^n\<bar> \<le> R'^n" if  "x \<in> {-R'<..<R'}" for n and x :: real
             proof -
               from that have "\<bar>x\<bar> \<le> R'" by auto
               then show ?thesis
                 unfolding power_abs by (rule power_mono) auto
             qed
             from mult_mono[OF this[OF \<open>x \<in> {-R'<..<R'}\<close>, of p] this[OF \<open>y \<in> {-R'<..<R'}\<close>, of "n-p"]]
               and \<open>0 < R'\<close>
             have "\<bar>x^p * y^(n - p)\<bar> \<le> R'^p * R'^(n - p)"
               unfolding abs_mult by auto
             then show "\<bar>x^p * y^(n - p)\<bar> \<le> R'^n"
               unfolding power_add[symmetric] using \<open>p \<le> n\<close> by auto
           qed
           also have "\<dots> = real (Suc n) * R' ^ n"
             unfolding sum_constant card_atLeastLessThan by auto
           finally show "\<bar>\<Sum>p<Suc n. x ^ p * y ^ (n - p)\<bar> \<le> \<bar>real (Suc n)\<bar> * \<bar>R' ^ n\<bar>"
             unfolding abs_of_nonneg[OF zero_le_power[OF less_imp_le[OF \<open>0 < R'\<close>]]]
             by linarith
           show "0 \<le> \<bar>f n\<bar> * \<bar>x - y\<bar>"
             unfolding abs_mult[symmetric] by auto
         qed
         also have "\<dots> = \<bar>f n * real (Suc n) * R' ^ n\<bar> * \<bar>x - y\<bar>"
           unfolding abs_mult mult.assoc[symmetric] by algebra
         finally show ?thesis .
       qed
     next
       show "DERIV (\<lambda>x. ?f x n) x0 :> ?f' x0 n" for n
         by (auto intro!: derivative_eq_intros simp del: power_Suc)
     next
       fix x
       assume "x \<in> {-R' <..< R'}"
       then have "R' \<in> {-R <..< R}" and "norm x < norm R'"
         using assms \<open>R' < R\<close> by auto
       have "summable (\<lambda>n. f n * x^n)"
       proof (rule summable_comparison_test, intro exI allI impI)
         fix n
         have le: "\<bar>f n\<bar> * 1 \<le> \<bar>f n\<bar> * real (Suc n)"
           by (rule mult_left_mono) auto
         show "norm (f n * x^n) \<le> norm (f n * real (Suc n) * x^n)"
           unfolding real_norm_def abs_mult
           using le mult_right_mono by fastforce
       qed (rule powser_insidea[OF converges[OF \<open>R' \<in> {-R <..< R}\<close>] \<open>norm x < norm R'\<close>])
       from this[THEN summable_mult2[where c=x], simplified mult.assoc, simplified mult.commute]
       show "summable (?f x)" by auto
     next
       show "summable (?f' x0)"
         using converges[OF \<open>x0 \<in> {-R <..< R}\<close>] .
       show "x0 \<in> {-R' <..< R'}"
         using \<open>x0 \<in> {-R' <..< R'}\<close> .
     qed
   qed
   let ?R = "(R + \<bar>x0\<bar>) / 2"
   have "\<bar>x0\<bar> < ?R"
     using assms by (auto simp: field_simps)
   then have "- ?R < x0"
   proof (cases "x0 < 0")
     case True
     then have "- x0 < ?R"
       using \<open>\<bar>x0\<bar> < ?R\<close> by auto
     then show ?thesis
       unfolding neg_less_iff_less[symmetric, of "- x0"] by auto
   next
     case False
     have "- ?R < 0" using assms by auto
     also have "\<dots> \<le> x0" using False by auto
     finally show ?thesis .
   qed
   then have "0 < ?R" "?R < R" "- ?R < x0" and "x0 < ?R"
     using assms by (auto simp: field_simps)
   from for_subinterval[OF this] show ?thesis .
 qed
 
 lemma geometric_deriv_sums:
   fixes z :: "'a :: {real_normed_field,banach}"
   assumes "norm z < 1"
   shows   "(\<lambda>n. of_nat (Suc n) * z ^ n) sums (1 / (1 - z)^2)"
 proof -
   have "(\<lambda>n. diffs (\<lambda>n. 1) n * z^n) sums (1 / (1 - z)^2)"
   proof (rule termdiffs_sums_strong)
     fix z :: 'a assume "norm z < 1"
     thus "(\<lambda>n. 1 * z^n) sums (1 / (1 - z))" by (simp add: geometric_sums)
   qed (insert assms, auto intro!: derivative_eq_intros simp: power2_eq_square)
   thus ?thesis unfolding diffs_def by simp
 qed
 
 lemma isCont_pochhammer [continuous_intros]: "isCont (\<lambda>z. pochhammer z n) z"
   for z :: "'a::real_normed_field"
   by (induct n) (auto simp: pochhammer_rec')
 
 lemma continuous_on_pochhammer [continuous_intros]: "continuous_on A (\<lambda>z. pochhammer z n)"
   for A :: "'a::real_normed_field set"
   by (intro continuous_at_imp_continuous_on ballI isCont_pochhammer)
 
 lemmas continuous_on_pochhammer' [continuous_intros] =
   continuous_on_compose2[OF continuous_on_pochhammer _ subset_UNIV]
 
 
 subsection \<open>Exponential Function\<close>
 
 definition exp :: "'a \<Rightarrow> 'a::{real_normed_algebra_1,banach}"
   where "exp = (\<lambda>x. \<Sum>n. x^n /\<^sub>R fact n)"
 
 lemma summable_exp_generic:
   fixes x :: "'a::{real_normed_algebra_1,banach}"
   defines S_def: "S \<equiv> \<lambda>n. x^n /\<^sub>R fact n"
   shows "summable S"
 proof -
   have S_Suc: "\<And>n. S (Suc n) = (x * S n) /\<^sub>R (Suc n)"
     unfolding S_def by (simp del: mult_Suc)
   obtain r :: real where r0: "0 < r" and r1: "r < 1"
     using dense [OF zero_less_one] by fast
   obtain N :: nat where N: "norm x < real N * r"
     using ex_less_of_nat_mult r0 by auto
   from r1 show ?thesis
   proof (rule summable_ratio_test [rule_format])
     fix n :: nat
     assume n: "N \<le> n"
     have "norm x \<le> real N * r"
       using N by (rule order_less_imp_le)
     also have "real N * r \<le> real (Suc n) * r"
       using r0 n by (simp add: mult_right_mono)
     finally have "norm x * norm (S n) \<le> real (Suc n) * r * norm (S n)"
       using norm_ge_zero by (rule mult_right_mono)
     then have "norm (x * S n) \<le> real (Suc n) * r * norm (S n)"
       by (rule order_trans [OF norm_mult_ineq])
     then have "norm (x * S n) / real (Suc n) \<le> r * norm (S n)"
       by (simp add: pos_divide_le_eq ac_simps)
     then show "norm (S (Suc n)) \<le> r * norm (S n)"
       by (simp add: S_Suc inverse_eq_divide)
   qed
 qed
 
 lemma summable_norm_exp: "summable (\<lambda>n. norm (x^n /\<^sub>R fact n))"
   for x :: "'a::{real_normed_algebra_1,banach}"
 proof (rule summable_norm_comparison_test [OF exI, rule_format])
   show "summable (\<lambda>n. norm x^n /\<^sub>R fact n)"
     by (rule summable_exp_generic)
   show "norm (x^n /\<^sub>R fact n) \<le> norm x^n /\<^sub>R fact n" for n
     by (simp add: norm_power_ineq)
 qed
 
 lemma summable_exp: "summable (\<lambda>n. inverse (fact n) * x^n)"
   for x :: "'a::{real_normed_field,banach}"
   using summable_exp_generic [where x=x]
   by (simp add: scaleR_conv_of_real nonzero_of_real_inverse)
 
 lemma exp_converges: "(\<lambda>n. x^n /\<^sub>R fact n) sums exp x"
   unfolding exp_def by (rule summable_exp_generic [THEN summable_sums])
 
 lemma exp_fdiffs:
   "diffs (\<lambda>n. inverse (fact n)) = (\<lambda>n. inverse (fact n :: 'a::{real_normed_field,banach}))"
   by (simp add: diffs_def mult_ac nonzero_inverse_mult_distrib nonzero_of_real_inverse
       del: mult_Suc of_nat_Suc)
 
 lemma diffs_of_real: "diffs (\<lambda>n. of_real (f n)) = (\<lambda>n. of_real (diffs f n))"
   by (simp add: diffs_def)
 
 lemma DERIV_exp [simp]: "DERIV exp x :> exp x"
   unfolding exp_def scaleR_conv_of_real
 proof (rule DERIV_cong)
   have sinv: "summable (\<lambda>n. of_real (inverse (fact n)) * x ^ n)" for x::'a
     by (rule exp_converges [THEN sums_summable, unfolded scaleR_conv_of_real])
   note xx = exp_converges [THEN sums_summable, unfolded scaleR_conv_of_real]
   show "((\<lambda>x. \<Sum>n. of_real (inverse (fact n)) * x ^ n) has_field_derivative
         (\<Sum>n. diffs (\<lambda>n. of_real (inverse (fact n))) n * x ^ n))  (at x)"
     by (rule termdiffs [where K="of_real (1 + norm x)"]) (simp_all only: diffs_of_real exp_fdiffs sinv norm_of_real)
   show "(\<Sum>n. diffs (\<lambda>n. of_real (inverse (fact n))) n * x ^ n) = (\<Sum>n. of_real (inverse (fact n)) * x ^ n)"
     by (simp add: diffs_of_real exp_fdiffs)
 qed
 
 declare DERIV_exp[THEN DERIV_chain2, derivative_intros]
   and DERIV_exp[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]
 
 lemmas has_derivative_exp[derivative_intros] = DERIV_exp[THEN DERIV_compose_FDERIV]
 
 lemma norm_exp: "norm (exp x) \<le> exp (norm x)"
 proof -
   from summable_norm[OF summable_norm_exp, of x]
   have "norm (exp x) \<le> (\<Sum>n. inverse (fact n) * norm (x^n))"
     by (simp add: exp_def)
   also have "\<dots> \<le> exp (norm x)"
     using summable_exp_generic[of "norm x"] summable_norm_exp[of x]
     by (auto simp: exp_def intro!: suminf_le norm_power_ineq)
   finally show ?thesis .
 qed
 
 lemma isCont_exp: "isCont exp x"
   for x :: "'a::{real_normed_field,banach}"
   by (rule DERIV_exp [THEN DERIV_isCont])
 
 lemma isCont_exp' [simp]: "isCont f a \<Longrightarrow> isCont (\<lambda>x. exp (f x)) a"
   for f :: "_ \<Rightarrow>'a::{real_normed_field,banach}"
   by (rule isCont_o2 [OF _ isCont_exp])
 
 lemma tendsto_exp [tendsto_intros]: "(f \<longlongrightarrow> a) F \<Longrightarrow> ((\<lambda>x. exp (f x)) \<longlongrightarrow> exp a) F"
   for f:: "_ \<Rightarrow>'a::{real_normed_field,banach}"
   by (rule isCont_tendsto_compose [OF isCont_exp])
 
 lemma continuous_exp [continuous_intros]: "continuous F f \<Longrightarrow> continuous F (\<lambda>x. exp (f x))"
   for f :: "_ \<Rightarrow>'a::{real_normed_field,banach}"
   unfolding continuous_def by (rule tendsto_exp)
 
 lemma continuous_on_exp [continuous_intros]: "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. exp (f x))"
   for f :: "_ \<Rightarrow>'a::{real_normed_field,banach}"
   unfolding continuous_on_def by (auto intro: tendsto_exp)
 
 
 subsubsection \<open>Properties of the Exponential Function\<close>
 
 lemma exp_zero [simp]: "exp 0 = 1"
   unfolding exp_def by (simp add: scaleR_conv_of_real)
 
 lemma exp_series_add_commuting:
   fixes x y :: "'a::{real_normed_algebra_1,banach}"
   defines S_def: "S \<equiv> \<lambda>x n. x^n /\<^sub>R fact n"
   assumes comm: "x * y = y * x"
   shows "S (x + y) n = (\<Sum>i\<le>n. S x i * S y (n - i))"
 proof (induct n)
   case 0
   show ?case
     unfolding S_def by simp
 next
   case (Suc n)
   have S_Suc: "\<And>x n. S x (Suc n) = (x * S x n) /\<^sub>R real (Suc n)"
     unfolding S_def by (simp del: mult_Suc)
   then have times_S: "\<And>x n. x * S x n = real (Suc n) *\<^sub>R S x (Suc n)"
     by simp
   have S_comm: "\<And>n. S x n * y = y * S x n"
     by (simp add: power_commuting_commutes comm S_def)
 
   have "real (Suc n) *\<^sub>R S (x + y) (Suc n) = (x + y) * (\<Sum>i\<le>n. S x i * S y (n - i))"
     by (metis Suc.hyps times_S)
   also have "\<dots> = x * (\<Sum>i\<le>n. S x i * S y (n - i)) + y * (\<Sum>i\<le>n. S x i * S y (n - i))"
     by (rule distrib_right)
   also have "\<dots> = (\<Sum>i\<le>n. x * S x i * S y (n - i)) + (\<Sum>i\<le>n. S x i * y * S y (n - i))"
     by (simp add: sum_distrib_left ac_simps S_comm)
   also have "\<dots> = (\<Sum>i\<le>n. x * S x i * S y (n - i)) + (\<Sum>i\<le>n. S x i * (y * S y (n - i)))"
     by (simp add: ac_simps)
   also have "\<dots> = (\<Sum>i\<le>n. real (Suc i) *\<^sub>R (S x (Suc i) * S y (n - i))) 
                 + (\<Sum>i\<le>n. real (Suc n - i) *\<^sub>R (S x i * S y (Suc n - i)))"
     by (simp add: times_S Suc_diff_le)
   also have "(\<Sum>i\<le>n. real (Suc i) *\<^sub>R (S x (Suc i) * S y (n - i)))
            = (\<Sum>i\<le>Suc n. real i *\<^sub>R (S x i * S y (Suc n - i)))"
     by (subst sum.atMost_Suc_shift) simp
   also have "(\<Sum>i\<le>n. real (Suc n - i) *\<^sub>R (S x i * S y (Suc n - i)))
            = (\<Sum>i\<le>Suc n. real (Suc n - i) *\<^sub>R (S x i * S y (Suc n - i)))"
     by simp
   also have "(\<Sum>i\<le>Suc n. real i *\<^sub>R (S x i * S y (Suc n - i)))
            + (\<Sum>i\<le>Suc n. real (Suc n - i) *\<^sub>R (S x i * S y (Suc n - i))) 
            = (\<Sum>i\<le>Suc n. real (Suc n) *\<^sub>R (S x i * S y (Suc n - i)))"
     by (simp flip: sum.distrib scaleR_add_left of_nat_add) 
   also have "\<dots> = real (Suc n) *\<^sub>R (\<Sum>i\<le>Suc n. S x i * S y (Suc n - i))"
     by (simp only: scaleR_right.sum)
   finally show "S (x + y) (Suc n) = (\<Sum>i\<le>Suc n. S x i * S y (Suc n - i))"
     by (simp del: sum.cl_ivl_Suc)
 qed
 
 lemma exp_add_commuting: "x * y = y * x \<Longrightarrow> exp (x + y) = exp x * exp y"
   by (simp only: exp_def Cauchy_product summable_norm_exp exp_series_add_commuting)
 
 lemma exp_times_arg_commute: "exp A * A = A * exp A"
   by (simp add: exp_def suminf_mult[symmetric] summable_exp_generic power_commutes suminf_mult2)
 
 lemma exp_add: "exp (x + y) = exp x * exp y"
   for x y :: "'a::{real_normed_field,banach}"
   by (rule exp_add_commuting) (simp add: ac_simps)
 
 lemma exp_double: "exp(2 * z) = exp z ^ 2"
   by (simp add: exp_add_commuting mult_2 power2_eq_square)
 
 lemmas mult_exp_exp = exp_add [symmetric]
 
 lemma exp_of_real: "exp (of_real x) = of_real (exp x)"
   unfolding exp_def
   apply (subst suminf_of_real [OF summable_exp_generic])
   apply (simp add: scaleR_conv_of_real)
   done
 
 lemmas of_real_exp = exp_of_real[symmetric]
 
 corollary exp_in_Reals [simp]: "z \<in> \<real> \<Longrightarrow> exp z \<in> \<real>"
   by (metis Reals_cases Reals_of_real exp_of_real)
 
 lemma exp_not_eq_zero [simp]: "exp x \<noteq> 0"
 proof
   have "exp x * exp (- x) = 1"
     by (simp add: exp_add_commuting[symmetric])
   also assume "exp x = 0"
   finally show False by simp
 qed
 
 lemma exp_minus_inverse: "exp x * exp (- x) = 1"
   by (simp add: exp_add_commuting[symmetric])
 
 lemma exp_minus: "exp (- x) = inverse (exp x)"
   for x :: "'a::{real_normed_field,banach}"
   by (intro inverse_unique [symmetric] exp_minus_inverse)
 
 lemma exp_diff: "exp (x - y) = exp x / exp y"
   for x :: "'a::{real_normed_field,banach}"
   using exp_add [of x "- y"] by (simp add: exp_minus divide_inverse)
 
 lemma exp_of_nat_mult: "exp (of_nat n * x) = exp x ^ n"
   for x :: "'a::{real_normed_field,banach}"
   by (induct n) (auto simp: distrib_left exp_add mult.commute)
 
 corollary exp_of_nat2_mult: "exp (x * of_nat n) = exp x ^ n"
   for x :: "'a::{real_normed_field,banach}"
   by (metis exp_of_nat_mult mult_of_nat_commute)
 
 lemma exp_sum: "finite I \<Longrightarrow> exp (sum f I) = prod (\<lambda>x. exp (f x)) I"
   by (induct I rule: finite_induct) (auto simp: exp_add_commuting mult.commute)
 
 lemma exp_divide_power_eq:
   fixes x :: "'a::{real_normed_field,banach}"
   assumes "n > 0"
   shows "exp (x / of_nat n) ^ n = exp x"
   using assms
 proof (induction n arbitrary: x)
   case (Suc n)
   show ?case
   proof (cases "n = 0")
     case True
     then show ?thesis by simp
   next
     case False
     have [simp]: "1 + (of_nat n * of_nat n + of_nat n * 2) \<noteq> (0::'a)"
       using of_nat_eq_iff [of "1 + n * n + n * 2" "0"]
       by simp
     from False have [simp]: "x * of_nat n / (1 + of_nat n) / of_nat n = x / (1 + of_nat n)"
       by simp
     have [simp]: "x / (1 + of_nat n) + x * of_nat n / (1 + of_nat n) = x"
       using of_nat_neq_0
       by (auto simp add: field_split_simps)
     show ?thesis
       using Suc.IH [of "x * of_nat n / (1 + of_nat n)"] False
       by (simp add: exp_add [symmetric])
   qed
 qed simp
 
 
 subsubsection \<open>Properties of the Exponential Function on Reals\<close>
 
 text \<open>Comparisons of \<^term>\<open>exp x\<close> with zero.\<close>
 
 text \<open>Proof: because every exponential can be seen as a square.\<close>
 lemma exp_ge_zero [simp]: "0 \<le> exp x"
   for x :: real
 proof -
   have "0 \<le> exp (x/2) * exp (x/2)"
     by simp
   then show ?thesis
     by (simp add: exp_add [symmetric])
 qed
 
 lemma exp_gt_zero [simp]: "0 < exp x"
   for x :: real
   by (simp add: order_less_le)
 
 lemma not_exp_less_zero [simp]: "\<not> exp x < 0"
   for x :: real
   by (simp add: not_less)
 
 lemma not_exp_le_zero [simp]: "\<not> exp x \<le> 0"
   for x :: real
   by (simp add: not_le)
 
 lemma abs_exp_cancel [simp]: "\<bar>exp x\<bar> = exp x"
   for x :: real
   by simp
 
 text \<open>Strict monotonicity of exponential.\<close>
 
 lemma exp_ge_add_one_self_aux:
   fixes x :: real
   assumes "0 \<le> x"
   shows "1 + x \<le> exp x"
   using order_le_imp_less_or_eq [OF assms]
 proof
   assume "0 < x"
   have "1 + x \<le> (\<Sum>n<2. inverse (fact n) * x^n)"
     by (auto simp: numeral_2_eq_2)
   also have "\<dots> \<le> (\<Sum>n. inverse (fact n) * x^n)"
     using \<open>0 < x\<close> by (auto  simp add: zero_le_mult_iff intro: sum_le_suminf [OF summable_exp])
   finally show "1 + x \<le> exp x"
     by (simp add: exp_def)
 qed auto
 
 lemma exp_gt_one: "0 < x \<Longrightarrow> 1 < exp x"
   for x :: real
 proof -
   assume x: "0 < x"
   then have "1 < 1 + x" by simp
   also from x have "1 + x \<le> exp x"
     by (simp add: exp_ge_add_one_self_aux)
   finally show ?thesis .
 qed
 
 lemma exp_less_mono:
   fixes x y :: real
   assumes "x < y"
   shows "exp x < exp y"
 proof -
   from \<open>x < y\<close> have "0 < y - x" by simp
   then have "1 < exp (y - x)" by (rule exp_gt_one)
   then have "1 < exp y / exp x" by (simp only: exp_diff)
   then show "exp x < exp y" by simp
 qed
 
 lemma exp_less_cancel: "exp x < exp y \<Longrightarrow> x < y"
   for x y :: real
   unfolding linorder_not_le [symmetric]
   by (auto simp: order_le_less exp_less_mono)
 
 lemma exp_less_cancel_iff [iff]: "exp x < exp y \<longleftrightarrow> x < y"
   for x y :: real
   by (auto intro: exp_less_mono exp_less_cancel)
 
 lemma exp_le_cancel_iff [iff]: "exp x \<le> exp y \<longleftrightarrow> x \<le> y"
   for x y :: real
   by (auto simp: linorder_not_less [symmetric])
 
 lemma exp_inj_iff [iff]: "exp x = exp y \<longleftrightarrow> x = y"
   for x y :: real
   by (simp add: order_eq_iff)
 
 text \<open>Comparisons of \<^term>\<open>exp x\<close> with one.\<close>
 
 lemma one_less_exp_iff [simp]: "1 < exp x \<longleftrightarrow> 0 < x"
   for x :: real
   using exp_less_cancel_iff [where x = 0 and y = x] by simp
 
 lemma exp_less_one_iff [simp]: "exp x < 1 \<longleftrightarrow> x < 0"
   for x :: real
   using exp_less_cancel_iff [where x = x and y = 0] by simp
 
 lemma one_le_exp_iff [simp]: "1 \<le> exp x \<longleftrightarrow> 0 \<le> x"
   for x :: real
   using exp_le_cancel_iff [where x = 0 and y = x] by simp
 
 lemma exp_le_one_iff [simp]: "exp x \<le> 1 \<longleftrightarrow> x \<le> 0"
   for x :: real
   using exp_le_cancel_iff [where x = x and y = 0] by simp
 
 lemma exp_eq_one_iff [simp]: "exp x = 1 \<longleftrightarrow> x = 0"
   for x :: real
   using exp_inj_iff [where x = x and y = 0] by simp
 
 lemma lemma_exp_total: "1 \<le> y \<Longrightarrow> \<exists>x. 0 \<le> x \<and> x \<le> y - 1 \<and> exp x = y"
   for y :: real
 proof (rule IVT)
   assume "1 \<le> y"
   then have "0 \<le> y - 1" by simp
   then have "1 + (y - 1) \<le> exp (y - 1)"
     by (rule exp_ge_add_one_self_aux)
   then show "y \<le> exp (y - 1)" by simp
 qed (simp_all add: le_diff_eq)
 
 lemma exp_total: "0 < y \<Longrightarrow> \<exists>x. exp x = y"
   for y :: real
 proof (rule linorder_le_cases [of 1 y])
   assume "1 \<le> y"
   then show "\<exists>x. exp x = y"
     by (fast dest: lemma_exp_total)
 next
   assume "0 < y" and "y \<le> 1"
   then have "1 \<le> inverse y"
     by (simp add: one_le_inverse_iff)
   then obtain x where "exp x = inverse y"
     by (fast dest: lemma_exp_total)
   then have "exp (- x) = y"
     by (simp add: exp_minus)
   then show "\<exists>x. exp x = y" ..
 qed
 
 
 subsection \<open>Natural Logarithm\<close>
 
 class ln = real_normed_algebra_1 + banach +
   fixes ln :: "'a \<Rightarrow> 'a"
   assumes ln_one [simp]: "ln 1 = 0"
 
 definition powr :: "'a \<Rightarrow> 'a \<Rightarrow> 'a::ln"  (infixr "powr" 80)
   \<comment> \<open>exponentation via ln and exp\<close>
   where "x powr a \<equiv> if x = 0 then 0 else exp (a * ln x)"
 
 lemma powr_0 [simp]: "0 powr z = 0"
   by (simp add: powr_def)
 
 
 instantiation real :: ln
 begin
 
 definition ln_real :: "real \<Rightarrow> real"
   where "ln_real x = (THE u. exp u = x)"
 
 instance
   by intro_classes (simp add: ln_real_def)
 
 end
 
 lemma powr_eq_0_iff [simp]: "w powr z = 0 \<longleftrightarrow> w = 0"
   by (simp add: powr_def)
 
 lemma ln_exp [simp]: "ln (exp x) = x"
   for x :: real
   by (simp add: ln_real_def)
 
 lemma exp_ln [simp]: "0 < x \<Longrightarrow> exp (ln x) = x"
   for x :: real
   by (auto dest: exp_total)
 
 lemma exp_ln_iff [simp]: "exp (ln x) = x \<longleftrightarrow> 0 < x"
   for x :: real
   by (metis exp_gt_zero exp_ln)
 
 lemma ln_unique: "exp y = x \<Longrightarrow> ln x = y"
   for x :: real
   by (erule subst) (rule ln_exp)
 
 lemma ln_mult: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> ln (x * y) = ln x + ln y"
   for x :: real
   by (rule ln_unique) (simp add: exp_add)
 
 lemma ln_prod: "finite I \<Longrightarrow> (\<And>i. i \<in> I \<Longrightarrow> f i > 0) \<Longrightarrow> ln (prod f I) = sum (\<lambda>x. ln(f x)) I"
   for f :: "'a \<Rightarrow> real"
   by (induct I rule: finite_induct) (auto simp: ln_mult prod_pos)
 
 lemma ln_inverse: "0 < x \<Longrightarrow> ln (inverse x) = - ln x"
   for x :: real
   by (rule ln_unique) (simp add: exp_minus)
 
 lemma ln_div: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> ln (x / y) = ln x - ln y"
   for x :: real
   by (rule ln_unique) (simp add: exp_diff)
 
 lemma ln_realpow: "0 < x \<Longrightarrow> ln (x^n) = real n * ln x"
   by (rule ln_unique) (simp add: exp_of_nat_mult)
 
 lemma ln_less_cancel_iff [simp]: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> ln x < ln y \<longleftrightarrow> x < y"
   for x :: real
   by (subst exp_less_cancel_iff [symmetric]) simp
 
 lemma ln_le_cancel_iff [simp]: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> ln x \<le> ln y \<longleftrightarrow> x \<le> y"
   for x :: real
   by (simp add: linorder_not_less [symmetric])
 
 lemma ln_inj_iff [simp]: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> ln x = ln y \<longleftrightarrow> x = y"
   for x :: real
   by (simp add: order_eq_iff)
 
 lemma ln_add_one_self_le_self: "0 \<le> x \<Longrightarrow> ln (1 + x) \<le> x"
   for x :: real
   by (rule exp_le_cancel_iff [THEN iffD1]) (simp add: exp_ge_add_one_self_aux)
 
 lemma ln_less_self [simp]: "0 < x \<Longrightarrow> ln x < x"
   for x :: real
   by (rule order_less_le_trans [where y = "ln (1 + x)"]) (simp_all add: ln_add_one_self_le_self)
 
 lemma ln_ge_iff: "\<And>x::real. 0 < x \<Longrightarrow> y \<le> ln x \<longleftrightarrow> exp y \<le> x"
   using exp_le_cancel_iff exp_total by force
 
 lemma ln_ge_zero [simp]: "1 \<le> x \<Longrightarrow> 0 \<le> ln x"
   for x :: real
   using ln_le_cancel_iff [of 1 x] by simp
 
 lemma ln_ge_zero_imp_ge_one: "0 \<le> ln x \<Longrightarrow> 0 < x \<Longrightarrow> 1 \<le> x"
   for x :: real
   using ln_le_cancel_iff [of 1 x] by simp
 
 lemma ln_ge_zero_iff [simp]: "0 < x \<Longrightarrow> 0 \<le> ln x \<longleftrightarrow> 1 \<le> x"
   for x :: real
   using ln_le_cancel_iff [of 1 x] by simp
 
 lemma ln_less_zero_iff [simp]: "0 < x \<Longrightarrow> ln x < 0 \<longleftrightarrow> x < 1"
   for x :: real
   using ln_less_cancel_iff [of x 1] by simp
 
 lemma ln_le_zero_iff [simp]: "0 < x \<Longrightarrow> ln x \<le> 0 \<longleftrightarrow> x \<le> 1"
   for x :: real
   by (metis less_numeral_extra(1) ln_le_cancel_iff ln_one)
 
 lemma ln_gt_zero: "1 < x \<Longrightarrow> 0 < ln x"
   for x :: real
   using ln_less_cancel_iff [of 1 x] by simp
 
 lemma ln_gt_zero_imp_gt_one: "0 < ln x \<Longrightarrow> 0 < x \<Longrightarrow> 1 < x"
   for x :: real
   using ln_less_cancel_iff [of 1 x] by simp
 
 lemma ln_gt_zero_iff [simp]: "0 < x \<Longrightarrow> 0 < ln x \<longleftrightarrow> 1 < x"
   for x :: real
   using ln_less_cancel_iff [of 1 x] by simp
 
 lemma ln_eq_zero_iff [simp]: "0 < x \<Longrightarrow> ln x = 0 \<longleftrightarrow> x = 1"
   for x :: real
   using ln_inj_iff [of x 1] by simp
 
 lemma ln_less_zero: "0 < x \<Longrightarrow> x < 1 \<Longrightarrow> ln x < 0"
   for x :: real
   by simp
 
 lemma ln_neg_is_const: "x \<le> 0 \<Longrightarrow> ln x = (THE x. False)"
   for x :: real
   by (auto simp: ln_real_def intro!: arg_cong[where f = The])
 
 lemma powr_eq_one_iff [simp]:
   "a powr x = 1 \<longleftrightarrow> x = 0" if "a > 1" for a x :: real
   using that by (auto simp: powr_def split: if_splits)
 
 lemma isCont_ln:
   fixes x :: real
   assumes "x \<noteq> 0"
   shows "isCont ln x"
 proof (cases "0 < x")
   case True
   then have "isCont ln (exp (ln x))"
     by (intro isCont_inverse_function[where d = "\<bar>x\<bar>" and f = exp]) auto
   with True show ?thesis
     by simp
 next
   case False
   with \<open>x \<noteq> 0\<close> show "isCont ln x"
     unfolding isCont_def
     by (subst filterlim_cong[OF _ refl, of _ "nhds (ln 0)" _ "\<lambda>_. ln 0"])
        (auto simp: ln_neg_is_const not_less eventually_at dist_real_def
          intro!: exI[of _ "\<bar>x\<bar>"])
 qed
 
 lemma tendsto_ln [tendsto_intros]: "(f \<longlongrightarrow> a) F \<Longrightarrow> a \<noteq> 0 \<Longrightarrow> ((\<lambda>x. ln (f x)) \<longlongrightarrow> ln a) F"
   for a :: real
   by (rule isCont_tendsto_compose [OF isCont_ln])
 
 lemma continuous_ln:
   "continuous F f \<Longrightarrow> f (Lim F (\<lambda>x. x)) \<noteq> 0 \<Longrightarrow> continuous F (\<lambda>x. ln (f x :: real))"
   unfolding continuous_def by (rule tendsto_ln)
 
 lemma isCont_ln' [continuous_intros]:
   "continuous (at x) f \<Longrightarrow> f x \<noteq> 0 \<Longrightarrow> continuous (at x) (\<lambda>x. ln (f x :: real))"
   unfolding continuous_at by (rule tendsto_ln)
 
 lemma continuous_within_ln [continuous_intros]:
   "continuous (at x within s) f \<Longrightarrow> f x \<noteq> 0 \<Longrightarrow> continuous (at x within s) (\<lambda>x. ln (f x :: real))"
   unfolding continuous_within by (rule tendsto_ln)
 
 lemma continuous_on_ln [continuous_intros]:
   "continuous_on s f \<Longrightarrow> (\<forall>x\<in>s. f x \<noteq> 0) \<Longrightarrow> continuous_on s (\<lambda>x. ln (f x :: real))"
   unfolding continuous_on_def by (auto intro: tendsto_ln)
 
 lemma DERIV_ln: "0 < x \<Longrightarrow> DERIV ln x :> inverse x"
   for x :: real
   by (rule DERIV_inverse_function [where f=exp and a=0 and b="x+1"])
     (auto intro: DERIV_cong [OF DERIV_exp exp_ln] isCont_ln)
 
 lemma DERIV_ln_divide: "0 < x \<Longrightarrow> DERIV ln x :> 1 / x"
   for x :: real
   by (rule DERIV_ln[THEN DERIV_cong]) (simp_all add: divide_inverse)
 
 declare DERIV_ln_divide[THEN DERIV_chain2, derivative_intros]
   and DERIV_ln_divide[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]
 
 lemmas has_derivative_ln[derivative_intros] = DERIV_ln[THEN DERIV_compose_FDERIV]
 
 lemma ln_series:
   assumes "0 < x" and "x < 2"
   shows "ln x = (\<Sum> n. (-1)^n * (1 / real (n + 1)) * (x - 1)^(Suc n))"
     (is "ln x = suminf (?f (x - 1))")
 proof -
   let ?f' = "\<lambda>x n. (-1)^n * (x - 1)^n"
 
   have "ln x - suminf (?f (x - 1)) = ln 1 - suminf (?f (1 - 1))"
   proof (rule DERIV_isconst3 [where x = x])
     fix x :: real
     assume "x \<in> {0 <..< 2}"
     then have "0 < x" and "x < 2" by auto
     have "norm (1 - x) < 1"
       using \<open>0 < x\<close> and \<open>x < 2\<close> by auto
     have "1 / x = 1 / (1 - (1 - x))" by auto
     also have "\<dots> = (\<Sum> n. (1 - x)^n)"
       using geometric_sums[OF \<open>norm (1 - x) < 1\<close>] by (rule sums_unique)
     also have "\<dots> = suminf (?f' x)"
       unfolding power_mult_distrib[symmetric]
       by (rule arg_cong[where f=suminf], rule arg_cong[where f="(^)"], auto)
     finally have "DERIV ln x :> suminf (?f' x)"
       using DERIV_ln[OF \<open>0 < x\<close>] unfolding divide_inverse by auto
     moreover
     have repos: "\<And> h x :: real. h - 1 + x = h + x - 1" by auto
     have "DERIV (\<lambda>x. suminf (?f x)) (x - 1) :>
       (\<Sum>n. (-1)^n * (1 / real (n + 1)) * real (Suc n) * (x - 1) ^ n)"
     proof (rule DERIV_power_series')
       show "x - 1 \<in> {- 1<..<1}" and "(0 :: real) < 1"
         using \<open>0 < x\<close> \<open>x < 2\<close> by auto
     next
       fix x :: real
       assume "x \<in> {- 1<..<1}"
       then show "summable (\<lambda>n. (- 1) ^ n * (1 / real (n + 1)) * real (Suc n) * x^n)"
         by (simp add: abs_if flip: power_mult_distrib)
     qed
     then have "DERIV (\<lambda>x. suminf (?f x)) (x - 1) :> suminf (?f' x)"
       unfolding One_nat_def by auto
     then have "DERIV (\<lambda>x. suminf (?f (x - 1))) x :> suminf (?f' x)"
       unfolding DERIV_def repos .
     ultimately have "DERIV (\<lambda>x. ln x - suminf (?f (x - 1))) x :> suminf (?f' x) - suminf (?f' x)"
       by (rule DERIV_diff)
     then show "DERIV (\<lambda>x. ln x - suminf (?f (x - 1))) x :> 0" by auto
   qed (auto simp: assms)
   then show ?thesis by auto
 qed
 
 lemma exp_first_terms:
   fixes x :: "'a::{real_normed_algebra_1,banach}"
   shows "exp x = (\<Sum>n<k. inverse(fact n) *\<^sub>R (x ^ n)) + (\<Sum>n. inverse(fact (n + k)) *\<^sub>R (x ^ (n + k)))"
 proof -
   have "exp x = suminf (\<lambda>n. inverse(fact n) *\<^sub>R (x^n))"
     by (simp add: exp_def)
   also from summable_exp_generic have "\<dots> = (\<Sum> n. inverse(fact(n+k)) *\<^sub>R (x ^ (n + k))) +
     (\<Sum> n::nat<k. inverse(fact n) *\<^sub>R (x^n))" (is "_ = _ + ?a")
     by (rule suminf_split_initial_segment)
   finally show ?thesis by simp
 qed
 
 lemma exp_first_term: "exp x = 1 + (\<Sum>n. inverse (fact (Suc n)) *\<^sub>R (x ^ Suc n))"
   for x :: "'a::{real_normed_algebra_1,banach}"
   using exp_first_terms[of x 1] by simp
 
 lemma exp_first_two_terms: "exp x = 1 + x + (\<Sum>n. inverse (fact (n + 2)) *\<^sub>R (x ^ (n + 2)))"
   for x :: "'a::{real_normed_algebra_1,banach}"
   using exp_first_terms[of x 2] by (simp add: eval_nat_numeral)
 
 lemma exp_bound:
   fixes x :: real
   assumes a: "0 \<le> x"
     and b: "x \<le> 1"
   shows "exp x \<le> 1 + x + x\<^sup>2"
 proof -
   have "suminf (\<lambda>n. inverse(fact (n+2)) * (x ^ (n + 2))) \<le> x\<^sup>2"
   proof -
-    have "(\<lambda>n. x\<^sup>2 / 2 * (1 / 2) ^ n) sums (x\<^sup>2 / 2 * (1 / (1 - 1 / 2)))"
+    have "(\<lambda>n. x\<^sup>2 / 2 * (1/2) ^ n) sums (x\<^sup>2 / 2 * (1 / (1 - 1/2)))"
       by (intro sums_mult geometric_sums) simp
-    then have sumsx: "(\<lambda>n. x\<^sup>2 / 2 * (1 / 2) ^ n) sums x\<^sup>2"
+    then have sumsx: "(\<lambda>n. x\<^sup>2 / 2 * (1/2) ^ n) sums x\<^sup>2"
       by simp
     have "suminf (\<lambda>n. inverse(fact (n+2)) * (x ^ (n + 2))) \<le> suminf (\<lambda>n. (x\<^sup>2/2) * ((1/2)^n))"
     proof (intro suminf_le allI)
       show "inverse (fact (n + 2)) * x ^ (n + 2) \<le> (x\<^sup>2/2) * ((1/2)^n)" for n :: nat
       proof -
         have "(2::nat) * 2 ^ n \<le> fact (n + 2)"
           by (induct n) simp_all
         then have "real ((2::nat) * 2 ^ n) \<le> real_of_nat (fact (n + 2))"
           by (simp only: of_nat_le_iff)
         then have "((2::real) * 2 ^ n) \<le> fact (n + 2)"
           unfolding of_nat_fact by simp
         then have "inverse (fact (n + 2)) \<le> inverse ((2::real) * 2 ^ n)"
           by (rule le_imp_inverse_le) simp
         then have "inverse (fact (n + 2)) \<le> 1/(2::real) * (1/2)^n"
           by (simp add: power_inverse [symmetric])
         then have "inverse (fact (n + 2)) * (x^n * x\<^sup>2) \<le> 1/2 * (1/2)^n * (1 * x\<^sup>2)"
           by (rule mult_mono) (rule mult_mono, simp_all add: power_le_one a b)
         then show ?thesis
           unfolding power_add by (simp add: ac_simps del: fact_Suc)
       qed
       show "summable (\<lambda>n. inverse (fact (n + 2)) * x ^ (n + 2))"
         by (rule summable_exp [THEN summable_ignore_initial_segment])
-      show "summable (\<lambda>n. x\<^sup>2 / 2 * (1 / 2) ^ n)"
+      show "summable (\<lambda>n. x\<^sup>2 / 2 * (1/2) ^ n)"
         by (rule sums_summable [OF sumsx])
     qed
     also have "\<dots> = x\<^sup>2"
       by (rule sums_unique [THEN sym]) (rule sumsx)
     finally show ?thesis .
   qed
   then show ?thesis
     unfolding exp_first_two_terms by auto
 qed
 
 corollary exp_half_le2: "exp(1/2) \<le> (2::real)"
   using exp_bound [of "1/2"]
   by (simp add: field_simps)
 
 corollary exp_le: "exp 1 \<le> (3::real)"
   using exp_bound [of 1]
   by (simp add: field_simps)
 
 lemma exp_bound_half: "norm z \<le> 1/2 \<Longrightarrow> norm (exp z) \<le> 2"
   by (blast intro: order_trans intro!: exp_half_le2 norm_exp)
 
 lemma exp_bound_lemma:
   assumes "norm z \<le> 1/2"
   shows "norm (exp z) \<le> 1 + 2 * norm z"
 proof -
   have *: "(norm z)\<^sup>2 \<le> norm z * 1"
     unfolding power2_eq_square
     by (rule mult_left_mono) (use assms in auto)
   have "norm (exp z) \<le> exp (norm z)"
     by (rule norm_exp)
   also have "\<dots> \<le> 1 + (norm z) + (norm z)\<^sup>2"
     using assms exp_bound by auto
   also have "\<dots> \<le> 1 + 2 * norm z"
     using * by auto
   finally show ?thesis .
 qed
 
 lemma real_exp_bound_lemma: "0 \<le> x \<Longrightarrow> x \<le> 1/2 \<Longrightarrow> exp x \<le> 1 + 2 * x"
   for x :: real
   using exp_bound_lemma [of x] by simp
 
 lemma ln_one_minus_pos_upper_bound:
   fixes x :: real
   assumes a: "0 \<le> x" and b: "x < 1"
   shows "ln (1 - x) \<le> - x"
 proof -
   have "(1 - x) * (1 + x + x\<^sup>2) = 1 - x^3"
     by (simp add: algebra_simps power2_eq_square power3_eq_cube)
   also have "\<dots> \<le> 1"
     by (auto simp: a)
   finally have "(1 - x) * (1 + x + x\<^sup>2) \<le> 1" .
   moreover have c: "0 < 1 + x + x\<^sup>2"
     by (simp add: add_pos_nonneg a)
   ultimately have "1 - x \<le> 1 / (1 + x + x\<^sup>2)"
     by (elim mult_imp_le_div_pos)
   also have "\<dots> \<le> 1 / exp x"
     by (metis a abs_one b exp_bound exp_gt_zero frac_le less_eq_real_def real_sqrt_abs
         real_sqrt_pow2_iff real_sqrt_power)
   also have "\<dots> = exp (- x)"
     by (auto simp: exp_minus divide_inverse)
   finally have "1 - x \<le> exp (- x)" .
   also have "1 - x = exp (ln (1 - x))"
     by (metis b diff_0 exp_ln_iff less_iff_diff_less_0 minus_diff_eq)
   finally have "exp (ln (1 - x)) \<le> exp (- x)" .
   then show ?thesis
     by (auto simp only: exp_le_cancel_iff)
 qed
 
 lemma exp_ge_add_one_self [simp]: "1 + x \<le> exp x"
   for x :: real
 proof (cases "0 \<le> x \<or> x \<le> -1")
   case True
   then show ?thesis
     by (meson exp_ge_add_one_self_aux exp_ge_zero order.trans real_add_le_0_iff)
 next
   case False
   then have ln1: "ln (1 + x) \<le> x"
     using ln_one_minus_pos_upper_bound [of "-x"] by simp
   have "1 + x = exp (ln (1 + x))"
     using False by auto
   also have "\<dots> \<le> exp x"
     by (simp add: ln1)
   finally show ?thesis .
 qed
 
 lemma ln_one_plus_pos_lower_bound:
   fixes x :: real
   assumes a: "0 \<le> x" and b: "x \<le> 1"
   shows "x - x\<^sup>2 \<le> ln (1 + x)"
 proof -
   have "exp (x - x\<^sup>2) = exp x / exp (x\<^sup>2)"
     by (rule exp_diff)
   also have "\<dots> \<le> (1 + x + x\<^sup>2) / exp (x \<^sup>2)"
     by (metis a b divide_right_mono exp_bound exp_ge_zero)
   also have "\<dots> \<le> (1 + x + x\<^sup>2) / (1 + x\<^sup>2)"
     by (simp add: a divide_left_mono add_pos_nonneg)
   also from a have "\<dots> \<le> 1 + x"
     by (simp add: field_simps add_strict_increasing zero_le_mult_iff)
   finally have "exp (x - x\<^sup>2) \<le> 1 + x" .
   also have "\<dots> = exp (ln (1 + x))"
   proof -
     from a have "0 < 1 + x" by auto
     then show ?thesis
       by (auto simp only: exp_ln_iff [THEN sym])
   qed
   finally have "exp (x - x\<^sup>2) \<le> exp (ln (1 + x))" .
   then show ?thesis
     by (metis exp_le_cancel_iff)
 qed
 
 lemma ln_one_minus_pos_lower_bound:
   fixes x :: real
-  assumes a: "0 \<le> x" and b: "x \<le> 1 / 2"
+  assumes a: "0 \<le> x" and b: "x \<le> 1/2"
   shows "- x - 2 * x\<^sup>2 \<le> ln (1 - x)"
 proof -
   from b have c: "x < 1" by auto
   then have "ln (1 - x) = - ln (1 + x / (1 - x))"
     by (auto simp: ln_inverse [symmetric] field_simps intro: arg_cong [where f=ln])
   also have "- (x / (1 - x)) \<le> \<dots>"
   proof -
     have "ln (1 + x / (1 - x)) \<le> x / (1 - x)"
       using a c by (intro ln_add_one_self_le_self) auto
     then show ?thesis
       by auto
   qed
   also have "- (x / (1 - x)) = - x / (1 - x)"
     by auto
   finally have d: "- x / (1 - x) \<le> ln (1 - x)" .
   have "0 < 1 - x" using a b by simp
   then have e: "- x - 2 * x\<^sup>2 \<le> - x / (1 - x)"
     using mult_right_le_one_le[of "x * x" "2 * x"] a b
     by (simp add: field_simps power2_eq_square)
   from e d show "- x - 2 * x\<^sup>2 \<le> ln (1 - x)"
     by (rule order_trans)
 qed
 
 lemma ln_add_one_self_le_self2:
   fixes x :: real
   shows "-1 < x \<Longrightarrow> ln (1 + x) \<le> x"
   by (metis diff_gt_0_iff_gt diff_minus_eq_add exp_ge_add_one_self exp_le_cancel_iff exp_ln minus_less_iff)
 
 lemma abs_ln_one_plus_x_minus_x_bound_nonneg:
   fixes x :: real
   assumes x: "0 \<le> x" and x1: "x \<le> 1"
   shows "\<bar>ln (1 + x) - x\<bar> \<le> x\<^sup>2"
 proof -
   from x have "ln (1 + x) \<le> x"
     by (rule ln_add_one_self_le_self)
   then have "ln (1 + x) - x \<le> 0"
     by simp
   then have "\<bar>ln(1 + x) - x\<bar> = - (ln(1 + x) - x)"
     by (rule abs_of_nonpos)
   also have "\<dots> = x - ln (1 + x)"
     by simp
   also have "\<dots> \<le> x\<^sup>2"
   proof -
     from x x1 have "x - x\<^sup>2 \<le> ln (1 + x)"
       by (intro ln_one_plus_pos_lower_bound)
     then show ?thesis
       by simp
   qed
   finally show ?thesis .
 qed
 
 lemma abs_ln_one_plus_x_minus_x_bound_nonpos:
   fixes x :: real
-  assumes a: "-(1 / 2) \<le> x" and b: "x \<le> 0"
+  assumes a: "-(1/2) \<le> x" and b: "x \<le> 0"
   shows "\<bar>ln (1 + x) - x\<bar> \<le> 2 * x\<^sup>2"
 proof -
   have *: "- (-x) - 2 * (-x)\<^sup>2 \<le> ln (1 - (- x))"
     by (metis a b diff_zero ln_one_minus_pos_lower_bound minus_diff_eq neg_le_iff_le) 
   have "\<bar>ln (1 + x) - x\<bar> = x - ln (1 - (- x))"
     using a ln_add_one_self_le_self2 [of x] by (simp add: abs_if)
   also have "\<dots> \<le> 2 * x\<^sup>2"
     using * by (simp add: algebra_simps)
   finally show ?thesis .
 qed
 
 lemma abs_ln_one_plus_x_minus_x_bound:
   fixes x :: real
-  assumes "\<bar>x\<bar> \<le> 1 / 2"
+  assumes "\<bar>x\<bar> \<le> 1/2"
   shows "\<bar>ln (1 + x) - x\<bar> \<le> 2 * x\<^sup>2"
 proof (cases "0 \<le> x")
   case True
   then show ?thesis
     using abs_ln_one_plus_x_minus_x_bound_nonneg assms by fastforce
 next
   case False
   then show ?thesis
     using abs_ln_one_plus_x_minus_x_bound_nonpos assms by auto
 qed
 
 lemma ln_x_over_x_mono:
   fixes x :: real
   assumes x: "exp 1 \<le> x" "x \<le> y"
   shows "ln y / y \<le> ln x / x"
 proof -
   note x
   moreover have "0 < exp (1::real)" by simp
   ultimately have a: "0 < x" and b: "0 < y"
     by (fast intro: less_le_trans order_trans)+
   have "x * ln y - x * ln x = x * (ln y - ln x)"
     by (simp add: algebra_simps)
   also have "\<dots> = x * ln (y / x)"
     by (simp only: ln_div a b)
   also have "y / x = (x + (y - x)) / x"
     by simp
   also have "\<dots> = 1 + (y - x) / x"
     using x a by (simp add: field_simps)
   also have "x * ln (1 + (y - x) / x) \<le> x * ((y - x) / x)"
     using x a
     by (intro mult_left_mono ln_add_one_self_le_self) simp_all
   also have "\<dots> = y - x"
     using a by simp
   also have "\<dots> = (y - x) * ln (exp 1)" by simp
   also have "\<dots> \<le> (y - x) * ln x"
     using a x exp_total of_nat_1 x(1)  by (fastforce intro: mult_left_mono)
   also have "\<dots> = y * ln x - x * ln x"
     by (rule left_diff_distrib)
   finally have "x * ln y \<le> y * ln x"
     by arith
   then have "ln y \<le> (y * ln x) / x"
     using a by (simp add: field_simps)
   also have "\<dots> = y * (ln x / x)" by simp
   finally show ?thesis
     using b by (simp add: field_simps)
 qed
 
 lemma ln_le_minus_one: "0 < x \<Longrightarrow> ln x \<le> x - 1"
   for x :: real
   using exp_ge_add_one_self[of "ln x"] by simp
 
 corollary ln_diff_le: "0 < x \<Longrightarrow> 0 < y \<Longrightarrow> ln x - ln y \<le> (x - y) / y"
   for x :: real
   by (simp add: ln_div [symmetric] diff_divide_distrib ln_le_minus_one)
 
 lemma ln_eq_minus_one:
   fixes x :: real
   assumes "0 < x" "ln x = x - 1"
   shows "x = 1"
 proof -
   let ?l = "\<lambda>y. ln y - y + 1"
   have D: "\<And>x::real. 0 < x \<Longrightarrow> DERIV ?l x :> (1 / x - 1)"
     by (auto intro!: derivative_eq_intros)
 
   show ?thesis
   proof (cases rule: linorder_cases)
     assume "x < 1"
     from dense[OF \<open>x < 1\<close>] obtain a where "x < a" "a < 1" by blast
     from \<open>x < a\<close> have "?l x < ?l a"
     proof (rule DERIV_pos_imp_increasing)
       fix y
       assume "x \<le> y" "y \<le> a"
       with \<open>0 < x\<close> \<open>a < 1\<close> have "0 < 1 / y - 1" "0 < y"
         by (auto simp: field_simps)
       with D show "\<exists>z. DERIV ?l y :> z \<and> 0 < z" by blast
     qed
     also have "\<dots> \<le> 0"
       using ln_le_minus_one \<open>0 < x\<close> \<open>x < a\<close> by (auto simp: field_simps)
     finally show "x = 1" using assms by auto
   next
     assume "1 < x"
     from dense[OF this] obtain a where "1 < a" "a < x" by blast
     from \<open>a < x\<close> have "?l x < ?l a"
     proof (rule DERIV_neg_imp_decreasing)
       fix y
       assume "a \<le> y" "y \<le> x"
       with \<open>1 < a\<close> have "1 / y - 1 < 0" "0 < y"
         by (auto simp: field_simps)
       with D show "\<exists>z. DERIV ?l y :> z \<and> z < 0"
         by blast
     qed
     also have "\<dots> \<le> 0"
       using ln_le_minus_one \<open>1 < a\<close> by (auto simp: field_simps)
     finally show "x = 1" using assms by auto
   next
     assume "x = 1"
     then show ?thesis by simp
   qed
 qed
 
 lemma ln_x_over_x_tendsto_0: "((\<lambda>x::real. ln x / x) \<longlongrightarrow> 0) at_top"
 proof (rule lhospital_at_top_at_top[where f' = inverse and g' = "\<lambda>_. 1"])
   from eventually_gt_at_top[of "0::real"]
   show "\<forall>\<^sub>F x in at_top. (ln has_real_derivative inverse x) (at x)"
     by eventually_elim (auto intro!: derivative_eq_intros simp: field_simps)
 qed (use tendsto_inverse_0 in
       \<open>auto simp: filterlim_ident dest!: tendsto_mono[OF at_top_le_at_infinity]\<close>)
 
 lemma exp_ge_one_plus_x_over_n_power_n:
   assumes "x \<ge> - real n" "n > 0"
   shows "(1 + x / of_nat n) ^ n \<le> exp x"
 proof (cases "x = - of_nat n")
   case False
   from assms False have "(1 + x / of_nat n) ^ n = exp (of_nat n * ln (1 + x / of_nat n))"
     by (subst exp_of_nat_mult, subst exp_ln) (simp_all add: field_simps)
   also from assms False have "ln (1 + x / real n) \<le> x / real n"
     by (intro ln_add_one_self_le_self2) (simp_all add: field_simps)
   with assms have "exp (of_nat n * ln (1 + x / of_nat n)) \<le> exp x"
     by (simp add: field_simps)
   finally show ?thesis .
 next
   case True
   then show ?thesis by (simp add: zero_power)
 qed
 
 lemma exp_ge_one_minus_x_over_n_power_n:
   assumes "x \<le> real n" "n > 0"
   shows "(1 - x / of_nat n) ^ n \<le> exp (-x)"
   using exp_ge_one_plus_x_over_n_power_n[of n "-x"] assms by simp
 
 lemma exp_at_bot: "(exp \<longlongrightarrow> (0::real)) at_bot"
   unfolding tendsto_Zfun_iff
 proof (rule ZfunI, simp add: eventually_at_bot_dense)
   fix r :: real
   assume "0 < r"
   have "exp x < r" if "x < ln r" for x
     by (metis \<open>0 < r\<close> exp_less_mono exp_ln that)
   then show "\<exists>k. \<forall>n<k. exp n < r" by auto
 qed
 
 lemma exp_at_top: "LIM x at_top. exp x :: real :> at_top"
   by (rule filterlim_at_top_at_top[where Q="\<lambda>x. True" and P="\<lambda>x. 0 < x" and g=ln])
     (auto intro: eventually_gt_at_top)
 
 lemma lim_exp_minus_1: "((\<lambda>z::'a. (exp(z) - 1) / z) \<longlongrightarrow> 1) (at 0)"
   for x :: "'a::{real_normed_field,banach}"
 proof -
   have "((\<lambda>z::'a. exp(z) - 1) has_field_derivative 1) (at 0)"
     by (intro derivative_eq_intros | simp)+
   then show ?thesis
     by (simp add: Deriv.has_field_derivative_iff)
 qed
 
 lemma ln_at_0: "LIM x at_right 0. ln (x::real) :> at_bot"
   by (rule filterlim_at_bot_at_right[where Q="\<lambda>x. 0 < x" and P="\<lambda>x. True" and g=exp])
      (auto simp: eventually_at_filter)
 
 lemma ln_at_top: "LIM x at_top. ln (x::real) :> at_top"
   by (rule filterlim_at_top_at_top[where Q="\<lambda>x. 0 < x" and P="\<lambda>x. True" and g=exp])
      (auto intro: eventually_gt_at_top)
 
 lemma filtermap_ln_at_top: "filtermap (ln::real \<Rightarrow> real) at_top = at_top"
   by (intro filtermap_fun_inverse[of exp] exp_at_top ln_at_top) auto
 
 lemma filtermap_exp_at_top: "filtermap (exp::real \<Rightarrow> real) at_top = at_top"
   by (intro filtermap_fun_inverse[of ln] exp_at_top ln_at_top)
      (auto simp: eventually_at_top_dense)
 
 lemma filtermap_ln_at_right: "filtermap ln (at_right (0::real)) = at_bot"
   by (auto intro!: filtermap_fun_inverse[where g="\<lambda>x. exp x"] ln_at_0
       simp: filterlim_at exp_at_bot)
 
 lemma tendsto_power_div_exp_0: "((\<lambda>x. x ^ k / exp x) \<longlongrightarrow> (0::real)) at_top"
 proof (induct k)
   case 0
   show "((\<lambda>x. x ^ 0 / exp x) \<longlongrightarrow> (0::real)) at_top"
     by (simp add: inverse_eq_divide[symmetric])
        (metis filterlim_compose[OF tendsto_inverse_0] exp_at_top filterlim_mono
          at_top_le_at_infinity order_refl)
 next
   case (Suc k)
   show ?case
   proof (rule lhospital_at_top_at_top)
     show "eventually (\<lambda>x. DERIV (\<lambda>x. x ^ Suc k) x :> (real (Suc k) * x^k)) at_top"
       by eventually_elim (intro derivative_eq_intros, auto)
     show "eventually (\<lambda>x. DERIV exp x :> exp x) at_top"
       by eventually_elim auto
     show "eventually (\<lambda>x. exp x \<noteq> 0) at_top"
       by auto
     from tendsto_mult[OF tendsto_const Suc, of "real (Suc k)"]
     show "((\<lambda>x. real (Suc k) * x ^ k / exp x) \<longlongrightarrow> 0) at_top"
       by simp
   qed (rule exp_at_top)
 qed
 
 subsubsection\<open> A couple of simple bounds\<close>
 
 lemma exp_plus_inverse_exp:
   fixes x::real
   shows "2 \<le> exp x + inverse (exp x)"
 proof -
   have "2 \<le> exp x + exp (-x)"
     using exp_ge_add_one_self [of x] exp_ge_add_one_self [of "-x"]
     by linarith
   then show ?thesis
     by (simp add: exp_minus)
 qed
 
 lemma real_le_x_sinh:
   fixes x::real
   assumes "0 \<le> x"
   shows "x \<le> (exp x - inverse(exp x)) / 2"
 proof -
   have *: "exp a - inverse(exp a) - 2*a \<le> exp b - inverse(exp b) - 2*b" if "a \<le> b" for a b::real
     using exp_plus_inverse_exp
     by (fastforce intro: derivative_eq_intros DERIV_nonneg_imp_nondecreasing [OF that])
   show ?thesis
     using*[OF assms] by simp
 qed
 
 lemma real_le_abs_sinh:
   fixes x::real
   shows "abs x \<le> abs((exp x - inverse(exp x)) / 2)"
 proof (cases "0 \<le> x")
   case True
   show ?thesis
     using real_le_x_sinh [OF True] True by (simp add: abs_if)
 next
   case False
   have "-x \<le> (exp(-x) - inverse(exp(-x))) / 2"
     by (meson False linear neg_le_0_iff_le real_le_x_sinh)
   also have "\<dots> \<le> \<bar>(exp x - inverse (exp x)) / 2\<bar>"
     by (metis (no_types, opaque_lifting) abs_divide abs_le_iff abs_minus_cancel
        add.inverse_inverse exp_minus minus_diff_eq order_refl)
   finally show ?thesis
     using False by linarith
 qed
 
 subsection\<open>The general logarithm\<close>
 
 definition log :: "real \<Rightarrow> real \<Rightarrow> real"
   \<comment> \<open>logarithm of \<^term>\<open>x\<close> to base \<^term>\<open>a\<close>\<close>
   where "log a x = ln x / ln a"
 
 lemma tendsto_log [tendsto_intros]:
   "(f \<longlongrightarrow> a) F \<Longrightarrow> (g \<longlongrightarrow> b) F \<Longrightarrow> 0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> 0 < b \<Longrightarrow>
     ((\<lambda>x. log (f x) (g x)) \<longlongrightarrow> log a b) F"
   unfolding log_def by (intro tendsto_intros) auto
 
 lemma continuous_log:
   assumes "continuous F f"
     and "continuous F g"
     and "0 < f (Lim F (\<lambda>x. x))"
     and "f (Lim F (\<lambda>x. x)) \<noteq> 1"
     and "0 < g (Lim F (\<lambda>x. x))"
   shows "continuous F (\<lambda>x. log (f x) (g x))"
   using assms unfolding continuous_def by (rule tendsto_log)
 
 lemma continuous_at_within_log[continuous_intros]:
   assumes "continuous (at a within s) f"
     and "continuous (at a within s) g"
     and "0 < f a"
     and "f a \<noteq> 1"
     and "0 < g a"
   shows "continuous (at a within s) (\<lambda>x. log (f x) (g x))"
   using assms unfolding continuous_within by (rule tendsto_log)
 
 lemma isCont_log[continuous_intros, simp]:
   assumes "isCont f a" "isCont g a" "0 < f a" "f a \<noteq> 1" "0 < g a"
   shows "isCont (\<lambda>x. log (f x) (g x)) a"
   using assms unfolding continuous_at by (rule tendsto_log)
 
 lemma continuous_on_log[continuous_intros]:
   assumes "continuous_on s f" "continuous_on s g"
     and "\<forall>x\<in>s. 0 < f x" "\<forall>x\<in>s. f x \<noteq> 1" "\<forall>x\<in>s. 0 < g x"
   shows "continuous_on s (\<lambda>x. log (f x) (g x))"
   using assms unfolding continuous_on_def by (fast intro: tendsto_log)
 
 lemma powr_one_eq_one [simp]: "1 powr a = 1"
   by (simp add: powr_def)
 
 lemma powr_zero_eq_one [simp]: "x powr 0 = (if x = 0 then 0 else 1)"
   by (simp add: powr_def)
 
 lemma powr_one_gt_zero_iff [simp]: "x powr 1 = x \<longleftrightarrow> 0 \<le> x"
   for x :: real
   by (auto simp: powr_def)
 declare powr_one_gt_zero_iff [THEN iffD2, simp]
 
 lemma powr_diff:
   fixes w:: "'a::{ln,real_normed_field}" shows  "w powr (z1 - z2) = w powr z1 / w powr z2"
   by (simp add: powr_def algebra_simps exp_diff)
 
 lemma powr_mult: "0 \<le> x \<Longrightarrow> 0 \<le> y \<Longrightarrow> (x * y) powr a = (x powr a) * (y powr a)"
   for a x y :: real
   by (simp add: powr_def exp_add [symmetric] ln_mult distrib_left)
 
 lemma powr_ge_pzero [simp]: "0 \<le> x powr y"
   for x y :: real
   by (simp add: powr_def)
 
 lemma powr_non_neg[simp]: "\<not>a powr x < 0" for a x::real
   using powr_ge_pzero[of a x] by arith
 
 lemma inverse_powr: "\<And>y::real. 0 \<le> y \<Longrightarrow> inverse y powr a = inverse (y powr a)"
     by (simp add: exp_minus ln_inverse powr_def)
 
 lemma powr_divide: "\<lbrakk>0 \<le> x; 0 \<le> y\<rbrakk> \<Longrightarrow> (x / y) powr a = (x powr a) / (y powr a)"
   for a b x :: real
     by (simp add: divide_inverse powr_mult inverse_powr)
 
 lemma powr_add: "x powr (a + b) = (x powr a) * (x powr b)"
   for a b x :: "'a::{ln,real_normed_field}"
   by (simp add: powr_def exp_add [symmetric] distrib_right)
 
 lemma powr_mult_base: "0 \<le> x \<Longrightarrow>x * x powr y = x powr (1 + y)"
   for x :: real
   by (auto simp: powr_add)
 
 lemma powr_powr: "(x powr a) powr b = x powr (a * b)"
   for a b x :: real
   by (simp add: powr_def)
 
 lemma powr_powr_swap: "(x powr a) powr b = (x powr b) powr a"
   for a b x :: real
   by (simp add: powr_powr mult.commute)
 
 lemma powr_minus: "x powr (- a) = inverse (x powr a)"
       for a x :: "'a::{ln,real_normed_field}"
   by (simp add: powr_def exp_minus [symmetric])
 
 lemma powr_minus_divide: "x powr (- a) = 1/(x powr a)"
       for a x :: "'a::{ln,real_normed_field}"
   by (simp add: divide_inverse powr_minus)
 
 lemma divide_powr_uminus: "a / b powr c = a * b powr (- c)"
   for a b c :: real
   by (simp add: powr_minus_divide)
 
 lemma powr_less_mono: "a < b \<Longrightarrow> 1 < x \<Longrightarrow> x powr a < x powr b"
   for a b x :: real
   by (simp add: powr_def)
 
 lemma powr_less_cancel: "x powr a < x powr b \<Longrightarrow> 1 < x \<Longrightarrow> a < b"
   for a b x :: real
   by (simp add: powr_def)
 
 lemma powr_less_cancel_iff [simp]: "1 < x \<Longrightarrow> x powr a < x powr b \<longleftrightarrow> a < b"
   for a b x :: real
   by (blast intro: powr_less_cancel powr_less_mono)
 
 lemma powr_le_cancel_iff [simp]: "1 < x \<Longrightarrow> x powr a \<le> x powr b \<longleftrightarrow> a \<le> b"
   for a b x :: real
   by (simp add: linorder_not_less [symmetric])
 
 lemma powr_realpow: "0 < x \<Longrightarrow> x powr (real n) = x^n"
   by (induction n) (simp_all add: ac_simps powr_add)
 
 lemma powr_real_of_int':
   assumes "x \<ge> 0" "x \<noteq> 0 \<or> n > 0"
   shows   "x powr real_of_int n = power_int x n"
 proof (cases "x = 0")
   case False
   with assms have "x > 0" by simp
   show ?thesis
   proof (cases n rule: int_cases4)
     case (nonneg n)
     thus ?thesis using \<open>x > 0\<close>
       by (auto simp add: powr_realpow)
   next
     case (neg n)
     thus ?thesis using \<open>x > 0\<close>
       by (auto simp add: powr_realpow powr_minus power_int_minus)
   qed
 qed (use assms in auto)
 
 lemma log_ln: "ln x = log (exp(1)) x"
   by (simp add: log_def)
 
 lemma DERIV_log:
   assumes "x > 0"
   shows "DERIV (\<lambda>y. log b y) x :> 1 / (ln b * x)"
 proof -
   define lb where "lb = 1 / ln b"
   moreover have "DERIV (\<lambda>y. lb * ln y) x :> lb / x"
     using \<open>x > 0\<close> by (auto intro!: derivative_eq_intros)
   ultimately show ?thesis
     by (simp add: log_def)
 qed
 
 lemmas DERIV_log[THEN DERIV_chain2, derivative_intros]
   and DERIV_log[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]
 
 lemma powr_log_cancel [simp]: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow> a powr (log a x) = x"
   by (simp add: powr_def log_def)
 
 lemma log_powr_cancel [simp]: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> log a (a powr y) = y"
   by (simp add: log_def powr_def)
 
 lemma log_mult:
   "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow> 0 < y \<Longrightarrow>
     log a (x * y) = log a x + log a y"
   by (simp add: log_def ln_mult divide_inverse distrib_right)
 
 lemma log_eq_div_ln_mult_log:
   "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> 0 < b \<Longrightarrow> b \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow>
     log a x = (ln b/ln a) * log b x"
   by (simp add: log_def divide_inverse)
 
 text\<open>Base 10 logarithms\<close>
 lemma log_base_10_eq1: "0 < x \<Longrightarrow> log 10 x = (ln (exp 1) / ln 10) * ln x"
   by (simp add: log_def)
 
 lemma log_base_10_eq2: "0 < x \<Longrightarrow> log 10 x = (log 10 (exp 1)) * ln x"
   by (simp add: log_def)
 
 lemma log_one [simp]: "log a 1 = 0"
   by (simp add: log_def)
 
 lemma log_eq_one [simp]: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> log a a = 1"
   by (simp add: log_def)
 
 lemma log_inverse: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow> log a (inverse x) = - log a x"
   using ln_inverse log_def by auto
 
 lemma log_divide: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow> 0 < y \<Longrightarrow> log a (x/y) = log a x - log a y"
   by (simp add: log_mult divide_inverse log_inverse)
 
 lemma powr_gt_zero [simp]: "0 < x powr a \<longleftrightarrow> x \<noteq> 0"
   for a x :: real
   by (simp add: powr_def)
 
 lemma powr_nonneg_iff[simp]: "a powr x \<le> 0 \<longleftrightarrow> a = 0"
   for a x::real
   by (meson not_less powr_gt_zero)
 
 lemma log_add_eq_powr: "0 < b \<Longrightarrow> b \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow> log b x + y = log b (x * b powr y)"
   and add_log_eq_powr: "0 < b \<Longrightarrow> b \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow> y + log b x = log b (b powr y * x)"
   and log_minus_eq_powr: "0 < b \<Longrightarrow> b \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow> log b x - y = log b (x * b powr -y)"
   and minus_log_eq_powr: "0 < b \<Longrightarrow> b \<noteq> 1 \<Longrightarrow> 0 < x \<Longrightarrow> y - log b x = log b (b powr y / x)"
   by (simp_all add: log_mult log_divide)
 
 lemma log_less_cancel_iff [simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 0 < y \<Longrightarrow> log a x < log a y \<longleftrightarrow> x < y"
   using powr_less_cancel_iff [of a] powr_log_cancel [of a x] powr_log_cancel [of a y]
   by (metis less_eq_real_def less_trans not_le zero_less_one)
 
 lemma log_inj:
   assumes "1 < b"
   shows "inj_on (log b) {0 <..}"
 proof (rule inj_onI, simp)
   fix x y
   assume pos: "0 < x" "0 < y" and *: "log b x = log b y"
   show "x = y"
   proof (cases rule: linorder_cases)
     assume "x = y"
     then show ?thesis by simp
   next
     assume "x < y"
     then have "log b x < log b y"
       using log_less_cancel_iff[OF \<open>1 < b\<close>] pos by simp
     then show ?thesis using * by simp
   next
     assume "y < x"
     then have "log b y < log b x"
       using log_less_cancel_iff[OF \<open>1 < b\<close>] pos by simp
     then show ?thesis using * by simp
   qed
 qed
 
 lemma log_le_cancel_iff [simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 0 < y \<Longrightarrow> log a x \<le> log a y \<longleftrightarrow> x \<le> y"
   by (simp add: linorder_not_less [symmetric])
 
 lemma zero_less_log_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 0 < log a x \<longleftrightarrow> 1 < x"
   using log_less_cancel_iff[of a 1 x] by simp
 
 lemma zero_le_log_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 0 \<le> log a x \<longleftrightarrow> 1 \<le> x"
   using log_le_cancel_iff[of a 1 x] by simp
 
 lemma log_less_zero_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> log a x < 0 \<longleftrightarrow> x < 1"
   using log_less_cancel_iff[of a x 1] by simp
 
 lemma log_le_zero_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> log a x \<le> 0 \<longleftrightarrow> x \<le> 1"
   using log_le_cancel_iff[of a x 1] by simp
 
 lemma one_less_log_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 1 < log a x \<longleftrightarrow> a < x"
   using log_less_cancel_iff[of a a x] by simp
 
 lemma one_le_log_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> 1 \<le> log a x \<longleftrightarrow> a \<le> x"
   using log_le_cancel_iff[of a a x] by simp
 
 lemma log_less_one_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> log a x < 1 \<longleftrightarrow> x < a"
   using log_less_cancel_iff[of a x a] by simp
 
 lemma log_le_one_cancel_iff[simp]: "1 < a \<Longrightarrow> 0 < x \<Longrightarrow> log a x \<le> 1 \<longleftrightarrow> x \<le> a"
   using log_le_cancel_iff[of a x a] by simp
 
 lemma le_log_iff:
   fixes b x y :: real
   assumes "1 < b" "x > 0"
   shows "y \<le> log b x \<longleftrightarrow> b powr y \<le> x"
   using assms
   by (metis less_irrefl less_trans powr_le_cancel_iff powr_log_cancel zero_less_one)
 
 lemma less_log_iff:
   assumes "1 < b" "x > 0"
   shows "y < log b x \<longleftrightarrow> b powr y < x"
   by (metis assms dual_order.strict_trans less_irrefl powr_less_cancel_iff
     powr_log_cancel zero_less_one)
 
 lemma
   assumes "1 < b" "x > 0"
   shows log_less_iff: "log b x < y \<longleftrightarrow> x < b powr y"
     and log_le_iff: "log b x \<le> y \<longleftrightarrow> x \<le> b powr y"
   using le_log_iff[OF assms, of y] less_log_iff[OF assms, of y]
   by auto
 
 lemmas powr_le_iff = le_log_iff[symmetric]
   and powr_less_iff = less_log_iff[symmetric]
   and less_powr_iff = log_less_iff[symmetric]
   and le_powr_iff = log_le_iff[symmetric]
 
 lemma le_log_of_power:
   assumes "b ^ n \<le> m" "1 < b"
   shows "n \<le> log b m"
 proof -
   from assms have "0 < m" by (metis less_trans zero_less_power less_le_trans zero_less_one)
   thus ?thesis using assms by (simp add: le_log_iff powr_realpow)
 qed
 
 lemma le_log2_of_power: "2 ^ n \<le> m \<Longrightarrow> n \<le> log 2 m" for m n :: nat
 using le_log_of_power[of 2] by simp
 
 lemma log_of_power_le: "\<lbrakk> m \<le> b ^ n; b > 1; m > 0 \<rbrakk> \<Longrightarrow> log b (real m) \<le> n"
 by (simp add: log_le_iff powr_realpow)
 
 lemma log2_of_power_le: "\<lbrakk> m \<le> 2 ^ n; m > 0 \<rbrakk> \<Longrightarrow> log 2 m \<le> n" for m n :: nat
 using log_of_power_le[of _ 2] by simp
 
 lemma log_of_power_less: "\<lbrakk> m < b ^ n; b > 1; m > 0 \<rbrakk> \<Longrightarrow> log b (real m) < n"
 by (simp add: log_less_iff powr_realpow)
 
 lemma log2_of_power_less: "\<lbrakk> m < 2 ^ n; m > 0 \<rbrakk> \<Longrightarrow> log 2 m < n" for m n :: nat
 using log_of_power_less[of _ 2] by simp
 
 lemma less_log_of_power:
   assumes "b ^ n < m" "1 < b"
   shows "n < log b m"
 proof -
   have "0 < m" by (metis assms less_trans zero_less_power zero_less_one)
   thus ?thesis using assms by (simp add: less_log_iff powr_realpow)
 qed
 
 lemma less_log2_of_power: "2 ^ n < m \<Longrightarrow> n < log 2 m" for m n :: nat
 using less_log_of_power[of 2] by simp
 
 lemma gr_one_powr[simp]:
   fixes x y :: real shows "\<lbrakk> x > 1; y > 0 \<rbrakk> \<Longrightarrow> 1 < x powr y"
 by(simp add: less_powr_iff)
 
 lemma log_pow_cancel [simp]:
   "a > 0 \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> log a (a ^ b) = b"
   by (simp add: ln_realpow log_def)
 
 lemma floor_log_eq_powr_iff: "x > 0 \<Longrightarrow> b > 1 \<Longrightarrow> \<lfloor>log b x\<rfloor> = k \<longleftrightarrow> b powr k \<le> x \<and> x < b powr (k + 1)"
   by (auto simp: floor_eq_iff powr_le_iff less_powr_iff)
 
 lemma floor_log_nat_eq_powr_iff: fixes b n k :: nat
   shows "\<lbrakk> b \<ge> 2; k > 0 \<rbrakk> \<Longrightarrow>
   floor (log b (real k)) = n \<longleftrightarrow> b^n \<le> k \<and> k < b^(n+1)"
 by (auto simp: floor_log_eq_powr_iff powr_add powr_realpow
                of_nat_power[symmetric] of_nat_mult[symmetric] ac_simps
          simp del: of_nat_power of_nat_mult)
 
 lemma floor_log_nat_eq_if: fixes b n k :: nat
   assumes "b^n \<le> k" "k < b^(n+1)" "b \<ge> 2"
   shows "floor (log b (real k)) = n"
 proof -
   have "k \<ge> 1" using assms(1,3) one_le_power[of b n] by linarith
   with assms show ?thesis by(simp add: floor_log_nat_eq_powr_iff)
 qed
 
 lemma ceiling_log_eq_powr_iff: "\<lbrakk> x > 0; b > 1 \<rbrakk>
   \<Longrightarrow> \<lceil>log b x\<rceil> = int k + 1 \<longleftrightarrow> b powr k < x \<and> x \<le> b powr (k + 1)"
 by (auto simp: ceiling_eq_iff powr_less_iff le_powr_iff)
 
 lemma ceiling_log_nat_eq_powr_iff: fixes b n k :: nat
   shows "\<lbrakk> b \<ge> 2; k > 0 \<rbrakk> \<Longrightarrow>
   ceiling (log b (real k)) = int n + 1 \<longleftrightarrow> (b^n < k \<and> k \<le> b^(n+1))"
 using ceiling_log_eq_powr_iff
 by (auto simp: powr_add powr_realpow of_nat_power[symmetric] of_nat_mult[symmetric] ac_simps
          simp del: of_nat_power of_nat_mult)
 
 lemma ceiling_log_nat_eq_if: fixes b n k :: nat
   assumes "b^n < k" "k \<le> b^(n+1)" "b \<ge> 2"
   shows "ceiling (log b (real k)) = int n + 1"
 proof -
   have "k \<ge> 1" using assms(1,3) one_le_power[of b n] by linarith
   with assms show ?thesis by(simp add: ceiling_log_nat_eq_powr_iff)
 qed
 
 lemma floor_log2_div2: fixes n :: nat assumes "n \<ge> 2"
 shows "floor(log 2 n) = floor(log 2 (n div 2)) + 1"
 proof cases
   assume "n=2" thus ?thesis by simp
 next
   let ?m = "n div 2"
   assume "n\<noteq>2"
   hence "1 \<le> ?m" using assms by arith
   then obtain i where i: "2 ^ i \<le> ?m" "?m < 2 ^ (i + 1)"
     using ex_power_ivl1[of 2 ?m] by auto
   have "2^(i+1) \<le> 2*?m" using i(1) by simp
   also have "2*?m \<le> n" by arith
   finally have *: "2^(i+1) \<le> \<dots>" .
   have "n < 2^(i+1+1)" using i(2) by simp
   from floor_log_nat_eq_if[OF * this] floor_log_nat_eq_if[OF i]
   show ?thesis by simp
 qed
 
 lemma ceiling_log2_div2: assumes "n \<ge> 2"
 shows "ceiling(log 2 (real n)) = ceiling(log 2 ((n-1) div 2 + 1)) + 1"
 proof cases
   assume "n=2" thus ?thesis by simp
 next
   let ?m = "(n-1) div 2 + 1"
   assume "n\<noteq>2"
   hence "2 \<le> ?m" using assms by arith
   then obtain i where i: "2 ^ i < ?m" "?m \<le> 2 ^ (i + 1)"
     using ex_power_ivl2[of 2 ?m] by auto
   have "n \<le> 2*?m" by arith
   also have "2*?m \<le> 2 ^ ((i+1)+1)" using i(2) by simp
   finally have *: "n \<le> \<dots>" .
   have "2^(i+1) < n" using i(1) by (auto simp: less_Suc_eq_0_disj)
   from ceiling_log_nat_eq_if[OF this *] ceiling_log_nat_eq_if[OF i]
   show ?thesis by simp
 qed
 
 lemma powr_real_of_int:
   "x > 0 \<Longrightarrow> x powr real_of_int n = (if n \<ge> 0 then x ^ nat n else inverse (x ^ nat (- n)))"
   using powr_realpow[of x "nat n"] powr_realpow[of x "nat (-n)"]
   by (auto simp: field_simps powr_minus)
 
 lemma powr_numeral [simp]: "0 \<le> x \<Longrightarrow> x powr (numeral n :: real) = x ^ (numeral n)"
   by (metis less_le power_zero_numeral powr_0 of_nat_numeral powr_realpow)
 
 lemma powr_int:
   assumes "x > 0"
   shows "x powr i = (if i \<ge> 0 then x ^ nat i else 1 / x ^ nat (-i))"
 proof (cases "i < 0")
   case True
   have r: "x powr i = 1 / x powr (- i)"
     by (simp add: powr_minus field_simps)
   show ?thesis using \<open>i < 0\<close> \<open>x > 0\<close>
     by (simp add: r field_simps powr_realpow[symmetric])
 next
   case False
   then show ?thesis
     by (simp add: assms powr_realpow[symmetric])
 qed
 
 definition powr_real :: "real \<Rightarrow> real \<Rightarrow> real"
   where [code_abbrev, simp]: "powr_real = Transcendental.powr"
 
 lemma compute_powr_real [code]:
   "powr_real b i =
     (if b \<le> 0 then Code.abort (STR ''powr_real with nonpositive base'') (\<lambda>_. powr_real b i)
      else if \<lfloor>i\<rfloor> = i then (if 0 \<le> i then b ^ nat \<lfloor>i\<rfloor> else 1 / b ^ nat \<lfloor>- i\<rfloor>)
      else Code.abort (STR ''powr_real with non-integer exponent'') (\<lambda>_. powr_real b i))"
     for b i :: real
   by (auto simp: powr_int)
 
 lemma powr_one: "0 \<le> x \<Longrightarrow> x powr 1 = x"
   for x :: real
   using powr_realpow [of x 1] by simp
 
 lemma powr_neg_one: "0 < x \<Longrightarrow> x powr - 1 = 1 / x"
   for x :: real
   using powr_int [of x "- 1"] by simp
 
 lemma powr_neg_numeral: "0 < x \<Longrightarrow> x powr - numeral n = 1 / x ^ numeral n"
   for x :: real
   using powr_int [of x "- numeral n"] by simp
 
 lemma root_powr_inverse: "0 < n \<Longrightarrow> 0 < x \<Longrightarrow> root n x = x powr (1/n)"
   by (rule real_root_pos_unique) (auto simp: powr_realpow[symmetric] powr_powr)
 
 lemma ln_powr: "x \<noteq> 0 \<Longrightarrow> ln (x powr y) = y * ln x"
   for x :: real
   by (simp add: powr_def)
 
 lemma ln_root: "n > 0 \<Longrightarrow> b > 0 \<Longrightarrow> ln (root n b) =  ln b / n"
   by (simp add: root_powr_inverse ln_powr)
 
 lemma ln_sqrt: "0 < x \<Longrightarrow> ln (sqrt x) = ln x / 2"
   by (simp add: ln_powr ln_powr[symmetric] mult.commute)
 
 lemma log_root: "n > 0 \<Longrightarrow> a > 0 \<Longrightarrow> log b (root n a) =  log b a / n"
   by (simp add: log_def ln_root)
 
 lemma log_powr: "x \<noteq> 0 \<Longrightarrow> log b (x powr y) = y * log b x"
   by (simp add: log_def ln_powr)
 
 (* [simp] is not worth it, interferes with some proofs *)
 lemma log_nat_power: "0 < x \<Longrightarrow> log b (x^n) = real n * log b x"
   by (simp add: log_powr powr_realpow [symmetric])
 
 lemma log_of_power_eq:
   assumes "m = b ^ n" "b > 1"
   shows "n = log b (real m)"
 proof -
   have "n = log b (b ^ n)" using assms(2) by (simp add: log_nat_power)
   also have "\<dots> = log b m" using assms by simp
   finally show ?thesis .
 qed
 
 lemma log2_of_power_eq: "m = 2 ^ n \<Longrightarrow> n = log 2 m" for m n :: nat
 using log_of_power_eq[of _ 2] by simp
 
 lemma log_base_change: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> log b x = log a x / log a b"
   by (simp add: log_def)
 
 lemma log_base_pow: "0 < a \<Longrightarrow> log (a ^ n) x = log a x / n"
   by (simp add: log_def ln_realpow)
 
 lemma log_base_powr: "a \<noteq> 0 \<Longrightarrow> log (a powr b) x = log a x / b"
   by (simp add: log_def ln_powr)
 
 lemma log_base_root: "n > 0 \<Longrightarrow> b > 0 \<Longrightarrow> log (root n b) x = n * (log b x)"
   by (simp add: log_def ln_root)
 
 lemma ln_bound: "0 < x \<Longrightarrow> ln x \<le> x" for x :: real
   using ln_le_minus_one by force
 
 lemma powr_mono:
   fixes x :: real
   assumes "a \<le> b" and "1 \<le> x" shows "x powr a \<le> x powr b"
   using assms less_eq_real_def by auto
 
 lemma ge_one_powr_ge_zero: "1 \<le> x \<Longrightarrow> 0 \<le> a \<Longrightarrow> 1 \<le> x powr a"
   for x :: real
   using powr_mono by fastforce
 
 lemma powr_less_mono2: "0 < a \<Longrightarrow> 0 \<le> x \<Longrightarrow> x < y \<Longrightarrow> x powr a < y powr a"
   for x :: real
   by (simp add: powr_def)
 
 lemma powr_less_mono2_neg: "a < 0 \<Longrightarrow> 0 < x \<Longrightarrow> x < y \<Longrightarrow> y powr a < x powr a"
   for x :: real
   by (simp add: powr_def)
 
 lemma powr_mono2: "x powr a \<le> y powr a" if "0 \<le> a" "0 \<le> x" "x \<le> y"
   for x :: real
   using less_eq_real_def powr_less_mono2 that by auto
 
 lemma powr_le1: "0 \<le> a \<Longrightarrow> 0 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> x powr a \<le> 1"
   for x :: real
   using powr_mono2 by fastforce
 
 lemma powr_mono2':
   fixes a x y :: real
   assumes "a \<le> 0" "x > 0" "x \<le> y"
   shows "x powr a \<ge> y powr a"
 proof -
   from assms have "x powr - a \<le> y powr - a"
     by (intro powr_mono2) simp_all
   with assms show ?thesis
     by (auto simp: powr_minus field_simps)
 qed
 
 lemma powr_mono_both:
   fixes x :: real
   assumes "0 \<le> a" "a \<le> b" "1 \<le> x" "x \<le> y"
     shows "x powr a \<le> y powr b"
   by (meson assms order.trans powr_mono powr_mono2 zero_le_one)
 
 lemma powr_inj: "0 < a \<Longrightarrow> a \<noteq> 1 \<Longrightarrow> a powr x = a powr y \<longleftrightarrow> x = y"
   for x :: real
   unfolding powr_def exp_inj_iff by simp
 
 lemma powr_half_sqrt: "0 \<le> x \<Longrightarrow> x powr (1/2) = sqrt x"
   by (simp add: powr_def root_powr_inverse sqrt_def)
 
 lemma square_powr_half [simp]:
   fixes x::real shows "x\<^sup>2 powr (1/2) = \<bar>x\<bar>"
   by (simp add: powr_half_sqrt)
 
 lemma ln_powr_bound: "1 \<le> x \<Longrightarrow> 0 < a \<Longrightarrow> ln x \<le> (x powr a) / a"
   for x :: real
   by (metis exp_gt_zero linear ln_eq_zero_iff ln_exp ln_less_self ln_powr mult.commute
       mult_imp_le_div_pos not_less powr_gt_zero)
 
 lemma ln_powr_bound2:
   fixes x :: real
   assumes "1 < x" and "0 < a"
   shows "(ln x) powr a \<le> (a powr a) * x"
 proof -
   from assms have "ln x \<le> (x powr (1 / a)) / (1 / a)"
     by (metis less_eq_real_def ln_powr_bound zero_less_divide_1_iff)
   also have "\<dots> = a * (x powr (1 / a))"
     by simp
   finally have "(ln x) powr a \<le> (a * (x powr (1 / a))) powr a"
     by (metis assms less_imp_le ln_gt_zero powr_mono2)
   also have "\<dots> = (a powr a) * ((x powr (1 / a)) powr a)"
     using assms powr_mult by auto
   also have "(x powr (1 / a)) powr a = x powr ((1 / a) * a)"
     by (rule powr_powr)
   also have "\<dots> = x" using assms
     by auto
   finally show ?thesis .
 qed
 
 lemma tendsto_powr:
   fixes a b :: real
   assumes f: "(f \<longlongrightarrow> a) F"
     and g: "(g \<longlongrightarrow> b) F"
     and a: "a \<noteq> 0"
   shows "((\<lambda>x. f x powr g x) \<longlongrightarrow> a powr b) F"
   unfolding powr_def
 proof (rule filterlim_If)
   from f show "((\<lambda>x. 0) \<longlongrightarrow> (if a = 0 then 0 else exp (b * ln a))) (inf F (principal {x. f x = 0}))"
     by simp (auto simp: filterlim_iff eventually_inf_principal elim: eventually_mono dest: t1_space_nhds)
   from f g a show "((\<lambda>x. exp (g x * ln (f x))) \<longlongrightarrow> (if a = 0 then 0 else exp (b * ln a)))
       (inf F (principal {x. f x \<noteq> 0}))"
     by (auto intro!: tendsto_intros intro: tendsto_mono inf_le1)
 qed
 
 lemma tendsto_powr'[tendsto_intros]:
   fixes a :: real
   assumes f: "(f \<longlongrightarrow> a) F"
     and g: "(g \<longlongrightarrow> b) F"
     and a: "a \<noteq> 0 \<or> (b > 0 \<and> eventually (\<lambda>x. f x \<ge> 0) F)"
   shows "((\<lambda>x. f x powr g x) \<longlongrightarrow> a powr b) F"
 proof -
   from a consider "a \<noteq> 0" | "a = 0" "b > 0" "eventually (\<lambda>x. f x \<ge> 0) F"
     by auto
   then show ?thesis
   proof cases
     case 1
     with f g show ?thesis by (rule tendsto_powr)
   next
     case 2
     have "((\<lambda>x. if f x = 0 then 0 else exp (g x * ln (f x))) \<longlongrightarrow> 0) F"
     proof (intro filterlim_If)
       have "filterlim f (principal {0<..}) (inf F (principal {z. f z \<noteq> 0}))"
         using \<open>eventually (\<lambda>x. f x \<ge> 0) F\<close>
         by (auto simp: filterlim_iff eventually_inf_principal
             eventually_principal elim: eventually_mono)
       moreover have "filterlim f (nhds a) (inf F (principal {z. f z \<noteq> 0}))"
         by (rule tendsto_mono[OF _ f]) simp_all
       ultimately have f: "filterlim f (at_right 0) (inf F (principal {x. f x \<noteq> 0}))"
         by (simp add: at_within_def filterlim_inf \<open>a = 0\<close>)
       have g: "(g \<longlongrightarrow> b) (inf F (principal {z. f z \<noteq> 0}))"
         by (rule tendsto_mono[OF _ g]) simp_all
       show "((\<lambda>x. exp (g x * ln (f x))) \<longlongrightarrow> 0) (inf F (principal {x. f x \<noteq> 0}))"
         by (rule filterlim_compose[OF exp_at_bot] filterlim_tendsto_pos_mult_at_bot
                  filterlim_compose[OF ln_at_0] f g \<open>b > 0\<close>)+
     qed simp_all
     with \<open>a = 0\<close> show ?thesis
       by (simp add: powr_def)
   qed
 qed
 
 lemma continuous_powr:
   assumes "continuous F f"
     and "continuous F g"
     and "f (Lim F (\<lambda>x. x)) \<noteq> 0"
   shows "continuous F (\<lambda>x. (f x) powr (g x :: real))"
   using assms unfolding continuous_def by (rule tendsto_powr)
 
 lemma continuous_at_within_powr[continuous_intros]:
   fixes f g :: "_ \<Rightarrow> real"
   assumes "continuous (at a within s) f"
     and "continuous (at a within s) g"
     and "f a \<noteq> 0"
   shows "continuous (at a within s) (\<lambda>x. (f x) powr (g x))"
   using assms unfolding continuous_within by (rule tendsto_powr)
 
 lemma isCont_powr[continuous_intros, simp]:
   fixes f g :: "_ \<Rightarrow> real"
   assumes "isCont f a" "isCont g a" "f a \<noteq> 0"
   shows "isCont (\<lambda>x. (f x) powr g x) a"
   using assms unfolding continuous_at by (rule tendsto_powr)
 
 lemma continuous_on_powr[continuous_intros]:
   fixes f g :: "_ \<Rightarrow> real"
   assumes "continuous_on s f" "continuous_on s g" and "\<forall>x\<in>s. f x \<noteq> 0"
   shows "continuous_on s (\<lambda>x. (f x) powr (g x))"
   using assms unfolding continuous_on_def by (fast intro: tendsto_powr)
 
 lemma tendsto_powr2:
   fixes a :: real
   assumes f: "(f \<longlongrightarrow> a) F"
     and g: "(g \<longlongrightarrow> b) F"
     and "\<forall>\<^sub>F x in F. 0 \<le> f x"
     and b: "0 < b"
   shows "((\<lambda>x. f x powr g x) \<longlongrightarrow> a powr b) F"
   using tendsto_powr'[of f a F g b] assms by auto
 
 lemma has_derivative_powr[derivative_intros]:
   assumes g[derivative_intros]: "(g has_derivative g') (at x within X)"
     and f[derivative_intros]:"(f has_derivative f') (at x within X)"
   assumes pos: "0 < g x" and "x \<in> X"
   shows "((\<lambda>x. g x powr f x::real) has_derivative (\<lambda>h. (g x powr f x) * (f' h * ln (g x) + g' h * f x / g x))) (at x within X)"
 proof -
   have "\<forall>\<^sub>F x in at x within X. g x > 0"
     by (rule order_tendstoD[OF _ pos])
       (rule has_derivative_continuous[OF g, unfolded continuous_within])
   then obtain d where "d > 0" and pos': "\<And>x'. x' \<in> X \<Longrightarrow> dist x' x < d \<Longrightarrow> 0 < g x'"
     using pos unfolding eventually_at by force
   have "((\<lambda>x. exp (f x * ln (g x))) has_derivative
     (\<lambda>h. (g x powr f x) * (f' h * ln (g x) + g' h * f x / g x))) (at x within X)"
     using pos
     by (auto intro!: derivative_eq_intros simp: field_split_simps powr_def)
   then show ?thesis
     by (rule has_derivative_transform_within[OF _ \<open>d > 0\<close> \<open>x \<in> X\<close>]) (auto simp: powr_def dest: pos')
 qed
 
 lemma DERIV_powr:
   fixes r :: real
   assumes g: "DERIV g x :> m"
     and pos: "g x > 0"
     and f: "DERIV f x :> r"
   shows "DERIV (\<lambda>x. g x powr f x) x :> (g x powr f x) * (r * ln (g x) + m * f x / g x)"
   using assms
   by (auto intro!: derivative_eq_intros ext simp: has_field_derivative_def algebra_simps)
 
 lemma DERIV_fun_powr:
   fixes r :: real
   assumes g: "DERIV g x :> m"
     and pos: "g x > 0"
   shows "DERIV (\<lambda>x. (g x) powr r) x :> r * (g x) powr (r - of_nat 1) * m"
   using DERIV_powr[OF g pos DERIV_const, of r] pos
   by (simp add: powr_diff field_simps)
 
 lemma has_real_derivative_powr:
   assumes "z > 0"
   shows "((\<lambda>z. z powr r) has_real_derivative r * z powr (r - 1)) (at z)"
 proof (subst DERIV_cong_ev[OF refl _ refl])
   from assms have "eventually (\<lambda>z. z \<noteq> 0) (nhds z)"
     by (intro t1_space_nhds) auto
   then show "eventually (\<lambda>z. z powr r = exp (r * ln z)) (nhds z)"
     unfolding powr_def by eventually_elim simp
   from assms show "((\<lambda>z. exp (r * ln z)) has_real_derivative r * z powr (r - 1)) (at z)"
     by (auto intro!: derivative_eq_intros simp: powr_def field_simps exp_diff)
 qed
 
 declare has_real_derivative_powr[THEN DERIV_chain2, derivative_intros]
 
 lemma tendsto_zero_powrI:
   assumes "(f \<longlongrightarrow> (0::real)) F" "(g \<longlongrightarrow> b) F" "\<forall>\<^sub>F x in F. 0 \<le> f x" "0 < b"
   shows "((\<lambda>x. f x powr g x) \<longlongrightarrow> 0) F"
   using tendsto_powr2[OF assms] by simp
 
 lemma continuous_on_powr':
   fixes f g :: "_ \<Rightarrow> real"
   assumes "continuous_on s f" "continuous_on s g"
     and "\<forall>x\<in>s. f x \<ge> 0 \<and> (f x = 0 \<longrightarrow> g x > 0)"
   shows "continuous_on s (\<lambda>x. (f x) powr (g x))"
   unfolding continuous_on_def
 proof
   fix x
   assume x: "x \<in> s"
   from assms x show "((\<lambda>x. f x powr g x) \<longlongrightarrow> f x powr g x) (at x within s)"
   proof (cases "f x = 0")
     case True
     from assms(3) have "eventually (\<lambda>x. f x \<ge> 0) (at x within s)"
       by (auto simp: at_within_def eventually_inf_principal)
     with True x assms show ?thesis
       by (auto intro!: tendsto_zero_powrI[of f _ g "g x"] simp: continuous_on_def)
   next
     case False
     with assms x show ?thesis
       by (auto intro!: tendsto_powr' simp: continuous_on_def)
   qed
 qed
 
 lemma tendsto_neg_powr:
   assumes "s < 0"
     and f: "LIM x F. f x :> at_top"
   shows "((\<lambda>x. f x powr s) \<longlongrightarrow> (0::real)) F"
 proof -
   have "((\<lambda>x. exp (s * ln (f x))) \<longlongrightarrow> (0::real)) F" (is "?X")
     by (auto intro!: filterlim_compose[OF exp_at_bot] filterlim_compose[OF ln_at_top]
         filterlim_tendsto_neg_mult_at_bot assms)
   also have "?X \<longleftrightarrow> ((\<lambda>x. f x powr s) \<longlongrightarrow> (0::real)) F"
     using f filterlim_at_top_dense[of f F]
     by (intro filterlim_cong[OF refl refl]) (auto simp: neq_iff powr_def elim: eventually_mono)
   finally show ?thesis .
 qed
 
 lemma tendsto_exp_limit_at_right: "((\<lambda>y. (1 + x * y) powr (1 / y)) \<longlongrightarrow> exp x) (at_right 0)"
   for x :: real
 proof (cases "x = 0")
   case True
   then show ?thesis by simp
 next
   case False
   have "((\<lambda>y. ln (1 + x * y)::real) has_real_derivative 1 * x) (at 0)"
     by (auto intro!: derivative_eq_intros)
   then have "((\<lambda>y. ln (1 + x * y) / y) \<longlongrightarrow> x) (at 0)"
     by (auto simp: has_field_derivative_def field_has_derivative_at)
   then have *: "((\<lambda>y. exp (ln (1 + x * y) / y)) \<longlongrightarrow> exp x) (at 0)"
     by (rule tendsto_intros)
   then show ?thesis
   proof (rule filterlim_mono_eventually)
     show "eventually (\<lambda>xa. exp (ln (1 + x * xa) / xa) = (1 + x * xa) powr (1 / xa)) (at_right 0)"
       unfolding eventually_at_right[OF zero_less_one]
       using False
       by (intro exI[of _ "1 / \<bar>x\<bar>"]) (auto simp: field_simps powr_def abs_if add_nonneg_eq_0_iff)
   qed (simp_all add: at_eq_sup_left_right)
 qed
 
 lemma tendsto_exp_limit_at_top: "((\<lambda>y. (1 + x / y) powr y) \<longlongrightarrow> exp x) at_top"
   for x :: real
   by (simp add: filterlim_at_top_to_right inverse_eq_divide tendsto_exp_limit_at_right)
 
 lemma tendsto_exp_limit_sequentially: "(\<lambda>n. (1 + x / n) ^ n) \<longlonglongrightarrow> exp x"
   for x :: real
 proof (rule filterlim_mono_eventually)
   from reals_Archimedean2 [of "\<bar>x\<bar>"] obtain n :: nat where *: "real n > \<bar>x\<bar>" ..
   then have "eventually (\<lambda>n :: nat. 0 < 1 + x / real n) at_top"
     by (intro eventually_sequentiallyI [of n]) (auto simp: field_split_simps)
   then show "eventually (\<lambda>n. (1 + x / n) powr n = (1 + x / n) ^ n) at_top"
     by (rule eventually_mono) (erule powr_realpow)
   show "(\<lambda>n. (1 + x / real n) powr real n) \<longlonglongrightarrow> exp x"
     by (rule filterlim_compose [OF tendsto_exp_limit_at_top filterlim_real_sequentially])
 qed auto
 
 
 subsection \<open>Sine and Cosine\<close>
 
 definition sin_coeff :: "nat \<Rightarrow> real"
   where "sin_coeff = (\<lambda>n. if even n then 0 else (- 1) ^ ((n - Suc 0) div 2) / (fact n))"
 
 definition cos_coeff :: "nat \<Rightarrow> real"
   where "cos_coeff = (\<lambda>n. if even n then ((- 1) ^ (n div 2)) / (fact n) else 0)"
 
 definition sin :: "'a \<Rightarrow> 'a::{real_normed_algebra_1,banach}"
   where "sin = (\<lambda>x. \<Sum>n. sin_coeff n *\<^sub>R x^n)"
 
 definition cos :: "'a \<Rightarrow> 'a::{real_normed_algebra_1,banach}"
   where "cos = (\<lambda>x. \<Sum>n. cos_coeff n *\<^sub>R x^n)"
 
 lemma sin_coeff_0 [simp]: "sin_coeff 0 = 0"
   unfolding sin_coeff_def by simp
 
 lemma cos_coeff_0 [simp]: "cos_coeff 0 = 1"
   unfolding cos_coeff_def by simp
 
 lemma sin_coeff_Suc: "sin_coeff (Suc n) = cos_coeff n / real (Suc n)"
   unfolding cos_coeff_def sin_coeff_def
   by (simp del: mult_Suc)
 
 lemma cos_coeff_Suc: "cos_coeff (Suc n) = - sin_coeff n / real (Suc n)"
   unfolding cos_coeff_def sin_coeff_def
   by (simp del: mult_Suc) (auto elim: oddE)
 
 lemma summable_norm_sin: "summable (\<lambda>n. norm (sin_coeff n *\<^sub>R x^n))"
   for x :: "'a::{real_normed_algebra_1,banach}"
 proof (rule summable_comparison_test [OF _ summable_norm_exp])
   show "\<exists>N. \<forall>n\<ge>N. norm (norm (sin_coeff n *\<^sub>R x ^ n)) \<le> norm (x ^ n /\<^sub>R fact n)"
     unfolding sin_coeff_def
     by (auto simp: divide_inverse abs_mult power_abs [symmetric] zero_le_mult_iff)
 qed
 
 lemma summable_norm_cos: "summable (\<lambda>n. norm (cos_coeff n *\<^sub>R x^n))"
   for x :: "'a::{real_normed_algebra_1,banach}"
 proof (rule summable_comparison_test [OF _ summable_norm_exp])
   show "\<exists>N. \<forall>n\<ge>N. norm (norm (cos_coeff n *\<^sub>R x ^ n)) \<le> norm (x ^ n /\<^sub>R fact n)"
     unfolding cos_coeff_def
     by (auto simp: divide_inverse abs_mult power_abs [symmetric] zero_le_mult_iff)
 qed
 
 
 lemma sin_converges: "(\<lambda>n. sin_coeff n *\<^sub>R x^n) sums sin x"
   unfolding sin_def
   by (metis (full_types) summable_norm_cancel summable_norm_sin summable_sums)
 
 lemma cos_converges: "(\<lambda>n. cos_coeff n *\<^sub>R x^n) sums cos x"
   unfolding cos_def
   by (metis (full_types) summable_norm_cancel summable_norm_cos summable_sums)
 
 lemma sin_of_real: "sin (of_real x) = of_real (sin x)"
   for x :: real
 proof -
   have "(\<lambda>n. of_real (sin_coeff n *\<^sub>R  x^n)) = (\<lambda>n. sin_coeff n *\<^sub>R  (of_real x)^n)"
   proof
     show "of_real (sin_coeff n *\<^sub>R  x^n) = sin_coeff n *\<^sub>R of_real x^n" for n
       by (simp add: scaleR_conv_of_real)
   qed
   also have "\<dots> sums (sin (of_real x))"
     by (rule sin_converges)
   finally have "(\<lambda>n. of_real (sin_coeff n *\<^sub>R x^n)) sums (sin (of_real x))" .
   then show ?thesis
     using sums_unique2 sums_of_real [OF sin_converges] by blast
 qed
 
 corollary sin_in_Reals [simp]: "z \<in> \<real> \<Longrightarrow> sin z \<in> \<real>"
   by (metis Reals_cases Reals_of_real sin_of_real)
 
 lemma cos_of_real: "cos (of_real x) = of_real (cos x)"
   for x :: real
 proof -
   have "(\<lambda>n. of_real (cos_coeff n *\<^sub>R  x^n)) = (\<lambda>n. cos_coeff n *\<^sub>R  (of_real x)^n)"
   proof
     show "of_real (cos_coeff n *\<^sub>R  x^n) = cos_coeff n *\<^sub>R of_real x^n" for n
       by (simp add: scaleR_conv_of_real)
   qed
   also have "\<dots> sums (cos (of_real x))"
     by (rule cos_converges)
   finally have "(\<lambda>n. of_real (cos_coeff n *\<^sub>R x^n)) sums (cos (of_real x))" .
   then show ?thesis
     using sums_unique2 sums_of_real [OF cos_converges]
     by blast
 qed
 
 corollary cos_in_Reals [simp]: "z \<in> \<real> \<Longrightarrow> cos z \<in> \<real>"
   by (metis Reals_cases Reals_of_real cos_of_real)
 
 lemma diffs_sin_coeff: "diffs sin_coeff = cos_coeff"
   by (simp add: diffs_def sin_coeff_Suc del: of_nat_Suc)
 
 lemma diffs_cos_coeff: "diffs cos_coeff = (\<lambda>n. - sin_coeff n)"
   by (simp add: diffs_def cos_coeff_Suc del: of_nat_Suc)
 
 lemma sin_int_times_real: "sin (of_int m * of_real x) = of_real (sin (of_int m * x))"
   by (metis sin_of_real of_real_mult of_real_of_int_eq)
 
 lemma cos_int_times_real: "cos (of_int m * of_real x) = of_real (cos (of_int m * x))"
   by (metis cos_of_real of_real_mult of_real_of_int_eq)
 
 text \<open>Now at last we can get the derivatives of exp, sin and cos.\<close>
 
 lemma DERIV_sin [simp]: "DERIV sin x :> cos x"
   for x :: "'a::{real_normed_field,banach}"
   unfolding sin_def cos_def scaleR_conv_of_real
   apply (rule DERIV_cong)
    apply (rule termdiffs [where K="of_real (norm x) + 1 :: 'a"])
       apply (simp_all add: norm_less_p1 diffs_of_real diffs_sin_coeff diffs_cos_coeff
               summable_minus_iff scaleR_conv_of_real [symmetric]
               summable_norm_sin [THEN summable_norm_cancel]
               summable_norm_cos [THEN summable_norm_cancel])
   done
 
 declare DERIV_sin[THEN DERIV_chain2, derivative_intros]
   and DERIV_sin[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]
 
 lemmas has_derivative_sin[derivative_intros] = DERIV_sin[THEN DERIV_compose_FDERIV]
 
 lemma DERIV_cos [simp]: "DERIV cos x :> - sin x"
   for x :: "'a::{real_normed_field,banach}"
   unfolding sin_def cos_def scaleR_conv_of_real
   apply (rule DERIV_cong)
    apply (rule termdiffs [where K="of_real (norm x) + 1 :: 'a"])
       apply (simp_all add: norm_less_p1 diffs_of_real diffs_minus suminf_minus
               diffs_sin_coeff diffs_cos_coeff
               summable_minus_iff scaleR_conv_of_real [symmetric]
               summable_norm_sin [THEN summable_norm_cancel]
               summable_norm_cos [THEN summable_norm_cancel])
   done
 
 declare DERIV_cos[THEN DERIV_chain2, derivative_intros]
   and DERIV_cos[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]
 
 lemmas has_derivative_cos[derivative_intros] = DERIV_cos[THEN DERIV_compose_FDERIV]
 
 lemma isCont_sin: "isCont sin x"
   for x :: "'a::{real_normed_field,banach}"
   by (rule DERIV_sin [THEN DERIV_isCont])
 
 lemma continuous_on_sin_real: "continuous_on {a..b} sin" for a::real
   using continuous_at_imp_continuous_on isCont_sin by blast
 
 lemma isCont_cos: "isCont cos x"
   for x :: "'a::{real_normed_field,banach}"
   by (rule DERIV_cos [THEN DERIV_isCont])
 
 lemma continuous_on_cos_real: "continuous_on {a..b} cos" for a::real
   using continuous_at_imp_continuous_on isCont_cos by blast
 
 
 context
   fixes f :: "'a::t2_space \<Rightarrow> 'b::{real_normed_field,banach}"
 begin
 
 lemma isCont_sin' [simp]: "isCont f a \<Longrightarrow> isCont (\<lambda>x. sin (f x)) a"
   by (rule isCont_o2 [OF _ isCont_sin])
 
 lemma isCont_cos' [simp]: "isCont f a \<Longrightarrow> isCont (\<lambda>x. cos (f x)) a"
   by (rule isCont_o2 [OF _ isCont_cos])
 
 lemma tendsto_sin [tendsto_intros]: "(f \<longlongrightarrow> a) F \<Longrightarrow> ((\<lambda>x. sin (f x)) \<longlongrightarrow> sin a) F"
   by (rule isCont_tendsto_compose [OF isCont_sin])
 
 lemma tendsto_cos [tendsto_intros]: "(f \<longlongrightarrow> a) F \<Longrightarrow> ((\<lambda>x. cos (f x)) \<longlongrightarrow> cos a) F"
   by (rule isCont_tendsto_compose [OF isCont_cos])
 
 lemma continuous_sin [continuous_intros]: "continuous F f \<Longrightarrow> continuous F (\<lambda>x. sin (f x))"
   unfolding continuous_def by (rule tendsto_sin)
 
 lemma continuous_on_sin [continuous_intros]: "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. sin (f x))"
   unfolding continuous_on_def by (auto intro: tendsto_sin)
 
 lemma continuous_cos [continuous_intros]: "continuous F f \<Longrightarrow> continuous F (\<lambda>x. cos (f x))"
   unfolding continuous_def by (rule tendsto_cos)
 
 lemma continuous_on_cos [continuous_intros]: "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. cos (f x))"
   unfolding continuous_on_def by (auto intro: tendsto_cos)
 
 end
 
 lemma continuous_within_sin: "continuous (at z within s) sin"     
   for z :: "'a::{real_normed_field,banach}"
   by (simp add: continuous_within tendsto_sin)
 
 lemma continuous_within_cos: "continuous (at z within s) cos"
   for z :: "'a::{real_normed_field,banach}"
   by (simp add: continuous_within tendsto_cos)
 
 
 subsection \<open>Properties of Sine and Cosine\<close>
 
 lemma sin_zero [simp]: "sin 0 = 0"
   by (simp add: sin_def sin_coeff_def scaleR_conv_of_real)
 
 lemma cos_zero [simp]: "cos 0 = 1"
   by (simp add: cos_def cos_coeff_def scaleR_conv_of_real)
 
 lemma DERIV_fun_sin: "DERIV g x :> m \<Longrightarrow> DERIV (\<lambda>x. sin (g x)) x :> cos (g x) * m"
   by (fact derivative_intros)
 
 lemma DERIV_fun_cos: "DERIV g x :> m \<Longrightarrow> DERIV (\<lambda>x. cos(g x)) x :> - sin (g x) * m"
   by (fact derivative_intros)
 
 
 subsection \<open>Deriving the Addition Formulas\<close>
 
 text \<open>The product of two cosine series.\<close>
 lemma cos_x_cos_y:
   fixes x :: "'a::{real_normed_field,banach}"
   shows
     "(\<lambda>p. \<Sum>n\<le>p.
         if even p \<and> even n
         then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0)
       sums (cos x * cos y)"
 proof -
   have "(cos_coeff n * cos_coeff (p - n)) *\<^sub>R (x^n * y^(p - n)) =
     (if even p \<and> even n then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p - n)
      else 0)"
     if "n \<le> p" for n p :: nat
   proof -
     from that have *: "even n \<Longrightarrow> even p \<Longrightarrow>
         (-1) ^ (n div 2) * (-1) ^ ((p - n) div 2) = (-1 :: real) ^ (p div 2)"
       by (metis div_add power_add le_add_diff_inverse odd_add)
     with that show ?thesis
       by (auto simp: algebra_simps cos_coeff_def binomial_fact)
   qed
   then have "(\<lambda>p. \<Sum>n\<le>p. if even p \<and> even n
                   then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0) =
              (\<lambda>p. \<Sum>n\<le>p. (cos_coeff n * cos_coeff (p - n)) *\<^sub>R (x^n * y^(p-n)))"
     by simp
   also have "\<dots> = (\<lambda>p. \<Sum>n\<le>p. (cos_coeff n *\<^sub>R x^n) * (cos_coeff (p - n) *\<^sub>R y^(p-n)))"
     by (simp add: algebra_simps)
   also have "\<dots> sums (cos x * cos y)"
     using summable_norm_cos
     by (auto simp: cos_def scaleR_conv_of_real intro!: Cauchy_product_sums)
   finally show ?thesis .
 qed
 
 text \<open>The product of two sine series.\<close>
 lemma sin_x_sin_y:
   fixes x :: "'a::{real_normed_field,banach}"
   shows
     "(\<lambda>p. \<Sum>n\<le>p.
         if even p \<and> odd n
         then - ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n)
         else 0)
       sums (sin x * sin y)"
 proof -
   have "(sin_coeff n * sin_coeff (p - n)) *\<^sub>R (x^n * y^(p-n)) =
     (if even p \<and> odd n
      then -((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n)
      else 0)"
     if "n \<le> p" for n p :: nat
   proof -
     have "(-1) ^ ((n - Suc 0) div 2) * (-1) ^ ((p - Suc n) div 2) = - ((-1 :: real) ^ (p div 2))"
       if np: "odd n" "even p"
     proof -
       have "p > 0"
         using \<open>n \<le> p\<close> neq0_conv that(1) by blast
       then have \<section>: "(- 1::real) ^ (p div 2 - Suc 0) = - ((- 1) ^ (p div 2))"
         using \<open>even p\<close> by (auto simp add: dvd_def power_eq_if)
       from \<open>n \<le> p\<close> np have *: "n - Suc 0 + (p - Suc n) = p - Suc (Suc 0)" "Suc (Suc 0) \<le> p"
         by arith+
       have "(p - Suc (Suc 0)) div 2 = p div 2 - Suc 0"
         by simp
       with \<open>n \<le> p\<close> np  \<section> * show ?thesis
         by (simp add: flip: div_add power_add)
     qed
     then show ?thesis
       using \<open>n\<le>p\<close> by (auto simp: algebra_simps sin_coeff_def binomial_fact)
   qed
   then have "(\<lambda>p. \<Sum>n\<le>p. if even p \<and> odd n
                then - ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0) =
              (\<lambda>p. \<Sum>n\<le>p. (sin_coeff n * sin_coeff (p - n)) *\<^sub>R (x^n * y^(p-n)))"
     by simp
   also have "\<dots> = (\<lambda>p. \<Sum>n\<le>p. (sin_coeff n *\<^sub>R x^n) * (sin_coeff (p - n) *\<^sub>R y^(p-n)))"
     by (simp add: algebra_simps)
   also have "\<dots> sums (sin x * sin y)"
     using summable_norm_sin
     by (auto simp: sin_def scaleR_conv_of_real intro!: Cauchy_product_sums)
   finally show ?thesis .
 qed
 
 lemma sums_cos_x_plus_y:
   fixes x :: "'a::{real_normed_field,banach}"
   shows
     "(\<lambda>p. \<Sum>n\<le>p.
         if even p
         then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n)
         else 0)
       sums cos (x + y)"
 proof -
   have
     "(\<Sum>n\<le>p.
       if even p then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n)
       else 0) = cos_coeff p *\<^sub>R ((x + y) ^ p)"
     for p :: nat
   proof -
     have
       "(\<Sum>n\<le>p. if even p then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0) =
        (if even p then \<Sum>n\<le>p. ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0)"
       by simp
     also have "\<dots> =
        (if even p
         then of_real ((-1) ^ (p div 2) / (fact p)) * (\<Sum>n\<le>p. (p choose n) *\<^sub>R (x^n) * y^(p-n))
         else 0)"
       by (auto simp: sum_distrib_left field_simps scaleR_conv_of_real nonzero_of_real_divide)
     also have "\<dots> = cos_coeff p *\<^sub>R ((x + y) ^ p)"
       by (simp add: cos_coeff_def binomial_ring [of x y]  scaleR_conv_of_real atLeast0AtMost)
     finally show ?thesis .
   qed
   then have
     "(\<lambda>p. \<Sum>n\<le>p.
         if even p
         then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n)
         else 0) = (\<lambda>p. cos_coeff p *\<^sub>R ((x+y)^p))"
     by simp
    also have "\<dots> sums cos (x + y)"
     by (rule cos_converges)
    finally show ?thesis .
 qed
 
 theorem cos_add:
   fixes x :: "'a::{real_normed_field,banach}"
   shows "cos (x + y) = cos x * cos y - sin x * sin y"
 proof -
   have
     "(if even p \<and> even n
       then ((- 1) ^ (p div 2) * int (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0) -
      (if even p \<and> odd n
       then - ((- 1) ^ (p div 2) * int (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0) =
      (if even p then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0)"
     if "n \<le> p" for n p :: nat
     by simp
   then have
     "(\<lambda>p. \<Sum>n\<le>p. (if even p then ((-1) ^ (p div 2) * (p choose n) / (fact p)) *\<^sub>R (x^n) * y^(p-n) else 0))
       sums (cos x * cos y - sin x * sin y)"
     using sums_diff [OF cos_x_cos_y [of x y] sin_x_sin_y [of x y]]
     by (simp add: sum_subtractf [symmetric])
   then show ?thesis
     by (blast intro: sums_cos_x_plus_y sums_unique2)
 qed
 
 lemma sin_minus_converges: "(\<lambda>n. - (sin_coeff n *\<^sub>R (-x)^n)) sums sin x"
 proof -
   have [simp]: "\<And>n. - (sin_coeff n *\<^sub>R (-x)^n) = (sin_coeff n *\<^sub>R x^n)"
     by (auto simp: sin_coeff_def elim!: oddE)
   show ?thesis
     by (simp add: sin_def summable_norm_sin [THEN summable_norm_cancel, THEN summable_sums])
 qed
 
 lemma sin_minus [simp]: "sin (- x) = - sin x"
   for x :: "'a::{real_normed_algebra_1,banach}"
   using sin_minus_converges [of x]
   by (auto simp: sin_def summable_norm_sin [THEN summable_norm_cancel]
       suminf_minus sums_iff equation_minus_iff)
 
 lemma cos_minus_converges: "(\<lambda>n. (cos_coeff n *\<^sub>R (-x)^n)) sums cos x"
 proof -
   have [simp]: "\<And>n. (cos_coeff n *\<^sub>R (-x)^n) = (cos_coeff n *\<^sub>R x^n)"
     by (auto simp: Transcendental.cos_coeff_def elim!: evenE)
   show ?thesis
     by (simp add: cos_def summable_norm_cos [THEN summable_norm_cancel, THEN summable_sums])
 qed
 
 lemma cos_minus [simp]: "cos (-x) = cos x"
   for x :: "'a::{real_normed_algebra_1,banach}"
-  using cos_minus_converges [of x]
-  by (simp add: cos_def summable_norm_cos [THEN summable_norm_cancel]
-      suminf_minus sums_iff equation_minus_iff)
+  using cos_minus_converges [of x] by (metis cos_def sums_unique)
+
+lemma cos_abs_real [simp]: "cos \<bar>x :: real\<bar> = cos x"
+  by (simp add: abs_if)
 
 lemma sin_cos_squared_add [simp]: "(sin x)\<^sup>2 + (cos x)\<^sup>2 = 1"
   for x :: "'a::{real_normed_field,banach}"
   using cos_add [of x "-x"]
   by (simp add: power2_eq_square algebra_simps)
 
 lemma sin_cos_squared_add2 [simp]: "(cos x)\<^sup>2 + (sin x)\<^sup>2 = 1"
   for x :: "'a::{real_normed_field,banach}"
   by (subst add.commute, rule sin_cos_squared_add)
 
 lemma sin_cos_squared_add3 [simp]: "cos x * cos x + sin x * sin x = 1"
   for x :: "'a::{real_normed_field,banach}"
   using sin_cos_squared_add2 [unfolded power2_eq_square] .
 
 lemma sin_squared_eq: "(sin x)\<^sup>2 = 1 - (cos x)\<^sup>2"
   for x :: "'a::{real_normed_field,banach}"
   unfolding eq_diff_eq by (rule sin_cos_squared_add)
 
 lemma cos_squared_eq: "(cos x)\<^sup>2 = 1 - (sin x)\<^sup>2"
   for x :: "'a::{real_normed_field,banach}"
   unfolding eq_diff_eq by (rule sin_cos_squared_add2)
 
 lemma abs_sin_le_one [simp]: "\<bar>sin x\<bar> \<le> 1"
   for x :: real
   by (rule power2_le_imp_le) (simp_all add: sin_squared_eq)
 
 lemma sin_ge_minus_one [simp]: "- 1 \<le> sin x"
   for x :: real
   using abs_sin_le_one [of x] by (simp add: abs_le_iff)
 
 lemma sin_le_one [simp]: "sin x \<le> 1"
   for x :: real
   using abs_sin_le_one [of x] by (simp add: abs_le_iff)
 
 lemma abs_cos_le_one [simp]: "\<bar>cos x\<bar> \<le> 1"
   for x :: real
   by (rule power2_le_imp_le) (simp_all add: cos_squared_eq)
 
 lemma cos_ge_minus_one [simp]: "- 1 \<le> cos x"
   for x :: real
   using abs_cos_le_one [of x] by (simp add: abs_le_iff)
 
 lemma cos_le_one [simp]: "cos x \<le> 1"
   for x :: real
   using abs_cos_le_one [of x] by (simp add: abs_le_iff)
 
 lemma cos_diff: "cos (x - y) = cos x * cos y + sin x * sin y"
   for x :: "'a::{real_normed_field,banach}"
   using cos_add [of x "- y"] by simp
 
 lemma cos_double: "cos(2*x) = (cos x)\<^sup>2 - (sin x)\<^sup>2"
   for x :: "'a::{real_normed_field,banach}"
   using cos_add [where x=x and y=x] by (simp add: power2_eq_square)
 
 lemma sin_cos_le1: "\<bar>sin x * sin y + cos x * cos y\<bar> \<le> 1"
   for x :: real
   using cos_diff [of x y] by (metis abs_cos_le_one add.commute)
 
 lemma DERIV_fun_pow: "DERIV g x :> m \<Longrightarrow> DERIV (\<lambda>x. (g x) ^ n) x :> real n * (g x) ^ (n - 1) * m"
   by (auto intro!: derivative_eq_intros simp:)
 
 lemma DERIV_fun_exp: "DERIV g x :> m \<Longrightarrow> DERIV (\<lambda>x. exp (g x)) x :> exp (g x) * m"
   by (auto intro!: derivative_intros)
 
 
 subsection \<open>The Constant Pi\<close>
 
 definition pi :: real
   where "pi = 2 * (THE x. 0 \<le> x \<and> x \<le> 2 \<and> cos x = 0)"
 
 text \<open>Show that there's a least positive \<^term>\<open>x\<close> with \<^term>\<open>cos x = 0\<close>;
    hence define pi.\<close>
 
 lemma sin_paired: "(\<lambda>n. (- 1) ^ n / (fact (2 * n + 1)) * x ^ (2 * n + 1)) sums  sin x"
   for x :: real
 proof -
   have "(\<lambda>n. \<Sum>k = n*2..<n * 2 + 2. sin_coeff k * x ^ k) sums sin x"
     by (rule sums_group) (use sin_converges [of x, unfolded scaleR_conv_of_real] in auto)
   then show ?thesis
     by (simp add: sin_coeff_def ac_simps)
 qed
 
 lemma sin_gt_zero_02:
   fixes x :: real
   assumes "0 < x" and "x < 2"
   shows "0 < sin x"
 proof -
   let ?f = "\<lambda>n::nat. \<Sum>k = n*2..<n*2+2. (- 1) ^ k / (fact (2*k+1)) * x^(2*k+1)"
   have pos: "\<forall>n. 0 < ?f n"
   proof
     fix n :: nat
     let ?k2 = "real (Suc (Suc (4 * n)))"
     let ?k3 = "real (Suc (Suc (Suc (4 * n))))"
     have "x * x < ?k2 * ?k3"
       using assms by (intro mult_strict_mono', simp_all)
     then have "x * x * x * x ^ (n * 4) < ?k2 * ?k3 * x * x ^ (n * 4)"
       by (intro mult_strict_right_mono zero_less_power \<open>0 < x\<close>)
     then show "0 < ?f n"
       by (simp add: ac_simps divide_less_eq)
 qed
   have sums: "?f sums sin x"
     by (rule sin_paired [THEN sums_group]) simp
   show "0 < sin x"
     unfolding sums_unique [OF sums] using sums_summable [OF sums] pos by (simp add: suminf_pos)
 qed
 
 lemma cos_double_less_one: "0 < x \<Longrightarrow> x < 2 \<Longrightarrow> cos (2 * x) < 1"
   for x :: real
   using sin_gt_zero_02 [where x = x] by (auto simp: cos_squared_eq cos_double)
 
 lemma cos_paired: "(\<lambda>n. (- 1) ^ n / (fact (2 * n)) * x ^ (2 * n)) sums cos x"
   for x :: real
 proof -
   have "(\<lambda>n. \<Sum>k = n * 2..<n * 2 + 2. cos_coeff k * x ^ k) sums cos x"
     by (rule sums_group) (use cos_converges [of x, unfolded scaleR_conv_of_real] in auto)
   then show ?thesis
     by (simp add: cos_coeff_def ac_simps)
 qed
 
 lemma sum_pos_lt_pair:
   fixes f :: "nat \<Rightarrow> real"
   assumes f: "summable f" and fplus: "\<And>d. 0 < f (k + (Suc(Suc 0) * d)) + f (k + ((Suc (Suc 0) * d) + 1))"
   shows "sum f {..<k} < suminf f"
 proof -
   have "(\<lambda>n. \<Sum>n = n * Suc (Suc 0)..<n * Suc (Suc 0) +  Suc (Suc 0). f (n + k)) 
              sums (\<Sum>n. f (n + k))"
   proof (rule sums_group)
     show "(\<lambda>n. f (n + k)) sums (\<Sum>n. f (n + k))"
       by (simp add: f summable_iff_shift summable_sums)
   qed auto
   with fplus have "0 < (\<Sum>n. f (n + k))"
     apply (simp add: add.commute)
     apply (metis (no_types, lifting) suminf_pos summable_def sums_unique)
     done
   then show ?thesis
     by (simp add: f suminf_minus_initial_segment)
 qed
 
 lemma cos_two_less_zero [simp]: "cos 2 < (0::real)"
 proof -
   note fact_Suc [simp del]
   from sums_minus [OF cos_paired]
   have *: "(\<lambda>n. - ((- 1) ^ n * 2 ^ (2 * n) / fact (2 * n))) sums - cos (2::real)"
     by simp
   then have sm: "summable (\<lambda>n. - ((- 1::real) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
     by (rule sums_summable)
   have "0 < (\<Sum>n<Suc (Suc (Suc 0)). - ((- 1::real) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
     by (simp add: fact_num_eq_if power_eq_if)
   moreover have "(\<Sum>n<Suc (Suc (Suc 0)). - ((- 1::real) ^ n  * 2 ^ (2 * n) / (fact (2 * n)))) <
     (\<Sum>n. - ((- 1) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
   proof -
     {
       fix d
       let ?six4d = "Suc (Suc (Suc (Suc (Suc (Suc (4 * d))))))"
       have "(4::real) * (fact (?six4d)) < (Suc (Suc (?six4d)) * fact (Suc (?six4d)))"
         unfolding of_nat_mult by (rule mult_strict_mono) (simp_all add: fact_less_mono)
       then have "(4::real) * (fact (?six4d)) < (fact (Suc (Suc (?six4d))))"
         by (simp only: fact_Suc [of "Suc (?six4d)"] of_nat_mult of_nat_fact)
       then have "(4::real) * inverse (fact (Suc (Suc (?six4d)))) < inverse (fact (?six4d))"
         by (simp add: inverse_eq_divide less_divide_eq)
     }
     then show ?thesis
       by (force intro!: sum_pos_lt_pair [OF sm] simp add: divide_inverse algebra_simps)
   qed
   ultimately have "0 < (\<Sum>n. - ((- 1::real) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
     by (rule order_less_trans)
   moreover from * have "- cos 2 = (\<Sum>n. - ((- 1::real) ^ n * 2 ^ (2 * n) / (fact (2 * n))))"
     by (rule sums_unique)
   ultimately have "(0::real) < - cos 2" by simp
   then show ?thesis by simp
 qed
 
 lemmas cos_two_neq_zero [simp] = cos_two_less_zero [THEN less_imp_neq]
 lemmas cos_two_le_zero [simp] = cos_two_less_zero [THEN order_less_imp_le]
 
 lemma cos_is_zero: "\<exists>!x::real. 0 \<le> x \<and> x \<le> 2 \<and> cos x = 0"
 proof (rule ex_ex1I)
   show "\<exists>x::real. 0 \<le> x \<and> x \<le> 2 \<and> cos x = 0"
     by (rule IVT2) simp_all
 next
   fix a b :: real
   assume ab: "0 \<le> a \<and> a \<le> 2 \<and> cos a = 0" "0 \<le> b \<and> b \<le> 2 \<and> cos b = 0"
   have cosd: "\<And>x::real. cos differentiable (at x)"
     unfolding real_differentiable_def by (auto intro: DERIV_cos)
   show "a = b"
   proof (cases a b rule: linorder_cases)
     case less
     then obtain z where "a < z" "z < b" "(cos has_real_derivative 0) (at z)"
       using Rolle by (metis cosd continuous_on_cos_real ab)
     then have "sin z = 0"
       using DERIV_cos DERIV_unique neg_equal_0_iff_equal by blast
     then show ?thesis
       by (metis \<open>a < z\<close> \<open>z < b\<close> ab order_less_le_trans less_le sin_gt_zero_02)
   next
     case greater
     then obtain z where "b < z" "z < a" "(cos has_real_derivative 0) (at z)"
       using Rolle by (metis cosd continuous_on_cos_real ab)
     then have "sin z = 0"
       using DERIV_cos DERIV_unique neg_equal_0_iff_equal by blast
     then show ?thesis
       by (metis \<open>b < z\<close> \<open>z < a\<close> ab order_less_le_trans less_le sin_gt_zero_02)
   qed auto
 qed
 
 lemma pi_half: "pi/2 = (THE x. 0 \<le> x \<and> x \<le> 2 \<and> cos x = 0)"
   by (simp add: pi_def)
 
 lemma cos_pi_half [simp]: "cos (pi/2) = 0"
   by (simp add: pi_half cos_is_zero [THEN theI'])
 
 lemma cos_of_real_pi_half [simp]: "cos ((of_real pi/2) :: 'a) = 0"
   if "SORT_CONSTRAINT('a::{real_field,banach,real_normed_algebra_1})"
   by (metis cos_pi_half cos_of_real eq_numeral_simps(4)
       nonzero_of_real_divide of_real_0 of_real_numeral)
 
 lemma pi_half_gt_zero [simp]: "0 < pi/2"
 proof -
   have "0 \<le> pi/2"
     by (simp add: pi_half cos_is_zero [THEN theI'])
   then show ?thesis
     by (metis cos_pi_half cos_zero less_eq_real_def one_neq_zero)
 qed
 
 lemmas pi_half_neq_zero [simp] = pi_half_gt_zero [THEN less_imp_neq, symmetric]
 lemmas pi_half_ge_zero [simp] = pi_half_gt_zero [THEN order_less_imp_le]
 
 lemma pi_half_less_two [simp]: "pi/2 < 2"
 proof -
   have "pi/2 \<le> 2"
     by (simp add: pi_half cos_is_zero [THEN theI'])
   then show ?thesis
     by (metis cos_pi_half cos_two_neq_zero le_less)
 qed
 
 lemmas pi_half_neq_two [simp] = pi_half_less_two [THEN less_imp_neq]
 lemmas pi_half_le_two [simp] =  pi_half_less_two [THEN order_less_imp_le]
 
 lemma pi_gt_zero [simp]: "0 < pi"
   using pi_half_gt_zero by simp
 
 lemma pi_ge_zero [simp]: "0 \<le> pi"
   by (rule pi_gt_zero [THEN order_less_imp_le])
 
 lemma pi_neq_zero [simp]: "pi \<noteq> 0"
   by (rule pi_gt_zero [THEN less_imp_neq, symmetric])
 
 lemma pi_not_less_zero [simp]: "\<not> pi < 0"
   by (simp add: linorder_not_less)
 
 lemma minus_pi_half_less_zero: "-(pi/2) < 0"
   by simp
 
 lemma m2pi_less_pi: "- (2*pi) < pi"
   by simp
 
 lemma sin_pi_half [simp]: "sin(pi/2) = 1"
   using sin_cos_squared_add2 [where x = "pi/2"]
   using sin_gt_zero_02 [OF pi_half_gt_zero pi_half_less_two]
   by (simp add: power2_eq_1_iff)
 
 lemma sin_of_real_pi_half [simp]: "sin ((of_real pi/2) :: 'a) = 1"
   if "SORT_CONSTRAINT('a::{real_field,banach,real_normed_algebra_1})"
   using sin_pi_half
   by (metis sin_pi_half eq_numeral_simps(4) nonzero_of_real_divide of_real_1 of_real_numeral sin_of_real)
 
 lemma sin_cos_eq: "sin x = cos (of_real pi/2 - x)"
   for x :: "'a::{real_normed_field,banach}"
   by (simp add: cos_diff)
 
 lemma minus_sin_cos_eq: "- sin x = cos (x + of_real pi/2)"
   for x :: "'a::{real_normed_field,banach}"
   by (simp add: cos_add nonzero_of_real_divide)
 
 lemma cos_sin_eq: "cos x = sin (of_real pi/2 - x)"
   for x :: "'a::{real_normed_field,banach}"
   using sin_cos_eq [of "of_real pi/2 - x"] by simp
 
 lemma sin_add: "sin (x + y) = sin x * cos y + cos x * sin y"
   for x :: "'a::{real_normed_field,banach}"
   using cos_add [of "of_real pi/2 - x" "-y"]
   by (simp add: cos_sin_eq) (simp add: sin_cos_eq)
 
 lemma sin_diff: "sin (x - y) = sin x * cos y - cos x * sin y"
   for x :: "'a::{real_normed_field,banach}"
   using sin_add [of x "- y"] by simp
 
 lemma sin_double: "sin(2 * x) = 2 * sin x * cos x"
   for x :: "'a::{real_normed_field,banach}"
   using sin_add [where x=x and y=x] by simp
 
 lemma cos_of_real_pi [simp]: "cos (of_real pi) = -1"
   using cos_add [where x = "pi/2" and y = "pi/2"]
   by (simp add: cos_of_real)
 
 lemma sin_of_real_pi [simp]: "sin (of_real pi) = 0"
   using sin_add [where x = "pi/2" and y = "pi/2"]
   by (simp add: sin_of_real)
 
 lemma cos_pi [simp]: "cos pi = -1"
   using cos_add [where x = "pi/2" and y = "pi/2"] by simp
 
 lemma sin_pi [simp]: "sin pi = 0"
   using sin_add [where x = "pi/2" and y = "pi/2"] by simp
 
 lemma sin_periodic_pi [simp]: "sin (x + pi) = - sin x"
   by (simp add: sin_add)
 
 lemma sin_periodic_pi2 [simp]: "sin (pi + x) = - sin x"
   by (simp add: sin_add)
 
 lemma cos_periodic_pi [simp]: "cos (x + pi) = - cos x"
   by (simp add: cos_add)
 
 lemma cos_periodic_pi2 [simp]: "cos (pi + x) = - cos x"
   by (simp add: cos_add)
 
 lemma sin_periodic [simp]: "sin (x + 2 * pi) = sin x"
   by (simp add: sin_add sin_double cos_double)
 
 lemma cos_periodic [simp]: "cos (x + 2 * pi) = cos x"
   by (simp add: cos_add sin_double cos_double)
 
 lemma cos_npi [simp]: "cos (real n * pi) = (- 1) ^ n"
   by (induct n) (auto simp: distrib_right)
 
 lemma cos_npi2 [simp]: "cos (pi * real n) = (- 1) ^ n"
   by (metis cos_npi mult.commute)
 
 lemma sin_npi [simp]: "sin (real n * pi) = 0"
   for n :: nat
   by (induct n) (auto simp: distrib_right)
 
 lemma sin_npi2 [simp]: "sin (pi * real n) = 0"
   for n :: nat
   by (simp add: mult.commute [of pi])
 
 lemma cos_two_pi [simp]: "cos (2 * pi) = 1"
   by (simp add: cos_double)
 
 lemma sin_two_pi [simp]: "sin (2 * pi) = 0"
   by (simp add: sin_double)
 
 context
   fixes w :: "'a::{real_normed_field,banach}"
 
 begin
 
 lemma sin_times_sin: "sin w * sin z = (cos (w - z) - cos (w + z)) / 2"
   by (simp add: cos_diff cos_add)
 
 lemma sin_times_cos: "sin w * cos z = (sin (w + z) + sin (w - z)) / 2"
   by (simp add: sin_diff sin_add)
 
 lemma cos_times_sin: "cos w * sin z = (sin (w + z) - sin (w - z)) / 2"
   by (simp add: sin_diff sin_add)
 
 lemma cos_times_cos: "cos w * cos z = (cos (w - z) + cos (w + z)) / 2"
   by (simp add: cos_diff cos_add)
 
 lemma cos_double_cos: "cos (2 * w) = 2 * cos w ^ 2 - 1"
   by (simp add: cos_double sin_squared_eq)
 
 lemma cos_double_sin: "cos (2 * w) = 1 - 2 * sin w ^ 2"
   by (simp add: cos_double sin_squared_eq)
 
 end
 
 lemma sin_plus_sin: "sin w + sin z = 2 * sin ((w + z) / 2) * cos ((w - z) / 2)"
   for w :: "'a::{real_normed_field,banach}" 
   apply (simp add: mult.assoc sin_times_cos)
   apply (simp add: field_simps)
   done
 
 lemma sin_diff_sin: "sin w - sin z = 2 * sin ((w - z) / 2) * cos ((w + z) / 2)"
   for w :: "'a::{real_normed_field,banach}"
   apply (simp add: mult.assoc sin_times_cos)
   apply (simp add: field_simps)
   done
 
 lemma cos_plus_cos: "cos w + cos z = 2 * cos ((w + z) / 2) * cos ((w - z) / 2)"
   for w :: "'a::{real_normed_field,banach,field}"
   apply (simp add: mult.assoc cos_times_cos)
   apply (simp add: field_simps)
   done
 
 lemma cos_diff_cos: "cos w - cos z = 2 * sin ((w + z) / 2) * sin ((z - w) / 2)"
   for w :: "'a::{real_normed_field,banach,field}"
   apply (simp add: mult.assoc sin_times_sin)
   apply (simp add: field_simps)
   done
 
 lemma sin_pi_minus [simp]: "sin (pi - x) = sin x"
   by (metis sin_minus sin_periodic_pi minus_minus uminus_add_conv_diff)
 
 lemma cos_pi_minus [simp]: "cos (pi - x) = - (cos x)"
   by (metis cos_minus cos_periodic_pi uminus_add_conv_diff)
 
 lemma sin_minus_pi [simp]: "sin (x - pi) = - (sin x)"
   by (simp add: sin_diff)
 
 lemma cos_minus_pi [simp]: "cos (x - pi) = - (cos x)"
   by (simp add: cos_diff)
 
 lemma sin_2pi_minus [simp]: "sin (2 * pi - x) = - (sin x)"
   by (metis sin_periodic_pi2 add_diff_eq mult_2 sin_pi_minus)
 
 lemma cos_2pi_minus [simp]: "cos (2 * pi - x) = cos x"
   by (metis (no_types, opaque_lifting) cos_add cos_minus cos_two_pi sin_minus sin_two_pi
       diff_0_right minus_diff_eq mult_1 mult_zero_left uminus_add_conv_diff)
 
 lemma sin_gt_zero2: "0 < x \<Longrightarrow> x < pi/2 \<Longrightarrow> 0 < sin x"
   by (metis sin_gt_zero_02 order_less_trans pi_half_less_two)
 
 lemma sin_less_zero:
   assumes "- pi/2 < x" and "x < 0"
   shows "sin x < 0"
 proof -
   have "0 < sin (- x)"
     using assms by (simp only: sin_gt_zero2)
   then show ?thesis by simp
 qed
 
 lemma pi_less_4: "pi < 4"
   using pi_half_less_two by auto
 
 lemma cos_gt_zero: "0 < x \<Longrightarrow> x < pi/2 \<Longrightarrow> 0 < cos x"
   by (simp add: cos_sin_eq sin_gt_zero2)
 
 lemma cos_gt_zero_pi: "-(pi/2) < x \<Longrightarrow> x < pi/2 \<Longrightarrow> 0 < cos x"
   using cos_gt_zero [of x] cos_gt_zero [of "-x"]
   by (cases rule: linorder_cases [of x 0]) auto
 
 lemma cos_ge_zero: "-(pi/2) \<le> x \<Longrightarrow> x \<le> pi/2 \<Longrightarrow> 0 \<le> cos x"
   by (auto simp: order_le_less cos_gt_zero_pi)
     (metis cos_pi_half eq_divide_eq eq_numeral_simps(4))
 
 lemma sin_gt_zero: "0 < x \<Longrightarrow> x < pi \<Longrightarrow> 0 < sin x"
   by (simp add: sin_cos_eq cos_gt_zero_pi)
 
 lemma sin_lt_zero: "pi < x \<Longrightarrow> x < 2 * pi \<Longrightarrow> sin x < 0"
   using sin_gt_zero [of "x - pi"]
   by (simp add: sin_diff)
 
 lemma pi_ge_two: "2 \<le> pi"
 proof (rule ccontr)
   assume "\<not> ?thesis"
   then have "pi < 2" by auto
   have "\<exists>y > pi. y < 2 \<and> y < 2 * pi"
   proof (cases "2 < 2 * pi")
     case True
     with dense[OF \<open>pi < 2\<close>] show ?thesis by auto
   next
     case False
     have "pi < 2 * pi" by auto
     from dense[OF this] and False show ?thesis by auto
   qed
   then obtain y where "pi < y" and "y < 2" and "y < 2 * pi"
     by blast
   then have "0 < sin y"
     using sin_gt_zero_02 by auto
   moreover have "sin y < 0"
     using sin_gt_zero[of "y - pi"] \<open>pi < y\<close> and \<open>y < 2 * pi\<close> sin_periodic_pi[of "y - pi"]
     by auto
   ultimately show False by auto
 qed
 
 lemma sin_ge_zero: "0 \<le> x \<Longrightarrow> x \<le> pi \<Longrightarrow> 0 \<le> sin x"
   by (auto simp: order_le_less sin_gt_zero)
 
 lemma sin_le_zero: "pi \<le> x \<Longrightarrow> x < 2 * pi \<Longrightarrow> sin x \<le> 0"
   using sin_ge_zero [of "x - pi"] by (simp add: sin_diff)
 
 lemma sin_pi_divide_n_ge_0 [simp]:
   assumes "n \<noteq> 0"
-  shows "0 \<le> sin (pi / real n)"
+  shows "0 \<le> sin (pi/real n)"
   by (rule sin_ge_zero) (use assms in \<open>simp_all add: field_split_simps\<close>)
 
 lemma sin_pi_divide_n_gt_0:
   assumes "2 \<le> n"
-  shows "0 < sin (pi / real n)"
+  shows "0 < sin (pi/real n)"
   by (rule sin_gt_zero) (use assms in \<open>simp_all add: field_split_simps\<close>)
 
 text\<open>Proof resembles that of \<open>cos_is_zero\<close> but with \<^term>\<open>pi\<close> for the upper bound\<close>
 lemma cos_total:
   assumes y: "-1 \<le> y" "y \<le> 1"
   shows "\<exists>!x. 0 \<le> x \<and> x \<le> pi \<and> cos x = y"
 proof (rule ex_ex1I)
   show "\<exists>x::real. 0 \<le> x \<and> x \<le> pi \<and> cos x = y"
     by (rule IVT2) (simp_all add: y)
 next
   fix a b :: real
   assume ab: "0 \<le> a \<and> a \<le> pi \<and> cos a = y" "0 \<le> b \<and> b \<le> pi \<and> cos b = y"
   have cosd: "\<And>x::real. cos differentiable (at x)"
     unfolding real_differentiable_def by (auto intro: DERIV_cos)
   show "a = b"
   proof (cases a b rule: linorder_cases)
     case less
     then obtain z where "a < z" "z < b" "(cos has_real_derivative 0) (at z)"
       using Rolle by (metis cosd continuous_on_cos_real ab)
     then have "sin z = 0"
       using DERIV_cos DERIV_unique neg_equal_0_iff_equal by blast
     then show ?thesis
       by (metis \<open>a < z\<close> \<open>z < b\<close> ab order_less_le_trans less_le sin_gt_zero)
   next
     case greater
     then obtain z where "b < z" "z < a" "(cos has_real_derivative 0) (at z)"
       using Rolle by (metis cosd continuous_on_cos_real ab)
     then have "sin z = 0"
       using DERIV_cos DERIV_unique neg_equal_0_iff_equal by blast
     then show ?thesis
       by (metis \<open>b < z\<close> \<open>z < a\<close> ab order_less_le_trans less_le sin_gt_zero)
   qed auto
 qed
 
 lemma sin_total:
   assumes y: "-1 \<le> y" "y \<le> 1"
   shows "\<exists>!x. - (pi/2) \<le> x \<and> x \<le> pi/2 \<and> sin x = y"
 proof -
   from cos_total [OF y]
   obtain x where x: "0 \<le> x" "x \<le> pi" "cos x = y"
     and uniq: "\<And>x'. 0 \<le> x' \<Longrightarrow> x' \<le> pi \<Longrightarrow> cos x' = y \<Longrightarrow> x' = x "
     by blast
   show ?thesis
     unfolding sin_cos_eq
   proof (rule ex1I [where a="pi/2 - x"])
     show "- (pi/2) \<le> z \<and> z \<le> pi/2 \<and> cos (of_real pi/2 - z) = y \<Longrightarrow>
           z = pi/2 - x" for z
       using uniq [of "pi/2 -z"] by auto
   qed (use x in auto)
 qed
 
 lemma cos_zero_lemma:
   assumes "0 \<le> x" "cos x = 0"
   shows "\<exists>n. odd n \<and> x = of_nat n * (pi/2)"
 proof -
   have xle: "x < (1 + real_of_int \<lfloor>x/pi\<rfloor>) * pi"
     using floor_correct [of "x/pi"]
     by (simp add: add.commute divide_less_eq)
   obtain n where "real n * pi \<le> x" "x < real (Suc n) * pi"
   proof 
     show "real (nat \<lfloor>x / pi\<rfloor>) * pi \<le> x"
       using assms floor_divide_lower [of pi x] by auto
     show "x < real (Suc (nat \<lfloor>x / pi\<rfloor>)) * pi"
       using assms floor_divide_upper [of pi x]  by (simp add: xle)
   qed
   then have x: "0 \<le> x - n * pi" "(x - n * pi) \<le> pi" "cos (x - n * pi) = 0"
     by (auto simp: algebra_simps cos_diff assms)
   then have "\<exists>!x. 0 \<le> x \<and> x \<le> pi \<and> cos x = 0"
     by (auto simp: intro!: cos_total)
   then obtain \<theta> where \<theta>: "0 \<le> \<theta>" "\<theta> \<le> pi" "cos \<theta> = 0"
     and uniq: "\<And>\<phi>. 0 \<le> \<phi> \<Longrightarrow> \<phi> \<le> pi \<Longrightarrow> cos \<phi> = 0 \<Longrightarrow> \<phi> = \<theta>"
     by blast
   then have "x - real n * pi = \<theta>"
     using x by blast
   moreover have "pi/2 = \<theta>"
     using pi_half_ge_zero uniq by fastforce
   ultimately show ?thesis
     by (rule_tac x = "Suc (2 * n)" in exI) (simp add: algebra_simps)
 qed
 
 lemma sin_zero_lemma:
   assumes "0 \<le> x" "sin x = 0"
   shows "\<exists>n::nat. even n \<and> x = real n * (pi/2)"
 proof -
   obtain n where "odd n" and n: "x + pi/2 = of_nat n * (pi/2)" "n > 0"
     using cos_zero_lemma [of "x + pi/2"] assms by (auto simp add: cos_add)
-  then have "x = real (n - 1) * (pi / 2)"
+  then have "x = real (n - 1) * (pi/2)"
     by (simp add: algebra_simps of_nat_diff)
   then show ?thesis
     by (simp add: \<open>odd n\<close>)
 qed
 
 lemma cos_zero_iff:
   "cos x = 0 \<longleftrightarrow> ((\<exists>n. odd n \<and> x = real n * (pi/2)) \<or> (\<exists>n. odd n \<and> x = - (real n * (pi/2))))"
   (is "?lhs = ?rhs")
 proof -
   have *: "cos (real n * pi/2) = 0" if "odd n" for n :: nat
   proof -
     from that obtain m where "n = 2 * m + 1" ..
     then show ?thesis
       by (simp add: field_simps) (simp add: cos_add add_divide_distrib)
   qed
   show ?thesis
   proof
     show ?rhs if ?lhs
       using that cos_zero_lemma [of x] cos_zero_lemma [of "-x"] by force
     show ?lhs if ?rhs
       using that by (auto dest: * simp del: eq_divide_eq_numeral1)
   qed
 qed
 
 lemma sin_zero_iff:
   "sin x = 0 \<longleftrightarrow> ((\<exists>n. even n \<and> x = real n * (pi/2)) \<or> (\<exists>n. even n \<and> x = - (real n * (pi/2))))"
   (is "?lhs = ?rhs")
 proof
   show ?rhs if ?lhs
     using that sin_zero_lemma [of x] sin_zero_lemma [of "-x"] by force
   show ?lhs if ?rhs
     using that by (auto elim: evenE)
 qed
 
 lemma sin_zero_pi_iff:
   fixes x::real
   assumes "\<bar>x\<bar> < pi"
   shows "sin x = 0 \<longleftrightarrow> x = 0"
 proof
   show "x = 0" if "sin x = 0"
     using that assms by (auto simp: sin_zero_iff)
 qed auto
 
 lemma cos_zero_iff_int: "cos x = 0 \<longleftrightarrow> (\<exists>i. odd i \<and> x = of_int i * (pi/2))"
 proof -
   have 1: "\<And>n. odd n \<Longrightarrow> \<exists>i. odd i \<and> real n = real_of_int i"
     by (metis even_of_nat_iff of_int_of_nat_eq)
   have 2: "\<And>n. odd n \<Longrightarrow> \<exists>i. odd i \<and> - (real n * pi) = real_of_int i * pi"
     by (metis even_minus even_of_nat_iff mult.commute mult_minus_right of_int_minus of_int_of_nat_eq)
   have 3: "\<lbrakk>odd i;  \<forall>n. even n \<or> real_of_int i \<noteq> - (real n)\<rbrakk>
          \<Longrightarrow> \<exists>n. odd n \<and> real_of_int i = real n" for i
     by (cases i rule: int_cases2) auto
   show ?thesis
     by (force simp: cos_zero_iff intro!: 1 2 3)
 qed
 
 lemma sin_zero_iff_int: "sin x = 0 \<longleftrightarrow> (\<exists>i. even i \<and> x = of_int i * (pi/2))" (is "?lhs = ?rhs")
 proof safe
   assume ?lhs
   then consider (plus) n where "even n" "x = real n * (pi/2)" | (minus) n where "even n"  "x = - (real n * (pi/2))"
     using sin_zero_iff by auto
   then show "\<exists>n. even n \<and> x = of_int n * (pi/2)"
   proof cases
     case plus
     then show ?rhs
       by (metis even_of_nat_iff of_int_of_nat_eq)
   next
     case minus
     then show ?thesis
       by (rule_tac x="- (int n)" in exI) simp
   qed
 next
   fix i :: int
   assume "even i"
   then show "sin (of_int i * (pi/2)) = 0"
     by (cases i rule: int_cases2, simp_all add: sin_zero_iff)
 qed
 
 lemma sin_zero_iff_int2: "sin x = 0 \<longleftrightarrow> (\<exists>i::int. x = of_int i * pi)"
 proof -
-  have "sin x = 0 \<longleftrightarrow> (\<exists>i. even i \<and> x = real_of_int i * (pi / 2))"
+  have "sin x = 0 \<longleftrightarrow> (\<exists>i. even i \<and> x = real_of_int i * (pi/2))"
     by (auto simp: sin_zero_iff_int)
-  also have "... = (\<exists>j. x = real_of_int (2*j) * (pi / 2))"
+  also have "... = (\<exists>j. x = real_of_int (2*j) * (pi/2))"
     using dvd_triv_left by blast
   also have "... = (\<exists>i::int. x = of_int i * pi)"
     by auto
   finally show ?thesis .
 qed
 
 lemma sin_npi_int [simp]: "sin (pi * of_int n) = 0"
   by (simp add: sin_zero_iff_int2)
 
 lemma cos_monotone_0_pi:
   assumes "0 \<le> y" and "y < x" and "x \<le> pi"
   shows "cos x < cos y"
 proof -
   have "- (x - y) < 0" using assms by auto
   from MVT2[OF \<open>y < x\<close> DERIV_cos]
   obtain z where "y < z" and "z < x" and cos_diff: "cos x - cos y = (x - y) * - sin z"
     by auto
   then have "0 < z" and "z < pi"
     using assms by auto
   then have "0 < sin z"
     using sin_gt_zero by auto
   then have "cos x - cos y < 0"
     unfolding cos_diff minus_mult_commute[symmetric]
     using \<open>- (x - y) < 0\<close> by (rule mult_pos_neg2)
   then show ?thesis by auto
 qed
 
 lemma cos_monotone_0_pi_le:
   assumes "0 \<le> y" and "y \<le> x" and "x \<le> pi"
   shows "cos x \<le> cos y"
 proof (cases "y < x")
   case True
   show ?thesis
     using cos_monotone_0_pi[OF \<open>0 \<le> y\<close> True \<open>x \<le> pi\<close>] by auto
 next
   case False
   then have "y = x" using \<open>y \<le> x\<close> by auto
   then show ?thesis by auto
 qed
 
 lemma cos_monotone_minus_pi_0:
   assumes "- pi \<le> y" and "y < x" and "x \<le> 0"
   shows "cos y < cos x"
 proof -
   have "0 \<le> - x" and "- x < - y" and "- y \<le> pi"
     using assms by auto
   from cos_monotone_0_pi[OF this] show ?thesis
     unfolding cos_minus .
 qed
 
 lemma cos_monotone_minus_pi_0':
   assumes "- pi \<le> y" and "y \<le> x" and "x \<le> 0"
   shows "cos y \<le> cos x"
 proof (cases "y < x")
   case True
   show ?thesis using cos_monotone_minus_pi_0[OF \<open>-pi \<le> y\<close> True \<open>x \<le> 0\<close>]
     by auto
 next
   case False
   then have "y = x" using \<open>y \<le> x\<close> by auto
   then show ?thesis by auto
 qed
 
 lemma sin_monotone_2pi:
   assumes "- (pi/2) \<le> y" and "y < x" and "x \<le> pi/2"
   shows "sin y < sin x"
   unfolding sin_cos_eq
   using assms by (auto intro: cos_monotone_0_pi)
 
 lemma sin_monotone_2pi_le:
   assumes "- (pi/2) \<le> y" and "y \<le> x" and "x \<le> pi/2"
   shows "sin y \<le> sin x"
   by (metis assms le_less sin_monotone_2pi)
 
 lemma sin_x_le_x:
   fixes x :: real
   assumes "x \<ge> 0"
   shows "sin x \<le> x"
 proof -
   let ?f = "\<lambda>x. x - sin x"
   have "\<And>u. \<lbrakk>0 \<le> u; u \<le> x\<rbrakk> \<Longrightarrow> \<exists>y. (?f has_real_derivative 1 - cos u) (at u)"
     by (auto intro!: derivative_eq_intros simp: field_simps)
   then have "?f x \<ge> ?f 0"
     by (metis cos_le_one diff_ge_0_iff_ge DERIV_nonneg_imp_nondecreasing [OF assms])
   then show "sin x \<le> x" by simp
 qed
 
 lemma sin_x_ge_neg_x:
   fixes x :: real
   assumes x: "x \<ge> 0"
   shows "sin x \<ge> - x"
 proof -
   let ?f = "\<lambda>x. x + sin x"
   have \<section>: "\<And>u. \<lbrakk>0 \<le> u; u \<le> x\<rbrakk> \<Longrightarrow> \<exists>y. (?f has_real_derivative 1 + cos u) (at u)"
     by (auto intro!: derivative_eq_intros simp: field_simps)
   have "?f x \<ge> ?f 0"
     by (rule DERIV_nonneg_imp_nondecreasing [OF assms]) (use \<section> real_0_le_add_iff in force)
   then show "sin x \<ge> -x" by simp
 qed
 
 lemma abs_sin_x_le_abs_x: "\<bar>sin x\<bar> \<le> \<bar>x\<bar>"
   for x :: real
   using sin_x_ge_neg_x [of x] sin_x_le_x [of x] sin_x_ge_neg_x [of "-x"] sin_x_le_x [of "-x"]
   by (auto simp: abs_real_def)
 
 
 subsection \<open>More Corollaries about Sine and Cosine\<close>
 
 lemma sin_cos_npi [simp]: "sin (real (Suc (2 * n)) * pi/2) = (-1) ^ n"
 proof -
   have "sin ((real n + 1/2) * pi) = cos (real n * pi)"
     by (auto simp: algebra_simps sin_add)
   then show ?thesis
     by (simp add: distrib_right add_divide_distrib add.commute mult.commute [of pi])
 qed
 
 lemma cos_2npi [simp]: "cos (2 * real n * pi) = 1"
   for n :: nat
   by (cases "even n") (simp_all add: cos_double mult.assoc)
 
 lemma cos_3over2_pi [simp]: "cos (3/2*pi) = 0"
 proof -
   have "cos (3/2*pi) = cos (pi + pi/2)"
     by simp
   also have "... = 0"
     by (subst cos_add, simp)
   finally show ?thesis .
 qed
 
 lemma sin_2npi [simp]: "sin (2 * real n * pi) = 0"
   for n :: nat
   by (auto simp: mult.assoc sin_double)
 
 lemma sin_3over2_pi [simp]: "sin (3/2*pi) = - 1"
 proof -
   have "sin (3/2*pi) = sin (pi + pi/2)"
     by simp
   also have "... = -1"
     by (subst sin_add, simp)
   finally show ?thesis .
 qed
 
 lemma cos_pi_eq_zero [simp]: "cos (pi * real (Suc (2 * m)) / 2) = 0"
   by (simp only: cos_add sin_add of_nat_Suc distrib_right distrib_left add_divide_distrib, auto)
 
 lemma DERIV_cos_add [simp]: "DERIV (\<lambda>x. cos (x + k)) xa :> - sin (xa + k)"
   by (auto intro!: derivative_eq_intros)
 
 lemma sin_zero_norm_cos_one:
   fixes x :: "'a::{real_normed_field,banach}"
   assumes "sin x = 0"
   shows "norm (cos x) = 1"
   using sin_cos_squared_add [of x, unfolded assms]
   by (simp add: square_norm_one)
 
 lemma sin_zero_abs_cos_one: "sin x = 0 \<Longrightarrow> \<bar>cos x\<bar> = (1::real)"
   using sin_zero_norm_cos_one by fastforce
 
 lemma cos_one_sin_zero:
   fixes x :: "'a::{real_normed_field,banach}"
   assumes "cos x = 1"
   shows "sin x = 0"
   using sin_cos_squared_add [of x, unfolded assms]
   by simp
 
 lemma sin_times_pi_eq_0: "sin (x * pi) = 0 \<longleftrightarrow> x \<in> \<int>"
   by (simp add: sin_zero_iff_int2) (metis Ints_cases Ints_of_int)
 
 lemma cos_one_2pi: "cos x = 1 \<longleftrightarrow> (\<exists>n::nat. x = n * 2 * pi) \<or> (\<exists>n::nat. x = - (n * 2 * pi))"
   (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then have "sin x = 0"
     by (simp add: cos_one_sin_zero)
   then show ?rhs
   proof (simp only: sin_zero_iff, elim exE disjE conjE)
     fix n :: nat
     assume n: "even n" "x = real n * (pi/2)"
     then obtain m where m: "n = 2 * m"
       using dvdE by blast
     then have me: "even m" using \<open>?lhs\<close> n
       by (auto simp: field_simps) (metis one_neq_neg_one  power_minus_odd power_one)
     show ?rhs
       using m me n
       by (auto simp: field_simps elim!: evenE)
   next
     fix n :: nat
     assume n: "even n" "x = - (real n * (pi/2))"
     then obtain m where m: "n = 2 * m"
       using dvdE by blast
     then have me: "even m" using \<open>?lhs\<close> n
       by (auto simp: field_simps) (metis one_neq_neg_one  power_minus_odd power_one)
     show ?rhs
       using m me n
       by (auto simp: field_simps elim!: evenE)
   qed
 next
   assume ?rhs
   then show "cos x = 1"
     by (metis cos_2npi cos_minus mult.assoc mult.left_commute)
 qed
 
 lemma cos_one_2pi_int: "cos x = 1 \<longleftrightarrow> (\<exists>n::int. x = n * 2 * pi)" (is "?lhs = ?rhs")
 proof
   assume "cos x = 1"
   then show ?rhs
     by (metis cos_one_2pi mult.commute mult_minus_right of_int_minus of_int_of_nat_eq)
 next
   assume ?rhs
   then show "cos x = 1"
     by (clarsimp simp add: cos_one_2pi) (metis mult_minus_right of_int_of_nat)
 qed
 
 lemma cos_npi_int [simp]:
   fixes n::int shows "cos (pi * of_int n) = (if even n then 1 else -1)"
     by (auto simp: algebra_simps cos_one_2pi_int elim!: oddE evenE)
 
 lemma sin_cos_sqrt: "0 \<le> sin x \<Longrightarrow> sin x = sqrt (1 - (cos(x) ^ 2))"
   using sin_squared_eq real_sqrt_unique by fastforce
 
 lemma sin_eq_0_pi: "- pi < x \<Longrightarrow> x < pi \<Longrightarrow> sin x = 0 \<Longrightarrow> x = 0"
   by (metis sin_gt_zero sin_minus minus_less_iff neg_0_less_iff_less not_less_iff_gr_or_eq)
 
 lemma cos_treble_cos: "cos (3 * x) = 4 * cos x ^ 3 - 3 * cos x"
   for x :: "'a::{real_normed_field,banach}"
 proof -
   have *: "(sin x * (sin x * 3)) = 3 - (cos x * (cos x * 3))"
     by (simp add: mult.assoc [symmetric] sin_squared_eq [unfolded power2_eq_square])
   have "cos(3 * x) = cos(2*x + x)"
     by simp
   also have "\<dots> = 4 * cos x ^ 3 - 3 * cos x"
     unfolding cos_add cos_double sin_double
     by (simp add: * field_simps power2_eq_square power3_eq_cube)
   finally show ?thesis .
 qed
 
-lemma cos_45: "cos (pi / 4) = sqrt 2 / 2"
-proof -
-  let ?c = "cos (pi / 4)"
-  let ?s = "sin (pi / 4)"
+lemma cos_45: "cos (pi/4) = sqrt 2 / 2"
+proof -
+  let ?c = "cos (pi/4)"
+  let ?s = "sin (pi/4)"
   have nonneg: "0 \<le> ?c"
     by (simp add: cos_ge_zero)
-  have "0 = cos (pi / 4 + pi / 4)"
+  have "0 = cos (pi/4 + pi/4)"
     by simp
-  also have "cos (pi / 4 + pi / 4) = ?c\<^sup>2 - ?s\<^sup>2"
+  also have "cos (pi/4 + pi/4) = ?c\<^sup>2 - ?s\<^sup>2"
     by (simp only: cos_add power2_eq_square)
   also have "\<dots> = 2 * ?c\<^sup>2 - 1"
     by (simp add: sin_squared_eq)
   finally have "?c\<^sup>2 = (sqrt 2 / 2)\<^sup>2"
     by (simp add: power_divide)
   then show ?thesis
     using nonneg by (rule power2_eq_imp_eq) simp
 qed
 
-lemma cos_30: "cos (pi / 6) = sqrt 3/2"
-proof -
-  let ?c = "cos (pi / 6)"
-  let ?s = "sin (pi / 6)"
+lemma cos_30: "cos (pi/6) = sqrt 3/2"
+proof -
+  let ?c = "cos (pi/6)"
+  let ?s = "sin (pi/6)"
   have pos_c: "0 < ?c"
     by (rule cos_gt_zero) simp_all
-  have "0 = cos (pi / 6 + pi / 6 + pi / 6)"
+  have "0 = cos (pi/6 + pi/6 + pi/6)"
     by simp
   also have "\<dots> = (?c * ?c - ?s * ?s) * ?c - (?s * ?c + ?c * ?s) * ?s"
     by (simp only: cos_add sin_add)
   also have "\<dots> = ?c * (?c\<^sup>2 - 3 * ?s\<^sup>2)"
     by (simp add: algebra_simps power2_eq_square)
   finally have "?c\<^sup>2 = (sqrt 3/2)\<^sup>2"
     using pos_c by (simp add: sin_squared_eq power_divide)
   then show ?thesis
     using pos_c [THEN order_less_imp_le]
     by (rule power2_eq_imp_eq) simp
 qed
 
-lemma sin_45: "sin (pi / 4) = sqrt 2 / 2"
+lemma sin_45: "sin (pi/4) = sqrt 2 / 2"
   by (simp add: sin_cos_eq cos_45)
 
-lemma sin_60: "sin (pi / 3) = sqrt 3/2"
+lemma sin_60: "sin (pi/3) = sqrt 3/2"
   by (simp add: sin_cos_eq cos_30)
 
-lemma cos_60: "cos (pi / 3) = 1 / 2"
-proof -
-  have "0 \<le> cos (pi / 3)"
+lemma cos_60: "cos (pi/3) = 1/2"
+proof -
+  have "0 \<le> cos (pi/3)"
     by (rule cos_ge_zero) (use pi_half_ge_zero in \<open>linarith+\<close>)
   then show ?thesis
     by (simp add: cos_squared_eq sin_60 power_divide power2_eq_imp_eq)
 qed
 
-lemma sin_30: "sin (pi / 6) = 1 / 2"
+lemma sin_30: "sin (pi/6) = 1/2"
   by (simp add: sin_cos_eq cos_60)
 
+lemma cos_120: "cos (2 * pi/3) = -1/2"
+  and sin_120: "sin (2 * pi/3) = sqrt 3 / 2"
+  using sin_double[of "pi/3"] cos_double[of "pi/3"]
+  by (simp_all add: power2_eq_square sin_60 cos_60)
+
+lemma cos_120': "cos (pi * 2 / 3) = -1/2"
+  using cos_120 by (subst mult.commute)
+
+lemma sin_120': "sin (pi * 2 / 3) = sqrt 3 / 2"
+  using sin_120 by (subst mult.commute)
+
 lemma cos_integer_2pi: "n \<in> \<int> \<Longrightarrow> cos(2 * pi * n) = 1"
   by (metis Ints_cases cos_one_2pi_int mult.assoc mult.commute)
 
 lemma sin_integer_2pi: "n \<in> \<int> \<Longrightarrow> sin(2 * pi * n) = 0"
   by (metis sin_two_pi Ints_mult mult.assoc mult.commute sin_times_pi_eq_0)
 
 lemma cos_int_2pin [simp]: "cos ((2 * pi) * of_int n) = 1"
   by (simp add: cos_one_2pi_int)
 
 lemma sin_int_2pin [simp]: "sin ((2 * pi) * of_int n) = 0"
   by (metis Ints_of_int sin_integer_2pi)
 
 lemma sincos_principal_value: "\<exists>y. (- pi < y \<and> y \<le> pi) \<and> (sin y = sin x \<and> cos y = cos x)"
 proof -
   define y where "y \<equiv> pi - (2 * pi) * frac ((pi - x) / (2 * pi))"
   have "-pi < y"" y \<le> pi"
     by (auto simp: field_simps frac_lt_1 y_def)
   moreover
   have "sin y = sin x" "cos y = cos x"
     unfolding y_def
      apply (simp_all add: frac_def divide_simps sin_add cos_add)
     by (metis sin_int_2pin cos_int_2pin diff_zero add.right_neutral mult.commute mult.left_neutral mult_zero_left)+
   ultimately
   show ?thesis by metis
 qed
 
 
 subsection \<open>Tangent\<close>
 
 definition tan :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
   where "tan = (\<lambda>x. sin x / cos x)"
 
 lemma tan_of_real: "of_real (tan x) = (tan (of_real x) :: 'a::{real_normed_field,banach})"
   by (simp add: tan_def sin_of_real cos_of_real)
 
 lemma tan_in_Reals [simp]: "z \<in> \<real> \<Longrightarrow> tan z \<in> \<real>"
   for z :: "'a::{real_normed_field,banach}"
   by (simp add: tan_def)
 
 lemma tan_zero [simp]: "tan 0 = 0"
   by (simp add: tan_def)
 
 lemma tan_pi [simp]: "tan pi = 0"
   by (simp add: tan_def)
 
 lemma tan_npi [simp]: "tan (real n * pi) = 0"
   for n :: nat
   by (simp add: tan_def)
 
 lemma tan_minus [simp]: "tan (- x) = - tan x"
   by (simp add: tan_def)
 
 lemma tan_periodic [simp]: "tan (x + 2 * pi) = tan x"
   by (simp add: tan_def)
 
 lemma lemma_tan_add1: "cos x \<noteq> 0 \<Longrightarrow> cos y \<noteq> 0 \<Longrightarrow> 1 - tan x * tan y = cos (x + y)/(cos x * cos y)"
   by (simp add: tan_def cos_add field_simps)
 
 lemma add_tan_eq: "cos x \<noteq> 0 \<Longrightarrow> cos y \<noteq> 0 \<Longrightarrow> tan x + tan y = sin(x + y)/(cos x * cos y)"
   for x :: "'a::{real_normed_field,banach}"
   by (simp add: tan_def sin_add field_simps)
 
 lemma tan_add:
   "cos x \<noteq> 0 \<Longrightarrow> cos y \<noteq> 0 \<Longrightarrow> cos (x + y) \<noteq> 0 \<Longrightarrow> tan (x + y) = (tan x + tan y)/(1 - tan x * tan y)"
   for x :: "'a::{real_normed_field,banach}"
   by (simp add: add_tan_eq lemma_tan_add1 field_simps) (simp add: tan_def)
 
 lemma tan_double: "cos x \<noteq> 0 \<Longrightarrow> cos (2 * x) \<noteq> 0 \<Longrightarrow> tan (2 * x) = (2 * tan x) / (1 - (tan x)\<^sup>2)"
   for x :: "'a::{real_normed_field,banach}"
   using tan_add [of x x] by (simp add: power2_eq_square)
 
 lemma tan_gt_zero: "0 < x \<Longrightarrow> x < pi/2 \<Longrightarrow> 0 < tan x"
   by (simp add: tan_def zero_less_divide_iff sin_gt_zero2 cos_gt_zero_pi)
 
 lemma tan_less_zero:
   assumes "- pi/2 < x" and "x < 0"
   shows "tan x < 0"
 proof -
   have "0 < tan (- x)"
     using assms by (simp only: tan_gt_zero)
   then show ?thesis by simp
 qed
 
 lemma tan_half: "tan x = sin (2 * x) / (cos (2 * x) + 1)"
   for x :: "'a::{real_normed_field,banach,field}"
   unfolding tan_def sin_double cos_double sin_squared_eq
   by (simp add: power2_eq_square)
 
-lemma tan_30: "tan (pi / 6) = 1 / sqrt 3"
+lemma tan_30: "tan (pi/6) = 1 / sqrt 3"
   unfolding tan_def by (simp add: sin_30 cos_30)
 
-lemma tan_45: "tan (pi / 4) = 1"
+lemma tan_45: "tan (pi/4) = 1"
   unfolding tan_def by (simp add: sin_45 cos_45)
 
-lemma tan_60: "tan (pi / 3) = sqrt 3"
+lemma tan_60: "tan (pi/3) = sqrt 3"
   unfolding tan_def by (simp add: sin_60 cos_60)
 
 lemma DERIV_tan [simp]: "cos x \<noteq> 0 \<Longrightarrow> DERIV tan x :> inverse ((cos x)\<^sup>2)"
   for x :: "'a::{real_normed_field,banach}"
   unfolding tan_def
   by (auto intro!: derivative_eq_intros, simp add: divide_inverse power2_eq_square)
 
 declare DERIV_tan[THEN DERIV_chain2, derivative_intros]
   and DERIV_tan[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]
 
 lemmas has_derivative_tan[derivative_intros] = DERIV_tan[THEN DERIV_compose_FDERIV]
 
 lemma isCont_tan: "cos x \<noteq> 0 \<Longrightarrow> isCont tan x"
   for x :: "'a::{real_normed_field,banach}"
   by (rule DERIV_tan [THEN DERIV_isCont])
 
 lemma isCont_tan' [simp,continuous_intros]:
   fixes a :: "'a::{real_normed_field,banach}" and f :: "'a \<Rightarrow> 'a"
   shows "isCont f a \<Longrightarrow> cos (f a) \<noteq> 0 \<Longrightarrow> isCont (\<lambda>x. tan (f x)) a"
   by (rule isCont_o2 [OF _ isCont_tan])
 
 lemma tendsto_tan [tendsto_intros]:
   fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
   shows "(f \<longlongrightarrow> a) F \<Longrightarrow> cos a \<noteq> 0 \<Longrightarrow> ((\<lambda>x. tan (f x)) \<longlongrightarrow> tan a) F"
   by (rule isCont_tendsto_compose [OF isCont_tan])
 
 lemma continuous_tan:
   fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
   shows "continuous F f \<Longrightarrow> cos (f (Lim F (\<lambda>x. x))) \<noteq> 0 \<Longrightarrow> continuous F (\<lambda>x. tan (f x))"
   unfolding continuous_def by (rule tendsto_tan)
 
 lemma continuous_on_tan [continuous_intros]:
   fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
   shows "continuous_on s f \<Longrightarrow> (\<forall>x\<in>s. cos (f x) \<noteq> 0) \<Longrightarrow> continuous_on s (\<lambda>x. tan (f x))"
   unfolding continuous_on_def by (auto intro: tendsto_tan)
 
 lemma continuous_within_tan [continuous_intros]:
   fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
   shows "continuous (at x within s) f \<Longrightarrow>
     cos (f x) \<noteq> 0 \<Longrightarrow> continuous (at x within s) (\<lambda>x. tan (f x))"
   unfolding continuous_within by (rule tendsto_tan)
 
 lemma LIM_cos_div_sin: "(\<lambda>x. cos(x)/sin(x)) \<midarrow>pi/2\<rightarrow> 0"
   by (rule tendsto_cong_limit, (rule tendsto_intros)+, simp_all)
 
 lemma lemma_tan_total: 
   assumes "0 < y" shows "\<exists>x. 0 < x \<and> x < pi/2 \<and> y < tan x"
 proof -
   obtain s where "0 < s" 
     and s: "\<And>x. \<lbrakk>x \<noteq> pi/2; norm (x - pi/2) < s\<rbrakk> \<Longrightarrow> norm (cos x / sin x - 0) < inverse y"
     using LIM_D [OF LIM_cos_div_sin, of "inverse y"] that assms by force
   obtain e where e: "0 < e" "e < s" "e < pi/2"
     using \<open>0 < s\<close> field_lbound_gt_zero pi_half_gt_zero by blast
   show ?thesis
   proof (intro exI conjI)
     have "0 < sin e" "0 < cos e"
       using e by (auto intro: cos_gt_zero sin_gt_zero2 simp: mult.commute)
     then 
     show "y < tan (pi/2 - e)"
       using s [of "pi/2 - e"] e assms
       by (simp add: tan_def sin_diff cos_diff) (simp add: field_simps split: if_split_asm)
   qed (use e in auto)
 qed
 
 lemma tan_total_pos: 
   assumes "0 \<le> y" shows "\<exists>x. 0 \<le> x \<and> x < pi/2 \<and> tan x = y"
 proof (cases "y = 0")
   case True
   then show ?thesis
     using pi_half_gt_zero tan_zero by blast
 next
   case False
   with assms have "y > 0"
     by linarith
   obtain x where x: "0 < x" "x < pi/2" "y < tan x"
     using lemma_tan_total \<open>0 < y\<close> by blast
   have "\<exists>u\<ge>0. u \<le> x \<and> tan u = y"
   proof (intro IVT allI impI)
     show "isCont tan u" if "0 \<le> u \<and> u \<le> x" for u
     proof -
       have "cos u \<noteq> 0"
         using antisym_conv2 cos_gt_zero that x(2) by fastforce
       with assms show ?thesis
         by (auto intro!: DERIV_tan [THEN DERIV_isCont])
     qed
   qed (use assms x in auto)
   then show ?thesis
     using x(2) by auto
 qed
     
 lemma lemma_tan_total1: "\<exists>x. -(pi/2) < x \<and> x < (pi/2) \<and> tan x = y"
 proof (cases "0::real" y rule: le_cases)
   case le
   then show ?thesis
     by (meson less_le_trans minus_pi_half_less_zero tan_total_pos)
 next
   case ge
-  with tan_total_pos [of "-y"] obtain x where "0 \<le> x" "x < pi / 2" "tan x = - y"
+  with tan_total_pos [of "-y"] obtain x where "0 \<le> x" "x < pi/2" "tan x = - y"
     by force
   then show ?thesis
     by (rule_tac x="-x" in exI) auto
 qed
 
 proposition tan_total: "\<exists>! x. -(pi/2) < x \<and> x < (pi/2) \<and> tan x = y"
 proof -
-  have "u = v" if u: "- (pi / 2) < u" "u < pi / 2" and v: "- (pi / 2) < v" "v < pi / 2"
+  have "u = v" if u: "- (pi/2) < u" "u < pi/2" and v: "- (pi/2) < v" "v < pi/2"
     and eq: "tan u = tan v" for u v
   proof (cases u v rule: linorder_cases)
     case less
     have "\<And>x. u \<le> x \<and> x \<le> v \<longrightarrow> isCont tan x"
       by (metis cos_gt_zero_pi isCont_tan le_less_trans less_irrefl less_le_trans u(1) v(2))
     then have "continuous_on {u..v} tan"
       by (simp add: continuous_at_imp_continuous_on)
     moreover have "\<And>x. u < x \<and> x < v \<Longrightarrow> tan differentiable (at x)"
       by (metis DERIV_tan cos_gt_zero_pi real_differentiable_def less_numeral_extra(3) order.strict_trans u(1) v(2))
     ultimately obtain z where "u < z" "z < v" "DERIV tan z :> 0"
       by (metis less Rolle eq)
     moreover have "cos z \<noteq> 0"
       by (metis (no_types) \<open>u < z\<close> \<open>z < v\<close> cos_gt_zero_pi less_le_trans linorder_not_less not_less_iff_gr_or_eq u(1) v(2))
     ultimately show ?thesis
       using DERIV_unique [OF _ DERIV_tan] by fastforce
   next
     case greater
     have "\<And>x. v \<le> x \<and> x \<le> u \<Longrightarrow> isCont tan x"
       by (metis cos_gt_zero_pi isCont_tan le_less_trans less_irrefl less_le_trans u(2) v(1))
     then have "continuous_on {v..u} tan"
       by (simp add: continuous_at_imp_continuous_on)
     moreover have "\<And>x. v < x \<and> x < u \<Longrightarrow> tan differentiable (at x)"
       by (metis DERIV_tan cos_gt_zero_pi real_differentiable_def less_numeral_extra(3) order.strict_trans u(2) v(1))
     ultimately obtain z where "v < z" "z < u" "DERIV tan z :> 0"
       by (metis greater Rolle eq)
     moreover have "cos z \<noteq> 0"
       by (metis \<open>v < z\<close> \<open>z < u\<close> cos_gt_zero_pi less_eq_real_def less_le_trans order_less_irrefl u(2) v(1))
     ultimately show ?thesis
       using DERIV_unique [OF _ DERIV_tan] by fastforce
   qed auto
-  then have "\<exists>!x. - (pi / 2) < x \<and> x < pi / 2 \<and> tan x = y" 
-    if x: "- (pi / 2) < x" "x < pi / 2" "tan x = y" for x
+  then have "\<exists>!x. - (pi/2) < x \<and> x < pi/2 \<and> tan x = y" 
+    if x: "- (pi/2) < x" "x < pi/2" "tan x = y" for x
     using that by auto
   then show ?thesis
     using lemma_tan_total1 [where y = y]
     by auto
 qed
 
 lemma tan_monotone:
   assumes "- (pi/2) < y" and "y < x" and "x < pi/2"
   shows "tan y < tan x"
 proof -
   have "DERIV tan x' :> inverse ((cos x')\<^sup>2)" if "y \<le> x'" "x' \<le> x" for x'
   proof -
     have "-(pi/2) < x'" and "x' < pi/2"
       using that assms by auto
     with cos_gt_zero_pi have "cos x' \<noteq> 0" by force
     then show "DERIV tan x' :> inverse ((cos x')\<^sup>2)"
       by (rule DERIV_tan)
   qed
   from MVT2[OF \<open>y < x\<close> this]
   obtain z where "y < z" and "z < x"
     and tan_diff: "tan x - tan y = (x - y) * inverse ((cos z)\<^sup>2)" by auto
   then have "- (pi/2) < z" and "z < pi/2"
     using assms by auto
   then have "0 < cos z"
     using cos_gt_zero_pi by auto
   then have inv_pos: "0 < inverse ((cos z)\<^sup>2)"
     by auto
   have "0 < x - y" using \<open>y < x\<close> by auto
   with inv_pos have "0 < tan x - tan y"
     unfolding tan_diff by auto
   then show ?thesis by auto
 qed
 
 lemma tan_monotone':
   assumes "- (pi/2) < y"
     and "y < pi/2"
     and "- (pi/2) < x"
     and "x < pi/2"
   shows "y < x \<longleftrightarrow> tan y < tan x"
 proof
   assume "y < x"
   then show "tan y < tan x"
     using tan_monotone and \<open>- (pi/2) < y\<close> and \<open>x < pi/2\<close> by auto
 next
   assume "tan y < tan x"
   show "y < x"
   proof (rule ccontr)
     assume "\<not> ?thesis"
     then have "x \<le> y" by auto
     then have "tan x \<le> tan y"
     proof (cases "x = y")
       case True
       then show ?thesis by auto
     next
       case False
       then have "x < y" using \<open>x \<le> y\<close> by auto
       from tan_monotone[OF \<open>- (pi/2) < x\<close> this \<open>y < pi/2\<close>] show ?thesis
         by auto
     qed
     then show False
       using \<open>tan y < tan x\<close> by auto
   qed
 qed
 
 lemma tan_inverse: "1 / (tan y) = tan (pi/2 - y)"
   unfolding tan_def sin_cos_eq[of y] cos_sin_eq[of y] by auto
 
 lemma tan_periodic_pi[simp]: "tan (x + pi) = tan x"
   by (simp add: tan_def)
 
 lemma tan_periodic_nat[simp]: "tan (x + real n * pi) = tan x"
   for n :: nat
 proof (induct n arbitrary: x)
   case 0
   then show ?case by simp
 next
   case (Suc n)
   have split_pi_off: "x + real (Suc n) * pi = (x + real n * pi) + pi"
     unfolding Suc_eq_plus1 of_nat_add  distrib_right by auto
   show ?case
     unfolding split_pi_off using Suc by auto
 qed
 
 lemma tan_periodic_int[simp]: "tan (x + of_int i * pi) = tan x"
 proof (cases "0 \<le> i")
   case True
   then have i_nat: "of_int i = of_int (nat i)" by auto
   show ?thesis unfolding i_nat
     by (metis of_int_of_nat_eq tan_periodic_nat)
 next
   case False
   then have i_nat: "of_int i = - of_int (nat (- i))" by auto
   have "tan x = tan (x + of_int i * pi - of_int i * pi)"
     by auto
   also have "\<dots> = tan (x + of_int i * pi)"
     unfolding i_nat mult_minus_left diff_minus_eq_add
     by (metis of_int_of_nat_eq tan_periodic_nat)
   finally show ?thesis by auto
 qed
 
 lemma tan_periodic_n[simp]: "tan (x + numeral n * pi) = tan x"
   using tan_periodic_int[of _ "numeral n" ] by simp
 
 lemma tan_minus_45: "tan (-(pi/4)) = -1"
   unfolding tan_def by (simp add: sin_45 cos_45)
 
 lemma tan_diff:
   "cos x \<noteq> 0 \<Longrightarrow> cos y \<noteq> 0 \<Longrightarrow> cos (x - y) \<noteq> 0 \<Longrightarrow> tan (x - y) = (tan x - tan y)/(1 + tan x * tan y)"
   for x :: "'a::{real_normed_field,banach}"
   using tan_add [of x "-y"] by simp
 
 lemma tan_pos_pi2_le: "0 \<le> x \<Longrightarrow> x < pi/2 \<Longrightarrow> 0 \<le> tan x"
   using less_eq_real_def tan_gt_zero by auto
 
 lemma cos_tan: "\<bar>x\<bar> < pi/2 \<Longrightarrow> cos x = 1 / sqrt (1 + tan x ^ 2)"
   using cos_gt_zero_pi [of x]
   by (simp add: field_split_simps tan_def real_sqrt_divide abs_if split: if_split_asm)
 
 lemma cos_tan_half: "cos x \<noteq>0 \<Longrightarrow>  cos (2*x) = (1 - (tan x)^2) / (1 + (tan x)^2)"
   unfolding cos_double tan_def by (auto simp add:field_simps )
 
 lemma sin_tan: "\<bar>x\<bar> < pi/2 \<Longrightarrow> sin x = tan x / sqrt (1 + tan x ^ 2)"
   using cos_gt_zero [of "x"] cos_gt_zero [of "-x"]
   by (force simp: field_split_simps tan_def real_sqrt_divide abs_if split: if_split_asm)
 
 lemma sin_tan_half: "sin (2*x) = 2 * tan x / (1 + (tan x)^2)"
   unfolding sin_double tan_def
   by (cases "cos x=0") (auto simp add:field_simps power2_eq_square)
 
 lemma tan_mono_le: "-(pi/2) < x \<Longrightarrow> x \<le> y \<Longrightarrow> y < pi/2 \<Longrightarrow> tan x \<le> tan y"
   using less_eq_real_def tan_monotone by auto
 
 lemma tan_mono_lt_eq:
   "-(pi/2) < x \<Longrightarrow> x < pi/2 \<Longrightarrow> -(pi/2) < y \<Longrightarrow> y < pi/2 \<Longrightarrow> tan x < tan y \<longleftrightarrow> x < y"
   using tan_monotone' by blast
 
 lemma tan_mono_le_eq:
   "-(pi/2) < x \<Longrightarrow> x < pi/2 \<Longrightarrow> -(pi/2) < y \<Longrightarrow> y < pi/2 \<Longrightarrow> tan x \<le> tan y \<longleftrightarrow> x \<le> y"
   by (meson tan_mono_le not_le tan_monotone)
 
 lemma tan_bound_pi2: "\<bar>x\<bar> < pi/4 \<Longrightarrow> \<bar>tan x\<bar> < 1"
   using tan_45 tan_monotone [of x "pi/4"] tan_monotone [of "-x" "pi/4"]
   by (auto simp: abs_if split: if_split_asm)
 
 lemma tan_cot: "tan(pi/2 - x) = inverse(tan x)"
   by (simp add: tan_def sin_diff cos_diff)
 
 
 subsection \<open>Cotangent\<close>
 
 definition cot :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
   where "cot = (\<lambda>x. cos x / sin x)"
 
 lemma cot_of_real: "of_real (cot x) = (cot (of_real x) :: 'a::{real_normed_field,banach})"
   by (simp add: cot_def sin_of_real cos_of_real)
 
 lemma cot_in_Reals [simp]: "z \<in> \<real> \<Longrightarrow> cot z \<in> \<real>"
   for z :: "'a::{real_normed_field,banach}"
   by (simp add: cot_def)
 
 lemma cot_zero [simp]: "cot 0 = 0"
   by (simp add: cot_def)
 
 lemma cot_pi [simp]: "cot pi = 0"
   by (simp add: cot_def)
 
 lemma cot_npi [simp]: "cot (real n * pi) = 0"
   for n :: nat
   by (simp add: cot_def)
 
 lemma cot_minus [simp]: "cot (- x) = - cot x"
   by (simp add: cot_def)
 
 lemma cot_periodic [simp]: "cot (x + 2 * pi) = cot x"
   by (simp add: cot_def)
 
 lemma cot_altdef: "cot x = inverse (tan x)"
   by (simp add: cot_def tan_def)
 
 lemma tan_altdef: "tan x = inverse (cot x)"
   by (simp add: cot_def tan_def)
 
 lemma tan_cot': "tan (pi/2 - x) = cot x"
   by (simp add: tan_cot cot_altdef)
 
 lemma cot_gt_zero: "0 < x \<Longrightarrow> x < pi/2 \<Longrightarrow> 0 < cot x"
   by (simp add: cot_def zero_less_divide_iff sin_gt_zero2 cos_gt_zero_pi)
 
 lemma cot_less_zero:
   assumes lb: "- pi/2 < x" and "x < 0"
   shows "cot x < 0"
 proof -
   have "0 < cot (- x)"
     using assms by (simp only: cot_gt_zero)
   then show ?thesis by simp
 qed
 
 lemma DERIV_cot [simp]: "sin x \<noteq> 0 \<Longrightarrow> DERIV cot x :> -inverse ((sin x)\<^sup>2)"
   for x :: "'a::{real_normed_field,banach}"
   unfolding cot_def using cos_squared_eq[of x]
   by (auto intro!: derivative_eq_intros) (simp add: divide_inverse power2_eq_square)
 
 lemma isCont_cot: "sin x \<noteq> 0 \<Longrightarrow> isCont cot x"
   for x :: "'a::{real_normed_field,banach}"
   by (rule DERIV_cot [THEN DERIV_isCont])
 
 lemma isCont_cot' [simp,continuous_intros]:
   "isCont f a \<Longrightarrow> sin (f a) \<noteq> 0 \<Longrightarrow> isCont (\<lambda>x. cot (f x)) a"
   for a :: "'a::{real_normed_field,banach}" and f :: "'a \<Rightarrow> 'a"
   by (rule isCont_o2 [OF _ isCont_cot])
 
 lemma tendsto_cot [tendsto_intros]: "(f \<longlongrightarrow> a) F \<Longrightarrow> sin a \<noteq> 0 \<Longrightarrow> ((\<lambda>x. cot (f x)) \<longlongrightarrow> cot a) F"
   for f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
   by (rule isCont_tendsto_compose [OF isCont_cot])
 
 lemma continuous_cot:
   "continuous F f \<Longrightarrow> sin (f (Lim F (\<lambda>x. x))) \<noteq> 0 \<Longrightarrow> continuous F (\<lambda>x. cot (f x))"
   for f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
   unfolding continuous_def by (rule tendsto_cot)
 
 lemma continuous_on_cot [continuous_intros]:
   fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
   shows "continuous_on s f \<Longrightarrow> (\<forall>x\<in>s. sin (f x) \<noteq> 0) \<Longrightarrow> continuous_on s (\<lambda>x. cot (f x))"
   unfolding continuous_on_def by (auto intro: tendsto_cot)
 
 lemma continuous_within_cot [continuous_intros]:
   fixes f :: "'a \<Rightarrow> 'a::{real_normed_field,banach}"
   shows "continuous (at x within s) f \<Longrightarrow> sin (f x) \<noteq> 0 \<Longrightarrow> continuous (at x within s) (\<lambda>x. cot (f x))"
   unfolding continuous_within by (rule tendsto_cot)
 
 
 subsection \<open>Inverse Trigonometric Functions\<close>
 
 definition arcsin :: "real \<Rightarrow> real"
   where "arcsin y = (THE x. -(pi/2) \<le> x \<and> x \<le> pi/2 \<and> sin x = y)"
 
 definition arccos :: "real \<Rightarrow> real"
   where "arccos y = (THE x. 0 \<le> x \<and> x \<le> pi \<and> cos x = y)"
 
 definition arctan :: "real \<Rightarrow> real"
   where "arctan y = (THE x. -(pi/2) < x \<and> x < pi/2 \<and> tan x = y)"
 
 lemma arcsin: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> - (pi/2) \<le> arcsin y \<and> arcsin y \<le> pi/2 \<and> sin (arcsin y) = y"
   unfolding arcsin_def by (rule theI' [OF sin_total])
 
 lemma arcsin_pi: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> - (pi/2) \<le> arcsin y \<and> arcsin y \<le> pi \<and> sin (arcsin y) = y"
   by (drule (1) arcsin) (force intro: order_trans)
 
 lemma sin_arcsin [simp]: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> sin (arcsin y) = y"
   by (blast dest: arcsin)
 
 lemma arcsin_bounded: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> - (pi/2) \<le> arcsin y \<and> arcsin y \<le> pi/2"
   by (blast dest: arcsin)
 
 lemma arcsin_lbound: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> - (pi/2) \<le> arcsin y"
   by (blast dest: arcsin)
 
 lemma arcsin_ubound: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> arcsin y \<le> pi/2"
   by (blast dest: arcsin)
 
 lemma arcsin_lt_bounded:
   assumes "- 1 < y" "y < 1"
   shows  "- (pi/2) < arcsin y \<and> arcsin y < pi/2"
 proof -
   have "arcsin y \<noteq> pi/2"
     by (metis arcsin assms not_less not_less_iff_gr_or_eq sin_pi_half)
   moreover have "arcsin y \<noteq> - pi/2"
     by (metis arcsin assms minus_divide_left not_less not_less_iff_gr_or_eq sin_minus sin_pi_half)
   ultimately show ?thesis
     using arcsin_bounded [of y] assms by auto
 qed
 
 lemma arcsin_sin: "- (pi/2) \<le> x \<Longrightarrow> x \<le> pi/2 \<Longrightarrow> arcsin (sin x) = x"
   unfolding arcsin_def
   using the1_equality [OF sin_total]  by simp
 
+lemma arcsin_unique:
+  assumes "-pi/2 \<le> x" and "x \<le> pi/2" and "sin x = y" shows "arcsin y = x"
+  using arcsin_sin[of x] assms by force
+
 lemma arcsin_0 [simp]: "arcsin 0 = 0"
   using arcsin_sin [of 0] by simp
 
 lemma arcsin_1 [simp]: "arcsin 1 = pi/2"
   using arcsin_sin [of "pi/2"] by simp
 
 lemma arcsin_minus_1 [simp]: "arcsin (- 1) = - (pi/2)"
   using arcsin_sin [of "- pi/2"] by simp
 
 lemma arcsin_minus: "- 1 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> arcsin (- x) = - arcsin x"
   by (metis (no_types, opaque_lifting) arcsin arcsin_sin minus_minus neg_le_iff_le sin_minus)
 
+lemma arcsin_one_half [simp]: "arcsin (1/2) = pi / 6"
+  and arcsin_minus_one_half [simp]: "arcsin (-(1/2)) = -pi / 6"
+  by (intro arcsin_unique; simp add: sin_30 field_simps)+
+  
+lemma arcsin_one_over_sqrt_2: "arcsin (1 / sqrt 2) = pi / 4"
+  by (rule arcsin_unique) (auto simp: sin_45 field_simps)
+
 lemma arcsin_eq_iff: "\<bar>x\<bar> \<le> 1 \<Longrightarrow> \<bar>y\<bar> \<le> 1 \<Longrightarrow> arcsin x = arcsin y \<longleftrightarrow> x = y"
   by (metis abs_le_iff arcsin minus_le_iff)
 
 lemma cos_arcsin_nonzero: "- 1 < x \<Longrightarrow> x < 1 \<Longrightarrow> cos (arcsin x) \<noteq> 0"
   using arcsin_lt_bounded cos_gt_zero_pi by force
 
 lemma arccos: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> 0 \<le> arccos y \<and> arccos y \<le> pi \<and> cos (arccos y) = y"
   unfolding arccos_def by (rule theI' [OF cos_total])
 
 lemma cos_arccos [simp]: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> cos (arccos y) = y"
   by (blast dest: arccos)
 
 lemma arccos_bounded: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> 0 \<le> arccos y \<and> arccos y \<le> pi"
   by (blast dest: arccos)
 
 lemma arccos_lbound: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> 0 \<le> arccos y"
   by (blast dest: arccos)
 
 lemma arccos_ubound: "- 1 \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> arccos y \<le> pi"
   by (blast dest: arccos)
 
 lemma arccos_lt_bounded: 
   assumes "- 1 < y" "y < 1"
   shows  "0 < arccos y \<and> arccos y < pi"
 proof -
   have "arccos y \<noteq> 0"
     by (metis (no_types) arccos assms(1) assms(2) cos_zero less_eq_real_def less_irrefl)
   moreover have "arccos y \<noteq> -pi"
     by (metis arccos assms(1) assms(2) cos_minus cos_pi not_less not_less_iff_gr_or_eq)
   ultimately show ?thesis
     using arccos_bounded [of y] assms
     by (metis arccos cos_pi not_less not_less_iff_gr_or_eq)
 qed
 
 lemma arccos_cos: "0 \<le> x \<Longrightarrow> x \<le> pi \<Longrightarrow> arccos (cos x) = x"
   by (auto simp: arccos_def intro!: the1_equality cos_total)
 
 lemma arccos_cos2: "x \<le> 0 \<Longrightarrow> - pi \<le> x \<Longrightarrow> arccos (cos x) = -x"
   by (auto simp: arccos_def intro!: the1_equality cos_total)
 
+lemma arccos_unique:
+  assumes "0 \<le> x" and "x \<le> pi" and "cos x = y" shows "arccos y = x"
+  using arccos_cos assms by blast
+
 lemma cos_arcsin:
   assumes "- 1 \<le> x" "x \<le> 1"
   shows "cos (arcsin x) = sqrt (1 - x\<^sup>2)"
 proof (rule power2_eq_imp_eq)
   show "(cos (arcsin x))\<^sup>2 = (sqrt (1 - x\<^sup>2))\<^sup>2"
     by (simp add: square_le_1 assms cos_squared_eq)
   show "0 \<le> cos (arcsin x)"
     using arcsin assms cos_ge_zero by blast
   show "0 \<le> sqrt (1 - x\<^sup>2)"
     by (simp add: square_le_1 assms)
 qed
 
 lemma sin_arccos:
   assumes "- 1 \<le> x" "x \<le> 1"
   shows "sin (arccos x) = sqrt (1 - x\<^sup>2)"
 proof (rule power2_eq_imp_eq)
   show "(sin (arccos x))\<^sup>2 = (sqrt (1 - x\<^sup>2))\<^sup>2"
     by (simp add: square_le_1 assms sin_squared_eq)
   show "0 \<le> sin (arccos x)"
     by (simp add: arccos_bounded assms sin_ge_zero)
   show "0 \<le> sqrt (1 - x\<^sup>2)"
     by (simp add: square_le_1 assms)
 qed
 
 lemma arccos_0 [simp]: "arccos 0 = pi/2"
-  by (metis arccos_cos cos_gt_zero cos_pi cos_pi_half pi_gt_zero
-      pi_half_ge_zero not_le not_zero_less_neg_numeral numeral_One)
+  using arccos_cos pi_half_ge_zero by fastforce
 
 lemma arccos_1 [simp]: "arccos 1 = 0"
   using arccos_cos by force
 
 lemma arccos_minus_1 [simp]: "arccos (- 1) = pi"
   by (metis arccos_cos cos_pi order_refl pi_ge_zero)
 
 lemma arccos_minus: "-1 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> arccos (- x) = pi - arccos x"
-  by (metis arccos_cos arccos_cos2 cos_minus_pi cos_total diff_le_0_iff_le le_add_same_cancel1
-      minus_diff_eq uminus_add_conv_diff)
+  by (smt (verit, ccfv_threshold) arccos arccos_cos cos_minus cos_minus_pi)
+
+lemma arccos_one_half [simp]: "arccos (1/2) = pi / 3"
+  and arccos_minus_one_half [simp]: "arccos (-(1/2)) = 2 * pi / 3"
+  by (intro arccos_unique; simp add: cos_60 cos_120)+
+
+lemma arccos_one_over_sqrt_2: "arccos (1 / sqrt 2) = pi / 4"
+  by (rule arccos_unique) (auto simp: cos_45 field_simps)
 
 corollary arccos_minus_abs:
   assumes "\<bar>x\<bar> \<le> 1"
   shows "arccos (- x) = pi - arccos x"
 using assms by (simp add: arccos_minus)
 
 lemma sin_arccos_nonzero: "- 1 < x \<Longrightarrow> x < 1 \<Longrightarrow> sin (arccos x) \<noteq> 0"
   using arccos_lt_bounded sin_gt_zero by force
 
 lemma arctan: "- (pi/2) < arctan y \<and> arctan y < pi/2 \<and> tan (arctan y) = y"
   unfolding arctan_def by (rule theI' [OF tan_total])
 
 lemma tan_arctan: "tan (arctan y) = y"
   by (simp add: arctan)
 
 lemma arctan_bounded: "- (pi/2) < arctan y \<and> arctan y < pi/2"
   by (auto simp only: arctan)
 
 lemma arctan_lbound: "- (pi/2) < arctan y"
   by (simp add: arctan)
 
 lemma arctan_ubound: "arctan y < pi/2"
   by (auto simp only: arctan)
 
 lemma arctan_unique:
   assumes "-(pi/2) < x"
     and "x < pi/2"
     and "tan x = y"
   shows "arctan y = x"
   using assms arctan [of y] tan_total [of y] by (fast elim: ex1E)
 
 lemma arctan_tan: "-(pi/2) < x \<Longrightarrow> x < pi/2 \<Longrightarrow> arctan (tan x) = x"
   by (rule arctan_unique) simp_all
 
 lemma arctan_zero_zero [simp]: "arctan 0 = 0"
   by (rule arctan_unique) simp_all
 
 lemma arctan_minus: "arctan (- x) = - arctan x"
   using arctan [of "x"] by (auto simp: arctan_unique)
 
 lemma cos_arctan_not_zero [simp]: "cos (arctan x) \<noteq> 0"
   by (intro less_imp_neq [symmetric] cos_gt_zero_pi arctan_lbound arctan_ubound)
 
 lemma cos_arctan: "cos (arctan x) = 1 / sqrt (1 + x\<^sup>2)"
 proof (rule power2_eq_imp_eq)
   have "0 < 1 + x\<^sup>2" by (simp add: add_pos_nonneg)
   show "0 \<le> 1 / sqrt (1 + x\<^sup>2)" by simp
   show "0 \<le> cos (arctan x)"
     by (intro less_imp_le cos_gt_zero_pi arctan_lbound arctan_ubound)
   have "(cos (arctan x))\<^sup>2 * (1 + (tan (arctan x))\<^sup>2) = 1"
     unfolding tan_def by (simp add: distrib_left power_divide)
   then show "(cos (arctan x))\<^sup>2 = (1 / sqrt (1 + x\<^sup>2))\<^sup>2"
     using \<open>0 < 1 + x\<^sup>2\<close> by (simp add: arctan power_divide eq_divide_eq)
 qed
 
 lemma sin_arctan: "sin (arctan x) = x / sqrt (1 + x\<^sup>2)"
   using add_pos_nonneg [OF zero_less_one zero_le_power2 [of x]]
   using tan_arctan [of x] unfolding tan_def cos_arctan
   by (simp add: eq_divide_eq)
 
 lemma tan_sec: "cos x \<noteq> 0 \<Longrightarrow> 1 + (tan x)\<^sup>2 = (inverse (cos x))\<^sup>2"
   for x :: "'a::{real_normed_field,banach,field}"
   by (simp add: add_divide_eq_iff inverse_eq_divide power2_eq_square tan_def)
 
 lemma arctan_less_iff: "arctan x < arctan y \<longleftrightarrow> x < y"
   by (metis tan_monotone' arctan_lbound arctan_ubound tan_arctan)
 
 lemma arctan_le_iff: "arctan x \<le> arctan y \<longleftrightarrow> x \<le> y"
   by (simp only: not_less [symmetric] arctan_less_iff)
 
 lemma arctan_eq_iff: "arctan x = arctan y \<longleftrightarrow> x = y"
   by (simp only: eq_iff [where 'a=real] arctan_le_iff)
 
 lemma zero_less_arctan_iff [simp]: "0 < arctan x \<longleftrightarrow> 0 < x"
   using arctan_less_iff [of 0 x] by simp
 
 lemma arctan_less_zero_iff [simp]: "arctan x < 0 \<longleftrightarrow> x < 0"
   using arctan_less_iff [of x 0] by simp
 
 lemma zero_le_arctan_iff [simp]: "0 \<le> arctan x \<longleftrightarrow> 0 \<le> x"
   using arctan_le_iff [of 0 x] by simp
 
 lemma arctan_le_zero_iff [simp]: "arctan x \<le> 0 \<longleftrightarrow> x \<le> 0"
   using arctan_le_iff [of x 0] by simp
 
 lemma arctan_eq_zero_iff [simp]: "arctan x = 0 \<longleftrightarrow> x = 0"
   using arctan_eq_iff [of x 0] by simp
 
 lemma continuous_on_arcsin': "continuous_on {-1 .. 1} arcsin"
 proof -
   have "continuous_on (sin ` {- pi/2 .. pi/2}) arcsin"
     by (rule continuous_on_inv) (auto intro: continuous_intros simp: arcsin_sin)
   also have "sin ` {- pi/2 .. pi/2} = {-1 .. 1}"
   proof safe
     fix x :: real
     assume "x \<in> {-1..1}"
     then show "x \<in> sin ` {- pi/2..pi/2}"
       using arcsin_lbound arcsin_ubound
       by (intro image_eqI[where x="arcsin x"]) auto
   qed simp
   finally show ?thesis .
 qed
 
 lemma continuous_on_arcsin [continuous_intros]:
   "continuous_on s f \<Longrightarrow> (\<forall>x\<in>s. -1 \<le> f x \<and> f x \<le> 1) \<Longrightarrow> continuous_on s (\<lambda>x. arcsin (f x))"
   using continuous_on_compose[of s f, OF _ continuous_on_subset[OF  continuous_on_arcsin']]
   by (auto simp: comp_def subset_eq)
 
 lemma isCont_arcsin: "-1 < x \<Longrightarrow> x < 1 \<Longrightarrow> isCont arcsin x"
   using continuous_on_arcsin'[THEN continuous_on_subset, of "{ -1 <..< 1 }"]
   by (auto simp: continuous_on_eq_continuous_at subset_eq)
 
 lemma continuous_on_arccos': "continuous_on {-1 .. 1} arccos"
 proof -
   have "continuous_on (cos ` {0 .. pi}) arccos"
     by (rule continuous_on_inv) (auto intro: continuous_intros simp: arccos_cos)
   also have "cos ` {0 .. pi} = {-1 .. 1}"
   proof safe
     fix x :: real
     assume "x \<in> {-1..1}"
     then show "x \<in> cos ` {0..pi}"
       using arccos_lbound arccos_ubound
       by (intro image_eqI[where x="arccos x"]) auto
   qed simp
   finally show ?thesis .
 qed
 
 lemma continuous_on_arccos [continuous_intros]:
   "continuous_on s f \<Longrightarrow> (\<forall>x\<in>s. -1 \<le> f x \<and> f x \<le> 1) \<Longrightarrow> continuous_on s (\<lambda>x. arccos (f x))"
   using continuous_on_compose[of s f, OF _ continuous_on_subset[OF  continuous_on_arccos']]
   by (auto simp: comp_def subset_eq)
 
 lemma isCont_arccos: "-1 < x \<Longrightarrow> x < 1 \<Longrightarrow> isCont arccos x"
   using continuous_on_arccos'[THEN continuous_on_subset, of "{ -1 <..< 1 }"]
   by (auto simp: continuous_on_eq_continuous_at subset_eq)
 
 lemma isCont_arctan: "isCont arctan x"
 proof -
-  obtain u where u: "- (pi / 2) < u" "u < arctan x"
+  obtain u where u: "- (pi/2) < u" "u < arctan x"
     by (meson arctan arctan_less_iff linordered_field_no_lb)
-  obtain v where v: "arctan x < v" "v < pi / 2"
+  obtain v where v: "arctan x < v" "v < pi/2"
     by (meson arctan_less_iff arctan_ubound linordered_field_no_ub)
   have "isCont arctan (tan (arctan x))"
   proof (rule isCont_inverse_function2 [of u "arctan x" v])
     show "\<And>z. \<lbrakk>u \<le> z; z \<le> v\<rbrakk> \<Longrightarrow> arctan (tan z) = z"
       using arctan_unique u(1) v(2) by auto
     then show "\<And>z. \<lbrakk>u \<le> z; z \<le> v\<rbrakk> \<Longrightarrow> isCont tan z"
       by (metis arctan cos_gt_zero_pi isCont_tan less_irrefl)
   qed (use u v in auto)
   then show ?thesis
     by (simp add: arctan)
 qed
 
 lemma tendsto_arctan [tendsto_intros]: "(f \<longlongrightarrow> x) F \<Longrightarrow> ((\<lambda>x. arctan (f x)) \<longlongrightarrow> arctan x) F"
   by (rule isCont_tendsto_compose [OF isCont_arctan])
 
 lemma continuous_arctan [continuous_intros]: "continuous F f \<Longrightarrow> continuous F (\<lambda>x. arctan (f x))"
   unfolding continuous_def by (rule tendsto_arctan)
 
 lemma continuous_on_arctan [continuous_intros]:
   "continuous_on s f \<Longrightarrow> continuous_on s (\<lambda>x. arctan (f x))"
   unfolding continuous_on_def by (auto intro: tendsto_arctan)
 
 lemma DERIV_arcsin:
   assumes "- 1 < x" "x < 1"
   shows "DERIV arcsin x :> inverse (sqrt (1 - x\<^sup>2))"
 proof (rule DERIV_inverse_function)
   show "(sin has_real_derivative sqrt (1 - x\<^sup>2)) (at (arcsin x))"
     by (rule derivative_eq_intros | use assms cos_arcsin in force)+
   show "sqrt (1 - x\<^sup>2) \<noteq> 0"
     using abs_square_eq_1 assms by force
 qed (use assms isCont_arcsin in auto)
 
 lemma DERIV_arccos:
   assumes "- 1 < x" "x < 1"
   shows "DERIV arccos x :> inverse (- sqrt (1 - x\<^sup>2))"
 proof (rule DERIV_inverse_function)
   show "(cos has_real_derivative - sqrt (1 - x\<^sup>2)) (at (arccos x))"
     by (rule derivative_eq_intros | use assms sin_arccos in force)+
   show "- sqrt (1 - x\<^sup>2) \<noteq> 0"
     using abs_square_eq_1 assms by force
 qed (use assms isCont_arccos in auto)
 
 lemma DERIV_arctan: "DERIV arctan x :> inverse (1 + x\<^sup>2)"
 proof (rule DERIV_inverse_function)
   have "inverse ((cos (arctan x))\<^sup>2) = 1 + x\<^sup>2"
     by (metis arctan cos_arctan_not_zero power_inverse tan_sec)
   then show "(tan has_real_derivative 1 + x\<^sup>2) (at (arctan x))"
     by (auto intro!: derivative_eq_intros)
   show "\<And>y. \<lbrakk>x - 1 < y; y < x + 1\<rbrakk> \<Longrightarrow> tan (arctan y) = y"
     using tan_arctan by blast
   show "1 + x\<^sup>2 \<noteq> 0"
     by (metis power_one sum_power2_eq_zero_iff zero_neq_one)
 qed (use isCont_arctan in auto)
 
 declare
   DERIV_arcsin[THEN DERIV_chain2, derivative_intros]
   DERIV_arcsin[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]
   DERIV_arccos[THEN DERIV_chain2, derivative_intros]
   DERIV_arccos[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]
   DERIV_arctan[THEN DERIV_chain2, derivative_intros]
   DERIV_arctan[THEN DERIV_chain2, unfolded has_field_derivative_def, derivative_intros]
 
 lemmas has_derivative_arctan[derivative_intros] = DERIV_arctan[THEN DERIV_compose_FDERIV]
   and has_derivative_arccos[derivative_intros] = DERIV_arccos[THEN DERIV_compose_FDERIV]
   and has_derivative_arcsin[derivative_intros] = DERIV_arcsin[THEN DERIV_compose_FDERIV]
 
 lemma filterlim_tan_at_right: "filterlim tan at_bot (at_right (- (pi/2)))"
   by (rule filterlim_at_bot_at_right[where Q="\<lambda>x. - pi/2 < x \<and> x < pi/2" and P="\<lambda>x. True" and g=arctan])
      (auto simp: arctan le_less eventually_at dist_real_def simp del: less_divide_eq_numeral1
            intro!: tan_monotone exI[of _ "pi/2"])
 
 lemma filterlim_tan_at_left: "filterlim tan at_top (at_left (pi/2))"
   by (rule filterlim_at_top_at_left[where Q="\<lambda>x. - pi/2 < x \<and> x < pi/2" and P="\<lambda>x. True" and g=arctan])
      (auto simp: arctan le_less eventually_at dist_real_def simp del: less_divide_eq_numeral1
            intro!: tan_monotone exI[of _ "pi/2"])
 
 lemma tendsto_arctan_at_top: "(arctan \<longlongrightarrow> (pi/2)) at_top"
 proof (rule tendstoI)
   fix e :: real
   assume "0 < e"
   define y where "y = pi/2 - min (pi/2) e"
   then have y: "0 \<le> y" "y < pi/2" "pi/2 \<le> e + y"
     using \<open>0 < e\<close> by auto
   show "eventually (\<lambda>x. dist (arctan x) (pi/2) < e) at_top"
   proof (intro eventually_at_top_dense[THEN iffD2] exI allI impI)
     fix x
     assume "tan y < x"
     then have "arctan (tan y) < arctan x"
       by (simp add: arctan_less_iff)
     with y have "y < arctan x"
       by (subst (asm) arctan_tan) simp_all
     with arctan_ubound[of x, arith] y \<open>0 < e\<close>
     show "dist (arctan x) (pi/2) < e"
       by (simp add: dist_real_def)
   qed
 qed
 
 lemma tendsto_arctan_at_bot: "(arctan \<longlongrightarrow> - (pi/2)) at_bot"
   unfolding filterlim_at_bot_mirror arctan_minus
   by (intro tendsto_minus tendsto_arctan_at_top)
 
 
 subsection \<open>Prove Totality of the Trigonometric Functions\<close>
 
 lemma cos_arccos_abs: "\<bar>y\<bar> \<le> 1 \<Longrightarrow> cos (arccos y) = y"
   by (simp add: abs_le_iff)
 
 lemma sin_arccos_abs: "\<bar>y\<bar> \<le> 1 \<Longrightarrow> sin (arccos y) = sqrt (1 - y\<^sup>2)"
   by (simp add: sin_arccos abs_le_iff)
 
 lemma sin_mono_less_eq:
   "- (pi/2) \<le> x \<Longrightarrow> x \<le> pi/2 \<Longrightarrow> - (pi/2) \<le> y \<Longrightarrow> y \<le> pi/2 \<Longrightarrow> sin x < sin y \<longleftrightarrow> x < y"
   by (metis not_less_iff_gr_or_eq sin_monotone_2pi)
 
 lemma sin_mono_le_eq:
   "- (pi/2) \<le> x \<Longrightarrow> x \<le> pi/2 \<Longrightarrow> - (pi/2) \<le> y \<Longrightarrow> y \<le> pi/2 \<Longrightarrow> sin x \<le> sin y \<longleftrightarrow> x \<le> y"
   by (meson leD le_less_linear sin_monotone_2pi sin_monotone_2pi_le)
 
 lemma sin_inj_pi:
   "- (pi/2) \<le> x \<Longrightarrow> x \<le> pi/2 \<Longrightarrow> - (pi/2) \<le> y \<Longrightarrow> y \<le> pi/2 \<Longrightarrow> sin x = sin y \<Longrightarrow> x = y"
   by (metis arcsin_sin)
 
 lemma arcsin_le_iff:
   assumes "x \<ge> -1" "x \<le> 1" "y \<ge> -pi/2" "y \<le> pi/2"
   shows   "arcsin x \<le> y \<longleftrightarrow> x \<le> sin y"
 proof -
   have "arcsin x \<le> y \<longleftrightarrow> sin (arcsin x) \<le> sin y"
     using arcsin_bounded[of x] assms by (subst sin_mono_le_eq) auto
   also from assms have "sin (arcsin x) = x" by simp
   finally show ?thesis .
 qed
 
 lemma le_arcsin_iff:
   assumes "x \<ge> -1" "x \<le> 1" "y \<ge> -pi/2" "y \<le> pi/2"
   shows   "arcsin x \<ge> y \<longleftrightarrow> x \<ge> sin y"
 proof -
   have "arcsin x \<ge> y \<longleftrightarrow> sin (arcsin x) \<ge> sin y"
     using arcsin_bounded[of x] assms by (subst sin_mono_le_eq) auto
   also from assms have "sin (arcsin x) = x" by simp
   finally show ?thesis .
 qed
 
 lemma cos_mono_less_eq: "0 \<le> x \<Longrightarrow> x \<le> pi \<Longrightarrow> 0 \<le> y \<Longrightarrow> y \<le> pi \<Longrightarrow> cos x < cos y \<longleftrightarrow> y < x"
   by (meson cos_monotone_0_pi cos_monotone_0_pi_le leD le_less_linear)
 
 lemma cos_mono_le_eq: "0 \<le> x \<Longrightarrow> x \<le> pi \<Longrightarrow> 0 \<le> y \<Longrightarrow> y \<le> pi \<Longrightarrow> cos x \<le> cos y \<longleftrightarrow> y \<le> x"
   by (metis arccos_cos cos_monotone_0_pi_le eq_iff linear)
 
 lemma cos_inj_pi: "0 \<le> x \<Longrightarrow> x \<le> pi \<Longrightarrow> 0 \<le> y \<Longrightarrow> y \<le> pi \<Longrightarrow> cos x = cos y \<Longrightarrow> x = y"
   by (metis arccos_cos)
 
 lemma arccos_le_pi2: "\<lbrakk>0 \<le> y; y \<le> 1\<rbrakk> \<Longrightarrow> arccos y \<le> pi/2"
   by (metis (mono_tags) arccos_0 arccos cos_le_one cos_monotone_0_pi_le
       cos_pi cos_pi_half pi_half_ge_zero antisym_conv less_eq_neg_nonpos linear minus_minus order.trans order_refl)
 
 lemma sincos_total_pi_half:
   assumes "0 \<le> x" "0 \<le> y" "x\<^sup>2 + y\<^sup>2 = 1"
   shows "\<exists>t. 0 \<le> t \<and> t \<le> pi/2 \<and> x = cos t \<and> y = sin t"
 proof -
   have x1: "x \<le> 1"
     using assms by (metis le_add_same_cancel1 power2_le_imp_le power_one zero_le_power2)
   with assms have *: "0 \<le> arccos x" "cos (arccos x) = x"
     by (auto simp: arccos)
   from assms have "y = sqrt (1 - x\<^sup>2)"
     by (metis abs_of_nonneg add.commute add_diff_cancel real_sqrt_abs)
   with x1 * assms arccos_le_pi2 [of x] show ?thesis
     by (rule_tac x="arccos x" in exI) (auto simp: sin_arccos)
 qed
 
 lemma sincos_total_pi:
   assumes "0 \<le> y" "x\<^sup>2 + y\<^sup>2 = 1"
   shows "\<exists>t. 0 \<le> t \<and> t \<le> pi \<and> x = cos t \<and> y = sin t"
 proof (cases rule: le_cases [of 0 x])
   case le
   from sincos_total_pi_half [OF le] show ?thesis
     by (metis pi_ge_two pi_half_le_two add.commute add_le_cancel_left add_mono assms)
 next
   case ge
   then have "0 \<le> -x"
     by simp
   then obtain t where t: "t\<ge>0" "t \<le> pi/2" "-x = cos t" "y = sin t"
     using sincos_total_pi_half assms
     by auto (metis \<open>0 \<le> - x\<close> power2_minus)
   show ?thesis
     by (rule exI [where x = "pi -t"]) (use t in auto)
 qed
 
 lemma sincos_total_2pi_le:
   assumes "x\<^sup>2 + y\<^sup>2 = 1"
   shows "\<exists>t. 0 \<le> t \<and> t \<le> 2 * pi \<and> x = cos t \<and> y = sin t"
 proof (cases rule: le_cases [of 0 y])
   case le
   from sincos_total_pi [OF le] show ?thesis
     by (metis assms le_add_same_cancel1 mult.commute mult_2_right order.trans)
 next
   case ge
   then have "0 \<le> -y"
     by simp
   then obtain t where t: "t\<ge>0" "t \<le> pi" "x = cos t" "-y = sin t"
     using sincos_total_pi assms
     by auto (metis \<open>0 \<le> - y\<close> power2_minus)
   show ?thesis
     by (rule exI [where x = "2 * pi - t"]) (use t in auto)
 qed
 
 lemma sincos_total_2pi:
   assumes "x\<^sup>2 + y\<^sup>2 = 1"
   obtains t where "0 \<le> t" "t < 2*pi" "x = cos t" "y = sin t"
 proof -
   from sincos_total_2pi_le [OF assms]
   obtain t where t: "0 \<le> t" "t \<le> 2*pi" "x = cos t" "y = sin t"
     by blast
   show ?thesis
     by (cases "t = 2 * pi") (use t that in \<open>force+\<close>)
 qed
 
 lemma arcsin_less_mono: "\<bar>x\<bar> \<le> 1 \<Longrightarrow> \<bar>y\<bar> \<le> 1 \<Longrightarrow> arcsin x < arcsin y \<longleftrightarrow> x < y"
   by (rule trans [OF sin_mono_less_eq [symmetric]]) (use arcsin_ubound arcsin_lbound in auto)
 
 lemma arcsin_le_mono: "\<bar>x\<bar> \<le> 1 \<Longrightarrow> \<bar>y\<bar> \<le> 1 \<Longrightarrow> arcsin x \<le> arcsin y \<longleftrightarrow> x \<le> y"
   using arcsin_less_mono not_le by blast
 
 lemma arcsin_less_arcsin: "- 1 \<le> x \<Longrightarrow> x < y \<Longrightarrow> y \<le> 1 \<Longrightarrow> arcsin x < arcsin y"
   using arcsin_less_mono by auto
 
 lemma arcsin_le_arcsin: "- 1 \<le> x \<Longrightarrow> x \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> arcsin x \<le> arcsin y"
   using arcsin_le_mono by auto
 
+lemma arcsin_nonneg: "x \<in> {0..1} \<Longrightarrow> arcsin x \<ge> 0"
+  using arcsin_le_arcsin[of 0 x] by simp
+  
 lemma arccos_less_mono: "\<bar>x\<bar> \<le> 1 \<Longrightarrow> \<bar>y\<bar> \<le> 1 \<Longrightarrow> arccos x < arccos y \<longleftrightarrow> y < x"
   by (rule trans [OF cos_mono_less_eq [symmetric]]) (use arccos_ubound arccos_lbound in auto)
 
 lemma arccos_le_mono: "\<bar>x\<bar> \<le> 1 \<Longrightarrow> \<bar>y\<bar> \<le> 1 \<Longrightarrow> arccos x \<le> arccos y \<longleftrightarrow> y \<le> x"
   using arccos_less_mono [of y x] by (simp add: not_le [symmetric])
 
 lemma arccos_less_arccos: "- 1 \<le> x \<Longrightarrow> x < y \<Longrightarrow> y \<le> 1 \<Longrightarrow> arccos y < arccos x"
   using arccos_less_mono by auto
 
 lemma arccos_le_arccos: "- 1 \<le> x \<Longrightarrow> x \<le> y \<Longrightarrow> y \<le> 1 \<Longrightarrow> arccos y \<le> arccos x"
   using arccos_le_mono by auto
 
 lemma arccos_eq_iff: "\<bar>x\<bar> \<le> 1 \<and> \<bar>y\<bar> \<le> 1 \<Longrightarrow> arccos x = arccos y \<longleftrightarrow> x = y"
   using cos_arccos_abs by fastforce
 
 
 lemma arccos_cos_eq_abs:
   assumes "\<bar>\<theta>\<bar> \<le> pi"
   shows "arccos (cos \<theta>) = \<bar>\<theta>\<bar>"
   unfolding arccos_def
 proof (intro the_equality conjI; clarify?)
   show "cos \<bar>\<theta>\<bar> = cos \<theta>"
     by (simp add: abs_real_def)
   show "x = \<bar>\<theta>\<bar>" if "cos x = cos \<theta>" "0 \<le> x" "x \<le> pi" for x
     by (simp add: \<open>cos \<bar>\<theta>\<bar> = cos \<theta>\<close> assms cos_inj_pi that)
 qed (use assms in auto)
 
 lemma arccos_cos_eq_abs_2pi:
   obtains k where "arccos (cos \<theta>) = \<bar>\<theta> - of_int k * (2 * pi)\<bar>"
 proof -
   define k where "k \<equiv>  \<lfloor>(\<theta> + pi) / (2 * pi)\<rfloor>"
   have lepi: "\<bar>\<theta> - of_int k * (2 * pi)\<bar> \<le> pi"
     using floor_divide_lower [of "2*pi" "\<theta> + pi"] floor_divide_upper [of "2*pi" "\<theta> + pi"]
     by (auto simp: k_def abs_if algebra_simps)
   have "arccos (cos \<theta>) = arccos (cos (\<theta> - of_int k * (2 * pi)))"
     using cos_int_2pin sin_int_2pin by (simp add: cos_diff mult.commute)
   also have "\<dots> = \<bar>\<theta> - of_int k * (2 * pi)\<bar>"
     using arccos_cos_eq_abs lepi by blast
   finally show ?thesis
     using that by metis
 qed
 
 lemma arccos_arctan:
   assumes "-1 < x" "x < 1"
   shows "arccos x = pi/2 - arctan(x / sqrt(1 - x\<^sup>2))"
 proof -
   have "arctan(x / sqrt(1 - x\<^sup>2)) - (pi/2 - arccos x) = 0"
   proof (rule sin_eq_0_pi)
-    show "- pi < arctan (x / sqrt (1 - x\<^sup>2)) - (pi / 2 - arccos x)"
+    show "- pi < arctan (x / sqrt (1 - x\<^sup>2)) - (pi/2 - arccos x)"
       using arctan_lbound [of "x / sqrt(1 - x\<^sup>2)"]  arccos_bounded [of x] assms
       by (simp add: algebra_simps)
   next
-    show "arctan (x / sqrt (1 - x\<^sup>2)) - (pi / 2 - arccos x) < pi"
+    show "arctan (x / sqrt (1 - x\<^sup>2)) - (pi/2 - arccos x) < pi"
       using arctan_ubound [of "x / sqrt(1 - x\<^sup>2)"]  arccos_bounded [of x] assms
       by (simp add: algebra_simps)
   next
-    show "sin (arctan (x / sqrt (1 - x\<^sup>2)) - (pi / 2 - arccos x)) = 0"
+    show "sin (arctan (x / sqrt (1 - x\<^sup>2)) - (pi/2 - arccos x)) = 0"
       using assms
       by (simp add: algebra_simps sin_diff cos_add sin_arccos sin_arctan cos_arctan
                     power2_eq_square square_eq_1_iff)
   qed
   then show ?thesis
     by simp
 qed
 
 lemma arcsin_plus_arccos:
   assumes "-1 \<le> x" "x \<le> 1"
     shows "arcsin x + arccos x = pi/2"
 proof -
   have "arcsin x = pi/2 - arccos x"
     apply (rule sin_inj_pi)
     using assms arcsin [OF assms] arccos [OF assms]
     by (auto simp: algebra_simps sin_diff)
   then show ?thesis
     by (simp add: algebra_simps)
 qed
 
 lemma arcsin_arccos_eq: "-1 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> arcsin x = pi/2 - arccos x"
   using arcsin_plus_arccos by force
 
 lemma arccos_arcsin_eq: "-1 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> arccos x = pi/2 - arcsin x"
   using arcsin_plus_arccos by force
 
 lemma arcsin_arctan: "-1 < x \<Longrightarrow> x < 1 \<Longrightarrow> arcsin x = arctan(x / sqrt(1 - x\<^sup>2))"
   by (simp add: arccos_arctan arcsin_arccos_eq)
 
 lemma arcsin_arccos_sqrt_pos: "0 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> arcsin x = arccos(sqrt(1 - x\<^sup>2))"
   by (smt (verit, del_insts) arccos_cos arcsin_0 arcsin_le_arcsin arcsin_pi cos_arcsin)
 
 lemma arcsin_arccos_sqrt_neg: "-1 \<le> x \<Longrightarrow> x \<le> 0 \<Longrightarrow> arcsin x = -arccos(sqrt(1 - x\<^sup>2))"
   using arcsin_arccos_sqrt_pos [of "-x"]
   by (simp add: arcsin_minus)
 
 lemma arccos_arcsin_sqrt_pos: "0 \<le> x \<Longrightarrow> x \<le> 1 \<Longrightarrow> arccos x = arcsin(sqrt(1 - x\<^sup>2))"
   by (smt (verit, del_insts) arccos_lbound arccos_le_pi2 arcsin_sin sin_arccos)
 
 lemma arccos_arcsin_sqrt_neg: "-1 \<le> x \<Longrightarrow> x \<le> 0 \<Longrightarrow> arccos x = pi - arcsin(sqrt(1 - x\<^sup>2))"
   using arccos_arcsin_sqrt_pos [of "-x"]
   by (simp add: arccos_minus)
 
 lemma cos_limit_1:
   assumes "(\<lambda>j. cos (\<theta> j)) \<longlonglongrightarrow> 1"
   shows "\<exists>k. (\<lambda>j. \<theta> j - of_int (k j) * (2 * pi)) \<longlonglongrightarrow> 0"
 proof -
   have "\<forall>\<^sub>F j in sequentially. cos (\<theta> j) \<in> {- 1..1}"
     by auto
   then have "(\<lambda>j. arccos (cos (\<theta> j))) \<longlonglongrightarrow> arccos 1"
     using continuous_on_tendsto_compose [OF continuous_on_arccos' assms] by auto
   moreover have "\<And>j. \<exists>k. arccos (cos (\<theta> j)) = \<bar>\<theta> j - of_int k * (2 * pi)\<bar>"
     using arccos_cos_eq_abs_2pi by metis
   then have "\<exists>k. \<forall>j. arccos (cos (\<theta> j)) = \<bar>\<theta> j - of_int (k j) * (2 * pi)\<bar>"
     by metis
   ultimately have "\<exists>k. (\<lambda>j. \<bar>\<theta> j - of_int (k j) * (2 * pi)\<bar>) \<longlonglongrightarrow> 0"
     by auto
   then show ?thesis
     by (simp add: tendsto_rabs_zero_iff)
 qed
 
 lemma cos_diff_limit_1:
   assumes "(\<lambda>j. cos (\<theta> j - \<Theta>)) \<longlonglongrightarrow> 1"
   obtains k where "(\<lambda>j. \<theta> j - of_int (k j) * (2 * pi)) \<longlonglongrightarrow> \<Theta>"
 proof -
   obtain k where "(\<lambda>j. (\<theta> j - \<Theta>) - of_int (k j) * (2 * pi)) \<longlonglongrightarrow> 0"
     using cos_limit_1 [OF assms] by auto
   then have "(\<lambda>j. \<Theta> + ((\<theta> j - \<Theta>) - of_int (k j) * (2 * pi))) \<longlonglongrightarrow> \<Theta> + 0"
     by (rule tendsto_add [OF tendsto_const])
   with that show ?thesis
     by auto
 qed
 
 subsection \<open>Machin's formula\<close>
 
-lemma arctan_one: "arctan 1 = pi / 4"
+lemma arctan_one: "arctan 1 = pi/4"
   by (rule arctan_unique) (simp_all add: tan_45 m2pi_less_pi)
 
 lemma tan_total_pi4:
   assumes "\<bar>x\<bar> < 1"
-  shows "\<exists>z. - (pi / 4) < z \<and> z < pi / 4 \<and> tan z = x"
+  shows "\<exists>z. - (pi/4) < z \<and> z < pi/4 \<and> tan z = x"
 proof
-  show "- (pi / 4) < arctan x \<and> arctan x < pi / 4 \<and> tan (arctan x) = x"
+  show "- (pi/4) < arctan x \<and> arctan x < pi/4 \<and> tan (arctan x) = x"
     unfolding arctan_one [symmetric] arctan_minus [symmetric]
     unfolding arctan_less_iff
     using assms by (auto simp: arctan)
 qed
 
 lemma arctan_add:
   assumes "\<bar>x\<bar> \<le> 1" "\<bar>y\<bar> < 1"
   shows "arctan x + arctan y = arctan ((x + y) / (1 - x * y))"
 proof (rule arctan_unique [symmetric])
-  have "- (pi / 4) \<le> arctan x" "- (pi / 4) < arctan y"
+  have "- (pi/4) \<le> arctan x" "- (pi/4) < arctan y"
     unfolding arctan_one [symmetric] arctan_minus [symmetric]
     unfolding arctan_le_iff arctan_less_iff
     using assms by auto
   from add_le_less_mono [OF this] show 1: "- (pi/2) < arctan x + arctan y"
     by simp
-  have "arctan x \<le> pi / 4" "arctan y < pi / 4"
+  have "arctan x \<le> pi/4" "arctan y < pi/4"
     unfolding arctan_one [symmetric]
     unfolding arctan_le_iff arctan_less_iff
     using assms by auto
   from add_le_less_mono [OF this] show 2: "arctan x + arctan y < pi/2"
     by simp
   show "tan (arctan x + arctan y) = (x + y) / (1 - x * y)"
     using cos_gt_zero_pi [OF 1 2] by (simp add: arctan tan_add)
 qed
 
 lemma arctan_double: "\<bar>x\<bar> < 1 \<Longrightarrow> 2 * arctan x = arctan ((2 * x) / (1 - x\<^sup>2))"
   by (metis arctan_add linear mult_2 not_less power2_eq_square)
 
-theorem machin: "pi / 4 = 4 * arctan (1 / 5) - arctan (1 / 239)"
+theorem machin: "pi/4 = 4 * arctan (1 / 5) - arctan (1/239)"
 proof -
   have "\<bar>1 / 5\<bar> < (1 :: real)"
     by auto
   from arctan_add[OF less_imp_le[OF this] this] have "2 * arctan (1 / 5) = arctan (5 / 12)"
     by auto
   moreover
   have "\<bar>5 / 12\<bar> < (1 :: real)"
     by auto
   from arctan_add[OF less_imp_le[OF this] this] have "2 * arctan (5 / 12) = arctan (120 / 119)"
     by auto
   moreover
-  have "\<bar>1\<bar> \<le> (1::real)" and "\<bar>1 / 239\<bar> < (1::real)"
+  have "\<bar>1\<bar> \<le> (1::real)" and "\<bar>1/239\<bar> < (1::real)"
     by auto
-  from arctan_add[OF this] have "arctan 1 + arctan (1 / 239) = arctan (120 / 119)"
+  from arctan_add[OF this] have "arctan 1 + arctan (1/239) = arctan (120 / 119)"
     by auto
-  ultimately have "arctan 1 + arctan (1 / 239) = 4 * arctan (1 / 5)"
+  ultimately have "arctan 1 + arctan (1/239) = 4 * arctan (1 / 5)"
     by auto
   then show ?thesis
     unfolding arctan_one by algebra
 qed
 
-lemma machin_Euler: "5 * arctan (1 / 7) + 2 * arctan (3 / 79) = pi / 4"
+lemma machin_Euler: "5 * arctan (1 / 7) + 2 * arctan (3 / 79) = pi/4"
 proof -
   have 17: "\<bar>1 / 7\<bar> < (1 :: real)" by auto
   with arctan_double have "2 * arctan (1 / 7) = arctan (7 / 24)"
     by simp (simp add: field_simps)
   moreover
   have "\<bar>7 / 24\<bar> < (1 :: real)" by auto
   with arctan_double have "2 * arctan (7 / 24) = arctan (336 / 527)"
     by simp (simp add: field_simps)
   moreover
   have "\<bar>336 / 527\<bar> < (1 :: real)" by auto
   from arctan_add[OF less_imp_le[OF 17] this]
   have "arctan(1/7) + arctan (336 / 527) = arctan (2879 / 3353)"
     by auto
   ultimately have I: "5 * arctan (1 / 7) = arctan (2879 / 3353)" by auto
   have 379: "\<bar>3 / 79\<bar> < (1 :: real)" by auto
   with arctan_double have II: "2 * arctan (3 / 79) = arctan (237 / 3116)"
     by simp (simp add: field_simps)
   have *: "\<bar>2879 / 3353\<bar> < (1 :: real)" by auto
   have "\<bar>237 / 3116\<bar> < (1 :: real)" by auto
   from arctan_add[OF less_imp_le[OF *] this] have "arctan (2879/3353) + arctan (237/3116) = pi/4"
     by (simp add: arctan_one)
   with I II show ?thesis by auto
 qed
 
 (*But could also prove MACHIN_GAUSS:
   12 * arctan(1/18) + 8 * arctan(1/57) - 5 * arctan(1/239) = pi/4*)
 
 
 subsection \<open>Introducing the inverse tangent power series\<close>
 
 lemma monoseq_arctan_series:
   fixes x :: real
   assumes "\<bar>x\<bar> \<le> 1"
   shows "monoseq (\<lambda>n. 1 / real (n * 2 + 1) * x^(n * 2 + 1))"
     (is "monoseq ?a")
 proof (cases "x = 0")
   case True
   then show ?thesis by (auto simp: monoseq_def)
 next
   case False
   have "norm x \<le> 1" and "x \<le> 1" and "-1 \<le> x"
     using assms by auto
   show "monoseq ?a"
   proof -
     have mono: "1 / real (Suc (Suc n * 2)) * x ^ Suc (Suc n * 2) \<le>
         1 / real (Suc (n * 2)) * x ^ Suc (n * 2)"
       if "0 \<le> x" and "x \<le> 1" for n and x :: real
     proof (rule mult_mono)
       show "1 / real (Suc (Suc n * 2)) \<le> 1 / real (Suc (n * 2))"
         by (rule frac_le) simp_all
       show "0 \<le> 1 / real (Suc (n * 2))"
         by auto
       show "x ^ Suc (Suc n * 2) \<le> x ^ Suc (n * 2)"
         by (rule power_decreasing) (simp_all add: \<open>0 \<le> x\<close> \<open>x \<le> 1\<close>)
       show "0 \<le> x ^ Suc (Suc n * 2)"
         by (rule zero_le_power) (simp add: \<open>0 \<le> x\<close>)
     qed
     show ?thesis
     proof (cases "0 \<le> x")
       case True
       from mono[OF this \<open>x \<le> 1\<close>, THEN allI]
       show ?thesis
         unfolding Suc_eq_plus1[symmetric] by (rule mono_SucI2)
     next
       case False
       then have "0 \<le> - x" and "- x \<le> 1"
         using \<open>-1 \<le> x\<close> by auto
       from mono[OF this]
       have "1 / real (Suc (Suc n * 2)) * x ^ Suc (Suc n * 2) \<ge>
           1 / real (Suc (n * 2)) * x ^ Suc (n * 2)" for n
         using \<open>0 \<le> -x\<close> by auto
       then show ?thesis
         unfolding Suc_eq_plus1[symmetric] by (rule mono_SucI1[OF allI])
     qed
   qed
 qed
 
 lemma zeroseq_arctan_series:
   fixes x :: real
   assumes "\<bar>x\<bar> \<le> 1"
   shows "(\<lambda>n. 1 / real (n * 2 + 1) * x^(n * 2 + 1)) \<longlonglongrightarrow> 0"
     (is "?a \<longlonglongrightarrow> 0")
 proof (cases "x = 0")
   case True
   then show ?thesis by simp
 next
   case False
   have "norm x \<le> 1" and "x \<le> 1" and "-1 \<le> x"
     using assms by auto
   show "?a \<longlonglongrightarrow> 0"
   proof (cases "\<bar>x\<bar> < 1")
     case True
     then have "norm x < 1" by auto
     from tendsto_mult[OF LIMSEQ_inverse_real_of_nat LIMSEQ_power_zero[OF \<open>norm x < 1\<close>, THEN LIMSEQ_Suc]]
     have "(\<lambda>n. 1 / real (n + 1) * x ^ (n + 1)) \<longlonglongrightarrow> 0"
       unfolding inverse_eq_divide Suc_eq_plus1 by simp
     then show ?thesis
       using pos2 by (rule LIMSEQ_linear)
   next
     case False
     then have "x = -1 \<or> x = 1"
       using \<open>\<bar>x\<bar> \<le> 1\<close> by auto
     then have n_eq: "\<And> n. x ^ (n * 2 + 1) = x"
       unfolding One_nat_def by auto
     from tendsto_mult[OF LIMSEQ_inverse_real_of_nat[THEN LIMSEQ_linear, OF pos2, unfolded inverse_eq_divide] tendsto_const[of x]]
     show ?thesis
       unfolding n_eq Suc_eq_plus1 by auto
   qed
 qed
 
 lemma summable_arctan_series:
   fixes n :: nat
   assumes "\<bar>x\<bar> \<le> 1"
   shows "summable (\<lambda> k. (-1)^k * (1 / real (k*2+1) * x ^ (k*2+1)))"
     (is "summable (?c x)")
   by (rule summable_Leibniz(1),
       rule zeroseq_arctan_series[OF assms],
       rule monoseq_arctan_series[OF assms])
 
 lemma DERIV_arctan_series:
   assumes "\<bar>x\<bar> < 1"
   shows "DERIV (\<lambda>x'. \<Sum>k. (-1)^k * (1 / real (k * 2 + 1) * x' ^ (k * 2 + 1))) x :>
       (\<Sum>k. (-1)^k * x^(k * 2))"
     (is "DERIV ?arctan _ :> ?Int")
 proof -
   let ?f = "\<lambda>n. if even n then (-1)^(n div 2) * 1 / real (Suc n) else 0"
 
   have n_even: "even n \<Longrightarrow> 2 * (n div 2) = n" for n :: nat
     by presburger
   then have if_eq: "?f n * real (Suc n) * x'^n =
       (if even n then (-1)^(n div 2) * x'^(2 * (n div 2)) else 0)"
     for n x'
     by auto
 
   have summable_Integral: "summable (\<lambda> n. (- 1) ^ n * x^(2 * n))" if "\<bar>x\<bar> < 1" for x :: real
   proof -
     from that have "x\<^sup>2 < 1"
       by (simp add: abs_square_less_1)
     have "summable (\<lambda> n. (- 1) ^ n * (x\<^sup>2) ^n)"
       by (rule summable_Leibniz(1))
         (auto intro!: LIMSEQ_realpow_zero monoseq_realpow \<open>x\<^sup>2 < 1\<close> order_less_imp_le[OF \<open>x\<^sup>2 < 1\<close>])
     then show ?thesis
       by (simp only: power_mult)
   qed
 
   have sums_even: "(sums) f = (sums) (\<lambda> n. if even n then f (n div 2) else 0)"
     for f :: "nat \<Rightarrow> real"
   proof -
     have "f sums x = (\<lambda> n. if even n then f (n div 2) else 0) sums x" for x :: real
     proof
       assume "f sums x"
       from sums_if[OF sums_zero this] show "(\<lambda>n. if even n then f (n div 2) else 0) sums x"
         by auto
     next
       assume "(\<lambda> n. if even n then f (n div 2) else 0) sums x"
       from LIMSEQ_linear[OF this[simplified sums_def] pos2, simplified sum_split_even_odd[simplified mult.commute]]
       show "f sums x"
         unfolding sums_def by auto
     qed
     then show ?thesis ..
   qed
 
   have Int_eq: "(\<Sum>n. ?f n * real (Suc n) * x^n) = ?Int"
     unfolding if_eq mult.commute[of _ 2]
       suminf_def sums_even[of "\<lambda> n. (- 1) ^ n * x ^ (2 * n)", symmetric]
     by auto
 
   have arctan_eq: "(\<Sum>n. ?f n * x^(Suc n)) = ?arctan x" for x
   proof -
     have if_eq': "\<And>n. (if even n then (- 1) ^ (n div 2) * 1 / real (Suc n) else 0) * x ^ Suc n =
       (if even n then (- 1) ^ (n div 2) * (1 / real (Suc (2 * (n div 2))) * x ^ Suc (2 * (n div 2))) else 0)"
       using n_even by auto
     have idx_eq: "\<And>n. n * 2 + 1 = Suc (2 * n)"
       by auto
     then show ?thesis
       unfolding if_eq' idx_eq suminf_def
         sums_even[of "\<lambda> n. (- 1) ^ n * (1 / real (Suc (2 * n)) * x ^ Suc (2 * n))", symmetric]
       by auto
   qed
 
   have "DERIV (\<lambda> x. \<Sum> n. ?f n * x^(Suc n)) x :> (\<Sum>n. ?f n * real (Suc n) * x^n)"
   proof (rule DERIV_power_series')
     show "x \<in> {- 1 <..< 1}"
       using \<open>\<bar> x \<bar> < 1\<close> by auto
     show "summable (\<lambda> n. ?f n * real (Suc n) * x'^n)"
       if x'_bounds: "x' \<in> {- 1 <..< 1}" for x' :: real
     proof -
       from that have "\<bar>x'\<bar> < 1" by auto
       then show ?thesis
         using that sums_summable sums_if [OF sums_0 [of "\<lambda>x. 0"] summable_sums [OF summable_Integral]]   
         by (auto simp add: if_distrib [of "\<lambda>x. x * y" for y] cong: if_cong)
     qed
   qed auto
   then show ?thesis
     by (simp only: Int_eq arctan_eq)
 qed
 
 lemma arctan_series:
   assumes "\<bar>x\<bar> \<le> 1"
   shows "arctan x = (\<Sum>k. (-1)^k * (1 / real (k * 2 + 1) * x ^ (k * 2 + 1)))"
     (is "_ = suminf (\<lambda> n. ?c x n)")
 proof -
   let ?c' = "\<lambda>x n. (-1)^n * x^(n*2)"
 
   have DERIV_arctan_suminf: "DERIV (\<lambda> x. suminf (?c x)) x :> (suminf (?c' x))"
     if "0 < r" and "r < 1" and "\<bar>x\<bar> < r" for r x :: real
   proof (rule DERIV_arctan_series)
     from that show "\<bar>x\<bar> < 1"
       using \<open>r < 1\<close> and \<open>\<bar>x\<bar> < r\<close> by auto
   qed
 
   {
     fix x :: real
     assume "\<bar>x\<bar> \<le> 1"
     note summable_Leibniz[OF zeroseq_arctan_series[OF this] monoseq_arctan_series[OF this]]
   } note arctan_series_borders = this
 
   have when_less_one: "arctan x = (\<Sum>k. ?c x k)" if "\<bar>x\<bar> < 1" for x :: real
   proof -
     obtain r where "\<bar>x\<bar> < r" and "r < 1"
       using dense[OF \<open>\<bar>x\<bar> < 1\<close>] by blast
     then have "0 < r" and "- r < x" and "x < r" by auto
 
     have suminf_eq_arctan_bounded: "suminf (?c x) - arctan x = suminf (?c a) - arctan a"
       if "-r < a" and "b < r" and "a < b" and "a \<le> x" and "x \<le> b" for x a b
     proof -
       from that have "\<bar>x\<bar> < r" by auto
       show "suminf (?c x) - arctan x = suminf (?c a) - arctan a"
       proof (rule DERIV_isconst2[of "a" "b"])
         show "a < b" and "a \<le> x" and "x \<le> b"
           using \<open>a < b\<close> \<open>a \<le> x\<close> \<open>x \<le> b\<close> by auto
         have "\<forall>x. - r < x \<and> x < r \<longrightarrow> DERIV (\<lambda> x. suminf (?c x) - arctan x) x :> 0"
         proof (rule allI, rule impI)
           fix x
           assume "-r < x \<and> x < r"
           then have "\<bar>x\<bar> < r" by auto
           with \<open>r < 1\<close> have "\<bar>x\<bar> < 1" by auto
           have "\<bar>- (x\<^sup>2)\<bar> < 1" using abs_square_less_1 \<open>\<bar>x\<bar> < 1\<close> by auto
           then have "(\<lambda>n. (- (x\<^sup>2)) ^ n) sums (1 / (1 - (- (x\<^sup>2))))"
             unfolding real_norm_def[symmetric] by (rule geometric_sums)
           then have "(?c' x) sums (1 / (1 - (- (x\<^sup>2))))"
             unfolding power_mult_distrib[symmetric] power_mult mult.commute[of _ 2] by auto
           then have suminf_c'_eq_geom: "inverse (1 + x\<^sup>2) = suminf (?c' x)"
             using sums_unique unfolding inverse_eq_divide by auto
           have "DERIV (\<lambda> x. suminf (?c x)) x :> (inverse (1 + x\<^sup>2))"
             unfolding suminf_c'_eq_geom
             by (rule DERIV_arctan_suminf[OF \<open>0 < r\<close> \<open>r < 1\<close> \<open>\<bar>x\<bar> < r\<close>])
           from DERIV_diff [OF this DERIV_arctan] show "DERIV (\<lambda>x. suminf (?c x) - arctan x) x :> 0"
             by auto
         qed
         then have DERIV_in_rball: "\<forall>y. a \<le> y \<and> y \<le> b \<longrightarrow> DERIV (\<lambda>x. suminf (?c x) - arctan x) y :> 0"
           using \<open>-r < a\<close> \<open>b < r\<close> by auto
         then show "\<And>y. \<lbrakk>a < y; y < b\<rbrakk> \<Longrightarrow> DERIV (\<lambda>x. suminf (?c x) - arctan x) y :> 0"
           using \<open>\<bar>x\<bar> < r\<close> by auto
         show "continuous_on {a..b} (\<lambda>x. suminf (?c x) - arctan x)"
           using DERIV_in_rball DERIV_atLeastAtMost_imp_continuous_on by blast
       qed
     qed
 
     have suminf_arctan_zero: "suminf (?c 0) - arctan 0 = 0"
       unfolding Suc_eq_plus1[symmetric] power_Suc2 mult_zero_right arctan_zero_zero suminf_zero
       by auto
 
     have "suminf (?c x) - arctan x = 0"
     proof (cases "x = 0")
       case True
       then show ?thesis
         using suminf_arctan_zero by auto
     next
       case False
       then have "0 < \<bar>x\<bar>" and "- \<bar>x\<bar> < \<bar>x\<bar>"
         by auto
       have "suminf (?c (- \<bar>x\<bar>)) - arctan (- \<bar>x\<bar>) = suminf (?c 0) - arctan 0"
         by (rule suminf_eq_arctan_bounded[where x1=0 and a1="-\<bar>x\<bar>" and b1="\<bar>x\<bar>", symmetric])
           (simp_all only: \<open>\<bar>x\<bar> < r\<close> \<open>-\<bar>x\<bar> < \<bar>x\<bar>\<close> neg_less_iff_less)
       moreover
       have "suminf (?c x) - arctan x = suminf (?c (- \<bar>x\<bar>)) - arctan (- \<bar>x\<bar>)"
         by (rule suminf_eq_arctan_bounded[where x1=x and a1="- \<bar>x\<bar>" and b1="\<bar>x\<bar>"])
            (simp_all only: \<open>\<bar>x\<bar> < r\<close> \<open>- \<bar>x\<bar> < \<bar>x\<bar>\<close> neg_less_iff_less)
       ultimately show ?thesis
         using suminf_arctan_zero by auto
     qed
     then show ?thesis by auto
   qed
 
   show "arctan x = suminf (\<lambda>n. ?c x n)"
   proof (cases "\<bar>x\<bar> < 1")
     case True
     then show ?thesis by (rule when_less_one)
   next
     case False
     then have "\<bar>x\<bar> = 1" using \<open>\<bar>x\<bar> \<le> 1\<close> by auto
     let ?a = "\<lambda>x n. \<bar>1 / real (n * 2 + 1) * x^(n * 2 + 1)\<bar>"
     let ?diff = "\<lambda>x n. \<bar>arctan x - (\<Sum>i<n. ?c x i)\<bar>"
     have "?diff 1 n \<le> ?a 1 n" for n :: nat
     proof -
       have "0 < (1 :: real)" by auto
       moreover
       have "?diff x n \<le> ?a x n" if "0 < x" and "x < 1" for x :: real
       proof -
         from that have "\<bar>x\<bar> \<le> 1" and "\<bar>x\<bar> < 1"
           by auto
         from \<open>0 < x\<close> have "0 < 1 / real (0 * 2 + (1::nat)) * x ^ (0 * 2 + 1)"
           by auto
         note bounds = mp[OF arctan_series_borders(2)[OF \<open>\<bar>x\<bar> \<le> 1\<close>] this, unfolded when_less_one[OF \<open>\<bar>x\<bar> < 1\<close>, symmetric], THEN spec]
         have "0 < 1 / real (n*2+1) * x^(n*2+1)"
           by (rule mult_pos_pos) (simp_all only: zero_less_power[OF \<open>0 < x\<close>], auto)
         then have a_pos: "?a x n = 1 / real (n*2+1) * x^(n*2+1)"
           by (rule abs_of_pos)
         show ?thesis
         proof (cases "even n")
           case True
           then have sgn_pos: "(-1)^n = (1::real)" by auto
           from \<open>even n\<close> obtain m where "n = 2 * m" ..
           then have "2 * m = n" ..
           from bounds[of m, unfolded this atLeastAtMost_iff]
           have "\<bar>arctan x - (\<Sum>i<n. (?c x i))\<bar> \<le> (\<Sum>i<n + 1. (?c x i)) - (\<Sum>i<n. (?c x i))"
             by auto
           also have "\<dots> = ?c x n" by auto
           also have "\<dots> = ?a x n" unfolding sgn_pos a_pos by auto
           finally show ?thesis .
         next
           case False
           then have sgn_neg: "(-1)^n = (-1::real)" by auto
           from \<open>odd n\<close> obtain m where "n = 2 * m + 1" ..
           then have m_def: "2 * m + 1 = n" ..
           then have m_plus: "2 * (m + 1) = n + 1" by auto
           from bounds[of "m + 1", unfolded this atLeastAtMost_iff, THEN conjunct1] bounds[of m, unfolded m_def atLeastAtMost_iff, THEN conjunct2]
           have "\<bar>arctan x - (\<Sum>i<n. (?c x i))\<bar> \<le> (\<Sum>i<n. (?c x i)) - (\<Sum>i<n+1. (?c x i))" by auto
           also have "\<dots> = - ?c x n" by auto
           also have "\<dots> = ?a x n" unfolding sgn_neg a_pos by auto
           finally show ?thesis .
         qed
       qed
       hence "\<forall>x \<in> { 0 <..< 1 }. 0 \<le> ?a x n - ?diff x n" by auto
       moreover have "isCont (\<lambda> x. ?a x n - ?diff x n) x" for x
         unfolding diff_conv_add_uminus divide_inverse
         by (auto intro!: isCont_add isCont_rabs continuous_ident isCont_minus isCont_arctan
           continuous_at_within_inverse isCont_mult isCont_power continuous_const isCont_sum
           simp del: add_uminus_conv_diff)
       ultimately have "0 \<le> ?a 1 n - ?diff 1 n"
         by (rule LIM_less_bound)
       then show ?thesis by auto
     qed
     have "?a 1 \<longlonglongrightarrow> 0"
       unfolding tendsto_rabs_zero_iff power_one divide_inverse One_nat_def
       by (auto intro!: tendsto_mult LIMSEQ_linear LIMSEQ_inverse_real_of_nat simp del: of_nat_Suc)
     have "?diff 1 \<longlonglongrightarrow> 0"
     proof (rule LIMSEQ_I)
       fix r :: real
       assume "0 < r"
       obtain N :: nat where N_I: "N \<le> n \<Longrightarrow> ?a 1 n < r" for n
         using LIMSEQ_D[OF \<open>?a 1 \<longlonglongrightarrow> 0\<close> \<open>0 < r\<close>] by auto
       have "norm (?diff 1 n - 0) < r" if "N \<le> n" for n
         using \<open>?diff 1 n \<le> ?a 1 n\<close> N_I[OF that] by auto
       then show "\<exists>N. \<forall> n \<ge> N. norm (?diff 1 n - 0) < r" by blast
     qed
     from this [unfolded tendsto_rabs_zero_iff, THEN tendsto_add [OF _ tendsto_const], of "- arctan 1", THEN tendsto_minus]
     have "(?c 1) sums (arctan 1)" unfolding sums_def by auto
     then have "arctan 1 = (\<Sum>i. ?c 1 i)" by (rule sums_unique)
 
     show ?thesis
     proof (cases "x = 1")
       case True
       then show ?thesis by (simp add: \<open>arctan 1 = (\<Sum> i. ?c 1 i)\<close>)
     next
       case False
       then have "x = -1" using \<open>\<bar>x\<bar> = 1\<close> by auto
 
       have "- (pi/2) < 0" using pi_gt_zero by auto
       have "- (2 * pi) < 0" using pi_gt_zero by auto
 
       have c_minus_minus: "?c (- 1) i = - ?c 1 i" for i by auto
 
-      have "arctan (- 1) = arctan (tan (-(pi / 4)))"
+      have "arctan (- 1) = arctan (tan (-(pi/4)))"
         unfolding tan_45 tan_minus ..
-      also have "\<dots> = - (pi / 4)"
+      also have "\<dots> = - (pi/4)"
         by (rule arctan_tan) (auto simp: order_less_trans[OF \<open>- (pi/2) < 0\<close> pi_gt_zero])
-      also have "\<dots> = - (arctan (tan (pi / 4)))"
+      also have "\<dots> = - (arctan (tan (pi/4)))"
         unfolding neg_equal_iff_equal
         by (rule arctan_tan[symmetric]) (auto simp: order_less_trans[OF \<open>- (2 * pi) < 0\<close> pi_gt_zero])
       also have "\<dots> = - (arctan 1)"
         unfolding tan_45 ..
       also have "\<dots> = - (\<Sum> i. ?c 1 i)"
         using \<open>arctan 1 = (\<Sum> i. ?c 1 i)\<close> by auto
       also have "\<dots> = (\<Sum> i. ?c (- 1) i)"
         using suminf_minus[OF sums_summable[OF \<open>(?c 1) sums (arctan 1)\<close>]]
         unfolding c_minus_minus by auto
       finally show ?thesis using \<open>x = -1\<close> by auto
     qed
   qed
 qed
 
 lemma arctan_half: "arctan x = 2 * arctan (x / (1 + sqrt(1 + x\<^sup>2)))"
   for x :: real
 proof -
   obtain y where low: "- (pi/2) < y" and high: "y < pi/2" and y_eq: "tan y = x"
     using tan_total by blast
   then have low2: "- (pi/2) < y / 2" and high2: "y / 2 < pi/2"
     by auto
 
   have "0 < cos y" by (rule cos_gt_zero_pi[OF low high])
   then have "cos y \<noteq> 0" and cos_sqrt: "sqrt ((cos y)\<^sup>2) = cos y"
     by auto
 
   have "1 + (tan y)\<^sup>2 = 1 + (sin y)\<^sup>2 / (cos y)\<^sup>2"
     unfolding tan_def power_divide ..
   also have "\<dots> = (cos y)\<^sup>2 / (cos y)\<^sup>2 + (sin y)\<^sup>2 / (cos y)\<^sup>2"
     using \<open>cos y \<noteq> 0\<close> by auto
   also have "\<dots> = 1 / (cos y)\<^sup>2"
     unfolding add_divide_distrib[symmetric] sin_cos_squared_add2 ..
   finally have "1 + (tan y)\<^sup>2 = 1 / (cos y)\<^sup>2" .
 
   have "sin y / (cos y + 1) = tan y / ((cos y + 1) / cos y)"
     unfolding tan_def using \<open>cos y \<noteq> 0\<close> by (simp add: field_simps)
   also have "\<dots> = tan y / (1 + 1 / cos y)"
     using \<open>cos y \<noteq> 0\<close> unfolding add_divide_distrib by auto
   also have "\<dots> = tan y / (1 + 1 / sqrt ((cos y)\<^sup>2))"
     unfolding cos_sqrt ..
   also have "\<dots> = tan y / (1 + sqrt (1 / (cos y)\<^sup>2))"
     unfolding real_sqrt_divide by auto
   finally have eq: "sin y / (cos y + 1) = tan y / (1 + sqrt(1 + (tan y)\<^sup>2))"
     unfolding \<open>1 + (tan y)\<^sup>2 = 1 / (cos y)\<^sup>2\<close> .
 
   have "arctan x = y"
     using arctan_tan low high y_eq by auto
   also have "\<dots> = 2 * (arctan (tan (y/2)))"
     using arctan_tan[OF low2 high2] by auto
   also have "\<dots> = 2 * (arctan (sin y / (cos y + 1)))"
     unfolding tan_half by auto
   finally show ?thesis
     unfolding eq \<open>tan y = x\<close> .
 qed
 
 lemma arctan_monotone: "x < y \<Longrightarrow> arctan x < arctan y"
   by (simp only: arctan_less_iff)
 
 lemma arctan_monotone': "x \<le> y \<Longrightarrow> arctan x \<le> arctan y"
   by (simp only: arctan_le_iff)
 
 lemma arctan_inverse:
   assumes "x \<noteq> 0"
   shows "arctan (1 / x) = sgn x * pi/2 - arctan x"
 proof (rule arctan_unique)
   have \<section>: "x > 0 \<Longrightarrow> arctan x < pi"
     using arctan_bounded [of x] by linarith 
   show "- (pi/2) < sgn x * pi/2 - arctan x"
     using assms by (auto simp: sgn_real_def arctan algebra_simps \<section>)
   show "sgn x * pi/2 - arctan x < pi/2"
     using arctan_bounded [of "- x"] assms
     by (auto simp: algebra_simps sgn_real_def arctan_minus)
   show "tan (sgn x * pi/2 - arctan x) = 1 / x"
     unfolding tan_inverse [of "arctan x", unfolded tan_arctan] sgn_real_def
     by (simp add: tan_def cos_arctan sin_arctan sin_diff cos_diff)
 qed
 
-theorem pi_series: "pi / 4 = (\<Sum>k. (-1)^k * 1 / real (k * 2 + 1))"
+theorem pi_series: "pi/4 = (\<Sum>k. (-1)^k * 1 / real (k * 2 + 1))"
   (is "_ = ?SUM")
 proof -
-  have "pi / 4 = arctan 1"
+  have "pi/4 = arctan 1"
     using arctan_one by auto
   also have "\<dots> = ?SUM"
     using arctan_series[of 1] by auto
   finally show ?thesis by auto
 qed
 
 
 subsection \<open>Existence of Polar Coordinates\<close>
 
 lemma cos_x_y_le_one: "\<bar>x / sqrt (x\<^sup>2 + y\<^sup>2)\<bar> \<le> 1"
   by (rule power2_le_imp_le [OF _ zero_le_one])
     (simp add: power_divide divide_le_eq not_sum_power2_lt_zero)
 
 lemma polar_Ex: "\<exists>r::real. \<exists>a. x = r * cos a \<and> y = r * sin a"
 proof -
   have polar_ex1: "\<exists>r a. x = r * cos a \<and> y = r * sin a" if "0 < y" for y
   proof -
     have "x = sqrt (x\<^sup>2 + y\<^sup>2) * cos (arccos (x / sqrt (x\<^sup>2 + y\<^sup>2)))"
       by (simp add: cos_arccos_abs [OF cos_x_y_le_one])
     moreover have "y = sqrt (x\<^sup>2 + y\<^sup>2) * sin (arccos (x / sqrt (x\<^sup>2 + y\<^sup>2)))"
       using that
       by (simp add: sin_arccos_abs [OF cos_x_y_le_one] power_divide right_diff_distrib flip: real_sqrt_mult)
     ultimately show ?thesis
       by blast
   qed
   show ?thesis
   proof (cases "0::real" y rule: linorder_cases)
     case less
     then show ?thesis
       by (rule polar_ex1)
   next
     case equal
     then show ?thesis
       by (force simp: intro!: cos_zero sin_zero)
   next
     case greater
     with polar_ex1 [where y="-y"] show ?thesis
       by auto (metis cos_minus minus_minus minus_mult_right sin_minus)
   qed
 qed
 
 
 subsection \<open>Basics about polynomial functions: products, extremal behaviour and root counts\<close>
 
 lemma pairs_le_eq_Sigma: "{(i, j). i + j \<le> m} = Sigma (atMost m) (\<lambda>r. atMost (m - r))"
   for m :: nat
   by auto
 
 lemma sum_up_index_split: "(\<Sum>k\<le>m + n. f k) = (\<Sum>k\<le>m. f k) + (\<Sum>k = Suc m..m + n. f k)"
   by (metis atLeast0AtMost Suc_eq_plus1 le0 sum.ub_add_nat)
 
 lemma Sigma_interval_disjoint: "(SIGMA i:A. {..v i}) \<inter> (SIGMA i:A.{v i<..w}) = {}"
   for w :: "'a::order"
   by auto
 
 lemma product_atMost_eq_Un: "A \<times> {..m} = (SIGMA i:A.{..m - i}) \<union> (SIGMA i:A.{m - i<..m})"
   for m :: nat
   by auto
 
 lemma polynomial_product: (*with thanks to Chaitanya Mangla*)
   fixes x :: "'a::idom"
   assumes m: "\<And>i. i > m \<Longrightarrow> a i = 0"
     and n: "\<And>j. j > n \<Longrightarrow> b j = 0"
   shows "(\<Sum>i\<le>m. (a i) * x ^ i) * (\<Sum>j\<le>n. (b j) * x ^ j) =
          (\<Sum>r\<le>m + n. (\<Sum>k\<le>r. (a k) * (b (r - k))) * x ^ r)"
 proof -
   have "\<And>i j. \<lbrakk>m + n - i < j; a i \<noteq> 0\<rbrakk> \<Longrightarrow> b j = 0"
     by (meson le_add_diff leI le_less_trans m n)
   then have \<section>: "(\<Sum>(i,j)\<in>(SIGMA i:{..m+n}. {m+n - i<..m+n}). a i * x ^ i * (b j * x ^ j)) = 0"
     by (clarsimp simp add: sum_Un Sigma_interval_disjoint intro!: sum.neutral)
   have "(\<Sum>i\<le>m. (a i) * x ^ i) * (\<Sum>j\<le>n. (b j) * x ^ j) = (\<Sum>i\<le>m. \<Sum>j\<le>n. (a i * x ^ i) * (b j * x ^ j))"
     by (rule sum_product)
   also have "\<dots> = (\<Sum>i\<le>m + n. \<Sum>j\<le>n + m. a i * x ^ i * (b j * x ^ j))"
     using assms by (auto simp: sum_up_index_split)
   also have "\<dots> = (\<Sum>r\<le>m + n. \<Sum>j\<le>m + n - r. a r * x ^ r * (b j * x ^ j))"
     by (simp add: add_ac sum.Sigma product_atMost_eq_Un sum_Un Sigma_interval_disjoint \<section>)
   also have "\<dots> = (\<Sum>(i,j)\<in>{(i,j). i+j \<le> m+n}. (a i * x ^ i) * (b j * x ^ j))"
     by (auto simp: pairs_le_eq_Sigma sum.Sigma)
   also have "... = (\<Sum>k\<le>m + n. \<Sum>i\<le>k. a i * x ^ i * (b (k - i) * x ^ (k - i)))"
     by (rule sum.triangle_reindex_eq)
   also have "\<dots> = (\<Sum>r\<le>m + n. (\<Sum>k\<le>r. (a k) * (b (r - k))) * x ^ r)"
     by (auto simp: algebra_simps sum_distrib_left simp flip: power_add intro!: sum.cong)
   finally show ?thesis .
 qed
 
 lemma polynomial_product_nat:
   fixes x :: nat
   assumes m: "\<And>i. i > m \<Longrightarrow> a i = 0"
     and n: "\<And>j. j > n \<Longrightarrow> b j = 0"
   shows "(\<Sum>i\<le>m. (a i) * x ^ i) * (\<Sum>j\<le>n. (b j) * x ^ j) =
          (\<Sum>r\<le>m + n. (\<Sum>k\<le>r. (a k) * (b (r - k))) * x ^ r)"
   using polynomial_product [of m a n b x] assms
   by (simp only: of_nat_mult [symmetric] of_nat_power [symmetric]
       of_nat_eq_iff Int.int_sum [symmetric])
 
 lemma polyfun_diff: (*COMPLEX_SUB_POLYFUN in HOL Light*)
   fixes x :: "'a::idom"
   assumes "1 \<le> n"
   shows "(\<Sum>i\<le>n. a i * x^i) - (\<Sum>i\<le>n. a i * y^i) =
     (x - y) * (\<Sum>j<n. (\<Sum>i=Suc j..n. a i * y^(i - j - 1)) * x^j)"
 proof -
   have h: "bij_betw (\<lambda>(i,j). (j,i)) ((SIGMA i : atMost n. lessThan i)) (SIGMA j : lessThan n. {Suc j..n})"
     by (auto simp: bij_betw_def inj_on_def)
   have "(\<Sum>i\<le>n. a i * x^i) - (\<Sum>i\<le>n. a i * y^i) = (\<Sum>i\<le>n. a i * (x^i - y^i))"
     by (simp add: right_diff_distrib sum_subtractf)
   also have "\<dots> = (\<Sum>i\<le>n. a i * (x - y) * (\<Sum>j<i. y^(i - Suc j) * x^j))"
     by (simp add: power_diff_sumr2 mult.assoc)
   also have "\<dots> = (\<Sum>i\<le>n. \<Sum>j<i. a i * (x - y) * (y^(i - Suc j) * x^j))"
     by (simp add: sum_distrib_left)
   also have "\<dots> = (\<Sum>(i,j) \<in> (SIGMA i : atMost n. lessThan i). a i * (x - y) * (y^(i - Suc j) * x^j))"
     by (simp add: sum.Sigma)
   also have "\<dots> = (\<Sum>(j,i) \<in> (SIGMA j : lessThan n. {Suc j..n}). a i * (x - y) * (y^(i - Suc j) * x^j))"
     by (auto simp: sum.reindex_bij_betw [OF h, symmetric] intro: sum.cong_simp)
   also have "\<dots> = (\<Sum>j<n. \<Sum>i=Suc j..n. a i * (x - y) * (y^(i - Suc j) * x^j))"
     by (simp add: sum.Sigma)
   also have "\<dots> = (x - y) * (\<Sum>j<n. (\<Sum>i=Suc j..n. a i * y^(i - j - 1)) * x^j)"
     by (simp add: sum_distrib_left mult_ac)
   finally show ?thesis .
 qed
 
 lemma polyfun_diff_alt: (*COMPLEX_SUB_POLYFUN_ALT in HOL Light*)
   fixes x :: "'a::idom"
   assumes "1 \<le> n"
   shows "(\<Sum>i\<le>n. a i * x^i) - (\<Sum>i\<le>n. a i * y^i) =
     (x - y) * ((\<Sum>j<n. \<Sum>k<n-j. a(j + k + 1) * y^k * x^j))"
 proof -
   have "(\<Sum>i=Suc j..n. a i * y^(i - j - 1)) = (\<Sum>k<n-j. a(j+k+1) * y^k)"
     if "j < n" for j :: nat
   proof -
     have "\<And>k. k < n - j \<Longrightarrow> k \<in> (\<lambda>i. i - Suc j) ` {Suc j..n}"
       by (rule_tac x="k + Suc j" in image_eqI, auto)
     then have h: "bij_betw (\<lambda>i. i - (j + 1)) {Suc j..n} (lessThan (n-j))"
       by (auto simp: bij_betw_def inj_on_def)
     then show ?thesis
       by (auto simp: sum.reindex_bij_betw [OF h, symmetric] intro: sum.cong_simp)
   qed
   then show ?thesis
     by (simp add: polyfun_diff [OF assms] sum_distrib_right)
 qed
 
 lemma polyfun_linear_factor:  (*COMPLEX_POLYFUN_LINEAR_FACTOR in HOL Light*)
   fixes a :: "'a::idom"
   shows "\<exists>b. \<forall>z. (\<Sum>i\<le>n. c(i) * z^i) = (z - a) * (\<Sum>i<n. b(i) * z^i) + (\<Sum>i\<le>n. c(i) * a^i)"
 proof (cases "n = 0")
   case True then show ?thesis
     by simp
 next
   case False
   have "(\<exists>b. \<forall>z. (\<Sum>i\<le>n. c i * z^i) = (z - a) * (\<Sum>i<n. b i * z^i) + (\<Sum>i\<le>n. c i * a^i)) \<longleftrightarrow>
         (\<exists>b. \<forall>z. (\<Sum>i\<le>n. c i * z^i) - (\<Sum>i\<le>n. c i * a^i) = (z - a) * (\<Sum>i<n. b i * z^i))"
     by (simp add: algebra_simps)
   also have "\<dots> \<longleftrightarrow>
     (\<exists>b. \<forall>z. (z - a) * (\<Sum>j<n. (\<Sum>i = Suc j..n. c i * a^(i - Suc j)) * z^j) =
       (z - a) * (\<Sum>i<n. b i * z^i))"
     using False by (simp add: polyfun_diff)
   also have "\<dots> = True" by auto
   finally show ?thesis
     by simp
 qed
 
 lemma polyfun_linear_factor_root:  (*COMPLEX_POLYFUN_LINEAR_FACTOR_ROOT in HOL Light*)
   fixes a :: "'a::idom"
   assumes "(\<Sum>i\<le>n. c(i) * a^i) = 0"
   obtains b where "\<And>z. (\<Sum>i\<le>n. c i * z^i) = (z - a) * (\<Sum>i<n. b i * z^i)"
   using polyfun_linear_factor [of c n a] assms by auto
 
 (*The material of this section, up until this point, could go into a new theory of polynomials
   based on Main alone. The remaining material involves limits, continuity, series, etc.*)
 
 lemma isCont_polynom: "isCont (\<lambda>w. \<Sum>i\<le>n. c i * w^i) a"
   for c :: "nat \<Rightarrow> 'a::real_normed_div_algebra"
   by simp
 
 lemma zero_polynom_imp_zero_coeffs:
   fixes c :: "nat \<Rightarrow> 'a::{ab_semigroup_mult,real_normed_div_algebra}"
   assumes "\<And>w. (\<Sum>i\<le>n. c i * w^i) = 0"  "k \<le> n"
   shows "c k = 0"
   using assms
 proof (induction n arbitrary: c k)
   case 0
   then show ?case
     by simp
 next
   case (Suc n c k)
   have [simp]: "c 0 = 0" using Suc.prems(1) [of 0]
     by simp
   have "(\<Sum>i\<le>Suc n. c i * w^i) = w * (\<Sum>i\<le>n. c (Suc i) * w^i)" for w
   proof -
     have "(\<Sum>i\<le>Suc n. c i * w^i) = (\<Sum>i\<le>n. c (Suc i) * w ^ Suc i)"
       unfolding Set_Interval.sum.atMost_Suc_shift
       by simp
     also have "\<dots> = w * (\<Sum>i\<le>n. c (Suc i) * w^i)"
       by (simp add: sum_distrib_left ac_simps)
     finally show ?thesis .
   qed
   then have w: "\<And>w. w \<noteq> 0 \<Longrightarrow> (\<Sum>i\<le>n. c (Suc i) * w^i) = 0"
     using Suc  by auto
   then have "(\<lambda>h. \<Sum>i\<le>n. c (Suc i) * h^i) \<midarrow>0\<rightarrow> 0"
     by (simp cong: LIM_cong)  \<comment> \<open>the case \<open>w = 0\<close> by continuity\<close>
   then have "(\<Sum>i\<le>n. c (Suc i) * 0^i) = 0"
     using isCont_polynom [of 0 "\<lambda>i. c (Suc i)" n] LIM_unique
     by (force simp: Limits.isCont_iff)
   then have "\<And>w. (\<Sum>i\<le>n. c (Suc i) * w^i) = 0"
     using w by metis
   then have "\<And>i. i \<le> n \<Longrightarrow> c (Suc i) = 0"
     using Suc.IH [of "\<lambda>i. c (Suc i)"] by blast
   then show ?case using \<open>k \<le> Suc n\<close>
     by (cases k) auto
 qed
 
 lemma polyfun_rootbound: (*COMPLEX_POLYFUN_ROOTBOUND in HOL Light*)
   fixes c :: "nat \<Rightarrow> 'a::{idom,real_normed_div_algebra}"
   assumes "c k \<noteq> 0" "k\<le>n"
   shows "finite {z. (\<Sum>i\<le>n. c(i) * z^i) = 0} \<and> card {z. (\<Sum>i\<le>n. c(i) * z^i) = 0} \<le> n"
   using assms
 proof (induction n arbitrary: c k)
   case 0
   then show ?case
     by simp
 next
   case (Suc m c k)
   let ?succase = ?case
   show ?case
   proof (cases "{z. (\<Sum>i\<le>Suc m. c(i) * z^i) = 0} = {}")
     case True
     then show ?succase
       by simp
   next
     case False
     then obtain z0 where z0: "(\<Sum>i\<le>Suc m. c(i) * z0^i) = 0"
       by blast
     then obtain b where b: "\<And>w. (\<Sum>i\<le>Suc m. c i * w^i) = (w - z0) * (\<Sum>i\<le>m. b i * w^i)"
       using polyfun_linear_factor_root [OF z0, unfolded lessThan_Suc_atMost]
       by blast
     then have eq: "{z. (\<Sum>i\<le>Suc m. c i * z^i) = 0} = insert z0 {z. (\<Sum>i\<le>m. b i * z^i) = 0}"
       by auto
     have "\<not> (\<forall>k\<le>m. b k = 0)"
     proof
       assume [simp]: "\<forall>k\<le>m. b k = 0"
       then have "\<And>w. (\<Sum>i\<le>m. b i * w^i) = 0"
         by simp
       then have "\<And>w. (\<Sum>i\<le>Suc m. c i * w^i) = 0"
         using b by simp
       then have "\<And>k. k \<le> Suc m \<Longrightarrow> c k = 0"
         using zero_polynom_imp_zero_coeffs by blast
       then show False using Suc.prems by blast
     qed
     then obtain k' where bk': "b k' \<noteq> 0" "k' \<le> m"
       by blast
     show ?succase
       using Suc.IH [of b k'] bk'
       by (simp add: eq card_insert_if del: sum.atMost_Suc)
     qed
 qed
 
 lemma
   fixes c :: "nat \<Rightarrow> 'a::{idom,real_normed_div_algebra}"
   assumes "c k \<noteq> 0" "k\<le>n"
   shows polyfun_roots_finite: "finite {z. (\<Sum>i\<le>n. c(i) * z^i) = 0}"
     and polyfun_roots_card: "card {z. (\<Sum>i\<le>n. c(i) * z^i) = 0} \<le> n"
   using polyfun_rootbound assms by auto
 
 lemma polyfun_finite_roots: (*COMPLEX_POLYFUN_FINITE_ROOTS in HOL Light*)
   fixes c :: "nat \<Rightarrow> 'a::{idom,real_normed_div_algebra}"
   shows "finite {x. (\<Sum>i\<le>n. c i * x^i) = 0} \<longleftrightarrow> (\<exists>i\<le>n. c i \<noteq> 0)"
     (is "?lhs = ?rhs")
 proof
   assume ?lhs
   moreover have "\<not> finite {x. (\<Sum>i\<le>n. c i * x^i) = 0}" if "\<forall>i\<le>n. c i = 0"
   proof -
     from that have "\<And>x. (\<Sum>i\<le>n. c i * x^i) = 0"
       by simp
     then show ?thesis
       using ex_new_if_finite [OF infinite_UNIV_char_0 [where 'a='a]]
       by auto
   qed
   ultimately show ?rhs by metis
 next
   assume ?rhs
   with polyfun_rootbound show ?lhs by blast
 qed
 
 lemma polyfun_eq_0: "(\<forall>x. (\<Sum>i\<le>n. c i * x^i) = 0) \<longleftrightarrow> (\<forall>i\<le>n. c i = 0)"
   for c :: "nat \<Rightarrow> 'a::{idom,real_normed_div_algebra}"
   (*COMPLEX_POLYFUN_EQ_0 in HOL Light*)
   using zero_polynom_imp_zero_coeffs by auto
 
 lemma polyfun_eq_coeffs: "(\<forall>x. (\<Sum>i\<le>n. c i * x^i) = (\<Sum>i\<le>n. d i * x^i)) \<longleftrightarrow> (\<forall>i\<le>n. c i = d i)"
   for c :: "nat \<Rightarrow> 'a::{idom,real_normed_div_algebra}"
 proof -
   have "(\<forall>x. (\<Sum>i\<le>n. c i * x^i) = (\<Sum>i\<le>n. d i * x^i)) \<longleftrightarrow> (\<forall>x. (\<Sum>i\<le>n. (c i - d i) * x^i) = 0)"
     by (simp add: left_diff_distrib Groups_Big.sum_subtractf)
   also have "\<dots> \<longleftrightarrow> (\<forall>i\<le>n. c i - d i = 0)"
     by (rule polyfun_eq_0)
   finally show ?thesis
     by simp
 qed
 
 lemma polyfun_eq_const: (*COMPLEX_POLYFUN_EQ_CONST in HOL Light*)
   fixes c :: "nat \<Rightarrow> 'a::{idom,real_normed_div_algebra}"
   shows "(\<forall>x. (\<Sum>i\<le>n. c i * x^i) = k) \<longleftrightarrow> c 0 = k \<and> (\<forall>i \<in> {1..n}. c i = 0)"
     (is "?lhs = ?rhs")
 proof -
   have *: "\<forall>x. (\<Sum>i\<le>n. (if i=0 then k else 0) * x^i) = k"
     by (induct n) auto
   show ?thesis
   proof
     assume ?lhs
     with * have "(\<forall>i\<le>n. c i = (if i=0 then k else 0))"
       by (simp add: polyfun_eq_coeffs [symmetric])
     then show ?rhs by simp
   next
     assume ?rhs
     then show ?lhs by (induct n) auto
   qed
 qed
 
 lemma root_polyfun:
   fixes z :: "'a::idom"
   assumes "1 \<le> n"
   shows "z^n = a \<longleftrightarrow> (\<Sum>i\<le>n. (if i = 0 then -a else if i=n then 1 else 0) * z^i) = 0"
   using assms by (cases n) (simp_all add: sum.atLeast_Suc_atMost atLeast0AtMost [symmetric])
 
 lemma
   assumes "SORT_CONSTRAINT('a::{idom,real_normed_div_algebra})"
     and "1 \<le> n"
   shows finite_roots_unity: "finite {z::'a. z^n = 1}"
     and card_roots_unity: "card {z::'a. z^n = 1} \<le> n"
   using polyfun_rootbound [of "\<lambda>i. if i = 0 then -1 else if i=n then 1 else 0" n n] assms(2)
   by (auto simp: root_polyfun [OF assms(2)])
 
 
 subsection \<open>Hyperbolic functions\<close>
 
 definition sinh :: "'a :: {banach, real_normed_algebra_1} \<Rightarrow> 'a" where
   "sinh x = (exp x - exp (-x)) /\<^sub>R 2"
 
 definition cosh :: "'a :: {banach, real_normed_algebra_1} \<Rightarrow> 'a" where
   "cosh x = (exp x + exp (-x)) /\<^sub>R 2"
 
 definition tanh :: "'a :: {banach, real_normed_field} \<Rightarrow> 'a" where
   "tanh x = sinh x / cosh x"
 
 definition arsinh :: "'a :: {banach, real_normed_algebra_1, ln} \<Rightarrow> 'a" where
   "arsinh x = ln (x + (x^2 + 1) powr of_real (1/2))"
 
 definition arcosh :: "'a :: {banach, real_normed_algebra_1, ln} \<Rightarrow> 'a" where
   "arcosh x = ln (x + (x^2 - 1) powr of_real (1/2))"
 
 definition artanh :: "'a :: {banach, real_normed_field, ln} \<Rightarrow> 'a" where
   "artanh x = ln ((1 + x) / (1 - x)) / 2"
 
 lemma arsinh_0 [simp]: "arsinh 0 = 0"
   by (simp add: arsinh_def)
 
 lemma arcosh_1 [simp]: "arcosh 1 = 0"
   by (simp add: arcosh_def)
 
 lemma artanh_0 [simp]: "artanh 0 = 0"
   by (simp add: artanh_def)
 
 lemma tanh_altdef:
   "tanh x = (exp x - exp (-x)) / (exp x + exp (-x))"
 proof -
   have "tanh x = (2 *\<^sub>R sinh x) / (2 *\<^sub>R cosh x)"
     by (simp add: tanh_def scaleR_conv_of_real)
   also have "2 *\<^sub>R sinh x = exp x - exp (-x)"
     by (simp add: sinh_def)
   also have "2 *\<^sub>R cosh x = exp x + exp (-x)"
     by (simp add: cosh_def)
   finally show ?thesis .
 qed
 
 lemma tanh_real_altdef: "tanh (x::real) = (1 - exp (- 2 * x)) / (1 + exp (- 2 * x))"
 proof -
   have [simp]: "exp (2 * x) = exp x * exp x" "exp (x * 2) = exp x * exp x"
     by (subst exp_add [symmetric]; simp)+
   have "tanh x = (2 * exp (-x) * sinh x) / (2 * exp (-x) * cosh x)"
     by (simp add: tanh_def)
   also have "2 * exp (-x) * sinh x = 1 - exp (-2*x)"
     by (simp add: exp_minus field_simps sinh_def)
   also have "2 * exp (-x) * cosh x = 1 + exp (-2*x)"
     by (simp add: exp_minus field_simps cosh_def)
   finally show ?thesis .
 qed
 
 
 lemma sinh_converges: "(\<lambda>n. if even n then 0 else x ^ n /\<^sub>R fact n) sums sinh x"
 proof -
   have "(\<lambda>n. (x ^ n /\<^sub>R fact n - (-x) ^ n /\<^sub>R fact n) /\<^sub>R 2) sums sinh x"
     unfolding sinh_def by (intro sums_scaleR_right sums_diff exp_converges)
   also have "(\<lambda>n. (x ^ n /\<^sub>R fact n - (-x) ^ n /\<^sub>R fact n) /\<^sub>R 2) =
                (\<lambda>n. if even n then 0 else x ^ n /\<^sub>R fact n)" by auto
   finally show ?thesis .
 qed
 
 lemma cosh_converges: "(\<lambda>n. if even n then x ^ n /\<^sub>R fact n else 0) sums cosh x"
 proof -
   have "(\<lambda>n. (x ^ n /\<^sub>R fact n + (-x) ^ n /\<^sub>R fact n) /\<^sub>R 2) sums cosh x"
     unfolding cosh_def by (intro sums_scaleR_right sums_add exp_converges)
   also have "(\<lambda>n. (x ^ n /\<^sub>R fact n + (-x) ^ n /\<^sub>R fact n) /\<^sub>R 2) =
                (\<lambda>n. if even n then x ^ n /\<^sub>R fact n else 0)" by auto
   finally show ?thesis .
 qed
 
 lemma sinh_0 [simp]: "sinh 0 = 0"
   by (simp add: sinh_def)
 
 lemma cosh_0 [simp]: "cosh 0 = 1"
 proof -
   have "cosh 0 = (1/2) *\<^sub>R (1 + 1)" by (simp add: cosh_def)
   also have "\<dots> = 1" by (rule scaleR_half_double)
   finally show ?thesis .
 qed
 
 lemma tanh_0 [simp]: "tanh 0 = 0"
   by (simp add: tanh_def)
 
 lemma sinh_minus [simp]: "sinh (- x) = -sinh x"
   by (simp add: sinh_def algebra_simps)
 
 lemma cosh_minus [simp]: "cosh (- x) = cosh x"
   by (simp add: cosh_def algebra_simps)
 
 lemma tanh_minus [simp]: "tanh (-x) = -tanh x"
   by (simp add: tanh_def)
 
 lemma sinh_ln_real: "x > 0 \<Longrightarrow> sinh (ln x :: real) = (x - inverse x) / 2"
   by (simp add: sinh_def exp_minus)
 
 lemma cosh_ln_real: "x > 0 \<Longrightarrow> cosh (ln x :: real) = (x + inverse x) / 2"
   by (simp add: cosh_def exp_minus)
 
 lemma tanh_ln_real:
   "tanh (ln x :: real) = (x ^ 2 - 1) / (x ^ 2 + 1)" if "x > 0"
 proof -
   from that have "(x * 2 - inverse x * 2) * (x\<^sup>2 + 1) =
     (x\<^sup>2 - 1) * (2 * x + 2 * inverse x)"
     by (simp add: field_simps power2_eq_square)
   moreover have "x\<^sup>2 + 1 > 0"
     using that by (simp add: ac_simps add_pos_nonneg)
   moreover have "2 * x + 2 * inverse x > 0"
     using that by (simp add: add_pos_pos)
   ultimately have "(x * 2 - inverse x * 2) /
     (2 * x + 2 * inverse x) =
     (x\<^sup>2 - 1) / (x\<^sup>2 + 1)"
     by (simp add: frac_eq_eq)
   with that show ?thesis
     by (simp add: tanh_def sinh_ln_real cosh_ln_real)
 qed
 
 lemma has_field_derivative_scaleR_right [derivative_intros]:
   "(f has_field_derivative D) F \<Longrightarrow> ((\<lambda>x. c *\<^sub>R f x) has_field_derivative (c *\<^sub>R D)) F"
   unfolding has_field_derivative_def
   using has_derivative_scaleR_right[of f "\<lambda>x. D * x" F c]
   by (simp add: mult_scaleR_left [symmetric] del: mult_scaleR_left)
 
 lemma has_field_derivative_sinh [THEN DERIV_chain2, derivative_intros]:
   "(sinh has_field_derivative cosh x) (at (x :: 'a :: {banach, real_normed_field}))"
   unfolding sinh_def cosh_def by (auto intro!: derivative_eq_intros)
 
 lemma has_field_derivative_cosh [THEN DERIV_chain2, derivative_intros]:
   "(cosh has_field_derivative sinh x) (at (x :: 'a :: {banach, real_normed_field}))"
   unfolding sinh_def cosh_def by (auto intro!: derivative_eq_intros)
 
 lemma has_field_derivative_tanh [THEN DERIV_chain2, derivative_intros]:
   "cosh x \<noteq> 0 \<Longrightarrow> (tanh has_field_derivative 1 - tanh x ^ 2)
                      (at (x :: 'a :: {banach, real_normed_field}))"
   unfolding tanh_def by (auto intro!: derivative_eq_intros simp: power2_eq_square field_split_simps)
 
 lemma has_derivative_sinh [derivative_intros]:
   fixes g :: "'a \<Rightarrow> ('a :: {banach, real_normed_field})"
   assumes "(g has_derivative (\<lambda>x. Db * x)) (at x within s)"
   shows   "((\<lambda>x. sinh (g x)) has_derivative (\<lambda>y. (cosh (g x) * Db) * y)) (at x within s)"
 proof -
   have "((\<lambda>x. - g x) has_derivative (\<lambda>y. -(Db * y))) (at x within s)"
     using assms by (intro derivative_intros)
   also have "(\<lambda>y. -(Db * y)) = (\<lambda>x. (-Db) * x)" by (simp add: fun_eq_iff)
   finally have "((\<lambda>x. sinh (g x)) has_derivative
     (\<lambda>y. (exp (g x) * Db * y - exp (-g x) * (-Db) * y) /\<^sub>R 2)) (at x within s)"
     unfolding sinh_def by (intro derivative_intros assms)
   also have "(\<lambda>y. (exp (g x) * Db * y - exp (-g x) * (-Db) * y) /\<^sub>R 2) = (\<lambda>y. (cosh (g x) * Db) * y)"
     by (simp add: fun_eq_iff cosh_def algebra_simps)
   finally show ?thesis .
 qed
 
 lemma has_derivative_cosh [derivative_intros]:
   fixes g :: "'a \<Rightarrow> ('a :: {banach, real_normed_field})"
   assumes "(g has_derivative (\<lambda>y. Db * y)) (at x within s)"
   shows   "((\<lambda>x. cosh (g x)) has_derivative (\<lambda>y. (sinh (g x) * Db) * y)) (at x within s)"
 proof -
   have "((\<lambda>x. - g x) has_derivative (\<lambda>y. -(Db * y))) (at x within s)"
     using assms by (intro derivative_intros)
   also have "(\<lambda>y. -(Db * y)) = (\<lambda>y. (-Db) * y)" by (simp add: fun_eq_iff)
   finally have "((\<lambda>x. cosh (g x)) has_derivative
     (\<lambda>y. (exp (g x) * Db * y + exp (-g x) * (-Db) * y) /\<^sub>R 2)) (at x within s)"
     unfolding cosh_def by (intro derivative_intros assms)
   also have "(\<lambda>y. (exp (g x) * Db * y + exp (-g x) * (-Db) * y) /\<^sub>R 2) = (\<lambda>y. (sinh (g x) * Db) * y)"
     by (simp add: fun_eq_iff sinh_def algebra_simps)
   finally show ?thesis .
 qed
 
 lemma sinh_plus_cosh: "sinh x + cosh x = exp x"
 proof -
-  have "sinh x + cosh x = (1 / 2) *\<^sub>R (exp x + exp x)"
+  have "sinh x + cosh x = (1/2) *\<^sub>R (exp x + exp x)"
     by (simp add: sinh_def cosh_def algebra_simps)
   also have "\<dots> = exp x" by (rule scaleR_half_double)
   finally show ?thesis .
 qed
 
 lemma cosh_plus_sinh: "cosh x + sinh x = exp x"
   by (subst add.commute) (rule sinh_plus_cosh)
 
 lemma cosh_minus_sinh: "cosh x - sinh x = exp (-x)"
 proof -
-  have "cosh x - sinh x = (1 / 2) *\<^sub>R (exp (-x) + exp (-x))"
+  have "cosh x - sinh x = (1/2) *\<^sub>R (exp (-x) + exp (-x))"
     by (simp add: sinh_def cosh_def algebra_simps)
   also have "\<dots> = exp (-x)" by (rule scaleR_half_double)
   finally show ?thesis .
 qed
 
 lemma sinh_minus_cosh: "sinh x - cosh x = -exp (-x)"
   using cosh_minus_sinh[of x] by (simp add: algebra_simps)
 
 
 context
   fixes x :: "'a :: {real_normed_field, banach}"
 begin
 
 lemma sinh_zero_iff: "sinh x = 0 \<longleftrightarrow> exp x \<in> {1, -1}"
   by (auto simp: sinh_def field_simps exp_minus power2_eq_square square_eq_1_iff)
 
 lemma cosh_zero_iff: "cosh x = 0 \<longleftrightarrow> exp x ^ 2 = -1"
   by (auto simp: cosh_def exp_minus field_simps power2_eq_square eq_neg_iff_add_eq_0)
 
 lemma cosh_square_eq: "cosh x ^ 2 = sinh x ^ 2 + 1"
   by (simp add: cosh_def sinh_def algebra_simps power2_eq_square exp_add [symmetric]
                 scaleR_conv_of_real)
 
 lemma sinh_square_eq: "sinh x ^ 2 = cosh x ^ 2 - 1"
   by (simp add: cosh_square_eq)
 
 lemma hyperbolic_pythagoras: "cosh x ^ 2 - sinh x ^ 2 = 1"
   by (simp add: cosh_square_eq)
 
 lemma sinh_add: "sinh (x + y) = sinh x * cosh y + cosh x * sinh y"
   by (simp add: sinh_def cosh_def algebra_simps scaleR_conv_of_real exp_add [symmetric])
 
 lemma sinh_diff: "sinh (x - y) = sinh x * cosh y - cosh x * sinh y"
   by (simp add: sinh_def cosh_def algebra_simps scaleR_conv_of_real exp_add [symmetric])
 
 lemma cosh_add: "cosh (x + y) = cosh x * cosh y + sinh x * sinh y"
   by (simp add: sinh_def cosh_def algebra_simps scaleR_conv_of_real exp_add [symmetric])
 
 lemma cosh_diff: "cosh (x - y) = cosh x * cosh y - sinh x * sinh y"
   by (simp add: sinh_def cosh_def algebra_simps scaleR_conv_of_real exp_add [symmetric])
 
 lemma tanh_add:
   "tanh (x + y) = (tanh x + tanh y) / (1 + tanh x * tanh y)"
   if "cosh x \<noteq> 0" "cosh y \<noteq> 0"
 proof -
   have "(sinh x * cosh y + cosh x * sinh y) * (1 + sinh x * sinh y / (cosh x * cosh y)) =
     (cosh x * cosh y + sinh x * sinh y) * ((sinh x * cosh y + sinh y * cosh x) / (cosh y * cosh x))"
     using that by (simp add: field_split_simps)
   also have "(sinh x * cosh y + sinh y * cosh x) / (cosh y * cosh x) = sinh x / cosh x + sinh y / cosh y"
     using that by (simp add: field_split_simps)
   finally have "(sinh x * cosh y + cosh x * sinh y) * (1 + sinh x * sinh y / (cosh x * cosh y)) =
     (sinh x / cosh x + sinh y / cosh y) * (cosh x * cosh y + sinh x * sinh y)"
     by simp
   then show ?thesis
     using that by (auto simp add: tanh_def sinh_add cosh_add eq_divide_eq)
      (simp_all add: field_split_simps)
 qed
 
 lemma sinh_double: "sinh (2 * x) = 2 * sinh x * cosh x"
   using sinh_add[of x] by simp
 
 lemma cosh_double: "cosh (2 * x) = cosh x ^ 2 + sinh x ^ 2"
   using cosh_add[of x] by (simp add: power2_eq_square)
 
 end
 
 lemma sinh_field_def: "sinh z = (exp z - exp (-z)) / (2 :: 'a :: {banach, real_normed_field})"
   by (simp add: sinh_def scaleR_conv_of_real)
 
 lemma cosh_field_def: "cosh z = (exp z + exp (-z)) / (2 :: 'a :: {banach, real_normed_field})"
   by (simp add: cosh_def scaleR_conv_of_real)
 
 
 subsubsection \<open>More specific properties of the real functions\<close>
 
 lemma sinh_real_zero_iff [simp]: "sinh (x::real) = 0 \<longleftrightarrow> x = 0"
 proof -
   have "(-1 :: real) < 0" by simp
   also have "0 < exp x" by simp
   finally have "exp x \<noteq> -1" by (intro notI) simp
   thus ?thesis by (subst sinh_zero_iff) simp
 qed
 
 lemma plus_inverse_ge_2:
   fixes x :: real
   assumes "x > 0"
   shows   "x + inverse x \<ge> 2"
 proof -
   have "0 \<le> (x - 1) ^ 2" by simp
   also have "\<dots> = x^2 - 2*x + 1" by (simp add: power2_eq_square algebra_simps)
   finally show ?thesis using assms by (simp add: field_simps power2_eq_square)
 qed
 
 lemma sinh_real_nonneg_iff [simp]: "sinh (x :: real) \<ge> 0 \<longleftrightarrow> x \<ge> 0"
   by (simp add: sinh_def)
 
 lemma sinh_real_pos_iff [simp]: "sinh (x :: real) > 0 \<longleftrightarrow> x > 0"
   by (simp add: sinh_def)
 
 lemma sinh_real_nonpos_iff [simp]: "sinh (x :: real) \<le> 0 \<longleftrightarrow> x \<le> 0"
   by (simp add: sinh_def)
 
 lemma sinh_real_neg_iff [simp]: "sinh (x :: real) < 0 \<longleftrightarrow> x < 0"
   by (simp add: sinh_def)
 
 lemma cosh_real_ge_1: "cosh (x :: real) \<ge> 1"
   using plus_inverse_ge_2[of "exp x"] by (simp add: cosh_def exp_minus)
 
 lemma cosh_real_pos [simp]: "cosh (x :: real) > 0"
   using cosh_real_ge_1[of x] by simp
 
 lemma cosh_real_nonneg[simp]: "cosh (x :: real) \<ge> 0"
   using cosh_real_ge_1[of x] by simp
 
 lemma cosh_real_nonzero [simp]: "cosh (x :: real) \<noteq> 0"
   using cosh_real_ge_1[of x] by simp
 
 lemma tanh_real_nonneg_iff [simp]: "tanh (x :: real) \<ge> 0 \<longleftrightarrow> x \<ge> 0"
   by (simp add: tanh_def field_simps)
 
 lemma tanh_real_pos_iff [simp]: "tanh (x :: real) > 0 \<longleftrightarrow> x > 0"
   by (simp add: tanh_def field_simps)
 
 lemma tanh_real_nonpos_iff [simp]: "tanh (x :: real) \<le> 0 \<longleftrightarrow> x \<le> 0"
   by (simp add: tanh_def field_simps)
 
 lemma tanh_real_neg_iff [simp]: "tanh (x :: real) < 0 \<longleftrightarrow> x < 0"
   by (simp add: tanh_def field_simps)
 
 lemma tanh_real_zero_iff [simp]: "tanh (x :: real) = 0 \<longleftrightarrow> x = 0"
   by (simp add: tanh_def field_simps)
 
 lemma arsinh_real_def: "arsinh (x::real) = ln (x + sqrt (x^2 + 1))"
   by (simp add: arsinh_def powr_half_sqrt)
 
 lemma arcosh_real_def: "x \<ge> 1 \<Longrightarrow> arcosh (x::real) = ln (x + sqrt (x^2 - 1))"
   by (simp add: arcosh_def powr_half_sqrt)
 
 lemma arsinh_real_aux: "0 < x + sqrt (x ^ 2 + 1 :: real)"
 proof (cases "x < 0")
   case True
   have "(-x) ^ 2 = x ^ 2" by simp
   also have "x ^ 2 < x ^ 2 + 1" by simp
   finally have "sqrt ((-x) ^ 2) < sqrt (x ^ 2 + 1)"
     by (rule real_sqrt_less_mono)
   thus ?thesis using True by simp
 qed (auto simp: add_nonneg_pos)
 
 lemma arsinh_minus_real [simp]: "arsinh (-x::real) = -arsinh x"
 proof -
   have "arsinh (-x) = ln (sqrt (x\<^sup>2 + 1) - x)"
     by (simp add: arsinh_real_def)
   also have "sqrt (x^2 + 1) - x = inverse (sqrt (x^2 + 1) + x)"
     using arsinh_real_aux[of x] by (simp add: field_split_simps algebra_simps power2_eq_square)
   also have "ln \<dots> = -arsinh x"
     using arsinh_real_aux[of x] by (simp add: arsinh_real_def ln_inverse)
   finally show ?thesis .
 qed
 
 lemma artanh_minus_real [simp]:
   assumes "abs x < 1"
   shows   "artanh (-x::real) = -artanh x"
   using assms by (simp add: artanh_def ln_div field_simps)
 
 lemma sinh_less_cosh_real: "sinh (x :: real) < cosh x"
   by (simp add: sinh_def cosh_def)
 
 lemma sinh_le_cosh_real: "sinh (x :: real) \<le> cosh x"
   by (simp add: sinh_def cosh_def)
 
 lemma tanh_real_lt_1: "tanh (x :: real) < 1"
   by (simp add: tanh_def sinh_less_cosh_real)
 
 lemma tanh_real_gt_neg1: "tanh (x :: real) > -1"
 proof -
   have "- cosh x < sinh x" by (simp add: sinh_def cosh_def field_split_simps)
   thus ?thesis by (simp add: tanh_def field_simps)
 qed
 
 lemma tanh_real_bounds: "tanh (x :: real) \<in> {-1<..<1}"
   using tanh_real_lt_1 tanh_real_gt_neg1 by simp
 
 context
   fixes x :: real
 begin
 
 lemma arsinh_sinh_real: "arsinh (sinh x) = x"
   by (simp add: arsinh_real_def powr_def sinh_square_eq sinh_plus_cosh)
 
 lemma arcosh_cosh_real: "x \<ge> 0 \<Longrightarrow> arcosh (cosh x) = x"
   by (simp add: arcosh_real_def powr_def cosh_square_eq cosh_real_ge_1 cosh_plus_sinh)
 
 lemma artanh_tanh_real: "artanh (tanh x) = x"
 proof -
   have "artanh (tanh x) = ln (cosh x * (cosh x + sinh x) / (cosh x * (cosh x - sinh x))) / 2"
     by (simp add: artanh_def tanh_def field_split_simps)
   also have "cosh x * (cosh x + sinh x) / (cosh x * (cosh x - sinh x)) =
                (cosh x + sinh x) / (cosh x - sinh x)" by simp
   also have "\<dots> = (exp x)^2"
     by (simp add: cosh_plus_sinh cosh_minus_sinh exp_minus field_simps power2_eq_square)
   also have "ln ((exp x)^2) / 2 = x" by (simp add: ln_realpow)
   finally show ?thesis .
 qed
 
 end
 
 lemma sinh_real_strict_mono: "strict_mono (sinh :: real \<Rightarrow> real)"
   by (rule pos_deriv_imp_strict_mono derivative_intros)+ auto
 
 lemma cosh_real_strict_mono:
   assumes "0 \<le> x" and "x < (y::real)"
   shows   "cosh x < cosh y"
 proof -
   from assms have "\<exists>z>x. z < y \<and> cosh y - cosh x = (y - x) * sinh z"
     by (intro MVT2) (auto dest: connectedD_interval intro!: derivative_eq_intros)
   then obtain z where z: "z > x" "z < y" "cosh y - cosh x = (y - x) * sinh z" by blast
   note \<open>cosh y - cosh x = (y - x) * sinh z\<close>
   also from \<open>z > x\<close> and assms have "(y - x) * sinh z > 0" by (intro mult_pos_pos) auto
   finally show "cosh x < cosh y" by simp
 qed
 
 lemma tanh_real_strict_mono: "strict_mono (tanh :: real \<Rightarrow> real)"
 proof -
   have *: "tanh x ^ 2 < 1" for x :: real
     using tanh_real_bounds[of x] by (simp add: abs_square_less_1 abs_if)
   show ?thesis
     by (rule pos_deriv_imp_strict_mono) (insert *, auto intro!: derivative_intros)
 qed
 
 lemma sinh_real_abs [simp]: "sinh (abs x :: real) = abs (sinh x)"
   by (simp add: abs_if)
 
 lemma cosh_real_abs [simp]: "cosh (abs x :: real) = cosh x"
   by (simp add: abs_if)
 
 lemma tanh_real_abs [simp]: "tanh (abs x :: real) = abs (tanh x)"
   by (auto simp: abs_if)
 
 lemma sinh_real_eq_iff [simp]: "sinh x = sinh y \<longleftrightarrow> x = (y :: real)"
   using sinh_real_strict_mono by (simp add: strict_mono_eq)
 
 lemma tanh_real_eq_iff [simp]: "tanh x = tanh y \<longleftrightarrow> x = (y :: real)"
   using tanh_real_strict_mono by (simp add: strict_mono_eq)
 
 lemma cosh_real_eq_iff [simp]: "cosh x = cosh y \<longleftrightarrow> abs x = abs (y :: real)"
 proof -
   have "cosh x = cosh y \<longleftrightarrow> x = y" if "x \<ge> 0" "y \<ge> 0" for x y :: real
     using cosh_real_strict_mono[of x y] cosh_real_strict_mono[of y x] that
     by (cases x y rule: linorder_cases) auto
   from this[of "abs x" "abs y"] show ?thesis by simp
 qed
 
 lemma sinh_real_le_iff [simp]: "sinh x \<le> sinh y \<longleftrightarrow> x \<le> (y::real)"
   using sinh_real_strict_mono by (simp add: strict_mono_less_eq)
 
 lemma cosh_real_nonneg_le_iff: "x \<ge> 0 \<Longrightarrow> y \<ge> 0 \<Longrightarrow> cosh x \<le> cosh y \<longleftrightarrow> x \<le> (y::real)"
   using cosh_real_strict_mono[of x y] cosh_real_strict_mono[of y x]
   by (cases x y rule: linorder_cases) auto
 
 lemma cosh_real_nonpos_le_iff: "x \<le> 0 \<Longrightarrow> y \<le> 0 \<Longrightarrow> cosh x \<le> cosh y \<longleftrightarrow> x \<ge> (y::real)"
   using cosh_real_nonneg_le_iff[of "-x" "-y"] by simp
 
 lemma tanh_real_le_iff [simp]: "tanh x \<le> tanh y \<longleftrightarrow> x \<le> (y::real)"
   using tanh_real_strict_mono by (simp add: strict_mono_less_eq)
 
 
 lemma sinh_real_less_iff [simp]: "sinh x < sinh y \<longleftrightarrow> x < (y::real)"
   using sinh_real_strict_mono by (simp add: strict_mono_less)
 
 lemma cosh_real_nonneg_less_iff: "x \<ge> 0 \<Longrightarrow> y \<ge> 0 \<Longrightarrow> cosh x < cosh y \<longleftrightarrow> x < (y::real)"
   using cosh_real_strict_mono[of x y] cosh_real_strict_mono[of y x]
   by (cases x y rule: linorder_cases) auto
 
 lemma cosh_real_nonpos_less_iff: "x \<le> 0 \<Longrightarrow> y \<le> 0 \<Longrightarrow> cosh x < cosh y \<longleftrightarrow> x > (y::real)"
   using cosh_real_nonneg_less_iff[of "-x" "-y"] by simp
 
 lemma tanh_real_less_iff [simp]: "tanh x < tanh y \<longleftrightarrow> x < (y::real)"
   using tanh_real_strict_mono by (simp add: strict_mono_less)
 
 
 subsubsection \<open>Limits\<close>
 
 lemma sinh_real_at_top: "filterlim (sinh :: real \<Rightarrow> real) at_top at_top"
 proof -
   have *: "((\<lambda>x. - exp (- x)) \<longlongrightarrow> (-0::real)) at_top"
     by (intro tendsto_minus filterlim_compose[OF exp_at_bot] filterlim_uminus_at_bot_at_top)
-  have "filterlim (\<lambda>x. (1 / 2) * (-exp (-x) + exp x) :: real) at_top at_top"
+  have "filterlim (\<lambda>x. (1/2) * (-exp (-x) + exp x) :: real) at_top at_top"
     by (rule filterlim_tendsto_pos_mult_at_top[OF _ _
                filterlim_tendsto_add_at_top[OF *]] tendsto_const)+ (auto simp: exp_at_top)
-  also have "(\<lambda>x. (1 / 2) * (-exp (-x) + exp x) :: real) = sinh"
+  also have "(\<lambda>x. (1/2) * (-exp (-x) + exp x) :: real) = sinh"
     by (simp add: fun_eq_iff sinh_def)
   finally show ?thesis .
 qed
 
 lemma sinh_real_at_bot: "filterlim (sinh :: real \<Rightarrow> real) at_bot at_bot"
 proof -
   have "filterlim (\<lambda>x. -sinh x :: real) at_bot at_top"
     by (simp add: filterlim_uminus_at_top [symmetric] sinh_real_at_top)
   also have "(\<lambda>x. -sinh x :: real) = (\<lambda>x. sinh (-x))" by simp
   finally show ?thesis by (subst filterlim_at_bot_mirror)
 qed
 
 lemma cosh_real_at_top: "filterlim (cosh :: real \<Rightarrow> real) at_top at_top"
 proof -
   have *: "((\<lambda>x. exp (- x)) \<longlongrightarrow> (0::real)) at_top"
     by (intro filterlim_compose[OF exp_at_bot] filterlim_uminus_at_bot_at_top)
-  have "filterlim (\<lambda>x. (1 / 2) * (exp (-x) + exp x) :: real) at_top at_top"
+  have "filterlim (\<lambda>x. (1/2) * (exp (-x) + exp x) :: real) at_top at_top"
     by (rule filterlim_tendsto_pos_mult_at_top[OF _ _
                filterlim_tendsto_add_at_top[OF *]] tendsto_const)+ (auto simp: exp_at_top)
-  also have "(\<lambda>x. (1 / 2) * (exp (-x) + exp x) :: real) = cosh"
+  also have "(\<lambda>x. (1/2) * (exp (-x) + exp x) :: real) = cosh"
     by (simp add: fun_eq_iff cosh_def)
   finally show ?thesis .
 qed
 
 lemma cosh_real_at_bot: "filterlim (cosh :: real \<Rightarrow> real) at_top at_bot"
 proof -
   have "filterlim (\<lambda>x. cosh (-x) :: real) at_top at_top"
     by (simp add: cosh_real_at_top)
   thus ?thesis by (subst filterlim_at_bot_mirror)
 qed
 
 lemma tanh_real_at_top: "(tanh \<longlongrightarrow> (1::real)) at_top"
 proof -
   have "((\<lambda>x::real. (1 - exp (- 2 * x)) / (1 + exp (- 2 * x))) \<longlongrightarrow> (1 - 0) / (1 + 0)) at_top"
     by (intro tendsto_intros filterlim_compose[OF exp_at_bot]
               filterlim_tendsto_neg_mult_at_bot[OF tendsto_const] filterlim_ident) auto
   also have "(\<lambda>x::real. (1 - exp (- 2 * x)) / (1 + exp (- 2 * x))) = tanh"
     by (rule ext) (simp add: tanh_real_altdef)
   finally show ?thesis by simp
 qed
 
 lemma tanh_real_at_bot: "(tanh \<longlongrightarrow> (-1::real)) at_bot"
 proof -
   have "((\<lambda>x::real. -tanh x) \<longlongrightarrow> -1) at_top"
     by (intro tendsto_minus tanh_real_at_top)
   also have "(\<lambda>x. -tanh x :: real) = (\<lambda>x. tanh (-x))" by simp
   finally show ?thesis by (subst filterlim_at_bot_mirror)
 qed
 
 
 subsubsection \<open>Properties of the inverse hyperbolic functions\<close>
 
 lemma isCont_sinh: "isCont sinh (x :: 'a :: {real_normed_field, banach})"
   unfolding sinh_def [abs_def] by (auto intro!: continuous_intros)
 
 lemma isCont_cosh: "isCont cosh (x :: 'a :: {real_normed_field, banach})"
   unfolding cosh_def [abs_def] by (auto intro!: continuous_intros)
 
 lemma isCont_tanh: "cosh x \<noteq> 0 \<Longrightarrow> isCont tanh (x :: 'a :: {real_normed_field, banach})"
   unfolding tanh_def [abs_def]
   by (auto intro!: continuous_intros isCont_divide isCont_sinh isCont_cosh)
 
 lemma continuous_on_sinh [continuous_intros]:
   fixes f :: "_ \<Rightarrow>'a::{real_normed_field,banach}"
   assumes "continuous_on A f"
   shows   "continuous_on A (\<lambda>x. sinh (f x))"
   unfolding sinh_def using assms by (intro continuous_intros)
 
 lemma continuous_on_cosh [continuous_intros]:
   fixes f :: "_ \<Rightarrow>'a::{real_normed_field,banach}"
   assumes "continuous_on A f"
   shows   "continuous_on A (\<lambda>x. cosh (f x))"
   unfolding cosh_def using assms by (intro continuous_intros)
 
 lemma continuous_sinh [continuous_intros]:
   fixes f :: "_ \<Rightarrow>'a::{real_normed_field,banach}"
   assumes "continuous F f"
   shows   "continuous F (\<lambda>x. sinh (f x))"
   unfolding sinh_def using assms by (intro continuous_intros)
 
 lemma continuous_cosh [continuous_intros]:
   fixes f :: "_ \<Rightarrow>'a::{real_normed_field,banach}"
   assumes "continuous F f"
   shows   "continuous F (\<lambda>x. cosh (f x))"
   unfolding cosh_def using assms by (intro continuous_intros)
 
 lemma continuous_on_tanh [continuous_intros]:
   fixes f :: "_ \<Rightarrow>'a::{real_normed_field,banach}"
   assumes "continuous_on A f" "\<And>x. x \<in> A \<Longrightarrow> cosh (f x) \<noteq> 0"
   shows   "continuous_on A (\<lambda>x. tanh (f x))"
   unfolding tanh_def using assms by (intro continuous_intros) auto
 
 lemma continuous_at_within_tanh [continuous_intros]:
   fixes f :: "_ \<Rightarrow>'a::{real_normed_field,banach}"
   assumes "continuous (at x within A) f" "cosh (f x) \<noteq> 0"
   shows   "continuous (at x within A) (\<lambda>x. tanh (f x))"
   unfolding tanh_def using assms by (intro continuous_intros continuous_divide) auto
 
 lemma continuous_tanh [continuous_intros]:
   fixes f :: "_ \<Rightarrow>'a::{real_normed_field,banach}"
   assumes "continuous F f" "cosh (f (Lim F (\<lambda>x. x))) \<noteq> 0"
   shows   "continuous F (\<lambda>x. tanh (f x))"
   unfolding tanh_def using assms by (intro continuous_intros continuous_divide) auto
 
 lemma tendsto_sinh [tendsto_intros]:
   fixes f :: "_ \<Rightarrow>'a::{real_normed_field,banach}"
   shows "(f \<longlongrightarrow> a) F \<Longrightarrow> ((\<lambda>x. sinh (f x)) \<longlongrightarrow> sinh a) F"
   by (rule isCont_tendsto_compose [OF isCont_sinh])
 
 lemma tendsto_cosh [tendsto_intros]:
   fixes f :: "_ \<Rightarrow>'a::{real_normed_field,banach}"
   shows "(f \<longlongrightarrow> a) F \<Longrightarrow> ((\<lambda>x. cosh (f x)) \<longlongrightarrow> cosh a) F"
   by (rule isCont_tendsto_compose [OF isCont_cosh])
 
 lemma tendsto_tanh [tendsto_intros]:
   fixes f :: "_ \<Rightarrow>'a::{real_normed_field,banach}"
   shows "(f \<longlongrightarrow> a) F \<Longrightarrow> cosh a \<noteq> 0 \<Longrightarrow> ((\<lambda>x. tanh (f x)) \<longlongrightarrow> tanh a) F"
   by (rule isCont_tendsto_compose [OF isCont_tanh])
 
 
 lemma arsinh_real_has_field_derivative [derivative_intros]:
   fixes x :: real
   shows "(arsinh has_field_derivative (1 / (sqrt (x ^ 2 + 1)))) (at x within A)"
 proof -
   have pos: "1 + x ^ 2 > 0" by (intro add_pos_nonneg) auto
   from pos arsinh_real_aux[of x] show ?thesis unfolding arsinh_def [abs_def]
     by (auto intro!: derivative_eq_intros simp: powr_minus powr_half_sqrt field_split_simps)
 qed
 
 lemma arcosh_real_has_field_derivative [derivative_intros]:
   fixes x :: real
   assumes "x > 1"
   shows   "(arcosh has_field_derivative (1 / (sqrt (x ^ 2 - 1)))) (at x within A)"
 proof -
   from assms have "x + sqrt (x\<^sup>2 - 1) > 0" by (simp add: add_pos_pos)
   thus ?thesis using assms unfolding arcosh_def [abs_def]
     by (auto intro!: derivative_eq_intros
              simp: powr_minus powr_half_sqrt field_split_simps power2_eq_1_iff)
 qed
 
 lemma artanh_real_has_field_derivative [derivative_intros]:
   "(artanh has_field_derivative (1 / (1 - x ^ 2))) (at x within A)" if
     "\<bar>x\<bar> < 1" for x :: real
 proof -
   from that have "- 1 < x" "x < 1" by linarith+
   hence "(artanh has_field_derivative (4 - 4 * x) / ((1 + x) * (1 - x) * (1 - x) * 4))
            (at x within A)" unfolding artanh_def [abs_def]
     by (auto intro!: derivative_eq_intros simp: powr_minus powr_half_sqrt)
   also have "(4 - 4 * x) / ((1 + x) * (1 - x) * (1 - x) * 4) = 1 / ((1 + x) * (1 - x))"
     using \<open>-1 < x\<close> \<open>x < 1\<close> by (simp add: frac_eq_eq)
   also have "(1 + x) * (1 - x) = 1 - x ^ 2"
     by (simp add: algebra_simps power2_eq_square)
   finally show ?thesis .
 qed
 
 lemma continuous_on_arsinh [continuous_intros]: "continuous_on A (arsinh :: real \<Rightarrow> real)"
   by (rule DERIV_continuous_on derivative_intros)+
 
 lemma continuous_on_arcosh [continuous_intros]:
   assumes "A \<subseteq> {1..}"
   shows   "continuous_on A (arcosh :: real \<Rightarrow> real)"
 proof -
   have pos: "x + sqrt (x ^ 2 - 1) > 0" if "x \<ge> 1" for x
     using that by (intro add_pos_nonneg) auto
   show ?thesis
   unfolding arcosh_def [abs_def]
   by (intro continuous_on_subset [OF _ assms] continuous_on_ln continuous_on_add
                continuous_on_id continuous_on_powr')
      (auto dest: pos simp: powr_half_sqrt intro!: continuous_intros)
 qed
 
 lemma continuous_on_artanh [continuous_intros]:
   assumes "A \<subseteq> {-1<..<1}"
   shows   "continuous_on A (artanh :: real \<Rightarrow> real)"
   unfolding artanh_def [abs_def]
   by (intro continuous_on_subset [OF _ assms]) (auto intro!: continuous_intros)
 
 lemma continuous_on_arsinh' [continuous_intros]:
   fixes f :: "real \<Rightarrow> real"
   assumes "continuous_on A f"
   shows   "continuous_on A (\<lambda>x. arsinh (f x))"
   by (rule continuous_on_compose2[OF continuous_on_arsinh assms]) auto
 
 lemma continuous_on_arcosh' [continuous_intros]:
   fixes f :: "real \<Rightarrow> real"
   assumes "continuous_on A f" "\<And>x. x \<in> A \<Longrightarrow> f x \<ge> 1"
   shows   "continuous_on A (\<lambda>x. arcosh (f x))"
   by (rule continuous_on_compose2[OF continuous_on_arcosh assms(1) order.refl])
      (use assms(2) in auto)
 
 lemma continuous_on_artanh' [continuous_intros]:
   fixes f :: "real \<Rightarrow> real"
   assumes "continuous_on A f" "\<And>x. x \<in> A \<Longrightarrow> f x \<in> {-1<..<1}"
   shows   "continuous_on A (\<lambda>x. artanh (f x))"
   by (rule continuous_on_compose2[OF continuous_on_artanh assms(1) order.refl])
      (use assms(2) in auto)
 
 lemma isCont_arsinh [continuous_intros]: "isCont arsinh (x :: real)"
   using continuous_on_arsinh[of UNIV] by (auto simp: continuous_on_eq_continuous_at)
 
 lemma isCont_arcosh [continuous_intros]:
   assumes "x > 1"
   shows   "isCont arcosh (x :: real)"
 proof -
   have "continuous_on {1::real<..} arcosh"
     by (rule continuous_on_arcosh) auto
   with assms show ?thesis by (auto simp: continuous_on_eq_continuous_at)
 qed
 
 lemma isCont_artanh [continuous_intros]:
   assumes "x > -1" "x < 1"
   shows   "isCont artanh (x :: real)"
 proof -
   have "continuous_on {-1<..<(1::real)} artanh"
     by (rule continuous_on_artanh) auto
   with assms show ?thesis by (auto simp: continuous_on_eq_continuous_at)
 qed
 
 lemma tendsto_arsinh [tendsto_intros]: "(f \<longlongrightarrow> a) F \<Longrightarrow> ((\<lambda>x. arsinh (f x)) \<longlongrightarrow> arsinh a) F"
   for f :: "_ \<Rightarrow> real"
   by (rule isCont_tendsto_compose [OF isCont_arsinh])
 
 lemma tendsto_arcosh_strong [tendsto_intros]:
   fixes f :: "_ \<Rightarrow> real"
   assumes "(f \<longlongrightarrow> a) F" "a \<ge> 1" "eventually (\<lambda>x. f x \<ge> 1) F"
   shows   "((\<lambda>x. arcosh (f x)) \<longlongrightarrow> arcosh a) F"
   by (rule continuous_on_tendsto_compose[OF continuous_on_arcosh[OF order.refl]])
      (use assms in auto)
 
 lemma tendsto_arcosh:
   fixes f :: "_ \<Rightarrow> real"
   assumes "(f \<longlongrightarrow> a) F" "a > 1"
   shows "((\<lambda>x. arcosh (f x)) \<longlongrightarrow> arcosh a) F"
   by (rule isCont_tendsto_compose [OF isCont_arcosh]) (use assms in auto)
 
 lemma tendsto_arcosh_at_left_1: "(arcosh \<longlongrightarrow> 0) (at_right (1::real))"
 proof -
   have "(arcosh \<longlongrightarrow> arcosh 1) (at_right (1::real))"
     by (rule tendsto_arcosh_strong) (auto simp: eventually_at intro!: exI[of _ 1])
   thus ?thesis by simp
 qed
 
 lemma tendsto_artanh [tendsto_intros]:
   fixes f :: "'a \<Rightarrow> real"
   assumes "(f \<longlongrightarrow> a) F" "a > -1" "a < 1"
   shows   "((\<lambda>x. artanh (f x)) \<longlongrightarrow> artanh a) F"
   by (rule isCont_tendsto_compose [OF isCont_artanh]) (use assms in auto)
 
 lemma continuous_arsinh [continuous_intros]:
   "continuous F f \<Longrightarrow> continuous F (\<lambda>x. arsinh (f x :: real))"
   unfolding continuous_def by (rule tendsto_arsinh)
 
 (* TODO: This rule does not work for one-sided continuity at 1 *)
 lemma continuous_arcosh_strong [continuous_intros]:
   assumes "continuous F f" "eventually (\<lambda>x. f x \<ge> 1) F"
   shows   "continuous F (\<lambda>x. arcosh (f x :: real))"
 proof (cases "F = bot")
   case False
   show ?thesis
     unfolding continuous_def
   proof (intro tendsto_arcosh_strong)
     show "1 \<le> f (Lim F (\<lambda>x. x))"
       using assms False unfolding continuous_def by (rule tendsto_lowerbound)
   qed (insert assms, auto simp: continuous_def)
 qed auto
 
 lemma continuous_arcosh:
   "continuous F f \<Longrightarrow> f (Lim F (\<lambda>x. x)) > 1 \<Longrightarrow> continuous F (\<lambda>x. arcosh (f x :: real))"
   unfolding continuous_def by (rule tendsto_arcosh) auto
 
 lemma continuous_artanh [continuous_intros]:
   "continuous F f \<Longrightarrow> f (Lim F (\<lambda>x. x)) \<in> {-1<..<1} \<Longrightarrow> continuous F (\<lambda>x. artanh (f x :: real))"
   unfolding continuous_def by (rule tendsto_artanh) auto
 
 lemma arsinh_real_at_top:
   "filterlim (arsinh :: real \<Rightarrow> real) at_top at_top"
 proof (subst filterlim_cong[OF refl refl])
   show "filterlim (\<lambda>x. ln (x + sqrt (1 + x\<^sup>2))) at_top at_top"
     by (intro filterlim_compose[OF ln_at_top filterlim_at_top_add_at_top] filterlim_ident
               filterlim_compose[OF sqrt_at_top] filterlim_tendsto_add_at_top[OF tendsto_const]
               filterlim_pow_at_top) auto
 qed (auto intro!: eventually_mono[OF eventually_ge_at_top[of 1]] simp: arsinh_real_def add_ac)
 
 lemma arsinh_real_at_bot:
   "filterlim (arsinh :: real \<Rightarrow> real) at_bot at_bot"
 proof -
   have "filterlim (\<lambda>x::real. -arsinh x) at_bot at_top"
     by (subst filterlim_uminus_at_top [symmetric]) (rule arsinh_real_at_top)
   also have "(\<lambda>x::real. -arsinh x) = (\<lambda>x. arsinh (-x))" by simp
   finally show ?thesis
     by (subst filterlim_at_bot_mirror)
 qed
 
 lemma arcosh_real_at_top:
   "filterlim (arcosh :: real \<Rightarrow> real) at_top at_top"
 proof (subst filterlim_cong[OF refl refl])
   show "filterlim (\<lambda>x. ln (x + sqrt (-1 + x\<^sup>2))) at_top at_top"
     by (intro filterlim_compose[OF ln_at_top filterlim_at_top_add_at_top] filterlim_ident
               filterlim_compose[OF sqrt_at_top] filterlim_tendsto_add_at_top[OF tendsto_const]
               filterlim_pow_at_top) auto
 qed (auto intro!: eventually_mono[OF eventually_ge_at_top[of 1]] simp: arcosh_real_def)
 
 lemma artanh_real_at_left_1:
   "filterlim (artanh :: real \<Rightarrow> real) at_top (at_left 1)"
 proof -
   have *: "filterlim (\<lambda>x::real. (1 + x) / (1 - x)) at_top (at_left 1)"
     by (rule LIM_at_top_divide)
        (auto intro!: tendsto_eq_intros eventually_mono[OF eventually_at_left_real[of 0]])
   have "filterlim (\<lambda>x::real. (1/2) * ln ((1 + x) / (1 - x))) at_top (at_left 1)"
     by (intro filterlim_tendsto_pos_mult_at_top[OF tendsto_const] *
                  filterlim_compose[OF ln_at_top]) auto
   also have "(\<lambda>x::real. (1/2) * ln ((1 + x) / (1 - x))) = artanh"
     by (simp add: artanh_def [abs_def])
   finally show ?thesis .
 qed
 
 lemma artanh_real_at_right_1:
   "filterlim (artanh :: real \<Rightarrow> real) at_bot (at_right (-1))"
 proof -
   have "?thesis \<longleftrightarrow> filterlim (\<lambda>x::real. -artanh x) at_top (at_right (-1))"
     by (simp add: filterlim_uminus_at_bot)
   also have "\<dots> \<longleftrightarrow> filterlim (\<lambda>x::real. artanh (-x)) at_top (at_right (-1))"
     by (intro filterlim_cong refl eventually_mono[OF eventually_at_right_real[of "-1" "1"]]) auto
   also have "\<dots> \<longleftrightarrow> filterlim (artanh :: real \<Rightarrow> real) at_top (at_left 1)"
     by (simp add: filterlim_at_left_to_right)
   also have \<dots> by (rule artanh_real_at_left_1)
   finally show ?thesis .
 qed
 
 
 subsection \<open>Simprocs for root and power literals\<close>
 
 lemma numeral_powr_numeral_real [simp]:
   "numeral m powr numeral n = (numeral m ^ numeral n :: real)"
   by (simp add: powr_numeral)
 
 context
 begin
 
 private lemma sqrt_numeral_simproc_aux:
   assumes "m * m \<equiv> n"
   shows   "sqrt (numeral n :: real) \<equiv> numeral m"
 proof -
   have "numeral n \<equiv> numeral m * (numeral m :: real)" by (simp add: assms [symmetric])
   moreover have "sqrt \<dots> \<equiv> numeral m" by (subst real_sqrt_abs2) simp
   ultimately show "sqrt (numeral n :: real) \<equiv> numeral m" by simp
 qed
 
 private lemma root_numeral_simproc_aux:
   assumes "Num.pow m n \<equiv> x"
   shows   "root (numeral n) (numeral x :: real) \<equiv> numeral m"
   by (subst assms [symmetric], subst numeral_pow, subst real_root_pos2) simp_all
 
 private lemma powr_numeral_simproc_aux:
   assumes "Num.pow y n = x"
   shows   "numeral x powr (m / numeral n :: real) \<equiv> numeral y powr m"
   by (subst assms [symmetric], subst numeral_pow, subst powr_numeral [symmetric])
      (simp, subst powr_powr, simp_all)
 
 private lemma numeral_powr_inverse_eq:
   "numeral x powr (inverse (numeral n)) = numeral x powr (1 / numeral n :: real)"
   by simp
 
 
 ML \<open>
 
 signature ROOT_NUMERAL_SIMPROC = sig
 
 val sqrt : int option -> int -> int option
 val sqrt' : int option -> int -> int option
 val nth_root : int option -> int -> int -> int option
 val nth_root' : int option -> int -> int -> int option
 val sqrt_simproc : Proof.context -> cterm -> thm option
 val root_simproc : int * int -> Proof.context -> cterm -> thm option
 val powr_simproc : int * int -> Proof.context -> cterm -> thm option
 
 end
 
 structure Root_Numeral_Simproc : ROOT_NUMERAL_SIMPROC = struct
 
 fun iterate NONE p f x =
       let
         fun go x = if p x then x else go (f x)
       in
         SOME (go x)
       end
   | iterate (SOME threshold) p f x =
       let
         fun go (threshold, x) = 
           if p x then SOME x else if threshold = 0 then NONE else go (threshold - 1, f x)
       in
         go (threshold, x)
       end  
 
 
 fun nth_root _ 1 x = SOME x
   | nth_root _ _ 0 = SOME 0
   | nth_root _ _ 1 = SOME 1
   | nth_root threshold n x =
   let
     fun newton_step y = ((n - 1) * y + x div Integer.pow (n - 1) y) div n
     fun is_root y = Integer.pow n y <= x andalso x < Integer.pow n (y + 1)
   in
     if x < n then
       SOME 1
     else if x < Integer.pow n 2 then 
       SOME 1 
     else 
       let
         val y = Real.floor (Math.pow (Real.fromInt x, Real.fromInt 1 / Real.fromInt n))
       in
         if is_root y then
           SOME y
         else
           iterate threshold is_root newton_step ((x + n - 1) div n)
       end
   end
 
 fun nth_root' _ 1 x = SOME x
   | nth_root' _ _ 0 = SOME 0
   | nth_root' _ _ 1 = SOME 1
   | nth_root' threshold n x = if x < n then NONE else if x < Integer.pow n 2 then NONE else
       case nth_root threshold n x of
         NONE => NONE
       | SOME y => if Integer.pow n y = x then SOME y else NONE
 
 fun sqrt _ 0 = SOME 0
   | sqrt _ 1 = SOME 1
   | sqrt threshold n =
     let
       fun aux (a, b) = if n >= b * b then aux (b, b * b) else (a, b)
       val (lower_root, lower_n) = aux (1, 2)
       fun newton_step x = (x + n div x) div 2
       fun is_sqrt r = r*r <= n andalso n < (r+1)*(r+1)
       val y = Real.floor (Math.sqrt (Real.fromInt n))
     in
       if is_sqrt y then 
         SOME y
       else
         Option.mapPartial (iterate threshold is_sqrt newton_step o (fn x => x * lower_root)) 
           (sqrt threshold (n div lower_n))
     end
 
 fun sqrt' threshold x =
   case sqrt threshold x of
     NONE => NONE
   | SOME y => if y * y = x then SOME y else NONE
 
 fun sqrt_simproc ctxt ct =
   let
     val n = ct |> Thm.term_of |> dest_comb |> snd |> dest_comb |> snd |> HOLogic.dest_numeral
   in
     case sqrt' (SOME 10000) n of
       NONE => NONE
     | SOME m => 
         SOME (Thm.instantiate' [] (map (SOME o Thm.cterm_of ctxt o HOLogic.mk_numeral) [m, n])
                   @{thm sqrt_numeral_simproc_aux})
   end
     handle TERM _ => NONE
 
 fun root_simproc (threshold1, threshold2) ctxt ct =
   let
     val [n, x] = 
       ct |> Thm.term_of |> strip_comb |> snd |> map (dest_comb #> snd #> HOLogic.dest_numeral)
   in
     if n > threshold1 orelse x > threshold2 then NONE else
       case nth_root' (SOME 100) n x of
         NONE => NONE
       | SOME m => 
           SOME (Thm.instantiate' [] (map (SOME o Thm.cterm_of ctxt o HOLogic.mk_numeral) [m, n, x])
             @{thm root_numeral_simproc_aux})
   end
     handle TERM _ => NONE
          | Match => NONE
 
 fun powr_simproc (threshold1, threshold2) ctxt ct =
   let
     val eq_thm = Conv.try_conv (Conv.rewr_conv @{thm numeral_powr_inverse_eq}) ct
     val ct = Thm.dest_equals_rhs (Thm.cprop_of eq_thm)
     val (_, [x, t]) = strip_comb (Thm.term_of ct)
     val (_, [m, n]) = strip_comb t
     val [x, n] = map (dest_comb #> snd #> HOLogic.dest_numeral) [x, n]
   in
     if n > threshold1 orelse x > threshold2 then NONE else
       case nth_root' (SOME 100) n x of
         NONE => NONE
       | SOME y => 
           let
             val [y, n, x] = map HOLogic.mk_numeral [y, n, x]
             val thm = Thm.instantiate' [] (map (SOME o Thm.cterm_of ctxt) [y, n, x, m])
               @{thm powr_numeral_simproc_aux}
           in
             SOME (@{thm transitive} OF [eq_thm, thm])
           end
   end
     handle TERM _ => NONE
          | Match => NONE
 
 end
 \<close>
 
 end
 
 simproc_setup sqrt_numeral ("sqrt (numeral n)") = 
   \<open>K Root_Numeral_Simproc.sqrt_simproc\<close>
   
 simproc_setup root_numeral ("root (numeral n) (numeral x)") = 
   \<open>K (Root_Numeral_Simproc.root_simproc (200, Integer.pow 200 2))\<close>
 
 simproc_setup powr_divide_numeral 
   ("numeral x powr (m / numeral n :: real)" | "numeral x powr (inverse (numeral n) :: real)") = 
     \<open>K (Root_Numeral_Simproc.powr_simproc (200, Integer.pow 200 2))\<close>
 
 
 lemma "root 100 1267650600228229401496703205376 = 2"
   by simp
     
 lemma "sqrt 196 = 14" 
   by simp
 
 lemma "256 powr (7 / 4 :: real) = 16384"
   by simp
     
 lemma "27 powr (inverse 3) = (3::real)"
   by simp
 
 end