Theory Algebra6

(**        Algebra6  
                            author Hidetsune Kobayashi
                            Group You Santo
                            Department of Mathematics
                            Nihon University
                            hikoba@math.cst.nihon-u.ac.jp
                            May 3, 2004.
                            April 6, 2007 (revised)

   chapter 4. Ring theory
    section 14. the degree of a polynomial(continued)
    section 15. homomorphism of polynomial rings
    section 16. relatively prime polynomials
    **)

theory Algebra6 imports Algebra5 begin

definition
  s_cf :: "[('a, 'm) Ring_scheme, ('a, 'm1) Ring_scheme, 'a, 'a]  
                                           β‡’ nat Γ— (nat β‡’ 'a)" where
  "s_cf R S X p = (if p = πŸ¬β‡˜R⇙ then (0, Ξ»j. πŸ¬β‡˜S⇙) else 
              SOME c. (pol_coeff S c ∧ p = polyn_expr R X (fst c) c ∧
              (snd c) (fst c) β‰  πŸ¬β‡˜S⇙))"
  (* special coefficients for p  *)

definition
  lcf :: "[('a, 'm) Ring_scheme, ('a, 'm1) Ring_scheme, 'a, 'a]  β‡’ 'a" where
  "lcf R S X p = (snd (s_cf R S X p)) (fst (s_cf R S X p))"
  
 
lemma (in PolynRg) lcf_val_0:"lcf R S X 𝟬 = πŸ¬β‡˜S⇙"
by (simp add:lcf_def s_cf_def)

lemma (in PolynRg) lcf_val:"⟦p ∈ carrier R; p β‰  𝟬 ⟧ ⟹ 
                    lcf R S X p = (snd (s_cf R S X p)) (fst (s_cf R S X p))"
by (simp add:lcf_def) 

lemma (in PolynRg) s_cf_pol_coeff:"p ∈ carrier R ⟹
                         pol_coeff S (s_cf R S X p)"
apply (simp add:s_cf_def) 
 apply (case_tac "p = πŸ¬β‡˜R⇙", simp) 
 apply (cut_tac subring, frule subring_Ring, 
             simp add:pol_coeff_def Ring.ring_zero)
apply simp
 apply (rule someI2_ex)
 apply (frule ex_polyn_expr[of p], erule exE, erule conjE)
 apply (frule_tac c = c in coeff_max_bddTr)
 apply (frule_tac c = c and n = "c_max S c" in pol_coeff_le, assumption)
 apply (subgoal_tac "p = polyn_expr R X (fst (c_max S c, snd c))
                                                  (c_max S c, snd c) ∧
                     snd (c_max S c, snd c) (fst (c_max S c, snd c)) β‰  πŸ¬β‡˜S⇙",
        blast)
 apply (rule conjI, simp)
 apply (subst polyn_expr_short[THEN sym], assumption+)
 apply (simp add:polyn_c_max)

 apply simp
 apply (rule coeff_max_nonzeroTr, assumption)
 apply (simp add:coeff_0_pol_0[THEN sym])

 apply simp
done

lemma (in PolynRg) lcf_mem:"p ∈ carrier R ⟹ (lcf R S X p) ∈ carrier S"
apply (cut_tac subring, frule subring_Ring) 
apply (simp add:lcf_def) 
 apply (cut_tac pol_coeff_mem[of "s_cf R S X p" "fst (s_cf R S X p)"],
          assumption,
        rule s_cf_pol_coeff, assumption, simp)
done

lemma (in PolynRg) s_cf_expr0:"p ∈ carrier R ⟹
      pol_coeff S (s_cf R S X p) ∧
      p = polyn_expr R X (fst (s_cf R S X p)) (s_cf R S X p)"
apply (cut_tac subring, frule subring_Ring)
apply (simp add:s_cf_def)
 apply (case_tac "p = πŸ¬β‡˜R⇙", simp)
 apply (rule conjI, simp add:pol_coeff_def, simp add:Ring.ring_zero)
 apply (simp add:polyn_expr_def,
        simp add:Subring_zero_ring_zero, simp add:ring_r_one)

apply simp
 apply (rule someI2_ex)
 apply (frule ex_polyn_expr[of p], erule exE, erule conjE)
 apply (frule_tac c = c in coeff_max_bddTr)
 apply (frule_tac c = c and n = "c_max S c" in pol_coeff_le, assumption)
 apply (subgoal_tac "p = polyn_expr R X (fst (c_max S c, snd c))
                                                  (c_max S c, snd c) ∧
                     snd (c_max S c, snd c) (fst (c_max S c, snd c)) β‰  πŸ¬β‡˜S⇙",
        blast)
 apply (rule conjI, simp)
 apply (subst polyn_expr_short[THEN sym], assumption+)
 apply (simp add:polyn_c_max)

 apply simp
 apply (rule coeff_max_nonzeroTr, assumption)
 apply (simp add:coeff_0_pol_0[THEN sym])
 apply simp
done 

lemma (in PolynRg) pos_deg_nonzero:"⟦p ∈ carrier R; 0 < deg_n R S X p⟧ ⟹
                     p β‰  𝟬"
apply (cut_tac s_cf_expr0[of p], (erule conjE)+)
 apply (frule pol_deg_eq_c_max[of p "s_cf R S X p"], assumption+)
 apply (simp, thin_tac "deg_n R S X p = c_max S (s_cf R S X p)")
 apply (simp add:c_max_def) 
 apply (case_tac "βˆ€x≀fst (s_cf R S X p). snd (s_cf R S X p) x = πŸ¬β‡˜S⇙ ", simp)
 apply (thin_tac "0 < (if βˆ€x≀fst (s_cf R S X p). snd (s_cf R S X p) x = πŸ¬β‡˜S⇙ 
   then 0 else n_max
                {j. j ≀ fst (s_cf R S X p) ∧ snd (s_cf R S X p) j β‰  πŸ¬β‡˜S⇙})")
 apply (simp add:coeff_0_pol_0[of "s_cf R S X p" "fst (s_cf R S X p)"])
 apply assumption
done

lemma (in PolynRg) s_cf_expr:"⟦p ∈ carrier R; p β‰  𝟬⟧ ⟹
      pol_coeff S (s_cf R S X p) ∧
      p = polyn_expr R X (fst (s_cf R S X p)) (s_cf R S X p) ∧
      (snd (s_cf R S X p)) (fst (s_cf R S X p)) β‰  πŸ¬β‡˜S⇙" 
apply (simp add:s_cf_def)
 apply (rule someI2_ex)

 apply (frule ex_polyn_expr[of p], erule exE, erule conjE)
 apply (frule_tac c = c in coeff_max_bddTr)
 apply (frule_tac c = c and n = "c_max S c" in pol_coeff_le, assumption)
 apply (subgoal_tac "p = polyn_expr R X (fst (c_max S c, snd c))
                                                  (c_max S c, snd c) ∧
                     snd (c_max S c, snd c) (fst (c_max S c, snd c)) β‰  πŸ¬β‡˜S⇙",
        blast)
 apply (rule conjI, simp)
 apply (subst polyn_expr_short[THEN sym], assumption+)
 apply (simp add:polyn_c_max)

 apply simp
 apply (rule coeff_max_nonzeroTr, assumption)
 apply (simp add:coeff_0_pol_0[THEN sym])
 apply simp
done

lemma (in PolynRg) lcf_nonzero:"⟦p ∈ carrier R; p β‰  𝟬 ⟧ ⟹ 
                                          lcf R S X p β‰  πŸ¬β‡˜S⇙"
apply (frule s_cf_expr[of p], assumption)
apply (simp add:lcf_def)
done

lemma (in PolynRg) s_cf_deg:"⟦p ∈ carrier R; p β‰  𝟬⟧ ⟹
                  deg_n R S X p = fst (s_cf R S X p)"
apply (frule s_cf_expr[of p], assumption, (erule conjE)+)
apply (simp add:pol_deg_n[of p "s_cf R S X p" "fst (s_cf R S X p)"])
done

lemma (in PolynRg) pol_expr_edeg:"⟦p ∈ carrier R; deg R S X p ≀ (an d)⟧ ⟹ 
       βˆƒf. (pol_coeff S f ∧ fst f = d ∧ p = polyn_expr R X d f)"
apply (case_tac "p = πŸ¬β‡˜R⇙")
 apply (subgoal_tac "pol_coeff S (d, Ξ»j. πŸ¬β‡˜S⇙) ∧ fst (d, Ξ»j. πŸ¬β‡˜S⇙) = d ∧ 
              p = polyn_expr R X d (d, Ξ»j. πŸ¬β‡˜S⇙)", blast)
 apply (rule conjI)
 apply (simp add:pol_coeff_def, cut_tac Ring.ring_zero[of S], simp,
        cut_tac subring, simp add:subring_Ring) 
 apply (cut_tac coeff_0_pol_0[of "(d, Ξ»j. πŸ¬β‡˜S⇙)" d], simp)
 apply (simp add:pol_coeff_def, cut_tac Ring.ring_zero[of S], simp,
        cut_tac subring, simp add:subring_Ring) 
 apply simp
 apply (frule s_cf_expr[of p], assumption+, (erule conjE)+)
 apply (simp add:deg_def na_an, simp add:ale_natle)
 apply (simp add:s_cf_deg)
 apply (subgoal_tac "pol_coeff S (d, Ξ»j. (if j ≀ (fst (s_cf R S X p)) then
         (snd (s_cf R S X p) j) else πŸ¬β‡˜S⇙)) ∧
         p = polyn_expr R X d (d, Ξ»j. (if j ≀ (fst (s_cf R S X p)) then
         (snd (s_cf R S X p) j) else πŸ¬β‡˜S⇙))", blast)
 apply (rule conjI)
  apply (simp add:pol_coeff_def, rule allI, rule impI, rule impI)
  apply (cut_tac subring, simp add:subring_Ring, simp add:subring_Ring[of S]
         Ring.ring_zero)
  apply (case_tac "fst (s_cf R S X p) = d", simp)
  apply (subst polyn_exprs_eq[of "(d, Ξ»j. if j ≀ d then snd (s_cf R S X p) j 
         else πŸ¬β‡˜S⇙)" "s_cf R S X p" d])
   apply (simp add:pol_coeff_def, cut_tac Ring.ring_zero[of S], simp,
          cut_tac subring, simp add:subring_Ring, simp) 
   apply (rule allI, rule impI, simp, assumption+)
   apply (drule noteq_le_less[of "fst (s_cf R S X p)" d], assumption+)
 apply (cut_tac polyn_n_m1[of "(d, Ξ»j. if j ≀ fst (s_cf R S X p) then 
        snd (s_cf R S X p) j else πŸ¬β‡˜S⇙)" "fst (s_cf R S X p)" d], simp)
 apply (cut_tac higher_part_zero[of "(d, Ξ»j. if j ≀ fst (s_cf R S X p) then 
     snd (s_cf R S X p) j else πŸ¬β‡˜S⇙)" "fst (s_cf R S X p)"], simp,
     thin_tac "polyn_expr R X d
      (d, Ξ»j. if j ≀ fst (s_cf R S X p) then snd (s_cf R S X p) j else πŸ¬β‡˜S⇙) =
     polyn_expr R X (fst (s_cf R S X p)) (d, Ξ»j. if j ≀ fst (s_cf R S X p) 
      then snd (s_cf R S X p) j else πŸ¬β‡˜S⇙) Β± 𝟬",
     thin_tac "Ξ£f R (Ξ»j. (if j ≀ fst (s_cf R S X p) then snd (s_cf R S X p) j
                else πŸ¬β‡˜S⇙) β‹…r X^β‡—R jβ‡–) (Suc (fst (s_cf R S X p))) d = 𝟬")
apply (subst polyn_exprs_eq[of "(d, Ξ»j. if j ≀ fst (s_cf R S X p) then 
       snd (s_cf R S X p) j else πŸ¬β‡˜S⇙)" "s_cf R S X p" "fst (s_cf R S X p)"])
  apply (simp add:pol_coeff_def, rule allI, rule impI, rule impI,
         cut_tac subring, simp add:subring_Ring, simp add:subring_Ring[of S]
         Ring.ring_zero, assumption+) apply (simp)
  apply (rule allI, rule impI, simp)
  apply (frule polyn_mem[of "s_cf R S X p" "fst (s_cf R S X p)"], simp+)
  apply (cut_tac ring_is_ag, simp add:aGroup.ag_r_zero)
  apply (simp add:pol_coeff_def, rule allI, rule impI, rule impI,
         cut_tac subring, simp add:subring_Ring, simp add:subring_Ring[of S]
         Ring.ring_zero)
  apply simp
  apply (rule ballI, simp add:nset_def)
  apply (simp add:pol_coeff_def, rule allI, rule impI, rule impI,
         cut_tac subring, simp add:subring_Ring, simp add:subring_Ring[of S]
         Ring.ring_zero)
  apply assumption apply simp
done

lemma (in PolynRg) cf_scf:"⟦pol_coeff S c; k ≀ fst c; polyn_expr R X k c β‰  𝟬⟧
    ⟹  βˆ€j ≀ fst (s_cf R S X (polyn_expr R X k c)).
              snd (s_cf R S X (polyn_expr R X k c)) j = snd c j"
apply (frule polyn_mem[of c k], assumption+)
apply (simp add:polyn_expr_short[of c k],
       rule allI, rule impI)
apply (cut_tac pol_deg_le_n1[of "polyn_expr R X k c" c k],
       frule s_cf_expr0[of "polyn_expr R X k (k, snd c)"], erule conjE)
apply (rotate_tac -1, drule sym)
apply (case_tac "fst (s_cf R S X (polyn_expr R X k (k, snd c))) = k",
       simp,
       cut_tac c = "s_cf R S X (polyn_expr R X k (k, snd c))" and 
       d = "(k, snd c)" in pol_expr_unique2,
       simp add:s_cf_pol_coeff, simp add:split_pol_coeff, simp,
        simp, simp add:polyn_expr_short[THEN sym, of c k])

 apply (simp add:s_cf_deg[of "polyn_expr R X k c"],
        drule noteq_le_less[of "fst (s_cf R S X (polyn_expr R X k c))" k],
        assumption) 
 apply (frule pol_expr_unique3[of "s_cf R S X (polyn_expr R X k c)" 
         "(k, snd c)"], simp add:split_pol_coeff, simp,
        simp add:polyn_expr_short[THEN sym, of c k])
apply (simp add:polyn_expr_short[THEN sym, of c k], assumption+, simp)
done

definition
  scf_cond :: "[('a, 'm) Ring_scheme, ('a, 'm1) Ring_scheme, 'a, 'a, 
                  nat, nat Γ— (nat β‡’ 'a)] β‡’ bool" where
  "scf_cond R S X p d c ⟷ pol_coeff S c ∧ fst c = d ∧ p = polyn_expr R X d c"

definition
  scf_d :: "[('a, 'm) Ring_scheme, ('a, 'm1) Ring_scheme, 'a, 'a, nat]
                β‡’ nat Γ— (nat β‡’ 'a)" where
  "scf_d R S X p d = (SOME f. scf_cond R S X p d f)" 
 
  (** system of coefficients, coeff_length d **)

lemma (in PolynRg) scf_d_polTr:"⟦p ∈ carrier R; deg R S X p ≀ an d⟧ ⟹ 
           scf_cond R S X p d (scf_d R S X p d)" 
apply (simp add:scf_d_def) 
apply (rule_tac P = "scf_cond R S X p d" in someI2_ex)
apply (frule pol_expr_edeg[of "p" "d"], assumption+)
apply (simp add:scf_cond_def, assumption)
done

lemma (in PolynRg) scf_d_pol:"⟦p ∈ carrier R; deg R S X p ≀ an d⟧ ⟹ 
      pol_coeff S (scf_d R S X p d) ∧ fst (scf_d R S X p d) = d ∧
       p = polyn_expr R X d (scf_d R S X p d)"
apply (frule scf_d_polTr[of "p" "d"], assumption+)
apply (simp add:scf_cond_def)
done

lemma (in PolynRg) pol_expr_of_X:
       "X = polyn_expr R X (Suc 0) (ext_cf S (Suc 0) (C0 S))"
apply (cut_tac X_mem_R, cut_tac subring)
apply (cut_tac X_to_d[of "Suc 0"])
 apply (simp add:ring_l_one)
done

lemma (in PolynRg) deg_n_of_X:"deg_n R S X X = Suc 0"
apply (cut_tac X_mem_R, cut_tac polyn_ring_S_nonzero,
       cut_tac subring)
apply (cut_tac pol_expr_of_X)
apply (cut_tac special_cf_pol_coeff)
apply (frule ext_cf_pol_coeff[of "C0 S" "Suc 0"])
 apply (frule pol_deg_eq_c_max[of X "ext_cf S (Suc 0) (C0 S)"], assumption)
        apply (simp add:ext_cf_len special_cf_len)
 apply (simp add:c_max_ext_special_cf)
done

lemma (in PolynRg) pol_X:"cf_sol R S X X c ⟹
              snd c 0 = πŸ¬β‡˜S⇙ ∧ snd c (Suc 0) = 1rβ‡˜S⇙" 

apply (simp add:cf_sol_def, erule conjE)
apply (cut_tac pol_expr_of_X) 
apply (cut_tac special_cf_pol_coeff,
               frule ext_cf_pol_coeff[of "C0 S" "Suc 0"])
apply (cut_tac X_mem_R, cut_tac polyn_ring_X_nonzero,
       cut_tac subring)
apply (frule pol_deg_le_n[of X c], assumption+, simp add:deg_n_of_X)
apply (case_tac "fst c = Suc 0")
apply (frule box_equation[of X "polyn_expr R X (Suc 0) 
       (ext_cf S (Suc 0) (C0 S))" "polyn_expr R X (fst c) c"], assumption+,
       thin_tac "X = polyn_expr R X (Suc 0) (ext_cf S (Suc 0) (C0 S))",
       thin_tac "X = polyn_expr R X (fst c) c")
apply (cut_tac pol_expr_unique2[of "ext_cf S (Suc 0) (C0 S)" c],
       simp, simp add:ext_cf_len special_cf_len, rule conjI,
       drule_tac a = 0 in forall_spec, simp,
       simp add:ext_special_cf_lo_zero)
apply( drule_tac a = "Suc 0" in forall_spec, simp,
       simp add:ext_special_cf_hi, assumption+,
       simp add:ext_cf_len special_cf_len)

apply (frule noteq_le_less[of "Suc 0" "fst c"],rule not_sym, assumption,
       cut_tac pol_expr_unique3[of "ext_cf S (Suc 0) (C0 S)" c],
       simp add:ext_cf_len special_cf_len,
       erule conjE,
       thin_tac "βˆ€j∈nset (Suc (Suc 0)) (fst c). snd c j = πŸ¬β‡˜S⇙")
 apply (rule conjI,
        drule_tac a = 0 in forall_spec, simp,
        simp add:ext_special_cf_lo_zero,
        drule_tac a = "Suc 0" in forall_spec, simp,
        simp add:ext_special_cf_hi,
        assumption+)
 apply (simp add:ext_cf_len special_cf_len)
done

lemma (in PolynRg) pol_of_deg0:"⟦p ∈ carrier R; p β‰  𝟬⟧
      ⟹  (deg_n R S X p = 0) = (p ∈ carrier S)"
apply (cut_tac subring,
       frule subring_Ring,
       cut_tac ring_is_ag,
       frule Ring.ring_is_ag[of S])
apply (rule iffI)
 apply (frule s_cf_expr[of p], assumption) 
 apply (simp add:s_cf_deg, (erule conjE)+, simp add:polyn_expr_def)
 apply (frule pol_coeff_mem[of "s_cf R S X p" 0], simp) 
 apply (cut_tac mem_subring_mem_ring[of S "snd (s_cf R S X p) 0"],
        simp add:ring_r_one, assumption+)

apply (frule s_cf_expr[of p], assumption+, (erule conjE)+,
       simp add:s_cf_deg)
apply (rule contrapos_pp, simp+)
apply (subgoal_tac "pol_coeff S (0, (λj. p)) ∧ 
                      p = polyn_expr R X 0 (0, (Ξ»j. p))", erule conjE)
apply (cut_tac a = "polyn_expr R X 0 (0, Ξ»j. p)" and 
               b = "polyn_expr R X (fst (s_cf R S X p)) (s_cf R S X p)" in 
               aGroup.ag_eq_diffzero[of R],  assumption+, simp, simp)

 apply (frule_tac c = "polyn_expr R X (fst (s_cf R S X p)) (s_cf R S X p)" in 
         box_equation[of p "polyn_expr R X 0 (0, Ξ»j. p)"], assumption,
        thin_tac "p = polyn_expr R X (fst (s_cf R S X p)) (s_cf R S X p)",
        thin_tac "p = polyn_expr R X 0 (0, Ξ»j. p)", simp)

 apply (simp only:polyn_minus_m_cf) 
  apply (rotate_tac -2, drule sym, simp,
        thin_tac "polyn_expr R X (fst (s_cf R S X p)) (s_cf R S X p) = 
                 polyn_expr R X 0 (0, Ξ»j. p)")
 apply (frule_tac c = "s_cf R S X p" in m_cf_pol_coeff)
 
 apply (frule_tac d = "m_cf S (s_cf R S X p)" in polyn_add1[of "(0, Ξ»j. p)"],
        assumption,
        simp add:m_cf_len,
        thin_tac "polyn_expr R X 0 (0, Ξ»j. p) Β±
     polyn_expr R X (fst (s_cf R S X p)) (m_cf S (s_cf R S X p)) =
     polyn_expr R X (fst (s_cf R S X p))
      (add_cf S (0, Ξ»j. p) (m_cf S (s_cf R S X p)))")
     apply (rotate_tac -1, drule sym, simp)

       
 apply (frule_tac d = "m_cf S (s_cf R S X p)" in 
                      add_cf_pol_coeff[of "(0, Ξ»j. p)"], assumption)
 apply (frule_tac c1 = "add_cf S (0, Ξ»j. p) (m_cf S (s_cf R S X p))" and 
        k1 = "fst (s_cf R S X p)" in
         coeff_0_pol_0[THEN sym],
       simp add:add_cf_len m_cf_len, simp,
       thin_tac "pol_coeff S (add_cf S (0, Ξ»j. p) (m_cf S (s_cf R S X p)))",
       thin_tac "polyn_expr R X (fst (s_cf R S X p))
      (add_cf S (0, λj. p) (m_cf S (s_cf R S X p))) = 𝟬")
 apply (drule_tac a = "fst (s_cf R S X p)" in forall_spec, simp,
        simp add:add_cf_def m_cf_len m_cf_def)
 apply (frule_tac c = "s_cf R S X p" and j = "fst (s_cf R S X p)" in 
        pol_coeff_mem, simp,
        frule_tac x = "snd (s_cf R S X p) (fst (s_cf R S X p))" in 
        aGroup.ag_inv_inv[of S],
        assumption, simp add:aGroup.ag_inv_zero)
 apply (subst polyn_expr_def, simp add:ring_r_one)
 apply (simp add:pol_coeff_def)
done

lemma (in PolynRg) pols_const:"⟦p ∈ carrier R; (deg R S X p) ≀ 0⟧  ⟹ 
                         p ∈ carrier S"  
apply (case_tac "p = πŸ¬β‡˜R⇙")
 apply (cut_tac subring)
 apply (frule Subring_zero_ring_zero[THEN sym, of S], simp,
       cut_tac subring,
       frule subring_Ring[of S],
       rule Ring.ring_zero[of S], assumption)
apply (subst pol_of_deg0[THEN sym], assumption+,
       simp add:deg_def,
       simp only:an_0[THEN sym],
       simp add:an_inj)
done  

lemma (in PolynRg) less_deg_add_nonzero:"⟦p ∈ carrier R; p β‰  𝟬; 
       q ∈ carrier R; q β‰  𝟬; 
       (deg_n R S X p) < (deg_n R S X q)⟧  ⟹ p Β± q β‰  𝟬"  
apply (frule ex_polyn_expr[of p], erule exE, erule conjE,
       frule ex_polyn_expr[of q], erule exE, erule conjE,
       rename_tac c d)
apply (frule_tac c = c in pol_deg_eq_c_max[of p], assumption+,
       frule_tac c = d in pol_deg_eq_c_max[of q], assumption+,
       frule_tac c = c in coeff_max_bddTr, 
       frule_tac c = d in coeff_max_bddTr)
apply (frule_tac c = c and n = "c_max S c" in pol_coeff_le, assumption,
       frule_tac c = d and n = "c_max S d" in pol_coeff_le, assumption+)
apply simp
apply (subst polyn_c_max, assumption,
       subst polyn_c_max, assumption,
       subst polyn_expr_short, assumption+)
 apply (frule_tac c = d and k = "c_max S d" in polyn_expr_short, assumption+,
       simp,
       thin_tac "polyn_expr R X (c_max S d) d =
           polyn_expr R X (c_max S d) (c_max S d, snd d)",
       thin_tac "deg_n R S X (polyn_expr R X (fst c) c) = c_max S c",
       thin_tac "deg_n R S X (polyn_expr R X (fst d) d) = c_max S d")
 
  apply (subst polyn_add, assumption+, simp add: max.absorb1 max.absorb2)
         
  apply (rule contrapos_pp, simp+,
         frule_tac c = "(c_max S c, snd c)" and d = "(c_max S d, snd d)" in 
         add_cf_pol_coeff, assumption+,
         frule_tac c1 = "add_cf S (c_max S c, snd c) (c_max S d, snd d)" and 
         k1 = "c_max S d" in coeff_0_pol_0[THEN sym],
         simp add:add_cf_len, simp,
       thin_tac "pol_coeff S (add_cf S (c_max S c, snd c) (c_max S d, snd d))",
       thin_tac "polyn_expr R X (c_max S d)
            (add_cf S (c_max S c, snd c) (c_max S d, snd d)) = 𝟬")
  apply (drule_tac a = "c_max S d" in forall_spec, simp,
         simp add:add_cf_def,
         frule_tac c = d and k = "fst d" in coeff_nonzero_polyn_nonzero,
         simp, simp,
         frule_tac c = d in coeff_max_nonzeroTr, assumption+, simp)
done

lemma (in PolynRg) polyn_deg_add1:"⟦p ∈ carrier R; p β‰  𝟬; q ∈ carrier R; 
      q β‰  𝟬; (deg_n R S X p) < (deg_n R S X q)⟧  ⟹  
            deg_n R S X (p Β± q) = (deg_n R S X q)"
apply (cut_tac subring)
apply (frule less_deg_add_nonzero[of p q], assumption+)
apply (frule ex_polyn_expr[of p], erule exE, erule conjE,
       frule ex_polyn_expr[of q], erule exE, erule conjE,
       rename_tac c d)
      apply (simp only:pol_deg_eq_c_max)
apply (frule_tac c = c in coeff_max_bddTr,
       frule_tac c = d in coeff_max_bddTr)
apply (frule_tac c = c and n = "c_max S c" in pol_coeff_le, assumption,
       frule_tac c = d and n = "c_max S d" in pol_coeff_le, assumption)
apply (simp add:polyn_c_max)

apply (frule_tac c = c and k = "c_max S c" in polyn_expr_short, simp,
       frule_tac c = d and k = "c_max S d" in polyn_expr_short, simp,
       simp)
  apply (frule_tac c = "(c_max S c, snd c)" and d = "(c_max S d, snd d)" in 
         polyn_add1, assumption+, simp,
        thin_tac "polyn_expr R X (c_max S c) c =
           polyn_expr R X (c_max S c) (c_max S c, snd c)",
        thin_tac "polyn_expr R X (c_max S d) d =
           polyn_expr R X (c_max S d) (c_max S d, snd d)")
  apply (frule_tac c = "(c_max S c, snd c)" and d = "(c_max S d, snd d)" in 
                  add_cf_pol_coeff, assumption+,
         rule_tac p = "polyn_expr R X (c_max S d)
            (add_cf S (c_max S c, snd c) (c_max S d, snd d))" and
          c = "add_cf S (c_max S c, snd c) (c_max S d, snd d)" and 
          n = "c_max S d" in pol_deg_n)
  apply (rule_tac polyn_mem, simp, simp add:add_cf_len,
         assumption,
         simp add:add_cf_len, simp,
         subst add_cf_def, simp)

  apply (frule_tac c1 = "(c_max S d, snd d)" and k1 = "c_max S d" in 
         coeff_0_pol_0[THEN sym], simp, simp,
         rule coeff_max_nonzeroTr, assumption+,
         erule exE, erule conjE,
         frule_tac i = j and j = "c_max S d" and k = "fst d" in
                le_trans, assumption+, blast)
done

lemma (in PolynRg) polyn_deg_add2:"⟦p ∈ carrier R; p β‰  𝟬; q ∈ carrier R; 
      q β‰  𝟬; p Β± q β‰  𝟬; (deg_n R S X p) = (deg_n R S X q)⟧  ⟹ 
          deg_n R S X (p Β± q) ≀ (deg_n R S X q)"
apply (cut_tac subring)
apply (frule ex_polyn_expr[of p], erule exE, erule conjE,
       frule ex_polyn_expr[of q], erule exE, erule conjE,
       rename_tac c d)
      apply (simp only:pol_deg_eq_c_max)
apply (frule_tac c = c in coeff_max_bddTr,
       frule_tac c = d in coeff_max_bddTr)
apply (frule_tac c = c and n = "c_max S c" in pol_coeff_le, assumption,
       frule_tac c = d and n = "c_max S d" in pol_coeff_le, assumption)
apply (simp add:polyn_c_max)

apply (frule_tac c = c and k = "c_max S c" in polyn_expr_short, simp,
       frule_tac c = d and k = "c_max S d" in polyn_expr_short, simp,
       simp,
       frule_tac c = "(c_max S d, snd c)" and d = "(c_max S d, snd d)" in 
         polyn_add1, simp)
 apply (thin_tac "polyn_expr R X (c_max S d) d =
           polyn_expr R X (c_max S d) (c_max S d, snd d)",
        thin_tac "polyn_expr R X (c_max S d) c =
           polyn_expr R X (c_max S d) (c_max S d, snd c)", simp)
 apply (thin_tac "polyn_expr R X (c_max S d) (c_max S d, snd c) Β±
           polyn_expr R X (c_max S d) (c_max S d, snd d) =
           polyn_expr R X (c_max S d)
            (add_cf S (c_max S d, snd c) (c_max S d, snd d))")
  apply (frule_tac c = "(c_max S d, snd c)" and d = "(c_max S d, snd d)" in 
                  add_cf_pol_coeff, assumption+) 
 apply (cut_tac p = "polyn_expr R X (c_max S d)
                (add_cf S (c_max S d, snd c) (c_max S d, snd d))"
        and c = "add_cf S (c_max S d, snd c) (c_max S d, snd d)" in
        pol_deg_eq_c_max)
   apply (rule_tac polyn_mem, simp) 
      apply (simp add:add_cf_len,
              assumption,
             simp add:add_cf_len, simp)
      apply (thin_tac "deg_n R S X
            (polyn_expr R X (c_max S d)
              (add_cf S (c_max S d, snd c) (c_max S d, snd d))) =
           c_max S (add_cf S (c_max S d, snd c) (c_max S d, snd d))",
             thin_tac "polyn_expr R X (c_max S d)
            (add_cf S (c_max S d, snd c) (c_max S d, snd d)) β‰ 
           𝟬")

  apply (frule_tac c = "add_cf S (c_max S d, snd c) (c_max S d, snd d)" in 
         coeff_max_bddTr)
  apply (simp add:add_cf_len)
done

lemma (in PolynRg) polyn_deg_add3:"⟦p ∈ carrier R; p β‰  𝟬; q ∈ carrier R; 
       q β‰  𝟬; p Β± q β‰  𝟬; (deg_n R S X p) ≀ n; (deg_n R S X q) ≀ n⟧  ⟹ 
          deg_n R S X (p Β± q) ≀ n"
apply (case_tac "(deg_n R S X p) = (deg_n R S X q)",
       frule polyn_deg_add2[of "p" "q"], assumption+,
       simp)
apply (cut_tac less_linear[of "deg_n R S X p" "deg_n R S X q"],
       simp, thin_tac "deg_n R S X p β‰  deg_n R S X q",
       erule disjE, simp add:polyn_deg_add1,
       cut_tac ring_is_ag, simp add:aGroup.ag_pOp_commute[of "R" "p" "q"],
       simp add:polyn_deg_add1)
done

lemma (in PolynRg) polyn_deg_add4:"⟦p ∈ carrier R; q ∈ carrier R; 
      (deg R S X p) ≀ (an n); (deg R S X q) ≀ (an n)⟧  ⟹ 
                    deg R S X (p Β± q) ≀ (an n)"
apply (cut_tac ring_is_ag)
apply (case_tac "p = πŸ¬β‡˜R⇙", simp add:aGroup.ag_l_zero)
apply (case_tac "q =  πŸ¬β‡˜R⇙", simp add:aGroup.ag_r_zero)
apply (case_tac "p Β±β‡˜R⇙ q = πŸ¬β‡˜R⇙", simp add:deg_def)
apply (frule aGroup.ag_pOp_closed[of R p q], assumption+)
apply (simp add:deg_an)
apply (simp only:ale_natle)
apply (simp add:polyn_deg_add3)
done
   
lemma (in PolynRg) polyn_deg_add5:"⟦p ∈ carrier R; q ∈ carrier R; 
       (deg R S X p) ≀ a; (deg R S X q) ≀ a⟧  ⟹ 
                                deg R S X (p Β± q) ≀ a"
apply (case_tac "a = ∞", simp)
apply (cut_tac ring_is_ag,
       case_tac "p = πŸ¬β‡˜R⇙", simp add:aGroup.ag_l_zero[of R],
       case_tac "q = πŸ¬β‡˜R⇙", simp add:aGroup.ag_r_zero,
       simp add:deg_an[of p])
apply (cut_tac an_nat_pos[of "deg_n R S X p"],
       frule ale_trans[of "0" "an (deg_n R S X p)" "a"], assumption+,
       subgoal_tac "an (deg_n R S X p) ≀ an (na a)",
       simp only:ale_natle[of "deg_n R S X p" "na a"])

apply (simp add:deg_an[of q])
apply (cut_tac an_nat_pos[of "deg_n R S X q"],
       frule ale_trans[of "0" "an (deg_n R S X q)" "a"], assumption+,
       subgoal_tac "an (deg_n R S X q) ≀ an (na a)",
       simp only:ale_natle[of "deg_n R S X q" "na a"])
apply (frule polyn_deg_add4[of p q "na a"], assumption+,
       simp add:an_na, simp add:deg_an,
       simp add:deg_an an_na, simp add:an_na)
apply (simp add:deg_an an_na, simp add:deg_an an_na)
done 

lemma (in PolynRg) lower_deg_part:"⟦p ∈ carrier R; p β‰  𝟬; 0 < deg_n R S X p⟧
      ⟹  
 deg R S X (polyn_expr R X (deg_n R S X p - Suc 0)(SOME f. cf_sol R S X p f))
                       < deg R S X p" 
 apply (case_tac "polyn_expr R X (deg_n R S X p - Suc 0) 
                              (SOME f. cf_sol R S X p f) = πŸ¬β‡˜R⇙")
 apply (simp add:deg_def, cut_tac minf_le_any[of "an (deg_n R S X p)"])
 apply (subst less_le, simp, simp add:an_def)
 apply (rule not_sym, rule contrapos_pp, simp+)

 apply (simp add:deg_def, simp add:aless_natless) 
 apply (frule pol_SOME_2[of p], erule conjE)
 apply (simp add:pol_deg_eq_c_max[of p "SOME c. cf_sol R S X p c"])
 apply (frule_tac c = "SOME c. cf_sol R S X p c" in coeff_max_bddTr)

 apply (cut_tac 
  p = "polyn_expr R X (c_max S (SOME c. cf_sol R S X p c) - Suc 0)
          (Eps (cf_sol R S X p))" and c = "(c_max S (SOME c. cf_sol R S X p c) - Suc 0, snd (SOME c. cf_sol R S X p c))" in pol_deg_eq_c_max)
  
  apply (rule polyn_mem, simp, arith)
  apply (rule pol_coeff_le, assumption, arith)
  apply (subst polyn_expr_short, arith, arith, simp)
  apply simp

  apply (cut_tac c = "(c_max S (SOME c. cf_sol R S X p c) - Suc 0,
         snd (SOME c. cf_sol R S X p c))" in coeff_max_bddTr,
         rule pol_coeff_le, assumption, arith, simp)
done 

definition
  ldeg_p :: "[('a, 'm) Ring_scheme, ('a, 'm1) Ring_scheme, 'a, nat, 'a]
                  β‡’ 'a" where
  "ldeg_p R S X d p = polyn_expr R X d (scf_d R S X p (Suc d))"
      (** deg R S X p ≀ (Suc d) **)

definition
  hdeg_p :: "[('a, 'm) Ring_scheme, ('a, 'm1) Ring_scheme, 'a, nat, 'a]
                  β‡’ 'a" where
  "hdeg_p R S X d p = (snd (scf_d R S X p d) d) β‹…rβ‡˜R⇙ (X^β‡—R dβ‡–)"
       (** deg R S X p ≀ d **) 

lemma (in PolynRg) ldeg_p_mem:"⟦p ∈ carrier R; deg R S X p ≀ an (Suc d) ⟧ ⟹
                      ldeg_p R S X d p ∈ carrier R"
apply (frule scf_d_pol[of "p" "Suc d"], assumption+, 
       erule conjE)
apply (simp add:ldeg_p_def)
apply (rule polyn_mem[of "scf_d R S X p (Suc d)" d],
         assumption+)
apply simp
done

lemma (in PolynRg) ldeg_p_zero:"p = πŸ¬β‡˜R⇙ ⟹ ldeg_p R S X d p = πŸ¬β‡˜R⇙"
apply (subgoal_tac "deg R S X p ≀ an (Suc d)",
       subgoal_tac "p ∈ carrier R")
apply (frule scf_d_pol[of "p" "Suc d"], assumption+, 
       erule conjE)
apply simp
apply (frule coeff_0_pol_0[of "scf_d R S X 𝟬 (Suc d)" "Suc d"], simp)
apply (simp add:ldeg_p_def)
apply (subst coeff_0_pol_0[THEN sym, of "scf_d R S X 𝟬 (Suc d)"],
        assumption+, simp)
apply (rule allI, rule impI, simp)
apply (simp, simp add:ring_zero)
apply (simp add:deg_def)
done
 
lemma (in PolynRg) hdeg_p_mem:"⟦p ∈ carrier R; deg R S X p ≀ an (Suc d)⟧ ⟹
                      hdeg_p R S X (Suc d) p ∈ carrier R" 
apply (frule scf_d_pol[of p "Suc d"], assumption+, erule conjE)
apply (simp only:hdeg_p_def, (erule conjE)+)
apply (cut_tac Ring)
apply (rule Ring.ring_tOp_closed[of "R"], assumption)
apply (frule pol_coeff_mem[of "scf_d R S X p (Suc d)" "Suc d"], simp)
apply (cut_tac subring)
apply (simp add:Ring.mem_subring_mem_ring)
apply (rule Ring.npClose[of "R"], assumption+)
apply (rule X_mem_R)
done


   
(*   *****************************************************************
definition ldeg_p :: "[('a, 'm) Ring_scheme, ('a, 'm1) Ring_scheme, 'a, 'a]
                  β‡’ 'a" where
 "ldeg_p R S X p == if p = 𝟬R then 𝟬R 
                       else if deg_n R S X p = 0 then p
                       else polyn_expr R X (fst (s_cf R S X p)  - Suc 0) 
                                                         (s_cf R S X p)" *)
      (** deg R S X p ≀ (Suc d), lower degree part **) (*
definition hdeg_p :: "[('a, 'm) Ring_scheme, ('a, 'm1) Ring_scheme, 'a,'a]
                  β‡’ 'a" where
 "hdeg_p R S X p == if p = 𝟬R then 𝟬R else 
                     (if (deg_n R S X p) = 0 then 𝟬R else
                      (snd (s_cf R S X p) (fst (s_cf R S X p))) β‹…rR 
                              X^R (fst (s_cf R S X p)))" *)
       (** deg R S X p ≀ d, the highest degree term  **)

(*
lemma (in PolynRg) ldeg_p_mem:"p ∈ carrier R  ⟹ ldeg_p R S X p ∈ carrier R"
apply (simp add:ldeg_p_def)
 apply (simp add:ring_zero)
 apply (rule impI, rule impI)
apply (frule s_cf_pol_coeff[of p])
 apply (simp add:polyn_mem)
done   
    
lemma (in PolynRg) ldeg_p_zero:"ldeg_p R S X 𝟬 = 𝟬"
apply (simp add:ldeg_p_def)
done 

lemma (in PolynRg) ldeg_p_zero1:"⟦p ∈ carrier R; p β‰  𝟬; deg_n R S X p = 0⟧ ⟹
                   ldeg_p R S X p = p"
by (simp add:ldeg_p_def)
 
lemma (in PolynRg) hdeg_p_mem:"p ∈ carrier R  ⟹
                                   hdeg_p R S X p ∈ carrier R"
apply (cut_tac ring_is_ag)
apply (cut_tac subring)
apply (simp add:hdeg_p_def)
 apply (case_tac "deg_n R S X p = 0", simp add:aGroup.ag_inc_zero)
apply simp
 apply (simp add:aGroup.ag_inc_zero)
 apply (rule impI)
 apply (frule s_cf_pol_coeff[of p])
 apply (cut_tac X_mem_R,
        rule ring_tOp_closed) 
 apply (simp add:pol_coeff_mem mem_subring_mem_ring)
 apply (rule npClose, assumption)
done *)

lemma (in PolynRg) hdeg_p_zero:"p = 𝟬 ⟹ hdeg_p R S X (Suc d) p = 𝟬"
apply (cut_tac X_mem_R)
apply (subgoal_tac "deg R S X p ≀ an (Suc d)",
       subgoal_tac "p ∈ carrier R")
apply (frule scf_d_pol[of p "Suc d"], assumption+, erule conjE)
apply simp
apply (frule coeff_0_pol_0[of "scf_d R S X 𝟬 (Suc d)" "Suc d"], 
        (erule conjE)+, simp)
apply (simp only:hdeg_p_def)
 apply (rotate_tac -1, drule sym, simp del:npow_suc)
apply (cut_tac subring, 
       simp del:npow_suc add:Subring_zero_ring_zero,
       rule ring_times_0_x, rule npClose, assumption)
apply (simp add:ring_zero)
apply (simp add:deg_def)
done

lemma (in PolynRg) decompos_p:"⟦p ∈ carrier R; deg R S X p ≀ an (Suc d)⟧ ⟹
                p = (ldeg_p R S X d p) Β± (hdeg_p R S X (Suc d) p)"
apply (frule scf_d_pol[of  p "Suc d"], assumption+, erule conjE)
apply (cut_tac subring, (erule conjE)+)
 apply (cut_tac polyn_Suc[of d "scf_d R S X p (Suc d)"])
 apply (simp only:ldeg_p_def hdeg_p_def)
 apply (rotate_tac -1, drule sym, simp del:npow_suc)
 apply (thin_tac "polyn_expr R X d (scf_d R S X p (Suc d)) Β±
     snd (scf_d R S X p (Suc d)) (Suc d) β‹…r X^β‡—R (Suc d)β‡– =
     polyn_expr R X (Suc d) (Suc d, snd (scf_d R S X p (Suc d)))")
 apply (simp add:polyn_expr_split[of "Suc d" "scf_d R S X p (Suc d)"],
        simp)
done

lemma (in PolynRg) deg_ldeg_p:"⟦p ∈ carrier R; deg R S X p ≀ an (Suc d)⟧  ⟹  
                deg R S X (ldeg_p R S X d p) ≀ an d"
apply (cut_tac subring,
       frule subring_Ring)
apply (case_tac "p = πŸ¬β‡˜R⇙")
apply (simp add:ldeg_p_zero, simp add:deg_def)
apply (frule scf_d_pol[of p "Suc d"], assumption+, (erule conjE)+)
apply (simp only:ldeg_p_def)
apply (case_tac "polyn_expr R X d (scf_d R S X p (Suc d)) = πŸ¬β‡˜R⇙")
apply (simp add:deg_def)

apply (simp add:deg_an)
apply (simp add:ale_natle)
apply (cut_tac pol_deg_le_n1[of "polyn_expr R X d (scf_d R S X p (Suc d))" 
       "scf_d R S X p (Suc d)" d], simp add:deg_def ale_natle)
apply (rule polyn_mem, assumption+, simp+) 
done

lemma (in PolynRg) deg_minus_eq:"⟦p ∈ carrier R; p β‰  𝟬⟧ ⟹  
                    deg_n R S X (-a p) = deg_n R S X p"
apply (cut_tac subring, 
       cut_tac ring_is_ag,
       frule subring_Ring)
apply (cut_tac ring_is_ag)
 apply (frule s_cf_expr[of p], assumption, (erule conjE)+,
        frule polyn_minus_m_cf[of "s_cf R S X p" "fst (s_cf R S X p)"], simp,
        drule sym, simp)
 apply (frule_tac x = p in aGroup.ag_mOp_closed, assumption+,
        frule m_cf_pol_coeff [of "s_cf R S X p"],
        frule pol_deg_n[of "-a p" "m_cf S (s_cf R S X p)" 
              "fst (s_cf R S X p)"], assumption,
        simp add:m_cf_len, assumption+)
 apply (simp add:m_cf_def,
        frule pol_coeff_mem[of "s_cf R S X p" "fst (s_cf R S X p)"], simp,
        frule Ring.ring_is_ag[of S])
 apply (rule contrapos_pp, simp+)
 apply (frule aGroup.ag_inv_inv[THEN sym, 
          of S "snd (s_cf R S X p) (fst (s_cf R S X p))"], assumption,
        simp add:aGroup.ag_inv_zero)
 apply (drule sym, simp, simp add:s_cf_deg)
done

lemma (in PolynRg) deg_minus_eq1:"p ∈ carrier R ⟹ 
                       deg R S X (-a p) = deg R S X p"
apply (cut_tac ring_is_ag)
apply (case_tac "p = πŸ¬β‡˜R⇙")
apply (simp add:aGroup.ag_inv_zero)
apply (frule deg_minus_eq[of p], assumption+,
       frule aGroup.ag_inv_inj[of "R" "p" "𝟬"], assumption,
       simp add:ring_zero, assumption, simp add:aGroup.ag_inv_zero)
apply (frule aGroup.ag_mOp_closed[of R p], assumption,
       simp add:deg_an)
done

lemma (in PolynRg) ldeg_p_pOp:"⟦p ∈ carrier R; q ∈ carrier R;
      deg R S X p ≀ an (Suc d); deg R S X q ≀ an (Suc d)⟧ ⟹
      (ldeg_p R S X d p) Β±β‡˜R⇙ (ldeg_p R S X d q) =
                              ldeg_p R S X d (p Β±β‡˜R⇙ q)"
apply (simp add:ldeg_p_def,
       cut_tac ring_is_ag, cut_tac subring, frule subring_Ring[of S],
       frule scf_d_pol[of p "Suc d"], assumption+,
       frule scf_d_pol[of q "Suc d"], assumption+, (erule conjE)+)
apply (frule polyn_add1[of "scf_d R S X p (Suc d)" "scf_d R S X q (Suc d)"],
       assumption+,
       rotate_tac -2, drule sym,
       frule aGroup.ag_pOp_closed[of "R" "p" "q"], assumption+,
       frule polyn_deg_add4 [of p q "Suc d"], assumption+,
       rotate_tac -5, drule sym) 
apply simp
apply (rotate_tac 4, drule sym, simp) 

apply (rotate_tac -1, drule sym,
       frule scf_d_pol[of "p Β± q" "Suc d"], assumption+, (erule conjE)+,
       frule box_equation[of "p Β± q" "polyn_expr R X (Suc d)
        (add_cf S (scf_d R S X p (Suc d)) (scf_d R S X q (Suc d)))" 
        "polyn_expr R X (Suc d) (scf_d R S X (p Β± q) (Suc d))"], assumption+,
       thin_tac "p Β± q =
        polyn_expr R X (Suc d) (scf_d R S X (p Β± q) (Suc d))")
apply (frule add_cf_pol_coeff[of "scf_d R S X p (Suc d)" 
                   "scf_d R S X q (Suc d)"],  assumption+)
apply (frule pol_expr_unique2[of "add_cf S (scf_d R S X p (Suc d)) 
       (scf_d R S X q (Suc d))" "scf_d R S X (p Β± q) (Suc d)"], assumption+)
 apply (subst add_cf_len[of "scf_d R S X p (Suc d)" "scf_d R S X q (Suc d)"], 
       assumption+) 
 apply (thin_tac "polyn_expr R X (Suc d) (scf_d R S X p (Suc d)) = p",
        thin_tac "polyn_expr R X (Suc d) (scf_d R S X q (Suc d)) = q",
        thin_tac "p Β± q = polyn_expr R X (Suc d)
          (add_cf S (scf_d R S X p (Suc d)) (scf_d R S X q (Suc d)))",
        thin_tac "polyn_expr R X (Suc d)
          (add_cf S (scf_d R S X p (Suc d)) (scf_d R S X q (Suc d))) =
           polyn_expr R X (Suc d) (scf_d R S X (p Β± q) (Suc d))")
 apply simp
 apply (thin_tac "polyn_expr R X (Suc d) (scf_d R S X p (Suc d)) = p",
        thin_tac "polyn_expr R X (Suc d) (scf_d R S X q (Suc d)) = q",
        thin_tac "p Β± q = polyn_expr R X (Suc d)
          (add_cf S (scf_d R S X p (Suc d)) (scf_d R S X q (Suc d)))")

 apply (simp add:add_cf_len,
       thin_tac "polyn_expr R X (Suc d)
      (add_cf S (scf_d R S X p (Suc d)) (scf_d R S X q (Suc d))) =
     polyn_expr R X (Suc d) (scf_d R S X (p Β± q) (Suc d))")
 apply (subst  polyn_expr_short[of "scf_d R S X p (Suc d)" d], assumption,
        simp)
 apply (subst  polyn_expr_short[of "scf_d R S X q (Suc d)" d], assumption,
        simp)
 apply (subst polyn_add_n[of d "snd (scf_d R S X p (Suc d))" 
               "snd (scf_d R S X q (Suc d))"])
 apply (simp add:split_pol_coeff, simp add:split_pol_coeff,
        subst polyn_expr_def)
 apply (rule aGroup.nsum_eq, assumption+,
        rule allI, rule impI,
        frule_tac j = j in pol_coeff_mem[of "scf_d R S X p (Suc d)"],
               simp,
        frule_tac j = j in pol_coeff_mem[of "scf_d R S X q (Suc d)"],
               simp,
        cut_tac Ring, rule Ring.ring_tOp_closed, assumption+,
        rule Ring.mem_subring_mem_ring[of R S], assumption+,
        frule Ring.ring_is_ag[of S], rule aGroup.ag_pOp_closed[of S],
               assumption+,
        rule Ring.npClose, assumption, simp add:X_mem_R)
 apply (rule allI, rule impI,
        frule_tac j = j in pol_coeff_mem[of "scf_d R S X (p Β± q) (Suc d)"], 
        simp, cut_tac Ring,
        subst Ring.ring_tOp_closed, assumption,
        rule Ring.mem_subring_mem_ring[of R S], assumption+,
        rule Ring.npClose, assumption, simp add:X_mem_R,
        simp)
 apply (rule allI, rule impI,
        drule_tac a = j in forall_spec, simp,
        thin_tac " pol_coeff S
          (add_cf S (scf_d R S X p (Suc d)) (scf_d R S X q (Suc d)))")
 apply (simp add:add_cf_def)
done

lemma (in PolynRg) hdeg_p_pOp:"⟦p ∈ carrier R; q ∈ carrier R;
      deg R S X p ≀ an (Suc d); deg R S X q ≀ an (Suc d)⟧ ⟹
      (hdeg_p R S X (Suc d) p) Β± (hdeg_p R S X (Suc d) q) =
                              hdeg_p R S X (Suc d) (p Β± q)"
apply (cut_tac Ring, frule Ring.ring_is_ag[of "R"])
apply (cut_tac subring, frule subring_Ring[of S])
apply (frule scf_d_pol[of p "Suc d"], assumption+,
       frule scf_d_pol[of q "Suc d"], assumption+,
        (erule conjE)+)
apply (frule polyn_add1[of "scf_d R S X p (Suc d)" "scf_d R S X q (Suc d)"],
       assumption+,
       rotate_tac -2, drule sym,
       frule aGroup.ag_pOp_closed[of "R" "p" "q"], assumption+,
       frule polyn_deg_add4 [of p q "Suc d"], assumption+,
       rotate_tac -5, drule sym) 
apply simp
apply (rotate_tac -13, drule sym, simp)
apply (rotate_tac -1, drule sym)
apply (frule scf_d_pol[of "p Β± q" "Suc d"], assumption+, (erule conjE)+)
apply (drule box_equation[of "p Β± q" "polyn_expr R X (Suc d)
       (add_cf S (scf_d R S X p (Suc d)) (scf_d R S X q (Suc d)))" 
       "polyn_expr R X (Suc d) (scf_d R S X (p Β± q) (Suc d))"],
       assumption+) apply (
      thin_tac "p Β± q = polyn_expr R X (Suc d) (scf_d R S X (p Β± q) (Suc d))")
apply (frule add_cf_pol_coeff[of "scf_d R S X p (Suc d)"
        "scf_d R S X q (Suc d)"], assumption+)
apply (cut_tac pol_expr_unique2[of "add_cf S (scf_d R S X p (Suc d)) 
       (scf_d R S X q (Suc d))" "scf_d R S X (p Β± q) (Suc d)"], 
       simp add:add_cf_len) 
apply (drule_tac a = "Suc d" in forall_spec, simp)
 apply (simp del:npow_suc add:hdeg_p_def)
 apply (rotate_tac -1, drule sym, simp del:npow_suc)
 apply (subst add_cf_def, simp del:npow_suc)
 apply (thin_tac "polyn_expr R X (Suc d) (scf_d R S X p (Suc d)) = p",
        thin_tac "polyn_expr R X (Suc d) (scf_d R S X q (Suc d)) = q",
        thin_tac "polyn_expr R X (Suc d) (add_cf S (scf_d R S X p (Suc d)) 
         (scf_d R S X q (Suc d))) =
          polyn_expr R X (Suc d) (scf_d R S X (p Β± q) (Suc d))",
        thin_tac "pol_coeff S (add_cf S (scf_d R S X p (Suc d)) 
                  (scf_d R S X q (Suc d)))",
        thin_tac "snd (scf_d R S X (p Β± q) (Suc d)) (Suc d) =
     snd (add_cf S (scf_d R S X p (Suc d)) (scf_d R S X q (Suc d))) (Suc d)")
 apply (frule pol_coeff_mem[of "scf_d R S X p (Suc d)" "Suc d"], 
        simp del:npow_suc,
        frule pol_coeff_mem[of "scf_d R S X q (Suc d)" "Suc d"], 
        simp del:npow_suc)
 apply (simp del:npow_suc add:Subring_pOp_ring_pOp)
 apply (frule mem_subring_mem_ring[of S "snd (scf_d R S X p (Suc d)) (Suc d)"],
        assumption,
        frule mem_subring_mem_ring[of S "snd (scf_d R S X q (Suc d)) (Suc d)"],
        assumption,
        cut_tac X_mem_R, frule Ring.npClose[of R X "Suc d"], assumption+)
 apply (subst Ring.ring_distrib2[THEN sym], assumption+, simp)

 apply (simp add:add_cf_pol_coeff, simp)
 apply (simp add:add_cf_len)
done

lemma (in PolynRg) ldeg_p_mOp:"⟦p ∈ carrier R; deg R S X p ≀ an (Suc d)⟧ ⟹ 
       -a (ldeg_p R S X d p) = ldeg_p R S X d (-a p)"
apply (cut_tac Ring, frule Ring.ring_is_ag[of "R"],
       cut_tac subring, frule subring_Ring[of S],
       frule scf_d_pol[of p "Suc d"], assumption+, (erule conjE)+,
       frule aGroup.ag_mOp_closed[of R p], assumption,
       frule scf_d_pol[of "-a p" "Suc d"])
apply (simp add:deg_minus_eq1, (erule conjE)+)
apply (frule polyn_minus[of "scf_d R S X p (Suc d)"  "Suc d"], simp)
apply (drule box_equation[of "-a p" "polyn_expr R X (Suc d)
       (scf_d R S X (-a p) (Suc d))"
       "polyn_expr R X (Suc d) (fst (scf_d R S X p (Suc d)), 
                Ξ»j. -aβ‡˜S⇙ snd (scf_d R S X p (Suc d)) j)"])
apply (rotate_tac 8, drule sym, simp,
       thin_tac "-a polyn_expr R X (Suc d) (scf_d R S X p (Suc d)) =
       polyn_expr R X (Suc d)
       (fst (scf_d R S X p (Suc d)), Ξ»j. -aβ‡˜S⇙ snd (scf_d R S X p (Suc d)) j)")
apply simp
apply (frule pol_expr_unique2[of "scf_d R S X (-a p) (Suc d)" 
       "(Suc d, Ξ»j. -aβ‡˜S⇙ snd (scf_d R S X p (Suc d)) j)"])
 apply (subst pol_coeff_def, rule allI, rule impI, simp)
 apply (frule_tac j = j in pol_coeff_mem[of "scf_d R S X p (Suc d)"],
        simp,
        frule Ring.ring_is_ag[of S],
        rule aGroup.ag_mOp_closed[of S], assumption+, simp)
 apply simp

 apply (simp add:ldeg_p_def)
 apply (subst polyn_minus[of "scf_d R S X p (Suc d)" d], assumption, simp,
        simp)
 apply (subst polyn_expr_short[of "(Suc d, 
              Ξ»j. -aβ‡˜S⇙ snd (scf_d R S X p (Suc d)) j)" d])
  apply (subst pol_coeff_def, rule allI, rule impI, simp,
         frule_tac j = j in pol_coeff_mem[of "scf_d R S X p (Suc d)"],
         simp,
         frule Ring.ring_is_ag[of S],
         rule aGroup.ag_mOp_closed[of S], assumption+, simp) 
  apply (subst polyn_expr_short[of "scf_d R S X (-a p) (Suc d)" d], 
          assumption, simp)
 apply (cut_tac pol_expr_unique2[of "(d, snd (Suc d, 
                Ξ»j. -aβ‡˜S⇙ snd (scf_d R S X p (Suc d)) j))" 
                "(d, snd (scf_d R S X (-a p) (Suc d)))"])
 apply (thin_tac "p = polyn_expr R X (Suc d) (scf_d R S X p (Suc d))",
        thin_tac "polyn_expr R X (Suc d) (scf_d R S X (-a p) (Suc d)) =
     polyn_expr R X (Suc d) (Suc d, Ξ»j. -aβ‡˜S⇙ snd (scf_d R S X p (Suc d)) j)",
        simp)
  apply (subst pol_coeff_def, rule allI, rule impI, simp,
         frule Ring.ring_is_ag[of S], rule aGroup.ag_mOp_closed, assumption,
         simp add:pol_coeff_mem)
  apply (subst pol_coeff_def, rule allI, rule impI, simp,
         frule Ring.ring_is_ag[of S], rule aGroup.ag_mOp_closed, assumption,
         simp add:pol_coeff_mem)
  apply simp
done

lemma (in PolynRg) hdeg_p_mOp:"⟦p ∈ carrier R;deg R S X p ≀ an (Suc d)⟧ 
  ⟹ -a (hdeg_p R S X (Suc d) p) = hdeg_p R S X (Suc d) (-a p)"
apply (cut_tac Ring, frule Ring.ring_is_ag[of "R"],
       cut_tac subring, frule subring_Ring[of S],
       frule scf_d_pol[of p "Suc d"], assumption+, (erule conjE)+,
       frule aGroup.ag_mOp_closed[of R p], assumption) apply (
       frule scf_d_pol[of "-a p" "Suc d"])
apply (simp add:deg_minus_eq1, (erule conjE)+)
apply (frule polyn_minus[of "scf_d R S X p (Suc d)"  "Suc d"], simp)
apply (drule box_equation[of "-a p" "polyn_expr R X (Suc d)
       (scf_d R S X (-a p) (Suc d))"
       "polyn_expr R X (Suc d) (fst (scf_d R S X p (Suc d)), 
                Ξ»j. -aβ‡˜S⇙ snd (scf_d R S X p (Suc d)) j)"])
apply (rotate_tac 8, drule sym, simp,
       thin_tac "-a polyn_expr R X (Suc d) (scf_d R S X p (Suc d)) =
       polyn_expr R X (Suc d)
       (fst (scf_d R S X p (Suc d)), Ξ»j. -aβ‡˜S⇙ snd (scf_d R S X p (Suc d)) j)")
apply simp

apply (frule pol_expr_unique2[of "scf_d R S X (-a p) (Suc d)" 
       "(Suc d, Ξ»j. -aβ‡˜S⇙ snd (scf_d R S X p (Suc d)) j)"])
 apply (subst pol_coeff_def, rule allI, rule impI, simp)
 apply (frule_tac j = j in pol_coeff_mem[of "scf_d R S X p (Suc d)"],
        simp,
        frule Ring.ring_is_ag[of S],
        rule aGroup.ag_mOp_closed[of S], assumption+, simp)
 apply simp
 apply (drule_tac a = "Suc d" in forall_spec, simp)
 apply (simp del:npow_suc add:hdeg_p_def)
 apply (thin_tac "p = polyn_expr R X (Suc d) (scf_d R S X p (Suc d))",
        thin_tac "polyn_expr R X (Suc d) (scf_d R S X (-a p) (Suc d)) =
     polyn_expr R X (Suc d) (Suc d, Ξ»j. -aβ‡˜S⇙ snd (scf_d R S X p (Suc d)) j)",
        thin_tac "snd (scf_d R S X (-a p) (Suc d)) (Suc d) =
     -aβ‡˜S⇙ snd (scf_d R S X p (Suc d)) (Suc d)")
 apply (frule pol_coeff_mem[of "scf_d R S X p (Suc d)" "Suc d"], simp,
        frule mem_subring_mem_ring[of S "snd (scf_d R S X p (Suc d)) (Suc d)"],
        assumption+,
        frule Ring.npClose[of R X "Suc d"], simp add:X_mem_R)
apply (subst Ring.ring_inv1_1[of "R"], assumption+)
apply (simp del:npow_suc add:Subring_minus_ring_minus)
done

subsection "Multiplication of polynomials"

lemma (in PolynRg) deg_mult_pols:"⟦Idomain S;
      p ∈ carrier R; p β‰  𝟬; q ∈ carrier R; q β‰  𝟬 ⟧ ⟹ 
      p β‹…r q β‰  𝟬 ∧
     deg_n R S X (p β‹…r q) = deg_n R S X p + deg_n R S X q"
apply (frule Idomain.idom_is_ring[of "S"],
       frule_tac x = p and y = q in ring_tOp_closed, assumption+)
 apply (frule s_cf_expr[of p], assumption,
        frule s_cf_expr[of q], assumption, (erule conjE)+)
 apply (frule_tac c = "s_cf R S X p" and d = "s_cf R S X q" in 
        polyn_expr_tOp_c, assumption, erule exE, (erule conjE)+)
 apply (drule sym, drule sym, simp,
        thin_tac "polyn_expr R X (fst (s_cf R S X q)) (s_cf R S X q) = q",
        thin_tac "polyn_expr R X (fst (s_cf R S X p)) (s_cf R S X p) = p")
 apply (rotate_tac -1, drule sym,
        frule ring_tOp_closed[of p q], assumption+,
        frule pol_coeff_mem[of "s_cf R S X p" "fst (s_cf R S X p)"], simp,
        frule pol_coeff_mem[of "s_cf R S X q" "fst (s_cf R S X q)"], simp,
        frule_tac x = "snd (s_cf R S X p) (fst (s_cf R S X p))" and 
        y = "snd (s_cf R S X q) (fst (s_cf R S X q))" in 
        Idomain.idom_tOp_nonzeros[of "S"], assumption+,
        frule_tac c = e in  coeff_nonzero_polyn_nonzero[ of _ 
        "deg_n R S X p + deg_n R S X q"], simp)
 apply (simp add:s_cf_deg, simp add:s_cf_deg)
 apply (cut_tac n = "fst (s_cf R S X p) + fst (s_cf R S X q)" in le_refl)
 apply (subgoal_tac "βˆƒj≀fst (s_cf R S X p) + 
                       fst (s_cf R S X q). snd e j β‰  πŸ¬β‡˜S⇙", simp)
 apply (cut_tac c = e in pol_deg_n[of "p β‹…r q" _ 
                "fst (s_cf R S X p) + fst (s_cf R S X q)"], simp+)
  apply (thin_tac "(polyn_expr R X (fst (s_cf R S X p) + 
          fst (s_cf R S X q)) e β‰  𝟬) =
         (βˆƒj≀fst (s_cf R S X p) + fst (s_cf R S X q). snd e j β‰  πŸ¬β‡˜S⇙)",
        thin_tac "p β‹…r q =
         polyn_expr R X (fst (s_cf R S X p) + fst (s_cf R S X q)) e",
        thin_tac "polyn_expr R X (fst (s_cf R S X p) + fst (s_cf R S X q)) e
         ∈ carrier R",
        thin_tac "snd (s_cf R S X p) (fst (s_cf R S X p)) ∈ carrier S",
        thin_tac "snd (s_cf R S X q) (fst (s_cf R S X q)) ∈ carrier S")
 apply (drule sym, drule sym, simp)
 apply (cut_tac n = "fst e" in le_refl, blast)
done
      
lemma (in PolynRg) deg_mult_pols1:"⟦Idomain S; p ∈ carrier R; q ∈ carrier R⟧
       ⟹ 
          deg R S X (p β‹…r q) = deg R S X p + deg R S X q"
apply (case_tac "p = πŸ¬β‡˜R⇙", simp add:ring_times_0_x, simp add:deg_def,
       rule impI) 
 apply (simp add:an_def)
apply (case_tac "q = πŸ¬β‡˜R⇙", simp add:ring_times_x_0, simp add:deg_def)
 apply (simp add:an_def)

apply (frule deg_mult_pols[of p q], assumption+, erule conjE)
apply (frule Idomain.idom_is_ring[of "S"])
apply (frule ring_tOp_closed[of p q], assumption+)
apply (simp add:deg_an an_def a_zpz)
done
       
lemma (in PolynRg) const_times_polyn:"⟦Idomain S; c ∈ carrier S; c β‰  πŸ¬β‡˜S⇙; 
       p ∈ carrier R; p β‰  𝟬⟧ ⟹ (c β‹…r p) β‰  𝟬  ∧
       deg_n R S X (c β‹…r p) = deg_n R S X p"
apply (frule Idomain.idom_is_ring[of "S"],
       cut_tac subring,
       frule mem_subring_mem_ring[of S c], assumption+,
       simp add:Subring_zero_ring_zero)
apply (frule deg_mult_pols[of c p], assumption+,
       erule conjE, simp,
       simp add:pol_of_deg0[THEN sym, of "c"])
done

(*lemma (in PolynRg) deg_minus_eq:"⟦ring R; integral_domain S; polyn_ring R S X; 
p ∈ carrier R; p β‰  0R⟧ ⟹   deg_n R S X (-R p) = deg_n R S X p" *)

lemma (in PolynRg) p_times_monomial_nonzero:"⟦p ∈ carrier R; p β‰  𝟬⟧ ⟹
                                                          (X^β‡—R jβ‡–) β‹…r p β‰  𝟬"
apply (cut_tac subring, frule subring_Ring)
apply (frule s_cf_expr[of p], assumption+, (erule conjE)+)
apply (frule low_deg_terms_zero1[THEN sym, of "s_cf R S X p" j])
 apply (drule sym, simp,
        thin_tac "X^⇗R j⇖ ⋅r p =
     polyn_expr R X (fst (s_cf R S X p) + j) (ext_cf S j (s_cf R S X p))",
         thin_tac "polyn_expr R X (fst (s_cf R S X p)) (s_cf R S X p) = p")
 apply (frule ext_cf_pol_coeff[of "s_cf R S X p" j])
 apply(frule coeff_nonzero_polyn_nonzero[of "ext_cf S j (s_cf R S X p)"
                                      "fst (ext_cf S j (s_cf R S X p))"],
       simp)
 apply (simp add:ext_cf_len add.commute[of j],
     thin_tac "(polyn_expr R X (fst (s_cf R S X p) + j) 
         (ext_cf S j (s_cf R S X p)) β‰  𝟬) =
     (βˆƒja≀fst (s_cf R S X p) + j. snd (ext_cf S j (s_cf R S X p)) ja β‰  πŸ¬β‡˜S⇙)")
 apply (cut_tac ext_cf_hi[of "s_cf R S X p" j], simp,
        thin_tac "snd (s_cf R S X p) (fst (s_cf R S X p)) =
        snd (ext_cf S j (s_cf R S X p)) (j + fst (s_cf R S X p))",
        simp add:add.commute[of _ j])
 apply (cut_tac n = "j + fst (s_cf R S X p)" in le_refl, blast)
 apply assumption
done

lemma (in PolynRg) p_times_monomial_nonzero1:"⟦Idomain S; p ∈ carrier R; 
       p β‰  𝟬; c ∈ carrier S; c β‰  πŸ¬β‡˜Sβ‡™βŸ§ ⟹(c β‹…r (X^β‡—R jβ‡–)) β‹…r p β‰  𝟬"
apply (frule Idomain.idom_is_ring[of "S"],
       cut_tac subring,
       cut_tac X_mem_R ,
       frule mem_subring_mem_ring[of S c], assumption+,
       frule npClose[of X j])
apply (simp add:ring_tOp_commute[of c],
       simp add:ring_tOp_assoc,
       frule const_times_polyn[of c p], assumption+,
       erule conjE,
       frule ring_tOp_closed[of c p], assumption+,
       simp add:p_times_monomial_nonzero[of "c β‹…r p"])
done

lemma (in PolynRg) polyn_ring_integral:"Idomain S = Idomain R"
apply (cut_tac subring, frule subring_Ring)
apply (rule iffI)
apply (subst Idomain_def) 
 apply (cut_tac Ring, simp)
 
 apply (rule Idomain_axioms.intro,
        rule contrapos_pp, simp+, erule conjE,
        frule_tac p = a and q = b in deg_mult_pols,
       assumption+, erule conjE, simp)

apply (subst Idomain_def) 
 apply (cut_tac Ring, simp)
 apply (rule Idomain_axioms.intro,
        rule contrapos_pp, simp+, erule conjE)
 apply (simp add:Subring_tOp_ring_tOp)
 apply (frule_tac x = a in mem_subring_mem_ring[of S], assumption,
        frule_tac x = b in mem_subring_mem_ring[of S], assumption)
 apply (frule_tac a = a and b = b in Idomain.idom[of R], assumption+)
        apply (simp add:Subring_zero_ring_zero)
 apply (erule disjE, simp add:Subring_zero_ring_zero)
 apply (simp add:Subring_zero_ring_zero)
done

lemma (in PolynRg) deg_to_X_d:"Idomain S ⟹  deg_n R S X (X^β‡—R dβ‡–) = d"
apply (cut_tac subring, frule subring_Ring,
       cut_tac polyn_ring_S_nonzero,
       cut_tac X_mem_R,
       cut_tac polyn_ring_X_nonzero,
       cut_tac polyn_ring_integral)
apply (induct_tac d)
 apply (cut_tac ring_one,
        simp add:Subring_one_ring_one[THEN sym],
        simp add:Subring_zero_ring_zero)
 apply (subst pol_of_deg0[of "1rβ‡˜S⇙"], assumption+, simp add:Ring.ring_one[of S])
 apply simp
 apply (subst deg_mult_pols, assumption+,
        simp add:npClose, 
        rule Idomain.idom_potent_nonzero, assumption+)
 apply (simp add:deg_n_of_X)
done

subsection β€ΉDegree with value in β€Ήaug_minfβ€Ίβ€Ί

lemma (in PolynRg) nonzero_deg_pos:"⟦p ∈ carrier R; p β‰  𝟬⟧ ⟹ 
                                                 0 ≀ deg R S X p"
by (simp add:deg_def) 

lemma (in PolynRg) deg_minf_pol_0:"p ∈ carrier R ⟹
                    (deg R S X p = -∞) = (p = 𝟬)" 
apply (rule iffI)
 apply (rule contrapos_pp, simp+,
        frule nonzero_deg_pos[of p], assumption+,
        simp add:deg_def an_def) 
apply (simp add:deg_def)
done

lemma (in PolynRg) pol_nonzero:"p ∈ carrier R ⟹
             (0 ≀ deg R S X p) = (p β‰  𝟬)" 
apply (rule iffI)
apply (rule contrapos_pp, simp+, simp add:deg_def,
       cut_tac minf_le_any[of "0"], frule ale_antisym[of "0" "-∞"], 
       assumption+,
       simp only:an_0[THEN sym], simp only:an_def, simp del:of_nat_0)
apply (simp add:deg_def) 
done

lemma (in PolynRg) minus_deg_in_aug_minf:"⟦p ∈ carrier R; p β‰  𝟬⟧ ⟹
                   - (deg R S X p) ∈ Z-∞"
apply (frule deg_in_aug_minf[of p],
      frule pol_nonzero[THEN sym, of p],
      simp add:aug_minf_def,
      rule contrapos_pp, simp+,
      cut_tac a_minus_minus[of "deg R S X p"], simp) 

apply (thin_tac "- deg R S X p = ∞", frule sym, 
       thin_tac "- ∞ = deg R S X p",
       frule deg_minf_pol_0[of p], simp)
done

lemma (in PolynRg) deg_of_X:"deg R S X X = 1" (* the degree of the polyn. X *)
apply (cut_tac X_mem_R,
       cut_tac polyn_ring_X_nonzero,
       cut_tac subring)
apply (simp add:deg_def, simp only:an_1[THEN sym],
       rule nat_eq_an_eq, simp add:deg_n_of_X)
done

lemma (in PolynRg) pol_deg_0:"⟦p ∈ carrier R; p β‰  𝟬⟧
                   ⟹  (deg R S X p = 0) = (p ∈ carrier S)"
apply (simp add:deg_def, simp only:an_0[THEN sym],
       rule iffI,
       frule an_inj[of "deg_n R S X p" "0"], simp,
       simp add:pol_of_deg0,
       rule nat_eq_an_eq, simp add:pol_of_deg0[of p])
done

lemma (in PolynRg) deg_of_X2n:"Idomain S ⟹ deg R S X (X^β‡—R nβ‡–) = an n"
apply (frule Idomain.idom_is_ring[of "S"])
apply (cut_tac subring,
       cut_tac X_mem_R,
       cut_tac polyn_ring_X_nonzero,
       cut_tac polyn_ring_integral, simp)
apply (induct_tac n)
apply simp
 apply (simp add:Subring_one_ring_one[THEN sym, of "S"])
 apply (subst pol_deg_0[of "1rβ‡˜S⇙"])
 apply (simp add:Subring_one_ring_one, simp add:ring_one)
 apply (simp add:Subring_one_ring_one[of S] polyn_ring_nonzero)
 apply (simp add:Ring.ring_one[of S])

apply (frule_tac n = n in npClose[of X])
apply (simp add:deg_def)
apply (simp add:Idomain.idom_potent_nonzero,
       frule_tac n = "Suc n" in Idomain.idom_potent_nonzero[of R X],
       assumption+, simp)
apply (rule nat_eq_an_eq) 
apply (frule_tac n = n in Idomain.idom_potent_nonzero[of R X], assumption+)
apply (frule_tac n = "deg_n R S X (X^⇗R n⇖)" and m = n in an_inj,
       thin_tac "an (deg_n R S X (X^⇗R n⇖)) = an n")
 apply (cut_tac deg_of_X)
 apply (simp add:deg_def, simp only:an_1[THEN sym])
apply (frule_tac n = "deg_n R S X X" and m = 1 in an_inj)
 apply (simp add:deg_mult_pols)
done

lemma (in PolynRg) add_pols_nonzero:"⟦p ∈ carrier R; q ∈ carrier R; 
      (deg R S X p) β‰  (deg R S X q)⟧  ⟹  p Β± q β‰  𝟬"
apply (cut_tac ring_is_ag,
       cut_tac subring,
       frule subring_Ring)
apply (case_tac "p = πŸ¬β‡˜R⇙", simp add:deg_minf_pol_0[THEN sym],
       simp add:aGroup.ag_l_zero, rule contrapos_pp, simp+,
       case_tac "q = πŸ¬β‡˜R⇙", simp add:aGroup.ag_r_zero)
apply (simp add:deg_def, 
       simp only:aneq_natneq[of "deg_n R S X p" "deg_n R S X q"],
       cut_tac less_linear[of "deg_n R S X p" "deg_n R S X q"], simp,
       erule disjE,
       rule less_deg_add_nonzero[of p q],
         assumption+,
       frule less_deg_add_nonzero[of q p], assumption+,
       simp add:aGroup.ag_pOp_commute)
done

lemma (in PolynRg) deg_pols_add1:"⟦p ∈ carrier R; q ∈ carrier R; 
                (deg R S X p) < (deg R S X q)⟧  ⟹  
                              deg R S X (p Β± q) = deg R S X q"
apply (cut_tac ring_is_ag,
       case_tac "p = πŸ¬β‡˜R⇙", simp add:deg_def aGroup.ag_l_zero,
       case_tac "q = πŸ¬β‡˜R⇙", simp add:deg_def) 
       apply (rule impI) apply (simp add:an_def z_neq_minf)
 apply (fold an_def,
        frule aless_imp_le[of "an (deg_n R S X p)" " - ∞"],
        cut_tac minf_le_any[of "an (deg_n R S X p)"],
        frule ale_antisym[of "an (deg_n R S X p)" "- ∞"], assumption+,
        simp add:an_neq_minf)
apply (simp add:deg_def, simp add:aless_nat_less,
       frule less_deg_add_nonzero[of p q], assumption+,
       simp, frule polyn_deg_add1[of p q], assumption+, simp)
done

lemma (in PolynRg) deg_pols_add2:"⟦p ∈ carrier R; q ∈ carrier R; 
       (deg R S X p) = (deg R S X q)⟧  ⟹ 
               deg R S X (p Β± q) ≀ (deg R S X q)"
apply (cut_tac ring_is_ag, 
       cut_tac subring, frule subring_Ring)
apply (case_tac "p = πŸ¬β‡˜R⇙", simp add:aGroup.ag_l_zero)
apply (case_tac "q = πŸ¬β‡˜R⇙", simp add:aGroup.ag_r_zero)
apply (simp add:deg_def,
       frule an_inj[of "deg_n R S X p" "deg_n R S X q"], simp,
       rule impI, subst ale_natle, simp add:polyn_deg_add2)
done

lemma (in PolynRg) deg_pols_add3:"⟦p ∈ carrier R; q ∈ carrier R; 
       (deg R S X p) ≀ an n; (deg R S X q) ≀ an n⟧  ⟹ 
                  deg R S X (p Β± q) ≀ an n"
apply (case_tac "(deg R S X p) = (deg R S X q)",
       frule deg_pols_add2[of p q], assumption+,
       simp)
apply (cut_tac aless_linear[of "deg R S X p" "deg R S X q"],
       simp, thin_tac "deg R S X p β‰  deg R S X q",
       erule disjE, simp add:deg_pols_add1,
       cut_tac ring_is_ag, simp add:aGroup.ag_pOp_commute[of "R" "p" "q"],
       simp add:deg_pols_add1)
done

lemma (in PolynRg) const_times_polyn1:"⟦Idomain S; p∈ carrier R; c ∈ carrier S;
            c β‰  πŸ¬β‡˜Sβ‡™βŸ§ ⟹ deg R S X (c β‹…r p) = deg R S X p"
apply (frule Idomain.idom_is_ring,
       cut_tac subring,
       frule mem_subring_mem_ring[of S c], assumption,
       simp add:Subring_zero_ring_zero)
apply (subst deg_mult_pols1[of c p], assumption+,
       simp add: pol_deg_0[THEN sym, of "c"],
       simp add:aadd_0_l)
done
 
section "Homomorphism of polynomial rings"

definition
  cf_h :: " ('a β‡’ 'b) β‡’ nat Γ— (nat β‡’ 'a) β‡’ nat Γ— (nat β‡’ 'b)" where
  "cf_h f = (Ξ»c. (fst c, cmp f (snd c)))"

definition
  polyn_Hom :: "[('a, 'm) Ring_scheme, ('a, 'm1) Ring_scheme, 'a,
              ('b, 'n) Ring_scheme, ('b, 'n1) Ring_scheme, 'b] β‡’
              ('a β‡’ 'b) set"
            (β€Ή(pHom _ _ _, _ _ _)β€Ί [67,67,67,67,67,68]67) where
  "pHom R S X, A B Y = {f. f ∈ rHom R A ∧ f`(carrier S) βŠ† carrier B ∧ 
                          f X = Y}"  (* Hom from a polynomial ring to
                                        a polynomial ring *)

definition
  erh :: "[('a, 'm) Ring_scheme, ('a, 'm1) Ring_scheme, 'a,
           ('b, 'n) Ring_scheme, ('b, 'n1) Ring_scheme, 'b, 'a β‡’ 'b, 
          nat, nat Γ— (nat β‡’ 'a)] β‡’ 'b" where
  "erh R S X A B Y f n c = polyn_expr A Y n (cf_h f c)"
 (* extension of a ring hom. *)

lemma (in PolynRg) cf_h_len:"⟦PolynRg A B Y; f ∈ rHom S B; 
                   pol_coeff S c⟧ ⟹ fst (cf_h f c) = fst c"
by (simp add:cf_h_def)

lemma (in PolynRg) cf_h_coeff:"⟦PolynRg A B Y; f ∈ rHom S B; 
                   pol_coeff S c⟧ ⟹  pol_coeff B (cf_h f c)"
apply (subst pol_coeff_def)
 apply (rule allI, rule impI, simp add:cf_h_len cf_h_def)
 apply (frule_tac j = j in pol_coeff_mem[of c], assumption)
 apply (simp add:cmp_def rHom_mem)
done

lemma (in PolynRg) cf_h_cmp:"⟦PolynRg A B Y; pol_coeff S (n, f); h ∈ rHom S B;
                    j ≀ n⟧ ⟹
                 (snd (cf_h h (n, f))) j = (cmp h f) j"
by (simp add:cf_h_def) 

lemma (in PolynRg) cf_h_special_cf:"⟦PolynRg A B Y; h ∈ rHom S B⟧ ⟹
       polyn_expr A Y (Suc 0) (cf_h h (ext_cf S (Suc 0) (C0 S))) =
         polyn_expr A Y (Suc 0) (ext_cf B (Suc 0) (C0 B))"
apply (cut_tac subring, frule subring_Ring,
       frule PolynRg.is_Ring[of A B Y],
       frule PolynRg.subring[of A B Y],
       frule Ring.subring_Ring[of A B], assumption)
apply (cut_tac special_cf_pol_coeff,
       frule ext_cf_pol_coeff[of "C0 S" "Suc 0"],
       frule cf_h_coeff[of A B Y h "ext_cf S (Suc 0) (C0 S)"], assumption+)
apply (frule PolynRg.special_cf_pol_coeff,
       frule PolynRg.ext_cf_pol_coeff[of A B Y "C0 B" "Suc 0"], assumption)
apply (frule PolynRg.pol_expr_unique2[of A B Y 
             "cf_h h (ext_cf S (Suc 0) (C0 S))" "ext_cf B (Suc 0) (C0 B)"],
       assumption+,
       simp add:cf_h_len PolynRg.ext_cf_len,
       simp add:ext_cf_len special_cf_len PolynRg.special_cf_len,
       simp add:cf_h_len PolynRg.ext_cf_len,
       simp add:ext_cf_len special_cf_len PolynRg.special_cf_len,
       thin_tac "(polyn_expr A Y (Suc 0) (cf_h h (ext_cf S (Suc 0) (C0 S))) =
                   polyn_expr A Y (Suc 0) (ext_cf B (Suc 0) (C0 B))) =
                (βˆ€j≀Suc 0.
                  snd (cf_h h (ext_cf S (Suc 0) (C0 S))) j =
                  snd (ext_cf B (Suc 0) (C0 B)) j)",
       thin_tac "pol_coeff S (C0 S)",
       thin_tac "pol_coeff S (ext_cf S (Suc 0) (C0 S))",
       thin_tac "pol_coeff B (cf_h h (ext_cf S (Suc 0) (C0 S)))")
apply (rule allI, rule impI)
 apply (case_tac "j = 0", simp add:cf_h_def cmp_def ext_cf_def sliden_def)
 apply (simp add:rHom_0_0)
 apply (simp)
 apply (frule_tac n = j in Suc_leI[of 0],
        frule_tac m = j and n = "Suc 0" in le_antisym, assumption+,
        thin_tac "j ≀ Suc 0", thin_tac "Suc 0 ≀ j",
        simp add:cf_h_def cmp_def ext_cf_def sliden_def special_cf_def,
        simp add:rHom_one)
done

lemma (in PolynRg) polyn_Hom_coeff_to_coeff:
     "⟦PolynRg A B Y; f ∈ pHom R S X, A B Y; pol_coeff S c⟧
        ⟹  pol_coeff B (cf_h f c)"
apply (subst pol_coeff_def)
 apply (rule allI, rule impI, simp add:cf_h_len cf_h_def)
 apply (frule_tac j = j in pol_coeff_mem[of c], assumption)
 apply (simp add:cmp_def polyn_Hom_def, (erule conjE)+)
 apply (simp add:image_def)
 apply (rule subsetD[of "{y. βˆƒx∈carrier S. y = f x}" "carrier B"], assumption,
        simp)
 apply blast
done (* old name is cmp_pol_coeff *)

lemma (in PolynRg) cf_h_len1:"⟦PolynRg A B Y; h ∈ rHom S B; 
        f ∈ pHom R S X, A B Y; βˆ€x∈carrier S. f x = h x; pol_coeff S c⟧ ⟹ 
        fst (cf_h f c) = fst (cf_h h c)"
by (simp add:cf_h_def)

lemma (in PolynRg) cf_h_len2:"⟦PolynRg A B Y; f ∈ pHom R S X, A B Y; 
          pol_coeff S c⟧ ⟹ fst (cf_h f c) = fst c"
by (simp add:cf_h_def)

lemma (in PolynRg) cmp_pol_coeff:"⟦f ∈ rHom S B; 
       pol_coeff S (n, c)⟧  ⟹ pol_coeff B (n,(cmp f c))"
apply (simp add:pol_coeff_def,
      rule allI, rule impI, simp add:cmp_def,
      frule_tac a = j in forall_spec, simp,
      thin_tac "βˆ€j≀n. c j ∈ carrier S")
apply (simp add:rHom_mem)
done 

lemma (in PolynRg) cmp_pol_coeff_e:"⟦PolynRg A B Y; f ∈ pHom R S X, A B Y; 
         pol_coeff S (n, c)⟧ ⟹ pol_coeff B (n, (cmp f c))"
apply (subst pol_coeff_def)
 apply (rule allI, rule impI, simp)
 apply (frule_tac j = j in pol_coeff_mem[of "(n, c)"], simp)
 apply (simp add:polyn_Hom_def cmp_def, (erule conjE)+)
 apply (simp add:image_def)
 apply (rule_tac c = "f (c j)" in subsetD[of "{y. βˆƒx∈carrier S. y = f x}"
                                  "carrier B"], assumption+)
 apply (simp, blast)
done

lemma (in PolynRg) cf_h_pol_coeff:"⟦PolynRg A B Y; h ∈ rHom S B;
      pol_coeff S (n, f)⟧ ⟹ cf_h h (n, f) = (n, cmp h f)"
by (simp add:cf_h_def)

lemma (in PolynRg) cf_h_polyn:"⟦PolynRg A B Y; h ∈ rHom S B; 
      pol_coeff S (n, f)⟧ ⟹
      polyn_expr A Y n (cf_h h (n, f)) = polyn_expr A Y n (n, (cmp h f))"
apply (frule cf_h_coeff[of A B Y h "(n, f)"], assumption+,
       frule cmp_pol_coeff[of h B n f], assumption+)
apply (rule PolynRg.polyn_exprs_eq[of A B Y  "cf_h h (n, f)" "(n, cmp h f)" n],
       assumption+,
       simp add:cf_h_len,
       rule allI, rule impI,
       simp add:cf_h_def)
done

lemma (in PolynRg) pHom_rHom:"⟦PolynRg A B Y; f ∈ pHom R S X, A B Y⟧ ⟹
                                 f ∈ rHom R A"
by (simp add:polyn_Hom_def)

lemma (in PolynRg) pHom_X_Y:"⟦PolynRg A B Y; f ∈ pHom R S X, A B Y⟧ ⟹
                                 f X = Y"
by (simp add:polyn_Hom_def)

lemma (in PolynRg) pHom_memTr:"⟦PolynRg A B Y; 
      f ∈ pHom R S X, A B Y⟧ ⟹ 
      βˆ€c. pol_coeff S (n, c) ⟢ 
          f (polyn_expr R X n (n, c)) = polyn_expr A Y n (n, cmp f c)" 
apply (cut_tac subring, frule subring_Ring,
       frule PolynRg.is_Ring[of A B Y],
       frule PolynRg.subring[of A B Y],
       frule Ring.subring_Ring[of A B], assumption)
apply (induct_tac n)
 apply (rule allI, rule impI)
 apply (simp add:polyn_expr_def cmp_def)
 apply (frule_tac c = "(0, c)" and j = 0 in pol_coeff_mem,
           simp, simp,
       frule_tac x = "c 0" in mem_subring_mem_ring, assumption+,
       simp add:polyn_Hom_def, (erule conjE)+,
       frule rHom_func[of f R A],
       frule_tac x = "c 0" in funcset_mem[of f "carrier R" "carrier A"],
              assumption+,
       simp add:ring_r_one, simp add:Ring.ring_r_one)

apply (rule allI, rule impI)
apply (cut_tac n = n and f = c in pol_coeff_pre, assumption) 
       apply (
       drule_tac a = c in forall_spec, assumption)
apply (cut_tac n = n and c = "(Suc n, c)" in polyn_Suc, simp,
        simp del:npow_suc,
        thin_tac "polyn_expr R X (Suc n) (Suc n, c) =
           polyn_expr R X n (Suc n, c) Β± c (Suc n) β‹…r X^β‡—R (Suc n)β‡–")
apply (frule_tac c = "(Suc n, c)" and k = n in polyn_expr_short, simp)
       apply (simp del:npow_suc,
       thin_tac "polyn_expr R X n (Suc n, c) = polyn_expr R X n (n, c)")
apply (frule_tac c = "(Suc n, c)" in polyn_Hom_coeff_to_coeff[of A B Y f],
       assumption+, simp del:npow_suc add:cf_h_def)
apply (frule_tac c = "(Suc n, cmp f c)" and n = n in 
                  PolynRg.polyn_Suc[of A B Y], simp, simp del:npow_suc,
       thin_tac "polyn_expr A Y (Suc n) (Suc n, cmp f c) =
        polyn_expr A Y n (Suc n, cmp f c) Β±β‡˜A⇙  cmp f c (Suc n) β‹…rβ‡˜A⇙ Y^β‡—A (Suc n)β‡–")
apply (frule_tac k = n and c = "(n, c)" in polyn_mem, simp) 
apply (frule_tac c = "(Suc n, c)" in monomial_mem,
       drule_tac a = "Suc n" in forall_spec, simp, simp del:npow_suc) 

apply (frule pHom_rHom[of A B Y f], assumption+,
                                       simp del:npow_suc add:rHom_add) 
apply (frule_tac c = "(Suc n, c)" and j = "Suc n" in pol_coeff_mem_R, simp,
         simp del:npow_suc)
apply (cut_tac X_mem_R,
       frule_tac n = "Suc n" in npClose[of X],
       cut_tac Ring,
       subst rHom_tOp[of R A _ _ f], assumption+) 
 apply (frule_tac c = "(Suc n, cmp f c)" and k = n in 
        PolynRg.polyn_expr_short[of A B Y], assumption+, simp,
        simp del:npow_suc)
 apply (cut_tac c = "(Suc n, cmp f c)" and n = n in 
        PolynRg.pol_coeff_le[of A B Y], assumption+, simp,
        simp del:npow_suc add:PolynRg.pol_coeff_le[of A B Y])
apply (subst rHom_npow[of R A X f], assumption+,
       simp del:npow_suc add:pHom_X_Y cmp_def)
done

lemma (in PolynRg) pHom_mem:"⟦PolynRg A B Y; 
      f ∈ pHom R S X, A B Y; pol_coeff S (n, c)⟧ ⟹ 
      f (polyn_expr R X n (n, c)) = polyn_expr A Y n (n, cmp f c)"
apply (simp add:pHom_memTr)
done

lemma (in PolynRg) pHom_memc:"⟦PolynRg A B Y; f ∈ pHom R S X, A B Y; 
      pol_coeff S c⟧ ⟹ 
      f (polyn_expr R X (fst c) c) = polyn_expr A Y (fst c) (cf_h f c)"
by (cases c) (simp add: cf_h_def pHom_mem)

lemma (in PolynRg) pHom_mem1:"⟦PolynRg A B Y; f ∈ pHom R S X, A B Y; 
       p ∈ carrier R⟧ ⟹  f p ∈ carrier A"
apply (simp add:polyn_Hom_def, (erule conjE)+)
apply (simp add:rHom_mem)
done

lemma (in PolynRg) pHom_pol_mem:"⟦PolynRg A B Y; f ∈ pHom R S X, A B Y; 
      p ∈ carrier R; p β‰  𝟬⟧  ⟹ 
      f p = polyn_expr A Y (deg_n R S X p) (cf_h f (s_cf R S X p))"
apply (frule s_cf_expr[of p], assumption, (erule conjE)+)
apply (subst s_cf_deg[of p], assumption+)
apply (subst pHom_memc[THEN sym, of A B Y f], assumption+)
apply (drule sym, simp)
done

lemma (in PolynRg) erh_rHom_coeff:"⟦PolynRg A B Y; h ∈ rHom S B;
       pol_coeff S c⟧  ⟹  erh R S X A B Y h 0 c = (cmp h (snd c)) 0"
apply (cut_tac subring,
       frule subring_Ring,
       frule PolynRg.is_Ring[of A B Y],
       frule PolynRg.subring[of A B Y],
       frule Ring.subring_Ring[of A B], assumption) 
apply (simp add:erh_def polyn_expr_def cf_h_def)
 apply (frule pol_coeff_mem [of c 0], simp)
 apply (simp add:cmp_def, frule rHom_mem[of h S B "snd c 0"], assumption)
 apply (frule Ring.mem_subring_mem_ring[of A B "h (snd c 0)"], assumption+,
        simp add:Ring.ring_r_one)
done

lemma (in PolynRg) erh_polyn_exprs:"⟦PolynRg A B Y; h ∈ rHom S B;
       pol_coeff S c; pol_coeff S d; 
       polyn_expr R X (fst c) c = polyn_expr R X (fst d) d⟧  ⟹  
       erh R S X A B Y h (fst c) c  = erh R S X A B Y h (fst d) d"
apply (cut_tac subring,
       frule subring_Ring,
       frule PolynRg.is_Ring[of A B Y],
       frule PolynRg.subring[of A B Y],
       frule Ring.subring_Ring[of A B], assumption+)
apply (simp add:erh_def)
apply (cut_tac less_linear[of "fst c" "fst d"])
apply (erule disjE,
       frule pol_expr_unique3[of c d], assumption+, simp,
       thin_tac "polyn_expr R X (fst c) c = polyn_expr R X (fst d) d",
       frule cf_h_coeff[of A B Y h c], assumption+,
       frule cf_h_coeff[of A B Y h d], assumption+) 
apply (frule PolynRg.pol_expr_unique3[of A B Y "cf_h h c" "cf_h h d"],
        assumption+, simp add:cf_h_len, simp add:cf_h_len,
       thin_tac "(polyn_expr A Y (fst c) (cf_h h c) =
       polyn_expr A Y (fst d) (cf_h h d)) =
       ((βˆ€j≀fst c. snd (cf_h h c) j = snd (cf_h h d) j) ∧
       (βˆ€j∈nset (Suc (fst c)) (fst d). snd (cf_h h d) j = πŸ¬β‡˜B⇙))",
       simp add:cf_h_def cmp_def, simp add:rHom_0_0)

apply (erule disjE,
       frule pol_expr_unique2[of c d], assumption+, simp,
       thin_tac "polyn_expr R X (fst d) c = polyn_expr R X (fst d) d",
       frule cf_h_coeff[of A B Y h c], assumption+,
       frule cf_h_coeff[of A B Y h d], assumption+) 
apply (frule PolynRg.pol_expr_unique2[of A B Y "cf_h h c" "cf_h h d"],
        assumption+, simp add:cf_h_len, simp add:cf_h_len,
       thin_tac "(polyn_expr A Y (fst d) (cf_h h c) =
        polyn_expr A Y (fst d) (cf_h h d)) =
       (βˆ€j≀fst d. snd (cf_h h c) j = snd (cf_h h d) j)",
        simp add:cf_h_def cmp_def)

apply (drule sym, rule sym,
       frule pol_expr_unique3[of d c], assumption+, simp,
       thin_tac "polyn_expr R X (fst d) d = polyn_expr R X (fst c) c",
       frule cf_h_coeff[of A B Y h c], assumption+,
       frule cf_h_coeff[of A B Y h d], assumption+) 
apply (frule PolynRg.pol_expr_unique3[of A B Y "cf_h h d" "cf_h h c"],
        assumption+, simp add:cf_h_len, simp add:cf_h_len,
       thin_tac "(polyn_expr A Y (fst d) (cf_h h d) =
       polyn_expr A Y (fst c) (cf_h h c)) =
       ((βˆ€j≀fst d. snd (cf_h h d) j = snd (cf_h h c) j) ∧
       (βˆ€j∈nset (Suc (fst d)) (fst c). snd (cf_h h c) j = πŸ¬β‡˜B⇙))",
       simp add:cf_h_def cmp_def, simp add:rHom_0_0)
done

definition
  erH :: "[('a, 'm) Ring_scheme, ('a, 'm1) Ring_scheme, 'a,
         ('b, 'n) Ring_scheme, ('b, 'n1) Ring_scheme, 'b, 'a β‡’ 'b] β‡’ 
                  'a β‡’ 'b" where
  "erH R S X A B Y h = (λx∈carrier R. erh R S X A B Y h 
                              (fst (s_cf R S X x)) (s_cf R S X x))" 
(*
lemma (in PolynRg) erH_phom:"⟦PolynRg A B y; h ∈ rHom S B⟧ ⟹
              erH R S X A B Y h ∈ pHom R S X, A B Y" *)

lemma (in PolynRg) erH_rHom_0:"⟦PolynRg A B Y; h ∈ rHom S B⟧  ⟹ 
                   (erH R S X A B Y h) 𝟬 = πŸ¬β‡˜A⇙"
apply (cut_tac subring, frule subring_Ring,
       cut_tac PolynRg.is_Ring[of A B Y],
       cut_tac PolynRg.subring[of A B Y],
       cut_tac Ring.subring_Ring[of A B])
apply (simp add:erH_def erh_def s_cf_def polyn_expr_def)
 apply (cut_tac ring_zero,
        simp add:cf_h_def cmp_def rHom_0_0,
        simp add:Ring.Subring_zero_ring_zero, 
        frule Ring.ring_zero[of A], simp add:Ring.ring_r_one, assumption+)
done


lemma (in PolynRg) erH_mem:"⟦PolynRg A B Y; h ∈ rHom S B; p ∈ carrier R⟧ ⟹
               erH R S X A B Y h p ∈ carrier A"
apply (cut_tac subring, frule subring_Ring,
       cut_tac PolynRg.is_Ring[of A B Y],
       cut_tac PolynRg.subring[of A B Y],
       cut_tac Ring.subring_Ring[of A B])
apply (case_tac "p = πŸ¬β‡˜R⇙")
  apply (simp add:erH_rHom_0, simp add:Ring.ring_zero)

apply (simp add:erH_def erh_def)
 apply (frule s_cf_expr[of p], assumption, (erule conjE)+)
 apply (rule PolynRg.polyn_mem[of A B Y "cf_h h (s_cf R S X p)"], assumption+)
 apply (simp add:cf_h_coeff)
 apply (simp add:cf_h_len, assumption+) 
done

lemma (in PolynRg) erH_rHom_nonzero:"⟦PolynRg A B Y; f ∈ rHom S B; 
      p ∈ carrier R; (erH R S X A B Y f) p β‰  πŸ¬β‡˜Aβ‡™βŸ§ ⟹ p β‰  𝟬"
apply (rule contrapos_pp, simp+)
apply (simp add:erH_rHom_0)
done

lemma (in PolynRg) erH_rHomTr2:"⟦PolynRg A B Y; h ∈ rHom S B⟧  ⟹ 
        (erH R S X A B Y h) (1r) = (1rβ‡˜A⇙)"
apply (cut_tac subring, frule subring_Ring,
       frule PolynRg.is_Ring[of A B Y],
       frule PolynRg.subring[of A B Y],
       frule Ring.subring_Ring[of A B], assumption,
       cut_tac polyn_ring_nonzero)
apply (cut_tac Subring_one_ring_one[THEN sym, of S],
       frule Ring.ring_one[of S],
       cut_tac ring_one)
apply (frule s_cf_expr[of "1r"], assumption+, (erule conjE)+)
 apply (frule s_cf_deg[THEN sym, of "1r"], assumption, simp)
 apply (cut_tac pol_of_deg0[THEN sym, of "1r"], simp,
        simp add:erH_def erh_def cf_h_def polyn_expr_def,
        frule pol_coeff_mem[of "s_cf R S X 1rβ‡˜S⇙" 0], simp)
 apply (simp add:Subring_tOp_ring_tOp[THEN sym],
        simp add:Ring.ring_r_one cmp_def) 
 apply (simp add:rHom_one,
        simp add:Ring.Subring_one_ring_one[of A B],
               frule Ring.ring_one[of A], simp add:Ring.ring_r_one)
 apply (simp add:ring_one)
 apply simp apply assumption
done

declare max.absorb1 [simp] max.absorb2 [simp]

lemma (in PolynRg) erH_multTr:"⟦PolynRg A B Y; h ∈ rHom S B; 
      pol_coeff S c⟧ ⟹ 
 βˆ€f g. pol_coeff S (m, f) ∧ pol_coeff S (((fst c) + m), g) ∧ 
       (polyn_expr R X (fst c) c) β‹…r (polyn_expr R X m (m, f)) = 
             (polyn_expr R X ((fst c) + m) ((fst c) + m, g))  ⟢ 
 (polyn_expr A Y (fst c) (cf_h h c)) β‹…rβ‡˜A⇙ (polyn_expr A Y m (cf_h h (m, f))) = 
                 (polyn_expr A Y ((fst c) + m) (cf_h h ((fst c)+m, g)))"
apply (cut_tac subring, frule subring_Ring,
       frule PolynRg.is_Ring[of A B Y],
       frule PolynRg.subring[of A B Y],
       frule Ring.subring_Ring[of A B], assumption)
apply (cases c)
apply (simp only:)
apply (rename_tac l u)
apply (thin_tac "c = (l, u)")
apply (induct_tac m) 
 apply ((rule allI)+, rule impI, (erule conjE)+, simp)
 apply (simp add:cf_h_polyn[of A B Y h])
 apply (simp add:polyn_expr_def[of _ _ 0])
 apply (frule_tac c = "(0, f)" and j = 0 in pol_coeff_mem, simp, simp,
        frule_tac c = "(0, f)" and j = 0 in pol_coeff_mem_R, simp, simp,
        frule_tac c = "(l, u)" and k = l in polyn_mem, simp,
        simp add:ring_r_one,
        simp add:ring_tOp_commute,
        simp add:scalar_times_pol_expr) 
 apply (frule_tac c = "(0, f)" in cf_h_coeff[of A B Y h], assumption+,
        frule_tac c = "(l, u)" in cf_h_coeff[of A B Y h], assumption+)
 apply (frule_tac c = "cf_h h (0, f)" in PolynRg.pol_coeff_mem[of A B Y _ 0],
        assumption+, simp, simp add:cf_h_cmp,
        frule_tac c = "cf_h h (0, f)" in PolynRg.pol_coeff_mem_R[of A B Y _ 0],
        assumption+, simp, simp add:cf_h_cmp,
        frule_tac c = "cf_h h (l, u)" and k = l in PolynRg.polyn_mem, simp,
        simp add:cf_h_len, simp add:cf_h_polyn,
        simp add:Ring.ring_r_one, simp add:Ring.ring_tOp_commute[of A],
        frule_tac n = l and f = u in cf_h_pol_coeff[of A B Y h],
              assumption+, simp)
  apply (simp add:PolynRg.scalar_times_pol_expr,
         frule_tac c = "(l, u)" and a = "f 0" in sp_cf_pol_coeff, assumption+,
         frule_tac c = "(l, cmp h u)" and a = "(cmp h f) 0" in 
           PolynRg.sp_cf_pol_coeff, assumption+,
         frule_tac c = "(l, g)" in cf_h_coeff[of A B Y h], assumption+,
         simp add:cf_h_pol_coeff) 
  apply (rule_tac c = "sp_cf B (cmp h f 0) (l, cmp h u)" and 
         d = "(l, cmp h g)" and k = l in PolynRg.polyn_exprs_eq[of A B Y],
         assumption+, simp add:sp_cf_len, 
         simp add:PolynRg.sp_cf_len)
  apply (rule allI, rule impI)
  apply (frule_tac c = "sp_cf S (f 0) (l, u)" and d = "(l, g)" in 
         pol_expr_unique2, assumption+,
         simp add:sp_cf_len, simp add:sp_cf_len)
  apply (drule_tac a = j in forall_spec, simp)
  apply (simp add:sp_cf_def)
  apply (rotate_tac -1, drule sym, simp add:cmp_def,
        thin_tac "pol_coeff B (l, Ξ»x. h (g x))",
        thin_tac "pol_coeff B (l, Ξ»j. h (f 0) β‹…rβ‡˜B⇙ h (u j))",
        thin_tac "pol_coeff S (l, Ξ»j. f 0 β‹…rβ‡˜S⇙ u j)",
        thin_tac "polyn_expr A Y l (l, λx. h (u x)) ∈ carrier A",
        thin_tac "pol_coeff B (l, Ξ»x. h (u x))",
        thin_tac "polyn_expr R X l (l, Ξ»j. f 0 β‹…rβ‡˜S⇙ u j) =
                                          polyn_expr R X l (l, g)")
  apply (frule_tac c = "(l, u)" and j = j in pol_coeff_mem, simp, simp)
  apply (simp add:rHom_tOp)

apply ((rule allI)+, (rule impI), (erule conjE)+)
 apply (simp add:cf_h_polyn,
        frule_tac n = n and f = f in pol_coeff_pre, 
        frule_tac n = "l + n" and f = g in pol_coeff_pre,
        frule_tac n = l and f = u and m = n and g = f in polyn_expr_tOp, 
        assumption+, erule exE, (erule conjE)+,
        rotate_tac -1, drule sym)

 apply (drule_tac x = f in spec,
        drule_tac x = e in spec, simp,
        frule_tac n = n and f = f in polyn_Suc_split,
        simp del:npow_suc,
        thin_tac "polyn_expr R X (Suc n) (Suc n, f) =
        polyn_expr R X n (n, f) Β± f (Suc n) β‹…r X^β‡—R (Suc n)β‡–")
 (* got polyn_expr A Y l (l, cmp h u) β‹…rA polyn_expr A Y n (n, cmp h f) =
        polyn_expr A Y (l + n) (l + n, cmp h e) *)

 apply (frule_tac c = "(Suc n, f)" in cf_h_coeff[of A B Y h], assumption+,
        simp del:npow_suc add:cf_h_pol_coeff)
 apply (frule_tac n = n and f = "cmp h f" in PolynRg.polyn_Suc_split[of A B Y],
        simp add:cf_h_pol_coeff, simp del:npow_suc,
        thin_tac "polyn_expr A Y (Suc n) (Suc n, cmp h f) =
        polyn_expr A Y n (n, cmp h f) Β±β‡˜A⇙ cmp h f (Suc n) β‹…rβ‡˜A⇙ Y^β‡—A (Suc n)β‡–")
   
apply (frule_tac c = "(l, u)" and k = l in polyn_mem, simp,
       frule_tac n = n and f = f in pol_coeff_pre,
       frule_tac c = "(n, f)" and k = n in polyn_mem, simp,
       frule_tac c = "(Suc n, f)" and j = "Suc n" in pol_coeff_mem_R, simp,
       cut_tac X_mem_R, simp del:npow_suc,
       cut_tac n = "Suc n" in npClose[of X], assumption,
       frule_tac x = "f (Suc n)" and y = " X^β‡—R (Suc n)β‡–" in ring_tOp_closed,
         assumption+,
       simp del:npow_suc add:ring_distrib1) 
apply (frule_tac c = "(l, u)" in cf_h_coeff[of A B Y h], assumption+,
       frule_tac c = "(Suc n, f)" in cf_h_coeff[of A B Y h], assumption+,
       frule_tac n = n and f = f in pol_coeff_pre,
       frule_tac c = "(n, f)" in cf_h_coeff[of A B Y h], assumption+,
       simp del:npow_suc add:cf_h_pol_coeff)
apply (frule_tac c = "(l, cmp h u)" and k = l in PolynRg.polyn_mem, simp, simp,      frule_tac c = "(n, cmp h f)" and k = n in PolynRg.polyn_mem, simp, simp) 


apply (frule_tac c = "(Suc n, f)" and j = "Suc n" in pol_coeff_mem_R, simp,
       cut_tac X_mem_R, simp del:npow_suc,
       cut_tac n = "Suc n" in npClose[of X], assumption,
       frule_tac x = "f (Suc n)" and y = " X^β‡—R (Suc n)β‡–" in ring_tOp_closed,
         assumption+,
       simp del:npow_suc add:ring_distrib1)

apply (frule_tac c = "(Suc n, cmp h f)" and j = "Suc n" in 
       PolynRg.pol_coeff_mem_R[of A B Y], simp del:npow_suc, 
       simp del:npow_suc,
       frule_tac PolynRg.X_mem_R[of A B Y], simp del:npow_suc,
       frule_tac n = "Suc n" in Ring.npClose[of A Y], assumption,
       frule_tac x = "cmp h f (Suc n)" and y = " Y^β‡—A (Suc n)β‡–" in 
       Ring.ring_tOp_closed[of A], assumption+,
       simp del:npow_suc add:Ring.ring_distrib1) 

apply (frule_tac x1 = "polyn_expr R X l (l, u)" and y1 = "f (Suc n)" and 
       z1 = " X^β‡—R (Suc n)β‡–" in ring_tOp_assoc[THEN sym], assumption+, 
       simp del:npow_suc,
       thin_tac "polyn_expr R X l (l, u) β‹…r polyn_expr R X n (n, f) =
        polyn_expr R X (l + n) (l + n, e)",
       thin_tac "polyn_expr R X l (l, u) β‹…r (f (Suc n) β‹…r X^β‡—R (Suc n)β‡–) =
        polyn_expr R X l (l, u) β‹…r f (Suc n) β‹…r X^β‡—R (Suc n)β‡–",
       simp only:ring_tOp_commute,
       frule_tac c = "(Suc n, f)" and j = "Suc n" in pol_coeff_mem, simp,
       simp del:npow_suc,
       simp del:npow_suc add:scalar_times_pol_expr)
 
  apply (frule_tac c = "(l, u)" and a = "f (Suc n)" in sp_cf_pol_coeff,
                assumption+,
         frule_tac c = "sp_cf S (f (Suc n)) (l, u)" and k = l in polyn_mem,
         simp add:sp_cf_len, simp only:ring_tOp_commute,
         frule_tac c1 = "sp_cf S (f (Suc n)) (l, u)" and j1 = "Suc n" in 
         low_deg_terms_zero1[THEN sym],
         simp only:sp_cf_len, simp del: npow_suc)
   apply (frule_tac c = "sp_cf S (f (Suc n)) (l, u)" and n = "Suc n" in 
          ext_cf_pol_coeff,
          frule_tac c = "(l + n, e)" and d = "ext_cf S (Suc n) (sp_cf S (
           f (Suc n)) (l, u))" in polyn_add1, assumption+,
          simp del:npow_suc add:ext_cf_len sp_cf_len,
          cut_tac a = l and b = n in add.commute,
          simp del:npow_suc,
         thin_tac "polyn_expr R X (n + l) (n + l, e) Β±
         polyn_expr R X (Suc (n + l))
         (ext_cf S (Suc n) (sp_cf S (f (Suc n)) (l, u))) =
         polyn_expr R X (Suc (n + l))
         (add_cf S (n + l, e)
           (ext_cf S (Suc n) (sp_cf S (f (Suc n)) (l, u))))",
         thin_tac "polyn_expr R X l (l, u) ∈ carrier R",
         thin_tac "polyn_expr R X n (n, f) ∈ carrier R",
         thin_tac "f (Suc n) ∈ carrier R",
         thin_tac "X ∈ carrier R",
         thin_tac "X^β‡—R (Suc n)β‡– ∈ carrier R",
         thin_tac "f (Suc n) β‹…r X^β‡—R (Suc n)β‡– ∈ carrier R",
         thin_tac "polyn_expr R X l (sp_cf S (f (Suc n)) (l, u)) ∈ carrier R",
         thin_tac "X^β‡—R (Suc n)β‡– β‹…r polyn_expr R X l (sp_cf S (f (Suc n)) (l, u)) =
        polyn_expr R X (Suc (n + l))
         (ext_cf S (Suc n) (sp_cf S (f (Suc n)) (l, u)))")
  (* got polyn_expr R X (Suc (n + l)) (Suc (n + l), g) =
        polyn_expr R X (Suc (n + l))
         (add_cf S (n + l, e)
           (ext_cf S (Suc n) (sp_cf S (f (Suc n)) (l, u)))) *)

   apply (subst Ring.ring_tOp_assoc[THEN sym], assumption+,
          subst Ring.ring_tOp_commute, assumption+)
    apply (frule_tac c = "(Suc n, f)" in cf_h_coeff[of A B Y h],
          assumption+,
          simp only:cf_h_pol_coeff)
   apply (frule_tac c = "(Suc n, cmp h f)" and j = "Suc n" in 
         PolynRg.pol_coeff_mem[of A B Y], assumption+, simp, 
         simp del:npow_suc) 
   apply (subst PolynRg.scalar_times_pol_expr[of A B Y], assumption+,
          simp)
   apply (frule_tac a = "cmp h f (Suc n)" and c = "(l, cmp h u)" in 
          PolynRg.sp_cf_pol_coeff[of A B Y], assumption+)
   apply (frule_tac c = "sp_cf B (cmp h f (Suc n)) (l, cmp h u)" and k = l 
          in PolynRg.polyn_mem[of A B Y], assumption, simp)
          apply (simp add:PolynRg.sp_cf_len)
   apply (subst Ring.ring_tOp_commute[of A], assumption+)
  apply (frule_tac c1 = "sp_cf B (cmp h f (Suc n)) (l, cmp h u)" and 
         j1 = "Suc n" in PolynRg.low_deg_terms_zero1[of A B Y, THEN sym],
         assumption+)
   apply (simp del:npow_suc add:sp_cf_len PolynRg.sp_cf_len,
          thin_tac "Y^β‡—A (Suc n)β‡– β‹…rβ‡˜A⇙
          polyn_expr A Y l (sp_cf B (cmp h f (Suc n)) (l, cmp h u)) =
          polyn_expr A Y (Suc (l + n))
          (ext_cf B (Suc n) (sp_cf B (cmp h f (Suc n)) (l, cmp h u)))",
          thin_tac "polyn_expr A Y l (sp_cf B (cmp h f (Suc n)) (l, cmp h u))
          ∈ carrier A")
   apply (frule_tac c = "sp_cf B (cmp h f (Suc n)) (l, cmp h u)" and 
          n = "Suc n" in PolynRg.ext_cf_pol_coeff[of A B Y], assumption+)
   apply (frule_tac c = "(l + n, cmp h e)" and 
          d = "ext_cf B (Suc n) (sp_cf B (cmp h f (Suc n)) (l, cmp h u))" in
          PolynRg.polyn_add1[of A B Y])    
   apply (frule_tac c = "(n + l, e)" in cf_h_coeff[of A B Y h], assumption+)
  apply (simp add:cf_h_pol_coeff[of A B Y h] add.commute, assumption)
  apply (simp add:PolynRg.ext_cf_len PolynRg.sp_cf_len)
  apply (cut_tac a = n and b = l in add.commute, simp)
  (** Now we got 
      polyn_expr A Y (max (l + n) (Suc (l + n)))
           (add_cf B (l + n, cmp h e)
             (ext_cf B (Suc n) (sp_cf B (cmp h f (Suc n)) (l, cmp h u)))) =
          polyn_expr A Y (Suc (l + n)) (Suc (l + n), cmp h g) *)

  apply (frule_tac c = "(l + n, e)" and 
         d = "ext_cf S (Suc n) (sp_cf S (f (Suc n)) (l, u))" in 
         add_cf_pol_coeff, assumption+)
  apply (frule_tac c = "(l + n, cmp h e)" and
         d = "ext_cf B (Suc n) (sp_cf B (cmp h f (Suc n)) (l, cmp h u))" in
         PolynRg.add_cf_pol_coeff[of A B Y]) 
  apply (frule_tac c = "(l + n, e)" in cf_h_coeff[of A B Y h], assumption+)
       apply (simp add:cf_h_pol_coeff) apply simp
   apply (thin_tac "polyn_expr A Y l (l, cmp h u) β‹…rβ‡˜A⇙ polyn_expr A Y n 
         (n, cmp h f) = polyn_expr A Y (l + n) (l + n, cmp h e)",
        thin_tac "polyn_expr A Y l (l, cmp h u) ∈ carrier A",
        thin_tac "polyn_expr A Y n (n, cmp h f) ∈ carrier A",
        thin_tac "Y ∈ carrier A",
        thin_tac "Y^β‡—A nβ‡– β‹…rβ‡˜A⇙ Y ∈ carrier A",
        thin_tac "cmp h f (Suc n) β‹…rβ‡˜A⇙ (Y^β‡—A nβ‡– β‹…rβ‡˜A⇙ Y) ∈ carrier A",
        thin_tac "polyn_expr A Y (l + n) (l + n, cmp h e) Β±β‡˜A⇙
        polyn_expr A Y (Suc (l + n))
         (ext_cf B (Suc n) (sp_cf B (cmp h f (Suc n)) (l, cmp h u))) =
        polyn_expr A Y (Suc (l + n))
         (add_cf B (l + n, cmp h e)
           (ext_cf B (Suc n) (sp_cf B (cmp h f (Suc n)) (l, cmp h u))))")
  apply (frule_tac c = "(Suc (l + n), g)" in cf_h_coeff[of A B Y h], 
          assumption+)
  apply (simp add:cf_h_pol_coeff)
  apply (frule_tac c = "(Suc (l + n), g)" and d = "add_cf S (l + n, e)
         (ext_cf S (Suc n) (sp_cf S (f (Suc n)) (l, u)))" in pol_expr_unique2)
     apply assumption apply (simp add:add_cf_len) 
     apply (simp add:ext_cf_len sp_cf_len)
      apply (simp add:add_cf_len ext_cf_len sp_cf_len)
      apply (cut_tac a = n and b = l in add.commute, simp,
     thin_tac "pol_coeff B
         (add_cf B (l + n, cmp h e)
           (ext_cf B (Suc n) (sp_cf B (cmp h f (Suc n)) (l, cmp h u))))",
     thin_tac "pol_coeff B (Suc (l + n), cmp h g)",
     thin_tac "pol_coeff S
         (add_cf S (l + n, e)
           (ext_cf S (Suc n) (sp_cf S (f (Suc n)) (l, u))))",
     thin_tac "pol_coeff B
         (ext_cf B (Suc n) (sp_cf B (cmp h f (Suc n)) (l, cmp h u)))",
     thin_tac "pol_coeff B (sp_cf B (cmp h f (Suc n)) (l, cmp h u))",
     thin_tac "polyn_expr R X (Suc (l + n)) (Suc (l + n), g) =
        polyn_expr R X (Suc (l + n))
         (add_cf S (l + n, e)
           (ext_cf S (Suc n) (sp_cf S (f (Suc n)) (l, u))))")
    apply (rule sym)
    apply (frule_tac c = "(Suc (l + n), g)" in cf_h_coeff[of A B Y h],
             assumption+,
           frule_tac c = "(l + n, e)" in cf_h_coeff[of A B Y h],
             assumption+) 
    apply (frule_tac c = "(l, cmp h u)" and a = "cmp h f (Suc n)" in 
           PolynRg.sp_cf_pol_coeff[of A B Y], assumption+)
    apply (cut_tac c = "(l + n, cmp h e)" and 
           d = "ext_cf B (Suc n) (sp_cf B (cmp h f (Suc n)) (l, cmp h u))" in
           PolynRg.add_cf_pol_coeff, assumption+)
    apply (simp add:cf_h_pol_coeff) 
    apply (rule PolynRg.ext_cf_pol_coeff, assumption+)
    apply (frule_tac c = "(Suc (l + n), cmp h g)" and 
           d = "add_cf B (l + n, cmp h e)
             (ext_cf B (Suc n) (sp_cf B (cmp h f (Suc n)) (l, cmp h u)))" in 
           PolynRg.pol_expr_unique2[of A B Y])
    apply (simp add:cf_h_pol_coeff) apply assumption
    apply (simp add:add_cf_len)
    apply (frule_tac n = "l + n" and f = e in  cf_h_pol_coeff[of A B Y h],
            assumption+) 
    apply (frule_tac c = "sp_cf B (cmp h f (Suc n)) (l, cmp h u)" and 
           n = "Suc n" in 
           PolynRg.ext_cf_pol_coeff[of A B Y], assumption+)
    apply (simp add:PolynRg.add_cf_len)
           apply (simp add:PolynRg.ext_cf_len)
           apply (simp add:PolynRg.sp_cf_len)
    apply (simp add:PolynRg.add_cf_len)
    apply (frule_tac c = "sp_cf B (cmp h f (Suc n)) (l, cmp h u)" and 
           n = "Suc n" in PolynRg.ext_cf_pol_coeff[of A B Y],
            assumption+)
    apply (frule_tac c = "(l + n, cmp h e)" and
           d = "ext_cf B (Suc n)
                   (sp_cf B (cmp h f (Suc n)) (l, cmp h u))" in 
           PolynRg.add_cf_pol_coeff[of A B Y])
    apply (simp add:cf_h_pol_coeff, assumption)
  apply (simp add:cf_h_pol_coeff)  
    apply (simp add:PolynRg.add_cf_len) 
    apply (simp add:PolynRg.ext_cf_len)
    apply (simp add:PolynRg.sp_cf_len)
    apply (cut_tac a = n and b = l in add.commute, simp)
  (* we got 
     βˆ€j≀Suc (l + n).
             cmp h g j =
             snd (add_cf B (l + n, cmp h e)
                   (ext_cf B (Suc n)
                     (sp_cf B (cmp h f (Suc n)) (l, cmp h u)))) j *)

    apply (thin_tac "(polyn_expr A Y (Suc (l + n)) (Suc (l + n), cmp h g) =
         polyn_expr A Y (Suc (l + n))
          (add_cf B (l + n, cmp h e)
            (ext_cf B (Suc n) (sp_cf B (cmp h f (Suc n)) (l, cmp h u))))) =
        (βˆ€j≀Suc (l + n).
            cmp h g j =
            snd (add_cf B (l + n, cmp h e)
                  (ext_cf B (Suc n)
                    (sp_cf B (cmp h f (Suc n)) (l, cmp h u))))
             j)")

   apply (rule allI, rule impI)
   apply (subst cmp_def)+
   apply (drule_tac a = j in forall_spec, simp, simp,
          thin_tac "g j = snd (add_cf S (l + n, e)
                     (ext_cf S (Suc n) (sp_cf S (f (Suc n)) (l, u)))) j")
   apply (case_tac "j = Suc (l+n)", simp)
     apply ((subst add_cf_def)+, 
            simp add:ext_cf_len, simp add:sp_cf_len,
            simp add:cmp_def PolynRg.ext_cf_len,
            simp add:PolynRg.sp_cf_len,
            (subst ext_cf_def)+, simp add:sp_cf_len sliden_def,
            (subst sp_cf_def)+, simp,
           frule_tac c = "(l, u)" and j = l in pol_coeff_mem, simp, simp,
           simp add:rHom_tOp)

 apply (frule_tac m = j and n = "Suc (l + n)" in noteq_le_less, assumption,
        thin_tac "j ≀ Suc (l + n)", thin_tac "j β‰  Suc (l + n)",
        (subst add_cf_def)+,
        simp add:ext_cf_len sp_cf_len, simp add:cmp_def,
        simp add:PolynRg.ext_cf_len PolynRg.sp_cf_len,
        (subst ext_cf_def)+, simp add:sp_cf_len,
        (subst sp_cf_def)+, simp add:sliden_def,
        frule_tac x = j and n = "l + n" in Suc_less_le)

 apply (rule conjI)
  apply (rule impI,
         frule_tac x = j and y = "Suc (l + n)" in less_imp_le,
         frule_tac m = j and n = "Suc (l + n)" and l = "Suc n" in diff_le_mono,
         simp,
         frule_tac c = "(l, u)" and j = "j - Suc n" in pol_coeff_mem, simp,
         frule_tac c = "(l + n, e)" and j = j in pol_coeff_mem, simp, simp,
         frule_tac x = "f (Suc n)" and y = "u (j - Suc n)" in 
          Ring.ring_tOp_closed[of S], assumption+,
         simp add:rHom_add rHom_tOp)
 apply (rule impI)
  apply (frule_tac c = "(l + n, e)" and j = j in pol_coeff_mem, simp, simp,
         frule_tac Ring.ring_zero[of S],
         simp add:rHom_add rHom_0_0)
done


lemma (in PolynRg) erH_multTr1:"⟦PolynRg A B Y; h ∈ rHom S B; 
      pol_coeff S c; pol_coeff S d;  pol_coeff S e; fst e = fst c + fst d; 
    (polyn_expr R X (fst c) c) β‹…r (polyn_expr R X (fst d) d) = 
     polyn_expr R X ((fst c) + (fst d)) e ⟧ ⟹ 
 (polyn_expr A Y (fst c) (cf_h h c)) β‹…rβ‡˜A⇙ (polyn_expr A Y (fst d) (cf_h h d))
  =  (polyn_expr A Y (fst e) (cf_h h e))"
by (cases d, cases e) (simp add: erH_multTr)

lemma (in PolynRg) erHomTr0:"⟦PolynRg A B Y; h ∈ rHom S B; x ∈ carrier R⟧
      ⟹ erH R S X A B Y h (-a x) = -aβ‡˜A⇙ (erH R S X A B Y h x)"
apply (cut_tac ring_is_ag,
       cut_tac subring, frule subring_Ring,
       frule PolynRg.is_Ring[of A B Y],
       frule Ring.ring_is_ag[of A],
       frule PolynRg.subring[of A B Y],
       frule Ring.subring_Ring[of A B], assumption+)   
apply (case_tac "x = πŸ¬β‡˜R⇙", simp add:aGroup.ag_inv_zero,
       simp add:erH_rHom_0[of A B Y h],
       frule Ring.ring_is_ag[of A], simp add:aGroup.ag_inv_zero)
apply (simp add:erH_def erh_def)
      apply (simp add:aGroup.ag_mOp_closed)
apply (frule_tac p = x in s_cf_expr, assumption+, (erule conjE)+)
apply (frule_tac x = x in aGroup.ag_mOp_closed, assumption+,
       frule_tac p = "-a x" in s_cf_expr,
       thin_tac "x = polyn_expr R X (fst (s_cf R S X x)) (s_cf R S X x)",      
       rule contrapos_pp, simp+,
       frule_tac x = x in aGroup.ag_inv_inv, simp, simp add:aGroup.ag_inv_zero,
       (erule conjE)+)

  apply (frule_tac c = "s_cf R S X (-a x)" in cf_h_coeff[of A B Y h],
         assumption+,
         frule_tac c = "s_cf R S X x" in cf_h_coeff[of A B Y h],
         assumption+)
  apply (frule polyn_minus_m_cf[of "s_cf R S X x" "fst (s_cf R S X x)"],
          simp) 
  apply (cut_tac a = "-a x" and 
          b = "polyn_expr R X (fst (s_cf R S X (-a x))) (s_cf R S X (-a x))"
     and  c = "polyn_expr R X (fst (s_cf R S X x)) (m_cf S (s_cf R S X x))" 
          in box_equation, assumption, simp,
          thin_tac "x = polyn_expr R X (fst (s_cf R S X x)) (s_cf R S X x)",
          thin_tac "-a x =
         polyn_expr R X (fst (s_cf R S X (-a x))) (s_cf R S X (-a x))",
          thin_tac "-a (polyn_expr R X (fst (s_cf R S X x)) (s_cf R S X x)) =
         polyn_expr R X (fst (s_cf R S X x)) (m_cf S (s_cf R S X x))",
         frule m_cf_pol_coeff[of "s_cf R S X x"])

  apply (subst PolynRg.polyn_minus_m_cf[of A B Y], assumption+,
         simp add:cf_h_len)
  apply (frule_tac c = "cf_h h (s_cf R S X x)" in 
                   PolynRg.m_cf_pol_coeff[of A B Y], assumption,
         frule PolynRg.pol_expr_unique2[of A B Y "cf_h h (s_cf R S X (-a x))" 
         "m_cf B (cf_h h (s_cf R S X x))"], assumption+)
  apply (simp add:cf_h_len)
  apply (simp add:PolynRg.m_cf_len cf_h_len)
  apply (simp add:s_cf_deg[THEN sym, of x],
         cut_tac ring_zero,         
         frule aGroup.ag_inv_inj[of R x 𝟬], assumption+, 
         simp only:aGroup.ag_inv_zero,
         subst s_cf_deg[THEN sym, of "-a x"], assumption+,
         simp add:deg_minus_eq)
  apply (simp add:cf_h_len PolynRg.m_cf_len,
         thin_tac "(polyn_expr A Y (fst (s_cf R S X (-a x)))
         (cf_h h (s_cf R S X (-a x))) = polyn_expr A Y (fst (s_cf R S X x))
         (m_cf B (cf_h h (s_cf R S X x)))) =
         (βˆ€j≀fst (s_cf R S X (-a x)). snd (cf_h h (s_cf R S X (-a x))) j =
          snd (m_cf B (cf_h h (s_cf R S X x))) j)")
   apply (rule allI, rule impI,
          subst m_cf_def)
   apply ((subst cf_h_def)+, simp add:cmp_def)
   apply (thin_tac "snd (s_cf R S X (-a x)) (fst (s_cf R S X (-a x))) β‰  πŸ¬β‡˜S⇙",
          thin_tac "pol_coeff B (cf_h h (s_cf R S X (-a x)))",
          thin_tac "pol_coeff B (cf_h h (s_cf R S X x))",
          thin_tac "pol_coeff B (m_cf B (cf_h h (s_cf R S X x)))")
   apply (frule m_cf_pol_coeff[of "s_cf R S X x"])
   apply (frule pol_expr_unique2[of "s_cf R S X (-a x)" 
                    "m_cf S (s_cf R S X x)"], assumption+,
          simp add:m_cf_len cf_h_len)
  apply (simp add:s_cf_deg[THEN sym, of x],
         cut_tac ring_zero,         
         frule aGroup.ag_inv_inj[of R x 𝟬], assumption+, 
         simp only:aGroup.ag_inv_zero,
         subst s_cf_deg[THEN sym, of "-a x"], assumption+,
         simp add:deg_minus_eq, simp add:m_cf_len)
  apply (drule_tac a = j in forall_spec, assumption,
         thin_tac "snd (s_cf R S X (-a x)) j = snd (m_cf S (s_cf R S X x)) j",
         thin_tac "polyn_expr R X (fst (s_cf R S X (-a x))) 
         (s_cf R S X (-a x)) =
         polyn_expr R X (fst (s_cf R S X x)) (m_cf S (s_cf R S X x))")
  apply (cut_tac ring_zero,         
         frule aGroup.ag_inv_inj[of R x 𝟬], assumption+, 
         simp only:aGroup.ag_inv_zero,
           (simp add:s_cf_deg[THEN sym, of "-a x"] deg_minus_eq,
             simp add:s_cf_deg[of x]) )
  apply (frule_tac j = j in pol_coeff_mem[of "s_cf R S X x"],
         assumption+)
  apply (subst m_cf_def, simp)
 apply (simp add:rHom_inv_inv)
done

lemma (in PolynRg) erHomTr1:"⟦PolynRg A B Y; h ∈ rHom S B; 
      a ∈ carrier R; b ∈ carrier R; a β‰  𝟬; b β‰  𝟬; a Β± b β‰  𝟬;
      deg_n R S X a = deg_n R S X b⟧ ⟹ 
      erH R S X A B Y h (a Β± b) = erH R S X A B Y h a Β±β‡˜A⇙ 
                                             (erH R S X A B Y h b)" 
apply (cut_tac ring_is_ag,
       cut_tac subring, frule subring_Ring,
       frule PolynRg.subring[of A B Y],
       frule_tac x = a and y = b in aGroup.ag_pOp_closed[of "R"], 
       assumption+,
       simp add:erH_def erh_def) 
apply (frule s_cf_expr[of a], assumption,
       frule s_cf_expr[of b], assumption,
       frule s_cf_expr[of "a Β± b"], assumption,
       (erule conjE)+,
       simp add:s_cf_deg)
apply (frule polyn_add1[of "s_cf R S X a" "s_cf R S X b"], assumption+)
apply (cut_tac a = "a Β± b" and 
       b = "polyn_expr R X (fst (s_cf R S X (a Β± b))) (s_cf R S X (a Β± b))" and
       c = "polyn_expr R X (max (fst (s_cf R S X a)) (fst (s_cf R S X b)))
       (add_cf S (s_cf R S X a) (s_cf R S X b))" in box_equation, 
       drule sym, drule sym, drule sym, simp,
       drule sym, drule sym, drule sym, simp,
       thin_tac "polyn_expr R X (fst (s_cf R S X a)) (s_cf R S X a) Β±
        polyn_expr R X (fst (s_cf R S X b)) (s_cf R S X b) =
        polyn_expr R X (max (fst (s_cf R S X a)) (fst (s_cf R S X b)))
        (add_cf S (s_cf R S X a) (s_cf R S X b))",
       thin_tac "a = polyn_expr R X (fst (s_cf R S X b)) (s_cf R S X a)",
       thin_tac "b = polyn_expr R X (fst (s_cf R S X b)) (s_cf R S X b)",
       thin_tac "a Β± b = 
         polyn_expr R X (fst (s_cf R S X (a Β± b))) (s_cf R S X (a Β± b))")
       apply simp

apply (frule cf_h_coeff[of A B Y h "s_cf R S X a"], assumption+,
       frule cf_h_coeff[of A B Y h "s_cf R S X b"], assumption+,
       frule cf_h_coeff[of A B Y h "s_cf R S X (a Β± b)"], assumption+)
apply (frule PolynRg.polyn_add1[of A B Y "cf_h h (s_cf R S X a)" 
                                "cf_h h (s_cf R S X b)"], assumption+,
       simp add:cf_h_len,
       thin_tac "polyn_expr A Y (fst (s_cf R S X b)) (cf_h h (s_cf R S X a))
        Β±β‡˜A⇙ polyn_expr A Y (fst (s_cf R S X b)) (cf_h h (s_cf R S X b)) =
             polyn_expr A Y (fst (s_cf R S X b))
               (add_cf B (cf_h h (s_cf R S X a)) (cf_h h (s_cf R S X b)))",
       frule PolynRg.add_cf_pol_coeff[of A B Y "cf_h h (s_cf R S X a)" 
                "cf_h h (s_cf R S X b)"], assumption+)
apply (case_tac "fst (s_cf R S X (a Β±β‡˜R⇙ b)) = fst (s_cf R S X b)")
apply (frule PolynRg.pol_expr_unique2[of A B Y "cf_h h (s_cf R S X (a Β± b))" 
              "add_cf B (cf_h h (s_cf R S X a)) (cf_h h (s_cf R S X b))"],
       assumption+)
       apply (simp add:cf_h_len add_cf_len,
              simp add:PolynRg.add_cf_len cf_h_len)
       apply (simp add:PolynRg.add_cf_len cf_h_len,
       thin_tac "(polyn_expr A Y (fst (s_cf R S X b)) (cf_h h (s_cf R S X 
        (a Β± b))) = polyn_expr A Y (fst (s_cf R S X b))
         (add_cf B (cf_h h (s_cf R S X a)) (cf_h h (s_cf R S X b)))) =
         (βˆ€j≀fst (s_cf R S X b).
          snd (cf_h h (s_cf R S X (a Β± b))) j =
          snd (add_cf B (cf_h h (s_cf R S X a)) (cf_h h (s_cf R S X b))) j)")

apply (frule pol_expr_unique2[of "s_cf R S X (a Β± b)" 
              "add_cf S (s_cf R S X a) (s_cf R S X b)"])
       apply (simp add:add_cf_pol_coeff)
       apply (simp add:add_cf_len, simp add:add_cf_len,
       thin_tac "polyn_expr R X (fst (s_cf R S X b)) (s_cf R S X (a Β± b)) =
                 polyn_expr R X (fst (s_cf R S X b))
                 (add_cf S (s_cf R S X a) (s_cf R S X b))")
apply (rule allI, rule impI,
       drule_tac a = j in forall_spec, assumption,
       subst add_cf_def, simp add:cf_h_len,
       (subst cf_h_def)+, (subst cmp_def)+, simp,
        thin_tac "snd (s_cf R S X (a Β± b)) j =
         snd (add_cf S (s_cf R S X a) (s_cf R S X b)) j")
       apply (subst add_cf_def, simp)
apply (frule_tac j = j in pol_coeff_mem[of "s_cf R S X a"], simp, 
       frule_tac j = j in pol_coeff_mem[of "s_cf R S X b"], simp,
       simp add:rHom_add)

apply (frule s_cf_deg[of a], assumption, 
       frule s_cf_deg[of b], assumption,
       frule s_cf_deg[of "a Β± b"], assumption,
       frule deg_pols_add2[of a b], assumption+,
       simp add:deg_def, simp add:deg_def ale_natle,
       frule_tac m = "fst (s_cf R S X (a Β± b))" and n = "fst (s_cf R S X b)" 
                 in noteq_le_less, assumption+)
apply (frule pol_expr_unique3[of "s_cf R S X (a Β± b)"
              "add_cf S (s_cf R S X a) (s_cf R S X b)"],
       simp add:add_cf_pol_coeff,
       simp add:add_cf_len,
       simp add:add_cf_len,
       thin_tac "polyn_expr R X (fst (s_cf R S X (a Β± b))) (s_cf R S X (a Β± b))
        =  polyn_expr R X (fst (s_cf R S X b)) 
                           (add_cf S (s_cf R S X a) (s_cf R S X b))")
apply (frule PolynRg.pol_expr_unique3[of A B Y "cf_h h (s_cf R S X (a Β± b))" 
              "add_cf B (cf_h h (s_cf R S X a)) (cf_h h (s_cf R S X b))"],
         assumption+,
       simp add:cf_h_len PolynRg.add_cf_len,
       simp add:PolynRg.add_cf_len cf_h_len,
       thin_tac "(polyn_expr A Y (fst (s_cf R S X (a Β± b)))
       (cf_h h (s_cf R S X (a Β± b))) = polyn_expr A Y (fst (s_cf R S X b))
       (add_cf B (cf_h h (s_cf R S X a)) (cf_h h (s_cf R S X b)))) =
       ((βˆ€j≀fst (s_cf R S X (a Β± b)).
          snd (cf_h h (s_cf R S X (a Β± b))) j =
          snd (add_cf B (cf_h h (s_cf R S X a)) (cf_h h (s_cf R S X b))) j) ∧
        (βˆ€j∈nset (Suc (fst (s_cf R S X (a Β± b)))) (fst (s_cf R S X b)).
          snd (add_cf B (cf_h h (s_cf R S X a)) (cf_h h (s_cf R S X b))) j =
          πŸ¬β‡˜B⇙))",
        thin_tac "pol_coeff B (cf_h h (s_cf R S X a))",
        thin_tac "pol_coeff B (cf_h h (s_cf R S X b))",
        thin_tac "pol_coeff B (cf_h h (s_cf R S X (a Β± b)))",
        thin_tac "pol_coeff B (add_cf B (cf_h h (s_cf R S X a)) 
                                         (cf_h h (s_cf R S X b)))",
        thin_tac "deg_n R S X a = fst (s_cf R S X b)",
        thin_tac "deg_n R S X b = fst (s_cf R S X b)",
        thin_tac "deg_n R S X (a Β± b) = fst (s_cf R S X (a Β± b))")
apply (rule conjI, erule conjE,
      thin_tac "βˆ€j∈nset (Suc (fst (s_cf R S X (a Β± b)))) (fst (s_cf R S X b)).
         snd (add_cf S (s_cf R S X a) (s_cf R S X b)) j = πŸ¬β‡˜S⇙")
   apply (rule allI, rule impI,
          drule_tac a = j in forall_spec, assumption,
          (subst cf_h_def)+, (subst cmp_def)+, simp,
          (subst add_cf_def)+, simp,
         frule_tac j = j in pol_coeff_mem[of "s_cf R S X a"], simp,
         frule_tac j = j in pol_coeff_mem[of "s_cf R S X b"], simp,
         simp add:rHom_add)
apply (erule conjE,
       thin_tac "βˆ€j≀fst (s_cf R S X (a Β± b)). snd (s_cf R S X (a Β± b)) j =
        snd (add_cf S (s_cf R S X a) (s_cf R S X b)) j")
  apply (rule ballI,
         drule_tac x = j in bspec, assumption,
         simp add:add_cf_def cf_h_len,
         simp add:cf_h_def cmp_def,
         frule_tac j = j in pol_coeff_mem[of "s_cf R S X a"], 
         simp add:nset_def,
         frule_tac j = j in pol_coeff_mem[of "s_cf R S X b"], 
         simp add:nset_def)
  apply (subst rHom_add[THEN sym, of h S B], assumption+, simp,
         (frule PolynRg.is_Ring[of A B Y],
          frule Ring.subring_Ring[of A B], assumption),
         simp add:rHom_0_0[of S B])
done
      
lemma (in PolynRg) erHomTr2:"⟦PolynRg A B Y; h ∈ rHom S B; 
      a ∈ carrier R; b ∈ carrier R; a β‰  𝟬; b β‰  𝟬; a Β± b β‰  𝟬;
      deg_n R S X a < deg_n R S X b⟧ ⟹ 
      erH R S X A B Y h (a Β± b) = erH R S X A B Y h a Β±β‡˜A⇙ 
                                             (erH R S X A B Y h b)"
apply (cut_tac ring_is_ag,
       cut_tac subring, frule subring_Ring,
       frule PolynRg.subring[of A B Y],
       frule_tac x = a and y = b in aGroup.ag_pOp_closed[of "R"], 
       assumption+,
       simp add:erH_def erh_def) 
apply (frule s_cf_expr[of a], assumption,
       frule s_cf_expr[of b], assumption,
       frule s_cf_expr[of "a Β± b"], assumption,
       (erule conjE)+,
       frule polyn_deg_add1[of a b], assumption+,
       simp add:s_cf_deg)
apply (frule polyn_add1[of "s_cf R S X a" "s_cf R S X b"], assumption+)
apply (cut_tac a = "a Β± b" and 
       b = "polyn_expr R X (fst (s_cf R S X b)) (s_cf R S X (a Β± b))" and
       c = "polyn_expr R X (max (fst (s_cf R S X a)) (fst (s_cf R S X b)))
       (add_cf S (s_cf R S X a) (s_cf R S X b))" in box_equation,
       drule sym, drule sym, drule sym, simp,
       drule sym, drule sym, drule sym, simp,
       thin_tac "polyn_expr R X (fst (s_cf R S X a)) (s_cf R S X a) Β±
        polyn_expr R X (fst (s_cf R S X b)) (s_cf R S X b) =
        polyn_expr R X (max (fst (s_cf R S X a)) (fst (s_cf R S X b)))
        (add_cf S (s_cf R S X a) (s_cf R S X b))",
       thin_tac "a = polyn_expr R X (fst (s_cf R S X a)) (s_cf R S X a)",
       thin_tac "b = polyn_expr R X (fst (s_cf R S X b)) (s_cf R S X b)",
       thin_tac "a Β± b = polyn_expr R X (fst (s_cf R S X b)) 
                            (s_cf R S X (a Β± b))",
       simp)

apply (frule cf_h_coeff[of A B Y h "s_cf R S X a"], assumption+,
       frule cf_h_coeff[of A B Y h "s_cf R S X b"], assumption+,
       frule cf_h_coeff[of A B Y h "s_cf R S X (a Β± b)"], assumption+)
apply (frule PolynRg.polyn_add1[of A B Y "cf_h h (s_cf R S X a)" 
                                "cf_h h (s_cf R S X b)"], assumption+,
       simp add:cf_h_len)
apply (thin_tac "polyn_expr A Y (fst (s_cf R S X a)) (cf_h h (s_cf R S X a))
        Β±β‡˜A⇙ polyn_expr A Y (fst (s_cf R S X b)) (cf_h h (s_cf R S X b)) =
        polyn_expr A Y (fst (s_cf R S X b))
        (add_cf B (cf_h h (s_cf R S X a)) (cf_h h (s_cf R S X b)))",
       frule PolynRg.add_cf_pol_coeff[of A B Y "cf_h h (s_cf R S X a)" 
                "cf_h h (s_cf R S X b)"], assumption+)
apply (frule PolynRg.pol_expr_unique2[of A B Y "cf_h h (s_cf R S X (a Β± b))" 
              "add_cf B (cf_h h (s_cf R S X a)) (cf_h h (s_cf R S X b))"],
       assumption+,
       simp add:cf_h_len add_cf_len,
       simp add:PolynRg.add_cf_len cf_h_len,
       simp add:PolynRg.add_cf_len cf_h_len,
       thin_tac "(polyn_expr A Y (fst (s_cf R S X b)) 
        (cf_h h (s_cf R S X (a Β± b))) = polyn_expr A Y (fst (s_cf R S X b))
        (add_cf B (cf_h h (s_cf R S X a)) (cf_h h (s_cf R S X b)))) =
       (βˆ€j≀fst (s_cf R S X b).
         snd (cf_h h (s_cf R S X (a Β± b))) j =
         snd (add_cf B (cf_h h (s_cf R S X a)) (cf_h h (s_cf R S X b))) j)")

apply (frule pol_expr_unique2[of "s_cf R S X (a Β± b)" 
              "add_cf S (s_cf R S X a) (s_cf R S X b)"],
       simp add:add_cf_pol_coeff,
       simp add:add_cf_len, simp add:add_cf_len) 
apply (thin_tac "polyn_expr R X (fst (s_cf R S X b)) (s_cf R S X (a Β± b)) =
        polyn_expr R X (fst (s_cf R S X b))
       (add_cf S (s_cf R S X a) (s_cf R S X b))")
apply (rule allI, rule impI,
       drule_tac a = j in forall_spec, assumption,
       subst add_cf_def, simp add:cf_h_len,
       (subst cf_h_def)+, (subst cmp_def)+, simp,
        subst add_cf_def, simp)
apply (case_tac "j ≀ fst (s_cf R S X a)", simp)
apply (frule_tac j = j in pol_coeff_mem[of "s_cf R S X a"], simp, 
       frule_tac j = j in pol_coeff_mem[of "s_cf R S X b"], simp,
       simp add:rHom_add)
    apply simp
   apply (subst add_cf_def, simp)
done

lemma (in PolynRg) erH_rHom:"⟦Idomain S; PolynRg A B Y; h ∈ rHom S B⟧
   ⟹ erH R S X A B Y h ∈ pHom R S X, A B Y"
apply (frule Idomain.idom_is_ring[of "S"],
       cut_tac subring,
       cut_tac polyn_ring_integral, simp,
       frule PolynRg.subring[of A B Y],
       frule PolynRg.is_Ring[of A B Y],
       frule Ring.subring_Ring[of A B], assumption)
apply (simp add:polyn_Hom_def,
       rule conjI)
 prefer 2
apply (cut_tac polyn_ring_X_nonzero,
       cut_tac X_mem_R, rule conjI,
       rule subsetI, simp add:image_def,
       erule bexE)  

apply (case_tac "xa = πŸ¬β‡˜S⇙", 
       simp add:Subring_zero_ring_zero,
       simp add:erH_rHom_0,
       simp add:Ring.Subring_zero_ring_zero[THEN sym, of A B],
       simp add:Ring.ring_zero[of B])
apply (simp add:Subring_zero_ring_zero,
       frule_tac x = xa in mem_subring_mem_ring, assumption,
       frule_tac p = xa in s_cf_expr, assumption+, (erule conjE)+,
       frule_tac p1 = xa in s_cf_deg[THEN sym], assumption+,
       frule_tac p1 = xa in pol_of_deg0[THEN sym], assumption+, simp)
apply (simp add:erH_def erh_def, subst polyn_expr_def, simp,
       frule_tac c = "s_cf R S X xa" in cf_h_coeff[of A B Y h], assumption+,
       frule_tac c = "cf_h h (s_cf R S X xa)" and j = 0 in 
                         PolynRg.pol_coeff_mem[of A B Y], assumption, simp,
       frule_tac c = "cf_h h (s_cf R S X xa)" and j = 0 in 
                         PolynRg.pol_coeff_mem_R[of A B Y], assumption, simp,
       simp add:Ring.ring_r_one[of A])

apply (cut_tac pol_expr_of_X,
       cut_tac special_cf_pol_coeff,
       frule ext_cf_pol_coeff[of "C0 S" "Suc 0"])
apply (simp add:erH_def erh_def)
apply (cut_tac deg_n_of_X)
 apply (frule s_cf_expr[of X], assumption+, (erule conjE)+,
        frule_tac a = X and 
        b = "polyn_expr R X (Suc 0) (ext_cf S (Suc 0) (C0 S))" and 
        c = "polyn_expr R X (fst (s_cf R S X X)) (s_cf R S X X)" in
        box_equation, assumption+,
        thin_tac "X = polyn_expr R X (Suc 0) (ext_cf S (Suc 0) (C0 S))",
        thin_tac "X = polyn_expr R X (fst (s_cf R S X X)) (s_cf R S X X)")
 apply (rule sym, subst PolynRg.pol_expr_of_X[of A B Y], assumption+,
        frule s_cf_deg[of X], assumption+, simp)
 apply (frule pol_expr_unique2[of "ext_cf S (Suc 0) (C0 S)" "s_cf R S X X"],
        assumption+, simp add:ext_cf_len special_cf_len,
        simp add:ext_cf_len special_cf_len)
 apply (frule cf_h_coeff[of A B Y h "ext_cf S (Suc 0) (C0 S)"], assumption+,
        frule cf_h_coeff[of A B Y h "s_cf R S X X"], assumption+)
 apply (frule PolynRg.pol_expr_unique2[of A B Y 
          "cf_h h (ext_cf S (Suc 0) (C0 S))" "cf_h h (s_cf R S X X)"],
        assumption+,
        simp add:cf_h_len ext_cf_len special_cf_len,
        simp add:cf_h_len ext_cf_len special_cf_len)
 
apply (simp add:cf_h_special_cf)
apply (thin_tac "(polyn_expr A Y (Suc 0) (ext_cf B (Suc 0) (C0 B)) =
        polyn_expr A Y (Suc 0) (cf_h h (s_cf R S X X))) =
         (βˆ€j≀Suc 0.
           snd (cf_h h (ext_cf S (Suc 0) (C0 S))) j =
           snd (cf_h h (s_cf R S X X)) j)")
 apply (rule allI, rule impI,
        drule_tac a = j in forall_spec, assumption,
        (subst cf_h_def)+, (subst cmp_def)+, simp)

apply (subst rHom_def, simp,
       cut_tac ring_is_ag,
       frule Ring.ring_is_ag[of A])
apply (rule conjI)
 apply (subst aHom_def, simp)
 apply (rule conjI)
  apply (simp add:erH_mem)
  apply (rule conjI, simp add:erH_def erh_def extensional_def)
  apply (rule ballI)+
  
  apply (case_tac "a = πŸ¬β‡˜R⇙", 
          case_tac "b = πŸ¬β‡˜R⇙", simp) 
  apply (simp add:erH_rHom_0,
         frule Ring.ring_is_ag[of A], frule Ring.ring_zero[of A],
         simp add:aGroup.ag_r_zero)
  apply (simp add:erH_rHom_0, simp add:erH_rHom_0)
  apply (frule_tac p = b in erH_mem[of A B Y h], assumption+) 
  apply (simp add:aGroup.ag_l_zero)

   apply (case_tac "b = πŸ¬β‡˜R⇙", simp) 
   apply (simp add:erH_rHom_0,
          frule_tac p = a in erH_mem[of A B Y h], assumption+,
          simp add:aGroup.ag_r_zero)

   apply (case_tac "a Β±β‡˜R⇙ b = πŸ¬β‡˜R⇙", simp add:erH_rHom_0) 
   apply (frule_tac x = a and y = b in aGroup.ag_inv_unique[of R],
          assumption+, simp,
          thin_tac "b = -a a")
   apply (subst erHomTr0[of A B Y h], assumption+,
          frule_tac p = a in erH_mem[of A B Y h], assumption+,
          simp add:aGroup.ag_r_inv1)
   
   apply (case_tac "deg_n R S X a = deg_n R S X b",
          simp add:erHomTr1[of A B Y h])
   apply (cut_tac y = "deg_n R S X a" and x = "deg_n R S X b" in less_linear,
          simp)
   apply (erule disjE)
   apply (subst aGroup.ag_pOp_commute, assumption+,
          frule_tac p = a in erH_mem[of A B Y h], assumption+,
          frule_tac p = b in erH_mem[of A B Y h], assumption+,
          subst aGroup.ag_pOp_commute[of A], assumption+,
          rule erHomTr2[of A B Y h], assumption+,
          simp add:aGroup.ag_pOp_commute, assumption)
  
    apply(rule erHomTr2[of A B Y h], assumption+)

 apply (simp add:erH_rHomTr2)
 apply (rule ballI)+
 apply (case_tac "x = πŸ¬β‡˜R⇙", simp add:ring_times_0_x erH_rHom_0,
        frule_tac p = y in erH_mem[of A B Y h], assumption+,
        simp add:Ring.ring_times_0_x[of A])
 apply (case_tac "y = πŸ¬β‡˜R⇙", simp add:ring_times_x_0 erH_rHom_0,
        frule_tac p = x in erH_mem[of A B Y h], assumption+,
        simp add:Ring.ring_times_x_0[of A])
 
 apply (frule_tac p = x in s_cf_expr, assumption+,
        frule_tac p = y in s_cf_expr, assumption+,
        frule_tac x = x and y = y in ring_tOp_closed, assumption+, 
        frule_tac p = "x β‹…r y" in s_cf_expr,
        simp add:Idomain.idom_tOp_nonzeros, (erule conjE)+)

 apply (frule_tac c = "s_cf R S X x" and d = "s_cf R S X y" in 
                  polyn_expr_tOp_c, assumption+, erule exE, (erule conjE)+,
        cut_tac a = "x β‹…r y" and 
        b = "polyn_expr R X (fst (s_cf R S X (x β‹…r y))) (s_cf R S X (x β‹…r y))" 
        and c = "polyn_expr R X (fst e) e" in box_equation)  
       apply assumption
       apply (thin_tac "x β‹…r y =
        polyn_expr R X (fst (s_cf R S X (x β‹…r y))) (s_cf R S X (x β‹…r y))")
       apply (drule sym, drule sym, simp) 
  
   apply (thin_tac "x = polyn_expr R X (fst (s_cf R S X x)) (s_cf R S X x)",
          thin_tac "y = polyn_expr R X (fst (s_cf R S X y)) (s_cf R S X y)",
         thin_tac "x β‹…r y =
        polyn_expr R X (fst (s_cf R S X (x β‹…r y))) (s_cf R S X (x β‹…r y))")

 apply ((subst erH_def)+, (subst erh_def)+, simp)
          
 apply (frule_tac c = "s_cf R S X x" and d = "s_cf R S X y" and e = e in
        erH_multTr1[of A B Y h], assumption+, simp, simp,
     thin_tac "polyn_expr A Y (fst (s_cf R S X x)) (cf_h h (s_cf R S X x)) β‹…rβ‡˜A⇙
     polyn_expr A Y (fst (s_cf R S X y)) (cf_h h (s_cf R S X y)) =
     polyn_expr A Y (fst (s_cf R S X x) + fst (s_cf R S X y)) (cf_h h e)")
 apply (rotate_tac -1, drule sym, simp,
       thin_tac "polyn_expr R X (fst (s_cf R S X x)) (s_cf R S X x) β‹…r
        polyn_expr R X (fst (s_cf R S X y)) (s_cf R S X y) =
        polyn_expr R X (fst (s_cf R S X (x β‹…r y))) (s_cf R S X (x β‹…r y))",
       rotate_tac -1, drule sym) 
  apply (frule_tac p = x in s_cf_deg, assumption,
         frule_tac p = y in s_cf_deg, assumption,
         frule_tac x = x and y = y in Idomain.idom_tOp_nonzeros[of R],
         assumption+,
         frule_tac p = "x β‹…r y" in s_cf_deg, assumption+)
  apply (frule_tac p = x and q = y in deg_mult_pols, assumption+,
         (erule conjE)+, simp,
         thin_tac "deg_n R S X x = fst (s_cf R S X x)", 
         thin_tac "deg_n R S X y = fst (s_cf R S X y)", 
         thin_tac "deg_n R S X (x β‹…r y) = fst (s_cf R S X (x β‹…r y))",
         rotate_tac -2, drule sym)
         apply (simp add:cf_h_len)
  apply (frule_tac c = "s_cf R S X (x β‹…r y)" in cf_h_coeff[of A B Y h],
          assumption+,
         frule_tac c = e in cf_h_coeff[of A B Y h], assumption+)
  apply (frule_tac c = "cf_h h (s_cf R S X (x β‹…r y))" and d = "cf_h h e" in 
         PolynRg.pol_expr_unique2[of A B Y], assumption+,
         simp add:cf_h_len, simp add:cf_h_len,
         thin_tac "(polyn_expr A Y (fst (s_cf R S X x) + fst (s_cf R S X y))
          (cf_h h (s_cf R S X (x β‹…r y))) =
           polyn_expr A Y (fst (s_cf R S X x) + fst (s_cf R S X y))
          (cf_h h e)) =
          (βˆ€j≀fst (s_cf R S X x) + fst (s_cf R S X y).
            snd (cf_h h (s_cf R S X (x β‹…r y))) j = snd (cf_h h e) j)")
  apply (frule_tac c = "s_cf R S X (x β‹…r y)" and d = e in 
         pol_expr_unique2, assumption+, simp, simp,
         thin_tac "polyn_expr R X (fst (s_cf R S X x) + fst (s_cf R S X y))
         (s_cf R S X (x β‹…r y)) =
         polyn_expr R X (fst (s_cf R S X x) + fst (s_cf R S X y)) e")
  apply (rule allI, rule impI, drule_tac a = j in forall_spec, assumption,
         subst cf_h_def, subst cmp_def, simp, 
         subst cf_h_def, subst cmp_def, simp)
done  

lemma (in PolynRg) erH_q_rHom:"⟦Idomain S; maximal_ideal S P; 
       PolynRg R' (S /r P) Y⟧ ⟹
       erH R S X R' (S /r P) Y (pj S P) ∈ pHom R S X, R' (S /r P) Y"
apply (frule Idomain.idom_is_ring[of "S"],
       frule Ring.qring_ring[of S P], simp add:Ring.maximal_ideal_ideal,
       rule erH_rHom[of R' "S /r P" Y "pj S P"], assumption+)
apply (rule pj_Hom[of S P], assumption+,
       simp add:Ring.maximal_ideal_ideal)
done 

lemma (in PolynRg) erH_add:"⟦Idomain S; PolynRg A B Y; h ∈ rHom S B;
                   p ∈ carrier R; q ∈ carrier R⟧ ⟹ 
          erH R S X A B Y h (p Β± q) =
                 (erH R S X A B Y h p) Β±β‡˜A⇙ (erH R S X A B Y h q)"
apply (frule erH_rHom[of A B Y h], assumption+)
apply (simp add:polyn_Hom_def, (erule conjE)+)
apply (simp add:rHom_add)
done

lemma (in PolynRg) erH_minus:"⟦Idomain S; PolynRg A B Y; 
       h ∈ rHom S B; p ∈ carrier R⟧ ⟹  
        erH R S X A B Y h (-a p) = -aβ‡˜A⇙ (erH R S X A B Y h p)"
apply (frule erH_rHom[of A B Y h], assumption+,
       simp add:polyn_Hom_def, (erule conjE)+)
apply (frule PolynRg.is_Ring[of A B Y])
apply (rule rHom_inv_inv[of R A p "erH R S X A B Y h"])
apply (cut_tac is_Ring, assumption+) 
done

lemma (in PolynRg) erH_mult:"⟦Idomain S; PolynRg A B Y; h ∈ rHom S B; 
      p ∈ carrier R; q ∈ carrier R⟧ ⟹  
      erH R S X A B Y h (p β‹…r q) =
                 (erH R S X A B Y h p) β‹…rβ‡˜A⇙ (erH R S X A B Y h q)"
apply (frule erH_rHom[of A B Y h], assumption+,
       simp add:polyn_Hom_def, (erule conjE)+,
       frule PolynRg.is_Ring[of A B Y],
       cut_tac is_Ring,
       rule rHom_tOp[of R A p q "erH R S X A B Y h"], assumption+)
done

lemma (in PolynRg) erH_rHom_cf:"⟦Idomain S; PolynRg A B Y; h ∈ rHom S B; 
                   s ∈ carrier S⟧  ⟹ erH R S X A B Y h s = h s"
apply (cut_tac subring, frule subring_Ring,
       frule PolynRg.subring[of A B Y], 
       frule PolynRg.is_Ring[of A B Y],
       frule Ring.subring_Ring[of A B], assumption,
       frule mem_subring_mem_ring[of S s], assumption+)
apply (case_tac "s = πŸ¬β‡˜S⇙", simp add:Subring_zero_ring_zero,
       simp add:erH_rHom_0,
       simp add:Subring_zero_ring_zero[THEN sym], 
       simp add:rHom_0_0, simp add:Ring.Subring_zero_ring_zero)
apply (frule s_cf_expr[of s],simp add:Subring_zero_ring_zero,
       (erule conjE)+,
       simp add:Subring_zero_ring_zero)
apply (frule s_cf_deg[of s], assumption+,
       frule pol_of_deg0[of s], assumption+, simp)
apply (subst erH_def, simp,
       subst erh_rHom_coeff[of A B Y h "s_cf R S X s"], assumption+,
       simp add:cmp_def polyn_expr_def,
       frule_tac c = "s_cf R S X s" and j = 0 in pol_coeff_mem, simp,
       frule mem_subring_mem_ring[of S "snd (s_cf R S X s) 0"], assumption+,
       simp add:ring_r_one)
done

lemma (in PolynRg) erH_rHom_coeff:"⟦Idomain S; PolynRg A B Y; h ∈ rHom S B; 
       pol_coeff S (n, f)⟧  ⟹ pol_coeff B (n, cmp h f)"
apply (simp add:pol_coeff_def)
 apply (rule allI, rule impI, drule_tac a = j in forall_spec, assumption)
 apply (simp add:cmp_def rHom_mem)
done

lemma (in PolynRg) erH_rHom_unique:"⟦Idomain S; PolynRg A B Y; h ∈ rHom S B⟧
     ⟹  βˆƒ!g. g ∈ pHom R S X, A B Y ∧ (βˆ€x∈carrier S. h x = g x)" 
apply (cut_tac subring, frule subring_Ring,
       cut_tac is_Ring,
       frule PolynRg.subring[of A B Y], 
       frule PolynRg.is_Ring[of A B Y],
       frule Ring.subring_Ring[of A B], assumption,
       frule Idomain.idom_is_ring[of S])

apply (rule ex_ex1I)
 apply (frule erH_rHom[of A B Y h], assumption+)
 apply (subgoal_tac "βˆ€x∈carrier S. h x = (erH R S X A B Y h) x", blast)
 apply (rule ballI, simp add:erH_rHom_cf, (erule conjE)+)
 apply (frule pHom_rHom[of A B Y], assumption+,
        frule pHom_rHom[of A B Y], assumption+,
        frule_tac f = g in rHom_func[of _ R A],
        frule_tac f = y in rHom_func[of _ R A])
 apply (rule_tac f = g and g = y in funcset_eq[of _ "carrier R"],
        simp add:rHom_def aHom_def, simp add:rHom_def aHom_def)
 apply (rule ballI,
        thin_tac "g ∈ carrier R β†’ carrier A",
        thin_tac "y ∈ carrier R β†’ carrier A")

 apply (case_tac "x = πŸ¬β‡˜R⇙", simp,
        subst rHom_0_0[of R A], assumption+, rule sym, 
        subst rHom_0_0[of R A], assumption+, simp)
 apply (subst pHom_pol_mem[of A B Y], assumption+)
 apply (frule_tac f = y and p = x in pHom_pol_mem[of A B Y], assumption+,
        simp,
        frule_tac f = g and c = "s_cf R S X x" in polyn_Hom_coeff_to_coeff,
        assumption+, simp add:s_cf_pol_coeff,
        frule_tac f = y and c = "s_cf R S X x" in polyn_Hom_coeff_to_coeff,
        assumption+, simp add:s_cf_pol_coeff)
 apply (simp add:s_cf_deg)
  apply (frule_tac f = g and c = "s_cf R S X x" in cf_h_len1[of A B Y h],
         assumption+, rule ballI, rule sym, simp, rule s_cf_pol_coeff, 
         assumption+)
  apply (frule_tac f = y and c = "s_cf R S X x" in cf_h_len1[of A B Y h],
         assumption+, rule ballI, rule sym, simp, rule s_cf_pol_coeff, 
         assumption+)
 apply (frule_tac c = "cf_h g (s_cf R S X x)" and d = "cf_h y (s_cf R S X x)"
         in PolynRg.pol_expr_unique2[of A B Y], assumption+, simp)
 apply (frule_tac p = x in s_cf_pol_coeff, simp add:cf_h_len,
        thin_tac "(polyn_expr A Y (fst (s_cf R S X x)) (cf_h g (s_cf R S X x))
         = polyn_expr A Y (fst (s_cf R S X x)) (cf_h y (s_cf R S X x))) =
        (βˆ€j≀fst (s_cf R S X x).
            snd (cf_h g (s_cf R S X x)) j = snd (cf_h y (s_cf R S X x)) j)")
 apply (rule allI, rule impI,
        (subst cf_h_def)+, (subst cmp_def)+, simp,
        frule_tac c = "s_cf R S X x" and j = j in pol_coeff_mem, assumption+)
 apply simp
done

lemma (in PolynRg) erH_rHom_unique1:"⟦Idomain S; PolynRg A B Y; h ∈ rHom S B; 
       f ∈ pHom R S X, A B Y; βˆ€x ∈ carrier S. f x = h x⟧ ⟹ 
       f = (erH R S X A B Y h)"
apply (frule erH_rHom_unique[of A B Y h], assumption+,
       erule ex1E,
       frule_tac x = f in spec,
       drule_tac x = "erH R S X A B Y h" in spec)
 apply (frule erH_rHom[of A B Y h], assumption+,
        simp add:erH_rHom_cf[THEN sym])
done

lemma (in PolynRg) pHom_dec_deg:"⟦PolynRg A B Y; f ∈ pHom R S X, A B Y; 
       p ∈ carrier R⟧ ⟹ 
                  deg A B Y (f p) ≀ deg R S X p"
apply (cut_tac subring, frule subring_Ring,
       frule PolynRg.subring[of A B Y],
       cut_tac is_Ring)
apply (frule PolynRg.is_Ring[of A B Y], 
       frule Ring.subring_Ring[of A B], assumption) 
apply (case_tac "f p = πŸ¬β‡˜A⇙",
       case_tac "p = πŸ¬β‡˜R⇙",
       simp add:deg_def, simp add:deg_def an_def,
       simp add:deg_def, subst ale_natle) 
apply (case_tac "p = πŸ¬β‡˜R⇙",
       frule pHom_rHom[of A B Y f], assumption+,
       rule conjI, rule impI, frule rHom_0_0[of R A f], assumption+,
       simp, rule impI, simp)

apply simp
 apply (frule pHom_pol_mem[of A B Y f p], assumption+)
 apply (cut_tac polyn_Hom_coeff_to_coeff[of A B Y f "s_cf R S X p"])
 apply (frule PolynRg.pol_deg_le_n[of A B Y "f p" "cf_h f (s_cf R S X p)"],
        frule pHom_rHom[of A B Y f], assumption+,
        rule rHom_mem[of f R A p], assumption+,
        frule s_cf_pol_coeff[of p],
        subst cf_h_len2[of A B Y f "s_cf R S X p"], assumption+,
        simp add:s_cf_deg,
       thin_tac "f p = polyn_expr A Y (deg_n R S X p) (cf_h f (s_cf R S X p))")
       apply (frule s_cf_pol_coeff[of p], simp add:cf_h_len2, 
              simp add:s_cf_deg[THEN sym],
              assumption+,
              simp add:s_cf_pol_coeff)
done
       
lemma (in PolynRg) erH_map:"⟦Idomain S; PolynRg A B Y; h ∈ rHom S B; 
       pol_coeff S (n, c)⟧ ⟹ 
      (erH R S X A B Y h) (polyn_expr R X n (n, c)) = 
                           polyn_expr A Y n (n, (cmp h c))"
apply (cut_tac subring, frule subring_Ring,
       frule PolynRg.subring[of A B Y],
       cut_tac is_Ring,
       frule PolynRg.is_Ring[of A B Y], 
       frule Ring.subring_Ring[of A B], assumption) 
apply (case_tac "polyn_expr R X n (n, c) = πŸ¬β‡˜R⇙", simp add:erH_rHom_0)
 apply (frule coeff_0_pol_0[THEN sym, of "(n, c)" n], simp, simp,
        thin_tac "polyn_expr R X n (n, c) = 𝟬")
 apply (frule cf_h_coeff[of A B Y h "(n, c)"], assumption+,
        simp add:cf_h_pol_coeff)
 apply (rule sym, 
        frule_tac PolynRg.coeff_0_pol_0[THEN sym, of A B Y "(n, cmp h c)" n], 
        simp+)
 apply (rule allI, rule impI, simp add:cmp_def, simp add:rHom_0_0)
 apply (frule erH_rHom[of A B Y h], assumption+)
 apply (subst pHom_mem[of A B Y "erH R S X A B Y h" n c], assumption+)
 apply (frule PolynRg.pol_expr_unique2[of A B Y 
        "(n, cmp (erH R S X A B Y h) c)" "(n, cmp h c)"],
       simp add:cmp_pol_coeff_e, simp add:cmp_pol_coeff)
 apply (simp, simp,
        thin_tac "(polyn_expr A Y n (n, cmp (erH R S X A B Y h) c) =
        polyn_expr A Y n (n, cmp h c)) =
       (βˆ€j≀n. cmp (erH R S X A B Y h) c j = cmp h c j)")
 apply (rule allI, rule impI,
        frule_tac j = j in pol_coeff_mem[of "(n, c)"], simp,
        simp add:cmp_def)
 apply (simp add:erH_rHom_cf)
done

section "Relatively prime polynomials"

definition
  rel_prime_pols :: "[('a, 'm) Ring_scheme, ('a, 'm1) Ring_scheme, 'a,
         'a, 'a ] β‡’ bool" where
  "rel_prime_pols R S X p q ⟷ (1rβ‡˜R⇙) ∈ ((Rxa R p) βˆ“β‡˜R⇙ (Rxa R q))"

definition
  div_condn :: "[('a, 'm) Ring_scheme, ('a, 'm1) Ring_scheme, 'a, nat, 
                'a, 'a ] β‡’ bool" where
  "div_condn R S X n g f ⟷ f ∈ carrier R ∧ n = deg_n R S X f ⟢
   (βˆƒq.  q ∈ carrier R ∧ ((f Β±β‡˜R⇙ (-aβ‡˜R⇙ (q β‹…rβ‡˜R⇙ g)) = πŸ¬β‡˜R⇙) ∨ (deg_n R S X 
    (f Β±β‡˜R⇙ (-aβ‡˜R⇙ (q β‹…rβ‡˜R⇙ g))) < deg_n R S X g)))"

lemma (in PolynRg) divisionTr0:"⟦Idomain S; p ∈ carrier R; 
       c ∈ carrier S; c β‰  πŸ¬β‡˜Sβ‡™βŸ§ ⟹ 
                     lcf R S X (c β‹…r X^β‡—R nβ‡– β‹…r p) = c β‹…rβ‡˜S⇙ (lcf R S X p)" 
apply (cut_tac polyn_ring_integral, simp,
       cut_tac subring, frule subring_Ring,
       cut_tac polyn_ring_X_nonzero,
       cut_tac X_mem_R)
apply (frule mem_subring_mem_ring[of S c], assumption+,
      frule npClose[of X n])
apply (case_tac "p = πŸ¬β‡˜R⇙", simp,
       frule ring_tOp_closed[of c "X^⇗R n⇖"], assumption+,
       simp add:ring_times_x_0 lcf_val_0,
       simp add:Ring.ring_times_x_0[of S])
apply (frule_tac x = c and y = " X^⇗R n⇖" in Idomain.idom_tOp_nonzeros[of R],
      assumption+,
      simp add:Subring_zero_ring_zero,
      frule Idomain.idom_potent_nonzero[of R X n], assumption+,
      frule_tac x = c and y = " X^⇗R n⇖" in ring_tOp_closed, assumption+,
      frule_tac x = "c ⋅r X^⇗R n⇖" and y = p in Idomain.idom_tOp_nonzeros[of R],
      assumption+,
      frule_tac x = "c ⋅r X^⇗R n⇖" and y = p in ring_tOp_closed, assumption+)
apply (simp add:lcf_val) 

apply (frule s_cf_expr[of p], assumption, (erule conjE)+,
       simp add:ring_tOp_assoc[of c _ p],
       frule low_deg_terms_zero1[THEN sym, of "s_cf R S X p" n])
apply (cut_tac a = "X^⇗R n⇖ ⋅r 
                    polyn_expr R X (fst (s_cf R S X p)) (s_cf R S X p)" and 
               b = "X^⇗R n⇖ ⋅r p" and 
               c = "polyn_expr R X (fst (s_cf R S X p) + n) 
                     (ext_cf S n (s_cf R S X p))" in box_equation,
       simp, assumption,
   thin_tac "p = polyn_expr R X (fst (s_cf R S X p)) (s_cf R S X p)",
   thin_tac "X^⇗R n⇖ ⋅r polyn_expr R X (fst (s_cf R S X p)) (s_cf R S X p) =
     polyn_expr R X (fst (s_cf R S X p) + n) (ext_cf S n (s_cf R S X p))")
apply (frule ext_cf_pol_coeff[of "s_cf R S X p" n],
       frule scalar_times_pol_expr[of c "ext_cf S n (s_cf R S X p)" 
            "fst (s_cf R S X p) + n"], assumption+,
       simp add:ext_cf_len)
   apply (frule sp_cf_pol_coeff[of "ext_cf S n (s_cf R S X p)" c],
          assumption+,
     cut_tac a = "c β‹…r
     polyn_expr R X (fst (s_cf R S X p) + n) (ext_cf S n (s_cf R S X p))"
     and b = "c ⋅r (X^⇗R n⇖ ⋅r p)" and 
         c = "polyn_expr R X (fst (s_cf R S X p) + n)
              (sp_cf S c (ext_cf S n (s_cf R S X p)))" in box_equation,
     simp, simp,
     thin_tac "X^⇗R n⇖ ⋅r p =
        polyn_expr R X (fst (s_cf R S X p) + n) (ext_cf S n (s_cf R S X p))",
     thin_tac "c β‹…r
        polyn_expr R X (fst (s_cf R S X p) + n) (ext_cf S n (s_cf R S X p)) =
        polyn_expr R X (fst (s_cf R S X p) + n)
        (sp_cf S c (ext_cf S n (s_cf R S X p)))")
  apply (frule s_cf_expr[of "c ⋅r (X^⇗R n⇖ ⋅r p)"], assumption+,
         (erule conjE)+,
         drule_tac a = "c ⋅r (X^⇗R n⇖ ⋅r p)" and 
         b = "polyn_expr R X (fst (s_cf R S X (c ⋅r (X^⇗R n⇖ ⋅r p))))
                       (s_cf R S X (c ⋅r (X^⇗R n⇖ ⋅r p)))" and 
         c = "polyn_expr R X (fst (s_cf R S X p) + n)
             (sp_cf S c (ext_cf S n (s_cf R S X p)))" in box_equation,
       assumption,
       thin_tac "c ⋅r (X^⇗R n⇖ ⋅r p) =
          polyn_expr R X (fst (s_cf R S X p) + n)
          (sp_cf S c (ext_cf S n (s_cf R S X p)))",
       frule pol_expr_unique2[of "s_cf R S X (c ⋅r (X^⇗R n⇖ ⋅r p))" 
               "sp_cf S c (ext_cf S n (s_cf R S X p))"], assumption+,
       subst s_cf_deg[THEN sym], assumption+,
        frule_tac Idomain.idom_potent_nonzero[of R X n], assumption+,
        frule_tac x = "X^⇗R n⇖" and y = p in Idomain.idom_tOp_nonzeros[of R],
        assumption+)
 apply (subst deg_mult_pols, assumption+, simp add:Subring_zero_ring_zero,
        simp add:ring_tOp_closed, assumption+,
        subst deg_mult_pols, assumption+,
        simp add:deg_to_X_d,
        cut_tac pol_of_deg0[THEN sym, of c], simp,
        simp add:sp_cf_len ext_cf_len s_cf_deg, assumption+,
        simp add:Subring_zero_ring_zero,
        simp add:sp_cf_len ext_cf_len)

  apply (subst s_cf_deg[THEN sym], assumption+,
        frule_tac Idomain.idom_potent_nonzero[of R X n], assumption+,
        frule_tac x = "X^⇗R n⇖" and y = p in Idomain.idom_tOp_nonzeros[of R],
        assumption+,
        simp add:s_cf_deg[THEN sym],
        frule_tac x = "X^⇗R n⇖" and y = p in ring_tOp_closed, assumption+)
  apply (frule deg_mult_pols[of c "X^⇗R n⇖ ⋅r p"], assumption+,
        simp add:Subring_zero_ring_zero, assumption+, (erule conjE)+, simp,
        thin_tac "deg_n R S X (c ⋅r (X^⇗R n⇖ ⋅r p)) =
                          deg_n R S X c + deg_n R S X (X^⇗R n⇖ ⋅r p)",
        cut_tac pol_of_deg0[THEN sym, of c], simp,
        frule deg_mult_pols[of "X^⇗R n⇖" p], assumption+, (erule conjE)+,
             simp,
      thin_tac "deg_n R S X (X^⇗R n⇖ ⋅r p) = deg_n R S X (X^⇗R n⇖) + deg_n R S X p",
      simp add:deg_to_X_d, simp add:add.commute[of n],
      thin_tac "polyn_expr R X (deg_n R S X p + n) 
          (s_cf R S X (c ⋅r (X^⇗R n⇖ ⋅r p))) = polyn_expr R X (deg_n R S X p + n)
                                      (sp_cf S c (ext_cf S n (s_cf R S X p)))")
  apply (subst sp_cf_def, simp)
  apply (subst ext_cf_def, simp add:sliden_def, assumption)
  apply (simp add:Subring_zero_ring_zero)
done

lemma (in PolynRg) divisionTr1:"⟦Corps S; g ∈ carrier R; g β‰  𝟬;
      0 < deg_n R S X g; f ∈ carrier R; f β‰  𝟬; deg_n R S X g ≀ deg_n R S X f⟧
      ⟹ 
      f Β± -a ((lcf R S X f) β‹…rβ‡˜S⇙ ((lcf R S X g)⇗‐ Sβ‡–) β‹…r 
                     (X^β‡—R ((deg_n R S X f) - (deg_n R S X g))β‡–) β‹…r g) = 𝟬 ∨ 
      deg_n R S X (f Β± -a ((lcf R S X f) β‹…rβ‡˜S⇙ ((lcf R S X g)⇗‐ Sβ‡–) β‹…r 
                 (X^β‡—R ((deg_n R S X f) - (deg_n R S X g))β‡–) β‹…r g)) < deg_n R S X f"
apply (cut_tac ring_is_ag,
       cut_tac subring, 
       frule Corps.field_is_idom[of "S"],
       frule subring_Ring,
       cut_tac subring,
       cut_tac polyn_ring_X_nonzero,
       cut_tac X_mem_R,
       cut_tac polyn_ring_integral, simp)
apply (frule npClose[of X "deg_n R S X f - deg_n R S X g"],
       frule_tac Idomain.idom_potent_nonzero[of R X 
                "fst (s_cf R S X f) - fst (s_cf R S X g)"], assumption+,
       frule s_cf_expr[of f], assumption+, (erule conjE)+,
       frule s_cf_expr[of g], assumption+, (erule conjE)+,
       simp add:s_cf_deg, simp add:lcf_val[THEN sym],
       frule Corps.invf_closed1[of S "lcf R S X g"], simp, simp add:lcf_mem,
       frule lcf_mem[of f], simp,
       frule subring_Ring, frule Ring.ring_is_ag[of S], (erule conjE)+,
       frule_tac x = "lcf R S X f" and y = "lcf R S X g⇗‐ Sβ‡–" in 
                 Ring.ring_tOp_closed[of S], assumption+,
       frule mem_subring_mem_ring[of S " lcf R S X f β‹…rβ‡˜S⇙ lcf R S X g⇗‐ Sβ‡– "],
         assumption+,
       frule_tac x = "lcf R S X f" and y = "lcf R S X g⇗‐ Sβ‡–" in 
         Idomain.idom_tOp_nonzeros[of S], assumption+,
       simp add:Subring_zero_ring_zero)
apply(frule_tac x = "lcf R S X f β‹…rβ‡˜S⇙ lcf R S X g⇗‐ Sβ‡–" and 
       y = "X^β‡—R (fst (s_cf R S X f) - fst (s_cf R S X g))β‡–" in 
      Idomain.idom_tOp_nonzeros[of R], assumption+,
      frule_tac x = "lcf R S X f β‹…rβ‡˜S⇙ lcf R S X g⇗‐ Sβ‡–" and 
       y = "X^β‡—R (fst (s_cf R S X f) - fst (s_cf R S X g))β‡–" in ring_tOp_closed, 
      assumption+,
      frule_tac x = "lcf R S X f β‹…rβ‡˜S⇙ lcf R S X g⇗‐ Sβ‡– β‹…r 
       X^β‡—R (fst (s_cf R S X f) - fst (s_cf R S X g))β‡–" and y = g in 
        Idomain.idom_tOp_nonzeros[of R], assumption+,
      frule_tac x = "lcf R S X f β‹…rβ‡˜S⇙ lcf R S X g⇗‐ Sβ‡– β‹…r 
       X^β‡—R (fst (s_cf R S X f) - fst (s_cf R S X g))β‡–" and y = g in ring_tOp_closed,
      assumption+)

apply (frule pol_diff_deg_less[of f "s_cf R S X f" 
       "s_cf R S X (lcf R S X f β‹…rβ‡˜S⇙ lcf R S X g⇗‐ Sβ‡– β‹…r 
                 X^β‡—R (fst (s_cf R S X f) - fst (s_cf R S X g))β‡– β‹…r g)"], assumption+,
       simp add:s_cf_pol_coeff)
 apply (simp add:s_cf_deg[THEN sym])
   apply (frule deg_mult_pols[of "lcf R S X f β‹…rβ‡˜S⇙ (lcf R S X g)⇗‐ Sβ‡–" 
                   "(X^β‡—R (deg_n R S X f - deg_n R S X g)β‡– )β‹…r g"], assumption+,
          rule ring_tOp_closed, assumption+,
          rule Idomain.idom_tOp_nonzeros[of R], assumption+,
          (erule conjE)+, 
          subst ring_tOp_assoc[of "lcf R S X f β‹…rβ‡˜S⇙ lcf R S X g⇗‐ Sβ‡–" _ g],
                 assumption+, simp,
          cut_tac pol_of_deg0[THEN sym, of "lcf R S X f β‹…rβ‡˜S⇙ lcf R S X g⇗‐ Sβ‡–"], 
          simp,
          thin_tac "deg_n R S X (lcf R S X f β‹…rβ‡˜S⇙ lcf R S X g⇗‐ Sβ‡– β‹…r
              (X^β‡—R (deg_n R S X f - deg_n R S X g)β‡– β‹…r g)) =
               deg_n R S X (X^β‡—R (deg_n R S X f - deg_n R S X g)β‡– β‹…r g)")
   apply (frule deg_mult_pols[of "(X^β‡—R (deg_n R S X f - deg_n R S X g)β‡– )" g], 
          assumption+, simp,
          simp add:deg_to_X_d, assumption+,
          fold lcf_def,
          subst divisionTr0[of g "lcf R S X f β‹…rβ‡˜S⇙ lcf R S X g⇗‐ Sβ‡–" 
                        "fst (s_cf R S X f) - fst (s_cf R S X g)"],
          assumption+, simp add:Subring_zero_ring_zero)
   apply (subst Ring.ring_tOp_assoc, assumption+, simp add:lcf_mem,
          frule Corps.invf_inv[of S "lcf R S X g"], simp add:lcf_mem,
          simp add:Subring_zero_ring_zero, simp add:Ring.ring_r_one,
          frule s_cf_expr[of "lcf R S X f β‹…rβ‡˜S⇙ lcf R S X g⇗‐ Sβ‡– β‹…r
               X^β‡—R (fst (s_cf R S X f) - fst (s_cf R S X g))β‡– β‹…r g"],
          rule  Idomain.idom_tOp_nonzeros[of R], assumption+) 
 apply ((erule conjE)+,
        thin_tac "snd (s_cf R S X
           (lcf R S X f β‹…rβ‡˜S⇙ lcf R S X g⇗‐ Sβ‡– β‹…r
            X^β‡—R (fst (s_cf R S X f) - fst (s_cf R S X g))β‡– β‹…r  g))
           (fst (s_cf R S X (lcf R S X f β‹…rβ‡˜S⇙ lcf R S X g⇗‐ Sβ‡– β‹…r
              X^β‡—R (fst (s_cf R S X f) - fst (s_cf R S X g))β‡– β‹…r g))) β‰  πŸ¬β‡˜S⇙")
  apply (rotate_tac -1, drule sym, simp)
done
 
lemma (in PolynRg) divisionTr2:"⟦Corps S; g ∈ carrier R; g β‰  𝟬; 
                   0 < deg_n R S X g⟧  ⟹  βˆ€f. div_condn R S X n g f"
apply (cut_tac ring_is_ag,
       frule Corps.field_is_idom[of "S"],
       cut_tac subring, frule subring_Ring,
       cut_tac polyn_ring_integral, simp,
       cut_tac X_mem_R)

apply (rule nat_less_induct)
apply (rule allI)
apply (subst div_condn_def, rule impI, (erule conjE)+)
apply (case_tac "f = πŸ¬β‡˜R⇙",
       cut_tac ring_zero,
       subgoal_tac " f Β± -a (𝟬 β‹…r g) = 𝟬",
       blast,
       simp add:ring_times_0_x, simp add:aGroup.ag_inv_zero[of "R"],
       simp add:aGroup.ag_r_zero) 
apply (case_tac "n < deg_n R S X g")
 apply (cut_tac ring_zero,
        subgoal_tac "deg_n R S X (f Β± -a (𝟬 β‹…r g)) < deg_n R S X g", 
        blast) apply ( 
       simp add:ring_times_0_x, simp add:aGroup.ag_inv_zero,
       simp add:aGroup.ag_r_zero)
apply (frule_tac x = n and y = "deg_n R S X g" in leI,
       thin_tac "Β¬ n < deg_n R S X g")
   (** deg_n R S X g ≀ deg_n R S X f **)
apply (frule_tac f = f in divisionTr1[of g], assumption+, simp)
apply (frule_tac p = f in lcf_mem,
       frule lcf_mem[of g],
       frule lcf_nonzero[of g], assumption+,
       frule Corps.invf_closed1[of S "lcf R S X g"], simp)
apply (frule_tac x = "lcf R S X f" and y = "lcf R S X g⇗‐ Sβ‡–" in 
                 Ring.ring_tOp_closed[of S], assumption+, simp)
 apply (frule_tac x = "lcf R S X f β‹…rβ‡˜S⇙ lcf R S X g⇗‐ Sβ‡–" in mem_subring_mem_ring,
        assumption) 
 apply (frule_tac n = "deg_n R S X f - deg_n R S X g" in npClose[of X],
        frule_tac x = "lcf R S X f β‹…rβ‡˜S⇙ lcf R S X g⇗‐ Sβ‡–" and 
                  y = "X^β‡—R (deg_n R S X f - deg_n R S X g)β‡–" in 
                  ring_tOp_closed, assumption+,
        frule_tac x = "lcf R S X f β‹…rβ‡˜S⇙ lcf R S X g⇗‐ Sβ‡– β‹…r 
                       X^β‡—R (deg_n R S X f - deg_n R S X g)β‡–"  and 
                  y = g in ring_tOp_closed, assumption+)
 apply (erule disjE, blast)
 apply (drule_tac a = "deg_n R S X (f Β± -a (lcf R S X f β‹…rβ‡˜S⇙ 
          lcf R S X g⇗‐ Sβ‡– β‹…r X^β‡—R (deg_n R S X f - deg_n R S X g)β‡– β‹…r g))" in
          forall_spec, simp)
 apply (simp add:div_condn_def)
 apply (drule_tac x = "f Β±
             -a (lcf R S X f β‹…rβ‡˜S⇙ lcf R S X g⇗‐ Sβ‡– β‹…r
                 X^β‡—R (deg_n R S X f - deg_n R S X g)β‡– β‹…r
                 g)" in spec)
 apply (frule_tac x = "lcf R S X f β‹…rβ‡˜S⇙ lcf R S X g⇗‐ Sβ‡– β‹…r
           X^β‡—R (deg_n R S X f - deg_n R S X g)β‡– β‹…r g" in aGroup.ag_mOp_closed,
           assumption)
 apply (frule_tac x = f and y = "-a (lcf R S X f β‹…rβ‡˜S⇙ lcf R S X g⇗‐ Sβ‡– β‹…r
               X^β‡—R (deg_n R S X f - deg_n R S X g)β‡– β‹…r g)" in 
        aGroup.ag_pOp_closed, assumption+, simp,
        thin_tac "deg_n R S X (f Β±  -a (lcf R S X f β‹…rβ‡˜S⇙ lcf R S X g⇗‐ Sβ‡– β‹…r
                 X^β‡—R (deg_n R S X f - deg_n R S X g)β‡– β‹…r g)) < deg_n R S X f")
 apply (erule exE,
        thin_tac "f Β± -a (lcf R S X f β‹…rβ‡˜S⇙ lcf R S X g⇗‐ Sβ‡– β‹…r
            X^β‡—R (deg_n R S X f - deg_n R S X g)β‡– β‹…r g) ∈ carrier R")
 apply ((erule conjE)+,
        frule_tac x = q and y = g in ring_tOp_closed, assumption+,
        frule_tac x = "q β‹…r g" in aGroup.ag_mOp_closed, assumption+,
        simp add:aGroup.ag_pOp_assoc,
        simp add:aGroup.ag_p_inv[THEN sym],
        simp add:ring_distrib2[THEN sym])
 apply (frule_tac x = "lcf R S X f β‹…rβ‡˜S⇙ lcf R S X g⇗‐ Sβ‡– β‹…r
         X^β‡—R (deg_n R S X f - deg_n R S X g)β‡–" and y = q in 
                          aGroup.ag_pOp_closed, assumption+)
 apply (erule disjE) 
 apply blast 
 apply blast
done

lemma (in PolynRg) divisionTr3:"⟦Corps S; g ∈ carrier R; g β‰  𝟬; 
      0 < deg_n R S X g; f ∈ carrier R⟧ ⟹  
     βˆƒq∈carrier R. (f Β± -a (q β‹…r  g) = 𝟬) ∨ ( f Β± -a (q β‹…r g) β‰  𝟬 ∧
      deg_n R S X (f Β± -a (q β‹…r g)) < (deg_n R S X g))"
apply (frule divisionTr2[of g "deg_n R S X f"], assumption+) 
 apply (drule_tac x = f in spec)
apply (simp add:div_condn_def, blast) 
done

lemma (in PolynRg) divisionTr4:"⟦Corps S; g ∈ carrier R; g β‰  𝟬; 
       0 < deg_n R S X g; f ∈ carrier R⟧ ⟹  
   βˆƒq∈carrier R. (f = q β‹…r g) ∨ (βˆƒr∈carrier R. r β‰  𝟬 ∧ (f = (q β‹…r g) Β± r)
     ∧ (deg_n R S X r) < (deg_n R S X g))"
apply (cut_tac is_Ring,
       cut_tac ring_is_ag)
apply (frule divisionTr3[of g f], assumption+,
       erule bexE,
       frule_tac x = q in ring_tOp_closed[of  _ g], assumption+,
       erule disjE) 
apply (simp add:aGroup.ag_eq_diffzero[THEN sym, of "R" "f"], blast)
apply (subgoal_tac "f = q β‹…r g Β± (f Β± -a (q β‹…r g))",
       subgoal_tac "(f Β± -a (q β‹…r g)) ∈ carrier R", blast,
       rule aGroup.ag_pOp_closed, assumption+,
       rule aGroup.ag_mOp_closed, assumption+)
apply (frule_tac x = "q β‹…r g" in aGroup.ag_mOp_closed, assumption+,
       subst aGroup.ag_pOp_assoc[THEN sym], assumption+,
       subst aGroup.ag_pOp_commute[of R _ f], assumption+,
       subst aGroup.ag_pOp_assoc, assumption+,
              simp add:aGroup.ag_r_inv1, simp add:aGroup.ag_r_zero)
done

lemma (in PolynRg) divisionTr:"⟦Corps S; g ∈ carrier R; 0 < deg R S X g; 
       f ∈ carrier R⟧ ⟹ 
       βˆƒq∈carrier R. (βˆƒr∈carrier R. (f = (q β‹…r g) Β± r) ∧ 
                                  (deg R S X r) < (deg R S X g))"
apply (subgoal_tac "g β‰  𝟬",
       frule divisionTr4[of g f], assumption+,
       simp add:deg_def, simp only:an_0[THEN sym],
       cut_tac aless_nat_less[of "0" "deg_n R S X g"],  simp, assumption)
apply (erule bexE, erule disjE,
       cut_tac ring_is_ag, frule aGroup.ag_r_zero[of "R" "f"], simp, simp,
       rotate_tac -1, frule sym,
       cut_tac ring_zero,
       subgoal_tac "deg R S X 𝟬 < deg R S X g", blast,
       simp add:deg_def an_def)
apply (erule bexE, (erule conjE)+,
       cut_tac n1 = "deg_n R S X r" and m1 = "deg_n R S X g" in 
       aless_natless[THEN sym], simp add:deg_def,
       drule sym, simp, rotate_tac -1, drule sym, blast)
apply (rule contrapos_pp, simp+,
       simp add:deg_def, frule aless_imp_le[of "0" "-∞"],
       cut_tac minf_le_any[of "0"]) 
 apply (frule ale_antisym[of "0" "-∞"], assumption)
 apply simp
done

lemma (in PolynRg) rel_prime_equation:"⟦Corps S; f ∈ carrier R; g ∈ carrier R;
      0 < deg R S X f; 0 < deg R S X g; rel_prime_pols R S X f g;
      h ∈ carrier R⟧ ⟹ 
     βˆƒu ∈ carrier R. βˆƒv ∈ carrier R.
     (deg R S X u ≀ amax ((deg R S X h) - (deg R S X f)) (deg R S X g)) ∧
     (deg R S X v ≀ (deg R S X f)) ∧ (u β‹…r f Β± (v β‹…r g) = h)"
apply (cut_tac ring_is_ag,
       cut_tac ring_zero, cut_tac subring, frule subring_Ring,
       frule aless_imp_le [of "0" "deg R S X f"],
       frule  pol_nonzero[of f], simp,
       frule aless_imp_le [of "0" "deg R S X g"], 
       frule  pol_nonzero[of g], simp,
       frule Corps.field_is_idom[of "S"],
       cut_tac polyn_ring_integral, simp,
       frule Idomain.idom_tOp_nonzeros[of R f g], assumption+) 
apply (case_tac "h = πŸ¬β‡˜R⇙")
 apply (cut_tac ring_is_ag,
        cut_tac ring_zero,
        subgoal_tac "deg R S X 𝟬 ≀ 
                      amax (deg R S X h - deg R S X f) (deg R S X g)",
        subgoal_tac "deg R S X 𝟬 ≀ deg R S X f ∧ 
                     𝟬 β‹…r f Β± 𝟬 β‹…r g = h", blast)
  apply (simp add:ring_times_0_x, simp add:aGroup.ag_r_zero,
        simp add:deg_def)
  apply (simp add:deg_def amax_def)

apply (simp add:rel_prime_pols_def,
       frule principal_ideal[of f], frule principal_ideal[of g],
       frule ideals_set_sum[of "R β™’p f" "R β™’p g" "1r"], assumption+,
       thin_tac "1r ∈ R β™’p f βˆ“ R β™’p g",
       (erule bexE)+,
       thin_tac "ideal R (R β™’p f)", thin_tac "ideal R (R β™’p g)",
       simp add:Rxa_def, (erule bexE)+, simp,
       thin_tac "ha = r β‹…r f", thin_tac "k = ra β‹…r g")
apply (frule_tac x = r in ring_tOp_closed[of _ f], assumption+,
       frule_tac x = ra in ring_tOp_closed[of _ g], assumption+,
       frule_tac y1 = "r β‹…r f" and z1 = "ra β‹…r g" in ring_distrib1[THEN sym, 
       of "h"], assumption+, simp add:ring_r_one, drule sym,
       simp,
       thin_tac "r β‹…r f Β± ra β‹…r g = 1r",
       simp add:ring_tOp_assoc[THEN sym], simp add:ring_r_one)
apply (frule_tac f = "h β‹…r r" in divisionTr[of g], assumption+,
       simp add:ring_tOp_closed,
       frule_tac f = "h β‹…r ra" in divisionTr[of f], assumption+,
       simp add:ring_tOp_closed,
       (erule bexE)+, (erule conjE)+) 
(** final **) 
apply (thin_tac " r ∈ carrier R",
       thin_tac "ra ∈ carrier R",
       thin_tac "r β‹…r f ∈ carrier R",
       thin_tac "ra β‹…r g ∈ carrier R")
apply (frule_tac x = q in ring_tOp_closed[of _ g], assumption+,
       frule_tac x = qa in ring_tOp_closed[of _ f], assumption+,
       frule_tac x = "q β‹…r g" and y = rb in aGroup.ag_pOp_commute, assumption+,
       simp, 
       thin_tac "q β‹…r g Β± rb = rb Β± q β‹…r g",
       thin_tac  "h β‹…r r =  rb Β± q β‹…r g",
       thin_tac "h β‹…r ra =  qa β‹…r f Β± rc")
apply (simp add:ring_distrib2[of g],
     frule_tac x = rb and y = "q β‹…r g" in aGroup.ag_pOp_closed[of R], 
       assumption+,
     frule_tac x = "rb Β± q β‹…r g" and y = f in ring_tOp_closed, 
      assumption+,
     frule_tac x = "qa β‹…r f" and y = g in ring_tOp_closed, assumption+,
     frule_tac x = rc and y = g in ring_tOp_closed, assumption+,
     simp add:aGroup.ag_pOp_assoc[THEN sym, of "R"],
     simp add:ring_tOp_assoc[of _ f g],
     simp add:ring_tOp_commute[of f g],
     simp add:ring_tOp_assoc[THEN sym, of  _ g f],
     frule_tac x = qa and y = g in ring_tOp_closed, assumption+,
     simp add:ring_distrib2[THEN sym],
     simp add:aGroup.ag_pOp_assoc,
     simp add:ring_distrib2[THEN sym],
     case_tac "q Β±β‡˜R⇙ qa = πŸ¬β‡˜R⇙", simp add:ring_times_0_x,
          simp add:aGroup.ag_r_zero,
     subgoal_tac "deg R S X rb ≀ 
                         amax (deg R S X h - deg R S X f) (deg R S X g)",
            subgoal_tac "deg R S X rc ≀ deg R S X f",
            blast,
        simp add:aless_imp_le,
        frule_tac x = "deg R S X rb" and y = "deg R S X g" in
           aless_imp_le,
        rule_tac i = "deg R S X rb" in ale_trans[of _ "deg R S X g" 
          "amax (deg R S X h - deg R S X f) (deg R S X g)"], assumption,
           simp add:amax_def, simp add:aneg_le aless_imp_le)
apply (subgoal_tac "rb Β± (q Β± qa) β‹…r g ∈ carrier R",
       subgoal_tac "deg R S X (rb Β± (q Β± qa) β‹…r g) ≀ 
                    amax (deg R S X h - deg R S X f) (deg R S X g)",
       subgoal_tac "deg R S X rc ≀ deg R S X f",  blast,
     simp add:aless_imp_le,
     frule_tac x = q and y = qa in aGroup.ag_pOp_closed[of "R"], assumption+,
     frule_tac p = rb and q = "(q Β± qa) β‹…r g" in deg_pols_add1,
     rule ring_tOp_closed, assumption+, simp add:deg_mult_pols1,
     frule_tac p1 = "q Β± qa" in pol_nonzero[THEN sym], simp)

apply (frule_tac y = "deg R S X (q Β± qa)" and z = "deg R S X rb" in 
                                   aadd_le_mono[of "0"], simp add:aadd_0_l)
apply (frule_tac p = "q Β± qa" in deg_ant_int, assumption+,
       frule_tac x = "deg R S X rb" and y = "deg R S X g" and 
                 z = "int (deg_n R S X ( q Β± qa))" in aadd_less_mono_z,
       simp add:aadd_commute)

apply (simp add:deg_mult_pols1,
       frule_tac p = "rb Β± (q Β± qa) β‹…r g" and q = f in 
            deg_mult_pols1, assumption+, simp,
       thin_tac "deg R S X (rb Β± (q Β± qa) β‹…r g) = 
                       deg R S X (q Β± qa) + deg R S X g",
       frule_tac x = "rb Β± (q Β± qa) β‹…r g" and y = f in 
       ring_tOp_closed,  assumption+, simp only:aGroup.ag_pOp_commute,
       frule_tac p = "rc β‹…r g" and q = "(rb Β± (q Β± qa) β‹…r g) β‹…r f" in 
        deg_pols_add1, assumption+, simp,
       thin_tac "deg R S X ((rb Β± (q Β± qa) β‹…r g) β‹…r f) =
        deg R S X (q Β± qa) + deg R S X g + deg R S X f")
apply (simp add:deg_mult_pols1,
       frule_tac p1 = "q Β± qa" in pol_nonzero[THEN sym], simp,
       simp add:deg_ant_int[of g])
apply (frule_tac x = "deg R S X rc" and y = "deg R S X f" and 
        z = "int (deg_n R S X g)" in aadd_less_mono_z,
       frule_tac a = "deg R S X ( q Β± qa)" in aadd_pos_le[of _ 
                   "deg R S X f + ant (int (deg_n R S X g))"],
       frule_tac x = "deg R S X rc + ant (int (deg_n R S X g))" and 
        y = "deg R S X f + ant (int (deg_n R S X g))" and 
        z = "deg R S X ( q Β± qa) + (deg R S X f + ant (int (deg_n R S X g)))" 
       in aless_le_trans, assumption+,
       thin_tac "deg R S X rc + ant (int (deg_n R S X g))
                       < deg R S X f + ant (int (deg_n R S X g))",
       thin_tac "deg R S X f + ant (int (deg_n R S X g))
           ≀ deg R S X ( q Β± qa) + (deg R S X f + ant (int (deg_n R S X g)))")
apply (simp add:deg_ant_int[THEN sym])
 apply (frule_tac p = "q Β± qa" in deg_in_aug_minf,
        frule_tac p = "g" in deg_in_aug_minf, 
        frule_tac p = "f" in deg_in_aug_minf, 
        simp add:aadd_commute[of "deg R S X f" "deg R S X g"],
        simp only:aadd_assoc_m[THEN sym], simp)
 apply (frule_tac p = "g" in deg_in_aug_minf,
        frule_tac p = "f" in deg_in_aug_minf,
        frule_tac p = "q Β± qa" in deg_in_aug_minf,
        simp add:diff_ant_def,
        subgoal_tac "-(deg R S X f) ∈ Z-∞") 
apply (subst aadd_assoc_m[of _ "deg R S X f" "- deg R S X f"],
       simp add:Zminf_pOp_closed, assumption+,
       (simp add:aadd_minus_r, simp add:aadd_0_r), simp add:amax_ge_l,
       simp add:deg_ant_int, simp add:aminus, simp add:z_in_aug_minf)
 apply (rule aGroup.ag_pOp_closed, assumption+,
        rule ring_tOp_closed,
        rule aGroup.ag_pOp_closed, assumption+)
done 

subsection "Polynomial, coeff mod P"

definition
  P_mod :: "[('a, 'm) Ring_scheme, ('a, 'm1) Ring_scheme, 'a, 'a set,
          'a] β‡’ bool" where
  "P_mod R S X P p ⟷ p = πŸ¬β‡˜R⇙ ∨ 
     (βˆ€j ≀ (fst (s_cf R S X p)). (snd (s_cf R S X p) j) ∈ P)"

lemma (in PolynRg) P_mod_whole:"p ∈ carrier R ⟹
                         P_mod R S X (carrier S) p"
apply (case_tac "p = πŸ¬β‡˜R⇙", simp add:P_mod_def)
apply (simp add:P_mod_def,
       rule allI, rule impI,
       rule pol_coeff_mem,
       simp add:s_cf_pol_coeff,
       assumption)
done

lemma (in PolynRg) zero_P_mod:"ideal S I ⟹ P_mod R S X I 𝟬" 
by (simp add:P_mod_def)

lemma (in PolynRg) P_mod_mod:"⟦ideal S I; p ∈ carrier R; pol_coeff S c;
                     p = polyn_expr R X (fst c) c⟧ ⟹ 
                     (βˆ€j ≀ (fst c). (snd c) j ∈ I) = (P_mod R S X I p)"
apply (cut_tac subring, frule subring_Ring)
apply (case_tac "p = πŸ¬β‡˜R⇙")
   apply (simp add:P_mod_def,
          drule sym,
          frule coeff_0_pol_0[THEN sym, of c "fst c"], simp, simp)
   apply (rule impI,
          simp add:Ring.ideal_zero)

apply (frule s_cf_expr[of p],
       simp add:P_mod_def, (erule conjE)+)
apply (frule polyn_c_max[of c])
 apply (frule coeff_nonzero_polyn_nonzero[of c "fst c"], simp)
 apply (frule coeff_max_nonzeroTr[of c], simp)
 apply (thin_tac "(polyn_expr R X (fst c) c β‰  𝟬) = (βˆƒj≀fst c. snd c j β‰  πŸ¬β‡˜S⇙)")
 apply (frule coeff_max_bddTr[of c])
 apply (frule polyn_expr_short[of c "c_max S c"], assumption+)
 apply (frule pol_expr_unique[of p "(c_max S c, snd c)" "s_cf R S X p"],
        assumption+, rule split_pol_coeff[of c], assumption+,
        simp, simp, assumption+)
 
 apply (thin_tac "p = polyn_expr R X (fst c) c",
        thin_tac "p = polyn_expr R X (fst (s_cf R S X p)) (s_cf R S X p)",
        thin_tac "polyn_expr R X (fst c) c = polyn_expr R X (c_max S c) c",
        thin_tac "polyn_expr R X (c_max S c) c =
                      polyn_expr R X (c_max S c) (c_max S c, snd c)")
 apply (frule coeff_max_zeroTr[of c], (erule conjE)+)
 apply (subst P_mod_def, simp)
 apply (rule iffI, rule allI, rule impI)
 apply (rotate_tac 10,
        drule_tac a = j in forall_spec,
        drule_tac x = j in spec, assumption,
        frule_tac i = j and j = "fst (s_cf R S X p)" and k = "fst c" in 
                  le_trans, assumption+, 
        drule_tac a = j in forall_spec, assumption, simp)
 
 apply (rule allI, rule impI)
 apply (case_tac "fst (s_cf R S X p) < j", 
        drule_tac a = j in forall_spec, simp,
        simp add:Ring.ideal_zero,
        frule_tac x = "fst (s_cf R S X p)" and y = j in leI,
        thin_tac "βˆ€j. j ≀ fst c ∧ fst (s_cf R S X p) < j ⟢ snd c j = πŸ¬β‡˜S⇙",
        drule_tac a = j in forall_spec, assumption,
        drule_tac a = j in forall_spec, assumption, simp)
done

lemma (in PolynRg) monomial_P_mod_mod:"⟦ideal S I; c ∈ carrier S; 
       p = c β‹…r (X^β‡—R dβ‡–)⟧ ⟹  (c ∈ I) = (P_mod R S X I p)"
apply (cut_tac subring, frule subring_Ring)
apply (cut_tac monomial_d[THEN sym, of "(0, Ξ»j. c)" "d"], simp)
apply (drule sym, simp)
apply (subst P_mod_mod[THEN sym, of I p "ext_cf S d (0, Ξ»j. c)"],
       assumption+)
   apply (frule mem_subring_mem_ring[of S c], assumption,
          cut_tac X_mem_R, 
          frule npClose[of X d], drule sym, simp add:ring_tOp_closed)
   apply (simp add:pol_coeff_def, rule allI, rule impI, 
       simp add:ext_cf_def sliden_def, rule impI, simp add:Ring.ring_zero,
       subst ext_cf_len, simp add:pol_coeff_def,
       simp)
   apply (subst ext_cf_len, simp add:pol_coeff_def,
          simp add:ext_cf_def)
apply (rule iffI)
   apply (simp add:Ring.ideal_zero,
          drule_tac x = d in spec,
          simp, simp add:pol_coeff_def)
done

lemma (in PolynRg) P_mod_add:"⟦ideal S I; p ∈ carrier R;
      q ∈ carrier R; P_mod R S X I p; P_mod R S X I q⟧ ⟹ 
               P_mod R S X I (p Β± q)"
apply (cut_tac subring,
       frule subring_Ring,
       cut_tac ring_is_ag)

apply (case_tac "p = πŸ¬β‡˜R⇙", simp add:aGroup.ag_l_zero,
       case_tac "q = πŸ¬β‡˜R⇙", simp add:aGroup.ag_r_zero)
apply (case_tac "p Β±β‡˜R⇙ q = πŸ¬β‡˜R⇙", simp add:P_mod_def)

apply (frule s_cf_expr[of p], assumption,
       frule s_cf_expr[of q], assumption, (erule conjE)+)
apply (frule polyn_add1[of "s_cf R S X p" "s_cf R S X q"], assumption+,
       drule sym, drule sym, simp, drule sym, simp,
       rotate_tac -1, drule sym)
apply (frule P_mod_mod[THEN sym, of I p "s_cf R S X p"], assumption+, simp,
       thin_tac "polyn_expr R X (fst (s_cf R S X p)) (s_cf R S X p) = p",
       frule P_mod_mod[THEN sym, of I q "s_cf R S X q"], assumption+, simp,
       thin_tac "polyn_expr R X (fst (s_cf R S X q)) (s_cf R S X q) = q")
apply (frule aGroup.ag_pOp_closed[of R p q], assumption+)  
apply (subst P_mod_mod[THEN sym, of I "p Β± q" 
             "add_cf S (s_cf R S X p) (s_cf R S X q)"], assumption+,
       simp add:add_cf_pol_coeff, simp, simp add:add_cf_len,
       thin_tac "p Β± q =
         polyn_expr R X (max (fst (s_cf R S X p)) (fst (s_cf R S X q)))
         (add_cf S (s_cf R S X p) (s_cf R S X q))")
       apply simp
apply (subst add_cf_len, assumption+)
apply (rule allI, rule impI)

apply (cut_tac x = "fst (s_cf R S X p)" and y = "fst (s_cf R S X q)" in 
       less_linear)
apply (erule disjE)
 apply (simp, subst add_cf_def, simp,
       (rule impI, 
        drule_tac a = j in forall_spec, assumption,
        drule_tac x = j in spec,
        frule_tac x = j and y = "fst (s_cf R S X p)" and 
           z = "fst (s_cf R S X q)" in le_less_trans, assumption+,
        frule_tac x = j and y = "fst (s_cf R S X q)" in less_imp_le, simp))
        apply (rule Ring.ideal_pOp_closed[of S I], assumption+)
apply (erule disjE)
 apply (simp, subst add_cf_def, simp,
        drule_tac a = j in forall_spec, assumption,
        drule_tac a = j in forall_spec, assumption)
        apply (rule Ring.ideal_pOp_closed[of S I], assumption+)

 apply (simp add: max.absorb1 max.absorb2, subst add_cf_def, simp, rule impI,
        drule_tac x = j in spec, 
        drule_tac a = j in forall_spec, assumption,
        frule_tac x = j and y = "fst (s_cf R S X q)" and 
           z = "fst (s_cf R S X p)" in le_less_trans, assumption+,
        frule_tac x = j and y = "fst (s_cf R S X p)" in less_imp_le, simp)
        apply (rule Ring.ideal_pOp_closed[of S I], assumption+)
done

lemma (in PolynRg) P_mod_minus:"⟦ideal S I; p ∈ carrier R; P_mod R S X I p⟧ ⟹
                  P_mod R S X I (-a p)" 
apply (cut_tac ring_is_ag,
       cut_tac subring,
       frule subring_Ring)
apply (case_tac "p = πŸ¬β‡˜R⇙", simp add:aGroup.ag_inv_zero)

apply (frule s_cf_expr[of p], assumption+, (erule conjE)+,
       frule polyn_minus_m_cf[of "s_cf R S X p" "fst (s_cf R S X p)"],
       simp,
       frule aGroup.ag_inv_inj[of R p 𝟬], assumption,
       simp add:ring_zero, assumption, simp add:aGroup.ag_inv_zero,
       frule m_cf_pol_coeff[of "s_cf R S X p"],
       drule sym, drule sym, simp)
apply (subst P_mod_mod[THEN sym, of I "-a p" "m_cf S (s_cf R S X p)"],
        assumption+,
      rule aGroup.ag_mOp_closed[of R p], assumption+,
      simp add:m_cf_len,
      thin_tac "polyn_expr R X (fst (s_cf R S X p)) 
                                 (m_cf S (s_cf R S X p)) = -a p")
apply (frule P_mod_mod[THEN sym, of I p "s_cf R S X p"], assumption+, simp,
       thin_tac "polyn_expr R X (fst (s_cf R S X p)) (s_cf R S X p) = p",
       simp)
apply (rule allI, rule impI,
       drule_tac a = j in forall_spec, simp add:m_cf_len,
       subst m_cf_def, simp,
       rule Ring.ideal_inv1_closed[of S I], assumption+)
done

lemma (in PolynRg) P_mod_pre:"⟦ideal S I; pol_coeff S ((Suc n), f); 
       P_mod R S X I (polyn_expr R X (Suc n) (Suc n, f))⟧ ⟹
       P_mod R S X I (polyn_expr R X n (n, f))" 
apply (frule pol_coeff_pre[of n f],
       frule polyn_mem[of "(n, f)" n],simp,
       frule polyn_mem[of "(Suc n, f)" "Suc n"], simp)
apply (case_tac "polyn_expr R X n (n, f) = πŸ¬β‡˜R⇙", simp add:P_mod_def)
apply (subst P_mod_mod[THEN sym, of I 
                  "polyn_expr R X n (n, f)" "(n, f)"], assumption+, simp,
       frule P_mod_mod[THEN sym, of I "polyn_expr R X (Suc n) (Suc n, f)"
               "(Suc n, f)"], assumption+, simp, simp)
done

lemma (in PolynRg) P_mod_pre1:"⟦ideal S I; pol_coeff S ((Suc n), f); 
       P_mod R S X I (polyn_expr R X (Suc n) (Suc n, f))⟧ ⟹
       P_mod R S X I (polyn_expr R X n (Suc n, f))" 
by (simp add:polyn_expr_restrict[of n f], simp add:P_mod_pre)

lemma (in PolynRg) P_mod_coeffTr:"⟦ideal S I; d ∈ carrier S⟧ ⟹ 
                   (P_mod R S X I d) = (d ∈ I)"
apply (cut_tac subring, frule subring_Ring,
       subst monomial_P_mod_mod[of I d "d β‹…r X^β‡—R 0β‡–" 0], assumption+,
       simp, simp,
       frule mem_subring_mem_ring[of _ d], assumption+,
       simp add:ring_r_one)
done 

lemma (in PolynRg) P_mod_mult_const:"⟦ideal S I; ideal S J; 
     pol_coeff S (n, f); P_mod R S X I (polyn_expr R X n (n, f));
     pol_coeff S (0, g); P_mod R S X J (polyn_expr R X 0 (0, g))⟧ ⟹ 
       P_mod R S X (I β™’rβ‡˜S⇙ J) ((polyn_expr R X n (n, f)) β‹…r 
                                        (polyn_expr R X 0 (0, g)))"
apply (cut_tac subring, frule subring_Ring) 
apply (frule_tac c = "(n, f)" in polyn_mem[of _ n], simp)
 apply (frule Ring.ideal_prod_ideal[of S I J], assumption+)
apply (case_tac "polyn_expr R X n (n, f) = πŸ¬β‡˜R⇙", simp)
 apply (frule_tac c = "(0, g)" in polyn_mem[of _ 0], simp,
        simp add:ring_times_0_x, simp add:P_mod_def)
 apply (simp add:polyn_expr_def [of _ _ "0"])
 apply (frule pol_coeff_mem[of "(0, g)" 0], simp, simp,
        frule mem_subring_mem_ring[of S "g 0"], assumption,
        simp add:ring_r_one,
        simp add:ring_tOp_commute[of _ "g 0"])
 apply (frule sp_cf_pol_coeff[of "(n, f)" "g 0"], assumption+)
 apply (subst scalar_times_pol_expr[of "g 0" "(n, f)" n], assumption+,
        simp)
 apply (subst P_mod_mod[THEN sym, of "I β™’rβ‡˜S⇙ J" 
        "polyn_expr R X n (sp_cf S (g 0) (n, f))" "sp_cf S (g 0) (n, f)"],
         assumption+,
         simp add:polyn_mem, simp add:sp_cf_pol_coeff,
         rule polyn_mem, simp add:sp_cf_pol_coeff,
         simp add:sp_cf_len, simp,
         simp add:sp_cf_len)
 apply (frule P_mod_mod[THEN sym, of I "polyn_expr R X n (n, f)" 
         "(n, f)"], assumption+, simp, simp,
        simp add:sp_cf_len, subst sp_cf_def, simp,
        simp add:P_mod_coeffTr[of J "g 0"])
 apply (rule allI, rule impI,
        drule_tac a = j in forall_spec, assumption,
        frule_tac h = "f j" in Ring.ideal_subset[of S I], assumption+,
        simp add:Ring.ring_tOp_commute[of S "g 0"])
 apply (simp add:Ring.prod_mem_prod_ideals[of S I J])
done

lemma (in PolynRg) P_mod_mult_const1:"⟦ideal S I; ideal S J; 
       pol_coeff S (n, f); P_mod R S X I (polyn_expr R X n (n, f));
       d ∈ J⟧ ⟹ 
       P_mod R S X (I β™’rβ‡˜S⇙ J) ((polyn_expr R X n (n, f)) β‹…r d)"
apply (cut_tac subring, frule subring_Ring)
apply (frule P_mod_coeffTr[THEN sym, of J d],
       simp add:Ring.ideal_subset, simp)
apply (frule P_mod_mult_const[of I J n f "Ξ»j. d"], assumption+,
       simp add:pol_coeff_def, simp add:Ring.ideal_subset)
apply (subst polyn_expr_def, simp,
       frule Ring.ideal_subset[of S  J d], assumption+,
       frule mem_subring_mem_ring[of S d], assumption,
       simp add:ring_r_one)
apply (simp add:polyn_expr_def[of _ _ 0],
       frule Ring.ideal_subset[of S  J d], assumption+,
       frule mem_subring_mem_ring[of S d], assumption,
       simp add:ring_r_one)
done
 
lemma (in PolynRg) P_mod_mult_monomial:"⟦ideal S I; p ∈ carrier R⟧ ⟹
           (P_mod R S X I p ) = (P_mod R S X I (p ⋅r X^⇗R m⇖))"
apply (cut_tac X_mem_R,
       cut_tac subring, frule subring_Ring)
apply (frule npClose[of X m],
       simp add:ring_tOp_commute[of p ])
apply (case_tac "p = πŸ¬β‡˜R⇙", simp add:ring_times_x_0)
apply (rule iffI)
apply (frule s_cf_expr[of p], assumption+, (erule conjE)+,
       cut_tac low_deg_terms_zero[THEN sym, of "fst (s_cf R S X p)" 
               "snd (s_cf R S X p)" m],
       simp add:polyn_expr_split[THEN sym],
       thin_tac "X^⇗R m⇖ ⋅r p =
       polyn_expr R X (fst (s_cf R S X p) + m) (ext_cf S m (s_cf R S X p))",
       frule ext_cf_pol_coeff[of "s_cf R S X p" m])
apply (frule P_mod_mod[THEN sym, of I p "s_cf R S X p"], assumption+,
       thin_tac "p = polyn_expr R X (fst (s_cf R S X p)) (s_cf R S X p)",
       simp)
apply (frule P_mod_mod[THEN sym, of I "polyn_expr R X (fst (s_cf R S X p) + 
          m) (ext_cf S m (s_cf R S X p))" "ext_cf S m (s_cf R S X p)"],
       rule polyn_mem, assumption, simp add:ext_cf_def,
       assumption, simp add:ext_cf_len add.commute, simp,
       thin_tac "P_mod R S X I (polyn_expr R X (fst (s_cf R S X p) + m)
        (ext_cf S m (s_cf R S X p))) = (βˆ€j≀fst (ext_cf S m (s_cf R S X p)).
         snd (ext_cf S m (s_cf R S X p)) j ∈ I)",
       thin_tac "snd (s_cf R S X p) (fst (s_cf R S X p)) β‰  πŸ¬β‡˜S⇙")
apply (rule allI, rule impI, simp add:ext_cf_len) apply (
       subst ext_cf_def, simp add:sliden_def) apply (rule impI,
       simp add:Ring.ideal_zero[of S]) 
apply (simp add:pol_coeff_split[THEN sym])
 
apply (frule s_cf_expr[of p], assumption+, (erule conjE)+,
       cut_tac low_deg_terms_zero[THEN sym, of "fst (s_cf R S X p)" 
               "snd (s_cf R S X p)" m],
       simp add:polyn_expr_split[THEN sym],
       thin_tac "X^⇗R m⇖ ⋅r p =
       polyn_expr R X (fst (s_cf R S X p) + m) (ext_cf S m (s_cf R S X p))",
       frule ext_cf_pol_coeff[of "s_cf R S X p" m]) 
apply (frule P_mod_mod[THEN sym, of I "polyn_expr R X (fst (s_cf R S X p) + 
          m) (ext_cf S m (s_cf R S X p))" "ext_cf S m (s_cf R S X p)"],
       rule polyn_mem, assumption, simp add:ext_cf_def,
       assumption, simp add:ext_cf_len add.commute, simp,
       thin_tac "p = polyn_expr R X (fst (s_cf R S X p)) (s_cf R S X p)",
       thin_tac "P_mod R S X I
       (polyn_expr R X (fst (s_cf R S X p) + m) (ext_cf S m (s_cf R S X p)))",
       thin_tac "snd (s_cf R S X p) (fst (s_cf R S X p)) β‰  πŸ¬β‡˜S⇙")
apply (subst P_mod_mod[THEN sym, of I p "s_cf R S X p"], assumption+,
       cut_tac s_cf_expr[of p], simp, assumption+,
       rule allI, rule impI,
       thin_tac "pol_coeff S (ext_cf S m (s_cf R S X p))",
       simp add:ext_cf_len, simp add:ext_cf_def)
apply (drule_tac x = "m + j" in spec,
       frule_tac i = j and j = "fst (s_cf R S X p)" and k = m and l = m in 
       add_le_mono, simp, simp only:add.commute[of _ m],
       thin_tac "j ≀ fst (s_cf R S X p)", simp,
       simp add:sliden_def)
apply simp
done

lemma (in PolynRg) P_mod_multTr:"⟦ideal S I; ideal S J; pol_coeff S (n, f); 
       P_mod R S X I (polyn_expr R X n (n, f))⟧ ⟹ βˆ€g. ((pol_coeff S (m, g)
       ∧ (P_mod R S X J (polyn_expr R X m (m, g))))  ⟢  
          P_mod R S X (I β™’rβ‡˜S⇙ J) 
           ((polyn_expr R X n (n, f)) β‹…r (polyn_expr R X m (m, g))))"
apply (cut_tac subring, frule subring_Ring,
       cut_tac ring_is_ag, cut_tac X_mem_R)
apply (frule polyn_mem[of "(n, f)" n], simp)
 apply (frule Ring.ideal_prod_ideal[of "S" "I" "J"], assumption+)
apply (case_tac "polyn_expr R X n (n, f) = πŸ¬β‡˜R⇙", simp)
 apply (rule allI, rule impI, erule conjE) 
 apply (frule_tac c = "(m, g)" in polyn_mem[of _ m], simp,
        simp add:ring_times_0_x, simp add:P_mod_def)
apply (induct_tac m)
 apply (rule allI, rule impI, erule conjE,
        rule_tac g = g in P_mod_mult_const[of I J n f], assumption+)
             (* case m = 0 done *)
apply (rule allI, rule impI, erule conjE)
apply (frule_tac n = na and f = g in pol_coeff_pre,
       frule_tac n = na and f = g in P_mod_pre[of J], assumption+)
apply (drule_tac a = g in forall_spec, simp)
 apply (frule_tac n = na and f = g in polyn_Suc_split, simp del:npow_suc)
 apply (thin_tac "polyn_expr R X (Suc na) (Suc na, g) =
        polyn_expr R X na (na, g) Β± g (Suc na) β‹…r X^β‡—R (Suc na)β‡–")
 apply (frule_tac c = "(na, g)" and k = na in polyn_mem, simp,
       subgoal_tac "(g (Suc na)) β‹…r (X^β‡—R (Suc na)β‡–) ∈ carrier R",
       subst ring_distrib1, assumption+)  
apply (frule_tac p = "(polyn_expr R X n (n, f)) β‹…r (polyn_expr R X na (na, g))"
       and  q = "(polyn_expr R X n (n, f)) β‹…r 
                      ((g (Suc na)) β‹…r (X^β‡—R (Suc na)β‡–))" in 
        P_mod_add[of "I β™’rβ‡˜S⇙ J"])
 apply (simp add:ring_tOp_closed, rule ring_tOp_closed, assumption+)
 apply (frule_tac c = "(Suc na, g)" and j = "Suc na" in pol_coeff_mem_R,
        simp)
 apply (subst ring_tOp_assoc[THEN sym], assumption+, simp,
        rule npClose, assumption+)
 apply (subst P_mod_mult_monomial[THEN sym, of "I β™’rβ‡˜S⇙ J"], assumption,
       rule ring_tOp_closed, assumption+, simp add:pol_coeff_mem_R)
 apply (rule P_mod_mult_const1, assumption+,
       thin_tac "P_mod R S X (I β™’rβ‡˜S⇙ J)
         (polyn_expr R X n (n, f) β‹…r polyn_expr R X na (na, g))")
 apply (cut_tac n1 = na and c1 = "(Suc na, g)" in polyn_Suc[THEN sym], simp,
        simp,
        frule_tac c = "(Suc na, g)" and k = na in polyn_expr_short,
        simp,  simp,
              thin_tac "P_mod R S X J (polyn_expr R X na (na, g))",
              thin_tac "polyn_expr R X na (na, g) ∈ carrier R",
              thin_tac "polyn_expr R X na (na, g) ± g (Suc na) ⋅r (X^⇗R na⇖ ⋅r X)
                       =  polyn_expr R X (Suc na) (Suc na, g)",
              thin_tac "polyn_expr R X na (Suc na, g) =
                                         polyn_expr R X na (na, g)")
 apply (frule_tac p1 = "polyn_expr R X (Suc na) (Suc na, g)" and 
                c1 = "(Suc na, g)" in P_mod_mod[THEN sym, of J],
        simp add:polyn_mem, assumption, simp, simp)

 apply (simp,
        rule ring_tOp_closed,
        cut_tac c = "(Suc na, g)" and j = "Suc na" in pol_coeff_mem_R,
               assumption, simp, simp, rule npClose, assumption+)
done

lemma (in PolynRg) P_mod_mult:"⟦ideal S I; ideal S J; pol_coeff S (n, c); 
      pol_coeff S (m, d); P_mod R S X I (polyn_expr R X n (n, c)); 
      P_mod R S X J (polyn_expr R X m (m, d))⟧  ⟹ 
      P_mod R S X (I β™’rβ‡˜S⇙ J) ((polyn_expr R X n (n, c)) β‹…r 
                                        (polyn_expr R X m (m, d)))"
apply (simp add:P_mod_multTr)
done

lemma (in PolynRg) P_mod_mult1:"⟦ideal S I; ideal S J;
      p ∈ carrier R; q ∈ carrier R; P_mod R S X I p; P_mod R S X J q⟧  ⟹ 
      P_mod R S X (I β™’rβ‡˜S⇙ J) (p β‹…r q)"
apply (case_tac "p = πŸ¬β‡˜R⇙")
 apply (simp add:ring_times_0_x, simp add:P_mod_def)
apply (case_tac "q = πŸ¬β‡˜R⇙")
 apply (simp add:ring_times_x_0, simp add:P_mod_def)

apply (frule s_cf_expr[of p], assumption+,
       frule s_cf_expr[of q], assumption+, (erule conjE)+)
apply (cut_tac P_mod_mult[of I J "fst (s_cf R S X p)" "snd (s_cf R S X p)"
       "fst (s_cf R S X q)"  "snd (s_cf R S X q)"])
      apply (simp add:polyn_expr_split[THEN sym], assumption+)
      apply (simp add:pol_coeff_split[THEN sym])
      apply (simp add:polyn_expr_split[THEN sym])+
done

lemma (in PolynRg) P_mod_mult2l:"⟦ideal S I; p ∈ carrier R; q ∈ carrier R; 
      P_mod R S X I p⟧  ⟹ P_mod R S X I (p β‹…r q)"
apply (cut_tac subring, frule subring_Ring[of S],
       frule Ring.whole_ideal[of S])
apply (frule P_mod_whole[of q])
apply (frule P_mod_mult1[of I "carrier S" p q], assumption+)
apply (simp add:Ring.idealprod_whole_r)
done

lemma (in PolynRg) P_mod_mult2r:"⟦ideal S I; p ∈ carrier R; q ∈ carrier R; 
      P_mod R S X I q⟧  ⟹ P_mod R S X I (p β‹…r q)"
apply (cut_tac subring, frule subring_Ring[of S],
       frule Ring.whole_ideal[of S])
apply (frule P_mod_whole[of p])
apply (frule P_mod_mult1[of "carrier S" I p q], assumption+)
apply (simp add:Ring.idealprod_whole_l)
done

lemma (in PolynRg) csrp_fn_pol_coeff:"⟦ideal S P; PolynRg R' (S /r P) Y; 
       pol_coeff (S /r P) (n,  c')⟧ ⟹
                          pol_coeff S (n, (cmp (csrp_fn S P) c'))"
apply (cut_tac subring, frule subring_Ring)
apply (simp add:pol_coeff_def)
apply (rule allI, rule impI, simp add:cmp_def)
apply (rule Ring.csrp_fn_mem[of S P], assumption+)
apply simp
done

lemma (in PolynRg) pj_csrp_mem_coeff:"⟦ideal S P; pol_coeff (S /r P) (n, c')⟧
      ⟹ βˆ€j ≀ n. (pj S P) ((csrp_fn S P) (c' j)) = c' j"
apply (cut_tac subring, frule subring_Ring)
apply (rule allI, rule impI, simp add:pol_coeff_def)
apply (simp add:Ring.csrp_pj)
done

lemma (in PolynRg) pHom_pj_csrp:"⟦Idomain S; ideal S P;
             PolynRg R' (S /r P) Y; pol_coeff (S /r P) (n, c')⟧ ⟹
              erH R S X R' (S /r P) Y (pj S P) 
                 (polyn_expr R X n (n, (cmp (csrp_fn S P) c')))
                                     = polyn_expr R' Y n (n, c')"
apply (cut_tac subring, frule subring_Ring,
       frule Ring.qring_ring[of "S" "P"], assumption+) 
 
apply (subst pHom_mem[of R' "(S /r P)" Y "erH R S X R' (S /r P) Y (pj S P)" 
      n  "cmp (csrp_fn S P) c'"], assumption+,
      rule erH_rHom[of R' "S /r P" Y "pj S P"],
       assumption+,
      simp add:pj_Hom, simp add:csrp_fn_pol_coeff)
apply (rule PolynRg.polyn_exprs_eq[of R' "S /r P" Y 
       "(n, cmp (erH R S X R' (S /r P) Y (pj S P)) (cmp (csrp_fn S P) c'))"
       "(n, c')" n], assumption+)
apply (frule csrp_fn_pol_coeff[of P R' Y n c'], assumption+,
       frule erH_rHom [of R' "S /r P" Y "pj S P"], assumption+,
       simp add:pj_Hom,
       rule cmp_pol_coeff_e[of R' "S /r P" Y "erH R S X R' (S /r P) Y (pj S P)"
       n "cmp (csrp_fn S P) c'"], assumption+, simp)
apply (rule allI, rule impI, simp add:cmp_def,
       frule_tac c = "(n, c')" and j = j in 
             PolynRg.pol_coeff_mem[of R' "S /r P" Y], assumption+, simp+,
       frule_tac x = "c' j" in Ring.csrp_fn_mem[of S P], assumption+,
       frule_tac s = "csrp_fn S P (c' j)" in 
            erH_rHom_cf[of R' "S /r P" Y "pj S P"], assumption+,
            simp add:pj_Hom, assumption+)
apply (simp add:pj_csrp_mem_coeff)
done

lemma (in PolynRg) ext_csrp_fn_nonzero:"⟦Idomain S; ideal S P; 
      PolynRg R' (S /r P) Y; g' ∈ carrier R'; g' β‰  πŸ¬β‡˜R'⇙ ⟧ ⟹ 
      polyn_expr R X (deg_n R' (S /r P) Y g') ((deg_n R' (S /r P) Y g'),
          (cmp (csrp_fn S P) (snd (s_cf R' (S /r P) Y g')))) β‰  𝟬"
apply (cut_tac subring, frule subring_Ring,
       frule Ring.qring_ring[of "S" "P"], assumption+,
       frule pj_Hom[of "S" "P"], assumption+,
       frule PolynRg.s_cf_expr[of R' "S /r P" Y g'], assumption+,
       (erule conjE)+)
apply (simp add:PolynRg.s_cf_deg[THEN sym, of R' "S /r P" Y g'],
       frule csrp_fn_pol_coeff[of P R' Y "deg_n R' (S /r P) Y g'"
                  "snd (s_cf R' (S /r P) Y g')"], assumption+,
       simp add:PolynRg.s_cf_deg[of R' "S /r P" Y g'])
apply (subst coeff_nonzero_polyn_nonzero[of "(deg_n R' (S /r P) Y g', 
             cmp (csrp_fn S P) (snd (s_cf R' (S /r P) Y g')))" 
             "deg_n R' (S /r P) Y g'"], assumption+, simp)
apply (simp add:cmp_def, rule contrapos_pp, simp+)
apply (drule_tac a = "deg_n R' (S /r P) Y g'" in forall_spec, simp,
       frule pj_csrp_mem_coeff[of P "deg_n R' (S /r P) Y g'" 
                                "snd (s_cf R' (S /r P) Y g')"],
       simp add:PolynRg.s_cf_deg[of R' "S /r P" Y g']) 
apply (drule_tac a = "deg_n R' (S /r P) Y g'" in forall_spec, simp,
       simp,
       frule pj_Hom[of S P], assumption, simp add:rHom_0_0)
done

lemma (in PolynRg) erH_inv:"⟦Idomain S; ideal S P; Ring R'; 
       PolynRg R' (S /r P) Y; g' ∈ carrier R'⟧ ⟹ 
      βˆƒg∈carrier R. deg R S X g ≀ (deg R' (S /r P) Y g') ∧
                (erH R S X R' (S /r P) Y (pj S P)) g = g'" 
apply (cut_tac subring, frule subring_Ring,
       frule Ring.qring_ring[of "S" "P"], assumption+,
       frule pj_Hom[of "S" "P"], assumption+)
apply (frule erH_rHom[of R' "S /r P" Y "pj S P"], assumption+)
apply (case_tac "g' = πŸ¬β‡˜R'⇙", simp,
       frule erH_rHom_0[of R' "S /r P" Y "pj S P"], assumption+,
       cut_tac ring_zero,
       subgoal_tac "deg R S X (𝟬) ≀ deg R' (S /r P) Y g'", blast,
       simp add:deg_def)
apply (frule PolynRg.s_cf_expr [of R' "S /r P" Y g'], assumption+,
       (erule conjE)+)
apply (frule pHom_pj_csrp[of P R' Y "fst (s_cf R' (S /r P) Y g')" 
                      "snd (s_cf R' (S /r P) Y g')"], assumption+,
       simp add:PolynRg.pol_coeff_split[THEN sym],
       drule sym, simp)
  apply (subgoal_tac "deg R S X (polyn_expr R X (fst (s_cf R' (S /r P) 
           Y g')) (fst (s_cf R' (S /r P) Y g'), cmp (csrp_fn S P) 
          (snd (s_cf R' (S /r P) Y g')))) ≀ deg R' (S /r P) Y g'",
         subgoal_tac "polyn_expr R X (fst (s_cf R' (S /r P) Y g'))
          (fst (s_cf R' (S /r P) Y g'),
           cmp (csrp_fn S P) (snd (s_cf R' (S /r P) Y g'))) ∈ carrier R",
         blast)
  apply(thin_tac " deg R S X
         (polyn_expr R X (fst (s_cf R' (S /r P) Y g'))
         (fst (s_cf R' (S /r P) Y g'),
         cmp (csrp_fn S P) (snd (s_cf R' (S /r P) Y g'))))
         ≀ deg R' (S /r P) Y g'",
     thin_tac "polyn_expr R' Y (fst (s_cf R' (S /r P) Y g')) 
         (s_cf R' (S /r P) Y g') = g'",
     thin_tac "erH R S X R' (S /r P) Y (pj S P)
         (polyn_expr R X (fst (s_cf R' (S /r P) Y g'))
         (fst (s_cf R' (S /r P) Y g'),
         cmp (csrp_fn S P) (snd (s_cf R' (S /r P) Y g')))) = g'",
     thin_tac "snd (s_cf R' (S /r P) Y g') (fst (s_cf R' (S /r P) Y g')) β‰ 
               πŸ¬β‡˜S /r P⇙")
  apply (rule_tac c = "(fst (s_cf R' (S /r P) Y g'),
         cmp (csrp_fn S P) (snd (s_cf R' (S /r P) Y g')))" and 
         k = "fst (s_cf R' (S /r P) Y g')" in polyn_mem)
  apply (rule csrp_fn_pol_coeff, assumption+,
         simp, simp,
         cut_tac pol_deg_le_n[of "polyn_expr R X (fst (s_cf R' (S /r P) Y g'))
          (fst (s_cf R' (S /r P) Y g'),
          cmp (csrp_fn S P) (snd (s_cf R' (S /r P) Y g')))"
            "(fst (s_cf R' (S /r P) Y g'),
          cmp (csrp_fn S P) (snd (s_cf R' (S /r P) Y g')))"])
 apply (simp, 
        simp add:PolynRg.s_cf_deg[THEN sym, of R' "S /r P" Y g'],
        frule ext_csrp_fn_nonzero[of P R' Y g'], assumption+,
        simp add:deg_def, simp add:ale_natle,
        rule polyn_mem, simp add:csrp_fn_pol_coeff, simp,
        simp add:csrp_fn_pol_coeff, simp)
done
 
lemma (in PolynRg) P_mod_0:"⟦Idomain S; ideal S P; PolynRg R' (S /r P) Y; 
       g ∈ carrier R⟧ ⟹
      (erH R S X R' (S /r P) Y (pj S P) g = πŸ¬β‡˜R'⇙) = (P_mod R S X P g)"
apply (cut_tac subring, frule subring_Ring,
       frule Ring.qring_ring[of "S" "P"], assumption+,
       frule pj_Hom[of "S" "P"], assumption+)
apply (case_tac "g = πŸ¬β‡˜R⇙",
       cut_tac ring_zero, simp add:P_mod_def,
       rule erH_rHom_0[of R' "S /r P" Y "pj S P"], assumption+) 
apply (frule s_cf_expr[of g], assumption+, (erule conjE)+,
       cut_tac polyn_expr_split[of "fst (s_cf R S X g)" "s_cf R S X g"])
apply (frule erH_map[of R' "S /r P" Y "pj S P" "fst (s_cf R S X g)" 
                        "snd (s_cf R S X g)"], assumption+) 
      apply (subst pol_coeff_split[THEN sym], assumption)
      apply (drule sym, simp)
      apply (thin_tac "erH R S X R' (S /r P) Y (pj S P) g =
       polyn_expr R' Y (fst (s_cf R S X g))
      (fst (s_cf R S X g), cmp (pj S P) (snd (s_cf R S X g)))")
      apply (rotate_tac -1, drule sym)
apply (subst P_mod_mod[THEN sym, of P g "s_cf R S X g"], assumption+,
       thin_tac "g = polyn_expr R X (fst (s_cf R S X g)) (s_cf R S X g)",
       frule erH_rHom_coeff[of R' "S /r P" Y "pj S P" "fst (s_cf R S X g)"
       "snd (s_cf R S X g)"], assumption+, simp)
apply (subst PolynRg.coeff_0_pol_0[THEN sym, of R' "S /r P" Y 
        "(fst (s_cf R S X g), cmp (pj S P) (snd (s_cf R S X g)))" 
        "fst (s_cf R S X g)"], assumption+, simp,
       thin_tac "pol_coeff (S /r P)
       (fst (s_cf R S X g), cmp (pj S P) (snd (s_cf R S X g)))")
apply (simp add:cmp_def)
apply (rule iffI)
 apply (rule allI, rule impI,
        drule_tac a = j in forall_spec, assumption,
        frule_tac j = j in pol_coeff_mem[of "s_cf R S X g"], assumption+,
        simp add:pj_zero[of S P])

 apply (rule allI, rule impI,
        drule_tac a = j in forall_spec, assumption,
        frule_tac j = j in pol_coeff_mem[of "s_cf R S X g"], assumption+,
        simp add:pj_zero[THEN sym, of S P])
done
            
lemma (in PolynRg) P_mod_I_J:"⟦p ∈ carrier R; ideal S I; ideal S J; 
          I βŠ† J;  P_mod R S X I p⟧ ⟹ P_mod R S X J p"
apply (case_tac "p = πŸ¬β‡˜R⇙", simp)
 apply (simp add:P_mod_def)

apply (frule s_cf_expr[of p], assumption, (erule conjE)+) 
 apply (frule P_mod_mod[THEN sym, of I p "s_cf R S X p"], assumption+) 
 apply (subst P_mod_mod[THEN sym, of J p "s_cf R S X p"], assumption+, 
        thin_tac "p = polyn_expr R X (fst (s_cf R S X p)) (s_cf R S X p)",
        simp)
 apply (rule allI, rule impI, drule_tac a = j in forall_spec, assumption,
        simp add:subsetD)
done
 
lemma (in PolynRg) P_mod_n_1:"⟦Idomain S; t ∈ carrier S; g ∈ carrier R; 
       P_mod R S X (S β™’p (t^β‡—S (Suc n)β‡–)) g⟧ ⟹ P_mod R S X (S β™’p t) g"
apply (cut_tac subring, frule subring_Ring,
       frule Ring.npClose[of S t n], assumption+,
       frule Ring.npClose[of S t "Suc n"], assumption+,
       frule Ring.principal_ideal[of S t], assumption+, 
       frule Ring.principal_ideal[of S "t^β‡—S (Suc n)β‡–"], assumption+)
apply (case_tac "g = πŸ¬β‡˜R⇙", simp add:P_mod_def)
apply (frule s_cf_expr[of g], assumption,
        (erule conjE)+,
       subst P_mod_mod[THEN sym, of "S β™’p t" "g" "s_cf R S X g"],
       assumption+) 
apply (frule_tac P_mod_mod[THEN sym, of "S β™’p (t^β‡—S (Suc n)β‡–)" g "s_cf R S X g"],
       assumption+)
apply (simp del:npow_suc,
       thin_tac "g = polyn_expr R X (fst (s_cf R S X g)) (s_cf R S X g)")
apply (rule allI, rule impI,
       drule_tac a = j in forall_spec, assumption+)
apply (simp add:Rxa_def, erule bexE, simp,
       simp add:Ring.ring_tOp_assoc[THEN sym, of S],
       frule_tac x = r and y = "t^⇗S n⇖" in Ring.ring_tOp_closed, assumption+,
       blast)
done

lemma (in PolynRg) P_mod_n_m:"⟦Idomain S; t ∈ carrier S; g ∈ carrier R; 
      m ≀ n; P_mod R S X (S β™’p (t^β‡—S (Suc n)β‡–)) g⟧ ⟹ 
               P_mod R S X (S β™’p (t^β‡—S (Suc m)β‡–)) g"
apply (cut_tac subring, frule subring_Ring)
apply (rule P_mod_I_J[of g "S β™’p (t^β‡—S (Suc n)β‡–)" "S β™’p (t^β‡—S (Suc m)β‡–)"],
       assumption)
 apply (rule Ring.principal_ideal, assumption+,
        rule Ring.npClose, assumption+)
 apply (rule Ring.principal_ideal, assumption+,
        rule Ring.npClose, assumption+)
 apply (thin_tac "P_mod R S X (S β™’p (t^β‡—S (Suc n)β‡–)) g")
 apply (rule subsetI)
   apply (simp del:npow_suc add:Rxa_def, erule bexE, simp del:npow_suc)
   apply (frule Ring.npMulDistr[THEN sym, of S t "Suc n - Suc m" "Suc m"],
          assumption)
   apply (simp del:npow_suc,
          thin_tac "t^β‡—S (Suc n)β‡– = t^β‡—S (n - m)β‡– β‹…rβ‡˜S⇙ t^β‡—S (Suc m)β‡–",
          thin_tac "x = r β‹…rβ‡˜S⇙ (t^β‡—S (n - m)β‡– β‹…rβ‡˜S⇙ t^β‡—S (Suc m)β‡–)")
   apply (subst Ring.ring_tOp_assoc[THEN sym, of S], assumption+,
          (rule Ring.npClose, assumption+)+)
   apply (frule_tac x = r and y = "t^β‡—S (n - m)β‡–" in Ring.ring_tOp_closed,
           assumption+,
          rule Ring.npClose, assumption+, blast)
   apply assumption
done

lemma (in PolynRg) P_mod_diff:"⟦Idomain S; ideal S P; PolynRg R' (S /r P) Y; 
       g ∈ carrier R; h ∈ carrier R⟧ ⟹
    (erH R S X R' (S /r P) Y (pj S P) g = (erH R S X R' (S /r P) Y (pj S P) h))
     = (P_mod R S X P (g Β± -a h))"
apply (cut_tac ring_is_ag,
       frule PolynRg.is_Ring[of R'],
       cut_tac subring,
       frule subring_Ring,
       frule Ring.qring_ring[of S P], assumption+,
       frule pj_Hom[of "S" "P"], assumption+,
       frule erH_rHom[of R' "S /r P" Y "pj S P"],
       assumption+,
       frule Ring.ring_is_ag[of R']) 
apply (frule erH_mem[of R' "S /r P" Y "pj S P" g], assumption+,
       frule erH_mem[of R' "S /r P" Y "pj S P" h], assumption+) 
apply (rule iffI)
apply (frule_tac a = "erH R S X R' (S /r P) Y (pj S P) g" and 
                 b = "erH R S X R' (S /r P) Y (pj S P) h" in 
       aGroup.ag_eq_diffzero[of R'], assumption+, simp,
       simp add:erH_minus[THEN sym, of R' "S /r P" Y "pj S P" h],
       drule sym, simp,
       thin_tac "erH R S X R' (S /r P) Y (pj S P) h =
                        erH R S X R' (S /r P) Y (pj S P) g",
       frule_tac x = h in aGroup.ag_mOp_closed, assumption+,
       simp add:erH_add[THEN sym, of  R' "S /r P" Y "pj S P" g "-a h"])
apply (subst P_mod_0[THEN sym, of P R' Y "g Β± -a h"], assumption+,
         rule aGroup.ag_pOp_closed, assumption+)

apply (frule_tac a = "erH R S X R' (S /r P) Y (pj S P) g" and 
                 b = "erH R S X R' (S /r P) Y (pj S P) h" in 
       aGroup.ag_eq_diffzero[of R'], assumption+, simp,
       simp add:erH_minus[THEN sym, of R' "S /r P" Y "pj S P" h])
   apply (subst erH_add[THEN sym, of  R' "S /r P" Y "pj S P" g "-a h"],
          assumption+,
          rule aGroup.ag_mOp_closed, assumption+)
   apply (subst P_mod_0[of P R' Y "g Β± -a h"], assumption+,
          rule aGroup.ag_pOp_closed, assumption+,
          rule aGroup.ag_mOp_closed, assumption+)
done

lemma (in PolynRg) P_mod_erH:"⟦Idomain S; ideal S P; PolynRg R' (S /r P) Y; 
        g ∈ carrier R; v ∈ carrier R; t ∈ P ⟧ ⟹
        (erH R S X R' (S /r P) Y (pj S P) g = 
                  (erH R S X R' (S /r P) Y (pj S P) (g Β± (t β‹…r v))))" 
apply (cut_tac subring, frule subring_Ring,
       cut_tac ring_is_ag,
       frule Ring.ideal_subset[of S P t], assumption+,
       frule mem_subring_mem_ring[of S t], assumption+,
       frule ring_tOp_closed[of t v], assumption+)
apply (subst P_mod_diff[of P R' Y g "g Β± (t β‹…r v)"], assumption+,
       rule aGroup.ag_pOp_closed, assumption+)
apply (simp add:aGroup.ag_p_inv,
       frule aGroup.ag_mOp_closed[of R g], assumption+,
       frule aGroup.ag_mOp_closed[of R "t β‹…r v"], assumption+,
       subst aGroup.ag_pOp_assoc[THEN sym], assumption+,
       simp add:aGroup.ag_r_inv1, simp add:aGroup.ag_l_zero)
apply (rule P_mod_minus[of P "t β‹…r v"], assumption+,
       frule P_mod_mult1[of P "carrier S" t v],
       simp add:Ring.whole_ideal, assumption+,
       subst P_mod_coeffTr[of P t], assumption+,
       rule P_mod_whole[of v], assumption+,
       simp add:Ring.idealprod_whole_r[of S P])
done

lemma (in PolynRg) coeff_principalTr:"⟦t ∈ carrier S⟧ ⟹
    βˆ€f. pol_coeff S (n, f) ∧ (βˆ€j ≀ n. f j ∈ S β™’p t) ⟢
          (βˆƒf'. pol_coeff S (n, f') ∧ (βˆ€j ≀ n. f j = t β‹…rβ‡˜S⇙ (f' j)))"
apply (cut_tac subring, frule subring_Ring,
       cut_tac ring_is_ag)
apply (induct_tac n,
       rule allI, rule impI, erule conjE, 
       simp add:Rxa_def, erule bexE,
       simp add:Ring.ring_tOp_commute[of S _ t],
       subgoal_tac "pol_coeff S (0, (Ξ»j. r))",
       subgoal_tac "t β‹…rβ‡˜S⇙ r = t β‹…rβ‡˜S⇙ ((Ξ»j. r) 0)", blast,
       simp, 
       simp add:pol_coeff_def)

apply (rule allI, rule impI, erule conjE,
       frule_tac n = n and f = f in pol_coeff_pre,
       subgoal_tac "βˆ€j ≀ n. f j ∈ S β™’p t",
       drule_tac a = f in forall_spec, simp,
       erule exE, erule conjE,
       frule_tac c = "(Suc n, f)" and j = "Suc n" in 
        pol_coeff_mem, simp, simp,
        drule_tac x = "Suc n" in spec, simp,
        simp add:Rxa_def,
        erule bexE, simp add:Ring.ring_tOp_commute[of "S" _ "t"])
  apply (subgoal_tac "pol_coeff S ((Suc n), (Ξ»j. if j ≀ n then (f' j) else r))
         ∧
        (βˆ€j ≀ (Suc n). f j = t β‹…rβ‡˜S⇙ ((Ξ»j. if j ≀ n then (f' j) else r) j))",
       blast) 
  apply (rule conjI, simp add:pol_coeff_def,
         rule allI, rule impI, 
         case_tac "j ≀ n", simp)
  apply simp
  apply (drule_tac y = j and x = n in not_le_imp_less,
         drule_tac m = n and n = j in Suc_leI)
  apply (frule_tac m = j and n = "Suc n" in le_antisym, assumption, simp,
         thin_tac "βˆ€f. pol_coeff S (n, f) ∧ (βˆ€j≀n. f j ∈ S β™’p t) ⟢
                  (βˆƒf'. pol_coeff S (n, f') ∧ (βˆ€j≀n. f j = t β‹…rβ‡˜S⇙ f' j))")
  apply (rule allI, rule impI, 
         drule_tac a = j in forall_spec, simp+)
done

lemma (in PolynRg) coeff_principal:"⟦t ∈ carrier S; pol_coeff S (n, f); 
          βˆ€j ≀ n. f j ∈ S β™’p t⟧ ⟹
          βˆƒf'. pol_coeff S (n, f') ∧ (βˆ€j ≀ n. f j = t β‹…rβ‡˜S⇙ (f' j))"
apply (simp add:coeff_principalTr)
done
 
lemma (in PolynRg) Pmod_0_principal:"⟦Idomain S; t ∈ carrier S; g ∈ carrier R;
            P_mod R S X (S β™’p t) g⟧ ⟹ βˆƒh∈ carrier R. g = t β‹…r h"
apply (cut_tac subring, frule subring_Ring)
apply (case_tac "g = πŸ¬β‡˜R⇙",
       cut_tac ring_zero,
       frule mem_subring_mem_ring[of S t], assumption+,
       frule ring_times_x_0[THEN sym, of t], blast)

apply (frule s_cf_expr[of g], assumption+,
        (erule conjE)+, frule Ring.principal_ideal[of S t], assumption,
       simp add:P_mod_mod[THEN sym, of "S β™’p t" g],
       frule coeff_principal[of t "fst (s_cf R S X g)" "snd (s_cf R S X g)"],
         simp add:pol_coeff_split[THEN sym], assumption+, 
       erule exE, erule conjE)
 apply (frule_tac c = "(fst (s_cf R S X g), f')" and k = "fst (s_cf R S X g)"
        in polyn_mem, simp,
        subgoal_tac "g = t β‹…r 
        (polyn_expr R X (fst (s_cf R S X g)) (fst (s_cf R S X g), f'))",
        blast)
 apply (subst scalar_times_pol_expr[of  t "(fst (s_cf R S X g), f')" 
           "fst (s_cf R S X g)"], assumption+, simp,
        drule sym,
        subgoal_tac "polyn_expr R X (fst (s_cf R S X g)) (s_cf R S X g) =
     polyn_expr R X (fst (s_cf R S X g)) (sp_cf S t (fst (s_cf R S X g), f'))",
        simp)
 apply (frule_tac c = "(fst (s_cf R S X g), f')" in sp_cf_pol_coeff[of _ t],
        assumption+,
        frule_tac d = "sp_cf S t (fst (s_cf R S X g), f')" in 
         pol_expr_unique2[of "s_cf R S X g"], assumption+,
        simp, simp add:sp_cf_len, simp add:sp_cf_len,
       thin_tac "(g =
           polyn_expr R X (fst (s_cf R S X g))
            (sp_cf S t (fst (s_cf R S X g), f'))) =
          (βˆ€j≀fst (s_cf R S X g).
              t β‹…rβ‡˜S⇙ f' j = snd (sp_cf S t (fst (s_cf R S X g), f')) j)",
       thin_tac "polyn_expr R X (fst (s_cf R S X g)) (s_cf R S X g) = g",
       thin_tac "polyn_expr R X (fst (s_cf R S X g)) (fst (s_cf R S X g), f')
          ∈ carrier R")
 apply (rule allI, rule impI, 
        drule_tac a = j in forall_spec, assumption+,
        simp add:sp_cf_def)
done
 
lemma (in PolynRg) Pmod0_principal_rev:"⟦Idomain S; t ∈ carrier S; 
                     g ∈ carrier R; βˆƒh∈ carrier R. g = t β‹…r  h⟧ ⟹ 
                                       P_mod R S X (S β™’p t) g"
apply (cut_tac subring, frule subring_Ring)
apply (erule bexE)
apply (case_tac "t = πŸ¬β‡˜S⇙", 
       frule Subring_zero_ring_zero, simp)
       apply (simp add:ring_times_0_x, simp add:P_mod_def)

apply (case_tac "h = πŸ¬β‡˜R⇙", simp,
       frule mem_subring_mem_ring[of S t], assumption+,
       simp add:ring_times_x_0, simp add:P_mod_def,
       cut_tac polyn_ring_integral, simp)
apply (frule_tac p = h in s_cf_expr, assumption+, (erule conjE)+,
       frule_tac c = "s_cf R S X h" and n = "fst (s_cf R S X h)" in 
       scalar_times_pol_expr[of  t], assumption+, simp,
       thin_tac "g = t β‹…r h",
       drule sym, simp)
apply (frule Ring.principal_ideal[of S t], assumption+,
       frule_tac c1 = "sp_cf S t (s_cf R S X h)" and p1 = "t β‹…r h" in 
       P_mod_mod[THEN sym],
       frule_tac x = t in mem_subring_mem_ring, assumption,
                 rule ring_tOp_closed, assumption+,
       simp add:sp_cf_pol_coeff, simp add:sp_cf_len)
apply (drule sym, simp,
       thin_tac "P_mod R S X (S β™’p t) (t β‹…r h) =
         (βˆ€j≀fst (sp_cf S t (s_cf R S X h)).
             snd (sp_cf S t (s_cf R S X h)) j ∈ S β™’p t)",
       thin_tac "polyn_expr R X (fst (s_cf R S X h)) 
                     (sp_cf S t (s_cf R S X h)) = t β‹…r h",
       thin_tac "polyn_expr R X (fst (s_cf R S X h)) (s_cf R S X h) = h")
apply (rule allI, rule impI, simp add:sp_cf_len,
       subst sp_cf_def, simp, subst Rxa_def, simp,
       frule_tac c = "s_cf R S X h" and j = j in pol_coeff_mem,
       assumption) 
apply (simp add:Ring.ring_tOp_commute[of S t], blast)
done

(** NOTE. if t β‰  0S then, deg g = deg h, because deg t = 0 **)

lemma (in PolynRg) Pmod0_principal_rev1:"⟦Idomain S; t ∈ carrier S; 
                     h ∈ carrier R⟧ ⟹ P_mod R S X (S β™’p t) (t β‹…r h)"
apply (rule Pmod0_principal_rev[of t "t β‹…r h"], assumption+)
apply (cut_tac subring,
       frule mem_subring_mem_ring[of S t], assumption+,
       simp add:ring_tOp_closed)
apply blast
done

lemma (in PolynRg) Pmod0_principal_erH_vanish_t:"⟦Idomain S; ideal S (S β™’p t);
 t ∈ carrier S; t β‰  πŸ¬β‡˜S⇙; PolynRg R' (S /r (S β™’p t)) Y ⟧ ⟹
      erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) t = πŸ¬β‡˜R'⇙"
apply (cut_tac subring, frule subring_Ring,
       frule mem_subring_mem_ring[of S t], assumption+)
 apply (subst P_mod_0[of "S β™’p t" R' Y t], assumption+)
 apply (rule Pmod0_principal_rev[of t t], assumption+)
 apply (cut_tac ring_one,
        frule ring_r_one[THEN sym, of t], blast)
done

lemma (in PolynRg) P_mod_diffxxx1:"⟦Idomain S; t ∈ carrier S; t β‰  πŸ¬β‡˜S⇙; 
        maximal_ideal S (S β™’p t); PolynRg R' (S /r (S β™’p t)) Y; 
        f ∈ carrier R; g ∈ carrier R; h ∈ carrier R;
        f β‰  𝟬; g β‰  𝟬; h β‰  𝟬; u ∈ carrier R; v ∈ carrier R;
        erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g β‰  πŸ¬β‡˜R'⇙; 
        erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) h β‰  πŸ¬β‡˜R'⇙;
        ra ∈ carrier R;
        f ± -a (g ⋅r h) = t^⇗S m⇖ ⋅r ra; 0 < m; 
        (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) u)
         β‹…rβ‡˜R'⇙ erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g Β±β‡˜R'⇙
        (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) v)
         β‹…rβ‡˜R'⇙ erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) h =
        erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) ra⟧
       ⟹ P_mod R S X (S β™’p (t^β‡—S (Suc m)β‡–))
           (f ± -a ((g ± t^⇗S m⇖ ⋅r v) ⋅r (h ± t^⇗S m⇖ ⋅r u)))"
apply (cut_tac is_Ring,
       cut_tac subring, frule subring_Ring,
       cut_tac ring_is_ag,
       frule PolynRg.is_Ring[of R' "S /r (S β™’p t)" Y],
       frule Ring.ring_is_ag[of R'],
       frule Ring.maximal_ideal_ideal[of "S" "S β™’p t"], assumption+,
       frule Ring.qring_ring[of S "S β™’p t"], assumption+, 
       frule erH_rHom[of R' "S /r (S β™’p t)" Y "pj S (S β™’p t)"], assumption+,
       frule mem_subring_mem_ring[of S t], assumption+)
apply (rule pj_Hom[of S "S β™’p t"], assumption+,
       frule pHom_rHom[of R' "S /r (S β™’p t)" Y 
        "erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t))"], assumption+)
apply (simp del:npow_suc add:rHom_tOp[THEN sym])
apply (frule_tac ring_tOp_closed[of u g], assumption,
       frule_tac ring_tOp_closed[of v h], assumption)
apply (simp del:npow_suc add:rHom_add[THEN sym])
 apply (rotate_tac 17, drule sym)
 apply (frule P_mod_diff[of "S β™’p t" R' Y ra  "u β‹…r g Β± v β‹…r h"], assumption+) 
 apply (rule aGroup.ag_pOp_closed, assumption+, simp del:npow_suc)
 apply (frule Pmod_0_principal[of t "ra Β± -a (u β‹…r g Β± v β‹…r h)"], assumption+)
 apply (rule aGroup.ag_pOp_closed, assumption+,
        rule aGroup.ag_mOp_closed, assumption,
        rule aGroup.ag_pOp_closed, assumption+, erule bexE)

apply (frule Ring.npClose[of S t m], assumption+,
       frule mem_subring_mem_ring[of S "t^⇗S m⇖"], assumption+,
       subst ring_distrib1,
       rule aGroup.ag_pOp_closed, assumption+,
       rule ring_tOp_closed, simp add:mem_subring_mem_ring,
       assumption+)
apply (rule ring_tOp_closed, assumption+)
apply (subst ring_distrib2, assumption+,
       rule ring_tOp_closed, assumption+ )
apply (frule_tac x = g and y = h in ring_tOp_closed, assumption+,
       frule_tac x = "t^⇗S m⇖" and y = v in ring_tOp_closed, assumption+,
       frule_tac x = "t^⇗S m⇖" and y = u in ring_tOp_closed, assumption+,
       frule_tac x = "t^⇗S m⇖ ⋅r v" and y = h in ring_tOp_closed, assumption+)
apply (subst ring_distrib2, assumption+,
      frule_tac x = "t^⇗S m⇖ ⋅r v" and y = "t^⇗S m⇖ ⋅r u" in ring_tOp_closed, 
      assumption+)
apply (subst aGroup.ag_p_inv, assumption+,
       rule aGroup.ag_pOp_closed, assumption+,
       rule aGroup.ag_pOp_closed, assumption+,
       rule ring_tOp_closed, assumption+)
apply (subst aGroup.ag_p_inv, assumption+,
       frule aGroup.ag_mOp_closed[of R "g β‹…r h"], assumption+,
       frule aGroup.ag_mOp_closed[of R "t^⇗S m⇖ ⋅r v ⋅r h"], assumption+)
apply (subst aGroup.ag_pOp_assoc[of R "-a (g ⋅r h)" " -a (t^⇗S m⇖ ⋅r v ⋅r h)"],
       assumption+)
apply (rule aGroup.ag_mOp_closed, assumption,
       rule aGroup.ag_pOp_closed, assumption,
       rule ring_tOp_closed, assumption+)
apply (subst aGroup.ag_pOp_assoc[THEN sym], assumption+,
       rule aGroup.ag_pOp_closed, assumption,
       rule aGroup.ag_mOp_closed, assumption+,
       rule aGroup.ag_mOp_closed, assumption+,
       rule aGroup.ag_pOp_closed, assumption+,
       rule ring_tOp_closed, assumption+, simp del:npow_suc)

apply (subst aGroup.ag_p_inv, assumption,
       rule ring_tOp_closed, assumption+,
       simp del:npow_suc add:ring_tOp_assoc[of "t^⇗S m⇖" v h],
       simp add:del:npow_suc add:ring_tOp_commute[of g "t^⇗S m⇖ ⋅r u"],
       simp del:npow_suc add:ring_tOp_assoc[of "t^⇗S m⇖" u g],
       simp del:npow_suc add:ring_inv1_2,
       subst aGroup.ag_pOp_assoc[THEN sym], assumption+,
                            rule ring_tOp_closed, assumption+)
       apply (rule aGroup.ag_pOp_closed, assumption+,
              (rule ring_tOp_closed, assumption+)+,
              rule aGroup.ag_mOp_closed, assumption+,
              (rule ring_tOp_closed, assumption+)+,
              rule aGroup.ag_mOp_closed, assumption+)
      apply (subst ring_distrib1[THEN sym, of "t^⇗S m⇖" ra  "v ⋅r (-a h)"],
             assumption+,
             rule ring_tOp_closed, assumption+, rule aGroup.ag_mOp_closed,
             assumption+)
      apply (subst aGroup.ag_pOp_assoc[THEN sym], assumption+,
             rule ring_tOp_closed, assumption+,
             rule aGroup.ag_pOp_closed, assumption+,
             rule ring_tOp_closed, assumption+, rule aGroup.ag_mOp_closed,
             assumption+)
      apply ((rule ring_tOp_closed, assumption+)+,
              rule aGroup.ag_mOp_closed, assumption+,
             (rule ring_tOp_closed, assumption+)+,
             rule aGroup.ag_mOp_closed, assumption+)
        apply (subst ring_distrib1[THEN sym, of "t^⇗S m⇖"],
               assumption+,
               rule aGroup.ag_pOp_closed, assumption+,
               rule ring_tOp_closed, assumption+,
               rule aGroup.ag_mOp_closed, assumption+,
               rule ring_tOp_closed, assumption+,
               rule aGroup.ag_mOp_closed, assumption+)
         apply (subst ring_tOp_assoc[of "t^⇗S m⇖" v], assumption+,
                rule ring_tOp_closed, assumption+,
                rule aGroup.ag_mOp_closed, assumption+)
         apply (subst ring_distrib1[THEN sym, of "t^⇗S m⇖"],
                assumption+,
                rule aGroup.ag_pOp_closed, assumption+,
                rule aGroup.ag_pOp_closed, assumption+,
                rule ring_tOp_closed, assumption,
                rule aGroup.ag_mOp_closed, assumption+,
                rule ring_tOp_closed, assumption,
                rule aGroup.ag_mOp_closed, assumption+,
                (rule ring_tOp_closed, assumption+)+,
                rule aGroup.ag_mOp_closed, assumption+)
    apply (frule ring_tOp_closed[of u g], assumption+,
           frule ring_tOp_closed[of v h], assumption+,
           simp del:npow_suc add:aGroup.ag_p_inv[of R "u β‹…r g" "v β‹…r h"],
           simp del:npow_suc add:add:ring_inv1_2,
           frule aGroup.ag_mOp_closed[of R g], assumption+,
                  frule aGroup.ag_mOp_closed[of R h], assumption+,
           frule ring_tOp_closed[of u "-a g"], assumption+,
                  frule ring_tOp_closed[of v "-a h"], assumption+,
           simp del:npow_suc add:aGroup.ag_pOp_commute[of R
                  "u β‹…r (-a g)" "v β‹…r (-a h)"],
           simp del:npow_suc add:aGroup.ag_pOp_assoc[THEN sym, 
                  of R ra "v β‹…r (-a h)" "u β‹…r (-a g)"])
  apply (subst ring_tOp_assoc[THEN sym, of v "t^⇗S m⇖" "-a u"], assumption+,
         rule aGroup.ag_mOp_closed, assumption+,
         simp only:ring_tOp_commute[of v "t^⇗S m⇖"],
         subgoal_tac "t^⇗S m⇖ ⋅r v = t ⋅r (t^⇗S (m - Suc 0)⇖ ⋅r v)", 
         simp del:npow_suc)
  apply (subst ring_tOp_assoc[of t],
         frule mem_subring_mem_ring[of S t], assumption+,
         rule ring_tOp_closed) 
   apply (frule Ring.npClose[of S t "m - Suc 0"], assumption+,
          simp add:mem_subring_mem_ring, assumption,
          rule aGroup.ag_mOp_closed, assumption+,
          subst ring_distrib1[THEN sym, of t],
          simp add:mem_subring_mem_ring, assumption+)
  apply ((rule ring_tOp_closed)+,
          frule Ring.npClose[of S t "m - Suc 0"], assumption+,
          simp add:mem_subring_mem_ring, assumption,
          rule aGroup.ag_mOp_closed, assumption+)
  apply (subst ring_tOp_assoc[THEN sym],
         frule Ring.npClose[of S t "m - Suc 0"], assumption+,
         simp add:mem_subring_mem_ring)

  apply (rule aGroup.ag_pOp_closed, assumption+,
         rule ring_tOp_closed,
         frule Ring.npClose[of S t "m - Suc 0"], assumption+,
         rule ring_tOp_closed, simp add:mem_subring_mem_ring,
         assumption, rule aGroup.ag_mOp_closed, assumption+,
         simp add:Subring_tOp_ring_tOp[THEN sym],
         simp only:npow_suc[THEN sym, of S t m]) 
  apply (rule Pmod0_principal_rev1[of "t^β‡—S (Suc m)β‡–"], assumption+,
         rule Ring.npClose, assumption+,
         rule aGroup.ag_pOp_closed, assumption+,
         (rule ring_tOp_closed)+,
         frule Ring.npClose[of S t "m - Suc 0"], assumption+,
         simp add:mem_subring_mem_ring, assumption,
         rule aGroup.ag_mOp_closed, assumption+)
  apply (frule Ring.npClose[of S t "m - Suc 0"], assumption+,
         frule mem_subring_mem_ring[of S t], assumption,
         frule mem_subring_mem_ring[of S "t^β‡—S (m - Suc 0)β‡–"], assumption,
         simp add:ring_tOp_assoc[THEN sym],
         simp add:ring_tOp_commute[of t "t^β‡—S (m - Suc 0)β‡–"],
         subgoal_tac "t^⇗S m⇖ = t^⇗S (Suc (m - Suc 0))⇖",
         simp del:Suc_pred add:Subring_tOp_ring_tOp,
         simp only:Suc_pred)
done

lemma (in PolynRg) P_mod_diffxxx2:"⟦Idomain S; t ∈ carrier S; t β‰  πŸ¬β‡˜S⇙;
   maximal_ideal S (S β™’p t); PolynRg R' (S /r (S β™’p t)) Y; 
   f ∈ carrier R; g ∈ carrier R; h ∈ carrier R;
  deg R S X g ≀ deg R' (S /r (S β™’p t)) Y 
                          (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g);
  deg R S X h + 
  deg R' (S /r (S β™’p t)) Y (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g) 
                                      ≀ deg R S X f;
  0 < deg R' (S /r (S β™’p t)) Y
        (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g);
  0 < deg R' (S /r (S β™’p t)) Y
       (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) h);
  rel_prime_pols R' (S /r (S β™’p t)) Y 
     (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g) 
        (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) h);
  P_mod R S X (S β™’p (t^β‡—S mβ‡–)) (f Β± -a (g β‹…r h)); 0 < m⟧ ⟹ 
βˆƒg1 h1. g1 ∈carrier R ∧ h1 ∈ carrier R ∧ 
     (deg R S X g1 ≀ deg R' (S /r (S β™’p t)) Y
       (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g1)) ∧ 
  P_mod R S X (S β™’p (t^β‡—S mβ‡–)) (g Β± -a g1) ∧  (deg R S X h1 + 
  deg R' (S /r (S β™’p t)) Y (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g1)
      ≀ deg R S X f) ∧
        P_mod R S X (S β™’p (t^β‡—S mβ‡–)) (h Β± -a h1) ∧ 
        P_mod R S X (S β™’p (t^β‡—S (Suc m)β‡–)) (f Β± (-a (g1 β‹…r h1)))" 
apply (cut_tac subring, frule subring_Ring,
       cut_tac ring_is_ag,
       frule Ring.residue_field_cd[of S "S β™’p t"], assumption+,
       frule Ring.maximal_ideal_ideal[of "S" "S β™’p t"], assumption+,
       frule pj_Hom[of "S" "S β™’p t"], assumption+,
       frule mem_subring_mem_ring[of S t], assumption+,
       frule Ring.qring_ring[of S "S β™’p t"], assumption+,
       frule  PolynRg.pol_nonzero[of R' "S /r (S β™’p t)" Y 
         "erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g"],
       rule erH_mem, assumption+,
       frule erH_rHom_nonzero[of R' "S /r (S β™’p t)" Y "pj S (S β™’p t)" "g"], 
       assumption+, simp add:aless_imp_le)
apply (frule PolynRg.pol_nonzero[of R' "S /r (S β™’p t)" Y 
        "erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) h"], 
       rule erH_mem, assumption+,
       frule erH_rHom_nonzero[of R' "S /r (S β™’p t)" Y "pj S (S β™’p t)" "h"], 
       assumption+, simp add:aless_imp_le, simp del:npow_suc add:aless_imp_le) 
apply (
       frule pol_nonzero[THEN sym, of "h"], simp del:npow_suc,
       frule aadd_pos_poss[of "deg R S X h" "deg R' (S /r (S β™’p t)) Y
          (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g)"], assumption+,
       frule aless_le_trans[of "0" "(deg R S X h) +
           (deg R' (S /r (S β™’p t)) Y
           (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g))"
          "deg R S X f"], assumption+,
       frule pol_nonzero[of f], simp del:npow_suc add:aless_imp_le)
 apply (thin_tac "0 < deg R S X f",
         thin_tac "0 < deg R S X h +
         deg R' (S /r (S β™’p t)) Y
          (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g)")
 apply (frule Pmod_0_principal[of "t^⇗S m⇖" "f ± -a (g ⋅r h)"],
        rule Ring.npClose, assumption+)
apply (rule aGroup.ag_pOp_closed, assumption+,
       rule aGroup.ag_mOp_closed, assumption+,
       rule ring_tOp_closed, assumption+,
       erule bexE, rename_tac ra) 

(******* deg (t^S⇧ m) ra ≀ deg f ******)
apply (frule deg_mult_pols1 [of g h], assumption+,
       frule aadd_le_mono[of "deg R S X g" "deg R' (S /r (S β™’p t)) Y
             (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g)"
              "deg R S X h"])
apply (simp only:aadd_commute[of "deg R' (S /r (S β™’p t)) Y
             (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g)"
             "deg R S X h"])
apply (frule ale_trans[of "deg R S X g + deg R S X h" "deg R S X h +
       deg R' (S /r (S β™’p t)) Y (erH R S X R' (S /r (S β™’p t)) Y 
       (pj S (S β™’p t)) g)"  "deg R S X f"], assumption+)
 apply (thin_tac "deg R S X g + deg R S X h
          ≀ deg R S X h +
            deg R' (S /r (S β™’p t)) Y
             (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g)")
 apply (frule_tac ring_tOp_closed[of g h], assumption+,
        frule deg_minus_eq1[of "g β‹…r h"],
        frule polyn_deg_add4[of "f" "-a (g β‹…r h)" "deg_n R S X f"],
        rule aGroup.ag_mOp_closed, assumption+) 
  apply (subst deg_an[THEN sym], assumption+, simp del:npow_suc)
  apply (simp add:deg_an[THEN sym], simp del:npow_suc add:deg_an[THEN sym],
         thin_tac "deg R S X (g β‹…r h) = deg R S X g + deg R S X h",
         thin_tac "deg R S X g + deg R S X h ≀ deg R S X f",
         thin_tac "deg R S X (-a (g β‹…r h)) = deg R S X g + deg R S X h")
(******* deg (t^S⇧ m) ra ≀ deg f  done *** next show deg ra ≀ deg f ***)
  apply (frule Ring.npClose[of S t m], assumption,
         frule Idomain.idom_potent_nonzero[of S t m], assumption+,
         frule_tac p = ra in const_times_polyn1[of _ "t^⇗S m⇖"], assumption+,
         simp del:npow_suc)
(******************  got deg ra ≀ deg f ***********************) 

(******  make g1 and h1 ******)
 
apply (frule_tac h = 
       "erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) ra" in 
       PolynRg.rel_prime_equation[of R' "(S /r (S β™’p t))" "Y" 
        "erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g" 
        "erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) h"], 
       assumption+,
       simp del:npow_suc add:erH_mem, simp del:npow_suc add:erH_mem, 
       assumption+,
       simp del:npow_suc add:erH_mem)
apply (erule bexE, erule bexE, (erule conjE)+,
      frule_tac erH_mem[of R' "S /r (S β™’p t)" Y
                     "pj S (S β™’p t)" "g"], assumption+,
      frule_tac erH_mem[of R' "S /r (S β™’p t)" Y
                      "pj S (S β™’p t)" "h"], assumption+)
apply (rename_tac ra u' v')
 apply (frule_tac g' = v' in erH_inv[of "S β™’p t" R' Y], assumption+,
        simp add:PolynRg.is_Ring[of R'], assumption+)
apply (frule_tac g' = u' in erH_inv[of "S β™’p t" R' Y ], assumption+,
        simp add:PolynRg.is_Ring[of R'], assumption+)
apply ((erule bexE)+, rename_tac ra u' v' v u, (erule conjE)+) 
apply (
    frule_tac p1 = u in erH_mult[THEN sym, of R' "S /r (S β™’p t)" Y 
        "pj S (S β™’p t)"  _ "g"], assumption+,
    frule_tac p1 = v in erH_mult[THEN sym, of R' "S /r (S β™’p t)" Y
        "pj S (S β™’p t)"  _ "h"], assumption+,
    thin_tac "0 < deg R' (S /r (S β™’p t)) Y
             (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g)",
    thin_tac "0 < deg R' (S /r (S β™’p t)) Y
             (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) h)",
    thin_tac "rel_prime_pols R' (S /r (S β™’p t)) Y
         (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g)
         (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) h)")
apply (subgoal_tac "g Β± (t^β‡—S mβ‡–) β‹…r v ∈ carrier R ∧
         h Β± (t^β‡—S mβ‡–) β‹…r u ∈ carrier R ∧
         deg R S X (g Β± (t^β‡—S mβ‡–) β‹…r v) ≀  deg R' (S /r (S β™’p t)) Y
                          (erH R S X R' (S /r (S β™’p t)) Y
                            (pj S (S β™’p t)) (g Β± (t^β‡—S mβ‡–) β‹…r v))  ∧
         P_mod R S X (S β™’p (t^β‡—S mβ‡–)) (g Β± -a (g Β± (t^β‡—S mβ‡–) β‹…r v)) ∧
         deg R S X (h ± (t^⇗S m⇖) ⋅r u) +  deg R' (S /r (S ♒p t)) Y
         (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) 
            (g Β± (t^β‡—S mβ‡–) β‹…r v)) ≀ deg R S X f ∧
         P_mod R S X (S β™’p (t^β‡—S mβ‡–)) ( h Β± -a (h Β± (t^β‡—S mβ‡–) β‹…r u)) ∧
         P_mod R S X (S β™’p (t^β‡—S (Suc m)β‡–))
         ( f ± -a ((g ± (t^⇗S m⇖) ⋅r v) ⋅r (h ± (t^⇗S m⇖) ⋅r u)))")
apply (thin_tac "deg R S X h +
        deg R' (S /r (S β™’p t)) Y
         (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g)
        ≀ deg R S X f",
      thin_tac "deg R' (S /r (S β™’p t)) Y u'
        ≀ amax
           (deg R' (S /r (S β™’p t)) Y
             (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) ra) -
            deg R' (S /r (S β™’p t)) Y
             (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g))
           (deg R' (S /r (S β™’p t)) Y
             (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) h))",
      thin_tac "deg R' (S /r (S β™’p t)) Y v' ≀ deg R' (S /r (S β™’p t)) Y
           (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g)",
      thin_tac "u' β‹…rβ‡˜R'⇙ erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g Β±β‡˜R'⇙
        v' β‹…rβ‡˜R'⇙ erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) h =
        erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) ra",
       thin_tac "erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g 
         ∈ carrier R'",
       thin_tac "erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) h 
          ∈ carrier R'",
       thin_tac "erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) v = v'",
       thin_tac "erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) u = u'",
       thin_tac "erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) u β‹…rβ‡˜R'⇙
        erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g =
        erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) (u β‹…r g)",
       thin_tac "erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) v β‹…rβ‡˜R'⇙
        erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) h =
        erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) (v β‹…r h)")
 apply blast

apply (frule mem_subring_mem_ring[of "S" "t^⇗S  m⇖"], assumption)
apply (rule conjI)
 apply (rule aGroup.ag_pOp_closed, assumption+,
        rule ring_tOp_closed, assumption+)
 apply (rule conjI,
        rule aGroup.ag_pOp_closed, assumption+,
        rule ring_tOp_closed, assumption+)

apply (frule Ring.a_in_principal[of "S" "t"], assumption+,
       frule Ring.maximal_ideal_ideal[of "S" "S β™’p t"], assumption+,
       frule Ring.ideal_npow_closed[of "S" "S β™’p t" "t" "m"], assumption+,
       frule PolynRg.is_Ring[of R' "S /r (S β™’p t)" Y],
       frule Ring.ring_is_ag[of R'],
       frule erH_rHom[of R' "S /r (S β™’p t)" Y "pj S (S β™’p t)"], assumption+)

apply (rule conjI)
apply (frule pHom_dec_deg[of R' "S /r (S β™’p t)" Y
      "erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t))" g], assumption+,
       frule_tac i = "deg R S X v" and j = "deg R' (S /r (S β™’p t)) Y v'" and 
        k = "deg R' (S /r (S β™’p t)) Y
          (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g)" in ale_trans,
      assumption, 
      thin_tac "deg R' (S /r (S β™’p t)) Y u' ≀ amax (deg R' (S /r (S β™’p t)) Y
            (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) ra) -
            deg R' (S /r (S β™’p t)) Y
             (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g))
           (deg R' (S /r (S β™’p t)) Y
             (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) h))",
       thin_tac "u' β‹…rβ‡˜R'⇙ erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g Β±β‡˜R'⇙
        v' β‹…rβ‡˜R'⇙ erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) h =
        erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) ra",
        thin_tac "deg R S X h +
        deg R' (S /r (S β™’p t)) Y
         (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g)
        ≀ deg R S X f")
apply (subst P_mod_erH[THEN sym, of "S ♒p t" "R'" "Y" "g" _  "t^⇗S m⇖"], 
       assumption+,
       thin_tac "deg R' (S /r (S β™’p t)) Y
                (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g)
                   ≀ deg R S X g")
apply (frule_tac p = v in const_times_polyn1[of _ "t^⇗S m⇖"], assumption+,
       frule_tac q = "(t^⇗S m⇖) ⋅r v" in polyn_deg_add4[of "g" _ 
          "deg_n R' (S /r (S β™’p t)) Y
          (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g)"])
 apply (rule ring_tOp_closed, assumption+,
        simp del:npow_suc add:PolynRg.deg_an[THEN sym],
        simp add:PolynRg.deg_an[THEN sym],
        simp add:PolynRg.deg_an[THEN sym]) 

 apply (rule conjI)
 apply (frule Ring.principal_ideal[of S "t^⇗S m⇖"], assumption+,
        frule Ring.a_in_principal[of S "t^⇗S m⇖"], assumption+)
 apply (frule_tac y = v in ring_tOp_closed[of "t^⇗S m⇖"], assumption+,
        subst aGroup.ag_p_inv, assumption+,
        frule aGroup.ag_mOp_closed[of "R" "g"], assumption+,
        frule_tac x = "(t^⇗S m⇖) ⋅r v" in aGroup.ag_mOp_closed[of "R"], 
        assumption+)
 apply (subst aGroup.ag_pOp_assoc[THEN sym], assumption+,
        subst aGroup.ag_r_inv1[of "R"], assumption+,
        subst aGroup.ag_l_zero[of "R"], assumption+,
        rule P_mod_minus, assumption+)
 apply (rule_tac g = "(t^⇗S m⇖) ⋅r v" in Pmod0_principal_rev[of  
       "t^⇗S m⇖"], assumption+)
 apply blast

apply (rule conjI)
apply (subst P_mod_erH[THEN sym, of "S ♒p t" R' Y g _ "t^⇗S m⇖"], assumption+,
       thin_tac "P_mod R S X (S ♒p (t^⇗S m⇖)) (t^⇗S m⇖ ⋅r ra)",
       thin_tac "f ± -a (g ⋅r h) = t^⇗S m⇖ ⋅r ra",
       thin_tac 
        "u' β‹…rβ‡˜R'⇙ erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g Β±β‡˜R'⇙
         v' β‹…rβ‡˜R'⇙ erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) h =
         erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) ra")
apply (case_tac "
         (deg R' (S /r (S β™’p t)) Y
          (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) ra) -
          deg R' (S /r (S β™’p t)) Y
             (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g)) ≀ 
         (deg R' (S /r (S β™’p t)) Y
             (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) h))")   
apply (simp add:amax_def)
apply (frule_tac i = "deg R S X u" and j = "deg R' (S /r (S β™’p t)) Y u'" and 
       k = "deg R' (S /r (S β™’p t)) Y
           (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) h)" in ale_trans, 
          assumption+,
       frule pHom_dec_deg[of R' "S /r (S β™’p t)" Y
          "erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t))" h], assumption+,
       frule_tac i = "deg R S X u" and j = "deg R' (S /r (S β™’p t)) Y
        (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) h)" and 
           k = "deg R S X h" in ale_trans, assumption+,
       frule_tac p = u and c = "t^⇗S m⇖" in const_times_polyn1,
             assumption+)
apply (frule_tac q = "(t^⇗S m⇖) ⋅r u" in polyn_deg_add4[of h _  "deg_n R S X h"],
       rule ring_tOp_closed, assumption+,
       subst deg_an[THEN sym], assumption+, rule ale_refl,
       subst deg_an[THEN sym], assumption+,
       simp, frule deg_an[THEN sym, of h], assumption+, simp)
 apply (frule_tac x = "deg R S X ( h ± (t^⇗S m⇖) ⋅r u)" in aadd_le_mono[of _ 
       "deg R S X h" "deg R' (S /r (S β™’p t)) Y
         (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g)"],
       rule_tac i = "deg R S X ( h ± (t^⇗S m⇖) ⋅r u) + (deg R' (S /r (S ♒p t))
         Y (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g))" in  
         ale_trans[of _ "deg R S X h + (deg R' (S /r (S β™’p t)) Y 
         (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g))" "deg R S X f"], 
         assumption+)
apply (simp add:amax_def)
apply (thin_tac "Β¬ deg R' (S /r (S β™’p t)) Y
           (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) ra) -
          deg R' (S /r (S β™’p t)) Y
           (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g)
          ≀ deg R' (S /r (S β™’p t)) Y
             (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) h)")

apply (subst aplus_le_aminus[of _ "deg R' (S /r (S β™’p t)) Y
       (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g)" "deg R S X f"])
 apply (rule deg_in_aug_minf,
        rule aGroup.ag_pOp_closed, assumption+,
        rule ring_tOp_closed, assumption+,
        rule PolynRg.deg_in_aug_minf, assumption+,
        rule deg_in_aug_minf, assumption+) 
 
 apply (subst PolynRg.deg_an, assumption+, simp add:minus_an_in_aug_minf,
        frule_tac y = u in ring_tOp_closed[of "t^⇗S m⇖"], assumption+,
        frule_tac q = "(t^⇗S m⇖) ⋅r u" in polyn_deg_add5[of h _ 
         "deg R S X f - deg R' (S /r (S β™’p t)) Y 
         (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g)"],
         assumption+,
        frule deg_in_aug_minf[of h],
        subst aplus_le_aminus[THEN sym, of "deg R S X h" 
         "deg R' (S /r (S β™’p t)) Y
         (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g)" 
        "deg R S X f"], assumption+,
        rule PolynRg.deg_in_aug_minf, assumption+,
        rule deg_in_aug_minf, assumption+,
        subst PolynRg.deg_an, assumption+,
        simp add:minus_an_in_aug_minf,
        assumption)

 apply (subst const_times_polyn1, assumption+,
        frule_tac i = "deg R S X u" and j = "deg R' (S /r (S β™’p t)) Y u'" and
         k = "deg R' (S /r (S β™’p t)) Y
              (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) ra) -
              deg R' (S /r (S β™’p t)) Y
               (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g)" in 
         ale_trans, assumption+,
        frule_tac p = ra in pHom_dec_deg[of R' "S /r (S β™’p t)" Y
         "erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t))"], assumption+,
        frule_tac i = "deg R' (S /r (S β™’p t)) Y
         (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) ra)" and 
         j = "deg R S X ra" and k = "deg R S X f" in ale_trans, assumption+,
        frule_tac a = "deg R' (S /r (S β™’p t)) Y
           (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) ra)" and 
          a' = "deg R S X f" and b = "deg R' (S /r (S β™’p t)) Y
             (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g)" in
          adiff_le_adiff,
        frule_tac i = "deg R S X u" and j = "deg R' (S /r (S β™’p t)) Y
           (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) ra) -
           deg R' (S /r (S β™’p t)) Y
           (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g)" and 
          k = "deg R S X f - deg R' (S /r (S β™’p t)) Y
           (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g)" in 
           ale_trans, assumption+)

apply (rule conjI) 
 apply (frule Ring.principal_ideal[of "S" "t^⇗S m⇖"], assumption+,
        frule Ring.a_in_principal[of "S" "t^⇗S m⇖"], assumption+,
        frule_tac y = u in ring_tOp_closed[of "t^⇗S m⇖"], assumption+,
        subst aGroup.ag_p_inv, assumption+,
        frule aGroup.ag_mOp_closed[of "R" "g"], assumption+,
        frule_tac x = "(t^⇗S m⇖) ⋅r u" in aGroup.ag_mOp_closed[of "R"], 
          assumption+,
        subst aGroup.ag_pOp_assoc[THEN sym], assumption+,
        rule aGroup.ag_mOp_closed, assumption+,
        subst aGroup.ag_r_inv1[of "R"], assumption+,
        subst aGroup.ag_l_zero[of "R"], assumption+,
        rule P_mod_minus, assumption+,
        rule_tac g = "(t^⇗S m⇖) ⋅r u" in Pmod0_principal_rev[of "t^⇗S m⇖"], 
         assumption+,
        thin_tac "deg R S X g
           ≀ deg R' (S /r (S β™’p t)) Y
              (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g)",
        thin_tac "deg R S X h + deg R' (S /r (S β™’p t)) Y
         (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g) ≀ deg R S X f",
        thin_tac "deg R' (S /r (S β™’p t)) Y u' ≀ amax
           (deg R' (S /r (S β™’p t)) Y
             (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) ra) -
            deg R' (S /r (S β™’p t)) Y
             (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g))
           (deg R' (S /r (S β™’p t)) Y
             (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) h))",
        thin_tac "deg R' (S /r (S β™’p t)) Y v' ≀ deg R' (S /r (S β™’p t)) Y
           (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g)",
        thin_tac "
        u' β‹…rβ‡˜R'⇙ erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g Β±β‡˜R'⇙
        v' β‹…rβ‡˜R'⇙ erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) h =
        erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) ra",
        thin_tac "erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) u β‹…rβ‡˜R'⇙
        erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g =
        erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) (u β‹…r g)",
        thin_tac "erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) v β‹…rβ‡˜R'⇙
        erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) h =
        erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) (v β‹…r h)")
 apply blast
apply (rule_tac u = u and v = v and ra = ra in P_mod_diffxxx1[of t R' Y f g h],
       assumption+)
apply (rotate_tac -12,
       drule sym, drule sym, simp)
done

(** Hensel_next R S X t R' Y f m gh **) 

definition
  Hensel_next :: "[('a, 'b) Ring_scheme, ('a, 'c) Ring_scheme, 'a, 'a,
 ('a set, 'm) Ring_scheme, 'a set,'a, nat] β‡’ ('a Γ— 'a) β‡’ ('a Γ— 'a)"
     (β€Ή(9Henβ‡˜ _ _ _ _ _ _ _⇙ _ _)β€Ί  [67,67,67,67,67,67,67,68]67) where

 "Henβ‡˜R S X t R' Y f ⇙ m gh = (SOME gh1. 
      gh1 ∈ carrier R Γ— carrier R ∧
      (deg R S X (fst gh1) ≀ deg R' (S /r (S β™’p t)) Y
      (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) (fst gh1))) ∧ 
  P_mod R S X (S β™’p (t^β‡—S mβ‡–)) ((fst gh) Β±β‡˜R⇙ -aβ‡˜R⇙ (fst gh1)) ∧ 
  (deg R S X (snd gh1) + deg R' (S /r (S β™’p t)) Y (erH R S X R' 
      (S /r (S β™’p  t)) Y (pj S (S β™’p  t)) (fst gh1)) ≀ deg R S X f) ∧
  P_mod R S X (S β™’p (t^β‡—S mβ‡–)) ((snd gh) Β±β‡˜R⇙ -aβ‡˜R⇙ (snd gh1)) ∧ 
  P_mod R S X (S β™’p (t^β‡—S (Suc m)β‡–)) (f Β±β‡˜R⇙ (-aβ‡˜R⇙ ((fst gh1) β‹…rβ‡˜R⇙ (snd gh1)))))"

lemma  cart_prod_fst:"x ∈ A Γ— B ⟹ fst x ∈ A" 
by auto

lemma  cart_prod_snd:"x ∈ A Γ— B ⟹ snd x ∈ B"
by auto

lemma cart_prod_split:"((x,y) ∈ A Γ— B) = (x ∈ A ∧ y ∈ B)"
by auto

lemma (in PolynRg) P_mod_diffxxx3:"⟦Idomain S; t ∈ carrier S; t β‰  πŸ¬β‡˜S⇙; 
   maximal_ideal S (S β™’p t); PolynRg R' (S /r (S β™’p t)) Y; 
   f ∈ carrier R; gh ∈ carrier R Γ— carrier R;
   deg R S X (fst gh) ≀ deg R' (S /r (S β™’p t)) Y (erH R S X R' 
                            (S /r (S β™’p t)) Y (pj S (S β™’p t)) (fst gh));  
   deg R S X (snd gh) + deg R' (S /r (S β™’p t)) Y (erH R S X R' 
         (S /r (S β™’p t)) Y (pj S (S β™’p t)) (fst gh)) ≀ deg R S X f;
  0 < deg R' (S /r (S β™’p t)) Y (erH R S X R' (S /r (S β™’p t)) Y 
                                           (pj S (S β™’p t)) (fst gh));
  0 < deg R' (S /r (S β™’p t)) Y
       (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) (snd gh));
  rel_prime_pols R' (S /r (S β™’p t)) Y 
    (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) (fst gh)) 
    (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) (snd gh));
  P_mod R S X (S β™’p (t^β‡—S mβ‡–)) (f Β± -a ((fst gh) β‹…r (snd gh))); 0 < m⟧ ⟹ 
  βˆƒgh1. gh1 ∈carrier R Γ— carrier R ∧ 
       (deg R S X (fst gh1) ≀ deg R' (S /r (S β™’p t)) Y
           (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) (fst gh1))) ∧ 
   P_mod R S X (S β™’p (t^β‡—S mβ‡–)) ((fst gh) Β± -a (fst gh1)) ∧ 
       (deg R S X (snd gh1) + deg R' (S /r (S β™’p t)) Y 
           (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) (fst gh1)) ≀ 
                                                              deg R S X f) ∧
        P_mod R S X (S β™’p (t^β‡—S mβ‡–)) ((snd gh) Β± -a (snd gh1)) ∧ 
        P_mod R S X (S β™’p (t^β‡—S (Suc m)β‡–)) (f Β± (-a ((fst gh1) β‹…r (snd gh1))))"
apply (cases gh)
apply (simp del: npow_suc)
apply (rename_tac g h)
apply (erule conjE,
        frule_tac g = g and h = h and f = f in P_mod_diffxxx2[of t R' Y],
        assumption+)
apply blast
done

lemma (in PolynRg) P_mod_diffxxx4:"⟦Idomain S; t ∈ carrier S; t β‰  πŸ¬β‡˜S⇙; 
      maximal_ideal S (S β™’p t); PolynRg R' (S /r (S β™’p t)) Y; f ∈ carrier R; 
      gh ∈ carrier R Γ— carrier R;
      deg R S X (fst gh) ≀ deg R' (S /r (S β™’p t)) Y
            (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) (fst gh));  
   deg R S X (snd gh) + deg R' (S /r (S β™’p t)) Y (erH R S X R' 
                (S /r (S β™’p t)) Y (pj S (S β™’p t)) (fst gh)) ≀ deg R S X f;
  0 < deg R' (S /r (S β™’p t)) Y
        (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) (fst gh));
  0 < deg R' (S /r (S β™’p t)) Y
        (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) (snd gh));
  rel_prime_pols R' (S /r (S β™’p t)) Y 
    (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) (fst gh)) 
    (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) (snd gh));
  P_mod R S X (S β™’p (t^β‡—S mβ‡–)) (f Β± -a ((fst gh) β‹…r (snd gh))); 0 < m⟧ ⟹ 
  (Henβ‡˜R S X t R' Y f ⇙ m gh) ∈ carrier R Γ— carrier R  ∧ (deg R S X
     (fst (Henβ‡˜R S X t R' Y f ⇙ m gh)) ≀ deg R' (S /r (S β™’p t)) Y
          (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) 
                                   (fst (Henβ‡˜R S X t R' Y f ⇙ m gh)))) ∧ 
  P_mod R S X (S β™’p (t^β‡—S mβ‡–)) ((fst gh) Β± -a (fst (Henβ‡˜R S X t R' Y f ⇙ m gh))) ∧ 
  (deg R S X (snd (Henβ‡˜R S X t R' Y f ⇙ m gh)) + deg R' (S /r (S β™’p t)) Y 
   (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) 
        (fst (Henβ‡˜R S X t R' Y f ⇙ m gh))) ≀  deg R S X f) ∧
  P_mod R S X (S β™’p (t^β‡—S mβ‡–)) ((snd gh) Β± -a (snd (Henβ‡˜R S X t R' Y f ⇙ m gh))) ∧ 
    P_mod R S X (S β™’p (t^β‡—S (Suc m)β‡–)) (f Β± (-a ((fst (Henβ‡˜R S X t R' Y f ⇙ m gh)) β‹…r 
             (snd (Henβ‡˜R S X t R' Y f ⇙ m gh)))))" 
apply (unfold Hensel_next_def)
apply (rule someI2_ex)
apply (rule P_mod_diffxxx3, assumption+)
done

(* Hensel_pair R S X t R' Y f g h m *)

primrec
  Hensel_pair :: "[('a, 'b) Ring_scheme, ('a, 'c) Ring_scheme, 'a, 'a,
    ('a set, 'm) Ring_scheme, 'a set, 'a, 'a, 'a, nat] β‡’ ('a Γ— 'a)"
      (β€Ή(10Hprβ‡˜ _ _ _ _ _ _ _ _ _⇙ _)β€Ί  [67,67,67,67,67,67,67,67,67,68]67)
where
  Hpr_0: "Hprβ‡˜R S X t R' Y f g h⇙ 0 = (g, h)"
| Hpr_Suc: "Hprβ‡˜R S X t R' Y f g h⇙ (Suc m) = 
            Henβ‡˜R S X t R' Y f ⇙ (Suc m) (Hprβ‡˜R S X t R' Y f g h⇙ m)" 

lemma (in PolynRg) fst_xxx:" ⟦t ∈ carrier S; t β‰  πŸ¬β‡˜S⇙; ideal S (S β™’p t);  
   βˆ€(n::nat). (F n) ∈ carrier R Γ— carrier R; 
   βˆ€m. P_mod R S X (S β™’p t) (fst (F m) Β± -a (fst (F (Suc m))))⟧ ⟹
       P_mod R S X (S β™’p t) (fst (F 0) Β± -a (fst (F n)))"
apply (cut_tac subring, frule subring_Ring,
       cut_tac ring_is_ag) 
apply (induct_tac n)
apply (drule_tac x = 0 in spec)
 apply (frule cart_prod_fst[of "F 0" "carrier R" "carrier R"])
apply (simp add:aGroup.ag_r_inv1) apply (simp add:P_mod_def)

apply (frule_tac x = 0 in spec,
       frule_tac x = n in spec,
       drule_tac x = "Suc n" in spec) 
        
 apply (frule_tac x = "F 0" in cart_prod_fst[of _ "carrier R" "carrier R"],
        frule_tac x = "F n" in cart_prod_fst[of _ "carrier R" "carrier R"],
        frule_tac x = "F (Suc n)" in cart_prod_fst[of _ "carrier R" 
                                                             "carrier R"])
apply (drule_tac x = n in spec)
apply (frule_tac p = "fst (F 0) Β± -a (fst (F n))" and 
                 q = "fst (F n) Β± -a (fst (F (Suc n)))" in 
       P_mod_add[of  "S β™’p t"])
apply (rule aGroup.ag_pOp_closed, assumption+, rule aGroup.ag_mOp_closed, 
       assumption+)+
apply (frule_tac x = "fst (F n)" in aGroup.ag_mOp_closed, assumption+,
       frule_tac x = "fst (F (Suc n))" in aGroup.ag_mOp_closed, assumption+)
apply (simp add:aGroup.pOp_assocTr41[of "R", THEN sym],
       simp add:aGroup.pOp_assocTr42[of "R"],
       simp add:aGroup.ag_l_inv1,
       simp add:aGroup.ag_r_zero)
done

lemma (in PolynRg) snd_xxx:"⟦t ∈ carrier S; t β‰  πŸ¬β‡˜S⇙;
   ideal S (S β™’p t);  βˆ€(n::nat). (F n) ∈ carrier R Γ— carrier R; 
  βˆ€m. P_mod R S X (S β™’p t) (snd (F m) Β± -a (snd (F (Suc m))))⟧ ⟹
   P_mod R S X (S β™’p t) (snd (F 0) Β± -a (snd (F n)))" 
apply (cut_tac subring, frule subring_Ring,
       cut_tac ring_is_ag) 
apply (induct_tac n)
apply (drule_tac x = 0 in spec)
 apply (frule cart_prod_snd[of "F 0" "carrier R" "carrier R"])
apply (simp add:aGroup.ag_r_inv1) apply (simp add:P_mod_def)

apply (frule_tac x = 0 in spec,
       frule_tac x = n in spec,
       drule_tac x = "Suc n" in spec) 
        
 apply (frule_tac x = "F 0" in cart_prod_snd[of _ "carrier R" "carrier R"],
        frule_tac x = "F n" in cart_prod_snd[of _ "carrier R" "carrier R"],
        frule_tac x = "F (Suc n)" in cart_prod_snd[of _ "carrier R" 
                                                             "carrier R"])
apply (drule_tac x = n in spec)
apply (frule_tac p = "snd (F 0) Β± -a (snd (F n))" and 
                 q = "snd (F n) Β± -a (snd (F (Suc n)))" in 
       P_mod_add[of  "S β™’p t"])
apply (rule aGroup.ag_pOp_closed, assumption+, rule aGroup.ag_mOp_closed, 
       assumption+)+
apply (frule_tac x = "snd (F n)" in aGroup.ag_mOp_closed, assumption+,
       frule_tac x = "snd (F (Suc n))" in aGroup.ag_mOp_closed, assumption+)
apply (simp add:aGroup.pOp_assocTr41[of "R", THEN sym],
       simp add:aGroup.pOp_assocTr42[of "R"],
       simp add:aGroup.ag_l_inv1,
       simp add:aGroup.ag_r_zero)
done

lemma (in PolynRg) P_mod_diffxxx5:"⟦Idomain S; t ∈ carrier S; t β‰  πŸ¬β‡˜S⇙; 
      maximal_ideal S (S β™’p t); PolynRg R' (S /r (S β™’p t)) Y; 
      f ∈ carrier R; (g, h) ∈ carrier R Γ— carrier R;
     deg R S X (fst (g, h)) ≀ deg R' (S /r (S β™’p t)) Y
       (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) (fst (g, h)));  
  deg R S X (snd (g, h)) + deg R' (S /r (S β™’p t)) Y 
  (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) (fst (g, h))) ≀ deg R S X f;
  0 < deg R' (S /r (S β™’p t)) Y (erH R S X R' (S /r (S β™’p t)) Y 
                                        (pj S (S β™’p t)) (fst (g, h)));
  0 < deg R' (S /r (S β™’p t)) Y (erH R S X R' (S /r (S β™’p t)) Y 
                                         (pj S (S β™’p t)) (snd (g, h)));
  rel_prime_pols R' (S /r (S β™’p t)) Y 
    (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) (fst (g, h))) 
    (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) (snd (g, h)));
     P_mod R S X (S β™’p t) (f Β± -a (g β‹…r h))⟧ ⟹ 
  (Hprβ‡˜R S X t R' Y f g h⇙ (Suc m)) ∈ carrier R Γ— carrier R  ∧
   erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) 
                       (fst (Hprβ‡˜R S X t R' Y f g h⇙ (Suc m))) =  
            erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) (fst (g, h)) ∧
   erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) 
                       (snd (Hprβ‡˜R S X t R' Y f g h⇙ (Suc m))) =  
            erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) (snd (g, h)) ∧
     (deg R S X (fst (Hprβ‡˜R S X t R' Y f g h⇙ (Suc m))) ≀ deg R' (S /r (S β™’p t)) Y 
         (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) 
                                     (fst (Hprβ‡˜R S X t R' Y f g h⇙ (Suc m))))) ∧ 
  P_mod R S X (S β™’p (t^β‡—S (Suc m)β‡–)) ((fst (Hprβ‡˜R S X t R' Y f g h⇙ m)) Β± -a 
                             (fst (Hprβ‡˜R S X t R' Y f g h⇙ (Suc m)))) ∧ 
(deg R S X (snd (Hprβ‡˜R S X t R' Y f g h⇙ (Suc m))) + deg R' (S /r (S β™’p t)) Y 
   (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) (fst (Hprβ‡˜R S X t R' Y f g h⇙ (Suc m)))) ≀  deg R S X f) ∧
P_mod R S X (S β™’p (t^β‡—S (Suc m)β‡–)) ((snd (Hprβ‡˜R S X t R' Y f g h⇙ m)) Β± -a (snd (Hprβ‡˜R S X t R' Y f g h⇙ (Suc m)))) ∧ 
 P_mod R S X (S β™’p (t^β‡—S (Suc (Suc m))β‡–)) (f Β± -a ((fst (Hprβ‡˜R S X t R' Y f g h⇙ (Suc m))) β‹…r (snd (Hprβ‡˜R S X t R' Y f g h⇙ (Suc m)))))"
apply (cut_tac subring, frule subring_Ring,
       cut_tac ring_is_ag,
       frule mem_subring_mem_ring[of S t], assumption+,
       frule Ring.maximal_ideal_ideal[of S "S β™’p t"], assumption+)
apply (induct_tac m)
 apply (simp del:Hpr_0 npow_suc)
 apply (simp only:Hpr_0)
 apply (frule P_mod_diffxxx4[of t R' Y f "(g, h)" "Suc 0"],
           assumption+)
 apply (simp add:cart_prod_split, simp+)
 apply (simp add:Ring.ring_l_one, simp)  
 apply (simp add:Ring.ring_l_one, (erule conjE)+) 
 apply (frule P_mod_diff[THEN sym, of "S β™’p t" R' Y g 
                      "fst (Henβ‡˜ R S X t R' Y f⇙ (Suc 0) (g, h))"], assumption+,
        simp add:cart_prod_fst, rotate_tac -1, drule sym, simp)
 apply (frule P_mod_diff[THEN sym, of "S β™’p t" R' Y h 
                      "snd (Henβ‡˜ R S X t R' Y f⇙ (Suc 0) (g, h))"], assumption+,
        simp add:cart_prod_snd, rotate_tac -1, drule sym, simp) 

apply ((erule conjE)+, rename_tac m)
apply (frule_tac m = "Suc (Suc m)" and gh = "Hprβ‡˜ R S X t R' Y f g h⇙ (Suc m)" in 
       P_mod_diffxxx4[of t R' Y f], assumption+)
apply (simp, simp, simp, simp del:npow_suc, simp)
apply (erule conjE)+
apply (simp del:npow_suc del:Hpr_Suc 
                add:Hpr_Suc[THEN sym, of R S X t R' Y f _ g h])
apply (thin_tac "deg R S X g
         ≀ deg R' (S /r (S β™’p t)) Y
            (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g)",
       thin_tac "deg R S X h +
         deg R' (S /r (S β™’p t)) Y
          (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g)
         ≀ deg R S X f",
       thin_tac "0 < deg R' (S /r (S β™’p t)) Y
              (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g)",
       thin_tac "0 < deg R' (S /r (S β™’p t)) Y
              (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) h)",
       thin_tac "rel_prime_pols R' (S /r (S β™’p t)) Y
          (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g)
          (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) h)",
       thin_tac "deg R S X (fst (Hprβ‡˜ R S X t R' Y f g h⇙ Suc m))
         ≀ deg R' (S /r (S β™’p t)) Y
            (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g)",
       thin_tac "deg R S X (snd (Hprβ‡˜ R S X t R' Y f g h⇙ Suc m)) +
         deg R' (S /r (S β™’p t)) Y
          (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g)
         ≀ deg R S X f",
       thin_tac "deg R S X (fst (Hprβ‡˜ R S X t R' Y f g h⇙ Suc (Suc m)))
         ≀ deg R' (S /r (S β™’p t)) Y
            (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t))
              (fst (Hprβ‡˜ R S X t R' Y f g h⇙ Suc (Suc m))))",
       thin_tac "deg R S X (snd (Hprβ‡˜ R S X t R' Y f g h⇙ Suc (Suc m))) +
         deg R' (S /r (S β™’p t)) Y
          (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t))
            (fst (Hprβ‡˜ R S X t R' Y f g h⇙ Suc (Suc m))))
         ≀ deg R S X f")
apply (frule_tac g = "fst (Hprβ‡˜ R S X t R' Y f g h⇙ (Suc m)) Β± -a (fst
       (Hprβ‡˜ R S X t R' Y f g h⇙ (Suc (Suc m))))" and n = "Suc m" in P_mod_n_1
       [of t], assumption+,
       (rule aGroup.ag_pOp_closed, assumption+, simp add:cart_prod_fst,
       rule aGroup.ag_mOp_closed, assumption+, simp add:cart_prod_fst,
       assumption),
       (frule_tac x = "Hprβ‡˜ R S X t R' Y f g h⇙ Suc m" in cart_prod_fst[of _ 
       "carrier R" "carrier R"],
       frule_tac x = "Hprβ‡˜ R S X t R' Y f g h⇙ (Suc (Suc m))" in cart_prod_fst[of _ 
       "carrier R" "carrier R"]),
       (frule_tac g1 = "fst (Hprβ‡˜ R S X t R' Y f g h⇙ (Suc m))" and 
       h1 = "fst (Hprβ‡˜ R S X t R' Y f g h⇙ (Suc (Suc m)))" in 
       P_mod_diff[THEN sym, of "S β™’p t" R' Y], assumption+))
apply (frule_tac g = "snd (Hprβ‡˜ R S X t R' Y f g h⇙ (Suc m)) Β± -a (snd
       (Hprβ‡˜ R S X t R' Y f g h⇙ (Suc (Suc m))))" and n = "Suc m" in P_mod_n_1
       [of t], assumption+,
       (rule aGroup.ag_pOp_closed, assumption+, simp add:cart_prod_snd,
       rule aGroup.ag_mOp_closed, assumption+, simp add:cart_prod_snd,
       assumption),
       (frule_tac x = "Hprβ‡˜ R S X t R' Y f g h⇙ Suc m" in cart_prod_snd[of _ 
       "carrier R" "carrier R"],
       frule_tac x = "Hprβ‡˜ R S X t R' Y f g h⇙ (Suc (Suc m))" in cart_prod_snd[of _ 
       "carrier R" "carrier R"]),
       (frule_tac g1 = "snd (Hprβ‡˜ R S X t R' Y f g h⇙ (Suc m))" and 
       h1 = "snd (Hprβ‡˜ R S X t R' Y f g h⇙ (Suc (Suc m)))" in 
       P_mod_diff[THEN sym, of "S β™’p t" R' Y], assumption+))
apply simp
done

(*** Hensel_pair basic ***)
lemma (in PolynRg) P_mod_diffxxx5_1:"⟦Idomain S; t ∈ carrier S; t β‰  πŸ¬β‡˜S⇙; 
  maximal_ideal S (S β™’p t); PolynRg R' (S /r (S β™’p t)) Y; 
  f ∈ carrier R; g ∈ carrier R; h ∈ carrier R;
  deg R S X g ≀ deg R' (S /r (S β™’p t)) Y
             (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g);
  deg R S X h + deg R' (S /r (S β™’p t)) Y (erH R S X R' 
                     (S /r (S β™’p t)) Y (pj S (S β™’p t)) g) ≀ deg R S X f;
  0 < deg R' (S /r (S β™’p t)) Y
                (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g);
  0 < deg R' (S /r (S β™’p t)) Y
                (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) h);
  rel_prime_pols R' (S /r (S β™’p t)) Y 
    (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g) 
    (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) h);
  P_mod R S X (S β™’p t) (f Β± -a (g β‹…r h))⟧ ⟹ 
 (Hprβ‡˜R S X t R' Y f g h⇙ (Suc m)) ∈ carrier R Γ— carrier R  ∧
 erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) 
     (fst (Hprβ‡˜R S X t R' Y f g h⇙ (Suc m))) = 
           erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) (fst (g, h)) ∧
 erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) 
     (snd (Hprβ‡˜R S X t R' Y f g h⇙ (Suc m))) =  
           erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) (snd (g, h)) ∧
     (deg R S X (fst (Hprβ‡˜R S X t R' Y f g h⇙ (Suc m))) ≀ deg R' 
  (S /r (S β™’p t)) Y (erH R S X R' (S /r (S β™’p t)) Y  
                    (pj S (S β™’p t)) (fst (Hprβ‡˜R S X t R' Y f g h⇙ (Suc m))))) ∧ 
 P_mod R S X (S β™’p (t^β‡—S (Suc m)β‡–)) ((fst (Hprβ‡˜R S X t R' Y f g h⇙ m)) Β± -a 
                                      (fst (Hprβ‡˜R S X t R' Y f g h⇙ (Suc m)))) ∧ 
 (deg R S X (snd (Hprβ‡˜R S X t R' Y f g h⇙ (Suc m))) + 
   deg R' (S /r (S β™’p t)) Y (erH R S X R' (S /r (S β™’p t)) Y 
     (pj S (S β™’p t)) (fst (Hprβ‡˜R S X t R' Y f g h⇙ (Suc m)))) ≀  deg R S X f) ∧
 P_mod R S X (S β™’p (t^β‡—S (Suc m)β‡–)) ((snd (Hprβ‡˜R S X t R' Y f g h⇙ m)) Β± -a 
                                      (snd (Hprβ‡˜R S X t R' Y f g h⇙ (Suc m)))) ∧ 
 P_mod R S X (S β™’p (t^β‡—S (Suc (Suc m))β‡–)) (f Β± -a 
  ((fst (Hprβ‡˜R S X t R' Y f g h⇙ (Suc m))) β‹…r (snd (Hprβ‡˜R S X t R' Y f g h⇙ (Suc m)))))"
apply (frule P_mod_diffxxx5[of t R' Y f g h m], assumption+)
apply (simp add:cart_prod_split, simp, simp, simp, simp, simp, assumption+)
done

(*** Hpr sequence of polynomial pair ***)
lemma (in PolynRg) P_mod_diffxxx5_2:"⟦Idomain S; t ∈ carrier S; t β‰  πŸ¬β‡˜S⇙; 
  maximal_ideal S (S β™’p t); PolynRg R' (S /r (S β™’p t)) Y; f ∈ carrier R; 
  g ∈ carrier R; h ∈ carrier R;
  deg R S X g ≀ deg R' (S /r (S β™’p t)) Y
               (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g);  
  deg R S X h + deg R' (S /r (S β™’p t)) Y (erH R S X R' 
                      (S /r (S β™’p t)) Y (pj S (S β™’p t)) g) ≀ deg R S X f;
  0 < deg R' (S /r (S β™’p t)) Y 
      (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g);
  0 < deg R' (S /r (S β™’p t)) Y
      (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) h);
  rel_prime_pols R' (S /r (S β™’p t)) Y 
    (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g) 
    (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) h);
  P_mod R S X (S β™’p t) (f Β± -a (g β‹…r h))⟧ ⟹ 
                (Hprβ‡˜R S X t R' Y f g h⇙ m) ∈ carrier R Γ— carrier R"
apply (case_tac "m = 0", simp, simp) 
apply (frule P_mod_diffxxx5_1[of t R' Y f g h 
       "m - Suc 0"], assumption+) apply (erule conjE)+
apply simp
done

(*** Cauchy 1***)
lemma (in PolynRg) P_mod_diffxxx5_3:"⟦Idomain S; t ∈ carrier S; t β‰  πŸ¬β‡˜S⇙; 
  maximal_ideal S (S β™’p t); PolynRg R' (S /r (S β™’p t)) Y; f ∈ carrier R; 
  g ∈ carrier R; h ∈ carrier R;
  deg R S X g ≀ deg R' (S /r (S β™’p t)) Y
      (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g);  
  deg R S X h + deg R' (S /r (S β™’p t)) Y (erH R S X R' 
                (S /r (S β™’p t)) Y (pj S (S β™’p t)) g) ≀ deg R S X f;
  0 < deg R' (S /r (S β™’p t)) Y
              (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g);
  0 < deg R' (S /r (S β™’p t)) Y
              (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) h);
  rel_prime_pols R' (S /r (S β™’p t)) Y 
    (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g) 
    (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) h);
  P_mod R S X (S β™’p t) (f Β± -a (g β‹…r h))⟧ ⟹ 
  P_mod R S X (S β™’p (t^β‡—S mβ‡–)) ((fst (Hprβ‡˜R S X t R' Y f g h⇙ m)) Β±
                                -a (fst (Hprβ‡˜R S X t R' Y f g h⇙ (m + n)))) ∧
  P_mod R S X (S β™’p (t^β‡—S mβ‡–)) ((snd (Hprβ‡˜R S X t R' Y f g h⇙ m)) Β±
                                -a (snd (Hprβ‡˜R S X t R' Y f g h⇙ (m + n))))"
apply (cut_tac ring_is_ag,
       cut_tac subring, frule subring_Ring)
apply (induct_tac n)
 apply (simp del:npow_suc Hpr_Suc) 
 apply (frule P_mod_diffxxx5_2[of t R' Y f g h m], assumption+)
 apply (frule cart_prod_fst[of "Hprβ‡˜ R S X t R' Y f g h⇙ m" "carrier R" "carrier R"],
        frule cart_prod_snd[of "Hprβ‡˜ R S X t R' Y f g h⇙ m" "carrier R" "carrier R"])
 apply (simp add:aGroup.ag_r_inv1, simp add:P_mod_def)

 apply (frule_tac m = "m + n" in P_mod_diffxxx5_1[of t R' Y f g h], 
        assumption+, (erule conjE)+)
apply (frule_tac m = m in P_mod_diffxxx5_2[of t R' Y f g h], assumption+)
apply (frule_tac m = "m + n" in P_mod_diffxxx5_2[of t R' Y f g h], assumption+)
apply (thin_tac "deg R S X g
           ≀ deg R' (S /r (S β™’p t)) Y
              (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g)",
       thin_tac "deg R S X h + deg R' (S /r (S β™’p t)) Y
          (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g) ≀ deg R S X f",
       thin_tac "0 < deg R' (S /r (S β™’p t)) Y
              (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g)",
       thin_tac "0 < deg R' (S /r (S β™’p t)) Y
              (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) h)",
       thin_tac "rel_prime_pols R' (S /r (S β™’p t)) Y
          (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g)
          (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) h)",
       thin_tac "P_mod R S X (S β™’p t) ( f Β± -a (g β‹…r h))",
       thin_tac "erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t))
                            (fst (Hprβ‡˜ R S X t R' Y f g h⇙ Suc (m + n))) =
         erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) (fst (g, h))",
       thin_tac "erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t))
                 (snd (Hprβ‡˜ R S X t R' Y f g h⇙ Suc (m + n))) =
                  erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t))
          (snd (g, h))",
       thin_tac "deg R S X (fst (Hprβ‡˜ R S X t R' Y f g h⇙ Suc (m + n)))
          ≀ deg R' (S /r (S β™’p t)) Y
            (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t))
                      (fst (Hprβ‡˜ R S X t R' Y f g h⇙ Suc (m + n))))",
      thin_tac "deg R S X (snd (Hprβ‡˜ R S X t R' Y f g h⇙ Suc (m + n))) +
      deg R' (S /r (S β™’p t)) Y (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t))
           (fst (Hprβ‡˜ R S X t R' Y f g h⇙ Suc (m + n)))) ≀ deg R S X f",
      thin_tac "P_mod R S X (S β™’p (t^β‡—S (Suc (Suc (m + n)))β‡–))
          (f Β±  -a (fst (Hprβ‡˜ R S X t R' Y f g h⇙ Suc (m + n)) β‹…r
                      snd (Hprβ‡˜ R S X t R' Y f g h⇙ Suc (m + n))))")
apply (simp del:npow_suc Hpr_Suc)
apply (frule_tac x = "Hprβ‡˜ R S X t R' Y f g h⇙ m" in 
          cart_prod_fst[of _ "carrier R" "carrier R"],
       frule_tac x = "Hprβ‡˜ R S X t R' Y f g h⇙ (m + n)" in 
          cart_prod_fst[of _ "carrier R" "carrier R"],
       frule_tac x = "Hprβ‡˜ R S X t R' Y f g h⇙ (Suc (m + n))" in 
          cart_prod_fst[of _ "carrier R" "carrier R"],
       frule_tac x = "Hprβ‡˜ R S X t R' Y f g h⇙ m" in 
          cart_prod_snd[of _ "carrier R" "carrier R"],
       frule_tac x = "Hprβ‡˜ R S X t R' Y f g h⇙ (m + n)" in 
          cart_prod_snd[of _ "carrier R" "carrier R"],
       frule_tac x = "Hprβ‡˜ R S X t R' Y f g h⇙ (Suc (m + n))" in 
          cart_prod_snd[of _ "carrier R" "carrier R"])
apply (case_tac "m = 0", simp del:npow_suc Hpr_Suc)
 apply (simp only:Ring.Rxa_one)
apply (rule conjI)
apply (rule_tac p = "g Β± -a (fst (Hprβ‡˜ R S X t R' Y f g h⇙ (Suc n)))" in
       P_mod_whole,
       rule aGroup.ag_pOp_closed, assumption+,
       rule aGroup.ag_mOp_closed, assumption+)
apply (rule_tac p = "h Β± -a (snd (Hprβ‡˜ R S X t R' Y f g h⇙ (Suc n)))" in
       P_mod_whole,
       rule aGroup.ag_pOp_closed, assumption+,
       rule aGroup.ag_mOp_closed, assumption+)
apply (frule_tac g = "fst (Hprβ‡˜ R S X t R' Y f g h⇙ (m + n)) Β± 
     -a (fst (Hprβ‡˜ R S X t R' Y f g h⇙ Suc (m + n)))" and n = "m + n" in 
     P_mod_n_m[of t _ "m - Suc 0"], assumption+)
apply (rule aGroup.ag_pOp_closed, assumption+, rule aGroup.ag_mOp_closed, 
       assumption+,
       arith,
       simp del:npow_suc Hpr_Suc, simp del:npow_suc Hpr_Suc)
apply (frule Ring.npClose[of S t m], assumption,
       frule Ring.principal_ideal[of S "t^⇗S m⇖"], assumption)
apply (frule_tac p = "fst (Hprβ‡˜ R S X t R' Y f g h⇙ m) Β±
           -a (fst (Hprβ‡˜ R S X t R' Y f g h⇙ (m + n)))" and 
       q = "fst (Hprβ‡˜ R S X t R' Y f g h⇙ (m + n)) Β±
           -a (fst (Hprβ‡˜ R S X t R' Y f g h⇙ Suc (m + n)))" in 
       P_mod_add[of "S ♒p (t^⇗S m⇖)"],
      (rule aGroup.ag_pOp_closed, assumption+,
             rule aGroup.ag_mOp_closed, assumption+)+,
      simp del:npow_suc Hpr_Suc add:aGroup.pOp_assoc_cancel)
apply (frule_tac g = "snd (Hprβ‡˜ R S X t R' Y f g h⇙ (m + n)) Β± 
     -a (snd (Hprβ‡˜ R S X t R' Y f g h⇙ Suc (m + n)))" and n = "m + n" in 
     P_mod_n_m[of t _ "m - Suc 0"], assumption+)
apply (rule aGroup.ag_pOp_closed, assumption+, rule aGroup.ag_mOp_closed, 
       assumption+,
       arith,
       simp del:npow_suc Hpr_Suc, simp del:npow_suc Hpr_Suc)
apply (frule_tac p = "snd (Hprβ‡˜ R S X t R' Y f g h⇙ m) Β±
           -a (snd (Hprβ‡˜ R S X t R' Y f g h⇙ (m + n)))" and 
       q = "snd (Hprβ‡˜ R S X t R' Y f g h⇙ (m + n)) Β±
           -a (snd (Hprβ‡˜ R S X t R' Y f g h⇙ Suc (m + n)))" in 
       P_mod_add[of "S ♒p (t^⇗S m⇖)"],
      (rule aGroup.ag_pOp_closed, assumption+,
             rule aGroup.ag_mOp_closed, assumption+)+,
      simp del:npow_suc Hpr_Suc add:aGroup.pOp_assoc_cancel)
done
 
(*** Cauchy, deg bounded ****)
lemma (in PolynRg) P_mod_diffxxx5_4:"⟦Idomain S; t ∈ carrier S; t β‰  πŸ¬β‡˜S⇙; 
      maximal_ideal S (S β™’p t); PolynRg R' (S /r (S β™’p t)) Y; f ∈ carrier R; 
  g ∈ carrier R; h ∈ carrier R;
  deg R S X g ≀ deg R' (S /r (S β™’p t)) Y
   (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g);  
  deg R S X h + deg R' (S /r (S β™’p t)) Y (erH R S X R' 
                (S /r (S β™’p t)) Y (pj S (S β™’p t)) g) ≀ deg R S X f;
    0 < deg R' (S /r (S β™’p t)) Y
        (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g);
    0 < deg R' (S /r (S β™’p t)) Y
        (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) h);
  rel_prime_pols R' (S /r (S β™’p t)) Y 
          (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g) 
          (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) h);
  P_mod R S X (S β™’p t) (f Β± -a (g β‹…r h))⟧ ⟹ 
       deg R S X (fst (Hprβ‡˜R S X t R' Y f g h⇙ m)) ≀ deg R S X g ∧
       deg R S X (snd (Hprβ‡˜R S X t R' Y f g h⇙ m)) ≀ deg R S X f" 
apply (cut_tac subring, frule subring_Ring,
       frule Ring.maximal_ideal_ideal[of S "S β™’p t"], assumption)
apply (case_tac "m = 0") apply simp
apply (frule aless_imp_le[of "0" "deg R' (S /r (S β™’p t)) Y
          (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g)"])
apply (frule aadd_le_mono[of "0" "deg R' (S /r (S β™’p t)) Y
       (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g)" "deg R S X h"])
 apply (simp add:aadd_0_l, simp add:aadd_commute[of  _ "deg R S X h"])

 apply (frule P_mod_diffxxx5_1[of t R' Y f g h "m - Suc 0"], 
        assumption+, (erule conjE)+)

apply (thin_tac "deg R S X g
     ≀ deg R' (S /r (S β™’p t)) Y
        (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g)")
apply (thin_tac "deg R S X h +  deg R' (S /r (S β™’p t)) Y
      (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g) ≀ deg R S X f") 
apply (thin_tac "rel_prime_pols R' (S /r (S β™’p t)) Y
      (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g)
      (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) h)",
       thin_tac "P_mod R S X (S β™’p t) ( f Β± -a (g β‹…r h))",
       thin_tac "P_mod R S X (S β™’p (t^β‡—S (Suc (m - Suc 0))β‡–))
        (fst (Hprβ‡˜ R S X t R' Y f g h⇙ (m - Suc 0)) Β±
         -a (fst (Hprβ‡˜ R S X t R' Y f g h⇙ Suc (m - Suc 0))))",
       thin_tac "P_mod R S X (S β™’p (t^β‡—S (Suc (m - Suc 0))β‡–))
      ( snd (Hprβ‡˜ R S X t R' Y f g h⇙ (m - Suc 0)) Β±
          -a (snd (Hprβ‡˜ R S X t R' Y f g h⇙ Suc (m - Suc 0))))",
       thin_tac "P_mod R S X (S β™’p (t^β‡—S (Suc (Suc (m - Suc 0)))β‡–))
      (f Β±
       -a (fst (Hprβ‡˜ R S X t R' Y f g h⇙ Suc (m - Suc 0)) β‹…r
           snd (Hprβ‡˜ R S X t R' Y f g h⇙ Suc (m - Suc 0))))")
apply (simp del:npow_suc Hpr_Suc)
 apply (thin_tac "erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t))
         (fst (Hprβ‡˜ R S X t R' Y f g h⇙ m)) =
         erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g",
        thin_tac "erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t))
        (snd (Hprβ‡˜ R S X t R' Y f g h⇙ m)) =
        erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) h") 
apply (frule_tac p = g in pHom_dec_deg[of R' "(S /r (S β™’p t))" Y
         "erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t))"]) 
apply (frule Ring.qring_ring[of "S" "S β™’p t"], assumption+)
apply (rule erH_rHom[of R' "(S /r (S β™’p t))" Y "pj S (S β™’p t)"], assumption+,
       simp add:pj_Hom, assumption+)
apply (frule ale_trans[of "deg R S X (fst (Hprβ‡˜ R S X t R' Y f g h⇙ m))" 
        "deg R' (S /r (S β™’p t)) Y
         (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g)" "deg R S X g"], 
       assumption+)
apply simp

apply (thin_tac "deg R S X (fst (Hprβ‡˜ R S X t R' Y f g h⇙ m))
                  ≀ deg R' (S /r (S β™’p t)) Y
                    (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g)",
      thin_tac "deg R' (S /r (S β™’p t)) Y
         (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g) ≀ deg R S X g",
      thin_tac "deg R S X (fst (Hprβ‡˜ R S X t R' Y f g h⇙ m)) ≀ deg R S X g")

apply (frule aless_imp_le[of "0" "deg R' (S /r (S β™’p t)) Y
          (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g)"])
apply (frule aadd_le_mono[of "0" "deg R' (S /r (S β™’p t)) Y
              (erH R S X R' (S /r (S β™’p t)) Y (pj S (S β™’p t)) g)" 
           "deg R S X (snd (Hprβ‡˜ R S X t R' Y f g h⇙ m))"])
apply (simp add:aadd_0_l, simp add:aadd_commute[of  _ 
                "deg R S X (snd (Hprβ‡˜ R S X t R' Y f g h⇙ m))"])
done

end