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 = 𝟬Rthen (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 "xfst (s_cf R S X p). snd (s_cf R S X p) x = 𝟬S⇙ ", simp)
 apply (thin_tac "0 < (if xfst (s_cf R S X p). snd (s_cf R S X p) x = 𝟬Sthen 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) = 1rS⇙" 

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 "jnset (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 ±Rq = 𝟬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) rR(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 ±Rq)"
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. -aSsnd (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. -aSsnd (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. -aSsnd (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. -aSsnd (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. -aSsnd (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. -aSsnd (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. -aSsnd (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. -aSsnd (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. -aSsnd (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. -aSsnd (scf_d R S X p (Suc d)) j)",
        thin_tac "snd (scf_d R S X (-a p) (Suc d)) (Suc d) =
     -aSsnd (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 "jfst (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  𝟬) =
         (jfst (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 jr 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))  𝟬) =
     (jafst (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 "1rS⇙"], 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 "1rS⇙"])
 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))) =
                (jSuc 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. xcarrier 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; xcarrier 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 "jn. 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. xcarrier 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) ±Acmp f c (Suc n) rAY^⇗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)) =
       ((jfst c. snd (cf_h h c) j = snd (cf_h h d) j) 
       (jnset (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)) =
       (jfst 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)) =
       ((jfst d. snd (cf_h h d) j = snd (cf_h h c) j) 
       (jnset (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 = (λxcarrier 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) = (1rA)"
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 1rS⇙" 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)) rA(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) rBh (u j))",
        thin_tac "pol_coeff S (l, λj. f 0 rSu 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 rSu 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) ±Acmp h f (Suc n) rAY^⇗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)rApolyn_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) rApolyn_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 nrAY  carrier A",
        thin_tac "cmp h f (Suc n) rA(Y^⇗A nrAY)  carrier A",
        thin_tac "polyn_expr A Y (l + n) (l + n, cmp h e) ±Apolyn_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))))) =
        (jSuc (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)) rA(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) = -aA(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)))) =
         (jfst (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))
        ±Apolyn_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 ±Rb)) = 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)))) =
         (jfst (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)))) =
       ((jfst (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) 
        (jnset (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 "jnset (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 "jfst (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))
        ±Apolyn_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)))) =
       (jfst (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))) =
         (jSuc 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 ±Rb = 𝟬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)) rApolyn_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)) =
          (jfst (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) = -aA(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) rA(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  (xcarrier 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 "xcarrier 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))) =
        (jfst (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)) =
       (jn. 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  (1rR)  ((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(-aR(q rRg)) = 𝟬R)  (deg_n R S X 
    (f ±R(-aR(q rRg))) < 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 nr p) = c rS(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 nr 
                    polyn_expr R X (fst (s_cf R S X p)) (s_cf R S X p)" and 
               b = "X^⇗R nr 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 nr 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 nr 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 nr 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 nr p)"], assumption+,
         (erule conjE)+,
         drule_tac a = "c r (X^⇗R nr p)" and 
         b = "polyn_expr R X (fst (s_cf R S X (c r (X^⇗R nr p))))
                       (s_cf R S X (c r (X^⇗R nr 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 nr 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 nr 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 nr p"], assumption+,
        simp add:Subring_zero_ring_zero, assumption+, (erule conjE)+, simp,
        thin_tac "deg_n R S X (c r (X^⇗R nr p)) =
                          deg_n R S X c + deg_n R S X (X^⇗R nr 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 nr 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 nr 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) rS((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) rS((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 rSlcf 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 rSlcf 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 rSlcf 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 rSlcf R S X g⇗‐ Sr 
       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 rSlcf R S X g⇗‐ Sr 
       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 rSlcf R S X g⇗‐ Sr 
                 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 rS(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 rSlcf R S X g⇗‐ S⇖" _ g],
                 assumption+, simp,
          cut_tac pol_of_deg0[THEN sym, of "lcf R S X f rSlcf R S X g⇗‐ S⇖"], 
          simp,
          thin_tac "deg_n R S X (lcf R S X f rSlcf R S X g⇗‐ Sr
              (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 rSlcf 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 rSlcf R S X g⇗‐ Sr
               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 rSlcf R S X g⇗‐ Sr
            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 rSlcf R S X g⇗‐ Sr
              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 rSlcf 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 rSlcf 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 rSlcf R S X g⇗‐ Sr 
                       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 rSlcf R S X g⇗‐ Sr 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 rSlcf R S X g⇗‐ Sr
                 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 rSlcf R S X g⇗‐ Sr
           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 rSlcf R S X g⇗‐ Sr
               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 rSlcf R S X g⇗‐ Sr
                 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 rSlcf R S X g⇗‐ Sr
            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 rSlcf R S X g⇗‐ Sr
         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   
     qcarrier 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   
   qcarrier R. (f = q r g)  (rcarrier 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  
       qcarrier R. (rcarrier 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 ±Rqa = 𝟬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  𝟬) = (jfst 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 ±Rq = 𝟬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 rSJ) ((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 rSJ" 
        "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 rSJ) ((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 mr 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))) = (jfst (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 mr 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 rSJ) 
           ((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 rSJ"])
 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 rSJ"], 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 rSJ)
         (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 nar 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 rSJ) ((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 rSJ) (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'  
      gcarrier 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)rSt^⇗S (Suc m)⇖",
          thin_tac "x = r rS(t^⇗S (n - m)rSt^⇗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 rS(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 rSr = t rS((λ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 rS((λ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)  (jn. f j  S p t) 
                  (f'. pol_coeff S (n, f')  (jn. f j = t rSf' 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 rS(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'))) =
          (jfst (s_cf R S X g).
              t rSf' 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) =
         (jfst (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 mr ra; 0 < m; 
        (erH R S X R' (S /r (S p t)) Y (pj S (S p t)) u)
         rR'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)
         rR'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 mr v) r (h ± t^⇗S mr 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 mr v" and y = h in ring_tOp_closed, assumption+)
apply (subst ring_distrib2, assumption+,
      frule_tac x = "t^⇗S mr v" and y = "t^⇗S mr 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 mr v r h"], assumption+)
apply (subst aGroup.ag_pOp_assoc[of R "-a (g r h)" " -a (t^⇗S mr 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 mr 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 mr 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^Sm) 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^Sm) 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' rR'erH R S X R' (S /r (S p t)) Y (pj S (S p t)) g ±R'v' rR'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 rR'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 rR'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' rR'erH R S X R' (S /r (S p t)) Y (pj S (S p t)) g ±R'v' rR'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 mr ra)",
       thin_tac "f ± -a (g r h) = t^⇗S mr ra",
       thin_tac 
        "u' rR'erH R S X R' (S /r (S p t)) Y (pj S (S p t)) g ±R'v' rR'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' rR'erH R S X R' (S /r (S p t)) Y (pj S (S p t)) g ±R'v' rR'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 rR'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 rR'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 fm 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-aR(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-aR(snd gh1))  
  P_mod R S X (S p (t^⇗S (Suc m))) (f ±R(-aR((fst gh1) rR(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 fm gh)  carrier R × carrier R   (deg R S X
     (fst (Hen⇘R S X t R' Y fm 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 fm gh))))  
  P_mod R S X (S p (t^⇗S m)) ((fst gh) ± -a (fst (Hen⇘R S X t R' Y fm gh)))  
  (deg R S X (snd (Hen⇘R S X t R' Y fm 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 fm 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 fm gh)))  
    P_mod R S X (S p (t^⇗S (Suc m))) (f ± (-a ((fst (Hen⇘R S X t R' Y fm gh)) r 
             (snd (Hen⇘R S X t R' Y fm 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 h0 = (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 hm)" 

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 hm)) ± -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 hm)) ± -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 hSuc 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 hSuc 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 hSuc (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 hSuc (Suc m))))",
       thin_tac "deg R S X (snd (Hpr⇘ R S X t R' Y f g hSuc (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 hSuc (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 hSuc 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 hSuc 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 hm)) ± -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 hm)) ± -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 hm)  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 hm)) ±
                                -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 hm)) ±
                                -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 hm" "carrier R" "carrier R"],
        frule cart_prod_snd[of "Hpr⇘ R S X t R' Y f g hm" "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 hSuc (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 hSuc (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 hSuc (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 hSuc (m + n))))",
      thin_tac "deg R S X (snd (Hpr⇘ R S X t R' Y f g hSuc (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 hSuc (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 hSuc (m + n)) r
                      snd (Hpr⇘ R S X t R' Y f g hSuc (m + n))))")
apply (simp del:npow_suc Hpr_Suc)
apply (frule_tac x = "Hpr⇘ R S X t R' Y f g hm" 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 hm" 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 hSuc (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 hm) ±
           -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 hSuc (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 hSuc (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 hm) ±
           -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 hSuc (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 hm))  deg R S X g 
       deg R S X (snd (Hpr⇘R S X t R' Y f g hm))  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 hSuc (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 hSuc (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 hSuc (m - Suc 0)) r
           snd (Hpr⇘ R S X t R' Y f g hSuc (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 hm)) =
         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 hm)) =
        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 hm))" 
        "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 hm))
                   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 hm))  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 hm))"])
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 hm))"])
done

end