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, opaque_lifting) 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 (verit, del_insts) \<open>x \<in> R\<close> additive.associative additive.commutative additive.composition_closed additive.submonoid_axioms distributive(2) 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 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)
        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, opaque_lifting))
  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, opaque_lifting) 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, opaque_lifting) 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, opaque_lifting) 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, opaque_lifting) 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 (verit, best) 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 (verit, best) 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