Theory Algebra5

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

  chapter 4.  Ring theory (continued)
    section 6.   operation of ideals
    section 7.   direct product1, general case
    section 8.   Chinese remainder theorem
    section 9.   addition of finite elements of a ring and ideal_multiplication
    section 10.  extension and contraction
    section 11.  complete system of representatives
    section 12.  Polynomial ring 
    section 13.  addition and multiplication of polyn_exprs
    section 14.  the degree of a polynomial
   **)

theory Algebra5 imports Algebra4 begin

section "Operation of ideals"

lemma (in Ring) ideal_sumTr1:"⟦ideal R A; ideal R B⟧ ⟹ 
          A ∓ B = ⋂ {J. ideal R J ∧ (A ∪ B) ⊆ J}"
apply (frule sum_ideals[of "A" "B"], assumption,
       frule sum_ideals_la1[of "A" "B"], assumption,
       frule sum_ideals_la2[of "A" "B"], assumption)
apply (rule equalityI)
  (* A ∓⇩R B ⊆ ⋂{J. ideal R J ∧ A ∪ B ⊆ J} *)

apply (rule_tac A = "{J. ideal R J ∧ (A ∪ B) ⊆ J}" and C = "A ∓ B" in
                Inter_greatest)
 apply (simp, (erule conjE)+)
 apply (rule_tac A = A and B = B and I = X in sum_ideals_cont,
        simp add:ideal_subset1, simp add:ideal_subset1, assumption+)
apply (rule_tac B = "A ∓ B" and A = "{J. ideal R J ∧ (A ∪ B) ⊆ J}" in
         Inter_lower)
 apply simp
done

lemma (in Ring) sum_ideals_commute:"⟦ideal R A; ideal R B⟧ ⟹   
                       A ∓ B = B ∓ A"
apply (frule ideal_sumTr1 [of "B"], assumption+,
       frule ideal_sumTr1 [of "A" "B"], assumption+)
apply (simp add:Un_commute[of "B" "A"])
done

lemma (in Ring) ideal_prod_mono1:"⟦ideal R A; ideal R B; ideal R C;
                A ⊆ B ⟧ ⟹ A ♢⇩r C ⊆ B ♢⇩r C"
apply (frule ideal_prod_ideal[of "B" "C"], assumption+)
apply (rule ideal_prod_subTr[of "A" "C" "B ♢⇩r C"], assumption+)
 apply (rule ballI)+
 apply (frule_tac c = i in subsetD[of "A" "B"], assumption+)
 apply (rule_tac i = i and j = j in prod_mem_prod_ideals[of "B" "C"],
                 assumption+)
done

lemma (in Ring) ideal_prod_mono2:"⟦ideal R A; ideal R B; ideal R C;
                A ⊆ B ⟧ ⟹ C ♢⇩r A ⊆ C ♢⇩r B"
apply (frule ideal_prod_mono1[of "A" "B" "C"], assumption+)
apply (simp add:ideal_prod_commute)
done

lemma (in Ring) cont_ideal_prod:"⟦ideal R A; ideal R B; ideal R C;
        A ⊆ C; B ⊆ C ⟧ ⟹ A ♢⇩r B ⊆ C"
apply (simp add:ideal_prod_def)
apply (rule subsetI, simp)
 apply (frule ideal_prod_ideal[of "A" "B"], assumption,
        frule_tac a = "A ♢⇩r B" in forall_spec,
   thin_tac "∀xa. ideal R xa ∧ {x. ∃i∈A. ∃j∈B. x = i ⋅⇩r j} ⊆ xa ⟶ x ∈ xa",
   simp)
 apply (rule subsetI, simp, (erule bexE)+, simp add:prod_mem_prod_ideals)
 apply (frule ideal_prod_la1[of "A" "B"], assumption,
        frule_tac c = x in subsetD[of "A ♢⇩r B" "A"], assumption+,
        simp add:subsetD)
done

lemma (in Ring) ideal_distrib:"⟦ideal R A; ideal R B; ideal R C⟧ ⟹
             A ♢⇩r (B ∓ C) =  A ♢⇩r B ∓  A ♢⇩r C"
apply (frule sum_ideals[of "B" "C"], assumption,
       frule ideal_prod_ideal[of "A" "B ∓ C"], assumption+,
       frule ideal_prod_ideal[of "A" "B"], assumption+,
       frule ideal_prod_ideal[of "A" "C"], assumption+,
       frule sum_ideals[of "A ♢⇩r B" "A ♢⇩r C"], assumption)
apply (rule equalityI)
 apply (rule ideal_prod_subTr[of "A" "B ∓ C" "A ♢⇩r B ∓ A ♢⇩r C"], assumption+)
 apply (rule ballI)+
 apply (frule_tac x = j in ideals_set_sum[of B C], assumption+,
        (erule bexE)+, simp) apply (
        thin_tac "j = h ± k",
        frule_tac h = i in ideal_subset[of "A"], assumption+,
        frule_tac h = h in ideal_subset[of "B"], assumption+,
        frule_tac h = k in ideal_subset[of "C"], assumption+)
 apply (simp add:ring_distrib1)
 apply (frule_tac i = i and j = h in prod_mem_prod_ideals[of "A" "B"],
         assumption+,
        frule_tac i = i and j = k in prod_mem_prod_ideals[of "A" "C"],
         assumption+)
 apply (frule sum_ideals_la1[of "A ♢⇩r B" "A ♢⇩r C"], assumption+,
        frule sum_ideals_la2[of "A ♢⇩r B" "A ♢⇩r C"], assumption+)
 apply (frule_tac c = "i ⋅⇩r h" in subsetD[of "A ♢⇩r B" "A ♢⇩r B ∓ A ♢⇩r C"], 
                                assumption+,
        frule_tac c = "i ⋅⇩r k" in subsetD[of "A ♢⇩r C" "A ♢⇩r B ∓ A ♢⇩r C"], 
                                assumption+)
 apply (simp add:ideal_pOp_closed) 
 apply (rule sum_ideals_cont[of "A ♢⇩r (B ∓ C)" "A ♢⇩r B" "A ♢⇩r C" ],
          assumption+) 
 apply (rule ideal_prod_subTr[of "A" "B" "A ♢⇩r (B ∓ C)"], assumption+)
  apply (rule ballI)+
  apply (frule sum_ideals_la1[of "B" "C"], assumption+,
         frule_tac c = j in subsetD[of "B" "B ∓ C"], assumption+,
         rule_tac i = i and j = j in prod_mem_prod_ideals[of "A" "B ∓ C"],
         assumption+)

  apply (rule ideal_prod_subTr[of "A" "C" "A ♢⇩r (B ∓ C)"], assumption+)
  apply (rule ballI)+
  apply (frule sum_ideals_la2[of "B" "C"], assumption+,
         frule_tac c = j in subsetD[of "C" "B ∓ C"], assumption+,
         rule_tac i = i and j = j in prod_mem_prod_ideals[of "A" "B ∓ C"],
         assumption+)
done

definition
  coprime_ideals::"[_, 'a set, 'a set] ⇒ bool" where
  "coprime_ideals R A B ⟷ A ∓⇘R⇙ B = carrier R"

lemma (in Ring) coprimeTr:"⟦ideal R A; ideal R B⟧ ⟹
                coprime_ideals R A B = (∃a ∈ A. ∃b ∈ B. a ± b = 1⇩r)"
apply (rule iffI)
 apply (simp add:coprime_ideals_def) 
 apply (cut_tac ring_one, frule sym, thin_tac "A ∓ B = carrier R", simp,
        thin_tac "carrier R = A ∓ B", frule ideals_set_sum[of A B],
        assumption+, (erule bexE)+, frule sym, blast)

apply (erule bexE)+
 apply (frule ideal_subset1[of A], frule ideal_subset1[of B]) 
 apply (frule_tac a = a and b = b in set_sum_mem[of _ A _ B], assumption+)
 apply (simp add:coprime_ideals_def)
 apply (frule sum_ideals[of "A" "B"], assumption+,
        frule ideal_inc_one[of "A ∓ B"], assumption)
 apply (simp add:coprime_ideals_def)
done

lemma (in Ring) coprime_int_prod:"⟦ideal R A; ideal R B; coprime_ideals R A B⟧
       ⟹   A ∩ B = A ♢⇩r B"
apply (frule ideal_prod_la1[of "A" "B"], assumption+,
       frule ideal_prod_la2[of "A" "B"], assumption+) 
apply (rule equalityI) 
defer
 (**  A ♢⇘R⇙ B ⊆ A ∩ B **)
 apply simp
 apply (simp add:coprime_ideals_def)
 apply (frule int_ideal[of "A" "B"], assumption)
 apply (frule idealprod_whole_r[of "A ∩ B"])
 apply (frule sym, thin_tac "A ∓ B = carrier R", simp)
 apply (simp add:ideal_distrib)
 apply (simp add:ideal_prod_commute[of "A ∩ B" "A"])
 apply (cut_tac Int_lower1[of "A" "B"], cut_tac Int_lower2[of "A" "B"])
 apply (frule ideal_prod_mono2[of "A ∩ B" "B" "A"], assumption+,  
        frule ideal_prod_mono1[of "A ∩ B" "A" "B"], assumption+)
 apply (frule ideal_prod_ideal[of "A ∩ B" "B"], assumption+,
        frule ideal_prod_ideal[of "A" "A ∩ B"], assumption+,
        frule ideal_subset1[of "A ♢⇩r (A ∩ B)"],
        frule ideal_subset1[of "(A ∩ B) ♢⇩r B"])
 apply (frule ideal_prod_ideal[of A B], assumption+,
        frule sum_ideals_cont[of "A ♢⇩r B" "A ♢⇩r (A ∩ B)" "(A ∩ B) ♢⇩r B"],
        assumption+) 
 apply simp
done

lemma (in Ring) coprime_elems:"⟦ideal R A; ideal R B; coprime_ideals R A B⟧ ⟹
                    ∃a∈A. ∃b∈B. a ± b = 1⇩r"
by (simp add:coprimeTr)

lemma (in Ring) coprime_elemsTr:"⟦ideal R A; ideal R B; a∈A; b∈B; a ± b = 1⇩r⟧ 
               ⟹ pj R A b = 1⇩r⇘(qring R A)⇙ ∧ pj R B a = 1⇩r⇘(qring R B)⇙"
apply (frule pj_Hom [OF Ring, of "A"],
       frule pj_Hom [OF Ring, of "B"])
 apply (frule qring_ring[of "A"], frule qring_ring[of "B"])
 apply (cut_tac ring_is_ag,
        frule Ring.ring_is_ag[of "R /⇩r A"],
         frule Ring.ring_is_ag[of "R /⇩r B"])
 apply (frule_tac a = a and b = b in aHom_add[of "R" "R /⇩r A" "pj R A"],
         assumption+,
       simp add:rHom_def, simp add:ideal_subset,
       simp add:ideal_subset, simp)
 apply (frule ideal_subset[of "A" "a"], assumption,
        frule ideal_subset[of "B" "b"], assumption+)
 apply (simp only:pj_zero[OF Ring, THEN sym, of "A" "a"],
        frule rHom_mem[of "pj R A" "R" "qring R A" "b"], assumption+,
        simp add:aGroup.l_zero[of "R /⇩r A"])
  apply (simp add:rHom_one[OF Ring, of "qring R A"])
  
  apply (frule_tac a = a and b = b in aHom_add[of "R" "R /⇩r B" "pj R B"],
         assumption+,
       simp add:rHom_def, simp add:ideal_subset,
       simp add:ideal_subset, simp)
  apply (simp only:pj_zero[OF Ring, THEN sym, of "B" "b"],
        frule rHom_mem[of "pj R B" "R" "qring R B" "a"], assumption+,
        simp add:aGroup.ag_r_zero[of "R /⇩r B"])
  apply (simp add:rHom_one[OF Ring, of "qring R B"])
done

lemma (in Ring) partition_of_unity:"⟦ideal R A; a ∈ A; b ∈ carrier R; 
       a ± b = 1⇩r; u ∈ carrier R; v ∈ carrier R⟧ ⟹ 
                                 pj R A (a ⋅⇩r v ± b ⋅⇩r u ) = pj R A u"
apply (frule pj_Hom [OF Ring, of "A"],
       frule ideal_subset [of "A" "a"], assumption+,
       frule ring_tOp_closed[of "a" "v"], assumption+,
       frule ring_tOp_closed[of "b" "u"], assumption+,
       frule qring_ring[of "A"])
 apply (simp add:ringhom1[OF Ring, of "qring R A" "a ⋅⇩r v" "b ⋅⇩r u" "pj R A"])
 apply (frule ideal_ring_multiple1[of "A" "a" "v"], assumption+,
        simp add:pj_zero[OF Ring, THEN sym, of "A" "a ⋅⇩r v"],
        frule rHom_mem[of "pj R A" "R" "qring R A" "b ⋅⇩r u"], assumption+,
        simp add:Ring.l_zero, simp add:rHom_tOp[OF Ring])
 apply (frule ringhom1[OF Ring, of "qring R A" "a" "b" "pj R A"], assumption+,
        simp,
        simp add:pj_zero[OF Ring, THEN sym, of "A" "a"],
        frule rHom_mem[of "pj R A" "R" "qring R A" "b"], assumption+,
        simp add:Ring.l_zero)
   apply (simp add:rHom_one[OF Ring, of "qring R A" "pj R A"],
          rotate_tac -2, frule sym, thin_tac "1⇩r⇘R /⇩r A⇙ = pj R A b",
          simp,
          rule Ring.ring_l_one[of "qring R A" "pj R A u"], assumption)
  apply (simp add:rHom_mem)
done

lemma (in Ring) coprimes_commute:"⟦ideal R A; ideal R B; coprime_ideals R A B ⟧
 ⟹ coprime_ideals R B A"
apply (simp add:coprime_ideals_def)
apply (simp add:sum_ideals_commute)
done

lemma (in Ring) coprime_surjTr:"⟦ideal R A; ideal R B; coprime_ideals R A B; 
                 X ∈ carrier (qring R A); Y ∈ carrier (qring R B) ⟧ ⟹ 
                         ∃r∈carrier R. pj R A r = X ∧ pj R B r = Y"
apply (frule qring_ring [of "A"], 
       frule qring_ring [of "B"], 
       frule coprime_elems [of "A" "B"], assumption+,
       frule pj_Hom [OF Ring, of "A"],
       frule pj_Hom [OF Ring, of "B"])
apply (erule bexE)+
 apply (simp add:qring_carrier[of "A"],
        simp add:qring_carrier[of "B"], (erule bexE)+,
        rename_tac a b u v)
 apply (rotate_tac -1, frule sym, thin_tac "v ⊎⇘R⇙ B = Y",
        rotate_tac -3, frule sym, thin_tac "u ⊎⇘R⇙ A = X", simp)
 apply (frule_tac h = a in ideal_subset[of "A"], assumption+,
       frule_tac h = b in ideal_subset[of "B"], assumption+,
       frule_tac x = a and y = v in ring_tOp_closed, assumption+,
       frule_tac x = b and y = u in ring_tOp_closed, assumption+,
       cut_tac ring_is_ag,
       frule_tac x = "a ⋅⇩r v" and y = "b ⋅⇩r u" in aGroup.ag_pOp_closed[of "R"], 
       assumption+) 
 apply (frule_tac a = a and b = b and u = u and v = v in 
                  partition_of_unity[of "A"], assumption+,
        simp add:pj_mem[OF Ring, of "A"])
 apply (frule_tac a = b and b = a and u = v and v = u in 
           partition_of_unity[of "B"], assumption+,
        subst aGroup.ag_pOp_commute[of "R"], assumption+,
        simp add:pj_mem[OF Ring, of "B"])      
 apply (frule_tac x = "b ⋅⇩r u" and y = "a ⋅⇩r v" in 
             aGroup.ag_pOp_commute[of "R"], assumption+, simp)
 apply (simp add:pj_mem[OF Ring], blast)
done

lemma (in Ring) coprime_n_idealsTr0:"⟦ideal R A; ideal R B; ideal R C; 
         coprime_ideals R A C; coprime_ideals R B C ⟧ ⟹ 
             coprime_ideals R (A ♢⇩r B) C" 
apply (simp add:coprimeTr[of "A" "C"],
       simp add:coprimeTr[of "B" "C"], (erule bexE)+)
apply (cut_tac ring_is_ag,
       frule_tac h = a in ideal_subset[of "A"], assumption+,
       frule_tac h = aa in ideal_subset[of "B"], assumption+,
       frule_tac h = b in ideal_subset[of "C"], assumption+,
       frule_tac h = ba in ideal_subset[of "C"], assumption+,
       frule_tac x = a and y = b in aGroup.ag_pOp_closed, assumption+)
apply (frule_tac x = "a ± b" and y = aa and z = ba in ring_distrib1,
        assumption+) apply (
       rotate_tac 6, frule sym, thin_tac "a ± b = 1⇩r",
       frule sym, thin_tac "aa ± ba = 1⇩r")
      apply (simp only:ring_distrib2)
apply (rotate_tac -1, frule sym, thin_tac "1⇩r = a ± b", simp,
       thin_tac "aa ± ba = 1⇩r")
       apply (simp add:ring_r_one,
       thin_tac "a ⋅⇩r aa ± b ⋅⇩r aa ± (a ⋅⇩r ba ± b ⋅⇩r ba) ∈ carrier R",
       thin_tac "a ± b = a ⋅⇩r aa ± b ⋅⇩r aa ± (a ⋅⇩r ba ± b ⋅⇩r ba)")
 apply (frule_tac x = a and y = aa in ring_tOp_closed, assumption+,
        frule_tac x = b and y = aa in ring_tOp_closed, assumption+,
        frule_tac x = a and y = ba in ring_tOp_closed, assumption+,
        frule_tac x = b and y = ba in ring_tOp_closed, assumption+, 
        frule_tac x = "a ⋅⇩r ba" and y = "b ⋅⇩r ba" in aGroup.ag_pOp_closed, 
        assumption+)
  apply (simp add:aGroup.ag_pOp_assoc,
         frule sym, thin_tac "1⇩r = a ⋅⇩r aa ± (b ⋅⇩r aa ± (a ⋅⇩r ba ± b ⋅⇩r ba))")
  apply (frule_tac i = a and j = aa in prod_mem_prod_ideals[of "A" "B"],
           assumption+)
  apply (frule_tac x = ba and r = a in ideal_ring_multiple[of "C"],
           assumption+,
         frule_tac x = ba and r = b in ideal_ring_multiple[of "C"],
           assumption+,
         frule_tac x = b and r = aa in ideal_ring_multiple1[of "C"],
           assumption+)
  apply (frule_tac I = C and x = "a ⋅⇩r ba" and y = "b ⋅⇩r ba" in 
         ideal_pOp_closed, assumption+,
         frule_tac I = C and x = "b ⋅⇩r aa" and y = "a ⋅⇩r ba ± b ⋅⇩r ba" in 
         ideal_pOp_closed, assumption+)
  apply (frule ideal_prod_ideal[of "A" "B"], assumption)
  apply (subst coprimeTr, assumption+, blast)
done

lemma (in Ring) coprime_n_idealsTr1:"ideal R C ⟹
    (∀k ≤ n. ideal R (J k)) ∧ (∀i ≤ n.  coprime_ideals R (J i) C) ⟶ 
    coprime_ideals R (iΠ⇘R,n⇙ J) C"
apply (induct_tac n)
apply (rule impI)
apply (erule conjE)
 apply simp 

apply (rule impI)
apply (erule conjE)
apply (cut_tac n = "Suc n" in n_in_Nsetn)
apply (cut_tac n = n in Nset_Suc) apply simp
 apply (cut_tac n = n and J = J in n_prod_ideal,
        rule allI, simp)
 apply (rule_tac A = "iΠ⇘R,n⇙ J" and B = "J (Suc n)" in 
                coprime_n_idealsTr0[of _ _ "C"], simp+)
done

lemma (in Ring) coprime_n_idealsTr2:"⟦ideal R C; (∀k ≤ n. ideal R (J k)); 
       (∀i ≤ n. coprime_ideals R (J i) C) ⟧ ⟹ 
                                     coprime_ideals R (iΠ⇘R,n⇙ J) C"
by (simp add:coprime_n_idealsTr1)

lemma (in Ring) coprime_n_idealsTr3:"(∀k ≤ (Suc n). ideal R (J k)) ∧ 
    (∀i ≤ (Suc n). ∀j ≤ (Suc n). i ≠ j ⟶ 
    coprime_ideals R (J i) (J j)) ⟶  coprime_ideals R (iΠ⇘R,n⇙ J) (J (Suc n))"
apply (rule impI, erule conjE)
apply (case_tac "n = 0", simp)
 apply (simp add:Nset_1)
 apply (cut_tac nat_eq_le[of "Suc n" "Suc n"],
        frule_tac a = "Suc n" in forall_spec, assumption) 
 apply (rotate_tac 1, frule_tac a = "Suc n" in forall_spec, assumption,
        thin_tac "∀j≤Suc n. Suc n ≠ j ⟶ coprime_ideals R (J (Suc n)) (J j)")
 apply (rule_tac C = "J (Suc n)" and n = n and J = J in coprime_n_idealsTr2,
        assumption, rule allI, simp)
 apply (rule allI, rule impI)
 apply (frule_tac a = i in forall_spec, simp,
       thin_tac "∀i≤Suc n. ∀j≤Suc n. i ≠ j ⟶ coprime_ideals R (J i) (J j)",
       rotate_tac -1,
       frule_tac a = "Suc n" in forall_spec, assumption+)
 apply simp+
done

lemma (in Ring) coprime_n_idealsTr4:"⟦(∀k ≤ (Suc n). ideal R (J k)) ∧ 
   (∀i ≤ (Suc n). ∀j ≤ (Suc n). i ≠ j ⟶ 
    coprime_ideals R (J i) (J j))⟧ ⟹ coprime_ideals R (iΠ⇘R,n⇙ J) (J (Suc n))"
apply (simp add:coprime_n_idealsTr3)
done

section "Direct product1, general case"

definition
  prod_tOp :: "['i set,  'i ⇒ ('a, 'm) Ring_scheme] ⇒ 
    ('i ⇒ 'a) ⇒ ('i ⇒ 'a) ⇒  ('i ⇒ 'a)" where
  "prod_tOp I A = (λf∈carr_prodag I A. λg∈carr_prodag I A.
                           λx∈I. (f x) ⋅⇩r⇘(A x)⇙ (g x))"
  (** Let x ∈ I, then A x is a ring, {A x | x ∈ I} is a set of rings. **)

definition
  prod_one::"['i set,  'i  ⇒ ('a, 'm) Ring_scheme] ⇒ ('i ⇒ 'a)" where
  "prod_one I A == λx∈I. 1⇩r⇘(A x)⇙"
  (** 1⇩(A x) is the unit of a ring A x. **)

definition
  prodrg :: "['i set, 'i ⇒ ('a, 'more) Ring_scheme] ⇒ ('i ⇒ 'a) Ring" where
  "prodrg I A = ⦇carrier = carr_prodag I A, pop = prod_pOp I A, mop = 
    prod_mOp I A, zero = prod_zero I A, tp = prod_tOp I A, 
    un = prod_one I A ⦈"
 (** I is the index set **)

abbreviation
  PRODRING  ("(rΠ⇘_⇙/ _)" [72,73]72) where
  "rΠ⇘I⇙ A == prodrg I A"

definition
  augm_func :: "[nat, nat ⇒ 'a,'a set, nat, nat ⇒ 'a, 'a set] ⇒ nat ⇒ 'a" where
  "augm_func n f A m g B = (λi∈{j. j ≤ (n + m)}. if i ≤ n then f i else
    if (Suc n) ≤ i ∧ i ≤ n + m then g ((sliden (Suc n)) i) else undefined)"
 (* Remark. g is a function of Nset (m - 1) → B *)  

definition    
  ag_setfunc :: "[nat, nat ⇒ ('a, 'more) Ring_scheme, nat, 
nat ⇒ ('a, 'more)  Ring_scheme] ⇒ (nat ⇒ 'a) set ⇒ (nat ⇒ 'a) set
 ⇒ (nat  ⇒ 'a) set" where
  "ag_setfunc n B1 m B2 X Y =
    {f. ∃g. ∃h. (g∈X) ∧(h∈Y) ∧(f = (augm_func n g (Un_carrier {j. j ≤ n} B1) 
      m h (Un_carrier {j. j ≤ (m - 1)} B2)))}"
 (* Later we consider X = ac_Prod_Rg (Nset n) B1 and Y = ac_Prod_Rg (Nset (m - 1)) B2 *)  
 
primrec
  ac_fProd_Rg :: "[nat, nat ⇒ ('a, 'more) Ring_scheme] ⇒
                 (nat ⇒ 'a) set"
where
  fprod_0: "ac_fProd_Rg 0 B = carr_prodag {0::nat} B"
| frpod_n: "ac_fProd_Rg (Suc n) B = ag_setfunc n B (Suc 0) (compose {0::nat} 
 B (slide (Suc n))) (carr_prodag {j. j ≤ n} B) (carr_prodag {0} (compose {0} B (slide (Suc n))))"

definition
  prodB1 :: "[('a, 'm) Ring_scheme, ('a, 'm) Ring_scheme] ⇒
                 (nat ⇒ ('a, 'm) Ring_scheme)" where
  "prodB1 R S = (λk. if k=0 then R else if k=Suc 0 then S else
                 undefined)"

definition
  Prod2Rg :: "[('a, 'm) Ring_scheme, ('a, 'm) Ring_scheme]
              ⇒ (nat ⇒ 'a) Ring" (infixl "⨁⇩r" 80) where
  "A1 ⨁⇩r A2 = prodrg {0, Suc 0} (prodB1 A1 A2)"

text ‹Don't try ‹(Prod_ring (Nset n) B) ⨁⇩r (B (Suc n))››

lemma carr_prodrg_mem_eq:"⟦f ∈ carrier (rΠ⇘I⇙ A); g ∈ carrier (rΠ⇘I⇙ A);
       ∀i∈I. f i = g i ⟧ ⟹ f = g" 
by (simp add:prodrg_def carr_prodag_def, (erule conjE)+,
    rule funcset_eq[of _ I], assumption+)

lemma prod_tOp_mem:"⟦∀k∈I. Ring (A k); X ∈ carr_prodag I A;
 Y ∈ carr_prodag I A⟧ ⟹ prod_tOp I A X Y ∈ carr_prodag I A"
apply (subst carr_prodag_def, simp)
apply (rule conjI)
 apply (simp add:prod_tOp_def restrict_def extensional_def)
apply (rule conjI)
 apply (rule Pi_I)
 apply (simp add:Un_carrier_def prod_tOp_def)
 apply (simp add:carr_prodag_def, (erule conjE)+)
 apply (blast dest: Ring.ring_tOp_closed del:PiE)
 
 apply (rule ballI)
 apply (simp add:prod_tOp_def)
 apply (simp add:carr_prodag_def, (erule conjE)+)
 apply (simp add:Ring.ring_tOp_closed)
done
 
 
lemma prod_tOp_func:"∀k∈I. Ring (A k) ⟹
    prod_tOp I A ∈ carr_prodag I A → carr_prodag I A → carr_prodag I A"
by (simp add:prod_tOp_mem)

lemma prod_one_func:"∀k∈I. Ring (A k) ⟹
                           prod_one I A ∈ carr_prodag I A"
apply (simp add:prod_one_def carr_prodag_def)
apply (rule conjI)
apply (rule Pi_I)
 apply (simp add:Un_carrier_def)
 apply (blast dest: Ring.ring_one)
 apply (simp add: Ring.ring_one)
done

lemma prodrg_carrier:"∀k∈I. Ring (A k) ⟹
                  carrier (prodrg I A) = carrier (prodag I A)"
by (simp add:prodrg_def prodag_def)

lemma prodrg_ring:"∀k∈I. Ring (A k) ⟹ Ring (prodrg I A)"
apply (rule Ring.intro)
 apply (simp add:prodrg_def)
 apply (rule prod_pOp_func,
        rule ballI, simp add:Ring.ring_is_ag)
 
 apply (simp add:prodrg_def, rule prod_pOp_assoc,
        simp add:Ring.ring_is_ag, assumption+)
 
 apply (simp add:prodrg_def, rule prod_pOp_commute,
          simp add:Ring.ring_is_ag, assumption+)

 apply (simp add:prodrg_def, rule prod_mOp_func,
           simp add:Ring.ring_is_ag) 
 
 apply (simp add:prodrg_def)
 apply (cut_tac X = a in prod_mOp_mem[of "I" "A"])
        apply (simp add:Ring.ring_is_ag, assumption)
 apply (cut_tac X = "prod_mOp I A a" and Y = a in prod_pOp_mem[of "I" "A"],
        simp add:Ring.ring_is_ag, assumption+,
        cut_tac prod_zero_func[of "I" "A"])
 apply (rule carr_prodag_mem_eq[of "I" "A"],
        simp add:Ring.ring_is_ag, assumption+,
        rule ballI, simp add:prod_pOp_def,
        subst prod_mOp_mem_i, simp add:Ring.ring_is_ag, assumption+,
        subst prod_zero_i, simp add:Ring.ring_is_ag, assumption+,
        rule aGroup.l_m, simp add:Ring.ring_is_ag,
        simp add:prodag_comp_i, simp add:Ring.ring_is_ag)
 apply (simp add:prodrg_def,
        rule prod_zero_func, simp add:Ring.ring_is_ag)
 apply (simp add:prodrg_def,
        cut_tac prod_zero_func[of "I" "A"],
        cut_tac X = "prod_zero I A" and Y = a in prod_pOp_mem[of "I" "A"],
        simp add:Ring.ring_is_ag, assumption+,
        rule carr_prodag_mem_eq[of "I" "A"],
        simp add:Ring.ring_is_ag, assumption+)
        apply (rule ballI)
      apply (simp add:prod_pOp_def prod_zero_def)
      apply (rule aGroup.ag_l_zero, simp add:Ring.ring_is_ag)
      apply (simp add:prodag_comp_i, simp add:Ring.ring_is_ag)
 apply (simp add:prodrg_def,
        rule prod_tOp_func, simp add:Ring.ring_is_ag)
 apply (simp add:prodrg_def)
  apply (frule_tac X = a and Y = b in prod_tOp_mem[of "I" "A"], assumption+,
         frule_tac X = "prod_tOp I A a b" and Y = c in 
                                      prod_tOp_mem[of "I" "A"], assumption+,
         frule_tac X = b and Y = c in prod_tOp_mem[of "I" "A"], assumption+,
         frule_tac X = a and Y = "prod_tOp I A b c" in 
                                      prod_tOp_mem[of "I" "A"], assumption+)
  apply (rule carr_prodag_mem_eq[of "I" "A"],
         simp add:Ring.ring_is_ag, assumption+, rule ballI)
  apply (simp add:prod_tOp_def)
  apply (rule Ring.ring_tOp_assoc, simp, (simp add:prodag_comp_i)+)
 apply (simp add:prodrg_def)
  apply (frule_tac X = a and Y = b in prod_tOp_mem[of "I" "A"], assumption+,
         frule_tac X = b and Y = a in prod_tOp_mem[of "I" "A"], assumption+,
         rule carr_prodag_mem_eq[of "I" "A"],
         simp add:Ring.ring_is_ag, assumption+)
  apply (rule ballI, simp add:prod_tOp_def)
  apply (rule Ring.ring_tOp_commute, (simp add:prodag_comp_i)+)
 apply (simp add:prodrg_def, rule prod_one_func, assumption)

 apply (simp add:prodrg_def)
  apply (cut_tac X = b and Y = c in prod_pOp_mem[of "I" "A"],
         simp add:Ring.ring_is_ag, assumption+,
         cut_tac X = a and Y = b in prod_tOp_mem[of "I" "A"], assumption+,
         cut_tac X = a and Y = c in prod_tOp_mem[of "I" "A"], assumption+,
         cut_tac X = "prod_tOp I A a b" and Y = "prod_tOp I A a c" in 
         prod_pOp_mem[of "I" "A"], simp add:Ring.ring_is_ag, assumption+)
  apply (rule carr_prodag_mem_eq[of "I" "A"],
         simp add:Ring.ring_is_ag, rule prod_tOp_mem[of "I" "A"], assumption+)
  apply (rule ballI, simp add:prod_tOp_def prod_pOp_def)
  apply (rule Ring.ring_distrib1, (simp add:prodag_comp_i)+)

 apply (simp add:prodrg_def,
        cut_tac prod_one_func[of "I" "A"],
        cut_tac X = "prod_one I A" and Y = a in prod_tOp_mem[of "I" "A"], 
        assumption+) 
 apply (rule carr_prodag_mem_eq[of "I" "A"],
        simp add:Ring.ring_is_ag, assumption+,
        rule ballI, simp add:prod_tOp_def prod_one_def,
        rule Ring.ring_l_one, simp, simp add:prodag_comp_i)
 apply simp
done

lemma prodrg_elem_extensional:"⟦∀k∈I. Ring (A k); f ∈ carrier (prodrg I A)⟧
      ⟹  f ∈ extensional I"
apply (simp add:prodrg_carrier)
apply (simp add:prodag_def carr_prodag_def)
done

lemma prodrg_pOp:"∀k∈I. Ring (A k) ⟹ 
                  pop (prodrg I A) = prod_pOp I A"
apply (simp add:prodrg_def)
done

lemma prodrg_mOp:"∀k∈I. Ring (A k) ⟹ 
                  mop (prodrg I A) = prod_mOp I A"
apply (simp add:prodrg_def)
done 

lemma prodrg_zero:"∀k∈I. Ring (A k) ⟹ 
                  zero (prodrg I A) = prod_zero I A"
apply (simp add:prodrg_def)
done

lemma prodrg_tOp:"∀k∈I. Ring (A k) ⟹ 
                  tp (prodrg I A) = prod_tOp I A"
apply (simp add:prodrg_def)
done

lemma prodrg_one:"∀k∈I. Ring (A k) ⟹ 
                  un (prodrg I A) = prod_one I A"
apply (simp add:prodrg_def)
done

lemma prodrg_sameTr5:"⟦∀k∈I. Ring (A k); ∀k∈I. A k = B k⟧
                               ⟹ prod_tOp I A = prod_tOp I B"
apply (frule prod_tOp_func)
apply (subgoal_tac "carr_prodag I A = carr_prodag I B", simp)
apply (frule prod_tOp_func [of "I" "B"])
 apply (rule funcset_eq [of _ "carr_prodag I B" _])
 apply (simp add:prod_tOp_def extensional_def) 
 apply (simp add:prod_tOp_def extensional_def) 
apply (rule ballI)
 apply (frule_tac x = x in funcset_mem [of "prod_tOp I A" "carr_prodag I B"
 "carr_prodag I B → carr_prodag I B"], assumption+)
 apply (frule_tac x = x in funcset_mem [of "prod_tOp I B" "carr_prodag I B"
 "carr_prodag I B → carr_prodag I B"], assumption+)
 apply (thin_tac " prod_tOp I A
           ∈ carr_prodag I B → carr_prodag I B → carr_prodag I B")
 apply (thin_tac "prod_tOp I B
           ∈ carr_prodag I B → carr_prodag I B → carr_prodag I B")
 apply (rule funcset_eq [of _ "carr_prodag I B"])
 apply (simp add:prod_tOp_def extensional_def) 
 apply (simp add:prod_tOp_def extensional_def) 
apply (rule ballI)
 apply (frule_tac f = "prod_tOp I A x" and A = "carr_prodag I B" and
         x = xa in funcset_mem, assumption+)
 apply (frule_tac f = "prod_tOp I B x" and A = "carr_prodag I B" and
         x = xa in funcset_mem, assumption+)
 apply (subgoal_tac "∀k∈I. aGroup (B k)") 
 apply (rule carr_prodag_mem_eq, assumption+)
 apply (rule ballI, simp add:prod_tOp_def) 
 apply (rule ballI, rule Ring.ring_is_ag, simp)
apply (subgoal_tac "∀k∈I. aGroup (A k)")
 apply (simp add:prodag_sameTr1)
 apply (rule ballI, rule Ring.ring_is_ag, simp)
done

lemma prodrg_sameTr6:"⟦∀k∈I. Ring (A k); ∀k∈I. A k = B k⟧
                               ⟹ prod_one I A = prod_one I B"
apply (frule prod_one_func [of "I" "A"])
apply (cut_tac prodag_sameTr1[of "I" "A" "B"])
apply (rule carr_prodag_mem_eq[of I A "prod_one I A" "prod_one I B"])
apply (simp add:Ring.ring_is_ag, assumption)
 apply (cut_tac prod_one_func [of "I" "B"], simp)
 apply simp
 apply (rule ballI, simp add:prod_one_def)
 apply (simp add:Ring.ring_is_ag, simp)
done

lemma prodrg_same:"⟦∀k∈I. Ring (A k); ∀k∈I. A k = B k⟧
                               ⟹ prodrg I A = prodrg I B"
apply (subgoal_tac "∀k∈I. aGroup (A k)")
apply (frule prodag_sameTr1, assumption+) 
apply (frule prodag_sameTr2, assumption+) 
apply (frule prodag_sameTr3, assumption+)
apply (frule prodag_sameTr4, assumption+)
apply (frule prodrg_sameTr5, assumption+)
apply (frule prodrg_sameTr6, assumption+)
apply (simp add:prodrg_def)
apply (rule ballI, rule Ring.ring_is_ag, simp)
done

lemma prodrg_component:"⟦f ∈ carrier (prodrg I A); i ∈ I⟧ ⟹
                                 f i ∈ carrier (A i)"
by (simp add:prodrg_def carr_prodag_def)

lemma project_rhom:"⟦∀k∈I. Ring (A k); j ∈ I⟧ ⟹
                         PRoject I A j ∈ rHom ( prodrg I A) (A j)"
apply (simp add:rHom_def)
apply (rule conjI)
 apply (simp add:aHom_def)
 apply (rule conjI)
 apply (rule Pi_I)
 apply (simp add:prodrg_carrier)
 apply (cut_tac prodag_carrier[of I A], simp)

 apply (simp add:PRoject_def)
 apply (cut_tac prodag_carrier[of I A], simp,
        thin_tac "carrier (aΠ⇘I⇙ A) = carr_prodag I A")
 apply (simp add:prodag_comp_i) 
 apply (simp add:Ring.ring_is_ag)
 apply (simp add:Ring.ring_is_ag)

 apply (subgoal_tac "∀k∈I. aGroup (A k)") 
 apply (frule project_aHom [of "I" "A" "j"], assumption+) 
 apply (rule conjI)
 apply (simp add:prodrg_carrier aHom_def)
 apply (simp add:prodrg_carrier)
 apply (simp add:prodrg_pOp)
 apply (simp add:prodag_pOp[THEN sym])
 apply (simp add:aHom_def)

 apply (rule ballI, simp add:Ring.ring_is_ag)

 apply (rule conjI)
 apply (rule ballI)+
 apply (simp add:prodrg_carrier)
 apply (cut_tac prodag_carrier[of I A], simp) 
 apply (frule_tac X = x and Y = y in prod_tOp_mem[of I A], assumption+)
 apply (simp add:prodrg_tOp)
 apply (simp add:PRoject_def)
 apply (simp add:prod_tOp_def)
 
 apply (rule ballI)
 apply (simp add:Ring.ring_is_ag)

apply (frule prodrg_ring [of "I" "A"])
apply (frule Ring.ring_one[of "rΠ⇘I⇙ A"])
 apply (simp add:prodrg_carrier)
 apply (cut_tac prodag_carrier[of I A], simp)
 apply (simp add:PRoject_def) apply (simp add:prodrg_def)
 apply (fold prodrg_def) apply (simp add:prod_one_def) 

apply (rule ballI)
 apply (simp add:Ring.ring_is_ag) 
done

lemma augm_funcTr:"⟦∀k ≤(Suc n). Ring (B k); 
                       f ∈ carr_prodag {i. i ≤ (Suc n)} B⟧ ⟹ 
 f = augm_func n (restrict f {i. i ≤ n}) (Un_carrier {i. i ≤ n} B) (Suc 0)  
     (λx∈{0::nat}. f (x + Suc n)) 
             (Un_carrier {0} (compose {0} B (slide (Suc n))))"
apply (rule carr_prodag_mem_eq [of "{i. i ≤ (Suc n)}" "B" "f"
 "augm_func n (restrict f {i. i ≤ n}) (Un_carrier {i. i ≤ n} B) (Suc 0)
 (λx∈{0}. f (x + Suc n)) (Un_carrier {0} (compose {0} B (slide (Suc n))))"])
 apply (rule ballI, simp add:Ring.ring_is_ag)
 apply (simp add:augm_func_def)
 apply (simp add:carr_prodag_def)
 apply (rule conjI)
 apply (simp add:augm_func_def)
 apply (rule conjI)
 apply (rule Pi_I)
 apply (simp add:augm_func_def sliden_def) 
 apply (erule conjE)+
 apply (frule_tac x = x in funcset_mem[of f "{i. i ≤ Suc n}" 
                           "Un_carrier {i. i ≤ Suc n} B"]) apply simp
 apply simp 
 apply (rule impI)
  apply (rule_tac x = "Suc n" in funcset_mem[of f "{i. i ≤ Suc n}" 
                  "Un_carrier {i. i ≤ Suc n} B"], assumption) apply simp
 apply (rule allI, (erule conjE)+) 
 apply (simp add:augm_func_def)
 apply (case_tac "i ≤ n", simp add:sliden_def)
 apply (simp add:sliden_def, rule impI) 
 apply (simp add:nat_not_le_less,
        frule_tac m = n and n = i in Suc_leI,
        frule_tac m = i and n = "Suc n" in Nat.le_antisym, assumption+,
        simp)
 
 apply (rule ballI, simp) 
 apply (simp add:augm_func_def sliden_def)
 apply (rule impI, simp add:nat_not_le_less)
  apply (frule_tac n = l in Suc_leI[of n _])
  apply (frule_tac m = l and n = "Suc n" in Nat.le_antisym, assumption+,
         simp)
done

lemma A_to_prodag_mem:"⟦Ring A; ∀k∈I. Ring (B k);  ∀k∈I. (S k) ∈ 
 rHom A (B k); x ∈ carrier A ⟧ ⟹ A_to_prodag A I S B x ∈ carr_prodag I B"
apply (simp add:carr_prodag_def)
apply (rule conjI)
apply (simp add:A_to_prodag_def extensional_def) 
apply (rule conjI)
 apply (rule Pi_I)
 apply (simp add: A_to_prodag_def)
 apply (subgoal_tac "(S xa) ∈ rHom A (B xa)") prefer 2 apply simp
 apply (thin_tac "∀k∈I. S k ∈ rHom A (B k)") 
 apply (frule_tac f = "S xa" and A = A and R = "B xa" in rHom_mem, assumption+)
 apply (simp add:Un_carrier_def) apply blast
apply (rule ballI)

apply (simp add:A_to_prodag_def)
 apply (rule_tac f = "S i" and A = A and R = "B i" and a = x in rHom_mem)
   apply simp 
   apply assumption
done

lemma A_to_prodag_rHom:"⟦Ring A; ∀k∈I. Ring (B k); ∀k∈I. (S k) ∈ 
      rHom A (B k) ⟧  ⟹ A_to_prodag A I S B ∈ rHom A (rΠ⇘I⇙ B)"
apply (simp add:rHom_def [of "A" "rΠ⇘I⇙ B"])
apply (rule conjI)
 apply (cut_tac A_to_prodag_aHom[of A I B S])
 apply (subst aHom_def, simp)
 apply (simp add:prodrg_carrier)
 apply (simp add:aHom_def)
 apply (simp add:prodrg_def)
 apply (cut_tac prodag_pOp[of I B], simp)

 apply (rule ballI, simp add:Ring.ring_is_ag,
        simp add:Ring.ring_is_ag,
        rule ballI, simp add:Ring.ring_is_ag)

 apply (rule ballI) 
 apply (simp add:rHom_def)

apply (rule conjI)
 apply (rule ballI)+
 apply (frule_tac x = x and y = y in Ring.ring_tOp_closed[of A], assumption+)
 apply (frule_tac x = "x ⋅⇩r⇘A⇙ y" in A_to_prodag_mem[of A I B S], assumption+,
        frule_tac x = x in A_to_prodag_mem[of A I B S], assumption+,
        frule_tac x = y in A_to_prodag_mem[of A I B S], assumption+)
 apply (simp add:prodrg_tOp[of I B])
 apply (frule_tac X = "A_to_prodag A I S B x " and Y = "A_to_prodag A I S B y"         in prod_tOp_mem[of I B], assumption+)
apply (cut_tac X = "A_to_prodag A I S B (x ⋅⇩r⇘A⇙ y)" and Y = "prod_tOp I B (A_to_prodag A I S B x) (A_to_prodag A I S B y)" in carr_prodag_mem_eq[of I B])
 apply (rule ballI, simp add:Ring.ring_is_ag) apply assumption+
 apply (rule ballI, simp add:prod_tOp_def A_to_prodag_def)
 apply (frule_tac x = l in bspec, assumption,
        thin_tac "∀k∈I. Ring (B k)",
        frule_tac x = l in bspec, assumption,
        thin_tac "∀k∈I. S k ∈ rHom A (B k)")
 apply (simp add:rHom_tOp) apply simp

 apply (simp add:prodrg_one[of I B])
 apply (frule prod_one_func[of I B])
 apply (frule Ring.ring_one[of A],
        frule_tac x = "1⇩r⇘A⇙" in A_to_prodag_mem[of A I B S], assumption+)
 apply (cut_tac X = "A_to_prodag A I S B 1⇩r⇘A⇙" and Y = "prod_one I B" in 
        carr_prodag_mem_eq[of I B])
 apply (rule ballI, simp add:Ring.ring_is_ag)
 apply assumption+
 apply (rule ballI)
 apply (subst A_to_prodag_def, simp add:prod_one_def)
 apply (frule_tac x = l in bspec, assumption,
        thin_tac "∀k∈I. Ring (B k)",
        frule_tac x = l in bspec, assumption,
        thin_tac "∀k∈I. S k ∈ rHom A (B k)")
 apply (simp add:rHom_one)
 apply assumption
done 

lemma ac_fProd_ProdTr1:"∀k ≤ (Suc n). Ring (B k) ⟹ 
 ag_setfunc n B (Suc 0) (compose {0::nat} B (slide (Suc n))) 
   (carr_prodag {i. i ≤ n} B) (carr_prodag {0} 
     (compose {0} B (slide (Suc n)))) ⊆  carr_prodag {i. i ≤ (Suc n)} B" 
supply [[simproc del: defined_all]]
apply (rule subsetI)
apply (simp add:ag_setfunc_def) 
apply (erule exE, erule conjE, erule exE, erule conjE)
apply (simp,
       thin_tac "x =
        augm_func n g (Un_carrier {j. j ≤ n} B) (Suc 0) h
         (Un_carrier {0} (compose {0} B (slide (Suc n))))")
apply (simp add:carr_prodag_def [of "{j. j ≤ (Suc n)}" "B"])
apply (rule conjI)
 apply (simp add:augm_func_def)
apply (rule conjI) 
 apply (simp add:Pi_def) apply (rule allI) apply (rule impI)
 apply (simp add:augm_func_def)
 apply (case_tac "x ≤ n")
 apply simp apply (simp add:carr_prodag_def)
 apply (erule conjE)+ apply (frule_tac x = x in mem_of_Nset [of _ "n"])
 apply (frule_tac f = g and x = x in funcset_mem[of _ "{j. j ≤ n}" 
                      "Un_carrier {j. j ≤ n} B"], assumption+)
 apply (simp add:Un_carrier_def,
        erule exE, erule conjE, erule exE, simp, erule conjE,
        frule_tac x = i and y = n and z = "Suc n" in le_less_trans,
        simp, 
        frule_tac x = i and y = "Suc n" in less_imp_le, blast)
 apply (simp add:sliden_def)
 apply (simp add:carr_prodag_def Un_carrier_def, (erule conjE)+)
 apply (simp add:compose_def slide_def)
 apply (cut_tac n_in_Nsetn[of "Suc n"], blast)
 apply (rule allI, rule impI)
 apply (simp add:augm_func_def) 
 apply (case_tac "i ≤ n", simp)
 apply (simp add:carr_prodag_def [of "{i. i ≤ n}" _])
 apply simp apply (thin_tac "g ∈ carr_prodag {i. i ≤ n} B")
 apply (simp add: not_less [symmetric, of _ n],
        frule_tac n = i in Suc_leI[of n],
        frule_tac m = i and n = "Suc n" in le_antisym, assumption+, simp)
 apply (simp add:carr_prodag_def compose_def slide_def sliden_def)
done

lemma ac_fProd_Prod:"∀k ≤ n. Ring (B k) ⟹ 
                      ac_fProd_Rg n B = carr_prodag {j. j ≤ n} B"
apply (case_tac "n = 0") 
 apply simp
 apply (subgoal_tac "∃m. n = Suc m")
 apply (subgoal_tac "∀m. n = Suc m ⟶ 
                     ac_fProd_Rg n B = carr_prodag {j. j ≤ n} B")
 apply blast apply (thin_tac "∃m. n = Suc m")
 apply (rule allI, rule impI) apply (simp, thin_tac "n = Suc m")
 apply (rule equalityI)
 apply (simp add:ac_fProd_ProdTr1)
 apply (rule subsetI)
 apply (rename_tac m f)  
apply (frule augm_funcTr, assumption+)
 apply (simp add:ag_setfunc_def)
 apply (subgoal_tac "(restrict f {j. j ≤ m}) ∈ carr_prodag {j. j ≤ m} B")
 apply (subgoal_tac "(λx∈{0::nat}. f (Suc (x + m))) ∈  carr_prodag {0}
                           (compose {0} B (slide (Suc m)))")
 
 apply blast
 apply (thin_tac "f =
           augm_func m (restrict f {i. i ≤ m}) (Un_carrier {i. i ≤ m} B)
            (Suc 0) (λx∈{0}. f (Suc (x + m)))
            (Un_carrier {0} (compose {0} B (slide (Suc m))))")
 apply (simp add:carr_prodag_def)
 apply (rule conjI)
 apply (simp add:Pi_def restrict_def)
 apply (simp add:Un_carrier_def compose_def slide_def)
 apply (simp add:compose_def slide_def)

 apply (thin_tac "f =
           augm_func m (restrict f {i. i ≤ m}) (Un_carrier {i. i ≤ m} B)
            (Suc 0) (λx∈{0}. f (Suc (x + m)))
            (Un_carrier {0} (compose {0} B (slide (Suc m))))")
 apply (simp add:carr_prodag_def)
 apply (simp add:Un_carrier_def)
 apply (simp add:Pi_def)
 apply (rule allI) apply (rule impI)
apply (erule conjE)+
 apply (rotate_tac 1) 
 apply (frule_tac a = x in forall_spec, simp)
 apply (erule exE,
        thin_tac "∀x≤Suc m. ∃xa. (∃i≤Suc m. xa = carrier (B i)) ∧ f x ∈ xa")
 apply (frule_tac a = x in forall_spec, simp)
apply blast
apply (cut_tac t = n in Suc_pred[THEN sym], simp)
apply blast
done

text‹A direct product of a finite number of rings defined with
 ‹ac_fProd_Rg› is equal to that defined by using ‹carr_prodag›.›

definition
 fprodrg :: "[nat, nat ⇒ ('a, 'more) Ring_scheme] ⇒ 
  ⦇carrier:: (nat ⇒ 'a) set, pop::[(nat ⇒ 'a), (nat ⇒ 'a)]
   ⇒ (nat ⇒ 'a), mop:: (nat ⇒ 'a) ⇒ (nat ⇒ 'a), zero::(nat ⇒ 'a), 
   tp :: [(nat ⇒ 'a), (nat ⇒ 'a)] ⇒ (nat ⇒ 'a), un :: (nat ⇒ 'a) ⦈" where
  
  "fprodrg n B = ⦇ carrier = ac_fProd_Rg n B,
     pop = λf. λg. prod_pOp {i. i ≤ n} B f g, mop = λf. prod_mOp {i. i ≤ n} B f,
     zero = prod_zero {i. i ≤ n} B, tp =  λf. λg. prod_tOp {i. i ≤ n} B f g, 
     un = prod_one {i. i ≤ n} B ⦈"  

definition
  fPRoject ::"[nat, nat ⇒ ('a, 'more) Ring_scheme, nat]
                   ⇒ (nat ⇒ 'a) ⇒ 'a" where
  "fPRoject n B x = (λf∈ac_fProd_Rg n B. f x)"

lemma fprodrg_ring:"∀k ≤ n. Ring (B k) ⟹ Ring (fprodrg n B)"
apply (simp add:fprodrg_def)
apply (frule ac_fProd_Prod)
apply simp 
 apply (fold prodrg_def)
apply (simp add:prodrg_ring)
done


section "Chinese remainder theorem"

lemma Chinese_remTr1:"⟦Ring A; ∀k ≤ (n::nat). ideal A (J k); 
 ∀k ≤ n. B k = qring A (J k); ∀k ≤ n. S k = pj A (J k) ⟧ ⟹
   ker⇘A,(rΠ⇘{j. j ≤ n}⇙ B)⇙ (A_to_prodag A {j. j ≤ n} S B) = 
                                        ⋂ {I. ∃k∈{j. j ≤ n}. I = (J k)}" 
apply (rule equalityI)
 apply (rule subsetI)
 apply (simp add:ker_def)
 apply (rule allI, rule impI)
 apply (rename_tac a K, erule conjE)
 apply (simp add:prodrg_def, simp add:A_to_prodag_def prod_one_def)
 apply (erule exE, erule conjE) 
 
 apply (subgoal_tac "(λk∈{j. j ≤ n}. S k a) k = (λx∈{j. j ≤ n}. 𝟬⇘B x⇙) k")
 apply (thin_tac "(λk∈{j. j ≤ n}. S k a) = prod_zero {j. j ≤ n} B")
 apply simp  apply (frule_tac I = "J k" in Ring.qring_zero [of "A"])
 apply simp
 apply (frule_tac I = "J k" and x = a in pj_mem [of "A"]) apply simp
 apply assumption apply simp
 apply (frule_tac I = "J k" and a = a in Ring.a_in_ar_coset [of "A"])
 apply simp apply assumption apply simp
 apply (simp add:prod_zero_def)
apply (rule subsetI)
 apply (simp add:CollectI ker_def)

 apply (cut_tac Nset_inc_0[of n]) 
 apply (frule_tac a = "J 0" in forall_spec, blast)
 apply (frule_tac x = 0 in spec, simp)
 apply (frule_tac h = x in Ring.ideal_subset [of "A" "J 0"], simp+)
 apply (thin_tac "x ∈ J 0")
 apply (simp add:A_to_prodag_def prodrg_def)
 apply (simp add:prod_zero_def)
 apply (rule funcset_eq [of _ "{j. j ≤ n}"])
 apply (simp add:extensional_def restrict_def)+
 apply (rule allI, rule impI) 
 apply (simp add:Ring.qring_zero)
 apply (frule_tac a = xa in forall_spec, assumption,
        thin_tac "∀k ≤ n. ideal A (J k)")
 apply (subst pj_mem [of "A"], assumption+)
 apply (frule_tac I = "J xa" and a = x in Ring.a_in_ar_coset [of "A"], 
        assumption+) 
 apply (rule_tac a = x and I = "J xa" in Ring.Qring_fix1 [of "A"], assumption+)
 apply blast 
done

lemma (in Ring) coprime_prod_int2Tr:
"((∀k ≤ (Suc n). ideal R (J k)) ∧ 
 (∀i ≤ (Suc n). ∀j ≤ (Suc n). (i ≠j ⟶ coprime_ideals R (J i) (J j))))
  ⟶ (⋂ {I. ∃k ≤ (Suc n). I = (J k)} = ideal_n_prod R (Suc n) J)"
apply (induct_tac n)
apply (rule impI)
 apply (erule conjE) 
 apply (simp add:Nset_1) 
 apply (subst coprime_int_prod [THEN sym, of "J 0" "J (Suc 0)"], simp+)
 apply (rule equalityI, rule subsetI)
 apply (simp, blast)
 apply (rule subsetI, simp, rule allI, rule impI, erule exE, (erule conjE)+)
 apply simp
 apply (simp add:Nset_1_1, erule disjE, (simp del:ideal_n_prodSn)+)

(** n **)
apply (rule impI)
 apply (subgoal_tac "⋂{I. ∃k ≤ (Suc (Suc n)). I = J k} =
              (⋂{I. ∃k ≤ (Suc n). I = J k}) ∩ (J (Suc (Suc n)))")
 apply (subgoal_tac "⋂{I. ∃k ≤ (Suc n). I = J k} = (iΠ⇘R,(Suc n)⇙ J)")
(* apply (simp del:ideal_n_prodSn)*) 
 apply (frule_tac n = "Suc n" and J = J in coprime_n_idealsTr4)
  apply (simp del:ideal_n_prodSn)
 apply (subst coprime_int_prod)
 apply (rule n_prod_ideal)
 apply (rule allI, simp, simp, assumption) 
 apply simp apply (cut_tac n = "Suc n" in Nsetn_sub_mem1)
 apply simp
 apply (thin_tac "(∀k≤Suc n. ideal R (J k)) ∧
         (∀i≤Suc n. ∀j≤Suc n. i ≠ j ⟶ coprime_ideals R (J i) (J j)) ⟶
         ⋂{I. ∃k≤Suc n. I = J k} = iΠ⇘R,Suc n⇙ J",
        thin_tac "(∀k≤Suc (Suc n). ideal R (J k)) ∧
         (∀i≤Suc (Suc n).
             ∀j≤Suc (Suc n). i ≠ j ⟶ coprime_ideals R (J i) (J j))")
 apply (rule equalityI, rule subsetI, simp)
 apply (rule conjI,
        rule allI, rule impI, erule exE, erule conjE, simp,
        frule_tac a = xa in forall_spec,
        frule_tac x = k and y = "Suc n" and z = "Suc (Suc n)" in 
        le_less_trans, simp,
        frule_tac x = k and y = "Suc (Suc n)" in less_imp_le, blast)
 apply simp 
 apply (frule_tac a = "J (Suc (Suc n))" in forall_spec,
        cut_tac n = "Suc (Suc n)" in le_refl, blast, simp)
 
 apply (rule subsetI, simp, rule allI, rule impI)
 apply (erule exE, erule conjE)
 apply (erule conjE, 
        case_tac "k = Suc (Suc n)", simp)
 apply (frule_tac m = k and n = "Suc (Suc n)" in noteq_le_less, assumption,
        thin_tac "k ≤ Suc (Suc n)")
 apply (frule_tac x = k and n = "Suc n" in Suc_less_le)
 apply (frule_tac a = xa in forall_spec, 
        blast,
        thin_tac "∀xa. (∃k≤Suc n. xa = J k) ⟶ x ∈ xa",
        simp)
done

lemma (in Ring) coprime_prod_int2:"⟦ ∀k ≤ (Suc n). ideal R (J k); 
 ∀i ≤ (Suc n). ∀j ≤ (Suc n). (i ≠j ⟶ coprime_ideals R (J i) (J j))⟧
 ⟹ (⋂ {I. ∃k ≤ (Suc n). I = (J k)} = ideal_n_prod R (Suc n) J)"
apply (simp add:coprime_prod_int2Tr)
done

lemma (in Ring) coprime_2_n:"⟦ideal R A; ideal R B⟧ ⟹
 (qring R A) ⨁⇩r (qring R B) = rΠ⇘{j. j ≤ (Suc 0)}⇙ (prodB1 (qring R A) (qring R B))"
apply (simp add:Prod2Rg_def Nset_1)
done

text‹In this and following lemmata, ideals A and B are of type 
       ‹('a, 'more) RingType_scheme›. Don't try 
       ‹(rΠ⇩(Nset n) B) ⨁⇩r B (Suc n)››

lemma (in Ring) A_to_prodag2_hom:"⟦ideal R A; ideal R B; S 0 = pj R A; 
      S (Suc 0) = pj R B⟧  ⟹ 
      A_to_prodag R {j. j ≤ (Suc 0)} S (prodB1 (qring R A) (qring R B)) ∈ 
      rHom R (qring R A ⨁⇩r qring R B)"
apply (subst coprime_2_n [of "A" "B"], assumption+)
apply (rule A_to_prodag_rHom, rule Ring_axioms)
apply (rule ballI)
apply (case_tac "k = 0")
apply (simp add:prodB1_def)
apply (simp add:qring_ring)
apply (simp)
 apply (frule_tac n = k in Suc_leI[of 0], thin_tac "0 < k")
 apply (frule_tac m = k and n = "Suc 0" in le_antisym, assumption)
 apply (simp, simp add:prodB1_def, simp add:qring_ring)

apply (rule ballI)
 apply (simp add:Nset_1)
 apply (erule disjE) 
 apply (simp add:prodB1_def, rule pj_Hom, rule Ring_axioms, assumption)
 apply (simp, simp add:prodB1_def)
 apply (rule pj_Hom, rule Ring_axioms, assumption+)
done

lemma (in Ring) A2coprime_rsurjecTr:"⟦ideal R A; ideal R B; S 0 = pj R A; 
      S (Suc 0) = pj R B⟧ ⟹ 
      (carrier (qring R A ⨁⇩r qring R B)) = 
        carr_prodag {j. j ≤ (Suc 0)} (prodB1 (qring R A) (qring R B))"
apply (simp add:Prod2Rg_def prodrg_def Nset_1)
done

lemma (in Ring) A2coprime_rsurjec:"⟦ideal R A; ideal R B; S 0 = pj R A; 
      S (Suc 0) = pj R B; coprime_ideals R A B⟧ ⟹ 
      surjec⇘R,((qring R A) ⨁⇩r (qring R B))⇙ 
           (A_to_prodag R {j. j≤(Suc 0)} S (prodB1 (qring R A) (qring R B)))"
apply (frule A_to_prodag2_hom [of "A" "B" "S"], assumption+)
apply (simp add:surjec_def)
apply (rule conjI, 
       simp add:rHom_def)
apply (rule surj_to_test[of "A_to_prodag R {j. j ≤ (Suc 0)} S 
       (prodB1 (qring R A) (qring R B))" "carrier R" 
        "carrier (qring R A ⨁⇩r qring R B)"])
 apply (simp add:rHom_def aHom_def)

 apply (rule ballI)
 apply (frule rHom_func[of "A_to_prodag R {j. j ≤ (Suc 0)} S 
                                   (prodB1 (R /⇩r A) (R /⇩r B))" R],
        thin_tac "A_to_prodag R {j. j ≤ (Suc 0)} S (prodB1 (R /⇩r A) (R /⇩r B))
         ∈ rHom R (R /⇩r A ⨁⇩r R /⇩r B)")
 apply (simp add:A2coprime_rsurjecTr[of A B S])
 apply (simp add:Nset_1)
 apply (frule_tac X = "b 0" and Y = "b (Suc 0)" in 
                  coprime_surjTr[of A B], assumption+)
 apply (simp add:carr_prodag_def prodB1_def,
        simp add:carr_prodag_def prodB1_def) 

 apply (erule bexE)
 apply (frule_tac x = r in funcset_mem[of "A_to_prodag R {0, Suc 0} S 
        (prodB1 (R /⇩r A) (R /⇩r B))"
         "carrier R" "carr_prodag {0, Suc 0} (prodB1 (R /⇩r A) (R /⇩r B))"],
         assumption+)
 apply (cut_tac X = "A_to_prodag R {0, Suc 0} S (prodB1 (R /⇩r A) (R /⇩r B)) r" 
        and Y = b in 
        carr_prodag_mem_eq[of "{0, Suc 0}" "prodB1 (R /⇩r A) (R /⇩r B)"])
  apply (rule ballI)
  apply (simp, erule disjE)
  apply (simp add:prodB1_def, fold prodB1_def, 
                                simp add:qring_ring Ring.ring_is_ag)
  apply (simp add:prodB1_def, fold prodB1_def, 
                               simp add:qring_ring Ring.ring_is_ag)
  apply assumption+
  apply (rule ballI, simp, erule disjE, simp)
  apply (subst A_to_prodag_def, simp)
  apply (subst A_to_prodag_def, simp)
 apply blast
done

lemma (in Ring) prod2_n_Tr1:"⟦∀k ≤ (Suc 0). ideal R (J k); 
      ∀k ≤ (Suc 0). B k = qring R (J k); 
      ∀k ≤ (Suc 0). S k = pj R (J k) ⟧  ⟹ 
    A_to_prodag R {j. j ≤ (Suc 0)} S 
            (prodB1 (qring R (J 0)) (qring R (J (Suc 0)))) = 
                               A_to_prodag R {j. j ≤ (Suc 0)} S B"
apply (subgoal_tac "∀k ≤ (Suc 0). (prodB1 (qring R (J 0)) (qring R (J (Suc 0)))) k = B k") 
apply (simp add:A_to_prodag_def)
apply (rule allI, rule impI)
 apply (case_tac "k = 0", simp add:Nset_1_1)
 apply (simp add:prodB1_def)
 apply (simp add:Nset_1_1)
 apply (simp add:prodB1_def)
done  

lemma (in aGroup) restrict_prod_Suc:"⟦∀k ≤ (Suc (Suc n)). ideal R (J k);
        ∀k ≤ (Suc (Suc n)). B k = R /⇩r J k;
        ∀k ≤ (Suc (Suc n)). S k = pj R (J k);
        f ∈ carrier (rΠ⇘{j. j ≤ (Suc (Suc n))}⇙ B)⟧ ⟹ 
        restrict f {j. j ≤ (Suc n)} ∈ carrier (rΠ⇘{j. j ≤ (Suc n)}⇙ B)"
apply (cut_tac Nsetn_sub_mem1[of "Suc n"])
 apply (simp add:prodrg_def) 
 apply (simp add:carr_prodag_def, (erule conjE)+)
 apply (simp add:Un_carrier_def)
 apply (rule Pi_I)
 apply simp
 apply (frule_tac x = x in funcset_mem[of f "{j. j ≤ (Suc (Suc n))}"
        "⋃{X. ∃i ≤ (Suc (Suc n)). X = carrier (R /⇩r J i)}"],
        simp)
 apply simp
 apply (erule exE, erule conjE, erule exE, erule conjE, simp)
 
 apply (rotate_tac -5) 
 apply (frule_tac a = x in forall_spec) apply simp
 apply blast
done

lemma (in Ring) Chinese_remTr2:"(∀k ≤ (Suc n). ideal R (J k)) ∧ 
     (∀k≤(Suc n). B k = qring R (J k)) ∧ 
     (∀k≤(Suc n). S k = pj R (J k)) ∧ 
     (∀i≤(Suc n). ∀j≤ (Suc n). (i ≠j ⟶ 
     coprime_ideals R (J i) (J j))) ⟶ 
     surjec⇘R,(rΠ⇘{j. j≤ (Suc n)}⇙ B)⇙ 
                   (A_to_prodag R {j. j≤(Suc n)} S B)"
apply (cut_tac Ring)
apply (induct_tac n)
(* case n = 0, i.e. two coprime_ideals *)  (** use coprime_surjTr **)
apply (rule impI) apply (erule conjE)+
 apply (frule  A_to_prodag_rHom [of R "{j. j ≤ Suc 0}" "B" "S"])
 apply (rule ballI, simp add:Ring.qring_ring)
 apply (rule ballI, simp add:pj_Hom) 
 apply (frule rHom_func[of "A_to_prodag R {j. j ≤ (Suc 0)} S B" R 
                           "rΠ⇘{j. j ≤ (Suc 0)}⇙ B"])
 apply (simp add:surjec_def)  
  apply (rule conjI)
  apply (simp add:rHom_def)
 apply (rule surj_to_test, assumption+)
 apply (rule ballI) apply (simp add:Nset_1) 
 apply (cut_tac coprime_elems [of "J 0" "J (Suc 0)"])
 apply (rename_tac f)
 apply (erule bexE, erule bexE)
 apply (simp add:prodrg_def) apply (fold prodrg_def)
 apply (cut_tac X = "f 0" and Y = "f (Suc 0)" in 
                  coprime_surjTr[of "J 0" "J (Suc 0)"], simp+)
 apply (simp add:carr_prodag_def, simp add:carr_prodag_def)
 apply (erule bexE, (erule conjE)+)
 apply (frule_tac x = r in funcset_mem[of "A_to_prodag R {0, Suc 0} S B"
        "carrier R" "carr_prodag {0, Suc 0} B"], assumption+)
 apply (cut_tac X = "A_to_prodag R {0, Suc 0} S B r" and Y = f in 
         carr_prodag_mem_eq[of "{0, Suc 0}" B])
  apply (rule ballI, simp, erule disjE, simp add:qring_ring 
                           Ring.ring_is_ag,
         simp add:Ring.qring_ring Ring.ring_is_ag)
  apply assumption+
  apply (rule ballI, simp, erule disjE, simp)
  apply (simp add:A_to_prodag_def, simp add:A_to_prodag_def)
  apply blast apply simp+
 
 apply (rule impI, (erule conjE)+)
 
(**** n ****)
 apply (cut_tac n = "Suc n" in Nsetn_sub_mem1)
apply (subgoal_tac "∀k∈{i. i ≤ Suc (Suc n)}. Ring (B k)")
apply (frule_tac I = "{i. i ≤ Suc (Suc n)}"  in A_to_prodag_rHom [of "R" _ "B" "S"])
 apply assumption 
 apply (rule ballI)
 apply (simp add:pj_Hom)
 apply simp
 apply (subst surjec_def, rule conjI,
        simp add:rHom_def)
 apply (cut_tac n = "Suc n" in coprime_n_idealsTr4[of  _ J])
 apply blast
 apply (frule_tac f = "A_to_prodag R {j. j ≤ (Suc (Suc n))} S B" and 
        A = R in rHom_func)
 apply (rule_tac f = "A_to_prodag R {j. j ≤ (Suc (Suc n))} S B" and
        A = "carrier R" and B = "carrier (rΠ⇘{j. j ≤ (Suc (Suc n))}⇙ B)" in
        surj_to_test, assumption+)
 apply (rule ballI)
 apply (cut_tac n = "Suc n" in n_prod_ideal[of  _ J])
 apply (rule allI, simp)
 apply (frule_tac A = "iΠ⇘R,(Suc n)⇙ J" and B = "J (Suc (Suc n))" in 
        coprime_elems,
        cut_tac n = "Suc (Suc n)" in n_in_Nsetn,
        blast, assumption)
 apply (erule bexE, erule bexE) apply (rename_tac n f a b)
 apply (thin_tac " coprime_ideals R (iΠ⇘R,(Suc n)⇙ J) (J (Suc (Suc n)))")
 apply (cut_tac n = "Suc n" and a = a and J = J in ele_n_prod,
        rule allI, simp, assumption)

 apply (cut_tac ring_is_ag)
 apply (frule_tac n = n and f = f in aGroup.restrict_prod_Suc[of R _ R J B S],
          assumption+)
 apply (frule_tac S = "rΠ⇘{j. j ≤ (Suc n)}⇙ B" and 
        f = "A_to_prodag R {j. j ≤ (Suc n)} S B" in surjec_surj_to[of R]) 
 apply (frule_tac f = "A_to_prodag R {j. j ≤ (Suc n)} S B" and A = "carrier R"
        and B = "carrier (rΠ⇘{j. j ≤  (Suc n)}⇙ B)" and 
        b = "restrict f {j. j ≤ (Suc n)}" in surj_to_el2, assumption)
 apply (erule bexE, rename_tac n f a b u)
 apply (cut_tac n = "Suc (Suc n)" in n_in_Nsetn,
        frule_tac f = f and I = "{j. j ≤ (Suc (Suc n))}" and A = B and 
         i = "Suc (Suc n)" in prodrg_component, assumption)  
 apply simp
 apply (frule_tac J = "J (Suc (Suc n))" and X = "f (Suc (Suc n))" in 
                pj_surj_to[of R], simp, assumption)
 apply (erule bexE, rename_tac n f a b u v)
 apply (frule_tac a = "Suc (Suc n)" in forall_spec, simp,
        frule_tac I = "J (Suc (Suc n))" and h = b in Ring.ideal_subset[of R],
        assumption+,
        cut_tac I = "iΠ⇘R,n⇙ J ♢⇩r⇘R⇙ J (Suc n)" and h = a in 
                       Ring.ideal_subset[of R], assumption+)
 apply (frule_tac x = b and y = u in  Ring.ring_tOp_closed[of R], assumption+,
        frule_tac x = a and y = v in  Ring.ring_tOp_closed[of R], assumption+,
       frule Ring.ring_is_ag[of R],
       frule_tac x = "b ⋅⇩r⇘R⇙ u" and y = "a ⋅⇩r⇘R⇙ v" in aGroup.ag_pOp_closed[of R],
       assumption+)
 apply (frule_tac f = "A_to_prodag R {j. j ≤ (Suc (Suc n))} S B" and 
        A = "carrier R" and B = "carrier (rΠ⇘{j. j ≤ (Suc (Suc n))}⇙ B)" and
        x = "b ⋅⇩r⇘R⇙ u ±⇘R⇙ a ⋅⇩r⇘R⇙ v" in funcset_mem, assumption+)
apply (frule_tac f = "A_to_prodag R {j. j ≤ (Suc (Suc n))} S B 
                       (b ⋅⇩r⇘R⇙ u ±⇘R⇙ a ⋅⇩r⇘R⇙ v)" and I = "{j. j ≤ (Suc (Suc n))}"
           and  g = f in carr_prodrg_mem_eq, simp)    
 apply (rule ballI)
 apply (subst A_to_prodag_def, simp)
 apply (frule_tac I = "J i" in pj_Hom[of R], simp)
 apply (simp add: rHom_add)
 apply (frule_tac a = i in forall_spec, assumption,
        thin_tac "∀k ≤ (Suc (Suc n)). ideal R (J k)",
        frule_tac I = "J i" in Ring.qring_ring[of R], assumption,
        thin_tac "∀k ≤ (Suc (Suc n)). Ring (R /⇩r J k)",
        frule_tac R = "R /⇩r (J i)" and x = b and y = u and f = "pj R (J i)" in
         rHom_tOp[of R], assumption+, simp,
     thin_tac "pj R (J i) (b ⋅⇩r⇘R⇙ u) = pj R (J i) b ⋅⇩r⇘R /⇩r J i⇙ pj R (J i) u",
     frule_tac R = "R /⇩r (J i)" and x = a and y = v and f = "pj R (J i)" in
     rHom_tOp[of R], simp add:Ring.qring_ring, assumption+)
  apply (frule_tac f = "pj R (J i)" and R = "R /⇩r J i" and a = v in
                    rHom_mem[of _ R], assumption+,
         frule_tac f = "pj R (J i)" and R = "R /⇩r J i" and a = u in
                    rHom_mem[of _ R], assumption+,
         frule_tac f = "pj R (J i)" and R = "R /⇩r J i" and a = b in
                    rHom_mem[of _ R], assumption+,
         frule_tac f = "pj R (J i)" and R = "R /⇩r J i" and a = a in
                    rHom_mem[of _ R], assumption+)
      apply (frule_tac R = "R /⇩r J i" in Ring.ring_is_ag)
  apply (case_tac "i ≤ (Suc n)")
  apply (frule_tac I1 = "J i" and x1 = a in pj_zero[THEN sym, of R ],
            assumption+, simp,
    thin_tac "pj R (J i) (a ⋅⇩r⇘R⇙ v) = 𝟬⇘R /⇩r J i⇙ ⋅⇩r⇘R /⇩r J i⇙ pj R (J i) v")
         apply (simp add:Ring.ring_times_0_x) 
  apply (frule_tac f = "pj R (J i)" and A = R and R = "R /⇩r J i" and
                 x = a and y = b in rHom_add, assumption+, simp,
         thin_tac "A_to_prodag R {j. j ≤ Suc (Suc n)} S B
         (b ⋅⇩r u) ±⇘rΠ⇘{i. i ≤ Suc (Suc n)}⇙ B⇙
        A_to_prodag R {j. j ≤ Suc (Suc n)} S B (a ⋅⇩r v)
        ∈ carrier (rΠ⇘{j. j ≤ Suc (Suc n)}⇙ B)")

  apply (simp add:aGroup.ag_l_zero)
  apply (rotate_tac -1, frule sym, thin_tac " pj R (J i) 1⇩r⇘R⇙ = pj R (J i) b",
         simp add:rHom_one) apply (simp add:Ring.ring_l_one)
         apply (simp add:aGroup.ag_r_zero)
  apply (frule_tac f = "A_to_prodag R {j. j ≤ (Suc n)} S B u" and 
          g = "restrict f {j. j ≤ (Suc n)}" and x = i in eq_fun_eq_val,
    thin_tac "A_to_prodag R {j. j≤(Suc n)} S B u = restrict f {j. j≤(Suc n)}")
  apply (simp add:A_to_prodag_def) 
  apply simp
  apply (frule_tac y = i and x = "Suc n" in not_le_imp_less, 
         frule_tac m = "Suc n" and n = i in Suc_leI,
         frule_tac m = i and n = "Suc (Suc n)" in Nat.le_antisym, assumption+,
         simp)
  apply (frule_tac I1 = "J (Suc (Suc n))" and x1 = b in pj_zero[THEN sym, of
          R ],  assumption+, simp add:Ring.ring_times_0_x) 
   apply (frule_tac f = "pj R (J (Suc (Suc n)))" and A = R and 
          R = "R /⇩r J (Suc (Suc n))" and
                 x = a and y = b in rHom_add, assumption+, simp)      
   apply (simp add:aGroup.ag_r_zero)
   apply (rotate_tac -1, frule sym, 
          thin_tac "pj R (J (Suc (Suc n))) 1⇩r⇘R⇙ = pj R (J (Suc (Suc n))) a",
          simp add:rHom_one,
          simp add:Ring.ring_l_one)
   apply (simp add:aGroup.ag_l_zero)

   apply blast
   apply (rule ballI, simp add:Ring.qring_ring)
done

lemma (in Ring) Chinese_remTr3:"⟦∀k ≤ (Suc n). ideal R (J k); 
      ∀k ≤ (Suc n). B k = qring R (J k); ∀k≤ (Suc n). S k = pj R (J k); 
  ∀i ≤ (Suc n). ∀j ≤ (Suc n). (i ≠j ⟶ coprime_ideals R (J i) (J j))⟧ ⟹
    surjec⇘R,(rΠ⇘{j. j ≤ (Suc n)}⇙ B)⇙ 
                   (A_to_prodag R {j. j ≤ (Suc n)} S B)"
apply (simp add:Chinese_remTr2 [of  "n" "J" "B" "S"])
done

lemma (in Ring) imset:"⟦∀k≤ (Suc n). ideal R (J k)⟧
⟹ {I. ∃k≤ (Suc n). I = J k} = {J k| k. k ∈ {j. j ≤ (Suc n)}}"
apply blast
done

theorem (in Ring) Chinese_remThm:"⟦(∀k ≤ (Suc n). ideal R (J k)); 
 ∀k≤(Suc n). B k = qring R (J k); ∀k ≤ (Suc n). S k = pj R (J k); 
 ∀i ≤ (Suc n). ∀j ≤ (Suc n). (i ≠j ⟶ coprime_ideals R (J i) (J j))⟧ 
⟹ bijec⇘(qring R (⋂ {J k | k. k∈{j. j ≤ (Suc n)}})),(rΠ⇘{j. j ≤ (Suc n)}⇙ B)⇙ 
     ((A_to_prodag R {j. j ≤ (Suc n)} S B)°⇘R,(prodrg {j. j ≤ (Suc n)} B)⇙)"
apply (frule Chinese_remTr3, assumption+)
apply (cut_tac I = "{j. j ≤ (Suc n)}" and A = B in prodrg_ring)
  apply (rule ballI, simp add:qring_ring)
apply (cut_tac surjec_ind_bijec [of "R" "rΠ⇘{j. j ≤ (Suc n)}⇙ B" 
                   "A_to_prodag R {j. j ≤ (Suc n)} S B"])
apply (cut_tac Ring,
       simp add:Chinese_remTr1 [of "R" "Suc n" "J" "B" "S"])
apply (simp add:imset, rule Ring_axioms, assumption+)
apply (rule A_to_prodag_rHom, rule Ring_axioms)
 apply (rule ballI)
 apply (simp add:qring_ring)
 apply (rule ballI, simp, rule pj_Hom, rule Ring_axioms, simp)
 apply assumption
done

lemma (in Ring) prod_prime:"⟦ideal R A; ∀k≤(Suc n). prime_ideal R (P k);
      ∀l≤(Suc n). ¬ (A ⊆ P l); 
      ∀k≤ (Suc n). ∀l≤ (Suc n). k = l ∨ ¬ (P k) ⊆ (P l)⟧ ⟹ 
     ∀i ≤ (Suc n). (nprod R (ppa R P A i) n ∈ A ∧ 
        (∀l ∈ {j. j≤(Suc n)} - {i}. nprod R (ppa R P A i) n ∈ P l) ∧ 
        (nprod R (ppa R P A i) n ∉ P i))"
apply (rule allI, rule impI)
apply (rule conjI)
apply (frule_tac i = i in prod_primeTr1[of n P A], assumption+)
apply (frule_tac n = n and f = "ppa R P A i" in ideal_nprod_inc[of  A])
  apply (rule allI, rule impI)
  apply (rotate_tac -2, 
         frule_tac a = ia in forall_spec, assumption,
         thin_tac "∀l ≤ n.
           ppa R P A i l ∈ A ∧
           ppa R P A i l ∈ P (skip i l) ∧ ppa R P A i l ∉ P i",
         simp add:ideal_subset)
  apply (rotate_tac -1, 
         frule_tac a = n in forall_spec, simp,
         thin_tac "∀l≤ n.
            ppa R P A i l ∈ A ∧
            ppa R P A i l ∈ P (skip i l) ∧ ppa R P A i l ∉ P i",
         (erule conjE)+, 
         blast, assumption)
apply (frule_tac i = i in prod_primeTr1[of n P A], assumption+)
apply (rule conjI)
 apply (rule ballI)
 apply (frule_tac a = l in forall_spec, simp,
        frule_tac I = "P l" in prime_ideal_ideal) 
apply (frule_tac n = n and f = "ppa R P A i" and A = "P l" in ideal_nprod_inc)
 apply (rule allI) apply (simp add:ppa_mem, simp)
 apply (case_tac "l < i",
        thin_tac "∀l≤ (Suc n). ¬ A ⊆ P l",
        thin_tac "∀k≤ (Suc n). ∀l ≤ (Suc n). k = l ∨ ¬ P k ⊆ P l")
  apply (erule conjE,
         frule_tac x = l and y = i and z = "Suc n" in less_le_trans,
         assumption,
         frule_tac x = l and n = n in Suc_less_le)
  apply (rotate_tac 2, 
         frule_tac a = l in forall_spec, assumption,
         thin_tac "∀l≤n. ppa R P A i l ∈ A ∧
                 ppa R P A i l ∈ P (skip i l) ∧ ppa R P A i l ∉ P i",
         thin_tac "l < Suc n")
  apply (simp only:skip_im_Tr1_2, blast)
  apply (frule_tac x = l and y = i in leI,
         thin_tac "¬ l < i",
         cut_tac x = l and A = "{j. j ≤ (Suc n)}" and a = i in in_diff1)
         apply simp  
         apply (erule conjE,
         frule not_sym, thin_tac "l ≠ i",
         frule_tac x = i and y = l in le_imp_less_or_eq,
         erule disjE, thin_tac "i ≤ l",
         frule_tac x = i and n = l in less_le_diff) 
  apply (cut_tac i = i and n = n and x = "l - Suc 0" in skip_im_Tr2_1,
         simp, assumption+, simp,
         frule_tac x = l and n = n in le_Suc_diff_le) 
  apply (rotate_tac -7,
         frule_tac a = "l - Suc 0" in forall_spec, assumption,
         thin_tac "∀l≤n. ppa R P A i l ∈ A ∧
                 ppa R P A i l ∈ P (skip i l) ∧ ppa R P A i l ∉ P i",
         simp, (erule conjE)+)
  apply blast
  apply simp
  apply assumption
    apply (frule_tac a = i in forall_spec, assumption,
           thin_tac "∀k≤ (Suc n). prime_ideal R (P k)") 
    apply (rule_tac P = "P i" and n = n and f = "ppa R P A i" in
             prime_nprod_exc, assumption+)
    apply (rule allI, rule impI)
    apply (rotate_tac -3, 
           frule_tac a = ia in forall_spec, assumption,
           thin_tac "∀l ≤ n.
           ppa R P A i l ∈ A ∧
           ppa R P A i l ∈ P (skip i l) ∧ ppa R P A i l ∉ P i",
           simp add:ideal_subset)
    apply (rule allI, rule impI) apply (
           rotate_tac 4,
           frule_tac a = l in forall_spec, assumption,
           thin_tac "∀l≤ n.
            ppa R P A i l ∈ A ∧
            ppa R P A i l ∈ P (skip i l) ∧ ppa R P A i l ∉ P i",
           simp)
done

lemma skip_im1:"⟦i ≤ (Suc n); P ∈ {j. j ≤ (Suc n)} → Collect (prime_ideal R)⟧
    ⟹
   compose {j. j ≤ n} P (skip i) ` {j. j ≤ n} = P ` ({j. j ≤ (Suc n)} - {i})"
apply (cut_tac skip_fun[of i n])
apply (subst setim_cmpfn[of _ _ _ _ "{X. prime_ideal R X}"], assumption+)
apply  simp
apply (simp add:skip_fun_im)
done

lemma (in Ring) mutch_aux1:"⟦ideal R A; i ≤ (Suc n);
        P ∈ {j. j ≤ (Suc n)} → Collect (prime_ideal R)⟧ ⟹ 
        compose {j. j ≤ n} P (skip i) ∈ {j. j ≤ n} → Collect (prime_ideal R)"
apply (cut_tac skip_fun[of i n])
apply (simp add:composition[of "skip i" "{j. j ≤ n}" "{j. j ≤ (Suc n)}" P 
            "Collect (prime_ideal R)"])
done

lemma (in Ring) prime_ideal_cont1Tr:"ideal R A  ⟹ 
      ∀P. ((P ∈ {j. j ≤ (n::nat)} → {X. prime_ideal R X}) ∧ 
                   (A ⊆ ⋃ (P ` {j. j ≤ n}))) ⟶ (∃i≤ n. A ⊆ (P i))"
apply (induct_tac n)
 apply (rule allI, rule impI)
 apply (erule conjE)
 apply simp 
(** n **)
apply (rule allI, rule impI)
 apply (erule conjE)+ 
 apply (case_tac "∃i ≤ (Suc n). ∃j≤ (Suc n). (i ≠ j ∧ P i ⊆ P j)")
 apply ((erule exE, erule conjE)+, erule conjE)
 apply (frule_tac f = P and n = n and X = "{X. prime_ideal R X}" and
         A = A and i = i and j = j in Un_less_Un, assumption+, simp+)
 apply (frule mutch_aux1, assumption+)
 apply (frule_tac a = "compose {j. j ≤ n} P (skip i)" in forall_spec,
        simp, erule exE)
 apply (cut_tac i = i and n = n and x = ia in skip_fun_im1,
               simp+, erule conjE, simp add:compose_def,blast)
 (** last_step induction assumption is of no use **)
apply (thin_tac "∀P. P ∈ {j. j ≤ n} → {X. prime_ideal R X} ∧
               A ⊆ ⋃(P ` {j. j ≤ n}) ⟶
               (∃i≤n. A ⊆ P i)",
       rule contrapos_pp, simp+)
 apply (cut_tac n = n and P = P in prod_prime [of A], assumption)
 apply (rule allI, rule impI,
     frule_tac f = P and A = "{j. j ≤ (Suc n)}" and B = "{X. prime_ideal R X}"
     and x = k in funcset_mem, simp, simp, assumption+) 
 apply (frule_tac n = "Suc n" and 
        f = "λi∈{j. j ≤ (Suc n)}. (nprod R (ppa R P A i) n)" in 
        nsum_ideal_inc[of A], rule allI, rule impI, simp)
 apply (subgoal_tac "(nsum R (λi∈{j. j ≤ (Suc n)}. nprod R (ppa R P A i) n) 
        (Suc n)) ∉ (⋃x∈{j. j ≤ (Suc n)}. P x)")
 apply blast
 apply (simp del:nsum_suc)
 apply (rule allI, rule impI) apply (rename_tac n P l)
  apply (frule_tac f = P and A = "{j. j ≤ (Suc n)}" and 
         B = "{X. prime_ideal R X}"
         and x = l in funcset_mem, simp, simp del:nsum_suc,
         frule_tac I = "P l" in prime_ideal_ideal)
  apply (rule_tac A = "P l" and n = "Suc n" and 
         f = "λi∈{j. j ≤ (Suc n)}. (nprod R (ppa R P A i) n)" in 
         nsum_ideal_exc, simp+, rule allI, simp add:ideal_subset)
  apply (rule contrapos_pp, simp+)
  apply (rotate_tac -1,
         frule_tac a = l in forall_spec, simp,
         thin_tac "∀j≤Suc n.
           (∃la∈{i. i ≤ Suc n} - {j}. eΠ⇘R,n⇙ ppa R P A la ∉ P l) ∨
           eΠ⇘R,n⇙ ppa R P A j ∈ P l",
         thin_tac "∀i≤Suc n. ∀j≤Suc n. i = j ∨ ¬ P i ⊆ P j",
         thin_tac "∀i≤Suc n. ¬ A ⊆ P i")
  apply (erule disjE, erule bexE) 
  apply (frule_tac a = la in forall_spec, simp,
         thin_tac "∀i≤Suc n.
           eΠ⇘R,n⇙ ppa R P A i ∈ A ∧
           (∀l∈{j. j ≤ Suc n} - {i}. eΠ⇘R,n⇙ ppa R P A i ∈ P l) ∧
           eΠ⇘R,n⇙ ppa R P A i ∉ P i",
           (erule conjE)+)
  apply blast
  apply blast
done
 
lemma (in Ring) prime_ideal_cont1:"⟦ideal R A; ∀i ≤ (n::nat). 
     prime_ideal R (P i); A ⊆ ⋃ {X. (∃i ≤ n. X = (P i))} ⟧ ⟹ 
     ∃i≤ n. A⊆(P i)"
apply (frule prime_ideal_cont1Tr[of A n])
apply (frule_tac a = P in forall_spec,
       thin_tac "∀P. P ∈ {j. j ≤ n} → {X. prime_ideal R X} ∧ 
       A ⊆ ⋃(P ` {j. j ≤ n}) ⟶ (∃i≤n. A ⊆ P i)")
apply (rule conjI, simp,
       rule subsetI, simp,
       frule_tac c = x in subsetD[of A "⋃{X. ∃i≤n. X = P i}"], assumption+,
       simp, blast)
apply assumption
done

lemma (in Ring) prod_n_ideal_contTr0:"(∀l≤ n. ideal R (J l)) ⟶
                               iΠ⇘R,n⇙ J  ⊆  ⋂{X. (∃k≤n. X = (J k))}"
apply (induct_tac n)
 apply simp 

 apply (rule impI)
 apply (cut_tac n = n in Nsetn_sub_mem1,
         simp)
 apply (cut_tac n = n in n_prod_ideal[of _ J], simp)
 apply (cut_tac I = "iΠ⇘R,n⇙ J" and J = "J (Suc n)" in 
             ideal_prod_sub_Int) apply assumption apply simp
 apply (frule_tac A = "iΠ⇘R,n⇙ J ♢⇩r⇘R⇙ J (Suc n)" and 
        B = "iΠ⇘R,n⇙ J ∩ J (Suc n)" and
        C = "⋂{X. ∃k≤ n. X = J k} ∩ J (Suc n)" in subset_trans)
 apply (rule_tac A = "iΠ⇘R,n⇙ J" and B = "⋂{X. ∃k≤n. X = J k}" and 
        C = "J (Suc n)" in inter_mono, assumption)
 apply (rule_tac A = "iΠ⇘R,n⇙ J ♢⇩r J (Suc n)" and
                 B = "⋂{X. ∃k≤ n. X = J k} ∩ J (Suc n)" and
                 C = "⋂{X. ∃k≤ (Suc n). X = J k}" in subset_trans,
         assumption)
 apply (rule subsetI)
  apply simp 
  apply (rule allI, rule impI) 
  apply (erule exE, (erule conjE)+)
  apply (case_tac "k = Suc n", simp)
  apply (frule_tac m = k and n = "Suc n" in noteq_le_less, assumption)
  apply (thin_tac " k ≤ Suc n")
  apply (frule_tac x = k and n = "Suc n" in less_le_diff,
         thin_tac "k < Suc n", simp, thin_tac "∀l≤Suc n. ideal R (J l)")
  apply (frule_tac a = xa in forall_spec, blast,
         thin_tac "∀xa. (∃k≤n. xa = J k) ⟶ x ∈ xa",
         simp)
done

lemma (in Ring) prod_n_ideal_contTr:"⟦∀l≤ n. ideal R (J l)⟧ ⟹
             iΠ⇘R,n⇙ J  ⊆  ⋂{X. (∃k ≤ n. X = (J k))}"
apply (simp add:prod_n_ideal_contTr0)
done

lemma (in Ring) prod_n_ideal_cont2:"⟦∀l≤ (n::nat). ideal R (J l); 
     prime_ideal R P; ⋂{X. (∃k≤ n. X = (J k))} ⊆ P⟧ ⟹ 
     ∃l≤ n. (J l) ⊆ P"
apply (frule prod_n_ideal_contTr[of n J])
apply (frule_tac A = "iΠ⇘R,n⇙ J" and B = "⋂{X. ∃k≤ n. X = J k}" and C = P 
       in subset_trans, assumption+)
apply (thin_tac "⋂{X. ∃k≤ n. X = J k} ⊆ P",
       thin_tac "iΠ⇘R,n⇙ J ⊆ ⋂{X. ∃k≤ n. X = J k}")
 apply (simp add:ideal_n_prod_prime)
done

lemma (in Ring) prod_n_ideal_cont3:"⟦∀l≤ (n::nat). ideal R (J l); 
      prime_ideal R P; ⋂{X. (∃k≤ n. X = (J k))} = P⟧ ⟹ 
      ∃l≤ n. (J l) = P"
apply (frule prod_n_ideal_cont2[of n J P], assumption+)
 apply simp
 apply (erule exE)
 apply (subgoal_tac "J l = P")
 apply blast
apply (rule equalityI, simp)
 apply (rule subsetI)
 apply (rotate_tac -4, frule sym, thin_tac "⋂{X. ∃k≤ n. X = J k} = P") 
 apply simp
 apply blast
done

definition
  ideal_quotient :: "[_ , 'a set, 'a set] ⇒ 'a set" where
  "ideal_quotient R A B = {x| x. x ∈ carrier R ∧ (∀b∈B. x ⋅⇩r⇘R⇙ b ∈ A)}"

abbreviation
  IDEALQT  ("(3_/ †⇩_/ _)" [82,82,83]82) where
  "A †⇩R B == ideal_quotient R A B"


lemma (in Ring) ideal_quotient_is_ideal:
  "⟦ideal R A; ideal R B⟧ ⟹ ideal R (ideal_quotient R A B)"
apply (rule ideal_condition)
 apply (rule subsetI) 
 apply (simp add:ideal_quotient_def CollectI)
 apply (simp add:ideal_quotient_def)
 apply (cut_tac ring_zero)
 apply (subgoal_tac "∀b∈B. 𝟬 ⋅⇩r b ∈ A")
 apply blast
 apply (rule ballI)
 apply (frule_tac h = b in ideal_subset[of B], assumption)
 apply (frule_tac x = b in ring_times_0_x )
 apply (simp add:ideal_zero)
apply (rule ballI)+
 apply (simp add:ideal_quotient_def, (erule conjE)+,
        rule conjI)
 apply (rule ideal_pOp_closed)
 apply (simp add:whole_ideal, assumption+)
 apply (cut_tac ring_is_ag)
 apply (simp add:aGroup.ag_mOp_closed)
apply (rule ballI)
apply (subst ring_distrib2) 
 apply (simp add:ideal_subset, assumption)
 apply (cut_tac ring_is_ag, simp add: aGroup.ag_mOp_closed)
 apply (frule_tac a1 = y and b1 = b in ring_inv1_1 [THEN sym])
 apply (simp add:ideal_subset, simp)
 apply (rule ideal_pOp_closed, assumption+, simp)
 apply (rule ideal_inv1_closed, assumption+, simp) 
apply (rule ballI)+
 apply (simp add:ideal_quotient_def)
 apply (rule conjI) 
  apply (erule conjE) 
  apply (simp add:ring_tOp_closed)
 apply (erule conjE)
apply (rule ballI)
 apply (subst ring_tOp_assoc, assumption+, simp add:ideal_subset)
 apply (simp add:ideal_ring_multiple [of "A"])
done

section ‹Addition of finite elements of a ring and ‹ideal_multiplication››
text‹We consider sum in an abelian group›

lemma (in aGroup) nsum_mem1Tr:" A +> J  ⟹  
                     (∀j ≤ n. f j ∈ J)  ⟶ nsum A f n ∈ J"
apply (induct_tac n)
 apply (rule impI) 
 apply simp
apply (rule impI) 
 apply simp
 apply (rule asubg_pOp_closed, assumption+)
 apply simp
done

lemma (in aGroup) fSum_mem:"⟦∀j ∈ nset (Suc n) m. f j ∈ carrier A; n < m⟧ ⟹
                   fSum A f (Suc n) m ∈ carrier A" 
apply (simp add:fSum_def)
apply (rule nsum_mem)
apply (rule allI, simp add:cmp_def slide_def)
apply (rule impI)
apply (frule_tac x = "Suc (n + j)" in bspec)
 apply (simp add:nset_def, arith)
done

lemma (in aGroup) nsum_mem1:"⟦A +> J; ∀j ≤ n. f j ∈ J⟧ ⟹ nsum A f n ∈ J"
apply (simp add:nsum_mem1Tr)
done 
   
lemma (in aGroup) nsum_eq_i:"⟦∀j≤n. f j ∈ carrier A; ∀j≤n. g j ∈ carrier A;
 i ≤ n; ∀l ≤ i. f l = g l⟧ ⟹ nsum A f i = nsum A g i"
apply (rule nsum_eq)
apply (rule allI, rule impI, simp)+
done

lemma (in aGroup) nsum_cmp_eq:"⟦f ∈ {j. j≤(n::nat)} → carrier A; 
 h1 ∈ {j. j ≤ n} → {j. j ≤ n};  h2 ∈ {j. j ≤ n} → {j. j ≤ n}; i ≤ n⟧ ⟹
 nsum A (cmp f (cmp h2 h1)) i = nsum A (cmp (cmp f h2) h1) i"
apply (rule nsum_eq_i [of n "cmp f (cmp h2 h1)" "cmp (cmp f h2) h1" i])
apply (rule allI, rule impI, simp add:cmp_def)
apply ((rule funcset_mem, assumption)+, simp) 
apply (rule allI, rule impI, simp add:cmp_def,
        (rule funcset_mem, assumption)+, simp+)
apply (rule allI, rule impI, simp add:cmp_def)
done

lemma (in aGroup) nsum_cmp_eq_transpos:"⟦ ∀j≤(Suc n). f j ∈ carrier A; 
       i ≤ n;i ≠ n ⟧ ⟹
 nsum A (cmp f (cmp (transpos i n) (cmp (transpos n (Suc n)) (transpos i n))))
 (Suc n) = nsum A (cmp f (transpos i (Suc n))) (Suc n)" 
apply (rule nsum_eq [of "Suc n" "cmp f (cmp (transpos i n) 
                            (cmp (transpos n (Suc n)) (transpos i n)))" 
       "cmp f (transpos i (Suc n))"])
apply (rule allI, rule impI)
apply (simp add:cmp_def)
apply (cut_tac i = i and n = "Suc n" and j = n and l = j in transpos_mem,
       simp+) 
apply (cut_tac i = n and n = "Suc n" and j = "Suc n" and l = "transpos i n j"
        in transpos_mem, simp+)
apply (cut_tac i = i and n = "Suc n" and j = n and
        l = "transpos n (Suc n) (transpos i n j)" in transpos_mem,
       simp+) 
apply (rule allI, rule impI, simp add:cmp_def)
apply (cut_tac i = i and n = "Suc n" and j = "Suc n" and l = j in transpos_mem,
       simp+)
apply (rule allI, rule impI)
 apply (simp add:cmp_def)
 apply (thin_tac "∀j≤Suc n. f j ∈ carrier A",
        rule eq_elems_eq_val[of _ _ f])
 apply (simp add:transpos_def)
done

lemma transpos_Tr_n1:"Suc (Suc 0) ≤ n ⟹ 
                           transpos (n - Suc 0) n n = n - Suc 0"
apply (simp add:transpos_def)
done

lemma transpos_Tr_n2:"Suc (Suc 0) ≤ n ⟹ 
               transpos (n - (Suc 0)) n (n - (Suc 0)) = n"
apply (simp add:transpos_def) 
done

lemma (in aGroup) additionTr0:"⟦0 < n; ∀j ≤ n. f j ∈ carrier A⟧
 ⟹ nsum A (cmp f (transpos (n - 1) n)) n = nsum A f n" 
apply (case_tac "n ≤ 1")
 apply simp
 apply (frule Suc_leI [of "0" "n"])
 apply (frule le_antisym [of "n" "Suc 0"], assumption+, simp)
 apply (simp add:cmp_def)
 apply (subst transpos_ij_1[of 0 "Suc 0"], simp+)
 apply (subst transpos_ij_2[of 0 "Suc 0"], simp+)
 apply (rule ag_pOp_commute, simp+)
 apply (frule not_le_imp_less[of n "Suc 0"])
apply (frule_tac Suc_leI [of "Suc 0" "n"],
       thin_tac "¬ n ≤ Suc 0")
 apply (cut_tac nsum_suc[of A f "n - Suc 0"], simp)
 apply (cut_tac nsum_suc[of A "cmp f (transpos (n - Suc 0) n)" "n - Suc 0"], 
        simp,
        thin_tac "Σ⇩e A f n = Σ⇩e A f (n - Suc 0) ± f n",
        thin_tac "Σ⇩e A (cmp f (transpos (n - Suc 0) n)) n =
     Σ⇩e A (cmp f (transpos (n - Suc 0) n)) (n - Suc 0) ±
     (cmp f (transpos (n - Suc 0) n) n)")
apply (case_tac "n = Suc (Suc 0)", simp)
 apply (cut_tac transpos_id_1[of "Suc 0" "Suc (Suc 0)" "Suc (Suc 0)" 0],
        cut_tac transpos_ij_1[of "Suc 0" "Suc (Suc 0)" "Suc (Suc 0)"],
        cut_tac transpos_ij_2[of "Suc 0" "Suc (Suc 0)" "Suc (Suc 0)"],
        simp add:cmp_def,
        thin_tac "n = Suc (Suc 0)",
        thin_tac "transpos (Suc 0) (Suc (Suc 0)) 0 = 0",
        thin_tac "transpos (Suc 0) (Suc (Suc 0)) (Suc 0) = Suc (Suc 0)",
        thin_tac "transpos (Suc 0) (Suc (Suc 0)) (Suc (Suc 0)) = Suc 0")
 apply (subst ag_pOp_assoc, simp+)
 apply (subst ag_pOp_commute[of "f (Suc (Suc 0))" "f (Suc 0)"], simp+)
  apply (subst ag_pOp_assoc[THEN sym], simp+)

 apply (frule not_sym)
 apply (frule noteq_le_less[of "Suc (Suc 0)" n], assumption,
        thin_tac "Suc (Suc 0) ≤ n")
 apply (cut_tac nsum_suc[of A f "n - Suc 0 - Suc 0"])
 apply (cut_tac Suc_pred[of "n - Suc 0"], simp del:nsum_suc)
 apply (cut_tac nsum_suc[of A "cmp f (transpos (n - Suc 0) n)"  
                "n - Suc (Suc 0)"], simp del:nsum_suc,
     thin_tac "Σ⇩e A f (n - Suc 0) = Σ⇩e A f (n - Suc (Suc 0)) ± f (n - Suc 0)",
     thin_tac "Suc (n - Suc (Suc 0)) = n - Suc 0",
     thin_tac "Σ⇩e A (cmp f (transpos (n - Suc 0) n)) (n - Suc 0) =
     Σ⇩e A (cmp f (transpos (n - Suc 0) n)) (n - Suc (Suc 0)) ±
     (cmp f (transpos (n - Suc 0) n)) (n - Suc 0)")
 apply (cut_tac nsum_eq_i[of n "cmp f (transpos (n - Suc 0) n)" f 
                 "n - Suc (Suc 0)"], simp,   
        thin_tac "Σ⇩e A (cmp f (transpos (n - Suc 0) n)) (n - Suc (Suc 0)) =
     Σ⇩e A f (n - Suc (Suc 0))")
 apply (simp add:cmp_def)
 apply (cut_tac transpos_ij_1[of "n - Suc 0" n n], simp)
 apply (cut_tac transpos_ij_2[of "n - Suc 0" n n], simp) 
 apply (subst ag_pOp_assoc,
        rule nsum_mem, rule allI, rule impI)
 apply (frule_tac x = j and y = "n - Suc (Suc 0)" and z = n in 
        le_less_trans, simp, frule_tac x = j and y = n in less_imp_le)
        apply simp+
 apply (subst ag_pOp_commute[of "f n"], simp, simp)
 apply (subst ag_pOp_assoc[THEN sym],
         rule nsum_mem, rule allI, rule impI,
         frule_tac x = j and y = "n - Suc (Suc 0)" and z = n in 
         le_less_trans, simp, frule_tac x = j and y = n in less_imp_le)
        apply simp+ 

 apply (rule allI, rule impI, simp add:cmp_def)
 apply (cut_tac i = "n - Suc 0" and n = n and j = n and l = j in transpos_mem,
        simp+) 
 
 apply (rule allI, rule impI)
 apply (simp add:cmp_def)
 apply (cut_tac i = "n - Suc 0" and n = n and j = n and x = l in transpos_id,
        simp+) 

 apply (cut_tac x = l and y = "n - Suc (Suc 0)" and z = n in le_less_trans,
        assumption) apply simp
 apply arith
 apply simp
 apply arith
done

lemma (in aGroup) additionTr1:"⟦ ∀f. ∀h. f ∈ {j. j≤(Suc n)} → carrier A ∧
       h ∈ {j. j≤(Suc n)} → {j. j≤(Suc n)} ∧ inj_on h {j. j≤(Suc n)} ⟶
       nsum A (cmp f h) (Suc n) = nsum A f (Suc n); 
       f ∈ {j. j≤(Suc (Suc n))} → carrier A; 
       h ∈ {j. j≤(Suc (Suc n))} → {j. j≤(Suc (Suc n))}; 
       inj_on h {j. j≤(Suc (Suc n))}; h (Suc (Suc n)) = Suc (Suc n)⟧
        ⟹ nsum A (cmp f h) (Suc (Suc n)) = nsum A f (Suc (Suc n))"
apply (subgoal_tac "f ∈ {j. j≤(Suc n)} → carrier A")
apply (subgoal_tac "h ∈ {j. j≤(Suc n)} → {j. j≤(Suc n)}")
apply (subgoal_tac "inj_on h {j. j≤(Suc n)}")
apply (subgoal_tac "nsum A (cmp f h) (Suc n) = nsum A f (Suc n)")
apply (thin_tac "∀f. ∀h. f ∈ {j. j≤(Suc n)} → carrier A ∧
       h ∈ {j. j≤(Suc n)} → {j. j≤(Suc n)} ∧ inj_on h {j. j≤(Suc n)} ⟶
       nsum A (cmp f h) (Suc n) = nsum A f (Suc n)")
prefer 2 apply simp
apply simp
 apply (thin_tac "nsum A (cmp f h) n ± (cmp f h (Suc n)) =  nsum A f n ± (f (Suc n))")
 apply (simp add:cmp_def)
 apply (thin_tac "∀f h. (f ∈ {j. j ≤ Suc n} → carrier A) ∧
           (h ∈ {j. j≤Suc n} → {j. j≤Suc n}) ∧ (inj_on h {j. j≤Suc n}) ⟶
           Σ⇩e A (cmp f h) (Suc n) = Σ⇩e A f (Suc n)")
 apply (frule Nset_injTr0 [of "h" "Suc n"], assumption+, simp) 
 apply (frule Nset_injTr0 [of "h" "Suc n"], assumption+, simp)
apply (simp add:Pi_def)
done

lemma (in aGroup) additionTr1_1:"⟦∀f. ∀h. f ∈ {j. j≤Suc n} → carrier A ∧
      h ∈ {j. j≤Suc n} → {j. j≤Suc n} ∧ inj_on h {j. j≤Suc n} ⟶
      nsum A (cmp f h) (Suc n) = nsum A f (Suc n); 
      f ∈ {j. j≤Suc (Suc n)} → carrier A; i ≤ n⟧ ⟹ 
    nsum A (cmp f (transpos i (Suc n))) (Suc (Suc n)) = nsum A f (Suc (Suc n))"
apply (rule additionTr1 [of "n" "f" "transpos i (Suc n)"], assumption+)
apply (rule transpos_hom [of "i" "Suc (Suc n)" "Suc n"])
 apply simp+
 apply (rule transpos_inj [of "i" "Suc (Suc n)" "Suc n"])
  apply simp+ 
  apply (subst transpos_id[of i "Suc (Suc n)" "Suc n" "Suc (Suc n)"])
  apply simp+
done

lemma (in aGroup) additionTr1_2:"⟦∀f. ∀h. f ∈ {j. j≤Suc n} → carrier A ∧
          h ∈ {j. j≤Suc n} → {j. j≤Suc n} ∧ 
          inj_on h {j. j≤Suc n} ⟶
          nsum A (cmp f h) (Suc n) = nsum A f (Suc n); 
         f ∈ {j. j≤ Suc (Suc n)} → carrier A; i ≤ (Suc n)⟧ ⟹ 
       nsum A (cmp f (transpos i (Suc (Suc n)))) (Suc (Suc n)) = 
                                             nsum A f (Suc (Suc n))"
apply (case_tac "i = Suc n")
 apply (simp del:nsum_suc) 
 apply (cut_tac additionTr0 [of "Suc (Suc n)" "f"], simp, simp,
         rule allI, rule impI, rule funcset_mem[of f "{j. j ≤ Suc (Suc n)}"
         "carrier A"], (simp del:nsum_suc)+)
 apply (subst nsum_cmp_eq_transpos [THEN sym, of "Suc n" f i],
        rule allI, rule impI, rule funcset_mem[of f "{j. j ≤ Suc (Suc n)}" 
        "carrier A"], assumption+,
        simp, assumption+)
 apply (subst nsum_cmp_eq [of "f" "Suc (Suc n)"  
        "cmp (transpos (Suc n) (Suc(Suc n))) (transpos i (Suc n))" 
        "transpos i (Suc n)" "Suc (Suc n)"], assumption+,
        rule Pi_I, simp add:cmp_def,
        rule transpos_mem, (simp del:nsum_suc)+,
        rule transpos_mem, (simp del:nsum_suc)+,
        rule Pi_I, simp,
        rule transpos_mem, (simp del:nsum_suc)+)
apply (subst nsum_cmp_eq [of "cmp f (transpos i (Suc n))" "Suc (Suc n)"  
       "(transpos i (Suc n))" "transpos (Suc n) (Suc (Suc n))" "Suc (Suc n)"],
       rule Pi_I, simp add:cmp_def,
       rule funcset_mem[of f "{j. j ≤ Suc (Suc n)}" "carrier A"], assumption,
       simp,
       rule transpos_mem, (simp del:nsum_suc)+,
       (rule Pi_I, simp,
        rule transpos_mem, (simp del:nsum_suc)+)+)

apply (subst additionTr1_1 [of "n" "cmp (cmp f (transpos i (Suc n)))
               (transpos (Suc n) (Suc (Suc n)))" "i"], assumption+,
       rule  cmp_fun [of _ "{j. j ≤ (Suc (Suc n))}" 
                       "{j. j ≤ (Suc (Suc n))}" _ "carrier A"],
       rule transpos_hom, simp, simp, simp,
       rule cmp_fun [of _ "{j. j ≤ (Suc (Suc n))}" 
                       "{j. j ≤ (Suc (Suc n))}" "f" "carrier A"],
       rule transpos_hom, simp, simp, assumption+, arith)
apply (cut_tac additionTr0 [of  "Suc (Suc n)" "cmp f (transpos i (Suc n))"],
       simp del:nsum_suc,
       thin_tac "nsum A (cmp 
  (cmp f (transpos i (Suc n))) (transpos (Suc n) (Suc (Suc n)))) (Suc (Suc n))
  = nsum A (cmp f (transpos i (Suc n))) (Suc (Suc n))")
apply (rule additionTr1_1, assumption+, arith, simp,
       rule allI, rule impI, simp add:cmp_def,
       rule funcset_mem[of f "{j. j ≤ Suc (Suc n)}" "carrier A"],
       assumption)
apply (simp add:transpos_mem)
done

lemma (in aGroup) additionTr2:" ∀f. ∀h. f ∈ {j. j ≤ (Suc n)} → carrier A ∧ 
        h ∈ {j. j ≤ (Suc n)} → {j. j ≤ (Suc n)} ∧ 
        inj_on h {j. j ≤ (Suc n)} ⟶ 
          nsum A (cmp f h) (Suc n) = nsum A f (Suc n)" 
apply (induct_tac n) 
 apply (rule allI)+
 apply (rule impI, (erule conjE)+)
 apply (simp add:cmp_def)
 apply (case_tac "h 0 = 0")
  apply (simp add:Nset_1)
  apply (simp add:Nset_1 ag_pOp_commute)

(************* n *****************)
apply (rule allI)+
apply (rule impI, (erule conjE)+)
apply (case_tac "h (Suc (Suc n)) = Suc (Suc n)") 
apply (rule additionTr1, assumption+)
apply (frule_tac f = h and n = "Suc (Suc n)" in inj_surj, assumption+)
 apply (frule sym, thin_tac "h ` {i. i ≤ Suc (Suc n)} = {i. i ≤ Suc (Suc n)}")
 apply (cut_tac n = "Suc (Suc n)" in n_in_Nsetn)
 apply (frule_tac a = "Suc (Suc n)" and A = "{i. i ≤ Suc (Suc n)}" and 
        B = "h ` {i. i ≤ Suc (Suc n)}" in eq_set_inc, assumption+)
 apply (thin_tac "{i. i ≤ Suc (Suc n)} = h ` {i. i ≤ Suc (Suc n)}")
 apply (simp del:nsum_suc add:image_def) 
 apply (erule exE, erule conjE)
 apply (frule sym, thin_tac "Suc (Suc n) = h x")
 apply (frule_tac i = x and n = "Suc (Suc n)" and j = "Suc (Suc n)" in 
                  transpos_ij_2, simp del:nsum_suc add:n_in_Nsetn)
        apply (rule contrapos_pp, (simp del:nsum_suc)+)
 apply (frule_tac x = "transpos x (Suc (Suc n)) (Suc (Suc n))" and y = x and 
        f = h in eq_elems_eq_val,
        thin_tac "transpos x (Suc (Suc n)) (Suc (Suc n)) = x",           
        simp del:nsum_suc)
 apply (frule_tac f = h and A = "{i. i ≤ Suc (Suc n)}" and x = x and 
                  y = "Suc (Suc n)" in inj_onTr2, simp, simp,
        frule not_sym, simp)
 apply (cut_tac f1 = "cmp f h" and n1 = n and i1 = x in 
        additionTr1_2[THEN sym], assumption)
 apply (rule cmp_fun, simp, assumption, arith)
 apply (simp del:nsum_suc,
        thin_tac "Σ⇩e A (cmp f h) (Suc (Suc n)) =
        Σ⇩e A (cmp (cmp f h) (transpos x (Suc (Suc n)))) (Suc (Suc n))")
 apply (frule_tac f = f and n = "Suc n" and A = "carrier A" in func_pre)
 apply (cut_tac f = "cmp h (transpos x (Suc (Suc n)))" and A = "{j. j ≤ (Suc (        Suc n))}" and ?A1.0 = "{j. j ≤ (Suc n)}" in restrict_inj)
 apply (rule_tac f = "transpos x (Suc (Suc n))" and A = "{j. j ≤ Suc (Suc n)}"
 and B = "{j. j ≤ Suc (Suc n)}" and g = h and C = "{j. j ≤ Suc (Suc n)}" in
  cmp_inj, simp,
  rule transpos_hom, simp, simp, assumption+,
  rule transpos_inj, simp, simp, assumption+,
  rule subsetI, simp)
apply (subst nsum_cmp_assoc,
       rule allI, rule impI, simp add:Pi_def,
       rule transpos_hom, assumption, simp, assumption+)
 apply (cut_tac f = "cmp f (cmp h (transpos x (Suc (Suc n))))" and n = "Suc n"
        in nsum_suc[of A ], simp del:nsum_suc,
   thin_tac "Σ⇩e A (cmp f (cmp h (transpos x (Suc (Suc n))))) (Suc (Suc n)) =
        Σ⇩e A (cmp f (cmp h (transpos x (Suc (Suc n))))) (Suc n) ±
        cmp f (cmp h (transpos x (Suc (Suc n)))) (Suc (Suc n))")
 apply (frule_tac x = f in spec,
        thin_tac "∀f h. f ∈ {j. j ≤ Suc n} → carrier A ∧
              h ∈ {j. j ≤ Suc n} → {j. j ≤ Suc n} ∧
              inj_on h {j. j ≤ Suc n} ⟶
              Σ⇩e A (cmp f h) (Suc n) = Σ⇩e A f (Suc n)")
 apply (frule_tac a = "cmp h (transpos x (Suc (Suc n)))" in forall_spec,
        thin_tac "∀h. f ∈ {j. j ≤ Suc n} → carrier A ∧
         h ∈ {j. j ≤ Suc n} → {j. j ≤ Suc n} ∧ inj_on h {j. j ≤ Suc n} ⟶
         Σ⇩e A (cmp f h) (Suc n) = Σ⇩e A f (Suc n)")
 apply simp
 apply (rule Pi_I)
 apply (simp add:cmp_def)
 apply (case_tac "xa = x", simp)
 apply (cut_tac i = x and n = "Suc (Suc n)" and j = "Suc (Suc n)" in 
         transpos_ij_1, simp, simp, simp, simp,
        frule_tac x = "Suc (Suc n)" and f = h and A = "{j. j ≤ Suc (Suc n)}"
         and B = "{j. j ≤ Suc (Suc n)}" in funcset_mem, simp,
        thin_tac "h ∈ {j. j ≤ Suc (Suc n)} → {j. j ≤ Suc (Suc n)}")
 apply (cut_tac m = "h (Suc (Suc n))" and n = "Suc (Suc n)" in noteq_le_less,
        simp, simp,
        rule_tac x = "h (Suc (Suc n))" and n = "Suc n" in Suc_less_le,
        assumption)
 apply (subst transpos_id, simp, simp, simp, simp,
        frule_tac x = xa and f = h and A = "{j. j ≤ Suc (Suc n)}" and 
        B = "{j. j ≤ Suc (Suc n)}" in funcset_mem, simp)
 apply (frule_tac f = h and A = "{j. j ≤ Suc (Suc n)}" and x = xa and y = x 
        in injective, simp, simp, assumption)
 apply (cut_tac m = "h xa" and n = "Suc (Suc n)" in noteq_le_less, simp,
        simp)
 apply (rule Suc_less_le, assumption,
        thin_tac "∀h. f ∈ {j. j ≤ Suc n} → carrier A ∧
        h ∈ {j. j ≤ Suc n} → {j. j ≤ Suc n} ∧ inj_on h {j. j ≤ Suc n} ⟶
        Σ⇩e A (cmp f h) (Suc n) = Σ⇩e A f (Suc n)")
 apply (simp del:nsum_suc add:cmp_def)
 apply simp
done

lemma (in aGroup) addition2:"⟦f ∈ {j. j ≤ (Suc n)} → carrier A; 
  h ∈ {j. j ≤ (Suc n)} → {j. j ≤ (Suc n)}; inj_on h {j. j ≤ (Suc n)}⟧ ⟹
  nsum A (cmp f h) (Suc n) = nsum A f (Suc n)"
apply (simp del:nsum_suc add:additionTr2)
done

lemma (in aGroup) addition21:"⟦f ∈ {j. j ≤ n} → carrier A; 
       h ∈ {j. j ≤ n} → {j. j ≤ n}; inj_on h {j. j ≤ n}⟧ ⟹
       nsum A (cmp f h) n = nsum A f n"
apply (case_tac "n = 0")
 apply (simp add: cmp_def)
 apply (cut_tac f = f and n = "n - Suc 0" and h = h in addition2)
 apply simp+
done

lemma (in aGroup) addition3:"⟦∀j ≤ (Suc n). f j ∈ carrier A; j ≤ (Suc n);
j ≠ Suc n⟧ ⟹ nsum A f (Suc n) = nsum A (cmp f (transpos j (Suc n))) (Suc n)"
apply (rule addition2 [THEN sym,of "f" "n" "transpos j (Suc n)"])
apply (simp)
apply (rule transpos_hom, assumption+, simp, assumption)
apply (rule transpos_inj, simp+)
done

lemma (in aGroup) nsum_splitTr:"(∀j ≤ (Suc (n + m)). f j ∈ carrier A) ⟶
   nsum A f (Suc (n + m)) = nsum A f n ± (nsum A (cmp f (slide (Suc n))) m)" 
apply (induct_tac m)
apply (rule impI) apply (simp add:slide_def cmp_def)
apply (rule impI, simp del:nsum_suc)

apply (cut_tac n = "Suc (n + na)" in nsum_suc[of A f],
       simp del:nsum_suc,
       thin_tac "Σ⇩e A f (Suc (Suc (n + na))) =
       Σ⇩e A f n ± Σ⇩e A (cmp f (slide (Suc n))) na ± f (Suc (Suc (n + na)))")
apply (cut_tac f = "cmp f (slide (Suc n))" and n = na in nsum_suc[of A],
       simp del:nsum_suc)
apply (subst ag_pOp_assoc)
apply (rule nsum_mem, rule allI, simp) 
 apply (rule_tac n = na in nsum_mem, 
        thin_tac "Σ⇩e A (cmp f (slide (Suc n))) (Suc na) =
          Σ⇩e A (cmp f (slide (Suc n))) na ± (cmp f (slide (Suc n)) (Suc na))")
 apply (rule allI, rule impI,
        simp add:cmp_def slide_def, simp)
 apply (simp add:cmp_def slide_def)
done

lemma (in aGroup) nsum_split:"∀j ≤ (Suc (n + m)). f j ∈ carrier A ⟹
   nsum A f (Suc (n + m)) = nsum A f n ± (nsum A (cmp f (slide (Suc n))) m)"  
by (simp del:nsum_suc add:nsum_splitTr)                                     

lemma (in aGroup) nsum_split1:"⟦∀j ≤ m. f j ∈ carrier A; n < m⟧ ⟹
                   nsum A f m = nsum A f n ± (fSum A f (Suc n) m)"
apply (cut_tac nsum_split[of n "m - n - Suc 0" f])
apply simp
apply (simp add:fSum_def)
apply simp
done

lemma (in aGroup) nsum_minusTr:" (∀j ≤ n. f j ∈ carrier A) ⟶
                    -⇩a (nsum A f n) = nsum A (λx∈{j. j ≤ n}. -⇩a (f x)) n"
apply (induct_tac n)
 apply (rule impI, simp)
apply (rule impI)
 apply (subst nsum_suc, subst nsum_suc)
 apply (subst ag_p_inv) 
 apply (rule_tac n = n in nsum_mem [of _ f],
        rule allI, simp, simp)
 apply (subgoal_tac "∀j≤n. f j ∈ carrier A", simp)
 apply (rule_tac a = "Σ⇩e A (λu. if u ≤ n then  -⇩a (f u) else undefined) n"
     and b = "Σ⇩e A (λx∈{j. j ≤ (Suc n)}. -⇩a (f x)) n" and c = "-⇩a (f (Suc n))"
     in ag_pOp_add_r,
     rule_tac n = n in nsum_mem,
     rule allI, rule impI, simp,
     rule ag_mOp_closed, simp)
 apply (rule_tac n = n in nsum_mem,
        rule allI, rule impI, simp,
        rule ag_mOp_closed, simp,
        rule ag_mOp_closed, simp) 
 apply (rule_tac f = "λu. if u ≤ n then -⇩a (f u) else undefined" and 
        n = n and g = "λx∈{j. j ≤ (Suc n)}. -⇩a (f x)" in nsum_eq,
        rule allI, rule impI,
        simp, rule ag_mOp_closed, simp,
        rule allI, simp, rule impI, rule ag_mOp_closed, simp) 
 apply (rule allI, simp)
 apply (rule allI, simp)
done

lemma (in aGroup) nsum_minus:"∀j ≤ n. f j ∈ carrier A ⟹ 
                    -⇩a (nsum A f n) = nsum A (λx∈{j. j ≤ n}. -⇩a (f x)) n"
apply (simp add:nsum_minusTr)
done

lemma (in aGroup) ring_nsum_zeroTr:"(∀j ≤ (n::nat). f j ∈ carrier A) ∧ 
                    (∀j ≤ n. f j = 𝟬) ⟶ nsum A f n = 𝟬"
apply (induct_tac n)
apply (rule impI) apply (erule conjE)+ apply simp

apply (rule impI, (erule conjE)+)
 apply (cut_tac n = n in Nsetn_sub_mem1, simp)
 apply (simp add:ag_inc_zero)
 apply (cut_tac ag_inc_zero,
        simp add:ag_r_zero)
done

lemma (in aGroup) ring_nsum_zero:"∀j ≤ (n::nat). f j = 𝟬  ⟹ Σ⇩e A f n = 𝟬"
apply (cut_tac ring_nsum_zeroTr[of n f])
apply (simp add:ag_inc_zero)
done

lemma (in aGroup) ag_nsum_1_nonzeroTr:
"∀f. (∀j ≤ n. f j ∈ carrier A) ∧ 
       (l ≤ n ∧ (∀j ∈ {j. j ≤ n} - {l}. f j = 𝟬))
      ⟶ nsum A f n = f l" 
apply (induct_tac n)
      apply simp 
apply (rule allI,
       rule impI, (erule conjE)+)
 apply (case_tac "l = Suc n") 
 apply simp
 apply (subgoal_tac "{j. j ≤ Suc n} - {Suc n} = {j. j ≤ n}", simp,
        frule ring_nsum_zero, simp)
 apply (rule ag_l_zero, simp)
 apply (rule equalityI, rule subsetI, simp,
        rule subsetI, simp)
 apply (frule_tac m = l and n = "Suc n" in noteq_le_less, assumption,
        thin_tac "l ≤ Suc n",
        frule_tac x = l and n = n in Suc_less_le)
 apply (cut_tac n = n in Nsetn_sub_mem1, simp)
 apply (thin_tac "∀f. (∀j≤n. f j ∈ carrier A) ∧
               (∀j∈{j. j ≤ n} - {l}. f j = 𝟬) ⟶
               Σ⇩e A f n = f l",
        frule_tac a = l in forall_spec, simp)
 apply (simp add:ag_r_zero)
done
            
lemma (in aGroup) ag_nsum_1_nonzero:"⟦∀j ≤ n. f j ∈ carrier A; l ≤ n; 
       ∀j∈({j. j ≤ n} - {l}). f j = 𝟬 ⟧ ⟹ nsum A f n = f l"  
apply (simp add:ag_nsum_1_nonzeroTr[of n l])
done

definition
  set_mult :: "[_ , 'a set, 'a set] ⇒ 'a set" where
  "set_mult R A B = {z. ∃x∈A. ∃y∈B.  x ⋅⇩r⇘R⇙ y = z}"

definition
  sum_mult :: "[_ , 'a set, 'a set] ⇒ 'a set" where
  "sum_mult R A B = {x. ∃n. ∃f ∈ {j. j ≤ (n::nat)}
                           → set_mult R A B. nsum R f n = x}"  
(*
 zero_fini::"[_ , 'a set, 'a set] ⇒ (nat ⇒ 'a)"
     "zero_fini R A B i == 𝟬 ⋅⇩r 𝟬" *)

lemma (in Ring) set_mult_sub:"⟦A ⊆ carrier R; B ⊆ carrier R⟧ ⟹
                                    set_mult R A B ⊆ carrier R"
apply (rule subsetI, simp add:set_mult_def, (erule bexE)+,
       frule sym, thin_tac "xa ⋅⇩r y = x", simp)
apply (rule ring_tOp_closed, (simp add:subsetD)+)
done

lemma (in Ring) set_mult_mono:"⟦A1 ⊆ carrier R; A2 ⊆ carrier R; A1 ⊆ A2; 
       B ⊆ carrier R⟧ ⟹ set_mult R A1 B ⊆ set_mult R A2 B"
apply (rule subsetI)
 apply (simp add:set_mult_def, (erule bexE)+)
 apply (frule_tac c = xa in subsetD[of A1 A2], assumption+)
 apply blast
done
 
lemma (in Ring) sum_mult_Tr1:"⟦A ⊆ carrier R; B ⊆ carrier R⟧ ⟹
               (∀j ≤ n. f j ∈ set_mult R A B) ⟶ nsum R f n ∈ carrier R"
apply (cut_tac ring_is_ag)
apply (induct_tac n)
 apply (rule impI, simp)
 apply (frule set_mult_sub[of A B], assumption, simp add:subsetD)
apply (rule impI)
 apply (cut_tac n = n in Nsetn_sub_mem1, simp)
 apply (frule set_mult_sub[of A B], assumption) 
 apply (frule_tac a = "Suc n" in forall_spec, simp,
        frule_tac c = "f (Suc n)" in subsetD[of "set_mult R A B" "carrier R"],
        assumption)
 apply (rule aGroup.ag_pOp_closed, assumption+)
done

lemma (in Ring) sum_mult_mem:"⟦A ⊆ carrier R; B ⊆ carrier R; 
   ∀j ≤ n. f j ∈ set_mult R A B⟧  ⟹ nsum R f n ∈ carrier R"
apply (cut_tac ring_is_ag)
apply (simp add:sum_mult_Tr1)
done

lemma (in Ring) sum_mult_mem1:"⟦A ⊆ carrier R; B ⊆ carrier R; 
        x ∈ sum_mult R A B⟧  ⟹
        ∃n. ∃f∈{j. j ≤ (n::nat)} → set_mult R A B. nsum R f n = x"
by (simp add:sum_mult_def)

lemma (in Ring) sum_mult_subR:"⟦A ⊆ carrier R; B ⊆ carrier R⟧ ⟹
                         sum_mult R A B ⊆ carrier R"
apply (rule subsetI)
apply (frule_tac x = x in sum_mult_mem1[of A B], assumption+)
apply (erule exE, erule bexE, frule sym, thin_tac "Σ⇩e R f n = x", simp)
apply (cut_tac ring_is_ag)
apply (rule aGroup.nsum_mem[of R], assumption) 
apply (rule allI, rule impI)
apply (frule_tac f = f and A = "{j. j ≤ n}" and B = "set_mult R A B" and
       x = j in funcset_mem, simp) 
apply (frule set_mult_sub[of A B], assumption)
apply (simp add:subsetD)
done

lemma (in Ring) times_mem_sum_mult:"⟦A ⊆ carrier R; B ⊆ carrier R; 
       a ∈ A; b ∈ B ⟧  ⟹  a ⋅⇩r b ∈ sum_mult R A B"
apply (simp add:sum_mult_def)
apply (subgoal_tac "(λi∈{j. j ≤ (0::nat)}. a ⋅⇩r b) ∈ {j. j ≤ 0} → set_mult R A B") 
apply (subgoal_tac "nsum R (λi∈{j. j ≤ (0::nat)}. a ⋅⇩r b) 0 = a ⋅⇩r b") 
apply blast
 apply simp
 apply (rule Pi_I, simp add:set_mult_def, blast)
done

lemma (in Ring) mem_minus_sum_multTr2:"⟦A ⊆ carrier R; B ⊆ carrier R; 
       ∀j ≤ n. f j ∈ set_mult R A B; i ≤ n⟧ ⟹ f i ∈ carrier R"
apply (frule_tac a = i in forall_spec, simp)
apply (frule set_mult_sub[of A B], assumption, simp add:subsetD)
done

lemma (in aGroup) nsum_jointfun:"⟦∀j ≤ n. f j ∈ carrier A; 
      ∀j ≤ m. g j ∈ carrier A⟧  ⟹ 
      Σ⇩e A (jointfun n f m g) (Suc (n + m)) =  Σ⇩e A f n ± (Σ⇩e A g m)"
 apply (subst nsum_split)
 apply (rule allI, rule impI)
 apply (frule_tac f = f and n = n and A = "carrier A" and g = g and m = m
        and B = "carrier A" in jointfun_mem, assumption+, simp)
 apply (subgoal_tac "nsum A (jointfun n f m g) n = nsum A f n")
 apply (subgoal_tac "nsum A (cmp (jointfun n f m g) (slide (Suc n))) m =
                               nsum A g m")
apply simp
 apply (thin_tac "nsum A (jointfun n f m g) n = nsum A f n") 
 apply (rule nsum_eq)
 apply (rule allI, rule impI,
        simp add:cmp_def jointfun_def slide_def sliden_def,
        assumption)
 apply (rule allI, simp add:cmp_def jointfun_def slide_def sliden_def)

 apply (rule nsum_eq)
 apply (rule allI, rule impI,
             simp add:jointfun_def, assumption)
 apply (rule allI, rule impI)
 apply (simp add:jointfun_def) 
done

lemma (in Ring) sum_mult_pOp_closed:"⟦A ⊆ carrier R; B ⊆ carrier R;
       a ∈ sum_mult R A B;  b ∈ sum_mult R A B ⟧ ⟹ a ±⇘R⇙ b ∈ sum_mult R A B" 
apply (cut_tac ring_is_ag)
apply (simp add:sum_mult_def)
 apply ((erule exE)+, (erule bexE)+)
 apply (rename_tac n m f g) 
 apply (frule sym, thin_tac "Σ⇩e R f n = a", frule sym, 
        thin_tac "Σ⇩e R g m = b", simp)
 apply (frule set_mult_sub[of A B], assumption)
 apply (subst aGroup.nsum_jointfun[THEN sym, of R], assumption)
 apply (rule allI, rule impI, 
        frule_tac f = f and A = "{j. j ≤ n}" and B = "set_mult R A B" and
        x = j in funcset_mem, simp, simp add:subsetD)
 apply (rule allI, rule impI, 
        frule_tac f = g and A = "{j. j ≤ m}" and B = "set_mult R A B" and
        x = j in funcset_mem, simp, simp add:subsetD)
  apply (frule_tac f = f and n = n and A = "set_mult R A B" and g = g and m = m
        and B = "set_mult R A B" in jointfun_hom, assumption+)
 apply (simp del:nsum_suc)
 apply blast
done

lemma (in Ring) set_mult_mOp_closed:"⟦A ⊆ carrier R; ideal R B;
       x ∈ set_mult R A B⟧ ⟹ -⇩a x ∈ set_mult R A B" 
apply (cut_tac ring_is_ag,
       simp add:set_mult_def,
       (erule bexE)+, frule sym, thin_tac "xa ⋅⇩r y = x", simp,
       frule_tac c = xa in subsetD[of A "carrier R"], assumption+,
       frule ideal_subset1[of B],
       frule_tac c = y in subsetD[of B "carrier R"], assumption+,
       simp add:ring_inv1_2,
       frule_tac I = B and x = y in ideal_inv1_closed,
           assumption+) 
apply blast
done

lemma (in Ring) set_mult_ring_times_closed:"⟦A ⊆ carrier R; ideal R B;
       x ∈ set_mult R A B; r ∈ carrier R⟧ ⟹ r ⋅⇩r  x ∈ set_mult R A B" 
apply (cut_tac ring_is_ag,   
       simp add:set_mult_def,
       (erule bexE)+, frule sym, thin_tac "xa ⋅⇩r y = x", simp,
       frule_tac c = xa in subsetD[of A "carrier R"], assumption+,
       frule ideal_subset1[of B],
       frule_tac c = y in subsetD[of B "carrier R"], assumption,
       frule_tac x = r and y = "xa ⋅⇩r y" in ring_tOp_commute,
       simp add:ring_tOp_closed, simp,
       subst ring_tOp_assoc, assumption+) 
 apply (frule_tac x = y and y = r in ring_tOp_commute, assumption+,
        simp,
        frule_tac x = y and r = r in ideal_ring_multiple [of B], assumption+)
 apply blast
done
 
lemma (in Ring) set_mult_sub_sum_mult:"⟦A ⊆ carrier R; ideal R B⟧ ⟹
                   set_mult R A B ⊆ sum_mult R A B" 
apply (rule subsetI)
 apply (simp add:sum_mult_def)
 apply (cut_tac f = "(λi∈{j. j ≤ (0::nat)}. x)" in nsum_0[of R]) 
 apply (cut_tac n_in_Nsetn[of 0],
        simp del:nsum_0)
 apply (cut_tac f = "λi∈{j. j ≤ (0::nat)}. x" and B = "%_. set_mult R A B" in 
                Pi_I[of "{j. j ≤ 0}"],
       simp)
 apply (subgoal_tac "Σ⇩e R (λi∈{j. j ≤ 0}. x) 0 = x")
 apply blast
 apply simp
done

lemma (in Ring) sum_mult_pOp_closedn:"⟦A ⊆ carrier R; ideal R B⟧  ⟹ 
               (∀j ≤ n. f j ∈ set_mult R A B) ⟶ Σ⇩e R f n ∈ sum_mult R A B"
apply (induct_tac n)
 apply (rule impI, simp) 
 apply (frule set_mult_sub_sum_mult[of A B], assumption+, simp add:subsetD)

apply (rule impI)
 apply simp
 apply (frule_tac a = "Suc n" in forall_spec, simp)
 apply (frule set_mult_sub_sum_mult[of A B], assumption+, 
        frule_tac c= "f (Suc n)" in 
                  subsetD[of "set_mult R A B" "sum_mult R A B"], assumption+)
 apply (rule sum_mult_pOp_closed, assumption,
        simp add:ideal_subset1, assumption+)
done

lemma (in Ring) mem_minus_sum_multTr4:"⟦A ⊆ carrier R; ideal R B⟧ ⟹
        (∀j ≤ n. f j ∈ set_mult R A B) ⟶ -⇩a (nsum R f n) ∈ sum_mult R A B"
apply (cut_tac ring_is_ag)
apply (induct_tac n)
 apply (rule impI)
 apply (cut_tac n_in_Nsetn[of 0])
 apply (frule_tac x = "f 0" in set_mult_mOp_closed[of A B], assumption+)
 apply simp
 apply (frule set_mult_sub_sum_mult[of A B], assumption+, 
        simp add:subsetD)
apply (rule impI)
 apply (cut_tac n = n in Nsetn_sub_mem1, simp)
 apply (frule sum_mult_subR[of A B], simp add:ideal_subset1)
 apply (frule_tac n = n and f = f in sum_mult_pOp_closedn[of A B], assumption,
        cut_tac n = n in Nsetn_sub_mem1, simp)
 apply (frule_tac c = "Σ⇩e R f n" in subsetD[of "sum_mult R A B" "carrier R"],
        assumption+,
        frule_tac a = "Suc n" in forall_spec, simp,
        thin_tac "∀j≤Suc n. f j ∈ set_mult R A B",
        frule set_mult_sub[of A B], simp add:ideal_subset1,
        frule_tac c = "f (Suc n)" in subsetD[of "set_mult R A B" "carrier R"],
        assumption+ )       
 apply (frule_tac x = "Σ⇩e R f n" and y = "f (Suc n)" in aGroup.ag_p_inv[of R],
        assumption+, simp) 
 apply (rule_tac a = "-⇩a (Σ⇩e R f n)" and b = "-⇩a (f (Suc n))" in 
        sum_mult_pOp_closed[of A B], assumption+,
        simp add:ideal_subset1, assumption)
 apply (frule_tac x = "f (Suc n)" in set_mult_mOp_closed[of A B], assumption+,
        frule set_mult_sub_sum_mult[of A B], assumption+)
 apply (simp add:subsetD)
done
 
lemma (in Ring) sum_mult_iOp_closed:"⟦A ⊆ carrier R; ideal R B; 
       x ∈ sum_mult R A B ⟧ ⟹ -⇩a x ∈ sum_mult R A B"
apply (frule sum_mult_mem1 [of A B x],
       simp add:ideal_subset1, assumption)
apply (erule exE, erule bexE, frule sym, thin_tac "Σ⇩e R f n = x")
apply simp
apply (frule_tac n = n and f = f in mem_minus_sum_multTr4[of A B], 
        assumption+)
apply (simp add:Pi_def)
done

lemma (in Ring) sum_mult_ring_multiplicationTr:
      "⟦A ⊆ carrier R; ideal R B; r ∈ carrier R⟧ ⟹
       (∀j ≤ n. f j ∈ set_mult R A B) ⟶ r ⋅⇩r (nsum R f n) ∈ sum_mult R A B"
apply (cut_tac ring_is_ag)
apply (induct_tac n)
 apply (rule impI, simp)
 apply (simp add:set_mult_def)
 apply ((erule bexE)+, frule sym, thin_tac "x ⋅⇩r y = f 0", simp)
 apply (frule_tac c = x in subsetD[of A "carrier R"], assumption+) 
 apply (frule ideal_subset1[of B],
        frule_tac c = y in subsetD[of B "carrier R"], assumption,
        frule_tac x = r and y = "x ⋅⇩r y" in ring_tOp_commute,
        simp add:ring_tOp_closed, simp,
        subst ring_tOp_assoc, assumption+) 
 apply (frule_tac x = y and y = r in ring_tOp_commute, assumption+,
        simp,
        frule_tac x = y and r = r in ideal_ring_multiple [of B], assumption+)
 apply (rule times_mem_sum_mult, assumption+)
 
apply (rule impI)
 apply (cut_tac n = n in Nsetn_sub_mem1, simp)
 apply (frule_tac f = f and n = n in aGroup.nsum_mem,
        frule set_mult_sub [of "A" "B"], simp add:ideal_subset1,
        rule allI, rule impI, cut_tac n = n in Nsetn_sub_mem1,
         simp add: subsetD,
        frule_tac a = "Suc n" in forall_spec, simp) 
 apply (frule set_mult_sub[of A B], simp add:ideal_subset1,
        frule_tac c = "f (Suc n)" in subsetD[of "set_mult R A B" "carrier R"],
        assumption)
 apply (simp add: ring_distrib1) 
 apply (rule sum_mult_pOp_closed[of A B], assumption+,
        simp add:ideal_subset1, assumption)
 apply (frule_tac x = "f (Suc n)" in set_mult_ring_times_closed [of A B _ r],
        assumption+, simp, assumption,
        frule set_mult_sub_sum_mult[of A B], assumption+,
        simp add:subsetD)
done

lemma (in Ring) sum_mult_ring_multiplication:"⟦A ⊆ carrier R; ideal R B; 
 r ∈ carrier R; a ∈ sum_mult R A B⟧  ⟹ r ⋅⇩r a ∈ sum_mult R A B"
apply (cut_tac ring_is_ag)
apply (frule sum_mult_mem1[of A B a],
       simp add:ideal_subset1, assumption)
apply (erule exE, erule bexE, frule sym, thin_tac "Σ⇩e R f n = a", simp)
apply (subgoal_tac "∀j ≤ n. f j ∈ set_mult R A B")
apply (simp add:sum_mult_ring_multiplicationTr)
apply (simp add:Pi_def)
done

lemma (in Ring) ideal_sum_mult:"⟦A ⊆ carrier R; A ≠ {}; ideal R B⟧ ⟹
                ideal R (sum_mult R A B)"
apply (simp add:ideal_def [of _ "sum_mult R A B"])
apply (cut_tac ring_is_ag)
apply (rule conjI) 
apply (rule aGroup.asubg_test, assumption+)
apply (rule subsetI)
 apply (frule_tac x = x in sum_mult_mem1[of A B],
        simp add:ideal_subset1, assumption,
        erule exE, erule bexE, frule sym, thin_tac "Σ⇩e R f n = x", simp)
 apply (rule_tac f = f and n = n in sum_mult_mem[of A B _ _], assumption+)
 apply (simp add:ideal_subset1)
 apply (simp add:Pi_def)
 apply (frule nonempty_ex[of A], erule exE)
 apply (frule ideal_zero[of B])
 apply (frule_tac a = x and b = 𝟬 in times_mem_sum_mult[of A B],
        simp add:ideal_subset1, assumption+) apply blast

 apply (rule ballI)+
 apply (rule_tac a = a and b = "-⇩a b" in sum_mult_pOp_closed[of A B],
        assumption, simp add:ideal_subset1, assumption+,
        rule_tac x = b in sum_mult_iOp_closed[of A B], assumption+)
 apply (rule ballI)+
 apply (rule sum_mult_ring_multiplication, assumption+)
done

lemma (in Ring) ideal_inc_set_multTr:"⟦A ⊆ carrier R; ideal R B; ideal R C; 
       set_mult R A B ⊆ C ⟧ ⟹
         ∀f ∈ {j. j ≤ (n::nat)} → set_mult R A B. Σ⇩e R f n ∈ C"
apply (induct_tac n)
 apply (simp add:subsetD)

apply (rule ballI)
  apply (
       frule_tac f = f and A = "{j. j ≤ Suc n}" and x = "Suc n" and 
                 B = "set_mult R A B"in funcset_mem, simp,
       frule_tac c = "f (Suc n)" in subsetD[of "set_mult R A B" "C"], 
       assumption+, simp)
 apply (rule ideal_pOp_closed[of C], assumption+,
        cut_tac n = n in Nsetn_sub_mem1, 
        frule_tac x = f in bspec, simp)
 apply (simp add:Pi_def, assumption+)
done

lemma (in Ring) ideal_inc_set_mult:"⟦A ⊆ carrier R; ideal R B; ideal R C; 
                           set_mult R A B ⊆ C ⟧ ⟹ sum_mult R A B ⊆ C"
apply (rule subsetI)
 apply (frule_tac x = x in sum_mult_mem1[of A B],
        simp add:ideal_subset1, assumption+)
 apply (erule exE, erule bexE, frule sym, thin_tac "Σ⇩e R f n = x", simp,
        thin_tac "x = Σ⇩e R f n", simp add:subsetD)
apply (simp add:ideal_inc_set_multTr)
done

lemma (in Ring) AB_inc_sum_mult:"⟦ideal R A; ideal R B⟧ ⟹ 
                                     sum_mult R A B ⊆ A ∩ B"
apply (frule ideal_subset1[of A], frule ideal_subset1[of B])
apply (frule ideal_inc_set_mult [of "A" "B" "A"], assumption+)
apply (rule subsetI, 
       simp add:set_mult_def, (erule bexE)+, frule sym, thin_tac "xa ⋅⇩r y = x",
       simp,
       frule_tac c = xa in subsetD[of A "carrier R"], assumption+,
       frule_tac c = y in subsetD[of B "carrier R"], assumption+,
       subst ring_tOp_commute, assumption+,
       simp add:ideal_ring_multiple)
apply (frule ideal_inc_set_mult [of "A" "B" "B"], assumption+)
apply (rule subsetI, 
       simp add:set_mult_def, (erule bexE)+, frule sym, thin_tac "xa ⋅⇩r y = x",
       simp,
       frule_tac c = xa in subsetD[of A "carrier R"], assumption+,
       simp add:ideal_ring_multiple)
apply simp
done

lemma (in Ring) sum_mult_is_ideal_prod:"⟦ideal R A; ideal R B⟧ ⟹
                                  sum_mult R A B =  A ♢⇩r B"
apply (rule equalityI)
 apply (frule ideal_prod_ideal [of "A" "B"], assumption+)
 apply (rule ideal_inc_set_mult)
  apply (simp add:ideal_subset1)+
 apply (rule subsetI)
 apply (simp add:set_mult_def ideal_prod_def)
 apply (auto del:subsetI) 
 apply (rule subsetI)
 apply (simp add:ideal_prod_def)
 apply (frule ideal_subset1[of A],
        frule ideal_sum_mult[of A B],
        frule ideal_zero[of A], blast, assumption)
 apply (frule_tac a = "sum_mult R A B" in forall_spec, simp)
 apply (rule subsetI, simp,
        thin_tac "∀xa. ideal R xa ∧ {x. ∃i∈A. ∃j∈B. x = i ⋅⇩r j} ⊆ xa ⟶ x ∈ xa",
        (erule bexE)+, simp)
 apply (rule times_mem_sum_mult, assumption,
        simp add:ideal_subset1, assumption+)
done

lemma (in Ring) ideal_prod_assocTr0:"⟦ideal R A; ideal R B; ideal R C; y ∈ C; 
                 z ∈ set_mult R A B⟧ ⟹ z ⋅⇩r y ∈ sum_mult R A (B ♢⇩r C)"
apply (simp add:set_mult_def, (erule bexE)+,
        frule sym, thin_tac "x ⋅⇩r ya = z", simp)
 apply (frule_tac h = x in ideal_subset[of A], assumption,
        frule_tac h = ya in ideal_subset[of B], assumption,
        frule_tac h = y in ideal_subset[of C], assumption,
        subst ring_tOp_assoc, assumption+) 
 apply (frule ideal_subset1[of A],
        frule ideal_subset1[of B], 
        frule ideal_subset1[of C],
        frule ideal_prod_ideal[of B C], assumption,
        frule ideal_subset1[of "B ♢⇩r C"])
  apply (rule times_mem_sum_mult[of A "B ♢⇩r C"], assumption+,
         subst sum_mult_is_ideal_prod[of B C, THEN sym], assumption+,
         rule times_mem_sum_mult[of B C], assumption+)
done

lemma (in Ring) ideal_prod_assocTr1:"⟦ideal R A; ideal R B; ideal R C; y ∈ C⟧
 ⟹ ∀f ∈ {j. j≤(n::nat)} → set_mult R A B. (Σ⇩e R f n) ⋅⇩r y ∈ A ♢⇩r (B ♢⇩r C)"
apply (cut_tac ring_is_ag)
apply (frule ideal_prod_ideal[of "B" "C"], assumption+,
       subst sum_mult_is_ideal_prod[of A "B ♢⇩r C", THEN sym], assumption+)     
apply (induct_tac n)
 apply simp
 apply (simp add:ideal_prod_assocTr0)
 apply (rule ballI,
       frule_tac x = f in bspec,
       thin_tac "∀f∈{j. j ≤ n} → set_mult R A B.
            Σ⇩e R f n ⋅⇩r y ∈ sum_mult R A (B ♢⇩r C)",
       rule Pi_I, simp,
       frule_tac f = f and A = "{j. j ≤ Suc n}" and B = "set_mult R A B" and
                 x = x in funcset_mem, simp, assumption)
 apply simp

 apply (frule ideal_subset1[of A], frule ideal_subset1[of B],
        frule set_mult_sub[of A B], assumption,
        frule_tac f = f and A = "{j. j ≤ (Suc n)}" in extend_fun[of _ _ 
                 "set_mult R A B"
         "carrier R"], assumption,
        subst ring_distrib2,
        simp add:ideal_subset)
 apply (rule aGroup.nsum_mem, assumption)
 apply (simp add:Pi_def)
 apply (simp add:funcset_mem del:Pi_I',
        frule_tac f = f and A = "{j. j ≤ Suc n}" and B = "set_mult R A B" and
        x =  "Suc n" in funcset_mem, simp)
apply (frule ideal_subset1[of A],
       frule ideal_zero[of A],
       frule ideal_sum_mult[of A "B ♢⇩r C"], blast, assumption)
apply (rule ideal_pOp_closed, assumption+)
apply (simp add:ideal_prod_assocTr0)
done

lemma (in Ring) ideal_quotient_idealTr:"⟦ideal R A; ideal R B; ideal R C; 
       x ∈ carrier R;∀c∈C. x ⋅⇩r c ∈ ideal_quotient R A B⟧ ⟹ 
       f∈{j. j ≤ n} → set_mult R B C ⟶  x ⋅⇩r (nsum R f n) ∈ A"

apply (frule ideal_subset1 [of "A"],
       frule ideal_subset1 [of "B"])
apply (induct_tac n)
 apply (rule impI) 
 apply (cut_tac n_in_Nsetn[of 0])
 apply (frule funcset_mem, assumption+) 
 apply (thin_tac "f ∈ {j. j ≤ 0} → set_mult R B C")
 apply (simp add:set_mult_def)
 apply (erule bexE)+
 apply (frule sym, thin_tac "xa ⋅⇩r y = f 0", simp)
 apply (frule_tac h = xa in ideal_subset[of B], assumption,
        frule_tac h = y in ideal_subset[of C], assumption)
 apply (frule_tac x = xa and y = y in ring_tOp_commute, assumption+,
        simp)
 apply (subst ring_tOp_assoc[THEN sym], assumption+)
 apply (frule_tac x = y in bspec, assumption,
        thin_tac "∀c∈C. x ⋅⇩r c ∈ A †⇩R B")
 apply (simp add:ideal_quotient_def)
(****** n ********)
apply (rule impI)
 apply (frule func_pre) apply simp
 apply (cut_tac ring_is_ag) 
 apply (frule ideal_subset1[of B], frule ideal_subset1[of C],
        frule set_mult_sub[of B C], assumption+)
 apply (cut_tac  n = n in nsum_memr [of _ "f"],
        rule allI, rule impI,
        frule_tac x = i in funcset_mem, simp, simp add:subsetD) 
 apply (frule_tac a = n in forall_spec, simp) 
 apply (thin_tac "∀l≤n. Σ⇩e R f l ∈ carrier R",
        frule_tac f = f and A = "{j. j ≤ Suc n}" and B = "set_mult R B C" 
                  and x = "Suc n" in funcset_mem, simp,
        frule_tac c = "f (Suc n)" in subsetD[of "set_mult R B C" " carrier R"],
         assumption+)
 apply (subst ring_distrib1, assumption+)
 apply (rule ideal_pOp_closed[of A], assumption+)
 apply (simp add: set_mult_def, (erule bexE)+,
        fold set_mult_def,
        frule sym, thin_tac "xa ⋅⇩r y = f (Suc n)", simp)
 apply (frule_tac c = xa in subsetD[of B "carrier R"], assumption+,
        frule_tac c = y in subsetD[of C "carrier R"], assumption+,
        frule_tac x = xa and y = y in ring_tOp_commute, assumption, simp,
        subst ring_tOp_assoc[THEN sym], assumption+)
 apply (simp add:ideal_quotient_def)
done

lemma (in Ring) ideal_quotient_ideal:"⟦ideal R A; ideal R B; ideal R C⟧ ⟹ 
                         A †⇩R B †⇩R C = A †⇩R B ♢⇩r C"
apply (rule equalityI)
 apply (rule subsetI)
 apply (simp add:ideal_quotient_def [of _ _ "C"])
 apply (erule conjE)
 apply (simp add:ideal_quotient_def [of _ _ "B ♢⇩r C"])
 apply (rule ballI)
apply (simp add:sum_mult_is_ideal_prod [THEN sym])
 apply (simp add:sum_mult_def)
 apply (erule exE, erule bexE)
 apply (rename_tac x c n f)
 apply (frule sym) apply simp 
apply (simp add:ideal_quotient_idealTr)
apply (rule subsetI)
 apply (simp add:sum_mult_is_ideal_prod [THEN sym])
 apply (simp add:ideal_quotient_def)
 apply (erule conjE)
 apply (rule ballI)
 apply (rename_tac x c)
 apply (frule ideal_subset [of "C"], assumption+)
 apply (simp add:ring_tOp_closed)
apply (rule ballI)
apply (rename_tac x v u)
 apply (frule ideal_subset [of "B"], assumption+)
 apply (subst ring_tOp_assoc, assumption+)
 apply (frule ideal_subset1[of B],
        frule ideal_subset1[of C],
        frule_tac a = u and b = v in times_mem_sum_mult[of B C], assumption+)
 apply (frule_tac x = u and y = v in ring_tOp_commute, assumption,
        simp)
done

lemma (in Ring) ideal_prod_assocTr:"⟦ideal R A; ideal R B; ideal R C⟧ ⟹
  ∀f. (f ∈ {j. j ≤ (n::nat)} → set_mult R (A ♢⇩r B) C ⟶ 
                                          (Σ⇩e R f n) ∈ A ♢⇩r (B ♢⇩r C))"
apply (subgoal_tac "∀x∈(A ♢⇩r B). ∀y∈C. x ⋅⇩r y ∈ A ♢⇩r (B ♢⇩r C)")
apply (induct_tac n)
  apply (rule allI) apply (rule impI)
  apply (frule_tac f = f and A = "{j. j ≤ 0}" and B = "set_mult R (A ♢⇩r B) C"
        and x = 0 in funcset_mem, simp, simp)
  apply (simp add:set_mult_def)
  apply ((erule bexE)+, frule sym, thin_tac "x ⋅⇩r y = f 0", simp)
apply (rule allI, rule impI)
  apply (frule func_pre)
  apply (frule_tac a = f in forall_spec, simp,
         thin_tac "∀f. f ∈ {j. j ≤ n} → set_mult R (A ♢⇩r B) C ⟶
               Σ⇩e R f n ∈ A ♢⇩r (B ♢⇩r C)",
         frule ideal_prod_ideal[of "B" "C"], assumption+,
         frule ideal_prod_ideal[of "A" "B ♢⇩r C"], assumption+, simp)
  apply (rule ideal_pOp_closed[of "A ♢⇩r (B ♢⇩r C)"], assumption+)
  apply (cut_tac n = "Suc n" in n_in_Nsetn,
       frule_tac f = f and A = "{j. j ≤ Suc n}" and 
       B = "set_mult R (A ♢⇩r B) C" and x = "Suc n" in funcset_mem, assumption) 
 apply (thin_tac "f ∈ {j. j ≤ n} → set_mult R (A ♢⇩r B) C",
        thin_tac "f ∈ {j. j ≤ Suc n} → set_mult R (A ♢⇩r B) C")
 apply (simp add:set_mult_def)
 apply ((erule bexE)+,
        frule sym, thin_tac "x ⋅⇩r y = f (Suc n)", simp)

 apply (rule ballI)+
 apply (simp add:sum_mult_is_ideal_prod[of A B, THEN sym])
 apply (frule ideal_subset1[of A], frule ideal_subset1[of B],
        frule_tac x = x in sum_mult_mem1[of A B], assumption+)
       apply (erule exE, erule bexE, frule sym, thin_tac "Σ⇩e R f n = x",
               simp)
  apply (simp add:ideal_prod_assocTr1)
done
 
lemma (in Ring) ideal_prod_assoc:"⟦ideal R A; ideal R B; ideal R C⟧ ⟹
            (A ♢⇩r B) ♢⇩r C = A ♢⇩r (B ♢⇩r C)" 
apply (rule equalityI)
 apply (rule subsetI)
 apply (frule ideal_prod_ideal[of "A" "B"], assumption+)
 apply (frule sum_mult_is_ideal_prod[of "A ♢⇩r B" "C"], assumption+)
 apply (frule sym) apply (thin_tac "sum_mult R (A ♢⇩r B) C = (A ♢⇩r B) ♢⇩r C")
 apply simp apply (thin_tac "(A ♢⇩r B) ♢⇩r C = sum_mult R (A ♢⇩r B) C")
 apply (thin_tac "ideal R (A ♢⇩r B)")
 apply (frule ideal_prod_ideal[of "B" "C"], assumption+)
  apply (simp add:sum_mult_def)
  apply (erule exE, erule bexE)  
 apply (frule sym, thin_tac "Σ⇩e R f n = x", simp) 
 apply (simp add:ideal_prod_assocTr) 
apply (rule subsetI)
 apply (frule ideal_prod_ideal[of "B" "C"], assumption+)
 apply (simp add:ideal_prod_commute [of "A" "B ♢⇩r C"])
 apply (frule ideal_prod_ideal[of "A" "B"], assumption+)
 apply (simp add:ideal_prod_commute[of "A ♢⇩r B" "C"])
 apply (simp add:ideal_prod_commute[of "A" "B"])
 apply (simp add:ideal_prod_commute[of "B" "C"])
 apply (frule ideal_prod_ideal[of "C" "B"], assumption+)
 apply (frule sum_mult_is_ideal_prod[of "C ♢⇩r B" "A"], assumption+)
 apply (frule sym) apply (thin_tac "sum_mult R (C ♢⇩r B) A = (C ♢⇩r B) ♢⇩r A")
 apply simp apply (thin_tac "(C ♢⇩r B) ♢⇩r A = sum_mult R (C ♢⇩r B) A")
 apply (thin_tac "ideal R (C ♢⇩r B)")
 apply (frule ideal_prod_ideal[of "B" "A"], assumption+)
  apply (simp add:sum_mult_def)
  apply (erule exE, erule bexE)
 apply (frule sym, thin_tac "Σ⇩e R f n = x", simp) 
 apply (simp add:ideal_prod_assocTr) 
done

lemma (in Ring) prod_principal_idealTr0:"  ⟦a ∈ carrier R; b ∈ carrier R;
         z ∈ set_mult R (R ♢⇩p a) (R ♢⇩p b)⟧ ⟹  z ∈ R ♢⇩p (a ⋅⇩r b)"
apply (simp add:set_mult_def, (erule bexE)+,
       simp add:Rxa_def, (erule bexE)+, simp)
apply (frule_tac x = r and y = a and z = "ra ⋅⇩r b" in ring_tOp_assoc,
           assumption+, simp add:ring_tOp_closed, simp)
apply (simp add:ring_tOp_assoc[THEN sym, of a _ b])
apply (frule_tac x = a and y = ra in ring_tOp_commute, assumption+, simp)
apply (simp add:ring_tOp_assoc[of _ a b],
       frule_tac x = a and y = b in ring_tOp_closed, assumption)
apply (simp add:ring_tOp_assoc[THEN sym, of _ _ "a ⋅⇩r b"],
       frule sym, thin_tac "r ⋅⇩r ra ⋅⇩r (a ⋅⇩r b) = z", simp,
       frule_tac x = r and y = ra in ring_tOp_closed, assumption+)
apply blast
done
 

lemma (in Ring) prod_principal_idealTr1:"  ⟦a ∈ carrier R; b ∈ carrier R⟧ ⟹
      ∀f ∈ {j. j ≤ (n::nat)} → set_mult R (R ♢⇩p a) (R ♢⇩p b). 
                                         Σ⇩e R f n ∈ R ♢⇩p (a ⋅⇩r b)"
apply (induct_tac n)
 apply (rule ballI, 
        frule_tac f = f in funcset_mem[of _ "{j. j ≤ 0}" 
         "set_mult R (R ♢⇩p a) (R ♢⇩p b)"], simp)
 apply (simp add:prod_principal_idealTr0)
apply (rule ballI,
       frule func_pre,
       frule_tac x = f in bspec, assumption,
       thin_tac "∀f∈{j. j ≤ n} → set_mult R (R ♢⇩p a) (R ♢⇩p b).
                                       Σ⇩e R f n ∈ R ♢⇩p (a ⋅⇩r b)")
 apply (frule ring_tOp_closed[of a b], assumption)
 apply (frule principal_ideal[of "a ⋅⇩r b"], simp,
        rule ideal_pOp_closed, assumption+)
 apply (cut_tac n = "Suc n" in n_in_Nsetn,
        frule_tac f = f and A = "{j. j ≤ Suc n}" and 
        B = "set_mult R (R ♢⇩p a) (R ♢⇩p b)" in funcset_mem, assumption)
 apply (simp add:prod_principal_idealTr0)
done

lemma (in Ring) prod_principal_ideal:"⟦a ∈ carrier R; b ∈ carrier R⟧ ⟹ 
                     (Rxa R a) ♢⇩r (Rxa R b) = Rxa R (a ⋅⇩r b)" 
apply (frule principal_ideal[of "a"], 
       frule principal_ideal[of "b"])
apply (subst sum_mult_is_ideal_prod[THEN sym, of "Rxa R a" "Rxa R b"], 
       assumption+) 
 apply (rule equalityI)
 apply (rule subsetI)
 apply (simp add:sum_mult_def)
 apply (erule exE, erule bexE)
 apply (frule sym, thin_tac "Σ⇩e R f n = x", simp, thin_tac "x = Σ⇩e R f n")
 apply (simp add:prod_principal_idealTr1)

apply (rule subsetI)
 apply (simp add:Rxa_def, fold Rxa_def)
 apply (erule bexE)
 apply (simp add:ring_tOp_assoc[THEN sym])
 apply (frule ideal_subset1[of "R ♢⇩p a"],
        frule ideal_subset1[of "R ♢⇩p b"])
 apply (rule_tac a = "r ⋅⇩r a" and b = b in times_mem_sum_mult[of "R ♢⇩p a" 
         "R ♢⇩p b"], assumption+)
 apply (simp add:Rxa_def, blast)
 apply (simp add:a_in_principal)
done

lemma (in Ring) principal_ideal_n_pow1:"a ∈ carrier R ⟹  
                                  (Rxa R a)⇗♢R n⇖  = Rxa R (a^⇗R n ⇖)"
 apply (cut_tac ring_one)
apply (induct_tac n)
 apply simp 
 apply (cut_tac a_in_principal[of "1⇩r"])
 apply (frule principal_ideal[of "1⇩r"])
 apply (frule ideal_inc_one, assumption, simp)
 apply (simp add:ring_one)
 apply simp
 apply (frule_tac n = n in npClose[of a],
        subst prod_principal_ideal, assumption+)
 apply (simp add:ring_tOp_commute)
done

lemma (in Ring) principal_ideal_n_pow:"⟦a ∈ carrier R; I = Rxa R a⟧ ⟹  
                                  I ⇗♢R n⇖  = Rxa R (a^⇗R n⇖)"
apply simp 
apply (rule principal_ideal_n_pow1[of "a" "n"], assumption+)
done

text‹more about ‹ideal_n_prod››

lemma (in Ring) nprod_eqTr:" f ∈ {j. j ≤ (n::nat)} → carrier R ∧
       g ∈ {j. j ≤ n} → carrier R ∧ (∀j ≤ n. f j = g j) ⟶
       nprod R f n = nprod R g n" 
apply (induct_tac n)
  apply simp
apply (rule impI, (erule conjE)+)
  apply (frule func_pre[of f], frule func_pre[of g],
         cut_tac n = n in Nsetn_sub_mem1, simp)
done

lemma (in Ring) nprod_eq:"⟦∀j ≤ n. f j ∈ carrier R; ∀j ≤ n. g j ∈ carrier R;
(∀j ≤ (n::nat). f j = g j)⟧ ⟹ nprod R f n = nprod R g n"
apply (cut_tac nprod_eqTr[of f n g])
apply simp
done

definition
  mprod_expR :: "[('b, 'm) Ring_scheme, nat ⇒ nat, nat ⇒ 'b, nat] ⇒ 'b" where
  "mprod_expR R e f n = nprod R (λj. ((f j)^⇗R (e j)⇖)) n"

 (** Note that e j is a natural number for all j in Nset n **)

lemma (in Ring) mprodR_Suc:"⟦e ∈ {j. j ≤ (Suc n)} → {j. (0::nat) ≤ j};
                 f ∈ {j. j ≤ (Suc n)} → carrier R⟧ ⟹ 
       mprod_expR R e f (Suc n) = 
            (mprod_expR R e f n) ⋅⇩r ((f (Suc n))^⇗R (e (Suc n))⇖)"
apply (simp add:mprod_expR_def)
done  

lemma (in Ring) mprod_expR_memTr:"e ∈ {j. j ≤ n} → {j. (0::nat) ≤ j} ∧ 
       f ∈ {j. j ≤ n} → carrier R  ⟶  mprod_expR R e f n ∈ carrier R"
apply (induct_tac n)
 apply (rule impI, (erule conjE)+)
 apply (cut_tac n_in_Nsetn[of 0], 
        simp add: mprod_expR_def)
 apply (rule npClose,
        simp add:Pi_def)

apply (rule impI, (erule conjE)+)
 apply (frule func_pre[of "e"], frule func_pre[of "f"])
 apply simp
 apply (simp add:mprodR_Suc)
 apply (rule ring_tOp_closed, assumption+)
 apply (rule npClose, cut_tac n = "Suc n" in n_in_Nsetn)
 apply (simp add:Pi_def)
done

lemma (in Ring) mprod_expR_mem:"⟦ e ∈ {j. j ≤ n} → {j. (0::nat) ≤ j};
       f ∈ {j. j ≤ n} → carrier R⟧   ⟹  mprod_expR R e f n ∈ carrier R"
apply (simp add:mprod_expR_memTr)
done  

lemma (in Ring) prod_n_principal_idealTr:"e ∈ {j. j≤n} → {j. (0::nat)≤j} ∧ 
f ∈ {j. j≤n} → carrier R ∧ (∀k ≤ n. J k = (Rxa R (f k))⇗♢R (e k)⇖) ⟶
                 ideal_n_prod R n J = Rxa R (mprod_expR R e f n)"
apply (induct_tac n)
 apply (rule impI) apply (erule conjE)+
 apply (simp add:mprod_expR_def)
 apply (subgoal_tac "J 0 = R ♢⇩p (f 0) ⇗♢R (e 0)⇖")
 apply simp
 apply (rule principal_ideal_n_pow[of "f 0" "R ♢⇩p (f 0)"])
 apply (cut_tac n_in_Nsetn[of 0], simp add:Pi_def) apply simp
 apply (cut_tac n_in_Nsetn[of 0], simp)

apply (rule impI, (erule conjE)+)
 apply (frule func_pre[of "e"], frule func_pre[of "f"])
 apply (cut_tac n = n in Nsetn_sub_mem1,
        simp add:mprodR_Suc)
 apply (cut_tac n = "Suc n" in n_in_Nsetn, simp)
 apply (frule_tac A = "{j. j ≤ Suc n}" and x = "Suc n" in funcset_mem[of "f" _ "carrier R"], simp)
 apply (frule_tac a = "f (Suc n)" and I = "R ♢⇩p (f (Suc n))" and n = "e (Suc n)" in  principal_ideal_n_pow) apply simp
 apply (subst prod_principal_ideal[THEN sym])
 apply (simp add:mprod_expR_mem)
 apply (rule npClose, assumption+) apply simp 
done

(************* used in Valuation2.thy *****************)
lemma (in Ring) prod_n_principal_ideal:"⟦e ∈ {j. j≤n} → {j. (0::nat)≤j};  
f ∈ {j. j≤n} → carrier R; ∀k≤ n. J k = (Rxa R (f k))⇗♢R (e k)⇖⟧ ⟹
                 ideal_n_prod R n J = Rxa R (mprod_expR R e f n)"
apply (simp add:prod_n_principal_idealTr[of e n f J])
done  
(*******************************************************)

lemma (in Idomain) a_notin_n_pow1:"⟦a ∈ carrier R; ¬ Unit R a; a ≠ 𝟬; 0 < n⟧
  ⟹  a ∉ (Rxa R a) ⇗♢R  (Suc n)⇖" 
apply (rule contrapos_pp)
 apply (simp del:ipSuc) apply (simp del:ipSuc)
 apply (frule principal_ideal[of "a"])
 apply (frule principal_ideal_n_pow[of "a" "R ♢⇩p a" "Suc n"]) 
 apply simp apply (simp del:ipSuc)
 apply (thin_tac "R ♢⇩p a ⇗♢R (Suc n)⇖ = R ♢⇩p (a^⇗R n⇖ ⋅⇩r a)")
 apply (thin_tac "ideal R (R ♢⇩p a)")
 apply (simp add:Rxa_def)
 apply (erule bexE)
apply (frule npClose[of "a" "n"])
 apply (simp add:ring_tOp_assoc[THEN sym])
 apply (frule ring_l_one[THEN sym, of "a"])
 apply (subgoal_tac "1⇩r ⋅⇩r a = r ⋅⇩r a^⇗R n⇖ ⋅⇩r a") 
 apply (cut_tac b = "r ⋅⇩r (a^⇗R n⇖)" in idom_mult_cancel_r[of "1⇩r" _ "a"])
 apply (simp add:ring_one) apply (simp add:ring_tOp_closed)
 apply assumption+
 apply (thin_tac "1⇩r ⋅⇩r a = r ⋅⇩r a^⇗R n⇖ ⋅⇩r a",
        thin_tac "a = 1⇩r ⋅⇩r a",
        thin_tac "a = r ⋅⇩r a^⇗R n⇖ ⋅⇩r a")
 apply (subgoal_tac "1⇩r = r ⋅⇩r (a^⇗R (Suc (n - Suc 0))⇖)") prefer 2
 apply (simp del:ipSuc) 
 apply (thin_tac "1⇩r = r ⋅⇩r a^⇗R n⇖")
 apply (simp del:Suc_pred)
 apply (frule npClose[of "a" "n - Suc 0"])
 apply (simp add:ring_tOp_assoc[THEN sym])
 apply (frule_tac x = r and y = "a^⇗R (n - Suc 0)⇖" in ring_tOp_closed, assumption)
 apply (simp add:ring_tOp_commute[of _ a])
 apply (simp add:Unit_def) apply blast
 apply simp
done

lemma (in Idomain) a_notin_n_pow2:"⟦a ∈ carrier R; ¬ Unit R a; a ≠ 𝟬; 
 0 < n⟧ ⟹ a^⇗R n⇖ ∉ (Rxa R a) ⇗♢R (Suc n)⇖"
apply (rule contrapos_pp)
 apply (simp del:ipSuc, simp del:ipSuc)
 apply (frule principal_ideal[of "a"])
 apply (frule principal_ideal_n_pow[of "a" "R ♢⇩p a" "Suc n"])
 apply (simp, simp del:ipSuc)
 apply (thin_tac "R ♢⇩p a ⇗♢R (Suc n)⇖ = R ♢⇩p (a^⇗R n⇖ ⋅⇩r a)")
 apply (thin_tac "ideal R (R ♢⇩p a)")
apply (simp add:Rxa_def) 
 apply (erule bexE)
 apply (frule idom_potent_nonzero[of "a" "n"], assumption+)
 apply (frule npClose[of "a" "n"])
 apply (frule ring_l_one[THEN sym, of "a^⇗R n⇖ "])
 apply (subgoal_tac "1⇩r ⋅⇩r (a^⇗R n⇖) =  r ⋅⇩r ((a^⇗R n⇖) ⋅⇩r a)")
 prefer 2 apply simp 
 apply (thin_tac "a^⇗R n⇖ = 1⇩r ⋅⇩r a^⇗R n⇖",
        thin_tac "a^⇗R n⇖ = r ⋅⇩r (a^⇗R n⇖ ⋅⇩r a)")
 apply (simp add:ring_tOp_commute[of "a^⇗R n⇖" a])
 apply (simp add:ring_tOp_assoc[THEN sym])
 apply (cut_tac ring_one,
        frule_tac b = "r ⋅⇩r a" in idom_mult_cancel_r[of "1⇩r" _ "a^⇗R n⇖"],
        simp add:ring_tOp_closed,
        assumption+)
 apply (simp add:ring_tOp_commute[of _ a])
 apply (simp add:Unit_def, blast)
done

lemma (in Idomain) n_pow_not_prime:"⟦a ∈ carrier R; a ≠ 𝟬;  0 < n⟧
            ⟹   ¬ prime_ideal R ((Rxa R a) ⇗♢R (Suc n)⇖)"
apply (case_tac "n = 0") 
 apply simp 
apply (case_tac "Unit R a")
 apply (simp del:ipSuc add:prime_ideal_def, rule impI)
 apply (frule principal_ideal[of "a"])
 apply (frule principal_ideal_n_pow[of "a" "R ♢⇩p a" "Suc n"]) 
 apply simp apply (simp del:npow_suc)
 apply (simp del:npow_suc add:idom_potent_unit [of "a" "Suc n"])
 apply (thin_tac "R ♢⇩p a ♢⇩r R ♢⇩p a ⇗♢R n⇖ = R ♢⇩p (a^⇗R (Suc n)⇖)")
 apply (frule npClose[of "a" "Suc n"])
 apply (frule a_in_principal[of "a^⇗R (Suc n)⇖"])
 apply (simp add: ideal_inc_unit)
 apply (frule a_notin_n_pow1[of "a" "n"], assumption+)
 apply (frule a_notin_n_pow2[of "a" "n"], assumption+)

 apply (frule npClose[of "a" "n"])
 apply (frule principal_ideal[of "a"])
 apply (frule principal_ideal_n_pow[of "a" "R ♢⇩p a" "Suc n"])
 apply simp apply (simp del:ipSuc npow_suc)
 apply (thin_tac "R ♢⇩p a ⇗♢R (Suc n)⇖ = R ♢⇩p (a^⇗R (Suc n)⇖)")
 apply (subst prime_ideal_def) 
 apply (simp del:npow_suc) apply (rule impI)
 apply (subgoal_tac "(a^⇗R n⇖) ⋅⇩r a ∈ R ♢⇩p (a^⇗R (Suc n)⇖)")
 apply blast

 apply (simp add:Rxa_def)
  apply (frule ring_tOp_closed[of "a" "a^⇗R n⇖"], assumption+)
 apply (frule ring_l_one[THEN sym, of "a ⋅⇩r (a^⇗R n⇖)"])
 apply (cut_tac ring_one)
 apply (simp add:ring_tOp_commute[of _ a], blast)
done

lemma (in Idomain) principal_pow_prime_condTr:
  "⟦a ∈ carrier R; a ≠ 𝟬; prime_ideal R ((Rxa R a) ⇗♢R (Suc n)⇖)⟧ ⟹ n = 0"
apply (rule contrapos_pp, (simp del:ipSuc)+) 
apply (frule n_pow_not_prime[of  "a" "n"], assumption+)
apply (simp del:ipSuc)
done

lemma (in Idomain) principal_pow_prime_cond:
  "⟦a ∈ carrier R; a ≠ 𝟬;  prime_ideal R ((Rxa R a) ⇗♢R n⇖)⟧ ⟹ n = Suc 0"
apply (case_tac "n = 0")
 apply simp
 apply (simp add:prime_ideal_def) apply (erule conjE)
 apply (cut_tac ring_one, simp)
apply (subgoal_tac "prime_ideal R (R ♢⇩p a ⇗♢R (Suc (n - Suc 0))⇖)")
apply (frule principal_pow_prime_condTr[of "a" "n - Suc 0"], assumption+)
apply simp apply simp
done

section "Extension and contraction"


locale TwoRings = Ring +
       fixes R' (structure)
       assumes secondR: "Ring R'"


definition
  i_contract :: "['a ⇒ 'b, ('a, 'm1) Ring_scheme, ('b, 'm2) Ring_scheme,
    'b set]  ⇒ 'a set" where
  "i_contract f R R' J = invim f (carrier R) J"

definition
  i_extension :: "['a ⇒ 'b, ('a, 'm1) Ring_scheme, ('b, 'm2) Ring_scheme,
           'a set] ⇒ 'b set" where
  "i_extension f R R' I = sum_mult R' (f ` I) (carrier R')"

lemma (in TwoRings) i_contract_sub:"⟦f ∈ rHom R R'; ideal R' J ⟧ ⟹
                       (i_contract f R R' J) ⊆ carrier R"
  by (auto simp add:i_contract_def invim_def)

lemma (in TwoRings) i_contract_ideal:"⟦f ∈ rHom R R'; ideal R' J ⟧ ⟹
                                          ideal R (i_contract f R R' J)"
 apply (cut_tac Ring,
        cut_tac secondR)
apply (rule ideal_condition)
apply (simp add:i_contract_sub)
apply (simp add:i_contract_def invim_def)
 apply (cut_tac ring_zero)
 apply (cut_tac Ring)
 apply (frule rHom_0_0[of R R' f], assumption+,
        cut_tac Ring.ideal_zero[of R' J])
 apply (frule sym, thin_tac "f 𝟬 = 𝟬⇘R'⇙", simp, blast,
        assumption+)
apply (rule ballI)+
 apply (simp add:i_contract_def invim_def, (erule conjE)+)
 apply (cut_tac ring_is_ag,
        frule_tac x = y in aGroup.ag_mOp_closed[of R], assumption)
 apply (simp add:aGroup.ag_pOp_closed)
 apply (simp add:rHom_add) 
 apply (frule_tac x = y in rHom_inv_inv[of R R' _ f], assumption+, simp,
        thin_tac "f (-⇩a y) = -⇩a⇘R'⇙ (f y)",
        frule_tac x = "f y" in Ring.ideal_inv1_closed[of R' J], assumption+,
        rule Ring.ideal_pOp_closed[of R'], assumption+)
 apply ((rule ballI)+,
        simp add:i_contract_def invim_def, erule conjE,
        simp add:ring_tOp_closed,
        simp add:rHom_tOp)
 apply (frule_tac a = r in rHom_mem[of f R R'], assumption,
        simp add:Ring.ideal_ring_multiple[of R' J])
done

lemma (in TwoRings) i_contract_mono:"⟦f ∈ rHom R R'; ideal R' J1; ideal R' J2;
 J1 ⊆ J2 ⟧ ⟹ i_contract f R R' J1 ⊆ i_contract f R R' J2"
apply (rule subsetI)
apply (simp add:i_contract_def invim_def) apply (erule conjE)
apply (rule subsetD, assumption+)
done

lemma (in TwoRings) i_contract_prime:"⟦f ∈ rHom R R'; prime_ideal R' P⟧ ⟹ 
                            prime_ideal R (i_contract f R R' P)"
apply (cut_tac Ring,
        cut_tac secondR)
apply (simp add:prime_ideal_def, (erule conjE)+)
 apply (simp add:i_contract_ideal)
 apply (rule conjI)
 apply (rule contrapos_pp, simp+)
 apply (simp add:i_contract_def invim_def, erule conjE)
 apply (simp add:rHom_one)
apply (rule ballI)+
 apply (frule_tac a = x in rHom_mem[of "f" "R" "R'"], assumption+,
        frule_tac a = y in rHom_mem[of "f" "R" "R'"], assumption+)
 apply (rule impI)
 apply (simp add:i_contract_def invim_def, erule conjE)
 apply (simp add:rHom_tOp)
done   

lemma (in TwoRings) i_extension_ideal:"⟦f ∈ rHom R R'; ideal R I ⟧ ⟹
                            ideal R' (i_extension f R R' I)"
apply (cut_tac Ring, cut_tac secondR)
apply (simp add:i_extension_def)
apply (rule Ring.ideal_sum_mult [of "R'" "f ` I" "carrier R'"], assumption+)
apply (rule subsetI)
apply (simp add:image_def)
   apply (erule bexE, frule_tac a = xa in rHom_mem[of f R R'],
          rule ideal_subset, assumption+, simp)
 apply (frule ideal_zero, simp, blast)
 apply (simp add:Ring.whole_ideal[of R'])
done

lemma (in TwoRings) i_extension_mono:"⟦f ∈ rHom R R'; ideal R I1; ideal R I2;
 I1 ⊆ I2 ⟧ ⟹ (i_extension f R R' I1) ⊆ (i_extension f R R' I2)"
apply (rule subsetI)
 apply (simp add:i_extension_def)
 apply (simp add:sum_mult_def)
 apply (erule exE, erule bexE)
 apply (cut_tac Ring.set_mult_mono[of R' "f ` I1" "f ` I2" "carrier R'"])
 apply (frule_tac f = fa and A = "{j. j ≤ n}" in extend_fun[of _ _ 
     "set_mult R' (f ` I1) (carrier R')" "set_mult R' (f ` I2) (carrier R')"],
     assumption+) apply blast
 apply (simp add:secondR)
 apply (simp add:image_def, rule subsetI, simp, erule bexE,
       frule_tac h = xb in ideal_subset[of I1], assumption, simp add:rHom_mem) 
 apply (simp add:image_def, rule subsetI, simp, erule bexE,
       frule_tac h = xb in ideal_subset[of I2], assumption, simp add:rHom_mem)
 apply (rule subsetI,
        simp add:image_def, erule bexE,
        frule_tac c = xb in subsetD[of I1 I2], assumption+, blast)
 apply simp
done 

lemma (in TwoRings) e_c_inc_self:"⟦f ∈ rHom R R'; ideal R I⟧ ⟹
              I ⊆ i_contract f R R' (i_extension f R R' I)"
apply (rule subsetI)
 apply (simp add:i_contract_def i_extension_def invim_def)
 apply (simp add:ideal_subset)
 apply (cut_tac secondR,
        frule Ring.ring_one [of "R'"])
 apply (frule_tac h = x in ideal_subset[of I], assumption,
        frule_tac f = f and A = R and R = R' and a = x in rHom_mem, assumption)
 apply (frule_tac t = "f x" in Ring.ring_r_one[THEN sym, of R'], assumption)
 apply (frule_tac a = "f x" and b = "1⇩r⇘R'⇙" in Ring.times_mem_sum_mult[of R'
                 "f ` I" "carrier R'"],
       rule subsetI,
       simp add:image_def, erule bexE,
       frule_tac h = xb in ideal_subset[of I], assumption,
       simp add:rHom_mem, simp,
       simp add:image_def, blast, assumption+)
 apply simp
done
       
lemma (in TwoRings) c_e_incd_self:"⟦f ∈ rHom R R'; ideal R' J ⟧ ⟹
                          i_extension f R R' (i_contract f R R' J) ⊆ J"
apply (rule subsetI)
 apply (simp add:i_extension_def)
 apply (simp add:sum_mult_def)
 apply (erule exE, erule bexE)
 apply (cut_tac secondR,
        frule_tac n = n and f = fa in Ring.ideal_nsum_closed[of R' J ],
        assumption)
 apply (rule allI, rule impI) apply (
        frule_tac f = fa and A = "{j. j ≤ n}" and 
        B = "set_mult R' (f ` i_contract f R R' J) (carrier R')" and x = j in
        funcset_mem, simp) apply (
  thin_tac "fa ∈ {j. j ≤ n} → set_mult R' (f ` i_contract f R R' J) (carrier R')")
  apply (simp add:set_mult_def, (erule bexE)+,
         simp add:i_contract_def invim_def, erule conjE)
  apply (frule_tac x = "f xa" and r = y in Ring.ideal_ring_multiple1[of R' J],
         assumption+, simp)
       
  apply simp
done

lemma (in TwoRings) c_e_c_eq_c:"⟦f ∈ rHom R R'; ideal R' J ⟧ ⟹
  i_contract f R R' (i_extension f R R' (i_contract f R R' J)) 
                                          = i_contract f R R' J"
apply (frule i_contract_ideal [of "f" "J"], assumption)
apply (frule e_c_inc_self [of "f" "i_contract f R R' J"], assumption+)
apply (frule c_e_incd_self [of "f" "J"], assumption+)
apply (frule i_contract_mono [of "f" 
         "i_extension f R R' (i_contract f R R' J)" "J"])
apply (rule i_extension_ideal, assumption+)
apply (rule equalityI, assumption+)
done

lemma (in TwoRings) e_c_e_eq_e:"⟦f ∈ rHom R R'; ideal R I ⟧ ⟹
  i_extension f R R' (i_contract f R R' (i_extension f R R' I)) 
                                          = i_extension f R R' I"
apply (frule i_extension_ideal [of "f" "I"], assumption+)
apply (frule c_e_incd_self [of "f" "i_extension f R R' I"], assumption+)
apply (rule equalityI, assumption+)
 apply (thin_tac "i_extension f R R' (i_contract f R R' (i_extension f R R' I))
       ⊆ i_extension f R R' I")
apply (frule e_c_inc_self [of "f" "I"], assumption+)
apply (rule i_extension_mono [of "f" "I" 
               "i_contract f R R' (i_extension f R R' I)"], assumption+)
apply (rule i_contract_ideal, assumption+)
done

section "Complete system of representatives"

definition
  csrp_fn :: "[_, 'a set] ⇒ 'a set ⇒ 'a" where
  "csrp_fn R I = (λx∈carrier (R /⇩r I). (if x = I then 𝟬⇘R⇙ else SOME y. y ∈ x))"
 
definition
  csrp :: "[_ , 'a set] ⇒ 'a set" where
  "csrp R I == (csrp_fn R I) ` (carrier (R /⇩r I))"

(** complete system of representatives having 1-1 correspondence with
    carrier  (R /⇩r I) **)

lemma (in Ring) csrp_mem:"⟦ideal R I; a ∈ carrier R⟧ ⟹
                           csrp_fn R I (a ⊎⇘R⇙ I) ∈ a ⊎⇘R⇙ I"
apply (simp add:csrp_fn_def qring_carrier) 
apply (case_tac "a ⊎⇘R⇙ I = I") apply simp
 apply (rule conjI, rule impI)
 apply (simp add:ideal_zero)
 apply (rule impI)
 apply (cut_tac ring_zero)
 apply (frule_tac x = 𝟬  in bspec, assumption+)
 apply (thin_tac "∀a∈carrier R. a ⊎⇘R⇙ I ≠ I")
 apply (frule ideal_zero[of "I"])
 apply (frule ar_coset_same4[of "I" "𝟬"], assumption+, simp)
apply simp
 apply (rule conjI)
 apply (rule impI, rule someI2_ex)
 apply (frule a_in_ar_coset[of "I" "a"], assumption+, blast, assumption+)
apply (rule impI)
 apply (frule_tac x = a in bspec, assumption+,
        thin_tac "∀aa∈carrier R. aa ⊎⇘R⇙ I ≠ a ⊎⇘R⇙ I", simp)
done

lemma (in Ring) csrp_same:"⟦ideal R I; a ∈ carrier R⟧ ⟹
                           csrp_fn R I (a ⊎⇘R⇙ I) ⊎⇘R⇙ I = a ⊎⇘R⇙ I"
apply (frule csrp_mem[of "I" "a"], assumption+)
apply (rule ar_cos_same[of "a" "I" "csrp_fn R I (a ⊎⇘R⇙ I)"], assumption+)
done

lemma (in Ring) csrp_mem1:"⟦ideal R I; x ∈ carrier (R /⇩r I)⟧ ⟹
                           csrp_fn R I x ∈ x"
apply (simp add:qring_carrier, erule bexE, frule sym,
       thin_tac "a ⊎⇘R⇙ I = x", simp)
apply (simp add:csrp_mem)
done

lemma (in Ring) csrp_fn_mem:"⟦ideal R I; x ∈ carrier (R /⇩r I)⟧ ⟹
                              (csrp_fn R I x) ∈ carrier R"
apply (simp add:qring_carrier, erule bexE, frule sym,
       thin_tac "a ⊎⇘R⇙ I = x", simp,
       frule_tac a = a in csrp_mem[of "I"], assumption+) 
apply (rule_tac a = a and x = "csrp_fn R I (a ⊎⇘R⇙ I)" in 
       ar_coset_subsetD[of  "I"], assumption+)
done

lemma (in Ring) csrp_eq_coset:"⟦ideal R I; x ∈ carrier (R /⇩r I)⟧ ⟹
                           (csrp_fn R I x) ⊎⇘R⇙ I = x"
apply (simp add:qring_carrier, erule bexE)
apply (frule sym, thin_tac "a ⊎⇘R⇙ I = x", simp)
 apply (frule_tac a = a in csrp_mem[of  "I"], assumption+)
apply (rule ar_cos_same, assumption+)
done 

lemma (in Ring) csrp_nz_nz:"⟦ideal R I; x ∈ carrier (R /⇩r I);
        x ≠ 𝟬⇘(R /⇩r I)⇙⟧ ⟹ (csrp_fn R I x) ≠ 𝟬"
apply (rule contrapos_pp, simp+)
apply (frule csrp_eq_coset[of "I" "x"], assumption+, simp)
apply (simp add:qring_zero[of "I"])
apply (frule ideal_zero[of  "I"]) apply (
       cut_tac ring_zero)
       apply (simp add:Qring_fix1 [of "𝟬" "I"])
done


lemma (in Ring) csrp_diff_in_vpr:"⟦ideal R I; x ∈ carrier R⟧ ⟹
              x ± (-⇩a (csrp_fn R I (pj R I x))) ∈ I"
apply (frule csrp_mem[of "I" "x"], 
       frule csrp_same[of "I" "x"], 
       simp add:pj_mem, assumption,
       frule  ar_coset_subsetD[of I x "csrp_fn R I (x ⊎⇘R⇙ I)"],
       assumption+)  
apply (frule belong_ar_coset2[of I x "csrp_fn R I (x ⊎⇘R⇙ I)"], assumption+,
     frule ideal_inv1_closed[of I "csrp_fn R I (x ⊎⇘R⇙ I) ± -⇩a x"], assumption+,
     cut_tac ring_is_ag,
     frule aGroup.ag_mOp_closed[of R x], assumption,
     simp add:aGroup.ag_pOp_commute[of R "csrp_fn R I (x ⊎⇘R⇙ I)" "-⇩a x"]) 
apply (simp add:aGroup.ag_p_inv[of R "-⇩a x" "csrp_fn R I (x ⊎⇘R⇙ I)"],
       simp add:aGroup.ag_inv_inv,
       cut_tac Ring, simp add:pj_mem[of R I x])
done

lemma (in Ring) csrp_pj:"⟦ideal R I; x ∈ carrier (R /⇩r I)⟧ ⟹
                 (pj R I) (csrp_fn R I x) = x"
apply(cut_tac Ring,
      frule csrp_fn_mem[of "I" "x"], assumption+,
      simp add:pj_mem[of "R" "I" "csrp_fn R I x"],
      simp add:csrp_eq_coset)
done

section "Polynomial ring" 

text‹In this section, we treat a ring of polynomials over a ring S.
       Numbers are of type ant›

definition
  pol_coeff :: "[('a, 'more) Ring_scheme, (nat × (nat ⇒ 'a))] ⇒ bool" where
  "pol_coeff S c ⟷ (∀j ≤ (fst c). (snd c) j ∈ carrier S)"

definition
  c_max :: "[('a, 'more) Ring_scheme, nat × (nat ⇒ 'a)] ⇒ nat" where
  "c_max S c = (if {j. j ≤ (fst c) ∧ (snd c) j ≠ 𝟬⇘S⇙} = {} then 0 else
                   n_max {j. j ≤ (fst c) ∧ (snd c) j ≠ 𝟬⇘S⇙})"

definition
  polyn_expr :: "[('a, 'more) Ring_scheme, 'a, nat, nat × (nat ⇒ 'a)]  ⇒ 'a" where
  "polyn_expr R X k c == nsum R (λj. ((snd c) j) ⋅⇩r⇘R⇙ (X^⇗R j⇖)) k"

definition
  algfree_cond :: "[('a, 'm) Ring_scheme, ('a, 'm1) Ring_scheme,
                                                'a] ⇒ bool" where
  "algfree_cond R S X ⟷ (∀c. pol_coeff S c ∧ (∀k ≤ (fst c).  
             (nsum R (λj. ((snd c) j) ⋅⇩r⇘R⇙ (X^⇗R j⇖)) k = 𝟬⇘R⇙ ⟶ 
             (∀j ≤ k. (snd c) j = 𝟬⇘S⇙))))"

locale PolynRg = Ring +
       fixes S (structure)
       fixes X (structure)
       assumes X_mem_R:"X ∈ carrier R"
       and not_zeroring:"¬ zeroring S"
       and subring:  "Subring R S"
       and algfree: "algfree_cond R S X"
       and S_X_generate:"x ∈ carrier R ⟹
           ∃f. pol_coeff S f ∧ x = polyn_expr R X (fst f) f"

(** a polynomial is an element of a polynomial ring **)
section ‹Addition and multiplication of ‹polyn_exprs››

subsection ‹Simple properties of a ‹polyn_ring››

lemma Subring_subset:"Subring R S ⟹ carrier S ⊆ carrier R"
by (simp add:Subring_def)

lemma (in Ring) subring_Ring:"Subring R S ⟹ Ring S"
by (simp add:Subring_def)

lemma (in Ring) mem_subring_mem_ring:"⟦Subring R S; x ∈ carrier S⟧ ⟹
                      x ∈ carrier R"
by (simp add:Subring_def, (erule conjE)+, simp add: subsetD)

lemma (in Ring) Subring_pOp_ring_pOp:"⟦Subring R S; a ∈ carrier S;
 b ∈ carrier S ⟧ ⟹ a ±⇘S⇙ b = a ± b"
apply (simp add:Subring_def, (erule conjE)+)
apply (frule rHom_add[of "ridmap S" S R a b], assumption+)
apply (cut_tac Ring.ring_is_ag[of S],
       frule aGroup.ag_pOp_closed[of S a b], assumption+,
       simp add:ridmap_def, assumption)
done

lemma (in Ring) Subring_tOp_ring_tOp:"⟦Subring R S; a ∈ carrier S;
              b ∈ carrier S ⟧ ⟹ a ⋅⇩r⇘S⇙ b = a ⋅⇩r b"
apply (simp add:Subring_def, (erule conjE)+)
apply (frule rHom_tOp[of "S" "R" "a" "b" "ridmap S"], rule Ring_axioms, assumption+)
apply (frule Ring.ring_tOp_closed[of "S" "a" "b"], assumption+,
       simp add:ridmap_def)
done

lemma (in Ring) Subring_one_ring_one:"Subring R S ⟹ 1⇩r⇘S⇙ = 1⇩r"
apply (simp add:Subring_def, (erule conjE)+)
apply (frule rHom_one[of "S" "R" "ridmap S"], rule Ring_axioms, assumption+)
apply (simp add:ridmap_def, simp add:Ring.ring_one[of S])
done

lemma (in Ring) Subring_zero_ring_zero:"Subring R S ⟹ 𝟬⇘S⇙ = 𝟬"
apply (simp add:Subring_def, (erule conjE)+,
       frule rHom_0_0[of "S" "R" "ridmap S"], rule Ring_axioms, assumption+,
       simp add:ridmap_def, simp add:Ring.ring_zero[of "S"])
done

lemma (in Ring) Subring_minus_ring_minus:"⟦Subring R S; x ∈ carrier S⟧
      ⟹ -⇩a⇘S⇙ x = -⇩a x"
apply (simp add:Subring_def, (erule conjE)+, simp add:rHom_def, (erule conjE)+)
apply (cut_tac ring_is_ag, frule Ring.ring_is_ag[of "S"])
apply (frule aHom_inv_inv[of "S" "R" "ridmap S" "x"], assumption+,
       frule aGroup.ag_mOp_closed[of "S" "x"], assumption+)
apply (simp add:ridmap_def)
done 

lemma (in PolynRg) Subring_pow_ring_pow:"x ∈ carrier S ⟹
                   x^⇗S n⇖ = x^⇗R n⇖"
apply (cut_tac subring, frule subring_Ring)          
apply (induct_tac n)
 apply (simp, simp add:Subring_one_ring_one)
apply (frule_tac n = n in Ring.npClose[of S x], assumption+)
apply (simp add:Subring_tOp_ring_tOp)
done

lemma (in PolynRg) is_Ring: "Ring R" ..

lemma (in PolynRg) polyn_ring_nonzero:"1⇩r ≠ 𝟬"
apply (cut_tac Ring, cut_tac subring)
apply (simp add:Subring_zero_ring_zero[THEN sym])
  apply (simp add:Subring_one_ring_one[THEN sym])
  using Ring.Zero_ring1 not_zeroring subring_Ring apply blast
done

lemma (in PolynRg) polyn_ring_S_nonzero:"1⇩r⇘S⇙ ≠ 𝟬⇘S⇙"
apply (cut_tac subring)
apply (simp add:Subring_zero_ring_zero)
apply (simp add:Subring_one_ring_one)
apply (simp add:polyn_ring_nonzero)
done

lemma (in PolynRg) polyn_ring_X_nonzero:"X ≠ 𝟬"
apply (cut_tac algfree,
       cut_tac subring)
apply (simp add:algfree_cond_def)
apply (rule contrapos_pp, simp+)
apply (drule_tac x = "Suc 0" in spec)
 apply (subgoal_tac "pol_coeff S ((Suc 0), 
          (λj∈{l. l ≤ (Suc 0)}. if j = 0 then 𝟬⇘S⇙ else 1⇩r⇘S⇙))")
 apply (drule_tac x = "λj∈{l. l ≤ (Suc 0)}. if j = 0 then 𝟬⇘S⇙ else 1⇩r⇘S⇙" in 
        spec) 
 apply (erule conjE, simp)
 apply (simp only:Nset_1)
 apply (drule_tac a = "Suc 0" in forall_spec, simp)
 apply simp
 apply (cut_tac subring, simp add:Subring_zero_ring_zero,
        simp add:Subring_one_ring_one, cut_tac ring_zero, cut_tac ring_one,
        simp add:ring_r_one, simp add:ring_times_x_0, cut_tac ring_is_ag,
          simp add:aGroup.ag_r_zero,
        drule_tac a = "Suc 0" in forall_spec, simp, simp)
 apply (cut_tac polyn_ring_S_nonzero, simp add:Subring_zero_ring_zero)

 apply (thin_tac "∀b. pol_coeff S (Suc 0, b) ∧
         (∀k≤Suc 0. Σ⇩e R (λj. b j ⋅⇩r 𝟬^⇗R j⇖) k = 𝟬 ⟶ (∀j≤k. b j = 𝟬⇘S⇙))",
        simp add:pol_coeff_def,
        rule allI,
        simp add:Subring_def, simp add:Ring.ring_zero,
        (rule impI)+,
        simp add:Ring.ring_one)
done

subsection "Coefficients of a polynomial" 

lemma (in PolynRg) pol_coeff_split:"pol_coeff S f = pol_coeff S (fst f, snd f)"
by simp

lemma (in PolynRg) pol_coeff_cartesian:"pol_coeff S c ⟹
                   (fst c, snd c) = c"
by simp

lemma (in PolynRg) split_pol_coeff:"⟦pol_coeff S c; k ≤ (fst c)⟧ ⟹
                                               pol_coeff S (k, snd c)"
by (simp add:pol_coeff_def)

lemma (in PolynRg) pol_coeff_pre:"pol_coeff S ((Suc n), f) ⟹ 
                   pol_coeff S (n, f)"
apply (simp add:pol_coeff_def)
done

lemma (in PolynRg) pol_coeff_le:"⟦pol_coeff S c; n ≤ (fst c)⟧ ⟹
                               pol_coeff S (n, (snd c))"
apply (simp add:pol_coeff_def) 
done

lemma (in PolynRg) pol_coeff_mem:"⟦pol_coeff S c; j ≤ (fst c)⟧ ⟹ 
                                                   ((snd c) j) ∈ carrier S"
by (simp add:pol_coeff_def) 

lemma (in PolynRg) pol_coeff_mem_R:"⟦pol_coeff S c; j ≤ (fst c)⟧
                  ⟹  ((snd c) j) ∈ carrier R"
apply (cut_tac subring, frule subring_Ring)
apply (frule pol_coeff_mem[of c "j"], assumption+,
       simp add:mem_subring_mem_ring)
done

lemma (in PolynRg) Slide_pol_coeff:"⟦pol_coeff S c; n < (fst c)⟧ ⟹
        pol_coeff S (((fst c) - Suc n), (λx. (snd c) (Suc (n + x))))"   
apply (simp add: pol_coeff_def)
done

subsection ‹Addition of ‹polyn_exprs››

lemma (in PolynRg) monomial_mem:"pol_coeff S c ⟹ 
                        ∀j ≤ (fst c). (snd c) j ⋅⇩r X^⇗R j⇖ ∈ carrier R"
apply (rule allI, rule impI)
apply (rule ring_tOp_closed) 
apply (simp add:pol_coeff_mem_R[of c],
       cut_tac X_mem_R, simp add:npClose)
done

lemma (in PolynRg) polyn_mem:"⟦pol_coeff S c; k ≤ (fst c)⟧ ⟹ 
                                        polyn_expr R X k c ∈ carrier R"
apply (simp add:polyn_expr_def,
       cut_tac ring_is_ag)
apply (rule aGroup.nsum_mem[of R k "λj. (snd c) j ⋅⇩r X^⇗R j⇖"], assumption+)
apply (simp add:monomial_mem)
done

lemma (in PolynRg) polyn_exprs_eq:"⟦pol_coeff S c; pol_coeff S d; 
         k ≤ (min (fst c) (fst d)); ∀j ≤ k. (snd c) j = (snd d) j⟧ ⟹ 
                     polyn_expr R X k c = polyn_expr R X k d" 
apply (cut_tac ring_is_ag,
       simp add:polyn_expr_def,
       cut_tac subring,
       cut_tac X_mem_R)
apply (rule aGroup.nsum_eq[of R k "λj. (snd c) j ⋅⇩r X^⇗R j⇖"
                                   "λj. (snd d) j ⋅⇩r X^⇗R j⇖"], assumption)
apply (simp add:monomial_mem)+
done

lemma (in PolynRg) polyn_expr_restrict:"pol_coeff S (Suc n, f) ⟹
              polyn_expr R X n (Suc n, f) = polyn_expr R X n (n, f)" 
apply (cut_tac subring, frule subring_Ring,
       cut_tac pol_coeff_le[of "(Suc n, f)" n]) 
apply (cut_tac polyn_exprs_eq[of "(Suc n, f)" "(n, f)" n],
       (simp add:pol_coeff_split[THEN sym])+) 
done

lemma (in PolynRg) polyn_expr_short:"⟦pol_coeff S c; k ≤ (fst c)⟧ ⟹
         polyn_expr R X k c = polyn_expr R X k (k, snd c)"
apply (rule polyn_exprs_eq[of c "(k, snd c)" k], assumption+)
 apply (simp add:pol_coeff_def)
 apply (simp)
 apply simp
done

lemma (in PolynRg) polyn_expr0:"pol_coeff S c ⟹ 
                                   polyn_expr R X 0 c = (snd c) 0"
apply (simp add:polyn_expr_def)
apply (cut_tac subring,
       cut_tac subring_Ring[of S])
apply (frule pol_coeff_mem[of c 0], simp)
 apply (frule mem_subring_mem_ring [of S "(snd c) 0"], assumption)
apply (simp add:ring_r_one, assumption)
done 

lemma (in PolynRg) polyn_expr_split:"
          polyn_expr R X k f = polyn_expr R X k (fst f, snd f)"
by simp

lemma (in PolynRg) polyn_Suc:"Suc n ≤ (fst c) ⟹ 
       polyn_expr R X (Suc n) ((Suc n), (snd c)) = 
               polyn_expr R X n c ± ((snd c) (Suc n)) ⋅⇩r (X^⇗R (Suc n)⇖)"
by (simp add:polyn_expr_def)

lemma (in PolynRg) polyn_Suc_split:"pol_coeff S (Suc n, f) ⟹ 
       polyn_expr R X (Suc n) ((Suc n), f) = 
          polyn_expr R X n (n, f) ± (f (Suc n)) ⋅⇩r (X^⇗R (Suc n)⇖)"
apply (cut_tac polyn_Suc[of n "(Suc n, f)"])
apply (simp del:npow_suc)
 apply (subst polyn_expr_short[of "(Suc n, f)" n], assumption+, simp)
 apply (simp del:npow_suc)
 apply simp
done

lemma (in PolynRg) polyn_n_m:"⟦pol_coeff S c; n < m; m ≤ (fst c)⟧ ⟹ 
      polyn_expr R X m (m, (snd c)) = polyn_expr R X n (n, (snd c)) ±  
                        (fSum R (λj. ((snd c) j) ⋅⇩r (X^⇗R j⇖)) (Suc n) m)"
apply (simp add:polyn_expr_def, cut_tac ring_is_ag)
apply (rule aGroup.nsum_split1[of "R" m "λj. ((snd c) j) ⋅⇩r (X^⇗R j⇖)" n], 
         assumption+)
apply (rule allI, rule impI)
apply (frule_tac monomial_mem[of c],
       frule_tac i = j and j = m and k = "(fst c)" in le_trans, assumption+,
       simp+)
done

lemma (in PolynRg) polyn_n_m1:"⟦pol_coeff S c; n < m; m ≤ (fst c)⟧ ⟹ 
      polyn_expr R X m c = polyn_expr R X n c ±  
                        (fSum R (λj. ((snd c) j) ⋅⇩r (X^⇗R j⇖)) (Suc n) m)"
apply (subst polyn_expr_short[of c n], assumption)
 apply (frule_tac x = n and y = m and z = "fst c" in less_le_trans, assumption,
        simp add:less_imp_le)
 apply (subst polyn_expr_short[of c m], assumption+)
 apply (simp add:polyn_n_m)
done

lemma (in PolynRg) polyn_n_m_mem:"⟦pol_coeff S c; n < m; m ≤ (fst c)⟧ ⟹ 
            (fSum R (λj. ((snd c) j) ⋅⇩r (X^⇗R j⇖)) (Suc n) m) ∈ carrier R"
apply (simp add:fSum_def)
apply (cut_tac ring_is_ag,
       rule_tac n = "m - Suc n" in aGroup.nsum_mem, assumption+)
apply (rule allI, rule impI,
        simp del:npow_suc add:cmp_def slide_def)
apply (rule ring_tOp_closed)
 apply (simp add:pol_coeff_def)
 apply (frule_tac a = "Suc (n + j)" in forall_spec, arith)
 apply (cut_tac subring)
 apply (simp add:mem_subring_mem_ring)
 apply (rule npClose)
 apply (cut_tac X_mem_R,
        simp del:npow_suc add:npClose)
done 

lemma (in PolynRg) polyn_n_ms_eq:"⟦pol_coeff S c; pol_coeff S d;
        m ≤ min (fst c) (fst d); n < m; 
       ∀j∈nset (Suc n) m. (snd c) j = (snd d) j⟧ ⟹ 
            (fSum R (λj. ((snd c) j) ⋅⇩r (X^⇗R j⇖)) (Suc n) m) =
                    (fSum R (λj. ((snd d) j) ⋅⇩r (X^⇗R j⇖)) (Suc n) m)" 
apply (cut_tac ring_is_ag)
apply (cut_tac aGroup.fSum_eq1[of R "Suc n" m "λj. (snd c) j ⋅⇩r X^⇗R j⇖"
                                             "λj. (snd d) j ⋅⇩r X^⇗R j⇖"],
       assumption+)
   apply (rule Suc_leI, assumption,
          simp add:nset_def, simp add:monomial_mem)
   apply (frule Suc_leI,
              rule ballI, simp add:nset_def)

   apply (simp add:monomial_mem)
 apply simp
done


lemma (in PolynRg) polyn_addTr:
 "(pol_coeff S (n, f)) ∧ (pol_coeff S (n, g)) ⟶
    (polyn_expr R X n (n, f)) ± (polyn_expr R X n (n, g)) =
                 nsum R (λj. ((f j) ±⇘S⇙ (g j)) ⋅⇩r (X^⇗R j⇖)) n"
apply (cut_tac subring,
        frule subring_Ring[of S])
apply (induct_tac n)
 apply (rule impI, simp, erule conjE)
 apply (simp add:polyn_expr0)
 apply (cut_tac pol_coeff_mem[of "(0, f)" 0], simp,
        cut_tac pol_coeff_mem[of "(0, g)" 0], simp,
       frule  mem_subring_mem_ring[of S "f 0"], assumption+,
       frule  mem_subring_mem_ring[of S "g 0"], assumption+,
       frule Ring.ring_is_ag[of S],
       frule aGroup.ag_pOp_closed[of S "f 0" "g 0"], assumption+,
       frule mem_subring_mem_ring[of S "f 0 ±⇘S⇙ g 0"], assumption+)
apply (simp add:ring_r_one)
 apply (simp add:Subring_pOp_ring_pOp[of S "f 0" "g 0"])
 apply (simp del:npow_suc)+
apply (rule impI, erule conjE)
 apply (frule_tac n = n in  pol_coeff_pre[of _ f],
        frule_tac n = n in  pol_coeff_pre[of _ g], simp del:npow_suc)
 apply (cut_tac n = n and c = "(Suc n, f)" in polyn_Suc, simp del:npow_suc,
        simp del:npow_suc,
        thin_tac "polyn_expr R X (Suc n) (Suc n, f) =
         polyn_expr R X n (Suc n, f) ± f (Suc n) ⋅⇩r X^⇗R (Suc n)⇖")
 apply (cut_tac n = n and c = "(Suc n, g)" in polyn_Suc, simp del:npow_suc,
        simp del:npow_suc,
        thin_tac "polyn_expr R X (Suc n) (Suc n, g) =
         polyn_expr R X n (Suc n, g) ± g (Suc n) ⋅⇩r X^⇗R (Suc n)⇖")
 apply (cut_tac c = "(Suc n, f)" and k = n in polyn_mem, assumption, 
                simp del:npow_suc,
        cut_tac k = n and c = "(Suc n, g)" in polyn_mem, assumption, 
                simp del:npow_suc)
 apply (frule_tac j = "Suc n" and c = "(Suc n, f)" in pol_coeff_mem_R, simp,
        frule_tac j = "Suc n" and c = "(Suc n, g)" in pol_coeff_mem_R, simp,
        cut_tac  X_mem_R,
        frule_tac n = "Suc n" in npClose[of "X"], simp del:npow_suc)
 apply (frule_tac x = "f (Suc n)" and y = "X^⇗R (Suc n)⇖" in ring_tOp_closed,
         assumption+,
        frule_tac x = "g (Suc n)" and y = "X^⇗R (Suc n)⇖" in ring_tOp_closed,
         assumption+)
 apply (cut_tac ring_is_ag, 
        subst aGroup.pOp_assocTr43, assumption+)
 apply (frule_tac x = "f (Suc n) ⋅⇩r X^⇗R (Suc n)⇖" and 
        y = "polyn_expr R X n (Suc n, g)" in aGroup.ag_pOp_commute[of R],
        assumption+, simp del:npow_suc,
        thin_tac "f (Suc n) ⋅⇩r X^⇗R (Suc n)⇖ ± polyn_expr R X n (Suc n, g) =
         polyn_expr R X n (Suc n, g) ± f (Suc n) ⋅⇩r X^⇗R (Suc n)⇖")
 apply (subst  aGroup.pOp_assocTr43[THEN sym], assumption+,
        simp del:npow_suc add:polyn_expr_restrict) 

 apply (frule_tac c = "(Suc n, f)" and j = "Suc n" in pol_coeff_mem, simp,
        frule_tac c = "(Suc n, g)" and j = "Suc n" in pol_coeff_mem, simp)
 apply (subst ring_distrib2[THEN sym], assumption+) 
apply (frule_tac c = "(Suc n, f)" and j = "Suc n" in  pol_coeff_mem, simp,
       frule_tac c = "(Suc n, g)" and j = "Suc n" in  pol_coeff_mem, simp)
 apply (frule_tac a = "f (Suc n)" and b = "g (Suc n)" in 
                      Subring_pOp_ring_pOp[of S], simp, simp)
apply simp
done

lemma (in PolynRg) polyn_add_n:"⟦pol_coeff S (n, f); pol_coeff S (n, g)⟧ ⟹ 
      (polyn_expr R X n (n, f)) ± (polyn_expr R X n (n, g)) =  
           nsum R (λj. ((f j) ±⇘S⇙ (g j)) ⋅⇩r (X^⇗R j⇖)) n"
by (simp add:polyn_addTr)

definition
  add_cf :: "[('a, 'm) Ring_scheme, nat × (nat ⇒ 'a), nat × (nat ⇒ 'a)] ⇒
                     nat × (nat ⇒ 'a)" where
  "add_cf S c d =
    (if (fst c) < (fst d) then ((fst d),  λj. (if j ≤ (fst c)
                                               then (((snd c) j) ±⇘S⇙ ((snd d) j)) else ((snd d) j)))
     else if (fst c) = (fst d) then ((fst c), λj. ((snd c) j ±⇘S⇙ (snd d) j))
     else ((fst c), λj. (if j ≤ (fst d) then 
                        ((snd c) j ±⇘S⇙ (snd d) j) else ((snd c) j))))" 

lemma (in PolynRg) add_cf_pol_coeff:"⟦pol_coeff S c; pol_coeff S d⟧
      ⟹  pol_coeff S (add_cf S c d)"
apply (cut_tac subring,
       frule subring_Ring[of S], frule Ring.ring_is_ag[of S])
 apply (simp add:pol_coeff_def)
 apply (rule allI, rule impI) 
 
apply (case_tac "(fst c) < (fst d)", simp add:add_cf_def)
 apply (rule impI, rule aGroup.ag_pOp_closed, assumption+, simp+)
 apply (drule leI[of "fst c" "fst d"],
              drule le_imp_less_or_eq[of "fst d" "fst c"])
apply (erule disjE)
 apply (simp add:add_cf_def, rule impI)
 apply (frule Ring.ring_is_ag[of S], rule aGroup.ag_pOp_closed, assumption,
       simp+)

apply (simp add:add_cf_def)
apply (frule Ring.ring_is_ag[of S], rule aGroup.ag_pOp_closed, assumption,
       simp+)
done  

lemma (in PolynRg) add_cf_len:"⟦pol_coeff S c; pol_coeff S d⟧
      ⟹ fst (add_cf S c d) = (max (fst c) (fst d))" 
by (simp add: add_cf_def max.absorb1 max.absorb2)

lemma (in PolynRg) polyn_expr_restrict1:"⟦pol_coeff S (n, f);
    pol_coeff S (Suc (m + n), g)⟧ ⟹ 
    polyn_expr R X (m + n) (add_cf S (n, f) (m + n, g)) = 
    polyn_expr R X (m + n) (m + n, snd (add_cf S (n, f) (Suc (m + n), g)))"
apply (frule pol_coeff_pre[of "m+n" g])
apply (frule add_cf_pol_coeff[of "(n, f)" "(Suc (m + n), g)"], assumption+,
       frule add_cf_pol_coeff[of "(n, f)" "(m + n, g)"], assumption+)
apply (rule polyn_exprs_eq[of "add_cf S (n, f) (m + n, g)" 
       "(m + n, snd (add_cf S (n, f) (Suc (m + n), g)))" "m + n"], assumption+)
 apply (rule split_pol_coeff[of "add_cf S (n, f) (Suc (m + n), g)" "m + n"],
         assumption, simp add:add_cf_len)
 apply (simp add:add_cf_len)

apply (rule allI, rule impI)
 apply (simp add:add_cf_def)
done

lemma (in PolynRg) polyn_add_n1:"⟦pol_coeff S (n, f); pol_coeff S (n, g)⟧ ⟹ 
      (polyn_expr R X n (n, f)) ± (polyn_expr R X n (n, g)) =  
                                polyn_expr R X n (add_cf S (n, f) (n, g))"
apply (subst polyn_add_n, assumption+)
 apply (simp add:polyn_expr_def add_cf_def)
done

lemma (in PolynRg) add_cf_val_hi:"(fst c) < (fst d) ⟹
                       snd (add_cf S c d) (fst d) = (snd d) (fst d)"
by (simp add:add_cf_def)

lemma (in PolynRg) add_cf_commute:"⟦pol_coeff S c; pol_coeff S d⟧
  ⟹ ∀j ≤ (max (fst c) (fst d)). snd (add_cf S c d) j = 
                           snd (add_cf S d c) j"
apply (cut_tac subring, frule subring_Ring,
       frule Ring.ring_is_ag[of S])
apply (simp add: add_cf_def max.absorb1 max.absorb2)
apply (case_tac "(fst c) = (fst d)", simp add: pol_coeff_def)
 apply (rule allI, rule impI,
        rule aGroup.ag_pOp_commute[of S], simp+)

apply (case_tac "(fst d) < (fst c)", simp,
       rule allI, rule impI,
       rule aGroup.ag_pOp_commute, assumption+)
apply (frule_tac x = j and y = "fst d" and z = "fst c" in le_less_trans, 
          assumption+, frule_tac x = j and y = "fst c" in less_imp_le,
          thin_tac "j < fst c", simp add:pol_coeff_mem, simp add:pol_coeff_mem)

apply simp
apply (frule leI[of "fst d" "fst c"],
       frule noteq_le_less[of "fst c" "fst d"], assumption,
       rule allI, rule impI,
       simp)

apply (rule aGroup.ag_pOp_commute, assumption+,
       simp add:pol_coeff_mem,
       frule_tac x = j and y = "fst c" and z = "fst d" in le_less_trans, 
          assumption+, frule_tac x = j and y = "fst d" in less_imp_le,
           thin_tac "j < fst d", simp add:pol_coeff_mem)
done

lemma (in PolynRg) polyn_addTr1:"pol_coeff S (n, f) ⟹
  ∀g. pol_coeff S (n + m, g) ⟶ 
        (polyn_expr R X n (n, f) ± (polyn_expr R X (n + m) ((n + m), g))
                   = polyn_expr R X (n + m) (add_cf S (n, f) ((n + m), g)))"
apply (cut_tac subring, frule subring_Ring)
apply (induct_tac m)
 apply (rule allI, rule impI, simp) 
 apply (simp add:polyn_add_n1)

apply (simp add:add.commute[of n])
 apply (rule allI, rule impI)
  apply (frule_tac n = "na + n" and f = g in pol_coeff_pre)
  apply (drule_tac a = g in forall_spec, assumption)
  apply (cut_tac n = "na + n" and c = "(Suc (na + n), g)" in  polyn_Suc,
         simp, simp del:npow_suc,
         thin_tac "polyn_expr R X (Suc (na + n)) (Suc (na + n), g) =
        polyn_expr R X (na + n) (Suc (na + n), g) ±
        g (Suc (na + n)) ⋅⇩r X^⇗R (Suc (na + n))⇖")
  apply (frule_tac c = "(n, f)" and k = n in polyn_mem, simp,
         frule_tac c = "(Suc (na + n), g)" and k = "na + n" in polyn_mem, simp,
         frule_tac c = "(Suc (na + n), g)" in monomial_mem)
  apply (drule_tac a = "Suc (na + n)" in forall_spec, simp del:npow_suc,
         cut_tac ring_is_ag, 
         subst aGroup.ag_pOp_assoc[THEN sym], assumption+, simp del:npow_suc)
  apply (simp del:npow_suc add:polyn_expr_restrict) 
  apply (frule_tac c = "(n, f)" and d = "(Suc (na + n), g)" in 
         add_cf_pol_coeff, assumption+,
         frule_tac c = "(n, f)" and d = "(na + n, g)" in 
         add_cf_pol_coeff, assumption+) 
  apply (frule_tac c = "add_cf S (n, f) (Suc (na + n), g)" and 
           n = "na + n" and m = "Suc (na + n)" in polyn_n_m, simp,
         subst add_cf_len, assumption+, simp) 
  apply (cut_tac k = "Suc (na + n)" and f = "add_cf S (n, f) (Suc (na + n), g)"
          in polyn_expr_split)
  apply (frule_tac c = "(n, f)" and d = "(Suc (na + n), g)" in 
          add_cf_len, assumption+, simp del: npow_suc add: max.absorb1 max.absorb2)
  apply (thin_tac "polyn_expr R X (Suc (na + n))
         (Suc (na + n), snd (add_cf S (n, f) (Suc (na + n), g))) =
        polyn_expr R X (na + n)
         (na + n, snd (add_cf S (n, f) (Suc (na + n), g))) ±
        Σ⇩f R (λj. snd (add_cf S (n, f) (Suc (na + n), g)) j ⋅⇩r
                  X^⇗R j⇖) (Suc (na + n)) (Suc (na + n))",
       thin_tac "polyn_expr R X (Suc (na + n)) (add_cf S (n, f) (Suc (na + n),
        g)) =
        polyn_expr R X (na + n)
         (na + n, snd (add_cf S (n, f) (Suc (na + n), g))) ±
         Σ⇩f R (λj. snd (add_cf S (n, f) (Suc (na + n), g)) j ⋅⇩r
                  X^⇗R j⇖) (Suc (na + n)) (Suc (na + n))")
  apply (simp del:npow_suc add:fSum_def cmp_def slide_def) 
  apply (cut_tac d = "(Suc (na + n), g)" in add_cf_val_hi[of "(n, f)"],
         simp, simp del:npow_suc,
         thin_tac "snd (add_cf S (n, f) (Suc (na + n), g)) (Suc (na + n)) =
        g (Suc (na + n))")
  apply (frule_tac c = "add_cf S (n, f) (Suc (na + n), g)" and k = "na + n" in
         polyn_mem, simp,
         frule_tac c = "add_cf S (n, f) (na + n, g)" and k = "na + n" in
         polyn_mem, simp )
  apply (subst add_cf_len, assumption+, simp del:npow_suc)
 apply (frule_tac a = "polyn_expr R X (na + n) (add_cf S (n, f) (na + n, g))" 
        and b = "polyn_expr R X (na + n) (add_cf S (n, f) (Suc (na + n), g))"
        and c = "g (Suc (na + n)) ⋅⇩r  X^⇗R (Suc (na + n))⇖" in 
        aGroup.ag_pOp_add_r[of R], assumption+) 
 apply (rule_tac c = "add_cf S (n, f) (na + n, g)" and 
        d = "add_cf S (n, f) (Suc (na + n), g)" and k = "na + n" in 
        polyn_exprs_eq, assumption+, simp,
        subst add_cf_len, assumption+) 
  apply (simp)

apply (rule allI, rule impI,
        (subst add_cf_def)+, simp,
        frule_tac m = na and g = g in polyn_expr_restrict1[of n f], assumption,
        simp del:npow_suc)
done

lemma (in PolynRg) polyn_add:"⟦pol_coeff S (n, f); pol_coeff S (m, g)⟧
       ⟹ polyn_expr R X n (n, f) ± (polyn_expr R X m (m, g))
                   = polyn_expr R X (max n m) (add_cf S (n, f) (m, g))"  
apply (cut_tac less_linear[of n m])
 apply (erule disjE,
        frule polyn_addTr1[of n f "m - n"],
        drule_tac a = g in forall_spec, simp, simp add: max.absorb1 max.absorb2)

 apply (erule disjE,
        simp add:polyn_add_n1) 
apply (frule polyn_mem[of "(n, f)" n], simp,
       frule polyn_mem[of "(m, g)" m], simp)
 apply (cut_tac ring_is_ag, simp add:aGroup.ag_pOp_commute)

 apply (frule polyn_addTr1[of m g "n - m"],
        drule_tac a = f in forall_spec, simp, simp,
        frule add_cf_commute[of "(m, g)" "(n, f)"], assumption+, 
        simp add:max_def,
        frule add_cf_pol_coeff[of "(n, f)" "(m, g)"], assumption+,
        frule add_cf_pol_coeff[of "(m, g)" "(n, f)"], assumption+)
 apply (rule polyn_exprs_eq[of "add_cf S (m, g) (n, f)" 
                 "add_cf S (n, f) (m, g)" n], assumption+)
  apply (simp add:add_cf_len, simp)
done

lemma (in PolynRg) polyn_add1:"⟦pol_coeff S c; pol_coeff S d⟧
       ⟹ polyn_expr R X (fst c) c ± (polyn_expr R X (fst d) d)
                   = polyn_expr R X (max (fst c) (fst d)) (add_cf S c d)"
apply (cases c)
apply (cases d)
apply (simp add: polyn_add)
done

lemma (in PolynRg) polyn_minus_nsum:"⟦pol_coeff S c; k ≤ (fst c)⟧ ⟹ 
       -⇩a (polyn_expr R X k c) = nsum R (λj. ((-⇩a⇘S⇙ ((snd c) j)) ⋅⇩r (X^⇗R j⇖))) k"
apply (cut_tac subring,
       frule subring_Ring[of S],
       frule Ring.ring_is_ag[of S],
       cut_tac ring_is_ag,
       cut_tac X_mem_R)
apply (simp add:polyn_expr_def,
       subst aGroup.nsum_minus[of R], assumption)
 apply (frule monomial_mem[of c], rule allI, rule impI,
        frule_tac i = j and j = k and k = "fst c" in le_trans, assumption+,
        simp)
apply (rule aGroup.nsum_eq, assumption,
       rule allI, rule impI, simp,
       rule aGroup.ag_mOp_closed, assumption) 
 apply (frule monomial_mem[of c],
        frule_tac i = j and j = k and k = "fst c" in le_trans, assumption+,
        simp)
apply (rule allI, rule impI,
       rule ring_tOp_closed)
apply (frule_tac j = j  in pol_coeff_mem[of c]) 
apply (frule_tac i = j and j = k and k = "fst c" in le_trans, assumption+,
       simp add:Subring_minus_ring_minus,
       frule_tac x = "(snd c) j" in mem_subring_mem_ring[of S], assumption,
       simp add:aGroup.ag_mOp_closed,
       simp add:npClose)
apply (rule allI, rule impI, simp,
       cut_tac j = j in pol_coeff_mem[of c], assumption,
       rule_tac i = j and j = k and k = "fst c" in le_trans, assumption+) 
apply (simp add:Subring_minus_ring_minus,
       frule_tac x = "(snd c) j" in mem_subring_mem_ring[of S], assumption)
apply (subst ring_inv1_1, assumption+)
apply (simp add:npClose, simp) 
done

lemma (in PolynRg) minus_pol_coeff:"pol_coeff S c ⟹ 
                         pol_coeff S ((fst c), (λj. (-⇩a⇘S⇙ ((snd c) j))))"
apply (simp add:pol_coeff_def)
apply (rule allI, rule impI)
apply (cut_tac subring, frule subring_Ring)
apply (frule Ring.ring_is_ag[of "S"])
apply (rule aGroup.ag_mOp_closed, assumption)
apply simp 
done

lemma (in PolynRg) polyn_minus:"⟦pol_coeff S c; k ≤ (fst c)⟧ ⟹ 
       -⇩a (polyn_expr R X k c) = 
                    polyn_expr R X k (fst c, (λj. (-⇩a⇘S⇙ ((snd c) j))))"
apply (cases c)
apply (subst polyn_minus_nsum)
apply (simp_all add: polyn_expr_def)
done

definition
  m_cf :: "[('a, 'm) Ring_scheme, nat × (nat ⇒ 'a)] ⇒ nat × (nat ⇒ 'a)" where
  "m_cf S c = (fst c, (λj. (-⇩a⇘S⇙ ((snd c) j))))"  

lemma (in PolynRg) m_cf_pol_coeff:"pol_coeff S c ⟹
                              pol_coeff S (m_cf S c)"
by (simp add:m_cf_def, simp add:minus_pol_coeff)

lemma (in PolynRg) m_cf_len:"pol_coeff S c ⟹
                                         fst (m_cf S c) = fst c"
by (simp add:m_cf_def)

lemma (in PolynRg) polyn_minus_m_cf:"⟦pol_coeff S c; k ≤ (fst c)⟧ ⟹ 
        -⇩a (polyn_expr R X k c) =  
                     polyn_expr R X k (m_cf S c)"
by (simp add:m_cf_def polyn_minus) 

lemma (in PolynRg) polyn_zero_minus_zero:"⟦pol_coeff S c; k ≤ (fst c)⟧ ⟹ 
       (polyn_expr R X k c = 𝟬) = (polyn_expr R X k (m_cf S c) = 𝟬)"
apply (cut_tac ring_is_ag)
apply (simp add:polyn_minus_m_cf[THEN sym])
apply (rule iffI, simp)
apply (simp add:aGroup.ag_inv_zero)
apply (frule polyn_mem[of c k], assumption)
apply (frule aGroup.ag_inv_inv[of "R" "polyn_expr R X k c"], assumption)
apply (simp add:aGroup.ag_inv_zero)
done

lemma (in PolynRg) coeff_0_pol_0:"⟦pol_coeff S c; k ≤ fst c⟧ ⟹
       (∀j≤ k. (snd c) j = 𝟬⇘S⇙) = (polyn_expr R X k c = 𝟬)"
apply (rule iffI)
apply (cut_tac ring_is_ag, cut_tac subring,
       frule subring_Ring)
apply (simp add:Subring_zero_ring_zero)
apply (simp add:polyn_expr_def,
       rule aGroup.nsum_zeroA[of R], assumption)
apply (rule allI, rule impI,
       cut_tac X_mem_R)
 apply (drule_tac a = j in forall_spec, simp,
        frule_tac n = j in npClose[of X], simp)
 apply (simp add:ring_times_0_x)
apply (cases c)
using algfree [simplified algfree_cond_def] by (auto simp add: polyn_expr_def)

subsection ‹Multiplication of ‹pol_exprs››

subsection "Multiplication"

definition
  ext_cf :: "[('a, 'm) Ring_scheme, nat, nat × (nat ⇒ 'a)] ⇒ 
                                                  nat × (nat ⇒ 'a)" where
  "ext_cf S n c = (n + fst c, λi. if n ≤ i then (snd c) (sliden n i) else 𝟬⇘S⇙)"

  (* 0         0 g(0)         g(m) 
     0            n           m+n  , where (m, g) is a pol_coeff  **)

definition
  sp_cf :: "[('a, 'm) Ring_scheme, 'a, nat × (nat ⇒ 'a)] ⇒ nat × (nat ⇒ 'a)" where
  "sp_cf S a c = (fst c, λj. a ⋅⇩r⇘S⇙ ((snd c) j))" (* scalar times cf *)

definition
  special_cf :: "('a, 'm) Ring_scheme ⇒ nat × (nat ⇒ 'a)" ("C⇩0") where
  "C⇩0 S = (0, λj. 1⇩r⇘S⇙)"

lemma (in PolynRg) special_cf_pol_coeff:"pol_coeff S (C⇩0 S)"  
apply (cut_tac subring, frule subring_Ring)
apply (simp add:pol_coeff_def special_cf_def)
apply (simp add:Ring.ring_one)
done

lemma (in PolynRg) special_cf_len:"fst (C⇩0 S) = 0"
apply (simp add:special_cf_def)
done

lemma (in PolynRg) ext_cf_pol_coeff:"pol_coeff S c ⟹ 
                           pol_coeff S (ext_cf S n c)"
apply (simp add: pol_coeff_def ext_cf_def sliden_def)
apply (rule impI)
apply (rule Ring.ring_zero)
apply (rule subring_Ring)
apply (rule subring)
done

lemma (in PolynRg) ext_cf_len:"pol_coeff S c ⟹
                   fst (ext_cf S m c) = m + fst c"
by (simp add:ext_cf_def)

lemma (in PolynRg) ext_special_cf_len:"fst (ext_cf S m (C⇩0 S)) = m"
apply (cut_tac special_cf_pol_coeff)
apply (simp add:ext_cf_len special_cf_def)
done

lemma (in PolynRg) ext_cf_self:"pol_coeff S c ⟹ 
                   ∀j ≤ (fst c). snd (ext_cf S 0 c) j = (snd c) j" 
apply (rule allI, rule impI, simp add:ext_cf_def sliden_def)
done

lemma (in PolynRg) ext_cf_hi:"pol_coeff S c ⟹ 
                   (snd c) (fst c)  =
                      snd (ext_cf S n c) (n + (fst c))"
apply (subst ext_cf_def)
apply (simp add:sliden_def)
done

lemma (in PolynRg) ext_special_cf_hi:"snd (ext_cf S n (C⇩0 S)) n = 1⇩r⇘S⇙"
apply (cut_tac special_cf_pol_coeff)
apply (cut_tac ext_cf_hi[of "C⇩0 S" n, THEN sym])
apply (simp add:special_cf_def, assumption)
done
 

lemma (in PolynRg) ext_cf_lo_zero:"⟦pol_coeff S c; 0 < n; x ≤ (n - Suc 0)⟧
              ⟹ snd (ext_cf S n c) x = 𝟬⇘S⇙"
apply (cut_tac Suc_le_mono[THEN sym, of x "n - Suc 0"], simp,
       cut_tac x = x and y = "Suc x" and z = n in less_le_trans,
       simp, assumption,
       simp add:nat_not_le_less[THEN sym, of x n],
              thin_tac "x ≤ n - Suc 0")
apply (simp add:ext_cf_def)
done

lemma (in PolynRg) ext_special_cf_lo_zero:"⟦0 < n; x ≤ (n - Suc 0)⟧
              ⟹ snd (ext_cf S n (C⇩0 S)) x = 𝟬⇘S⇙"
by (cut_tac special_cf_pol_coeff,
       frule ext_cf_lo_zero[of "C⇩0 S" n], assumption+)

lemma (in PolynRg) sp_cf_pol_coeff:"⟦pol_coeff S c; a ∈ carrier S⟧ ⟹ 
                   pol_coeff S (sp_cf S a c)"
apply (cut_tac subring, frule subring_Ring)
apply (simp add:pol_coeff_def sp_cf_def,
       rule allI, rule impI,
      rule Ring.ring_tOp_closed, assumption+)
apply simp
done

lemma (in PolynRg) sp_cf_len:"⟦pol_coeff S c; a ∈ carrier S⟧ ⟹ 
                    fst (sp_cf S a c) = fst c"
by (simp add:sp_cf_def)

lemma (in PolynRg) sp_cf_val:"⟦pol_coeff S c; j ≤ (fst c); a ∈ carrier S⟧ ⟹ 
                    snd (sp_cf S a c) j =  a ⋅⇩r⇘S⇙ ((snd c) j)"  
by (simp add:sp_cf_def)

lemma (in PolynRg) polyn_ext_cf_lo_zero:"⟦pol_coeff S c; 0 < j⟧ ⟹  
                     polyn_expr R X (j - Suc 0) (ext_cf S j c) = 𝟬"
apply (simp add:polyn_expr_def, cut_tac ring_is_ag,
       rule aGroup.nsum_zeroA, assumption) 
apply (rule allI, rule impI)
 apply (frule_tac x = ja in ext_cf_lo_zero [of c j], assumption+)
 apply (cut_tac X_mem_R, frule_tac n = ja in npClose[of X])
 apply (cut_tac subring,
        simp add:Subring_zero_ring_zero,
        simp add:ring_times_0_x)
done
        
lemma (in PolynRg) monomial_d:"pol_coeff S c ⟹
                  polyn_expr R X d (ext_cf S d c) = ((snd c) 0) ⋅⇩r X^⇗R d⇖"
apply (cut_tac ring_is_ag,
       cut_tac subring,
       cut_tac  X_mem_R,
       frule subring_Ring[of S])
apply (frule pol_coeff_mem [of c 0], simp)
apply (case_tac "d = 0")
 apply simp
 apply (simp add:polyn_expr_def ext_cf_def sliden_def)
apply (frule ext_cf_pol_coeff[of c d]) 
apply (cut_tac polyn_Suc[of "d - Suc 0" "ext_cf S d c"])
apply (simp)
apply (cut_tac polyn_ext_cf_lo_zero[of c d], simp,
       thin_tac "polyn_expr R X (d - Suc 0) (ext_cf S d c) = 𝟬")
 apply (frule monomial_mem[of "ext_cf S d c"], simp add:ext_cf_len,
        drule_tac a = d in forall_spec, simp, simp add:aGroup.ag_l_zero) 
 apply (subst polyn_expr_short[of "ext_cf S d c" d], assumption,
        simp add:ext_cf_len)
 apply (simp,
        subst ext_cf_def, simp add:sliden_def , assumption+,
        simp add:ext_cf_len)
done

lemma (in PolynRg) X_to_d:" X^⇗R d⇖ =  polyn_expr R X d (ext_cf S d (C⇩0 S))"
apply (cut_tac special_cf_pol_coeff)
apply (subst monomial_d[of "C⇩0 S" d], assumption+)
apply (subst special_cf_def, simp)
apply (cut_tac subring, frule subring_Ring)
apply (simp add:Subring_one_ring_one)
apply (cut_tac X_mem_R, frule_tac n = d in npClose[of X])
apply (simp add:ring_l_one)
done

lemma (in PolynRg) c_max_ext_special_cf:"c_max S (ext_cf S n (C⇩0 S)) = n"
apply (cut_tac polyn_ring_S_nonzero,
       cut_tac subring, frule subring_Ring)
apply (simp add:c_max_def special_cf_def ext_cf_def)
 apply (cut_tac n_max[of "{j. (n ≤ j ⟶ j = n) ∧ n ≤ j}" n])
 apply (erule conjE)+ apply simp
 apply (rule subsetI, simp, erule conjE, simp)
 apply (cut_tac le_refl[of n], blast)
done  

lemma (in PolynRg) scalar_times_polynTr:"a ∈ carrier S ⟹ 
       ∀f. pol_coeff S (n, f) ⟶ 
        a ⋅⇩r (polyn_expr R X n (n, f)) = polyn_expr R X n (sp_cf S a (n, f))"
apply (cut_tac subring,
       cut_tac X_mem_R,
       frule_tac x = a in mem_subring_mem_ring, assumption)
apply (induct_tac n,
       rule allI, rule impI, simp add:polyn_expr_def sp_cf_def,
       cut_tac n_in_Nsetn[of "0"])
apply (cut_tac subring_Ring,
        frule_tac c = "(0, f)" in pol_coeff_mem[of _ "0"], simp) 
apply (simp,
       frule_tac x = "f 0" in mem_subring_mem_ring, assumption) 
apply (       simp add:Subring_tOp_ring_tOp,
       frule_tac y = "f 0" in ring_tOp_closed[of a], assumption+,
       cut_tac ring_one, simp add:ring_tOp_assoc, assumption)

apply (rule allI, rule impI,
       frule subring_Ring,
       frule_tac n = n and f = f in pol_coeff_pre,
       drule_tac x = f in spec, simp) 
 apply (cut_tac n = n and c = "(Suc n, f)" in polyn_Suc, simp,
         simp del:npow_suc,
        thin_tac "polyn_expr R X (Suc n) (Suc n, f) =
           polyn_expr R X n (Suc n, f) ± f (Suc n) ⋅⇩r X^⇗R (Suc n)⇖")
 apply (cut_tac n = n and c = "sp_cf S a (Suc n, f)" in polyn_Suc,
        simp add:sp_cf_len)
 apply (frule_tac c = "(Suc n, f)" and a = a in sp_cf_len, assumption+,
        simp only:fst_conv)
 apply (cut_tac k = "Suc n" and f = "sp_cf S a (Suc n, f)" in 
        polyn_expr_split, simp del:npow_suc,
        thin_tac "polyn_expr R X (Suc n) (Suc n, snd (sp_cf S a (Suc n, f))) =
           polyn_expr R X n (sp_cf S a (Suc n, f)) ±
           snd (sp_cf S a (Suc n, f)) (Suc n) ⋅⇩r X^⇗R (Suc n)⇖",
        thin_tac "polyn_expr R X (Suc n) (sp_cf S a (Suc n, f)) =
           polyn_expr R X n (sp_cf S a (Suc n, f)) ±
           snd (sp_cf S a (Suc n, f)) (Suc n) ⋅⇩r X^⇗R (Suc n)⇖")
 apply (frule_tac c = "(Suc n, f)" and a = a in sp_cf_pol_coeff, assumption)
 apply (frule_tac c = "(Suc n, f)" and k = n in polyn_mem,
        simp,  
        frule_tac c = "(Suc n, f)" in monomial_mem,
        drule_tac a = "Suc n" in forall_spec, simp,
        simp only:snd_conv)
 apply (subst ring_distrib1, assumption+,
        subst polyn_expr_restrict, assumption+, simp del:npow_suc,
        subst sp_cf_val, assumption, simp, assumption,
              simp only:snd_conv,
        frule_tac c = "(Suc n, f)" and j = "Suc n" in pol_coeff_mem,
              simp, simp only:snd_conv,
        simp del:npow_suc add:Subring_tOp_ring_tOp,
        subst ring_tOp_assoc[THEN sym, of a], assumption+,
        simp add:mem_subring_mem_ring, rule npClose, assumption)
 apply (cut_tac ring_is_ag,
        rule aGroup.ag_pOp_add_r, assumption+,
        rule polyn_mem, rule sp_cf_pol_coeff, assumption+,
        simp add:sp_cf_len,
        rule polyn_mem, assumption, simp add:sp_cf_len,
        frule_tac c = "(Suc n, f)" and j = "Suc n" in pol_coeff_mem_R,
                simp, simp only:snd_conv,
        (rule ring_tOp_closed)+, assumption+, rule npClose, assumption)
 apply (rule_tac c = "sp_cf S a (n, f)" and d = "sp_cf S a (Suc n, f)" and 
        k = n in polyn_exprs_eq, rule sp_cf_pol_coeff, assumption+,
        simp add:sp_cf_len)

 apply (rule allI, rule impI,
        (subst sp_cf_def)+, simp)
done
 
lemma (in PolynRg) scalar_times_pol_expr:"⟦a ∈ carrier S; pol_coeff S c; 
       n ≤ fst c⟧ ⟹ 
           a ⋅⇩r (polyn_expr R X n c) = polyn_expr R X n (sp_cf S a c)"
apply (cases c) apply (simp only:)
apply (rename_tac m g)
apply (thin_tac "c = (m, g)")
apply (frule_tac c = "(m, g)" and k = n in polyn_expr_short, simp,
       simp)
apply (frule scalar_times_polynTr[of a n],
       drule_tac x = g in spec)
 apply (frule_tac c = "(m, g)" and n = n in pol_coeff_le, simp, simp,
        thin_tac "polyn_expr R X n (m, g) = polyn_expr R X n (n, g)",
        thin_tac "a ⋅⇩r polyn_expr R X n (n, g) =
           polyn_expr R X n (sp_cf S a (n, g))")
 apply (frule_tac c = "(m, g)" and n = n in pol_coeff_le, simp, simp,
        frule_tac c = "(n, g)" and a = a in sp_cf_pol_coeff, assumption,
        frule_tac c = "(m, g)" and a = a in sp_cf_pol_coeff, assumption)    
 apply (rule_tac c = "sp_cf S a (n, g)" and d = "sp_cf S a (m, g)" and 
        k = n in polyn_exprs_eq, assumption+)
        apply (simp add:sp_cf_len)
 apply (rule allI, (subst sp_cf_def)+, simp)
done

lemma (in PolynRg) sp_coeff_nonzero:"⟦Idomain S; a ∈ carrier S; a ≠ 𝟬⇘S⇙; 
       pol_coeff S c; (snd c) j ≠ 𝟬⇘S⇙; j ≤ (fst c)⟧ ⟹ 
       snd (sp_cf S a c) j ≠  𝟬⇘S⇙"
apply (simp add:sp_cf_def)
apply (frule_tac y = "(snd c) j" in Idomain.idom_tOp_nonzeros[of S a], 
       assumption+,
       simp add:pol_coeff_def, simp add:Pi_def, assumption+)
done

lemma (in PolynRg) ext_cf_inductTl:"pol_coeff S (Suc n, f) ⟹
        polyn_expr R X (n + j) (ext_cf S j (Suc n, f)) = 
                      polyn_expr R X (n + j) (ext_cf S j (n, f))"
apply (frule pol_coeff_pre[of n f],
       frule ext_cf_pol_coeff[of "(Suc n, f)" j],
       frule ext_cf_pol_coeff[of "(n, f)" j],
       rule polyn_exprs_eq[of "ext_cf S j (Suc n, f)" "ext_cf S j (n, f)" 
         "n + j"], assumption+)
 apply (simp add:ext_cf_len)
 apply (rule allI, (subst ext_cf_def)+, simp add:sliden_def)
done

lemma (in PolynRg) low_deg_terms_zeroTr:" 
     pol_coeff S (n, f) ⟶
     polyn_expr R X (n + j) (ext_cf S j (n, f)) = 
                     (X^⇗R j⇖) ⋅⇩r (polyn_expr R X n (n, f))"
apply (cut_tac ring_is_ag,
       cut_tac X_mem_R, frule npClose[of "X" "j"])
apply (induct_tac n)
 apply (rule impI, simp)
 apply (case_tac "j = 0", simp add:ext_cf_def sliden_def polyn_expr_def) 
 apply (frule_tac c = "(0, f)" and j = 0 in pol_coeff_mem_R, simp, simp)
 apply (simp add:ring_r_one ring_l_one)
 apply (cut_tac polyn_Suc[of "j - Suc 0" "ext_cf S j (0, f)"],
        simp del:npow_suc)
 apply (frule ext_cf_len[of "(0, f)" j],
        cut_tac polyn_expr_split[of j "ext_cf S j (0, f)"], simp,
        thin_tac "polyn_expr R X j (ext_cf S j (0, f)) =
        polyn_expr R X (j - Suc 0) (ext_cf S j (0, f)) ±
        snd (ext_cf S j (0, f)) j ⋅⇩r X^⇗R j⇖")
 apply (simp add:polyn_ext_cf_lo_zero[of "(0, f)" j],
        thin_tac "polyn_expr R X j (j, snd (ext_cf S j (0, f))) =
        𝟬 ± snd (ext_cf S j (0, f)) j ⋅⇩r X^⇗R j⇖",
        frule ext_cf_hi[THEN sym, of "(0, f)" j], simp add:polyn_expr_def)
  apply (frule_tac c = "(0, f)" and j = 0 in pol_coeff_mem_R, simp, simp)
  apply (subst aGroup.ag_l_zero, assumption, simp add:ring_tOp_closed,
         simp add:ring_r_one, subst ring_tOp_commute, assumption+, simp)

 apply (simp add:ext_cf_len)
apply (rule impI,
       cut_tac subring,
       cut_tac subring_Ring[of S],
       frule_tac n = n in pol_coeff_pre[of _ "f"]) 
       apply simp
 apply (subst polyn_expr_split)
 apply (cut_tac n = "n + j" and c = "ext_cf S j (Suc n, f)" in polyn_Suc,
        simp add:ext_cf_len) 
 apply (subst ext_cf_len, assumption+, simp del:npow_suc add:add.commute[of j],
       thin_tac "polyn_expr R X (Suc (n + j))
          (Suc (n + j), snd (ext_cf S j (Suc n, f))) =
         polyn_expr R X (n + j) (ext_cf S j (Suc n, f)) ±
         snd (ext_cf S j (Suc n, f)) (Suc (n + j)) ⋅⇩r X^⇗R (Suc (n + j))⇖",
        subst ext_cf_inductTl, assumption+, simp del:npow_suc,
        thin_tac "polyn_expr R X (n + j) (ext_cf S j (n, f)) =
         X^⇗R j⇖ ⋅⇩r polyn_expr R X n (n, f)")
 apply (cut_tac c1 = "(Suc n, f)" and n1 = j in ext_cf_hi[THEN sym], 
        assumption+, 
        simp del:npow_suc add:add.commute[of j])
 apply (cut_tac n = n and c = "(Suc n, f)" in polyn_Suc, simp,
        simp del:npow_suc)
 apply (frule_tac c = "(Suc 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,
        simp del:npow_suc,
        frule_tac x = "f (Suc n)" and y = "X^⇗R (Suc n)⇖" in ring_tOp_closed,
        rule npClose, assumption,
        subst ring_distrib1, assumption+)
 apply (subst polyn_expr_restrict, assumption+)
 apply (rule_tac a = "f (Suc n) ⋅⇩r X^⇗R (Suc (n + j))⇖ " and 
             b = "X^⇗R j⇖ ⋅⇩r (f (Suc n) ⋅⇩r X^⇗R (Suc n)⇖)" and 
             c = "X^⇗R j⇖ ⋅⇩r polyn_expr R X n (n, f)" in aGroup.ag_pOp_add_l,
        assumption+,
        rule ring_tOp_closed, assumption+, rule npClose, assumption,
        (rule ring_tOp_closed, assumption+)+,
        simp add:polyn_mem,
        frule_tac n = "Suc n" in npClose[of X],
        subst ring_tOp_assoc[THEN sym], assumption+,
        subst ring_tOp_commute[of "X^⇗R j⇖"], assumption,
               simp add:pol_coeff_mem,
        subst ring_tOp_assoc, assumption+,
        subst npMulDistr[of X], assumption, simp add:add.commute[of j])
apply simp
done
       
lemma (in PolynRg) low_deg_terms_zero:"pol_coeff S (n, f) ⟹ 
  polyn_expr R X (n + j) (ext_cf S j (n, f)) = 
                            (X^⇗R j⇖) ⋅⇩r (polyn_expr R X n (n, f))"
by (simp add:low_deg_terms_zeroTr)

lemma (in PolynRg) low_deg_terms_zero1:"pol_coeff S c ⟹ 
  polyn_expr R X ((fst c) + j) (ext_cf S j c) = 
                            (X^⇗R j⇖) ⋅⇩r (polyn_expr R X (fst c) c)"
by (cases c) (simp add: low_deg_terms_zeroTr)


lemma (in PolynRg) polyn_expr_tOpTr:"pol_coeff S (n, f) ⟹ 
      ∀g. (pol_coeff S (m, g) ⟶ (∃h. pol_coeff S ((n + m), h) ∧
           h (n + m) = (f n) ⋅⇩r⇘S⇙ (g m) ∧
  (polyn_expr R X (n + m) (n + m, h) = 
          (polyn_expr R X n (n, f)) ⋅⇩r (polyn_expr R X m (m, g)))))"
apply (cut_tac subring,
       cut_tac X_mem_R,
       frule subring_Ring[of S])
apply (induct_tac m)
 apply (rule allI, rule impI, simp)
 apply (simp add:polyn_expr_def [of R X 0]) 
 apply (frule_tac c = "(0,g)" in pol_coeff_mem[of _ 0], simp, simp,
        frule_tac c = "(0,g)" in pol_coeff_mem_R[of _ 0], simp, simp)
 apply (simp add:ring_r_one,
        frule_tac c = "(n, f)" and k = n in polyn_mem, simp,
        simp only:ring_tOp_commute[of "polyn_expr R X n (n, f)"],
        subst scalar_times_pol_expr, assumption+, simp) 
 apply (cut_tac f = "sp_cf S (g 0) (n, f)" in pol_coeff_split)
        apply (simp add:sp_cf_len)
 apply (cut_tac f = "sp_cf S (g 0) (n, f)" in polyn_expr_split[of n],
        simp only:sp_cf_len, simp only:fst_conv,
        frule_tac a = "g 0" in sp_cf_pol_coeff[of "(n, f)"], assumption+,
        simp,
        subgoal_tac "snd (sp_cf S (g 0) (n, f)) n = (f n) ⋅⇩r⇘S⇙ (g 0)", blast) 
 apply (thin_tac "pol_coeff S (n, snd (sp_cf S (g 0) (n, f)))",
        thin_tac "polyn_expr R X n (sp_cf S (g 0) (n, f)) =
         polyn_expr R X n (n, snd (sp_cf S (g 0) (n, f)))",
        thin_tac "pol_coeff S (sp_cf S (g 0) (n, f))")
 apply (subst sp_cf_val[of "(n, f)" n], assumption+, simp, assumption, simp,
        frule_tac c = "(n,f)" in pol_coeff_mem[of _ n], simp, simp,
        simp add:Ring.ring_tOp_commute)  

apply (rule allI, rule impI)
apply (frule_tac n = na and f = g in pol_coeff_pre, 
       drule_tac a = g in forall_spec, assumption+)
apply (erule exE, (erule conjE)+) 
apply (cut_tac n = na and c = "(Suc na, g)" in polyn_Suc, (simp del:npow_suc)+,
       thin_tac "polyn_expr R X (Suc na) (Suc na, g) =
        polyn_expr R X na (Suc na, g) ± g (Suc na) ⋅⇩r X^⇗R (Suc na)⇖",
       subst polyn_expr_restrict, assumption)
apply (frule_tac c = "(n, f)" and k = n in polyn_mem,simp del:npow_suc,
       frule_tac c = "(na, g)" and k = na in polyn_mem, simp del:npow_suc,
       frule_tac c = "(Suc na, g)" in monomial_mem, simp del:npow_suc,
       drule_tac a = "Suc na" in forall_spec, simp del:npow_suc)
apply (subst ring_distrib1, assumption+)
apply (rotate_tac 8, drule sym,
       simp del:npow_suc)
apply (thin_tac "polyn_expr R X n (n, f) ⋅⇩r polyn_expr R X na (na, g) =
        polyn_expr R X (n + na) (n + na, h)")
apply (frule_tac c = "(Suc na, g)" and j ="Suc na" in pol_coeff_mem_R, simp,
       simp del:npow_suc,
       frule_tac c = "(Suc na, g)" and j ="Suc na" in pol_coeff_mem, simp,
       simp del:npow_suc)
apply (subst ring_tOp_commute, assumption+,
       subst ring_tOp_assoc, assumption+, rule npClose, assumption+,
       subst low_deg_terms_zero[THEN sym], assumption+)
apply (frule_tac c = "(n, f)" and n = "Suc na" in ext_cf_pol_coeff)
apply (frule_tac c = "ext_cf S (Suc na) (n, f)" and a = "g (Suc na)" in 
       sp_cf_pol_coeff, assumption)
apply (subst scalar_times_pol_expr, assumption+,
       simp add:ext_cf_len,
       cut_tac k = "n + Suc na" and 
        f = "sp_cf S (g (Suc na)) (ext_cf S (Suc na) (n, f))" in 
        polyn_expr_split,
       simp only:sp_cf_len,
       thin_tac "polyn_expr R X (n + Suc na)
         (sp_cf S (g (Suc na)) (ext_cf S (Suc na) (n, f))) =
        polyn_expr R X (n + Suc na)
         (fst (ext_cf S (Suc na) (n, f)),
          snd (sp_cf S (g (Suc na)) (ext_cf S (Suc na) (n, f))))",
       simp only:ext_cf_len, simp only:fst_conv,
       simp add:add.commute[of _ n])
apply (subst polyn_add, assumption+,
       cut_tac f = "sp_cf S (g (Suc na)) (ext_cf S (Suc na) (n, f))" in 
       pol_coeff_split, simp only:sp_cf_len, simp only:ext_cf_len,
       simp add:add.commute[of _ n], simp add: max_def,
       frule_tac c = "sp_cf S (g (Suc na)) (ext_cf S (Suc na) (n, f))"
              in pol_coeff_cartesian,
       simp only:sp_cf_len, simp only:ext_cf_len, 
               simp add:add.commute[of _ n],
       thin_tac "(Suc (n + na),
         snd (sp_cf S (g (Suc na)) (ext_cf S (Suc na) (n, f)))) =
        sp_cf S (g (Suc na)) (ext_cf S (Suc na) (n, f))",
       frule_tac c = "(n + na, h)" and 
               d = "sp_cf S (g (Suc na)) (ext_cf S (Suc na) (n, f))" in 
               add_cf_pol_coeff, assumption)
  apply (cut_tac k = "Suc (n + na)" and f = "add_cf S (n + na, h)
       (sp_cf S (g (Suc na)) (ext_cf S (Suc na) (n, f)))" in polyn_expr_split)
  apply (simp only: mp)

  apply (
       thin_tac "polyn_expr R X (Suc (n + na))
         (add_cf S (n + na, h)
           (sp_cf S (g (Suc na)) (ext_cf S (Suc na) (n, f)))) =
        polyn_expr R X (Suc (n + na))
         (fst (add_cf S (n + na, h)
                (sp_cf S (g (Suc na)) (ext_cf S (Suc na) (n, f)))),
          snd (add_cf S (n + na, h)
                (sp_cf S (g (Suc na)) (ext_cf S (Suc na) (n, f)))))")
  apply (subst add_cf_len)
  apply assumption+
  apply (simp add: sp_cf_len)
  apply (simp add: ext_cf_len max_def)
  apply (cut_tac f = "add_cf S (n + na, h)
           (sp_cf S (g (Suc na)) (ext_cf S (Suc na) (n, f)))" in 
            pol_coeff_split)
  apply (simp only: add_cf_len)
  apply (simp only: sp_cf_len)
  apply (simp add: ext_cf_len)
  apply (thin_tac "pol_coeff S
         (add_cf S (n + na, h)
           (sp_cf S (g (Suc na)) (ext_cf S (Suc na) (n, f))))",
       subgoal_tac "snd (add_cf S (n + na, h) (sp_cf S (g (Suc na)) 
       (ext_cf S (Suc na) (n, f)))) (Suc (n + na)) = f n ⋅⇩r⇘S⇙ g (Suc na)",
       simp add:add.commute[of _ n], blast)
 apply (subst add_cf_def, simp add:sp_cf_len ext_cf_len,
        subst sp_cf_def, simp add:ext_cf_len,
        subst ext_cf_def, simp add:sliden_def,
        frule pol_coeff_mem[of "(n, f)" n], simp, 
        simp add:Ring.ring_tOp_commute)
done

lemma (in PolynRg) polyn_expr_tOp:"⟦
  pol_coeff S (n, f); pol_coeff S (m, g)⟧ ⟹ ∃e. pol_coeff S ((n + m), e) ∧
  e (n + m) = (f n) ⋅⇩r⇘S⇙ (g m) ∧
  polyn_expr R X (n + m)(n + m, e) = 
           (polyn_expr R X n (n, f)) ⋅⇩r (polyn_expr R X m (m, g))"
by (simp add:polyn_expr_tOpTr) 


lemma (in PolynRg) polyn_expr_tOp_c:"⟦pol_coeff S c; pol_coeff S d⟧ ⟹
      ∃e. pol_coeff S e ∧ (fst e = fst c + fst d) ∧
          (snd e) (fst e) = (snd c (fst c)) ⋅⇩r⇘S⇙ (snd d) (fst d) ∧
          polyn_expr R X (fst e) e =
                  (polyn_expr R X (fst c) c) ⋅⇩r (polyn_expr R X (fst d) d)"  
by (cases c, cases d) (simp add: polyn_expr_tOpTr)

section "The degree of a polynomial"

lemma (in PolynRg) polyn_degreeTr:"⟦pol_coeff S c; k ≤ (fst c)⟧ ⟹
       (polyn_expr R X k c = 𝟬 ) = ({j. j ≤ k ∧ (snd c) j ≠ 𝟬⇘S⇙} = {})"
apply (subst coeff_0_pol_0[THEN sym, of c k], assumption+)
apply blast
done

lemma (in PolynRg) higher_part_zero:"⟦pol_coeff S c; k < fst c;
      ∀j∈nset (Suc k) (fst c). snd c j = 𝟬⇘S⇙⟧ ⟹   
             Σ⇩f R (λj. snd c j ⋅⇩r X^⇗R j⇖) (Suc k) (fst c) = 𝟬" 
apply (cut_tac ring_is_ag,
       rule aGroup.fSum_zero1[of R k "fst c" "λj. snd c j ⋅⇩r X^⇗R j⇖"],
       assumption+) 
apply (rule ballI, 
       drule_tac x = j in bspec, assumption, simp)
apply (cut_tac subring, 
       simp add:Subring_zero_ring_zero,
       cut_tac X_mem_R,
       frule_tac n = j in npClose[of X],
       simp add:ring_times_0_x)
done

lemma (in PolynRg) coeff_nonzero_polyn_nonzero:"⟦pol_coeff S c; k ≤ (fst c)⟧
    ⟹ (polyn_expr R X k c ≠ 𝟬) = (∃j≤k. (snd c) j ≠ 𝟬⇘S⇙ )" 
by (simp add:coeff_0_pol_0[THEN sym, of c k])


lemma (in PolynRg) pol_expr_unique:"⟦p ∈ carrier R; p ≠ 𝟬; 
      pol_coeff S c; p = polyn_expr R X (fst c) c; (snd c) (fst c) ≠ 𝟬⇘S⇙; 
      pol_coeff S d; p = polyn_expr R X (fst d) d; (snd d) (fst d) ≠ 𝟬⇘S⇙⟧ ⟹
      (fst c) = (fst d) ∧ (∀j ≤ (fst c). (snd c) j = (snd d) j)"
apply (cut_tac ring_is_ag, 
       cut_tac subring, frule subring_Ring,
       frule Ring.ring_is_ag[of S])
apply (frule m_cf_pol_coeff[of d])
apply (frule polyn_minus_m_cf[of d "fst d"], simp)
 apply (drule sym, drule sym, simp)
 apply (rotate_tac -2, drule sym, drule sym)
 apply (frule_tac x = p in aGroup.ag_r_inv1[of R], assumption, simp,
        thin_tac "p = polyn_expr R X (fst c) c",
        thin_tac "polyn_expr R X (fst d) d = polyn_expr R X (fst c) c",
        thin_tac "-⇩a (polyn_expr R X (fst c) c) = 
                                    polyn_expr R X (fst d) (m_cf S d)")
 apply (frule polyn_add1[of c "m_cf S d"], assumption+, simp add:m_cf_len,
        thin_tac "polyn_expr R X (fst c) c ± polyn_expr R X (fst d) (m_cf S d)
           = polyn_expr R X (max (fst c) (fst d)) (add_cf S c (m_cf S d))",
        thin_tac "polyn_expr R X (fst c) c ≠
           polyn_expr R X (max (fst c) (fst d)) (add_cf S c (m_cf S d))")
 apply (frule_tac add_cf_pol_coeff[of c "m_cf S d"], simp add:m_cf_len)
 apply (cut_tac coeff_0_pol_0[THEN sym, of "add_cf S c (m_cf S d)" 
                  "max (fst c) (fst d)"],
        drule sym, simp,
        thin_tac "polyn_expr R X (max (fst c) (fst d)) 
                                         (add_cf S c (m_cf S d)) = 𝟬",
        thin_tac "pol_coeff S (add_cf S c (m_cf S d))",
        thin_tac "pol_coeff S (m_cf S d)") 

apply (case_tac "fst c = fst d", simp)
    apply (rule allI, rule impI, 
           drule_tac a = j in forall_spec, assumption)
          apply (simp add:add_cf_def m_cf_def m_cf_len)
     apply (frule_tac j = j in pol_coeff_mem[of c], simp,
            frule_tac j = j in  pol_coeff_mem[of d], simp)
   apply (subst aGroup.ag_eq_diffzero[of S], assumption+)

 apply (simp add:add_cf_def)
 apply (case_tac "¬ (fst c) ≤ (fst d)", simp)
   apply (simp add:m_cf_len)
  apply (drule_tac a = "fst c" in forall_spec, simp, simp)

 apply simp
 apply (drule_tac a = "fst d" in forall_spec, simp, simp add:m_cf_len)
 apply (case_tac "fst c ≠ fst d", 
        frule noteq_le_less[of "fst c" "fst d"], assumption, simp)
        apply (simp add:m_cf_def)
        apply (frule pol_coeff_mem[of d "fst d"], simp)
        apply (frule Ring.ring_is_ag[of S], 
               frule aGroup.ag_inv_inv[of S "snd d (fst d)"], assumption)
               apply (simp add:aGroup.ag_inv_zero)
 apply simp
 apply simp
 apply (simp add:add_cf_len m_cf_len)
done

lemma (in PolynRg) pol_expr_unique2:"⟦pol_coeff S c; pol_coeff S d; 
      fst c = fst d⟧ ⟹
  (polyn_expr R X (fst c) c = polyn_expr R X (fst d) d ) =
      (∀j ≤ (fst c). (snd c) j = (snd d) j)"
apply (cut_tac ring_is_ag, 
       cut_tac subring, frule subring_Ring,
       frule Ring.ring_is_ag[of S])
apply (rule iffI)
apply (frule m_cf_pol_coeff[of d])
 apply (frule polyn_mem[of c "fst c"], simp,
        frule polyn_mem[of d "fst d"], simp)
 apply (frule aGroup.ag_eq_diffzero[of R "polyn_expr R X (fst c) c" 
                   "polyn_expr R X (fst d) d"], assumption+,
        simp,
        simp only:polyn_minus_m_cf[of d "fst d"],
        drule sym, simp)
 apply (frule polyn_add1[of c "m_cf S d"], assumption+, simp add:m_cf_len)
 apply (thin_tac "polyn_expr R X (fst c) d ± polyn_expr R X (fst c) 
         (m_cf S d) =
         polyn_expr R X (fst c) (add_cf S c (m_cf S d))",
        thin_tac "polyn_expr R X (fst c) c = polyn_expr R X (fst c) d",
        thin_tac "polyn_expr R X (fst c) d ∈ carrier R",
        drule sym)
 apply (frule_tac add_cf_pol_coeff[of c "m_cf S d"], simp add:m_cf_len)
 apply (frule coeff_0_pol_0[THEN sym, of "add_cf S c (m_cf S d)" 
                "fst c"],
        simp add:add_cf_len, simp add:m_cf_len,
        thin_tac "𝟬 = polyn_expr R X (fst d) (add_cf S c (m_cf S d))",
        thin_tac "pol_coeff S (add_cf S c (m_cf S d))")
 apply (simp add:add_cf_def m_cf_def)
  apply (rule allI, rule impI)
  apply (drule_tac a = j in forall_spec, assumption)
  apply (frule_tac j = j in pol_coeff_mem[of c], simp,
         frule_tac j = j in pol_coeff_mem[of d], simp)
  apply (simp add:aGroup.ag_eq_diffzero[THEN sym])

 apply simp
 apply (rule polyn_exprs_eq[of c d "fst d"], assumption+)
        apply (simp, assumption+)
done

lemma (in PolynRg) pol_expr_unique3:"⟦pol_coeff S c; pol_coeff S d; 
      fst c < fst d⟧ ⟹
  (polyn_expr R X (fst c) c = polyn_expr R X (fst d) d ) =
      ((∀j ≤ (fst c). (snd c) j = (snd d) j) ∧
                        (∀j∈nset (Suc (fst c)) (fst d). (snd d) j = 𝟬⇘S⇙))"
apply (rule iffI)
apply (cut_tac ring_is_ag, 
       cut_tac subring, frule subring_Ring,
       frule Ring.ring_is_ag[of S])
apply (frule m_cf_pol_coeff[of d])
 apply (frule polyn_mem[of c "fst c"], simp,
        frule polyn_mem[of d "fst d"], simp)
 apply (frule aGroup.ag_eq_diffzero[of R "polyn_expr R X (fst c) c" 
                   "polyn_expr R X (fst d) d"], assumption+,
        simp,
        simp only:polyn_minus_m_cf[of d "fst d"],
        drule sym, simp)
  apply (frule polyn_add1 [of c "m_cf S d"])
  apply assumption+
  apply (simp add: m_cf_len)
  apply (thin_tac "polyn_expr R X (fst d) d = polyn_expr R X (fst c) c")
  apply (thin_tac "polyn_expr R X (fst c) c ∈ carrier R", drule sym)
 apply (frule_tac add_cf_pol_coeff[of c "m_cf S d"], simp add:m_cf_len)
 apply (frule coeff_0_pol_0[THEN sym, of "add_cf S c (m_cf S d)" 
                "max (fst c) (fst d)"])
  apply (simp add:add_cf_len m_cf_len, simp)
        apply (thin_tac "pol_coeff S (add_cf S c (m_cf S d))")
 apply (simp add:add_cf_def m_cf_def max_def)
 apply (rule conjI)
  apply (rule allI, rule impI,
         frule_tac x = j and y = "fst c" and z = "fst d" in le_less_trans, 
         assumption+,
         frule_tac x = j and y = "fst d" in less_imp_le)
  apply (drule_tac a = j in forall_spec, simp, simp)
  apply (frule_tac j = j in pol_coeff_mem[of c], simp,
         frule_tac j = j in pol_coeff_mem[of d], simp)
  apply (simp add:aGroup.ag_eq_diffzero[THEN sym])

  apply (rule ballI, simp add:nset_def, erule conjE)
  apply (cut_tac x = "fst c" and y = "Suc (fst c)" and z = j in 
         less_le_trans, simp, assumption)
  apply (cut_tac m1 = "fst c" and n1 = j in nat_not_le_less[THEN sym], simp)
  apply (drule_tac a = j in forall_spec, assumption, simp,
         frule_tac j = j in pol_coeff_mem[of d], simp)
  apply (frule_tac x = "snd d j" in aGroup.ag_inv_inv[of S], assumption,
         simp add:aGroup.ag_inv_inv aGroup.ag_inv_zero)
 apply (cut_tac polyn_n_m[of d "fst c" "fst d"])
 apply (subst polyn_expr_split[of "fst d" d], simp,
        thin_tac "polyn_expr R X (fst d) d =
     polyn_expr R X (fst c) (fst c, snd d) ±
     Σ⇩f R (λj. snd d j ⋅⇩r X^⇗R j⇖) (Suc (fst c)) (fst d)", erule conjE) 
 apply (subst higher_part_zero[of d "fst c"], assumption+)
 apply (frule pol_coeff_le[of d "fst c"], simp add:less_imp_le,
        frule polyn_mem[of "(fst c, snd d)" "fst c"], simp,
        cut_tac ring_is_ag,
        simp add:aGroup.ag_r_zero,
        subst polyn_expr_short[THEN sym, of d "fst c"], assumption+,
        simp add:less_imp_le)
 apply (rule polyn_exprs_eq[of c d "fst c"], assumption+)
        apply (simp, assumption+)
 apply (simp add:less_imp_le)
done

lemma (in PolynRg) polyn_degree_unique:"⟦pol_coeff S c; pol_coeff S d;
      polyn_expr R X (fst c) c = polyn_expr R X (fst d) d⟧ ⟹ 
      c_max S c = c_max S d" 
apply (cut_tac ring_is_ag,
       cut_tac subring,
       frule subring_Ring,
       frule Ring.ring_is_ag[of S])

apply (case_tac "polyn_expr R X (fst d) d = 𝟬⇘R⇙")
 apply (cut_tac coeff_0_pol_0[THEN sym, of d "fst d"], simp,
        cut_tac coeff_0_pol_0[THEN sym, of c "fst c"], simp)
 apply (simp add:c_max_def, assumption, simp, assumption, simp)

apply (frule polyn_mem[of c "fst c"], simp, frule polyn_mem[of d "fst d"], 
       simp)
apply (frule aGroup.ag_eq_diffzero[of "R" "polyn_expr R X (fst c) c" 
               "polyn_expr R X (fst d) d"], assumption+)
apply (simp only:polyn_minus_m_cf[of d "fst d"],
       frule m_cf_pol_coeff [of d])
apply (frule polyn_add1[of c "m_cf S d"], assumption+,
       simp only:m_cf_len) 
apply (rotate_tac -1, drule sym, simp,
       thin_tac "polyn_expr R X (fst d) d ±
                         polyn_expr R X (fst d) (m_cf S d) = 𝟬",
       frule add_cf_pol_coeff[of c "m_cf S d"], assumption+)
apply (cut_tac coeff_0_pol_0[THEN sym, of "add_cf S c (m_cf S d)" 
                "fst (add_cf S c (m_cf S d))"],
       simp add:add_cf_len m_cf_len,
       thin_tac "polyn_expr R X (max (fst c) (fst d)) 
                            (add_cf S c (m_cf S d)) = 𝟬",
       thin_tac "pol_coeff S (add_cf S c (m_cf S d))",
       thin_tac "pol_coeff S (m_cf S d)")
 apply (frule coeff_nonzero_polyn_nonzero[of d "fst d"], simp, simp)
 apply (drule sym, simp)
 apply (frule coeff_nonzero_polyn_nonzero[of c "fst c"], simp, simp)
apply (simp add:c_max_def, rule conjI, rule impI, blast,
       rule conjI, rule impI, blast)
apply (rule n_max_eq_sets)
apply (rule equalityI)
apply (rule subsetI, simp)
 apply (erule conjE)

 apply (case_tac "fst c ≤ fst d")
  apply (frule_tac i = x in le_trans[of _ "fst c" "fst d"], assumption+, simp)
apply (
        rule contrapos_pp, simp+,
        frule_tac i = x in le_trans[of _ "fst c" "fst d"], assumption+,
        drule_tac a = x in forall_spec, assumption,
        drule le_imp_less_or_eq[of "fst c" "fst d"],
        erule disjE, simp add:add_cf_def m_cf_len m_cf_def,
        frule_tac j = x in pol_coeff_mem[of c], assumption+,
        simp add:aGroup.ag_inv_zero aGroup.ag_r_zero[of S])
 
        apply (simp add:add_cf_def m_cf_len m_cf_def,
               rotate_tac -1, drule sym, simp,
               frule_tac j = x in pol_coeff_mem[of c], simp,
               simp add:aGroup.ag_inv_zero aGroup.ag_r_zero[of S])

        apply (simp add:nat_not_le_less) (* ¬ fst c ≤ fst d *)
        apply (case_tac "¬ x ≤ (fst d)", simp,
               simp add:nat_not_le_less,
               frule_tac x = "fst d" and y = x and z = "fst c" in 
               less_le_trans, assumption+,
               drule_tac x = x in spec, simp add:max_def,
               simp add:add_cf_def m_cf_len m_cf_def)

        apply (simp,
               drule_tac x = x in spec, simp add:max_def,
               rule contrapos_pp, simp+,
               simp add:add_cf_def m_cf_len m_cf_def,
               frule_tac j = x in pol_coeff_mem[of c],
               frule_tac x = x and y = "fst d" and z = "fst c" in
               le_less_trans, assumption+, simp add:less_imp_le,
               simp add:aGroup.ag_inv_zero aGroup.ag_r_zero[of S])

 apply (rule subsetI, simp, erule conjE,
        case_tac "fst d ≤ fst c",
        frule_tac i = x and j = "fst d" and k = "fst c" in le_trans,
        assumption+, simp,
        drule_tac x = x in spec, simp add:max_def,
        rule contrapos_pp, simp+,
        simp add:add_cf_def m_cf_len m_cf_def)
   apply (case_tac "fst d = fst c", simp, rotate_tac -1, drule sym, simp,
          frule_tac j = x in pol_coeff_mem[of d], assumption,
          frule_tac x = "snd d x" in aGroup.ag_mOp_closed, assumption+,
          simp add:aGroup.ag_l_zero,
          frule_tac x = "snd d x" in aGroup.ag_inv_inv[of S],
                 assumption, simp add:aGroup.ag_inv_zero)

   apply (drule noteq_le_less[of "fst d" "fst c"], assumption,
          simp,
          frule_tac j = x in pol_coeff_mem[of d], assumption,
          frule_tac x = "snd d x" in aGroup.ag_mOp_closed, assumption+,
          simp add:aGroup.ag_l_zero,
          frule_tac x = "snd d x" in aGroup.ag_inv_inv[of S],
                 assumption, simp add:aGroup.ag_inv_zero)

   apply (simp add:nat_not_le_less,
          case_tac "¬ x ≤ fst c", simp,
          simp add:nat_not_le_less,
          drule_tac x = x in spec, simp add:max_def,
          simp add:add_cf_def m_cf_len m_cf_def,
          frule_tac j = x in pol_coeff_mem[of d], assumption,
          frule_tac x = "snd d x" in aGroup.ag_mOp_closed, assumption+,
          simp add:aGroup.ag_l_zero,
          frule_tac x = "snd d x" in aGroup.ag_inv_inv[of S],
                 assumption, simp add:aGroup.ag_inv_zero)

   apply (simp,
          drule_tac x = x in spec, simp add:max_def,
          rule contrapos_pp, simp+,
          simp add:add_cf_def m_cf_len m_cf_def,
          frule_tac x = x and y = "fst c" and z = "fst d" in le_less_trans,
           assumption+, frule_tac x = x and y = "fst d" in less_imp_le,
          frule_tac j = x in pol_coeff_mem[of d], assumption,
          frule_tac x = "snd d x" in aGroup.ag_mOp_closed, assumption+,
          simp add:aGroup.ag_l_zero,
          frule_tac x = "snd d x" in aGroup.ag_inv_inv[of S],
                 assumption, simp add:aGroup.ag_inv_zero)

 apply (thin_tac "∀j≤max (fst c) (fst d). snd (add_cf S c (m_cf S d)) j = 𝟬⇘S⇙")
 apply (rotate_tac -1, drule sym, simp)
 apply (simp add:coeff_0_pol_0[THEN sym, of c "fst c"])
 apply blast
 apply simp+
done

lemma (in PolynRg) ex_polyn_expr:"p ∈ carrier R ⟹
         ∃c. pol_coeff S c ∧ p = polyn_expr R X (fst c) c"
apply (cut_tac S_X_generate[of p], blast)
apply assumption
done

lemma (in PolynRg) c_max_eqTr0:"⟦pol_coeff S c; k ≤ (fst c);
     polyn_expr R X k c = polyn_expr R X (fst c) c; ∃j≤k. (snd c) j ≠ 𝟬⇘S⇙⟧ ⟹
               c_max S (k, snd c) = c_max S c"
apply (simp add:polyn_expr_short[of c k],
       frule pol_coeff_le[of c k], assumption+,
       rule polyn_degree_unique[of "(k, snd c)" c], assumption+,
       simp)
done

definition
  cf_sol :: "[('a, 'b) Ring_scheme, ('a, 'b1) Ring_scheme, 'a, 'a,
                nat × (nat ⇒ 'a)] ⇒ bool" where
 "cf_sol R S X p c ⟷ pol_coeff S c ∧ (p = polyn_expr R X (fst c) c)"

definition
  deg_n ::"[('a, 'b) Ring_scheme, ('a, 'b1) Ring_scheme, 'a, 'a] ⇒ nat" where
  "deg_n R S X p = c_max S (SOME c. cf_sol R S X p c)" 

definition
  deg ::"[('a, 'b) Ring_scheme, ('a, 'b1) Ring_scheme, 'a, 'a] ⇒ ant" where
  "deg R S X p = (if p = 𝟬⇘R⇙ then -∞ else (an (deg_n R S X p)))"

lemma (in PolynRg) ex_cf_sol:"p ∈ carrier R ⟹
                                    ∃c. cf_sol R S X p c"
apply (unfold cf_sol_def) 
apply (frule ex_polyn_expr[of p], (erule exE)+)
apply (cut_tac n = "fst c" in le_refl, blast)
done 

lemma (in PolynRg) deg_in_aug_minf:"p ∈ carrier R ⟹
                                   deg R S X p ∈ Z⇩-⇩∞"
apply (simp add:aug_minf_def deg_def an_def)
done

lemma (in PolynRg) deg_noninf:"p ∈ carrier R ⟹
                                   deg R S X p ≠ ∞"
apply (cut_tac deg_in_aug_minf[of p], simp add:deg_def,
       simp add:aug_minf_def)
apply (case_tac "p = 𝟬⇘R⇙", simp+)
done

lemma (in PolynRg) deg_ant_int:"⟦p ∈ carrier R; p ≠ 𝟬⟧
                  ⟹ deg R S X p = ant (int (deg_n R S X p))"
by (simp add:deg_def an_def)

lemma (in PolynRg) deg_an:"⟦p ∈ carrier R; p ≠ 𝟬⟧
        ⟹ deg R S X p = an (deg_n R S X p)"
by (simp add:deg_def)

lemma (in PolynRg) pol_SOME_1:"p ∈ carrier R  ⟹ 
             cf_sol R S X p (SOME f. cf_sol R S X p f)"
apply (frule ex_cf_sol[of p])
apply (rule_tac P = "cf_sol R S X p" in someI_ex, assumption)
done

lemma (in PolynRg) pol_SOME_2:"p ∈ carrier R ⟹
         pol_coeff S (SOME c. cf_sol R S X p c) ∧  
           p = polyn_expr R X (fst (SOME c. cf_sol R S X p c))
                                      (SOME c. cf_sol R S X p c)"
apply (frule pol_SOME_1[of p])
apply (simp add:cf_sol_def)
done

lemma (in PolynRg) coeff_max_zeroTr:"pol_coeff S c ⟹
                   ∀j. j ≤ (fst c) ∧ (c_max S c) < j ⟶ (snd c) j = 𝟬⇘S⇙"
apply (case_tac "∀j ≤ (fst c). (snd c) j = 𝟬⇘S⇙", rule allI, rule impI,
       erule conjE, simp) 
apply simp
apply (frule coeff_nonzero_polyn_nonzero[THEN sym, of c "fst c"], simp,
       simp)
apply (rule allI, rule impI, erule conjE,
       simp add:c_max_def,
       simp add:polyn_degreeTr[of c "fst c"])
apply (subgoal_tac "{j. j ≤ (fst c) ∧ (snd c) j ≠ 𝟬⇘S⇙} ⊆ {j. j ≤ (fst c)}",
       frule n_max[of "{j. j ≤ (fst c) ∧ (snd c) j ≠ 𝟬⇘S⇙}" "fst c"], blast) 
 apply (case_tac "∀x≤fst c. snd c x = 𝟬⇘S⇙ ", blast, simp)
 apply (erule conjE)
apply (rule contrapos_pp, simp+,
       thin_tac "∃x≤fst c. snd c x ≠ 𝟬⇘S⇙",
       thin_tac "{j. j ≤ fst c ∧ snd c j ≠ 𝟬⇘S⇙} ⊆ {j. j ≤ fst c}",
       thin_tac "snd c (n_max {j. j ≤ fst c ∧ snd c j ≠ 𝟬⇘S⇙}) ≠ 𝟬⇘S⇙",
       drule_tac a = j in forall_spec, simp)
apply simp
apply (rule subsetI, simp)
done 

lemma (in PolynRg) coeff_max_nonzeroTr:"⟦pol_coeff S c; 
       ∃j ≤ (fst c). (snd c) j ≠ 𝟬⇘S⇙⟧ ⟹ (snd c) (c_max S c) ≠ 𝟬⇘S⇙"
apply (simp add:c_max_def)
apply (subgoal_tac "{j. j ≤ (fst c) ∧ (snd c) j ≠ 𝟬⇘S⇙} ⊆ {j. j ≤ (fst c)}",
       frule n_max[of "{j. j ≤ (fst c) ∧ (snd c) j ≠ 𝟬⇘S⇙}" "fst c"], blast) 
apply (erule conjE, simp)

apply (rule subsetI, simp)
done

lemma (in PolynRg) coeff_max_bddTr:"pol_coeff S c ⟹ c_max S c ≤ (fst c)"
apply (case_tac "∀j≤(fst c). (snd c) j = 𝟬⇘S⇙", simp add:c_max_def)
apply (simp add:c_max_def,
       frule polyn_degreeTr[of c "fst c"], simp, simp,
       subgoal_tac "{j. j ≤ (fst c) ∧ (snd c) j ≠ 𝟬⇘S⇙} ⊆ {j. j ≤ (fst c)}",
       frule n_max[of "{j. j ≤ (fst c) ∧ (snd c) j ≠ 𝟬⇘S⇙}" "fst c"],
       blast, erule conjE, simp)
apply (rule subsetI, simp)
done

lemma (in PolynRg) pol_coeff_max:"pol_coeff S c ⟹ 
                             pol_coeff S ((c_max S c), snd c)"
apply (rule pol_coeff_le[of c "c_max S c"], assumption)
apply (simp add:coeff_max_bddTr)
done

lemma (in PolynRg) polyn_c_max:"pol_coeff S c ⟹
       polyn_expr R X (fst c) c = polyn_expr R X (c_max S c) c"
apply (case_tac "(c_max S c) = (fst c)", simp)
apply (frule coeff_max_bddTr[of c], 
       frule noteq_le_less[of "c_max S c" "fst c"], assumption)
apply (subst polyn_n_m1[of c "c_max S c" "fst c"], assumption+, simp)

apply (frule_tac polyn_mem[of c "c_max S c"], assumption+)
 apply (subst higher_part_zero[of c "c_max S c"], assumption+)
 apply (frule coeff_max_zeroTr[of c],
        rule ballI, simp add:nset_def)

apply (cut_tac ring_is_ag, simp add:aGroup.ag_r_zero)
done

lemma (in PolynRg) pol_deg_eq_c_max:"⟦p ∈ carrier R; 
       pol_coeff S c; p = polyn_expr R X (fst c) c⟧ ⟹ 
                   deg_n R S X p = c_max S c"
apply (cut_tac subring, frule subring_Ring)
 apply (frule polyn_c_max[of c]) 
apply (frule pol_SOME_2[of p])
apply (subst deg_n_def, erule conjE) 
apply (rule polyn_degree_unique[of "Eps (cf_sol R S X p)" "c"], simp,
       assumption)
 apply simp
done

lemma (in PolynRg) pol_deg_le_n:"⟦p ∈ carrier R; pol_coeff S c; 
       p = polyn_expr R X (fst c) c⟧ ⟹ deg_n R S X p ≤ (fst c)"
apply (frule  pol_deg_eq_c_max[of p c], assumption+,
       frule  coeff_max_bddTr[of c]) 
apply simp
done

lemma (in PolynRg) pol_deg_le_n1:"⟦p ∈ carrier R; pol_coeff S c; k ≤ (fst c); 
       p = polyn_expr R X k c⟧ ⟹ deg_n R S X p ≤ k"
apply (simp add:deg_n_def, drule sym, simp)
apply (frule pol_SOME_2[of p], erule conjE)
apply (frule pol_coeff_le[of c k], assumption)
apply (simp only:polyn_expr_short[of c k])
apply (drule sym)
apply (subst polyn_degree_unique[of "SOME c. cf_sol R S X p c" "(k, snd c)"],
       assumption+, simp)
apply (frule coeff_max_bddTr[of "(k, snd c)"], simp)
done

lemma (in PolynRg) pol_len_gt_deg:"⟦p ∈ carrier R; pol_coeff S c; 
       p = polyn_expr R X (fst c) c; deg R S X p < (an j); j ≤ (fst c)⟧
       ⟹  (snd c) j = 𝟬⇘S⇙"
apply (case_tac "p = 𝟬⇘R⇙", simp, drule sym)
 apply (simp add:coeff_0_pol_0[THEN sym, of c "fst c"])
 apply (simp add:deg_def, simp add:aless_natless)
 apply (drule sym, simp)
 apply (frule coeff_max_zeroTr[of c])
 apply (simp add:pol_deg_eq_c_max)
done

lemma (in PolynRg) pol_diff_deg_less:"⟦p ∈ carrier R; pol_coeff S c; 
      p = polyn_expr R X (fst c) c; pol_coeff S d;
      fst c = fst d; (snd c) (fst c) = (snd d) (fst d)⟧ ⟹
      p ± (-⇩a (polyn_expr R X (fst d) d)) = 𝟬 ∨ 
     deg_n R S X (p ± (-⇩a (polyn_expr R X (fst d) d))) < (fst c)"
apply (cut_tac ring_is_ag, 
       cut_tac subring, frule subring_Ring)
apply (case_tac "p ±⇘R⇙ (-⇩a⇘R⇙ (polyn_expr R X (fst d) d)) = 𝟬⇘R⇙", simp) 
apply simp
 apply (simp add:polyn_minus_m_cf[of d "fst d"],
        frule m_cf_pol_coeff[of d])
 apply (cut_tac  polyn_add1[of c "m_cf S d"], simp add:m_cf_len,
        thin_tac "polyn_expr R X (fst d) c ± polyn_expr R X (fst d) (m_cf S d)
        = polyn_expr R X (fst d) (add_cf S c (m_cf S d))")
 apply (frule add_cf_pol_coeff[of c "m_cf S d"], assumption+)
 apply (cut_tac polyn_mem[of "add_cf S c (m_cf S d)" "fst d"],
        frule pol_deg_le_n[of "polyn_expr R X (fst d) (add_cf S c (m_cf S d))"
        "add_cf S c (m_cf S d)"], assumption+,
        simp add:add_cf_len m_cf_len,
        simp add:add_cf_len m_cf_len)
 apply (rule noteq_le_less[of "deg_n R S X (polyn_expr R X (fst d) 
         (add_cf S c (m_cf S d)))" "fst d"], assumption)
 apply (rule contrapos_pp, simp+)
 apply (cut_tac pol_deg_eq_c_max[of "polyn_expr R X (fst d) 
             (add_cf S c (m_cf S d))" "add_cf S c (m_cf S d)"],
        simp,
        thin_tac "deg_n R S X (polyn_expr R X (fst d) (add_cf S c (m_cf S d)))
                 = fst d") 
 apply (frule coeff_nonzero_polyn_nonzero[of "add_cf S c (m_cf S d)" "fst d"],
        simp add:add_cf_len m_cf_len, simp,
              thin_tac "polyn_expr R X (fst d) (add_cf S c (m_cf S d)) ≠ 𝟬",
        frule coeff_max_nonzeroTr[of "add_cf S c (m_cf S d)"],
        simp add:add_cf_len m_cf_len,
               thin_tac "∃j≤fst d. snd (add_cf S c (m_cf S d)) j ≠ 𝟬⇘S⇙",
               thin_tac "pol_coeff S (m_cf S d)",
               thin_tac "pol_coeff S (add_cf S c (m_cf S d))",
               thin_tac "polyn_expr R X (fst d) (add_cf S c (m_cf S d)) ∈ 
                         carrier R", simp,
               thin_tac "c_max S (add_cf S c (m_cf S d)) = fst d")
   apply (simp add:add_cf_def m_cf_def,
          frule pol_coeff_mem[of d "fst d"], simp,
          frule Ring.ring_is_ag[of S], 
               simp add:aGroup.ag_r_inv1, assumption+,
          simp add:add_cf_len m_cf_len, assumption,
          simp add:add_cf_len m_cf_len, assumption+)
done

lemma (in PolynRg) pol_pre_lt_deg:"⟦p ∈ carrier R; pol_coeff S c;
      deg_n R S X p ≤ (fst c); (deg_n R S X p) ≠ 0;
      p = polyn_expr R X (deg_n R S X p) c ⟧ ⟹ 
 (deg_n R S X (polyn_expr R X ((deg_n R S X p) - Suc 0) c)) < (deg_n R S X p)"
apply (frule polyn_expr_short[of c "deg_n R S X p"], assumption)
apply (cut_tac pol_deg_le_n[of "polyn_expr R X (deg_n R S X p - Suc 0) c"
           "(deg_n R S X p - Suc 0, snd c)"], simp)
 apply (rule polyn_mem[of c "deg_n R S X p - Suc 0"], assumption+,
        arith,
        rule pol_coeff_le[of c "deg_n R S X p - Suc 0"], assumption,
        arith, simp)
 apply (subst polyn_expr_short[of c "deg_n R S X p - Suc 0"],
         assumption+, arith, simp)
done

lemma (in PolynRg) pol_deg_n:"⟦p ∈ carrier R; pol_coeff S c; 
       n ≤ fst c; p = polyn_expr R X n c; (snd c) n ≠ 𝟬⇘S⇙⟧ ⟹
                   deg_n R S X p = n"
apply (simp add:polyn_expr_short[of c n])
 apply (frule pol_coeff_le[of c n], assumption+,
        cut_tac pol_deg_eq_c_max[of p "(n, snd c)"],
        drule sym, simp, simp add:c_max_def)
 apply (rule conjI, rule impI, cut_tac le_refl[of n],
        thin_tac "deg_n R S X p =
        (if ∀x≤n. snd c x = 𝟬⇘S⇙ then 0
        else n_max {j. j ≤ fst (n, snd c) ∧ snd (n, snd c) j ≠ 𝟬⇘S⇙})",
        drule_tac a = n in forall_spec, assumption, simp)
 apply (rule impI)
 apply (cut_tac n_max[of "{j. j ≤ n ∧ snd c j ≠ 𝟬⇘S⇙}" n], erule conjE,
        drule_tac x = n in bspec, simp, simp)
 apply (rule subsetI, simp, blast,
        drule sym, simp, assumption)
apply simp
done

lemma (in PolynRg) pol_expr_deg:"⟦p ∈ carrier R; p ≠ 𝟬⟧ 
       ⟹ ∃c. pol_coeff S c ∧ deg_n R S X p ≤ (fst c) ∧ 
                p = polyn_expr R X (deg_n R S X p) c ∧ 
               (snd c) (deg_n R S X p) ≠ 𝟬⇘S⇙"  
apply (cut_tac subring,
       frule subring_Ring)
apply (frule ex_polyn_expr[of p], erule exE, erule conjE)
 apply (frule_tac c = c in polyn_c_max)
 apply (frule_tac c = c in pol_deg_le_n[of p], assumption+)
 apply (frule_tac c1 = c and k1 ="fst c" in coeff_0_pol_0[THEN sym], simp) 
 apply (subgoal_tac "p = polyn_expr R X (deg_n R S X p) c ∧
               snd c (deg_n R S X p) ≠ 𝟬⇘S⇙", blast)
 apply (subst pol_deg_eq_c_max, assumption+)+
 apply simp
 apply (cut_tac c = c in coeff_max_nonzeroTr, simp+)
done

lemma (in PolynRg) deg_n_pos:"p ∈ carrier R ⟹ 0 ≤ deg_n R S X p"
by simp

lemma (in PolynRg) pol_expr_deg1:"⟦p ∈ carrier R; d = na (deg R S X p)⟧ ⟹ 
                ∃c. (pol_coeff S c ∧ p = polyn_expr R X d c)"
apply (cut_tac subring, frule subring_Ring)
apply (case_tac "p = 𝟬⇘R⇙",
       simp add:deg_def na_minf,
       subgoal_tac "pol_coeff S (0, (λj. 𝟬⇘S⇙))", 
       subgoal_tac "𝟬 = polyn_expr R X d (0, (λj. 𝟬⇘S⇙))", blast,
       cut_tac coeff_0_pol_0[of "(d, λj. 𝟬⇘S⇙)" d], simp+,
       simp add:pol_coeff_def,
       simp add:Ring.ring_zero)

apply (simp add:deg_def na_an,
       frule pol_expr_deg[of p], assumption,
       erule exE, (erule conjE)+,
       unfold split_paired_all, simp, blast)
done

end