diff --git a/thys/Finite_Fields/Card_Irreducible_Polynomials_Aux.thy b/thys/Finite_Fields/Card_Irreducible_Polynomials_Aux.thy
--- a/thys/Finite_Fields/Card_Irreducible_Polynomials_Aux.thy
+++ b/thys/Finite_Fields/Card_Irreducible_Polynomials_Aux.thy
@@ -1,916 +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
+    using ring_hom_ringI2 subring_is_ring d.ring_axioms 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 auto
       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 force
       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_Isomorphic.thy b/thys/Finite_Fields/Finite_Fields_Isomorphic.thy
--- a/thys/Finite_Fields/Finite_Fields_Isomorphic.thy
+++ b/thys/Finite_Fields/Finite_Fields_Isomorphic.thy
@@ -1,367 +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)
+    by (intro ring_hom_ringI2 pzf.ring_axioms 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
--- a/thys/Finite_Fields/Finite_Fields_Preliminary_Results.thy
+++ b/thys/Finite_Fields/Finite_Fields_Preliminary_Results.thy
@@ -1,1010 +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)
+    using dr.ring_axioms ds.ring_axioms 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)
+    using dr.ring_axioms ds.ring_axioms 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)
+    using dr.ring_axioms ds.ring_axioms 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/Ring_Characteristic.thy b/thys/Finite_Fields/Ring_Characteristic.thy
--- a/thys/Finite_Fields/Ring_Characteristic.thy
+++ b/thys/Finite_Fields/Ring_Characteristic.thy
@@ -1,1017 +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 int_ring" using int.ring_axioms 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
+    by (intro ring.carrier_is_subring int.ring_axioms
         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) 
+    by  (intro ring_hom_ringI a b ring_axioms, 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/Padic_Ints/Cring_Poly.thy b/thys/Padic_Ints/Cring_Poly.thy
--- a/thys/Padic_Ints/Cring_Poly.thy
+++ b/thys/Padic_Ints/Cring_Poly.thy
@@ -1,7052 +1,7052 @@
 theory Cring_Poly
   imports "HOL-Algebra.UnivPoly" "HOL-Algebra.Subrings" Function_Ring
 begin
 
 text\<open>
   This theory extends the material in \<^theory>\<open>HOL-Algebra.UnivPoly\<close>. The main additions are 
   material on Taylor expansions of polynomials and polynomial derivatives, and various applications
   of the universal property of polynomial evaluation. These include construing polynomials as 
   functions from the base ring to itself, composing one polynomial with another, and extending
   homomorphisms between rings to homomoprhisms of their polynomial rings. These formalizations 
   are necessary components of the proof of Hensel's lemma for $p$-adic integers, and for the 
   proof of $p$-adic quantifier elimination. \<close>
 
 lemma(in ring) ring_hom_finsum:
   assumes "h \<in> ring_hom R S"
   assumes "ring S"
   assumes "finite I"
   assumes "F \<in> I \<rightarrow> carrier R"
   shows "h (finsum R F I) = finsum S (h \<circ> F) I"
 proof- 
   have I: "(h \<in> ring_hom R S \<and> F \<in> I \<rightarrow> carrier R) \<longrightarrow> h (finsum R F I) = finsum S (h \<circ> F) I"
     apply(rule finite_induct, rule assms)
     using assms ring_hom_zero[of h R S] 
-    apply (metis abelian_group_def abelian_monoid.finsum_empty is_ring ring_def)
+    apply (metis abelian_group_def abelian_monoid.finsum_empty ring_axioms ring_def)
   proof(rule)
     fix A a 
     assume A: "finite A" "a \<notin> A" "h \<in> ring_hom R S \<and> F \<in> A \<rightarrow> carrier R \<longrightarrow>
            h (finsum R F A) = finsum S (h \<circ> F) A" "h \<in> ring_hom R S \<and> F \<in> insert a A \<rightarrow> carrier R"
     have 0: "h \<in> ring_hom R S \<and> F \<in> A \<rightarrow> carrier R "
       using A by auto 
     have 1: "h (finsum R F A) = finsum S (h \<circ> F) A"
       using A 0 by auto 
     have 2: "abelian_monoid S"
       using assms ring_def abelian_group_def by auto
     have 3: "h (F a \<oplus> finsum R F A) = h (F a) \<oplus>\<^bsub>S\<^esub> (finsum S (h \<circ> F) A) "
       using ring_hom_add assms finsum_closed 1 A(4) by fastforce
     have 4: "finsum R F (insert a A) = F a \<oplus> finsum R F A"
       using finsum_insert[of A a F] A assms by auto 
     have 5: "finsum S (h \<circ> F) (insert a A) = (h \<circ> F) a \<oplus>\<^bsub>S\<^esub> finsum S (h \<circ> F) A"
       apply(rule abelian_monoid.finsum_insert[of S A a "h \<circ> F"])
           apply (simp add: "2")
          apply(rule A)
         apply(rule A)
       using ring_hom_closed A  "0" apply fastforce
       using A ring_hom_closed by auto 
     show "h (finsum R F (insert a A)) =
            finsum S (h \<circ> F) (insert a A)"
       unfolding 4 5 3 by auto 
   qed
   thus ?thesis using assms by blast 
 qed
 
 lemma(in ring) ring_hom_a_inv:
   assumes "ring S"
   assumes "h \<in> ring_hom R S"
   assumes "b \<in> carrier R"
   shows "h (\<ominus> b) =  \<ominus>\<^bsub>S\<^esub> h b"
 proof-
   have "h b \<oplus>\<^bsub>S\<^esub> h (\<ominus> b) = \<zero>\<^bsub>S\<^esub>"
     by (metis (no_types, opaque_lifting) abelian_group.a_inv_closed assms(1) assms(2) assms(3) 
         is_abelian_group local.ring_axioms r_neg ring_hom_add ring_hom_zero)        
   then show ?thesis 
     by (metis (no_types, lifting) abelian_group.minus_equality add.inv_closed assms(1) 
         assms(2) assms(3) ring.is_abelian_group ring.ring_simprules(10) ring_hom_closed)
 qed
 
 lemma(in ring) ring_hom_minus:
   assumes "ring S"
   assumes "h \<in> ring_hom R S"
   assumes "a \<in> carrier R"
   assumes "b \<in> carrier R"
   shows "h (a \<ominus> b) = h a \<ominus>\<^bsub>S\<^esub> h b" 
   using assms ring_hom_add[of h R S a "\<ominus>\<^bsub>R\<^esub> b"]
   unfolding a_minus_def 
   using ring_hom_a_inv[of S h b] by auto 
 
 lemma ring_hom_nat_pow:
   assumes "ring R"
   assumes "ring S"
   assumes "h \<in> ring_hom R S"
   assumes "a \<in> carrier R"
   shows "h (a[^]\<^bsub>R\<^esub>(n::nat)) = (h a)[^]\<^bsub>S\<^esub>(n::nat)"
   using assms by (simp add: ring_hom_ring.hom_nat_pow ring_hom_ringI2)
 
 lemma (in ring) Units_not_right_zero_divisor:
   assumes "a \<in> Units R"
   assumes "b \<in> carrier R"
   assumes "a \<otimes> b = \<zero>"
   shows  "b = \<zero>"
 proof- 
   have "inv a \<otimes> a \<otimes> b = \<zero> "
     using assms Units_closed Units_inv_closed r_null m_assoc[of "inv a" a b] by presburger
   thus ?thesis using assms 
     by (metis Units_l_inv l_one)    
 qed
 
 lemma (in ring) Units_not_left_zero_divisor:
   assumes "a \<in> Units R"
   assumes "b \<in> carrier R"
   assumes "b \<otimes> a = \<zero>"
   shows  "b = \<zero>"
 proof- 
   have "b \<otimes> (a \<otimes> inv a) = \<zero> "
     using assms Units_closed Units_inv_closed l_null m_assoc[of b a"inv a"] by presburger
   thus ?thesis using assms 
     by (metis Units_r_inv r_one)    
 qed
 
 lemma (in cring) finsum_remove:
   assumes "\<And>i. i \<in> Y \<Longrightarrow> f i \<in> carrier R"
   assumes "finite Y"
   assumes "i \<in> Y"
   shows "finsum R f Y = f i \<oplus> finsum R f (Y - {i})"
 proof- 
   have "finsum R f (insert i (Y - {i})) = f i \<oplus> finsum R f (Y - {i})"
     apply(rule finsum_insert)
     using assms apply blast apply blast using assms apply blast
     using assms by blast 
   thus ?thesis using assms 
     by (metis insert_Diff)
 qed
 
 
 type_synonym degree = nat
 text\<open>The composition of two ring homomorphisms is a ring homomorphism\<close>
 lemma ring_hom_compose:                                                                                                           
   assumes "ring R"
   assumes "ring S"
   assumes "ring T"
   assumes "h \<in> ring_hom R S"
   assumes "g \<in> ring_hom S T"
   assumes "\<And>c. c \<in> carrier R \<Longrightarrow> f c = g (h c)"
   shows "f \<in>  ring_hom R T"
 proof(rule ring_hom_memI)
   show "\<And>x. x \<in> carrier R \<Longrightarrow> f x \<in> carrier T"
     using assms  by (metis ring_hom_closed)
   show " \<And>x y. x \<in> carrier R \<Longrightarrow> y \<in> carrier R \<Longrightarrow> f (x \<otimes>\<^bsub>R\<^esub> y) = f x \<otimes>\<^bsub>T\<^esub> f y"
   proof-
     fix x y
     assume A: "x \<in>  carrier R" "y \<in>  carrier R"
     show "f (x \<otimes>\<^bsub>R\<^esub> y) = f x \<otimes>\<^bsub>T\<^esub> f y"
     proof-
       have  "f (x \<otimes>\<^bsub>R\<^esub> y) = g (h (x \<otimes>\<^bsub>R\<^esub> y))"
         by (simp add: A(1) A(2) assms(1) assms(6) ring.ring_simprules(5))
       then have  "f (x \<otimes>\<^bsub>R\<^esub> y) = g ((h x) \<otimes>\<^bsub>S\<^esub> (h y))"
         using A(1) A(2) assms(4) ring_hom_mult by fastforce
       then have  "f (x \<otimes>\<^bsub>R\<^esub> y) = g (h x) \<otimes>\<^bsub>T\<^esub> g (h y)"
         using A(1) A(2) assms(4) assms(5) ring_hom_closed ring_hom_mult by fastforce
       then show ?thesis 
         by (simp add: A(1) A(2) assms(6))
     qed
   qed
   show "\<And>x y. x \<in> carrier R \<Longrightarrow> y \<in> carrier R \<Longrightarrow> f (x \<oplus>\<^bsub>R\<^esub> y) = f x \<oplus>\<^bsub>T\<^esub> f y"
   proof-
     fix x y
     assume A: "x \<in>  carrier R" "y \<in>  carrier R"
     show "f (x \<oplus>\<^bsub>R\<^esub> y) = f x \<oplus>\<^bsub>T\<^esub> f y"
     proof-
       have  "f (x \<oplus>\<^bsub>R\<^esub> y) = g (h (x \<oplus>\<^bsub>R\<^esub> y))"
         by (simp add: A(1) A(2) assms(1) assms(6) ring.ring_simprules(1))
       then have  "f (x \<oplus>\<^bsub>R\<^esub> y) = g ((h x) \<oplus>\<^bsub>S\<^esub> (h y))"
         using A(1) A(2) assms(4) ring_hom_add by fastforce
       then have  "f (x \<oplus>\<^bsub>R\<^esub> y) = g (h x) \<oplus>\<^bsub>T\<^esub> g (h y)"
         by (metis (no_types, opaque_lifting) A(1) A(2) assms(4) assms(5) ring_hom_add ring_hom_closed)
       then show ?thesis
         by (simp add: A(1) A(2) assms(6))
     qed
   qed
   show "f \<one>\<^bsub>R\<^esub> = \<one>\<^bsub>T\<^esub>" 
     by (metis assms(1) assms(4) assms(5) assms(6) ring.ring_simprules(6) ring_hom_one)
 qed
 
 
 (**************************************************************************************************)
 (**************************************************************************************************)
 section\<open>Basic Notions about Polynomials\<close>
 (**************************************************************************************************)
 (**************************************************************************************************)
 context UP_ring
 begin
 
 
 text\<open>rings are closed under monomial terms\<close>
 lemma monom_term_car:
   assumes "c \<in> carrier R"
   assumes "x \<in> carrier R"
   shows "c \<otimes> x[^](n::nat) \<in> carrier R"
   using assms monoid.nat_pow_closed 
   by blast
 
 text\<open>Univariate polynomial ring over R\<close>
 
 lemma P_is_UP_ring:
 "UP_ring R"
   by (simp add: UP_ring_axioms)
 
 text\<open>Degree function\<close>
 abbreviation(input) degree  where
 "degree f \<equiv>  deg R f"
 
 lemma UP_car_memI:
   assumes "\<And>n. n > k \<Longrightarrow> p n = \<zero>"
   assumes "\<And>n. p n \<in> carrier R"
   shows "p \<in> carrier P"
 proof-
   have "bound \<zero> k p"
     by (simp add: assms(1) bound.intro)
   then show ?thesis 
     by (metis (no_types, lifting) P_def UP_def assms(2) mem_upI partial_object.select_convs(1))
 qed
 
 lemma(in UP_cring) UP_car_memI':
   assumes "\<And>x. g x \<in> carrier R"
   assumes "\<And>x. x > k \<Longrightarrow> g x = \<zero>"
   shows "g \<in> carrier (UP R)"
 proof-
   have "bound \<zero> k g"
     using assms unfolding bound_def by blast 
   then show ?thesis 
     using P_def UP_car_memI assms(1) by blast
 qed
 
 lemma(in UP_cring) UP_car_memE:
   assumes "g \<in> carrier (UP R)"
   shows "\<And>x. g x \<in> carrier R"
         "\<And>x. x > (deg R g) \<Longrightarrow> g x = \<zero>"
   using P_def assms UP_def[of R] apply (simp add: mem_upD)
   using assms UP_def[of R] up_def[of R] 
   by (smt R.ring_axioms UP_ring.deg_aboveD UP_ring.intro partial_object.select_convs(1) restrict_apply up_ring.simps(2))
   
 end
 
   (**************************************************************************************************)
   (**************************************************************************************************)
   subsection\<open>Lemmas About Coefficients\<close>
   (**************************************************************************************************)
   (**************************************************************************************************)
 
 context UP_ring
 begin
 text\<open>The goal here is to reduce dependence on the function coeff from Univ\_Poly, in favour of using
 a polynomial itself as its coefficient function.\<close>
 
 lemma coeff_simp:
   assumes "f \<in> carrier P"
   shows "coeff (UP R)  f = f "
 proof fix x show "coeff (UP R) f x = f x" 
     using assms P_def UP_def[of R] by auto 
 qed
 
 text\<open>Coefficients are in R\<close>
 
 lemma cfs_closed:
   assumes "f \<in> carrier P"
   shows "f n \<in> carrier R"
   using assms coeff_simp[of f]  P_def coeff_closed 
   by fastforce
 
 lemma cfs_monom:
   "a \<in> carrier R ==> (monom P a m) n = (if m=n then a else \<zero>)"
 using coeff_simp  P_def coeff_monom monom_closed by auto
 
 lemma cfs_zero [simp]: "\<zero>\<^bsub>P\<^esub> n = \<zero>" 
   using P_def UP_zero_closed coeff_simp coeff_zero by auto
 
 lemma cfs_one [simp]: "\<one>\<^bsub>P\<^esub> n = (if n=0 then \<one> else \<zero>)"
   by (metis P_def R.one_closed UP_ring.cfs_monom UP_ring_axioms monom_one)
 
 lemma cfs_smult [simp]:
   "[| a \<in> carrier R; p \<in> carrier P |] ==> (a \<odot>\<^bsub>P\<^esub> p) n = a \<otimes> p n"
   using P_def UP_ring.coeff_simp UP_ring_axioms UP_smult_closed coeff_smult by fastforce
   
 lemma cfs_add [simp]:
   "[| p \<in> carrier P; q \<in> carrier P |] ==> (p \<oplus>\<^bsub>P\<^esub> q) n = p n \<oplus> q n"
   by (metis P.add.m_closed P_def UP_ring.coeff_add UP_ring.coeff_simp UP_ring_axioms)
 
 lemma cfs_a_inv [simp]:
   assumes R: "p \<in> carrier P"
   shows "(\<ominus>\<^bsub>P\<^esub> p) n = \<ominus> (p n)"
   using P.add.inv_closed P_def UP_ring.coeff_a_inv UP_ring.coeff_simp UP_ring_axioms assms 
   by fastforce
 
 lemma cfs_minus [simp]:
   "[| p \<in> carrier P; q \<in> carrier P |] ==> (p \<ominus>\<^bsub>P\<^esub> q) n = p n \<ominus> q n"
   using P.minus_closed P_def coeff_minus coeff_simp by auto
 
 lemma cfs_monom_mult_r:
   assumes "p \<in> carrier P"
   assumes "a \<in> carrier R"
   shows "(monom P a n \<otimes>\<^bsub>P\<^esub> p) (k + n) = a \<otimes> p k"
   using coeff_monom_mult assms P.m_closed P_def coeff_simp monom_closed by auto
 
 lemma(in UP_cring) cfs_monom_mult_l:
   assumes "p \<in> carrier P"
   assumes "a \<in> carrier R"
   shows "(p \<otimes>\<^bsub>P\<^esub> monom P a n) (k + n) = a \<otimes> p k"
   using UP_m_comm assms(1) assms(2) cfs_monom_mult_r by auto
 
 lemma(in UP_cring) cfs_monom_mult_l':
   assumes "f \<in> carrier P"
   assumes "a \<in> carrier R"
   assumes "m \<ge> n"
   shows "(f \<otimes>\<^bsub>P\<^esub> (monom P a n)) m = a \<otimes> (f (m - n))"
   using cfs_monom_mult_l[of f a n "m-n"] assms 
   by simp
 
 lemma(in UP_cring) cfs_monom_mult_r':
   assumes "f \<in> carrier P"
   assumes "a \<in> carrier R"
   assumes "m \<ge> n"
   shows "((monom P a n) \<otimes>\<^bsub>P\<^esub> f) m = a \<otimes> (f (m - n))"
   using cfs_monom_mult_r[of f a n "m-n"] assms 
   by simp 
 end
   (**************************************************************************************************)
   (**************************************************************************************************)
   subsection\<open>Degree Bound Lemmas\<close>
   (**************************************************************************************************)
   (**************************************************************************************************)
 
 context UP_ring
 begin
 
 lemma bound_deg_sum:
   assumes " f \<in> carrier P"
   assumes "g \<in> carrier P"
   assumes "degree f  \<le> n"
   assumes "degree g \<le> n"
   shows "degree (f \<oplus>\<^bsub>P\<^esub> g) \<le> n"
   using P_def UP_ring_axioms assms(1) assms(2) assms(3) assms(4) 
   by (meson deg_add max.boundedI order_trans)
 
 lemma bound_deg_sum':
   assumes " f \<in> carrier P"
   assumes "g \<in> carrier P"
   assumes "degree f < n"
   assumes "degree g < n"
   shows "degree (f \<oplus>\<^bsub>P\<^esub> g) < n"
   using P_def UP_ring_axioms assms(1) assms(2) 
         assms(3) assms(4) 
   by (metis bound_deg_sum le_neq_implies_less less_imp_le_nat not_less)        
 
 lemma equal_deg_sum:
   assumes " f \<in> carrier P"
   assumes "g \<in> carrier P"
   assumes "degree f < n"
   assumes "degree g = n"
   shows "degree (f \<oplus>\<^bsub>P\<^esub> g) = n"
 proof-
   have 0: "degree (f \<oplus>\<^bsub>P\<^esub> g) \<le>n"
     using assms bound_deg_sum 
           P_def UP_ring_axioms by auto
   show "degree (f \<oplus>\<^bsub>P\<^esub> g) = n"
   proof(rule ccontr)
     assume "degree (f \<oplus>\<^bsub>P\<^esub> g) \<noteq> n "
     then have 1: "degree (f \<oplus>\<^bsub>P\<^esub> g) < n"
       using 0 by auto 
     have 2: "degree (\<ominus>\<^bsub>P\<^esub> f) < n"
       using assms by simp
     have 3: "g = (f \<oplus>\<^bsub>P\<^esub> g) \<oplus>\<^bsub>P\<^esub> (\<ominus>\<^bsub>P\<^esub> f)"
       using assms 
       by (simp add: P.add.m_comm P.r_neg1)
     then show False using 1 2 3 assms 
       by (metis UP_a_closed UP_a_inv_closed deg_add leD le_max_iff_disj)
   qed
 qed
 
 lemma equal_deg_sum':
   assumes "f \<in> carrier P"
   assumes "g \<in> carrier P"
   assumes "degree g < n"
   assumes "degree f = n"
   shows "degree (f \<oplus>\<^bsub>P\<^esub> g) = n"
   using P_def UP_a_comm UP_ring.equal_deg_sum UP_ring_axioms assms(1) assms(2) assms(3) assms(4)
   by fastforce
 
 lemma degree_of_sum_diff_degree:
   assumes "p \<in> carrier P"
   assumes "q \<in> carrier P"
   assumes "degree q < degree p"
   shows "degree (p \<oplus>\<^bsub>P\<^esub> q) = degree p" 
   by(rule equal_deg_sum', auto simp: assms)
 
 lemma degree_of_difference_diff_degree:
   assumes "p \<in> carrier P"
   assumes "q \<in> carrier P"
   assumes "degree q < degree p"
   shows "degree (p \<ominus>\<^bsub>P\<^esub> q) = degree p" 
 proof-
   have A: "(p \<ominus>\<^bsub>P\<^esub> q) = p \<oplus>\<^bsub>P\<^esub> (\<ominus>\<^bsub>P\<^esub> q)" 
     by (simp add: P.minus_eq)
   have "degree (\<ominus>\<^bsub>P\<^esub> q) = degree q " 
     by (simp add: assms(2))
   then show ?thesis 
     using assms A 
     by (simp add: degree_of_sum_diff_degree)
 qed
 
 lemma (in UP_ring) deg_diff_by_const:
   assumes "g \<in> carrier (UP R)"
   assumes "a \<in> carrier R"
   assumes "h = g \<oplus>\<^bsub>UP R\<^esub> up_ring.monom (UP R) a 0"
   shows "deg R g = deg R h"
   unfolding assms using assms 
   by (metis P_def UP_ring.bound_deg_sum UP_ring.deg_monom_le UP_ring.monom_closed UP_ring_axioms degree_of_sum_diff_degree gr_zeroI not_less)
 
 lemma (in UP_ring) deg_diff_by_const':
   assumes "g \<in> carrier (UP R)"
   assumes "a \<in> carrier R"
   assumes "h = g \<ominus>\<^bsub>UP R\<^esub> up_ring.monom (UP R) a 0"
   shows "deg R g = deg R h"
   apply(rule deg_diff_by_const[of _  "\<ominus> a"])
   using assms apply blast 
   using assms apply blast
   by (metis P.minus_eq P_def assms(2) assms(3) monom_a_inv)
 
 lemma(in UP_ring) deg_gtE:
   assumes "p \<in> carrier P"
   assumes "i > deg R p"
   shows "p i = \<zero>"
   using assms  P_def coeff_simp deg_aboveD by metis
 end
 
   (**************************************************************************************************)
   (**************************************************************************************************)
   subsection\<open>Leading Term Function\<close>
   (**************************************************************************************************)
   (**************************************************************************************************)
 
 definition leading_term where 
 "leading_term R f = monom (UP R) (f (deg R f)) (deg R f)"
 
 context UP_ring
 begin
 
 abbreviation(input) ltrm  where
 "ltrm f \<equiv> monom P (f (deg R f)) (deg R f)"
 
 text\<open>leading term is a polynomial\<close>
 lemma ltrm_closed:
   assumes "f \<in> carrier P"
   shows "ltrm f \<in> carrier P"
   using assms 
   by (simp add: cfs_closed)  
   
 text\<open>Simplified coefficient function description for leading term\<close>
 lemma ltrm_coeff:
   assumes "f \<in> carrier P"
   shows "coeff P (ltrm f) n  = (if (n = degree f) then (f (degree f)) else \<zero>)"
     using assms 
     by (simp add: cfs_closed)
 
 lemma ltrm_cfs:
   assumes "f \<in> carrier P"
   shows "(ltrm f) n  = (if (n = degree f) then (f (degree f)) else \<zero>)"
   using assms 
   by (simp add: cfs_closed cfs_monom)
 
 lemma ltrm_cfs_above_deg:
   assumes "f \<in> carrier P"
   assumes "n > degree f"
   shows "ltrm f n = \<zero>"
   using assms 
   by (simp add: ltrm_cfs)
 
 text\<open>The leading term of f has the same degree as f\<close>
 
 lemma deg_ltrm:
   assumes "f \<in> carrier P"
   shows "degree (ltrm f) = degree f"
   using assms 
   by (metis P_def UP_ring.lcoeff_nonzero_deg UP_ring_axioms cfs_closed coeff_simp deg_const deg_monom)
 
 text\<open>Subtracting the leading term yields a drop in degree\<close>
 
 lemma minus_ltrm_degree_drop:
   assumes "f \<in> carrier P"
   assumes "degree f = Suc n"
   shows "degree (f \<ominus>\<^bsub>P\<^esub> (ltrm f)) \<le> n"
 proof(rule UP_ring.deg_aboveI)
   show C0: "UP_ring R" 
     by (simp add: UP_ring_axioms)    
   show C1: "f \<ominus>\<^bsub>P\<^esub> ltrm f \<in> carrier (UP R)"
     using assms ltrm_closed P.minus_closed P_def 
     by blast     
   show C2: "\<And>m. n < m \<Longrightarrow> coeff (UP R) (f \<ominus>\<^bsub>P\<^esub> ltrm f) m = \<zero>"
   proof-
     fix m
     assume A: "n<m"
     show "coeff (UP R) (f \<ominus>\<^bsub>P\<^esub> ltrm f) m = \<zero>"
     proof(cases " m = Suc n")
       case True
       have B: "f m \<in> carrier R" 
         using UP.coeff_closed P_def assms(1) cfs_closed by blast       
       have "m = degree f"
         using True by (simp add: assms(2))
       then have "f m = (ltrm f) m" 
         using ltrm_cfs assms(1) by auto 
       then have "(f m) \<ominus>\<^bsub>R\<^esub>( ltrm f) m = \<zero>"
         using B UP_ring_def P_is_UP_ring 
           B R.add.r_inv R.is_abelian_group abelian_group.minus_eq by fastforce
       then have "(f \<ominus>\<^bsub>UP R\<^esub> ltrm f) m = \<zero>"
         by (metis C1 ltrm_closed P_def assms(1) coeff_minus coeff_simp)        
       then show ?thesis 
         using C1 P_def UP_ring.coeff_simp UP_ring_axioms by fastforce
     next
       case False
       have D0: "m > degree f" using False 
         using A assms(2) by linarith
        have B: "f m \<in> carrier R" 
          using UP.coeff_closed P_def assms(1) cfs_closed 
          by blast
        have "f m = (ltrm f) m" 
          using D0 ltrm_cfs_above_deg P_def assms(1) coeff_simp deg_aboveD 
          by auto 
       then show ?thesis 
         by (metis B ltrm_closed P_def R.r_neg UP_ring.coeff_simp UP_ring_axioms a_minus_def assms(1) coeff_minus)       
     qed
   qed
 qed
 
 lemma ltrm_decomp:
   assumes "f \<in> carrier P"
   assumes "degree f >(0::nat)"
   obtains g where "g \<in> carrier P \<and> f = g \<oplus>\<^bsub>P\<^esub> (ltrm f) \<and> degree g < degree f"
 proof-
   have 0: "f \<ominus>\<^bsub>P\<^esub> (ltrm f) \<in> carrier P"
     using ltrm_closed assms(1) by blast    
   have 1: "f = (f \<ominus>\<^bsub>P\<^esub> (ltrm f)) \<oplus>\<^bsub>P\<^esub> (ltrm f)"
     using assms 
     by (metis "0" ltrm_closed P.add.inv_solve_right P.minus_eq)
   show ?thesis using assms 0 1 minus_ltrm_degree_drop[of f]
     by (metis ltrm_closed Suc_diff_1 Suc_n_not_le_n deg_ltrm equal_deg_sum' linorder_neqE_nat that)
 qed
 
 text\<open>leading term of a sum\<close>
 lemma coeff_of_sum_diff_degree0:
   assumes "p \<in> carrier P"
   assumes "q \<in> carrier P"
   assumes "degree q < n"
   shows "(p \<oplus>\<^bsub>P\<^esub> q) n = p n"
   using assms P_def UP_ring.deg_aboveD UP_ring_axioms cfs_add coeff_simp cfs_closed deg_aboveD 
   by auto
 
 lemma coeff_of_sum_diff_degree1:
   assumes "p \<in> carrier P"
   assumes "q \<in> carrier P"
   assumes "degree q < degree p"
   shows "(p \<oplus>\<^bsub>P\<^esub> q) (degree p) = p (degree p)"
   using assms(1) assms(2) assms(3) coeff_of_sum_diff_degree0 by blast
 
 
 
 lemma ltrm_of_sum_diff_degree:
   assumes "p \<in> carrier P"
   assumes "q \<in> carrier P"
   assumes "degree p > degree q"
   shows "ltrm (p \<oplus>\<^bsub>P\<^esub> q) = ltrm p" 
   unfolding leading_term_def 
   using assms(1) assms(2) assms(3) coeff_of_sum_diff_degree1 degree_of_sum_diff_degree 
   by presburger
 
 text\<open>leading term of a monomial\<close>
 
 lemma ltrm_monom:
   assumes "a \<in> carrier R"
   assumes "f = monom P a n"
   shows "ltrm f = f"
   unfolding leading_term_def
   by (metis P_def UP_ring.cfs_monom UP_ring.monom_zero UP_ring_axioms assms(1) assms(2) deg_monom)  
 
 lemma ltrm_monom_simp:
   assumes "a \<in> carrier R"
   shows "ltrm (monom P a n) = monom P a n"
   using assms ltrm_monom by auto
 
 lemma ltrm_inv_simp[simp]:
   assumes "f \<in> carrier P"
   shows "ltrm (ltrm f) = ltrm f"
   by (metis assms deg_ltrm ltrm_cfs)
 
 lemma ltrm_deg_0:
   assumes "p \<in> carrier P"
   assumes "degree p = 0"
   shows "ltrm p = p"
   using ltrm_monom assms P_def UP_ring.deg_zero_impl_monom UP_ring_axioms coeff_simp
   by fastforce
 
 lemma ltrm_prod_ltrm:
   assumes "p \<in> carrier P"
   assumes "q \<in> carrier P"
   shows "ltrm ((ltrm p) \<otimes>\<^bsub>P\<^esub> (ltrm q)) = (ltrm p) \<otimes>\<^bsub>P\<^esub> (ltrm q)"
   using ltrm_monom R.m_closed assms(1) assms(2) cfs_closed monom_mult
   by metis 
 
 text\<open>lead coefficient function\<close>
 
 abbreviation(input) lcf where
 "lcf p \<equiv> p (deg R p)"
 
 lemma(in UP_ring) lcf_ltrm:
 "ltrm p = monom P (lcf p) (degree p)"
   by auto
 
 lemma lcf_closed:
   assumes "f \<in> carrier P"
   shows "lcf f \<in> carrier R"
   by (simp add: assms cfs_closed)
 
 lemma(in UP_cring) lcf_monom:
   assumes "a \<in> carrier R"
   shows "lcf (monom P a n) = a" "lcf (monom (UP R) a n) = a"
   using assms deg_monom cfs_monom apply fastforce
   by (metis UP_ring.cfs_monom UP_ring.deg_monom UP_ring_axioms assms)
 
 
 end 
 
 text\<open>Function which truncates a polynomial by removing the leading term\<close>
 
 definition truncate where
 "truncate R f = f \<ominus>\<^bsub>(UP R)\<^esub> (leading_term R f)"
 
 context UP_ring
 begin 
 
 abbreviation(input) trunc where
 "trunc \<equiv> truncate R"
 
 lemma trunc_closed:
   assumes "f \<in> carrier P"
   shows "trunc f \<in> carrier P"
   using assms unfolding truncate_def 
   by (metis ltrm_closed P_def UP_ring.UP_ring UP_ring_axioms leading_term_def ring.ring_simprules(4))
 
 lemma trunc_simps:
   assumes "f \<in> carrier P"
   shows "f = (trunc f) \<oplus>\<^bsub>P\<^esub> (ltrm f)"
         "f \<ominus>\<^bsub>P\<^esub> (trunc f) = ltrm f"   
   apply (metis ltrm_closed P.add.inv_solve_right P.minus_closed P_def a_minus_def assms Cring_Poly.truncate_def leading_term_def)
   using trunc_closed[of f] ltrm_closed[of f] P_def P.add.inv_solve_right[of "ltrm f" f "trunc f"]
         assms  unfolding UP_cring_def
   by (metis P.add.inv_closed P.add.m_lcomm P.add.r_inv_ex P.minus_eq P.minus_minus
       P.r_neg2 P.r_zero Cring_Poly.truncate_def leading_term_def)
 
 lemma trunc_zero:
   assumes "f \<in> carrier P"
   assumes "degree f = 0"
   shows "trunc f = \<zero>\<^bsub>P\<^esub>"
   unfolding truncate_def 
   using assms ltrm_deg_0[of f] 
   by (metis P.r_neg P_def a_minus_def leading_term_def)
 
 lemma trunc_degree:
   assumes "f \<in> carrier P"
   assumes "degree f > 0"
   shows "degree (trunc f) < degree f"
   unfolding truncate_def using assms 
   by (metis ltrm_closed ltrm_decomp P.add.right_cancel Cring_Poly.truncate_def trunc_closed trunc_simps(1))
 
 text\<open>The coefficients of trunc agree with f for small degree\<close>
 
 lemma trunc_cfs:
   assumes "p \<in> carrier P"
   assumes "n < degree p"
   shows " (trunc p) n = p n"
   using P_def assms(1) assms(2) unfolding truncate_def 
   by (smt ltrm_closed ltrm_cfs R.minus_zero R.ring_axioms UP_ring.cfs_minus
       UP_ring_axioms a_minus_def cfs_closed leading_term_def nat_neq_iff ring.ring_simprules(15))
 
 text\<open>monomial predicate\<close>
 
 definition is_UP_monom where
 "is_UP_monom = (\<lambda>f. f \<in> carrier (UP R) \<and> f = ltrm f)"
 
 lemma is_UP_monomI:
   assumes "a \<in> carrier R"
   assumes "p = monom P a n"
   shows "is_UP_monom p"
   using assms(1) assms(2) is_UP_monom_def ltrm_monom P_def monom_closed 
   by auto
   
 lemma is_UP_monomI':
   assumes "f \<in> carrier (UP R)"
   assumes "f = ltrm f"
   shows "is_UP_monom f"
   using assms P_def unfolding is_UP_monom_def by blast 
 
 lemma monom_is_UP_monom:
   assumes "a \<in> carrier R"
   shows "is_UP_monom (monom P a n)" "is_UP_monom (monom (UP R) a n)"
   using assms P_def ltrm_monom_simp monom_closed
   unfolding is_UP_monom_def  
   by auto
 
 lemma is_UP_monomE:
   assumes "is_UP_monom f"
   shows "f \<in> carrier P" "f = monom P (lcf f) (degree f)"  "f = monom (UP R) (lcf f) (degree f)"
   using assms unfolding is_UP_monom_def 
   by(auto simp: P_def ) 
 
 lemma ltrm_is_UP_monom:
   assumes "p \<in> carrier P"
   shows "is_UP_monom (ltrm p)"
   using assms 
   by (simp add: cfs_closed monom_is_UP_monom(1))
 
 lemma is_UP_monom_mult:
   assumes "is_UP_monom p"
   assumes "is_UP_monom q"
   shows "is_UP_monom (p \<otimes>\<^bsub>P\<^esub> q)"
   apply(rule is_UP_monomI')
   using assms is_UP_monomE P_def UP_mult_closed 
   apply simp  
   using assms is_UP_monomE[of p] is_UP_monomE[of q] 
         P_def monom_mult 
   by (metis lcf_closed ltrm_monom R.m_closed)
 end 
 
   (**************************************************************************************************)
   (**************************************************************************************************)
   subsection\<open>Properties of Leading Terms and Leading Coefficients in Commutative Rings and Domains\<close>
   (**************************************************************************************************)
   (**************************************************************************************************)
 
 context UP_cring
 begin
 
 lemma cring_deg_mult:
   assumes "q \<in> carrier P"
   assumes "p \<in> carrier P"
   assumes "lcf q \<otimes> lcf p \<noteq>\<zero>"
   shows "degree (q \<otimes>\<^bsub>P\<^esub> p) = degree p + degree q"
 proof-
   have "q \<otimes>\<^bsub>P\<^esub> p = (trunc q \<oplus>\<^bsub>P\<^esub> ltrm q) \<otimes>\<^bsub>P\<^esub> (trunc p \<oplus>\<^bsub>P\<^esub> ltrm p)"
     using assms(1) assms(2) trunc_simps(1) by auto
   then have "q \<otimes>\<^bsub>P\<^esub> p = (trunc q \<oplus>\<^bsub>P\<^esub> ltrm q) \<otimes>\<^bsub>P\<^esub> (trunc p \<oplus>\<^bsub>P\<^esub> ltrm p)"
     by linarith
   then have 0: "q \<otimes>\<^bsub>P\<^esub> p = (trunc q  \<otimes>\<^bsub>P\<^esub> (trunc p \<oplus>\<^bsub>P\<^esub> ltrm p)) \<oplus>\<^bsub>P\<^esub> ( ltrm q \<otimes>\<^bsub>P\<^esub> (trunc p \<oplus>\<^bsub>P\<^esub> ltrm p))"
     by (simp add: P.l_distr assms(1) assms(2) ltrm_closed trunc_closed)
   have 1: "(trunc q  \<otimes>\<^bsub>P\<^esub> (trunc p \<oplus>\<^bsub>P\<^esub> ltrm p)) (degree p + degree q) = \<zero>"
   proof(cases "degree q = 0")
     case True
     then show ?thesis 
       using assms(1) assms(2) trunc_simps(1) trunc_zero by auto           
   next
     case False
     have "degree ((trunc q)  \<otimes>\<^bsub>P\<^esub> p) \<le> degree (trunc q) + degree p"
       using assms trunc_simps[of q]  deg_mult_ring[of "trunc q" p]  trunc_closed 
       by blast      
     then have "degree (trunc q  \<otimes>\<^bsub>P\<^esub> (trunc p \<oplus>\<^bsub>P\<^esub> ltrm p)) < degree q + degree p"
       using False assms(1) assms(2) trunc_degree trunc_simps(1) by fastforce
     then show ?thesis 
       by (metis P_def UP_mult_closed UP_ring.coeff_simp UP_ring_axioms
           add.commute assms(1) assms(2) deg_belowI not_less trunc_closed trunc_simps(1))      
   qed
   have 2: "(q \<otimes>\<^bsub>P\<^esub> p) (degree p + degree q) = 
                    ( ltrm q \<otimes>\<^bsub>P\<^esub> (trunc p \<oplus>\<^bsub>P\<^esub> ltrm p)) (degree p + degree q)"
     using 0 1 assms cfs_closed trunc_closed by auto       
   have 3: "(q \<otimes>\<^bsub>P\<^esub> p) (degree p + degree q) = 
                    ( ltrm q \<otimes>\<^bsub>P\<^esub> trunc p) (degree p + degree q) \<oplus> ( ltrm q \<otimes>\<^bsub>P\<^esub> ltrm p) (degree p + degree q)"
     by (simp add: "2" ltrm_closed UP_r_distr assms(1) assms(2) trunc_closed)   
   have 4: "( ltrm q \<otimes>\<^bsub>P\<^esub> trunc p) (degree p + degree q) = \<zero>"
   proof(cases "degree p = 0")
     case True
     then show ?thesis 
       using "2" "3" assms(1) assms(2) cfs_closed ltrm_closed trunc_zero by auto            
   next
     case False
     have "degree ( ltrm q \<otimes>\<^bsub>P\<^esub> trunc p) \<le> degree (ltrm q) + degree (trunc p)"
       using assms trunc_simps deg_mult_ring ltrm_closed trunc_closed by presburger              
     then have "degree ( ltrm q \<otimes>\<^bsub>P\<^esub> trunc p) < degree q + degree p"
       using False assms(1) assms(2) trunc_degree trunc_simps(1) deg_ltrm by fastforce 
     then show ?thesis 
       by (metis ltrm_closed P_def UP_mult_closed UP_ring.coeff_simp UP_ring_axioms add.commute assms(1) assms(2) deg_belowI not_less trunc_closed)          
   qed
   have 5: "(q \<otimes>\<^bsub>P\<^esub> p) (degree p + degree q) = ( ltrm q \<otimes>\<^bsub>P\<^esub> ltrm p) (degree p + degree q)"
     by (simp add: "3" "4" assms(1) assms(2) cfs_closed)   
   have 6: "ltrm q \<otimes>\<^bsub>P\<^esub> ltrm p = monom P (lcf q \<otimes> lcf p) (degree p + degree q)"
     unfolding  leading_term_def 
     by (metis P_def UP_ring.monom_mult UP_ring_axioms add.commute assms(1) assms(2) cfs_closed)
   have 7: "( ltrm q \<otimes>\<^bsub>P\<^esub> ltrm p) (degree p + degree q) \<noteq>\<zero>"
     using 5  6 assms 
     by (metis R.m_closed cfs_closed cfs_monom)   
   have 8: "degree (q \<otimes>\<^bsub>P\<^esub> p) \<ge>degree p + degree q"
     using 5 6 7 P_def UP_mult_closed assms(1) assms(2) 
     by (simp add: UP_ring.coeff_simp UP_ring_axioms deg_belowI)    
   then show ?thesis 
     using assms(1) assms(2) deg_mult_ring by fastforce
 qed
 
 text\<open>leading term is multiplicative\<close>
 
 lemma ltrm_of_sum_diff_deg:
   assumes "q \<in> carrier P"
   assumes "a \<in> carrier R"
   assumes "a \<noteq>\<zero>"
   assumes "degree q < n"
   assumes "p = q \<oplus>\<^bsub>P\<^esub> (monom P a n)"
   shows "ltrm p =  (monom P a n)"
 proof-
   have 0: "degree  (monom P a n) = n" 
     by (simp add: assms(2) assms(3))
   have 1: "(monom P a n) \<in> carrier P"
     using assms(2) by auto
   have 2: "ltrm ((monom P a n) \<oplus>\<^bsub>P\<^esub> q) = ltrm (monom P a n)"
     using assms ltrm_of_sum_diff_degree[of "(monom P a n)" q] 1  "0" by linarith
   then show ?thesis 
     using UP_a_comm assms(1) assms(2) assms(5) ltrm_monom by auto
 qed
 
 lemma(in UP_cring) ltrm_smult_cring:
   assumes "p \<in> carrier P"
   assumes "a \<in> carrier R"
   assumes "lcf p \<otimes> a \<noteq> \<zero>"
   shows "ltrm (a \<odot>\<^bsub>P\<^esub>p) = a\<odot>\<^bsub>P\<^esub>(ltrm p)"
   using assms 
   by (smt lcf_monom(1) P_def R.m_closed R.m_comm cfs_closed cfs_smult coeff_simp
       cring_deg_mult deg_monom deg_ltrm monom_closed monom_mult_is_smult monom_mult_smult) 
 
 lemma(in UP_cring) deg_zero_ltrm_smult_cring:
   assumes "p \<in> carrier P"
   assumes "a \<in> carrier R"
   assumes "degree p = 0"
   shows "ltrm (a \<odot>\<^bsub>P\<^esub>p) = a\<odot>\<^bsub>P\<^esub>(ltrm p)"
   by (metis ltrm_deg_0 assms(1) assms(2) assms(3) deg_smult_decr le_0_eq module.smult_closed module_axioms)
 
 lemma(in UP_domain) ltrm_smult:
   assumes "p \<in> carrier P"
   assumes "a \<in> carrier R"
   shows "ltrm (a \<odot>\<^bsub>P\<^esub>p) = a\<odot>\<^bsub>P\<^esub>(ltrm p)"
   by (metis lcf_closed ltrm_closed ltrm_smult_cring P_def R.integral_iff UP_ring.deg_ltrm 
       UP_ring_axioms UP_smult_zero assms(1) assms(2) cfs_zero deg_nzero_nzero deg_zero_ltrm_smult_cring monom_zero)
 
 lemma(in UP_cring) cring_ltrm_mult:
   assumes "p \<in> carrier P"
   assumes "q \<in> carrier P"
   assumes "lcf p \<otimes> lcf q \<noteq> \<zero>"
   shows "ltrm (p \<otimes>\<^bsub>P\<^esub> q) = (ltrm p) \<otimes>\<^bsub>P\<^esub> (ltrm q)"
 proof(cases "degree p = 0 \<or> degree q = 0")
   case True
   then show ?thesis 
     by (smt ltrm_closed ltrm_deg_0 ltrm_smult_cring R.m_comm UP_m_comm assms(1) assms(2) assms(3) cfs_closed monom_mult_is_smult)
 next
   case False
     obtain q0 where q0_def: "q0 = trunc q" 
       by simp
     obtain p0 where p0_def: "p0 = trunc p" 
       by simp
     have Pq: "degree q0 < degree q"
       using False P_def assms(2) q0_def trunc_degree by blast          
     have Pp: "degree p0 < degree p"
       using False P_def assms(1) p0_def trunc_degree by blast
     have "p \<otimes>\<^bsub>P\<^esub> q = (p0 \<oplus>\<^bsub>P\<^esub> ltrm(p)) \<otimes>\<^bsub>P \<^esub>(q0 \<oplus>\<^bsub>P\<^esub> ltrm(q))"
       using assms(1) assms(2) p0_def q0_def trunc_simps(1) by auto
     then have P0: "p \<otimes>\<^bsub>P\<^esub> q = ((p0 \<oplus>\<^bsub>P\<^esub> ltrm(p)) \<otimes>\<^bsub>P \<^esub>q0) \<oplus>\<^bsub>P\<^esub> ((p0 \<oplus>\<^bsub>P\<^esub> ltrm(p))\<otimes>\<^bsub>P \<^esub>ltrm(q))"
       by (simp add: P.r_distr assms(1) assms(2) ltrm_closed p0_def q0_def trunc_closed)
     have P1: "degree ((p0 \<oplus>\<^bsub>P\<^esub> ltrm(p)) \<otimes>\<^bsub>P \<^esub>q0) < degree ((p0 \<oplus>\<^bsub>P\<^esub> ltrm(p))\<otimes>\<^bsub>P \<^esub>ltrm(q))"
     proof-
       have LHS: "degree ((p0 \<oplus>\<^bsub>P\<^esub> ltrm(p)) \<otimes>\<^bsub>P \<^esub>q0) \<le> degree p + degree q0 "
       proof(cases "q0 = \<zero>\<^bsub>P\<^esub>")
         case True
         then show ?thesis 
           using assms(1) p0_def trunc_simps(1) by auto
       next
         case False
         then show ?thesis 
           using assms(1) assms(2) deg_mult_ring  p0_def 
             q0_def trunc_simps(1) trunc_closed by auto
       qed
       have RHS: "degree ((p0 \<oplus>\<^bsub>P\<^esub> ltrm(p))\<otimes>\<^bsub>P \<^esub>ltrm(q)) = degree p + degree q"
         using assms(1) assms(2) deg_mult_ring ltrm_closed p0_def trunc_simps(1) 
         by (smt P_def UP_cring.lcf_monom(1) UP_cring.cring_deg_mult UP_cring_axioms add.commute assms(3) cfs_closed deg_ltrm)                    
         then show ?thesis 
           using RHS LHS  Pq 
           by linarith    
     qed
     then have P2: "ltrm (p \<otimes>\<^bsub>P\<^esub> q) = ltrm ((p0 \<oplus>\<^bsub>P\<^esub> ltrm(p))\<otimes>\<^bsub>P \<^esub>ltrm(q))"
       using P0 P1  
       by (metis (no_types, lifting) ltrm_closed ltrm_of_sum_diff_degree P.add.m_comm 
           UP_mult_closed assms(1) assms(2) p0_def q0_def trunc_closed trunc_simps(1))      
     have P3: " ltrm ((p0 \<oplus>\<^bsub>P\<^esub> ltrm(p))\<otimes>\<^bsub>P \<^esub>ltrm(q)) = ltrm p \<otimes>\<^bsub>P\<^esub> ltrm q"
     proof-
       have Q0: "((p0 \<oplus>\<^bsub>P\<^esub> ltrm(p))\<otimes>\<^bsub>P \<^esub>ltrm(q)) = (p0 \<otimes>\<^bsub>P \<^esub>ltrm(q)) \<oplus>\<^bsub>P\<^esub>  (ltrm(p))\<otimes>\<^bsub>P \<^esub>ltrm(q)"
         by (simp add: P.l_distr assms(1) assms(2) ltrm_closed p0_def trunc_closed)
       have Q1: "degree ((p0 \<otimes>\<^bsub>P \<^esub>ltrm(q)) ) < degree ((ltrm(p))\<otimes>\<^bsub>P \<^esub>ltrm(q))"
       proof(cases "p0 = \<zero>\<^bsub>P\<^esub>")
         case True
         then show ?thesis 
           using P1 assms(1) assms(2)  ltrm_closed by auto
       next
         case F: False
         then show ?thesis
           proof-
             have LHS: "degree ((p0 \<otimes>\<^bsub>P \<^esub>ltrm(q))) < degree p + degree q"
               using False F  Pp assms(1) assms(2) deg_nzero_nzero 
                  deg_ltrm ltrm_closed p0_def trunc_closed 
               by (smt add_le_cancel_right deg_mult_ring le_trans not_less)   
             have RHS: "degree ((ltrm(p))\<otimes>\<^bsub>P \<^esub>ltrm(q)) = degree p + degree q" 
               using cring_deg_mult[of "ltrm p" "ltrm q"] assms 
               by (simp add: ltrm_closed ltrm_cfs deg_ltrm)                      
             then show ?thesis using LHS RHS by auto 
         qed
       qed
       have Q2: "ltrm ((p0 \<oplus>\<^bsub>P\<^esub> ltrm(p))\<otimes>\<^bsub>P \<^esub>ltrm(q)) = ltrm ((ltrm(p))\<otimes>\<^bsub>P \<^esub>ltrm(q))" 
         using Q0 Q1 
         by (metis (no_types, lifting) ltrm_closed ltrm_of_sum_diff_degree P.add.m_comm 
             UP_mult_closed assms(1) assms(2) p0_def trunc_closed)        
       show ?thesis using ltrm_prod_ltrm Q0 Q1 Q2 
         by (simp add: assms(1) assms(2))
     qed
     then show ?thesis 
       by (simp add: P2)
 qed
 
 lemma(in UP_domain) ltrm_mult:
   assumes "p \<in> carrier P"
   assumes "q \<in> carrier P"
   shows "ltrm (p \<otimes>\<^bsub>P\<^esub> q) = (ltrm p) \<otimes>\<^bsub>P\<^esub> (ltrm q)"
   using cring_ltrm_mult assms 
   by (smt ltrm_closed ltrm_deg_0 cfs_closed deg_nzero_nzero deg_ltrm local.integral_iff monom_mult monom_zero)
 
 lemma lcf_deg_0:
   assumes "degree p = 0"
   assumes "p \<in> carrier P"
   assumes "q \<in> carrier P"
   shows "(p \<otimes>\<^bsub>P\<^esub> q) = (lcf p)\<odot>\<^bsub>P\<^esub>q" 
   using P_def assms(1) assms(2) assms(3) 
   by (metis ltrm_deg_0 cfs_closed monom_mult_is_smult)
   
 text\<open>leading term powers\<close>
 
 lemma (in domain) nonzero_pow_nonzero:
   assumes "a \<in> carrier R"
   assumes "a \<noteq>\<zero>"
   shows "a[^](n::nat) \<noteq> \<zero>"  
 proof(induction n)
   case 0
   then show ?case 
     by auto
 next
   case (Suc n)
   fix n::nat
   assume IH: "a[^] n \<noteq> \<zero>" 
   show "a[^] (Suc n) \<noteq> \<zero>" 
   proof-
     have "a[^] (Suc n) = a[^] n \<otimes> a"
       by simp
     then show ?thesis using assms IH 
       using IH assms(1) assms(2) local.integral by auto
   qed
 qed
 
 lemma (in UP_cring) cring_monom_degree:
   assumes "a \<in> (carrier R)"
   assumes "p = monom P a m"
   assumes "a[^]n \<noteq> \<zero>"
   shows "degree (p[^]\<^bsub>P\<^esub> n) = n*m"
   by (simp add: assms(1) assms(2) assms(3) monom_pow)
   
 lemma (in UP_domain) monom_degree:
   assumes "a \<noteq>\<zero>"
   assumes "a \<in> (carrier R)"
   assumes "p = monom P a m"
   shows "degree (p[^]\<^bsub>P\<^esub> n) = n*m"
   by (simp add: R.domain_axioms assms(1) assms(2) assms(3) domain.nonzero_pow_nonzero monom_pow)
   
 lemma(in UP_cring)  cring_pow_ltrm:
   assumes "p \<in> carrier P" 
   assumes "lcf p [^]n \<noteq> \<zero>"
   shows "ltrm (p[^]\<^bsub>P\<^esub>(n::nat)) = (ltrm p)[^]\<^bsub>P\<^esub>n"
 proof-
   have "lcf p [^]n \<noteq> \<zero> \<Longrightarrow> ltrm (p[^]\<^bsub>P\<^esub>(n::nat)) = (ltrm p)[^]\<^bsub>P\<^esub>n"
   proof(induction n)
     case 0
     then show ?case 
       using P.ring_simprules(6) P.nat_pow_0 cfs_one deg_one monom_one by presburger
   next
     case (Suc n) fix n::nat
     assume IH : "(lcf p [^] n \<noteq> \<zero> \<Longrightarrow> ltrm (p [^]\<^bsub>P\<^esub> n) = ltrm p [^]\<^bsub>P\<^esub> n)"
     assume A: "lcf p [^] Suc n \<noteq> \<zero>"
     have a: "ltrm (p [^]\<^bsub>P\<^esub> n) = ltrm p [^]\<^bsub>P\<^esub> n"
       apply(cases "lcf p [^] n = \<zero>")
       using A lcf_closed assms(1) apply auto[1]
       by(rule IH)
     have 0: "lcf (ltrm (p [^]\<^bsub>P\<^esub> n)) = lcf p [^] n"
       unfolding a 
       by (simp add: lcf_monom(1) assms(1) cfs_closed monom_pow)
     then have 1: "lcf (ltrm (p [^]\<^bsub>P\<^esub> n)) \<otimes> lcf p \<noteq> \<zero>"
       using assms A R.nat_pow_Suc IH  by metis   
     then show "ltrm (p [^]\<^bsub>P\<^esub> Suc n) = ltrm p [^]\<^bsub>P\<^esub> Suc n"
       using IH 0 assms(1) cring_ltrm_mult cfs_closed 
       by (smt A lcf_monom(1) ltrm_closed P.nat_pow_Suc2 P.nat_pow_closed R.nat_pow_Suc2 a)    
   qed
   then show ?thesis 
     using assms(2) by blast
 qed
 
 lemma(in UP_cring)  cring_pow_deg:
   assumes "p \<in> carrier P" 
   assumes "lcf p [^]n \<noteq> \<zero>"
   shows "degree (p[^]\<^bsub>P\<^esub>(n::nat)) = n*degree p"
 proof-
   have "degree ( (ltrm p)[^]\<^bsub>P\<^esub>n) = n*degree p"
     using assms(1) assms(2) cring_monom_degree lcf_closed lcf_ltrm by auto
   then show ?thesis 
     using assms cring_pow_ltrm 
     by (metis P.nat_pow_closed P_def UP_ring.deg_ltrm UP_ring_axioms)
 qed
 
 lemma(in UP_cring)  cring_pow_deg_bound:
   assumes "p \<in> carrier P" 
   shows "degree (p[^]\<^bsub>P\<^esub>(n::nat)) \<le> n*degree p"
   apply(induction n)
    apply (metis Group.nat_pow_0 deg_one le_zero_eq mult_is_0)  
   using deg_mult_ring[of _ p]
   by (smt P.nat_pow_Suc2 P.nat_pow_closed ab_semigroup_add_class.add_ac(1) assms deg_mult_ring le_iff_add mult_Suc)  
 
 lemma(in UP_cring) deg_smult:
   assumes "a \<in> carrier R"
   assumes "f \<in> carrier (UP R)"
   assumes "a \<otimes> lcf f \<noteq> \<zero>"
   shows "deg R (a \<odot>\<^bsub>UP R\<^esub> f) = deg R  f"
   using assms  P_def cfs_smult deg_eqI deg_smult_decr smult_closed 
   by (metis deg_gtE le_neq_implies_less)
  
 lemma(in UP_cring) deg_smult':
   assumes "a \<in> Units R"
   assumes "f \<in> carrier (UP R)"
   shows "deg R (a \<odot>\<^bsub>UP R\<^esub> f) = deg R  f"
   apply(cases "deg R f = 0")
   apply (metis P_def R.Units_closed assms(1) assms(2) deg_smult_decr le_zero_eq)
   apply(rule deg_smult) 
   using assms apply blast
   using assms apply blast
 proof
   assume A: "deg R f \<noteq> 0" "a \<otimes> f (deg R f) = \<zero>"
   have 0: "f (deg R f) = \<zero>"
     using A assms R.Units_not_right_zero_divisor[of a "f (deg R f)"] UP_car_memE(1) by blast
   then show False  using assms A 
     by (metis P_def deg_zero deg_ltrm monom_zero)
 qed
 
 lemma(in UP_domain)  pow_sum0:
 "\<And> p q. p \<in> carrier P \<Longrightarrow> q \<in> carrier P \<Longrightarrow> degree q < degree p \<Longrightarrow> degree ((p \<oplus>\<^bsub>P\<^esub> q )[^]\<^bsub>P\<^esub>n) = (degree p)*n"
 proof(induction n)
   case 0
   then show ?case 
     by (metis Group.nat_pow_0 deg_one mult_is_0)
 next
     case (Suc n)
     fix n
     assume IH: "\<And> p q. p \<in> carrier P \<Longrightarrow> q \<in> carrier P \<Longrightarrow> 
               degree q < degree p \<Longrightarrow> degree ((p \<oplus>\<^bsub>P\<^esub> q )[^]\<^bsub>P\<^esub>n) = (degree p)*n"
     then show "\<And> p q. p \<in> carrier P \<Longrightarrow> q \<in> carrier P \<Longrightarrow> 
              degree q < degree p \<Longrightarrow> degree ((p \<oplus>\<^bsub>P\<^esub> q )[^]\<^bsub>P\<^esub>(Suc n)) = (degree p)*(Suc n)"
     proof-
       fix p q
       assume A0: "p \<in> carrier P" and 
            A1: "q \<in> carrier P" and 
            A2:  "degree q < degree p"
       show "degree ((p \<oplus>\<^bsub>P\<^esub> q )[^]\<^bsub>P\<^esub>(Suc n)) = (degree p)*(Suc n)"
       proof(cases "q = \<zero>\<^bsub>P\<^esub>")
         case True
         then show ?thesis 
         by (metis A0 A1 A2 IH P.nat_pow_Suc2 P.nat_pow_closed P.r_zero deg_mult 
             domain.nonzero_pow_nonzero local.domain_axioms mult_Suc_right nat_neq_iff)
       next
         case False
         then show ?thesis 
         proof-
           have P0: "degree ((p \<oplus>\<^bsub>P\<^esub> q )[^]\<^bsub>P\<^esub>n) = (degree p)*n" 
           using A0 A1 A2 IH by auto 
           have P1: "(p \<oplus>\<^bsub>P\<^esub> q )[^]\<^bsub>P\<^esub>(Suc n) = ((p \<oplus>\<^bsub>P\<^esub> q )[^]\<^bsub>P\<^esub>n) \<otimes>\<^bsub>P\<^esub> (p \<oplus>\<^bsub>P\<^esub> q )"
             by simp
           then have P2: "(p \<oplus>\<^bsub>P\<^esub> q )[^]\<^bsub>P\<^esub>(Suc n) = (((p \<oplus>\<^bsub>P\<^esub> q )[^]\<^bsub>P\<^esub>n) \<otimes>\<^bsub>P\<^esub> p) \<oplus>\<^bsub>P\<^esub> (((p \<oplus>\<^bsub>P\<^esub> q )[^]\<^bsub>P\<^esub>n) \<otimes>\<^bsub>P\<^esub> q)"
             by (simp add: A0 A1 UP_r_distr)
           have P3: "degree (((p \<oplus>\<^bsub>P\<^esub> q )[^]\<^bsub>P\<^esub>n) \<otimes>\<^bsub>P\<^esub> p) = (degree p)*n + (degree p)" 
             using P0 A0 A1 A2 deg_nzero_nzero  degree_of_sum_diff_degree local.nonzero_pow_nonzero by auto
           have P4: "degree (((p \<oplus>\<^bsub>P\<^esub> q )[^]\<^bsub>P\<^esub>n) \<otimes>\<^bsub>P\<^esub> q) = (degree p)*n + (degree q)" 
             using P0 A0 A1 A2 deg_nzero_nzero  degree_of_sum_diff_degree local.nonzero_pow_nonzero False deg_mult 
             by simp
           have P5: "degree (((p \<oplus>\<^bsub>P\<^esub> q )[^]\<^bsub>P\<^esub>n) \<otimes>\<^bsub>P\<^esub> p) > degree (((p \<oplus>\<^bsub>P\<^esub> q )[^]\<^bsub>P\<^esub>n) \<otimes>\<^bsub>P\<^esub> q)"
             using P3 P4 A2 by auto 
           then show ?thesis using P5 P3 P2 
             by (simp add: A0 A1 degree_of_sum_diff_degree)
         qed
       qed
     qed
 qed
 
 lemma(in UP_domain)  pow_sum:
   assumes "p \<in> carrier P" 
   assumes "q \<in> carrier P"
   assumes "degree q < degree p"
   shows "degree ((p \<oplus>\<^bsub>P\<^esub> q )[^]\<^bsub>P\<^esub>n) = (degree p)*n"
   using assms(1) assms(2) assms(3) pow_sum0 by blast
 
 lemma(in UP_domain)  deg_pow0:
  "\<And> p. p \<in> carrier P \<Longrightarrow> n \<ge> degree p \<Longrightarrow> degree (p [^]\<^bsub>P\<^esub> m) = m*(degree p)"
 proof(induction n)
   case 0
   show "p \<in> carrier P \<Longrightarrow> 0 \<ge> degree p \<Longrightarrow> degree (p [^]\<^bsub>P\<^esub> m) = m*(degree p)"
   proof-
     assume B0:"p \<in> carrier P"
     assume B1: "0 \<ge> degree p"
     then obtain a where a_def: "a \<in> carrier R \<and> p = monom P a 0"
       using B0 deg_zero_impl_monom  by fastforce
     show "degree (p [^]\<^bsub>P\<^esub> m) = m*(degree p)"  using UP_cring.monom_pow 
       by (metis P_def R.nat_pow_closed UP_cring_axioms a_def deg_const  
         mult_0_right mult_zero_left)
   qed
 next
   case (Suc n)
   fix n
   assume IH: "\<And>p. (p \<in> carrier P \<Longrightarrow> n \<ge>degree p \<Longrightarrow> degree (p [^]\<^bsub>P\<^esub> m) = m * (degree p))"
   show "p \<in> carrier P \<Longrightarrow> Suc n \<ge> degree p \<Longrightarrow> degree (p [^]\<^bsub>P\<^esub> m) = m * (degree p)"
   proof-
     assume A0: "p \<in> carrier P"
     assume A1: "Suc n \<ge> degree p"
     show "degree (p [^]\<^bsub>P\<^esub> m) = m * (degree p)"
     proof(cases "Suc n > degree p")
       case True
       then show ?thesis using IH A0 by simp
     next
       case False
       then show ?thesis 
       proof-
         obtain q where q_def: "q = trunc p"
           by simp
         obtain k where k_def: "k = degree q"
           by simp
         have q_is_poly: "q \<in> carrier P" 
           by (simp add: A0 q_def trunc_closed)
         have k_bound0: "k <degree p" 
           using k_def q_def trunc_degree[of p] A0 False by auto
         have k_bound1: "k \<le> n" 
           using k_bound0 A0 A1 by auto  
         have P_q:"degree (q [^]\<^bsub>P\<^esub> m) = m * k" 
           using IH[of "q"] k_bound1 k_def q_is_poly by auto  
         have P_ltrm: "degree ((ltrm p) [^]\<^bsub>P\<^esub> m) = m*(degree p)"
         proof-
           have "degree p = degree (ltrm p)" 
             by (simp add: A0 deg_ltrm)            
           then show ?thesis using monom_degree 
             by (metis A0 P.r_zero P_def cfs_closed coeff_simp equal_deg_sum k_bound0 k_def lcoeff_nonzero2 nat_neq_iff q_is_poly)            
         qed
         have "p = q \<oplus>\<^bsub>P\<^esub> (ltrm p)" 
           by (simp add: A0 q_def trunc_simps(1))
         then show ?thesis 
           using P_q pow_sum[of "(ltrm p)" q m] A0 UP_a_comm 
             deg_ltrm k_bound0 k_def ltrm_closed q_is_poly by auto
       qed
     qed
   qed
 qed
 
 lemma(in UP_domain)  deg_pow:
   assumes "p \<in> carrier P"
   shows "degree (p [^]\<^bsub>P\<^esub> m) = m*(degree p)"
   using deg_pow0 assms by blast
 
 lemma(in UP_domain)  ltrm_pow0:
 "\<And>f. f \<in> carrier P \<Longrightarrow> ltrm (f [^]\<^bsub>P\<^esub> (n::nat)) = (ltrm f) [^]\<^bsub>P\<^esub> n"
 proof(induction n)
   case 0
   then show ?case 
     using ltrm_deg_0 P.nat_pow_0 P.ring_simprules(6) deg_one by presburger  
 next
   case (Suc n)
   fix n::nat
   assume IH: "\<And>f. f \<in> carrier P \<Longrightarrow> ltrm (f [^]\<^bsub>P\<^esub> n) = (ltrm f) [^]\<^bsub>P\<^esub> n"
   then show "\<And>f. f \<in> carrier P \<Longrightarrow> ltrm (f [^]\<^bsub>P\<^esub> (Suc n)) = (ltrm f) [^]\<^bsub>P\<^esub> (Suc n)"
   proof-
     fix f
     assume A: "f \<in> carrier P"
     show " ltrm (f [^]\<^bsub>P\<^esub> (Suc n)) = (ltrm f) [^]\<^bsub>P\<^esub> (Suc n)"
     proof-
       have 0: "ltrm (f [^]\<^bsub>P\<^esub> n) = (ltrm f) [^]\<^bsub>P\<^esub> n" 
         using A IH  by blast
       have 1: "ltrm (f [^]\<^bsub>P\<^esub> (Suc n)) = ltrm ((f [^]\<^bsub>P\<^esub> n)\<otimes>\<^bsub>P\<^esub> f)" 
         by auto then 
       show ?thesis using ltrm_mult 0 1 
         by (simp add: A)
     qed
   qed
 qed
 
 lemma(in UP_domain)  ltrm_pow:
   assumes "f \<in> carrier P"
   shows " ltrm (f [^]\<^bsub>P\<^esub> (n::nat)) = (ltrm f) [^]\<^bsub>P\<^esub> n"
   using assms ltrm_pow0 by blast
 
 text\<open>lemma on the leading coefficient\<close>
 
 lemma lcf_eq:
   assumes "f \<in> carrier P"
   shows "lcf f = lcf (ltrm f)"
   using ltrm_deg_0 
   by (simp add: ltrm_cfs assms deg_ltrm)
   
 lemma lcf_eq_deg_eq_imp_ltrm_eq:
   assumes "p \<in> carrier P"
   assumes "q \<in> carrier P"
   assumes "degree p > 0"
   assumes "degree p = degree q"
   assumes "lcf p = lcf q"
   shows "ltrm p = ltrm q"
   using assms(4) assms(5) 
   by (simp add: leading_term_def)
   
 lemma ltrm_eq_imp_lcf_eq:
   assumes "p \<in> carrier P"
   assumes "q \<in> carrier P"
   assumes "ltrm p = ltrm q"
   shows "lcf p = lcf q"
   using assms 
   by (metis lcf_eq)
 
 lemma ltrm_eq_imp_deg_drop:
   assumes "p \<in> carrier P"
   assumes "q \<in> carrier P"
   assumes "ltrm p = ltrm q"
   assumes "degree p >0"
   shows "degree (p \<ominus>\<^bsub>P\<^esub> q) < degree p"
 proof-
   have P0: "degree p = degree q"
     by (metis assms(1) assms(2) assms(3) deg_ltrm)
   then have P1: "degree (p \<ominus>\<^bsub>P\<^esub> q) \<le> degree p"
     by (metis P.add.inv_solve_right P.minus_closed P.minus_eq assms(1)
         assms(2) degree_of_sum_diff_degree neqE order.strict_implies_order order_refl)
   have "degree (p \<ominus>\<^bsub>P\<^esub> q) \<noteq> degree p"
   proof
     assume A: "degree (p \<ominus>\<^bsub>P\<^esub> q) = degree p"
     have Q0: "p \<ominus>\<^bsub>P\<^esub> q = ((trunc p) \<oplus>\<^bsub>P\<^esub> (ltrm p)) \<ominus>\<^bsub>P\<^esub> ((trunc q) \<oplus>\<^bsub>P\<^esub> (ltrm p))"
       using assms(1) assms(2) assms(3) trunc_simps(1) by force
     have Q1: "p \<ominus>\<^bsub>P\<^esub> q = (trunc p)  \<ominus>\<^bsub>P\<^esub> (trunc q)" 
     proof-
       have "p \<ominus>\<^bsub>P\<^esub> q = ((trunc p) \<oplus>\<^bsub>P\<^esub> (ltrm p)) \<ominus>\<^bsub>P\<^esub> (trunc q) \<ominus> \<^bsub>P\<^esub> (ltrm p)"
         using Q0 
         by (simp add: P.minus_add P.minus_eq UP_a_assoc assms(1) assms(2) ltrm_closed trunc_closed)
       then show ?thesis 
         by (metis (no_types, lifting) ltrm_closed P.add.inv_mult_group P.minus_eq 
             P.r_neg2 UP_a_assoc assms(1) assms(2) assms(3) carrier_is_submodule submoduleE(6) trunc_closed trunc_simps(1))        
     qed
     have Q2: "degree (trunc p) < degree p" 
       by (simp add: assms(1) assms(4) trunc_degree)
     have Q3: "degree (trunc q) < degree q" 
       using P0 assms(2) assms(4) trunc_degree by auto
     then show False  using A Q1 Q2 Q3 by (simp add: P.add.inv_solve_right
           P.minus_eq P0 assms(1) assms(2) degree_of_sum_diff_degree trunc_closed)
   qed
   then show ?thesis 
     using P1 by auto
 qed
 
 lemma(in UP_cring) cring_lcf_scalar_mult:
   assumes "p \<in> carrier P"
   assumes "a \<in> carrier R"
   assumes "a \<otimes> (lcf p) \<noteq>\<zero>"
   shows "lcf (a \<odot>\<^bsub>P\<^esub> p) = a \<otimes> (lcf p)"
 proof-
   have 0: "lcf (a \<odot>\<^bsub>P\<^esub> p) = lcf (ltrm (a \<odot>\<^bsub>P\<^esub> p))"
     using assms  lcf_eq smult_closed by blast
   have 1: "degree (a \<odot>\<^bsub>P\<^esub> p) = degree p"
     by (smt lcf_monom(1) P_def R.one_closed R.r_null UP_ring.coeff_smult UP_ring_axioms  
         assms(1) assms(2) assms(3) coeff_simp cring_deg_mult deg_const monom_closed monom_mult_is_smult smult_one)
   then have "lcf (a \<odot>\<^bsub>P\<^esub> p) = lcf (a \<odot>\<^bsub>P\<^esub> (ltrm p))"
     using lcf_eq[of "a \<odot>\<^bsub>P\<^esub> p"] smult_closed  assms 0 
     by (metis cfs_closed cfs_smult monom_mult_smult)     
   then show ?thesis 
     unfolding leading_term_def 
     by (metis P_def R.m_closed UP_cring.lcf_monom UP_cring_axioms assms(1) assms(2) cfs_closed monom_mult_smult)   
 qed
 
 lemma(in UP_domain) lcf_scalar_mult:
   assumes "p \<in> carrier P"
   assumes "a \<in> carrier R"
   shows "lcf (a \<odot>\<^bsub>P\<^esub> p) = a \<otimes> (lcf p)"
 proof-
   have "lcf (a \<odot>\<^bsub>P\<^esub> p) = lcf (ltrm (a \<odot>\<^bsub>P\<^esub> p))"
     using lcf_eq UP_smult_closed assms(1) assms(2) by blast 
   then have "lcf (a \<odot>\<^bsub>P\<^esub> p) = lcf (a \<odot>\<^bsub>P\<^esub> (ltrm p))"
     using ltrm_smult assms(1) assms(2) by metis   
   then show ?thesis 
     by (metis (full_types) UP_smult_zero assms(1) assms(2) cfs_smult cfs_zero deg_smult)    
 qed
 
 lemma(in UP_cring)  cring_lcf_mult:
   assumes "p \<in> carrier P"
   assumes "q \<in> carrier P"
   assumes "(lcf p) \<otimes> (lcf q) \<noteq>\<zero>"
   shows "lcf (p \<otimes>\<^bsub>P\<^esub> q) = (lcf p) \<otimes> (lcf q)"
   using assms cring_ltrm_mult 
   by (smt lcf_monom(1) P.m_closed R.m_closed cfs_closed monom_mult)
 
 lemma(in UP_domain)  lcf_mult:
   assumes "p \<in> carrier P"
   assumes "q \<in> carrier P"
   shows "lcf (p \<otimes>\<^bsub>P\<^esub> q) = (lcf p) \<otimes> (lcf q)"
   by (smt ltrm_deg_0 R.integral_iff assms(1) assms(2) cfs_closed cring_lcf_mult deg_zero deg_ltrm local.integral_iff monom_zero)
 
 lemma(in UP_cring)  cring_lcf_pow:
   assumes "p \<in> carrier P"
   assumes "(lcf p)[^]n \<noteq>\<zero>"
   shows "lcf (p[^]\<^bsub>P\<^esub>(n::nat)) = (lcf p)[^]n"
   by (smt P.nat_pow_closed R.nat_pow_closed assms(1) assms(2) cring_pow_ltrm lcf_closed lcf_ltrm lcf_monom monom_pow)
 
 lemma(in UP_domain)  lcf_pow:
   assumes "p \<in> carrier P"
   shows "lcf (p[^]\<^bsub>P\<^esub>(n::nat)) = (lcf p)[^]n"
 proof-
   show ?thesis 
   proof(induction n)
     case 0
     then show ?case 
       by (metis Group.nat_pow_0 P_def R.one_closed UP_cring.lcf_monom UP_cring_axioms monom_one)    
   next
     case (Suc n)
     fix n
     assume IH: "lcf (p[^]\<^bsub>P\<^esub>(n::nat)) = (lcf p)[^]n"
     show "lcf (p[^]\<^bsub>P\<^esub>(Suc n)) = (lcf p)[^](Suc n)"
     proof-
       have "lcf (p[^]\<^bsub>P\<^esub>(Suc n)) = lcf ((p[^]\<^bsub>P\<^esub>n) \<otimes>\<^bsub>P\<^esub>p)"
         by simp
       then have "lcf (p[^]\<^bsub>P\<^esub>(Suc n)) = (lcf p)[^]n \<otimes> (lcf p)"
         by (simp add: IH assms lcf_mult)
       then show ?thesis by auto 
     qed
   qed
 qed
 end
 
   (**************************************************************************************************)
   (**************************************************************************************************)
   subsection\<open>Constant Terms and Constant Coefficients\<close>
   (**************************************************************************************************)
   (**************************************************************************************************)
 
 text\<open>Constant term  and coefficient function\<close>
 
 definition zcf where
 "zcf f = (f 0)"
 
 abbreviation(in UP_cring)(input) ctrm where
 "ctrm f \<equiv> monom P (f 0) 0"
 
 context UP_cring
 begin
 
 lemma ctrm_is_poly:
   assumes "p \<in> carrier P"
   shows "ctrm p \<in> carrier P"
   by (simp add: assms cfs_closed)
 
 lemma ctrm_degree:
   assumes "p \<in> carrier P"
   shows "degree (ctrm p) = 0"
   by (simp add: assms cfs_closed) 
   
 lemma ctrm_zcf:
 assumes "f \<in> carrier P"
 assumes "zcf f = \<zero>"
 shows "ctrm f = \<zero>\<^bsub>P\<^esub>"
   by (metis P_def UP_ring.monom_zero UP_ring_axioms zcf_def assms(2))
 
 lemma zcf_degree_zero:
   assumes "f \<in> carrier P"
   assumes "degree f = 0"
   shows "lcf f = zcf f"
   by (simp add: zcf_def assms(2))
   
 lemma zcf_zero_degree_zero:
   assumes "f \<in> carrier P"
   assumes "degree f = 0"
   assumes "zcf f = \<zero>"
   shows "f = \<zero>\<^bsub>P\<^esub>"
   using zcf_degree_zero[of f] assms ltrm_deg_0[of f] 
   by simp
 
 lemma zcf_ctrm:
   assumes "p \<in> carrier P"
   shows "zcf (ctrm p) = zcf p"
   unfolding zcf_def 
   using P_def UP_ring.cfs_monom UP_ring_axioms assms cfs_closed by fastforce
  
 lemma ctrm_trunc:
   assumes "p \<in> carrier P"
   assumes "degree p >0"
   shows "zcf(trunc p) = zcf p"
   by (simp add: zcf_def assms(1) assms(2) trunc_cfs)
 
 text\<open>Constant coefficient function is a ring homomorphism\<close>
 
 
 lemma zcf_add:
   assumes "p \<in> carrier P"
   assumes "q \<in> carrier P"
   shows "zcf(p \<oplus>\<^bsub>P\<^esub> q) = (zcf p) \<oplus> (zcf q)"
   by (simp add: zcf_def assms(1) assms(2))
 
 lemma coeff_ltrm[simp]:
   assumes "p \<in> carrier P"
   assumes "degree p > 0"
   shows "zcf(ltrm p) = \<zero>"
   by (metis ltrm_cfs_above_deg ltrm_cfs zcf_def assms(1) assms(2))
 
 lemma zcf_zero[simp]:
 "zcf \<zero>\<^bsub>P\<^esub> = \<zero>"
   using zcf_degree_zero by auto
 
 lemma zcf_one[simp]:
 "zcf \<one>\<^bsub>P\<^esub> = \<one>"
   by (simp add: zcf_def)
 
 lemma ctrm_smult:
   assumes "f \<in> carrier P"
   assumes "a \<in>  carrier R"
   shows "ctrm (a \<odot>\<^bsub>P\<^esub> f) = a \<odot>\<^bsub>P\<^esub>(ctrm f)"
   using P_def UP_ring.monom_mult_smult UP_ring_axioms assms(1) assms(2) cfs_smult coeff_simp 
   by (simp add: UP_ring.monom_mult_smult cfs_closed)
 
 lemma ctrm_monom[simp]:
   assumes "a \<in> carrier R"
   shows "ctrm (monom P a (Suc k)) = \<zero>\<^bsub>P\<^esub>"
   by (simp add: assms cfs_monom)
 end
   (**************************************************************************************************)
   (**************************************************************************************************)
   subsection\<open>Polynomial Induction Rules\<close>
   (**************************************************************************************************)
   (**************************************************************************************************)
 
 context UP_ring
 begin
 
 text\<open>Rule for strong induction on polynomial degree\<close>
 
 lemma poly_induct:
   assumes "p \<in> carrier P"
   assumes Deg_0: "\<And>p. p \<in> carrier P \<Longrightarrow> degree p = 0 \<Longrightarrow> Q p"
   assumes IH: "\<And>p. (\<And>q. q \<in> carrier P \<Longrightarrow> degree q < degree p \<Longrightarrow> Q q) \<Longrightarrow> p \<in> carrier P \<Longrightarrow> degree p > 0 \<Longrightarrow> Q p"
   shows "Q p"
 proof-
   have "\<And>n. \<And>p. p \<in> carrier P \<Longrightarrow> degree p \<le> n \<Longrightarrow> Q p"
   proof-
     fix n
     show "\<And>p. p \<in> carrier P \<Longrightarrow>  degree p \<le> n \<Longrightarrow> Q p"
     proof(induction n)
       case 0
       then show ?case 
         using Deg_0  by simp
     next
       case (Suc n)
       fix n 
       assume I:  "\<And>p. p \<in> carrier P \<Longrightarrow>  degree p \<le> n \<Longrightarrow> Q p"
       show  "\<And>p. p \<in> carrier P \<Longrightarrow>  degree p \<le> (Suc n) \<Longrightarrow> Q p"
       proof-
         fix p
         assume A0: " p \<in> carrier P "
         assume A1: "degree p \<le>Suc n"
         show "Q p"
         proof(cases "degree p < Suc n")
           case True
           then show ?thesis 
             using I  A0 by auto
         next
           case False
           then have D: "degree p = Suc n" 
             by (simp add: A1 nat_less_le)
           then  have "(\<And>q. q \<in> carrier P \<Longrightarrow> degree q < degree p \<Longrightarrow> Q q)" 
               using I   by simp
             then show "Q p" 
                   using IH D A0 A1 Deg_0 by blast
         qed
       qed
     qed
   qed
   then show ?thesis using assms by blast 
 qed
 
 text\<open>Variant on induction on degree\<close>
 
 lemma poly_induct2:
   assumes "p \<in> carrier P"
   assumes Deg_0: "\<And>p. p \<in> carrier P \<Longrightarrow> degree p = 0 \<Longrightarrow> Q p"
   assumes IH: "\<And>p. degree p > 0  \<Longrightarrow> p \<in> carrier P \<Longrightarrow> Q (trunc p)  \<Longrightarrow> Q p"
   shows "Q p"
 proof(rule poly_induct)
   show "p \<in> carrier P" 
     by (simp add: assms(1))
   show "\<And>p. p \<in> carrier P \<Longrightarrow> degree p = 0 \<Longrightarrow> Q p" 
       by (simp add: Deg_0)
     show "\<And>p. (\<And>q. q \<in> carrier P \<Longrightarrow> degree q < degree p \<Longrightarrow> Q q) \<Longrightarrow> p \<in> carrier P \<Longrightarrow> 0 < degree p \<Longrightarrow> Q p"
     proof-
       fix p
       assume A0: "(\<And>q. q \<in> carrier P \<Longrightarrow> degree q < degree p \<Longrightarrow> Q q)"
       assume A1: " p \<in> carrier P"
       assume A2: "0 < degree p" 
       show "Q p"
       proof-
         have "degree (trunc p) < degree p"
           by (simp add: A1 A2 trunc_degree)
         have "Q (trunc p)"
           by (simp add: A0 A1 \<open>degree (trunc p) < degree p\<close> trunc_closed)
         then show ?thesis 
           by (simp add: A1 A2 IH)
       qed
     qed
 qed
 
 text\<open>Additive properties which are true for all monomials are true for all polynomials \<close>
 
 lemma poly_induct3:
   assumes "p \<in> carrier P"
   assumes add: "\<And>p q. q \<in> carrier P \<Longrightarrow> p \<in> carrier P \<Longrightarrow> Q p \<Longrightarrow> Q q  \<Longrightarrow> Q (p \<oplus>\<^bsub>P\<^esub> q)"
   assumes monom: "\<And>a n. a \<in> carrier R \<Longrightarrow> Q (monom P a n)"
   shows "Q p"
   apply(rule poly_induct2)
   apply (simp add: assms(1))
   apply (metis lcf_closed P_def coeff_simp deg_zero_impl_monom monom)
   by (metis lcf_closed ltrm_closed add monom trunc_closed trunc_simps(1))
 
 lemma poly_induct4:
   assumes "p \<in> carrier P"
   assumes add: "\<And>p q. q \<in> carrier P \<Longrightarrow> p \<in> carrier P \<Longrightarrow> Q p \<Longrightarrow> Q q  \<Longrightarrow> Q (p \<oplus>\<^bsub>P\<^esub> q)"
   assumes monom_zero: "\<And>a. a \<in> carrier R \<Longrightarrow> Q (monom P a 0)"
   assumes monom_Suc: "\<And>a n. a \<in> carrier R \<Longrightarrow> Q (monom P a (Suc n))"
   shows "Q p"
   apply(rule poly_induct3)
   using assms(1) apply auto[1]
   using add apply blast
   using monom_zero monom_Suc 
   by (metis P_def UP_ring.monom_zero UP_ring_axioms deg_monom deg_monom_le le_0_eq le_SucE zero_induct)
 
 lemma monic_monom_smult:
   assumes "a \<in> carrier R"
   shows "a \<odot>\<^bsub>P\<^esub> monom P \<one> n = monom P a n"
   using assms 
   by (metis R.one_closed R.r_one monom_mult_smult)
 
 lemma poly_induct5:
   assumes "p \<in> carrier P"
   assumes add: "\<And>p q. q \<in> carrier P \<Longrightarrow> p \<in> carrier P \<Longrightarrow> Q p \<Longrightarrow> Q q  \<Longrightarrow> Q (p \<oplus>\<^bsub>P\<^esub> q)"
   assumes monic_monom: "\<And>n. Q (monom P \<one> n)"
   assumes smult: "\<And>p a . a \<in> carrier R \<Longrightarrow> p \<in> carrier P \<Longrightarrow> Q p \<Longrightarrow> Q (a \<odot>\<^bsub>P\<^esub> p)"
   shows "Q p"
   apply(rule poly_induct3)
   apply (simp add: assms(1))
   using add apply blast
 proof-
   fix a n assume A: "a \<in> carrier R" show "Q (monom P a n)"
     using monic_monom[of n] smult[of a "monom P \<one> n"] monom_mult_smult[of a \<one> n]
   by (simp add: A)
 qed
 
 lemma poly_induct6:
   assumes "p \<in> carrier P"
   assumes monom: "\<And>a n. a \<in> carrier R \<Longrightarrow> Q (monom P a 0)"
   assumes plus_monom: "\<And>a n p. a \<in> carrier R \<Longrightarrow> a \<noteq> \<zero> \<Longrightarrow> p \<in> carrier P \<Longrightarrow> degree p < n \<Longrightarrow> Q p \<Longrightarrow>
                                 Q(p \<oplus>\<^bsub>P\<^esub> monom P a n)"
   shows "Q p"
   apply(rule poly_induct2)
   using assms(1) apply auto[1]
   apply (metis lcf_closed P_def coeff_simp deg_zero_impl_monom monom)
   using plus_monom 
   by (metis lcf_closed P_def coeff_simp lcoeff_nonzero_deg nat_less_le trunc_closed trunc_degree trunc_simps(1))
   
 
 end
 
 (**************************************************************************************************)
 (**************************************************************************************************)
 section\<open>Mapping a Polynomial to its Associated Ring Function\<close>
 (**************************************************************************************************)
 (**************************************************************************************************)
 
 
 text\<open>Turning a polynomial into a function on R:\<close>
 definition to_function  where
 "to_function S f  = (\<lambda>s \<in> carrier S. eval S S (\<lambda>x. x) s f)"
 
 context UP_cring
 begin
 
 definition to_fun where
 "to_fun f \<equiv> to_function R f"
 
 text\<open>Explicit formula for evaluating a polynomial function:\<close>
 
 lemma to_fun_eval:
   assumes "f \<in> carrier P"
   assumes "x \<in> carrier R"
   shows "to_fun f x  = eval R R (\<lambda>x. x) x f"
   using assms unfolding to_function_def to_fun_def 
   by auto 
 
 lemma to_fun_formula:
   assumes "f \<in> carrier P"
   assumes "x \<in> carrier R"
   shows "to_fun f x = (\<Oplus>i \<in> {..degree f}. (f i) \<otimes> x [^] i)"
 proof-
   have "f \<in> carrier (UP R)"
     using assms P_def by auto 
   then  have "eval R R (\<lambda>x. x) x f =  (\<Oplus>\<^bsub>R\<^esub>i\<in>{..deg R f}. (\<lambda>x. x) (coeff (UP R) f i) \<otimes>\<^bsub>R\<^esub> x [^]\<^bsub>R\<^esub> i)"
     apply(simp add:UnivPoly.eval_def) done
   then have "to_fun f x = (\<Oplus>\<^bsub>R\<^esub>i\<in>{..deg R f}. (\<lambda>x. x) (coeff (UP R) f i) \<otimes>\<^bsub>R\<^esub> x [^]\<^bsub>R\<^esub> i)"
     using to_function_def assms unfolding to_fun_def  
     by (simp add: to_function_def)
   then show ?thesis  
     by(simp add: assms coeff_simp) 
 qed
 
 lemma eval_ring_hom:
   assumes "a \<in> carrier R"
   shows "eval R R (\<lambda>x. x) a \<in> ring_hom P R"
 proof-
   have "(\<lambda>x. x) \<in> ring_hom R R"
     apply(rule ring_hom_memI)
     apply auto done
   then have "UP_pre_univ_prop R R (\<lambda>x. x)"
     using R_cring UP_pre_univ_propI by blast
   then show ?thesis 
     by (simp add: P_def UP_pre_univ_prop.eval_ring_hom assms)
 qed
 
 lemma to_fun_closed:
   assumes "f \<in> carrier P"
   assumes "x \<in> carrier R"
   shows "to_fun f x  \<in> carrier R"
   using assms to_fun_eval[of f x] eval_ring_hom[of x]
   ring_hom_closed 
   by fastforce
   
 lemma to_fun_plus:
   assumes "g \<in> carrier P"
   assumes "f \<in> carrier P"
   assumes "x \<in> carrier R"
   shows "to_fun (f \<oplus>\<^bsub>P\<^esub> g) x = (to_fun f x) \<oplus> (to_fun g x)"
   using assms to_fun_eval[of ] eval_ring_hom[of x]
   by (simp add: ring_hom_add)
   
 lemma to_fun_mult:
   assumes "g \<in> carrier P"
   assumes "f \<in> carrier P"
   assumes "x \<in> carrier R"
   shows "to_fun (f \<otimes>\<^bsub>P\<^esub> g) x = (to_fun f x) \<otimes> (to_fun g x)"
   using assms to_fun_eval[of ] eval_ring_hom[of x]
   by (simp add: ring_hom_mult)
 
 lemma to_fun_ring_hom:
   assumes "a \<in> carrier R"
   shows "(\<lambda>p. to_fun p a) \<in> ring_hom P R"
   apply(rule ring_hom_memI)
   apply (simp add: assms to_fun_closed)
     apply (simp add: assms to_fun_mult)
       apply (simp add: assms to_fun_plus)
         using to_fun_eval[of "\<one>\<^bsub>P\<^esub>" a] eval_ring_hom[of a] 
               ring_hom_closed 
         by (simp add: assms ring_hom_one)
 
 lemma ring_hom_uminus:
   assumes "ring S"
   assumes "f \<in> (ring_hom S R)"
   assumes "a \<in> carrier S"
   shows "f (\<ominus>\<^bsub>S\<^esub> a) = \<ominus> (f a)"
 proof-
   have "f (a \<ominus>\<^bsub>S\<^esub> a) = (f a) \<oplus> f (\<ominus>\<^bsub>S\<^esub> a)"
     unfolding a_minus_def 
     by (simp add: assms(1) assms(2) assms(3) ring.ring_simprules(3) ring_hom_add)
   then have "(f a) \<oplus> f (\<ominus>\<^bsub>S\<^esub> a) = \<zero> "
     by (metis R.ring_axioms a_minus_def assms(1) assms(2) assms(3) 
         ring.ring_simprules(16) ring_hom_zero)
   then show ?thesis 
     by (metis (no_types, lifting) R.add.m_comm R.minus_equality assms(1)
         assms(2) assms(3) ring.ring_simprules(3) ring_hom_closed)
 qed
 
 lemma to_fun_minus:
   assumes "f \<in> carrier P"
   assumes "x \<in> carrier R"
   shows "to_fun (\<ominus>\<^bsub>P\<^esub>f) x = \<ominus> (to_fun f x)"
   unfolding to_function_def to_fun_def 
   using  eval_ring_hom[of x] assms  
   by (simp add: UP_ring ring_hom_uminus)
 
 lemma id_is_hom:
 "ring_hom_cring R R (\<lambda>x. x)"
 proof(rule ring_hom_cringI)
   show "cring R" 
     by (simp add: R_cring )
   show "cring R" 
     by (simp add: R_cring ) 
   show "(\<lambda>x. x) \<in> ring_hom R R"
     unfolding ring_hom_def
     apply(auto)
     done
 qed
 
 lemma UP_pre_univ_prop_fact:
 "UP_pre_univ_prop R R (\<lambda>x. x)"
   unfolding UP_pre_univ_prop_def
   by (simp add: UP_cring_def R_cring  id_is_hom)
 
 end
 
   (**************************************************************************************************)
   (**************************************************************************************************)
   subsection\<open>to-fun is a Ring Homomorphism from Polynomials to Functions\<close>
   (**************************************************************************************************)
   (**************************************************************************************************)
 
 context UP_cring
 begin
 
 lemma to_fun_is_Fun:
   assumes "x \<in> carrier P"
   shows "to_fun x \<in> carrier (Fun R)"
   apply(rule ring_functions.function_ring_car_memI)
   unfolding ring_functions_def apply(simp add: R.ring_axioms)
   using to_fun_closed assms apply auto[1]
   unfolding to_function_def to_fun_def  by auto 
 
 lemma to_fun_Fun_mult:
   assumes "x \<in> carrier P"
   assumes "y \<in> carrier P"
   shows "to_fun (x \<otimes>\<^bsub>P\<^esub> y) = to_fun x \<otimes>\<^bsub>function_ring (carrier R) R\<^esub> to_fun y"
   apply(rule ring_functions.function_ring_car_eqI[of R _ "carrier R"])
   apply (simp add: R.ring_axioms ring_functions_def)
     apply (simp add: assms(1) assms(2) to_fun_is_Fun)
       apply (simp add: R.ring_axioms assms(1) assms(2) ring_functions.fun_mult_closed ring_functions.intro to_fun_is_Fun)
         by (simp add: R.ring_axioms assms(1) assms(2) ring_functions.function_mult_eval_car ring_functions.intro to_fun_is_Fun to_fun_mult)
 
 lemma to_fun_Fun_add:
   assumes "x \<in> carrier P"
   assumes "y \<in> carrier P"
   shows "to_fun (x \<oplus>\<^bsub>P\<^esub> y) = to_fun x \<oplus>\<^bsub>function_ring (carrier R) R\<^esub> to_fun y"
   apply(rule ring_functions.function_ring_car_eqI[of R _ "carrier R"])
   apply (simp add: R.ring_axioms ring_functions_def)
     apply (simp add: assms(1) assms(2) to_fun_is_Fun)
       apply (simp add: R.ring_axioms assms(1) assms(2) ring_functions.fun_add_closed ring_functions.intro to_fun_is_Fun)
         by (simp add: R.ring_axioms assms(1) assms(2) ring_functions.fun_add_eval_car ring_functions.intro to_fun_is_Fun to_fun_plus)
 
 lemma to_fun_Fun_one:
 "to_fun \<one>\<^bsub>P\<^esub> = \<one>\<^bsub>Fun R\<^esub>"
   apply(rule ring_functions.function_ring_car_eqI[of R _ "carrier R"])
   apply (simp add: R.ring_axioms ring_functions_def)
     apply (simp add: to_fun_is_Fun)
       apply (simp add: R.ring_axioms ring_functions.function_one_closed ring_functions_def)
         using P_def R.ring_axioms UP_cring.eval_ring_hom UP_cring.to_fun_eval UP_cring_axioms UP_one_closed ring_functions.function_one_eval ring_functions.intro ring_hom_one 
           by fastforce
 
 lemma to_fun_Fun_zero:
 "to_fun \<zero>\<^bsub>P\<^esub> = \<zero>\<^bsub>Fun R\<^esub>"
   apply(rule ring_functions.function_ring_car_eqI[of R _ "carrier R"])
   apply (simp add: R.ring_axioms ring_functions_def)
     apply (simp add: to_fun_is_Fun)
       apply (simp add: R.ring_axioms ring_functions.function_zero_closed ring_functions_def)
         using P_def R.ring_axioms UP_cring.eval_ring_hom UP_cring.to_fun_eval UP_cring_axioms UP_zero_closed ring_functions.function_zero_eval ring_functions.intro ring_hom_zero 
         by (metis UP_ring eval_ring_hom)
 
 lemma to_fun_function_ring_hom:
 "to_fun \<in> ring_hom P (Fun R)"
   apply(rule ring_hom_memI)
     using to_fun_is_Fun apply auto[1]
       apply (simp add: to_fun_Fun_mult)
         apply (simp add: to_fun_Fun_add)
           by (simp add: to_fun_Fun_one)
 
 lemma(in UP_cring) to_fun_one:
   assumes "a \<in> carrier R"
   shows "to_fun \<one>\<^bsub>P\<^esub> a = \<one>"
   using assms to_fun_Fun_one 
   by (metis P_def UP_cring.to_fun_eval UP_cring_axioms UP_one_closed eval_ring_hom ring_hom_one) 
 
 lemma(in UP_cring) to_fun_zero:
   assumes "a \<in> carrier R"
   shows "to_fun \<zero>\<^bsub>P\<^esub> a = \<zero>"
   by (simp add: assms R.ring_axioms ring_functions.function_zero_eval ring_functions.intro to_fun_Fun_zero) 
 
 lemma(in UP_cring) to_fun_nat_pow:
   assumes "h \<in> carrier (UP R)"
   assumes "a \<in> carrier R"
   shows "to_fun (h[^]\<^bsub>UP R\<^esub>(n::nat)) a = (to_fun h a)[^]n"
   apply(induction n)
   using assms to_fun_one 
   apply (metis P.nat_pow_0 P_def R.nat_pow_0)
   using assms to_fun_mult  P.nat_pow_closed P_def by auto
 
 lemma(in UP_cring) to_fun_finsum: 
   assumes "finite (Y::'d set)"
   assumes "f \<in> UNIV \<rightarrow> carrier (UP R)"
   assumes "t \<in> carrier R"
   shows "to_fun (finsum (UP R) f Y) t = finsum R (\<lambda>i. (to_fun (f i) t)) Y"
 proof(rule finite.induct[of Y])
   show "finite Y"
     using assms by blast 
   show "to_fun (finsum (UP R) f {}) t = (\<Oplus>i\<in>{}. to_fun (f i) t)"
     using P.finsum_empty[of f] assms unfolding P_def R.finsum_empty 
     using P_def to_fun_zero by presburger
   show  "\<And>A a. finite A \<Longrightarrow>
            to_fun (finsum (UP R) f A) t = (\<Oplus>i\<in>A. to_fun (f i) t) \<Longrightarrow> to_fun (finsum (UP R) f (insert a A)) t = (\<Oplus>i\<in>insert a A. to_fun (f i) t)"
   proof-     
     fix A :: "'d set" fix a
     assume A: "finite A" "to_fun (finsum (UP R) f A) t = (\<Oplus>i\<in>A. to_fun (f i) t)"
     show "to_fun (finsum (UP R) f (insert a A)) t = (\<Oplus>i\<in>insert a A. to_fun (f i) t)"
     proof(cases "a \<in> A")
       case True
       then show ?thesis using A 
         by (metis insert_absorb)
     next
       case False
       have 0: "finsum (UP R) f (insert a A) = f a \<oplus>\<^bsub>UP R\<^esub> finsum (UP R) f A"
         using A False finsum_insert[of A a f] assms unfolding P_def  by blast
       have 1: "to_fun (f a \<oplus>\<^bsub>P\<^esub>finsum (UP R) f A ) t =  to_fun (f a) t \<oplus> to_fun (finsum (UP R) f A) t"
         apply(rule to_fun_plus[of  "finsum (UP R) f A" "f a" t])
         using assms(2) finsum_closed[of f A] A unfolding P_def apply blast
         using P_def assms apply blast
         using assms by blast
       have 2: "to_fun (f a \<oplus>\<^bsub>P\<^esub>finsum (UP R) f A ) t =  to_fun (f a) t \<oplus> (\<Oplus>i\<in>A. to_fun (f i) t)"
         unfolding  1 A by blast 
       have 3: "(\<Oplus>i\<in>insert a A. to_fun (f i) t) = to_fun (f a) t \<oplus> (\<Oplus>i\<in>A. to_fun (f i) t)"
         apply(rule  R.finsum_insert, rule A, rule False)
         using to_fun_closed assms unfolding P_def apply blast
         apply(rule to_fun_closed) using assms unfolding P_def apply blast using assms by blast 
       show ?thesis 
         unfolding 0 unfolding 3 using 2 unfolding P_def by blast 
     qed
   qed
 qed
 
 end
 
 (**************************************************************************************************)
 (**************************************************************************************************)
 subsection\<open>Inclusion of a Ring into its Polynomials Ring via Constants\<close>
 (**************************************************************************************************)
 (**************************************************************************************************)
 
 definition to_polynomial where
 "to_polynomial R = (\<lambda>a. monom (UP R) a 0)"
 
 context UP_cring
 begin
 
 abbreviation(input) to_poly where
 "to_poly  \<equiv> to_polynomial R"
 
 lemma to_poly_mult_simp:
   assumes "b \<in> carrier R"
   assumes "f \<in> carrier (UP R)"
   shows "(to_polynomial R b) \<otimes>\<^bsub>UP R\<^esub> f = b \<odot>\<^bsub>UP R\<^esub> f"
         "f  \<otimes>\<^bsub>UP R\<^esub> (to_polynomial R b) = b \<odot>\<^bsub>UP R\<^esub> f"   
   unfolding to_polynomial_def
   using assms  P_def monom_mult_is_smult apply auto[1]
   using UP_cring.UP_m_comm UP_cring_axioms UP_ring.monom_closed 
         UP_ring.monom_mult_is_smult UP_ring_axioms assms(1) assms(2) 
   by fastforce  
 
 lemma to_fun_to_poly:
   assumes "a \<in> carrier R"
   assumes "b \<in> carrier R"
   shows "to_fun (to_poly a) b = a"
   unfolding to_function_def to_fun_def to_polynomial_def 
   by (simp add: UP_pre_univ_prop.eval_const UP_pre_univ_prop_fact assms(1) assms(2))
   
 lemma to_poly_inverse:
   assumes "f \<in> carrier P"
   assumes "degree f = 0"
   shows "f = to_poly (f 0)"
   using P_def assms(1) assms(2) 
   by (metis ltrm_deg_0 to_polynomial_def) 
 
 lemma to_poly_closed:
   assumes "a \<in> carrier R"
   shows "to_poly a \<in> carrier P"
   by (metis P_def assms monom_closed to_polynomial_def)
 
 lemma degree_to_poly[simp]:
   assumes "a \<in> carrier R"
   shows "degree (to_poly a) = 0"
   by (metis P_def assms deg_const to_polynomial_def)
 
 lemma to_poly_is_ring_hom:
 "to_poly \<in> ring_hom R P"
   unfolding to_polynomial_def
   unfolding P_def
   using UP_ring.const_ring_hom[of R]
   UP_ring_axioms by simp 
 
 lemma to_poly_add:
   assumes "a \<in> carrier R"
   assumes "b \<in> carrier R"
   shows "to_poly (a \<oplus> b) = to_poly a \<oplus>\<^bsub>P\<^esub> to_poly b"
   by (simp add: assms(1) assms(2) ring_hom_add to_poly_is_ring_hom)
 
 lemma to_poly_mult:
   assumes "a \<in> carrier R"
   assumes "b \<in> carrier R"
   shows "to_poly (a \<otimes> b) = to_poly a \<otimes>\<^bsub>P\<^esub> to_poly b"
   by (simp add: assms(1) assms(2) ring_hom_mult to_poly_is_ring_hom)
 
 lemma to_poly_minus:
   assumes "a \<in> carrier R"
   assumes "b \<in> carrier R"
   shows "to_poly (a \<ominus> b) = to_poly a \<ominus>\<^bsub>P\<^esub> to_poly b"
   by (metis P.minus_eq P_def R.add.inv_closed R.ring_axioms UP_ring.monom_add 
       UP_ring_axioms assms(1) assms(2) monom_a_inv ring.ring_simprules(14) to_polynomial_def)
 
 lemma to_poly_a_inv:
   assumes "a \<in> carrier R"
   shows "to_poly (\<ominus> a) =  \<ominus>\<^bsub>P\<^esub> to_poly a"
   by (metis P_def assms monom_a_inv to_polynomial_def)
 
 lemma to_poly_nat_pow:
   assumes "a \<in> carrier R"
   shows "(to_poly a) [^]\<^bsub>P\<^esub> (n::nat)= to_poly (a[^]n)"
   using assms UP_cring UP_cring_axioms UP_cring_def UnivPoly.ring_hom_cringI ring_hom_cring.hom_pow to_poly_is_ring_hom 
   by fastforce
 
 
 end
 
 (**************************************************************************************************)
 (**************************************************************************************************)
 section\<open>Polynomial Substitution\<close>
 (**************************************************************************************************)
 (**************************************************************************************************)
 
 definition compose where
 "compose R f g = eval R (UP R) (to_polynomial R) g f"
 
 abbreviation(in UP_cring)(input) sub  (infixl "of" 70) where
 "sub f g \<equiv> compose R f g"
 
 definition rev_compose  where
 "rev_compose R = eval R (UP R) (to_polynomial R)"
 
 abbreviation(in UP_cring)(input) rev_sub  where
 "rev_sub \<equiv> rev_compose R"
 
 context UP_cring
 begin
 
 lemma  sub_rev_sub:
 "sub f g = rev_sub g f"
   unfolding compose_def rev_compose_def 
   by simp  
 
 lemma(in UP_cring) to_poly_UP_pre_univ_prop:
 "UP_pre_univ_prop R P to_poly"
 proof 
   show "to_poly \<in> ring_hom R P" 
     by (simp add: to_poly_is_ring_hom)
 qed
 
 lemma rev_sub_is_hom:
   assumes "g \<in> carrier P"
   shows "rev_sub g \<in> ring_hom P P"
   unfolding rev_compose_def
   using to_poly_UP_pre_univ_prop assms(1) UP_pre_univ_prop.eval_ring_hom[of R P to_poly g] 
   unfolding P_def apply auto 
   done
 
 lemma rev_sub_closed:
   assumes "p \<in> carrier P"
   assumes "q \<in> carrier P"
   shows "rev_sub q p \<in> carrier P"
   using rev_sub_is_hom[of q] assms ring_hom_closed[of "rev_sub q" P P p] by auto  
 
 lemma sub_closed:
   assumes "p \<in> carrier P"
   assumes "q \<in> carrier P"
   shows "sub q p \<in> carrier P"
   by (simp add: assms(1) assms(2) rev_sub_closed sub_rev_sub)
 
 lemma rev_sub_add:
   assumes "g \<in> carrier P"
   assumes "f \<in> carrier P"
   assumes "h \<in>carrier P"
   shows "rev_sub g (f \<oplus>\<^bsub>P\<^esub> h) = (rev_sub g f) \<oplus>\<^bsub>P\<^esub> (rev_sub g h)"
   using rev_sub_is_hom assms ring_hom_add by fastforce
 
 lemma sub_add: 
   assumes "g \<in> carrier P"
   assumes "f \<in> carrier P"
   assumes "h \<in>carrier P"
   shows "((f \<oplus>\<^bsub>P\<^esub> h) of g) = ((f of g) \<oplus>\<^bsub>P\<^esub> (h of g))"
   by (simp add: assms(1) assms(2) assms(3) rev_sub_add sub_rev_sub)
 
 lemma rev_sub_mult:
   assumes "g \<in> carrier P"
   assumes "f \<in> carrier P"
   assumes "h \<in>carrier P"
   shows "rev_sub g (f \<otimes>\<^bsub>P\<^esub> h) = (rev_sub g f) \<otimes>\<^bsub>P\<^esub> (rev_sub g h)"
   using rev_sub_is_hom assms ring_hom_mult  by fastforce
 
 lemma sub_mult: 
   assumes "g \<in> carrier P"
   assumes "f \<in> carrier P"
   assumes "h \<in>carrier P"
   shows "((f \<otimes>\<^bsub>P\<^esub> h) of g) = ((f of g) \<otimes>\<^bsub>P\<^esub> (h of g))"
   by (simp add: assms(1) assms(2) assms(3) rev_sub_mult sub_rev_sub)
 
 lemma sub_monom:
   assumes "g \<in> carrier (UP R)"
   assumes "a \<in> carrier R"
   shows "sub (monom (UP R) a n) g = to_poly a  \<otimes>\<^bsub>UP R\<^esub> (g[^]\<^bsub>UP R\<^esub> (n::nat))" 
         "sub (monom (UP R) a n) g = a \<odot>\<^bsub>UP R\<^esub> (g[^]\<^bsub>UP R\<^esub> (n::nat))" 
    apply (simp add: UP_cring.to_poly_UP_pre_univ_prop UP_cring_axioms 
           UP_pre_univ_prop.eval_monom assms(1) assms(2) Cring_Poly.compose_def)
   by (metis P_def UP_cring.to_poly_mult_simp(1) UP_cring_axioms UP_pre_univ_prop.eval_monom 
       UP_ring assms(1) assms(2) Cring_Poly.compose_def monoid.nat_pow_closed ring_def to_poly_UP_pre_univ_prop) 
  
 text\<open>Subbing into a constant does nothing\<close>
 
 lemma rev_sub_to_poly:
   assumes "g \<in> carrier P"
   assumes "a \<in> carrier R"
   shows "rev_sub g (to_poly a) = to_poly a"
   unfolding to_polynomial_def rev_compose_def
   using to_poly_UP_pre_univ_prop 
   unfolding to_polynomial_def 
      using P_def UP_pre_univ_prop.eval_const assms(1) assms(2) by fastforce
 
 lemma sub_to_poly:
   assumes "g \<in> carrier P"
   assumes "a \<in> carrier R"
   shows "(to_poly a) of g  = to_poly a"
   by (simp add: assms(1) assms(2) rev_sub_to_poly sub_rev_sub)
 
 lemma sub_const:
   assumes "g \<in> carrier P"
   assumes "f \<in> carrier P"
   assumes "degree f = 0"
   shows "f of g = f"
   by (metis lcf_closed assms(1) assms(2) assms(3) sub_to_poly to_poly_inverse)
 
 text\<open>Substitution into a monomial\<close>
 
 lemma monom_sub:
   assumes "a \<in> carrier R"
   assumes "g \<in> carrier P"
   shows "(monom P a n) of g = a \<odot>\<^bsub>P\<^esub> g[^]\<^bsub>P\<^esub> n"
     unfolding compose_def
     using assms UP_pre_univ_prop.eval_monom[of R P to_poly a g n] to_poly_UP_pre_univ_prop 
     unfolding P_def  
     using P.nat_pow_closed P_def  to_poly_mult_simp(1) 
     by (simp add: to_poly_mult_simp(1) UP_cring_axioms)
     
 lemma(in UP_cring)  cring_sub_monom_bound:
   assumes "a \<in> carrier R"
   assumes "a \<noteq>\<zero>"
   assumes "f = monom P a n"
   assumes "g \<in> carrier P"
   shows "degree (f of g) \<le> n*(degree g)"
 proof-
   have "f of g = (to_poly a) \<otimes>\<^bsub>P\<^esub> (g[^]\<^bsub>P\<^esub>n)"
     unfolding compose_def
     using assms UP_pre_univ_prop.eval_monom[of R P to_poly a g] to_poly_UP_pre_univ_prop 
     unfolding P_def  
     by blast
   then show ?thesis 
     by (smt P.nat_pow_closed assms(1) assms(4) cring_pow_deg_bound deg_mult_ring
         degree_to_poly le_trans plus_nat.add_0 to_poly_closed)
 qed
 
 lemma(in UP_cring)  cring_sub_monom:
   assumes "a \<in> carrier R"
   assumes "a \<noteq>\<zero>"
   assumes "f = monom P a n"
   assumes "g \<in> carrier P"
   assumes "a \<otimes> (lcf g [^] n) \<noteq> \<zero>"
   shows "degree (f of g) = n*(degree g)"
 proof-
   have 0: "f of g = (to_poly a) \<otimes>\<^bsub>P\<^esub> (g[^]\<^bsub>P\<^esub>n)"
     unfolding compose_def
     using assms UP_pre_univ_prop.eval_monom[of R P to_poly a g] to_poly_UP_pre_univ_prop 
     unfolding P_def  
     by blast
   have 1: "lcf (to_poly a) \<otimes> lcf (g [^]\<^bsub>P\<^esub> n) \<noteq> \<zero>" 
     using assms 
     by (smt P.nat_pow_closed P_def R.nat_pow_closed R.r_null cring_pow_ltrm lcf_closed lcf_ltrm lcf_monom monom_pow to_polynomial_def)
   then show ?thesis 
     using 0 1 assms cring_pow_deg[of g n] cring_deg_mult[of "to_poly a" "g[^]\<^bsub>P\<^esub>n"]
     by (metis P.nat_pow_closed R.r_null add.right_neutral degree_to_poly to_poly_closed)
 qed
     
 lemma(in UP_domain)  sub_monom:
   assumes "a \<in> carrier R"
   assumes "a \<noteq>\<zero>"
   assumes "f = monom P a n"
   assumes "g \<in> carrier P"
   shows "degree (f of g) = n*(degree g)"
 proof-
   have "f of g = (to_poly a) \<otimes>\<^bsub>P\<^esub> (g[^]\<^bsub>P\<^esub>n)"
     unfolding compose_def
     using assms UP_pre_univ_prop.eval_monom[of R P to_poly a g] to_poly_UP_pre_univ_prop 
     unfolding P_def  
     by blast
   then show ?thesis using deg_pow deg_mult 
     by (metis P.nat_pow_closed P_def assms(1) assms(2) 
         assms(4) deg_smult monom_mult_is_smult to_polynomial_def)
 qed
 
 text\<open>Subbing a constant into a polynomial yields a constant\<close>
 lemma sub_in_const:
   assumes "g \<in> carrier P"
   assumes "f \<in> carrier P"
   assumes "degree g = 0"
   shows "degree (f of g) = 0"
 proof-
   have "\<And>n. (\<And>p. p \<in> carrier P \<Longrightarrow> degree p \<le> n \<Longrightarrow> degree (p of g) = 0)"
   proof-
     fix n
     show "\<And>p. p \<in> carrier P \<Longrightarrow> degree p \<le> n \<Longrightarrow> degree (p of g) = 0"
     proof(induction n)
       case 0
       then show ?case 
         by (simp add: assms(1) sub_const)       
     next
       case (Suc n)
       fix n
       assume IH: "\<And>p. p \<in> carrier P \<Longrightarrow> degree p \<le> n \<Longrightarrow> degree (p of g) = 0"
       show  "\<And>p. p \<in> carrier P \<Longrightarrow> degree p \<le> (Suc n) \<Longrightarrow> degree (p of g) = 0"
       proof-
         fix p
         assume A0: "p \<in> carrier P"
         assume A1: "degree p \<le> (Suc n)"
         show "degree (p of g) = 0"
         proof(cases "degree p < Suc n")
           case True
           then show ?thesis using IH 
             using A0 by auto
         next
           case False
           then have D: "degree p = Suc n" 
             by (simp add: A1 nat_less_le)
           show ?thesis
           proof-
             have P0: "degree ((trunc p) of g) = 0" using IH 
               by (metis A0 D less_Suc_eq_le trunc_degree trunc_closed zero_less_Suc)
             have P1: "degree ((ltrm p) of g) = 0" 
             proof-
               obtain a n where an_def: "ltrm p = monom P a n \<and> a \<in> carrier R"
                 unfolding leading_term_def 
                 using A0 P_def cfs_closed by blast
               obtain b where b_def: "g = monom P b 0 \<and> b \<in> carrier R"
                 using assms deg_zero_impl_monom  coeff_closed 
                 by blast               
               have 0: " monom P b 0 [^]\<^bsub>P\<^esub> n = monom P (b[^]n) 0"
                 apply(induction n)
                  apply fastforce[1]
               proof- fix n::nat assume IH: "monom P b 0 [^]\<^bsub>P\<^esub> n = monom P (b [^] n) 0"
                 have "monom P b 0 [^]\<^bsub>P\<^esub> Suc n = (monom P (b[^]n) 0) \<otimes>\<^bsub>P\<^esub> monom P b 0"
                   using IH by simp
                 then have "monom P b 0 [^]\<^bsub>P\<^esub> Suc n = (monom P ((b[^]n)\<otimes>b) 0)"
                   using b_def  
                   by (simp add: monom_mult_is_smult monom_mult_smult)
                 then show "monom P b 0 [^]\<^bsub>P\<^esub> Suc n = monom P (b [^] Suc n) 0 "
                   by simp 
               qed
                    
               then have 0: "a \<odot>\<^bsub>P\<^esub> monom P b 0 [^]\<^bsub>P\<^esub> n = monom P (a \<otimes> b[^]n) 0"
                 by (simp add: an_def b_def monom_mult_smult)
 
 
               then show ?thesis using monom_sub[of a "monom P b 0" n] assms an_def 
                 by (simp add: \<open>\<lbrakk>a \<in> carrier R; monom P b 0 \<in> carrier P\<rbrakk> \<Longrightarrow> monom P a n of monom P b 0 = a \<odot>\<^bsub>P\<^esub> monom P b 0 [^]\<^bsub>P\<^esub> n\<close> b_def)
             qed
             have P2: "p of g = (trunc p of g) \<oplus>\<^bsub>P\<^esub> ((ltrm p) of g)"
               by (metis A0 assms(1) ltrm_closed sub_add trunc_simps(1) trunc_closed)
             then show ?thesis 
               using P0 P1 P2 deg_add[of "trunc p of g" "ltrm p of g"] 
               by (metis A0 assms(1) le_0_eq ltrm_closed max_0R sub_closed trunc_closed)              
           qed
         qed
       qed
     qed
   qed
   then show ?thesis 
     using assms(2) by blast
 qed
 
 lemma (in UP_cring)  cring_sub_deg_bound:
   assumes "g \<in> carrier P"
   assumes "f \<in> carrier P"
   shows "degree (f of g) \<le> degree f * degree g"
 proof-
   have "\<And>n. \<And> p. p \<in> carrier P \<Longrightarrow> (degree p) \<le> n \<Longrightarrow> degree (p of g) \<le> degree p * degree g"
   proof-
     fix n::nat
     show "\<And> p. p \<in> carrier P \<Longrightarrow> (degree p) \<le> n \<Longrightarrow> degree (p of g) \<le> degree p * degree g"
     proof(induction n)
       case 0
       then have B0: "degree p = 0" by auto 
       then show ?case using sub_const[of g p] 
         by (simp add: "0.prems"(1) assms(1))
     next
       case (Suc n)
       fix n
       assume IH: "(\<And>p. p \<in> carrier P \<Longrightarrow> degree p \<le> n \<Longrightarrow> degree (p of g) \<le> degree p * degree g)"
       show " p \<in> carrier P \<Longrightarrow> degree p \<le> Suc n \<Longrightarrow> degree (p of g) \<le>  degree p * degree g"
       proof-
         assume A0: "p \<in> carrier P"
         assume A1: "degree p \<le> Suc n"
         show ?thesis 
         proof(cases "degree p < Suc n")
           case True
           then show ?thesis using IH 
             by (simp add: A0)
         next
           case False
           then have D: "degree p = Suc n" 
             using A1 by auto  
           have P0: "(p of g) = ((trunc p) of g) \<oplus>\<^bsub>P\<^esub> ((ltrm p) of g)"
             by (metis A0 assms(1) ltrm_closed sub_add trunc_simps(1) trunc_closed)
           have P1: "degree ((trunc p) of g) \<le> (degree (trunc p))*(degree g)"
             using IH  by (metis A0 D less_Suc_eq_le trunc_degree trunc_closed zero_less_Suc)
           have P2: "degree ((ltrm p) of g) \<le> (degree p) * degree g"
             using A0 D P_def  UP_cring_axioms assms(1) 
             by (metis False cfs_closed coeff_simp cring_sub_monom_bound deg_zero lcoeff_nonzero2 less_Suc_eq_0_disj)                              
           then show ?thesis
             proof(cases "degree g = 0")
               case True
               then show ?thesis 
                 by (simp add: Suc(2) assms(1) sub_in_const)
             next
               case F: False
               then show ?thesis 
               proof-
                 have P3: "degree ((trunc p) of g) \<le> n*degree g"
                   using A0 False D  P1 P2  IH[of "trunc p"] trunc_degree[of p]
                 proof -
                   { assume "degree (trunc p) < degree p"
                     then have "degree (trunc p) \<le> n"
                       using D by auto
                     then have ?thesis
                       by (meson P1 le_trans mult_le_cancel2) }
                   then show ?thesis
                     by (metis (full_types) A0 D Suc_mult_le_cancel1 nat_mult_le_cancel_disj trunc_degree)
                 qed      
                 then have P3': "degree ((trunc p) of g) < (degree p)*degree g"
                   using F D by auto 
                 have P4: "degree (ltrm p of g) \<le> (degree p)*degree g"
                   using cring_sub_monom_bound  D P2 
                   by auto
                 then show ?thesis 
                   using D  P0 P1 P3 P4 A0 P3' assms(1) bound_deg_sum less_imp_le_nat
                     ltrm_closed sub_closed trunc_closed 
                   by metis                   
               qed
             qed
           qed
         qed
       qed
   qed
   then show ?thesis 
     using assms(2) by blast
 qed
 
 lemma (in UP_cring)  cring_sub_deg:
   assumes "g \<in> carrier P"
   assumes "f \<in> carrier P"
   assumes "lcf f \<otimes> (lcf g [^] (degree f)) \<noteq> \<zero>"
   shows "degree (f of g) = degree f * degree g"
 proof-
   have 0: "f of g = (trunc f of g) \<oplus>\<^bsub>P\<^esub> ((ltrm f) of g)"
     by (metis assms(1) assms(2) ltrm_closed rev_sub_add sub_rev_sub trunc_simps(1) trunc_closed)
   have 1: "lcf f \<noteq> \<zero>"
     using assms  cring.cring_simprules(26) lcf_closed 
     by auto
   have 2: "degree ((ltrm f) of g) = degree f * degree g"
     using 0 1 assms cring_sub_monom[of "lcf f" "ltrm f" "degree f" g] lcf_closed lcf_ltrm 
     by blast
   show ?thesis
     apply(cases "degree f = 0")
      apply (simp add: assms(1) assms(2))
     apply(cases "degree g = 0")
      apply (simp add: assms(1) assms(2) sub_in_const)
     using 0 1 assms cring_sub_deg_bound[of g "trunc f"] trunc_degree[of f]   
     using sub_const apply auto[1]
     apply(cases "degree g = 0")
     using 0 1 assms cring_sub_deg_bound[of g "trunc f"] trunc_degree[of f]   
     using sub_in_const apply fastforce
     unfolding 0 using 1 2 
     by (smt "0" ltrm_closed \<open>\<lbrakk>f \<in> carrier P; 0 < deg R f\<rbrakk> \<Longrightarrow> deg R (Cring_Poly.truncate R f) < deg R f\<close>
         assms(1) assms(2) cring_sub_deg_bound degree_of_sum_diff_degree equal_deg_sum
         le_eq_less_or_eq mult_less_cancel2 nat_neq_iff neq0_conv sub_closed trunc_closed)    
 qed
 
 lemma (in UP_domain)  sub_deg0:
   assumes "g \<in> carrier P"
   assumes "f \<in> carrier P"
   assumes "g \<noteq> \<zero>\<^bsub>P\<^esub>"
   assumes "f \<noteq> \<zero>\<^bsub>P\<^esub>"
   shows "degree (f of g) = degree f * degree g"
 proof-
   have "\<And>n. \<And> p. p \<in> carrier P \<Longrightarrow> (degree p) \<le> n \<Longrightarrow> degree (p of g) = degree p * degree g"
   proof-
     fix n::nat
     show "\<And> p. p \<in> carrier P \<Longrightarrow> (degree p) \<le> n \<Longrightarrow> degree (p of g) = degree p * degree g"
     proof(induction n)
       case 0
       then have B0: "degree p = 0" by auto 
       then show ?case using sub_const[of g p] 
         by (simp add: "0.prems"(1) assms(1))
     next
       case (Suc n)
       fix n
       assume IH: "(\<And>p. p \<in> carrier P \<Longrightarrow> degree p \<le> n \<Longrightarrow> degree (p of g) = degree p * degree g)"
       show " p \<in> carrier P \<Longrightarrow> degree p \<le> Suc n \<Longrightarrow> degree (p of g) = degree p * degree g"
       proof-
         assume A0: "p \<in> carrier P"
         assume A1: "degree p \<le> Suc n"
         show ?thesis 
         proof(cases "degree p < Suc n")
           case True
           then show ?thesis using IH 
             by (simp add: A0)
         next
           case False
           then have D: "degree p = Suc n" 
             using A1 by auto  
           have P0: "(p of g) = ((trunc p) of g) \<oplus>\<^bsub>P\<^esub> ((ltrm p) of g)"
             by (metis A0 assms(1) ltrm_closed sub_add trunc_simps(1) trunc_closed)
           have P1: "degree ((trunc p) of g) = (degree (trunc p))*(degree g)"
             using IH  by (metis A0 D less_Suc_eq_le trunc_degree trunc_closed zero_less_Suc)
           have P2: "degree ((ltrm p) of g) = (degree p) * degree g"
             using A0 D P_def UP_domain.sub_monom UP_cring_axioms assms(1) 
             by (metis False UP_domain_axioms UP_ring.coeff_simp UP_ring.lcoeff_nonzero2 UP_ring_axioms cfs_closed deg_nzero_nzero less_Suc_eq_0_disj)
                      
           then show ?thesis
             proof(cases "degree g = 0")
               case True
               then show ?thesis 
                 by (simp add: Suc(2) assms(1) sub_in_const)
             next
               case False
               then show ?thesis 
               proof-
                 have P3: "degree ((trunc p) of g) < degree ((ltrm p) of g)"
                   using False D  P1 P2  
                   by (metis (no_types, lifting) A0 mult.commute mult_right_cancel 
                       nat_less_le nat_mult_le_cancel_disj trunc_degree zero_less_Suc)
                 then show ?thesis 
                  by (simp add: A0 ltrm_closed P0 P2 assms(1) equal_deg_sum sub_closed trunc_closed)                 
               qed
             qed
           qed
         qed
       qed
   qed
   then show ?thesis 
       using assms(2) by blast
 qed
 
 lemma(in UP_domain)  sub_deg:
   assumes "g \<in> carrier P"
   assumes "f \<in> carrier P"
   assumes "g \<noteq> \<zero>\<^bsub>P\<^esub>"
   shows "degree (f of g) = degree f * degree g"
 proof(cases "f = \<zero>\<^bsub>P\<^esub>")
   case True
   then show ?thesis 
     using assms(1)  sub_const by auto
 next
   case False
   then show ?thesis 
     by (simp add: assms(1) assms(2) assms(3) sub_deg0)
 qed
 
 lemma(in UP_cring)  cring_ltrm_sub:
   assumes "g \<in> carrier P"
   assumes "f \<in> carrier P"
   assumes "degree g > 0"
   assumes "lcf f \<otimes> (lcf g [^] (degree f)) \<noteq> \<zero>"
   shows "ltrm (f of g) = ltrm ((ltrm f) of g)"
 proof-
   have P0: "degree (f of g) = degree ((ltrm f) of g)"
     using assms(1) assms(2) assms(4) cring_sub_deg lcf_eq ltrm_closed deg_ltrm 
     by auto               
   have P1: "f of g = ((trunc f) of g) \<oplus>\<^bsub>P\<^esub>((ltrm f) of g)"
     by (metis assms(1) assms(2) ltrm_closed rev_sub_add sub_rev_sub trunc_simps(1) trunc_closed)
   then show ?thesis
   proof(cases "degree f = 0")
     case True
     then show ?thesis 
       using ltrm_deg_0 assms(2) by auto     
   next
     case False
     have P2: "degree (f of g) = degree f * degree g"
       by (simp add: assms(1) assms(2) assms(4) cring_sub_deg)      
     then have P3: "degree ((trunc f) of g) < degree ((ltrm f) of g)"
       using False P0 P1 P_def UP_cring.sub_closed trunc_closed UP_cring_axioms
           UP_ring.degree_of_sum_diff_degree UP_ring.ltrm_closed UP_ring_axioms assms(1) 
           assms(2) assms(4) cring_sub_deg_bound le_antisym less_imp_le_nat less_nat_zero_code
           mult_right_le_imp_le nat_neq_iff trunc_degree
       by (smt assms(3))
     then show ?thesis using P0 P1 P2 
       by (metis (no_types, lifting) ltrm_closed ltrm_of_sum_diff_degree P.add.m_comm assms(1) assms(2) sub_closed trunc_closed)      
   qed
 qed
 
 lemma(in UP_domain)  ltrm_sub:
   assumes "g \<in> carrier P"
   assumes "f \<in> carrier P"
   assumes "degree g > 0"
   shows "ltrm (f of g) = ltrm ((ltrm f) of g)"
 proof-
   have P0: "degree (f of g) = degree ((ltrm f) of g)"
     using sub_deg 
     by (metis ltrm_closed assms(1) assms(2) assms(3) deg_zero deg_ltrm nat_neq_iff)       
   have P1: "f of g = ((trunc f) of g) \<oplus>\<^bsub>P\<^esub>((ltrm f) of g)"
     by (metis assms(1) assms(2) ltrm_closed rev_sub_add sub_rev_sub trunc_simps(1) trunc_closed)
   then show ?thesis
   proof(cases "degree f = 0")
     case True
     then show ?thesis 
       using ltrm_deg_0 assms(2) by auto    
   next
     case False
     then have P2: "degree ((trunc f) of g) < degree ((ltrm f) of g)"
       using sub_deg 
       by (metis (no_types, lifting) ltrm_closed assms(1) assms(2) assms(3) deg_zero
           deg_ltrm mult_less_cancel2 neq0_conv trunc_closed trunc_degree)      
     then show ?thesis 
       using P0 P1 P2 
       by (metis (no_types, lifting) ltrm_closed ltrm_of_sum_diff_degree P.add.m_comm assms(1) assms(2) sub_closed trunc_closed)
   qed
 qed
 
 lemma(in UP_cring)  cring_lcf_of_sub_in_ltrm:
   assumes "g \<in> carrier P"
   assumes "f \<in> carrier P"
   assumes "degree f = n"
   assumes "degree g > 0"
   assumes "(lcf f) \<otimes> ((lcf g)[^]n) \<noteq>\<zero>"
   shows "lcf ((ltrm f) of g) = (lcf f) \<otimes> ((lcf g)[^]n)"
   by (metis (no_types, lifting) P.nat_pow_closed P_def R.r_null UP_cring.monom_sub UP_cring_axioms 
       assms(1) assms(2) assms(3) assms(5) cfs_closed cring_lcf_pow cring_lcf_scalar_mult)
 
 lemma(in UP_domain)  lcf_of_sub_in_ltrm:
   assumes "g \<in> carrier P"
   assumes "f \<in> carrier P"
   assumes "degree f = n"
   assumes "degree g > 0"
   shows "lcf ((ltrm f) of g) = (lcf f) \<otimes> ((lcf g)[^]n)"
 proof(cases "degree f = 0")
   case True
   then show ?thesis 
     using ltrm_deg_0 assms(1) assms(2) assms(3) cfs_closed 
     by (simp add: sub_const)       
 next
   case False
   then show ?thesis 
   proof-
     have P0: "(ltrm f) of g = (to_poly (lcf f)) \<otimes>\<^bsub>P\<^esub> (g[^]\<^bsub>P\<^esub>n)"
       unfolding compose_def
       using assms UP_pre_univ_prop.eval_monom[of R P to_poly "(lcf f)" g n] to_poly_UP_pre_univ_prop 
       unfolding P_def  
       using P_def cfs_closed by blast        
     have P1: "(ltrm f) of g = (lcf f) \<odot>\<^bsub>P\<^esub>(g[^]\<^bsub>P\<^esub>n)"
       using P0 P.nat_pow_closed 
       by (simp add: assms(1) assms(2) assms(3) cfs_closed monom_sub)          
     have P2: "ltrm ((ltrm f) of g) = (ltrm (to_poly (lcf f))) \<otimes>\<^bsub>P\<^esub> (ltrm (g[^]\<^bsub>P\<^esub>n))"
       using P0 ltrm_mult P.nat_pow_closed P_def assms(1) assms(2) 
          to_poly_closed 
       by (simp add: cfs_closed)                  
     have P3: "ltrm ((ltrm f) of g) =  (to_poly (lcf f)) \<otimes>\<^bsub>P\<^esub> (ltrm (g[^]\<^bsub>P\<^esub>n))"
       using P2  ltrm_deg_0 assms(2) to_poly_closed 
       by (simp add: cfs_closed)           
     have P4: "ltrm ((ltrm f) of g) = (lcf f) \<odot>\<^bsub>P\<^esub> ((ltrm g)[^]\<^bsub>P\<^esub>n)"
       using P.nat_pow_closed P1 P_def assms(1) assms(2) ltrm_pow0 ltrm_smult 
       by (simp add: cfs_closed)
     have P5: "lcf ((ltrm f) of g) = (lcf f) \<otimes> (lcf ((ltrm g)[^]\<^bsub>P\<^esub>n))"
       using lcf_scalar_mult P4  by (metis P.nat_pow_closed P1 cfs_closed 
           UP_smult_closed assms(1) assms(2) assms(3) lcf_eq ltrm_closed sub_rev_sub)
     show ?thesis
       using P5 ltrm_pow lcf_pow assms(1) lcf_eq ltrm_closed by presburger
   qed
 qed
 
 lemma(in UP_cring)  cring_ltrm_of_sub_in_ltrm:
   assumes "g \<in> carrier P"
   assumes "f \<in> carrier P"
   assumes "degree f = n"
   assumes "degree g > 0"
   assumes "(lcf f) \<otimes> ((lcf g)[^]n) \<noteq>\<zero>"
   shows "ltrm ((ltrm f) of g) = (lcf f) \<odot>\<^bsub>P\<^esub> ((ltrm g)[^]\<^bsub>P\<^esub>n)"
   by (smt lcf_eq ltrm_closed R.nat_pow_closed R.r_null assms(1) assms(2) assms(3) 
       assms(4) assms(5) cfs_closed cring_lcf_of_sub_in_ltrm cring_lcf_pow cring_pow_ltrm
       cring_pow_deg cring_sub_deg deg_zero deg_ltrm monom_mult_smult neq0_conv)
   
 lemma(in UP_domain)  ltrm_of_sub_in_ltrm:
   assumes "g \<in> carrier P"
   assumes "f \<in> carrier P"
   assumes "degree f = n"
   assumes "degree g > 0"
   shows "ltrm ((ltrm f) of g) = (lcf f) \<odot>\<^bsub>P\<^esub> ((ltrm g)[^]\<^bsub>P\<^esub>n)"
   by (smt Group.nat_pow_0 lcf_of_sub_in_ltrm lcf_pow lcf_scalar_mult ltrm_closed 
       ltrm_pow0 ltrm_smult P.nat_pow_closed P_def UP_ring.monom_one UP_ring_axioms assms(1) 
       assms(2) assms(3) assms(4) cfs_closed coeff_simp deg_const deg_nzero_nzero deg_pow 
       deg_smult deg_ltrm lcoeff_nonzero2 nat_less_le sub_deg)
 
 text\<open>formula for the leading term of a composition \<close>
 
 lemma(in UP_domain)  cring_ltrm_of_sub:
   assumes "g \<in> carrier P"
   assumes "f \<in> carrier P"
   assumes "degree f = n"
   assumes "degree g > 0"
   assumes "(lcf f) \<otimes> ((lcf g)[^]n) \<noteq>\<zero>"
   shows "ltrm (f of g) = (lcf f) \<odot>\<^bsub>P\<^esub> ((ltrm g)[^]\<^bsub>P\<^esub>n)"
   using ltrm_of_sub_in_ltrm ltrm_sub assms(1) assms(2) assms(3) assms(4) by presburger
     
 lemma(in UP_domain)  ltrm_of_sub:
   assumes "g \<in> carrier P"
   assumes "f \<in> carrier P"
   assumes "degree f = n"
   assumes "degree g > 0"
   shows "ltrm (f of g) = (lcf f) \<odot>\<^bsub>P\<^esub> ((ltrm g)[^]\<^bsub>P\<^esub>n)"
   using ltrm_of_sub_in_ltrm ltrm_sub assms(1) assms(2) assms(3) assms(4) by presburger
    
 text\<open>subtitution is associative\<close>
 
 lemma  sub_assoc_monom:
   assumes "f \<in> carrier P"
   assumes "q \<in> carrier P"
   assumes "r \<in> carrier P"
   shows "(ltrm f) of (q of r) = ((ltrm f) of q) of r"
 proof-
   obtain n where n_def: "n = degree f"
     by simp
   obtain a where a_def: "a \<in> carrier R \<and> (ltrm f) = monom P a n"
     using assms(1) cfs_closed n_def by blast         
   have LHS: "(ltrm f) of (q of r) = a \<odot>\<^bsub>P\<^esub> (q of r)[^]\<^bsub>P\<^esub> n"
     by (metis P.nat_pow_closed P_def UP_pre_univ_prop.eval_monom a_def assms(2)
         assms(3) compose_def monom_mult_is_smult sub_closed to_poly_UP_pre_univ_prop to_polynomial_def)
   have RHS0: "((ltrm f) of q) of r = (a \<odot>\<^bsub>P\<^esub> q[^]\<^bsub>P\<^esub> n)of r"
     by (metis P.nat_pow_closed P_def UP_pre_univ_prop.eval_monom a_def 
         assms(2) compose_def monom_mult_is_smult to_poly_UP_pre_univ_prop to_polynomial_def)
   have RHS1: "((ltrm f) of q) of r = ((to_poly a) \<otimes>\<^bsub>P\<^esub> q[^]\<^bsub>P\<^esub> n)of r"
     using RHS0  by (metis P.nat_pow_closed P_def a_def 
         assms(2) monom_mult_is_smult to_polynomial_def)
   have RHS2: "((ltrm f) of q) of r = ((to_poly a) of r) \<otimes>\<^bsub>P\<^esub> (q[^]\<^bsub>P\<^esub> n of r)"
     using RHS1 a_def assms(2) assms(3) sub_mult to_poly_closed by auto
   have RHS3: "((ltrm f) of q) of r = (to_poly a) \<otimes>\<^bsub>P\<^esub> (q[^]\<^bsub>P\<^esub> n of r)"
     using RHS2 a_def assms(3) sub_to_poly by auto
   have RHS4: "((ltrm f) of q) of r = a \<odot>\<^bsub>P\<^esub> ((q[^]\<^bsub>P\<^esub> n)of r)"
     using RHS3 
     by (metis P.nat_pow_closed P_def a_def assms(2) assms(3) 
         monom_mult_is_smult sub_closed to_polynomial_def)
   have "(q of r)[^]\<^bsub>P\<^esub> n = ((q[^]\<^bsub>P\<^esub> n)of r)" 
     apply(induction n) 
     apply (metis Group.nat_pow_0 P.ring_simprules(6) assms(3) deg_one sub_const)
     by (simp add: assms(2) assms(3) sub_mult)    
   then show ?thesis using RHS4 LHS by simp
 qed
 
 lemma sub_assoc:
   assumes "f \<in> carrier P"
   assumes "q \<in> carrier P"
   assumes "r \<in> carrier P"
   shows "f of (q of r) = (f of q) of r"
 proof-
   have "\<And> n. \<And> p. p \<in> carrier P \<Longrightarrow> degree p \<le> n \<Longrightarrow> p of (q of r) = (p of q) of r"
   proof-
     fix n
     show "\<And> p. p \<in> carrier P \<Longrightarrow> degree p \<le> n \<Longrightarrow> p of (q of r) = (p of q) of r"
     proof(induction n)
       case 0
       then have deg_p: "degree p = 0"
         by blast
       then have B0: "p of (q of r) = p"
         using sub_const[of "q of r" p] assms  "0.prems"(1) sub_closed by blast
       have B1: "(p of q) of r = p"
       proof-
         have p0: "p of q = p"
           using deg_p 0 assms(2) 
           by (simp add: P_def UP_cring.sub_const UP_cring_axioms)                             
         show ?thesis 
           unfolding p0 using deg_p 0 assms(3) 
           by (simp add: P_def UP_cring.sub_const UP_cring_axioms)                             
       qed
       then show "p of (q of r) = (p of q) of r" using B0 B1 by auto 
     next
       case (Suc n)
       fix n
       assume IH: "\<And> p. p \<in> carrier P \<Longrightarrow> degree p \<le> n \<Longrightarrow> p of (q of r) = (p of q) of r"
       then show "\<And> p. p \<in> carrier P \<Longrightarrow> degree p \<le> Suc n \<Longrightarrow> p of (q of r) = (p of q) of r"
       proof-
         fix p
         assume A0: " p \<in> carrier P "
         assume A1: "degree p \<le> Suc n"
         show "p of (q of r) = (p of q) of r"
         proof(cases "degree p < Suc n")
           case True
           then show ?thesis using A0 A1 IH by auto 
         next
           case False
           then have "degree p = Suc n"
             using A1 by auto 
           have I0: "p of (q of r) = ((trunc p) \<oplus>\<^bsub>P\<^esub> (ltrm p)) of (q of r)"
             using A0 trunc_simps(1) by auto
           have I1: "p of (q of r) = ((trunc p)  of (q of r)) \<oplus>\<^bsub>P\<^esub> ((ltrm p)  of (q of r))"
             using I0 sub_add 
             by (simp add: A0 assms(2) assms(3) ltrm_closed rev_sub_closed sub_rev_sub trunc_closed)
           have I2: "p of (q of r) = (((trunc p)  of q) of r) \<oplus>\<^bsub>P\<^esub> (((ltrm p)  of q) of r)"
             using IH[of "trunc p"] sub_assoc_monom[of p q r] 
             by (metis A0 I1 \<open>degree p = Suc n\<close> assms(2) assms(3) 
                 less_Suc_eq_le trunc_degree trunc_closed zero_less_Suc)
           have I3: "p of (q of r) = (((trunc p)  of q) \<oplus>\<^bsub>P\<^esub> ((ltrm p)  of q)) of r"
             using sub_add trunc_simps(1) assms   
             by (simp add: A0 I2 ltrm_closed sub_closed trunc_closed)
           have I4: "p of (q of r) = (((trunc p)\<oplus>\<^bsub>P\<^esub>(ltrm p))   of q)  of r"
             using sub_add trunc_simps(1) assms   
             by (simp add: trunc_simps(1) A0 I3 ltrm_closed trunc_closed)
           then show ?thesis 
             using A0 trunc_simps(1) by auto
         qed
       qed
     qed
   qed
   then show ?thesis 
     using assms(1) by blast
 qed
 
 lemma sub_smult:
   assumes "f \<in> carrier P"
   assumes "q \<in> carrier P"
   assumes "a \<in> carrier R"
   shows "(a\<odot>\<^bsub>P\<^esub>f ) of q = a\<odot>\<^bsub>P\<^esub>(f of q)"
 proof-
   have "(a\<odot>\<^bsub>P\<^esub>f ) of q = ((to_poly a) \<otimes>\<^bsub>P\<^esub>f) of q"
     using assms  by (metis P_def monom_mult_is_smult to_polynomial_def)
   then have "(a\<odot>\<^bsub>P\<^esub>f ) of q = ((to_poly a) of q) \<otimes>\<^bsub>P\<^esub>(f of q)"
     by (simp add: assms(1) assms(2) assms(3) sub_mult to_poly_closed)
   then have "(a\<odot>\<^bsub>P\<^esub>f ) of q = (to_poly a) \<otimes>\<^bsub>P\<^esub>(f of q)"
     by (simp add: assms(2) assms(3) sub_to_poly)
   then show ?thesis 
     by (metis P_def assms(1) assms(2) assms(3) 
         monom_mult_is_smult sub_closed to_polynomial_def)
 qed
 
 lemma to_fun_sub_monom:
   assumes "is_UP_monom f"
   assumes "g \<in> carrier P"
   assumes "a \<in> carrier R"
   shows "to_fun (f of g) a = to_fun f (to_fun g a)"   
 proof-
   obtain b n where b_def: "b \<in> carrier R \<and> f = monom P b n"
     using assms unfolding is_UP_monom_def 
      using P_def cfs_closed by blast     
   then have P0: "f of g = b \<odot>\<^bsub>P\<^esub> (g[^]\<^bsub>P\<^esub>n)"
     using b_def assms(2) monom_sub by blast
   have P1: "UP_pre_univ_prop R R (\<lambda>x. x)" 
     by (simp add: UP_pre_univ_prop_fact)
   then have P2: "to_fun f (to_fun g a) = b \<otimes>((to_fun g a)[^]n)"
     using P1 to_fun_eval[of f "to_fun g a"] P_def UP_pre_univ_prop.eval_monom assms(1)
           assms(2) assms(3) b_def is_UP_monomE(1) to_fun_closed 
     by force
   have P3: "to_fun (monom P b n of g) a =  b \<otimes>((to_fun g a)[^]n)"
   proof-
     have 0: "to_fun (monom P b n of g) a = eval R R (\<lambda>x. x) a  (b \<odot>\<^bsub>P\<^esub> (g[^]\<^bsub>P\<^esub>n) )"
 
       using UP_pre_univ_prop.eval_monom[of R "(UP R)" to_poly b g n]
             P_def assms(2) b_def to_poly_UP_pre_univ_prop to_fun_eval P0
       by (metis assms(3) monom_closed sub_closed)      
     have 1: "to_fun (monom P b n of g) a = (eval R R (\<lambda>x. x) a  (to_poly b)) \<otimes> ( eval R R (\<lambda>x. x) a ( g [^]\<^bsub>UP R\<^esub> n ))"
       using 0 eval_ring_hom 
       by (metis P.nat_pow_closed P0 P_def assms(2) assms(3) b_def monom_mult_is_smult to_fun_eval to_fun_mult to_poly_closed to_polynomial_def)                
     have 2: "to_fun (monom P b n of g) a = b \<otimes> ( eval R R (\<lambda>x. x) a ( g [^]\<^bsub>UP R\<^esub> n ))"
       using 1 assms(3) b_def to_fun_eval to_fun_to_poly to_poly_closed by auto              
     then show ?thesis 
       unfolding to_function_def to_fun_def 
       using eval_ring_hom P_def UP_pre_univ_prop.ring_homD UP_pre_univ_prop_fact 
             assms(2) assms(3) ring_hom_cring.hom_pow by fastforce
   qed
   then show ?thesis 
     using b_def P2 by auto
 qed
 
 lemma to_fun_sub:
   assumes "g \<in> carrier P"
   assumes "f \<in> carrier P"
   assumes "a \<in> carrier R"
   shows "to_fun (f of  g) a = (to_fun f) (to_fun g a)"
 proof(rule poly_induct2[of f])
   show "f \<in> carrier P" 
     using assms by auto 
   show "\<And>p. p \<in> carrier P \<Longrightarrow> degree p = 0 \<Longrightarrow> to_fun (p of g) a = to_fun p (to_fun g a)"
   proof-
     fix p
     assume A0: "p \<in> carrier P"
     assume A1: "degree p = 0"
     then have P0: "degree (p of g) = 0"
       by (simp add: A0 assms(1) sub_const)    
     then obtain b where b_def: "p of g = to_poly b \<and> b \<in> carrier R"
       using A0 A1 cfs_closed assms(1) to_poly_inverse 
       by (meson sub_closed)
     then have "to_fun (p of g) a = b" 
       by (simp add: assms(3) to_fun_to_poly)     
     have "p of g = p"
       using A0 A1 P_def sub_const UP_cring_axioms assms(1) by blast
     then have P1: "p = to_poly b"
       using b_def by auto
     have "to_fun g a \<in> carrier R"
       using assms
       by (simp add: to_fun_closed)  
     then show "to_fun (p of g) a =  to_fun p (to_fun g a)"
       using P1 \<open>to_fun (p of g) a = b\<close> b_def 
       by (simp add: to_fun_to_poly)      
   qed
   show "\<And>p. 0 < degree p \<Longrightarrow> p \<in> carrier P \<Longrightarrow> 
             to_fun (trunc p of g) a = to_fun (trunc p) (to_fun g a) \<Longrightarrow> 
             to_fun (p of g) a = to_fun p (to_fun g a)"
   proof-
     fix p
     assume A0: "0 < degree p"
     assume A1: " p \<in> carrier P"
     assume A2: "to_fun (trunc p of g) a = to_fun (trunc p) (to_fun g a)"
     show "to_fun (p of g) a = to_fun p (to_fun g a)"
     proof-
       have "p of g = (trunc p) of g \<oplus>\<^bsub>P\<^esub> (ltrm p) of g"
         by (metis A1 assms(1) ltrm_closed sub_add trunc_simps(1) trunc_closed)
       then have "to_fun (p of g) a = to_fun ((trunc p) of g) a \<oplus> (to_fun ((ltrm p) of g) a)"
         by (simp add: A1 assms(1) assms(3) to_fun_plus ltrm_closed sub_closed trunc_closed)        
       then have 0: "to_fun (p of g) a = to_fun (trunc p) (to_fun g a) \<oplus> (to_fun ((ltrm p) of g) a)"
         by (simp add: A2)
       have "(to_fun ((ltrm p) of g) a) = to_fun (ltrm p) (to_fun g a)"
         using to_fun_sub_monom 
         by (simp add: A1 assms(1) assms(3) ltrm_is_UP_monom)
       then have "to_fun (p of g) a = to_fun (trunc p) (to_fun g a) \<oplus>  to_fun (ltrm p) (to_fun g a)"
         using 0 by auto 
       then show ?thesis 
         by (metis A1 assms(1) assms(3) to_fun_closed to_fun_plus ltrm_closed trunc_simps(1) trunc_closed)
     qed
   qed
 qed
 end
 
 
 text\<open>More material on constant terms and constant coefficients\<close>
 
 context UP_cring
 begin
 
 lemma to_fun_ctrm:
   assumes "f \<in> carrier P"
   assumes  "b \<in> carrier R"  
   shows "to_fun (ctrm f) b = (f 0)"
   using assms 
   by (metis ctrm_degree ctrm_is_poly lcf_monom(2) P_def cfs_closed to_fun_to_poly to_poly_inverse)   
 
 lemma to_fun_smult:
   assumes "f \<in> carrier P"
   assumes "b \<in> carrier R"
   assumes "c \<in> carrier R"
   shows "to_fun (c \<odot>\<^bsub>P\<^esub> f) b = c \<otimes>(to_fun f b)"
 proof-
   have "(c \<odot>\<^bsub>P\<^esub> f) = (to_poly c) \<otimes>\<^bsub>P\<^esub> f"
     by (metis P_def assms(1) assms(3) monom_mult_is_smult to_polynomial_def)
   then have "to_fun (c \<odot>\<^bsub>P\<^esub> f) b = to_fun (to_poly c) b \<otimes> to_fun f b"
     by (simp add: assms(1) assms(2) assms(3) to_fun_mult to_poly_closed)    
   then show  ?thesis 
     by (simp add: assms(2) assms(3) to_fun_to_poly)  
 qed
 
 lemma to_fun_monom:
   assumes "c \<in> carrier R"
   assumes "x \<in> carrier R"
   shows "to_fun (monom P c n) x = c \<otimes> x [^] n"
   by (smt P_def R.m_comm R.nat_pow_closed UP_cring.to_poly_nat_pow UP_cring_axioms assms(1) 
       assms(2) monom_is_UP_monom(1) sub_monom(1) to_fun_smult to_fun_sub_monom to_fun_to_poly 
       to_poly_closed to_poly_mult_simp(2))
 
 lemma zcf_monom:
   assumes "a \<in> carrier R"
   shows "zcf (monom P a n) = to_fun (monom P a n) \<zero>"
   using to_fun_monom unfolding zcf_def 
   by (simp add: R.nat_pow_zero assms cfs_monom)
 
 lemma zcf_to_fun: 
   assumes "p \<in> carrier P"
   shows "zcf p = to_fun p \<zero>"
   apply(rule poly_induct3[of p])
   apply (simp add: assms)
   using R.zero_closed zcf_add to_fun_plus apply presburger
   using zcf_monom by blast
 
 lemma zcf_to_poly[simp]:
   assumes "a \<in> carrier R"
   shows "zcf (to_poly a) = a"
   by (metis assms cfs_closed degree_to_poly to_fun_to_poly to_poly_inverse to_poly_closed zcf_def)
 
 lemma zcf_ltrm_mult:
   assumes "p \<in> carrier P"
   assumes "q \<in> carrier P"
   assumes "degree p > 0"
   shows "zcf((ltrm p) \<otimes>\<^bsub>P\<^esub> q) = \<zero>"
   using zcf_to_fun[of "ltrm p \<otimes>\<^bsub>P\<^esub> q" ]
   by (metis ltrm_closed P.l_null P.m_closed R.zero_closed UP_zero_closed zcf_to_fun
       zcf_zero assms(1) assms(2) assms(3) coeff_ltrm to_fun_mult)
 
 lemma zcf_mult:
   assumes "p \<in> carrier P"
   assumes "q \<in> carrier P"
   shows "zcf(p \<otimes>\<^bsub>P\<^esub> q) = (zcf p) \<otimes> (zcf q)"
   using zcf_to_fun[of " p \<otimes>\<^bsub>P\<^esub> q" ] zcf_to_fun[of "p" ] zcf_to_fun[of "q" ] to_fun_mult[of q p \<zero>]
   by (simp add: assms(1) assms(2))
 
 lemma zcf_is_ring_hom:
 "zcf\<in> ring_hom P R"
   apply(rule ring_hom_memI)
   using zcf_mult zcf_add
   apply (simp add: P_def UP_ring.cfs_closed UP_ring_axioms zcf_def)
     apply (simp add: zcf_mult)
       using zcf_add apply auto[1]
         by simp  
 
 lemma ctrm_is_ring_hom:
 "ctrm \<in> ring_hom P P"
   apply(rule ring_hom_memI)
      apply (simp add: ctrm_is_poly)
       apply (metis zcf_def zcf_mult cfs_closed monom_mult zero_eq_add_iff_both_eq_0)     
         using cfs_add[of _ _ 0] 
         apply (simp add: cfs_closed)        
   by auto  
 
 
 (**************************************************************************************************)
 (**************************************************************************************************)
 section\<open>Describing the Image of (UP R) in the Ring of Functions from R to R\<close>
 (**************************************************************************************************)
 (**************************************************************************************************)
 
 lemma to_fun_diff:
   assumes "p \<in> carrier P"
   assumes "q \<in> carrier P"
   assumes "a \<in> carrier R"
   shows "to_fun (p \<ominus>\<^bsub>P\<^esub> q) a = to_fun p a \<ominus> to_fun q a"
   using to_fun_plus[of "\<ominus>\<^bsub>P\<^esub> q" p a]
   by (simp add: P.minus_eq R.minus_eq assms(1) assms(2) assms(3) to_fun_minus)
 
 lemma to_fun_const:
   assumes "a \<in> carrier R"
   assumes "b \<in> carrier R"
   shows "to_fun (monom P a 0) b = a"
   by (metis lcf_monom(2) P_def UP_cring.to_fun_ctrm UP_cring_axioms assms(1) assms(2) deg_const monom_closed)
 
 lemma to_fun_monic_monom:
   assumes "b \<in> carrier R"
   shows "to_fun (monom P \<one> n) b = b[^]n"
   by (simp add: assms to_fun_monom)
 
 
 text\<open>Constant polynomials map to constant polynomials\<close>
 
 lemma const_to_constant:
   assumes "a \<in> carrier R"
   shows "to_fun (monom P a 0) = constant_function (carrier R) a"
   apply(rule ring_functions.function_ring_car_eqI[of R _ "carrier R"])
   unfolding ring_functions_def apply(simp add: R.ring_axioms)
     apply (simp add: assms to_fun_is_Fun)
       using assms ring_functions.constant_function_closed[of R a "carrier R"]
       unfolding ring_functions_def apply (simp add: R.ring_axioms)
         using assms to_fun_const[of a ] unfolding constant_function_def 
         by auto 
 
 text\<open>Monomial polynomials map to monomial functions\<close>
 
 lemma monom_to_monomial:
   assumes "a \<in> carrier R"
   shows "to_fun (monom P a n) = monomial_function R a n"
   apply(rule ring_functions.function_ring_car_eqI[of R _ "carrier R"])
   unfolding ring_functions_def apply(simp add: R.ring_axioms)
     apply (simp add: assms to_fun_is_Fun)
       using assms U_function_ring.monomial_functions[of R a n] R.ring_axioms
       unfolding U_function_ring_def  
       apply auto[1]
         unfolding monomial_function_def 
         using assms to_fun_monom[of a _ n]
         by auto 
 end 
 
 
 (**************************************************************************************************)
 (**************************************************************************************************)
 section\<open>Taylor Expansions\<close>
 (**************************************************************************************************)
 (**************************************************************************************************)
 
 
 (**************************************************************************************************)
 (**************************************************************************************************)
 subsection\<open>Monic Linear Polynomials\<close>
 (**************************************************************************************************)
 (**************************************************************************************************)
 
 text\<open>The polynomial representing the variable X\<close>
 
 definition X_poly where
 "X_poly R = monom (UP R) \<one>\<^bsub>R\<^esub> 1"
 
 context UP_cring
 begin
 
 abbreviation(input) X where
 "X \<equiv> X_poly R"
 
 lemma X_closed:
 "X \<in> carrier P"
   unfolding X_poly_def 
   using P_def monom_closed by blast
 
 lemma degree_X[simp]:
   assumes "\<one> \<noteq>\<zero>"
   shows"degree X = 1"
   unfolding X_poly_def 
   using assms P_def deg_monom[of \<one> 1]  
   by blast
 
 lemma X_not_zero:
   assumes "\<one> \<noteq>\<zero>"
   shows"X \<noteq> \<zero>\<^bsub>P\<^esub>"
   using degree_X assms by force  
 
 lemma sub_X[simp]:
   assumes "p \<in> carrier P"
   shows "X of p = p"
   unfolding X_poly_def
   using P_def UP_pre_univ_prop.eval_monom1 assms compose_def to_poly_UP_pre_univ_prop 
   by metis
 
 lemma sub_monom_deg_one:
   assumes "p \<in> carrier P"
   assumes "a \<in> carrier R"
   shows "monom P a 1 of p = a \<odot>\<^bsub>P\<^esub> p"
   using assms sub_smult[of X p a] unfolding X_poly_def
   by (metis P_def R.one_closed R.r_one X_closed X_poly_def monom_mult_smult sub_X)
 
 lemma monom_rep_X_pow:
   assumes "a \<in> carrier R"
   shows "monom P a n = a\<odot>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n)"
 proof-
   have "monom P a n = a\<odot>\<^bsub>P\<^esub>monom P \<one> n"
     by (metis R.one_closed R.r_one assms monom_mult_smult)
   then show ?thesis 
     unfolding X_poly_def 
     using monom_pow 
     by (simp add: P_def)
 qed
 
 lemma X_sub[simp]:
   assumes "p \<in> carrier P"
   shows "p of X = p"
   apply(rule poly_induct3)
   apply (simp add: assms)
   using X_closed sub_add apply presburger
   using sub_monom[of X] P_def monom_rep_X_pow X_closed by auto
 
 text\<open>representation of monomials as scalar multiples of powers of X\<close>
 
 lemma ltrm_rep_X_pow:
   assumes "p \<in> carrier P"
   shows "ltrm p = (lcf p)\<odot>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>(degree p))"
 proof-
   have "ltrm p =  monom P (lcf p) (degree p)"
     using assms unfolding leading_term_def by (simp add: P_def)
   then show ?thesis 
     using monom_rep_X_pow P_def assms 
     by (simp add: cfs_closed)     
 qed
 
 lemma to_fun_monom':
   assumes "c \<in> carrier R"
   assumes "c \<noteq>\<zero>"
   assumes "x \<in> carrier R"
   shows "to_fun (c \<odot>\<^bsub>P\<^esub> X[^]\<^bsub>P\<^esub>(n::nat)) x = c \<otimes> x [^] n"
   using P_def to_fun_monom monom_rep_X_pow UP_cring_axioms assms(1) assms(2) assms(3) by fastforce
 
 lemma to_fun_X_pow:
   assumes "x \<in> carrier R"
   shows "to_fun (X[^]\<^bsub>P\<^esub>(n::nat)) x = x [^] n"
   using to_fun_monom'[of \<one> x n] assms 
   by (metis P.nat_pow_closed R.l_one R.nat_pow_closed R.one_closed R.r_null R.r_one 
       UP_one_closed X_closed to_fun_to_poly ring_hom_one smult_l_null smult_one to_poly_is_ring_hom)  
 end
 
 text\<open>Monic linear polynomials\<close>
 
 definition X_poly_plus where
 "X_poly_plus R a = (X_poly R) \<oplus>\<^bsub>(UP R)\<^esub> to_polynomial R a"
 
 definition X_poly_minus where
 "X_poly_minus R a = (X_poly R) \<ominus>\<^bsub>(UP R)\<^esub> to_polynomial R a"
 
 context UP_cring
 begin
 
 abbreviation(input) X_plus where
 "X_plus \<equiv> X_poly_plus R"
 
 abbreviation(input) X_minus where
 "X_minus \<equiv> X_poly_minus R"
 
 lemma X_plus_closed:
   assumes "a \<in> carrier R"
   shows "(X_plus a) \<in> carrier P"
   unfolding X_poly_plus_def using X_closed to_poly_closed 
   using P_def UP_a_closed assms by auto
 
 lemma X_minus_closed:
   assumes "a \<in> carrier R"
   shows "(X_minus a) \<in> carrier P"
   unfolding X_poly_minus_def using X_closed to_poly_closed
   by (simp add: P_def UP_cring.UP_cring UP_cring_axioms assms cring.cring_simprules(4))   
 
 lemma X_minus_plus:
   assumes "a \<in> carrier R"
   shows "(X_minus a) = X_plus (\<ominus>a)"
   using P_def UP_ring.UP_ring  UP_ring_axioms
   by (simp add: X_poly_minus_def X_poly_plus_def a_minus_def assms to_poly_a_inv)
   
 lemma degree_of_X_plus:
   assumes "a \<in> carrier R"
   assumes "\<one> \<noteq>\<zero>"
   shows "degree (X_plus a) = 1"
 proof-
   have 0:"degree (X_plus a) \<le> 1"
     using deg_add degree_X  P_def unfolding X_poly_plus_def 
       using UP_cring.to_poly_closed UP_cring_axioms X_closed assms(1) assms(2) by fastforce      
   have 1:"degree (X_plus a) > 0"
     by (metis One_nat_def P_def R.one_closed R.r_zero X_poly_def 
         X_closed X_poly_plus_def X_plus_closed  assms  coeff_add coeff_monom deg_aboveD  
          gr0I  lessI  n_not_Suc_n to_polynomial_def to_poly_closed)
   then show ?thesis 
     using "0" by linarith
 qed
 
 lemma degree_of_X_minus:
   assumes "a \<in> carrier R"
   assumes "\<one> \<noteq>\<zero>"
   shows "degree (X_minus a) = 1"
   using degree_of_X_plus[of "\<ominus>a"] X_minus_plus[simp] assms by auto  
 
 lemma ltrm_of_X:
 shows"ltrm X = X"
   unfolding leading_term_def
   by (metis P_def R.one_closed X_poly_def is_UP_monom_def is_UP_monomI leading_term_def)
 
 lemma ltrm_of_X_plus:
   assumes "a \<in> carrier R"
   assumes "\<one> \<noteq>\<zero>"
   shows "ltrm (X_plus a) = X"
   unfolding X_poly_plus_def
   using X_closed  assms  ltrm_of_sum_diff_degree[of X "to_poly a"]  
     degree_to_poly[of a]  to_poly_closed[of a] degree_X ltrm_of_X 
     by (simp add: P_def)  
 
 lemma ltrm_of_X_minus:
   assumes "a \<in> carrier R"
   assumes "\<one> \<noteq>\<zero>"
   shows "ltrm (X_minus a) = X"
   using X_minus_plus[of a]  assms 
   by (simp add: ltrm_of_X_plus)
 
 lemma lcf_of_X_minus:
   assumes "a \<in> carrier R"
   assumes "\<one> \<noteq>\<zero>"
   shows "lcf (X_minus a) = \<one>"
   using ltrm_of_X_minus unfolding X_poly_def 
   using P_def UP_cring.X_minus_closed UP_cring.lcf_eq UP_cring_axioms assms(1) assms(2) lcf_monom 
   by (metis R.one_closed)
   
 lemma lcf_of_X_plus:
   assumes "a \<in> carrier R"
   assumes "\<one> \<noteq>\<zero>"
   shows "lcf (X_plus a) = \<one>"
   using ltrm_of_X_plus unfolding X_poly_def 
   by (metis lcf_of_X_minus P_def UP_cring.lcf_eq UP_cring.X_plus_closed UP_cring_axioms X_minus_closed assms(1) assms(2) degree_of_X_minus)
 
 lemma to_fun_X[simp]:
   assumes "a \<in> carrier R"
   shows "to_fun X a = a"
   using X_closed assms to_fun_sub_monom ltrm_is_UP_monom ltrm_of_X to_poly_closed 
   by (metis sub_X to_fun_to_poly)
 
 lemma to_fun_X_plus[simp]:
   assumes "a \<in> carrier R"
   assumes "b \<in> carrier R"
   shows "to_fun (X_plus a) b = b \<oplus> a"
   unfolding X_poly_plus_def 
   using assms to_fun_X[of b] to_fun_plus[of "to_poly a" X  b] to_fun_to_poly[of a b] 
   using P_def X_closed to_poly_closed by auto
 
 lemma to_fun_X_minus[simp]:
   assumes "a \<in> carrier R"
   assumes "b \<in> carrier R"
   shows "to_fun (X_minus a) b = b \<ominus> a"
   using to_fun_X_plus[of "\<ominus> a" b] X_minus_plus[of a] assms 
   by (simp add: R.minus_eq)
 
 lemma cfs_X_plus:
   assumes "a \<in> carrier R"
   shows "X_plus a n = (if n = 0 then a else (if n = 1 then \<one> else \<zero>))"
   using assms cfs_add monom_closed UP_ring_axioms cfs_monom 
   unfolding X_poly_plus_def to_polynomial_def X_poly_def P_def    
   by auto 
 
 lemma cfs_X_minus:
   assumes "a \<in> carrier R"
   shows "X_minus a n = (if n = 0 then \<ominus> a else (if n = 1 then \<one> else \<zero>))"
   using cfs_X_plus[of "\<ominus> a"] assms
   unfolding X_poly_plus_def X_poly_minus_def 
   by (simp add: P_def a_minus_def to_poly_a_inv)
 
 text\<open>Linear substituions\<close>
  
 lemma X_plus_sub_deg:
   assumes "a \<in> carrier R"
   assumes "f \<in> carrier P"
   shows "degree (f of (X_plus a)) = degree f"
   apply(cases "\<one> = \<zero>")
    apply (metis P_def UP_one_closed X_plus_closed X_poly_def sub_X assms(1) assms(2) deg_one monom_one monom_zero sub_const)
   using cring_sub_deg[of "X_plus a" f] assms X_plus_closed[of a] lcf_of_X_plus[of a]  
         ltrm_of_X_plus degree_of_X_plus[of a] P_def 
   by (metis lcf_eq R.nat_pow_one R.r_one UP_cring.cring_sub_deg UP_cring_axioms X_closed X_sub 
       cfs_closed coeff_simp deg_nzero_nzero degree_X lcoeff_nonzero2 sub_const) 
 
 lemma X_minus_sub_deg:
   assumes "a \<in> carrier R"
   assumes "f \<in> carrier P"
   shows "degree (f of (X_minus a)) = degree f"
   using X_plus_sub_deg[of "\<ominus>a"] assms X_minus_plus[of a]
   by simp
 
 lemma plus_minus_sub:
   assumes " a \<in> carrier R"
   shows "X_plus a of X_minus a = X"
   unfolding X_poly_plus_def
 proof-
   have "(X \<oplus>\<^bsub>P\<^esub> to_poly a) of X_minus a = (X  of X_minus a) \<oplus>\<^bsub>P\<^esub> (to_poly a) of X_minus a"
     using sub_add
     by (simp add: X_closed X_minus_closed assms to_poly_closed)     
   then have "(X \<oplus>\<^bsub>P\<^esub> to_poly a) of X_minus a = (X_minus a) \<oplus>\<^bsub>P\<^esub> (to_poly a)"
     by (simp add: X_minus_closed assms sub_to_poly)
   then show "(X \<oplus>\<^bsub>UP R\<^esub> to_poly a) of X_minus a = X" 
     unfolding to_polynomial_def X_poly_minus_def
     by (metis P.add.inv_solve_right P.minus_eq P_def 
         X_closed X_poly_minus_def X_minus_closed assms monom_closed to_polynomial_def)
 qed
 
 lemma minus_plus_sub:
   assumes " a \<in> carrier R"
   shows "X_minus a of X_plus a = X"
   using plus_minus_sub[of "\<ominus>a"]
   unfolding X_poly_minus_def
   unfolding X_poly_plus_def
   using assms  apply simp
   by (metis P_def R.add.inv_closed R.minus_minus a_minus_def to_poly_a_inv)
 
 lemma ltrm_times_X:
   assumes "p \<in> carrier P"
   shows "ltrm (X \<otimes>\<^bsub>P\<^esub> p) = X \<otimes>\<^bsub>P\<^esub> (ltrm p)"
   using assms ltrm_of_X cring_ltrm_mult[of X p]
   by (metis ltrm_deg_0 P.r_null R.l_one R.one_closed UP_cring.lcf_monom(1)
       UP_cring_axioms X_closed X_poly_def cfs_closed deg_zero deg_ltrm monom_zero)
 
 lemma times_X_not_zero:
   assumes "p \<in> carrier P"
   assumes "p \<noteq> \<zero>\<^bsub>P\<^esub>"
   shows "(X \<otimes>\<^bsub>P\<^esub> p) \<noteq> \<zero>\<^bsub>P\<^esub>"
   by (metis (no_types, opaque_lifting) lcf_monom(1) lcf_of_X_minus ltrm_of_X_minus P.inv_unique
       P.r_null R.l_one R.one_closed UP_zero_closed X_closed zcf_def 
       zcf_zero_degree_zero assms(1) assms(2) cfs_closed cfs_zero cring_lcf_mult 
       deg_monom deg_nzero_nzero deg_ltrm degree_X degree_of_X_minus 
       monom_one monom_zero)
 
 lemma degree_times_X:
   assumes "p \<in> carrier P"
   assumes "p \<noteq> \<zero>\<^bsub>P\<^esub>"
   shows "degree (X \<otimes>\<^bsub>P\<^esub> p) = degree p + 1"
   using cring_deg_mult[of X p] assms times_X_not_zero[of p]
   by (metis (no_types, lifting) P.r_null P.r_one P_def R.l_one R.one_closed
       UP_cring.lcf_monom(1) UP_cring_axioms UP_zero_closed X_closed X_poly_def cfs_closed 
       deg_zero deg_ltrm degree_X monom_one monom_zero to_poly_inverse)
    
 end
 
 (**************************************************************************************************)
 (**************************************************************************************************)
 subsection\<open>Basic Facts About Taylor Expansions\<close>
 (**************************************************************************************************)
 (**************************************************************************************************)
 definition taylor_expansion where
 "taylor_expansion R a p = compose R p (X_poly_plus R a)"
 
 definition(in UP_cring) taylor  where
 "taylor \<equiv> taylor_expansion R"
 
 context UP_cring
 begin
 
 lemma taylor_expansion_ring_hom:
   assumes "c \<in> carrier R"
   shows "taylor_expansion R c \<in> ring_hom P P"
   unfolding taylor_expansion_def 
   using rev_sub_is_hom[of "X_plus c"]
   unfolding rev_compose_def compose_def 
   using X_plus_closed assms by auto 
 
 notation  taylor ("T\<^bsub>_\<^esub>")
 
 lemma(in UP_cring) taylor_closed:
   assumes "f \<in> carrier P"
   assumes "a \<in> carrier R"
   shows "T\<^bsub>a\<^esub> f \<in>  carrier P"
   unfolding taylor_def
   by (simp add: X_plus_closed assms(1) assms(2) sub_closed taylor_expansion_def)
 
 lemma taylor_deg:
   assumes "a \<in> carrier R"
   assumes "p \<in> carrier P"
   shows "degree (T\<^bsub>a\<^esub> p) = degree p"
   unfolding taylor_def taylor_expansion_def 
   using X_plus_sub_deg[of a p] assms 
   by (simp add: taylor_expansion_def)
 
 lemma taylor_id:
   assumes "a \<in> carrier R"
   assumes "p \<in> carrier P"
   shows "p = (T\<^bsub>a\<^esub> p) of (X_minus a)"
   unfolding taylor_expansion_def taylor_def
   using assms sub_assoc[of p "X_plus a" "X_minus a"] X_plus_closed[of a]  X_minus_closed[of a]
   by (metis X_sub plus_minus_sub taylor_expansion_def)
 
 lemma taylor_eval:
   assumes "a \<in> carrier R"
   assumes "f \<in> carrier P"
   assumes "b \<in> carrier R"
   shows "to_fun (T\<^bsub>a\<^esub> f) b = to_fun f (b \<oplus> a)"
   unfolding  taylor_expansion_def taylor_def
   using to_fun_sub[of "(X_plus a)" f b] to_fun_X_plus[of a b] 
         assms X_plus_closed[of a] by auto
 
 lemma taylor_eval':
   assumes "a \<in> carrier R"
   assumes "f \<in> carrier P"
   assumes "b \<in> carrier R"
   shows "to_fun f (b) = to_fun (T\<^bsub>a\<^esub> f) (b \<ominus> a) "
   unfolding taylor_expansion_def taylor_def
   using to_fun_sub[of "(X_minus a)" "T\<^bsub>a\<^esub> f" b] to_fun_X_minus[of b a] 
         assms X_minus_closed[of a] 
   by (metis taylor_closed taylor_def taylor_id taylor_expansion_def to_fun_X_minus)
 
 lemma(in UP_cring) degree_monom:
   assumes "a \<in> carrier R"
   shows "degree (a \<odot>\<^bsub>UP R\<^esub> (X_poly R)[^]\<^bsub>UP R\<^esub>n) = (if a = \<zero> then 0 else n)"
   apply(cases "a = \<zero>")
   apply (metis (full_types) P.nat_pow_closed P_def R.one_closed UP_smult_zero X_poly_def deg_zero monom_closed)
   using P_def UP_cring.monom_rep_X_pow UP_cring_axioms assms deg_monom by fastforce  
 
 lemma(in UP_cring) poly_comp_finsum:
   assumes "\<And>i::nat. i \<le> n \<Longrightarrow> g i \<in> carrier P"
   assumes "q \<in> carrier P"
   assumes "p = (\<Oplus>\<^bsub>P\<^esub> i \<in> {..n}. g i)"
   shows "p of q = (\<Oplus>\<^bsub>P\<^esub> i \<in> {..n}. (g i) of q)"  
 proof- 
   have 0: "p of q  = rev_sub q p"
     unfolding compose_def rev_compose_def by blast 
   have 1: "p of q = finsum P (rev_compose R q \<circ> g) {..n}" 
     unfolding 0 unfolding assms 
     apply(rule ring_hom_finsum[of "rev_compose R q" P "{..n}" g ])
     using assms(2) rev_sub_is_hom apply blast
     apply (simp add: UP_ring)
      apply simp
   by (simp add: assms(1))
   show ?thesis unfolding 1 
     unfolding comp_apply rev_compose_def compose_def
     by auto 
 qed
 
 lemma(in UP_cring) poly_comp_expansion:
   assumes "p \<in> carrier P"
   assumes "q \<in> carrier P"
   assumes "degree p \<le> n"
   shows "p of q = (\<Oplus>\<^bsub>P\<^esub> i \<in> {..n}. (p i) \<odot>\<^bsub>P\<^esub> q[^]\<^bsub>P\<^esub>i)"
 proof-
   obtain g where g_def: "g = (\<lambda>i. monom P (p i) i)"
     by blast 
   have 0: "\<And>i. (g i) of q = (p i) \<odot>\<^bsub>P\<^esub> q[^]\<^bsub>P\<^esub>i"
   proof- fix i show "g i of q = p i \<odot>\<^bsub>P\<^esub> q [^]\<^bsub>P\<^esub> i"
       using assms g_def  P_def coeff_simp monom_sub 
       by (simp add: cfs_closed)           
   qed
   have 1: "(\<And>i. i \<le> n \<Longrightarrow> g i \<in> carrier P)"
     using g_def assms 
     by (simp add: cfs_closed)   
   have  "(\<Oplus>\<^bsub>P\<^esub>i\<in>{..n}. monom P (p i) i) = p"
     using assms up_repr_le[of p n] coeff_simp[of p] unfolding P_def 
     by auto     
   then have  "p = (\<Oplus>\<^bsub>P\<^esub> i \<in> {..n}. g i)"
     using g_def by auto       
   then have "p of q = (\<Oplus>\<^bsub>P\<^esub>i\<in>{..n}. g i of q)" 
     using 0 1 poly_comp_finsum[of n g q p]
     using assms(2) 
     by blast
   then show ?thesis 
     by(simp add: 0)
 qed
 
 lemma(in UP_cring) taylor_sum:
   assumes "p \<in> carrier P"
   assumes "degree p \<le> n"
   assumes "a \<in> carrier R"
   shows "p = (\<Oplus>\<^bsub>P\<^esub> i \<in> {..n}. T\<^bsub>a\<^esub> p i \<odot>\<^bsub>P\<^esub> (X_minus a)[^]\<^bsub>P\<^esub>i)"
 proof-
   have 0: "(T\<^bsub>a\<^esub> p) of X_minus a = p" 
     using P_def taylor_id assms(1) assms(3) 
     by fastforce
   have 1: "degree (T\<^bsub>a\<^esub> p) \<le> n"
     using assms 
     by (simp add: taylor_deg)
   have 2: "T\<^bsub>a\<^esub> p of X_minus a = (\<Oplus>\<^bsub>P\<^esub>i\<in>{..n}. T\<^bsub>a\<^esub> p i \<odot>\<^bsub>P\<^esub> X_minus a [^]\<^bsub>P\<^esub> i)"
     using 1 X_minus_closed[of a]  poly_comp_expansion[of "T\<^bsub>a\<^esub> p" "X_minus a" n] 
           assms  taylor_closed 
     by blast
   then show ?thesis
     using 0 
     by simp
 qed
 
 text\<open>The $i^{th}$ term in the taylor expansion\<close>
 definition taylor_term where
 "taylor_term c p i = (taylor_expansion R c p i) \<odot>\<^bsub>UP R\<^esub> (UP_cring.X_minus R c) [^]\<^bsub>UP R\<^esub>i" 
 
 lemma (in UP_cring) taylor_term_closed:
 assumes "p \<in> carrier P"
 assumes "a \<in> carrier R"
 shows "taylor_term a p i \<in> carrier (UP R)"
  unfolding taylor_term_def 
   using P.nat_pow_closed P_def taylor_closed taylor_def X_minus_closed assms(1) assms(2) smult_closed 
   by (simp add: cfs_closed)
 
 lemma(in UP_cring) taylor_term_sum:
   assumes "p \<in> carrier P"
   assumes "degree p \<le> n"
   assumes "a \<in> carrier R"
   shows "p = (\<Oplus>\<^bsub>P\<^esub> i \<in> {..n}. taylor_term a p i)"
   unfolding taylor_term_def taylor_def
   using assms taylor_sum[of p n a] P_def 
   using taylor_def by auto
   
 lemma (in UP_cring) taylor_expansion_add:
   assumes "p \<in> carrier P"
   assumes "q \<in> carrier P"
   assumes "c \<in> carrier R"
   shows "taylor_expansion R c (p \<oplus>\<^bsub>UP R\<^esub> q) = (taylor_expansion R c p) \<oplus>\<^bsub>UP R\<^esub> (taylor_expansion R c q)"
   unfolding taylor_expansion_def 
   using assms X_plus_closed[of c] P_def sub_add 
   by blast
 
 lemma (in UP_cring) taylor_term_add:
   assumes "p \<in> carrier P"
   assumes "q \<in> carrier P"
   assumes "a \<in> carrier R"
   shows "taylor_term a (p \<oplus>\<^bsub>UP R\<^esub>q) i = taylor_term a p i \<oplus>\<^bsub>UP R\<^esub> taylor_term a q i"
   using assms   taylor_expansion_add[of p q a]  
   unfolding taylor_term_def 
   using P.nat_pow_closed P_def taylor_closed X_minus_closed cfs_add smult_l_distr 
   by (simp add: taylor_def cfs_closed)
   
 lemma (in UP_cring) to_fun_taylor_term:
 assumes "p \<in> carrier P"
 assumes "a \<in> carrier R"
 assumes "c \<in> carrier R"
 shows "to_fun (taylor_term c p i) a = (T\<^bsub>c\<^esub> p i) \<otimes> (a \<ominus> c)[^]i"
   using assms to_fun_smult[of "X_minus c [^]\<^bsub>UP R\<^esub> i" a "taylor_expansion R c p i"] 
               to_fun_X_minus[of c a] to_fun_nat_pow[of "X_minus c" a i]  
   unfolding taylor_term_def 
   using P.nat_pow_closed P_def taylor_closed taylor_def X_minus_closed 
   by (simp add: cfs_closed)    
 
 
 end
 
 (**************************************************************************************************)
 (**************************************************************************************************)
 subsection\<open>Defining the (Scalar-Valued) Derivative of a Polynomial Using the Taylor Expansion\<close>
 (**************************************************************************************************)
 (**************************************************************************************************)
 definition derivative where
 "derivative R f a = (taylor_expansion R a f) 1"
 
 context UP_cring
 begin 
 
 abbreviation(in UP_cring) deriv where
 "deriv \<equiv> derivative R"
 
 lemma(in UP_cring) deriv_closed:
   assumes "f \<in> carrier P"
   assumes "a \<in> carrier R"
   shows "(derivative R f a) \<in> carrier R"
   unfolding derivative_def  
   using taylor_closed taylor_def assms(1) assms(2) cfs_closed by auto
 
 lemma(in UP_cring) deriv_add:
   assumes "f \<in> carrier P"
   assumes "g \<in> carrier P"
   assumes "a \<in> carrier R"
   shows "deriv (f \<oplus>\<^bsub>P\<^esub> g) a = deriv f a \<oplus> deriv g a"
   unfolding derivative_def taylor_expansion_def  using assms 
   by (simp add: X_plus_closed sub_add sub_closed)
 
 end 
 (**************************************************************************************************)
 (**************************************************************************************************)
 section\<open>The Polynomial-Valued Derivative Operator\<close>
 (**************************************************************************************************)
 (**************************************************************************************************)
 
 context UP_cring
 begin
 
   (**********************************************************************)
   (**********************************************************************)
   subsection\<open>Operator Which Shifts Coefficients\<close>
   (**********************************************************************)
   (**********************************************************************)
 lemma cfs_times_X:
   assumes "g \<in> carrier P"
   shows "(X \<otimes>\<^bsub>P\<^esub> g) (Suc n) = g n"
   apply(rule poly_induct3[of g])
   apply (simp add: assms)
   apply (metis (no_types, lifting) P.m_closed P.r_distr X_closed cfs_add)
   by (metis (no_types, lifting) P_def R.l_one R.one_closed R.r_null Suc_eq_plus1 X_poly_def
       cfs_monom coeff_monom_mult coeff_simp monom_closed monom_mult)
 
 lemma times_X_pow_coeff:
   assumes "g \<in> carrier P"
   shows "(monom P \<one> k \<otimes>\<^bsub>P\<^esub> g) (n + k) = g n"
   using coeff_monom_mult P.m_closed P_def assms coeff_simp monom_closed 
   by (simp add: cfs_closed)
 
 lemma zcf_eq_zero_unique:
   assumes "f \<in> carrier P"
   assumes "g \<in> carrier P \<and> (f = X \<otimes>\<^bsub>P\<^esub> g)"
   shows "\<And> h. h  \<in> carrier P \<and> (f = X \<otimes>\<^bsub>P\<^esub> h) \<Longrightarrow> h = g"
 proof-
   fix h
   assume A: "h  \<in> carrier P \<and> (f = X \<otimes>\<^bsub>P\<^esub> h)"
   then have 0: " X \<otimes>\<^bsub>P\<^esub> g =  X \<otimes>\<^bsub>P\<^esub> h"
     using assms(2) by auto
  show "h = g"
    using 0 A assms 
    by (metis P_def coeff_simp  cfs_times_X up_eqI)
 qed
 
 lemma f_minus_ctrm:
   assumes "f \<in> carrier P"
   shows "zcf(f \<ominus>\<^bsub>P\<^esub> ctrm f) = \<zero>"
   using assms 
   by (smt ctrm_is_poly P.add.inv_closed P.minus_closed P_def R.r_neg R.zero_closed zcf_to_fun 
         to_fun_minus to_fun_plus UP_cring_axioms zcf_ctrm zcf_def a_minus_def cfs_closed)
 
 definition poly_shift where
 "poly_shift f n = f (Suc n)"
    
 lemma poly_shift_closed:
   assumes "f \<in> carrier P"
   shows "poly_shift f \<in> carrier P"
   apply(rule UP_car_memI[of "deg R f"])
   unfolding poly_shift_def 
 proof -
   fix n :: nat
   assume "deg R f < n"
   then have "deg R f < Suc n"
     using Suc_lessD by blast
   then have "f (Suc n) = \<zero>\<^bsub>P\<^esub> (Suc n)"
     by (metis P.l_zero UP_zero_closed assms coeff_of_sum_diff_degree0)
   then show "f (Suc n) = \<zero>"
     by simp
 next
   show " \<And>n. f (Suc n) \<in> carrier R"
     by(rule cfs_closed, rule assms)
 qed
 
 lemma poly_shift_eq_0:
   assumes "f \<in> carrier P"
   shows "f  n = (ctrm f \<oplus>\<^bsub>P\<^esub> X \<otimes>\<^bsub>P\<^esub> poly_shift f) n"
   apply(cases "n = 0")
   apply (smt ctrm_degree ctrm_is_poly ltrm_of_X One_nat_def P.r_null P.r_zero P_def UP_cring.lcf_monom(1) UP_cring_axioms UP_mult_closed UP_r_one UP_zero_closed X_closed zcf_ltrm_mult zcf_def zcf_zero assms cfs_add cfs_closed deg_zero degree_X lessI monom_one poly_shift_closed to_poly_inverse)
 proof- assume A: "n \<noteq> 0"
   then obtain k where k_def: " n = Suc k"
     by (meson lessI less_Suc_eq_0_disj)
   show ?thesis 
     using  cfs_times_X[of "poly_shift f" k] poly_shift_def[of f k] poly_shift_closed assms
         cfs_add[of "ctrm f" "X \<otimes>\<^bsub>P\<^esub> poly_shift f" n] unfolding k_def 
     by (simp add: X_closed cfs_closed cfs_monom)
 qed   
         
 lemma poly_shift_eq:
   assumes "f \<in> carrier P"
   shows "f = (ctrm f \<oplus>\<^bsub>P\<^esub> X \<otimes>\<^bsub>P\<^esub> poly_shift f)"
 by(rule ext, rule poly_shift_eq_0, rule assms)
 
 lemma poly_shift_id:
   assumes "f \<in> carrier P"
   shows "f \<ominus>\<^bsub>P\<^esub> ctrm f = X \<otimes>\<^bsub>P\<^esub> poly_shift f"
   using assms poly_shift_eq[of f] poly_shift_closed unfolding a_minus_def 
   by (metis ctrm_is_poly P.add.inv_solve_left P.m_closed UP_a_comm UP_a_inv_closed X_closed)
 
 lemma poly_shift_degree_zero:
   assumes "p \<in> carrier P"
   assumes "degree p = 0"
   shows "poly_shift p = \<zero>\<^bsub>P\<^esub>"
   by (metis ltrm_deg_0 P.r_neg P.r_null UP_ring UP_zero_closed X_closed zcf_eq_zero_unique 
       abelian_group.minus_eq assms(1) assms(2) poly_shift_closed poly_shift_id ring_def)
 
 lemma poly_shift_degree:
   assumes "p \<in> carrier P"
   assumes "degree p > 0"
   shows "degree (poly_shift p) = degree p - 1 "
   using poly_shift_id[of p] 
   by (metis ctrm_degree ctrm_is_poly P.r_null X_closed add_diff_cancel_right' assms(1) assms(2) 
       deg_zero degree_of_difference_diff_degree degree_times_X nat_less_le poly_shift_closed)
   
 lemma poly_shift_monom:
   assumes "a \<in> carrier R"
   shows "poly_shift (monom P a (Suc k)) = (monom P a k)"
 proof-
   have "(monom P a (Suc k)) = ctrm (monom P a (Suc k)) \<oplus>\<^bsub>P\<^esub> X \<otimes>\<^bsub>P\<^esub>poly_shift (monom P a (Suc k))"
     using poly_shift_eq[of "monom P a (Suc k)"] assms monom_closed 
     by blast
   then have "(monom P a (Suc k)) = \<zero>\<^bsub>P\<^esub> \<oplus>\<^bsub>P\<^esub> X \<otimes>\<^bsub>P\<^esub>poly_shift (monom P a (Suc k))"
     using assms by simp
   then have "(monom P a (Suc k)) = X \<otimes>\<^bsub>P\<^esub>poly_shift (monom P a (Suc k))"
     using X_closed assms poly_shift_closed by auto  
   then have "X \<otimes>\<^bsub>P\<^esub>(monom P a k) = X \<otimes>\<^bsub>P\<^esub>poly_shift (monom P a (Suc k))"
     by (metis P_def R.l_one R.one_closed X_poly_def assms monom_mult plus_1_eq_Suc)
   then show ?thesis 
     using X_closed X_not_zero assms 
     by (meson UP_mult_closed zcf_eq_zero_unique monom_closed poly_shift_closed)        
 qed
 
 lemma(in UP_cring) poly_shift_add:
   assumes "f \<in> carrier P"
   assumes "g \<in> carrier P"
   shows "poly_shift (f \<oplus>\<^bsub>P\<^esub> g) = (poly_shift f) \<oplus>\<^bsub>P\<^esub> (poly_shift g)"
   apply(rule ext)
   using cfs_add[of "poly_shift f" "poly_shift g"] poly_shift_closed poly_shift_def 
   by (simp add: poly_shift_def assms(1) assms(2))
 
 lemma(in UP_cring) poly_shift_s_mult:
   assumes "f \<in> carrier P"
   assumes "s \<in> carrier R"
   shows "poly_shift (s \<odot>\<^bsub>P\<^esub>f) = s \<odot>\<^bsub>P\<^esub> (poly_shift f)"
 proof-
   have "(s \<odot>\<^bsub>P\<^esub>f) = (ctrm (s \<odot>\<^bsub>P\<^esub>f)) \<oplus>\<^bsub>P\<^esub>(X \<otimes>\<^bsub>P\<^esub> poly_shift (s \<odot>\<^bsub>P\<^esub>f))"
     using poly_shift_eq[of "(s \<odot>\<^bsub>P\<^esub>f)"] assms(1) assms(2) 
     by blast
   then have 0: "(s \<odot>\<^bsub>P\<^esub>f) = (s \<odot>\<^bsub>P\<^esub>(ctrm f)) \<oplus>\<^bsub>P\<^esub>(X \<otimes>\<^bsub>P\<^esub> poly_shift (s \<odot>\<^bsub>P\<^esub>f))"
     using ctrm_smult assms(1) assms(2) by auto   
   have 1: "(s \<odot>\<^bsub>P\<^esub>f) = s \<odot>\<^bsub>P\<^esub> ((ctrm f) \<oplus>\<^bsub>P\<^esub>  (X \<otimes>\<^bsub>P\<^esub> (poly_shift f)))"
     using assms(1) poly_shift_eq by auto
   have 2:  "(s \<odot>\<^bsub>P\<^esub>f) = (s \<odot>\<^bsub>P\<^esub>(ctrm f)) \<oplus>\<^bsub>P\<^esub>  (s \<odot>\<^bsub>P\<^esub>(X \<otimes>\<^bsub>P\<^esub> (poly_shift f)))"
     by (simp add: "1" X_closed assms(1) assms(2) ctrm_is_poly poly_shift_closed smult_r_distr)    
   have 3:  "(s \<odot>\<^bsub>P\<^esub>f) = (s \<odot>\<^bsub>P\<^esub>(ctrm f)) \<oplus>\<^bsub>P\<^esub>  (X \<otimes>\<^bsub>P\<^esub> (s \<odot>\<^bsub>P\<^esub>(poly_shift f)))"
     using "2" UP_m_comm X_closed assms(1) assms(2) smult_assoc2
     by (simp add: poly_shift_closed)    
   have 4: "(X \<otimes>\<^bsub>P\<^esub> poly_shift (s \<odot>\<^bsub>P\<^esub>f)) =  (X \<otimes>\<^bsub>P\<^esub> (s \<odot>\<^bsub>P\<^esub>(poly_shift f)))"
     using 3 0  X_closed assms(1) assms(2) ctrm_is_poly poly_shift_closed 
     by auto     
   then show ?thesis 
     using X_closed X_not_zero assms(1) assms(2) 
     by (metis UP_mult_closed UP_smult_closed zcf_eq_zero_unique poly_shift_closed)  
 qed
 
 lemma zcf_poly_shift:
   assumes "f \<in>  carrier P"
   shows "zcf (poly_shift f) = f 1"  
   apply(rule poly_induct3)
   apply (simp add: assms)
   using poly_shift_add zcf_add cfs_add poly_shift_closed apply metis 
   unfolding zcf_def using poly_shift_monom poly_shift_degree_zero
   by (simp add: poly_shift_def)
 
 fun poly_shift_iter ("shift") where
 Base:"poly_shift_iter 0 f = f"|
 Step:"poly_shift_iter (Suc n) f = poly_shift (poly_shift_iter n f)"
 
 lemma shift_closed:
   assumes "f \<in> carrier P"
   shows "shift n f \<in> carrier P"
   apply(induction n)
   using assms poly_shift_closed by auto 
 
   (**********************************************************************)
   (**********************************************************************)
   subsection\<open>Operator Which Multiplies Coefficients by Their Degree\<close>
   (**********************************************************************)
   (**********************************************************************)
 
 definition n_mult where 
 "n_mult f = (\<lambda>n. [n]\<cdot>\<^bsub>R\<^esub>(f n))"
 
 lemma(in UP_cring) n_mult_closed:
   assumes "f \<in> carrier P"
   shows "n_mult f \<in> carrier P"
   apply(rule UP_car_memI[of "deg R f"])
   unfolding n_mult_def 
   apply (metis P.l_zero R.add.nat_pow_one UP_zero_closed assms cfs_zero coeff_of_sum_diff_degree0)
   using assms cfs_closed by auto 
 
 text\<open>Facts about the shift function\<close>
 
 lemma shift_one:
 "shift (Suc 0) = poly_shift"
   by auto 
 
 lemma shift_factor0:
   assumes "f \<in> carrier P"
   shows "degree f \<ge> (Suc k) \<Longrightarrow> degree (f \<ominus>\<^bsub>P\<^esub> ((shift (Suc k) f) \<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>(Suc k)))) < (Suc k)"
 proof(induction k)
   case 0
   have 0: " f \<ominus>\<^bsub>P\<^esub> (ctrm f) =  (shift (Suc 0) f)\<otimes>\<^bsub>P\<^esub>X"
     by (metis UP_m_comm X_closed assms poly_shift_id shift_closed shift_one)         
   then have  " f \<ominus>\<^bsub>P\<^esub>(shift (Suc 0) f)\<otimes>\<^bsub>P\<^esub>X =    (ctrm f) "
   proof-
     have " f \<ominus>\<^bsub>P\<^esub> (ctrm f) \<ominus>\<^bsub>P\<^esub> (shift (Suc 0) f)\<otimes>\<^bsub>P\<^esub>X=  (shift (Suc 0) f)\<otimes>\<^bsub>P\<^esub>X \<ominus>\<^bsub>P\<^esub> (shift (Suc 0) f)\<otimes>\<^bsub>P\<^esub>X"
       using 0   by simp
     then have " f \<ominus>\<^bsub>P\<^esub> (ctrm f) \<ominus>\<^bsub>P\<^esub> (shift (Suc 0) f)\<otimes>\<^bsub>P\<^esub>X = \<zero>\<^bsub>P\<^esub>"
       using UP_cring.UP_cring[of R] assms 
       by (metis "0" P.ring_simprules(4) P_def UP_ring.UP_ring UP_ring_axioms 
           a_minus_def abelian_group.r_neg ctrm_is_poly ring_def)
     then have " f \<ominus>\<^bsub>P\<^esub> ((ctrm f) \<oplus>\<^bsub>P\<^esub> (shift (Suc 0) f)\<otimes>\<^bsub>P\<^esub>X) = \<zero>\<^bsub>P\<^esub>"
       using assms P.ring_simprules  
       by (metis "0" poly_shift_id poly_shift_eq)
     then have " f \<ominus>\<^bsub>P\<^esub> ((shift (Suc 0) f)\<otimes>\<^bsub>P\<^esub>X \<oplus>\<^bsub>P\<^esub> (ctrm f) ) = \<zero>\<^bsub>P\<^esub>"
       using P.m_closed UP_a_comm X_closed assms ctrm_is_poly shift_closed 
       by presburger      
     then have "f \<ominus>\<^bsub>P\<^esub> ((shift (Suc 0) f)\<otimes>\<^bsub>P\<^esub>X) \<ominus>\<^bsub>P\<^esub> (ctrm f)= \<zero>\<^bsub>P\<^esub>"
       using P.add.m_assoc P.ring_simprules(14) P.ring_simprules(19) assms "0" 
           P.add.inv_closed P.r_neg P.r_zero ctrm_is_poly
       by smt      
     then show ?thesis 
       by (metis "0" P.add.m_comm P.m_closed P.ring_simprules(14) P.ring_simprules(18) 
           P.ring_simprules(3) X_closed assms ctrm_is_poly poly_shift_id poly_shift_eq 
           shift_closed)
   qed
   then have  " f \<ominus>\<^bsub>P\<^esub>(shift (Suc 0) f)\<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>(Suc 0)) =    (ctrm f) "
   proof-
     have "X = X[^]\<^bsub>P\<^esub>(Suc 0)"
       by (simp add: X_closed)
     then show ?thesis 
       using 0 \<open>f \<ominus>\<^bsub>P\<^esub> shift (Suc 0) f \<otimes>\<^bsub>P\<^esub> X = ctrm f\<close> 
       by auto   
   qed
   then have " degree (f \<ominus>\<^bsub>P\<^esub>(shift (Suc 0) f)\<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>(Suc 0))) < 1"
     using ctrm_degree[of f] assms   by simp
   then show ?case 
     by blast
 next
   case (Suc n)
   fix k
   assume IH: "degree f \<ge> (Suc k) \<Longrightarrow> degree (f \<ominus>\<^bsub>P\<^esub> ((shift (Suc k) f) \<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>(Suc k)))) < (Suc k)"
   show  "degree f \<ge> (Suc (Suc k)) \<Longrightarrow> degree (f \<ominus>\<^bsub>P\<^esub> ((shift (Suc (Suc k)) f) \<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>(Suc (Suc k))))) < (Suc (Suc k))"
   proof-
     obtain n where n_def: "n = Suc k"
       by simp
     have IH': "degree f \<ge> n \<Longrightarrow> degree (f \<ominus>\<^bsub>P\<^esub> ((shift n f) \<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n))) < n"
       using n_def IH by auto 
     have P: "degree f \<ge> (Suc n) \<Longrightarrow> degree (f \<ominus>\<^bsub>P\<^esub> ((shift (Suc n) f) \<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>(Suc n)))) < (Suc n)"
     proof-
       obtain g where g_def: "g = (f \<ominus>\<^bsub>P\<^esub> ((shift n f) \<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n)))"
         by simp
       obtain s where s_def: "s = shift n f"
         by simp
       obtain s' where s'_def: "s' = shift (Suc n) f"
         by simp
       have P: "g \<in> carrier P" "s \<in> carrier P" "s' \<in> carrier P" "(X[^]\<^bsub>P\<^esub>n) \<in> carrier P"
         using s_def s'_def g_def assms shift_closed[of f n]  
         apply (simp add: X_closed)
         apply (simp add: \<open>f \<in> carrier P \<Longrightarrow> shift n f \<in> carrier P\<close> assms s_def)
         using P_def UP_cring.shift_closed UP_cring_axioms assms s'_def apply blast
         using X_closed by blast
       have g_def': "g = (f \<ominus>\<^bsub>P\<^esub> (s \<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n)))"
         using g_def s_def by auto 
       assume "degree f \<ge> (Suc n)"
       then have " degree (f \<ominus>\<^bsub>P\<^esub> (s \<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n))) < n" 
         using IH' Suc_leD s_def by blast
       then have d_g: "degree g < n" using g_def' by auto 
       have P0: "f \<ominus>\<^bsub>P\<^esub> (s' \<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>(Suc n))) = ((ctrm s)\<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n)) \<oplus>\<^bsub>P\<^esub> g"
       proof-
         have "s = (ctrm s) \<oplus>\<^bsub>P\<^esub> (X \<otimes>\<^bsub>P\<^esub> s')"
           using s_def s'_def  P_def poly_shift_eq UP_cring_axioms assms shift_closed 
           by (simp add: UP_cring.poly_shift_eq)
         then have 0: "g = f \<ominus>\<^bsub>P\<^esub> ((ctrm s) \<oplus>\<^bsub>P\<^esub> (X \<otimes>\<^bsub>P\<^esub> s')) \<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n)"
           using g_def'  by auto
         then have "g = f \<ominus>\<^bsub>P\<^esub> ((ctrm s)\<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n)) \<ominus>\<^bsub>P\<^esub> ((X \<otimes>\<^bsub>P\<^esub> s') \<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n))"
-          using P cring X_closed  P.l_distr P.ring_simprules(19) UP_a_assoc a_minus_def assms
+          using P cring_axioms X_closed  P.l_distr P.ring_simprules(19) UP_a_assoc a_minus_def assms
           by (simp add: a_minus_def ctrm_is_poly)
         then have "g \<oplus>\<^bsub>P\<^esub> ((X \<otimes>\<^bsub>P\<^esub> s') \<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n)) =  f \<ominus>\<^bsub>P\<^esub> ((ctrm s)\<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n))"
-          using P cring X_closed  P.l_distr P.ring_simprules UP_a_assoc a_minus_def assms
+          using P cring_axioms X_closed  P.l_distr P.ring_simprules UP_a_assoc a_minus_def assms
           by (simp add: P.r_neg2 ctrm_is_poly)                                                   
         then have " ((ctrm s)\<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n)) =  f \<ominus>\<^bsub>P\<^esub> (g \<oplus>\<^bsub>P\<^esub> ((X \<otimes>\<^bsub>P\<^esub> s') \<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n)))"
-          using P cring X_closed P.ring_simprules UP_a_assoc a_minus_def assms
+          using P cring_axioms X_closed P.ring_simprules UP_a_assoc a_minus_def assms
           by (simp add: P.ring_simprules(17) ctrm_is_poly)           
         then have " ((ctrm s)\<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n)) =  f \<ominus>\<^bsub>P\<^esub> (((X \<otimes>\<^bsub>P\<^esub> s') \<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n)) \<oplus>\<^bsub>P\<^esub> g)"
           by (simp add: P(1) P(3) UP_a_comm X_closed)          
         then have "((ctrm s)\<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n)) =  f \<ominus>\<^bsub>P\<^esub> ((X \<otimes>\<^bsub>P\<^esub> s') \<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n)) \<ominus>\<^bsub>P\<^esub> g"
           using P(1) P(3) P.ring_simprules(19) UP_a_assoc a_minus_def assms
           by (simp add: a_minus_def X_closed) 
         then have "((ctrm s)\<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n)) \<oplus>\<^bsub>P\<^esub> g=  f \<ominus>\<^bsub>P\<^esub> ((X \<otimes>\<^bsub>P\<^esub> s') \<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n))"
           by (metis P(1) P(3) P(4) P.add.inv_solve_right P.m_closed P.ring_simprules(14)
               P.ring_simprules(4) P_def UP_cring.X_closed UP_cring_axioms assms)
         then have "((ctrm s)\<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n)) \<oplus>\<^bsub>P\<^esub> g=  f \<ominus>\<^bsub>P\<^esub> ((s' \<otimes>\<^bsub>P\<^esub> X) \<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n))"
           by (simp add: P(3) UP_m_comm X_closed)         
         then have "((ctrm s)\<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n)) \<oplus>\<^bsub>P\<^esub> g=  f \<ominus>\<^bsub>P\<^esub> (s' \<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>(Suc n)))"
           using P(3) P.nat_pow_Suc2 UP_m_assoc X_closed by auto
         then show ?thesis
           by auto 
       qed
       have P1: "degree (((ctrm s)\<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n)) \<oplus>\<^bsub>P\<^esub> g) \<le> n"
       proof-
         have Q0: "degree ((ctrm s)\<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n))  \<le> n"
         proof(cases "ctrm s = \<zero>\<^bsub>P\<^esub>")
           case True
           then show ?thesis 
             by (simp add: P(4))
         next
           case False
           then have F0: "degree ((ctrm s)\<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n)) \<le> degree (ctrm s) + degree (X[^]\<^bsub>P\<^esub>n) "
             by (meson ctrm_is_poly P(2) P(4) deg_mult_ring)             
           have F1: "\<one>\<noteq>\<zero>\<Longrightarrow> degree (X[^]\<^bsub>P\<^esub>n) = n"
             unfolding X_poly_def 
             using P_def cring_monom_degree by auto
           show ?thesis 
             by (metis (no_types, opaque_lifting) F0 F1 ltrm_deg_0 P(2) P.r_null P_def R.l_null R.l_one 
                 R.nat_pow_closed R.zero_closed X_poly_def assms cfs_closed 
                 add_0 deg_const deg_zero deg_ltrm 
                 monom_pow monom_zero zero_le)                                    
         qed
         then show ?thesis 
           using d_g
           by (simp add: P(1) P(2) P(4) bound_deg_sum ctrm_is_poly) 
       qed
       then show ?thesis 
         using s'_def P0 by auto
     qed
     assume "degree f \<ge> (Suc (Suc k)) "
     then show "degree (f \<ominus>\<^bsub>P\<^esub> ((shift (Suc (Suc k)) f) \<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>(Suc (Suc k))))) < (Suc (Suc k))"
       using P by(simp add: n_def)
   qed
 qed
 
 lemma(in UP_cring) shift_degree0:
   assumes "f \<in> carrier P"
   shows "degree f >n \<Longrightarrow> Suc (degree (shift (Suc n) f)) = degree (shift n f)"
 proof(induction n) 
   case 0
   assume B: "0< degree f"
   have 0: "degree (shift 0 f) = degree f"
     by simp
   have 1: "degree f = degree (f \<ominus>\<^bsub>P\<^esub> (ctrm f))"
     using assms(1) B ctrm_degree degree_of_difference_diff_degree
     by (simp add: ctrm_is_poly)   
   have "(f \<ominus>\<^bsub>P\<^esub> (ctrm f)) = X \<otimes>\<^bsub>P\<^esub>(shift 1 f)"
     using P_def poly_shift_id UP_cring_axioms assms(1) by auto
   then have "degree (f \<ominus>\<^bsub>P\<^esub> (ctrm f)) = 1 + (degree (shift 1 f))"
     by (metis "1" B P.r_null X_closed add.commute assms deg_nzero_nzero degree_times_X not_gr_zero shift_closed)        
   then have  "degree (shift 0 f) = 1 + (degree (shift 1 f))"
     using 0 1 by auto 
   then show ?case 
     by simp
 next
   case (Suc n)
   fix n 
   assume IH: "(n < degree f \<Longrightarrow> Suc (degree (shift (Suc n) f)) = degree (shift n f))"
   show "Suc n < degree f \<Longrightarrow> Suc (degree (shift (Suc (Suc n)) f)) = degree (shift (Suc n) f)"
   proof-
     assume A: " Suc n < degree f"
     then have 0: "(shift (Suc n) f) = ctrm ((shift (Suc n) f)) \<oplus>\<^bsub>P\<^esub>  (shift (Suc (Suc n)) f)\<otimes>\<^bsub>P\<^esub>X"
       by (metis UP_m_comm X_closed assms local.Step poly_shift_eq shift_closed)                
     have N: "(shift (Suc (Suc n)) f) \<noteq> \<zero>\<^bsub>P\<^esub>"
     proof
       assume C: "shift (Suc (Suc n)) f = \<zero>\<^bsub>P\<^esub>"
       obtain g where g_def: "g = f \<ominus>\<^bsub>P\<^esub>  (shift (Suc (Suc n)) f)\<otimes>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>(Suc (Suc n)))"
         by simp
       have C0: "degree g < degree f"
         using g_def assms A 
         by (meson Suc_leI Suc_less_SucD Suc_mono less_trans_Suc shift_factor0)
       have C1: "g = f" 
         using C
         by (simp add: P.minus_eq X_closed assms g_def)          
       then show False 
         using C0 by auto 
     qed
     have 1: "degree (shift (Suc n) f) = degree ((shift (Suc n) f) \<ominus>\<^bsub>P\<^esub> ctrm ((shift (Suc n) f)))"
     proof(cases "degree (shift (Suc n) f) = 0")
       case True
       then show ?thesis 
         using N assms poly_shift_degree_zero poly_shift_closed shift_closed by auto        
     next
       case False
       then have "degree (shift (Suc n) f) > degree  (ctrm ((shift (Suc n) f)))"
       proof -
         have "shift (Suc n) f \<in> carrier P"
           using assms shift_closed by blast
         then show ?thesis
           using False ctrm_degree by auto
       qed        
       then show ?thesis
       proof -
         show ?thesis
           using \<open>degree (ctrm (shift (Suc n) f)) < degree (shift (Suc n) f)\<close> 
             assms ctrm_is_poly degree_of_difference_diff_degree shift_closed by presburger
       qed         
     qed
     have 2: "(shift (Suc n) f) \<ominus>\<^bsub>P\<^esub> ctrm ((shift (Suc n) f)) =  (shift (Suc (Suc n)) f)\<otimes>\<^bsub>P\<^esub>X"
       using 0
       by (metis Cring_Poly.INTEG.Step P.m_comm X_closed assms poly_shift_id shift_closed)                                   
     have 3: "degree ((shift (Suc n) f) \<ominus>\<^bsub>P\<^esub> ctrm ((shift (Suc n) f))) =  degree (shift (Suc (Suc n)) f) + 1"
       using 2 N X_closed X_not_zero assms  degree_X shift_closed 
       by (metis UP_m_comm degree_times_X)
     then show ?thesis using 1
       by linarith
   qed
 qed
 
 lemma(in UP_cring) shift_degree:
   assumes "f \<in> carrier P"
   shows "degree f \<ge> n \<Longrightarrow>  degree (shift n f) + n = degree f"
 proof(induction n)
   case 0
   then show ?case 
     by auto
 next
   case (Suc n)
   fix n
   assume IH: "(n \<le> degree f \<Longrightarrow> degree (shift n f) + n = degree f)"
   show "Suc n \<le> degree f \<Longrightarrow> degree (shift (Suc n) f) + Suc n = degree f"
   proof-
     assume A: "Suc n \<le> degree f "
     have 0: "degree (shift n f) + n = degree f" 
       using IH A by auto  
     have 1: "degree (shift n f) = Suc (degree (shift (Suc n) f))"
       using A assms shift_degree0 by auto 
     show "degree (shift (Suc n) f) + Suc n = degree f" 
       using 0 1  by simp
   qed
 qed
 
 lemma(in UP_cring) shift_degree':
   assumes "f \<in> carrier P"
   shows "degree (shift (degree f) f) = 0"
   using shift_degree assms 
   by fastforce
 
 lemma(in UP_cring) shift_above_degree:
   assumes "f \<in> carrier P"
   assumes "k > degree f"
   shows "(shift k f) = \<zero>\<^bsub>P\<^esub>"
 proof-
   have "\<And>n. shift ((degree f)+ (Suc n)) f = \<zero>\<^bsub>P\<^esub>"
   proof-
     fix n
     show "shift ((degree f)+ (Suc n)) f = \<zero>\<^bsub>P\<^esub>"
     proof(induction n)
       case 0
       have B0:"shift (degree f) f  = ctrm(shift (degree f) f) \<oplus>\<^bsub>P\<^esub> (shift (degree f + Suc 0) f)\<otimes>\<^bsub>P\<^esub>X"
       proof -
         have f1: "\<forall>f n. f \<notin> carrier P \<or> shift n f \<in> carrier P"
           by (meson shift_closed)
         then have "shift (degree f + Suc 0) f \<in> carrier P"
           using assms(1) by blast
         then show ?thesis
           using f1 by (simp add: P.m_comm X_closed assms(1) poly_shift_eq)
       qed        
       have B1:"shift (degree f) f = ctrm(shift (degree f) f)"
       proof -
         have "shift (degree f) f \<in> carrier P"
           using assms(1) shift_closed by blast
         then show ?thesis
           using ltrm_deg_0 assms(1) shift_degree' by auto          
       qed        
       have B2: "(shift (degree f + Suc 0) f)\<otimes>\<^bsub>P\<^esub>X = \<zero>\<^bsub>P\<^esub>"
         using B0 B1 X_closed assms(1)
       proof -
         have "\<forall>f n. f \<notin> carrier P \<or> shift n f \<in> carrier P"
           using shift_closed by blast
         then show ?thesis
           by (metis (no_types) B0 B1 P.add.l_cancel_one UP_mult_closed X_closed assms(1))
       qed         
       then show ?case 
         by (metis P.r_null UP_m_comm UP_zero_closed X_closed assms(1) zcf_eq_zero_unique shift_closed)        
     next
       case (Suc n)
       fix n
       assume "shift (degree f + Suc n) f = \<zero>\<^bsub>P\<^esub>"
       then show "shift (degree f + Suc (Suc n)) f = \<zero>\<^bsub>P\<^esub>"
         by (simp add: poly_shift_degree_zero)
     qed
   qed
   then show ?thesis 
     using assms(2) less_iff_Suc_add by auto
 qed
 
 lemma(in UP_domain) shift_cfs0:
   assumes "f \<in> carrier P"
   shows "zcf(shift 1 f) = f 1"
   using assms 
   by (simp add: zcf_poly_shift) 
 
 lemma(in UP_cring) X_mult_cf:
   assumes "p \<in> carrier P"
   shows "(p \<otimes>\<^bsub>P\<^esub> X) (k+1) = p k"
   unfolding X_poly_def
   using assms 
   by (metis UP_m_comm X_closed X_poly_def add.commute plus_1_eq_Suc cfs_times_X)
  
 lemma(in UP_cring) X_pow_cf:
   assumes "p \<in> carrier P"
   shows "(p \<otimes>\<^bsub>P\<^esub> X[^]\<^bsub>P\<^esub>(n::nat)) (n + k) = p k"
 proof-
   have P: "\<And>f. f \<in> carrier P \<Longrightarrow> (f \<otimes>\<^bsub>P\<^esub> X[^]\<^bsub>P\<^esub>(n::nat)) (n + k) = f k"
   proof(induction n)
     show "\<And>f. f \<in> carrier P \<Longrightarrow> (f \<otimes>\<^bsub>P\<^esub> X [^]\<^bsub>P\<^esub> (0::nat)) (0 + k) = f k"
     proof-
       fix f
       assume B0: "f \<in> carrier P"
       show "(f \<otimes>\<^bsub>P\<^esub> X [^]\<^bsub>P\<^esub> (0::nat)) (0 + k) = f k"
         by (simp add: B0)
     qed
     fix n
     fix f
     assume IH: "(\<And>f. f \<in> carrier P \<Longrightarrow> (f \<otimes>\<^bsub>P\<^esub> X [^]\<^bsub>P\<^esub> n) (n + k) = f k)"
     assume A0: " f \<in> carrier P"
     show "(f \<otimes>\<^bsub>P\<^esub> X [^]\<^bsub>P\<^esub> Suc n) (Suc n + k) = f k"
     proof-
       have 0: "(f \<otimes>\<^bsub>P\<^esub> X [^]\<^bsub>P\<^esub> n)(n + k) = f k"
         using A0 IH by simp
       have 1: "((f \<otimes>\<^bsub>P\<^esub> X [^]\<^bsub>P\<^esub> n)\<otimes>\<^bsub>P\<^esub>X) (Suc n + k) = (f \<otimes>\<^bsub>P\<^esub> X [^]\<^bsub>P\<^esub> n)(n + k)"
         using X_mult_cf A0 P.m_closed P.nat_pow_closed 
               Suc_eq_plus1 X_closed add_Suc by presburger
       have 2: "(f \<otimes>\<^bsub>P\<^esub> (X [^]\<^bsub>P\<^esub> n \<otimes>\<^bsub>P\<^esub>X)) (Suc n + k) = (f \<otimes>\<^bsub>P\<^esub> X [^]\<^bsub>P\<^esub> n)(n + k)"
         using 1
         by (simp add: A0 UP_m_assoc X_closed)         
       then show ?thesis 
         by (simp add: "0")
     qed
   qed
   show ?thesis using assms P[of p] by auto 
 qed
 
 lemma poly_shift_cfs:
   assumes "f \<in> carrier P"
   shows "poly_shift f n = f (Suc n)"
 proof-
   have "(f \<ominus>\<^bsub>P\<^esub> ctrm f) (Suc n) = (X \<otimes>\<^bsub>P\<^esub> (poly_shift f)) (Suc n)"
     using assms poly_shift_id by auto
   then show ?thesis unfolding X_poly_def using poly_shift_closed assms 
     by (metis (no_types, lifting) ctrm_degree ctrm_is_poly 
         P.add.m_comm P.minus_closed coeff_of_sum_diff_degree0 poly_shift_id poly_shift_eq cfs_times_X zero_less_Suc)
 qed
 
 lemma(in UP_cring) shift_cfs:
   assumes "p \<in> carrier P"
   shows "(shift k p) n = p (k + n)"
   apply(induction k arbitrary: n)
   by (auto simp: assms poly_shift_cfs shift_closed)
 
   (**********************************************************************)
   (**********************************************************************)
   subsection\<open>The Derivative Operator\<close>
   (**********************************************************************)
   (**********************************************************************)
 definition pderiv where
 "pderiv  p = poly_shift (n_mult p)"
 
 lemma pderiv_closed:
   assumes "p \<in> carrier P"
   shows "pderiv p \<in> carrier P"
   unfolding  pderiv_def 
   using assms n_mult_closed[of p]  poly_shift_closed[of "n_mult p"] 
   by blast
 
 text\<open>Function which obtains the first n+1 terms of f, in ascending order of degree:\<close>
 
 definition trms_of_deg_leq  where
 "trms_of_deg_leq n f \<equiv> f \<ominus>\<^bsub>(UP R)\<^esub> ((shift (Suc n) f) \<otimes>\<^bsub>UP R\<^esub> monom P \<one> (Suc n))"
 
 lemma trms_of_deg_leq_closed:
   assumes "f \<in> carrier P"
   shows "trms_of_deg_leq n f \<in> carrier P"
   unfolding trms_of_deg_leq_def using assms 
   by (metis P.m_closed P.minus_closed P_def R.one_closed monom_closed shift_closed)
 
 lemma trms_of_deg_leq_id:
   assumes "f \<in> carrier P"
   shows "f \<ominus>\<^bsub>P\<^esub> (trms_of_deg_leq k f) = shift (Suc k) f \<otimes>\<^bsub>P\<^esub> monom P \<one> (Suc k)"
   unfolding trms_of_deg_leq_def 
   using assms 
   by (smt P.add.inv_closed P.l_zero P.m_closed P.minus_add P.minus_minus P.r_neg
       P_def R.one_closed UP_a_assoc a_minus_def monom_closed shift_closed)
 
 lemma trms_of_deg_leq_id':
   assumes "f \<in> carrier P"
   shows "f = (trms_of_deg_leq k f)  \<oplus>\<^bsub>P\<^esub> shift (Suc k) f \<otimes>\<^bsub>P\<^esub> monom P \<one> (Suc k)"
   using trms_of_deg_leq_id assms  trms_of_deg_leq_closed[of f]
   by (smt P.add.inv_closed P.l_zero P.m_closed P.minus_add P.minus_minus P.r_neg R.one_closed UP_a_assoc a_minus_def monom_closed shift_closed)
 
 lemma deg_leqI:
   assumes "p \<in> carrier P"
   assumes "\<And>n. n > k \<Longrightarrow> p n = \<zero>"
   shows "degree p \<le> k"
   by (metis assms(1) assms(2) deg_zero deg_ltrm le0 le_less_linear monom_zero)
 
 lemma deg_leE:
   assumes "p \<in> carrier P"
   assumes "degree p < k"
   shows "p k = \<zero>"
   using assms  coeff_of_sum_diff_degree0 P_def coeff_simp deg_aboveD 
   by auto
 
 lemma trms_of_deg_leq_deg:
   assumes "f \<in> carrier P"
   shows "degree (trms_of_deg_leq k f) \<le> k"
 proof-
   have "\<And>n. (trms_of_deg_leq k f) (Suc k + n) = \<zero>"
   proof-
     fix n
     have 0: "(shift (Suc k) f \<otimes>\<^bsub>UP R\<^esub> monom P \<one> (Suc k)) (Suc k + n) = shift (Suc k) f n"
       using assms shift_closed cfs_monom_mult_l 
       by (metis P.m_comm P_def R.one_closed add.commute monom_closed times_X_pow_coeff)
     then show "trms_of_deg_leq k f (Suc k + n) = \<zero>" 
       unfolding trms_of_deg_leq_def
       using shift_cfs[of f "Suc k" n] 
             cfs_minus[of f "shift (Suc k) f \<otimes>\<^bsub>UP R\<^esub> monom P \<one> (Suc k)" "Suc k + n"]
       by (metis P.m_closed P.r_neg P_def R.one_closed a_minus_def assms 
           cfs_minus cfs_zero monom_closed shift_closed)
   qed
   then show ?thesis using deg_leqI 
     by (metis (no_types, lifting) assms le_iff_add less_Suc_eq_0_disj less_Suc_eq_le trms_of_deg_leq_closed)
 qed
   
 lemma trms_of_deg_leq_zero_is_ctrm:
   assumes "f \<in> carrier P"
   assumes "degree f > 0"
   shows "trms_of_deg_leq 0 f = ctrm f"
 proof-
   have "f = ctrm f \<oplus>\<^bsub>P\<^esub> (X \<otimes>\<^bsub>P\<^esub> (shift (Suc 0) f))"
     using assms poly_shift_eq 
     by simp
   then have "f = ctrm f \<oplus>\<^bsub>P\<^esub> (X [^]\<^bsub>UP R\<^esub> Suc 0 \<otimes>\<^bsub>P\<^esub> (shift (Suc 0) f))"
     using P.nat_pow_eone P_def X_closed  by auto
   then show ?thesis 
   unfolding trms_of_deg_leq_def 
   by (metis (no_types, lifting) ctrm_is_poly One_nat_def P.add.right_cancel P.m_closed 
       P.minus_closed P.nat_pow_eone P_def UP_m_comm X_closed X_poly_def assms(1) shift_closed
       trms_of_deg_leq_def trms_of_deg_leq_id')
 qed
 
 lemma cfs_monom_mult:
   assumes "p \<in> carrier P"
   assumes "a \<in> carrier R"
   assumes "k < n"
   shows "(p \<otimes>\<^bsub>P\<^esub> (monom P a n)) k = \<zero>"
   apply(rule poly_induct3[of p])
     apply (simp add: assms(1))
    apply (metis (no_types, lifting) P.l_distr P.m_closed R.r_zero R.zero_closed assms(2) cfs_add monom_closed)
   using assms monom_mult[of _ a _ n] 
   by (metis R.m_closed R.m_comm add.commute cfs_monom not_add_less1)
 
 lemma(in UP_cring) cfs_monom_mult_2:
   assumes "f \<in> carrier P"
   assumes "a \<in> carrier R"
   assumes "m < n"
   shows "((monom P a n) \<otimes>\<^bsub>P\<^esub> f) m = \<zero>"
   using cfs_monom_mult
   by (simp add: P.m_comm assms(1) assms(2) assms(3))
 
 lemma trms_of_deg_leq_cfs:
   assumes "f \<in> carrier P"
   shows "trms_of_deg_leq n f k = (if k \<le> n then (f k) else \<zero>)"
   unfolding trms_of_deg_leq_def 
   apply(cases "k \<le> n")
   using cfs_minus[of f "shift (Suc n) f \<otimes>\<^bsub>UP R\<^esub> monom P \<one> (Suc n)"] 
         cfs_monom_mult[of _ \<one> k "Suc n"] 
    apply (metis (no_types, lifting) P.m_closed P.minus_closed P_def R.one_closed R.r_zero assms
       cfs_add cfs_closed le_refl monom_closed nat_less_le nat_neq_iff not_less_eq_eq shift_closed 
       trms_of_deg_leq_def trms_of_deg_leq_id')
   using trms_of_deg_leq_deg[of f n] deg_leE   
   unfolding trms_of_deg_leq_def 
   using assms trms_of_deg_leq_closed trms_of_deg_leq_def by auto
  
 lemma trms_of_deg_leq_iter:
   assumes "f \<in> carrier P"
   shows "trms_of_deg_leq (Suc k) f = (trms_of_deg_leq k f) \<oplus>\<^bsub>P\<^esub> monom P (f (Suc k)) (Suc k)"
 proof fix x
   show "trms_of_deg_leq (Suc k) f x = (trms_of_deg_leq k f \<oplus>\<^bsub>P\<^esub> monom P (f (Suc k)) (Suc k)) x"
     apply(cases "x \<le> k")
     using trms_of_deg_leq_cfs trms_of_deg_leq_closed cfs_closed[of f "Suc k"]
           cfs_add[of "trms_of_deg_leq k f" "monom P (f (Suc k)) (Suc k)" x]   
      apply (simp add: assms)
     using deg_leE assms cfs_closed cfs_monom apply auto[1]
     by (simp add: assms cfs_closed cfs_monom trms_of_deg_leq_cfs trms_of_deg_leq_closed)   
 qed 
 
 lemma trms_of_deg_leq_0:
   assumes "f \<in> carrier P"
   shows "trms_of_deg_leq 0 f = ctrm f"
   by (metis One_nat_def P.r_null P_def UP_m_comm UP_zero_closed X_closed X_poly_def assms not_gr_zero
       poly_shift_degree_zero shift_one trms_of_deg_leq_def trms_of_deg_leq_zero_is_ctrm trunc_simps(2) trunc_zero)
   
 lemma trms_of_deg_leq_degree_f:
   assumes "f \<in>  carrier P"
   shows "trms_of_deg_leq (degree f) f = f"
 proof fix x 
   show "trms_of_deg_leq (deg R f) f x = f x"
     using assms trms_of_deg_leq_cfs deg_leE[of f x] 
   by simp
 qed
 
 definition(in UP_cring) lin_part where
 "lin_part f = trms_of_deg_leq 1 f"
 
 lemma(in UP_cring) lin_part_id:
   assumes "f \<in> carrier P"
   shows "lin_part f = (ctrm f) \<oplus>\<^bsub>P\<^esub> monom P (f 1) 1"
   unfolding lin_part_def
   by (simp add: assms trms_of_deg_leq_0 trms_of_deg_leq_iter)
 
 lemma(in UP_cring) lin_part_eq:
   assumes "f \<in> carrier P"
   shows "f = lin_part f \<oplus>\<^bsub>P\<^esub> (shift 2 f) \<otimes>\<^bsub>P\<^esub> monom P \<one> 2"
   unfolding lin_part_def 
   by (metis Suc_1 assms trms_of_deg_leq_id')
 
 text\<open>Constant term of a substitution:\<close>
 
 lemma zcf_eval:
   assumes "f \<in> carrier P"
   shows "zcf f = to_fun f \<zero>"
   using assms zcf_to_fun by blast
 
 lemma ctrm_of_sub:
   assumes "f \<in> carrier P"
   assumes "g \<in> carrier P"
   shows "zcf(f of g) = to_fun f (zcf g)"
   apply(rule poly_induct3[of f]) 
   apply (simp add: assms(1))
   using P_def UP_cring.to_fun_closed UP_cring_axioms zcf_add zcf_to_fun assms(2) to_fun_plus sub_add sub_closed apply fastforce
   using R.zero_closed zcf_to_fun assms(2) to_fun_sub monom_closed sub_closed by presburger
  
 text\<open>Evaluation of linear part:\<close>
 
 lemma to_fun_lin_part:
   assumes "f \<in> carrier P"
   assumes "b \<in> carrier R"
   shows "to_fun (lin_part f) b = (f 0) \<oplus> (f 1) \<otimes> b"
   using assms lin_part_id[of f] to_fun_ctrm to_fun_monom monom_closed 
    by (simp add: cfs_closed to_fun_plus) 
 
 text\<open>Constant term of taylor expansion:\<close>
 
 lemma taylor_zcf:
   assumes "f \<in> carrier P"
   assumes "a \<in> carrier R"
   shows "zcf(T\<^bsub>a\<^esub> f) = to_fun f a"
   unfolding taylor_expansion_def
   using ctrm_of_sub assms P_def zcf_eval X_plus_closed taylor_closed taylor_eval by auto
 
 lemma(in UP_cring) taylor_eq_1:
   assumes "f \<in> carrier P"
   assumes "a \<in> carrier R"
   shows "(T\<^bsub>a\<^esub> f) \<ominus>\<^bsub>P\<^esub> (trms_of_deg_leq 1 (T\<^bsub>a\<^esub> f)) = (shift (2::nat) (T\<^bsub>a\<^esub> f))\<otimes>\<^bsub>P\<^esub> (X[^]\<^bsub>P\<^esub>(2::nat))"
   by (metis P.nat_pow_eone P.nat_pow_mult P_def Suc_1 taylor_closed X_closed X_poly_def assms(1) 
       assms(2) monom_one_Suc2 one_add_one trms_of_deg_leq_id)
 
 lemma(in UP_cring) taylor_deg_1:
   assumes "f \<in> carrier P"
   assumes "a \<in> carrier R"
   shows "f of (X_plus a) = (lin_part (T\<^bsub>a\<^esub> f)) \<oplus>\<^bsub>P\<^esub> (shift (2::nat) (T\<^bsub>a\<^esub> f))\<otimes>\<^bsub>P\<^esub> (X[^]\<^bsub>P\<^esub>(2::nat))"
   using taylor_eq_1[of f a]
   unfolding taylor_expansion_def lin_part_def
   using One_nat_def X_plus_closed assms(1) 
         assms(2) trms_of_deg_leq_id' numeral_2_eq_2 sub_closed 
   by (metis P.nat_pow_Suc2 P.nat_pow_eone P_def taylor_def X_closed X_poly_def monom_one_Suc taylor_expansion_def)
 
 lemma(in UP_cring) taylor_deg_1_eval:
   assumes "f \<in> carrier P"
   assumes "a \<in> carrier R"
   assumes "b \<in> carrier R"
   assumes "c = to_fun (shift (2::nat) (T\<^bsub>a\<^esub> f)) b"
   assumes "fa = to_fun f a"
   assumes "f'a = deriv f a"
   shows "to_fun f (b \<oplus> a) = fa \<oplus> (f'a \<otimes> b) \<oplus> (c \<otimes> b[^](2::nat))"
   using assms taylor_deg_1 unfolding derivative_def   
 proof-
   have 0: "to_fun f (b \<oplus> a) = to_fun (f of (X_plus a)) b"
     using to_fun_sub assms X_plus_closed by auto    
   have 1: "to_fun (lin_part (T\<^bsub>a\<^esub> f)) b = fa \<oplus> (f'a \<otimes> b) "
     using assms to_fun_lin_part[of "(T\<^bsub>a\<^esub> f)" b]  
     by (metis P_def taylor_def UP_cring.taylor_zcf UP_cring.taylor_closed UP_cring_axioms zcf_def derivative_def)    
   have 2: "(T\<^bsub>a\<^esub> f) = (lin_part (T\<^bsub>a\<^esub> f)) \<oplus>\<^bsub>P\<^esub> ((shift 2 (T\<^bsub>a\<^esub> f))\<otimes>\<^bsub>P\<^esub>X[^]\<^bsub>P\<^esub>(2::nat))"
     using lin_part_eq[of "(T\<^bsub>a\<^esub>f)"] assms(1) assms(2) taylor_closed 
     by (metis taylor_def taylor_deg_1 taylor_expansion_def)        
   then have "to_fun (T\<^bsub>a\<^esub>f) b = fa \<oplus> (f'a \<otimes> b) \<oplus> to_fun ((shift 2 (T\<^bsub>a\<^esub> f))\<otimes>\<^bsub>P\<^esub>X[^]\<^bsub>P\<^esub>(2::nat)) b"
     using 1 2 
     by (metis P.nat_pow_closed taylor_closed UP_mult_closed X_closed assms(1) assms(2) assms(3) 
         to_fun_plus lin_part_def shift_closed trms_of_deg_leq_closed)    
   then have  "to_fun (T\<^bsub>a\<^esub>f) b = fa \<oplus> (f'a \<otimes> b) \<oplus> c \<otimes> to_fun (X[^]\<^bsub>P\<^esub>(2::nat)) b"
     by (simp add: taylor_closed X_closed assms(1) assms(2) assms(3) assms(4) to_fun_mult shift_closed)    
   then have 3: "to_fun f (b \<oplus> a)= fa \<oplus> (f'a \<otimes> b) \<oplus> c \<otimes> to_fun (X[^]\<^bsub>P\<^esub>(2::nat)) b"
     using taylor_eval assms(1) assms(2) assms(3) by auto
   have "to_fun (X[^]\<^bsub>P\<^esub>(2::nat)) b = b[^](2::nat)"
     by (metis P.nat_pow_Suc2 P.nat_pow_eone R.nat_pow_Suc2 
         R.nat_pow_eone Suc_1 to_fun_X 
         X_closed assms(3) to_fun_mult)
   then show ?thesis 
     using 3 by auto 
 qed
 
 lemma(in UP_cring) taylor_deg_1_eval':
   assumes "f \<in> carrier P"
   assumes "a \<in> carrier R"
   assumes "b \<in> carrier R"
   assumes "c = to_fun (shift (2::nat) (T\<^bsub>a\<^esub> f)) b"
   assumes "fa = to_fun f a"
   assumes "f'a = deriv f a"
   shows "to_fun f (a \<oplus> b) = fa \<oplus> (f'a \<otimes> b) \<oplus> (c \<otimes> b[^](2::nat))"
   using R.add.m_comm taylor_deg_1_eval assms(1) assms(2) assms(3) assms(4) assms(5) assms(6) 
   by auto
 
 lemma(in UP_cring) taylor_deg_1_eval'':
   assumes "f \<in> carrier P"
   assumes "a \<in> carrier R"
   assumes "b \<in> carrier R"
   assumes "c = to_fun (shift (2::nat) (T\<^bsub>a\<^esub> f)) (\<ominus>b)"
   shows "to_fun f (a \<ominus> b) = (to_fun f a) \<ominus> (deriv f a \<otimes> b) \<oplus> (c \<otimes> b[^](2::nat))"
 proof-
   have "\<ominus>b \<in> carrier R"
     using assms 
     by blast
   then have 0: "to_fun f (a \<ominus> b) = (to_fun f a)\<oplus> (deriv f a \<otimes> (\<ominus>b)) \<oplus> (c \<otimes> (\<ominus>b)[^](2::nat))"
   unfolding a_minus_def
   using taylor_deg_1_eval'[of f a "\<ominus>b" c "(to_fun f a)" "deriv f a"] assms
   by auto 
   have 1: "\<ominus> (deriv f a \<otimes> b) = (deriv f a \<otimes> (\<ominus>b))"
     using assms 
     by (simp add: R.r_minus deriv_closed)
   have 2: "(c \<otimes> b[^](2::nat)) = (c \<otimes> (\<ominus>b)[^](2::nat))"
     using assms 
     by (metis R.add.inv_closed R.add.inv_solve_right R.l_zero R.nat_pow_Suc2 
         R.nat_pow_eone R.zero_closed Suc_1 UP_ring_axioms UP_ring_def
         ring.ring_simprules(26) ring.ring_simprules(27))
   show ?thesis 
     using 0 1 2 
     unfolding a_minus_def
     by simp 
 qed
 
 lemma(in UP_cring) taylor_deg_1_expansion:
   assumes "f \<in> carrier P"
   assumes "a \<in> carrier R"
   assumes "b \<in> carrier R"
   assumes "c = to_fun (shift (2::nat) (T\<^bsub>a\<^esub> f)) (b \<ominus> a)"
   assumes "fa = to_fun f a"
   assumes "f'a = deriv f a"
   shows "to_fun f (b) = fa \<oplus> f'a \<otimes> (b \<ominus> a) \<oplus> (c \<otimes> (b \<ominus> a)[^](2::nat))"
 proof-
   obtain b' where b'_def: "b'= b \<ominus> a "
     by simp
   then have b'_def': "b = b' \<oplus> a"
     using assms 
     by (metis R.add.inv_solve_right R.minus_closed R.minus_eq)
   have "to_fun f (b' \<oplus> a) = fa \<oplus> (f'a \<otimes> b') \<oplus> (c \<otimes> b'[^](2::nat))" 
     using assms taylor_deg_1_eval[of f a b' c fa f'a]  b'_def 
     by blast
   then have "to_fun f (b) = fa \<oplus> (f'a \<otimes> b') \<oplus> (c \<otimes> b'[^](2::nat))" 
     using b'_def' 
     by auto 
   then show "to_fun f (b) = fa \<oplus> f'a \<otimes> (b \<ominus> a) \<oplus> c \<otimes> (b \<ominus> a) [^] (2::nat)"
     using b'_def
     by auto   
 qed
 
 lemma(in UP_cring) Taylor_deg_1_expansion':
   assumes "f \<in> carrier (UP R)"
   assumes "a \<in> carrier R"
   assumes "b \<in> carrier R"
   shows "\<exists>c \<in> carrier R. to_fun f (b) = (to_fun f a) \<oplus> (deriv f a) \<otimes> (b \<ominus> a) \<oplus> (c \<otimes> (b \<ominus> a)[^](2::nat))"
   using taylor_deg_1_expansion[of f a b] assms unfolding P_def 
   by (metis P_def R.minus_closed taylor_closed shift_closed to_fun_closed)
 
 
 text\<open>Basic Properties of deriv and pderiv:\<close>
 
 lemma n_mult_degree_bound:
   assumes "f \<in> carrier P"
   shows "degree (n_mult f) \<le> degree f"
   apply(rule deg_leqI)
   apply (simp add: assms n_mult_closed)
   by (simp add: assms deg_leE n_mult_def)
 
 lemma pderiv_deg_0[simp]:
   assumes "f \<in> carrier P"
   assumes "degree f = 0"
   shows "pderiv f = \<zero>\<^bsub>P\<^esub>"
 proof-
   have "degree (n_mult f) = 0"
     using P_def n_mult_degree_bound  assms(1) assms(2) by fastforce
   then show ?thesis 
     unfolding pderiv_def
     by (simp add: assms(1) n_mult_closed poly_shift_degree_zero)    
 qed
 
 lemma deriv_deg_0:
   assumes "f \<in> carrier P"
   assumes "degree f = 0"
   assumes "a \<in> carrier R"
   shows "deriv f a = \<zero>"
   unfolding derivative_def taylor_expansion_def
   using X_plus_closed assms(1) assms(2) assms(3) deg_leE sub_const by force
 
 lemma poly_shift_monom':
   assumes "a \<in> carrier R"
   shows "poly_shift (a \<odot>\<^bsub>P\<^esub> (X[^]\<^bsub>P\<^esub>(Suc n))) = a\<odot>\<^bsub>P\<^esub>(X[^]\<^bsub>P\<^esub>n)"
   using assms monom_rep_X_pow poly_shift_monom by auto
 
 lemma monom_coeff:
   assumes "a \<in> carrier R"
   shows "(a \<odot>\<^bsub>P\<^esub> X [^]\<^bsub>P\<^esub> (n::nat)) k = (if (k = n) then a else \<zero>)"
   using assms cfs_monom monom_rep_X_pow by auto
 
 lemma cfs_n_mult:
   assumes "p \<in> carrier P"
   shows "n_mult p n = [n]\<cdot>(p n)"
   by (simp add: n_mult_def)
 
 lemma cfs_add_nat_pow:
   assumes "p \<in> carrier P"
   shows "([(n::nat)]\<cdot>\<^bsub>P\<^esub>p) k = [n]\<cdot>(p k)"
   apply(induction n) by (auto simp: assms)
 
 lemma cfs_add_int_pow:
   assumes "p \<in> carrier P"
   shows "([(n::int)]\<cdot>\<^bsub>P\<^esub>p) k = [n]\<cdot>(p k)"
   apply(induction n)
   by(auto simp: add_pow_int_ge assms cfs_add_nat_pow add_pow_int_lt)
 
 lemma add_nat_pow_monom:
   assumes "a \<in> carrier R"
   shows "[(n::nat)]\<cdot>\<^bsub>P\<^esub>monom P a k = monom P ([n]\<cdot>a) k"
   apply(rule ext) 
   by (simp add: assms cfs_add_nat_pow cfs_monom)
   
 lemma add_int_pow_monom:
   assumes "a \<in> carrier R"
   shows "[(n::int)]\<cdot>\<^bsub>P\<^esub>monom P a k = monom P ([n]\<cdot>a) k"
   apply(rule ext) 
   by (simp add: assms cfs_add_int_pow cfs_monom)
 
 lemma n_mult_monom:
   assumes "a \<in> carrier R"
   shows "n_mult (monom P a (Suc n)) = monom P ([Suc n]\<cdot>a) (Suc n)"
   apply(rule ext)
   unfolding n_mult_def 
   using assms cfs_monom by auto
 
 lemma pderiv_monom:
   assumes "a \<in> carrier R"
   shows "pderiv (monom P a n) = monom P ([n]\<cdot>a) (n-1)"
   apply(cases "n = 0")
    apply (simp add: assms)
   unfolding pderiv_def 
   using assms Suc_diff_1[of n] n_mult_monom[of a "n-1"] poly_shift_monom[of "[Suc (n-1)]\<cdot>a" "Suc (n-1)"]
   by (metis R.add.nat_pow_closed neq0_conv poly_shift_monom)
 
 lemma pderiv_monom':
   assumes "a \<in> carrier R"
   shows "pderiv (a \<odot>\<^bsub>P\<^esub> X[^]\<^bsub>P\<^esub>(n::nat)) = ([n]\<cdot>a)\<odot>\<^bsub>P\<^esub> X[^]\<^bsub>P\<^esub>(n-1)"  
   using assms pderiv_monom[of a n ] 
   by (simp add: P_def UP_cring.monom_rep_X_pow UP_cring_axioms)
 
 lemma n_mult_add:
   assumes "p \<in> carrier P"
   assumes "q \<in> carrier P"
   shows "n_mult (p \<oplus>\<^bsub>P\<^esub> q) = n_mult p \<oplus>\<^bsub>P\<^esub> n_mult q"
 proof(rule ext) fix x show "n_mult (p \<oplus>\<^bsub>P\<^esub> q) x = (n_mult p \<oplus>\<^bsub>P\<^esub> n_mult q) x"
   using assms R.add.nat_pow_distrib[of "p x" "q x" x]  cfs_add[of p q x] 
         cfs_add[of "n_mult p" "n_mult q" x] n_mult_closed
   unfolding n_mult_def 
   by (simp add: cfs_closed) 
 qed
 
 lemma pderiv_add:
   assumes "p \<in> carrier P"
   assumes "q \<in> carrier P"
   shows "pderiv (p \<oplus>\<^bsub>P\<^esub> q) = pderiv p \<oplus>\<^bsub>P\<^esub> pderiv q"
   unfolding pderiv_def 
   using assms poly_shift_add n_mult_add 
   by (simp add: n_mult_closed)
 
 lemma zcf_monom_sub:
   assumes "p \<in> carrier P"
   shows "zcf ((monom P \<one> (Suc n)) of  p) = zcf p [^] (Suc n)"
   apply(induction n)
   using One_nat_def P.nat_pow_eone R.nat_pow_eone R.one_closed R.zero_closed zcf_to_fun assms to_fun_closed monom_sub smult_one apply presburger
   using P_def UP_cring.ctrm_of_sub UP_cring_axioms zcf_to_fun assms to_fun_closed to_fun_monom monom_closed 
   by fastforce
 
 lemma zcf_monom_sub':
   assumes "p \<in> carrier P"
   assumes "a \<in> carrier R"
   shows "zcf ((monom P a (Suc n)) of  p) = a \<otimes> zcf p [^] (Suc n)"
   using zcf_monom_sub assms P_def R.zero_closed UP_cring.ctrm_of_sub UP_cring.to_fun_monom UP_cring_axioms
     zcf_to_fun to_fun_closed monom_closed by fastforce
   
 lemma deriv_monom:
   assumes "a \<in> carrier R"
   assumes "b \<in> carrier R"
   shows "deriv (monom P a n) b =  ([n]\<cdot>a)\<otimes>(b[^](n-1))"  
 proof(induction n)
   case 0
   have 0: "b [^] ((0::nat) - 1) \<in> carrier R"
     using assms 
     by simp
   then show ?case unfolding derivative_def using assms  
     by (smt One_nat_def P_def R.add.nat_pow_0 R.nat_pow_Suc2 R.nat_pow_eone R.zero_closed 
         taylor_def taylor_deg UP_cring.taylor_closed UP_cring.zcf_monom UP_cring.shift_one 
         UP_cring_axioms zcf_degree_zero zcf_zero_degree_zero degree_monom monom_closed 
         monom_rep_X_pow plus_1_eq_Suc poly_shift_degree_zero shift_cfs to_fun_monom to_fun_zero zero_diff)
 next
   case (Suc n)
   show ?case
   proof(cases "n = 0")
     case True
     have T0: "[Suc n] \<cdot> a \<otimes> b [^] (Suc n - 1) = a"
       by (simp add: True assms(1))
     have T1: "(X_poly R \<oplus>\<^bsub>UP R\<^esub> to_polynomial R b) [^]\<^bsub>UP R\<^esub> Suc n = X_poly R \<oplus>\<^bsub>UP R\<^esub> to_polynomial R b "
       using P.nat_pow_eone P_def True UP_a_closed X_closed assms(2) to_poly_closed by auto
     then show ?thesis 
       unfolding derivative_def taylor_expansion_def
       using T0 T1 True sub_monom(2)[of "X_plus b" a "Suc n"] cfs_add assms
       unfolding P_def X_poly_plus_def to_polynomial_def X_poly_def  
       by (smt Group.nat_pow_0 lcf_eq lcf_monom(2) ltrm_of_X_plus One_nat_def P_def R.one_closed 
           R.r_one R.r_zero UP_cring.zcf_monom UP_cring.degree_of_X_plus 
           UP_cring.poly_shift_degree_zero UP_cring_axioms X_closed X_plus_closed X_poly_def 
           X_poly_plus_def zcf_zero_degree_zero cfs_monom_mult_l degree_to_poly to_fun_X_pow 
           plus_1_eq_Suc poly_shift_cfs poly_shift_monom to_poly_closed to_poly_mult_simp(2)
           to_poly_nat_pow to_polynomial_def)
   next
     case False
   have "deriv (monom P a (Suc n)) b = ((monom P a (Suc n)) of (X_plus b)) 1"
     unfolding derivative_def taylor_expansion_def 
     by auto
   then have "deriv (monom P a (Suc n)) b = (((monom P a n) of (X_plus b)) \<otimes>\<^bsub>P\<^esub> (X_plus b)) 1"
     using  monom_mult[of a \<one> n 1] sub_mult[of "X_plus b" "monom P a n" "monom P \<one> 1" ]  X_plus_closed[of b] assms   
     by (metis lcf_monom(1) P.l_one P.nat_pow_eone P_def R.one_closed R.r_one Suc_eq_plus1 
         deg_one monom_closed monom_one sub_monom(1) to_poly_inverse)
   then have "deriv (monom P a (Suc n)) b = (((monom P a n) of (X_plus b)) \<otimes>\<^bsub>P\<^esub> (monom P \<one> 1) \<oplus>\<^bsub>P\<^esub>  
                                             (((monom P a n) of (X_plus b)) \<otimes>\<^bsub>P\<^esub> to_poly b)) 1"
     unfolding X_poly_plus_def 
     by (metis P.r_distr P_def X_closed X_plus_closed X_poly_def X_poly_plus_def assms(1) assms(2) monom_closed sub_closed to_poly_closed)
   then have "deriv (monom P a (Suc n)) b = ((monom P a n) of (X_plus b)) 0 \<oplus> b \<otimes> ((monom P a n) of (X_plus b)) 1"
     unfolding X_poly_plus_def 
     by (smt One_nat_def P.m_closed P_def UP_m_comm X_closed X_plus_closed X_poly_def X_poly_plus_def
         assms(1) assms(2) cfs_add cfs_monom_mult_l monom_closed plus_1_eq_Suc sub_closed cfs_times_X to_polynomial_def)
   then have "deriv (monom P a (Suc n)) b = ((monom P a n) of (X_plus b)) 0 \<oplus> b \<otimes> (deriv (monom P a n) b)"
     by (simp add: derivative_def taylor_expansion_def)
   then have "deriv (monom P a (Suc n)) b = ((monom P a n) of (X_plus b)) 0 \<oplus> b \<otimes> ( ([n]\<cdot>a)\<otimes>(b[^](n-1)))"
     by (simp add: Suc)
   then have 0: "deriv (monom P a (Suc n)) b = ((monom P a n) of (X_plus b)) 0 \<oplus> ([n]\<cdot>a)\<otimes>(b[^]n)"
     using assms R.m_comm[of b] R.nat_pow_mult[of b "n-1" 1] False 
     by (metis (no_types, lifting) R.add.nat_pow_closed R.m_lcomm R.nat_pow_closed R.nat_pow_eone add.commute add_eq_if plus_1_eq_Suc)
   have 1: "((monom P a n) of (X_plus b)) 0 = a \<otimes> b[^]n"
      unfolding X_poly_plus_def using zcf_monom_sub' 
      by (smt ctrm_of_sub One_nat_def P_def R.l_zero R.one_closed UP_cring.zcf_to_poly 
          UP_cring.f_minus_ctrm UP_cring_axioms X_plus_closed X_poly_def X_poly_plus_def zcf_add
          zcf_def assms(1) assms(2) to_fun_monom monom_closed monom_one_Suc2 poly_shift_id poly_shift_monom to_poly_closed)
    show ?thesis 
      using 0 1  R.add.nat_pow_Suc2 R.add.nat_pow_closed R.l_distr R.nat_pow_closed assms(1) assms(2) diff_Suc_1 by presburger
  qed
 qed
 
 lemma deriv_smult:
   assumes "a \<in> carrier R"
   assumes "b \<in> carrier R"
   assumes "g \<in> carrier P"
   shows "deriv (a \<odot>\<^bsub>P\<^esub> g) b = a \<otimes> (deriv g b)"
   unfolding derivative_def taylor_expansion_def 
   using assms sub_smult X_plus_closed cfs_smult
   by (simp add: sub_closed)
 
 lemma deriv_const:
   assumes "a \<in> carrier R"
   assumes "b \<in> carrier R"
   shows "deriv (monom P a 0) b = \<zero>"
   unfolding derivative_def 
   using assms taylor_closed taylor_def taylor_deg deg_leE by auto 
 
 lemma deriv_monom_deg_one:
   assumes "a \<in> carrier R"
   assumes "b \<in> carrier R"
   shows "deriv (monom P a 1) b = a"
   unfolding derivative_def taylor_expansion_def 
   using assms cfs_X_plus[of b 1] sub_monom_deg_one X_plus_closed[of b]
   by simp  
 
 lemma monom_Suc:
   assumes "a \<in> carrier R"
   shows "monom P a (Suc n) = monom P \<one> 1 \<otimes>\<^bsub>P\<^esub> monom P a n"
         "monom P a (Suc n) = monom P a n \<otimes>\<^bsub>P\<^esub> monom P \<one> 1"
   apply (metis R.l_one R.one_closed Suc_eq_plus1_left assms monom_mult)
   by (metis R.one_closed R.r_one Suc_eq_plus1 assms monom_mult)
 
 
 (**************************************************************************************************)
 (**************************************************************************************************)
 subsection\<open>The Product Rule\<close>
 (**************************************************************************************************)
 (**************************************************************************************************)
 
 lemma(in UP_cring) times_x_product_rule: 
   assumes "f \<in> carrier P"
   shows "pderiv (f \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) =  f \<oplus>\<^bsub>P\<^esub> pderiv f \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1"
 proof(rule poly_induct3[of f])
   show "f \<in> carrier P"
     using assms by blast 
   show "\<And>p q. q \<in> carrier P \<Longrightarrow>
            p \<in> carrier P \<Longrightarrow>
            pderiv (p \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) = p \<oplus>\<^bsub>P\<^esub> pderiv p \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1 \<Longrightarrow>
            pderiv (q \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) = q \<oplus>\<^bsub>P\<^esub> pderiv q \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1 \<Longrightarrow>
            pderiv ((p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) = p \<oplus>\<^bsub>P\<^esub> q \<oplus>\<^bsub>P\<^esub> pderiv (p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1"
   proof- fix p q assume A: "q \<in> carrier P"
            "p \<in> carrier P"
            "pderiv (p \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) = p \<oplus>\<^bsub>P\<^esub> pderiv p \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1"
            "pderiv (q \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) = q \<oplus>\<^bsub>P\<^esub> pderiv q \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1"
     have 0: "(p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1 =  (p \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) \<oplus>\<^bsub>P\<^esub> (q \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1)"
       using A assms  by (meson R.one_closed UP_l_distr is_UP_monomE(1) is_UP_monomI)
     have  1: "pderiv ((p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) = pderiv (p \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) \<oplus>\<^bsub>P\<^esub> pderiv (q \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1)"
       unfolding 0 apply(rule pderiv_add) 
       using A is_UP_monomE(1) monom_is_UP_monom(1) apply blast
       using A is_UP_monomE(1) monom_is_UP_monom(1) by blast
     have 2: "pderiv ((p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) = p \<oplus>\<^bsub>P\<^esub> pderiv p \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1 \<oplus>\<^bsub>P\<^esub> (q \<oplus>\<^bsub>P\<^esub> pderiv q \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1)"
       unfolding 1 A  by blast 
     have 3: "pderiv ((p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) = p \<oplus>\<^bsub>P\<^esub> q \<oplus>\<^bsub>P\<^esub> (pderiv p \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1 \<oplus>\<^bsub>P\<^esub> pderiv q \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1)"
       unfolding 2 
       using A P.add.m_lcomm R.one_closed UP_a_assoc UP_a_closed UP_mult_closed is_UP_monomE(1) monom_is_UP_monom(1) pderiv_closed by presburger
     have 4: "pderiv ((p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) = p \<oplus>\<^bsub>P\<^esub> q \<oplus>\<^bsub>P\<^esub> ((pderiv p \<oplus>\<^bsub>P\<^esub> pderiv q) \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1)"
       unfolding 3 using A P.l_distr R.one_closed is_UP_monomE(1) monom_is_UP_monom(1) pderiv_closed by presburger
     show 5: "pderiv ((p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) = p \<oplus>\<^bsub>P\<^esub> q \<oplus>\<^bsub>P\<^esub> pderiv (p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1"
       unfolding 4 using pderiv_add A by presburger
   qed
   show "\<And>a n. a \<in> carrier R \<Longrightarrow>
            pderiv (up_ring.monom P a n \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) = up_ring.monom P a n \<oplus>\<^bsub>P\<^esub> pderiv (up_ring.monom P a n) \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1"
   proof- fix a n assume A: "a \<in> carrier R"
     have 0: "up_ring.monom P a n \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1 = up_ring.monom P a (Suc n)"
       using A monom_Suc(2) by presburger
     have 1: "pderiv (up_ring.monom P a n \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) =  [(Suc n)] \<cdot>\<^bsub>P\<^esub> (up_ring.monom P a n)"
       unfolding 0 using A add_nat_pow_monom n_mult_monom pderiv_def poly_shift_monom 
       by (simp add: P_def)
     have 2: "pderiv (up_ring.monom P a n \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) = (up_ring.monom P a n) \<oplus>\<^bsub>P\<^esub> [n] \<cdot>\<^bsub>P\<^esub> (up_ring.monom P a n)"
       unfolding 1 using A P.add.nat_pow_Suc2 is_UP_monomE(1) monom_is_UP_monom(1) by blast
     have 3: "pderiv (up_ring.monom P a n) \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1 =  [n] \<cdot>\<^bsub>P\<^esub> (up_ring.monom P a n)"
       apply(cases "n = 0")
       using A  add_nat_pow_monom n_mult_monom pderiv_def poly_shift_monom pderiv_deg_0 apply auto[1]
       using monom_Suc(2)[of a "n-1"] A  add_nat_pow_monom n_mult_monom pderiv_def poly_shift_monom
       by (metis R.add.nat_pow_closed Suc_eq_plus1 add_eq_if monom_Suc(2) pderiv_monom)     
     show "pderiv (up_ring.monom P a n \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) = up_ring.monom P a n \<oplus>\<^bsub>P\<^esub> pderiv (up_ring.monom P a n) \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1"
       unfolding 2 3 by blast 
   qed
 qed
 
 lemma(in UP_cring) deg_one_eval:
   assumes "g \<in> carrier (UP R)"
   assumes "deg R g = 1"
   shows "\<And>t. t \<in> carrier R \<Longrightarrow> to_fun g t = g 0 \<oplus> (g 1)\<otimes>t"
 proof-
   obtain h where h_def: "h = ltrm g"
     by blast 
   have 0: "deg R (g \<ominus>\<^bsub>UP R\<^esub> h) = 0"
     using assms unfolding h_def 
     by (metis ltrm_closed ltrm_eq_imp_deg_drop ltrm_monom P_def UP_car_memE(1) less_one)
   have 1: "g \<ominus>\<^bsub>UP R\<^esub> h = to_poly (g 0)"
   proof(rule ext) fix x show "(g \<ominus>\<^bsub>UP R\<^esub> h) x = to_polynomial R (g 0) x"
     proof(cases "x = 0")
       case True
       have T0: "h 0 = \<zero>"
         unfolding h_def using assms UP_car_memE(1) cfs_monom by presburger
       have T1: "(g \<ominus>\<^bsub>UP R\<^esub> h) 0 = g 0 \<ominus> h 0"
         using ltrm_closed P_def assms(1) cfs_minus h_def by blast
       then show ?thesis using T0 assms  
         by (smt "0" ltrm_closed ltrm_deg_0 P.minus_closed P_def UP_car_memE(1) UP_zero_closed zcf_def zcf_zero deg_zero degree_to_poly h_def to_poly_closed to_poly_inverse to_poly_minus trunc_simps(2) trunc_zero)        
     next
       case False
       then have "x > 0"
         by presburger 
       then show ?thesis 
         by (metis "0" ltrm_closed P.minus_closed P_def UP_car_memE(1) UP_cring.degree_to_poly UP_cring_axioms assms(1) deg_leE h_def to_poly_closed)     
     qed
   qed
   have 2: "g = (g \<ominus>\<^bsub>UP R\<^esub> h) \<oplus>\<^bsub>UP R\<^esub> h"
     unfolding h_def using assms 
     by (metis "1" P_def h_def lin_part_def lin_part_id to_polynomial_def trms_of_deg_leq_degree_f)    
   fix t assume A: "t \<in> carrier R"
   have 3: " to_fun g t = to_fun (g \<ominus>\<^bsub>UP R\<^esub> h) t \<oplus> to_fun h t"
     using 2 
     by (metis "1" A P_def UP_car_memE(1) assms(1) h_def monom_closed to_fun_plus to_polynomial_def)
   then show "to_fun g t = g 0 \<oplus> g 1 \<otimes> t "
     unfolding 1 h_def 
     using A P_def UP_cring.lin_part_def UP_cring_axioms assms(1) assms(2) to_fun_lin_part trms_of_deg_leq_degree_f by fastforce
 qed
 
 lemma nmult_smult:
   assumes "a \<in> carrier R"
   assumes "f \<in> carrier P"
   shows "n_mult (a \<odot>\<^bsub>P\<^esub> f) = a \<odot>\<^bsub>P\<^esub> (n_mult f)"
   apply(rule poly_induct4[of f])
   apply (simp add: assms(2))
   using assms(1) n_mult_add n_mult_closed smult_closed smult_r_distr apply presburger
   using assms  apply(intro ext, metis (no_types, lifting) ctrm_smult ltrm_deg_0 P_def R.add.nat_pow_0 UP_cring.ctrm_degree UP_cring.n_mult_closed UP_cring.n_mult_def UP_cring_axioms UP_smult_closed UP_zero_closed zcf_degree_zero zcf_zero deg_const deg_zero le_0_eq monom_closed n_mult_degree_bound smult_r_null)
   using monom_mult_smult n_mult_monom assms 
   by (smt lcf_monom(1) P_def R.add.nat_pow_closed R.add_pow_rdistr R.zero_closed UP_cring.to_poly_mult_simp(1) UP_cring_axioms UP_smult_closed cfs_closed cring_lcf_mult monom_closed to_polynomial_def)
 
 lemma pderiv_smult:
   assumes "a \<in> carrier R"
   assumes "f \<in> carrier P"
   shows "pderiv (a \<odot>\<^bsub>P\<^esub> f) = a \<odot>\<^bsub>P\<^esub> (pderiv f)"
   unfolding pderiv_def
   using assms
   by (simp add: n_mult_closed nmult_smult poly_shift_s_mult) 
 
 lemma(in UP_cring) pderiv_minus:
   assumes "a \<in> carrier P"
   assumes "b \<in> carrier P"
   shows "pderiv (a \<ominus>\<^bsub>P\<^esub> b) = pderiv a \<ominus>\<^bsub>P\<^esub> pderiv b"
 proof-
   have "\<ominus>\<^bsub>P\<^esub> b = (\<ominus>\<one>)\<odot>\<^bsub>P\<^esub>b"
     using R.one_closed UP_smult_one assms(2) smult_l_minus by presburger
   thus ?thesis unfolding a_minus_def using pderiv_add assms pderiv_smult
     by (metis P.add.inv_closed R.add.inv_closed R.one_closed UP_smult_one pderiv_closed smult_l_minus)
 qed
 
 lemma(in UP_cring) pderiv_const:
   assumes "b \<in> carrier R"
   shows "pderiv (up_ring.monom P b 0) = \<zero>\<^bsub>P\<^esub>"
   using assms pderiv_monom[of b 0] deg_const is_UP_monomE(1) monom_is_UP_monom(1) pderiv_deg_0 
   by blast
    
 lemma(in UP_cring) pderiv_minus_const:
   assumes "a \<in> carrier P"
   assumes "b \<in> carrier R"
   shows "pderiv (a \<ominus>\<^bsub>P\<^esub> up_ring.monom P b 0) = pderiv a"
   using pderiv_minus[of a "up_ring.monom P b 0" ] assms pderiv_const[of b] 
   by (smt P.l_zero P.minus_closed P_def UP_cring.pderiv_const UP_cring.pderiv_minus UP_cring.poly_shift_eq UP_cring_axioms cfs_closed monom_closed pderiv_add pderiv_closed poly_shift_id)
 
 lemma(in UP_cring) monom_product_rule: 
   assumes "f \<in> carrier P"
   assumes "a \<in> carrier R" 
   shows "pderiv (f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a n) =  f \<otimes>\<^bsub>P\<^esub> pderiv (up_ring.monom P a n) \<oplus>\<^bsub>P\<^esub> pderiv f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a n"
 proof-
   have "\<forall>f. f \<in> carrier P \<longrightarrow> pderiv (f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a n) =  f \<otimes>\<^bsub>P\<^esub> pderiv (up_ring.monom P a n) \<oplus>\<^bsub>P\<^esub> pderiv f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a n"
   proof(induction n)
     case 0
     show ?case 
     proof fix f show "f \<in> carrier P \<longrightarrow> pderiv (f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a 0) = f \<otimes>\<^bsub>P\<^esub> pderiv (up_ring.monom P a 0) \<oplus>\<^bsub>P\<^esub> pderiv f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a 0 "
       proof assume A: "f \<in> carrier P"
         have 0: "f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a 0 = a \<odot>\<^bsub>P\<^esub>f"
           using assms A  UP_m_comm is_UP_monomE(1) monom_is_UP_monom(1) monom_mult_is_smult by presburger
         have 1: "f \<otimes>\<^bsub>P\<^esub> pderiv (up_ring.monom P a 0) = \<zero>\<^bsub>P\<^esub>"
           using A assms P.r_null pderiv_const by presburger
         have 2: "pderiv f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a 0 = a \<odot>\<^bsub>P\<^esub> pderiv f"
           using assms A  UP_m_comm is_UP_monomE(1) monom_is_UP_monom(1) monom_mult_is_smult  pderiv_closed by presburger
         show "pderiv (f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a 0) = f \<otimes>\<^bsub>P\<^esub> pderiv (up_ring.monom P a 0) \<oplus>\<^bsub>P\<^esub> pderiv f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a 0"
           unfolding 0 1 2 using A UP_l_zero UP_smult_closed assms(2) pderiv_closed pderiv_smult by presburger
       qed
     qed
   next
     case (Suc n)
     show "\<forall>f. f \<in> carrier P \<longrightarrow>
              pderiv (f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a (Suc n)) = f \<otimes>\<^bsub>P\<^esub> pderiv (up_ring.monom P a (Suc n)) \<oplus>\<^bsub>P\<^esub> pderiv f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a (Suc n)"
     proof fix f
       show "f \<in> carrier P \<longrightarrow>
          pderiv (f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a (Suc n)) = f \<otimes>\<^bsub>P\<^esub> pderiv (up_ring.monom P a (Suc n)) \<oplus>\<^bsub>P\<^esub> pderiv f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a (Suc n)"
       proof
        assume A: "f \<in> carrier P"
       show " pderiv (f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a (Suc n)) = f \<otimes>\<^bsub>P\<^esub> pderiv (up_ring.monom P a (Suc n)) \<oplus>\<^bsub>P\<^esub> pderiv f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a (Suc n)"
       proof(cases "n = 0")
         case True
         have 0: "(f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a (Suc n)) = a \<odot>\<^bsub>P\<^esub> f \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1"
         proof -
           have "\<forall>n. up_ring.monom P a n \<in> carrier P"
             using assms(2) is_UP_monomE(1) monom_is_UP_monom(1) by presburger
           then show ?thesis
             by (metis A P.m_assoc P.m_comm R.one_closed True assms(2) is_UP_monomE(1) monom_Suc(2) monom_is_UP_monom(1) monom_mult_is_smult)
         qed
         have 1: "f \<otimes>\<^bsub>P\<^esub> pderiv (up_ring.monom P a (Suc n)) = a \<odot>\<^bsub>P\<^esub> f"
           using assms True 
           by (metis A One_nat_def P.m_comm R.add.nat_pow_eone diff_Suc_1 is_UP_monomE(1) is_UP_monomI monom_mult_is_smult pderiv_monom)
         have 2: "pderiv f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a (Suc n) = a \<odot>\<^bsub>P\<^esub> (pderiv f \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1)"
           using A assms unfolding True 
           by (metis P.m_lcomm R.one_closed UP_mult_closed is_UP_monomE(1) monom_Suc(2) monom_is_UP_monom(1) monom_mult_is_smult pderiv_closed)
         have 3: "a \<odot>\<^bsub>P\<^esub> f \<oplus>\<^bsub>P\<^esub> a \<odot>\<^bsub>P\<^esub> (pderiv f \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) = a \<odot>\<^bsub>P\<^esub> (f \<oplus>\<^bsub>P\<^esub>(pderiv f \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1))"
           using assms A  P.m_closed R.one_closed is_UP_monomE(1) monom_is_UP_monom(1) pderiv_closed smult_r_distr by presburger
         show ?thesis
           unfolding 0 1 2 3 
           using A times_x_product_rule P.m_closed R.one_closed UP_smult_assoc2 assms(2) is_UP_monomE(1) monom_is_UP_monom(1) pderiv_smult by presburger
       next
         case False
       have IH: "pderiv ((f \<otimes>\<^bsub>P\<^esub>up_ring.monom P \<one> 1) \<otimes>\<^bsub>P\<^esub> up_ring.monom P a n) = (f \<otimes>\<^bsub>P\<^esub>up_ring.monom P \<one> 1) \<otimes>\<^bsub>P\<^esub> pderiv (up_ring.monom P a n) \<oplus>\<^bsub>P\<^esub> pderiv (f \<otimes>\<^bsub>P\<^esub>up_ring.monom P \<one> 1) \<otimes>\<^bsub>P\<^esub> up_ring.monom P a n"
         using Suc A P.m_closed R.one_closed is_UP_monomE(1) is_UP_monomI by presburger
       have 0: "f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a (Suc n) = (f \<otimes>\<^bsub>P\<^esub>up_ring.monom P \<one> 1)  \<otimes>\<^bsub>P\<^esub> up_ring.monom P a n"
         using A R.one_closed UP_m_assoc assms(2) is_UP_monomE(1) monom_Suc(1) monom_is_UP_monom(1) by presburger
       have 1: "(f \<otimes>\<^bsub>P\<^esub>up_ring.monom P \<one> 1) \<otimes>\<^bsub>P\<^esub> pderiv (up_ring.monom P a n) \<oplus>\<^bsub>P\<^esub> pderiv (f \<otimes>\<^bsub>P\<^esub>up_ring.monom P \<one> 1) \<otimes>\<^bsub>P\<^esub> up_ring.monom P a n = 
                (f \<otimes>\<^bsub>P\<^esub>up_ring.monom P \<one> 1) \<otimes>\<^bsub>P\<^esub> pderiv (up_ring.monom P a n) \<oplus>\<^bsub>P\<^esub> (f \<oplus>\<^bsub>P\<^esub> pderiv f \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) \<otimes>\<^bsub>P\<^esub> up_ring.monom P a n "
         using A times_x_product_rule by presburger
       have 2: "(f \<otimes>\<^bsub>P\<^esub>up_ring.monom P \<one> 1) \<otimes>\<^bsub>P\<^esub> pderiv (up_ring.monom P a n) =(f \<otimes>\<^bsub>P\<^esub>up_ring.monom P ([n]\<cdot>a) n)"
       proof-
         have 20: "up_ring.monom P ([n] \<cdot> a) (n) = up_ring.monom P \<one> 1 \<otimes>\<^bsub>P\<^esub> up_ring.monom P ([n] \<cdot> a) (n - 1)"
           using A assms False monom_mult[of \<one> "[n]\<cdot>a" 1 "n-1"] 
           by (metis R.add.nat_pow_closed R.l_one R.one_closed Suc_eq_plus1 add.commute add_eq_if )          
         show ?thesis unfolding 20 using assms A False   pderiv_monom[of a n] 
           using P.m_assoc R.one_closed is_UP_monomE(1) monom_is_UP_monom(1) by simp
       qed
       have 3: "(f \<otimes>\<^bsub>P\<^esub>up_ring.monom P ([n]\<cdot>a) n) = [n]\<cdot>\<^bsub>P\<^esub>(f \<otimes>\<^bsub>P\<^esub>up_ring.monom P a n)"
         using A assms by (metis P.add_pow_rdistr add_nat_pow_monom is_UP_monomE(1) monom_is_UP_monom(1))
       have 4: "pderiv (f \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) =  (f \<oplus>\<^bsub>P\<^esub> pderiv f \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1)"
         using times_x_product_rule  A by blast
       have 5: " (f \<oplus>\<^bsub>P\<^esub> pderiv f \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) \<otimes>\<^bsub>P\<^esub> up_ring.monom P a n  = 
  (f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a n ) \<oplus>\<^bsub>P\<^esub> (pderiv f \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1 \<otimes>\<^bsub>P\<^esub> up_ring.monom P a n )"
         using A assms  by (meson P.l_distr P.m_closed R.one_closed is_UP_monomE(1) is_UP_monomI pderiv_closed)
       have 6: " (f \<oplus>\<^bsub>P\<^esub> pderiv f \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1) \<otimes>\<^bsub>P\<^esub> up_ring.monom P a n  = 
  (f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a n ) \<oplus>\<^bsub>P\<^esub> (pderiv f \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1 \<otimes>\<^bsub>P\<^esub> up_ring.monom P a n )"
         using A assms False 5  by blast
       have 7: "(f \<otimes>\<^bsub>P\<^esub>up_ring.monom P \<one> 1) \<otimes>\<^bsub>P\<^esub> pderiv (up_ring.monom P a n) \<oplus>\<^bsub>P\<^esub> pderiv (f \<otimes>\<^bsub>P\<^esub>up_ring.monom P \<one> 1) \<otimes>\<^bsub>P\<^esub> up_ring.monom P a n =
                [(Suc n)] \<cdot>\<^bsub>P\<^esub> (f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a n) \<oplus>\<^bsub>P\<^esub> pderiv f \<otimes>\<^bsub>P\<^esub> up_ring.monom P \<one> 1 \<otimes>\<^bsub>P\<^esub> up_ring.monom P a n"
         unfolding 2 3  5 6 using assms A P.a_assoc 
         by (smt "1" "2" "3" "6" P.add.nat_pow_Suc P.m_closed R.one_closed is_UP_monomE(1) monom_is_UP_monom(1) pderiv_closed)
       have 8: "pderiv (f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a (Suc n)) = pderiv ((f \<otimes>\<^bsub>P\<^esub>up_ring.monom P \<one> 1) \<otimes>\<^bsub>P\<^esub> up_ring.monom P a n)"
         using A assms 0  by presburger
       show " pderiv (f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a (Suc n)) = f \<otimes>\<^bsub>P\<^esub> pderiv (up_ring.monom P a (Suc n)) \<oplus>\<^bsub>P\<^esub> pderiv f \<otimes>\<^bsub>P\<^esub> up_ring.monom P a (Suc n)"
         unfolding 8 IH 0 1 2 3 4 5 6 
         by (smt "2" "4" "6" "7" A P.add_pow_rdistr R.one_closed UP_m_assoc add_nat_pow_monom assms(2) diff_Suc_1 is_UP_monomE(1) is_UP_monomI monom_Suc(1) pderiv_closed pderiv_monom)        
        qed
      qed
    qed
  qed
   thus ?thesis using assms by blast 
 qed
 
 lemma(in UP_cring) product_rule: 
   assumes "f \<in> carrier (UP R)"
   assumes "g \<in> carrier (UP R)"
   shows "pderiv (f \<otimes>\<^bsub>UP R\<^esub>g) = (pderiv f \<otimes>\<^bsub>UP R\<^esub> g) \<oplus>\<^bsub>UP R\<^esub> (f \<otimes>\<^bsub>UP R\<^esub> pderiv g)"
 proof(rule poly_induct3[of f])
   show "f \<in> carrier P"
     using assms unfolding P_def by blast 
   show "\<And>p q. q \<in> carrier P \<Longrightarrow>
            p \<in> carrier P \<Longrightarrow>
            pderiv (p \<otimes>\<^bsub>UP R\<^esub> g) = pderiv p \<otimes>\<^bsub>UP R\<^esub> g \<oplus>\<^bsub>UP R\<^esub> p \<otimes>\<^bsub>UP R\<^esub> pderiv g \<Longrightarrow>
            pderiv (q \<otimes>\<^bsub>UP R\<^esub> g) = pderiv q \<otimes>\<^bsub>UP R\<^esub> g \<oplus>\<^bsub>UP R\<^esub> q \<otimes>\<^bsub>UP R\<^esub> pderiv g \<Longrightarrow>
            pderiv ((p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>UP R\<^esub> g) = pderiv (p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>UP R\<^esub> g \<oplus>\<^bsub>UP R\<^esub> (p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>UP R\<^esub> pderiv g"
   proof- fix p q 
     assume A: "q \<in> carrier P" "p \<in> carrier P"
            "pderiv (p \<otimes>\<^bsub>UP R\<^esub> g) = pderiv p \<otimes>\<^bsub>UP R\<^esub> g \<oplus>\<^bsub>UP R\<^esub> p \<otimes>\<^bsub>UP R\<^esub> pderiv g"
            "pderiv (q \<otimes>\<^bsub>UP R\<^esub> g) = pderiv q \<otimes>\<^bsub>UP R\<^esub> g \<oplus>\<^bsub>UP R\<^esub> q \<otimes>\<^bsub>UP R\<^esub> pderiv g"
     have 0: "(p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>UP R\<^esub> g = p \<otimes>\<^bsub>UP R\<^esub> g \<oplus>\<^bsub>UP R\<^esub> q \<otimes>\<^bsub>UP R\<^esub> g"
       using A assms unfolding P_def using P_def UP_l_distr by blast
     have 1: "pderiv ((p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>UP R\<^esub> g) = pderiv (p \<otimes>\<^bsub>UP R\<^esub> g) \<oplus>\<^bsub>UP R\<^esub> pderiv (q \<otimes>\<^bsub>UP R\<^esub> g)"
       unfolding 0  using pderiv_add[of "p \<otimes>\<^bsub>P\<^esub> g" "q \<otimes>\<^bsub>P\<^esub> g"] unfolding P_def 
       using A(1) A(2) P_def UP_mult_closed assms(2) by blast
     have 2: "pderiv ((p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>UP R\<^esub> g) = pderiv p \<otimes>\<^bsub>UP R\<^esub> g \<oplus>\<^bsub>UP R\<^esub> p \<otimes>\<^bsub>UP R\<^esub> pderiv g \<oplus>\<^bsub>UP R\<^esub> (pderiv q \<otimes>\<^bsub>UP R\<^esub> g \<oplus>\<^bsub>UP R\<^esub> q \<otimes>\<^bsub>UP R\<^esub> pderiv g)"
       unfolding 1 A by blast 
     have 3: "pderiv ((p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>UP R\<^esub> g) = pderiv p \<otimes>\<^bsub>UP R\<^esub> g \<oplus>\<^bsub>UP R\<^esub> pderiv q \<otimes>\<^bsub>UP R\<^esub> g  \<oplus>\<^bsub>UP R\<^esub> p \<otimes>\<^bsub>UP R\<^esub> pderiv g  \<oplus>\<^bsub>UP R\<^esub> q \<otimes>\<^bsub>UP R\<^esub> pderiv g"
       using A assms 
       by (smt "2" P.add.m_lcomm P.m_closed P_def UP_a_assoc pderiv_closed)
     have 4: "pderiv ((p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>UP R\<^esub> g) = (pderiv p \<otimes>\<^bsub>UP R\<^esub> g \<oplus>\<^bsub>UP R\<^esub> pderiv q \<otimes>\<^bsub>UP R\<^esub> g)  \<oplus>\<^bsub>UP R\<^esub> (p \<otimes>\<^bsub>UP R\<^esub> pderiv g  \<oplus>\<^bsub>UP R\<^esub> q \<otimes>\<^bsub>UP R\<^esub> pderiv g)"
       unfolding 3 using A assms P_def UP_a_assoc UP_a_closed UP_mult_closed pderiv_closed by auto
     have 5: "pderiv ((p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>UP R\<^esub> g) = ((pderiv p  \<oplus>\<^bsub>UP R\<^esub> pderiv q) \<otimes>\<^bsub>UP R\<^esub> g)  \<oplus>\<^bsub>UP R\<^esub> ((p \<oplus>\<^bsub>UP R\<^esub> q)  \<otimes>\<^bsub>UP R\<^esub> pderiv g)"
       unfolding 4 using A assms  by (metis P.l_distr P_def pderiv_closed)
     have 6: "pderiv ((p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>UP R\<^esub> g) = ((pderiv (p \<oplus>\<^bsub>P\<^esub> q)) \<otimes>\<^bsub>UP R\<^esub> g)  \<oplus>\<^bsub>UP R\<^esub> ((p \<oplus>\<^bsub>UP R\<^esub> q)  \<otimes>\<^bsub>UP R\<^esub> pderiv g)"
       unfolding 5 using A assms  
       by (metis P_def pderiv_add)
     show "pderiv ((p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>UP R\<^esub> g) = pderiv (p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>UP R\<^esub> g \<oplus>\<^bsub>UP R\<^esub> (p \<oplus>\<^bsub>P\<^esub> q) \<otimes>\<^bsub>UP R\<^esub> pderiv g"
       unfolding 6 using A assms P_def by blast     
   qed
   show "\<And>a n. a \<in> carrier R \<Longrightarrow>
            pderiv (up_ring.monom P a n \<otimes>\<^bsub>UP R\<^esub> g) = pderiv (up_ring.monom P a n) \<otimes>\<^bsub>UP R\<^esub> g \<oplus>\<^bsub>UP R\<^esub> up_ring.monom P a n \<otimes>\<^bsub>UP R\<^esub> pderiv g"
     using P_def UP_m_comm assms(2) is_UP_monomE(1) monom_is_UP_monom(1) monom_product_rule pderiv_closed by presburger
 qed
 
 (**************************************************************************************************)
 (**************************************************************************************************)
 subsection\<open>The Chain Rule\<close>
 (**************************************************************************************************)
 (**************************************************************************************************)
 
 lemma(in UP_cring) chain_rule: 
   assumes "f \<in> carrier P"
   assumes "g \<in> carrier P"
   shows "pderiv (compose R f g) = compose R (pderiv f) g \<otimes>\<^bsub>UP R\<^esub> pderiv g"
 proof(rule poly_induct3[of f])
   show "f \<in> carrier P"
     using assms by blast
   show "\<And>p q. q \<in> carrier P \<Longrightarrow>
            p \<in> carrier P \<Longrightarrow>
            pderiv (Cring_Poly.compose R p g) = Cring_Poly.compose R (pderiv p) g \<otimes>\<^bsub>UP R\<^esub> pderiv g \<Longrightarrow>
            pderiv (Cring_Poly.compose R q g) = Cring_Poly.compose R (pderiv q) g \<otimes>\<^bsub>UP R\<^esub> pderiv g \<Longrightarrow>
            pderiv (Cring_Poly.compose R (p \<oplus>\<^bsub>P\<^esub> q) g) = Cring_Poly.compose R (pderiv (p \<oplus>\<^bsub>P\<^esub> q)) g \<otimes>\<^bsub>UP R\<^esub> pderiv g"
   using pderiv_add sub_add 
   by (smt P_def UP_a_closed UP_m_comm UP_r_distr assms(2) pderiv_closed sub_closed)
   show "\<And>a n. a \<in> carrier R \<Longrightarrow>
            pderiv (compose R (up_ring.monom P a n) g) = compose R (pderiv (up_ring.monom P a n)) g \<otimes>\<^bsub>UP R\<^esub> pderiv g"
   proof-
     fix a n assume A: "a \<in> carrier R"
     show "pderiv (compose R (up_ring.monom P a n) g) = compose R (pderiv (up_ring.monom P a n)) g \<otimes>\<^bsub>UP R\<^esub> pderiv g"
     proof(induction n)
       case 0
       have 00: "(compose R (up_ring.monom P a 0) g) = (up_ring.monom P a 0)"
         using A P_def assms(2) deg_const is_UP_monom_def monom_is_UP_monom(1) sub_const by presburger
       have 01: "pderiv (up_ring.monom P a 0) = \<zero>\<^bsub>P\<^esub>"
         using A pderiv_const by blast
       show ?case unfolding 00 01 
         by (metis P.l_null P_def UP_zero_closed assms(2) deg_zero pderiv_closed sub_const)
     next
       case (Suc n)
       show "pderiv (Cring_Poly.compose R (up_ring.monom P a (Suc n)) g) = Cring_Poly.compose R (pderiv (up_ring.monom P a (Suc n))) g \<otimes>\<^bsub>UP R\<^esub> pderiv g"
       proof(cases "n = 0")
         case True
         have 0: "compose R (up_ring.monom P a (Suc n)) g = a \<odot>\<^bsub>P\<^esub> g"
           using A assms sub_monom_deg_one[of g a] unfolding True using One_nat_def 
           by presburger
         have 1: "(pderiv (up_ring.monom P a (Suc n))) = up_ring.monom P a 0"
           unfolding True 
         proof -
           have "pderiv (up_ring.monom P a 0) = \<zero>\<^bsub>P\<^esub>"
             using A pderiv_const by blast
           then show "pderiv (up_ring.monom P a (Suc 0)) = up_ring.monom P a 0"
             using A lcf_monom(1) P_def  X_closed deg_const deg_nzero_nzero  is_UP_monomE(1) monom_Suc(2) monom_is_UP_monom(1) monom_rep_X_pow pderiv_monom poly_shift_degree_zero poly_shift_eq sub_monom(2) sub_monom_deg_one to_poly_inverse to_poly_mult_simp(2)
             by (metis (no_types, lifting) P.l_null P.r_zero X_poly_def times_x_product_rule)
         qed
         then show ?thesis unfolding 0 1 
           using A P_def assms(2) deg_const is_UP_monomE(1) monom_is_UP_monom(1) monom_mult_is_smult pderiv_closed pderiv_smult sub_const 
           by presburger
       next
         case False
       have 0: "compose R (up_ring.monom P a (Suc n)) g = (compose R (up_ring.monom P a n) g) \<otimes>\<^bsub>P\<^esub> (compose R (up_ring.monom P \<one> 1) g)"
         using assms A by (metis R.one_closed monom_Suc(2) monom_closed sub_mult)
       have 1: "compose R (up_ring.monom P a (Suc n)) g = (compose R (up_ring.monom P a n) g) \<otimes>\<^bsub>P\<^esub> g"
         unfolding 0 using A assms 
         by (metis P_def R.one_closed UP_cring.lcf_monom(1) UP_cring.to_poly_inverse UP_cring_axioms UP_l_one UP_one_closed deg_one monom_one sub_monom_deg_one to_poly_mult_simp(1))
       have 2: "pderiv (compose R (up_ring.monom P a (Suc n)) g ) =
                     ((pderiv (compose R (up_ring.monom P a n) g)) \<otimes>\<^bsub>P\<^esub> g) \<oplus>\<^bsub>P\<^esub> ((compose R (up_ring.monom P a n) g) \<otimes>\<^bsub>P\<^esub> pderiv g)"
         unfolding 1 unfolding P_def apply(rule product_rule)
         using A assms unfolding P_def using P_def is_UP_monomE(1) is_UP_monomI rev_sub_closed sub_rev_sub apply presburger
         using assms unfolding P_def  by blast 
       have 3: "pderiv (compose R (up_ring.monom P a (Suc n)) g ) = 
                     (compose R (pderiv (up_ring.monom P a n)) g \<otimes>\<^bsub>UP R\<^esub> pderiv g \<otimes>\<^bsub>P\<^esub> g) \<oplus>\<^bsub>P\<^esub> ((compose R (up_ring.monom P a n) g) \<otimes>\<^bsub>P\<^esub> pderiv g)"
         unfolding 2 Suc by blast 
       have 4: "pderiv (compose R (up_ring.monom P a (Suc n)) g ) = 
                     ((compose R (pderiv (up_ring.monom P a n)) g  \<otimes>\<^bsub>P\<^esub> g) \<otimes>\<^bsub>UP R\<^esub> pderiv g) \<oplus>\<^bsub>P\<^esub> ((compose R (up_ring.monom P a n) g) \<otimes>\<^bsub>P\<^esub> pderiv g)"
         unfolding 3 using A assms m_assoc m_comm 
         by (smt P_def monom_closed monom_rep_X_pow pderiv_closed sub_closed)
       have 5: "pderiv (compose R (up_ring.monom P a (Suc n)) g ) = 
                     ((compose R (pderiv (up_ring.monom P a n)) g  \<otimes>\<^bsub>P\<^esub> g) \<oplus>\<^bsub>P\<^esub> (compose R (up_ring.monom P a n) g)) \<otimes>\<^bsub>P\<^esub> pderiv g"
         unfolding 4 using A assms 
         by (metis P.l_distr P.m_closed P_def UP_cring.pderiv_closed UP_cring_axioms monom_closed sub_closed)
       have 6: "compose R (pderiv (up_ring.monom P a n)) g  \<otimes>\<^bsub>P\<^esub> g = [n]\<cdot>\<^bsub>P\<^esub>compose R ((up_ring.monom P a n)) g"
       proof-
         have 60: "(pderiv (up_ring.monom P a n)) = (up_ring.monom P ([n]\<cdot>a) (n-1))" 
           using A assms pderiv_monom by blast
         have 61: "compose R (pderiv (up_ring.monom P a n)) g \<otimes>\<^bsub>P\<^esub> g  = compose R ((up_ring.monom P ([n]\<cdot>a) (n-1))) g \<otimes>\<^bsub>P\<^esub> (compose R (up_ring.monom P \<one> 1) g)"
           unfolding 60 using A assms sub_monom_deg_one[of g \<one> ] R.one_closed smult_one by presburger
         have 62: "compose R (pderiv (up_ring.monom P a n)) g  \<otimes>\<^bsub>P\<^esub> g = compose R (up_ring.monom P ([n]\<cdot>a) n) g"
           unfolding 61 using False A assms sub_mult[of g "up_ring.monom P ([n] \<cdot> a) (n - 1)" "up_ring.monom P \<one> 1" ] monom_mult[of "[n]\<cdot>a" \<one> "n-1" 1] 
           by (metis Nat.add_0_right R.add.nat_pow_closed R.one_closed R.r_one Suc_eq_plus1 add_eq_if monom_closed)
         have 63: "\<And>k::nat. Cring_Poly.compose R (up_ring.monom P ([k] \<cdot> a) n) g = [k] \<cdot>\<^bsub>P\<^esub>Cring_Poly.compose R (up_ring.monom P a n) g"
         proof- fix k::nat show "Cring_Poly.compose R (up_ring.monom P ([k] \<cdot> a) n) g = [k] \<cdot>\<^bsub>P\<^esub>Cring_Poly.compose R (up_ring.monom P a n) g"
             apply(induction k)
             using  UP_zero_closed assms(2) deg_zero monom_zero sub_const 
              apply (metis A P.add.nat_pow_0 add_nat_pow_monom)
           proof- 
             fix k::nat
             assume a: "Cring_Poly.compose R (monom P ([k] \<cdot> a) n) g =
          [k] \<cdot>\<^bsub>P\<^esub> Cring_Poly.compose R (monom P a n) g"
             have 0: "(monom P ([Suc k] \<cdot> a) n) = [Suc k] \<cdot> a \<odot>\<^bsub>P\<^esub>(monom P \<one> n)"
               by (simp add: A monic_monom_smult)
             have 1: "(monom P ([Suc k] \<cdot> a) n) = [k] \<cdot> a \<odot>\<^bsub>P\<^esub>(monom P \<one> n) \<oplus>\<^bsub>P\<^esub>a \<odot>\<^bsub>P\<^esub>(monom P \<one> n) "
               unfolding 0 
               by (simp add: A UP_smult_l_distr)
             show "Cring_Poly.compose R (monom P ([Suc k] \<cdot> a) n) g =
          [Suc k] \<cdot>\<^bsub>P\<^esub> (Cring_Poly.compose R (monom P a n) g) "
               unfolding 1 
               by (simp add: A a assms(2) monic_monom_smult sub_add)
           qed
         qed
         have 64: "Cring_Poly.compose R (up_ring.monom P ([n] \<cdot> a) n) g = [n] \<cdot>\<^bsub>P\<^esub>Cring_Poly.compose R (up_ring.monom P a n) g"
           using 63 by blast 
         show ?thesis unfolding 62 64 by blast 
       qed
       have 63: "\<And>k::nat. Cring_Poly.compose R (up_ring.monom P ([k] \<cdot> a) n) g = [k] \<cdot>\<^bsub>P\<^esub>Cring_Poly.compose R (up_ring.monom P a n) g"
       proof- fix k::nat show "Cring_Poly.compose R (up_ring.monom P ([k] \<cdot> a) n) g = [k] \<cdot>\<^bsub>P\<^esub>Cring_Poly.compose R (up_ring.monom P a n) g"
             apply(induction k)
             using UP_zero_closed assms(2) deg_zero monom_zero sub_const 
             apply (metis A P.add.nat_pow_0 add_nat_pow_monom)           
             using A P.add.nat_pow_Suc add_nat_pow_monom assms(2) is_UP_monomE(1) monom_is_UP_monom(1) rev_sub_add sub_rev_sub
             by (metis P.add.nat_pow_closed)            
       qed
       have 7: "([n] \<cdot>\<^bsub>P\<^esub> Cring_Poly.compose R (up_ring.monom P a n) g \<oplus>\<^bsub>P\<^esub> Cring_Poly.compose R (up_ring.monom P a n) g) = 
                                 [Suc n] \<cdot>\<^bsub>P\<^esub> (Cring_Poly.compose R (up_ring.monom P a n) g)"
         using A assms P.add.nat_pow_Suc by presburger
       have 8: "[Suc n] \<cdot>\<^bsub>P\<^esub> Cring_Poly.compose R (up_ring.monom P a n) g \<otimes>\<^bsub>P\<^esub> pderiv g = Cring_Poly.compose R (up_ring.monom P ([Suc n] \<cdot> a) n) g \<otimes>\<^bsub>P\<^esub> pderiv g"
         unfolding  63[of "Suc n"] by blast 
       show ?thesis unfolding 5 6 7 8 using A assms pderiv_monom[of  "a" "Suc n"] 
         using P_def diff_Suc_1 by metis  
     qed
   qed
   qed
 qed
 
 lemma deriv_prod_rule_times_monom:
   assumes "a \<in> carrier R"
   assumes "b \<in> carrier R"
   assumes "q \<in> carrier P"
   shows "deriv ((monom P a n) \<otimes>\<^bsub>P\<^esub> q) b = (deriv (monom P a n) b) \<otimes> (to_fun q b) \<oplus> (to_fun (monom P a n) b) \<otimes> deriv q b"
 proof(rule poly_induct3[of q])
   show "q \<in> carrier P"
     using assms by simp 
   show " \<And>p q. q \<in> carrier P \<Longrightarrow>
            p \<in> carrier P \<Longrightarrow>
            deriv (monom P a n \<otimes>\<^bsub>P\<^esub> p) b = deriv (monom P a n) b \<otimes> to_fun p b \<oplus> to_fun (monom P a n) b \<otimes> deriv p b \<Longrightarrow>
            deriv (monom P a n \<otimes>\<^bsub>P\<^esub> q) b = deriv (monom P a n) b \<otimes> to_fun q b \<oplus> to_fun (monom P a n) b \<otimes> deriv q b \<Longrightarrow>
            deriv (monom P a n \<otimes>\<^bsub>P\<^esub> (p \<oplus>\<^bsub>P\<^esub> q)) b = deriv (monom P a n) b \<otimes> to_fun (p \<oplus>\<^bsub>P\<^esub> q) b \<oplus> to_fun (monom P a n) b \<otimes> deriv (p \<oplus>\<^bsub>P\<^esub> q) b"
   proof- fix p q assume A: "q \<in> carrier P" " p \<in> carrier P"
           "deriv (monom P a n \<otimes>\<^bsub>P\<^esub> p) b = deriv (monom P a n) b \<otimes> to_fun p b \<oplus> to_fun (monom P a n) b \<otimes> deriv p b"
           "deriv (monom P a n \<otimes>\<^bsub>P\<^esub> q) b = deriv (monom P a n) b \<otimes> to_fun q b \<oplus> to_fun (monom P a n) b \<otimes> deriv q b"
     have "deriv (monom P a n \<otimes>\<^bsub>P\<^esub> (p \<oplus>\<^bsub>P\<^esub> q)) b =  deriv (monom P a n) b \<otimes> to_fun p b \<oplus> to_fun (monom P a n) b \<otimes> deriv p b
                                                   \<oplus>deriv (monom P a n) b \<otimes> to_fun q b \<oplus> to_fun (monom P a n) b \<otimes> deriv q b"
       using A assms 
       by (simp add: P.r_distr R.add.m_assoc deriv_add deriv_closed to_fun_closed)    
     hence "deriv (monom P a n \<otimes>\<^bsub>P\<^esub> (p \<oplus>\<^bsub>P\<^esub> q)) b =  deriv (monom P a n) b \<otimes> to_fun p b \<oplus>deriv (monom P a n) b \<otimes> to_fun q b 
               \<oplus> to_fun (monom P a n) b \<otimes> deriv p b  \<oplus> to_fun (monom P a n) b \<otimes> deriv q b"
       using A(1) A(2) R.add.m_assoc R.add.m_comm assms(1) assms(2) deriv_closed to_fun_closed by auto
     hence "deriv (monom P a n \<otimes>\<^bsub>P\<^esub> (p \<oplus>\<^bsub>P\<^esub> q)) b =  deriv (monom P a n) b \<otimes> (to_fun p b \<oplus>  to_fun q b)
               \<oplus> to_fun (monom P a n) b \<otimes> (deriv p b  \<oplus> deriv q b)"
       by (simp add: A(1) A(2) R.add.m_assoc R.r_distr assms(1) assms(2) deriv_closed to_fun_closed)
     thus "deriv (monom P a n \<otimes>\<^bsub>P\<^esub> (p \<oplus>\<^bsub>P\<^esub> q)) b = deriv (monom P a n) b \<otimes> to_fun (p \<oplus>\<^bsub>P\<^esub> q) b \<oplus> to_fun (monom P a n) b \<otimes> deriv (p \<oplus>\<^bsub>P\<^esub> q) b"
       by (simp add: A(1) A(2) assms(2) deriv_add to_fun_plus)
   qed
   show "\<And>c m. c \<in> carrier R \<Longrightarrow>  deriv (monom P a n \<otimes>\<^bsub>P\<^esub> monom P c m) b = 
                                     deriv (monom P a n) b \<otimes> to_fun (monom P c m) b 
                                   \<oplus> to_fun (monom P a n) b \<otimes> deriv (monom P c m) b"
   proof- fix c m assume A: "c \<in> carrier R"
     show "deriv (monom P a n \<otimes>\<^bsub>P\<^esub> monom P c m) b = deriv (monom P a n) b \<otimes> to_fun (monom P c m) b \<oplus> to_fun (monom P a n) b \<otimes> deriv (monom P c m) b"
     proof(cases "n = 0")
       case True
       have LHS: "deriv (monom P a n \<otimes>\<^bsub>P\<^esub> monom P c m) b = deriv (monom P (a \<otimes> c) m) b"
         by (metis A True add.left_neutral assms(1) monom_mult)
       have RHS: "deriv (monom P a n) b \<otimes> to_fun (monom P c m) b \<oplus> to_fun (monom P a n) b \<otimes> deriv (monom P c m) b 
                 = a \<otimes> deriv (monom P c m) b "
         using deriv_const to_fun_monom A True assms(1) assms(2) deriv_closed by auto
       show ?thesis using A assms  LHS RHS deriv_monom 
         by (smt R.add.nat_pow_closed R.add_pow_rdistr R.m_assoc R.m_closed R.nat_pow_closed)
     next
       case False
       show ?thesis 
       proof(cases "m = 0")
         case True
         have LHS: "deriv (monom P a n \<otimes>\<^bsub>P\<^esub> monom P c m) b = deriv (monom P (a \<otimes> c) n) b"
           by (metis A True add.comm_neutral assms(1) monom_mult)
         have RHS: "deriv (monom P a n) b \<otimes> to_fun (monom P c m) b \<oplus> to_fun (monom P a n) b \<otimes> deriv (monom P c m) b 
                 = c \<otimes> deriv (monom P a n) b "
           by (metis (no_types, lifting) A lcf_monom(1) P_def R.m_closed R.m_comm R.r_null
               R.r_zero True UP_cring.to_fun_ctrm UP_cring_axioms assms(1) assms(2) deg_const 
               deriv_closed deriv_const to_fun_closed monom_closed)
         show ?thesis using LHS RHS deriv_monom A assms 
           by (smt R.add.nat_pow_closed R.add_pow_ldistr R.m_assoc R.m_closed R.m_comm R.nat_pow_closed)
       next
         case F: False
         have pos: "n > 0" "m >0"
           using F False by auto 
         have RHS: "deriv (monom P a n \<otimes>\<^bsub>P\<^esub> monom P c m) b = [(n + m)] \<cdot> (a \<otimes> c) \<otimes> b [^] (n + m - 1)"
           using deriv_monom[of "a \<otimes> c" b "n + m"] monom_mult[of a c n m]  
           by (simp add: A assms(1) assms(2))
         have LHS: "deriv (monom P a n) b \<otimes> to_fun (monom P c m) b  \<oplus> to_fun (monom P a n) b \<otimes> deriv (monom P c m) b
                     = [n]\<cdot>a \<otimes>(b[^](n-1)) \<otimes> c \<otimes> b[^]m \<oplus>  a \<otimes> b[^]n  \<otimes>  [m]\<cdot>c \<otimes>(b[^](m-1))"
           using deriv_monom[of a b n] to_fun_monom[of a b n] 
             deriv_monom[of c b m] to_fun_monom[of c b m] A assms 
           by (simp add: R.m_assoc)
         have 0: "[n]\<cdot>a \<otimes> (b[^](n-1)) \<otimes> c \<otimes> b[^]m = [n]\<cdot>a \<otimes> c \<otimes> b[^](n + m -1) "
         proof-
           have "[n]\<cdot>a \<otimes> (b[^](n-1)) \<otimes> c \<otimes> b[^]m = [n]\<cdot>a  \<otimes> c \<otimes> (b[^](n-1)) \<otimes> b[^]m"
             by (simp add: A R.m_lcomm R.semiring_axioms assms(1) assms(2) semiring.semiring_simprules(8))
           hence "[n]\<cdot>a \<otimes> (b[^](n-1)) \<otimes> c \<otimes> b[^]m = [n]\<cdot>a  \<otimes> c \<otimes> ((b[^](n-1)) \<otimes> b[^]m)"
             by (simp add: A R.m_assoc assms(1) assms(2))
           thus ?thesis 
             by (simp add: False R.nat_pow_mult add_eq_if assms(2))
         qed
         have 1: "a \<otimes> b[^]n  \<otimes>  [m]\<cdot>c \<otimes>(b[^](m-1)) = a \<otimes> [m]\<cdot>c \<otimes> b[^](n + m -1)" 
         proof-
           have "a \<otimes> b[^]n  \<otimes>  [m]\<cdot>c \<otimes>(b[^](m-1)) = a \<otimes>  [m]\<cdot>c \<otimes> b[^]n  \<otimes>(b[^](m-1))"
             using A R.m_comm R.m_lcomm assms(1) assms(2) by auto
           hence "a \<otimes> b[^]n  \<otimes>  [m]\<cdot>c \<otimes>(b[^](m-1)) = a \<otimes>  [m]\<cdot>c \<otimes> (b[^]n  \<otimes>(b[^](m-1)))"
             by (simp add: A R.m_assoc assms(1) assms(2))
           thus ?thesis 
             by (simp add: F R.nat_pow_mult add.commute add_eq_if assms(2))
         qed
         have LHS: "deriv (monom P a n) b \<otimes> to_fun (monom P c m) b  \<oplus> to_fun (monom P a n) b \<otimes> deriv (monom P c m) b
                     = [n]\<cdot>a \<otimes> c \<otimes> b[^](n + m -1)  \<oplus>  a \<otimes> [m]\<cdot>c \<otimes> b[^](n + m -1)"      
           using LHS 0 1 
           by simp
         hence LHS: "deriv (monom P a n) b \<otimes> to_fun (monom P c m) b  \<oplus> to_fun (monom P a n) b \<otimes> deriv (monom P c m) b
                     = [n]\<cdot> (a \<otimes> c \<otimes> b[^](n + m -1))  \<oplus>  [m]\<cdot> (a \<otimes> c \<otimes> b[^](n + m -1))"                
           by (simp add: A R.add_pow_ldistr R.add_pow_rdistr assms(1) assms(2))
         show ?thesis using LHS RHS 
           by (simp add: A R.add.nat_pow_mult R.add_pow_ldistr assms(1) assms(2))
       qed
     qed
   qed
 qed
                
 lemma deriv_prod_rule:
   assumes "p \<in> carrier P"
   assumes "q \<in> carrier P"
   assumes "a \<in> carrier R"
   shows "deriv (p \<otimes>\<^bsub>P\<^esub> q) a = deriv p a \<otimes> (to_fun q a) \<oplus> (to_fun p a) \<otimes> deriv q a"
 proof(rule poly_induct3[of p])
   show "p \<in> carrier P"
     using assms(1) by simp 
   show " \<And>p qa.
        qa \<in> carrier P \<Longrightarrow>
        p \<in> carrier P \<Longrightarrow>
        deriv (p \<otimes>\<^bsub>P\<^esub> q) a = deriv p a \<otimes> to_fun q a \<oplus> to_fun p a \<otimes> deriv q a \<Longrightarrow>
        deriv (qa \<otimes>\<^bsub>P\<^esub> q) a = deriv qa a \<otimes> to_fun q a \<oplus> to_fun qa a \<otimes> deriv q a \<Longrightarrow>
        deriv ((p \<oplus>\<^bsub>P\<^esub> qa) \<otimes>\<^bsub>P\<^esub> q) a = deriv (p \<oplus>\<^bsub>P\<^esub> qa) a \<otimes> to_fun q a \<oplus> to_fun (p \<oplus>\<^bsub>P\<^esub> qa) a \<otimes> deriv q a"
   proof- fix f g assume A: "f \<in> carrier P" "g \<in> carrier P"
                   "deriv (f \<otimes>\<^bsub>P\<^esub> q) a = deriv f a \<otimes> to_fun q a \<oplus> to_fun f a \<otimes> deriv q a"
                   "deriv (g \<otimes>\<^bsub>P\<^esub> q) a = deriv g a \<otimes> to_fun q a \<oplus> to_fun g a \<otimes> deriv q a"
     have "deriv ((f \<oplus>\<^bsub>P\<^esub> g) \<otimes>\<^bsub>P\<^esub> q) a = deriv f a \<otimes> to_fun q a \<oplus> to_fun f a \<otimes> deriv q a \<oplus>
                                          deriv g a \<otimes> to_fun q a \<oplus> to_fun g a \<otimes> deriv q a"
       using A deriv_add 
       by (simp add: P.l_distr R.add.m_assoc assms(2) assms(3) deriv_closed to_fun_closed)
     hence "deriv ((f \<oplus>\<^bsub>P\<^esub> g) \<otimes>\<^bsub>P\<^esub> q) a = deriv f a \<otimes> to_fun q a \<oplus> deriv g a \<otimes> to_fun q a \<oplus> 
                                        to_fun f a \<otimes> deriv q a \<oplus>  to_fun g a \<otimes> deriv q a"
       using R.a_comm R.a_assoc deriv_closed to_fun_closed assms 
       by (simp add: A(1) A(2))      
     hence "deriv ((f \<oplus>\<^bsub>P\<^esub> g) \<otimes>\<^bsub>P\<^esub> q) a = (deriv f a \<otimes> to_fun q a \<oplus> deriv g a \<otimes> to_fun q a) \<oplus> 
                                          (to_fun f a \<otimes> deriv q a \<oplus>  to_fun g a \<otimes> deriv q a)"
       by (simp add: A(1) A(2) R.add.m_assoc assms(2) assms(3) deriv_closed to_fun_closed)
     thus "deriv ((f \<oplus>\<^bsub>P\<^esub> g) \<otimes>\<^bsub>P\<^esub> q) a = deriv (f \<oplus>\<^bsub>P\<^esub> g) a \<otimes> to_fun q a \<oplus> to_fun (f \<oplus>\<^bsub>P\<^esub> g) a \<otimes> deriv q a"
       by (simp add: A(1) A(2) R.l_distr assms(2) assms(3) deriv_add deriv_closed to_fun_closed to_fun_plus)
   qed
   show "\<And>aa n. aa \<in> carrier R \<Longrightarrow> deriv (monom P aa n \<otimes>\<^bsub>P\<^esub> q) a = deriv (monom P aa n) a \<otimes> to_fun q a \<oplus> to_fun (monom P aa n) a \<otimes> deriv q a"
     using deriv_prod_rule_times_monom 
     by (simp add: assms(2) assms(3))
 qed
 
 lemma pderiv_eval_deriv_monom:
   assumes "a \<in> carrier R"
   assumes "b \<in> carrier R"
   shows "to_fun (pderiv (monom P a n)) b = deriv (monom P a n) b"
   using deriv_monom assms pderiv_monom  
   by (simp add: P_def UP_cring.to_fun_monom UP_cring_axioms)
 
 lemma pderiv_eval_deriv:
   assumes "f \<in> carrier P"
   assumes "a \<in> carrier R"
   shows "deriv f a = to_fun (pderiv f) a"
   apply(rule poly_induct3[of f])
   apply (simp add: assms(1))
     using assms(2) deriv_add to_fun_plus pderiv_add pderiv_closed apply presburger
       using assms(2) pderiv_eval_deriv_monom 
   by presburger
 
 text\<open>Taking taylor expansions commutes with taking derivatives:\<close>
 
 lemma(in UP_cring) taylor_expansion_pderiv_comm:
   assumes "f \<in> carrier (UP R)"
   assumes "c \<in> carrier R"
   shows "pderiv (taylor_expansion R c f) = taylor_expansion R c (pderiv f)"
   apply(rule poly_induct3[of f])
   using assms unfolding P_def  apply blast
 proof-
   fix p q assume A: " q \<in> carrier (UP R)" "p \<in> carrier (UP R)"
            "pderiv (taylor_expansion R c p) = taylor_expansion R c (pderiv p)"
            "pderiv (taylor_expansion R c q) = taylor_expansion R c (pderiv q)"
   have 0: " pderiv (taylor_expansion R c (p \<oplus>\<^bsub>UP R\<^esub> q)) =  pderiv (taylor_expansion R c p \<oplus>\<^bsub>UP R\<^esub> taylor_expansion R c q)"
     using A P_def taylor_expansion_add assms(2) by presburger
   show "pderiv (taylor_expansion R c (p \<oplus>\<^bsub>UP R\<^esub> q)) = taylor_expansion R c (pderiv (p \<oplus>\<^bsub>UP R\<^esub> q))"
     unfolding 0
     using A(1) A(2) A(3) A(4) taylor_def UP_cring.taylor_closed UP_cring.taylor_expansion_add UP_cring.pderiv_add UP_cring.pderiv_closed UP_cring_axioms assms(2) by fastforce
 next
   fix a n assume A: "a \<in> carrier R"
   show "pderiv (taylor_expansion R c (up_ring.monom (UP R) a n)) = taylor_expansion R c (pderiv (up_ring.monom (UP R) a n))"
   proof(cases "n = 0")
     case True
     have 0: "deg R (taylor_expansion R c (up_ring.monom (UP R) a n)) = 0"
       unfolding True 
       using P_def A assms taylor_def taylor_deg deg_const is_UP_monomE(1) monom_is_UP_monom(2) by presburger
     have 1: "(pderiv (up_ring.monom (UP R) a n)) = \<zero>\<^bsub>P\<^esub>"
       unfolding True using P_def A assms pderiv_const by blast
     show ?thesis unfolding 1 using 0 A assms P_def 
       by (metis P.add.right_cancel taylor_closed taylor_def taylor_expansion_add UP_l_zero UP_zero_closed monom_closed pderiv_deg_0)
   next
     case False
     have 0: "pderiv (up_ring.monom (UP R) a n) =  (up_ring.monom (UP R) ([n]\<cdot>a) (n-1))"
       using A  
       by (simp add: UP_cring.pderiv_monom UP_cring_axioms)      
     have 1: "pderiv (taylor_expansion R c (up_ring.monom (UP R) a n)) = (Cring_Poly.compose R (up_ring.monom (UP R) ([n]\<cdot>a) (n-1)) (X_plus c)) \<otimes>\<^bsub>P\<^esub> pderiv (X_plus c)"
       using chain_rule[of "up_ring.monom (UP R) a n" "X_plus c"] unfolding 0 taylor_expansion_def
       using A P_def X_plus_closed assms(2) is_UP_monom_def monom_is_UP_monom(1) by presburger
     have 2: "pderiv (X_plus c) = \<one>\<^bsub>P\<^esub>"
       using pderiv_add[of "X_poly R" "to_poly c"]  P.l_null P.l_one P.r_zero P_def R.one_closed  X_closed 
         X_poly_def X_poly_plus_def assms(2) monom_one pderiv_const to_poly_closed to_polynomial_def
       by (metis times_x_product_rule)
       show ?thesis unfolding 1 0 2 taylor_expansion_def
         by (metis "1" "2" A P.l_one P_def R.add.nat_pow_closed UP_m_comm UP_one_closed X_plus_closed assms(2) monom_closed sub_closed taylor_expansion_def)      
   qed
 qed
 
   (**********************************************************************)
   (**********************************************************************)
   subsection\<open>Linear Substitutions\<close>
   (**********************************************************************)
   (**********************************************************************)
 lemma(in UP_ring) lcoeff_Lcf:
   assumes "f \<in> carrier P"
   shows "lcoeff f = lcf f"
   unfolding P_def
   using assms  coeff_simp[of f] by metis
 
 lemma(in UP_cring) linear_sub_cfs:
   assumes "f \<in> carrier (UP R)"
   assumes "d \<in> carrier R"
   assumes "g = compose R f (up_ring.monom (UP R) d 1)"
   shows "g i = d[^]i \<otimes> f i"
 proof-
   have 0: "(up_ring.monom (UP R) d 1) \<in> carrier (UP R)"
     using assms by (meson R.ring_axioms UP_ring.intro UP_ring.monom_closed)
   have 1: "(\<forall>i. compose R f (up_ring.monom (UP R) d 1) i = d[^]i \<otimes> f i)"
     apply(rule poly_induct3[of f])
     using assms unfolding P_def apply blast
   proof-
     show "\<And>p q. q \<in> carrier (UP R) \<Longrightarrow>
            p \<in> carrier (UP R) \<Longrightarrow>
            \<forall>i. Cring_Poly.compose R p (up_ring.monom (UP R) d 1) i = d [^] i \<otimes> p i \<Longrightarrow>
            \<forall>i. Cring_Poly.compose R q (up_ring.monom (UP R) d 1) i = d [^] i \<otimes> q i \<Longrightarrow>
            \<forall>i. Cring_Poly.compose R (p \<oplus>\<^bsub>UP R\<^esub> q) (up_ring.monom (UP R) d 1) i = d [^] i \<otimes> (p \<oplus>\<^bsub>UP R\<^esub> q) i"
     proof 
     fix p q i
     assume A: "q \<in> carrier (UP R)"
            "p \<in> carrier (UP R)"
            "\<forall>i. Cring_Poly.compose R p (up_ring.monom (UP R) d 1) i = d [^] i \<otimes> p i"
            "\<forall>i. Cring_Poly.compose R q (up_ring.monom (UP R) d 1) i = d [^] i \<otimes> q i"
     show "Cring_Poly.compose R (p \<oplus>\<^bsub>UP R\<^esub> q) (up_ring.monom (UP R) d 1) i = d [^] i \<otimes> (p \<oplus>\<^bsub>UP R\<^esub> q) i"
     proof- 
       have 1: "Cring_Poly.compose R (p \<oplus>\<^bsub>UP R\<^esub> q) (up_ring.monom (UP R) d 1) = 
               Cring_Poly.compose R p (up_ring.monom (UP R) d 1) \<oplus>\<^bsub>UP R\<^esub> Cring_Poly.compose R q (up_ring.monom (UP R) d 1)"
         using A(1) A(2) sub_add[of "up_ring.monom (UP R) d 1" q p] unfolding P_def 
         using "0" P_def sub_add by blast
       have 2: "Cring_Poly.compose R (p \<oplus>\<^bsub>UP R\<^esub> q) (up_ring.monom (UP R) d 1) i = 
               Cring_Poly.compose R p (up_ring.monom (UP R) d 1) i \<oplus> Cring_Poly.compose R q (up_ring.monom (UP R) d 1) i"
         using 1 by (metis (no_types, lifting) "0" A(1) A(2) P_def cfs_add sub_closed)
       have 3: "Cring_Poly.compose R (p \<oplus>\<^bsub>UP R\<^esub> q) (up_ring.monom (UP R) d 1) i =   d [^] i \<otimes> p i \<oplus> d [^] i \<otimes> q i"
         unfolding 2 using A by presburger
       have 4: "Cring_Poly.compose R (p \<oplus>\<^bsub>UP R\<^esub> q) (up_ring.monom (UP R) d 1) i =   d [^] i \<otimes> (p i \<oplus>  q i)"
         using "3" A(1) A(2) R.nat_pow_closed R.r_distr UP_car_memE(1) assms(2) by presburger
       thus "Cring_Poly.compose R (p \<oplus>\<^bsub>UP R\<^esub> q) (up_ring.monom (UP R) d 1) i = d [^] i \<otimes> (p \<oplus>\<^bsub>UP R\<^esub> q) i"
         unfolding 4  using A(1) A(2) P_def cfs_add by presburger
     qed
   qed
   show "\<And>a n. a \<in> carrier R \<Longrightarrow>
            \<forall>i. Cring_Poly.compose R (up_ring.monom (UP R) a n) (up_ring.monom (UP R) d 1) i = d [^] i \<otimes> up_ring.monom (UP R) a n i"
   proof fix a n i assume A: "a \<in> carrier R"
     have 0: "Cring_Poly.compose R (up_ring.monom (UP R) a n) (up_ring.monom (UP R) d 1)  = 
                          a \<odot>\<^bsub>UP R\<^esub>(up_ring.monom (UP R) d 1)[^]\<^bsub>UP R\<^esub>n"
       using assms A 0 P_def monom_sub by blast
     have 1: "Cring_Poly.compose R (up_ring.monom (UP R) a n) (up_ring.monom (UP R) d 1)  = 
                          a \<odot>\<^bsub>UP R\<^esub> (d[^]n \<odot>\<^bsub>UP R\<^esub>(up_ring.monom (UP R) \<one> n))"
       unfolding  0 using A assms 
       by (metis P_def R.nat_pow_closed monic_monom_smult monom_pow mult.left_neutral)
     have 2: "Cring_Poly.compose R (up_ring.monom (UP R) a n) (up_ring.monom (UP R) d 1)  = 
                          (a \<otimes>d[^]n)\<odot>\<^bsub>UP R\<^esub>(up_ring.monom (UP R) \<one> n)"
       unfolding 1 using A assms  
       by (metis R.nat_pow_closed R.one_closed R.ring_axioms UP_ring.UP_smult_assoc1 UP_ring.intro UP_ring.monom_closed)
     show "Cring_Poly.compose R (up_ring.monom (UP R) a n) (up_ring.monom (UP R) d 1) i = d [^] i \<otimes> up_ring.monom (UP R) a n i"
       apply(cases "i = n")
       unfolding 2 using A P_def R.m_closed R.m_comm R.nat_pow_closed assms(2) cfs_monom monic_monom_smult apply presburger
       using A P_def R.m_closed R.nat_pow_closed R.r_null assms(2) cfs_monom monic_monom_smult by presburger
   qed
   qed
   show ?thesis using 1 unfolding assms   
     by blast 
 qed
 
 lemma(in UP_cring) linear_sub_deriv: 
   assumes "f \<in> carrier (UP R)"
   assumes "d \<in> carrier R"
   assumes "g = compose R f (up_ring.monom (UP R) d 1)"
   assumes "c \<in> carrier R"
   shows "pderiv g = d \<odot>\<^bsub>UP R\<^esub> compose R (pderiv f) (up_ring.monom (UP R) d 1)"
   unfolding assms 
 proof(rule  poly_induct3[of f])
   show "f \<in> carrier P"
     using assms unfolding P_def  by blast
   show "\<And> p q. q \<in> carrier P \<Longrightarrow>
            p \<in> carrier P \<Longrightarrow>
            pderiv (Cring_Poly.compose R p (up_ring.monom (UP R) d 1)) = d \<odot>\<^bsub>UP R\<^esub> Cring_Poly.compose R (pderiv p) (up_ring.monom (UP R) d 1) \<Longrightarrow>
            pderiv (Cring_Poly.compose R q (up_ring.monom (UP R) d 1)) = d \<odot>\<^bsub>UP R\<^esub> Cring_Poly.compose R (pderiv q) (up_ring.monom (UP R) d 1) \<Longrightarrow>
            pderiv (Cring_Poly.compose R (p \<oplus>\<^bsub>P\<^esub> q) (up_ring.monom (UP R) d 1)) =
            d \<odot>\<^bsub>UP R\<^esub> Cring_Poly.compose R (pderiv (p \<oplus>\<^bsub>P\<^esub> q)) (up_ring.monom (UP R) d 1)"
   proof- fix p q assume A: "q \<in> carrier P" "p \<in> carrier P"
            "pderiv (Cring_Poly.compose R p (up_ring.monom (UP R) d 1)) = d \<odot>\<^bsub>UP R\<^esub> Cring_Poly.compose R (pderiv p) (up_ring.monom (UP R) d 1)"
            "pderiv (Cring_Poly.compose R q (up_ring.monom (UP R) d 1)) = d \<odot>\<^bsub>UP R\<^esub> Cring_Poly.compose R (pderiv q) (up_ring.monom (UP R) d 1)"
     show " pderiv (Cring_Poly.compose R (p \<oplus>\<^bsub>P\<^esub> q) (up_ring.monom (UP R) d 1)) =
            d \<odot>\<^bsub>UP R\<^esub> Cring_Poly.compose R (pderiv (p \<oplus>\<^bsub>P\<^esub> q)) (up_ring.monom (UP R) d 1)"
       using A assms 
       by (smt P_def UP_a_closed UP_r_distr monom_closed monom_mult_is_smult pderiv_add pderiv_closed rev_sub_add sub_closed sub_rev_sub)
   qed
   show "\<And>a n. a \<in> carrier R \<Longrightarrow>
            pderiv (Cring_Poly.compose R (up_ring.monom P a n) (up_ring.monom (UP R) d 1)) =
            d \<odot>\<^bsub>UP R\<^esub> Cring_Poly.compose R (pderiv (up_ring.monom P a n)) (up_ring.monom (UP R) d 1)"
   proof- fix a n assume A: "a \<in> carrier R"
     have "(Cring_Poly.compose R (up_ring.monom P a n) (up_ring.monom (UP R) d 1)) = a \<odot>\<^bsub>UP R\<^esub> (up_ring.monom P d 1)[^]\<^bsub>UP R\<^esub> n"
       using A assms sub_monom(2)  P_def is_UP_monomE(1) monom_is_UP_monom(1) by blast
     hence 0: "(Cring_Poly.compose R (up_ring.monom P a n) (up_ring.monom (UP R) d 1)) = a \<odot>\<^bsub>UP R\<^esub> (up_ring.monom P (d[^]n) n)"
       using A assms P_def monom_pow nat_mult_1 by metis 
     show "pderiv (Cring_Poly.compose R (up_ring.monom P a n) (up_ring.monom (UP R) d 1)) =
            d \<odot>\<^bsub>UP R\<^esub> Cring_Poly.compose R (pderiv (up_ring.monom P a n)) (up_ring.monom (UP R) d 1)"
     proof(cases  "n = 0")
       case True
       have T0: "pderiv (up_ring.monom P a n) = \<zero>\<^bsub> UP R\<^esub>" unfolding True 
         using A P_def pderiv_const by blast
       have T1: "(Cring_Poly.compose R (up_ring.monom P a n) (up_ring.monom (UP R) d 1)) = up_ring.monom P a n"
         unfolding True 
         using A assms  P_def deg_const is_UP_monomE(1) monom_is_UP_monom(1) sub_const by presburger
       thus ?thesis unfolding T0 T1  
         by (metis P.nat_pow_eone P_def UP_smult_closed UP_zero_closed X_closed assms(2) deg_zero monom_rep_X_pow smult_r_null sub_const)
     next
       case False
       have F0: "pderiv (Cring_Poly.compose R (up_ring.monom P a n) (up_ring.monom (UP R) d 1)) = (a \<odot>\<^bsub>UP R\<^esub> (up_ring.monom P ([n]\<cdot>\<^bsub>R\<^esub>(d[^]n))(n-1)))"
         using A assms pderiv_monom unfolding 0 
         using P_def R.nat_pow_closed is_UP_monomE(1) monom_is_UP_monom(1) pderiv_smult by metis 
       have F1: "(pderiv (up_ring.monom P a n)) = up_ring.monom P ([n] \<cdot> a) (n - 1)"
         using A assms pderiv_monom[of a n] by blast 
       hence F2: "(pderiv (up_ring.monom P a n)) = ([n] \<cdot> a) \<odot>\<^bsub>UP R\<^esub>up_ring.monom P \<one> (n - 1)"
         using A P_def monic_monom_smult by auto        
       have F3: "Cring_Poly.compose R ((([n] \<cdot> a) \<odot>\<^bsub>UP R\<^esub> (up_ring.monom P \<one> (n - 1)))) (up_ring.monom (UP R) d 1) = 
                 ([n] \<cdot> a) \<odot>\<^bsub>UP R\<^esub> ((up_ring.monom (UP R) d 1)[^]\<^bsub>UP R\<^esub>(n-1))"
         using A F1 F2 P_def assms(2) monom_closed sub_monom(2) by fastforce
       have F4: "Cring_Poly.compose R ((([n] \<cdot> a) \<odot>\<^bsub>UP R\<^esub> (up_ring.monom P \<one> (n - 1)))) (up_ring.monom (UP R) d 1) =
                 ([n] \<cdot> a) \<odot>\<^bsub>UP R\<^esub> ((up_ring.monom (UP R) (d[^](n-1)) (n-1)))"
         by (metis F3 P_def assms(2) monom_pow nat_mult_1)
       have F5: "d \<odot>\<^bsub>UP R\<^esub> (Cring_Poly.compose R (pderiv (up_ring.monom P a n)) (up_ring.monom (UP R) d 1)) = 
                 (d \<otimes>([n] \<cdot> a)) \<odot>\<^bsub>UP R\<^esub> up_ring.monom (UP R) (d [^] (n - 1)) (n - 1)"
         unfolding F4 F2 
         using A P_def assms(2) monom_closed smult_assoc1 by auto       
       have F6: "d \<odot>\<^bsub>UP R\<^esub> (Cring_Poly.compose R (pderiv (up_ring.monom P a n)) (up_ring.monom (UP R) d 1)) = 
                 (d \<otimes> d[^](n-1) \<otimes>[n] \<cdot> a) \<odot>\<^bsub>UP R\<^esub> ((up_ring.monom (UP R) \<one> (n-1)))"
         unfolding F5 using False A  assms P_def  R.m_assoc R.m_closed R.m_comm R.nat_pow_closed monic_monom_smult monom_mult_smult
         by (smt R.add.nat_pow_closed)        
       have F7: "pderiv (Cring_Poly.compose R (up_ring.monom P a n) (up_ring.monom (UP R) d 1)) = (a \<otimes> ([n]\<cdot>\<^bsub>R\<^esub>(d[^]n)) \<odot>\<^bsub>UP R\<^esub> (up_ring.monom P \<one> (n-1)))"
         unfolding F0 using A assms  P_def  R.m_closed R.nat_pow_closed monic_monom_smult monom_mult_smult
         by simp
       have F8: "a \<otimes> [n] \<cdot> (d [^] n)  = d \<otimes> d [^] (n - 1) \<otimes> [n] \<cdot> a"
       proof-
         have F80: "d \<otimes> d [^] (n - 1) \<otimes> [n] \<cdot> a = d [^] n \<otimes> [n] \<cdot> a"
           using A assms  False by (metis R.nat_pow_Suc2 add.right_neutral add_eq_if)
         show ?thesis unfolding F80 
           using A R.add_pow_rdistr R.m_comm R.nat_pow_closed assms(2) by presburger
       qed
       show ?thesis unfolding F6 F7 unfolding  F8 P_def by blast  
     qed
   qed
 qed
 
 lemma(in UP_cring) linear_sub_deriv': 
   assumes "f \<in> carrier (UP R)"
   assumes "d \<in> carrier R"
   assumes "g = compose R f (up_ring.monom (UP R) d 1)"
   assumes "c \<in> carrier R"
   shows "pderiv g = compose R (d \<odot>\<^bsub>UP R\<^esub> pderiv f) (up_ring.monom (UP R) d 1)"
   using assms linear_sub_deriv[of f d g c] P_def is_UP_monomE(1) is_UP_monomI pderiv_closed sub_smult by metis 
 
 lemma(in UP_cring) linear_sub_inv:
   assumes "f \<in> carrier (UP R)"
   assumes "d \<in> Units R"
   assumes "g = compose R f (up_ring.monom (UP R) d 1)"
   shows "compose R g (up_ring.monom (UP R) (inv d) 1) = f"
   unfolding assms 
 proof fix x 
   have 0: "Cring_Poly.compose R (Cring_Poly.compose R f (up_ring.monom (UP R) d 1)) (up_ring.monom (UP R) (inv d) 1) x = 
         (inv d)[^]x \<otimes> ((Cring_Poly.compose R f (up_ring.monom (UP R) d 1)) x)"
     apply(rule linear_sub_cfs) 
     using P_def R.Units_closed assms(1) assms(2) monom_closed sub_closed apply auto[1]
      apply (simp add: assms(2))
     by blast
   show "Cring_Poly.compose R (Cring_Poly.compose R f (up_ring.monom (UP R) d 1)) (up_ring.monom (UP R) (inv d) 1) x = f x "
     unfolding 0 using linear_sub_cfs[of f d "Cring_Poly.compose R f (up_ring.monom (UP R) d 1)" x]
       assms 
   by (smt R.Units_closed R.Units_inv_closed R.Units_l_inv R.m_assoc R.m_comm R.nat_pow_closed R.nat_pow_distrib R.nat_pow_one R.r_one UP_car_memE(1))
 qed
 
 lemma(in UP_cring) linear_sub_deg: 
   assumes "f \<in> carrier (UP R)"
   assumes "d \<in> Units R"
   assumes "g = compose R f (up_ring.monom (UP R) d 1)"
   shows "deg R g = deg R f"
 proof(cases "deg R f = 0")
   case True
   show ?thesis using assms 
     unfolding True assms using P_def True monom_closed 
     by (simp add: R.Units_closed sub_const)    
 next
   case False
   have 0: "monom (UP R) d 1 (deg R (monom (UP R) d 1)) = d"
     using assms  lcf_monom(2) by blast
   have 1: "d[^](deg R f) \<in> Units R" 
     using assms(2)
     by (metis Group.comm_monoid.axioms(1) R.units_comm_group R.units_of_pow comm_group_def monoid.nat_pow_closed units_of_carrier)
   have 2: "f (deg R f) \<noteq> \<zero>"
     using assms False P_def UP_cring.ltrm_rep_X_pow UP_cring_axioms deg_ltrm degree_monom by fastforce
   have "deg R g = deg R f * deg R (up_ring.monom (UP R) d 1)" 
     unfolding assms 
     apply(rule cring_sub_deg[of "up_ring.monom (UP R) d 1" f] )
     using assms P_def monom_closed apply blast
     unfolding P_def apply(rule assms)
     unfolding 0 using 2 1 
     by (metis R.Units_closed R.Units_l_cancel R.m_comm R.r_null R.zero_closed UP_car_memE(1) assms(1))  
   thus ?thesis using assms  unfolding assms
     by (metis (no_types, lifting) P_def R.Units_closed deg_monom deg_zero is_UP_monomE(1) linear_sub_inv monom_is_UP_monom(2) monom_zero mult.right_neutral mult_0_right sub_closed sub_const)
 qed
 
 end
 
 (**************************************************************************************************)
 (**************************************************************************************************)
 section\<open>Lemmas About Polynomial Division\<close>
 (**************************************************************************************************)
 (**************************************************************************************************)
 context UP_cring
 begin
 
   (**********************************************************************)
   (**********************************************************************)
   subsection\<open>Division by Linear Terms\<close>
   (**********************************************************************)
   (**********************************************************************)
 definition UP_root_div where
 "UP_root_div f a =  (poly_shift (T\<^bsub>a\<^esub> f)) of (X_minus a)"
 
 definition UP_root_rem where
 "UP_root_rem f a = ctrm (T\<^bsub>a\<^esub> f)"
 
 lemma UP_root_div_closed:
   assumes "f \<in> carrier P"
   assumes "a \<in> carrier R"
   shows "UP_root_div f a \<in> carrier P"
   using assms 
   unfolding UP_root_div_def
   by (simp add: taylor_closed X_minus_closed poly_shift_closed sub_closed)
 
 lemma rem_closed:
   assumes "f \<in> carrier P"
   assumes "a \<in> carrier R"
   shows "UP_root_rem f a \<in> carrier P"
   using assms 
   unfolding UP_root_rem_def
   by (simp add: taylor_closed ctrm_is_poly) 
 
 lemma rem_deg:
   assumes "f \<in> carrier P"
   assumes "a \<in> carrier R"
   shows "degree (UP_root_rem f a) = 0"
   by (simp add: taylor_closed assms(1) assms(2) ctrm_degree UP_root_rem_def)
 
 lemma remainder_theorem:
   assumes "f \<in> carrier P"
   assumes "a \<in> carrier R"
   assumes "g = UP_root_div f a"
   assumes "r = UP_root_rem f a"
   shows "f = r \<oplus>\<^bsub>P\<^esub> (X_minus a) \<otimes>\<^bsub>P\<^esub> g"
 proof-
   have  "T\<^bsub>a\<^esub>f = (ctrm (T\<^bsub>a\<^esub>f)) \<oplus>\<^bsub>P\<^esub> X \<otimes>\<^bsub>P\<^esub> poly_shift (T\<^bsub>a\<^esub>f)"
     using poly_shift_eq[of "T\<^bsub>a\<^esub>f"] assms taylor_closed 
     by blast     
   hence 1: "T\<^bsub>a\<^esub>f of (X_minus a) = (ctrm (T\<^bsub>a\<^esub>f)) \<oplus>\<^bsub>P\<^esub> (X_minus a) \<otimes>\<^bsub>P\<^esub> (poly_shift (T\<^bsub>a\<^esub>f) of (X_minus a))"
     using assms taylor_closed[of f a] X_minus_closed[of a] X_closed 
           sub_add[of "X_minus a" "ctrm (T\<^bsub>a\<^esub>f)" "X \<otimes>\<^bsub>P\<^esub> poly_shift (T\<^bsub>a\<^esub>f)"] 
           sub_const[of "X_minus a"]  sub_mult[of "X_minus a" X  "poly_shift (T\<^bsub>a\<^esub>f)"] 
           ctrm_degree ctrm_is_poly P.m_closed poly_shift_closed sub_X 
     by presburger
   have 2: "f = (ctrm (T\<^bsub>a\<^esub>f)) \<oplus>\<^bsub>P\<^esub> (X_minus a) \<otimes>\<^bsub>P\<^esub> (poly_shift (T\<^bsub>a\<^esub>f) of (X_minus a))"
     using 1 taylor_id[of a f] assms 
     by simp 
   then show ?thesis
     using assms
     unfolding UP_root_div_def UP_root_rem_def
     by auto 
 qed
 
 lemma remainder_theorem':
   assumes "f \<in> carrier P"
   assumes "a \<in> carrier R"
   shows "f = UP_root_rem f a \<oplus>\<^bsub>P\<^esub> (X_minus a) \<otimes>\<^bsub>P\<^esub> UP_root_div f a"
   using assms remainder_theorem by auto 
 
 lemma factor_theorem:
   assumes "f \<in> carrier P"
   assumes "a \<in> carrier R"
   assumes "g = UP_root_div f a"
   assumes "to_fun f a = \<zero>"
   shows "f = (X_minus a) \<otimes>\<^bsub>P\<^esub> g"
   using remainder_theorem[of f a g _] assms
   unfolding UP_root_rem_def 
   by (simp add: ctrm_zcf taylor_zcf taylor_closed UP_root_div_closed X_minus_closed)
 
 lemma factor_theorem':
   assumes "f \<in> carrier P"
   assumes "a \<in> carrier R"
   assumes "to_fun f a = \<zero>"
   shows "f = (X_minus a) \<otimes>\<^bsub>P\<^esub> UP_root_div f a"
   by (simp add: assms(1) assms(2) assms(3) factor_theorem)
 
   (**********************************************************************)
   (**********************************************************************)
   subsection\<open>Geometric Sums\<close>
   (**********************************************************************)
   (**********************************************************************)
 lemma geom_quot:
   assumes "a \<in> carrier R"
   assumes "b \<in> carrier R"
   assumes "p = monom P \<one> (Suc n) \<ominus>\<^bsub>P\<^esub> monom P (b[^](Suc n)) 0 "
   assumes "g = UP_root_div p b"
   shows "a[^](Suc n) \<ominus> b[^] (Suc n) = (a \<ominus> b) \<otimes> (to_fun g a)"
 proof-
   have root: "to_fun p b = \<zero>"
     using assms to_fun_const[of "b[^](Suc n)" b] to_fun_monic_monom[of b "Suc n"] R.nat_pow_closed[of b "Suc n"]
           to_fun_diff[of "monom P \<one> (Suc n)" "monom P (b[^](Suc n)) 0" b] monom_closed 
     by (metis P.minus_closed P_def R.one_closed R.zero_closed UP_cring.f_minus_ctrm 
         UP_cring.to_fun_diff UP_cring_axioms zcf_to_fun cfs_monom to_fun_const)
   have LHS: "to_fun p a = a[^](Suc n) \<ominus> b[^] (Suc n)"
     using assms to_fun_const to_fun_monic_monom to_fun_diff 
     by auto
   have RHS: "to_fun ((X_minus b) \<otimes>\<^bsub>P\<^esub> g) a = (a \<ominus> b) \<otimes> (to_fun g a)"
     using to_fun_mult[of g "X_minus b"] assms X_minus_closed 
     by (metis P.minus_closed P_def R.nat_pow_closed R.one_closed UP_cring.UP_root_div_closed UP_cring_axioms to_fun_X_minus monom_closed)
   show ?thesis 
     using RHS LHS root factor_theorem' assms(2) assms(3) assms(4) 
     by auto
 qed
 
 end
 
 context UP_cring
 begin 
 
 definition geometric_series where
 "geometric_series n a b = to_fun (UP_root_div (monom P \<one> (Suc n) \<ominus>\<^bsub>UP R\<^esub> (monom P (b[^](Suc n)) 0)) b) a"
 
 lemma geometric_series_id:
   assumes "a \<in> carrier R"
   assumes "b \<in> carrier R"
   shows "a[^](Suc n) \<ominus>b[^] (Suc n) = (a \<ominus> b) \<otimes> (geometric_series n a b)"
   using assms geom_quot 
   by (simp add: P_def geometric_series_def)
 
 lemma geometric_series_closed:
   assumes "a \<in> carrier R"
   assumes "b \<in> carrier R"
   shows "(geometric_series n a b) \<in> carrier R"
   unfolding geometric_series_def 
   using assms  P.minus_closed P_def UP_root_div_closed to_fun_closed monom_closed 
   by auto
 
 text\<open>Shows that $a^n - b^n$ has $a - b$ as a factor:\<close>
 lemma to_fun_monic_monom_diff:
     assumes "a \<in> carrier R"
     assumes "b \<in> carrier R"
     shows "\<exists>c. c \<in> carrier R \<and> to_fun (monom P \<one> n) a \<ominus> to_fun (monom P \<one> n) b = (a \<ominus> b) \<otimes> c"
 proof(cases "n = 0")
   case True
   have "to_fun (monom P \<one> 0) a \<ominus> to_fun (monom P \<one> 0) b = (a \<ominus> b) \<otimes> \<zero>"
     unfolding a_minus_def using to_fun_const[of \<one>] assms 
     by (simp add: R.r_neg)
   then show ?thesis 
     using True by blast 
 next
   case False
   then show ?thesis 
     using Suc_diff_1[of n] geometric_series_id[of a b "n-1"] geometric_series_closed[of a b "n-1"]
         assms(1) assms(2) to_fun_monic_monom 
     by auto
 qed
 
 lemma to_fun_diff_factor:
   assumes "a \<in> carrier R"
   assumes "b \<in> carrier R"
   assumes "f \<in> carrier P"
   shows "\<exists>c. c \<in> carrier R \<and>(to_fun f a) \<ominus> (to_fun f b) = (a \<ominus> b)\<otimes>c"
 proof(rule poly_induct5[of f])
   show "f \<in> carrier P" using assms by simp 
   show "\<And>p q. q \<in> carrier P \<Longrightarrow>
            p \<in> carrier P \<Longrightarrow>
            \<exists>c. c \<in> carrier R \<and> to_fun p a \<ominus> to_fun p b = (a \<ominus> b) \<otimes> c \<Longrightarrow>
            \<exists>c. c \<in> carrier R \<and> to_fun q a \<ominus> to_fun q b = (a \<ominus> b) \<otimes> c \<Longrightarrow>
      \<exists>c. c \<in> carrier R \<and> to_fun (p \<oplus>\<^bsub>P\<^esub> q) a \<ominus> to_fun (p \<oplus>\<^bsub>P\<^esub> q) b = (a \<ominus> b) \<otimes> c"
   proof- fix p q assume A: "q \<in> carrier P" "p \<in> carrier P" 
                           "\<exists>c. c \<in> carrier R \<and> to_fun p a \<ominus> to_fun p b = (a \<ominus> b) \<otimes> c"
                           "\<exists>c. c \<in> carrier R \<and> to_fun q a \<ominus> to_fun q b = (a \<ominus> b) \<otimes> c"
     obtain c  where c_def: "c \<in> carrier R \<and> to_fun p a \<ominus> to_fun p b = (a \<ominus> b) \<otimes> c"
       using A by blast 
     obtain c'  where c'_def: "c' \<in> carrier R \<and> to_fun q a \<ominus> to_fun q b = (a \<ominus> b) \<otimes> c'"
       using A by blast 
     have 0: "(a \<ominus> b) \<otimes> c \<oplus> (a \<ominus> b) \<otimes> c' = (a \<ominus> b)\<otimes>(c \<oplus> c')"
       using assms c_def c'_def  unfolding a_minus_def       
       by (simp add: R.r_distr R.r_minus)   
     have 1: "to_fun (p \<oplus>\<^bsub>P\<^esub>q) a \<ominus> to_fun (p \<oplus>\<^bsub>P\<^esub> q) b = to_fun p a \<oplus> to_fun q a \<ominus> to_fun p b \<ominus> to_fun q b"
       using A to_fun_plus[of p q a] to_fun_plus[of p q b] assms to_fun_closed 
             R.ring_simprules(19)[of "to_fun p b" "to_fun q b"] 
       by (simp add: R.add.m_assoc R.minus_eq to_fun_plus)
     hence "to_fun (p \<oplus>\<^bsub>P\<^esub>q) a \<ominus> to_fun (p \<oplus>\<^bsub>P\<^esub> q) b = to_fun p a \<ominus> to_fun p b \<oplus> to_fun q a \<ominus> to_fun q b"
       using 0 A assms R.ring_simprules  to_fun_closed a_assoc a_comm 
       unfolding a_minus_def 
       by smt
     hence "to_fun (p \<oplus>\<^bsub>P\<^esub>q) a \<ominus> to_fun (p \<oplus>\<^bsub>P\<^esub> q) b = to_fun p a \<ominus> to_fun p b \<oplus> (to_fun q a \<ominus> to_fun q b)"
       using 0 A assms R.ring_simprules  to_fun_closed 
       unfolding a_minus_def 
       by metis 
     hence "to_fun (p \<oplus>\<^bsub>P\<^esub>q) a \<ominus> to_fun (p \<oplus>\<^bsub>P\<^esub> q) b = (a \<ominus> b)\<otimes>(c \<oplus> c')"
       using 0 A c_def c'_def  
       by simp
     thus "\<exists>c. c \<in> carrier R \<and> to_fun (p \<oplus>\<^bsub>P\<^esub> q) a \<ominus> to_fun (p \<oplus>\<^bsub>P\<^esub> q) b = (a \<ominus> b) \<otimes> c"
       using R.add.m_closed c'_def c_def by blast
   qed
   show "\<And>n. \<exists>c. c \<in> carrier R \<and> to_fun (monom P \<one> n) a \<ominus> to_fun (monom P \<one> n) b = (a \<ominus> b) \<otimes> c"
     by (simp add: assms(1) assms(2) to_fun_monic_monom_diff)
   show "\<And>p aa.
        aa \<in> carrier R \<Longrightarrow>
        p \<in> carrier P \<Longrightarrow> \<exists>c. c \<in> carrier R \<and> to_fun p a \<ominus> to_fun p b = (a \<ominus> b) \<otimes> c \<Longrightarrow> \<exists>c. c \<in> carrier R \<and> to_fun (aa \<odot>\<^bsub>P\<^esub> p) a \<ominus> to_fun (aa \<odot>\<^bsub>P\<^esub> p) b = (a \<ominus> b) \<otimes> c"
   proof- fix p c assume A: "c \<in> carrier R" " p \<in> carrier P" 
                           "\<exists>e. e \<in> carrier R \<and> to_fun p a \<ominus> to_fun p b = (a \<ominus> b) \<otimes> e"
     then obtain d where d_def: "d \<in> carrier R \<and> to_fun p a \<ominus> to_fun p b = (a \<ominus> b) \<otimes> d"
       by blast 
     have "to_fun (c \<odot>\<^bsub>P\<^esub> p) a \<ominus> to_fun (c \<odot>\<^bsub>P\<^esub> p) b = c \<otimes> (to_fun p a \<ominus> to_fun p b)"
       using A d_def assms to_fun_smult[of p a c] to_fun_smult[of p b c] 
             to_fun_closed[of p a] to_fun_closed[of p b]  R.ring_simprules 
       by smt
     hence "c\<otimes>d \<in> carrier R \<and> to_fun (c \<odot>\<^bsub>P\<^esub> p) a \<ominus> to_fun (c \<odot>\<^bsub>P\<^esub> p) b = (a \<ominus> b) \<otimes> (c \<otimes>d)"
       by (simp add: A(1) R.m_lcomm assms(1) assms(2) d_def)
     thus "\<exists>e. e \<in> carrier R \<and> to_fun (c \<odot>\<^bsub>P\<^esub> p) a \<ominus> to_fun (c \<odot>\<^bsub>P\<^esub> p) b = (a \<ominus> b) \<otimes> e" 
       by blast 
   qed
 qed
 
 text\<open>Any finite set over a domain is the zero set of a polynomial:\<close>
 lemma(in UP_domain) fin_set_poly_roots:
   assumes "F \<subseteq> carrier R"
   assumes "finite F"
   shows "\<exists> P \<in> carrier (UP R). \<forall> x \<in> carrier R. to_fun P x = \<zero> \<longleftrightarrow> x \<in> F"
   apply(rule finite.induct)
     apply (simp add: assms(2))
 proof-
   show "\<exists>P\<in>carrier (UP R). \<forall>x\<in>carrier R. (to_fun P x = \<zero>) = (x \<in> {})"
   proof-
     have "\<forall>x\<in>carrier R. (to_fun (\<one>\<^bsub>UP R\<^esub>) x = \<zero>) = (x \<in> {})"
     proof
       fix x
       assume A: "x \<in> carrier R"
       then have "(to_fun (\<one>\<^bsub>UP R\<^esub>)) x = \<one>"
         by (metis P_def R.one_closed UP_cring.to_fun_to_poly UP_cring_axioms ring_hom_one to_poly_is_ring_hom)
       then show "(to_fun \<one>\<^bsub>UP R\<^esub> x = \<zero>) = (x \<in> {})"
         by simp      
     qed
     then show ?thesis 
       using P_def UP_one_closed 
       by blast
   qed
   show "\<And>A a. finite A \<Longrightarrow>
            \<exists>P\<in>carrier (UP R). \<forall>x\<in>carrier R. (to_fun P x = \<zero>) = (x \<in> A) \<Longrightarrow> \<exists>P\<in>carrier (UP R). \<forall>x\<in>carrier R. (to_fun P x = \<zero>) = (x \<in> insert a A)"
   proof-
     fix A :: "'a set" fix a
     assume fin_A: "finite A"
     assume IH: "\<exists>P\<in>carrier (UP R). \<forall>x\<in>carrier R. (to_fun P x = \<zero>) = (x \<in> A)"
     then obtain p  where p_def: "p \<in>carrier (UP R) \<and> (\<forall>x\<in>carrier R. (to_fun p x = \<zero>) = (x \<in> A))"
       by blast
     show "\<exists>P\<in>carrier (UP R). \<forall>x\<in>carrier R. (to_fun P x = \<zero>) = (x \<in> insert a A)"
     proof(cases "a \<in> carrier R")
       case True
         obtain Q where Q_def: "Q = p \<otimes>\<^bsub>UP R\<^esub> (X \<ominus>\<^bsub>UP R\<^esub> to_poly a)"
       by blast
       have "\<forall>x\<in>carrier R. (to_fun Q x = \<zero>) = (x \<in> insert a A)" 
       proof fix x
         assume P: "x \<in> carrier R"
         have P0: "to_fun (X \<ominus>\<^bsub>UP R\<^esub> to_poly a) x = x \<ominus> a" 
           using to_fun_plus[of X "\<ominus>\<^bsub>UP R\<^esub> to_poly a" x] True P 
           unfolding a_minus_def 
           by (metis X_poly_minus_def a_minus_def to_fun_X_minus)
         then have "to_fun Q x = (to_fun p x) \<otimes> (x \<ominus> a)"
         proof-
           have 0: " p \<in> carrier P"
           by (simp add: P_def p_def)
           have 1: "    X \<ominus>\<^bsub>UP R\<^esub> to_poly a \<in> carrier P"
           using P.minus_closed P_def True X_closed to_poly_closed by auto
           have 2: "x \<in> carrier R"
           by (simp add: P)
           then show ?thesis 
           using to_fun_mult[of p "(X \<ominus>\<^bsub>UP R\<^esub> to_poly a)" x] P0 0 1 2 Q_def True P_def to_fun_mult 
           by auto
         qed
        then show "(to_fun Q x = \<zero>) = (x \<in> insert a A)" 
         using p_def 
         by (metis P R.add.inv_closed R.integral_iff R.l_neg R.minus_closed R.minus_unique True UP_cring.to_fun_closed UP_cring_axioms a_minus_def insert_iff)        
     qed
     then have "Q \<in> carrier (UP R) \<and> (\<forall>x\<in>carrier R. (to_fun Q x = \<zero>) = (x \<in> insert a A))" 
       using P.minus_closed P_def Q_def True UP_mult_closed X_closed p_def to_poly_closed by auto
     then show ?thesis 
       by blast
   next
     case False 
     then show ?thesis 
       using IH subsetD by auto
   qed
   qed
 qed
 
   (**********************************************************************)
   (**********************************************************************)
   subsection\<open>Polynomial Evaluation at Multiplicative Inverses\<close>
   (**********************************************************************)
   (**********************************************************************)
 text\<open>For every polynomial $p(x)$ of degree $n$, there is a unique polynomial $q(x)$ which satisfies the equation $q(x) = x^n p(1/x)$. This section defines this polynomial and proves this identity.\<close>
 definition(in UP_cring) one_over_poly where
 "one_over_poly p = (\<lambda> n. if n \<le> degree p then p ((degree  p) - n) else \<zero>)"
 
 lemma(in UP_cring) one_over_poly_closed: 
   assumes "p \<in> carrier P"
   shows "one_over_poly p \<in> carrier P"
   apply(rule UP_car_memI[of "degree p" ])
   unfolding one_over_poly_def using assms  apply simp
   by (simp add: assms cfs_closed)
   
 lemma(in UP_cring) one_over_poly_monom:
   assumes "a \<in> carrier R"
   shows "one_over_poly (monom P a n) = monom P a 0"
   apply(rule ext)
   unfolding one_over_poly_def using assms 
   by (metis cfs_monom deg_monom diff_diff_cancel diff_is_0_eq diff_self_eq_0 zero_diff)
 
 lemma(in UP_cring) one_over_poly_monom_add:
   assumes "a \<in> carrier R"
   assumes "a \<noteq> \<zero>"
   assumes "p \<in> carrier P"
   assumes "degree p < n"
   shows "one_over_poly (p \<oplus>\<^bsub>P\<^esub> monom P a n) = monom P a 0 \<oplus>\<^bsub>P\<^esub> monom P \<one> (n - degree p) \<otimes>\<^bsub>P\<^esub> one_over_poly p"
 proof-
   have 0: "degree (p \<oplus>\<^bsub>P\<^esub> monom P a n) = n"
     by (simp add: assms(1) assms(2) assms(3) assms(4) equal_deg_sum)
   show ?thesis 
   proof(rule ext) fix x show "one_over_poly (p \<oplus>\<^bsub>P\<^esub> monom P a n) x =
                                  (monom P a 0 \<oplus>\<^bsub>P\<^esub> monom P \<one> (n - deg R p) \<otimes>\<^bsub>P\<^esub> one_over_poly p) x"
     proof(cases "x = 0")
       case T: True
       have T0: "one_over_poly (p \<oplus>\<^bsub>P\<^esub> monom P a n) 0 = a"
         unfolding one_over_poly_def 
         by (metis lcf_eq lcf_monom(1) ltrm_of_sum_diff_deg P.add.m_closed assms(1) assms(2) assms(3) assms(4) diff_zero le0 monom_closed)        
       have T1: "(monom P a 0 \<oplus>\<^bsub>P\<^esub> monom P \<one> (n - degree p) \<otimes>\<^bsub>P\<^esub> one_over_poly p) 0 = a"
         using one_over_poly_closed 
         by (metis (no_types, lifting) lcf_monom(1) R.one_closed R.r_zero UP_m_comm UP_mult_closed assms(1) assms(3) assms(4) cfs_add cfs_monom_mult deg_const monom_closed zero_less_diff)                    
       show ?thesis  using T0 T1 T by auto 
     next
       case F: False
       show ?thesis
       proof(cases "x < n - degree p")
         case True
         then have T0: "degree p < n - x \<and> n - x < n"
           using F by auto
         then have T1: "one_over_poly (p \<oplus>\<^bsub>P\<^esub> monom P a n) x = \<zero>"
           using True F 0 unfolding one_over_poly_def 
           using assms(1) assms(3) coeff_of_sum_diff_degree0 
           by (metis ltrm_cfs ltrm_of_sum_diff_deg P.add.m_closed P.add.m_comm assms(2) assms(4) monom_closed nat_neq_iff)          
         have "(monom P a 0 \<oplus>\<^bsub>P\<^esub> monom P \<one> (n - degree p) \<otimes>\<^bsub>P\<^esub> one_over_poly p) x = \<zero>"  
           using True F 0  one_over_poly_def one_over_poly_closed 
           by (metis (no_types, lifting) P.add.m_comm P.m_closed R.one_closed UP_m_comm assms(1)
               assms(3) cfs_monom_mult coeff_of_sum_diff_degree0 deg_const monom_closed neq0_conv)
         then show ?thesis using T1 by auto 
       next
         case False
         then have "n - degree p \<le> x"
           by auto 
         then obtain k where k_def: "k + (n - degree p) = x"
           using le_Suc_ex  diff_add 
           by blast
         have F0: "(monom P a 0 \<oplus>\<^bsub>P\<^esub> monom P \<one> (n - deg R p) \<otimes>\<^bsub>P\<^esub> one_over_poly p) x
               = one_over_poly p k"
           using k_def one_over_poly_closed assms 
                 times_X_pow_coeff[of "one_over_poly p" "n - deg R p" k]
                 P.m_closed 
           by (metis (no_types, lifting) P.add.m_comm R.one_closed add_gr_0 coeff_of_sum_diff_degree0 deg_const monom_closed zero_less_diff)                
         show ?thesis 
         proof(cases "x \<le> n")
           case True
           have T0: "n - x = degree p - k"
             using assms(4) k_def by linarith
           have T1: "n - x < n"
             using True F 
             by linarith
           then have F1: "(p \<oplus>\<^bsub>P\<^esub> monom P a n) (n - x) = p (degree p - k)"
             using True False F0 0 k_def cfs_add 
             by (simp add: F0 T0 assms(1) assms(3) cfs_closed cfs_monom)            
           then show ?thesis 
             using "0" F0 assms(1) assms(2) assms(3) degree_of_sum_diff_degree k_def one_over_poly_def
             by auto          
         next
           case False
           then show ?thesis 
             using "0" F0 assms(1) assms(2) assms(3) degree_of_sum_diff_degree k_def one_over_poly_def 
             by auto          
         qed
       qed
     qed 
   qed
 qed
 
 lemma( in UP_cring) one_over_poly_eval: 
   assumes "p \<in> carrier P"
   assumes "x \<in> carrier R"
   assumes "x \<in> Units R"
   shows "to_fun (one_over_poly p) x = (x[^](degree p)) \<otimes> (to_fun p (inv\<^bsub>R\<^esub> x))" 
 proof(rule poly_induct6[of p])
   show " p \<in> carrier P"
     using assms by simp 
   show "\<And>a n. a \<in> carrier R \<Longrightarrow> 
         to_fun (one_over_poly (monom P a 0)) x = x [^] deg R (monom P a 0) \<otimes> to_fun (monom P a 0) (inv x)"
     using assms to_fun_const one_over_poly_monom by auto
   show "\<And>a n p.
        a \<in> carrier R \<Longrightarrow>
        a \<noteq> \<zero> \<Longrightarrow>
        p \<in> carrier P \<Longrightarrow>
        deg R p < n \<Longrightarrow>
        to_fun (one_over_poly p) x = x [^] deg R p \<otimes> to_fun p (inv x) \<Longrightarrow>
       to_fun (one_over_poly (p \<oplus>\<^bsub>P\<^esub> monom P a n)) x = x [^] deg R (p \<oplus>\<^bsub>P\<^esub> monom P a n) \<otimes> to_fun (p \<oplus>\<^bsub>P\<^esub> monom P a n) (inv x)"
   proof- fix a n p assume A: "a \<in> carrier R" "a \<noteq> \<zero>" "p \<in> carrier P" "deg R p < n"
                              "to_fun (one_over_poly p) x = x [^] deg R p \<otimes> to_fun p (inv x)"
     have "one_over_poly (p \<oplus>\<^bsub>P\<^esub> monom P a n) = monom P a 0 \<oplus>\<^bsub>P\<^esub> monom P \<one> (n - degree p) \<otimes>\<^bsub>P\<^esub> one_over_poly p"
       using A by (simp add: one_over_poly_monom_add)
     hence "to_fun ( one_over_poly (p \<oplus>\<^bsub>P\<^esub> monom P a n)) x = 
                 a \<oplus> to_fun ( monom P \<one> (n - degree p) \<otimes>\<^bsub>P\<^esub> one_over_poly p) x"
       using A to_fun_plus one_over_poly_closed cfs_add 
       by (simp add: assms(2) to_fun_const)
     hence "to_fun (one_over_poly (p \<oplus>\<^bsub>P\<^esub> monom P a n)) x = a \<oplus> x[^](n - degree p) \<otimes> x [^] degree p \<otimes> to_fun p (inv x)"
       by (simp add: A(3) A(5) R.m_assoc assms(2) assms(3) to_fun_closed to_fun_monic_monom to_fun_mult one_over_poly_closed)
     hence 0:"to_fun (one_over_poly (p \<oplus>\<^bsub>P\<^esub> monom P a n)) x = a \<oplus> x[^]n \<otimes> to_fun p (inv x)"
       using A R.nat_pow_mult assms(2)
       by auto
     have 1: "to_fun (one_over_poly (p \<oplus>\<^bsub>P\<^esub> monom P a n)) x = x[^]n \<otimes> (a \<otimes> inv x [^]n \<oplus> to_fun p (inv x))"
     proof-
       have "x[^]n \<otimes> a \<otimes> inv x [^]n = a"
         by (metis (no_types, opaque_lifting) A(1) R.Units_inv_closed R.Units_r_inv R.m_assoc 
             R.m_comm R.nat_pow_closed R.nat_pow_distrib R.nat_pow_one R.r_one assms(2) assms(3))
       thus ?thesis 
         using A R.ring_simprules(23)[of _ _  "x[^]n"] 0 R.m_assoc assms(2) assms(3) to_fun_closed 
         by auto
     qed
     have 2: "degree (p \<oplus>\<^bsub>P\<^esub> monom P a n) = n"
       by (simp add: A(1) A(2) A(3) A(4) equal_deg_sum)
     show " to_fun (one_over_poly (p \<oplus>\<^bsub>P\<^esub> monom P a n)) x = x [^] deg R (p \<oplus>\<^bsub>P\<^esub> monom P a n) \<otimes> to_fun (p \<oplus>\<^bsub>P\<^esub> monom P a n) (inv x)"
       using 1 2 
       by (metis (no_types, lifting) A(1) A(3) P_def R.Units_inv_closed R.add.m_comm 
           UP_cring.to_fun_monom UP_cring_axioms assms(3) to_fun_closed to_fun_plus monom_closed)
   qed
 qed
 
 end
 
 (**************************************************************************************************)
 (**************************************************************************************************)
 section\<open>Lifting Homomorphisms of Rings to Polynomial Rings by Application to Coefficients\<close>
 (**************************************************************************************************)
 (**************************************************************************************************)
 
 definition poly_lift_hom where
 "poly_lift_hom R S \<phi> = eval R (UP S) (to_polynomial S \<circ> \<phi>) (X_poly S)"
 
 context UP_ring
 begin
 
 lemma(in UP_cring) pre_poly_lift_hom_is_hom:
   assumes "cring S"
   assumes "\<phi> \<in> ring_hom R S"
   shows "ring_hom_ring R (UP S) (to_polynomial S \<circ> \<phi>)"
   apply(rule ring_hom_ringI) 
        apply (simp add: R.ring_axioms)
   apply (simp add: UP_ring.UP_ring UP_ring.intro assms(1) cring.axioms(1))
   using UP_cring.intro UP_cring.to_poly_closed assms(1) assms(2) ring_hom_closed apply fastforce
   using assms UP_cring.to_poly_closed[of S] ring_hom_closed[of \<phi> R S] comp_apply[of "to_polynomial S" \<phi>]
   unfolding UP_cring_def 
   apply (metis UP_cring.to_poly_mult UP_cring_def ring_hom_mult)
   using assms UP_cring.to_poly_closed[of S] ring_hom_closed[of \<phi> R S] comp_apply[of "to_polynomial S" \<phi>]
   unfolding UP_cring_def 
     apply (metis UP_cring.to_poly_add UP_cring_def ring_hom_add)
   using assms UP_cring.to_poly_closed[of S] ring_hom_one[of \<phi> R S] comp_apply[of "to_polynomial S" \<phi>]
   unfolding UP_cring_def 
   by (simp add: \<open>\<phi> \<in> ring_hom R S \<Longrightarrow> \<phi> \<one> = \<one>\<^bsub>S\<^esub>\<close> UP_cring.intro UP_cring.to_poly_is_ring_hom ring_hom_one)
 
 lemma(in UP_cring) poly_lift_hom_is_hom:
   assumes "cring S"
   assumes "\<phi> \<in> ring_hom R S"
   shows "poly_lift_hom R S \<phi> \<in> ring_hom (UP R) (UP S)"
   unfolding poly_lift_hom_def
   apply( rule UP_pre_univ_prop.eval_ring_hom[of R "UP S" ])
   unfolding UP_pre_univ_prop_def
   apply (simp add: R_cring RingHom.ring_hom_cringI UP_cring.UP_cring UP_cring_def assms(1) assms(2) pre_poly_lift_hom_is_hom)
   by (simp add: UP_cring.X_closed UP_cring.intro assms(1))
 
 lemma(in UP_cring) poly_lift_hom_closed: 
   assumes "cring S"
   assumes "\<phi> \<in> ring_hom R S"
   assumes "p \<in> carrier (UP R)"
   shows "poly_lift_hom R S \<phi> p \<in> carrier (UP S)"
   by (metis assms(1) assms(2) assms(3) poly_lift_hom_is_hom ring_hom_closed)
 
 lemma(in UP_cring) poly_lift_hom_add: 
   assumes "cring S"
   assumes "\<phi> \<in> ring_hom R S"
   assumes "p \<in> carrier (UP R)"
   assumes "q \<in> carrier (UP R)"
   shows "poly_lift_hom R S \<phi> (p \<oplus>\<^bsub>UP R\<^esub> q) = poly_lift_hom R S \<phi> p \<oplus>\<^bsub>UP S\<^esub> poly_lift_hom R S \<phi> q"
   using assms poly_lift_hom_is_hom[of S \<phi>] ring_hom_add[of "poly_lift_hom R S \<phi>" "UP R" "UP S" p q] 
   by blast
 
 lemma(in UP_cring) poly_lift_hom_mult: 
   assumes "cring S"
   assumes "\<phi> \<in> ring_hom R S"
   assumes "p \<in> carrier (UP R)"
   assumes "q \<in> carrier (UP R)"
   shows "poly_lift_hom R S \<phi> (p \<otimes>\<^bsub>UP R\<^esub> q) = poly_lift_hom R S \<phi> p \<otimes>\<^bsub>UP S\<^esub> poly_lift_hom R S \<phi> q"
   using assms poly_lift_hom_is_hom[of  S \<phi>] ring_hom_mult[of "poly_lift_hom R S \<phi>" "UP R" "UP S" p q] 
   by blast 
 
 lemma(in UP_cring) poly_lift_hom_extends_hom:
   assumes "cring S"
   assumes "\<phi> \<in> ring_hom R S"
   assumes "r \<in> carrier R"
   shows "poly_lift_hom R S \<phi> (to_polynomial R r) = to_polynomial S (\<phi> r)"
   using UP_pre_univ_prop.eval_const[of R "UP S" "to_polynomial S \<circ> \<phi>" "X_poly S" r ] assms 
         comp_apply[of "\<lambda>a. monom (UP S) a 0"  \<phi> r] pre_poly_lift_hom_is_hom[of  S \<phi>]
   unfolding poly_lift_hom_def to_polynomial_def UP_pre_univ_prop_def 
   by (simp add: R_cring RingHom.ring_hom_cringI UP_cring.UP_cring UP_cring.X_closed UP_cring.intro)
 
 lemma(in UP_cring) poly_lift_hom_extends_hom':
   assumes "cring S"
   assumes "\<phi> \<in> ring_hom R S"
   assumes "r \<in> carrier R"
   shows "poly_lift_hom R S \<phi> (monom P r 0) = monom (UP S) (\<phi> r) 0"
   using poly_lift_hom_extends_hom[of S \<phi> r] assms 
   unfolding to_polynomial_def P_def 
   by blast
 
 lemma(in UP_cring) poly_lift_hom_smult: 
   assumes "cring S"
   assumes "\<phi> \<in> ring_hom R S"
   assumes "p \<in> carrier (UP R)"
   assumes "a \<in> carrier R"
   shows "poly_lift_hom R S \<phi>  (a \<odot>\<^bsub>UP R\<^esub> p) = \<phi> a \<odot>\<^bsub>UP S\<^esub> (poly_lift_hom R S \<phi> p)"
   using assms poly_lift_hom_is_hom[of S \<phi>] poly_lift_hom_extends_hom'[of S \<phi> a] 
         poly_lift_hom_mult[of  S \<phi> "monom P a 0" p] ring_hom_closed[of \<phi> R S a]
         UP_ring.monom_mult_is_smult[of S "\<phi> a" "poly_lift_hom R S \<phi> p"]
         monom_mult_is_smult[of a p] monom_closed[of a 0] poly_lift_hom_closed[of S \<phi> p]
   unfolding to_polynomial_def UP_ring_def P_def cring_def 
   by simp        
 
 lemma(in UP_cring) poly_lift_hom_monom:
   assumes "cring S"
   assumes "\<phi> \<in> ring_hom R S"
   assumes "r \<in> carrier R"
   shows "poly_lift_hom R S \<phi> (monom (UP R) r n) = (monom (UP S) (\<phi> r) n)"
 proof-
   have "eval R (UP S) (to_polynomial S \<circ> \<phi>) (X_poly S) (monom (UP R) r n) = (to_polynomial S \<circ> \<phi>) r \<otimes>\<^bsub>UP S\<^esub> X_poly S [^]\<^bsub>UP S\<^esub> n"
     using assms UP_pre_univ_prop.eval_monom[of R "UP S" "to_polynomial S \<circ> \<phi>" r "X_poly S" n]
     unfolding UP_pre_univ_prop_def UP_cring_def ring_hom_cring_def
     by (meson UP_cring.UP_cring UP_cring.X_closed UP_cring.pre_poly_lift_hom_is_hom UP_cring_axioms 
         UP_cring_def ring_hom_cring_axioms.intro ring_hom_ring.homh)     
    then have "eval R (UP S) (to_polynomial S \<circ> \<phi>) (X_poly S) (monom (UP R) r n) = (to_polynomial S (\<phi> r)) \<otimes>\<^bsub>UP S\<^esub> X_poly S [^]\<^bsub>UP S\<^esub> n"
     by simp
   then show ?thesis
   unfolding poly_lift_hom_def
   using assms UP_cring.monom_rep_X_pow[of S "\<phi> r" n]  ring_hom_closed[of \<phi> R S r]
     by (metis UP_cring.X_closed UP_cring.intro UP_cring.monom_sub UP_cring.sub_monom(1))
 qed
 
 lemma(in UP_cring) poly_lift_hom_X_var:
   assumes "cring S"
   assumes "\<phi> \<in> ring_hom R S"
   shows "poly_lift_hom R S \<phi> (monom (UP R) \<one>\<^bsub>R\<^esub> 1) = (monom (UP S) \<one>\<^bsub>S\<^esub> 1)"
   using assms(1) assms(2) poly_lift_hom_monom ring_hom_one by fastforce
 
 lemma(in UP_cring) poly_lift_hom_X_var':
   assumes "cring S"
   assumes "\<phi> \<in> ring_hom R S"
   shows "poly_lift_hom R S \<phi> (X_poly R) = (X_poly S)"
   unfolding X_poly_def 
   using assms(1) assms(2) poly_lift_hom_X_var by blast
   
 lemma(in UP_cring) poly_lift_hom_X_var'':
   assumes "cring S"
   assumes "\<phi> \<in> ring_hom R S"
   shows "poly_lift_hom R S \<phi> (monom (UP R) \<one>\<^bsub>R\<^esub> n) = (monom (UP S) \<one>\<^bsub>S\<^esub> n)"
   using assms(1) assms(2) poly_lift_hom_monom ring_hom_one by fastforce
 
 lemma(in UP_cring) poly_lift_hom_X_var''':
   assumes "cring S"
   assumes "\<phi> \<in> ring_hom R S"
   shows "poly_lift_hom R S \<phi> (X_poly R [^]\<^bsub>UP R\<^esub> (n::nat)) = (X_poly S) [^]\<^bsub>UP S\<^esub> (n::nat)"
   using assms 
   by (smt ltrm_of_X P.nat_pow_closed P_def R.ring_axioms UP_cring.to_fun_closed UP_cring.intro
       UP_cring.monom_pow UP_cring.poly_lift_hom_monom UP_cring_axioms X_closed cfs_closed 
       cring.axioms(1) to_fun_X_pow poly_lift_hom_X_var' ring_hom_closed ring_hom_nat_pow)  
 
 lemma(in UP_cring) poly_lift_hom_X_plus:
   assumes "cring S"
   assumes "\<phi> \<in> ring_hom R S"
   assumes "a \<in> carrier R"
   shows "poly_lift_hom R S \<phi> (X_poly_plus R a) = X_poly_plus S (\<phi> a)"
   using ring_hom_add
   unfolding X_poly_plus_def 
   using P_def X_closed assms(1) assms(2) assms(3) poly_lift_hom_X_var' poly_lift_hom_add poly_lift_hom_extends_hom to_poly_closed by fastforce
 
 lemma(in UP_cring) poly_lift_hom_X_plus_nat_pow:
   assumes "cring S"
   assumes "\<phi> \<in> ring_hom R S"
   assumes "a \<in> carrier R"
   shows "poly_lift_hom R S \<phi> (X_poly_plus R a [^]\<^bsub>UP R\<^esub> (n::nat)) = X_poly_plus S (\<phi> a) [^]\<^bsub>UP S\<^esub> (n::nat)"
   using assms poly_lift_hom_X_plus[of S \<phi> a] 
         ring_hom_nat_pow[of "UP R" "UP S" "poly_lift_hom R S \<phi>" "X_poly_plus R a" n] 
         poly_lift_hom_is_hom[of S \<phi>] X_plus_closed[of a] UP_ring.UP_ring[of S]
   unfolding P_def cring_def UP_cring_def
   using P_def UP_ring UP_ring.intro
   by (simp add: UP_ring.intro)
  
 lemma(in UP_cring) X_poly_plus_nat_pow_closed:
   assumes "a \<in> carrier R"
   shows " X_poly_plus R a [^]\<^bsub>UP R\<^esub> (n::nat) \<in> carrier (UP R)"
   using assms P.nat_pow_closed P_def X_plus_closed by auto
 
 lemma(in UP_cring) poly_lift_hom_X_plus_nat_pow_smult:
   assumes "cring S"
   assumes "\<phi> \<in> ring_hom R S"
   assumes "a \<in> carrier R"
   assumes "b \<in> carrier R"
   shows "poly_lift_hom R S \<phi> (b \<odot>\<^bsub>UP R\<^esub> X_poly_plus R a [^]\<^bsub>UP R\<^esub> (n::nat)) = \<phi> b \<odot>\<^bsub>UP S \<^esub>X_poly_plus S (\<phi> a) [^]\<^bsub>UP S\<^esub> (n::nat)"
   by (simp add: X_poly_plus_nat_pow_closed assms(1) assms(2) assms(3) assms(4) poly_lift_hom_X_plus_nat_pow poly_lift_hom_smult)
 
 lemma(in UP_cring) poly_lift_hom_X_minus:
   assumes "cring S"
   assumes "\<phi> \<in> ring_hom R S"
   assumes "a \<in> carrier R"
   shows "poly_lift_hom R S \<phi> (X_poly_minus R a) = X_poly_minus S (\<phi> a)"
   using poly_lift_hom_X_plus[of S \<phi> "\<ominus> a"] X_minus_plus[of a] UP_cring.X_minus_plus[of S "\<phi> a"]
         R.ring_hom_a_inv[of S \<phi> a]
   unfolding UP_cring_def P_def
   by (metis R.add.inv_closed assms(1) assms(2) assms(3) cring.axioms(1) ring_hom_closed)
 
 lemma(in UP_cring) poly_lift_hom_X_minus_nat_pow:
   assumes "cring S"
   assumes "\<phi> \<in> ring_hom R S"
   assumes "a \<in> carrier R"
   shows "poly_lift_hom R S \<phi> (X_poly_minus R a [^]\<^bsub>UP R\<^esub> (n::nat)) = X_poly_minus S (\<phi> a) [^]\<^bsub>UP S\<^esub> (n::nat)"
   using assms poly_lift_hom_X_minus ring_hom_nat_pow X_minus_plus UP_cring.X_minus_plus 
       poly_lift_hom_X_plus poly_lift_hom_X_plus_nat_pow by fastforce
 
 lemma(in UP_cring) X_poly_minus_nat_pow_closed:
   assumes "a \<in> carrier R"
   shows "X_poly_minus R a [^]\<^bsub>UP R\<^esub> (n::nat) \<in> carrier (UP R)"
   using assms monoid.nat_pow_closed[of "UP R" "X_poly_minus R a" n] 
         P.nat_pow_closed P_def X_minus_closed by auto
 
 lemma(in UP_cring) poly_lift_hom_X_minus_nat_pow_smult:
   assumes "cring S"
   assumes "\<phi> \<in> ring_hom R S"
   assumes "a \<in> carrier R"
   assumes "b \<in> carrier R"
   shows "poly_lift_hom R S \<phi> (b \<odot>\<^bsub>UP R\<^esub> X_poly_minus R a [^]\<^bsub>UP R\<^esub> (n::nat)) = \<phi> b \<odot>\<^bsub>UP S \<^esub>X_poly_minus S (\<phi> a) [^]\<^bsub>UP S\<^esub> (n::nat)"
   by (simp add: X_poly_minus_nat_pow_closed assms(1) assms(2) assms(3) assms(4) poly_lift_hom_X_minus_nat_pow poly_lift_hom_smult)
 
 lemma(in UP_cring) poly_lift_hom_cf:
   assumes "cring S"
   assumes "\<phi> \<in> ring_hom R S"
   assumes "p \<in> carrier P"
   shows "poly_lift_hom R S \<phi> p k = \<phi> (p k)"
   apply(rule poly_induct3[of p])
   apply (simp add: assms(3))
 proof-
   show "\<And>p q. q \<in> carrier P \<Longrightarrow>
            p \<in> carrier P \<Longrightarrow>
            poly_lift_hom R S \<phi> p k = \<phi> (p k) \<Longrightarrow> poly_lift_hom R S \<phi> q k = \<phi> (q k) \<Longrightarrow> poly_lift_hom R S \<phi> (p \<oplus>\<^bsub>P\<^esub> q) k = \<phi> ((p \<oplus>\<^bsub>P\<^esub> q) k)"
   proof- fix p q assume A: "p \<in> carrier P"  "q \<in> carrier P"
           "poly_lift_hom R S \<phi> p k = \<phi> (p k)" "poly_lift_hom R S \<phi> q k = \<phi> (q k)"
     show "poly_lift_hom R S \<phi> q k = \<phi> (q k) \<Longrightarrow> poly_lift_hom R S \<phi> (p \<oplus>\<^bsub>P\<^esub> q) k = \<phi> ((p \<oplus>\<^bsub>P\<^esub> q) k)"
       using A assms poly_lift_hom_add[of S \<phi> p q] 
             poly_lift_hom_closed[of S \<phi> p] poly_lift_hom_closed[of S \<phi> q]   
            UP_ring.cfs_closed[of S "poly_lift_hom R S \<phi> q " k] UP_ring.cfs_closed[of S "poly_lift_hom R S \<phi> p" k] 
            UP_ring.cfs_add[of S "poly_lift_hom R S \<phi> p" "poly_lift_hom R S \<phi> q" k]       
       unfolding P_def UP_ring_def  
       by (metis (full_types) P_def cfs_add cfs_closed cring.axioms(1) ring_hom_add)
   qed
   show "\<And>a n. a \<in> carrier R \<Longrightarrow> poly_lift_hom R S \<phi> (monom P a n) k = \<phi> (monom P a n k)"
   proof- fix a m assume A: "a \<in> carrier R" 
     show "poly_lift_hom R S \<phi> (monom P a m) k = \<phi> (monom P a m k)"     
       apply(cases "m = k")
     using cfs_monom[of a m k] assms poly_lift_hom_monom[of S \<phi> a m] UP_ring.cfs_monom[of S "\<phi> a" m k] 
        unfolding P_def UP_ring_def  
        apply (simp add: A cring.axioms(1) ring_hom_closed)
            using cfs_monom[of a m k] assms poly_lift_hom_monom[of S \<phi> a m] UP_ring.cfs_monom[of S "\<phi> a" m k] 
        unfolding P_def UP_ring_def  
        by (metis A P_def R.ring_axioms cring.axioms(1) ring_hom_closed ring_hom_zero)     
   qed
 qed
 
 lemma(in ring) ring_hom_monom_term:
   assumes "a \<in> carrier R"
   assumes "c \<in> carrier R"
   assumes "ring S"
   assumes "h \<in> ring_hom R S"
   shows "h (a \<otimes> c[^](n::nat)) = h a \<otimes>\<^bsub>S\<^esub> (h c)[^]\<^bsub>S\<^esub>n"
   apply(induction n)
   using assms ringE(2) ring_hom_closed apply fastforce
   by (metis assms(1) assms(2) assms(3) assms(4) local.ring_axioms nat_pow_closed ring_hom_mult ring_hom_nat_pow)
 
 lemma(in UP_cring) poly_lift_hom_eval:
   assumes "cring S"
   assumes "\<phi> \<in> ring_hom R S"
   assumes "p \<in> carrier P"
   assumes "a \<in> carrier R"
   shows "UP_cring.to_fun  S (poly_lift_hom R S \<phi> p) (\<phi> a) = \<phi> (to_fun p a) "
   apply(rule poly_induct3[of p])
     apply (simp add: assms(3))
 proof-
   show "\<And>p q. q \<in> carrier P \<Longrightarrow>
            p \<in> carrier P \<Longrightarrow>
            UP_cring.to_fun S (poly_lift_hom R S \<phi> p) (\<phi> a) = \<phi> (to_fun p a) \<Longrightarrow>
            UP_cring.to_fun S (poly_lift_hom R S \<phi> q) (\<phi> a) = \<phi> (to_fun q a) \<Longrightarrow>
            UP_cring.to_fun S (poly_lift_hom R S \<phi> (p \<oplus>\<^bsub>P\<^esub> q)) (\<phi> a) = \<phi> (to_fun (p \<oplus>\<^bsub>P\<^esub> q) a)"
   proof- fix p q  assume A: "q \<in> carrier P"  "p \<in> carrier P"
            "UP_cring.to_fun S (poly_lift_hom R S \<phi> p) (\<phi> a) = \<phi> (to_fun p a)"
            "UP_cring.to_fun S (poly_lift_hom R S \<phi> q) (\<phi> a) = \<phi> (to_fun q a)"
     have "(poly_lift_hom R S \<phi> (p \<oplus>\<^bsub>P\<^esub> q)) = poly_lift_hom R S \<phi> p \<oplus>\<^bsub>UP S\<^esub> poly_lift_hom R S \<phi> q"
       using A(1) A(2) P_def assms(1) assms(2) poly_lift_hom_add by auto
     hence "UP_cring.to_fun S (poly_lift_hom R S \<phi> (p \<oplus>\<^bsub>P\<^esub> q)) (\<phi> a) = 
           UP_cring.to_fun S (poly_lift_hom R S \<phi> p) (\<phi> a) \<oplus>\<^bsub>S\<^esub> UP_cring.to_fun S (poly_lift_hom R S \<phi> q) (\<phi> a)"
       using UP_cring.to_fun_plus[of S] assms 
       unfolding UP_cring_def 
       by (metis (no_types, lifting) A(1) A(2) P_def poly_lift_hom_closed ring_hom_closed)
     thus "UP_cring.to_fun S (poly_lift_hom R S \<phi> (p \<oplus>\<^bsub>P\<^esub> q)) (\<phi> a) = \<phi> (to_fun (p \<oplus>\<^bsub>P\<^esub> q) a)"
       using A to_fun_plus assms ring_hom_add[of \<phi> R S]
         poly_lift_hom_closed[of S \<phi>]  UP_cring.to_fun_def[of S] to_fun_def
       unfolding P_def UP_cring_def 
       using UP_cring.to_fun_closed UP_cring_axioms 
       by metis 
   qed
   show "\<And>c n. c \<in> carrier R \<Longrightarrow> UP_cring.to_fun  S (poly_lift_hom R S \<phi> (monom P c n)) (\<phi> a) = \<phi> (to_fun (monom P c n) a)"
     unfolding P_def
   proof - fix c n assume A: "c \<in> carrier R"
     have 0: "\<phi> (a [^]\<^bsub>R\<^esub> (n::nat)) =  \<phi> a [^]\<^bsub>S\<^esub> n" 
       using assms ring_hom_nat_pow[of R S \<phi> a n] 
       unfolding cring_def 
       using R.ring_axioms by blast
     have 1: "\<phi> (c \<otimes>\<^bsub>R\<^esub> a [^]\<^bsub>R\<^esub> n) = \<phi> c \<otimes>\<^bsub>S\<^esub> \<phi> a [^]\<^bsub>S\<^esub> n"
       using ring_hom_mult[of \<phi> R S c "a [^]\<^bsub>R\<^esub> n" ] 0 assms A monoid.nat_pow_closed [of R a n]
       by (simp add: cring.axioms(1) ringE(2))
     show "UP_cring.to_fun  S (poly_lift_hom R S \<phi> (monom (UP R) c n)) (\<phi> a) = \<phi> (to_fun(monom (UP R) c n) a)"
       using assms A poly_lift_hom_monom[of S \<phi> c n] UP_cring.to_fun_monom[of S "\<phi> c" "\<phi> a" n]
            to_fun_monom[of c a n]  0 1 ring_hom_closed[of \<phi> R S] unfolding UP_cring_def
       by (simp add: P_def to_fun_def)      
   qed
 qed
 
 lemma(in UP_cring) poly_lift_hom_sub:
   assumes "cring S"
   assumes "\<phi> \<in> ring_hom R S"
   assumes "p \<in> carrier P"
   assumes "q \<in> carrier P"
   shows "poly_lift_hom R S \<phi> (compose R p q) = compose S (poly_lift_hom R S \<phi> p) (poly_lift_hom R S \<phi> q)"
   apply(rule poly_induct3[of p])
   apply (simp add: assms(3))
 proof-
   show " \<And>p qa.
        qa \<in> carrier P \<Longrightarrow>
        p \<in> carrier P \<Longrightarrow>
        poly_lift_hom R S \<phi> (Cring_Poly.compose R p q) = Cring_Poly.compose S (poly_lift_hom R S \<phi> p) (poly_lift_hom R S \<phi> q) \<Longrightarrow>
        poly_lift_hom R S \<phi> (Cring_Poly.compose R qa q) = Cring_Poly.compose S (poly_lift_hom R S \<phi> qa) (poly_lift_hom R S \<phi> q) \<Longrightarrow>
        poly_lift_hom R S \<phi> (Cring_Poly.compose R (p \<oplus>\<^bsub>P\<^esub> qa) q) = Cring_Poly.compose S (poly_lift_hom R S \<phi> (p \<oplus>\<^bsub>P\<^esub> qa)) (poly_lift_hom R S \<phi> q)"
   proof- fix a b assume A: "a \<in> carrier P"
        "b \<in> carrier P"
        "poly_lift_hom R S \<phi> (Cring_Poly.compose R a q) = Cring_Poly.compose S (poly_lift_hom R S \<phi> a) (poly_lift_hom R S \<phi> q)"
        "poly_lift_hom R S \<phi> (Cring_Poly.compose R b q) = Cring_Poly.compose S (poly_lift_hom R S \<phi> b) (poly_lift_hom R S \<phi> q)"
     show "poly_lift_hom R S \<phi> (Cring_Poly.compose R (a \<oplus>\<^bsub>P\<^esub> b) q) = Cring_Poly.compose S (poly_lift_hom R S \<phi> (a \<oplus>\<^bsub>P\<^esub> b)) (poly_lift_hom R S \<phi> q)"
       using assms UP_cring.sub_add[of R q a b ] UP_cring.sub_add[of S  ] 
       unfolding UP_cring_def 
       by (metis A(1) A(2) A(3) A(4) P_def R_cring UP_cring.sub_closed UP_cring_axioms poly_lift_hom_add poly_lift_hom_closed)
   qed
   show "\<And>a n. a \<in> carrier R \<Longrightarrow>
            poly_lift_hom R S \<phi> (Cring_Poly.compose R (monom P a n) q) = 
             Cring_Poly.compose S (poly_lift_hom R S \<phi> (monom P a n)) (poly_lift_hom R S \<phi> q)"
   proof-
     fix a n assume A: "a \<in> carrier R"
     have 0: "(poly_lift_hom R S \<phi> (monom (UP R) a n)) = monom (UP S) (\<phi> a) n"
       by (simp add: A assms(1) assms(2) assms(3) assms(4) poly_lift_hom_monom)
     have 1: " q [^]\<^bsub>UP R\<^esub> n \<in> carrier (UP R)"
       using monoid.nat_pow_closed[of "UP R" q n] UP_ring.UP_ring UP_ring.intro assms(1) assms
             P.monoid_axioms P_def by blast
     have 2: "poly_lift_hom R S \<phi> (to_polynomial R a \<otimes>\<^bsub>UP R\<^esub> q [^]\<^bsub>UP R\<^esub> n) = 
             to_polynomial S (\<phi> a) \<otimes>\<^bsub>UP S\<^esub> (poly_lift_hom R S \<phi> q) [^]\<^bsub>UP S\<^esub> n"
       using poly_lift_hom_mult[of S \<phi> "to_polynomial R a" "q [^]\<^bsub>UP R\<^esub> n"] poly_lift_hom_is_hom[of S \<phi>]
             ring_hom_nat_pow[of P "UP S" "poly_lift_hom R S \<phi>" q n]   UP_cring.UP_cring[of S]
             UP_cring poly_lift_hom_monom[of S \<phi> a 0] ring_hom_closed[of \<phi> R S a] 
             monom_closed[of a 0] nat_pow_closed[of q n] assms A
       unfolding to_polynomial_def P_def UP_cring_def cring_def
       by auto 
     have 3: "poly_lift_hom R S \<phi> (Cring_Poly.compose R (monom (UP R) a n) q) = to_polynomial S (\<phi> a) \<otimes>\<^bsub>UP S\<^esub> (poly_lift_hom R S \<phi> q) [^]\<^bsub>UP S\<^esub> n"
       using "2" A P_def assms(4) sub_monom(1) by auto      
     have 4: "Cring_Poly.compose S (poly_lift_hom R S \<phi> (monom (UP R) a n)) (poly_lift_hom R S \<phi> q) 
                               = Cring_Poly.compose S (monom (UP S) (\<phi> a) n) (poly_lift_hom R S \<phi> q)"
       by (simp add: "0")    
     have "poly_lift_hom R S \<phi> q \<in> carrier (UP S)"
       using P_def UP_cring.poly_lift_hom_closed UP_cring_axioms assms(1) assms(2) assms(4) by blast
     then have 5: "Cring_Poly.compose S (poly_lift_hom R S \<phi> (monom (UP R) a n)) (poly_lift_hom R S \<phi> q)
                               = to_polynomial S (\<phi> a) \<otimes>\<^bsub>UP S\<^esub> (poly_lift_hom R S \<phi> q) [^]\<^bsub>UP S\<^esub> n"
       using 4 UP_cring.sub_monom[of S "poly_lift_hom R S \<phi> q" "\<phi> a" n] assms 
       unfolding UP_cring_def  
       by (simp add: A ring_hom_closed)
     thus "poly_lift_hom R S \<phi> (Cring_Poly.compose R (monom P a n) q) = 
             Cring_Poly.compose S (poly_lift_hom R S \<phi> (monom P a n)) (poly_lift_hom R S \<phi> q)"
       using 0 1 2 3 4 assms A 
       by (simp add: P_def)
   qed
 qed
 
 lemma(in UP_cring) poly_lift_hom_comm_taylor_expansion:
   assumes "cring S"
   assumes "\<phi> \<in> ring_hom R S"
   assumes "p \<in> carrier P"
   assumes "a \<in> carrier R"
   shows "poly_lift_hom R S \<phi> (taylor_expansion R a p) = taylor_expansion S (\<phi> a) (poly_lift_hom R S \<phi> p)"
   unfolding taylor_expansion_def 
   using  poly_lift_hom_sub[of S \<phi> p "(X_poly_plus R a)"] poly_lift_hom_X_plus[of S \<phi> a] assms 
   by (simp add: P_def UP_cring.X_plus_closed UP_cring_axioms)
  
 lemma(in UP_cring) poly_lift_hom_comm_taylor_expansion_cf:
   assumes "cring S"
   assumes "\<phi> \<in> ring_hom R S"
   assumes "p \<in> carrier (UP R)"
   assumes "a \<in> carrier R"
   shows "\<phi> (taylor_expansion R a p i) = taylor_expansion S (\<phi> a) (poly_lift_hom R S \<phi> p) i"
   using poly_lift_hom_cf assms poly_lift_hom_comm_taylor_expansion P_def 
         taylor_def UP_cring.taylor_closed UP_cring_axioms by fastforce
   
 lemma(in UP_cring) taylor_expansion_cf_closed:
   assumes "p \<in> carrier P"
   assumes "a \<in> carrier R"
   shows "taylor_expansion R a p i \<in> carrier R"
   using assms taylor_closed
   by (simp add: taylor_def cfs_closed)
 
 lemma(in UP_cring) poly_lift_hom_comm_taylor_term:
   assumes "cring S"
   assumes "\<phi> \<in> ring_hom R S"
   assumes "p \<in> carrier (UP R)"
   assumes "a \<in> carrier R"
   shows "poly_lift_hom R S \<phi> (taylor_term a p i) = UP_cring.taylor_term S (\<phi> a) (poly_lift_hom R S \<phi> p) i"
   using poly_lift_hom_X_minus_nat_pow_smult[of S \<phi> a "taylor_expansion R a p i" i] 
         poly_lift_hom_comm_taylor_expansion[of S \<phi> p a]
         poly_lift_hom_comm_taylor_expansion_cf[of S \<phi> p a i]
         assms UP_cring.taylor_term_def[of S]
     unfolding taylor_term_def UP_cring_def P_def
   by (simp add: UP_cring.taylor_expansion_cf_closed UP_cring_axioms) 
 
 lemma(in UP_cring) poly_lift_hom_degree_bound:
   assumes "cring S"
   assumes "h \<in> ring_hom R S"
   assumes "f \<in> carrier (UP R)"
   shows "deg S (poly_lift_hom R S h f) \<le> deg R f"
     using poly_lift_hom_closed[of S h f]  UP_cring.deg_leqI[of S "poly_lift_hom R S h f" "deg R f"] assms ring_hom_zero[of h R S] deg_aboveD[of f] coeff_simp[of f]
     unfolding P_def UP_cring_def
     by (simp add: P_def R.ring_axioms cring.axioms(1) poly_lift_hom_cf)
 
 lemma(in UP_cring) deg_eqI:
   assumes "f \<in> carrier (UP R)"
   assumes "deg R f \<le> n"
   assumes "f n \<noteq> \<zero>"
   shows "deg R f = n"
   using assms coeff_simp[of f] P_def deg_leE le_neq_implies_less by blast
 
 lemma(in UP_cring) poly_lift_hom_degree_eq:
   assumes "cring S"
   assumes "h \<in> ring_hom R S"
   assumes "h (lcf f) \<noteq> \<zero>\<^bsub>S\<^esub>"
   assumes "f \<in> carrier (UP R)"
   shows "deg S (poly_lift_hom R S h f) = deg R f"
   apply(rule UP_cring.deg_eqI)
   using assms unfolding UP_cring_def apply blast
   using poly_lift_hom_closed[of S h f] assms apply blast 
   using poly_lift_hom_degree_bound[of S h f] assms apply blast 
   using assms poly_lift_hom_cf[of S h f] 
   by (metis P_def)
 
 lemma(in UP_cring) poly_lift_hom_lcoeff:
   assumes "cring S"
   assumes "h \<in> ring_hom R S"
   assumes "h (lcf f) \<noteq> \<zero>\<^bsub>S\<^esub>"
   assumes "f \<in> carrier (UP R)"
   shows "UP_ring.lcf S (poly_lift_hom R S h f) = h (lcf f)"
   using poly_lift_hom_degree_eq[of S h f] assms 
   by (simp add: P_def poly_lift_hom_cf)
 
 end 
 
 (**************************************************************************************************)
 (**************************************************************************************************)
 section\<open>Coefficient List Constructor for Polynomials\<close>
 (**************************************************************************************************)
 (**************************************************************************************************)
 
 definition list_to_poly where
 "list_to_poly R as n = (if n < length as then as!n else \<zero>\<^bsub>R\<^esub>)"
 
 context UP_ring
 begin
 
 lemma(in UP_ring) list_to_poly_closed:
   assumes "set as \<subseteq> carrier R"
   shows "list_to_poly R as \<in> carrier P"
   apply(rule UP_car_memI[of "length as"])
   apply (simp add: list_to_poly_def)
   by (metis R.zero_closed assms in_mono list_to_poly_def nth_mem)
 
 lemma(in UP_ring) list_to_poly_zero[simp]:
 "list_to_poly R [] = \<zero>\<^bsub>UP R\<^esub>"
   unfolding list_to_poly_def 
   apply auto 
   by(simp add: UP_def)   
 
 lemma(in UP_domain) list_to_poly_singleton:
   assumes "a \<in> carrier R"
   shows "list_to_poly R [a] = monom P a 0"
   apply(rule ext)
   unfolding list_to_poly_def using assms 
   by (simp add: cfs_monom)
 end 
 
 definition cf_list where 
 "cf_list R p = map p [(0::nat)..< Suc (deg R p)]"
 
 lemma cf_list_length:
 "length (cf_list R p) = Suc (deg R p)"
   unfolding cf_list_def 
   by simp
 
 lemma cf_list_entries:
   assumes "i \<le> deg R p"
   shows "(cf_list R p)!i = p i"
   unfolding cf_list_def 
   by (metis add.left_neutral assms diff_zero less_Suc_eq_le map_eq_map_tailrec nth_map_upt)
   
 lemma(in UP_ring) list_to_poly_cf_list_inv:
   assumes "p \<in> carrier (UP R)"
   shows "list_to_poly R (cf_list R p) = p"
 proof
   fix x 
   show "list_to_poly R (cf_list R p) x = p x"
     apply(cases "x < degree p")
     unfolding list_to_poly_def 
     using assms cf_list_length[of R p] cf_list_entries[of _ R p]
      apply simp
     by (metis P_def UP_ring.coeff_simp UP_ring_axioms \<open>\<And>i. i \<le> deg R p \<Longrightarrow> cf_list R p ! i = p i\<close> \<open>length (cf_list R p) = Suc (deg R p)\<close> assms deg_belowI less_Suc_eq_le)
 qed
 
 section\<open>Polynomial Rings over a Subring\<close>
 
 subsection\<open>Characterizing the Carrier of a Polynomial Ring over a Subring\<close>
 lemma(in ring) carrier_update: 
 "carrier (R\<lparr>carrier := S\<rparr>) = S"
 "\<zero>\<^bsub>(R\<lparr>carrier := S\<rparr>)\<^esub> = \<zero>"
 "\<one>\<^bsub>(R\<lparr>carrier := S\<rparr>)\<^esub> = \<one>"
 "(\<oplus>\<^bsub>(R\<lparr>carrier := S\<rparr>)\<^esub>) = (\<oplus>)"
 "(\<otimes>\<^bsub>(R\<lparr>carrier := S\<rparr>)\<^esub>) = (\<otimes>)"
 by auto 
 
 
 lemma(in UP_cring) poly_cfs_subring:
   assumes "subring S R"
   assumes "g \<in> carrier (UP R)"
   assumes "\<And>n. g n \<in> S"
   shows "g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
   apply(rule UP_cring.UP_car_memI')
   using R.subcringI' R.subcring_iff UP_cring.intro assms(1) subringE(1) apply blast
 proof-
   have "carrier (R\<lparr>carrier := S\<rparr>) = S"
     using ring.carrier_update  by simp
   then show 0: "\<And>x. g x \<in> carrier (R\<lparr>carrier := S\<rparr>)"
     using assms by blast
   have 0: "\<zero>\<^bsub>R\<lparr>carrier := S\<rparr>\<^esub> = \<zero>"
     using R.carrier_update(2) by blast
   then show "\<And>x. (deg R g) < x \<Longrightarrow> g x = \<zero>\<^bsub>R\<lparr>carrier := S\<rparr>\<^esub>"
     using UP_car_memE assms(2) by presburger
 qed
 
 lemma(in UP_cring) UP_ring_subring:
   assumes "subring S R"
   shows "UP_cring (R \<lparr> carrier := S \<rparr>)"  "UP_ring (R \<lparr> carrier := S \<rparr>)"
   using assms unfolding UP_cring_def 
   using R.subcringI' R.subcring_iff subringE(1) apply blast  
   using assms unfolding UP_ring_def 
   using R.subcringI' R.subcring_iff subringE(1)  
   by (simp add: R.subring_is_ring)
   
 lemma(in UP_cring) UP_ring_subring_is_ring:
   assumes "subring S R"
   shows "cring (UP (R \<lparr> carrier := S \<rparr>))"
   using assms UP_ring_subring[of S] UP_cring.UP_cring[of "R\<lparr>carrier := S\<rparr>"] 
   by blast
   
 lemma(in UP_cring) UP_ring_subring_add_closed:
   assumes "subring S R"
   assumes "g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
   assumes "f \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
   shows "f \<oplus>\<^bsub>UP (R \<lparr> carrier := S \<rparr>)\<^esub>g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
   using assms UP_ring_subring_is_ring[of S] 
   by (meson cring.cring_simprules(1))
 
 lemma(in UP_cring) UP_ring_subring_mult_closed:
   assumes "subring S R"
   assumes "g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
   assumes "f \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
   shows "f \<otimes>\<^bsub>UP (R \<lparr> carrier := S \<rparr>)\<^esub>g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
   using assms UP_ring_subring_is_ring[of S] 
   by (meson cring.carrier_is_subcring subcringE(6))
 
 lemma(in UP_cring) UP_ring_subring_car:
   assumes "subring S R"
   shows "carrier (UP (R \<lparr> carrier := S \<rparr>)) = {h \<in> carrier (UP R). \<forall>n. h n \<in> S}"
 proof
   show "carrier (UP (R\<lparr>carrier := S\<rparr>)) \<subseteq> {h \<in> carrier (UP R). \<forall>n. h n \<in> S}"
   proof
     fix h assume A: "h \<in> carrier (UP (R\<lparr>carrier := S\<rparr>))"
     have "h \<in> carrier P"
       apply(rule UP_car_memI[of "deg (R\<lparr>carrier := S\<rparr>) h"]) unfolding P_def 
       using UP_cring.UP_car_memE[of "R\<lparr>carrier := S\<rparr>" h] R.carrier_update[of S]
             assms UP_ring_subring A apply presburger
       using UP_cring.UP_car_memE[of "R\<lparr>carrier := S\<rparr>" h] assms 
       by (metis A R.ring_axioms UP_cring_def \<open>carrier (R\<lparr>carrier := S\<rparr>) = S\<close> cring.subcringI' is_UP_cring ring.subcring_iff subringE(1) subsetD)
     then show "h \<in> {h \<in> carrier (UP R). \<forall>n. h n \<in> S}"
       unfolding P_def 
       using assms A  UP_cring.UP_car_memE[of "R\<lparr>carrier := S\<rparr>" h] R.carrier_update[of S]
       UP_ring_subring by blast
   qed
   show "{h \<in> carrier (UP R). \<forall>n. h n \<in> S} \<subseteq> carrier (UP (R\<lparr>carrier := S\<rparr>))"
   proof fix h assume A: "h \<in> {h \<in> carrier (UP R). \<forall>n. h n \<in> S}"
     have 0: "h \<in> carrier (UP R)"
       using A by blast 
     have 1: "\<And>n. h n \<in> S"
       using A by blast 
     show "h \<in> carrier (UP (R\<lparr>carrier := S\<rparr>))"
       apply(rule UP_ring.UP_car_memI[of _ "deg R h"])
       using assms UP_ring_subring[of S] UP_cring.axioms UP_ring.intro cring.axioms(1) apply blast
       using UP_car_memE[of h] carrier_update 0 R.carrier_update(2) apply presburger
       using assms 1  R.carrier_update(1) by blast
   qed
 qed
 
 lemma(in UP_cring) UP_ring_subring_car_subset:
   assumes "subring S R"
   shows "carrier (UP (R \<lparr> carrier := S \<rparr>)) \<subseteq> carrier (UP R)"
 proof fix h assume "h \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
   then show "h \<in> carrier (UP R)"
   using assms UP_ring_subring_car[of S] by blast
 qed
 
 lemma(in UP_cring) UP_ring_subring_car_subset':
   assumes "subring S R"
   assumes "h \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
   shows "h \<in>  carrier (UP R)"
   using assms UP_ring_subring_car_subset[of S] by blast 
 
 lemma(in UP_cring) UP_ring_subring_add:
   assumes "subring S R"
   assumes "g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
   assumes "f \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
   shows "g \<oplus>\<^bsub>UP R\<^esub> f = g \<oplus>\<^bsub>UP (R \<lparr> carrier := S \<rparr>)\<^esub>f"
 proof(rule ext) fix x show "(g \<oplus>\<^bsub>UP R\<^esub> f) x = (g \<oplus>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> f) x"
   proof-
     have 0: " (g \<oplus>\<^bsub>P\<^esub> f) x = g x \<oplus> f x"
       using assms cfs_add[of g f x] unfolding P_def 
       using UP_ring_subring_car_subset' by blast
     have 1: "(g \<oplus>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> f) x = g x \<oplus>\<^bsub>R\<lparr>carrier := S\<rparr>\<^esub> f x"
       using   UP_ring.cfs_add[of "R \<lparr> carrier := S \<rparr>" g f x] UP_ring_subring[of S] assms 
       unfolding UP_ring_def UP_cring_def 
       using R.subring_is_ring by blast
     show ?thesis using 0 1  R.carrier_update(4)[of S]  
     by (simp add: P_def)
   qed
 qed
 
 lemma(in UP_cring) UP_ring_subring_deg:
   assumes "subring S R"
   assumes "g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
   shows "deg R g = deg (R \<lparr> carrier := S \<rparr>) g"
 proof-
   have 0: "g \<in> carrier (UP R)"
     using assms UP_ring_subring_car[of S] by blast
   have 1: "deg R g \<le> deg (R \<lparr> carrier := S \<rparr>) g"
     using 0 assms UP_cring.UP_car_memE[of "R \<lparr> carrier := S \<rparr>" g]
              UP_car_memE[of g] P_def R.carrier_update(2) UP_ring_subring deg_leqI by presburger
   have 2: "deg (R \<lparr> carrier := S \<rparr>) g \<le> deg R g"
     using 0 assms UP_cring.UP_car_memE[of "R \<lparr> carrier := S \<rparr>" g]
              UP_car_memE[of g] P_def R.carrier_update(2) UP_ring_subring UP_cring.deg_leqI 
     by metis 
 
   show ?thesis using 1 2 by presburger 
 qed
 
 
 lemma(in UP_cring) UP_subring_monom:
   assumes "subring S R"
   assumes "a \<in> S"
   shows "up_ring.monom (UP R) a n = up_ring.monom (UP (R \<lparr> carrier := S \<rparr>)) a n"
 proof fix x
   have 0: "a \<in> carrier R"
     using assms subringE(1)  by blast
   have 1: "a \<in> carrier (R\<lparr>carrier := S\<rparr>)"
     using assms  by (simp add: assms(2))
   have 2: " up_ring.monom (UP (R\<lparr>carrier := S\<rparr>)) a n x = (if n = x then a else \<zero>\<^bsub>R\<lparr>carrier := S\<rparr>\<^esub>)"
     using 1  assms UP_ring_subring[of S] UP_ring.cfs_monom[of "R\<lparr>carrier := S\<rparr>" a n x] UP_cring.axioms UP_ring.intro cring.axioms(1) 
     by blast
   show "up_ring.monom (UP R) a n x = up_ring.monom (UP (R\<lparr>carrier := S\<rparr>)) a n x"
     using 0 1 2 cfs_monom[of a n x]  R.carrier_update(2)[of S] unfolding P_def by presburger
 qed
 
 lemma(in UP_cring) UP_ring_subring_mult:
   assumes "subring S R"
   assumes "g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
   assumes "f \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
   shows "g \<otimes>\<^bsub>UP R\<^esub> f = g \<otimes>\<^bsub>UP (R \<lparr> carrier := S \<rparr>)\<^esub>f"
 proof(rule UP_ring.poly_induct3[of "R \<lparr> carrier := S \<rparr>" f])
   show "UP_ring (R\<lparr>carrier := S\<rparr>)"
     by (simp add: UP_ring_subring(2) assms(1))
   show " f \<in> carrier (UP (R\<lparr>carrier := S\<rparr>))"
     by (simp add: assms(3))
   show " \<And>p q. q \<in> carrier (UP (R\<lparr>carrier := S\<rparr>)) \<Longrightarrow>
            p \<in> carrier (UP (R\<lparr>carrier := S\<rparr>)) \<Longrightarrow>
            g \<otimes>\<^bsub>UP R\<^esub> p = g \<otimes>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> p \<Longrightarrow>
            g \<otimes>\<^bsub>UP R\<^esub> q = g \<otimes>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> q \<Longrightarrow> g \<otimes>\<^bsub>UP R\<^esub> (p \<oplus>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> q) = g \<otimes>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> (p \<oplus>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> q)"
   proof- fix p q 
     assume A: " q \<in> carrier (UP (R\<lparr>carrier := S\<rparr>))"
            "p \<in> carrier (UP (R\<lparr>carrier := S\<rparr>))"
            "g \<otimes>\<^bsub>UP R\<^esub> p = g \<otimes>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> p"
            "g \<otimes>\<^bsub>UP R\<^esub> q = g \<otimes>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> q"
     have 0: "p \<oplus>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> q = p \<oplus>\<^bsub>UP R\<^esub> q"
       using A UP_ring_subring_add[of S p q] 
       by (simp add: assms(1))
     have 1: "g \<otimes>\<^bsub>UP R\<^esub> (p \<oplus>\<^bsub>UP R\<^esub> q) = g \<otimes>\<^bsub>UP R\<^esub> p \<oplus>\<^bsub>UP R\<^esub> g \<otimes>\<^bsub>UP R\<^esub> q"
       using 0 A assms  P.r_distr P_def UP_ring_subring_car_subset' by auto
     hence 2:"g \<otimes>\<^bsub>UP R\<^esub> (p \<oplus>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> q) = g \<otimes>\<^bsub>UP R\<^esub> p \<oplus>\<^bsub>UP R\<^esub> g \<otimes>\<^bsub>UP R\<^esub> q"
       using 0 by simp
     have 3: "g \<otimes>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> (p \<oplus>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> q) =
           g \<otimes>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> p \<oplus>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> g \<otimes>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> q"
       using 0 A assms semiring.r_distr[of "UP (R\<lparr>carrier := S\<rparr>)"]  UP_ring_subring_car_subset' 
       using UP_ring.UP_r_distr \<open>UP_ring (R\<lparr>carrier := S\<rparr>)\<close> by blast
     hence 4: "g \<otimes>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> (p \<oplus>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> q) =
           g \<otimes>\<^bsub>UP R\<^esub> p \<oplus>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> g \<otimes>\<^bsub>UP R\<^esub> q"
       using A by simp 
     hence 5: "g \<otimes>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> (p \<oplus>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> q) =
           g \<otimes>\<^bsub>UP R\<^esub> p \<oplus>\<^bsub>UP R\<^esub> g \<otimes>\<^bsub>UP R\<^esub> q"
       using UP_ring_subring_add[of S]
       by (simp add: A(1) A(2) A(3) A(4) UP_ring.UP_mult_closed \<open>UP_ring (R\<lparr>carrier := S\<rparr>)\<close> assms(1) assms(2))
     show "g \<otimes>\<^bsub>UP R\<^esub> (p \<oplus>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> q) = g \<otimes>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> (p \<oplus>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> q)"
       by (simp add: "2" "5")
   qed
   show "\<And>a n. a \<in> carrier (R\<lparr>carrier := S\<rparr>) \<Longrightarrow> g \<otimes>\<^bsub>UP R\<^esub> monom (UP (R\<lparr>carrier := S\<rparr>)) a n = g \<otimes>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> monom (UP (R\<lparr>carrier := S\<rparr>)) a n"
   proof fix a n x assume A: "a \<in> carrier (R\<lparr>carrier := S\<rparr>)"
     have 0: "monom (UP (R\<lparr>carrier := S\<rparr>)) a n = monom (UP R) a n"
       using A UP_subring_monom assms(1) by auto
     have 1: "g \<in> carrier (UP R)"
       using assms UP_ring_subring_car_subset' by blast
     have 2: "a \<in> carrier R"
       using A assms subringE(1)[of S R] R.carrier_update[of S] by blast       
     show "(g \<otimes>\<^bsub>UP R\<^esub> monom (UP (R\<lparr>carrier := S\<rparr>)) a n) x = (g \<otimes>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> monom (UP (R\<lparr>carrier := S\<rparr>)) a n) x"
     proof(cases "x < n")
       case True
       have T0: "(g \<otimes>\<^bsub>UP R\<^esub> monom (UP R) a n) x = \<zero>" 
         using 1 2 True cfs_monom_mult[of g a x n] A assms unfolding P_def  by blast
       then show ?thesis using UP_cring.cfs_monom_mult[of "R\<lparr>carrier := S\<rparr>" g a x n] 0 A True 
           UP_ring_subring(1) assms(1) assms(2) by auto
     next
       case False
       have F0: "(g \<otimes>\<^bsub>UP R\<^esub> monom (UP R) a n) x = a \<otimes> (g (x - n))" 
         using 1 2 False cfs_monom_mult_l[of g a n "x - n"] A assms unfolding P_def by simp
       have F1: "(g \<otimes>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> monom (UP (R\<lparr>carrier := S\<rparr>)) a n) (x - n + n) = a \<otimes>\<^bsub>R\<lparr>carrier := S\<rparr>\<^esub> g (x - n)" 
         using 1 2 False UP_cring.cfs_monom_mult_l[of "R\<lparr>carrier := S\<rparr>" g a n "x - n"] A assms 
               UP_ring_subring(1) by blast
       hence F2: "(g \<otimes>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> monom (UP R) a n) (x - n + n) = a \<otimes> g (x - n)" 
         using UP_subring_monom[of S a n] R.carrier_update[of S] assms 0 by metis         
       show ?thesis using F0 F1 1 2 assms 
         by (simp add: "0" False add.commute add_diff_inverse_nat)
     qed
   qed
 qed
 
 lemma(in UP_cring) UP_ring_subring_one:
   assumes "subring S R"
   shows "\<one>\<^bsub>UP R\<^esub> = \<one>\<^bsub>UP (R \<lparr> carrier := S \<rparr>)\<^esub>"
   using UP_subring_monom[of S \<one> 0] assms P_def R.subcringI' UP_ring.monom_one UP_ring_subring(2) monom_one subcringE(3) by force
 
 lemma(in UP_cring) UP_ring_subring_zero:
   assumes "subring S R"
   shows "\<zero>\<^bsub>UP R\<^esub> = \<zero>\<^bsub>UP (R \<lparr> carrier := S \<rparr>)\<^esub>"
   using UP_subring_monom[of S \<zero> 0] UP_ring.monom_zero[of "R \<lparr> carrier := S \<rparr>" 0]  assms monom_zero[of 0]
   UP_ring_subring[of S] subringE(2)[of S R]
   unfolding P_def  
   by (simp add: P_def R.carrier_update(2))
 
 lemma(in UP_cring) UP_ring_subring_nat_pow:
   assumes "subring S R"
   assumes "g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
   shows "g[^]\<^bsub>UP R\<^esub>n = g[^]\<^bsub>UP (R \<lparr> carrier := S \<rparr>)\<^esub>(n::nat)"
   apply(induction n)
   using assms apply (simp add: UP_ring_subring_one)
 proof-
   fix n::nat
   assume A: "g [^]\<^bsub>UP R\<^esub> n = g [^]\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> n"
   have "Group.monoid (UP (R\<lparr>carrier := S\<rparr>)) "
     using assms UP_ring_subring[of S] UP_ring.UP_ring[of "R\<lparr>carrier := S\<rparr>"] ring.is_monoid by blast
   hence 0 : " g [^]\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> n \<in> carrier (UP (R\<lparr>carrier := S\<rparr>))"
     using monoid.nat_pow_closed[of "UP (R \<lparr> carrier := S \<rparr>)" g n] assms UP_ring_subring
     unfolding UP_ring_def ring_def by blast
   have 1: "g [^]\<^bsub>UP R\<^esub> n \<in> carrier (UP R)"
     using 0 assms UP_ring_subring_car_subset'[of S] by (simp add: A)
   then have 2: "g [^]\<^bsub>UP R\<^esub> n \<otimes>\<^bsub>UP R\<^esub> g = g [^]\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> n \<otimes>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> g"
     using assms UP_ring_subring_mult[of S "g [^]\<^bsub>UP R\<^esub> n" g] 
     by (simp add: "0" A)
   then show "g [^]\<^bsub>UP R\<^esub> Suc n = g [^]\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> Suc n" 
     by simp
 qed
 
 lemma(in UP_cring) UP_subring_compose_monom:
   assumes "subring S R"
   assumes "g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
   assumes "a \<in> S"
   shows "compose R (up_ring.monom (UP R) a n) g = compose (R \<lparr> carrier := S \<rparr>) (up_ring.monom (UP (R \<lparr> carrier := S \<rparr>)) a n) g"
 proof-
   have g_closed: "g \<in> carrier (UP R)"
     using assms UP_ring_subring_car by blast
   have 0: "a \<in> carrier R"
     using assms subringE(1) by blast  
   have 1: "compose R (up_ring.monom (UP R) a n) g = a \<odot>\<^bsub>UP R\<^esub> (g[^]\<^bsub>UP R\<^esub>n)"
     using monom_sub[of a g n] unfolding P_def 
     using "0" assms(2) g_closed by blast
   have 2: "compose (R\<lparr>carrier := S\<rparr>) (up_ring.monom (UP (R\<lparr>carrier := S\<rparr>)) a n) g = a \<odot>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> g [^]\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> n"
     using assms UP_cring.monom_sub[of "R \<lparr> carrier := S \<rparr>" a g n] UP_ring_subring[of S] R.carrier_update[of S]
     by blast
   have 3: " g [^]\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> n = g[^]\<^bsub>UP R\<^esub>n"
     using UP_ring_subring_nat_pow[of S g n] 
     by (simp add: assms(1) assms(2))
   have 4: "a \<odot>\<^bsub>UP R\<^esub> (g[^]\<^bsub>UP R\<^esub>n) = a \<odot>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> g [^]\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> n"
   proof fix x  
     show "(a \<odot>\<^bsub>UP R\<^esub> g [^]\<^bsub>UP R\<^esub> n) x = (a \<odot>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> g [^]\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> n) x"
     proof-
       have LHS: "(a \<odot>\<^bsub>UP R\<^esub> g [^]\<^bsub>UP R\<^esub> n) x = a \<otimes> ((g [^]\<^bsub>UP R\<^esub> n) x)"
         using "0" P.nat_pow_closed P_def cfs_smult g_closed by auto
       have RHS: "(a \<odot>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> g [^]\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> n) x = a \<otimes>\<^bsub>R\<lparr>carrier := S\<rparr>\<^esub> ((g [^]\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> n) x)"
       proof-
         have "Group.monoid (UP (R\<lparr>carrier := S\<rparr>)) "
           using assms UP_ring_subring[of S] UP_ring.UP_ring[of "R\<lparr>carrier := S\<rparr>"] ring.is_monoid by blast
         hence 0 : " g [^]\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> n \<in> carrier (UP (R\<lparr>carrier := S\<rparr>))"
           using monoid.nat_pow_closed[of "UP (R \<lparr> carrier := S \<rparr>)" g n] assms UP_ring_subring
           unfolding UP_ring_def ring_def by blast
         have 1: "g [^]\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> n \<in> carrier (UP (R\<lparr>carrier := S\<rparr>))"
           using assms UP_ring_subring[of S] R.carrier_update[of S] 0 by blast
         then show ?thesis using UP_ring.cfs_smult UP_ring_subring assms 
           by (simp add: UP_ring.cfs_smult)
       qed
       show ?thesis using R.carrier_update RHS LHS 3 assms  
         by simp
     qed
   qed
   show ?thesis using 0 1 2 3 4 
     by simp
 qed
 
 lemma(in UP_cring) UP_subring_compose:
   assumes "subring S R"
   assumes "g \<in> carrier (UP R)"
   assumes "f \<in> carrier (UP R)"
   assumes "\<And>n. g n \<in> S"
   assumes "\<And>n. f n \<in> S"
   shows "compose R f g = compose (R \<lparr> carrier := S \<rparr>) f g"
 proof-
   have g_closed: "g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
     using assms poly_cfs_subring by blast
   have 0: "\<And>n. (\<forall> h. h \<in> carrier (UP R) \<and> deg R h \<le> n \<and> h \<in> carrier (UP (R \<lparr> carrier := S \<rparr>)) \<longrightarrow> compose R h g = compose (R \<lparr> carrier := S \<rparr>) h g)"
   proof-  fix n show "(\<forall> h. h \<in> carrier (UP R) \<and> deg R h \<le> n \<and> h \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))   \<longrightarrow> compose R h g = compose (R \<lparr> carrier := S \<rparr>) h g)"
     proof(induction n)
       show "\<forall>h. h \<in> carrier (UP R) \<and> deg R h \<le> 0 \<and> h \<in> carrier (UP (R\<lparr>carrier := S\<rparr>)) \<longrightarrow> Cring_Poly.compose R h g = Cring_Poly.compose (R\<lparr>carrier := S\<rparr>) h g"
       proof fix h 
         show "h \<in> carrier (UP R) \<and> deg R h \<le> 0 \<and> h \<in> carrier (UP (R\<lparr>carrier := S\<rparr>)) \<longrightarrow> Cring_Poly.compose R h g = Cring_Poly.compose (R\<lparr>carrier := S\<rparr>) h g"
         proof
           assume A: "h \<in> carrier (UP R) \<and> deg R h \<le> 0 \<and> h \<in> carrier (UP (R\<lparr>carrier := S\<rparr>))"
           then have 0: "deg R h = 0"
             by linarith 
           then have 1: "deg (R \<lparr> carrier := S \<rparr>) h = 0"
             using A assms UP_ring_subring_deg[of S h] 
             by linarith
           show "Cring_Poly.compose R h g = Cring_Poly.compose (R\<lparr>carrier := S\<rparr>) h g"
             using 0 1 g_closed assms sub_const[of g h] UP_cring.sub_const[of "R\<lparr>carrier := S\<rparr>" g h] A P_def UP_ring_subring
             by presburger
         qed
       qed
       show "\<And>n. \<forall>h. h \<in> carrier (UP R) \<and> deg R h \<le> n \<and> h \<in> carrier (UP (R\<lparr>carrier := S\<rparr>)) \<longrightarrow>
              Cring_Poly.compose R h g = Cring_Poly.compose (R\<lparr>carrier := S\<rparr>) h g \<Longrightarrow>
          \<forall>h. h \<in> carrier (UP R) \<and> deg R h \<le> Suc n \<and> h \<in> carrier (UP (R\<lparr>carrier := S\<rparr>)) \<longrightarrow>
              Cring_Poly.compose R h g = Cring_Poly.compose (R\<lparr>carrier := S\<rparr>) h g"
       proof fix n h 
         assume IH: "\<forall>h. h \<in> carrier (UP R) \<and> deg R h \<le> n \<and> h \<in> carrier (UP (R\<lparr>carrier := S\<rparr>)) \<longrightarrow>
                Cring_Poly.compose R h g = Cring_Poly.compose (R\<lparr>carrier := S\<rparr>) h g"
         show "h \<in> carrier (UP R) \<and> deg R h \<le> Suc n \<and> h \<in> carrier (UP (R\<lparr>carrier := S\<rparr>)) \<longrightarrow>
            Cring_Poly.compose R h g = Cring_Poly.compose (R\<lparr>carrier := S\<rparr>) h g"
         proof assume A: "h \<in> carrier (UP R) \<and> deg R h \<le> Suc n \<and> h \<in> carrier (UP (R\<lparr>carrier := S\<rparr>))"
           show "Cring_Poly.compose R h g = Cring_Poly.compose (R\<lparr>carrier := S\<rparr>) h g"
           proof(cases "deg R h \<le> n")
             case True
             then show ?thesis using A IH by blast
           next
             case False
             then have F0: "deg R h = Suc n"
               using A by (simp add: A le_Suc_eq)
             then have F1: "deg (R\<lparr>carrier := S\<rparr>) h = Suc n"
               using UP_ring_subring_deg[of S h] A  
               by (simp add: \<open>h \<in> carrier (UP R) \<and> deg R h \<le> Suc n \<and> h \<in> carrier (UP (R\<lparr>carrier := S\<rparr>))\<close> assms(1))
             obtain j where j_def: "j \<in> carrier (UP (R\<lparr>carrier := S\<rparr>)) \<and>
           h = j \<oplus>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> up_ring.monom (UP (R\<lparr>carrier := S\<rparr>)) (h (deg (R\<lparr>carrier := S\<rparr>) h)) (deg (R\<lparr>carrier := S\<rparr>) h) \<and>
           deg (R\<lparr>carrier := S\<rparr>) j < deg (R\<lparr>carrier := S\<rparr>) h"
               using A UP_ring.ltrm_decomp[of "R\<lparr>carrier := S\<rparr>" h] assms UP_ring_subring[of S] 
               F1 by (metis (mono_tags, lifting) F0 False zero_less_Suc)
             have j_closed: "j \<in> carrier (UP R)"  
               using j_def assms UP_ring_subring_car_subset by blast 
             have F2: "deg R j < deg R h"
               using j_def  assms  
               by (metis (no_types, lifting) F0 F1 UP_ring_subring_deg)
             have F3: "(deg (R\<lparr>carrier := S\<rparr>) h) = deg R h"
               by (simp add: F0 F1)
             have F30: "h (deg (R\<lparr>carrier := S\<rparr>) h) \<in> S "
               using A UP_cring.UP_car_memE[of "R\<lparr>carrier := S\<rparr>" h "deg (R\<lparr>carrier := S\<rparr>) h"]
               by (metis R.carrier_update(1) UP_ring_subring(1) assms(1))
             hence F4: "up_ring.monom P (h (deg R h)) (deg R h) = 
                   up_ring.monom (UP (R\<lparr>carrier := S\<rparr>)) (h (deg (R\<lparr>carrier := S\<rparr>) h)) (deg (R\<lparr>carrier := S\<rparr>) h)"
               using F3 g_closed j_def UP_subring_monom[of S "h (deg (R\<lparr>carrier := S\<rparr>) h)"] assms 
               unfolding  P_def by metis 
             have F5: "compose R (up_ring.monom (UP R) (h (deg R h)) (deg R h)) g = 
                       compose (R \<lparr> carrier := S \<rparr>) (up_ring.monom (UP (R \<lparr> carrier := S \<rparr>)) (h (deg (R\<lparr>carrier := S\<rparr>) h)) (deg (R\<lparr>carrier := S\<rparr>) h)) g"
               using F0 F1 F2 F3 F4 UP_subring_compose_monom[of S] assms  P_def \<open>h (deg (R\<lparr>carrier := S\<rparr>) h) \<in> S\<close> 
               by (metis g_closed)
             have F5: "compose R j g =  compose (R \<lparr> carrier := S \<rparr>) j g"
               using F0 F2 IH UP_ring_subring_car_subset' assms(1) j_def by auto
             have F6: "h = j \<oplus>\<^bsub>UP R\<^esub> monom (UP R) (h (deg R h)) (deg R h)"
               using j_def F4 UP_ring_subring_add[of S j "up_ring.monom (UP (R\<lparr>carrier := S\<rparr>)) (h (deg (R\<lparr>carrier := S\<rparr>) h)) (deg (R\<lparr>carrier := S\<rparr>) h)"]
                     UP_ring.monom_closed[of "R\<lparr>carrier := S\<rparr>" "h (deg (R\<lparr>carrier := S\<rparr>) h)" "deg (R\<lparr>carrier := S\<rparr>) h"]          
               using P_def UP_ring_subring(2) \<open>h (deg (R\<lparr>carrier := S\<rparr>) h) \<in> S\<close> assms(1) by auto
             have F7: "compose R h g =compose R  j g \<oplus>\<^bsub>UP R\<^esub>
                                     compose R (up_ring.monom (UP R) (h (deg R h)) (deg R h)) g"
             proof-
               show ?thesis 
               using assms(2) j_closed  F5 sub_add[of g j "up_ring.monom P (h (deg R h)) (deg R h)" ] 
                      F4 F3 F2 F1 g_closed  unfolding P_def              
               by (metis A F6 ltrm_closed P_def)
             qed
             have F8: "compose (R \<lparr> carrier := S \<rparr>) h g = compose (R \<lparr> carrier := S \<rparr>)  j g \<oplus>\<^bsub>UP (R \<lparr> carrier := S \<rparr>)\<^esub>
                                     compose (R \<lparr> carrier := S \<rparr>) (up_ring.monom (UP (R \<lparr> carrier := S \<rparr>)) (h (deg (R \<lparr> carrier := S \<rparr>) h)) (deg (R \<lparr> carrier := S \<rparr>) h)) g"
             proof-
               have 0: " UP_cring (R\<lparr>carrier := S\<rparr>)"
                 by (simp add: UP_ring_subring(1) assms(1))
               have 1: "monom (UP (R\<lparr>carrier := S\<rparr>)) (h (deg R h)) (deg R h) \<in> carrier (UP (R\<lparr>carrier := S\<rparr>))"
                 using assms 0 F30 UP_ring.monom_closed[of "R\<lparr>carrier := S\<rparr>" "h (deg R h)" "deg R h"] R.carrier_update[of S]
                 unfolding UP_ring_def UP_cring_def 
                 by (simp add: F3 cring.axioms(1))
               show ?thesis
                 using 0 1 g_closed j_def UP_cring.sub_add[of "R \<lparr> carrier := S \<rparr>" g j "monom (UP (R\<lparr>carrier := S\<rparr>)) (h (deg R h)) (deg R h)" ]
                 using F3 by auto
             qed
             have F9: "compose R  j g \<in> carrier (UP R)"
               by (simp add: UP_cring.sub_closed assms(2) is_UP_cring j_closed)
             have F10: "compose (R \<lparr> carrier := S \<rparr>) j g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
               using assms j_def UP_cring.sub_closed[of "R \<lparr> carrier := S \<rparr>"] UP_ring_subring(1) g_closed by blast
             have F11: " compose R (up_ring.monom (UP R) (h (deg R h)) (deg R h)) g \<in> carrier (UP R)"
               using assms j_def UP_cring.sub_closed[of "R \<lparr> carrier := S \<rparr>"] 
                     UP_ring.monom_closed[of "R \<lparr> carrier := S \<rparr>"]
               by (simp add: A UP_car_memE(1) UP_cring.rev_sub_closed UP_ring.monom_closed is_UP_cring is_UP_ring sub_rev_sub)
             have F12: " compose (R \<lparr> carrier := S \<rparr>) (up_ring.monom (UP (R \<lparr> carrier := S \<rparr>)) (h (deg (R \<lparr> carrier := S \<rparr>) h)) (deg (R \<lparr> carrier := S \<rparr>) h)) g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
               using assms j_def UP_cring.sub_closed[of "R \<lparr> carrier := S \<rparr>"] 
                     UP_ring.monom_closed[of "R \<lparr> carrier := S \<rparr>"] UP_ring_subring[of S]
               using A UP_ring.ltrm_closed g_closed by fastforce
             show ?thesis using F9 F10 F11 F12 F7 F8 F5 UP_ring_subring_add[of S "compose R  j g" "compose R (up_ring.monom (UP R) (h (deg R h)) (deg R h)) g"]
                     assms 
               using F3 F30 UP_subring_compose_monom g_closed by auto
           qed
         qed
       qed
     qed
   qed
   show  ?thesis using 0[of "deg R f"]   
     by (simp add: assms(1) assms(3) assms(5) poly_cfs_subring)
 qed   
 
 
 subsection\<open>Evaluation over a Subring\<close>
 
 lemma(in UP_cring) UP_subring_eval:
   assumes "subring S R"
   assumes "g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
   assumes "a \<in> S"
   shows "to_function R g a = to_function (R \<lparr> carrier := S \<rparr>) g a"
   apply(rule UP_ring.poly_induct3[of "R \<lparr> carrier := S \<rparr>" g] )
   apply (simp add: UP_ring_subring(2) assms(1))
     apply (simp add: assms(2))
 proof-
   show "\<And>p q. q \<in> carrier (UP (R\<lparr>carrier := S\<rparr>)) \<Longrightarrow>
            p \<in> carrier (UP (R\<lparr>carrier := S\<rparr>)) \<Longrightarrow>
            to_function R p a = to_function (R\<lparr>carrier := S\<rparr>) p a \<Longrightarrow>
            to_function R q a = to_function (R\<lparr>carrier := S\<rparr>) q a \<Longrightarrow>
            to_function R (p \<oplus>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> q) a = to_function (R\<lparr>carrier := S\<rparr>) (p \<oplus>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> q) a"
   proof- fix p q assume A: "q \<in> carrier (UP (R\<lparr>carrier := S\<rparr>))"
            "p \<in> carrier (UP (R\<lparr>carrier := S\<rparr>))"
           " to_function R p a = to_function (R\<lparr>carrier := S\<rparr>) p a"
           " to_function R q a = to_function (R\<lparr>carrier := S\<rparr>) q a"
     have a_closed: "a \<in> carrier R"
       using  assms R.carrier_update[of S] subringE(1) by blast
     have 0: "UP_cring (R\<lparr>carrier := S\<rparr>)"
       using assms by (simp add: UP_ring_subring(1))
     have 1: "to_function (R\<lparr>carrier := S\<rparr>) p a \<in> S"
       using A 0 UP_cring.to_fun_closed[of "R\<lparr>carrier := S\<rparr>"]  
       by (simp add: UP_cring.to_fun_def assms(3))
     have 2: "to_function (R\<lparr>carrier := S\<rparr>) q a \<in> S"
       using A 0 UP_cring.to_fun_closed[of "R\<lparr>carrier := S\<rparr>"]  
       by (simp add: UP_cring.to_fun_def assms(3))
     have 3: "p \<in> carrier (UP R)"
       using A  assms 0 UP_ring_subring_car_subset' by blast
     have 4: "q \<in> carrier (UP R)"
       using A  assms 0 UP_ring_subring_car_subset' by blast
     have 5: "to_fun p a \<oplus> to_fun q a =  UP_cring.to_fun (R\<lparr>carrier := S\<rparr>) p a \<oplus>\<^bsub>R\<lparr>carrier := S\<rparr>\<^esub> UP_cring.to_fun (R\<lparr>carrier := S\<rparr>) q a"
       using 1 2 A R.carrier_update[of S] assms by (simp add: "0" UP_cring.to_fun_def to_fun_def)
     have 6: "UP_cring.to_fun (R\<lparr>carrier := S\<rparr>) (p \<oplus>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> q) a =
     UP_cring.to_fun (R\<lparr>carrier := S\<rparr>) p a \<oplus>\<^bsub>R\<lparr>carrier := S\<rparr>\<^esub> UP_cring.to_fun (R\<lparr>carrier := S\<rparr>) q a"
       using UP_cring.to_fun_plus[of "R \<lparr> carrier := S \<rparr>" q p a] 
       by (simp add: "0" A(1) A(2) assms(3))
     have 7: "to_fun (p \<oplus>\<^bsub>P\<^esub> q) a = to_fun p a \<oplus> to_fun q a"
       using to_fun_plus[of q p a] 3 4 a_closed by (simp add: P_def)
     have 8: "p \<oplus>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> q = p \<oplus>\<^bsub>P\<^esub> q"
       unfolding P_def using assms A R.carrier_update[of S] UP_ring_subring_add[of S p q] by simp
     show "to_function R (p \<oplus>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> q) a = to_function (R\<lparr>carrier := S\<rparr>) (p \<oplus>\<^bsub>UP (R\<lparr>carrier := S\<rparr>)\<^esub> q) a"
       using UP_ring_subring_car_subset'[of S ] 0 1 2 3 4 5 6 7 8 A R.carrier_update[of S] 
       unfolding P_def by (simp add: UP_cring.to_fun_def to_fun_def)
   qed
   show "\<And>b n.
        b \<in> carrier (R\<lparr>carrier := S\<rparr>) \<Longrightarrow>
        to_function R (monom (UP (R\<lparr>carrier := S\<rparr>)) b n) a = to_function (R\<lparr>carrier := S\<rparr>) (monom (UP (R\<lparr>carrier := S\<rparr>)) b n) a"  
   proof- fix b n assume A: "b \<in> carrier (R\<lparr>carrier := S\<rparr>)"
     have 0: "UP_cring (R\<lparr>carrier := S\<rparr>)"
       by (simp add: UP_ring_subring(1) assms(1))
     have a_closed: "a \<in> carrier R"
       using assms subringE by blast 
     have 1: "UP_cring.to_fun (R\<lparr>carrier := S\<rparr>) (monom (UP (R\<lparr>carrier := S\<rparr>)) b n) a = b \<otimes>\<^bsub>R\<lparr>carrier := S\<rparr>\<^esub> a [^]\<^bsub>R\<lparr>carrier := S\<rparr>\<^esub> n"
       using assms A UP_cring.to_fun_monom[of "R\<lparr>carrier := S\<rparr>" b a n]  
       by (simp add: "0")
     have 2: "UP_cring.to_fun (R\<lparr>carrier := S\<rparr>) (monom (UP (R\<lparr>carrier := S\<rparr>)) b n) \<equiv> to_function (R\<lparr>carrier := S\<rparr>) (monom (UP (R\<lparr>carrier := S\<rparr>)) b n)"
       using UP_cring.to_fun_def[of "R\<lparr>carrier := S\<rparr>" "monom (UP (R\<lparr>carrier := S\<rparr>)) b n"] 0 by linarith
     have 3: "(monom (UP (R\<lparr>carrier := S\<rparr>)) b n) = monom P b n"
       using A assms unfolding P_def using  UP_subring_monom by auto
     have 4:  " b \<otimes> a [^] n = b \<otimes>\<^bsub>R\<lparr>carrier := S\<rparr>\<^esub> a [^]\<^bsub>R\<lparr>carrier := S\<rparr>\<^esub> n" 
       apply(induction n) using R.carrier_update[of S] apply simp
       using R.carrier_update[of S] R.nat_pow_consistent by auto
     hence 5: "to_function R (monom (UP (R\<lparr>carrier := S\<rparr>)) b n) a = b \<otimes>\<^bsub>R\<lparr>carrier := S\<rparr>\<^esub> a[^]\<^bsub>R\<lparr>carrier := S\<rparr>\<^esub>n"
       using 0 1 2 3 assms A UP_cring.to_fun_monom[of "R\<lparr>carrier := S\<rparr>" b a n] UP_cring.to_fun_def[of "R\<lparr>carrier := S\<rparr>" "monom (UP (R\<lparr>carrier := S\<rparr>)) b n"]
              R.carrier_update[of S] subringE[of S R] a_closed UP_ring.monom_closed[of "R\<lparr>carrier := S\<rparr>" a n]  
              to_fun_monom[of b a n]
       unfolding P_def UP_cring.to_fun_def to_fun_def by (metis subsetD)
     thus " to_function R (monom (UP (R\<lparr>carrier := S\<rparr>)) b n) a = to_function (R\<lparr>carrier := S\<rparr>) (monom (UP (R\<lparr>carrier := S\<rparr>)) b n) a"
       using "1" "2" by auto
   qed
 qed
 
 lemma(in UP_cring) UP_subring_eval':
   assumes "subring S R"
   assumes "g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
   assumes "a \<in> S"
   shows "to_fun g a = to_function (R \<lparr> carrier := S \<rparr>) g a"
   unfolding to_fun_def using assms 
   by (simp add: UP_subring_eval)
 
 lemma(in UP_cring) UP_subring_eval_closed:
   assumes "subring S R"
   assumes "g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
   assumes "a \<in> S"
   shows "to_fun g a \<in> S"
   using assms  UP_subring_eval'[of S g a] UP_cring.to_fun_closed  UP_cring.to_fun_def R.carrier_update(1) UP_ring_subring(1) by fastforce
 
 subsection\<open>Derivatives and Taylor Expansions over a Subring\<close>
 
 
 lemma(in UP_cring) UP_subring_taylor:
   assumes "subring S R"
   assumes "g \<in> carrier (UP R)"
   assumes "\<And>n. g n \<in> S"
   assumes "a \<in> S"
   shows "taylor_expansion R a g = taylor_expansion (R \<lparr> carrier := S \<rparr>) a g"
 proof-
   have a_closed: "a \<in> carrier R"
     using assms subringE by blast
   have 0: "X_plus a \<in> carrier (UP R)"
     using assms X_plus_closed  unfolding P_def  
     using local.a_closed by auto
   have 1: "\<And>n. X_plus a n \<in> S"
   proof- fix n
     have "X_plus a n = (if n = 0 then a else 
                         (if n = 1 then \<one> else \<zero>))"
       using a_closed 
       by (simp add: cfs_X_plus)
     then show "X_plus a n \<in> S" using subringE assms 
       by (simp add: subringE(2) subringE(3))
   qed
   have 2: "(X_poly_plus (R\<lparr>carrier := S\<rparr>) a) = X_plus a"
   proof-
     have 20: "(X_poly_plus (R\<lparr>carrier := S\<rparr>) a) = (\<lambda>k. if k = (0::nat) then a else 
                         (if k = 1 then \<one> else \<zero>))"
       using a_closed assms UP_cring.cfs_X_plus[of "R\<lparr>carrier := S\<rparr>" a] R.carrier_update 
             UP_ring_subring(1) by auto
     have 21: "X_plus a = (\<lambda>k. if k = (0::nat) then a else 
                         (if k = 1 then \<one> else \<zero>))"
        using cfs_X_plus[of a] a_closed 
        by blast
      show ?thesis apply(rule ext) using 20 21
        by auto
   qed     
   show ?thesis
     unfolding taylor_expansion_def using 0 1 2 assms UP_subring_compose[of S g "X_plus a"] 
     by (simp add: UP_subring_compose)
 qed
 
 lemma(in UP_cring) UP_subring_taylor_closed:
   assumes "subring S R"
   assumes "g \<in> carrier (UP R)"
   assumes "\<And>n. g n \<in> S"
   assumes "a \<in> S"
   shows "taylor_expansion R a g \<in> carrier  (UP (R \<lparr> carrier := S \<rparr>))"
 proof-
   have "g \<in> carrier (UP (R\<lparr>carrier := S\<rparr>))"
     by (metis P_def R.carrier_update(1) R.carrier_update(2) UP_cring.UP_car_memI' UP_ring_subring(1) assms(1) assms(2) assms(3) deg_leE)
   then show ?thesis   
     using assms UP_cring.taylor_def[of "R\<lparr>carrier := S\<rparr>"] UP_subring_taylor[of S g a]
           UP_cring.taylor_closed[of "R \<lparr> carrier := S \<rparr>" g a] UP_ring_subring(1)[of S] by simp
 qed
 
 lemma(in UP_cring) UP_subring_taylor_closed':
   assumes "subring S R"
   assumes "g \<in> carrier  (UP (R \<lparr> carrier := S \<rparr>))"
   assumes "a \<in> S"
   shows "taylor_expansion R a g \<in> carrier  (UP (R \<lparr> carrier := S \<rparr>))"
   using UP_subring_taylor_closed assms UP_cring.UP_car_memE[of "R \<lparr> carrier := S \<rparr>" g] R.carrier_update[of S]
         UP_ring_subring(1) UP_ring_subring_car_subset' by auto
 
 lemma(in UP_cring) UP_subring_taylor':
   assumes "subring S R"
   assumes "g \<in> carrier (UP R)"
   assumes "\<And>n. g n \<in> S"
   assumes "a \<in> S"
   shows "taylor_expansion R a g n \<in> S"
   using assms UP_subring_taylor R.carrier_update[of S] UP_cring.taylor_closed[of "R \<lparr> carrier := S \<rparr>"]
   using UP_cring.taylor_expansion_cf_closed UP_ring_subring(1) poly_cfs_subring by metis 
 
 
 lemma(in UP_cring) UP_subring_deriv:
   assumes "subring S R"
   assumes "g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
   assumes "a \<in> S"
   shows  "deriv g a= UP_cring.deriv (R \<lparr> carrier := S \<rparr>) g a"
 proof-
   have 0: "(\<And>n. g n \<in> S)"
     using assms UP_ring_subring_car by blast
   thus ?thesis 
     unfolding derivative_def using 0 UP_ring_subring_car_subset[of S] assms UP_subring_taylor[of S g a] 
     by (simp add: subset_iff)
 qed
 
 lemma(in UP_cring) UP_subring_deriv_closed:
   assumes "subring S R"
   assumes "g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
   assumes "a \<in> S"
   shows  "deriv g a \<in> S"
   using assms  UP_cring.deriv_closed[of "R \<lparr> carrier := S \<rparr>" g a] UP_subring_deriv[of S g a]
         UP_ring_subring_car_subset[of S] UP_ring_subring[of S]
   by simp
 
 lemma(in UP_cring) poly_shift_subring_closed:
   assumes "subring S R"
   assumes "g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
   shows "poly_shift g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
   using UP_cring.poly_shift_closed[of "R \<lparr> carrier := S \<rparr>" g] assms UP_ring_subring[of S]
   by simp
 
 lemma(in UP_cring) UP_subring_taylor_appr:
   assumes "subring S R"
   assumes "g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
   assumes "a \<in> S"
   assumes "b \<in> S"
   shows "\<exists>c \<in> S. to_fun g a= to_fun g b \<oplus> (deriv g b)\<otimes> (a \<ominus> b) \<oplus>  (c \<otimes> (a \<ominus>  b)[^](2::nat))"
 proof-
   have  a_closed: "a \<in> carrier R"
     using assms subringE by blast
   have b_closed: "b \<in> carrier R"
     using assms subringE by blast
   have g_closed:  " g \<in> carrier (UP R)"
     using UP_ring_subring_car_subset[of S] assms by blast 
   have 0: "to_fun (shift 2 (T\<^bsub>b\<^esub> g)) (a \<ominus> b) = to_fun (shift 2 (T\<^bsub>b\<^esub> g)) (a \<ominus> b)"
     by simp
   have 1: "to_fun g b = to_fun g b"
     by simp
   have 2: "deriv g b = deriv g b"
     by simp 
   have 3: "to_fun g a = to_fun g b \<oplus> deriv g b \<otimes> (a \<ominus> b) \<oplus> to_fun (shift 2 (T\<^bsub>b\<^esub> g)) (a \<ominus> b) \<otimes> (a \<ominus> b) [^] (2::nat)"
     using taylor_deg_1_expansion[of g b a "to_fun (shift 2 (T\<^bsub>b\<^esub> g)) (a \<ominus> b)" "to_fun g b" "deriv g b"]
           assms a_closed b_closed g_closed 0 1 2 unfolding P_def by blast
   have 4: "to_fun (shift 2 (T\<^bsub>b\<^esub> g)) (a \<ominus> b) \<in> S"
   proof-
     have 0: "(2::nat) = Suc (Suc 0)"
       by simp
     have 1: "a \<ominus> b \<in> S"
       using assms unfolding a_minus_def  
       by (simp add: subringE(5) subringE(7))
     have 2: "poly_shift (T\<^bsub>b\<^esub> g) \<in> carrier (UP (R\<lparr>carrier := S\<rparr>))"
       using poly_shift_subring_closed[of S "taylor_expansion R b g"] UP_ring_subring[of S]
             UP_subring_taylor_closed'[of S g b] assms       unfolding taylor_def
       by blast
     hence 3: "poly_shift (poly_shift (T\<^bsub>b\<^esub> g)) \<in> carrier (UP (R\<lparr>carrier := S\<rparr>))"
       using    UP_cring.poly_shift_closed[of "R\<lparr>carrier := S\<rparr>" "(poly_shift (T\<^bsub>b\<^esub> g))"]            
       unfolding taylor_def 
       using assms(1) poly_shift_subring_closed by blast
     have 4: "to_fun (poly_shift (poly_shift (T\<^bsub>b\<^esub> g))) (a \<ominus> b) \<in> S"
       using 1 2 3 0 UP_subring_eval_closed[of S "poly_shift (poly_shift (T\<^bsub>b\<^esub> g))"  "a \<ominus> b"] 
               UP_cring.poly_shift_closed[of "R\<lparr>carrier := S\<rparr>"] assms
       by blast
     then show ?thesis 
       by (simp add: numeral_2_eq_2)
   qed
   obtain c where c_def: "c = to_fun (shift 2 (T\<^bsub>b\<^esub> g)) (a \<ominus> b)"
     by blast 
   have 5: "c \<in> S \<and> to_fun g a = to_fun g b \<oplus> deriv g b \<otimes> (a \<ominus> b) \<oplus> c \<otimes> (a \<ominus> b) [^] (2::nat)"
     unfolding c_def using 3 4 by blast 
   thus ?thesis using c_def  4 by blast 
 qed
 
 lemma(in UP_cring) UP_subring_taylor_appr':
   assumes "subring S R"
   assumes "g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
   assumes "a \<in> S"
   assumes "b \<in> S"
   shows "\<exists>c c' c''. c \<in> S \<and> c' \<in> S \<and> c'' \<in> S \<and> to_fun g a= c \<oplus> c'\<otimes> (a \<ominus> b) \<oplus>  (c'' \<otimes> (a \<ominus>  b)[^](2::nat))"
   using UP_subring_taylor_appr[of S g a b] assms UP_subring_deriv_closed[of S g b] UP_subring_eval_closed[of S g b]
   by blast 
 
 lemma (in UP_cring) pderiv_cfs: 
   assumes"g \<in> carrier (UP R)"
   shows "pderiv g n = [Suc n]\<cdot>(g (Suc n))"
   unfolding pderiv_def  
   using n_mult_closed[of g] assms  poly_shift_cfs[of "n_mult g" n] 
   unfolding P_def n_mult_def by blast
 
 lemma(in ring) subring_add_pow:
   assumes "subring S R"
   assumes "a \<in> S"
   shows "[(n::nat)] \<cdot>\<^bsub>R\<lparr>carrier := S\<rparr>\<^esub> a = [(n::nat)] \<cdot>a"
 proof-
   have 0: "a \<in> carrier R"
     using assms(1) assms(2) subringE(1) by blast
   have 1: "a \<in> carrier (R\<lparr>carrier := S\<rparr>)"
     by (simp add: assms(2))
   show ?thesis
   apply(induction n)
   using assms 0 1 carrier_update[of S] 
   apply (simp add: add_pow_def)
   using assms 0 1 carrier_update[of S] 
   by (simp add: add_pow_def)
 qed
 
 lemma(in UP_cring) UP_subring_pderiv_equal:
   assumes "subring S R"
   assumes "g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
   shows "pderiv g = UP_cring.pderiv (R\<lparr>carrier := S\<rparr>) g"
 proof fix n
   show "pderiv g n = UP_cring.pderiv (R\<lparr>carrier := S\<rparr>) g n"
     using UP_cring.pderiv_cfs[of "R \<lparr> carrier := S \<rparr>" g n] pderiv_cfs[of g n]
           assms R.subring_add_pow[of S "g (Suc n)" "Suc n"]
     by (simp add: UP_ring_subring(1) UP_ring_subring_car)
 qed
   
 lemma(in UP_cring) UP_subring_pderiv_closed:
   assumes "subring S R"
   assumes "g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
   shows "pderiv g \<in> carrier (UP (R \<lparr> carrier := S \<rparr>))"
   using assms UP_cring.pderiv_closed[of "R \<lparr> carrier := S \<rparr>" g] R.carrier_update(1) UP_ring_subring(1)
 UP_subring_pderiv_equal by auto
 
 lemma(in UP_cring) UP_subring_pderiv_closed':
   assumes "subring S R"
   assumes "g \<in> carrier (UP R)"
   assumes "\<And>n. g n \<in> S"
   shows "\<And>n. pderiv g n \<in> S"
   using assms UP_subring_pderiv_closed[of S g] poly_cfs_subring[of S g] UP_ring_subring_car
   by blast
 
 lemma(in UP_cring) taylor_deg_one_expansion_subring:
   assumes "f \<in> carrier (UP R)"
   assumes "subring S R"
   assumes "\<And>i. f i \<in> S"
   assumes "a \<in> S"
   assumes "b \<in> S"
   shows "\<exists>c \<in> S. to_fun f b = (to_fun f a) \<oplus> (deriv f a) \<otimes> (b \<ominus> a) \<oplus> (c \<otimes> (b \<ominus> a)[^](2::nat))"
   apply(rule UP_subring_taylor_appr, rule assms) 
   using assms poly_cfs_subring apply blast
   by(rule assms, rule assms)
   
 lemma(in UP_cring) taylor_deg_one_expansion_subring':
   assumes "f \<in> carrier (UP R)"
   assumes "subring S R"
   assumes "\<And>i. f i \<in> S"
   assumes "a \<in> S"
   assumes "b \<in> S"
   shows "\<exists>c \<in> S. to_fun f b = (to_fun f a) \<oplus> (to_fun (pderiv f) a) \<otimes> (b \<ominus> a) \<oplus> (c \<otimes> (b \<ominus> a)[^](2::nat))"
 proof-
   have "S \<subseteq> carrier R"
     using assms subringE(1) by blast
   hence 0: "deriv f a = to_fun (pderiv f) a"
     using assms  pderiv_eval_deriv[of f a] unfolding P_def  by blast 
   show ?thesis 
     using assms taylor_deg_one_expansion_subring[of f S a b]
     unfolding 0 by blast 
 qed
 
 end