Theory Algebra4

Up to index of Isabelle/HOL/Valuation

theory Algebra4
imports Algebra3 Binomial Zorn
begin

(**       Algebra4  
                            author Hidetsune Kobayashi
                                   Lingjun Chen (part of Chap 4. section 2, 
                                   with revision by H. 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 3.  Group Theory. Focused on Jordan Hoelder theorem (continued)
     section 20.   abelian groups
     subsection 20-1. Homomorphism of abelian groups
     subsection 20-2  quotient abelian group
   section 21  direct product and direct sum of abelian groups, 
               in general case

 chapter 4.  Ring theory
   section 1.  Definition of a ring and an ideal
   section 2.  Calculation of elements
   section 3.  ring homomorphisms
   section 4.  quotient rings
   section 5.  primary ideals, prime ideals
 **)   

theory Algebra4
imports Algebra3 Binomial Zorn
begin

(*<*)hide const ring(*>*)

section "20. Abelian groups"

record 'a aGroup = "'a carrier" + 
  pop      :: "['a, 'a ] => 'a"  (infixl "±\<index>" 62) 
  mop      :: "'a  => 'a"        ("(-a\<index> _)" [64]63 )
  zero     :: "'a"               ("\<zero>\<index>")

locale aGroup =
  fixes A (structure)
 assumes 
         pop_closed: "pop A ∈ carrier A -> carrier A -> carrier A"
 and     aassoc : "[|a ∈ carrier A; b ∈ carrier A; c ∈ carrier A|] ==>
         (a ± b) ± c = a ± (b ± c)"
 and     pop_commute:"[|a ∈ carrier A; b ∈ carrier A|] ==> a ± b = b ± a" 
 and     mop_closed:"mop A ∈ carrier A -> carrier A"
 and     l_m :"a ∈ carrier A ==>  (-a a) ± a = \<zero>"
 and     ex_zero: "\<zero> ∈ carrier A"
 and     l_zero:"a ∈ carrier A ==> \<zero> ± a = a"

constdefs (structure A)
 b_ag::"_  =>
   (|carrier:: 'a set, top:: ['a, 'a] => 'a , iop:: 'a => 'a, one:: 'a |)),"
   "b_ag A == (|carrier = carrier A, top = pop A, iop = mop A,
    one = zero A |)),"

 asubGroup :: "[_ , 'a set] => bool"
     "asubGroup A H == (b_ag A) » H"

constdefs (structure A)
 aqgrp :: "[_ , 'a set] => 
         (| carrier::'a set set, pop::['a  set, 'a set] => 'a set,
           mop::'a set => 'a set, zero :: 'a set |)),"
 
      "aqgrp A H  ==  (|carrier = set_rcs (b_ag A) H, 
         pop = λX. λY. (c_top (b_ag A) H X Y), 
         mop = λX. (c_iop (b_ag A) H X), zero = H |)),"
 
 ag_idmap::"_ => ('a => 'a)"  ("(aI_)")
 "aIA == λx∈carrier A. x"

syntax (xsymbols)
  "@ASubG"  :: "[('a, 'more) aGroup_scheme, 'a set] => bool" 
            (infixl "+>" 58)

translations
  "A +> H" == "asubGroup A H"

constdefs (structure A)
 Ag_ind ::"[_ , 'a => 'd] => 'd aGroup"
"Ag_ind A f == (|carrier = f`(carrier A),
  pop = λx ∈ f`(carrier A). λy ∈ f`(carrier A). 
              f(((invfun (carrier A) (f`(carrier A)) f) x) ±  
                    ((invfun (carrier A) (f`(carrier A)) f) y)),
  mop = λx∈(f`(carrier A)). f (-a ((invfun (carrier A) (f`(carrier A)) f) x)),
  zero = f (\<zero> ) |)),"

 Agii ::"[_ , 'a => 'd] => ('a => 'd)"
 "Agii A f == λx∈carrier A. f x"   (** Ag_induced_isomorphism **)

lemma (in aGroup) ag_carrier_carrier:"carrier (b_ag A) = carrier A"
by (simp add:b_ag_def)

lemma (in aGroup) ag_pOp_closed:"[|x ∈ carrier A; y ∈ carrier A|] ==> 
                                     pop A x y ∈ carrier A"
apply (cut_tac pop_closed)
apply (frule funcset_mem[of "op ± " "carrier A" "carrier A -> carrier A" "x"],
        assumption+)
apply (rule funcset_mem[of "op ± x" "carrier A" "carrier A" "y"], assumption+)
done

lemma (in aGroup) ag_mOp_closed:"x ∈ carrier A ==> (-a x)  ∈ carrier A"
apply (cut_tac mop_closed)
apply (rule funcset_mem[of "mop A" "carrier A" "carrier A" "x"], assumption+)
done

lemma (in aGroup) asubg_subset:"A +> H ==> H ⊆ carrier A"
apply (simp add:asubGroup_def)
apply (simp add:sg_def, (erule conjE)+)
apply (simp add:ag_carrier_carrier)
done

lemma (in aGroup) ag_pOp_commute:"[|x ∈ carrier A; y ∈ carrier A|]  ==> 
           pop A x y = pop A y x"  
by (simp add:pop_commute)

lemma (in aGroup) b_ag_group:"Group (b_ag A)"
apply (unfold Group_def)
 apply (simp add:b_ag_def)
apply (simp add:pop_closed mop_closed ex_zero)
apply (rule conjI)
 apply (rule allI, rule impI)+
 apply (simp add:aassoc)
apply (rule conjI)
 apply (rule allI, rule impI)
 apply (simp add:l_m)
 
 apply (rule allI, rule impI)
 apply (simp add:l_zero)
done

lemma (in aGroup) agop_gop:"top (b_ag A) = pop A" (*agpop_gtop*)
 apply (simp add:b_ag_def)
done

lemma (in aGroup) agiop_giop:"iop (b_ag A) = mop A" (*agmop_giop*)
apply (simp add:b_ag_def)
done

lemma (in aGroup) agunit_gone:"one (b_ag A) = \<zero>"
apply (simp add:b_ag_def)
done

lemma (in aGroup) ag_pOp_add_r:"[|a ∈ carrier A; b ∈ carrier A; c ∈ carrier A;
                 a = b|]  ==> a ± c =  b ± c" 
apply simp
done

lemma (in aGroup) ag_add_commute:"[|a ∈ carrier A; b ∈ carrier A|] ==>
                                                  a ± b = b ± a"
by (simp add:pop_commute)

lemma (in aGroup) ag_pOp_add_l:"[|a ∈ carrier A; b ∈ carrier A; c ∈ carrier A;
                 a = b|]  ==> c ± a =  c ± b" 
apply simp
done

lemma (in aGroup) asubg_pOp_closed:"[|asubGroup A H; x ∈ H; y ∈ H|]
                                   ==> pop A x y ∈ H"
apply (simp add:asubGroup_def)
 apply (cut_tac b_ag_group)  
 apply (frule Group.sg_mult_closed [of "b_ag A" "H" "x" "y"], assumption+)
apply (simp only:agop_gop)   
done

lemma (in aGroup) asubg_mOp_closed:"[|asubGroup A H; x ∈ H|] ==> -a x ∈ H"
apply (simp add:asubGroup_def)
apply (cut_tac b_ag_group) 
apply (frule Group.sg_i_closed[of "b_ag A" "H" "x"], assumption+)
apply (simp add:agiop_giop)
done

lemma (in aGroup) asubg_subset1:"[|asubGroup A H; x ∈ H|] ==> x ∈ carrier A"
apply (simp add:asubGroup_def)
apply (cut_tac b_ag_group)
apply (frule Group.sg_subset_elem[of "b_ag A" "H" "x"], assumption+)
apply (simp add:ag_carrier_carrier)
done

lemma (in aGroup) asubg_inc_zero:"asubGroup A H ==> \<zero> ∈ H"
apply (simp add:asubGroup_def)
apply (cut_tac b_ag_group)
apply (frule Group.sg_unit_closed[of "b_ag A" "H"], assumption)
apply (simp add:b_ag_def)
done

lemma (in aGroup) ag_inc_zero:"\<zero> ∈ carrier A"
by (simp add:ex_zero)

lemma (in aGroup) ag_l_zero:"x ∈ carrier A ==> \<zero> ± x = x"
by (simp add:l_zero)
 
lemma (in aGroup) ag_r_zero:"x ∈ carrier A ==> x ± \<zero> = x"
apply (cut_tac ex_zero)
apply (subst pop_commute, assumption+)
apply (rule ag_l_zero, assumption)
done

lemma (in aGroup) ag_l_inv1:"x ∈ carrier A ==> (-a x) ± x = \<zero>"
by (simp add:l_m)

lemma (in aGroup) ag_r_inv1:"x ∈ carrier A ==> x ± (-a x) = \<zero>" 
by (frule ag_mOp_closed[of "x"],
       subst ag_pOp_commute, assumption+,
       simp add:ag_l_inv1)

lemma (in aGroup) ag_pOp_assoc:"[|x ∈ carrier A; y ∈ carrier A; z ∈ carrier A|] 
                ==> (x ± y) ± z = x ± (y ± z)" 
by (simp add:aassoc)

lemma (in aGroup) ag_inv_unique:"[|x ∈ carrier A; y ∈ carrier A; x ± y = \<zero>|] ==>
                                     y = -a x" 
apply (frule ag_mOp_closed[of "x"],
       frule aassoc[of "-a x" "x" "y"], assumption+, 
       simp add:l_m l_zero ag_r_zero)
done

lemma (in aGroup) ag_inv_inj:"[|x ∈ carrier A; y ∈ carrier A; x ≠ y|] ==>
                                          (-a x) ≠ (-a y)" 
apply (rule contrapos_pp, simp+)
apply (frule ag_mOp_closed[of "y"],
       frule aassoc[of "y" "-a y" "x"], assumption+)
apply (simp only:ag_r_inv1,
       frule sym, thin_tac "-a x = -a y", simp add:l_m)
apply (simp add:l_zero ag_r_zero)
done
    
lemma (in aGroup) pOp_assocTr41:"[|a ∈ carrier A; b ∈ carrier A; c ∈ carrier A;
 d ∈ carrier A|] ==> a ± b ± c ± d = a ± b ± (c ± d)" 
by (frule ag_pOp_closed[of "a" "b"], assumption+,
    rule aassoc[of "a ± b" "c" "d"], assumption+)
  
lemma (in aGroup) pOp_assocTr42:"[|a ∈ carrier A; b ∈ carrier A;
 c ∈ carrier A; d ∈ carrier A|] ==> a ± b ± c ± d = a ± (b ± c) ± d" 
by (simp add:aassoc[THEN sym, of "a" "b" "c"])

lemma (in aGroup) pOp_assocTr43:"[|a ∈ carrier A; b ∈ carrier A;
 c ∈ carrier A; d ∈ carrier A|] ==> a ± b ± (c ± d) = a ± (b ± c) ± d" 
by (subst  pOp_assocTr41[THEN sym], assumption+, 
       rule pOp_assocTr42, assumption+)

lemma (in aGroup) pOp_assoc_cancel:"[|a ∈ carrier A; b ∈ carrier A;
 c ∈ carrier A|] ==> a ± -a b ± (b ± -a c) = a ± -a c" 
apply (subst pOp_assocTr43, assumption) 
apply (simp add:ag_l_inv1 ag_mOp_closed)+
apply (simp add:ag_r_zero)
done

lemma (in aGroup) ag_p_inv:"[|x ∈ carrier A; y ∈ carrier A|] ==>
                                     (-a (x ± y)) = (-a x) ± (-a y)" 
apply (frule ag_mOp_closed[of "x"], frule ag_mOp_closed[of "y"],
       frule ag_pOp_closed[of "x" "y"], assumption+)
apply (frule aassoc[of "x ± y" "-a x" "-a y"], assumption+,
       simp add:pOp_assocTr43, simp add:pop_commute[of "y" "-a x"],
       simp add:aassoc[THEN sym, of "x" "-a x" "y"],
       simp add:ag_r_inv1 l_zero)
apply (frule ag_pOp_closed[of "-a x" "-a y"], assumption+,
       simp add:pOp_assocTr41,
       rule ag_inv_unique[THEN sym, of "x ± y" "-a x ± -a y"], assumption+)
done

lemma (in aGroup) gEQAddcross: "[|l1 ∈ carrier A; l2 ∈ carrier A;
      r1 ∈ carrier A; r1 ∈ carrier A; l1 = r2; l2 = r1|] ==> 
                          l1 ± l2 = r1 ± r2"
  apply (simp add:ag_pOp_commute)
  done

lemma (in aGroup) ag_eq_sol1:"[|a ∈ carrier A; x∈ carrier A; b∈ carrier A;
                               a ± x = b|] ==> x = (-a a) ± b" 
apply (frule ag_mOp_closed[of "a"])
apply (frule aassoc[of "-a a" "a" "x"], assumption+)
apply (simp add:l_m l_zero)
done

lemma (in aGroup) ag_eq_sol2:"[|a ∈ carrier A; x∈ carrier A; b∈ carrier A;
                                x ± a = b|] ==> x = b ± (-a a)"
apply (frule ag_mOp_closed[of "a"],
       frule aassoc[of "x" "a" "-a a"], assumption+, 
       simp add:ag_r_inv1 ag_r_zero)
done

lemma (in aGroup) ag_add4_rel:"[|a ∈ carrier A; b ∈ carrier A; c ∈ carrier A;
 d ∈ carrier A |] ==> a ± b ± (c ± d) =  a ± c ± (b ± d)"
apply (simp add:pOp_assocTr43[of "a" "b" "c" "d"],
       simp add:ag_pOp_commute[of "b" "c"],
       simp add:pOp_assocTr43[THEN sym, of "a" "c" "b" "d"])
done

lemma (in aGroup) ag_inv_inv:"x ∈ carrier A ==> -a (-a x) = x"
by (frule ag_l_inv1[of "x"], frule ag_mOp_closed[of "x"],
       rule  ag_inv_unique[THEN sym, of "-a x" "x"], assumption+)

lemma (in aGroup) ag_inv_zero:"-a \<zero> = \<zero>"
apply (cut_tac ex_zero)
apply (frule l_zero[of "\<zero>"])
apply (rule ag_inv_unique[THEN sym], assumption+)
done   

lemma (in aGroup) ag_diff_minus:"[|a ∈ carrier A; b ∈ carrier A; c ∈ carrier A;
                   a ± (-a b) = c|] ==> b ± (-a a) = (-a c)"
apply (frule sym, thin_tac "a ± -a b = c", simp, thin_tac "c = a ± -a b")
apply (frule ag_mOp_closed[of "b"], frule ag_mOp_closed[of "a"],
       subst ag_p_inv, assumption+, subst ag_inv_inv, assumption)
apply (simp add:ag_pOp_commute)
done

lemma (in aGroup) pOp_cancel_l:"[|a ∈ carrier A; b ∈ carrier A; c ∈ carrier A;                    c ± a =  c ± b |] ==> a = b"
apply (frule ag_mOp_closed[of "c"],
       frule aassoc[of "-a c" "c" "a"], assumption+,
       simp only:l_m l_zero)
apply (simp only:aassoc[THEN sym, of "-a c" "c" "b"],
        simp only:l_m l_zero)
done

lemma (in aGroup) pOp_cancel_r:"[|a ∈ carrier A; b ∈ carrier A; c ∈ carrier A;               a ± c =  b ± c |] ==> a = b"
by (simp add:ag_pOp_commute pOp_cancel_l)

lemma (in aGroup) ag_eq_diffzero:"[|a ∈ carrier A; b ∈ carrier A|] ==>
                       (a = b) = (a ± (-a b) = \<zero>)" 
apply (rule iffI)
 apply (simp add:ag_r_inv1)
 apply (frule ag_mOp_closed[of "b"])
 apply (simp add:ag_pOp_commute[of "a" "-a b"])
 apply (subst ag_inv_unique[of "-a b" "a"], assumption+,
        simp add:ag_inv_inv) 
done

lemma (in aGroup) ag_eq_diffzero1:"[|a ∈ carrier A; b ∈ carrier A|] ==>
                       (a = b) = ((-a a) ± b = \<zero>)" 
apply (frule ag_mOp_closed[of a],
       simp add:ag_pOp_commute)
apply (subst ag_eq_diffzero[THEN sym], assumption+)
apply (rule iffI, rule sym, assumption)
apply (rule sym, assumption)
done

lemma (in aGroup) ag_neq_diffnonzero:"[|a ∈ carrier A; b ∈ carrier A|] ==>
         (a ≠ b) = (a ± (-a b) ≠  \<zero>)" 
apply (rule iffI)
 apply (rule contrapos_pp, simp+)
 apply (simp add:ag_eq_diffzero[THEN sym])
apply (rule contrapos_pp, simp+)
 apply (simp add:ag_r_inv1)
done

lemma (in aGroup) ag_plus_zero:"[|x ∈ carrier A; y ∈ carrier A|] ==>
                     (x = -a y)  = (x ± y = \<zero>)"
apply (rule iffI)
 apply (simp add:ag_l_inv1)
apply (simp add:ag_pOp_commute[of "x" "y"])
apply (rule ag_inv_unique[of "y" "x"], assumption+)
done 

lemma (in aGroup) asubg_nsubg:"A +> H ==>  (b_ag A) \<triangleright> H"
apply (cut_tac b_ag_group)
apply (simp add:asubGroup_def)
apply (rule Group.cond_nsg[of "b_ag A" "H"], assumption+)
apply (rule ballI)+
apply(simp add:agop_gop agiop_giop)
 apply (frule Group.sg_subset[of "b_ag A" "H"], assumption) 
 apply (simp add:ag_carrier_carrier)
apply (frule_tac c = h in subsetD[of "H" "carrier A"], assumption+)
 apply (subst ag_pOp_commute, assumption+)
 apply (frule_tac x = a in ag_mOp_closed)
 apply (subst aassoc, assumption+, simp add:ag_r_inv1 ag_r_zero)
done

lemma (in aGroup) subg_asubg:"b_ag G » H ==> G +> H"
apply (simp add:asubGroup_def)
done
 
lemma (in aGroup) asubg_test:"[|H ⊆ carrier A; H ≠ {}; 
               ∀a∈H. ∀b∈H. (a ± (-a b) ∈ H)|] ==> A +> H"
apply (simp add:asubGroup_def) apply (cut_tac b_ag_group) 
apply (rule Group.sg_condition [of "b_ag A" "H"], assumption+)
 apply (simp add:ag_carrier_carrier) apply assumption
apply (rule allI)+ apply (rule impI)
apply (simp add:agop_gop agiop_giop)
done 

lemma (in aGroup) asubg_zero:"A +> {\<zero>}"
apply (rule asubg_test[of "{\<zero>}"])
 apply (simp add:ag_inc_zero)
 apply simp
 apply (simp, cut_tac ag_inc_zero, simp add:ag_r_inv1)
done 

lemma (in aGroup) asubg_whole:"A +> carrier A"
apply (rule asubg_test[of "carrier A"])
apply (simp,
       cut_tac ag_inc_zero, simp add:nonempty) 
apply ((rule ballI)+,
       rule ag_pOp_closed, assumption,
       rule_tac x = b in ag_mOp_closed, assumption)
done

lemma (in aGroup) Ag_ind_carrier:"bij_to f (carrier A) (D::'d set) ==> 
               carrier (Ag_ind A f) = f ` (carrier A)"
by (simp add:Ag_ind_def)

lemma (in aGroup) Ag_ind_aGroup:"[|f ∈ carrier A -> D;
      bij_to f (carrier A) (D::'d set)|] ==> aGroup (Ag_ind A f)"
apply (simp add:bij_to_def, frule conjunct1, frule conjunct2, fold bij_to_def)
apply (simp add:aGroup_def) 
 apply (rule conjI)
 apply (rule bivar_func_test)
 apply (rule ballI)+
 apply (simp add:Ag_ind_carrier surj_to_def)
 apply (frule_tac b = a in invfun_mem1[of "f" "carrier A" "D"], assumption+,
        frule_tac b = b in invfun_mem1[of "f" "carrier A" "D"], assumption+)
apply (simp add:Ag_ind_def)
 apply (rule funcset_mem[of "f" "carrier A" "D"], assumption)
 apply (simp add:ag_pOp_closed)
 
 apply (rule conjI)
 apply (rule allI, rule impI)+
 apply (simp add: Ag_ind_carrier surj_to_def)
 apply (frule_tac b = a in invfun_mem1[of "f" "carrier A" "D"], assumption+,
        frule_tac b = b in invfun_mem1[of "f" "carrier A" "D"], assumption+,
        frule_tac b = c in invfun_mem1[of "f" "carrier A" "D"], assumption+)
 apply (simp add:Ag_ind_def)
 apply (frule_tac x = "invfun (carrier A) D f a" and 
                  y = "invfun (carrier A) D f b" in ag_pOp_closed, assumption+,
        frule_tac x = "invfun (carrier A) D f b" and 
                  y = "invfun (carrier A) D f c" in ag_pOp_closed, assumption+)
 apply (simp add:funcset_mem[of "f" "carrier A" "D"])
 apply (unfold bij_to_def, frule conjunct1, fold bij_to_def)
 apply (simp add:invfun_l) 
 apply (subst injective_iff[of "f" "carrier A", THEN sym], assumption) 
 apply (simp add:ag_pOp_closed)+
 apply (simp add:ag_pOp_assoc)

apply (rule conjI)
 apply (rule allI, rule impI)+
 apply (simp add:Ag_ind_def)
 apply (subst injective_iff[of "f" "carrier A", THEN sym], assumption) 
 apply (frule_tac b = a in invfun_mem1[of "f" "carrier A" "D"], assumption+,
        frule_tac b = b in invfun_mem1[of "f" "carrier A" "D"], assumption+)
       apply (simp add:surj_to_def) apply (simp add:surj_to_def)
 
 apply (simp add:surj_to_def)
 apply (frule_tac b = b in invfun_mem1[of "f" "carrier A" "D"], assumption+) 
 apply (simp add:ag_pOp_closed)

 apply (simp add:surj_to_def)
 apply (frule_tac b = a in invfun_mem1[of "f" "carrier A" "D"], assumption+,
        frule_tac b = b in invfun_mem1[of "f" "carrier A" "D"], assumption+)
       apply (simp add:ag_pOp_closed)

 apply (simp add:surj_to_def)
 apply (frule_tac b = a in invfun_mem1[of "f" "carrier A" "D"], assumption+,
        frule_tac b = b in invfun_mem1[of "f" "carrier A" "D"], assumption+)
       apply (simp add:ag_pOp_commute)

apply (rule conjI)
 apply (rule univar_func_test)
 apply (rule ballI)
 apply (simp add:Ag_ind_def surj_to_def)
 apply (rule funcset_mem[of "f" "carrier A" "D"], assumption)
 apply (frule_tac b = x in invfun_mem1[of "f" "carrier A" "D"], assumption+)
 apply (simp add:ag_mOp_closed)

apply (rule conjI)
 apply (rule allI, rule impI)
 apply (simp add:Ag_ind_def surj_to_def)
 apply (frule_tac b = a in invfun_mem1[of "f" "carrier A" "D"], assumption+)
           
 apply (frule_tac x = "invfun (carrier A) D f a" in ag_mOp_closed)
 apply (simp add:funcset_mem[of "f" "carrier A" "D"])
 apply (subst injective_iff[of "f" "carrier A", THEN sym], assumption)
 apply (unfold bij_to_def, frule conjunct1, fold bij_to_def)
 apply (simp add:invfun_l)
 apply (simp add:ag_pOp_closed)
 apply (simp add:ag_inc_zero)
 apply (unfold bij_to_def, frule conjunct1, fold bij_to_def)
 apply (simp add:invfun_l)
 apply (simp add:l_m)

apply (rule conjI)
 apply (simp add:Ag_ind_def surj_to_def)
 apply (rule funcset_mem[of "f" "carrier A" "D"], assumption)
 apply (simp add:ag_inc_zero)

apply (rule allI, rule impI)
  apply (simp add:Ag_ind_def surj_to_def)
  apply (cut_tac ag_inc_zero, simp add:funcset_mem)
  apply (unfold bij_to_def, frule conjunct1, fold bij_to_def)
  apply (simp add:invfun_l)
 apply (frule_tac b = a in invfun_mem1[of "f" "carrier A" "D"], assumption+)   
 apply (simp add:l_zero)
 apply (simp add:invfun_r)
done 

subsection "20-1. Homomorphism of abelian groups"

constdefs 
  aHom::"[('a, 'm) aGroup_scheme, ('b, 'm1) aGroup_scheme] => ('a => 'b) set"
 "aHom A B == {f. f ∈ carrier A -> carrier B ∧ f ∈ extensional (carrier A) ∧
               (∀a∈carrier A. ∀b∈carrier A. f (a ±A b) = (f a) ±B (f b))}"

constdefs
 compos::"[('a, 'm) aGroup_scheme, 'b => 'c, 'a => 'b] => 'a => 'c"
 "compos A g f == compose (carrier A) g f"

constdefs
 ker::"[('a, 'm) aGroup_scheme, ('b, 'm1) aGroup_scheme] => ('a => 'b)
        => 'a set" ("(3ker_,_ _)" [82,82,83]82)
 "kerF,G f == {a. a ∈ carrier F ∧ f a = (\<zero>G)}"

constdefs
 injec::"[('a, 'm) aGroup_scheme, ('b, 'm1) aGroup_scheme, 'a => 'b]
            => bool"             ("(3injec_,_ _)" [82,82,83]82)
 "injecF,G f == f ∈ aHom F G ∧ kerF,G f = {\<zero>F}"

constdefs
 surjec::"[('a, 'm) aGroup_scheme, ('b, 'm1) aGroup_scheme, 'a => 'b]
            => bool"             ("(3surjec_,_ _)" [82,82,83]82)
 "surjecF,G f == f ∈ aHom F G ∧ surj_to f (carrier F) (carrier G)"  

constdefs
 bijec::"[('a, 'm) aGroup_scheme, ('b, 'm1) aGroup_scheme, 'a => 'b]
            => bool"             ("(3bijec_,_ _)" [82,82,83]82)
 "bijecF,G f == injecF,G f ∧surjecF,G f"

constdefs
 ainvf::"[('a, 'm) aGroup_scheme, ('b, 'm1) aGroup_scheme, 'a => 'b]
            => ('b => 'a)"             ("(3ainvf_,_ _)" [82,82,83]82)
 "ainvfF,G f == invfun (carrier F) (carrier G) f"
 
lemma aHom_mem:"[|aGroup F; aGroup G; f ∈ aHom F G; a ∈ carrier F|] ==>
                       f a ∈ carrier G"
apply (simp add:aHom_def) apply (erule conjE)+
apply (simp add:funcset_mem)
done

lemma aHom_func:"f ∈ aHom F G ==> f ∈ carrier F -> carrier G"
by (simp add:aHom_def)

lemma aHom_add:"[|aGroup F; aGroup G; f ∈ aHom F G; a ∈ carrier F; 
 b ∈ carrier F|] ==> f (a ±F b) = (f a) ±G (f b)" 
apply (simp add:aHom_def)
done

lemma aHom_0_0:"[|aGroup F; aGroup G; f ∈ aHom F G|] ==> f (\<zero>F) = \<zero>G"
apply (frule aGroup.ag_inc_zero [of "F"])
apply (subst aGroup.ag_l_zero [THEN sym, of "F" "\<zero>F"], assumption+)
apply (simp add:aHom_add)
apply (frule aGroup.ag_l_zero [THEN sym, of "F" "\<zero>F"], assumption+)
apply (subgoal_tac "f (\<zero>F) = f (\<zero>F ±F \<zero>F)") prefer 2 apply simp
apply (thin_tac "\<zero>F = \<zero>F ±F \<zero>F")
apply (simp add:aHom_add) apply (frule sym) 
apply (thin_tac "f \<zero>F = f \<zero>F ±G f \<zero>F")
apply (frule aHom_mem[of "F" "G" "f" "\<zero>F"], assumption+)
apply (frule aGroup.ag_mOp_closed[of "G" "f \<zero>F"], assumption+)
apply (frule aGroup.aassoc[of "G" "-aG (f \<zero>F)" "f \<zero>F" "f \<zero>F"], assumption+)
apply (simp add:aGroup.l_m aGroup.l_zero)
done

lemma ker_inc_zero:"[|aGroup F; aGroup G; f ∈ aHom F G|] ==> \<zero>F ∈ kerF,G f"
by (frule aHom_0_0[of "F" "G" "f"], assumption+,
       simp add:ker_def, simp add:aGroup.ag_inc_zero [of "F"])

lemma aHom_inv_inv:"[|aGroup F; aGroup G; f ∈ aHom F G; a ∈ carrier F|] ==>
                         f (-aF a) = -aG (f a)"
apply (frule aGroup.ag_l_inv1 [of "F" "a"], assumption+,
       frule sym, thin_tac "-aF a ±F a = \<zero>F",
       frule aHom_0_0[of "F" "G" "f"], assumption+,
       frule aGroup.ag_mOp_closed[of "F" "a"], assumption+)
 apply (simp add:aHom_add, thin_tac "\<zero>F = -aF a ±F a")
 apply (frule aHom_mem[of "F" "G" "f" "-aF a"], assumption+,
        frule aHom_mem[of "F" "G" "f" "a"], assumption+,
        simp only:aGroup.ag_pOp_commute[of "G" "f (-aF a)" "f a"])
 apply (rule aGroup.ag_inv_unique[of "G"], assumption+)
done

lemma aHom_compos:"[|aGroup L; aGroup M; aGroup N; f ∈ aHom L M; g ∈ aHom M N |]
  ==> compos L g f ∈ aHom L N" 
apply (simp add:aHom_def [of "L" "N"])
apply (rule conjI)
 apply (rule univar_func_test) apply (rule ballI)
 apply (simp add:compos_def compose_def)
 apply (rule aHom_mem [of "M" "N" "g"], assumption+)
 apply (simp add:aHom_mem [of "L" "M" "f"])
apply (rule conjI)
 apply (simp add:compos_def compose_def extensional_def)
apply (rule ballI)+
 apply (simp add:compos_def compose_def)
 apply (simp add:aGroup.ag_pOp_closed)
 apply (simp add:aHom_add)
 apply (rule aHom_add, assumption+)
 apply (simp add:aHom_mem)+
done

lemma aHom_compos_assoc:"[|aGroup K; aGroup L; aGroup M; aGroup N; f ∈ aHom K L;
      g ∈ aHom L M; h ∈ aHom M N |]  ==> 
      compos K h (compos K g f) = compos K (compos L h g) f"
apply (simp add:compos_def compose_def)
apply (rule funcset_eq[of _ "carrier K"])
apply (simp add:restrict_def extensional_def)
apply (simp add:restrict_def extensional_def)
apply (rule ballI, simp)
apply (simp add:aHom_mem)
done

lemma injec_inj_on:"[|aGroup F; aGroup G; injecF,G f|] ==> inj_on f (carrier F)" 
apply (simp add:inj_on_def)
 apply (rule ballI)+ apply (rule impI)
 apply (simp add:injec_def, erule conjE)
 apply (frule_tac a = x in aHom_mem[of "F" "G" "f"], assumption+,
        frule_tac a = x in aHom_mem[of "F" "G" "f"], assumption+)
 apply (frule_tac x = "f x" in aGroup.ag_r_inv1[of "G"], assumption+)
 apply (simp only:aHom_inv_inv[THEN sym, of "F" "G" "f"])
 apply (frule sym, thin_tac "f x = f y", simp)
 apply (frule_tac x = y in aGroup.ag_mOp_closed[of "F"], assumption+)
 apply (simp add:aHom_add[THEN sym], simp add:ker_def)
 apply (subgoal_tac "x ±F -aF y ∈ {a ∈ carrier F. f a = \<zero>G}",
        simp)
 apply (subst aGroup.ag_eq_diffzero[of "F"], assumption+)
apply (frule_tac x = x and y = "-aF y" in aGroup.ag_pOp_closed[of "F"],
           assumption+)
 apply simp apply blast
done

lemma surjec_surj_to:"surjecR,S f ==> surj_to f (carrier R) (carrier S)"
by (simp add:surjec_def)

lemma compos_bijec:"[|aGroup E; aGroup F; aGroup G; bijecE,F f; bijecF,G g|] ==>
                     bijecE,G (compos E g f)"
apply (simp add:bijec_def, (erule conjE)+)
apply (rule conjI)
 apply (simp add:injec_def, (erule conjE)+)
 apply (simp add:aHom_compos[of "E" "F" "G" "f" "g"])
 apply (rule equalityI, rule subsetI, simp add:ker_def, erule conjE) 
 apply (simp add:compos_def compose_def)
 apply (frule_tac a = x in aHom_mem[of "E" "F" "f"], assumption+)
 apply (subgoal_tac "(f x) ∈ {a ∈ carrier F. g a = \<zero>G}", simp)
 apply (subgoal_tac "x ∈ {a ∈ carrier E. f a = \<zero>F}", simp)
 apply blast apply blast
 apply (rule subsetI, simp)
 apply (simp add:ker_def compos_def compose_def)
 apply (simp add:aGroup.ag_inc_zero) apply (simp add:aHom_0_0)

apply (simp add:surjec_def, (erule conjE)+)
 apply (simp add:aHom_compos)
 apply (simp add:aHom_def, (erule conjE)+) apply (simp add:compos_def)
 apply (rule compose_surj[of "f" "carrier E" "carrier F" "g" "carrier G"],
            assumption+)
done

lemma ainvf_aHom:"[|aGroup F; aGroup G; bijecF,G f|] ==>
                      ainvfF,G f ∈ aHom G F"
apply (subst aHom_def, simp)
 apply (simp add:ainvf_def)
 apply (simp add:bijec_def, erule conjE)
 apply (frule injec_inj_on[of "F" "G" "f"], assumption+)
 apply (simp add:surjec_def, (erule conjE)+)
 apply (simp add:aHom_def, (erule conjE)+)
 apply (frule inv_func[of "f" "carrier F" "carrier G"], assumption+, simp)
apply (rule conjI)
 apply (simp add:invfun_def)
apply (rule ballI)+
 apply (frule_tac x = a in funcset_mem[of "Ifn F G f" "carrier G" "carrier F"],
      assumption+,
      frule_tac x = b in funcset_mem[of "Ifn F G f" "carrier G" "carrier F"],
      assumption+,
      frule_tac x = a and y = b in aGroup.ag_pOp_closed[of "G"], assumption+,
      frule_tac x = "a ±G b" in funcset_mem[of "Ifn F G f" "carrier G" 
       "carrier F"], assumption+)
 apply (frule_tac a = "(Ifn F G f) a" and b = "(Ifn F G f) b" in 
           aHom_add[of "F" "G" "f"], assumption+, simp add:injec_def,
           assumption+,
           thin_tac "∀a∈carrier F. ∀b∈carrier F. f (a ±F b) = f a ±G f b")
 apply (simp add:invfun_r[of "f" "carrier F" "carrier G"]) 
 apply (frule_tac x = a and y = b in aGroup.ag_pOp_closed[of "G"], assumption+) apply (frule_tac b = "a ±G b" in invfun_r[of "f" "carrier F" "carrier G"],
           assumption+) 
 apply (simp add:inj_on_def)
 apply (frule_tac x = "(Ifn F G f) a" and y = "(Ifn F G f) b" in 
          aGroup.ag_pOp_closed, assumption+)
 apply (frule_tac b = "(Ifn F G f) (a ±G b)" in forball_spec1, assumption,
        thin_tac "∀x∈carrier F. ∀y∈carrier F. f x = f y --> x = y")
 apply (frule_tac b = "(Ifn F G f) a ±F (Ifn F G f) b" in forball_spec1,
            assumption,
        thin_tac "∀y∈carrier F.
              f ((Ifn F G f) (a ±G b)) = f y --> (Ifn F G f) (a ±G b) = y")
 apply simp
done

lemma ainvf_bijec:"[|aGroup F; aGroup G; bijecF,G f|] ==> bijecG,F (ainvfF,G f)"
apply (subst bijec_def)
apply (simp add:injec_def surjec_def)
apply (simp add:ainvf_aHom)
apply (rule conjI)
 apply (rule equalityI)
 apply (rule subsetI, simp add:ker_def, erule conjE)
 apply (simp add:ainvf_def)
 apply (simp add:bijec_def,(erule conjE)+, simp add:surjec_def,
         (erule conjE)+, simp add:aHom_def, (erule conjE)+)
 apply (frule injec_inj_on[of "F" "G" "f"], assumption+)
 apply (subst invfun_r[THEN sym, of "f" "carrier F" "carrier G"], assumption+)
 apply (simp add:injec_def, (erule conjE)+, simp add:aHom_0_0)
 
 apply (rule subsetI, simp add:ker_def)
 apply (simp add:aGroup.ex_zero)
 apply (frule ainvf_aHom[of "F" "G" "f"], assumption+)
 apply (simp add:aHom_0_0)

apply (frule ainvf_aHom[of "F" "G" "f"], assumption+,
        simp add:aHom_def, (erule conjE)+,
       rule surj_to_test[of "ainvfF,G f" "carrier G" "carrier F"],
        assumption+)
 apply (rule ballI,
        thin_tac "∀a∈carrier G. ∀b∈carrier G.
               (ainvfF,G f) (a ±G b) = (ainvfF,G f) a ±F (ainvfF,G f) b")
 apply (simp add:bijec_def, erule conjE)
  apply (frule injec_inj_on[of "F" "G" "f"], assumption+)
  apply (simp add:surjec_def aHom_def, (erule conjE)+)
  apply (subst ainvf_def)
 apply (frule_tac a = b in invfun_l[of "f" "carrier F" "carrier G"],
                  assumption+,
        frule_tac x = b in funcset_mem[of "f" "carrier F" "carrier G"],
                  assumption+, blast)
done

lemma ainvf_l:"[|aGroup E; aGroup F; bijecE,F f; x ∈ carrier E|] ==>
                      (ainvfE,F f) (f x) = x"
apply (simp add:bijec_def, erule conjE)
apply (frule injec_inj_on[of "E" "F" "f"], assumption+)
apply (simp add:surjec_def aHom_def, (erule conjE)+)
apply (frule invfun_l[of "f" "carrier E" "carrier F" "x"], assumption+) 
apply (simp add:ainvf_def)
done

lemma (in aGroup) aI_aHom:"aIA ∈ aHom A A"
apply (simp add:aHom_def)
apply (rule conjI,
      rule univar_func_test, rule ballI, simp add:ag_idmap_def)
apply (simp add:ag_idmap_def ag_pOp_closed)
done

lemma compos_aI_l:"[|aGroup A; aGroup B; f ∈ aHom A B|] ==> compos A aIB f = f"
apply (simp add:compos_def)
apply (rule funcset_eq[of _ "carrier A"])
 apply (simp add:compose_def extensional_def)
 apply (simp add:aHom_def)
apply (rule ballI)
 apply (frule_tac a = x in aHom_mem[of "A" "B" "f"], assumption+)
 apply (simp add:compose_def ag_idmap_def)
done

lemma compos_aI_r:"[|aGroup A; aGroup B; f ∈ aHom A B|] ==> compos A f aIA = f"
apply (simp add:compos_def)
apply (rule funcset_eq[of _ "carrier A"])
 apply (simp add:compose_def extensional_def)
 apply (simp add:aHom_def)
apply (rule ballI)
 apply (simp add:compose_def ag_idmap_def)
done

lemma compos_aI_surj:"[|aGroup A; aGroup B; f ∈ aHom A B; g ∈ aHom B A;
                      compos A g f = aIA|] ==> surjecB,A g"
apply (simp add:surjec_def)
apply (rule surj_to_test[of "g" "carrier B" "carrier A"])
 apply (simp add:aHom_def)
apply (rule ballI)
 apply (subgoal_tac "compos A g f b = aIA b",
        thin_tac "compos A g f = aIA")
 apply (simp add:compos_def compose_def ag_idmap_def)
 apply (frule_tac a = b in aHom_mem[of "A" "B" "f"], assumption+, blast)
 apply simp
done

lemma compos_aI_inj:"[|aGroup A; aGroup B; f ∈ aHom A B; g ∈ aHom B A;
                      compos A g f = aIA|] ==> injecA,B f"        
apply (simp add:injec_def)
apply (simp add:ker_def)
apply (rule equalityI)
 apply (rule subsetI, simp, erule conjE)
 apply (subgoal_tac "compos A g f x = aIA x",
        thin_tac "compos A g f = aIA")
 apply (simp add:compos_def compose_def)
 apply (simp add:aHom_0_0 ag_idmap_def) apply simp

 apply (rule subsetI, simp)
 apply (simp add:aGroup.ag_inc_zero aHom_0_0)
done

lemma (in aGroup) Ag_ind_aHom:"[|f ∈ carrier A -> D; 
      bij_to f (carrier A) (D::'d set)|] ==> Agii A f ∈ aHom A (Ag_ind A f)"
apply (simp add:aHom_def)
 apply (unfold bij_to_def, frule conjunct1, frule conjunct2, fold bij_to_def)
 apply (simp add:Ag_ind_carrier surj_to_def)
apply (rule conjI)
 apply (rule univar_func_test)
 apply (rule ballI, simp add:Agii_def funcset_mem)
 apply (simp add:Agii_def)
 apply (rule ballI)+
 apply (simp add:Ag_ind_def)
 apply (simp add:funcset_mem)+
 apply (unfold bij_to_def, frule conjunct1, fold bij_to_def) 
 apply (simp add:invfun_l)
 apply (simp add:ag_pOp_closed)
done

lemma (in aGroup) Agii_mem:"[|f ∈ carrier A -> D; x ∈ carrier A; 
      bij_to f (carrier A) (D::'d set)|] ==> Agii A f x ∈ carrier (Ag_ind A f)"
apply (simp add:Agii_def Ag_ind_carrier)
done

lemma Ag_ind_bijec:"[|aGroup A; f ∈ carrier A -> D; 
      bij_to f (carrier A) (D::'d set)|] ==> bijecA, (Ag_ind A f) (Agii A f)"
apply (frule aGroup.Ag_ind_aHom[of "A" "f" "D"], assumption+)
apply (frule aGroup.Ag_ind_aGroup[of "A" "f" "D"], assumption+)
apply (simp add:bijec_def)
 apply (rule conjI)
 apply (simp add:injec_def)
 apply (rule equalityI) 
 apply (rule subsetI) 
 apply (simp add:ker_def, erule conjE)
apply (frule aHom_0_0[of "A" "Ag_ind A f" "Agii A f"], assumption+)
 apply (rotate_tac -2, frule sym, thin_tac "Agii A f x = \<zero>Ag_ind A f", simp)
 apply (frule aGroup.ag_inc_zero[of "A"], simp add:Agii_def)
 apply (unfold bij_to_def, frule conjunct2, fold bij_to_def)
 apply (frule aGroup.ag_inc_zero[of "A"])
 apply (simp add:injective_iff[THEN sym, of "f" "carrier A" "\<zero>A"])
 apply (rule subsetI, simp)
 apply (subst ker_def, simp)
 apply (simp add:aGroup.ag_inc_zero, simp add:aHom_0_0)

apply (subst surjec_def)
apply (unfold bij_to_def, frule conjunct1, fold bij_to_def, simp)
 apply (simp add:aGroup.Ag_ind_carrier surj_to_def Agii_def)
done

constdefs
 aimg ::"[('b, 'm1) aGroup_scheme, _, 'b => 'a]
            => 'a aGroup"  ("(3aimg_,_ _)" [82,82,83]82)
  "aimgF,A f ≡ A (| carrier := f ` (carrier F), pop := pop A, mop := mop A,
                  zero := zero A|)),"

lemma ker_subg:"[|aGroup F; aGroup G; f ∈ aHom F G |] ==> F +> kerF,G f"
apply (rule aGroup.asubg_test, assumption+)
apply (rule subsetI)
 apply (simp add:ker_def)
apply (simp add:ker_def)
apply (frule aHom_0_0 [of "F" "G" "f"], assumption+)
apply (frule aGroup.ex_zero [of "F"]) apply blast
apply (rule ballI)+
apply (simp add:ker_def) apply (erule conjE)+
apply (frule_tac x = b in aGroup.ag_mOp_closed[of "F"], assumption+)
apply (rule conjI)
apply (rule aGroup.ag_pOp_closed, assumption+)
apply (simp add:aHom_add)
apply (simp add:aHom_inv_inv)
apply (simp add:aGroup.ag_inv_zero[of "G"])
apply (cut_tac aGroup.ex_zero[of "G"], simp add:aGroup.l_zero)
apply assumption
done

subsection "20-2 quotient abelian group"

constdefs (structure A)
 ar_coset :: "['a, _ , 'a set] => 'a set" (** a_rcs **)
     ("(3_ \<uplus>_ _)" [66,66,67]66)
  "ar_coset a A H ==  H •(b_ag A) a"

 set_ar_cos:: "[_ , 'a set] => 'a set set"
  "set_ar_cos A I == {X. ∃a∈carrier A. X = ar_coset a A I}"

 aset_sum :: "[_ , 'a set, 'a set] => 'a set "
  "aset_sum A H K == s_top (b_ag A) H K"

syntax 
  "@ASBOP1" :: "['a set, _ , 'a set] => 'a set" (infix "\<minusplus>\<index>" 60)
 
translations
  "H \<minusplus>A K" == "aset_sum A H K"

lemma (in aGroup) ag_a_in_ar_cos:"[|A +> H; a ∈ carrier A|] ==> a ∈ a \<uplus>A H"
apply (simp add:ar_coset_def)
apply (simp add:asubGroup_def) 
apply (cut_tac b_ag_group)
apply (rule Group.a_in_rcs[of "b_ag A" "H" "a"], assumption+)
apply (simp add:ag_carrier_carrier[THEN sym])
done

lemma (in aGroup) r_cos_subset:"[|A +> H; X ∈ set_rcs (b_ag A) H|] ==>
                   X ⊆ carrier A" 
apply (simp add:asubGroup_def set_rcs_def)
apply (erule bexE)
apply (cut_tac  b_ag_group)
apply (frule_tac a = a in Group.rcs_subset[of "b_ag A" "H"], assumption+)
apply (simp add:ag_carrier_carrier)
done

lemma (in aGroup) asubg_costOp_commute:"[|A +> H; x ∈ set_rcs (b_ag A) H;
       y ∈ set_rcs (b_ag A) H|] ==>
             c_top (b_ag A) H x y = c_top (b_ag A) H y x"
apply (simp add:set_rcs_def, (erule bexE)+, simp)
apply (cut_tac b_ag_group)
apply (subst Group.c_top_welldef[THEN sym], assumption+,
       simp add:asubg_nsubg,
       (simp add:ag_carrier_carrier)+)
apply (subst Group.c_top_welldef[THEN sym], assumption+,
       simp add:asubg_nsubg,
       (simp add:ag_carrier_carrier)+)
apply (simp add:agop_gop)
 apply (simp add:ag_pOp_commute)
done

lemma (in aGroup) Subg_Qgroup:"A +> H ==> aGroup (aqgrp A H)" 
apply (frule asubg_nsubg[of "H"])
apply (cut_tac b_ag_group)
apply (simp add:aGroup_def)
 apply (simp add:aqgrp_def)
 apply (simp add:Group.Qg_top [of "b_ag A" "H"]) 
 apply (simp add:Group.Qg_iop [of "b_ag A" "H"])
 apply (frule Group.nsg_sg[of "b_ag A" "H"], assumption+,
        simp add:Group.unit_rcs_in_set_rcs[of "b_ag A" "H"])
apply (simp add:Group.Qg_tassoc)
apply (simp add:asubg_costOp_commute)
apply (simp add:Group.Qg_i[of "b_ag A" "H"])
apply (simp add:Group.Qg_unit[of "b_ag A" "H"])
done

lemma (in aGroup) plus_subgs:"[|A +> H1; A +> H2|] ==> A +> H1 \<minusplus> H2"
apply (simp add:aset_sum_def)
 apply (frule asubg_nsubg[of "H2"])
 apply (simp add:asubGroup_def[of _ "H1"])
apply (cut_tac "b_ag_group") 
apply (frule Group.smult_sg_nsg[of "b_ag A" "H1" "H2"], assumption+)
apply (simp add:asubGroup_def)
done

lemma (in aGroup) set_sum:"[|H ⊆ carrier A; K ⊆ carrier A|] ==>
                    H \<minusplus> K = {x. ∃h∈H. ∃k∈K. x = h ± k}"
 apply (cut_tac b_ag_group)
apply (rule equalityI)
 apply (rule subsetI)
 apply (simp add:aset_sum_def)
 apply (simp add:agop_gop[THEN sym] s_top_def, (erule bexE)+,
        frule sym, thin_tac "xa ·b_ag A y = x", simp, blast)
 apply (rule subsetI, simp add:aset_sum_def, (erule bexE)+)
 apply (frule_tac c = h in subsetD[of H "carrier A"], assumption+,
        frule_tac c = k in subsetD[of K "carrier A"], assumption+)
 apply (simp add:agop_gop[THEN sym], simp add:s_top_def, blast)
done

lemma (in aGroup) mem_set_sum:"[|H ⊆ carrier A; K ⊆ carrier A;
                  x ∈ H \<minusplus> K |] ==> ∃h∈H. ∃k∈K. x = h ± k"
by (simp add:set_sum)

lemma (in aGroup) mem_sum_subgs:"[|A +> H; A +> K; h ∈ H; k ∈ K|] ==> 
                    h ± k ∈ H \<minusplus> K"
apply (frule asubg_subset[of H],
       frule asubg_subset[of K], 
       simp add:set_sum, blast)
done

lemma (in aGroup) aqgrp_carrier:"A +> H ==>
                   set_rcs (b_ag A ) H = set_ar_cos A H"
apply (simp add:set_ar_cos_def)
apply (simp add:ag_carrier_carrier [THEN sym])
apply (simp add:ar_coset_def set_rcs_def)
done

lemma (in aGroup) unit_in_set_ar_cos:"A +> H ==> H ∈ set_ar_cos A H"
apply (simp add:aqgrp_carrier[THEN sym])
apply (cut_tac b_ag_group) apply (simp add:asubGroup_def)
apply (simp add:Group.unit_rcs_in_set_rcs[of "b_ag A" "H"])
done

lemma (in aGroup) aqgrp_pOp_maps:"[|A +> H; a ∈ carrier A; b ∈ carrier A|] ==> 
      pop (aqgrp A H) (a \<uplus>A H) (b \<uplus>A H) = (a ± b) \<uplus>A H"
apply (simp add:aqgrp_def ar_coset_def)
apply (cut_tac b_ag_group)
apply (frule asubg_nsubg)
apply (simp add:ag_carrier_carrier [THEN sym])
apply (subst Group.c_top_welldef [THEN sym], assumption+)
apply (simp add:agop_gop)
done

lemma (in aGroup) aqgrp_mOp_maps:"[|A +> H; a ∈ carrier A|] ==> 
                   mop (aqgrp A H) (a \<uplus>A H) = (-a a) \<uplus>A H"
apply (simp add:aqgrp_def ar_coset_def)
apply (cut_tac b_ag_group)
apply (frule asubg_nsubg)
apply (simp add:ag_carrier_carrier [THEN sym])
apply (subst Group.c_iop_welldef, assumption+)
apply (simp add:agiop_giop)
done

lemma (in aGroup) aqgrp_zero:"A +> H ==> zero (aqgrp A H) = H"
apply (simp add:aqgrp_def)
done

lemma (in aGroup) arcos_fixed:"[|A +> H; a ∈ carrier A; h ∈ H |] ==> 
                              a \<uplus>A H = (h ± a) \<uplus>A H"
 apply (cut_tac b_ag_group)
 apply (simp add:agop_gop[THEN sym]) 
 apply (simp add:ag_carrier_carrier[THEN sym])
 apply (simp add:ar_coset_def)
 apply (simp add:asubGroup_def)
 apply (simp add:Group.rcs_fixed1[of "b_ag A" "H"])
done

constdefs
 rind_hom :: "[('a, 'more) aGroup_scheme, ('b, 'more1) aGroup_scheme, 
                ('a  => 'b)] => ('a set  => 'b )"
   "rind_hom A B f == λX∈(set_ar_cos A (kerA,B f)). f (SOME x. x ∈ X)"

syntax 
 "@RIND_HOM"::"['a => 'b, ('a, 'm) aGroup_scheme, ('b, 'm1) aGroup_scheme]
         =>  ('a set  => 'b )" ("(3_°_,_)" [82,82,83]82)  

translations
    "f°F,G " == "rind_hom F G f"


section "21 direct product and direct sum of abelian groups, in general case"

constdefs
 Un_carrier::"['i set, 'i => ('a, 'more) aGroup_scheme] => 'a set"
   "Un_carrier I A ==  \<Union>{X. ∃i∈I. X = carrier (A i)}"

 carr_prodag::"['i set, 'i => ('a, 'more) aGroup_scheme] => 
               ('i  => 'a ) set"  
 "carr_prodag I A == {f. f ∈ extensional I ∧ f ∈ I -> (Un_carrier I A) ∧ 
                                               (∀i∈I. f i ∈ carrier (A i))}"

 prod_pOp::"['i set,  'i => ('a, 'more) aGroup_scheme] => 
                                 ('i => 'a) => ('i => 'a) =>  ('i => 'a)"
  "prod_pOp I A  == λf∈carr_prodag I A. λg∈carr_prodag I A.
                                        λx∈I. (f x) ±(A x) (g x)" 

 prod_mOp::"['i set, 'i => ('a, 'more) aGroup_scheme] =>
                                  ('i => 'a) => ('i => 'a)"
  "prod_mOp I A  == λf∈carr_prodag I A. λx∈I. (-a(A x) (f x))" 

 prod_zero::"['i set,  'i  => ('a, 'more) aGroup_scheme] => ('i => 'a)"
  "prod_zero I A == λx∈I. \<zero>(A x)"

 prodag::"['i set, 'i => ('a, 'more) aGroup_scheme] => ('i => 'a) aGroup" 
     
 "prodag I A == (| carrier = carr_prodag I A, 
   pop = prod_pOp I A, mop = prod_mOp I A,
   zero = prod_zero I A|)),"  


 PRoject::"['i set, 'i => ('a, 'more) aGroup_scheme, 'i]
                   => ('i => 'a) => 'a" ("(3π_,_,_)" [82,82,83]82)
  "PRoject I A x == λf ∈ carr_prodag I A. f x"

syntax 
  "@PRODag" :: "['i set, 'i => ('a, 'more) aGroup_scheme] => 
               ('i => 'a ) set"  ("(aΠ_ _)" [72,73]72)

translations
   "aΠI A" == "prodag I A"

lemma prodag_comp_i:"[|a ∈ carr_prodag I A; i ∈ I|] ==> (a i) ∈ carrier (A i)"
by (simp add:carr_prodag_def)

lemma prod_pOp_func:"∀k∈I. aGroup (A k) ==>
    prod_pOp I A ∈ carr_prodag I A -> carr_prodag I A -> carr_prodag I A"
apply (rule bivar_func_test)
apply (rule ballI)+
 apply (subst carr_prodag_def) apply (simp add:CollectI)
apply (rule conjI)
 apply (simp add:prod_pOp_def restrict_def extensional_def)
apply (rule conjI)
 apply (rule univar_func_test)
 apply (rule ballI)
 apply (simp add:prod_pOp_def)
 apply (subst Un_carrier_def) apply (simp add:CollectI)
 apply (frule_tac b = x in forball_spec1, assumption,
        thin_tac "∀k∈I. aGroup (A k)")
 apply (simp add:carr_prodag_def) apply (erule conjE)+ 
 apply (thin_tac "a ∈ I -> Un_carrier I A") 
 apply (thin_tac "b ∈ I -> Un_carrier I A")
 apply (frule_tac b = x in forball_spec1, assumption,
        thin_tac "∀i∈I. a i ∈ carrier (A i)",
        frule_tac b = x in forball_spec1, assumption,
        thin_tac "∀i∈I. b i ∈ carrier (A i)")
 apply (frule_tac x = "a x" and y = "b x" in aGroup.ag_pOp_closed, assumption+)
 apply blast
apply (rule ballI)
 apply (simp add:prod_pOp_def)
 apply (rule_tac A = "A i" and x = "a i" and y = "b i" in aGroup.ag_pOp_closed)
 apply simp 
 apply (simp add:carr_prodag_def)+
done
 
lemma prod_pOp_mem:"[|∀k∈I. aGroup (A k); X ∈ carr_prodag I A;
 Y ∈ carr_prodag I A|] ==> prod_pOp I A X Y ∈ carr_prodag I A"
apply (frule prod_pOp_func)
apply (frule funcset_mem[of "prod_pOp I A" 
                        "carr_prodag I A" "carr_prodag I A -> carr_prodag I A"
                         "X"], assumption+)
apply (rule funcset_mem[of "prod_pOp I A X" "carr_prodag I A" 
                           "carr_prodag I A" "Y"], assumption+)
done

lemma prod_pOp_mem_i:"[|∀k∈I. aGroup (A k); X ∈ carr_prodag I A;
 Y ∈ carr_prodag I A; i ∈ I|] ==> prod_pOp I A X Y i = (X i) ±(A i) (Y i)"
apply (simp add:prod_pOp_def)
done

lemma prod_mOp_func:"∀k∈I. aGroup (A k) ==>
                  prod_mOp I A ∈ carr_prodag I A -> carr_prodag I A"
apply (rule univar_func_test)
apply (rule ballI)
 apply (simp add:prod_mOp_def carr_prodag_def)
 apply (erule conjE)+
apply (rule conjI)
 apply (rule univar_func_test)
 apply (rule ballI) apply simp
 apply (rename_tac f j)
 apply (frule_tac f = f and x = j in funcset_mem [of _ "I" "Un_carrier I A"],
                             assumption+)
 apply (thin_tac "f ∈ I -> Un_carrier I A")
 apply (frule_tac b = j in forball_spec1, assumption,
        thin_tac "∀k∈I. aGroup (A k)",
        frule_tac b = j in forball_spec1, assumption,
        thin_tac "∀i∈I. f i ∈ carrier (A i)")
 apply (thin_tac "f j ∈ Un_carrier I A")
 apply (simp add:Un_carrier_def)
 apply (frule aGroup.ag_mOp_closed, assumption+) 
 apply blast
apply (rule ballI) 
 apply (rule_tac A = "A i" and x = "x i" in aGroup.ag_mOp_closed)
 apply simp+
done

lemma prod_mOp_mem:"[|∀j∈I. aGroup (A j); X ∈ carr_prodag I A|] ==>
                         prod_mOp I A X ∈ carr_prodag I A"
apply (frule prod_mOp_func)
apply (simp add:funcset_mem)
done

lemma prod_mOp_mem_i:"[|∀j∈I. aGroup (A j); X ∈ carr_prodag I A; i ∈ I|] ==>
                         prod_mOp I A X i = -a(A i) (X i)"
apply (simp add:prod_mOp_def)
done

lemma prod_zero_func:"∀k∈I. aGroup (A k) ==>
                           prod_zero I A ∈ carr_prodag I A"
apply (simp add:prod_zero_def prodag_def)
apply (simp add:carr_prodag_def)
apply (rule conjI)
 apply (rule univar_func_test)
 apply (rule ballI) apply simp
 apply (subgoal_tac "aGroup (A x)") prefer 2 apply simp
 apply (thin_tac "∀k∈I. aGroup (A k)")
 apply (simp add:Un_carrier_def)
 apply (frule aGroup.ex_zero)
 apply auto
apply (frule_tac b = i in forball_spec1, assumption,
       thin_tac "∀k∈I. aGroup (A k)")
 apply (simp add:aGroup.ex_zero)
done

lemma prod_zero_i:"[|∀k∈I. aGroup (A k); i ∈ I|] ==>
                           prod_zero I A i = \<zero>(A i) "
by (simp add:prod_zero_def)

lemma carr_prodag_mem_eq:"[|∀k∈I. aGroup (A k); X ∈ carr_prodag I A;
Y ∈ carr_prodag I A; ∀l∈I. (X l) = (Y l) |] ==> X = Y" 
apply (simp add:carr_prodag_def)
apply (erule conjE)+
apply (simp add:funcset_eq)
done

lemma prod_pOp_assoc:"[|∀k∈I. aGroup (A k); a ∈ carr_prodag I A; 
      b ∈ carr_prodag I A; c ∈ carr_prodag I A|] ==>
      prod_pOp I A (prod_pOp I A a b) c =
                               prod_pOp I A a (prod_pOp I A b c)"
 apply (frule_tac X = a and Y = b in prod_pOp_mem[of "I" "A"], assumption+,
        frule_tac X = b and Y = c in prod_pOp_mem[of "I" "A"], assumption+,
        frule_tac X = "prod_pOp I A a b" and Y = c in prod_pOp_mem[of "I"
            "A"], assumption+,
        frule_tac X = a and Y = "prod_pOp I A b c" in prod_pOp_mem[of "I"
            "A"], assumption+)
 apply (rule carr_prodag_mem_eq[of "I" "A"], assumption+,
       rule ballI)
 apply (simp add:prod_pOp_mem_i)
 apply (frule_tac b = l in forball_spec1, assumption,
        thin_tac "∀k∈I. aGroup (A k)")
 apply (rule aGroup.ag_pOp_assoc, assumption)
 apply (simp add:prodag_comp_i)+
done

lemma prod_pOp_commute:"[|∀k∈I. aGroup (A k); a ∈ carr_prodag I A; 
                           b ∈ carr_prodag I A|] ==>
                           prod_pOp I A a b = prod_pOp I A b a" 
apply (frule_tac X = a and Y = b in prod_pOp_mem[of "I" "A"], assumption+,
         frule_tac X = b and Y = a in prod_pOp_mem[of "I" "A"], assumption+)
apply (rule carr_prodag_mem_eq[of "I" "A"], assumption+,
        rule ballI)
 apply (simp add:prod_pOp_mem_i)
 apply (frule_tac b = l in forball_spec1, assumption,
        thin_tac "∀k∈I. aGroup (A k)",
        rule aGroup.ag_pOp_commute, assumption)
 apply (simp add:prodag_comp_i)+
done

lemma prodag_aGroup:"∀k∈I. aGroup (A k) ==> aGroup (prodag I A)" 
apply (simp add:aGroup_def [of "(prodag I A)"])
apply (simp add:prodag_def)
 apply (simp add:prod_pOp_func)
 apply (simp add:prod_mOp_func)
 apply (simp add:prod_zero_func)
apply (rule conjI)
 apply (rule allI, rule impI)+
 apply (simp add:prod_pOp_assoc)
apply (rule conjI)
  apply (rule allI, rule impI)+  
  apply (simp add:prod_pOp_commute)
apply (rule conjI)
 apply (rule allI, rule impI)
 apply (frule_tac X = a in prod_mOp_mem [of "I" "A"], assumption+) 
 apply (frule_tac X = "prod_mOp I A a" and Y = a in prod_pOp_mem[of "I" "A"],
        assumption+)
 apply (rule carr_prodag_mem_eq[of "I" "A"], assumption+)
 apply (simp add:prod_zero_func)
 apply (rule ballI)
 apply (simp add:prod_pOp_mem_i,
         simp add:prod_zero_i) apply (
         simp add:prod_mOp_mem_i)
  apply (frule_tac b = l in forball_spec1, assumption,
         thin_tac "∀k∈I. aGroup (A k)",
         rule aGroup.l_m, assumption+, simp add:prodag_comp_i)
apply (rule allI, rule impI)
  apply (frule_tac prod_zero_func[of "I" "A"], 
         frule_tac Y = a in prod_pOp_mem[of "I" "A" "prod_zero I A"],
          assumption+)
  apply (rule carr_prodag_mem_eq[of "I" "A"], assumption+)
  apply (rule ballI)
  apply (subst prod_pOp_mem_i[of "I" "A"], assumption+,
         subst prod_zero_i[of "I" "A"], assumption+)
  apply (frule_tac b = l in forball_spec1, assumption, 
         rule aGroup.l_zero, assumption+,
         simp add:prodag_comp_i)
done

lemma prodag_carrier:"∀k∈I. aGroup (A k) ==>
            carrier (prodag I A) = carr_prodag I A"
by (simp add:prodag_def)

lemma prodag_elemfun:"[|∀k∈I. aGroup (A k); f ∈ carrier (prodag I A)|] ==>
         f ∈ extensional I"
apply (simp add:prodag_carrier)
apply (simp add:carr_prodag_def)
done

lemma prodag_component:"[|f ∈ carrier (prodag I A); i ∈ I |] ==>
                              f i ∈ carrier (A i)"
by (simp add:prodag_def carr_prodag_def)

lemma prodag_pOp:"∀k∈I. aGroup (A k) ==> 
                  pop (prodag I A) = prod_pOp I A"
apply (simp add:prodag_def)
done

lemma prodag_iOp:"∀k∈I. aGroup (A k) ==> 
                  mop (prodag I A) = prod_mOp I A"
apply (simp add:prodag_def)
done 

lemma prodag_zero:"∀k∈I. aGroup (A k) ==> 
                  zero (prodag I A) = prod_zero I A"
apply (simp add:prodag_def)
done

lemma prodag_sameTr0:"[|∀k∈I. aGroup (A k); ∀k∈I. A k = B k|]
                               ==> Un_carrier I A = Un_carrier I B"
apply (simp add:Un_carrier_def)
done

lemma prodag_sameTr1:"[|∀k∈I. aGroup (A k); ∀k∈I. A k = B k|]
                               ==> carr_prodag I A = carr_prodag I B"
apply (rule equalityI)
 apply (rule subsetI)
 apply (simp add:carr_prodag_def, (erule conjE)+)
 apply (rule univar_func_test, rule ballI)
 apply (subst Un_carrier_def, simp, blast)

apply (rule subsetI)
 apply (simp add:carr_prodag_def, (erule conjE)+)
 apply (rule univar_func_test, rule ballI)
 apply (subst Un_carrier_def, simp)
 apply blast
done

lemma prodag_sameTr2:"[|∀k∈I. aGroup (A k); ∀k∈I. A k = B k|]
                               ==> prod_pOp I A = prod_pOp I B"
apply (frule prodag_sameTr1 [of "I" "A" "B"], assumption+)
apply (simp add:prod_pOp_def)
apply (rule bivar_func_eq)
apply (rule ballI)+
apply (rule funcset_eq [of _ "I"])
 apply (simp add:restrict_def extensional_def)+
done

lemma prodag_sameTr3:"[|∀k∈I. aGroup (A k); ∀k∈I. A k = B k|]
                               ==> prod_mOp I A = prod_mOp I B"
apply (frule prodag_sameTr1 [of "I" "A" "B"], assumption+)
apply (simp add:prod_mOp_def)
apply (rule funcset_eq [of _ "carr_prodag I B"])
 apply (simp add:restrict_def extensional_def)
 apply (simp add:restrict_def extensional_def)
apply (rule ballI)
apply (rename_tac g) apply simp
apply (rule funcset_eq [of _ "I"])
 apply (simp add:restrict_def extensional_def)+
done

lemma prodag_sameTr4:"[|∀k∈I. aGroup (A k); ∀k∈I. A k = B k|]
                               ==> prod_zero I A = prod_zero I B"
apply (simp add:prod_zero_def)
apply (rule funcset_eq [of _ "I"])
 apply (simp add:restrict_def extensional_def)+
done

lemma prodag_same:"[|∀k∈I. aGroup (A k); ∀k∈I. A k = B k|]
                               ==> prodag I A = prodag I B"
apply (frule prodag_sameTr1, assumption+) 
apply (frule prodag_sameTr2, assumption+) 
apply (frule prodag_sameTr3, assumption+)
apply (frule prodag_sameTr4, assumption+)
apply (simp add:prodag_def)
done
      
lemma project_mem:"[|∀k∈I. aGroup (A k); j ∈ I; x ∈ carrier (prodag I A)|] ==>
                         (PRoject I A j) x  ∈ carrier (A j)"
apply (simp add:PRoject_def)
apply (simp add:prodag_def)
apply (simp add:carr_prodag_def)
done

lemma project_aHom:"[|∀k∈I. aGroup (A k); j ∈ I|] ==>
                         PRoject I A j ∈ aHom (prodag I A) (A j)"
apply (simp add:aHom_def)
apply (rule conjI)
apply (rule univar_func_test)
 apply (rule ballI)
 apply (simp add:project_mem)
apply (rule conjI)
 apply (simp add:PRoject_def restrict_def extensional_def)
 apply (rule allI, rule impI, simp add:prodag_def)
apply (rule ballI)+
 apply (simp add:prodag_def)
 apply (simp add:prod_pOp_def)
 apply (frule_tac X = a and Y = b in prod_pOp_mem[of I A], assumption+)
 apply (simp add:prod_pOp_def)
 apply (simp add:PRoject_def)
done

lemma project_aHom1:"∀k∈I. aGroup (A k) ==>
                      ∀j ∈ I. PRoject I A j ∈ aHom (prodag I A) (A j)"
apply (rule ballI)
apply (rule project_aHom, assumption+)
done
 
constdefs
 A_to_prodag :: "[('a, 'm) aGroup_scheme, 'i set, 'i =>('a => 'b), 
 'i  => ('b, 'm1) aGroup_scheme] => ('a => ('i =>'b))"
 "A_to_prodag A I S B == λa∈carrier A. λk∈I. S k a" 

 (* I is an index set, A is an abelian group, S: I -> carrier A -> 
  carrier (prodag I B),   s i ∈ carrier A -> B i  *)  

lemma A_to_prodag_mem:"[|aGroup A; ∀k∈I. aGroup (B k);  ∀k∈I. (S k) ∈ 
 aHom 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 restrict_def)
apply (simp add:Pi_def restrict_def A_to_prodag_def)
apply (rule conjI)  
apply (rule allI) apply (rule impI)
apply (simp add:Un_carrier_def) 
 apply (rotate_tac 2,
        frule_tac b = xa in forball_spec1, assumption,
        thin_tac "∀k∈I. S k ∈ aHom A (B k)")
 apply (simp add:aHom_def) apply (erule conjE)+ 
 apply (frule_tac f = "S xa" and A = "carrier A" and B = "carrier (B xa)"
           and x = x in funcset_mem, assumption+)
 apply blast
apply (rule ballI)
 apply (rotate_tac 2,
        frule_tac b = i in forball_spec1, assumption,
        thin_tac "∀k∈I. S k ∈ aHom A (B k)")
 apply (simp add:aHom_def) apply (erule conjE)+
 apply (simp add:funcset_mem)
done
 
lemma A_to_prodag_aHom:"[|aGroup A; ∀k∈I. aGroup (B k); ∀k∈I. (S k) ∈ 
 aHom A (B k) |]  ==> A_to_prodag A I S B ∈ aHom A (aΠI B)"
apply (simp add:aHom_def [of "A" "aΠI B"])
apply (rule conjI)
 apply (rule univar_func_test)
 apply (rule ballI) apply (simp add:prodag_def)
 apply (simp add: A_to_prodag_mem)

apply (rule conjI)
apply (simp add:A_to_prodag_def restrict_def extensional_def)
apply (rule ballI)+
 apply (frule_tac x = a and y = b in aGroup.ag_pOp_closed, assumption+)
 apply (frule_tac x = "a ±A b" in A_to_prodag_mem [of "A" "I" "B" "S"],
                                                       assumption+)
 apply (frule_tac x = a in A_to_prodag_mem [of "A" "I" "B" "S"],
                                                       assumption+)
 apply (frule_tac x = b in A_to_prodag_mem [of "A" "I" "B" "S"],
                                                       assumption+)
 apply (frule prodag_aGroup [of "I" "B"])
 apply (frule_tac x = a in A_to_prodag_mem[of "A" "I" "B" "S"], assumption+,
        frule_tac x = b in A_to_prodag_mem[of "A" "I" "B" "S"], assumption+,
        frule_tac x = "a ±A b" in A_to_prodag_mem[of "A" "I" "B" "S"], 
                                                 assumption+)
 apply (frule prodag_aGroup[of "I" "B"],
        frule_tac x = "A_to_prodag A I S B a" and 
 y = "A_to_prodag A I S B b" in aGroup.ag_pOp_closed [of "aΠI B"])
 apply (simp add:prodag_carrier)
 apply (simp add:prodag_carrier)
 apply (rule carr_prodag_mem_eq, assumption+)
 apply (simp add:prodag_carrier)
 apply (rule ballI)
 apply (simp add:A_to_prodag_def prod_pOp_def)
 apply (rotate_tac 2,
        frule_tac b = l in forball_spec1, assumption,
        thin_tac "∀k∈I. S k ∈ aHom A (B k)")
 apply (simp add:prodag_def prod_pOp_def)
 apply (frule_tac b = l in forball_spec1, assumption,
        thin_tac "∀k∈I. aGroup (B k)")
apply (simp add: aHom_add)
done

constdefs
 finiteHom::"['i set, 'i => ('a, 'more) aGroup_scheme, 'i => 'a] => bool"
  "finiteHom I A f == f ∈ carr_prodag I A ∧ (∃H. H ⊆ I ∧ finite H ∧ (
    ∀j ∈ (I - H). (f j) = \<zero>(A j)))"

constdefs
 carr_dsumag::"['i set, 'i => ('a, 'more) aGroup_scheme] => 
               ('i  => 'a ) set"  
 "carr_dsumag I A == {f. finiteHom I A f}"

 dsumag::"['i set, 'i => ('a, 'more) aGroup_scheme] => ('i => 'a) aGroup" 
  "dsumag I A == (| carrier = carr_dsumag I A, 
   pop = prod_pOp I A, mop = prod_mOp I A,
   zero = prod_zero I A|)),"  


 dProj::"['i set, 'i => ('a, 'more) aGroup_scheme, 'i]
                   => ('i => 'a) => 'a"
  "dProj I A x == λf∈carr_dsumag I A. f x"

syntax 
  "@DSUMag" :: "['i set, 'i => ('a, 'more) aGroup_scheme] => 
               ('i => 'a ) set"  ("(a\<Oplus>_ _)" [72,73]72)
translations
  "a\<Oplus>I A" == "dsumag I A"

lemma dsum_pOp_func:"∀k∈I. aGroup (A k) ==>
    prod_pOp I A ∈ carr_dsumag I A -> carr_dsumag I A -> carr_dsumag I A"
apply (rule bivar_func_test)
apply (rule ballI)+
 apply (subst carr_dsumag_def) apply (simp add:CollectI)
apply (simp add:finiteHom_def)
 apply (rule conjI)
 apply (simp add:carr_dsumag_def) apply (simp add:finiteHom_def)
 apply (erule conjE)+ apply (simp add:prod_pOp_mem)
apply (simp add:carr_dsumag_def finiteHom_def) apply (erule conjE)+
 apply ((erule exE)+, (erule conjE)+)
 apply (frule_tac F = H and G = Ha in finite_UnI, assumption+)
 apply (subgoal_tac "∀j∈I - (H ∪ Ha). prod_pOp I A a b j = \<zero>A j")
 apply (frule_tac A = H and B = Ha in Un_least[of _ "I"], assumption+)
  apply blast

 apply (rule ballI) 
 apply (simp, (erule conjE)+)
 apply (frule_tac b = j in forball_spec1, assumption,
         thin_tac "∀k∈I. aGroup (A k)",
        frule_tac b = j in forball_spec1, simp,
         thin_tac "∀j∈I - H. a j = \<zero>A j",
        frule_tac b = j in forball_spec1, simp,
         thin_tac "∀j∈I - Ha. b j = \<zero>A j")
 apply (simp add:prod_pOp_def)
 apply (rule aGroup.ag_l_zero) apply simp
 apply (rule aGroup.ex_zero) apply assumption
done

lemma dsum_pOp_mem:"[|∀k∈I. aGroup (A k); X ∈ carr_dsumag I A;
 Y ∈ carr_dsumag I A|] ==> prod_pOp I A X Y ∈ carr_dsumag I A"
apply (frule dsum_pOp_func[of "I" "A"])
apply (frule funcset_mem[of "prod_pOp I A" "carr_dsumag I A" 
              "carr_dsumag I A -> carr_dsumag I A" "X"], assumption+)
apply (rule funcset_mem[of "prod_pOp I A X" "carr_dsumag I A" 
            "carr_dsumag I A" "Y"], assumption+)
done

lemma dsum_iOp_func:"∀k∈I. aGroup (A k) ==>
                  prod_mOp I A ∈ carr_dsumag I A -> carr_dsumag I A"
apply (rule univar_func_test)
apply (rule ballI)
 apply (simp add:carr_dsumag_def) apply (simp add:finiteHom_def)
 apply (erule conjE)+ apply (simp add:prod_mOp_mem)
 apply (erule exE, (erule conjE)+)
 apply (simp add:prod_mOp_def)
 apply (subgoal_tac "∀j∈I - H. -aA j (x j) = \<zero>A j")
 apply blast

apply (rule ballI)
 apply (frule_tac b = j in forball_spec1, simp,
        thin_tac "∀k∈I. aGroup (A k)",
        frule_tac b = j in forball_spec1, simp,
        thin_tac "∀j∈I - H. x j = \<zero>A j", simp add:aGroup.ag_inv_zero)
done

lemma dsum_iOp_mem:"[|∀j∈I. aGroup (A j); X ∈ carr_dsumag I A|] ==>
                         prod_mOp I A X ∈ carr_dsumag I A"
apply (frule dsum_iOp_func)
apply (simp add:funcset_mem)
done

lemma dsum_zero_func:"∀k∈I. aGroup (A k) ==>
                           prod_zero I A ∈ carr_dsumag I A"
apply (simp add:carr_dsumag_def) apply (simp add:finiteHom_def)
apply (rule conjI) apply (simp add:prod_zero_func)
 apply (subgoal_tac "{} ⊆ I") prefer 2 apply simp
 apply (subgoal_tac "finite {}") prefer 2 apply simp
 apply (subgoal_tac "∀j∈I - {}. prod_zero I A j = \<zero>A j")
 apply blast
 apply (rule ballI) apply simp
 apply (simp add:prod_zero_def)
done

lemma dsumag_sub_prodag:"∀k∈I. aGroup (A k) ==>
                              carr_dsumag I A ⊆ carr_prodag I A"
by (rule subsetI,
       simp add:carr_dsumag_def finiteHom_def)

lemma carrier_dsumag:"∀k∈I. aGroup (A k) ==> 
         carrier (dsumag I A) = carr_dsumag I A"
apply (simp add:dsumag_def)
done

lemma dsumag_elemfun:"[|∀k∈I. aGroup (A k); f ∈ carrier (dsumag I A)|] ==>
         f ∈ extensional I"
apply (simp add:carrier_dsumag)
apply (simp add:carr_dsumag_def) apply (simp add:finiteHom_def)
apply (erule conjE) apply (simp add:carr_prodag_def)
done

lemma dsumag_aGroup:"∀k∈I. aGroup (A k) ==> aGroup (dsumag I A)"
apply (simp add:aGroup_def [of "dsumag I A"])
apply (simp add:dsumag_def)  
apply (simp add:dsum_pOp_func)  
apply (simp add:dsum_iOp_func)
apply (simp add:dsum_zero_func)
apply (frule dsumag_sub_prodag[of "I" "A"])

apply (rule conjI)
 apply (rule allI, rule impI)+
 apply (frule_tac X = a and Y = b in dsum_pOp_mem, assumption+)
 apply (frule_tac X = b and Y = c in dsum_pOp_mem, assumption+)
 apply (frule_tac X = "prod_pOp I A a b" and Y = c in dsum_pOp_mem, 
                    assumption+) 
 apply (frule_tac Y = "prod_pOp I A b c" and X = a in dsum_pOp_mem, 
                    assumption+) 
 apply (rule carr_prodag_mem_eq [of "I" "A"], assumption+)
 apply (simp add:subsetD) apply (simp add:subsetD)
 apply (rule ballI)
 apply (subst prod_pOp_mem_i, assumption+, (simp add:subsetD)+)
 apply (subst prod_pOp_mem_i, assumption+)
  apply (simp add:subsetD)+
 apply (subst prod_pOp_mem_i, assumption+, (simp add:subsetD)+)
 apply (subst prod_pOp_mem_i, assumption+) apply (simp add:subsetD)+
 apply (thin_tac "prod_pOp I A a b ∈ carr_dsumag I A",
        thin_tac "prod_pOp I A b c ∈ carr_dsumag I A",
        thin_tac "prod_pOp I A (prod_pOp I A a b) c ∈ carr_dsumag I A",
        thin_tac "prod_pOp I A a (prod_pOp I A b c) ∈ carr_dsumag I A",
        thin_tac "carr_dsumag I A ⊆ carr_prodag I A")

 apply (frule_tac b = l in forball_spec1, assumption,
        thin_tac "∀k∈I. aGroup (A k)",
        simp add:carr_dsumag_def finiteHom_def, (erule conjE)+,
        simp add:carr_prodag_def, (erule conjE)+)
 apply (frule_tac b = l in forball_spec1, assumption,
        thin_tac "∀i∈I. a i ∈ carrier (A i)",
        frule_tac b = l in forball_spec1, assumption,
        thin_tac "∀i∈I. b i ∈ carrier (A i)",
        frule_tac b = l in forball_spec1, assumption,
        thin_tac "∀i∈I. c i ∈ carrier (A i)")
 apply (simp add:aGroup.aassoc)

apply (rule conjI)
 apply (rule allI, rule impI)+
 apply (rule carr_prodag_mem_eq [of "I" "A"], assumption+)
  apply (frule_tac X = a and Y = b in prod_pOp_mem[of "I" "A"],
         (simp add:subsetD)+) 
  apply (frule_tac X = b and Y = a in prod_pOp_mem[of "I" "A"],
         (simp add:subsetD)+)
  apply (rule ballI,
         subst prod_pOp_mem_i, assumption+, (simp add:subsetD)+)
  apply (subst prod_pOp_mem_i, assumption+, (simp add:subsetD)+)
  apply (frule_tac b = l in forball_spec1, assumption,
         thin_tac "∀k∈I. aGroup (A k)")
  apply (frule_tac c = a in subsetD[of "carr_dsumag I A" "carr_prodag I A"],
          assumption+, thin_tac "a ∈ carr_dsumag I A",
         frule_tac c = b in subsetD[of "carr_dsumag I A" "carr_prodag I A"],
          assumption+, thin_tac "b ∈ carr_dsumag I A",
          thin_tac "carr_dsumag I A ⊆ carr_prodag I A") 
  apply (simp add:carr_prodag_def, (erule conjE)+, 
         simp add:aGroup.ag_pOp_commute)

apply (rule conjI)
 apply (rule allI, rule impI)
 apply (frule_tac X = a in prod_mOp_mem[of "I" "A"],
        simp add:subsetD) 
 apply (frule_tac X = "prod_mOp I A a" and Y = a in prod_pOp_mem[of "I" "A"],
        simp add:subsetD, simp add:subsetD)
 apply (rule carr_prodag_mem_eq [of "I" "A"], assumption+,
        simp add:prod_zero_func)
 apply (rule ballI)
 apply (subst prod_pOp_mem_i, assumption+,
        simp add:subsetD, assumption)
 apply (subst prod_mOp_mem_i, assumption+, simp add:subsetD, assumption)
 apply (simp add:prod_zero_i)
 apply (frule_tac b = l in forball_spec1, assumption,
         thin_tac "∀k∈I. aGroup (A k)",
         thin_tac "prod_mOp I A a ∈ carr_prodag I A",
         thin_tac "prod_pOp I A (prod_mOp I A a) a ∈ carr_prodag I A",
        frule_tac c = a in subsetD[of "carr_dsumag I A" "carr_prodag I A"], 
         assumption,
        thin_tac "carr_dsumag I A ⊆ carr_prodag I A",
        simp add:carr_prodag_def, (erule conjE)+)
  apply (frule_tac b = l in forball_spec1, assumption,
         thin_tac "∀i∈I. a i ∈ carrier (A i)")
  apply (rule aGroup.l_m, assumption+)

apply (rule allI, rule impI)
 apply (frule prod_zero_func[of "I" "A"])
 apply (frule_tac X = "prod_zero I A" and Y = a in prod_pOp_mem[of "I" "A"], 
            assumption+, simp add:subsetD)
 apply (rule carr_prodag_mem_eq [of "I" "A"], assumption+,
        simp add:subsetD)
 apply (rule ballI)
 apply (subst prod_pOp_mem_i, assumption+)
        apply (simp add:subsetD, assumption)
 apply (simp add:prod_zero_i,
        frule_tac b = l in forball_spec1, assumption,
        thin_tac "∀k∈I. aGroup (A k)",
        frule_tac c = a in subsetD[of "carr_dsumag I A" "carr_prodag I A"],
                  assumption+,
        thin_tac "carr_dsumag I A ⊆ carr_prodag I A",
        thin_tac "a ∈ carr_dsumag I A",
        thin_tac "prod_pOp I A (prod_zero I A) a ∈ carr_prodag I A")
 apply (simp add:carr_prodag_def, (erule conjE)+)
 apply (rule aGroup.l_zero, assumption)
 apply blast
done
       
lemma dsumag_pOp:"∀k∈I. aGroup (A k) ==> 
                  pop (dsumag I A) = prod_pOp I A"
apply (simp add:dsumag_def)
done

lemma dsumag_mOp:"∀k∈I. aGroup (A k) ==> 
                  mop (dsumag I A) = prod_mOp I A"
apply (simp add:dsumag_def) 
done 

lemma dsumag_zero:"∀k∈I. aGroup (A k) ==> 
                  zero (dsumag I A) = prod_zero I A"
apply (simp add:dsumag_def)
done


subsection "characterization of a direct product"

lemma direct_prod_mem_eq:"[|∀j∈I. aGroup (A j); f ∈ carrier (aΠI A);
       g ∈ carrier (aΠI A); ∀j∈I. (PRoject I A j) f = (PRoject I A j) g|] ==>
       f = g"
apply (rule funcset_eq[of "f" "I" "g"])
 apply (thin_tac "∀j∈I. aGroup (A j)", 
        thin_tac "g ∈ carrier (aΠI A)",
        thin_tac "∀j∈I. (πI,A,j) f = (πI,A,j) g",
        simp add:prodag_def carr_prodag_def)
  apply (thin_tac "∀j∈I. aGroup (A j)", 
        thin_tac "f ∈ carrier (aΠI A)",
        thin_tac "∀j∈I. (πI,A,j) f = (πI,A,j) g",
        simp add:prodag_def carr_prodag_def)
 apply (simp add:PRoject_def prodag_def)
done

lemma map_family_fun:"[|∀j∈I. aGroup (A j); aGroup S; 
      ∀j∈I. ((g j) ∈ aHom S (A j)); x ∈ carrier S|] ==> 
         (λy ∈ carrier S. (λj∈I. (g j) y)) x ∈ carrier (aΠI A)" 
apply (simp add:prodag_def carr_prodag_def)
 apply (simp add:aHom_mem)
 apply (rule univar_func_test, rule ballI, simp add:Un_carrier_def)
 apply (frule_tac b = xa in forball_spec1, assumption,
        thin_tac "∀j∈I. aGroup (A j)",
        frule_tac b = xa in forball_spec1, assumption,
        thin_tac "∀j∈I. g j ∈ aHom S (A j)")
 apply (frule_tac G = "A xa" and f = "g xa" and a = x in aHom_mem[of "S"],
        assumption+, blast)
done

lemma map_family_aHom:"[|∀j∈I. aGroup (A j); aGroup S; 
      ∀j∈I. ((g j) ∈ aHom S (A j))|] ==> 
         (λy ∈ carrier S. (λj∈I. (g j) y)) ∈ aHom S (aΠI A)"
apply (subst aHom_def, simp) 
 apply (simp add:aGroup.ag_pOp_closed)

apply (rule conjI)
 apply (rule univar_func_test, rule ballI)
 apply (rule map_family_fun[of "I" "A" "S" "g"], assumption+)
apply (rule ballI)+
 apply (frule_tac x = a and y = b in aGroup.ag_pOp_closed[of "S"],
                   assumption+)
 apply (frule_tac x = "a ±S b" in map_family_fun[of "I" "A" "S" "g"],
          assumption+, simp)
 apply (frule_tac x = a in map_family_fun[of "I" "A" "S" "g"],
          assumption+, simp,
         frule_tac x = b in map_family_fun[of "I" "A" "S" "g"],
          assumption+, simp)
 apply (frule prodag_aGroup[of "I" "A"])
 apply (frule_tac x = "(λj∈I. g j a)" and y = "(λj∈I. g j b)" in 
        aGroup.ag_pOp_closed[of "aΠI A"], assumption+)
 apply (simp only:prodag_carrier)

apply (rule carr_prodag_mem_eq, assumption+)
 apply (rule ballI)
 apply (subst prodag_def, simp add:prod_pOp_def)
 apply (simp add:aHom_add)
done

lemma map_family_triangle:"[|∀j∈I. aGroup (A j); aGroup S;
         ∀j∈I. ((g j) ∈ aHom S (A j))|] ==> ∃!f. f ∈ aHom S (aΠI A) ∧ 
                  (∀j∈I. compos S (PRoject I A j) f =  (g j))"
apply (rule ex_ex1I)
apply (frule map_family_aHom[of "I" "A" "S" "g"], assumption+) 
apply (subgoal_tac "∀j∈I. compos S (πI,A,j) (λy∈carrier S. λj∈I. g j y) = g j")
apply blast
apply (rule ballI)
apply (simp add:compos_def)
apply (rule funcset_eq[of _ "carrier S"])
 apply (simp add:compose_def) apply (simp add:aHom_def)
 apply (rule ballI)
 apply (frule prodag_aGroup[of "I" "A"])
 apply (frule prodag_carrier[of "I" "A"])
 apply (frule_tac f = "λy∈carrier S. λj∈I. g j y" and a = x in 
        aHom_mem[of "S" "aΠI A"], assumption+)
 apply (simp add:compose_def, simp add:PRoject_def)
apply (rename_tac f f1)
 apply (erule conjE)+
 apply (rule funcset_eq[of _ "carrier S"])
 apply (simp add:aHom_def, simp add:aHom_def) 
 apply (rule ballI)
 apply (frule prodag_aGroup[of "I" "A"])
 apply (frule_tac f = f and a = x in aHom_mem[of "S" "aΠI A"], assumption+,
        frule_tac f = f1 and a = x in aHom_mem[of "S" "aΠI A"], assumption+)
 apply (rule_tac f = "f x" and g = "f1 x" in direct_prod_mem_eq[of "I" "A"],
        assumption+)
 apply (rule ballI)
 apply (rotate_tac 4,
        frule_tac b = j in forball_spec1, assumption,
        thin_tac "∀j∈I. compos S (πI,A,j) f = g j",
         frule_tac b = j in forball_spec1, assumption,
        thin_tac "∀j∈I. compos S (πI,A,j) f1 = g j",
        simp add:compos_def compose_def) 
 apply (subgoal_tac "(λx∈carrier S. (πI,A,j) (f x)) x = g j x",
        subgoal_tac "(λx∈carrier S. (πI,A,j) (f1 x)) x = g j x", 
        thin_tac "(λx∈carrier S. (πI,A,j) (f x)) = g j",
        thin_tac "(λx∈carrier S. (πI,A,j) (f1 x)) = g j", 
simp+)
done

lemma Ag_ind_triangle:"[|∀j∈I. aGroup (A j); j ∈ I; f ∈ carrier (aΠI A) -> B; 
      bij_to f (carrier (aΠI A)) (B::'d set); j ∈ I|] ==> 
compos (aΠI A) (compos (Ag_ind (aΠI A) f)(PRoject I A j) (ainvf(aΠI A),
 (Ag_ind (aΠI A) f) (Agii (aΠI A) f))) (Agii (aΠI A) f) = 
                                       PRoject I A j"
apply (frule prodag_aGroup[of "I" "A"])
apply (frule aGroup.Ag_ind_aGroup[of "aΠI A" "f" "B"], assumption+)
apply (simp add:compos_def)
apply (rule funcset_eq[of _ "carrier (aΠI A)"])
apply simp
apply (simp add:PRoject_def  prodag_carrier extensional_def)
apply (rule ballI)
apply (simp add:compose_def invfun_l)
apply (simp add:aGroup.Agii_mem)
apply (frule Ag_ind_bijec[of "aΠI A" "f" "B"], assumption+)
apply (frule_tac x = x in ainvf_l[of "aΠI A" "Ag_ind (aΠI A) f"
                                     "Agii (aΠI A) f"], assumption+)
apply simp
done

(** Note               f'
                 aΠI A -> Ag_ind (aΠI A) f
                     \     |
                      \    |
        PRoject I A j  \   | (PRoject I A j) o (f'¯1)  
                        \  |
                          A j             , where f' = Agii (aΠI A) f **)

constdefs
 ProjInd :: "['i set, 'i => ('a, 'm) aGroup_scheme, ('i => 'a) => 'd, 'i] => 
                       ('d => 'a)"
 "ProjInd I A f j == compos (Ag_ind (aΠI A) f)(PRoject I A j) (ainvf(aΠI A), (Ag_ind (aΠI A) f) (Agii (aΠI A) f))"

(** Note               f'
                 aΠI A -> Ag_ind (aΠI A) f
                     \     |
                      \    |
        PRoject I A j  \   | PRojInd I A f j 
                        \  |
                          A j              **)

lemma ProjInd_aHom:"[|∀j∈ I. aGroup (A j); j ∈ I; f ∈ carrier (aΠI A) -> B; 
      bij_to f (carrier (aΠI A)) (B::'d set); j ∈ I|] ==> 
        (ProjInd I A f j) ∈ aHom (Ag_ind (aΠI A) f) (A j)"
apply (frule prodag_aGroup[of "I" "A"])
apply (frule aGroup.Ag_ind_aGroup[of "aΠI A" "f" "B"], assumption+)
apply (frule_tac b = j in forball_spec1, assumption)
apply (frule aGroup.Ag_ind_aHom[of "aΠI A" "f" "B"], assumption+)
apply (simp add:ProjInd_def)
apply (frule Ag_ind_bijec[of "aΠI A" "f" "B"], assumption+)
apply (frule ainvf_aHom[of "aΠI A" "Ag_ind (aΠI A) f" "Agii (aΠI A) f"],
             assumption+) 
apply (frule project_aHom[of "I" "A" "j"], assumption)
apply (simp add:aHom_compos)
done

lemma ProjInd_aHom1:"[|∀j∈ I. aGroup (A j); f ∈ carrier (aΠI A) -> B; 
      bij_to f (carrier (aΠI A)) (B::'d set)|] ==> 
        ∀j∈I. (ProjInd I A f j) ∈ aHom (Ag_ind (aΠI A) f) (A j)"
apply (rule ballI)
apply (simp add:ProjInd_aHom)
done

lemma ProjInd_mem_eq:"[|∀j∈I. aGroup (A j); f ∈ carrier (aΠI A) -> B;
      bij_to f (carrier (aΠI A)) B; aGroup S; x ∈ carrier (Ag_ind (aΠI A) f);
      y ∈ carrier (Ag_ind (aΠI A) f);
      ∀j∈I. (ProjInd I A f j x = ProjInd I A f j y)|] ==> x = y"
apply (simp add:ProjInd_def)
apply (simp add:compos_def compose_def)
apply (frule prodag_aGroup[of "I" "A"])
apply (frule aGroup.Ag_ind_aGroup[of "aΠI A" "f" "B"], assumption+)
apply (frule aGroup.Ag_ind_aHom[of "aΠI A" "f" "B"], assumption+)
apply (frule Ag_ind_bijec[of "aΠI A" "f" "B"], assumption+)
apply (frule ainvf_aHom[of "aΠI A" "Ag_ind (aΠI A) f" "Agii (aΠI A) f"],
         assumption+) 
apply (frule aHom_mem[of "Ag_ind (aΠI A) f" "aΠI A" "ainvf(aΠI A),Ag_ind (aΠI A) f Agii (aΠI A) f" "x"], assumption+,
       frule aHom_mem[of "Ag_ind (aΠI A) f" "aΠI A" "ainvf(aΠI A),Ag_ind (aΠI A) f Agii (aΠI A) f" "y"], assumption+)

apply (frule direct_prod_mem_eq[of "I" "A" "(ainvf(aΠI A),Ag_ind (aΠI A) f Agii (aΠI A) f) x" "(ainvf(aΠI A),Ag_ind (aΠI A) f Agii (aΠI A) f) y"], assumption+)
apply (thin_tac "ainvf(aΠI A),Ag_ind (aΠI A) f Agii (aΠI A) f
     ∈ aHom (Ag_ind (aΠI A) f) (aΠI A)")
apply (frule ainvf_bijec[of "aΠI A" "Ag_ind (aΠI A) f" "Agii (aΠI A) f"],
                   assumption+)
apply (thin_tac "bijec(aΠI A),Ag_ind (aΠI A) f Agii (aΠI A) f")
apply (unfold bijec_def, frule conjunct1, fold bijec_def)
apply (frule injec_inj_on[of "Ag_ind (aΠI A) f" "aΠI A" "ainvf(aΠI A),Ag_ind (aΠI A) f Agii (aΠI A) f"], assumption+)
apply (simp add:injective_iff[THEN sym, of "ainvf(aΠI A),Ag_ind (aΠI A) f Agii (aΠI A) f" "carrier (Ag_ind (aΠI A) f)" "x" "y"])
done

lemma ProjInd_mem_eq1:"[|∀j∈I. aGroup (A j); f ∈ carrier (aΠI A) -> B;
      bij_to f (carrier (aΠI A)) B; aGroup S; 
      h ∈ aHom (Ag_ind (aΠI A) f) (Ag_ind (aΠI A) f);
      ∀j∈I. compos (Ag_ind (aΠI A) f) (ProjInd I A f j) h = ProjInd I A f j|]       ==> h = ag_idmap (Ag_ind (aΠI A) f)"
apply (rule funcset_eq[of _ "carrier (Ag_ind (aΠI A) f)"])
 apply (simp add:aHom_def)
 apply (simp add:ag_idmap_def)
apply (rule ballI)
 apply (simp add:ag_idmap_def)
 apply (frule prodag_aGroup[of "I" "A"],
        frule aGroup.Ag_ind_aGroup[of "aΠI A" "f" "B"], assumption+)        
 apply (frule_tac a = x in aHom_mem[of "Ag_ind (aΠI A) f" "Ag_ind (aΠI A) f" 
        "h"], assumption+)
 apply (rule_tac x = "h x" and y = x in ProjInd_mem_eq[of "I" "A" "f" "B" "S"],
        assumption+)
 apply (rotate_tac 1,
        rule ballI,
        frule_tac b = j in forball_spec1, assumption,
        thin_tac "∀j∈I. compos (Ag_ind (aΠI A) f) (ProjInd I A f j) h =
               ProjInd I A f j")       
 apply (simp add:compos_def compose_def)
 apply (subgoal_tac "(λx∈carrier (Ag_ind (aΠI A) f). ProjInd I A f j (h x)) x 
                    = ProjInd I A f j x",
        thin_tac "(λx∈carrier (Ag_ind (aΠI A) f). ProjInd I A f j (h x)) =
           ProjInd I A f j")
 apply simp+
done

lemma Ag_ind_triangle1:"[|∀j∈I. aGroup (A j); f ∈ carrier (aΠI A) -> B; 
      bij_to f (carrier (aΠI A)) (B::'d set); j ∈ I|] ==> 
      compos (aΠI A) (ProjInd I A f j) (Agii (aΠI A) f) =  PRoject I A j"
apply (simp add:ProjInd_def)
apply (simp add:Ag_ind_triangle)
done

lemma map_family_triangle1:"[|∀j∈I. aGroup (A j); f ∈ carrier (aΠI A) -> B;
      bij_to f (carrier (aΠI A)) (B::'d set); aGroup S; 
     ∀j∈I. ((g j) ∈ aHom S (A j))|] ==> ∃!h. h ∈ aHom S (Ag_ind (aΠI A) f) ∧ 
                  (∀j∈I. compos S (ProjInd I A f j) h =  (g j))"
apply (frule prodag_aGroup[of "I" "A"])
apply (frule aGroup.Ag_ind_aGroup[of "aΠI A" "f" "B"], assumption+)
apply (frule Ag_ind_bijec[of "aΠI A" "f" "B"], assumption+)  
apply (rule ex_ex1I)
apply (frule map_family_triangle[of "I" "A" "S" "g"], assumption+)
apply (frule ex1_implies_ex)
apply (erule exE)
apply (erule conjE)
apply (unfold bijec_def, frule conjunct2, fold bijec_def)
apply (unfold surjec_def, frule conjunct1, fold surjec_def)
apply (rename_tac fa,
       frule_tac f = fa in aHom_compos[of "S" "aΠI A" "Ag_ind (aΠI A) f" _ 
                 "Agii (aΠI A) f"], assumption+)
apply (subgoal_tac "∀j∈I. compos S (ProjInd I A f j) 
                           (compos S (Agii (aΠI A) f) fa) = g j")
apply blast
apply (rule ballI) 
apply (frule_tac N = "A j" and f = fa and g = "Agii (aΠI A) f" and
 h = "ProjInd I A f j" in aHom_compos_assoc[of "S" "aΠI A" "Ag_ind (aΠI A) f"],
 assumption+) apply simp apply assumption+ 
apply (simp add:ProjInd_aHom)
apply simp
apply (thin_tac "compos S (ProjInd I A f j) (compos S (Agii (aΠI A) f) fa) =
        compos S (compos (aΠI A) (ProjInd I A f j) (Agii (aΠI A) f)) fa")
apply (simp add:Ag_ind_triangle1)
apply (rename_tac h h1)
 apply (erule conjE)+
 apply (rule funcset_eq[of _ "carrier S"])
 apply (simp add:aHom_def, simp add:aHom_def)
 apply (rule ballI)
 apply (simp add:compos_def)

apply (frule_tac f = h and a = x in aHom_mem[of "S" "Ag_ind (aΠI A) f"],
          assumption+,
       frule_tac f = h1 and a = x in aHom_mem[of "S" "Ag_ind (aΠI A) f"],
          assumption+)
apply (rule_tac x = "h x" and y = "h1 x" in ProjInd_mem_eq[of "I" "A" "f" 
       "B" "S"], assumption+)
apply (rule ballI)
apply (rotate_tac 5,
       frule_tac b = j in forball_spec1, assumption,
       thin_tac "∀j∈I. compose (carrier S) (ProjInd I A f j) h = g j",
       frule_tac b = j in forball_spec1, assumption,
       thin_tac "∀j∈I. compose (carrier S) (ProjInd I A f j) h1 = g j")
apply (simp add:compose_def,
       subgoal_tac "(λx∈carrier S. ProjInd I A f j (h x)) x = g j x",
       thin_tac "(λx∈carrier S. ProjInd I A f j (h x)) = g j",
       subgoal_tac "(λx∈carrier S. ProjInd I A f j (h1 x)) x = g j x",
       thin_tac "(λx∈carrier S. ProjInd I A f j (h1 x)) = g j", simp+)
done

lemma  map_family_triangle2:"[|I ≠ {}; ∀j∈I. aGroup (A j); aGroup S; 
       ∀j∈I. g j ∈ aHom S (A j); ff ∈ carrier (aΠI A) -> B;
        bij_to ff (carrier (aΠI A)) B; 
        h1 ∈ aHom (Ag_ind (aΠI A) ff) S;
        ∀j∈I. compos (Ag_ind (aΠI A) ff) (g j) h1 = ProjInd I A ff j;
        h2 ∈ aHom S (Ag_ind (aΠI A) ff);
        ∀j∈I. compos S (ProjInd I A ff j) h2 = g j|]
       ==> ∀j∈I. compos (Ag_ind (aΠI A) ff) (ProjInd I A ff j)
                 (compos (Ag_ind (aΠI A) ff) h2 h1) =
                ProjInd I A ff j"
apply (rule ballI)
apply (frule prodag_aGroup[of "I" "A"])
apply (frule_tac f = ff in aGroup.Ag_ind_aGroup[of "aΠI A" _ "B"], assumption+)

apply (frule_tac N = "A j" and h = "ProjInd I A ff j" in aHom_compos_assoc[of "Ag_ind (aΠI A) ff" "S" "Ag_ind (aΠI A) ff" _ "h1" "h2"], assumption+)
 apply simp apply assumption+ apply (simp add:ProjInd_aHom)
apply simp
done

lemma  map_family_triangle3:"[|∀j∈I. aGroup (A j); aGroup S; aGroup S1; 
       ∀j∈I. f j ∈ aHom S (A j); ∀j∈I. g j ∈ aHom S1 (A j);   
        h1 ∈ aHom S1 S; h2 ∈ aHom S S1; 
        ∀j∈I. compos S (g j) h2 = f j;
        ∀j∈I. compos S1 (f j) h1 = g j|]
       ==> ∀j∈I. compos S (f j) (compos S h1 h2) = f j"
apply (rule ballI)
apply (frule_tac h = "f j" and N = "A j" in aHom_compos_assoc[of "S" "S1" 
                              "S" _ "h2" "h1"], assumption+)
apply simp apply assumption+ apply simp
apply simp
done

lemma map_family_triangle4:"[|∀j∈I. aGroup (A j); aGroup S; 
                ∀j∈I. f j ∈ aHom S (A j)|] ==> 
               ∀j∈I. compos S (f j) (ag_idmap S) = f j"
apply (rule ballI) 
apply (frule_tac b = j in forball_spec1, assumption,
       thin_tac "∀j∈I. aGroup (A j)",
       frule_tac b = j in forball_spec1, assumption,
       thin_tac "∀j∈I. f j ∈ aHom S (A j)")
apply (simp add:compos_aI_r)
done 

lemma  prod_triangle:"[|I ≠ {}; ∀j∈I. aGroup (A j); aGroup S; 
       ∀j∈I. g j ∈ aHom S (A j); ff ∈ carrier (aΠI A) -> B;
        bij_to ff (carrier (aΠI A)) B; 
        h1 ∈ aHom (Ag_ind (aΠI A) ff) S;
        ∀j∈I. compos (Ag_ind (aΠI A) ff) (g j) h1 = ProjInd I A ff j;
        h2 ∈ aHom S (Ag_ind (aΠI A) ff);
        ∀j∈I. compos S (ProjInd I A ff j) h2 = g j|]
       ==> (compos (Ag_ind (aΠI A) ff) h2 h1) = ag_idmap (Ag_ind (aΠI A) ff)"  
apply (frule map_family_triangle2[of "I" "A" "S" "g" "ff" "B" "h1" "h2"], assumption+)
apply (frule prodag_aGroup[of "I" "A"],
       frule aGroup.Ag_ind_aGroup[of "aΠI A" "ff" "B"], assumption+)
apply (frule aHom_compos[of "Ag_ind (aΠI A) ff" "S" "Ag_ind (aΠI A) ff" "h1" 
                            "h2"], assumption+)
apply (rule ProjInd_mem_eq1[of "I" "A" "ff" "B" "S" 
                            "compos (Ag_ind (aΠI A) ff) h2 h1"], assumption+)
done

lemma characterization_prodag:"[|I ≠ {}; ∀j∈(I::'i set). aGroup ((A j):: 
    ('a, 'm) aGroup_scheme); aGroup (S::'d aGroup); 
    ∀j∈I. ((g j) ∈ aHom S (A j)); ∃ff. ff ∈ carrier (aΠI A) -> (B::'d set) ∧ 
          bij_to ff (carrier (aΠI A)) B; 
    ∀(S':: 'd aGroup). aGroup S' --> 
        (∀g'. (∀j∈I. (g' j) ∈ aHom S' (A j) --> 
         (∃! f. f ∈ aHom S' S ∧ (∀j∈I. compos S' (g j) f =  (g' j)))))|] ==>
     ∃h. bijec(prodag I A),S h"
apply (frule prodag_aGroup[of "I" "A"])
apply (erule exE)
apply (frule_tac f = ff in aGroup.Ag_ind_aGroup[of "aΠI A" _ "B"], erule conjE,
       assumption, simp, erule conjE)
apply (frule aGroup.Ag_ind_aGroup[of "aΠI A" _ "B"], assumption+,
       frule_tac a = S in forall_spec, assumption+)
apply (rotate_tac -1,
       frule_tac a = g in forall_spec1,
       thin_tac "∀g'. ∀j∈I. g' j ∈ aHom S (A j) -->
              (∃!f. f ∈ aHom S S ∧ (∀j∈I. compos S (g j) f = g' j))") 
apply (frule_tac a = "Ag_ind (aΠI A) ff" in forall_spec, assumption+,
       thin_tac "∀S'. aGroup S' --> (∀g'. ∀j∈I. g' j ∈ aHom S' (A j) -->
                (∃!f. f ∈ aHom S' S ∧ (∀j∈I. compos S' (g j) f = g' j)))")
apply (frule_tac a = "ProjInd I A ff" in forall_spec1,
       thin_tac "∀g'. ∀j∈I. g' j ∈ aHom (Ag_ind (aΠI A) ff) (A j) -->
                     (∃!f. f ∈ aHom (Ag_ind (aΠI A) ff) S ∧
                          (∀j∈I. compos (Ag_ind (aΠI A) ff) (g j) f =
                                 g' j))")
apply (frule_tac f = ff in ProjInd_aHom1[of "I" "A" _ "B"], assumption+)
apply (simp add:nonempty_ex[of "I"],
       rotate_tac -2,
       frule ex1_implies_ex,
       thin_tac "∃!f. f ∈ aHom (Ag_ind (aΠI A) ff) S ∧
         (∀j∈I. compos (Ag_ind (aΠI A) ff) (g j) f = ProjInd I A ff j)",
       rotate_tac -1, erule exE, erule conjE) 
apply (rename_tac ff h1,
       frule_tac f = ff in map_family_triangle1[of "I" "A" _  "B" "S" "g"],
           assumption+,
       rotate_tac -1,
       frule ex1_implies_ex,
       thin_tac "∃!h. h ∈ aHom S (Ag_ind (aΠI A) ff) ∧
             (∀j∈I. compos S (ProjInd I A ff j) h = g j)",
       rotate_tac -1,
       erule exE, erule conjE)
apply (rename_tac ff h1 h2)
apply (frule_tac ff = ff and ?h1.0 = h1 and ?h2.0 = h2 in prod_triangle[of "I"
        "A" "S" "g" _ "B"], assumption+,
       frule_tac ?S1.0 = "Ag_ind (aΠI A) ff" in map_family_triangle3[of "I" 
                "A" "S" _ "g"],
        assumption+,
       frule_tac f = h2 and g = h1 and M =  "Ag_ind (aΠI A) ff" in 
                aHom_compos[of "S" _ "S" ], assumption+)
apply (erule ex1E)
 apply (rotate_tac -1,
        frule_tac a = "compos S h1 h2" in forall_spec1,
        frule map_family_triangle4[of "I" "A" "S" "g"], assumption+,
        frule aGroup.aI_aHom[of "S"])
 apply (frule_tac a = "aIS" in forall_spec1,
   thin_tac "∀y. y ∈ aHom S S ∧ (∀j∈I. compos S (g j) y = g j) --> y = f",
   simp,
   thin_tac "∀j∈I. compos S (ProjInd I A ff j) h2 = g j",
   thin_tac "∀j∈I. compos S (g j) f = g j",
   thin_tac "∀j∈I. compos (Ag_ind (aΠI A) ff) (g j) h1 = ProjInd I A ff j")
 apply (rotate_tac -1, frule sym, thin_tac "aIS = f", simp,
        frule_tac A = "Ag_ind (aΠI A) ff" and f = h1 and g = h2 in 
         compos_aI_inj[of _ "S"], assumption+,
        frule_tac B = "Ag_ind (aΠI A) ff" and f = h2 and g = h1 in 
         compos_aI_surj[of "S"], assumption+)
 apply (frule_tac f = ff in Ag_ind_bijec[of "aΠI A" _ "B"], assumption+,
        frule_tac F = "Ag_ind (aΠI A) ff" and f = "Agii (aΠI A) ff" and g = h1 
           in compos_bijec[of "aΠI A" _ "S"], assumption+)
apply (subst bijec_def, simp) 
 apply (thin_tac "bijec(aΠI A),Ag_ind (aΠI A) ff Agii (aΠI A) ff",
        thin_tac "injecAg_ind (aΠI A) ff,S h1",
        thin_tac "surjecAg_ind (aΠI A) ff,S h1")
apply (rule exI, simp)
done

(***  Note.  
                                     f
                                  S' -> S
                                    \   |
                                 g' j\  | g j
                                      \ |
                                        A j

       ***)



chapter "4. Ring theory"

section "1. Definition of a ring and an ideal"

record 'a Ring = "'a aGroup" + 
  tp ::  "['a, 'a ] => 'a" (infixl "·r\<index>" 70)
  un :: "'a"   ("1r\<index>") 
  
locale Ring =
 fixes R (structure)

 assumes 
         pop_closed: "pop R ∈ carrier R -> carrier R -> carrier R"
 and     pop_aassoc : "[|a ∈ carrier R; b ∈ carrier R; c ∈ carrier R|] ==>
         (a ± b) ± c = a ± (b ± c)"
 and     pop_commute:"[|a ∈ carrier R; b ∈ carrier R|] ==> a ± b = b ± a" 
 and     mop_closed:"mop R ∈ carrier R -> carrier R"
 and     l_m :"a ∈ carrier R ==>  (-a a) ± a = \<zero>"
 and     ex_zero: "\<zero> ∈ carrier R"
 and     l_zero:"a ∈ carrier R ==> \<zero> ± a = a"
 and     tp_closed: "tp R ∈ carrier R -> carrier R -> carrier R"
 and     tp_assoc : "[|a ∈ carrier R; b ∈ carrier R; c ∈ carrier R|] ==>
                  (a ·r b) ·r c = a ·r (b ·r c)"
 and     tp_commute: "[|a ∈ carrier R; b ∈ carrier R|] ==> a ·r b = b  ·r a" 
 and     un_closed: "(1r) ∈ carrier R"
 and     rg_distrib: "[|a ∈ carrier R; b ∈ carrier R; c ∈ carrier R|] ==>
                     a ·r (b ± c) = a ·r b  ±  a ·r c"
 and     rg_l_unit: "a ∈ carrier R ==> (1r) ·r a = a"
 
constdefs
 zeroring :: "('a, 'more) Ring_scheme => bool"
  "zeroring R == Ring R ∧ carrier R = {\<zero>R}"

consts
  nscal ::  "('a, 'more) Ring_scheme  => 'a => nat  => 'a"
  npow   ::  "('a, 'more) Ring_scheme  => 'a => nat  => 'a"

  nsum  :: "('a, 'more) aGroup_scheme => (nat => 'a) => nat => 'a"
  nprod  :: "('a, 'more) Ring_scheme => (nat => 'a) => nat => 'a"

primrec
 nscal_0:  "nscal R x 0 = \<zero>R"
 nscal_suc:  "nscal R x (Suc n) = (nscal R x n) ±R x"

primrec
  npow_0: "npow R x 0 = 1rR"
  npow_suc: "npow R x (Suc n) = (npow R x n) ·rR x" 

primrec
  nprod_0:  "nprod R f 0 = f 0"
  nprod_suc:"nprod R f (Suc n) = (nprod R f n) ·rR (f (Suc n))"  

primrec
  nsum_0: "nsum R f 0 = f 0"
  nsum_suc: "nsum R f (Suc n) = (nsum R f n) ±R (f (Suc n))"

syntax 
  "@NSCAL" :: "[nat, ('a, 'more) Ring_scheme, 'a] => 'a" 
       ("(3 _ ×_ _)" [75,75,76]75)
  "@NPOW" ::  "['a, ('a, 'more) Ring_scheme, nat] =>  'a" 
       ("(3_^_ _)" [77,77,78]77)
  "@SUM" :: "('a, 'more) aGroup_scheme => (nat => 'a) => nat => 'a"
       ("(3Σe _ _ _)" [85,85,86]85)

  "@NPROD"::"[('a, 'm) Ring_scheme, nat, nat => 'a] => 'a"
           ("(3eΠ_,_ _)" [98,98,99]98)

translations
  "n ×R x" == "nscal R x n"
  "a^R n" == "npow R a n" 
  "Σe G f n" == "nsum G f n"
  "eΠR,n f" == "nprod R f n"
 
constdefs (structure A)
 fSum::"[_, (nat => 'a), nat, nat] => 'a"
 "fSum A f n m == if n ≤ m then nsum A (cmp f (slide n))(m - n) 
                       else \<zero>" 

syntax 
   "@FSUM" :: "[('a, 'more) aGroup_scheme, (nat => 'a), nat, nat] => 'a"
       ("(4Σf _ _ _ _)" [85,85,85,86]85)

translations
  "Σf G f n m" == "fSum G f n m"

lemma (in aGroup) nsum_zeroGTr:"(∀j ≤ n. f j = \<zero>) --> nsum A f n = \<zero>"
apply (induct_tac n) 
 apply (rule impI, simp)

apply (rule impI)
apply (cut_tac n = n in Nsetn_sub_mem1, simp)
apply (cut_tac ex_zero)
apply (simp add:l_zero[of \<zero>])
done

lemma (in aGroup) nsum_zeroA:"∀j ≤ n. f j = \<zero> ==>   nsum A f n = \<zero>"
apply (simp add:nsum_zeroGTr)
done

constdefs (structure R)
 sr::"[_ , 'a set] => bool"
  "sr R S == S ⊆ carrier R ∧ 1r ∈ S ∧ (∀x∈S. ∀y ∈ S. x  ± (-a y) ∈ S ∧ 
               x ·r y ∈ S)"

 Sr ::"[_ , 'a set] => _"
  "Sr R S == R (|carrier := S, pop := λx∈S. λy∈S. x ±R y, mop := λx∈S. (-aR x),
   zero := \<zero>R, tp := λx∈S. λy∈S. x ·rR y, un := 1rR |)),"

(** sr is a subring without ring structure, Sr is a subring with Ring structure
     **)


lemma (in Ring) Ring:"Ring R"
by (unfold_locales)

lemma (in Ring) ring_is_ag:"aGroup R"
apply (rule aGroup.intro,
       rule pop_closed,
       rule pop_aassoc, assumption+,
       rule pop_commute, assumption+,
       rule mop_closed,
       rule l_m, assumption,
       rule ex_zero,
       rule l_zero, assumption)
done

lemma (in Ring) ring_zero:"\<zero> ∈ carrier R"
by (simp add: ex_zero)

lemma (in Ring) ring_one:"1r ∈ carrier R"
by (simp add:un_closed)

lemma (in Ring) ring_tOp_closed:"[| x ∈ carrier R; y ∈ carrier R|] ==>
                     x ·r y ∈ carrier R"
apply (cut_tac tp_closed)
 apply (frule funcset_mem[of "op ·r" "carrier R" "carrier R -> carrier R"
            "x"], assumption+,
        thin_tac "op ·r ∈ carrier R -> carrier R -> carrier R")
 apply (rule funcset_mem[of "op ·r x" "carrier R" "carrier R" "y"], 
              assumption+)
done

lemma (in Ring) ring_tOp_commute:"[|x ∈ carrier R; y ∈ carrier R|] ==>
                x ·r y = y ·r x" 
by (simp add:tp_commute)

lemma (in Ring) ring_distrib1:"[|x ∈ carrier R; y ∈ carrier R; z ∈ carrier R |]
                 ==> x ·r (y ± z) = x ·r y ± x ·r z"   
by (simp add:rg_distrib)

lemma (in Ring) ring_distrib2:"[|x ∈ carrier R; y ∈ carrier R; z ∈ carrier R |]
                ==> (y ± z) ·r x = y ·r x ±  z ·r x"   
apply (subst tp_commute[of "y ± z" "x"])
 apply (cut_tac ring_is_ag, simp add:aGroup.ag_pOp_closed)
 apply assumption
apply (subst ring_distrib1, assumption+)
 apply (simp add:tp_commute)
done

lemma (in Ring) ring_distrib3:"[|a ∈ carrier R; b ∈ carrier R; x ∈ carrier R; 
      y ∈ carrier R |] ==> (a ± b) ·r (x ± y) =
                                          a ·r x ± a ·r y ± b ·r x ± b ·r y"
apply (subst ring_distrib2)+
 apply (cut_tac ring_is_ag)
 apply (rule aGroup.ag_pOp_closed, assumption+) 
 apply ((subst ring_distrib1)+, assumption+)
 apply (subst ring_distrib1, assumption+)
 apply (rule pop_aassoc [THEN sym, of "a ·r x ± a ·r y" "b ·r x" "b ·r y"])
 apply (cut_tac ring_is_ag, rule aGroup.ag_pOp_closed, assumption)
 apply (simp add:ring_tOp_closed)+
done

lemma (in Ring) rEQMulR:
  "[|x ∈ carrier R; y ∈ carrier R; z ∈ carrier R; x = y |]
        ==> x ·r z = y ·r z"
by simp

lemma (in Ring) ring_tOp_assoc:"[|x ∈ carrier R; y ∈ carrier R; z ∈ carrier R |]
 ==> (x ·r y) ·r z = x ·r (y ·r z)"
by (simp add:tp_assoc)

lemma (in Ring) ring_l_one:"x ∈ carrier R ==> 1r ·r x = x"
by (simp add:rg_l_unit)

lemma (in Ring) ring_r_one:"x ∈ carrier R  ==> x ·r 1r = x"
 apply (subst ring_tOp_commute, assumption+)
 apply (simp add:un_closed)
 apply (simp add:ring_l_one)
done

lemma (in Ring) ring_times_0_x:"x ∈ carrier R ==> \<zero> ·r x = \<zero>"
apply (cut_tac ring_is_ag)
apply (cut_tac ring_zero)
apply (frule ring_distrib2 [of "x" "\<zero>" "\<zero>"], assumption+)
apply (simp add:aGroup.ag_l_zero [of "R" "\<zero>"])
apply (frule ring_tOp_closed [of "\<zero>" "x"], assumption+)
apply (frule sym, thin_tac "\<zero> ·r x = \<zero> ·r x ± \<zero> ·r x")
apply (frule aGroup.ag_eq_sol2 [of "R" "\<zero> ·r x" "\<zero> ·r x" "\<zero> ·r x"], 
        assumption+)
apply (thin_tac "\<zero> ·r x ± \<zero> ·r x = \<zero> ·r x")
apply (simp add:aGroup.ag_r_inv1)
done

lemma (in Ring) ring_times_x_0:"x ∈ carrier R ==>  x ·r \<zero> = \<zero>"
apply (cut_tac ring_zero)
apply (subst ring_tOp_commute, assumption+, simp add:ring_zero)
apply (simp add:ring_times_0_x)
done 

lemma (in Ring) rMulZeroDiv:
     "[| x ∈ carrier R; y ∈ carrier R; x = \<zero> ∨ y = \<zero> |]   ==> x  ·r  y = \<zero>";
apply (erule disjE, simp)
apply (rule ring_times_0_x, assumption+)
apply (simp, rule ring_times_x_0, assumption+)
done

lemma (in Ring) ring_inv1:"[| a ∈ carrier R; b ∈ carrier R |] ==>
      -a (a ·r b) = (-a a) ·r b ∧ -a (a ·r b) = a ·r (-a b)"
apply (cut_tac ring_is_ag)  
apply (rule conjI) 
apply (frule ring_distrib2 [THEN sym, of "b" "a" "-a a"], assumption+)
 apply (frule aGroup.ag_mOp_closed [of "R" "a"], assumption+)
 apply (simp add:aGroup.ag_r_inv1 [of "R" "a"])
 apply (simp add:ring_times_0_x)
 apply (frule aGroup.ag_mOp_closed [of "R" "a"], assumption+)
 apply (frule ring_tOp_closed [of "a" "b"], assumption+)
 apply (frule ring_tOp_closed [of "-a a" "b"], assumption+)
 apply (frule aGroup.ag_eq_sol1 [of "R" "a ·r b" "(-a a) ·r b" "\<zero>"], 
           assumption+)
 apply (rule ring_zero, assumption+)
 apply (thin_tac "a ·r b ± (-a a) ·r b = \<zero>")
 apply (frule sym) apply (thin_tac "(-a a) ·r b = -a (a ·r b) ± \<zero>")
 apply (frule aGroup.ag_mOp_closed [of "R" " a ·r b"], assumption+)
 apply (simp add:aGroup.ag_r_zero)
apply (frule ring_distrib1 [THEN sym, of "a" "b" "-a b"], assumption+)
 apply (simp add:aGroup.ag_mOp_closed)
  apply (simp add:aGroup.ag_r_inv1 [of "R" "b"])
  apply (simp add:ring_times_x_0)
 apply (frule aGroup.ag_mOp_closed [of "R" "b"], assumption+)
 apply (frule ring_tOp_closed [of "a" "b"], assumption+)
 apply (frule ring_tOp_closed [of "a" "-a b"], assumption+)
 apply (frule aGroup.ag_eq_sol1 [THEN sym, of "R" "a ·r b" "a ·r (-a b)" "\<zero>"], 
                                                      assumption+)
 apply (simp add:ring_zero) apply assumption
 apply (frule aGroup.ag_mOp_closed [of "R" " a ·r b"], assumption+)
  apply (simp add:aGroup.ag_r_zero)
done

lemma (in Ring) ring_inv1_1:"[|a ∈ carrier R; b ∈ carrier R |] ==>
      -a (a ·r b) = (-a a) ·r b"
apply (simp add:ring_inv1)
done

lemma (in Ring) ring_inv1_2:"[| a ∈ carrier R; b ∈ carrier R |] ==>
                                -a (a ·r b) = a ·r (-a b)"
apply (frule ring_inv1 [of "a" "b"], assumption+)
apply (frule conjunct2) 
apply (thin_tac "-a a ·r b = (-a a) ·r b ∧ -a (a ·r b) = a ·r (-a b)") 
apply simp
done

lemma (in Ring) ring_times_minusl:"a ∈ carrier R ==>  -a a = (-a 1r) ·r a"
apply (cut_tac ring_one)
apply (frule ring_inv1_1[of "1r" "a"], assumption+)
apply (simp add:ring_l_one)
done

lemma (in Ring) ring_times_minusr:"a ∈ carrier R ==>  -a a = a ·r (-a 1r)"
apply (cut_tac ring_one)
apply (frule ring_inv1_2[of "a" "1r"], assumption+)
apply (simp add:ring_r_one)
done

lemma (in Ring) ring_inv1_3:"[|a ∈ carrier R; b ∈ carrier R|] ==>
                           a ·r b = (-a a) ·r (-a b)"
apply (cut_tac ring_is_ag)
apply (subst  aGroup.ag_inv_inv[THEN sym], assumption+)
apply (frule aGroup.ag_mOp_closed[of "R" "a"], assumption+)
apply (subst ring_inv1_1[THEN sym, of "-a a" "b"], assumption+)
apply (subst ring_inv1_2[of "-a a" "b"], assumption+, simp)
done

lemma (in Ring) ring_distrib4:"[|a ∈ carrier R; b ∈ carrier R;
                                x ∈ carrier R; y ∈ carrier R |] ==>
      a ·r b ± (-a x ·r y) = a ·r (b ± (-a y)) ± (a ± (-a x)) ·r y"
apply (cut_tac ring_is_ag)
apply (subst ring_distrib1, assumption+)
apply (rule aGroup.ag_mOp_closed, assumption+) 
apply (subst ring_distrib2, assumption+)
apply (rule aGroup.ag_mOp_closed, assumption+) 
apply (subst aGroup.pOp_assocTr43, assumption+)
apply (rule ring_tOp_closed, assumption+)+
 apply (rule aGroup.ag_mOp_closed, assumption+)
 apply (rule ring_tOp_closed, assumption+)
 apply (rule ring_tOp_closed)
 apply (simp add:aGroup.ag_mOp_closed)+
apply (subst ring_distrib1 [THEN sym, of "a" _], assumption+)
 apply (rule aGroup.ag_mOp_closed, assumption+)
apply (simp add:aGroup.ag_l_inv1)
apply (simp add:ring_times_x_0)
apply (subst aGroup.ag_r_zero, assumption+)
apply (simp add:ring_tOp_closed)
apply (simp add: ring_inv1_1)
done

lemma (in Ring) rMulLC:
     "[|x ∈ carrier R; y ∈ carrier R; z ∈ carrier R|]
        ==> x ·r (y ·r z) = y ·r (x ·r z)"
  apply (subst ring_tOp_assoc [THEN sym], assumption+)
  apply (subst ring_tOp_commute [of "x" "y"], assumption+)
  apply (subst ring_tOp_assoc, assumption+)
  apply simp
  done 

lemma (in Ring) Zero_ring:"1r = \<zero> ==> zeroring R"
apply (simp add:zeroring_def)
apply (rule conjI)
 apply (rule Ring_axioms)
apply (rule equalityI)
 apply (rule subsetI)
 apply (frule_tac x = x in ring_r_one, simp add:ring_times_x_0)

 apply (simp add:ring_zero)
done

lemma (in Ring) Zero_ring1:"¬ (zeroring R) ==>  1r ≠ \<zero>"
apply (rule contrapos_pp, simp+,
       cut_tac Zero_ring, simp+)
done

lemma (in Ring) Sr_one:"sr R S ==> 1r ∈ S"
apply (simp add:sr_def)
done

lemma (in Ring) Sr_zero:"sr R S ==> \<zero> ∈ S"
apply (cut_tac ring_is_ag, frule Sr_one[of "S"])
apply (simp add:sr_def) apply (erule conjE)+
apply (frule_tac b = "1r" in forball_spec1, assumption,
       thin_tac "∀x∈S. ∀y∈S. x ± -a y ∈ S ∧ x ·r y ∈ S",
       frule_tac b = "1r" in forball_spec1, assumption,
       thin_tac "∀y∈S. 1r ± -a y ∈ S ∧ 1r ·r y ∈ S",
       erule conjE)
apply (cut_tac ring_one, 
       simp add:aGroup.ag_r_inv1[of "R" "1r"])
done

lemma (in Ring) Sr_mOp_closed:"[|sr R S; x ∈ S|] ==> -a x ∈ S" 
apply (frule Sr_zero[of "S"])
apply (simp add:sr_def, (erule conjE)+)
apply (cut_tac ring_is_ag)
 apply (frule_tac b = "\<zero>" in forball_spec1, assumption,
        thin_tac "∀x∈S. ∀y∈S. x ± -a y ∈ S ∧ x ·r y ∈ S",
        frule_tac b = x in forball_spec1, assumption,
        thin_tac "∀y∈S. \<zero> ± -a y ∈ S ∧ \<zero> ·r y ∈ S", erule conjE)
 apply (frule subsetD[of "S" "carrier R" "\<zero>"], assumption+,
        frule subsetD[of "S" "carrier R" "x"], assumption+)
 apply (frule aGroup.ag_mOp_closed [of "R" "x"], assumption) 
 apply (simp add:aGroup.ag_l_zero) 
done

lemma (in Ring) Sr_pOp_closed:"[|sr R S; x ∈ S; y ∈ S|] ==> x ± y ∈ S"
apply (frule Sr_mOp_closed[of "S" "y"], assumption+)
apply (unfold sr_def, (erule conjE)+)
 apply (frule_tac b = x in forball_spec1, assumption,
        thin_tac "∀x∈S. ∀y∈S. x ± -a y ∈ S ∧ x ·r y ∈ S",
        frule_tac b = "-a y" in forball_spec1, assumption,
        thin_tac "∀y∈S. x ± -a y ∈ S ∧ x ·r y ∈ S", erule conjE) 

 apply (cut_tac ring_is_ag )
 apply (frule subsetD[of "S" "carrier R" "y"], assumption+)
 apply (simp add:aGroup.ag_inv_inv) 
done

lemma (in Ring) Sr_tOp_closed:"[|sr R S; x ∈ S; y ∈ S|] ==> x ·r y ∈ S"
by (simp add:sr_def)

lemma (in Ring) Sr_ring:"sr R S ==> Ring (Sr R S)"
apply (simp add:Ring_def [of "Sr R S"],
       cut_tac ring_is_ag)
 apply (rule conjI)
 apply (simp add:Sr_def)
 apply (rule bivar_func_test, (rule ballI)+)
 apply (frule_tac x = a and y = b in Sr_pOp_closed, assumption+,
        simp)

apply (rule conjI)
 apply (rule allI, rule impI)+
 apply (simp add:Sr_def,
        frule_tac x = a and y = b in Sr_pOp_closed, assumption+,
        frule_tac x = b and y = c in Sr_pOp_closed, assumption+, 
        simp add:Sr_def sr_def, (erule conjE)+)
 apply (frule_tac c = a in subsetD[of "S" "carrier R"], assumption+,
        frule_tac c = b in subsetD[of "S" "carrier R"], assumption+,
        frule_tac c = c in subsetD[of "S" "carrier R"], assumption+)
 apply (simp add:aGroup.ag_pOp_assoc)

apply (rule conjI)
 apply (rule allI, rule impI)+
 apply (simp add:Sr_def sr_def, (erule conjE)+,
        frule_tac c = a in subsetD[of "S" "carrier R"], assumption+,
        frule_tac c = b in subsetD[of "S" "carrier R"], assumption+)
 apply (simp add:aGroup.ag_pOp_commute)

apply (rule conjI)
  apply ((subst Sr_def)+, simp)
  apply (rule univar_func_test, rule ballI, simp add:Sr_mOp_closed)

apply (rule conjI)
  apply (rule allI)
  apply ((subst Sr_def)+, simp add:Sr_mOp_closed, rule impI)
  apply (unfold sr_def, frule conjunct1, fold sr_def,
         frule_tac c = a in subsetD[of "S" "carrier R"], assumption+,
         simp add:aGroup.ag_l_inv1)

apply (rule conjI)
  apply (simp add:Sr_def Sr_zero)

apply (rule conjI)
  apply (rule allI, simp add:Sr_def Sr_zero)
  apply (rule impI)
  apply (unfold sr_def, frule conjunct1, fold sr_def,
         frule_tac c = a in subsetD[of "S" "carrier R"], assumption+,
         simp add:aGroup.ag_l_zero) 

apply (rule conjI)
  apply (simp add:Sr_def)
  apply (rule bivar_func_test, (rule ballI)+)
  apply (simp add:Sr_tOp_closed)

apply (rule conjI)
  apply (rule allI, rule impI)+
  apply (simp add:Sr_def Sr_tOp_closed)
  apply (unfold sr_def, frule conjunct1, fold sr_def,
         frule_tac c = a in subsetD[of "S" "carrier R"], assumption+,
         frule_tac c = b in subsetD[of "S" "carrier R"], assumption+,
         frule_tac c = c in subsetD[of "S" "carrier R"], assumption+)
  apply (simp add:ring_tOp_assoc)

apply (rule conjI)
  apply ((rule allI, rule impI)+, simp add:Sr_def)
  apply (unfold sr_def, frule conjunct1, fold sr_def,
         frule_tac c = a in subsetD[of "S" "carrier R"], assumption+,
         frule_tac c = b in subsetD[of "S" "carrier R"], assumption+,
         simp add:ring_tOp_commute)

apply (rule conjI)
  apply (simp add:Sr_def Sr_one)

apply (rule conjI)
  apply (simp add:Sr_def Sr_pOp_closed Sr_tOp_closed)
  apply (rule allI, rule impI)+
  apply (unfold sr_def, frule conjunct1, fold sr_def,
         frule_tac c = a in subsetD[of "S" "carrier R"], assumption+,
         frule_tac c = b in subsetD[of "S" "carrier R"], assumption+,
         frule_tac c = c in subsetD[of "S" "carrier R"], assumption+)
  apply (simp add:ring_distrib1)   

apply (simp add:Sr_def Sr_one)
 apply (rule allI, rule impI)
   apply (unfold sr_def, frule conjunct1, fold sr_def,
         frule_tac c = a in subsetD[of "S" "carrier R"], assumption+)
 apply (simp add:ring_l_one)
done


section "2. Calculation of elements"
 (** The author of this part is L. Chen, revised by H. Murao and Y.
     Santo  **)

subsection "nscale"

lemma (in Ring) ring_tOp_rel:"[|x∈carrier R; xa∈carrier R; y∈carrier R;
ya ∈ carrier R |] ==> (x ·r xa) ·r (y ·r ya) = (x ·r y) ·r (xa ·r ya)"
apply (frule ring_tOp_closed[of "y" "ya"], assumption+,
       simp add:ring_tOp_assoc[of "x" "xa"])
apply (simp add:ring_tOp_assoc[THEN sym, of "xa" "y" "ya"],
       simp add:ring_tOp_commute[of "xa" "y"],
       simp add:ring_tOp_assoc[of "y" "xa" "ya"])
apply (frule ring_tOp_closed[of "xa" "ya"], assumption+,
       simp add:ring_tOp_assoc[THEN sym, of "x" "y"])
done

lemma (in Ring) nsClose:
  "!! n. [| x ∈ carrier R |]  ==> nscal R x n ∈ carrier R"
  apply (induct_tac n)
  apply (simp add:ring_zero)
  apply (cut_tac ring_is_ag, simp add:aGroup.ag_pOp_closed)
done

lemma (in Ring) nsZero:
             "nscal R \<zero> n = \<zero>"
  apply (cut_tac ring_is_ag)
  apply (induct_tac n)
  apply simp
  
  apply simp
   apply (cut_tac ring_zero, simp add:aGroup.ag_l_zero)
  done  

lemma (in Ring) nsZeroI: "!! n.  x = \<zero>  ==> nscal R x n = \<zero>";
  by (simp only:nsZero)

lemma (in Ring) nsEqElm:  "[| x ∈ carrier R; y ∈ carrier R; x = y |]
        ==> (nscal R x n) = (nscal R y n)"
  by simp

lemma (in Ring) nsDistr:  "x ∈ carrier R 
        ==> (nscal R x n) ± (nscal R x m) = nscal R x (n + m)"
apply (cut_tac ring_is_ag)
  apply (induct_tac m)
  apply simp
  apply (frule nsClose[of "x" "n"]) 
  apply ( simp add:aGroup.ag_r_zero)

  apply simp 
  apply (frule_tac x = x and n = n in nsClose,
         frule_tac x = x and n = na in nsClose)
  apply (subst aGroup.ag_pOp_assoc[THEN sym], assumption+, simp) 
  done

lemma (in Ring) nsDistrL:  "[|x ∈ carrier R; y ∈ carrier R |]
        ==> (nscal R x n) ± (nscal R y n) = nscal R (x ± y) n"
  apply (cut_tac ring_is_ag)
  apply (induct_tac n)
  apply simp 
  apply (cut_tac ring_zero, 
         simp add:aGroup.ag_l_zero)

  apply simp
  apply (frule_tac x = x and n = n in nsClose,
         frule_tac x = y and n = n in nsClose)
  apply (subst aGroup.pOp_assocTr43[of R _ x _ y], assumption+)
  apply (frule_tac x = x and y = "n ×R y" in aGroup.ag_pOp_commute[of "R"],
         assumption+)
   apply simp
   apply (subst aGroup.pOp_assocTr43[THEN sym, of R _ _ x y], assumption+)
   apply simp
done
 
lemma (in Ring) nsMulDistrL:"[| x ∈ carrier R; y ∈ carrier R |]
        ==> x ·r (nscal R y n) = nscal R (x ·r y) n";
  apply (induct_tac n)
  apply simp
  apply (simp add:ring_times_x_0)

  apply simp apply (subst ring_distrib1, assumption+)
  apply (rule nsClose, assumption+) 
  apply simp
done
 
lemma (in Ring) nsMulDistrR:"[| x ∈ carrier R; y ∈ carrier R|]
        ==> (nscal R y n) ·r x = nscal R (y ·r x) n"
  apply (frule_tac x = y and n = n in nsClose,
         simp add:ring_tOp_commute[of "n ×R y" "x"],
         simp add:nsMulDistrL,
         simp add:ring_tOp_commute[of "y" "x"])
done

subsection "npow"

lemma (in Ring) npClose:"x ∈ carrier R ==> npow R x n ∈ carrier R"
  apply (induct_tac n)
  apply simp apply (simp add:ring_one)

  apply simp
  apply (rule ring_tOp_closed, assumption+)
  done

lemma (in Ring) npMulDistr:"!! n m. x ∈ carrier R  ==> 
                 (npow R x n) ·r (npow R x m) = npow R x (n + m)"
  apply (induct_tac m)
  apply simp apply (rule ring_r_one, simp add:npClose)

  apply simp
  apply (frule_tac x = x and n = n in npClose,
         frule_tac x = x and n = na in npClose)
  apply (simp add:ring_tOp_assoc[THEN sym])
done

lemma (in Ring) npMulExp:"!!n m. x ∈ carrier R 
        ==>  npow R (npow R x n) m = npow R x (n * m)" 
apply (induct_tac m)
apply simp
apply simp 
apply (simp add:npMulDistr)
apply (simp add:add_commute)
done    


lemma (in Ring) npGTPowZero_sub:
  " !! n. [| x ∈ carrier R; npow R x m = \<zero> |]
        ==>(m ≤ n) --> (npow R x n = \<zero> )";
  apply (rule impI)
  apply (subgoal_tac "npow R x n = (npow R x (n-m)) ·r (npow R x m)")
  apply simp
  apply (rule ring_times_x_0) apply (simp add:npClose)
  apply (thin_tac "x^R m = \<zero>")
  apply (subst npMulDistr, assumption)
  apply simp
  done

lemma (in Ring) npGTPowZero:
  "!! n. [| x ∈ carrier R; npow R x m = \<zero>; m ≤ n |]
        ==> npow R x n = \<zero>"
  apply (cut_tac x = x and m = m and n = n in npGTPowZero_sub, assumption+)
  apply simp
  done


lemma (in Ring) npOne: " npow R (1r) n = 1r"
  apply (induct_tac n) apply simp

  apply simp
    apply (rule ring_r_one, simp add:ring_one) 
done

lemma (in Ring) npZero_sub: "0 < n --> npow R \<zero> n = \<zero>"
  apply (induct_tac "n")
  apply simp

  apply simp
    apply (cut_tac ring_zero,
           frule_tac n = n in npClose[of "\<zero>"]) 
    apply (simp add:ring_times_x_0)
done

lemma (in Ring) npZero: "0 < n  ==> npow R \<zero> n = \<zero>"
  apply (simp add:npZero_sub)
done
 
lemma (in Ring) npMulElmL: "!! n. [| x ∈ carrier R; 0 ≤ n|] 
        ==> x ·r (npow R x n) = npow R x (Suc n)"
apply (simp only:npow_suc,
       frule_tac n = n and x = x in npClose,
       simp add:ring_tOp_commute)
done

lemma (in Ring) npMulEleL: "!! n. x ∈ carrier R 
        ==> (npow R x n) ·r x =  npow R x (Suc n)"
by (simp add:npMulElmL[THEN sym])

lemma (in Ring) npMulElmR: "!! n. x ∈ carrier R 
        ==> (npow R x n) ·r x =  npow R x (Suc n)"
  apply ( frule_tac n = n in npClose[of "x"])
   apply (simp only:ring_tOp_commute,
          subst npMulElmL, assumption, simp, simp)
  done

lemma (in Ring) np_1:"a ∈ carrier R ==> npow R a (Suc 0) = a"  (* Y. Santo*)
apply simp
 apply (simp add:ring_l_one)
done 
 
subsection  "nsum and fSum"

lemma (in aGroup) nsum_memTr: "(∀j ≤ n. f j ∈ carrier A) -->
                                 nsum A f n ∈ carrier A"  
  apply (induct_tac "n")
  apply simp 
  apply (rule impI)
  apply (cut_tac n = n in Nsetn_sub_mem1, simp)
  apply (frule_tac a = "Suc n" in forall_spec, simp,
         thin_tac "∀j≤Suc n. f j ∈ carrier A")
   apply (rule ag_pOp_closed, assumption+)
   done 

lemma (in aGroup) nsum_mem:"∀j ≤ n. f j ∈ carrier A ==>
                                 nsum A f n ∈ carrier A"
apply (simp add:nsum_memTr)
done
    
lemma (in aGroup) nsum_eqTr:"(∀j ≤ n. f j ∈ carrier A ∧ 
                                      g j ∈ carrier A ∧
                                      f j = g j) 
                           -->  nsum A f n = nsum A g n"
apply (induct_tac n)
 apply simp 
apply (rule impI)
 apply (cut_tac n = n in Nsetn_sub_mem1, simp)
done

lemma (in aGroup) nsum_eq:"[|∀j ≤ n. f j ∈ carrier A; ∀j ≤ n. g j ∈ carrier A;
                           ∀j ≤ n. f j = g j|] ==>  nsum A f n = nsum A g n"
by (simp add:nsum_eqTr)

lemma (in aGroup) nsum_cmp_assoc:"[|∀j ≤ n. f j ∈ carrier A;
       g ∈ {j. j ≤ n} -> {j. j ≤ n}; h ∈ {j. j ≤ n} -> {j. j ≤ n}|] ==>
       nsum A (cmp (cmp f h) g) n = nsum A (cmp f (cmp h g)) n" 
apply (rule nsum_eq)
apply (rule allI, rule impI, simp add:cmp_def)
apply (frule_tac x = j in funcset_mem[of g "{j. j ≤ n}" "{j. j ≤ n}"], simp,
       frule_tac x = "g j" in funcset_mem[of h "{j. j ≤ n}" "{j. j ≤ n}"], 
       assumption, simp)
 apply (rule allI, rule impI, simp add:cmp_def,
       frule_tac x = j in funcset_mem[of g "{j. j ≤ n}" "{j. j ≤ n}"], simp,
       frule_tac x = "g j" in funcset_mem[of h "{j. j ≤ n}" "{j. j ≤ n}"], 
       assumption, simp)
 apply (rule allI, simp add:cmp_def)
done

lemma (in aGroup) fSum_Suc:"∀j ∈ nset n (n + Suc m). f j ∈ carrier A ==>
              fSum A f n (n + Suc m) = fSum A f n (n + m) ± f (n + Suc m)"
by (simp add:fSum_def, simp add:cmp_def slide_def)

lemma (in aGroup) fSum_eqTr:"(∀j ∈ nset n (n + m). f j ∈ carrier A ∧ 
         g j ∈ carrier A ∧  f j = g j)  --> 
                       fSum A f  n (n + m) = fSum A g n (n + m)"
apply (induct_tac m)
 apply (simp add:fSum_def, 
        simp add:cmp_def slide_def,
        simp add:nset_def)

apply (rule impI) 
 apply (subst fSum_Suc,
        rule ballI, simp, simp)
 apply (cut_tac n = n and m = na and f = g in fSum_Suc,
        rule ballI, simp, simp,
        thin_tac "Σf A g n (Suc (n + na)) =
                                   Σf A g n (n + na) ± g (Suc (n + na))")

 apply (cut_tac n = n and m = na in nsetnm_sub_mem, simp,
        thin_tac "∀j. j ∈ nset n (n + na) --> j ∈ nset n (Suc (n + na))")
apply (frule_tac b = "Suc (n + na)" in forball_spec1,
       simp add:nset_def, simp)
done

lemma (in aGroup) fSum_eq:"[| ∀j ∈ nset n (n + m). f j ∈ carrier A; 
      ∀j ∈ nset n (n + m). g j ∈ carrier A; (∀j∈ nset n (n + m). f j = g j)|]
       ==> 
         fSum A f n (n + m) = fSum A g n (n + m)"
by (simp add:fSum_eqTr)

lemma (in aGroup) fSum_eq1:"[|n ≤ m; ∀j∈nset n m. f j ∈ carrier A;
       ∀j∈nset n m. g j ∈ carrier A;  ∀j∈nset n m. f j = g j|] ==>
         fSum A f n m = fSum A g n m" 
apply (cut_tac fSum_eq[of n "m - n" f g])
apply simp+
done

lemma (in aGroup) fSum_zeroTr:"(∀j ∈ nset n (n + m). f j = \<zero>)  --> 
                       fSum A f  n (n + m) = \<zero>"
apply (induct_tac m)
 apply (simp add:fSum_def cmp_def slide_def nset_def)
 apply (rule impI)
 apply (subst fSum_Suc)
 apply (rule ballI, simp add:ag_inc_zero)
apply (frule_tac b = "n + Suc na" in forball_spec1, simp add:nset_def,
       simp)
 apply (simp add:nset_def)
 apply (cut_tac ag_inc_zero, simp add:ag_l_zero)
done

lemma (in aGroup) fSum_zero:"∀j ∈ nset n (n + m). f j = \<zero>  ==>
                       fSum A f  n (n + m) = \<zero>"
by (simp add:fSum_zeroTr)

lemma (in aGroup) fSum_zero1:"[|n < m; ∀j ∈ nset (Suc n) m. f j = \<zero>|]  ==>
                       fSum A f  (Suc n) m = \<zero>"
apply (cut_tac fSum_zero[of "Suc n" "m - Suc n" f])
 apply simp+
done

lemma (in Ring) nsumMulEleL: "!! n. [| ∀ i. f i ∈ carrier R; x ∈ carrier R |]
        ==> x ·r (nsum R f n) = nsum R (λ i. x ·r (f i)) n"
  apply (cut_tac ring_is_ag)
  apply (induct_tac "n")
  apply simp

  apply simp
  apply (subst ring_distrib1, assumption)
  apply (rule aGroup.nsum_mem, assumption) 
 apply (rule allI, simp+)
done

lemma (in Ring) nsumMulElmL:
  "!! n. [| ∀ i. f i ∈ carrier R; x ∈ carrier R |]
        ==> x ·r (nsum R f n) = nsum R (λ i. x ·r (f i)) n"
  apply (cut_tac ring_is_ag)
  apply (induct_tac "n")
  apply simp

  apply simp
  apply (subst ring_distrib1, assumption+)
    apply (simp add:aGroup.nsum_mem)+
  done

lemma (in aGroup) nsumTailTr:
         "(∀j≤(Suc n). f j ∈ carrier A) -->
          nsum A f (Suc n) = (nsum A (λ i. (f (Suc i))) n) ± (f 0)"
  apply (induct_tac "n")
  apply simp
  apply (rule impI, 
         rule ag_pOp_commute)
  apply (cut_tac Nset_inc_0[of "Suc 0"],
         simp add:funcset_mem,
         cut_tac n_in_Nsetn[of "Suc 0"],
         simp add:funcset_mem)

  apply (rule impI)
   apply (cut_tac n = "Suc n" in Nsetn_sub_mem1, simp)
   apply (frule_tac a = 0 in forall_spec, simp,
          frule_tac a = "Suc (Suc n)" in forall_spec, simp)
    apply (cut_tac n = n in nsum_mem[of  _  "λi. f (Suc i)"],
          rule allI, rule impI,
          frule_tac a = "Suc j" in forall_spec, simp, simp,
          thin_tac "∀j≤Suc (Suc n). f j ∈ carrier A")
    apply (subst ag_pOp_assoc, assumption+) 
       apply (simp add:ag_pOp_commute[of  "f 0"])
    apply (subst ag_pOp_assoc[THEN sym], assumption+) 
    apply simp
  done 
 
lemma (in aGroup) nsumTail:
      "∀j ≤ (Suc n). f j ∈ carrier A ==>
            nsum A f (Suc n) = (nsum A (λ i. (f (Suc i))) n) ± (f 0)"
  by (cut_tac nsumTailTr[of n f], simp)

lemma (in aGroup) nsumElmTail:
  "∀i. f i ∈ carrier A 
        ==> nsum A f (Suc n) = (nsum A (λ i. (f (Suc i))) n) ± (f 0)"
  apply (cut_tac n = n and f = f in nsumTail,
         rule allI, simp, simp)
done

lemma (in aGroup) nsum_addTr:
  "(∀j ≤ n. f j ∈ carrier A ∧ g j ∈ carrier A) -->
   nsum A (λ i. (f i) ± (g i)) n = (nsum A f n) ± (nsum A g n)" 
  apply (induct_tac "n")
  apply simp

  apply (simp, rule impI)
  apply (cut_tac n = n in Nsetn_sub_mem1, simp)
 apply (thin_tac "Σe A (λi. f i ± g i) n = Σe A f n ± Σe A g n")
  apply (rule aGroup.ag_add4_rel, rule aGroup_axioms)
  apply (rule aGroup.nsum_mem, rule aGroup_axioms, rule allI, simp)
  apply (rule aGroup.nsum_mem, rule aGroup_axioms, rule allI, simp)
  apply simp+
  done

lemma (in aGroup) nsum_add:
  "[| ∀j ≤ n. f j ∈ carrier A; ∀j ≤ n. g j ∈ carrier A|]  ==> 
   nsum A (λ i. (f i) ± (g i)) n = (nsum A f n) ± (nsum A g n)"
by (cut_tac nsum_addTr[of n f g], simp)

lemma (in aGroup) nsumElmAdd:
  "[| ∀ i. f i ∈ carrier A; ∀ i. g i ∈ carrier A|]   
        ==> nsum A (λ i. (f i) ± (g i)) n = (nsum A f n) ± (nsum A g n)"
 apply (cut_tac nsum_add[of n f g])
 apply simp
 apply (rule allI, simp)+
 done 

lemma (in aGroup) nsum_add_nmTr:
  "(∀j ≤ n. f j ∈ carrier A) ∧ (∀j ≤ m. g j ∈ carrier A) -->
   nsum A (jointfun n f m g) (Suc (n + m)) = (nsum A f n) ± (nsum A g m)"
apply (induct_tac m)      
 apply (simp add:jointfun_def sliden_def)
 apply (rule impI)
 apply (rule ag_pOp_add_r)
 apply (rule nsum_mem, rule allI, erule conjE, rule impI, simp)
 apply (erule conjE, simp add:nsum_mem, simp)
 apply (rule nsum_eq[of n], simp+)
apply (simp add:jointfun_def)
 apply (rule impI, simp)
 apply (erule conjE, simp add:sliden_def)
 apply (thin_tac "Σe A (λi. if i ≤ n then f i else g (sliden (Suc n) i))
        (n + na) ± g na = Σe A f n ± Σe A g na")
 apply (subst ag_pOp_assoc)
 apply (simp add:nsum_mem)
 apply (simp add:nsum_mem, simp)
 apply simp
done

lemma (in aGroup) nsum_add_nm:
"[|∀j ≤ n. f j ∈ carrier A; ∀j ≤ m. g j ∈ carrier A|] ==>
   nsum A (jointfun n f m g) (Suc (n + m)) = (nsum A f n) ± (nsum A g m)"
apply (cut_tac nsum_add_nmTr[of n f m g])
 apply simp
done

lemma (in Ring) npeSum2_sub_muly:
  "[| x ∈ carrier R; y ∈ carrier R |] ==>
        y ·r(nsum R (λi. nscal R ((npow R x (n-i)) ·r (npow R y i))
                                (n choose i)) n)
        = nsum R (λi. nscal R ((npow R x (n-i)) ·r (npow R y (i+1)))
                                (n choose i)) n"
  apply (cut_tac ring_is_ag)
  apply (subst nsumMulElmL)
    apply (rule allI)
      apply (simp only:nsClose add:ring_tOp_closed 
             add:npClose)
    apply assumption
  apply (simp only:nsMulDistrL add:nsClose add:ring_tOp_closed
         add:npClose)  
  apply (simp only: rMulLC [of "y"] add:npClose)

 apply (simp del:npow_suc add:ring_tOp_commute[of y])
 apply (rule aGroup.nsum_eq, assumption)
  apply (rule allI, rule impI, rule nsClose,
         rule ring_tOp_closed, simp add:npClose,
         rule ring_tOp_closed, assumption, simp add:npClose)
  apply (rule allI, rule impI, rule nsClose,
         rule ring_tOp_closed, simp add:npClose,
         rule npClose, assumption)
 apply (rule allI, rule impI)
  apply (frule_tac n = j in npClose[of y])
  apply (simp add:ring_tOp_commute[of y])
done
  
(********)(********)(********)(********)
lemma binomial_n0: "(Suc n choose 0) = (n choose 0)";
  by simp

lemma binomial_ngt_diff:
  "(n choose Suc n) = (Suc n choose Suc n) - (n choose n)";
  by (subst binomial_Suc_Suc, arith)


lemma binomial_ngt_0: "(n choose Suc n) = 0";
  apply (subst binomial_ngt_diff, 
         (subst binomial_n_n)+)
  apply simp
  done

lemma diffLessSuc: "m ≤ n ==> Suc (n-m) = Suc n - m";
  by arith

lemma (in Ring) npow_suc_i:
  "[| x ∈ carrier R; i ≤ n |]
        ==> npow R x (Suc n - i) =  x ·r (npow R x (n-i))"
  apply (subst diffLessSuc [THEN sym, of "i" "n"], assumption)
  apply (frule_tac n = "n - i" in npClose,
         simp add:ring_tOp_commute[of x])
  done
(**
lemma (in Ring) nsumEqFunc_sub:
  "[|  !! i. f i ∈ carrier R; !! i. g i ∈ carrier R |]
        ==> ( ∀ i. i ≤ n --> f i = g i) --> (nsum0 R f n = nsum0 R g n)";
  apply (induct_tac "n")
  apply simp+
  done

lemma (in Ring) nsumEqFunc:
  "[| !! i. f i ∈ carrier R; !! i. g i ∈ carrier R;
     !! i. i ≤ n --> f i = g i |] ==>  nsum0 R f n = nsum0 R g n"
  apply (cut_tac nsumEqFunc_sub [of "f" "g" "n"])
  apply simp+
  done          nsumEqFunc --> nsum_eq       **)
(********)(********)

lemma (in Ring) npeSum2_sub_mulx: "[| x ∈ carrier R; y ∈ carrier R |] ==>
  x ·r (nsum R (λ i. nscal R ((npow R x (n-i)) ·r (npow R y i)) 
                                                        (n choose i)) n)
   = (nsum R (λi. nscal R
                          ((npow R x (Suc n - Suc i)) ·r (npow R y (Suc i)))
                          (n choose Suc i)) n) ± 
                (nscal R ((npow R x (Suc n - 0)) ·r (npow R y 0))
                        (Suc n choose 0))" 
  apply (cut_tac ring_is_ag)
  apply (simp only: binomial_n0)
  apply (subst aGroup.nsumElmTail [THEN sym, of R "λ i. nscal R ((npow R x (Suc n - i)) ·r (npow R y i)) (n choose i)"], assumption+)
  apply (rule allI)
      apply (simp only:nsClose add:ring_tOp_closed add:npClose)

  apply (simp only:nsum_suc)
  apply (subst binomial_ngt_0)
  apply (simp only:nscal_0) 
  apply (subst aGroup.ag_r_zero, assumption)
    apply (simp add:aGroup.nsum_mem nsClose ring_tOp_closed npClose)
  apply (subst nsumMulElmL [of  _ "x"])
    apply (rule allI, rule nsClose, rule ring_tOp_closed, simp add:npClose,
           simp add:npClose, assumption)

  apply (simp add: nsMulDistrL [of "x"] ring_tOp_closed npClose)
  apply (simp add:ring_tOp_assoc [THEN sym, of "x"] npClose)
  apply (rule aGroup.nsum_eq, assumption)
   apply (rule allI, rule impI,
          rule nsClose, (rule ring_tOp_closed)+, assumption,
          simp add:npClose, simp add:npClose)
   apply (rule allI, rule impI,
          rule nsClose, rule ring_tOp_closed,
          simp add:npClose, simp add:npClose)
  apply (rule allI, rule impI)
  apply (frule_tac n = "n - j" in npClose[of x],
        simp add:ring_tOp_commute[of x],
        subst npow_suc[THEN sym])
  apply (simp add:Suc_diff_le)
done

lemma (in Ring) npeSum2_sub_mulx2:
  "[| x ∈ carrier R; y ∈ carrier R |] ==>
        x ·r (nsum R (λ i. nscal R ((npow R x (n-i)) ·r (npow R y i))
                                (n choose i)) n)
        = (nsum R  (λi. nscal R
                          ((npow R x (n - i)) ·r ((npow R y i) ·r y ))
                          (n choose Suc i)) n) ± 
                (\<zero> ± ((x ·r (npow R x n)) ·r (1r)))"
apply (subst  npeSum2_sub_mulx, assumption+, simp)
apply (frule npClose[of x n])
apply (subst ring_tOp_commute[of x], assumption+)
 apply (cut_tac ring_is_ag)
 apply (cut_tac aGroup.nsum_eq[of R n
        "λi.  (n choose Suc i) ×R (x^R (n - i) ·r y^R (Suc i))" 
        "λi.  (n choose Suc i) ×R (x^R (n - i) ·r (y^R i ·r y))"])
 apply (simp del:npow_suc)+
  apply (rule allI, rule impI,
         rule nsClose, rule ring_tOp_closed, simp add:npClose,
         simp only:npClose)
  apply (rule allI, rule impI,
         rule nsClose, rule ring_tOp_closed, simp add:npClose,
         rule ring_tOp_closed, simp add:npClose, assumption)
  apply (rule allI, rule impI)
 apply (frule_tac n = j in npClose[of y])
 apply simp
done
   

lemma (in Ring) npeSum2:
  "!! n. [| x ∈ carrier R; y ∈ carrier R |]
        ==> npow R (x ± y) n =
                nsum R (λ i. nscal R ((npow R x (n-i)) ·r (npow R y i))
                                       ( n choose i) ) n"
  apply (cut_tac ring_is_ag)
  apply (induct_tac "n")

  (*1*)
  apply simp
    apply (cut_tac ring_one, simp add:ring_r_one, simp add:aGroup.ag_l_zero)
  (*1:done*)

  apply (subst aGroup.nsumElmTail, assumption+)
    apply (rule allI)
    apply (simp add:nsClose ring_tOp_closed npClose)

(**
thm binomial_Suc_Suc
**)
  apply (simp only:binomial_Suc_Suc)
  apply (simp only: nsDistr [THEN sym] add:npClose ring_tOp_closed)
  apply (subst aGroup.nsumElmAdd, assumption+)
    apply (rule allI,
           simp add:nsClose ring_tOp_closed npClose)
    apply (rule allI,
           simp add:nsClose add:ring_tOp_closed npClose)
  apply (subst aGroup.ag_pOp_assoc, assumption)
    apply (rule aGroup.nsum_mem, assumption, 
           rule allI, rule impI,  simp add:nsClose ring_tOp_closed npClose)
    apply (rule aGroup.nsum_mem, assumption, 
           rule allI, rule impI,  simp add:nsClose ring_tOp_closed npClose)
    apply (simp add:nsClose ring_tOp_closed npClose)
    apply (rule aGroup.ag_pOp_closed, assumption) 
    apply (simp add:aGroup.ag_inc_zero)
    apply (rule ring_tOp_closed)+
    apply (simp add:npClose, assumption, simp add:ring_one)

  apply (subst npMulElmL [THEN sym, of "x ± y"],
         simp add:aGroup.ag_pOp_closed, simp) 
   apply simp
  apply (subst ring_distrib2 [of _ "x" "y"])
  apply (rule aGroup.nsum_mem,assumption,
         rule allI, rule impI, rule nsClose, rule ring_tOp_closed,
         simp add:npClose, simp add:npClose, assumption+)
  apply (rule aGroup.gEQAddcross [THEN sym], assumption+,
         rule aGroup.nsum_mem, assumption, rule allI, rule impI, rule nsClose, 
         (rule ring_tOp_closed)+, simp add:npClose,
         rule ring_tOp_closed, simp add:npClose, assumption)
    apply (rule aGroup.ag_pOp_closed, assumption)
    apply (rule aGroup.nsum_mem, assumption,
           rule allI, rule impI, rule nsClose, rule ring_tOp_closed,
          simp add:npClose, rule ring_tOp_closed, simp add:npClose, assumption)
    apply (rule aGroup.ag_pOp_closed, assumption, simp add:ring_zero) 
    apply ((rule ring_tOp_closed)+,
           simp add:npClose,assumption, simp add:ring_one) 
    apply (rule ring_tOp_closed, assumption,
           rule aGroup.nsum_mem, assumption, rule allI, rule impI, 
           rule nsClose, rule ring_tOp_closed,
           (simp add:npClose)+)
    apply (rule ring_tOp_closed, assumption+,
           rule aGroup.nsum_mem, assumption, rule allI, rule impI,
           rule nsClose,
           rule ring_tOp_closed,
           simp add:npClose, simp add:npClose)
    apply (subst npeSum2_sub_muly [of "x" "y"], assumption+, simp)

  (* final part *)
  apply (subst npeSum2_sub_mulx2 [of x y], assumption+)
  apply (frule_tac n = na in npClose[of x],
         simp add:ring_tOp_commute[of _ x])
  done

lemma (in aGroup) nsum_zeroTr:
  "!! n. (∀ i. i ≤ n -->  f i = \<zero>) --> (nsum A f n = \<zero>)";
  apply (induct_tac "n")
  apply simp

  apply (rule impI)
  apply (cut_tac n = na in Nsetn_sub_mem1, simp)
    apply (subst aGroup.ag_l_zero, rule aGroup_axioms)
    apply (simp add:ag_inc_zero)
  apply simp
  done

lemma (in Ring) npAdd:
  "[| x ∈ carrier R; y ∈ carrier R;
     npow R x m = \<zero>; npow R y n = \<zero> |]
        ==> npow R (x ± y) (m + n) = \<zero>"
  apply (subst npeSum2, assumption+)

  apply (rule aGroup.nsum_zeroTr [THEN mp])
  apply (simp add:ring_is_ag)
  apply (rule allI, rule impI)
  apply (rule nsZeroI) 
  apply (rule rMulZeroDiv, simp add:npClose, simp add:npClose)

  apply (case_tac "i ≤ n")

  apply (rule disjI1)
  apply (rule npGTPowZero [of "x" "m"], assumption+)
    apply arith

  apply (rule disjI2)
  apply (rule npGTPowZero [of "y" "n"], assumption+)
    apply (arith)
  done

lemma (in Ring) npInverse:
  "!!n. x ∈ carrier R 
        ==> npow R (-a x) n = npow R x n 
            ∨ npow R (-a x) n = -a (npow R x n)"
  apply (induct_tac n)
 (* n=0 *)
  apply simp

 apply (erule disjE)
 apply simp
 apply (subst ring_inv1_2,
        simp add:npClose, assumption, simp)
 apply (cut_tac ring_is_ag)

 apply simp
 apply (subst ring_inv1_2[THEN sym, of _ x]) 
 apply (rule aGroup.ag_mOp_closed, assumption+,
        simp add:npClose, assumption)
 apply (thin_tac "(-a x)^R na = -a (x^R na)",
        frule_tac n = na in npClose[of x],
        frule_tac x = "x^R na" in aGroup.ag_mOp_closed[of R], simp add:npClose)
 apply (simp add: ring_inv1_1[of _ x])
 apply (simp add:aGroup.ag_inv_inv[of R])
done

lemma (in Ring) npMul:
  "!! n. [| x ∈ carrier R; y ∈ carrier R |]
        ==> npow R (x ·r y) n = (npow R x n) ·r (npow R y n)"
  apply (induct_tac "n")
 (* n=0 *)
  apply simp
  apply (rule ring_r_one [THEN sym]) apply (simp add:ring_one)
 (* n>0 *)
  apply (simp only:npow_suc)
  apply (rule ring_tOp_rel[THEN sym])
    apply (rule npClose, assumption+)+
  done

section "3. ring homomorphisms"

constdefs
 rHom :: "[('a, 'm) Ring_scheme, ('b, 'm1) Ring_scheme] 
                      => ('a  => 'b) set"
  "rHom A R == {f. f ∈ aHom A R ∧
   (∀x∈carrier A. ∀y∈carrier A. f ( x ·rA y) =  (f x) ·rR (f y)) 
   ∧ f (1rA) = (1rR)}"
  
constdefs
  rInvim :: "[('a, 'm) Ring_scheme, ('b, 'm1) Ring_scheme, 'a => 'b, 'b set]
               => 'a set"
  "rInvim A R f K == {a. a ∈ carrier A ∧ f a ∈ K}"

constdefs
  rimg::"[('a, 'm) Ring_scheme, ('b, 'm1) Ring_scheme, 'a => 'b] =>
            'b Ring"
  "rimg A R f == (|carrier= f `(carrier A), pop = pop R, mop = mop R,
  zero = zero R, tp = tp R, un = un R |)),"

constdefs
 ridmap::"('a, 'm) Ring_scheme => ('a => 'a)"
 "ridmap R == λx∈carrier R. x"

constdefs
 r_isom::"[('a, 'm) Ring_scheme, ('b, 'm1) Ring_scheme] => bool"
                       (infixr "≅r" 100)
 "r_isom R R' == ∃f∈rHom R R'. bijecR,R' f"

constdefs 
 Subring::"[('a, 'm) Ring_scheme, ('a, 'm1) Ring_scheme] => bool"
  "Subring R S == Ring S ∧ (carrier S ⊆ carrier R) ∧ (ridmap S) ∈ rHom S R" 

lemma ridmap_surjec:"Ring A ==> surjecA,A (ridmap A)"
apply (simp add:surjec_def)
 apply (rule conjI,
        simp add:aHom_def,
        rule conjI, rule univar_func_test, rule ballI, simp add:ridmap_def)
 apply (rule conjI,
        simp add:ridmap_def)
 apply ((rule ballI)+,
       simp add:ridmap_def,
       frule Ring.ring_is_ag[of "A"], simp add:aGroup.ag_pOp_closed)

apply (simp add:surj_to_def ridmap_def)
done

lemma rHom_aHom:"f ∈ rHom A R ==> f ∈ aHom A R"
apply (simp add:rHom_def)
done

lemma rimg_carrier:"f ∈ rHom A R ==> carrier (rimg A R f) = f ` (carrier A)"
apply (simp add:rimg_def)
done

lemma rHom_mem:"[| f ∈ rHom A R; a ∈ carrier A |] ==> f a ∈ carrier R"
apply (simp add:rHom_def, frule conjunct1)
 apply (thin_tac "f ∈ aHom A R ∧
     (∀x∈carrier A. ∀y∈carrier A. f (x ·rA y) = f x ·rR f y) ∧ f 1rA = 1rR")
 apply (simp add:aHom_def, frule conjunct1)
 apply (thin_tac "f ∈ carrier A -> carrier R ∧
     f ∈ extensional (carrier A) ∧
     (∀a∈carrier A. ∀b∈carrier A. f (a ±A b) = f a ±R f b)") 
 apply (simp add:funcset_mem)
done

lemma rHom_func:"f ∈ rHom A R ==> f ∈ carrier A -> carrier R"
by (simp add:rHom_def aHom_def)

lemma ringhom1:"[| Ring A; Ring R; x ∈ carrier A; y ∈ carrier A; 
                    f ∈ rHom A R |] ==> f (x ±A y) = (f x) ±R (f y)"
apply (simp add:rHom_def) apply (erule conjE)
apply (frule Ring.ring_is_ag [of "A"])
apply (frule Ring.ring_is_ag [of "R"])
apply (rule aHom_add, assumption+)
done

lemma rHom_inv_inv:"[| Ring A; Ring R; x ∈ carrier A; f ∈ rHom A R |] 
 ==> f (-aA x) = -aR (f x)"
apply (frule Ring.ring_is_ag [of "A"],
       frule Ring.ring_is_ag [of "R"])
apply (simp add:rHom_def, erule conjE)
apply (simp add:aHom_inv_inv)
done

lemma rHom_0_0:"[| Ring A; Ring R; f ∈ rHom A R |]  ==> f (\<zero>A) = \<zero>R"
apply (frule Ring.ring_is_ag [of "A"], frule Ring.ring_is_ag [of "R"])
apply (simp add:rHom_def, (erule conjE)+, simp add:aHom_0_0)
done

lemma rHom_tOp:"[| Ring A; Ring R; x ∈ carrier A; y ∈ carrier A; 
 f ∈ rHom A R |] ==> f (x ·rA y) = (f x) ·rR (f y)"
by (simp add:rHom_def)

lemma rHom_add:"[|f ∈ rHom A R; x ∈ carrier A; y ∈ carrier A|] ==>
                   f (x ±A y) = (f x) ±R (f y)"
by (simp add:rHom_def aHom_def)

lemma rHom_one:"[| Ring A; Ring R;f ∈ rHom A R |] ==> f (1rA) = (1rR)" 
by (simp add:rHom_def)

lemma rHom_npow:"[| Ring A; Ring R; x ∈ carrier A; f ∈ rHom A R |] ==> 
                    f (x^A n) = (f x)^R n"
apply (induct_tac n)
apply (simp add:rHom_one) 
apply (simp,
      frule_tac n = n in Ring.npClose[of "A" "x"], assumption+,
      subst rHom_tOp[of "A" "R" _ "x" "f"], assumption+, simp)
done  

lemma rHom_compos:"[|Ring A; Ring B; Ring C; f ∈ rHom A B; g ∈ rHom B C|] ==>
                   compos A g f ∈ rHom A C"
apply (subst rHom_def, simp)
apply (frule Ring.ring_is_ag[of "A"], frule Ring.ring_is_ag[of "B"],
       frule Ring.ring_is_ag[of "C"], 
       frule rHom_aHom[of "f" "A" "B"], frule rHom_aHom[of "g" "B" "C"],
       simp add:aHom_compos)
apply (rule conjI)
 apply ((rule ballI)+, simp add:compos_def compose_def,
        frule_tac x = x and y = y in Ring.ring_tOp_closed[of "A"], assumption+,
        simp)
apply (simp add:rHom_tOp)
 apply (frule_tac a = x in rHom_mem[of "f" "A" "B"], assumption+,
        frule_tac a = y in rHom_mem[of "f" "A" "B"], assumption+,
         simp add:rHom_tOp)
 apply (frule Ring.ring_one[of "A"], frule Ring.ring_one[of "B"],
        simp add:compos_def compose_def, simp add:rHom_one)
done

lemma rimg_ag:"[|Ring A; Ring R; f ∈ rHom A R|] ==> aGroup (rimg A R f)"
apply (frule Ring.ring_is_ag [of "A"],
       frule Ring.ring_is_ag [of "R"])
apply (simp add:rHom_def, (erule conjE)+)
apply (subst aGroup_def)
apply (simp add:rimg_def)
apply (rule conjI)
 apply (rule bivar_func_test)
 apply (rule ballI)+
 apply (simp add:image_def)
 apply (erule bexE)+
 apply simp 
 apply (subst aHom_add [THEN sym, of "A" "R" "f"], assumption+)
 apply (frule_tac x = x and y = xa in aGroup.ag_pOp_closed, assumption+,
        blast)
apply (rule conjI)
 apply ((rule allI, rule impI)+, simp add:image_def, (erule bexE)+, simp)
 apply (frule_tac x = x and y = xa in aGroup.ag_pOp_closed, assumption+,
        frule_tac x = xa and y = xb in aGroup.ag_pOp_closed, assumption+)
 apply (simp add:aHom_add[of "A" "R" "f", THEN sym] aGroup.ag_pOp_assoc)
apply (rule conjI)
 apply ((rule allI, rule impI)+, simp add:image_def, (erule bexE)+, simp) 
 apply (simp add:aHom_add[of "A" "R" "f", THEN sym] aGroup.ag_pOp_commute)
apply (rule conjI)
 apply (rule univar_func_test, rule ballI)
 apply (simp add:image_def, erule bexE, simp)
 apply (simp add:aHom_inv_inv[THEN sym],
        frule_tac x = xa in aGroup.ag_mOp_closed[of "A"], assumption+, blast)
apply (rule conjI)
  apply (rule allI, rule impI, simp add:image_def, (erule bexE)+, simp) 
   apply (simp add:aHom_inv_inv[THEN sym],
        frule_tac x = x in aGroup.ag_mOp_closed[of "A"], assumption+,
        simp add:aHom_add[of "A" "R" "f", THEN sym])
 apply (simp add:aGroup.ag_l_inv1 aHom_0_0)
apply (rule conjI)
 apply (simp add:image_def)
 apply (frule aHom_0_0[THEN sym, of "A" "R" "f"], assumption+,
        frule Ring.ring_zero[of "A"], blast)
 
apply (rule allI, rule impI,
       simp add:image_def, erule bexE,
       frule_tac a = x in aHom_mem[of "A" "R" "f"], assumption+, simp)
 apply (simp add:aGroup.ag_l_zero)
done 

lemma rimg_ring:"[|Ring A; Ring R; f ∈ rHom A R |] ==> Ring (rimg A R f)"
apply (unfold Ring_def [of "rimg A R f"])
apply (frule rimg_ag[of "A" "R" "f"], assumption+)
 apply (rule conjI, simp add:aGroup_def[of "rimg A R f"])
apply(rule conjI)
 apply (rule conjI, rule allI, rule impI)
 apply (frule aGroup.ag_inc_zero[of "rimg A R f"],
        subst aGroup.ag_pOp_commute, assumption+,
        simp add:aGroup.ag_r_zero[of "rimg A R f"])
      
apply (rule conjI)
apply (rule bivar_func_test, (rule ballI)+)
apply (thin_tac "aGroup (rimg A R f)",
       simp add:rimg_def, simp add:image_def, (erule bexE)+, 
       simp add:rHom_tOp[THEN sym])
 apply (frule_tac x = x and y = xa in Ring.ring_tOp_closed, assumption+,
        blast)
 apply ((rule allI)+, (rule impI)+)
 apply (thin_tac "aGroup (rimg A R f)", simp add:rimg_def,
        simp add:image_def, (erule bexE)+, simp)
 apply (frule_tac x = x and y = xa in Ring.ring_tOp_closed, assumption+,
        frule_tac x = xa and y = xb in Ring.ring_tOp_closed, assumption+,
        simp add:rHom_tOp[THEN sym],
        simp add:Ring.ring_tOp_assoc)
apply (rule conjI, rule conjI, (rule allI)+, (rule impI)+)
 apply (thin_tac "aGroup (rimg A R f)", simp add:rimg_def,
        simp add:image_def, (erule bexE)+, simp,
        simp add:rHom_tOp[THEN sym],
        simp add:Ring.ring_tOp_commute)
  apply (thin_tac "aGroup (rimg A R f)", simp add:rimg_def,
         simp add:image_def)
  apply (subst rHom_one [THEN sym, of "A" "R" "f"], assumption+,
         frule Ring.ring_one[of "A"], blast)
apply (rule conjI, (rule allI)+, (rule impI)+)
apply (simp add:rimg_def, fold rimg_def,
       simp add:image_def, (erule bexE)+, simp) 
 apply (frule rHom_aHom[of "f" "A" "R"],
        frule Ring.ring_is_ag [of "A"],
        frule Ring.ring_is_ag [of "R"],
        simp add:aHom_add[THEN sym],
        simp add:rHom_tOp[THEN sym])
 apply (frule_tac x = xa and y = xb in aGroup.ag_pOp_closed[of "A"],
          assumption+,
        frule_tac x = x and y = xa in Ring.ring_tOp_closed[of "A"],
          assumption+,
        frule_tac x = x and y = xb in Ring.ring_tOp_closed[of "A"],
          assumption+,
        simp add:aHom_add[THEN sym],
        simp add:rHom_tOp[THEN sym],
        simp add:Ring.ring_distrib1)
 apply (rule allI, rule impI,
        thin_tac "aGroup (rimg A R f)")
 apply (simp add:rimg_def,
        simp add:image_def, erule bexE, simp add:rHom_tOp[THEN sym],
        frule_tac a = x in rHom_mem[of "f" "A" "R"], assumption+,
         simp add:Ring.ring_l_one)
done

constdefs (structure R)
 ideal::"[_ , 'a set] => bool"
  "ideal R I == (R +> I) ∧ (∀r∈carrier R. ∀x∈I. (r ·r x ∈ I))"

translations
    "f°F,G " == "rind_hom F G f"
                                                          (* tOp -> pOp *) 

lemma (in Ring) ideal_asubg:"ideal R I ==> R +> I"
by (simp add:ideal_def)

lemma (in Ring) ideal_pOp_closed:"[|ideal R I; x ∈ I; y ∈ I |] 
                                                   ==> x ± y ∈ I"
apply (unfold ideal_def, frule conjunct1, fold ideal_def)
apply (cut_tac ring_is_ag,
       simp add:aGroup.asubg_pOp_closed)
done

lemma (in Ring) ideal_nsum_closedTr:"ideal R I ==> 
                                      (∀j ≤ n. f j ∈ I) -->  nsum R f n ∈ I"
apply (induct_tac n)
 apply (rule impI)
 apply simp 
 
 apply (rule impI) 
 apply (cut_tac n = n in Nsetn_sub_mem1, simp)
 apply (rule ideal_pOp_closed, assumption+)
 apply simp
done

lemma (in Ring) ideal_nsum_closed:"[|ideal R I; ∀j ≤ n. f j ∈ I|] ==>
                                             nsum R f n ∈ I"
by (simp add:ideal_nsum_closedTr)

lemma (in Ring) ideal_subset1:"ideal R I ==> I ⊆ carrier R"
apply (unfold ideal_def, frule conjunct1, fold ideal_def)
  apply (simp add:asubGroup_def sg_def, (erule conjE)+)
  apply (cut_tac ring_is_ag,
         simp add:aGroup.ag_carrier_carrier)
done

lemma (in Ring) ideal_subset:"[|ideal R I; h ∈ I|] ==> h ∈ carrier R"
by (frule ideal_subset1[of "I"],
       simp add:subsetD)

lemma (in Ring) ideal_ring_multiple:"[|ideal R I; x ∈ I; r ∈ carrier R|] ==>
       r ·r x ∈ I"
by (simp add:ideal_def)

lemma (in Ring) ideal_ring_multiple1:"[|ideal R I; x ∈ I; r ∈ carrier R |] ==>
       x ·r r ∈ I"
apply (frule ideal_subset[of "I" "x"], assumption+)
apply (simp add:ring_tOp_commute ideal_ring_multiple)
done

lemma (in Ring) ideal_npow_closedTr:"[|ideal R I; x ∈ I|] ==> 
                                        0 < n --> x^R n ∈ I"
apply (induct_tac n,
       simp)
apply (rule impI)
 apply simp
 apply (case_tac "n = 0", simp)
 apply (frule ideal_subset[of "I" "x"], assumption+,
        simp add:ring_l_one)
 
 apply simp
apply (frule ideal_subset[of "I" "x"], assumption+,
       rule ideal_ring_multiple, assumption+,
       simp add:ideal_subset)
done

lemma (in Ring) ideal_npow_closed:"[|ideal R I; x ∈ I; 0 < n|] ==> x^R n ∈ I"
by (simp add:ideal_npow_closedTr)

lemma (in Ring) times_modTr:"[|a ∈ carrier R; a' ∈ carrier R; b ∈ carrier R;
 b' ∈ carrier R; ideal R I; a ± (-a b) ∈ I; a' ± (-a b') ∈ I|] ==>
                           a ·r a' ± (-a (b ·r b')) ∈ I"
apply (cut_tac ring_is_ag)
apply (subgoal_tac "a ·r a' ± (-a (b ·r b')) = a ·r a' ± (-a (a ·r b')) 
                       ± (a ·r b' ± (-a (b ·r b')))")
apply simp
 apply (simp add:ring_inv1_2[of "a" "b'"], simp add:ring_inv1_1[of "b" "b'"])
 apply (frule aGroup.ag_mOp_closed[of "R" "b'"], assumption+)
 apply (simp add:ring_distrib1[THEN sym, of "a" "a'" "-a b'"])
 apply (frule aGroup.ag_mOp_closed[of "R" "b"], assumption+)
 apply (frule ring_distrib2[THEN sym, of "b'" "a" "-a b" ], assumption+)
 apply simp
 
apply (thin_tac "a ·r a' ± (-a b) ·r b' = a ·r (a' ± -a b') ± (a ± -a b) ·r b'",
       thin_tac "a ·r b' ± (-a b) ·r b' = (a ± -a b) ·r b'")
 apply (frule ideal_ring_multiple[of "I" "a' ± (-a b')" "a"], assumption+,
        frule ideal_ring_multiple1[of "I" "a ± (-a b)" "b'"], assumption+)
 apply (simp add:ideal_pOp_closed)

apply (frule ring_tOp_closed[of "a" "a'"], assumption+,
       frule ring_tOp_closed[of "a" "b'"], assumption+,
       frule ring_tOp_closed[of "b" "b'"], assumption+,
       frule aGroup.ag_mOp_closed[of "R" "b ·r b'"], assumption+,
       frule aGroup.ag_mOp_closed[of "R" "a ·r b'"], assumption+)

 apply (subst aGroup.ag_pOp_assoc[of "R"], assumption+)
 apply (rule aGroup.ag_pOp_closed, assumption+)
 apply (simp add:aGroup.ag_pOp_assoc[THEN sym, of "R" "-a (a ·r b')" "a ·r b'" 
                          "-a (b ·r b')"],
        simp add:aGroup.ag_l_inv1 aGroup.ag_l_zero)
done

lemma (in Ring) ideal_inv1_closed:"[| ideal R I; x ∈ I |] ==> -a x ∈ I"
apply (cut_tac ring_is_ag)
apply (unfold ideal_def, frule conjunct1, fold ideal_def)
apply (simp add:aGroup.asubg_mOp_closed[of "R" "I"])
done

lemma (in Ring) ideal_zero:"ideal R I  ==> \<zero> ∈ I"

apply (cut_tac ring_is_ag)
apply (unfold ideal_def, frule conjunct1, fold ideal_def)
apply (simp add:aGroup.asubg_inc_zero)
done

lemma (in Ring) ideal_zero_forall:"∀I. ideal R I -->  \<zero> ∈ I"
by (simp add:ideal_zero)

lemma (in Ring) ideal_ele_sumTr1:"[| ideal R I; a ∈ carrier R; b ∈ carrier R;
          a ± b ∈ I; a ∈ I |] ==> b ∈ I"
apply (frule ideal_inv1_closed[of "I" "a"], assumption+)
apply (frule ideal_pOp_closed[of "I" "-a a" "a ± b"], assumption+)
apply (frule ideal_subset[of "I" "-a a"], assumption+)
apply (cut_tac ring_is_ag,
       simp add:aGroup.ag_pOp_assoc[THEN sym],
       simp add:aGroup.ag_l_inv1,
       simp add:aGroup.ag_l_zero)
done

lemma (in Ring) ideal_ele_sumTr2:"[|ideal R I; a ∈ carrier R; b ∈ carrier R;
                a ± b ∈ I; b ∈ I|] ==> a ∈ I"
apply (cut_tac ring_is_ag,
       simp add:aGroup.ag_pOp_commute[of "R" "a" "b"])
apply (simp add:ideal_ele_sumTr1[of "I" "b" "a"])
done

lemma (in Ring) ideal_condition:"[|I ⊆ carrier R; I ≠ {}; 
       ∀x∈I. ∀y∈I. x ± (-a y) ∈ I; ∀r∈carrier R. ∀x∈I. r ·r x ∈ I |] ==> 
                                   ideal R I" 
apply (simp add:ideal_def)
 apply (cut_tac ring_is_ag)
 apply (rule aGroup.asubg_test[of "R" "I"], assumption+)
done

lemma (in Ring) ideal_condition1:"[|I ⊆ carrier R; I ≠ {}; 
  ∀x∈I. ∀y∈I. x ± y ∈ I; ∀r∈carrier R. ∀x∈I. r ·r x ∈ I |] ==> ideal R I"
apply (rule ideal_condition[of "I"], assumption+)
apply (rule ballI)+
apply (cut_tac ring_is_ag,
       cut_tac ring_one,
       frule aGroup.ag_mOp_closed[of "R" "1r"], assumption+)
 apply (frule_tac b = "-a 1r " in forball_spec1, assumption+,
        thin_tac "∀r∈carrier R. ∀x∈I. r ·r x ∈ I",
        rotate_tac -1,
        frule_tac b = y in forball_spec1, assumption,
        thin_tac "∀x∈I. (-a 1r) ·r x ∈ I")
 apply (frule_tac c = y in subsetD[of "I" "carrier R"], assumption+,
        simp add:ring_times_minusl[THEN sym], simp add:ideal_pOp_closed) 
done
 
lemma (in Ring) zero_ideal:"ideal R {\<zero>}"
apply (cut_tac ring_is_ag)
apply (rule ideal_condition1)
 apply (simp add:ring_zero)
 apply simp
 apply simp
apply (cut_tac ring_zero, simp add:aGroup.ag_l_zero)
apply simp
 apply (rule ballI, simp add:ring_times_x_0)
done

lemma (in Ring) whole_ideal:"ideal R (carrier R)"
apply (rule ideal_condition1)
 apply simp
 apply (cut_tac ring_zero, blast)
 apply (cut_tac ring_is_ag,
        simp add:aGroup.ag_pOp_closed,
        simp add:ring_tOp_closed)
done

lemma (in Ring) ideal_inc_one:"[|ideal R I; 1r ∈ I |] ==> I = carrier R"
apply (rule equalityI)
apply (simp add:ideal_subset1)
apply (rule subsetI,
       frule_tac r = x in ideal_ring_multiple[of "I" "1r"], assumption+,
       simp add:ring_r_one)
done

lemma (in Ring) ideal_inc_one1:"ideal R I ==>
                              (1r ∈ I) = (I = carrier R)"
apply (rule iffI)
 apply (simp add:ideal_inc_one)
 apply (frule sym, thin_tac "I = carrier R", 
        cut_tac ring_one, simp)
done

constdefs (structure R)
  Unit :: "_ => 'a => bool"
  "Unit R a == a ∈ carrier R ∧ (∃b∈carrier R. a ·r b = 1r)"

lemma (in Ring) ideal_inc_unit:"[|ideal R I; a ∈ I; Unit R a|] ==> 1r ∈ I"
by (simp add:Unit_def, erule conjE, erule bexE,
       frule_tac r = b in ideal_ring_multiple1[of "I" "a"], assumption+,
       simp)

lemma (in Ring) proper_ideal:"[|ideal R I; 1r ∉ I|] ==> I ≠ carrier R"
apply (rule contrapos_pp, simp+)
apply (simp add: ring_one)
done

lemma (in Ring) ideal_inc_unit1:"[|a ∈ carrier R; Unit R a; ideal R I; a ∈ I|]
                        ==> I = carrier R"
apply (frule ideal_inc_unit[of "I" "a"], assumption+)
apply (rule ideal_inc_one[of "I"], assumption+)
done

lemma (in Ring) int_ideal:"[|ideal R I; ideal R J|] ==> ideal R (I ∩ J)"
apply (rule ideal_condition1)
apply (frule ideal_subset1[of "I"], frule ideal_subset1[of "J"])
 apply blast
 apply (frule ideal_zero[of "I"], frule ideal_zero[of "J"], blast)

 apply ((rule ballI)+, simp, (erule conjE)+,
         simp add:ideal_pOp_closed)
 apply ((rule ballI)+, simp, (erule conjE)+)
 apply (simp add:ideal_ring_multiple)
done

constdefs (structure R)
   ideal_prod::"[_, 'a set, 'a set] => 'a set" (infix "♦r\<index>" 90 )
   "ideal_prod R I J == \<Inter> {L. ideal R L ∧ 
                               {x.(∃i∈I. ∃j∈J. x = i ·r j)} ⊆ L}"

lemma (in Ring) set_sum_mem:"[|a ∈ I; b ∈ J; I ⊆ carrier R; J ⊆ carrier R|] ==>
             a ± b ∈ I \<minusplus> J"
apply (cut_tac ring_is_ag)
apply (simp add:aGroup.set_sum, blast) 
done
 
lemma (in Ring) sum_ideals:"[|ideal R I1; ideal R I2|] ==> ideal R (I1 \<minusplus> I2)"
apply (cut_tac ring_is_ag)
apply (frule ideal_subset1[of "I1"], frule ideal_subset1[of "I2"])
apply (rule ideal_condition1)
 apply (rule subsetI, simp add:aGroup.set_sum, (erule bexE)+)
 apply (frule_tac h = h in ideal_subset[of "I1"], assumption+,
        frule_tac h = k in ideal_subset[of "I2"], assumption+,
        cut_tac ring_is_ag,
        simp add:aGroup.ag_pOp_closed)
 apply (frule ideal_zero[of "I1"], frule ideal_zero[of "I2"],
        frule set_sum_mem[of "\<zero>" "I1" "\<zero>" "I2"], assumption+, blast) 
apply (rule ballI)+
 apply (simp add:aGroup.set_sum, (erule bexE)+, simp)
 apply (rename_tac x y i ia j ja)
 apply (frule_tac h = i in ideal_subset[of "I1"], assumption+,
        frule_tac h = ia in ideal_subset[of "I1"], assumption+,
        frule_tac h = j in ideal_subset[of "I2"], assumption+,
        frule_tac h = ja in ideal_subset[of "I2"], assumption+)
 apply (subst aGroup.pOp_assocTr43, assumption+)
 apply (frule_tac x = j and y = ia in aGroup.ag_pOp_commute[of "R"],
          assumption+, simp)
 apply (subst aGroup.pOp_assocTr43[THEN sym], assumption+)
 apply (frule_tac x = i and y = ia in ideal_pOp_closed[of "I1"], assumption+,
        frule_tac x = j and y = ja in ideal_pOp_closed[of "I2"], assumption+,
        blast)
apply (rule ballI)+
 apply (simp add:aGroup.set_sum, (erule bexE)+, simp)
 apply (rename_tac r x i j)
 apply (frule_tac h = i in ideal_subset[of "I1"], assumption+,
        frule_tac h = j in ideal_subset[of "I2"], assumption+)
 apply (simp add:ring_distrib1)
 apply (frule_tac x = i and r = r in ideal_ring_multiple[of "I1"], assumption+,
        frule_tac x = j and r = r in ideal_ring_multiple[of "I2"], assumption+,
        blast)
done

lemma (in Ring) sum_ideals_la1:"[|ideal R I1; ideal R I2|] ==> I1 ⊆ (I1 \<minusplus> I2)"
apply (cut_tac ring_is_ag)
apply (rule subsetI)
apply (frule ideal_zero[of "I2"],
       frule_tac h = x in ideal_subset[of "I1"], assumption+,
       frule_tac x = x in aGroup.ag_r_zero[of "R"], assumption+)
apply (subst aGroup.set_sum, assumption,
       simp add:ideal_subset1, simp add:ideal_subset1, simp,
       frule sym, thin_tac "x ± \<zero> = x", blast)
done

lemma (in Ring) sum_ideals_la2:"[|ideal R I1; ideal R I2 |] ==> I2 ⊆ (I1 \<minusplus> I2)"
apply (cut_tac ring_is_ag)
apply (rule subsetI)
apply (frule ideal_zero[of "I1"],
       frule_tac h = x in ideal_subset[of "I2"], assumption+,
       frule_tac x = x in aGroup.ag_l_zero[of "R"], assumption+)
apply (subst aGroup.set_sum, assumption,
       simp add:ideal_subset1, simp add:ideal_subset1, simp,
       frule sym, thin_tac "\<zero> ± x = x", blast)
done

lemma (in Ring) sum_ideals_cont:"[|ideal R I;  A ⊆ I; B ⊆ I |] ==> A \<minusplus> B ⊆ I"
apply (cut_tac ring_is_ag)
apply (rule subsetI)
 apply (frule ideal_subset1[of I],
        frule subset_trans[of A I "carrier R"], assumption+,
        frule subset_trans[of B I "carrier R"], assumption+)
 apply (simp add:aGroup.set_sum[of R], (erule bexE)+, simp) 
 apply (frule_tac c = h in subsetD[of "A" "I"], assumption+,
        frule_tac c = k in subsetD[of "B" "I"], assumption+)
 apply (simp add:ideal_pOp_closed)
done

lemma (in Ring) ideals_set_sum:"[|ideal R A; ideal R B; x ∈ A \<minusplus> B|] ==>
             ∃h∈A. ∃k∈B. x = h ± k"
apply (frule ideal_subset1[of A],
       frule ideal_subset1[of B])
apply (cut_tac ring_is_ag,
       simp add:aGroup.set_sum)
done

constdefs (structure R)
  Rxa :: "[_, 'a ] => 'a set" (infixl "♦p" 200) 
  "Rxa R a == {x. ∃r∈carrier R. x = (r ·r a)}"

lemma (in Ring) a_in_principal:"a ∈ carrier R ==> a ∈ Rxa R a"
apply (cut_tac ring_one,
       frule ring_l_one[THEN sym, of "a"])
apply (simp add:Rxa_def, blast)
done

lemma (in Ring) principal_ideal:"a ∈ carrier R ==> ideal R (Rxa R a)"
apply (rule ideal_condition1)
  apply (rule subsetI,
         simp add:Rxa_def, erule bexE, simp add:ring_tOp_closed)
apply (frule a_in_principal[of "a"], blast)
apply ((rule ballI)+, 
        simp add:Rxa_def, (erule bexE)+, simp,
        subst ring_distrib2[THEN sym], assumption+,
        cut_tac ring_is_ag,
        frule_tac x = r and y = ra in aGroup.ag_pOp_closed, assumption+,
        blast)
apply ((rule ballI)+,
        simp add:Rxa_def, (erule bexE)+, simp,
        simp add:ring_tOp_assoc[THEN sym])
 apply (frule_tac x = r and y = ra in ring_tOp_closed, assumption, blast)
done

lemma (in Ring) rxa_in_Rxa:"[|a ∈ carrier R; r ∈ carrier R|] ==>
                                     r ·r a ∈ Rxa R a"  
by (simp add:Rxa_def, blast)

lemma (in Ring) Rxa_one:"Rxa R 1r = carrier R"
apply (rule equalityI)
 apply (rule subsetI, simp add:Rxa_def, erule bexE)
 apply (simp add:ring_r_one)

 apply (rule subsetI, simp add:Rxa_def)
 apply (frule_tac t = x in ring_r_one[THEN sym], blast)
done

lemma (in Ring) Rxa_zero:"Rxa R \<zero> = {\<zero>}"
apply (rule equalityI) 
apply (rule subsetI)
 apply (simp add:Rxa_def, erule bexE, simp add:ring_times_x_0)
apply (rule subsetI)
 apply (simp add:Rxa_def)
 apply (cut_tac ring_zero,
        frule ring_times_x_0[THEN sym, of "\<zero>"], blast)
done

lemma (in Ring) Rxa_nonzero:"[|a ∈ carrier R; a ≠ \<zero>|] ==> Rxa R a ≠ {\<zero>}"
apply (rule contrapos_pp, simp+)
 apply (frule a_in_principal[of "a"])
 apply simp
done

lemma (in Ring) ideal_cont_Rxa:"[|ideal R I; a ∈ I|] ==> Rxa R a ⊆ I"
apply (rule subsetI)
 apply (simp add:Rxa_def, erule bexE, simp)
 apply (simp add:ideal_ring_multiple)
done

lemma (in Ring) Rxa_mult_smaller:"[| a ∈ carrier R; b ∈ carrier R|] ==>
                    Rxa R (a ·r b) ⊆ Rxa R b"
apply (frule rxa_in_Rxa[of b a], assumption,
       frule principal_ideal[of b])
apply (rule ideal_cont_Rxa[of "R ♦p b" "a ·r b"], assumption+)
done

lemma (in Ring) id_ideal_psub_sum:"[|ideal R I; a ∈ carrier R; a ∉ I|] ==>
                                             I ⊂ I \<minusplus> Rxa R a"  
apply (cut_tac ring_is_ag)
apply (simp add:psubset_eq) 
apply (frule principal_ideal)
apply (rule conjI)
apply (rule sum_ideals_la1, assumption+)
apply (rule contrapos_pp) apply simp+
apply (frule sum_ideals_la2[of "I" "Rxa R a"], assumption+)
apply (frule a_in_principal[of "a"],
       frule subsetD[of "Rxa R a" "I \<minusplus> Rxa R a" "a"], assumption+)
apply simp
done

lemma (in Ring) mul_two_principal_idealsTr:"[|a ∈ carrier R; b ∈ carrier R;
         x ∈ Rxa R a; y ∈ Rxa R b|] ==> ∃r∈carrier R. x ·r y = r ·r (a ·r b)" 
apply (simp add:Rxa_def, (erule bexE)+)
apply simp
apply (frule_tac x = ra and y = b in ring_tOp_closed, assumption+)
apply (simp add:ring_tOp_assoc)
apply (simp add:ring_tOp_assoc[THEN sym, of a _ b])
apply (simp add:ring_tOp_commute[of a], simp add:ring_tOp_assoc)
apply (frule_tac x = a and y = b in ring_tOp_closed, assumption+,
       thin_tac "ra ·r b ∈ carrier R",
       simp add:ring_tOp_assoc[THEN sym, of _ _ "a ·r b"],
       frule_tac x = r and y = ra in ring_tOp_closed, assumption+)
apply (simp add:ring_tOp_commute[of b a])
apply blast
done

consts 
  sum_pr_ideals::"[('a, 'm) Ring_scheme, nat => 'a, nat] => 'a set"
 
primrec 
 sum_pr0: "sum_pr_ideals R f 0 = Rxa R (f 0)"
 sum_prn: "sum_pr_ideals R f (Suc n) =
                   (Rxa R (f (Suc n))) \<minusplus>R (sum_pr_ideals R f n)"

lemma (in Ring) restrictfun_Nset:"f ∈ {i. i ≤ (Suc n)} -> carrier R
          ==> f ∈ {i. i ≤ n} -> carrier R" 
apply (rule univar_func_test, rule ballI)
apply (rule_tac funcset_mem, assumption+)
apply (cut_tac Nsetn_sub_mem1[of n], simp)
done
                  
lemma (in Ring) sum_of_prideals0:
      "∀f. (∀l ≤ n. f l ∈ carrier R) --> ideal R (sum_pr_ideals R f n)"  
apply (induct_tac n) 
apply (rule allI) apply (rule impI)
 apply simp 
 apply (rule Ring.principal_ideal, rule Ring_axioms, assumption)
(** case n **) 
apply (rule allI, rule impI)
 apply (frule_tac a = f in forall_spec1,
        thin_tac "∀f. (∀l ≤ n. f l ∈ carrier R) -->
               ideal R (sum_pr_ideals R f n)")
 apply (cut_tac n = n in Nsetn_sub_mem1, simp)
 apply (cut_tac a = "f (Suc n)" in  principal_ideal,
       simp)
 apply (rule_tac ?I1.0 = "Rxa R (f (Suc n))" and 
        ?I2.0 = "sum_pr_ideals R f n" in Ring.sum_ideals, rule Ring_axioms, assumption+) 
done

lemma (in Ring) sum_of_prideals:"[|∀l ≤ n. f l ∈ carrier R|] ==>
                      ideal R (sum_pr_ideals R f n)" 
apply (simp add:sum_of_prideals0)
done
 
text {* later, we show sum_pr_ideals is the least ideal containing 
        {f 0, f 1,…, f n} *}

lemma (in Ring) sum_of_prideals1:"∀f. (∀l ≤ n. f l ∈ carrier R) --> 
                                    f ` {i. i ≤ n} ⊆ (sum_pr_ideals R f n)" 
apply (induct_tac n)
 apply (rule allI, rule impI)
apply (simp, simp add:a_in_principal)

apply (rule allI, rule impI)
 apply (frule_tac a = f in forall_spec,
        thin_tac "∀f. (∀l ≤ n. f l ∈ carrier R) -->
               f ` {i. i ≤ n} ⊆ sum_pr_ideals R f n")
 apply (rule allI, cut_tac n = n in Nset_un, simp)

 apply (subst Nset_un)
 apply (cut_tac A = "{i. i ≤ (Suc n)}" and f = f and B = "carrier R" and
        ?A1.0 = "{i. i ≤ n}" and ?A2.0 = "{Suc n}" in im_set_un1,
        simp, rule Nset_un)
 apply (thin_tac "∀f. (∀l≤n. f l ∈ carrier R) -->
               f ` {i. i ≤ n} ⊆ sum_pr_ideals R f n",
        simp) 
 apply (cut_tac n = n and f = f in sum_of_prideals,
        cut_tac n = n in Nsetn_sub_mem1, simp)
 apply (cut_tac a = "f (Suc n)" in principal_ideal, simp)
 apply (frule_tac ?I1.0 = "Rxa R (f (Suc n))" and ?I2.0 = "sum_pr_ideals R f n"
                 in sum_ideals_la1, assumption+,
        cut_tac a = "f (Suc n)" in a_in_principal, simp, 
        frule_tac A = "R ♦p f (Suc n)" and
         B = "R ♦p f (Suc n) \<minusplus> sum_pr_ideals R f n" and c = "f (Suc n)" in 
         subsetD, simp+)
  apply (frule_tac ?I1.0 = "Rxa R (f (Suc n))" and 
         ?I2.0 = "sum_pr_ideals R f n" in sum_ideals_la2, assumption+)
  apply (rule_tac A = "f ` {j. j ≤ n}" and B = "sum_pr_ideals R f n" and
         C = "Rxa R (f (Suc n)) \<minusplus> sum_pr_ideals R f n" in subset_trans, 
         assumption+)
done

lemma (in Ring) sum_of_prideals2:"∀l ≤ n. f l ∈ carrier R
               ==>  f ` {i. i ≤ n} ⊆ (sum_pr_ideals R f n)" 
apply (simp add:sum_of_prideals1)
done

lemma (in Ring) sum_of_prideals3:"ideal R I ==>
      ∀f. (∀l ≤ n. f l ∈ carrier R) ∧ (f ` {i. i ≤ n} ⊆ I) -->
          (sum_pr_ideals R f n ⊆ I)" 
apply (induct_tac n)
 apply (rule allI, rule impI, erule conjE)
 apply simp
 apply (rule ideal_cont_Rxa[of I], assumption+)

apply (rule allI, rule impI, erule conjE)
 apply (frule_tac a = f in forall_spec,
        thin_tac "∀f. (∀l ≤ n. f l ∈ carrier R) ∧ f `{i. i ≤ n} ⊆ I -->
               sum_pr_ideals R f n ⊆ I")
 apply (simp add:Nset_un)
 apply (thin_tac "∀f. (∀l ≤ n. f l ∈ carrier R) ∧ f ` {i. i ≤ n} ⊆ I -->
               sum_pr_ideals R f n ⊆ I")
 apply (frule_tac a = "Suc n" in forall_spec1,
        thin_tac "∀l ≤ (Suc n). f l ∈ carrier R", simp)
   apply (cut_tac a = "Suc n" and A = "{i. i ≤ Suc n}" and 
          f = f in mem_in_image2, simp)
   apply (frule_tac A = "f ` {i. i ≤ Suc n}" and B = I and c = "f (Suc n)" in
          subsetD,  assumption+) 
 apply (rule_tac A = "Rxa R  (f (Suc n))" and B = "sum_pr_ideals R f n" in 
        sum_ideals_cont[of I], assumption)
 apply (rule ideal_cont_Rxa[of I], assumption+)
done

lemma (in Ring) sum_of_prideals4:"[|ideal R I; ∀l ≤ n. f l ∈ carrier R; 
       (f ` {i. i ≤ n} ⊆ I)|] ==> sum_pr_ideals R f n ⊆ I" 
apply (simp add:sum_of_prideals3)
done

lemma ker_ideal:"[|Ring A; Ring R; f ∈ rHom A R|] ==> ideal A (kerA,R f)"
apply (frule Ring.ring_is_ag[of "A"], frule Ring.ring_is_ag[of "R"])
apply (rule Ring.ideal_condition1, assumption+) 
apply (rule subsetI,
       simp add:ker_def) 
apply (simp add:rHom_def, frule conjunct1)
apply (frule ker_inc_zero[of "A" "R" "f"], assumption+, blast)

apply (rule ballI)+
 apply (simp add:ker_def, (erule conjE)+)
 apply (simp add:aGroup.ag_pOp_closed)
 apply (simp add:rHom_def, frule conjunct1,
        simp add:aHom_add, 
        frule Ring.ring_zero[of "R"],
        simp add:aGroup.ag_l_zero)
apply (rule ballI)+
 apply (simp add:ker_def, (erule conjE)+)
 apply (simp add:Ring.ring_tOp_closed)
 apply (simp add:rHom_tOp)
 apply (frule_tac a = r in rHom_mem[of "f" "A" "R"], assumption+,
        simp add:Ring.ring_times_x_0)
done

subsection "ring of integers"

 constdefs
  Zr::"int Ring"
  "Zr == (| carrier = Zset, pop = λn∈Zset. λm∈Zset. (m + n),
 mop = λl∈Zset. -l, zero = 0, tp = λm∈Zset. λn∈Zset. m * n, un = 1|)),"

lemma ring_of_integers:"Ring Zr"
apply (simp add:Ring_def)
apply (rule conjI)
 apply (rule bivar_func_test)
 apply (rule ballI)+
 apply (simp add:Zr_def Zset_def)
apply (rule conjI)
 apply (simp add:Zr_def Zset_def)
apply (rule conjI)
 apply (rule allI, rule impI)+
 apply (simp add:Zr_def Zset_def)
apply (rule conjI)
 apply (simp add:Zr_def Zset_def)
apply (rule conjI,
       rule allI, rule impI, simp add:Zr_def Zset_def)
apply (rule conjI, simp add:Zr_def Zset_def)
apply (rule conjI,
       rule allI, rule impI, simp add:Zr_def Zset_def)
apply (rule conjI)
 apply (rule bivar_func_test)
 apply ((rule ballI)+, simp add:Zr_def Zset_def)
apply (rule conjI,
       (rule allI, rule impI)+, simp add:Zr_def Zset_def)
apply (rule conjI,
       (rule allI, rule impI)+, simp add:Zr_def Zset_def)
apply (rule conjI)
 apply (simp add:Zr_def Zset_def)
apply (rule conjI,
       (rule allI, rule impI)+, simp add:Zr_def Zset_def)
 apply (simp add:zadd_zmult_distrib2)
apply (rule allI, rule impI)
  apply (simp add:Zr_def Zset_def)
done

lemma Zr_zero:"\<zero>Zr = 0"
by (simp add:Zr_def)

lemma Zr_one:"1rZr = 1"
by (simp add:Zr_def)

lemma Zr_minus:"-aZr n = - n"
by (simp add:Zr_def Zset_def)

lemma Zr_add:"n ±Zr m = n + m"
by (simp add:Zr_def Zset_def)

lemma Zr_times:"n ·rZr m = n * m"
by (simp add:Zr_def Zset_def)

constdefs
 lev :: "int set => int"
 "lev I == Zleast {n. n ∈ I ∧ 0 < n}"

lemma Zr_gen_Zleast:"[|ideal Zr I; I ≠ {0::int}|] ==> 
                       Rxa Zr (lev I) = I"
 apply (cut_tac ring_of_integers)
 apply (simp add:lev_def)
 apply (subgoal_tac "{n. n ∈ I ∧ 0 < n} ≠ {}")
 apply (subgoal_tac "{n. n ∈ I ∧ 0 < n} ⊆ Zset")
 apply (subgoal_tac "LB {n. n ∈ I ∧ 0 < n} 0")
 apply (frule_tac A = "{n. n ∈ I ∧ 0 < n}" and n = 0 in Zleast, assumption+)
 apply (erule conjE)+
 apply (fold lev_def)
defer
 apply (simp add:LB_def)
 apply (simp add:Zset_def)
 apply (frule Ring.ideal_zero[of "Zr" "I"], assumption+, simp add:Zr_zero) 
 apply (frule singleton_sub[of "0" "I"])
 apply (frule sets_not_eq[of "I" "{0}"], assumption+, erule bexE, simp)
 apply (case_tac "0 < a", blast)
 apply (frule Ring.ring_one[of "Zr"])
 apply (frule Ring.ring_is_ag[of "Zr"],
         frule aGroup.ag_mOp_closed[of "Zr" "1rZr"], assumption)
 apply (frule_tac x = a in Ring.ideal_ring_multiple[of "Zr" "I" _ "-aZr 1rZr"],
        assumption+)
 apply (simp add:Zr_one Zr_minus,
        thin_tac "ideal Zr I", thin_tac "Ring Zr", thin_tac "1 ∈ carrier Zr",
        thin_tac "-1 ∈ carrier Zr", thin_tac "aGroup Zr")
 apply (simp add:Zr_def Zset_def)
 apply (subgoal_tac "0 < - a", blast)
 apply arith
 apply (thin_tac "{n ∈ I. 0 < n} ≠ {}", thin_tac "{n ∈ I. 0 < n} ⊆ Zset",
        thin_tac "LB {n ∈ I. 0 < n} 0") 
 
apply simp
 apply (erule conjE)
 apply (frule Ring.ideal_cont_Rxa[of "Zr" "I" "lev I"], assumption+)
 apply (rule equalityI, assumption,
        thin_tac "Rxa Zr (lev I) ⊆ I")
 apply (rule subsetI)
 apply (simp add:Rxa_def, simp add:Zr_times) 
 apply (cut_tac a = x and b = "lev I" in zmod_zdiv_equality)
 apply (subgoal_tac "x = (x div lev I) * (lev I)",
        subgoal_tac "x div lev I ∈ carrier Zr", blast)
 apply (simp add:Zr_def Zset_def)
apply (subgoal_tac "x mod lev I = 0", simp)
 apply (subst zmult_commute, assumption)
 apply (subgoal_tac "x mod lev I ∈ I")
 apply (thin_tac "x = lev I * (x div lev I) + x mod lev I")
 apply (frule_tac a = x in pos_mod_conj[of "lev I"])
 apply (rule contrapos_pp, simp+)
 apply (erule conjE)
 apply (frule_tac a = "x mod (lev I)" in forall_spec)
  apply simp apply arith
  apply (frule_tac r = "x div (lev I)" in 
          Ring.ideal_ring_multiple1[of "Zr" "I" "lev I"], assumption+,
          simp add:Zr_def Zset_def)
  apply (frule sym, thin_tac "x = lev I * (x div lev I) + x mod lev I")  
  apply (rule_tac a = "lev I * (x div lev I)" and b = "x mod lev I " in 
         Ring.ideal_ele_sumTr1[of "Zr" "I"], assumption+)
 apply (simp add:Zr_def Zset_def)
 apply (simp add:Zr_def Zset_def)
 apply (subst Zr_add)
 apply simp
 apply (simp add:Zr_times)
done
 
lemma Zr_pir:"ideal Zr I ==> ∃n. Rxa Zr n = I" (** principal ideal ring *)
apply (case_tac "I = {(0::int)}")
 apply (subgoal_tac "Rxa Zr 0 = I") apply blast
 apply (rule equalityI)
 apply (rule subsetI) apply (simp add:Rxa_def)
 apply (simp add:Zr_def Zset_def)
 apply (rule subsetI)
 apply (simp add:Rxa_def Zr_def Zset_def)
apply (frule Zr_gen_Zleast [of "I"], assumption+)
 apply blast
done

section "4. quotient rings" 

lemma (in Ring) mem_set_ar_cos:"[|ideal R I; a ∈ carrier R|] ==> 
                                         a \<uplus>R I ∈ set_ar_cos R I"
by (simp add:set_ar_cos_def, blast)

lemma (in Ring) I_in_set_ar_cos:"ideal R I ==> I ∈ set_ar_cos R I"
apply (cut_tac ring_is_ag,
       frule ideal_asubg[of "I"],
       rule aGroup.unit_in_set_ar_cos, assumption+)
done

lemma (in Ring) ar_coset_same1:"[|ideal R I; a ∈ carrier R; b ∈ carrier R; 
       b ± (-a a) ∈ I |] ==> a \<uplus>R I = b \<uplus>R I"
apply (cut_tac ring_is_ag)
 apply (frule aGroup.b_ag_group[of "R"])
 apply (simp add:ideal_def asubGroup_def) apply (erule conjE)
 apply (frule aGroup.ag_carrier_carrier[THEN sym, of "R"]) 
 apply simp
 apply (frule Group.rcs_eq[of "b_ag R" "I" "a" "b"], assumption+)
 apply (frule aGroup.agop_gop [of "R"])
 apply (frule aGroup.agiop_giop[of "R"]) apply simp
 apply (simp add:ar_coset_def rcs_def)
done

lemma (in Ring) ar_coset_same2:"[|ideal R I; a ∈ carrier R; b ∈ carrier R; 
                                  a \<uplus>R I = b \<uplus>R I|] ==>  b ± (-a a) ∈ I"
apply (cut_tac ring_is_ag)
apply (simp add:ar_coset_def)
 apply (frule aGroup.b_ag_group[of "R"])
 apply (simp add:ideal_def asubGroup_def, frule conjunct1, fold asubGroup_def,
        fold ideal_def, simp add:asubGroup_def)
 apply (subgoal_tac "a ∈ carrier (b_ag R)",
         subgoal_tac "b ∈ carrier (b_ag R)")
 apply (simp add:Group.rcs_eq[THEN sym, of "b_ag R" "I" "a" "b"])
 apply (frule aGroup.agop_gop [of "R"])
 apply (frule aGroup.agiop_giop[of "R"]) apply simp
 apply (simp add:b_ag_def)+
done

lemma (in Ring) ar_coset_same3:"[|ideal R I; a ∈ carrier R; a \<uplus>R I = I|] ==> 
                               a∈I"
apply (cut_tac ring_is_ag)
apply (simp add:ar_coset_def) 
apply (rule Group.rcs_fixed [of "b_ag R" "I" "a" ])
apply (rule aGroup.b_ag_group, assumption) 
apply (simp add:ideal_def asubGroup_def)
apply (simp add:b_ag_def)
apply assumption
done

lemma (in Ring) ar_coset_same3_1:"[|ideal R I; a ∈ carrier R; a ∉ I|] ==> 
                                                    a \<uplus>R I ≠ I"
apply (rule contrapos_pp, simp+)
apply (simp add:ar_coset_same3)
done

lemma (in Ring) ar_coset_same4:"[|ideal R I; a ∈ I|] ==> 
                                     a \<uplus>R I = I"
apply (cut_tac ring_is_ag)
apply (frule ideal_subset[of "I" "a"], assumption+)
apply (simp add:ar_coset_def)
apply (rule Group.rcs_Unit2 [of "b_ag R" "I""a"])
apply (rule aGroup.b_ag_group, assumption) 
apply (simp add:ideal_def asubGroup_def)
apply assumption
done

lemma (in Ring) ar_coset_same4_1:"[|ideal R I; a \<uplus>R I ≠ I|] ==> a ∉ I"
apply (rule contrapos_pp, simp+)
apply (simp add:ar_coset_same4)
done

lemma (in Ring) belong_ar_coset1:"[|ideal R I; a ∈ carrier R; x ∈ carrier R; 
                 x ± (-a a) ∈ I|] ==>  x ∈ a \<uplus>R I"  
apply (frule ar_coset_same1 [of "I" "a" "x"], assumption+)
apply (subgoal_tac "x ∈ x \<uplus>R I")
 apply simp
 apply (cut_tac ring_is_ag)
 apply (subgoal_tac "carrier R = carrier (b_ag R)")
 apply (frule aGroup.agop_gop[THEN sym, of "R"])
 apply (frule aGroup.agiop_giop [THEN sym, of "R"])
 apply (simp add:ar_coset_def)
 apply (simp add:ideal_def asubGroup_def)
 
apply (rule Group.a_in_rcs [of "b_ag R" "I" "x"])
 apply (simp add: aGroup.b_ag_group) 
 apply simp
 apply simp
 apply (simp add:b_ag_def)
done

lemma (in Ring) a_in_ar_coset:"[|ideal R I; a ∈ carrier R|] ==> a ∈ a \<uplus>R I"
apply (rule belong_ar_coset1, assumption+)
apply (cut_tac ring_is_ag)
apply (simp add:aGroup.ag_r_inv1)
apply (simp add:ideal_zero)
done

lemma (in Ring) ar_coset_subsetD:"[|ideal R I; a ∈ carrier R; x ∈ a \<uplus>R I |] ==>
                           x ∈ carrier R"
 apply (subgoal_tac "carrier R = carrier (b_ag R)")
 apply (cut_tac ring_is_ag)
 apply (frule aGroup.agop_gop [THEN sym, of "R"])
 apply (frule aGroup.agiop_giop [THEN sym, of "R"])
 apply (simp add:ar_coset_def)
 apply (simp add:ideal_def asubGroup_def)
apply (rule Group.rcs_subset_elem[of "b_ag R" "I" "a" "x"])
 apply (simp add:aGroup.b_ag_group) 
 apply simp
 apply assumption+
 apply (simp add:b_ag_def)
done

lemma (in Ring) ar_cos_mem:"[|ideal R I; a ∈ carrier R|] ==>
                                 a \<uplus>R I ∈ set_rcs (b_ag R) I"
apply (cut_tac ring_is_ag)
 apply (simp add:set_rcs_def ar_coset_def)
 apply (frule aGroup.ag_carrier_carrier[THEN sym, of "R"]) apply simp
 apply blast
done

lemma (in Ring) mem_ar_coset1:"[|ideal R I; a ∈ carrier R; x ∈ a \<uplus>R I|] ==>
                                 ∃h∈I. h ± a = x"
 apply (cut_tac ring_is_ag)
 apply (frule aGroup.ag_carrier_carrier[THEN sym, of "R"]) 
 apply (frule aGroup.agop_gop [THEN sym, of "R"])
 apply (frule aGroup.agiop_giop [THEN sym, of "R"])
 apply (simp add:ar_coset_def)
 apply (simp add:ideal_def asubGroup_def)
apply (simp add:rcs_def)
done

lemma (in Ring) ar_coset_mem2:"[|ideal R I; a ∈ carrier R; x ∈ a \<uplus>R I|] ==>
                           ∃h∈I. x = a ± h"
apply (cut_tac ring_is_ag)
apply (frule mem_ar_coset1 [of "I" "a" "x"], assumption+)
apply (erule bexE,
       frule_tac h = h in ideal_subset[of "I"], assumption+)
apply (simp add:aGroup.ag_pOp_commute[of "R" _ "a"], 
       frule sym, thin_tac "a ± h = x", blast)
done

lemma (in Ring) belong_ar_coset2:"[|ideal R I; a ∈ carrier R; x ∈ a \<uplus>R I |]
                                    ==> x ± (-a a) ∈ I"
apply (cut_tac ring_is_ag)
apply (frule mem_ar_coset1, assumption+, erule bexE)
 apply (frule sym, thin_tac "h ± a = x", simp)
 apply (frule_tac h = h in ideal_subset[of "I"], assumption)
 apply (frule aGroup.ag_mOp_closed[of "R" "a"], assumption)
 apply (subst aGroup.ag_pOp_assoc, assumption+,
        simp add:aGroup.ag_r_inv1,
        simp add:aGroup.ag_r_zero)
done

lemma (in Ring) ar_c_top: "[|ideal R I; a ∈ carrier R; b ∈ carrier R|] 
       ==> (c_top (b_ag R) I (a \<uplus>R I) (b \<uplus>R I)) = (a ± b) \<uplus>R I" 
apply (cut_tac ring_is_ag, frule ideal_asubg,
       frule aGroup.asubg_nsubg[of "R" "I"], assumption,
       frule aGroup.b_ag_group[of "R"]) 
apply (simp add:ar_coset_def)
apply (subst Group.c_top_welldef[THEN sym], assumption+)
apply (simp add:aGroup.ag_carrier_carrier)+
apply (simp add:aGroup.agop_gop)
done

text{* Following lemma is not necessary to define a quotient ring. But
it makes clear that the binary operation2 of the quotient ring is well 
defined. *}

lemma (in Ring) quotient_ring_tr1:"[|ideal R I; a1 ∈ carrier R; a2 ∈ carrier R;
                b1 ∈ carrier R; b2 ∈ carrier R; 
                a1 \<uplus>R I = a2 \<uplus>R I; b1 \<uplus>R I = b2 \<uplus>R I|] ==>
                             (a1 ·r b1) \<uplus>R I = (a2 ·r b2) \<uplus>R I" 
apply (rule ar_coset_same1, assumption+)
 apply (simp add: ring_tOp_closed)+
apply (frule ar_coset_same2 [of "I" "a1" "a2"], assumption+)
apply (frule ar_coset_same2 [of "I" "b1" "b2"], assumption+) 
apply (frule ring_distrib4[of "a2" "b2" "a1" "b1"], assumption+)
 apply simp
 apply (rule ideal_pOp_closed[of "I"], assumption)
 apply (simp add:ideal_ring_multiple, simp add:ideal_ring_multiple1)
done

constdefs (structure R)
 rcostOp :: "[_, 'a set] => (['a set, 'a set] => 'a set)" 
    
    "rcostOp R I == λX∈(set_rcs (b_ag R) I). λY∈(set_rcs (b_ag R) I).
                {z. ∃ x ∈ X. ∃ y ∈ Y. ∃h∈I. (x ·r y) ± h = z}"

lemma (in Ring) rcostOp:"[|ideal R I; a ∈ carrier R; b ∈ carrier R|] ==>
                    rcostOp R I (a \<uplus>R I) (b \<uplus>R I) = (a ·r b) \<uplus>R I"
apply (cut_tac ring_is_ag)
 apply (frule ar_cos_mem[of "I" "a"], assumption+)
 apply (frule ar_cos_mem[of "I" "b"], assumption+) 
apply (simp add:rcostOp_def)
apply (rule equalityI)
 apply (rule subsetI, simp) apply (erule bexE)+
 apply (rule belong_ar_coset1, assumption+)
 apply (simp add:ring_tOp_closed)
 apply (frule sym, thin_tac "xa ·r y ± h = x", simp)
 apply (rule aGroup.ag_pOp_closed, assumption) 
 apply (frule_tac x = xa in ar_coset_mem2[of "I" "a"], assumption+,
        frule_tac x = y in ar_coset_mem2[of "I" "b"], assumption+,
        (erule bexE)+, simp)
 apply (rule ring_tOp_closed, rule aGroup.ag_pOp_closed, assumption+,
        simp add:ideal_subset)
 apply (rule aGroup.ag_pOp_closed, assumption+, simp add:ideal_subset,
        simp add:ideal_subset)
 apply (frule sym, thin_tac "xa ·r y ± h = x", simp)
 apply (frule_tac x = xa in belong_ar_coset2[of "I" "a"], assumption+,
        frule_tac x = y in belong_ar_coset2[of "I" "b"], assumption+)
 apply (frule_tac x = xa in ar_coset_subsetD[of "I" "a"], assumption+,
        frule_tac x = y in ar_coset_subsetD[of "I" "b"], assumption+)
 apply (subst aGroup.ag_pOp_commute, assumption,
        simp add:ring_tOp_closed, simp add:ideal_subset)
 apply (subst aGroup.ag_pOp_assoc, assumption,
        simp add:ideal_subset, simp add:ring_tOp_closed,
        rule aGroup.ag_mOp_closed, simp add:ring_tOp_closed,
        simp add:ring_tOp_closed)
 apply (rule ideal_pOp_closed, assumption+)
 apply (rule_tac a = xa and a' = y and b = a and b' = b in times_modTr,
        assumption+)

 apply (rule subsetI, simp)
 apply (frule_tac x = x in ar_coset_mem2[of "I" "a ·r b"],
        simp add:ring_tOp_closed, assumption)
 apply (erule bexE) apply simp
 apply (frule a_in_ar_coset[of "I" "a"], assumption+,
        frule a_in_ar_coset[of "I" "b"], assumption+)
 apply blast
done

constdefs (structure R)
 qring ::  "[('a, 'm) Ring_scheme, 'a set] => (| carrier :: 'a set set,
 pop :: ['a  set, 'a set] => 'a set, mop :: 'a set => 'a set, 
 zero :: 'a set, tp :: ['a  set, 'a set] => 'a set, un :: 'a set |)),"
 
"qring R I == (| carrier = set_rcs (b_ag R) I, pop = c_top (b_ag R) I, 
                mop = c_iop (b_ag R) I, zero = I,
                tp = rcostOp R I, un = 1r \<uplus>R I|))," 

 syntax 
  "@QRING" :: "([('a, 'more) Ring_scheme, 'a set] => ('a set) Ring)"
              (infixl "'/'r" 200) 
translations
  "R /r I" == "qring R I"

lemma (in Ring) carrier_qring:"ideal R I ==> 
                               carrier (qring R I) = set_rcs (b_ag R) I"
by (simp add:qring_def)

lemma (in Ring) carrier_qring1:"ideal R I ==>
                                carrier (qring R I) = set_ar_cos R I"
apply (cut_tac ring_is_ag)
apply (simp add:carrier_qring set_rcs_def set_ar_cos_def)
apply (simp add:ar_coset_def aGroup.ag_carrier_carrier) 
done

lemma (in Ring) qring_ring:"ideal R I ==> Ring (qring R I)"
apply (cut_tac ring_is_ag)
apply (frule ideal_asubg[of "I"],
        frule aGroup.asubg_nsubg[of "R" "I"], assumption,
        frule aGroup.b_ag_group[of "R"])
apply (subst Ring_def, simp)
apply (rule conjI)
 apply (rule bivar_func_test, (rule ballI)+)
 apply (simp add:carrier_qring, simp add:set_rcs_def, (erule bexE)+)
 apply (subst qring_def, simp)
 apply (subst Group.c_top_welldef[THEN sym, of "b_ag R" "I"], assumption+)
 apply (frule_tac a = aa and b = ab in Group.mult_closed[of "b_ag R"],
                  assumption+, blast)
apply (rule conjI)
 apply (rule allI, rule impI)+
 apply (simp add:qring_def)
 apply (simp add:Group.Qg_tassoc[of "b_ag R" "I"])
apply (rule conjI)
 apply (rule allI, rule impI)+
 apply (simp add:qring_def)
 apply (simp add:set_rcs_def, (erule bexE)+, simp)
 apply (subst Group.c_top_welldef[THEN sym, of "b_ag R" "I"], assumption+)+
 apply (simp add:aGroup.agop_gop)
 apply (simp add:aGroup.ag_carrier_carrier)
 apply (simp add:aGroup.ag_pOp_commute)
apply (rule conjI)
 apply (rule univar_func_test, rule ballI)
 apply (simp add:qring_def)
 apply (simp add:Group.Qg_iop_closed)
apply (rule conjI)
 apply (rule allI, rule impI)
 apply (simp add:qring_def)
 apply (simp add:Group.Qg_i[of "b_ag R" "I"])
apply (rule conjI)
 apply (simp add:qring_def)
 apply (frule Group.nsg_sg[of "b_ag R" "I"], assumption)
 apply (simp add:Group.unit_rcs_in_set_rcs)
apply (rule conjI)
 apply (rule allI, rule impI)
 apply (simp add:qring_def)
 apply (simp add:Group.Qg_unit[of "b_ag R" "I"])
apply (rule conjI)
 apply (rule bivar_func_test, (rule ballI)+)
 apply (simp add:qring_def aGroup.aqgrp_carrier)
 apply (simp add:set_ar_cos_def, (erule bexE)+, simp add:rcostOp,
        frule_tac x = aa and y = ab in ring_tOp_closed, assumption+,
        blast)
apply (rule conjI)
 apply (rule allI, rule impI)+
 apply (simp add:qring_def aGroup.aqgrp_carrier)
 apply (simp add:set_ar_cos_def, (erule bexE)+, simp add:rcostOp)
 apply (frule_tac x = aa and y = ab in ring_tOp_closed, assumption+,
        frule_tac x = ab and y = ac in ring_tOp_closed, assumption+,
        simp add:rcostOp, simp add:ring_tOp_assoc)
apply (rule conjI)
 apply (rule allI, rule impI)+
 apply (simp add:qring_def aGroup.aqgrp_carrier)
 apply (simp add:set_ar_cos_def, (erule bexE)+, simp add:rcostOp,
        simp add:ring_tOp_commute)
apply (rule conjI)
 apply (simp add:qring_def aGroup.aqgrp_carrier) 
 apply (cut_tac ring_one, simp add:set_ar_cos_def, blast)
apply (rule conjI)
 apply (rule allI, rule impI)+
 apply (simp add:qring_def aGroup.aqgrp_carrier)  
 apply (simp add:set_ar_cos_def, (erule bexE)+, simp)
 apply (simp add:ar_c_top rcostOp)
 apply (frule_tac x = ab and y = ac in aGroup.ag_pOp_closed,
                  assumption+,
        frule_tac x = aa and y = ab in ring_tOp_closed, assumption+ ,
        frule_tac x = aa and y = ac in ring_tOp_closed, assumption+)
 apply (simp add:ar_c_top rcostOp, simp add:ring_distrib1)
apply (rule allI, rule impI)
  apply (simp add:qring_def aGroup.aqgrp_carrier) 
  apply (simp add:set_ar_cos_def, erule bexE, simp)
  apply (cut_tac ring_one)
  apply (simp add:rcostOp, simp add:ring_l_one)
done

lemma (in Ring) qring_carrier:"ideal R I ==> 
              carrier (qring R I)  = {X. ∃a∈ carrier R. a \<uplus>R I = X}" 
apply (simp add:carrier_qring1 set_ar_cos_def)
apply (rule equalityI)
 apply (rule subsetI, simp, erule bexE, frule sym, thin_tac "x = a \<uplus>R I",
        blast)
apply (rule subsetI, simp, erule bexE, frule sym, thin_tac "a \<uplus>R I = x",
       blast)
done

lemma (in Ring) qring_mem:"[|ideal R I; a ∈ carrier R|] ==> 
                                 a \<uplus>R I ∈ carrier (qring R I)" 
apply (simp add:qring_carrier)
apply blast
done

lemma (in Ring) qring_pOp:"[|ideal R I; a ∈ carrier R; b ∈ carrier R |]
 ==> pop (qring R I) (a \<uplus>R I) (b \<uplus>R I) = (a ± b) \<uplus>R I"
by (simp add:qring_def, simp add:ar_c_top)

lemma (in Ring) qring_zero:"ideal R I ==> zero (qring R I) = I"
apply (simp add:qring_def)
done

lemma (in Ring) qring_zero_1:"[|a ∈ carrier R; ideal R I; a \<uplus>R I = I|] ==> 
                                    a ∈ I"
by (frule a_in_ar_coset [of "I" "a"], assumption+, simp)

lemma (in Ring) Qring_fix1:"[|a ∈ carrier R; ideal R I; a ∈ I|] ==> a \<uplus>R I = I"
apply (cut_tac ring_is_ag, frule aGroup.b_ag_group)
apply (simp add:ar_coset_def)
apply (frule ideal_asubg[of "I"], simp add:asubGroup_def)
apply (simp add:Group.rcs_fixed2[of "b_ag R" "I"])
done

lemma (in Ring) ar_cos_same:"[|a ∈ carrier R; ideal R I; x ∈ a \<uplus>R I|] ==>
                                x \<uplus>R I = a \<uplus>R I"
apply (cut_tac ring_is_ag) 
apply (rule ar_coset_same1[of "I" "x" "a"], assumption+) 
apply (rule ar_coset_subsetD[of "I"], assumption+)
apply (frule ar_coset_mem2[of "I" "a" "x"], assumption+,
       erule bexE)
apply (frule_tac h = h in ideal_subset[of "I"], assumption,
      simp add:aGroup.ag_p_inv)
apply (frule_tac x = a in aGroup.ag_mOp_closed[of "R"], assumption+,
       frule_tac x = h in aGroup.ag_mOp_closed[of "R"], assumption+) 
apply (simp add:aGroup.ag_pOp_assoc[THEN sym],
       simp add:aGroup.ag_r_inv1 aGroup.ag_l_zero)
apply (simp add:ideal_inv1_closed)
done

lemma (in Ring) qring_tOp:"[|ideal R I; a ∈ carrier R; b ∈ carrier R|] ==> 
                tp (qring R I) (a \<uplus>R I) (b \<uplus>R I) = (a ·r b) \<uplus>R I"
by (simp add:qring_def, simp add:rcostOp)  

lemma rind_hom_well_def:"[|Ring A; Ring R; f ∈ rHom A R; a ∈ carrier A |] ==>
                                   f a = (f°A,R) (a \<uplus>A (kerA,R f))"
apply (frule ker_ideal[of "A" "R" "f"], assumption+)
apply (frule Ring.mem_set_ar_cos[of "A" "kerA,R f" "a"], assumption+)
apply (simp add:rind_hom_def)
 apply (rule someI2_ex)
 apply (frule Ring.a_in_ar_coset [of "A" "kerA,R f" "a"], assumption+, blast)
 apply (frule_tac x = x in Ring.ar_coset_mem2[of "A" "kerA,R f" "a"],
           assumption+, erule bexE, simp,
        frule_tac h = h in Ring.ideal_subset[of "A" "kerA,R f"], assumption+)
 apply (frule_tac Ring.ring_is_ag[of "A"],
        frule_tac Ring.ring_is_ag[of "R"],
        simp add:rHom_def, frule conjunct1, simp add:aHom_add)
 apply (simp add:ker_def)
 apply (frule aHom_mem[of "A" "R" "f" "a"], assumption+,
        simp add:aGroup.ag_r_zero)
done

lemma (in Ring) set_r_ar_cos:"ideal R I ==>
                 set_rcs (b_ag R) I = set_ar_cos R I"
 apply (simp add:set_ar_cos_def set_rcs_def ar_coset_def)
 apply (cut_tac ring_is_ag) 
 apply (simp add:aGroup.ag_carrier_carrier)
done

lemma set_r_ar_cos_ker:"[|Ring A; Ring R; f ∈ rHom A R |] ==>
                     set_rcs (b_ag A) (kerA,R f) = set_ar_cos A (kerA,R f)"
apply (frule ker_ideal[of "A" "R" "f"], assumption+)
 apply (simp add:Ring.carrier_qring[THEN sym],
        simp add:Ring.carrier_qring1[THEN sym])
done

lemma ind_hom_rhom:"[|Ring A; Ring R; f ∈ rHom A R|] ==>
                                    (f°A,R) ∈ rHom (qring A (kerA,R f)) R"
apply (simp add:rHom_def [of "qring A (kerA,R f)" "R"])
apply (rule conjI)
 apply (simp add:aHom_def)
 apply (rule conjI)
 apply (simp add:qring_def)
apply (simp add:rind_hom_def extensional_def)
apply (rule univar_func_test)
 apply (rule ballI)
 apply (frule Ring.ring_is_ag [of "A"], frule Ring.ring_is_ag [of "R"], 
        frule aGroup.b_ag_group [of "R"])
 apply (simp add:aGroup.ag_carrier_carrier [THEN sym])
 apply (simp add:set_ar_cos_def)
 apply (rule conjI)
 apply (rule impI)
 apply (erule bexE, simp)
 apply (frule ker_ideal [of "A" "R" "f"], assumption+)
 apply (frule_tac a = a in Ring.a_in_ar_coset [of "A" "kerA,R f"],
        assumption+)
 apply (rule someI2_ex, blast)
 apply (frule_tac I = "kerA,R f" and a = a and x = xa in 
                   Ring.ar_coset_subsetD[of "A"], assumption+)
 apply (simp add:aGroup.ag_carrier_carrier, simp add:rHom_mem)
 apply (simp add:set_r_ar_cos_ker, simp add:set_ar_cos_def, rule impI, blast)
apply (rule conjI)
 apply (simp add:qring_def)
 apply (simp add:set_r_ar_cos_ker)
 apply (simp add:rind_hom_def extensional_def)
apply (rule ballI)+
 apply (simp add:qring_def)
 apply (simp add:set_r_ar_cos_ker)
 apply (simp add:set_ar_cos_def)
 apply ((erule bexE)+, simp)
 apply (frule ker_ideal[of "A" "R" "f"], assumption+) 
 apply (simp add:Ring.ar_c_top)
 apply (frule Ring.ring_is_ag[of "A"],
        frule Ring.ring_is_ag[of "R"],
        frule_tac x = aa and y = ab in aGroup.ag_pOp_closed[of "A"],
        assumption+) 
 apply (simp add:rind_hom_well_def[THEN sym])
 apply (simp add:rHom_def, frule conjunct1, simp add:aHom_add)
apply (rule conjI) 
 apply (rule ballI)+
 apply (frule ker_ideal[of "A" "R" "f"], assumption+,
        simp add:Ring.carrier_qring1, simp add:set_ar_cos_def,
        (erule bexE)+, simp add:qring_def Ring.rcostOp)
 apply (frule Ring.ring_is_ag[of "A"], 
         frule_tac x = a and y = aa in Ring.ring_tOp_closed[of "A"],
         assumption+)
 apply (simp add:rind_hom_well_def[THEN sym], simp add:rHom_tOp)

apply (simp add:qring_def)
 apply (frule Ring.ring_one[of "A"],
        simp add:rind_hom_well_def[THEN sym],
        simp add:rHom_one)
done

lemma ind_hom_injec:"[|Ring A; Ring R; f ∈ rHom A R|] ==> 
                              injec(qring A (kerA,R f)),R (f°A,R)"
apply (simp add:injec_def)
apply (frule ind_hom_rhom [of "A" "R" "f"], assumption+)
apply (frule rHom_aHom[of "f°A,R" "A /r (kerA,R f)" "R"], simp)
 apply (simp add:ker_def[of _ _ "f°A,R"])
apply ((subst qring_def)+, simp)
 apply (simp add:set_r_ar_cos_ker)

apply (frule Ring.ring_is_ag[of "A"],
       frule Ring.ring_is_ag[of "R"],
       frule ker_ideal[of "A" "R" "f"], assumption+)
apply (rule equalityI)
 apply (rule subsetI)
 apply (simp, erule conjE)
 apply (simp add:set_ar_cos_def, erule bexE, simp)
 apply (simp add:rind_hom_well_def[THEN sym, of "A" "R" "f"],
        thin_tac "x = a \<uplus>A kerA,R f")
 apply (rule_tac a = a in Ring.Qring_fix1[of "A" _ "kerA,R f"], assumption+)
 apply (simp add:ker_def)

 apply (rule subsetI, simp) 
 apply (simp add:Ring.I_in_set_ar_cos[of "A" "kerA,R f"])
 apply (frule Ring.ideal_zero[of "A" "kerA,R f"], assumption+,
        frule Ring.ring_zero[of "A"])

 apply (frule Ring.ar_coset_same4[of "A" "kerA,R f" "\<zero>A"], assumption+)
 apply (frule rind_hom_well_def[THEN sym, of "A" "R" "f" "\<zero>A"], assumption+)
 apply simp

 apply (rule rHom_0_0, assumption+) 
done

lemma rhom_to_rimg:"[|Ring A; Ring R; f ∈ rHom A R|] ==>
                                   f ∈ rHom A (rimg A R f)"
apply (frule Ring.ring_is_ag[of "A"], frule Ring.ring_is_ag[of "R"])
apply (subst rHom_def, simp)
apply (rule conjI)
 apply (subst aHom_def, simp)
 apply (rule conjI)
 apply (rule univar_func_test, rule ballI, simp add:rimg_def)
 apply (rule conjI)
  apply (simp add:rHom_def aHom_def)
  apply ((rule ballI)+, simp add:rimg_def)
 apply (rule aHom_add, assumption+)
  apply (simp add:rHom_aHom, assumption+)

 apply (rule conjI)
 apply ((rule ballI)+, simp add:rimg_def, simp add:rHom_tOp)

 apply (simp add:rimg_def, simp add:rHom_one)
done

lemma ker_to_rimg:"[|Ring A; Ring R; f ∈ rHom A R |] ==>
                         kerA,R f = kerA,(rimg A R f) f"
apply (frule rhom_to_rimg [of "A" "R" "f"], assumption+)
apply (simp add:ker_def)
apply (simp add:rimg_def)
done

lemma indhom_eq:"[|Ring A; Ring R; f ∈ rHom A R|] ==> f°A,(rimg A R f) = f°A,R"
apply (frule rimg_ring[of "A" "R" "f"], assumption+)
apply (frule rhom_to_rimg[of "A" "R" "f"], assumption+,
       frule ind_hom_rhom[of "A" "rimg A R f"], assumption+,
       frule ind_hom_rhom[of "A" "R" "f"], assumption+) (** extensional **)
apply (rule funcset_eq[of "f°A,rimg A R f " "carrier (A /r (kerA,R f))" "f°A,R"])
 apply (simp add:ker_to_rimg[THEN sym],
        simp add:rHom_def[of _ "rimg A R f"] aHom_def)
 apply (simp add:rHom_def[of _ "R"] aHom_def)

apply (simp add:ker_to_rimg[THEN sym])
 apply (rule ballI)
 apply (frule ker_ideal[of "A" "R" "f"], assumption+,
        simp add:Ring.carrier_qring1)
 apply (simp add:set_ar_cos_def, erule bexE, simp)
 apply (simp add:rind_hom_well_def[THEN sym])
 apply (frule rind_hom_well_def[THEN sym, of "A" "rimg A R f" "f"],
         assumption+, simp add:ker_to_rimg[THEN sym])
done
 
lemma indhom_bijec2_rimg:"[|Ring A; Ring R; f ∈ rHom A R|] ==>
                    bijec(qring A (kerA,R f)),(rimg A R f) (f°A,R)"
apply (frule rimg_ring [of "A" "R" "f"], assumption+)
apply (frule rhom_to_rimg[of "A" "R" "f"], assumption+)
apply (frule ind_hom_rhom[of "A" "rimg A R f" "f"], assumption+)
 apply (frule ker_to_rimg[THEN sym, of "A" "R" "f"], assumption+)
 apply (frule indhom_eq[of "A" "R" "f"], assumption+)
apply simp
 apply (simp add:bijec_def)
 apply (rule conjI)
  apply (simp add:injec_def)
   apply (rule conjI) 
   apply (simp add:rHom_def)
   apply (frule ind_hom_injec [of "A" "R" "f"], assumption+)
   apply (simp add:injec_def)
   apply (simp add:ker_def [of _ _ "f°A,R"]) 
   apply (simp add:rimg_def)

  apply (simp add:surjec_def) 
   apply (rule conjI) 
   apply (simp add:rHom_def)
   apply (rule surj_to_test)
   apply (simp add:rHom_def aHom_def)
   apply (rule ballI) 
   apply (simp add:rimg_carrier)
   apply (simp add:image_def)
   apply (erule bexE, simp)
   apply (frule_tac a1 = x in rind_hom_well_def[THEN sym, of "A" "R" "f"],
                   assumption+)
   apply (frule ker_ideal[of "A" "R" "f"], assumption+,
        simp add:Ring.carrier_qring1,
        frule_tac a = x in Ring.mem_set_ar_cos[of "A" "kerA,R f"], assumption+)
 apply blast
done

lemma surjec_ind_bijec:"[|Ring A; Ring R; f ∈ rHom A R; surjecA,R f|] ==>
     bijec(qring A (kerA,R f)),R (f°A,R)"
apply (frule ind_hom_rhom[of "A" "R" "f"], assumption+)
apply (simp add:surjec_def)
apply (simp add:bijec_def)
 apply (simp add:ind_hom_injec)

 apply (simp add:surjec_def) 
   apply (simp add:rHom_aHom)
   apply (rule surj_to_test)
   apply (simp add:rHom_def aHom_def)
   apply (rule ballI) 
   apply (simp add:surj_to_def, frule sym, 
                        thin_tac "f ` carrier A = carrier R", simp,
                        thin_tac "carrier R = f ` carrier A")
   apply (simp add:image_def, erule bexE)
   apply (frule_tac a1 = x in rind_hom_well_def[THEN sym, of "A" "R" "f"],
                   assumption+)
   apply (frule ker_ideal[of "A" "R" "f"], assumption+,
        simp add:Ring.carrier_qring1,
        frule_tac a = x in Ring.mem_set_ar_cos[of "A" "kerA,R f"], assumption+)
 apply blast
done

lemma ridmap_ind_bijec:"Ring A ==>
     bijec(qring A (kerA,A (ridmap A))),A ((ridmap A)°A,A)" 
apply (frule ridmap_surjec[of "A"])
apply (rule surjec_ind_bijec [of "A" "A" "ridmap A"], assumption+)
 apply (simp add:rHom_def, simp add:surjec_def)
 
 apply (rule conjI)
  apply (rule ballI)+
  apply (frule_tac x = x and y = y in Ring.ring_tOp_closed[of "A"],
          assumption+, simp add:ridmap_def)
  apply (simp add:ridmap_def Ring.ring_one)
  
 apply assumption
done

lemma ker_of_idmap:"Ring A ==> kerA,A (ridmap A) = {\<zero>A}" 
apply (simp add:ker_def)
apply (simp add:ridmap_def)
apply (rule equalityI)
 apply (rule subsetI) apply (simp add:CollectI)
 apply (rule subsetI) apply (simp add:CollectI)
 
 apply (simp add:Ring.ring_zero)
done

lemma ring_natural_isom:"Ring A ==> 
         bijec(qring A {\<zero>A}),A ((ridmap A)°A,A)"
apply (frule ridmap_ind_bijec)
apply (simp add: ker_of_idmap)
done           (** A /r {0A} ≅ A **)

constdefs
 pj :: "[('a, 'm) Ring_scheme, 'a set] => ('a => 'a set)" 
      "pj R I == λx. Pj (b_ag R) I x" 

 (* pj is projection homomorphism *)

lemma pj_Hom:"[|Ring R; ideal R I|] ==> (pj R I) ∈ rHom R (qring R I)"
apply (simp add:rHom_def)
apply (rule conjI) 
apply (simp add:aHom_def)
 apply (rule conjI)
 apply (rule univar_func_test) apply (rule ballI)
 apply (simp add:qring_def)
 apply (frule Ring.ring_is_ag)
 apply (simp add:aGroup.ag_carrier_carrier [THEN sym])
 apply (simp add:pj_def Pj_def)
 apply (simp add:set_rcs_def) apply blast
apply (rule conjI)
 apply (simp add:pj_def Pj_def extensional_def) 
 apply (frule Ring.ring_is_ag) apply (simp add:aGroup.ag_carrier_carrier)
apply (rule ballI)+
 apply (frule Ring.ring_is_ag)
 apply (frule_tac x = a and y = b in aGroup.ag_pOp_closed, assumption+)
 apply (simp add:aGroup.ag_carrier_carrier [THEN sym])
 apply (simp add:pj_def Pj_def)
 apply (simp add:qring_def) apply (frule aGroup.b_ag_group)
 apply (simp add:aGroup.agop_gop [THEN sym])
 apply (subst Group.c_top_welldef[of "b_ag R" "I"], assumption+)
 apply (frule Ring.ideal_asubg[of "R" "I"], assumption+)
 apply (simp add:aGroup.asubg_nsubg)
 apply assumption+
 apply simp

apply (rule conjI)
 apply (rule ballI)+
 apply (simp add: qring_def)
 apply (frule_tac x = x and y = y in Ring.ring_tOp_closed, assumption+)
 apply (frule Ring.ring_is_ag)
 apply (simp add:aGroup.ag_carrier_carrier [THEN sym])
 apply (simp add:pj_def Pj_def)
 apply (simp add:aGroup.ag_carrier_carrier)
       
 apply (frule_tac a1 = x and b1 = y in Ring.rcostOp [THEN sym, of "R" "I"], 
                                                             assumption+)
 apply (simp add:ar_coset_def)
apply (simp add:qring_def)
 apply (frule Ring.ring_one)
 apply (frule Ring.ring_is_ag)
 apply (simp add:aGroup.ag_carrier_carrier [THEN sym])
 apply (simp add:pj_def Pj_def)
 apply (simp add:ar_coset_def)
done

lemma pj_mem:"[|Ring R; ideal R I; x ∈ carrier R|] ==> pj R I x = x \<uplus>R I"
apply (frule Ring.ring_is_ag)
apply (simp add:aGroup.ag_carrier_carrier [THEN sym])
apply (simp add:pj_def Pj_def)
apply (simp add:ar_coset_def)
done  

lemma pj_zero:"[|Ring R; ideal R I; x ∈ carrier R|] ==>
                         (pj R I x = \<zero>(R /r I)) = (x ∈ I)"
apply (rule iffI)
apply (simp add:pj_mem Ring.qring_zero,
       simp add:Ring.qring_zero_1[of "R" "x" "I"])
apply (simp add:pj_mem Ring.qring_zero,
       rule Ring.Qring_fix1, assumption+)
done

lemma pj_surj_to:"[|Ring R; ideal R J; X ∈ carrier (R /r J)|] ==> 
                   ∃r∈ carrier R. pj R J r = X" 
apply (simp add:qring_def set_rcs_def,
       fold ar_coset_def, simp add:b_ag_def, erule bexE,
       frule_tac x = a in pj_mem[of R J], assumption+, simp)
 apply blast
done

lemma invim_of_ideal:"[|Ring R; ideal R I; ideal (qring R I) J |] ==> 
  ideal R (rInvim R (qring R I) (pj R I) J)"
apply (rule Ring.ideal_condition, assumption)
 apply (simp add:rInvim_def) apply (rule subsetI) apply (simp add:CollectI)
apply (subgoal_tac "\<zero>R ∈ rInvim R (qring R I) (pj R I) J")
apply (simp add:nonempty)
apply (simp add:rInvim_def)
apply (simp add: Ring.ring_zero)
 apply (frule Ring.ring_is_ag)
 apply (frule pj_Hom [of "R" "I"], assumption+)
 apply (frule Ring.qring_ring [of "R" "I"], assumption+)
 apply (frule rHom_0_0 [of "R" "R /r I" "pj R I"], assumption+)
 apply (simp add:Ring.ideal_zero)
apply (rule ballI)+
 apply (simp add:rInvim_def) apply (erule conjE)+
 apply (rule conjI)
 apply (frule Ring.ring_is_ag)
 apply (rule aGroup.ag_pOp_closed, assumption+) 
 apply (rule aGroup.ag_mOp_closed, assumption+)
 apply (frule pj_Hom [of "R" "I"], assumption+)
 apply (frule Ring.ring_is_ag)
 apply (frule_tac x = y in aGroup.ag_mOp_closed [of "R"], assumption+)
 apply (simp add:rHom_def) apply (erule conjE)+
 apply (subst aHom_add [of "R" "R /r I" "pj R I"], assumption+)
 apply (simp add:Ring.qring_ring Ring.ring_is_ag)
 apply assumption+
apply (frule Ring.qring_ring [of "R" "I"], assumption+)
 apply (rule Ring.ideal_pOp_closed, assumption+)
 apply (subst aHom_inv_inv[of "R" "R /r I" "pj R I"], assumption+)
 apply (simp add:Ring.ring_is_ag) apply assumption+
 apply (frule_tac x = "pj R I y" in Ring.ideal_inv1_closed [of "R /r I" "J"],
                                              assumption+)
apply (rule ballI)+
 apply (simp add:rInvim_def) apply (erule conjE)
 apply (simp add:Ring.ring_tOp_closed)
 apply (frule pj_Hom [of "R" "I"], assumption+)
 apply (subst rHom_tOp [of "R" "R /r I" _ _ "pj R I"], assumption+)
 apply (frule Ring.qring_ring[of "R" "I"], assumption+) 
 apply (rule Ring.ideal_ring_multiple [of "R /r I" "J"])
 apply (simp add:Ring.qring_ring) apply assumption+
 apply (simp add:rHom_mem)
done

lemma pj_invim_cont_I:"[|Ring R; ideal R I; ideal (qring R I) J|] ==> 
                         I ⊆ (rInvim R (qring R I) (pj R I) J)"
apply (rule subsetI)
 apply (simp add:rInvim_def)
 apply (frule Ring.ideal_subset [of "R" "I"], assumption+)
 apply simp
 apply (frule  pj_mem [of "R" "I"  _], assumption+)
 apply (simp add:Ring.ar_coset_same4)
apply (frule  Ring.qring_ring[of "R" "I"], assumption+)
apply (frule Ring.ideal_zero [of "qring R I" "J"], assumption+)

apply (frule Ring.qring_zero[of "R" "I"], assumption)
 apply simp
done

lemma pj_invim_mono1:"[|Ring R; ideal R I; ideal (qring R I) J1; 
      ideal (qring R I) J2; J1 ⊆ J2 |] ==> 
      (rInvim R (qring R I) (pj R I) J1) ⊆ (rInvim R (qring R I) (pj R I) J2)"
apply (rule subsetI) 
apply (simp add:rInvim_def)
apply (simp add:subsetD)
done

lemma pj_img_ideal:"[|Ring R; ideal R I; ideal R J; I ⊆ J|] ==> 
                                  ideal (qring R I) ((pj R I)`J)"
apply (rule Ring.ideal_condition [of "qring R I" "(pj R I) `J"]) 
apply (simp add:Ring.qring_ring)
apply (rule subsetI, simp add:image_def)
 apply (erule bexE)
 apply (frule_tac h = xa in Ring.ideal_subset [of "R" "J"], assumption+)
 apply (frule pj_Hom [of "R" "I"], assumption+)
 apply (simp add:rHom_mem)
 apply (frule Ring.ideal_zero [of "R" "J"], assumption+)
 apply (simp add:image_def) apply blast
apply (rule ballI)+
 apply (simp add:image_def)
 apply (erule bexE)+
 apply (frule pj_Hom [of "R" "I"], assumption+)
 apply (rename_tac x y s t)
 apply (frule_tac h = s in Ring.ideal_subset [of "R" "J"], assumption+) 
 apply (frule_tac h = t in Ring.ideal_subset [of "R" "J"], assumption+)
 apply (simp add:rHom_def)   apply (erule conjE)+
 apply (frule Ring.ring_is_ag)
 apply (frule Ring.qring_ring [of "R" "I"], assumption+)
 apply (frule Ring.ring_is_ag [of "R /r I"])
  apply (frule_tac x = t in aGroup.ag_mOp_closed [of "R"], assumption+)
 apply (frule_tac a1 = s and b1 = "-aR t" in aHom_add [of "R" "R /r I" 
  "pj R I", THEN sym], assumption+) apply (simp add:aHom_inv_inv)
 apply (frule_tac x = t in Ring.ideal_inv1_closed [of "R" "J"], assumption+)
 apply (frule_tac x = s and y = "-aR t" in Ring.ideal_pOp_closed [of "R" "J"], 
                                             assumption+)
 apply blast
apply (rule ballI)+
apply (simp add:qring_def)
 apply (simp add:Ring.set_r_ar_cos) 
 apply (simp add:set_ar_cos_def, erule bexE)
 apply simp
 apply (simp add:image_def)
 apply (erule bexE)
 apply (frule_tac x = xa in pj_mem [of "R" "I"], assumption+) 
 apply (simp add:Ring.ideal_subset) apply simp
 apply (subst Ring.rcostOp, assumption+)
    apply (simp add:Ring.ideal_subset)  
 apply (frule_tac x = xa and r = a in Ring.ideal_ring_multiple [of "R" "J"],
                                                  assumption+)
 apply (frule_tac h = "a ·rR xa" in Ring.ideal_subset [of "R" "J"], 
                                                                 assumption+)
 apply (frule_tac x1 = "a ·rR xa" in pj_mem [THEN sym, of "R" "I"], 
                                                                 assumption+)
 apply simp
 apply blast
done
 
lemma npQring:"[|Ring R; ideal R I; a ∈ carrier R|] ==>
      npow (qring R I) (a \<uplus>R I) n = (npow R a n) \<uplus>R I"
apply (induct_tac n)
apply (simp add:qring_def) 

apply (simp add:qring_def)
apply (rule Ring.rcostOp, assumption+)
apply (rule Ring.npClose, assumption+)
done

section "5. Primary ideals, Prime ideals"

constdefs
  maximal_set::"['a set set, 'a set] => bool"
 "maximal_set S mx == mx ∈ S ∧ (∀s∈S. mx ⊆ s --> mx = s)" 

constdefs (structure R)
 nilpotent::"[_, 'a] => bool"
  "nilpotent R a == ∃(n::nat). a^R n = \<zero>"

 zero_divisor::"[_, 'a] => bool"
  "zero_divisor R a == ∃x∈ carrier R. x ≠ \<zero> ∧ x ·r a = \<zero>"

 primary_ideal::"[_, 'a set] => bool"
   "primary_ideal R q == ideal R q ∧ (1r) ∉ q ∧ 
   (∀x∈ carrier R. ∀y∈ carrier R. 
    x ·r y ∈ q  --> (∃n. (npow R x n) ∈ q ∨ y ∈ q))"

 prime_ideal::"[_, 'a set] => bool"
  "prime_ideal R p == ideal R p ∧ (1r) ∉ p ∧ (∀x∈ carrier R. ∀y∈ carrier R. 
   (x ·r y ∈ p --> x ∈ p ∨ y ∈ p))"

 maximal_ideal::"[_, 'a set] => bool"
  "maximal_ideal R mx == ideal R mx ∧ 1r ∉ mx ∧ 
        {J. (ideal R J ∧ mx ⊆ J)} = {mx, carrier R}"

lemma (in Ring) maximal_ideal_ideal:"[|maximal_ideal R mx|] ==> ideal R mx" 
by (simp add:maximal_ideal_def)

lemma (in Ring) maximal_ideal_proper:"maximal_ideal R mx ==> 1r ∉ mx"
by (simp add:maximal_ideal_def)

lemma (in Ring) prime_ideal_ideal:"prime_ideal R I ==> ideal R I"
by (simp add:prime_ideal_def)

lemma (in Ring) prime_ideal_proper:"prime_ideal R I ==> I ≠ carrier R"
apply (simp add:prime_ideal_def, (erule conjE)+)
apply (simp add:proper_ideal)
done

lemma (in Ring) prime_ideal_proper1:"prime_ideal R p ==> 1r ∉ p"
by (simp add:prime_ideal_def) 

lemma (in Ring) primary_ideal_ideal:"primary_ideal R q ==> ideal R q"
by (simp add:primary_ideal_def) 

lemma (in Ring)  primary_ideal_proper1:"primary_ideal R q ==> 1r ∉ q"
by (simp add:primary_ideal_def) 

lemma (in Ring) prime_elems_mult_not:"[|prime_ideal R P; x ∈ carrier R;
                y ∈ carrier R; x ∉ P; y ∉ P |] ==> x ·r y ∉ P"
apply (simp add:prime_ideal_def, (erule conjE)+)
apply (rule contrapos_pp, simp+)
 apply (frule_tac b = x in forball_spec1, assumption,
        thin_tac "∀x∈carrier R. ∀y∈carrier R. x ·r y ∈ P --> x ∈ P ∨ y ∈ P",
        frule_tac b = y in forball_spec1, assumption,
        thin_tac "∀y∈carrier R. x ·r y ∈ P --> x ∈ P ∨ y ∈ P", simp)
done
        

lemma (in Ring) prime_is_primary:"prime_ideal R p ==> primary_ideal R p"
apply (unfold primary_ideal_def)
apply (rule conjI, simp add:prime_ideal_def)
apply (rule conjI, simp add:prime_ideal_def)
apply ((rule ballI)+, rule impI)
apply (simp add:prime_ideal_def, (erule conjE)+) 
 apply (frule_tac b = x in forball_spec1, assumption,
        thin_tac "∀x∈carrier R. ∀y∈carrier R. x ·r y ∈ p --> x ∈ p ∨ y ∈ p",
        frule_tac b = y in forball_spec1, assumption,
        thin_tac "∀y∈carrier R. x ·r y ∈ p --> x ∈ p ∨ y ∈ p", simp)
 apply (erule disjE)
 apply (frule_tac t = x in np_1[THEN sym])
 apply (frule_tac a = x and A = p and b = "x^R (Suc 0)" in eq_elem_in,
                                               assumption)
 apply blast
apply simp
done

lemma (in Ring) maximal_prime_Tr0:"[|maximal_ideal R mx; x ∈ carrier R; x ∉ mx|]
              ==>  mx \<minusplus> (Rxa R x) = carrier R"
apply (frule principal_ideal [of "x"])
 apply (frule maximal_ideal_ideal[of "mx"]) 
 apply (frule sum_ideals [of "mx" "Rxa R x"], assumption)
 apply (frule sum_ideals_la1 [of "mx" "Rxa R x"], assumption)
 apply (simp add:maximal_ideal_def) 
 apply (erule conjE)+ 
 apply (subgoal_tac "mx \<minusplus> (Rxa R x) ∈ {J. ideal R J ∧ mx ⊆ J}")
 apply simp
apply (frule sum_ideals_la2 [of "mx" "Rxa R x"], assumption+)
  apply (frule a_in_principal [of "x"])
  apply (frule subsetD [of "Rxa R x" "mx \<minusplus> (Rxa R x)" "x"], assumption+)
 apply (thin_tac "{J. ideal R J ∧ mx ⊆ J} = {mx, carrier R}")
apply (erule disjE)
 apply simp apply simp
 
apply (thin_tac "{J. ideal R J ∧ mx ⊆ J} = {mx, carrier R}")
 apply simp
done

lemma (in Ring) maximal_is_prime:"maximal_ideal R mx ==> prime_ideal R mx"
apply (cut_tac ring_is_ag)
apply (simp add:prime_ideal_def)
apply (simp add:maximal_ideal_ideal) 
apply (simp add:maximal_ideal_proper)

apply ((rule ballI)+, rule impI)
apply (rule contrapos_pp, simp+, erule conjE)
apply (frule_tac x = x in maximal_prime_Tr0[of "mx"], assumption+,
       frule_tac x = y in maximal_prime_Tr0[of "mx"], assumption+,
       frule maximal_ideal_ideal[of mx],
       frule ideal_subset1[of mx],
       frule_tac a = x in principal_ideal,
       frule_tac a = y in principal_ideal,
       frule_tac I = "R ♦p x" in ideal_subset1,
       frule_tac I = "R ♦p y" in ideal_subset1)
apply (simp add:aGroup.set_sum)
 apply (cut_tac ring_one)
 apply (frule sym, 
        thin_tac "{xa. ∃h∈mx. ∃k∈R ♦p x. xa = h ± k} = carrier R",
        frule sym, 
        thin_tac "{x. ∃h∈mx. ∃k∈R ♦p y. x = h ± k} = carrier R")
 apply (frule_tac a = "1r" and B = "{xa. ∃i∈mx. ∃j∈(Rxa R x). xa = i ± j}" in 
                         eq_set_inc[of _ "carrier R"], assumption,
        frule_tac a = "1r" and B = "{xa. ∃i∈mx. ∃j∈(Rxa R y). xa = i ± j}" in 
                         eq_set_inc[of _ "carrier R"], assumption,
        thin_tac "carrier R = {xa. ∃i∈mx. ∃j∈(Rxa R x). xa = i ± j}",
        thin_tac "carrier R = {x. ∃i∈mx. ∃j∈(Rxa R y). x = i ± j}")
 apply (drule CollectD, (erule bexE)+,
        frule sym, thin_tac "1r = i ± j")
 apply (drule CollectD, (erule bexE)+, rotate_tac -1,
        frule sym, thin_tac "1r = ia ± ja")
 apply (frule_tac h = i in ideal_subset[of mx], assumption,
        frule_tac h = ia in ideal_subset[of mx], assumption,
        frule_tac h = j in ideal_subset, assumption+,
        frule_tac h = ja in ideal_subset, assumption+)
 apply (cut_tac ring_one)
 apply (frule_tac x = i and y = j in aGroup.ag_pOp_closed, assumption+)
 apply (frule_tac x = "i ± j" and y = ia and z = ja in ring_distrib1,
           assumption+)
 apply (frule_tac x = ia and y = i and z = j in ring_distrib2, assumption+,
        frule_tac x = ja and y = i and z = j in ring_distrib2, assumption+,
        simp)
 apply (thin_tac "1r ·r ia = i ·r ia ± j ·r ia", 
        thin_tac "1r ·r ja = i ·r ja ± j ·r ja",
        simp add:ring_l_one[of "1r"])
 apply (frule_tac x = ia and r = i in ideal_ring_multiple[of mx], assumption+,
        frule_tac x = i and r = j in ideal_ring_multiple1[of mx], assumption+,
        frule_tac x = i and r = ja in ideal_ring_multiple1[of mx], assumption+,
        frule_tac r = j and x = ia in ideal_ring_multiple[of mx], assumption+)
 apply (subgoal_tac "j ·r ja ∈ mx")
 apply (frule_tac x = "i ·r ia" and y = "j ·r ia" in ideal_pOp_closed[of mx],
                   assumption+) apply (
        frule_tac x = "i ·r ja" and y = "j ·r ja" in ideal_pOp_closed[of mx],
           assumption+) 
 apply (frule_tac x = "i ·r ia ± j ·r ia" and y = "i ·r ja ± j ·r ja" in 
          ideal_pOp_closed[of mx], assumption+,
        thin_tac "i ± j = i ·r ia ± j ·r ia ± (i ·r ja ± j ·r ja)",
        thin_tac "ia ± ja = i ·r ia ± j ·r ia ± (i ·r ja ± j ·r ja)")
 apply (frule sym, thin_tac "1r = i ·r ia ± j ·r ia ± (i ·r ja ± j ·r ja)",
       simp)
 apply (simp add:maximal_ideal_def)
 
apply (thin_tac "i ± j = i ·r ia ± j ·r ia ± (i ·r ja ± j ·r ja)",
       thin_tac "ia ± ja = i ·r ia ± j ·r ia ± (i ·r ja ± j ·r ja)",
       thin_tac "i ·r ia ± j ·r ia ± (i ·r ja ± j ·r ja) ∈ carrier R",
       thin_tac "1r = i ·r ia ± j ·r ia ± (i ·r ja ± j ·r ja)",
       thin_tac "i ·r j ∈ mx", thin_tac "i ·r ja ∈ mx",
       thin_tac "R ♦p y ⊆ carrier R", thin_tac "R ♦p x ⊆ carrier R",
       thin_tac "ideal R (R ♦p y)", thin_tac "ideal R (R ♦p x)")
 apply (simp add:Rxa_def, (erule bexE)+, simp)
 apply (simp add:ring_tOp_assoc)
 apply (simp add:ring_tOp_assoc[THEN sym])
 apply (frule_tac x = x and y = ra in ring_tOp_commute, assumption+, simp)
 apply (simp add:ring_tOp_assoc,
        frule_tac x = x and y = y in ring_tOp_closed, assumption+)
 apply (frule_tac x1 = r and y1 = ra and z1 = "x ·r y" in 
        ring_tOp_assoc[THEN sym], assumption+, simp)
 apply (frule_tac x = r and y = ra in ring_tOp_closed, assumption+,
        rule ideal_ring_multiple[of mx], assumption+)
done
       
lemma (in Ring) chain_un:"[|c ∈ chain {I. ideal R I ∧ I ⊂ carrier R}; c ≠ {}|]
       ==> ideal R (\<Union>c)"
apply (rule ideal_condition1)
apply (rule Union_least[of "c" "carrier R"])
 apply (simp add:chain_def,
       erule conjE,
       frule_tac c = X in subsetD[of "c" "{I. ideal R I ∧ I ⊂ carrier R}"],
       assumption+, simp add:psubset_imp_subset)
 apply (simp add:chain_def,
       erule conjE)
 apply (frule nonempty_ex[of "c"], erule exE)
 apply (frule_tac c = x in subsetD[of "c" "{I. ideal R I ∧ I ⊂ carrier R}"],
        assumption+, simp, erule conjE)
 apply (frule_tac I = x in ideal_zero, blast)

apply (rule ballI)+
 apply simp 
 apply (erule bexE)+
apply (simp add: chain_def chain_subset_def)
 apply (frule conjunct1) apply (frule conjunct2)
 apply (thin_tac "c ⊆ {I. ideal R I ∧ I ⊂ carrier R} ∧ (∀x∈c. ∀y∈c. x ⊆ y ∨ y ⊆ x)")
 apply (frule_tac b = X in forball_spec1, assumption,
        thin_tac "∀x∈c. ∀y∈c. x ⊆ y ∨ y ⊆ x",
        frule_tac b = Xa in forball_spec1, assumption,
        thin_tac "∀y∈c. X ⊆ y ∨ y ⊆ X")
 apply (frule_tac c = Xa in subsetD[of "c" "{I. ideal R I ∧ I ⊂ carrier R}"],
          assumption+,
        frule_tac c = X in subsetD[of "c" "{I. ideal R I ∧ I ⊂ carrier R}"],
          assumption+, simp)
 apply (erule conjE)+
 apply (erule disjE,
        frule_tac c = x and A = X and B = Xa in subsetD, assumption+,
        frule_tac x = x and y = y and I = Xa in ideal_pOp_closed, assumption+,
        blast)
 apply (frule_tac c = y and A = Xa and B = X in subsetD, assumption+,
        frule_tac x = x and y = y and I = X in ideal_pOp_closed, assumption+,
        blast) 

apply (rule ballI)+
 apply (simp, erule bexE)
 apply (simp add:chain_def, erule conjE)
 apply (frule_tac c = X in subsetD[of "c" "{I. ideal R I ∧ I ⊂ carrier R}"], 
        assumption+, simp, erule conjE)
 apply (frule_tac I = X and x = x and r = r in ideal_ring_multiple,
        assumption+, blast)
done

lemma (in Ring) zeroring_no_maximal:"zeroring R ==> ¬ (∃I. maximal_ideal R I)"
apply (rule contrapos_pp, simp+, erule exE,
       frule_tac mx = x in maximal_ideal_ideal)
apply (frule_tac I = x in ideal_zero)
apply (simp add:zeroring_def, erule conjE,
       cut_tac ring_one, simp, thin_tac "carrier R = {\<zero>}",
        frule sym, thin_tac "1r = \<zero>", simp, thin_tac "\<zero> = 1r")
apply (simp add:maximal_ideal_def)
done

lemma (in Ring) id_maximal_Exist:"¬(zeroring R) ==> ∃I. maximal_ideal R I"
 apply (cut_tac S="{ I. ideal R I ∧ I ⊂ carrier R }" in Zorn_Lemma2)
 apply (rule ballI) 

 apply (case_tac "c={}", simp)
   apply (cut_tac zero_ideal)
   apply (simp add:zeroring_def) 
    apply (cut_tac Ring, simp,
           frule not_sym, thin_tac "carrier R ≠ {\<zero>}")
   apply (cut_tac ring_zero,
         frule singleton_sub[of "\<zero>" "carrier R"],
         thin_tac "\<zero> ∈ carrier R")
   apply (subst psubset_eq)
   apply blast 
 apply (subgoal_tac "\<Union>c ∈ {I. ideal R I ∧ I ⊂ carrier R}") 
 apply (subgoal_tac "∀x∈c. x ⊆ (\<Union>c)", blast) 
  apply (rule ballI, rule Union_upper, assumption)
  apply (simp add:chain_un) 
  apply (cut_tac A = c in Union_least[of _ "carrier R"])
  apply (simp add:chain_def, erule conjE,
        frule_tac c = X and A = c in 
          subsetD[of _ "{I. ideal R I ∧ I ⊂ carrier R}"], assumption+,
          simp add:ideal_subset1, simp add:psubset_eq)
  apply (rule contrapos_pp, simp+,
         cut_tac ring_one, frule sym, thin_tac "\<Union>c = carrier R")
  apply (frule_tac B = "\<Union>c" in eq_set_inc[of "1r" "carrier R"], assumption,
         thin_tac "carrier R = \<Union>c")
  apply (simp, erule bexE)
  apply (simp add:chain_def, erule conjE)
  apply (frule_tac c = X and A = c in 
         subsetD[of _ "{I. ideal R I ∧ I ⊆ carrier R ∧ I ≠ carrier R}"],
         assumption+, simp, (erule conjE)+)
  apply (frule_tac I = X in ideal_inc_one, assumption+, simp)

 apply (erule bexE, simp, erule conjE)
 apply (subgoal_tac "maximal_ideal R y", blast)
 apply (simp add:maximal_ideal_def)

apply (rule conjI, rule contrapos_pp, simp+,
       frule_tac  I = y in ideal_inc_one, assumption+, simp)

apply (rule equalityI)
 apply (rule subsetI, simp)
 apply (erule conjE)
 apply (frule_tac a = x in forall_spec1,
        thin_tac "∀x. ideal R x ∧ x ⊂ carrier R --> y ⊆ x --> y = x", simp)
 apply (frule_tac I = x in ideal_subset1, simp add:psubset_eq)
 apply (case_tac "x = carrier R", simp)
 apply simp

 apply (rule subsetI, simp)
 apply (erule disjE)
 apply simp
 apply (simp add:whole_ideal)
done

constdefs (structure R)
 ideal_Int::"[_, 'a set set] => 'a set"
  "ideal_Int R S == \<Inter> S"

lemma (in Ring) ideal_Int_ideal:"[|S ⊆ {I. ideal R I}; S≠{}|] ==> 
                                                 ideal R (\<Inter> S)"
apply (rule ideal_condition1) 
 apply (frule nonempty_ex[of "S"], erule exE)
 apply (frule_tac c = x in subsetD[of "S" "{I. ideal R I}"], assumption+)
 apply (simp, frule_tac I = x in ideal_subset1)
 apply (frule_tac B = x and A = S in Inter_lower)
 apply (rule_tac A = "\<Inter>S" and B = x and C = "carrier R" in subset_trans,
         assumption+)

 apply (cut_tac ideal_zero_forall, blast)
 apply (simp, rule ballI)

apply (rule ballI)+
 apply simp
 apply (frule_tac b = X in forball_spec1, assumption,
        thin_tac "∀X∈S. x ∈ X",
        frule_tac b = X in forball_spec1, assumption,
        thin_tac "∀X∈S. y ∈ X")
apply (frule_tac c = X in subsetD[of "S" "{I. ideal R I}"], assumption+,
       simp, rule_tac x = x and y = y in ideal_pOp_closed, assumption+)

apply (rule ballI)+
 apply (simp, rule ballI)
 apply (frule_tac b = X in forball_spec1, assumption,
        thin_tac "∀X∈S. x ∈ X",
        frule_tac c = X in subsetD[of "S" "{I. ideal R I}"], assumption+,
        simp add:ideal_ring_multiple)
done

lemma (in Ring) sum_prideals_Int:"[|∀l ≤ n. f l ∈ carrier R; 
                S = {I. ideal R I ∧ f ` {i. i ≤ n} ⊆ I}|] ==>  
                                  (sum_pr_ideals R f n) = \<Inter> S"
apply (rule equalityI) 
apply (subgoal_tac "∀X∈S. sum_pr_ideals R f n ⊆ X")
apply blast
 apply (rule ballI)
 apply (simp, erule conjE)
 apply (rule_tac I = X and n = n and f = f in sum_of_prideals4, assumption+)
apply (subgoal_tac "(sum_pr_ideals R f n) ∈ S")
 apply blast
 apply (simp add:CollectI)
 apply (simp add: sum_of_prideals2)
 apply (simp add: sum_of_prideals)
done

text{* This proves that (sum_pr_ideals R f n) is the smallest ideal containing
 f ` (Nset n) *} 

consts
 ideal_n_prod::"[('a, 'm) Ring_scheme, nat,  nat => 'a set] => 'a set"

primrec
  ideal_n_prod0: "ideal_n_prod R 0 J = J 0"
  ideal_n_prodSn: "ideal_n_prod R (Suc n) J = 
                          (ideal_n_prod R n J) ♦rR (J (Suc n))"

syntax
 "@IDNPROD"::"[('a, 'm) Ring_scheme, nat,  nat => 'a set] => 'a set"
          ("(3iΠ_,_ _)" [98,98,99]98)
translations
  "iΠR,n J" == "ideal_n_prod R n J" 

consts
  ideal_pow :: "['a set, ('a, 'more) Ring_scheme, nat] => 'a set"
               ("(3_/ ♦_ _)" [120,120,121]120)
primrec
 ip0:  "I ♦R 0 = carrier R"
 ipSuc:  "I ♦R (Suc n) = I ♦rR (I ♦R n)"

lemma (in Ring) prod_mem_prod_ideals:"[|ideal R I; ideal R J; i ∈ I; j ∈ J|] ==> 
                            i ·r j ∈ (I ♦r J)" 
apply (simp add:ideal_prod_def)
apply (rule allI, rule impI, erule conjE, rename_tac X) 
 apply (rule_tac A = "{x. ∃i∈I. ∃j∈J. x = Ring.tp R i j}" and B = X and c = "i ·r j" in  subsetD, assumption)
 apply simp apply blast
done

lemma (in Ring) ideal_prod_ideal:"[|ideal R I; ideal R J |] ==> 
                                        ideal R (I ♦r J)"
apply (rule ideal_condition1) 
 apply (simp add:ideal_prod_def)
 apply (rule subsetI, simp)
 apply (cut_tac whole_ideal)
 apply (frule_tac a = "carrier R" in forall_spec1,
        thin_tac "∀xa. ideal R xa ∧ {x. ∃i∈I. ∃j∈J. x = i ·r j} ⊆ xa --> 
                                                                   x ∈ xa")
 apply (subgoal_tac "{x. ∃i∈I. ∃j∈J. x = i ·r j} ⊆ carrier R", simp)
     apply (thin_tac "ideal R (carrier R) ∧
            {x. ∃i∈I. ∃j∈J. x = i ·r j} ⊆ carrier R --> x ∈ carrier R")
 apply (rule subsetI, simp, (erule bexE)+, simp)
 apply (frule_tac h = i in ideal_subset[of "I"], assumption+,
        frule_tac h = j in ideal_subset[of "J"], assumption+)
 apply (rule_tac x = i and y = j in ring_tOp_closed, assumption+)

 apply (frule ideal_zero[of "I"],
        frule ideal_zero[of "J"],
        subgoal_tac "\<zero> ∈ I ♦r R J", blast)
 apply (simp add:ideal_prod_def)
 apply (rule allI, rule impI, erule conjE)
 apply (rule ideal_zero, assumption)

 apply (rule ballI)+
 apply (simp add:ideal_prod_def)
 apply (rule allI, rule impI)
 apply (frule_tac a = xa in forall_spec1,
        thin_tac "∀xa. ideal R xa ∧ {x. ∃i∈I. ∃j∈J. x = i ·r j} ⊆ xa
                                            --> x ∈ xa",
        frule_tac a = xa in forall_spec1,
        thin_tac "∀x. ideal R x ∧ {x. ∃i∈I. ∃j∈J. x = i ·r j} ⊆ x --> y ∈ x",
        erule conjE, simp,
        rule_tac x = x and y = y in ideal_pOp_closed, assumption+)
 apply (rule ballI)+
        apply (simp add:ideal_prod_def)
        apply (rule allI, rule impI, erule conjE)
        apply (frule_tac a = xa in forall_spec1, 
               thin_tac "∀xa. ideal R xa ∧ {x. ∃i∈I. ∃j∈J. x = i ·r j} 
                            ⊆ xa --> x ∈ xa", simp)         
 apply (simp add:ideal_ring_multiple)
done 

lemma (in Ring) ideal_prod_commute:"[|ideal R I; ideal R J|] ==>
                                              I ♦r J = J ♦r I"
apply (simp add:ideal_prod_def)
apply (subgoal_tac "{K. ideal R K ∧ {x. ∃i∈I. ∃j∈J. x = i ·r j} 
       ⊆ K}  = {K. ideal R K ∧ {x. ∃i∈J. ∃j∈I. x = i ·r j} ⊆ K}")
apply simp
apply (rule equalityI)
apply (rule subsetI, rename_tac X, simp, erule conjE)
 apply (rule subsetI, simp)
 apply ((erule bexE)+)
 apply (subgoal_tac "x ∈ {x. ∃i∈I. ∃j∈J. x = i ·r j}",
        rule_tac c = x and A = "{x. ∃i∈I. ∃j∈J. x = i ·r j}" and B = X in 
        subsetD, assumption+,
        frule_tac h = i in ideal_subset[of "J"], assumption,
        frule_tac h = j in ideal_subset[of "I"], assumption,
        frule_tac x = i and y = j in ring_tOp_commute, assumption+, simp,
        blast)
 apply (rule subsetI, simp, erule conjE,
        rule subsetI, simp,
        (erule bexE)+,
        subgoal_tac "xa ∈ {x. ∃i∈J. ∃j∈I. x = i ·r j}",
        rule_tac c = xa and A = "{x. ∃i∈J. ∃j∈I. x = i ·r j}" and B = x in 
                 subsetD, assumption+,
        frule_tac h = i in ideal_subset[of "I"], assumption,
        frule_tac h = j in ideal_subset[of "J"], assumption,
        frule_tac x = i and y = j in ring_tOp_commute, assumption+, simp,
        blast)
done

lemma (in Ring) ideal_prod_subTr:"[|ideal R I; ideal R J; ideal R C;
                        ∀i∈I. ∀j∈J. i ·r j ∈ C|] ==> I ♦r J ⊆ C" 
apply (simp add:ideal_prod_def)
 apply (rule_tac B = C and 
        A = "{L. ideal R L ∧ {x. ∃i∈I. ∃j∈J. x = i ·r j} ⊆ L}" in 
        Inter_lower)
 apply simp
 apply (rule subsetI, simp, (erule bexE)+, simp)
done

lemma (in Ring) n_prod_idealTr:
     "(∀k ≤ n. ideal R (J k)) --> ideal R (ideal_n_prod R n J)"
apply (induct_tac n)
apply (rule impI)
apply simp 

apply (rule impI)
apply (simp only:ideal_n_prodSn)
 apply (cut_tac n = n in Nsetn_sub_mem1, simp)
 apply (rule ideal_prod_ideal, assumption)
 apply simp
done
 
lemma (in Ring) n_prod_ideal:"[|∀k ≤ n. ideal R (J k)|]
                               ==>  ideal R (ideal_n_prod R n J)"
apply (simp add:n_prod_idealTr)
done

lemma (in Ring) ideal_prod_la1:"[|ideal R I; ideal R J|] ==> (I ♦r J) ⊆ I" 
 apply (simp add:ideal_prod_def)
 apply (rule subsetI)
 apply (simp add:CollectI)
 apply (subgoal_tac "{x. ∃i∈I. ∃j∈J. x =  i ·r j} ⊆ I")
 apply blast
apply (thin_tac "∀xa. ideal R xa ∧ {x. ∃i∈I. ∃j∈J. x =  i ·r j} ⊆ xa
                                                              --> x ∈ xa") 
 apply (rule subsetI, simp add:CollectI,
        (erule bexE)+, frule_tac h = j in ideal_subset[of "J"], assumption+)
 apply (simp add:ideal_ring_multiple1)
done

lemma (in Ring) ideal_prod_el1:"[|ideal R I; ideal R J; a ∈ (I ♦r J)|] ==> 
                           a ∈ I" 
apply (frule ideal_prod_la1 [of "I" "J"], assumption+)
apply (rule subsetD, assumption+)
done 

lemma (in Ring) ideal_prod_la2:"[|ideal R I; ideal R J |] ==> (I ♦r J) ⊆ J" 
 apply (subst ideal_prod_commute, assumption+, 
        rule ideal_prod_la1[of "J" "I"], assumption+)
done

lemma (in Ring) ideal_prod_sub_Int:"[|ideal R I; ideal R J |] ==> 
                     (I ♦r J) ⊆ I ∩ J" 
by (simp add:ideal_prod_la1 ideal_prod_la2)

lemma (in Ring) ideal_prod_el2:"[|ideal R I; ideal R J; a ∈ (I ♦r J)|] ==> 
                                 a ∈ J"
by (frule ideal_prod_la2 [of "I" "J"], assumption+,
       rule subsetD, assumption+)

text{* iΠR,n J is the product of ideals *}
lemma (in Ring) ele_n_prodTr0:"[|∀k ≤ (Suc n). ideal R (J k);
             a ∈ iΠR,(Suc n) J |] ==> a ∈ (iΠR,n J) ∧ a ∈ (J (Suc n))"
apply (simp add:Nset_Suc[of n])
 apply (cut_tac n_prod_ideal[of n J])
apply (rule conjI)
 apply (rule ideal_prod_el1 [of "iΠR,n J" "J (Suc n)"], assumption, simp+)
 apply (rule ideal_prod_el2[of "iΠR,n J" "J (Suc n)"], assumption+, simp+)
done
 
lemma (in Ring) ele_n_prodTr1:
      "(∀k ≤ n. ideal R (J k)) ∧ a ∈ ideal_n_prod R n J -->
                                             (∀k ≤ n. a ∈ (J k))"
apply (induct_tac n)
(** n = 0 **)
 apply simp
(** n **)
 apply (rule impI)
 apply (rule allI, rule impI)
 apply (cut_tac n = n in Nsetn_sub_mem1, simp)
 apply (erule conjE)
 apply (frule_tac n = n in ele_n_prodTr0[of _ J a])
 apply simp
 
 apply (erule conjE,
        thin_tac "∀k≤Suc n. ideal R (J k)")
 apply simp
 apply (case_tac "k = Suc n", simp)
 apply (frule_tac m = k and n = "Suc n" in noteq_le_less, assumption+,
        thin_tac "k ≤ Suc n")
 apply (frule_tac x = k and n = "Suc n" in less_le_diff, simp)
done

lemma (in Ring) ele_n_prod:"[|∀k ≤ n. ideal R (J k); 
                       a ∈ ideal_n_prod R n J |] ==>  ∀k ≤ n. a ∈ (J k)"
by (simp add: ele_n_prodTr1 [of "n" "J" "a"])

lemma (in Ring) idealprod_whole_l:"ideal R I ==> (carrier R) ♦rR I = I"
apply (rule equalityI)
 apply (rule subsetI)
 apply (simp add:ideal_prod_def)
 apply (subgoal_tac "{x. ∃i∈carrier R. ∃j∈I. x = i ·r j} ⊆ I")
 apply blast
 apply (thin_tac "∀xa. ideal R xa ∧ {x. ∃i∈carrier R. ∃j∈I. 
                       x = i ·r j} ⊆ xa --> x ∈ xa")
 apply (rule subsetI)
 apply simp
 apply ((erule bexE)+, simp)
 apply (thin_tac "xa = i ·r j", simp add:ideal_ring_multiple)
apply (rule subsetI)
 apply (simp add:ideal_prod_def)
 apply (rule allI, rule impI) apply (erule conjE)
 apply (rename_tac xa X)
 apply (cut_tac ring_one)
 apply (frule_tac h = xa in ideal_subset[of "I"], assumption,
        frule_tac x = xa in ring_l_one)
 apply (subgoal_tac "1r ·r xa ∈ {x. ∃i∈carrier R. ∃j∈I. x = i ·r j}")
 apply (rule_tac c = xa and A = "{x. ∃i∈carrier R. ∃j∈I. x = i ·r j}" and 
         B = X in subsetD, assumption+)
 apply simp
 apply simp
 apply (frule sym, thin_tac "1r ·r xa = xa", blast)
done

lemma (in Ring) idealprod_whole_r:"ideal R I ==> I ♦r (carrier R) = I"
by (cut_tac whole_ideal,
       simp add:ideal_prod_commute[of "I" "carrier R"],
       simp add:idealprod_whole_l)

lemma (in Ring) idealpow_1_self:"ideal R I ==> I ♦R (Suc 0) = I"
apply simp
apply (simp add:idealprod_whole_r)
done

lemma (in Ring) ideal_pow_ideal:"ideal R I ==> ideal R (I ♦R n)"
apply (induct_tac n)
apply (simp add:whole_ideal)
apply simp
apply (simp add:ideal_prod_ideal)
done

lemma (in Ring) ideal_prod_prime:"[|ideal R I; ideal R J; prime_ideal R P;
                          I ♦r J ⊆ P |] ==> I ⊆ P ∨ J ⊆ P"
apply (rule contrapos_pp, simp+)
apply (erule conjE, simp add:subset_eq, (erule bexE)+)
apply (frule_tac i = x and j = xa in prod_mem_prod_ideals[of "I" "J"],
          assumption+)
 apply (frule_tac b = "x ·r xa" in forball_spec1, assumption,
        thin_tac "∀x∈I ♦r R J. x ∈ P")
 apply (simp add: prime_ideal_def, (erule conjE)+) 
 apply (frule_tac h = x in ideal_subset, assumption,
        frule_tac b = x in forball_spec1, assumption,
        thin_tac "∀x∈carrier R. ∀y∈carrier R. x ·r y ∈ P --> x ∈ P ∨ y ∈ P",
        frule_tac h = xa in ideal_subset, assumption,
        frule_tac b = xa in forball_spec1, assumption,
        thin_tac "∀y∈carrier R. x ·r y ∈ P --> x ∈ P ∨ y ∈ P",
        simp)
done

lemma (in Ring) ideal_n_prod_primeTr:"prime_ideal R P ==> 
       (∀k ≤ n. ideal R (J k)) --> (ideal_n_prod R n J ⊆ P) --> 
                                               (∃i ≤ n. (J i) ⊆ P)"
apply (induct_tac n)
apply simp 

apply (rule impI)
 apply (rule impI, simp)
 apply (cut_tac I = "iΠR,n J" and J = "J (Suc n)" in
                      ideal_prod_prime[of _ _ "P"],
        rule_tac n = n and J = J in n_prod_ideal,
         rule allI, simp+)
 apply (erule disjE, simp)
 apply (cut_tac n = n in Nsetn_sub_mem1,
        blast)
 apply blast
done

lemma (in Ring) ideal_n_prod_prime:"[|prime_ideal R P; 
            ∀k ≤ n. ideal R (J k); ideal_n_prod R n J ⊆ P|] ==> 
                                            ∃i ≤ n. (J i) ⊆ P"
apply (simp add:ideal_n_prod_primeTr)
done

constdefs (structure R)
 ppa::"[_, nat => 'a set, 'a set, nat] => (nat => 'a)"
  "ppa R P A i l == SOME x. x ∈ A ∧ x ∈ (P (skip i l)) ∧ x ∉ P i"  
     (** Note (ppa R P A) is used to prove prime_ideal_cont1,
         some element x of A such that x ∈ P j for (i ≠ j) and x ∉ P i **)

lemma (in Ring) prod_primeTr:"[|prime_ideal R P; ideal R A; ¬ A ⊆ P; 
                ideal R B; ¬ B ⊆ P |] ==> ∃x. x ∈ A ∧ x ∈ B ∧ x ∉ P"  
apply (simp add:subset_eq)
 apply (erule bexE)+
apply (subgoal_tac "x ·r xa ∈ A ∧ x ·r xa ∈ B ∧ x ·r xa ∉ P")
 apply blast
 apply (rule conjI)
 apply (rule ideal_ring_multiple1, assumption+)
  apply (simp add:ideal_subset)
 apply (rule conjI)
  apply (rule ideal_ring_multiple, assumption+)
  apply (simp add:ideal_subset)

 apply (rule contrapos_pp, simp+) 
apply (simp add:prime_ideal_def, (erule conjE)+)
 apply (frule_tac h = x in ideal_subset[of "A"], assumption+,
        frule_tac h = xa in ideal_subset[of "B"], assumption+,
        frule_tac b = x in forball_spec1, assumption,
        thin_tac "∀x∈carrier R. ∀y∈carrier R. x ·r y ∈ P --> x ∈ P ∨ y ∈ P",
        frule_tac b = xa in forball_spec1, assumption,
        thin_tac "∀y∈carrier R. x ·r y ∈ P --> x ∈ P ∨ y ∈ P")
  apply simp
done

lemma (in Ring) prod_primeTr1:"[|∀k ≤ (Suc n). prime_ideal R (P k); 
       ideal R A; ∀l ≤ (Suc n). ¬ (A ⊆ P l); 
       ∀k ≤ (Suc n). ∀l ≤ (Suc n). k = l ∨ ¬ (P k) ⊆ (P l); i ≤ (Suc n)|] ==> 
       ∀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)"  
apply (rule allI, rule impI) 
apply (cut_tac i = i and l = l in skip_il_neq_i)
apply (rotate_tac 2)
      apply (frule_tac a = i in forall_spec1,
             thin_tac "∀l ≤ (Suc n). ¬ A ⊆ P l", simp)

      apply (cut_tac l = l in skip_mem[of _ "n" "i"], simp,
             frule_tac a = "skip i l" in forall_spec1, 
             thin_tac "∀k ≤ (Suc n). ∀l ≤ (Suc n). k = l ∨ ¬ P k ⊆ P l",
             simp) 
     apply (rotate_tac -1,
            frule_tac a = i in forall_spec1,
            thin_tac "∀la ≤ (Suc n). skip i l = la ∨ ¬ P (skip i l) ⊆ P la",
            simp)
apply (cut_tac P = "P i" and A = A and B = "P (skip i l)" in prod_primeTr,
       simp, assumption+)
 apply (frule_tac a = "skip i l" in forall_spec1, 
        thin_tac "∀k≤Suc n. prime_ideal R (P k)", simp,
        rule prime_ideal_ideal, assumption+) 
 apply (simp add:ppa_def)
 apply (rule someI2_ex, assumption+)
done

lemma (in Ring) ppa_mem:"[|∀k ≤ (Suc n). prime_ideal R (P k); ideal R A; 
      ∀l ≤ (Suc n). ¬ (A ⊆ P l); 
      ∀k ≤ (Suc n). ∀l ≤ (Suc n). k = l ∨ ¬ (P k) ⊆ (P l); 
      i  ≤ (Suc n); l ≤ n|] ==> ppa R P A i l ∈ carrier R"
apply (frule_tac prod_primeTr1[of n P A], assumption+)
 apply (rotate_tac -1, frule_tac a = l in forall_spec1,
        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) 
 apply (simp add:ideal_subset)
done

lemma (in Ring) nsum_memrTr:"(∀i ≤ n. f i ∈ carrier R) --> 
                             (∀l ≤ n. nsum R f l ∈ carrier R)"
apply (cut_tac ring_is_ag)  
apply (induct_tac n)
(** n = 0 **)
 apply (rule impI, rule allI, rule impI)
 apply simp
(** n **)
apply (rule impI)
 apply (rule allI, rule impI)

 apply (rule aGroup.nsum_mem, assumption)
 apply (rule allI, simp)
done 

lemma (in Ring) nsum_memr:"∀i ≤ n. f i ∈ carrier R ==>
                          ∀l ≤ n. nsum R f l ∈ carrier R"  
by (simp add:nsum_memrTr)

lemma (in Ring) nsum_ideal_incTr:"ideal R A ==> 
               (∀i ≤ n. f i ∈ A) -->  nsum R f n ∈ A"
 apply (induct_tac n)
 apply (rule impI)
  apply simp
(** n **)
apply (rule impI)
apply simp
apply (rule ideal_pOp_closed, assumption+)
 apply simp 
done

lemma (in Ring) nsum_ideal_inc:"[|ideal R A; ∀i ≤ n. f i ∈ A|] ==>
                    nsum R f n ∈ A"
by (simp add:nsum_ideal_incTr)

lemma (in Ring) nsum_ideal_excTr:"ideal R A ==> 
      (∀i ≤ n. f i ∈ carrier R) ∧ (∃j ≤ n. (∀l ∈ {i. i ≤ n} -{j}. f l ∈ A)
       ∧ (f j ∉ A)) --> nsum R f n ∉ A"
apply (induct_tac n)
(** n = 0 **)
 apply simp 
(** n **)   
 apply (rule impI)
 apply (erule conjE)+
apply (erule exE)
apply (case_tac "j = Suc n", simp) apply (
       thin_tac "(∃j≤n. f j ∉ A) --> Σe R f n ∉ A")
 apply (erule conjE)
 apply (cut_tac n = n and f = f in nsum_ideal_inc[of A], assumption,
        rule allI, simp)
 apply (rule contrapos_pp, simp+)
 apply (frule_tac a = "Σe R f n" and b = "f (Suc n)" in 
                   ideal_ele_sumTr1[of A],
        simp add:ideal_subset, simp, assumption+, simp)

apply (erule conjE,
       frule_tac m = j and n = "Suc n" in noteq_le_less, assumption,
       frule_tac x = j and n = "Suc n" in less_le_diff,
       thin_tac "j ≤ Suc n", thin_tac "j < Suc n", simp,
       cut_tac n = n in Nsetn_sub_mem1, simp)
apply (erule conjE,
       frule_tac b = "Suc n" in forball_spec1, simp)
apply (rule contrapos_pp, simp+)       
 apply (frule_tac a = "Σe R f n" and b = "f (Suc n)" in 
                   ideal_ele_sumTr2[of A])
 apply (cut_tac ring_is_ag,
        rule_tac n = n in aGroup.nsum_mem[of R _ f], assumption+,
        rule allI, simp, simp, assumption+, simp)
 apply (subgoal_tac "∃j≤n. (∀l∈{i. i ≤ n} - {j}. f l ∈ A) ∧ f j ∉ A",
        simp,
        thin_tac "(∃j≤n. (∀l∈{i. i ≤ n} - {j}. f l ∈ A) ∧ f j ∉ A)
                     --> Σe R f n ∉ A")
 apply (subgoal_tac "∀l∈{i. i ≤ n} - {j}. f l ∈ A", blast,
        thin_tac "Σe R f n ± f (Suc n) ∈ A",
        thin_tac "Σe R f n ∈ A")
 apply (rule ballI)
 apply (frule_tac b = l in forball_spec1, simp, assumption)
done
 
lemma (in Ring) nsum_ideal_exc:"[|ideal R A; ∀i ≤ n. f i ∈ carrier R; 
      ∃j ≤ n. (∀l∈{i. i ≤ n} -{j}. f l ∈ A) ∧ (f j ∉ A) |] ==> nsum R f n ∉ A"
by (simp add:nsum_ideal_excTr)

lemma (in Ring) nprod_memTr:"(∀i ≤ n. f i ∈ carrier R) --> 
                             (∀l. l ≤ n -->  nprod R f l ∈ carrier R)"
apply (induct_tac n)
apply (rule impI, rule allI, rule impI, simp)

apply (rule impI, rule allI, rule impI)
apply (case_tac "l ≤ n")
 apply (cut_tac n = n in Nset_Suc, blast)
 apply (cut_tac m = l and n = "Suc n" in Nat.le_anti_sym, assumption)
 apply (simp add: not_less)
 apply simp
 apply (rule ring_tOp_closed, simp)
 apply (cut_tac n = n in Nset_Suc, blast)
done

lemma (in Ring) nprod_mem:"[|∀i ≤ n. f i ∈ carrier R; l ≤ n|] ==>
                              nprod R f l ∈ carrier R"
by (simp add:nprod_memTr)

lemma (in Ring) ideal_nprod_incTr:"ideal R A ==> 
                (∀i ≤ n. f i ∈ carrier R) ∧ 
                             (∃l ≤ n. f l ∈ A) --> nprod R f n ∈ A"
apply (induct_tac n)  
(** n = 0 **)
apply simp
(** n **)
apply (rule impI)
 apply (erule conjE)+ 
apply simp
 apply (erule exE)
 apply (case_tac "l = Suc n", simp)
 apply (rule_tac x = "f (Suc n)" and r = "nprod R f n" in 
                 ideal_ring_multiple[of "A"], assumption+)
 apply (rule_tac n = "Suc n" and f = f and l = n in nprod_mem,
                 assumption+, simp)
 apply (erule conjE)
 apply (frule_tac m = l and n = "Suc n" in noteq_le_less, assumption,
       frule_tac x = l and n = "Suc n" in less_le_diff,
       thin_tac "l ≤ Suc n", thin_tac "l < Suc n", simp)
apply (rule_tac x = "nprod R f n" and r = "f (Suc n)" in 
                      ideal_ring_multiple1[of "A"], assumption+)
 apply blast
 apply simp
done

lemma (in Ring) ideal_nprod_inc:"[|ideal R A; ∀i ≤ n. f i ∈ carrier R; 
                ∃l ≤ n. f l ∈ A|] ==> nprod R f n ∈ A"
by (simp add:ideal_nprod_incTr)

lemma (in Ring) nprod_excTr:"prime_ideal R P ==> 
          (∀i ≤ n. f i ∈ carrier R) ∧ (∀l ≤ n. f l ∉ P) --> 
                                                     nprod R f n ∉ P"
apply (induct_tac n)
(** n = 0 **)
 apply simp  (* n = 0 done *)
(** n **)
apply (rule impI)
apply (erule conjE)+
 apply simp
  apply (rule_tac y = "f (Suc n)" and x = "nprod R f n" in 
          prime_elems_mult_not[of "P"], assumption,
         rule_tac n = n in  nprod_mem, rule allI, simp+) 
done

lemma (in Ring) prime_nprod_exc:"[|prime_ideal R P; ∀i ≤ n. f i ∈ carrier R;
                ∀l ≤ n. f l ∉ P|] ==> nprod R f n ∉ P"
by (simp add:nprod_excTr)

constdefs (structure R)
 nilrad::"_ => 'a set"
  "nilrad R == {x. x ∈ carrier R ∧ nilpotent R x}" 

lemma (in Ring) id_nilrad_ideal:"ideal R (nilrad R)"
apply (cut_tac ring_is_ag)
apply (rule ideal_condition1[of "nilrad R"])
 apply (rule subsetI) apply (simp add:nilrad_def CollectI)
 apply (simp add:nilrad_def) 
 apply (cut_tac ring_zero)
 apply (subgoal_tac "nilpotent R \<zero>")
 apply blast
 apply (simp add:nilpotent_def)
 apply (frule np_1[of "\<zero>"], blast) 

 apply (rule ballI)+
apply (simp add:nilrad_def nilpotent_def, (erule conjE)+)
 apply (erule exE)+
 apply (simp add:aGroup.ag_pOp_closed[of "R"]) 
 apply (frule_tac x = x and y = y and m = n and n = na in npAdd, 
        assumption+, blast)
 
 apply (rule ballI)+
 apply (simp add:nilrad_def nilpotent_def, erule conjE, erule exE)
 apply (simp add:ring_tOp_closed,
        frule_tac x = r and y = x and n = n in npMul, assumption+,
           simp,
        frule_tac x = r and n = n in npClose)
        apply (simp add:ring_times_x_0, blast)
done

constdefs (structure R)
 rad_ideal :: "[_, 'a set ] => 'a set"
  "rad_ideal R I == {a. a ∈ carrier R ∧ nilpotent (qring R I) ((pj R I) a)}"

lemma (in Ring) id_rad_invim:"ideal R I ==> 
       rad_ideal R I = (rInvim R (qring R I) (pj R I ) (nilrad (qring R I)))"
apply (cut_tac ring_is_ag)
apply (rule equalityI)
 apply (rule subsetI)
 apply (simp add:rad_ideal_def)
 apply (erule conjE)+
 apply (simp add:rInvim_def)
 apply (simp add:nilrad_def)
 apply (subst pj_mem, rule Ring_axioms)
 apply assumption+
 apply (simp add:qring_def ar_coset_def set_rcs_def) 
 apply (simp add:aGroup.ag_carrier_carrier)
 apply blast 

apply (rule subsetI)
 apply (simp add:rInvim_def nilrad_def) 
apply (simp add: rad_ideal_def)
done 

lemma (in Ring) id_rad_ideal:"ideal R I ==> ideal R (rad_ideal R I)"
(* thm invim_of_ideal *)
apply (subst id_rad_invim [of "I"], assumption)
apply (rule invim_of_ideal, rule Ring_axioms, assumption)
apply (rule Ring.id_nilrad_ideal) 
apply (simp add:qring_ring)
done

lemma (in Ring) id_rad_cont_I:"ideal R I ==> I ⊆ (rad_ideal R I)"
apply (simp add:rad_ideal_def)
apply (rule subsetI, simp,
       simp add:ideal_subset)
apply (simp add:nilpotent_def)
apply (subst pj_mem, assumption+,
       simp add:ideal_subset) (* thm npQring *)

 apply (frule_tac h = x in ideal_subset[of "I"], assumption,
        frule_tac a = x in npQring[OF Ring, of "I" _ "Suc 0"], assumption, 
        simp only:np_1, simp only:Qring_fix1,
        subst qring_zero[of "I"], assumption)
 apply blast
done

lemma (in Ring) id_rad_set:"ideal R I ==>
       rad_ideal R I = {x. x ∈ carrier R ∧ (∃n. npow R x n ∈ I)}"
apply (simp add:rad_ideal_def)
apply (rule equalityI)
 apply (rule subsetI) 
 apply (simp add:nilpotent_def, erule conjE, erule exE)
 apply (simp add: pj_mem[OF Ring], simp add:npQring[OF Ring])
apply ( simp add:qring_zero)
 apply (frule_tac x = x and n = n in npClose)
 apply (frule_tac a = "x^R n" in ar_coset_same3[of "I"], assumption+,
        blast)
apply (rule subsetI, simp, erule conjE, erule exE)
 apply (simp add:nilpotent_def)
 apply (simp add: pj_mem[OF Ring], simp add:npQring[OF Ring], 
                                            simp add:qring_zero) 
 apply (frule_tac a = "x^R n" in ar_coset_same4[of "I"], assumption+)
 apply blast
done

lemma (in Ring) rad_primary_prime:"primary_ideal R q ==> 
                                    prime_ideal R (rad_ideal R q)" 
apply (simp add:prime_ideal_def)  
apply (frule primary_ideal_ideal[of "q"])
apply (simp add:id_rad_ideal)
apply (rule conjI)
 apply (rule contrapos_pp, simp+)
 apply (simp add:id_rad_set, erule conjE, erule exE)
 apply (simp add:npOne)
 apply (simp add:primary_ideal_proper1[of "q"])

apply ((rule ballI)+, rule impI)
 apply (rule contrapos_pp, simp+, erule conjE)
 apply (simp add:id_rad_set, erule conjE, erule exE)
 apply (simp add:npMul)
 apply (simp add:primary_ideal_def, (erule conjE)+)
 apply (frule_tac x = x and n = n in npClose,
        frule_tac x = y and n = n in npClose)
 apply (frule_tac b = "x^R n" in forball_spec1, assumption,
        thin_tac "∀x∈carrier R. ∀y∈carrier R. x ·r y ∈ q -->
                                    (∃n. x^R n ∈ q) ∨ y ∈ q",
        frule_tac b = "y^R n" in forball_spec1, assumption,
        thin_tac "∀y∈carrier R. x^R n ·r y ∈ q --> 
                             (∃na. x^R n^R na ∈ q) ∨ y ∈ q", simp)
 apply (simp add:npMulExp)
done

lemma (in Ring) npow_notin_prime:"[|prime_ideal R P; x ∈ carrier R; x ∉ P|]
                                ==> ∀n. npow R x n ∉ P" 
apply (rule allI) 
apply (induct_tac n)
 apply simp 
 apply (simp add:prime_ideal_proper1)

 apply simp
 apply (frule_tac x = x and n = na in npClose) 
 apply (simp add:prime_elems_mult_not)
done

lemma (in Ring) npow_in_prime:"[|prime_ideal R P; x ∈ carrier R; 
                               ∃n. npow R x n ∈ P |] ==> x ∈ P"
apply (rule contrapos_pp, simp+)
apply (frule npow_notin_prime, assumption+)
apply blast
done
       
constdefs (structure R)
 mul_closed_set::"[_, 'a set ] => bool"
 "mul_closed_set R S == S ⊆ carrier R ∧ (∀s∈S. ∀t∈S. s ·r t ∈ S)"

locale Idomain = Ring +
       assumes idom: 
       "[|a ∈ carrier R; b ∈ carrier R; a ·r b = \<zero>|] ==> a = \<zero> ∨ b = \<zero>"
  (* integral domain *)

locale Corps = 
       fixes K (structure)
       assumes f_is_ring: "Ring K"
       and f_inv: "∀x∈carrier K - {\<zero>}. ∃x' ∈ carrier K. x' ·r x = 1r"
  (** integral domain **)

lemma (in Ring) mul_closed_set_sub:"mul_closed_set R S ==> S ⊆ carrier R"
by (simp add:mul_closed_set_def)

lemma (in Ring) mul_closed_set_tOp_closed:"[|mul_closed_set R S; s ∈ S;
                            t ∈ S|] ==> s ·r t ∈ S"
by (simp add:mul_closed_set_def)

lemma (in Corps) f_inv_unique:"[| x ∈ carrier K - {\<zero>}; x' ∈ carrier K; 
      x'' ∈ carrier K; x' ·r  x = 1r; x'' ·r x = 1r |] ==> x' = x''"
apply (cut_tac  f_is_ring)
 apply (cut_tac x = x' and y = x and z = x'' in Ring.ring_tOp_assoc[of K],
        assumption+, simp, assumption, simp)
 apply (simp add:Ring.ring_l_one[of K],
        simp add:Ring.ring_tOp_commute[of K x x''] Ring.ring_r_one[of K])
done

constdefs (structure K)
  invf:: "[_, 'a] => 'a"
  "invf K x == THE y. y ∈ carrier K ∧ y ·r x = 1r"

lemma (in Corps) invf_inv:"x ∈ carrier K - {\<zero>} ==>
                (invf K x) ∈ carrier K ∧ (invf K x) ·r x = 1r " 
apply (simp add:invf_def)
apply (rule theI')
apply (rule ex_ex1I)
apply (cut_tac f_inv, blast) 
apply (rule_tac x' = xa and x'' = y in f_inv_unique[of x])
       apply simp+
done



constdefs (structure K)
  npowf   ::  "_  => 'a => int  => 'a"
  "npowf K x n == 
        if 0 ≤ n then npow K x (nat n) else npow K (invf K x) (nat (- n))"
  
syntax
  "@NPOWF" ::  "['a, _, int] =>  'a" 
       ("(3___)" [77,77,78]77)
 
  "@IOP"   :: "['a, _] => 'a"
       ("(_­ _)" [87,88]87) 
  
translations
  "aKn" == "npowf K a n " 
  "a­K" == "invf K a"

lemma (in Idomain) idom_is_ring:"Ring R"
by unfold_locales

lemma (in Idomain) idom_tOp_nonzeros:"[|x ∈ carrier R; 
       y ∈ carrier R; x ≠ \<zero>;  y ≠ \<zero>|] ==> x ·r y ≠ \<zero>"
apply (rule contrapos_pp, simp+)
apply (cut_tac idom[of x y]) apply (erule disjE, simp+)
done

lemma (in Idomain) idom_potent_nonzero:
       "[|x ∈ carrier R; x ≠ \<zero>|]  ==> npow R x n ≠ \<zero> " 
apply (induct_tac n)
 apply simp  (* case 0 *)
 apply (rule contrapos_pp, simp+)
 apply (frule ring_l_one[of "x", THEN sym]) apply simp
 apply (simp add:ring_times_0_x)
 (* case (Suc n) *)

 apply (rule contrapos_pp, simp+)
 apply (frule_tac n = n in npClose[of x],
        cut_tac a = "x^R n" and b = x in idom, assumption+)
 apply (erule disjE, simp+)      
done

lemma (in Idomain) idom_potent_unit:"[|a ∈ carrier R; 0 < n|]
                 ==> (Unit R a) = (Unit R (npow R a n))" 
apply (rule iffI)
 apply (simp add:Unit_def, erule bexE)
 apply (simp add:npClose)
 apply (frule_tac x1 = a and y1 = b and n1 = n in npMul[THEN sym], assumption, 
        simp add:npOne)
  apply (frule_tac x = b and n = n in npClose, blast) 

apply (case_tac "n = Suc 0", simp only: np_1)
 apply (simp add:Unit_def, erule conjE, erule bexE)
 apply (cut_tac x = a and n = "n - Suc 0" in npow_suc[of R], simp del:npow_suc,
      thin_tac "a^R n = a^R (n - Suc 0) ·r a",
      frule_tac x = a and n = "n - Suc 0" in npClose,
      frule_tac x = "a^R (n - Suc 0)" and y = a in ring_tOp_commute, assumption+,
      simp add:ring_tOp_assoc,
      frule_tac x = "a^R (n - Suc 0)" and y = b in ring_tOp_closed, assumption+)
 apply blast
done

lemma (in Idomain) idom_mult_cancel_r:"[|a ∈ carrier R; 
       b ∈ carrier R; c ∈ carrier R; c ≠ \<zero>; a ·r c = b ·r c|] ==> a = b"
apply (cut_tac ring_is_ag)
 apply (frule ring_tOp_closed[of "a" "c"], assumption+,
        frule ring_tOp_closed[of "b" "c"], assumption+)
 apply (simp add:aGroup.ag_eq_diffzero[of "R" "a ·r c" "b ·r c"],
        simp add:ring_inv1_1,
        frule aGroup.ag_mOp_closed[of "R" "b"], assumption,
        simp add:ring_distrib2[THEN sym, of "c" "a" "-a b"])
 apply (frule aGroup.ag_pOp_closed[of "R" "a" "-a b"], assumption+)
 apply (subst aGroup.ag_eq_diffzero[of R a b], assumption+)
 apply (rule contrapos_pp, simp+)
 apply (frule idom_tOp_nonzeros[of "a ± -a b" c], assumption+, simp)
done

lemma (in Idomain) idom_mult_cancel_l:"[|a ∈ carrier R; 
      b ∈ carrier R; c ∈ carrier R; c ≠ \<zero>; c ·r a = c ·r b|] ==> a = b"
apply (simp add:ring_tOp_commute)
apply (simp add:idom_mult_cancel_r)
done

lemma (in Corps) invf_closed1:"x ∈ carrier K - {\<zero>} ==>
                               invf K x ∈ (carrier K) - {\<zero>}"
apply (frule  invf_inv[of x], erule conjE)
 apply (rule contrapos_pp, simp+)
 apply (cut_tac f_is_ring) apply (
        simp add:Ring.ring_times_0_x[of K])
 apply (frule sym, thin_tac "\<zero> = 1r", simp, erule conjE)
 apply (frule Ring.ring_l_one[of K x], assumption)
 apply (rotate_tac -1, frule sym, thin_tac "1r ·r x = x",
        simp add:Ring.ring_times_0_x)
done

lemma (in Corps) linvf:"x ∈ carrier K - {\<zero>} ==> (invf K x) ·r x = 1r"
by (simp add:invf_inv)

lemma (in Corps) field_is_ring:"Ring K"
by (simp add:f_is_ring)

lemma (in Corps) invf_one:"1r ≠ \<zero>  ==> invf K (1r) = 1r"
apply (cut_tac field_is_ring)
 apply (frule_tac Ring.ring_one)
 apply (cut_tac invf_closed1 [of "1r"]) 
 apply (cut_tac linvf[of "1r"])
 apply (simp add:Ring.ring_r_one[of "K"])
 apply simp+
done

lemma (in Corps) field_tOp_assoc:"[|x ∈ carrier K; y ∈ carrier K; z ∈ carrier K|]
                                ==> x ·r y ·r z =  x ·r (y ·r z)"  
apply (cut_tac field_is_ring)
apply (simp add:Ring.ring_tOp_assoc)
done

lemma (in Corps) field_tOp_commute:"[|x ∈ carrier K; y ∈ carrier K|]
                                ==> x ·r y  =  y ·r x"  
apply (cut_tac field_is_ring)
apply (simp add:Ring.ring_tOp_commute)
done

lemma (in Corps) field_inv_inv:"[|x ∈ carrier K; x ≠ \<zero>|] ==> (x­K)­K = x"
apply (cut_tac invf_closed1[of "x"]) 
 apply (cut_tac invf_inv[of "x­K"], erule conjE)
 apply (frule field_tOp_assoc[THEN sym, of "x­ K­ K" "x­ K" "x"],
        simp, assumption, simp)
 apply (cut_tac field_is_ring,
        simp add:Ring.ring_l_one Ring.ring_r_one, erule conjE,
        cut_tac invf_inv[of x], erule conjE, simp add:Ring.ring_r_one)
 apply simp+
done
        
lemma (in Corps) field_is_idom:"Idomain K" 
apply (rule Idomain.intro)
 apply (simp add:field_is_ring)
 apply (cut_tac field_is_ring)
 apply (rule Idomain_axioms.intro)
 apply (rule contrapos_pp, simp+, erule conjE)
 apply (cut_tac x = a in invf_closed1, simp, simp, erule conjE)
 apply (frule_tac x = "a­ K" and y = a and z = b in field_tOp_assoc, 
         assumption+)
 apply (simp add:linvf Ring.ring_times_x_0 Ring.ring_l_one)
done

lemma (in Corps) field_potent_nonzero:"[|x ∈ carrier K; x ≠ \<zero>|] ==>  
                                       x^K n ≠ \<zero>"
apply (cut_tac field_is_idom)
apply (cut_tac field_is_ring,
       simp add:Idomain.idom_potent_nonzero)
done

lemma (in Corps) field_potent_nonzero1:"[|x ∈ carrier K; x ≠ \<zero>|] ==> xKn  ≠ \<zero>" 
apply (simp add:npowf_def)
apply (case_tac "0 ≤ n") 
apply (simp add:field_potent_nonzero)

apply simp
 apply (cut_tac invf_closed1[of "x"], simp+, (erule conjE)+) 
 apply (simp add:field_potent_nonzero) 
 apply simp 
done

lemma (in Corps) field_nilp_zero:"[|x ∈ carrier K; x^K n = \<zero>|] ==> x = \<zero>"
by (rule contrapos_pp, simp+, simp add:field_potent_nonzero)

lemma (in Corps) npowf_mem:"[|a ∈ carrier K; a ≠ \<zero>|] ==> 
                                    npowf K a n ∈ carrier K"
apply (simp add:npowf_def) 
apply (cut_tac field_is_ring)
apply (case_tac "0 ≤ n", simp,
       simp add:Ring.npClose, simp)

apply (cut_tac invf_closed1[of "a"], simp, erule conjE,
       simp add:Ring.npClose, simp) 
done

lemma (in Corps) field_npowf_exp_zero:"[|a ∈ carrier K; a ≠ \<zero>|] ==> 
                                    npowf K a 0 = 1r"
by (cut_tac field_is_ring, simp add:npowf_def)

lemma (in Corps) npow_exp_minusTr1:"[|x ∈ carrier K; x ≠ \<zero>; 0 ≤ i|]  ==> 
       0 ≤ i - (int j) -->  xK(i - (int j)) = x^K (nat i) ·r (x­K)^K j"
apply (cut_tac field_is_ring,
       cut_tac invf_closed1[of "x"], simp,
       simp add:npowf_def, erule conjE)
apply (induct_tac "j", simp)
 apply (frule Ring.npClose[of "K" "x" "nat i"], assumption+,
        simp add:Ring.ring_r_one)
apply (rule impI, simp)
 apply (subst zdiff)
 apply (simp add:zadd_commute[of "1"])
 apply (cut_tac z = i and w = "int n + 1" in zdiff,
       simp only:zminus_zadd_distrib,
       thin_tac "i - (int n + 1) = i + (- int n + - 1)")
 apply (simp only:zadd_assoc[THEN sym])
 apply (simp only:zdiff[THEN sym, of _ "1"])
 apply (cut_tac z = "i + - int n" in nat_diff_distrib[of "1"],
         simp, simp)
 apply (simp only:zdiff[of _ "1"], simp)
 
apply (cut_tac field_is_idom)
apply (frule_tac n = "nat i" in Ring.npClose[of "K" "x"], assumption+,
       frule_tac n = "nat i" in Ring.npClose[of "K" "x­ K"], assumption+,
       frule_tac n = n in Ring.npClose[of "K" "x­ K"], assumption+ )
apply (rule_tac a = "x^K (nat (i - int n) - Suc 0)" and 
       b = "x^K (nat i) ·r (x­ K^K n ·r x­ K)" and c = x in 
       Idomain.idom_mult_cancel_r[of "K"], assumption+)
 apply (simp add:Ring.npClose, rule Ring.ring_tOp_closed, assumption+,
        rule Ring.ring_tOp_closed, assumption+)
 apply (subgoal_tac "0 < nat (i - int n)")
 apply (subst Ring.npMulElmR, assumption+, simp,
        simp add:field_tOp_assoc[THEN sym, of "x^K (nat i)" _ "x­ K"])
 apply (subst field_tOp_assoc[of _ _ x]) 
 apply (rule Ring.ring_tOp_closed[of K], assumption+)
 apply (simp add: linvf)
 apply (subst Ring.ring_r_one[of K], assumption)
 apply (rule Ring.ring_tOp_closed[of K], assumption+, simp)

 apply arith
apply simp
done

lemma (in Corps) npow_exp_minusTr2:"[|x ∈ carrier K; x ≠ \<zero>; 0 ≤ i; 0 ≤ j; 
                 0 ≤ i - j|]  ==>  xK(i - j) = x^K (nat i) ·r (x­K)^K (nat j)"
apply (frule npow_exp_minusTr1[of "x" "i" "nat j"], assumption+)
apply simp
done 

lemma (in Corps) npowf_inv:"[|x ∈ carrier K; x ≠ \<zero>; 0 ≤ j|] ==> xKj = (x­K)K(-j)"
apply (simp add:npowf_def)
 apply (rule impI, simp add:zle)
 apply (simp add:field_inv_inv)
done

lemma (in Corps) npowf_inv1:"[|x ∈ carrier K; x ≠ \<zero>; ¬ 0 ≤ j|] ==>
                                      xKj = (x­K)K(-j)"
apply (simp add:npowf_def)
done

lemma (in Corps) npowf_inverse:"[|x ∈ carrier K; x ≠ \<zero>|] ==> xKj = (x­K)K(-j)"
apply (case_tac "0 ≤ j")
apply (simp add:npowf_inv, simp add:npowf_inv1)
done

lemma (in Corps) npowf_expTr1:"[|x ∈ carrier K; x ≠ \<zero>; 0 ≤ i; 0 ≤ j; 
                 0 ≤ i - j|] ==> xK(i - j) = xKi ·r xK(- j)"
apply (simp add:npow_exp_minusTr2)
apply (simp add:npowf_def)
done 

lemma (in Corps) npowf_expTr2:"[|x ∈ carrier K; x ≠ \<zero>; 0 ≤ i + j|] ==>
                          xK(i + j) = xKi ·r xKj"
apply (cut_tac field_is_ring)
 apply (case_tac "0 ≤ i")
  apply (case_tac "0 ≤ j")
  apply (simp add:npowf_def, simp add:nat_add_distrib,
         rule Ring.npMulDistr[THEN sym], assumption+)
 apply (subst zminus_minus[THEN sym, of "i" "j"],
        subst npow_exp_minusTr2[of "x" "i" "-j"], assumption+)
  apply (simp add:zle, simp add:zless_imp_zle, simp add:npowf_def)
 apply (simp add:zadd_commute[of "i" "j"],
        subst zminus_minus[THEN sym, of "j" "i"],
        subst npow_exp_minusTr2[of "x" "j" "-i"], assumption+)
  apply (simp add:zle, simp add:zless_imp_zle, simp)
  apply (frule npowf_mem[of "x" "i"], assumption+,
         frule npowf_mem[of "x" "j"], assumption+,
         simp add:field_tOp_commute[of "xKi" "xKj"])
  apply (simp add:npowf_def)
done

lemma (in Corps) npowf_exp_add:"[|x ∈ carrier K; x ≠ \<zero>|] ==>
                          xK(i + j) = xKi ·r xKj"
apply (case_tac "0 ≤ i + j")
apply (simp add:npowf_expTr2)
apply (simp add:npowf_inv1[of "x" "i + j"])
 apply (simp add:zle)
apply (subgoal_tac "0 < -i + -j") prefer 2 apply simp
 apply (thin_tac "i + j < 0")  
 apply (frule zless_imp_zle[of "0" "-i + -j"])
 apply (thin_tac "0 < -i + -j")
apply (cut_tac invf_closed1[of "x"])
apply (simp, erule conjE,
       frule npowf_expTr2[of "x­K" "-i" "-j"], assumption+)
 apply (simp add:zdiff[THEN sym])
apply (simp add:npowf_inverse, simp)
done

lemma (in Corps) npowf_exp_1_add:"[|x ∈ carrier K; x ≠ \<zero>|] ==>
                                        xK(1 + j) = x ·r xKj"
apply (simp add:npowf_exp_add[of "x" "1" "j"])
apply (cut_tac field_is_ring)
apply (simp add:npowf_def, simp add:Ring.ring_l_one)
done

lemma (in Corps) npowf_minus:"[|x ∈ carrier K; x ≠ \<zero>|] ==> (xKj)­K = xK(- j)"
apply (frule npowf_exp_add[of "x" "j" "-j"], assumption+)
 apply (simp add:field_npowf_exp_zero)
apply (cut_tac field_is_ring) 
apply (frule npowf_mem[of "x" "j"], assumption+)
 apply (frule field_potent_nonzero1[of "x" "j"], assumption+) 
apply (cut_tac invf_closed1[of "xKj"], simp, erule conjE,
       frule Ring.ring_r_one[of "K" "(xKj)­K"], assumption, simp,
      thin_tac "1r = xKj ·r xK- j",
      frule npowf_mem[of "x" "-j"], assumption+)
apply (simp add:field_tOp_assoc[THEN sym], simp add:linvf,
       simp add:Ring.ring_l_one, simp)
done
 
lemma (in Ring) residue_fieldTr:"[|maximal_ideal R mx; x ∈ carrier(qring R mx); 
 x ≠ \<zero>(qring R mx)|] ==>∃y∈carrier (qring R mx). y ·r(qring R mx) x = 1r(qring R mx)"
apply (frule maximal_ideal_ideal[of "mx"])
apply (simp add:qring_carrier)
 apply (simp add:qring_zero)
 apply (simp add:qring_def)
 apply (erule bexE)
 apply (frule sym, thin_tac "a \<uplus>R mx = x", simp)
 apply (frule_tac a = a in ar_coset_same4_1[of "mx"], assumption+) 
 apply (frule_tac x = a in maximal_prime_Tr0[of "mx"], assumption+)
 apply (cut_tac ring_one)
 apply (rotate_tac -2, frule sym, thin_tac "mx \<minusplus> R ♦p a = carrier R")
 apply (frule_tac B = "mx \<minusplus> R ♦p a" in eq_set_inc[of "1r" "carrier R"],
                  assumption+,
        thin_tac "carrier R = mx \<minusplus> R ♦p a")
 apply (frule ideal_subset1[of mx])
 apply (frule_tac a = a in principal_ideal,
        frule_tac I = "R ♦p a" in ideal_subset1)
 apply (cut_tac ring_is_ag,
        simp add:aGroup.set_sum, (erule bexE)+)
 apply (thin_tac "ideal R (R ♦p a)", thin_tac "R ♦p a ⊆ carrier R",
        simp add:Rxa_def, (erule bexE)+, simp, thin_tac "k = r ·r a")
 apply (frule_tac a = r and b = a in rcostOp[of "mx"], assumption+)
 apply (frule_tac x = r and y = a in ring_tOp_closed, assumption+)
 apply (frule_tac a = "r ·r a" and x = h and b = "1r" in 
        aGroup.ag_eq_sol2[of "R"], assumption+)
       apply (simp add:ideal_subset) apply (simp add:ring_one, simp)
       apply (frule_tac a = h and b = "1r ± -a (r ·r a)" and A = mx in 
              eq_elem_in, assumption+)
 apply (frule_tac a = "r ·r a" and b = "1r" in ar_coset_same1[of "mx"],
        rule ring_tOp_closed, assumption+, rule ring_one, assumption)
  apply (frule_tac a1 = "r ·r a" and h1 = h in aGroup.arcos_fixed[THEN sym, 
         of R mx],  unfold ideal_def, erule conjE, assumption+,
         thin_tac "R +> mx ∧ (∀r∈carrier R. ∀x∈mx. r ·r x ∈ mx)",
         thin_tac "x = a \<uplus>R mx",
         thin_tac "1r = h ± r ·r a", 
         thin_tac "h = 1r ± -a (r ·r a)", thin_tac "1r ± -a (r ·r a) ∈ mx")
  apply (rename_tac b h k r) apply simp
  apply blast
done 

(*
constdefs (structure R)
 field_cd::"_ => bool"
 "field_cd R  == ∀x∈(carrier R - {\<zero>}). ∃y∈carrier R. 
                                                y ·r x = 1r" *)
(* field condition  *) (* 
constdefs (structure R)
 rIf :: "_ => 'a  => 'a " *) (** rIf is ring_invf **) (*
 "rIf R == λx. (SOME y. y ∈ carrier R ∧ y ·r x = 1r)"
*) (*
constdefs (structure R)
  Rf::"_ => 'a field"
  "Rf R == (|carrier = carrier R, pop = pop R, mop = mop R, zero = zero R, 
               tp = tp R, un = un R, invf = rIf R|))," *)

(*
constdefs (structure R)
 Rf ::  "_ => (| carrier :: 'a set,
  pOp :: ['a, 'a] => 'a, mOp ::'a => 'a, zero :: 'a, tOp :: ['a, 'a] => 'a,
  one ::'a, iOp ::'a => 'a|))," 

  "Rf R  == (| carrier = carrier R, pOp = pOp R, mOp = mOp R, zero = zero R, 
  tOp = tOp R, one = one R, iOp = ring_iOp R|))," *)
(*
lemma (in Ring) rIf_mem:"[|field_cd R; x ∈ carrier R - {\<zero>}|] ==> 
                     rIf R x ∈ carrier R ∧ rIf R x ≠ \<zero>"
apply (simp add:rIf_def)
apply (rule someI2_ex) 
apply (simp add:field_cd_def, blast)
apply (simp add:field_cd_def)
 apply (thin_tac "∀x∈carrier R - {\<zero>}. ∃y∈carrier R. y ·r x = 1r")
 apply (erule conjE)+
 apply (rule contrapos_pp, simp+) 
 apply (frule sym, thin_tac "\<zero> ·r x = 1r", simp add:ring_times_0_x)
  apply (frule ring_l_one[of "x"])
 apply (simp add:ring_times_0_x)
done

lemma (in Ring) rIf:"[|field_cd R; x ∈ carrier R - {\<zero>}|] ==> 
                                           (rIf R x) ·r x = 1r"
apply (simp add:rIf_def)
apply (rule someI2_ex)
apply (simp add:field_cd_def, blast) 
apply simp
done

lemma (in Ring) field_cd_integral:"field_cd R ==> Idomain R"
apply (rule Idomain.intro)
 apply assumption
 apply (rule Idomain_axioms.intro)

apply (rule contrapos_pp, simp+, erule conjE)
apply (cut_tac x = a in rIf_mem, assumption, simp, erule conjE)
apply (frule_tac x = "rIf R a" and y = a and z = b in ring_tOp_assoc, 
                 assumption+, simp add:rIf)
apply (simp add:ring_l_one ring_times_x_0)
done

lemma (in Ring) Rf_field:"field_cd R ==> field (Rf R)"
apply (rule field.intro)
 apply (simp add:Rf_def)
 apply (rule Ring.intro)
 apply (simp add:pop_closed)
 apply ( cut_tac ring_is_ag, simp add:aGroup.ag_pOp_assoc)
 apply (simp add:Rf_def,
         cut_tac ring_is_ag, simp add:aGroup.ag_pOp_commute)
 apply (simp add:mop_closed) 
 apply (simp add:
 

apply (rule conjI)
 prefer 2
 apply (rule conjI)
 apply (rule univar_func_test, rule ballI)
 apply (simp, erule conjE, simp add:Rf_def)
 apply (rule rIf_mem, assumption+, simp)
apply (rule allI, rule impI) 
 apply (simp add:Rf_def)
 apply (frule_tac x = x in rIf, simp, assumption)

 apply (subst Rf_def, simp add:Ring_def)
 apply (cut_tac ring_is_ag)
 apply (rule conjI, simp add:aGroup_def)
 apply (rule conjI, (rule allI, rule impI)+, simp add:aGroup.ag_pOp_assoc)
 apply (rule conjI, (rule allI, rule impI)+, simp add:aGroup.ag_pOp_commute)
 apply (rule conjI, rule univar_func_test, rule ballI,
                                              simp add:aGroup.ag_mOp_closed)
 apply (rule conjI, rule allI, rule impI, simp add:aGroup.ag_l_inv1)
 apply (simp add:aGroup.ag_inc_zero)
 apply (rule conjI, rule allI, rule impI, simp add:aGroup.ag_l_zero)

 apply (rule conjI, rule bivar_func_test, (rule ballI)+, 
                                          simp add:ring_tOp_closed)
 apply (rule conjI, (rule allI, rule impI)+, simp add:ring_tOp_assoc)
 apply (rule conjI, (rule allI, rule impI)+, simp add:ring_tOp_commute)
 apply (simp add:ring_one)
 apply (rule conjI, (rule allI, rule impI)+, simp add:ring_distrib1)
 apply (rule allI, rule impI, simp add:ring_l_one)
done
 *)

lemma (in Ring) residue_field_cd:"maximal_ideal R mx ==>
                                           Corps (qring R mx)"
apply (rule Corps.intro)
apply (rule Ring.qring_ring, rule Ring_axioms)
apply (simp add:maximal_ideal_ideal)
apply (simp add:residue_fieldTr[of "mx"])
done

(*
lemma (in Ring) qRf_field:"maximal_ideal R mx ==> field (Rf (qring R mx))"
apply (frule maximal_ideal_ideal[of "mx"])
apply (frule qring_ring [of "mx"])
 apply (frule residue_field_cd[of "mx"])
 apply (rule Ring.Rf_field, assumption+)
done

lemma (in Ring) qRf_pj_rHom:"maximal_ideal R mx ==> 
                          (pj R mx) ∈ rHom R (Rf (qring R mx))"
apply (frule maximal_ideal_ideal[of "mx"]) 
apply (frule pj_Hom[OF Ring, of "mx"])
apply (simp add:rHom_def aHom_def Rf_def)
done *)

lemma (in Ring) maximal_set_idealTr:
       "maximal_set {I. ideal R I ∧ S ∩ I = {}} mx ==> ideal R mx" 
by (simp add:maximal_set_def)

lemma (in Ring) maximal_setTr:"[|maximal_set {I. ideal R I ∧ S ∩ I = {}} mx; 
                                         ideal R J; mx ⊂ J |] ==> S ∩ J ≠ {}"
by (rule contrapos_pp, simp+, simp add:psubset_eq, erule conjE,
       simp add:maximal_set_def)

lemma (in Ring) mulDisj:"[|mul_closed_set R S; 1r ∈ S; \<zero> ∉ S; 
    T = {I. ideal R I ∧ S ∩ I = {}}; maximal_set T mx |] ==> prime_ideal R mx"
apply (simp add:prime_ideal_def)
apply (rule conjI, simp add:maximal_set_def,
       rule conjI, simp add:maximal_set_def)
apply (rule contrapos_pp, simp+)
apply ((erule conjE)+, blast)

apply ((rule ballI)+, rule impI)
apply (rule contrapos_pp, simp+, (erule conjE)+)
apply (cut_tac a = x in id_ideal_psub_sum[of "mx"],
               simp add:maximal_set_def, assumption+,
       cut_tac a = y in id_ideal_psub_sum[of "mx"],
               simp add:maximal_set_def, assumption+)
apply (frule_tac J = "mx \<minusplus> R ♦p x" in maximal_setTr[of "S" "mx"],
       rule sum_ideals, simp add:maximal_set_def,
       simp add:principal_ideal, assumption,
       thin_tac "mx ⊂ mx \<minusplus> R ♦p x")
apply (frule_tac J = "mx \<minusplus> R ♦p y" in maximal_setTr[of "S" "mx"],
       rule sum_ideals, simp add:maximal_set_def,
       simp add:principal_ideal, assumption,
       thin_tac "mx ⊂ mx \<minusplus> R ♦p y")
apply (frule_tac A = "S ∩ (mx \<minusplus> R ♦p x)" in nonempty_ex,
       frule_tac A = "S ∩ (mx \<minusplus> R ♦p y)" in nonempty_ex, 
       (erule exE)+, simp, (erule conjE)+)
apply (rename_tac x y s1 s2,
       thin_tac "S ∩ (mx \<minusplus> R ♦p x) ≠ {}",
       thin_tac "S ∩ (mx \<minusplus> R ♦p y) ≠ {}") 
apply (frule maximal_set_idealTr,
       frule_tac a = x in principal_ideal, 
       frule_tac a = y in principal_ideal, 
       frule ideal_subset1[of mx],
       frule_tac I = "R ♦p x" in ideal_subset1,
       frule_tac I = "R ♦p y" in ideal_subset1)
apply (cut_tac ring_is_ag,
       simp add:aGroup.set_sum[of R mx],
       erule bexE, erule bexE, simp)
apply (frule_tac s = s1 and t = s2 in mul_closed_set_tOp_closed, simp, 
       assumption, simp,
       frule_tac c = h in subsetD[of mx "carrier R"], assumption+,
       frule_tac c = k and A = "R ♦p x" in subsetD[of _ "carrier R"], 
       assumption+) 
apply (
       cut_tac mul_closed_set_sub, 
       frule_tac c = s2 in subsetD[of S "carrier R"], assumption+,
       simp add:ring_distrib2)
apply ((erule bexE)+, simp,
       frule_tac c = ha in subsetD[of mx "carrier R"], assumption+,
       frule_tac c = ka and A = "R ♦p y" in subsetD[of _ "carrier R"], 
       assumption+,
       simp add:ring_distrib1)
apply (frule_tac x = h and r = ha in ideal_ring_multiple1[of mx], assumption+)
apply (frule_tac x = h and r = ka in ideal_ring_multiple1[of mx], assumption+,
       frule_tac x = ha and r = k in ideal_ring_multiple[of mx], assumption+)
apply (frule_tac a = x and b = y and x = k and y = ka in 
                  mul_two_principal_idealsTr, assumption+,
       erule bexE,
       frule_tac x = "x ·r y" and r = r in ideal_ring_multiple[of mx],
       assumption+,
       rotate_tac -2, frule sym, thin_tac "k ·r ka = r ·r (x ·r y)", simp)
 apply (frule_tac x = "h ·r ha ± h ·r ka" and y = "k ·r ha ± k ·r ka" in 
        ideal_pOp_closed[of mx])
 apply (rule ideal_pOp_closed, assumption+)+
 apply (simp add:maximal_set_def)
 apply blast
 apply assumption
done

lemma (in Ring) ex_mulDisj_maximal:"[|mul_closed_set R S; \<zero> ∉ S; 1r ∈ S;  
       T = {I. ideal R I ∧ S ∩ I = {}}|] ==>  ∃mx. maximal_set T mx" 
apply (cut_tac S="{ I. ideal R I ∧ S ∩ I = {}}" in Zorn_Lemma2)
prefer 2
  apply (simp add:maximal_set_def)

apply (rule ballI)
apply (case_tac "c = {}")
 apply (cut_tac zero_ideal, blast) 

apply (subgoal_tac "c ∈ chain {I. ideal R I ∧ I ⊂ carrier R}")
apply (frule chain_un, assumption)
 apply (subgoal_tac "S ∩ (\<Union> c) = {}")
 apply (subgoal_tac "∀x∈c. x ⊆ \<Union> c",  blast)
apply (rule ballI, rule subsetI, simp add:CollectI)
 apply blast

apply (rule contrapos_pp, simp+)
 apply (frule_tac A = S and B = "\<Union> c" in nonempty_int)
 apply (erule exE)
 apply (simp add:Inter_def, erule conjE, erule bexE) 
 apply (simp add:chain_def, erule conjE)
 apply (frule_tac c = X and A = c and B = "{I. ideal R I ∧ S ∩ I = {}}" in
        subsetD, assumption+,
        thin_tac "c ⊆ {I. ideal R I ∧ I ⊂ carrier R}",
        thin_tac "c ⊆ {I. ideal R I ∧ S ∩ I = {}}")
 apply (simp, blast)

apply (simp add:chain_def chain_subset_def, erule conjE)
 apply (rule subsetI)
 apply (frule_tac c = x and A = c and B = "{I. ideal R I ∧ S ∩ I = {}}" in 
                  subsetD, assumption+,
        thin_tac "c ⊆ {I. ideal R I ∧ S ∩ I = {}}",
        thin_tac "T = {I. ideal R I ∧ S ∩ I = {}}")
 apply (simp, thin_tac "∀x∈c. ∀y∈c. x ⊆ y ∨ y ⊆ x", erule conjE)
 apply (simp add:psubset_eq ideal_subset1)
 apply (rule contrapos_pp, simp+)
 apply (rotate_tac -1, frule sym, thin_tac "x = carrier R", 
        thin_tac "carrier R = x")
 apply (cut_tac ring_one, blast)
done

lemma (in Ring) ex_mulDisj_prime:"[|mul_closed_set R S; \<zero> ∉ S; 1r ∈ S|] ==> 
                            ∃mx. prime_ideal R mx ∧ S ∩ mx = {}" 
apply (frule ex_mulDisj_maximal[of "S" "{I. ideal R I ∧ S ∩ I = {}}"],
               assumption+, simp, erule exE)
 apply (frule_tac mx = mx in mulDisj [of "S" "{I. ideal R I ∧ S ∩ I = {}}"], 
                  assumption+, simp, assumption)
 apply (simp add:maximal_set_def, (erule conjE)+, blast)
done

lemma (in Ring) nilradTr1:"¬ zeroring R ==> nilrad R = \<Inter> {p. prime_ideal R p}"
apply (rule equalityI)
 (* nilrad R ⊆ \<Inter>Collect (prime_ideal R) *)
apply (rule subsetI)
 apply (simp add:nilrad_def CollectI nilpotent_def) 
 apply (erule conjE, erule exE)
 apply (rule allI, rule impI)
 apply (frule_tac prime_ideal_ideal) 
 apply (frule sym, thin_tac "x^R n = \<zero>", frule ideal_zero, simp)
 apply (case_tac "n = 0", simp)
 apply (frule Zero_ring1[THEN not_sym], simp)
 apply (rule_tac P = xa and x = x in npow_in_prime,assumption+, blast) 

apply (rule subsetI)
 apply (rule contrapos_pp, simp+)
 apply (frule id_maximal_Exist, erule exE,
        frule maximal_is_prime)
 apply (frule_tac a = I in forall_spec, assumption,
        frule_tac I = I in prime_ideal_ideal, 
        frule_tac h = x and I = I in ideal_subset, assumption)
apply (subgoal_tac "\<zero> ∉ {s. ∃n. s = npow R x n} ∧ 
                                  1r ∈ {s. ∃n. s = npow R x n}")
apply (subgoal_tac "mul_closed_set R {s. ∃n. s = npow R x n}")
apply (erule conjE)
apply (frule_tac S = "{s. ∃n. s = npow R x n}" in ex_mulDisj_prime,
       assumption+, erule exE, erule conjE)
apply (subgoal_tac "x ∈ {s. ∃n. s = x^R n}", blast)

apply simp 
apply (cut_tac t = x in np_1[THEN sym], assumption, blast)

apply (thin_tac "\<zero> ∉ {s. ∃n. s = x^R n} ∧ 1r ∈ {s. ∃n. s = x^R n}",
       thin_tac "∀xa. prime_ideal R xa --> x ∈ xa")
apply (subst mul_closed_set_def)
 apply (rule conjI)
 apply (rule subsetI, simp, erule exE)
 apply (simp add:npClose)
apply ((rule ballI)+, simp, (erule exE)+, simp)
 apply (simp add:npMulDistr, blast)

apply (rule conjI)
 apply simp
 apply (rule contrapos_pp, simp+, erule exE)
 apply (frule sym, thin_tac "\<zero> = x^R n")
 apply (simp add:nilrad_def nilpotent_def)

apply simp
 apply (cut_tac x1 = x in npow_0[THEN sym, of "R"], blast)
done

lemma (in Ring) nonilp_residue_nilrad:"[|¬ zeroring R; x ∈ carrier R; 
        nilpotent (qring R (nilrad R)) (x \<uplus>R (nilrad R))|] ==>
                   x \<uplus>R (nilrad R) = \<zero>(qring R (nilrad R))"
apply (simp add:nilpotent_def)
 apply (erule exE)
 apply (cut_tac id_nilrad_ideal)
 apply (simp add:qring_zero) 
 apply (cut_tac "Ring")
 apply (simp add:npQring)
 apply (frule_tac x = x and n = n in npClose)
 apply (frule_tac I = "nilrad R" and a = "x^R n" in ar_coset_same3,
             assumption+)
 apply (rule_tac I = "nilrad R" and a = x in ar_coset_same4, assumption)
 apply (thin_tac "x^R n \<uplus>R nilrad R = nilrad R", 
        simp add:nilrad_def nilpotent_def, erule exE)
 apply (simp add:npMulExp, blast)
done

lemma (in Ring) ex_contid_maximal:"[| S = {1r}; \<zero> ∉ S; ideal R I; I ∩ S = {};
T = {J. ideal R J ∧ S ∩ J = {} ∧ I ⊆ J}|] ==> ∃mx. maximal_set T mx" 
apply (cut_tac S="{J. ideal R J ∧ S ∩ J = {} ∧ I ⊆ J}" in Zorn_Lemma2)
apply (rule ballI)
apply (case_tac "c = {}") (** case c = {} **)
 apply blast             (** case c = {} done **)
     (** existence of sup in c **)
apply (subgoal_tac "\<Union>c∈{J. ideal R J ∧ S ∩ J = {} ∧ I ⊆ J} ∧ 
                                         (∀x∈c. x ⊆  \<Union>c)")  
 apply blast
apply (rule conjI,
       simp add:CollectI)
apply (subgoal_tac "c ∈ chain {I. ideal R I ∧ I ⊂ carrier R}")
apply (rule conjI,
       simp add:chain_un)
apply (rule conjI)
apply (rule contrapos_pp, simp+, erule bexE)
 apply (thin_tac " c ∈ chain {I. ideal R I ∧ I ⊂ carrier R}")
 apply (simp add:chain_def, erule conjE)
 apply (frule_tac c = x and A = c and B = "{J. ideal R J ∧ 1r ∉ J ∧ I ⊆ J}" 
         in subsetD, assumption+, simp,
        thin_tac "c ∈ chain {I. ideal R I ∧ I ⊂ carrier R}")
 apply (frule_tac A = c in nonempty_ex, erule exE, simp add:chain_def,
        erule conjE,
        frule_tac c = x and A = c and B = "{J. ideal R J ∧ 1r ∉ J ∧ I ⊆ J}" in
                  subsetD, assumption+, simp, (erule conjE)+)
 apply (rule_tac A = I and B = x and C = "\<Union>c" in subset_trans, assumption,
        rule_tac B = x and A = c in Union_upper, assumption+)
 apply (simp add:chain_def, erule conjE)
 apply (rule subsetI, simp)
 apply (frule_tac c = x and A = c and B = "{J. ideal R J ∧ 1r ∉ J ∧ I ⊆ J}"
        in subsetD, assumption+, simp, (erule conjE)+)
 apply (subst psubset_eq, simp add:ideal_subset1)
 apply (rule contrapos_pp, simp+, simp add:ring_one)
 
 apply (rule ballI)
 apply (rule Union_upper, assumption)
 apply (erule bexE)
 apply (simp add:maximal_set_def)
 apply blast
done

lemma (in Ring) contid_maximal:"[|S = {1r}; \<zero> ∉ S; ideal R I; I ∩ S = {};
             T = {J. ideal R J ∧ S ∩ J = {} ∧ I ⊆ J}; maximal_set T mx|] ==> 
                                                maximal_ideal R mx"
apply (simp add:maximal_set_def maximal_ideal_def)
apply (erule conjE)+
apply (rule equalityI)
  (** {J. ideal R J ∧ mx ⊆ J} ⊆ {mx, carrier R} **) 
  apply (rule subsetI, simp add:CollectI, erule conjE)
 apply (case_tac "x = mx", simp, simp)
 apply (subgoal_tac "1r ∈ x")
 apply (rule_tac  I = x in ideal_inc_one, assumption+)
 apply (rule contrapos_pp, simp+)
 apply (subgoal_tac "mx = x", 
        rotate_tac -3, frule not_sym) 
 apply (simp, blast)
apply (rule subsetI, 
            simp add:CollectI)
 apply (case_tac "x = mx", simp, simp)
 apply (simp add:whole_ideal,
        rule subsetI, rule ideal_subset[of "mx"], assumption+)
done

lemma (in Ring) ideal_contained_maxid:"[|¬(zeroring R); ideal R I; 1r ∉ I|] ==>
                    ∃mx. maximal_ideal R mx ∧ I ⊆ mx"
apply (cut_tac ex_contid_maximal[of "{1r}" "I"
                      "{J. ideal R J ∧ {1r} ∩ J = {} ∧ I ⊆ J}"])
apply (erule exE,
       cut_tac mx = mx in contid_maximal[of "{1r}" "I"
                         "{J. ideal R J ∧ {1r} ∩ J = {} ∧ I ⊆ J}"])
apply simp
 apply (frule Zero_ring1, simp,
        assumption, simp, simp, simp,
        simp add:maximal_set_def, (erule conjE)+, blast,
        simp, frule Zero_ring1, simp)
 apply (assumption, simp, simp)
done

lemma (in Ring) nonunit_principal_id:"[|a ∈ carrier R; ¬ (Unit R a)|] ==>
                                             (R ♦p a) ≠ (carrier R)"
apply (rule contrapos_pp, simp+)
apply (frule sym, thin_tac "R ♦p a = carrier R")
apply (cut_tac ring_one)
 apply (frule eq_set_inc[of "1r" "carrier R" "R ♦p a"], assumption,
        thin_tac "carrier R = R ♦p a", thin_tac "1r ∈ carrier R")
apply (simp add:Rxa_def, erule bexE, simp add:ring_tOp_commute[of _ "a"],
       frule sym, thin_tac "1r = a ·r r")
apply (simp add:Unit_def)
done

lemma (in Ring) nonunit_contained_maxid:"[|¬(zeroring R); a ∈ carrier R; 
                ¬ Unit R a |]  ==>  ∃mx. maximal_ideal R mx ∧ a ∈  mx"
apply (frule principal_ideal[of "a"],
       frule ideal_contained_maxid[of "R ♦p a"], assumption)
 apply (rule contrapos_pp, simp+,
        frule ideal_inc_one[of "R ♦p a"], assumption,
        simp add:nonunit_principal_id)
apply (erule exE, erule conjE)
 apply (frule a_in_principal[of "a"])
 apply (frule_tac B = mx in subsetD[of "R ♦p a" _ "a"], assumption, blast)
done

constdefs (structure R)
 local_ring :: "_ => bool"
 "local_ring R == Ring R ∧ ¬ zeroring R ∧ card {mx. maximal_ideal R mx} = 1"

lemma (in Ring) local_ring_diff:"[|¬ zeroring R; ideal R mx; mx ≠ carrier R;
  ∀a∈ (carrier R - mx). Unit R a |] ==> local_ring R ∧ maximal_ideal R mx" 
apply (subgoal_tac "{mx} = {m. maximal_ideal R m}")
 apply (cut_tac singletonI[of "mx"], simp)
 apply (frule sym, thin_tac "{mx} = {m. maximal_ideal R m}")  
 apply (simp add:local_ring_def, simp add:Ring)
apply (rule equalityI)
 apply (rule subsetI, simp)
 apply (simp add:maximal_ideal_def) 
 apply (simp add:ideal_inc_one1[of "mx", THEN sym])
 apply (thin_tac "x = mx", simp)
 apply (rule equalityI)
  apply (rule subsetI, simp, erule conjE)
  apply (case_tac "x ≠ mx")
  apply (frule_tac A = x and B = mx in sets_not_eq, assumption)
  apply (erule bexE)
  apply (frule_tac h = a and I = x in ideal_subset, assumption+)
  apply (frule_tac b = a in forball_spec1, simp)
  apply (frule_tac I = x and a = a in ideal_inc_unit1, assumption+,
        simp)
  apply simp
 
  apply (rule subsetI, simp)
  apply (erule disjE)
  apply simp
  apply (simp add:whole_ideal ideal_subset1)

apply (rule subsetI)
 apply simp
 apply (subgoal_tac "x ⊆ mx",
        thin_tac "∀a∈carrier R - mx. Unit R a",
        simp add:maximal_ideal_def, (erule conjE)+)
 apply (subgoal_tac "mx ∈ {J. ideal R J ∧ x ⊆ J}", simp)
 apply (thin_tac "{J. ideal R J ∧ x ⊆ J} = {x, carrier R}")
 apply simp

 apply (rule contrapos_pp, simp+)
 apply (simp add:subset_eq, erule bexE)
 apply (frule_tac mx = x in maximal_ideal_ideal,
        frule_tac b = xa in forball_spec1, 
        thin_tac "∀a∈carrier R - mx. Unit R a", simp,
        simp add:ideal_subset)
 apply (frule_tac I = x and a = xa in ideal_inc_unit, assumption+,
                  simp add:maximal_ideal_def)
done

lemma (in Ring) localring_unit:"[|¬ zeroring R; maximal_ideal R mx; 
                ∀x. x ∈ mx --> Unit R (x ± 1r) |] ==> local_ring R"
apply (frule maximal_ideal_ideal[of "mx"])
apply (frule local_ring_diff[of "mx"], assumption)
 apply (simp add:maximal_ideal_def, erule conjE)
 apply (simp add:ideal_inc_one1[THEN sym, of "mx"])
 apply (rule ballI, simp, erule conjE)

 apply (frule_tac x = a in maximal_prime_Tr0[of "mx"], assumption+)

 apply (frule sym, thin_tac "mx \<minusplus> R ♦p a = carrier R", 
        cut_tac ring_one, 
        frule_tac a = "1r" and A = "carrier R" and B = "mx \<minusplus> R ♦p a" in
                  eq_set_inc, assumption+,
        thin_tac "carrier R = mx \<minusplus> R ♦p a")
 apply (frule_tac a = a in principal_ideal, 
       frule ideal_subset1[of mx],
       frule_tac I = "R ♦p a" in ideal_subset1)
 apply (cut_tac ring_is_ag,
        simp add:aGroup.set_sum, (erule bexE)+)
 apply (simp add:Rxa_def, erule bexE, simp)
 apply (frule sym, thin_tac "1r = h ± r ·r a",
        frule_tac x = r and y = a in ring_tOp_closed, assumption+,
        frule_tac h = h in ideal_subset[of "mx"], assumption+)
 apply (frule_tac I = mx and x = h in ideal_inv1_closed, assumption)
 apply (frule_tac a = "-a h" in forall_spec, assumption,
        thin_tac "∀x. x ∈ mx --> Unit R (x ± (h ± r ·r a))",
        thin_tac "h ± r ·r a = 1r")
 apply (frule_tac h = "-a h" in ideal_subset[of "mx"], assumption, 
        frule_tac x1 = "-a h" and y1 = h and z1 = "r ·r a" in 
        aGroup.ag_pOp_assoc[THEN sym], assumption+,
        simp add:aGroup.ag_l_inv1 aGroup.ag_l_zero,
        thin_tac "k = r ·r a", thin_tac "h ± r ·r a ∈ carrier R",
        thin_tac "h ∈ carrier R", thin_tac "-a h ∈ mx",
        thin_tac "-a h ± (h ± r ·r a) = r ·r a")
 apply (simp add:ring_tOp_commute, simp add:Unit_def, erule bexE,
        simp add:ring_tOp_assoc,
        frule_tac x = r and y = b in ring_tOp_closed, assumption+, blast)
 apply simp
done

constdefs (structure R)
 J_rad ::"_ => 'a set"
  "J_rad R == if (zeroring R) then (carrier R) else
                 \<Inter> {mx. maximal_ideal R mx}" 
  (** if zeroring R then \<Inter> {mx. maximal_ideal R mx} is UNIV, hence
      we restrict UNIV to carrier R **)

lemma (in Ring) zeroring_J_rad_empty:"zeroring R ==> J_rad R = carrier R"
by (simp add:J_rad_def)

lemma (in Ring) J_rad_mem:"x ∈ J_rad R ==> x ∈ carrier R"
apply (simp add:J_rad_def) 
apply (case_tac "zeroring R", simp)
apply simp
apply (frule id_maximal_Exist, erule exE)
 apply (frule_tac a = I in forall_spec, assumption,
        thin_tac "∀xa. maximal_ideal R xa --> x ∈ xa")
 apply (frule maximal_ideal_ideal,
        simp add:ideal_subset)
done

lemma (in Ring) J_rad_unit:"[|¬ zeroring R; x ∈ J_rad R|] ==> 
            ∀y. (y∈ carrier R --> Unit R (1r ± (-a x) ·r y))"
apply (cut_tac ring_is_ag,
       rule allI, rule impI,
       rule contrapos_pp, simp+)
apply (frule J_rad_mem[of "x"], 
       frule_tac x = x and y = y in ring_tOp_closed, assumption,
       frule_tac x = "x ·r y" in aGroup.ag_mOp_closed, assumption+)
apply (cut_tac ring_one,
      frule_tac x = "1r" and y = "-a (x ·r y)" in aGroup.ag_pOp_closed, 
      assumption+)
 apply (frule_tac a = "1r ± -a (x ·r y)" in nonunit_contained_maxid,
        assumption+, simp add:ring_inv1_1)
apply (erule exE, erule conjE)
 apply (simp add:J_rad_def,
        frule_tac a = mx in forall_spec, assumption,
        thin_tac "∀xa. maximal_ideal R xa --> x ∈ xa",
        frule_tac mx = mx in maximal_ideal_ideal,
        frule_tac I = mx and x = x and r = y in ideal_ring_multiple1,
        assumption+)
 apply (frule_tac I = mx and x = "x ·r y" in ideal_inv1_closed,
           assumption+)

 apply (frule_tac I = mx and a = "1r" and b = "-a (x ·r y)" in ideal_ele_sumTr2,
        assumption+)
 apply (simp add:maximal_ideal_def)
done

end

20. Abelian groups

lemma ag_carrier_carrier:

  carrier (b_ag A) = carrier A

lemma ag_pOp_closed:

  [| x ∈ carrier A; y ∈ carrier A |] ==> x ± y ∈ carrier A

lemma ag_mOp_closed:

  x ∈ carrier A ==> -a x ∈ carrier A

lemma asubg_subset:

  @ASubG A H ==> H  carrier A

lemma ag_pOp_commute:

  [| x ∈ carrier A; y ∈ carrier A |] ==> x ± y = y ± x

lemma b_ag_group:

  Group (b_ag A)

lemma agop_gop:

  Group.top (b_ag A) = op ±

lemma agiop_giop:

  iop (b_ag A) = mop A

lemma agunit_gone:

  \<one>b_ag A = \<zero>

lemma ag_pOp_add_r:

  [| a ∈ carrier A; b ∈ carrier A; c ∈ carrier A; a = b |] ==> a ± c = b ± c

lemma ag_add_commute:

  [| a ∈ carrier A; b ∈ carrier A |] ==> a ± b = b ± a

lemma ag_pOp_add_l:

  [| a ∈ carrier A; b ∈ carrier A; c ∈ carrier A; a = b |] ==> c ± a = c ± b

lemma asubg_pOp_closed:

  [| @ASubG A H; xH; yH |] ==> x ± yH

lemma asubg_mOp_closed:

  [| @ASubG A H; xH |] ==> -a xH

lemma asubg_subset1:

  [| @ASubG A H; xH |] ==> x ∈ carrier A

lemma asubg_inc_zero:

  @ASubG A H ==> \<zero> ∈ H

lemma ag_inc_zero:

  \<zero> ∈ carrier A

lemma ag_l_zero:

  x ∈ carrier A ==> \<zero> ± x = x

lemma ag_r_zero:

  x ∈ carrier A ==> x ± \<zero> = x

lemma ag_l_inv1:

  x ∈ carrier A ==> -a x ± x = \<zero>

lemma ag_r_inv1:

  x ∈ carrier A ==> x ± -a x = \<zero>

lemma ag_pOp_assoc:

  [| x ∈ carrier A; y ∈ carrier A; z ∈ carrier A |] ==> x ± y ± z = x ± (y ± z)

lemma ag_inv_unique:

  [| x ∈ carrier A; y ∈ carrier A; x ± y = \<zero> |] ==> y = -a x

lemma ag_inv_inj:

  [| x ∈ carrier A; y ∈ carrier A; x  y |] ==> -a x  -a y

lemma pOp_assocTr41:

  [| a ∈ carrier A; b ∈ carrier A; c ∈ carrier A; d ∈ carrier A |]
  ==> a ± b ± c ± d = a ± b ± (c ± d)

lemma pOp_assocTr42:

  [| a ∈ carrier A; b ∈ carrier A; c ∈ carrier A; d ∈ carrier A |]
  ==> a ± b ± c ± d = a ± (b ± c) ± d

lemma pOp_assocTr43:

  [| a ∈ carrier A; b ∈ carrier A; c ∈ carrier A; d ∈ carrier A |]
  ==> a ± b ± (c ± d) = a ± (b ± c) ± d

lemma pOp_assoc_cancel:

  [| a ∈ carrier A; b ∈ carrier A; c ∈ carrier A |]
  ==> a ± -a b ± (b ± -a c) = a ± -a c

lemma ag_p_inv:

  [| x ∈ carrier A; y ∈ carrier A |] ==> -a (x ± y) = -a x ± -a y

lemma gEQAddcross:

  [| l1.0 ∈ carrier A; l2.0 ∈ carrier A; r1.0 ∈ carrier A; r1.0 ∈ carrier A;
     l1.0 = r2.0; l2.0 = r1.0 |]
  ==> l1.0 ± l2.0 = r1.0 ± r2.0

lemma ag_eq_sol1:

  [| a ∈ carrier A; x ∈ carrier A; b ∈ carrier A; a ± x = b |] ==> x = -a a ± b

lemma ag_eq_sol2:

  [| a ∈ carrier A; x ∈ carrier A; b ∈ carrier A; x ± a = b |] ==> x = b ± -a a

lemma ag_add4_rel:

  [| a ∈ carrier A; b ∈ carrier A; c ∈ carrier A; d ∈ carrier A |]
  ==> a ± b ± (c ± d) = a ± c ± (b ± d)

lemma ag_inv_inv:

  x ∈ carrier A ==> -a (-a x) = x

lemma ag_inv_zero:

  -a \<zero> = \<zero>

lemma ag_diff_minus:

  [| a ∈ carrier A; b ∈ carrier A; c ∈ carrier A; a ± -a b = c |]
  ==> b ± -a a = -a c

lemma pOp_cancel_l:

  [| a ∈ carrier A; b ∈ carrier A; c ∈ carrier A; c ± a = c ± b |] ==> a = b

lemma pOp_cancel_r:

  [| a ∈ carrier A; b ∈ carrier A; c ∈ carrier A; a ± c = b ± c |] ==> a = b

lemma ag_eq_diffzero:

  [| a ∈ carrier A; b ∈ carrier A |] ==> (a = b) = (a ± -a b = \<zero>)

lemma ag_eq_diffzero1:

  [| a ∈ carrier A; b ∈ carrier A |] ==> (a = b) = (-a a ± b = \<zero>)

lemma ag_neq_diffnonzero:

  [| a ∈ carrier A; b ∈ carrier A |] ==> (a  b) = (a ± -a b  \<zero>)

lemma ag_plus_zero:

  [| x ∈ carrier A; y ∈ carrier A |] ==> (x = -a y) = (x ± y = \<zero>)

lemma asubg_nsubg:

  @ASubG A H ==> b_ag A \<triangleright> H

lemma subg_asubg:

  b_ag G » H  ==> @ASubG G H

lemma asubg_test:

  [| H  carrier A; H  {}; ∀aH. ∀bH. a ± -a bH |] ==> @ASubG A H

lemma asubg_zero:

  @ASubG A {\<zero>}

lemma asubg_whole:

  @ASubG A (carrier A)

lemma Ag_ind_carrier:

  bij_to f (carrier A) D ==> carrier (Ag_ind A f) = f ` carrier A

lemma Ag_ind_aGroup:

  [| f ∈ carrier A -> D; bij_to f (carrier A) D |] ==> aGroup (Ag_ind A f)

20-1. Homomorphism of abelian groups

lemma aHom_mem:

  [| aGroup F; aGroup G; f ∈ aHom F G; a ∈ carrier F |] ==> f a ∈ carrier G

lemma aHom_func:

  f ∈ aHom F G ==> f ∈ carrier F -> carrier G

lemma aHom_add:

  [| aGroup F; aGroup G; f ∈ aHom F G; a ∈ carrier F; b ∈ carrier F |]
  ==> f (a ±F b) = f a ±G f b

lemma aHom_0_0:

  [| aGroup F; aGroup G; f ∈ aHom F G |] ==> f \<zero>F = \<zero>G

lemma ker_inc_zero:

  [| aGroup F; aGroup G; f ∈ aHom F G |] ==> \<zero>F ∈ kerF,G f

lemma aHom_inv_inv:

  [| aGroup F; aGroup G; f ∈ aHom F G; a ∈ carrier F |] ==> f (-aF a) = -aG f a

lemma aHom_compos:

  [| aGroup L; aGroup M; aGroup N; f ∈ aHom L M; g ∈ aHom M N |]
  ==> compos L g f ∈ aHom L N

lemma aHom_compos_assoc:

  [| aGroup K; aGroup L; aGroup M; aGroup N; f ∈ aHom K L; g ∈ aHom L M;
     h ∈ aHom M N |]
  ==> compos K h (compos K g f) = compos K (compos L h g) f

lemma injec_inj_on:

  [| aGroup F; aGroup G; injecF,G f |] ==> inj_on f (carrier F)

lemma surjec_surj_to:

  surjecR,S f ==> surj_to f (carrier R) (carrier S)

lemma compos_bijec:

  [| aGroup E; aGroup F; aGroup G; bijecE,F f; bijecF,G g |]
  ==> bijecE,G compos E g f

lemma ainvf_aHom:

  [| aGroup F; aGroup G; bijecF,G f |] ==> ainvfF,G f ∈ aHom G F

lemma ainvf_bijec:

  [| aGroup F; aGroup G; bijecF,G f |] ==> bijecG,F (ainvfF,G f)

lemma ainvf_l:

  [| aGroup E; aGroup F; bijecE,F f; x ∈ carrier E |] ==> (ainvfE,F f) (f x) = x

lemma aI_aHom:

  aIA ∈ aHom A A

lemma compos_aI_l:

  [| aGroup A; aGroup B; f ∈ aHom A B |] ==> compos A aIB f = f

lemma compos_aI_r:

  [| aGroup A; aGroup B; f ∈ aHom A B |] ==> compos A f aIA = f

lemma compos_aI_surj:

  [| aGroup A; aGroup B; f ∈ aHom A B; g ∈ aHom B A; compos A g f = aIA |]
  ==> surjecB,A g

lemma compos_aI_inj:

  [| aGroup A; aGroup B; f ∈ aHom A B; g ∈ aHom B A; compos A g f = aIA |]
  ==> injecA,B f

lemma Ag_ind_aHom:

  [| f ∈ carrier A -> D; bij_to f (carrier A) D |]
  ==> Agii A f ∈ aHom A (Ag_ind A f)

lemma Agii_mem:

  [| f ∈ carrier A -> D; x ∈ carrier A; bij_to f (carrier A) D |]
  ==> Agii A f x ∈ carrier (Ag_ind A f)

lemma Ag_ind_bijec:

  [| aGroup A; f ∈ carrier A -> D; bij_to f (carrier A) D |]
  ==> bijecA,Ag_ind A f Agii A f

lemma ker_subg:

  [| aGroup F; aGroup G; f ∈ aHom F G |] ==> @ASubG F (kerF,G f)

20-2 quotient abelian group

lemma ag_a_in_ar_cos:

  [| @ASubG A H; a ∈ carrier A |] ==> aa \<uplus>A H

lemma r_cos_subset:

  [| @ASubG A H; X ∈ set_rcs (b_ag A) H |] ==> X  carrier A

lemma asubg_costOp_commute:

  [| @ASubG A H; x ∈ set_rcs (b_ag A) H; y ∈ set_rcs (b_ag A) H |]
  ==> c_top (b_ag A) H x y = c_top (b_ag A) H y x

lemma Subg_Qgroup:

  @ASubG A H ==> aGroup (aqgrp A H)

lemma plus_subgs:

  [| @ASubG A H1.0; @ASubG A H2.0 |] ==> @ASubG A (H1.0 \<minusplus> H2.0)

lemma set_sum:

  [| H  carrier A; K  carrier A |]
  ==> H \<minusplus> K = {x. ∃hH. ∃kK. x = h ± k}

lemma mem_set_sum:

  [| H  carrier A; K  carrier A; xH \<minusplus> K |]
  ==> ∃hH. ∃kK. x = h ± k

lemma mem_sum_subgs:

  [| @ASubG A H; @ASubG A K; hH; kK |] ==> h ± kH \<minusplus> K

lemma aqgrp_carrier:

  @ASubG A H ==> set_rcs (b_ag A) H = set_ar_cos A H

lemma unit_in_set_ar_cos:

  @ASubG A H ==> H ∈ set_ar_cos A H

lemma aqgrp_pOp_maps:

  [| @ASubG A H; a ∈ carrier A; b ∈ carrier A |]
  ==> a \<uplus>A H ±aqgrp A H b \<uplus>A H = (a ± b) \<uplus>A H

lemma aqgrp_mOp_maps:

  [| @ASubG A H; a ∈ carrier A |]
  ==> -aaqgrp A H a \<uplus>A H = (-a a) \<uplus>A H

lemma aqgrp_zero:

  @ASubG A H ==> \<zero>aqgrp A H = H

lemma arcos_fixed:

  [| @ASubG A H; a ∈ carrier A; hH |] ==> a \<uplus>A H = (h ± a) \<uplus>A H

21 direct product and direct sum of abelian groups, in general case

lemma prodag_comp_i:

  [| a ∈ carr_prodag I A; iI |] ==> a i ∈ carrier (A i)

lemma prod_pOp_func:

  kI. aGroup (A k)
  ==> prod_pOp I A ∈ carr_prodag I A -> carr_prodag I A -> carr_prodag I A

lemma prod_pOp_mem:

  [| ∀kI. aGroup (A k); X ∈ carr_prodag I A; Y ∈ carr_prodag I A |]
  ==> prod_pOp I A X Y ∈ carr_prodag I A

lemma prod_pOp_mem_i:

  [| ∀kI. aGroup (A k); X ∈ carr_prodag I A; Y ∈ carr_prodag I A; iI |]
  ==> prod_pOp I A X Y i = X i ±A i Y i

lemma prod_mOp_func:

  kI. aGroup (A k) ==> prod_mOp I A ∈ carr_prodag I A -> carr_prodag I A

lemma prod_mOp_mem:

  [| ∀jI. aGroup (A j); X ∈ carr_prodag I A |]
  ==> prod_mOp I A X ∈ carr_prodag I A

lemma prod_mOp_mem_i:

  [| ∀jI. aGroup (A j); X ∈ carr_prodag I A; iI |]
  ==> prod_mOp I A X i = -aA i X i

lemma prod_zero_func:

  kI. aGroup (A k) ==> prod_zero I A ∈ carr_prodag I A

lemma prod_zero_i:

  [| ∀kI. aGroup (A k); iI |] ==> prod_zero I A i = \<zero>A i

lemma carr_prodag_mem_eq:

  [| ∀kI. aGroup (A k); X ∈ carr_prodag I A; Y ∈ carr_prodag I A;
     ∀lI. X l = Y l |]
  ==> X = Y

lemma prod_pOp_assoc:

  [| ∀kI. aGroup (A k); a ∈ carr_prodag I A; b ∈ carr_prodag I A;
     c ∈ carr_prodag I A |]
  ==> prod_pOp I A (prod_pOp I A a b) c = prod_pOp I A a (prod_pOp I A b c)

lemma prod_pOp_commute:

  [| ∀kI. aGroup (A k); a ∈ carr_prodag I A; b ∈ carr_prodag I A |]
  ==> prod_pOp I A a b = prod_pOp I A b a

lemma prodag_aGroup:

  kI. aGroup (A k) ==> aGroup (aΠI A)

lemma prodag_carrier:

  kI. aGroup (A k) ==> carrier (aΠI A) = carr_prodag I A

lemma prodag_elemfun:

  [| ∀kI. aGroup (A k); f ∈ carrier (aΠI A) |] ==> fextensional I

lemma prodag_component:

  [| f ∈ carrier (aΠI A); iI |] ==> f i ∈ carrier (A i)

lemma prodag_pOp:

  kI. aGroup (A k) ==> op ±I A = prod_pOp I A

lemma prodag_iOp:

  kI. aGroup (A k) ==> mop (aΠI A) = prod_mOp I A

lemma prodag_zero:

  kI. aGroup (A k) ==> \<zero>I A = prod_zero I A

lemma prodag_sameTr0:

  [| ∀kI. aGroup (A k); ∀kI. A k = B k |] ==> Un_carrier I A = Un_carrier I B

lemma prodag_sameTr1:

  [| ∀kI. aGroup (A k); ∀kI. A k = B k |] ==> carr_prodag I A = carr_prodag I B

lemma prodag_sameTr2:

  [| ∀kI. aGroup (A k); ∀kI. A k = B k |] ==> prod_pOp I A = prod_pOp I B

lemma prodag_sameTr3:

  [| ∀kI. aGroup (A k); ∀kI. A k = B k |] ==> prod_mOp I A = prod_mOp I B

lemma prodag_sameTr4:

  [| ∀kI. aGroup (A k); ∀kI. A k = B k |] ==> prod_zero I A = prod_zero I B

lemma prodag_same:

  [| ∀kI. aGroup (A k); ∀kI. A k = B k |] ==> aΠI A = aΠI B

lemma project_mem:

  [| ∀kI. aGroup (A k); jI; x ∈ carrier (aΠI A) |]
  ==> (πI,A,j) x ∈ carrier (A j)

lemma project_aHom:

  [| ∀kI. aGroup (A k); jI |] ==> πI,A,j ∈ aHom (aΠI A) (A j)

lemma project_aHom1:

  kI. aGroup (A k) ==> ∀jI. πI,A,j ∈ aHom (aΠI A) (A j)

lemma A_to_prodag_mem:

  [| aGroup A; ∀kI. aGroup (B k); ∀kI. S k ∈ aHom A (B k); x ∈ carrier A |]
  ==> A_to_prodag A I S B x ∈ carr_prodag I B

lemma A_to_prodag_aHom:

  [| aGroup A; ∀kI. aGroup (B k); ∀kI. S k ∈ aHom A (B k) |]
  ==> A_to_prodag A I S B ∈ aHom A (aΠI B)

lemma dsum_pOp_func:

  kI. aGroup (A k)
  ==> prod_pOp I A ∈ carr_dsumag I A -> carr_dsumag I A -> carr_dsumag I A

lemma dsum_pOp_mem:

  [| ∀kI. aGroup (A k); X ∈ carr_dsumag I A; Y ∈ carr_dsumag I A |]
  ==> prod_pOp I A X Y ∈ carr_dsumag I A

lemma dsum_iOp_func:

  kI. aGroup (A k) ==> prod_mOp I A ∈ carr_dsumag I A -> carr_dsumag I A

lemma dsum_iOp_mem:

  [| ∀jI. aGroup (A j); X ∈ carr_dsumag I A |]
  ==> prod_mOp I A X ∈ carr_dsumag I A

lemma dsum_zero_func:

  kI. aGroup (A k) ==> prod_zero I A ∈ carr_dsumag I A

lemma dsumag_sub_prodag:

  kI. aGroup (A k) ==> carr_dsumag I A  carr_prodag I A

lemma carrier_dsumag:

  kI. aGroup (A k) ==> carrier (a\<Oplus>I A) = carr_dsumag I A

lemma dsumag_elemfun:

  [| ∀kI. aGroup (A k); f ∈ carrier (a\<Oplus>I A) |] ==> fextensional I

lemma dsumag_aGroup:

  kI. aGroup (A k) ==> aGroup (a\<Oplus>I A)

lemma dsumag_pOp:

  kI. aGroup (A k) ==> op ±a\<Oplus>I A = prod_pOp I A

lemma dsumag_mOp:

  kI. aGroup (A k) ==> mop (a\<Oplus>I A) = prod_mOp I A

lemma dsumag_zero:

  kI. aGroup (A k) ==> \<zero>a\<Oplus>I A = prod_zero I A

characterization of a direct product

lemma direct_prod_mem_eq:

  [| ∀jI. aGroup (A j); f ∈ carrier (aΠI A); g ∈ carrier (aΠI A);
     ∀jI. (πI,A,j) f = (πI,A,j) g |]
  ==> f = g

lemma map_family_fun:

  [| ∀jI. aGroup (A j); aGroup S; ∀jI. g j ∈ aHom S (A j); x ∈ carrier S |]
  ==> (λy∈carrier S. λjI. g j y) x ∈ carrier (aΠI A)

lemma map_family_aHom:

  [| ∀jI. aGroup (A j); aGroup S; ∀jI. g j ∈ aHom S (A j) |]
  ==> (λy∈carrier S. λjI. g j y) ∈ aHom S (aΠI A)

lemma map_family_triangle:

  [| ∀jI. aGroup (A j); aGroup S; ∀jI. g j ∈ aHom S (A j) |]
  ==> ∃!f. f ∈ aHom S (aΠI A) ∧ (∀jI. compos SI,A,j) f = g j)

lemma Ag_ind_triangle:

  [| ∀jI. aGroup (A j); jI; f ∈ carrier (aΠI A) -> B;
     bij_to f (carrier (aΠI A)) B; jI |]
  ==> compos (aΠI A)
       (compos (Ag_ind (aΠI A) f) (πI,A,j)
         (ainvf(aΠI A),Ag_ind (aΠI A) f Agii (aΠI A) f))
       (Agii (aΠI A) f) =
      πI,A,j

lemma ProjInd_aHom:

  [| ∀jI. aGroup (A j); jI; f ∈ carrier (aΠI A) -> B;
     bij_to f (carrier (aΠI A)) B; jI |]
  ==> ProjInd I A f j ∈ aHom (Ag_ind (aΠI A) f) (A j)

lemma ProjInd_aHom1:

  [| ∀jI. aGroup (A j); f ∈ carrier (aΠI A) -> B; bij_to f (carrier (aΠI A)) B |]
  ==> ∀jI. ProjInd I A f j ∈ aHom (Ag_ind (aΠI A) f) (A j)

lemma ProjInd_mem_eq:

  [| ∀jI. aGroup (A j); f ∈ carrier (aΠI A) -> B; bij_to f (carrier (aΠI A)) B;
     aGroup S; x ∈ carrier (Ag_ind (aΠI A) f); y ∈ carrier (Ag_ind (aΠI A) f);
     ∀jI. ProjInd I A f j x = ProjInd I A f j y |]
  ==> x = y

lemma ProjInd_mem_eq1:

  [| ∀jI. aGroup (A j); f ∈ carrier (aΠI A) -> B; bij_to f (carrier (aΠI A)) B;
     aGroup S; h ∈ aHom (Ag_ind (aΠI A) f) (Ag_ind (aΠI A) f);
     ∀jI. compos (Ag_ind (aΠI A) f) (ProjInd I A f j) h = ProjInd I A f j |]
  ==> h = aIAg_ind (aΠI A) f

lemma Ag_ind_triangle1:

  [| ∀jI. aGroup (A j); f ∈ carrier (aΠI A) -> B; bij_to f (carrier (aΠI A)) B;
     jI |]
  ==> compos (aΠI A) (ProjInd I A f j) (Agii (aΠI A) f) = πI,A,j

lemma map_family_triangle1:

  [| ∀jI. aGroup (A j); f ∈ carrier (aΠI A) -> B; bij_to f (carrier (aΠI A)) B;
     aGroup S; ∀jI. g j ∈ aHom S (A j) |]
  ==> ∃!h. h ∈ aHom S (Ag_ind (aΠI A) f) ∧
           (∀jI. compos S (ProjInd I A f j) h = g j)

lemma map_family_triangle2:

  [| I  {}; ∀jI. aGroup (A j); aGroup S; ∀jI. g j ∈ aHom S (A j);
     ff ∈ carrier (aΠI A) -> B; bij_to ff (carrier (aΠI A)) B;
     h1.0 ∈ aHom (Ag_ind (aΠI A) ff) S;
     ∀jI. compos (Ag_ind (aΠI A) ff) (g j) h1.0 = ProjInd I A ff j;
     h2.0 ∈ aHom S (Ag_ind (aΠI A) ff);
     ∀jI. compos S (ProjInd I A ff j) h2.0 = g j |]
  ==> ∀jI. compos (Ag_ind (aΠI A) ff) (ProjInd I A ff j)
             (compos (Ag_ind (aΠI A) ff) h2.0 h1.0) =
            ProjInd I A ff j

lemma map_family_triangle3:

  [| ∀jI. aGroup (A j); aGroup S; aGroup S1.0; ∀jI. f j ∈ aHom S (A j);
     ∀jI. g j ∈ aHom S1.0 (A j); h1.0 ∈ aHom S1.0 S; h2.0 ∈ aHom S S1.0;
     ∀jI. compos S (g j) h2.0 = f j; ∀jI. compos S1.0 (f j) h1.0 = g j |]
  ==> ∀jI. compos S (f j) (compos S h1.0 h2.0) = f j

lemma map_family_triangle4:

  [| ∀jI. aGroup (A j); aGroup S; ∀jI. f j ∈ aHom S (A j) |]
  ==> ∀jI. compos S (f j) aIS = f j

lemma prod_triangle:

  [| I  {}; ∀jI. aGroup (A j); aGroup S; ∀jI. g j ∈ aHom S (A j);
     ff ∈ carrier (aΠI A) -> B; bij_to ff (carrier (aΠI A)) B;
     h1.0 ∈ aHom (Ag_ind (aΠI A) ff) S;
     ∀jI. compos (Ag_ind (aΠI A) ff) (g j) h1.0 = ProjInd I A ff j;
     h2.0 ∈ aHom S (Ag_ind (aΠI A) ff);
     ∀jI. compos S (ProjInd I A ff j) h2.0 = g j |]
  ==> compos (Ag_ind (aΠI A) ff) h2.0 h1.0 = aIAg_ind (aΠI A) ff

lemma characterization_prodag:

  [| I  {}; ∀jI. aGroup (A j); aGroup S; ∀jI. g j ∈ aHom S (A j);
     ∃ff. ff ∈ carrier (aΠI A) -> B ∧ bij_to ff (carrier (aΠI A)) B;
     ∀S'. aGroup S' -->
          (∀g'. ∀jI. g' j ∈ aHom S' (A j) -->
                      (∃!f. f ∈ aHom S' S ∧ (∀jI. compos S' (g j) f = g' j))) |]
  ==> ∃h. bijec(aΠI A),S h

4. Ring theory

1. Definition of a ring and an ideal

lemma nsum_zeroGTr:

  (∀jn. f j = \<zero>) --> Σe A f n = \<zero>

lemma nsum_zeroA:

  jn. f j = \<zero> ==> Σe A f n = \<zero>

lemma Ring:

  Ring R

lemma ring_is_ag:

  aGroup R

lemma ring_zero:

  \<zero> ∈ carrier R

lemma ring_one:

  1r ∈ carrier R

lemma ring_tOp_closed:

  [| x ∈ carrier R; y ∈ carrier R |] ==> x ·r y ∈ carrier R

lemma ring_tOp_commute:

  [| x ∈ carrier R; y ∈ carrier R |] ==> x ·r y = y ·r x

lemma ring_distrib1:

  [| x ∈ carrier R; y ∈ carrier R; z ∈ carrier R |]
  ==> x ·r (y ± z) = x ·r y ± x ·r z

lemma ring_distrib2:

  [| x ∈ carrier R; y ∈ carrier R; z ∈ carrier R |]
  ==> (y ± z) ·r x = y ·r x ± z ·r x

lemma ring_distrib3:

  [| a ∈ carrier R; b ∈ carrier R; x ∈ carrier R; y ∈ carrier R |]
  ==> (a ± b) ·r (x ± y) = a ·r x ± a ·r y ± b ·r x ± b ·r y

lemma rEQMulR:

  [| x ∈ carrier R; y ∈ carrier R; z ∈ carrier R; x = y |] ==> x ·r z = y ·r z

lemma ring_tOp_assoc:

  [| x ∈ carrier R; y ∈ carrier R; z ∈ carrier R |]
  ==> x ·r y ·r z = x ·r (y ·r z)

lemma ring_l_one:

  x ∈ carrier R ==> 1r ·r x = x

lemma ring_r_one:

  x ∈ carrier R ==> x ·r 1r = x

lemma ring_times_0_x:

  x ∈ carrier R ==> \<zero> ·r x = \<zero>

lemma ring_times_x_0:

  x ∈ carrier R ==> x ·r \<zero> = \<zero>

lemma rMulZeroDiv:

  [| x ∈ carrier R; y ∈ carrier R; x = \<zero> ∨ y = \<zero> |]
  ==> x ·r y = \<zero>

lemma ring_inv1:

  [| a ∈ carrier R; b ∈ carrier R |]
  ==> -a a ·r b = (-a a) ·r b ∧ -a a ·r b = a ·r (-a b)

lemma ring_inv1_1:

  [| a ∈ carrier R; b ∈ carrier R |] ==> -a a ·r b = (-a a) ·r b

lemma ring_inv1_2:

  [| a ∈ carrier R; b ∈ carrier R |] ==> -a a ·r b = a ·r (-a b)

lemma ring_times_minusl:

  a ∈ carrier R ==> -a a = (-a 1r) ·r a

lemma ring_times_minusr:

  a ∈ carrier R ==> -a a = a ·r (-a 1r)

lemma ring_inv1_3:

  [| a ∈ carrier R; b ∈ carrier R |] ==> a ·r b = (-a a) ·r (-a b)

lemma ring_distrib4:

  [| a ∈ carrier R; b ∈ carrier R; x ∈ carrier R; y ∈ carrier R |]
  ==> a ·r b ± -a x ·r y = a ·r (b ± -a y) ± (a ± -a x) ·r y

lemma rMulLC:

  [| x ∈ carrier R; y ∈ carrier R; z ∈ carrier R |]
  ==> x ·r (y ·r z) = y ·r (x ·r z)

lemma Zero_ring:

  1r = \<zero> ==> zeroring R

lemma Zero_ring1:

  ¬ zeroring R ==> 1r  \<zero>

lemma Sr_one:

  sr R S ==> 1rS

lemma Sr_zero:

  sr R S ==> \<zero> ∈ S

lemma Sr_mOp_closed:

  [| sr R S; xS |] ==> -a xS

lemma Sr_pOp_closed:

  [| sr R S; xS; yS |] ==> x ± yS

lemma Sr_tOp_closed:

  [| sr R S; xS; yS |] ==> x ·r yS

lemma Sr_ring:

  sr R S ==> Ring (Sr R S)

2. Calculation of elements

nscale

lemma ring_tOp_rel:

  [| x ∈ carrier R; xa ∈ carrier R; y ∈ carrier R; ya ∈ carrier R |]
  ==> x ·r xa ·r (y ·r ya) = x ·r y ·r (xa ·r ya)

lemma nsClose:

  x ∈ carrier R ==>  n ×R x ∈ carrier R

lemma nsZero:

   n ×R \<zero> = \<zero>

lemma nsZeroI:

  x = \<zero> ==>  n ×R x = \<zero>

lemma nsEqElm:

  [| x ∈ carrier R; y ∈ carrier R; x = y |] ==>  n ×R x =  n ×R y

lemma nsDistr:

  x ∈ carrier R ==>  n ×R x ±  m ×R x =  (n + m) ×R x

lemma nsDistrL:

  [| x ∈ carrier R; y ∈ carrier R |] ==>  n ×R x ±  n ×R y =  n ×R (x ± y)

lemma nsMulDistrL:

  [| x ∈ carrier R; y ∈ carrier R |] ==> x ·r  n ×R y =  n ×R (x ·r y)

lemma nsMulDistrR:

  [| x ∈ carrier R; y ∈ carrier R |] ==>  n ×R y ·r x =  n ×R (y ·r x)

npow

lemma npClose:

  x ∈ carrier R ==> x^R n ∈ carrier R

lemma npMulDistr:

  x ∈ carrier R ==> x^R n ·r x^R m = x^R (n + m)

lemma npMulExp:

  x ∈ carrier R ==> x^R n^R m = x^R (n * m)

lemma npGTPowZero_sub:

  [| x ∈ carrier R; x^R m = \<zero> |] ==> m  n --> x^R n = \<zero>

lemma npGTPowZero:

  [| x ∈ carrier R; x^R m = \<zero>; m  n |] ==> x^R n = \<zero>

lemma npOne:

  1r^R n = 1r

lemma npZero_sub:

  0 < n --> \<zero>^R n = \<zero>

lemma npZero:

  0 < n ==> \<zero>^R n = \<zero>

lemma npMulElmL:

  [| x ∈ carrier R; 0  n |] ==> x ·r x^R n = x^R Suc n

lemma npMulEleL:

  x ∈ carrier R ==> x^R n ·r x = x^R Suc n

lemma npMulElmR:

  x ∈ carrier R ==> x^R n ·r x = x^R Suc n

lemma np_1:

  a ∈ carrier R ==> a^R Suc 0 = a

nsum and fSum

lemma nsum_memTr:

  (∀jn. f j ∈ carrier A) --> Σe A f n ∈ carrier A

lemma nsum_mem:

  jn. f j ∈ carrier A ==> Σe A f n ∈ carrier A

lemma nsum_eqTr:

  (∀jn. f j ∈ carrier Ag j ∈ carrier Af j = g j) --> Σe A f n = Σe A g n

lemma nsum_eq:

  [| ∀jn. f j ∈ carrier A; ∀jn. g j ∈ carrier A; ∀jn. f j = g j |]
  ==> Σe A f n = Σe A g n

lemma nsum_cmp_assoc:

  [| ∀jn. f j ∈ carrier A; g ∈ {j. j  n} -> {j. j  n};
     h ∈ {j. j  n} -> {j. j  n} |]
  ==> Σe A cmp (cmp f h) g n = Σe A cmp f (cmp h g) n

lemma fSum_Suc:

  j∈nset n (n + Suc m). f j ∈ carrier A
  ==> Σf A f n (n + Suc m) = Σf A f n (n + m) ± f (n + Suc m)

lemma fSum_eqTr:

  (∀j∈nset n (n + m). f j ∈ carrier Ag j ∈ carrier Af j = g j) -->
  Σf A f n (n + m) = Σf A g n (n + m)

lemma fSum_eq:

  [| ∀j∈nset n (n + m). f j ∈ carrier A; ∀j∈nset n (n + m). g j ∈ carrier A;
     ∀j∈nset n (n + m). f j = g j |]
  ==> Σf A f n (n + m) = Σf A g n (n + m)

lemma fSum_eq1:

  [| n  m; ∀j∈nset n m. f j ∈ carrier A; ∀j∈nset n m. g j ∈ carrier A;
     ∀j∈nset n m. f j = g j |]
  ==> Σf A f n m = Σf A g n m

lemma fSum_zeroTr:

  (∀j∈nset n (n + m). f j = \<zero>) --> Σf A f n (n + m) = \<zero>

lemma fSum_zero:

  j∈nset n (n + m). f j = \<zero> ==> Σf A f n (n + m) = \<zero>

lemma fSum_zero1:

  [| n < m; ∀j∈nset (Suc n) m. f j = \<zero> |] ==> Σf A f Suc n m = \<zero>

lemma nsumMulEleL:

  [| ∀i. f i ∈ carrier R; x ∈ carrier R |]
  ==> x ·r Σe R f n = Σe Ri. x ·r f i) n

lemma nsumMulElmL:

  [| ∀i. f i ∈ carrier R; x ∈ carrier R |]
  ==> x ·r Σe R f n = Σe Ri. x ·r f i) n

lemma nsumTailTr:

  (∀j≤Suc n. f j ∈ carrier A) --> Σe A f Suc n = Σe Ai. f (Suc i)) n ± f 0

lemma nsumTail:

  j≤Suc n. f j ∈ carrier A ==> Σe A f Suc n = Σe Ai. f (Suc i)) n ± f 0

lemma nsumElmTail:

  i. f i ∈ carrier A ==> Σe A f Suc n = Σe Ai. f (Suc i)) n ± f 0

lemma nsum_addTr:

  (∀jn. f j ∈ carrier Ag j ∈ carrier A) -->
  Σe Ai. f i ± g i) n = Σe A f n ± Σe A g n

lemma nsum_add:

  [| ∀jn. f j ∈ carrier A; ∀jn. g j ∈ carrier A |]
  ==> Σe Ai. f i ± g i) n = Σe A f n ± Σe A g n

lemma nsumElmAdd:

  [| ∀i. f i ∈ carrier A; ∀i. g i ∈ carrier A |]
  ==> Σe Ai. f i ± g i) n = Σe A f n ± Σe A g n

lemma nsum_add_nmTr:

  (∀jn. f j ∈ carrier A) ∧ (∀jm. g j ∈ carrier A) -->
  Σe A jointfun n f m g Suc (n + m) = Σe A f n ± Σe A g m

lemma nsum_add_nm:

  [| ∀jn. f j ∈ carrier A; ∀jm. g j ∈ carrier A |]
  ==> Σe A jointfun n f m g Suc (n + m) = Σe A f n ± Σe A g m

lemma npeSum2_sub_muly:

  [| x ∈ carrier R; y ∈ carrier R |]
  ==> y ·r Σe Ri.  (n choose i) ×R (x^R (n - i) ·r y^R i)) n =
      Σe Ri.  (n choose i) ×R (x^R (n - i) ·r y^R (i + 1))) n

lemma binomial_n0:

  Suc n choose 0 = n choose 0

lemma binomial_ngt_diff:

  n choose Suc n = Suc n choose Suc n - (n choose n)

lemma binomial_ngt_0:

  n choose Suc n = 0

lemma diffLessSuc:

  m  n ==> Suc (n - m) = Suc n - m

lemma npow_suc_i:

  [| x ∈ carrier R; i  n |] ==> x^R (Suc n - i) = x ·r x^R (n - i)

lemma npeSum2_sub_mulx:

  [| x ∈ carrier R; y ∈ carrier R |]
  ==> x ·r Σe Ri.  (n choose i) ×R (x^R (n - i) ·r y^R i)) n =
      Σe Ri.  (n choose Suc i) ×R (x^R (Suc n - Suc i) ·r y^R Suc i)) n ±
       (Suc n choose 0) ×R (x^R (Suc n - 0) ·r y^R 0)

lemma npeSum2_sub_mulx2:

  [| x ∈ carrier R; y ∈ carrier R |]
  ==> x ·r Σe Ri.  (n choose i) ×R (x^R (n - i) ·r y^R i)) n =
      Σe Ri.  (n choose Suc i) ×R (x^R (n - i) ·r (y^R i ·r y))) n ±
      (\<zero> ± x ·r x^R n ·r 1r)

lemma npeSum2:

  [| x ∈ carrier R; y ∈ carrier R |]
  ==> (x ± y)^R n = Σe Ri.  (n choose i) ×R (x^R (n - i) ·r y^R i)) n

lemma nsum_zeroTr:

  (∀in. f i = \<zero>) --> Σe A f n = \<zero>

lemma npAdd:

  [| x ∈ carrier R; y ∈ carrier R; x^R m = \<zero>; y^R n = \<zero> |]
  ==> (x ± y)^R (m + n) = \<zero>

lemma npInverse:

  x ∈ carrier R ==> (-a x)^R n = x^R n ∨ (-a x)^R n = -a x^R n

lemma npMul:

  [| x ∈ carrier R; y ∈ carrier R |] ==> (x ·r y)^R n = x^R n ·r y^R n

3. ring homomorphisms

lemma ridmap_surjec:

  Ring A ==> surjecA,A ridmap A

lemma rHom_aHom:

  f ∈ rHom A R ==> f ∈ aHom A R

lemma rimg_carrier:

  f ∈ rHom A R ==> carrier (rimg A R f) = f ` carrier A

lemma rHom_mem:

  [| f ∈ rHom A R; a ∈ carrier A |] ==> f a ∈ carrier R

lemma rHom_func:

  f ∈ rHom A R ==> f ∈ carrier A -> carrier R

lemma ringhom1:

  [| Ring A; Ring R; x ∈ carrier A; y ∈ carrier A; f ∈ rHom A R |]
  ==> f (x ±A y) = f x ±R f y

lemma rHom_inv_inv:

  [| Ring A; Ring R; x ∈ carrier A; f ∈ rHom A R |] ==> f (-aA x) = -aR f x

lemma rHom_0_0:

  [| Ring A; Ring R; f ∈ rHom A R |] ==> f \<zero>A = \<zero>R

lemma rHom_tOp:

  [| Ring A; Ring R; x ∈ carrier A; y ∈ carrier A; f ∈ rHom A R |]
  ==> f (x ·rA y) = f x ·rR f y

lemma rHom_add:

  [| f ∈ rHom A R; x ∈ carrier A; y ∈ carrier A |] ==> f (x ±A y) = f x ±R f y

lemma rHom_one:

  [| Ring A; Ring R; f ∈ rHom A R |] ==> f 1rA = 1rR

lemma rHom_npow:

  [| Ring A; Ring R; x ∈ carrier A; f ∈ rHom A R |] ==> f (x^A n) = f x^R n

lemma rHom_compos:

  [| Ring A; Ring B; Ring C; f ∈ rHom A B; g ∈ rHom B C |]
  ==> compos A g f ∈ rHom A C

lemma rimg_ag:

  [| Ring A; Ring R; f ∈ rHom A R |] ==> aGroup (rimg A R f)

lemma rimg_ring:

  [| Ring A; Ring R; f ∈ rHom A R |] ==> Ring (rimg A R f)

lemma ideal_asubg:

  ideal R I ==> @ASubG R I

lemma ideal_pOp_closed:

  [| ideal R I; xI; yI |] ==> x ± yI

lemma ideal_nsum_closedTr:

  ideal R I ==> (∀jn. f jI) --> Σe R f nI

lemma ideal_nsum_closed:

  [| ideal R I; ∀jn. f jI |] ==> Σe R f nI

lemma ideal_subset1:

  ideal R I ==> I  carrier R

lemma ideal_subset:

  [| ideal R I; hI |] ==> h ∈ carrier R

lemma ideal_ring_multiple:

  [| ideal R I; xI; r ∈ carrier R |] ==> r ·r xI

lemma ideal_ring_multiple1:

  [| ideal R I; xI; r ∈ carrier R |] ==> x ·r rI

lemma ideal_npow_closedTr:

  [| ideal R I; xI |] ==> 0 < n --> x^R nI

lemma ideal_npow_closed:

  [| ideal R I; xI; 0 < n |] ==> x^R nI

lemma times_modTr:

  [| a ∈ carrier R; a' ∈ carrier R; b ∈ carrier R; b' ∈ carrier R; ideal R I;
     a ± -a bI; a' ± -a b'I |]
  ==> a ·r a' ± -a b ·r b'I

lemma ideal_inv1_closed:

  [| ideal R I; xI |] ==> -a xI

lemma ideal_zero:

  ideal R I ==> \<zero> ∈ I

lemma ideal_zero_forall:

  I. ideal R I --> \<zero> ∈ I

lemma ideal_ele_sumTr1:

  [| ideal R I; a ∈ carrier R; b ∈ carrier R; a ± bI; aI |] ==> bI

lemma ideal_ele_sumTr2:

  [| ideal R I; a ∈ carrier R; b ∈ carrier R; a ± bI; bI |] ==> aI

lemma ideal_condition:

  [| I  carrier R; I  {}; ∀xI. ∀yI. x ± -a yI;
     ∀r∈carrier R. ∀xI. r ·r xI |]
  ==> ideal R I

lemma ideal_condition1:

  [| I  carrier R; I  {}; ∀xI. ∀yI. x ± yI;
     ∀r∈carrier R. ∀xI. r ·r xI |]
  ==> ideal R I

lemma zero_ideal:

  ideal R {\<zero>}

lemma whole_ideal:

  ideal R (carrier R)

lemma ideal_inc_one:

  [| ideal R I; 1rI |] ==> I = carrier R

lemma ideal_inc_one1:

  ideal R I ==> (1rI) = (I = carrier R)

lemma ideal_inc_unit:

  [| ideal R I; aI; Unit R a |] ==> 1rI

lemma proper_ideal:

  [| ideal R I; 1r  I |] ==> I  carrier R

lemma ideal_inc_unit1:

  [| a ∈ carrier R; Unit R a; ideal R I; aI |] ==> I = carrier R

lemma int_ideal:

  [| ideal R I; ideal R J |] ==> ideal R (IJ)

lemma set_sum_mem:

  [| aI; bJ; I  carrier R; J  carrier R |] ==> a ± bI \<minusplus> J

lemma sum_ideals:

  [| ideal R I1.0; ideal R I2.0 |] ==> ideal R (I1.0 \<minusplus> I2.0)

lemma sum_ideals_la1:

  [| ideal R I1.0; ideal R I2.0 |] ==> I1.0  I1.0 \<minusplus> I2.0

lemma sum_ideals_la2:

  [| ideal R I1.0; ideal R I2.0 |] ==> I2.0  I1.0 \<minusplus> I2.0

lemma sum_ideals_cont:

  [| ideal R I; A  I; B  I |] ==> A \<minusplus> B  I

lemma ideals_set_sum:

  [| ideal R A; ideal R B; xA \<minusplus> B |] ==> ∃hA. ∃kB. x = h ± k

lemma a_in_principal:

  a ∈ carrier R ==> aRp a

lemma principal_ideal:

  a ∈ carrier R ==> ideal R (Rp a)

lemma rxa_in_Rxa:

  [| a ∈ carrier R; r ∈ carrier R |] ==> r ·r aRp a

lemma Rxa_one:

  Rp 1r = carrier R

lemma Rxa_zero:

  Rp \<zero> = {\<zero>}

lemma Rxa_nonzero:

  [| a ∈ carrier R; a  \<zero> |] ==> Rp a  {\<zero>}

lemma ideal_cont_Rxa:

  [| ideal R I; aI |] ==> Rp a  I

lemma Rxa_mult_smaller:

  [| a ∈ carrier R; b ∈ carrier R |] ==> Rp (a ·r b)  Rp b

lemma id_ideal_psub_sum:

  [| ideal R I; a ∈ carrier R; a  I |] ==> I  I \<minusplus> Rp a

lemma mul_two_principal_idealsTr:

  [| a ∈ carrier R; b ∈ carrier R; xRp a; yRp b |]
  ==> ∃r∈carrier R. x ·r y = r ·r (a ·r b)

lemma restrictfun_Nset:

  f ∈ {i. i  Suc n} -> carrier R ==> f ∈ {i. i  n} -> carrier R

lemma sum_of_prideals0:

  f. (∀ln. f l ∈ carrier R) --> ideal R (sum_pr_ideals R f n)

lemma sum_of_prideals:

  ln. f l ∈ carrier R ==> ideal R (sum_pr_ideals R f n)

lemma sum_of_prideals1:

  f. (∀ln. f l ∈ carrier R) --> f ` {i. i  n}  sum_pr_ideals R f n

lemma sum_of_prideals2:

  ln. f l ∈ carrier R ==> f ` {i. i  n}  sum_pr_ideals R f n

lemma sum_of_prideals3:

  ideal R I
  ==> ∀f. (∀ln. f l ∈ carrier R) ∧ f ` {i. i  n}  I --> sum_pr_ideals R f n  I

lemma sum_of_prideals4:

  [| ideal R I; ∀ln. f l ∈ carrier R; f ` {i. i  n}  I |]
  ==> sum_pr_ideals R f n  I

lemma ker_ideal:

  [| Ring A; Ring R; f ∈ rHom A R |] ==> ideal A (kerA,R f)

ring of integers

lemma ring_of_integers:

  Ring Zr

lemma Zr_zero:

  \<zero>Zr = 0

lemma Zr_one:

  1rZr = 1

lemma Zr_minus:

  -aZr n = - n

lemma Zr_add:

  n ±Zr m = n + m

lemma Zr_times:

  n ·rZr m = n * m

lemma Zr_gen_Zleast:

  [| ideal Zr I; I  {0} |] ==> Zr ♦p lev I = I

lemma Zr_pir:

  ideal Zr I ==> ∃n. Zr ♦p n = I

4. quotient rings

lemma mem_set_ar_cos:

  [| ideal R I; a ∈ carrier R |] ==> a \<uplus>R I ∈ set_ar_cos R I

lemma I_in_set_ar_cos:

  ideal R I ==> I ∈ set_ar_cos R I

lemma ar_coset_same1:

  [| ideal R I; a ∈ carrier R; b ∈ carrier R; b ± -a aI |]
  ==> a \<uplus>R I = b \<uplus>R I

lemma ar_coset_same2:

  [| ideal R I; a ∈ carrier R; b ∈ carrier R; a \<uplus>R I = b \<uplus>R I |]
  ==> b ± -a aI

lemma ar_coset_same3:

  [| ideal R I; a ∈ carrier R; a \<uplus>R I = I |] ==> aI

lemma ar_coset_same3_1:

  [| ideal R I; a ∈ carrier R; a  I |] ==> a \<uplus>R I  I

lemma ar_coset_same4:

  [| ideal R I; aI |] ==> a \<uplus>R I = I

lemma ar_coset_same4_1:

  [| ideal R I; a \<uplus>R I  I |] ==> a  I

lemma belong_ar_coset1:

  [| ideal R I; a ∈ carrier R; x ∈ carrier R; x ± -a aI |]
  ==> xa \<uplus>R I

lemma a_in_ar_coset:

  [| ideal R I; a ∈ carrier R |] ==> aa \<uplus>R I

lemma ar_coset_subsetD:

  [| ideal R I; a ∈ carrier R; xa \<uplus>R I |] ==> x ∈ carrier R

lemma ar_cos_mem:

  [| ideal R I; a ∈ carrier R |] ==> a \<uplus>R I ∈ set_rcs (b_ag R) I

lemma mem_ar_coset1:

  [| ideal R I; a ∈ carrier R; xa \<uplus>R I |] ==> ∃hI. h ± a = x

lemma ar_coset_mem2:

  [| ideal R I; a ∈ carrier R; xa \<uplus>R I |] ==> ∃hI. x = a ± h

lemma belong_ar_coset2:

  [| ideal R I; a ∈ carrier R; xa \<uplus>R I |] ==> x ± -a aI

lemma ar_c_top:

  [| ideal R I; a ∈ carrier R; b ∈ carrier R |]
  ==> c_top (b_ag R) I (a \<uplus>R I) (b \<uplus>R I) = (a ± b) \<uplus>R I

lemma quotient_ring_tr1:

  [| ideal R I; a1.0 ∈ carrier R; a2.0 ∈ carrier R; b1.0 ∈ carrier R;
     b2.0 ∈ carrier R; a1.0 \<uplus>R I = a2.0 \<uplus>R I;
     b1.0 \<uplus>R I = b2.0 \<uplus>R I |]
  ==> a1.0 ·r b1.0 \<uplus>R I = a2.0 ·r b2.0 \<uplus>R I

lemma rcostOp:

  [| ideal R I; a ∈ carrier R; b ∈ carrier R |]
  ==> rcostOp R I (a \<uplus>R I) (b \<uplus>R I) = a ·r b \<uplus>R I

lemma carrier_qring:

  ideal R I ==> carrier (R /r I) = set_rcs (b_ag R) I

lemma carrier_qring1:

  ideal R I ==> carrier (R /r I) = set_ar_cos R I

lemma qring_ring:

  ideal R I ==> Ring (R /r I)

lemma qring_carrier:

  ideal R I ==> carrier (R /r I) = {X. ∃a∈carrier R. a \<uplus>R I = X}

lemma qring_mem:

  [| ideal R I; a ∈ carrier R |] ==> a \<uplus>R I ∈ carrier (R /r I)

lemma qring_pOp:

  [| ideal R I; a ∈ carrier R; b ∈ carrier R |]
  ==> a \<uplus>R I ±R /r I b \<uplus>R I = (a ± b) \<uplus>R I

lemma qring_zero:

  ideal R I ==> \<zero>R /r I = I

lemma qring_zero_1:

  [| a ∈ carrier R; ideal R I; a \<uplus>R I = I |] ==> aI

lemma Qring_fix1:

  [| a ∈ carrier R; ideal R I; aI |] ==> a \<uplus>R I = I

lemma ar_cos_same:

  [| a ∈ carrier R; ideal R I; xa \<uplus>R I |]
  ==> x \<uplus>R I = a \<uplus>R I

lemma qring_tOp:

  [| ideal R I; a ∈ carrier R; b ∈ carrier R |]
  ==> (a \<uplus>R I) ·rR /r I (b \<uplus>R I) = a ·r b \<uplus>R I

lemma rind_hom_well_def:

  [| Ring A; Ring R; f ∈ rHom A R; a ∈ carrier A |]
  ==> f a = (f°A,R) (a \<uplus>A kerA,R f)

lemma set_r_ar_cos:

  ideal R I ==> set_rcs (b_ag R) I = set_ar_cos R I

lemma set_r_ar_cos_ker:

  [| Ring A; Ring R; f ∈ rHom A R |]
  ==> set_rcs (b_ag A) (kerA,R f) = set_ar_cos A (kerA,R f)

lemma ind_hom_rhom:

  [| Ring A; Ring R; f ∈ rHom A R |] ==> f°A,R ∈ rHom (A /r (kerA,R f)) R

lemma ind_hom_injec:

  [| Ring A; Ring R; f ∈ rHom A R |] ==> injecA /r (kerA,R f),R (f°A,R)

lemma rhom_to_rimg:

  [| Ring A; Ring R; f ∈ rHom A R |] ==> f ∈ rHom A (rimg A R f)

lemma ker_to_rimg:

  [| Ring A; Ring R; f ∈ rHom A R |] ==> kerA,R f = kerA,rimg A R f f

lemma indhom_eq:

  [| Ring A; Ring R; f ∈ rHom A R |] ==> f°A,rimg A R f = f°A,R

lemma indhom_bijec2_rimg:

  [| Ring A; Ring R; f ∈ rHom A R |] ==> bijecA /r (kerA,R f),rimg A R f (f°A,R)

lemma surjec_ind_bijec:

  [| Ring A; Ring R; f ∈ rHom A R; surjecA,R f |]
  ==> bijecA /r (kerA,R f),R (f°A,R)

lemma ridmap_ind_bijec:

  Ring A ==> bijecA /r (kerA,A ridmap A),A (ridmap A°A,A)

lemma ker_of_idmap:

  Ring A ==> kerA,A ridmap A = {\<zero>A}

lemma ring_natural_isom:

  Ring A ==> bijecA /r {\<zero>A},A (ridmap A°A,A)

lemma pj_Hom:

  [| Ring R; ideal R I |] ==> pj R I ∈ rHom R (R /r I)

lemma pj_mem:

  [| Ring R; ideal R I; x ∈ carrier R |] ==> pj R I x = x \<uplus>R I

lemma pj_zero:

  [| Ring R; ideal R I; x ∈ carrier R |] ==> (pj R I x = \<zero>R /r I) = (xI)

lemma pj_surj_to:

  [| Ring R; ideal R J; X ∈ carrier (R /r J) |] ==> ∃r∈carrier R. pj R J r = X

lemma invim_of_ideal:

  [| Ring R; ideal R I; ideal (R /r I) J |]
  ==> ideal R (rInvim R (R /r I) (pj R I) J)

lemma pj_invim_cont_I:

  [| Ring R; ideal R I; ideal (R /r I) J |] ==> I  rInvim R (R /r I) (pj R I) J

lemma pj_invim_mono1:

  [| Ring R; ideal R I; ideal (R /r I) J1.0; ideal (R /r I) J2.0; J1.0  J2.0 |]
  ==> rInvim R (R /r I) (pj R I) J1.0  rInvim R (R /r I) (pj R I) J2.0

lemma pj_img_ideal:

  [| Ring R; ideal R I; ideal R J; I  J |] ==> ideal (R /r I) (pj R I ` J)

lemma npQring:

  [| Ring R; ideal R I; a ∈ carrier R |]
  ==> (a \<uplus>R I)^R /r I n = a^R n \<uplus>R I

5. Primary ideals, Prime ideals

lemma maximal_ideal_ideal:

  maximal_ideal R mx ==> ideal R mx

lemma maximal_ideal_proper:

  maximal_ideal R mx ==> 1r  mx

lemma prime_ideal_ideal:

  prime_ideal R I ==> ideal R I

lemma prime_ideal_proper:

  prime_ideal R I ==> I  carrier R

lemma prime_ideal_proper1:

  prime_ideal R p ==> 1r  p

lemma primary_ideal_ideal:

  primary_ideal R q ==> ideal R q

lemma primary_ideal_proper1:

  primary_ideal R q ==> 1r  q

lemma prime_elems_mult_not:

  [| prime_ideal R P; x ∈ carrier R; y ∈ carrier R; x  P; y  P |] ==> x ·r y  P

lemma prime_is_primary:

  prime_ideal R p ==> primary_ideal R p

lemma maximal_prime_Tr0:

  [| maximal_ideal R mx; x ∈ carrier R; x  mx |]
  ==> mx \<minusplus> Rp x = carrier R

lemma maximal_is_prime:

  maximal_ideal R mx ==> prime_ideal R mx

lemma chain_un:

  [| cchain {I. ideal R II  carrier R}; c  {} |] ==> ideal R (Union c)

lemma zeroring_no_maximal:

  zeroring R ==> ¬ (∃I. maximal_ideal R I)

lemma id_maximal_Exist:

  ¬ zeroring R ==> ∃I. maximal_ideal R I

lemma ideal_Int_ideal:

  [| S  {I. ideal R I}; S  {} |] ==> ideal R (Inter S)

lemma sum_prideals_Int:

  [| ∀ln. f l ∈ carrier R; S = {I. ideal R If ` {i. i  n}  I} |]
  ==> sum_pr_ideals R f n = Inter S

lemma prod_mem_prod_ideals:

  [| ideal R I; ideal R J; iI; jJ |] ==> i ·r jIr J

lemma ideal_prod_ideal:

  [| ideal R I; ideal R J |] ==> ideal R (Ir J)

lemma ideal_prod_commute:

  [| ideal R I; ideal R J |] ==> Ir J = Jr I

lemma ideal_prod_subTr:

  [| ideal R I; ideal R J; ideal R C; ∀iI. ∀jJ. i ·r jC |] ==> Ir J  C

lemma n_prod_idealTr:

  (∀kn. ideal R (J k)) --> ideal R (iΠR,n J)

lemma n_prod_ideal:

  kn. ideal R (J k) ==> ideal R (iΠR,n J)

lemma ideal_prod_la1:

  [| ideal R I; ideal R J |] ==> Ir J  I

lemma ideal_prod_el1:

  [| ideal R I; ideal R J; aIr J |] ==> aI

lemma ideal_prod_la2:

  [| ideal R I; ideal R J |] ==> Ir J  J

lemma ideal_prod_sub_Int:

  [| ideal R I; ideal R J |] ==> Ir J  IJ

lemma ideal_prod_el2:

  [| ideal R I; ideal R J; aIr J |] ==> aJ

lemma ele_n_prodTr0:

  [| ∀k≤Suc n. ideal R (J k); a ∈ iΠR,Suc n J |] ==> a ∈ iΠR,n JaJ (Suc n)

lemma ele_n_prodTr1:

  (∀kn. ideal R (J k)) ∧ a ∈ iΠR,n J --> (∀kn. aJ k)

lemma ele_n_prod:

  [| ∀kn. ideal R (J k); a ∈ iΠR,n J |] ==> ∀kn. aJ k

lemma idealprod_whole_l:

  ideal R I ==> carrier Rr I = I

lemma idealprod_whole_r:

  ideal R I ==> Ir carrier R = I

lemma idealpow_1_self:

  ideal R I ==> I R Suc 0 = I

lemma ideal_pow_ideal:

  ideal R I ==> ideal R (I R n)

lemma ideal_prod_prime:

  [| ideal R I; ideal R J; prime_ideal R P; Ir J  P |] ==> I  PJ  P

lemma ideal_n_prod_primeTr:

  prime_ideal R P ==> (∀kn. ideal R (J k)) --> iΠR,n J  P --> (∃in. J i  P)

lemma ideal_n_prod_prime:

  [| prime_ideal R P; ∀kn. ideal R (J k); iΠR,n J  P |] ==> ∃in. J i  P

lemma prod_primeTr:

  [| prime_ideal R P; ideal R A; ¬ A  P; ideal R B; ¬ B  P |]
  ==> ∃x. xAxBx  P

lemma prod_primeTr1:

  [| ∀k≤Suc n. prime_ideal R (P k); ideal R A; ∀l≤Suc n. ¬ A  P l;
     ∀k≤Suc n. ∀l≤Suc n. k = l ∨ ¬ P k  P l; i  Suc n |]
  ==> ∀ln. ppa R P A i lA ∧ ppa R P A i lP (skip i l) ∧ ppa R P A i l  P i

lemma ppa_mem:

  [| ∀k≤Suc n. prime_ideal R (P k); ideal R A; ∀l≤Suc n. ¬ A  P l;
     ∀k≤Suc n. ∀l≤Suc n. k = l ∨ ¬ P k  P l; i  Suc n; l  n |]
  ==> ppa R P A i l ∈ carrier R

lemma nsum_memrTr:

  (∀in. f i ∈ carrier R) --> (∀ln. Σe R f l ∈ carrier R)

lemma nsum_memr:

  in. f i ∈ carrier R ==> ∀ln. Σe R f l ∈ carrier R

lemma nsum_ideal_incTr:

  ideal R A ==> (∀in. f iA) --> Σe R f nA

lemma nsum_ideal_inc:

  [| ideal R A; ∀in. f iA |] ==> Σe R f nA

lemma nsum_ideal_excTr:

  ideal R A
  ==> (∀in. f i ∈ carrier R) ∧
      (∃jn. (∀l∈{i. i  n} - {j}. f lA) ∧ f j  A) -->
      Σe R f n  A

lemma nsum_ideal_exc:

  [| ideal R A; ∀in. f i ∈ carrier R;
     ∃jn. (∀l∈{i. i  n} - {j}. f lA) ∧ f j  A |]
  ==> Σe R f n  A

lemma nprod_memTr:

  (∀in. f i ∈ carrier R) --> (∀ln. eΠR,l f ∈ carrier R)

lemma nprod_mem:

  [| ∀in. f i ∈ carrier R; l  n |] ==> eΠR,l f ∈ carrier R

lemma ideal_nprod_incTr:

  ideal R A ==> (∀in. f i ∈ carrier R) ∧ (∃ln. f lA) --> eΠR,n fA

lemma ideal_nprod_inc:

  [| ideal R A; ∀in. f i ∈ carrier R; ∃ln. f lA |] ==> eΠR,n fA

lemma nprod_excTr:

  prime_ideal R P ==> (∀in. f i ∈ carrier R) ∧ (∀ln. f l  P) --> eΠR,n f  P

lemma prime_nprod_exc:

  [| prime_ideal R P; ∀in. f i ∈ carrier R; ∀ln. f l  P |] ==> eΠR,n f  P

lemma id_nilrad_ideal:

  ideal R (nilrad R)

lemma id_rad_invim:

  ideal R I ==> rad_ideal R I = rInvim R (R /r I) (pj R I) (nilrad (R /r I))

lemma id_rad_ideal:

  ideal R I ==> ideal R (rad_ideal R I)

lemma id_rad_cont_I:

  ideal R I ==> I  rad_ideal R I

lemma id_rad_set:

  ideal R I ==> rad_ideal R I = {x : carrier R. ∃n. x^R nI}

lemma rad_primary_prime:

  primary_ideal R q ==> prime_ideal R (rad_ideal R q)

lemma npow_notin_prime:

  [| prime_ideal R P; x ∈ carrier R; x  P |] ==> ∀n. x^R n  P

lemma npow_in_prime:

  [| prime_ideal R P; x ∈ carrier R; ∃n. x^R nP |] ==> xP

lemma mul_closed_set_sub:

  mul_closed_set R S ==> S  carrier R

lemma mul_closed_set_tOp_closed:

  [| mul_closed_set R S; sS; tS |] ==> s ·r tS

lemma f_inv_unique:

  [| x ∈ carrier K - {\<zero>}; x' ∈ carrier K; x'' ∈ carrier K; x' ·r x = 1r;
     x'' ·r x = 1r |]
  ==> x' = x''

lemma invf_inv:

  x ∈ carrier K - {\<zero>} ==> invf K x ∈ carrier K ∧ invf K x ·r x = 1r

lemma idom_is_ring:

  Ring R

lemma idom_tOp_nonzeros:

  [| x ∈ carrier R; y ∈ carrier R; x  \<zero>; y  \<zero> |]
  ==> x ·r y  \<zero>

lemma idom_potent_nonzero:

  [| x ∈ carrier R; x  \<zero> |] ==> x^R n  \<zero>

lemma idom_potent_unit:

  [| a ∈ carrier R; 0 < n |] ==> Unit R a = Unit R (a^R n)

lemma idom_mult_cancel_r:

  [| a ∈ carrier R; b ∈ carrier R; c ∈ carrier R; c  \<zero>; a ·r c = b ·r c |]
  ==> a = b

lemma idom_mult_cancel_l:

  [| a ∈ carrier R; b ∈ carrier R; c ∈ carrier R; c  \<zero>; c ·r a = c ·r b |]
  ==> a = b

lemma invf_closed1:

  x ∈ carrier K - {\<zero>} ==> x­ K ∈ carrier K - {\<zero>}

lemma linvf:

  x ∈ carrier K - {\<zero>} ==> x­ K ·r x = 1r

lemma field_is_ring:

  Ring K

lemma invf_one:

  1r  \<zero> ==> 1r­ K = 1r

lemma field_tOp_assoc:

  [| x ∈ carrier K; y ∈ carrier K; z ∈ carrier K |]
  ==> x ·r y ·r z = x ·r (y ·r z)

lemma field_tOp_commute:

  [| x ∈ carrier K; y ∈ carrier K |] ==> x ·r y = y ·r x

lemma field_inv_inv:

  [| x ∈ carrier K; x  \<zero> |] ==> x­ K­ K = x

lemma field_is_idom:

  Idomain K

lemma field_potent_nonzero:

  [| x ∈ carrier K; x  \<zero> |] ==> x^K n  \<zero>

lemma field_potent_nonzero1:

  [| x ∈ carrier K; x  \<zero> |] ==> xKn  \<zero>

lemma field_nilp_zero:

  [| x ∈ carrier K; x^K n = \<zero> |] ==> x = \<zero>

lemma npowf_mem:

  [| a ∈ carrier K; a  \<zero> |] ==> aKn ∈ carrier K

lemma field_npowf_exp_zero:

  [| a ∈ carrier K; a  \<zero> |] ==> aK0 = 1r

lemma npow_exp_minusTr1:

  [| x ∈ carrier K; x  \<zero>; 0  i |]
  ==> 0  i - int j --> xK(i - int j) = x^K nat i ·r x­ K^K j

lemma npow_exp_minusTr2:

  [| x ∈ carrier K; x  \<zero>; 0  i; 0  j; 0  i - j |]
  ==> xK(i - j) = x^K nat i ·r x­ K^K nat j

lemma npowf_inv:

  [| x ∈ carrier K; x  \<zero>; 0  j |] ==> xKj = x­ KK- j

lemma npowf_inv1:

  [| x ∈ carrier K; x  \<zero>; ¬ 0  j |] ==> xKj = x­ KK- j

lemma npowf_inverse:

  [| x ∈ carrier K; x  \<zero> |] ==> xKj = x­ KK- j

lemma npowf_expTr1:

  [| x ∈ carrier K; x  \<zero>; 0  i; 0  j; 0  i - j |]
  ==> xK(i - j) = xKi ·r xK- j

lemma npowf_expTr2:

  [| x ∈ carrier K; x  \<zero>; 0  i + j |] ==> xK(i + j) = xKi ·r xKj

lemma npowf_exp_add:

  [| x ∈ carrier K; x  \<zero> |] ==> xK(i + j) = xKi ·r xKj

lemma npowf_exp_1_add:

  [| x ∈ carrier K; x  \<zero> |] ==> xK(1 + j) = x ·r xKj

lemma npowf_minus:

  [| x ∈ carrier K; x  \<zero> |] ==> (xKj)­ K = xK- j

lemma residue_fieldTr:

  [| maximal_ideal R mx; x ∈ carrier (R /r mx); x  \<zero>R /r mx |]
  ==> ∃y∈carrier (R /r mx). y ·rR /r mx x = 1rR /r mx

lemma residue_field_cd:

  maximal_ideal R mx ==> Corps (R /r mx)

lemma maximal_set_idealTr:

  maximal_set {I. ideal R ISI = {}} mx ==> ideal R mx

lemma maximal_setTr:

  [| maximal_set {I. ideal R ISI = {}} mx; ideal R J; mx  J |]
  ==> SJ  {}

lemma mulDisj:

  [| mul_closed_set R S; 1rS; \<zero>  S; T = {I. ideal R ISI = {}};
     maximal_set T mx |]
  ==> prime_ideal R mx

lemma ex_mulDisj_maximal:

  [| mul_closed_set R S; \<zero>  S; 1rS; T = {I. ideal R ISI = {}} |]
  ==> ∃mx. maximal_set T mx

lemma ex_mulDisj_prime:

  [| mul_closed_set R S; \<zero>  S; 1rS |]
  ==> ∃mx. prime_ideal R mxSmx = {}

lemma nilradTr1:

  ¬ zeroring R ==> nilrad R = Inter {p. prime_ideal R p}

lemma nonilp_residue_nilrad:

  [| ¬ zeroring R; x ∈ carrier R;
     nilpotent (R /r nilrad R) (x \<uplus>R nilrad R) |]
  ==> x \<uplus>R nilrad R = \<zero>R /r nilrad R

lemma ex_contid_maximal:

  [| S = {1r}; \<zero>  S; ideal R I; IS = {};
     T = {J. ideal R JSJ = {} ∧ I  J} |]
  ==> ∃mx. maximal_set T mx

lemma contid_maximal:

  [| S = {1r}; \<zero>  S; ideal R I; IS = {};
     T = {J. ideal R JSJ = {} ∧ I  J}; maximal_set T mx |]
  ==> maximal_ideal R mx

lemma ideal_contained_maxid:

  [| ¬ zeroring R; ideal R I; 1r  I |] ==> ∃mx. maximal_ideal R mxI  mx

lemma nonunit_principal_id:

  [| a ∈ carrier R; ¬ Unit R a |] ==> Rp a  carrier R

lemma nonunit_contained_maxid:

  [| ¬ zeroring R; a ∈ carrier R; ¬ Unit R a |]
  ==> ∃mx. maximal_ideal R mxamx

lemma local_ring_diff:

  [| ¬ zeroring R; ideal R mx; mx  carrier R; ∀a∈carrier R - mx. Unit R a |]
  ==> local_ring R ∧ maximal_ideal R mx

lemma localring_unit:

  [| ¬ zeroring R; maximal_ideal R mx; ∀x. xmx --> Unit R (x ± 1r) |]
  ==> local_ring R

lemma zeroring_J_rad_empty:

  zeroring R ==> J_rad R = carrier R

lemma J_rad_mem:

  x ∈ J_rad R ==> x ∈ carrier R

lemma J_rad_unit:

  [| ¬ zeroring R; x ∈ J_rad R |]
  ==> ∀y. y ∈ carrier R --> Unit R (1r ± (-a x) ·r y)