# HG changeset patch
# User paulson
# Date 1555239617 -3600
# Node ID 6152339771557d64222ee866bc8a393bc01fd1d3
# Parent  57503fe1b0ff293b56bf416d84f9e46e7e66b93d# Parent  13b10ca7115021fc1a548364b234a303ea6acb75
merged

diff -r 57503fe1b0ff -r 615233977155 src/HOL/Algebra/Algebra.thy
--- a/src/HOL/Algebra/Algebra.thy	Sat Apr 13 22:06:40 2019 +0200
+++ b/src/HOL/Algebra/Algebra.thy	Sun Apr 14 12:00:17 2019 +0100
@@ -2,6 +2,6 @@
 
 theory Algebra
   imports Sylow Chinese_Remainder Zassenhaus Galois_Connection Generated_Fields Free_Abelian_Groups
-     Divisibility Embedded_Algebras IntRing Sym_Groups Exact_Sequence Polynomials
+     Divisibility Embedded_Algebras IntRing Sym_Groups Exact_Sequence Polynomials Algebraic_Closure
 begin
 end
diff -r 57503fe1b0ff -r 615233977155 src/HOL/Algebra/Algebraic_Closure.thy
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Algebra/Algebraic_Closure.thy	Sun Apr 14 12:00:17 2019 +0100
@@ -0,0 +1,768 @@
+(*  Title:      HOL/Algebra/Algebraic_Closure.thy
+    Author:     Paulo Emílio de Vilhena
+
+With contributions by Martin Baillon.
+*)
+
+theory Algebraic_Closure
+  imports Indexed_Polynomials Polynomial_Divisibility Pred_Zorn Finite_Extensions
+
+begin
+
+section \<open>Algebraic Closure\<close>
+
+subsection \<open>Definitions\<close>
+
+inductive iso_incl :: "'a ring \<Rightarrow> 'a ring \<Rightarrow> bool" (infixl "\<lesssim>" 65) for A B
+  where iso_inclI [intro]: "id \<in> ring_hom A B \<Longrightarrow> iso_incl A B"
+
+definition law_restrict :: "('a, 'b) ring_scheme \<Rightarrow> 'a ring"
+  where "law_restrict R \<equiv> (ring.truncate R)
+           \<lparr> mult := (\<lambda>a \<in> carrier R. \<lambda>b \<in> carrier R. a \<otimes>\<^bsub>R\<^esub> b),
+              add := (\<lambda>a \<in> carrier R. \<lambda>b \<in> carrier R. a \<oplus>\<^bsub>R\<^esub> b) \<rparr>"
+
+definition (in ring) \<sigma> :: "'a list \<Rightarrow> (('a list multiset) \<Rightarrow> 'a) list"
+  where "\<sigma> P = map indexed_const P"
+
+definition (in ring) extensions :: "(('a list multiset) \<Rightarrow> 'a) ring set"
+  where "extensions \<equiv> { L \<comment> \<open>such that\<close>.
+           \<comment> \<open>i\<close>   (field L) \<and>
+           \<comment> \<open>ii\<close>  (indexed_const \<in> ring_hom R L) \<and>
+           \<comment> \<open>iii\<close> (\<forall>\<P> \<in> carrier L. carrier_coeff \<P>) \<and>
+           \<comment> \<open>iv\<close>  (\<forall>\<P> \<in> carrier L. \<forall>P \<in> carrier (poly_ring R).
+                       \<not> index_free \<P> P \<longrightarrow> \<X>\<^bsub>P\<^esub> \<in> carrier L \<and> (ring.eval L) (\<sigma> P) \<X>\<^bsub>P\<^esub> = \<zero>\<^bsub>L\<^esub>) }"
+
+abbreviation (in ring) restrict_extensions :: "(('a list multiset) \<Rightarrow> 'a) ring set" ("\<S>")
+  where "\<S> \<equiv> law_restrict ` extensions"
+
+
+subsection \<open>Basic Properties\<close>
+
+(* ========== *)
+lemma (in field) is_ring: "ring R"
+  using ring_axioms .
+(* ========== *)
+
+lemma law_restrict_carrier: "carrier (law_restrict R) = carrier R"
+  by (simp add: law_restrict_def ring.defs)
+
+lemma law_restrict_one: "one (law_restrict R) = one R"
+  by (simp add: law_restrict_def ring.defs)
+
+lemma law_restrict_zero: "zero (law_restrict R) = zero R"
+  by (simp add: law_restrict_def ring.defs)
+
+lemma law_restrict_mult: "monoid.mult (law_restrict R) = (\<lambda>a \<in> carrier R. \<lambda>b \<in> carrier R. a \<otimes>\<^bsub>R\<^esub> b)"
+  by (simp add: law_restrict_def ring.defs)
+
+lemma law_restrict_add: "add (law_restrict R) = (\<lambda>a \<in> carrier R. \<lambda>b \<in> carrier R. a \<oplus>\<^bsub>R\<^esub> b)"
+  by (simp add: law_restrict_def ring.defs)
+
+lemma (in ring) law_restrict_is_ring: "ring (law_restrict R)"
+  by (unfold_locales) (auto simp add: law_restrict_def Units_def ring.defs,
+      simp_all add: a_assoc a_comm m_assoc l_distr r_distr a_lcomm)
+
+lemma (in field) law_restrict_is_field: "field (law_restrict R)"
+proof -
+  have "comm_monoid_axioms (law_restrict R)"
+    using m_comm unfolding comm_monoid_axioms_def law_restrict_carrier law_restrict_mult by auto 
+  then interpret L: cring "law_restrict R"
+    using cring.intro law_restrict_is_ring comm_monoid.intro ring.is_monoid by auto
+  have "Units R = Units (law_restrict R)"
+    unfolding Units_def law_restrict_carrier law_restrict_mult law_restrict_one by auto
+  thus ?thesis
+    using L.cring_fieldI unfolding field_Units law_restrict_carrier law_restrict_zero by simp
+qed
+    
+lemma law_restrict_iso_imp_eq:
+  assumes "id \<in> ring_iso (law_restrict A) (law_restrict B)" and "ring A" and "ring B"
+  shows "law_restrict A = law_restrict B"
+proof -
+  have "carrier A = carrier B"
+    using ring_iso_memE(5)[OF assms(1)] unfolding bij_betw_def law_restrict_def by (simp add: ring.defs)
+  hence mult: "a \<otimes>\<^bsub>law_restrict A\<^esub> b = a \<otimes>\<^bsub>law_restrict B\<^esub> b"
+    and add:  "a \<oplus>\<^bsub>law_restrict A\<^esub> b = a \<oplus>\<^bsub>law_restrict B\<^esub> b" for a b
+    using ring_iso_memE(2-3)[OF assms(1)] unfolding law_restrict_def by (auto simp add: ring.defs)
+  have "monoid.mult (law_restrict A) = monoid.mult (law_restrict B)"
+    using mult by auto
+  moreover have "add (law_restrict A) = add (law_restrict B)"
+    using add by auto
+  moreover from \<open>carrier A = carrier B\<close> have "carrier (law_restrict A) = carrier (law_restrict B)"
+    unfolding law_restrict_def by (simp add: ring.defs)
+  moreover have "\<zero>\<^bsub>law_restrict A\<^esub> = \<zero>\<^bsub>law_restrict B\<^esub>"
+    using ring_hom_zero[OF _ assms(2-3)[THEN ring.law_restrict_is_ring]] assms(1)
+    unfolding ring_iso_def by auto
+  moreover have "\<one>\<^bsub>law_restrict A\<^esub> = \<one>\<^bsub>law_restrict B\<^esub>"
+    using ring_iso_memE(4)[OF assms(1)] by simp
+  ultimately show ?thesis by simp
+qed
+
+lemma law_restrict_hom: "h \<in> ring_hom A B \<longleftrightarrow> h \<in> ring_hom (law_restrict A) (law_restrict B)"
+proof
+  assume "h \<in> ring_hom A B" thus "h \<in> ring_hom (law_restrict A) (law_restrict B)"
+    by (auto intro!: ring_hom_memI dest: ring_hom_memE simp: law_restrict_def ring.defs)
+next
+  assume h: "h \<in> ring_hom (law_restrict A) (law_restrict B)" show "h \<in> ring_hom A B"
+    using ring_hom_memE[OF h] by (auto intro!: ring_hom_memI simp: law_restrict_def ring.defs)
+qed
+
+lemma iso_incl_hom: "A \<lesssim> B \<longleftrightarrow> (law_restrict A) \<lesssim> (law_restrict B)"
+  using law_restrict_hom iso_incl.simps by blast
+
+
+subsection \<open>Partial Order\<close>
+
+lemma iso_incl_backwards: 
+  assumes "A \<lesssim> B" shows "id \<in> ring_hom A B"
+  using assms by cases
+
+lemma iso_incl_antisym_aux: 
+  assumes "A \<lesssim> B" and "B \<lesssim> A" shows "id \<in> ring_iso A B"
+proof - 
+  have hom: "id \<in> ring_hom A B" "id \<in> ring_hom B A" 
+    using assms(1-2)[THEN iso_incl_backwards] by auto
+  thus ?thesis 
+    using hom[THEN ring_hom_memE(1)] by (auto simp add: ring_iso_def bij_betw_def inj_on_def)
+qed
+
+lemma iso_incl_refl: "A \<lesssim> A" 
+  by (rule iso_inclI[OF ring_hom_memI], auto)
+
+lemma iso_incl_trans: 
+  assumes "A \<lesssim> B" and "B \<lesssim> C" shows "A \<lesssim> C"
+  using ring_hom_trans[OF assms[THEN iso_incl_backwards]] by auto
+
+lemma (in ring) iso_incl_antisym:
+  assumes "A \<in> \<S>" "B \<in> \<S>" and "A \<lesssim> B" "B \<lesssim> A" shows "A = B"
+proof - 
+  obtain A' B' :: "('a list multiset \<Rightarrow> 'a) ring" 
+    where A: "A = law_restrict A'" "ring A'" and B: "B = law_restrict B'" "ring B'"
+    using assms(1-2) field.is_ring by (auto simp add: extensions_def)
+  thus ?thesis 
+    using law_restrict_iso_imp_eq iso_incl_antisym_aux[OF assms(3-4)] by simp
+qed
+
+lemma (in ring) iso_incl_partial_order: "partial_order_on \<S> (rel_of (\<lesssim>) \<S>)"
+  using iso_incl_refl iso_incl_trans iso_incl_antisym by (rule partial_order_on_rel_ofI)
+
+lemma iso_inclE:
+  assumes "ring A" and "ring B" and "A \<lesssim> B" shows "ring_hom_ring A B id"
+  using iso_incl_backwards[OF assms(3)] ring_hom_ring.intro[OF assms(1-2)]
+  unfolding symmetric[OF ring_hom_ring_axioms_def] by simp
+
+lemma iso_incl_imp_same_eval:
+  assumes "ring A" and "ring B" and "A \<lesssim> B" and "a \<in> carrier A" and "set p \<subseteq> carrier A"
+  shows "(ring.eval A) p a = (ring.eval B) p a"
+  using ring_hom_ring.eval_hom'[OF iso_inclE[OF assms(1-3)] assms(4-5)] by simp
+
+
+subsection \<open>Extensions Non Empty\<close>
+
+lemma (in ring) indexed_const_is_inj: "inj indexed_const"
+  unfolding indexed_const_def by (rule inj_onI, metis)
+
+lemma (in ring) indexed_const_inj_on: "inj_on indexed_const (carrier R)"
+  unfolding indexed_const_def by (rule inj_onI, metis)
+
+lemma (in field) extensions_non_empty: "\<S> \<noteq> {}"
+proof -
+  have "image_ring indexed_const R \<in> extensions"
+  proof (auto simp add: extensions_def)
+    show "field (image_ring indexed_const R)"
+      using inj_imp_image_ring_is_field[OF indexed_const_inj_on] .
+  next
+    show "indexed_const \<in> ring_hom R (image_ring indexed_const R)"
+      using inj_imp_image_ring_iso[OF indexed_const_inj_on] unfolding ring_iso_def by auto
+  next
+    fix \<P> :: "('a list multiset) \<Rightarrow> 'a" and P
+    assume "\<P> \<in> carrier (image_ring indexed_const R)"
+    then obtain k where "k \<in> carrier R" and "\<P> = indexed_const k"
+      unfolding image_ring_carrier by blast
+    hence "index_free \<P> P" for P
+      unfolding index_free_def indexed_const_def by auto
+    thus "\<not> index_free \<P> P \<Longrightarrow> \<X>\<^bsub>P\<^esub> \<in> carrier (image_ring indexed_const R)"
+     and "\<not> index_free \<P> P \<Longrightarrow> ring.eval (image_ring indexed_const R) (\<sigma> P) \<X>\<^bsub>P\<^esub> = \<zero>\<^bsub>image_ring indexed_const R\<^esub>"
+      by auto
+    from \<open>k \<in> carrier R\<close> and \<open>\<P> = indexed_const k\<close> show "carrier_coeff \<P>"
+      unfolding indexed_const_def carrier_coeff_def by auto
+  qed
+  thus ?thesis
+    by blast
+qed
+
+
+subsection \<open>Chains\<close>
+
+definition union_ring :: "(('a, 'c) ring_scheme) set \<Rightarrow> 'a ring"
+  where "union_ring C = 
+           \<lparr> carrier = (\<Union>(carrier ` C)),
+         monoid.mult = (\<lambda>a b. (monoid.mult (SOME R. R \<in> C \<and> a \<in> carrier R \<and> b \<in> carrier R) a b)),
+                 one = one (SOME R. R \<in> C),
+                zero = zero (SOME R. R \<in> C),
+                 add = (\<lambda>a b. (add (SOME R. R \<in> C \<and> a \<in> carrier R \<and> b \<in> carrier R) a b)) \<rparr>"
+
+
+lemma union_ring_carrier: "carrier (union_ring C) = (\<Union>(carrier ` C))"
+  unfolding union_ring_def by simp
+
+context
+  fixes C :: "'a ring set"
+  assumes field_chain: "\<And>R. R \<in> C \<Longrightarrow> field R" and chain: "\<And>R S. \<lbrakk> R \<in> C; S \<in> C \<rbrakk> \<Longrightarrow> R \<lesssim> S \<or> S \<lesssim> R"
+begin
+
+lemma ring_chain: "R \<in> C \<Longrightarrow> ring R"
+  using field.is_ring[OF field_chain] by blast
+
+lemma same_one_same_zero:
+  assumes "R \<in> C" shows "\<one>\<^bsub>union_ring C\<^esub> = \<one>\<^bsub>R\<^esub>" and "\<zero>\<^bsub>union_ring C\<^esub> = \<zero>\<^bsub>R\<^esub>"
+proof -
+  have "\<one>\<^bsub>R\<^esub> = \<one>\<^bsub>S\<^esub>" if "R \<in> C" and "S \<in> C" for R S
+    using ring_hom_one[of id] chain[OF that] unfolding iso_incl.simps by auto
+  moreover have "\<zero>\<^bsub>R\<^esub> = \<zero>\<^bsub>S\<^esub>" if "R \<in> C" and "S \<in> C" for R S
+    using chain[OF that] ring_hom_zero[OF _ ring_chain ring_chain] that unfolding iso_incl.simps by auto
+  ultimately have "one (SOME R. R \<in> C) = \<one>\<^bsub>R\<^esub>" and "zero (SOME R. R \<in> C) = \<zero>\<^bsub>R\<^esub>"
+    using assms by (metis (mono_tags) someI)+
+  thus "\<one>\<^bsub>union_ring C\<^esub> = \<one>\<^bsub>R\<^esub>" and "\<zero>\<^bsub>union_ring C\<^esub> = \<zero>\<^bsub>R\<^esub>"
+    unfolding union_ring_def by auto
+qed
+
+lemma same_laws:
+  assumes "R \<in> C" and "a \<in> carrier R" and "b \<in> carrier R"
+  shows "a \<otimes>\<^bsub>union_ring C\<^esub> b = a \<otimes>\<^bsub>R\<^esub> b" and "a \<oplus>\<^bsub>union_ring C\<^esub> b = a \<oplus>\<^bsub>R\<^esub> b"
+proof -
+  have "a \<otimes>\<^bsub>R\<^esub> b = a \<otimes>\<^bsub>S\<^esub> b"
+    if "R \<in> C" "a \<in> carrier R" "b \<in> carrier R" and "S \<in> C" "a \<in> carrier S" "b \<in> carrier S" for R S
+    using ring_hom_memE(2)[of id R S] ring_hom_memE(2)[of id S R] that chain[OF that(1,4)]
+    unfolding iso_incl.simps by auto
+  moreover have "a \<oplus>\<^bsub>R\<^esub> b = a \<oplus>\<^bsub>S\<^esub> b"
+    if "R \<in> C" "a \<in> carrier R" "b \<in> carrier R" and "S \<in> C" "a \<in> carrier S" "b \<in> carrier S" for R S
+    using ring_hom_memE(3)[of id R S] ring_hom_memE(3)[of id S R] that chain[OF that(1,4)]
+    unfolding iso_incl.simps by auto
+  ultimately
+  have "monoid.mult (SOME R. R \<in> C \<and> a \<in> carrier R \<and> b \<in> carrier R) a b = a \<otimes>\<^bsub>R\<^esub> b"
+   and         "add (SOME R. R \<in> C \<and> a \<in> carrier R \<and> b \<in> carrier R) a b = a \<oplus>\<^bsub>R\<^esub> b"
+    using assms by (metis (mono_tags, lifting) someI)+
+  thus "a \<otimes>\<^bsub>union_ring C\<^esub> b = a \<otimes>\<^bsub>R\<^esub> b" and "a \<oplus>\<^bsub>union_ring C\<^esub> b = a \<oplus>\<^bsub>R\<^esub> b"
+    unfolding union_ring_def by auto
+qed
+
+lemma exists_superset_carrier:
+  assumes "finite S" and "S \<noteq> {}" and "S \<subseteq> carrier (union_ring C)"
+  shows "\<exists>R \<in> C. S \<subseteq> carrier R"
+  using assms
+proof (induction, simp)
+  case (insert s S)
+  obtain R where R: "s \<in> carrier R" "R \<in> C"
+    using insert(5) unfolding union_ring_def by auto
+  show ?case
+  proof (cases)
+    assume "S = {}" thus ?thesis
+      using R by blast
+  next
+    assume "S \<noteq> {}"
+    then obtain T where T: "S \<subseteq> carrier T" "T \<in> C"
+      using insert(3,5) by blast
+    have "carrier R \<subseteq> carrier T \<or> carrier T \<subseteq> carrier R"
+      using ring_hom_memE(1)[of id R] ring_hom_memE(1)[of id T] chain[OF R(2) T(2)]
+      unfolding iso_incl.simps by auto
+    thus ?thesis
+      using R T by auto
+  qed
+qed
+
+lemma union_ring_is_monoid:
+  assumes "C \<noteq> {}" shows "comm_monoid (union_ring C)"
+proof
+  fix a b c
+  assume "a \<in> carrier (union_ring C)" "b \<in> carrier (union_ring C)" "c \<in> carrier (union_ring C)"
+  then obtain R where R: "R \<in> C" "a \<in> carrier R" "b \<in> carrier R" "c \<in> carrier R"
+    using exists_superset_carrier[of "{ a, b, c }"] by auto
+  then interpret field R
+    using field_chain by simp
+
+  show "a \<otimes>\<^bsub>union_ring C\<^esub> b \<in> carrier (union_ring C)"
+    using R(1-3) unfolding same_laws(1)[OF R(1-3)] unfolding union_ring_def by auto 
+  show "(a \<otimes>\<^bsub>union_ring C\<^esub> b) \<otimes>\<^bsub>union_ring C\<^esub> c = a \<otimes>\<^bsub>union_ring C\<^esub> (b \<otimes>\<^bsub>union_ring C\<^esub> c)"
+   and "a \<otimes>\<^bsub>union_ring C\<^esub> b = b \<otimes>\<^bsub>union_ring C\<^esub> a"
+   and "\<one>\<^bsub>union_ring C\<^esub> \<otimes>\<^bsub>union_ring C\<^esub> a = a"
+   and "a \<otimes>\<^bsub>union_ring C\<^esub> \<one>\<^bsub>union_ring C\<^esub> = a"
+    using same_one_same_zero[OF R(1)] same_laws(1)[OF R(1)] R(2-4) m_assoc m_comm by auto
+next
+  show "\<one>\<^bsub>union_ring C\<^esub> \<in> carrier (union_ring C)"
+    using ring.ring_simprules(6)[OF ring_chain] assms same_one_same_zero(1)
+    unfolding union_ring_carrier by auto    
+qed
+
+lemma union_ring_is_abelian_group:
+  assumes "C \<noteq> {}" shows "cring (union_ring C)"
+proof (rule cringI[OF abelian_groupI union_ring_is_monoid[OF assms]])
+  fix a b c
+  assume "a \<in> carrier (union_ring C)" "b \<in> carrier (union_ring C)" "c \<in> carrier (union_ring C)"
+  then obtain R where R: "R \<in> C" "a \<in> carrier R" "b \<in> carrier R" "c \<in> carrier R"
+    using exists_superset_carrier[of "{ a, b, c }"] by auto
+  then interpret field R
+    using field_chain by simp
+
+  show "a \<oplus>\<^bsub>union_ring C\<^esub> b \<in> carrier (union_ring C)"
+    using R(1-3) unfolding same_laws(2)[OF R(1-3)] unfolding union_ring_def by auto
+  show "(a \<oplus>\<^bsub>union_ring C\<^esub> b) \<otimes>\<^bsub>union_ring C\<^esub> c = (a \<otimes>\<^bsub>union_ring C\<^esub> c) \<oplus>\<^bsub>union_ring C\<^esub> (b \<otimes>\<^bsub>union_ring C\<^esub> c)"
+   and "(a \<oplus>\<^bsub>union_ring C\<^esub> b) \<oplus>\<^bsub>union_ring C\<^esub> c = a \<oplus>\<^bsub>union_ring C\<^esub> (b \<oplus>\<^bsub>union_ring C\<^esub> c)"
+   and "a \<oplus>\<^bsub>union_ring C\<^esub> b = b \<oplus>\<^bsub>union_ring C\<^esub> a"
+   and "\<zero>\<^bsub>union_ring C\<^esub> \<oplus>\<^bsub>union_ring C\<^esub> a = a" 
+    using same_one_same_zero[OF R(1)] same_laws[OF R(1)] R(2-4) l_distr a_assoc a_comm by auto
+  have "\<exists>a' \<in> carrier R. a' \<oplus>\<^bsub>union_ring C\<^esub> a = \<zero>\<^bsub>union_ring C\<^esub>"
+    using same_laws(2)[OF R(1)] R(2) same_one_same_zero[OF R(1)] by simp
+  with \<open>R \<in> C\<close> show "\<exists>y \<in> carrier (union_ring C). y \<oplus>\<^bsub>union_ring C\<^esub> a = \<zero>\<^bsub>union_ring C\<^esub>"
+    unfolding union_ring_carrier by auto
+next
+  show "\<zero>\<^bsub>union_ring C\<^esub> \<in> carrier (union_ring C)"
+    using ring.ring_simprules(2)[OF ring_chain] assms same_one_same_zero(2)
+    unfolding union_ring_carrier by auto
+qed
+
+lemma union_ring_is_field :
+  assumes "C \<noteq> {}" shows "field (union_ring C)"
+proof (rule cring.cring_fieldI[OF union_ring_is_abelian_group[OF assms]])
+  have "carrier (union_ring C) - { \<zero>\<^bsub>union_ring C\<^esub> } \<subseteq> Units (union_ring C)"
+  proof
+    fix a assume "a \<in> carrier (union_ring C) - { \<zero>\<^bsub>union_ring C\<^esub> }"
+    hence "a \<in> carrier (union_ring C)" and "a \<noteq> \<zero>\<^bsub>union_ring C\<^esub>"
+      by auto
+    then obtain R where R: "R \<in> C" "a \<in> carrier R"
+      using exists_superset_carrier[of "{ a }"] by auto
+    then interpret field R
+      using field_chain by simp
+
+    from \<open>a \<in> carrier R\<close> and \<open>a \<noteq> \<zero>\<^bsub>union_ring C\<^esub>\<close> have "a \<in> Units R"
+      unfolding same_one_same_zero[OF R(1)] field_Units by auto 
+    hence "\<exists>a' \<in> carrier R. a' \<otimes>\<^bsub>union_ring C\<^esub> a = \<one>\<^bsub>union_ring C\<^esub> \<and> a \<otimes>\<^bsub>union_ring C\<^esub> a' = \<one>\<^bsub>union_ring C\<^esub>"
+      using same_laws[OF R(1)] same_one_same_zero[OF R(1)] R(2) unfolding Units_def by auto
+    with \<open>R \<in> C\<close> and \<open>a \<in> carrier (union_ring C)\<close> show "a \<in> Units (union_ring C)"
+      unfolding Units_def union_ring_carrier by auto
+  qed
+  moreover have "\<zero>\<^bsub>union_ring C\<^esub> \<notin> Units (union_ring C)"
+  proof (rule ccontr)
+    assume "\<not> \<zero>\<^bsub>union_ring C\<^esub> \<notin> Units (union_ring C)"
+    then obtain a where a: "a \<in> carrier (union_ring C)" "a \<otimes>\<^bsub>union_ring C\<^esub> \<zero>\<^bsub>union_ring C\<^esub> = \<one>\<^bsub>union_ring C\<^esub>"
+      unfolding Units_def by auto
+    then obtain R where R: "R \<in> C" "a \<in> carrier R"
+      using exists_superset_carrier[of "{ a }"] by auto
+    then interpret field R
+      using field_chain by simp
+    have "\<one>\<^bsub>R\<^esub> = \<zero>\<^bsub>R\<^esub>"
+      using a R same_laws(1)[OF R(1)] same_one_same_zero[OF R(1)] by auto
+    thus False
+      using one_not_zero by simp
+  qed
+  hence "Units (union_ring C) \<subseteq> carrier (union_ring C) - { \<zero>\<^bsub>union_ring C\<^esub> }"
+    unfolding Units_def by auto
+  ultimately show "Units (union_ring C) = carrier (union_ring C) - { \<zero>\<^bsub>union_ring C\<^esub> }"
+    by simp
+qed
+
+lemma union_ring_is_upper_bound:
+  assumes "R \<in> C" shows "R \<lesssim> union_ring C"
+  using ring_hom_memI[of R id "union_ring C"] same_laws[of R] same_one_same_zero[of R] assms
+  unfolding union_ring_carrier by auto
+
+end
+
+
+subsection \<open>Zorn\<close>
+
+lemma (in ring) exists_core_chain:
+  assumes "C \<in> Chains (rel_of (\<lesssim>) \<S>)" obtains C' where "C' \<subseteq> extensions" and "C = law_restrict ` C'"
+  using Chains_rel_of[OF assms] by (meson subset_image_iff)
+
+lemma (in ring) core_chain_is_chain:
+  assumes "law_restrict ` C \<in> Chains (rel_of (\<lesssim>) \<S>)" shows "\<And>R S. \<lbrakk> R \<in> C; S \<in> C \<rbrakk> \<Longrightarrow> R \<lesssim> S \<or> S \<lesssim> R"
+proof -
+  fix R S assume "R \<in> C" and "S \<in> C" thus "R \<lesssim> S \<or> S \<lesssim> R"
+    using assms(1) unfolding iso_incl_hom[of R] iso_incl_hom[of S] Chains_def by auto
+qed
+
+lemma (in field) exists_maximal_extension:
+  shows "\<exists>M \<in> \<S>. \<forall>L \<in> \<S>. M \<lesssim> L \<longrightarrow> L = M"
+proof (rule predicate_Zorn[OF iso_incl_partial_order])
+  show "\<forall>C \<in> Chains (rel_of (\<lesssim>) \<S>). \<exists>L \<in> \<S>. \<forall>R \<in> C. R \<lesssim> L"
+  proof
+    fix C assume C: "C \<in> Chains (rel_of (\<lesssim>) \<S>)"
+    show "\<exists>L \<in> \<S>. \<forall>R \<in> C. R \<lesssim> L"
+    proof (cases)
+      assume "C = {}" thus ?thesis
+        using extensions_non_empty by auto
+    next
+      assume "C \<noteq> {}"
+      from \<open>C \<in> Chains (rel_of (\<lesssim>) \<S>)\<close>
+      obtain C' where C': "C' \<subseteq> extensions" "C = law_restrict ` C'"
+        using exists_core_chain by auto
+      with \<open>C \<noteq> {}\<close> obtain S where S: "S \<in> C'" and "C' \<noteq> {}"
+        by auto
+
+      have core_chain: "\<And>R. R \<in> C' \<Longrightarrow> field R" "\<And>R S. \<lbrakk> R \<in> C'; S \<in> C' \<rbrakk> \<Longrightarrow> R \<lesssim> S \<or> S \<lesssim> R"
+        using core_chain_is_chain[of C'] C' C unfolding extensions_def by auto
+      from \<open>C' \<noteq> {}\<close> interpret Union: field "union_ring C'"
+          using union_ring_is_field[OF core_chain] C'(1) by blast
+
+      have "union_ring C' \<in> extensions"
+      proof (auto simp add: extensions_def)
+        show "field (union_ring C')"
+          using Union.field_axioms .
+      next
+        from \<open>S \<in> C'\<close> have "indexed_const \<in> ring_hom R S"
+          using C'(1) unfolding extensions_def by auto
+        thus "indexed_const \<in> ring_hom R (union_ring C')"
+          using ring_hom_trans[of _ R S id] union_ring_is_upper_bound[OF core_chain S]
+          unfolding iso_incl.simps by auto
+      next
+        show "a \<in> carrier (union_ring C') \<Longrightarrow> carrier_coeff a" for a
+          using C'(1) unfolding union_ring_carrier extensions_def by auto
+      next
+        fix \<P> P
+        assume "\<P> \<in> carrier (union_ring C')" and P: "P \<in> carrier (poly_ring R)" "\<not> index_free \<P> P"
+        from \<open>\<P> \<in> carrier (union_ring C')\<close> obtain T where T: "T \<in> C'" "\<P> \<in> carrier T"
+          using exists_superset_carrier[of C' "{ \<P> }"] core_chain by auto
+        hence "\<X>\<^bsub>P\<^esub> \<in> carrier T" and "(ring.eval T) (\<sigma> P) \<X>\<^bsub>P\<^esub> = \<zero>\<^bsub>T\<^esub>"
+          and field: "field T" and hom: "indexed_const \<in> ring_hom R T"
+          using P C'(1) unfolding extensions_def by auto
+        with \<open>T \<in> C'\<close> show "\<X>\<^bsub>P\<^esub> \<in> carrier (union_ring C')"
+          unfolding union_ring_carrier by auto
+        have "set P \<subseteq> carrier R"
+          using P(1) unfolding sym[OF univ_poly_carrier] polynomial_def by auto
+        hence "set (\<sigma> P) \<subseteq> carrier T"
+          using ring_hom_memE(1)[OF hom] unfolding \<sigma>_def by (induct P) (auto)
+        with \<open>\<X>\<^bsub>P\<^esub> \<in> carrier T\<close> and \<open>(ring.eval T) (\<sigma> P) \<X>\<^bsub>P\<^esub> = \<zero>\<^bsub>T\<^esub>\<close>
+        show "(ring.eval (union_ring C')) (\<sigma> P) \<X>\<^bsub>P\<^esub> = \<zero>\<^bsub>union_ring C'\<^esub>"
+          using iso_incl_imp_same_eval[OF field.is_ring[OF field] Union.is_ring
+                union_ring_is_upper_bound[OF core_chain T(1)]] same_one_same_zero(2)[OF core_chain T(1)]
+          by auto
+      qed
+      moreover have "R \<lesssim> law_restrict (union_ring C')" if "R \<in> C" for R
+        using that union_ring_is_upper_bound[OF core_chain] iso_incl_hom unfolding C' by auto
+      ultimately show ?thesis
+        by blast
+    qed
+  qed
+qed
+
+
+subsection \<open>Existence of roots\<close>
+
+lemma polynomial_hom:
+  assumes "h \<in> ring_hom R S" and "field R" and "field S"
+  shows "p \<in> carrier (poly_ring R) \<Longrightarrow> (map h p) \<in> carrier (poly_ring S)"
+proof -
+  assume "p \<in> carrier (poly_ring R)"
+  interpret ring_hom_ring R S h
+    using ring_hom_ringI2[OF assms(2-3)[THEN field.is_ring] assms(1)] .
+
+  from \<open>p \<in> carrier (poly_ring R)\<close> have "set p \<subseteq> carrier R" and lc: "p \<noteq> [] \<Longrightarrow> lead_coeff p \<noteq> \<zero>\<^bsub>R\<^esub>"
+    unfolding sym[OF univ_poly_carrier] polynomial_def by auto
+  hence "set (map h p) \<subseteq> carrier S"
+    by (induct p) (auto)
+  moreover have "h a = \<zero>\<^bsub>S\<^esub> \<Longrightarrow> a = \<zero>\<^bsub>R\<^esub>" if "a \<in> carrier R" for a
+    using non_trivial_field_hom_is_inj[OF assms(1-3)] that unfolding inj_on_def by simp 
+  with \<open>set p \<subseteq> carrier R\<close> have "lead_coeff (map h p) \<noteq> \<zero>\<^bsub>S\<^esub>" if "p \<noteq> []"
+    using lc[OF that] that by (cases p) (auto)
+  ultimately show ?thesis
+    unfolding sym[OF univ_poly_carrier] polynomial_def by auto 
+qed
+
+lemma (in ring_hom_ring) subfield_polynomial_hom:
+  assumes "subfield K R" and "\<one>\<^bsub>S\<^esub> \<noteq> \<zero>\<^bsub>S\<^esub>"
+  shows "p \<in> carrier (K[X]\<^bsub>R\<^esub>) \<Longrightarrow> (map h p) \<in> carrier ((h ` K)[X]\<^bsub>S\<^esub>)"
+proof -
+  assume "p \<in> carrier (K[X]\<^bsub>R\<^esub>)"
+  hence "p \<in> carrier (poly_ring (R \<lparr> carrier := K \<rparr>))"
+    using R.univ_poly_consistent[OF subfieldE(1)[OF assms(1)]] by simp
+  moreover have "h \<in> ring_hom (R \<lparr> carrier := K \<rparr>) (S \<lparr> carrier := h ` K \<rparr>)"
+    using hom_mult subfieldE(3)[OF assms(1)] unfolding ring_hom_def subset_iff by auto
+  moreover have "field (R \<lparr> carrier := K \<rparr>)" and "field (S \<lparr> carrier := (h ` K) \<rparr>)"
+    using R.subfield_iff(2)[OF assms(1)] S.subfield_iff(2)[OF img_is_subfield(2)[OF assms]] by simp+
+  ultimately have "(map h p) \<in> carrier (poly_ring (S \<lparr> carrier := h ` K \<rparr>))"
+    using polynomial_hom[of h "R \<lparr> carrier := K \<rparr>" "S \<lparr> carrier := h ` K \<rparr>"] by auto
+  thus ?thesis
+    using S.univ_poly_consistent[OF subfieldE(1)[OF img_is_subfield(2)[OF assms]]] by simp
+qed
+
+lemma (in field) exists_root:
+  assumes "M \<in> extensions" and "\<And>L. \<lbrakk> L \<in> extensions; M \<lesssim> L \<rbrakk> \<Longrightarrow> law_restrict L = law_restrict M"
+    and "P \<in> carrier (poly_ring R)" and "degree P > 0"
+  shows "\<exists>x \<in> carrier M. (ring.eval M) (\<sigma> P) x = \<zero>\<^bsub>M\<^esub>"
+proof (rule ccontr)
+  from \<open>M \<in> extensions\<close> interpret M: field M + Hom: ring_hom_ring R M "indexed_const"
+    using ring_hom_ringI2[OF ring_axioms field.is_ring] unfolding extensions_def by auto
+  interpret UP: principal_domain "poly_ring M"
+    using M.univ_poly_is_principal[OF M.carrier_is_subfield] .
+
+  assume no_roots: "\<not> (\<exists>x \<in> carrier M. M.eval (\<sigma> P) x = \<zero>\<^bsub>M\<^esub>)"
+  have "(\<sigma> P) \<in> carrier (poly_ring M)"
+    using polynomial_hom[OF Hom.homh field_axioms M.field_axioms assms(3)] unfolding \<sigma>_def by simp
+  moreover have "(\<sigma> P) \<notin> Units (poly_ring M)" and "(\<sigma> P) \<noteq> \<zero>\<^bsub>poly_ring M\<^esub>"
+    using assms(4) unfolding M.univ_poly_carrier_units \<sigma>_def univ_poly_zero by auto
+  ultimately obtain Q
+    where Q: "Q \<in> carrier (poly_ring M)" "pirreducible\<^bsub>M\<^esub> (carrier M) Q" "Q pdivides\<^bsub>M\<^esub> (\<sigma> P)"
+    using UP.exists_irreducible_divisor[of "\<sigma> P"] unfolding pdivides_def by blast
+
+  have hyps:
+    \<comment> \<open>i\<close>   "field M"
+    \<comment> \<open>ii\<close>  "\<And>\<P>. \<P> \<in> carrier M \<Longrightarrow> carrier_coeff \<P>"
+    \<comment> \<open>iii\<close> "\<And>\<P>. \<P> \<in> carrier M \<Longrightarrow> index_free \<P> P"
+    \<comment> \<open>iv\<close>  "\<zero>\<^bsub>M\<^esub> = indexed_const \<zero>"
+    using assms(1,3) no_roots unfolding extensions_def by auto
+  have degree_gt: "degree Q > 1"
+  proof (rule ccontr)
+    assume "\<not> degree Q > 1" hence "degree Q = 1"
+      using M.pirreducible_degree[OF M.carrier_is_subfield Q(1-2)] by simp
+    then obtain x where "x \<in> carrier M" and "M.eval Q x = \<zero>\<^bsub>M\<^esub>"
+      using M.degree_one_root[OF M.carrier_is_subfield Q(1)] M.add.inv_closed by blast  
+    hence "M.eval (\<sigma> P) x = \<zero>\<^bsub>M\<^esub>"
+      using M.pdivides_imp_root_sharing[OF Q(1,3)] by simp
+    with \<open>x \<in> carrier M\<close> show False
+      using no_roots by simp
+  qed
+
+  define image_poly where "image_poly = image_ring (eval_pmod M P Q) (poly_ring M)"
+  with \<open>degree Q > 1\<close> have "M \<lesssim> image_poly"
+    using image_poly_iso_incl[OF hyps Q(1)] by auto
+  moreover have is_field: "field image_poly"
+    using image_poly_is_field[OF hyps Q(1-2)] unfolding image_poly_def by simp
+  moreover have "image_poly \<in> extensions"
+  proof (auto simp add: extensions_def is_field)
+    fix \<P> assume "\<P> \<in> carrier image_poly"
+    then obtain R where \<P>: "\<P> = eval_pmod M P Q R" and "R \<in> carrier (poly_ring M)"
+      unfolding image_poly_def image_ring_carrier by auto
+    hence "M.pmod R Q \<in> carrier (poly_ring M)"
+      using M.long_division_closed(2)[OF M.carrier_is_subfield _ Q(1)] by simp
+    hence "list_all carrier_coeff (M.pmod R Q)"
+      using hyps(2) unfolding sym[OF univ_poly_carrier] list_all_iff polynomial_def by auto
+    thus "carrier_coeff \<P>"
+      using indexed_eval_in_carrier[of "M.pmod R Q"] unfolding \<P> by simp
+  next
+    from \<open>M \<lesssim> image_poly\<close> show "indexed_const \<in> ring_hom R image_poly"
+      using ring_hom_trans[OF Hom.homh, of id] unfolding iso_incl.simps by simp
+  next
+    from \<open>M \<lesssim> image_poly\<close> interpret Id: ring_hom_ring M image_poly id
+      using iso_inclE[OF M.ring_axioms field.is_ring[OF is_field]] by simp
+
+    fix \<P> S
+    assume A: "\<P> \<in> carrier image_poly" "\<not> index_free \<P> S" "S \<in> carrier (poly_ring R)"
+    have "\<X>\<^bsub>S\<^esub> \<in> carrier image_poly \<and> Id.eval (\<sigma> S) \<X>\<^bsub>S\<^esub> = \<zero>\<^bsub>image_poly\<^esub>"
+    proof (cases)
+      assume "P \<noteq> S"
+      then obtain Q' where "Q' \<in> carrier M" and "\<not> index_free Q' S"
+        using A(1) image_poly_index_free[OF hyps Q(1) _ A(2)] unfolding image_poly_def by auto
+      hence "\<X>\<^bsub>S\<^esub> \<in> carrier M" and "M.eval (\<sigma> S) \<X>\<^bsub>S\<^esub> = \<zero>\<^bsub>M\<^esub>"
+        using assms(1) A(3) unfolding extensions_def by auto
+      moreover have "\<sigma> S \<in> carrier (poly_ring M)"
+        using polynomial_hom[OF Hom.homh field_axioms M.field_axioms A(3)] unfolding \<sigma>_def .
+      ultimately show ?thesis
+        using Id.eval_hom[OF M.carrier_is_subring] Id.hom_closed Id.hom_zero by auto
+    next
+      assume "\<not> P \<noteq> S" hence S: "P = S"
+        by simp
+      have poly_hom: "R \<in> carrier (poly_ring image_poly)" if "R \<in> carrier (poly_ring M)" for R
+        using polynomial_hom[OF Id.homh M.field_axioms is_field that] by simp
+      have "\<X>\<^bsub>S\<^esub> \<in> carrier image_poly"
+        using eval_pmod_var(2)[OF hyps Hom.homh Q(1) degree_gt] unfolding image_poly_def S by simp
+      moreover have "Id.eval Q \<X>\<^bsub>S\<^esub> = \<zero>\<^bsub>image_poly\<^esub>"
+        using image_poly_eval_indexed_var[OF hyps Hom.homh Q(1) degree_gt Q(2)] unfolding image_poly_def S by simp
+      moreover have "Q pdivides\<^bsub>image_poly\<^esub> (\<sigma> S)"
+      proof -
+        obtain R where R: "R \<in> carrier (poly_ring M)" "\<sigma> S = Q \<otimes>\<^bsub>poly_ring M\<^esub> R"
+          using Q(3) unfolding S pdivides_def by auto
+        moreover have "set Q \<subseteq> carrier M" and "set R \<subseteq> carrier M"
+          using Q(1) R(1) unfolding sym[OF univ_poly_carrier] polynomial_def by auto
+        ultimately have "Id.normalize (\<sigma> S) = Q \<otimes>\<^bsub>poly_ring image_poly\<^esub> R"
+          using Id.poly_mult_hom'[of Q R] unfolding univ_poly_mult by simp
+        moreover have "\<sigma> S \<in> carrier (poly_ring M)"
+          using polynomial_hom[OF Hom.homh field_axioms M.field_axioms A(3)] unfolding \<sigma>_def .
+        hence "\<sigma> S \<in> carrier (poly_ring image_poly)"
+          using polynomial_hom[OF Id.homh M.field_axioms is_field] by simp
+        hence "Id.normalize (\<sigma> S) = \<sigma> S"
+          using Id.normalize_polynomial unfolding sym[OF univ_poly_carrier] by simp
+        ultimately show ?thesis
+          using poly_hom[OF Q(1)] poly_hom[OF R(1)]
+          unfolding pdivides_def factor_def univ_poly_mult by auto
+      qed
+      moreover have "Q \<in> carrier (poly_ring (image_poly))"
+        using poly_hom[OF Q(1)] by simp
+      ultimately show ?thesis
+        using domain.pdivides_imp_root_sharing[OF field.axioms(1)[OF is_field], of Q] by auto
+    qed
+    thus "\<X>\<^bsub>S\<^esub> \<in> carrier image_poly" and "Id.eval (\<sigma> S) \<X>\<^bsub>S\<^esub> = \<zero>\<^bsub>image_poly\<^esub>"
+      by auto
+  qed
+  ultimately have "law_restrict M = law_restrict image_poly"
+    using assms(2) by simp
+  hence "carrier M = carrier image_poly"
+    unfolding law_restrict_def by (simp add:ring.defs)
+  moreover have "\<X>\<^bsub>P\<^esub> \<in> carrier image_poly"
+    using eval_pmod_var(2)[OF hyps Hom.homh Q(1) degree_gt] unfolding image_poly_def by simp
+  moreover have "\<X>\<^bsub>P\<^esub> \<notin> carrier M"
+    using indexed_var_not_index_free[of P] hyps(3) by blast
+  ultimately show False by simp
+qed
+
+lemma (in field) exists_extension_with_roots:
+  shows "\<exists>L \<in> extensions. \<forall>P \<in> carrier (poly_ring R).
+    degree P > 0 \<longrightarrow> (\<exists>x \<in> carrier L. (ring.eval L) (\<sigma> P) x = \<zero>\<^bsub>L\<^esub>)"
+proof -
+  obtain M where "M \<in> extensions" and "\<forall>L \<in> extensions. M \<lesssim> L \<longrightarrow> law_restrict L = law_restrict M"
+    using exists_maximal_extension iso_incl_hom by blast
+  thus ?thesis
+    using exists_root[of M] by auto
+qed
+
+
+subsection \<open>Existence of Algebraic Closure\<close>
+
+locale algebraic_closure = field L + subfield K L for L (structure) and K +
+  assumes algebraic_extension: "x \<in> carrier L \<Longrightarrow> (algebraic over K) x"
+    and roots_over_subfield: "\<lbrakk> P \<in> carrier (K[X]); degree P > 0 \<rbrakk> \<Longrightarrow> \<exists>x \<in> carrier L. eval P x = \<zero>\<^bsub>L\<^esub>"
+
+locale algebraically_closed = field L for L (structure) +
+  assumes roots_over_carrier: "\<lbrakk> P \<in> carrier (poly_ring L); degree P > 0 \<rbrakk> \<Longrightarrow> \<exists>x \<in> carrier L. eval P x = \<zero>\<^bsub>L\<^esub>"
+
+definition (in field) closure :: "(('a list) multiset \<Rightarrow> 'a) ring" ("\<Omega>")
+  where "closure = (SOME L \<comment> \<open>such that\<close>.
+           \<comment> \<open>i\<close>  algebraic_closure L (indexed_const ` (carrier R)) \<and> 
+           \<comment> \<open>ii\<close> indexed_const \<in> ring_hom R L)"
+
+
+lemma algebraic_hom:
+  assumes "h \<in> ring_hom R S" and "field R" and "field S" and "subfield K R" and "x \<in> carrier R"
+  shows "((ring.algebraic R) over K) x \<Longrightarrow> ((ring.algebraic S) over (h ` K)) (h x)"
+proof -
+  interpret Hom: ring_hom_ring R S h
+    using ring_hom_ringI2[OF assms(2-3)[THEN field.is_ring] assms(1)] .
+  assume "(Hom.R.algebraic over K) x"
+  then obtain p where p: "p \<in> carrier (K[X]\<^bsub>R\<^esub>)" and "p \<noteq> []" and eval: "Hom.R.eval p x = \<zero>\<^bsub>R\<^esub>"
+    using domain.algebraicE[OF field.axioms(1) subfieldE(1), of R K x] assms(2,4-5) by auto
+  hence "(map h p) \<in> carrier ((h ` K)[X]\<^bsub>S\<^esub>)" and "(map h p) \<noteq> []"
+    using Hom.subfield_polynomial_hom[OF assms(4) one_not_zero[OF assms(3)]] by auto
+  moreover have "Hom.S.eval (map h p) (h x) = \<zero>\<^bsub>S\<^esub>"
+    using Hom.eval_hom[OF subfieldE(1)[OF assms(4)] assms(5) p] unfolding eval by simp
+  ultimately show ?thesis
+    using Hom.S.non_trivial_ker_imp_algebraic[of "h ` K" "h x"] unfolding a_kernel_def' by auto
+qed
+
+lemma (in field) exists_closure:
+  obtains L :: "(('a list multiset) \<Rightarrow> 'a) ring"
+  where "algebraic_closure L (indexed_const ` (carrier R))" and "indexed_const \<in> ring_hom R L"
+proof -
+  obtain L where "L \<in> extensions"
+    and roots: "\<And>P. \<lbrakk> P \<in> carrier (poly_ring R); degree P > 0 \<rbrakk> \<Longrightarrow>
+                      \<exists>x \<in> carrier L. (ring.eval L) (\<sigma> P) x = \<zero>\<^bsub>L\<^esub>"
+    using exists_extension_with_roots by auto
+
+  let ?K = "indexed_const ` (carrier R)"
+  let ?set_of_algs = "{ x \<in> carrier L. ((ring.algebraic L) over ?K) x }"
+  let ?M = "L \<lparr> carrier := ?set_of_algs \<rparr>"
+
+  from \<open>L \<in> extensions\<close>
+  have L: "field L" and  hom: "ring_hom_ring R L indexed_const"
+    using ring_hom_ringI2[OF ring_axioms field.is_ring] unfolding extensions_def by auto
+  have "subfield ?K L"
+    using ring_hom_ring.img_is_subfield(2)[OF hom carrier_is_subfield
+          domain.one_not_zero[OF field.axioms(1)[OF L]]] by auto
+  hence set_of_algs: "subfield ?set_of_algs L"
+    using field.subfield_of_algebraics[OF L, of ?K] by simp
+  have M: "field ?M"
+    using ring.subfield_iff(2)[OF field.is_ring[OF L] set_of_algs] by simp
+
+  interpret Id: ring_hom_ring ?M L id
+    using ring_hom_ringI[OF field.is_ring[OF M] field.is_ring[OF L]] by auto
+
+  have is_subfield: "subfield ?K ?M"
+  proof (intro ring.subfield_iff(1)[OF field.is_ring[OF M]])
+    have "L \<lparr> carrier := ?K \<rparr> = ?M \<lparr> carrier := ?K \<rparr>"
+      by simp
+    moreover from \<open>subfield ?K L\<close> have "field (L \<lparr> carrier := ?K \<rparr>)"
+      using ring.subfield_iff(2)[OF field.is_ring[OF L]] by simp
+    ultimately show "field (?M \<lparr> carrier := ?K \<rparr>)"
+      by simp
+  next
+    show "?K \<subseteq> carrier ?M"
+    proof
+      fix x :: "('a list multiset) \<Rightarrow> 'a"
+      assume "x \<in> ?K"
+      hence "x \<in> carrier L"
+        using ring_hom_memE(1)[OF ring_hom_ring.homh[OF hom]] by auto
+      moreover from \<open>subfield ?K L\<close> and \<open>x \<in> ?K\<close> have "(Id.S.algebraic over ?K) x"
+        using domain.algebraic_self[OF field.axioms(1)[OF L] subfieldE(1)] by auto
+      ultimately show "x \<in> carrier ?M"
+        by auto
+    qed
+  qed
+
+  have "algebraic_closure ?M ?K"
+  proof (intro algebraic_closure.intro[OF M is_subfield])
+    have "(Id.R.algebraic over ?K) x" if "x \<in> carrier ?M" for x
+      using that Id.S.algebraic_consistent[OF subfieldE(1)[OF set_of_algs]] by simp
+    moreover have "\<exists>x \<in> carrier ?M. Id.R.eval P x = \<zero>\<^bsub>?M\<^esub>"
+      if "P \<in> carrier (?K[X]\<^bsub>?M\<^esub>)" and "degree P > 0" for P
+    proof -
+      from \<open>P \<in> carrier (?K[X]\<^bsub>?M\<^esub>)\<close> have "P \<in> carrier (?K[X]\<^bsub>L\<^esub>)"
+        unfolding Id.S.univ_poly_consistent[OF subfieldE(1)[OF set_of_algs]] .
+      hence "set P \<subseteq> ?K"
+        unfolding sym[OF univ_poly_carrier] polynomial_def by auto
+      hence "\<exists>Q. set Q \<subseteq> carrier R \<and> P = \<sigma> Q"
+      proof (induct P, simp add: \<sigma>_def)
+        case (Cons p P)
+        then obtain q Q where "q \<in> carrier R" "set Q \<subseteq> carrier R" and "\<sigma> Q = P""indexed_const q = p"
+          unfolding \<sigma>_def by auto
+        hence "set (q # Q) \<subseteq> carrier R" and "\<sigma> (q # Q) = (p # P)"
+          unfolding \<sigma>_def by auto
+        thus ?case
+          by metis
+      qed
+      then obtain Q where "set Q \<subseteq> carrier R" and "\<sigma> Q = P"
+        by auto
+      moreover have "lead_coeff Q \<noteq> \<zero>"
+      proof (rule ccontr)
+        assume "\<not> lead_coeff Q \<noteq> \<zero>" then have "lead_coeff Q = \<zero>"
+          by simp
+        with \<open>\<sigma> Q = P\<close> and \<open>degree P > 0\<close> have "lead_coeff P = indexed_const \<zero>"
+          unfolding \<sigma>_def by (metis diff_0_eq_0 length_map less_irrefl_nat list.map_sel(1) list.size(3))
+        hence "lead_coeff P = \<zero>\<^bsub>L\<^esub>"
+          using ring_hom_zero[OF ring_hom_ring.homh ring_hom_ring.axioms(1-2)] hom by auto
+        with \<open>degree P > 0\<close> have "\<not> P \<in> carrier (?K[X]\<^bsub>?M\<^esub>)"
+          unfolding sym[OF univ_poly_carrier] polynomial_def by auto
+        with \<open>P \<in> carrier (?K[X]\<^bsub>?M\<^esub>)\<close> show False
+          by simp
+      qed
+      ultimately have "Q \<in> carrier (poly_ring R)"
+        unfolding sym[OF univ_poly_carrier] polynomial_def by auto
+      moreover from \<open>degree P > 0\<close> and \<open>\<sigma> Q = P\<close> have "degree Q > 0"
+        unfolding \<sigma>_def by auto
+      ultimately obtain x where "x \<in> carrier L" and "Id.S.eval P x = \<zero>\<^bsub>L\<^esub>"
+        using roots[of Q] unfolding \<open>\<sigma> Q = P\<close> by auto
+      hence "Id.R.eval P x = \<zero>\<^bsub>?M\<^esub>"
+        unfolding Id.S.eval_consistent[OF subfieldE(1)[OF set_of_algs]] by simp
+      moreover from \<open>degree P > 0\<close> have "P \<noteq> []"
+        by auto
+      with \<open>P \<in> carrier (?K[X]\<^bsub>L\<^esub>)\<close> and \<open>Id.S.eval P x = \<zero>\<^bsub>L\<^esub>\<close> have "(Id.S.algebraic over ?K) x"
+        using Id.S.non_trivial_ker_imp_algebraic[of ?K x] unfolding a_kernel_def' by auto
+      with \<open>x \<in> carrier L\<close> have "x \<in> carrier ?M"
+        by auto
+      ultimately show ?thesis
+        by auto
+    qed
+    ultimately show "algebraic_closure_axioms ?M ?K"
+      unfolding algebraic_closure_axioms_def by auto
+  qed
+  moreover have "indexed_const \<in> ring_hom R ?M"
+    using ring_hom_ring.homh[OF hom] subfieldE(3)[OF is_subfield]
+    unfolding subset_iff ring_hom_def by auto
+  ultimately show thesis
+    using that by auto
+qed
+
+lemma (in field) closureE:
+  shows "algebraic_closure \<Omega> (indexed_const ` (carrier R))" and "indexed_const \<in> ring_hom R \<Omega>"
+  using exists_closure unfolding closure_def
+  by (metis (mono_tags, lifting) someI2)+
+
+end
+  
diff -r 57503fe1b0ff -r 615233977155 src/HOL/Algebra/Embedded_Algebras.thy
--- a/src/HOL/Algebra/Embedded_Algebras.thy	Sat Apr 13 22:06:40 2019 +0200
+++ b/src/HOL/Algebra/Embedded_Algebras.thy	Sun Apr 14 12:00:17 2019 +0100
@@ -49,6 +49,16 @@
 
 subsection \<open>Basic Properties - First Part\<close>
 
+lemma line_extension_consistent:
+  assumes "subring K R" shows "ring.line_extension (R \<lparr> carrier := K \<rparr>) = line_extension"
+  unfolding ring.line_extension_def[OF subring_is_ring[OF assms]] line_extension_def
+  by (simp add: set_add_def set_mult_def)
+
+lemma Span_consistent:
+  assumes "subring K R" shows "ring.Span (R \<lparr> carrier := K \<rparr>) = Span"
+  unfolding ring.Span.simps[OF subring_is_ring[OF assms]] Span.simps
+            line_extension_consistent[OF assms] by simp
+
 lemma combine_in_carrier [simp, intro]:
   "\<lbrakk> set Ks \<subseteq> carrier R; set Us \<subseteq> carrier R \<rbrakk> \<Longrightarrow> combine Ks Us \<in> carrier R"
   by (induct Ks Us rule: combine.induct) (auto)
@@ -71,6 +81,31 @@
   "set Us \<subseteq> carrier R \<Longrightarrow> combine (replicate (length Us) \<zero>) Us = \<zero>"
   by (induct Us) (auto)
 
+lemma combine_take:
+  "combine (take (length Us) Ks) Us = combine Ks Us"
+  by (induct Us arbitrary: Ks)
+     (auto, metis combine.simps(1) list.exhaust take.simps(1) take_Suc_Cons)
+
+lemma combine_append_zero:
+  "set Us \<subseteq> carrier R \<Longrightarrow> combine (Ks @ [ \<zero> ]) Us = combine Ks Us"
+proof (induct Ks arbitrary: Us)
+  case Nil thus ?case by (induct Us) (auto)
+next
+  case Cons thus ?case by (cases Us) (auto)
+qed
+
+lemma combine_prepend_replicate:
+  "\<lbrakk> set Ks \<subseteq> carrier R; set Us \<subseteq> carrier R \<rbrakk> \<Longrightarrow>
+     combine ((replicate n \<zero>) @ Ks) Us = combine Ks (drop n Us)"
+proof (induct n arbitrary: Us, simp)
+  case (Suc n) thus ?case
+    by (cases Us) (auto, meson combine_in_carrier ring_simprules(8) set_drop_subset subset_trans)
+qed
+
+lemma combine_append_replicate:
+  "set Us \<subseteq> carrier R \<Longrightarrow> combine (Ks @ (replicate n \<zero>)) Us = combine Ks Us"
+  by (induct n) (auto, metis append.assoc combine_append_zero replicate_append_same)
+
 lemma combine_append:
   assumes "length Ks = length Us"
     and "set Ks  \<subseteq> carrier R" "set Us \<subseteq> carrier R"
@@ -119,6 +154,36 @@
   finally show ?case .
 qed
 
+lemma combine_normalize:
+  assumes "set Ks \<subseteq> carrier R" "set Us \<subseteq> carrier R" "combine Ks Us = a" 
+  obtains Ks'
+  where "set (take (length Us) Ks) \<subseteq> set Ks'" "set Ks' \<subseteq> set (take (length Us) Ks) \<union> { \<zero> }"
+    and "length Ks' = length Us" "combine Ks' Us = a"
+proof -
+  define Ks'
+    where "Ks' = (if length Ks \<le> length Us
+                  then Ks @ (replicate (length Us - length Ks) \<zero>) else take (length Us) Ks)"
+  hence "set (take (length Us) Ks) \<subseteq> set Ks'" "set Ks' \<subseteq> set (take (length Us) Ks) \<union> { \<zero> }"
+        "length Ks' = length Us" "a = combine Ks' Us"
+    using combine_append_replicate[OF assms(2)] combine_take assms(3) by auto
+  thus thesis
+    using that by blast
+qed
+
+lemma line_extension_mem_iff: "u \<in> line_extension K a E \<longleftrightarrow> (\<exists>k \<in> K. \<exists>v \<in> E. u = k \<otimes> a \<oplus> v)"
+  unfolding line_extension_def set_add_def'[of R "K #> a" E] unfolding r_coset_def by blast
+
+lemma line_extension_in_carrier:
+  assumes "K \<subseteq> carrier R" "a \<in> carrier R" "E \<subseteq> carrier R"
+  shows "line_extension K a E \<subseteq> carrier R"
+  using set_add_closed[OF r_coset_subset_G[OF assms(1-2)] assms(3)]
+  by (simp add: line_extension_def)
+
+lemma Span_in_carrier:
+  assumes "K \<subseteq> carrier R" "set Us \<subseteq> carrier R"
+  shows "Span K Us \<subseteq> carrier R"
+  using assms by (induct Us) (auto simp add: line_extension_in_carrier)
+
 
 subsection \<open>Some Basic Properties of Linear Independence\<close>
 
@@ -131,10 +196,18 @@
   "independent K (u # Us) \<Longrightarrow> u \<in> carrier R"
   by (cases rule: independent.cases, auto)+
 
+lemma dimension_independent [intro]: "independent K Us \<Longrightarrow> dimension (length Us) K (Span K Us)"
+proof (induct Us)
+  case Nil thus ?case by simp
+next
+  case Cons thus ?case
+    using Suc_dim independent_backwards[OF Cons(2)] by auto 
+qed
+
 
 text \<open>Now, we fix K, a subfield of the ring. Many lemmas would also be true for weaker
       structures, but our interest is to work with subfields, so generalization could
-      be the subjuct of a future work.\<close>
+      be the subject of a future work.\<close>
 
 context
   fixes K :: "'a set" assumes K: "subfield K R"
@@ -146,9 +219,6 @@
 lemmas subring_props [simp] =
   subringE[OF subfieldE(1)[OF K]]
 
-lemma line_extension_mem_iff: "u \<in> line_extension K a E \<longleftrightarrow> (\<exists>k \<in> K. \<exists>v \<in> E. u = k \<otimes> a \<oplus> v)"
-  unfolding line_extension_def set_add_def'[of R "K #> a" E] unfolding r_coset_def by blast
-
 lemma line_extension_is_subgroup:
   assumes "subgroup E (add_monoid R)" "a \<in> carrier R"
   shows "subgroup (line_extension K a E) (add_monoid R)"
@@ -325,6 +395,28 @@
 
 subsubsection \<open>Corollaries\<close>
 
+corollary Span_mem_iff_length_version:
+  assumes "set Us \<subseteq> carrier R"
+  shows "a \<in> Span K Us \<longleftrightarrow> (\<exists>Ks. set Ks \<subseteq> K \<and> length Ks = length Us \<and> a = combine Ks Us)"
+  using Span_eq_combine_set_length_version[OF assms] by blast
+
+corollary Span_mem_imp_non_trivial_combine:
+  assumes "set Us \<subseteq> carrier R" and "a \<in> Span K Us"
+  obtains k Ks
+  where "k \<in> K - { \<zero> }" "set Ks \<subseteq> K" "length Ks = length Us" "combine (k # Ks) (a # Us) = \<zero>"
+proof -
+  obtain Ks where Ks: "set Ks \<subseteq> K" "length Ks = length Us" "a = combine Ks Us"
+    using Span_mem_iff_length_version[OF assms(1)] assms(2) by auto
+  hence "((\<ominus> \<one>) \<otimes> a) \<oplus> a = combine ((\<ominus> \<one>) # Ks) (a # Us)"
+    by auto
+  moreover have "((\<ominus> \<one>) \<otimes> a) \<oplus> a = \<zero>"
+    using assms(2) Span_subgroup_props(1)[OF assms(1)] l_minus l_neg by auto  
+  moreover have "\<ominus> \<one> \<noteq> \<zero>"
+    using subfieldE(6)[OF K] l_neg by force 
+  ultimately show ?thesis
+    using that subring_props(3,5) Ks(1-2) by (force simp del: combine.simps)
+qed
+
 corollary Span_mem_iff:
   assumes "set Us \<subseteq> carrier R" and "a \<in> carrier R"
   shows "a \<in> Span K Us \<longleftrightarrow> (\<exists>k \<in> K - { \<zero> }. \<exists>Ks. set Ks \<subseteq> K \<and> combine (k # Ks) (a # Us) = \<zero>)"
@@ -355,11 +447,6 @@
     using Span_m_inv_simprule[OF assms(1) _ assms(2), of k] k by auto
 qed
 
-corollary Span_mem_iff_length_version:
-  assumes "set Us \<subseteq> carrier R"
-  shows "a \<in> Span K Us \<longleftrightarrow> (\<exists>Ks. set Ks \<subseteq> K \<and> length Ks = length Us \<and> a = combine Ks Us)"
-  using Span_eq_combine_set_length_version[OF assms] by blast
-
 
 subsection \<open>Span as the minimal subgroup that contains \<^term>\<open>K <#> (set Us)\<close>\<close>
 
@@ -525,7 +612,7 @@
       fix v assume "v \<in> line_extension K u (Span K Us <+>\<^bsub>R\<^esub> Span K Vs)"
       then obtain k u' v'
         where v: "k \<in> K" "u' \<in> Span K Us" "v' \<in> Span K Vs" "v = k \<otimes> u \<oplus> (u' \<oplus> v')"
-        using line_extension_mem_iff[of v u "Span K Us <+>\<^bsub>R\<^esub> Span K Vs"]
+        using line_extension_mem_iff[of v _ u "Span K Us <+>\<^bsub>R\<^esub> Span K Vs"]
         unfolding set_add_def' by blast
       hence "v = (k \<otimes> u \<oplus> u') \<oplus> v'"
         using in_carrier(2-3)[THEN Span_subgroup_props(1)] in_carrier(1) subring_props(1)
@@ -541,12 +628,12 @@
       fix v assume "v \<in> Span K (u # Us) <+>\<^bsub>R\<^esub> Span K Vs"
       then obtain k u' v'
         where v: "k \<in> K" "u' \<in> Span K Us" "v' \<in> Span K Vs" "v = (k \<otimes> u \<oplus> u') \<oplus> v'"
-        using line_extension_mem_iff[of _ u "Span K Us"] unfolding set_add_def' by auto
+        using line_extension_mem_iff[of _ _ u "Span K Us"] unfolding set_add_def' by auto
       hence "v = (k \<otimes> u) \<oplus> (u' \<oplus> v')"
         using in_carrier(2-3)[THEN Span_subgroup_props(1)] in_carrier(1) subring_props(1)
         by (metis (no_types, lifting) rev_subsetD ring_simprules(5,7))
       thus "v \<in> line_extension K u (Span K Us <+>\<^bsub>R\<^esub> Span K Vs)"
-        using line_extension_mem_iff[of "(k \<otimes> u) \<oplus> (u' \<oplus> v')" u "Span K Us <+>\<^bsub>R\<^esub> Span K Vs"]
+        using line_extension_mem_iff[of "(k \<otimes> u) \<oplus> (u' \<oplus> v')" K u "Span K Us <+>\<^bsub>R\<^esub> Span K Vs"]
         unfolding set_add_def' using v by auto
     qed
   qed
@@ -571,7 +658,7 @@
     by auto
 qed
 
-lemma independent_strinct_incl:
+lemma independent_strict_incl:
   assumes "independent K (u # Us)" shows "Span K Us \<subset> Span K (u # Us)"
 proof -
   have "u \<in> Span K (u # Us)"
@@ -588,7 +675,7 @@
 proof -
   assume "Span K (u # Us) \<subseteq> Span K Vs"
   hence "Span K Us \<subset> Span K Vs"
-    using independent_strinct_incl[OF assms(1)] by auto
+    using independent_strict_incl[OF assms(1)] by auto
   then obtain v where v: "v \<in> set Vs" "v \<notin> Span K Us"
     using Span_strict_incl[of Us Vs] assms[THEN independent_in_carrier] by auto
   thus ?thesis
@@ -638,7 +725,7 @@
         where u': "u' \<in> Span K Us" "u' \<in> carrier R"
           and v': "v' \<in> Span K Vs" "v' \<in> carrier R" "v' \<noteq> \<zero>"
           and k: "k \<in> K" "(k \<otimes> u \<oplus> u') = v'"
-        using line_extension_mem_iff[of _ u "Span K Us"] in_carrier(2-3)[THEN Span_subgroup_props(1)]
+        using line_extension_mem_iff[of _ _ u "Span K Us"] in_carrier(2-3)[THEN Span_subgroup_props(1)]
               subring_props(1) by force
       hence "v' = \<zero>" if "k = \<zero>"
         using in_carrier(1) that IH by auto
@@ -735,6 +822,11 @@
   qed
 qed
 
+lemma non_trivial_combine_imp_dependent:
+  assumes "set Ks \<subseteq> K" and "combine Ks Us = \<zero>" and "\<not> set (take (length Us) Ks) \<subseteq> { \<zero> }"
+  shows "dependent K Us"
+  using independent_imp_trivial_combine[OF _ assms(1-2)] assms(3) by blast  
+
 lemma trivial_combine_imp_independent:
   assumes "set Us \<subseteq> carrier R"
     and "\<And>Ks. \<lbrakk> set Ks \<subseteq> K; combine Ks Us = \<zero> \<rbrakk> \<Longrightarrow> set (take (length Us) Ks) \<subseteq> { \<zero> }"
@@ -773,6 +865,27 @@
     using li_Cons[OF u] by simp
 qed
 
+corollary dependent_imp_non_trivial_combine:
+  assumes "set Us \<subseteq> carrier R" and "dependent K Us"
+  obtains Ks where "length Ks = length Us" "combine Ks Us = \<zero>" "set Ks \<subseteq> K" "set Ks \<noteq> { \<zero> }"
+proof -
+  obtain Ks
+    where Ks: "set Ks \<subseteq> carrier R" "set Ks \<subseteq> K" "combine Ks Us = \<zero>" "\<not> set (take (length Us) Ks) \<subseteq> { \<zero> }"
+    using trivial_combine_imp_independent[OF assms(1)] assms(2) subring_props(1) by blast
+  obtain Ks'
+    where Ks': "set (take (length Us) Ks) \<subseteq> set Ks'" "set Ks' \<subseteq> set (take (length Us) Ks) \<union> { \<zero> }"
+               "length Ks' = length Us" "combine Ks' Us = \<zero>"
+    using combine_normalize[OF Ks(1) assms(1) Ks(3)] by metis
+  have "set (take (length Us) Ks) \<subseteq> set Ks"
+    by (simp add: set_take_subset) 
+  hence "set Ks' \<subseteq> K"
+    using Ks(2) Ks'(2) subring_props(2) Un_commute by blast
+  moreover have "set Ks' \<noteq> { \<zero> }"
+    using Ks'(1) Ks(4) by auto
+  ultimately show thesis
+    using that Ks' by blast
+qed
+
 corollary unique_decomposition:
   assumes "independent K Us"
   shows "a \<in> Span K Us \<Longrightarrow> \<exists>!Ks. set Ks \<subseteq> K \<and> length Ks = length Us \<and> a = combine Ks Us"
@@ -964,7 +1077,7 @@
   thus ?case by blast
 qed
 
-lemma dimension_zero [intro]: "dimension 0 K E \<Longrightarrow> E = { \<zero> }"
+lemma dimension_zero: "dimension 0 K E \<Longrightarrow> E = { \<zero> }"
 proof -
   assume "dimension 0 K E"
   then obtain Vs where "length Vs = 0" "Span K Vs = E"
@@ -973,12 +1086,12 @@
     by auto
 qed
 
-lemma dimension_independent [intro]: "independent K Us \<Longrightarrow> dimension (length Us) K (Span K Us)"
-proof (induct Us)
-  case Nil thus ?case by simp
-next
-  case Cons thus ?case
-    using Suc_dim[OF independent_backwards(3,1)[OF Cons(2)]] by auto
+lemma dimension_one [iff]: "dimension 1 K K"
+proof -
+  have "K = Span K [ \<one> ]"
+    using line_extension_mem_iff[of _ K \<one> "{ \<zero> }"] subfieldE(3)[OF K] by (auto simp add: rev_subsetD)
+  thus ?thesis
+    using dimension.Suc_dim[OF one_closed _ dimension.zero_dim, of K] subfieldE(6)[OF K] by auto 
 qed
 
 lemma dimensionI:
@@ -1081,6 +1194,37 @@
     using aux_lemma[OF _ assms(2-3)] by auto
 qed
 
+lemma filter_base:
+  assumes "set Us \<subseteq> carrier R"
+  obtains Vs where "set Vs \<subseteq> carrier R" and "independent K Vs" and "Span K Vs = Span K Us"
+proof -
+  from \<open>set Us \<subseteq> carrier R\<close> have "\<exists>Vs. independent K Vs \<and> Span K Vs = Span K Us"
+  proof (induction Us)
+    case Nil thus ?case by auto
+  next
+    case (Cons u Us)
+    then obtain Vs where Vs: "independent K Vs" "Span K Vs = Span K Us"
+      by auto
+    show ?case
+    proof (cases "u \<in> Span K Us")
+      case True
+      hence "Span K (u # Us) = Span K Us"
+        using Span_base_incl mono_Span_subset
+        by (metis Cons.prems insert_subset list.simps(15) subset_antisym)
+      thus ?thesis
+        using Vs by blast
+    next
+      case False
+      hence "Span K (u # Vs) = Span K (u # Us)" and "independent K (u # Vs)"
+        using li_Cons[of u K Vs] Cons(2) Vs by auto
+      thus ?thesis
+        by blast
+    qed
+  qed
+  thus ?thesis
+    using independent_in_carrier that by auto
+qed
+
 lemma dimension_backwards:
   "dimension (Suc n) K E \<Longrightarrow> \<exists>v \<in> carrier R. \<exists>E'. dimension n K E' \<and> v \<notin> E' \<and> E = line_extension K v E'"
   by (cases rule: dimension.cases) (auto)
@@ -1123,7 +1267,7 @@
 
   hence dim: "dimension (n + m - k) K (Span K (Us @ (Vs @ Bs)))"
     using independent_append[OF independent_split(2)[OF Us(2)] Vs(2)] Us(1) Vs(1) Bs(2)
-          dimension_independent[of "Us @ (Vs @ Bs)"] by auto
+          dimension_independent[of K "Us @ (Vs @ Bs)"] by auto
 
   have "(Span K Us) <+>\<^bsub>R\<^esub> F \<subseteq> E <+>\<^bsub>R\<^esub> F"
     using mono_Span_append(1)[OF in_carrier(1) Bs(1)] Us(3) unfolding set_add_def' by auto
@@ -1149,9 +1293,10 @@
   thus ?thesis using dim by simp
 qed
 
-end
+end (* of fixed K context. *)
 
-end
+end (* of ring context. *)
+
 
 lemma (in ring) telescopic_base_aux:
   assumes "subfield K R" "subfield F R"
@@ -1186,7 +1331,7 @@
   proof
     fix v assume "v \<in> E"
     then obtain f where f: "f \<in> F" "v = f \<otimes> u \<oplus> \<zero>"
-      using u(1,3) line_extension_mem_iff[OF assms(2)] by auto
+      using u(1,3) line_extension_mem_iff by auto
     then obtain Ks where Ks: "set Ks \<subseteq> K" "f = combine Ks Us"
       using Span_eq_combine_set[OF assms(1) Us(1)] Us(4) by auto
     have "v = f \<otimes> u"
@@ -1209,7 +1354,7 @@
     ultimately have "v = (combine Ks Us) \<otimes> u \<oplus> \<zero>" and "combine Ks Us \<in> F"
       using subring_props(1)[OF assms(2)] u(1) by auto
     thus "v \<in> E"
-      using u(3) line_extension_mem_iff[OF assms(2)] by auto
+      using u(3) line_extension_mem_iff by auto
   qed
   ultimately have "Span K (map (\<lambda>u'. u' \<otimes> u) Us) = E" by auto
   thus ?thesis
@@ -1234,9 +1379,9 @@
   hence li: "independent F [ v ]" "independent F Vs'" and inter: "Span F [ v ] \<inter> Span F Vs' = { \<zero> }"
     using Vs(3) independent_split[OF assms(2), of "[ v ]" Vs'] by auto
   have "dimension n K (Span F [ v ])"
-    using dimension_independent[OF assms(2) li(1)] telescopic_base_aux[OF assms(1-3)] by simp
+    using dimension_independent[OF li(1)] telescopic_base_aux[OF assms(1-3)] by simp
   moreover have "dimension (n * m) K (Span F Vs')"
-    using Suc(1) dimension_independent[OF assms(2) li(2)] Vs(2) unfolding v by auto
+    using Suc(1) dimension_independent[OF li(2)] Vs(2) unfolding v by auto
   ultimately have "dimension (n * Suc m) K (Span F [ v ] <+>\<^bsub>R\<^esub> Span F Vs')"
     using dimension_direct_sum_space[OF assms(1) _ _ inter] by auto
   thus "dimension (n * Suc m) K E"
@@ -1244,70 +1389,387 @@
 qed
 
 
-(*
-lemma combine_take:
-  assumes "set Ks  \<subseteq> carrier R" "set Us \<subseteq> carrier R"
-  shows "length Ks \<le> length Us \<Longrightarrow> combine Ks Us = combine Ks (take (length Ks) Us)"
-    and "length Us \<le> length Ks \<Longrightarrow> combine Ks Us = combine (take (length Us) Ks) Us"
+context ring_hom_ring
+begin
+
+lemma combine_hom:
+  "\<lbrakk> set Ks \<subseteq> carrier R; set Us \<subseteq> carrier R \<rbrakk> \<Longrightarrow> combine (map h Ks) (map h Us) = h (R.combine Ks Us)"
+  by (induct Ks Us rule: R.combine.induct) (auto)
+
+lemma line_extension_hom:
+  assumes "K \<subseteq> carrier R" "a \<in> carrier R" "E \<subseteq> carrier R"
+  shows "line_extension (h ` K) (h a) (h ` E) = h ` R.line_extension K a E"
+  using set_add_hom[OF homh R.r_coset_subset_G[OF assms(1-2)] assms(3)]
+        coset_hom(2)[OF ring_hom_in_hom(1)[OF homh] assms(1-2)]
+  unfolding R.line_extension_def S.line_extension_def
+  by simp
+
+lemma Span_hom:
+  assumes "K \<subseteq> carrier R" "set Us \<subseteq> carrier R"
+  shows "Span (h ` K) (map h Us) = h ` R.Span K Us"
+  using assms line_extension_hom R.Span_in_carrier by (induct Us) (auto)
+
+lemma inj_on_subgroup_iff_trivial_ker:
+  assumes "subgroup H (add_monoid R)"
+  shows "inj_on h H \<longleftrightarrow> a_kernel (R \<lparr> carrier := H \<rparr>) S h = { \<zero> }"
+  using group_hom.inj_on_subgroup_iff_trivial_ker[OF a_group_hom assms]
+  unfolding a_kernel_def[of "R \<lparr> carrier := H \<rparr>" S h] by simp
+
+corollary inj_on_Span_iff_trivial_ker:
+  assumes "subfield K R" "set Us \<subseteq> carrier R"
+  shows "inj_on h (R.Span K Us) \<longleftrightarrow> a_kernel (R \<lparr> carrier := R.Span K Us \<rparr>) S h = { \<zero> }"
+  using inj_on_subgroup_iff_trivial_ker[OF R.Span_is_add_subgroup[OF assms]] .
+
+
+context
+  fixes K :: "'a set" assumes K: "subfield K R" and one_zero: "\<one>\<^bsub>S\<^esub> \<noteq> \<zero>\<^bsub>S\<^esub>"
+begin
+
+lemma inj_hom_preserves_independent:
+  assumes "inj_on h (R.Span K Us)"
+  and "R.independent K Us" shows "independent (h ` K) (map h Us)"
+proof (rule ccontr)
+  have in_carrier: "set Us \<subseteq> carrier R" "set (map h Us) \<subseteq> carrier S"
+    using R.independent_in_carrier[OF assms(2)] by auto 
+
+  assume ld: "dependent (h ` K) (map h Us)"
+  obtain Ks :: "'c list"
+    where Ks: "length Ks = length Us" "combine Ks (map h Us) = \<zero>\<^bsub>S\<^esub>" "set Ks \<subseteq> h ` K" "set Ks \<noteq> { \<zero>\<^bsub>S\<^esub> }"
+    using dependent_imp_non_trivial_combine[OF img_is_subfield(2)[OF K one_zero] in_carrier(2) ld]
+    by (metis length_map)
+  obtain Ks' where Ks': "set Ks' \<subseteq> K" "Ks = map h Ks'"
+    using Ks(3) by (induct Ks) (auto, metis insert_subset list.simps(15,9))
+  hence "h (R.combine Ks' Us) = \<zero>\<^bsub>S\<^esub>"
+    using combine_hom[OF _ in_carrier(1)] Ks(2) subfieldE(3)[OF K] by (metis subset_trans)
+  moreover have "R.combine Ks' Us \<in> R.Span K Us"
+    using R.Span_eq_combine_set[OF K in_carrier(1)] Ks'(1) by auto
+  ultimately have "R.combine Ks' Us = \<zero>"
+    using assms hom_zero R.Span_subgroup_props(2)[OF K in_carrier(1)] by (auto simp add: inj_on_def)
+  hence "set Ks' \<subseteq> { \<zero> }"
+    using R.independent_imp_trivial_combine[OF K assms(2)] Ks' Ks(1)
+    by (metis length_map order_refl take_all)
+  hence "set Ks \<subseteq> { \<zero>\<^bsub>S\<^esub> }"
+    unfolding Ks' using hom_zero by (induct Ks') (auto)
+  hence "Ks = []"
+    using Ks(4) by (metis set_empty2 subset_singletonD)
+  hence "independent (h ` K) (map h Us)"
+    using independent.li_Nil Ks(1) by simp
+  from \<open>dependent (h ` K) (map h Us)\<close> and this show False by simp
+qed
+
+corollary inj_hom_dimension:
+  assumes "inj_on h E"
+  and "R.dimension n K E" shows "dimension n (h ` K) (h ` E)"
+proof -
+  obtain Us
+    where Us: "set Us \<subseteq> carrier R" "R.independent K Us" "length Us = n" "R.Span K Us = E"
+    using R.exists_base[OF K assms(2)] by blast
+  hence "dimension n (h ` K) (Span (h ` K) (map h Us))"
+    using dimension_independent[OF inj_hom_preserves_independent[OF _ Us(2)]] assms(1) by auto
+  thus ?thesis
+    using Span_hom[OF subfieldE(3)[OF K] Us(1)] Us(4) by simp
+qed
+
+corollary rank_nullity_theorem:
+  assumes "R.dimension n K E" and "R.dimension m K (a_kernel (R \<lparr> carrier := E \<rparr>) S h)"
+  shows "dimension (n - m) (h ` K) (h ` E)"
 proof -
-  assume len: "length Ks \<le> length Us"
-  hence Us: "Us = (take (length Ks) Us) @ (drop (length Ks) Us)" by auto
-  hence set_t: "set (take (length Ks) Us) \<subseteq> carrier R" and set_d: "set (drop (length Ks) Us) \<subseteq> carrier R"
-    using assms(2) len by (metis le_sup_iff set_append)+
-  hence "combine Ks Us = (combine Ks (take (length Ks) Us)) \<oplus> \<zero>"
-    using combine_append[OF _ assms(1), of "take (length Ks) Us" "[]" "drop (length Ks) Us"] len by auto
-  also have " ... = combine Ks (take (length Ks) Us)"
-    using combine_in_carrier[OF assms(1) set_t] by auto
-  finally show "combine Ks Us = combine Ks (take (length Ks) Us)" .
-next
-  assume len: "length Us \<le> length Ks"
-  hence Us: "Ks = (take (length Us) Ks) @ (drop (length Us) Ks)" by auto
-  hence set_t: "set (take (length Us) Ks) \<subseteq> carrier R" and set_d: "set (drop (length Us) Ks) \<subseteq> carrier R"
-    using assms(1) len by (metis le_sup_iff set_append)+
-  hence "combine Ks Us = (combine (take (length Us) Ks) Us) \<oplus> \<zero>"
-    using combine_append[OF _ _ assms(2), of "take (length Us) Ks" "drop (length Us) Ks" "[]"] len by auto
-  also have " ... = combine (take (length Us) Ks) Us"
-    using combine_in_carrier[OF set_t assms(2)] by auto
-  finally show "combine Ks Us = combine (take (length Us) Ks) Us" .
+  obtain Us
+    where Us: "set Us \<subseteq> carrier R" "R.independent K Us" "length Us = m"
+              "R.Span K Us = a_kernel (R \<lparr> carrier := E \<rparr>) S h"
+    using R.exists_base[OF K assms(2)] by blast
+  obtain Vs
+    where Vs: "R.independent K (Vs @ Us)" "length (Vs @ Us) = n" "R.Span K (Vs @ Us) = E" 
+    using R.complete_base[OF K assms(1) Us(2)] R.Span_base_incl[OF K Us(1)] Us(4)
+    unfolding a_kernel_def' by auto
+  have set_Vs: "set Vs \<subseteq> carrier R"
+    using R.independent_in_carrier[OF Vs(1)] by auto
+  have "R.Span K Vs \<inter> a_kernel (R \<lparr> carrier := E \<rparr>) S h = { \<zero> }"
+    using R.independent_split[OF K Vs(1)] Us(4) by simp
+  moreover have "R.Span K Vs \<subseteq> E"
+    using R.mono_Span_append(1)[OF K set_Vs Us(1)] Vs(3) by auto
+  ultimately have "a_kernel (R \<lparr> carrier := R.Span K Vs \<rparr>) S h \<subseteq> { \<zero> }"
+    unfolding a_kernel_def' by (simp del: R.Span.simps, blast)
+  hence "a_kernel (R \<lparr> carrier := R.Span K Vs \<rparr>) S h = { \<zero> }"
+    using R.Span_subgroup_props(2)[OF K set_Vs]
+    unfolding a_kernel_def' by (auto simp del: R.Span.simps)
+  hence "inj_on h (R.Span K Vs)"
+    using inj_on_Span_iff_trivial_ker[OF K set_Vs] by simp
+  moreover have "R.dimension (n - m) K (R.Span K Vs)"
+    using R.dimension_independent[OF R.independent_split(2)[OF K Vs(1)]] Vs(2) Us(3) by auto
+  ultimately have "dimension (n - m) (h ` K) (h ` (R.Span K Vs))"
+    using assms(1) inj_hom_dimension by simp
+
+  have "h ` E = h ` (R.Span K Vs <+>\<^bsub>R\<^esub> R.Span K Us)"
+    using R.Span_append_eq_set_add[OF K set_Vs Us(1)] Vs(3) by simp
+  hence "h ` E = h ` (R.Span K Vs) <+>\<^bsub>S\<^esub> h ` (R.Span K Us)"
+    using R.Span_subgroup_props(1)[OF K] set_Vs Us(1) set_add_hom[OF homh] by auto
+  moreover have "h ` (R.Span K Us) = { \<zero>\<^bsub>S\<^esub> }"
+    using R.space_subgroup_props(2)[OF K assms(1)] unfolding Us(4) a_kernel_def' by force
+  ultimately have "h ` E = h ` (R.Span K Vs) <+>\<^bsub>S\<^esub> { \<zero>\<^bsub>S\<^esub> }"
+    by simp
+  hence "h ` E = h ` (R.Span K Vs)"
+    using R.Span_subgroup_props(1-2)[OF K set_Vs] unfolding set_add_def' by force
+
+  from \<open>dimension (n - m) (h ` K) (h ` (R.Span K Vs))\<close> and this show ?thesis by simp
 qed
-*)
+
+end (* of fixed K context. *)
+
+end (* of ring_hom_ring context. *)
+
+lemma (in ring_hom_ring)
+  assumes "subfield K R" and "set Us \<subseteq> carrier R" and "\<one>\<^bsub>S\<^esub> \<noteq> \<zero>\<^bsub>S\<^esub>"
+    and "independent (h ` K) (map h Us)" shows "R.independent K Us"
+proof (rule ccontr)
+  assume "R.dependent K Us"
+  then obtain Ks
+    where "length Ks = length Us" and "R.combine Ks Us = \<zero>" and "set Ks \<subseteq> K" and "set Ks \<noteq> { \<zero> }"
+    using R.dependent_imp_non_trivial_combine[OF assms(1-2)] by metis
+  hence "combine (map h Ks) (map h Us) = \<zero>\<^bsub>S\<^esub>"
+    using combine_hom[OF _ assms(2), of Ks] subfieldE(3)[OF assms(1)] by simp
+  moreover from \<open>set Ks \<subseteq> K\<close> have "set (map h Ks) \<subseteq> h ` K"
+    by (induction Ks) (auto)
+  moreover have "\<not> set (map h Ks) \<subseteq> { h \<zero> }"
+  proof (rule ccontr)
+    assume "\<not> \<not> set (map h Ks) \<subseteq> { h \<zero> }" then have "set (map h Ks) \<subseteq> { h \<zero> }"
+      by simp
+    moreover from \<open>R.dependent K Us\<close> and \<open>length Ks = length Us\<close> have "Ks \<noteq> []"
+      by auto
+    ultimately have "set (map h Ks) = { h \<zero> }"
+      using subset_singletonD by fastforce
+    with \<open>set Ks \<subseteq> K\<close> have "set Ks = { \<zero> }"
+      using inj_onD[OF _ _ _ subringE(2)[OF subfieldE(1)[OF assms(1)]], of h]
+            img_is_subfield(1)[OF assms(1,3)] subset_singletonD
+      by (induction Ks) (auto simp add: subset_singletonD, fastforce)
+    with \<open>set Ks \<noteq> { \<zero> }\<close> show False
+      by simp
+  qed
+  with \<open>length Ks = length Us\<close> have "\<not> set (take (length (map h Us)) (map h Ks)) \<subseteq> { h \<zero> }"
+    by auto
+  ultimately have "dependent (h ` K) (map h Us)"
+    using non_trivial_combine_imp_dependent[OF img_is_subfield(2)[OF assms(1,3)], of "map h Ks"] by simp
+  with \<open>independent (h ` K) (map h Us)\<close> show False
+    by simp
+qed
+
+
+subsection \<open>Finite Dimension\<close>
+
+definition (in ring) finite_dimension :: "'a set \<Rightarrow> 'a set \<Rightarrow> bool"
+  where "finite_dimension K E \<longleftrightarrow> (\<exists>n. dimension n K E)"
+
+abbreviation (in ring) infinite_dimension :: "'a set \<Rightarrow> 'a set \<Rightarrow> bool"
+  where "infinite_dimension K E \<equiv> \<not> finite_dimension K E"
+
+definition (in ring) dim :: "'a set \<Rightarrow> 'a set \<Rightarrow> nat"
+  where "dim K E = (THE n. dimension n K E)"
+
+locale subalgebra = subgroup V "add_monoid R" for K and V and R (structure) +
+  assumes smult_closed: "\<lbrakk> k \<in> K; v \<in> V \<rbrakk> \<Longrightarrow> k \<otimes> v \<in> V"
+
+
+subsubsection \<open>Basic Properties\<close>
+
+lemma (in ring) unique_dimension:
+  assumes "subfield K R" and "finite_dimension K E" shows "\<exists>!n. dimension n K E"
+  using assms(2) dimension_is_inj[OF assms(1)] unfolding finite_dimension_def by auto
+
+lemma (in ring) finite_dimensionI:
+  assumes "dimension n K E" shows "finite_dimension K E"
+  using assms unfolding finite_dimension_def by auto
 
-(*
-lemma combine_normalize:
-  assumes "set Ks \<subseteq> K" "set Us \<subseteq> carrier R" "a = combine Ks Us"
-  shows "\<exists>Ks'. set Ks' \<subseteq> K \<and> length Ks' = length Us \<and> a = combine Ks' Us"
-proof (cases "length Ks \<le> length Us")
-  assume "\<not> length Ks \<le> length Us"
-  hence len: "length Us < length Ks" by simp
-  hence "length (take (length Us) Ks) = length Us" and "set (take (length Us) Ks) \<subseteq> K"
-    using assms(1) by (auto, metis contra_subsetD in_set_takeD)
-  thus ?thesis
-    using combine_take(2)[OF _ assms(2), of Ks] assms(1,3) subring_props(1) len
-    by (metis dual_order.trans nat_less_le)
+lemma (in ring) finite_dimensionE:
+  assumes "subfield K R" and "finite_dimension K E" shows "dimension ((dim over K) E) K E"
+  using theI'[OF unique_dimension[OF assms]] unfolding over_def dim_def by simp
+
+lemma (in ring) dimI:
+  assumes "subfield K R" and "dimension n K E" shows "(dim over K) E = n"
+  using finite_dimensionE[OF assms(1) finite_dimensionI] dimension_is_inj[OF assms(1)] assms(2)
+  unfolding over_def dim_def by auto
+
+lemma (in ring) finite_dimensionE' [elim]:
+  assumes "finite_dimension K E" and "\<And>n. dimension n K E \<Longrightarrow> P" shows P
+  using assms unfolding finite_dimension_def by auto
+
+lemma (in ring) Span_finite_dimension:
+  assumes "subfield K R" and "set Us \<subseteq> carrier R"
+  shows "finite_dimension K (Span K Us)"
+  using filter_base[OF assms] finite_dimensionI[OF dimension_independent[of K]] by metis
+
+lemma (in ring) carrier_is_subalgebra:
+  assumes "K \<subseteq> carrier R" shows "subalgebra K (carrier R) R"
+  using assms subalgebra.intro[OF add.group_incl_imp_subgroup[of "carrier R"], of K] add.group_axioms
+  unfolding subalgebra_axioms_def by auto
+
+lemma (in ring) subalgebra_in_carrier:
+  assumes "subalgebra K V R" shows "V \<subseteq> carrier R"
+  using subgroup.subset[OF subalgebra.axioms(1)[OF assms]] by simp
+
+lemma (in ring) subalgebra_inter:
+  assumes "subalgebra K V R" and "subalgebra K V' R" shows "subalgebra K (V \<inter> V') R"
+  using add.subgroups_Inter_pair assms unfolding subalgebra_def subalgebra_axioms_def by auto
+
+lemma (in ring_hom_ring) img_is_subalgebra:
+  assumes "K \<subseteq> carrier R" and "subalgebra K V R" shows "subalgebra (h ` K) (h ` V) S"
+proof (intro subalgebra.intro)
+  have "group_hom (add_monoid R) (add_monoid S) h"
+    using ring_hom_in_hom(2)[OF homh] R.add.group_axioms add.group_axioms
+    unfolding group_hom_def group_hom_axioms_def by auto
+  thus "subgroup (h ` V) (add_monoid S)"
+    using group_hom.subgroup_img_is_subgroup[OF _ subalgebra.axioms(1)[OF assms(2)]] by force
 next
-  assume len: "length Ks \<le> length Us"
-  have Ks: "set Ks \<subseteq> carrier R" and set_r: "set (replicate (length Us - length Ks) \<zero>) \<subseteq> carrier R"
-    using assms subring_props(1) zero_closed by (metis dual_order.trans, auto)
-  moreover
-  have set_t: "set (take (length Ks) Us) \<subseteq> carrier R"
-   and set_d: "set (drop (length Ks) Us) \<subseteq> carrier R"
-    using assms(2) len dual_order.trans by (metis set_take_subset, metis set_drop_subset)
-  ultimately
-  have "combine (Ks @ (replicate (length Us - length Ks) \<zero>)) Us =
-       (combine Ks (take (length Ks) Us)) \<oplus>
-       (combine (replicate (length Us - length Ks) \<zero>) (drop (length Ks) Us))"
-    using combine_append[OF _ Ks set_t set_r set_d] len by auto
-  also have " ... = combine Ks (take (length Ks) Us)"
-    using combine_replicate[OF set_d] combine_in_carrier[OF Ks set_t] by auto
-  also have " ... = a"
-    using combine_take(1)[OF Ks assms(2) len] assms(3) by simp
-  finally have "combine (Ks @ (replicate (length Us - length Ks) \<zero>)) Us = a" .
-  moreover have "set (Ks @ (replicate (length Us - length Ks) \<zero>)) \<subseteq> K"
-    using assms(1) subring_props(2) by auto
-  moreover have "length (Ks @ (replicate (length Us - length Ks) \<zero>)) = length Us"
-    using len by simp
-  ultimately show ?thesis by blast
+  show "subalgebra_axioms (h ` K) (h ` V) S"
+    using R.subalgebra_in_carrier[OF assms(2)] subalgebra.axioms(2)[OF assms(2)] assms(1)
+    unfolding subalgebra_axioms_def
+    by (auto, metis hom_mult image_eqI subset_iff)
+qed
+
+lemma (in ring) ideal_is_subalgebra:
+  assumes "K \<subseteq> carrier R" "ideal I R" shows "subalgebra K I R"
+  using ideal.axioms(1)[OF assms(2)] ideal.I_l_closed[OF assms(2)] assms(1)
+  unfolding subalgebra_def subalgebra_axioms_def additive_subgroup_def by auto
+
+lemma (in ring) Span_is_subalgebra:
+  assumes "subfield K R" "set Us \<subseteq> carrier R" shows "subalgebra K (Span K Us) R"
+  using Span_smult_closed[OF assms] Span_is_add_subgroup[OF assms]
+  unfolding subalgebra_def subalgebra_axioms_def by auto
+
+lemma (in ring) finite_dimension_imp_subalgebra:
+  assumes "subfield K R" "finite_dimension K E" shows "subalgebra K E R"
+  using exists_base[OF assms(1) finite_dimensionE[OF assms]] Span_is_subalgebra[OF assms(1)] by auto
+
+lemma (in ring) subalgebra_Span_incl:
+  assumes "subfield K R" and "subalgebra K V R" "set Us \<subseteq> V" shows "Span K Us \<subseteq> V"
+proof -
+  have "K <#> (set Us) \<subseteq> V"
+    using subalgebra.smult_closed[OF assms(2)] assms(3) unfolding set_mult_def by blast
+  moreover have "set Us \<subseteq> carrier R"
+    using subalgebra_in_carrier[OF assms(2)] assms(3) by auto
+  ultimately show ?thesis
+    using subalgebra.axioms(1)[OF assms(2)] Span_min[OF assms(1)] by blast
+qed
+
+lemma (in ring) Span_subalgebra_minimal:
+  assumes "subfield K R" "set Us \<subseteq> carrier R"
+  shows "Span K Us = \<Inter> { V. subalgebra K V R \<and> set Us \<subseteq> V }"
+  using Span_is_subalgebra[OF assms] Span_base_incl[OF assms] subalgebra_Span_incl[OF assms(1)]
+  by blast
+
+lemma (in ring) Span_subalgebraI:
+  assumes "subfield K R"
+    and "subalgebra K E R" "set Us \<subseteq> E"
+    and "\<And>V. \<lbrakk> subalgebra K V R; set Us \<subseteq> V \<rbrakk> \<Longrightarrow> E \<subseteq> V"
+  shows "E = Span K Us"
+proof -
+  have "\<Inter> { V. subalgebra K V R \<and> set Us \<subseteq> V } = E"
+    using assms(2-4) by auto
+  thus "E = Span K Us"
+    using Span_subalgebra_minimal subalgebra_in_carrier[of K E] assms by auto
 qed
-*)
+
+lemma (in ring) subalbegra_incl_imp_finite_dimension:
+  assumes "subfield K R" and "finite_dimension K E"
+  and "subalgebra K V R" "V \<subseteq> E" shows "finite_dimension K V"
+proof -
+  obtain n where n: "dimension n K E"
+    using assms(2) by auto
+
+  define S where "S = { Us. set Us \<subseteq> V \<and> independent K Us }"
+  have "length ` S \<subseteq> {..n}"
+    unfolding S_def using independent_length_le_dimension[OF assms(1) n] assms(4) by auto
+  moreover have "[] \<in> S"
+    unfolding S_def by simp
+  hence "length ` S \<noteq> {}" by blast
+  ultimately obtain m where m: "m \<in> length ` S" and greatest: "\<And>k. k \<in> length ` S \<Longrightarrow> k \<le> m"
+    by (meson Max_ge Max_in finite_atMost rev_finite_subset)
+  then obtain Us where Us: "set Us \<subseteq> V" "independent K Us" "m = length Us"
+      unfolding S_def by auto
+  have "Span K Us = V"
+  proof (rule ccontr)
+    assume "\<not> Span K Us = V" then have "Span K Us \<subset> V"
+      using subalgebra_Span_incl[OF assms(1,3) Us(1)] by blast
+    then obtain v where v:"v \<in> V" "v \<notin> Span K Us"
+      by blast
+    hence "independent K (v # Us)"
+      using independent.li_Cons[OF _ _ Us(2)] subalgebra_in_carrier[OF assms(3)] by auto
+    hence "(v # Us) \<in> S"
+      unfolding S_def using Us(1) v(1) by auto
+    hence "length (v # Us) \<le> m"
+      using greatest by blast
+    moreover have "length (v # Us) = Suc m"
+      using Us(3) by auto
+    ultimately show False by simp
+  qed
+  thus ?thesis
+    using finite_dimensionI[OF dimension_independent[OF Us(2)]] by simp
+qed
+
+lemma (in ring_hom_ring) infinite_dimension_hom:
+  assumes "subfield K R" and "\<one>\<^bsub>S\<^esub> \<noteq> \<zero>\<^bsub>S\<^esub>" and "inj_on h E" and "subalgebra K E R"
+  shows "R.infinite_dimension K E \<Longrightarrow> infinite_dimension (h ` K) (h ` E)"
+proof -
+  note subfield = img_is_subfield(2)[OF assms(1-2)]
+
+  assume "R.infinite_dimension K E"
+  show "infinite_dimension (h ` K) (h ` E)"
+  proof (rule ccontr)
+    assume "\<not> infinite_dimension (h ` K) (h ` E)"
+    then obtain Vs where "set Vs \<subseteq> carrier S" and "Span (h ` K) Vs = h ` E"
+      using exists_base[OF subfield] by blast
+    hence "set Vs \<subseteq> h ` E"
+      using Span_base_incl[OF subfield] by blast
+    hence "\<exists>Us. set Us \<subseteq> E \<and> Vs = map h Us"
+      by (induct Vs) (auto, metis insert_subset list.simps(9,15))
+    then obtain Us where "set Us \<subseteq> E" and "Vs = map h Us"
+      by blast
+    with \<open>Span (h ` K) Vs = h ` E\<close> have "h ` (R.Span K Us) = h ` E"
+      using R.subalgebra_in_carrier[OF assms(4)] Span_hom assms(1) by auto
+    moreover from \<open>set Us \<subseteq> E\<close> have "R.Span K Us \<subseteq> E"
+      using R.subalgebra_Span_incl assms(1-4) by blast
+    ultimately have "R.Span K Us = E"
+    proof (auto simp del: R.Span.simps)
+      fix a assume "a \<in> E"
+      with \<open>h ` (R.Span K Us) = h ` E\<close> obtain b where "b \<in> R.Span K Us" and "h a = h b"
+        by auto
+      with \<open>R.Span K Us \<subseteq> E\<close> and \<open>a \<in> E\<close> have "a = b"
+        using inj_onD[OF assms(3)] by auto
+      with \<open>b \<in> R.Span K Us\<close> show "a \<in> R.Span K Us"
+        by simp
+    qed
+    with \<open>set Us \<subseteq> E\<close> have "R.finite_dimension K E"
+      using R.Span_finite_dimension[OF assms(1)] R.subalgebra_in_carrier[OF assms(4)] by auto
+    with \<open>R.infinite_dimension K E\<close> show False
+      by simp
+  qed
+qed
+
+
+subsubsection \<open>Reformulation of some lemmas in this new language.\<close>
+
+lemma (in ring) sum_space_dim:
+  assumes "subfield K R" "finite_dimension K E" "finite_dimension K F"
+  shows "finite_dimension K (E <+>\<^bsub>R\<^esub> F)"
+    and "((dim over K) (E <+>\<^bsub>R\<^esub> F)) = ((dim over K) E) + ((dim over K) F) - ((dim over K) (E \<inter> F))"
+proof -
+  obtain n m k where n: "dimension n K E" and m: "dimension m K F" and k: "dimension k K (E \<inter> F)"
+    using assms(2-3) subalbegra_incl_imp_finite_dimension[OF assms(1-2)
+          subalgebra_inter[OF assms(2-3)[THEN finite_dimension_imp_subalgebra[OF assms(1)]]]]
+    by (meson inf_le1 finite_dimension_def)
+  hence "dimension (n + m - k) K (E <+>\<^bsub>R\<^esub> F)"
+    using dimension_sum_space[OF assms(1)] by simp
+  thus "finite_dimension K (E <+>\<^bsub>R\<^esub> F)"
+   and "((dim over K) (E <+>\<^bsub>R\<^esub> F)) = ((dim over K) E) + ((dim over K) F) - ((dim over K) (E \<inter> F))"
+    using finite_dimensionI dimI[OF assms(1)] n m k by auto
+qed
+
+lemma (in ring) telescopic_base_dim:
+  assumes "subfield K R" "subfield F R" and "finite_dimension K F" and "finite_dimension F E"
+  shows "finite_dimension K E" and "(dim over K) E = ((dim over K) F) * ((dim over F) E)"
+  using telescopic_base[OF assms(1-2)
+        finite_dimensionE[OF assms(1,3)]
+        finite_dimensionE[OF assms(2,4)]]
+        dimI[OF assms(1)] finite_dimensionI
+  by auto
 
 end
diff -r 57503fe1b0ff -r 615233977155 src/HOL/Algebra/Finite_Extensions.thy
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Algebra/Finite_Extensions.thy	Sun Apr 14 12:00:17 2019 +0100
@@ -0,0 +1,810 @@
+(*  Title:      HOL/Algebra/Finite_Extensions.thy
+    Author:     Paulo Emílio de Vilhena
+*)
+
+theory Finite_Extensions
+  imports Embedded_Algebras Polynomials Polynomial_Divisibility
+    
+begin
+
+section \<open>Finite Extensions\<close>
+
+subsection \<open>Definitions\<close>
+
+definition (in ring) transcendental :: "'a set \<Rightarrow> 'a \<Rightarrow> bool"
+  where "transcendental K x \<longleftrightarrow> inj_on (\<lambda>p. eval p x) (carrier (K[X]))"
+
+abbreviation (in ring) algebraic :: "'a set \<Rightarrow> 'a \<Rightarrow> bool"
+  where "algebraic K x \<equiv> \<not> transcendental K x"
+
+definition (in ring) Irr :: "'a set \<Rightarrow> 'a \<Rightarrow> 'a list"
+  where "Irr K x = (THE p. p \<in> carrier (K[X]) \<and> pirreducible K p \<and> eval p x = \<zero> \<and> lead_coeff p = \<one>)"
+
+inductive_set (in ring) simple_extension :: "'a set \<Rightarrow> 'a \<Rightarrow> 'a set"
+  for K and x where
+    zero [simp, intro]: "\<zero> \<in> simple_extension K x" |
+    lin:  "\<lbrakk> k1 \<in> simple_extension K x; k2 \<in> K \<rbrakk> \<Longrightarrow> (k1 \<otimes> x) \<oplus> k2 \<in> simple_extension K x"
+
+fun (in ring) finite_extension :: "'a set \<Rightarrow> 'a list \<Rightarrow> 'a set"
+  where "finite_extension K xs = foldr (\<lambda>x K'. simple_extension K' x) xs K"
+
+
+subsection \<open>Basic Properties\<close>
+
+lemma (in ring) transcendental_consistent:
+  assumes "subring K R" shows "transcendental = ring.transcendental (R \<lparr> carrier := K \<rparr>)"
+  unfolding transcendental_def ring.transcendental_def[OF subring_is_ring[OF assms]]
+            univ_poly_consistent[OF assms] eval_consistent[OF assms] ..
+
+lemma (in ring) algebraic_consistent:
+  assumes "subring K R" shows "algebraic = ring.algebraic (R \<lparr> carrier := K \<rparr>)"
+  unfolding over_def transcendental_consistent[OF assms] ..
+
+lemma (in ring) eval_transcendental:
+  assumes "(transcendental over K) x" "p \<in> carrier (K[X])" "eval p x = \<zero>" shows "p = []"
+proof -
+  have "[] \<in> carrier (K[X])" and "eval [] x = \<zero>"
+    by (auto simp add: univ_poly_def)
+  thus ?thesis
+    using assms unfolding over_def transcendental_def inj_on_def by auto
+qed
+
+lemma (in ring) transcendental_imp_trivial_ker:
+  shows "(transcendental over K) x \<Longrightarrow> a_kernel (K[X]) R (\<lambda>p. eval p x) = { [] }"
+  using eval_transcendental unfolding a_kernel_def' by (auto simp add: univ_poly_def)
+
+lemma (in ring) non_trivial_ker_imp_algebraic:
+  shows "a_kernel (K[X]) R (\<lambda>p. eval p x) \<noteq> { [] } \<Longrightarrow> (algebraic over K) x"
+  using transcendental_imp_trivial_ker unfolding over_def by auto
+
+lemma (in domain) trivial_ker_imp_transcendental:
+  assumes "subring K R" and "x \<in> carrier R"
+  shows "a_kernel (K[X]) R (\<lambda>p. eval p x) = { [] } \<Longrightarrow> (transcendental over K) x"
+  using ring_hom_ring.trivial_ker_imp_inj[OF eval_ring_hom[OF assms]]
+  unfolding transcendental_def over_def by (simp add: univ_poly_zero)
+
+lemma (in domain) algebraic_imp_non_trivial_ker:
+  assumes "subring K R" and "x \<in> carrier R"
+  shows "(algebraic over K) x \<Longrightarrow> a_kernel (K[X]) R (\<lambda>p. eval p x) \<noteq> { [] }"
+  using trivial_ker_imp_transcendental[OF assms] unfolding over_def by auto
+
+lemma (in domain) algebraicE:
+  assumes "subring K R" and "x \<in> carrier R" "(algebraic over K) x"
+  obtains p where "p \<in> carrier (K[X])" "p \<noteq> []" "eval p x = \<zero>"
+proof -
+  have "[] \<in> a_kernel (K[X]) R (\<lambda>p. eval p x)"
+    unfolding a_kernel_def' univ_poly_def by auto
+  then obtain p where "p \<in> carrier (K[X])" "p \<noteq> []" "eval p x = \<zero>"
+    using algebraic_imp_non_trivial_ker[OF assms] unfolding a_kernel_def' by blast
+  thus thesis using that by auto
+qed
+
+lemma (in ring) algebraicI:
+  assumes "p \<in> carrier (K[X])" "p \<noteq> []" and "eval p x = \<zero>" shows "(algebraic over K) x"
+  using assms non_trivial_ker_imp_algebraic unfolding a_kernel_def' by auto
+
+lemma (in ring) transcendental_mono:
+  assumes "K \<subseteq> K'" "(transcendental over K') x" shows "(transcendental over K) x"
+proof -
+  have "carrier (K[X]) \<subseteq> carrier (K'[X])"
+    using assms(1) unfolding univ_poly_def polynomial_def by auto
+  thus ?thesis
+    using assms unfolding over_def transcendental_def by (metis inj_on_subset)
+qed
+
+corollary (in ring) algebraic_mono:
+  assumes "K \<subseteq> K'" "(algebraic over K) x" shows "(algebraic over K') x"
+  using transcendental_mono[OF assms(1)] assms(2) unfolding over_def by blast 
+
+lemma (in domain) zero_is_algebraic:
+  assumes "subring K R" shows "(algebraic over K) \<zero>"
+  using algebraicI[OF var_closed(1)[OF assms]] unfolding var_def by auto
+
+lemma (in domain) algebraic_self:
+  assumes "subring K R" and "k \<in> K" shows "(algebraic over K) k"
+proof (rule algebraicI[of "[ \<one>, \<ominus> k ]"])
+  show "[ \<one>, \<ominus> k ] \<in> carrier (K [X])" and "[ \<one>, \<ominus> k ] \<noteq> []"
+    using subringE(2-3,5)[OF assms(1)] assms(2) unfolding univ_poly_def polynomial_def by auto
+  have "k \<in> carrier R"
+    using subringE(1)[OF assms(1)] assms(2) by auto
+  thus "eval [ \<one>, \<ominus> k ] k = \<zero>"
+    by (auto, algebra)
+qed
+
+lemma (in domain) ker_diff_carrier:
+  assumes "subring K R"
+  shows "a_kernel (K[X]) R (\<lambda>p. eval p x) \<noteq> carrier (K[X])"
+proof -
+  have "eval [ \<one> ] x \<noteq> \<zero>" and "[ \<one> ] \<in> carrier (K[X])"
+    using subringE(3)[OF assms] unfolding univ_poly_def polynomial_def by auto
+  thus ?thesis
+    unfolding a_kernel_def' by blast
+qed
+
+
+subsection \<open>Minimal Polynomial\<close>
+
+lemma (in domain) minimal_polynomial_is_unique:
+  assumes "subfield K R" and "x \<in> carrier R" "(algebraic over K) x"
+  shows "\<exists>!p \<in> carrier (K[X]). pirreducible K p \<and> eval p x = \<zero> \<and> lead_coeff p = \<one>"
+    (is "\<exists>!p. ?minimal_poly p")
+proof -
+  interpret UP: principal_domain "K[X]"
+    using univ_poly_is_principal[OF assms(1)] .
+
+  let ?ker_gen = "\<lambda>p. p \<in> carrier (K[X]) \<and> pirreducible K p \<and> lead_coeff p = \<one> \<and>
+                    a_kernel (K[X]) R (\<lambda>p. eval p x) = PIdl\<^bsub>K[X]\<^esub> p"
+
+  obtain p where p: "?ker_gen p" and unique: "\<And>q. ?ker_gen q \<Longrightarrow> q = p"
+    using exists_unique_pirreducible_gen[OF assms(1) eval_ring_hom[OF _ assms(2)]
+          algebraic_imp_non_trivial_ker[OF _ assms(2-3)]
+          ker_diff_carrier] subfieldE(1)[OF assms(1)] by auto
+  hence "?minimal_poly p"
+    using UP.cgenideal_self p unfolding a_kernel_def' by auto
+  moreover have "\<And>q. ?minimal_poly q \<Longrightarrow> q = p"
+  proof -
+    fix q assume q: "?minimal_poly q"
+    then have "q \<in> PIdl\<^bsub>K[X]\<^esub> p"
+      using p unfolding a_kernel_def' by auto
+    hence "p \<sim>\<^bsub>K[X]\<^esub> q"
+      using cgenideal_pirreducible[OF assms(1)] p q by simp
+    hence "a_kernel (K[X]) R (\<lambda>p. eval p x) = PIdl\<^bsub>K[X]\<^esub> q"
+      using UP.associated_iff_same_ideal q p by simp
+    thus "q = p"
+      using unique q by simp
+  qed
+  ultimately show ?thesis by blast
+qed
+
+lemma (in domain) IrrE:
+  assumes "subfield K R" and "x \<in> carrier R" "(algebraic over K) x"
+  shows "Irr K x \<in> carrier (K[X])" and "pirreducible K (Irr K x)"
+    and "lead_coeff (Irr K x) = \<one>" and "eval (Irr K x) x = \<zero>"
+  using theI'[OF minimal_polynomial_is_unique[OF assms]] unfolding Irr_def by auto
+
+lemma (in domain) Irr_generates_ker:
+  assumes "subfield K R" and "x \<in> carrier R" "(algebraic over K) x"
+  shows "a_kernel (K[X]) R (\<lambda>p. eval p x) = PIdl\<^bsub>K[X]\<^esub> (Irr K x)"
+proof -
+  obtain q
+    where q: "q \<in> carrier (K[X])" "pirreducible K q"
+      and ker: "a_kernel (K[X]) R (\<lambda>p. eval p x) = PIdl\<^bsub>K[X]\<^esub> q"
+    using exists_unique_pirreducible_gen[OF assms(1) eval_ring_hom[OF _ assms(2)]
+          algebraic_imp_non_trivial_ker[OF _ assms(2-3)]
+          ker_diff_carrier] subfieldE(1)[OF assms(1)] by auto
+  have "Irr K x \<in> PIdl\<^bsub>K[X]\<^esub> q"
+    using IrrE(1,4)[OF assms] ker unfolding a_kernel_def' by auto
+  thus ?thesis
+    using cgenideal_pirreducible[OF assms(1) q(1-2) IrrE(2)[OF assms]] q(1) IrrE(1)[OF assms]
+          cring.associated_iff_same_ideal[OF univ_poly_is_cring[OF subfieldE(1)[OF assms(1)]]]
+    unfolding ker
+    by simp
+qed
+
+lemma (in domain) Irr_minimal:
+  assumes "subfield K R" and "x \<in> carrier R" "(algebraic over K) x"
+    and "p \<in> carrier (K[X])" "eval p x = \<zero>" shows "(Irr K x) pdivides p"
+proof -
+  interpret UP: principal_domain "K[X]"
+    using univ_poly_is_principal[OF assms(1)] .
+
+  have "p \<in> PIdl\<^bsub>K[X]\<^esub> (Irr K x)"
+    using Irr_generates_ker[OF assms(1-3)] assms(4-5) unfolding a_kernel_def' by auto
+  hence "(Irr K x) divides\<^bsub>K[X]\<^esub> p"
+    using UP.to_contain_is_to_divide IrrE(1)[OF assms(1-3)]
+    by (meson UP.cgenideal_ideal UP.cgenideal_minimal assms(4))
+  thus ?thesis
+    unfolding pdivides_iff_shell[OF assms(1) IrrE(1)[OF assms(1-3)] assms(4)] .
+qed
+
+lemma (in domain) rupture_of_Irr:
+  assumes "subfield K R" and "x \<in> carrier R" "(algebraic over K) x" shows "field (Rupt K (Irr K x))"
+  using rupture_is_field_iff_pirreducible[OF assms(1)] IrrE(1-2)[OF assms] by simp
+
+
+subsection \<open>Simple Extensions\<close>
+
+lemma (in ring) simple_extension_consistent:
+  assumes "subring K R" shows "ring.simple_extension (R \<lparr> carrier := K \<rparr>) = simple_extension"
+proof -
+  interpret K: ring "R \<lparr> carrier := K \<rparr>"
+    using subring_is_ring[OF assms] .
+
+  have "\<And>K' x. K.simple_extension  K' x \<subseteq> simple_extension K' x"
+  proof
+    fix K' x a show "a \<in> K.simple_extension  K' x \<Longrightarrow> a \<in> simple_extension K' x"
+      by (induction rule: K.simple_extension.induct) (auto simp add: simple_extension.lin)
+  qed
+  moreover
+  have "\<And>K' x. simple_extension K' x \<subseteq> K.simple_extension  K' x"
+  proof
+    fix K' x a assume a: "a \<in> simple_extension K' x" thus "a \<in> K.simple_extension  K' x"
+      using K.simple_extension.zero K.simple_extension.lin
+      by (induction rule: simple_extension.induct) (simp)+
+  qed
+  ultimately show ?thesis by blast
+qed
+
+lemma (in ring) mono_simple_extension:
+  assumes "K \<subseteq> K'" shows "simple_extension K x \<subseteq> simple_extension K' x"
+proof
+  fix a assume "a \<in> simple_extension K x" thus "a \<in> simple_extension K' x"
+  proof (induct a rule: simple_extension.induct, simp)
+    case lin thus ?case using simple_extension.lin assms by blast
+  qed
+qed
+
+lemma (in ring) simple_extension_incl:
+  assumes "K \<subseteq> carrier R" and "x \<in> carrier R" shows "K \<subseteq> simple_extension K x"
+proof
+  fix k assume "k \<in> K" thus "k \<in> simple_extension K x"
+    using simple_extension.lin[OF simple_extension.zero, of k K x] assms by auto
+qed
+
+lemma (in ring) simple_extension_mem:
+  assumes "subring K R" and "x \<in> carrier R" shows "x \<in> simple_extension K x"
+proof -
+  have "\<one> \<in> simple_extension K x"
+    using simple_extension_incl[OF _ assms(2)] subringE(1,3)[OF assms(1)] by auto
+  thus ?thesis
+    using simple_extension.lin[OF _ subringE(2)[OF assms(1)], of \<one> x] assms(2) by auto
+qed
+
+lemma (in ring) simple_extension_carrier:
+  assumes "x \<in> carrier R" shows "simple_extension (carrier R) x = carrier R"
+proof
+  show "carrier R \<subseteq> simple_extension (carrier R) x"
+    using simple_extension_incl[OF _ assms] by auto
+next
+  show "simple_extension (carrier R) x \<subseteq> carrier R"
+  proof
+    fix a assume "a \<in> simple_extension (carrier R) x" thus "a \<in> carrier R"
+      by (induct a rule: simple_extension.induct) (auto simp add: assms)
+  qed
+qed
+
+lemma (in ring) simple_extension_in_carrier:
+  assumes "K \<subseteq> carrier R" and "x \<in> carrier R" shows "simple_extension K x \<subseteq> carrier R"
+  using mono_simple_extension[OF assms(1), of x] simple_extension_carrier[OF assms(2)] by auto 
+
+lemma (in ring) simple_extension_subring_incl:
+  assumes "subring K' R" and "K \<subseteq> K'" "x \<in> K'" shows "simple_extension K x \<subseteq> K'"
+  using ring.simple_extension_in_carrier[OF subring_is_ring[OF assms(1)]] assms(2-3)
+  unfolding simple_extension_consistent[OF assms(1)] by simp
+
+lemma (in ring) simple_extension_as_eval_img:
+  assumes "K \<subseteq> carrier R" "x \<in> carrier R"
+  shows "simple_extension K x = (\<lambda>p. eval p x) ` carrier (K[X])"
+proof
+  show "simple_extension K x \<subseteq> (\<lambda>p. eval p x) ` carrier (K[X])"
+  proof
+    fix a assume "a \<in> simple_extension K x" thus "a \<in> (\<lambda>p. eval p x) ` carrier (K[X])"
+    proof (induction rule: simple_extension.induct)
+      case zero
+      have "polynomial K []" and "eval [] x = \<zero>"
+        unfolding polynomial_def by simp+
+      thus ?case
+        unfolding univ_poly_carrier by force
+    next
+      case (lin k1 k2)
+      then obtain p where p: "p \<in> carrier (K[X])" "polynomial K p" "eval p x = k1"
+        by (auto simp add: univ_poly_carrier)
+      hence "set p \<subseteq> carrier R" and "k2 \<in> carrier R"
+        using assms(1) lin(2) unfolding polynomial_def by auto
+      hence "eval (normalize (p @ [ k2 ])) x = k1 \<otimes> x \<oplus> k2"
+        using eval_append_aux[of p k2 x] eval_normalize[of "p @ [ k2 ]" x] assms(2) p(3) by auto
+      thus ?case
+        using normalize_gives_polynomial[of "p @ [ k2 ]"] polynomial_incl[OF p(2)] lin(2)
+        unfolding univ_poly_carrier by force
+    qed
+  qed
+next
+  show "(\<lambda>p. eval p x) ` carrier (K[X]) \<subseteq> simple_extension K x"
+  proof
+    fix a assume "a \<in> (\<lambda>p. eval p x) ` carrier (K[X])"
+    then obtain p where p: "set p \<subseteq> K" "eval p x = a"
+      using polynomial_incl unfolding univ_poly_def by auto
+    thus "a \<in> simple_extension K x"
+    proof (induct "length p" arbitrary: p a)
+      case 0 thus ?case
+        using simple_extension.zero by simp
+    next
+      case (Suc n)
+      obtain p' k where p: "p = p' @ [ k ]"
+        using Suc(2) by (metis list.size(3) nat.simps(3) rev_exhaust)
+      hence "a = (eval p' x) \<otimes> x \<oplus> k"
+        using eval_append_aux[of p' k x] Suc(3-4) assms unfolding p by auto
+      moreover have "eval p' x \<in> simple_extension K x"
+        using Suc(1-3) unfolding p by auto
+      ultimately show ?case
+        using simple_extension.lin Suc(3) unfolding p by auto
+    qed
+  qed
+qed
+
+corollary (in domain) simple_extension_is_subring:
+  assumes "subring K R" "x \<in> carrier R" shows "subring (simple_extension K x) R"
+  using ring_hom_ring.img_is_subring[OF eval_ring_hom[OF assms]
+        ring.carrier_is_subring[OF univ_poly_is_ring[OF assms(1)]]]
+        simple_extension_as_eval_img[OF subringE(1)[OF assms(1)] assms(2)]
+  by simp
+
+corollary (in domain) simple_extension_minimal:
+  assumes "subring K R" "x \<in> carrier R"
+  shows "simple_extension K x = \<Inter> { K'. subring K' R \<and> K \<subseteq> K' \<and> x \<in> K' }"
+  using simple_extension_is_subring[OF assms] simple_extension_mem[OF assms]
+        simple_extension_incl[OF subringE(1)[OF assms(1)] assms(2)] simple_extension_subring_incl
+  by blast
+
+corollary (in domain) simple_extension_isomorphism:
+  assumes "subring K R" "x \<in> carrier R"
+  shows "(K[X]) Quot (a_kernel (K[X]) R (\<lambda>p. eval p x)) \<simeq> R \<lparr> carrier := simple_extension K x \<rparr>"
+  using ring_hom_ring.FactRing_iso_set_aux[OF eval_ring_hom[OF assms]]
+        simple_extension_as_eval_img[OF subringE(1)[OF assms(1)] assms(2)]
+  unfolding is_ring_iso_def by auto
+
+corollary (in domain) simple_extension_of_algebraic:
+  assumes "subfield K R" and "x \<in> carrier R" "(algebraic over K) x"
+  shows "Rupt K (Irr K x) \<simeq> R \<lparr> carrier := simple_extension K x \<rparr>"
+  using simple_extension_isomorphism[OF subfieldE(1)[OF assms(1)] assms(2)]
+  unfolding Irr_generates_ker[OF assms] rupture_def by simp
+
+corollary (in domain) simple_extension_of_transcendental:
+  assumes "subring K R" and "x \<in> carrier R" "(transcendental over K) x"
+  shows "K[X] \<simeq> R \<lparr> carrier := simple_extension K x \<rparr>"
+  using simple_extension_isomorphism[OF _ assms(2), of K] assms(1)
+        ring_iso_trans[OF ring.FactRing_zeroideal(2)[OF univ_poly_is_ring]]
+  unfolding transcendental_imp_trivial_ker[OF assms(3)] univ_poly_zero
+  by auto
+
+proposition (in domain) simple_extension_subfield_imp_algebraic:
+  assumes "subring K R" "x \<in> carrier R"
+  shows "subfield (simple_extension K x) R \<Longrightarrow> (algebraic over K) x"
+proof -
+  assume simple_ext: "subfield (simple_extension K x) R" show "(algebraic over K) x"
+  proof (rule ccontr)
+    assume "\<not> (algebraic over K) x" then have "(transcendental over K) x"
+      unfolding over_def by simp
+    then obtain h where h: "h \<in> ring_iso (R \<lparr> carrier := simple_extension K x \<rparr>) (K[X])"
+      using ring_iso_sym[OF univ_poly_is_ring simple_extension_of_transcendental] assms
+      unfolding is_ring_iso_def by blast
+    then interpret Hom: ring_hom_ring "R \<lparr> carrier := simple_extension K x \<rparr>" "K[X]" h
+      using subring_is_ring[OF simple_extension_is_subring[OF assms]]
+            univ_poly_is_ring[OF assms(1)] assms h
+      by (auto simp add: ring_hom_ring_def ring_hom_ring_axioms_def ring_iso_def)
+    have "field (K[X])"
+      using field.ring_iso_imp_img_field[OF subfield_iff(2)[OF simple_ext] h]
+      unfolding Hom.hom_one Hom.hom_zero by simp
+    moreover have "\<not> field (K[X])"
+      using univ_poly_not_field[OF assms(1)] .
+    ultimately show False by simp
+  qed
+qed
+
+proposition (in domain) simple_extension_is_subfield:
+  assumes "subfield K R" "x \<in> carrier R"
+  shows "subfield (simple_extension K x) R \<longleftrightarrow> (algebraic over K) x"
+proof
+  assume alg: "(algebraic over K) x"
+  then obtain h where h: "h \<in> ring_iso (Rupt K (Irr K x)) (R \<lparr> carrier := simple_extension K x \<rparr>)"
+    using simple_extension_of_algebraic[OF assms] unfolding is_ring_iso_def by blast
+  have rupt_field: "field (Rupt K (Irr K x))" and "ring (R \<lparr> carrier := simple_extension K x \<rparr>)"
+    using subring_is_ring[OF simple_extension_is_subring[OF subfieldE(1)]]
+          rupture_of_Irr[OF assms alg] assms by simp+
+  then interpret Hom: ring_hom_ring "Rupt K (Irr K x)" "R \<lparr> carrier := simple_extension K x \<rparr>" h
+    using h cring.axioms(1)[OF domain.axioms(1)[OF field.axioms(1)]]
+    by (auto simp add: ring_hom_ring_def ring_hom_ring_axioms_def ring_iso_def)
+  show "subfield (simple_extension K x) R"
+    using field.ring_iso_imp_img_field[OF rupt_field h] subfield_iff(1)[OF _
+          simple_extension_in_carrier[OF subfieldE(3)[OF assms(1)] assms(2)]]
+    by simp
+next
+  assume simple_ext: "subfield (simple_extension K x) R" thus "(algebraic over K) x"
+    using simple_extension_subfield_imp_algebraic[OF subfieldE(1)[OF assms(1)] assms(2)] by simp
+qed
+
+
+subsection \<open>Link between dimension of K-algebras and algebraic extensions\<close>
+
+lemma (in domain) exp_base_independent:
+  assumes "subfield K R" "x \<in> carrier R" "(algebraic over K) x"
+  shows "independent K (exp_base x (degree (Irr K x)))"
+proof -
+  have "\<And>n. n \<le> degree (Irr K x) \<Longrightarrow> independent K (exp_base x n)"
+  proof -
+    fix n show "n \<le> degree (Irr K x) \<Longrightarrow> independent K (exp_base x n)"
+    proof (induct n, simp add: exp_base_def)
+      case (Suc n)
+      have "x [^] n \<notin> Span K (exp_base x n)"
+      proof (rule ccontr)
+        assume "\<not> x [^] n \<notin> Span K (exp_base x n)"
+        then obtain a Ks
+          where Ks: "a \<in> K - { \<zero> }" "set Ks \<subseteq> K" "length Ks = n" "combine (a # Ks) (exp_base x (Suc n)) = \<zero>"
+          using Span_mem_imp_non_trivial_combine[OF assms(1) exp_base_closed[OF assms(2), of n]]
+          by (auto simp add: exp_base_def)
+        hence "eval (a # Ks) x = \<zero>"
+          using combine_eq_eval by (auto simp add: exp_base_def)
+        moreover have "(a # Ks) \<in> carrier (K[X]) - { [] }"
+          unfolding univ_poly_def polynomial_def using Ks(1-2) by auto
+        ultimately have "degree (Irr K x) \<le> n"
+          using pdivides_imp_degree_le[OF subfieldE(1)[OF assms(1)]
+                IrrE(1)[OF assms] _ _  Irr_minimal[OF assms, of "a # Ks"]] Ks(3) by auto
+        from \<open>Suc n \<le> degree (Irr K x)\<close> and this show False by simp
+      qed
+      thus ?case
+        using independent.li_Cons assms(2) Suc by (auto simp add: exp_base_def)
+    qed
+  qed
+  thus ?thesis
+    by simp
+qed
+
+lemma (in ring) Span_eq_eval_img:
+  assumes "subfield K R" "x \<in> carrier R"
+  shows "Span K (exp_base x n) = (\<lambda>p. eval p x) ` { p \<in> carrier (K[X]). length p \<le> n }"
+    (is "?Span = ?eval_img")
+proof
+  show "?Span \<subseteq> ?eval_img"
+  proof
+    fix u assume "u \<in> Span K (exp_base x n)"
+    then obtain Ks where Ks: "set Ks \<subseteq> K" "length Ks = n" "u = combine Ks (exp_base x n)"
+      using Span_eq_combine_set_length_version[OF assms(1) exp_base_closed[OF assms(2)]]
+      by (auto simp add: exp_base_def)
+    hence "u = eval (normalize Ks) x"
+      using combine_eq_eval eval_normalize[OF _ assms(2)] subfieldE(3)[OF assms(1)] by auto
+    moreover have "normalize Ks \<in> carrier (K[X])"
+      using normalize_gives_polynomial[OF Ks(1)] unfolding univ_poly_def by auto
+    moreover have "length (normalize Ks) \<le> n"
+      using normalize_length_le[of Ks] Ks(2) by auto
+    ultimately show "u \<in> ?eval_img" by auto
+  qed
+next
+  show "?eval_img \<subseteq> ?Span"
+  proof
+    fix u assume "u \<in> ?eval_img"
+    then obtain p where p: "p \<in> carrier (K[X])" "length p \<le> n" "u = eval p x"
+      by blast
+    hence "combine p (exp_base x (length p)) = u"
+      using combine_eq_eval by auto
+    moreover have set_p: "set p \<subseteq> K"
+      using polynomial_incl[of K p] p(1) unfolding univ_poly_carrier by auto
+    hence "set p \<subseteq> carrier R"
+      using subfieldE(3)[OF assms(1)] by auto 
+    moreover have "drop (n - length p) (exp_base x n) = exp_base x (length p)"
+      using p(2) drop_exp_base by auto
+    ultimately have "combine ((replicate (n - length p) \<zero>) @ p) (exp_base x n) = u"
+      using combine_prepend_replicate[OF _ exp_base_closed[OF assms(2), of n]] by auto
+    moreover have "set ((replicate (n - length p) \<zero>) @ p) \<subseteq> K"
+      using subringE(2)[OF subfieldE(1)[OF assms(1)]] set_p by auto
+    ultimately show "u \<in> ?Span"
+      using Span_eq_combine_set[OF assms(1) exp_base_closed[OF assms(2), of n]] by blast
+  qed
+qed
+
+lemma (in domain) Span_exp_base:
+  assumes "subfield K R" "x \<in> carrier R" "(algebraic over K) x"
+  shows "Span K (exp_base x (degree (Irr K x))) = simple_extension K x"
+  unfolding simple_extension_as_eval_img[OF subfieldE(3)[OF assms(1)] assms(2)]
+            Span_eq_eval_img[OF assms(1-2)]
+proof (auto)
+  interpret UP: principal_domain "K[X]"
+    using univ_poly_is_principal[OF assms(1)] .
+  note hom_simps = ring_hom_memE[OF eval_is_hom[OF subfieldE(1)[OF assms(1)] assms(2)]]
+
+  fix p assume p: "p \<in> carrier (K[X])"
+  have Irr: "Irr K x \<in> carrier (K[X])" "Irr K x \<noteq> []"
+    using IrrE(1-2)[OF assms] unfolding ring_irreducible_def univ_poly_zero by auto 
+  then obtain q r
+    where q: "q \<in> carrier (K[X])" and r: "r \<in> carrier (K[X])"
+      and dvd: "p = Irr K x \<otimes>\<^bsub>K [X]\<^esub> q \<oplus>\<^bsub>K [X]\<^esub> r" "r = [] \<or> degree r < degree (Irr K x)"
+    using subfield_long_division_theorem_shell[OF assms(1) p Irr(1)] unfolding univ_poly_zero by auto
+  hence "eval p x = (eval (Irr K x) x) \<otimes> (eval q x) \<oplus> (eval r x)"
+    using hom_simps(2-3) Irr(1) by simp
+  hence "eval p x = eval r x"
+    using hom_simps(1) q r unfolding IrrE(4)[OF assms] by simp
+  moreover have "length r < length (Irr K x)"
+    using dvd(2) Irr(2) by auto
+  ultimately
+  show "eval p x \<in> (\<lambda>p. local.eval p x) ` { p \<in> carrier (K [X]). length p \<le> length (Irr K x) - Suc 0 }"
+    using r by auto
+qed
+
+corollary (in domain) dimension_simple_extension:
+  assumes "subfield K R" "x \<in> carrier R" "(algebraic over K) x"
+  shows "dimension (degree (Irr K x)) K (simple_extension K x)"
+  using dimension_independent[OF exp_base_independent[OF assms]] Span_exp_base[OF assms]
+  by (simp add: exp_base_def)
+
+lemma (in ring) finite_dimension_imp_algebraic:
+  assumes "subfield K R" "subring F R" and "finite_dimension K F"
+  shows "x \<in> F \<Longrightarrow> (algebraic over K) x"
+proof -
+  let ?Us = "\<lambda>n. map (\<lambda>i. x [^] i) (rev [0..< Suc n])"
+
+  assume x: "x \<in> F" then have in_carrier: "x \<in> carrier R"
+    using subringE[OF assms(2)] by auto
+  obtain n where n: "dimension n K F"
+    using assms(3) by auto
+  have set_Us: "set (?Us n) \<subseteq> F"
+    using x subringE(3,6)[OF assms(2)] by (induct n) (auto)
+  hence "set (?Us n) \<subseteq> carrier R"
+    using subringE(1)[OF assms(2)] by auto
+  moreover have "dependent K (?Us n)"
+    using independent_length_le_dimension[OF assms(1) n _ set_Us] by auto
+  ultimately
+  obtain Ks where Ks: "length Ks = Suc n" "combine Ks (?Us n) = \<zero>" "set Ks \<subseteq> K" "set Ks \<noteq> { \<zero> }"
+    using dependent_imp_non_trivial_combine[OF assms(1), of "?Us n"] by auto
+  have "set Ks \<subseteq> carrier R"
+    using subring_props(1)[OF assms(1)] Ks(3) by auto 
+  hence "eval (normalize Ks) x = \<zero>"
+    using combine_eq_eval[of Ks] eval_normalize[OF _ in_carrier] Ks(1-2) by (simp add: exp_base_def)
+  moreover have "normalize Ks = [] \<Longrightarrow> set Ks \<subseteq> { \<zero> }"
+    by (induct Ks) (auto, meson list.discI,
+                    metis all_not_in_conv list.discI list.sel(3) singletonD subset_singletonD)
+  hence "normalize Ks \<noteq> []"
+    using Ks(1,4) by (metis list.size(3) nat.distinct(1) set_empty subset_singleton_iff)
+  moreover have "normalize Ks \<in> carrier (K[X])"
+    using normalize_gives_polynomial[OF Ks(3)] unfolding univ_poly_def by auto
+  ultimately show ?thesis
+    using algebraicI by auto
+qed
+
+corollary (in domain) simple_extension_dim:
+  assumes "subfield K R" "x \<in> carrier R" "(algebraic over K) x"
+  shows "(dim over K) (simple_extension K x) = degree (Irr K x)"
+  using dimI[OF assms(1) dimension_simple_extension[OF assms]] .
+
+corollary (in domain) finite_dimension_simple_extension:
+  assumes "subfield K R" "x \<in> carrier R"
+  shows "finite_dimension K (simple_extension K x) \<longleftrightarrow> (algebraic over K) x"
+  using finite_dimensionI[OF dimension_simple_extension[OF assms]]
+        finite_dimension_imp_algebraic[OF _ simple_extension_is_subring[OF subfieldE(1)]]
+        simple_extension_mem[OF subfieldE(1)] assms
+  by auto
+
+
+subsection \<open>Finite Extensions\<close>
+
+lemma (in ring) finite_extension_consistent:
+  assumes "subring K R" shows "ring.finite_extension (R \<lparr> carrier := K \<rparr>) = finite_extension"
+proof -
+  have "\<And>K' xs. ring.finite_extension (R \<lparr> carrier := K \<rparr>) K' xs = finite_extension K' xs"
+  proof -
+    fix K' xs show "ring.finite_extension (R \<lparr> carrier := K \<rparr>) K' xs = finite_extension K' xs"
+      using ring.finite_extension.simps[OF subring_is_ring[OF assms]]
+            simple_extension_consistent[OF assms] by (induct xs) (auto)
+  qed
+  thus ?thesis by blast
+qed
+
+lemma (in ring) mono_finite_extension:
+  assumes "K \<subseteq> K'" shows "finite_extension K xs \<subseteq> finite_extension K' xs"
+  using mono_simple_extension assms by (induct xs) (auto)
+
+lemma (in ring) finite_extension_carrier:
+  assumes "set xs \<subseteq> carrier R" shows "finite_extension (carrier R) xs = carrier R"
+  using assms simple_extension_carrier by (induct xs) (auto)
+
+lemma (in ring) finite_extension_in_carrier:
+  assumes "K \<subseteq> carrier R" and "set xs \<subseteq> carrier R" shows "finite_extension K xs \<subseteq> carrier R"
+  using assms simple_extension_in_carrier by (induct xs) (auto)
+
+lemma (in ring) finite_extension_subring_incl:
+  assumes "subring K' R" and "K \<subseteq> K'" "set xs \<subseteq> K'" shows "finite_extension K xs \<subseteq> K'"
+  using ring.finite_extension_in_carrier[OF subring_is_ring[OF assms(1)]] assms(2-3)
+  unfolding finite_extension_consistent[OF assms(1)] by simp
+
+lemma (in ring) finite_extension_incl_aux:
+  assumes "K \<subseteq> carrier R" and "x \<in> carrier R" "set xs \<subseteq> carrier R"
+  shows "finite_extension K xs \<subseteq> finite_extension K (x # xs)"
+  using simple_extension_incl[OF finite_extension_in_carrier[OF assms(1,3)] assms(2)] by simp
+
+lemma (in ring) finite_extension_incl:
+  assumes "K \<subseteq> carrier R" and "set xs \<subseteq> carrier R" shows "K \<subseteq> finite_extension K xs"
+  using finite_extension_incl_aux[OF assms(1)] assms(2) by (induct xs) (auto)
+
+lemma (in ring) finite_extension_as_eval_img:
+  assumes "K \<subseteq> carrier R" and "x \<in> carrier R" "set xs \<subseteq> carrier R"
+  shows "finite_extension K (x # xs) = (\<lambda>p. eval p x) ` carrier ((finite_extension K xs) [X])"
+  using simple_extension_as_eval_img[OF finite_extension_in_carrier[OF assms(1,3)] assms(2)] by simp
+
+lemma (in domain) finite_extension_is_subring:
+  assumes "subring K R" "set xs \<subseteq> carrier R" shows "subring (finite_extension K xs) R"
+  using assms simple_extension_is_subring by (induct xs) (auto)
+
+corollary (in domain) finite_extension_mem:
+  assumes "subring K R" "set xs \<subseteq> carrier R" shows "set xs \<subseteq> finite_extension K xs"
+proof -
+  { fix x xs assume "x \<in> carrier R" "set xs \<subseteq> carrier R"
+    hence "x \<in> finite_extension K (x # xs)"
+      using simple_extension_mem[OF finite_extension_is_subring[OF assms(1), of xs]] by simp }
+  note aux_lemma = this
+  show ?thesis
+    using aux_lemma finite_extension_incl_aux[OF subringE(1)[OF assms(1)]] assms(2)
+    by (induct xs) (simp, smt insert_subset list.simps(15) subset_trans) 
+qed
+
+corollary (in domain) finite_extension_minimal:
+  assumes "subring K R" "set xs \<subseteq> carrier R"
+  shows "finite_extension K xs = \<Inter> { K'. subring K' R \<and> K \<subseteq> K' \<and> set xs \<subseteq> K' }"
+  using finite_extension_is_subring[OF assms] finite_extension_mem[OF assms]
+        finite_extension_incl[OF subringE(1)[OF assms(1)] assms(2)] finite_extension_subring_incl
+  by blast
+
+corollary (in domain) finite_extension_same_set:
+  assumes "subring K R" "set xs \<subseteq> carrier R" "set xs = set ys"
+  shows "finite_extension K xs = finite_extension K ys"
+  using finite_extension_minimal[OF assms(1)] assms(2-3) by auto
+
+text \<open>The reciprocal is also true, but it is more subtle.\<close>
+proposition (in domain) finite_extension_is_subfield:
+  assumes "subfield K R" "set xs \<subseteq> carrier R"
+  shows "(\<And>x. x \<in> set xs \<Longrightarrow> (algebraic over K) x) \<Longrightarrow> subfield (finite_extension K xs) R"
+  using simple_extension_is_subfield algebraic_mono assms
+  by (induct xs) (auto, metis finite_extension.simps finite_extension_incl subring_props(1))
+
+proposition (in domain) finite_extension_finite_dimension:
+  assumes "subfield K R" "set xs \<subseteq> carrier R"
+  shows "(\<And>x. x \<in> set xs \<Longrightarrow> (algebraic over K) x) \<Longrightarrow> finite_dimension K (finite_extension K xs)"
+    and "finite_dimension K (finite_extension K xs) \<Longrightarrow> (\<And>x. x \<in> set xs \<Longrightarrow> (algebraic over K) x)"
+proof -
+  show "finite_dimension K (finite_extension K xs) \<Longrightarrow> (\<And>x. x \<in> set xs \<Longrightarrow> (algebraic over K) x)"
+    using finite_dimension_imp_algebraic[OF assms(1)
+          finite_extension_is_subring[OF subfieldE(1)[OF assms(1)] assms(2)]]
+          finite_extension_mem[OF subfieldE(1)[OF assms(1)] assms(2)] by auto
+next
+  show "(\<And>x. x \<in> set xs \<Longrightarrow> (algebraic over K) x) \<Longrightarrow> finite_dimension K (finite_extension K xs)"
+    using assms(2)
+  proof (induct xs, simp add: finite_dimensionI[OF dimension_one[OF assms(1)]])
+    case (Cons x xs)
+    hence "finite_dimension K (finite_extension K xs)"
+      by auto
+    moreover have "(algebraic over (finite_extension K xs)) x"
+      using algebraic_mono[OF finite_extension_incl[OF subfieldE(3)[OF assms(1)]]] Cons(2-3) by auto
+    moreover have "subfield (finite_extension K xs) R"
+      using finite_extension_is_subfield[OF assms(1)] Cons(2-3) by auto
+    ultimately show ?case
+      using telescopic_base_dim(1)[OF assms(1) _ _ 
+            finite_dimensionI[OF dimension_simple_extension, of _ x]] Cons(3) by auto
+  qed
+qed
+
+corollary (in domain) finite_extesion_mem_imp_algebraic:
+  assumes "subfield K R" "set xs \<subseteq> carrier R" and "\<And>x. x \<in> set xs \<Longrightarrow> (algebraic over K) x"
+  shows "y \<in> finite_extension K xs \<Longrightarrow> (algebraic over K) y"
+  using finite_dimension_imp_algebraic[OF assms(1)
+        finite_extension_is_subring[OF subfieldE(1)[OF assms(1)] assms(2)]]
+        finite_extension_finite_dimension(1)[OF assms(1-2)] assms(3) by auto
+
+corollary (in domain) simple_extesion_mem_imp_algebraic:
+  assumes "subfield K R" "x \<in> carrier R" "(algebraic over K) x"
+  shows "y \<in> simple_extension K x \<Longrightarrow> (algebraic over K) y"
+  using finite_extesion_mem_imp_algebraic[OF assms(1), of "[ x ]"] assms(2-3) by auto
+
+
+subsection \<open>Arithmetic of algebraic numbers\<close>
+
+text \<open>We show that the set of algebraic numbers of a field
+      over a subfield K is a subfield itself.\<close>
+
+lemma (in field) subfield_of_algebraics:
+  assumes "subfield K R" shows "subfield { x \<in> carrier R. (algebraic over K) x } R"
+proof -
+  let ?set_of_algebraics = "{ x \<in> carrier R. (algebraic over K) x }"
+
+  show ?thesis
+  proof (rule subfieldI'[OF subringI])
+    show "?set_of_algebraics \<subseteq> carrier R" and "\<one> \<in> ?set_of_algebraics"
+      using algebraic_self[OF _ subringE(3)] subfieldE(1)[OF assms(1)] by auto
+  next
+    fix x y assume x: "x \<in> ?set_of_algebraics" and y: "y \<in> ?set_of_algebraics"
+    have "\<ominus> x \<in> simple_extension K x"
+      using subringE(5)[OF simple_extension_is_subring[OF subfieldE(1)]]
+            simple_extension_mem[OF subfieldE(1)] assms(1) x by auto
+    thus "\<ominus> x \<in> ?set_of_algebraics"
+      using simple_extesion_mem_imp_algebraic[OF assms] x by auto
+
+    have "x \<oplus> y \<in> finite_extension K [ x, y ]" and "x \<otimes> y \<in> finite_extension K [ x, y ]"
+      using subringE(6-7)[OF finite_extension_is_subring[OF subfieldE(1)[OF assms(1)]], of "[ x, y ]"]
+            finite_extension_mem[OF subfieldE(1)[OF assms(1)], of "[ x, y ]"] x y by auto
+    thus "x \<oplus> y \<in> ?set_of_algebraics" and "x \<otimes> y \<in> ?set_of_algebraics"
+      using finite_extesion_mem_imp_algebraic[OF assms, of "[ x, y ]"] x y by auto
+  next
+    fix z assume z: "z \<in> ?set_of_algebraics - { \<zero> }"
+    have "inv z \<in> simple_extension K z"
+      using subfield_m_inv(1)[of "simple_extension K z"]
+            simple_extension_is_subfield[OF assms, of z]
+            simple_extension_mem[OF subfieldE(1)] assms(1) z by auto
+    thus "inv z \<in> ?set_of_algebraics"
+      using simple_extesion_mem_imp_algebraic[OF assms] field_Units z by auto
+  qed
+qed
+
+
+(*
+proposition (in domain) finite_extension_is_subfield:
+  assumes "subfield K R" "set xs \<subseteq> carrier R"
+  shows "subfield (finite_extension K xs) R \<longleftrightarrow> (algebraic_set over K) (set xs)"
+proof
+  have "(\<And>x. x \<in> set xs \<Longrightarrow> (algebraic over K) x) \<Longrightarrow> subfield (finite_extension K xs) R"
+    using simple_extension_is_subfield algebraic_mono assms
+    by (induct xs) (auto, metis finite_extension.simps finite_extension_incl subring_props(1))
+  thus "(algebraic_set over K) (set xs) \<Longrightarrow> subfield (finite_extension K xs) R"
+    unfolding algebraic_set_def over_def by auto
+next
+  { fix x xs
+    assume x: "x \<in> carrier R" and xs: "set xs \<subseteq> carrier R"
+      and is_subfield: "subfield (finite_extension K (x # xs)) R"
+    hence "(algebraic over K) x" sorry }
+
+  assume "subfield (finite_extension K xs) R" thus "(algebraic_set over K) (set xs)"
+    using assms(2)
+  proof (induct xs)
+    case Nil thus ?case
+      unfolding algebraic_set_def over_def by simp
+  next
+    case (Cons x xs)
+    have "(algebraic over K) x"
+      using simple_extension_subfield_imp_algebraic[OF 
+            finite_extension_is_subring[of K xs], of x]
+
+    then show ?case sorry
+  qed
+qed
+*)
+
+(*
+lemma (in ring) transcendental_imp_trivial_ker:
+  assumes "x \<in> carrier R"
+  shows "(transcendental over K) x \<Longrightarrow> (\<And>p. \<lbrakk> polynomial R p; set p \<subseteq> K \<rbrakk> \<Longrightarrow> eval p x = \<zero> \<Longrightarrow> p = [])"
+proof -
+  fix p assume "(transcendental over K) x" "polynomial R p" "eval p x = \<zero>" "set p \<subseteq> K"
+  moreover have "eval [] x = \<zero>" and "polynomial R []"
+    using assms zero_is_polynomial by auto
+  ultimately show "p = []"
+    unfolding over_def transcendental_def inj_on_def by auto
+qed
+
+lemma (in domain) trivial_ker_imp_transcendental:
+  assumes "subring K R" and "x \<in> carrier R"
+  shows "(\<And>p. \<lbrakk> polynomial R p; set p \<subseteq> K \<rbrakk> \<Longrightarrow> eval p x = \<zero> \<Longrightarrow> p = []) \<Longrightarrow> (transcendental over K) x"
+proof -
+  assume "\<And>p. \<lbrakk> polynomial R p; set p \<subseteq> K \<rbrakk> \<Longrightarrow> eval p x = \<zero> \<Longrightarrow> p = []"
+  hence "a_kernel (univ_poly (R \<lparr> carrier := K \<rparr>)) R (\<lambda>p. local.eval p x) = { [] }"
+    unfolding a_kernel_def' univ_poly_subring_def'[OF assms(1)] by auto
+  moreover have "[] = \<zero>\<^bsub>(univ_poly (R \<lparr> carrier := K \<rparr>))\<^esub>"
+    unfolding univ_poly_def by auto
+  ultimately have "inj_on (\<lambda>p. local.eval p x) (carrier (univ_poly (R \<lparr> carrier := K \<rparr>)))"
+    using ring_hom_ring.trivial_ker_imp_inj[OF eval_ring_hom[OF assms]] by auto
+  thus "(transcendental over K) x"
+    unfolding over_def transcendental_def univ_poly_subring_def'[OF assms(1)] by simp
+qed
+
+lemma (in ring) non_trivial_ker_imp_algebraic:
+  assumes "x \<in> carrier R"
+    and "p \<noteq> []" "polynomial R p" "set p \<subseteq> K" "eval p x = \<zero>"
+  shows "(algebraic over K) x"
+  using transcendental_imp_trivial_ker[OF assms(1) _ assms(3-5)] assms(2)
+  unfolding over_def algebraic_def by auto
+
+lemma (in domain) algebraic_imp_non_trivial_ker:
+  assumes "subring K R" "x \<in> carrier R"
+  shows "(algebraic over K) x \<Longrightarrow> (\<exists>p \<noteq> []. polynomial R p \<and> set p \<subseteq> K \<and> eval p x = \<zero>)"
+  using trivial_ker_imp_transcendental[OF assms]
+  unfolding over_def algebraic_def by auto
+
+lemma (in domain) algebraic_iff:
+  assumes "subring K R" "x \<in> carrier R"
+  shows "(algebraic over K) x \<longleftrightarrow> (\<exists>p \<noteq> []. polynomial R p \<and> set p \<subseteq> K \<and> eval p x = \<zero>)"
+  using non_trivial_ker_imp_algebraic[OF assms(2)] algebraic_imp_non_trivial_ker[OF assms] by auto
+*)
+
+
+(*
+lemma (in field)
+  assumes "subfield K R"
+  shows "subfield (simple_extension K x) R \<longleftrightarrow> (algebraic over K) x"
+  sorry
+
+*)
+end
\ No newline at end of file
diff -r 57503fe1b0ff -r 615233977155 src/HOL/Algebra/Indexed_Polynomials.thy
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Algebra/Indexed_Polynomials.thy	Sun Apr 14 12:00:17 2019 +0100
@@ -0,0 +1,549 @@
+(*  Title:      HOL/Algebra/Indexed_Polynomials.thy
+    Author:     Paulo Emílio de Vilhena
+*)
+
+theory Indexed_Polynomials
+  imports Weak_Morphisms "HOL-Library.Multiset" Polynomial_Divisibility
+    
+begin
+
+section \<open>Indexed Polynomials\<close>
+
+text \<open>In this theory, we build a basic framework to the study of polynomials on letters
+      indexed by a set. The main interest is to then apply these concepts to the construction
+      of the algebraic closure of a field. \<close>
+
+
+subsection \<open>Definitions\<close>
+
+text \<open>We formalize indexed monomials as multisets with its support a subset of the index set.
+      On top of those, we build indexed polynomials which are simply functions mapping a monomial
+      to its coefficient. \<close>
+
+definition (in ring) indexed_const :: "'a \<Rightarrow> ('c multiset \<Rightarrow> 'a)" 
+  where "indexed_const k = (\<lambda>m. if m = {#} then k else \<zero>)"
+
+definition (in ring) indexed_pmult :: "('c multiset \<Rightarrow> 'a) \<Rightarrow> 'c \<Rightarrow> ('c multiset \<Rightarrow> 'a)" (infixl "\<Otimes>" 65)
+  where "indexed_pmult P i = (\<lambda>m. if i \<in># m then P (m - {# i #}) else \<zero>)"
+
+definition (in ring) indexed_padd :: "_ \<Rightarrow> _ \<Rightarrow> ('c multiset \<Rightarrow> 'a)" (infixl "\<Oplus>" 65)
+  where "indexed_padd P Q = (\<lambda>m. (P m) \<oplus> (Q m))"
+
+definition (in ring) indexed_var :: "'c \<Rightarrow> ('c multiset \<Rightarrow> 'a)" ("\<X>\<index>")
+  where "indexed_var i = (indexed_const \<one>) \<Otimes> i"
+
+definition (in ring) index_free :: "('c multiset \<Rightarrow> 'a) \<Rightarrow> 'c \<Rightarrow> bool"
+  where "index_free P i \<longleftrightarrow> (\<forall>m. i \<in># m \<longrightarrow> P m = \<zero>)"
+
+definition (in ring) carrier_coeff :: "('c multiset \<Rightarrow> 'a) \<Rightarrow> bool"
+  where "carrier_coeff P \<longleftrightarrow> (\<forall>m. P m \<in> carrier R)"
+
+inductive_set (in ring) indexed_pset :: "'c set \<Rightarrow> 'a set \<Rightarrow> ('c multiset \<Rightarrow> 'a) set" ("_ [\<X>\<index>]" 80)
+  for I and K where
+    indexed_const:  "k \<in> K \<Longrightarrow> indexed_const k \<in> (K[\<X>\<^bsub>I\<^esub>])"
+  | indexed_padd:  "\<lbrakk> P \<in> (K[\<X>\<^bsub>I\<^esub>]); Q \<in> (K[\<X>\<^bsub>I\<^esub>]) \<rbrakk> \<Longrightarrow> P \<Oplus> Q \<in> (K[\<X>\<^bsub>I\<^esub>])"
+  | indexed_pmult: "\<lbrakk> P \<in> (K[\<X>\<^bsub>I\<^esub>]); i \<in> I \<rbrakk> \<Longrightarrow> P \<Otimes> i \<in> (K[\<X>\<^bsub>I\<^esub>])"
+
+fun (in ring) indexed_eval_aux :: "('c multiset \<Rightarrow> 'a) list \<Rightarrow> 'c \<Rightarrow> ('c multiset \<Rightarrow> 'a)"
+  where "indexed_eval_aux Ps i = foldr (\<lambda>P Q. (Q \<Otimes> i) \<Oplus> P) Ps (indexed_const \<zero>)"
+
+fun (in ring) indexed_eval :: "('c multiset \<Rightarrow> 'a) list \<Rightarrow> 'c \<Rightarrow> ('c multiset \<Rightarrow> 'a)"
+  where "indexed_eval Ps i = indexed_eval_aux (rev Ps) i"
+
+
+subsection \<open>Basic Properties\<close>
+
+lemma (in ring) carrier_coeffE:
+  assumes "carrier_coeff P" shows "P m \<in> carrier R"
+  using assms unfolding carrier_coeff_def by simp
+
+lemma (in ring) indexed_zero_def: "indexed_const \<zero> = (\<lambda>_. \<zero>)"
+  unfolding indexed_const_def by simp
+
+lemma (in ring) indexed_const_index_free: "index_free (indexed_const k) i"
+  unfolding index_free_def indexed_const_def by auto
+
+lemma (in domain) indexed_var_not_index_free: "\<not> index_free \<X>\<^bsub>i\<^esub> i"
+proof -
+  have "\<X>\<^bsub>i\<^esub> {# i #} = \<one>"
+    unfolding indexed_var_def indexed_pmult_def indexed_const_def by simp
+  thus ?thesis
+    using one_not_zero unfolding index_free_def by fastforce 
+qed
+
+lemma (in ring) indexed_pmult_zero [simp]:
+  shows "indexed_pmult (indexed_const \<zero>) i = indexed_const \<zero>"
+  unfolding indexed_zero_def indexed_pmult_def by auto
+
+lemma (in ring) indexed_padd_zero:
+  assumes "carrier_coeff P" shows "P \<Oplus> (indexed_const \<zero>) = P" and "(indexed_const \<zero>) \<Oplus> P = P"
+  using assms unfolding carrier_coeff_def indexed_zero_def indexed_padd_def by auto
+
+lemma (in ring) indexed_padd_const:
+  shows "(indexed_const k1) \<Oplus> (indexed_const k2) = indexed_const (k1 \<oplus> k2)"
+  unfolding indexed_padd_def indexed_const_def by auto
+
+lemma (in ring) indexed_const_in_carrier:
+  assumes "K \<subseteq> carrier R" and "k \<in> K" shows "\<And>m. (indexed_const k) m \<in> carrier R"
+  using assms unfolding indexed_const_def by auto
+
+lemma (in ring) indexed_padd_in_carrier:
+  assumes "carrier_coeff P" and "carrier_coeff Q" shows "carrier_coeff (indexed_padd P Q)"
+  using assms unfolding carrier_coeff_def indexed_padd_def by simp
+
+lemma (in ring) indexed_pmult_in_carrier:
+  assumes "carrier_coeff P" shows "carrier_coeff (P \<Otimes> i)"
+  using assms unfolding carrier_coeff_def indexed_pmult_def by simp
+
+lemma (in ring) indexed_eval_aux_in_carrier:
+  assumes "list_all carrier_coeff Ps" shows "carrier_coeff (indexed_eval_aux Ps i)"
+  using assms unfolding carrier_coeff_def
+  by (induct Ps) (auto simp add: indexed_zero_def indexed_padd_def indexed_pmult_def)
+
+lemma (in ring) indexed_eval_in_carrier:
+  assumes "list_all carrier_coeff Ps" shows "carrier_coeff (indexed_eval Ps i)"
+  using assms indexed_eval_aux_in_carrier[of "rev Ps"] by auto
+
+lemma (in ring) indexed_pset_in_carrier:
+  assumes "K \<subseteq> carrier R" and "P \<in> (K[\<X>\<^bsub>I\<^esub>])" shows "carrier_coeff P"
+  using assms(2,1) indexed_const_in_carrier unfolding carrier_coeff_def
+  by (induction) (auto simp add: indexed_zero_def indexed_padd_def indexed_pmult_def)
+
+
+subsection \<open>Indexed Eval\<close>
+
+lemma (in ring) exists_indexed_eval_aux_monomial:
+  assumes "carrier_coeff P" and "list_all carrier_coeff Qs"
+    and "count n i = k" and "P n \<noteq> \<zero>" and "list_all (\<lambda>Q. index_free Q i) Qs"
+  obtains m where "count m i = length Qs + k" and "(indexed_eval_aux (Qs @ [ P ]) i) m \<noteq> \<zero>"
+proof -
+  from assms(2,5) have "\<exists>m. count m i = length Qs + k \<and> (indexed_eval_aux (Qs @ [ P ]) i) m \<noteq> \<zero>"
+  proof (induct Qs)
+    case Nil thus ?case
+      using indexed_padd_zero(2)[OF assms(1)] assms(3-4) by auto
+  next
+    case (Cons Q Qs)
+    then obtain m where m: "count m i = length Qs + k" "(indexed_eval_aux (Qs @ [ P ]) i) m \<noteq> \<zero>"
+      by auto
+    define m' where "m' = m + {# i #}"
+    hence "Q m' = \<zero>"
+      using Cons(3) unfolding index_free_def by simp
+    moreover have "(indexed_eval_aux (Qs @ [ P ]) i) m \<in> carrier R"
+      using indexed_eval_aux_in_carrier[of "Qs @ [ P ]" i] Cons(2) assms(1) carrier_coeffE by auto
+    hence "((indexed_eval_aux (Qs @ [ P ]) i) \<Otimes> i) m' \<in> carrier R - { \<zero> }"
+      using m unfolding indexed_pmult_def m'_def by simp
+    ultimately have "(indexed_eval_aux (Q # (Qs @ [ P ])) i) m' \<noteq> \<zero>"
+      by (auto simp add: indexed_padd_def)
+    moreover from \<open>count m i = length Qs + k\<close> have "count m' i = length (Q # Qs) + k"
+      unfolding m'_def by simp
+    ultimately show ?case
+      by auto
+  qed
+  thus thesis
+    using that by blast
+qed
+
+lemma (in ring) indexed_eval_aux_monomial_degree_le:
+  assumes "list_all carrier_coeff Ps" and "list_all (\<lambda>P. index_free P i) Ps"
+    and "(indexed_eval_aux Ps i) m \<noteq> \<zero>" shows "count m i \<le> length Ps - 1"
+  using assms(1-3)
+proof (induct Ps arbitrary: m, simp add: indexed_zero_def)
+  case (Cons P Ps) show ?case
+  proof (cases "count m i = 0", simp)
+    assume "count m i \<noteq> 0"
+    hence "P m = \<zero>"
+      using Cons(3) unfolding index_free_def by simp
+    moreover have "(indexed_eval_aux Ps i) m \<in> carrier R"
+      using carrier_coeffE[OF indexed_eval_aux_in_carrier[of Ps i]] Cons(2) by simp 
+    ultimately have "((indexed_eval_aux Ps i) \<Otimes> i) m \<noteq> \<zero>"
+      using Cons(4) by (auto simp add: indexed_padd_def)
+    with \<open>count m i \<noteq> 0\<close> have "(indexed_eval_aux Ps i) (m - {# i #}) \<noteq> \<zero>"
+      unfolding indexed_pmult_def by (auto simp del: indexed_eval_aux.simps)
+    hence "count m i - 1 \<le> length Ps - 1"
+      using Cons(1)[of "m - {# i #}"] Cons(2-3) by auto
+    moreover from \<open>(indexed_eval_aux Ps i) (m - {# i #}) \<noteq> \<zero>\<close> have "length Ps > 0"
+      by (auto simp add: indexed_zero_def)
+    moreover from \<open>count m i \<noteq> 0\<close> have "count m i > 0"
+      by simp
+    ultimately show ?thesis
+      by (simp add: Suc_leI le_diff_iff)
+  qed
+qed
+
+lemma (in ring) indexed_eval_aux_is_inj:
+  assumes "list_all carrier_coeff Ps" and "list_all (\<lambda>P. index_free P i) Ps"
+      and "list_all carrier_coeff Qs" and "list_all (\<lambda>Q. index_free Q i) Qs"
+    and "indexed_eval_aux Ps i = indexed_eval_aux Qs i" and "length Ps = length Qs"
+  shows "Ps = Qs"
+  using assms
+proof (induct Ps arbitrary: Qs, simp)
+  case (Cons P Ps)
+  from \<open>length (P # Ps) = length Qs\<close> obtain Q' Qs' where Qs: "Qs = Q' # Qs'" and "length Ps = length Qs'"
+    by (metis Suc_length_conv)
+
+  have in_carrier:
+    "((indexed_eval_aux Ps  i) \<Otimes> i) m \<in> carrier R" "P  m \<in> carrier R"
+    "((indexed_eval_aux Qs' i) \<Otimes> i) m \<in> carrier R" "Q' m \<in> carrier R" for m
+    using indexed_eval_aux_in_carrier[of Ps  i]
+          indexed_eval_aux_in_carrier[of Qs' i] Cons(2,4) carrier_coeffE
+    unfolding Qs indexed_pmult_def by auto
+
+  have "(indexed_eval_aux (P # Ps) i) m = (indexed_eval_aux (Q' # Qs') i) m" for m
+    using Cons(6) unfolding Qs by simp
+  hence eq: "((indexed_eval_aux Ps i) \<Otimes> i) m \<oplus> P m = ((indexed_eval_aux Qs' i) \<Otimes> i) m \<oplus> Q' m" for m
+    by (simp add: indexed_padd_def)
+
+  have "P m = Q' m" if "i \<in># m" for m
+    using that Cons(3,5) unfolding index_free_def Qs by auto
+  moreover have "P m = Q' m" if "i \<notin># m" for m
+    using in_carrier(2,4) eq[of m] that by (auto simp add: indexed_pmult_def)
+  ultimately have "P = Q'"
+    by auto
+
+  hence "(indexed_eval_aux Ps i) m = (indexed_eval_aux Qs' i) m" for m
+    using eq[of "m + {# i #}"] in_carrier[of "m + {# i #}"] unfolding indexed_pmult_def by auto
+  with \<open>length Ps = length Qs'\<close> have "Ps = Qs'"
+    using Cons(1)[of Qs'] Cons(2-5) unfolding Qs by auto
+  with \<open>P = Q'\<close> show ?case
+    unfolding Qs by simp
+qed
+
+lemma (in ring) indexed_eval_aux_is_inj':
+  assumes "list_all carrier_coeff Ps" and "list_all (\<lambda>P. index_free P i) Ps"
+      and "list_all carrier_coeff Qs" and "list_all (\<lambda>Q. index_free Q i) Qs"
+      and "carrier_coeff P" and "index_free P i" "P \<noteq> indexed_const \<zero>"
+      and "carrier_coeff Q" and "index_free Q i" "Q \<noteq> indexed_const \<zero>"
+    and "indexed_eval_aux (Ps @ [ P ]) i = indexed_eval_aux (Qs @ [ Q ]) i"
+  shows "Ps = Qs" and "P = Q"
+proof -
+  obtain m n where "P m \<noteq> \<zero>" and "Q n \<noteq> \<zero>"
+    using assms(7,10) unfolding indexed_zero_def by blast
+  hence "count m i = 0" and "count n i = 0"
+    using assms(6,9) unfolding index_free_def by (meson count_inI)+ 
+  with \<open>P m \<noteq> \<zero>\<close> and \<open>Q n \<noteq> \<zero>\<close> obtain m' n'
+    where m': "count m' i = length Ps" "(indexed_eval_aux (Ps @ [ P ]) i) m' \<noteq> \<zero>"
+      and n': "count n' i = length Qs" "(indexed_eval_aux (Qs @ [ Q ]) i) n' \<noteq> \<zero>"
+    using exists_indexed_eval_aux_monomial[of P Ps m i 0]
+          exists_indexed_eval_aux_monomial[of Q Qs n i 0] assms(1-5,8)
+    by (metis (no_types, lifting) add.right_neutral)
+  have "(indexed_eval_aux (Qs @ [ Q ]) i) m' \<noteq> \<zero>"
+    using m'(2) assms(11) by simp
+  with \<open>count m' i = length Ps\<close> have "length Ps \<le> length Qs"
+    using indexed_eval_aux_monomial_degree_le[of "Qs @ [ Q ]" i m'] assms(3-4,8-9) by auto
+  moreover have "(indexed_eval_aux (Ps @ [ P ]) i) n' \<noteq> \<zero>"
+    using n'(2) assms(11) by simp
+  with \<open>count n' i = length Qs\<close> have "length Qs \<le> length Ps"
+    using indexed_eval_aux_monomial_degree_le[of "Ps @ [ P ]" i n'] assms(1-2,5-6) by auto
+  ultimately have same_len: "length (Ps @ [ P ]) = length (Qs @ [ Q ])"
+    by simp
+  thus "Ps = Qs" and "P = Q"
+    using indexed_eval_aux_is_inj[of "Ps @ [ P ]" i "Qs @ [ Q ]"] assms(1-6,8-9,11) by auto
+qed
+
+lemma (in ring) exists_indexed_eval_monomial:
+  assumes "carrier_coeff P" and "list_all carrier_coeff Qs"
+    and "P n \<noteq> \<zero>" and "list_all (\<lambda>Q. index_free Q i) Qs"
+  obtains m where "count m i = length Qs + (count n i)" and "(indexed_eval (P # Qs) i) m \<noteq> \<zero>"
+  using exists_indexed_eval_aux_monomial[OF assms(1) _ _ assms(3), of "rev Qs"] assms(2,4) by auto
+
+corollary (in ring) exists_indexed_eval_monomial':
+  assumes "carrier_coeff P" and "list_all carrier_coeff Qs"
+    and "P \<noteq> indexed_const \<zero>" and "list_all (\<lambda>Q. index_free Q i) Qs"
+  obtains m where "count m i \<ge> length Qs" and "(indexed_eval (P # Qs) i) m \<noteq> \<zero>"
+proof -
+  from \<open>P \<noteq> indexed_const \<zero>\<close> obtain n where "P n \<noteq> \<zero>"
+    unfolding indexed_const_def by auto
+  then obtain m where "count m i = length Qs + (count n i)" and "(indexed_eval (P # Qs) i) m \<noteq> \<zero>"
+    using exists_indexed_eval_monomial[OF assms(1-2) _ assms(4)] by auto
+  thus thesis
+    using that by force
+qed
+
+lemma (in ring) indexed_eval_monomial_degree_le:
+  assumes "list_all carrier_coeff Ps" and "list_all (\<lambda>P. index_free P i) Ps"
+    and "(indexed_eval Ps i) m \<noteq> \<zero>" shows "count m i \<le> length Ps - 1"
+  using indexed_eval_aux_monomial_degree_le[of "rev Ps"] assms by auto
+
+lemma (in ring) indexed_eval_is_inj:
+  assumes "list_all carrier_coeff Ps" and "list_all (\<lambda>P. index_free P i) Ps"
+      and "list_all carrier_coeff Qs" and "list_all (\<lambda>Q. index_free Q i) Qs"
+      and "carrier_coeff P" and "index_free P i" "P \<noteq> indexed_const \<zero>"
+      and "carrier_coeff Q" and "index_free Q i" "Q \<noteq> indexed_const \<zero>"
+    and "indexed_eval (P # Ps) i = indexed_eval (Q # Qs) i"
+  shows "Ps = Qs" and "P = Q"
+proof -
+  have rev_cond:
+    "list_all carrier_coeff (rev Ps)" "list_all (\<lambda>P. index_free P i) (rev Ps)"
+    "list_all carrier_coeff (rev Qs)" "list_all (\<lambda>Q. index_free Q i) (rev Qs)"
+    using assms(1-4) by auto
+  show "Ps = Qs" and "P = Q"
+    using indexed_eval_aux_is_inj'[OF rev_cond assms(5-10)] assms(11) by auto
+qed
+
+lemma (in ring) indexed_eval_inj_on_carrier:
+  assumes "\<And>P. P \<in> carrier L \<Longrightarrow> carrier_coeff P" and "\<And>P. P \<in> carrier L \<Longrightarrow> index_free P i" and "\<zero>\<^bsub>L\<^esub> = indexed_const \<zero>"
+  shows "inj_on (\<lambda>Ps. indexed_eval Ps i) (carrier (poly_ring L))"
+proof -
+  { fix Ps
+    assume "Ps \<in> carrier (poly_ring L)" and "indexed_eval Ps i = indexed_const \<zero>"
+    have "Ps = []"
+    proof (rule ccontr)
+      assume "Ps \<noteq> []"
+      then obtain P' Ps' where Ps: "Ps = P' # Ps'"
+        using list.exhaust by blast
+      with \<open>Ps \<in> carrier (poly_ring L)\<close>
+      have "P' \<noteq> indexed_const \<zero>" and "list_all carrier_coeff Ps" and "list_all (\<lambda>P. index_free P i) Ps"
+        using assms unfolding sym[OF univ_poly_carrier[of L "carrier L"]] polynomial_def
+        by (simp add: list.pred_set subset_code(1))+
+      then obtain m where "(indexed_eval Ps i) m \<noteq> \<zero>"
+        using exists_indexed_eval_monomial'[of P' Ps'] unfolding Ps by auto
+      hence "indexed_eval Ps i \<noteq> indexed_const \<zero>"
+        unfolding indexed_const_def by auto
+      with \<open>indexed_eval Ps i = indexed_const \<zero>\<close> show False by simp
+    qed } note aux_lemma = this
+
+  show ?thesis
+  proof (rule inj_onI)
+    fix Ps Qs
+    assume "Ps \<in> carrier (poly_ring L)" and "Qs \<in> carrier (poly_ring L)"
+    show "indexed_eval Ps i = indexed_eval Qs i \<Longrightarrow> Ps = Qs"
+    proof (cases)
+      assume "Qs = []" and "indexed_eval Ps i = indexed_eval Qs i"
+      with \<open>Ps \<in> carrier (poly_ring L)\<close> show "Ps = Qs"
+        using aux_lemma by simp
+    next
+      assume "Qs \<noteq> []" and eq: "indexed_eval Ps i = indexed_eval Qs i"
+      with \<open>Qs \<in> carrier (poly_ring L)\<close> have "Ps \<noteq> []"
+        using aux_lemma by auto
+      from \<open>Ps \<noteq> []\<close> and \<open>Qs \<noteq> []\<close> obtain P' Ps' Q' Qs' where Ps: "Ps = P' # Ps'" and Qs: "Qs = Q' # Qs'"
+        using list.exhaust by metis
+
+      from \<open>Ps \<in> carrier (poly_ring L)\<close> and \<open>Ps = P' # Ps'\<close>
+      have "carrier_coeff P'" and "index_free P' i" "P' \<noteq> indexed_const \<zero>"
+       and "list_all carrier_coeff Ps'" and "list_all (\<lambda>P. index_free P i) Ps'"
+        using assms unfolding sym[OF univ_poly_carrier[of L "carrier L"]] polynomial_def
+        by (simp add: list.pred_set subset_code(1))+
+      moreover 
+      from \<open>Qs \<in> carrier (poly_ring L)\<close> and \<open>Qs = Q' # Qs'\<close>
+      have "carrier_coeff Q'" and "index_free Q' i" "Q' \<noteq> indexed_const \<zero>"
+       and "list_all carrier_coeff Qs'" and "list_all (\<lambda>P. index_free P i) Qs'"
+        using assms unfolding sym[OF univ_poly_carrier[of L "carrier L"]] polynomial_def
+        by (simp add: list.pred_set subset_code(1))+
+      ultimately show ?thesis
+        using indexed_eval_is_inj[of Ps' i Qs' P' Q'] eq unfolding Ps Qs by auto
+    qed
+  qed
+qed
+
+
+subsection \<open>Link with Weak Morphisms\<close>
+
+text \<open>We study some elements of the contradiction needed in the algebraic closure existence proof. \<close>
+
+context ring
+begin
+
+lemma (in ring) indexed_padd_index_free:
+  assumes "index_free P i" and "index_free Q i" shows "index_free (P \<Oplus> Q) i"
+  using assms unfolding indexed_padd_def index_free_def by auto
+
+lemma (in ring) indexed_pmult_index_free:
+  assumes "index_free P j" and "i \<noteq> j" shows "index_free (P \<Otimes> i) j"
+  using assms unfolding index_free_def indexed_pmult_def
+  by (metis insert_DiffM insert_noteq_member)
+
+lemma (in ring) indexed_eval_index_free:
+  assumes "list_all (\<lambda>P. index_free P j) Ps" and "i \<noteq> j" shows "index_free (indexed_eval Ps i) j"
+proof -
+  { fix Ps assume "list_all (\<lambda>P. index_free P j) Ps" hence "index_free (indexed_eval_aux Ps i) j"
+      using indexed_padd_index_free[OF indexed_pmult_index_free[OF _ assms(2)]]
+      by (induct Ps) (auto simp add: indexed_zero_def index_free_def) }
+  thus ?thesis
+    using assms(1) by auto
+qed
+
+context
+  fixes L :: "(('c multiset) \<Rightarrow> 'a) ring" and i :: 'c
+  assumes hyps:
+    \<comment> \<open>i\<close>   "field L"
+    \<comment> \<open>ii\<close>  "\<And>P. P \<in> carrier L \<Longrightarrow> carrier_coeff P"
+    \<comment> \<open>iii\<close> "\<And>P. P \<in> carrier L \<Longrightarrow> index_free P i"
+    \<comment> \<open>iv\<close>  "\<zero>\<^bsub>L\<^esub> = indexed_const \<zero>"
+begin
+
+interpretation L: field L
+  using \<open>field L\<close> .
+
+interpretation UP: principal_domain "poly_ring L"
+  using L.univ_poly_is_principal[OF L.carrier_is_subfield] .
+
+
+abbreviation eval_pmod
+  where "eval_pmod q \<equiv> (\<lambda>p. indexed_eval (L.pmod p q) i)"
+
+abbreviation image_poly
+  where "image_poly q \<equiv> image_ring (eval_pmod q) (poly_ring L)"
+
+
+lemma indexed_eval_is_weak_ring_morphism:
+  assumes "q \<in> carrier (poly_ring L)" shows "weak_ring_morphism (eval_pmod q) (PIdl\<^bsub>poly_ring L\<^esub> q) (poly_ring L)"
+proof (rule weak_ring_morphismI)
+  show "ideal (PIdl\<^bsub>poly_ring L\<^esub> q) (poly_ring L)"
+    using UP.cgenideal_ideal[OF assms] .
+next
+  fix a b assume in_carrier: "a \<in> carrier (poly_ring L)" "b \<in> carrier (poly_ring L)"
+  note ldiv_closed = in_carrier[THEN L.long_division_closed(2)[OF L.carrier_is_subfield _ assms]]
+
+  have "(eval_pmod q) a = (eval_pmod q) b \<longleftrightarrow> L.pmod a q = L.pmod b q"
+    using inj_onD[OF indexed_eval_inj_on_carrier[OF hyps(2-4)] _ ldiv_closed] by fastforce
+  also have " ... \<longleftrightarrow> q pdivides\<^bsub>L\<^esub> (a \<ominus>\<^bsub>poly_ring L\<^esub> b)"
+    unfolding L.same_pmod_iff_pdivides[OF L.carrier_is_subfield in_carrier assms] ..
+  also have " ... \<longleftrightarrow> PIdl\<^bsub>poly_ring L\<^esub> (a \<ominus>\<^bsub>poly_ring L\<^esub> b) \<subseteq> PIdl\<^bsub>poly_ring L\<^esub> q"
+    unfolding UP.to_contain_is_to_divide[OF assms UP.minus_closed[OF in_carrier]] pdivides_def ..
+  also have " ... \<longleftrightarrow> a \<ominus>\<^bsub>poly_ring L\<^esub> b \<in> PIdl\<^bsub>poly_ring L\<^esub> q"
+    unfolding UP.cgenideal_eq_genideal[OF assms] UP.cgenideal_eq_genideal[OF UP.minus_closed[OF in_carrier]]
+              UP.Idl_subset_ideal'[OF UP.minus_closed[OF in_carrier] assms] ..
+  finally show "(eval_pmod q) a = (eval_pmod q) b \<longleftrightarrow> a \<ominus>\<^bsub>poly_ring L\<^esub> b \<in> PIdl\<^bsub>poly_ring L\<^esub> q" .
+qed
+
+lemma eval_norm_eq_id:
+  assumes "q \<in> carrier (poly_ring L)" and "degree q > 0" and "a \<in> carrier L"
+  shows "((eval_pmod q) \<circ> (ring.poly_of_const L)) a = a"
+proof (cases)
+  assume "a = \<zero>\<^bsub>L\<^esub>" thus ?thesis
+    using L.long_division_zero(2)[OF L.carrier_is_subfield assms(1)] hyps(4)
+    unfolding ring.poly_of_const_def[OF L.ring_axioms] by auto
+next
+  assume "a \<noteq> \<zero>\<^bsub>L\<^esub>" then have in_carrier: "[ a ] \<in> carrier (poly_ring L)"
+    using assms(3) unfolding sym[OF univ_poly_carrier[of L "carrier L"]] polynomial_def by simp
+  from \<open>a \<noteq> \<zero>\<^bsub>L\<^esub>\<close> show ?thesis
+    using L.pmod_const(2)[OF L.carrier_is_subfield in_carrier assms(1)] assms(2)
+          indexed_padd_zero(2)[OF hyps(2)[OF assms(3)]]
+    unfolding ring.poly_of_const_def[OF L.ring_axioms] by auto
+qed
+
+lemma image_poly_iso_incl:
+  assumes "q \<in> carrier (poly_ring L)" and "degree q > 0" shows "id \<in> ring_hom L (image_poly q)"
+proof -
+  have "((eval_pmod q) \<circ> L.poly_of_const) \<in> ring_hom L (image_poly q)"
+    using ring_hom_trans[OF L.canonical_embedding_is_hom[OF L.carrier_is_subring]
+          UP.weak_ring_morphism_is_hom[OF indexed_eval_is_weak_ring_morphism[OF assms(1)]]]
+    by simp
+  thus ?thesis
+    using eval_norm_eq_id[OF assms(1-2)] L.ring_hom_restrict[of _ "image_poly q" id] by auto
+qed
+
+lemma image_poly_is_field:
+  assumes "q \<in> carrier (poly_ring L)" and "pirreducible\<^bsub>L\<^esub> (carrier L) q" shows "field (image_poly q)"
+  using UP.image_ring_is_field[OF indexed_eval_is_weak_ring_morphism[OF assms(1)]] assms(2)
+  unfolding sym[OF L.rupture_is_field_iff_pirreducible[OF L.carrier_is_subfield assms(1)]] rupture_def
+  by simp
+
+lemma image_poly_index_free:
+  assumes "q \<in> carrier (poly_ring L)" and "P \<in> carrier (image_poly q)" and "\<not> index_free P j" "i \<noteq> j"
+  obtains Q where "Q \<in> carrier L" and "\<not> index_free Q j"
+proof -
+  from \<open>P \<in> carrier (image_poly q)\<close> obtain p where p: "p \<in> carrier (poly_ring L)" and P: "P = (eval_pmod q) p"
+    unfolding image_ring_carrier by blast
+  from \<open>\<not> index_free P j\<close> have "\<not> list_all (\<lambda>P. index_free P j) (L.pmod p q)"
+    using indexed_eval_index_free[OF _ assms(4), of "L.pmod p q"] unfolding sym[OF P] by auto
+  then obtain Q where "Q \<in> set (L.pmod p q)" and "\<not> index_free Q j"
+    unfolding list_all_iff by auto
+  thus ?thesis
+    using L.long_division_closed(2)[OF L.carrier_is_subfield p assms(1)] that
+    unfolding sym[OF univ_poly_carrier[of L "carrier L"]] polynomial_def
+    by auto
+qed
+
+lemma eval_pmod_var:
+  assumes "indexed_const \<in> ring_hom R L" and "q \<in> carrier (poly_ring L)" and "degree q > 1"
+  shows "(eval_pmod q) X\<^bsub>L\<^esub> = \<X>\<^bsub>i\<^esub>" and "\<X>\<^bsub>i\<^esub> \<in> carrier (image_poly q)"
+proof -
+  have "X\<^bsub>L\<^esub> = [ indexed_const \<one>, indexed_const \<zero> ]" and "X\<^bsub>L\<^esub> \<in> carrier (poly_ring L)"
+    using ring_hom_one[OF assms(1)] hyps(4) L.var_closed(1) L.carrier_is_subring unfolding var_def by auto
+  thus "(eval_pmod q) X\<^bsub>L\<^esub> = \<X>\<^bsub>i\<^esub>"
+    using L.pmod_const(2)[OF L.carrier_is_subfield _ assms(2), of "X\<^bsub>L\<^esub>"] assms(3)
+    by (auto simp add: indexed_pmult_def indexed_padd_def indexed_const_def indexed_var_def)
+  with \<open>X\<^bsub>L\<^esub> \<in> carrier (poly_ring L)\<close> show "\<X>\<^bsub>i\<^esub> \<in> carrier (image_poly q)"
+    using image_iff unfolding image_ring_carrier by fastforce
+qed
+
+lemma image_poly_eval_indexed_var:
+  assumes "indexed_const \<in> ring_hom R L"
+    and "q \<in> carrier (poly_ring L)" and "degree q > 1" and "pirreducible\<^bsub>L\<^esub> (carrier L) q"
+  shows "(ring.eval (image_poly q)) q \<X>\<^bsub>i\<^esub> = \<zero>\<^bsub>image_poly q\<^esub>"
+proof -
+  let ?surj = "L.rupture_surj (carrier L) q"
+  let ?Rupt = "Rupt\<^bsub>L\<^esub> (carrier L) q"
+  let ?f = "eval_pmod q"
+
+  interpret UP: ring "poly_ring L"
+    using L.univ_poly_is_ring[OF L.carrier_is_subring] .
+  from \<open>pirreducible\<^bsub>L\<^esub> (carrier L) q\<close> interpret Rupt: field ?Rupt
+    using L.rupture_is_field_iff_pirreducible[OF L.carrier_is_subfield assms(2)] by simp
+
+  have weak_morphism: "weak_ring_morphism ?f (PIdl\<^bsub>poly_ring L\<^esub> q) (poly_ring L)"
+    using indexed_eval_is_weak_ring_morphism[OF assms(2)] .
+  then interpret I: ideal "PIdl\<^bsub>poly_ring L\<^esub> q" "poly_ring L"
+    using weak_ring_morphism.axioms(1) by auto
+  interpret Hom: ring_hom_ring ?Rupt "image_poly q" "\<lambda>x. the_elem (?f ` x)"
+    using ring_hom_ring.intro[OF I.quotient_is_ring UP.image_ring_is_ring[OF weak_morphism]]
+          UP.weak_ring_morphism_is_iso[OF weak_morphism]
+    unfolding ring_iso_def symmetric[OF ring_hom_ring_axioms_def] rupture_def
+    by auto
+
+  have "set q \<subseteq> carrier L" and lc: "q \<noteq> [] \<Longrightarrow> lead_coeff q \<in> carrier L - { \<zero>\<^bsub>L\<^esub> }"
+    using assms(2) unfolding sym[OF univ_poly_carrier] polynomial_def by auto
+
+  have map_surj: "set (map (?surj \<circ> L.poly_of_const) q) \<subseteq> carrier ?Rupt"
+  proof -
+    have "L.poly_of_const a \<in> carrier (poly_ring L)" if "a \<in> carrier L" for a
+      using that L.normalize_gives_polynomial[of "[ a ]"]
+      unfolding univ_poly_carrier ring.poly_of_const_def[OF L.ring_axioms] by simp
+    hence "(?surj \<circ> L.poly_of_const) a \<in> carrier ?Rupt" if "a \<in> carrier L" for a
+      using ring_hom_memE(1)[OF L.rupture_surj_hom(1)[OF L.carrier_is_subring assms(2)]] that by simp
+    with \<open>set q \<subseteq> carrier L\<close> show ?thesis
+      by (induct q) (auto)
+  qed
+
+  have "?surj X\<^bsub>L\<^esub> \<in> carrier ?Rupt"
+    using ring_hom_memE(1)[OF L.rupture_surj_hom(1)[OF _ assms(2)] L.var_closed(1)] L.carrier_is_subring by simp
+  moreover have "map (\<lambda>x. the_elem (?f ` x)) (map (?surj \<circ> L.poly_of_const) q) = q"
+  proof -
+    define g where "g = (?surj \<circ> L.poly_of_const)"
+    define f where "f = (\<lambda>x. the_elem (?f ` x))"
+
+    have "the_elem (?f ` ((?surj \<circ> L.poly_of_const) a)) = ((eval_pmod q) \<circ> L.poly_of_const) a"
+      if "a \<in> carrier L" for a
+      using that L.normalize_gives_polynomial[of "[ a ]"] UP.weak_ring_morphism_range[OF weak_morphism]
+      unfolding univ_poly_carrier ring.poly_of_const_def[OF L.ring_axioms] by auto
+    hence "the_elem (?f ` ((?surj \<circ> L.poly_of_const) a)) = a" if "a \<in> carrier L" for a
+      using eval_norm_eq_id[OF assms(2)] that assms(3) by simp
+    hence "f (g a) = a" if "a \<in> carrier L" for a
+      using that unfolding f_def g_def by simp
+    with \<open>set q \<subseteq> carrier L\<close> have "map f (map g q) = q"
+      by (induct q) (auto)
+    thus ?thesis
+      unfolding f_def g_def by simp
+  qed
+  moreover have "(\<lambda>x. the_elem (?f ` x)) (?surj X\<^bsub>L\<^esub>) = \<X>\<^bsub>i\<^esub>"
+    using UP.weak_ring_morphism_range[OF weak_morphism L.var_closed(1)[OF L.carrier_is_subring]]
+    unfolding eval_pmod_var(1)[OF assms(1-3)] by simp
+  ultimately have "Hom.S.eval q \<X>\<^bsub>i\<^esub> = (\<lambda>x. the_elem (?f ` x)) (Rupt.eval (map (?surj \<circ> L.poly_of_const) q) (?surj X\<^bsub>L\<^esub>))"
+    using Hom.eval_hom'[OF _ map_surj] by auto
+  moreover have "\<zero>\<^bsub>?Rupt\<^esub> = ?surj \<zero>\<^bsub>poly_ring L\<^esub>"
+    unfolding rupture_def FactRing_def by (simp add: I.a_rcos_const)
+  hence "the_elem (?f ` \<zero>\<^bsub>?Rupt\<^esub>) = \<zero>\<^bsub>image_poly q\<^esub>"
+    using UP.weak_ring_morphism_range[OF weak_morphism UP.zero_closed]
+    unfolding image_ring_zero by simp 
+  hence "(\<lambda>x. the_elem (?f ` x)) (Rupt.eval (map (?surj \<circ> L.poly_of_const) q) (?surj X\<^bsub>L\<^esub>)) = \<zero>\<^bsub>image_poly q\<^esub>"
+    using L.polynomial_rupture[OF L.carrier_is_subring assms(2)] by simp
+  ultimately show ?thesis
+    by simp
+qed
+
+end (* of fixed L context. *)
+
+end (* of ring context. *)
+
+end
\ No newline at end of file
diff -r 57503fe1b0ff -r 615233977155 src/HOL/Algebra/Polynomial_Divisibility.thy
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Algebra/Polynomial_Divisibility.thy	Sun Apr 14 12:00:17 2019 +0100
@@ -0,0 +1,1221 @@
+(*  Title:      HOL/Algebra/Polynomial_Divisibility.thy
+    Author:     Paulo Emílio de Vilhena
+*)
+
+theory Polynomial_Divisibility
+  imports Polynomials Embedded_Algebras "HOL-Library.Multiset"
+    
+begin
+
+section \<open>Divisibility of Polynomials\<close>
+
+subsection \<open>Definitions\<close>
+
+abbreviation poly_ring :: "_ \<Rightarrow> ('a  list) ring"
+  where "poly_ring R \<equiv> univ_poly R (carrier R)"
+
+abbreviation pirreducible :: "_ \<Rightarrow> 'a set \<Rightarrow> 'a list \<Rightarrow> bool" ("pirreducible\<index>")
+  where "pirreducible\<^bsub>R\<^esub> K p \<equiv> ring_irreducible\<^bsub>(univ_poly R K)\<^esub> p"
+
+abbreviation pprime :: "_ \<Rightarrow> 'a set \<Rightarrow> 'a list \<Rightarrow> bool" ("pprime\<index>")
+  where "pprime\<^bsub>R\<^esub> K p \<equiv> ring_prime\<^bsub>(univ_poly R K)\<^esub> p"
+
+definition pdivides :: "_ \<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> bool" (infix "pdivides\<index>" 65)
+  where "p pdivides\<^bsub>R\<^esub> q = p divides\<^bsub>(univ_poly R (carrier R))\<^esub> q"
+
+definition rupture :: "_ \<Rightarrow> 'a set \<Rightarrow> 'a list \<Rightarrow> (('a list) set) ring" ("Rupt\<index>")
+  where "Rupt\<^bsub>R\<^esub> K p = (K[X]\<^bsub>R\<^esub>) Quot (PIdl\<^bsub>K[X]\<^bsub>R\<^esub>\<^esub> p)"
+
+abbreviation (in ring) rupture_surj :: "'a set \<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> ('a list) set"
+  where "rupture_surj K p \<equiv> (\<lambda>q. (PIdl\<^bsub>K[X]\<^esub> p) +>\<^bsub>K[X]\<^esub> q)"
+
+
+subsection \<open>Basic Properties\<close>
+
+lemma (in ring) carrier_polynomial_shell [intro]:
+  assumes "subring K R" and "p \<in> carrier (K[X])" shows "p \<in> carrier (poly_ring R)"
+  using carrier_polynomial[OF assms(1), of p] assms(2) unfolding sym[OF univ_poly_carrier] by simp
+
+lemma (in domain) pdivides_zero:
+  assumes "subring K R" and "p \<in> carrier (K[X])" shows "p pdivides []"
+  using ring.divides_zero[OF univ_poly_is_ring[OF carrier_is_subring]
+         carrier_polynomial_shell[OF assms]]
+  unfolding univ_poly_zero pdivides_def .
+
+lemma (in domain) zero_pdivides_zero: "[] pdivides []"
+  using pdivides_zero[OF carrier_is_subring] univ_poly_carrier by blast
+
+lemma (in domain) zero_pdivides:
+  shows "[] pdivides p \<longleftrightarrow> p = []"
+  using ring.zero_divides[OF univ_poly_is_ring[OF carrier_is_subring]]
+  unfolding univ_poly_zero pdivides_def .
+
+lemma (in domain) pprime_iff_pirreducible:
+  assumes "subfield K R" and "p \<in> carrier (K[X])"
+  shows "pprime K p \<longleftrightarrow> pirreducible K p"
+  using principal_domain.primeness_condition[OF univ_poly_is_principal] assms by simp
+
+lemma (in domain) pirreducibleE:
+  assumes "subring K R" "p \<in> carrier (K[X])" "pirreducible K p"
+  shows "p \<noteq> []" "p \<notin> Units (K[X])"
+    and "\<And>q r. \<lbrakk> q \<in> carrier (K[X]); r \<in> carrier (K[X])\<rbrakk> \<Longrightarrow>
+                 p = q \<otimes>\<^bsub>K[X]\<^esub> r \<Longrightarrow> q \<in> Units (K[X]) \<or> r \<in> Units (K[X])"
+  using domain.ring_irreducibleE[OF univ_poly_is_domain[OF assms(1)] _ assms(3)] assms(2)
+  by (auto simp add: univ_poly_zero)
+
+lemma (in domain) pirreducibleI:
+  assumes "subring K R" "p \<in> carrier (K[X])" "p \<noteq> []" "p \<notin> Units (K[X])"
+    and "\<And>q r. \<lbrakk> q \<in> carrier (K[X]); r \<in> carrier (K[X])\<rbrakk> \<Longrightarrow>
+                 p = q \<otimes>\<^bsub>K[X]\<^esub> r \<Longrightarrow> q \<in> Units (K[X]) \<or> r \<in> Units (K[X])"
+  shows "pirreducible K p"
+  using domain.ring_irreducibleI[OF univ_poly_is_domain[OF assms(1)] _ assms(4)] assms(2-3,5)
+  by (auto simp add: univ_poly_zero)
+
+lemma (in domain) univ_poly_carrier_units_incl:
+  shows "Units ((carrier R) [X]) \<subseteq> { [ k ] | k. k \<in> carrier R - { \<zero> } }"
+proof
+  fix p assume "p \<in> Units ((carrier R) [X])"
+  then obtain q
+    where p: "polynomial (carrier R) p" and q: "polynomial (carrier R) q" and pq: "poly_mult p q = [ \<one> ]"
+    unfolding Units_def univ_poly_def by auto
+  hence not_nil: "p \<noteq> []" and "q \<noteq> []"
+    using poly_mult_integral[OF carrier_is_subring p q] poly_mult_zero[OF polynomial_incl[OF p]] by auto
+  hence "degree p = 0"
+    using poly_mult_degree_eq[OF carrier_is_subring p q] unfolding pq by simp
+  hence "length p = 1"
+    using not_nil by (metis One_nat_def Suc_pred length_greater_0_conv)
+  then obtain k where k: "p = [ k ]"
+    by (metis One_nat_def length_0_conv length_Suc_conv)
+  hence "k \<in> carrier R - { \<zero> }"
+    using p unfolding polynomial_def by auto 
+  thus "p \<in> { [ k ] | k. k \<in> carrier R - { \<zero> } }"
+    unfolding k by blast
+qed
+
+lemma (in field) univ_poly_carrier_units:
+  "Units ((carrier R) [X]) = { [ k ] | k. k \<in> carrier R - { \<zero> } }"
+proof
+  show "Units ((carrier R) [X]) \<subseteq> { [ k ] | k. k \<in> carrier R - { \<zero> } }"
+    using univ_poly_carrier_units_incl by simp
+next
+  show "{ [ k ] | k. k \<in> carrier R - { \<zero> } } \<subseteq> Units ((carrier R) [X])"
+  proof (auto)
+    fix k assume k: "k \<in> carrier R" "k \<noteq> \<zero>"
+    hence inv_k: "inv k \<in> carrier R" "inv k \<noteq> \<zero>" and "k \<otimes> inv k = \<one>" "inv k \<otimes> k = \<one>"
+      using subfield_m_inv[OF carrier_is_subfield, of k] by auto
+    hence "poly_mult [ k ] [ inv k ] = [ \<one> ]" and "poly_mult [ inv k ] [ k ] = [ \<one> ]"
+      by (auto simp add: k)
+    moreover have "polynomial (carrier R) [ k ]" and "polynomial (carrier R) [ inv k ]"
+      using const_is_polynomial k inv_k by auto
+    ultimately show "[ k ] \<in> Units ((carrier R) [X])"
+      unfolding Units_def univ_poly_def by (auto simp del: poly_mult.simps)
+  qed
+qed
+
+lemma (in domain) univ_poly_units_incl:
+  assumes "subring K R" shows "Units (K[X]) \<subseteq> { [ k ] | k. k \<in> K - { \<zero> } }"
+  using domain.univ_poly_carrier_units_incl[OF subring_is_domain[OF assms]]
+        univ_poly_consistent[OF assms] by auto
+
+lemma (in ring) univ_poly_units:
+  assumes "subfield K R" shows "Units (K[X]) = { [ k ] | k. k \<in> K - { \<zero> } }"
+  using field.univ_poly_carrier_units[OF subfield_iff(2)[OF assms]]
+        univ_poly_consistent[OF subfieldE(1)[OF assms]] by auto
+
+corollary (in domain) rupture_one_not_zero:
+  assumes "subfield K R" and "p \<in> carrier (K[X])" and "degree p > 0"
+  shows "\<one>\<^bsub>Rupt K p\<^esub> \<noteq> \<zero>\<^bsub>Rupt K p\<^esub>"
+proof (rule ccontr)
+  interpret UP: principal_domain "K[X]"
+    using univ_poly_is_principal[OF assms(1)] . 
+
+  assume "\<not> \<one>\<^bsub>Rupt K p\<^esub> \<noteq> \<zero>\<^bsub>Rupt K p\<^esub>"
+  then have "PIdl\<^bsub>K[X]\<^esub> p +>\<^bsub>K[X]\<^esub> \<one>\<^bsub>K[X]\<^esub> = PIdl\<^bsub>K[X]\<^esub> p"
+    unfolding rupture_def FactRing_def by simp
+  hence "\<one>\<^bsub>K[X]\<^esub> \<in> PIdl\<^bsub>K[X]\<^esub> p"
+    using ideal.rcos_const_imp_mem[OF UP.cgenideal_ideal[OF assms(2)]] by auto
+  then obtain q where "q \<in> carrier (K[X])" and "\<one>\<^bsub>K[X]\<^esub> = q \<otimes>\<^bsub>K[X]\<^esub> p"
+    using assms(2) unfolding cgenideal_def by auto
+  hence "p \<in> Units (K[X])"
+    unfolding Units_def using assms(2) UP.m_comm by auto
+  hence "degree p = 0"
+    unfolding univ_poly_units[OF assms(1)] by auto
+  with \<open>degree p > 0\<close> show False
+    by simp
+qed
+
+corollary (in ring) pirreducible_degree:
+  assumes "subfield K R" "p \<in> carrier (K[X])" "pirreducible K p"
+  shows "degree p \<ge> 1"
+proof (rule ccontr)
+  assume "\<not> degree p \<ge> 1" then have "length p \<le> 1"
+    by simp
+  moreover have "p \<noteq> []" and "p \<notin> Units (K[X])"
+    using assms(3) by (auto simp add: ring_irreducible_def irreducible_def univ_poly_zero)
+  ultimately obtain k where k: "p = [ k ]"
+    by (metis append_butlast_last_id butlast_take diff_is_0_eq le_refl self_append_conv2 take0 take_all)
+  hence "k \<in> K" and "k \<noteq> \<zero>"
+    using assms(2) by (auto simp add: polynomial_def univ_poly_def)
+  hence "p \<in> Units (K[X])"
+    using univ_poly_units[OF assms(1)] unfolding k by auto
+  from \<open>p \<in> Units (K[X])\<close> and \<open>p \<notin> Units (K[X])\<close> show False by simp
+qed
+
+corollary (in domain) univ_poly_not_field:
+  assumes "subring K R" shows "\<not> field (K[X])"
+proof -
+  have "X \<in> carrier (K[X]) - { \<zero>\<^bsub>(K[X])\<^esub> }" and "X \<notin> { [ k ] | k. k \<in> K - { \<zero> } }"
+    using var_closed(1)[OF assms] unfolding univ_poly_zero var_def by auto 
+  thus ?thesis
+    using field.field_Units[of "K[X]"] univ_poly_units_incl[OF assms] by blast 
+qed
+
+lemma (in domain) rupture_is_field_iff_pirreducible:
+  assumes "subfield K R" and "p \<in> carrier (K[X])"
+  shows "field (Rupt K p) \<longleftrightarrow> pirreducible K p"
+proof
+  assume "pirreducible K p" thus "field (Rupt K p)"
+    using principal_domain.field_iff_prime[OF univ_poly_is_principal[OF assms(1)]] assms(2)
+          pprime_iff_pirreducible[OF assms] pirreducibleE(1)[OF subfieldE(1)[OF assms(1)]]
+    by (simp add: univ_poly_zero rupture_def)
+next
+  interpret UP: principal_domain "K[X]"
+    using univ_poly_is_principal[OF assms(1)] .
+
+  assume field: "field (Rupt K p)"
+  have "p \<noteq> []"
+  proof (rule ccontr)
+    assume "\<not> p \<noteq> []" then have p: "p = []"
+      by simp
+    hence "Rupt K p \<simeq> (K[X])"
+      using UP.FactRing_zeroideal(1) UP.genideal_zero
+            UP.cgenideal_eq_genideal[OF UP.zero_closed]
+      by (simp add: rupture_def univ_poly_zero)
+    then obtain h where h: "h \<in> ring_iso (Rupt K p) (K[X])"
+      unfolding is_ring_iso_def by blast
+    moreover have "ring (Rupt K p)"
+      using field by (simp add: cring_def domain_def field_def) 
+    ultimately interpret R: ring_hom_ring "Rupt K p" "K[X]" h
+      unfolding ring_hom_ring_def ring_hom_ring_axioms_def ring_iso_def
+      using UP.ring_axioms by simp
+    have "field (K[X])"
+      using field.ring_iso_imp_img_field[OF field h] by simp
+    thus False
+      using univ_poly_not_field[OF subfieldE(1)[OF assms(1)]] by simp
+  qed
+  thus "pirreducible K p"
+    using UP.field_iff_prime pprime_iff_pirreducible[OF assms] assms(2) field
+    by (simp add: univ_poly_zero rupture_def)
+qed
+
+lemma (in domain) rupture_surj_hom:
+  assumes "subring K R" and "p \<in> carrier (K[X])"
+  shows "(rupture_surj K p) \<in> ring_hom (K[X]) (Rupt K p)"
+    and "ring_hom_ring (K[X]) (Rupt K p) (rupture_surj K p)"
+proof -
+  interpret UP: domain "K[X]"
+    using univ_poly_is_domain[OF assms(1)] .
+  interpret I: ideal "PIdl\<^bsub>K[X]\<^esub> p" "K[X]"
+    using UP.cgenideal_ideal[OF assms(2)] .
+  show "(rupture_surj K p) \<in> ring_hom (K[X]) (Rupt K p)"
+   and "ring_hom_ring (K[X]) (Rupt K p) (rupture_surj K p)"
+    using ring_hom_ring.intro[OF UP.ring_axioms I.quotient_is_ring] I.rcos_ring_hom
+    unfolding symmetric[OF ring_hom_ring_axioms_def] rupture_def by auto
+qed
+
+corollary (in domain) rupture_surj_norm_is_hom:
+  assumes "subring K R" and "p \<in> carrier (K[X])"
+  shows "((rupture_surj K p) \<circ> poly_of_const) \<in> ring_hom (R \<lparr> carrier := K \<rparr>) (Rupt K p)"
+  using ring_hom_trans[OF canonical_embedding_is_hom[OF assms(1)] rupture_surj_hom(1)[OF assms]] .
+
+lemma (in domain) norm_map_in_poly_ring_carrier:
+  assumes "p \<in> carrier (poly_ring R)" and "\<And>a. a \<in> carrier R \<Longrightarrow> f a \<in> carrier (poly_ring R)"
+  shows "ring.normalize (poly_ring R) (map f p) \<in> carrier (poly_ring (poly_ring R))"
+proof -
+  have "set p \<subseteq> carrier R"
+    using assms(1) unfolding sym[OF univ_poly_carrier] polynomial_def by auto
+  hence "set (map f p) \<subseteq> carrier (poly_ring R)"
+    using assms(2) by auto
+  thus ?thesis
+    using ring.normalize_gives_polynomial[OF univ_poly_is_ring[OF carrier_is_subring]]
+    unfolding univ_poly_carrier by simp
+qed
+
+lemma (in domain) map_in_poly_ring_carrier:
+  assumes "p \<in> carrier (poly_ring R)" and "\<And>a. a \<in> carrier R \<Longrightarrow> f a \<in> carrier (poly_ring R)"
+    and "\<And>a. a \<noteq> \<zero> \<Longrightarrow> f a \<noteq> []"
+  shows "map f p \<in> carrier (poly_ring (poly_ring R))"
+proof -
+  interpret UP: ring "poly_ring R"
+    using univ_poly_is_ring[OF carrier_is_subring] .
+  have "lead_coeff p \<noteq> \<zero>" if "p \<noteq> []"
+    using that assms(1) unfolding sym[OF univ_poly_carrier] polynomial_def by auto
+  hence "ring.normalize (poly_ring R) (map f p) = map f p"
+    by (cases p) (simp_all add: assms(3) univ_poly_zero)
+  thus ?thesis
+    using norm_map_in_poly_ring_carrier[of p f] assms(1-2) by simp
+qed
+
+lemma (in domain) map_norm_in_poly_ring_carrier:
+  assumes "subring K R" and "p \<in> carrier (K[X])"
+  shows "map poly_of_const p \<in> carrier (poly_ring (K[X]))"
+  using domain.map_in_poly_ring_carrier[OF subring_is_domain[OF assms(1)]]
+proof -
+  have "\<And>a. a \<in> K \<Longrightarrow> poly_of_const a \<in> carrier (K[X])"
+   and "\<And>a. a \<noteq> \<zero> \<Longrightarrow> poly_of_const a \<noteq> []"
+    using ring_hom_memE(1)[OF canonical_embedding_is_hom[OF assms(1)]]
+    by (auto simp: poly_of_const_def)
+  thus ?thesis
+    using domain.map_in_poly_ring_carrier[OF subring_is_domain[OF assms(1)]] assms(2)
+    unfolding univ_poly_consistent[OF assms(1)] by simp
+qed
+
+lemma (in domain) polynomial_rupture:
+  assumes "subring K R" and "p \<in> carrier (K[X])"
+  shows "(ring.eval (Rupt K p)) (map ((rupture_surj K p) \<circ> poly_of_const) p) (rupture_surj K p X) = \<zero>\<^bsub>Rupt K p\<^esub>"
+proof -
+  let ?surj = "rupture_surj K p"
+
+  interpret UP: domain "K[X]"
+    using univ_poly_is_domain[OF assms(1)] .
+  interpret Hom: ring_hom_ring "K[X]" "Rupt K p" ?surj
+    using rupture_surj_hom(2)[OF assms] .
+
+  have "(Hom.S.eval) (map (?surj \<circ> poly_of_const) p) (?surj X) = ?surj ((UP.eval) (map poly_of_const p) X)"
+    using Hom.eval_hom[OF UP.carrier_is_subring var_closed(1)[OF assms(1)]
+          map_norm_in_poly_ring_carrier[OF assms]] by simp
+  also have " ... = ?surj p"
+    unfolding sym[OF eval_rewrite[OF assms]] ..
+  also have " ... = \<zero>\<^bsub>Rupt K p\<^esub>"
+    using UP.a_rcos_zero[OF UP.cgenideal_ideal[OF assms(2)] UP.cgenideal_self[OF assms(2)]]
+    unfolding rupture_def FactRing_def by simp
+  finally show ?thesis .
+qed
+
+
+subsection \<open>Division\<close>
+
+definition (in ring) long_divides :: "'a list \<Rightarrow> 'a list \<Rightarrow> ('a list \<times> 'a list) \<Rightarrow> bool"
+  where "long_divides p q t \<longleftrightarrow>
+           \<comment> \<open>i\<close>   (t \<in> carrier (poly_ring R) \<times> carrier (poly_ring R)) \<and>
+           \<comment> \<open>ii\<close>  (p = (q \<otimes>\<^bsub>poly_ring R\<^esub> (fst t)) \<oplus>\<^bsub>poly_ring R\<^esub> (snd t)) \<and>
+           \<comment> \<open>iii\<close> (snd t = [] \<or> degree (snd t) < degree q)"
+
+definition (in ring) long_division :: "'a list \<Rightarrow> 'a list \<Rightarrow> ('a list \<times> 'a list)"
+  where "long_division p q = (THE t. long_divides p q t)"
+
+definition (in ring) pdiv :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list" (infixl "pdiv" 65)
+  where "p pdiv q = (if q = [] then [] else fst (long_division p q))"
+
+definition (in ring) pmod :: "'a list \<Rightarrow> 'a list \<Rightarrow> 'a list" (infixl "pmod" 65)
+  where "p pmod q = (if q = [] then p else snd (long_division p q))"
+
+
+lemma (in ring) long_dividesI:
+  assumes "b \<in> carrier (poly_ring R)" and "r \<in> carrier (poly_ring R)"
+      and "p = (q \<otimes>\<^bsub>poly_ring R\<^esub> b) \<oplus>\<^bsub>poly_ring R\<^esub> r" and "r = [] \<or> degree r < degree q"
+    shows "long_divides p q (b, r)"
+  using assms unfolding long_divides_def by auto 
+
+lemma (in domain) exists_long_division:
+  assumes "subfield K R" and "p \<in> carrier (K[X])" and "q \<in> carrier (K[X])" "q \<noteq> []"
+  obtains b r where "b \<in> carrier (K[X])" and "r \<in> carrier (K[X])" and "long_divides p q (b, r)"
+  using subfield_long_division_theorem_shell[OF assms(1-3)] assms(4)
+        carrier_polynomial_shell[OF subfieldE(1)[OF assms(1)]]
+  unfolding long_divides_def univ_poly_zero univ_poly_add univ_poly_mult by auto
+
+lemma (in domain) exists_unique_long_division:
+  assumes "subfield K R" and "p \<in> carrier (K[X])" and "q \<in> carrier (K[X])" "q \<noteq> []"
+  shows "\<exists>!t. long_divides p q t"
+proof -
+  let ?padd   = "\<lambda>a b. a \<oplus>\<^bsub>poly_ring R\<^esub> b"
+  let ?pmult  = "\<lambda>a b. a \<otimes>\<^bsub>poly_ring R\<^esub> b"
+  let ?pminus = "\<lambda>a b. a \<ominus>\<^bsub>poly_ring R\<^esub> b"
+
+  interpret UP: domain "poly_ring R"
+    using univ_poly_is_domain[OF carrier_is_subring] .
+
+  obtain b r where ldiv: "long_divides p q (b, r)"
+    using exists_long_division[OF assms] by metis
+
+  moreover have "(b, r) = (b', r')" if "long_divides p q (b', r')" for b' r'
+  proof -
+    have q: "q \<in> carrier (poly_ring R)" "q \<noteq> []"
+      using assms(3-4) carrier_polynomial[OF subfieldE(1)[OF assms(1)]]
+      unfolding univ_poly_carrier by auto 
+    hence in_carrier: "q \<in> carrier (poly_ring R)"
+      "b  \<in> carrier (poly_ring R)" "r  \<in> carrier (poly_ring R)"
+      "b' \<in> carrier (poly_ring R)" "r' \<in> carrier (poly_ring R)" 
+      using assms(3) that ldiv unfolding long_divides_def by auto
+    have "?pminus (?padd (?pmult q b) r) r' = ?pminus (?padd (?pmult q b') r') r'"
+      using ldiv and that unfolding long_divides_def by auto
+    hence eq: "?padd (?pmult q (?pminus b b')) (?pminus r r') = \<zero>\<^bsub>poly_ring R\<^esub>"
+      using in_carrier by algebra
+    have "b = b'"
+    proof (rule ccontr)
+      assume "b \<noteq> b'"
+      hence pminus: "?pminus b b' \<noteq> \<zero>\<^bsub>poly_ring R\<^esub>" "?pminus b b' \<in> carrier (poly_ring R)"
+        using in_carrier(2,4) by (metis UP.add.inv_closed UP.l_neg UP.minus_eq UP.minus_unique, algebra)
+      hence degree_ge: "degree (?pmult q (?pminus b b')) \<ge> degree q"
+        using poly_mult_degree_eq[OF carrier_is_subring, of q "?pminus b b'"] q
+        unfolding univ_poly_zero univ_poly_carrier univ_poly_mult by simp
+
+      have "?pminus b b' = \<zero>\<^bsub>poly_ring R\<^esub>" if "?pminus r r' = \<zero>\<^bsub>poly_ring R\<^esub>"
+        using eq pminus(2) q UP.integral univ_poly_zero unfolding that by auto 
+      hence "?pminus r r' \<noteq> []"
+        using pminus(1) unfolding univ_poly_zero by blast
+      moreover have "?pminus r r' = []" if "r = []" and "r' = []"
+        using univ_poly_a_inv_def'[OF carrier_is_subring UP.zero_closed] that
+        unfolding a_minus_def univ_poly_add univ_poly_zero by auto
+      ultimately have "r \<noteq> [] \<or> r' \<noteq> []"
+        by blast
+      hence "max (degree r) (degree r') < degree q"
+        using ldiv and that unfolding long_divides_def by auto
+      moreover have "degree (?pminus r r') \<le> max (degree r) (degree r')"
+        using poly_add_degree[of r "map (a_inv R) r'"]
+        unfolding a_minus_def univ_poly_add univ_poly_a_inv_def'[OF carrier_is_subring in_carrier(5)]
+        by auto
+      ultimately have degree_lt: "degree (?pminus r r') < degree q"
+        by linarith
+      have is_poly: "polynomial (carrier R) (?pmult q (?pminus b b'))" "polynomial (carrier R) (?pminus r r')"
+        using in_carrier pminus(2) unfolding univ_poly_carrier by algebra+
+      
+      have "degree (?padd (?pmult q (?pminus b b')) (?pminus r r')) = degree (?pmult q (?pminus b b'))"
+        using poly_add_degree_eq[OF carrier_is_subring is_poly] degree_ge degree_lt
+        unfolding univ_poly_carrier sym[OF univ_poly_add[of R "carrier R"]] max_def by simp
+      hence "degree (?padd (?pmult q (?pminus b b')) (?pminus r r')) > 0"
+        using degree_ge degree_lt by simp
+      moreover have "degree (?padd (?pmult q (?pminus b b')) (?pminus r r')) = 0"
+        using eq unfolding univ_poly_zero by simp
+      ultimately show False by simp
+    qed
+    hence "?pminus r r' = \<zero>\<^bsub>poly_ring R\<^esub>"
+      using in_carrier eq by algebra
+    hence "r = r'"
+      using in_carrier by (metis UP.add.inv_closed UP.add.right_cancel UP.minus_eq UP.r_neg)
+    with \<open>b = b'\<close> show ?thesis
+      by simp
+  qed
+
+  ultimately show ?thesis
+    by auto
+qed
+
+lemma (in domain) long_divisionE:
+  assumes "subfield K R" and "p \<in> carrier (K[X])" and "q \<in> carrier (K[X])" "q \<noteq> []"
+  shows "long_divides p q (p pdiv q, p pmod q)"
+  using theI'[OF exists_unique_long_division[OF assms]] assms(4)
+  unfolding pmod_def pdiv_def long_division_def by auto
+
+lemma (in domain) long_divisionI:
+  assumes "subfield K R" and "p \<in> carrier (K[X])" and "q \<in> carrier (K[X])" "q \<noteq> []"
+  shows "long_divides p q (b, r) \<Longrightarrow> (b, r) = (p pdiv q, p pmod q)"
+  using exists_unique_long_division[OF assms] long_divisionE[OF assms] by metis
+
+lemma (in domain) long_division_closed:
+  assumes "subfield K R" and "p \<in> carrier (K[X])" "q \<in> carrier (K[X])"
+  shows "p pdiv q \<in> carrier (K[X])" and "p pmod q \<in> carrier (K[X])"
+proof -
+  have "p pdiv q \<in> carrier (K[X]) \<and> p pmod q \<in> carrier (K[X])"
+    using assms univ_poly_zero_closed[of R] long_divisionI[of K] exists_long_division[OF assms]
+    by (cases "q = []") (simp add: pdiv_def pmod_def, metis Pair_inject)+
+  thus "p pdiv q \<in> carrier (K[X])" and "p pmod q \<in> carrier (K[X])"
+    by auto
+qed
+
+lemma (in domain) pdiv_pmod:
+  assumes "subfield K R" and "p \<in> carrier (K[X])" "q \<in> carrier (K[X])"
+  shows "p = (q \<otimes>\<^bsub>K[X]\<^esub> (p pdiv q)) \<oplus>\<^bsub>K[X]\<^esub> (p pmod q)"
+proof (cases)
+  interpret UP: ring "K[X]"
+    using univ_poly_is_ring[OF subfieldE(1)[OF assms(1)]] .
+  assume "q = []" thus ?thesis
+    using assms(2) unfolding pdiv_def pmod_def sym[OF univ_poly_zero[of R K]] by simp
+next
+  assume "q \<noteq> []" thus ?thesis
+    using long_divisionE[OF assms] unfolding long_divides_def univ_poly_mult univ_poly_add by simp
+qed
+
+lemma (in domain) pmod_degree:
+  assumes "subfield K R" and "p \<in> carrier (K[X])" and "q \<in> carrier (K[X])" "q \<noteq> []"
+  shows "p pmod q = [] \<or> degree (p pmod q) < degree q"
+  using long_divisionE[OF assms] unfolding long_divides_def by auto
+
+lemma (in domain) pmod_const:
+  assumes "subfield K R" and "p \<in> carrier (K[X])" "q \<in> carrier (K[X])" and "degree q > degree p" 
+  shows "p pdiv q = []" and "p pmod q = p"
+proof -
+  have "p pdiv q = [] \<and> p pmod q = p"
+  proof (cases)
+    interpret UP: ring "K[X]"
+      using univ_poly_is_ring[OF subfieldE(1)[OF assms(1)]] .
+
+    assume "q \<noteq> []"
+    have "p = (q \<otimes>\<^bsub>K[X]\<^esub> []) \<oplus>\<^bsub>K[X]\<^esub> p"
+      using assms(2-3) unfolding sym[OF univ_poly_zero[of R K]] by simp
+    moreover have "([], p) \<in> carrier (poly_ring R) \<times> carrier (poly_ring R)"
+      using carrier_polynomial_shell[OF subfieldE(1)[OF assms(1)] assms(2)] by auto
+    ultimately have "long_divides p q ([], p)"
+      using assms(4) unfolding long_divides_def univ_poly_mult univ_poly_add by auto
+    with \<open>q \<noteq> []\<close> show ?thesis
+      using long_divisionI[OF assms(1-3)] by auto
+  qed (simp add: pmod_def pdiv_def)
+  thus "p pdiv q = []" and "p pmod q = p"
+    by auto
+qed
+
+lemma (in domain) long_division_zero:
+  assumes "subfield K R" and "q \<in> carrier (K[X])" shows "[] pdiv q = []" and "[] pmod q = []"
+proof -
+  interpret UP: ring "poly_ring R"
+    using univ_poly_is_ring[OF carrier_is_subring] .
+
+  have "[] pdiv q = [] \<and> [] pmod q = []"
+  proof (cases)
+    assume "q \<noteq> []"
+    have "q \<in> carrier (poly_ring R)"
+      using carrier_polynomial_shell[OF subfieldE(1)[OF assms(1)] assms(2)] .
+    hence "long_divides [] q ([], [])"
+      unfolding long_divides_def sym[OF univ_poly_zero[of R "carrier R"]] by auto
+    with \<open>q \<noteq> []\<close> show ?thesis
+      using long_divisionI[OF assms(1) univ_poly_zero_closed assms(2)] by simp
+  qed (simp add: pmod_def pdiv_def)
+  thus "[] pdiv q = []" and "[] pmod q = []"
+    by auto
+qed
+
+lemma (in domain) long_division_a_inv:
+  assumes "subfield K R" and "p \<in> carrier (K[X])" "q \<in> carrier (K[X])"
+  shows "((\<ominus>\<^bsub>K[X]\<^esub> p) pdiv q) = \<ominus>\<^bsub>K[X]\<^esub> (p pdiv q)" (is "?pdiv")
+    and "((\<ominus>\<^bsub>K[X]\<^esub> p) pmod q) = \<ominus>\<^bsub>K[X]\<^esub> (p pmod q)" (is "?pmod")
+proof -
+  interpret UP: ring "K[X]"
+    using univ_poly_is_ring[OF subfieldE(1)[OF assms(1)]] .
+
+  have "?pdiv \<and> ?pmod"
+  proof (cases)
+    assume "q = []" thus ?thesis
+      unfolding pmod_def pdiv_def sym[OF univ_poly_zero[of R K]] by simp
+  next
+    assume not_nil: "q \<noteq> []"
+    have "\<ominus>\<^bsub>K[X]\<^esub> p = \<ominus>\<^bsub>K[X]\<^esub> ((q \<otimes>\<^bsub>K[X]\<^esub> (p pdiv q)) \<oplus>\<^bsub>K[X]\<^esub> (p pmod q))"
+      using pdiv_pmod[OF assms] by simp
+    hence "\<ominus>\<^bsub>K[X]\<^esub> p = (q \<otimes>\<^bsub>K[X]\<^esub> (\<ominus>\<^bsub>K[X]\<^esub> (p pdiv q))) \<oplus>\<^bsub>K[X]\<^esub> (\<ominus>\<^bsub>K[X]\<^esub> (p pmod q))"
+      using assms(2-3) long_division_closed[OF assms] by algebra
+    moreover have "\<ominus>\<^bsub>K[X]\<^esub> (p pdiv q) \<in> carrier (K[X])" "\<ominus>\<^bsub>K[X]\<^esub> (p pmod q) \<in> carrier (K[X])"
+      using long_division_closed[OF assms] by algebra+
+    hence "(\<ominus>\<^bsub>K[X]\<^esub> (p pdiv q), \<ominus>\<^bsub>K[X]\<^esub> (p pmod q)) \<in> carrier (poly_ring R) \<times> carrier (poly_ring R)"
+      using carrier_polynomial_shell[OF subfieldE(1)[OF assms(1)]] by auto
+    moreover have "\<ominus>\<^bsub>K[X]\<^esub> (p pmod q) = [] \<or> degree (\<ominus>\<^bsub>K[X]\<^esub> (p pmod q)) < degree q"
+      using univ_poly_a_inv_length[OF subfieldE(1)[OF assms(1)]
+            long_division_closed(2)[OF assms]] pmod_degree[OF assms not_nil]
+      by auto
+    ultimately have "long_divides (\<ominus>\<^bsub>K[X]\<^esub> p) q (\<ominus>\<^bsub>K[X]\<^esub> (p pdiv q), \<ominus>\<^bsub>K[X]\<^esub> (p pmod q))"
+      unfolding long_divides_def univ_poly_mult univ_poly_add by simp
+    thus ?thesis
+      using long_divisionI[OF assms(1) UP.a_inv_closed[OF assms(2)] assms(3) not_nil] by simp
+  qed
+  thus ?pdiv and ?pmod
+    by auto
+qed
+
+lemma (in domain) long_division_add:
+  assumes "subfield K R" and "a \<in> carrier (K[X])" "b \<in> carrier (K[X])" "q \<in> carrier (K[X])"
+  shows "(a \<oplus>\<^bsub>K[X]\<^esub> b) pdiv q = (a pdiv q) \<oplus>\<^bsub>K[X]\<^esub> (b pdiv q)" (is "?pdiv")
+    and "(a \<oplus>\<^bsub>K[X]\<^esub> b) pmod q = (a pmod q) \<oplus>\<^bsub>K[X]\<^esub> (b pmod q)" (is "?pmod")
+proof -
+  let ?pdiv_add = "(a pdiv q) \<oplus>\<^bsub>K[X]\<^esub> (b pdiv q)"
+  let ?pmod_add = "(a pmod q) \<oplus>\<^bsub>K[X]\<^esub> (b pmod q)"
+
+  interpret UP: ring "K[X]"
+    using univ_poly_is_ring[OF subfieldE(1)[OF assms(1)]] .
+
+  have "?pdiv \<and> ?pmod"
+  proof (cases)
+    assume "q = []" thus ?thesis
+      using assms(2-3) unfolding pmod_def pdiv_def sym[OF univ_poly_zero[of R K]] by simp
+  next
+    note in_carrier = long_division_closed[OF assms(1,2,4)]
+                      long_division_closed[OF assms(1,3,4)]
+
+    assume "q \<noteq> []"
+    have "a \<oplus>\<^bsub>K[X]\<^esub> b = ((q \<otimes>\<^bsub>K[X]\<^esub> (a pdiv q)) \<oplus>\<^bsub>K[X]\<^esub> (a pmod q)) \<oplus>\<^bsub>K[X]\<^esub>
+                         ((q \<otimes>\<^bsub>K[X]\<^esub> (b pdiv q)) \<oplus>\<^bsub>K[X]\<^esub> (b pmod q))"
+      using assms(2-3)[THEN pdiv_pmod[OF assms(1) _ assms(4)]] by simp
+    hence "a \<oplus>\<^bsub>K[X]\<^esub> b = (q \<otimes>\<^bsub>K[X]\<^esub> ?pdiv_add) \<oplus>\<^bsub>K[X]\<^esub> ?pmod_add"
+      using assms(4) in_carrier by algebra
+    moreover have "(?pdiv_add, ?pmod_add) \<in> carrier (poly_ring R) \<times> carrier (poly_ring R)"
+      using in_carrier carrier_polynomial_shell[OF subfieldE(1)[OF assms(1)]] by auto
+    moreover have "?pmod_add = [] \<or> degree ?pmod_add < degree q"
+    proof (cases)
+      assume "?pmod_add \<noteq> []"
+      hence "a pmod q \<noteq> [] \<or> b pmod q \<noteq> []"
+        using in_carrier(2,4) unfolding sym[OF univ_poly_zero[of R K]] by auto
+      moreover from \<open>q \<noteq> []\<close>
+      have "a pmod q = [] \<or> degree (a pmod q) < degree q" and "b pmod q = [] \<or> degree (b pmod q) < degree q"
+        using assms(2-3)[THEN pmod_degree[OF assms(1) _ assms(4)]] by auto
+      ultimately have "max (degree (a pmod q)) (degree (b pmod q)) < degree q"
+        by auto
+      thus ?thesis
+        using poly_add_degree le_less_trans unfolding univ_poly_add by blast
+    qed simp
+    ultimately have "long_divides (a \<oplus>\<^bsub>K[X]\<^esub> b) q (?pdiv_add, ?pmod_add)"
+      unfolding long_divides_def univ_poly_mult univ_poly_add by simp
+    with \<open>q \<noteq> []\<close> show ?thesis
+      using long_divisionI[OF assms(1) UP.a_closed[OF assms(2-3)] assms(4)] by simp
+  qed
+  thus ?pdiv and ?pmod
+    by auto
+qed
+
+lemma (in domain) long_division_add_iff:
+  assumes "subfield K R"
+    and "a \<in> carrier (K[X])" "b \<in> carrier (K[X])" "c \<in> carrier (K[X])" "q \<in> carrier (K[X])"
+  shows "a pmod q = b pmod q \<longleftrightarrow> (a \<oplus>\<^bsub>K[X]\<^esub> c) pmod q = (b \<oplus>\<^bsub>K[X]\<^esub> c) pmod q"
+proof -
+  interpret UP: ring "K[X]"
+    using univ_poly_is_ring[OF subfieldE(1)[OF assms(1)]] .
+  show ?thesis
+    using assms(2-4)[THEN long_division_closed(2)[OF assms(1) _ assms(5)]]
+    unfolding assms(2-3)[THEN long_division_add(2)[OF assms(1) _ assms(4-5)]] by auto
+qed
+
+lemma (in domain) pdivides_iff:
+  assumes "subfield K R" and "polynomial K p" "polynomial K q"
+  shows "p pdivides q \<longleftrightarrow> p divides\<^bsub>K[X]\<^esub> q"
+proof
+  show "p divides\<^bsub>K [X]\<^esub> q \<Longrightarrow> p pdivides q"
+    using carrier_polynomial[OF subfieldE(1)[OF assms(1)]]
+    unfolding pdivides_def factor_def univ_poly_mult univ_poly_carrier by auto
+next
+  interpret UP: ring "poly_ring R"
+    using univ_poly_is_ring[OF carrier_is_subring] .
+  
+  have in_carrier: "p \<in> carrier (poly_ring R)" "q \<in> carrier (poly_ring R)"
+    using carrier_polynomial[OF subfieldE(1)[OF assms(1)]] assms
+    unfolding univ_poly_carrier by auto
+
+  assume "p pdivides q"
+  then obtain b where "b \<in> carrier (poly_ring R)" and "q = p \<otimes>\<^bsub>poly_ring R\<^esub> b"
+      unfolding pdivides_def factor_def by blast
+  show "p divides\<^bsub>K[X]\<^esub> q"
+  proof (cases)
+    assume "p = []"
+    with \<open>b \<in> carrier (poly_ring R)\<close> and \<open>q = p \<otimes>\<^bsub>poly_ring R\<^esub> b\<close> have "q = []"
+      unfolding univ_poly_mult sym[OF univ_poly_carrier]
+      using poly_mult_zero(1)[OF polynomial_incl] by simp
+    with \<open>p = []\<close> show ?thesis
+      using poly_mult_zero(2)[of "[]"]
+      unfolding factor_def univ_poly_mult by auto 
+  next
+    interpret UP: ring "poly_ring R"
+      using univ_poly_is_ring[OF carrier_is_subring] .
+
+    assume "p \<noteq> []"
+    from \<open>p pdivides q\<close> obtain b where "b \<in> carrier (poly_ring R)" and "q = p \<otimes>\<^bsub>poly_ring R\<^esub> b"
+      unfolding pdivides_def factor_def by blast
+    moreover have "p \<in> carrier (poly_ring R)" and "q \<in> carrier (poly_ring R)"
+      using assms carrier_polynomial[OF subfieldE(1)[OF assms(1)]] unfolding univ_poly_carrier by auto
+    ultimately have "q = (p \<otimes>\<^bsub>poly_ring R\<^esub> b) \<oplus>\<^bsub>poly_ring R\<^esub> \<zero>\<^bsub>poly_ring R\<^esub>"
+      by algebra
+    with \<open>b \<in> carrier (poly_ring R)\<close> have "long_divides q p (b, [])"
+      unfolding long_divides_def univ_poly_zero by auto
+    with \<open>p \<noteq> []\<close> have "b \<in> carrier (K[X])"
+      using long_divisionI[of K q p b] long_division_closed[of K q p] assms
+      unfolding univ_poly_carrier by auto
+    with \<open>q = p \<otimes>\<^bsub>poly_ring R\<^esub> b\<close> show ?thesis
+      unfolding factor_def univ_poly_mult by blast
+  qed
+qed
+
+lemma (in domain) pdivides_iff_shell:
+  assumes "subfield K R" and "p \<in> carrier (K[X])" "q \<in> carrier (K[X])"
+  shows "p pdivides q \<longleftrightarrow> p divides\<^bsub>K[X]\<^esub> q"
+  using pdivides_iff assms by (simp add: univ_poly_carrier)
+
+lemma (in domain) pmod_zero_iff_pdivides:
+  assumes "subfield K R" and "p \<in> carrier (K[X])" "q \<in> carrier (K[X])"
+  shows "p pmod q = [] \<longleftrightarrow> q pdivides p"
+proof -
+  interpret UP: domain "K[X]"
+    using univ_poly_is_domain[OF subfieldE(1)[OF assms(1)]] .
+
+  show ?thesis
+  proof
+    assume pmod: "p pmod q = []"
+    have "p pdiv q \<in> carrier (K[X])" and "p pmod q \<in> carrier (K[X])"
+      using long_division_closed[OF assms] by auto
+    hence "p = q \<otimes>\<^bsub>K[X]\<^esub> (p pdiv q)"
+      using pdiv_pmod[OF assms] assms(3) unfolding pmod sym[OF univ_poly_zero[of R K]] by algebra
+    with \<open>p pdiv q \<in> carrier (K[X])\<close> show "q pdivides p"
+      unfolding pdivides_iff_shell[OF assms(1,3,2)] factor_def by blast
+  next
+    assume "q pdivides p" show "p pmod q = []"
+    proof (cases)
+      assume "q = []" with \<open>q pdivides p\<close> show ?thesis
+        using zero_pdivides unfolding pmod_def by simp
+    next
+      assume "q \<noteq> []"
+      from \<open>q pdivides p\<close> obtain r where "r \<in> carrier (K[X])" and "p = q \<otimes>\<^bsub>K[X]\<^esub> r"
+        unfolding pdivides_iff_shell[OF assms(1,3,2)] factor_def by blast
+      hence "p = (q \<otimes>\<^bsub>K[X]\<^esub> r) \<oplus>\<^bsub>K[X]\<^esub> []"
+        using assms(2) unfolding sym[OF univ_poly_zero[of R K]] by simp
+      moreover from \<open>r \<in> carrier (K[X])\<close> have "r \<in> carrier (poly_ring R)"
+        using carrier_polynomial_shell[OF subfieldE(1)[OF assms(1)]] by auto
+      ultimately have "long_divides p q (r, [])"
+        unfolding long_divides_def univ_poly_mult univ_poly_add by auto
+      with \<open>q \<noteq> []\<close> show ?thesis
+        using long_divisionI[OF assms] by simp
+    qed
+  qed
+qed
+
+lemma (in domain) same_pmod_iff_pdivides:
+  assumes "subfield K R" and "a \<in> carrier (K[X])" "b \<in> carrier (K[X])" "q \<in> carrier (K[X])"
+  shows "a pmod q = b pmod q \<longleftrightarrow> q pdivides (a \<ominus>\<^bsub>K[X]\<^esub> b)"
+proof -
+  interpret UP: domain "K[X]"
+    using univ_poly_is_domain[OF subfieldE(1)[OF assms(1)]] .
+
+  have "a pmod q = b pmod q \<longleftrightarrow> (a \<oplus>\<^bsub>K[X]\<^esub> (\<ominus>\<^bsub>K[X]\<^esub> b)) pmod q = (b \<oplus>\<^bsub>K[X]\<^esub> (\<ominus>\<^bsub>K[X]\<^esub> b)) pmod q"
+    using long_division_add_iff[OF assms(1-3) UP.a_inv_closed[OF assms(3)] assms(4)] .
+  also have " ... \<longleftrightarrow> (a \<ominus>\<^bsub>K[X]\<^esub> b) pmod q = \<zero>\<^bsub>K[X]\<^esub> pmod q"
+    using assms(2-3) by algebra
+  also have " ... \<longleftrightarrow> q pdivides (a \<ominus>\<^bsub>K[X]\<^esub> b)"
+    using pmod_zero_iff_pdivides[OF assms(1) UP.minus_closed[OF assms(2-3)] assms(4)]
+    unfolding univ_poly_zero long_division_zero(2)[OF assms(1,4)] .
+  finally show ?thesis .
+qed
+
+lemma (in domain) pdivides_imp_degree_le:
+  assumes "subring K R" and "p \<in> carrier (K[X])" "q \<in> carrier (K[X])" "q \<noteq> []"
+  shows "p pdivides q \<Longrightarrow> degree p \<le> degree q"
+proof -
+  assume "p pdivides q"
+  then obtain r where r: "polynomial (carrier R) r" "q = poly_mult p r"
+    unfolding pdivides_def factor_def univ_poly_mult univ_poly_carrier by blast
+  moreover have p: "polynomial (carrier R) p"
+    using assms(2) carrier_polynomial[OF assms(1)] unfolding univ_poly_carrier by auto
+  moreover have "p \<noteq> []" and "r \<noteq> []"
+    using poly_mult_zero(2)[OF polynomial_incl[OF p]] r(2) assms(4) by auto 
+  ultimately show "degree p \<le> degree q"
+    using poly_mult_degree_eq[OF carrier_is_subring, of p r] by auto
+qed
+
+lemma (in domain) pprimeE:
+  assumes "subfield K R" "p \<in> carrier (K[X])" "pprime K p"
+  shows "p \<noteq> []" "p \<notin> Units (K[X])"
+    and "\<And>q r. \<lbrakk> q \<in> carrier (K[X]); r \<in> carrier (K[X])\<rbrakk> \<Longrightarrow>
+                 p pdivides (q \<otimes>\<^bsub>K[X]\<^esub> r) \<Longrightarrow> p pdivides q \<or> p pdivides r"
+  using assms(2-3) poly_mult_closed[OF subfieldE(1)[OF assms(1)]] pdivides_iff[OF assms(1)]
+  unfolding ring_prime_def prime_def 
+  by (auto simp add: univ_poly_mult univ_poly_carrier univ_poly_zero)
+
+lemma (in domain) pprimeI:
+  assumes "subfield K R" "p \<in> carrier (K[X])" "p \<noteq> []" "p \<notin> Units (K[X])"
+    and "\<And>q r. \<lbrakk> q \<in> carrier (K[X]); r \<in> carrier (K[X])\<rbrakk> \<Longrightarrow>
+                 p pdivides (q \<otimes>\<^bsub>K[X]\<^esub> r) \<Longrightarrow> p pdivides q \<or> p pdivides r"
+  shows "pprime K p"
+  using assms(2-5) poly_mult_closed[OF subfieldE(1)[OF assms(1)]] pdivides_iff[OF assms(1)]
+  unfolding ring_prime_def prime_def
+  by (auto simp add: univ_poly_mult univ_poly_carrier univ_poly_zero)
+
+lemma (in domain) associated_polynomials_iff:
+  assumes "subfield K R" and "p \<in> carrier (K[X])" "q \<in> carrier (K[X])"
+  shows "p \<sim>\<^bsub>K[X]\<^esub> q \<longleftrightarrow> (\<exists>k \<in> K - { \<zero> }. p = [ k ] \<otimes>\<^bsub>K[X]\<^esub> q)"
+  using domain.ring_associated_iff[OF univ_poly_is_domain[OF subfieldE(1)[OF assms(1)]] assms(2-3)]
+  unfolding univ_poly_units[OF assms(1)] by auto
+
+corollary (in domain) associated_polynomials_imp_same_length: (* stronger than "imp_same_degree" *)
+  assumes "subfield K R" and "p \<in> carrier (K[X])" "q \<in> carrier (K[X])"
+  shows "p \<sim>\<^bsub>K[X]\<^esub> q \<Longrightarrow> length p = length q"
+  unfolding associated_polynomials_iff[OF assms]
+  using poly_mult_const(1)[OF subfieldE(1)[OF assms(1)],of q] assms(3)
+  by (auto simp add: univ_poly_carrier univ_poly_mult simp del: poly_mult.simps)
+
+
+subsection \<open>Ideals\<close>
+
+lemma (in domain) exists_unique_gen:
+  assumes "subfield K R" "ideal I (K[X])" "I \<noteq> { [] }"
+  shows "\<exists>!p \<in> carrier (K[X]). lead_coeff p = \<one> \<and> I = PIdl\<^bsub>K[X]\<^esub> p"
+    (is "\<exists>!p. ?generator p")
+proof -
+  interpret UP: principal_domain "K[X]"
+    using univ_poly_is_principal[OF assms(1)] .
+  obtain q where q: "q \<in> carrier (K[X])" "I = PIdl\<^bsub>K[X]\<^esub> q"
+    using UP.exists_gen[OF assms(2)] by blast
+  hence not_nil: "q \<noteq> []"
+    using UP.genideal_zero UP.cgenideal_eq_genideal[OF UP.zero_closed] assms(3)
+    by (auto simp add: univ_poly_zero)
+  hence "lead_coeff q \<in> K - { \<zero> }"
+    using q(1) unfolding univ_poly_def polynomial_def by auto
+  hence inv_lc_q: "inv (lead_coeff q) \<in> K - { \<zero> }" "inv (lead_coeff q) \<otimes> lead_coeff q = \<one>"
+    using subfield_m_inv[OF assms(1)] by auto 
+
+  define p where "p = [ inv (lead_coeff q) ] \<otimes>\<^bsub>K[X]\<^esub> q"
+  have is_poly: "polynomial K [ inv (lead_coeff q) ]" "polynomial K q"
+    using inv_lc_q(1) q(1) unfolding univ_poly_def polynomial_def by auto
+  hence in_carrier: "p \<in> carrier (K[X])"
+    using UP.m_closed unfolding univ_poly_carrier p_def by simp
+  have lc_p: "lead_coeff p = \<one>"
+    using poly_mult_lead_coeff[OF subfieldE(1)[OF assms(1)] is_poly _ not_nil] inv_lc_q(2)
+    unfolding p_def univ_poly_mult[of R K] by simp
+  moreover have PIdl_p: "I = PIdl\<^bsub>K[X]\<^esub> p"
+    using UP.associated_iff_same_ideal[OF in_carrier q(1)] q(2) inv_lc_q(1) p_def
+          associated_polynomials_iff[OF assms(1) in_carrier q(1)]
+    by auto
+  ultimately have "?generator p"
+    using in_carrier by simp
+
+  moreover
+  have "\<And>r. \<lbrakk> r \<in> carrier (K[X]); lead_coeff r = \<one>; I = PIdl\<^bsub>K[X]\<^esub> r \<rbrakk> \<Longrightarrow> r = p"
+  proof -
+    fix r assume r: "r \<in> carrier (K[X])" "lead_coeff r = \<one>" "I = PIdl\<^bsub>K[X]\<^esub> r"
+    obtain k where k: "k \<in> K - { \<zero> }" "r = [ k ] \<otimes>\<^bsub>K[X]\<^esub> p"
+      using UP.associated_iff_same_ideal[OF r(1) in_carrier] PIdl_p r(3)
+            associated_polynomials_iff[OF assms(1) r(1) in_carrier]
+      by auto
+    hence "polynomial K [ k ]"
+      unfolding polynomial_def by simp
+    moreover have "p \<noteq> []"
+      using not_nil UP.associated_iff_same_ideal[OF in_carrier q(1)] q(2) PIdl_p
+            associated_polynomials_imp_same_length[OF assms(1) in_carrier q(1)] by auto
+    ultimately have "lead_coeff r = k \<otimes> (lead_coeff p)"
+      using poly_mult_lead_coeff[OF subfieldE(1)[OF assms(1)]] in_carrier k(2)
+      unfolding univ_poly_def by (auto simp del: poly_mult.simps)
+    hence "k = \<one>"
+      using lc_p r(2) k(1) subfieldE(3)[OF assms(1)] by auto
+    hence "r = map ((\<otimes>) \<one>) p"
+      using poly_mult_const(1)[OF subfieldE(1)[OF assms(1)] _ k(1), of p] in_carrier
+      unfolding k(2) univ_poly_carrier[of R K] univ_poly_mult[of R K] by auto
+    moreover have "set p \<subseteq> carrier R"
+      using polynomial_in_carrier[OF subfieldE(1)[OF assms(1)]]
+            in_carrier univ_poly_carrier[of R K] by auto
+    hence "map ((\<otimes>) \<one>) p = p"
+      by (induct p) (auto)
+    ultimately show "r = p" by simp
+  qed
+
+  ultimately show ?thesis by blast
+qed
+
+proposition (in domain) exists_unique_pirreducible_gen:
+  assumes "subfield K R" "ring_hom_ring (K[X]) R h"
+    and "a_kernel (K[X]) R h \<noteq> { [] }" "a_kernel (K[X]) R h \<noteq> carrier (K[X])"
+  shows "\<exists>!p \<in> carrier (K[X]). pirreducible K p \<and> lead_coeff p = \<one> \<and> a_kernel (K[X]) R h = PIdl\<^bsub>K[X]\<^esub> p"
+    (is "\<exists>!p. ?generator p")
+proof -
+  interpret UP: principal_domain "K[X]"
+    using univ_poly_is_principal[OF assms(1)] .
+
+  have "ideal (a_kernel (K[X]) R h) (K[X])"
+    using ring_hom_ring.kernel_is_ideal[OF assms(2)] .
+  then obtain p
+    where p: "p \<in> carrier (K[X])" "lead_coeff p = \<one>" "a_kernel (K[X]) R h = PIdl\<^bsub>K[X]\<^esub> p"
+      and unique:
+      "\<And>q. \<lbrakk> q \<in> carrier (K[X]); lead_coeff q = \<one>; a_kernel (K[X]) R h = PIdl\<^bsub>K[X]\<^esub> q \<rbrakk> \<Longrightarrow> q = p"
+    using exists_unique_gen[OF assms(1) _ assms(3)] by metis
+
+  have "p \<in> carrier (K[X]) - { [] }"
+      using UP.genideal_zero UP.cgenideal_eq_genideal[OF UP.zero_closed] assms(3) p(1,3)
+      by (auto simp add: univ_poly_zero)
+  hence "pprime K p"
+    using ring_hom_ring.primeideal_vimage[OF assms(2) UP.is_cring zeroprimeideal]
+          UP.primeideal_iff_prime[of p]
+    unfolding univ_poly_zero sym[OF p(3)] a_kernel_def' by simp
+  hence "pirreducible K p"
+    using pprime_iff_pirreducible[OF assms(1) p(1)] by simp
+  thus ?thesis
+    using p unique by metis 
+qed
+
+lemma (in domain) cgenideal_pirreducible:
+  assumes "subfield K R" and "p \<in> carrier (K[X])" "pirreducible K p" 
+  shows "\<lbrakk> pirreducible K q; q \<in> PIdl\<^bsub>K[X]\<^esub> p \<rbrakk> \<Longrightarrow> p \<sim>\<^bsub>K[X]\<^esub> q"
+proof -
+  interpret UP: principal_domain "K[X]"
+    using univ_poly_is_principal[OF assms(1)] .
+
+  assume q: "pirreducible K q" "q \<in> PIdl\<^bsub>K[X]\<^esub> p"
+  hence in_carrier: "q \<in> carrier (K[X])"
+    using additive_subgroup.a_subset[OF ideal.axioms(1)[OF UP.cgenideal_ideal[OF assms(2)]]] by auto
+  hence "p divides\<^bsub>K[X]\<^esub> q"
+    by (meson q assms(2) UP.cgenideal_ideal UP.cgenideal_minimal UP.to_contain_is_to_divide)
+  then obtain r where r: "r \<in> carrier (K[X])" "q = p \<otimes>\<^bsub>K[X]\<^esub> r"
+    by auto
+  hence "r \<in> Units (K[X])"
+    using pirreducibleE(3)[OF _ in_carrier q(1) assms(2) r(1)] subfieldE(1)[OF assms(1)]
+          pirreducibleE(2)[OF _ assms(2-3)] by auto
+  thus "p \<sim>\<^bsub>K[X]\<^esub> q"
+    using UP.ring_associated_iff[OF in_carrier assms(2)] r(2) UP.associated_sym
+    unfolding UP.m_comm[OF assms(2) r(1)] by auto
+qed
+
+
+subsection \<open>Roots and Multiplicity\<close>
+
+lemma (in domain) pdivides_imp_root_sharing:
+  assumes "p \<in> carrier (poly_ring R)" "p pdivides q" and "a \<in> carrier R"
+  shows "eval p a = \<zero> \<Longrightarrow> eval q a = \<zero>"
+proof - 
+  from \<open>p pdivides q\<close> obtain r where r: "q = p \<otimes>\<^bsub>poly_ring R\<^esub> r" "r \<in> carrier (poly_ring R)"
+    unfolding pdivides_def factor_def by auto
+  hence "eval q a = (eval p a) \<otimes> (eval r a)"
+    using ring_hom_memE(2)[OF eval_is_hom[OF carrier_is_subring assms(3)] assms(1) r(2)] by simp
+  thus "eval p a = \<zero> \<Longrightarrow> eval q a = \<zero>"
+    using ring_hom_memE(1)[OF eval_is_hom[OF carrier_is_subring assms(3)] r(2)] by auto
+qed
+
+lemma (in domain) degree_one_root:
+  assumes "subfield K R" and "p \<in> carrier (K[X])" and "degree p = 1"
+  shows "eval p (\<ominus> (inv (lead_coeff p) \<otimes> (const_term p))) = \<zero>"
+    and "inv (lead_coeff p) \<otimes> (const_term p) \<in> K" 
+proof -
+  from \<open>degree p = 1\<close> have "length p = Suc (Suc 0)"
+    by simp
+  then obtain a b where p: "p = [ a, b ]"
+    by (metis (no_types, hide_lams) Suc_length_conv length_0_conv)
+  hence "a \<in> K - { \<zero> }" "b \<in> K"  and in_carrier: "a \<in> carrier R" "b \<in> carrier R"
+    using assms(2) subfieldE(3)[OF assms(1)] unfolding sym[OF univ_poly_carrier] polynomial_def by auto
+  hence inv_a: "inv a \<in> carrier R" "a \<otimes> inv a = \<one>" and "inv a \<in> K"
+    using subfield_m_inv(1-2)[OF assms(1), of a] subfieldE(3)[OF assms(1)] by auto 
+  hence "eval p (\<ominus> (inv a \<otimes> b)) = a \<otimes> (\<ominus> (inv a \<otimes> b)) \<oplus> b"
+    using in_carrier unfolding p by simp
+  also have " ... = \<ominus> (a \<otimes> (inv a \<otimes> b)) \<oplus> b"
+    using inv_a in_carrier by (simp add: r_minus)
+  also have " ... = \<zero>"
+    using in_carrier(2) unfolding sym[OF m_assoc[OF in_carrier(1) inv_a(1) in_carrier(2)]] inv_a(2) by algebra
+  finally have "eval p (\<ominus> (inv a \<otimes> b)) = \<zero>" .
+  moreover have ct: "const_term p = b"
+    using in_carrier unfolding p const_term_def by auto
+  ultimately show "eval p (\<ominus> (inv (lead_coeff p) \<otimes> (const_term p))) = \<zero>"
+    unfolding p by simp
+  from \<open>inv a \<in> K\<close> and \<open>b \<in> K\<close>
+  show "inv (lead_coeff p) \<otimes> (const_term p) \<in> K"
+    using p subringE(6)[OF subfieldE(1)[OF assms(1)]] unfolding ct by auto
+qed
+
+
+subsection \<open>Link between @{term \<open>(pmod)\<close>} and @{term rupture_surj}\<close>
+
+lemma (in domain) rupture_surj_composed_with_pmod:
+  assumes "subfield K R" and "p \<in> carrier (K[X])" and "q \<in> carrier (K[X])"
+  shows "rupture_surj K p q = rupture_surj K p (q pmod p)"
+proof -
+  interpret UP: principal_domain "K[X]"
+    using univ_poly_is_principal[OF assms(1)] .
+  interpret Rupt: ring "Rupt K p"
+    using assms by (simp add: UP.cgenideal_ideal ideal.quotient_is_ring rupture_def)
+
+  let ?h = "rupture_surj K p"
+
+  have "?h q = (?h p \<otimes>\<^bsub>Rupt K p\<^esub> ?h (q pdiv p)) \<oplus>\<^bsub>Rupt K p\<^esub> ?h (q pmod p)"
+   and "?h (q pdiv p) \<in> carrier (Rupt K p)" "?h (q pmod p) \<in> carrier (Rupt K p)"
+    using pdiv_pmod[OF assms(1,3,2)] long_division_closed[OF assms(1,3,2)] assms UP.m_closed
+          ring_hom_memE[OF rupture_surj_hom(1)[OF subfieldE(1)[OF assms(1)] assms(2)]]
+    by metis+
+  moreover have "?h p = PIdl\<^bsub>K[X]\<^esub> p"
+    using assms by (simp add: UP.a_rcos_zero UP.cgenideal_ideal UP.cgenideal_self)
+  hence "?h p = \<zero>\<^bsub>Rupt K p\<^esub>"
+    unfolding rupture_def FactRing_def by simp
+  ultimately show ?thesis
+    by simp
+qed
+
+corollary (in domain) rupture_carrier_as_pmod_image:
+  assumes "subfield K R" and "p \<in> carrier (K[X])"
+  shows "(rupture_surj K p) ` ((\<lambda>q. q pmod p) ` (carrier (K[X]))) = carrier (Rupt K p)"
+    (is "?lhs = ?rhs")
+proof
+  have "(\<lambda>q. q pmod p) ` carrier (K[X]) \<subseteq> carrier (K[X])"
+    using long_division_closed(2)[OF assms(1) _ assms(2)] by auto
+  thus "?lhs \<subseteq> ?rhs"
+    using ring_hom_memE(1)[OF rupture_surj_hom(1)[OF subfieldE(1)[OF assms(1)] assms(2)]] by auto
+next
+  show "?rhs \<subseteq> ?lhs"
+  proof
+    fix a assume "a \<in> carrier (Rupt K p)"
+    then obtain q where "q \<in> carrier (K[X])" and "a = rupture_surj K p q"
+      unfolding rupture_def FactRing_def A_RCOSETS_def' by auto
+    thus "a \<in> ?lhs"
+      using rupture_surj_composed_with_pmod[OF assms] by auto
+  qed
+qed
+
+(* Move to Ideal.thy ========================================================= *)
+lemma (in ring) quotient_eq_iff_same_a_r_cos:
+  assumes "ideal I R" and "a \<in> carrier R" and "b \<in> carrier R"
+  shows "a \<ominus> b \<in> I \<longleftrightarrow> I +> a = I +> b"
+proof
+  assume "I +> a = I +> b"
+  then obtain i where "i \<in> I" and "\<zero> \<oplus> a = i \<oplus> b"
+    using additive_subgroup.zero_closed[OF ideal.axioms(1)[OF assms(1)]] assms(2)
+    unfolding a_r_coset_def' by blast
+  hence "a \<ominus> b = i"
+    using assms(2-3) by (metis a_minus_def add.inv_solve_right assms(1) ideal.Icarr l_zero)
+  with \<open>i \<in> I\<close> show "a \<ominus> b \<in> I"
+    by simp
+next
+  assume "a \<ominus> b \<in> I"
+  then obtain i where "i \<in> I" and "a = i \<oplus> b"
+    using ideal.Icarr[OF assms(1)] assms(2-3)
+    by (metis a_minus_def add.inv_solve_right)
+  hence "I +> a = (I +> i) +> b"
+    using ideal.Icarr[OF assms(1)] assms(3)
+    by (simp add: a_coset_add_assoc subsetI)
+  with \<open>i \<in> I\<close> show "I +> a = I +> b"
+    using a_rcos_zero[OF assms(1)] by simp
+qed
+(* ========================================================================== *)
+
+lemma (in domain) rupture_surj_inj_on:
+  assumes "subfield K R" and "p \<in> carrier (K[X])"
+  shows "inj_on (rupture_surj K p) ((\<lambda>q. q pmod p) ` (carrier (K[X])))"
+proof (intro inj_onI)
+  interpret UP: principal_domain "K[X]"
+    using univ_poly_is_principal[OF assms(1)] .
+
+  fix a b
+  assume "a \<in> (\<lambda>q. q pmod p) ` carrier (K[X])"
+     and "b \<in> (\<lambda>q. q pmod p) ` carrier (K[X])"
+  then obtain q s
+    where q: "q \<in> carrier (K[X])" "a = q pmod p"
+      and s: "s \<in> carrier (K[X])" "b = s pmod p"
+    by auto
+  moreover assume "rupture_surj K p a = rupture_surj K p b"
+  ultimately have "q \<ominus>\<^bsub>K[X]\<^esub> s \<in> (PIdl\<^bsub>K[X]\<^esub> p)"
+    using UP.quotient_eq_iff_same_a_r_cos[OF UP.cgenideal_ideal[OF assms(2)], of q s]
+          rupture_surj_composed_with_pmod[OF assms] by auto
+  hence "p pdivides (q \<ominus>\<^bsub>K[X]\<^esub> s)"
+    using assms q(1) s(1) UP.to_contain_is_to_divide pdivides_iff_shell
+    by (meson UP.cgenideal_ideal UP.cgenideal_minimal UP.minus_closed)
+  thus "a = b"
+    unfolding q s same_pmod_iff_pdivides[OF assms(1) q(1) s(1) assms(2)] .
+qed
+
+
+subsection \<open>Dimension\<close>
+
+definition (in ring) exp_base :: "'a \<Rightarrow> nat \<Rightarrow> 'a list"
+  where "exp_base x n = map (\<lambda>i. x [^] i) (rev [0..< n])"
+
+lemma (in ring) exp_base_closed:
+  assumes "x \<in> carrier R" shows "set (exp_base x n) \<subseteq> carrier R"
+  using assms by (induct n) (auto simp add: exp_base_def)
+
+lemma (in ring) exp_base_append:
+  shows "exp_base x (n + m) = (map (\<lambda>i. x [^] i) (rev [n..< n + m])) @ exp_base x n"
+  unfolding exp_base_def by (metis map_append rev_append upt_add_eq_append zero_le)
+
+lemma (in ring) drop_exp_base:
+  shows "drop n (exp_base x m) = exp_base x (m - n)"
+proof -
+  have ?thesis if "n > m"
+    using that by (simp add: exp_base_def)
+  moreover have ?thesis if "n \<le> m"
+    using exp_base_append[of x "m - n" n] that by auto
+  ultimately show ?thesis
+    by linarith 
+qed
+
+lemma (in ring) combine_eq_eval:
+  shows "combine Ks (exp_base x (length Ks)) = eval Ks x"
+  unfolding exp_base_def by (induct Ks) (auto)
+
+lemma (in domain) pmod_image_characterization:
+  assumes "subfield K R" and "p \<in> carrier (K[X])" and "p \<noteq> []"
+  shows "(\<lambda>q. q pmod p) ` carrier (K[X]) = { q \<in> carrier (K[X]). length q \<le> degree p }"
+proof -
+  interpret UP: principal_domain "K[X]"
+    using univ_poly_is_principal[OF assms(1)] .
+
+  show ?thesis
+  proof (intro no_atp(10)[OF subsetI subsetI])
+    fix q assume "q \<in> { q \<in> carrier (K[X]). length q \<le> degree p }"
+    then have "q \<in> carrier (K[X])" and "length q \<le> degree p"
+      by simp+
+
+    show "q \<in> (\<lambda>q. q pmod p) ` carrier (K[X])"
+    proof (cases "q = []")
+      case True
+      have "p pmod p = q"
+        unfolding True pmod_zero_iff_pdivides[OF assms(1,2,2)]
+        using assms(1-2) pdivides_iff_shell by auto
+      thus ?thesis
+        using assms(2) by blast 
+    next
+      case False
+      with \<open>length q \<le> degree p\<close> have "degree q < degree p"
+        using le_eq_less_or_eq by fastforce 
+      with \<open>q \<in> carrier (K[X])\<close> show ?thesis
+        using pmod_const(2)[OF assms(1) _ assms(2), of q] by (metis imageI) 
+    qed
+  next
+    fix q assume "q \<in> (\<lambda>q. q pmod p) ` carrier (K[X])"
+    then obtain q' where "q' \<in> carrier (K[X])" and "q = q' pmod p"
+      by auto
+    thus "q \<in> { q \<in> carrier (K[X]). length q \<le> degree p }"
+      using long_division_closed(2)[OF assms(1) _ assms(2), of q']
+            pmod_degree[OF assms(1) _ assms(2-3), of q']
+      by auto
+  qed
+qed
+
+lemma (in domain) Span_var_pow_base:
+  assumes "subfield K R"
+  shows "ring.Span (K[X]) (poly_of_const ` K) (ring.exp_base (K[X]) X n) =
+         { q \<in> carrier (K[X]). length q \<le> n }" (is "?lhs = ?rhs")
+proof -
+  note subring = subfieldE(1)[OF assms]
+  note subfield = univ_poly_subfield_of_consts[OF assms]
+
+  interpret UP: domain "K[X]"
+    using univ_poly_is_domain[OF subring] .
+
+  show ?thesis
+  proof (intro no_atp(10)[OF subsetI subsetI])
+    fix q assume "q \<in> { q \<in> carrier (K[X]). length q \<le> n }"
+    then have q: "q \<in> carrier (K[X])" "length q \<le> n"
+      by simp+
+
+    let ?repl = "replicate (n - length q) \<zero>\<^bsub>K[X]\<^esub>"
+    let ?map = "map poly_of_const q"
+    let ?comb = "UP.combine"
+    define Ks where "Ks = ?repl @ ?map"
+
+    have "q = ?comb ?map (UP.exp_base X (length q))"
+      using q eval_rewrite[OF subring q(1)] unfolding sym[OF UP.combine_eq_eval] by auto
+    moreover from \<open>length q \<le> n\<close>
+    have "?comb (?repl @ Ks) (UP.exp_base X n) =  ?comb Ks (UP.exp_base X (length q))"
+      if "set Ks \<subseteq> carrier (K[X])" for Ks
+      using UP.combine_prepend_replicate[OF that UP.exp_base_closed[OF var_closed(1)[OF subring]]]
+      unfolding UP.drop_exp_base by auto
+
+    moreover have "set ?map \<subseteq> carrier (K[X])"
+      using map_norm_in_poly_ring_carrier[OF subring q(1)]
+      unfolding sym[OF univ_poly_carrier] polynomial_def by auto
+    
+    moreover have "?repl = map poly_of_const (replicate (n - length q) \<zero>)"
+      unfolding poly_of_const_def univ_poly_zero by (induct "n - length q") (auto)
+    hence "set ?repl \<subseteq> poly_of_const ` K"
+      using subringE(2)[OF subring] by auto
+    moreover from \<open>q \<in> carrier (K[X])\<close> have "set q \<subseteq> K"
+      unfolding sym[OF univ_poly_carrier] polynomial_def by auto
+    hence "set ?map \<subseteq> poly_of_const ` K"
+      by auto
+
+    ultimately have "q = ?comb Ks (UP.exp_base X n)" and "set Ks \<subseteq> poly_of_const ` K"
+      by (simp add: Ks_def)+
+    thus "q \<in> UP.Span (poly_of_const ` K) (UP.exp_base X n)"
+      using UP.Span_eq_combine_set[OF subfield UP.exp_base_closed[OF var_closed(1)[OF subring]]] by auto
+  next
+    fix q assume "q \<in> UP.Span (poly_of_const ` K) (UP.exp_base X n)"
+    thus "q \<in> { q \<in> carrier (K[X]). length q \<le> n }"
+    proof (induction n arbitrary: q)
+      case 0 thus ?case
+        unfolding UP.exp_base_def by (auto simp add: univ_poly_zero)
+    next
+      case (Suc n)
+      then obtain k p where k: "k \<in> K" and p: "p \<in> UP.Span (poly_of_const ` K) (UP.exp_base X n)"
+        and q: "q = ((poly_of_const k) \<otimes>\<^bsub>K[X]\<^esub> (X [^]\<^bsub>K[X]\<^esub> n)) \<oplus>\<^bsub>K[X]\<^esub> p"
+        unfolding UP.exp_base_def using UP.line_extension_mem_iff by auto
+      have p_in_carrier: "p \<in> carrier (K[X])" and "length p \<le> n"
+        using Suc(1)[OF p] by simp+
+      moreover from \<open>k \<in> K\<close> have "poly_of_const k \<in> carrier (K[X])"
+        unfolding poly_of_const_def sym[OF univ_poly_carrier] polynomial_def by auto
+      ultimately have "q \<in> carrier (K[X])"
+        unfolding q using var_pow_closed[OF subring, of n] by algebra
+
+      moreover have "poly_of_const k = \<zero>\<^bsub>K[X]\<^esub>" if "k = \<zero>"
+        unfolding poly_of_const_def that univ_poly_zero by simp
+      with \<open>p \<in> carrier (K[X])\<close> have "q = p" if "k = \<zero>"
+        unfolding q using var_pow_closed[OF subring, of n] that by algebra
+      with \<open>length p \<le> n\<close> have "length q \<le> Suc n" if "k = \<zero>"
+        using that by simp
+
+      moreover have "poly_of_const k = [ k ]" if "k \<noteq> \<zero>"
+        unfolding poly_of_const_def using that by simp
+      hence monom: "monom k n = (poly_of_const k) \<otimes>\<^bsub>K[X]\<^esub> (X [^]\<^bsub>K[X]\<^esub> n)" if "k \<noteq> \<zero>"
+        using that monom_eq_var_pow[OF subring] subfieldE(3)[OF assms] k by auto
+      with \<open>p \<in> carrier (K[X])\<close> and \<open>k \<in> K\<close> and \<open>length p \<le> n\<close>
+      have "length q = Suc n" if "k \<noteq> \<zero>"
+        using that poly_add_length_eq[OF subring monom_is_polynomial[OF subring, of k n], of p]
+        unfolding univ_poly_carrier monom_def univ_poly_add sym[OF monom[OF that]] q by auto  
+      ultimately show ?case
+        by (cases "k = \<zero>", auto)
+    qed
+  qed
+qed
+
+lemma (in domain) var_pow_base_independent:
+  assumes "subfield K R"
+  shows "ring.independent (K[X]) (poly_of_const ` K) (ring.exp_base (K[X]) X n)"
+proof -
+  note subring = subfieldE(1)[OF assms]
+  interpret UP: domain "K[X]"
+    using univ_poly_is_domain[OF subring] .
+
+  show ?thesis
+  proof (induction n, simp add: UP.exp_base_def)
+    case (Suc n)
+    have "X [^]\<^bsub>K[X]\<^esub> n \<notin> UP.Span (poly_of_const ` K) (ring.exp_base (K[X]) X n)"
+      unfolding sym[OF unitary_monom_eq_var_pow[OF subring]] monom_def
+                Span_var_pow_base[OF assms] by auto
+    moreover have "X [^]\<^bsub>K[X]\<^esub> n # UP.exp_base X n = UP.exp_base X (Suc n)"
+      unfolding UP.exp_base_def by simp
+    ultimately show ?case
+      using UP.li_Cons[OF var_pow_closed[OF subring, of n] _Suc] by simp
+  qed
+qed
+
+lemma (in domain) bounded_degree_dimension:
+  assumes "subfield K R"
+  shows "ring.dimension (K[X]) n (poly_of_const ` K) { q \<in> carrier (K[X]). length q \<le> n }"
+proof -
+  interpret UP: domain "K[X]"
+    using univ_poly_is_domain[OF subfieldE(1)[OF assms]] .
+  have "length (UP.exp_base X n) = n"
+    unfolding UP.exp_base_def by simp
+  thus ?thesis
+    using UP.dimension_independent[OF var_pow_base_independent[OF assms], of n]
+    unfolding Span_var_pow_base[OF assms] by simp
+qed
+
+corollary (in domain) univ_poly_infinite_dimension:
+  assumes "subfield K R" shows "ring.infinite_dimension (K[X]) (poly_of_const ` K) (carrier (K[X]))"
+proof (rule ccontr)
+  interpret UP: domain "K[X]"
+    using univ_poly_is_domain[OF subfieldE(1)[OF assms]] .
+
+  assume "\<not> UP.infinite_dimension (poly_of_const ` K) (carrier (K[X]))"
+  then obtain n where n: "UP.dimension n (poly_of_const ` K) (carrier (K[X]))"
+    by blast
+  show False
+    using UP.independent_length_le_dimension[OF univ_poly_subfield_of_consts[OF assms] n
+          var_pow_base_independent[OF assms, of "Suc n"]
+          UP.exp_base_closed[OF var_closed(1)[OF subfieldE(1)[OF assms]]]]
+    unfolding UP.exp_base_def by simp
+qed
+
+corollary (in domain) rupture_dimension:
+  assumes "subfield K R" and "p \<in> carrier (K[X])" and "degree p > 0"
+  shows "ring.dimension (Rupt K p) (degree p) ((rupture_surj K p) ` poly_of_const ` K) (carrier (Rupt K p))"
+proof -
+  interpret UP: domain "K[X]"
+    using univ_poly_is_domain[OF subfieldE(1)[OF assms(1)]] .
+  interpret Hom: ring_hom_ring "K[X]" "Rupt K p" "rupture_surj K p"
+    using rupture_surj_hom(2)[OF subfieldE(1)[OF assms(1)] assms(2)] .
+
+  have not_nil: "p \<noteq> []"
+    using assms(3) by auto
+
+  show ?thesis
+    using Hom.inj_hom_dimension[OF univ_poly_subfield_of_consts rupture_one_not_zero
+          rupture_surj_inj_on] bounded_degree_dimension assms
+    unfolding sym[OF rupture_carrier_as_pmod_image[OF assms(1-2)]]
+              pmod_image_characterization[OF assms(1-2) not_nil]
+    by simp
+qed
+
+end
\ No newline at end of file
diff -r 57503fe1b0ff -r 615233977155 src/HOL/Algebra/Polynomials.thy
--- a/src/HOL/Algebra/Polynomials.thy	Sat Apr 13 22:06:40 2019 +0200
+++ b/src/HOL/Algebra/Polynomials.thy	Sun Apr 14 12:00:17 2019 +0100
@@ -57,9 +57,11 @@
                      then (lead_coeff p, degree p) # (dense_repr (tl p))
                      else (dense_repr (tl p)))"
 
-fun (in ring) of_dense :: "('a \<times> nat) list \<Rightarrow> 'a list"
-  where "of_dense dl = foldr (\<lambda>(a, n) l. poly_add (monom a n) l) dl []"
+fun (in ring) poly_of_dense :: "('a \<times> nat) list \<Rightarrow> 'a list"
+  where "poly_of_dense dl = foldr (\<lambda>(a, n) l. poly_add (monom a n) l) dl []"
 
+definition (in ring) poly_of_const :: "'a \<Rightarrow> 'a list"
+  where "poly_of_const = (\<lambda>k. normalize [ k ])"
 
 
 subsection \<open>Basic Properties\<close>
@@ -324,15 +326,17 @@
   qed
 qed
 
+corollary normalize_trick:
+  shows "p = (replicate (length p - length (normalize p)) \<zero>) @ (normalize p)"
+  using normalize_def'(1)[of p] unfolding sym[OF normalize_def'(2)] .
+
 lemma normalize_coeff: "coeff p = coeff (normalize p)"
 proof (induction p)
   case Nil thus ?case by simp
 next
   case (Cons a p)
   have "coeff (normalize p) (length p) = \<zero>"
-    using normalize_length_le[of p] coeff_degree[of "normalize p"]
-    by (metis One_nat_def coeff.simps(1) diff_less length_0_conv
-        less_imp_diff_less nat_neq_iff neq0_conv not_le zero_less_Suc)
+    using normalize_length_le[of p] coeff_degree[of "normalize p"] coeff_length by blast
   then show ?case
     using Cons by (cases "a = \<zero>") (auto)
 qed
@@ -456,8 +460,7 @@
 lemma poly_add_degree_eq:
   assumes "polynomial K p1" "polynomial K p2" and "degree p1 \<noteq> degree p2"
   shows "degree (poly_add p1 p2) = max (degree p1) (degree p2)"
-  using poly_add_length_eq[of p1 p2] assms
-  by (metis (no_types, lifting) diff_le_mono max.absorb_iff1 max_def)
+  using poly_add_length_eq[OF assms(1-2)] assms(3) by simp
 
 end (* of fixed K context. *)
 (* ========================================================================== *)
@@ -724,7 +727,7 @@
 
 lemma monom_decomp:
   assumes "subring K R" "polynomial K p"
-  shows "p = of_dense (dense_repr p)"
+  shows "p = poly_of_dense (dense_repr p)"
   using assms(2)
 proof (induct "length p" arbitrary: p rule: less_induct)
   case less thus ?case
@@ -739,12 +742,12 @@
     also have " ... = poly_add (monom a (degree (a # l))) (normalize l)"
       using poly_add_normalize(2)[of "monom a (degree (a # l))", OF _ l(1)] a
       unfolding monom_def by force
-    also have " ... = poly_add (monom a (degree (a # l))) (of_dense (dense_repr (normalize l)))"
+    also have " ... = poly_add (monom a (degree (a # l))) (poly_of_dense (dense_repr (normalize l)))"
       using less(1)[OF _ normalize_gives_polynomial[OF l(2)]] normalize_length_le[of l]
       unfolding Cons by simp
-    also have " ... = of_dense ((a, degree (a # l)) # dense_repr (normalize l))"
+    also have " ... = poly_of_dense ((a, degree (a # l)) # dense_repr (normalize l))"
       by simp
-    also have " ... = of_dense (dense_repr (a # l))"
+    also have " ... = poly_of_dense (dense_repr (a # l))"
       using polynomial_dense_repr[OF less(2)] unfolding Cons by simp
     finally show ?thesis
       unfolding Cons by simp
@@ -1383,6 +1386,11 @@
   unfolding univ_poly_def by simp
 
 
+(* NEW  ========== *)
+lemma univ_poly_zero_closed [intro]: "[] \<in> carrier (K[X]\<^bsub>R\<^esub>)"
+  unfolding sym[OF univ_poly_carrier] polynomial_def by simp
+
+
 context domain
 begin
 
@@ -1575,8 +1583,7 @@
 declare poly_add.simps[simp]
 
 lemma univ_poly_a_inv_def':
-  assumes "p \<in> carrier (K[X])"
-  shows "\<ominus>\<^bsub>K[X]\<^esub> p = map (\<lambda>a. \<ominus> a) p"
+  assumes "p \<in> carrier (K[X])" shows "\<ominus>\<^bsub>K[X]\<^esub> p = map (\<lambda>a. \<ominus> a) p"
 proof -
   have aux_lemma:
     "\<And>p. p \<in> carrier (K[X]) \<Longrightarrow> p \<oplus>\<^bsub>K[X]\<^esub> (map (\<lambda>a. \<ominus> a) p) = []"
@@ -1619,6 +1626,16 @@
     using assms by simp
 qed
 
+(* NEW ========== *)
+corollary univ_poly_a_inv_length:
+  assumes "p \<in> carrier (K[X])" shows "length (\<ominus>\<^bsub>K[X]\<^esub> p) = length p"
+  unfolding univ_poly_a_inv_def'[OF assms] by simp
+
+(* NEW ========== *)
+corollary univ_poly_a_inv_degree:
+  assumes "p \<in> carrier (K[X])" shows "degree (\<ominus>\<^bsub>K[X]\<^esub> p) = degree p"
+  using univ_poly_a_inv_length[OF assms] by simp
+
 
 subsection \<open>Long Division Theorem\<close>
 
@@ -1712,7 +1729,8 @@
 
 end (* of domain context. *)
 
-lemma (in field) field_long_division_theorem:
+(* PROOF ========== *)
+lemma (in domain) field_long_division_theorem:
   assumes "subfield K R" "polynomial K p" and "polynomial K b" "b \<noteq> []"
   shows "\<exists>q r. polynomial K q \<and> polynomial K r \<and>
                p = (b \<otimes>\<^bsub>K[X]\<^esub> q) \<oplus>\<^bsub>K[X]\<^esub> r \<and> (r = [] \<or> degree r < degree b)"
@@ -1720,8 +1738,9 @@
         subfield.subfield_Units[OF assms(1)] lead_coeff_not_zero[of K "hd b" "tl b"]
   by simp
 
+(* PROOF ========== *)
 text \<open>The same theorem as above, but now, everything is in a shell. \<close>
-lemma (in field) field_long_division_theorem_shell:
+lemma (in domain) field_long_division_theorem_shell:
   assumes "subfield K R" "p \<in> carrier (K[X])" and "b \<in> carrier (K[X])" "b \<noteq> \<zero>\<^bsub>K[X]\<^esub>"
   shows "\<exists>q r. q \<in> carrier (K[X]) \<and> r \<in> carrier (K[X]) \<and>
                p = (b \<otimes>\<^bsub>K[X]\<^esub> q) \<oplus>\<^bsub>K[X]\<^esub> r \<and> (r = \<zero>\<^bsub>K[X]\<^esub> \<or> degree r < degree b)"
@@ -1807,13 +1826,14 @@
 
 subsubsection \<open>Corollaries\<close>
 
+(* PROOF ========== *)
 corollary (in ring) subfield_long_division_theorem_shell:
   assumes "subfield K R" "p \<in> carrier (K[X])" and "b \<in> carrier (K[X])" "b \<noteq> \<zero>\<^bsub>K[X]\<^esub>"
   shows "\<exists>q r. q \<in> carrier (K[X]) \<and> r \<in> carrier (K[X]) \<and>
                p = (b \<otimes>\<^bsub>K[X]\<^esub> q) \<oplus>\<^bsub>K[X]\<^esub> r \<and> (r = \<zero>\<^bsub>K[X]\<^esub> \<or> degree r < degree b)"
-  using field.field_long_division_theorem_shell[OF subfield_iff(2)[OF assms(1)]
-        field.carrier_is_subfield[OF subfield_iff(2)[OF assms(1)]]]
-        univ_poly_consistent[OF subfieldE(1)[OF assms(1)]] assms(2-4)
+  using domain.field_long_division_theorem_shell[OF subdomain_is_domain[OF subfield.axioms(1)]
+        field.carrier_is_subfield[OF subfield_iff(2)[OF assms(1)]]] assms(1-4)
+  unfolding univ_poly_consistent[OF subfieldE(1)[OF assms(1)]]
   by auto
 
 corollary (in domain) univ_poly_is_euclidean:
@@ -2016,6 +2036,79 @@
   unfolding ring_hom_cring_def ring_hom_cring_axioms_def cring_def by auto
 
 
+subsection \<open>Homomorphisms\<close>
+
+lemma (in ring_hom_ring) eval_hom':
+  assumes "a \<in> carrier R" and "set p \<subseteq> carrier R"
+  shows "h (R.eval p a) = eval (map h p) (h a)"
+  using assms by (induct p, auto simp add: R.eval_in_carrier hom_nat_pow)
+
+lemma (in ring_hom_ring) eval_hom:
+  assumes "subring K R" and "a \<in> carrier R" and "p \<in> carrier (K[X])"
+  shows "h (R.eval p a) = eval (map h p) (h a)"
+proof -
+  have "set p \<subseteq> carrier R"
+    using subringE(1)[OF assms(1)] R.polynomial_incl assms(3)
+    unfolding sym[OF univ_poly_carrier[of R]] by auto
+  thus ?thesis
+    using eval_hom'[OF assms(2)] by simp
+qed
+
+lemma (in ring_hom_ring) coeff_hom':
+  assumes "set p \<subseteq> carrier R" shows "h (R.coeff p i) = coeff (map h p) i"
+  using assms by (induct p) (auto)
+
+lemma (in ring_hom_ring) poly_add_hom':
+  assumes "set p \<subseteq> carrier R" and "set q \<subseteq> carrier R"
+  shows "normalize (map h (R.poly_add p q)) = poly_add (map h p) (map h q)"
+proof -
+  have set_map: "set (map h s) \<subseteq> carrier S" if "set s \<subseteq> carrier R" for s
+    using that by auto
+  have "coeff (normalize (map h (R.poly_add p q))) = coeff (map h (R.poly_add p q))"
+    using S.normalize_coeff by auto
+  also have " ... = (\<lambda>i. h ((R.coeff p i) \<oplus> (R.coeff q i)))"
+    using coeff_hom'[OF R.poly_add_in_carrier[OF assms]] R.poly_add_coeff[OF assms] by simp
+  also have " ... = (\<lambda>i. (coeff (map h p) i) \<oplus>\<^bsub>S\<^esub> (coeff (map h q) i))"
+    using assms[THEN R.coeff_in_carrier] assms[THEN coeff_hom'] by simp
+  also have " ... = (\<lambda>i. coeff (poly_add (map h p) (map h q)) i)"
+    using S.poly_add_coeff[OF assms[THEN set_map]] by simp
+  finally have "coeff (normalize (map h (R.poly_add p q))) = (\<lambda>i. coeff (poly_add (map h p) (map h q)) i)" .
+  thus ?thesis
+    unfolding coeff_iff_polynomial_cond[OF
+              normalize_gives_polynomial[OF set_map[OF R.poly_add_in_carrier[OF assms]]]
+              poly_add_is_polynomial[OF carrier_is_subring assms[THEN set_map]]] .
+qed
+
+lemma (in ring_hom_ring) poly_mult_hom':
+  assumes "set p \<subseteq> carrier R" and "set q \<subseteq> carrier R"
+  shows "normalize (map h (R.poly_mult p q)) = poly_mult (map h p) (map h q)"
+  using assms(1)
+proof (induct p, simp)
+  case (Cons a p)
+  have set_map: "set (map h s) \<subseteq> carrier S" if "set s \<subseteq> carrier R" for s
+    using that by auto
+
+  let ?q_a = "(map ((\<otimes>) a) q) @ (replicate (length p) \<zero>)"
+  have set_q_a: "set ?q_a \<subseteq> carrier R"
+    using assms(2) Cons(2) by (induct q) (auto)
+  have q_a_simp: "map h ?q_a = (map ((\<otimes>\<^bsub>S\<^esub>) (h a)) (map h q)) @ (replicate (length (map h p)) \<zero>\<^bsub>S\<^esub>)"
+    using assms(2) Cons(2) by (induct q) (auto)
+
+  have "S.normalize (map h (R.poly_mult (a # p) q)) = 
+        S.normalize (map h (R.poly_add ?q_a (R.poly_mult p q)))"
+    by simp
+  also have " ... = S.poly_add (map h ?q_a) (map h (R.poly_mult p q))"
+    using poly_add_hom'[OF set_q_a R.poly_mult_in_carrier[OF _ assms(2)]] Cons by simp
+  also have " ... = S.poly_add (map h ?q_a) (S.normalize (map h (R.poly_mult p q)))"
+    using poly_add_normalize(2)[OF set_map[OF set_q_a] set_map[OF R.poly_mult_in_carrier[OF _ assms(2)]]] Cons by simp
+  also have " ... = S.poly_add (map h ?q_a) (S.poly_mult (map h p) (map h q))"
+    using Cons by simp
+  also have " ... = S.poly_mult (map h (a # p)) (map h q)"
+    unfolding q_a_simp by simp
+  finally show ?case . 
+qed
+
+
 subsection \<open>The X Variable\<close>
 
 definition var :: "_ \<Rightarrow> 'a list" ("X\<index>")
@@ -2080,6 +2173,73 @@
   finally show ?thesis .
 qed
 
+lemma (in domain) eval_rewrite:
+  assumes "subring K R" and "p \<in> carrier (K[X])"
+  shows "p = (ring.eval (K[X])) (map poly_of_const p) X"
+proof -
+  let ?map_norm = "\<lambda>p. map poly_of_const p"
+
+  interpret UP: domain "K[X]"
+    using univ_poly_is_domain[OF assms(1)] .
+
+  { fix l assume "set l \<subseteq> K"
+    hence "poly_of_const a \<in> carrier (K[X])" if "a \<in> set l" for a
+      using that normalize_gives_polynomial[of "[ a ]" K]
+      unfolding univ_poly_carrier poly_of_const_def by auto
+    hence "set (?map_norm l) \<subseteq> carrier (K[X])"
+      by auto }
+  note aux_lemma1 = this
+
+  { fix q l assume set_l: "set l \<subseteq> K" and q: "q \<in> carrier (K[X])"
+    from set_l have "UP.eval (?map_norm l) q = UP.eval (?map_norm ((replicate n \<zero>) @ l)) q" for n
+    proof (induct n, simp)
+      case (Suc n)
+      from \<open>set l \<subseteq> K\<close> have set_replicate: "set ((replicate n \<zero>) @ l) \<subseteq> K"
+        using subringE(2)[OF assms(1)] by (induct n) (auto)
+      have step: "UP.eval (?map_norm l') q = UP.eval (?map_norm (\<zero> # l')) q" if "set l' \<subseteq> K" for l'
+        using UP.eval_in_carrier[OF aux_lemma1[OF that]] q unfolding poly_of_const_def
+        by (simp, simp add: sym[OF univ_poly_zero[of R K]])
+      have "UP.eval (?map_norm l) q = UP.eval (?map_norm ((replicate n \<zero>) @ l)) q"
+        using Suc by simp
+      also have " ... = UP.eval (map poly_of_const ((replicate (Suc n) \<zero>) @ l)) q"
+        using step[OF set_replicate] by simp
+      finally show ?case .
+    qed }
+  note aux_lemma2 = this
+
+  { fix q l assume "set l \<subseteq> K" and q: "q \<in> carrier (K[X])"
+    from \<open>set l \<subseteq> K\<close> have set_norm: "set (normalize l) \<subseteq> K"
+      by (induct l) (auto)
+    have "UP.eval (?map_norm l) q = UP.eval (?map_norm (normalize l)) q"
+      using aux_lemma2[OF set_norm q, of "length l - length (local.normalize l)"]
+      unfolding sym[OF normalize_trick[of l]] .. }
+  note aux_lemma3 = this
+
+  from \<open>p \<in> carrier (K[X])\<close> show ?thesis
+  proof (induct "length p" arbitrary: p rule: less_induct)
+    case less thus ?case
+    proof (cases p, simp add: univ_poly_zero)
+      case (Cons a l)
+      hence a: "a \<in> carrier R - { \<zero> }" and set_l: "set l \<subseteq> carrier R" "set l \<subseteq> K"
+        using less(2) subringE(1)[OF assms(1)] unfolding sym[OF univ_poly_carrier] polynomial_def by auto
+
+      have "a # l = poly_add (monom a (length l)) l"
+        using poly_add_monom[OF set_l(1) a] ..
+      also have " ... = poly_add (monom a (length l)) (normalize l)"
+        using poly_add_normalize(2)[OF monom_in_carrier[of a] set_l(1)] a by simp
+      also have " ... = poly_add (monom a (length l)) (UP.eval (?map_norm (normalize l)) X)"
+        using less(1)[of "normalize l"] normalize_gives_polynomial[OF set_l(2)] normalize_length_le[of l]
+        by (auto simp add: univ_poly_carrier Cons(1))
+      also have " ... = poly_add ([ a ] \<otimes>\<^bsub>K[X]\<^esub> (X [^]\<^bsub>K[X]\<^esub> (length l))) (UP.eval (?map_norm l) X)"
+        unfolding monom_eq_var_pow[OF assms(1) a] aux_lemma3[OF set_l(2) var_closed(1)[OF assms(1)]] ..
+      also have " ... = UP.eval (?map_norm (a # l)) X"
+        using a unfolding sym[OF univ_poly_add[of R K]] unfolding poly_of_const_def by auto
+      finally show ?thesis
+        unfolding Cons(1) .
+    qed
+  qed   
+qed
+
 lemma (in ring) dense_repr_set_fst:
   assumes "set p \<subseteq> K" shows "fst ` (set (dense_repr p)) \<subseteq> K - { \<zero> }"
   using assms by (induct p) (auto)
@@ -2118,7 +2278,7 @@
 
       have a: "a \<in> K - { \<zero> }"
         using less(2) subringE(1)[OF assms(1)] unfolding Cons univ_poly_def polynomial_def by auto 
-      hence "p = (monom a (length l)) \<oplus>\<^bsub>K[X]\<^esub> (of_dense (dense_repr (normalize l)))"
+      hence "p = (monom a (length l)) \<oplus>\<^bsub>K[X]\<^esub> (poly_of_dense (dense_repr (normalize l)))"
         using monom_decomp[OF assms(1), of p] less(2) dense_repr_normalize
         unfolding univ_poly_add univ_poly_carrier Cons by (auto simp del: poly_add.simps)
       also have " ... = (monom a (length l)) \<oplus>\<^bsub>K[X]\<^esub> (normalize l)"
@@ -2307,29 +2467,52 @@
 
 subsection \<open>The Canonical Embedding of K in K[X]\<close>
 
-lemma (in field) univ_poly_carrier_subfield_of_consts:
-  "subfield { p \<in> carrier ((carrier R)[X]). degree p = 0 } ((carrier R)[X])"
+lemma (in ring) poly_of_const_consistent:
+  assumes "subring K R" shows "ring.poly_of_const (R \<lparr> carrier := K \<rparr>) = poly_of_const"
+  unfolding ring.poly_of_const_def[OF subring_is_ring[OF assms]]
+            normalize_consistent[OF assms] poly_of_const_def ..
+
+lemma (in domain) canonical_embedding_is_hom:
+  assumes "subring K R" shows "poly_of_const \<in> ring_hom (R \<lparr> carrier := K \<rparr>) (K[X])"
+  using subringE(1)[OF assms] unfolding subset_iff poly_of_const_def
+  by (auto intro!: ring_hom_memI simp add: univ_poly_def)
+
+lemma (in domain) canonical_embedding_ring_hom:
+  assumes "subring K R" shows "ring_hom_ring (R \<lparr> carrier := K \<rparr>) (K[X]) poly_of_const"
+  using canonical_embedding_is_hom[OF assms] unfolding symmetric[OF ring_hom_ring_axioms_def]
+  by (rule ring_hom_ring.intro[OF subring_is_ring[OF assms] univ_poly_is_ring[OF assms]])
+
+lemma (in field) poly_of_const_over_carrier:
+  shows "poly_of_const ` (carrier R) = { p \<in> carrier ((carrier R)[X]). degree p = 0 }"
 proof -
-  have ring_hom: "ring_hom_ring R ((carrier R)[X]) (\<lambda>k. normalize [ k ])"
-    by (rule ring_hom_ringI[OF ring_axioms univ_poly_is_ring[OF carrier_is_subring]])
-       (auto simp add: univ_poly_def)
-  have subfield: "subfield ((\<lambda>k. normalize [ k ]) ` (carrier R)) ((carrier R)[X])"
-    using ring_hom_ring.img_is_subfield(2)[OF ring_hom carrier_is_subfield]
-    unfolding univ_poly_def by auto
-
-  have "(\<lambda>k. normalize [ k ]) ` (carrier R) = insert [] { [ k ] | k. k \<in> carrier R - { \<zero> } }"
-    by auto
+  have "poly_of_const ` (carrier R) = insert [] { [ k ] | k. k \<in> carrier R - { \<zero> } }"
+    unfolding poly_of_const_def by auto
   also have " ... = { p \<in> carrier ((carrier R)[X]). degree p = 0 }"
     unfolding univ_poly_def polynomial_def
     by (auto, metis le_Suc_eq le_zero_eq length_0_conv length_Suc_conv list.sel(1) list.set_sel(1) subsetCE)
-  finally have "(\<lambda>k. normalize [ k ]) ` (carrier R) = { p \<in> carrier ((carrier R)[X]). degree p = 0 }" .
+  finally show ?thesis .
+qed
+
+lemma (in ring) poly_of_const_over_subfield:
+  assumes "subfield K R" shows "poly_of_const ` K = { p \<in> carrier (K[X]). degree p = 0 }"
+  using field.poly_of_const_over_carrier[OF subfield_iff(2)[OF assms]]
+        poly_of_const_consistent[OF subfieldE(1)[OF assms]]
+        univ_poly_consistent[OF subfieldE(1)[OF assms]] by simp
+    
+lemma (in field) univ_poly_carrier_subfield_of_consts:
+  "subfield (poly_of_const ` (carrier R)) ((carrier R)[X])"
+proof -
+  have ring_hom: "ring_hom_ring R ((carrier R)[X]) poly_of_const"
+    using canonical_embedding_ring_hom[OF carrier_is_subring] by simp
   thus ?thesis
-    using subfield by auto
+    using ring_hom_ring.img_is_subfield(2)[OF ring_hom carrier_is_subfield]
+    unfolding univ_poly_def by auto
 qed
 
 proposition (in ring) univ_poly_subfield_of_consts:
-  assumes "subfield K R" shows "subfield { p \<in> carrier (K[X]). degree p = 0 } (K[X])"
+  assumes "subfield K R" shows "subfield (poly_of_const ` K) (K[X])"
   using field.univ_poly_carrier_subfield_of_consts[OF subfield_iff(2)[OF assms]]
-        univ_poly_consistent[OF subfieldE(1)[OF assms]] by auto
+  unfolding poly_of_const_consistent[OF subfieldE(1)[OF assms]]
+            univ_poly_consistent[OF subfieldE(1)[OF assms]] by simp
 
 end
diff -r 57503fe1b0ff -r 615233977155 src/HOL/Algebra/Pred_Zorn.thy
--- /dev/null	Thu Jan 01 00:00:00 1970 +0000
+++ b/src/HOL/Algebra/Pred_Zorn.thy	Sun Apr 14 12:00:17 2019 +0100
@@ -0,0 +1,57 @@
+theory Pred_Zorn
+  imports HOL.Zorn
+
+begin
+
+(* ========== *)
+lemma partial_order_onE:
+  assumes "partial_order_on A r" shows "refl_on A r" and "trans r" and "antisym r"
+  using assms unfolding partial_order_on_def preorder_on_def by auto
+(* ========== *)
+
+abbreviation rel_of :: "('a \<Rightarrow> 'a \<Rightarrow> bool) \<Rightarrow> 'a set \<Rightarrow> ('a \<times> 'a) set"
+  where "rel_of P A \<equiv> { (a, b) \<in> A \<times> A. P a b }"
+
+lemma Field_rel_of:
+  assumes "refl_on A (rel_of P A)" shows "Field (rel_of P A) = A"
+  using assms unfolding refl_on_def Field_def by auto
+
+(* ========== *)
+lemma Chains_rel_of:
+  assumes "C \<in> Chains (rel_of P A)" shows "C \<subseteq> A"
+  using assms unfolding Chains_def by auto
+(* ========== *)
+
+lemma partial_order_on_rel_ofI:
+  assumes refl: "\<And>a. a \<in> A \<Longrightarrow> P a a"
+    and trans: "\<And>a b c. \<lbrakk> a \<in> A; b \<in> A; c \<in> A \<rbrakk> \<Longrightarrow> P a b \<Longrightarrow> P b c \<Longrightarrow> P a c"
+    and antisym: "\<And>a b. \<lbrakk> a \<in> A; b \<in> A \<rbrakk> \<Longrightarrow> P a b \<Longrightarrow> P b a \<Longrightarrow> a = b"
+  shows "partial_order_on A (rel_of P A)"
+proof -
+  from refl have "refl_on A (rel_of P A)"
+    unfolding refl_on_def by auto
+  moreover have "trans (rel_of P A)" and "antisym (rel_of P A)"
+    by (auto intro: transI dest: trans, auto intro: antisymI dest: antisym)
+  ultimately show ?thesis
+    unfolding partial_order_on_def preorder_on_def by simp
+qed
+
+lemma Partial_order_rel_ofI:
+  assumes "partial_order_on A (rel_of P A)" shows "Partial_order (rel_of P A)"
+  using assms unfolding Field_rel_of[OF partial_order_onE(1)[OF assms]] .
+
+lemma predicate_Zorn:
+  assumes "partial_order_on A (rel_of P A)"
+    and "\<forall>C \<in> Chains (rel_of P A). \<exists>u \<in> A. \<forall>a \<in> C. P a u"
+  shows "\<exists>m \<in> A. \<forall>a \<in> A. P m a \<longrightarrow> a = m"
+proof -
+  have "a \<in> A" if "a \<in> C" and "C \<in> Chains (rel_of P A)" for C a
+    using that Chains_rel_of by auto
+  moreover have "(a, u) \<in> rel_of P A" if "a \<in> A" and "u \<in> A" and "P a u" for a u
+    using that by auto
+  ultimately show ?thesis
+    using Zorns_po_lemma[OF Partial_order_rel_ofI[OF assms(1)]] assms(2)
+    unfolding Field_rel_of[OF partial_order_onE(1)[OF assms(1)]] by auto
+qed
+
+end
\ No newline at end of file
diff -r 57503fe1b0ff -r 615233977155 src/HOL/Algebra/Ring_Divisibility.thy
--- a/src/HOL/Algebra/Ring_Divisibility.thy	Sat Apr 13 22:06:40 2019 +0200
+++ b/src/HOL/Algebra/Ring_Divisibility.thy	Sun Apr 14 12:00:17 2019 +0100
@@ -7,6 +7,23 @@
 
 begin
 
+(* TEMPORARY ====================================================================== *)
+definition mult_of :: "('a, 'b) ring_scheme \<Rightarrow> 'a monoid" where
+  "mult_of R \<equiv> \<lparr> carrier = carrier R - {\<zero>\<^bsub>R\<^esub>}, mult = mult R, one = \<one>\<^bsub>R\<^esub>\<rparr>"
+
+lemma carrier_mult_of [simp]: "carrier (mult_of R) = carrier R - {\<zero>\<^bsub>R\<^esub>}"
+  by (simp add: mult_of_def)
+
+lemma mult_mult_of [simp]: "mult (mult_of R) = mult R"
+ by (simp add: mult_of_def)
+
+lemma nat_pow_mult_of: "([^]\<^bsub>mult_of R\<^esub>) = (([^]\<^bsub>R\<^esub>) :: _ \<Rightarrow> nat \<Rightarrow> _)"
+  by (simp add: mult_of_def fun_eq_iff nat_pow_def)
+
+lemma one_mult_of [simp]: "\<one>\<^bsub>mult_of R\<^esub> = \<one>\<^bsub>R\<^esub>"
+  by (simp add: mult_of_def)
+(* ================================================================================ *)
+
 section \<open>The Arithmetic of Rings\<close>
 
 text \<open>In this section we study the links between the divisibility theory and that of rings\<close>
@@ -51,6 +68,11 @@
        and "one  (mult_of R) =  one R"
   using factorial_monoid_axioms by auto
 
+lemma (in ring) noetherian_ringI:
+  assumes "\<And>I. ideal I R \<Longrightarrow> \<exists>A \<subseteq> carrier R. finite A \<and> I = Idl A"
+  shows "noetherian_ring R"
+  using assms by unfold_locales auto
+
 lemma (in domain) euclidean_domainI:
   assumes "\<And>a b. \<lbrakk> a \<in> carrier R - { \<zero> }; b \<in> carrier R - { \<zero> } \<rbrakk> \<Longrightarrow>
            \<exists>q r. q \<in> carrier R \<and> r \<in> carrier R \<and> a = (b \<otimes> q) \<oplus> r \<and> ((r = \<zero>) \<or> (\<phi> r < \<phi> b))"
@@ -529,7 +551,7 @@
 lemma (in ring) trivial_ideal_chain_imp_noetherian:
   assumes "\<And>C. \<lbrakk> C \<noteq> {}; subset.chain { I. ideal I R } C \<rbrakk> \<Longrightarrow> \<Union>C \<in> C"
   shows "noetherian_ring R"
-proof (auto simp add: noetherian_ring_def noetherian_ring_axioms_def ring_axioms)
+proof (rule noetherian_ringI)
   fix I assume I: "ideal I R"
   have in_carrier: "I \<subseteq> carrier R" and add_subgroup: "additive_subgroup I R"
     using ideal.axioms(1)[OF I] additive_subgroup.a_subset by auto
@@ -662,6 +684,26 @@
     using C unfolding pred_on.maxchain_def by blast
 qed
 
+lemma (in noetherian_domain) exists_irreducible_divisor:
+  assumes "a \<in> carrier R - { \<zero> }" and "a \<notin> Units R"
+  obtains b where "b \<in> carrier R" and "ring_irreducible b" and "b divides a"
+proof -
+  obtain fs where set_fs: "set fs \<subseteq> carrier (mult_of R)" and "wfactors (mult_of R) fs a"
+    using factorization_property[OF assms] by blast
+  hence "a \<in> Units R" if "fs = []"
+    using that assms(1) Units_cong assoc_iff_assoc_mult unfolding wfactors_def by (simp, blast)
+  hence "fs \<noteq> []"
+    using assms(2) by auto
+  then obtain f' fs' where fs: "fs = f' # fs'"
+    using list.exhaust by blast
+  from \<open>wfactors (mult_of R) fs a\<close> have "f' divides a"
+    using mult_of.wfactors_dividesI[OF _ set_fs] assms(1) unfolding fs by auto
+  moreover from \<open>wfactors (mult_of R) fs a\<close> have "ring_irreducible f'" and "f' \<in> carrier R"
+    using set_fs ring_irreducibleI'[of f'] unfolding wfactors_def fs by auto
+  ultimately show thesis
+    using that by blast
+qed
+
 
 subsection \<open>Principal Domains\<close>
 
diff -r 57503fe1b0ff -r 615233977155 src/HOL/Algebra/Subrings.thy
--- a/src/HOL/Algebra/Subrings.thy	Sat Apr 13 22:06:40 2019 +0200
+++ b/src/HOL/Algebra/Subrings.thy	Sun Apr 14 12:00:17 2019 +0100
@@ -225,6 +225,11 @@
   assumes "subring H R" shows "domain (R \<lparr> carrier := H \<rparr>)"
   using subdomainI'[OF assms] unfolding subdomain_iff[OF subringE(1)[OF assms]] .
 
+(* NEW ====================== *)
+lemma (in ring) subdomain_is_domain:
+  assumes "subdomain H R" shows "domain (R \<lparr> carrier := H \<rparr>)"
+  using assms unfolding subdomain_iff[OF subdomainE(1)[OF assms]] .
+
 
 subsubsection \<open>Subfields\<close>
 
@@ -338,6 +343,23 @@
     using monoid.m_inv_monoid_consistent[OF monoid_axioms k K(2)] by auto
 qed
 
+lemma (in ring) subfield_m_inv_simprule:
+  assumes "subfield K R"
+  shows "\<lbrakk> k \<in> K - { \<zero> }; a \<in> carrier R \<rbrakk> \<Longrightarrow> k \<otimes> a \<in> K \<Longrightarrow> a \<in> K"
+proof -
+  note subring_props = subringE[OF subfieldE(1)[OF assms]]
+
+  assume A: "k \<in> K - { \<zero> }" "a \<in> carrier R" "k \<otimes> a \<in> K"
+  then obtain k' where k': "k' \<in> K" "k \<otimes> a = k'" by blast
+  have inv_k: "inv k \<in> K" "inv k \<otimes> k = \<one>"
+    using subfield_m_inv[OF assms A(1)] by auto
+  hence "inv k \<otimes> (k \<otimes> a) \<in> K"
+    using k' A(3) subring_props(6) by auto
+  thus "a \<in> K"
+    using m_assoc[of "inv k" k a] A(2) inv_k subring_props(1)
+    by (metis (no_types, hide_lams) A(1) Diff_iff l_one subsetCE)
+qed
+
 lemma (in ring) subfield_iff:
   shows "\<lbrakk> field (R \<lparr> carrier := K \<rparr>); K \<subseteq> carrier R \<rbrakk> \<Longrightarrow> subfield K R"
     and "subfield K R \<Longrightarrow> field (R \<lparr> carrier := K \<rparr>)"
@@ -433,4 +455,46 @@
     using S.subfield_iff[of "h ` K"] K(1) ring_hom_memE(1)[OF homh] by blast
 qed
 
+(* NEW ========================================================================== *)
+lemma (in ring_hom_ring) induced_ring_hom:
+  assumes "subring K R" shows "ring_hom_ring (R \<lparr> carrier := K \<rparr>) S h"
+proof -
+  have "h \<in> ring_hom (R \<lparr> carrier := K \<rparr>) S"
+    using homh subringE(1)[OF assms] unfolding ring_hom_def
+    by (auto, meson hom_mult hom_add subsetCE)+
+  thus ?thesis
+    using R.subring_is_ring[OF assms] ring_axioms
+    unfolding ring_hom_ring_def ring_hom_ring_axioms_def by auto
+qed
+
+(* NEW ========================================================================== *)
+lemma (in ring_hom_ring) inj_on_subgroup_iff_trivial_ker:
+  assumes "subring K R"
+  shows "inj_on h K \<longleftrightarrow> a_kernel (R \<lparr> carrier := K \<rparr>) S h = { \<zero> }"
+  using ring_hom_ring.inj_iff_trivial_ker[OF induced_ring_hom[OF assms]] by simp
+
+lemma (in ring_hom_ring) inv_ring_hom:
+  assumes "inj_on h K" and "subring K R"
+  shows "ring_hom_ring (S \<lparr> carrier := h ` K \<rparr>) R (inv_into K h)"
+proof (intro ring_hom_ringI[OF _ R.ring_axioms], auto)
+  show "ring (S \<lparr> carrier := h ` K \<rparr>)"
+    using subring_is_ring[OF img_is_subring[OF assms(2)]] .
+next
+  show "inv_into K h \<one>\<^bsub>S\<^esub> = \<one>\<^bsub>R\<^esub>"
+    using assms(1) subringE(3)[OF assms(2)] hom_one by (simp add: inv_into_f_eq)
+next
+  fix k1 k2
+  assume k1: "k1 \<in> K" and k2: "k2 \<in> K"
+  with \<open>k1 \<in> K\<close> show "inv_into K h (h k1) \<in> carrier R"
+    using assms(1) subringE(1)[OF assms(2)] by (simp add: subset_iff)
+
+  from \<open>k1 \<in> K\<close> and \<open>k2 \<in> K\<close>
+  have "h k1 \<oplus>\<^bsub>S\<^esub> h k2 = h (k1 \<oplus>\<^bsub>R\<^esub> k2)" and "k1 \<oplus>\<^bsub>R\<^esub> k2 \<in> K"
+   and "h k1 \<otimes>\<^bsub>S\<^esub> h k2 = h (k1 \<otimes>\<^bsub>R\<^esub> k2)" and "k1 \<otimes>\<^bsub>R\<^esub> k2 \<in> K"
+    using subringE(1,6,7)[OF assms(2)] by (simp add: subset_iff)+
+  thus "inv_into K h (h k1 \<oplus>\<^bsub>S\<^esub> h k2) = inv_into K h (h k1) \<oplus>\<^bsub>R\<^esub> inv_into K h (h k2)"
+   and "inv_into K h (h k1 \<otimes>\<^bsub>S\<^esub> h k2) = inv_into K h (h k1) \<otimes>\<^bsub>R\<^esub> inv_into K h (h k2)"
+    using assms(1) k1 k2 by simp+
+qed
+
 end