diff --git a/thys/Grothendieck_Schemes/Comm_Ring.thy b/thys/Grothendieck_Schemes/Comm_Ring.thy
--- a/thys/Grothendieck_Schemes/Comm_Ring.thy
+++ b/thys/Grothendieck_Schemes/Comm_Ring.thy
@@ -1,5669 +1,5670 @@
 
 text \<open>Authors: Anthony Bordg and Lawrence Paulson,
 with some contributions from Wenda Li\<close>
 
 theory Comm_Ring
   imports
     "Group_Extras"
     "Topological_Space"
     "Jacobson_Basic_Algebra.Ring_Theory"
     "Set_Extras"
 begin
 
 (*Suppresses the built-in plus sign, but why does
  no_notation minus (infixl "-" 65)
 cause errors with monoid subtraction below? --LCP
 *)
 no_notation plus (infixl "+" 65)
 
 lemma (in monoid_homomorphism) monoid_preimage: "Group_Theory.monoid (\<eta> \<^sup>\<inverse> M M') (\<cdot>) \<one>"
   by (simp add: Int_absorb1 source.monoid_axioms subsetI)
 
 lemma (in group_homomorphism) group_preimage: "Group_Theory.group (\<eta> \<^sup>\<inverse> G G') (\<cdot>) \<one>"
   by (simp add: Int_absorb1 source.group_axioms subsetI)
 
 lemma (in ring_homomorphism) ring_preimage: "ring (\<eta> \<^sup>\<inverse> R R') (+) (\<cdot>) \<zero> \<one>"
   by (simp add: Int_absorb2 Int_commute source.ring_axioms subset_iff)
 
 section \<open>Commutative Rings\<close>
 
 subsection \<open>Commutative Rings\<close>
 
 locale comm_ring = ring +
   assumes comm_mult: "\<lbrakk> a \<in> R; b \<in> R \<rbrakk> \<Longrightarrow> a \<cdot> b = b \<cdot> a"
 
 text \<open>The zero ring is a commutative ring.\<close>
 
 lemma invertible_0: "monoid.invertible {0} (\<lambda>n m. 0) 0 0"
     using Group_Theory.monoid.intro monoid.unit_invertible by force
 
 interpretation ring0: ring "{0::nat}" "\<lambda>n m. 0" "\<lambda>n m. 0" 0 0
   using invertible_0 by unfold_locales auto
 
 declare ring0.additive.left_unit [simp del] ring0.additive.invertible [simp del]
 declare ring0.additive.invertible_left_inverse [simp del] ring0.right_zero [simp del]
 
 interpretation cring0: comm_ring "{0::nat}" "\<lambda>n m. 0" "\<lambda>n m. 0" 0 0
   by (metis comm_ring_axioms_def comm_ring_def ring0.ring_axioms)
 
 (* def 0.13 *)
 definition (in ring) zero_divisor :: "'a \<Rightarrow> 'a \<Rightarrow> bool"
   where "zero_divisor x y \<equiv> (x \<noteq> \<zero>) \<and> (y \<noteq> \<zero>) \<and> (x \<cdot> y = \<zero>)"
 
 subsection \<open>Entire Rings\<close>
 
 (* def 0.14 *)
 locale entire_ring = comm_ring + assumes units_neq: "\<one> \<noteq> \<zero>" and
 no_zero_div: "\<lbrakk> x \<in> R; y \<in> R\<rbrakk> \<Longrightarrow> \<not>(zero_divisor x y)"
 
 subsection \<open>Ideals\<close>
 
 context comm_ring begin
 
 lemma mult_left_assoc: "\<lbrakk> a \<in> R; b \<in> R; c \<in> R \<rbrakk> \<Longrightarrow> b \<cdot> (a \<cdot> c) = a \<cdot> (b \<cdot> c)"
   using comm_mult multiplicative.associative by auto
 
 lemmas ring_mult_ac = comm_mult multiplicative.associative mult_left_assoc
 
 (* ex. 0.16 *)
 lemma ideal_R_R: "ideal R R (+) (\<cdot>) \<zero> \<one>"
 proof qed auto
 
 lemma ideal_0_R: "ideal {\<zero>} R (+) (\<cdot>) \<zero> \<one>"
 proof
   show "monoid.invertible {\<zero>} (+) \<zero> u"
     if "u \<in> {\<zero>}"
     for u :: 'a
   proof (rule monoid.invertibleI)
     show "Group_Theory.monoid {\<zero>} (+) \<zero>"
     proof qed (use that in auto)
   qed (use that in auto)
 qed auto
 
 definition ideal_gen_by_prod :: "'a set \<Rightarrow> 'a set \<Rightarrow> 'a set"
   where "ideal_gen_by_prod \<aa> \<bb> \<equiv> additive.subgroup_generated {x. \<exists>a b. x = a \<cdot> b \<and> a \<in> \<aa> \<and> b \<in> \<bb>}"
 
 lemma ideal_zero: "ideal A R add mult zero unit \<Longrightarrow> zero \<in> A"
   by (simp add: ideal_def subgroup_of_additive_group_of_ring_def subgroup_def submonoid_def submonoid_axioms_def)
 
 lemma ideal_implies_subset:
   assumes "ideal A R add mult zero unit"
   shows "A \<subseteq> R"
   by (meson assms ideal_def subgroup_def subgroup_of_additive_group_of_ring_def submonoid_axioms_def submonoid_def)
 
 lemma ideal_inverse:
   assumes "a \<in> A" "ideal A R (+) mult zero unit"
   shows "additive.inverse a \<in> A"
   by (meson additive.invertible assms comm_ring.ideal_implies_subset comm_ring_axioms ideal_def subgroup.subgroup_inverse_iff subgroup_of_additive_group_of_ring_def subsetD)
 
 lemma ideal_add:
   assumes "a \<in> A"  "b \<in> A" "ideal A R add mult zero unit"
   shows "add a b \<in> A"
   by (meson Group_Theory.group_def assms ideal_def monoid.composition_closed subgroup_def subgroup_of_additive_group_of_ring_def)
 
 lemma ideal_mult_in_subgroup_generated:
   assumes \<aa>: "ideal \<aa> R (+) (\<cdot>) \<zero> \<one>" and \<bb>: "ideal \<bb> R (+) (\<cdot>) \<zero> \<one>" and "a \<in> \<aa>" "b \<in> \<bb>"
   shows "a \<cdot> b \<in> ideal_gen_by_prod \<aa> \<bb>"
   proof -
   have "\<exists>x y. a \<cdot> b = x \<cdot> y \<and> x \<in> \<aa> \<and> y \<in> \<bb>"
     using assms ideal_implies_subset by blast
   with ideal_implies_subset show ?thesis
     unfolding additive.subgroup_generated_def ideal_gen_by_prod_def
     using assms ideal_implies_subset by (blast intro: additive.generate.incl)
 qed
 
 subsection \<open>Ideals generated by an Element\<close>
 
 definition gen_ideal:: "'a \<Rightarrow> 'a set" ("\<langle>_\<rangle>")
   where "\<langle>x\<rangle> \<equiv> {y. \<exists>r\<in>R. y = r \<cdot> x}"
 
 lemma zero_in_gen_ideal:
   assumes "x \<in> R"
   shows "\<zero> \<in> \<langle>x\<rangle>"
 proof -
   have "\<exists>a. a \<in> R \<and> \<zero> = a \<cdot> x"
     by (metis (lifting) additive.unit_closed assms left_zero)
   then show ?thesis
     using gen_ideal_def by blast
 qed
 
 lemma add_in_gen_ideal:
   "\<lbrakk>x \<in> R; a \<in> \<langle>x\<rangle>; b \<in> \<langle>x\<rangle>\<rbrakk> \<Longrightarrow> a + b \<in> \<langle>x\<rangle>"
     apply (clarsimp simp : gen_ideal_def)
   by (metis (no_types) additive.composition_closed distributive(2))
 
 lemma gen_ideal_subset:
   assumes "x \<in> R"
   shows "\<langle>x\<rangle> \<subseteq> R"
   using assms comm_ring.gen_ideal_def local.comm_ring_axioms by fastforce
 
 lemma gen_ideal_monoid:
   assumes "x \<in> R"
   shows "Group_Theory.monoid \<langle>x\<rangle> (+) \<zero>"
 proof
   show "a + b \<in> \<langle>x\<rangle>" if "a \<in> \<langle>x\<rangle>" "b \<in> \<langle>x\<rangle>" for a b
     by (simp add: add_in_gen_ideal assms that)
 qed (use assms zero_in_gen_ideal gen_ideal_def in auto)
 
 lemma gen_ideal_group:
   assumes "x \<in> R"
   shows "Group_Theory.group \<langle>x\<rangle> (+) \<zero>"
 proof
   fix a b c
   assume "a \<in> \<langle>x\<rangle>" "b \<in> \<langle>x\<rangle>" "c \<in> \<langle>x\<rangle>"
   then show "a + b + c = a + (b + c)"
     by (meson assms gen_ideal_monoid monoid.associative)
 next
   fix a
   assume a: "a \<in> \<langle>x\<rangle>"
   show "\<zero> + a = a"
     by (meson a assms gen_ideal_monoid monoid.left_unit)
   show "a + \<zero> = a"
     by (meson a assms gen_ideal_monoid monoid.right_unit)
   interpret M: monoid "\<langle>x\<rangle>" "(+)" \<zero>
     by (simp add: assms gen_ideal_monoid)
   obtain r where r: "r\<in>R" "a = r \<cdot> x"
     using a gen_ideal_def by auto
   show "monoid.invertible \<langle>x\<rangle> (+) \<zero> a"
   proof (rule M.invertibleI)
     have "\<exists>r\<in>R. - a = r \<cdot> x"
       by (metis assms ideal_R_R ideal_inverse local.left_minus r)
     then show "-a \<in> \<langle>x\<rangle>" by (simp add: gen_ideal_def)
   qed (use a r assms in auto)
 qed (auto simp: zero_in_gen_ideal add_in_gen_ideal assms)
 
 lemma gen_ideal_ideal:
   assumes "x \<in> R"
   shows "ideal \<langle>x\<rangle> R (+) (\<cdot>) \<zero> \<one>"
 proof intro_locales
   show "submonoid_axioms \<langle>x\<rangle> R (+) \<zero>"
     by (simp add: add_in_gen_ideal assms gen_ideal_subset submonoid_axioms.intro zero_in_gen_ideal)
   show "Group_Theory.group_axioms \<langle>x\<rangle> (+) \<zero>"
     by (meson Group_Theory.group_def assms gen_ideal_group)
   show "ideal_axioms \<langle>x\<rangle> R (\<cdot>)"
   proof
     fix a b
     assume "a \<in> R" "b \<in> \<langle>x\<rangle>"
     then obtain r where r: "r\<in>R" "b = r \<cdot> x"
       by (auto simp add: gen_ideal_def)
     have "a \<cdot> (r \<cdot> x) = (a \<cdot> r) \<cdot> x"
       using \<open>a \<in> R\<close> \<open>r \<in> R\<close> assms multiplicative.associative by presburger
     then show "a \<cdot> b \<in> \<langle>x\<rangle>"
       using \<open>a \<in> R\<close> r gen_ideal_def by blast
     then show "b \<cdot> a \<in> \<langle>x\<rangle>"
       by (simp add: \<open>a \<in> R\<close> assms comm_mult r)
   qed
 qed (auto simp add: assms gen_ideal_monoid)
 
 
 subsection \<open>Exercises\<close>
 
 lemma in_ideal_gen_by_prod:
   assumes \<aa>: "ideal \<aa> R (+) (\<cdot>) \<zero> \<one>" and \<bb>: "ideal \<bb> R (+) (\<cdot>) \<zero> \<one>"
     and "a \<in> R" and b: "b \<in> ideal_gen_by_prod \<aa> \<bb>"
   shows "a \<cdot> b \<in> ideal_gen_by_prod \<aa> \<bb>"
   using b \<open>a \<in> R\<close>
   unfolding additive.subgroup_generated_def ideal_gen_by_prod_def
 proof (induction arbitrary: a)
   case unit
   then show ?case
     by (simp add: additive.generate.unit)
 next
   case (incl x u)
   with \<aa> \<bb> have "\<And>a b. \<lbrakk>a \<cdot> b \<in> R; a \<in> \<aa>; b \<in> \<bb>\<rbrakk> \<Longrightarrow> \<exists>x y. u \<cdot> (a \<cdot> b) = x \<cdot> y \<and> x \<in> \<aa> \<and> y \<in> \<bb>"
     by simp (metis ideal.ideal(1) ideal_implies_subset multiplicative.associative subset_iff)
   then show ?case
     using additive.generate.incl incl.hyps incl.prems by force
 next
   case (inv u v)
   then show ?case
   proof clarsimp
     fix a b
     assume "v \<in> R" "a \<cdot> b \<in> R" "a \<in> \<aa>" "b \<in> \<bb>"
     then have "v \<cdot> (- a \<cdot> b) = v \<cdot> a \<cdot> (- b) \<and> v \<cdot> a \<in> \<aa> \<and> - b \<in> \<bb>"
       by (metis \<aa> \<bb> ideal.ideal(1) ideal_implies_subset ideal_inverse in_mono local.right_minus multiplicative.associative)
     then show "v \<cdot> (- a \<cdot> b) \<in> additive.generate (R \<inter> {a \<cdot> b |a b. a \<in> \<aa> \<and> b \<in> \<bb>})"
       using \<aa> \<bb> additive.subgroup_generated_def ideal_mult_in_subgroup_generated
       unfolding ideal_gen_by_prod_def
       by presburger
   qed
 next
   case (mult u v)
   then show ?case
     using additive.generate.mult additive.generate_into_G distributive(1) by force
 qed
 
 (* ex. 0.12 *)
 lemma ideal_subgroup_generated:
   assumes "ideal \<aa> R (+) (\<cdot>) \<zero> \<one>" and "ideal \<bb> R (+) (\<cdot>) \<zero> \<one>"
   shows "ideal (ideal_gen_by_prod \<aa> \<bb>) R (+) (\<cdot>) \<zero> \<one>"
   proof
   show "ideal_gen_by_prod \<aa> \<bb> \<subseteq> R"
     by (simp add: additive.subgroup_generated_is_subset ideal_gen_by_prod_def)
   show "a + b \<in> ideal_gen_by_prod \<aa> \<bb>"
     if "a \<in> ideal_gen_by_prod \<aa> \<bb>" "b \<in> ideal_gen_by_prod \<aa> \<bb>"
     for a b
     using that additive.subgroup_generated_is_monoid monoid.composition_closed
     by (fastforce simp: ideal_gen_by_prod_def)
   show "\<zero> \<in> ideal_gen_by_prod \<aa> \<bb>"
     using additive.generate.unit additive.subgroup_generated_def ideal_gen_by_prod_def by presburger
   show "a + b + c = a + (b + c)"
     if "a \<in> ideal_gen_by_prod \<aa> \<bb>" "b \<in> ideal_gen_by_prod \<aa> \<bb>" "c \<in> ideal_gen_by_prod \<aa> \<bb>"
     for a b c
     using that additive.subgroup_generated_is_subset
     unfolding ideal_gen_by_prod_def
     by blast
   show "\<zero> + a = a" "a + \<zero> = a"
     if "a \<in> ideal_gen_by_prod \<aa> \<bb>" for a
     using that additive.subgroup_generated_is_subset unfolding ideal_gen_by_prod_def
     by blast+
   show "monoid.invertible (ideal_gen_by_prod \<aa> \<bb>) (+) \<zero> u"
     if "u \<in> ideal_gen_by_prod \<aa> \<bb>" for u
     using that additive.subgroup_generated_is_subgroup group.invertible
     unfolding ideal_gen_by_prod_def subgroup_def
     by fastforce
   show "a \<cdot> b \<in> ideal_gen_by_prod \<aa> \<bb>"
     if "a \<in> R" "b \<in> ideal_gen_by_prod \<aa> \<bb>" for a b
     using that by (simp add: assms in_ideal_gen_by_prod)
   then show "b \<cdot> a \<in> ideal_gen_by_prod \<aa> \<bb>"
     if "a \<in> R" "b \<in> ideal_gen_by_prod \<aa> \<bb>" for a b
     using that
     by (metis \<open>ideal_gen_by_prod \<aa> \<bb> \<subseteq> R\<close> comm_mult in_mono)
 qed
 
 lemma ideal_gen_by_prod_is_inter:
   assumes "ideal \<aa> R (+) (\<cdot>) \<zero> \<one>" and "ideal \<bb> R (+) (\<cdot>) \<zero> \<one>"
   shows "ideal_gen_by_prod \<aa> \<bb> = \<Inter> {I. ideal I R (+) (\<cdot>) \<zero> \<one> \<and> {a \<cdot> b |a b. a \<in> \<aa> \<and> b \<in> \<bb>} \<subseteq> I}"
     (is "?lhs = ?rhs")
 proof
   have "x \<in> ?rhs" if "x \<in> ?lhs" for x
     using that
     unfolding ideal_gen_by_prod_def additive.subgroup_generated_def
     by induction (force simp: ideal_zero ideal_inverse ideal_add)+
   then show "?lhs \<subseteq> ?rhs" by blast
   show "?rhs \<subseteq> ?lhs"
     using assms ideal_subgroup_generated by (force simp: ideal_mult_in_subgroup_generated)
 qed
 
 end (* comm_ring *)
 
 text \<open>def. 0.18, see remark 0.20\<close>
 locale pr_ideal = comm:comm_ring R "(+)" "(\<cdot>)" "\<zero>" "\<one>" + ideal I R "(+)" "(\<cdot>)" "\<zero>" "\<one>"
   for R and I and addition (infixl "+" 65) and multiplication (infixl "\<cdot>" 70) and zero ("\<zero>") and
 unit ("\<one>")
 + assumes carrier_neq: "I \<noteq> R" and absorbent: "\<lbrakk>x \<in> R; y \<in> R\<rbrakk> \<Longrightarrow> (x \<cdot> y \<in> I) \<Longrightarrow> (x \<in> I \<or> y \<in> I)"
 begin
 
 text \<open>
 Note that in the locale prime ideal the order of I and R is reversed with respect to the locale
 ideal, so that we can introduce some syntactic sugar later.
 \<close>
 
 text \<open>remark 0.21\<close>
 lemma not_1 [simp]:
   shows "\<one> \<notin> I"
 proof
   assume "\<one> \<in> I"
   then have "\<And>x. \<lbrakk>\<one> \<in> I; x \<in> R\<rbrakk> \<Longrightarrow> x \<in> I"
     by (metis ideal(1) comm.multiplicative.right_unit)
   with \<open>\<one> \<in> I\<close> have "I = R"
     by auto
   then show False
     using carrier_neq by blast
 qed
 
 lemma not_invertible:
   assumes "x \<in> I"
   shows "\<not> comm.multiplicative.invertible x"
   using assms ideal(2) not_1 by blast
 
 text \<open>ex. 0.22\<close>
 lemma submonoid_notin:
   assumes "S = {x \<in> R. x \<notin> I}"
   shows "submonoid S R (\<cdot>) \<one>"
 proof
   show "S \<subseteq> R"
     using assms by force
   show "a \<cdot> b \<in> S"
     if "a \<in> S"
       and "b \<in> S"
     for a :: 'a
       and b :: 'a
     using that
     using absorbent assms by blast
   show "\<one> \<in> S"
     using assms carrier_neq ideal(1) by fastforce
 qed
 
 end (* pr_ideal *)
 
 
 section \<open>Spectrum of a ring\<close>
 
 subsection \<open>The Zariski Topology\<close>
 
 context comm_ring begin
 
 text \<open>Notation 1\<close>
 definition closed_subsets :: "'a set \<Rightarrow> ('a set) set" ("\<V> _" [900] 900)
   where "\<V> \<aa> \<equiv> {I. pr_ideal R I (+) (\<cdot>) \<zero> \<one> \<and> \<aa> \<subseteq> I}"
 
 text \<open>Notation 2\<close>
 definition spectrum :: "('a set) set" ("Spec")
   where "Spec \<equiv> {I. pr_ideal R I (+) (\<cdot>) \<zero> \<one>}"
 
 lemma cring0_spectrum_eq [simp]: "cring0.spectrum = {}"
   unfolding cring0.spectrum_def pr_ideal_def
   by (metis (no_types, lifting) Collect_empty_eq cring0.ideal_zero pr_ideal.intro pr_ideal.not_1)
 
 text \<open>remark 0.11\<close>
 lemma closed_subsets_R [simp]:
   shows "\<V> R = {}"
   using ideal_implies_subset
   by (auto simp: closed_subsets_def pr_ideal_axioms_def pr_ideal_def)
 
 lemma closed_subsets_zero [simp]:
   shows "\<V> {\<zero>} = Spec"
   unfolding closed_subsets_def spectrum_def pr_ideal_def pr_ideal_axioms_def
   by (auto dest: ideal_zero)
 
 lemma closed_subsets_ideal_aux:
   assumes \<aa>: "ideal \<aa> R (+) (\<cdot>) \<zero> \<one>" and \<bb>: "ideal \<bb> R (+) (\<cdot>) \<zero> \<one>"
       and prime: "pr_ideal R x (+) (\<cdot>) \<zero> \<one>" and disj: "\<aa> \<subseteq> x \<or> \<bb> \<subseteq> x"
   shows "ideal_gen_by_prod \<aa> \<bb> \<subseteq> x"
   unfolding ideal_gen_by_prod_def additive.subgroup_generated_def
 proof
   fix u
   assume u: "u \<in> additive.generate (R \<inter> {a \<cdot> b |a b. a \<in> \<aa> \<and> b \<in> \<bb>})"
   have "\<aa> \<subseteq> R" "\<bb> \<subseteq> R"
     using \<aa> \<bb> ideal_implies_subset by auto
   show "u \<in> x" using u
   proof induction
     case unit
     then show ?case
       by (meson comm_ring.ideal_zero prime pr_ideal_def)
   next
     case (incl a)
     then have "a \<in> R"
       by blast
     with incl pr_ideal.axioms [OF prime] show ?case
       by clarsimp (metis \<open>\<aa> \<subseteq> R\<close> \<open>\<bb> \<subseteq> R\<close> disj ideal.ideal subset_iff)
   next
     case (inv a)
     then have "a \<in> R"
       by blast
     with inv pr_ideal.axioms [OF prime] show ?case
       by clarsimp (metis \<open>\<aa> \<subseteq> R\<close> \<open>\<bb> \<subseteq> R\<close> disj ideal.ideal ideal_inverse subset_iff)
   next
     case (mult a b)
     then show ?case
       by (meson prime comm_ring.ideal_add pr_ideal_def)
   qed
 qed
 
 
 text \<open>ex. 0.13\<close>
 lemma closed_subsets_ideal_iff:
   assumes "ideal \<aa> R (+) (\<cdot>) \<zero> \<one>" and "ideal \<bb> R (+) (\<cdot>) \<zero> \<one>"
   shows "\<V> (ideal_gen_by_prod \<aa> \<bb>) = (\<V> \<aa>) \<union> (\<V> \<bb>)" (is "?lhs = ?rhs")
 proof
   show "?lhs \<subseteq> ?rhs"
     unfolding closed_subsets_def
     by clarsimp (meson assms ideal_implies_subset ideal_mult_in_subgroup_generated in_mono pr_ideal.absorbent)
   show "?rhs \<subseteq> ?lhs"
     unfolding closed_subsets_def
     using closed_subsets_ideal_aux [OF assms] by auto
 qed
 
 abbreviation finsum:: "'b set \<Rightarrow> ('b \<Rightarrow> 'a) \<Rightarrow> 'a"
   where "finsum I f \<equiv> additive.finprod I f"
 
 lemma finsum_empty [simp]: "finsum {} f = \<zero>"
   by (simp add: additive.finprod_def)
 
 lemma finsum_insert:
   assumes "finite I" "i \<notin> I"
     and R: "f i \<in> R" "\<And>j. j \<in> I \<Longrightarrow> f j \<in> R"
   shows "finsum (insert i I) f = f i + finsum I f"
   unfolding additive.finprod_def
 proof (subst LCD.foldD_insert [where B = "insert i I"])
   show "LCD (insert i I) R ((+) \<circ> f)"
   proof
     show "((+) \<circ> f) x (((+) \<circ> f) y z) = ((+) \<circ> f) y (((+) \<circ> f) x z)"
       if "x \<in> insert i I" "y \<in> insert i I" "z \<in> R" for x y z
       using that additive.associative additive.commutative R by auto
     show "((+) \<circ> f) x y \<in> R"
       if "x \<in> insert i I" "y \<in> R" for x y
       using that R by force
   qed
 qed (use assms in auto)
 
 lemma finsum_singleton [simp]:
   assumes "f i \<in> R"
   shows "finsum {i} f = f i"
   by (metis additive.right_unit assms finite.emptyI finsum_empty finsum_insert insert_absorb insert_not_empty)
 
 
 (* ex. 0.15 *)
 lemma ex_15:
   fixes J :: "'b set" and \<aa> :: "'b \<Rightarrow> 'a set"
   assumes "J \<noteq> {}" and J: "\<And>j. j\<in>J \<Longrightarrow> ideal (\<aa> j) R (+) (\<cdot>) \<zero> \<one>"
   shows "\<V> ({x. \<exists>I f. x = finsum I f \<and> I \<subseteq> J \<and> finite I \<and> (\<forall>i. i\<in>I \<longrightarrow> f i \<in> \<aa> i)}) = (\<Inter>j\<in>J. \<V> (\<aa> j))"
   proof -
   have "y \<in> U"
     if j: "j \<in> J" "y \<in> \<aa> j"
       and "pr_ideal R U (+) (\<cdot>) \<zero> \<one>"
       and U: "{finsum I f |I f. I \<subseteq> J \<and> finite I \<and> (\<forall>i. i \<in> I \<longrightarrow> f i \<in> \<aa> i)} \<subseteq> U"
     for U j y
   proof -
     have "y \<in> R"
       using J j ideal_implies_subset by blast
     then have y: "y = finsum {j} (\<lambda>_. y)"
       by simp
     then have "y \<in> {finsum I f |I f. I \<subseteq> J \<and> finite I \<and> (\<forall>i. i \<in> I \<longrightarrow> f i \<in> \<aa> i)}"
       using that by blast
     then show ?thesis
       by (rule subsetD [OF U])
   qed
   moreover have PI: "pr_ideal R x (+) (\<cdot>) \<zero> \<one>" if "\<forall>j\<in>J. pr_ideal R x (+) (\<cdot>) \<zero> \<one> \<and> \<aa> j \<subseteq> x" for x
     using that assms(1) by fastforce
   moreover have "finsum I f \<in> U"
     if "finite I"
       and "\<forall>j\<in>J. pr_ideal R U (+) (\<cdot>) \<zero> \<one> \<and> \<aa> j \<subseteq> U"
       and "I \<subseteq> J" "\<forall>i. i \<in> I \<longrightarrow> f i \<in> \<aa> i" for U I f
     using that
   proof (induction I rule: finite_induct)
     case empty
     then show ?case
       using PI assms ideal_zero by fastforce
   next
     case (insert i I)
     then have "finsum (insert i I) f = f i + finsum I f"
       by (metis assms(2) finsum_insert ideal_implies_subset insertCI subset_iff)
     also have "... \<in> U"
       using insert by (metis ideal_add insertCI pr_ideal.axioms(2) subset_eq)
     finally show ?case .
   qed
   ultimately show ?thesis
     by (auto simp: closed_subsets_def)
 qed
 
 (* ex 0.16 *)
 definition is_zariski_open:: "'a set set \<Rightarrow> bool" where
 "is_zariski_open U \<equiv> generated_topology Spec {U. (\<exists>\<aa>. ideal \<aa> R (+) (\<cdot>) \<zero> \<one> \<and> U = Spec - \<V> \<aa>)} U"
 
 lemma is_zariski_open_empty [simp]: "is_zariski_open {}"
   using UNIV is_zariski_open_def generated_topology_is_topology topological_space.open_empty
   by simp
 
 lemma is_zariski_open_Spec [simp]: "is_zariski_open Spec"
   by (simp add: UNIV is_zariski_open_def)
 
 lemma is_zariski_open_Union [intro]:
   "(\<And>x. x \<in> F \<Longrightarrow> is_zariski_open x) \<Longrightarrow> is_zariski_open (\<Union> F)"
   by (simp add: UN is_zariski_open_def)
 
 lemma is_zariski_open_Int [simp]:
   "\<lbrakk>is_zariski_open U; is_zariski_open V\<rbrakk> \<Longrightarrow> is_zariski_open (U \<inter> V)"
   using Int is_zariski_open_def by blast
 
 lemma zariski_is_topological_space [iff]:
   shows "topological_space Spec is_zariski_open"
   unfolding is_zariski_open_def using generated_topology_is_topology
   by blast
 
 lemma zariski_open_is_subset:
   assumes "is_zariski_open U"
   shows "U \<subseteq> Spec"
   using assms zariski_is_topological_space topological_space.open_imp_subset by auto
 
 lemma cring0_is_zariski_open [simp]: "cring0.is_zariski_open = (\<lambda>U. U={})"
   using cring0.cring0_spectrum_eq cring0.is_zariski_open_empty cring0.zariski_open_is_subset by blast
 
 subsection \<open>Standard Open Sets\<close>
 
 definition standard_open:: "'a \<Rightarrow> 'a set set" ("\<D>'(_')")
   where "\<D>(x) \<equiv> (Spec \<setminus> \<V>(\<langle>x\<rangle>))"
 
 lemma standard_open_is_zariski_open:
   assumes "x \<in> R"
   shows "is_zariski_open \<D>(x)"
   unfolding is_zariski_open_def standard_open_def
   using assms gen_ideal_ideal generated_topology.simps by fastforce
 
 lemma standard_open_is_subset:
   assumes "x \<in> R"
   shows "\<D>(x) \<subseteq> Spec"
   by (simp add: assms standard_open_is_zariski_open zariski_open_is_subset)
 
 lemma belongs_standard_open_iff:
   assumes "x \<in> R" and "\<pp> \<in> Spec"
   shows "x \<notin> \<pp> \<longleftrightarrow> \<pp> \<in> \<D>(x)"
   using assms
   apply (auto simp: standard_open_def closed_subsets_def spectrum_def gen_ideal_def subset_iff)
   apply (metis pr_ideal.absorbent)
   by (meson ideal.ideal(1) pr_ideal_def)
 
 end (* comm_ring *)
 
 
 subsection \<open>Presheaves of Rings\<close>
 
 (* def 0.17 *)
 locale presheaf_of_rings = Topological_Space.topological_space
   + fixes \<FF>:: "'a set \<Rightarrow> 'b set"
   and \<rho>:: "'a set \<Rightarrow> 'a set \<Rightarrow> ('b \<Rightarrow> 'b)" and b:: "'b"
   and add_str:: "'a set \<Rightarrow> ('b \<Rightarrow> 'b \<Rightarrow> 'b)" ("+\<^bsub>_\<^esub>")
   and mult_str:: "'a set \<Rightarrow> ('b \<Rightarrow> 'b \<Rightarrow> 'b)" ("\<cdot>\<^bsub>_\<^esub>")
   and zero_str:: "'a set \<Rightarrow> 'b" ("\<zero>\<^bsub>_\<^esub>") and one_str:: "'a set \<Rightarrow> 'b" ("\<one>\<^bsub>_\<^esub>")
 assumes is_ring_morphism:
   "\<And>U V. is_open U \<Longrightarrow> is_open V \<Longrightarrow> V \<subseteq> U \<Longrightarrow> ring_homomorphism (\<rho> U V)
                                                   (\<FF> U) (+\<^bsub>U\<^esub>) (\<cdot>\<^bsub>U\<^esub>) \<zero>\<^bsub>U\<^esub> \<one>\<^bsub>U\<^esub>
                                                   (\<FF> V) (+\<^bsub>V\<^esub>) (\<cdot>\<^bsub>V\<^esub>) \<zero>\<^bsub>V\<^esub> \<one>\<^bsub>V\<^esub>"
   and ring_of_empty: "\<FF> {} = {b}"
   and identity_map [simp]: "\<And>U. is_open U \<Longrightarrow> (\<And>x. x \<in> \<FF> U \<Longrightarrow> \<rho> U U x = x)"
   and assoc_comp:
   "\<And>U V W. is_open U \<Longrightarrow> is_open V \<Longrightarrow> is_open W \<Longrightarrow> V \<subseteq> U \<Longrightarrow> W \<subseteq> V \<Longrightarrow>
 (\<And>x. x \<in> (\<FF> U) \<Longrightarrow> \<rho> U W x = (\<rho> V W \<circ> \<rho> U V) x)"
 begin
 
 lemma is_ring_from_is_homomorphism:
   shows "\<And>U. is_open U \<Longrightarrow> ring (\<FF> U) (+\<^bsub>U\<^esub>) (\<cdot>\<^bsub>U\<^esub>) \<zero>\<^bsub>U\<^esub> \<one>\<^bsub>U\<^esub>"
   using is_ring_morphism ring_homomorphism.axioms(2) by fastforce
 
 lemma is_map_from_is_homomorphism:
   assumes "is_open U" and "is_open V" and "V \<subseteq> U"
   shows "Set_Theory.map (\<rho> U V) (\<FF> U) (\<FF> V)"
   using assms by (meson is_ring_morphism ring_homomorphism.axioms(1))
 
 lemma eq_\<rho>:
   assumes "is_open U" and "is_open V" and "is_open W" and "W \<subseteq> U \<inter> V" and "s \<in> \<FF> U" and "t \<in> \<FF> V"
     and "\<rho> U W s = \<rho> V W t" and "is_open W'" and "W' \<subseteq> W"
   shows "\<rho> U W' s = \<rho> V W' t"
   by (metis Int_subset_iff assms assoc_comp comp_apply)
 
 end (* presheaf_of_rings *)
 
 locale morphism_presheaves_of_rings =
 source: presheaf_of_rings X is_open \<FF> \<rho> b add_str mult_str zero_str one_str
   + target: presheaf_of_rings X is_open \<FF>' \<rho>' b' add_str' mult_str' zero_str' one_str'
   for X and is_open
     and \<FF> and \<rho> and b and add_str ("+\<^bsub>_\<^esub>") and mult_str ("\<cdot>\<^bsub>_\<^esub>")
     and zero_str ("\<zero>\<^bsub>_\<^esub>") and one_str ("\<one>\<^bsub>_\<^esub>")
     and \<FF>' and \<rho>' and b' and add_str' ("+''\<^bsub>_\<^esub>") and mult_str' ("\<cdot>''\<^bsub>_\<^esub>")
     and zero_str' ("\<zero>''\<^bsub>_\<^esub>") and one_str' ("\<one>''\<^bsub>_\<^esub>") +
   fixes fam_morphisms:: "'a set \<Rightarrow> ('b \<Rightarrow> 'c)"
   assumes is_ring_morphism: "\<And>U. is_open U \<Longrightarrow> ring_homomorphism (fam_morphisms U)
                                                                 (\<FF> U) (+\<^bsub>U\<^esub>) (\<cdot>\<^bsub>U\<^esub>) \<zero>\<^bsub>U\<^esub> \<one>\<^bsub>U\<^esub>
                                                                 (\<FF>' U) (+'\<^bsub>U\<^esub>) (\<cdot>'\<^bsub>U\<^esub>) \<zero>'\<^bsub>U\<^esub> \<one>'\<^bsub>U\<^esub>"
     and comm_diagrams: "\<And>U V. is_open U \<Longrightarrow> is_open V \<Longrightarrow> V \<subseteq> U \<Longrightarrow>
                (\<And>x. x \<in> \<FF> U \<Longrightarrow> (\<rho>' U V \<circ> fam_morphisms U) x = (fam_morphisms V \<circ> \<rho> U V) x)"
 begin
 
 lemma fam_morphisms_are_maps:
   assumes "is_open U"
   shows "Set_Theory.map (fam_morphisms U) (\<FF> U) (\<FF>' U)"
   using assms is_ring_morphism by (simp add: ring_homomorphism_def)
 
 end (* morphism_presheaves_of_rings *)
 
 (* Identity presheaf *)
 lemma (in presheaf_of_rings) id_is_mor_pr_rngs:
   shows "morphism_presheaves_of_rings S is_open \<FF> \<rho> b add_str mult_str zero_str one_str \<FF> \<rho> b add_str mult_str zero_str one_str (\<lambda>U. identity (\<FF> U))"
 proof (intro morphism_presheaves_of_rings.intro morphism_presheaves_of_rings_axioms.intro)
   show "\<And>U. is_open U \<Longrightarrow> ring_homomorphism (identity (\<FF> U))
                                             (\<FF> U) (add_str U) (mult_str U) (zero_str U) (one_str U)
                                             (\<FF> U) (add_str U) (mult_str U) (zero_str U) (one_str U)"
     by (metis identity_map is_map_from_is_homomorphism is_ring_morphism restrict_ext restrict_on_source subset_eq)
   show "\<And>U V. \<lbrakk>is_open U; is_open V; V \<subseteq> U\<rbrakk>
            \<Longrightarrow> (\<And>x. x \<in> (\<FF> U) \<Longrightarrow> (\<rho> U V \<circ> identity (\<FF> U)) x = (identity (\<FF> V) \<circ> \<rho> U V) x)"
     using map.map_closed by (metis comp_apply is_map_from_is_homomorphism restrict_apply')
 qed (use presheaf_of_rings_axioms in auto)
 
 lemma comp_ring_morphisms:
   assumes "ring_homomorphism \<eta> A addA multA zeroA oneA B addB multB zeroB oneB"
 and "ring_homomorphism \<theta> B addB multB zeroB oneB C addC multC zeroC oneC"
 shows "ring_homomorphism (compose A \<theta> \<eta>) A addA multA zeroA oneA C addC multC zeroC oneC"
   using comp_monoid_morphisms comp_group_morphisms assms
   by (metis monoid_homomorphism_def ring_homomorphism_def)
 
 (* Composition of presheaves *)
  lemma comp_of_presheaves:
   assumes 1: "morphism_presheaves_of_rings X is_open \<FF> \<rho> b add_str mult_str zero_str one_str \<FF>' \<rho>' b' add_str' mult_str' zero_str' one_str' \<phi>"
     and 2: "morphism_presheaves_of_rings X is_open \<FF>' \<rho>' b' add_str' mult_str' zero_str' one_str' \<FF>'' \<rho>'' b'' add_str'' mult_str'' zero_str'' one_str'' \<phi>'"
   shows "morphism_presheaves_of_rings X is_open \<FF> \<rho> b add_str mult_str zero_str one_str \<FF>'' \<rho>'' b'' add_str'' mult_str'' zero_str'' one_str'' (\<lambda>U. (\<phi>' U \<circ> \<phi> U \<down> \<FF> U))"
 proof (intro morphism_presheaves_of_rings.intro morphism_presheaves_of_rings_axioms.intro)
   show "ring_homomorphism (\<phi>' U \<circ> \<phi> U \<down> \<FF> U) (\<FF> U) (add_str U) (mult_str U) (zero_str U) (one_str U) (\<FF>'' U) (add_str'' U) (mult_str'' U) (zero_str'' U) (one_str'' U)"
     if "is_open U"
     for U :: "'a set"
     using that
     by (metis assms comp_ring_morphisms morphism_presheaves_of_rings.is_ring_morphism)
 next
   show "\<And>x. x \<in> (\<FF> U) \<Longrightarrow> (\<rho>'' U V \<circ> (\<phi>' U \<circ> \<phi> U \<down> \<FF> U)) x = (\<phi>' V \<circ> \<phi> V \<down> \<FF> V \<circ> \<rho> U V) x"
     if "is_open U" "is_open V" "V \<subseteq> U" for U V
     using that
     using morphism_presheaves_of_rings.comm_diagrams [OF 1]
     using morphism_presheaves_of_rings.comm_diagrams [OF 2]
     using presheaf_of_rings.is_map_from_is_homomorphism [OF morphism_presheaves_of_rings.axioms(1) [OF 1]]
     by (metis "1" comp_apply compose_eq map.map_closed morphism_presheaves_of_rings.fam_morphisms_are_maps)
 qed (use assms in \<open>auto simp: morphism_presheaves_of_rings_def\<close>)
 
 locale iso_presheaves_of_rings = mor:morphism_presheaves_of_rings
 + assumes is_inv:
 "\<exists>\<psi>. morphism_presheaves_of_rings X is_open \<FF>' \<rho>' b' add_str' mult_str' zero_str' one_str' \<FF> \<rho> b add_str mult_str zero_str one_str \<psi>
 \<and> (\<forall>U. is_open U \<longrightarrow> (\<forall>x \<in> (\<FF>' U). (fam_morphisms U \<circ> \<psi> U) x = x) \<and> (\<forall>x \<in> (\<FF> U). (\<psi> U \<circ> fam_morphisms U) x = x))"
 
 
 subsection \<open>Sheaves of Rings\<close>
 
 (* def 0.19 *)
 locale sheaf_of_rings = presheaf_of_rings +
   assumes locality: "\<And>U I V s. open_cover_of_open_subset S is_open U I V \<Longrightarrow> (\<And>i. i\<in>I \<Longrightarrow> V i \<subseteq> U) \<Longrightarrow>
 s \<in> \<FF> U \<Longrightarrow> (\<And>i. i\<in>I \<Longrightarrow> \<rho> U (V i) s = \<zero>\<^bsub>(V i)\<^esub>) \<Longrightarrow> s = \<zero>\<^bsub>U\<^esub>"
 and
 glueing: "\<And>U I V s. open_cover_of_open_subset S is_open U I V \<Longrightarrow> (\<forall>i. i\<in>I \<longrightarrow> V i \<subseteq> U \<and> s i \<in> \<FF> (V i)) \<Longrightarrow>
 (\<And>i j. i\<in>I \<Longrightarrow> j\<in>I \<Longrightarrow> \<rho> (V i) (V i \<inter> V j) (s i) = \<rho> (V j) (V i \<inter> V j) (s j)) \<Longrightarrow>
 (\<exists>t. t \<in> \<FF> U \<and> (\<forall>i. i\<in>I \<longrightarrow> \<rho> U (V i) t = s i))"
 
 (* def. 0.20 *)
 locale morphism_sheaves_of_rings = morphism_presheaves_of_rings
 
 locale iso_sheaves_of_rings = iso_presheaves_of_rings
 
 (* ex. 0.21 *)
 locale ind_sheaf = sheaf_of_rings +
   fixes U:: "'a set"
   assumes is_open_subset: "is_open U"
 begin
 
 interpretation it: ind_topology S is_open U
   by (simp add: ind_topology.intro ind_topology_axioms.intro is_open_subset open_imp_subset topological_space_axioms)
 
 definition ind_sheaf:: "'a set \<Rightarrow> 'b set"
   where "ind_sheaf V \<equiv> \<FF> (U \<inter> V)"
 
 definition ind_ring_morphisms:: "'a set \<Rightarrow> 'a set \<Rightarrow> ('b \<Rightarrow> 'b)"
   where "ind_ring_morphisms V W \<equiv> \<rho> (U \<inter> V) (U \<inter> W)"
 
 definition ind_add_str:: "'a set \<Rightarrow> ('b \<Rightarrow> 'b \<Rightarrow> 'b)"
   where "ind_add_str V \<equiv> \<lambda>x y. +\<^bsub>(U \<inter> V)\<^esub> x y"
 
 definition ind_mult_str:: "'a set \<Rightarrow> ('b \<Rightarrow> 'b \<Rightarrow> 'b)"
   where "ind_mult_str V \<equiv> \<lambda>x y. \<cdot>\<^bsub>(U \<inter> V)\<^esub> x y"
 
 definition ind_zero_str:: "'a set \<Rightarrow> 'b"
   where "ind_zero_str V \<equiv> \<zero>\<^bsub>(U\<inter>V)\<^esub>"
 
 definition ind_one_str:: "'a set \<Rightarrow> 'b"
   where "ind_one_str V \<equiv> \<one>\<^bsub>(U\<inter>V)\<^esub>"
 
 lemma ind_is_open_imp_ring:
   "\<And>U. it.ind_is_open U
    \<Longrightarrow> ring (ind_sheaf U) (ind_add_str U) (ind_mult_str U) (ind_zero_str U) (ind_one_str U)"
   unfolding ind_add_str_def it.ind_is_open_def ind_mult_str_def ind_one_str_def ind_sheaf_def ind_zero_str_def 
   using is_open_subset is_ring_from_is_homomorphism it.is_subset open_inter by force
 
 lemma ind_sheaf_is_presheaf:
   shows "presheaf_of_rings U (it.ind_is_open) ind_sheaf ind_ring_morphisms b
 ind_add_str ind_mult_str ind_zero_str ind_one_str"
 proof -
   have "topological_space U it.ind_is_open" by (simp add: it.ind_space_is_top_space)
   moreover have "ring_homomorphism (ind_ring_morphisms W V)
                      (ind_sheaf W) (ind_add_str W) (ind_mult_str W) (ind_zero_str W) (ind_one_str W)
                      (ind_sheaf V) (ind_add_str V) (ind_mult_str V) (ind_zero_str V) (ind_one_str V)"
     if "it.ind_is_open W" "it.ind_is_open V" "V \<subseteq> W" for W V
   proof (intro ring_homomorphism.intro ind_is_open_imp_ring)
     show "Set_Theory.map (ind_ring_morphisms W V) (ind_sheaf W) (ind_sheaf V)"
       unfolding ind_ring_morphisms_def ind_sheaf_def
       by (metis that it.ind_is_open_def inf.left_idem is_open_subset is_ring_morphism 
           open_inter ring_homomorphism_def)
     from that
     obtain o: "is_open (U \<inter> V)" "is_open (U \<inter> W)" "U \<inter> V \<subseteq> U \<inter> W"
       by (metis (no_types) it.ind_is_open_def inf.absorb_iff2 is_open_subset open_inter)
     then show "group_homomorphism (ind_ring_morphisms W V) (ind_sheaf W) (ind_add_str W) (ind_zero_str W) (ind_sheaf V) (ind_add_str V) (ind_zero_str V)"
       unfolding ind_ring_morphisms_def ind_sheaf_def ind_zero_str_def
       by (metis ind_sheaf.ind_add_str_def ind_sheaf_axioms is_ring_morphism ring_homomorphism.axioms(4))
     show "monoid_homomorphism (ind_ring_morphisms W V) (ind_sheaf W) (ind_mult_str W) (ind_one_str W) (ind_sheaf V) (ind_mult_str V) (ind_one_str V)"
       using o by (metis ind_mult_str_def ind_one_str_def ind_ring_morphisms_def ind_sheaf_def is_ring_morphism ring_homomorphism_def)
   qed (use that in auto)
   moreover have "ind_sheaf {} = {b}"
     by (simp add: ring_of_empty ind_sheaf_def)
   moreover have "\<And>U. it.ind_is_open U \<Longrightarrow> (\<And>x. x \<in> (ind_sheaf U) \<Longrightarrow> ind_ring_morphisms U U x = x)"
     by (simp add: Int_absorb1 it.ind_is_open_def ind_ring_morphisms_def ind_sheaf_def it.is_open_from_ind_is_open is_open_subset)
   moreover have "\<And>U V W. it.ind_is_open U \<Longrightarrow> it.ind_is_open V \<Longrightarrow> it.ind_is_open W \<Longrightarrow> V \<subseteq> U \<Longrightarrow> W \<subseteq> V
              \<Longrightarrow> (\<And>x. x \<in> (ind_sheaf U) \<Longrightarrow> ind_ring_morphisms U W x = (ind_ring_morphisms V W \<circ> ind_ring_morphisms U V) x)"
     by (metis Int_absorb1 assoc_comp it.ind_is_open_def ind_ring_morphisms_def ind_sheaf_def it.is_open_from_ind_is_open is_open_subset)
   ultimately show ?thesis
     unfolding presheaf_of_rings_def presheaf_of_rings_axioms_def by blast
 qed
 
 lemma ind_sheaf_is_sheaf:
   shows "sheaf_of_rings U it.ind_is_open ind_sheaf ind_ring_morphisms b ind_add_str ind_mult_str ind_zero_str ind_one_str"
 proof (intro sheaf_of_rings.intro sheaf_of_rings_axioms.intro)
   show "presheaf_of_rings U it.ind_is_open ind_sheaf ind_ring_morphisms b ind_add_str ind_mult_str ind_zero_str ind_one_str"
     using ind_sheaf_is_presheaf by blast
 next
   fix V I W s
   assume oc: "open_cover_of_open_subset U it.ind_is_open V I W"
     and WV: "\<And>i. i \<in> I \<Longrightarrow> W i \<subseteq> V"
     and s: "s \<in> ind_sheaf V"
     and eq: "\<And>i. i \<in> I \<Longrightarrow> ind_ring_morphisms V (W i) s = ind_zero_str (W i)"
   have "it.ind_is_open V"
     using oc open_cover_of_open_subset.is_open_subset by blast
   then have "s \<in> \<FF> V"
     by (metis ind_sheaf.ind_sheaf_def ind_sheaf_axioms it.ind_is_open_def inf.absorb2 s)
   then have "s = \<zero>\<^bsub>V\<^esub>"
     by (metis Int_absorb1 Int_subset_iff WV ind_sheaf.ind_zero_str_def ind_sheaf_axioms eq it.ind_is_open_def ind_ring_morphisms_def is_open_subset locality oc it.open_cover_from_ind_open_cover open_cover_of_open_subset.is_open_subset)
   then show "s = ind_zero_str V"
     by (metis Int_absorb1 it.ind_is_open_def ind_zero_str_def oc open_cover_of_open_subset.is_open_subset)
 next
   fix V I W s
   assume oc: "open_cover_of_open_subset U it.ind_is_open V I W"
     and WV: "\<forall>i. i \<in> I \<longrightarrow> W i \<subseteq> V \<and> s i \<in> ind_sheaf (W i)"
     and eq: "\<And>i j. \<lbrakk>i \<in> I; j \<in> I\<rbrakk> \<Longrightarrow> ind_ring_morphisms (W i) (W i \<inter> W j) (s i) = ind_ring_morphisms (W j) (W i \<inter> W j) (s j)"
   have "is_open V"
     using it.is_open_from_ind_is_open is_open_subset oc open_cover_of_open_subset.is_open_subset by blast
   moreover have "open_cover_of_open_subset S is_open V I W"
     using it.open_cover_from_ind_open_cover oc ind_topology.intro ind_topology_axioms_def is_open_subset it.is_subset topological_space_axioms by blast
   moreover have "\<rho> (W i) (W i \<inter> W j) (s i) = \<rho> (W j) (W i \<inter> W j) (s j)"
     if "i\<in>I" "j\<in>I" for i j
   proof -
     have "U \<inter> W i = W i" and "U \<inter> W j = W j"
       by (metis Int_absorb1 WV it.ind_is_open_def oc open_cover_of_open_subset.is_open_subset
             subset_trans that)+
     then show ?thesis
       using eq[unfolded ind_ring_morphisms_def,OF that] by (metis inf_sup_aci(2))
   qed
   moreover have "\<forall>i. i\<in>I \<longrightarrow> W i \<subseteq> V \<and> s i \<in> \<FF> (W i)"
     by (metis WV it.ind_is_open_def ind_sheaf_def inf.orderE inf_idem inf_aci(3) oc open_cover_of_open_subset.is_open_subset)
   ultimately
   obtain t where "t \<in> (\<FF> V) \<and> (\<forall>i. i\<in>I \<longrightarrow> \<rho> V (W i) t = s i)"
     using glueing by blast
   then have "t \<in> ind_sheaf V"
     unfolding ind_sheaf_def using oc
     by (metis Int_absorb1 cover_of_subset_def open_cover_of_open_subset_def open_cover_of_subset_def)
   moreover have "\<forall>i. i\<in>I \<longrightarrow> ind_ring_morphisms V (W i) t = s i"
     unfolding ind_ring_morphisms_def
     by (metis oc Int_absorb1 \<open>t \<in> \<FF> V \<and> (\<forall>i. i \<in> I \<longrightarrow> \<rho> V (W i) t = s i)\<close> cover_of_subset_def open_cover_of_open_subset_def open_cover_of_subset_def)
   ultimately show "\<exists>t. t \<in> (ind_sheaf V) \<and> (\<forall>i. i\<in>I \<longrightarrow> ind_ring_morphisms V (W i) t = s i)" by blast
 qed
 
 end (* ind_sheaf *)
 
 (* construction 0.22 *)
 locale im_sheaf = sheaf_of_rings + continuous_map
 begin
 
 (* def 0.24 *)
 definition im_sheaf:: "'c set => 'b set"
   where "im_sheaf V \<equiv> \<FF> (f\<^sup>\<inverse> S V)"
 
 definition im_sheaf_morphisms:: "'c set \<Rightarrow> 'c set \<Rightarrow> ('b \<Rightarrow> 'b)"
   where "im_sheaf_morphisms U V \<equiv> \<rho> (f\<^sup>\<inverse> S U) (f\<^sup>\<inverse> S V)"
 
 definition add_im_sheaf:: "'c set \<Rightarrow> 'b \<Rightarrow> 'b \<Rightarrow> 'b"
   where "add_im_sheaf \<equiv> \<lambda>V x y. +\<^bsub>(f\<^sup>\<inverse> S V)\<^esub> x y"
 
 definition mult_im_sheaf:: "'c set \<Rightarrow> 'b \<Rightarrow> 'b \<Rightarrow> 'b"
   where "mult_im_sheaf \<equiv> \<lambda>V x y. \<cdot>\<^bsub>(f\<^sup>\<inverse> S V)\<^esub> x y"
 
 definition zero_im_sheaf:: "'c set \<Rightarrow> 'b"
   where "zero_im_sheaf \<equiv> \<lambda>V. \<zero>\<^bsub>(f\<^sup>\<inverse> S V)\<^esub>"
 
 definition one_im_sheaf:: "'c set \<Rightarrow> 'b"
   where "one_im_sheaf \<equiv> \<lambda>V. \<one>\<^bsub>(f\<^sup>\<inverse> S V)\<^esub>"
 
 lemma im_sheaf_is_presheaf:
   "presheaf_of_rings S' (is_open') im_sheaf im_sheaf_morphisms b
 add_im_sheaf mult_im_sheaf zero_im_sheaf one_im_sheaf"
 proof (intro presheaf_of_rings.intro presheaf_of_rings_axioms.intro)
   show "topological_space S' is_open'"
     by (simp add: target.topological_space_axioms)
   show "\<And>U V. \<lbrakk>is_open' U; is_open' V; V \<subseteq> U\<rbrakk>
            \<Longrightarrow> ring_homomorphism (im_sheaf_morphisms U V)
 (im_sheaf U) (add_im_sheaf U) (mult_im_sheaf U) (zero_im_sheaf U) (one_im_sheaf U)
 (im_sheaf V) (add_im_sheaf V) (mult_im_sheaf V) (zero_im_sheaf V) (one_im_sheaf V)"
     unfolding add_im_sheaf_def mult_im_sheaf_def zero_im_sheaf_def one_im_sheaf_def
     by (metis Int_commute Int_mono im_sheaf_def im_sheaf_morphisms_def is_continuous is_ring_morphism subset_refl vimage_mono)
   show "im_sheaf {} = {b}" using im_sheaf_def ring_of_empty by simp
   show "\<And>U. is_open' U \<Longrightarrow> (\<And>x. x \<in> (im_sheaf U) \<Longrightarrow> im_sheaf_morphisms U U x = x)"
     using im_sheaf_morphisms_def by (simp add: im_sheaf_def is_continuous)
   show "\<And>U V W.
        \<lbrakk>is_open' U; is_open' V; is_open' W; V \<subseteq> U; W \<subseteq> V\<rbrakk>
        \<Longrightarrow> (\<And>x. x \<in> (im_sheaf U) \<Longrightarrow> im_sheaf_morphisms U W x = (im_sheaf_morphisms V W \<circ> im_sheaf_morphisms U V) x)"
     by (metis Int_mono assoc_comp im_sheaf_def im_sheaf_morphisms_def ind_topology.is_subset is_continuous ind_topology_is_open_self vimage_mono)
 qed
 
 (* ex 0.23 *)
 lemma im_sheaf_is_sheaf:
   shows "sheaf_of_rings S' (is_open') im_sheaf im_sheaf_morphisms b
 add_im_sheaf mult_im_sheaf zero_im_sheaf one_im_sheaf"
 proof (intro sheaf_of_rings.intro sheaf_of_rings_axioms.intro)
   show "presheaf_of_rings S' is_open' im_sheaf im_sheaf_morphisms b
 add_im_sheaf mult_im_sheaf zero_im_sheaf one_im_sheaf"
     using im_sheaf_is_presheaf by force
 next
   fix U I V s
   assume oc: "open_cover_of_open_subset S' is_open' U I V"
     and VU: "\<And>i. i \<in> I \<Longrightarrow> V i \<subseteq> U"
     and s: "s \<in> im_sheaf U"
     and eq0: "\<And>i. i \<in> I \<Longrightarrow> im_sheaf_morphisms U (V i) s =zero_im_sheaf (V i)"
   have "open_cover_of_open_subset S is_open (f\<^sup>\<inverse> S U) I (\<lambda>i. f\<^sup>\<inverse> S (V i))"
     by (simp add: oc open_cover_of_open_subset_from_target_to_source)
   then show "s = zero_im_sheaf U" using zero_im_sheaf_def
     by (smt VU im_sheaf_def im_sheaf_morphisms_def eq0 inf.absorb_iff2 inf_le2 inf_sup_aci(1) inf_sup_aci(3) locality s vimage_Int)
 next
   fix U I V s
   assume oc: "open_cover_of_open_subset S' is_open' U I V"
     and VU: "\<forall>i. i \<in> I \<longrightarrow> V i \<subseteq> U \<and> s i \<in> im_sheaf (V i)"
     and eq: "\<And>i j. \<lbrakk>i \<in> I; j \<in> I\<rbrakk> \<Longrightarrow> im_sheaf_morphisms (V i) (V i \<inter> V j) (s i) = im_sheaf_morphisms (V j) (V i \<inter> V j) (s j)"
   have "\<exists>t. t \<in> \<FF> (f  \<^sup>\<inverse> S U) \<and> (\<forall>i. i \<in> I \<longrightarrow> \<rho> (f  \<^sup>\<inverse> S U) (f  \<^sup>\<inverse> S (V i)) t = s i)"
   proof (rule glueing)
     show "open_cover_of_open_subset S is_open (f \<^sup>\<inverse> S U) I (\<lambda>i. f \<^sup>\<inverse> S (V i))"
       using oc open_cover_of_open_subset_from_target_to_source by presburger
     show "\<forall>i. i \<in> I \<longrightarrow> f \<^sup>\<inverse> S (V i) \<subseteq> f \<^sup>\<inverse> S U \<and> s i \<in> \<FF> (f \<^sup>\<inverse> S (V i))"
       using VU im_sheaf_def by blast
     show "\<rho> (f \<^sup>\<inverse> S (V i)) (f \<^sup>\<inverse> S (V i) \<inter> f \<^sup>\<inverse> S (V j)) (s i) = \<rho> (f \<^sup>\<inverse> S (V j)) (f \<^sup>\<inverse> S (V i) \<inter> f \<^sup>\<inverse> S (V j)) (s j)"
       if "i \<in> I" "j \<in> I" for i j
       using im_sheaf_morphisms_def eq that
       by (smt Int_commute Int_left_commute inf.left_idem vimage_Int)
   qed
   then obtain t where "t \<in> \<FF> (f\<^sup>\<inverse> S U) \<and> (\<forall>i. i\<in>I \<longrightarrow> \<rho> (f\<^sup>\<inverse> S U) (f\<^sup>\<inverse> S (V i)) t = s i)" ..
   then show "\<exists>t. t \<in> im_sheaf U \<and> (\<forall>i. i \<in> I \<longrightarrow> im_sheaf_morphisms U (V i) t = s i)"
     using im_sheaf_def im_sheaf_morphisms_def by auto
 qed
 
 sublocale sheaf_of_rings S' is_open' im_sheaf im_sheaf_morphisms b
     add_im_sheaf mult_im_sheaf zero_im_sheaf one_im_sheaf
   using im_sheaf_is_sheaf .
 
 end (* im_sheaf *)
 
 lemma (in sheaf_of_rings) id_to_iso_of_sheaves:
   shows "iso_sheaves_of_rings S is_open \<FF> \<rho> b add_str mult_str zero_str one_str
             (im_sheaf.im_sheaf S \<FF> (identity S))
             (im_sheaf.im_sheaf_morphisms S \<rho> (identity S))
             b
             (\<lambda>V. +\<^bsub>identity S \<^sup>\<inverse> S V\<^esub>) (\<lambda>V. \<cdot>\<^bsub>identity S \<^sup>\<inverse> S V\<^esub>) (\<lambda>V. \<zero>\<^bsub>identity S \<^sup>\<inverse> S V\<^esub>) (\<lambda>V. \<one>\<^bsub>identity S \<^sup>\<inverse> S V\<^esub>) (\<lambda>U. identity (\<FF> U))"
     (is "iso_sheaves_of_rings S is_open \<FF> \<rho> b _ _ _ _ _ _ b  ?add ?mult ?zero ?one ?F")
 proof-
   have preq[simp]: "\<And>V. V \<subseteq> S \<Longrightarrow> (identity S \<^sup>\<inverse> S V) = V"
     by auto
   interpret id: im_sheaf S is_open \<FF> \<rho> b add_str mult_str zero_str one_str S is_open "identity S"
     by intro_locales (auto simp add: Set_Theory.map_def continuous_map_axioms_def open_imp_subset)
   have 1[simp]: "\<And>V. V \<subseteq> S \<Longrightarrow> im_sheaf.im_sheaf S \<FF> (identity S) V = \<FF> V"
     by (simp add: id.im_sheaf_def)
   have 2[simp]: "\<And>U V. \<lbrakk>U \<subseteq> S; V \<subseteq> S\<rbrakk> \<Longrightarrow> im_sheaf.im_sheaf_morphisms S \<rho> (identity S) U V \<equiv> \<rho> U V"
     using id.im_sheaf_morphisms_def by auto
   show ?thesis
   proof intro_locales
     have rh: "\<And>U. is_open U \<Longrightarrow>
          ring_homomorphism (identity (\<FF> U)) (\<FF> U) +\<^bsub>U\<^esub> \<cdot>\<^bsub>U\<^esub> \<zero>\<^bsub>U\<^esub> \<one>\<^bsub>U\<^esub> (\<FF> U) +\<^bsub>U\<^esub> \<cdot>\<^bsub>U\<^esub> \<zero>\<^bsub>U\<^esub> \<one>\<^bsub>U\<^esub>"
       using id_is_mor_pr_rngs morphism_presheaves_of_rings.is_ring_morphism by fastforce
     show "morphism_presheaves_of_rings_axioms is_open \<FF> \<rho> add_str mult_str zero_str one_str
            id.im_sheaf id.im_sheaf_morphisms ?add ?mult ?zero ?one ?F"
       unfolding morphism_presheaves_of_rings_axioms_def
       by (auto simp: rh open_imp_subset intro: is_map_from_is_homomorphism map.map_closed)
     have \<rho>: "\<And>U V W x. \<lbrakk>is_open U; is_open V; is_open W; V \<subseteq> U; W \<subseteq> V; x \<in> \<FF> U\<rbrakk> \<Longrightarrow> \<rho> V W (\<rho> U V x) = \<rho> U W x"
       by (metis assoc_comp comp_def)
     show "presheaf_of_rings_axioms is_open id.im_sheaf id.im_sheaf_morphisms b ?add ?mult ?zero ?one"
       by (auto simp: \<rho> presheaf_of_rings_axioms_def is_ring_morphism open_imp_subset ring_of_empty)
     then have "presheaf_of_rings S is_open id.im_sheaf id.im_sheaf_morphisms b ?add ?mult ?zero ?one"
       by (metis id.im_sheaf_is_presheaf presheaf_of_rings_def)
     moreover
     have "morphism_presheaves_of_rings_axioms is_open
           id.im_sheaf id.im_sheaf_morphisms ?add ?mult ?zero ?one \<FF> \<rho> add_str
           mult_str zero_str one_str (\<lambda>U. \<lambda>x\<in>\<FF> U. x)"
       unfolding morphism_presheaves_of_rings_axioms_def
       by (auto simp: rh open_imp_subset intro: is_map_from_is_homomorphism map.map_closed)
     ultimately
     show "iso_presheaves_of_rings_axioms S is_open \<FF> \<rho> b add_str mult_str zero_str one_str
             id.im_sheaf id.im_sheaf_morphisms b ?add ?mult ?zero ?one ?F"
       by (auto simp: presheaf_of_rings_axioms iso_presheaves_of_rings_axioms_def morphism_presheaves_of_rings_def open_imp_subset)
   qed
 qed
 
 
 subsection \<open>Quotient Ring\<close>
 
 (*Probably for Group_Theory*)
 context group begin
 
 lemma cancel_imp_equal:
   "\<lbrakk> u \<cdot> inverse v = \<one>;  u \<in> G; v \<in> G \<rbrakk> \<Longrightarrow> u = v"
   by (metis invertible invertible_inverse_closed invertible_right_cancel invertible_right_inverse)
 
 end
 
 (*Probably for Ring_Theory*)
 context ring begin
 
 lemma inverse_distributive: "\<lbrakk> a \<in> R; b \<in> R; c \<in> R \<rbrakk> \<Longrightarrow> a \<cdot> (b - c) = a \<cdot> b - a \<cdot> c"
     "\<lbrakk> a \<in> R; b \<in> R; c \<in> R \<rbrakk> \<Longrightarrow> (b - c) \<cdot> a = b \<cdot> a - c \<cdot> a"
   using additive.invertible additive.invertible_inverse_closed distributive
         local.left_minus local.right_minus by presburger+
 
 end
 
 locale quotient_ring = comm:comm_ring R "(+)" "(\<cdot>)" "\<zero>" "\<one>" + submonoid S R "(\<cdot>)" "\<one>"
   for S and R and addition (infixl "+" 65) and multiplication (infixl "\<cdot>" 70) and zero ("\<zero>") and
 unit ("\<one>")
 begin
 
 lemmas comm_ring_simps =
   comm.multiplicative.associative
   comm.additive.associative
   comm.comm_mult
   comm.additive.commutative
   right_minus
 
 definition rel:: "('a \<times> 'a) \<Rightarrow> ('a \<times> 'a) \<Rightarrow> bool" (infix "\<sim>" 80)
   where "x \<sim> y \<equiv> \<exists>s1. s1 \<in> S \<and> s1 \<cdot> (snd y \<cdot> fst x - snd x \<cdot> fst y) = \<zero>"
 
 lemma rel_refl: "\<And>x. x \<in> R \<times> S \<Longrightarrow> x \<sim> x"
     by (auto simp: rel_def)
 
 lemma rel_sym:
   assumes "x \<sim> y" "x \<in> R \<times> S" "y \<in> R \<times> S" shows "y \<sim> x"
 proof -
   obtain rx sx ry sy s
     where \<section>: "rx \<in> R" "sx \<in> S" "ry \<in> R" "s \<in> S" "sy \<in> S" "s \<cdot> (sy \<cdot> rx - sx \<cdot> ry) = \<zero>" "x = (rx,sx)" "y = (ry,sy)"
     using assms by (auto simp: rel_def)
   then have "s \<cdot> (sx \<cdot> ry - sy \<cdot> rx) = \<zero>"
     by (metis sub comm.additive.cancel_imp_equal comm.inverse_distributive(1) comm.multiplicative.composition_closed)
   with \<section> show ?thesis
     by (auto simp: rel_def)
 qed
 
 lemma rel_trans:
   assumes "x \<sim> y" "y \<sim> z" "x \<in> R \<times> S" "y \<in> R \<times> S" "z \<in> R \<times> S" shows "x \<sim> z"
   using assms
 proof (clarsimp simp: rel_def)
   fix r s r2 s2 r1 s1 sx sy
   assume \<section>: "r \<in> R" "s \<in> S" "r1 \<in> R" "s1 \<in> S" "sx \<in> S" "r2 \<in> R" "s2 \<in> S" "sy \<in> S"
     and sx0: "sx \<cdot> (s1 \<cdot> r2 - s2 \<cdot> r1) = \<zero>" and sy0: "sy \<cdot> (s2 \<cdot> r - s \<cdot> r2) = \<zero>"
   show "\<exists>u. u \<in> S \<and> u \<cdot> (s1 \<cdot> r - s \<cdot> r1) = \<zero>"
   proof (intro exI conjI)
     show "sx \<cdot> sy \<cdot> s1 \<cdot> s2 \<in> S"
       using \<section> by blast
     have sx: "sx \<cdot> s1 \<cdot> r2 = sx \<cdot> s2 \<cdot> r1" and sy: "sy \<cdot> s2 \<cdot> r = sy \<cdot> s \<cdot> r2"
       using sx0 sy0 \<section> comm.additive.cancel_imp_equal comm.inverse_distributive(1)
         comm.multiplicative.associative comm.multiplicative.composition_closed sub
       by metis+
     then
     have "sx \<cdot> sy \<cdot> s1 \<cdot> s2 \<cdot> (s1 \<cdot> r - s \<cdot> r1) = sx \<cdot> sy \<cdot> s1 \<cdot> s2 \<cdot> s1 \<cdot> r - sx \<cdot> sy \<cdot> s1 \<cdot> s2 \<cdot> s \<cdot> r1"
       using "\<section>" \<open>sx \<cdot> sy \<cdot> s1 \<cdot> s2 \<in> S\<close>
         comm.inverse_distributive(1) comm.multiplicative.associative comm.multiplicative.composition_closed
         sub
       by presburger
     also have "... = sx \<cdot> sy \<cdot> s1 \<cdot> s \<cdot> s1 \<cdot> r2 - sx \<cdot> sy \<cdot> s1 \<cdot> s2 \<cdot> s \<cdot> r1"
       using \<section>
       by (smt sy comm.comm_mult comm.multiplicative.associative comm.multiplicative.composition_closed sub)
     also have "... = sx \<cdot> sy \<cdot> s1 \<cdot> s \<cdot> s1 \<cdot> r2 - sx \<cdot> sy \<cdot> s1 \<cdot> s1 \<cdot> s \<cdot> r2"
       using \<section> by (smt sx comm.comm_mult comm.multiplicative.associative
           comm.multiplicative.composition_closed sub)
     also have "... = \<zero>"
       using \<section> by (simp add: comm.ring_mult_ac)
     finally show "sx \<cdot> sy \<cdot> s1 \<cdot> s2 \<cdot> (s1 \<cdot> r - s \<cdot> r1) = \<zero>" .
   qed
 qed
 
 interpretation rel: equivalence "R \<times> S" "{(x,y) \<in> (R\<times>S)\<times>(R\<times>S). x \<sim> y}"
   by (blast intro: equivalence.intro rel_refl rel_sym rel_trans)
 
 
 notation equivalence.Partition (infixl "'/" 75)
 
 definition frac:: "'a \<Rightarrow> 'a \<Rightarrow> ('a \<times> 'a) set" (infixl "'/" 75)
   where "r / s \<equiv> rel.Class (r, s)"
 
 lemma frac_Pow:"(r, s) \<in> R \<times> S \<Longrightarrow> frac r s \<in> Pow (R \<times> S) "
   using local.frac_def rel.Class_closed2 by auto
 
 lemma frac_eqI:
   assumes "s1\<in>S" and "(r, s) \<in> R \<times> S" "(r', s') \<in> R \<times> S"
      and eq:"s1 \<cdot> s' \<cdot> r = s1 \<cdot> s \<cdot> r'"
   shows "frac r s = frac r' s'"
   unfolding frac_def
 proof (rule rel.Class_eq)
   have "s1 \<cdot> (s' \<cdot> r - s \<cdot> r') = \<zero>"
     using assms comm.inverse_distributive(1) comm.multiplicative.associative by auto
   with \<open>s1\<in>S\<close> have "(r, s) \<sim> (r', s')"
     unfolding rel_def by auto
   then show "((r, s), r', s') \<in> {(x, y). (x, y) \<in> (R \<times> S) \<times> R \<times> S \<and> x \<sim> y}"
     using assms(2,3) by auto
 qed
 
 lemma frac_eq_Ex:
   assumes "(r, s) \<in> R \<times> S" "(r', s') \<in> R \<times> S" "frac r s = frac r' s'"
   obtains s1 where "s1\<in>S" "s1 \<cdot> (s' \<cdot> r - s \<cdot> r') = \<zero>"
 proof -
   have "(r, s) \<sim> (r', s')"
     using \<open>frac r s = frac r' s'\<close> rel.Class_equivalence[OF assms(1,2)]
     unfolding frac_def by auto
   then show ?thesis unfolding rel_def
     by (metis fst_conv snd_conv that)
 qed
 
 lemma frac_cancel:
   assumes "s1\<in>S" and "(r, s) \<in> R \<times> S"
   shows "frac (s1\<cdot>r) (s1\<cdot>s) = frac r s"
   apply (rule frac_eqI[of \<one>])
   using assms comm_ring_simps by auto
 
 lemma frac_eq_obtains:
   assumes "(r,s) \<in> R \<times> S" and x_def:"x=(SOME x. x\<in>(frac r s))"
   obtains s1 where "s1\<in>S" "s1 \<cdot> s \<cdot> fst x = s1 \<cdot> snd x \<cdot> r" and "x \<in> R \<times> S"
 proof -
   have "x\<in>(r/s)"
     unfolding x_def
     apply (rule someI[of _ "(r,s)"])
     using assms(1) local.frac_def by blast
   from rel.ClassD[OF this[unfolded frac_def] \<open>(r,s) \<in> R \<times> S\<close>]
   have x_RS:"x\<in>R \<times> S" and "x \<sim> (r,s)" by auto
   from this(2) obtain s1 where "s1\<in>S" and "s1 \<cdot> (s \<cdot> fst x - snd x \<cdot> r) = \<zero>"
     unfolding rel_def by auto
   then have x_eq:"s1 \<cdot> s \<cdot> fst x = s1 \<cdot> snd x \<cdot> r"
     using comm.distributive x_RS assms(1)
     by (smt comm.additive.group_axioms group.cancel_imp_equal comm.inverse_distributive(1)
         mem_Sigma_iff comm.multiplicative.associative comm.multiplicative.composition_closed prod.collapse sub)
   then show ?thesis using that x_RS \<open>s1\<in>S\<close> by auto
 qed
 
 definition valid_frac::"('a \<times> 'a) set \<Rightarrow> bool" where
   "valid_frac X \<equiv> \<exists>r\<in>R. \<exists>s\<in>S. r / s = X"
 
 lemma frac_non_empty[simp]:"(a,b) \<in> R \<times> S \<Longrightarrow> valid_frac (frac a b)"
   unfolding frac_def valid_frac_def by blast
 
 definition add_rel_aux:: "'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> ('a \<times> 'a) set"
   where "add_rel_aux r s r' s' \<equiv> (r\<cdot>s' + r'\<cdot>s) / (s\<cdot>s')"
 
 definition add_rel:: "('a \<times> 'a) set \<Rightarrow> ('a \<times> 'a) set \<Rightarrow> ('a \<times> 'a) set"
   where "add_rel X Y \<equiv>
   let x = (SOME x. x \<in> X) in
   let y = (SOME y. y \<in> Y) in
   add_rel_aux (fst x) (snd x) (fst y) (snd y)"
 
 lemma add_rel_frac:
   assumes "(r,s) \<in> R \<times> S" "(r',s')\<in> R \<times> S"
   shows "add_rel (r/s) (r'/s') = (r\<cdot>s' + r'\<cdot>s) / (s\<cdot>s')"
 proof -
   define x where "x=(SOME x. x\<in>(r/s))"
   define y where "y=(SOME y. y\<in>(r'/s'))"
 
   obtain s1 where [simp]:"s1 \<in> S" and x_eq:"s1 \<cdot> s \<cdot> fst x = s1 \<cdot> snd x \<cdot> r" and x_RS:"x \<in> R \<times> S"
     using frac_eq_obtains[OF \<open>(r,s) \<in> R \<times> S\<close> x_def] by auto
   obtain s2 where [simp]:"s2 \<in> S" and y_eq:"s2 \<cdot> s' \<cdot> fst y = s2 \<cdot> snd y \<cdot> r'" and y_RS:"y \<in> R \<times> S"
     using frac_eq_obtains[OF \<open>(r',s') \<in> R \<times> S\<close> y_def] by auto
 
   have "add_rel (r/s) (r'/s') = (fst x \<cdot> snd y + fst y \<cdot> snd x) / (snd x \<cdot> snd y)"
     unfolding add_rel_def add_rel_aux_def x_def y_def Let_def by auto
   also have "... = (r\<cdot>s' + r'\<cdot>s) / (s\<cdot>s')"
   proof (rule frac_eqI[of "s1 \<cdot> s2"])
     have "snd y \<cdot>  s' \<cdot> s2 \<cdot> (s1 \<cdot>  s \<cdot> fst x)  = snd y \<cdot> s' \<cdot> s2 \<cdot> (s1 \<cdot>  snd x \<cdot>  r)"
       using x_eq by simp
     then have "s1 \<cdot> s2 \<cdot> s \<cdot> s' \<cdot> fst x \<cdot> snd y =  s1 \<cdot> s2 \<cdot> snd x \<cdot> snd y \<cdot> r \<cdot> s'"
       using comm.multiplicative.associative assms x_RS y_RS comm.comm_mult by auto
     moreover have "snd x \<cdot> s \<cdot>s1 \<cdot> (s2 \<cdot> s' \<cdot> fst y) = snd x \<cdot> s \<cdot>s1 \<cdot> (s2 \<cdot> snd y \<cdot> r')"
       using y_eq by simp
     then have "s1 \<cdot> s2 \<cdot> s \<cdot> s' \<cdot> fst y \<cdot> snd x = s1 \<cdot> s2 \<cdot> snd x \<cdot> snd y \<cdot> r' \<cdot> s"
       using comm.multiplicative.associative assms x_RS y_RS comm.comm_mult
       by auto
     ultimately show "s1 \<cdot> s2 \<cdot> (s \<cdot> s') \<cdot> (fst x \<cdot> snd y + fst y \<cdot> snd x)
         = s1 \<cdot> s2 \<cdot> (snd x \<cdot> snd y) \<cdot> (r \<cdot> s' + r' \<cdot> s)"
       using comm.multiplicative.associative assms x_RS y_RS comm.distributive
       by auto
     show "s1 \<cdot> s2 \<in> S" "(fst x \<cdot> snd y + fst y \<cdot> snd x, snd x \<cdot> snd y) \<in> R \<times> S"
         "(r \<cdot> s' + r' \<cdot> s, s \<cdot> s') \<in> R \<times> S"
       using assms x_RS y_RS by auto
   qed
   finally show ?thesis by auto
 qed
 
 lemma valid_frac_add[intro,simp]:
   assumes "valid_frac X" "valid_frac Y"
   shows "valid_frac (add_rel X Y)"
 proof -
   obtain r s r' s' where "r\<in>R" "s\<in>S" "r'\<in>R" "s'\<in>S"
       and *:"add_rel X Y = (r\<cdot>s' + r'\<cdot>s) / (s\<cdot>s')"
   proof -
     define x where "x=(SOME x. x\<in>X)"
     define y where "y=(SOME y. y\<in>Y)"
     have "x\<in>X" "y\<in>Y"
       using assms unfolding x_def y_def valid_frac_def some_in_eq local.frac_def
       by blast+
     then obtain "x \<in> R \<times> S" "y \<in> R \<times> S"
       using assms
       by (simp add: valid_frac_def x_def y_def) (metis frac_eq_obtains mem_Sigma_iff)
     moreover have "add_rel X Y = (fst x \<cdot> snd y + fst y \<cdot> snd x) / (snd x \<cdot> snd y)"
       unfolding add_rel_def add_rel_aux_def x_def y_def Let_def by auto
     ultimately show ?thesis using that by auto
   qed
   from this(1-4)
   have "(r\<cdot>s' + r'\<cdot>s,s\<cdot>s') \<in> R \<times> S"
     by auto
   with * show ?thesis by auto
 qed
 
 definition uminus_rel:: "('a \<times> 'a) set \<Rightarrow> ('a \<times> 'a) set"
   where "uminus_rel X \<equiv> let x = (SOME x. x \<in> X) in (comm.additive.inverse (fst x) / snd x)"
 
 lemma uminus_rel_frac:
   assumes "(r,s) \<in> R \<times> S"
   shows "uminus_rel (r/s) = (comm.additive.inverse r) / s"
 proof -
   define x where "x=(SOME x. x\<in>(r/s))"
 
   obtain s1 where [simp]:"s1 \<in> S" and x_eq:"s1 \<cdot> s \<cdot> fst x = s1 \<cdot> snd x \<cdot> r" and x_RS:"x \<in> R \<times> S"
     using frac_eq_obtains[OF \<open>(r,s) \<in> R \<times> S\<close> x_def] by auto
 
   have "uminus_rel (r/s)= (comm.additive.inverse (fst x)) / (snd x )"
     unfolding uminus_rel_def x_def Let_def by auto
   also have "... = (comm.additive.inverse r) / s"
     apply (rule frac_eqI[of s1])
     using x_RS assms x_eq by (auto simp add: comm.right_minus)
   finally show ?thesis .
 qed
 
 lemma valid_frac_uminus[intro,simp]:
   assumes "valid_frac X"
   shows "valid_frac (uminus_rel X)"
 proof -
   obtain r s where "r\<in>R" "s\<in>S"
       and *:"uminus_rel X = (comm.additive.inverse r) / s"
   proof -
     define x where "x=(SOME x. x\<in>X)"
     have "x\<in>X"
       using assms unfolding x_def valid_frac_def some_in_eq local.frac_def
       by blast
     then have "x\<in> R \<times> S"
       using assms valid_frac_def
       by (metis frac_eq_obtains mem_Sigma_iff x_def)
     moreover have "uminus_rel X = (comm.additive.inverse (fst x) ) / (snd x)"
       unfolding uminus_rel_def x_def Let_def by auto
     ultimately show ?thesis using that by auto
   qed
   from this(1-3)
   have "(comm.additive.inverse r,s) \<in> R \<times> S" by auto
   with * show ?thesis by auto
 qed
 
 definition mult_rel_aux:: "'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> ('a \<times> 'a) set"
   where "mult_rel_aux r s r' s' \<equiv> (r\<cdot>r') / (s\<cdot>s')"
 
 definition mult_rel:: "('a \<times> 'a) set \<Rightarrow> ('a \<times> 'a) set \<Rightarrow> ('a \<times> 'a) set"
   where "mult_rel X Y \<equiv>
   let x = (SOME x. x \<in> X) in
   let y = (SOME y. y \<in> Y) in
   mult_rel_aux (fst x) (snd x) (fst y) (snd y)"
 
 lemma mult_rel_frac:
   assumes "(r,s) \<in> R \<times> S" "(r',s')\<in> R \<times> S"
   shows "mult_rel (r/s) (r'/s') = (r\<cdot> r') / (s\<cdot>s')"
 proof -
    define x where "x=(SOME x. x\<in>(r/s))"
   define y where "y=(SOME y. y\<in>(r'/s'))"
 
   obtain s1 where [simp]:"s1 \<in> S" and x_eq:"s1 \<cdot> s \<cdot> fst x = s1 \<cdot> snd x \<cdot> r" and x_RS:"x \<in> R \<times> S"
     using frac_eq_obtains[OF \<open>(r,s) \<in> R \<times> S\<close> x_def] by auto
   obtain s2 where [simp]:"s2 \<in> S" and y_eq:"s2 \<cdot> s' \<cdot> fst y = s2 \<cdot> snd y \<cdot> r'" and y_RS:"y \<in> R \<times> S"
     using frac_eq_obtains[OF \<open>(r',s') \<in> R \<times> S\<close> y_def] by auto
 
   have "mult_rel (r/s) (r'/s') = (fst x \<cdot> fst y ) / (snd x \<cdot> snd y)"
     unfolding mult_rel_def mult_rel_aux_def x_def y_def Let_def by auto
   also have "... = (r\<cdot> r') / (s\<cdot>s')"
   proof (rule frac_eqI[of "s1 \<cdot> s2"])
     have "(s1 \<cdot> s \<cdot> fst x) \<cdot> (s2 \<cdot> s' \<cdot> fst y)  = (s1 \<cdot> snd x \<cdot> r) \<cdot> (s2 \<cdot> snd y \<cdot> r')"
       using x_eq y_eq by auto
     then show "s1 \<cdot> s2 \<cdot> (s \<cdot> s') \<cdot> (fst x \<cdot> fst y) = s1 \<cdot> s2 \<cdot> (snd x \<cdot> snd y) \<cdot> (r \<cdot> r')"
       using comm.multiplicative.associative assms x_RS y_RS comm.distributive comm.comm_mult by auto
     show "s1 \<cdot> s2 \<in> S" "(fst x \<cdot> fst y, snd x \<cdot> snd y) \<in> R \<times> S"
         "(r \<cdot> r', s \<cdot> s') \<in> R \<times> S"
       using assms x_RS y_RS by auto
   qed
   finally show ?thesis by auto
 qed
 
 lemma valid_frac_mult[intro,simp]:
   assumes "valid_frac X" "valid_frac Y"
   shows "valid_frac (mult_rel X Y)"
 proof -
   obtain r s r' s' where "r\<in>R" "s\<in>S" "r'\<in>R" "s'\<in>S"
       and *:"mult_rel X Y = (r\<cdot> r') / (s\<cdot>s')"
   proof -
     define x where "x=(SOME x. x\<in>X)"
     define y where "y=(SOME y. y\<in>Y)"
     have "x\<in>X" "y\<in>Y"
       using assms unfolding x_def y_def valid_frac_def some_in_eq local.frac_def
       by blast+
     then obtain "x \<in> R \<times> S" "y \<in> R \<times> S"
       using assms
       by (simp add: valid_frac_def x_def y_def) (metis frac_eq_obtains mem_Sigma_iff)
     moreover have "mult_rel X Y = (fst x \<cdot> fst y) / (snd x \<cdot> snd y)"
       unfolding mult_rel_def mult_rel_aux_def x_def y_def Let_def by auto
     ultimately show ?thesis using that by auto
   qed
   from this(1-4)
   have "(r\<cdot>r',s\<cdot>s') \<in> R \<times> S"
     by auto
   with * show ?thesis by auto
 qed
 
 definition zero_rel::"('a \<times> 'a) set" where
   "zero_rel = frac \<zero> \<one>"
 
 definition one_rel::"('a \<times> 'a) set" where
   "one_rel = frac \<one> \<one>"
 
 lemma valid_frac_zero[simp]:
   "valid_frac zero_rel"
   unfolding zero_rel_def valid_frac_def by blast
 
 lemma valid_frac_one[simp]:
   "valid_frac one_rel"
   unfolding one_rel_def valid_frac_def by blast
 
 definition carrier_quotient_ring:: "('a \<times> 'a) set set"
   where "carrier_quotient_ring \<equiv> rel.Partition"
 
 lemma carrier_quotient_ring_iff[iff]: "X \<in> carrier_quotient_ring \<longleftrightarrow> valid_frac X "
   unfolding valid_frac_def carrier_quotient_ring_def
   using local.frac_def rel.natural.map_closed rel.representant_exists by fastforce
 
 lemma frac_from_carrier:
   assumes "X \<in> carrier_quotient_ring"
   obtains r s where "r \<in> R" "s \<in> S" "X = rel.Class (r,s)"
   using assms carrier_quotient_ring_def
   by (metis (no_types, lifting) SigmaE rel.representant_exists)
 
 lemma add_minus_zero_rel:
   assumes "valid_frac a"
   shows "add_rel a (uminus_rel a) = zero_rel"
 proof -
   obtain a1 a2 where a_RS:"(a1, a2)\<in>R \<times> S" and a12:"a = a1 / a2 "
     using \<open>valid_frac a\<close> unfolding valid_frac_def by auto
   have "add_rel a (uminus_rel a) =  \<zero> / (a2 \<cdot> a2)"
     unfolding a12 using comm_ring_simps a_RS
     by (simp add:add_rel_frac uminus_rel_frac comm.right_minus)
   also have "... = \<zero> / \<one>"
     apply (rule frac_eqI[of \<one>])
     using a_RS by auto
   also have "... = zero_rel" unfolding zero_rel_def ..
   finally show "add_rel a (uminus_rel a) = zero_rel" .
 qed
 
 
 (* ex. 0.26 *)
 sublocale comm_ring carrier_quotient_ring add_rel mult_rel zero_rel one_rel
 proof (unfold_locales; unfold carrier_quotient_ring_iff)
   show add_assoc:"add_rel (add_rel a b) c = add_rel a (add_rel b c)" and
        mult_assoc:"mult_rel (mult_rel a b) c = mult_rel a (mult_rel b c)" and
        distr:"mult_rel a (add_rel b c) = add_rel (mult_rel a b) (mult_rel a c)"
     if "valid_frac a" and "valid_frac b" and "valid_frac c" for a b c
   proof -
     obtain a1 a2 where a_RS:"(a1, a2)\<in>R \<times> S" and a12:"a = a1 / a2 "
       using \<open>valid_frac a\<close> unfolding valid_frac_def by auto
     obtain b1 b2 where b_RS:"(b1, b2)\<in>R \<times> S" and b12:"b = b1 / b2 "
       using \<open>valid_frac b\<close> unfolding valid_frac_def by auto
     obtain c1 c2 where c_RS:"(c1, c2)\<in>R \<times> S" and c12:"c = c1 / c2"
       using \<open>valid_frac c\<close> unfolding valid_frac_def by auto
 
     have "add_rel (add_rel a b) c = add_rel (add_rel (a1/a2) (b1/b2)) (c1/c2)"
       using a12 b12 c12 by auto
     also have "... = ((a1 \<cdot> b2 + b1 \<cdot> a2) \<cdot> c2 + c1 \<cdot> (a2 \<cdot> b2)) / (a2 \<cdot> b2 \<cdot> c2)"
       using a_RS b_RS c_RS by (simp add:add_rel_frac)
     also have "... = add_rel (a1/a2) (add_rel (b1/b2) (c1/c2))"
       using a_RS b_RS c_RS comm.distributive comm_ring_simps
       by (auto simp add:add_rel_frac)
     also have "... = add_rel a (add_rel b c)"
       using a12 b12 c12 by auto
     finally show "add_rel (add_rel a b) c = add_rel a (add_rel b c)" .
 
     show "mult_rel (mult_rel a b) c = mult_rel a (mult_rel b c)"
       unfolding a12 b12 c12 using comm_ring_simps a_RS b_RS c_RS
       by (auto simp add:mult_rel_frac)
 
     have "mult_rel a (add_rel b c) = (a1 \<cdot> (b1 \<cdot> c2 + c1 \<cdot> b2)) / (a2 \<cdot> (b2 \<cdot> c2))"
       unfolding a12 b12 c12 using a_RS b_RS c_RS
       by (simp add:mult_rel_frac add_rel_frac)
     also have "... = (a2 \<cdot> (a1 \<cdot> (b1 \<cdot> c2 + c1 \<cdot> b2))) / (a2 \<cdot> (a2 \<cdot> (b2 \<cdot> c2)))"
       using a_RS b_RS c_RS by (simp add:frac_cancel)
     also have "... = add_rel (mult_rel a b) (mult_rel a c)"
       unfolding a12 b12 c12 using comm_ring_simps a_RS b_RS c_RS comm.distributive
       by (auto simp add:mult_rel_frac add_rel_frac)
     finally show "mult_rel a (add_rel b c) = add_rel (mult_rel a b) (mult_rel a c)"
       .
   qed
   show add_0:"add_rel zero_rel a = a"
       and mult_1:"mult_rel one_rel a = a"
      if "valid_frac a" for a
   proof -
     obtain a1 a2 where a_RS:"(a1, a2)\<in>R \<times> S" and a12:"a = a1 / a2 "
       using \<open>valid_frac a\<close> unfolding valid_frac_def by auto
     have "add_rel zero_rel a = add_rel zero_rel (a1/a2)"
       using a12 by simp
     also have "... = (a1/a2)"
       using a_RS comm_ring_simps comm.distributive zero_rel_def
       by (auto simp add:add_rel_frac)
     also have "... = a"
       using a12 by auto
     finally show "add_rel zero_rel a = a" .
     show "mult_rel one_rel a = a"
       unfolding a12 one_rel_def using a_RS by (auto simp add:mult_rel_frac)
   qed
   show add_commute:"add_rel a b = add_rel b a"
     and mult_commute:"mult_rel a b = mult_rel b a"
     if "valid_frac a" and "valid_frac b" for a b
   proof -
     obtain a1 a2 where a_RS:"(a1, a2)\<in>R \<times> S" and a12:"a = a1 / a2 "
       using \<open>valid_frac a\<close> unfolding valid_frac_def by auto
     obtain b1 b2 where b_RS:"(b1, b2)\<in>R \<times> S" and b12:"b = b1 / b2 "
       using \<open>valid_frac b\<close> unfolding valid_frac_def by auto
 
     show "add_rel a b = add_rel b a" "mult_rel a b = mult_rel b a"
       unfolding a12 b12  using comm_ring_simps a_RS b_RS
       by (auto simp add:mult_rel_frac add_rel_frac)
   qed
   show "add_rel a zero_rel = a" if "valid_frac a" for a
     using that add_0 add_commute by auto
   show "mult_rel a one_rel = a" if "valid_frac a" for a
     using that mult_commute mult_1 by auto
   show "monoid.invertible carrier_quotient_ring add_rel zero_rel a"
     if "valid_frac a" for a
   proof -
     have "Group_Theory.monoid carrier_quotient_ring add_rel zero_rel"
       apply (unfold_locales)
       using add_0 add_assoc add_commute by simp_all
     moreover have "add_rel a (uminus_rel a) = zero_rel" "add_rel (uminus_rel a) a = zero_rel"
       using add_minus_zero_rel add_commute that by auto
     ultimately show "monoid.invertible carrier_quotient_ring add_rel zero_rel a"
       unfolding monoid.invertible_def
       apply (rule monoid.invertibleI)
       using add_commute \<open>valid_frac a\<close> by auto
   qed
   show "mult_rel (add_rel b c) a = add_rel (mult_rel b a) (mult_rel c a)"
     if "valid_frac a" and "valid_frac b" and "valid_frac c" for a b c
     using that mult_commute add_commute distr by (simp add: valid_frac_add)
 qed auto
 
 end (* quotient_ring *)
 
 notation quotient_ring.carrier_quotient_ring
            ("(_ \<^sup>\<inverse> _/ \<^bsub>(2_ _ _))\<^esub>" [60,1000,1000,1000,1000]1000)
 
 
 subsection \<open>Local Rings at Prime Ideals\<close>
 
 context pr_ideal
 begin
 
 lemma submonoid_pr_ideal:
   shows "submonoid (R \<setminus> I) R (\<cdot>) \<one>"
 proof
   show "a \<cdot> b \<in> R\<setminus>I" if "a \<in> R\<setminus>I" "b \<in> R\<setminus>I" for a b
     using that by (metis Diff_iff absorbent comm.multiplicative.composition_closed)
   show "\<one> \<in> R\<setminus>I"
     using ideal.ideal(2) ideal_axioms pr_ideal.carrier_neq pr_ideal_axioms by fastforce
 qed auto
 
 interpretation local:quotient_ring "(R \<setminus> I)" R "(+)" "(\<cdot>)" \<zero> \<one>
   by intro_locales (meson submonoid_def submonoid_pr_ideal)
 
 (* definition 0.28 *)
 definition carrier_local_ring_at:: "('a \<times> 'a) set set"
   where "carrier_local_ring_at \<equiv> (R \<setminus> I)\<^sup>\<inverse> R\<^bsub>(+) (\<cdot>) \<zero>\<^esub>"
 
 definition add_local_ring_at:: "('a \<times> 'a) set \<Rightarrow> ('a \<times> 'a) set \<Rightarrow> ('a \<times> 'a) set"
   where "add_local_ring_at \<equiv> local.add_rel "
 
 definition mult_local_ring_at:: "('a \<times> 'a) set \<Rightarrow> ('a \<times> 'a) set \<Rightarrow> ('a \<times> 'a) set"
   where "mult_local_ring_at \<equiv> local.mult_rel "
 
 definition uminus_local_ring_at:: "('a \<times> 'a) set \<Rightarrow> ('a \<times> 'a) set"
   where "uminus_local_ring_at \<equiv> local.uminus_rel "
 
 definition zero_local_ring_at:: "('a \<times> 'a) set"
   where "zero_local_ring_at \<equiv> local.zero_rel"
 
 definition one_local_ring_at:: "('a \<times> 'a) set"
   where "one_local_ring_at \<equiv> local.one_rel"
 
 sublocale comm_ring carrier_local_ring_at add_local_ring_at mult_local_ring_at
             zero_local_ring_at one_local_ring_at
   by (simp add: add_local_ring_at_def carrier_local_ring_at_def local.local.comm_ring_axioms
       mult_local_ring_at_def one_local_ring_at_def zero_local_ring_at_def)
 
 
 lemma frac_from_carrier_local:
   assumes "X \<in> carrier_local_ring_at"
   obtains r s where "r \<in> R" "s \<in> R" "s \<notin> I" "X = local.frac r s"
 proof-
   have "X \<in> (R \<setminus> I)\<^sup>\<inverse> R\<^bsub>(+) (\<cdot>) \<zero>\<^esub>" using assms by (simp add: carrier_local_ring_at_def)
   then have "X \<in> quotient_ring.carrier_quotient_ring (R \<setminus> I) R (+) (\<cdot>) \<zero>" by blast
   then obtain r s where "r \<in> R" "s \<in> (R \<setminus> I)" "X = local.frac r s"
     using local.frac_from_carrier by (metis local.frac_def)
   thus thesis using that by blast
 qed
 
 lemma eq_from_eq_frac:
   assumes "local.frac r s = local.frac r' s'"
     and "s \<in> (R \<setminus> I)" and "s' \<in> (R \<setminus> I)" and "r \<in> R" "r' \<in> R"
   obtains h where "h \<in> (R \<setminus> I)" "h \<cdot> (s' \<cdot> r - s \<cdot> r') = \<zero>"
     using local.frac_eq_Ex[of r s r' s'] assms by blast
 
 end (* pr_ideal *)
 
 abbreviation carrier_of_local_ring_at::
 "'a set \<Rightarrow> 'a set \<Rightarrow> ('a \<Rightarrow> 'a \<Rightarrow> 'a) \<Rightarrow> ('a \<Rightarrow> 'a \<Rightarrow> 'a) \<Rightarrow> 'a \<Rightarrow> ('a \<times> 'a) set set" ("_ \<^bsub>_ _ _ _\<^esub>" [1000]1000)
 where "R \<^bsub>I add mult zero\<^esub> \<equiv> pr_ideal.carrier_local_ring_at R I add mult zero"
 
 
 subsection \<open>Spectrum of a Ring\<close>
 
 (* construction 0.29 *)
 context comm_ring
 begin
 
 interpretation zariski_top_space: topological_space Spec is_zariski_open
   unfolding is_zariski_open_def using generated_topology_is_topology
   by blast
 
 lemma spectrum_imp_cxt_quotient_ring:
   "\<pp> \<in> Spec \<Longrightarrow> quotient_ring (R \<setminus> \<pp>) R (+) (\<cdot>) \<zero> \<one>"
   apply (intro_locales)
   using pr_ideal.submonoid_pr_ideal spectrum_def submonoid_def by fastforce
 
 lemma spectrum_imp_pr:
   "\<pp> \<in> Spec \<Longrightarrow> pr_ideal R \<pp> (+) (\<cdot>) \<zero> \<one>"
   unfolding spectrum_def by auto
 
 lemma frac_in_carrier_local:
   assumes "\<pp> \<in> Spec" and "r \<in> R" and "s \<in> R" and "s \<notin> \<pp>"
   shows "(quotient_ring.frac (R \<setminus> \<pp>) R (+) (\<cdot>) \<zero> r s) \<in> R\<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>"
 proof -
   interpret qr:quotient_ring "R \<setminus> \<pp>" R "(+)" "(\<cdot>)" \<zero> \<one>
     using spectrum_imp_cxt_quotient_ring[OF \<open>\<pp> \<in> Spec\<close>] .
   interpret pi:pr_ideal R \<pp> "(+)" "(\<cdot>)" \<zero> \<one>
     using spectrum_imp_pr[OF \<open>\<pp> \<in> Spec\<close>] .
   show ?thesis unfolding pi.carrier_local_ring_at_def
     using assms(2-) by (auto intro:qr.frac_non_empty)
 qed
 
 definition is_locally_frac:: "('a set \<Rightarrow> ('a \<times> 'a) set) \<Rightarrow> 'a set set \<Rightarrow> bool"
   where "is_locally_frac s V \<equiv> (\<exists>r f. r \<in> R \<and> f \<in> R \<and> (\<forall>\<qq> \<in> V. f \<notin> \<qq> \<and>
             s \<qq> = quotient_ring.frac (R \<setminus> \<qq>) R (+) (\<cdot>) \<zero> r f))"
 
 lemma is_locally_frac_subset:
   assumes "is_locally_frac s U" "V \<subseteq> U"
   shows "is_locally_frac s V"
   using assms unfolding is_locally_frac_def
   by (meson subsetD)
 
 lemma is_locally_frac_cong:
   assumes "\<And>x. x\<in>U \<Longrightarrow> f x=g x"
   shows "is_locally_frac f U = is_locally_frac g U"
   unfolding is_locally_frac_def using assms by simp
 
 definition is_regular:: "('a set \<Rightarrow> ('a \<times> 'a) set) \<Rightarrow> 'a set set \<Rightarrow> bool"
   where "is_regular s U \<equiv>
 \<forall>\<pp>. \<pp> \<in> U \<longrightarrow> (\<exists>V. is_zariski_open V \<and> V \<subseteq> U \<and> \<pp> \<in> V \<and> (is_locally_frac s V))"
 
 lemma map_on_empty_is_regular:
   fixes s:: "'a set \<Rightarrow> ('a \<times> 'a) set"
   shows "is_regular s {}"
   by (simp add: is_regular_def)
 
 lemma cring0_is_regular [simp]: "cring0.is_regular x = (\<lambda>U. U={})"
   unfolding cring0.is_regular_def cring0_is_zariski_open
   by blast
 
 definition sheaf_spec:: "'a set set \<Rightarrow> ('a set \<Rightarrow> ('a \<times> 'a) set) set" ("\<O> _" [90]90)
   where "\<O> U \<equiv> {s\<in>(\<Pi>\<^sub>E \<pp>\<in>U. (R\<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>)). is_regular s U}"
 
 lemma cring0_sheaf_spec_empty [simp]: "cring0.sheaf_spec {} = {\<lambda>x. undefined}"
   by (simp add: cring0.sheaf_spec_def)
 
 lemma sec_has_right_codom:
   assumes "s \<in> \<O> U" and "\<pp> \<in> U"
   shows "s \<pp> \<in> (R\<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>)"
 using assms sheaf_spec_def by auto
 
 
 lemma is_regular_has_right_codom:
   assumes "U \<subseteq> Spec" "\<pp> \<in> U" "is_regular s U"
   shows "s \<pp> \<in> R\<setminus>\<pp> \<^sup>\<inverse> R\<^bsub>(+) (\<cdot>) \<zero>\<^esub>"
 proof -
   interpret qr:quotient_ring "(R \<setminus> \<pp>)" R "(+)" "(\<cdot>)" \<zero> \<one>
     using spectrum_imp_cxt_quotient_ring assms by auto
   show ?thesis using assms
     by (smt frac_in_carrier_local is_locally_frac_def is_regular_def
           pr_ideal.carrier_local_ring_at_def spectrum_imp_pr subset_eq)
 qed
 
 lemma sec_is_extensional:
   assumes "s \<in> \<O> U"
   shows "s \<in> extensional U"
   using assms sheaf_spec_def by (simp add: PiE_iff)
 
 definition \<O>b::"'a set \<Rightarrow> ('a \<times> 'a) set"
   where "\<O>b = (\<lambda>\<pp>. undefined)"
 
 lemma \<O>_on_emptyset: "\<O> {} = {\<O>b}"
   unfolding sheaf_spec_def \<O>b_def
   by (auto simp:Set_Theory.map_def map_on_empty_is_regular)
 
 lemma sheaf_spec_of_empty_is_singleton:
   fixes U:: "'a set set"
   assumes "U = {}" and "s \<in> extensional U" and "t \<in> extensional U"
   shows "s = t"
   using assms by (simp add: Set_Theory.map_def)
 
 definition add_sheaf_spec:: "('a set) set \<Rightarrow> ('a set \<Rightarrow> ('a \<times> 'a) set) \<Rightarrow> ('a set \<Rightarrow> ('a \<times> 'a) set) \<Rightarrow> ('a set \<Rightarrow> ('a \<times> 'a) set)"
   where "add_sheaf_spec U s s' \<equiv> \<lambda>\<pp>\<in>U. quotient_ring.add_rel (R \<setminus> \<pp>) R (+) (\<cdot>) \<zero> (s \<pp>) (s' \<pp>)"
 
 lemma is_regular_add_sheaf_spec:
   assumes "is_regular s U" and "is_regular s' U" and "U \<subseteq> Spec"
   shows "is_regular (add_sheaf_spec U s s') U"
 proof -
   have "add_sheaf_spec U s s' \<pp> \<in> R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>" if "\<pp> \<in> U" for \<pp>
   proof -
     interpret pi: pr_ideal R \<pp> "(+)" "(\<cdot>)" \<zero> \<one>
       using \<open>U \<subseteq> Spec\<close>[unfolded spectrum_def] \<open>\<pp> \<in> U\<close> by blast
     have "s \<pp> \<in> pi.carrier_local_ring_at"
       "s' \<pp> \<in> pi.carrier_local_ring_at"
       using \<open>is_regular s U\<close> \<open>is_regular s' U\<close>
       unfolding is_regular_def is_locally_frac_def using that
       using assms(3) frac_in_carrier_local by fastforce+
     then show ?thesis
       unfolding add_sheaf_spec_def using that
       by (simp flip:pi.add_local_ring_at_def)
   qed
   moreover have "(\<exists>V\<subseteq>U. is_zariski_open V \<and> \<pp> \<in> V \<and> is_locally_frac (add_sheaf_spec U s s') V)"
     if "\<pp> \<in> U" for \<pp>
   proof -
     obtain V1 r1 f1 where "V1 \<subseteq>U" "is_zariski_open V1" "\<pp> \<in> V1" "r1 \<in> R" "f1 \<in> R" and
         q_V1:"(\<forall>\<qq>. \<qq> \<in> V1 \<longrightarrow> f1 \<notin> \<qq> \<and> s \<qq> = quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> r1 f1)"
       using \<open>is_regular s U\<close>[unfolded is_regular_def] \<open>\<pp> \<in> U\<close>
       unfolding is_locally_frac_def by auto
     obtain V2 r2 f2 where "V2 \<subseteq>U" "is_zariski_open V2" "\<pp> \<in> V2" "r2 \<in> R" "f2 \<in> R" and
         q_V2:"(\<forall>\<qq>. \<qq> \<in> V2 \<longrightarrow> f2 \<notin> \<qq> \<and> s' \<qq> = quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> r2 f2)"
       using \<open>is_regular s' U\<close>[unfolded is_regular_def]  \<open>\<pp> \<in> U\<close>
       unfolding is_locally_frac_def by auto
 
     define V3 where "V3 = V1 \<inter> V2"
     define r3 where "r3 = r1 \<cdot> f2 + r2 \<cdot> f1 "
     define f3 where "f3 = f1 \<cdot> f2"
     have "V3 \<subseteq>U" "\<pp> \<in> V3" "r3 \<in> R" "f3 \<in> R"
       unfolding V3_def r3_def f3_def
       using \<open>V1 \<subseteq> U\<close> \<open>\<pp> \<in> V1\<close> \<open>V2 \<subseteq> U\<close> \<open>\<pp> \<in> V2\<close> \<open>f1 \<in> R\<close> \<open>f2 \<in> R\<close> \<open>r1 \<in> R\<close> \<open>r2 \<in> R\<close> by blast+
     moreover have "is_zariski_open V3" using \<open>is_zariski_open V1\<close> \<open>is_zariski_open V2\<close> topological_space.open_inter by (simp add: V3_def)
     moreover have "f3 \<notin> \<qq>"
         "add_sheaf_spec U s s' \<qq> = quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> r3 f3"
         if "\<qq> \<in> V3" for \<qq>
     proof -
       interpret q:quotient_ring "R\<setminus>\<qq>" R "(+)" "(\<cdot>)" \<zero>
         using \<open>U \<subseteq> Spec\<close> \<open>V3 \<subseteq> U\<close> \<open>\<qq> \<in> V3\<close> quotient_ring_def local.comm_ring_axioms
           pr_ideal.submonoid_pr_ideal spectrum_def
         by fastforce
       have "f1 \<notin> \<qq>" "s \<qq> = q.frac r1 f1"
         using q_V1 \<open>\<qq> \<in> V3\<close>  unfolding V3_def by auto
       have "f2 \<notin> \<qq>" "s' \<qq> = q.frac r2 f2"
         using q_V2 \<open>\<qq> \<in> V3\<close>  unfolding V3_def by auto
 
       have "q.add_rel (q.frac r1 f1) (q.frac r2 f2) = q.frac (r1 \<cdot> f2 + r2 \<cdot> f1) (f1 \<cdot> f2)"
         apply (rule q.add_rel_frac)
         subgoal by (simp add: \<open>f1 \<in> R\<close> \<open>f1 \<notin> \<qq>\<close> \<open>r1 \<in> R\<close> \<open>r2 \<in> R\<close>)
         subgoal using \<open>f2 \<in> R\<close> \<open>f2 \<notin> \<qq>\<close> \<open>r2 \<in> R\<close> by blast
         done
       then have "q.add_rel (s \<qq>) (s' \<qq>) = q.frac r3 f3"
         unfolding r3_def f3_def using \<open>s \<qq> = q.frac r1 f1\<close> \<open>s' \<qq> = q.frac r2 f2\<close>
         by auto
       then show "add_sheaf_spec U s s' \<qq> = q.frac r3 f3"
         unfolding add_sheaf_spec_def using \<open>V3 \<subseteq> U\<close> \<open>\<qq> \<in> V3\<close> by auto
       show "f3 \<notin> \<qq>" using that unfolding V3_def f3_def
         using \<open>f1 \<in> R\<close> \<open>f1 \<notin> \<qq>\<close> \<open>f2 \<in> R\<close> \<open>f2 \<notin> \<qq>\<close> q.sub_composition_closed by auto
     qed
     ultimately show ?thesis using is_locally_frac_def by metis
   qed
   ultimately show ?thesis unfolding is_regular_def is_locally_frac_def by meson
 qed
 
 lemma add_sheaf_spec_in_sheaf_spec:
   assumes "s \<in> \<O> U" and "t \<in> \<O> U" and "U \<subseteq> Spec"
   shows "add_sheaf_spec U s t \<in> \<O> U"
 proof -
   have "add_sheaf_spec U s t \<pp> \<in> R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>"
       if "\<pp> \<in> U" for \<pp>
   proof -
     interpret qr:quotient_ring "(R\<setminus>\<pp>)" R "(+)" "(\<cdot>)" \<zero> \<one>
       apply (rule spectrum_imp_cxt_quotient_ring)
       using that \<open>U \<subseteq> Spec\<close> by auto
     interpret pi:pr_ideal R \<pp> "(+)" "(\<cdot>)" \<zero> \<one>
       using that \<open>U \<subseteq> Spec\<close> by (auto intro:spectrum_imp_pr)
     have "qr.valid_frac (s \<pp>)" "qr.valid_frac (t \<pp>)"
       using sec_has_right_codom[OF _ that] \<open>s \<in> \<O> U\<close> \<open>t \<in> \<O> U\<close>
       by (auto simp:pi.carrier_local_ring_at_def)
     then show ?thesis
       using that unfolding add_sheaf_spec_def pi.carrier_local_ring_at_def
       by auto
   qed
   moreover have "is_regular (add_sheaf_spec U s t) U"
     using \<open>s \<in> \<O> U\<close> \<open>t \<in> \<O> U\<close> \<open>U \<subseteq> Spec\<close> is_regular_add_sheaf_spec
     unfolding sheaf_spec_def by auto
   moreover have "add_sheaf_spec U s t \<in> extensional U"
     unfolding add_sheaf_spec_def by auto
   ultimately show ?thesis
     unfolding sheaf_spec_def by (simp add: PiE_iff)
 qed
 
 definition mult_sheaf_spec:: "('a set) set \<Rightarrow> ('a set \<Rightarrow> ('a \<times> 'a) set) \<Rightarrow> ('a set \<Rightarrow> ('a \<times> 'a) set) \<Rightarrow> ('a set \<Rightarrow> ('a \<times> 'a) set)"
   where "mult_sheaf_spec U s s' \<equiv> \<lambda>\<pp>\<in>U. quotient_ring.mult_rel (R \<setminus> \<pp>) R (+) (\<cdot>) \<zero> (s \<pp>) (s' \<pp>)"
 
 lemma is_regular_mult_sheaf_spec:
   assumes "is_regular s U" and "is_regular s' U" and "U \<subseteq> Spec"
   shows "is_regular (mult_sheaf_spec U s s') U"
 proof -
   have "mult_sheaf_spec U s s' \<pp> \<in> R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>" if "\<pp> \<in> U" for \<pp>
   proof -
     interpret pi: pr_ideal R \<pp> "(+)" "(\<cdot>)" \<zero> \<one>
       using \<open>U \<subseteq> Spec\<close>[unfolded spectrum_def] \<open>\<pp> \<in> U\<close> by blast
     have "s \<pp> \<in> pi.carrier_local_ring_at"
       "s' \<pp> \<in> pi.carrier_local_ring_at"
       using \<open>is_regular s U\<close> \<open>is_regular s' U\<close>
       unfolding is_regular_def using that
       using assms(3) frac_in_carrier_local in_mono is_locally_frac_def by fastforce+
     then show ?thesis
       unfolding mult_sheaf_spec_def using that
       by (simp flip:pi.mult_local_ring_at_def)
   qed
   moreover have "(\<exists>V\<subseteq>U. is_zariski_open V \<and> \<pp> \<in> V \<and> is_locally_frac (mult_sheaf_spec U s s') V)"
     if "\<pp> \<in> U" for \<pp>
   proof -
     obtain V1 r1 f1 where "V1 \<subseteq>U" "is_zariski_open V1" "\<pp> \<in> V1" "r1 \<in> R" "f1 \<in> R" and
         q_V1:"(\<forall>\<qq>. \<qq> \<in> V1 \<longrightarrow> f1 \<notin> \<qq> \<and> s \<qq> = quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> r1 f1)"
       using \<open>is_regular s U\<close>[unfolded is_regular_def] \<open>\<pp> \<in> U\<close> unfolding is_locally_frac_def
       by auto
     obtain V2 r2 f2 where "V2 \<subseteq>U" "is_zariski_open V2" "\<pp> \<in> V2" "r2 \<in> R" "f2 \<in> R" and
         q_V2:"(\<forall>\<qq>. \<qq> \<in> V2 \<longrightarrow> f2 \<notin> \<qq> \<and> s' \<qq> = quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> r2 f2)"
       using \<open>is_regular s' U\<close>[unfolded is_regular_def] \<open>\<pp> \<in> U\<close> unfolding is_locally_frac_def
       by auto
 
     define V3 where "V3 = V1 \<inter> V2"
     define r3 where "r3 = r1 \<cdot> r2  "
     define f3 where "f3 = f1 \<cdot> f2"
     have "V3 \<subseteq>U" "\<pp> \<in> V3" "r3 \<in> R" "f3 \<in> R"
       unfolding V3_def r3_def f3_def
       using \<open>V1 \<subseteq> U\<close> \<open>\<pp> \<in> V1\<close> \<open>\<pp> \<in> V2\<close> \<open>f1 \<in> R\<close> \<open>f2 \<in> R\<close> \<open>r1 \<in> R\<close> \<open>r2 \<in> R\<close> by blast+
     moreover have "is_zariski_open V3"
       using topological_space.open_inter by (simp add: V3_def \<open>is_zariski_open V1\<close> \<open>is_zariski_open V2\<close>)
     moreover have "f3 \<notin> \<qq>"
         "mult_sheaf_spec U s s' \<qq> = quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> r3 f3"
         if "\<qq> \<in> V3" for \<qq>
     proof -
       interpret q:quotient_ring "R\<setminus>\<qq>" R "(+)" "(\<cdot>)" \<zero>
         using \<open>U \<subseteq> Spec\<close> \<open>V3 \<subseteq> U\<close> \<open>\<qq> \<in> V3\<close> quotient_ring_def local.comm_ring_axioms
           pr_ideal.submonoid_pr_ideal spectrum_def
         by fastforce
       have "f1 \<notin> \<qq>" "s \<qq> = q.frac r1 f1"
         using q_V1 \<open>\<qq> \<in> V3\<close>  unfolding V3_def by auto
       have "f2 \<notin> \<qq>" "s' \<qq> = q.frac r2 f2"
         using q_V2 \<open>\<qq> \<in> V3\<close>  unfolding V3_def by auto
 
       have "q.mult_rel (q.frac r1 f1) (q.frac r2 f2) = q.frac (r1 \<cdot> r2 ) (f1 \<cdot> f2)"
         apply (rule q.mult_rel_frac)
         subgoal by (simp add: \<open>f1 \<in> R\<close> \<open>f1 \<notin> \<qq>\<close> \<open>r1 \<in> R\<close> \<open>r2 \<in> R\<close>)
         subgoal using \<open>f2 \<in> R\<close> \<open>f2 \<notin> \<qq>\<close> \<open>r2 \<in> R\<close> by blast
         done
       then have "q.mult_rel (s \<qq>) (s' \<qq>) = q.frac r3 f3"
         unfolding r3_def f3_def using \<open>s \<qq> = q.frac r1 f1\<close> \<open>s' \<qq> = q.frac r2 f2\<close>
         by auto
       then show "mult_sheaf_spec U s s' \<qq> = q.frac r3 f3"
         unfolding mult_sheaf_spec_def using \<open>V3 \<subseteq> U\<close> \<open>\<qq> \<in> V3\<close> by auto
       show "f3 \<notin> \<qq>" using that unfolding V3_def f3_def
         using \<open>f1 \<in> R\<close> \<open>f1 \<notin> \<qq>\<close> \<open>f2 \<in> R\<close> \<open>f2 \<notin> \<qq>\<close> q.sub_composition_closed by auto
     qed
     ultimately show ?thesis using is_locally_frac_def by metis
   qed
   ultimately show ?thesis unfolding is_regular_def is_locally_frac_def by meson
 qed
 
 lemma mult_sheaf_spec_in_sheaf_spec:
   assumes "s \<in> \<O> U" and "t \<in> \<O> U" and "U \<subseteq> Spec"
   shows "mult_sheaf_spec U s t \<in> \<O> U"
 proof -
   have "mult_sheaf_spec U s t \<pp> \<in> R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>"
       if "\<pp> \<in> U" for \<pp>
   proof -
     interpret qr:quotient_ring "(R\<setminus>\<pp>)" R "(+)" "(\<cdot>)" \<zero> \<one>
       apply (rule spectrum_imp_cxt_quotient_ring)
       using that \<open>U \<subseteq> Spec\<close> by auto
     interpret pi:pr_ideal R \<pp> "(+)" "(\<cdot>)" \<zero> \<one>
       using that \<open>U \<subseteq> Spec\<close> by (auto intro:spectrum_imp_pr)
     have "qr.valid_frac (s \<pp>)" "qr.valid_frac (t \<pp>)"
       using sec_has_right_codom[OF _ that] \<open>s \<in> \<O> U\<close> \<open>t \<in> \<O> U\<close>
       by (auto simp:pi.carrier_local_ring_at_def)
     then show ?thesis
       using that unfolding mult_sheaf_spec_def pi.carrier_local_ring_at_def
       by auto
   qed
   moreover have "is_regular (mult_sheaf_spec U s t) U"
     using \<open>s \<in> \<O> U\<close> \<open>t \<in> \<O> U\<close> \<open>U \<subseteq> Spec\<close> is_regular_mult_sheaf_spec
     unfolding sheaf_spec_def by auto
   moreover have "mult_sheaf_spec U s t \<in> extensional U"
     unfolding mult_sheaf_spec_def by auto
   ultimately show ?thesis
     unfolding sheaf_spec_def by (simp add: PiE_iff)
 qed
 
 definition uminus_sheaf_spec::"('a set) set \<Rightarrow> ('a set \<Rightarrow> ('a \<times> 'a) set) \<Rightarrow> ('a set \<Rightarrow> ('a \<times> 'a) set)"
   where "uminus_sheaf_spec U s \<equiv> \<lambda>\<pp>\<in>U. quotient_ring.uminus_rel (R \<setminus> \<pp>) R (+) (\<cdot>) \<zero> (s \<pp>) "
 
 lemma is_regular_uminus_sheaf_spec:
   assumes "is_regular s U" and "U \<subseteq> Spec"
   shows "is_regular (uminus_sheaf_spec U s) U"
 proof -
   have "uminus_sheaf_spec U s \<pp> \<in> R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>" if "\<pp> \<in> U" for \<pp>
   proof -
     interpret pi: pr_ideal R \<pp> "(+)" "(\<cdot>)" \<zero> \<one>
       using \<open>U \<subseteq> Spec\<close>[unfolded spectrum_def] \<open>\<pp> \<in> U\<close> by blast
     interpret qr:quotient_ring "(R\<setminus>\<pp>)"
       by (simp add: quotient_ring_def local.comm_ring_axioms pi.submonoid_pr_ideal)
 
     have "s \<pp> \<in> pi.carrier_local_ring_at"
       using \<open>is_regular s U\<close>
       unfolding is_regular_def using that
       using assms(2) frac_in_carrier_local in_mono is_locally_frac_def by fastforce
     then show ?thesis
       unfolding uminus_sheaf_spec_def pi.carrier_local_ring_at_def using that
       by simp
   qed
   moreover have "(\<exists>V\<subseteq>U. is_zariski_open V \<and> \<pp> \<in> V \<and> is_locally_frac (uminus_sheaf_spec U s) V)"
     if "\<pp> \<in> U" for \<pp>
   proof -
     obtain V1 r1 f1 where "V1 \<subseteq>U" "is_zariski_open V1" "\<pp> \<in> V1" "r1 \<in> R" "f1 \<in> R" and
         q_V1:"(\<forall>\<qq>. \<qq> \<in> V1 \<longrightarrow> f1 \<notin> \<qq> \<and> s \<qq> = quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> r1 f1)"
       using \<open>is_regular s U\<close>[unfolded is_regular_def] \<open>\<pp> \<in> U\<close> unfolding is_locally_frac_def
       by auto
 
     define V3 where "V3 = V1 "
     define r3 where "r3 = additive.inverse r1"
     define f3 where "f3 = f1"
     have "V3 \<subseteq>U" "\<pp> \<in> V3" "r3 \<in> R" "f3 \<in> R"
       unfolding V3_def r3_def f3_def
       using \<open>V1 \<subseteq> U\<close> \<open>\<pp> \<in> V1\<close> \<open>f1 \<in> R\<close>  \<open>r1 \<in> R\<close> by blast+
     moreover have "is_zariski_open V3"
       using topological_space.open_inter by (simp add: V3_def \<open>is_zariski_open V1\<close>)
     moreover have "f3 \<notin> \<qq>"
         "uminus_sheaf_spec U s \<qq> = quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> r3 f3"
         if "\<qq> \<in> V3" for \<qq>
     proof -
       interpret q:quotient_ring "R\<setminus>\<qq>" R "(+)" "(\<cdot>)" \<zero>
         using \<open>U \<subseteq> Spec\<close> \<open>V3 \<subseteq> U\<close> \<open>\<qq> \<in> V3\<close> quotient_ring_def local.comm_ring_axioms
           pr_ideal.submonoid_pr_ideal spectrum_def
         by fastforce
       have "f1 \<notin> \<qq>" "s \<qq> = q.frac r1 f1"
         using q_V1 \<open>\<qq> \<in> V3\<close>  unfolding V3_def by auto
 
       have "q.uminus_rel (q.frac r1 f1) = q.frac (additive.inverse r1) f1"
         apply (rule q.uminus_rel_frac)
         by (simp add: \<open>f1 \<in> R\<close> \<open>f1 \<notin> \<qq>\<close> \<open>r1 \<in> R\<close>)
       then have "q.uminus_rel (s \<qq>) = q.frac r3 f3"
         unfolding r3_def f3_def using \<open>s \<qq> = q.frac r1 f1\<close> by auto
       then show "uminus_sheaf_spec U s \<qq> = q.frac r3 f3"
         unfolding uminus_sheaf_spec_def using \<open>V3 \<subseteq> U\<close> \<open>\<qq> \<in> V3\<close> by auto
       show "f3 \<notin> \<qq>" using that unfolding V3_def f3_def
         using \<open>f1 \<in> R\<close> \<open>f1 \<notin> \<qq>\<close> q.sub_composition_closed by auto
     qed
     ultimately show ?thesis using is_locally_frac_def by metis
   qed
   ultimately show ?thesis unfolding is_regular_def is_locally_frac_def by meson
 qed
 
 lemma uminus_sheaf_spec_in_sheaf_spec:
   assumes "s \<in> \<O> U" and "U \<subseteq> Spec"
   shows "uminus_sheaf_spec U s \<in> \<O> U"
 proof -
   have "uminus_sheaf_spec U s \<pp> \<in> R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>"
       if "\<pp> \<in> U" for \<pp>
   proof -
     interpret qr:quotient_ring "(R\<setminus>\<pp>)" R "(+)" "(\<cdot>)" \<zero> \<one>
       apply (rule spectrum_imp_cxt_quotient_ring)
       using that \<open>U \<subseteq> Spec\<close> by auto
     interpret pi:pr_ideal R \<pp> "(+)" "(\<cdot>)" \<zero> \<one>
       using that \<open>U \<subseteq> Spec\<close> by (auto intro:spectrum_imp_pr)
     have "qr.valid_frac (s \<pp>)"
       using sec_has_right_codom[OF _ that] \<open>s \<in> \<O> U\<close>
       by (auto simp:pi.carrier_local_ring_at_def)
     then show ?thesis
       using that unfolding uminus_sheaf_spec_def pi.carrier_local_ring_at_def
       by auto
   qed
   moreover have "is_regular (uminus_sheaf_spec U s) U"
     using \<open>s \<in> \<O> U\<close>  \<open>U \<subseteq> Spec\<close> is_regular_uminus_sheaf_spec
     unfolding sheaf_spec_def by auto
   moreover have "uminus_sheaf_spec U s \<in> extensional U"
     unfolding uminus_sheaf_spec_def by auto
   ultimately show ?thesis
     unfolding sheaf_spec_def by (simp add: PiE_iff)
 qed
 
 definition zero_sheaf_spec:: "'a set set \<Rightarrow> ('a set \<Rightarrow> ('a \<times> 'a) set)"
   where "zero_sheaf_spec U \<equiv> \<lambda>\<pp>\<in>U. quotient_ring.zero_rel (R \<setminus> \<pp>) R (+) (\<cdot>) \<zero> \<one>"
 
 lemma is_regular_zero_sheaf_spec:
   assumes "is_zariski_open U"
   shows "is_regular (zero_sheaf_spec U) U"
 proof -
   have "zero_sheaf_spec U \<pp> \<in> R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>" if "\<pp> \<in> U" for \<pp>
     unfolding zero_sheaf_spec_def
     using assms comm_ring.frac_in_carrier_local local.comm_ring_axioms pr_ideal.not_1 
           quotient_ring.zero_rel_def spectrum_imp_cxt_quotient_ring spectrum_imp_pr subsetD that 
           zariski_top_space.open_imp_subset by fastforce
   moreover have "(\<exists>V\<subseteq>U. is_zariski_open V \<and> \<pp> \<in> V \<and> is_locally_frac (zero_sheaf_spec U) V)"
     if "\<pp> \<in> U" for \<pp>
   proof -
     define V3 where "V3 = U"
     define r3 where "r3 = \<zero> "
     define f3 where "f3 = \<one>"
     have "V3 \<subseteq>U" "\<pp> \<in> V3" "r3 \<in> R" "f3 \<in> R"
       unfolding V3_def r3_def f3_def using that by auto
     moreover have "is_zariski_open V3" using assms by (simp add: V3_def)
     moreover have "f3 \<notin> \<qq>"
         "zero_sheaf_spec U \<qq> = quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> r3 f3"
         if "\<qq> \<in> V3" for \<qq>
       subgoal using V3_def assms f3_def pr_ideal.submonoid_pr_ideal spectrum_def
           submonoid.sub_unit_closed that zariski_open_is_subset by fastforce
       subgoal
       proof -
         interpret q:quotient_ring "R\<setminus>\<qq>" R
           using V3_def assms quotient_ring_def local.comm_ring_axioms
             pr_ideal.submonoid_pr_ideal spectrum_def that zariski_open_is_subset by fastforce
         show ?thesis unfolding zero_sheaf_spec_def
           using V3_def f3_def q.zero_rel_def r3_def that by auto
       qed
       done
     ultimately show ?thesis using is_locally_frac_def  by metis
   qed
   ultimately show ?thesis unfolding is_regular_def is_locally_frac_def  by meson
 qed
 
 lemma zero_sheaf_spec_in_sheaf_spec:
   assumes "is_zariski_open U"
   shows "zero_sheaf_spec U \<in> \<O> U"
 proof -
   have "zero_sheaf_spec U \<pp> \<in> R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>"if "\<pp> \<in> U" for \<pp>
   proof -
     interpret qr:quotient_ring "(R\<setminus>\<pp>)" R "(+)" "(\<cdot>)" \<zero> \<one>
       by (meson assms comm_ring.zariski_open_is_subset local.comm_ring_axioms
           spectrum_imp_cxt_quotient_ring subsetD that)
     interpret pi:pr_ideal R \<pp> "(+)" "(\<cdot>)" \<zero> \<one>
       by (meson assms spectrum_imp_pr subsetD that zariski_open_is_subset)
     show ?thesis unfolding zero_sheaf_spec_def pi.carrier_local_ring_at_def
       using that by auto
   qed
   moreover have "is_regular (zero_sheaf_spec U) U"
     using is_regular_zero_sheaf_spec assms by auto
   moreover have "zero_sheaf_spec U \<in> extensional U"
     by (simp add: zero_sheaf_spec_def)
   ultimately show ?thesis unfolding sheaf_spec_def by (simp add: PiE_iff)
 qed
 
 definition one_sheaf_spec:: "'a set set \<Rightarrow> ('a set \<Rightarrow> ('a \<times> 'a) set)"
   where "one_sheaf_spec U \<equiv> \<lambda>\<pp>\<in>U. quotient_ring.one_rel (R \<setminus> \<pp>) R (+) (\<cdot>) \<zero> \<one>"
 
 lemma is_regular_one_sheaf_spec:
   assumes "is_zariski_open U"
   shows "is_regular (one_sheaf_spec U) U"
 proof -
   have "one_sheaf_spec U \<pp> \<in> R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>" if "\<pp> \<in> U" for \<pp>
     unfolding one_sheaf_spec_def
     by (smt assms closed_subsets_zero comm_ring.closed_subsets_def
         quotient_ring.carrier_quotient_ring_iff quotient_ring.valid_frac_one
         quotient_ring_def local.comm_ring_axioms mem_Collect_eq
         pr_ideal.carrier_local_ring_at_def pr_ideal.submonoid_pr_ideal
         restrict_apply subsetD that zariski_open_is_subset)
   moreover have "(\<exists>V\<subseteq>U. is_zariski_open V \<and> \<pp> \<in> V \<and> is_locally_frac (one_sheaf_spec U) V)"
     if "\<pp> \<in> U" for \<pp>
   proof -
     define V3 where "V3 = U"
     define r3 where "r3 = \<one>"
     define f3 where "f3 = \<one>"
     have "V3 \<subseteq>U" "\<pp> \<in> V3" "r3 \<in> R" "f3 \<in> R"
       unfolding V3_def r3_def f3_def using that by auto
     moreover have "is_zariski_open V3" using assms by (simp add: V3_def)
     moreover have "f3 \<notin> \<qq>"
         "one_sheaf_spec U \<qq> = quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> r3 f3"
         if "\<qq> \<in> V3" for \<qq>
       subgoal using V3_def assms f3_def pr_ideal.submonoid_pr_ideal spectrum_def
           submonoid.sub_unit_closed that zariski_open_is_subset by fastforce
       subgoal
       proof -
         interpret q:quotient_ring "R\<setminus>\<qq>" R
           using V3_def assms quotient_ring_def local.comm_ring_axioms
             pr_ideal.submonoid_pr_ideal spectrum_def that zariski_open_is_subset by fastforce
         show ?thesis unfolding one_sheaf_spec_def
           using V3_def f3_def q.one_rel_def r3_def that by auto
       qed
       done
     ultimately show ?thesis using is_locally_frac_def by metis
   qed
   ultimately show ?thesis unfolding is_regular_def is_locally_frac_def by meson
 qed
 
 lemma one_sheaf_spec_in_sheaf_spec:
   assumes "is_zariski_open U"
   shows "one_sheaf_spec U \<in> \<O> U"
 proof -
   have "one_sheaf_spec U \<pp> \<in> R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>"if "\<pp> \<in> U" for \<pp>
   proof -
     interpret qr:quotient_ring "(R\<setminus>\<pp>)" R "(+)" "(\<cdot>)" \<zero> \<one>
       by (meson assms comm_ring.zariski_open_is_subset local.comm_ring_axioms
           spectrum_imp_cxt_quotient_ring subsetD that)
     interpret pi:pr_ideal R \<pp> "(+)" "(\<cdot>)" \<zero> \<one>
       by (meson assms spectrum_imp_pr subsetD that zariski_open_is_subset)
     show ?thesis unfolding one_sheaf_spec_def pi.carrier_local_ring_at_def
       using that by auto
   qed
   moreover have "is_regular (one_sheaf_spec U) U"
     using is_regular_one_sheaf_spec assms by auto
   moreover have "one_sheaf_spec U \<in> extensional U"
     by (simp add: one_sheaf_spec_def)
   ultimately show ?thesis unfolding sheaf_spec_def by (simp add: PiE_iff)
 qed
 
 lemma zero_sheaf_spec_extensional[simp]:
   "zero_sheaf_spec U \<in> extensional U"
   unfolding zero_sheaf_spec_def by simp
 
 lemma one_sheaf_spec_extensional[simp]:
   "one_sheaf_spec U \<in> extensional U"
   unfolding one_sheaf_spec_def by simp
 
 lemma add_sheaf_spec_extensional[simp]:
   "add_sheaf_spec U a b \<in> extensional U"
   unfolding add_sheaf_spec_def by simp
 
 lemma mult_sheaf_spec_extensional[simp]:
   "mult_sheaf_spec U a b \<in> extensional U"
   unfolding mult_sheaf_spec_def by simp
 
 lemma sheaf_spec_extensional[simp]:
   "a \<in> \<O> U \<Longrightarrow> a \<in> extensional U"
   unfolding sheaf_spec_def by (simp add: PiE_iff Set_Theory.map_def)
 
 lemma sheaf_spec_on_open_is_comm_ring:
   assumes "is_zariski_open U"
   shows "comm_ring (\<O> U) (add_sheaf_spec U) (mult_sheaf_spec U) (zero_sheaf_spec U) (one_sheaf_spec U)"
 proof unfold_locales
   show add_\<O>:"add_sheaf_spec U a b \<in> \<O> U"
     and "mult_sheaf_spec U a b \<in> \<O> U"
     if "a \<in> \<O> U" "b \<in> \<O> U" for a b
     subgoal by (simp add: add_sheaf_spec_in_sheaf_spec assms that(1,2) zariski_open_is_subset)
     subgoal by (simp add: assms mult_sheaf_spec_in_sheaf_spec that(1,2) zariski_open_is_subset)
     done
   show "zero_sheaf_spec U \<in> \<O> U" "one_sheaf_spec U \<in> \<O> U"
     subgoal by (simp add: assms zero_sheaf_spec_in_sheaf_spec)
     subgoal by (simp add: assms one_sheaf_spec_in_sheaf_spec)
     done
 
   have imp_qr:"quotient_ring (R\<setminus>\<pp>) R (+) (\<cdot>) \<zero> \<one>" if "\<pp> \<in> U" for \<pp>
     using that
     by (meson assms comm_ring.spectrum_imp_cxt_quotient_ring in_mono local.comm_ring_axioms
           zariski_open_is_subset)
   have qr_valid_frac:"quotient_ring.valid_frac (R\<setminus>\<pp>) R (+) (\<cdot>) \<zero> (s \<pp>)"
       if "s \<in> \<O> U" "\<pp> \<in> U" for s \<pp>
     using assms comm_ring.zariski_open_is_subset quotient_ring.carrier_quotient_ring_iff
       imp_qr local.comm_ring_axioms pr_ideal.carrier_local_ring_at_def sec_has_right_codom
       spectrum_imp_pr that(1) that(2) by fastforce
 
   show add_zero:"add_sheaf_spec U (zero_sheaf_spec U) a = a" if "a \<in> \<O> U" for a
   proof -
     have "add_sheaf_spec U (zero_sheaf_spec U) a \<pp> = a \<pp>" if "\<pp> \<in> U" for \<pp>
     proof -
       interpret cq:quotient_ring "R\<setminus>\<pp>" R "(+)" "(\<cdot>)" \<zero> \<one>
         using imp_qr that by auto
       show ?thesis unfolding add_sheaf_spec_def zero_sheaf_spec_def
         using that by (simp add: \<open>a \<in> \<O> U\<close> qr_valid_frac)
     qed
     then show "add_sheaf_spec U (zero_sheaf_spec U) a = a"
       using that by(auto intro: extensionalityI[where A=U])
   qed
   show add_assoc:"add_sheaf_spec U (add_sheaf_spec U a b) c
       = add_sheaf_spec U a (add_sheaf_spec U b c)"
     if "a \<in> \<O> U" and "b \<in> \<O> U" and "c \<in> \<O> U"
     for a b c
   proof (rule extensionalityI)
     fix \<pp> assume "\<pp> \<in> U"
     interpret cq:quotient_ring "R\<setminus>\<pp>" R "(+)" "(\<cdot>)" \<zero> \<one> using \<open>\<pp> \<in> U\<close> imp_qr by auto
     show "add_sheaf_spec U (add_sheaf_spec U a b) c \<pp> = add_sheaf_spec U a (add_sheaf_spec U b c) \<pp>"
       unfolding add_sheaf_spec_def using \<open>\<pp> \<in> U\<close>
       by (simp add: cq.additive.associative qr_valid_frac that(1) that(2) that(3))
   qed (auto simp add:add_sheaf_spec_def)
   show add_comm:"add_sheaf_spec U x y = add_sheaf_spec U y x"
     if "x \<in> \<O> U" and "y \<in> \<O> U" for x y
   proof (rule extensionalityI)
     fix \<pp> assume "\<pp> \<in> U"
     interpret cq:quotient_ring "R\<setminus>\<pp>" R "(+)" "(\<cdot>)" \<zero> \<one> using \<open>\<pp> \<in> U\<close> imp_qr by auto
     show " add_sheaf_spec U x y \<pp> = add_sheaf_spec U y x \<pp>"
       unfolding add_sheaf_spec_def using \<open>\<pp> \<in> U\<close>
       by (simp add: cq.additive.commutative qr_valid_frac that(1) that(2))
   qed auto
   show mult_comm:"mult_sheaf_spec U x y = mult_sheaf_spec U y x"
     if "x \<in> \<O> U" and "y \<in> \<O> U" for x y
   proof (rule extensionalityI)
     fix \<pp> assume "\<pp> \<in> U"
     interpret cq:quotient_ring "R\<setminus>\<pp>" R "(+)" "(\<cdot>)" \<zero> \<one> using \<open>\<pp> \<in> U\<close> imp_qr by auto
     show "mult_sheaf_spec U x y \<pp> = mult_sheaf_spec U y x \<pp>"
       unfolding mult_sheaf_spec_def using \<open>\<pp> \<in> U\<close>
       by (simp add: cq.comm_mult qr_valid_frac that(1) that(2))
   qed auto
   show add_zero:"add_sheaf_spec U a (zero_sheaf_spec U) = a"
       if "a \<in> \<O> U" for a
     using add_zero add_comm that by (simp add: \<open>zero_sheaf_spec U \<in> \<O> U\<close>)
 
   show "mult_sheaf_spec U (mult_sheaf_spec U a b) c = mult_sheaf_spec U a (mult_sheaf_spec U b c)"
     if "a \<in> \<O> U" and "b \<in> \<O> U"
       and "c \<in> \<O> U"
     for a b c
   proof (rule extensionalityI)
     fix \<pp> assume "\<pp> \<in> U"
     interpret cq:quotient_ring "R\<setminus>\<pp>" R "(+)" "(\<cdot>)" \<zero> \<one> using \<open>\<pp> \<in> U\<close> imp_qr by auto
     show "mult_sheaf_spec U (mult_sheaf_spec U a b) c \<pp>
                 = mult_sheaf_spec U a (mult_sheaf_spec U b c) \<pp>"
       unfolding mult_sheaf_spec_def using \<open>\<pp> \<in> U\<close>
       by (simp add: cq.multiplicative.associative qr_valid_frac that(1) that(2) that(3))
   qed (auto simp add:add_sheaf_spec_def)
 
   show "mult_sheaf_spec U (one_sheaf_spec U) a = a"
     if "a \<in> \<O> U" for a
   proof (rule extensionalityI)
     fix \<pp> assume "\<pp> \<in> U"
     interpret cq:quotient_ring "R\<setminus>\<pp>" R "(+)" "(\<cdot>)" \<zero> \<one> using \<open>\<pp> \<in> U\<close> imp_qr by auto
     show "mult_sheaf_spec U (one_sheaf_spec U) a \<pp> = a \<pp>"
       unfolding mult_sheaf_spec_def using \<open>\<pp> \<in> U\<close>
       by (simp add: one_sheaf_spec_def qr_valid_frac that)
   qed (auto simp add: \<open>a \<in> \<O> U\<close>)
   then show "mult_sheaf_spec U a (one_sheaf_spec U) = a"
     if "a \<in> \<O> U" for a
     by (simp add: \<open>one_sheaf_spec U \<in> \<O> U\<close> mult_comm that)
 
   show "mult_sheaf_spec U a (add_sheaf_spec U b c)
           = add_sheaf_spec U (mult_sheaf_spec U a b) (mult_sheaf_spec U a c)"
     if "a \<in> \<O> U" and "b \<in> \<O> U" and "c \<in> \<O> U" for a b c
   proof (rule extensionalityI)
     fix \<pp> assume "\<pp> \<in> U"
     interpret cq:quotient_ring "R\<setminus>\<pp>" R "(+)" "(\<cdot>)" \<zero> \<one> using \<open>\<pp> \<in> U\<close> imp_qr by auto
     show "mult_sheaf_spec U a (add_sheaf_spec U b c) \<pp> =
          add_sheaf_spec U (mult_sheaf_spec U a b) (mult_sheaf_spec U a c) \<pp>"
       unfolding mult_sheaf_spec_def add_sheaf_spec_def
       by (simp add: cq.distributive(1) qr_valid_frac that(1) that(2) that(3))
   qed auto
   then show "mult_sheaf_spec U (add_sheaf_spec U b c) a
                 = add_sheaf_spec U (mult_sheaf_spec U b a) (mult_sheaf_spec U c a)"
     if "a \<in> \<O> U" and "b \<in> \<O> U" and "c \<in> \<O> U" for a b c
     by (simp add: add_\<O> mult_comm that(1) that(2) that(3))
   show "monoid.invertible (\<O> U) (add_sheaf_spec U) (zero_sheaf_spec U) u"
     if "u \<in> \<O> U" for u
   proof (rule monoid.invertibleI)
     show "Group_Theory.monoid (\<O> U) (add_sheaf_spec U) (zero_sheaf_spec U)"
       apply unfold_locales
       using add_\<O> \<open>zero_sheaf_spec U \<in> \<O> U\<close> add_assoc \<open>zero_sheaf_spec U \<in> \<O> U\<close>
         add_comm add_zero  add_zero
       by simp_all
     show "add_sheaf_spec U u (uminus_sheaf_spec U u) = zero_sheaf_spec U"
     proof (rule extensionalityI)
       fix \<pp> assume "\<pp> \<in> U"
       interpret cq:quotient_ring "R\<setminus>\<pp>" R "(+)" "(\<cdot>)" \<zero> \<one> using \<open>\<pp> \<in> U\<close> imp_qr by auto
 
       have "cq.add_rel (u \<pp>) (cq.uminus_rel (u \<pp>)) = cq.zero_rel"
         by (simp add: \<open>\<pp> \<in> U\<close> cq.add_minus_zero_rel qr_valid_frac that)
       then show "add_sheaf_spec U u (uminus_sheaf_spec U u) \<pp> = zero_sheaf_spec U \<pp>"
         unfolding add_sheaf_spec_def uminus_sheaf_spec_def zero_sheaf_spec_def
         using \<open>\<pp> \<in> U\<close> by simp
     qed auto
     then show "add_sheaf_spec U (uminus_sheaf_spec U u) u = zero_sheaf_spec U"
       by (simp add: add_comm assms comm_ring.zariski_open_is_subset local.comm_ring_axioms
           that uminus_sheaf_spec_in_sheaf_spec)
     show "u \<in> \<O> U" using that .
     show "uminus_sheaf_spec U u \<in> \<O> U"
       by (simp add: assms comm_ring.zariski_open_is_subset local.comm_ring_axioms
             that uminus_sheaf_spec_in_sheaf_spec)
   qed
 qed
 
 definition sheaf_spec_morphisms::
 "'a set set \<Rightarrow> 'a set set \<Rightarrow> (('a set \<Rightarrow> ('a \<times> 'a) set) \<Rightarrow> ('a set \<Rightarrow> ('a \<times> 'a) set))"
 where "sheaf_spec_morphisms U V \<equiv> \<lambda>s\<in>(\<O> U). restrict s V"
 
 lemma sheaf_morphisms_sheaf_spec:
   assumes "s \<in> \<O> U"
   shows "sheaf_spec_morphisms U U s = s"
   using assms sheaf_spec_def restrict_on_source sheaf_spec_morphisms_def
   by auto
 
 lemma sheaf_spec_morphisms_are_maps:
   assumes (*this assumption seems redundant: "is_zariski_open U" and*)
     "is_zariski_open V" and "V \<subseteq> U"
   shows "Set_Theory.map (sheaf_spec_morphisms U V) (\<O> U) (\<O> V)"
 proof -
   have "sheaf_spec_morphisms U V \<in> extensional (\<O> U)"
     unfolding sheaf_spec_morphisms_def by auto
   moreover have "sheaf_spec_morphisms U V \<in> (\<O> U) \<rightarrow> (\<O> V)"
     unfolding sheaf_spec_morphisms_def
   proof
     fix s assume "s \<in> \<O> U"
     then have "s \<in> (\<Pi>\<^sub>E \<pp>\<in>U. R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>)"
         and p:"\<forall>\<pp>. \<pp> \<in> U \<longrightarrow> (\<exists>V. is_zariski_open V \<and> V \<subseteq> U \<and> \<pp> \<in> V \<and> is_locally_frac s V)"
       unfolding sheaf_spec_def is_regular_def by auto
     have "restrict s V \<in> (\<Pi>\<^sub>E \<pp>\<in>V. R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>)"
       using \<open>s \<in> (\<Pi>\<^sub>E \<pp>\<in>U. R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>)\<close> using \<open>V \<subseteq> U\<close> by auto
     moreover have "(\<exists>Va. is_zariski_open Va \<and> Va \<subseteq> V \<and> \<pp> \<in> Va \<and> is_locally_frac (restrict s V) Va)"
       if "\<pp> \<in> V" for \<pp>
     proof -
       obtain U1 where "is_zariski_open U1" "U1 \<subseteq> U" "\<pp> \<in> U1" "is_locally_frac s U1"
         using p[rule_format, of \<pp>] that \<open>V \<subseteq> U\<close> \<open>\<pp> \<in> V\<close> by auto
       define V1 where "V1 = U1 \<inter> V"
       have "is_zariski_open V1"
         using \<open>is_zariski_open V\<close> \<open>is_zariski_open U1\<close> by (simp add: V1_def)
       moreover have "is_locally_frac s V1"
         using is_locally_frac_subset[OF \<open>is_locally_frac s U1\<close>] unfolding V1_def by simp
       then have "is_locally_frac (restrict s V) V1"
         unfolding restrict_def V1_def using is_locally_frac_cong by (smt in_mono inf_le2)
       moreover have "V1 \<subseteq> V" "\<pp> \<in> V1"
         unfolding V1_def using \<open>V \<subseteq> U\<close> \<open>\<pp> \<in> U1\<close> that by auto
       ultimately show ?thesis by auto
     qed
     ultimately show "restrict s V \<in> \<O> V"
       unfolding sheaf_spec_def is_regular_def by auto
   qed
   ultimately show ?thesis
     by (simp add: extensional_funcset_def map.intro)
 qed
 
 lemma sheaf_spec_morphisms_are_ring_morphisms:
   assumes U: "is_zariski_open U" and V: "is_zariski_open V" and "V \<subseteq> U"
   shows "ring_homomorphism (sheaf_spec_morphisms U V)
                            (\<O> U) (add_sheaf_spec U) (mult_sheaf_spec U) (zero_sheaf_spec U) (one_sheaf_spec U)
                            (\<O> V) (add_sheaf_spec V) (mult_sheaf_spec V) (zero_sheaf_spec V) (one_sheaf_spec V)"
 proof intro_locales
   show "Set_Theory.map (sheaf_spec_morphisms U V) (\<O> U) (\<O> V)"
     by (simp add: assms sheaf_spec_morphisms_are_maps)
   show "Group_Theory.monoid (\<O> U) (add_sheaf_spec U) (zero_sheaf_spec U)"
     using sheaf_spec_on_open_is_comm_ring [OF U]
     by (auto simp: comm_ring_def ring_def abelian_group_def commutative_monoid_def)
   show "Group_Theory.group_axioms (\<O> U) (add_sheaf_spec U) (zero_sheaf_spec U)"
     using sheaf_spec_on_open_is_comm_ring [OF U]
     by (auto simp: comm_ring_def ring_def abelian_group_def commutative_monoid_def group_def)
   show "commutative_monoid_axioms (\<O> U) (add_sheaf_spec U)"
     using sheaf_spec_on_open_is_comm_ring [OF U]
     by (auto simp: comm_ring_def ring_def abelian_group_def commutative_monoid_def group_def)
   show "Group_Theory.monoid (\<O> U) (mult_sheaf_spec U) (one_sheaf_spec U)"
     by (meson U comm_ring_def ring_def sheaf_spec_on_open_is_comm_ring)
   show "ring_axioms (\<O> U) (add_sheaf_spec U) (mult_sheaf_spec U)"
     by (meson U comm_ring.axioms(1) ring_def sheaf_spec_on_open_is_comm_ring)
   show "Group_Theory.monoid (\<O> V) (add_sheaf_spec V) (zero_sheaf_spec V)"
     using sheaf_spec_on_open_is_comm_ring [OF V]
     by (auto simp: comm_ring_def ring_def abelian_group_def commutative_monoid_def)
   show "Group_Theory.group_axioms (\<O> V) (add_sheaf_spec V) (zero_sheaf_spec V)"
     using sheaf_spec_on_open_is_comm_ring [OF V]
     by (auto simp: comm_ring_def ring_def abelian_group_def commutative_monoid_def group_def)
   show "commutative_monoid_axioms (\<O> V) (add_sheaf_spec V)"
     using sheaf_spec_on_open_is_comm_ring [OF V]
     by (auto simp: comm_ring_def ring_def abelian_group_def commutative_monoid_def group_def)
   show "Group_Theory.monoid (\<O> V) (mult_sheaf_spec V) (one_sheaf_spec V)"
     by (meson V comm_ring.axioms(1) ring_def sheaf_spec_on_open_is_comm_ring)
   show "ring_axioms (\<O> V) (add_sheaf_spec V) (mult_sheaf_spec V)"
     by (meson V comm_ring_def ring_def sheaf_spec_on_open_is_comm_ring)
   show "monoid_homomorphism_axioms (sheaf_spec_morphisms U V) (\<O> U)
               (add_sheaf_spec U) (zero_sheaf_spec U) (add_sheaf_spec V) (zero_sheaf_spec V)"
   proof
     fix x y
     assume xy: "x \<in> \<O> U" "y \<in> \<O> U"
     have "sheaf_spec_morphisms U V (add_sheaf_spec U x y) = restrict (add_sheaf_spec U x y) V"
       by (simp add: U add_sheaf_spec_in_sheaf_spec comm_ring.zariski_open_is_subset local.comm_ring_axioms sheaf_spec_morphisms_def xy)
     also have "... = add_sheaf_spec V (restrict x V) (restrict y V)"
       using add_sheaf_spec_def \<open>V \<subseteq> U\<close> by force
     also have "... = add_sheaf_spec V (sheaf_spec_morphisms U V x) (sheaf_spec_morphisms U V y)"
       by (simp add: sheaf_spec_morphisms_def xy)
     finally show "sheaf_spec_morphisms U V (add_sheaf_spec U x y) = add_sheaf_spec V (sheaf_spec_morphisms U V x) (sheaf_spec_morphisms U V y)" .
   next
     have "sheaf_spec_morphisms U V (zero_sheaf_spec U) = restrict (zero_sheaf_spec U) V"
       by (simp add: U comm_ring.sheaf_spec_morphisms_def local.comm_ring_axioms zero_sheaf_spec_in_sheaf_spec)
     also have "... = zero_sheaf_spec V"
       by (metis FuncSet.restrict_restrict assms(3) inf.absorb_iff2 zero_sheaf_spec_def)
     finally show "sheaf_spec_morphisms U V (zero_sheaf_spec U) = zero_sheaf_spec V" .
   qed
   show "monoid_homomorphism_axioms (sheaf_spec_morphisms U V) (\<O> U)
               (mult_sheaf_spec U) (one_sheaf_spec U) (mult_sheaf_spec V) (one_sheaf_spec V)"
   proof
     fix x y
     assume xy: "x \<in> \<O> U" "y \<in> \<O> U"
         have "sheaf_spec_morphisms U V (mult_sheaf_spec U x y) = restrict (mult_sheaf_spec U x y) V"
       by (simp add: U mult_sheaf_spec_in_sheaf_spec comm_ring.zariski_open_is_subset local.comm_ring_axioms sheaf_spec_morphisms_def xy)
     also have "... = mult_sheaf_spec V (restrict x V) (restrict y V)"
       using mult_sheaf_spec_def \<open>V \<subseteq> U\<close> by force
     also have "... = mult_sheaf_spec V (sheaf_spec_morphisms U V x) (sheaf_spec_morphisms U V y)"
       by (simp add: sheaf_spec_morphisms_def xy)
     finally show "sheaf_spec_morphisms U V (mult_sheaf_spec U x y) = mult_sheaf_spec V (sheaf_spec_morphisms U V x) (sheaf_spec_morphisms U V y)" .
   next
     have "sheaf_spec_morphisms U V (one_sheaf_spec U) = restrict (one_sheaf_spec U) V"
       by (simp add: U comm_ring.sheaf_spec_morphisms_def local.comm_ring_axioms one_sheaf_spec_in_sheaf_spec)
     also have "... = one_sheaf_spec V"
       by (metis FuncSet.restrict_restrict assms(3) inf.absorb_iff2 one_sheaf_spec_def)
     finally show "sheaf_spec_morphisms U V (one_sheaf_spec U) = one_sheaf_spec V" .
   qed
 qed
 
 lemma sheaf_spec_is_presheaf:
   shows "presheaf_of_rings Spec is_zariski_open sheaf_spec sheaf_spec_morphisms \<O>b
 add_sheaf_spec mult_sheaf_spec zero_sheaf_spec one_sheaf_spec"
 proof intro_locales
   have "sheaf_spec {} = {\<O>b}"
   proof
     show "{\<O>b} \<subseteq> \<O> {}"
       using undefined_is_map_on_empty map_on_empty_is_regular sheaf_spec_def \<O>_on_emptyset by auto
     thus "\<O> {} \<subseteq> {\<O>b}"
       using sheaf_spec_def sheaf_spec_of_empty_is_singleton by auto
   qed
   moreover have "\<And>U. is_zariski_open U \<Longrightarrow> (\<And>s. s \<in> (\<O> U) \<Longrightarrow> sheaf_spec_morphisms U U s = s)"
     using sheaf_spec_morphisms_def sheaf_morphisms_sheaf_spec by simp
   moreover have "sheaf_spec_morphisms U W s = (sheaf_spec_morphisms V W \<circ> sheaf_spec_morphisms U V) s"
     if "is_zariski_open U" "is_zariski_open V" "is_zariski_open W" "V \<subseteq> U" "W \<subseteq> V" and "s \<in> \<O> U"
     for U V W s
   proof -
     have "restrict s V \<in> \<O> V"
       using that by (smt map.map_closed restrict_apply sheaf_spec_morphisms_are_maps sheaf_spec_morphisms_def)
     with that show ?thesis
       by (simp add: sheaf_spec_morphisms_def inf_absorb2)
   qed
   ultimately show "presheaf_of_rings_axioms is_zariski_open sheaf_spec
                     sheaf_spec_morphisms \<O>b add_sheaf_spec mult_sheaf_spec zero_sheaf_spec one_sheaf_spec"
     unfolding presheaf_of_rings_def presheaf_of_rings_axioms_def using sheaf_spec_morphisms_are_ring_morphisms
     by blast
 qed
 
 (* ex. 0.30 *)
 lemma sheaf_spec_is_sheaf:
   shows "sheaf_of_rings Spec is_zariski_open sheaf_spec sheaf_spec_morphisms \<O>b
 add_sheaf_spec mult_sheaf_spec zero_sheaf_spec one_sheaf_spec"
 proof (intro sheaf_of_rings.intro sheaf_of_rings_axioms.intro)
   show "presheaf_of_rings Spec is_zariski_open sheaf_spec sheaf_spec_morphisms \<O>b
      add_sheaf_spec mult_sheaf_spec zero_sheaf_spec one_sheaf_spec"
     using sheaf_spec_is_presheaf by simp
 next
   fix U I V s assume H: "open_cover_of_open_subset Spec is_zariski_open U I V"
                         "\<And>i. i \<in> I \<Longrightarrow> V i \<subseteq> U"
                         "s \<in> \<O> U"
                         "\<And>i. i \<in> I \<Longrightarrow> sheaf_spec_morphisms U (V i) s = zero_sheaf_spec (V i)"
   then have "s \<pp> = zero_sheaf_spec U \<pp>" if "\<pp> \<in> U" for \<pp>
   proof -
     from that obtain i where F: "i \<in> I" "\<pp> \<in> (V i)" "is_zariski_open (V i)"
       using H(1) unfolding open_cover_of_subset_def open_cover_of_open_subset_def
       by (metis cover_of_subset.cover_of_select_index cover_of_subset.select_index_belongs open_cover_of_subset_axioms_def)
     then have "sheaf_spec_morphisms U (V i) s \<pp> = quotient_ring.zero_rel (R \<setminus> \<pp>) R (+) (\<cdot>) \<zero> \<one>"
       using H(2,4) F by (simp add: zero_sheaf_spec_def)
     thus "s \<pp> = zero_sheaf_spec U \<pp>"
       using sheaf_spec_morphisms_def zero_sheaf_spec_def F(2) by (simp add: H(3) \<open>\<pp> \<in> U\<close>)
   qed
   moreover have "s \<in> extensional U" " zero_sheaf_spec U \<in> extensional U"
     by (simp_all add: H(3))
   ultimately show "s = zero_sheaf_spec U" using extensionalityI by blast
 next
   fix U I V s assume H: "open_cover_of_open_subset Spec is_zariski_open U I V"
                         "\<forall>i. i \<in> I \<longrightarrow> V i \<subseteq> U \<and> s i \<in> \<O> (V i)"
                         "\<And>i j. i \<in> I \<Longrightarrow>
                                   j \<in> I \<Longrightarrow>
                                     sheaf_spec_morphisms (V i) (V i \<inter> V j) (s i) =
                                     sheaf_spec_morphisms (V j) (V i \<inter> V j) (s j)"
   define t where D: "t \<equiv> \<lambda>\<pp>\<in>U. s (cover_of_subset.select_index I V \<pp>) \<pp>"
   then have F1: "s i \<pp> = s j \<pp>" if "i \<in> I" "j \<in> I" "\<pp> \<in> V i" "\<pp> \<in> V j" for \<pp> i j
   proof -
     have "s i \<pp> = sheaf_spec_morphisms (V i) (V i \<inter> V j) (s i) \<pp>"
       using that sheaf_spec_morphisms_def by (simp add: H(2))
     moreover have "\<dots> = sheaf_spec_morphisms (V j) (V i \<inter> V j) (s j) \<pp>"
       using H(3) that by fastforce
     moreover have "\<dots> = s j \<pp>"
       using sheaf_spec_morphisms_def that by (simp add: H(2))
     ultimately show "s i \<pp> = s j \<pp>" by blast
   qed
   have "t \<in> \<O> U"
   proof-
     have "t \<pp> \<in> (R\<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>)" if "\<pp>\<in>U" for \<pp>
       using D H(1) H(2) cover_of_subset.cover_of_select_index
         cover_of_subset.select_index_belongs open_cover_of_open_subset.axioms(1)
         open_cover_of_subset_def sec_has_right_codom that by fastforce
     moreover have "t \<in> extensional U"
       using D by blast
     moreover have "is_regular t U"
       unfolding is_regular_def
     proof (intro strip conjI)
       fix \<pp>
       assume "\<pp> \<in> U"
       show "\<exists>V. is_zariski_open V \<and> V \<subseteq> U \<and> \<pp> \<in> V \<and> is_locally_frac t V"
       proof -
         have cov_in_I: "cover_of_subset.select_index I V \<pp> \<in> I"
           by (meson H(1) \<open>\<pp> \<in> U\<close> cover_of_subset.select_index_belongs open_cover_of_open_subset_def open_cover_of_subset_def)
         have V: "V (cover_of_subset.select_index I V \<pp>) \<subseteq> U"
           using H(2) by (meson H(1) \<open>\<pp> \<in> U\<close> cover_of_subset.select_index_belongs open_cover_of_open_subset_def open_cover_of_subset_def)
         have V2: "\<exists>V'. is_zariski_open V' \<and> V'\<subseteq> V (cover_of_subset.select_index I V \<pp>) \<and> \<pp> \<in> V' \<and>
                  is_locally_frac (s (cover_of_subset.select_index I V \<pp>)) V'"
           using H(1,2)
           unfolding sheaf_spec_def open_cover_of_open_subset_def open_cover_of_subset_def is_regular_def
           using \<open>\<pp> \<in> U\<close> cov_in_I cover_of_subset.cover_of_select_index by fastforce
         have "\<And>V' \<qq>. is_zariski_open V' \<and> V' \<subseteq> V (cover_of_subset.select_index I V \<pp>) \<Longrightarrow> \<qq> \<in> V' \<Longrightarrow> t \<qq> = s (cover_of_subset.select_index I V \<pp>) \<qq>"
           by (smt D F1 H(1) V \<open>\<pp> \<in> U\<close> cover_of_subset.cover_of_select_index cover_of_subset.select_index_belongs open_cover_of_open_subset_def open_cover_of_subset_def restrict_apply subsetD)
         with V V2 show ?thesis unfolding is_locally_frac_def
           by (smt subset_trans)
       qed
     qed
     ultimately show ?thesis unfolding sheaf_spec_def by (simp add:PiE_iff)
   qed
   have "sheaf_spec_morphisms U (V i) t = s i" if "i \<in> I" for i
   proof
     fix \<pp>
     have "sheaf_spec_morphisms U (V i) t \<pp> = s i \<pp>" if "\<pp> \<in> U"
     proof-
       from that H(1)
       obtain j where "j \<in> I \<and> \<pp> \<in> V j \<and> t \<pp> = s j \<pp>"
         unfolding D open_cover_of_subset_def open_cover_of_open_subset_def
         by (meson cover_of_subset.cover_of_select_index cover_of_subset.select_index_belongs restrict_apply')
       thus "sheaf_spec_morphisms U (V i) t \<pp> = s i \<pp>"
         using \<open>t \<in> \<O> U\<close> \<open>i \<in> I\<close> H(2) that
         unfolding sheaf_spec_morphisms_def
         apply (simp add: D split: if_split_asm)
         by (metis (mono_tags, hide_lams) F1  extensional_arb [OF sec_is_extensional])
     qed
     thus "sheaf_spec_morphisms U (V i) t \<pp> = s i \<pp>"
       using sheaf_spec_morphisms_def D F1
       by (smt H(2) \<open>i \<in> I\<close> \<open>t \<in> \<O> U\<close> comm_ring.sheaf_morphisms_sheaf_spec local.comm_ring_axioms restrict_apply subsetD)
   qed
   thus "\<exists>t. t \<in> (\<O> U) \<and> (\<forall>i. i \<in> I \<longrightarrow> sheaf_spec_morphisms U (V i) t = s i)"
     using \<open>t \<in> \<O> U\<close> by blast
 qed
 
 lemma shrinking:
   assumes "is_zariski_open U" and "\<pp> \<in> U" and "s \<in> \<O> U" and "t \<in> \<O> U"
   obtains V a f b g where "is_zariski_open V" "V \<subseteq> U" "\<pp> \<in> V" "a \<in> R" "f \<in> R" "b \<in> R" "g \<in> R"
 "f \<notin> \<pp>" "g \<notin> \<pp>"
 "\<And>\<qq>. \<qq> \<in> V \<Longrightarrow> f \<notin> \<qq> \<and> s \<qq> = quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> a f"
 "\<And>\<qq>. \<qq> \<in> V \<Longrightarrow> g \<notin> \<qq> \<and> t \<qq> = quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> b g"
 proof-
   obtain Vs a f where "is_zariski_open Vs" "Vs \<subseteq> U" "\<pp> \<in> Vs" "a \<in> R" "f \<in> R"
 "\<And>\<qq>. \<qq> \<in> Vs \<Longrightarrow> f \<notin> \<qq> \<and> s \<qq> = quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> a f"
     using assms(2,3) sheaf_spec_def is_regular_def is_locally_frac_def by auto
   obtain Vt b g where "is_zariski_open Vt" "Vt \<subseteq> U" "\<pp> \<in> Vt" "b \<in> R" "g \<in> R"
 "\<And>\<qq>. \<qq> \<in> Vt \<Longrightarrow> g \<notin> \<qq> \<and> t \<qq> = quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> b g"
     using assms(2,4) sheaf_spec_def is_regular_def is_locally_frac_def by auto
   then have "is_zariski_open (Vs \<inter> Vt)" "Vs \<inter> Vt \<subseteq> U" "\<pp> \<in> Vs \<inter> Vt"
 "\<And>\<qq>. \<qq> \<in> (Vs \<inter> Vt) \<Longrightarrow> f \<notin> \<qq> \<and> s \<qq> = quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> a f"
 "\<And>\<qq>. \<qq> \<in> (Vs \<inter> Vt) \<Longrightarrow> g \<notin> \<qq> \<and> t \<qq> = quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> b g"
     using topological_space.open_inter apply (simp add: \<open>is_zariski_open Vs\<close>)
     using \<open>Vs \<subseteq> U\<close> apply auto[1] apply (simp add: \<open>\<pp> \<in> Vs\<close> \<open>\<pp> \<in> Vt\<close>)
     apply (simp add: \<open>\<And>\<qq>. \<qq> \<in> Vs \<Longrightarrow> f \<notin> \<qq> \<and> s \<qq> = quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> a f\<close>)
     by (simp add: \<open>\<And>\<qq>. \<qq> \<in> Vt \<Longrightarrow> g \<notin> \<qq> \<and> t \<qq> = quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> b g\<close>)
   thus ?thesis using \<open>a \<in> R\<close> \<open>b \<in> R\<close> \<open>f \<in> R\<close> \<open>g \<in> R\<close> that by presburger
 qed
 
 end (* comm_ring *)
 
 
 section \<open>Schemes\<close>
 
 subsection \<open>Ringed Spaces\<close>
 
 (* definition 0.32 *)
 locale ringed_space = sheaf_of_rings
 
 context comm_ring
 begin
 
 lemma spec_is_ringed_space:
   shows "ringed_space Spec is_zariski_open sheaf_spec sheaf_spec_morphisms \<O>b
 add_sheaf_spec mult_sheaf_spec zero_sheaf_spec one_sheaf_spec"
 proof (intro ringed_space.intro)
   show "sheaf_of_rings Spec is_zariski_open sheaf_spec sheaf_spec_morphisms \<O>b
      add_sheaf_spec mult_sheaf_spec zero_sheaf_spec one_sheaf_spec"
     using sheaf_spec_is_sheaf by simp
 qed
 
 end (* comm_ring *)
 
 (* definition 0.33 *)
 locale morphism_ringed_spaces =
 im_sheaf X is_open\<^sub>X \<O>\<^sub>X \<rho>\<^sub>X b add_str\<^sub>X mult_str\<^sub>X zero_str\<^sub>X one_str\<^sub>X Y is_open\<^sub>Y f +
  codom: ringed_space Y is_open\<^sub>Y \<O>\<^sub>Y \<rho>\<^sub>Y d add_str\<^sub>Y mult_str\<^sub>Y zero_str\<^sub>Y one_str\<^sub>Y
 for X and is_open\<^sub>X and \<O>\<^sub>X and \<rho>\<^sub>X and b and add_str\<^sub>X and mult_str\<^sub>X and zero_str\<^sub>X and one_str\<^sub>X
 and Y and is_open\<^sub>Y and \<O>\<^sub>Y and \<rho>\<^sub>Y and d and add_str\<^sub>Y and mult_str\<^sub>Y and zero_str\<^sub>Y and one_str\<^sub>Y
 and f +
 fixes \<phi>\<^sub>f:: "'c set \<Rightarrow> ('d \<Rightarrow> 'b)"
 assumes is_morphism_of_sheaves: "morphism_sheaves_of_rings
 Y is_open\<^sub>Y \<O>\<^sub>Y \<rho>\<^sub>Y d add_str\<^sub>Y mult_str\<^sub>Y zero_str\<^sub>Y one_str\<^sub>Y
 im_sheaf im_sheaf_morphisms b add_im_sheaf mult_im_sheaf zero_im_sheaf one_im_sheaf
 \<phi>\<^sub>f"
 
 
 subsection \<open>Direct Limits of Rings\<close>
 
 (* construction 0.34 *)
 locale direct_lim = sheaf_of_rings +
   fixes I:: "'a set set"
   assumes subset_of_opens: "\<And>U. U \<in> I \<Longrightarrow> is_open U"
     and has_lower_bound: "\<And>U V. \<lbrakk> U\<in>I; V\<in>I \<rbrakk> \<Longrightarrow> \<exists>W\<in>I. W \<subseteq> U \<inter> V"
 begin
 
 definition get_lower_bound:: "'a set \<Rightarrow> 'a set \<Rightarrow> 'a set" where
   "get_lower_bound U V= (SOME W. W \<in> I \<and> W \<subseteq> U \<and> W \<subseteq> V)"
 
 lemma get_lower_bound[intro]:
   assumes "U \<in> I" "V \<in> I"
   shows "get_lower_bound U V \<in> I" "get_lower_bound U V \<subseteq> U" "get_lower_bound U V \<subseteq> V"
 proof -
   have "\<exists>W. W \<in> I \<and> W \<subseteq> U \<and> W \<subseteq> V"
     using has_lower_bound[OF assms] by auto
   from someI_ex[OF this]
   show "get_lower_bound U V \<in> I" "get_lower_bound U V \<subseteq> U" "get_lower_bound U V \<subseteq> V"
     unfolding get_lower_bound_def by auto
 qed
 
 lemma obtain_lower_bound_finite:
   assumes "finite Us"  "Us \<noteq> {}" "Us \<subseteq> I"
   obtains W where "W \<in> I" "\<forall>U\<in>Us. W \<subseteq> U"
   using assms
 proof (induct Us arbitrary:thesis)
   case (insert U F)
   have ?case when "F={}"
     using insert.prems(1) insert.prems(3) that by blast
   moreover have ?case when "F\<noteq>{}"
   proof -
     obtain W where "W \<in> I" "\<forall>U\<in>F. W \<subseteq> U"
       using insert.hyps(3) insert.prems(3) by auto
     obtain W1 where "W1 \<in>I" "W1 \<subseteq> U" "W1 \<subseteq> W"
       by (meson \<open>W \<in> I\<close> get_lower_bound(1) get_lower_bound(2) get_lower_bound(3)
           insert.prems(3) insert_subset)
     then have "\<forall>a\<in>insert U F. W1 \<subseteq> a"
       using \<open>\<forall>U\<in>F. W \<subseteq> U\<close> by auto
     with \<open>W1 \<in>I\<close> show ?thesis
       using insert(4) by auto
   qed
   ultimately show ?case by auto
 qed simp
 
 definition principal_subs :: "'a set set \<Rightarrow> 'a set \<Rightarrow> 'a set filter" where
   "principal_subs As A = Abs_filter (\<lambda>P. \<forall>x. (x\<in>As \<and> x \<subseteq> A) \<longrightarrow> P x)"
 
 lemma eventually_principal_subs: "eventually P (principal_subs As A) \<longleftrightarrow> (\<forall>x. x\<in>As \<and> x\<subseteq>A \<longrightarrow> P x)"
   unfolding principal_subs_def
   by (rule eventually_Abs_filter, rule is_filter.intro) auto
 
 lemma principal_subs_UNIV[simp]: "principal_subs UNIV UNIV = top"
   by (auto simp: filter_eq_iff eventually_principal_subs)
 
 lemma principal_subs_empty[simp]: "principal_subs {} s = bot"
   (*"principal_subs ss {} = bot"*)
   by (auto simp: filter_eq_iff eventually_principal_subs)
 
 lemma principal_subs_le_iff[iff]:
   "principal_subs As A \<le> principal_subs As' A'
             \<longleftrightarrow> {x. x\<in>As \<and> x \<subseteq> A} \<subseteq> {x. x\<in>As' \<and> x \<subseteq> A'}"
   unfolding le_filter_def eventually_principal_subs by blast
 
 lemma principal_subs_eq_iff[iff]:
     "principal_subs As A = principal_subs As' A' \<longleftrightarrow>{x. x\<in>As \<and> x \<subseteq> A} = {x. x\<in>As' \<and> x \<subseteq> A'}"
   unfolding eq_iff by simp
 
 lemma principal_subs_inj_on[simp]:"inj_on (principal_subs As) As"
   unfolding inj_on_def by auto
 
 definition lbound :: "'a set set \<Rightarrow> ('a set) filter" where
   "lbound Us = (INF S\<in>{S. S\<in>I \<and> (\<forall>u\<in>Us. S \<subseteq> u)}. principal_subs I S)"
 
 lemma eventually_lbound_finite:
   assumes "finite A" "A\<noteq>{}" "A\<subseteq>I"
   shows "(\<forall>\<^sub>F w in lbound A. P w) \<longleftrightarrow> (\<exists>w0. w0 \<in> I \<and> (\<forall>a\<in>A. w0 \<subseteq> a) \<and> (\<forall>w. (w\<subseteq>w0 \<and> w\<in>I) \<longrightarrow> P w))"
 proof -
   have "\<exists>x. x \<in> I \<and> (\<forall>xa\<in>A. x \<subseteq> xa)"
     by (metis Int_iff assms inf.order_iff obtain_lower_bound_finite)
   moreover have " \<exists>x. x \<in> I \<and> Ball A ((\<subseteq>) x)
               \<and> {xa \<in> I. xa \<subseteq> x} \<subseteq> {x \<in> I. x \<subseteq> a}
                 \<and> {xa \<in> I. xa \<subseteq> x} \<subseteq> {x \<in> I. x \<subseteq> b}"
     if "a \<in> I \<and> (\<forall>x\<in>A. a \<subseteq> x)" "b \<in> I \<and> (\<forall>x\<in>A. b \<subseteq> x)" for a b
     apply (rule exI[where x="get_lower_bound a b"])
     using that apply auto
     subgoal using get_lower_bound(2) by blast
     subgoal by (meson get_lower_bound(2) subsetD)
     subgoal by (meson get_lower_bound(3) subsetD)
     done
   moreover have "(\<exists>b\<in>{S \<in> I. Ball A ((\<subseteq>) S)}. eventually P (principal_subs I b)) =
     (\<exists>w0. w0 \<in> I \<and> Ball A ((\<subseteq>) w0) \<and> (\<forall>w. w \<subseteq> w0 \<and> w \<in> I \<longrightarrow> P w))"
     unfolding eventually_principal_subs by force
   ultimately show ?thesis unfolding lbound_def
     by (subst eventually_INF_base) auto
 qed
 
 lemma lbound_eq:
   assumes A:"finite A" "A\<noteq>{}" "A\<subseteq>I"
   assumes B:"finite B" "B\<noteq>{}" "B\<subseteq>I"
   shows "lbound A = lbound B"
 proof -
   have "eventually P (lbound A')" if "eventually P (lbound B')"
     and A':"finite A'" "A'\<noteq>{}" "A' \<subseteq> I"
     and B':"finite B'" "B'\<noteq>{}" "B' \<subseteq> I"
   for P A' B'
   proof -
     obtain w0 where w0:"w0 \<in> I" "(\<forall>a\<in>B'. w0 \<subseteq> a)" "(\<forall>w. w \<subseteq> w0 \<and> w \<in> I \<longrightarrow> P w)"
       using \<open>eventually P (lbound B')\<close> unfolding eventually_lbound_finite[OF B',of P]
       by auto
     obtain w1 where w1:"w1 \<in> I" "\<forall>U\<in>A'. w1 \<subseteq> U"
       using obtain_lower_bound_finite[OF A'] by auto
     define w2 where "w2=get_lower_bound w0 w1"
     have "w2 \<in> I" using \<open>w0 \<in> I\<close> \<open>w1 \<in> I\<close> unfolding w2_def by auto
     moreover have "\<forall>a\<in>A'. w2 \<subseteq> a"
       unfolding w2_def by (meson dual_order.trans get_lower_bound(3) w0(1) w1(1) w1(2))
     moreover have "\<forall>w. w \<subseteq> w2 \<and> w \<in> I \<longrightarrow> P w"
       unfolding w2_def by (meson dual_order.trans get_lower_bound(2) w0(1) w0(3) w1(1))
     ultimately show ?thesis unfolding eventually_lbound_finite[OF A',of P] by auto
   qed
   then have "eventually P (lbound A) = eventually P (lbound B)" for P
     using A B by auto
   then show ?thesis unfolding filter_eq_iff by auto
 qed
 
 lemma lbound_leq:
   assumes "A \<subseteq> B"
   shows "lbound A \<le>lbound B"
   unfolding lbound_def
   apply (rule Inf_superset_mono)
   apply (rule image_mono)
   using assms by auto
 
 definition llbound::"('a set) filter" where
   "llbound = lbound {SOME a. a\<in>I}"
 
 lemma llbound_not_bot:
   assumes "I\<noteq> {}"
   shows "llbound \<noteq> bot"
   unfolding trivial_limit_def llbound_def
   apply (subst eventually_lbound_finite)
   using assms by (auto simp add: some_in_eq)
 
 lemma llbound_lbound:
   assumes "finite A" "A\<noteq>{}" "A\<subseteq>I"
   shows "lbound A = llbound"
   unfolding llbound_def
   apply (rule lbound_eq)
   using assms by (auto simp add: some_in_eq)
 
 definition rel:: "('a set \<times> 'b) \<Rightarrow> ('a set \<times> 'b) \<Rightarrow> bool" (infix "\<sim>" 80)
   where "x \<sim> y \<equiv> (fst x \<in> I \<and> fst y \<in> I) \<and> (snd x \<in> \<FF> (fst x) \<and> snd y \<in> \<FF> (fst y)) \<and>
 (\<exists>W. (W \<in> I) \<and> (W \<subseteq> fst x \<inter> fst y) \<and> \<rho> (fst x) W (snd x) = \<rho> (fst y) W (snd y))"
 
 lemma rel_is_equivalence:
   shows "equivalence (Sigma I \<FF>) {(x, y). x \<sim> y}"
   unfolding equivalence_def
 proof (intro conjI strip)
   show "(a, c) \<in> {(x, y). x \<sim> y}"
     if "(a, b) \<in> {(x, y). x \<sim> y}" "(b, c) \<in> {(x, y). x \<sim> y}" for a b c
   proof -
     obtain W1 where W1:"fst a \<in> I" "fst b \<in> I" "snd a \<in> \<FF> (fst a)" "snd b \<in> \<FF> (fst b)"
                     "W1 \<in> I" "W1 \<subseteq> fst a" "W1 \<subseteq> fst b"
                     "\<rho> (fst a) W1 (snd a) = \<rho> (fst b) W1 (snd b)"
       using \<open>(a, b) \<in> {(x, y). x \<sim> y}\<close> unfolding rel_def by auto
     obtain W2 where W2:"fst b \<in> I" "fst c \<in> I" "snd b \<in> \<FF> (fst b)" "snd c \<in> \<FF> (fst c)"
                     "W2 \<in> I" "W2 \<subseteq> fst b" "W2 \<subseteq> fst c"
                     "\<rho> (fst b) W2 (snd b) = \<rho> (fst c) W2 (snd c)"
       using \<open>(b, c) \<in> {(x, y). x \<sim> y}\<close> unfolding rel_def by auto
     obtain W3 where W3:"W3 \<in>I" "W3 \<subseteq> W1 \<inter> W2"
       using has_lower_bound[OF \<open>W1\<in>I\<close> \<open>W2\<in>I\<close>] by auto
     from \<open>W3 \<subseteq> W1 \<inter> W2\<close>
     have "W3 \<subseteq> fst a \<inter> fst c" using W1(6) W2(7) by blast
     moreover have "\<rho> (fst a) W3 (snd a) = \<rho> (fst c) W3 (snd c)"
       using W1 W2 by (metis W3(1) W3(2) eq_\<rho> le_inf_iff subset_of_opens)
     moreover note \<open>W3 \<in>I\<close> W1 W2
     ultimately show ?thesis
       unfolding rel_def by auto
   qed
 qed (auto simp: rel_def Int_commute)
 
 interpretation rel:equivalence "(Sigma I \<FF>)" "{(x, y). x \<sim> y}"
   using rel_is_equivalence .
 
 definition class_of:: "'a set \<Rightarrow> 'b \<Rightarrow> ('a set \<times> 'b) set" ("\<lfloor>(_,/ _)\<rfloor>")
   where "\<lfloor>U,s\<rfloor> \<equiv> rel.Class (U, s)"
 
 lemma class_of_eqD:
   assumes "\<lfloor>U1,s1\<rfloor> = \<lfloor>U2,s2\<rfloor>" "(U1,s1) \<in> Sigma I \<FF>" "(U2,s2) \<in> Sigma I \<FF>"
   obtains W where "W \<in> I" "W \<subseteq> U1 \<inter> U2" "\<rho> U1 W s1 = \<rho> U2 W s2"
   using rel.Class_equivalence[OF assms(2,3)] assms(1)
   unfolding class_of_def rel_def by auto
 
 lemma class_of_eqI:
   assumes "(U1,s1) \<in> Sigma I \<FF>" "(U2,s2) \<in> Sigma I \<FF>"
   assumes "W \<in> I" "W \<subseteq> U1 \<inter> U2" "\<rho> U1 W s1 = \<rho> U2 W s2"
   shows "\<lfloor>U1,s1\<rfloor> = \<lfloor>U2,s2\<rfloor>"
   unfolding class_of_def
   apply (rule rel.Class_eq)
   using assms  by (auto simp: rel_def)
 
 lemma class_of_0_in:
   assumes "U \<in> I"
   shows "\<zero>\<^bsub>U\<^esub> \<in> \<FF> U"
 proof -
   have "ring (\<FF> U) +\<^bsub>U\<^esub> \<cdot>\<^bsub>U\<^esub> \<zero>\<^bsub>U\<^esub> \<one>\<^bsub>U\<^esub>"
     using assms subset_of_opens is_ring_from_is_homomorphism by blast
   then show ?thesis
     unfolding ring_def abelian_group_def Group_Theory.group_def by (meson monoid.unit_closed)
 qed
 
 lemma rel_Class_iff: "x \<sim> y \<longleftrightarrow> y \<in> Sigma I \<FF> \<and> x \<in> rel.Class y"
   by blast
 
 lemma class_of_0_eq:
   assumes "U \<in> I" "U' \<in> I"
   shows "\<lfloor>U, \<zero>\<^bsub>U\<^esub>\<rfloor> = \<lfloor>U', \<zero>\<^bsub>U'\<^esub>\<rfloor>"
 proof -
   obtain W where W: "W \<in> I" "W \<subseteq> U" "W \<subseteq> U'"
     by (metis Int_subset_iff assms has_lower_bound)
   then have "is_open W" "is_open U" "is_open U'"
     by (auto simp add: assms subset_of_opens)
   then have "\<rho> U W \<zero>\<^bsub>U\<^esub> = \<rho> U' W \<zero>\<^bsub>U'\<^esub>"
     using W is_ring_morphism [of U W] is_ring_morphism [of U' W]
     by (simp add: ring_homomorphism_def group_homomorphism_def monoid_homomorphism_def
                monoid_homomorphism_axioms_def)
   with W have "\<exists>W. W \<in> I \<and> W \<subseteq> U \<and> W \<subseteq> U' \<and> \<rho> U W \<zero>\<^bsub>U\<^esub> = \<rho> U' W \<zero>\<^bsub>U'\<^esub>" by blast
   moreover have "\<zero>\<^bsub>U\<^esub> \<in> \<FF> U" "\<zero>\<^bsub>U'\<^esub> \<in> \<FF> U'"
     by (auto simp add: assms class_of_0_in)
   ultimately have "(U, \<zero>\<^bsub>U\<^esub>) \<sim> (U', \<zero>\<^bsub>U'\<^esub>)"
     using assms by (auto simp: rel_def)
   then show ?thesis
     unfolding class_of_def by (simp add: rel.Class_eq)
 qed
 
 lemma class_of_1_in:
   assumes "U \<in> I"
   shows "\<one>\<^bsub>U\<^esub> \<in> \<FF> U"
 proof -
   have "ring (\<FF> U) +\<^bsub>U\<^esub> \<cdot>\<^bsub>U\<^esub> \<zero>\<^bsub>U\<^esub> \<one>\<^bsub>U\<^esub>"
     using assms subset_of_opens is_ring_from_is_homomorphism by blast
   then show ?thesis
     unfolding ring_def by (meson monoid.unit_closed)
 qed
 
 lemma class_of_1_eq:
   assumes "U \<in> I" and "U' \<in> I"
   shows "\<lfloor>U, \<one>\<^bsub>U\<^esub>\<rfloor> = \<lfloor>U', \<one>\<^bsub>U'\<^esub>\<rfloor>"
 proof -
   obtain W where W: "W \<in> I" "W \<subseteq> U" "W \<subseteq> U'"
     by (metis Int_subset_iff assms has_lower_bound)
   then have "is_open W" "is_open U" "is_open U'"
     by (auto simp add: assms subset_of_opens)
   then have "\<rho> U W \<one>\<^bsub>U\<^esub> = \<rho> U' W \<one>\<^bsub>U'\<^esub>"
     using W is_ring_morphism [of U W] is_ring_morphism [of U' W]
     by (simp add: ring_homomorphism_def group_homomorphism_def monoid_homomorphism_def
                monoid_homomorphism_axioms_def)
   with W have "\<exists>W. W \<in> I \<and> W \<subseteq> U \<and> W \<subseteq> U' \<and> \<rho> U W \<one>\<^bsub>U\<^esub> = \<rho> U' W \<one>\<^bsub>U'\<^esub>" by blast
   moreover
   have "\<one>\<^bsub>U\<^esub> \<in> \<FF> U" "\<one>\<^bsub>U'\<^esub> \<in> \<FF> U'"
     by (auto simp add: assms class_of_1_in)
   ultimately have "(U, \<one>\<^bsub>U\<^esub>) \<sim> (U', \<one>\<^bsub>U'\<^esub>)"
     using assms by (auto simp: rel_def)
   then show ?thesis
     unfolding class_of_def by (simp add: rel.Class_eq)
 qed
 
 definition add_rel :: "('a set \<times> 'b) set \<Rightarrow> ('a set \<times> 'b) set \<Rightarrow> ('a set \<times> 'b) set"
   where "add_rel X Y \<equiv> let
               x = (SOME x. x \<in> X);
               y = (SOME y. y \<in> Y);
               w = get_lower_bound (fst x) (fst y)
             in
               \<lfloor>w, add_str w (\<rho> (fst x) w (snd x)) (\<rho> (fst y) w (snd y))\<rfloor>"
 
 definition mult_rel :: "('a set \<times> 'b) set \<Rightarrow> ('a set \<times> 'b) set \<Rightarrow> ('a set \<times> 'b) set"
   where "mult_rel X Y \<equiv> let
               x = (SOME x. x \<in> X);
               y = (SOME y. y \<in> Y);
               w = get_lower_bound (fst x) (fst y)
             in
               \<lfloor>w, mult_str w (\<rho> (fst x) w (snd x)) (\<rho> (fst y) w (snd y))\<rfloor>"
 
 definition carrier_direct_lim:: "('a set \<times> 'b) set set"
   where "carrier_direct_lim \<equiv> rel.Partition"
 
 lemma zero_rel_carrier[intro]:
   assumes "U \<in> I"
   shows "\<lfloor>U, \<zero>\<^bsub>U\<^esub>\<rfloor> \<in> carrier_direct_lim"
   unfolding carrier_direct_lim_def class_of_def
 proof (rule rel.Block_closed)
   interpret ring "(\<FF> U)" "+\<^bsub>U\<^esub>" "\<cdot>\<^bsub>U\<^esub>" "\<zero>\<^bsub>U\<^esub>" "\<one>\<^bsub>U\<^esub>"
     by (simp add: assms is_ring_from_is_homomorphism subset_of_opens)
   show "(U, \<zero>\<^bsub>U\<^esub>) \<in> Sigma I \<FF>"
     by (simp add: assms)
 qed
 
 lemma one_rel_carrier[intro]:
   assumes "U \<in> I"
   shows "\<lfloor>U, \<one>\<^bsub>U\<^esub>\<rfloor> \<in> carrier_direct_lim"
   unfolding carrier_direct_lim_def class_of_def
   apply (rule rel.Block_closed)
   by (simp add: assms class_of_1_in)
 
 lemma rel_carrier_Eps_in:
   fixes X :: "('a set \<times> 'b) set"
   defines "a\<equiv>(SOME x. x \<in> X)"
   assumes "X \<in> carrier_direct_lim"
   shows "a \<in> X" "a \<in>Sigma I \<FF>"  "X = \<lfloor>fst a, snd a\<rfloor>"
 proof -
   have "\<exists>a\<in>Sigma I \<FF>. a \<in> X \<and> X = rel.Class a"
     using rel.representant_exists[OF \<open>X \<in> carrier_direct_lim\<close>[unfolded carrier_direct_lim_def]]
     by simp
   then have "a \<in> X \<and> a \<in>Sigma I \<FF> \<and> X = \<lfloor>fst a, snd a\<rfloor>"
     unfolding class_of_def
     by (metis a_def assms(2) carrier_direct_lim_def ex_in_conv prod.collapse rel.Block_self
         rel.Class_closed some_in_eq)
   then show "a \<in> X" "a \<in>Sigma I \<FF>"  "X = \<lfloor>fst a, snd a\<rfloor>" by auto
 qed
 
 lemma add_rel_carrier[intro]:
   assumes "X \<in> carrier_direct_lim" "Y \<in> carrier_direct_lim"
   shows "add_rel X Y \<in> carrier_direct_lim"
 proof -
   define x where "x=(SOME x. x \<in> X)"
   define y where "y=(SOME y. y \<in> Y)"
   define z where "z=get_lower_bound (fst x) (fst y)"
 
   have "x\<in>X" "x\<in>Sigma I \<FF>"
     using rel_carrier_Eps_in[OF \<open>X \<in> carrier_direct_lim\<close>] unfolding x_def by auto
   have "y\<in>Y" "y \<in> Sigma I \<FF>"
     using rel_carrier_Eps_in[OF \<open>Y \<in> carrier_direct_lim\<close>] unfolding y_def by auto
 
   have "add_rel X Y = \<lfloor>z, add_str z (\<rho> (fst x) z (snd x)) (\<rho> (fst y) z (snd y))\<rfloor>"
     unfolding add_rel_def Let_def
     by (fold x_def y_def z_def,rule)
   also have "... \<in> carrier_direct_lim"
     unfolding carrier_direct_lim_def class_of_def
   proof (rule rel.Block_closed)
     have "z\<in>I" using \<open>x\<in>Sigma I \<FF>\<close> \<open>y\<in>Sigma I \<FF>\<close> unfolding z_def by auto
     then interpret ring "(\<FF> z)" "+\<^bsub>z\<^esub>" "\<cdot>\<^bsub>z\<^esub>" "\<zero>\<^bsub>z\<^esub>" "\<one>\<^bsub>z\<^esub>"
       using is_ring_from_is_homomorphism subset_of_opens by auto
     show "(z, +\<^bsub>z\<^esub> (\<rho> (fst x) z (snd x)) (\<rho> (fst y) z (snd y))) \<in> Sigma I \<FF>"
       using \<open>z\<in>I\<close>
       apply simp
       by (metis \<open>x \<in> Sigma I \<FF>\<close> \<open>y \<in> Sigma I \<FF>\<close> additive.composition_closed
           direct_lim.subset_of_opens direct_lim_axioms get_lower_bound(2) get_lower_bound(3)
           is_map_from_is_homomorphism map.map_closed mem_Sigma_iff prod.exhaust_sel z_def)
   qed
   finally show ?thesis .
 qed
 
 
 lemma rel_eventually_llbound:
   assumes "x \<sim> y"
   shows "\<forall>\<^sub>F w in llbound. \<rho> (fst x) w (snd x) = \<rho> (fst y) w (snd y)"
 proof -
   have xy:"fst x \<in> I" "fst y \<in> I" "snd x \<in> \<FF> (fst x)" "snd y \<in> \<FF> (fst y)"
     using \<open>x \<sim> y\<close> unfolding rel_def by auto
   obtain w0 where w0:"w0 \<in> I" "w0 \<subseteq> fst x \<inter> fst y" "\<rho> (fst x) w0 (snd x) = \<rho> (fst y) w0 (snd y)"
     using \<open>x \<sim> y\<close> unfolding rel_def by auto
 
   interpret xw0:ring_homomorphism "\<rho> (fst x) w0" "\<FF> (fst x)" "+\<^bsub>fst x\<^esub>" "\<cdot>\<^bsub>fst x\<^esub>" "\<zero>\<^bsub>fst x\<^esub>"
         "\<one>\<^bsub>fst x\<^esub>" "\<FF> w0" "+\<^bsub>w0\<^esub>" "\<cdot>\<^bsub>w0\<^esub>" "\<zero>\<^bsub>w0\<^esub>" "\<one>\<^bsub>w0\<^esub>"
     by (meson is_ring_morphism le_inf_iff subset_of_opens w0 xy(1))
   interpret yw0:ring_homomorphism "\<rho> (fst y) w0" "\<FF> (fst y)" "+\<^bsub>fst y\<^esub>" "\<cdot>\<^bsub>fst y\<^esub>" "\<zero>\<^bsub>fst y\<^esub>"
         "\<one>\<^bsub>fst y\<^esub>" "\<FF> w0" "+\<^bsub>w0\<^esub>" "\<cdot>\<^bsub>w0\<^esub>" "\<zero>\<^bsub>w0\<^esub>" "\<one>\<^bsub>w0\<^esub>"
     using w0 by (metis is_ring_morphism le_inf_iff subset_of_opens  xy(2))
   have "\<rho> (fst x) w (snd x) = \<rho> (fst y) w (snd y)" if "w \<subseteq> w0" "w \<in> I" for w
   proof -
     interpret w0w:ring_homomorphism "\<rho> w0 w" "\<FF> w0" "+\<^bsub>w0\<^esub>" "\<cdot>\<^bsub>w0\<^esub>" "\<zero>\<^bsub>w0\<^esub>" "\<one>\<^bsub>w0\<^esub>" "\<FF> w"
                   "+\<^bsub>w\<^esub>" "\<cdot>\<^bsub>w\<^esub>" "\<zero>\<^bsub>w\<^esub>" "\<one>\<^bsub>w\<^esub>"
       using is_ring_morphism subset_of_opens that w0(1) by presburger
 
     have "\<rho> (fst x) w (snd x) = (\<rho> w0 w \<circ> \<rho> (fst x) w0) (snd x)"
       by (meson assoc_comp le_inf_iff subset_of_opens that w0 xy)
     also have "... = (\<rho> w0 w \<circ> \<rho> (fst y) w0) (snd y)"
       unfolding comp_def
       using w0(3) by auto
     also have "... = \<rho> (fst y) w (snd y)"
       using w0 xy by (metis Int_subset_iff assoc_comp subset_of_opens that)
     finally show ?thesis .
   qed
   with w0 have "\<exists>w0. w0 \<in> I \<and> w0 \<subseteq> fst x \<inter> fst y
             \<and> (\<forall>w. (w\<subseteq>w0 \<and> w\<in>I) \<longrightarrow> \<rho> (fst x) w (snd x) = \<rho> (fst y) w (snd y))"
     by auto
   then have "\<forall>\<^sub>F w in lbound {fst x,fst y}. \<rho> (fst x) w (snd x) = \<rho> (fst y) w (snd y)"
     apply (subst eventually_lbound_finite)
     using xy(1,2) by auto
   then show ?thesis
     using llbound_lbound[of "{fst x,fst y}"] xy(1,2) by auto
 qed
 
 lemma
   fixes x y:: "'a set \<times> 'b" and z z':: "'a set"
   assumes xy:"x \<in> Sigma I \<FF>" "y \<in> Sigma I \<FF>"
   assumes z:"z\<in>I" "z \<subseteq> fst x" "z \<subseteq> fst y"
   assumes z':"z'\<in>I" "z' \<subseteq> fst x" "z' \<subseteq> fst y"
   shows add_rel_well_defined:"\<lfloor>z, add_str z (\<rho> (fst x) z (snd x)) (\<rho> (fst y) z (snd y))\<rfloor> =
           \<lfloor>z', add_str z' (\<rho> (fst x) z' (snd x)) (\<rho> (fst y) z' (snd y))\<rfloor>" (is "?add")
     and mult_rel_well_defined:
         "\<lfloor>z, mult_str z (\<rho> (fst x) z (snd x)) (\<rho> (fst y) z (snd y))\<rfloor> =
          \<lfloor>z', mult_str z' (\<rho> (fst x) z' (snd x)) (\<rho> (fst y) z' (snd y))\<rfloor>" (is "?mult")
 proof -
   interpret xz:ring_homomorphism "(\<rho> (fst x) z)" "(\<FF> (fst x))"
               "+\<^bsub>fst x\<^esub>" "\<cdot>\<^bsub>fst x\<^esub>" "\<zero>\<^bsub>fst x\<^esub>" "\<one>\<^bsub>fst x\<^esub>" "(\<FF> z)" "+\<^bsub>z\<^esub>" "\<cdot>\<^bsub>z\<^esub>" "\<zero>\<^bsub>z\<^esub>" "\<one>\<^bsub>z\<^esub>"
     using is_ring_morphism \<open>x \<in> Sigma I \<FF>\<close> z subset_of_opens by force
   interpret yz:ring_homomorphism "(\<rho> (fst y) z)" "(\<FF> (fst y))"
               "+\<^bsub>fst y\<^esub>" "\<cdot>\<^bsub>fst y\<^esub>" "\<zero>\<^bsub>fst y\<^esub>" "\<one>\<^bsub>fst y\<^esub>" "(\<FF> z)" "+\<^bsub>z\<^esub>" "\<cdot>\<^bsub>z\<^esub>" "\<zero>\<^bsub>z\<^esub>" "\<one>\<^bsub>z\<^esub>"
     using is_ring_morphism \<open>y \<in> Sigma I \<FF>\<close> z subset_of_opens by force
   interpret xz':ring_homomorphism "(\<rho> (fst x) z')" "(\<FF> (fst x))"
               "+\<^bsub>fst x\<^esub>" "\<cdot>\<^bsub>fst x\<^esub>" "\<zero>\<^bsub>fst x\<^esub>" "\<one>\<^bsub>fst x\<^esub>" "(\<FF> z')" "+\<^bsub>z'\<^esub>" "\<cdot>\<^bsub>z'\<^esub>" "\<zero>\<^bsub>z'\<^esub>" "\<one>\<^bsub>z'\<^esub>"
     using is_ring_morphism \<open>x \<in> Sigma I \<FF>\<close> z' subset_of_opens by force
   interpret yz':ring_homomorphism "(\<rho> (fst y) z')" "(\<FF> (fst y))"
               "+\<^bsub>fst y\<^esub>" "\<cdot>\<^bsub>fst y\<^esub>" "\<zero>\<^bsub>fst y\<^esub>" "\<one>\<^bsub>fst y\<^esub>" "(\<FF> z')" "+\<^bsub>z'\<^esub>" "\<cdot>\<^bsub>z'\<^esub>" "\<zero>\<^bsub>z'\<^esub>" "\<one>\<^bsub>z'\<^esub>"
     using is_ring_morphism \<open>y \<in> Sigma I \<FF>\<close> z' subset_of_opens by force
 
   obtain w where w:"w \<in> I" "w \<subseteq> z \<inter> z'"
     using has_lower_bound \<open>z\<in>I\<close> \<open>z'\<in>I\<close> by meson
 
   interpret zw:ring_homomorphism "\<rho> z w" "(\<FF> z)" "+\<^bsub>z\<^esub>" "\<cdot>\<^bsub>z\<^esub>" "\<zero>\<^bsub>z\<^esub>" "\<one>\<^bsub>z\<^esub>"
       "\<FF> w" "+\<^bsub>w\<^esub>" "\<cdot>\<^bsub>w\<^esub>" "\<zero>\<^bsub>w\<^esub>" "\<one>\<^bsub>w\<^esub>"
     using w by (meson is_ring_morphism le_inf_iff subset_of_opens z(1))
   interpret z'w:ring_homomorphism "\<rho> z' w" "(\<FF> z')" "+\<^bsub>z'\<^esub>" "\<cdot>\<^bsub>z'\<^esub>" "\<zero>\<^bsub>z'\<^esub>" "\<one>\<^bsub>z'\<^esub>"
       "\<FF> w" "+\<^bsub>w\<^esub>" "\<cdot>\<^bsub>w\<^esub>" "\<zero>\<^bsub>w\<^esub>" "\<one>\<^bsub>w\<^esub>"
     using \<open>w \<in> I\<close> \<open>w \<subseteq> z \<inter> z'\<close> z' by (meson is_ring_morphism le_inf_iff subset_of_opens)
 
   show ?add
   proof (rule class_of_eqI[OF _ _ \<open>w \<in> I\<close> \<open>w \<subseteq> z \<inter> z'\<close>])
     define xz yz where "xz = \<rho> (fst x) z (snd x)" and "yz = \<rho> (fst y) z (snd y)"
     define xz' yz' where "xz' = \<rho> (fst x) z' (snd x)" and "yz' = \<rho> (fst y) z' (snd y)"
     show "(z, +\<^bsub>z\<^esub> xz yz) \<in> Sigma I \<FF>" "(z', +\<^bsub>z'\<^esub> xz' yz') \<in> Sigma I \<FF>"
       subgoal using assms(1) assms(2) xz_def yz_def z(1) by fastforce
       subgoal using assms(1) assms(2) xz'_def yz'_def z'(1) by fastforce
       done
     have "\<rho> z w (+\<^bsub>z\<^esub> xz yz) = +\<^bsub>w\<^esub> (\<rho> z w xz) (\<rho> z w yz)"
       apply (rule zw.additive.commutes_with_composition)
       using assms(1,2) xz_def yz_def by force+
     also have "... = +\<^bsub>w\<^esub> (\<rho> (fst x) w (snd x)) (\<rho> (fst y) w (snd y))"
       unfolding xz_def yz_def
       using assoc_comp w z subset_of_opens assms
       by (metis SigmaE le_inf_iff o_def prod.sel)
     also have "... = +\<^bsub>w\<^esub> (\<rho> z' w xz') (\<rho> z' w yz')"
       unfolding xz'_def yz'_def
       using assoc_comp  w z' subset_of_opens assms
       by (metis SigmaE le_inf_iff o_def prod.sel)
     also have "... = \<rho> z' w (+\<^bsub>z'\<^esub> xz' yz')"
       using assms(2) xy(1) xz'_def yz'_def z'w.additive.commutes_with_composition by force
     finally show "\<rho> z w (+\<^bsub>z\<^esub> xz yz) = \<rho> z' w (+\<^bsub>z'\<^esub> xz' yz')" .
   qed
 
   show ?mult
   proof (rule class_of_eqI[OF _ _ \<open>w \<in> I\<close> \<open>w \<subseteq> z \<inter> z'\<close>])
     define xz yz where "xz = \<rho> (fst x) z (snd x)" and "yz = \<rho> (fst y) z (snd y)"
     define xz' yz' where "xz' = \<rho> (fst x) z' (snd x)" and "yz' = \<rho> (fst y) z' (snd y)"
     show "(z, \<cdot>\<^bsub>z\<^esub> xz yz) \<in> Sigma I \<FF>" "(z', \<cdot>\<^bsub>z'\<^esub> xz' yz') \<in> Sigma I \<FF>"
       unfolding xz_def yz_def xz'_def yz'_def
       using assms by auto
     have "\<rho> z w (\<cdot>\<^bsub>z\<^esub> xz yz) = \<cdot>\<^bsub>w\<^esub> (\<rho> z w xz) (\<rho> z w yz)"
       apply (rule zw.multiplicative.commutes_with_composition)
       using xy xz_def yz_def by force+
     also have "... = \<cdot>\<^bsub>w\<^esub> (\<rho> (fst x) w (snd x)) (\<rho> (fst y) w (snd y))"
       unfolding xz_def yz_def
       using xy w z assoc_comp
       by (metis SigmaE fst_conv le_inf_iff o_def snd_conv subset_of_opens)
     also have "... = \<cdot>\<^bsub>w\<^esub> (\<rho> z' w xz') (\<rho> z' w yz')"
       unfolding xz'_def yz'_def
       using xy w z' assoc_comp
       by (metis SigmaE fst_conv le_inf_iff o_def snd_conv subset_of_opens)
     also have "... = \<rho> z' w (\<cdot>\<^bsub>z'\<^esub> xz' yz')"
       unfolding xz'_def yz'_def
       using monoid_homomorphism.commutes_with_composition xy z'w.multiplicative.monoid_homomorphism_axioms by fastforce
     finally show "\<rho> z w (\<cdot>\<^bsub>z\<^esub> xz yz) = \<rho> z' w (\<cdot>\<^bsub>z'\<^esub> xz' yz')" .
   qed
 qed
 
 lemma add_rel_well_defined_llbound:
   fixes x y:: "'a set \<times> 'b" and z z':: "'a set"
   assumes "x \<in> Sigma I \<FF>" "y \<in> Sigma I \<FF>"
   assumes z:"z\<in>I" "z \<subseteq> fst x" "z \<subseteq> fst y"
   shows "\<forall>\<^sub>F w in llbound. \<lfloor>z, add_str z (\<rho> (fst x) z (snd x)) (\<rho> (fst y) z (snd y))\<rfloor> =
           \<lfloor>w, add_str w (\<rho> (fst x) w (snd x)) (\<rho> (fst y) w (snd y))\<rfloor>" (is "\<forall>\<^sub>F w in _. ?P w")
 proof -
   have  "\<forall>w. w \<subseteq> z \<and> w \<in> I \<longrightarrow>?P w "
     by (meson add_rel_well_defined assms(1) assms(2) dual_order.trans z(1) z(2) z(3))
   then have "\<forall>\<^sub>F w in lbound {fst x,fst y}. ?P w"
     apply (subst eventually_lbound_finite)
     using assms by auto
   then show ?thesis
     using llbound_lbound[of "{fst x,fst y}"] assms(1,2) by auto
 qed
 
 lemma mult_rel_well_defined_llbound:
   fixes x y:: "'a set \<times> 'b" and z z':: "'a set"
   assumes "x \<in> Sigma I \<FF>" "y \<in> Sigma I \<FF>"
   assumes z:"z\<in>I" "z \<subseteq> fst x" "z \<subseteq> fst y"
   shows "\<forall>\<^sub>F w in llbound. \<lfloor>z, mult_str z (\<rho> (fst x) z (snd x)) (\<rho> (fst y) z (snd y))\<rfloor> =
           \<lfloor>w, mult_str w (\<rho> (fst x) w (snd x)) (\<rho> (fst y) w (snd y))\<rfloor>" (is "\<forall>\<^sub>F w in _. ?P w")
 proof -
   have  "\<forall>w. w \<subseteq> z \<and> w \<in> I \<longrightarrow>?P w "
     by (meson mult_rel_well_defined assms(1) assms(2) dual_order.trans z(1) z(2) z(3))
   then have "\<forall>\<^sub>F w in lbound {fst x,fst y}. ?P w"
     apply (subst eventually_lbound_finite)
     using assms by auto
   then show ?thesis
     using llbound_lbound[of "{fst x,fst y}"] assms(1,2) by auto
 qed
 
 lemma add_rel_class_of:
   fixes U V W :: "'a set" and x y :: 'b
   assumes uv_sigma:"(U, x) \<in> Sigma I \<FF>" "(V, y) \<in> Sigma I \<FF>"
   assumes w:"W \<in> I" "W \<subseteq> U" "W \<subseteq> V"
   shows "add_rel \<lfloor>U, x\<rfloor> \<lfloor>V, y\<rfloor> = \<lfloor>W, +\<^bsub>W\<^esub> (\<rho> U W x) (\<rho> V W y)\<rfloor>"
 proof -
   define ux where "ux = (SOME ux. ux \<in> \<lfloor>U, x\<rfloor>)"
   define vy where "vy = (SOME ux. ux \<in> \<lfloor>V, y\<rfloor>)"
   have "ux \<in> \<lfloor>U, x\<rfloor>" "vy \<in> \<lfloor>V, y\<rfloor> "
     unfolding ux_def vy_def using uv_sigma class_of_def some_in_eq by blast+
   then have "ux \<in> Sigma I \<FF>" "vy \<in> Sigma I \<FF>"
     using class_of_def uv_sigma by blast+
   then have "fst ux \<in> I" "fst vy \<in> I" by auto
 
   define w1 where "w1 = get_lower_bound (fst ux) (fst vy)"
   have w1:"w1 \<in> I" "w1 \<subseteq> fst ux" "w1 \<subseteq> fst vy"
     using get_lower_bound[OF \<open>fst ux \<in> I\<close> \<open>fst vy \<in> I\<close>] unfolding w1_def by auto
 
   have "add_rel \<lfloor>U, x\<rfloor> \<lfloor>V, y\<rfloor> = \<lfloor>w1, +\<^bsub>w1\<^esub> (\<rho> (fst ux) w1 (snd ux)) (\<rho> (fst vy) w1 (snd vy))\<rfloor>"
     unfolding add_rel_def
     apply (fold ux_def vy_def)
     by (simp add:Let_def w1_def)
   moreover have "\<forall>\<^sub>F w in llbound.
             ... = \<lfloor>w, add_str w (\<rho> (fst ux) w (snd ux)) (\<rho> (fst vy) w (snd vy))\<rfloor>"
     apply (rule add_rel_well_defined_llbound)
     using \<open>ux \<in> Sigma I \<FF>\<close> \<open>vy \<in> Sigma I \<FF>\<close> w1 by auto
   ultimately have "\<forall>\<^sub>F w in llbound. add_rel \<lfloor>U, x\<rfloor> \<lfloor>V, y\<rfloor>
       = \<lfloor>w, add_str w (\<rho> (fst ux) w (snd ux)) (\<rho> (fst vy) w (snd vy))\<rfloor>"
     by simp
   moreover have
     "\<forall>\<^sub>F w in llbound. \<rho> (fst ux) w (snd ux) = \<rho> (fst (U, x)) w (snd (U, x))"
     "\<forall>\<^sub>F w in llbound. \<rho> (fst vy) w (snd vy) = \<rho> (fst (V, y)) w (snd (V, y))"
     subgoal
       apply (rule rel_eventually_llbound)
       using \<open>ux \<in> \<lfloor>U, x\<rfloor>\<close> class_of_def uv_sigma(1) by auto
     subgoal
       apply (rule rel_eventually_llbound)
       using \<open>vy \<in> \<lfloor>V, y\<rfloor>\<close> class_of_def uv_sigma(2) by auto
     done
   ultimately have "\<forall>\<^sub>F w in llbound. add_rel \<lfloor>U, x\<rfloor> \<lfloor>V, y\<rfloor>
       = \<lfloor>w, add_str w (\<rho> U w x) (\<rho> V w y)\<rfloor>"
     apply eventually_elim
     by auto
   moreover have "\<forall>\<^sub>F w in llbound. \<lfloor>W, +\<^bsub>W\<^esub> (\<rho> U W x) (\<rho> V W y)\<rfloor> = \<lfloor>w, +\<^bsub>w\<^esub> (\<rho> U w x) (\<rho> V w y)\<rfloor>"
     apply (rule add_rel_well_defined_llbound[of "(U,x)" "(V,y)" W,simplified])
     using w uv_sigma by auto
   ultimately have "\<forall>\<^sub>F w in llbound.
       add_rel \<lfloor>U, x\<rfloor> \<lfloor>V, y\<rfloor> = \<lfloor>W, +\<^bsub>W\<^esub> (\<rho> U W x) (\<rho> V W y)\<rfloor>"
     apply eventually_elim
     by auto
   moreover have "llbound\<noteq>bot" using llbound_not_bot w(1) by blast
   ultimately show ?thesis by auto
 qed
 
 lemma mult_rel_class_of:
   fixes U V W :: "'a set" and x y :: 'b
   assumes uv_sigma:"(U, x) \<in> Sigma I \<FF>" "(V, y) \<in> Sigma I \<FF>"
   assumes w:"W \<in> I" "W \<subseteq> U" "W \<subseteq> V"
   shows "mult_rel \<lfloor>U, x\<rfloor> \<lfloor>V, y\<rfloor> = \<lfloor>W, \<cdot>\<^bsub>W\<^esub> (\<rho> U W x) (\<rho> V W y)\<rfloor>"
 proof -
   define ux where "ux = (SOME ux. ux \<in> \<lfloor>U, x\<rfloor>)"
   define vy where "vy = (SOME ux. ux \<in> \<lfloor>V, y\<rfloor>)"
   have "ux \<in> \<lfloor>U, x\<rfloor>" "vy \<in> \<lfloor>V, y\<rfloor> "
     unfolding ux_def vy_def using uv_sigma class_of_def some_in_eq by blast+
   then have "ux \<in> Sigma I \<FF>" "vy \<in> Sigma I \<FF>"
     using class_of_def uv_sigma by blast+
   then have "fst ux \<in> I" "fst vy \<in> I" by auto
 
   define w1 where "w1 = get_lower_bound (fst ux) (fst vy)"
   have w1:"w1 \<in> I" "w1 \<subseteq> fst ux" "w1 \<subseteq> fst vy"
     using get_lower_bound[OF \<open>fst ux \<in> I\<close> \<open>fst vy \<in> I\<close>] unfolding w1_def by auto
 
   have "mult_rel \<lfloor>U, x\<rfloor> \<lfloor>V, y\<rfloor> = \<lfloor>w1, \<cdot>\<^bsub>w1\<^esub> (\<rho> (fst ux) w1 (snd ux)) (\<rho> (fst vy) w1 (snd vy))\<rfloor>"
     unfolding mult_rel_def
     apply (fold ux_def vy_def)
     by (simp add:Let_def w1_def)
   moreover have "\<forall>\<^sub>F w in llbound.
             ... = \<lfloor>w, mult_str w (\<rho> (fst ux) w (snd ux)) (\<rho> (fst vy) w (snd vy))\<rfloor>"
     apply (rule mult_rel_well_defined_llbound)
     using \<open>ux \<in> Sigma I \<FF>\<close> \<open>vy \<in> Sigma I \<FF>\<close> w1 by auto
   ultimately have "\<forall>\<^sub>F w in llbound. mult_rel \<lfloor>U, x\<rfloor> \<lfloor>V, y\<rfloor>
       = \<lfloor>w, mult_str w (\<rho> (fst ux) w (snd ux)) (\<rho> (fst vy) w (snd vy))\<rfloor>"
     by simp
   moreover have
     "\<forall>\<^sub>F w in llbound. \<rho> (fst ux) w (snd ux) = \<rho> (fst (U, x)) w (snd (U, x))"
     "\<forall>\<^sub>F w in llbound. \<rho> (fst vy) w (snd vy) = \<rho> (fst (V, y)) w (snd (V, y))"
     subgoal
       apply (rule rel_eventually_llbound)
       using \<open>ux \<in> \<lfloor>U, x\<rfloor>\<close> class_of_def uv_sigma(1) by auto
     subgoal
       apply (rule rel_eventually_llbound)
       using \<open>vy \<in> \<lfloor>V, y\<rfloor>\<close> class_of_def uv_sigma(2) by auto
     done
   ultimately have "\<forall>\<^sub>F w in llbound. mult_rel \<lfloor>U, x\<rfloor> \<lfloor>V, y\<rfloor>
       = \<lfloor>w, mult_str w (\<rho> U w x) (\<rho> V w y)\<rfloor>"
     apply eventually_elim
     by auto
   moreover have "\<forall>\<^sub>F w in llbound. \<lfloor>W, \<cdot>\<^bsub>W\<^esub> (\<rho> U W x) (\<rho> V W y)\<rfloor> = \<lfloor>w, \<cdot>\<^bsub>w\<^esub> (\<rho> U w x) (\<rho> V w y)\<rfloor>"
     apply (rule mult_rel_well_defined_llbound[of "(U,x)" "(V,y)" W,simplified])
     using w uv_sigma by auto
   ultimately have "\<forall>\<^sub>F w in llbound.
       mult_rel \<lfloor>U, x\<rfloor> \<lfloor>V, y\<rfloor> = \<lfloor>W, \<cdot>\<^bsub>W\<^esub> (\<rho> U W x) (\<rho> V W y)\<rfloor>"
     apply eventually_elim
     by auto
   moreover have "llbound\<noteq>bot" using llbound_not_bot w(1) by blast
   ultimately show ?thesis by auto
 qed
 
 lemma mult_rel_carrier[intro]:
   assumes "X \<in> carrier_direct_lim" "Y \<in> carrier_direct_lim"
   shows "mult_rel X Y \<in> carrier_direct_lim"
 proof -
   define x where "x=(SOME x. x \<in> X)"
   define y where "y=(SOME y. y \<in> Y)"
 
   have "x\<in>X" "x\<in>Sigma I \<FF>"
     using rel_carrier_Eps_in[OF \<open>X \<in> carrier_direct_lim\<close>] unfolding x_def by auto
   have "y\<in>Y" "y \<in> Sigma I \<FF>"
     using rel_carrier_Eps_in[OF \<open>Y \<in> carrier_direct_lim\<close>] unfolding y_def by auto
 
   define z where "z=get_lower_bound (fst x) (fst y)"
   have "z \<in> I" "z \<subseteq> fst x" "z \<subseteq> fst y"
   proof -
     have "fst x \<in> I" "fst y \<in> I"
       using \<open>x \<in> Sigma I \<FF>\<close> \<open>y \<in> Sigma I \<FF>\<close> by auto
     then show "z \<in> I" "z \<subseteq> fst x" "z \<subseteq> fst y"
       using get_lower_bound[of "fst x" "fst y",folded z_def] by auto
   qed
 
   have "mult_rel X Y = \<lfloor>z, mult_str z (\<rho> (fst x) z (snd x)) (\<rho> (fst y) z (snd y))\<rfloor>"
     unfolding mult_rel_def Let_def
     by (fold x_def y_def z_def,rule)
   also have "... \<in> carrier_direct_lim"
     unfolding carrier_direct_lim_def class_of_def
   proof (rule rel.Block_closed)
     interpret ring "(\<FF> z)" "+\<^bsub>z\<^esub>" "\<cdot>\<^bsub>z\<^esub>" "\<zero>\<^bsub>z\<^esub>" "\<one>\<^bsub>z\<^esub>"
       by (simp add: \<open>z \<in> I\<close> is_ring_from_is_homomorphism subset_of_opens)
     show "(z, \<cdot>\<^bsub>z\<^esub> (\<rho> (fst x) z (snd x)) (\<rho> (fst y) z (snd y))) \<in> Sigma I \<FF>"
       by (metis SigmaE SigmaI \<open>x \<in> Sigma I \<FF>\<close> \<open>y \<in> Sigma I \<FF>\<close> \<open>z \<in> I\<close> \<open>z \<subseteq> fst x\<close> \<open>z \<subseteq> fst y\<close>
           direct_lim.subset_of_opens direct_lim_axioms fst_conv
           is_map_from_is_homomorphism map.map_closed multiplicative.composition_closed snd_conv)
   qed
   finally show ?thesis .
 qed
 
 (* exercise 0.35 *)
 lemma direct_lim_is_ring:
   assumes "U \<in> I"
   shows "ring carrier_direct_lim add_rel mult_rel \<lfloor>U, \<zero>\<^bsub>U\<^esub>\<rfloor> \<lfloor>U, \<one>\<^bsub>U\<^esub>\<rfloor>"
 proof unfold_locales
   show add_rel: "add_rel a b \<in> carrier_direct_lim" and mult_rel: "mult_rel a b \<in> carrier_direct_lim"
     if "a \<in> carrier_direct_lim" "b \<in> carrier_direct_lim" for a b
     using \<open>U \<in> I\<close> that by auto
   show zero_rel: "\<lfloor>U, \<zero>\<^bsub>U\<^esub>\<rfloor> \<in> carrier_direct_lim" and one_rel: "\<lfloor>U, \<one>\<^bsub>U\<^esub>\<rfloor> \<in> carrier_direct_lim"
     using \<open>U \<in> I\<close> by auto
 
   show add_rel_0: "add_rel \<lfloor>U, \<zero>\<^bsub>U\<^esub>\<rfloor> X = X"
     and "mult_rel \<lfloor>U, \<one>\<^bsub>U\<^esub>\<rfloor> X = X"
     and "mult_rel X \<lfloor>U, \<one>\<^bsub>U\<^esub>\<rfloor> = X"
       if "X \<in> carrier_direct_lim" for X
   proof -
     define x where "x=(SOME x. x \<in> X)"
     have x:"x\<in>X" "x\<in>Sigma I \<FF>" "fst x\<in>I" and X_alt:"X= \<lfloor>fst x, snd x\<rfloor>"
       using rel_carrier_Eps_in[OF \<open>X \<in> carrier_direct_lim\<close>]
       unfolding x_def by auto
 
     obtain w0 where w0:"w0\<in>I" "w0 \<subseteq> U" "w0 \<subseteq> fst x"
       using has_lower_bound[OF \<open>U\<in>I\<close> \<open>fst x\<in>I\<close>] by blast
 
     interpret uw0:ring_homomorphism "\<rho> U w0" "\<FF> U" "+\<^bsub>U\<^esub>" "\<cdot>\<^bsub>U\<^esub>" "\<zero>\<^bsub>U\<^esub>" "\<one>\<^bsub>U\<^esub>" "\<FF> w0" "+\<^bsub>w0\<^esub>"
                     "\<cdot>\<^bsub>w0\<^esub>" "\<zero>\<^bsub>w0\<^esub>" "\<one>\<^bsub>w0\<^esub>"
       using is_ring_morphism \<open>U\<in>I\<close> w0 subset_of_opens by auto
     interpret xw0:ring_homomorphism "\<rho> (fst x) w0" "\<FF> (fst x)" "+\<^bsub>fst x\<^esub>" "\<cdot>\<^bsub>fst x\<^esub>" "\<zero>\<^bsub>fst x\<^esub>"
                     "\<one>\<^bsub>fst x\<^esub>" "\<FF> w0" "+\<^bsub>w0\<^esub>" "\<cdot>\<^bsub>w0\<^esub>" "\<zero>\<^bsub>w0\<^esub>" "\<one>\<^bsub>w0\<^esub>"
       using is_ring_morphism \<open>fst x\<in>I\<close> w0 subset_of_opens by auto
 
     have "add_rel \<lfloor>U, \<zero>\<^bsub>U\<^esub>\<rfloor> X = \<lfloor>w0, +\<^bsub>w0\<^esub> (\<rho> U w0 \<zero>\<^bsub>U\<^esub>) (\<rho> (fst x) w0 (snd x))\<rfloor>"
       unfolding X_alt
       apply (subst add_rel_class_of)
       using \<open>U \<in> I\<close> w0 x by simp_all
     also have "... = \<lfloor>w0, +\<^bsub>w0\<^esub> \<zero>\<^bsub>w0\<^esub> (\<rho> (fst x) w0 (snd x))\<rfloor>"
       by (simp add:uw0.additive.commutes_with_unit )
     also have "... = \<lfloor>w0, \<rho> (fst x) w0 (snd x)\<rfloor>"
       apply (subst uw0.target.additive.left_unit)
       using carrier_direct_lim_def rel.block_closed that x(1) by auto
     also have "... = X"
       unfolding X_alt
       apply (rule class_of_eqI[where W=w0])
       using w0 x subset_of_opens by auto
     finally show "add_rel \<lfloor>U, \<zero>\<^bsub>U\<^esub>\<rfloor> X = X" .
 
     have "mult_rel \<lfloor>U, \<one>\<^bsub>U\<^esub>\<rfloor> X = \<lfloor>w0, \<cdot>\<^bsub>w0\<^esub> (\<rho> U w0 \<one>\<^bsub>U\<^esub>) (\<rho> (fst x) w0 (snd x))\<rfloor>"
       unfolding X_alt
       apply (subst mult_rel_class_of)
       using \<open>U \<in> I\<close> w0 x by simp_all
     also have "... = \<lfloor>w0, \<cdot>\<^bsub>w0\<^esub> \<one>\<^bsub>w0\<^esub> (\<rho> (fst x) w0 (snd x))\<rfloor>"
       by (simp add: uw0.multiplicative.commutes_with_unit)
     also have "... = \<lfloor>w0, \<rho> (fst x) w0 (snd x)\<rfloor>"
       apply (subst uw0.target.multiplicative.left_unit)
       using carrier_direct_lim_def rel.block_closed that x(1) by auto
     also have "... = X"
       using X_alt \<open>\<lfloor>w0, \<rho> (fst x) w0 (snd x)\<rfloor> = X\<close> by force
     finally show "mult_rel \<lfloor>U, \<one>\<^bsub>U\<^esub>\<rfloor> X = X" .
 
     have "mult_rel X \<lfloor>U, \<one>\<^bsub>U\<^esub>\<rfloor> = \<lfloor>w0, \<cdot>\<^bsub>w0\<^esub> (\<rho> (fst x) w0 (snd x)) (\<rho> U w0 \<one>\<^bsub>U\<^esub>)\<rfloor>"
       unfolding X_alt
       apply (subst mult_rel_class_of)
       using \<open>U \<in> I\<close> w0 x by simp_all
     also have "... = \<lfloor>w0, \<cdot>\<^bsub>w0\<^esub> (\<rho> (fst x) w0 (snd x)) \<one>\<^bsub>w0\<^esub> \<rfloor>"
       by (simp add: uw0.multiplicative.commutes_with_unit)
     also have "... = \<lfloor>w0, \<rho> (fst x) w0 (snd x)\<rfloor>"
       apply (subst uw0.target.multiplicative.right_unit)
       using carrier_direct_lim_def rel.block_closed that x(1) by auto
     also have "... = X"
       using X_alt \<open>\<lfloor>w0, \<rho> (fst x) w0 (snd x)\<rfloor> = X\<close> by force
     finally show "mult_rel X \<lfloor>U, \<one>\<^bsub>U\<^esub>\<rfloor> = X" .
   qed
 
   show add_rel_commute: "add_rel X Y = add_rel Y X"
     if "X \<in> carrier_direct_lim" "Y \<in> carrier_direct_lim" for X Y
   proof -
     define x where "x=(SOME x. x \<in> X)"
     define y where "y=(SOME y. y \<in> Y)"
 
     have x:"x\<in>X" "x\<in>Sigma I \<FF>"
       using rel_carrier_Eps_in[OF \<open>X \<in> carrier_direct_lim\<close>] unfolding x_def by auto
     have y:"y\<in>Y" "y \<in> Sigma I \<FF>"
       using rel_carrier_Eps_in[OF \<open>Y \<in> carrier_direct_lim\<close>] unfolding y_def by auto
 
     define z where "z=get_lower_bound (fst x) (fst y)"
     have z:"z \<in> I" "z \<subseteq> fst x" "z \<subseteq> fst y" and z_alt:"z=get_lower_bound (fst y) (fst x) "
     proof -
       have "fst x \<in> I" "fst y \<in> I"
         using \<open>x \<in> Sigma I \<FF>\<close> \<open>y \<in> Sigma I \<FF>\<close> by auto
       then show "z \<in> I" "z \<subseteq> fst x" "z \<subseteq> fst y"
         using get_lower_bound[of "fst x" "fst y",folded z_def] by auto
       show "z=get_lower_bound (fst y) (fst x) "
         by (metis (no_types, lifting) Eps_cong get_lower_bound_def z_def)
     qed
 
     interpret xz:ring_homomorphism "(\<rho> (fst x) z)" "(\<FF> (fst x))" "+\<^bsub>fst x\<^esub>" "\<cdot>\<^bsub>fst x\<^esub>"
                       "\<zero>\<^bsub>fst x\<^esub>" "\<one>\<^bsub>fst x\<^esub>" "(\<FF> z)" "+\<^bsub>z\<^esub>" "\<cdot>\<^bsub>z\<^esub>" "\<zero>\<^bsub>z\<^esub>" "\<one>\<^bsub>z\<^esub>"
       using is_ring_morphism z x subset_of_opens by force
 
     interpret yz:ring_homomorphism "(\<rho> (fst y) z)" "(\<FF> (fst y))" "+\<^bsub>fst y\<^esub>" "\<cdot>\<^bsub>fst y\<^esub>"
                       "\<zero>\<^bsub>fst y\<^esub>" "\<one>\<^bsub>fst y\<^esub>" "(\<FF> z)" "+\<^bsub>z\<^esub>" "\<cdot>\<^bsub>z\<^esub>" "\<zero>\<^bsub>z\<^esub>" "\<one>\<^bsub>z\<^esub>"
       using is_ring_morphism z y subset_of_opens by auto
 
     have "add_rel X Y = \<lfloor>z, add_str z (\<rho> (fst x) z (snd x)) (\<rho> (fst y) z (snd y))\<rfloor>"
       unfolding add_rel_def Let_def by (fold x_def y_def z_def,rule)
     also have "... = add_rel Y X"
       unfolding add_rel_def Let_def
       apply (fold x_def y_def z_alt)
       using \<open>x \<in> Sigma I \<FF>\<close> \<open>y \<in> Sigma I \<FF>\<close> xz.target.additive.commutative by auto
     finally show "add_rel X Y = add_rel Y X" .
   qed
 
   show add_assoc:"add_rel (add_rel X Y) Z = add_rel X (add_rel Y Z)"
        "mult_rel (mult_rel X Y) Z = mult_rel X (mult_rel Y Z)"
        "mult_rel X (add_rel Y Z) = add_rel (mult_rel X Y) (mult_rel X Z)"
        "mult_rel (add_rel Y Z) X = add_rel (mult_rel Y X) (mult_rel Z X)"
     if "X \<in> carrier_direct_lim" "Y \<in> carrier_direct_lim" "Z \<in> carrier_direct_lim" for X Y Z
   proof -
     define x where "x=(SOME x. x \<in> X)"
     define y where "y=(SOME y. y \<in> Y)"
     define z where "z=(SOME z. z \<in> Z)"
 
     have x:"x\<in>X" "x\<in>Sigma I \<FF>" and x_alt:"X = \<lfloor>fst x,snd x\<rfloor>"
       using rel_carrier_Eps_in[OF \<open>X \<in> carrier_direct_lim\<close>] unfolding x_def by auto
     have y:"y\<in>Y" "y \<in> Sigma I \<FF>" and y_alt:"Y = \<lfloor>fst y,snd y\<rfloor>"
       using rel_carrier_Eps_in[OF \<open>Y \<in> carrier_direct_lim\<close>] unfolding y_def by auto
     have z:"z\<in>Z" "z \<in> Sigma I \<FF>" and z_alt:"Z = \<lfloor>fst z,snd z\<rfloor>"
       using rel_carrier_Eps_in[OF \<open>Z \<in> carrier_direct_lim\<close>] unfolding z_def by auto
 
     obtain w0 where w0:"w0 \<in> I" "w0 \<subseteq> fst x" "w0 \<subseteq> fst y" "w0 \<subseteq> fst z"
       using obtain_lower_bound_finite[of "{fst x,fst y,fst z}"] x y z
       by force
 
     interpret xw0:ring_homomorphism "\<rho> (fst x) w0" "\<FF> (fst x)" "+\<^bsub>fst x\<^esub>" "\<cdot>\<^bsub>fst x\<^esub>" "\<zero>\<^bsub>fst x\<^esub>"
                     "\<one>\<^bsub>fst x\<^esub>" "\<FF> w0" "+\<^bsub>w0\<^esub>" "\<cdot>\<^bsub>w0\<^esub>" "\<zero>\<^bsub>w0\<^esub>" "\<one>\<^bsub>w0\<^esub>"
       using is_ring_morphism x w0 subset_of_opens by auto
     interpret yw0:ring_homomorphism "\<rho> (fst y) w0" "\<FF> (fst y)" "+\<^bsub>fst y\<^esub>" "\<cdot>\<^bsub>fst y\<^esub>" "\<zero>\<^bsub>fst y\<^esub>"
                     "\<one>\<^bsub>fst y\<^esub>" "\<FF> w0" "+\<^bsub>w0\<^esub>" "\<cdot>\<^bsub>w0\<^esub>" "\<zero>\<^bsub>w0\<^esub>" "\<one>\<^bsub>w0\<^esub>"
       using is_ring_morphism y w0 subset_of_opens by auto
     interpret zw0:ring_homomorphism "\<rho> (fst z) w0" "\<FF> (fst z)" "+\<^bsub>fst z\<^esub>" "\<cdot>\<^bsub>fst z\<^esub>" "\<zero>\<^bsub>fst z\<^esub>"
                     "\<one>\<^bsub>fst z\<^esub>" "\<FF> w0" "+\<^bsub>w0\<^esub>" "\<cdot>\<^bsub>w0\<^esub>" "\<zero>\<^bsub>w0\<^esub>" "\<one>\<^bsub>w0\<^esub>"
       using is_ring_morphism z w0 subset_of_opens by auto
 
     have "add_rel (add_rel X Y) Z = \<lfloor>w0, +\<^bsub>w0\<^esub> ((+\<^bsub>w0\<^esub> (\<rho> (fst x) w0 (snd x))
                                 (\<rho> (fst y) w0 (snd y)))) (\<rho> (fst z) w0 (snd z))\<rfloor>"
       unfolding x_alt y_alt z_alt
       using x y z w0 subset_of_opens add_rel_class_of
       by (force simp add: add_rel_class_of)
     also have "... = \<lfloor>w0, +\<^bsub>w0\<^esub> (\<rho> (fst x) w0 (snd x))
                               (+\<^bsub>w0\<^esub> (\<rho> (fst y) w0 (snd y)) (\<rho> (fst z) w0 (snd z)))\<rfloor>"
       using x(2) xw0.target.additive.associative y(2) z(2) by force
     also have "... =  add_rel X (add_rel Y Z)"
       unfolding x_alt y_alt z_alt
       using x y z w0 add_rel_class_of subset_of_opens by force
     finally show "add_rel (add_rel X Y) Z = add_rel X (add_rel Y Z)" .
 
     have "mult_rel (mult_rel X Y) Z = \<lfloor>w0, \<cdot>\<^bsub>w0\<^esub> ((\<cdot>\<^bsub>w0\<^esub> (\<rho> (fst x) w0 (snd x))
                                 (\<rho> (fst y) w0 (snd y)))) (\<rho> (fst z) w0 (snd z))\<rfloor>"
       unfolding x_alt y_alt z_alt
       using x y z w0 mult_rel_class_of subset_of_opens by force
     also have "... = \<lfloor>w0, \<cdot>\<^bsub>w0\<^esub> (\<rho> (fst x) w0 (snd x))
                               (\<cdot>\<^bsub>w0\<^esub> (\<rho> (fst y) w0 (snd y)) (\<rho> (fst z) w0 (snd z)))\<rfloor>"
       apply (subst xw0.target.multiplicative.associative)
       using w0 x y z by auto
     also have "... =  mult_rel X (mult_rel Y Z)"
       unfolding x_alt y_alt z_alt
       using x y z w0 mult_rel_class_of subset_of_opens by force
     finally show "mult_rel (mult_rel X Y) Z = mult_rel X (mult_rel Y Z)" .
 
     have "mult_rel X (add_rel Y Z) = \<lfloor>w0, \<cdot>\<^bsub>w0\<^esub> (\<rho> (fst x) w0 (snd x))
                   (+\<^bsub>w0\<^esub> (\<rho> (fst y) w0 (snd y)) (\<rho> (fst z) w0 (snd z)))\<rfloor>"
       unfolding x_alt y_alt z_alt
       using x y z w0 add_rel_class_of mult_rel_class_of subset_of_opens by force
     also have "... = \<lfloor>w0, +\<^bsub>w0\<^esub> (\<cdot>\<^bsub>w0\<^esub> (\<rho> (fst x) w0 (snd x)) (\<rho> (fst y) w0 (snd y)))
             (\<cdot>\<^bsub>w0\<^esub> (\<rho> (fst x) w0 (snd x)) (\<rho> (fst z) w0 (snd z)))\<rfloor>"
       apply (subst xw0.target.distributive)
       using w0 x y z by auto
     also have "... = add_rel (mult_rel X Y) (mult_rel X Z)"
       unfolding x_alt y_alt z_alt
       using x y z w0 add_rel_class_of mult_rel_class_of subset_of_opens by force
     finally show "mult_rel X (add_rel Y Z) = add_rel (mult_rel X Y) (mult_rel X Z)" .
 
     have "mult_rel (add_rel Y Z) X = \<lfloor>w0, \<cdot>\<^bsub>w0\<^esub> (+\<^bsub>w0\<^esub> (\<rho> (fst y) w0 (snd y))
                                           (\<rho> (fst z) w0 (snd z))) (\<rho> (fst x) w0 (snd x))\<rfloor>"
       unfolding x_alt y_alt z_alt
       using x y z w0 add_rel_class_of mult_rel_class_of subset_of_opens by force
     also have "... = \<lfloor>w0, +\<^bsub>w0\<^esub> (\<cdot>\<^bsub>w0\<^esub> (\<rho> (fst y) w0 (snd y)) (\<rho> (fst x) w0 (snd x)))
             (\<cdot>\<^bsub>w0\<^esub> (\<rho> (fst z) w0 (snd z)) (\<rho> (fst x) w0 (snd x)))\<rfloor>"
       apply (subst xw0.target.distributive)
       using w0 x y z by auto
     also have "... = add_rel (mult_rel Y X) (mult_rel Z X)"
       unfolding x_alt y_alt z_alt
       using x y z w0 add_rel_class_of mult_rel_class_of subset_of_opens by force
     finally show "mult_rel (add_rel Y Z) X = add_rel (mult_rel Y X) (mult_rel Z X)" .
   qed
 
   show add_rel_0':"\<And>a. a \<in> carrier_direct_lim \<Longrightarrow> add_rel a \<lfloor>U, \<zero>\<^bsub>U\<^esub>\<rfloor> = a"
     using add_rel_0 add_rel_commute zero_rel by force
 
   interpret Group_Theory.monoid carrier_direct_lim add_rel "\<lfloor>U, \<zero>\<^bsub>U\<^esub>\<rfloor>"
     apply unfold_locales
     by (simp_all add: zero_rel add_rel_carrier add_assoc add_rel_0 add_rel_0')
 
   show "monoid.invertible carrier_direct_lim add_rel \<lfloor>U, \<zero>\<^bsub>U\<^esub>\<rfloor> X"
     if "X \<in> carrier_direct_lim" for X
   proof -
     define x where "x=(SOME x. x \<in> X)"
     have x:"x\<in>X" "x\<in>Sigma I \<FF>" "fst x\<in>I" and X_alt:"X= \<lfloor>fst x, snd x\<rfloor>"
       using rel_carrier_Eps_in[OF \<open>X \<in> carrier_direct_lim\<close>]
       unfolding x_def by auto
 
     obtain w0 where w0: "w0 \<in> I" "w0 \<subseteq> U" "w0 \<subseteq> fst x"
       using has_lower_bound[OF \<open>U\<in>I\<close> \<open>fst x\<in>I\<close>] by blast
 
     interpret uw0:ring_homomorphism "\<rho> U w0" "\<FF> U" "+\<^bsub>U\<^esub>" "\<cdot>\<^bsub>U\<^esub>" "\<zero>\<^bsub>U\<^esub>" "\<one>\<^bsub>U\<^esub>" "\<FF> w0" "+\<^bsub>w0\<^esub>"
                     "\<cdot>\<^bsub>w0\<^esub>" "\<zero>\<^bsub>w0\<^esub>" "\<one>\<^bsub>w0\<^esub>"
       using is_ring_morphism \<open>U\<in>I\<close> w0 subset_of_opens by auto
     interpret xw0:ring_homomorphism "\<rho> (fst x) w0" "\<FF> (fst x)" "+\<^bsub>fst x\<^esub>" "\<cdot>\<^bsub>fst x\<^esub>" "\<zero>\<^bsub>fst x\<^esub>"
                     "\<one>\<^bsub>fst x\<^esub>" "\<FF> w0" "+\<^bsub>w0\<^esub>" "\<cdot>\<^bsub>w0\<^esub>" "\<zero>\<^bsub>w0\<^esub>" "\<one>\<^bsub>w0\<^esub>"
       using is_ring_morphism \<open>fst x\<in>I\<close> w0 subset_of_opens by auto
 
     define Y where "Y=\<lfloor>fst x, xw0.source.additive.inverse (snd x)\<rfloor>"
 
     have "add_rel X Y  = \<lfloor>w0, +\<^bsub>w0\<^esub> (\<rho> (fst x) w0 (snd x))
                                   (\<rho> (fst x) w0 (xw0.source.additive.inverse (snd x)))\<rfloor>"
       unfolding X_alt Y_def
     proof (subst add_rel_class_of)
       show "(fst x, xw0.source.additive.inverse (snd x)) \<in> Sigma I \<FF>"
         using x(2) xw0.source.additive.invertible xw0.source.additive.invertible_inverse_closed
         by force
     qed (use x w0 in auto)
     also have "... =  \<lfloor>w0, \<zero>\<^bsub>w0\<^esub>\<rfloor>"
       apply (subst xw0.additive.invertible_image_lemma)
       subgoal using x(2) xw0.source.additive.invertible by force
       using x(2) by auto
     also have "... =  \<lfloor>U, \<zero>\<^bsub>U\<^esub>\<rfloor>"
       by (simp add: assms class_of_0_eq w0(1))
     finally have "add_rel X Y = \<lfloor>U, \<zero>\<^bsub>U\<^esub>\<rfloor>" .
     moreover have "Y \<in> carrier_direct_lim"
       using Group_Theory.group_def Y_def carrier_direct_lim_def class_of_def
         monoid.invertible_inverse_closed x(2) xw0.source.additive.group_axioms
         xw0.source.additive.invertible by fastforce
     moreover have "add_rel Y X = \<lfloor>U, \<zero>\<^bsub>U\<^esub>\<rfloor>"
       using \<open>Y \<in> carrier_direct_lim\<close> \<open>add_rel X Y = \<lfloor>U, \<zero>\<^bsub>U\<^esub>\<rfloor>\<close>
       by (simp add: add_rel_commute that)
     ultimately show ?thesis
       unfolding invertible_def[OF that] by auto
   qed
 qed
 
 
 (* The canonical function from \<FF> U into lim \<FF> for U \<in> I:*)
 definition canonical_fun:: "'a set \<Rightarrow> 'b \<Rightarrow> ('a set \<times> 'b) set"
   where "canonical_fun U x = \<lfloor>U, x\<rfloor>"
 
 
 lemma rel_I1:
   assumes "s \<in> \<FF> U" "x \<in> \<lfloor>U, s\<rfloor>" "U \<in> I"
   shows "(U, s) \<sim> x"
 proof -
   have Us: "\<lfloor>U, s\<rfloor> \<in> carrier_direct_lim"
     using assms unfolding carrier_direct_lim_def class_of_def
     by (simp add: equivalence.Class_in_Partition rel_is_equivalence)
   then show ?thesis
     using rel_Class_iff assms
     by (metis carrier_direct_lim_def class_of_def mem_Sigma_iff rel.Block_self rel.Class_self rel.block_closed)
 qed
 
 lemma rel_I2:
   assumes "s \<in> \<FF> U" "x \<in> \<lfloor>U, s\<rfloor>" "U \<in> I"
   shows "(U, s) \<sim> (SOME x. x \<in> \<lfloor>U, s\<rfloor>)"
   using carrier_direct_lim_def class_of_def rel_carrier_Eps_in(2) rel_carrier_Eps_in(3) assms
   by fastforce
 
 lemma carrier_direct_limE:
   assumes "X \<in> carrier_direct_lim"
   obtains U s where "U \<in> I" "s \<in> \<FF> U" "X = \<lfloor>U,s\<rfloor>"
   using assms carrier_direct_lim_def class_of_def by auto
 
 
 
 end (* direct_lim *)
 
 abbreviation "dlim \<equiv> direct_lim.carrier_direct_lim"
 
 
 subsubsection \<open>Universal property of direct limits\<close>
 
 proposition (in direct_lim) universal_property:
   fixes A:: "'c set" and \<psi>:: "'a set \<Rightarrow> ('b \<Rightarrow> 'c)" and add:: "'c \<Rightarrow> 'c \<Rightarrow> 'c"
     and mult:: "'c \<Rightarrow> 'c \<Rightarrow> 'c" and zero:: "'c" and one:: "'c"
   assumes "ring A add mult zero one"
     and r_hom: "\<And>U. U \<in> I \<Longrightarrow> ring_homomorphism (\<psi> U) (\<FF> U) (+\<^bsub>U\<^esub>) (\<cdot>\<^bsub>U\<^esub>) \<zero>\<^bsub>U\<^esub> \<one>\<^bsub>U\<^esub> A add mult zero one"
     and eq: "\<And>U V x. \<lbrakk>U \<in> I; V \<in> I; V \<subseteq> U; x \<in> (\<FF> U)\<rbrakk> \<Longrightarrow> (\<psi> V \<circ> \<rho> U V) x = \<psi> U x"
   shows "\<forall>V\<in>I. \<exists>!u. ring_homomorphism u carrier_direct_lim add_rel mult_rel \<lfloor>V,\<zero>\<^bsub>V\<^esub>\<rfloor> \<lfloor>V,\<one>\<^bsub>V\<^esub>\<rfloor> A add mult zero one
 \<and> (\<forall>U\<in>I. \<forall>x\<in>(\<FF> U). (u \<circ> canonical_fun U) x = \<psi> U x)"
 proof
   fix V assume "V \<in> I"
   interpret ring_V: ring carrier_direct_lim add_rel mult_rel "\<lfloor>V, \<zero>\<^bsub>V\<^esub>\<rfloor>" "\<lfloor>V, \<one>\<^bsub>V\<^esub>\<rfloor>"
     using \<open>V \<in> I\<close> direct_lim_is_ring by blast
   interpret ring_\<psi>V: ring_homomorphism "\<psi> V" "\<FF> V" "+\<^bsub>V\<^esub>" "\<cdot>\<^bsub>V\<^esub>" "\<zero>\<^bsub>V\<^esub>" "\<one>\<^bsub>V\<^esub>" A add mult zero one
     using \<open>V \<in> I\<close> r_hom by presburger
 
   define u where "u \<equiv> \<lambda>X \<in> carrier_direct_lim. let x = (SOME x. x \<in> X) in \<psi> (fst x) (snd x)"
     \<comment>\<open>The proposition below proves that @{term u} is well defined.\<close>
   have \<psi>_eqI: "\<psi> x1 x2 = \<psi> y1 y2" if "(x1,x2) \<sim> (y1,y2)"
     for x1 x2 y1 y2
     by (smt (verit, best) Int_subset_iff assms(3) comp_apply fst_conv rel_def snd_conv that)
   have u_eval: "u \<lfloor>U,s\<rfloor> = \<psi> U s" if "U \<in> I" "s \<in> \<FF> U" for U s
   proof -
     have Us: "\<lfloor>U, s\<rfloor> \<in> carrier_direct_lim"
       using that unfolding carrier_direct_lim_def class_of_def
       by (simp add: equivalence.Class_in_Partition rel_is_equivalence)
     with that show ?thesis
       apply (simp add: u_def Let_def)
       by (metis \<psi>_eqI prod.exhaust_sel rel_I2 rel_carrier_Eps_in(1))
   qed
 
   have u_PiE: "u \<in> carrier_direct_lim \<rightarrow>\<^sub>E A"
   proof
     fix X
     assume "X \<in> carrier_direct_lim" then show "u X \<in> A"
       by (metis carrier_direct_limE map.map_closed r_hom ring_homomorphism_def u_eval)
   qed (auto simp: u_def)
   have hom_u: "ring_homomorphism u carrier_direct_lim add_rel mult_rel \<lfloor>V, \<zero>\<^bsub>V\<^esub>\<rfloor> \<lfloor>V, \<one>\<^bsub>V\<^esub>\<rfloor>
                                      A add mult zero one"
   proof
     have "u (add_rel \<lfloor>U,s\<rfloor> \<lfloor>V,t\<rfloor>) = add (u \<lfloor>U,s\<rfloor>) (u \<lfloor>V,t\<rfloor>)"
       if "U \<in> I" "V \<in> I" "s \<in> \<FF> U" "t \<in> \<FF> V" for U V s t
     proof -
       obtain W where "W \<in> I" and Wsub: "W \<subseteq> U \<inter> V"
         using assms has_lower_bound by (metis \<open>U \<in> I\<close> \<open>V \<in> I\<close>)
       interpret ring_\<psi>W: ring_homomorphism "\<psi> W" "\<FF> W" "+\<^bsub>W\<^esub>" "\<cdot>\<^bsub>W\<^esub>" "\<zero>\<^bsub>W\<^esub>" "\<one>\<^bsub>W\<^esub>" A add mult zero one
         using \<open>W \<in> I\<close> r_hom by presburger
       have "u (add_rel \<lfloor>U,s\<rfloor> \<lfloor>V,t\<rfloor>) = u (\<lfloor>W, +\<^bsub>W\<^esub> (\<rho> U W s) (\<rho> V W t)\<rfloor>)"
         using Wsub \<open>W \<in> I\<close> add_rel_class_of that by force
       also have "\<dots> = \<psi> W (+\<^bsub>W\<^esub> (\<rho> U W s) (\<rho> V W t))"
         by (metis Wsub \<open>W \<in> I\<close> direct_lim.subset_of_opens direct_lim_axioms is_map_from_is_homomorphism le_infE map.map_closed ring_\<psi>W.source.additive.composition_closed that u_eval)
       also have "\<dots> = add (\<psi> W ((\<rho> U W s))) (\<psi> W ((\<rho> V W t)))"
         using that
         by (meson \<open>W \<in> I\<close> \<open>W \<subseteq> U \<inter> V\<close> inf.bounded_iff is_ring_morphism map.map_closed ring_\<psi>W.additive.commutes_with_composition ring_homomorphism_def subset_of_opens)
       also have "\<dots> = add (\<psi> U s) (\<psi> V t)"
         using \<open>W \<in> I\<close> \<open>W \<subseteq> U \<inter> V\<close> eq that by force
       also have "... = add (u \<lfloor>U,s\<rfloor>) (u \<lfloor>V,t\<rfloor>)"
         by (simp add: that u_eval)
       finally show "u (add_rel \<lfloor>U,s\<rfloor> \<lfloor>V,t\<rfloor>) = add (u \<lfloor>U,s\<rfloor>) (u \<lfloor>V,t\<rfloor>)" .
     qed
     then show "u (add_rel X Y) = add (u X) (u Y)"
       if "X \<in> carrier_direct_lim" and "Y \<in> carrier_direct_lim" for X Y
       by (metis (no_types, lifting) carrier_direct_limE that)
     show "u \<lfloor>V, \<zero>\<^bsub>V\<^esub>\<rfloor> = zero"
       using \<open>V \<in> I\<close> ring_\<psi>V.additive.commutes_with_unit ring_\<psi>V.source.additive.unit_closed
         u_eval by presburger
     have "u (mult_rel \<lfloor>U,s\<rfloor> \<lfloor>V,t\<rfloor>) = mult (u \<lfloor>U,s\<rfloor>) (u \<lfloor>V,t\<rfloor>)"
       if "U \<in> I" "V \<in> I" "s \<in> \<FF> U" "t \<in> \<FF> V" for U V s t
     proof -
       obtain W where "W \<in> I" and Wsub: "W \<subseteq> U \<inter> V"
         by (meson \<open>U \<in> I\<close> \<open>V \<in> I\<close> has_lower_bound)
       interpret ring_\<psi>W: ring_homomorphism "\<psi> W" "\<FF> W" "+\<^bsub>W\<^esub>" "\<cdot>\<^bsub>W\<^esub>" "\<zero>\<^bsub>W\<^esub>" "\<one>\<^bsub>W\<^esub>" A add mult zero one
         using \<open>W \<in> I\<close> r_hom by presburger
       have "u (mult_rel \<lfloor>U,s\<rfloor> \<lfloor>V,t\<rfloor>) = u (\<lfloor>W, \<cdot>\<^bsub>W\<^esub> (\<rho> U W s) (\<rho> V W t)\<rfloor>)"
         using Wsub \<open>W \<in> I\<close> mult_rel_class_of that by force
       also have "\<dots> = \<psi> W (\<cdot>\<^bsub>W\<^esub> (\<rho> U W s) (\<rho> V W t))"
         by (metis Wsub \<open>W \<in> I\<close> direct_lim.subset_of_opens direct_lim_axioms is_map_from_is_homomorphism
             le_infE map.map_closed ring_\<psi>W.source.multiplicative.composition_closed that u_eval)
       also have "\<dots> = mult (\<psi> W ((\<rho> U W s))) (\<psi> W ((\<rho> V W t)))"
         by (meson Wsub \<open>W \<in> I\<close> inf.boundedE is_ring_morphism map.map_closed ring_\<psi>W.multiplicative.commutes_with_composition ring_homomorphism_def subset_of_opens that)
       also have "\<dots> = mult (\<psi> U s) (\<psi> V t)"
         using Wsub \<open>W \<in> I\<close> eq that by force
       also have "... = mult (u \<lfloor>U,s\<rfloor>) (u \<lfloor>V,t\<rfloor>)"
         using that u_eval by presburger
       finally show "u (mult_rel \<lfloor>U,s\<rfloor> \<lfloor>V,t\<rfloor>) = mult (u \<lfloor>U,s\<rfloor>) (u \<lfloor>V,t\<rfloor>)" .
     qed
     then show "u (mult_rel X Y) = mult (u X) (u Y)"
       if "X \<in> carrier_direct_lim" and "Y \<in> carrier_direct_lim" for X Y
       by (metis (no_types, lifting) carrier_direct_limE that)
     show "u (\<lfloor>V, \<one>\<^bsub>V\<^esub>\<rfloor>) = one"
       by (simp add: \<open>V \<in> I\<close> ring_\<psi>V.multiplicative.commutes_with_unit u_eval)
   qed (simp add: u_PiE)
   show "\<exists>!u. ring_homomorphism u carrier_direct_lim add_rel mult_rel \<lfloor>V, \<zero>\<^bsub>V\<^esub>\<rfloor> \<lfloor>V, \<one>\<^bsub>V\<^esub>\<rfloor>
                                       A add mult zero one \<and>
                   (\<forall>U\<in>I. \<forall>x\<in>\<FF> U. (u \<circ> canonical_fun U) x = \<psi> U x)"
   proof
     show "ring_homomorphism u carrier_direct_lim add_rel mult_rel \<lfloor>V, \<zero>\<^bsub>V\<^esub>\<rfloor> \<lfloor>V, \<one>\<^bsub>V\<^esub>\<rfloor> A add mult zero one \<and> (\<forall>U\<in>I. \<forall>x\<in>\<FF> U. (u \<circ> canonical_fun U) x = \<psi> U x)"
       by (simp add: canonical_fun_def hom_u u_eval)
     fix v
     assume v: "ring_homomorphism v carrier_direct_lim add_rel mult_rel \<lfloor>V, \<zero>\<^bsub>V\<^esub>\<rfloor> \<lfloor>V, \<one>\<^bsub>V\<^esub>\<rfloor> A add mult zero one \<and> (\<forall>U\<in>I. \<forall>x\<in>\<FF> U. (v \<circ> canonical_fun U) x = \<psi> U x)"
     have "u X = v X" if "X \<in> carrier_direct_lim" for X
       by (metis v canonical_fun_def carrier_direct_limE comp_apply that u_eval)
     moreover have "v \<in> carrier_direct_lim \<rightarrow>\<^sub>E A"
       by (metis v Set_Theory.map_def ring_homomorphism_def)
     ultimately show "v = u"
       using PiE_ext u_PiE by blast
   qed
 qed
 
 
 subsection \<open>Locally Ringed Spaces\<close>
 
 subsubsection \<open>Stalks of a Presheaf\<close>
 
 locale stalk = direct_lim +
   fixes x:: "'a"
   assumes is_elem: "x \<in> S" and index: "I = {U. is_open U \<and> x \<in> U}"
 begin
 
 (* definition 0.37 *)
 definition carrier_stalk:: "('a set \<times> 'b) set set"
   where "carrier_stalk \<equiv> dlim \<FF> \<rho> (neighborhoods x)"
 
 lemma neighborhoods_eq:"neighborhoods x = I"
   unfolding index neighborhoods_def by simp
 
 definition add_stalk:: "('a set \<times> 'b) set \<Rightarrow> ('a set \<times> 'b) set \<Rightarrow> ('a set \<times> 'b) set"
   where "add_stalk \<equiv> add_rel"
 
 definition mult_stalk:: "('a set \<times> 'b) set \<Rightarrow> ('a set \<times> 'b) set \<Rightarrow> ('a set \<times> 'b) set"
   where "mult_stalk \<equiv> mult_rel"
 
 definition zero_stalk:: "'a set \<Rightarrow> ('a set \<times> 'b) set"
   where "zero_stalk V \<equiv> class_of V \<zero>\<^bsub>V\<^esub>"
 
 definition one_stalk:: "'a set \<Rightarrow> ('a set \<times> 'b) set"
   where "one_stalk V \<equiv> class_of V \<one>\<^bsub>V\<^esub>"
 
 lemma class_of_in_stalk:
   assumes "A \<in> (neighborhoods x)" and "z \<in> \<FF> A"
   shows "class_of A z \<in> carrier_stalk"
 proof -
   interpret equivalence "Sigma I \<FF>" "{(x, y). x \<sim> y}"
     using rel_is_equivalence by blast
   show ?thesis
     using assms unfolding carrier_stalk_def neighborhoods_def
     by (metis (no_types, lifting) carrier_direct_lim_def class_of_def index mem_Sigma_iff natural.map_closed)
 qed
 
 lemma stalk_is_ring:
   assumes "is_open V" and "x \<in> V"
   shows "ring carrier_stalk add_stalk mult_stalk (zero_stalk V) (one_stalk V)"
 proof -
   interpret r: ring carrier_direct_lim add_rel mult_rel "\<lfloor>V, \<zero>\<^bsub>V\<^esub>\<rfloor>" "\<lfloor>V, \<one>\<^bsub>V\<^esub>\<rfloor>"
     using assms direct_lim_is_ring index by blast
   show ?thesis
     using r.additive.monoid_axioms
     unfolding zero_stalk_def one_stalk_def add_stalk_def mult_stalk_def carrier_stalk_def
     using index neighborhoods_def r.ring_axioms by metis
 qed
 
 
 lemma in_zero_stalk [simp]:
   assumes "V \<in> I"
   shows "(V, zero_str V) \<in> zero_stalk V"
   by (simp add: assms zero_stalk_def class_of_def class_of_0_in equivalence.Class_self rel_is_equivalence)
 
 lemma in_one_stalk [simp]:
   assumes "V \<in> I"
   shows "(V, one_str V) \<in> one_stalk V"
   by (simp add: assms one_stalk_def class_of_def class_of_1_in equivalence.Class_self rel_is_equivalence)
 
 lemma universal_property_for_stalk:
   fixes A:: "'c set" and \<psi>:: "'a set \<Rightarrow> ('b \<Rightarrow> 'c)"
   assumes ringA: "ring A add mult zero one"
     and hom: "\<And>U. U \<in> neighborhoods x \<Longrightarrow> ring_homomorphism (\<psi> U) (\<FF> U) (+\<^bsub>U\<^esub>) (\<cdot>\<^bsub>U\<^esub>) \<zero>\<^bsub>U\<^esub> \<one>\<^bsub>U\<^esub> A add mult zero one"
     and eq: "\<And>U V s. \<lbrakk>U \<in> neighborhoods x; V \<in> neighborhoods x; V\<subseteq>U; s \<in> \<FF> U\<rbrakk> \<Longrightarrow> (\<psi> V \<circ> \<rho> U V) s = \<psi> U s"
   shows "\<forall>V\<in>(neighborhoods x). \<exists>!u. ring_homomorphism u
 carrier_stalk add_stalk mult_stalk (zero_stalk V) (one_stalk V) A add mult zero one
 \<and> (\<forall>U\<in>(neighborhoods x). \<forall>s\<in>(\<FF> U). (u \<circ> canonical_fun U) s = \<psi> U s)"
 proof -
   note neighborhoods_eq [simp]
   have "\<forall>V\<in>I. \<exists>!u. ring_homomorphism u carrier_direct_lim add_rel mult_rel
                       \<lfloor>V, \<zero>\<^bsub>V\<^esub>\<rfloor> \<lfloor>V, \<one>\<^bsub>V\<^esub>\<rfloor> A add mult zero one \<and>
                           (\<forall>U\<in>I. \<forall>x\<in>\<FF> U. (u \<circ> canonical_fun U) x = \<psi> U x)"
     apply (rule universal_property[OF ringA hom])
     using eq by simp_all
   then show ?thesis
     unfolding carrier_stalk_def add_stalk_def mult_stalk_def zero_stalk_def one_stalk_def
     by simp
 qed
 
 end (* stalk *)
 
 sublocale stalk \<subseteq> direct_lim by (simp add: direct_lim_axioms)
 
 
 subsubsection \<open>Maximal Ideals\<close>
 
 (* definition 0.38 *)
 locale max_ideal = comm_ring R "(+)" "(\<cdot>)" "\<zero>" "\<one>" + ideal I  R "(+)" "(\<cdot>)" "\<zero>" "\<one>"
   for R and I and addition (infixl "+" 65) and multiplication (infixl "\<cdot>" 70) and zero ("\<zero>") and
 unit ("\<one>") +
 assumes neq_ring: "I \<noteq> R" and is_max: "\<And>\<aa>. ideal \<aa> R (+) (\<cdot>) \<zero> \<one> \<Longrightarrow> \<aa> \<noteq> R \<Longrightarrow> I \<subseteq> \<aa> \<Longrightarrow> I = \<aa>"
 begin
 
 lemma psubset_ring: "I \<subset> R"
   using neq_ring by blast
 
 lemma
   shows "\<not> (\<exists>\<aa>. ideal \<aa> R (+) (\<cdot>) \<zero> \<one> \<and> \<aa> \<noteq> R \<and> I \<subset> \<aa>)"
   using is_max by blast
 
 text \<open>A maximal ideal is prime\<close>
 proposition is_pr_ideal: "pr_ideal R I (+) (\<cdot>) \<zero> \<one>"
 proof
   show "I \<noteq> R"
     using neq_ring by fastforce
   fix x y
   assume "x \<in> R" "y \<in> R" and dot: "x \<cdot> y \<in> I"
   then show "x \<in> I \<or> y \<in> I"
   proof-
     have "False" if "x \<notin> I" "y \<notin> I"
     proof-
       define J where "J \<equiv> {i + r \<cdot> x |i r. i \<in> I \<and> r \<in> R}"
       have "J \<subseteq> R"
         using \<open>x \<in> R\<close> by (auto simp: J_def)
       have "x \<in> J"
         apply (simp add: J_def)
         by (metis \<open>x \<in> R\<close> additive.left_unit additive.sub_unit_closed multiplicative.left_unit multiplicative.unit_closed)
       interpret monJ: monoid J "(+)" \<zero>
       proof
         have "\<zero> = \<zero> + \<zero> \<cdot> x"
           by (simp add: \<open>x \<in> R\<close>)
         then show "\<zero> \<in> J"
           by (auto simp: J_def)
       next
         fix a b
         assume "a \<in> J" and "b \<in> J"
         then obtain ia ra ib rb where a: "a = ia + ra \<cdot> x" "ia \<in> I" "ra \<in> R"
                                   and b: "b = ib + rb \<cdot> x" "ib \<in> I" "rb \<in> R"
           by (auto simp: J_def)
         then have "ia + ra \<cdot> x + (ib + rb \<cdot> x) = ia + ib + (ra + rb) \<cdot> x"
           by (smt (z3) \<open>x \<in> R\<close> additive.commutative additive.composition_closed additive.monoid_axioms additive.submonoid_axioms distributive(2) monoid.associative multiplicative.composition_closed submonoid.sub)
         with a b show "a + b \<in> J"
           by (auto simp add: J_def)
       next
         fix a b c
         assume "a \<in> J" and "b \<in> J" and "c \<in> J"
         then show "a + b + c = a + (b + c)"
           by (meson \<open>J \<subseteq> R\<close> additive.associative subsetD)
       next
         fix a
         assume "a \<in> J"
         then show "\<zero> + a = a" "a + \<zero> = a"
           using \<open>J \<subseteq> R\<close> additive.left_unit additive.right_unit by blast+
       qed
       interpret idJ: ideal J R "(+)" "(\<cdot>)" \<zero> \<one>
       proof
         fix u
         assume "u \<in> J"
         then obtain i r where "u = i + r \<cdot> x" "i \<in> I" "r \<in> R"
           by (auto simp: J_def)
         then have "-u = -i + (-r) \<cdot> x"
           by (simp add: \<open>x \<in> R\<close> additive.commutative additive.inverse_composition_commute local.left_minus)
         with \<open>i \<in> I\<close> \<open>r \<in> R\<close> have "-u \<in> J"
           by (auto simp: J_def)
         with \<open>u \<in> J\<close> show "monoid.invertible J (+) \<zero> u"
           using  monoid.invertibleI [where v = "-u"]
           by (simp add: \<open>u \<in> J\<close> monJ.monoid_axioms \<open>i \<in> I\<close> \<open>r \<in> R\<close> \<open>u = i + r \<cdot> x\<close> \<open>x \<in> R\<close>)
       next
         fix a b
         assume "a \<in> R" and "b \<in> J"
         then obtain i r where ir: "b = i + r \<cdot> x" "i \<in> I" "r \<in> R"
           by (auto simp: J_def)
         then have "a \<cdot> (i + r \<cdot> x) = a \<cdot> i + a \<cdot> r \<cdot> x"
           by (simp add: \<open>a \<in> R\<close> \<open>x \<in> R\<close> distributive(1) multiplicative.associative)
         then show "a \<cdot> b \<in> J"
           using \<open>a \<in> R\<close> ideal(1) ir by (force simp add: J_def)
         have "b \<cdot> a = i \<cdot> a + r \<cdot> a \<cdot> x"
           by (simp add: \<open>a \<in> R\<close> \<open>x \<in> R\<close> comm_mult distributive(1) ir mult_left_assoc)
         then show "b \<cdot> a \<in> J"
           by (metis \<open>J \<subseteq> R\<close> \<open>a \<cdot> b \<in> J\<close> \<open>a \<in> R\<close> \<open>b \<in> J\<close> comm_mult subsetD)
       qed (auto simp: \<open>J \<subseteq> R\<close>)
       have "I \<subset> J"
       proof
         show "I \<subseteq> J"
           unfolding J_def
           apply clarify
           by (metis \<open>x \<in> R\<close> additive.sub.right_unit additive.unit_closed left_zero)
         show "I \<noteq> J"
           using \<open>x \<in> J\<close> \<open>x \<notin> I\<close> by blast
       qed
       hence "J = R"
         using idJ.ideal_axioms is_max by auto
       hence "\<one> \<in> J"
         by fastforce
       then obtain a r where "a \<in> I" "r \<in> R" "\<one> = a + r\<cdot>x"
           unfolding J_def by blast
       then have "y = (a + r\<cdot>x) \<cdot> y"
         using \<open>y \<in> R\<close> multiplicative.left_unit by presburger
       also have "\<dots> = a \<cdot> y + r\<cdot>x\<cdot>y"
         by (simp add: \<open>a \<in> I\<close> \<open>r \<in> R\<close> \<open>x \<in> R\<close> \<open>y \<in> R\<close> distributive(2))
       also have "\<dots> \<in> I"
         by (simp add: \<open>a \<in> I\<close> \<open>r \<in> R\<close> \<open>x \<in> R\<close> \<open>y \<in> R\<close> dot ideal multiplicative.associative)
       finally have "y \<in> I" .
       thus ?thesis using that(2) by auto
     qed
     thus ?thesis by auto
   qed
 qed
 
 end (* locale max_ideal *)
 
 
 subsubsection \<open>Maximal Left Ideals\<close>
 
 locale lideal = subgroup_of_additive_group_of_ring +
   assumes lideal: "\<lbrakk> r \<in> R; a \<in> I \<rbrakk> \<Longrightarrow> r \<cdot> a \<in> I"
 
 begin
 
 lemma subset: "I \<subseteq> R"
-  by simp
+  by blast
 
 lemma has_one_imp_equal:
   assumes "\<one> \<in> I"
   shows "I = R"
   by (metis assms lideal subset multiplicative.right_unit subsetI subset_antisym)
 
 end
 
 lemma (in comm_ring) ideal_iff_lideal:
   "ideal I R (+) (\<cdot>) \<zero> \<one> \<longleftrightarrow> lideal I R (+) (\<cdot>) \<zero> \<one>" (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then interpret I: ideal I R "(+)" "(\<cdot>)" \<zero> \<one> .
   show ?rhs
   proof qed (use I.ideal in presburger)
 next
   assume ?rhs
   then interpret I: lideal I R "(+)" "(\<cdot>)" \<zero> \<one> .
   show ?lhs
   proof
     fix r a
     assume "r \<in> R" "a \<in> I"
     then show "r \<cdot> a \<in> I"
       using I.lideal by blast
     then show "a \<cdot> r \<in> I"
       by (simp add: \<open>a \<in> I\<close> \<open>r \<in> R\<close> comm_mult)
   qed
 qed
 
 
 locale max_lideal = lideal +
   assumes neq_ring: "I \<noteq> R" and is_max: "\<And>\<aa>. lideal \<aa> R (+) (\<cdot>) \<zero> \<one> \<Longrightarrow> \<aa> \<noteq> R \<Longrightarrow> I \<subseteq> \<aa> \<Longrightarrow> I = \<aa>"
 
 (**WHY ARE THE ARGUMENT ORDERS OF max_ideal vs max_lideal INCONSISTENT?**)
 lemma (in comm_ring) max_ideal_iff_max_lideal:
   "max_ideal R I (+) (\<cdot>) \<zero> \<one> \<longleftrightarrow> max_lideal I R (+) (\<cdot>) \<zero> \<one>" (is "?lhs = ?rhs")
 proof
   assume ?lhs
   then interpret I: max_ideal R I "(+)" "(\<cdot>)" \<zero> \<one> .
   show ?rhs
   proof intro_locales
     show "lideal_axioms I R (\<cdot>)"
       by (simp add: I.ideal(1) lideal_axioms.intro)
     show "max_lideal_axioms I R (+) (\<cdot>) \<zero> \<one>"
       by (simp add: I.is_max I.neq_ring ideal_iff_lideal max_lideal_axioms.intro)
   qed
 next
   assume ?rhs
   then interpret I: max_lideal I R "(+)" "(\<cdot>)" \<zero> \<one> .
   show ?lhs
   proof intro_locales
     show "ideal_axioms I R (\<cdot>)"
       by (meson I.lideal_axioms ideal_def ideal_iff_lideal)
     show "max_ideal_axioms R I (+) (\<cdot>) \<zero> \<one>"
       by (meson I.is_max I.neq_ring ideal_iff_lideal max_ideal_axioms.intro)
   qed
 qed
 
 subsubsection \<open>Local Rings\<close>
 
 (* definition 0.39 *)
 locale local_ring = ring +
   assumes is_unique: "\<And>I J. max_lideal I R (+) (\<cdot>) \<zero> \<one> \<Longrightarrow> max_lideal J R (+) (\<cdot>) \<zero> \<one> \<Longrightarrow> I = J"
     and has_max_lideal: "\<exists>\<ww>. max_lideal \<ww> R (+) (\<cdot>) \<zero> \<one>"
 
 (*Can this be proved from the analogous result for left, right ideals?*)
 lemma im_of_ideal_is_ideal:
   assumes I: "ideal I A addA multA zeroA oneA"
     and f: "ring_epimorphism f A addA multA zeroA oneA B addB multB zeroB oneB"
   shows "ideal (f ` I) B addB multB zeroB oneB"
 proof -
   interpret IA: ideal I A addA multA zeroA oneA
     using I by blast
   interpret fepi: ring_epimorphism f A addA multA zeroA oneA B addB multB zeroB oneB
     using f by force
   show ?thesis
   proof intro_locales
     show sma: "submonoid_axioms (f ` I) B addB zeroB"
     proof
       show "f ` I \<subseteq> B"
         by blast
       have "zeroA \<in> I"
         by simp
       then show "zeroB \<in> f ` I"
         using fepi.additive.commutes_with_unit by blast
     next
       fix b1 b2
       assume "b1 \<in> f ` I" and "b2 \<in> f ` I"
       then show "addB b1 b2 \<in> f ` I"
         unfolding image_iff
         by (metis IA.additive.sub IA.additive.sub_composition_closed fepi.additive.commutes_with_composition)
     qed
     show "Group_Theory.monoid (f ` I) addB zeroB"
     proof
       fix a b
       assume "a \<in> f ` I" "b \<in> f ` I"
       then show "addB a b \<in> f ` I"
         by (meson sma submonoid_axioms_def)
     next
       show "zeroB \<in> f ` I"
         using fepi.additive.commutes_with_unit by blast
     qed auto
     show "Group_Theory.group_axioms (f ` I) addB zeroB"
     proof
       fix b
       assume "b \<in> f ` I"
       then obtain i where "b = f i" "i \<in> I"
         by blast
       then obtain j where "addA i j = zeroA" "j \<in> I"
         using IA.additive.sub.invertible_right_inverse by blast
       then show "monoid.invertible (f ` I) addB zeroB b"
         by (metis IA.additive.commutative IA.additive.sub \<open>Group_Theory.monoid (f ` I) addB zeroB\<close> \<open>b = f i\<close> \<open>i \<in> I\<close> fepi.additive.commutes_with_composition fepi.additive.commutes_with_unit image_eqI monoid.invertibleI)
     qed
     show "ideal_axioms (f ` I) B multB"
     proof
       fix b fi
       assume "b \<in> B" and "fi \<in> f ` I"
       then obtain i where i: "fi = f i" "i \<in> I"
         by blast
       obtain a where a: "a \<in> A" "f a = b"
         using \<open>b \<in> B\<close> fepi.surjective by blast
       then show "multB b fi \<in> f ` I"
         by (metis IA.additive.submonoid_axioms IA.ideal(1) \<open>fi = f i\<close> \<open>i \<in> I\<close> fepi.multiplicative.commutes_with_composition image_iff submonoid.sub)
       then show "multB fi b \<in> f ` I"
         by (metis IA.additive.sub IA.ideal(2) a i fepi.multiplicative.commutes_with_composition imageI)
     qed
   qed
 qed
 
 lemma im_of_lideal_is_lideal:
   assumes I: "lideal I A addA multA zeroA oneA"
     and f: "ring_epimorphism f A addA multA zeroA oneA B addB multB zeroB oneB"
   shows "lideal (f ` I) B addB multB zeroB oneB"
 proof -
   interpret IA: lideal I A addA multA zeroA oneA
     using I by blast
   interpret fepi: ring_epimorphism f A addA multA zeroA oneA B addB multB zeroB oneB
     using f by force
   show ?thesis
   proof intro_locales
     show sma: "submonoid_axioms (f ` I) B addB zeroB"
     proof
       show "f ` I \<subseteq> B"
         by blast
       have "zeroA \<in> I"
         by simp
       then show "zeroB \<in> f ` I"
         using fepi.additive.commutes_with_unit by blast
     next
       fix b1 b2
       assume "b1 \<in> f ` I" and "b2 \<in> f ` I"
       then show "addB b1 b2 \<in> f ` I"
         unfolding image_iff
         by (metis IA.additive.sub IA.additive.sub_composition_closed fepi.additive.commutes_with_composition)
     qed
     show "Group_Theory.monoid (f ` I) addB zeroB"
     proof
       fix a b
       assume "a \<in> f ` I" "b \<in> f ` I"
       then show "addB a b \<in> f ` I"
         by (meson sma submonoid_axioms_def)
     next
       show "zeroB \<in> f ` I"
         using fepi.additive.commutes_with_unit by blast
     qed auto
     show "Group_Theory.group_axioms (f ` I) addB zeroB"
     proof
       fix b
       assume "b \<in> f ` I"
       then obtain i where "b = f i" "i \<in> I"
         by blast
       then obtain j where "addA i j = zeroA" "j \<in> I"
         using IA.additive.sub.invertible_right_inverse by blast
       then show "monoid.invertible (f ` I) addB zeroB b"
         by (metis IA.additive.commutative IA.additive.sub \<open>Group_Theory.monoid (f ` I) addB zeroB\<close> \<open>b = f i\<close> \<open>i \<in> I\<close> fepi.additive.commutes_with_composition fepi.additive.commutes_with_unit image_eqI monoid.invertibleI)
     qed
     show "lideal_axioms (f ` I) B multB"
     proof
       fix b fi
       assume "b \<in> B" and "fi \<in> f ` I"
       then obtain i where i: "fi = f i" "i \<in> I"
         by blast
       obtain a where a: "a \<in> A" "f a = b"
         using \<open>b \<in> B\<close> fepi.surjective by blast
       then show "multB b fi \<in> f ` I"
         by (metis IA.additive.submonoid_axioms IA.lideal(1) \<open>fi = f i\<close> \<open>i \<in> I\<close> fepi.multiplicative.commutes_with_composition image_iff submonoid.sub)
     qed
   qed
 qed
 
 
 lemma im_of_max_lideal_is_max:
   assumes I: "max_lideal I A addA multA zeroA oneA"
     and f: "ring_isomorphism f A addA multA zeroA oneA B addB multB zeroB oneB"
   shows "max_lideal (f ` I) B addB multB zeroB oneB"
 proof -
   interpret maxI: max_lideal I A addA multA zeroA oneA
     using I by blast
   interpret fiso: ring_isomorphism f A addA multA zeroA oneA B addB multB zeroB oneB
     using f by force
   interpret fIB: lideal "f ` I" B addB multB zeroB oneB
   proof intro_locales
     show "submonoid_axioms (f ` I) B addB zeroB"
     proof
       show "addB a b \<in> f ` I"
         if "a \<in> f ` I" "b \<in> f ` I" for a b
         using that
         by (clarsimp simp: image_iff) (metis fiso.additive.commutes_with_composition maxI.additive.sub maxI.additive.sub_composition_closed)
     qed (use fiso.additive.commutes_with_unit in auto)
     then show "Group_Theory.monoid (f ` I) addB zeroB"
       using fiso.target.additive.monoid_axioms
       unfolding submonoid_axioms_def monoid_def
       by (meson subsetD)
     then show "Group_Theory.group_axioms (f ` I) addB zeroB"
       apply (clarsimp simp:  Group_Theory.group_axioms_def image_iff monoid.invertible_def)
       by (metis fiso.additive.commutes_with_composition fiso.additive.commutes_with_unit maxI.additive.sub maxI.additive.sub.invertible maxI.additive.sub.invertible_def)
     have "\<And>r x. \<lbrakk>r \<in> B; x \<in> I\<rbrakk> \<Longrightarrow> \<exists>xa\<in>I. multB r (f x) = f xa"
       by (metis (no_types, lifting) fiso.multiplicative.commutes_with_composition fiso.surjective image_iff maxI.additive.sub maxI.lideal)
   then show "lideal_axioms (f ` I) B multB"
     by (force intro!: lideal_axioms.intro)
   qed
   show ?thesis
   proof unfold_locales
     show "f ` I \<noteq> B"
       using maxI.neq_ring fiso.bijective maxI.additive.submonoid_axioms
       unfolding submonoid_axioms_def submonoid_def
       by (metis bij_betw_imp_inj_on fiso.surjective inj_on_image_eq_iff subset_iff)
   next
     fix J
     assume "lideal J B addB multB zeroB oneB" and "J \<noteq> B" and fim: "f ` I \<subseteq> J"
     then interpret JB: lideal J B addB multB zeroB oneB
       by blast
     have \<section>: "lideal (f \<^sup>\<inverse> A J) A addA multA zeroA oneA"
     proof intro_locales
       show sma: "submonoid_axioms (f \<^sup>\<inverse> A J) A addA zeroA"
       proof
         show "addA a b \<in> f \<^sup>\<inverse> A J" if "a \<in> f \<^sup>\<inverse> A J" and "b \<in> f \<^sup>\<inverse> A J" for a b
           using that
           apply clarsimp
           using JB.additive.sub_composition_closed fiso.additive.commutes_with_composition by presburger
       qed blast+
       show "Group_Theory.monoid (f \<^sup>\<inverse> A J) addA zeroA"
         by (smt (verit, ccfv_threshold) Group_Theory.monoid.intro IntD2 sma maxI.additive.associative maxI.additive.left_unit maxI.additive.right_unit submonoid_axioms_def)
       show "Group_Theory.group_axioms (f \<^sup>\<inverse> A J) addA zeroA"
       proof
         fix x
         assume "x \<in> f \<^sup>\<inverse> A J"
         then show "monoid.invertible (f \<^sup>\<inverse> A J) addA zeroA x"
           apply clarify
           by (smt (verit, best) JB.additive.sub.invertible JB.additive.submonoid_inverse_closed IntI \<open>Group_Theory.monoid (f \<^sup>\<inverse> A J) addA zeroA\<close> fiso.additive.invertible_commutes_with_inverse maxI.additive.inverse_equality maxI.additive.invertible maxI.additive.invertibleE monoid.invertible_def vimageI)
       qed
       show "lideal_axioms (f \<^sup>\<inverse> A J) A multA"
       proof
         fix a j
         assume \<section>: "a \<in> A" "j \<in> f \<^sup>\<inverse> A J"
         then show "multA a j \<in> f \<^sup>\<inverse> A J"
           using JB.lideal(1) fiso.map_closed fiso.multiplicative.commutes_with_composition
           by simp
       qed
     qed
     have "I = f \<^sup>\<inverse> A J"
     proof (rule maxI.is_max [OF \<section>])
       show "f \<^sup>\<inverse> A J \<noteq> A"
         using JB.additive.sub \<open>J \<noteq> B\<close> fiso.surjective by blast
       show "I \<subseteq> f \<^sup>\<inverse> A J"
         by (meson fim image_subset_iff_subset_vimage inf_greatest maxI.additive.sub subset_iff)
     qed
     then have "J \<subseteq> f ` I"
       using JB.additive.sub fiso.surjective by blast
     with fim show "f ` I = J" ..
   qed
 qed
 
 lemma im_of_max_ideal_is_max:
   assumes I: "max_ideal A I addA multA zeroA oneA"
     and f: "ring_isomorphism f A addA multA zeroA oneA B addB multB zeroB oneB"
   shows "max_ideal B (f ` I) addB multB zeroB oneB"
 proof -
   interpret maxI: max_ideal A I addA multA zeroA oneA
     using I by blast
   interpret fiso: ring_isomorphism f A addA multA zeroA oneA B addB multB zeroB oneB
     using f by force
   interpret fIB: ideal "f ` I" B addB multB zeroB oneB
     using maxI.ideal_axioms fiso.ring_homomorphism_axioms
     by (meson fiso.ring_epimorphism_axioms im_of_ideal_is_ideal)
   show ?thesis
   proof intro_locales
     show "comm_ring_axioms B multB"
     proof
       fix b1 b2
       assume "b1 \<in> B" and "b2 \<in> B"
       then obtain a1 a2 where a1: "a1 \<in> A" "f a1 = b1" and a2: "a2 \<in> A" "f a2 = b2"
         using fiso.surjective by blast
       then have "multA a1 a2 = multA a2 a1"
         using maxI.comm_mult by presburger
       then show "multB b1 b2 = multB b2 b1"
         by (metis a1 a2 fiso.multiplicative.commutes_with_composition)
     qed
     show "max_ideal_axioms B (f ` I) addB multB zeroB oneB"
     proof
       obtain i where "i \<in> A" "i \<notin> I"
         using maxI.neq_ring by blast
       then have "f i \<notin> f ` I"
         unfolding image_iff
         by (metis fiso.injective inj_on_def maxI.additive.sub)
       then show "f ` I \<noteq> B"
         using \<open>i \<in> A\<close> fiso.map_closed by blast
     next
       fix J
       assume "ideal J B addB multB zeroB oneB" and "J \<noteq> B" and fim: "f ` I \<subseteq> J"
       then interpret JB: ideal J B addB multB zeroB oneB
         by blast
       have \<section>: "ideal (f \<^sup>\<inverse> A J) A addA multA zeroA oneA"
       proof intro_locales
         show sma: "submonoid_axioms (f \<^sup>\<inverse> A J) A addA zeroA"
         proof
           show "addA a b \<in> f \<^sup>\<inverse> A J" if "a \<in> f \<^sup>\<inverse> A J" and "b \<in> f \<^sup>\<inverse> A J" for a b
             using that
             apply clarsimp
             using JB.additive.sub_composition_closed fiso.additive.commutes_with_composition by presburger
         qed blast+
         show "Group_Theory.monoid (f \<^sup>\<inverse> A J) addA zeroA"
           by (smt (verit, ccfv_threshold) Group_Theory.monoid.intro IntD2 sma maxI.additive.associative maxI.additive.left_unit maxI.additive.right_unit submonoid_axioms_def)
         show "Group_Theory.group_axioms (f \<^sup>\<inverse> A J) addA zeroA"
         proof
           fix x
           assume "x \<in> f \<^sup>\<inverse> A J"
           then show "monoid.invertible (f \<^sup>\<inverse> A J) addA zeroA x"
             apply clarify
             by (smt (verit, best) JB.additive.sub.invertible JB.additive.submonoid_inverse_closed IntI \<open>Group_Theory.monoid (f \<^sup>\<inverse> A J) addA zeroA\<close> fiso.additive.invertible_commutes_with_inverse maxI.additive.inverse_equality maxI.additive.invertible maxI.additive.invertibleE monoid.invertible_def vimageI)
         qed
         show "ideal_axioms (f \<^sup>\<inverse> A J) A multA"
         proof
           fix a j
           assume \<section>: "a \<in> A" "j \<in> f \<^sup>\<inverse> A J"
           then show "multA a j \<in> f \<^sup>\<inverse> A J"
             using JB.ideal(1) fiso.map_closed fiso.multiplicative.commutes_with_composition
             by simp
           then show "multA j a \<in> f \<^sup>\<inverse> A J"
             by (metis Int_iff \<section> maxI.comm_mult)
         qed
       qed
       have "I = f \<^sup>\<inverse> A J"
         by (metis "\<section>" JB.additive.sub \<open>J \<noteq> B\<close> fim fiso.surjective image_subset_iff_subset_vimage
             le_inf_iff maxI.is_max maxI.psubset_ring psubsetE subsetI subset_antisym)
       then show "f ` I = J"
         using JB.additive.sub fiso.surjective
         by blast
     qed
   qed
 qed
 
 
 lemma preim_of_ideal_is_ideal:
   fixes f :: "'a\<Rightarrow>'b"
   assumes J: "ideal J B addB multB zeroB oneB"
     and "ring_homomorphism f A addA multA zeroA oneA B addB multB zeroB oneB"
   shows "ideal (f\<^sup>\<inverse> A J) A addA multA zeroA oneA"
 proof -
   interpret JB: ideal J B addB multB zeroB oneB
     using J by blast
   interpret f: ring_homomorphism f A addA multA zeroA oneA B addB multB zeroB oneB
     using assms by force
   interpret preB: ring "f \<^sup>\<inverse> A B" addA multA zeroA oneA
     using f.ring_preimage by blast
   show ?thesis
   proof intro_locales
     show "submonoid_axioms (f \<^sup>\<inverse> A J) A addA zeroA"
       by (auto simp add: submonoid_axioms_def f.additive.commutes_with_composition f.additive.commutes_with_unit)
     then show grp_fAJ: "Group_Theory.monoid (f \<^sup>\<inverse> A J) addA zeroA"
       by (auto simp: submonoid_axioms_def Group_Theory.monoid_def)
     show "Group_Theory.group_axioms (f \<^sup>\<inverse> A J) addA zeroA"
       unfolding group_def
     proof
       fix x
       assume x: "x \<in> f \<^sup>\<inverse> A J"
       then have "f x \<in> J" "x \<in> A"
         by auto
       then obtain v where "f v \<in> J \<and> v \<in> A \<and> addA x v = zeroA"
         by (metis JB.additive.sub.invertible JB.additive.submonoid_inverse_closed f.additive.invertible_commutes_with_inverse
               f.source.additive.invertible f.source.additive.invertible_inverse_closed f.source.additive.invertible_right_inverse)
       then show "monoid.invertible (f \<^sup>\<inverse> A J) addA zeroA x"
         by (metis Int_iff f.source.additive.commutative grp_fAJ monoid.invertibleI vimageI x)
     qed
     show "ideal_axioms (f \<^sup>\<inverse> A J) A multA"
     proof
       fix a j
       assume \<section>: "a \<in> A" "j \<in> f \<^sup>\<inverse> A J"
       then show "multA j a \<in> f \<^sup>\<inverse> A J" "multA a j \<in> f \<^sup>\<inverse> A J"
         using JB.ideal f.map_closed f.multiplicative.commutes_with_composition by force+
     qed
   qed
 qed
 
 lemma preim_of_max_ideal_is_max:
   fixes f:: "'a \<Rightarrow> 'b"
   assumes J: "max_ideal B J addB multB zeroB oneB"
     and f: "ring_isomorphism f A addA multA zeroA oneA B addB multB zeroB oneB"
   shows "max_ideal A (f\<^sup>\<inverse> A J) addA multA zeroA oneA"
 proof -
   interpret maxJ: max_ideal B J addB multB zeroB oneB
     using J by blast
   interpret fiso: ring_isomorphism f A addA multA zeroA oneA B addB multB zeroB oneB
     using f by force
   interpret fAJ: ideal "f\<^sup>\<inverse> A J" A addA multA zeroA oneA
     using maxJ.ideal_axioms fiso.ring_homomorphism_axioms by (blast intro: preim_of_ideal_is_ideal)
   show ?thesis
   proof intro_locales
     show "comm_ring_axioms A multA"
     proof
       fix a b
       assume "a \<in> A" and "b \<in> A"
       then have "multB (f a) (f b) = multB (f b) (f a)"
         using fiso.map_closed maxJ.comm_mult by presburger
       then show "multA a b = multA b a"
         by (metis bij_betw_iff_bijections \<open>a \<in> A\<close> \<open>b \<in> A\<close> fiso.bijective fiso.multiplicative.commutes_with_composition fiso.source.multiplicative.composition_closed)
     qed
     show "max_ideal_axioms A (f \<^sup>\<inverse> A J) addA multA zeroA oneA"
     proof
       show "f \<^sup>\<inverse> A J \<noteq> A"
         using fiso.surjective maxJ.additive.sub maxJ.neq_ring by blast
       fix I
       assume "ideal I A addA multA zeroA oneA"
         and "I \<noteq> A" and "f \<^sup>\<inverse> A J \<subseteq> I"
       then interpret IA: ideal I A addA multA zeroA oneA
         by blast
       have mon_fI: "Group_Theory.monoid (f ` I) addB zeroB"
       proof
         fix a b
         assume "a \<in> f ` I" "b \<in> f ` I"
         then show "addB a b \<in> f ` I"
           unfolding image_iff
           by (metis IA.additive.sub IA.additive.sub_composition_closed fiso.additive.commutes_with_composition)
       next
         show "zeroB \<in> f ` I"
           using fiso.additive.commutes_with_unit by blast
       qed blast+
       have ideal_fI: "ideal (f ` I) B addB multB zeroB oneB"
       proof
         show "f ` I \<subseteq> B"
           by blast
         show "zeroB \<in> f ` I"
           using fiso.additive.commutes_with_unit by blast
       next
         fix a b
         assume "a \<in> f ` I" and "b \<in> f ` I"
         then show "addB a b \<in> f ` I"
           unfolding image_iff
           by (metis IA.additive.sub IA.additive.sub_composition_closed fiso.additive.commutes_with_composition)
       next
         fix b
         assume "b \<in> f ` I"
         then obtain i where i: "b = f i" "i \<in> I"
           by blast
         then obtain j where "addA i j = zeroA" "j \<in> I"
           by (meson IA.additive.sub.invertible IA.additive.sub.invertibleE)
         then have "addB b (f j) = zeroB"
           by (metis IA.additive.sub i fiso.additive.commutes_with_composition fiso.additive.commutes_with_unit)
         then show "monoid.invertible (f ` I) addB zeroB b"
           by (metis IA.additive.sub i \<open>j \<in> I\<close> fiso.map_closed imageI maxJ.additive.commutative mon_fI monoid.invertibleI)
       next
         fix a b
         assume "a \<in> B" and "b \<in> f ` I"
         with IA.ideal show "multB a b \<in> f ` I" "multB b a \<in> f ` I"
           by (smt (verit, best) IA.additive.sub fiso.multiplicative.commutes_with_composition fiso.surjective image_iff)+
       qed blast+
       have "J = f ` I"
       proof (rule maxJ.is_max [OF ideal_fI])
         show "f ` I \<noteq> B"
           by (metis IA.additive.sub \<open>I \<noteq> A\<close> fiso.injective fiso.surjective inj_on_image_eq_iff subsetI)
         show "J \<subseteq> f ` I"
           unfolding image_def
           apply clarify
           by (smt (verit, ccfv_threshold) Int_iff \<open>f \<^sup>\<inverse> A J \<subseteq> I\<close> fiso.surjective imageE maxJ.additive.sub subset_eq vimageI)
       qed
       then show "f \<^sup>\<inverse> A J = I"
         using \<open>f \<^sup>\<inverse> A J \<subseteq> I\<close> by blast
     qed
   qed
 qed
 
 lemma preim_of_lideal_is_lideal:
   assumes "lideal I B addB multB zeroB oneB"
     and "ring_homomorphism f A addA multA zeroA oneA B addB multB zeroB oneB"
   shows "lideal (f \<^sup>\<inverse> A I) (f \<^sup>\<inverse> A B) addA multA zeroA oneA"
 proof -
   interpret A: ring A addA multA zeroA oneA
     by (meson assms ring_homomorphism_def)
   interpret B: ring B addB multB zeroB oneB
     by (meson assms ring_homomorphism_def)
   interpret f: ring_homomorphism f A addA multA zeroA oneA B addB multB zeroB oneB
     using assms by blast
   interpret preB: ring "f \<^sup>\<inverse> A B" addA multA zeroA oneA
     using f.ring_preimage by blast
   interpret IB: lideal I B addB multB zeroB oneB
     by (simp add: assms)
   show ?thesis
   proof intro_locales
     show "submonoid_axioms (f \<^sup>\<inverse> A I) (f \<^sup>\<inverse> A B) addA zeroA"
       by (auto simp add: submonoid_axioms_def f.additive.commutes_with_composition f.additive.commutes_with_unit)
     have "(A.additive.inverse u) \<in> f \<^sup>\<inverse> A I" if "f u \<in> I" and "u \<in> A" for u
     proof -
       have "f (A.additive.inverse u) = B.additive.inverse (f u)"
         using A.additive.invertible f.additive.invertible_commutes_with_inverse that by presburger
       then show ?thesis
         using A.additive.invertible_inverse_closed that by blast
     qed
     moreover have "addA (A.additive.inverse u) u = zeroA"  "addA u (A.additive.inverse u) = zeroA" if "u \<in> A" for u
       by (auto simp add: that)
     moreover
     show "Group_Theory.monoid (f \<^sup>\<inverse> A I) addA zeroA"
       by (auto simp: monoid_def f.additive.commutes_with_composition f.additive.commutes_with_unit)
     ultimately show "Group_Theory.group_axioms (f \<^sup>\<inverse> A I) addA zeroA"
       unfolding group_axioms_def by (metis IntE monoid.invertibleI vimage_eq)
     show "lideal_axioms (f \<^sup>\<inverse> A I) (f \<^sup>\<inverse> A B) multA"
       unfolding lideal_axioms_def
       using IB.lideal f.map_closed f.multiplicative.commutes_with_composition by force
   qed
 qed
 
 lemma preim_of_max_lideal_is_max:
   assumes "max_lideal I B addB multB zeroB oneB"
       and "ring_isomorphism f A addA multA zeroA oneA B addB multB zeroB oneB"
   shows "max_lideal (f \<^sup>\<inverse> A I) (f \<^sup>\<inverse> A B) addA multA zeroA oneA"
 proof -
   interpret f: ring_isomorphism f A addA multA zeroA oneA B addB multB zeroB oneB
     using assms by blast
   interpret MI: max_lideal I B addB multB zeroB oneB
     by (simp add: assms)
   interpret pre: lideal "f \<^sup>\<inverse> A I" "f \<^sup>\<inverse> A B" addA multA zeroA oneA
     by (meson preim_of_lideal_is_lideal MI.lideal_axioms f.ring_homomorphism_axioms)
   show ?thesis
   proof intro_locales
     show "max_lideal_axioms (f \<^sup>\<inverse> A I) (f \<^sup>\<inverse> A B) addA multA zeroA oneA"
     proof
       show "f \<^sup>\<inverse> A I \<noteq> f \<^sup>\<inverse> A B"
         using MI.neq_ring MI.subset f.surjective by blast
       fix \<aa>
       assume "lideal \<aa> (f \<^sup>\<inverse> A B) addA multA zeroA oneA"
         and "\<aa> \<noteq> f \<^sup>\<inverse> A B"
         and "f \<^sup>\<inverse> A I \<subseteq> \<aa>"
       then interpret lideal \<aa> "f \<^sup>\<inverse> A B" addA multA zeroA oneA
         by metis
       have "f ` \<aa> \<noteq> B"
         by (metis Int_absorb1 \<open>\<aa> \<noteq> f \<^sup>\<inverse> A B\<close> f.injective f.surjective image_subset_iff_subset_vimage inj_on_image_eq_iff subset subset_iff)
       moreover have "I \<subseteq> f ` \<aa>"
         by (smt (verit, ccfv_threshold) Int_iff MI.subset \<open>f \<^sup>\<inverse> A I \<subseteq> \<aa>\<close> f.surjective image_iff subset_iff vimageI)
       moreover have "lideal (f ` \<aa>) B addB multB zeroB oneB"
         by (metis f.multiplicative.image.subset f.ring_epimorphism_axioms im_of_lideal_is_lideal image_subset_iff_subset_vimage inf.orderE inf_sup_aci(1) lideal_axioms)
       ultimately show "f \<^sup>\<inverse> A I = \<aa>"
         by (metis MI.is_max \<open>f \<^sup>\<inverse> A I \<subseteq> \<aa>\<close> image_subset_iff_subset_vimage le_inf_iff subset subset_antisym)
     qed
   qed
 qed
 
 lemma isomorphic_to_local_is_local:
   assumes lring: "local_ring B addB multB zeroB oneB"
     and iso: "ring_isomorphism f A addA multA zeroA oneA B addB multB zeroB oneB"
   shows "local_ring A addA multA zeroA oneA"
 proof intro_locales
   interpret ring A addA multA zeroA oneA
     by (meson iso ring_homomorphism.axioms(2) ring_isomorphism.axioms(1))
 
   show "Group_Theory.monoid A addA zeroA"
     by (simp add: additive.monoid_axioms)
   show "Group_Theory.group_axioms A addA zeroA"
     by (meson Group_Theory.group_def additive.group_axioms)
   show "commutative_monoid_axioms A addA"
     by (simp add: additive.commutative commutative_monoid_axioms_def)
   show "Group_Theory.monoid A multA oneA"
     by (simp add: multiplicative.monoid_axioms)
   show "ring_axioms A addA multA"
     by (meson local.ring_axioms ring.axioms(3))
   have hom: "monoid_homomorphism f A multA oneA B multB oneB"
     by (meson iso ring_homomorphism_def ring_isomorphism.axioms(1))
   have "bij_betw f A B"
     using iso map.graph
     by (simp add: bijective.bijective ring_isomorphism_def bijective_map_def)
   show "local_ring_axioms A addA multA zeroA oneA"
   proof
     fix I J
     assume I: "max_lideal I A addA multA zeroA oneA" and J: "max_lideal J A addA multA zeroA oneA"
     show "I = J"
     proof-
       have "max_lideal (f ` I) B addB multB zeroB oneB"
         by (meson I im_of_max_lideal_is_max iso)
       moreover have "max_lideal (f ` J) B addB multB zeroB oneB"
         by (meson J im_of_max_lideal_is_max iso)
       ultimately have "f ` I = f ` J"
         by (meson local_ring.is_unique lring)
       thus ?thesis
         using bij_betw_imp_inj_on [OF \<open>bij_betw f A B\<close>]
         by (meson I J inj_on_image_eq_iff lideal.subset max_lideal.axioms(1))
     qed
   next
     show "\<exists>\<ww>. max_lideal \<ww> A addA multA zeroA oneA"
       by (meson im_of_max_lideal_is_max iso local_ring.has_max_lideal lring ring_isomorphism.inverse_ring_isomorphism)
   qed
 qed
 
 
 (* ex. 0.40 *)
 lemma (in pr_ideal) local_ring_at_is_local:
   shows "local_ring carrier_local_ring_at add_local_ring_at mult_local_ring_at zero_local_ring_at one_local_ring_at"
 proof-
   interpret cq: quotient_ring "R\<setminus>I" R "(+)" "(\<cdot>)" \<zero> \<one>
     by (simp add: Comm_Ring.quotient_ring_def comm.comm_ring_axioms submonoid_pr_ideal)
   define \<ww> where "\<ww> \<equiv> {quotient_ring.frac (R\<setminus>I) R (+) (\<cdot>) \<zero> r s| r s. r \<in> I \<and> s \<in> (R \<setminus> I)}"
     \<comment>\<open>Now every proper ideal of @{term "R\<setminus>I"} is included in @{term \<ww>}, and the result follows trivially\<close>
   have maximal: "\<aa> \<subseteq> \<ww>"
     if "lideal \<aa> carrier_local_ring_at add_local_ring_at mult_local_ring_at zero_local_ring_at one_local_ring_at"
       and ne: "\<aa> \<noteq> carrier_local_ring_at" for \<aa>
   proof
     fix x
     interpret \<aa>: lideal \<aa> carrier_local_ring_at add_local_ring_at mult_local_ring_at zero_local_ring_at one_local_ring_at
       using that by blast
     assume "x \<in> \<aa>"
     have "False" if "x \<notin> \<ww>"
     proof -
       obtain r s where "r \<in> R" "s \<in> R" "s \<notin> I" "r \<notin> I" "x = cq.frac r s"
         using frac_from_carrier_local \<open>x \<in> \<aa>\<close> \<open>x \<notin> \<ww>\<close> [unfolded \<ww>_def, simplified]
         by (metis \<aa>.additive.sub)
       then have sr: "cq.frac s r \<in> carrier_local_ring_at"
         by (simp add: \<open>r \<in> R\<close> \<open>s \<in> R\<close> carrier_local_ring_at_def)
       have [simp]: "r \<cdot> s \<notin> I"
         using \<open>r \<in> R\<close> \<open>r \<notin> I\<close> \<open>s \<in> R\<close> \<open>s \<notin> I\<close> absorbent by blast
       have "one_local_ring_at = cq.frac \<one> \<one>"
         by (simp add: one_local_ring_at_def cq.one_rel_def)
       also have "... = cq.frac (s \<cdot> r) (r \<cdot> s)"
         using \<open>r \<in> R\<close> \<open>r \<notin> I\<close> \<open>s \<in> R\<close> \<open>s \<notin> I\<close>
         by (intro cq.frac_eqI [of \<one>]) (auto simp: comm.comm_mult)
       also have "... = cq.mult_rel (cq.frac s r) (cq.frac r s)"
         using  \<open>r \<in> R\<close> \<open>r \<notin> I\<close> \<open>s \<in> R\<close> \<open>s \<notin> I\<close> by (simp add: cq.mult_rel_frac)
       also have "\<dots> = mult_local_ring_at (cq.frac s r) (cq.frac r s)"
         using mult_local_ring_at_def by force
       also have "... \<in> \<aa>"
         using \<aa>.lideal \<open>x = cq.frac r s\<close> \<open>x \<in> \<aa>\<close> sr by blast
       finally have "one_local_ring_at \<in> \<aa>" .
       thus ?thesis
         using ne \<aa>.has_one_imp_equal by force
     qed
     thus "x \<in> \<ww>" by auto
   qed
   have uminus_closed: "uminus_local_ring_at u \<in> \<ww>" if "u \<in> \<ww>" for u
     using that by (force simp: \<ww>_def cq.uminus_rel_frac uminus_local_ring_at_def)
   have add_closed: "add_local_ring_at a b \<in> \<ww>" if "a \<in> \<ww>" "b \<in> \<ww>" for a b
   proof -
     obtain ra sa rb sb where ab: "a = cq.frac ra sa" "b = cq.frac rb sb"
       and "ra \<in> I" "rb \<in> I" "sa \<in> R" "sa \<notin> I" "sb \<in> R" "sb \<notin> I"
       using \<open>a \<in> \<ww>\<close> \<open>b \<in> \<ww>\<close> by (auto simp: \<ww>_def)
     then have "add_local_ring_at (cq.frac ra sa) (cq.frac rb sb) = cq.frac (ra \<cdot> sb + rb \<cdot> sa) (sa \<cdot> sb)"
       by (force simp add: cq.add_rel_frac add_local_ring_at_def)
     moreover have "ra \<cdot> sb + rb \<cdot> sa \<in> I"
       by (simp add: \<open>ra \<in> I\<close> \<open>rb \<in> I\<close> \<open>sa \<in> R\<close> \<open>sb \<in> R\<close> ideal(2))
     ultimately show ?thesis
       unfolding \<ww>_def using \<open>sa \<in> R\<close> \<open>sa \<notin> I\<close> \<open>sb \<in> R\<close> \<open>sb \<notin> I\<close> ab absorbent by blast
   qed
   interpret \<ww>: lideal \<ww> carrier_local_ring_at add_local_ring_at mult_local_ring_at zero_local_ring_at one_local_ring_at
   proof intro_locales
     show subm: "submonoid_axioms \<ww> carrier_local_ring_at add_local_ring_at zero_local_ring_at"
     proof
       show "\<ww> \<subseteq> carrier_local_ring_at"
         using \<ww>_def comm.comm_ring_axioms comm.frac_in_carrier_local comm_ring.spectrum_def pr_ideal_axioms by fastforce
       show "zero_local_ring_at \<in> \<ww>"
         using \<ww>_def comm.spectrum_def comm.spectrum_imp_cxt_quotient_ring not_1 pr_ideal_axioms quotient_ring.zero_rel_def zero_local_ring_at_def by fastforce
     qed (auto simp: add_closed)
     show mon: "Group_Theory.monoid \<ww> add_local_ring_at zero_local_ring_at"
     proof
       show "zero_local_ring_at \<in> \<ww>"
         by (meson subm submonoid_axioms_def)
     next
       fix a b c
       assume "a \<in> \<ww>" "b \<in> \<ww>" "c \<in> \<ww>"
       then show "add_local_ring_at (add_local_ring_at a b) c = add_local_ring_at a (add_local_ring_at b c)"
         by (meson additive.associative in_mono subm submonoid_axioms_def)
     next
       fix a assume "a \<in> \<ww>"
       show "add_local_ring_at zero_local_ring_at a = a"
         by (meson \<open>a \<in> \<ww>\<close> subm additive.left_unit in_mono submonoid_axioms_def)
       show "add_local_ring_at a zero_local_ring_at = a"
         by (meson \<open>a \<in> \<ww>\<close> additive.right_unit in_mono subm submonoid_axioms_def)
     qed (auto simp: add_closed)
     show "Group_Theory.group_axioms \<ww> add_local_ring_at zero_local_ring_at"
     proof unfold_locales
       fix u
       assume "u \<in> \<ww>"
       show "monoid.invertible \<ww> add_local_ring_at zero_local_ring_at u"
       proof (rule monoid.invertibleI [OF mon])
         show "add_local_ring_at u (uminus_local_ring_at u) = zero_local_ring_at"
           using \<open>u \<in> \<ww>\<close>
           apply (clarsimp simp add: \<ww>_def add_local_ring_at_def zero_local_ring_at_def uminus_local_ring_at_def)
           by (metis Diff_iff  additive.submonoid_axioms cq.add_minus_zero_rel cq.valid_frac_def submonoid.sub)
         then show "add_local_ring_at (uminus_local_ring_at u) u = zero_local_ring_at"
           using subm unfolding submonoid_axioms_def
           by (simp add: \<open>u \<in> \<ww>\<close> additive.commutative subset_iff uminus_closed)
       qed (use \<open>u \<in> \<ww>\<close> uminus_closed in auto)
     qed
     show "lideal_axioms \<ww> carrier_local_ring_at mult_local_ring_at"
     proof
       fix a b
       assume a: "a \<in> carrier_local_ring_at"
       then obtain ra sa where a: "a = cq.frac ra sa" and "ra \<in> R" and sa: "sa \<in> R" "sa \<notin> I"
         by (meson frac_from_carrier_local)
       then have "a \<in> carrier_local_ring_at"
         by (simp add: comm.frac_in_carrier_local comm.spectrum_def pr_ideal_axioms)
       assume "b \<in> \<ww>"
       then obtain rb sb where b: "b = cq.frac rb sb" and "rb \<in> I" and sb: "sb \<in> R" "sb \<notin> I"
         using \<ww>_def by blast
       have "cq.mult_rel (cq.frac ra sa) (cq.frac rb sb) = cq.frac (ra \<cdot> rb) (sa \<cdot> sb)"
         using \<open>ra \<in> R\<close> sa  \<open>rb \<in> I\<close> sb
         by (force simp: cq.mult_rel_frac)
       then show "mult_local_ring_at a b \<in> \<ww>"
         apply (clarsimp simp add: mult_local_ring_at_def \<ww>_def a b)
         by (metis Diff_iff \<open>ra \<in> R\<close> \<open>rb \<in> I\<close> cq.sub_composition_closed ideal(1) sa sb)
     qed
   qed
   have max: "max_lideal \<ww> carrier_local_ring_at add_local_ring_at mult_local_ring_at zero_local_ring_at one_local_ring_at"
   proof
     have False
       if "s \<in> R\<setminus>I" "r \<in> I" and eq: "cq.frac \<one> \<one> = cq.frac r s" for r s
       using that eq_from_eq_frac [OF eq] \<open>r \<in> I\<close> comm.additive.abelian_group_axioms
       unfolding abelian_group_def
       by (metis Diff_iff absorbent additive.sub comm.additive.cancel_imp_equal comm.inverse_distributive(1) comm.multiplicative.composition_closed cq.sub_unit_closed ideal(1))
     then have "cq.frac \<one> \<one> \<notin> \<ww>"
       using \<ww>_def by blast
     moreover have "cq.frac \<one> \<one> \<in> carrier_local_ring_at"
       using carrier_local_ring_at_def cq.multiplicative.unit_closed cq.one_rel_def by force
     ultimately show "\<ww> \<noteq> carrier_local_ring_at"
       by blast
   qed (use maximal in blast)
   have "\<And>J. max_lideal J carrier_local_ring_at add_local_ring_at mult_local_ring_at zero_local_ring_at one_local_ring_at
 \<Longrightarrow> J = \<ww>"
     by (metis maximal max max_lideal.axioms(1) max_lideal.is_max max_lideal.neq_ring)
   with max show ?thesis
     by (metis local.ring_axioms local_ring_axioms_def local_ring_def)
 qed
 
 definition (in stalk) is_local:: "'a set \<Rightarrow> bool" where
 "is_local U \<equiv> local_ring carrier_stalk add_stalk mult_stalk (zero_stalk U) (one_stalk U)"
 
 (* def. 0.41 *)
 locale local_ring_morphism =
 source: local_ring A "(+)" "(\<cdot>)" \<zero> \<one> + target: local_ring B "(+')" "(\<cdot>')" "\<zero>'" "\<one>'"
 + ring_homomorphism f A "(+)" "(\<cdot>)" "\<zero>" "\<one>" B "(+')" "(\<cdot>')" "\<zero>'" "\<one>'"
 for f and
 A and addition (infixl "+" 65) and multiplication (infixl "\<cdot>" 70) and zero ("\<zero>") and unit ("\<one>") and
 B and addition' (infixl "+''" 65) and multiplication' (infixl "\<cdot>''" 70) and zero' ("\<zero>''") and unit' ("\<one>''")
 + assumes preimage_of_max_lideal:
 "\<And>\<ww>\<^sub>A \<ww>\<^sub>B. max_lideal \<ww>\<^sub>A A (+) (\<cdot>) \<zero> \<one> \<Longrightarrow> max_lideal \<ww>\<^sub>B B (+') (\<cdot>') \<zero>' \<one>' \<Longrightarrow> (f\<^sup>\<inverse> A \<ww>\<^sub>B) = \<ww>\<^sub>A"
 
 lemma id_is_local_ring_morphism:
   assumes "local_ring A add mult zero one"
   shows "local_ring_morphism (identity A) A add mult zero one A add mult zero one"
 proof -
   interpret local_ring A add mult zero one
     by (simp add: assms)
   show ?thesis
   proof intro_locales
     show "Set_Theory.map (identity A) A A"
       by (simp add: Set_Theory.map_def)
     show "monoid_homomorphism_axioms (identity A) A add zero add zero"
       by (simp add: monoid_homomorphism_axioms_def)
     show "monoid_homomorphism_axioms (identity A) A mult one mult one"
       by (simp add: monoid_homomorphism_axioms_def)
     show "local_ring_morphism_axioms (identity A) A add mult zero one A add mult zero one"
     proof
       fix \<ww>\<^sub>A \<ww>\<^sub>B
       assume "max_lideal \<ww>\<^sub>A A add mult zero one" "max_lideal \<ww>\<^sub>B A add mult zero one"
       then have "\<ww>\<^sub>B \<inter> A = \<ww>\<^sub>A"
         by (metis Int_absorb2 is_unique lideal.subset max_lideal.axioms(1))
       then show "identity A \<^sup>\<inverse> A \<ww>\<^sub>B = \<ww>\<^sub>A"
         by (simp add: preimage_identity_self)
     qed
   qed
 qed
 
 lemma (in ring_epimorphism) preim_subset_imp_subset:
   assumes "\<eta> \<^sup>\<inverse> R I \<subseteq> \<eta> \<^sup>\<inverse> R J" and "I \<subseteq> R'"
   shows "I \<subseteq> J"
   using Int_absorb1 assms surjective
   by blast
 
 
 lemma iso_is_local_ring_morphism:
   assumes "local_ring A addA multA zeroA oneA"
     and "ring_isomorphism f A addA multA zeroA oneA B addB multB zeroB oneB"
   shows "local_ring_morphism f A addA multA zeroA oneA B addB multB zeroB oneB"
 proof -
   interpret A: local_ring A addA multA zeroA oneA
     using assms(1) by blast
   interpret B: ring B addB multB zeroB oneB
     by (meson assms(2) ring_homomorphism_def ring_isomorphism_def)
   interpret f: ring_isomorphism f A addA multA zeroA oneA B addB multB zeroB oneB
     by (simp add: assms)
   interpret preB: ring "f \<^sup>\<inverse> A B" addA multA zeroA oneA
     by (metis (no_types) A.ring_axioms f.multiplicative.image.subset image_subset_iff_subset_vimage inf.absorb2)
   show ?thesis
   proof
     fix I J
     assume "max_lideal I B addB multB zeroB oneB"
     then interpret MI: max_lideal I B addB multB zeroB oneB
       by simp
     assume "max_lideal J B addB multB zeroB oneB"
     then interpret MJ: max_lideal J B addB multB zeroB oneB
       by simp
     interpret GI: subgroup I B addB zeroB
       by unfold_locales
     have "max_lideal (f \<^sup>\<inverse> A I) (f \<^sup>\<inverse> A B) addA multA zeroA oneA"
       by (metis (no_types) MI.max_lideal_axioms f.ring_isomorphism_axioms preim_of_max_lideal_is_max)
     moreover have "max_lideal (f \<^sup>\<inverse> A J) (f \<^sup>\<inverse> A B) addA multA zeroA oneA"
       by (meson MJ.max_lideal_axioms f.ring_isomorphism_axioms preim_of_max_lideal_is_max)
     ultimately have "f \<^sup>\<inverse> A I = f \<^sup>\<inverse> A J"
       by (metis A.is_unique Int_absorb1 f.multiplicative.image.subset image_subset_iff_subset_vimage)
     then show "I = J"
       by (metis MI.lideal_axioms MI.neq_ring MJ.max_lideal_axioms MJ.subset f.preim_subset_imp_subset max_lideal.is_max subset_refl)
   next
     show "\<exists>\<ww>. max_lideal \<ww> B addB multB zeroB oneB"
       by (meson A.has_max_lideal assms(2) im_of_max_lideal_is_max)
   next
     fix \<ww>\<^sub>A \<ww>\<^sub>B
     assume "max_lideal \<ww>\<^sub>A A addA multA zeroA oneA"
         and "max_lideal \<ww>\<^sub>B B addB multB zeroB oneB"
     then show "f \<^sup>\<inverse> A \<ww>\<^sub>B = \<ww>\<^sub>A"
       by (metis A.is_unique f.multiplicative.image.subset f.ring_isomorphism_axioms image_subset_iff_subset_vimage inf.absorb2 preim_of_max_lideal_is_max)
   qed
 qed
 
 (*these epimorphism aren't actually used*)
 lemma (in monoid_homomorphism) monoid_epimorphism_image:
    "monoid_epimorphism \<eta> M (\<cdot>) \<one> (\<eta> ` M) (\<cdot>') \<one>'"
 proof -
   interpret monoid "\<eta> ` M" "(\<cdot>')" "\<one>'"
     using image.sub.monoid_axioms by force
   show ?thesis
   proof qed (auto simp: bij_betw_def commutes_with_unit commutes_with_composition)
 qed
 
 lemma (in group_homomorphism) group_epimorphism_image:
    "group_epimorphism \<eta> G (\<cdot>) \<one> (\<eta> ` G) (\<cdot>') \<one>'"
 proof -
   interpret group "\<eta> ` G" "(\<cdot>')" "\<one>'"
     using image.sub.group_axioms by blast
   show ?thesis
   proof qed (auto simp: bij_betw_def commutes_with_composition)
 qed
 
 lemma (in ring_homomorphism) ring_epimorphism_preimage:
    "ring_epimorphism \<eta> R (+) (\<cdot>) \<zero> \<one> (\<eta> ` R) (+') (\<cdot>') \<zero>' \<one>'"
 proof -
   interpret ring "\<eta> ` R" "(+')" "(\<cdot>')" "\<zero>'" "\<one>'"
   proof qed (auto simp add: target.distributive target.additive.commutative)
   show ?thesis
   proof qed (auto simp: additive.commutes_with_composition additive.commutes_with_unit
       multiplicative.commutes_with_composition multiplicative.commutes_with_unit)
 qed
 
 lemma comp_of_local_ring_morphisms:
   assumes "local_ring_morphism f A addA multA zeroA oneA B addB multB zeroB oneB"
       and "local_ring_morphism g B addB multB zeroB oneB C addC multC zeroC oneC"
     shows "local_ring_morphism (compose A g f) A addA multA zeroA oneA C addC multC zeroC oneC"
 proof -
   interpret f: local_ring_morphism f A addA multA zeroA oneA B addB multB zeroB oneB
     by (simp add: assms)
   interpret g: local_ring_morphism g B addB multB zeroB oneB C addC multC zeroC oneC
     by (simp add: assms)
   interpret gf: ring_homomorphism "compose A g f" A addA multA zeroA oneA C addC multC zeroC oneC
     using comp_ring_morphisms f.ring_homomorphism_axioms g.ring_homomorphism_axioms
     by fastforce
   obtain \<ww>\<^sub>B where \<ww>\<^sub>B: "max_lideal \<ww>\<^sub>B B addB multB zeroB oneB"
     using f.target.has_max_lideal by force
   show ?thesis
   proof intro_locales
     show "local_ring_morphism_axioms (compose A g f) A addA multA zeroA oneA C addC multC zeroC oneC"
     proof
       fix \<ww>\<^sub>A \<ww>\<^sub>C
       assume max: "max_lideal \<ww>\<^sub>A A addA multA zeroA oneA"
                   "max_lideal \<ww>\<^sub>C C addC multC zeroC oneC"
       interpret maxA: max_lideal \<ww>\<^sub>A A addA multA zeroA oneA
         using max by blast
       interpret maxC: max_lideal \<ww>\<^sub>C C addC multC zeroC oneC
         using max by blast
       have "B \<subseteq> g -` C"
         by blast
       with max interpret maxg: max_lideal "g \<^sup>\<inverse> B \<ww>\<^sub>C" "g \<^sup>\<inverse> B C" addB multB zeroB oneB
         by (metis Int_absorb1 \<ww>\<^sub>B g.preimage_of_max_lideal)
       interpret maxgf: Group_Theory.monoid "(g \<circ> f \<down> A) \<^sup>\<inverse> A \<ww>\<^sub>C" addA zeroA
         by (simp add: monoid_def vimage_def gf.additive.commutes_with_composition
                       gf.additive.commutes_with_unit f.source.additive.associative)
       show "(g \<circ> f \<down> A) \<^sup>\<inverse> A \<ww>\<^sub>C = \<ww>\<^sub>A"
       proof (rule maxA.is_max [symmetric])
         show "lideal ((g \<circ> f \<down> A) \<^sup>\<inverse> A \<ww>\<^sub>C) A addA multA zeroA oneA"
         proof
           fix u
           assume u: "u \<in> (g \<circ> f \<down> A) \<^sup>\<inverse> A \<ww>\<^sub>C"
           then have "u \<in> A"
             by auto
           show "maxgf.invertible u"
           proof (rule maxgf.invertibleI)
             show "addA u (f.source.additive.inverse u) = zeroA"
               using f.source.additive.invertible_right_inverse \<open>u \<in> A\<close> by blast
             have "(g \<circ> f \<down> A) (f.source.additive.inverse u) = g.target.additive.inverse (g (f u))"
               by (metis f.source.additive.invertible \<open>u \<in> A\<close> compose_eq
                     gf.additive.invertible_commutes_with_inverse)
             then show "(f.source.additive.inverse u) \<in> (g \<circ> f \<down> A) \<^sup>\<inverse> A \<ww>\<^sub>C"
               by (metis f.source.additive.invertible f.source.additive.invertible_inverse_closed
                     g.target.additive.group_axioms Int_iff compose_eq
                     maxC.additive.subgroup_inverse_iff f.map_closed g.map_axioms group.invertible
                     map.map_closed u vimage_eq)
           qed (use u \<open>u \<in> A\<close> in auto)
         next
           fix r a
           assume "r \<in> A" and "a \<in> (g \<circ> f \<down> A) \<^sup>\<inverse> A \<ww>\<^sub>C"
           then show "multA r a \<in> (g \<circ> f \<down> A) \<^sup>\<inverse> A \<ww>\<^sub>C"
             by (simp add: maxC.lideal gf.multiplicative.commutes_with_composition)
         qed (use maxgf.unit_closed maxgf.composition_closed in auto)
-        show "(g \<circ> f \<down> A) \<^sup>\<inverse> A \<ww>\<^sub>C \<noteq> A"
-          by (metis f.source.multiplicative.unit_closed f.target.multiplicative.unit_closed Int_iff
-              compose_eq f.multiplicative.commutes_with_unit maxg.has_one_imp_equal maxg.neq_ring
-              vimage_eq)
-        show "\<ww>\<^sub>A \<subseteq> (g \<circ> f \<down> A) \<^sup>\<inverse> A \<ww>\<^sub>C"
-          apply clarsimp
-          using f.preimage_of_max_lideal g.preimage_of_max_lideal \<ww>\<^sub>B
-          by (metis IntD1 maxA.additive.sub compose_eq max vimageD)
+        have "\<And>x. x \<in> \<ww>\<^sub>A \<Longrightarrow> g (f x) \<in> \<ww>\<^sub>C"
+          by (metis IntD1 \<ww>\<^sub>B f.preimage_of_max_lideal g.preimage_of_max_lideal max vimageD)
+        then show "\<ww>\<^sub>A \<subseteq> (g \<circ> f \<down> A) \<^sup>\<inverse> A \<ww>\<^sub>C"
+          by (auto simp: compose_eq)
+        have "oneB \<notin> g -` \<ww>\<^sub>C"
+          using maxg.has_one_imp_equal maxg.neq_ring by force
+        then have "g oneB \<notin> \<ww>\<^sub>C"
+          by blast
+        then show "(g \<circ> f \<down> A) \<^sup>\<inverse> A \<ww>\<^sub>C \<noteq> A"
+          by (metis Int_iff compose_eq f.multiplicative.commutes_with_unit f.source.multiplicative.unit_closed vimage_eq)
       qed
     qed
   qed
 qed
 
 subsubsection \<open>Locally Ringed Spaces\<close>
 
 (* The key map from the stalk at a prime ideal \<pp> to the local ring at \<pp> *)
 locale key_map = comm_ring +
   fixes \<pp>:: "'a set" assumes is_prime: "\<pp> \<in> Spec"
 begin
 
 interpretation pi:pr_ideal R \<pp> "(+)" "(\<cdot>)" \<zero> \<one>
   by (simp add: is_prime spectrum_imp_pr)
 
 interpretation top: topological_space Spec is_zariski_open
-
   by simp
 
 interpretation pr:presheaf_of_rings Spec is_zariski_open sheaf_spec sheaf_spec_morphisms
             \<O>b add_sheaf_spec mult_sheaf_spec zero_sheaf_spec one_sheaf_spec
   by (fact local.sheaf_spec_is_presheaf)
 
 interpretation local:quotient_ring "(R \<setminus> \<pp>)" R "(+)" "(\<cdot>)" \<zero> \<one>
   using is_prime spectrum_imp_cxt_quotient_ring by presburger
 
 interpretation st: stalk "Spec" is_zariski_open sheaf_spec sheaf_spec_morphisms
 \<O>b add_sheaf_spec mult_sheaf_spec zero_sheaf_spec one_sheaf_spec "{U. is_zariski_open U \<and> \<pp>\<in>U}" \<pp>
 proof
   fix U I V s
   assume "open_cover_of_open_subset Spec is_zariski_open U I V"
     and "\<And>i. i \<in> I \<Longrightarrow> V i \<subseteq> U"
     and "s \<in> \<O> U"
     and "\<And>i. i \<in> I \<Longrightarrow> sheaf_spec_morphisms U (V i) s = zero_sheaf_spec (V i)"
   then show "s = zero_sheaf_spec U"
     by (metis sheaf_of_rings.locality sheaf_spec_is_sheaf)
 next
 fix U I V s
   assume "open_cover_of_open_subset Spec is_zariski_open U I V"
       and "\<forall>i. i \<in> I \<longrightarrow> V i \<subseteq> U \<and> s i \<in> \<O> V i"
       and "\<And>i j. \<lbrakk>i \<in> I; j \<in> I\<rbrakk> \<Longrightarrow> sheaf_spec_morphisms (V i) (V i \<inter> V j) (s i) = sheaf_spec_morphisms (V j) (V i \<inter> V j) (s j)"
   then show "\<exists>t. t \<in> \<O> U \<and> (\<forall>i. i \<in> I \<longrightarrow> sheaf_spec_morphisms U (V i) t = s i)"
     by (smt (verit, ccfv_threshold) sheaf_of_rings.glueing sheaf_spec_is_sheaf)
 qed (use is_prime in auto)
 
 declare st.subset_of_opens [simp del, rule del] \<comment>\<open>because it loops!\<close>
 
 definition key_map:: "'a set set \<Rightarrow> (('a set \<Rightarrow> ('a \<times> 'a) set) \<Rightarrow> ('a \<times> 'a) set)"
   where "key_map U \<equiv> \<lambda>s\<in>(\<O> U). s \<pp>"
 
 lemma key_map_is_map:
   assumes  "\<pp> \<in> U"
   shows "Set_Theory.map (key_map U) (\<O> U) (R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>)"
 proof
   have "\<And>s. s \<in> \<O> U \<Longrightarrow> s \<pp> \<in> (R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>)"
     using sheaf_spec_def assms is_regular_def by blast
   thus "key_map U \<in> (\<O> U) \<rightarrow>\<^sub>E (R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>)"
     using key_map_def extensional_funcset_def by simp
 qed
 
 lemma key_map_is_ring_morphism:
   assumes "\<pp> \<in> U" and "is_zariski_open U"
   shows "ring_homomorphism (key_map U)
 (\<O> U) (add_sheaf_spec U) (mult_sheaf_spec U) (zero_sheaf_spec U) (one_sheaf_spec U)
 (R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>) (pi.add_local_ring_at) (pi.mult_local_ring_at) (pi.zero_local_ring_at) (pi.one_local_ring_at)"
 proof (intro ring_homomorphism.intro)
   show "Set_Theory.map (key_map U) (\<O> U) (R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>)" using key_map_is_map assms(1) by simp
 next
   show "ring (\<O> U) (add_sheaf_spec U) (mult_sheaf_spec U) (zero_sheaf_spec U) (one_sheaf_spec U)"
     using \<open>is_zariski_open U\<close> pr.is_ring_from_is_homomorphism by blast
 next
   show "ring (R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>) (pi.add_local_ring_at) (pi.mult_local_ring_at) (pi.zero_local_ring_at) (pi.one_local_ring_at)"
     by (simp add: pi.ring_axioms)
 next
   show "group_homomorphism (key_map U) (\<O> U) (add_sheaf_spec U) (zero_sheaf_spec U) (R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>) (pi.add_local_ring_at) (pi.zero_local_ring_at)"
   proof intro_locales
     show "Set_Theory.map (local.key_map U) (\<O> U) pi.carrier_local_ring_at"
       by (simp add: assms(1) key_map_is_map)
     show "Group_Theory.monoid (\<O> U) (add_sheaf_spec U) (zero_sheaf_spec U)"
       "Group_Theory.group_axioms (\<O> U) (add_sheaf_spec U) (zero_sheaf_spec U)"
       using pr.is_ring_from_is_homomorphism [OF \<open>is_zariski_open U\<close>]
       unfolding ring_def Group_Theory.group_def abelian_group_def
       by blast+
     have 1: "(key_map U) (zero_sheaf_spec U) = pi.zero_local_ring_at"
       using assms
       unfolding key_map_def pi.zero_local_ring_at_def
       by (metis (no_types, lifting) restrict_apply' zero_sheaf_spec_def zero_sheaf_spec_in_sheaf_spec)
     have 2: "\<And>x y. \<lbrakk>x \<in> \<O> U; y \<in> \<O> U\<rbrakk> \<Longrightarrow>
            (key_map U) (add_sheaf_spec U x y) = pi.add_local_ring_at (key_map U x) (key_map U y)"
       using add_sheaf_spec_in_sheaf_spec key_map_def assms pi.add_local_ring_at_def
         add_sheaf_spec_def spectrum_def zariski_open_is_subset
       by fastforce
     show "monoid_homomorphism_axioms (local.key_map U) (\<O> U) (add_sheaf_spec U) (zero_sheaf_spec U) pi.add_local_ring_at pi.zero_local_ring_at"
       unfolding monoid_homomorphism_axioms_def
       by (auto simp: 1 2)
   qed
 next
   have "(key_map U) (one_sheaf_spec U) = pi.one_local_ring_at"
     using one_sheaf_spec_def key_map_def pi.one_local_ring_at_def assms one_sheaf_spec_in_sheaf_spec spectrum_def by fastforce
   moreover have "\<And>x y. \<lbrakk>x \<in> \<O> U; y \<in> \<O> U\<rbrakk> \<Longrightarrow>
            (key_map U) (mult_sheaf_spec U x y) = pi.mult_local_ring_at (key_map U x) (key_map U y)"
     using mult_sheaf_spec_in_sheaf_spec key_map_def assms pi.mult_local_ring_at_def
       mult_sheaf_spec_def spectrum_def zariski_open_is_subset by fastforce
   ultimately show "monoid_homomorphism (key_map U) (\<O> U) (mult_sheaf_spec U) (one_sheaf_spec U) (R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>) (pi.mult_local_ring_at) (pi.one_local_ring_at)"
     using pr.is_ring_from_is_homomorphism [OF \<open>is_zariski_open U\<close>] \<open>\<pp> \<in> U\<close>
     unfolding monoid_homomorphism_def monoid_homomorphism_axioms_def ring_def
     using key_map_is_map pi.multiplicative.monoid_axioms by presburger
 qed
 
 lemma key_map_is_coherent:
   assumes "V \<subseteq> U" and "is_zariski_open U" and "is_zariski_open V" and "\<pp> \<in> V" and "s \<in> \<O> U"
   shows "(key_map V \<circ> sheaf_spec_morphisms U V) s = key_map U s"
 proof-
   have "sheaf_spec_morphisms U V s \<in> \<O> V"
     using assms sheaf_spec_morphisms_are_maps map.map_closed
     by (metis (mono_tags, hide_lams))
   thus "(key_map V \<circ> sheaf_spec_morphisms U V) s = key_map U s"
     by (simp add: \<open>s \<in> \<O> U\<close> assms(4) key_map_def sheaf_spec_morphisms_def)
 qed
 
 lemma key_ring_morphism:
   assumes "is_zariski_open V" and "\<pp> \<in> V"
   shows "\<exists>\<phi>. ring_homomorphism \<phi>
 st.carrier_stalk st.add_stalk st.mult_stalk (st.zero_stalk V) (st.one_stalk V)
 (R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>) (pi.add_local_ring_at) (pi.mult_local_ring_at) (pi.zero_local_ring_at) (pi.one_local_ring_at)
 \<and>
 (\<forall>U\<in>(top.neighborhoods \<pp>). \<forall>s\<in>\<O> U. (\<phi> \<circ> st.canonical_fun U) s = key_map U s)"
 proof -
   have "ring (R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>) (pi.add_local_ring_at) (pi.mult_local_ring_at) (pi.zero_local_ring_at) (pi.one_local_ring_at)"
     by (simp add: pi.ring_axioms)
   moreover have "V \<in> top.neighborhoods \<pp>"
     using assms top.neighborhoods_def sheaf_spec_is_presheaf by fastforce
   moreover have "\<And>U. U \<in> top.neighborhoods \<pp> \<Longrightarrow>
           ring_homomorphism (key_map U)
 (\<O> U) (add_sheaf_spec U) (mult_sheaf_spec U) (zero_sheaf_spec U) (one_sheaf_spec U)
 (R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>) (pi.add_local_ring_at) (pi.mult_local_ring_at) (pi.zero_local_ring_at) (pi.one_local_ring_at)"
     using key_map_is_ring_morphism top.neighborhoods_def sheaf_spec_is_presheaf by force
   moreover have "\<And>U V x. \<lbrakk>U \<in> top.neighborhoods \<pp>; V \<in> top.neighborhoods \<pp>; V \<subseteq> U; x \<in> \<O> U\<rbrakk>
                           \<Longrightarrow> (key_map V \<circ> sheaf_spec_morphisms U V) x = key_map U x"
     using key_map_is_coherent
     by (metis (no_types, lifting) mem_Collect_eq top.neighborhoods_def)
   ultimately show ?thesis
     using assms local.sheaf_spec_is_presheaf zariski_open_is_subset
       st.universal_property_for_stalk[of "R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>" "pi.add_local_ring_at" "pi.mult_local_ring_at"
         "pi.zero_local_ring_at" "pi.one_local_ring_at" "key_map"]
     by auto
 qed
 
 lemma class_from_belongs_stalk:
   assumes "s \<in> st.carrier_stalk"
   obtains U s' where "is_zariski_open U" "\<pp> \<in> U" "s' \<in> \<O> U" "s = st.class_of U s'"
 proof -
   interpret dl: direct_lim Spec is_zariski_open sheaf_spec sheaf_spec_morphisms "\<O>b"
     add_sheaf_spec mult_sheaf_spec zero_sheaf_spec one_sheaf_spec "top.neighborhoods \<pp>"
     by (simp add: st.direct_lim_axioms top.neighborhoods_def)
   interpret eq: equivalence "Sigma (top.neighborhoods \<pp>) sheaf_spec" "{(x, y). dl.rel x y}"
     using dl.rel_is_equivalence by force
   note dl.subset_of_opens [simp del]
   obtain U s' where seq: "s = eq.Class (U, s')" and U: "U \<in> top.neighborhoods \<pp>" and s': "s' \<in> \<O> U"
     using assms
     unfolding st.carrier_stalk_def dl.carrier_direct_lim_def
     by (metis SigmaD1 SigmaD2 eq.representant_exists old.prod.exhaust)
   show thesis
   proof
     show "is_zariski_open U"
       using U dl.subset_of_opens by blast
     show "\<pp> \<in> U"
       using U top.neighborhoods_def by force
     show "s' \<in> \<O> U"
       using s' by blast
     show "s = st.class_of U s'"
       using seq st.class_of_def top.neighborhoods_def by presburger
   qed
 qed
 
 lemma same_class_from_restrict:
   assumes "is_zariski_open U" "is_zariski_open V" "U \<subseteq> V" "s \<in> \<O> V" "\<pp> \<in> U"
   shows "st.class_of V s = st.class_of U (sheaf_spec_morphisms V U s)"
 proof -
   interpret eq: equivalence "Sigma {U. is_zariski_open U \<and> \<pp> \<in> U} sheaf_spec" "{(x, y). st.rel x y}"
     using st.rel_is_equivalence by blast
   show ?thesis
     unfolding st.class_of_def
   proof (rule eq.Class_eq)
      have \<section>:"sheaf_spec_morphisms V U s \<in> \<O> U"
       using assms map.map_closed pr.is_map_from_is_homomorphism by fastforce
     then have "\<exists>W. is_zariski_open W \<and> \<pp> \<in> W \<and> W \<subseteq> V \<and> W \<subseteq> U \<and> sheaf_spec_morphisms V W s = sheaf_spec_morphisms U W (sheaf_spec_morphisms V U s)"
       using assms(1) assms(3) assms(5) by auto
     then show "((V, s), U, sheaf_spec_morphisms V U s) \<in> {(x, y). st.rel x y}"
       using \<section> assms by (auto simp: st.rel_def)
   qed
 qed
 
 lemma shrinking_from_belong_stalk:
   assumes "s \<in> st.carrier_stalk" and "t \<in> st.carrier_stalk"
   obtains U s' t' where "is_zariski_open U" "\<pp> \<in> U" "s' \<in> \<O> U" "s = st.class_of U s'"
     "t' \<in> \<O> U" "t = st.class_of U t'"
 proof -
   obtain U s' where HU:"is_zariski_open U" "\<pp> \<in> U" "s' \<in> \<O> U" "s = st.class_of U s'"
     using assms(1) class_from_belongs_stalk by blast
   obtain V t' where HV:"is_zariski_open V" "\<pp> \<in> V" "t' \<in> \<O> V" "t = st.class_of V t'"
     using assms(2) class_from_belongs_stalk by blast
   show thesis
   proof
     have "U \<inter> V \<subseteq> Spec"
       using zariski_open_is_subset HU(1) by blast
     show "\<pp> \<in> U \<inter> V"
       by (simp add: \<open>\<pp> \<in> U\<close> \<open>\<pp> \<in> V\<close>)
     show UV: "is_zariski_open (U \<inter> V)" using topological_space.open_inter
       by (simp add: \<open>is_zariski_open U\<close> \<open>is_zariski_open V\<close>)
     show "s = st.class_of (U \<inter> V) (sheaf_spec_morphisms U (U \<inter> V) s')"
       using HU UV \<open>\<pp> \<in> U \<inter> V\<close> same_class_from_restrict by blast
     show "t = st.class_of (U \<inter> V) (sheaf_spec_morphisms V (U \<inter> V) t')"
       using HV UV \<open>\<pp> \<in> U \<inter> V\<close> same_class_from_restrict by blast
     show "sheaf_spec_morphisms U (U \<inter> V) s' \<in> \<O> (U \<inter> V)"
       using HU(3) UV map.map_closed sheaf_spec_morphisms_are_maps by fastforce
     show "sheaf_spec_morphisms V (U \<inter> V) t' \<in> \<O> (U \<inter> V)"
       using HV(3) UV map.map_closed sheaf_spec_morphisms_are_maps by fastforce
   qed
 qed
 
 
 lemma stalk_at_prime_is_iso_to_local_ring_at_prime_aux:
   assumes "is_zariski_open V" and "\<pp> \<in> V" and
     \<phi>: "ring_homomorphism \<phi>
       st.carrier_stalk st.add_stalk st.mult_stalk (st.zero_stalk V) (st.one_stalk V)
 (R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>) (pi.add_local_ring_at) (pi.mult_local_ring_at) (pi.zero_local_ring_at) (pi.one_local_ring_at)"
     and all_eq: "\<forall>U\<in>(top.neighborhoods \<pp>). \<forall>s\<in>\<O> U. (\<phi> \<circ> st.canonical_fun U) s = key_map U s"
   shows "ring_isomorphism \<phi>
 st.carrier_stalk st.add_stalk st.mult_stalk (st.zero_stalk V) (st.one_stalk V)
 (R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>) (pi.add_local_ring_at) (pi.mult_local_ring_at) (pi.zero_local_ring_at) (pi.one_local_ring_at)"
 proof (intro ring_isomorphism.intro bijective_map.intro bijective.intro)
   show "ring_homomorphism \<phi>
 st.carrier_stalk st.add_stalk st.mult_stalk (st.zero_stalk V) (st.one_stalk V)
 (R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>) (pi.add_local_ring_at) (pi.mult_local_ring_at) (pi.zero_local_ring_at) (pi.one_local_ring_at)"
     using assms(3) by simp
 next
   show "Set_Theory.map \<phi> st.carrier_stalk (R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>)"
     using assms(3) by (simp add: ring_homomorphism_def)
 next
   show "bij_betw \<phi> st.carrier_stalk (R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>)"
   proof-
     have "inj_on \<phi> st.carrier_stalk"
     proof
       fix s t assume "s \<in> st.carrier_stalk" "t \<in> st.carrier_stalk" "\<phi> s = \<phi> t"
       obtain U s' t' a f b g where FU [simp]: "is_zariski_open U" "\<pp> \<in> U" "s' \<in> \<O> U" "t' \<in> \<O> U"
         and s: "s = st.class_of U s'" "t = st.class_of U t'"
         and s': "s' = (\<lambda>\<qq>\<in>U. quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> a f)"
         and t': "t' = (\<lambda>\<qq>\<in>U. quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> b g)"
         and "a \<in> R" "b \<in> R" "f \<in> R" "g \<in> R" "f \<notin> \<pp>" "g \<notin> \<pp>"
       proof-
         obtain V s' t' where HV: "s = st.class_of V s'" "t = st.class_of V t'"
                             "s' \<in> \<O> V" "t' \<in> \<O> V" "is_zariski_open V" "\<pp> \<in> V"
           using shrinking_from_belong_stalk by (metis (no_types, lifting) \<open>s \<in> st.carrier_stalk\<close> \<open>t \<in> st.carrier_stalk\<close>)
         then obtain U a f b g where HU: "is_zariski_open U" "U \<subseteq> V" "\<pp> \<in> U" "a \<in> R" "f \<in> R" "b \<in> R" "g \<in> R"
           "f \<notin> \<pp>" "g \<notin> \<pp>"
           "\<And>\<qq>. \<qq> \<in> U \<Longrightarrow> f \<notin> \<qq> \<and> s' \<qq> = quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> a f"
           "\<And>\<qq>. \<qq> \<in> U \<Longrightarrow> g \<notin> \<qq> \<and> t' \<qq> = quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> b g"
           using shrinking[of V \<pp> s' t'] by blast
         show ?thesis
         proof
           show "sheaf_spec_morphisms V U s' \<in> \<O> U"
             by (metis (mono_tags, hide_lams) HU(1,2) HV(3) map.map_closed sheaf_spec_morphisms_are_maps)
           show "sheaf_spec_morphisms V U t' \<in> \<O> U"
             by (metis (mono_tags, hide_lams) HU(1,2) HV(4) map.map_closed sheaf_spec_morphisms_are_maps)
           show "s = st.class_of U (sheaf_spec_morphisms V U s')"
             by (simp add: HU(1-3) HV same_class_from_restrict)
           show "t = st.class_of U (sheaf_spec_morphisms V U t')"
             by (simp add: HU(1-3) HV same_class_from_restrict)
           show "sheaf_spec_morphisms V U s' = (\<lambda>\<qq>\<in>U. quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> a f)"
             using HV(3)  sheaf_spec_morphisms_def HU(10) by fastforce
           show "sheaf_spec_morphisms V U t' = (\<lambda>\<qq>\<in>U. quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> b g)"
             using HV(4) HU(11) sheaf_spec_morphisms_def by fastforce
         qed (use HU in auto)
     qed
     hence fact:"local.frac a f = local.frac b g"
       proof-
         have "local.frac a f = key_map U s'"
           using key_map_def \<open>\<pp> \<in> U\<close> \<open>s' = (\<lambda>\<qq>\<in>U. quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> a f)\<close> \<open>s' \<in> \<O> U\<close> by auto
         also have "\<dots> = \<phi> (st.canonical_fun U s')"
           using \<open>\<pp> \<in> U\<close> \<open>is_zariski_open U\<close> \<open>s' \<in> \<O> U\<close> assms(4) pr.presheaf_of_rings_axioms top.neighborhoods_def by fastforce
         also have "\<dots> = \<phi> (st.class_of U s')" using direct_lim.canonical_fun_def is_prime st.canonical_fun_def st.class_of_def by fastforce
         also have "\<dots> = \<phi> s" by (simp add: \<open>s = st.class_of U s'\<close>)
         also have "\<dots> = \<phi> t" using \<open>\<phi> s = \<phi> t\<close> by simp
         also have "\<dots> = \<phi> (st.class_of U t')" using \<open>t = st.class_of U t'\<close> by auto
         also have "\<dots> = \<phi> (st.canonical_fun U t')"
           using direct_lim.canonical_fun_def is_prime st.canonical_fun_def st.class_of_def by fastforce
         also have "\<dots> = key_map U t'"
           using \<open>\<pp> \<in> U\<close> \<open>is_zariski_open U\<close> \<open>t' \<in> \<O> U\<close> assms(4) top.neighborhoods_def by auto
         also have "\<dots> = local.frac b g"
           using FU(4) local.key_map_def t' by force
         finally show ?thesis .
       qed
       then obtain h where Hh: "h \<in> R" "h \<notin> \<pp>" "h \<cdot> (g \<cdot> a - f \<cdot> b) = \<zero>"
         using pi.eq_from_eq_frac by (metis Diff_iff \<open>a \<in> R\<close> \<open>b \<in> R\<close> \<open>f \<in> R\<close> \<open>f \<notin> \<pp>\<close> \<open>g \<in> R\<close> \<open>g \<notin> \<pp>\<close>)
       have izo: "is_zariski_open (U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h))"
         using local.standard_open_is_zariski_open
         by (simp add: Hh(1) \<open>f \<in> R\<close> \<open>g \<in> R\<close> standard_open_is_zariski_open)
       have ssm_s': "sheaf_spec_morphisms U (U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h)) s'
                 \<in> \<O> (U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h))"
         by (metis (no_types, hide_lams) FU(3) Int_assoc inf_le1 izo map.map_closed sheaf_spec_morphisms_are_maps)
       have ssm_t': "sheaf_spec_morphisms U (U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h)) t'
                 \<in> \<O> (U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h))"
         by (metis (no_types, hide_lams) FU(4) Int_assoc inf_le1 izo map.map_closed sheaf_spec_morphisms_are_maps)      have [simp]: "\<pp> \<in> \<D>(f)" "\<pp> \<in> \<D>(g)" "\<pp> \<in> \<D>(h)"
         using Hh \<open>f \<in> R\<close> \<open>f \<notin> \<pp>\<close> \<open>g \<in> R\<close> \<open>g \<notin> \<pp>\<close> belongs_standard_open_iff st.is_elem by blast+
       have eq: "s' \<qq> = t' \<qq>" if "\<qq> \<in> U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h)" for \<qq>
       proof -
         have "\<qq> \<in> Spec"
           using standard_open_def that by auto
         then        interpret q: quotient_ring "R\<setminus>\<qq>" R "(+)" "(\<cdot>)" \<zero>
           using spectrum_imp_cxt_quotient_ring by force
         note local.q.sub [simp del]  \<comment>\<open>Because it definitely loops\<close>
         define RR where "RR \<equiv> {(x, y). (x, y) \<in> (R \<times> (R\<setminus>\<qq>)) \<times> R \<times> (R\<setminus>\<qq>) \<and> q.rel x y}"
         interpret eq: equivalence "R \<times> (R\<setminus>\<qq>)" "RR"
           unfolding RR_def by (blast intro: equivalence.intro q.rel_refl q.rel_sym q.rel_trans)
         have Fq [simp]: "f \<notin> \<qq>" "g \<notin> \<qq>" "h \<notin> \<qq>"
           using belongs_standard_open_iff that
           apply (meson Int_iff \<open>\<qq> \<in> Spec\<close> \<open>f \<in> R\<close>)
           apply (meson Int_iff \<open>\<qq> \<in> Spec\<close> \<open>g \<in> R\<close> belongs_standard_open_iff that)
           by (meson Hh(1) IntD2 \<open>\<qq> \<in> Spec\<close> belongs_standard_open_iff that)
         moreover  have "eq.Class (a, f) = eq.Class (b, g)"
         proof (rule eq.Class_eq)
           have "\<exists>s1. s1 \<in> R \<and> s1 \<notin> \<qq> \<and> s1 \<cdot> (g \<cdot> a - f \<cdot> b) = \<zero>"
             using Hh \<open>h \<notin> \<qq>\<close> by blast
           then show "((a,f), b,g) \<in> RR"
             by (simp add: RR_def q.rel_def  \<open>a \<in> R\<close> \<open>b \<in> R\<close> \<open>f \<in> R\<close> \<open>g \<in> R\<close>)
         qed
         ultimately have "q.frac a f = q.frac b g"
           using RR_def q.frac_def by metis
         thus "s' \<qq> = t' \<qq>"
           by (simp add: s' t')
       qed
       show "s = t"
       proof-
         have "s = st.class_of (U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h)) (sheaf_spec_morphisms U (U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h)) s')"
           using \<open>\<pp> \<in> \<D>(f)\<close> \<open>\<pp> \<in> \<D>(g)\<close> \<open>\<pp> \<in> \<D>(h)\<close>
           by (smt (verit, ccfv_threshold) FU(1-3) IntE IntI izo s(1) same_class_from_restrict subsetI)
         also have "\<dots> = st.class_of (U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h)) (sheaf_spec_morphisms U (U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h)) t')"
         proof (rule local.st.class_of_eqI)
           show "sheaf_spec_morphisms (U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h)) (U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h)) (sheaf_spec_morphisms U (U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h)) s') = sheaf_spec_morphisms (U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h)) (U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h)) (sheaf_spec_morphisms U (U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h)) t')"
           proof (rule local.pr.eq_\<rho>)
             show "sheaf_spec_morphisms (U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h)) (U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h)) (sheaf_spec_morphisms U (U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h)) s') =
                   sheaf_spec_morphisms (U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h)) (U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h)) (sheaf_spec_morphisms U (U \<inter> \<D>(f) \<inter> \<D>(g) \<inter> \<D>(h)) t')"
               using eq FU(3) FU(4)
               apply (simp add: sheaf_spec_morphisms_def)
               apply (metis eq restrict_ext)
               done
           qed (use izo ssm_s' ssm_t' in auto)
         qed (auto simp: izo ssm_s' ssm_t')
         also have "\<dots> = t"
           using \<open>\<pp> \<in> \<D>(f)\<close> \<open>\<pp> \<in> \<D>(g)\<close> \<open>\<pp> \<in> \<D>(h)\<close>
           by (smt (verit, ccfv_threshold) FU(1-4) IntE IntI izo s(2) same_class_from_restrict subsetI)
         finally show ?thesis .
       qed
     qed
     moreover have "\<phi> ` st.carrier_stalk = (R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>)"
     proof
       show "\<phi> ` st.carrier_stalk \<subseteq> pi.carrier_local_ring_at"
         using assms(3) by (simp add: image_subset_of_target ring_homomorphism_def)
     next
       show "pi.carrier_local_ring_at \<subseteq> \<phi> ` st.carrier_stalk"
       proof
         fix x assume H:"x \<in> (R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>)"
         obtain a f where F:"a \<in> R" "f \<in> R" "f \<notin> \<pp>" "x = local.frac a f"
           using pi.frac_from_carrier_local H by blast
         define s where sec_def:"s \<equiv> \<lambda>\<qq>\<in>\<D>(f). quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> a f"
         then have sec:"s \<in> \<O>(\<D>(f))"
         proof-
           have "s \<qq> \<in> (R\<^bsub>\<qq> (+) (\<cdot>) \<zero>\<^esub>)" if "\<qq> \<in> \<D>(f)" for \<qq>
           proof -
             have "f \<notin> \<qq>" using that belongs_standard_open_iff F(2) standard_open_is_subset by blast
             then have "quotient_ring.frac (R\<setminus>\<qq>) R (+) (\<cdot>) \<zero> a f \<in> (R\<^bsub>\<qq> (+) (\<cdot>) \<zero>\<^esub>)"
               using F(1,2) frac_in_carrier_local \<open>\<qq> \<in> \<D>(f)\<close> standard_open_is_subset by blast
             thus "s \<qq> \<in> (R\<^bsub>\<qq> (+) (\<cdot>) \<zero>\<^esub>)" using sec_def by (simp add: \<open>\<qq> \<in> \<D>(f)\<close>)
           qed
           moreover have "s \<in>  extensional (\<D>(f))"
             using sec_def by auto
           moreover have "is_regular s \<D>(f)"
             using F(1,2) standard_open_is_subset  belongs_standard_open_iff is_regular_def[of s "\<D>(f)"] standard_open_is_zariski_open
             by (smt is_locally_frac_def restrict_apply sec_def subsetD subsetI)
           ultimately show ?thesis unfolding sheaf_spec_def[of "\<D>(f)"]
             by (simp add:PiE_iff)
         qed
         then have im:"\<phi> (st.class_of \<D>(f) s) = local.frac a f"
         proof-
           have "\<phi> (st.class_of \<D>(f) s) = \<phi> (st.canonical_fun \<D>(f) s)"
             using st.canonical_fun_def direct_lim.canonical_fun_def st.class_of_def is_prime by fastforce
           also have "\<dots> = key_map \<D>(f) s"
             using all_eq st.is_elem F(2) F(3) sec
             apply (simp add: top.neighborhoods_def)
             by (meson belongs_standard_open_iff standard_open_is_zariski_open)
           also have "... = local.frac a f"
             by (metis (mono_tags, lifting) F(2,3) belongs_standard_open_iff is_prime key_map_def restrict_apply sec sec_def)
           finally show ?thesis .
         qed
         thus "x \<in> \<phi> ` st.carrier_stalk"
         proof-
           have "st.class_of \<D>(f) s \<in> st.carrier_stalk"
           proof-
             have "\<pp> \<in> Spec" using is_prime by simp
             also have "\<D>(f) \<in> (top.neighborhoods \<pp>)"
               using top.neighborhoods_def belongs_standard_open_iff F(2,3) is_prime standard_open_is_zariski_open standard_open_is_subset
               by (metis (no_types, lifting) mem_Collect_eq)
             moreover have "s \<in> \<O> \<D>(f)" using sec by simp
             ultimately show ?thesis using st.class_of_in_stalk by auto
           qed
           thus ?thesis using F(4) im by blast
         qed
       qed
     qed
     ultimately show ?thesis by (simp add: bij_betw_def)
   qed
 qed
 
 lemma stalk_at_prime_is_iso_to_local_ring_at_prime:
   assumes "is_zariski_open V" and "\<pp> \<in> V"
   shows "\<exists>\<phi>. ring_isomorphism \<phi>
 st.carrier_stalk st.add_stalk st.mult_stalk (st.zero_stalk V) (st.one_stalk V)
 (R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>) (pi.add_local_ring_at) (pi.mult_local_ring_at) (pi.zero_local_ring_at) (pi.one_local_ring_at)"
   using key_ring_morphism stalk_at_prime_is_iso_to_local_ring_at_prime_aux assms by meson
 
 end (* key_map *)
 
 (* def. 0.42 *)
 locale locally_ringed_space = ringed_space +
   assumes stalks_are_local: "\<And>x U. x \<in> U \<Longrightarrow> is_open U \<Longrightarrow>
 stalk.is_local is_open \<FF> \<rho> add_str mult_str zero_str one_str (neighborhoods x) x U"
 
 context comm_ring
 begin
 
 interpretation pr: presheaf_of_rings "Spec" is_zariski_open sheaf_spec sheaf_spec_morphisms
             \<O>b add_sheaf_spec mult_sheaf_spec zero_sheaf_spec one_sheaf_spec
   by (simp add: comm_ring.sheaf_spec_is_presheaf local.comm_ring_axioms)
 
 (* ex. 0.43 *)
 lemma spec_is_locally_ringed_space:
   shows "locally_ringed_space Spec is_zariski_open sheaf_spec sheaf_spec_morphisms \<O>b
 add_sheaf_spec mult_sheaf_spec zero_sheaf_spec one_sheaf_spec"
 proof (intro locally_ringed_space.intro locally_ringed_space_axioms.intro)
   interpret sh: sheaf_of_rings Spec is_zariski_open sheaf_spec
      sheaf_spec_morphisms \<O>b add_sheaf_spec mult_sheaf_spec
      zero_sheaf_spec one_sheaf_spec
     using sheaf_spec_is_sheaf .
 
   show "ringed_space Spec is_zariski_open sheaf_spec sheaf_spec_morphisms \<O>b add_sheaf_spec mult_sheaf_spec zero_sheaf_spec one_sheaf_spec"
     using spec_is_ringed_space by simp
   show "stalk.is_local is_zariski_open sheaf_spec sheaf_spec_morphisms add_sheaf_spec mult_sheaf_spec
 zero_sheaf_spec one_sheaf_spec (pr.neighborhoods \<pp>) \<pp> U"
     if "\<pp> \<in> U" "is_zariski_open U" for \<pp> U
   proof -
     interpret st: stalk Spec is_zariski_open sheaf_spec sheaf_spec_morphisms \<O>b add_sheaf_spec
       mult_sheaf_spec zero_sheaf_spec one_sheaf_spec "pr.neighborhoods \<pp>" \<pp>
     proof
       show "\<pp> \<in> Spec"
         by (meson in_mono that zariski_open_is_subset)
     qed (auto simp: pr.neighborhoods_def)
     interpret pri: pr_ideal R \<pp> "(+)" "(\<cdot>)" \<zero> \<one>
       by (simp add: spectrum_imp_pr st.is_elem)
     interpret km: key_map R "(+)" "(\<cdot>)" \<zero> \<one> \<pp>
     proof qed (simp add: st.is_elem)
     have "ring st.carrier_stalk st.add_stalk st.mult_stalk (st.zero_stalk U) (st.one_stalk U)"
       using st.stalk_is_ring sheaf_spec_is_presheaf \<open>is_zariski_open U\<close> \<open>\<pp> \<in> U\<close> by blast
     also have "local_ring pri.carrier_local_ring_at pri.add_local_ring_at pri.mult_local_ring_at
                  pri.zero_local_ring_at pri.one_local_ring_at"
       using pr_ideal.local_ring_at_is_local
       by (simp add: pr_ideal.local_ring_at_is_local spectrum_imp_pr st.is_elem)
     moreover
     note st.subset_of_opens [simp del]
     have "\<exists>f. ring_isomorphism f
 st.carrier_stalk st.add_stalk st.mult_stalk (st.zero_stalk U) (st.one_stalk U)
 (R \<^bsub>\<pp> (+) (\<cdot>) \<zero>\<^esub>) (pr_ideal.add_local_ring_at R \<pp> (+) (\<cdot>) \<zero>) (pr_ideal.mult_local_ring_at R \<pp> (+) (\<cdot>) \<zero>) (pr_ideal.zero_local_ring_at R \<pp> (+) (\<cdot>) \<zero> \<one>) (pr_ideal.one_local_ring_at R \<pp> (+) (\<cdot>) \<zero> \<one>)"
       by (simp add: km.stalk_at_prime_is_iso_to_local_ring_at_prime st.index that)
     ultimately show "stalk.is_local is_zariski_open sheaf_spec sheaf_spec_morphisms add_sheaf_spec mult_sheaf_spec
 zero_sheaf_spec one_sheaf_spec (pr.neighborhoods \<pp>) \<pp> U"
       using isomorphic_to_local_is_local \<open>\<pp> \<in> U\<close> \<open>is_zariski_open U\<close> st.is_local_def by fastforce
   qed
 qed
 
 end (* comm_ring *)
 
 (* Construction 0.44: induced morphism between direct limits *)
 locale ind_mor_btw_stalks = morphism_ringed_spaces +
   fixes x::"'a"
   assumes is_elem: "x \<in> X"
 begin
 
 interpretation stx:stalk X is_open\<^sub>X \<O>\<^sub>X \<rho>\<^sub>X b add_str\<^sub>X mult_str\<^sub>X zero_str\<^sub>X one_str\<^sub>X
   "{U. is_open\<^sub>X U \<and> x \<in> U}" "x"
 proof qed (auto simp: is_elem)
 
 interpretation stfx: stalk Y is_open\<^sub>Y \<O>\<^sub>Y \<rho>\<^sub>Y d add_str\<^sub>Y mult_str\<^sub>Y zero_str\<^sub>Y one_str\<^sub>Y
   "{U. is_open\<^sub>Y U \<and> (f x) \<in> U}" "f x"
 proof qed (auto simp: is_elem)
 
 definition induced_morphism:: "('c set \<times> 'd) set \<Rightarrow> ('a set \<times> 'b) set" where
 "induced_morphism \<equiv> \<lambda>C \<in> stfx.carrier_stalk. let r = (SOME r. r \<in> C) in stx.class_of (f\<^sup>\<inverse> X (fst r)) (\<phi>\<^sub>f (fst r) (snd r))"
 
 (* One should think of fst r as a V in index, and snd r as a d in \<O>\<^sub>Y V. *)
 
 lemma phi_in_O:
   assumes "is_open\<^sub>Y V" "q \<in> \<O>\<^sub>Y V"
   shows "\<phi>\<^sub>f V q \<in> \<O>\<^sub>X (f \<^sup>\<inverse> X (V))"
   using is_morphism_of_sheaves morphism_presheaves_of_rings.fam_morphisms_are_maps
   unfolding morphism_sheaves_of_rings_def
   by (metis assms local.im_sheaf_def map.map_closed)
 
 lemma induced_morphism_is_well_defined:
   assumes "stfx.rel (V,q) (V',q')"
   shows "stx.class_of (f\<^sup>\<inverse> X V) (\<phi>\<^sub>f V q) = stx.class_of (f\<^sup>\<inverse> X V') (\<phi>\<^sub>f V' q')"
 proof -
   obtain W where W: "is_open\<^sub>Y W" "f x \<in> W" "W \<subseteq> V" "W \<subseteq> V'"
     and eq: "\<rho>\<^sub>Y V W q = \<rho>\<^sub>Y V' W q'"
     using assms stfx.rel_def by auto
   show ?thesis
   proof (rule stx.class_of_eqI)
     show "(f \<^sup>\<inverse> X V, \<phi>\<^sub>f V q) \<in> Sigma {U. is_open\<^sub>X U \<and> x \<in> U} \<O>\<^sub>X"
       using is_continuous phi_in_O assms stfx.rel_def stx.is_elem by auto
     show "(f \<^sup>\<inverse> X V', \<phi>\<^sub>f V' q') \<in> Sigma {U. is_open\<^sub>X U \<and> x \<in> U} \<O>\<^sub>X"
       using is_continuous phi_in_O assms stfx.rel_def stx.is_elem by auto
     show "f \<^sup>\<inverse> X W \<in> {U. is_open\<^sub>X U \<and> x \<in> U}"
       using W is_continuous stx.is_elem by auto
     show "f \<^sup>\<inverse> X W \<subseteq> f \<^sup>\<inverse> X V \<inter> f \<^sup>\<inverse> X V'"
       using W by blast
   interpret Y: morphism_sheaves_of_rings Y is_open\<^sub>Y \<O>\<^sub>Y \<rho>\<^sub>Y
      d add_str\<^sub>Y mult_str\<^sub>Y zero_str\<^sub>Y one_str\<^sub>Y
      local.im_sheaf im_sheaf_morphisms b
       add_im_sheaf mult_im_sheaf zero_im_sheaf one_im_sheaf \<phi>\<^sub>f
     by (rule is_morphism_of_sheaves)
     have "\<rho>\<^sub>X (f\<^sup>\<inverse> X V) (f\<^sup>\<inverse> X W) (\<phi>\<^sub>f V q) = \<phi>\<^sub>f W (\<rho>\<^sub>Y V W q)"
       using assms Y.comm_diagrams W
       by (simp add: stfx.rel_def im_sheaf_morphisms_def o_def)
   also have "\<dots> = \<phi>\<^sub>f W (\<rho>\<^sub>Y V' W q')"
     by (simp add: eq)
     also have "\<dots> = \<rho>\<^sub>X (f\<^sup>\<inverse> X V') (f\<^sup>\<inverse> X W) (\<phi>\<^sub>f V' q')"
       using assms Y.comm_diagrams W
       by (simp add: stfx.rel_def im_sheaf_morphisms_def o_def)
     finally show "\<rho>\<^sub>X (f \<^sup>\<inverse> X V) (f \<^sup>\<inverse> X W) (\<phi>\<^sub>f V q) = \<rho>\<^sub>X (f \<^sup>\<inverse> X V') (f \<^sup>\<inverse> X W) (\<phi>\<^sub>f V' q')" .
   qed
 qed
 
 lemma induced_morphism_eq:
   assumes "C \<in> stfx.carrier_stalk"
   obtains V q where "(V,q) \<in> C" "induced_morphism C = stx.class_of (f\<^sup>\<inverse> X V) (\<phi>\<^sub>f V q)"
   by (metis (mono_tags, lifting) assms induced_morphism_def prod.exhaust_sel restrict_apply
             stfx.carrier_stalk_def stfx.neighborhoods_eq stfx.rel_carrier_Eps_in(1))
 
 lemma induced_morphism_eval:
   assumes "C \<in> stfx.carrier_stalk" and "r \<in> C"
   shows "induced_morphism C = stx.class_of (f\<^sup>\<inverse> X (fst r)) (\<phi>\<^sub>f (fst r) (snd r))"
   by (smt (verit, best) assms induced_morphism_eq induced_morphism_is_well_defined
           prod.exhaust_sel stfx.carrier_direct_limE stfx.carrier_stalk_def stfx.neighborhoods_eq stfx.rel_I1)
 
 
 proposition ring_homomorphism_induced_morphism:
   assumes "is_open\<^sub>Y V" and "f x \<in> V"
   shows "ring_homomorphism induced_morphism
 stfx.carrier_stalk stfx.add_stalk stfx.mult_stalk (stfx.zero_stalk V) (stfx.one_stalk V)
 stx.carrier_stalk stx.add_stalk stx.mult_stalk (stx.zero_stalk (f\<^sup>\<inverse> X V)) (stx.one_stalk (f\<^sup>\<inverse> X V))"
 proof intro_locales
   interpret phif: ring_homomorphism "\<phi>\<^sub>f V" "\<O>\<^sub>Y V"
     "add_str\<^sub>Y V" "mult_str\<^sub>Y V" "zero_str\<^sub>Y V" "one_str\<^sub>Y V" "local.im_sheaf V"
     "add_im_sheaf V" "mult_im_sheaf V" "zero_im_sheaf V" "one_im_sheaf V"
     by (metis assms(1) is_morphism_of_sheaves morphism_presheaves_of_rings.is_ring_morphism morphism_sheaves_of_rings_def)
   interpret V: ring stfx.carrier_direct_lim stfx.add_rel stfx.mult_rel "stfx.class_of V (zero_str\<^sub>Y V)"
     "stfx.class_of V (one_str\<^sub>Y V)"
     using assms stfx.direct_lim_is_ring by force
   interpret X: ring stx.carrier_direct_lim stx.add_rel stx.mult_rel "stx.class_of X (zero_str\<^sub>X X)"
      "stx.class_of X (one_str\<^sub>X X)"
     using stx.direct_lim_is_ring stx.is_elem by auto
   interpret dlY: direct_lim Y is_open\<^sub>Y \<O>\<^sub>Y \<rho>\<^sub>Y d add_str\<^sub>Y
     mult_str\<^sub>Y zero_str\<^sub>Y one_str\<^sub>Y "target.neighborhoods (f x)"
     using stfx.direct_lim_axioms stfx.neighborhoods_eq by force
   interpret eqY: equivalence "Sigma {U. is_open\<^sub>Y U \<and> f x \<in> U} \<O>\<^sub>Y" "{(x, y). stfx.rel x y}"
     using stfx.rel_is_equivalence by blast
   interpret morphY: morphism_sheaves_of_rings Y is_open\<^sub>Y \<O>\<^sub>Y \<rho>\<^sub>Y
      d add_str\<^sub>Y mult_str\<^sub>Y zero_str\<^sub>Y one_str\<^sub>Y
      local.im_sheaf im_sheaf_morphisms b
       add_im_sheaf mult_im_sheaf zero_im_sheaf one_im_sheaf \<phi>\<^sub>f
     by (rule is_morphism_of_sheaves)
 
   have 0 [iff]: "stfx.zero_stalk V \<in> stfx.carrier_stalk"
     using stfx.carrier_stalk_def stfx.neighborhoods_eq stfx.zero_stalk_def by auto
   have 1 [iff]: "stfx.one_stalk V \<in> stfx.carrier_stalk"
     using stfx.carrier_stalk_def stfx.neighborhoods_eq stfx.one_stalk_def by auto
 
   show "Set_Theory.map induced_morphism stfx.carrier_stalk stx.carrier_stalk"
   proof
     show "induced_morphism \<in> stfx.carrier_stalk \<rightarrow>\<^sub>E stx.carrier_stalk"
     proof
       fix C
       assume C: "C \<in> stfx.carrier_stalk"
       then obtain r where "r \<in> C"
         by (metis stfx.carrier_stalk_def stfx.rel_carrier_Eps_in(1) target.neighborhoods_def)
       moreover have "is_open\<^sub>X (f \<^sup>\<inverse> X (fst r))"
         by (metis (no_types, lifting) C SigmaD1 \<open>r \<in> C\<close> eqY.block_closed is_continuous prod.exhaust_sel stfx.carrier_direct_lim_def stfx.carrier_stalk_def stfx.neighborhoods_eq stfx.subset_of_opens)
       ultimately have "stx.class_of (f \<^sup>\<inverse> X (fst r)) (\<phi>\<^sub>f (fst r) (snd r)) \<in> stx.carrier_stalk"
         by (smt (verit, best) C IntI dlY.carrier_direct_limE mem_Collect_eq phi_in_O stfx.carrier_stalk_def stfx.neighborhoods_eq stfx.rel_I1 stfx.rel_def stx.class_of_in_stalk stx.is_elem stx.neighborhoods_eq vimage_def)
       then show "induced_morphism C \<in> stx.carrier_stalk"
         using C \<open>r \<in> C\<close> induced_morphism_eval by presburger
     qed (simp add: induced_morphism_def)
   qed
   show "Group_Theory.monoid stfx.carrier_stalk stfx.add_stalk (stfx.zero_stalk V)"
     by (simp add: V.additive.monoid_axioms stfx.add_stalk_def stfx.carrier_stalk_def stfx.neighborhoods_eq stfx.zero_stalk_def)
   show "Group_Theory.group_axioms stfx.carrier_stalk stfx.add_stalk (stfx.zero_stalk V)"
     using Group_Theory.group_def V.additive.group_axioms stfx.add_stalk_def stfx.carrier_stalk_def stfx.zero_stalk_def target.neighborhoods_def by fastforce
   show "commutative_monoid_axioms stfx.carrier_stalk stfx.add_stalk"
     using V.additive.commutative_monoid_axioms commutative_monoid_def stfx.add_stalk_def stfx.carrier_stalk_def target.neighborhoods_def by fastforce
   show "Group_Theory.monoid stfx.carrier_stalk stfx.mult_stalk (stfx.one_stalk V)"
     by (simp add: V.multiplicative.monoid_axioms stfx.carrier_stalk_def stfx.mult_stalk_def stfx.neighborhoods_eq stfx.one_stalk_def)
   show "ring_axioms stfx.carrier_stalk stfx.add_stalk stfx.mult_stalk"
     by (metis (no_types, lifting) V.additive.unit_closed mem_Collect_eq ring_def stfx.carrier_direct_limE stfx.stalk_is_ring)
   show "Group_Theory.monoid stx.carrier_stalk stx.add_stalk (stx.zero_stalk (f \<^sup>\<inverse> X V))"
     using abelian_group_def assms commutative_monoid_def is_continuous ring_def stx.is_elem stx.stalk_is_ring by fastforce
   show "Group_Theory.group_axioms stx.carrier_stalk stx.add_stalk (stx.zero_stalk (f \<^sup>\<inverse> X V))"
     using Group_Theory.group_def abelian_group_def assms is_continuous ring_def stx.is_elem stx.stalk_is_ring by fastforce
   show "commutative_monoid_axioms stx.carrier_stalk stx.add_stalk"
     using X.additive.commutative_monoid_axioms commutative_monoid_def neighborhoods_def stx.add_stalk_def stx.carrier_stalk_def by fastforce
   show "Group_Theory.monoid stx.carrier_stalk stx.mult_stalk (stx.one_stalk (f \<^sup>\<inverse> X V))"
     using assms is_continuous ring_def stx.is_elem stx.stalk_is_ring by fastforce
   show "ring_axioms stx.carrier_stalk stx.add_stalk stx.mult_stalk"
     using X.ring_axioms ring_def stx.add_stalk_def stx.carrier_stalk_def stx.mult_stalk_def stx.neighborhoods_eq by fastforce
   show "monoid_homomorphism_axioms induced_morphism stfx.carrier_stalk stfx.add_stalk (stfx.zero_stalk V) stx.add_stalk (stx.zero_stalk (f \<^sup>\<inverse> X V))"
   proof
     fix C C'
     assume CC: "C \<in> stfx.carrier_stalk" "C' \<in> stfx.carrier_stalk"
     show "induced_morphism (stfx.add_stalk C C') = stx.add_stalk (induced_morphism C) (induced_morphism C')"
     proof -
       obtain U q U' q' where Uq: "(U,q) \<in> C" "(U',q') \<in> C'"
          and eq: "induced_morphism C = stx.class_of (f\<^sup>\<inverse> X U) (\<phi>\<^sub>f U q)"
          and eq': "induced_morphism C' = stx.class_of (f\<^sup>\<inverse> X U') (\<phi>\<^sub>f U' q')"
         by (metis (no_types, lifting) CC induced_morphism_eq)
       then obtain cc [simp]: "is_open\<^sub>Y (U \<inter> U')" "f x \<in> U" "f x \<in> U'"
         using CC eqY.block_closed stfx.carrier_direct_lim_def stfx.carrier_stalk_def stfx.neighborhoods_eq target.open_inter by force
       then interpret cc_rh: ring_homomorphism "\<phi>\<^sub>f (U \<inter> U')" "\<O>\<^sub>Y (U \<inter> U')"
         "add_str\<^sub>Y (U \<inter> U')" "mult_str\<^sub>Y (U \<inter> U')" "zero_str\<^sub>Y (U \<inter> U')"
         "one_str\<^sub>Y (U \<inter> U')" "local.im_sheaf (U \<inter> U')"
         "add_im_sheaf (U \<inter> U')" "mult_im_sheaf (U \<inter> U')"
         "zero_im_sheaf (U \<inter> U')" "one_im_sheaf (U \<inter> U')"
         by (metis is_morphism_of_sheaves morphism_presheaves_of_rings.is_ring_morphism morphism_sheaves_of_rings_def)
       obtain opeU [simp]: "is_open\<^sub>Y U" "is_open\<^sub>Y U'"
         by (metis (no_types, lifting) CC SigmaD1 Uq dlY.subset_of_opens eqY.block_closed stfx.carrier_direct_lim_def stfx.carrier_stalk_def stfx.neighborhoods_eq)
       obtain [simp]: "q \<in> \<O>\<^sub>Y U" "q' \<in> \<O>\<^sub>Y U'"
         using CC Uq stfx.carrier_direct_lim_def stfx.carrier_stalk_def stfx.neighborhoods_eq by auto
 
       define add where "add \<equiv> add_str\<^sub>Y (U \<inter> U') (\<rho>\<^sub>Y U (U \<inter> U') q) (\<rho>\<^sub>Y U' (U \<inter> U') q')"
       have add_stalk_eq_class: "stfx.add_stalk C C' = stfx.class_of (U \<inter> U') add"
         using CC
         unfolding add_def stfx.add_stalk_def stfx.carrier_stalk_def dlY.carrier_direct_lim_def
         by (smt (verit, best) IntI Int_commute Uq cc eqY.Block_self eqY.block_closed inf.cobounded1 mem_Collect_eq stfx.add_rel_class_of stfx.class_of_def stfx.neighborhoods_eq)
        then have C: "(stfx.class_of (U \<inter> U') add) \<in> stfx.carrier_stalk"
          using CC \<open>Group_Theory.monoid stfx.carrier_stalk stfx.add_stalk (stfx.zero_stalk V)\<close> monoid.composition_closed by fastforce
       have add_in: "add \<in> \<O>\<^sub>Y (U \<inter> U')"
         apply (simp add: add_def)
         using cc_rh.source.additive.composition_closed\<open>q \<in> \<O>\<^sub>Y U\<close> \<open>q' \<in> \<O>\<^sub>Y U'\<close>
         by (metis Int_commute cc(1) codom.is_map_from_is_homomorphism inf.cobounded1 map.map_closed opeU)
       obtain V r where Vr: "(V,r) \<in> stfx.add_stalk C C'"
            and eq: "induced_morphism (stfx.add_stalk C C') = stx.class_of (f \<^sup>\<inverse> X V) (\<phi>\<^sub>f V r)"
         using induced_morphism_eq add_stalk_eq_class C by auto
       have "is_open\<^sub>Y V"
         by (smt (verit, best) C SigmaD1 Vr add_stalk_eq_class dlY.subset_of_opens eqY.block_closed stfx.carrier_direct_lim_def stfx.carrier_stalk_def stfx.neighborhoods_eq)
       have "r \<in> \<O>\<^sub>Y V"
         by (smt (verit, best) IntI Vr add_stalk_eq_class add_in cc fst_conv mem_Collect_eq snd_conv stfx.rel_I1 stfx.rel_def)
       have fxV: "f x \<in> V"
         using C Vr add_stalk_eq_class stfx.carrier_direct_lim_def stfx.carrier_stalk_def stfx.neighborhoods_eq by auto
       have fXUU: "is_open\<^sub>X (f\<^sup>\<inverse> X (U \<inter> U'))"
         using cc(1) is_continuous by presburger
       have "(U \<inter> U', add) \<in> stfx.class_of V r"
         by (metis (no_types, lifting) IntI Vr add_stalk_eq_class add_in cc mem_Collect_eq stfx.class_of_def stfx.rel_Class_iff stfx.rel_I1)
       then have "stfx.rel (V, r) (U \<inter> U', add)"
         by (simp add: fxV \<open>is_open\<^sub>Y V\<close> \<open>r \<in> \<O>\<^sub>Y V\<close> stfx.rel_I1)
       then have "induced_morphism (stfx.add_stalk C C') = stx.class_of (f\<^sup>\<inverse> X (U \<inter> U')) (\<phi>\<^sub>f (U \<inter> U') add)"
         using eq induced_morphism_is_well_defined by presburger
       moreover have "stx.add_stalk (induced_morphism C) (induced_morphism C') =
                      stx.add_stalk (stx.class_of (f \<^sup>\<inverse> X U) (\<phi>\<^sub>f U q))
                                    (stx.class_of (f \<^sup>\<inverse> X U') (\<phi>\<^sub>f U' q'))"
         using CC(1) Uq(1) eq' induced_morphism_eval by auto
       moreover have "\<dots> = stx.class_of (f\<^sup>\<inverse> X (U \<inter> U'))
                                        (add_str\<^sub>X (f\<^sup>\<inverse> X (U \<inter> U'))
                                                  (\<rho>\<^sub>X (f\<^sup>\<inverse> X (U)) (f\<^sup>\<inverse> X (U \<inter> U')) (\<phi>\<^sub>f (U) (q)))
                                                  (\<rho>\<^sub>X (f\<^sup>\<inverse> X (U')) (f\<^sup>\<inverse> X (U \<inter> U')) (\<phi>\<^sub>f (U') (q')))
                                         )"
         unfolding stx.add_stalk_def
         using is_continuous phi_in_O stx.is_elem fXUU
         by (intro stx.add_rel_class_of) auto
       moreover have "\<phi>\<^sub>f (U \<inter> U') add = add_str\<^sub>X (f\<^sup>\<inverse> X (U \<inter> U'))
                                        (\<phi>\<^sub>f (U \<inter> U') (\<rho>\<^sub>Y (U) (U \<inter> U') (q)))
                                        (\<phi>\<^sub>f (U \<inter> U') (\<rho>\<^sub>Y (U') (U \<inter> U') (q')))"
         unfolding add_def
       proof (subst cc_rh.additive.commutes_with_composition)
         show "\<rho>\<^sub>Y U (U \<inter> U') q \<in> \<O>\<^sub>Y (U \<inter> U')"
           by (metis \<open>q \<in> \<O>\<^sub>Y U\<close> cc(1) codom.is_map_from_is_homomorphism inf.cobounded1 map.map_closed opeU(1))
         show "\<rho>\<^sub>Y U' (U \<inter> U') q' \<in> \<O>\<^sub>Y (U \<inter> U')"
           by (metis \<open>q' \<in> \<O>\<^sub>Y U'\<close> cc(1) codom.is_map_from_is_homomorphism inf.commute inf_le1 map.map_closed opeU(2))
       qed (auto simp: add_im_sheaf_def)
       moreover have "\<dots> = add_str\<^sub>X (f\<^sup>\<inverse> X (U \<inter> U'))
                             (\<rho>\<^sub>X (f\<^sup>\<inverse> X (U)) (f\<^sup>\<inverse> X (U \<inter> U')) (\<phi>\<^sub>f (U) (q)))
                             (\<rho>\<^sub>X (f\<^sup>\<inverse> X U') (f\<^sup>\<inverse> X (U \<inter> U')) (\<phi>\<^sub>f (U') (q')))"
         using assms
         apply (simp add: stfx.rel_def morphY.comm_diagrams [symmetric, unfolded o_def])
         using im_sheaf_morphisms_def by fastforce
       ultimately show ?thesis
         by simp
     qed
   next
     have "induced_morphism (stfx.zero_stalk V) = stx.class_of (f\<^sup>\<inverse> X V) (\<phi>\<^sub>f V (zero_str\<^sub>Y V))"
       using induced_morphism_eval [OF 0, where r = "(V, zero_str\<^sub>Y V)"] assms by force
     also have "\<dots> = stx.zero_stalk (f \<^sup>\<inverse> X V)"
       by (simp add: phif.additive.commutes_with_unit zero_im_sheaf_def stx.zero_stalk_def)
     finally show "induced_morphism (stfx.zero_stalk V) = stx.zero_stalk (f \<^sup>\<inverse> X V)" .
   qed
   show "monoid_homomorphism_axioms induced_morphism stfx.carrier_stalk stfx.mult_stalk (stfx.one_stalk V) stx.mult_stalk (stx.one_stalk (f \<^sup>\<inverse> X V))"
   proof
     fix C C'
     assume CC: "C \<in> stfx.carrier_stalk" "C' \<in> stfx.carrier_stalk"
     show "induced_morphism (stfx.mult_stalk C C') = stx.mult_stalk (induced_morphism C) (induced_morphism C')"
     proof -
       obtain U q U' q' where Uq: "(U,q) \<in> C" "(U',q') \<in> C'"
          and eq: "induced_morphism C = stx.class_of (f\<^sup>\<inverse> X U) (\<phi>\<^sub>f U q)"
          and eq': "induced_morphism C' = stx.class_of (f\<^sup>\<inverse> X U') (\<phi>\<^sub>f U' q')"
         by (metis (no_types, lifting) CC induced_morphism_eq)
       then obtain cc [simp]: "is_open\<^sub>Y (U \<inter> U')" "f x \<in> U" "f x \<in> U'"
         using CC eqY.block_closed stfx.carrier_direct_lim_def stfx.carrier_stalk_def stfx.neighborhoods_eq target.open_inter by force
       then interpret cc_rh: ring_homomorphism "\<phi>\<^sub>f (U \<inter> U')" "\<O>\<^sub>Y (U \<inter> U')"
         "add_str\<^sub>Y (U \<inter> U')" "mult_str\<^sub>Y (U \<inter> U')" "zero_str\<^sub>Y (U \<inter> U')"
         "one_str\<^sub>Y (U \<inter> U')" "local.im_sheaf (U \<inter> U')"
         "add_im_sheaf (U \<inter> U')" "mult_im_sheaf (U \<inter> U')"
         "zero_im_sheaf (U \<inter> U')" "one_im_sheaf (U \<inter> U')"
         by (metis is_morphism_of_sheaves morphism_presheaves_of_rings.is_ring_morphism morphism_sheaves_of_rings_def)
       obtain opeU [simp]: "is_open\<^sub>Y U" "is_open\<^sub>Y U'"
         by (metis (no_types, lifting) CC SigmaD1 Uq dlY.subset_of_opens eqY.block_closed stfx.carrier_direct_lim_def stfx.carrier_stalk_def stfx.neighborhoods_eq)
       obtain [simp]: "q \<in> \<O>\<^sub>Y U" "q' \<in> \<O>\<^sub>Y U'"
         using CC Uq stfx.carrier_direct_lim_def stfx.carrier_stalk_def stfx.neighborhoods_eq by auto
 
       define mult where "mult \<equiv> mult_str\<^sub>Y (U \<inter> U') (\<rho>\<^sub>Y U (U \<inter> U') q) (\<rho>\<^sub>Y U' (U \<inter> U') q')"
       have mult_stalk_eq_class: "stfx.mult_stalk C C' = stfx.class_of (U \<inter> U') mult"
         using CC
         unfolding mult_def stfx.mult_stalk_def stfx.carrier_stalk_def dlY.carrier_direct_lim_def
         by (smt (verit, best) IntI Int_commute Uq cc eqY.Block_self eqY.block_closed inf.cobounded1 mem_Collect_eq stfx.mult_rel_class_of stfx.class_of_def stfx.neighborhoods_eq)
        then have C: "(stfx.class_of (U \<inter> U') mult) \<in> stfx.carrier_stalk"
          by (metis CC V.multiplicative.monoid_axioms monoid.composition_closed stfx.carrier_stalk_def stfx.mult_stalk_def stfx.neighborhoods_eq)
       have mult_in: "mult \<in> \<O>\<^sub>Y (U \<inter> U')"
         apply (simp add: mult_def)
         using cc_rh.source.additive.composition_closed\<open>q \<in> \<O>\<^sub>Y U\<close> \<open>q' \<in> \<O>\<^sub>Y U'\<close>
         by (meson cc(1) cc_rh.source.multiplicative.composition_closed codom.is_map_from_is_homomorphism inf_le1 inf_le2 map.map_closed opeU)
       obtain V r where Vr: "(V,r) \<in> stfx.mult_stalk C C'"
            and eq: "induced_morphism (stfx.mult_stalk C C') = stx.class_of (f \<^sup>\<inverse> X V) (\<phi>\<^sub>f V r)"
         using induced_morphism_eq mult_stalk_eq_class C by auto
       have "is_open\<^sub>Y V"
         by (smt (verit, best) C SigmaD1 Vr mult_stalk_eq_class dlY.subset_of_opens eqY.block_closed stfx.carrier_direct_lim_def stfx.carrier_stalk_def stfx.neighborhoods_eq)
       have "r \<in> \<O>\<^sub>Y V"
         by (smt (verit, best) IntI Vr mult_stalk_eq_class mult_in cc fst_conv mem_Collect_eq snd_conv stfx.rel_I1 stfx.rel_def)
       have fxV: "f x \<in> V"
         using C Vr mult_stalk_eq_class stfx.carrier_direct_lim_def stfx.carrier_stalk_def stfx.neighborhoods_eq by auto
       have fXUU: "is_open\<^sub>X (f\<^sup>\<inverse> X (U \<inter> U'))"
         using cc(1) is_continuous by presburger
       have "(U \<inter> U', mult) \<in> stfx.class_of V r"
         by (metis (no_types, lifting) IntI Vr mult_stalk_eq_class mult_in cc mem_Collect_eq stfx.class_of_def stfx.rel_Class_iff stfx.rel_I1)
       then have "stfx.rel (V, r) (U \<inter> U', mult)"
         by (simp add: fxV \<open>is_open\<^sub>Y V\<close> \<open>r \<in> \<O>\<^sub>Y V\<close> stfx.rel_I1)
       then have "induced_morphism (stfx.mult_stalk C C') = stx.class_of (f\<^sup>\<inverse> X (U \<inter> U')) (\<phi>\<^sub>f (U \<inter> U') mult)"
         using eq induced_morphism_is_well_defined by presburger
       moreover have "stx.mult_stalk (induced_morphism C) (induced_morphism C') =
                      stx.mult_stalk (stx.class_of (f \<^sup>\<inverse> X U) (\<phi>\<^sub>f U q))
                                    (stx.class_of (f \<^sup>\<inverse> X U') (\<phi>\<^sub>f U' q'))"
         using CC(1) Uq(1) eq' induced_morphism_eval by auto
       moreover have "\<dots> = stx.class_of (f\<^sup>\<inverse> X (U \<inter> U'))
                                (mult_str\<^sub>X (f\<^sup>\<inverse> X (U \<inter> U'))
                                          (\<rho>\<^sub>X (f \<^sup>\<inverse> X U) (f \<^sup>\<inverse> X (U \<inter> U')) (\<phi>\<^sub>f U q))
                                          (\<rho>\<^sub>X (f \<^sup>\<inverse> X U') (f \<^sup>\<inverse> X (U \<inter> U')) (\<phi>\<^sub>f U' q')))"
         unfolding stx.mult_stalk_def
         using is_continuous phi_in_O stx.is_elem fXUU
         by (intro stx.mult_rel_class_of) auto
       moreover have "\<phi>\<^sub>f (U \<inter> U') mult = mult_str\<^sub>X (f\<^sup>\<inverse> X (U \<inter> U'))
                                            (\<phi>\<^sub>f (U \<inter> U') (\<rho>\<^sub>Y U (U \<inter> U') q))
                                            (\<phi>\<^sub>f (U \<inter> U') (\<rho>\<^sub>Y U' (U \<inter> U') q'))"
         unfolding mult_def
       proof (subst cc_rh.multiplicative.commutes_with_composition)
         show "\<rho>\<^sub>Y U (U \<inter> U') q \<in> \<O>\<^sub>Y (U \<inter> U')"
           by (metis \<open>q \<in> \<O>\<^sub>Y U\<close> cc(1) codom.is_map_from_is_homomorphism inf.cobounded1 map.map_closed opeU(1))
         show "\<rho>\<^sub>Y U' (U \<inter> U') q' \<in> \<O>\<^sub>Y (U \<inter> U')"
           by (metis \<open>q' \<in> \<O>\<^sub>Y U'\<close> cc(1) codom.is_map_from_is_homomorphism inf.commute inf_le1 map.map_closed opeU(2))
       qed (auto simp: mult_im_sheaf_def)
       moreover have "\<dots> = mult_str\<^sub>X (f\<^sup>\<inverse> X (U \<inter> U'))
                             (\<rho>\<^sub>X (f \<^sup>\<inverse> X U) (f \<^sup>\<inverse> X (U \<inter> U')) (\<phi>\<^sub>f U q))
                             (\<rho>\<^sub>X (f \<^sup>\<inverse> X U') (f \<^sup>\<inverse> X (U \<inter> U')) (\<phi>\<^sub>f U' q'))"
         using assms im_sheaf_morphisms_def
         by (fastforce simp: stfx.rel_def morphY.comm_diagrams [symmetric, unfolded o_def])
       ultimately show ?thesis
         by simp
     qed
   next
     have "induced_morphism (stfx.one_stalk V) = stx.class_of (f\<^sup>\<inverse> X V) (\<phi>\<^sub>f V (one_str\<^sub>Y V))"
       using induced_morphism_eval [OF 1, where r = "(V, one_str\<^sub>Y V)"] assms by force
     also have "\<dots> = stx.one_stalk (f \<^sup>\<inverse> X V)"
       by (simp add: phif.multiplicative.commutes_with_unit one_im_sheaf_def stx.one_stalk_def)
     finally show "induced_morphism (stfx.one_stalk V) = stx.one_stalk (f \<^sup>\<inverse> X V)" .
   qed
 qed
 
 
 definition is_local:: "'c set \<Rightarrow> (('c set \<times> 'd) set \<Rightarrow> ('a set \<times> 'b) set) \<Rightarrow> bool" where
   "is_local V \<phi> \<equiv>
       local_ring_morphism \<phi>
       stfx.carrier_stalk stfx.add_stalk stfx.mult_stalk (stfx.zero_stalk V) (stfx.one_stalk V)
       stx.carrier_stalk stx.add_stalk stx.mult_stalk (stx.zero_stalk (f\<^sup>\<inverse> X V)) (stx.one_stalk (f\<^sup>\<inverse> X V))"
 
 end (* ind_mor_btw_stalks *)
 
 notation ind_mor_btw_stalks.induced_morphism ("\<phi>\<^bsub>(3_ _ _ _/ _ _ _/ _ _ _)\<^esub>"
     [1000,1000,1000,1000,1000,1000,1000,1000,1000,1000]1000)
 
 lemma (in sheaf_of_rings) induced_morphism_with_id_is_id:
   assumes "x \<in> S"
   shows "\<phi>\<^bsub>S is_open \<FF> \<rho> is_open \<FF> \<rho> (identity S) (\<lambda>U. identity (\<FF> U)) x\<^esub>
        = (\<lambda>C\<in>(stalk.carrier_stalk is_open \<FF> \<rho> x). C)"
 proof -
   interpret im_sheaf S is_open \<FF> \<rho> b add_str mult_str zero_str one_str S is_open "identity S"
     by (metis homeomorphism.axioms(3) id_is_homeomorphism im_sheaf_def inverse_map_identity
         sheaf_of_rings_axioms)
   interpret codom: ringed_space S is_open \<FF> \<rho> b add_str mult_str zero_str one_str
     by (meson im_sheaf.axioms(1) im_sheaf_axioms ringed_space_def)
 
   interpret ind_mor_btw_stalks S is_open \<FF> \<rho> b add_str mult_str zero_str one_str S
        is_open \<FF> \<rho> b add_str mult_str zero_str one_str "identity S" "\<lambda>U. identity (\<FF> U)" x
     apply intro_locales
     subgoal
     proof -
       have "ring_homomorphism (identity (\<FF> U)) (\<FF> U) +\<^bsub>U\<^esub> \<cdot>\<^bsub>U\<^esub> \<zero>\<^bsub>U\<^esub> \<one>\<^bsub>U\<^esub> (local.im_sheaf U) (add_im_sheaf U)
           (mult_im_sheaf U) (zero_im_sheaf U) (one_im_sheaf U)" if "is_open U" for U
         by (smt (z3) id_is_mor_pr_rngs im_sheaf.add_im_sheaf_def im_sheaf.im_sheaf_def
             im_sheaf.mult_im_sheaf_def im_sheaf_axioms local.topological_space_axioms
             morphism_presheaves_of_rings.is_ring_morphism one_im_sheaf_def that
             topological_space.open_preimage_identity zero_im_sheaf_def)
       moreover have "\<forall>U V. is_open U \<longrightarrow>
            is_open V \<longrightarrow>
            V \<subseteq> U \<longrightarrow> (\<forall>x. x \<in> \<FF> U \<longrightarrow> (im_sheaf_morphisms U V \<circ> identity (\<FF> U)) x = (identity (\<FF> V) \<circ> \<rho> U V) x)"
         by (smt (verit, best) comp_apply im_sheaf_morphisms_def is_map_from_is_homomorphism
             local.im_sheaf_def map.map_closed open_preimage_identity restrict_apply')
       ultimately have "morphism_presheaves_of_rings_axioms is_open \<FF> \<rho> add_str mult_str
           zero_str one_str local.im_sheaf im_sheaf_morphisms add_im_sheaf mult_im_sheaf
           zero_im_sheaf one_im_sheaf (\<lambda>U. identity (\<FF> U))"
         unfolding morphism_presheaves_of_rings_axioms_def by auto
       then show ?thesis
         unfolding morphism_ringed_spaces_axioms_def
         by intro_locales
 
     qed
     subgoal by (meson assms ind_mor_btw_stalks_axioms.intro)
     done
 
   have "(let r = SOME r. r \<in> C
         in direct_lim.class_of \<FF> \<rho> (neighborhoods x) (identity S \<^sup>\<inverse> S (fst r))
             (identity (\<FF> (fst r)) (snd r))) = C"
     (is "?L= _")
     if "C\<in>stalk.carrier_stalk is_open \<FF> \<rho> x" for C
   proof -
     interpret stk:stalk S is_open \<FF> \<rho> b add_str mult_str zero_str one_str
                       "neighborhoods x" x
       apply unfold_locales
       using is_elem neighborhoods_def by auto
     define r where "r=(SOME x. x \<in> C)"
     have r:"r \<in> C" "r \<in> Sigma (neighborhoods x) \<FF>" and "C = stk.class_of (fst r) (snd r)"
       using stk.rel_carrier_Eps_in[OF that[unfolded stk.carrier_stalk_def]] unfolding r_def by auto
 
     have "?L = stk.class_of (identity S \<^sup>\<inverse> S (fst r)) (identity (\<FF> (fst r)) (snd r))"
       unfolding r_def Let_def by simp
     also have "... =  stk.class_of (fst r) (snd r)"
       by (metis open_preimage_identity r(1) restrict_apply stk.carrier_direct_limE
           stk.carrier_stalk_def stk.rel_I1 stk.rel_def stk.subset_of_opens that)
     also have "... = C"
       using \<open>C = stk.class_of (fst r) (snd r)\<close> by simp
     finally show ?thesis .
   qed
   then show ?thesis
     unfolding induced_morphism_def
     using is_elem neighborhoods_def by fastforce
 qed
 
 lemma (in locally_ringed_space) induced_morphism_with_id_is_local:
   assumes "x \<in> S" and V: "x \<in> V" "is_open V"
   shows "ind_mor_btw_stalks.is_local
 S is_open \<FF> \<rho> add_str mult_str zero_str one_str is_open \<FF> \<rho> add_str mult_str zero_str one_str
 (identity S) x V (\<phi>\<^bsub>S is_open \<FF> \<rho> is_open \<FF> \<rho> (identity S) (\<lambda>U. identity (\<FF> U)) x\<^esub>)"
 proof-
   have [simp]: "(identity S)\<^sup>\<inverse> S V = V"
     using assms by auto
   interpret stfx: stalk S is_open \<FF> \<rho> b add_str mult_str zero_str one_str
                     "{U. is_open U \<and> (identity S x) \<in> U}" "identity S x"
   proof qed (use assms in auto)
   have "local_ring stfx.carrier_stalk stfx.add_stalk stfx.mult_stalk (stfx.zero_stalk V) (stfx.one_stalk V)"
     by (smt (verit, best) assms restrict_apply' stalks_are_local stfx.is_local_def stfx.neighborhoods_eq)
   interpret stx: stalk S is_open \<FF> \<rho> b add_str mult_str zero_str one_str "{U. is_open U \<and> x \<in> U}" "x"
     using \<open>x \<in> S\<close> stfx.stalk_axioms by fastforce
   interpret local_ring stx.carrier_stalk stx.add_stalk stx.mult_stalk
               "stx.zero_stalk ((identity S)\<^sup>\<inverse> S V)" "stx.one_stalk ((identity S)\<^sup>\<inverse> S V)"
     using V stalks_are_local stx.is_local_def stx.neighborhoods_eq by fastforce
   interpret imS: im_sheaf S is_open \<FF> \<rho> b add_str mult_str zero_str one_str S is_open "identity S"
     by (metis homeomorphism.axioms(3) id_is_homeomorphism im_sheaf_def inverse_map_identity
         sheaf_of_rings_axioms)
   have rh: "\<And>U. is_open U \<Longrightarrow>
              ring_homomorphism (identity (\<FF> U)) (\<FF> U) +\<^bsub>U\<^esub> \<cdot>\<^bsub>U\<^esub> \<zero>\<^bsub>U\<^esub> \<one>\<^bsub>U\<^esub> (imS.im_sheaf U)
               (imS.add_im_sheaf U) (imS.mult_im_sheaf U) (imS.zero_im_sheaf U) (imS.one_im_sheaf U)"
     unfolding imS.add_im_sheaf_def imS.mult_im_sheaf_def imS.one_im_sheaf_def
               imS.zero_im_sheaf_def imS.im_sheaf_def
     using id_is_mor_pr_rngs morphism_presheaves_of_rings.is_ring_morphism by fastforce
   interpret ind_mor_btw_stalks S is_open \<FF> \<rho> b add_str mult_str zero_str one_str S
     is_open \<FF> \<rho> b add_str mult_str zero_str one_str "identity S" "\<lambda>U. identity (\<FF> U)" x
   proof intro_locales
     show "morphism_ringed_spaces_axioms S \<FF> \<rho> b add_str mult_str zero_str one_str
               S is_open \<FF> \<rho> b add_str mult_str zero_str one_str (identity S) (\<lambda>U. identity (\<FF> U))"
       unfolding morphism_ringed_spaces_axioms_def morphism_sheaves_of_rings_def
         morphism_presheaves_of_rings_def morphism_presheaves_of_rings_axioms_def
       using rh
       by (auto simp add: presheaf_of_rings_axioms imS.presheaf_of_rings_axioms
              map.map_closed [OF is_map_from_is_homomorphism] imS.im_sheaf_morphisms_def)
     show "ind_mor_btw_stalks_axioms S x"
       by (simp add: assms(1) ind_mor_btw_stalks_axioms_def)
   qed
   have "\<phi>\<^bsub>S is_open \<FF> \<rho> is_open \<FF> \<rho> (identity S) (\<lambda>U. identity (\<FF> U)) x\<^esub> = identity stx.carrier_stalk"
     using induced_morphism_with_id_is_id stx.is_elem by simp
   then show ?thesis
     using id_is_local_ring_morphism is_local_def local_ring_axioms stx.is_elem by fastforce
 qed
 
 (* definition 0.45 *)
 
 locale morphism_locally_ringed_spaces = morphism_ringed_spaces +
   assumes are_local_morphisms:
     "\<And>x V. \<lbrakk>x \<in> X; is_open\<^sub>Y V; f x \<in> V\<rbrakk> \<Longrightarrow>
 ind_mor_btw_stalks.is_local X is_open\<^sub>X \<O>\<^sub>X \<rho>\<^sub>X add_str\<^sub>X mult_str\<^sub>X zero_str\<^sub>X one_str\<^sub>X
                             is_open\<^sub>Y \<O>\<^sub>Y \<rho>\<^sub>Y add_str\<^sub>Y mult_str\<^sub>Y zero_str\<^sub>Y one_str\<^sub>Y f
                             x V \<phi>\<^bsub>X is_open\<^sub>X \<O>\<^sub>X \<rho>\<^sub>X is_open\<^sub>Y \<O>\<^sub>Y \<rho>\<^sub>Y f \<phi>\<^sub>f x\<^esub>"
 
 lemma (in locally_ringed_space) id_to_mor_locally_ringed_spaces:
   shows "morphism_locally_ringed_spaces
             S is_open \<FF> \<rho> b add_str mult_str zero_str one_str
             S is_open \<FF> \<rho> b add_str mult_str zero_str one_str
             (identity S) (\<lambda>U. identity (\<FF> U))"
 proof intro_locales
   interpret idim: im_sheaf S is_open \<FF> \<rho> b add_str mult_str zero_str one_str S is_open "identity S"
   proof
     fix U assume "is_open U"
     then show "is_open (identity S \<^sup>\<inverse> S U)"
       by (simp add: open_inter preimage_identity_self)
   qed auto
   show "Set_Theory.map (identity S) S S"
     by (simp add: Set_Theory.map_def)
   show "continuous_map_axioms S is_open is_open (identity S)"
     by (simp add: continuous_map_axioms_def open_inter preimage_identity_self)
   have gh: "group_homomorphism (identity (\<FF> U)) (\<FF> U) +\<^bsub>U\<^esub>
           \<zero>\<^bsub>U\<^esub> (idim.im_sheaf U) (idim.add_im_sheaf U) (idim.zero_im_sheaf U)"
     if "is_open U" for U
     using that id_is_mor_pr_rngs idim.add_im_sheaf_def idim.im_sheaf_def idim.zero_im_sheaf_def morphism_presheaves_of_rings.is_ring_morphism ring_homomorphism_def by fastforce
   have "morphism_presheaves_of_rings_axioms is_open \<FF> \<rho> add_str mult_str zero_str one_str idim.im_sheaf idim.im_sheaf_morphisms idim.add_im_sheaf idim.mult_im_sheaf idim.zero_im_sheaf idim.one_im_sheaf (\<lambda>U. identity (\<FF> U))"
     unfolding morphism_presheaves_of_rings_axioms_def
   proof (intro conjI strip)
     fix U
     assume "is_open U"
     then show "ring_homomorphism (identity (\<FF> U)) (\<FF> U) +\<^bsub>U\<^esub> \<cdot>\<^bsub>U\<^esub> \<zero>\<^bsub>U\<^esub> \<one>\<^bsub>U\<^esub> (idim.im_sheaf U) (idim.add_im_sheaf U) (idim.mult_im_sheaf U) (idim.zero_im_sheaf U) (idim.one_im_sheaf U)"
       using id_is_mor_pr_rngs idim.add_im_sheaf_def idim.im_sheaf_def idim.mult_im_sheaf_def idim.one_im_sheaf_def idim.zero_im_sheaf_def morphism_presheaves_of_rings.is_ring_morphism by fastforce
     fix V x
     assume "is_open V" and "V \<subseteq> U" and "x \<in> \<FF> U"
     then show "(idim.im_sheaf_morphisms U V \<circ> identity (\<FF> U)) x = (identity (\<FF> V) \<circ> \<rho> U V) x"
       using \<open>is_open U\<close>
       by (simp add: idim.im_sheaf_morphisms_def map.map_closed [OF is_map_from_is_homomorphism])
   qed
   then show mrs: "morphism_ringed_spaces_axioms S \<FF> \<rho> b add_str mult_str zero_str one_str
                       S is_open \<FF> \<rho> b add_str mult_str zero_str one_str (identity S) (\<lambda>U. identity (\<FF> U))"
     by (simp add: idim.im_sheaf_is_presheaf morphism_presheaves_of_rings_def morphism_ringed_spaces_axioms.intro morphism_sheaves_of_rings.intro presheaf_of_rings_axioms)
   show "morphism_locally_ringed_spaces_axioms S is_open \<FF> \<rho> add_str mult_str zero_str one_str
                      is_open \<FF> \<rho> add_str mult_str zero_str one_str (identity S) (\<lambda>U. identity (\<FF> U))"
     using induced_morphism_with_id_is_local
     by (simp add: morphism_locally_ringed_spaces_axioms_def)
 qed
 
 locale iso_locally_ringed_spaces = morphism_locally_ringed_spaces +
   assumes is_homeomorphism: "homeomorphism X is_open\<^sub>X Y is_open\<^sub>Y f" and
 is_iso_of_sheaves: "iso_sheaves_of_rings Y is_open\<^sub>Y \<O>\<^sub>Y \<rho>\<^sub>Y d add_str\<^sub>Y mult_str\<^sub>Y zero_str\<^sub>Y one_str\<^sub>Y
 im_sheaf im_sheaf_morphisms b add_im_sheaf mult_im_sheaf zero_im_sheaf one_im_sheaf
 \<phi>\<^sub>f"
 
 lemma (in locally_ringed_space) id_to_iso_locally_ringed_spaces:
   shows "iso_locally_ringed_spaces
             S is_open \<FF> \<rho> b add_str mult_str zero_str one_str
             S is_open \<FF> \<rho> b add_str mult_str zero_str one_str
             (identity S) (\<lambda>U. identity (\<FF> U))"
 proof -
   interpret morphism_ringed_spaces S is_open \<FF> \<rho> b add_str mult_str zero_str one_str
     S is_open \<FF> \<rho> b add_str mult_str zero_str one_str "identity S" "\<lambda>U. identity (\<FF> U)"
     by (metis id_to_mor_locally_ringed_spaces morphism_locally_ringed_spaces_def)
   show ?thesis
   proof intro_locales
     show "morphism_locally_ringed_spaces_axioms S is_open \<FF> \<rho> add_str mult_str zero_str one_str is_open \<FF> \<rho> add_str mult_str zero_str one_str (identity S) (\<lambda>U. identity (\<FF> U))"
       by (metis id_to_mor_locally_ringed_spaces morphism_locally_ringed_spaces_def)
     show "iso_locally_ringed_spaces_axioms S is_open \<FF> \<rho> b add_str mult_str zero_str one_str S is_open \<FF> \<rho> b add_str mult_str zero_str one_str (identity S) (\<lambda>U. identity (\<FF> U))"
       unfolding iso_locally_ringed_spaces_axioms_def iso_sheaves_of_rings_def iso_presheaves_of_rings_def iso_presheaves_of_rings_axioms_def
     proof (intro conjI)
       show "homeomorphism S is_open S is_open (identity S)"
         using id_is_homeomorphism by blast
       show mor:"morphism_presheaves_of_rings S is_open \<FF> \<rho> b add_str mult_str zero_str one_str
             local.im_sheaf im_sheaf_morphisms b add_im_sheaf mult_im_sheaf zero_im_sheaf one_im_sheaf
             (\<lambda>U. identity (\<FF> U))"
         by (simp add: is_morphism_of_sheaves morphism_sheaves_of_rings.axioms)
       have "morphism_presheaves_of_rings S is_open
                local.im_sheaf im_sheaf_morphisms b add_im_sheaf mult_im_sheaf zero_im_sheaf one_im_sheaf
                \<FF> \<rho> b add_str mult_str zero_str one_str (\<lambda>U. identity (\<FF> U))"
         unfolding morphism_presheaves_of_rings_def morphism_presheaves_of_rings_axioms_def
       proof (intro conjI strip)
         show "presheaf_of_rings S is_open local.im_sheaf im_sheaf_morphisms b add_im_sheaf mult_im_sheaf zero_im_sheaf one_im_sheaf"
           using im_sheaf_is_presheaf by blast
         show "presheaf_of_rings S is_open \<FF> \<rho> b add_str mult_str zero_str one_str"
           by (metis mor morphism_presheaves_of_rings_def)
       next
         fix U assume "is_open U"
         then have "ring_homomorphism (identity (\<FF> U)) (\<FF> U) +\<^bsub>U\<^esub> \<cdot>\<^bsub>U\<^esub> \<zero>\<^bsub>U\<^esub> \<one>\<^bsub>U\<^esub> (\<FF> U) +\<^bsub>U\<^esub> \<cdot>\<^bsub>U\<^esub> \<zero>\<^bsub>U\<^esub> \<one>\<^bsub>U\<^esub>"
           by (smt (z3) im_sheaf.add_im_sheaf_def im_sheaf.mult_im_sheaf_def im_sheaf_axioms
               local.im_sheaf_def mor morphism_presheaves_of_rings.is_ring_morphism one_im_sheaf_def
               open_preimage_identity zero_im_sheaf_def)
         then show "ring_homomorphism (identity (\<FF> U)) (local.im_sheaf U) (add_im_sheaf U) (mult_im_sheaf U) (zero_im_sheaf U) (one_im_sheaf U) (\<FF> U) +\<^bsub>U\<^esub> \<cdot>\<^bsub>U\<^esub> \<zero>\<^bsub>U\<^esub> \<one>\<^bsub>U\<^esub>"
           using \<open>is_open U \<close> im_sheaf.add_im_sheaf_def im_sheaf_axioms local.im_sheaf_def mult_im_sheaf_def one_im_sheaf_def zero_im_sheaf_def
           by fastforce
         fix V x
         assume "is_open V" and "V \<subseteq> U" and "x \<in> local.im_sheaf U"
         then show "(\<rho> U V \<circ> identity (\<FF> U)) x = (identity (\<FF> V) \<circ> im_sheaf_morphisms U V) x"
           using map.map_closed [OF is_map_from_is_homomorphism] \<open>is_open U\<close>
           by (simp add: im_sheaf_morphisms_def local.im_sheaf_def)
       qed
       then show "\<exists>\<psi>. morphism_presheaves_of_rings S is_open (im_sheaf.im_sheaf S \<FF> (identity S)) (im_sheaf.im_sheaf_morphisms S \<rho> (identity S)) b
               (im_sheaf.add_im_sheaf S add_str (identity S)) (im_sheaf.mult_im_sheaf S mult_str (identity S)) (im_sheaf.zero_im_sheaf S zero_str (identity S)) (im_sheaf.one_im_sheaf S one_str (identity S)) \<FF> \<rho> b add_str mult_str zero_str one_str \<psi> \<and> (\<forall>U. is_open U \<longrightarrow> (\<forall>x\<in>im_sheaf.im_sheaf S \<FF> (identity S) U. (identity (\<FF> U) \<circ> \<psi> U) x = x) \<and> (\<forall>x\<in>\<FF> U. (\<psi> U \<circ> identity (\<FF> U)) x = x))"
         using local.im_sheaf_def by auto
     qed
   qed
 qed
 
 end