diff --git a/thys/Finite_Fields/Card_Irreducible_Polynomials.thy b/thys/Finite_Fields/Card_Irreducible_Polynomials.thy
new file mode 100644
--- /dev/null
+++ b/thys/Finite_Fields/Card_Irreducible_Polynomials.thy
@@ -0,0 +1,231 @@
+subsection \<open>Gauss Formula\label{sec:card_irred}\<close>
+
+theory Card_Irreducible_Polynomials
+  imports 
+    Dirichlet_Series.Moebius_Mu
+    Card_Irreducible_Polynomials_Aux
+begin
+
+hide_const "Polynomial.order"
+
+text \<open>The following theorem is a slightly generalized form of the formula discovered by
+Gauss for the number of monic irreducible polynomials over a finite field. He originally verified 
+the result for the case when @{term "R"} is a simple prime field.
+The version of the formula here for the case where @{term "R"} may be an arbitrary finite field can
+be found in Chebolu and Min{\'a}{\v{c}}~\cite{chebolu2010}.\<close>
+
+theorem (in finite_field) card_irred:
+  assumes "n > 0"
+  shows "n * card {f. monic_irreducible_poly R f \<and> degree f = n} = 
+    (\<Sum>d | d dvd n. moebius_mu d * (order R^(n div d)))"
+    (is "?lhs = ?rhs")
+proof -
+  have "?lhs = dirichlet_prod moebius_mu (\<lambda>x. int (order R) ^ x) n"
+    using card_irred_aux
+    by (intro moebius_inversion assms) (simp flip:of_nat_power) 
+  also have "... = ?rhs"
+    by (simp add:dirichlet_prod_def)
+  finally show ?thesis by simp
+qed
+
+text \<open>In the following an explicit analytic lower bound for the cardinality of monic irreducible
+polynomials is shown, with which existence follows. This part deviates from the classic approach, 
+where existence is verified using a divisibility argument. The reason for the deviation is that an
+analytic bound can also be used to estimate the runtime of a randomized algorithm selecting an 
+irreducible polynomial, by randomly sampling monic polynomials.\<close>
+
+lemma (in finite_field) card_irred_1:
+  "card {f. monic_irreducible_poly R f \<and> degree f = 1} = order R" 
+proof -
+  have "int (1 * card {f. monic_irreducible_poly R f \<and> degree f = 1})
+    = int (order R)"
+    by (subst card_irred, auto)
+  thus ?thesis by simp
+qed
+
+lemma (in finite_field) card_irred_2:
+  "real (card {f. monic_irreducible_poly R f \<and> degree f = 2}) = 
+    (real (order R)^2 - order R) / 2" 
+proof -
+  have "x dvd 2 \<Longrightarrow> x = 1 \<or> x = 2" for x :: nat
+    using nat_dvd_not_less[where m="2"] 
+    by (metis One_nat_def even_zero gcd_nat.strict_trans2 
+        less_2_cases nat_neq_iff pos2)
+  hence a: "{d. d dvd 2} = {1,2::nat}" 
+    by (auto simp add:set_eq_iff)
+
+  have "2*real (card {f. monic_irreducible_poly R f \<and> degree f = 2})
+    = of_int (2* card {f. monic_irreducible_poly R f \<and> degree f = 2})"
+    by simp
+  also have "... = 
+    of_int (\<Sum>d | d dvd 2. moebius_mu d * int (order R) ^ (2 div d))"
+    by (subst card_irred, auto)
+  also have "... = order R^2 - int (order R)"
+    by (subst a, simp)
+  also have "... = real (order R)^2 - order R"
+    by simp
+  finally have 
+    "2 * real (card {f. monic_irreducible_poly R f \<and> degree f = 2}) = 
+    real (order R)^2 - order R"
+    by simp
+  thus ?thesis by simp
+qed
+
+lemma (in finite_field) card_irred_gt_2:
+  assumes "n > 2"
+  shows "real (order R)^n / (2*real n) \<le> 
+    card {f. monic_irreducible_poly R f \<and> degree f = n}" 
+    (is "?lhs \<le> ?rhs")
+proof -
+  let ?m = "real (order R)"
+  have a:"?m \<ge> 2" 
+    using finite_field_min_order by simp
+
+  have b:"moebius_mu n \<ge> -(1::real)" for n :: nat 
+    using abs_moebius_mu_le[where n="n"]
+    unfolding abs_le_iff by auto 
+
+  have c: "n > 0" using assms by simp
+  have d: "x < n - 1" if d_assms: "x dvd n" "x \<noteq> n" for x :: nat
+  proof -
+    have "x < n" 
+      using d_assms dvd_nat_bounds c by auto
+    moreover have "\<not>(n-1 dvd n)" using assms 
+      by (metis One_nat_def Suc_diff_Suc c diff_zero 
+          dvd_add_triv_right_iff nat_dvd_1_iff_1 
+          nat_neq_iff numeral_2_eq_2 plus_1_eq_Suc)
+    hence "x \<noteq> n-1" using d_assms by auto
+    ultimately show "x < n-1"  by simp
+  qed
+
+  have "?m^n / 2 = ?m^n - ?m^n/2" by simp
+  also have "... \<le> ?m^n - ?m^n/?m^1"
+    using a by (intro diff_mono divide_left_mono, simp_all)
+  also have "... \<le> ?m^n - ?m^(n-1)"
+    using a c by (subst power_diff, simp_all) 
+  also have "... \<le> ?m^n - (?m^(n-1) - 1)/1" by simp
+  also have "... \<le> ?m^n - (?m^(n-1)-1)/(?m-1)"
+    using a by (intro diff_left_mono divide_left_mono, simp_all) 
+  also have "... = ?m^n - (\<Sum>i \<in> {..<n-1}. ?m^i)"
+    using a by (subst geometric_sum, simp_all)
+  also have "... \<le> ?m^n - (\<Sum>i \<in> {k. k dvd n \<and> k \<noteq> n}. ?m^i)"
+    using d
+    by (intro diff_mono sum_mono2 subsetI, auto simp add:not_less) 
+  also have "... = ?m^n + (\<Sum>i \<in> {k. k dvd n \<and> k \<noteq> n}. (-1) * ?m^i)"
+    by (subst sum_distrib_left[symmetric], simp)
+  also have "... \<le> moebius_mu 1 * ?m^n + 
+    (\<Sum>i \<in> {k. k dvd n \<and> k \<noteq> n}. moebius_mu (n div i) * ?m^i)"
+    using b
+    by (intro add_mono sum_mono mult_right_mono) 
+      (simp_all add:not_less) 
+  also have "... =  (\<Sum>i \<in> insert n {k. k dvd n \<and> k \<noteq> n}.
+    moebius_mu (n div i) * ?m^i)"
+    using c by (subst sum.insert, auto)  
+  also have "... = (\<Sum>i \<in> {k. k dvd n}. moebius_mu (n div i) * ?m^i)"
+    by (intro sum.cong, auto simp add:set_eq_iff)
+  also have "... = dirichlet_prod (\<lambda>i. ?m^i) moebius_mu n" 
+    unfolding dirichlet_prod_def by (intro sum.cong, auto)
+  also have "... = dirichlet_prod moebius_mu (\<lambda>i. ?m^i) n"
+    using dirichlet_prod_moebius_commute by metis
+  also have "... = 
+    of_int (\<Sum>d | d dvd n. moebius_mu d * order R^(n div d))"
+    unfolding dirichlet_prod_def by simp
+  also have "... = of_int (n * 
+    card {f. monic_irreducible_poly R f \<and> length f - 1 = n})"
+    using card_irred[OF c] by simp
+  also have "... = n * ?rhs" by simp
+  finally have "?m^n / 2 \<le> n * ?rhs" by simp
+  hence "?m ^ n \<le> 2 * n * ?rhs" by simp
+  hence "?m^n/(2*real n) \<le> ?rhs" 
+    using c by (subst pos_divide_le_eq, simp_all add:algebra_simps) 
+  thus ?thesis by simp
+qed
+
+lemma (in finite_field) exist_irred:
+  assumes "n > 0"
+  obtains f where "monic_irreducible_poly R f" "degree f = n"
+proof -
+  consider (i) "n = 1" | (ii) "n = 2" | (iii) "n>2"
+    using assms by linarith
+  then have 
+    "card {f. monic_irreducible_poly R f \<and> degree f = n} > 0"
+    (is "card ?A > 0")
+  proof (cases)
+    case i
+    hence "card ?A = order R"
+      using card_irred_1 by simp
+    also have "... > 0"
+       using finite_field_min_order by simp
+    finally show ?thesis by simp
+  next
+    case ii
+    have "0 < (real (order R) * (real (order R) - 1)) / 2" 
+      using finite_field_min_order by simp
+    also have "... = (real (order R)^2 - order R) / 2"
+      by (simp add:power2_eq_square algebra_simps)
+    also have "... = real (card ?A)"
+      using ii by (subst card_irred_2[symmetric], simp) 
+    finally have " 0 < real (card ?A)" by simp
+    then show ?thesis by simp
+  next
+    case iii
+    have "0 < real (order R)^n / (2*real n)"
+      using finite_field_min_order assms by simp
+    also have "... \<le> real (card ?A)"
+      using iii card_irred_gt_2 by simp
+    finally have "0 < real (card ?A)" by simp
+    then show ?thesis by simp
+  qed
+  hence "?A \<noteq> {}" 
+    by (metis card.empty nless_le)
+  then obtain f where "monic_irreducible_poly R f" "degree f = n"
+    by auto
+  thus ?thesis using that by simp
+qed
+
+theorem existence:
+  assumes "n > 0"
+  assumes "Factorial_Ring.prime p"
+  shows "\<exists>(F:: int set list set ring). finite_field F \<and> order F = p^n"
+proof -
+  interpret zf: finite_field "ZFact (int p)"
+    using zfact_prime_is_finite_field assms by simp
+
+  interpret zfp: polynomial_ring "ZFact p" "carrier (ZFact p)"
+    unfolding polynomial_ring_def polynomial_ring_axioms_def
+    using zf.field_axioms zf.carrier_is_subfield by simp
+
+  have p_gt_0: "p > 0" using prime_gt_0_nat assms(2) by simp
+
+  obtain f where f_def: 
+    "monic_irreducible_poly (ZFact (int p)) f"
+    "degree f = n"
+    using zf.exist_irred assms by auto
+
+  let ?F  = "Rupt\<^bsub>(ZFact p)\<^esub> (carrier (ZFact p)) f" 
+  have "f \<in> carrier (poly_ring (ZFact (int p)))"
+    using f_def(1) zf.monic_poly_carr
+    unfolding monic_irreducible_poly_def
+    by simp
+  moreover have "degree f > 0"
+    using assms(1) f_def by simp
+  ultimately have "order ?F =  card (carrier (ZFact p))^degree f"
+    by (intro zf.rupture_order[OF zf.carrier_is_subfield]) auto
+  hence a:"order ?F = p^n"
+    unfolding f_def(2) card_zfact_carr[OF p_gt_0] by simp
+
+  have "field ?F"
+    using f_def(1) zf.monic_poly_carr monic_irreducible_poly_def
+    by (subst zfp.rupture_is_field_iff_pirreducible) auto
+  moreover have "order ?F > 0"
+    unfolding a using assms(1,2) p_gt_0 by simp
+  ultimately have b:"finite_field ?F"
+    using card_ge_0_finite
+    by (intro finite_fieldI, auto simp add:Coset.order_def) 
+
+  show ?thesis
+    using a b
+    by (intro exI[where x="?F"], simp)
+qed
+
+end
diff --git a/thys/Finite_Fields/Card_Irreducible_Polynomials_Aux.thy b/thys/Finite_Fields/Card_Irreducible_Polynomials_Aux.thy
new file mode 100644
--- /dev/null
+++ b/thys/Finite_Fields/Card_Irreducible_Polynomials_Aux.thy
@@ -0,0 +1,916 @@
+section \<open>Counting Irreducible Polynomials \label{sec:card_irred}\<close>
+
+subsection \<open>The polynomial $X^n - X$\<close>
+
+theory Card_Irreducible_Polynomials_Aux
+imports 
+  "HOL-Algebra.Multiplicative_Group"
+  Formal_Polynomial_Derivatives
+  Monic_Polynomial_Factorization
+begin
+
+lemma (in domain)
+  assumes "subfield K R"
+  assumes "f \<in> carrier (K[X])" "degree f > 0"
+  shows embed_inj: "inj_on (rupture_surj K f \<circ> poly_of_const) K"
+    and rupture_order: "order (Rupt K f) = card K^degree f"
+    and rupture_char: "char (Rupt K f) = char R"
+proof -
+  interpret p: principal_domain "K[X]"
+    using univ_poly_is_principal[OF assms(1)] by simp
+
+  interpret I: ideal "PIdl\<^bsub>K[X]\<^esub> f" "K[X]"
+    using p.cgenideal_ideal[OF assms(2)] by simp
+
+  interpret d: ring "Rupt K f"
+    unfolding rupture_def using I.quotient_is_ring by simp
+
+  have e: "subring K R"
+    using assms(1) subfieldE(1) by auto
+
+  interpret h:
+    ring_hom_ring "R \<lparr> carrier := K \<rparr>" 
+      "Rupt K f" "rupture_surj K f \<circ> poly_of_const"
+    using rupture_surj_norm_is_hom[OF e assms(2)]
+    using ring_hom_ringI2 subring_is_ring d.is_ring e 
+    by blast
+
+  have "field (R \<lparr>carrier := K\<rparr>)"
+    using assms(1) subfield_iff(2) by simp
+  hence "subfield K (R\<lparr>carrier := K\<rparr>)" 
+    using ring.subfield_iff[OF subring_is_ring[OF e]] by simp
+  hence b: "subfield (rupture_surj K f ` poly_of_const ` K) (Rupt K f)"
+    unfolding image_image comp_def[symmetric]
+    by (intro h.img_is_subfield rupture_one_not_zero assms, simp)
+
+  have "inj_on poly_of_const K"
+    using poly_of_const_inj inj_on_subset by auto
+  moreover have 
+    "poly_of_const ` K \<subseteq> ((\<lambda>q. q pmod f) ` carrier (K [X]))"
+  proof (rule image_subsetI)
+    fix x assume "x \<in> K"
+    hence f: 
+      "poly_of_const x \<in> carrier (K[X])"
+      "degree (poly_of_const x) = 0" 
+      using poly_of_const_over_subfield[OF assms(1)] by auto
+    moreover 
+    have "degree (poly_of_const x) < degree f"
+      using f(2) assms by simp
+    hence "poly_of_const x pmod f = poly_of_const x"
+      by (intro pmod_const(2)[OF assms(1)] f assms(2), simp)
+    ultimately show 
+      "poly_of_const x \<in> ((\<lambda>q. q pmod f) ` carrier (K [X]))"
+      by force
+  qed  
+  hence "inj_on (rupture_surj K f) (poly_of_const ` K)"
+    using rupture_surj_inj_on[OF assms(1,2)] inj_on_subset by blast
+  ultimately show d: "inj_on (rupture_surj K f \<circ> poly_of_const) K"
+    using comp_inj_on by auto
+
+  have a: "d.dimension (degree f) (rupture_surj K f ` poly_of_const ` K) 
+    (carrier (Rupt K f))"
+    using rupture_dimension[OF assms(1-3)] by auto
+  then obtain base where base_def:
+    "set base \<subseteq> carrier (Rupt K f)"
+    "d.independent (rupture_surj K f ` poly_of_const ` K) base"
+    "length base = degree f" 
+    "d.Span (rupture_surj K f ` poly_of_const ` K) base = 
+      carrier (Rupt K f)"
+    using d.exists_base[OF b a] by auto
+  have "order (Rupt K f) = 
+    card (d.Span (rupture_surj K f ` poly_of_const ` K) base)"
+    unfolding order_def base_def(4) by simp
+  also have "... = 
+    card (rupture_surj K f ` poly_of_const ` K) ^ length base"
+    using d.card_span[OF b base_def(2,1)] by simp
+  also have "... 
+    = card ((rupture_surj K f \<circ> poly_of_const) ` K) ^ degree f"
+    using base_def(3) image_image unfolding comp_def by metis
+  also have "... = card K^degree f"
+    by (subst card_image[OF d], simp)
+  finally show "order (Rupt K f) = card K^degree f" by simp
+
+  have "char (Rupt K f) = char (R \<lparr> carrier := K \<rparr>)"
+    using h.char_consistent d by simp
+  also have "... = char R"
+    using char_consistent[OF subfieldE(1)[OF assms(1)]] by simp
+  finally show "char (Rupt K f) = char R" by simp
+qed
+
+definition gauss_poly where
+  "gauss_poly K n = X\<^bsub>K\<^esub> [^]\<^bsub>poly_ring K\<^esub> (n::nat) \<ominus>\<^bsub>poly_ring K\<^esub> X\<^bsub>K\<^esub>"
+
+context field
+begin
+
+interpretation polynomial_ring "R" "carrier R"
+  unfolding polynomial_ring_def polynomial_ring_axioms_def
+  using field_axioms carrier_is_subfield by simp
+
+text \<open>The following lemma can be found in Ireland and Rosen~\cite[\textsection 7.1, Lemma 2]{ireland1982}.\<close>
+
+lemma gauss_poly_div_gauss_poly_iff_1:
+  fixes l m :: nat
+  assumes "l > 0"
+  shows "(X [^]\<^bsub>P\<^esub> l \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>) pdivides (X [^]\<^bsub>P\<^esub> m \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>) \<longleftrightarrow> l dvd m"
+    (is "?lhs \<longleftrightarrow> ?rhs")
+proof -
+  define q where "q = m div l"
+  define r where "r = m mod l"
+  have m_def: "m = q * l + r" and r_range: "r < l"
+    using assms by (auto simp add:q_def r_def) 
+
+  have pow_sum_carr:"(\<Oplus>\<^bsub>P\<^esub>i\<in>{..<q}. (X [^]\<^bsub>P\<^esub> l)[^]\<^bsub>P\<^esub> i) \<in> carrier P" 
+    using var_pow_closed
+    by (intro p.finsum_closed, simp)
+
+  have "(X [^]\<^bsub>P\<^esub> (q*l) \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>) = ((X [^]\<^bsub>P\<^esub> l)[^]\<^bsub>P\<^esub> q) \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>"
+    using var_closed
+    by (subst p.nat_pow_pow, simp_all add:algebra_simps)
+  also have "... =
+    (X [^]\<^bsub>P\<^esub> l \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>) \<otimes>\<^bsub>P\<^esub> (\<Oplus>\<^bsub>P\<^esub>i\<in>{..<q}. (X [^]\<^bsub>P\<^esub> l) [^]\<^bsub>P\<^esub> i)" 
+    using var_pow_closed
+    by (subst p.geom[symmetric], simp_all)
+  finally have pow_sum_fact: "(X [^]\<^bsub>P\<^esub> (q*l) \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>) =
+    (X [^]\<^bsub>P\<^esub> l \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>) \<otimes>\<^bsub>P\<^esub> (\<Oplus>\<^bsub>P\<^esub>i\<in>{..<q}. (X\<^bsub>R\<^esub> [^]\<^bsub>P\<^esub> l) [^]\<^bsub>P\<^esub> i)" 
+    by simp
+    
+  have "(X [^]\<^bsub>P\<^esub> l \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>) divides\<^bsub>P\<^esub> (X [^]\<^bsub>P\<^esub> (q*l) \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>)"
+    by (rule dividesI[OF pow_sum_carr pow_sum_fact])
+
+  hence c:"(X [^]\<^bsub>P\<^esub> l \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>) divides\<^bsub>P\<^esub> X [^]\<^bsub>P\<^esub> r \<otimes>\<^bsub>P\<^esub> (X [^]\<^bsub>P\<^esub> (q * l) \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>)"
+    using var_pow_closed
+    by (intro p.divides_prod_l, auto)
+
+  have "(X [^]\<^bsub>P\<^esub> m \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>) = X [^]\<^bsub>P\<^esub> (r + q * l) \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>"
+    unfolding m_def using add.commute by metis
+  also have "... = (X [^]\<^bsub>P\<^esub> r) \<otimes>\<^bsub>P\<^esub> (X [^]\<^bsub>P\<^esub> (q*l)) \<oplus>\<^bsub>P\<^esub> (\<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>)"
+    using var_closed 
+    by (subst p.nat_pow_mult, auto simp add:a_minus_def)
+  also have "... = ((X [^]\<^bsub>P\<^esub> r) \<otimes>\<^bsub>P\<^esub> (X [^]\<^bsub>P\<^esub> (q*l) \<oplus>\<^bsub>P\<^esub> (\<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>)) 
+    \<oplus>\<^bsub>P\<^esub> (X [^]\<^bsub>P\<^esub> r)) \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>"
+    using var_pow_closed
+    by algebra
+  also have "... = (X [^]\<^bsub>P\<^esub> r) \<otimes>\<^bsub>P\<^esub> (X [^]\<^bsub>P\<^esub> (q*l) \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>) 
+    \<oplus>\<^bsub>P\<^esub> (X [^]\<^bsub>P\<^esub> r) \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>"
+    by algebra
+  also have "... = (X [^]\<^bsub>P\<^esub> r) \<otimes>\<^bsub>P\<^esub> (X [^]\<^bsub>P\<^esub> (q*l) \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>) 
+    \<oplus>\<^bsub>P\<^esub> ((X [^]\<^bsub>P\<^esub> r) \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>)"
+    unfolding a_minus_def using var_pow_closed
+    by (subst p.a_assoc, auto)
+  finally have a:"(X [^]\<^bsub>P\<^esub> m \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>) = 
+    (X [^]\<^bsub>P\<^esub> r) \<otimes>\<^bsub>P\<^esub> (X [^]\<^bsub>P\<^esub> (q*l) \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>) \<oplus>\<^bsub>P\<^esub> (X [^]\<^bsub>P\<^esub> r \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>)"
+    (is "_ = ?x")
+    by simp
+
+  have xn_m_1_deg': "degree (X [^]\<^bsub>P\<^esub> n \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>) = n"
+    if "n > 0" for n :: nat
+  proof -
+    have "degree (X [^]\<^bsub>P\<^esub> n \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>) = degree (X [^]\<^bsub>P\<^esub> n \<oplus>\<^bsub>P\<^esub> \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>)"
+      by (simp add:a_minus_def)
+    also have "... = max (degree (X [^]\<^bsub>P\<^esub> n)) (degree (\<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>))"
+      using var_pow_closed var_pow_carr var_pow_degree 
+      using univ_poly_a_inv_degree degree_one that
+      by (subst degree_add_distinct, auto)
+    also have "... = n"
+      using var_pow_degree degree_one univ_poly_a_inv_degree
+      by simp
+    finally show ?thesis by simp
+  qed
+
+  have xn_m_1_deg: "degree (X [^]\<^bsub>P\<^esub> n \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>) = n" for n :: nat
+  proof (cases "n > 0")
+    case True
+    then show ?thesis using xn_m_1_deg' by auto
+  next
+    case False
+    hence "n = 0" by simp
+    hence "degree (X [^]\<^bsub>P\<^esub> n \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>) = degree (\<zero>\<^bsub>P\<^esub>)"
+      by (intro arg_cong[where f="degree"], simp)
+    then show ?thesis using False by (simp add:univ_poly_zero)
+  qed
+
+  have b: "degree (X [^]\<^bsub>P\<^esub> l \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>) > degree (X\<^bsub>R\<^esub> [^]\<^bsub>P\<^esub> r \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>)"
+    using r_range unfolding xn_m_1_deg by simp
+
+  have xn_m_1_carr: "X [^]\<^bsub>P\<^esub> n \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub> \<in> carrier P" for n :: nat 
+    unfolding a_minus_def
+    by (intro p.a_closed var_pow_closed, simp)
+
+  have "?lhs \<longleftrightarrow> (X [^]\<^bsub>P\<^esub> l \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>) pdivides ?x"
+    by (subst a, simp) 
+  also have "... \<longleftrightarrow> (X [^]\<^bsub>P\<^esub> l \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>) pdivides (X [^]\<^bsub>P\<^esub> r \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>)"
+    unfolding pdivides_def 
+    by (intro p.div_sum_iff c var_pow_closed 
+        xn_m_1_carr p.a_closed p.m_closed)
+  also have "... \<longleftrightarrow> r = 0"
+  proof (cases "r = 0")
+    case True
+    have "(X [^]\<^bsub>P\<^esub> l \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>) pdivides \<zero>\<^bsub>P\<^esub>" 
+      unfolding univ_poly_zero
+      by (intro pdivides_zero xn_m_1_carr) 
+    also have "... = (X [^]\<^bsub>P\<^esub> r \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>)"
+      by (simp add:a_minus_def True) algebra
+    finally show ?thesis using True by simp
+  next
+    case False
+    hence "degree (X [^]\<^bsub>P\<^esub> r \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>) > 0" using xn_m_1_deg by simp 
+    hence "X [^]\<^bsub>P\<^esub> r \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub> \<noteq> []" by auto
+    hence "\<not>(X [^]\<^bsub>P\<^esub> l \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>) pdivides (X [^]\<^bsub>P\<^esub> r \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>)"
+      using pdivides_imp_degree_le b xn_m_1_carr
+      by (metis le_antisym less_or_eq_imp_le nat_neq_iff)
+    thus ?thesis using False by simp
+  qed
+  also have "... \<longleftrightarrow> l dvd m"
+    unfolding m_def using r_range assms by auto
+  finally show ?thesis
+    by simp
+qed
+
+lemma gauss_poly_factor: 
+  assumes "n > 0"
+  shows "gauss_poly R n = (X [^]\<^bsub>P\<^esub> (n-1) \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>) \<otimes>\<^bsub>P\<^esub> X" (is "_ = ?rhs")
+proof -
+  have a:"1 + (n - 1) = n"
+    using assms by simp
+  have "gauss_poly R n = X [^]\<^bsub>P\<^esub> (1+(n-1)) \<ominus>\<^bsub>P\<^esub> X"
+    unfolding gauss_poly_def by (subst a, simp)
+  also have "... = (X [^]\<^bsub>P\<^esub> (n-1)) \<otimes>\<^bsub>P\<^esub> X \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub> \<otimes>\<^bsub>P\<^esub> X"
+    using var_closed by simp 
+  also have "... = ?rhs"
+    unfolding a_minus_def using var_closed l_one
+    by (subst p.l_distr, auto, algebra)
+  finally show ?thesis by simp
+qed
+
+lemma var_neq_zero: "X \<noteq> \<zero>\<^bsub>P\<^esub>"
+  by (simp add:var_def univ_poly_zero)
+
+lemma var_pow_eq_one_iff: "X [^]\<^bsub>P\<^esub> k = \<one>\<^bsub>P\<^esub> \<longleftrightarrow> k = (0::nat)"
+proof (cases "k=0")
+  case True
+  then show ?thesis using var_closed(1) by simp
+next
+  case False
+  have "degree (X\<^bsub>R\<^esub> [^]\<^bsub>P\<^esub> k) = k "
+    using var_pow_degree by simp
+  also have "... \<noteq> degree (\<one>\<^bsub>P\<^esub>)" using False degree_one by simp
+  finally have "degree (X\<^bsub>R\<^esub> [^]\<^bsub>P\<^esub> k) \<noteq> degree \<one>\<^bsub>P\<^esub>" by simp
+  then show ?thesis by auto
+qed
+
+lemma gauss_poly_carr: "gauss_poly R n \<in> carrier P"
+  using var_closed(1)
+  unfolding gauss_poly_def by simp
+
+lemma gauss_poly_degree:
+  assumes "n > 1"
+  shows "degree (gauss_poly R n) = n" 
+proof -
+  have "degree (gauss_poly R n) = max n 1"
+    unfolding gauss_poly_def a_minus_def
+    using var_pow_carr var_carr degree_var
+    using var_pow_degree univ_poly_a_inv_degree
+    using assms by (subst degree_add_distinct, auto)
+  also have "... = n" using assms by simp
+  finally show ?thesis by simp
+qed
+
+lemma gauss_poly_not_zero: 
+  assumes "n > 1"
+  shows "gauss_poly R n \<noteq> \<zero>\<^bsub>P\<^esub>"
+proof -
+  have "degree (gauss_poly R n) \<noteq> degree ( \<zero>\<^bsub>P\<^esub>)"
+    using assms by (subst gauss_poly_degree, simp_all add:univ_poly_zero)
+  thus ?thesis by auto
+qed
+
+lemma gauss_poly_monic:
+  assumes "n > 1" 
+  shows "monic_poly R (gauss_poly R n)"
+proof -
+  have "monic_poly R (X [^]\<^bsub>P\<^esub> n)" 
+    by (intro monic_poly_pow monic_poly_var) 
+  moreover have "\<ominus>\<^bsub>P\<^esub> X \<in> carrier P" 
+    using var_closed by simp
+  moreover have "degree (\<ominus>\<^bsub>P\<^esub> X) < degree (X [^]\<^bsub>P\<^esub> n)" 
+    using assms univ_poly_a_inv_degree var_closed
+    using degree_var
+    unfolding var_pow_degree by (simp)
+  ultimately show ?thesis
+    unfolding gauss_poly_def a_minus_def
+    by (intro monic_poly_add_distinct, auto)
+qed
+
+lemma geom_nat: 
+  fixes q :: nat
+  fixes x :: "_ :: {comm_ring,monoid_mult}"
+  shows "(x-1) * (\<Sum>i \<in> {..<q}. x^i) = x^q-1"
+  by (induction q, auto simp:algebra_simps)
+
+text \<open>The following lemma can be found in Ireland and Rosen~\cite[\textsection 7.1, Lemma 3]{ireland1982}.\<close>
+
+lemma gauss_poly_div_gauss_poly_iff_2:
+  fixes a :: int
+  fixes l m :: nat
+  assumes "l > 0" "a > 1"
+  shows "(a ^ l - 1) dvd (a ^ m - 1) \<longleftrightarrow> l dvd m"
+    (is "?lhs \<longleftrightarrow> ?rhs")
+proof -
+  define q where "q = m div l"
+  define r where "r = m mod l"
+  have m_def: "m = q * l + r" and r_range: "r < l" "r \<ge> 0"
+    using assms by (auto simp add:q_def r_def) 
+
+  have "a ^ (l * q) - 1 = (a ^ l) ^ q - 1"
+    by (simp add: power_mult)
+  also have "... = (a^l - 1) * (\<Sum>i \<in> {..<q}. (a^l)^i)"
+    by (subst geom_nat[symmetric], simp) 
+  finally have "a ^ (l * q) - 1 = (a^l - 1) * (\<Sum>i \<in> {..<q}. (a^l)^i)"
+    by simp
+  hence c:"a ^ l - 1 dvd a^ r * (a ^ (q * l) - 1)" by (simp add:mult.commute)
+
+  have "a ^ m - 1 = a ^ (r + q * l) - 1"
+    unfolding m_def using add.commute by metis
+  also have "... = (a ^ r) * (a ^ (q*l)) -1"
+    by (simp add: power_add)
+  also have "... = ((a ^ r) * (a ^ (q*l) -1)) + (a ^ r) - 1" 
+    by (simp add: right_diff_distrib)
+  also have "... = (a ^ r) * (a ^ (q*l) - 1) + ((a ^ r) - 1)"
+    by simp
+  finally have a: 
+    "a ^ m - 1 = (a ^ r) * (a ^ (q*l) - 1) + ((a ^ r) - 1)"
+    (is "_ = ?x")
+    by simp
+
+  have "?lhs \<longleftrightarrow> (a^l -1) dvd ?x"
+    by (subst a, simp)
+  also have "... \<longleftrightarrow> (a^l -1) dvd (a^r -1)"
+    using c dvd_add_right_iff by auto
+  also have "... \<longleftrightarrow> r = 0"
+  proof
+    assume "a ^ l - 1 dvd a ^ r - 1"
+    hence "a ^ l - 1  \<le> a ^ r -1 \<or> r = 0 " 
+      using assms r_range zdvd_not_zless by force
+    moreover have "a ^ r < a^l" using assms r_range by simp
+    ultimately show "r= 0"by simp
+  next
+    assume "r = 0"
+    thus "a ^ l - 1 dvd a ^ r - 1" by simp
+  qed
+  also have "... \<longleftrightarrow> l dvd m"
+    using r_def by auto
+  finally show ?thesis by simp
+qed
+
+lemma gauss_poly_div_gauss_poly_iff:
+  assumes "m > 0" "n > 0" "a > 1"
+  shows "gauss_poly R (a^n) pdivides\<^bsub>R\<^esub> gauss_poly R (a^m) 
+    \<longleftrightarrow> n dvd m" (is "?lhs=?rhs")
+proof -
+  have a:"a^m > 1" using assms one_less_power by blast
+  hence a1: "a^m > 0" by linarith
+  have b:"a^n > 1" using assms one_less_power by blast
+  hence b1:"a^n > 0" by linarith
+
+  have "?lhs \<longleftrightarrow>
+    (X [^]\<^bsub>P\<^esub> (a^n-1) \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>) \<otimes>\<^bsub>P\<^esub> X pdivides 
+    (X [^]\<^bsub>P\<^esub> (a^m-1) \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>) \<otimes>\<^bsub>P\<^esub> X"
+    using  gauss_poly_factor a1 b1 by simp
+  also have "... \<longleftrightarrow> 
+    (X [^]\<^bsub>P\<^esub> (a^n-1) \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>) pdivides 
+    (X [^]\<^bsub>P\<^esub> (a^m-1) \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>)"
+    using var_closed a b var_neq_zero
+    by (subst pdivides_mult_r, simp_all add:var_pow_eq_one_iff) 
+  also have "... \<longleftrightarrow> a^n-1 dvd a^m-1"
+    using b
+    by (subst gauss_poly_div_gauss_poly_iff_1) simp_all
+  also have "... \<longleftrightarrow> int (a^n-1) dvd int (a^m-1)"
+    by (subst of_nat_dvd_iff, simp)
+  also have "... \<longleftrightarrow> int a^n-1 dvd int a^m-1"
+    using a b by (simp add:of_nat_diff)
+  also have "... \<longleftrightarrow> n dvd m"
+    using assms
+    by (subst gauss_poly_div_gauss_poly_iff_2) simp_all
+  finally show ?thesis by simp
+qed
+
+end
+
+context finite_field 
+begin
+
+interpretation polynomial_ring "R" "carrier R"
+  unfolding polynomial_ring_def polynomial_ring_axioms_def
+  using field_axioms carrier_is_subfield by simp
+
+lemma div_gauss_poly_iff:
+  assumes "n > 0"
+  assumes "monic_irreducible_poly R f"
+  shows "f pdivides\<^bsub>R\<^esub> gauss_poly R (order R^n) \<longleftrightarrow> degree f dvd n"
+proof -
+  have f_carr: "f \<in> carrier P" 
+    using assms(2) unfolding monic_irreducible_poly_def
+    unfolding monic_poly_def by simp
+  have f_deg: "degree f > 0" 
+    using assms(2) monic_poly_min_degree by fastforce
+
+  define K where "K = Rupt\<^bsub>R\<^esub> (carrier R) f"
+  have field_K: "field K"
+    using assms(2) unfolding K_def monic_irreducible_poly_def 
+    unfolding monic_poly_def
+    by (subst rupture_is_field_iff_pirreducible)  auto
+  have a: "order K = order R^degree f" 
+    using rupture_order[OF carrier_is_subfield] f_carr f_deg
+    unfolding K_def order_def by simp
+  have char_K: "char K = char R" 
+    using rupture_char[OF carrier_is_subfield] f_carr f_deg
+    unfolding K_def by simp
+
+  have "card (carrier K) > 0"
+    using a f_deg finite_field_min_order unfolding order_def by simp
+  hence d: "finite (carrier K)" using card_ge_0_finite by auto
+  interpret f: finite_field "K"
+    using field_K d by (intro finite_fieldI, simp_all)
+  interpret fp: polynomial_ring "K" "(carrier K)"
+    unfolding polynomial_ring_def polynomial_ring_axioms_def
+    using f.field_axioms f.carrier_is_subfield by simp
+
+  define \<phi> where "\<phi> = rupture_surj (carrier R) f"
+  interpret h:ring_hom_ring "P" "K" "\<phi>"
+    unfolding K_def \<phi>_def using f_carr rupture_surj_hom by simp
+
+  have embed_inj: "inj_on (\<phi> \<circ> poly_of_const) (carrier R)"
+    unfolding \<phi>_def
+    using embed_inj[OF carrier_is_subfield f_carr f_deg] by simp
+
+  interpret r:ring_hom_ring "R" "P" "poly_of_const"
+    using canonical_embedding_ring_hom by simp
+
+  obtain rn where "order R = char K^rn" "rn > 0"
+    unfolding char_K using finite_field_order by auto
+  hence ord_rn: "order R ^n = char K^(rn * n)" using assms(1) 
+    by (simp add: power_mult)
+
+  interpret q:ring_hom_cring "K" "K" "\<lambda>x. x [^]\<^bsub>K\<^esub> order R^n"
+    using ord_rn
+    by (intro f.frobenius_hom f.finite_carr_imp_char_ge_0 d, simp) 
+
+  have o1: "order R^degree f > 1"
+    using f_deg finite_field_min_order one_less_power
+    by blast
+  hence o11: "order R^degree f > 0" by linarith
+  have o2: "order R^n > 1" 
+    using assms(1) finite_field_min_order one_less_power
+    by blast
+  hence o21: "order R^n > 0" by linarith
+  let ?g1 = "gauss_poly K (order R^degree f)"
+  let ?g2 = "gauss_poly K (order R^n)"
+
+  have g1_monic: "monic_poly K ?g1"
+    using f.gauss_poly_monic[OF o1] by simp
+
+  have c:"x [^]\<^bsub>K\<^esub> (order R^degree f) = x" if b:"x \<in> carrier K" for x
+    using b d order_pow_eq_self
+    unfolding a[symmetric]
+    by (intro f.order_pow_eq_self, auto)
+
+  have k_cycle: 
+    "\<phi> (poly_of_const x) [^]\<^bsub>K\<^esub> (order R^n) = \<phi>(poly_of_const x)" 
+    if k_cycle_1: "x \<in> carrier R" for x
+  proof -
+    have "\<phi> (poly_of_const x) [^]\<^bsub>K\<^esub> (order R^n) = 
+      \<phi> (poly_of_const (x [^]\<^bsub>R\<^esub> (order R^n)))"
+      using k_cycle_1 by (simp add: h.hom_nat_pow r.hom_nat_pow)
+    also have "... = \<phi> (poly_of_const x)"
+      using order_pow_eq_self' k_cycle_1 by simp
+    finally show ?thesis by simp
+  qed
+  
+  have roots_g1: "pmult\<^bsub>K\<^esub> d ?g1 \<ge> 1" 
+    if roots_g1_assms: "degree d = 1" "monic_irreducible_poly K d" for d
+  proof -
+    obtain x where x_def: "x \<in> carrier K" "d = [\<one>\<^bsub>K\<^esub>, \<ominus>\<^bsub>K\<^esub> x]"
+      using f.degree_one_monic_poly roots_g1_assms by auto
+    interpret x:ring_hom_cring "poly_ring K" "K" "(\<lambda>p. f.eval p x)"
+      by (intro fp.eval_cring_hom x_def)
+    have "ring.eval K ?g1 x = \<zero>\<^bsub>K\<^esub>"
+      unfolding gauss_poly_def a_minus_def
+      using fp.var_closed f.eval_var x_def c
+      by (simp, algebra)
+    hence "f.is_root ?g1 x"
+      using x_def f.gauss_poly_not_zero[OF o1]
+      unfolding f.is_root_def univ_poly_zero by simp
+    hence "[\<one>\<^bsub>K\<^esub>, \<ominus>\<^bsub>K\<^esub> x] pdivides\<^bsub>K\<^esub> ?g1"
+      using f.is_root_imp_pdivides f.gauss_poly_carr by simp
+    hence "d pdivides\<^bsub>K\<^esub> ?g1" by (simp add:x_def)
+    thus "pmult\<^bsub>K\<^esub> d ?g1 \<ge> 1"
+      using that f.gauss_poly_not_zero f.gauss_poly_carr o1
+      by (subst f.multiplicity_ge_1_iff_pdivides, simp_all)
+  qed
+
+  show ?thesis
+  proof
+    assume f:"f pdivides\<^bsub>R\<^esub> gauss_poly R (order R^n)"
+    have "(\<phi> X) [^]\<^bsub>K\<^esub> (order R^n) \<ominus>\<^bsub>K\<^esub> (\<phi> X\<^bsub>R\<^esub>) = 
+      \<phi> (gauss_poly R (order R^n))"
+      unfolding gauss_poly_def a_minus_def using var_closed
+      by (simp add: h.hom_nat_pow)
+    also have "... = \<zero>\<^bsub>K\<^esub>" 
+      unfolding K_def \<phi>_def using f_carr gauss_poly_carr f
+      by (subst rupture_eq_0_iff, simp_all) 
+    finally have "(\<phi> X\<^bsub>R\<^esub>) [^]\<^bsub>K\<^esub> (order R^n) \<ominus>\<^bsub>K\<^esub> (\<phi> X\<^bsub>R\<^esub>) = \<zero>\<^bsub>K\<^esub>"
+      by simp
+    hence g:"(\<phi> X) [^]\<^bsub>K\<^esub> (order R^n) = (\<phi> X)"
+      using var_closed by simp
+
+    have roots_g2: "pmult\<^bsub>K\<^esub> d ?g2 \<ge> 1" 
+      if roots_g2_assms: "degree d = 1" "monic_irreducible_poly K d" for d
+    proof -
+      obtain y where y_def: "y \<in> carrier K" "d = [\<one>\<^bsub>K\<^esub>, \<ominus>\<^bsub>K\<^esub> y]"
+        using f.degree_one_monic_poly roots_g2_assms by auto
+
+      interpret x:ring_hom_cring "poly_ring K" "K" "(\<lambda>p. f.eval p y)"
+        by (intro fp.eval_cring_hom y_def)
+      obtain x where x_def: "x \<in> carrier P" "y = \<phi> x"
+        using y_def unfolding \<phi>_def K_def rupture_def 
+        unfolding FactRing_def A_RCOSETS_def'
+        by auto
+      let ?\<tau>  = "\<lambda>i. poly_of_const (coeff x i)"
+      have test: "?\<tau> i \<in> carrier P" for i
+        by (intro r.hom_closed coeff_range x_def)
+      have test_2: "coeff x i \<in> carrier R" for i 
+        by (intro coeff_range x_def)
+
+      have x_coeff_carr: "i \<in> set x \<Longrightarrow> i \<in> carrier R"  for i
+        using x_def(1) 
+        by (auto simp add:univ_poly_carrier[symmetric] polynomial_def)
+
+      have a:"map (\<phi> \<circ> poly_of_const) x \<in> carrier (poly_ring K)"
+        using rupture_surj_norm_is_hom[OF f_carr] 
+        using domain_axioms f.domain_axioms embed_inj
+        by (intro carrier_hom'[OF  x_def(1)])
+         (simp_all add:\<phi>_def K_def)
+
+      have "(\<phi> x) [^]\<^bsub>K\<^esub> (order R^n) = 
+        f.eval (map (\<phi> \<circ> poly_of_const) x) (\<phi> X) [^]\<^bsub>K\<^esub> (order R^n)"
+        unfolding \<phi>_def K_def
+        by (subst rupture_surj_as_eval[OF f_carr x_def(1)], simp)
+      also have "... = 
+        f.eval (map (\<lambda>x. \<phi> (poly_of_const x) [^]\<^bsub>K\<^esub> order R ^ n) x) (\<phi> X)"
+        using a h.hom_closed var_closed(1)
+        by (subst q.ring.eval_hom[OF f.carrier_is_subring])
+          (simp_all add:comp_def g)
+      also have "... = f.eval (map (\<lambda>x. \<phi> (poly_of_const x)) x) (\<phi> X)"
+        using k_cycle x_coeff_carr
+        by (intro arg_cong2[where f="f.eval"] map_cong, simp_all)
+      also have "... = (\<phi> x)"
+        unfolding \<phi>_def K_def
+        by (subst rupture_surj_as_eval[OF f_carr x_def(1)], simp add:comp_def)
+      finally have "\<phi> x [^]\<^bsub>K\<^esub> order R ^ n = \<phi> x" by simp
+       
+      hence "y [^]\<^bsub>K\<^esub> (order R^n) = y" using x_def by simp
+      hence "ring.eval K ?g2 y = \<zero>\<^bsub>K\<^esub>"
+        unfolding gauss_poly_def a_minus_def
+        using fp.var_closed f.eval_var y_def
+        by (simp, algebra)
+      hence "f.is_root ?g2 y"
+        using y_def f.gauss_poly_not_zero[OF o2]
+        unfolding f.is_root_def univ_poly_zero by simp
+      hence "d pdivides\<^bsub>K\<^esub> ?g2"
+        unfolding y_def
+        by (intro f.is_root_imp_pdivides f.gauss_poly_carr, simp)
+      thus "pmult\<^bsub>K\<^esub> d ?g2 \<ge> 1"
+        using that f.gauss_poly_carr f.gauss_poly_not_zero o2
+        by (subst f.multiplicity_ge_1_iff_pdivides, auto)
+    qed
+
+    have inv_k_inj: "inj_on (\<lambda>x. \<ominus>\<^bsub>K\<^esub> x) (carrier K)"
+      by (intro inj_onI, metis f.minus_minus)
+    let ?mip = "monic_irreducible_poly K"
+
+    have "sum' (\<lambda>d. pmult\<^bsub>K\<^esub> d ?g1 * degree d) {d. ?mip d} = degree ?g1"
+      using f.gauss_poly_monic o1
+      by (subst f.degree_monic_poly', simp_all)
+    also have "... = order K"
+      using f.gauss_poly_degree o1 a by simp
+    also have "... = card ((\<lambda>k. [\<one>\<^bsub>K\<^esub>, \<ominus>\<^bsub>K\<^esub> k]) ` carrier K)"
+      unfolding order_def using inj_onD[OF inv_k_inj]
+      by (intro card_image[symmetric] inj_onI) (simp_all) 
+    also have "... = card {d. ?mip d \<and> degree d = 1}"
+      using f.degree_one_monic_poly
+      by (intro arg_cong[where f="card"], simp add:set_eq_iff image_iff) 
+    also have "... = sum (\<lambda>d. 1) {d. ?mip d \<and> degree d = 1}" 
+      by simp
+    also have "... = sum' (\<lambda>d. 1) {d. ?mip d \<and> degree d = 1}" 
+      by (intro sum.eq_sum[symmetric] 
+          finite_subset[OF _ fp.finite_poly(1)[OF d]])
+       (auto simp:monic_irreducible_poly_def monic_poly_def)
+    also have "... = sum' (\<lambda>d. of_bool (degree d = 1)) {d. ?mip d}" 
+      by (intro sum.mono_neutral_cong_left' subsetI, simp_all)
+    also have "... \<le> sum' (\<lambda>d. of_bool (degree d = 1)) {d. ?mip d}"
+      by simp
+    finally have "sum' (\<lambda>d. pmult\<^bsub>K\<^esub> d ?g1 * degree d) {d. ?mip d}
+      \<le> sum' (\<lambda>d. of_bool (degree d = 1)) {d. ?mip d}"
+      by simp
+    moreover have 
+      "pmult\<^bsub>K\<^esub> d ?g1 * degree d \<ge> of_bool (degree d = 1)" 
+      if v:"monic_irreducible_poly K d" for d
+    proof (cases "degree d = 1")
+      case True
+      then obtain x where "x \<in> carrier K" "d = [\<one>\<^bsub>K\<^esub>, \<ominus>\<^bsub>K\<^esub> x]"
+        using f.degree_one_monic_poly v by auto
+      hence "pmult\<^bsub>K\<^esub> d ?g1 \<ge> 1"
+        using roots_g1 v by simp
+      then show ?thesis using True by simp
+    next
+      case False
+      then show ?thesis by simp
+    qed
+    moreover have 
+      "finite {d. ?mip d \<and> pmult\<^bsub>K\<^esub> d ?g1 * degree d > 0}"
+      by (intro finite_subset[OF _ f.factor_monic_poly_fin[OF g1_monic]]
+          subsetI) simp
+    ultimately have v2:
+      "\<forall>d \<in> {d. ?mip d}. pmult\<^bsub>K\<^esub> d ?g1 * degree d = 
+      of_bool (degree d = 1)" 
+      by (intro sum'_eq_iff, simp_all add:not_le)
+    have "pmult\<^bsub>K\<^esub> d ?g1 \<le> pmult\<^bsub>K\<^esub> d ?g2" if "?mip d" for d
+    proof (cases "degree d = 1")
+      case True
+      hence "pmult\<^bsub>K\<^esub> d ?g1 = 1" using v2 that by simp
+      also have "... \<le> pmult\<^bsub>K\<^esub> d ?g2" 
+        by (intro roots_g2 True that)
+      finally show ?thesis by simp
+    next
+      case False
+      hence "degree d > 1"
+        using f.monic_poly_min_degree[OF that] by simp
+      hence "pmult\<^bsub>K\<^esub> d ?g1 = 0" using v2 that by auto
+      then show ?thesis by simp
+    qed
+    hence "?g1 pdivides\<^bsub>K\<^esub> ?g2"
+      using o1 o2 f.divides_monic_poly f.gauss_poly_monic by simp
+    thus "degree f dvd n"
+      by (subst (asm) f.gauss_poly_div_gauss_poly_iff
+          [OF assms(1) f_deg finite_field_min_order], simp) 
+  next
+    have d:"\<phi> X\<^bsub>R\<^esub> \<in> carrier K"
+      by (intro h.hom_closed var_closed)
+
+    have "\<phi> (gauss_poly R (order R^degree f)) = 
+      (\<phi> X\<^bsub>R\<^esub>) [^]\<^bsub>K\<^esub> (order R^degree f) \<ominus>\<^bsub>K\<^esub> (\<phi> X\<^bsub>R\<^esub>)"
+      unfolding gauss_poly_def a_minus_def using var_closed
+      by (simp add: h.hom_nat_pow)
+    also have "... = \<zero>\<^bsub>K\<^esub>"
+      using c d by simp
+    finally have "\<phi> (gauss_poly R (order R^degree f)) = \<zero>\<^bsub>K\<^esub>" by simp
+    hence "f pdivides\<^bsub>R\<^esub> gauss_poly R (order R^degree f)"
+      unfolding K_def \<phi>_def using f_carr gauss_poly_carr
+      by (subst (asm) rupture_eq_0_iff, simp_all) 
+    moreover assume "degree f dvd n"
+    
+    hence "gauss_poly R (order R^degree f) pdivides 
+      (gauss_poly R (order R^n))"
+      using gauss_poly_div_gauss_poly_iff
+        [OF assms(1) f_deg finite_field_min_order]
+      by simp
+    ultimately show "f pdivides\<^bsub>R\<^esub> gauss_poly R (order R^n)"
+      using f_carr a p.divides_trans unfolding pdivides_def by blast
+  qed
+qed
+
+lemma gauss_poly_splitted:
+  "splitted (gauss_poly R (order R))"
+proof -
+  have "degree q \<le> 1" if 
+    "q \<in> carrier P" 
+    "pirreducible (carrier R) q" 
+    "q pdivides gauss_poly R (order R)" for q
+  proof -
+    have q_carr: "q \<in> carrier (mult_of P)" 
+      using that unfolding ring_irreducible_def by simp
+    moreover have "irreducible (mult_of P) q" 
+      using that unfolding ring_irreducible_def
+      by (intro p.irreducible_imp_irreducible_mult that, simp_all)
+    ultimately obtain p where p_def: 
+      "monic_irreducible_poly R p" "q \<sim>\<^bsub>mult_of P\<^esub> p"
+      using monic_poly_span by auto
+    have p_carr: "p \<in> carrier P" "p \<noteq> []" 
+      using p_def(1) 
+      unfolding monic_irreducible_poly_def monic_poly_def
+      by auto
+    moreover have "p divides\<^bsub>mult_of P\<^esub> q"
+      using associatedE[OF p_def(2)] by auto
+    hence "p pdivides q"
+      unfolding pdivides_def using divides_mult_imp_divides by simp
+    moreover have "q pdivides gauss_poly R (order R^1)"
+      using that by simp
+    ultimately have "p pdivides gauss_poly R (order R^1)"
+      unfolding pdivides_def using p.divides_trans by blast
+    hence "degree p dvd 1"
+      using  div_gauss_poly_iff[where n="1"] p_def(1) by simp
+    hence "degree p = 1" by simp
+    moreover have "q divides\<^bsub>mult_of P\<^esub> p"
+      using associatedE[OF p_def(2)] by auto
+    hence "q pdivides p"
+      unfolding pdivides_def using divides_mult_imp_divides by simp
+    hence "degree q \<le> degree p"
+      using that p_carr
+      by (intro pdivides_imp_degree_le) auto
+    ultimately show ?thesis by simp
+  qed
+
+  thus ?thesis
+    using gauss_poly_carr
+    by (intro trivial_factors_imp_splitted, auto)
+qed
+
+text \<open>The following lemma, for the case when @{term "R"} is a simple prime field, can be found in
+Ireland and Rosen~\cite[\textsection 7.1, Theorem 2]{ireland1982}. Here the result is verified even
+for arbitrary finite fields.\<close>
+
+lemma multiplicity_of_factor_of_gauss_poly:
+  assumes "n > 0"
+  assumes "monic_irreducible_poly R f"
+  shows 
+    "pmult\<^bsub>R\<^esub> f (gauss_poly R (order R^n)) = of_bool (degree f dvd n)"
+proof (cases "degree f dvd n")
+  case True
+  let ?g = "gauss_poly R (order R^n)"
+  have f_carr: "f \<in> carrier P" "f \<noteq> []"
+    using assms(2)
+    unfolding monic_irreducible_poly_def monic_poly_def
+    by auto
+
+  have o2: "order R^n > 1" 
+    using finite_field_min_order assms(1) one_less_power by blast
+  hence o21: "order R^n > 0" by linarith
+
+  obtain d :: nat where order_dim: "order R = char R ^ d" "d > 0"
+    using finite_field_order by blast
+  have "d * n > 0" using order_dim assms by simp
+  hence char_dvd_order: "int (char R) dvd int (order R ^ n)"
+    unfolding order_dim 
+    using finite_carr_imp_char_ge_0[OF finite_carrier]
+    by (simp add:power_mult[symmetric])
+
+  interpret h: ring_hom_ring  "R" "P" "poly_of_const"
+    using canonical_embedding_ring_hom by simp
+
+  have "f pdivides\<^bsub>R\<^esub> ?g"
+    using True div_gauss_poly_iff[OF assms] by simp
+  hence "pmult\<^bsub>R\<^esub> f ?g \<ge> 1"
+    using multiplicity_ge_1_iff_pdivides[OF assms(2)] 
+    using gauss_poly_carr gauss_poly_not_zero[OF o2] 
+    by auto
+  moreover have "pmult\<^bsub>R\<^esub> f ?g < 2"
+  proof (rule ccontr)
+    assume "\<not> pmult\<^bsub>R\<^esub> f ?g < 2"
+    hence "pmult\<^bsub>R\<^esub> f ?g \<ge> 2" by simp
+    hence "(f [^]\<^bsub>P\<^esub> (2::nat)) pdivides\<^bsub>R\<^esub> ?g"
+      using gauss_poly_carr gauss_poly_not_zero[OF o2]
+      by (subst (asm) multiplicity_ge_iff[OF assms(2)]) simp_all
+    hence "(f [^]\<^bsub>P\<^esub> (2::nat)) divides\<^bsub>mult_of P\<^esub> ?g"
+      unfolding pdivides_def 
+      using f_carr gauss_poly_not_zero o2 gauss_poly_carr
+      by (intro p.divides_imp_divides_mult) simp_all
+    then obtain h where h_def: 
+      "h \<in> carrier (mult_of P)" 
+      "?g = f [^]\<^bsub>P\<^esub> (2::nat) \<otimes>\<^bsub>P\<^esub> h"
+      using dividesD by auto
+    have "\<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub> = int_embed P (order R ^ n) 
+      \<otimes>\<^bsub>P\<^esub> (X\<^bsub>R\<^esub> [^]\<^bsub>P\<^esub> (order R ^ n-1)) \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>"
+      using var_closed
+      apply (subst int_embed_consistent_with_poly_of_const)
+      apply (subst iffD2[OF embed_char_eq_0_iff char_dvd_order])
+      by (simp add:a_minus_def)
+    also have "... = pderiv\<^bsub>R\<^esub> (X\<^bsub>R\<^esub> [^]\<^bsub>P\<^esub> order R ^ n) \<ominus>\<^bsub>P\<^esub> pderiv\<^bsub>R\<^esub> X\<^bsub>R\<^esub>"
+      using pderiv_var
+      by (subst pderiv_var_pow[OF o21], simp)
+    also have "... = pderiv\<^bsub>R\<^esub> ?g" 
+      unfolding gauss_poly_def a_minus_def using var_closed
+      by (subst pderiv_add, simp_all add:pderiv_inv)
+    also have "... = pderiv\<^bsub>R\<^esub> (f [^]\<^bsub>P\<^esub> (2::nat) \<otimes>\<^bsub>P\<^esub> h)"
+      using h_def(2) by simp
+    also have "... = pderiv\<^bsub>R\<^esub> (f [^]\<^bsub>P\<^esub> (2::nat)) \<otimes>\<^bsub>P\<^esub> h 
+      \<oplus>\<^bsub>P\<^esub> (f [^]\<^bsub>P\<^esub> (2::nat)) \<otimes>\<^bsub>P\<^esub> pderiv\<^bsub>R\<^esub> h"
+      using f_carr h_def
+      by (intro pderiv_mult, simp_all)
+    also have "... = int_embed P 2 \<otimes>\<^bsub>P\<^esub> f  \<otimes>\<^bsub>P\<^esub> pderiv\<^bsub>R\<^esub> f \<otimes>\<^bsub>P\<^esub> h 
+      \<oplus>\<^bsub>P\<^esub> f \<otimes>\<^bsub>P\<^esub> f \<otimes>\<^bsub>P\<^esub> pderiv\<^bsub>R\<^esub> h"
+      using f_carr
+      by (subst pderiv_pow, simp_all add:numeral_eq_Suc)
+    also have "... = f \<otimes>\<^bsub>P\<^esub> (int_embed P 2 \<otimes>\<^bsub>P\<^esub> pderiv\<^bsub>R\<^esub> f \<otimes>\<^bsub>P\<^esub> h) 
+      \<oplus>\<^bsub>P\<^esub> f \<otimes>\<^bsub>P\<^esub> (f \<otimes>\<^bsub>P\<^esub> pderiv\<^bsub>R\<^esub> h)"
+      using f_carr pderiv_carr h_def p.int_embed_closed
+      apply (intro arg_cong2[where f="(\<oplus>\<^bsub>P\<^esub>)"]) 
+      by (subst p.m_comm, simp_all add:p.m_assoc)
+    also have "... = f \<otimes>\<^bsub>P\<^esub> 
+      (int_embed P 2 \<otimes>\<^bsub>P\<^esub> pderiv\<^bsub>R\<^esub> f \<otimes>\<^bsub>P\<^esub> h \<oplus>\<^bsub>P\<^esub> f \<otimes>\<^bsub>P\<^esub> pderiv\<^bsub>R\<^esub> h)"
+      using f_carr pderiv_carr h_def p.int_embed_closed
+      by (subst p.r_distr, simp_all)
+    finally have "\<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub> = f \<otimes>\<^bsub>P\<^esub> 
+      (int_embed P 2 \<otimes>\<^bsub>P\<^esub> pderiv\<^bsub>R\<^esub> f \<otimes>\<^bsub>P\<^esub> h \<oplus>\<^bsub>P\<^esub> f \<otimes>\<^bsub>P\<^esub> pderiv\<^bsub>R\<^esub> h)" 
+      (is "_ = f \<otimes>\<^bsub>P\<^esub> ?q")
+      by simp
+
+    hence "f pdivides\<^bsub>R\<^esub> \<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>"
+      unfolding factor_def pdivides_def
+      using f_carr pderiv_carr h_def p.int_embed_closed
+      by auto
+    moreover have "\<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub> \<noteq> \<zero>\<^bsub>P\<^esub>" by simp
+    ultimately have  "degree f \<le> degree (\<ominus>\<^bsub>P\<^esub> \<one>\<^bsub>P\<^esub>)"
+      using f_carr 
+      by (intro pdivides_imp_degree_le, simp_all add:univ_poly_zero)
+    also have "... = 0"
+      by (subst univ_poly_a_inv_degree, simp)
+       (simp add:univ_poly_one)
+    finally have "degree f = 0" by simp
+       
+    then show "False" 
+      using pirreducible_degree assms(2)
+      unfolding monic_irreducible_poly_def monic_poly_def 
+      by fastforce
+  qed
+  ultimately have "pmult\<^bsub>R\<^esub> f ?g = 1" by simp
+  then show ?thesis using True by simp
+next
+  case False
+  have o2: "order R^n > 1" 
+    using finite_field_min_order assms(1) one_less_power by blast
+
+  have "\<not>(f pdivides\<^bsub>R\<^esub> gauss_poly R (order R^n))"
+    using div_gauss_poly_iff[OF assms] False by simp
+  hence "pmult\<^bsub>R\<^esub> f (gauss_poly R (order R^n)) = 0"
+    using multiplicity_ge_1_iff_pdivides[OF assms(2)]
+    using gauss_poly_carr gauss_poly_not_zero[OF o2] leI less_one
+    by blast
+  then show ?thesis using False by simp
+qed
+
+text \<open>The following lemma, for the case when @{term "R"} is a simple prime field, can be found in Ireland
+and Rosen~\cite[\textsection 7.1, Corollary 1]{ireland1982}. Here the result is verified even for
+arbitrary finite fields.\<close>
+
+lemma card_irred_aux:
+  assumes "n > 0"
+  shows "order R^n = (\<Sum>d | d dvd n. d * 
+    card {f. monic_irreducible_poly R f \<and> degree f = d})"
+  (is "?lhs = ?rhs")
+proof -
+  let ?G = "{f. monic_irreducible_poly R f \<and> degree f dvd n}"
+  
+  let ?D = "{f. monic_irreducible_poly R f}"
+  have a: "finite {d. d dvd n}" using finite_divisors_nat assms by simp
+  have b: "finite {f. monic_irreducible_poly R f \<and> degree f = k}" for k
+  proof -
+    have "{f. monic_irreducible_poly R f \<and> degree f = k} \<subseteq> 
+      {f. f \<in> carrier P \<and> degree f \<le> k}"
+      unfolding monic_irreducible_poly_def monic_poly_def by auto
+    moreover have "finite {f. f \<in> carrier P \<and> degree f \<le> k}" 
+      using finite_poly[OF finite_carrier] by simp
+    ultimately show ?thesis using finite_subset by simp
+  qed
+
+  have G_split: "?G = 
+    \<Union> {{f.  monic_irreducible_poly R f \<and> degree f = d} | d. d dvd n}"
+    by auto
+  have c: "finite ?G"
+    using a b by (subst G_split, auto) 
+  have d: "order R^n > 1" 
+    using assms finite_field_min_order one_less_power by blast
+
+  have "?lhs = degree (gauss_poly R (order R^n))"
+    using d
+    by (subst gauss_poly_degree, simp_all)
+  also have "... = 
+    sum' (\<lambda>d. pmult\<^bsub>R\<^esub> d (gauss_poly R (order R^n)) * degree d) ?D"
+    using d
+    by (intro degree_monic_poly'[symmetric] gauss_poly_monic) 
+  also have "... = sum' (\<lambda>d. of_bool (degree d dvd n) * degree d) ?D"
+    using multiplicity_of_factor_of_gauss_poly[OF assms]
+    by (intro sum.cong', auto)
+  also have "... = sum' (\<lambda>d. degree d) ?G"
+    by (intro sum.mono_neutral_cong_right' subsetI, auto)
+  also have "... = (\<Sum> d \<in> ?G. degree d)"
+    using c by (intro sum.eq_sum, simp) 
+  also have "... = 
+    (\<Sum> f \<in> (\<Union> d \<in> {d. d dvd n}. 
+    {f. monic_irreducible_poly R f \<and> degree f = d}). degree f)"
+    by (intro sum.cong, auto simp add:set_eq_iff)
+  also have "... = (\<Sum>d | d dvd n. sum degree 
+    {f. monic_irreducible_poly R f \<and> degree f = d})"
+    using a b by (subst sum.UNION_disjoint, auto simp add:set_eq_iff)
+  also have "... = (\<Sum>d | d dvd n. sum (\<lambda>_. d) 
+    {f. monic_irreducible_poly R f \<and> degree f = d})"
+    by (intro sum.cong, simp_all)
+  also have "... = ?rhs"
+    by (simp add:mult.commute)
+  finally show ?thesis
+    by simp
+qed
+
+end
+
+end
diff --git a/thys/Finite_Fields/Finite_Fields_Factorization_Ext.thy b/thys/Finite_Fields/Finite_Fields_Factorization_Ext.thy
new file mode 100644
--- /dev/null
+++ b/thys/Finite_Fields/Finite_Fields_Factorization_Ext.thy
@@ -0,0 +1,516 @@
+subsection "Factorization"
+
+theory Finite_Fields_Factorization_Ext
+  imports Finite_Fields_Preliminary_Results
+begin
+
+text \<open>This section contains additional results building on top of the development in
+@{theory "HOL-Algebra.Divisibility"} about factorization in a @{locale "factorial_monoid"}.\<close>
+
+definition factor_mset where "factor_mset G x = 
+  (THE f. (\<exists> as. f = fmset G as \<and> wfactors G as x \<and> set as \<subseteq> carrier G))"
+
+text \<open>In @{theory "HOL-Algebra.Divisibility"} it is already verified that the multiset representing
+the factorization of an element of a factorial monoid into irreducible factors is well-defined.
+With these results it is then possible to define @{term "factor_mset"} and show its properties,
+without referring to a factorization in list form first.\<close>
+
+definition multiplicity where
+  "multiplicity G d g = Max {(n::nat). (d [^]\<^bsub>G\<^esub> n) divides\<^bsub>G\<^esub> g}"
+
+definition canonical_irreducibles where 
+  "canonical_irreducibles G A = (
+    A \<subseteq> {a. a \<in> carrier G \<and> irreducible G a} \<and>
+    (\<forall>x y. x \<in> A \<longrightarrow> y \<in> A \<longrightarrow> x \<sim>\<^bsub>G\<^esub> y \<longrightarrow> x = y) \<and>
+    (\<forall>x \<in> carrier G. irreducible G x \<longrightarrow> (\<exists>y \<in> A. x \<sim>\<^bsub>G\<^esub> y)))"
+
+text \<open>A set of irreducible elements that contains exactly one element from each equivalence class
+of an irreducible element formed by association, is called a set of 
+@{term "canonical_irreducibles"}. An example is the set of monic irreducible polynomials as
+representatives of all irreducible polynomials.\<close>
+
+context factorial_monoid
+begin
+
+lemma assoc_as_fmset_eq:
+  assumes "wfactors G as a"
+    and "wfactors G bs b"
+    and "a \<in> carrier G"
+    and "b \<in> carrier G"
+    and "set as \<subseteq> carrier G"
+    and "set bs \<subseteq> carrier G"
+  shows "a \<sim> b \<longleftrightarrow> (fmset G as = fmset G bs)"
+proof -
+  have "a \<sim> b \<longleftrightarrow> (a divides b \<and> b divides a)"
+    by (simp add:associated_def)
+  also have "... \<longleftrightarrow> 
+    (fmset G as \<subseteq># fmset G bs \<and> fmset G bs \<subseteq># fmset G as)"
+    using divides_as_fmsubset assms by blast
+  also have "... \<longleftrightarrow> (fmset G as = fmset G bs)" by auto
+  finally show ?thesis by simp
+qed
+
+lemma factor_mset_aux_1:
+  assumes "a \<in> carrier G" "set as \<subseteq> carrier G" "wfactors G as a"
+  shows "factor_mset G a = fmset G as"
+proof -
+  define H where "H = {as. wfactors G as a \<and> set as \<subseteq> carrier G}"
+  have b:"as \<in> H"
+    using H_def assms by simp
+
+  have c: "x \<in> H \<Longrightarrow> y \<in> H \<Longrightarrow> fmset G x = fmset G y" for x y
+    unfolding H_def using assoc_as_fmset_eq 
+    using associated_refl assms by blast 
+
+  have "factor_mset G a = (THE f. \<exists>as \<in> H. f= fmset G as)"
+    by (simp add:factor_mset_def H_def, metis) 
+
+  also have "... = fmset G as"
+    using b c
+    by (intro the1_equality) blast+
+  finally have "factor_mset G a = fmset G as" by simp
+
+  thus ?thesis
+    using b unfolding H_def by auto
+qed
+
+lemma factor_mset_aux:
+  assumes "a \<in> carrier G"
+  shows "\<exists>as. factor_mset G a = fmset G as \<and> wfactors G as a \<and> 
+    set as \<subseteq> carrier G"
+proof -
+  obtain as where as_def: "wfactors G as a" "set as \<subseteq> carrier G"
+    using wfactors_exist assms by blast
+  thus ?thesis using factor_mset_aux_1 assms by blast
+qed
+
+lemma factor_mset_set:
+  assumes "a \<in> carrier G"
+  assumes "x \<in># factor_mset G a" 
+  obtains y where 
+    "y \<in> carrier G" 
+    "irreducible G y" 
+    "assocs G y = x" 
+proof -
+  obtain as where as_def: 
+    "factor_mset G a = fmset G as" 
+    "wfactors G as a" "set as \<subseteq> carrier G"
+    using factor_mset_aux assms by blast
+  hence "x \<in># fmset G as"
+    using assms by simp
+  hence "x \<in> assocs G ` set as"
+    using assms as_def by (simp add:fmset_def)
+  hence "\<exists>y. y \<in> set as \<and> x = assocs G y"
+    by auto
+  moreover have "y \<in> carrier G \<and> irreducible G y" 
+    if "y \<in> set as" for y
+    using as_def that wfactors_def
+    by (simp add: wfactors_def) auto
+  ultimately show ?thesis
+    using that by blast
+qed
+
+lemma factor_mset_mult:
+  assumes "a \<in> carrier G" "b \<in> carrier G"
+  shows "factor_mset G (a \<otimes> b) = factor_mset G a + factor_mset G b"
+proof -
+  obtain as where as_def: 
+    "factor_mset G a = fmset G as" 
+    "wfactors G as a" "set as \<subseteq> carrier G"
+    using factor_mset_aux assms by blast
+  obtain bs where bs_def: 
+    "factor_mset G b = fmset G bs" 
+    "wfactors G bs b" "set bs \<subseteq> carrier G"
+    using factor_mset_aux assms(2) by blast
+  have "a \<otimes> b \<in> carrier G" using assms by auto
+  then obtain cs where cs_def:
+    "factor_mset G (a \<otimes> b) = fmset G cs" 
+    "wfactors G cs (a \<otimes> b)" 
+    "set cs \<subseteq> carrier G"
+    using factor_mset_aux assms by blast
+  have "fmset G cs = fmset G as + fmset G bs"
+    using as_def bs_def cs_def assms 
+    by (intro  mult_wfactors_fmset[where a="a" and b="b"]) auto
+  thus ?thesis
+    using as_def bs_def cs_def by auto
+qed
+
+lemma factor_mset_unit: "factor_mset G \<one> = {#}"
+proof -
+  have "factor_mset G \<one> = factor_mset G (\<one> \<otimes> \<one>)"
+    by simp
+  also have "... = factor_mset G \<one> + factor_mset G \<one>"
+    by (intro factor_mset_mult, auto)
+  finally show "factor_mset G \<one> = {#}"
+    by simp
+qed
+
+lemma factor_mset_irred: 
+  assumes "x \<in> carrier G" "irreducible G x"
+  shows "factor_mset G x = image_mset (assocs G) {#x#}"
+proof -
+  have "wfactors G [x] x"
+    using assms by (simp add:wfactors_def)
+  hence "factor_mset G x = fmset G [x]"
+    using factor_mset_aux_1 assms by simp
+  also have "... = image_mset (assocs G) {#x#}"
+    by (simp add:fmset_def)
+  finally show ?thesis by simp
+qed
+
+lemma factor_mset_divides:
+  assumes "a \<in> carrier G" "b \<in> carrier G"
+  shows "a divides b \<longleftrightarrow> factor_mset G a \<subseteq># factor_mset G b"
+proof -
+  obtain as where as_def: 
+    "factor_mset G a = fmset G as" 
+    "wfactors G as a" "set as \<subseteq> carrier G"
+    using factor_mset_aux assms by blast
+  obtain bs where bs_def: 
+    "factor_mset G b = fmset G bs" 
+    "wfactors G bs b" "set bs \<subseteq> carrier G"
+    using factor_mset_aux assms(2) by blast
+  hence "a divides b \<longleftrightarrow> fmset G as \<subseteq># fmset G bs"
+    using as_def bs_def assms
+    by (intro divides_as_fmsubset) auto
+  also have "... \<longleftrightarrow> factor_mset G a \<subseteq># factor_mset G b"
+    using as_def bs_def by simp
+  finally show ?thesis by simp
+qed
+
+lemma factor_mset_sim:
+  assumes "a \<in> carrier G" "b \<in> carrier G"
+  shows "a \<sim> b \<longleftrightarrow> factor_mset G a = factor_mset G b"
+  using factor_mset_divides assms
+  by (simp add:associated_def) auto
+
+lemma factor_mset_prod:
+  assumes "finite A"
+  assumes "f ` A \<subseteq> carrier G" 
+  shows "factor_mset G (\<Otimes>a \<in> A. f a) = 
+    (\<Sum>a \<in> A. factor_mset G (f a))"
+  using assms
+proof (induction A rule:finite_induct)
+  case empty
+  then show ?case by (simp add:factor_mset_unit)
+next
+  case (insert x F)
+  have "factor_mset G (finprod G f (insert x F)) = 
+    factor_mset G (f x \<otimes> finprod G f F)"
+    using insert by (subst finprod_insert) auto
+  also have "... = factor_mset G (f x) + factor_mset G (finprod G f F)"
+    using insert by (intro factor_mset_mult finprod_closed) auto
+  also have 
+    "... = factor_mset G (f x) + (\<Sum>a \<in> F. factor_mset G (f a))"
+    using insert by simp
+  also have "... = (\<Sum>a\<in>insert x F. factor_mset G (f a))"
+    using insert by simp
+  finally show ?case by simp
+qed
+
+lemma factor_mset_pow:
+  assumes "a \<in> carrier G"
+  shows "factor_mset G (a [^] n) = repeat_mset n (factor_mset G a)"
+proof (induction n)
+  case 0
+  then show ?case by (simp add:factor_mset_unit)
+next
+  case (Suc n)
+  have "factor_mset G (a [^] Suc n) = factor_mset G (a [^] n \<otimes> a)"
+    by simp
+  also have "... = factor_mset G (a [^] n) + factor_mset G a"
+    using assms by (intro factor_mset_mult) auto
+  also have "... = repeat_mset n (factor_mset G a) + factor_mset G a"
+    using Suc by simp
+  also have "... = repeat_mset (Suc n) (factor_mset G a)"
+    by simp
+  finally show ?case by simp
+qed
+
+lemma image_mset_sum:
+  assumes "finite F"
+  shows 
+    "image_mset h (\<Sum>x \<in> F. f x) = (\<Sum>x \<in> F. image_mset h (f x))"
+  using assms
+  by (induction F rule:finite_induct, simp, simp)
+
+lemma decomp_mset: 
+  "(\<Sum>x\<in>set_mset R. replicate_mset (count R x) x) = R"
+  by (rule multiset_eqI, simp add:count_sum count_eq_zero_iff)
+
+lemma factor_mset_count:
+  assumes "a \<in> carrier G" "d \<in> carrier G" "irreducible G d"
+  shows "count (factor_mset G a) (assocs G d) = multiplicity G d a"
+proof -
+  have a: 
+    "count (factor_mset G a) (assocs G d) \<ge> m \<longleftrightarrow> d [^] m divides a"
+    (is "?lhs \<longleftrightarrow> ?rhs") for m
+  proof -
+    have "?lhs \<longleftrightarrow> replicate_mset m (assocs G d) \<subseteq># factor_mset G a"
+      by (simp add:count_le_replicate_mset_subset_eq)
+    also have "... \<longleftrightarrow> factor_mset G (d [^] m) \<subseteq># factor_mset G a"
+      using assms(2,3) by (simp add:factor_mset_pow factor_mset_irred)
+    also have "... \<longleftrightarrow> ?rhs"
+      using assms(1,2) by (subst factor_mset_divides) auto
+    finally show ?thesis by simp
+  qed
+
+  define M where "M = {(m::nat). d [^] m divides a}"
+
+  have M_alt: "M = {m. m \<le> count (factor_mset G a) (assocs G d)}"
+    using a by (simp add:M_def)
+
+  hence "Max M = count (factor_mset G a) (assocs G d)"
+    by (intro Max_eqI, auto)
+  thus ?thesis
+    unfolding multiplicity_def M_def by auto
+qed
+
+lemma multiplicity_ge_iff:
+  assumes "d \<in> carrier G" "irreducible G d" "a \<in> carrier G"
+  shows "multiplicity G d a \<ge> k \<longleftrightarrow> d [^] k divides a" 
+    (is "?lhs \<longleftrightarrow> ?rhs")
+proof -
+  have "?lhs \<longleftrightarrow> count (factor_mset G a) (assocs G d) \<ge> k"
+    using factor_mset_count[OF assms(3,1,2)] by simp
+  also have "... \<longleftrightarrow> replicate_mset k (assocs G d) \<subseteq># factor_mset G a"
+    by (subst count_le_replicate_mset_subset_eq, simp) 
+  also have "... \<longleftrightarrow>
+    repeat_mset k (factor_mset G d) \<subseteq># factor_mset G a" 
+    by (subst factor_mset_irred[OF assms(1,2)], simp)
+  also have "... \<longleftrightarrow> factor_mset G (d [^]\<^bsub>G\<^esub> k) \<subseteq># factor_mset G a" 
+    by (subst factor_mset_pow[OF assms(1)], simp)
+  also have "... \<longleftrightarrow> (d [^] k) divides\<^bsub>G\<^esub> a"
+    using assms(1) factor_mset_divides[OF _ assms(3)] by simp
+  finally show ?thesis by simp
+qed
+
+lemma multiplicity_gt_0_iff:
+  assumes "d \<in> carrier G" "irreducible G d" "a \<in> carrier G"
+  shows "multiplicity G d a > 0 \<longleftrightarrow> d divides a"
+  using multiplicity_ge_iff[OF assms(1,2,3), where k="1"] assms
+  by auto
+
+lemma factor_mset_count_2:
+  assumes "a \<in> carrier G" 
+  assumes "\<And>z. z \<in> carrier G \<Longrightarrow> irreducible G z \<Longrightarrow> y \<noteq> assocs G z"
+  shows "count (factor_mset G a) y = 0"
+  using factor_mset_set [OF assms(1)] assms(2) by (metis count_inI)
+
+lemma factor_mset_choose:
+  assumes "a \<in> carrier G" "set_mset R \<subseteq> carrier G"
+  assumes "image_mset (assocs G) R = factor_mset G a" 
+  shows "a \<sim> (\<Otimes>x\<in>set_mset R. x [^] count R x)" (is "a \<sim> ?rhs")
+proof -
+  have b:"irreducible G x" if a:"x \<in># R" for x
+  proof -
+    have x_carr: "x \<in> carrier G" 
+      using a assms(2) by auto
+    have "assocs G x \<in> assocs G ` set_mset R"
+      using a by simp
+    hence "assocs G x \<in># factor_mset G a"
+      using assms(3) a in_image_mset by metis
+    then obtain z where z_def: 
+      "z \<in> carrier G" "irreducible G z" "assocs G x = assocs G z"
+      using factor_mset_set assms(1) by metis
+    have "z \<sim> x" using z_def(1,3) assocs_eqD x_carr by simp 
+    thus ?thesis using z_def(1,2) x_carr irreducible_cong by simp
+  qed
+
+  have "factor_mset G ?rhs = 
+    (\<Sum>x\<in>set_mset R. factor_mset G (x [^] count R x))"
+    using assms(2) by (subst factor_mset_prod, auto) 
+  also have "... = 
+    (\<Sum>x\<in>set_mset R. repeat_mset (count R x) (factor_mset G x))"
+    using assms(2) by (intro sum.cong, auto simp add:factor_mset_pow)
+  also have "... = (\<Sum>x\<in>set_mset R. 
+    repeat_mset (count R x) (image_mset (assocs G) {#x#}))"
+    using assms(2) b by (intro sum.cong, auto simp add:factor_mset_irred)
+  also have "... = (\<Sum>x\<in>set_mset R. 
+    image_mset (assocs G) (replicate_mset (count R x) x))"
+    by simp
+  also have "... = image_mset (assocs G) 
+    (\<Sum>x\<in>set_mset R. (replicate_mset (count R x) x))"
+    by (simp add: image_mset_sum)
+  also have "... = image_mset (assocs G) R"
+    by (simp add:decomp_mset)
+  also have "... = factor_mset G a"
+    using assms by simp
+  finally have "factor_mset G ?rhs = factor_mset G a" by simp
+  moreover have "(\<Otimes>x\<in>set_mset R. x [^] count R x) \<in> carrier G"
+    using assms(2) by (intro finprod_closed, auto)
+  ultimately show ?thesis 
+    using assms(1) by (subst factor_mset_sim) auto
+qed
+
+lemma divides_iff_mult_mono:
+  assumes "a \<in> carrier G" "b \<in> carrier G" 
+  assumes "canonical_irreducibles G R"
+  assumes "\<And>d. d \<in> R \<Longrightarrow> multiplicity G d a \<le> multiplicity G d b"
+  shows "a divides b"
+proof -
+  have "count (factor_mset G a) d \<le> count (factor_mset G b) d" for d
+  proof (cases "\<exists>y \<in> carrier G. irreducible G y \<and> d = assocs G y")
+    case True
+    then obtain y where y_def: 
+      "irreducible G y" "y \<in> carrier G" "d = assocs G y"
+      by blast
+    then obtain z where z_def: "z \<in> R" "y \<sim> z"
+      using assms(3) unfolding canonical_irreducibles_def by metis
+    have z_more: "irreducible G z" "z \<in> carrier G"
+      using z_def(1) assms(3)
+      unfolding canonical_irreducibles_def by auto
+    have "y \<in> assocs G z" using z_def(2) z_more(2) y_def(2) 
+      by (simp add: closure_ofI2)
+    hence d_def: "d = assocs G z"
+      using y_def(2,3) z_more(2) assocs_repr_independence
+      by blast
+    have "count (factor_mset G a) d = multiplicity G z a"
+      unfolding d_def
+      by (intro factor_mset_count[OF assms(1) z_more(2,1)])
+    also have "... \<le> multiplicity G z b"
+      using assms(4) z_def(1) by simp
+    also have "... = count (factor_mset G b) d"
+      unfolding d_def
+      by (intro factor_mset_count[symmetric, OF assms(2) z_more(2,1)])
+    finally show ?thesis by simp 
+  next
+    case False
+    have "count (factor_mset G a) d = 0" using False
+      by (intro factor_mset_count_2[OF assms(1)], simp)
+    moreover have "count (factor_mset G b) d = 0" using False
+      by (intro factor_mset_count_2[OF assms(2)], simp)
+    ultimately show ?thesis by simp
+  qed
+
+  hence "factor_mset G a \<subseteq># factor_mset G b" 
+    unfolding subseteq_mset_def by simp
+  thus ?thesis using factor_mset_divides assms(1,2) by simp
+qed
+
+lemma count_image_mset_inj:
+  assumes "inj_on f R" "x \<in> R" "set_mset A \<subseteq> R"
+  shows "count (image_mset f A) (f x) = count A x"
+proof (cases "x \<in># A")
+  case True
+  hence "(f y = f x \<and> y \<in># A) = (y = x)" for y 
+    by (meson assms(1) assms(3) inj_onD subsetD)
+  hence "(f -` {f x} \<inter> set_mset A) = {x}" 
+    by (simp add:set_eq_iff)
+  thus ?thesis
+    by (subst count_image_mset, simp)
+next
+  case False
+  hence "x \<notin> set_mset A" by simp
+  hence "f x \<notin> f ` set_mset A" using assms
+    by (simp add: inj_on_image_mem_iff)
+  hence "count (image_mset f A) (f x) = 0" 
+    by (simp add:count_eq_zero_iff)
+  thus ?thesis by (metis count_inI False)
+qed
+
+text \<open>Factorization of an element from a @{locale "factorial_monoid"} using a selection of representatives 
+from each equivalence class formed by @{term "(\<sim>)"}.\<close>
+
+lemma split_factors:
+  assumes "canonical_irreducibles G R"
+  assumes "a \<in> carrier G"
+  shows 
+    "finite {d. d \<in> R \<and> multiplicity G d a > 0}"
+    "a \<sim> (\<Otimes>d\<in>{d. d \<in> R \<and> multiplicity G d a > 0}. 
+          d [^] multiplicity G d a)" (is "a \<sim> ?rhs")
+proof -
+  have r_1: "R \<subseteq> {x. x \<in> carrier G \<and> irreducible G x}" 
+    using assms(1) unfolding canonical_irreducibles_def by simp
+  have r_2: "\<And>x y. x \<in> R \<Longrightarrow> y \<in> R \<Longrightarrow> x \<sim> y \<Longrightarrow> x = y" 
+    using assms(1) unfolding canonical_irreducibles_def by simp
+  
+  have assocs_inj: "inj_on (assocs G) R"
+    using r_1 r_2 assocs_eqD by (intro inj_onI, blast) 
+  
+  define R' where
+    "R' = (\<Sum>d\<in> {d. d \<in> R \<and> multiplicity G d a > 0}.
+    replicate_mset (multiplicity G d a) d)"
+
+  have "count (factor_mset G a) (assocs G x) > 0" 
+    if "x \<in> R" "0 < multiplicity G x a" for x
+    using assms r_1 r_2 that
+    by (subst factor_mset_count[OF assms(2)]) auto
+  hence "assocs G ` {d \<in> R. 0 < multiplicity G d a} 
+    \<subseteq> set_mset (factor_mset G a)"
+    by (intro image_subsetI, simp)
+  hence a:"finite (assocs G ` {d \<in> R. 0 < multiplicity G d a})"
+    using finite_subset by auto
+
+  show "finite {d \<in> R. 0 < multiplicity G d a}" 
+    using assocs_inj inj_on_subset[OF assocs_inj]
+    by (intro finite_imageD[OF a], simp)
+
+  hence count_R': 
+    "count R' d = (if d \<in> R then multiplicity G d a else 0)"
+    for d
+    by (auto simp add:R'_def count_sum) 
+
+  have set_R': "set_mset R' = {d \<in> R. 0 < multiplicity G d a}"
+    unfolding set_mset_def using count_R' by auto
+
+  have "count (image_mset (assocs G) R') x = 
+    count (factor_mset G a) x" for x
+  proof (cases "\<exists>x'. x' \<in> R \<and> x = assocs G x'")
+    case True
+    then obtain x' where x'_def: "x' \<in> R" "x = assocs G x'"
+      by blast
+    have "count (image_mset (assocs G) R') x = count R' x'"
+      using assocs_inj inj_on_subset[OF assocs_inj] x'_def
+      by (subst x'_def(2), subst count_image_mset_inj[OF assocs_inj])
+        (auto simp:set_R') 
+    also have "... = multiplicity G x' a"
+      using count_R' x'_def by simp
+    also have "... = count (factor_mset G a) (assocs G x')"
+      using x'_def(1) r_1
+      by (subst factor_mset_count[OF assms(2)]) auto
+    also have "... = count (factor_mset G a) x"
+      using x'_def(2) by simp
+    finally show ?thesis by simp
+  next
+    case False
+    have a:"x \<noteq> assocs G z" 
+      if a1: "z \<in> carrier G" and a2: "irreducible G z" for z
+    proof -
+      obtain v where v_def: "v \<in> R" "z \<sim> v"
+        using a1 a2 assms(1)
+        unfolding canonical_irreducibles_def by auto
+      hence "z \<in> assocs G v"
+        using a1 r_1 v_def(1) by (simp add: closure_ofI2)
+      hence "assocs G z = assocs G v"
+        using a1 r_1 v_def(1)  assocs_repr_independence
+        by auto
+      moreover have "x \<noteq> assocs G v"
+        using False v_def(1) by simp
+      ultimately show ?thesis by simp
+    qed
+
+    have "count (image_mset (assocs G) R') x = 0"
+      using False count_R' by (simp add: count_image_mset) auto
+    also have "... = count (factor_mset G a) x"
+      using a
+      by (intro factor_mset_count_2[OF assms(2), symmetric]) auto 
+    finally show ?thesis by simp
+  qed
+
+  hence "image_mset (assocs G) R' = factor_mset G a"
+    by (rule multiset_eqI)
+
+  moreover have "set_mset R' \<subseteq> carrier G" 
+    using r_1 by (auto simp add:set_R') 
+  ultimately have "a \<sim> (\<Otimes>x\<in>set_mset R'. x [^] count R' x)"
+    using assms(2) by (intro factor_mset_choose, auto)
+  also have "... = ?rhs"
+    using set_R' assms r_1 r_2
+    by (intro finprod_cong', auto simp add:count_R')
+  finally show "a \<sim> ?rhs" by simp
+qed
+
+end
+
+end
\ No newline at end of file
diff --git a/thys/Finite_Fields/Finite_Fields_Isomorphic.thy b/thys/Finite_Fields/Finite_Fields_Isomorphic.thy
new file mode 100644
--- /dev/null
+++ b/thys/Finite_Fields/Finite_Fields_Isomorphic.thy
@@ -0,0 +1,367 @@
+section \<open>Isomorphism between Finite Fields\label{sec:uniqueness}\<close>
+
+theory Finite_Fields_Isomorphic
+  imports
+    Card_Irreducible_Polynomials
+begin
+
+lemma (in finite_field) eval_on_root_is_iso:
+  defines "p \<equiv> char R"
+  assumes "f \<in> carrier (poly_ring (ZFact p))" 
+  assumes "pirreducible\<^bsub>(ZFact p)\<^esub> (carrier (ZFact p)) f" 
+  assumes "order R = p^degree f"
+  assumes "x \<in> carrier R" 
+  assumes "eval (map (char_iso R) f) x = \<zero>"
+  shows "ring_hom_ring (Rupt\<^bsub>(ZFact p)\<^esub> (carrier (ZFact p)) f) R 
+    (\<lambda>g. the_elem ((\<lambda>g'. eval (map (char_iso R) g') x) ` g))"
+proof -
+  let ?P = "poly_ring (ZFact p)"
+
+  have char_pos: "char R > 0"
+    using finite_carr_imp_char_ge_0[OF finite_carrier] by simp
+
+  have p_prime: "Factorial_Ring.prime p" 
+    unfolding p_def 
+    using characteristic_is_prime[OF char_pos] by simp
+
+  interpret zf: finite_field "ZFact p"
+    using zfact_prime_is_finite_field p_prime by simp
+  interpret pzf: principal_domain "poly_ring (ZFact p)"
+    using zf.univ_poly_is_principal[OF zf.carrier_is_subfield] by simp
+
+  interpret i: ideal "(PIdl\<^bsub>?P\<^esub> f)" "?P" 
+    by (intro pzf.cgenideal_ideal assms(2))
+  have rupt_carr: "y \<subseteq> carrier (poly_ring (ZFact p))"
+    if "y \<in> carrier (Rupt\<^bsub>ZFact p\<^esub> (carrier (ZFact p)) f)" for y
+    using that pzf.quot_carr i.ideal_axioms by (simp add:rupture_def)
+
+  have rupt_is_ring: "ring (Rupt\<^bsub>ZFact p\<^esub> (carrier (ZFact p)) f)"
+    unfolding rupture_def by (intro i.quotient_is_ring)
+
+  have "map (char_iso R) \<in> 
+    ring_iso ?P (poly_ring (R\<lparr>carrier := char_subring R\<rparr>))"
+    using lift_iso_to_poly_ring[OF char_iso] zf.domain_axioms 
+    using char_ring_is_subdomain subdomain_is_domain
+    by (simp add:p_def)
+  moreover have "(char_subring R)[X] = 
+    poly_ring (R \<lparr>carrier := char_subring R\<rparr>)"
+    using univ_poly_consistent[OF char_ring_is_subring] by simp
+  ultimately have 
+    "map (char_iso R) \<in> ring_hom ?P ((char_subring R)[X])"
+    by (simp add:ring_iso_def)
+  moreover have "(\<lambda>p. eval p x) \<in> ring_hom ((char_subring R)[X]) R"
+    using eval_is_hom char_ring_is_subring assms(5) by simp
+  ultimately have 
+    "(\<lambda>p. eval p x) \<circ> map (char_iso R) \<in> ring_hom ?P R"
+    using ring_hom_trans by blast
+  hence a:"(\<lambda>p. eval (map (char_iso R) p) x) \<in> ring_hom ?P R"
+    by (simp add:comp_def)
+  interpret h:ring_hom_ring "?P" "R" "(\<lambda>p. eval (map (char_iso R) p) x)"
+    by (intro ring_hom_ringI2 pzf.is_ring a ring_axioms)
+
+  let ?h = "(\<lambda>p. eval (map (char_iso R) p) x)"
+  let ?J = "a_kernel (poly_ring (ZFact (int p))) R ?h"
+
+  have "?h ` a_kernel (poly_ring (ZFact (int p))) R ?h \<subseteq> {\<zero>}"
+    by auto
+  moreover have 
+    "\<zero>\<^bsub>?P\<^esub> \<in> a_kernel (poly_ring (ZFact (int p))) R ?h" 
+    "?h \<zero>\<^bsub>?P\<^esub> = \<zero>" 
+    unfolding a_kernel_def' by simp_all
+  hence "{\<zero>} \<subseteq> ?h ` a_kernel (poly_ring (ZFact (int p))) R ?h"
+    by simp
+  ultimately have c:
+    "?h ` a_kernel (poly_ring (ZFact (int p))) R ?h = {\<zero>}"
+    by auto
+
+  have d: "PIdl\<^bsub>?P\<^esub> f \<subseteq> a_kernel ?P R ?h"
+  proof (rule subsetI) 
+    fix y assume "y \<in> PIdl\<^bsub>?P\<^esub> f"
+    then obtain y' where y'_def: "y' \<in> carrier ?P" "y = y' \<otimes>\<^bsub>?P\<^esub> f" 
+      unfolding cgenideal_def by auto
+    have "?h y = ?h (y' \<otimes>\<^bsub>?P\<^esub> f)" by (simp add:y'_def)
+    also have "... = ?h y' \<otimes> ?h f"
+      using y'_def assms(2) by simp
+    also have "... = ?h y' \<otimes> \<zero>"
+      using assms(6) by simp
+    also have "... = \<zero>"
+      using y'_def by simp
+    finally have "?h y = \<zero>" by simp
+    moreover have "y \<in> carrier ?P" using y'_def assms(2) by simp
+    ultimately show "y \<in> a_kernel ?P R ?h"
+      unfolding a_kernel_def kernel_def by simp
+  qed
+
+  have "(\<lambda>y. the_elem ((\<lambda>p. eval (map (char_iso R) p) x) ` y)) 
+    \<in> ring_hom (?P Quot ?J) R"
+    using h.the_elem_hom by simp
+  moreover have "(\<lambda>y. ?J <+>\<^bsub>?P\<^esub> y) 
+    \<in> ring_hom (Rupt\<^bsub>(ZFact p)\<^esub> (carrier (ZFact p)) f) (?P Quot ?J)"
+    unfolding rupture_def using h.kernel_is_ideal d assms(2)
+    by (intro pzf.quot_quot_hom pzf.cgenideal_ideal) auto
+  ultimately have "(\<lambda>y. the_elem (?h ` y)) \<circ> (\<lambda>y. ?J <+>\<^bsub>?P\<^esub> y)
+    \<in> ring_hom (Rupt\<^bsub>(ZFact p)\<^esub> (carrier (ZFact p)) f) R"
+    using ring_hom_trans by blast
+  hence b: "(\<lambda>y. the_elem (?h ` (?J <+>\<^bsub>?P\<^esub> y))) \<in> 
+    ring_hom (Rupt\<^bsub>(ZFact p)\<^esub> (carrier (ZFact p)) f) R"
+    by (simp add:comp_def)
+  have "?h ` y = ?h ` (?J <+>\<^bsub>?P\<^esub> y)"
+    if "y \<in> carrier (Rupt\<^bsub>ZFact p\<^esub> (carrier (ZFact p)) f)"
+    for y
+  proof -
+    have y_range: "y \<subseteq> carrier ?P"
+      using rupt_carr that by simp
+    have "?h ` y = {\<zero>} <+>\<^bsub>R\<^esub> ?h ` y"
+      using y_range h.hom_closed by (subst set_add_zero, auto)
+    also have "... = ?h ` ?J <+>\<^bsub>R\<^esub> ?h ` y"
+      by (subst c, simp)
+    also have "... = ?h ` (?J <+>\<^bsub>?P\<^esub> y)"
+      by (subst set_add_hom[OF a _ y_range], subst a_kernel_def') auto
+    finally show ?thesis by simp
+  qed
+  hence "(\<lambda>y. the_elem (?h ` y)) \<in> 
+    ring_hom (Rupt\<^bsub>(ZFact p)\<^esub> (carrier (ZFact p)) f) R"
+    by (intro ring_hom_cong[OF _ rupt_is_ring b]) simp
+  thus ?thesis
+    by (intro ring_hom_ringI2 rupt_is_ring ring_axioms, simp)
+qed
+
+lemma (in domain) pdivides_consistent:
+  assumes "subfield K R" "f \<in> carrier (K[X])" "g \<in> carrier (K[X])"
+  shows "f pdivides g \<longleftrightarrow> f pdivides\<^bsub>R \<lparr> carrier := K \<rparr>\<^esub> g"
+proof -
+  have a:"subring K R" 
+    using assms(1) subfieldE(1) by auto
+  let ?S = "R \<lparr> carrier := K \<rparr>"
+  have "f pdivides g \<longleftrightarrow> f divides\<^bsub>K[X]\<^esub> g"
+    using pdivides_iff_shell[OF assms] by simp
+  also have "... \<longleftrightarrow> (\<exists>x \<in> carrier (K[X]). f \<otimes>\<^bsub>K[X]\<^esub> x = g)"
+    unfolding pdivides_def factor_def by auto
+  also have "... \<longleftrightarrow> 
+    (\<exists>x \<in> carrier (poly_ring ?S). f \<otimes>\<^bsub>poly_ring ?S\<^esub> x = g)"
+    using univ_poly_consistent[OF a] by simp
+  also have "... \<longleftrightarrow> f divides\<^bsub>poly_ring ?S\<^esub> g"
+    unfolding pdivides_def factor_def by auto
+  also have "... \<longleftrightarrow> f pdivides\<^bsub>?S\<^esub> g"
+    unfolding pdivides_def by simp
+  finally show ?thesis by simp
+qed
+
+lemma (in finite_field) find_root:
+  assumes "subfield K R"
+  assumes "monic_irreducible_poly (R \<lparr> carrier := K \<rparr>) f"
+  assumes "order R = card K^degree f"
+  obtains x where "eval f x = \<zero>" "x \<in> carrier R"
+proof -
+  define \<tau> :: "'a list \<Rightarrow> 'a list" where "\<tau> = id"
+  let ?K = "R \<lparr> carrier := K \<rparr>"
+  have "finite K" 
+    using assms(1) by (intro finite_subset[OF _ finite_carrier], simp)
+  hence fin_K: "finite (carrier (?K))" 
+    by simp 
+  interpret f: finite_field "?K"
+    using assms(1) subfield_iff fin_K finite_fieldI by blast
+  have b:"subring K R" 
+    using assms(1) subfieldE(1) by blast
+  interpret e: ring_hom_ring "(K[X])" "(poly_ring R)" "\<tau>"
+    using embed_hom[OF b] by (simp add:\<tau>_def)
+
+  have a: "card K^degree f > 1"
+    using assms(3) finite_field_min_order by simp
+  have "f \<in> carrier (poly_ring ?K)"
+    using f.monic_poly_carr assms(2)
+    unfolding monic_irreducible_poly_def by simp
+  hence f_carr_2: "f \<in> carrier (K[X])"
+    using univ_poly_consistent[OF b] by simp
+  have f_carr: "f \<in> carrier (poly_ring R)"
+    using e.hom_closed[OF f_carr_2] unfolding \<tau>_def by simp
+
+  have gp_carr: "gauss_poly ?K (order ?K^degree f) \<in> carrier (K[X])"
+    using f.gauss_poly_carr univ_poly_consistent[OF b] by simp
+
+  have "gauss_poly ?K (order ?K^degree f) = 
+    gauss_poly ?K (card K^degree f)"
+    by (simp add:Coset.order_def)
+  also have "... = 
+    X\<^bsub>?K\<^esub> [^]\<^bsub>poly_ring ?K\<^esub> card K ^ degree f \<ominus>\<^bsub>poly_ring ?K\<^esub> X\<^bsub>?K\<^esub>"
+    unfolding gauss_poly_def by simp
+  also have "... = X\<^bsub>R\<^esub> [^]\<^bsub>K[X]\<^esub> card K ^ degree f  \<ominus>\<^bsub>K[X]\<^esub> X\<^bsub>R\<^esub>"
+    unfolding var_def using univ_poly_consistent[OF b] by simp
+  also have "... = \<tau> (X\<^bsub>R\<^esub> [^]\<^bsub>K[X]\<^esub> card K ^ degree f  \<ominus>\<^bsub>K[X]\<^esub> X\<^bsub>R\<^esub>)"
+    unfolding \<tau>_def by simp
+  also have "... = gauss_poly R (card K^degree f)"
+    unfolding gauss_poly_def a_minus_def using var_closed[OF b]
+    by (simp add:e.hom_nat_pow, simp add:\<tau>_def)
+  finally have gp_consistent: "gauss_poly ?K (order ?K^degree f) = 
+    gauss_poly R (card K^degree f)"
+    by simp
+
+  have deg_f: "degree f > 0" 
+    using f.monic_poly_min_degree[OF assms(2)] by simp
+
+  have "splitted f"
+  proof (cases "degree f > 1")
+    case True
+  
+    have "f pdivides\<^bsub>?K\<^esub> gauss_poly ?K (order ?K^degree f)"
+      using f.div_gauss_poly_iff[OF deg_f assms(2)] by simp
+    hence "f pdivides gauss_poly ?K (order ?K^degree f)"
+      using pdivides_consistent[OF assms(1)] f_carr_2 gp_carr by simp
+    hence "f pdivides gauss_poly R (card K^degree f)"
+      using gp_consistent by simp
+    moreover have "splitted (gauss_poly R (card K^degree f))" 
+      unfolding assms(3)[symmetric] using gauss_poly_splitted by simp
+    moreover have "gauss_poly R (card K^degree f) \<noteq> []" 
+      using gauss_poly_not_zero a by (simp add: univ_poly_zero)
+    ultimately show "splitted f"
+      using pdivides_imp_splitted f_carr gauss_poly_carr by auto
+  next
+    case False
+    hence "degree f = 1" using deg_f by simp
+    thus ?thesis using f_carr degree_one_imp_splitted by auto
+  qed
+  hence "size (roots f) > 0"
+    using deg_f unfolding splitted_def by simp
+  then obtain x where x_def: "x \<in> carrier R" "is_root f x"
+    using roots_mem_iff_is_root[OF f_carr]
+    by (metis f_carr nonempty_has_size not_empty_rootsE)
+  have "eval f x = \<zero>"
+    using x_def is_root_def by blast
+  thus ?thesis using x_def using that by simp
+qed
+
+lemma (in finite_field) find_iso_from_zfact:
+  defines "p \<equiv> int (char R)"
+  assumes "monic_irreducible_poly (ZFact p) f"
+  assumes "order R = char R^degree f"
+  shows "\<exists>\<phi>. \<phi> \<in> ring_iso (Rupt\<^bsub>(ZFact p)\<^esub> (carrier (ZFact p)) f) R"
+proof -
+  have char_pos: "char R > 0"
+    using finite_carr_imp_char_ge_0[OF finite_carrier] by simp
+
+  interpret zf: finite_field "ZFact p"
+    unfolding p_def using zfact_prime_is_finite_field 
+    using characteristic_is_prime[OF char_pos] by simp
+
+  interpret zfp: polynomial_ring "ZFact p" "carrier (ZFact p)"
+    unfolding polynomial_ring_def polynomial_ring_axioms_def
+    using zf.field_axioms zf.carrier_is_subfield by simp
+
+  let ?f' = "map (char_iso R) f" 
+  let ?F = "Rupt\<^bsub>(ZFact p)\<^esub> (carrier (ZFact p)) f"
+
+  have "domain (R\<lparr>carrier := char_subring R\<rparr>)"
+    using char_ring_is_subdomain subdomain_is_domain by simp 
+
+  hence "monic_irreducible_poly (R \<lparr> carrier := char_subring R \<rparr>) ?f'" 
+    using char_iso p_def zf.domain_axioms
+    by (intro monic_irreducible_poly_hom[OF assms(2)]) auto
+  moreover have "order R = card (char_subring R)^degree ?f'"
+    using assms(3) unfolding char_def by simp
+  ultimately obtain x where x_def: "eval ?f' x = \<zero>" "x \<in> carrier R"
+    using find_root[OF char_ring_is_subfield[OF char_pos]] by blast
+  let ?\<phi> = "(\<lambda>g. the_elem ((\<lambda>g'. eval (map (char_iso R) g') x) ` g))"
+  interpret r: ring_hom_ring "?F" "R" "?\<phi>"
+    using assms(2,3)
+    unfolding monic_irreducible_poly_def monic_poly_def p_def
+    by (intro eval_on_root_is_iso x_def, auto) 
+  have a:"?\<phi> \<in> ring_hom ?F R" 
+    using r.homh by auto
+
+  have "field (Rupt\<^bsub>ZFact p\<^esub> (carrier (ZFact p)) f)"
+    using assms(2)
+    unfolding monic_irreducible_poly_def monic_poly_def
+    by (subst zfp.rupture_is_field_iff_pirreducible, simp_all) 
+  hence b:"inj_on ?\<phi> (carrier ?F)"
+    using non_trivial_field_hom_is_inj[OF a _ field_axioms] by simp
+
+  have "card (?\<phi> ` carrier ?F) = order ?F"
+    using card_image[OF b] unfolding Coset.order_def by simp
+  also have "... =  card (carrier (ZFact p))^degree f"
+    using assms(2) zf.monic_poly_min_degree[OF assms(2)]
+    unfolding monic_irreducible_poly_def monic_poly_def
+    by (intro zf.rupture_order[OF zf.carrier_is_subfield]) auto
+  also have "... = char R ^degree f"
+    unfolding p_def by (subst card_zfact_carr[OF char_pos], simp)
+  also have "... = card (carrier R)"
+    using assms(3) unfolding Coset.order_def by simp  
+  finally have "card (?\<phi> ` carrier ?F) = card (carrier R)" by simp
+  moreover have "?\<phi> ` carrier ?F \<subseteq> carrier R"
+    by (intro image_subsetI, simp)
+  ultimately have "?\<phi> ` carrier ?F = carrier R"
+    by (intro card_seteq finite_carrier, auto) 
+  hence "bij_betw ?\<phi> (carrier ?F) (carrier R)"
+    using b bij_betw_imageI by auto
+
+  thus ?thesis
+    unfolding ring_iso_def using a b by auto
+qed
+
+theorem uniqueness:
+  assumes "finite_field F\<^sub>1"
+  assumes "finite_field F\<^sub>2"
+  assumes "order F\<^sub>1 = order F\<^sub>2"
+  shows "F\<^sub>1 \<simeq> F\<^sub>2"
+proof -
+  obtain n where o1: "order F\<^sub>1 = char F\<^sub>1^n" "n > 0"
+    using finite_field.finite_field_order[OF assms(1)] by auto
+  obtain m where o2: "order F\<^sub>2 = char F\<^sub>2^m" "m > 0"
+    using finite_field.finite_field_order[OF assms(2)] by auto
+
+  interpret f1: "finite_field" F\<^sub>1 using assms(1) by simp 
+  interpret f2: "finite_field" F\<^sub>2 using assms(2) by simp 
+
+  have char_pos: "char F\<^sub>1 > 0" "char F\<^sub>2 > 0"
+    using f1.finite_carrier f1.finite_carr_imp_char_ge_0 
+    using f2.finite_carrier f2.finite_carr_imp_char_ge_0 by auto
+  hence char_prime: 
+    "Factorial_Ring.prime (char F\<^sub>1)" 
+    "Factorial_Ring.prime (char F\<^sub>2)"
+    using f1.characteristic_is_prime f2.characteristic_is_prime
+    by auto
+
+  have "char F\<^sub>1^n = char F\<^sub>2^m" 
+    using o1 o2 assms(3) by simp
+  hence eq: "n = m" "char F\<^sub>1 = char F\<^sub>2"
+    using char_prime char_pos o1(2) o2(2) prime_power_inj' by auto
+
+  obtain p where p_def: "p = char F\<^sub>1" "p = char F\<^sub>2" 
+    using eq by simp
+
+  have p_prime: "Factorial_Ring.prime p" 
+    unfolding p_def(1)
+    using f1.characteristic_is_prime char_pos by simp
+
+  interpret zf: finite_field "ZFact (int p)"
+    using zfact_prime_is_finite_field p_prime o1(2) 
+    using prime_nat_int_transfer by blast
+
+  interpret zfp: polynomial_ring "ZFact p" "carrier (ZFact p)"
+    unfolding polynomial_ring_def polynomial_ring_axioms_def
+    using zf.field_axioms zf.carrier_is_subfield by simp
+
+  obtain f where f_def: 
+    "monic_irreducible_poly (ZFact (int p)) f" "degree f = n"
+    using zf.exist_irred o1(2) by auto
+
+  let ?F\<^sub>0  = "Rupt\<^bsub>(ZFact p)\<^esub> (carrier (ZFact p)) f" 
+
+  obtain \<phi>\<^sub>1 where \<phi>\<^sub>1_def: "\<phi>\<^sub>1 \<in> ring_iso ?F\<^sub>0 F\<^sub>1"
+    using f1.find_iso_from_zfact f_def o1
+    unfolding p_def by auto
+
+  obtain \<phi>\<^sub>2 where \<phi>\<^sub>2_def: "\<phi>\<^sub>2 \<in> ring_iso ?F\<^sub>0 F\<^sub>2"
+    using f2.find_iso_from_zfact f_def o2
+    unfolding p_def(2) eq(1) by auto
+
+  have "?F\<^sub>0 \<simeq> F\<^sub>1" using \<phi>\<^sub>1_def is_ring_iso_def by auto
+  moreover have "?F\<^sub>0 \<simeq> F\<^sub>2" using \<phi>\<^sub>2_def is_ring_iso_def by auto
+  moreover have "field ?F\<^sub>0" 
+    using f_def(1) zf.monic_poly_carr monic_irreducible_poly_def
+    by (subst zfp.rupture_is_field_iff_pirreducible) auto
+  hence "ring ?F\<^sub>0" using field.is_ring by auto
+  ultimately show ?thesis 
+    using ring_iso_trans ring_iso_sym by blast
+qed
+
+end
diff --git a/thys/Finite_Fields/Finite_Fields_Preliminary_Results.thy b/thys/Finite_Fields/Finite_Fields_Preliminary_Results.thy
new file mode 100644
--- /dev/null
+++ b/thys/Finite_Fields/Finite_Fields_Preliminary_Results.thy
@@ -0,0 +1,1010 @@
+section \<open>Introduction\<close>
+
+text \<open>The following section starts with preliminary results. Section~\ref{sec:ring_char} introduces
+the characteristic of rings with the Frobenius endomorphism. Whenever it makes sense,
+the definitions and facts do not assume the finiteness of the fields or rings. For example the
+characteristic is defined over arbitrary rings (and also fields). 
+
+While formal derivatives do exist for type-class based structures in
+\verb|HOL-Computational_Algebra|, as far as I can tell, they do not exist for the structure based
+polynomials in \verb|HOL-Algebra|. These are introduced in Section~\ref{sec:pderiv}.
+
+A cornerstone of the proof is the derivation of Gauss' formula for the number of monic irreducible
+polynomials over a finite field $R$ in Section~\ref{sec:card_irred}. The proof follows the
+derivation by Ireland and Rosen~\cite[\textsection 7]{ireland1982} closely, with the caveat that it
+does not assume that $R$ is a simple prime field, but that it is just a finite field.
+This works by adjusting a proof step with the information that the order of a finite field must be 
+of the form $p^n$, where $p$ is the characteristic of the field, derived in Section~\ref{sec:ring_char}.
+The final step relies on the M\"obius inversion theorem formalized by
+Eberl~\cite{Dirichlet_Series-AFP}.\footnote{Thanks to Katharina Kreuzer for discovering that
+formalization.}
+
+With Gauss' formula it is possible to show the existence of the finite fields of order $p^n$ 
+where $p$ is a prime and $n > 0$. During the proof the fact that the polynomial $X^n - X$ splits
+in a field of order $n$ is also derived, which is necessary for the uniqueness result as well.
+
+The uniqueness proof is inspired by the derivation of the same result in
+Lidl and Niederreiter~\cite{lidl1986}, but because of the already derived existence proof for 
+irreducible polynomials, it was possible to reduce its complexity.
+
+The classification consists of three theorems:
+\begin{itemize}
+\item \emph{Existence}: For each prime power $p^n$ there exists a finite field of that size. 
+  This is shown at the conclusion of Section~\ref{sec:card_irred}.
+\item \emph{Uniqueness}: Any two finite fields of the same size are isomorphic. 
+  This is shown at the conclusion of Section~\ref{sec:uniqueness}.
+\item \emph{Completeness}: Any finite fields' size must be a prime power. 
+  This is shown at the conclusion of Section~\ref{sec:ring_char}.
+\end{itemize}
+\<close>
+
+section \<open>Preliminary Results\<close>
+
+theory Finite_Fields_Preliminary_Results
+  imports "HOL-Algebra.Polynomial_Divisibility"
+begin
+
+subsection \<open>Summation in the discrete topology\<close>
+
+text \<open>The following lemmas transfer the corresponding result from the summation over finite sets
+to summation over functions which vanish outside of a finite set.\<close>
+
+lemma sum'_subtractf_nat:
+  fixes f :: "'a \<Rightarrow> nat"
+  assumes "finite {i \<in> A. f i \<noteq> 0}"
+  assumes "\<And>i. i \<in> A \<Longrightarrow> g i \<le> f i"
+  shows "sum' (\<lambda>i. f i - g i) A = sum' f A - sum' g A"
+    (is "?lhs = ?rhs")
+proof -
+  have c:"finite {i \<in> A. g i \<noteq> 0}"
+    using assms(2)
+    by (intro finite_subset[OF _ assms(1)] subsetI, force) 
+  let ?B = "{i \<in> A. f i \<noteq> 0 \<or> g i \<noteq> 0}"
+
+  have b:"?B = {i \<in> A. f i \<noteq> 0} \<union> {i \<in> A. g i \<noteq> 0}"
+    by (auto simp add:set_eq_iff)
+  have a:"finite ?B"
+    using assms(1) c by (subst b, simp)
+  have "?lhs = sum' (\<lambda>i. f i - g i) ?B"
+    by (intro sum.mono_neutral_cong_right', simp_all)
+  also have "... = sum (\<lambda>i. f i - g i) ?B"
+    by (intro sum.eq_sum a) 
+  also have "... = sum f ?B - sum g ?B"
+    using assms(2) by (subst sum_subtractf_nat, auto)
+  also have "... = sum' f ?B - sum' g ?B"
+    by (intro arg_cong2[where f="(-)"] sum.eq_sum[symmetric] a)
+  also have "... = ?rhs"
+    by (intro arg_cong2[where f="(-)"] sum.mono_neutral_cong_left')
+      simp_all
+  finally show ?thesis
+    by simp
+qed
+
+lemma sum'_nat_eq_0_iff:
+  fixes f :: "'a \<Rightarrow> nat"
+  assumes "finite {i \<in> A. f i \<noteq> 0}"
+  assumes "sum' f A = 0"
+  shows "\<And>i. i \<in> A \<Longrightarrow> f i = 0"
+proof -
+  let ?B = "{i \<in> A. f i \<noteq> 0}"
+
+  have "sum f ?B = sum' f ?B"
+    by (intro sum.eq_sum[symmetric] assms(1))
+  also have "... = sum' f A"
+    by (intro sum.non_neutral')
+  also have "... = 0" using assms(2) by simp
+  finally have a:"sum f ?B = 0" by simp
+  have "\<And>i. i \<in> ?B \<Longrightarrow> f i = 0"
+    using sum_nonneg_0[OF assms(1) _ a] by blast
+  thus "\<And>i. i \<in> A \<Longrightarrow> f i = 0"
+    by blast
+qed
+
+lemma sum'_eq_iff:
+  fixes f :: "'a \<Rightarrow> nat"
+  assumes "finite {i \<in> A. f i \<noteq> 0}"
+  assumes "\<And>i. i \<in> A \<Longrightarrow> f i \<ge> g i"
+  assumes "sum' f A \<le> sum' g A"
+  shows "\<forall>i \<in> A. f i = g i"
+proof -
+  have "{i \<in> A. g i \<noteq> 0} \<subseteq> {i \<in> A. f i \<noteq> 0}"
+    using assms(2) order_less_le_trans 
+    by (intro subsetI, auto) 
+  hence a:"finite {i \<in> A. g i \<noteq> 0}"
+    by (rule finite_subset, intro assms(1))
+  have " {i \<in> A. f i - g i \<noteq> 0} \<subseteq> {i \<in> A. f i \<noteq> 0}" 
+    by (intro subsetI, simp_all)
+  hence b: "finite {i \<in> A. f i - g i \<noteq> 0}" 
+    by (rule finite_subset, intro assms(1))
+  have "sum' (\<lambda>i. f i - g i) A = sum' f A - sum' g A"
+    using assms(1,2) a by (subst sum'_subtractf_nat, auto) 
+  also have "... = 0"
+    using assms(3) by simp
+  finally have "sum' (\<lambda>i. f i - g i) A = 0" by simp
+  hence "\<And>i. i \<in> A \<Longrightarrow> f i - g i = 0"
+    using sum'_nat_eq_0_iff[OF b] by simp
+  thus ?thesis
+    using assms(2) diff_is_0_eq' diffs0_imp_equal by blast
+qed
+
+subsection \<open>Polynomials\<close>
+
+text \<open>The embedding of the constant polynomials into the polynomials is injective:\<close>
+
+lemma (in ring) poly_of_const_inj:
+  "inj poly_of_const"
+proof -
+  have "coeff (poly_of_const x) 0 = x" for x 
+    unfolding poly_of_const_def normalize_coeff[symmetric]
+    by simp
+  thus ?thesis by (metis injI)
+qed
+
+lemma (in domain) embed_hom:
+  assumes "subring K R"
+  shows "ring_hom_ring (K[X]) (poly_ring R) id"
+proof (rule ring_hom_ringI)
+  show "ring (K[X])"
+    using univ_poly_is_ring[OF assms(1)] by simp
+  show "ring (poly_ring R)"
+    using univ_poly_is_ring[OF carrier_is_subring] by simp
+  have "K \<subseteq> carrier R" 
+    using subringE(1)[OF assms(1)] by simp
+  thus "\<And>x. x \<in> carrier (K [X]) \<Longrightarrow> id x \<in> carrier (poly_ring R)"
+    unfolding univ_poly_carrier[symmetric] polynomial_def by auto
+  show "id (x \<otimes>\<^bsub>K [X]\<^esub> y) = id x \<otimes>\<^bsub>poly_ring R\<^esub> id y" 
+    if "x \<in> carrier (K [X])" "y \<in> carrier (K [X])" for x y
+    unfolding univ_poly_mult by simp
+  show "id (x \<oplus>\<^bsub>K [X]\<^esub> y) = id x \<oplus>\<^bsub>poly_ring R\<^esub> id y"
+    if "x \<in> carrier (K [X])" "y \<in> carrier (K [X])" for x y
+    unfolding univ_poly_add by simp
+  show "id \<one>\<^bsub>K [X]\<^esub> = \<one>\<^bsub>poly_ring R\<^esub>"
+    unfolding univ_poly_one by simp
+qed
+
+text \<open>The following are versions of the properties of the degrees of polynomials, that abstract
+over the definition of the polynomial ring structure. In the theories
+@{theory "HOL-Algebra.Polynomials"} and also @{theory "HOL-Algebra.Polynomial_Divisibility"}
+these abstract version are usually indicated with the suffix ``shell'', consider for example:
+@{thm [source] "domain.pdivides_iff_shell"}.\<close>
+
+lemma (in ring) degree_add_distinct:
+  assumes "subring K R" 
+  assumes "f \<in> carrier (K[X]) - {\<zero>\<^bsub>K[X]\<^esub>}"
+  assumes "g \<in> carrier (K[X]) - {\<zero>\<^bsub>K[X]\<^esub>}"
+  assumes "degree f \<noteq> degree g"
+  shows "degree (f \<oplus>\<^bsub>K[X]\<^esub> g) = max (degree f) (degree g)"
+  unfolding univ_poly_add using assms(2,3,4) 
+  by (subst poly_add_degree_eq[OF assms(1)])
+    (auto simp:univ_poly_carrier univ_poly_zero)
+
+lemma (in domain) degree_mult:
+  assumes "subring K R" 
+  assumes "f \<in> carrier (K[X]) - {\<zero>\<^bsub>K[X]\<^esub>}"
+  assumes "g \<in> carrier (K[X]) - {\<zero>\<^bsub>K[X]\<^esub>}"
+  shows "degree (f \<otimes>\<^bsub>K[X]\<^esub> g) = degree f + degree g"
+  unfolding univ_poly_mult using assms(2,3) 
+  by (subst poly_mult_degree_eq[OF assms(1)])
+    (auto simp:univ_poly_carrier univ_poly_zero)
+
+lemma (in ring) degree_one:
+  "degree (\<one>\<^bsub>K[X]\<^esub>) = 0"
+  unfolding univ_poly_one by simp
+
+lemma (in domain) pow_non_zero: 
+  "x \<in> carrier R \<Longrightarrow> x \<noteq> \<zero> \<Longrightarrow> x [^] (n :: nat) \<noteq> \<zero>"
+  using integral by (induction n, auto) 
+
+lemma (in domain) degree_pow:
+  assumes "subring K R" 
+  assumes "f \<in> carrier (K[X]) - {\<zero>\<^bsub>K[X]\<^esub>}"
+  shows "degree (f [^]\<^bsub>K[X]\<^esub> n) = degree f * n"
+proof -
+  interpret p:domain "K[X]"
+    using univ_poly_is_domain[OF assms(1)] by simp
+
+  show ?thesis
+  proof (induction n)
+    case 0
+    then show ?case by (simp add:univ_poly_one)
+  next
+    case (Suc n)
+    have "degree (f [^]\<^bsub>K [X]\<^esub> Suc n) = degree (f [^]\<^bsub>K [X]\<^esub> n \<otimes>\<^bsub>K[X]\<^esub> f)"
+      by simp
+    also have "... = degree (f [^]\<^bsub>K [X]\<^esub> n) + degree f"
+      using p.pow_non_zero assms(2)
+      by (subst degree_mult[OF assms(1)], auto)
+    also have "... = degree f * Suc n"
+      by (subst Suc, simp)
+    finally show ?case by simp
+  qed
+qed
+
+lemma (in ring) degree_var:
+  "degree (X\<^bsub>R\<^esub>) = 1"
+  unfolding var_def by simp
+
+lemma (in domain) var_carr:
+  fixes n :: nat
+  assumes "subring K R"
+  shows "X\<^bsub>R\<^esub> \<in> carrier (K[X]) - {\<zero>\<^bsub>K [X]\<^esub>}"
+proof -
+  have "X\<^bsub>R\<^esub> \<in> carrier (K[X])" 
+    using var_closed[OF assms(1)] by simp
+  moreover have "X \<noteq> \<zero>\<^bsub>K [X]\<^esub>"
+    unfolding var_def univ_poly_zero by simp
+  ultimately show ?thesis by simp
+qed
+
+lemma (in domain) var_pow_carr:
+  fixes n :: nat
+  assumes "subring K R"
+  shows "X\<^bsub>R\<^esub> [^]\<^bsub>K [X]\<^esub> n \<in> carrier (K[X]) - {\<zero>\<^bsub>K [X]\<^esub>}"
+proof -
+  interpret p:domain "K[X]"
+    using univ_poly_is_domain[OF assms(1)] by simp
+
+  have "X\<^bsub>R\<^esub> [^]\<^bsub>K [X]\<^esub> n \<in> carrier (K[X])" 
+    using var_pow_closed[OF assms(1)] by simp
+  moreover have "X \<noteq> \<zero>\<^bsub>K [X]\<^esub>"
+    unfolding var_def univ_poly_zero by simp
+  hence "X\<^bsub>R\<^esub> [^]\<^bsub>K [X]\<^esub> n \<noteq> \<zero>\<^bsub>K [X]\<^esub>"
+    using var_closed(1)[OF assms(1)]
+    by (intro p.pow_non_zero, auto)
+  ultimately show ?thesis by simp
+qed
+
+lemma (in domain) var_pow_degree:
+  fixes n :: nat
+  assumes "subring K R"
+  shows "degree (X\<^bsub>R\<^esub> [^]\<^bsub>K [X]\<^esub> n) = n"
+  using var_carr[OF assms(1)] degree_var
+  by (subst degree_pow[OF assms(1)], auto)
+
+lemma (in domain) finprod_non_zero:
+  assumes "finite A"
+  assumes "f \<in> A \<rightarrow> carrier R - {\<zero>}"
+  shows "(\<Otimes>i \<in> A. f i) \<in> carrier R - {\<zero>}"
+  using assms
+proof (induction A rule:finite_induct)
+  case empty
+  then show ?case by simp
+next
+  case (insert x F)
+  have "finprod R f (insert x F) = f x \<otimes> finprod R f F"
+    using insert by (subst finprod_insert, simp_all add:Pi_def)
+  also have "... \<in> carrier R-{\<zero>}"
+    using integral insert by auto
+  finally show ?case by simp
+qed
+
+lemma (in domain) degree_prod:
+  assumes "finite A"
+  assumes "subring K R" 
+  assumes "f \<in> A \<rightarrow> carrier (K[X]) - {\<zero>\<^bsub>K[X]\<^esub>}"
+  shows "degree (\<Otimes>\<^bsub>K[X]\<^esub>i \<in> A. f i) = (\<Sum>i \<in> A. degree (f i))"
+  using assms
+proof -
+  interpret p:domain "K[X]"
+    using univ_poly_is_domain[OF assms(2)] by simp
+
+  show ?thesis
+    using assms(1,3)
+  proof (induction A rule: finite_induct)
+    case empty
+    then show ?case by (simp add:univ_poly_one)
+  next
+    case (insert x F)
+    have "degree (finprod (K[X]) f (insert x F)) = 
+      degree (f x \<otimes>\<^bsub>K[X]\<^esub> finprod (K[X]) f F)"
+      using insert by (subst p.finprod_insert, auto)
+    also have "... = degree (f x) + degree (finprod (K[X]) f F)"
+      using insert p.finprod_non_zero[OF insert(1)]
+      by (subst degree_mult[OF assms(2)], simp_all) 
+    also have "... = degree (f x) + (\<Sum>i \<in> F. degree (f i))"
+      using insert by (subst insert(3), auto) 
+    also have "... = (\<Sum>i \<in> insert x F. degree (f i))"
+      using insert by simp
+    finally show ?case by simp
+  qed
+qed
+
+lemma (in ring) coeff_add:
+  assumes "subring K R"
+  assumes "f \<in> carrier (K[X])" "g \<in> carrier (K[X])"
+  shows "coeff (f \<oplus>\<^bsub>K[X]\<^esub> g) i = coeff f i \<oplus>\<^bsub>R\<^esub> coeff g i"
+proof -
+  have a:"set f \<subseteq> carrier R"
+    using assms(1,2) univ_poly_carrier 
+    using subringE(1)[OF assms(1)] polynomial_incl
+    by blast
+  have b:"set g \<subseteq> carrier R" 
+    using assms(1,3) univ_poly_carrier
+    using subringE(1)[OF assms(1)] polynomial_incl
+    by blast
+  show ?thesis
+    unfolding univ_poly_add poly_add_coeff[OF a b] by simp
+qed
+
+text \<open>This is a version of geometric sums for commutative rings:\<close>
+
+lemma (in cring) geom:
+  fixes q:: nat
+  assumes [simp]: "a \<in> carrier R"
+  shows "(a \<ominus> \<one>) \<otimes> (\<Oplus>i\<in>{..<q}. a [^] i) = (a [^] q \<ominus> \<one>)"
+    (is "?lhs = ?rhs")
+proof -
+  have [simp]: "a [^] i \<in> carrier R" for i :: nat
+    by (intro nat_pow_closed assms)
+  have [simp]: "\<ominus> \<one> \<otimes> x = \<ominus> x" if "x \<in> carrier R" for x
+    using l_minus l_one one_closed that by presburger
+
+  let ?cterm = "(\<Oplus>i\<in>{1..<q}. a [^] i)"
+
+  have "?lhs = a \<otimes> (\<Oplus>i\<in>{..<q}. a [^] i)  \<ominus> (\<Oplus>i\<in>{..<q}. a [^] i)"
+    unfolding a_minus_def by (subst l_distr, simp_all add:Pi_def)
+  also have "... = (\<Oplus>i\<in>{..<q}. a \<otimes> a [^] i) \<ominus> (\<Oplus>i\<in>{..<q}. a [^] i)"
+    by (subst finsum_rdistr, simp_all add:Pi_def)
+  also have "... = (\<Oplus>i\<in>{..<q}. a [^] (Suc i)) \<ominus> (\<Oplus>i\<in>{..<q}. a [^] i)"
+    by (subst nat_pow_Suc, simp_all add:m_comm)
+  also have "... = (\<Oplus>i\<in>Suc ` {..<q}. a [^] i) \<ominus> (\<Oplus>i\<in>{..<q}. a [^] i)"
+    by (subst finsum_reindex, simp_all)
+  also have "... = 
+    (\<Oplus>i\<in> insert q {1..<q}. a [^] i) \<ominus> 
+    (\<Oplus>i\<in> insert 0 {1..<q}. a [^] i)"
+  proof (cases "q > 0")
+    case True
+    moreover have "Suc ` {..<q} = insert q {Suc 0..<q}" 
+      using True lessThan_atLeast0 by fastforce 
+    moreover have "{..<q} = insert 0 {Suc 0..<q}"
+      using True by (auto simp add:set_eq_iff) 
+    ultimately show ?thesis 
+      by (intro arg_cong2[where f="\<lambda>x y. x \<ominus> y"] finsum_cong)
+        simp_all
+  next
+    case False
+    then show ?thesis by (simp, algebra)
+  qed
+  also have "... = (a [^] q \<oplus> ?cterm) \<ominus> (\<one> \<oplus> ?cterm)"
+    by simp
+  also have "... = a [^] q \<oplus> ?cterm \<oplus> (\<ominus> \<one> \<oplus> \<ominus> ?cterm)"
+    unfolding a_minus_def by (subst minus_add, simp_all)
+  also have "... = a [^] q \<oplus> (?cterm \<oplus> (\<ominus> \<one> \<oplus> \<ominus> ?cterm))"
+    by (subst a_assoc, simp_all)
+  also have "... = a [^] q \<oplus> (?cterm \<oplus> (\<ominus> ?cterm \<oplus> \<ominus> \<one>))"
+    by (subst a_comm[where x="\<ominus> \<one>"], simp_all)
+  also have "... = a [^] q \<oplus> ((?cterm \<oplus> (\<ominus> ?cterm)) \<oplus> \<ominus> \<one>)"
+    by (subst a_assoc, simp_all)
+  also have "... = a [^] q \<oplus> (\<zero> \<oplus> \<ominus> \<one>)"
+    by (subst r_neg, simp_all)
+  also have "... = a [^] q \<ominus> \<one>" 
+    unfolding a_minus_def by simp
+  finally show ?thesis by simp
+qed
+
+lemma (in domain) rupture_eq_0_iff:
+  assumes "subfield K R" "p \<in> carrier (K[X])" "q \<in> carrier (K[X])"
+  shows "rupture_surj K p q = \<zero>\<^bsub>Rupt K p\<^esub> \<longleftrightarrow> p pdivides q"
+    (is "?lhs \<longleftrightarrow> ?rhs")
+proof -
+  interpret h:ring_hom_ring "K[X]" "(Rupt K p)" "(rupture_surj K p)"
+    using assms subfieldE by (intro rupture_surj_hom) auto
+
+  have a: "q pmod p \<in> (\<lambda>q. q pmod p) ` carrier (K [X])" 
+    using assms(3) by simp
+  have "\<zero>\<^bsub>K[X]\<^esub> = \<zero>\<^bsub>K[X]\<^esub> pmod p" 
+    using assms(1,2) long_division_zero(2)
+    by (simp add:univ_poly_zero)
+  hence b: "\<zero>\<^bsub>K[X]\<^esub> \<in> (\<lambda>q. q pmod p) ` carrier (K[X])" 
+    by (simp add:image_iff) auto
+
+  have "?lhs \<longleftrightarrow> rupture_surj K p (q pmod p) = 
+    rupture_surj K p (\<zero>\<^bsub>K[X]\<^esub>)" 
+    by (subst rupture_surj_composed_with_pmod[OF assms]) simp
+  also have "... \<longleftrightarrow> q pmod p = \<zero>\<^bsub>K[X]\<^esub>"
+    using assms(3)
+    by (intro inj_on_eq_iff[OF rupture_surj_inj_on[OF assms(1,2)]] a b)
+  also have "... \<longleftrightarrow> ?rhs"
+    unfolding univ_poly_zero
+    by (intro pmod_zero_iff_pdivides[OF assms(1)] assms(2,3))
+  finally show "?thesis" by simp
+qed
+
+subsection \<open>Ring Isomorphisms\<close>
+
+text \<open>The following lemma shows that an isomorphism between domains also induces an isomorphism
+between the corresponding polynomial rings.\<close>
+
+lemma lift_iso_to_poly_ring:
+  assumes "h \<in> ring_iso R S" "domain R" "domain S"
+  shows "map h \<in> ring_iso (poly_ring R) (poly_ring S)"
+proof (rule ring_iso_memI)
+  interpret dr: domain "R" using assms(2) by blast
+  interpret ds: domain "S" using assms(3) by blast
+  interpret pdr: domain "poly_ring R"
+    using dr.univ_poly_is_domain[OF dr.carrier_is_subring] by simp
+  interpret pds: domain "poly_ring S"
+    using ds.univ_poly_is_domain[OF ds.carrier_is_subring] by simp
+  interpret h: ring_hom_ring "R" "S" h
+    using dr.is_ring ds.is_ring assms(1)
+    by (intro ring_hom_ringI2, simp_all add:ring_iso_def)
+  let ?R = "poly_ring R"
+  let ?S = "poly_ring S"
+
+  have h_img: "h ` (carrier R) = carrier S" 
+    using assms(1) unfolding ring_iso_def bij_betw_def by auto
+  have h_inj: "inj_on h (carrier R)" 
+    using assms(1) unfolding ring_iso_def bij_betw_def by auto
+  hence h_non_zero_iff:  "h x \<noteq> \<zero>\<^bsub>S\<^esub>"
+    if "x \<noteq> \<zero>\<^bsub>R\<^esub>" "x \<in> carrier R" for x
+    using h.hom_zero dr.zero_closed inj_onD that by metis
+
+  have norm_elim: "ds.normalize (map h x) = map h x" 
+    if "x \<in> carrier (poly_ring R)" for x 
+  proof (cases "x")
+    case Nil then show ?thesis by simp
+  next
+    case (Cons xh xt)
+    have "xh \<in> carrier R" "xh \<noteq> \<zero>\<^bsub>R\<^esub>"
+      using that unfolding Cons univ_poly_carrier[symmetric] 
+      unfolding polynomial_def by auto
+    hence "h xh \<noteq> \<zero>\<^bsub>S\<^esub>" using h_non_zero_iff by simp
+    then show ?thesis unfolding Cons by simp
+  qed
+
+  show t_1: "map h x \<in> carrier ?S" 
+    if "x \<in> carrier ?R" for x
+    using that hd_in_set h_non_zero_iff hd_map
+    unfolding univ_poly_carrier[symmetric] polynomial_def 
+    by (cases x, auto)
+
+  show "map h (x \<otimes>\<^bsub>?R\<^esub> y) = map h x \<otimes>\<^bsub>?S\<^esub> map h y" 
+    if "x \<in> carrier ?R" "y \<in> carrier ?R" for x y
+  proof -
+    have "map h (x \<otimes>\<^bsub>?R\<^esub> y) = ds.normalize (map h (x \<otimes>\<^bsub>?R\<^esub> y))"
+      using that by (intro norm_elim[symmetric],simp) 
+    also have "... = map h x \<otimes>\<^bsub>?S\<^esub> map h y"
+      using that unfolding univ_poly_mult univ_poly_carrier[symmetric] 
+      unfolding polynomial_def
+      by (intro h.poly_mult_hom'[of x y] , auto)
+    finally show ?thesis by simp
+  qed
+
+  show "map h (x \<oplus>\<^bsub>?R\<^esub> y) = map h x \<oplus>\<^bsub>?S\<^esub> map h y"
+    if "x \<in> carrier ?R" "y \<in> carrier ?R" for x y
+  proof -
+    have "map h (x \<oplus>\<^bsub>?R\<^esub> y) = ds.normalize (map h (x \<oplus>\<^bsub>?R\<^esub> y))"
+      using that by (intro norm_elim[symmetric],simp) 
+    also have "... = map h x \<oplus>\<^bsub>?S\<^esub> map h y"
+      using that
+      unfolding univ_poly_add univ_poly_carrier[symmetric] 
+      unfolding polynomial_def
+      by (intro h.poly_add_hom'[of x y], auto)
+    finally show ?thesis by simp
+  qed
+
+  show "map h \<one>\<^bsub>?R\<^esub> = \<one>\<^bsub>?S\<^esub>" 
+    unfolding univ_poly_one by simp
+
+  let ?hinv = "map (the_inv_into (carrier R) h)"
+
+  have "map h \<in> carrier ?R \<rightarrow> carrier ?S" 
+    using t_1 by simp
+  moreover have "?hinv x \<in> carrier ?R" 
+    if "x \<in> carrier ?S" for x
+  proof (cases "x = []")
+    case True
+    then show ?thesis 
+      by (simp add:univ_poly_carrier[symmetric] polynomial_def)
+  next
+    case False
+    have set_x: "set x \<subseteq> h ` carrier R" 
+      using that h_img unfolding univ_poly_carrier[symmetric]
+      unfolding polynomial_def by auto
+    have "lead_coeff x \<noteq> \<zero>\<^bsub>S\<^esub>" "lead_coeff x \<in> carrier S"
+      using that False unfolding univ_poly_carrier[symmetric]
+      unfolding polynomial_def by auto
+    hence "the_inv_into (carrier R) h (lead_coeff x) \<noteq> 
+      the_inv_into (carrier R) h \<zero>\<^bsub>S\<^esub>" 
+      using inj_on_the_inv_into[OF h_inj] inj_onD 
+      using ds.zero_closed h_img by metis
+    hence "the_inv_into (carrier R) h (lead_coeff x) \<noteq> \<zero>\<^bsub>R\<^esub>" 
+      unfolding h.hom_zero[symmetric] 
+      unfolding the_inv_into_f_f[OF h_inj dr.zero_closed] by simp
+    hence "lead_coeff (?hinv x) \<noteq> \<zero>\<^bsub>R\<^esub>" 
+      using False by (simp add:hd_map)
+    moreover have "the_inv_into (carrier R) h ` set x \<subseteq> carrier R" 
+      using the_inv_into_into[OF h_inj] set_x
+      by (intro image_subsetI) auto
+    hence "set (?hinv x) \<subseteq> carrier R" by simp 
+    ultimately show ?thesis
+      by (simp add:univ_poly_carrier[symmetric] polynomial_def)
+  qed
+  moreover have "?hinv (map h x) = x" if "x \<in> carrier ?R" for x 
+  proof -
+    have set_x: "set x \<subseteq> carrier R" 
+      using that unfolding univ_poly_carrier[symmetric]
+      unfolding polynomial_def by auto
+    have "?hinv (map h x) = 
+      map (\<lambda>y. the_inv_into (carrier R) h (h y)) x"
+      by simp
+    also have "... = map id x"
+      using set_x by (intro map_cong)
+        (auto simp add:the_inv_into_f_f[OF h_inj])
+    also have "... = x" by simp
+    finally show ?thesis by simp
+  qed
+  moreover have "map h (?hinv x) = x" 
+    if "x \<in> carrier ?S" for x
+  proof -
+    have set_x: "set x \<subseteq> h ` carrier R" 
+      using that h_img unfolding univ_poly_carrier[symmetric]
+      unfolding polynomial_def by auto
+    have "map h (?hinv x) = 
+      map (\<lambda>y. h (the_inv_into (carrier R) h y)) x"
+      by simp
+    also have "... = map id x"
+      using set_x by (intro map_cong)
+        (auto simp add:f_the_inv_into_f[OF h_inj])
+    also have "... = x" by simp
+    finally show ?thesis by simp
+  qed
+  ultimately show "bij_betw (map h) (carrier ?R) (carrier ?S)" 
+    by (intro bij_betwI[where g="?hinv"], auto) 
+qed
+
+lemma carrier_hom:
+  assumes "f \<in> carrier (poly_ring R)"
+  assumes "h \<in> ring_iso R S" "domain R" "domain S"
+  shows "map h f \<in> carrier (poly_ring S)"
+proof -
+  note poly_iso = lift_iso_to_poly_ring[OF assms(2,3,4)] 
+  show ?thesis
+    using ring_iso_memE(1)[OF poly_iso assms(1)] by simp
+qed
+
+lemma carrier_hom':
+  assumes "f \<in> carrier (poly_ring R)"
+  assumes "h \<in> ring_hom R S"
+  assumes "domain R" "domain S" 
+  assumes "inj_on h (carrier R)"
+  shows "map h f \<in> carrier (poly_ring S)"
+proof -
+  let ?S = "S \<lparr> carrier := h ` carrier R \<rparr>"
+
+  interpret dr: domain "R" using assms(3) by blast
+  interpret ds: domain "S" using assms(4) by blast
+  interpret h1: ring_hom_ring R S h
+    using assms(2) ring_hom_ringI2 dr.ring_axioms 
+    using ds.ring_axioms by blast 
+  have subr: "subring (h ` carrier R) S" 
+    using h1.img_is_subring[OF dr.carrier_is_subring] by blast
+  interpret h: ring_hom_ring "((h ` carrier R)[X]\<^bsub>S\<^esub>)" "poly_ring S" "id"
+    using ds.embed_hom[OF subr] by simp
+
+  let ?S = "S \<lparr> carrier := h ` carrier R \<rparr>"
+  have "h \<in> ring_hom R ?S"
+    using assms(2) unfolding ring_hom_def by simp
+  moreover have "bij_betw h (carrier R) (carrier ?S)"
+    using assms(5) bij_betw_def by auto
+  ultimately have h_iso: "h \<in> ring_iso R ?S"
+    unfolding ring_iso_def by simp
+
+  have dom_S: "domain ?S" 
+    using ds.subring_is_domain[OF subr] by simp
+
+  note poly_iso = lift_iso_to_poly_ring[OF h_iso assms(3) dom_S]
+  have "map h f \<in> carrier (poly_ring ?S)"
+    using ring_iso_memE(1)[OF poly_iso assms(1)] by simp
+  also have "carrier (poly_ring ?S) = 
+    carrier (univ_poly S (h ` carrier R))"
+    using ds.univ_poly_consistent[OF subr] by simp
+  also have "... \<subseteq> carrier (poly_ring S)"
+    using h.hom_closed by auto
+  finally show ?thesis by simp
+qed
+
+text \<open>The following lemmas transfer properties like divisibility, irreducibility etc. between
+ring isomorphisms.\<close>
+
+lemma divides_hom:
+  assumes "h \<in> ring_iso R S" 
+  assumes "domain R" "domain S" 
+  assumes "x \<in> carrier R" "y \<in> carrier R"
+  shows "x divides\<^bsub>R\<^esub> y \<longleftrightarrow> (h x) divides\<^bsub>S\<^esub> (h y)"  (is "?lhs \<longleftrightarrow> ?rhs")
+proof -
+  interpret dr: domain "R" using assms(2) by blast
+  interpret ds: domain "S" using assms(3) by blast
+  interpret pdr: domain "poly_ring R"
+    using dr.univ_poly_is_domain[OF dr.carrier_is_subring] by simp
+  interpret pds: domain "poly_ring S"
+    using ds.univ_poly_is_domain[OF ds.carrier_is_subring] by simp
+  interpret h: ring_hom_ring "R" "S" h
+    using dr.is_ring ds.is_ring assms(1)
+    by (intro ring_hom_ringI2, simp_all add:ring_iso_def)
+
+  have h_inj_on: "inj_on h (carrier R)" 
+    using assms(1) unfolding ring_iso_def bij_betw_def by auto
+  have h_img: "h ` (carrier R) = carrier S" 
+    using assms(1) unfolding ring_iso_def bij_betw_def by auto
+
+  have "?lhs \<longleftrightarrow> (\<exists>c \<in> carrier R. y = x \<otimes>\<^bsub>R\<^esub> c)"
+    unfolding factor_def by simp
+  also have "... \<longleftrightarrow> (\<exists>c \<in> carrier R. h y = h x \<otimes>\<^bsub>S\<^esub> h c)"
+    using assms(4,5) inj_onD[OF h_inj_on]
+    by (intro bex_cong, auto simp flip:h.hom_mult) 
+  also have "... \<longleftrightarrow> (\<exists>c \<in> carrier S. h y = h x  \<otimes>\<^bsub>S\<^esub> c)"
+    unfolding h_img[symmetric] by simp
+  also have "... \<longleftrightarrow> ?rhs" 
+    unfolding factor_def by simp
+  finally show ?thesis by simp
+qed
+
+lemma properfactor_hom:
+  assumes "h \<in> ring_iso R S" 
+  assumes "domain R" "domain S" 
+  assumes "x \<in> carrier R" "b \<in> carrier R"
+  shows "properfactor R b x \<longleftrightarrow> properfactor S (h b) (h x)" 
+  using divides_hom[OF assms(1,2,3)] assms(4,5)
+  unfolding properfactor_def by simp
+
+lemma Units_hom:
+  assumes "h \<in> ring_iso R S" 
+  assumes "domain R" "domain S" 
+  assumes "x \<in> carrier R"
+  shows "x \<in> Units R \<longleftrightarrow>  h x \<in> Units S"
+proof -
+
+  interpret dr: domain "R" using assms(2) by blast
+  interpret ds: domain "S" using assms(3) by blast
+  interpret pdr: domain "poly_ring R"
+    using dr.univ_poly_is_domain[OF dr.carrier_is_subring] by simp
+  interpret pds: domain "poly_ring S"
+    using ds.univ_poly_is_domain[OF ds.carrier_is_subring] by simp
+  interpret h: ring_hom_ring "R" "S" h
+    using dr.is_ring ds.is_ring assms(1)
+    by (intro ring_hom_ringI2, simp_all add:ring_iso_def)
+
+  have h_img: "h ` (carrier R) = carrier S" 
+    using assms(1) unfolding ring_iso_def bij_betw_def by auto
+
+  have h_inj_on: "inj_on h (carrier R)" 
+    using assms(1) unfolding ring_iso_def bij_betw_def by auto
+
+  hence h_one_iff: "h x = \<one>\<^bsub>S\<^esub> \<longleftrightarrow> x = \<one>\<^bsub>R\<^esub>" if "x \<in> carrier R" for x
+    using h.hom_one that by (metis dr.one_closed inj_onD)
+
+  have "x \<in> Units R \<longleftrightarrow> 
+    (\<exists>y\<in>carrier R. x \<otimes>\<^bsub>R\<^esub> y = \<one>\<^bsub>R\<^esub> \<and> y \<otimes>\<^bsub>R\<^esub> x = \<one>\<^bsub>R\<^esub>)"
+    using assms unfolding Units_def by auto
+  also have "... \<longleftrightarrow> 
+    (\<exists>y\<in>carrier R. h x \<otimes>\<^bsub>S\<^esub> h y = h \<one>\<^bsub>R\<^esub> \<and> h y \<otimes>\<^bsub>S\<^esub> h x = h \<one>\<^bsub>R\<^esub>)"
+    using h_one_iff assms by (intro bex_cong, simp_all flip:h.hom_mult)
+  also have "... \<longleftrightarrow> 
+    (\<exists>y\<in>carrier S. h x \<otimes>\<^bsub>S\<^esub> y = h \<one>\<^bsub>R\<^esub> \<and> y \<otimes>\<^bsub>S\<^esub> h x = \<one>\<^bsub>S\<^esub>)"
+    unfolding h_img[symmetric] by simp
+  also have "... \<longleftrightarrow> h x \<in> Units S"
+    using assms h.hom_closed unfolding Units_def by auto
+  finally show ?thesis by simp
+qed
+
+lemma irreducible_hom:
+  assumes "h \<in> ring_iso R S" 
+  assumes "domain R" "domain S" 
+  assumes "x \<in> carrier R"
+  shows "irreducible R x = irreducible S (h x)"
+proof -
+  have h_img: "h ` (carrier R) = carrier S" 
+    using assms(1) unfolding ring_iso_def bij_betw_def by auto
+
+  have "irreducible R x \<longleftrightarrow> (x \<notin> Units R \<and> 
+    (\<forall>b\<in>carrier R. properfactor R b x \<longrightarrow> b \<in> Units R))"
+    unfolding Divisibility.irreducible_def by simp
+  also have "... \<longleftrightarrow> (x \<notin> Units R \<and> 
+    (\<forall>b\<in>carrier R. properfactor S (h b) (h x) \<longrightarrow> b \<in> Units R))"
+    using properfactor_hom[OF assms(1,2,3)] assms(4) by simp
+  also have "... \<longleftrightarrow> (h x \<notin> Units S \<and> 
+    (\<forall>b\<in>carrier R. properfactor S (h b) (h x) \<longrightarrow> h b \<in> Units S))"
+    using assms(4) Units_hom[OF assms(1,2,3)] by simp
+  also have "...\<longleftrightarrow> (h x \<notin> Units S \<and> 
+    (\<forall>b\<in>h ` carrier R. properfactor S b (h x) \<longrightarrow> b \<in> Units S))"
+    by simp
+  also have "... \<longleftrightarrow> irreducible S (h x)"
+    unfolding h_img Divisibility.irreducible_def by simp
+  finally show ?thesis by simp
+qed
+
+lemma pirreducible_hom:
+  assumes "h \<in> ring_iso R S" 
+  assumes "domain R" "domain S"
+  assumes "f \<in> carrier (poly_ring R)"
+  shows "pirreducible\<^bsub>R\<^esub> (carrier R) f = 
+    pirreducible\<^bsub>S\<^esub> (carrier S) (map h f)" 
+    (is "?lhs = ?rhs")
+proof -
+  note lift_iso = lift_iso_to_poly_ring[OF assms(1,2,3)]
+  interpret dr: domain "R" using assms(2) by blast
+  interpret ds: domain "S" using assms(3) by blast
+  interpret pdr: domain "poly_ring R"
+    using dr.univ_poly_is_domain[OF dr.carrier_is_subring] by simp
+  interpret pds: domain "poly_ring S"
+    using ds.univ_poly_is_domain[OF ds.carrier_is_subring] by simp
+
+  have mh_inj_on: "inj_on (map h) (carrier (poly_ring R))" 
+    using lift_iso unfolding ring_iso_def bij_betw_def by auto
+  moreover have "map h \<zero>\<^bsub>poly_ring R\<^esub> = \<zero>\<^bsub>poly_ring S\<^esub>"
+    by (simp add:univ_poly_zero)
+  ultimately have mh_zero_iff: 
+    "map h f = \<zero>\<^bsub>poly_ring S\<^esub> \<longleftrightarrow> f = \<zero>\<^bsub>poly_ring R\<^esub>"
+    using assms(4) by (metis pdr.zero_closed inj_onD)
+
+  have "?lhs \<longleftrightarrow> (f \<noteq> \<zero>\<^bsub>poly_ring R\<^esub> \<and> irreducible (poly_ring R) f)"
+    unfolding ring_irreducible_def by simp
+  also have "... \<longleftrightarrow> 
+    (f \<noteq> \<zero>\<^bsub>poly_ring R\<^esub> \<and> irreducible (poly_ring S) (map h f))"
+    using irreducible_hom[OF lift_iso] pdr.domain_axioms
+    using assms(4) pds.domain_axioms by simp
+  also have "... \<longleftrightarrow> 
+    (map h f \<noteq> \<zero>\<^bsub>poly_ring S\<^esub> \<and> irreducible (poly_ring S) (map h f))"
+    using mh_zero_iff by simp
+  also have "... \<longleftrightarrow> ?rhs"
+    unfolding ring_irreducible_def by simp
+  finally show ?thesis by simp
+qed
+
+
+lemma ring_hom_cong:
+  assumes "\<And>x. x \<in> carrier R \<Longrightarrow> f' x = f x" 
+  assumes "ring R"
+  assumes "f \<in> ring_hom R S"
+  shows "f' \<in> ring_hom R S"
+proof -
+  interpret ring "R" using assms(2) by simp
+  show ?thesis 
+    using assms(1) ring_hom_memE[OF assms(3)]
+    by (intro ring_hom_memI, auto) 
+qed
+
+text \<open>The natural homomorphism between factor rings, where one ideal is a subset of the other.\<close>
+
+lemma (in ring) quot_quot_hom: 
+  assumes "ideal I R"
+  assumes "ideal J R"
+  assumes "I \<subseteq> J"
+  shows "(\<lambda>x. (J <+>\<^bsub>R\<^esub> x)) \<in> ring_hom (R Quot I) (R Quot J)"  
+proof (rule ring_hom_memI)
+  interpret ji: ideal J R
+    using assms(2) by simp
+  interpret ii: ideal I R
+    using assms(1) by simp
+
+  have a:"J <+>\<^bsub>R\<^esub> I = J"
+    using assms(3) unfolding set_add_def set_mult_def by auto
+
+  show "J <+>\<^bsub>R\<^esub> x \<in> carrier (R Quot J)"
+    if "x \<in> carrier (R Quot I)" for x
+  proof -
+    have " \<exists>y\<in>carrier R. x = I +> y" 
+      using that unfolding FactRing_def A_RCOSETS_def' by simp
+    then obtain y where y_def: "y \<in> carrier R" "x = I +> y"
+      by auto
+    have "J <+>\<^bsub>R\<^esub> (I +> y) = (J <+>\<^bsub>R\<^esub> I) +> y"
+      using y_def(1) by (subst a_setmult_rcos_assoc) auto
+    also have "... = J +> y" using a by simp
+    finally have "J <+>\<^bsub>R\<^esub> (I +> y) = J +> y" by simp
+    thus ?thesis
+      using y_def unfolding FactRing_def A_RCOSETS_def' by auto 
+  qed
+
+  show "J <+>\<^bsub>R\<^esub> x \<otimes>\<^bsub>R Quot I\<^esub> y = 
+    (J <+>\<^bsub>R\<^esub> x) \<otimes>\<^bsub>R Quot J\<^esub> (J <+>\<^bsub>R\<^esub> y)"
+    if "x \<in> carrier (R Quot I)" "y \<in> carrier (R Quot I)" 
+    for x y
+  proof -
+    have "\<exists>x1\<in>carrier R. x = I +> x1" "\<exists>y1\<in>carrier R. y = I +> y1" 
+      using that unfolding FactRing_def A_RCOSETS_def' by auto
+    then obtain x1 y1 
+      where x1_def: "x1 \<in> carrier R" "x = I +> x1"
+        and y1_def: "y1 \<in> carrier R" "y = I +> y1"
+      by auto
+    have "J <+>\<^bsub>R\<^esub> x \<otimes>\<^bsub>R Quot I\<^esub> y = J <+>\<^bsub>R\<^esub> (I +> x1 \<otimes> y1)"
+      using x1_def y1_def
+      by (simp add: FactRing_def ii.rcoset_mult_add)
+    also have "... = (J <+>\<^bsub>R\<^esub> I) +> x1 \<otimes> y1"
+      using x1_def(1) y1_def(1)
+      by (subst a_setmult_rcos_assoc) auto
+    also have "... = J +> x1 \<otimes> y1"
+      using a by simp
+    also have "... = [mod J:] (J +> x1) \<Otimes> (J +> y1)" 
+      using x1_def(1) y1_def(1) by (subst ji.rcoset_mult_add, auto)
+    also have "... = 
+      [mod J:] ((J <+>\<^bsub>R\<^esub> I) +> x1) \<Otimes> ((J <+>\<^bsub>R\<^esub> I) +> y1)" 
+      using a by simp
+    also have "... = 
+      [mod J:] (J <+>\<^bsub>R\<^esub> (I +> x1)) \<Otimes> (J <+>\<^bsub>R\<^esub> (I +> y1))"
+      using x1_def(1) y1_def(1)
+      by (subst (1 2) a_setmult_rcos_assoc) auto
+    also have "... = (J <+>\<^bsub>R\<^esub> x) \<otimes>\<^bsub>R Quot J\<^esub> (J <+>\<^bsub>R\<^esub> y)"
+      using x1_def y1_def by (simp add: FactRing_def)
+    finally show ?thesis by simp
+  qed
+
+  show "J <+>\<^bsub>R\<^esub> x \<oplus>\<^bsub>R Quot I\<^esub> y = 
+    (J <+>\<^bsub>R\<^esub> x) \<oplus>\<^bsub>R Quot J\<^esub> (J <+>\<^bsub>R\<^esub> y)"
+    if "x \<in> carrier (R Quot I)" "y \<in> carrier (R Quot I)"
+    for x y
+  proof -
+    have "\<exists>x1\<in>carrier R. x = I +> x1" "\<exists>y1\<in>carrier R. y = I +> y1" 
+      using that unfolding FactRing_def A_RCOSETS_def' by auto
+    then obtain x1 y1 
+      where x1_def: "x1 \<in> carrier R" "x = I +> x1"
+        and y1_def: "y1 \<in> carrier R" "y = I +> y1"
+      by auto
+    have "J <+>\<^bsub>R\<^esub> x \<oplus>\<^bsub>R Quot I\<^esub> y = 
+      J <+>\<^bsub>R\<^esub> ((I +> x1) <+>\<^bsub>R\<^esub> (I +> y1))"
+      using x1_def y1_def by (simp add:FactRing_def)
+    also have "... = J <+>\<^bsub>R\<^esub> (I +> (x1 \<oplus> y1))"
+      using x1_def y1_def ii.a_rcos_sum by simp
+    also have "... = (J <+>\<^bsub>R\<^esub> I) +> (x1 \<oplus> y1)"
+      using x1_def y1_def by (subst a_setmult_rcos_assoc) auto
+    also have "... = J +> (x1 \<oplus> y1)"
+      using a by simp
+    also have "... = 
+      ((J <+>\<^bsub>R\<^esub> I) +> x1) <+>\<^bsub>R\<^esub> ((J <+>\<^bsub>R\<^esub> I) +> y1)"
+      using x1_def y1_def ji.a_rcos_sum a by simp
+    also have "... = 
+      J <+>\<^bsub>R\<^esub> (I +> x1) <+>\<^bsub>R\<^esub> (J <+>\<^bsub>R\<^esub> (I +> y1))" 
+      using x1_def y1_def by (subst (1 2) a_setmult_rcos_assoc) auto
+    also have "... = (J <+>\<^bsub>R\<^esub> x) \<oplus>\<^bsub>R Quot J\<^esub> (J <+>\<^bsub>R\<^esub> y)"
+      using x1_def y1_def by (simp add:FactRing_def)
+    finally show ?thesis by simp
+  qed
+
+  have "J <+>\<^bsub>R\<^esub> \<one>\<^bsub>R Quot I\<^esub> = J <+>\<^bsub>R\<^esub> (I +> \<one>)"
+    unfolding FactRing_def by simp
+  also have "... = (J <+>\<^bsub>R\<^esub> I) +> \<one>" 
+    by (subst a_setmult_rcos_assoc) auto
+  also have "... = J +> \<one>" using a by simp
+  also have "... = \<one>\<^bsub>R Quot J\<^esub>"
+    unfolding FactRing_def by simp
+  finally show "J <+>\<^bsub>R\<^esub> \<one>\<^bsub>R Quot I\<^esub> = \<one>\<^bsub>R Quot J\<^esub>" 
+    by simp
+qed
+
+lemma (in ring) quot_carr:
+  assumes "ideal I R"
+  assumes "y \<in> carrier (R Quot I)"
+  shows "y \<subseteq> carrier R"
+proof -
+  interpret ideal I R using assms(1) by simp
+  have "y \<in> a_rcosets I"
+    using assms(2) unfolding FactRing_def by simp
+  then obtain v where y_def: "y = I +> v" "v \<in> carrier R"
+    unfolding A_RCOSETS_def' by auto
+  have "I +> v \<subseteq> carrier R" 
+    using y_def(2) a_r_coset_subset_G a_subset by presburger
+  thus "y \<subseteq> carrier R" unfolding y_def by simp
+qed
+
+lemma (in ring) set_add_zero:
+  assumes "A \<subseteq> carrier R"
+  shows "{\<zero>} <+>\<^bsub>R\<^esub> A = A"
+proof -
+  have "{\<zero>} <+>\<^bsub>R\<^esub> A = (\<Union>x\<in>A. {\<zero> \<oplus> x})"
+    using assms unfolding set_add_def set_mult_def by simp
+  also have "... = (\<Union>x\<in>A. {x})"
+    using assms by (intro arg_cong[where f="Union"] image_cong, auto)
+  also have "... = A" by simp
+  finally show ?thesis by simp
+qed
+
+text \<open>Adapted from the proof of @{thm [source] domain.polynomial_rupture}\<close>
+
+lemma (in domain) rupture_surj_as_eval:
+  assumes "subring K R" 
+  assumes "p \<in> carrier (K[X])" "q \<in> carrier (K[X])"
+  shows "rupture_surj K p q = 
+    ring.eval (Rupt K p) (map ((rupture_surj K p) \<circ> poly_of_const) q) 
+    (rupture_surj K p X)"
+proof -
+  let ?surj = "rupture_surj K p"
+
+  interpret UP: domain "K[X]"
+    using univ_poly_is_domain[OF assms(1)] .
+  interpret h: ring_hom_ring "K[X]" "Rupt K p" ?surj
+    using rupture_surj_hom(2)[OF assms(1,2)] .
+
+  have "(h.S.eval) (map (?surj \<circ> poly_of_const) q) (?surj X) = 
+    ?surj ((UP.eval) (map poly_of_const q) X)"
+    using h.eval_hom[OF UP.carrier_is_subring var_closed(1)[OF assms(1)]
+          map_norm_in_poly_ring_carrier[OF assms(1,3)]] by simp
+  also have " ... = ?surj q"
+    unfolding sym[OF eval_rewrite[OF assms(1,3)]] ..
+  finally show ?thesis by simp
+qed
+
+subsection \<open>Divisibility\<close>
+
+lemma  (in field) f_comm_group_1:
+  assumes "x \<in> carrier R" "y \<in> carrier R"
+  assumes "x \<noteq> \<zero>" "y \<noteq> \<zero>"
+  assumes "x \<otimes> y = \<zero>"
+  shows "False" 
+  using integral assms by auto
+
+lemma (in field) f_comm_group_2:
+  assumes "x \<in> carrier R"
+  assumes "x \<noteq> \<zero>"
+  shows " \<exists>y\<in>carrier R - {\<zero>}. y \<otimes> x = \<one>"
+proof -
+  have x_unit: "x \<in> Units R" using field_Units assms by simp
+  thus ?thesis unfolding Units_def by auto
+qed
+
+sublocale field < mult_of: comm_group "mult_of R"
+  rewrites "mult (mult_of R) = mult R"
+       and "one  (mult_of R) = one R"
+  using f_comm_group_1 f_comm_group_2
+  by (auto intro!:comm_groupI m_assoc m_comm)
+
+lemma (in domain) div_neg:
+  assumes "a \<in> carrier R" "b \<in> carrier R"
+  assumes "a divides b"
+  shows "a divides (\<ominus> b)"
+proof -
+  obtain r1 where r1_def: "r1 \<in> carrier R" "a \<otimes> r1 = b"
+    using assms by (auto simp:factor_def) 
+
+  have "a \<otimes> (\<ominus> r1) = \<ominus> (a \<otimes> r1)"
+    using assms(1) r1_def(1) by algebra
+  also have "... = \<ominus> b"
+    using r1_def(2) by simp
+  finally have "\<ominus>b = a \<otimes> (\<ominus> r1)" by simp
+  moreover have "\<ominus>r1 \<in> carrier R"
+    using r1_def(1) by simp
+  ultimately show ?thesis
+    by (auto simp:factor_def) 
+qed
+
+lemma (in domain) div_sum:
+  assumes "a \<in> carrier R" "b \<in> carrier R" "c \<in> carrier R"
+  assumes "a divides b"
+  assumes "a divides c"
+  shows "a divides (b \<oplus> c)"
+proof -
+  obtain r1 where r1_def: "r1 \<in> carrier R" "a \<otimes> r1 = b"
+    using assms by (auto simp:factor_def) 
+
+  obtain r2 where r2_def: "r2 \<in> carrier R" "a \<otimes> r2 = c"
+    using assms by (auto simp:factor_def) 
+
+  have "a \<otimes> (r1 \<oplus> r2) = (a \<otimes> r1) \<oplus> (a \<otimes> r2)"
+    using assms(1) r1_def(1) r2_def(1) by algebra
+  also have "... = b \<oplus> c"
+    using r1_def(2) r2_def(2) by simp
+  finally have "b \<oplus> c = a \<otimes> (r1 \<oplus> r2)" by simp
+  moreover have "r1 \<oplus> r2 \<in> carrier R"
+    using r1_def(1) r2_def(1) by simp
+  ultimately show ?thesis
+    by (auto simp:factor_def) 
+qed
+
+lemma (in domain) div_sum_iff:
+  assumes "a \<in> carrier R" "b \<in> carrier R" "c \<in> carrier R"
+  assumes "a divides b"
+  shows "a divides (b \<oplus> c) \<longleftrightarrow> a divides c"
+proof 
+  assume "a divides (b \<oplus> c)"
+  moreover have "a divides (\<ominus> b)"
+    using div_neg assms(1,2,4) by simp
+  ultimately have "a divides ((b \<oplus> c) \<oplus> (\<ominus> b))"
+    using div_sum assms by simp
+  also have "... = c" using assms(1,2,3) by algebra
+  finally show "a divides c" by simp
+next
+  assume "a divides c"
+  thus "a divides (b \<oplus> c)"
+    using assms by (intro div_sum) auto
+qed
+
+end
diff --git a/thys/Finite_Fields/Formal_Polynomial_Derivatives.thy b/thys/Finite_Fields/Formal_Polynomial_Derivatives.thy
new file mode 100644
--- /dev/null
+++ b/thys/Finite_Fields/Formal_Polynomial_Derivatives.thy
@@ -0,0 +1,414 @@
+section \<open>Formal Derivatives\label{sec:pderiv}\<close>
+
+theory Formal_Polynomial_Derivatives
+  imports "HOL-Algebra.Polynomial_Divisibility" "Ring_Characteristic"
+begin
+
+definition pderiv ("pderiv\<index>") where 
+  "pderiv\<^bsub>R\<^esub> x = ring.normalize R (
+    map (\<lambda>i. int_embed R i \<otimes>\<^bsub>R\<^esub> ring.coeff R x i) (rev [1..<length x]))"
+
+context domain
+begin
+
+lemma coeff_range:
+  assumes "subring K R"
+  assumes "f \<in> carrier (K[X])"
+  shows "coeff f i \<in> K"
+proof -
+  have "coeff f i \<in> set f \<union> {\<zero>}"
+    using coeff_img(3) by auto
+  also have "... \<subseteq> K \<union> {\<zero>}"
+    using assms(2) univ_poly_carrier polynomial_incl by blast
+  also have "... \<subseteq> K" 
+    using subringE[OF assms(1)] by simp
+  finally show ?thesis by simp
+qed
+
+lemma pderiv_carr:
+  assumes "subring K R"
+  assumes "f \<in> carrier (K[X])"
+  shows "pderiv f \<in> carrier (K[X])"
+proof -
+  have "int_embed R i \<otimes> coeff f i \<in> K" for i
+    using coeff_range[OF assms] int_embed_range[OF assms(1)] 
+    using subringE[OF assms(1)] by simp
+  hence "polynomial K (pderiv f)"
+    unfolding pderiv_def by (intro normalize_gives_polynomial, auto)
+  thus ?thesis
+    using univ_poly_carrier by auto
+qed
+
+lemma pderiv_coeff:
+  assumes "subring K R"
+  assumes "f \<in> carrier (K[X])"
+  shows "coeff (pderiv f) k = int_embed R (Suc k) \<otimes> coeff f (Suc k)"
+    (is "?lhs = ?rhs")
+proof (cases "k + 1  < length f")
+  case True
+  define j where "j = length f - k - 2"
+  define d where 
+    "d = map (\<lambda>i. int_embed R i \<otimes> coeff f i) (rev [1..<length f])"
+
+  have a: "j+1 < length f"
+    using True unfolding j_def by simp
+  hence b: "j < length [1..<length f]"
+    by simp
+  have c: "k < length d"
+    unfolding d_def using True by simp
+  have d: "degree d - k = j"
+    unfolding d_def j_def by simp
+  have e: "rev [Suc 0..<length f] ! j = length f - 1 - j"
+    using b  by (subst rev_nth, auto)
+  have f: "length f - j - 1 = k+1"
+    unfolding j_def using True by simp
+
+  have "coeff (pderiv f ) k = coeff (normalize d) k"
+    unfolding pderiv_def d_def by simp
+  also have "... = coeff d k"
+    using normalize_coeff by simp
+  also have "... = d ! j"
+    using c d by (subst coeff_nth, auto)
+  also have 
+    "... = int_embed R (length f - j - 1) \<otimes> coeff f (length f - j - 1)"
+    using b e unfolding d_def by simp
+  also have "... = ?rhs"
+    using f by simp
+  finally show ?thesis by simp
+next
+  case False
+  hence "Suc k \<ge> length f"
+    by simp
+  hence a:"coeff f (Suc k) = \<zero>"
+    using coeff_img by blast
+  have b:"coeff (pderiv f) k = \<zero>"
+    unfolding pderiv_def normalize_coeff[symmetric] using False
+    by (intro coeff_length, simp)
+  show ?thesis 
+    using int_embed_range[OF carrier_is_subring] by (simp add:a b) 
+qed
+
+lemma pderiv_const:
+  assumes "degree x = 0"
+  shows "pderiv x = \<zero>\<^bsub>K[X]\<^esub>"
+proof (cases "length x = 0")
+  case True
+  then show ?thesis by (simp add:univ_poly_zero pderiv_def)
+next
+  case False
+  hence "length x = 1" using assms by linarith
+  then obtain y where "x = [y]" by (cases x, auto) 
+  then show ?thesis by (simp add:univ_poly_zero pderiv_def)
+qed
+
+lemma pderiv_var:
+  shows "pderiv X = \<one>\<^bsub>K[X]\<^esub>"
+  unfolding var_def pderiv_def
+  by (simp add:univ_poly_one int_embed_def)
+
+lemma pderiv_zero:
+  shows "pderiv \<zero>\<^bsub>K[X]\<^esub> = \<zero>\<^bsub>K[X]\<^esub>"
+  unfolding pderiv_def univ_poly_zero by simp
+
+lemma pderiv_add:
+  assumes "subring K R"
+  assumes [simp]: "f \<in> carrier (K[X])" "g \<in> carrier (K[X])"
+  shows "pderiv (f \<oplus>\<^bsub>K[X]\<^esub> g) = pderiv f \<oplus>\<^bsub>K[X]\<^esub> pderiv g"
+    (is "?lhs = ?rhs")
+proof -
+  interpret p: ring "(K[X])"
+    using univ_poly_is_ring[OF assms(1)] by simp
+
+  let ?n = "(\<lambda>i. int_embed R i)"
+
+  have a[simp]:"?n k \<in> carrier R" for k
+    using int_embed_range[OF carrier_is_subring] by auto
+  have b[simp]:"coeff f k \<in> carrier R" if "f \<in> carrier (K[X])" for k f
+    using coeff_range[OF assms(1)] that
+    using subringE(1)[OF assms(1)] by auto
+
+  have "coeff ?lhs i = coeff ?rhs i" for i
+  proof -
+    have "coeff ?lhs i = ?n (i+1) \<otimes> coeff (f \<oplus>\<^bsub>K [X]\<^esub> g) (i+1)"
+      by (simp add: pderiv_coeff[OF assms(1)])
+    also have "... = ?n (i+1) \<otimes> (coeff f (i+1) \<oplus> coeff g (i+1))"
+      by (subst coeff_add[OF assms], simp)
+    also have "... = ?n (i+1) \<otimes> coeff f (i+1) 
+      \<oplus> int_embed R (i+1) \<otimes> coeff g (i+1)"
+      by (subst r_distr, simp_all)
+    also have "... = coeff (pderiv f) i \<oplus> coeff (pderiv g) i"
+      by (simp add: pderiv_coeff[OF assms(1)])
+    also have "... = coeff (pderiv f \<oplus>\<^bsub>K [X]\<^esub> pderiv g) i"
+      using pderiv_carr[OF assms(1)] 
+      by (subst coeff_add[OF assms(1)], auto) 
+    finally show ?thesis by simp
+  qed
+  hence "coeff ?lhs = coeff ?rhs" by auto
+  thus "?lhs = ?rhs"
+    using pderiv_carr[OF assms(1)]
+    by (subst coeff_iff_polynomial_cond[where K="K"])
+      (simp_all add:univ_poly_carrier)+
+qed
+
+lemma pderiv_inv:
+  assumes "subring K R"
+  assumes [simp]: "f \<in> carrier (K[X])"
+  shows "pderiv (\<ominus>\<^bsub>K[X]\<^esub> f) = \<ominus>\<^bsub>K[X]\<^esub> pderiv f" (is "?lhs = ?rhs")
+proof -
+  interpret p: cring "(K[X])"
+    using univ_poly_is_cring[OF assms(1)] by simp
+
+  have "pderiv (\<ominus>\<^bsub>K[X]\<^esub> f) = pderiv (\<ominus>\<^bsub>K[X]\<^esub> f) \<oplus>\<^bsub>K[X]\<^esub> \<zero>\<^bsub>K[X]\<^esub>"
+    using pderiv_carr[OF assms(1)]
+    by (subst p.r_zero, simp_all)
+  also have "... = pderiv (\<ominus>\<^bsub>K[X]\<^esub> f) \<oplus>\<^bsub>K[X]\<^esub> (pderiv f \<ominus>\<^bsub>K[X]\<^esub> pderiv f)" 
+    using pderiv_carr[OF assms(1)] by simp
+  also have "... = pderiv (\<ominus>\<^bsub>K[X]\<^esub> f) \<oplus>\<^bsub>K[X]\<^esub> pderiv f \<ominus>\<^bsub>K[X]\<^esub> pderiv f" 
+    using pderiv_carr[OF assms(1)]
+    unfolding a_minus_def by (simp add:p.a_assoc)
+  also have "... = pderiv (\<ominus>\<^bsub>K[X]\<^esub> f \<oplus>\<^bsub>K[X]\<^esub> f) \<ominus>\<^bsub>K[X]\<^esub> pderiv f" 
+    by (subst pderiv_add[OF assms(1)], simp_all)
+  also have "... = pderiv \<zero>\<^bsub>K[X]\<^esub> \<ominus>\<^bsub>K[X]\<^esub> pderiv f"
+    by (subst p.l_neg, simp_all)
+  also have "... = \<zero>\<^bsub>K[X]\<^esub> \<ominus>\<^bsub>K[X]\<^esub> pderiv f"
+    by (subst pderiv_zero, simp)
+  also have "... = \<ominus>\<^bsub>K[X]\<^esub> pderiv f"
+    unfolding a_minus_def using pderiv_carr[OF assms(1)]
+    by (subst p.l_zero, simp_all)
+  finally show "pderiv (\<ominus>\<^bsub>K[X]\<^esub> f) = \<ominus>\<^bsub>K[X]\<^esub> pderiv f"
+    by simp
+qed
+
+
+lemma coeff_mult:
+  assumes "subring K R"
+  assumes "f \<in> carrier (K[X])" "g \<in> carrier (K[X])"
+  shows "coeff (f \<otimes>\<^bsub>K[X]\<^esub> g) i = 
+    (\<Oplus> k \<in> {..i}. (coeff f) k \<otimes> (coeff g) (i - k))"
+proof -
+  have a:"set f \<subseteq> carrier R"
+    using assms(1,2) univ_poly_carrier 
+    using subringE(1)[OF assms(1)] polynomial_incl by blast
+  have b:"set g \<subseteq> carrier R" 
+    using assms(1,3) univ_poly_carrier
+    using subringE(1)[OF assms(1)] polynomial_incl by blast
+  show ?thesis
+    unfolding univ_poly_mult poly_mult_coeff[OF a b] by simp
+qed
+
+lemma pderiv_mult:
+  assumes "subring K R"
+  assumes [simp]: "f \<in> carrier (K[X])" "g \<in> carrier (K[X])"
+  shows "pderiv (f \<otimes>\<^bsub>K[X]\<^esub> g) = 
+    pderiv f \<otimes>\<^bsub>K[X]\<^esub> g \<oplus>\<^bsub>K[X]\<^esub> f \<otimes>\<^bsub>K[X]\<^esub> pderiv g" 
+    (is "?lhs = ?rhs")
+proof -
+  interpret p: cring "(K[X])"
+    using univ_poly_is_cring[OF assms(1)] by simp
+
+  let ?n = "(\<lambda>i. int_embed R i)"
+
+  have a[simp]:"?n k \<in> carrier R" for k 
+    using int_embed_range[OF carrier_is_subring] by auto
+  have b[simp]:"coeff f k \<in> carrier R" if "f \<in> carrier (K[X])" for k f
+    using coeff_range[OF assms(1)] 
+    using subringE(1)[OF assms(1)] that by auto
+
+  have "coeff ?lhs i = coeff ?rhs i" for i
+  proof -
+    have "coeff ?lhs i = ?n (i+1) \<otimes> coeff (f \<otimes>\<^bsub>K [X]\<^esub> g) (i+1)"
+      using assms(2,3) by (simp add: pderiv_coeff[OF assms(1)])
+    also have "... = ?n (i+1) \<otimes> 
+      (\<Oplus>k \<in> {..i+1}. coeff f k \<otimes> (coeff g (i + 1 - k)))"
+      by (subst coeff_mult[OF assms], simp)
+    also have "... = 
+      (\<Oplus>k \<in> {..i+1}. ?n (i+1) \<otimes> (coeff f k \<otimes> coeff g (i + 1 - k)))"
+      by (intro finsum_rdistr, simp_all add:Pi_def) 
+    also have "... = 
+      (\<Oplus>k \<in> {..i+1}. ?n k \<otimes> (coeff f k \<otimes> coeff g (i + 1 - k)) \<oplus>
+      ?n (i+1-k) \<otimes> (coeff f k \<otimes> coeff g (i + 1 - k)))" 
+      using int_embed_add[symmetric] of_nat_diff
+      by (intro finsum_cong') 
+        (simp_all add:l_distr[symmetric] of_nat_diff) 
+    also have "... = 
+      (\<Oplus>k \<in> {..i+1}. ?n k \<otimes> coeff f k \<otimes> coeff g (i + 1 - k) \<oplus>
+      coeff f k \<otimes> (?n (i+1-k) \<otimes> coeff g (i + 1 - k)))" 
+      using Pi_def a b m_assoc m_comm
+      by (intro finsum_cong' arg_cong2[where f="(\<oplus>)"], simp_all)
+    also have "... = 
+      (\<Oplus>k \<in> {..i+1}. ?n k \<otimes> coeff f k \<otimes> coeff g (i+1-k)) \<oplus>
+      (\<Oplus>k \<in> {..i+1}. coeff f k \<otimes> (?n (i+1-k) \<otimes> coeff g (i+1-k)))" 
+      by (subst finsum_addf[symmetric], simp_all add:Pi_def) 
+    also have "... = 
+      (\<Oplus>k\<in>insert 0 {1..i+1}. ?n k \<otimes> coeff f k \<otimes> coeff g (i+1-k)) \<oplus>
+      (\<Oplus>k\<in>insert (i+1) {..i}. coeff f k \<otimes> (?n (i+1-k) \<otimes> coeff g (i+1-k)))" 
+      using subringE(1)[OF assms(1)]
+      by (intro arg_cong2[where f="(\<oplus>)"] finsum_cong')
+        (auto simp:set_eq_iff)
+    also have "... = 
+      (\<Oplus>k \<in> {1..i+1}. ?n k \<otimes> coeff f k \<otimes> coeff g (i+1-k)) \<oplus>
+      (\<Oplus>k \<in> {..i}. coeff f k \<otimes> (?n (i+1-k) \<otimes> coeff g (i+1-k)))" 
+      by (subst (1 2) finsum_insert, auto simp add:int_embed_zero)
+    also have "... = 
+      (\<Oplus>k \<in> Suc ` {..i}. ?n k \<otimes> coeff f (k) \<otimes> coeff g (i+1-k)) \<oplus>
+      (\<Oplus>k \<in> {..i}. coeff f k \<otimes> (?n (i+1-k) \<otimes> coeff g (i+1-k)))" 
+      by (intro arg_cong2[where f="(\<oplus>)"] finsum_cong')
+        (simp_all add:Pi_def atMost_atLeast0)
+    also have "... = 
+      (\<Oplus>k \<in> {..i}. ?n (k+1) \<otimes> coeff f (k+1) \<otimes> coeff g (i-k)) \<oplus>
+      (\<Oplus>k \<in> {..i}. coeff f k \<otimes> (?n (i+1-k) \<otimes> coeff g (i+1-k)))" 
+      by (subst finsum_reindex, auto)
+    also have "... = 
+      (\<Oplus>k \<in> {..i}. coeff (pderiv f) k \<otimes> coeff g (i-k)) \<oplus>
+      (\<Oplus>k \<in> {..i}. coeff f k \<otimes> coeff (pderiv g) (i-k))" 
+      using Suc_diff_le
+      by (subst (1 2) pderiv_coeff[OF assms(1)]) 
+        (auto intro!: finsum_cong')
+    also have "... = 
+      coeff (pderiv f \<otimes>\<^bsub>K[X]\<^esub> g) i \<oplus> coeff (f \<otimes>\<^bsub>K[X]\<^esub> pderiv g) i"
+      using pderiv_carr[OF assms(1)]
+      by (subst (1 2) coeff_mult[OF assms(1)], auto)
+    also have "... = coeff ?rhs i" 
+      using pderiv_carr[OF assms(1)]
+      by (subst coeff_add[OF assms(1)], auto)
+    finally show ?thesis by simp
+  qed
+
+  hence "coeff ?lhs = coeff ?rhs" by auto
+  thus "?lhs = ?rhs"
+    using pderiv_carr[OF assms(1)]
+    by (subst coeff_iff_polynomial_cond[where K="K"])
+     (simp_all add:univ_poly_carrier)
+qed
+
+lemma pderiv_pow:
+  assumes "n > (0 :: nat)"
+  assumes "subring K R"
+  assumes [simp]: "f \<in> carrier (K[X])"
+  shows "pderiv (f [^]\<^bsub>K[X]\<^esub> n) = 
+    int_embed (K[X]) n \<otimes>\<^bsub>K[X]\<^esub> f [^]\<^bsub>K[X]\<^esub> (n-1) \<otimes>\<^bsub>K[X]\<^esub> pderiv f" 
+    (is "?lhs = ?rhs")
+proof -
+  interpret p: cring "(K[X])"
+    using univ_poly_is_cring[OF assms(2)] by simp
+
+  let ?n = "\<lambda>n. int_embed (K[X]) n"
+
+  have [simp]: "?n i \<in> carrier (K[X])" for i 
+    using p.int_embed_range[OF p.carrier_is_subring] by simp
+
+  obtain m where n_def: "n = Suc m" using assms(1) lessE by blast
+  have "pderiv (f [^]\<^bsub>K[X]\<^esub> (m+1)) = 
+    ?n (m+1) \<otimes>\<^bsub>K[X]\<^esub> f [^]\<^bsub>K[X]\<^esub> m \<otimes>\<^bsub>K[X]\<^esub> pderiv f" 
+  proof (induction m)
+    case 0
+    then show ?case 
+      using pderiv_carr[OF assms(2)] assms(3) 
+      using p.int_embed_one by simp
+  next
+    case (Suc m)
+    have "pderiv (f [^]\<^bsub>K [X]\<^esub> (Suc m + 1)) = 
+      pderiv (f [^]\<^bsub>K [X]\<^esub> (m+1) \<otimes>\<^bsub>K[X]\<^esub> f) "
+      by simp
+    also have "... = 
+      pderiv (f [^]\<^bsub>K [X]\<^esub> (m+1)) \<otimes>\<^bsub>K[X]\<^esub> f \<oplus>\<^bsub>K[X]\<^esub> 
+      f [^]\<^bsub>K [X]\<^esub> (m+1) \<otimes>\<^bsub>K[X]\<^esub> pderiv f"
+      using assms(3) by (subst pderiv_mult[OF assms(2)], auto)
+    also have "... = 
+      (?n (m+1) \<otimes>\<^bsub>K [X]\<^esub> f [^]\<^bsub>K [X]\<^esub> m \<otimes>\<^bsub>K [X]\<^esub> pderiv f) \<otimes>\<^bsub>K[X]\<^esub> f 
+      \<oplus>\<^bsub>K[X]\<^esub> f [^]\<^bsub>K [X]\<^esub> (m+1) \<otimes>\<^bsub>K[X]\<^esub> pderiv f"
+      by (subst Suc(1), simp)  
+    also have 
+      "... = ?n (m+1) \<otimes>\<^bsub>K[X]\<^esub> (f [^]\<^bsub>K [X]\<^esub> (m+1) \<otimes>\<^bsub>K[X]\<^esub> pderiv f) 
+      \<oplus>\<^bsub>K[X]\<^esub> \<one>\<^bsub>K [X]\<^esub> \<otimes>\<^bsub>K[X]\<^esub> (f [^]\<^bsub>K [X]\<^esub> (m+1) \<otimes>\<^bsub>K[X]\<^esub> pderiv f)"
+      using assms(3) pderiv_carr[OF assms(2)]
+      apply (intro arg_cong2[where f="(\<oplus>\<^bsub>K[X]\<^esub>)"])
+      apply (simp add:p.m_assoc)
+       apply (simp add:p.m_comm)
+      by simp
+    also have 
+      "... = (?n (m+1) \<oplus>\<^bsub>K[X]\<^esub> \<one>\<^bsub>K [X]\<^esub>) \<otimes>\<^bsub>K [X]\<^esub> 
+      (f [^]\<^bsub>K [X]\<^esub> (m+1) \<otimes>\<^bsub>K [X]\<^esub> pderiv f)"
+      using assms(3) pderiv_carr[OF assms(2)] 
+      by (subst p.l_distr[symmetric], simp_all)
+    also have "... = 
+      (\<one>\<^bsub>K [X]\<^esub> \<oplus>\<^bsub>K[X]\<^esub> ?n (m+1)) \<otimes>\<^bsub>K [X]\<^esub> 
+      (f [^]\<^bsub>K [X]\<^esub> (m+1) \<otimes>\<^bsub>K [X]\<^esub> pderiv f)"
+      using assms(3) pderiv_carr[OF assms(2)]
+      by (subst p.a_comm, simp_all)
+    also have "... = ?n (1+ Suc m) 
+      \<otimes>\<^bsub>K [X]\<^esub> f [^]\<^bsub>K [X]\<^esub> (Suc m) \<otimes>\<^bsub>K [X]\<^esub> pderiv f"
+      using assms(3) pderiv_carr[OF assms(2)] of_nat_add
+      apply (subst (2) of_nat_add, subst p.int_embed_add)
+      by (simp add:p.m_assoc p.int_embed_one) 
+    finally show ?case by simp
+  qed
+  thus "?thesis" using n_def by auto
+qed
+
+lemma pderiv_var_pow:
+  assumes "n > (0::nat)"
+  assumes "subring K R"
+  shows "pderiv (X [^]\<^bsub>K[X]\<^esub> n) = 
+    int_embed (K[X]) n \<otimes>\<^bsub>K[X]\<^esub> X [^]\<^bsub>K[X]\<^esub> (n-1)"
+proof -
+  interpret p: cring "(K[X])"
+    using univ_poly_is_cring[OF assms(2)] by simp
+
+  have [simp]: "int_embed (K[X]) i \<in> carrier (K[X])" for i
+    using p.int_embed_range[OF p.carrier_is_subring] by simp
+
+  show ?thesis
+    using var_closed[OF assms(2)] 
+    using pderiv_var[where K="K"] pderiv_carr[OF assms(2)]
+    by (subst pderiv_pow[OF assms(1,2)], simp_all)
+qed
+
+lemma int_embed_consistent_with_poly_of_const:
+  assumes "subring K R"
+  shows "int_embed (K[X]) m = poly_of_const (int_embed R m)"
+proof -
+  define K' where "K' = R \<lparr> carrier := K \<rparr>"
+  interpret p: cring "(K[X])"
+    using univ_poly_is_cring[OF assms] by simp
+  interpret d: domain "K'"
+    unfolding K'_def
+    using assms(1) subdomainI' subdomain_is_domain by simp
+  interpret h: ring_hom_ring  "K'" "K[X]" "poly_of_const"
+    unfolding K'_def
+    using canonical_embedding_ring_hom[OF assms(1)] by simp
+
+  define n where "n=nat (abs m)"
+
+  have a1: "int_embed (K[X]) (int n) = poly_of_const (int_embed K' n)"
+  proof (induction n)
+    case 0
+    then show ?case by (simp add:d.int_embed_zero p.int_embed_zero)
+  next
+    case (Suc n)
+    then show ?case
+      using d.int_embed_closed d.int_embed_add d.int_embed_one
+      by (simp add:p.int_embed_add p.int_embed_one)
+  qed
+  also have "... = poly_of_const (int_embed R n)"
+    unfolding K'_def using int_embed_consistent[OF assms] by simp
+  finally have a: 
+    "int_embed (K[X]) (int n) = poly_of_const (int_embed R (int n))"
+    by simp
+
+  have "int_embed (K[X]) (-(int n)) = 
+    poly_of_const (int_embed K' (- (int n)))"
+    using d.int_embed_closed a1 by (simp add: p.int_embed_inv d.int_embed_inv)
+  also have "... = poly_of_const (int_embed R (- (int n)))"
+    unfolding K'_def using int_embed_consistent[OF assms] by simp
+  finally have b:
+    "int_embed (K[X]) (-int n) = poly_of_const (int_embed R (-int n))"
+    by simp
+
+  show ?thesis
+    using a b n_def by (cases "m \<ge> 0", simp, simp)
+qed
+
+end
+
+end
diff --git a/thys/Finite_Fields/Monic_Polynomial_Factorization.thy b/thys/Finite_Fields/Monic_Polynomial_Factorization.thy
new file mode 100644
--- /dev/null
+++ b/thys/Finite_Fields/Monic_Polynomial_Factorization.thy
@@ -0,0 +1,658 @@
+section \<open>Factorization into Monic Polynomials\label{sec:monic}\<close>
+
+theory Monic_Polynomial_Factorization
+imports
+  Finite_Fields_Factorization_Ext
+  Formal_Polynomial_Derivatives
+begin
+
+hide_const Factorial_Ring.multiplicity
+hide_const Factorial_Ring.irreducible
+
+lemma (in domain) finprod_mult_of:
+  assumes "finite A"
+  assumes "\<And>x. x \<in> A \<Longrightarrow> f x \<in> carrier (mult_of R)"
+  shows "finprod R f A = finprod (mult_of R) f A"
+  using assms by (induction A rule:finite_induct, auto) 
+
+lemma (in ring) finite_poly:
+  assumes "subring K R"
+  assumes "finite K"
+  shows 
+    "finite {f. f \<in> carrier (K[X]) \<and> degree f = n}" (is "finite ?A")
+    "finite {f. f \<in> carrier (K[X]) \<and> degree f \<le> n}" (is "finite ?B")
+proof -
+  have "finite {f. set f \<subseteq> K \<and> length f \<le> n + 1}" (is "finite ?C")
+    using assms(2) finite_lists_length_le by auto
+  moreover have "?B \<subseteq> ?C"
+    by (intro subsetI) 
+      (auto simp:univ_poly_carrier[symmetric] polynomial_def)
+  ultimately show a: "finite ?B" 
+    using finite_subset by auto
+  moreover have "?A \<subseteq> ?B" 
+    by (intro subsetI, simp)
+  ultimately show "finite ?A"
+    using finite_subset by auto
+qed
+
+definition pmult :: "_ \<Rightarrow> 'a list \<Rightarrow> 'a list \<Rightarrow> nat" ("pmult\<index>") 
+  where "pmult\<^bsub>R\<^esub> d p = multiplicity (mult_of (poly_ring R)) d p" 
+
+definition monic_poly :: "_ \<Rightarrow> 'a list \<Rightarrow> bool"
+  where "monic_poly R f = 
+    (f \<noteq> [] \<and> lead_coeff f = \<one>\<^bsub>R\<^esub> \<and> f \<in> carrier (poly_ring R))"
+
+definition monic_irreducible_poly where
+  "monic_irreducible_poly R f =
+    (monic_poly R f \<and> pirreducible\<^bsub>R\<^esub> (carrier R) f)"
+
+abbreviation "m_i_p \<equiv> monic_irreducible_poly"
+
+locale polynomial_ring = field +
+  fixes K
+  assumes polynomial_ring_assms: "subfield K R"
+begin
+
+lemma K_subring: "subring K R"
+  using polynomial_ring_assms subfieldE(1) by auto
+
+abbreviation P where "P \<equiv> K[X]"
+
+text \<open>This locale is used to specialize the following lemmas for a fixed coefficient ring.
+It can be introduced in a context as an intepretation to be able to use the following specialized
+lemmas. Because it is not (and should not) introduced as a sublocale it has no lasting effect
+for the field locale itself.\<close> 
+
+lemmas
+    poly_mult_lead_coeff = poly_mult_lead_coeff[OF K_subring]
+and degree_add_distinct = degree_add_distinct[OF K_subring]
+and coeff_add = coeff_add[OF K_subring]
+and var_closed = var_closed[OF K_subring]
+and degree_prod = degree_prod[OF _ K_subring]
+and degree_pow = degree_pow[OF K_subring]
+and pirreducible_degree = pirreducible_degree[OF polynomial_ring_assms]
+and degree_one_imp_pirreducible = 
+    degree_one_imp_pirreducible[OF polynomial_ring_assms]
+and var_pow_closed = var_pow_closed[OF K_subring]
+and var_pow_carr = var_pow_carr[OF K_subring]
+and univ_poly_a_inv_degree = univ_poly_a_inv_degree[OF K_subring]
+and var_pow_degree = var_pow_degree[OF K_subring]
+and pdivides_zero = pdivides_zero[OF K_subring]
+and pdivides_imp_degree_le = pdivides_imp_degree_le[OF K_subring]
+and var_carr = var_carr[OF K_subring]
+and rupture_eq_0_iff = rupture_eq_0_iff[OF polynomial_ring_assms]
+and rupture_is_field_iff_pirreducible =
+    rupture_is_field_iff_pirreducible[OF polynomial_ring_assms]
+and rupture_surj_hom = rupture_surj_hom[OF K_subring]
+and canonical_embedding_ring_hom =
+    canonical_embedding_ring_hom[OF K_subring]
+and rupture_surj_norm_is_hom = rupture_surj_norm_is_hom[OF K_subring]
+and rupture_surj_as_eval = rupture_surj_as_eval[OF K_subring]
+and eval_cring_hom = eval_cring_hom[OF K_subring]
+and coeff_range = coeff_range[OF K_subring]
+and finite_poly = finite_poly[OF K_subring]
+and int_embed_consistent_with_poly_of_const =
+    int_embed_consistent_with_poly_of_const[OF K_subring]
+and pderiv_var_pow = pderiv_var_pow[OF _ K_subring]
+and pderiv_add = pderiv_add[OF K_subring]
+and pderiv_inv = pderiv_inv[OF K_subring]
+and pderiv_mult = pderiv_mult[OF K_subring]
+and pderiv_pow = pderiv_pow[OF _ K_subring]
+and pderiv_carr = pderiv_carr[OF K_subring]
+
+sublocale p:principal_domain "poly_ring R"
+  by (simp add: carrier_is_subfield univ_poly_is_principal)
+
+end
+
+context field
+begin
+
+interpretation polynomial_ring "R" "carrier R" 
+  using carrier_is_subfield field_axioms
+  by (simp add:polynomial_ring_def polynomial_ring_axioms_def)
+
+lemma pdivides_mult_r: 
+  assumes "a \<in> carrier (mult_of P)" 
+  assumes "b \<in> carrier (mult_of P)" 
+  assumes "c \<in> carrier (mult_of P)"
+  shows "a \<otimes>\<^bsub>P\<^esub> c pdivides b \<otimes>\<^bsub>P\<^esub> c \<longleftrightarrow> a pdivides b" 
+    (is "?lhs \<longleftrightarrow> ?rhs")
+proof -
+  have a:"b \<otimes>\<^bsub>P\<^esub> c \<in> carrier P - {\<zero>\<^bsub>P\<^esub>}"
+    using assms p.mult_of.m_closed by force
+  have b:"a \<otimes>\<^bsub>P\<^esub> c \<in> carrier P"
+    using assms by simp
+  have c:"b \<in> carrier P - {\<zero>\<^bsub>P\<^esub>}"
+    using assms p.mult_of.m_closed by force
+  have d:"a \<in> carrier P" using assms by simp
+  have "?lhs \<longleftrightarrow> a \<otimes>\<^bsub>P\<^esub> c divides\<^bsub>mult_of P\<^esub> b \<otimes>\<^bsub>P\<^esub> c"
+    unfolding pdivides_def using p.divides_imp_divides_mult a b
+    by (meson divides_mult_imp_divides)
+  also have "... \<longleftrightarrow> a divides\<^bsub>mult_of P\<^esub> b"
+    using p.mult_of.divides_mult_r[OF assms] by simp
+  also have "... \<longleftrightarrow> ?rhs"
+    unfolding pdivides_def using p.divides_imp_divides_mult c d
+    by (meson divides_mult_imp_divides)
+  finally show ?thesis by simp
+qed
+
+lemma lead_coeff_carr:
+  assumes "x \<in> carrier (mult_of P)"
+  shows "lead_coeff x \<in> carrier R - {\<zero>}"
+proof (cases x)
+  case Nil
+  then show ?thesis using assms by (simp add:univ_poly_zero)
+next
+  case (Cons a list)
+  hence a: "polynomial (carrier R) (a # list)"
+    using assms univ_poly_carrier by auto
+  have "lead_coeff x = a"
+    using Cons by simp
+  also have "a \<in> carrier R - {\<zero>}"
+    using lead_coeff_not_zero a by simp
+  finally show ?thesis by simp
+qed
+
+lemma lead_coeff_poly_of_const:
+  assumes "r \<noteq> \<zero>"
+  shows "lead_coeff (poly_of_const r) = r"
+  using assms
+  by (simp add:poly_of_const_def)
+
+lemma lead_coeff_mult:
+  assumes "f \<in> carrier (mult_of P)"
+  assumes "g \<in> carrier (mult_of P)"
+  shows "lead_coeff (f \<otimes>\<^bsub>P\<^esub> g) = lead_coeff f \<otimes> lead_coeff g"
+  unfolding univ_poly_mult using assms 
+  using univ_poly_carrier[where R="R" and K="carrier R"]
+  by (subst poly_mult_lead_coeff) (simp_all add:univ_poly_zero)
+
+lemma monic_poly_carr:
+  assumes "monic_poly R f"
+  shows "f \<in> carrier P"
+  using assms unfolding monic_poly_def by simp
+
+lemma monic_poly_add_distinct: 
+  assumes "monic_poly R f"
+  assumes "g \<in> carrier P" "degree g < degree f"
+  shows "monic_poly R (f \<oplus>\<^bsub>P\<^esub> g)"
+proof (cases "g \<noteq> \<zero>\<^bsub>P\<^esub>")
+  case True
+  define n where "n = degree f"
+  have "f \<in> carrier P - {\<zero>\<^bsub>P\<^esub>}"
+    using assms(1) univ_poly_zero
+    unfolding monic_poly_def by auto
+  hence "degree (f \<oplus>\<^bsub>P\<^esub> g) = max (degree f) (degree g)"
+    using assms(2,3) True
+    by (subst degree_add_distinct, simp_all)
+  also have "... = degree f"
+    using assms(3) by simp
+  finally have b: "degree (f \<oplus>\<^bsub>P\<^esub> g) = n"
+    unfolding n_def by simp
+  moreover have "n > 0"
+    using assms(3) unfolding n_def by simp
+  ultimately have "degree (f \<oplus>\<^bsub>P\<^esub> g) \<noteq> degree ([])"
+    by simp
+  hence a:"f \<oplus>\<^bsub>P\<^esub> g \<noteq> []" by auto
+
+  have "degree [] = 0" by simp
+  also have  "... < degree f"
+    using assms(3) by simp
+  finally have "degree f \<noteq> degree []" by simp
+  hence c: "f \<noteq> []" by auto
+
+  have d: "length g \<le> n" 
+    using  assms(3) unfolding n_def by simp 
+
+  have "lead_coeff (f \<oplus>\<^bsub>P\<^esub> g) = coeff (f \<oplus>\<^bsub>P\<^esub> g) n"
+    using a b by (cases "f \<oplus>\<^bsub>P\<^esub> g", auto)
+  also have "... = coeff f n \<oplus> coeff g n" 
+    using monic_poly_carr assms
+    by (subst coeff_add, auto) 
+  also have "... = lead_coeff f \<oplus> coeff g n"
+    using c unfolding n_def by (cases "f", auto)
+  also have "... = \<one> \<oplus> \<zero>"
+    using assms(1) unfolding monic_poly_def 
+    unfolding subst coeff_length[OF d] by simp
+  also have "... = \<one>"
+    by simp
+  finally have "lead_coeff (f \<oplus>\<^bsub>P\<^esub> g) = \<one>" by simp
+  moreover have "f \<oplus>\<^bsub>P\<^esub> g \<in> carrier P"
+    using monic_poly_carr assms by simp
+  ultimately show  ?thesis
+    using a  unfolding monic_poly_def by auto
+next
+  case False
+  then show ?thesis using assms monic_poly_carr by simp
+qed
+
+lemma monic_poly_one: "monic_poly R \<one>\<^bsub>P\<^esub>"
+proof -
+  have "\<one>\<^bsub>P\<^esub> \<in> carrier P"
+    by simp
+  thus ?thesis
+    by (simp add:univ_poly_one monic_poly_def)
+qed
+
+lemma monic_poly_var: "monic_poly R X"
+proof -
+  have "X \<in> carrier P"
+    using var_closed by simp
+  thus ?thesis
+    by (simp add:var_def monic_poly_def)
+qed
+
+lemma monic_poly_carr_2:
+  assumes "monic_poly R f"
+  shows "f \<in> carrier (mult_of P)"
+  using assms unfolding monic_poly_def
+  by (simp add:univ_poly_zero)
+
+lemma monic_poly_mult:
+  assumes "monic_poly R f"
+  assumes "monic_poly R g"
+  shows "monic_poly R (f \<otimes>\<^bsub>P\<^esub> g)"
+proof -
+  have "lead_coeff (f \<otimes>\<^bsub>P\<^esub> g) = lead_coeff f \<otimes>\<^bsub>R\<^esub> lead_coeff g"
+    using assms monic_poly_carr_2
+    by (subst lead_coeff_mult) auto
+  also have "... =  \<one>"
+    using assms unfolding monic_poly_def by simp
+  finally have "lead_coeff (f \<otimes>\<^bsub>P\<^esub> g) = \<one>\<^bsub>R\<^esub>" by simp
+  moreover have "(f \<otimes>\<^bsub>P\<^esub> g) \<in> carrier (mult_of P)"
+    using monic_poly_carr_2 assms by blast
+  ultimately show ?thesis
+    by (simp add:monic_poly_def univ_poly_zero)
+qed
+
+lemma monic_poly_pow:
+  assumes "monic_poly R f"
+  shows "monic_poly R (f [^]\<^bsub>P\<^esub> (n::nat))"
+  using assms monic_poly_one monic_poly_mult
+  by (induction n, auto)
+
+lemma monic_poly_prod:
+  assumes "finite A"
+  assumes "\<And>x. x \<in> A \<Longrightarrow> monic_poly R (f x)"
+  shows "monic_poly R (finprod P f A)"
+  using assms 
+proof (induction A rule:finite_induct)
+  case empty
+  then show ?case by (simp add:monic_poly_one)
+next
+  case (insert x F)
+  have a: "f \<in> F \<rightarrow> carrier P" 
+    using insert monic_poly_carr by simp
+  have b: "f x \<in> carrier P" 
+    using insert monic_poly_carr by simp
+  have "monic_poly R (f x \<otimes>\<^bsub>P\<^esub> finprod P f F)"
+    using insert by (intro monic_poly_mult) auto
+  thus ?case
+    using insert a b by (subst p.finprod_insert, auto)
+qed
+
+lemma monic_poly_not_assoc:
+  assumes "monic_poly R f"
+  assumes "monic_poly R g"
+  assumes "f \<sim>\<^bsub>(mult_of P)\<^esub> g"
+  shows "f = g"
+proof -
+  obtain u where u_def: "f = g \<otimes>\<^bsub>P\<^esub> u" "u \<in> Units (mult_of P)"
+    using p.mult_of.associatedD2 assms monic_poly_carr_2
+    by blast
+
+  hence "u \<in> Units P" by simp
+  then obtain v where v_def: "u = [v]" "v \<noteq> \<zero>\<^bsub>R\<^esub>" "v \<in> carrier R"
+    using univ_poly_carrier_units by auto
+
+  have "\<one> = lead_coeff f"
+    using assms(1) by (simp add:monic_poly_def)
+  also have  "... = lead_coeff (g \<otimes>\<^bsub>P\<^esub> u)"
+    by (simp add:u_def)
+  also have "... = lead_coeff g \<otimes> lead_coeff u"
+    using assms(2) monic_poly_carr_2 v_def u_def(2)
+    by (subst lead_coeff_mult, auto simp add:univ_poly_zero) 
+  also have "... = lead_coeff g \<otimes> v"
+    using v_def by simp
+  also have "... = v"
+    using assms(2) v_def(3) by (simp add:monic_poly_def)
+  finally have "\<one> = v" by simp
+  hence "u = \<one>\<^bsub>P\<^esub>" 
+    using v_def by (simp add:univ_poly_one)
+  thus "f = g"
+    using u_def assms monic_poly_carr by simp
+qed
+
+lemma monic_poly_span:
+  assumes "x \<in> carrier (mult_of P)" "irreducible (mult_of P) x"
+  shows "\<exists>y. monic_irreducible_poly R y \<and> x \<sim>\<^bsub>(mult_of P)\<^esub> y"
+proof -
+  define z where "z = poly_of_const (inv (lead_coeff x))"
+  define y where "y = x \<otimes>\<^bsub>P\<^esub> z"
+
+  have x_carr: "x \<in> carrier (mult_of P)" using assms by simp
+
+  hence lx_ne_0: "lead_coeff x \<noteq> \<zero>" 
+    and lx_unit: "lead_coeff x \<in> Units R" 
+    using lead_coeff_carr[OF x_carr] by (auto simp add:field_Units)
+  have lx_inv_ne_0: "inv (lead_coeff x) \<noteq> \<zero>"  
+    using lx_unit 
+    by (metis Units_closed Units_r_inv r_null zero_not_one)
+  have lx_inv_carr: "inv (lead_coeff x) \<in> carrier R" 
+    using lx_unit by simp
+
+  have "z \<in> carrier P"
+    using lx_inv_carr poly_of_const_over_carrier
+    unfolding z_def by auto
+  moreover have "z \<noteq> \<zero>\<^bsub>P\<^esub>" 
+    using lx_inv_ne_0
+    by (simp add:z_def poly_of_const_def univ_poly_zero)
+  ultimately have z_carr: "z \<in> carrier (mult_of P)" by simp
+  have z_unit: "z \<in> Units (mult_of P)"
+    using lx_inv_ne_0 lx_inv_carr
+    by (simp add:univ_poly_carrier_units z_def poly_of_const_def)
+  have y_exp: "y = x \<otimes>\<^bsub>(mult_of P)\<^esub> z" 
+    by (simp add:y_def)
+  hence y_carr: "y \<in> carrier (mult_of P)" 
+    using x_carr z_carr p.mult_of.m_closed by simp
+
+  have "irreducible (mult_of P) y"
+    unfolding y_def using assms z_unit z_carr
+    by (intro p.mult_of.irreducible_prod_rI, auto)
+  moreover have "lead_coeff y = \<one>\<^bsub>R\<^esub>" 
+    unfolding y_def using x_carr z_carr lx_inv_ne_0 lx_unit
+    by (simp add: lead_coeff_mult z_def lead_coeff_poly_of_const)
+  hence "monic_poly R y"
+    using y_carr unfolding monic_poly_def
+    by (simp add:univ_poly_zero) 
+  ultimately have "monic_irreducible_poly R y"
+    using p.irreducible_mult_imp_irreducible y_carr
+    by (simp add:monic_irreducible_poly_def ring_irreducible_def)
+  moreover have "y \<sim>\<^bsub>(mult_of P)\<^esub> x" 
+    by (intro p.mult_of.associatedI2[OF z_unit] y_def x_carr)
+  hence "x \<sim>\<^bsub>(mult_of P)\<^esub> y"
+    using x_carr y_carr by (simp add:p.mult_of.associated_sym)
+  ultimately show ?thesis by auto
+qed
+
+lemma monic_polys_are_canonical_irreducibles:
+  "canonical_irreducibles (mult_of P) {d. monic_irreducible_poly R d}"
+  (is "canonical_irreducibles (mult_of P) ?S")
+proof -
+  have sp_1: 
+    "?S \<subseteq> {x \<in> carrier (mult_of P). irreducible (mult_of P) x}" 
+    unfolding monic_irreducible_poly_def ring_irreducible_def
+    using monic_poly_carr
+    by (intro subsetI, simp add: p.irreducible_imp_irreducible_mult) 
+  have sp_2: "x = y" 
+      if "x \<in> ?S" "y \<in> ?S" "x \<sim>\<^bsub>(mult_of P)\<^esub> y" for x y 
+    using that monic_poly_not_assoc
+    by (simp add:monic_irreducible_poly_def)
+
+  have sp_3: "\<exists>y \<in> ?S. x \<sim>\<^bsub>(mult_of P)\<^esub> y" 
+    if "x \<in> carrier (mult_of P)" "irreducible (mult_of P) x" for x
+    using that monic_poly_span by simp
+
+  thus ?thesis using sp_1 sp_2 sp_3
+    unfolding canonical_irreducibles_def by simp
+qed
+
+lemma
+  assumes "monic_poly R a"
+  shows factor_monic_poly: 
+    "a = (\<Otimes>\<^bsub>P\<^esub>d\<in>{d. monic_irreducible_poly R d \<and> pmult d a > 0}. 
+      d [^]\<^bsub>P\<^esub> pmult d a)" (is "?lhs = ?rhs")
+    and factor_monic_poly_fin: 
+      "finite {d. monic_irreducible_poly R d \<and> pmult d a > 0}" 
+proof -
+  let ?S = "{d. monic_irreducible_poly R d}"
+  let ?T = "{d. monic_irreducible_poly R d \<and> pmult d a > 0}"
+  let ?mip = "monic_irreducible_poly R"
+
+  have sp_4: "a \<in> carrier (mult_of P)" 
+    using assms monic_poly_carr_2
+    unfolding monic_irreducible_poly_def by simp
+
+  have b_1: "x \<in> carrier (mult_of P)" if "?mip x" for x 
+    using that monic_poly_carr_2
+    unfolding monic_irreducible_poly_def by simp
+  have b_2:"irreducible (mult_of P) x" if "?mip x" for x
+    using that
+    unfolding monic_irreducible_poly_def ring_irreducible_def 
+    by (simp add: monic_poly_carr p.irreducible_imp_irreducible_mult)
+  have b_3:"x \<in> carrier P" if "?mip x" for x
+    using that monic_poly_carr
+    unfolding monic_irreducible_poly_def
+    by simp
+
+  have a_carr: "a \<in> carrier P - {\<zero>\<^bsub>P\<^esub>}" 
+    using sp_4 by simp
+
+  have "?T = {d. ?mip d \<and> multiplicity (mult_of P) d a > 0}" 
+    by (simp add:pmult_def)
+  also have "... = {d \<in> ?S. multiplicity (mult_of P) d a > 0}"
+    using p.mult_of.multiplicity_gt_0_iff[OF b_1 b_2 sp_4]
+    by (intro order_antisym subsetI, auto)
+  finally have t:"?T = {d \<in> ?S. multiplicity (mult_of P) d a > 0}"
+    by simp
+
+  show fin_T: "finite ?T"
+    unfolding t
+    using p.mult_of.split_factors(1)
+      [OF monic_polys_are_canonical_irreducibles]
+    using sp_4 by auto
+
+  have a:"x [^]\<^bsub>P\<^esub> (n::nat) \<in> carrier (mult_of P)" if "?mip x" for x n
+  proof -
+    have "monic_poly R (x [^]\<^bsub>P\<^esub> n)"
+      using that monic_poly_pow 
+      unfolding monic_irreducible_poly_def by auto
+    thus ?thesis
+      using monic_poly_carr_2 by simp
+  qed
+
+  have "?lhs \<sim>\<^bsub>(mult_of P)\<^esub> 
+    finprod (mult_of P) 
+      (\<lambda>d. d [^]\<^bsub>(mult_of P)\<^esub> (multiplicity (mult_of P) d a)) ?T"
+    unfolding t 
+    by (intro p.mult_of.split_factors(2)
+        [OF monic_polys_are_canonical_irreducibles sp_4])
+  also have "... = 
+    finprod (mult_of P) (\<lambda>d. d [^]\<^bsub>P\<^esub> (multiplicity (mult_of P) d a)) ?T"
+    by (simp add:nat_pow_mult_of)
+  also have "... = ?rhs"
+    using fin_T a
+    by (subst p.finprod_mult_of, simp_all add:pmult_def) 
+  finally have "?lhs \<sim>\<^bsub>(mult_of P)\<^esub> ?rhs" by simp
+  moreover have "monic_poly R ?rhs" 
+    using fin_T 
+    by (intro monic_poly_prod monic_poly_pow)
+      (auto simp:monic_irreducible_poly_def) 
+  ultimately show "?lhs = ?rhs"
+    using monic_poly_not_assoc assms monic_irreducible_poly_def
+    by blast
+qed
+
+lemma degree_monic_poly':
+  assumes "monic_poly R f"
+  shows 
+    "sum' (\<lambda>d. pmult d f * degree d) {d. monic_irreducible_poly R d} = 
+    degree f" 
+proof -
+  let ?mip = "monic_irreducible_poly R"
+
+  have b: "d \<in> carrier P - {\<zero>\<^bsub>P\<^esub>}" if "?mip d" for d 
+    using that monic_poly_carr_2
+    unfolding monic_irreducible_poly_def by simp
+  have a: "d [^]\<^bsub>P\<^esub> n \<in> carrier P - {\<zero>\<^bsub>P\<^esub>}" if "?mip d" for d and n :: "nat"
+    using b that monic_poly_pow
+    unfolding monic_irreducible_poly_def 
+    by (simp add: p.pow_non_zero)
+
+  have "degree f = 
+    degree (\<Otimes>\<^bsub>P\<^esub>d\<in>{d. ?mip d \<and> pmult d f > 0}. d [^]\<^bsub>P\<^esub> pmult d f)"
+    using factor_monic_poly[OF assms(1)] by simp
+  also have "... = 
+    (\<Sum>i\<in>{d. ?mip d \<and> 0 < pmult d f}. degree (i [^]\<^bsub>P\<^esub> pmult i f))"
+    using a assms(1)
+    by (subst degree_prod[OF factor_monic_poly_fin])
+     (simp_all add:Pi_def)
+  also have "... = 
+    (\<Sum>i\<in>{d. ?mip d \<and> 0 < pmult d f}. degree i * pmult i f)"
+    using b degree_pow by (intro sum.cong, auto)
+  also have "... = 
+    (\<Sum>d\<in>{d. ?mip d \<and> 0 < pmult d f}. pmult d f * degree d)"
+    by (simp add:mult.commute)
+  also have "... = 
+    sum' (\<lambda>d. pmult d f * degree d) {d. ?mip d \<and> 0 < pmult d f}"
+    using sum.eq_sum factor_monic_poly_fin[OF assms(1)] by simp
+  also have "... = sum' (\<lambda>d. pmult d f * degree d) {d. ?mip d}"
+    by (intro sum.mono_neutral_cong_left' subsetI, auto)
+  finally show ?thesis by simp
+qed
+
+lemma monic_poly_min_degree:
+  assumes "monic_irreducible_poly R f"
+  shows  "degree f \<ge> 1"
+  using assms unfolding monic_irreducible_poly_def monic_poly_def
+  by (intro pirreducible_degree) auto
+
+lemma degree_one_monic_poly:
+  "monic_irreducible_poly R f \<and> degree f = 1 \<longleftrightarrow> 
+  (\<exists>x \<in> carrier R. f = [\<one>, \<ominus>x])"
+proof 
+  assume "monic_irreducible_poly R f \<and> degree f = 1"
+  hence a:"monic_poly R f" "length f = 2"
+    unfolding monic_irreducible_poly_def by auto
+  then obtain u v where f_def: "f = [u,v]"
+    by (cases f, simp, cases "tl f", auto)
+
+  have "u = \<one>" using a unfolding monic_poly_def f_def by simp
+  moreover have "v \<in> carrier R" 
+    using a unfolding monic_poly_def univ_poly_carrier[symmetric]
+    unfolding polynomial_def f_def by simp 
+  ultimately have "f =  [\<one>, \<ominus>(\<ominus>v)]" "(\<ominus>v) \<in> carrier R"
+    using a_inv_closed f_def by auto
+  thus "(\<exists>x \<in> carrier R. f = [\<one>\<^bsub>R\<^esub>, \<ominus>\<^bsub>R\<^esub>x])" by auto
+next
+  assume "(\<exists>x \<in> carrier R. f = [\<one>, \<ominus>x])"
+  then obtain x where f_def: "f = [\<one>,\<ominus>x]" "x \<in> carrier R" by auto
+  have a:"degree f = 1" using f_def(2) unfolding f_def by simp
+  have b:"f \<in> carrier P"
+    using f_def(2) unfolding univ_poly_carrier[symmetric]
+    unfolding f_def polynomial_def by simp
+  have c: "pirreducible (carrier R) f"   
+    by (intro degree_one_imp_pirreducible a b)
+  have d: "lead_coeff f = \<one>" unfolding f_def by simp
+  show "monic_irreducible_poly R f \<and> degree f = 1"
+    using a b c d 
+    unfolding monic_irreducible_poly_def monic_poly_def
+    by auto
+qed
+
+lemma multiplicity_ge_iff:
+  assumes "monic_irreducible_poly R d" 
+  assumes "f \<in> carrier P - {\<zero>\<^bsub>P\<^esub>}"
+  shows "pmult d f \<ge> k \<longleftrightarrow> d [^]\<^bsub>P\<^esub> k pdivides f"
+proof -
+  have a:"f \<in> carrier (mult_of P)" 
+    using assms(2) by simp
+  have b: "d \<in> carrier (mult_of P)" 
+    using assms(1) monic_poly_carr_2
+    unfolding monic_irreducible_poly_def by simp
+  have c: "irreducible (mult_of P) d" 
+    using assms(1) monic_poly_carr_2 
+    using p.irreducible_imp_irreducible_mult
+    unfolding monic_irreducible_poly_def 
+    unfolding ring_irreducible_def monic_poly_def
+    by simp
+  have d: "d [^]\<^bsub>P\<^esub> k \<in> carrier P" using b by simp
+
+  have "pmult d f \<ge> k \<longleftrightarrow> d [^]\<^bsub>(mult_of P)\<^esub> k divides\<^bsub>(mult_of P)\<^esub> f"
+    unfolding pmult_def
+    by (intro p.mult_of.multiplicity_ge_iff a b c)
+  also have "... \<longleftrightarrow> d [^]\<^bsub>P\<^esub> k pdivides\<^bsub>R\<^esub> f"
+    using p.divides_imp_divides_mult[OF d assms(2)]
+    using divides_mult_imp_divides 
+    unfolding pdivides_def nat_pow_mult_of
+    by auto
+  finally show ?thesis by simp
+qed
+
+lemma multiplicity_ge_1_iff_pdivides:
+  assumes "monic_irreducible_poly R d" "f \<in> carrier P - {\<zero>\<^bsub>P\<^esub>}"
+  shows "pmult d f \<ge> 1 \<longleftrightarrow> d pdivides f"
+proof -
+  have "d \<in> carrier P" 
+    using assms(1) monic_poly_carr
+    unfolding monic_irreducible_poly_def
+    by simp
+  thus ?thesis
+    using multiplicity_ge_iff[OF assms, where k="1"]
+    by simp
+qed
+  
+lemma divides_monic_poly:
+  assumes "monic_poly R f" "monic_poly R g"
+  assumes "\<And>d. monic_irreducible_poly R d 
+    \<Longrightarrow> pmult d f \<le> pmult d g" 
+  shows "f pdivides g"
+proof -
+  have a:"f \<in> carrier (mult_of P)" "g \<in> carrier (mult_of P)" 
+    using monic_poly_carr_2 assms(1,2) by auto
+
+  have "f divides\<^bsub>(mult_of P)\<^esub> g"
+    using assms(3) unfolding pmult_def 
+    by (intro p.mult_of.divides_iff_mult_mono
+        [OF a monic_polys_are_canonical_irreducibles]) simp
+  thus ?thesis 
+    unfolding pdivides_def using divides_mult_imp_divides by simp
+qed
+
+end
+
+lemma monic_poly_hom:
+  assumes "monic_poly R f"
+  assumes "h \<in> ring_iso R S" "domain R" "domain S"
+  shows "monic_poly S (map h f)"
+proof -
+  have c: "h \<in> ring_hom R S"
+    using assms(2) ring_iso_def by auto
+  have e: "f \<in> carrier (poly_ring R)" 
+    using assms(1) unfolding monic_poly_def by simp
+
+  have a:"f \<noteq> []"
+    using assms(1) unfolding monic_poly_def by simp
+  hence "map h f \<noteq> []" by simp
+  moreover have "lead_coeff f = \<one>\<^bsub>R\<^esub>"
+    using assms(1) unfolding monic_poly_def by simp
+  hence "lead_coeff (map h f) = \<one>\<^bsub>S\<^esub>" 
+    using ring_hom_one[OF c] by (simp add: hd_map[OF a])
+  ultimately show ?thesis
+    using carrier_hom[OF e assms(2-4)]
+    unfolding monic_poly_def by simp
+qed
+
+lemma monic_irreducible_poly_hom:
+  assumes "monic_irreducible_poly R f"
+  assumes "h \<in> ring_iso R S" "domain R" "domain S"
+  shows "monic_irreducible_poly S (map h f)"
+proof -
+  have a:
+    "pirreducible\<^bsub>R\<^esub> (carrier R) f"
+    "f \<in> carrier (poly_ring R)"
+    "monic_poly R f"
+    using assms(1)
+    unfolding monic_poly_def monic_irreducible_poly_def
+    by auto
+ 
+  have "pirreducible\<^bsub>S\<^esub> (carrier S) (map h f)"
+    using a pirreducible_hom assms by auto  
+  moreover have "monic_poly S (map h f)"
+    using a monic_poly_hom[OF _ assms(2,3,4)] by simp
+  ultimately show ?thesis
+    unfolding monic_irreducible_poly_def by simp
+qed
+
+end
diff --git a/thys/Finite_Fields/ROOT b/thys/Finite_Fields/ROOT
new file mode 100644
--- /dev/null
+++ b/thys/Finite_Fields/ROOT
@@ -0,0 +1,18 @@
+chapter AFP
+
+session Finite_Fields (AFP) = "HOL-Algebra" +
+  options [timeout = 600]
+  sessions
+    Dirichlet_Series
+  theories 
+    Card_Irreducible_Polynomials
+    Card_Irreducible_Polynomials_Aux
+    Finite_Fields_Factorization_Ext
+    Finite_Fields_Isomorphic
+    Finite_Fields_Preliminary_Results
+    Formal_Polynomial_Derivatives
+    Monic_Polynomial_Factorization
+    Ring_Characteristic
+  document_files
+    "root.tex"
+    "root.bib"
diff --git a/thys/Finite_Fields/Ring_Characteristic.thy b/thys/Finite_Fields/Ring_Characteristic.thy
new file mode 100644
--- /dev/null
+++ b/thys/Finite_Fields/Ring_Characteristic.thy
@@ -0,0 +1,1017 @@
+section \<open>Characteristic of Rings\label{sec:ring_char}\<close>
+
+theory Ring_Characteristic
+  imports 
+    "Finite_Fields_Factorization_Ext"
+    "HOL-Algebra.IntRing" 
+    "HOL-Algebra.Embedded_Algebras"
+begin
+
+locale finite_field = field +
+  assumes finite_carrier: "finite (carrier R)"
+begin
+
+lemma finite_field_min_order:
+  "order R > 1"
+proof (rule ccontr)
+  assume a:"\<not>(1 < order R)"
+  have "{\<zero>\<^bsub>R\<^esub>,\<one>\<^bsub>R\<^esub>} \<subseteq> carrier R" by auto
+  hence "card {\<zero>\<^bsub>R\<^esub>,\<one>\<^bsub>R\<^esub>} \<le> card (carrier R)"
+    using card_mono finite_carrier by blast
+  also have "... \<le> 1" using a by (simp add:order_def)
+  finally have "card {\<zero>\<^bsub>R\<^esub>,\<one>\<^bsub>R\<^esub>} \<le> 1" by blast
+  thus "False" by simp
+qed
+
+lemma (in finite_field) order_pow_eq_self:
+  assumes "x \<in> carrier R"
+  shows "x [^] (order R) = x"
+proof (cases "x = \<zero>")
+  case True
+  have "order R > 0"
+    using assms(1) order_gt_0_iff_finite finite_carrier by simp
+  then obtain n where n_def:"order R = Suc n" 
+    using lessE by blast
+  have "x [^] (order R) = \<zero>" 
+    unfolding n_def using True by (subst nat_pow_Suc, simp)
+  thus ?thesis using True by simp
+next
+  case False
+  have x_carr:"x \<in> carrier (mult_of R)"
+    using False assms by simp
+
+  have carr_non_empty: "card (carrier R) > 0" 
+    using order_gt_0_iff_finite finite_carrier
+    unfolding order_def by simp
+  have "x [^] (order R) = x [^]\<^bsub>mult_of R\<^esub> (order R)"
+    by (simp add:nat_pow_mult_of)
+  also have "... = x [^]\<^bsub>mult_of R\<^esub> (order (mult_of R)+1)"
+    using carr_non_empty unfolding order_def
+    by (intro arg_cong[where f="\<lambda>t. x [^]\<^bsub>mult_of R\<^esub> t"]) (simp)
+  also have "... = x"
+    using x_carr
+    by (simp add:mult_of.pow_order_eq_1)
+  finally show "x [^] (order R) = x"
+    by simp
+qed
+
+lemma (in finite_field) order_pow_eq_self':
+  assumes "x \<in> carrier R"
+  shows "x [^] (order R ^ d) = x"
+proof (induction d)
+  case 0
+  then show ?case using assms by simp
+next
+  case (Suc d)
+  have "x [^] order R ^ (Suc d) = x [^] (order R ^ d * order R)"
+    by (simp add:mult.commute)
+  also have "... = (x [^] (order R ^ d)) [^] order R"
+    using assms by (simp add: nat_pow_pow)
+  also have "... = (x [^] (order R ^ d))"
+    using order_pow_eq_self assms by simp
+  also have "... = x"
+    using Suc by simp
+  finally show ?case by simp
+qed
+
+end
+
+lemma finite_fieldI:
+  assumes "field R"
+  assumes "finite (carrier R)"
+  shows "finite_field R"
+  using assms
+  unfolding finite_field_def finite_field_axioms_def
+  by auto
+
+lemma (in domain) finite_domain_units:
+  assumes "finite (carrier R)"
+  shows "Units R = carrier R - {\<zero>}" (is "?lhs = ?rhs")
+proof 
+  have "Units R \<subseteq> carrier R" by (simp add:Units_def) 
+  moreover have "\<zero> \<notin> Units R"
+    by (meson zero_is_prime(1) primeE)
+  ultimately show "Units R \<subseteq> carrier R - {\<zero>}" by blast
+next
+  have "x \<in> Units R" if a: "x \<in> carrier R - {\<zero>}" for x
+  proof -
+    have x_carr: "x \<in> carrier R" using a by blast
+    define f where "f = (\<lambda>y. y \<otimes>\<^bsub>R\<^esub> x)"
+    have "inj_on f (carrier R)" unfolding f_def
+      by (rule inj_onI, metis DiffD1 DiffD2 a m_rcancel insertI1)
+    hence "card (carrier R) = card (f ` carrier R)"
+      by (metis card_image)
+    moreover have "f ` carrier R \<subseteq> carrier R" unfolding f_def
+      by (rule image_subsetI, simp add: ring.ring_simprules x_carr)
+    ultimately have "f ` carrier R = carrier R"
+      using card_subset_eq assms by metis
+    moreover have "\<one>\<^bsub>R\<^esub> \<in> carrier R" by simp
+    ultimately have "\<exists>y \<in> carrier R. f y = \<one>\<^bsub>R\<^esub>" 
+      by (metis image_iff)
+    then obtain y 
+      where y_carrier: "y \<in> carrier R" 
+        and y_left_inv: "y \<otimes>\<^bsub>R\<^esub> x = \<one>\<^bsub>R\<^esub>" 
+      using f_def by blast
+    hence  y_right_inv: "x \<otimes>\<^bsub>R\<^esub> y = \<one>\<^bsub>R\<^esub>"
+      by (metis DiffD1 a cring_simprules(14))
+    show "x \<in> Units R"
+      using y_carrier y_left_inv y_right_inv
+      by (metis DiffD1 a divides_one factor_def)
+  qed
+  thus "?rhs \<subseteq> ?lhs" by auto
+qed
+
+text \<open>The following theorem can be found in Lidl and Niederreiter~\cite[Theorem 1.31]{lidl1986}.\<close>
+
+theorem finite_domains_are_fields:
+  assumes "domain R"
+  assumes "finite (carrier R)"
+  shows "finite_field R"
+proof -
+  interpret domain R using assms by auto
+  have "Units R = carrier R - {\<zero>\<^bsub>R\<^esub>}"
+    using finite_domain_units[OF assms(2)] by simp
+  then have "field R"
+    by (simp add: assms(1) field.intro field_axioms.intro)
+  thus ?thesis
+    using assms(2) finite_fieldI by auto 
+qed
+
+definition zfact_iso :: "nat \<Rightarrow> nat \<Rightarrow> int set" where
+  "zfact_iso p k = Idl\<^bsub>\<Z>\<^esub> {int p} +>\<^bsub>\<Z>\<^esub> (int k)"
+
+context
+  fixes n :: nat
+  assumes n_gt_0: "n > 0"
+begin
+
+private abbreviation I where "I \<equiv> Idl\<^bsub>\<Z>\<^esub> {int n}"
+
+private lemma ideal_I: "ideal I \<Z>"
+  by (simp add: int.genideal_ideal)
+
+lemma int_cosetI:
+  assumes "u mod (int n) = v mod (int n)"
+  shows "Idl\<^bsub>\<Z>\<^esub> {int n} +>\<^bsub>\<Z>\<^esub> u = Idl\<^bsub>\<Z>\<^esub> {int n} +>\<^bsub>\<Z>\<^esub> v"
+proof -
+  have "u - v \<in> I"
+    by (metis Idl_subset_eq_dvd assms int_Idl_subset_ideal mod_eq_dvd_iff)
+  thus ?thesis
+    using ideal_I int.quotient_eq_iff_same_a_r_cos by simp
+qed
+
+lemma zfact_iso_inj:
+  "inj_on (zfact_iso n) {..<n}"
+proof (rule inj_onI)
+  fix x y
+  assume a:"x \<in> {..<n}" "y \<in> {..<n}"
+  assume "zfact_iso n x = zfact_iso n y"
+  hence "I +>\<^bsub>\<Z>\<^esub> (int x) = I +>\<^bsub>\<Z>\<^esub> (int y)"
+    by (simp add:zfact_iso_def)
+  hence "int x - int y \<in> I"
+    by (subst int.quotient_eq_iff_same_a_r_cos[OF ideal_I], auto)
+  hence "int x mod int n = int y mod int n"
+    by (meson Idl_subset_eq_dvd int_Idl_subset_ideal mod_eq_dvd_iff)
+  thus "x = y"
+    using a by simp
+qed
+
+lemma zfact_iso_ran:
+  "zfact_iso n ` {..<n} = carrier (ZFact (int n))"
+proof -
+  have "zfact_iso n ` {..<n} \<subseteq> carrier (ZFact (int n))"
+    unfolding zfact_iso_def ZFact_def FactRing_simps 
+    using int.a_rcosetsI by auto
+  moreover have "x \<in> zfact_iso n ` {..<n}" 
+    if a:"x \<in> carrier (ZFact (int n))" for x
+  proof -
+    obtain y where y_def: "x = I +>\<^bsub>\<Z>\<^esub> y"
+      using a unfolding ZFact_def FactRing_simps by auto
+    obtain z where z_def: "(int z) mod (int n) = y mod (int n)" "z < n"
+      by (metis Euclidean_Division.pos_mod_sign mod_mod_trivial 
+          nonneg_int_cases of_nat_0_less_iff of_nat_mod n_gt_0
+          unique_euclidean_semiring_numeral_class.pos_mod_bound)
+    have "x = I  +>\<^bsub>\<Z>\<^esub> y"
+      by (simp add:y_def)
+    also have "... = I +>\<^bsub>\<Z>\<^esub> (int z)"
+      by (intro int_cosetI, simp add:z_def)
+    also have "... = zfact_iso n z"
+      by (simp add:zfact_iso_def)
+    finally have "x = zfact_iso n z"
+      by simp
+    thus "x \<in> zfact_iso n ` {..<n}"
+      using z_def(2) by blast
+  qed
+  ultimately show ?thesis by auto
+qed
+
+lemma zfact_iso_bij:
+  "bij_betw (zfact_iso n) {..<n} (carrier (ZFact (int n)))"
+  using  bij_betw_def zfact_iso_inj zfact_iso_ran by blast
+
+lemma card_zfact_carr: "card (carrier (ZFact (int n))) = n"
+  using bij_betw_same_card[OF zfact_iso_bij] by simp
+
+lemma fin_zfact: "finite (carrier (ZFact (int n)))"
+  using card_zfact_carr n_gt_0 card_ge_0_finite by force
+
+end
+
+lemma zfact_prime_is_finite_field:
+  assumes "Factorial_Ring.prime p"
+  shows "finite_field (ZFact (int p))"
+proof -
+  have p_gt_0: "p > 0" using assms(1) prime_gt_0_nat by simp
+  have "Factorial_Ring.prime (int p)" 
+    using assms by simp
+  moreover have "finite (carrier (ZFact (int p)))" 
+    using fin_zfact[OF p_gt_0] by simp
+  ultimately show ?thesis
+    by (intro finite_domains_are_fields ZFact_prime_is_domain, auto)
+qed
+
+definition int_embed :: "_ \<Rightarrow> int \<Rightarrow> _"  where
+  "int_embed R k = add_pow R k \<one>\<^bsub>R\<^esub>"
+
+lemma (in ring) add_pow_consistent:
+  fixes i :: "int"
+  assumes "subring K R"
+  assumes "k \<in> K"
+  shows "add_pow R i k = add_pow (R \<lparr> carrier := K \<rparr>) i k"
+    (is "?lhs = ?rhs")
+proof -
+  have a:"subgroup K (add_monoid R)" 
+    using assms(1) subring.axioms by auto
+  have "add_pow R i k = k [^]\<^bsub>add_monoid R\<lparr>carrier := K\<rparr>\<^esub> i" 
+    using add.int_pow_consistent[OF a assms(2)] by simp
+  also have "... = ?rhs"
+    unfolding add_pow_def by simp
+  finally show ?thesis by simp
+qed
+
+lemma (in ring) int_embed_consistent:
+  assumes "subring K R"
+  shows "int_embed R i = int_embed (R \<lparr> carrier := K \<rparr>) i"
+proof -
+  have a:"\<one> = \<one>\<^bsub>R \<lparr> carrier := K \<rparr>\<^esub>" by simp
+  have b:"\<one>\<^bsub>R\<lparr>carrier := K\<rparr>\<^esub> \<in> K" 
+    using assms subringE(3) by auto
+  show ?thesis
+    unfolding int_embed_def a using b add_pow_consistent[OF assms(1)] by simp
+qed
+
+lemma (in ring) int_embed_closed:
+  "int_embed R k \<in> carrier R"
+  unfolding int_embed_def using add.int_pow_closed by simp
+
+lemma (in ring) int_embed_range:
+  assumes "subring K R"
+  shows "int_embed R k \<in> K"
+proof -
+  let ?R' =  "R \<lparr> carrier := K \<rparr>"
+  interpret x:ring ?R'
+    using subring_is_ring[OF assms] by simp
+  have "int_embed R k = int_embed ?R' k"
+    using int_embed_consistent[OF assms] by simp
+  also have "...  \<in> K"
+    using x.int_embed_closed by simp
+  finally show ?thesis by simp
+qed
+
+lemma (in ring) int_embed_zero:
+  "int_embed R 0 = \<zero>\<^bsub>R\<^esub>"
+  by (simp add:int_embed_def add_pow_def)  
+
+lemma (in ring) int_embed_one:
+  "int_embed R 1 = \<one>\<^bsub>R\<^esub>"
+  by (simp add:int_embed_def)  
+
+lemma (in ring) int_embed_add:
+  "int_embed R (x+y) = int_embed R x \<oplus>\<^bsub>R\<^esub> int_embed R y"
+  by (simp add:int_embed_def add.int_pow_mult)  
+
+lemma (in ring) int_embed_inv:
+  "int_embed R (-x) = \<ominus>\<^bsub>R\<^esub> int_embed R x" (is "?lhs = ?rhs")
+proof -
+  have "?lhs = int_embed R (-x) \<oplus> (int_embed R x \<ominus> int_embed R x)"
+    using int_embed_closed by simp
+  also have 
+    "... = int_embed R (-x) \<oplus> int_embed R x \<oplus> (\<ominus> int_embed R x)"
+    using int_embed_closed by (subst a_minus_def, subst a_assoc, auto)
+  also have "... = int_embed R (-x +x) \<oplus> (\<ominus> int_embed R x)"
+    by (subst int_embed_add, simp)
+  also have "... = ?rhs"
+    using int_embed_closed
+    by (simp add:int_embed_zero)
+  finally show ?thesis by simp
+qed
+
+lemma (in ring) int_embed_diff:
+  "int_embed R (x-y) = int_embed R x \<ominus>\<^bsub>R\<^esub> int_embed R y"
+  (is "?lhs = ?rhs")
+proof -
+  have "?lhs = int_embed R (x + (-y))"  by simp
+  also have "... = ?rhs"
+    by (subst int_embed_add, simp add:a_minus_def int_embed_inv)
+  finally show ?thesis by simp
+qed
+
+lemma (in ring) int_embed_mult_aux:
+  "int_embed R (x*int y) = int_embed R x \<otimes> int_embed R y"
+proof (induction y)
+  case 0
+  then show ?case by (simp add:int_embed_closed int_embed_zero)
+next
+  case (Suc y)
+  have "int_embed R (x * int (Suc y)) = int_embed R (x + x * int y)"
+    by (simp add:algebra_simps) 
+  also have "... = int_embed R x \<oplus> int_embed R (x * int y)"
+    by (subst int_embed_add, simp)
+  also have 
+    "... = int_embed R x \<otimes> \<one> \<oplus> int_embed R x \<otimes> int_embed R y"
+    using int_embed_closed
+    by (subst Suc, simp)
+  also have "... = int_embed R x \<otimes> (int_embed R 1 \<oplus> int_embed R y)"
+    using int_embed_closed by (subst r_distr, simp_all add:int_embed_one)
+  also have "... = int_embed R x \<otimes> int_embed R (1+int y)"
+    by (subst int_embed_add, simp)
+  also have "... = int_embed R x \<otimes> int_embed R (Suc y)"
+    by simp
+  finally show ?case by simp
+qed
+
+lemma (in ring) int_embed_mult:
+  "int_embed R (x*y) = int_embed R x \<otimes>\<^bsub>R\<^esub> int_embed R y"
+proof (cases "y \<ge> 0")
+  case True
+  then obtain y' where y_def: "y = int y'"
+    using nonneg_int_cases by auto
+  have "int_embed R (x * y) = int_embed R (x * int y')"
+    unfolding y_def by simp
+  also have "... = int_embed R x \<otimes> int_embed R y'"
+    by (subst int_embed_mult_aux, simp)
+  also have "... = int_embed R x \<otimes> int_embed R y"
+    unfolding y_def by simp
+  finally show ?thesis by simp
+next
+  case False
+  then obtain y' where y_def: "y = - int y'" 
+    by (meson nle_le nonpos_int_cases)
+  have "int_embed R (x * y) = int_embed R (-(x * int y'))"
+    unfolding y_def by simp
+  also have "... = \<ominus> (int_embed R (x * int y'))"
+    by (subst int_embed_inv, simp)
+  also have "... = \<ominus> (int_embed R x \<otimes> int_embed R y')"
+    by (subst int_embed_mult_aux, simp)
+  also have "... = int_embed R x \<otimes> \<ominus> int_embed R y'"
+    using int_embed_closed by algebra
+  also have "... = int_embed R x \<otimes> int_embed R (-y')"
+    by (subst int_embed_inv, simp)
+  also have "... = int_embed R x \<otimes> int_embed R y"
+    unfolding y_def by simp
+  finally show ?thesis by simp
+qed
+
+lemma (in ring) int_embed_ring_hom: 
+  "ring_hom_ring int_ring R (int_embed R)"
+proof (rule ring_hom_ringI) 
+  show "ring int_ring" using int.is_ring by simp
+  show "ring R" using ring_axioms by simp
+  show "int_embed R x \<in> carrier R" if "x \<in> carrier \<Z>" for x
+    using int_embed_closed by simp
+  show "int_embed R (x\<otimes>\<^bsub>\<Z>\<^esub>y) = int_embed R x \<otimes> int_embed R y" 
+    if "x \<in> carrier \<Z>" "y \<in> carrier \<Z>" for x y 
+    using int_embed_mult by simp
+  show "int_embed R (x\<oplus>\<^bsub>\<Z>\<^esub>y) = int_embed R x \<oplus> int_embed R y" 
+    if "x \<in> carrier \<Z>" "y \<in> carrier \<Z>" for x y 
+    using int_embed_add by simp
+  show "int_embed R \<one>\<^bsub>\<Z>\<^esub> = \<one>"
+    by (simp add:int_embed_one)
+qed
+
+abbreviation char_subring where
+  "char_subring R \<equiv> int_embed R ` UNIV"
+
+definition char where 
+  "char R = card (char_subring R)"
+
+text \<open>This is a non-standard definition for the characteristic of a ring. 
+
+Commonly~\cite[Definition 1.43]{lidl1986} it is defined to be the smallest natural number $n$ such
+that n-times repeated addition of any number is zero. If no such number exists then it is defined 
+to be $0$. In the case of rings with unit elements --- not that the locale @{locale "ring"} requires
+unit elements --- the above definition can be simplified to the number of times the unit elements
+needs to be repeatedly added to reach $0$.
+
+The following three lemmas imply that the definition of the characteristic here coincides with the
+latter definition.\<close>
+
+lemma (in ring) char_bound:
+  assumes "x > 0"
+  assumes "int_embed R (int x) = \<zero>"
+  shows "char R \<le> x" "char R > 0"
+proof -
+  have "char_subring R \<subseteq> int_embed R ` ({0..<int x})"
+  proof (rule image_subsetI)
+    fix y :: int
+    assume "y \<in> UNIV"
+    define u where "u = y div (int x)"
+    define v where "v = y mod (int x)"
+    have "int x > 0" using assms by simp
+    hence y_exp: "y = u * int x + v" "v \<ge> 0" "v < int x"
+      unfolding u_def v_def by simp_all
+    have "int_embed R y = int_embed R v"
+      using int_embed_closed unfolding y_exp
+      by (simp add:int_embed_mult int_embed_add assms(2))
+    also have "... \<in> int_embed R ` ({0..<int x})"
+      using y_exp(2,3) by simp
+    finally show "int_embed R y \<in> int_embed R ` {0..<int x}"
+      by simp
+  qed
+  hence a:"char_subring R = int_embed R ` {0..<int x}"
+    by auto
+  hence "char R = card (int_embed R ` ({0..<int x}))"
+    unfolding char_def a by simp
+  also have "... \<le> card {0..<int x}"
+    by (intro card_image_le, simp)
+  also have "... = x" by simp
+  finally show "char R \<le> x" by simp
+  have "1 = card {int_embed R 0}" by simp
+  also have "... \<le> card (int_embed R ` {0..<int x})"
+    using assms(1) by (intro card_mono finite_imageI, simp_all) 
+  also have "... = char R"
+    unfolding char_def a by simp
+  finally show "char R > 0" by simp
+qed
+
+lemma (in ring) embed_char_eq_0:
+  "int_embed R (int (char R)) = \<zero>"
+proof (cases "finite (char_subring R)")
+  case True
+  interpret h: ring_hom_ring "int_ring" R "(int_embed R)"
+    using int_embed_ring_hom by simp
+
+  define A where "A = {0..int (char R)}"
+  have "card (int_embed R ` A) \<le> card (char_subring R)"
+    by (intro card_mono[OF True] image_subsetI, simp)
+  also have "... = char R"
+    unfolding char_def by simp
+  also have "... < card A"
+    unfolding A_def by simp
+  finally have "card (int_embed R ` A) < card A" by simp
+  hence "\<not>inj_on (int_embed R) A"
+    using pigeonhole by simp
+  then obtain x y where xy: 
+    "x \<in> A" "y \<in> A" "x \<noteq> y" "int_embed R x = int_embed R y"
+    unfolding inj_on_def by auto
+  define v where "v = nat (max x y - min x y)"
+  have a:"int_embed R v = \<zero>"
+    using xy int_embed_closed
+    by (cases "x < y", simp_all add:int_embed_diff v_def)
+  moreover have "v > 0"
+    using xy by (cases "x < y", simp_all add:v_def)
+  ultimately have "char R \<le> v" using char_bound by simp
+  moreover have "v \<le> char R"
+    using xy v_def A_def by (cases "x < y", simp_all)
+  ultimately have "char R = v" by simp
+  then show ?thesis using a by simp
+next
+  case False
+  hence "char R = 0" 
+    unfolding char_def by simp
+  then show ?thesis by (simp add:int_embed_zero)
+qed
+
+lemma (in ring) embed_char_eq_0_iff:
+  fixes n :: int
+  shows "int_embed R n = \<zero> \<longleftrightarrow> char R dvd n"
+proof (cases "char R > 0")
+  case True
+  define r where "r = n mod char R"
+  define s where "s = n div char R"
+  have rs: "r < char R" "r \<ge> 0" "n = r + s * char R" 
+    using True by (simp_all add:r_def s_def)
+
+  have "int_embed R n = int_embed R r"
+    using int_embed_closed unfolding rs(3)
+    by (simp add: int_embed_add  int_embed_mult embed_char_eq_0)
+
+  moreover have "nat r < char R" using rs by simp
+  hence "int_embed R (nat r) \<noteq> \<zero> \<or> nat r = 0"
+    using True char_bound not_less by blast
+  hence "int_embed R r \<noteq> \<zero> \<or> r = 0"
+    using rs by simp
+
+  ultimately have "int_embed R n = \<zero> \<longleftrightarrow> r = 0"
+    using int_embed_zero by auto
+  also have "r = 0 \<longleftrightarrow> char R dvd n"
+    using r_def by auto
+  finally show ?thesis by simp
+next
+  case False
+  hence "char R = 0" by simp
+  hence a:"x > 0 \<Longrightarrow> int_embed R (int x) \<noteq> \<zero>" for x
+    using char_bound by auto
+
+  have c:"int_embed R (abs x) \<noteq> \<zero> \<longleftrightarrow> int_embed R x \<noteq> \<zero>" for x
+    using int_embed_closed
+    by (cases "x > 0", simp, simp add:int_embed_inv)
+  
+  have "int_embed R x \<noteq> \<zero>" if b:"x \<noteq> 0" for x
+  proof -
+    have "nat (abs x) > 0" using b by simp
+    hence "int_embed R (nat (abs x)) \<noteq> \<zero>"
+      using a by blast
+    hence "int_embed R (abs x) \<noteq> \<zero>" by simp
+    thus ?thesis using c by simp
+  qed
+  hence "int_embed R n = \<zero> \<longleftrightarrow> n = 0" 
+    using int_embed_zero by auto
+  also have "n = 0 \<longleftrightarrow> char R dvd n" using False by simp
+  finally show ?thesis by simp
+qed
+
+text \<open>This result can be found in \cite[Theorem 1.44]{lidl1986}.\<close>
+
+lemma (in domain) characteristic_is_prime:
+  assumes "char R > 0"
+  shows "prime (char R)"
+proof (rule ccontr)
+  have "\<not>(char R = 1)"
+    using embed_char_eq_0 int_embed_one by auto
+  hence "\<not>(char R dvd 1)" using assms(1) by simp
+  moreover assume "\<not>(prime (char R))"
+  hence "\<not>(irreducible (char R))"
+    using irreducible_imp_prime_elem_gcd prime_elem_nat_iff by blast
+  ultimately obtain p q where pq_def: "p * q = char R" "p > 1" "q > 1" 
+    using assms
+    unfolding Factorial_Ring.irreducible_def by auto
+  have "int_embed R p \<otimes> int_embed R q = \<zero>"
+    using embed_char_eq_0 pq_def 
+    by (subst int_embed_mult[symmetric]) (metis of_nat_mult)
+  hence "int_embed R p = \<zero> \<or> int_embed R q = \<zero>"
+    using integral int_embed_closed by simp
+  hence "p*q \<le> p \<or> p*q \<le> q"
+    using char_bound pq_def by auto
+  thus "False"
+    using pq_def(2,3) by simp
+qed
+
+lemma (in ring) char_ring_is_subring:
+  "subring (char_subring R) R"
+proof -
+  have "subring (int_embed R ` carrier int_ring) R"
+    by (intro ring.carrier_is_subring int.is_ring
+        ring_hom_ring.img_is_subring[OF int_embed_ring_hom]) 
+  thus ?thesis by simp
+qed
+
+lemma (in cring) char_ring_is_subcring:
+  "subcring (char_subring R) R"
+  using subcringI'[OF char_ring_is_subring] by auto
+
+lemma (in domain) char_ring_is_subdomain:
+  "subdomain (char_subring R) R"
+  using subdomainI'[OF char_ring_is_subring] by auto
+
+lemma image_set_eqI:
+  assumes "\<And>x. x \<in> A \<Longrightarrow> f x \<in> B"
+  assumes "\<And>x. x \<in> B \<Longrightarrow> g x \<in> A \<and> f (g x) = x" 
+  shows  "f ` A = B"
+  using assms by force
+
+text \<open>This is the binomial expansion theorem for commutative rings.\<close>
+
+lemma (in cring) binomial_expansion:
+  fixes n :: nat
+  assumes [simp]: "x \<in> carrier R" "y \<in> carrier R"
+  shows "(x \<oplus> y) [^] n = 
+    (\<Oplus>k \<in> {..n}. int_embed R (n choose k) \<otimes> x [^] k \<otimes> y [^] (n-k))" 
+proof -
+  define A where "A = (\<lambda>k. {A. A \<subseteq> {..<n} \<and> card A = k})"
+
+  have fin_A: "finite (A i)" for i 
+    unfolding A_def by simp
+  have disj_A: "pairwise (\<lambda>i j. disjnt (A i) (A j)) {..n}" 
+    unfolding pairwise_def disjnt_def A_def by auto
+  have card_A: "B \<in> A i \<Longrightarrow> card B = i" if " i \<in> {..n}" for i B 
+    unfolding A_def by simp
+  have card_A2: "card (A i) = (n choose i)" if "i \<in> {..n}" for i 
+    unfolding A_def using n_subsets[where A="{..<n}"] by simp
+
+  have card_bound: "card A \<le> n"
+    if "A \<subseteq> {..<n}" for n A 
+    by (metis card_lessThan finite_lessThan card_mono that)
+  have card_insert: "card (insert n A) = card A + 1"
+    if "A \<subseteq> {..<(n::nat)}" for n A 
+    using finite_subset that by (subst card_insert_disjoint, auto)
+
+  have embed_distr: "[m] \<cdot> y = int_embed R (int m) \<otimes> y" 
+    if "y \<in> carrier R" for m y
+    unfolding int_embed_def add_pow_def using that
+    by (simp add:add_pow_def[symmetric] int_pow_int add_pow_ldistr)
+
+  have "(x \<oplus> y) [^] n = 
+    (\<Oplus>A \<in> Pow {..<n}. x [^] (card A) \<otimes> y [^] (n-card A))"
+  proof (induction n)
+    case 0
+    then show ?case by simp
+  next
+    case (Suc n)
+    have s1: 
+      "insert n ` Pow {..<n} = {A. A \<subseteq> {..<n+1} \<and> n \<in> A}" 
+      by (intro image_set_eqI[where g="\<lambda>x. x \<inter> {..<n}"], auto) 
+    have s2:
+      "Pow {..<n} = {A. A \<subseteq> {..<n+1} \<and> n \<notin> A}" 
+      using lessThan_Suc by auto
+
+    have "(x \<oplus> y) [^] Suc n = (x \<oplus> y) [^] n \<otimes> (x \<oplus> y)" by simp
+    also have "... = 
+      (\<Oplus>A \<in> Pow {..<n}. x [^] (card A) \<otimes> y [^] (n-card A)) \<otimes> 
+      (x \<oplus> y)"
+      by (subst Suc, simp)
+    also have "... = 
+      (\<Oplus>A \<in> Pow {..<n}. x [^] (card A) \<otimes> y [^] (n-card A)) \<otimes> x \<oplus>
+      (\<Oplus>A \<in> Pow {..<n}. x [^] (card A) \<otimes> y [^] (n-card A)) \<otimes> y"
+      by (subst r_distr, auto)
+    also have "... = 
+      (\<Oplus>A \<in> Pow {..<n}. x [^] (card A) \<otimes> y [^] (n-card A) \<otimes> x) \<oplus>
+      (\<Oplus>A \<in> Pow {..<n}. x [^] (card A) \<otimes> y [^] (n-card A) \<otimes> y)"
+      by (simp add:finsum_ldistr)
+    also have "... = 
+      (\<Oplus>A \<in> Pow {..<n}. x [^] (card A+1) \<otimes> y [^] (n-card A)) \<oplus>
+      (\<Oplus>A \<in> Pow {..<n}. x [^] (card A) \<otimes> y [^] (n-card A+1))"
+      using m_assoc m_comm 
+      by (intro arg_cong2[where f="(\<oplus>)"] finsum_cong', auto)
+    also have "... = 
+      (\<Oplus>A \<in> Pow {..<n}. x [^] (card (insert n A)) 
+        \<otimes> y [^] (n+1-card (insert n A))) \<oplus>
+      (\<Oplus>A \<in> Pow {..<n}. x [^] (card A) \<otimes> y [^] (n+1-card A))"
+      using finite_subset card_bound card_insert Suc_diff_le
+      by (intro arg_cong2[where f="(\<oplus>)"] finsum_cong', simp_all)
+    also have "... = 
+      (\<Oplus>A \<in> insert n ` Pow {..<n}. x [^] (card A) 
+        \<otimes> y [^] (n+1-card A)) \<oplus>
+      (\<Oplus>A \<in> Pow {..<n}. x [^] (card A) \<otimes> y [^] (n+1-card A))"
+      by (subst finsum_reindex, auto simp add:inj_on_def) 
+    also have "... = 
+      (\<Oplus>A \<in> {A. A \<subseteq> {..<n+1} \<and> n \<in> A}. 
+        x [^] (card A) \<otimes> y [^] (n+1-card A)) \<oplus>
+      (\<Oplus>A \<in> {A. A \<subseteq> {..<n+1} \<and> n \<notin> A}. 
+        x [^] (card A) \<otimes> y [^] (n+1-card A))"
+      by (intro arg_cong2[where f="(\<oplus>)"] finsum_cong' s1 s2, simp_all)
+    also have "... = (\<Oplus>A \<in> 
+      {A. A \<subseteq> {..<n+1} \<and> n \<in> A} \<union> {A. A \<subseteq> {..<n+1} \<and> n \<notin> A}. 
+        x [^] (card A) \<otimes> y [^] (n+1-card A))"
+      by (subst finsum_Un_disjoint, auto)
+    also have "... = 
+      (\<Oplus>A \<in> Pow {..<n+1}. x [^] (card A) \<otimes> y [^] (n+1-card A))"
+      by (intro finsum_cong', auto)
+    finally show ?case by simp
+  qed
+  also have "... = 
+    (\<Oplus>A \<in> (\<Union> (A ` {..n})). x [^] (card A) \<otimes> y [^] (n-card A))"
+    using card_bound by (intro finsum_cong', auto simp add:A_def)
+  also have "... = 
+    (\<Oplus> k \<in> {..n}. (\<Oplus> A \<in> A k. x [^] (card A) \<otimes> y [^] (n-card A)))"
+    using fin_A disj_A by (subst add.finprod_UN_disjoint, auto)
+  also have "... = (\<Oplus> k \<in> {..n}. (\<Oplus> A \<in> A k. x [^] k \<otimes> y [^] (n-k)))"
+    using card_A by (intro finsum_cong', auto)
+  also have "... = 
+    (\<Oplus> k \<in> {..n}. int_embed R (card (A k)) \<otimes> x [^] k \<otimes> y [^] (n-k))"
+    using int_embed_closed
+    by (subst add.finprod_const, simp_all add:embed_distr m_assoc)
+  also have "... = 
+    (\<Oplus> k \<in> {..n}. int_embed R (n choose k) \<otimes> x [^] k \<otimes> y [^] (n-k))"
+    using int_embed_closed card_A2 by (intro finsum_cong', simp_all)
+  finally show ?thesis by simp
+qed
+
+lemma bin_prime_factor:
+  assumes "prime p"
+  assumes "k > 0" "k < p"
+  shows "p dvd (p choose k)"
+proof -
+  have "p dvd fact p" 
+    using assms(1) prime_dvd_fact_iff by auto
+  hence "p dvd fact k * fact (p - k) * (p choose k)"
+    using binomial_fact_lemma assms by simp
+  hence "p dvd fact k \<or> p dvd fact (p-k) \<or> p dvd (p choose k)"
+    by (simp add: assms(1) prime_dvd_mult_eq_nat)
+  thus "p dvd (p choose k)"
+    using assms(1,2,3) prime_dvd_fact_iff by auto
+qed
+
+theorem (in domain) freshmans_dream:
+  assumes "char R > 0"
+  assumes [simp]: "x \<in> carrier R" "y \<in> carrier R"
+  shows "(x \<oplus> y) [^] (char R) = x [^] char R \<oplus> y [^] char R" 
+    (is "?lhs = ?rhs")
+proof -
+  have c:"prime (char R)"
+    using assms(1) characteristic_is_prime by auto
+  have a:"int_embed R (char R choose i) = \<zero>" 
+    if "i \<in> {..char R} - {0, char R}" for i
+  proof -
+    have "i > 0" "i < char R" using that by auto
+    hence "char R dvd char R choose i"
+      using c bin_prime_factor by simp
+    thus ?thesis using embed_char_eq_0_iff by simp
+  qed
+
+  have "?lhs = (\<Oplus>k \<in> {..char R}. int_embed R (char R choose k) 
+    \<otimes> x [^] k \<otimes> y [^] (char R-k))"
+    using binomial_expansion[OF assms(2,3)] by simp
+  also have "... = (\<Oplus>k \<in> {0,char R}.int_embed R (char R choose k) 
+    \<otimes> x [^] k \<otimes> y [^] (char R-k))"
+    using a int_embed_closed
+    by (intro add.finprod_mono_neutral_cong_right, simp, simp_all)
+  also have "... = ?rhs"
+    using int_embed_closed assms(1) by (simp add:int_embed_one a_comm)
+  finally show ?thesis by simp
+qed
+
+text \<open>The following theorem is somtimes called Freshman's dream for obvious reasons,
+it can be found in Lidl and Niederreiter~\cite[Theorem 1.46]{lidl1986}.\<close>
+
+lemma (in domain) freshmans_dream_ext:
+  fixes m
+  assumes "char R > 0"
+  assumes [simp]: "x \<in> carrier R" "y \<in> carrier R"
+  defines "n \<equiv> char R^m" 
+  shows "(x \<oplus> y) [^] n = x [^] n \<oplus> y [^] n"
+    (is "?lhs = ?rhs")
+  unfolding n_def
+proof (induction m)
+  case 0
+  then show ?case by simp
+next
+  case (Suc m)
+  have "(x \<oplus> y) [^] (char R^(m+1)) = 
+    (x \<oplus> y) [^] (char R^m * char R)"
+    by (simp add:mult.commute)
+  also have "... = ((x \<oplus> y) [^] (char R^m)) [^] char R"
+    using nat_pow_pow by simp
+  also have "... = (x [^] (char R^m) \<oplus> y [^] (char R^m)) [^] char R"
+    by (subst Suc, simp)
+  also have "... = 
+    (x [^] (char R^m)) [^] char R \<oplus> (y [^] (char R^m)) [^] char R"
+    by (subst freshmans_dream[OF assms(1), symmetric], simp_all)
+  also have "... = 
+    x [^] (char R^m * char R) \<oplus> y [^] (char R^m * char R)"
+    by (simp add:nat_pow_pow)
+  also have "... = x [^] (char R^Suc m) \<oplus> y [^] (char R^Suc m)"
+    by (simp add:mult.commute)
+  finally show ?case by simp
+qed
+
+text \<open>The following is a generalized version of the Frobenius homomorphism. The classic version
+of the theorem is the case where @{term "(k::nat) = 1"}.\<close>
+
+theorem (in domain) frobenius_hom:
+  assumes "char R  > 0"
+  assumes "m = char R ^ k"
+  shows "ring_hom_cring R R (\<lambda>x. x [^] m)"
+proof -
+  have a:"(x \<otimes> y) [^] m = x [^] m \<otimes> y [^] m" 
+    if b:"x \<in> carrier R" "y \<in> carrier R" for x y 
+    using b nat_pow_distrib by simp
+  have b:"(x \<oplus> y) [^] m = x [^] m \<oplus> y [^] m"
+    if b:"x \<in> carrier R" "y \<in> carrier R" for x y 
+    unfolding assms(2) freshmans_dream_ext[OF assms(1) b] 
+    by simp
+
+  have "ring_hom_ring R R (\<lambda>x. x [^] m)"
+    by  (intro ring_hom_ringI a b is_ring, simp_all) 
+
+  thus "?thesis"
+    using RingHom.ring_hom_cringI is_cring by blast
+qed
+
+lemma (in domain) char_ring_is_subfield:
+  assumes "char R > 0"
+  shows "subfield (char_subring R) R"
+proof -
+  interpret d:domain "R \<lparr> carrier := char_subring R \<rparr>"
+    using char_ring_is_subdomain subdomain_is_domain by simp
+
+  have "finite (char_subring R)" 
+    using char_def assms by (metis card_ge_0_finite)
+  hence "Units (R \<lparr> carrier := char_subring R \<rparr>) 
+    = char_subring R - {\<zero>}"
+    using d.finite_domain_units by simp
+
+  thus ?thesis
+    using subfieldI[OF char_ring_is_subcring] by simp
+qed
+
+lemma card_lists_length_eq': 
+  fixes A :: "'a set"
+  shows "card {xs. set xs \<subseteq> A \<and> length xs = n} = card A ^ n" 
+proof (cases "finite A")
+  case True
+  then show ?thesis using card_lists_length_eq by auto
+next
+  case False
+  hence inf_A: "infinite A" by simp
+  show ?thesis
+  proof (cases "n = 0")
+    case True
+    hence "card {xs. set xs \<subseteq> A \<and> length xs = n} = card {([] :: 'a list)}"
+      by (intro arg_cong[where f="card"], auto simp add:set_eq_iff)
+    also have "... = 1" by simp
+    also have "... = card A^n" using True inf_A by simp
+    finally show ?thesis by simp 
+  next
+    case False
+    hence "inj (replicate n)" 
+      by (meson inj_onI replicate_eq_replicate)
+    hence "inj_on (replicate n) A" using inj_on_subset 
+      by (metis subset_UNIV) 
+    hence "infinite (replicate n ` A)"
+      using inf_A finite_image_iff by auto
+    moreover have 
+      "replicate n ` A \<subseteq> {xs. set xs \<subseteq> A \<and> length xs  = n}"
+      by (intro image_subsetI, auto)
+    ultimately have "infinite {xs. set xs \<subseteq> A \<and> length xs  = n}"
+      using infinite_super by auto
+    hence "card {xs. set xs \<subseteq> A \<and> length xs  = n} = 0" by simp
+    then show ?thesis using inf_A False by simp
+  qed
+qed
+
+lemma (in ring) card_span:
+  assumes "subfield K R"
+  assumes "independent K w"
+  assumes "set w \<subseteq> carrier R"
+  shows "card (Span K w) = card K^(length w)"
+proof -
+  define A where "A = {x. set x \<subseteq> K \<and> length x = length w}"
+  define f where "f = (\<lambda>x. combine x w)"
+
+  have "x \<in> f ` A" if a:"x \<in> Span K w" for x
+  proof -
+    obtain y where "y \<in> A" "x = f y"
+      unfolding A_def f_def
+      using unique_decomposition[OF assms(1,2) a] by auto
+    thus ?thesis by simp
+  qed
+  moreover have "f x \<in> Span K w" if a: "x \<in> A" for x
+    using Span_eq_combine_set[OF assms(1,3)] a
+    unfolding A_def f_def by auto
+  ultimately have b:"Span K w = f ` A" by auto
+
+  have "False" if a: "x \<in> A" "y \<in> A" "f x = f y" "x \<noteq> y" for x y
+  proof -
+    have "f x \<in> Span K w" using b a by simp
+    thus "False" 
+      using a unique_decomposition[OF assms(1,2)]
+      unfolding f_def A_def by blast
+  qed
+  hence f_inj: "inj_on f A" 
+    unfolding inj_on_def by auto
+
+  have "card (Span K w) = card (f ` A)" using b by simp
+  also have "... = card A" by (intro card_image f_inj) 
+  also have "... = card K^length w"
+    unfolding A_def by (intro card_lists_length_eq')
+  finally show ?thesis by simp
+qed
+
+lemma (in ring) finite_carr_imp_char_ge_0:
+  assumes "finite (carrier R)"
+  shows "char R > 0"
+proof -
+  have "char_subring R \<subseteq> carrier R"
+    using int_embed_closed by auto
+  hence "finite (char_subring R)"
+    using finite_subset assms by auto
+  hence "card (char_subring R) > 0"
+    using card_range_greater_zero by simp
+  thus "char R > 0" 
+    unfolding char_def by simp
+qed
+
+lemma (in ring) char_consistent:
+  assumes "subring H R"
+  shows "char (R \<lparr> carrier := H \<rparr>) = char R"
+proof -
+  show ?thesis
+    using int_embed_consistent[OF assms(1)]
+    unfolding char_def by simp
+qed
+
+lemma (in ring_hom_ring) char_consistent:
+  assumes "inj_on h (carrier R)"
+  shows "char R = char S"
+proof -
+  have a:"h (int_embed R (int n)) = int_embed S (int n)" for n
+    using R.int_embed_range[OF R.carrier_is_subring]
+    using R.int_embed_range[OF R.carrier_is_subring]
+    using S.int_embed_one R.int_embed_one
+    using S.int_embed_zero R.int_embed_zero
+    using S.int_embed_add R.int_embed_add
+    by (induction n, simp_all)
+
+  have b:"h (int_embed R (-(int n))) = int_embed S (-(int n))" for n
+    using R.int_embed_range[OF R.carrier_is_subring]
+    using S.int_embed_range[OF S.carrier_is_subring] a
+    by (simp add:R.int_embed_inv S.int_embed_inv)
+
+  have c:"h (int_embed R n) = int_embed S n" for n
+  proof (cases "n \<ge> 0")
+    case True
+    then obtain m where "n = int m"
+      using nonneg_int_cases by auto
+    then show ?thesis 
+      by (simp add:a)
+  next
+    case False
+    hence "n \<le> 0" by simp
+    then obtain m where "n = -int m" 
+      using nonpos_int_cases by auto
+    then show ?thesis by (simp add:b)
+  qed
+
+  have "char S = card (h ` char_subring R)"
+    unfolding char_def image_image c by simp
+  also have "... = card (char_subring R)"
+    using R.int_embed_range[OF R.carrier_is_subring]
+    by (intro card_image inj_on_subset[OF assms(1)]) auto 
+  also have "... = char R" unfolding char_def by simp
+  finally show ?thesis
+    by simp
+qed
+
+definition char_iso :: "_ \<Rightarrow> int set \<Rightarrow> 'a" 
+  where "char_iso R x = the_elem (int_embed R ` x)"
+
+text \<open>The function @{term "char_iso R"} denotes the isomorphism between @{term "ZFact (char R)"} and
+the characteristic subring.\<close>
+
+lemma (in ring) char_iso: "char_iso R \<in> 
+  ring_iso (ZFact (char R)) (R\<lparr>carrier := char_subring R\<rparr>)"
+proof -
+  interpret h: ring_hom_ring "int_ring" "R" "int_embed R"
+    using int_embed_ring_hom by simp
+
+  have "a_kernel \<Z> R (int_embed R) = {x. int_embed R x = \<zero>}"
+    unfolding a_kernel_def kernel_def by simp
+  also have "... = {x. char R dvd x}"
+    using embed_char_eq_0_iff by simp
+  also have "... = PIdl\<^bsub>\<Z>\<^esub> (int (char R))" 
+    unfolding cgenideal_def by auto
+  also have "... = Idl\<^bsub>\<Z>\<^esub> {int (char R)}"
+    using int.cgenideal_eq_genideal by simp
+  finally have a:"a_kernel \<Z> R (int_embed R) = Idl\<^bsub>\<Z>\<^esub> {int (char R)}"
+    by simp
+  show  "?thesis"
+    unfolding char_iso_def ZFact_def a[symmetric]
+    by (intro h.FactRing_iso_set_aux)
+qed
+
+text \<open>The size of a finite field must be a prime power.
+This can be found in Ireland and Rosen~\cite[Proposition 7.1.3]{ireland1982}.\<close>
+
+theorem (in finite_field) finite_field_order:
+  "\<exists>n. order R = char R ^ n \<and> n > 0"
+proof -
+  have a:"char R > 0"
+    using finite_carr_imp_char_ge_0[OF finite_carrier]
+    by simp
+  let ?CR = "char_subring R"
+
+  obtain v where v_def: "set v = carrier R"
+    using finite_carrier finite_list by auto
+  hence b:"set v \<subseteq> carrier R" by auto
+
+  have "carrier R = set v" using v_def by simp
+  also have "... \<subseteq> Span ?CR v"
+    using Span_base_incl[OF char_ring_is_subfield[OF a] b] by simp
+  finally have "carrier R \<subseteq> Span ?CR v" by simp
+  moreover have "Span ?CR v \<subseteq> carrier R"
+    using int_embed_closed v_def by (intro Span_in_carrier, auto)
+  ultimately have Span_v: "Span ?CR v = carrier R" by simp
+
+  obtain w where w_def: 
+    "set w \<subseteq> carrier R" 
+    "independent ?CR w" 
+    "Span ?CR v = Span ?CR w"
+    using b filter_base[OF char_ring_is_subfield[OF a]]
+    by metis
+
+  have Span_w: "Span ?CR w = carrier R"
+    using w_def(3) Span_v by simp
+
+  hence "order R = card (Span ?CR w)" by (simp add:order_def)
+  also have "... = card ?CR^length w"
+    by (intro card_span char_ring_is_subfield[OF a] w_def(1,2))
+  finally have c:
+    "order R = char R^(length w)"
+    by (simp add:char_def)
+  have "length w > 0"
+    using finite_field_min_order c by auto
+  thus ?thesis using c by auto
+qed
+
+end
diff --git a/thys/Finite_Fields/document/root.bib b/thys/Finite_Fields/document/root.bib
new file mode 100644
--- /dev/null
+++ b/thys/Finite_Fields/document/root.bib
@@ -0,0 +1,42 @@
+@book{ireland1982,
+  author    = {Kenneth Ireland and
+               Michael Rosen},
+  title     = {A classical introduction to modern number theory},
+  series    = {Graduate texts in mathematics},
+  volume    = {84},
+  publisher = {Springer},
+  year      = {1982},
+  isbn      = {978-0-387-90625-6},
+  timestamp = {Fri, 28 Jun 2019 12:45:52 +0200},
+  biburl    = {https://dblp.org/rec/books/daglib/0068082.bib},
+  bibsource = {dblp computer science bibliography, https://dblp.org}
+}
+
+@book{lidl1986,
+author = {Lidl, Rudolf and Niederreiter, Harald},
+title = {Introduction to Finite Fields and Their Applications},
+year = {1986},
+isbn = {0521307066},
+publisher = {Cambridge University Press},
+address = {USA}
+}
+
+@article{chebolu2010,
+  title={Counting Irreducible Polynomials over Finite Fields Using the Inclusion-Exclusion Principle},
+  author={Sunil K. Chebolu and J{\'a}n Min{\'a}{\v{c}}},
+  journal={Mathematics Magazine},
+  year={2010},
+  volume={84},
+  pages={369 - 371}
+}
+
+@article{Dirichlet_Series-AFP,
+  author  = {Manuel Eberl},
+  title   = {Dirichlet Series},
+  journal = {Archive of Formal Proofs},
+  month   = oct,
+  year    = 2017,
+  note    = {\url{https://isa-afp.org/entries/Dirichlet_Series.html},
+            Formal proof development},
+  ISSN    = {2150-914x},
+}
\ No newline at end of file
diff --git a/thys/Finite_Fields/document/root.tex b/thys/Finite_Fields/document/root.tex
new file mode 100644
--- /dev/null
+++ b/thys/Finite_Fields/document/root.tex
@@ -0,0 +1,37 @@
+\documentclass[11pt,a4paper]{article}
+\usepackage[T1]{fontenc}
+\usepackage{isabelle,isabellesym}
+\usepackage{amssymb}
+\usepackage{pdfsetup}
+\urlstyle{rm}
+\isabellestyle{it}
+
+\begin{document}
+
+\title{Finite Fields}
+\author{Emin Karayel}
+\maketitle
+
+\abstract{This entry formalizes the classification of the finite fields (also called Galois fields):
+For each prime power $p^n$ there exists exactly one (up to isomorphisms) finite field of that size
+and there are no other finite fields.
+The derivation includes a formalization of the characteristic of rings, the Frobenius endomorphism, 
+formal differentiation for polynomials in HOL-Algebra and Gauss' formula for the number of
+monic irreducible polynomials over finite fields:
+\[
+\frac{1}{n} \sum_{d | n} \mu(d) p^{n/d} \textrm{.}
+\]
+The proofs are based on the books from Ireland and Rosen~\cite{ireland1982}, as well as,
+Lidl and Niederreiter~\cite{lidl1986}.
+}
+  
+\parindent 0pt\parskip 0.5ex
+
+\tableofcontents
+
+\input{session}
+
+\bibliographystyle{abbrv}
+\bibliography{root}
+
+\end{document}
\ No newline at end of file
diff --git a/thys/ROOTS b/thys/ROOTS
--- a/thys/ROOTS
+++ b/thys/ROOTS
@@ -1,685 +1,686 @@
 ADS_Functor
 AI_Planning_Languages_Semantics
 AODV
 AVL-Trees
 AWN
 Abortable_Linearizable_Modules
 Abs_Int_ITP2012
 Abstract-Hoare-Logics
 Abstract-Rewriting
 Abstract_Completeness
 Abstract_Soundness
 Ackermanns_not_PR
 Actuarial_Mathematics
 Adaptive_State_Counting
 Affine_Arithmetic
 Aggregation_Algebras
 Akra_Bazzi
 Algebraic_Numbers
 Algebraic_VCs
 Allen_Calculus
 Amicable_Numbers
 Amortized_Complexity
 AnselmGod
 Applicative_Lifting
 Approximation_Algorithms
 Architectural_Design_Patterns
 Aristotles_Assertoric_Syllogistic
 Arith_Prog_Rel_Primes
 ArrowImpossibilityGS
 Attack_Trees
 Auto2_HOL
 Auto2_Imperative_HOL
 AutoFocus-Stream
 Automated_Stateful_Protocol_Verification
 Automatic_Refinement
 AxiomaticCategoryTheory
 BDD
 BD_Security_Compositional
 BNF_CC
 BNF_Operations
 BTree
 Banach_Steinhaus
 Belief_Revision
 Bell_Numbers_Spivey
 BenOr_Kozen_Reif
 Berlekamp_Zassenhaus
 Bernoulli
 Bertrands_Postulate
 Bicategory
 BinarySearchTree
 Binding_Syntax_Theory
 Binomial-Heaps
 Binomial-Queues
 BirdKMP
 Blue_Eyes
 Bondy
 Boolean_Expression_Checkers
 Bounded_Deducibility_Security
 Buchi_Complementation
 Budan_Fourier
 Buffons_Needle
 Buildings
 BytecodeLogicJmlTypes
 C2KA_DistributedSystems
 CAVA_Automata
 CAVA_LTL_Modelchecker
 CCS
 CISC-Kernel
 CRDT
 CSP_RefTK
 CYK
 CZH_Elementary_Categories
 CZH_Foundations
 CZH_Universal_Constructions
 CakeML
 CakeML_Codegen
 Call_Arity
 Card_Equiv_Relations
 Card_Multisets
 Card_Number_Partitions
 Card_Partitions
 Cartan_FP
 Case_Labeling
 Catalan_Numbers
 Category
 Category2
 Category3
 Cauchy
 Cayley_Hamilton
 Certification_Monads
 Chandy_Lamport
 Chord_Segments
 Circus
 Clean
 Clique_and_Monotone_Circuits
 ClockSynchInst
 Closest_Pair_Points
 CoCon
 CoSMeDis
 CoSMed
 CofGroups
 Coinductive
 Coinductive_Languages
 Collections
 Combinable_Wands
 Combinatorics_Words
 Combinatorics_Words_Graph_Lemma
 Combinatorics_Words_Lyndon
 Comparison_Sort_Lower_Bound
 Compiling-Exceptions-Correctly
 Complete_Non_Orders
 Completeness
 Complex_Bounded_Operators
 Complex_Geometry
 Complx
 ComponentDependencies
 ConcurrentGC
 ConcurrentIMP
 Concurrent_Ref_Alg
 Concurrent_Revisions
 Conditional_Simplification
 Conditional_Transfer_Rule
 Consensus_Refined
 Constructive_Cryptography
 Constructive_Cryptography_CM
 Constructor_Funs
 Containers
 CoreC++
 Core_DOM
 Core_SC_DOM
 Correctness_Algebras
 Cotangent_PFD_Formula
 Count_Complex_Roots
 CryptHOL
 CryptoBasedCompositionalProperties
 Cubic_Quartic_Equations
 DFS_Framework
 DOM_Components
 DPT-SAT-Solver
 DataRefinementIBP
 Datatype_Order_Generator
 Decl_Sem_Fun_PL
 Decreasing-Diagrams
 Decreasing-Diagrams-II
 Dedekind_Real
 Deep_Learning
 Delta_System_Lemma
 Density_Compiler
 Dependent_SIFUM_Refinement
 Dependent_SIFUM_Type_Systems
 Depth-First-Search
 Derangements
 Deriving
 Descartes_Sign_Rule
 Design_Theory
 Dict_Construction
 Differential_Dynamic_Logic
 Differential_Game_Logic
 Digit_Expansions
 Dijkstra_Shortest_Path
 Diophantine_Eqns_Lin_Hom
 Dirichlet_L
 Dirichlet_Series
 DiscretePricing
 Discrete_Summation
 DiskPaxos
 Dominance_CHK
 DPRM_Theorem
 DynamicArchitectures
 Dynamic_Tables
 E_Transcendental
 Echelon_Form
 EdmondsKarp_Maxflow
 Efficient-Mergesort
 Elliptic_Curves_Group_Law
 Encodability_Process_Calculi
 Epistemic_Logic
 Equivalence_Relation_Enumeration
 Ergodic_Theory
 Error_Function
 Euler_MacLaurin
 Euler_Partition
 Eval_FO
 Example-Submission
 Extended_Finite_State_Machine_Inference
 Extended_Finite_State_Machines
 FFT
 FLP
 FOL-Fitting
 FOL_Axiomatic
 FOL_Harrison
 FOL_Seq_Calc1
 FOL_Seq_Calc2
 FOL_Seq_Calc3
 Factor_Algebraic_Polynomial
 Factored_Transition_System_Bounding
 Falling_Factorial_Sum
 Farkas
 FeatherweightJava
 Featherweight_OCL
 Fermat3_4
 FileRefinement
 FinFun
 Finger-Trees
 Finite-Map-Extras
 Finite_Automata_HF
+Finite_Fields
 Finitely_Generated_Abelian_Groups
 First_Order_Terms
 First_Welfare_Theorem
 Fishburn_Impossibility
 Fisher_Yates
 Fishers_Inequality
 Flow_Networks
 Floyd_Warshall
 Flyspeck-Tame
 FocusStreamsCaseStudies
 Forcing
 Formal_Puiseux_Series
 Formal_SSA
 Formula_Derivatives
 Foundation_of_geometry
 Fourier
 FO_Theory_Rewriting
 Free-Boolean-Algebra
 Free-Groups
 Frequency_Moments
 Fresh_Identifiers
 FunWithFunctions
 FunWithTilings
 Functional-Automata
 Functional_Ordered_Resolution_Prover
 Furstenberg_Topology
 GPU_Kernel_PL
 Gabow_SCC
 GaleStewart_Games
 Gale_Shapley
 Game_Based_Crypto
 Gauss-Jordan-Elim-Fun
 Gauss_Jordan
 Gauss_Sums
 Gaussian_Integers
 GenClock
 General-Triangle
 Generalized_Counting_Sort
 Generic_Deriving
 Generic_Join
 GewirthPGCProof
 Girth_Chromatic
 GoedelGod
 Goedel_HFSet_Semantic
 Goedel_HFSet_Semanticless
 Goedel_Incompleteness
 Goodstein_Lambda
 GraphMarkingIBP
 Graph_Saturation
 Graph_Theory
 Green
 Groebner_Bases
 Groebner_Macaulay
 Gromov_Hyperbolicity
 Grothendieck_Schemes
 Group-Ring-Module
 HOL-CSP
 HOLCF-Prelude
 HRB-Slicing
 Hahn_Jordan_Decomposition
 Heard_Of
 Hello_World
 HereditarilyFinite
 Hermite
 Hermite_Lindemann
 Hidden_Markov_Models
 Higher_Order_Terms
 Hoare_Time
 Hood_Melville_Queue
 HotelKeyCards
 Huffman
 Hybrid_Logic
 Hybrid_Multi_Lane_Spatial_Logic
 Hybrid_Systems_VCs
 HyperCTL
 Hyperdual
 IEEE_Floating_Point
 IFC_Tracking
 IMAP-CRDT
 IMO2019
 IMP2
 IMP2_Binary_Heap
 IMP_Compiler
 IP_Addresses
 Imperative_Insertion_Sort
 Impossible_Geometry
 Incompleteness
 Incredible_Proof_Machine
 Independence_CH
 Inductive_Confidentiality
 Inductive_Inference
 InfPathElimination
 InformationFlowSlicing
 InformationFlowSlicing_Inter
 Integration
 Interpolation_Polynomials_HOL_Algebra
 Interpreter_Optimizations
 Interval_Arithmetic_Word32
 Intro_Dest_Elim
 Iptables_Semantics
 Irrational_Series_Erdos_Straus
 Irrationality_J_Hancl
 Irrationals_From_THEBOOK
 IsaGeoCoq
 Isabelle_C
 Isabelle_Marries_Dirac
 Isabelle_Meta_Model
 Jacobson_Basic_Algebra
 Jinja
 JinjaDCI
 JinjaThreads
 JiveDataStoreModel
 Jordan_Hoelder
 Jordan_Normal_Form
 KAD
 KAT_and_DRA
 KBPs
 KD_Tree
 Key_Agreement_Strong_Adversaries
 Kleene_Algebra
 Knights_Tour
 Knot_Theory
 Knuth_Bendix_Order
 Knuth_Morris_Pratt
 Koenigsberg_Friendship
 Kruskal
 Kuratowski_Closure_Complement
 LLL_Basis_Reduction
 LLL_Factorization
 LOFT
 LTL
 LTL_Master_Theorem
 LTL_Normal_Form
 LTL_to_DRA
 LTL_to_GBA
 Lam-ml-Normalization
 LambdaAuth
 LambdaMu
 Lambda_Free_EPO
 Lambda_Free_KBOs
 Lambda_Free_RPOs
 Lambert_W
 Landau_Symbols
 Laplace_Transform
 Latin_Square
 LatticeProperties
 Launchbury
 Laws_of_Large_Numbers
 Lazy-Lists-II
 Lazy_Case
 Lehmer
 Lifting_Definition_Option
 Lifting_the_Exponent
 LightweightJava
 LinearQuantifierElim
 Linear_Inequalities
 Linear_Programming
 Linear_Recurrences
 Liouville_Numbers
 List-Index
 List-Infinite
 List_Interleaving
 List_Inversions
 List_Update
 LocalLexing
 Localization_Ring
 Locally-Nameless-Sigma
 Logging_Independent_Anonymity
 Lowe_Ontological_Argument
 Lower_Semicontinuous
 Lp
 LP_Duality
 Lucas_Theorem
 MDP-Algorithms
 MDP-Rewards
 MFMC_Countable
 MFODL_Monitor_Optimized
 MFOTL_Monitor
 MSO_Regex_Equivalence
 Markov_Models
 Marriage
 Mason_Stothers
 Matrices_for_ODEs
 Matrix
 Matrix_Tensor
 Matroids
 Max-Card-Matching
 Median_Method
 Median_Of_Medians_Selection
 Menger
 Mereology
 Mersenne_Primes
 Metalogic_ProofChecker
 MiniML
 MiniSail
 Minimal_SSA
 Minkowskis_Theorem
 Minsky_Machines
 Modal_Logics_for_NTS
 Modular_Assembly_Kit_Security
 Modular_arithmetic_LLL_and_HNF_algorithms
 Monad_Memo_DP
 Monad_Normalisation
 MonoBoolTranAlgebra
 MonoidalCategory
 Monomorphic_Monad
 MuchAdoAboutTwo
 Multiset_Ordering_NPC
 Multi_Party_Computation
 Multirelations
 Myhill-Nerode
 Name_Carrying_Type_Inference
 Nash_Williams
 Nat-Interval-Logic
 Native_Word
 Nested_Multisets_Ordinals
 Network_Security_Policy_Verification
 Neumann_Morgenstern_Utility
 No_FTL_observers
 Nominal2
 Noninterference_CSP
 Noninterference_Concurrent_Composition
 Noninterference_Generic_Unwinding
 Noninterference_Inductive_Unwinding
 Noninterference_Ipurge_Unwinding
 Noninterference_Sequential_Composition
 NormByEval
 Nullstellensatz
 Octonions
 OpSets
 Open_Induction
 Optics
 Optimal_BST
 Orbit_Stabiliser
 Order_Lattice_Props
 Ordered_Resolution_Prover
 Ordinal
 Ordinal_Partitions
 Ordinals_and_Cardinals
 Ordinary_Differential_Equations
 PAC_Checker
 Package_logic
 PAL
 PCF
 PLM
 POPLmark-deBruijn
 PSemigroupsConvolution
 Padic_Ints
 Pairing_Heap
 Paraconsistency
 Parity_Game
 Partial_Function_MR
 Partial_Order_Reduction
 Password_Authentication_Protocol
 Pell
 Perfect-Number-Thm
 Perron_Frobenius
 Physical_Quantities
 Pi_Calculus
 Pi_Transcendental
 Planarity_Certificates
 Pluennecke_Ruzsa_Inequality
 Poincare_Bendixson
 Poincare_Disc
 Polynomial_Factorization
 Polynomial_Interpolation
 Polynomials
 Pop_Refinement
 Posix-Lexing
 Possibilistic_Noninterference
 Power_Sum_Polynomials
 Pratt_Certificate
 Prefix_Free_Code_Combinators
 Presburger-Automata
 Prim_Dijkstra_Simple
 Prime_Distribution_Elementary
 Prime_Harmonic_Series
 Prime_Number_Theorem
 Priority_Queue_Braun
 Priority_Search_Trees
 Probabilistic_Noninterference
 Probabilistic_Prime_Tests
 Probabilistic_System_Zoo
 Probabilistic_Timed_Automata
 Probabilistic_While
 Program-Conflict-Analysis
 Progress_Tracking
 Projective_Geometry
 Projective_Measurements
 Promela
 Proof_Strategy_Language
 PropResPI
 Propositional_Proof_Systems
 Prpu_Maxflow
 PseudoHoops
 Psi_Calculi
 Ptolemys_Theorem
 Public_Announcement_Logic
 QHLProver
 QR_Decomposition
 Quantales
 Quasi_Borel_Spaces
 Quaternions
 Quick_Sort_Cost
 RIPEMD-160-SPARK
 ROBDD
 RSAPSS
 Ramsey-Infinite
 Random_BSTs
 Random_Graph_Subgraph_Threshold
 Randomised_BSTs
 Randomised_Social_Choice
 Rank_Nullity_Theorem
 Real_Impl
 Real_Power
 Recursion-Addition
 Recursion-Theory-I
 Refine_Imperative_HOL
 Refine_Monadic
 RefinementReactive
 Regex_Equivalence
 Registers
 Regression_Test_Selection
 Regular-Sets
 Regular_Algebras
 Regular_Tree_Relations
 Relation_Algebra
 Relational-Incorrectness-Logic
 Relational_Disjoint_Set_Forests
 Relational_Forests
 Relational_Method
 Relational_Minimum_Spanning_Trees
 Relational_Paths
 Rep_Fin_Groups
 ResiduatedTransitionSystem
 Residuated_Lattices
 Resolution_FOL
 Rewrite_Properties_Reduction
 Rewriting_Z
 Ribbon_Proofs
 Robbins-Conjecture
 Robinson_Arithmetic
 Root_Balanced_Tree
 Roth_Arithmetic_Progressions
 Routing
 Roy_Floyd_Warshall
 SATSolverVerification
 SC_DOM_Components
 SDS_Impossibility
 SIFPL
 SIFUM_Type_Systems
 SPARCv8
 Safe_Distance
 Safe_OCL
 Saturation_Framework
 Saturation_Framework_Extensions
 Schutz_Spacetime
 Secondary_Sylow
 Security_Protocol_Refinement
 Selection_Heap_Sort
 SenSocialChoice
 Separata
 Separation_Algebra
 Separation_Logic_Imperative_HOL
 SequentInvertibility
 Shadow_DOM
 Shadow_SC_DOM
 Shivers-CFA
 ShortestPath
 Show
 Sigma_Commit_Crypto
 Signature_Groebner
 Simpl
 Simple_Firewall
 Simplex
 Simplicial_complexes_and_boolean_functions
 SimplifiedOntologicalArgument
 Skew_Heap
 Skip_Lists
 Slicing
 Sliding_Window_Algorithm
 Smith_Normal_Form
 Smooth_Manifolds
 Sophomores_Dream
 Sort_Encodings
 Source_Coding_Theorem
 SpecCheck
 Special_Function_Bounds
 Splay_Tree
 Sqrt_Babylonian
 Stable_Matching
 Statecharts
 Stateful_Protocol_Composition_and_Typing
 Stellar_Quorums
 Stern_Brocot
 Stewart_Apollonius
 Stirling_Formula
 Stochastic_Matrices
 Stone_Algebras
 Stone_Kleene_Relation_Algebras
 Stone_Relation_Algebras
 Store_Buffer_Reduction
 Stream-Fusion
 Stream_Fusion_Code
 Strong_Security
 Sturm_Sequences
 Sturm_Tarski
 Stuttering_Equivalence
 Subresultants
 Subset_Boolean_Algebras
 SumSquares
 Sunflowers
 SuperCalc
 Surprise_Paradox
 Symmetric_Polynomials
 Syntax_Independent_Logic
 Szemeredi_Regularity
 Szpilrajn
 TESL_Language
 TLA
 Tail_Recursive_Functions
 Tarskis_Geometry
 Taylor_Models
 Three_Circles
 Timed_Automata
 Topological_Semantics
 Topology
 TortoiseHare
 Transcendence_Series_Hancl_Rucki
 Transformer_Semantics
 Transition_Systems_and_Automata
 Transitive-Closure
 Transitive-Closure-II
 Transitive_Models
 Treaps
 Tree-Automata
 Tree_Decomposition
 Triangle
 Trie
 Twelvefold_Way
 Tycon
 Types_Tableaus_and_Goedels_God
 Types_To_Sets_Extension
 UPF
 UPF_Firewall
 UTP
 Universal_Hash_Families
 Universal_Turing_Machine
 UpDown_Scheme
 Valuation
 Van_Emde_Boas_Trees
 Van_der_Waerden
 VectorSpace
 VeriComp
 Verified-Prover
 Verified_SAT_Based_AI_Planning
 VerifyThis2018
 VerifyThis2019
 Vickrey_Clarke_Groves
 Virtual_Substitution
 VolpanoSmith
 VYDRA_MDL
 WHATandWHERE_Security
 WOOT_Strong_Eventual_Consistency
 WebAssembly
 Weight_Balanced_Trees
 Weighted_Path_Order
 Well_Quasi_Orders
 Wetzels_Problem
 Winding_Number_Eval
 Word_Lib
 WorkerWrapper
 X86_Semantics
 XML
 Youngs_Inequality
 ZFC_in_HOL
 Zeta_3_Irrational
 Zeta_Function
 pGCL