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

   chapter 5. Modules
    section 8. exact sequence
    section 9. Tensor products

   chapter 6. Construction of a special aelian group
    section 1. free generated abelian group, direct sum and direct product 2
    section 2. Abelian Group generated by one element
    section 3. Free Generated Modules
    section 4. a fgmodule and a free module
    section 5. direct sum, again

   **)

theory Algebra9 imports Algebra8 begin

section "Exact sequence"

definition
  Zm :: "[('r, 'm) Ring_scheme, 'a] \<Rightarrow> ('a, 'r) Module" where
  "Zm R e = \<lparr> carrier = {e}, pop = \<lambda>x\<in>{e}. \<lambda>y\<in>{e}. e, mop =
    \<lambda>x\<in>{e}. e, zero = e, sprod = \<lambda>r\<in>carrier R. \<lambda>x\<in>{e}. e\<rparr>"

lemma (in Ring) Zm_Module:"R module (Zm R e)"
apply (simp add:Module_def aGroup_def Zm_def Module_axioms_def)
 apply (simp add:ring_one, cut_tac Ring, simp)
 apply (rule conjI)
 apply (rule allI, rule impI, rule allI, rule impI, rule impI)
 apply (cut_tac ring_is_ag,
        frule_tac x = a and y = b in aGroup.ag_pOp_closed, assumption+, simp)
 apply (rule allI, rule impI, rule allI, rule impI, rule impI,
        frule_tac x = a and y = b in ring_tOp_closed, assumption+, simp)
done

lemma (in Ring) Zm_carrier:"carrier (Zm R e) = {e}"
apply (simp add:Zm_def)
done

lemma (in Ring) Zm_to_M_0:"\<lbrakk>R module M; f \<in> mHom R (Zm R e) M\<rbrakk> \<Longrightarrow>
                     f e = \<zero>\<^bsub>M\<^esub>"
apply (cut_tac Zm_Module [of e])
 apply (frule Module.mHom_add [of "Zm R e" R M f e e], assumption+,
        (simp add:Zm_carrier)+,
        frule_tac R = R and M = "Zm R e" in Module.module_is_ag,
        frule_tac x = e and y = e in aGroup.ag_pOp_closed[of "Zm R e"],
        (simp add:Zm_carrier)+)
 apply (frule_tac R = R and M = "Zm R e" and N = M and f = f and m = e in
        Module.mHom_mem, assumption+, simp add:Zm_carrier,
        frule sym, thin_tac "f e =  f e  \<plusminus>\<^bsub>M\<^esub> (f e)",
        frule_tac R = R and M = M in Module.module_is_ag,
        frule aGroup.ag_eq_sol2 [of M "f e" "f e" "f e"], assumption+)
apply (simp add:aGroup.ag_r_inv1)
done

lemma (in Ring) Z_to_M:"\<lbrakk>R module M; f \<in> mHom R (Zm R e) M;
                              g \<in> mHom R (Zm R e) M \<rbrakk>  \<Longrightarrow> f = g"
apply (rule_tac R = R and M = "Zm R e" and N = M in Module.mHom_eq)
 apply (simp add:Zm_Module)
 apply assumption+
 apply (rule ballI)
 apply (simp add:Zm_carrier)
 apply (simp add:Zm_to_M_0 [of _ _ e])
done

lemma (in Ring) mzeromap_mHom:"\<lbrakk>R module M; R module N\<rbrakk> \<Longrightarrow>
                                     mzeromap M N \<in> mHom R M N"
apply (simp add:mHom_def aHom_def)
apply (rule conjI)
 apply (simp add:mzeromap_def, simp add:Module_def aGroup_def)
apply (rule conjI)
 apply (simp add:mzeromap_def extensional_def)
apply (rule conjI)
 apply ((rule ballI)+,
        frule_tac R = R and M = M in Module.module_is_ag,
        frule_tac x = a and y = b in aGroup.ag_pOp_closed [of "M"],
        assumption+,
        simp add:mzeromap_def,
        frule_tac R = R and M = N in Module.module_is_ag,
        rule aGroup.ag_l_zero[THEN sym, of "N"], assumption+,
        simp add:aGroup.ag_inc_zero)
apply (rule ballI)+
 apply (frule_tac a = a and m = m in Module.sc_mem [of M R], assumption+,
        simp add:mzeromap_def,
        rule Module.sc_a_0 [THEN sym], assumption+)
done

lemma (in Ring) HOM_carrier:"carrier (HOM\<^bsub>R\<^esub> M N) = mHom R M N"
apply (simp add:HOM_def)
done

lemma (in Ring) mHom_Z_M:"R module M \<Longrightarrow>
              mHom R (Zm R e) M = {mzeromap (Zm R e) M}"
apply (rule equalityI)
 apply (rule subsetI)
 apply simp
 apply (cut_tac Zm_Module [of e])
 apply (frule mzeromap_mHom [of "Zm R e" M], assumption+)
 apply (simp add:Z_to_M)
apply (rule subsetI) apply simp
 apply (cut_tac Zm_Module[of e],
        simp add:mzeromap_mHom)
done

lemma (in Module) Modules_single_carrier_isom:"\<lbrakk>R module N; carrier M = {\<zero>};
      carrier N = {\<zero>\<^bsub>N\<^esub>}\<rbrakk> \<Longrightarrow> M \<cong>\<^bsub>R\<^esub> N"
apply (subgoal_tac "bijec\<^bsub>M, N\<^esub> (\<lambda>x\<in>{\<zero>}. \<zero>\<^bsub>N\<^esub>) \<and>
                          (\<lambda>x\<in>{\<zero>}. \<zero>\<^bsub>N\<^esub>) \<in> mHom R M N")
apply (simp add:misomorphic_def, blast,
       subgoal_tac "(\<lambda>x\<in>{\<zero>}. \<zero>\<^bsub>N\<^esub>) \<in> mHom R M N", simp)
apply (simp add:bijec_def injec_def surjec_def mHom_def,
       simp add:ker_def surj_to_def)

apply (simp add:mHom_def aHom_def)
 apply (cut_tac ag_inc_zero, simp add:ag_l_zero)
 apply (frule_tac R = R and M = N in Module.module_is_ag,
        frule aGroup.ag_inc_zero[of N],
        simp add:aGroup.ag_l_zero[of N])
 apply (simp add:sc_a_0 Module.sc_a_0)
done

lemma (in Ring) Zm_isom:"(Zm R (e::'a)) \<cong>\<^bsub>R\<^esub> (Zm R (u::'b))"
apply (cut_tac Zm_Module[of e], cut_tac Zm_Module[of u])
apply (rule_tac R = R and M = "Zm R e" and N = "Zm R u" in
                Module.Modules_single_carrier_isom, assumption+)
apply (simp add:Zm_def)+
done

lemma (in Ring) HOM_Z_M_0:"R module M \<Longrightarrow> HOM\<^bsub>R\<^esub> (Zm R e) M \<cong>\<^bsub>R\<^esub> (Zm R e)"
 apply (cut_tac Zm_Module[of e],
        frule_tac M = "Zm R e" and N = M in Module.HOM_is_module,
        assumption+)
 apply (cut_tac M = "Zm R e" and N = M in HOM_carrier)
 apply (simp add: mHom_Z_M)
 apply (simp add:Module.zero_HOM)
 apply (rule_tac R = R and M = "HOM\<^bsub>R\<^esub> (Zm R e) M" and N = "Zm R e" in
         Module.Modules_single_carrier_isom, assumption+)
 apply (simp add:Zm_def)
done

lemma (in Ring) M_to_Z:"\<lbrakk>R module M; f \<in> mHom R M (Zm R e);
                               g \<in> mHom R M (Zm R e)\<rbrakk>  \<Longrightarrow> f = g"
apply (rule Module.mHom_eq [of M _ "Zm R e"], assumption+)
 apply (simp add:Zm_Module, assumption+)
 apply (rule ballI)
 apply (frule_tac m = m in Module.mHom_mem [of M _ "Zm R e" f],
        simp add:Zm_Module, assumption+)
 apply (frule_tac m = m in Module.mHom_mem [of M _ "Zm R e" g],
        simp add:Zm_Module, assumption+)
 apply (simp add:Zm_carrier)
done

lemma (in Ring) mHom_to_zero:"R module M \<Longrightarrow>  mHom R M (Zm R e) =
                                              {mzeromap M (Zm R e)}"
apply (frule mzeromap_mHom [of M "Zm R e"])
 apply (simp add:Zm_Module)
apply (rule equalityI)
 apply (rule subsetI)
 apply (frule_tac f = "mzeromap M (Zm R e)" and g = x in M_to_Z [of M],
                                      assumption+)
 apply simp
 apply (rule subsetI)
 apply simp
done

lemma (in Ring) carrier_HOM_M_Z:"R module M \<Longrightarrow>
                 carrier (HOM\<^bsub>R\<^esub> M (Zm R e)) = {mzeromap M (Zm R e)}"
apply (subst HOM_carrier)
apply (simp add:mHom_to_zero)
done

lemma (in Ring) HOM_M_Z_0:"R module M \<Longrightarrow> HOM\<^bsub>R\<^esub> M (Zm R e) \<cong>\<^bsub>R\<^esub> (Zm R e)"
apply (cut_tac Zm_Module[of e],
        frule_tac M = M and N = "Zm R e" in Module.HOM_is_module,
        assumption+)
 apply (frule_tac M = M and e = e in carrier_HOM_M_Z)
 apply (simp add:Module.zero_HOM)
 apply (rule Module.Modules_single_carrier_isom, assumption+)
 apply (simp add:Zm_def)
done

lemma (in Ring) M_to_Z_0:"\<lbrakk>R module M; f \<in> mHom R M (Zm R e)\<rbrakk> \<Longrightarrow>
                              ker\<^bsub>M,(Zm R e)\<^esub> f = carrier M"
apply (simp add:ker_def)
apply (simp add:Zm_def) apply (fold Zm_def)
apply (rule equalityI)
 apply (rule subsetI)
 apply (simp add:CollectI)
 apply (rule subsetI, simp)
 apply (cut_tac Zm_Module[of e])
 apply (frule_tac R = R and M = M and N = "Zm R e" and f = f and m = x in
         Module.mHom_mem, assumption+)
 apply (simp add:Zm_carrier)
done

definition
  exact3 :: "[('r, 'm) Ring_scheme, ('a, 'r, 'm1) Module_scheme, 'a \<Rightarrow> 'b,
    ('b, 'r, 'm1) Module_scheme, 'b \<Rightarrow> 'c, ('c, 'r, 'm1) Module_scheme] \<Rightarrow> bool" where
  "exact3 R L0 h0 L1 h1 L2 == h0 ` (carrier L0) = ker\<^bsub>(L1),(L2)\<^esub> h1"

definition
  exact4 :: "[('r, 'm) Ring_scheme, ('a0, 'r, 'm1) Module_scheme, 'a0 \<Rightarrow> 'a1,
    ('a1, 'r, 'm1) Module_scheme, 'a1 \<Rightarrow> 'a2, ('a2, 'r, 'm1) Module_scheme,
    'a2 \<Rightarrow> 'a3, ('a3, 'r, 'm1) Module_scheme] \<Rightarrow> bool" where
  "exact4 R L0 h0 L1 h1 L2 h2 L3 \<longleftrightarrow> h0 ` (carrier L0) = ker\<^bsub>(L1),(L2)\<^esub> h1 \<and>
                                     h1 ` (carrier L1) = ker\<^bsub>(L2),(L3)\<^esub> h2 "

definition
  exact5 :: "[('r, 'm) Ring_scheme, ('a0, 'r, 'm1) Module_scheme, 'a0 \<Rightarrow> 'a1,
    ('a1, 'r, 'm1) Module_scheme, 'a1 \<Rightarrow> 'a2, ('a2, 'r, 'm1) Module_scheme,
    'a2 \<Rightarrow> 'a3, ('a3, 'r, 'm1) Module_scheme, 'a3 \<Rightarrow> 'a4,
    ('a4, 'r, 'm1) Module_scheme] \<Rightarrow> bool" where
  "exact5 R L0 h0 L1 h1 L2 h2 L3 h3 L4 == h0 ` (carrier L0) = ker\<^bsub>(L1),(L2)\<^esub> h1 \<and>
    h1 ` (carrier L1) = ker\<^bsub>(L2),(L3)\<^esub> h2 \<and> h2 `(carrier L2) = ker\<^bsub>(L3),(L4)\<^esub> h3 "

definition
  exact8 :: "[('r, 'm) Ring_scheme, ('a0, 'r, 'm1) Module_scheme, 'a0 \<Rightarrow> 'a1,
    ('a1, 'r, 'm1) Module_scheme, 'a1 \<Rightarrow> 'a2, ('a2, 'r, 'm1) Module_scheme,
    'a2 \<Rightarrow> 'a3, ('a3, 'r, 'm1) Module_scheme, 'a3 \<Rightarrow> 'a4,
    ('a4, 'r, 'm1) Module_scheme, 'a4 \<Rightarrow> 'a5, ('a5, 'r, 'm1) Module_scheme,
    'a5 \<Rightarrow> 'a6, ('a6, 'r, 'm1) Module_scheme, 'a6 \<Rightarrow> 'a7,
    ('a7, 'r, 'm1) Module_scheme] \<Rightarrow> bool"  where
  "exact8 R L0 h0 L1 h1 L2 h2 L3 h3 L4 h4 L5 h5 L6 h6 L7 \<longleftrightarrow>
    h0 ` (carrier L0) = ker\<^bsub>(L1),(L2)\<^esub> h1 \<and> h1 ` (carrier L1) = ker\<^bsub>(L2),(L3)\<^esub> h2 \<and>
    h2 ` (carrier L2) = ker\<^bsub>(L3),(L4)\<^esub> h3 \<and> h3 ` (carrier L3) = ker\<^bsub>(L4),(L5)\<^esub> h4 \<and>
    h4 ` (carrier L4) = ker\<^bsub>(L5),(L6)\<^esub> h5 \<and> h5 ` (carrier L5) = ker\<^bsub>(L6),(L7)\<^esub> h6"

lemma (in Ring) exact3_comp_0:"\<lbrakk>R module L; R module M; R module N;
       f \<in> mHom R L M; g \<in> mHom R M N; exact3 R L f M g N\<rbrakk> \<Longrightarrow>
      compos L g f = mzeromap L N"
apply (frule Module.mHom_compos [of M R L N f g], assumption+,
       frule mzeromap_mHom [of L N], assumption,
       rule Module.mHom_eq [of L R N], assumption+)
apply (rule ballI)
 apply (subst compos_def)+
 apply (simp add:exact3_def)
 apply (cut_tac mHom_func[of f L M])
 apply (frule_tac a = m in mem_in_image [of f "carrier L" "carrier M"],
          assumption+)
 apply simp
apply (simp add:ker_def mzeromap_def compose_def, assumption)
done

lemma (in Ring) exact_im_sub_kern:"\<lbrakk>R module L; R module M; R module N;
             f \<in> mHom R L M; g \<in> mHom R M N; exact3 R L f M g N\<rbrakk> \<Longrightarrow>
           f ` (carrier L) \<subseteq> ker\<^bsub>M,N\<^esub> g"
apply (simp add:exact3_def)
done

lemma (in Ring) mzero_im_sub_ker:"\<lbrakk>R module L; R module M; R module N;
       f \<in> mHom R L M; g \<in> mHom R M N; compos L g f = mzeromap L N\<rbrakk> \<Longrightarrow>
      f ` (carrier L) \<subseteq> ker\<^bsub>M,N\<^esub> g"
apply (rule subsetI)
 apply (simp add:image_def)
 apply auto
 apply (simp add:ker_def)
 apply (simp add:Module.mHom_mem)
 apply (simp add:compos_def compose_def)
 apply (subgoal_tac "(\<lambda>x\<in>carrier L. g (f x)) xa = mzeromap L N xa")
 prefer 2 apply simp
 apply (thin_tac "(\<lambda>x\<in>carrier L. g (f x)) = mzeromap L N")
 apply simp
 apply (simp add:mzeromap_def)
done

lemma (in Ring) left_exact_injec:"\<lbrakk>R module M; R module N;
      z \<in> mHom R (Zm R e) M; f \<in> mHom R M N; exact3 R (Zm R e) z M f N\<rbrakk> \<Longrightarrow>
      injec\<^bsub>M,N\<^esub> f"
apply (simp add:injec_def)
apply (rule conjI)
apply (simp add:mHom_def)
apply (simp add:exact3_def)
apply (simp add:Zm_def, fold Zm_def)
apply (simp add: Zm_to_M_0 [of M z e])
done

lemma (in Ring) injec_left_exact:"\<lbrakk>R module M; R module N;
       z \<in> mHom R (Zm R e) M; f \<in> mHom R M N; injec\<^bsub>M,N\<^esub> f\<rbrakk> \<Longrightarrow>
       exact3 R (Zm R e) z M f N"
apply (simp add:exact3_def)
apply (simp add:Zm_def, fold Zm_def)
 apply (simp add:Zm_to_M_0 [of  "M" "z" "e"])
 apply (simp add:injec_def)
done

  (*  injec_mHom_image
                 N
                 | \ x      x `(N) \<subseteq> f `(M1)
                 |  \
                M1 \<rightarrow> M2
                   f                     *)
lemma (in Ring) injec_mHom_image:"\<lbrakk>R module N; R module M1; R module M2;
       x \<in> mHom R N M2; f \<in> mHom R M1 M2; x ` (carrier N) \<subseteq> f ` (carrier M1);
       injec\<^bsub>M1,M2\<^esub> f\<rbrakk>\<Longrightarrow>
   (\<lambda>n \<in>(carrier N). (SOME m. (m \<in> carrier M1 \<and> x n = f m))) \<in> mHom R N M1 \<and>
   compos N f (\<lambda>n \<in> (carrier N). (SOME m. m \<in> carrier M1 \<and> x n = f m)) = x"
apply (subgoal_tac "(\<lambda>n\<in>carrier N. SOME m. m \<in> carrier M1 \<and> x n = f m) \<in>
       mHom R N M1", simp)
apply (rule Module.mHom_eq, assumption+)
 apply (simp add:Module.mHom_compos, assumption)
 apply (rule ballI)
 apply (simp add:compos_def compose_def)
 apply (thin_tac "(\<lambda>n\<in>carrier N. SOME m. m \<in> carrier M1 \<and> x n = f m) \<in>
                   mHom R N M1")
 apply (frule_tac m = m in Module.mHom_mem [of N R M2 x], assumption+)
 apply (cut_tac mHom_func[of x N M2],
        frule_tac a = m in mem_in_image[of x "carrier N" "carrier M2"],
        assumption+,
        frule_tac c = "x m" in subsetD [of "x ` carrier N" "f ` carrier M1"],
        assumption+)
 apply (simp add:image_def)
 apply (rule someI2_ex, blast)
 apply (thin_tac "\<exists>xa\<in>carrier M1. x m = f xa", erule conjE)
 apply (rotate_tac -1, rule sym, assumption+)

apply (simp add:mHom_def[of R N M1] aHom_def)
 apply (rule conjI)
 apply (rule Pi_I)
 apply (cut_tac mHom_func[of x N M2],
        frule_tac a = xa in mem_in_image[of x "carrier N" "carrier M2"],
        assumption+,
        frule_tac c = "x xa" in subsetD [of "x ` carrier N" "f ` carrier M1"],
        assumption+)
 apply (simp add:image_def)
 apply (rule someI2_ex, blast, simp, assumption)

apply (frule_tac R = R and M = N in Module.module_is_ag,
       simp add:aGroup.ag_pOp_closed,
       simp add:Module.sc_mem)
apply (rule conjI)
 apply (rule ballI)+
 apply (frule_tac x = a and y = b in aGroup.ag_pOp_closed [of "N"],
                                                            assumption+)
 apply (cut_tac mHom_func[of x N M2],
        frule_tac a = "a \<plusminus>\<^bsub>N\<^esub> b" in mem_in_image[of x "carrier N" "carrier M2"],
        assumption+,
        frule_tac c = "x (a \<plusminus>\<^bsub>N\<^esub> b)" in subsetD[of "x ` carrier N"
                                      "f ` carrier M1"], assumption+)
 apply (frule_tac a = a in mem_in_image[of x "carrier N" "carrier M2"],
        assumption+,
        frule_tac c = "x a" in subsetD[of "x ` carrier N"
                                      "f ` carrier M1"], assumption+,
        frule_tac a = b in mem_in_image[of x "carrier N" "carrier M2"],
        assumption+,
        frule_tac c = "x b" in subsetD[of "x ` carrier N"
                                      "f ` carrier M1"], assumption+)
 apply (simp add:image_def)
 apply (rule someI2_ex, blast)
 apply (rule someI2_ex, blast)
 apply (rule someI2_ex, blast)
 apply (thin_tac "\<exists>xa\<in>carrier N. x ( a \<plusminus>\<^bsub>N\<^esub> b) = x xa",
        thin_tac "\<exists>xa\<in>carrier M1. x ( a \<plusminus>\<^bsub>N\<^esub> b) = f xa",
        thin_tac "\<exists>xa\<in>carrier N. x a = x xa",
        thin_tac "\<exists>xa\<in>carrier M1. x a = f xa",
        thin_tac "\<exists>xa\<in>carrier N. x b = x xa",
        thin_tac "\<exists>xa\<in>carrier M1. x b = f xa")
 apply ((erule conjE)+, fold image_def)
 apply (frule_tac R = R and M = N and N = M2 and f = x and m = a and n = b in
        Module.mHom_add, assumption+, simp)
 apply (simp add:Module.mHom_add[THEN sym, of _ _ _ f])
 apply (frule_tac R = R and M = M1 and N = M2 and f = f in Module.minjec_inj,
        assumption+)
 apply (frule_tac R = R and M = M1 in Module.module_is_ag,
        frule_tac x = xaa and y = xa in aGroup.ag_pOp_closed[of M1],
        assumption+)
 apply (simp add:inj_on_def, assumption)

apply (rule ballI)+
 apply (frule_tac a = a and m = m in Module.sc_mem [of N R], assumption+)
 apply (cut_tac mHom_func[of x N M2],
        frule_tac a = "a \<cdot>\<^sub>s\<^bsub>N\<^esub> m" in mem_in_image[of x "carrier N" "carrier M2"],
        assumption+,
        frule_tac c = "x (a \<cdot>\<^sub>s\<^bsub>N\<^esub> m)" in subsetD[of "x ` carrier N"
                                      "f ` carrier M1"], assumption+)
 apply (frule_tac a = m in mem_in_image[of x "carrier N" "carrier M2"],
        assumption+,
        frule_tac c = "x m" in subsetD[of "x ` carrier N"
                                      "f ` carrier M1"], assumption+)
 apply (thin_tac "x (a \<cdot>\<^sub>s\<^bsub>N\<^esub> m) \<in> x ` carrier N",
        thin_tac "x m \<in> x ` carrier N")
 apply (simp add:image_def)
 apply (rule someI2_ex, blast)
 apply (rule someI2_ex, blast)
 apply (thin_tac "\<exists>xa\<in>carrier M1. x m = f xa",
        thin_tac "\<exists>xa\<in>carrier M1. x (a \<cdot>\<^sub>s\<^bsub>N\<^esub> m) = f xa")
 apply (erule conjE)+
 apply (simp add:Module.mHom_lin)
 apply (simp add:Module.mHom_lin[THEN sym])
 apply (rule sym)
 apply (frule_tac R = R and M = M1 and N = M2 and f = f in Module.minjec_inj,
        assumption+,
        frule_tac R = R and M = M1 and a = a and m = xa in Module.sc_mem,
        assumption+)
 apply (simp add:inj_on_def, assumption)
done

lemma (in Ring) right_exact_surjec:"\<lbrakk>R module M; R module N; f \<in> mHom R M N;
 p \<in> mHom R N (Zm R e); exact3 R M f N p (Zm R e)\<rbrakk> \<Longrightarrow> surjec\<^bsub>M,N\<^esub> f"
apply (simp add:surjec_def)
 apply (rule conjI)
 apply (simp add:mHom_def)
 apply (simp add:surj_to_def)
apply (simp add:exact3_def)
 apply (simp add:M_to_Z_0)
done

lemma (in Ring) surjec_right_exact:"\<lbrakk>R module M; R module N; f \<in> mHom R M N;
 p \<in> mHom R N (Zm R e); surjec\<^bsub>M,N\<^esub> f\<rbrakk> \<Longrightarrow> exact3 R M f N p (Zm R e)"
apply (simp add:exact3_def)
apply (simp add:ker_def)
 apply (frule_tac f = p and M = N and N = "Zm R e" in mHom_func,
        simp add:Zm_carrier)
 apply (simp add:surjec_def surj_to_def,
        thin_tac "f \<in> aHom M N \<and> f ` carrier M = carrier N")
 apply (subst Zm_def, simp)
 apply (rule equalityI, rule subsetI, simp,
        frule funcset_mem[of p "carrier N" "{e}"], assumption, simp)
 apply (rule subsetI, simp)
done

lemma (in Ring) exact4_exact3:"\<lbrakk>R module M; R module N; z \<in> mHom R (Zm R e) M;
       f \<in> mHom R M N; z1 \<in> mHom R N (Zm R e);
       exact4 R (Zm R e) z M f N z1 (Zm R e) \<rbrakk> \<Longrightarrow>
      exact3 R (Zm R e) z M f N \<and> exact3 R M f N z1 (Zm R e)"
apply (simp add:exact4_def exact3_def)
done

lemma (in Ring) exact4_bijec:"\<lbrakk>R module M; R module N; z \<in> mHom R (Zm R e) M;
       f \<in> mHom R M N; z1 \<in> mHom R N (Zm R e);
       exact4 R (Zm R e) z M f N z1 (Zm R e)\<rbrakk> \<Longrightarrow> bijec\<^bsub>M,N\<^esub> f"
apply (frule exact4_exact3 [of M N z e f z1], assumption+)
 apply (erule conjE)
 apply (simp add:bijec_def)
 apply (simp add:left_exact_injec)
 apply (simp add:right_exact_surjec)
done

lemma (in Ring) exact_im_sub_ker:"\<lbrakk>R module L; R module M; R module N;
  f \<in> mHom R L M; g \<in> mHom R M N; z1 \<in> mHom R N (Zm R e); R module Z;
  exact4 R L f M g N z1 (Zm R e); x \<in> mHom R M Z; compos L x f = mzeromap L Z\<rbrakk>
  \<Longrightarrow> (\<lambda>z\<in>(carrier N). x (SOME y. y \<in> carrier M \<and> g y = z)) \<in> mHom R N Z"
apply (subst mHom_def, simp)
apply (rule conjI)
 apply (simp add:aHom_def)
 apply (rule conjI)
 apply (rule Pi_I)
 apply simp
apply (subgoal_tac "exact3 R M g N z1 (Zm R e)")
prefer 2 apply (simp add:exact4_def exact3_def)
apply (frule right_exact_surjec [of M N g z1], assumption+)
 apply (simp add:surjec_def, frule conjunct2)
 apply (simp add:surj_to_def, erule conjE)
 apply (rotate_tac -1, frule sym, thin_tac "g ` carrier M = carrier N",
        simp, thin_tac "carrier N = g ` carrier M")
 apply (simp add:image_def)
 apply (rule someI2_ex, blast)
 apply (erule conjE, simp add:Module.mHom_mem)

apply (frule_tac R = R and M = N in Module.module_is_ag,
       simp add:aGroup.ag_pOp_closed)
 apply (rule ballI)+
 apply (frule_tac x = a and y = b in aGroup.ag_pOp_closed [of "N"],
                                                         assumption+)
apply (subgoal_tac "exact3 R M g N z1 (Zm R e)")
prefer 2 apply (simp add:exact4_def exact3_def,
        frule right_exact_surjec[of M N g z1], assumption+)
 apply (simp add:surjec_def surj_to_def, erule conjE)
 apply (rotate_tac -1, frule sym, thin_tac "g ` carrier M = carrier N",
        simp)
 apply (simp add:image_def)
 apply (rule someI2_ex, blast)
 apply (rule someI2_ex, blast)
 apply (rule someI2_ex)
 apply (thin_tac "\<exists>x\<in>carrier M. a = g x", thin_tac "\<exists>x\<in>carrier M. b = g x",
        thin_tac "xa \<in> carrier M \<and> g xa = b",
        thin_tac "xaa \<in> carrier M \<and> g xaa = a")
 apply (erule bexE, rotate_tac -1, frule sym, thin_tac "a \<plusminus>\<^bsub>N\<^esub> b = g xb")
 apply blast
 apply (thin_tac "\<exists>x\<in>carrier M. a = g x", thin_tac "\<exists>x\<in>carrier M. b = g x",
        thin_tac "\<exists>x\<in>carrier M. a \<plusminus>\<^bsub>N\<^esub> b = g x")
 apply (erule conjE)+
 apply (rotate_tac -5)
 apply (frule sym, thin_tac "g xa = b", frule sym, thin_tac "g xaa = a",
        frule sym, thin_tac "g xb = a \<plusminus>\<^bsub>N\<^esub> b", simp)
 apply (simp add:Module.mHom_add[THEN sym])
  apply (frule mzero_im_sub_ker [of L M Z f x], assumption+)
 apply (simp add:exact4_def, fold image_def,
        thin_tac "f ` carrier L = ker\<^bsub>M,N\<^esub> g \<and> g ` carrier M = ker\<^bsub>N,Zm R e\<^esub> z1")
 apply (frule_tac R = R and M = M in Module.module_is_ag,
       frule_tac x = xaa and y = xa in aGroup.ag_pOp_closed[of M], assumption+,
       frule_tac R = R and M = M and N = N and f = g and a = "xaa \<plusminus>\<^bsub>M\<^esub> xa"
        and b = xb in Module.mHom_ker_eq, assumption+)
 apply (frule_tac c = "xaa \<plusminus>\<^bsub>M\<^esub> xa \<plusminus>\<^bsub>M\<^esub> -\<^sub>a\<^bsub>M\<^esub> xb" in subsetD[of "ker\<^bsub>M,N\<^esub> g"
                   "ker\<^bsub>M,Z\<^esub> x"], assumption+)
 apply (frule_tac a = "xaa \<plusminus>\<^bsub>M\<^esub> xa" and b = xb in
                  Module.mHom_eq_ker[of M R Z x], assumption+)
 apply (rule sym, assumption)

 apply (simp add:Module.sc_mem)
 apply (rule ballI)+
 apply (frule right_exact_surjec[of M N g z1], assumption+,
        simp add:exact4_def exact3_def)
 apply (frule_tac a = a and m = m in Module.sc_mem[of N], assumption+)
 apply (simp add:surjec_def surj_to_def, erule conjE,
        rotate_tac -1, frule sym, thin_tac "g ` carrier M = carrier N",
        simp, thin_tac "carrier N = g ` carrier M")
 apply (simp add:image_def)
 apply (rule someI2_ex, blast,
        thin_tac "\<exists>x\<in>carrier M. m = g x")
 apply (rule someI2_ex)
 apply (erule bexE, rotate_tac -1, frule sym, thin_tac "a \<cdot>\<^sub>s\<^bsub>N\<^esub> m = g xaa")
 apply blast
 apply (thin_tac "\<exists>x\<in>carrier M. a \<cdot>\<^sub>s\<^bsub>N\<^esub> m = g x")
 apply (erule conjE)+
 apply (rotate_tac -3, frule sym, thin_tac "g xa = m", simp)
 apply (simp add:Module.mHom_lin[THEN sym])
 apply (frule_tac a = a and m = xa in Module.sc_mem, assumption+)
 apply (frule_tac R = R and M = M and N = N and f = g and a = xaa and
        b = "a \<cdot>\<^sub>s\<^bsub>M\<^esub> xa" in Module.mHom_ker_eq, assumption+)

 apply (frule mzero_im_sub_ker [of L M Z f x], assumption+,
        simp add:exact4_def,
        thin_tac "f ` carrier L = ker\<^bsub>M,N\<^esub> g \<and> g ` carrier M = ker\<^bsub>N,Zm R e\<^esub> z1")
 apply (frule_tac c = "xaa \<plusminus>\<^bsub>M\<^esub> -\<^sub>a\<^bsub>M\<^esub> (a \<cdot>\<^sub>s\<^bsub>M\<^esub> xa)" in
                  subsetD[of "ker\<^bsub>M,N\<^esub> g " "ker\<^bsub>M,Z\<^esub> x"], assumption+)
 apply (rule_tac a = xaa and b = "a \<cdot>\<^sub>s\<^bsub>M\<^esub> xa" in
                  Module.mHom_eq_ker[of M R Z x], assumption+)
done

    (*     f    g    z1
         L \<rightarrow> M \<rightarrow> N \<rightarrow> 0      exact4 L M N (Zm R e) f g z1, x \<in> mHom R M Z
               x\  | \<exists>x'       im f \<subseteq> ker x, then exists x'
                   Z        *)

lemma (in Ring) exact_im_sub_ker1:"\<lbrakk>R module L; R module M; R module N;
      f \<in> mHom R L M; g \<in> mHom R M N; z1 \<in> mHom R N (Zm R e); R module Z;
      exact4 R L f M g N z1 (Zm R e); x \<in> mHom R M Z;
      compos L x f = mzeromap L Z \<rbrakk> \<Longrightarrow>
    compos M (\<lambda>z\<in>(carrier N). x (SOME y. y \<in> carrier M \<and> g y = z)) g = x"
apply (frule exact_im_sub_ker [of L M N f g z1 e Z x], assumption+)
apply (frule_tac g = "(\<lambda>z\<in>carrier N. x (SOME y. y \<in> carrier M \<and> g y = z))" in
        Module.mHom_compos [of N R M Z g], assumption+)
 apply (rule Module.mHom_eq [of M R Z _ x], assumption+)
 apply (rule ballI)
 apply (subst compos_def, subst compose_def, simp)
 apply (simp add:Module.mHom_mem)
 apply (thin_tac "compos M (\<lambda>z\<in>carrier N. x
                 (SOME y. y \<in> carrier M \<and> g y = z)) g \<in> mHom R M Z")
 apply (thin_tac "(\<lambda>z\<in>carrier N. x (SOME y. y \<in> carrier M \<and> g y = z)) \<in>
                                                               mHom R N Z")
 apply (frule right_exact_surjec [of M N g z1 e], assumption+)
 apply (simp add:exact4_def exact3_def)
 apply (frule mHom_func[of g M N],
        frule_tac a = m in mem_in_image[of g "carrier M" "carrier N"],
        assumption+)
 apply (simp add:image_def)
 apply (rule someI2_ex) apply blast
 apply (thin_tac "\<exists>x\<in>carrier M. g m = g x") apply (erule conjE)
 apply (frule mzero_im_sub_ker [of L M Z f x], assumption+)
 apply (simp add:surjec_def surj_to_def exact4_def)
 apply (frule_tac a = xa and b = m in Module.mHom_ker_eq[of M R N g],
         assumption+)
 apply (frule_tac c = "xa \<plusminus>\<^bsub>M\<^esub> -\<^sub>a\<^bsub>M\<^esub> m" in subsetD[of "ker\<^bsub>M,N\<^esub> g" "ker\<^bsub>M,Z\<^esub> x"],
                  assumption+)
 apply (rule_tac a = xa and b = m in Module.mHom_eq_ker[of M R Z x],
           assumption+)
done

definition
  module_iota :: "[('r, 'm) Ring_scheme, ('a, 'r, 'm1) Module_scheme] \<Rightarrow>
                'a \<Rightarrow> 'a"  ("(m\<iota>\<^bsub>_\<^esub> _)" [92, 93]92) where
  "m\<iota>\<^bsub>R\<^esub> M = (\<lambda>x\<in>carrier M. x)"

lemma (in Ring) short_exact_sequence:"\<lbrakk>R module M; submodule R M N;
 z \<in> mHom R (Zm R e) (mdl M N); z1 \<in> mHom R (M /\<^sub>m N) (Zm R e)\<rbrakk> \<Longrightarrow>
 exact5 R (Zm R e) z (mdl M N)(m\<iota>\<^bsub>R\<^esub> (mdl M N)) M (mpj M N) (M /\<^sub>m N) z1 (Zm R e)"
apply (simp add:exact5_def)
apply (rule conjI)
 apply (simp add:Zm_def, fold Zm_def)
 apply (frule Module.mdl_is_module [of M R N], assumption+)
 apply (simp add:ker_def, simp add:module_iota_def)
 apply (simp add:Zm_to_M_0 [of "mdl M N" "z"])
 apply (simp add:mdl_def, fold mdl_def)
 apply (rule equalityI)
 apply simp
 apply (simp add:Module.submodule_inc_0)
 apply (rule subsetI)
 apply (simp add:CollectI)
apply (rule conjI)
 apply (simp add:module_iota_def)
 apply (simp add:mdl_def, fold mdl_def)
  apply (simp add:Module.mker_of_mpj[THEN sym])
 apply (frule Module.qmodule_module [of M R N], assumption)
apply (subst M_to_Z_0 [of "M /\<^sub>m N" z1 e], assumption+)
 apply (frule Module.mpj_surjec [of M R N], assumption+)
 apply (simp add:surjec_def surj_to_def)
done

lemma (in Ring) rexact4_lexact4_HOM:"\<lbrakk>R module M1; R module M2; R module M3;
      f \<in> mHom R M1 M2; g \<in> mHom R M2 M3; z1 \<in> mHom R M3 (Zm R e);
      exact4 R M1 f M2 g M3 z1 (Zm R e)\<rbrakk> \<Longrightarrow>
 \<forall>N. R module N \<longrightarrow>
 exact4 R (HOM\<^bsub>R\<^esub> (Zm R e) N) (sup_sharp R M3 (Zm R e) N z1) (HOM\<^bsub>R\<^esub> M3 N)
(sup_sharp R M2 M3 N g) (HOM\<^bsub>R\<^esub> M2 N) (sup_sharp R M1 M2 N f) (HOM\<^bsub>R\<^esub> M1 N)"

 (*              f     g    z1
             M1 \<rightarrow> M2 \<rightarrow> M3 \<rightarrow> (Zm R e)
                         |
                         N                     *)
apply (rule allI) apply (rule impI)
apply (subst exact4_def)
apply (rule conjI)
 apply (cut_tac Zm_Module [of e])
 apply (subst HOM_carrier [of  "Zm R e"])
 apply (simp add:mHom_Z_M)
 apply (simp add:sup_sharp_def)
 apply (simp add:mzeromap_mHom)
 apply (simp add:ker_def)
 apply (simp add:HOM_def)
 apply (rule equalityI)
 apply (rule subsetI)
 apply simp
 apply (frule_tac N = N in mzeromap_mHom [of "Zm R e"], assumption+)
   thm Module.mHom_compos[of "Zm R e" R M3 _ z1]
 apply (frule_tac N = N and g = "mzeromap (Zm R e) N" in
                 Module.mHom_compos[of  "Zm R e" R M3 _ z1], assumption+,
        simp)
 apply (frule_tac N = N in mzeromap_mHom [of M2], assumption+)
 apply (rule_tac N = N and f = "compos M2 (compos M3 (mzeromap (Zm R e) N) z1) g" and g = "mzeromap M2 N" in Module.mHom_eq [of M2 _ ], assumption+)
 apply (rule Module.mHom_compos, assumption+)
 apply (rule ballI)
 apply (simp add:compos_def mzeromap_def compose_def)
 apply (simp add:Module.mHom_mem)+
 apply (rule subsetI, simp, erule conjE, simp)
 apply (frule_tac N = N in mzeromap_mHom [of "Zm R e"], assumption+)
 apply (frule_tac N = N and g = "mzeromap (Zm R e) N" in
        Module.mHom_compos [of "Zm R e" R M3  _ z1], assumption+)
 apply (rule_tac  N = N and f = x and
        g = "compos M3 (mzeromap (Zm R e) N) z1" in Module.mHom_eq[of M3 _],
        assumption+)
 apply (rule ballI)
 apply (subst compos_def, subst compose_def)
 apply (subst mzeromap_def) apply (simp add:Module.mHom_mem)
 apply (simp add:exact4_def)
 apply (subgoal_tac "exact3 R M2 g  M3 z1 (Zm R e)")
 prefer 2 apply (simp add:exact3_def)
 apply (frule right_exact_surjec [of M2 M3 g z1], assumption+)
 apply (simp add:surjec_def surj_to_def, erule conjE)
 apply (thin_tac "f ` carrier M1 = ker\<^bsub>M2,M3\<^esub> g",
        thin_tac "g \<in> aHom M2 M3 \<and> ker\<^bsub>M3,Zm R e\<^esub> z1 = carrier M3",
        rotate_tac -1, frule sym, thin_tac "g ` carrier M2 = carrier M3",
        simp add:image_def, fold image_def)
 apply (erule bexE, simp) apply (simp add:compos_def compose_def mzeromap_def)
 apply (frule_tac f = "\<lambda>xa\<in>carrier M2. x (g xa)" and g = "\<lambda>x\<in>carrier M2. \<zero>\<^bsub>N\<^esub>"
        and x = xa in eq_fun_eq_val,
        thin_tac "(\<lambda>xa\<in>carrier M2. x (g xa)) = (\<lambda>x\<in>carrier M2. \<zero>\<^bsub>N\<^esub>)",
        simp)
(* apply (erule conjE) apply (simp add:surj_to_def)
 apply (simp add:image_def)
 apply (subgoal_tac "m \<in> {y. \<exists>x\<in>carrier M2. y = g x}")
 apply (thin_tac "{y. \<exists>x\<in>carrier M2. y = g x} = carrier M3")
 prefer 2 apply simp apply simp
 apply (subgoal_tac "\<forall>y\<in>carrier M2. m = g y \<longrightarrow> x m = 0\<^sub>N")
 apply blast
 apply (rule ballI) apply (rule impI) apply simp
 apply (thin_tac "compos M3 (mzeromap (Zm R e) N) z1 \<in> mHom R M3 N")
 apply (thin_tac "\<exists>x\<in>carrier M2. g y = g x") apply (thin_tac "m = g y")
 apply (simp add:compos_def compose_def)
 apply (subgoal_tac "(\<lambda>xa\<in>carrier M2. x (g xa)) y = x ( g y)")
 apply (simp add:mzeromap_def) apply (thin_tac "(\<lambda>xa\<in>carrier M2. x (g xa)) = mzeromap M2 N")
 apply simp  *)
apply (rule equalityI)
 apply (rule subsetI)
 apply (simp add:image_def)
 apply (simp add:ker_def)
 apply (simp add:HOM_carrier)
 apply (erule bexE)
 apply (frule_tac L = N and f = xa in Module.sup_sharp_homTr[of M2 R M3 _ g],
         assumption+, simp)
  thm Module.sup_sharp_homTr[of M1 R M2 _ f]
 apply (frule_tac L = N and f = "sup_sharp R M2 M3 N g xa" in
        Module.sup_sharp_homTr[of M1 R M2 _ f], assumption+)
 apply (simp add:HOM_def)
 apply (frule_tac N = N in  mzeromap_mHom[of M1], assumption)
 apply (rule Module.mHom_eq, assumption+)
apply (rule ballI)
 apply (subst sup_sharp_def)
 apply simp
 apply (subst compos_def, subst compose_def)
 apply (subst sup_sharp_def, simp)
 apply (subst compos_def, subst compose_def, simp)
 apply (simp add:Module.mHom_mem)
 apply (subgoal_tac "exact3 R M1 f M2 g M3")
 prefer 2 apply (simp add:exact4_def exact3_def)
 apply (frule_tac exact3_comp_0 [of M1 M2 M3 f g], assumption+)
 apply (frule_tac f = "compos M1 g f" and g = "mzeromap M1 M3"
        and x = m in eq_fun_eq_val,
        thin_tac "compos M1 g f = mzeromap M1 M3",
        simp add:compos_def compose_def mzeromap_def)
 apply (simp add:Module.mHom_0)
apply (rule subsetI)
 apply (simp add:ker_def)
 apply (erule conjE)
 apply (simp add:HOM_carrier)
 apply (simp add:HOM_def)
 apply (simp add:sup_sharp_def)
 apply (simp add:image_def)
 apply (frule_tac Z = N and x = x in  exact_im_sub_ker1 [of M1 M2 M3 f g z1 e],
        assumption+)
 apply (rotate_tac -1) apply (frule sym)
 apply (thin_tac "compos M2 (\<lambda>z\<in>carrier M3. x
                      (SOME y. y \<in> carrier M2 \<and> g y = z)) g = x")
 apply (frule_tac Z = N and x = x in exact_im_sub_ker [of M1 M2 M3 f g z1 e],
        assumption+)
 apply blast
done

lemma exact_HOM_exactTr:"\<lbrakk>Ring (R::('r, 'm1) Ring_scheme); f \<in> mHom R M1 M2;
      g \<in> mHom R M2 M3; z1 \<in> mHom R M3 (Zm R e); R module NV;
     \<forall>(N::('a, 'r, 'm) Module_scheme). R module N \<longrightarrow>
      exact4 R (HOM\<^bsub>R\<^esub> (Zm R e) N)(sup_sharp R M3 (Zm R e) N z1)
      (HOM\<^bsub>R\<^esub> M3 N) (sup_sharp R M2 M3 N g) (HOM\<^bsub>R\<^esub> M2 N) (sup_sharp R M1 M2 N f)
      (HOM\<^bsub>R\<^esub> M1 N); R module (L::('a, 'r, 'm) Module_scheme)\<rbrakk> \<Longrightarrow>
  exact4 R (HOM\<^bsub>R\<^esub> (Zm R e) L) (sup_sharp R M3 (Zm R e) L z1)
 (HOM\<^bsub>R\<^esub> M3 L) (sup_sharp R M2 M3 L g) (HOM\<^bsub>R\<^esub> M2 L) (sup_sharp R M1 M2 L f)
 (HOM\<^bsub>R\<^esub> M1 L)"
apply simp
done

(*
lemma exact_HOM_exact:"\<lbrakk>ring (R:: ('r, 'm) RingType_scheme); R module M1; R module M2; R module M3; f \<in> mHom R M1 M2; g \<in> mHom R M2 M3; z1 \<in> mHom R M3 (Zm R e); R module (NV::('g, 'r) ModuleType); \<forall>(N::('g, 'r) ModuleType). R module N \<longrightarrow> exact4 R (HOM\<^sub>R (Zm R e) N) (HOM\<^sub>R M3 N) (HOM\<^sub>R M2 N) (HOM\<^sub>R M1 N) (sup_sharp R M3 (Zm R e) N z1) (sup_sharp R M2 M3 N g) (sup_sharp R M1 M2 N f) \<rbrakk> \<Longrightarrow> exact4 R M1 M2 M3 (Zm R e) f g z1"
apply (subst exact4_def)
apply (subgoal_tac "surjec\<^sub>M2\<^sub>,\<^sub>M3 g")
 apply (frule surjec_right_exact [of "R" "M2" "M3" "g" "z1" "e"], assumption+)
 apply (simp add:exact3_def)
prefer 2
apply (frule img_set_submodule [of "R" "M2" "M3" "g"], assumption+)
apply (frule qmodule_module [of "R" "M3" "g ` carrier M2"], assumption+)
apply (subgoal_tac "exact4 R (HOM\<^sub>R (Zm R e) (M3 /\<^sub>m (g ` carrier M2))) (HOM\<^sub>R M3 (M3 /\<^sub>m (g ` carrier M2))) (HOM\<^sub>R M2 (M3 /\<^sub>m (g ` carrier M2))) (HOM\<^sub>R M1 (M3 /\<^sub>m (g ` carrier M2))) (sup_sharp R M3 (Zm R e) (M3 /\<^sub>m (g ` carrier M2)) z1) (sup_sharp R M2 M3 (M3 /\<^sub>m (g ` carrier M2)) g) (sup_sharp R M1 M2 (M3 /\<^sub>m (g ` carrier M2)) f)")
prefer 2
 apply (thin_tac "submodule R M3 (g ` carrier M2)")
 apply (thin_tac "ring R") apply (thin_tac "R module M1")
 apply (thin_tac " R module M2") apply (thin_tac "R module M3")
apply blast ML
apply (rule allI)
 apply (rule impI)
 apply simp     ????????????
*)

lemma lexact4_rexact4_HOM:"\<lbrakk>Ring R; R module M1; R module M2; R module M3;
f \<in> mHom R M1 M2; g \<in> mHom R M2 M3; z \<in> mHom R (Zm R e) M1;
exact4 R (Zm R e) z M1 f M2 g M3 \<rbrakk> \<Longrightarrow>
\<forall>N. R module N \<longrightarrow> exact4 R (HOM\<^bsub>R\<^esub> N (Zm R e)) (sub_sharp R N (Zm R e) M1 z)
    (HOM\<^bsub>R\<^esub> N M1) (sub_sharp R N M1 M2 f) (HOM\<^bsub>R\<^esub> N M2) (sub_sharp R N M2 M3 g)
    (HOM\<^bsub>R\<^esub> N M3)"

 (*
                        N
                     z  |   f     g
            (Zm R e) \<rightarrow> M1 \<rightarrow> M2 \<rightarrow> M3  *)
apply (rule allI) apply (rule impI)
apply (subst exact4_def)
apply (rule conjI)
 apply (rule equalityI)
 apply (rule subsetI)
 apply (simp add:image_def)
 apply (simp add:HOM_def) apply (fold HOM_def)
 apply (erule bexE)
 apply (simp add:ker_def) apply (simp add:HOM_def)
 apply (simp add:sub_sharp_def)
 apply (cut_tac Ring.Zm_Module [of R e])
 apply (simp add:Module.mHom_compos)
 apply (frule_tac L = N and f = xa in
                  Module.mHom_compos[of "Zm R e" R _ M1 _ z], assumption+)
 apply (frule_tac L = N and f = "compos N z xa" in
                             Module.mHom_compos[of M1 R _ M2 _ f], assumption+)
 apply (frule_tac M = N in Ring.mzeromap_mHom [of R _  M2], assumption+)
 apply (rule Module.mHom_eq, assumption+)
 apply (rule ballI)
 apply (simp add:mzeromap_def) apply (simp add:compos_def compose_def)
  apply (frule_tac M = N and f = xa and m = m in Module.mHom_mem [of _ R
         "Zm R e"], assumption+)
 apply (simp add:exact4_def)
 apply (frule conjunct1)
 apply (thin_tac "z ` carrier (Zm R e) = ker\<^bsub>M1,M2\<^esub> f")
 apply (erule conjE, thin_tac "f ` carrier M1 = ker\<^bsub>M2,M3\<^esub> g")
 apply (frule Ring.mHom_func[of R z "(Zm R e)" M1], assumption)
 apply (frule_tac a = "xa m" in mem_in_image
          [of z "carrier (Zm R e)" "carrier M1"], assumption+, simp)
 apply (simp add:ker_def, assumption)

apply (rule subsetI)
 apply (simp add:ker_def) apply (simp add:HOM_def)
 apply (erule conjE)
 apply (frule_tac M = N in Ring.mHom_to_zero [of "R" _ "e"], assumption+)
 apply simp apply (simp add:sub_sharp_def)
 apply (simp add:exact4_def) apply (frule conjunct1)
 apply (thin_tac "z ` carrier (Zm R e) = ker\<^bsub>M1,M2\<^esub> f \<and>
                                          f ` carrier M1 = ker\<^bsub>M2,M3\<^esub> g")
 apply (simp add:Zm_def, fold Zm_def)
 apply (frule_tac L = N and f = x in Ring.mzero_im_sub_ker [of R _ M1 M2 _ f], assumption+) apply (rotate_tac -2) apply (frule sym)
 apply (thin_tac "{z e} = ker\<^bsub>M1,M2\<^esub> f", simp)
 apply (subgoal_tac "mzeromap N (Zm R e) \<in> mHom R N (Zm R e)")
 prefer 2  apply simp
 apply (frule Ring.Zm_Module[of R e])
 apply (frule_tac L = N and f = "mzeromap N (Zm R e)" in
        Module.mHom_compos [of "Zm R e" R _  M1 _ z], assumption+)
 apply (rule Module.mHom_eq, assumption+) apply (rule ballI)
 apply (simp add:compos_def compose_def mzeromap_def)
 apply (simp add:Zm_def, fold Zm_def)
 apply (frule_tac M = N and f = x in Ring.mHom_func[of R _ _ M1], assumption+)
 apply (frule_tac f = x and A = "carrier N" and B = "carrier M1" and a = m in
         mem_in_image, assumption+)
 apply (frule_tac c = "x m" and A = "x ` carrier N" and B = "{z e}" in
                      subsetD, assumption+)  apply simp

apply (simp add:image_def ker_def HOM_def)
apply (rule equalityI)
 apply (rule subsetI)
 apply (simp, erule bexE)
 apply (simp add:sub_sharp_def)
 apply (frule_tac L = N and f = xa in Module.mHom_compos [of M1 R _ M2 _ "f"],
                              assumption+) apply simp
 apply (frule_tac L = N and f = "compos N f xa" in Module.mHom_compos [of M2 R
        _ M3 _ g], assumption+)
 apply (rule Module.mHom_eq, assumption+)
 apply (simp add:Ring.mzeromap_mHom)
 apply (rule ballI)
 apply (simp add:compos_def compose_def mzeromap_def)
 apply (thin_tac " x = (\<lambda>x\<in>carrier N. f (xa x))")
 apply (thin_tac "(\<lambda>x\<in>carrier N. f (xa x)) \<in> mHom R N M2")
 apply (thin_tac "(\<lambda>x\<in>carrier N. g (if x \<in> carrier N then f (xa x) else undefined)) \<in> mHom R N M3")
 apply (frule_tac M = N and f = xa and m = m in Module.mHom_mem [of _ R M1],
        assumption+)
 apply (simp add:exact4_def) apply (frule conjunct2)
 apply (thin_tac "z ` carrier (Zm R e) = ker\<^bsub>M1,M2\<^esub> f \<and>
                                     f ` carrier M1 = ker\<^bsub>M2,M3\<^esub> g")
 apply (frule Ring.mHom_func[of R f M1 M2], assumption+,
        frule_tac f = f and A = "carrier M1" and B = "carrier M2" and
        a = "xa m" in  mem_in_image, assumption+, simp)
 apply (simp add:ker_def)

 apply (rule subsetI)
 apply simp apply (erule conjE)
 apply (simp add:sub_sharp_def)
 apply (frule_tac L = N and f = x in Ring.mzero_im_sub_ker [of R _ M2 M3 _ g],
        assumption+)
 apply (simp add:exact4_def)
 apply (frule conjunct2) apply (rotate_tac -1) apply (frule sym)
 apply (thin_tac "f ` carrier M1 = ker\<^bsub>M2,M3\<^esub> g")
 apply simp apply (thin_tac "ker\<^bsub>M2,M3\<^esub> g = f ` carrier M1")
 apply (frule Ring.left_exact_injec[of "R" "M1" "M2" "z" "e" "f"], assumption+)
 apply (simp add:exact3_def exact4_def)
 apply (frule_tac N = N and x = x in Ring.injec_mHom_image[of R _ M1 M2 _ f],
        assumption+)
 apply (erule conjE) apply (rotate_tac -1) apply (frule sym)
 apply (thin_tac "compos N f (\<lambda>n\<in>carrier N. SOME m. m \<in> carrier M1 \<and>
                                                        x n = f m) = x")
 apply blast
done

(* Now, we cannot prove following because of type problem
lemma l_exact4_HOM_lexact4:"\<lbrakk>ring R; R module M1; R module M2; R module M3; f \<in> mHom R M1 M2;
   g \<in> mHom R M2 M3; z \<in> mHom R (Zm R e) M1;
   \<forall>N. R module N \<longrightarrow>
       exact4 R (HOM\<^sub>R N Zm R e) (HOM\<^sub>R N M1) (HOM\<^sub>R N M2) (HOM\<^sub>R N M3)
        (sub_sharp R N (Zm R e) M1 z) (sub_sharp R N M1 M2 f)
        (sub_sharp R N M2 M3 g)\<rbrakk>
\<Longrightarrow> exact4 R (Zm R e) M1 M2 M3 z f g" *)

(*
lemma exact_coker:"\<lbrakk>ring R; R module M1; R module M2; R module M3; z \<in> mHom R (Zm R e) M1; f \<in> mHom R M1 M2; g \<in> mHom R M2 M3; z1 \<in> mHom R M3 (Zm R ee);  R module N1; R module N2; R module N3; h \<in> mHom R N1 N2; i \<in> mHom R N2 N3; exact5 (Zm R e) M1 M2 M3 (Zm R ee) z f g z1: exact5 (Zm R u) N1 N2 N3 (Zm R uu) z h i z1: f1 \<in> mHom R M1 N1; f2 \<in> mHom R M2 N2; f3 \<in> mHom R M3 N3; compos m1 f2 f = compos M1 h f1; compos M2 f3 g = compos M2 i f2\<rbrakk> \<Longrightarrow> exact8 (Zm R e) (mdl M1 (ker\<^sub>M1\<^sub>,\<^sub>N1 f1)) (mdl M2 (ker\<^sub>M2\<^sub>,\<^sub>N2 f2)) (mdl M3 (ker\<^sub>M3\<^sub>,\<^sub>N3 f3)) (N1 /\<^sub>m (f1 ` (carrier M1))) (N2 /\<^sub>m (f2 ` (carrier M2))) (N3 /\<^sub>m (f3 ` (carrier M3))) z f g zz hh ii zz1 "

*)

section "Tensor product"

definition
  prod_carr :: "[('a, 'r, 'm) Module_scheme, ('b, 'r, 'm) Module_scheme]
   \<Rightarrow> ('a * 'b) set" (infixl "\<times>\<^sub>c" 100) where
  "M \<times>\<^sub>c N = carrier M \<times> carrier N"

definition
  bilinear_map :: "['a * 'b \<Rightarrow> 'c, ('r, 'm) Ring_scheme,
    ('a, 'r, 'm1) Module_scheme, ('b, 'r, 'm1) Module_scheme,
    ('c, 'r, 'm1) Module_scheme] \<Rightarrow> bool" where
  "bilinear_map f R M1 M2 N \<longleftrightarrow> f \<in> M1 \<times>\<^sub>c M2 \<rightarrow> carrier N \<and>
                             f \<in> extensional (M1 \<times>\<^sub>c M2) \<and>
   (\<forall>x1 \<in> carrier M1. \<forall>x2 \<in> carrier M1.
         \<forall>y\<in>carrier M2.(f (x1 \<plusminus>\<^bsub>M1\<^esub> x2, y) = f (x1, y) \<plusminus>\<^bsub>N\<^esub> (f (x2, y)))) \<and>
   (\<forall>x\<in>carrier M1. \<forall>y1\<in>carrier M2.
         \<forall>y2\<in>carrier M2. f (x, y1 \<plusminus>\<^bsub>M2\<^esub> y2) = f (x, y1) \<plusminus>\<^bsub>N\<^esub> (f (x, y2))) \<and>
   (\<forall>x\<in>carrier M1. \<forall>y\<in>carrier M2.
         \<forall>r\<in>carrier R. f (r \<cdot>\<^sub>s\<^bsub>M1\<^esub> x, y) = r \<cdot>\<^sub>s\<^bsub>N\<^esub> (f (x, y)) \<and>
                       f (x, r \<cdot>\<^sub>s\<^bsub>M2\<^esub> y) = r \<cdot>\<^sub>s\<^bsub>N\<^esub> (f (x, y)))"

lemma (in Ring) prod_carr_mem:"\<lbrakk>R module M; R module N; m \<in> carrier M;
       n \<in> carrier N\<rbrakk> \<Longrightarrow> (m, n) \<in> M \<times>\<^sub>c N"
by (simp add:prod_carr_def)

lemma (in Ring) bilinear_func:"bilinear_map f R M N Z \<Longrightarrow>
                  f \<in> M \<times>\<^sub>c N \<rightarrow> carrier Z"
by (simp add:bilinear_map_def)

lemma (in Ring) bilinear_mem:"\<lbrakk>R module M1; R module M2; R module N;
      m1 \<in> carrier M1; m2 \<in> carrier M2; bilinear_map f R M1 M2 N\<rbrakk> \<Longrightarrow>
      f (m1, m2) \<in> carrier N"
apply (simp add:bilinear_map_def) apply (erule conjE)+
apply (rule funcset_mem [of "f" "M1 \<times>\<^sub>c M2" "carrier N"], assumption+)
apply (simp add:prod_carr_def)
done

lemma (in Ring) bilinear_l_add:"\<lbrakk>R module M1; R module M2; R module N;
       m11 \<in> carrier M1; m12 \<in> carrier M1; m2 \<in> carrier M2;
       bilinear_map f R M1 M2 N\<rbrakk> \<Longrightarrow>
       f (m11 \<plusminus>\<^bsub>M1\<^esub> m12, m2) = f (m11, m2) \<plusminus>\<^bsub>N\<^esub> (f (m12, m2))"
apply (simp add:bilinear_map_def)
done

lemma (in Ring) bilinear_l_add1:"\<lbrakk>R module M1; R module M2; R module N;
       m11 \<in> carrier M1; m12 \<in> carrier M1; m2 \<in> carrier M2;
       bilinear_map f R M1 M2 N\<rbrakk> \<Longrightarrow>
       f (m11 \<plusminus>\<^bsub>M1\<^esub> m12, m2) \<plusminus>\<^bsub>N\<^esub> -\<^sub>a\<^bsub>N\<^esub> (f (m11, m2) \<plusminus>\<^bsub>N\<^esub> (f (m12, m2))) = \<zero>\<^bsub>N\<^esub>"
apply (frule Module.module_is_ag[of N],
       frule Module.module_is_ag[of M1],
       subst aGroup.ag_eq_diffzero[of N, THEN sym], assumption+,
       frule_tac x = m11 and y = m12 in aGroup.ag_pOp_closed, assumption+)
 apply (simp add:bilinear_mem,
       rule aGroup.ag_pOp_closed, assumption+)
       apply ((simp add:bilinear_mem)+, simp add:bilinear_l_add)
done

lemma (in Ring) bilinear_r_add:"\<lbrakk>R module M1; R module M2; R module N;
      m \<in> carrier M1; m21 \<in> carrier M2; m22 \<in> carrier M2;
      bilinear_map f R M1 M2 N\<rbrakk> \<Longrightarrow>
      f (m, m21 \<plusminus>\<^bsub>M2\<^esub> m22) = f (m, m21) \<plusminus>\<^bsub>N\<^esub> (f (m, m22))"
apply (simp add:bilinear_map_def)
done

lemma (in Ring) bilinear_r_add1:"\<lbrakk>R module M1; R module M2; R module N;
       m \<in> carrier M1; m21 \<in> carrier M2; m22 \<in> carrier M2;
       bilinear_map f R M1 M2 N\<rbrakk> \<Longrightarrow>
       f (m, m21 \<plusminus>\<^bsub>M2\<^esub> m22) \<plusminus>\<^bsub>N\<^esub> -\<^sub>a\<^bsub>N\<^esub> (f (m, m21) \<plusminus>\<^bsub>N\<^esub> (f (m, m22))) = \<zero>\<^bsub>N\<^esub>"
apply (frule Module.module_is_ag[of N],
       frule Module.module_is_ag[of M2],
       subst aGroup.ag_eq_diffzero[of N, THEN sym], assumption+,
       frule_tac x = m21 and y = m22 in aGroup.ag_pOp_closed, assumption+)
 apply (simp add:bilinear_mem,
       rule aGroup.ag_pOp_closed, assumption+)
       apply ((simp add:bilinear_mem)+, simp add:bilinear_r_add)
done

lemma (in Ring) bilinear_l_lin1:"\<lbrakk>R module M1; R module M2; R module N;
      m1 \<in> carrier M1; m2 \<in> carrier M2; r \<in> carrier R;
      bilinear_map f R M1 M2 N\<rbrakk> \<Longrightarrow>
         f (r \<cdot>\<^sub>s\<^bsub>M1\<^esub> m1, m2) \<plusminus>\<^bsub>N\<^esub> -\<^sub>a\<^bsub>N\<^esub> (r \<cdot>\<^sub>s\<^bsub>N\<^esub> (f (m1, m2))) = \<zero>\<^bsub>N\<^esub>"
apply (frule Module.module_is_ag[of N],
       subst aGroup.ag_eq_diffzero[of N, THEN sym], assumption+,
       frule_tac a = r and m = m1 in Module.sc_mem[of M1 R], assumption+,
       simp add:bilinear_mem)
 apply (rule Module.sc_mem, assumption+, simp add:bilinear_mem,
        simp add:bilinear_l_lin)
done

lemma (in Ring) bilinear_r_lin:"\<lbrakk>R module M1; R module M2; R module N;
      m1 \<in> carrier M1; m2 \<in> carrier M2; r \<in> carrier R;
      bilinear_map f R M1 M2 N\<rbrakk> \<Longrightarrow> f (m1, r \<cdot>\<^sub>s\<^bsub>M2\<^esub> m2) = r \<cdot>\<^sub>s\<^bsub>N\<^esub> (f (m1, m2))"
apply (simp add:bilinear_map_def)
done

lemma (in Ring) bilinear_r_lin1:"\<lbrakk>R module M1; R module M2; R module N;
      m1 \<in> carrier M1; m2 \<in> carrier M2; r \<in> carrier R;
      bilinear_map f R M1 M2 N\<rbrakk> \<Longrightarrow>
      f (m1, r \<cdot>\<^sub>s\<^bsub>M2\<^esub> m2)  \<plusminus>\<^bsub>N\<^esub> -\<^sub>a\<^bsub>N\<^esub> (r \<cdot>\<^sub>s\<^bsub>N\<^esub> (f (m1, m2))) = \<zero>\<^bsub>N\<^esub> "
apply (frule Module.module_is_ag[of N],
       subst aGroup.ag_eq_diffzero[of N, THEN sym], assumption+,
       frule_tac a = r and m = m2 in Module.sc_mem[of M2 R], assumption+,
       simp add:bilinear_mem)
 apply (rule Module.sc_mem, assumption+, simp add:bilinear_mem,
        simp add:bilinear_r_lin)
done

lemma (in Ring) bilinear_l_0:"\<lbrakk>R module M1; R module M2; R module N;
      m2 \<in> carrier M2; bilinear_map f R M1 M2 N\<rbrakk> \<Longrightarrow> f (\<zero>\<^bsub>M1\<^esub>, m2) = \<zero>\<^bsub>N\<^esub>"
apply (frule Module.module_inc_zero [of M1 R])
apply (frule bilinear_l_add [of M1 M2 N "\<zero>\<^bsub>M1\<^esub>" "\<zero>\<^bsub>M1\<^esub>" "m2" "f"], assumption+)
 apply (frule Module.module_is_ag [of M1 R], simp add:aGroup.ag_l_zero)
 apply (frule bilinear_mem [of M1 M2 N "\<zero>\<^bsub>M1\<^esub>" m2 f], assumption+)
 apply (frule Module.module_is_ag [of N R])
 apply (frule aGroup.ag_eq_sol1 [of "N" "f (\<zero>\<^bsub>M1\<^esub>, m2)" "f (\<zero>\<^bsub>M1\<^esub>, m2)"
        "f (\<zero>\<^bsub>M1\<^esub>, m2)"], assumption+)
 apply (rule sym, assumption+)
apply (simp add:aGroup.ag_l_inv1)
done

lemma (in Ring) bilinear_r_0:"\<lbrakk>R module M1; R module M2; R module N;
      m1 \<in> carrier M1; bilinear_map f R M1 M2 N\<rbrakk> \<Longrightarrow> f (m1, \<zero>\<^bsub>M2\<^esub>) = \<zero>\<^bsub>N\<^esub>"
apply (frule Module.module_inc_zero [of M2 R])
apply (frule bilinear_r_add [of M1 M2 N m1 "\<zero>\<^bsub>M2\<^esub>" "\<zero>\<^bsub>M2\<^esub>" "f"], assumption+)
 apply (frule Module.module_is_ag [of M2 R])
 apply (simp add:aGroup.ag_l_zero)
 apply (frule bilinear_mem [of M1 M2 N m1 "\<zero>\<^bsub>M2\<^esub>" "f"], assumption+)
 apply (frule Module.module_is_ag [of N R])
 apply (frule aGroup.ag_eq_sol1 [of N "f (m1, \<zero>\<^bsub>M2\<^esub>)" "f (m1, \<zero>\<^bsub>M2\<^esub>)"
       "f (m1, \<zero>\<^bsub>M2\<^esub>)"], assumption+)
 apply (rule sym, assumption+)
apply (simp add:aGroup.ag_l_inv1)
done

definition
  universal_property :: "[('r, 'm) Ring_scheme, ('a, 'r, 'm1) Module_scheme,
                     ('b, 'r, 'm1) Module_scheme, ('c, 'r, 'm1) Module_scheme,
                     'a * 'b \<Rightarrow>'c] \<Rightarrow>  bool" where
  "universal_property (R::('r, 'm) Ring_scheme) (M::('a, 'r, 'm1) Module_scheme)
    (N:: ('b, 'r, 'm1) Module_scheme) (MN::('c, 'r, 'm1) Module_scheme)
    (f:: 'a * 'b \<Rightarrow> 'c) \<longleftrightarrow> (bilinear_map f R M N MN) \<and>
    (\<forall>(Z :: ('c, 'r, 'm1) Module_scheme). \<forall>(g :: 'a * 'b \<Rightarrow> 'c). (R module Z) \<and>
    (bilinear_map g R M N Z) \<longrightarrow>  ((\<exists>!h. (h \<in> mHom R MN Z) \<and>
                                        (compose (M \<times>\<^sub>c N) h f = g))))"

(* universal_property R MV M N MN f *)

lemma tensor_prod_uniqueTr:"\<lbrakk>Ring R; R module (M::('a, 'r, 'm1) Module_scheme);
      R module (N:: ('b, 'r, 'm1) Module_scheme);
      R module (MN:: ('c, 'r, 'm1) Module_scheme);
      R module (MN1::('c, 'r, 'm1) Module_scheme);
      universal_property R M N MN f; universal_property R M N MN1 g\<rbrakk> \<Longrightarrow>
      \<exists>!k. k \<in> mHom R MN1 MN \<and> compose (M \<times>\<^sub>c N) k g = f"
apply (simp add: universal_property_def [of  _ _ _ _ "f"])
 apply (frule conjunct1) apply (fold universal_property_def)
 apply (simp add:universal_property_def [of _ _ _ _ "g"])
done

lemma tensor_prod_unique:"\<lbrakk>Ring (R:: ('r, 'm) Ring_scheme);
      R module (M :: ('a, 'r, 'm1) Module_scheme);
      R module (N:: ('b, 'r, 'm1) Module_scheme);
      R module (MN:: ('c, 'r, 'm1) Module_scheme);
      R module (MN1::('c, 'r, 'm1) Module_scheme);
      universal_property R M N MN f; universal_property R M N MN1 g\<rbrakk> \<Longrightarrow>
      MN \<cong>\<^bsub>R\<^esub> MN1"
apply (frule tensor_prod_uniqueTr[of R M N MN MN1 f g], assumption+,
       erule ex1E,
       thin_tac "\<forall>y. y \<in> mHom R MN1 MN \<and> compose (M \<times>\<^sub>c N) y g = f \<longrightarrow> y = k",
       frule tensor_prod_uniqueTr [of R M N MN1 MN g f], assumption+)
apply (erule ex1E,
       thin_tac "\<forall>y. y \<in> mHom R MN MN1 \<and> compose (M \<times>\<^sub>c N) y f = g \<longrightarrow> y = ka",
       (erule conjE)+,
       rename_tac k h,
       frule_tac f = k in Ring.mHom_func[of R _ MN1 MN], assumption)
apply (subgoal_tac "f \<in> (M \<times>\<^sub>c N) \<rightarrow> (carrier MN)")
 prefer 2 apply (simp add:universal_property_def bilinear_map_def)
apply (frule_tac f = h in Ring.mHom_func[of R _ MN MN1], assumption,
        frule_tac  g = h and h = k in compose_assoc [of "f" "M \<times>\<^sub>c N" "carrier MN"], simp)
apply (subgoal_tac "g \<in> (M \<times>\<^sub>c N) \<rightarrow> (carrier MN1)")
 prefer 2 apply (simp add:universal_property_def bilinear_map_def)
apply (frule_tac g = k and h = h in compose_assoc [of "g" "M \<times>\<^sub>c N" "carrier MN1"], simp)
apply (subgoal_tac "compose (M \<times>\<^sub>c N) (mId\<^bsub>MN\<^esub>) f = f")
 prefer 2
 apply (frule Module.mId_mHom [of MN R],
        frule_tac f = "mId\<^bsub>MN\<^esub>" in Ring.mHom_func[of R _ MN MN], assumption,
        frule  composition [of f "M \<times>\<^sub>c N" "carrier MN" "mId\<^bsub>MN\<^esub>" "carrier MN"],
         assumption+,
        rule funcset_eq [of _ "M \<times>\<^sub>c N"] )
   apply (simp add:compose_def restrict_def extensional_def,
        simp add:universal_property_def bilinear_map_def)
 apply (simp add:compose_def mId_def funcset_mem del:Pi_I')
apply (rotate_tac -4)
apply (frule sym,
        thin_tac "f = compose (M \<times>\<^sub>c N) (compose (carrier MN) k h) f")
apply (subgoal_tac "(compose (carrier MN) k h) = mId\<^bsub>MN\<^esub>")
 apply (subgoal_tac "(compose (carrier MN1) h k) = (mId\<^bsub>MN1\<^esub>)")
  apply (simp add:misomorphic_def)
  apply (frule_tac f = h and g = k in Module.mHom_mId_bijec [of MN R MN1],
            assumption+)
  apply blast  (* compose (carrier MN1) h k = mId\<^sub>MN1 *)
 apply (subgoal_tac "compose (M \<times>\<^sub>c N) (mId\<^bsub>MN1\<^esub>) g = g")
  prefer 2
  apply (frule Module.mId_mHom [of MN1 R])
  apply (subgoal_tac "mId\<^bsub>MN1\<^esub>  \<in> carrier MN1 \<rightarrow> carrier MN1")
   prefer 2 apply (simp add:mHom_def aHom_def)
  apply (frule  composition [of "g" "M \<times>\<^sub>c N" "carrier MN1" "mId\<^bsub>MN1\<^esub>"
      "carrier MN1"], assumption+,
      rule funcset_eq [of _ "M \<times>\<^sub>c N"],
      simp add:compose_def restrict_def extensional_def,
      simp add:universal_property_def bilinear_map_def)
  apply (simp add:compose_def mId_def,
       simp add:funcset_mem del:Pi_I',
       frule sym,
       thin_tac "g = compose (M \<times>\<^sub>c N) (compose (carrier MN1) h k) g",
       frule tensor_prod_uniqueTr [of R M N MN1 MN1 g g], assumption+)
 apply (erule ex1E,
        frule Module.mId_mHom [of MN1 R])
 apply (subgoal_tac "mId\<^bsub>MN1\<^esub> = ka") prefer 2
  apply (thin_tac "compose (M \<times>\<^sub>c N) k g = f",
         thin_tac "compose (M \<times>\<^sub>c N) h f = g",
         thin_tac "compose (M \<times>\<^sub>c N) (compose (carrier MN) k h) f = f",
         thin_tac "compose (carrier MN) k h = mId\<^bsub>MN\<^esub>",
         thin_tac "ka \<in> mHom R MN1 MN1 \<and> compose (M \<times>\<^sub>c N) ka g = g",
         thin_tac "compose (M \<times>\<^sub>c N) (compose (carrier MN1) h k) g = g",
      blast)
 apply (subgoal_tac "compose (carrier MN1) h k = ka",
        thin_tac "k \<in> mHom R MN1 MN",
        thin_tac "compose (M \<times>\<^sub>c N) k g = f",
        thin_tac "compose (M \<times>\<^sub>c N) h f = g",
        thin_tac "k \<in> carrier MN1 \<rightarrow> carrier MN",
        thin_tac "f \<in> M \<times>\<^sub>c N \<rightarrow> carrier MN",
        thin_tac "h \<in> carrier MN \<rightarrow> carrier MN1",
        thin_tac "compose (M \<times>\<^sub>c N) (compose (carrier MN) k h) f = f",
        thin_tac "compose (carrier MN) k h = mId\<^bsub>MN\<^esub>",
        thin_tac "compose (M \<times>\<^sub>c N) (mId\<^bsub>MN1\<^esub> ) g = g",
        thin_tac "compose (M \<times>\<^sub>c N) (compose (carrier MN1) h k) g = g",
        thin_tac "ka \<in> mHom R MN1 MN1 \<and> compose (M \<times>\<^sub>c N) ka g = g",
        thin_tac "\<forall>y. y \<in> mHom R MN1 MN1 \<and>
                               compose (M \<times>\<^sub>c N) y g = g \<longrightarrow> y = ka")
  apply simp
 apply (thin_tac "mId\<^bsub>MN1\<^esub>  \<in> mHom R MN1 MN1",
        thin_tac "compose (M \<times>\<^sub>c N) (mId\<^bsub>MN1\<^esub> ) g = g",
        thin_tac "ka \<in> mHom R MN1 MN1 \<and> compose (M \<times>\<^sub>c N) ka g = g",
        thin_tac "mId\<^bsub>MN1\<^esub>  = ka")
 apply (subgoal_tac "(compose (carrier MN1) h k) \<in> mHom R MN1 MN1")
  apply simp
 apply (thin_tac "\<forall>y. y \<in> mHom R MN1 MN1 \<and>
             compose (M \<times>\<^sub>c N) y g = g \<longrightarrow> y = ka")

 apply (frule_tac f = k and g = h in  Module.mHom_compos[of MN R MN1 MN1],
                        assumption+)
 apply (simp add:compos_def)  (** compose (carrier MN1) h k = mId\<^bsub>MN1\<^esub> done **)
  (* compose (carrier MN) k h = mId\<^sub>MN *)
apply (frule Module.mId_mHom [of MN R])
apply (subgoal_tac "compose (M \<times>\<^sub>c N) (mId\<^bsub>MN\<^esub>) f = f")
 prefer 2
 apply (frule_tac f = "mId\<^bsub>MN\<^esub>" in Ring.mHom_func[of R _ MN MN], assumption)
 apply (frule  composition [of "f" "M \<times>\<^sub>c N" "carrier MN" "mId\<^bsub>MN\<^esub>" "carrier MN"],
        assumption+)
apply (frule tensor_prod_uniqueTr [of "R" "M" "N" "MN" "MN" "f" "f"],
       assumption+)
apply (erule ex1E)
apply (subgoal_tac "mId\<^bsub>MN\<^esub> = ka") prefer 2
 apply (thin_tac "compose (M \<times>\<^sub>c N) k g = f",
         thin_tac "compose (M \<times>\<^sub>c N) h f = g",
         thin_tac "ka \<in> mHom R MN MN \<and> compose (M \<times>\<^sub>c N) ka f = f")
 apply blast
apply (rotate_tac -1) apply (frule sym, thin_tac "mId\<^bsub>MN\<^esub>  = ka")
apply (thin_tac "compose (M \<times>\<^sub>c N) k g = f",
        thin_tac "compose (M \<times>\<^sub>c N) h f = g",
        thin_tac "k \<in> carrier MN1 \<rightarrow> carrier MN",
        thin_tac "f \<in> M \<times>\<^sub>c N \<rightarrow> carrier MN",
        thin_tac "h \<in> carrier MN \<rightarrow> carrier MN1",
        thin_tac "compose (M \<times>\<^sub>c N) (mId\<^bsub>MN\<^esub>) f = f")
apply (subgoal_tac "(compose (carrier MN) k h) \<in> mHom R MN MN")
 apply simp
apply (frule_tac f = h and g = k in Module.mHom_compos[of MN1 R MN "MN"],
                        assumption+)
apply (metis compos_def)
done

chapter "Construction of an abelian group"

section "Free generated abelian group I, direct sum and direct product 2"

(** Make a free generated abelian group **)

definition (* for abelian groups, modules *)
  bpp :: "['a \<Rightarrow> 'a \<Rightarrow> 'a, 'a, 'a] \<Rightarrow> 'a" where
  "bpp f a b = f a b"

definition
  ipp :: "['a \<Rightarrow> 'a, 'a] \<Rightarrow> 'a"  ("(\<^sub>_-/ _)" [64,65]64) where
  "\<^sub>i- a == i a"

definition (* for modules *)
  sop :: "['r \<Rightarrow> 'a \<Rightarrow> 'a, 'r, 'a] \<Rightarrow> 'a" where
  "sop s r a = s r a"

abbreviation
  BOP :: "['a, 'a \<Rightarrow> 'a \<Rightarrow> 'a, 'a] \<Rightarrow> 'a"
    ("(3_/ \<^sub>_+/ _)" [62,62,63]62) where
  "a \<^sub>f+ b == bpp f a b"

abbreviation
  SOP :: "['r, 'r \<Rightarrow> 'a \<Rightarrow> 'a, 'a] \<Rightarrow> 'a"
    ("(3_/ \<^sub>_\<cdot> _)" [68,68,69]68) where
  "r \<^sub>s\<cdot> a == sop s r a"

definition
 minus_set :: "['a \<Rightarrow> 'a, 'a set] \<Rightarrow> 'a set" where
 "minus_set i A = {x. \<exists>y\<in>A. x = \<^sub>i- y}"

definition
 pm_set :: "['a \<Rightarrow> 'a, 'a set] \<Rightarrow> 'a set" where
 "pm_set i A = A \<union> (minus_set i A)"

definition
  s_set :: "[('r, 'm) Ring_scheme, 'r \<Rightarrow> 'a \<Rightarrow> 'a, 'a set] \<Rightarrow> 'a set" where
  "s_set R s A = {x. \<exists>r\<in>carrier R. \<exists>a\<in>A. x = r \<^sub>s\<cdot> a} \<union> A"

primrec add_set :: "['a \<Rightarrow> 'a \<Rightarrow> 'a, 'a set] \<Rightarrow> nat \<Rightarrow> 'a set"
where
  add_set_0 : "add_set f A 0 = A"
| add_set_Suc: "add_set f A (Suc n) =
                      {x. \<exists>s\<in> (add_set f A n). \<exists>t\<in> A. x = s \<^sub>f+ t}"

definition
  aug_pm_set :: "['a, 'a \<Rightarrow> 'a, 'a set] \<Rightarrow> 'a set" where
  "aug_pm_set z i A = {z} \<union> A \<union> (minus_set i A)"

definition
  addition_set :: "['a \<Rightarrow> 'a \<Rightarrow> 'a, 'a set] \<Rightarrow> 'a set" where
  "addition_set f A = \<Union>{add_set f A n | n. (0::nat)\<le> n}"

definition
  assoc_bpp :: "['a set, 'a \<Rightarrow> 'a \<Rightarrow> 'a] \<Rightarrow> bool" where
  "assoc_bpp A f \<longleftrightarrow>
    (\<forall>a\<in>(addition_set f A). \<forall>b\<in>(addition_set f A). \<forall>c\<in>(addition_set f A). (a \<^sub>f+ b) \<^sub>f+ c = a \<^sub>f+ (b \<^sub>f+ c))"

definition
  commute_bpp :: "['a \<Rightarrow> 'a \<Rightarrow> 'a, 'a set] \<Rightarrow> bool" where
  "commute_bpp f A \<longleftrightarrow> (\<forall>x\<in>addition_set f A. \<forall>y\<in>addition_set f A. x \<^sub>f+ y = y \<^sub>f+ x)"

definition
  zeroA :: "['a, 'a \<Rightarrow> 'a, 'a \<Rightarrow> 'a \<Rightarrow> 'a, 'a set] \<Rightarrow> 'a \<Rightarrow> bool" where
  "zeroA z i f A z1 \<longleftrightarrow> (\<forall>x \<in> addition_set f (aug_pm_set z i A). z1 \<^sub>f+ x = x)"

definition
  inv_ipp :: "['a, 'a \<Rightarrow> 'a, 'a \<Rightarrow> 'a \<Rightarrow> 'a, 'a set] \<Rightarrow> bool" where
  "inv_ipp z i f A \<longleftrightarrow> (\<forall>a\<in>addition_set f (aug_pm_set z i A). zeroA z i f A ((\<^sub>i- a) \<^sub>f+ a))"

definition
  ipp_cond1 :: "['a set, 'a \<Rightarrow> 'a] \<Rightarrow> bool" where
  "ipp_cond1 A i \<longleftrightarrow> (\<forall>x\<in>A. \<^sub>i- (\<^sub>i- x) = x)"

definition
  ipp_cond2 :: "['a, 'a set, 'a \<Rightarrow> 'a,  'a \<Rightarrow> 'a \<Rightarrow> 'a] \<Rightarrow> bool" where
  "ipp_cond2 z A i f == \<forall>x\<in>(addition_set f (aug_pm_set z i A)).
    \<forall>y\<in> (addition_set f (aug_pm_set z i A)). \<^sub>i-(x \<^sub>f+ y) = \<^sub>i- y \<^sub>f+ (\<^sub>i- x)"

definition
  ipp_cond3 :: "['a, 'a \<Rightarrow> 'a] \<Rightarrow> bool" where
  "ipp_cond3 z i \<longleftrightarrow> \<^sub>i- z = z"

lemma add_set_mono:"A \<subseteq> B \<Longrightarrow> add_set f A n \<subseteq> add_set f B n"
apply (induct_tac n)
 apply simp
apply (rule subsetI, simp)
 apply (erule bexE)+
 apply (frule_tac A = "add_set f A n" and B = "add_set f B n" and c = s in
        subsetD, assumption+)
 apply (frule_tac A = A and B = B and c = t in subsetD, assumption+)
 apply blast
done

lemma addition_inc_add:"add_set f A n \<subseteq> addition_set f A"
apply (rule subsetI)
 apply (simp add:addition_set_def)
 apply blast
done

lemma addition_inc_add0:" A \<subseteq> addition_set f A"
apply (rule subsetI)
apply (insert addition_inc_add [of "f" "A" "0"])
 apply simp
 apply (simp add:subsetD)
done

lemma addition_set_mono:"A \<subseteq> B \<Longrightarrow> addition_set f A \<subseteq> addition_set f B"
apply (rule subsetI)
apply (simp add:addition_set_def [of "f" "A"])
 apply (erule exE, erule conjE, erule exE, simp)
 apply (frule_tac n = n in add_set_mono [of "A" "B" "f"],
        frule_tac A = "add_set f A n" and B = "add_set f B n" and c = x in
        subsetD, assumption+)
 apply (cut_tac n = n in addition_inc_add[of f B])
 apply (simp add:subsetD)
done

lemma a_in_aug_pm_set:"a \<in> A \<Longrightarrow> a \<in> aug_pm_set z i A"
apply (simp add:aug_pm_set_def)
done

lemma A_sub_aug_pm_set:"A \<subseteq> aug_pm_set z i A"
by (rule subsetI, simp add:aug_pm_set_def)

lemma addition_sub_aug_pm_addition:"
        addition_set f A \<subseteq> addition_set f (aug_pm_set z i A)"
apply (cut_tac A_sub_aug_pm_set[of A z i])
apply (simp add:addition_set_mono)
done

lemma assoc_bpp_restrict:"\<lbrakk> A \<subseteq> B; assoc_bpp B f\<rbrakk> \<Longrightarrow> assoc_bpp A f"
apply (simp add:assoc_bpp_def)
 apply (rule ballI)+
 apply (frule addition_set_mono[of A B f])
 apply blast
done

lemma addition_assoc:"\<lbrakk>assoc_bpp A f; x \<in> addition_set f A;
                       y \<in> addition_set f A; z \<in> addition_set f A\<rbrakk> \<Longrightarrow>
            (x \<^sub>f+ y) \<^sub>f+ z = x \<^sub>f+ (y \<^sub>f+ z)"
apply (simp add:assoc_bpp_def)
done

lemma bpp_closedTr:"assoc_bpp A f \<Longrightarrow>
      \<forall>x y. x \<in> add_set f A n \<and> y \<in> add_set f A m \<longrightarrow>
                  x \<^sub>f+ y \<in> add_set f A (n + m + Suc 0)"
apply (induct_tac m, simp, blast)
 apply ((rule allI)+, rule impI, erule conjE)
 apply (simp, (erule bexE)+)
 apply (cut_tac addition_inc_add[of f A n],
        cut_tac n = na in addition_inc_add[of f A],
        cut_tac addition_inc_add0[of A f])
 apply (drule_tac x = x in spec,
        drule_tac a = s in forall_spec, simp)

 apply ((erule bexE)+, simp)
 apply (cut_tac n = "n + na" in addition_inc_add[of f A],
        frule_tac c = sa and A = "add_set f A (n + na)" in subsetD[of _
         "addition_set f A"], assumption+,
        frule_tac c = x in subsetD[of "add_set f A n" "addition_set f A"],
         assumption+,
        frule_tac c = s and A = "add_set f A na" in
            subsetD[of _ "addition_set f A"], assumption+,
        frule_tac c = t in subsetD[of A "addition_set f A"], assumption+,
        frule_tac c = ta in subsetD[of A "addition_set f A"], assumption+)
apply (frule_tac x1 = x and y1 = s and z1 = t in addition_assoc[THEN sym,
                 of A f],  assumption+) apply simp apply blast
done

lemma bpp_closed1:"\<lbrakk>assoc_bpp A f; x \<in> add_set f A n; y \<in> add_set f A m\<rbrakk> \<Longrightarrow>
                    x \<^sub>f+ y \<in> add_set f A (n + m + Suc 0)"
apply (insert bpp_closedTr[of "A" "f"])
apply blast
done
lemma bpp_closed:"\<lbrakk>assoc_bpp A f; x \<in> addition_set f A; y \<in> addition_set f A\<rbrakk>
             \<Longrightarrow>  x \<^sub>f+ y \<in> addition_set f A"
apply (simp add:addition_set_def)
 apply ((erule exE)+, (erule conjE)+, (erule exE)+, simp)
 apply (frule_tac x = x and n = n and y = y and m = na in bpp_closed1,
        assumption+)
 apply blast
done

lemma aug_addition_inc_z:" z \<in> addition_set f (aug_pm_set z i A)"
apply (subgoal_tac "z \<in> aug_pm_set z i A")
apply (subgoal_tac "aug_pm_set z i A \<subseteq> addition_set f (aug_pm_set z i A)")
 apply (simp add:subsetD)
 apply (simp add:addition_inc_add0)
 apply (simp add:aug_pm_set_def)
done

lemma aug_bpp_closed:"\<lbrakk>assoc_bpp (aug_pm_set z i A) f;
      x \<in> addition_set f (aug_pm_set z i A);
      y \<in> addition_set f (aug_pm_set z i A)\<rbrakk> \<Longrightarrow>
                  x \<^sub>f+ y \<in> addition_set f (aug_pm_set z i A)"
apply (simp add:bpp_closed [of "aug_pm_set z i A" "f"])
done

lemma aug_commute:"\<lbrakk>commute_bpp f (aug_pm_set z i A);
     x \<in> addition_set f (aug_pm_set z i A);
     y \<in> addition_set f (aug_pm_set z i A)\<rbrakk> \<Longrightarrow> x \<^sub>f+ y = y \<^sub>f+ x"
apply (simp add: commute_bpp_def)
done

lemma addition_set_inc_z:"z \<in> addition_set f (aug_pm_set z i A)"
apply (simp add:addition_set_def)
apply (subgoal_tac "z \<in> add_set f (aug_pm_set z i A) 0")
apply blast
apply (simp add:aug_pm_set_def)
done

lemma  aug_ipp_closed0:"\<lbrakk>commute_bpp f (aug_pm_set z i A);
       assoc_bpp (aug_pm_set z i A) f; ipp_cond1 A i; ipp_cond2 z A i f;
       ipp_cond3 z i; x \<in> add_set f (aug_pm_set z i A) 0\<rbrakk> \<Longrightarrow>
         \<^sub>i- x \<in> add_set f (aug_pm_set z i A) 0"
 apply (simp add:aug_pm_set_def)
 apply (case_tac "x \<in> A", simp add:minus_set_def, blast)
 apply simp
 apply (simp add:minus_set_def)
 apply (case_tac "x = z", simp, simp add:ipp_cond3_def)
 apply simp
 apply (erule bexE)
 apply (simp add:ipp_cond1_def)
done

lemma aug_ipp_closedTr:"\<lbrakk>commute_bpp f (aug_pm_set z i A);
      assoc_bpp (aug_pm_set z i A) f; ipp_cond1 A i; ipp_cond2 z A i f;
      ipp_cond3 z i\<rbrakk> \<Longrightarrow>
      \<forall>x. x \<in> add_set f (aug_pm_set z i A) n \<longrightarrow>
                             \<^sub>i- x \<in> add_set f (aug_pm_set z i A) n"
apply (induct_tac n, rule allI, rule impI)
 apply (simp add:aug_pm_set_def)
 apply (case_tac "x = z", simp add:ipp_cond3_def)
 apply simp
 apply (case_tac "x \<in> A", simp add:minus_set_def, blast)
 apply simp
 apply (simp add:minus_set_def)
 apply (erule bexE, simp add:ipp_cond1_def)
apply (rule allI, rule impI, simp)
 apply (erule bexE)+
 apply (drule_tac a = s in forall_spec, assumption)
 apply (cut_tac ipp_cond2_def[of z A i f], simp)
 apply (cut_tac n = n in addition_inc_add[of f "aug_pm_set z i A"],
        frule_tac c = s and A = "add_set f (aug_pm_set z i A) n" in
        subsetD[of _ "addition_set f (aug_pm_set z i A)"], assumption+,
        cut_tac addition_inc_add0[of "aug_pm_set z i A" f],
        frule_tac c = t in subsetD[of "aug_pm_set z i A"
         "addition_set f (aug_pm_set z i A)"], assumption+)
 apply (drule_tac x = s in bspec, assumption,
        drule_tac x = t in bspec, assumption)

 apply (frule_tac x = t in aug_ipp_closed0[of f z i A], assumption+,
        simp, assumption+, simp, simp,
        frule_tac c = "\<^sub>i- t" in subsetD[of "aug_pm_set z i A"
                        "addition_set f (aug_pm_set z i A)"], assumption+)
 apply (frule_tac c = "\<^sub>i- s" and A = "add_set f (aug_pm_set z i A) n" in
        subsetD[of _ "addition_set f (aug_pm_set z i A)"], assumption+,
        frule_tac x = "\<^sub>i- t" and y = "\<^sub>i- s" in aug_commute[of f z i A],
                         assumption+, simp)
 apply blast
done

lemma aug_ipp_closedTr2:"\<lbrakk>commute_bpp f (aug_pm_set z i A);
      assoc_bpp (aug_pm_set z i A) f; ipp_cond1 A i; ipp_cond2 z A i f;
      ipp_cond3 z i; x \<in> add_set f (aug_pm_set z i A) n\<rbrakk> \<Longrightarrow>
         \<^sub>i- x \<in> add_set f (aug_pm_set z i A) n"
apply (simp add:aug_ipp_closedTr)
done

lemma aug_ipp_closed:"\<lbrakk>commute_bpp f (aug_pm_set z i A);
      assoc_bpp (aug_pm_set z i A) f; ipp_cond1 A i; ipp_cond2 z A i f;
      ipp_cond3 z i; x \<in> addition_set f (aug_pm_set z i A)\<rbrakk> \<Longrightarrow>
      \<^sub>i- x \<in> addition_set f (aug_pm_set z i A)"
apply (simp add:addition_set_def, erule exE, erule conjE, erule exE, simp)
 apply (frule_tac n = n in aug_ipp_closedTr2[of f z i A x], assumption+)
 apply blast
done

lemma aug_zero_unique:"\<lbrakk>commute_bpp f (aug_pm_set z i A);
      z1 \<in> addition_set f (aug_pm_set z i A); zeroA z i f A z;
      zeroA z i f A z1\<rbrakk> \<Longrightarrow> z = z1"
apply (simp add:zeroA_def[of "z" _ _ _ "z"])
apply (drule_tac x = z1 in bspec, assumption)

apply (cut_tac addition_set_inc_z [of z f i A])
apply (frule aug_commute [of f z i A z z1], assumption+)
apply simp
apply (simp add:zeroA_def[of _ _ _ _ "z1"])
done

lemma inv_aug_addition:"\<lbrakk>commute_bpp f (aug_pm_set z i A);
      assoc_bpp (aug_pm_set z i A) f; ipp_cond1 A i; ipp_cond2 z A i f;
      ipp_cond3 z i; inv_ipp z i f A; commute_bpp f (aug_pm_set z i A);
      zeroA z i f A z\<rbrakk> \<Longrightarrow>
     \<forall>a\<in>addition_set f (aug_pm_set z i A). (\<^sub>i-a) \<^sub>f+ a = z"
apply (simp add:inv_ipp_def)
apply (rule ballI)
apply (drule_tac x = a in bspec, assumption)
 apply (frule_tac ?z1.0 = "(\<^sub>i- a \<^sub>f+ a)" in aug_zero_unique [of f z i A])
 apply (frule_tac x = a in aug_ipp_closed [of f z i A], assumption+)
 apply (rule_tac x = "\<^sub>i- a" and y = a in aug_bpp_closed [of z i A f],
                                       assumption+)
 apply (simp add:zeroA_def)
done

definition
  fag_gen_by :: "['a set, 'a \<Rightarrow> 'a \<Rightarrow> 'a, 'a \<Rightarrow> 'a, 'a] \<Rightarrow> 'a aGroup" where
  "fag_gen_by A f i z = \<lparr>carrier = addition_set f (aug_pm_set z i A),
  pop = \<lambda>x\<in>(addition_set f (aug_pm_set z i A)).
          \<lambda>y\<in>(addition_set f (aug_pm_set z i A)). x \<^sub>f+ y,
  mop = \<lambda>x\<in>(addition_set f (aug_pm_set z i A)). \<^sub>i- x, zero = z\<rparr>"

lemma fag_gen_carrier:"\<lbrakk>commute_bpp f (aug_pm_set z i A);
      assoc_bpp (aug_pm_set z i A) f; ipp_cond1 A i; ipp_cond2 z A i f;
      ipp_cond3 z i; inv_ipp z i f A; commute_bpp f (aug_pm_set z i A);
      zeroA z i f A z\<rbrakk> \<Longrightarrow>
      carrier (fag_gen_by A f i z) = addition_set f (aug_pm_set z i A)"
by (simp add:fag_gen_by_def)

lemma addition_set_sub_fag_gen_carrier:"\<lbrakk>commute_bpp f (aug_pm_set z i A);
      assoc_bpp (aug_pm_set z i A) f; ipp_cond1 A i; ipp_cond2 z A i f;
      ipp_cond3 z i; inv_ipp z i f A; commute_bpp f (aug_pm_set z i A);
      zeroA z i f A z\<rbrakk> \<Longrightarrow> addition_set f A \<subseteq> carrier (fag_gen_by A f i z)"
apply (simp add:fag_gen_carrier)
apply (simp add:addition_sub_aug_pm_addition)
done

lemma fag_aGroup:"\<lbrakk>commute_bpp f (aug_pm_set z i A);
      assoc_bpp (aug_pm_set z i A) f; ipp_cond1 A i; ipp_cond2 z A i f;
      ipp_cond3 z i; inv_ipp z i f A; commute_bpp f (aug_pm_set z i A);
      zeroA z i f A z\<rbrakk> \<Longrightarrow> aGroup (fag_gen_by A f i z)"
apply (rule aGroup.intro)
 apply (simp add:fag_gen_by_def aug_bpp_closed)

apply (simp add:fag_gen_by_def)
 apply (simp add:aug_bpp_closed)
 apply (simp add:assoc_bpp_def)

 apply (simp add:fag_gen_by_def)
 apply (simp add:aug_commute)

 apply (simp add:fag_gen_by_def aug_ipp_closed)

 apply (simp add:fag_gen_by_def inv_aug_addition aug_ipp_closed)

 apply (simp add:fag_gen_by_def  addition_set_inc_z)

 apply (simp add:fag_gen_by_def addition_set_inc_z zeroA_def)
done

section "Abelian group generated by a singleton (constructive)"

definition
  fag_single :: "['a, 'a \<Rightarrow> 'a \<Rightarrow> 'a, 'a \<Rightarrow> 'a, 'a] \<Rightarrow> 'a aGroup" where
  "fag_single a f i z = fag_gen_by {a} f i z"

lemma aug_pm_aug_pm_minus:"ipp_cond1 {a} i \<Longrightarrow>
                      aug_pm_set z i {a} = aug_pm_set z i {\<^sub>i- a}"
apply (simp add:aug_pm_set_def minus_set_def)
 apply (simp add:ipp_cond1_def)
 apply (rule equalityI, rule subsetI, simp, blast)
 apply (rule subsetI, simp, blast)
done

lemma ipp_cond1_minus:"ipp_cond1 {a} i \<Longrightarrow> ipp_cond1 {\<^sub>i- a} i"
by (simp add:ipp_cond1_def)

lemma ipp_cond2_minus:"\<lbrakk>ipp_cond1 {a} i; ipp_cond2 z {a} i f\<rbrakk> \<Longrightarrow>
                                             ipp_cond2 z {\<^sub>i- a} i f"
by (simp add:ipp_cond2_def, simp add:aug_pm_aug_pm_minus)

lemma zeroA_minus:"\<lbrakk>ipp_cond1 {a} i; zeroA z i f {a} z1\<rbrakk> \<Longrightarrow>
                   zeroA z i f {\<^sub>i- a} z1"
apply (simp add:zeroA_def)
apply (simp add:aug_pm_aug_pm_minus)
done

lemma inv_ipp_minus:"\<lbrakk>ipp_cond1 {a} i; inv_ipp z i f {a}\<rbrakk> \<Longrightarrow>
      inv_ipp z i f {\<^sub>i- a}"
 apply (simp add:inv_ipp_def [of _ _ _ "{a}"])
 apply (simp add:aug_pm_aug_pm_minus)
apply (simp add:inv_ipp_def)
apply (simp add:zeroA_minus)
done

lemma fag_single_additionTr1:"\<lbrakk>commute_bpp f (aug_pm_set z i {a});
      assoc_bpp (aug_pm_set z i {a}) f; ipp_cond1 {a} i; ipp_cond2 z {a} i f;
      ipp_cond3 z i; inv_ipp z i f {a}; commute_bpp f (aug_pm_set z i {a});
      zeroA z i f {a} z\<rbrakk> \<Longrightarrow>
 \<forall>s. s\<in> add_set f {a} (Suc n) \<longrightarrow> s \<^sub>f+ \<^sub>i- a \<in> add_set f {a} n"
apply (cut_tac addition_inc_add0[of "aug_pm_set z i {a}" f])
 apply (cut_tac a_in_aug_pm_set[of a "{a}" z i], simp)
 apply (frule subsetD[of "aug_pm_set z i {a}"
         "addition_set f (aug_pm_set z i {a})" "a"], assumption+)
apply (induct_tac n)
 apply (rule allI, rule impI, simp)
 apply (frule aug_ipp_closed [of f z i "{a}" a], assumption+)
 apply (simp add:addition_assoc)
 apply (frule aug_commute [of f z i "{a}" a "\<^sub>i- a"], assumption+)
 apply simp apply (thin_tac "a \<^sub>f+ \<^sub>i- a = \<^sub>i- a \<^sub>f+ a")
 apply (simp add:inv_aug_addition)
 apply (cut_tac addition_set_inc_z[of z f i "{a}"])
 apply (frule aug_commute [of "f" "z" "i" "{a}" "a" "z"], assumption+)
 apply simp apply (thin_tac "a \<^sub>f+ z = z \<^sub>f+ a")
 apply (simp add:zeroA_def)

apply (rule allI) apply (rule impI)
 apply (erule bexE)
 apply (thin_tac "\<forall>s. (\<exists>sa\<in>add_set f {a} n. s = sa \<^sub>f+ a) \<longrightarrow>
            s \<^sub>f+ \<^sub>i- a \<in> add_set f {a} n")
 apply (simp del:add_set_Suc)
 apply (frule fag_aGroup[of f z i "{a}"], assumption+)
 apply (cut_tac n = "Suc n" in addition_inc_add[of f "{a}"],
              cut_tac addition_sub_aug_pm_addition[of f "{a}" z i],
        frule_tac c = sa and A = "add_set f {a} (Suc n)" in subsetD[of _
          "addition_set f {a}"], assumption+,
        frule_tac c = sa in subsetD[of "addition_set f {a}"
                    "addition_set f (aug_pm_set z i {a})"], assumption+)
 apply (cut_tac x = sa and y = a and z = " \<^sub>i- a" in
              aGroup.ag_pOp_assoc[of "fag_gen_by {a} f i z"], assumption,
        simp del:add_set_Suc add:fag_gen_carrier)
 apply (simp add:fag_gen_carrier,
        cut_tac addition_inc_add0[of "aug_pm_set z i {a}"],
        simp add:subsetD)
 apply (subst fag_gen_carrier, assumption+)
        apply (rule aug_ipp_closed[of f z i "{a}" a], assumption+)
        apply (simp add:subsetD)
apply (simp del:add_set_Suc add:fag_gen_by_def, fold fag_gen_by_def,
       frule aug_ipp_closed[of f z i "{a}" a], assumption+,
       simp del:add_set_Suc add:aug_bpp_closed,
       simp del:add_set_Suc add:aug_commute[of f z i "{a}" a "\<^sub>i- a"],
       thin_tac "sa \<^sub>f+ a \<^sub>f+ \<^sub>i- a = sa \<^sub>f+ (\<^sub>i- a \<^sub>f+ a)",
       simp del:add_set_Suc add:inv_aug_addition,
       cut_tac addition_set_inc_z[of z f i "{a}"])
 apply (subst aug_commute[of f z i "{a}" _ z], assumption+)
 apply (simp del:add_set_Suc add:zeroA_def[of z i f "{a}" z])

 apply simp
done

lemma fag_single_additionTr2:"\<lbrakk>commute_bpp f (aug_pm_set z i {a});
      assoc_bpp (aug_pm_set z i {a}) f; ipp_cond1 {a} i; ipp_cond2 z {a} i f;
      ipp_cond3 z i; inv_ipp z i f {a}; commute_bpp f (aug_pm_set z i {a});
      zeroA z i f {a} z; s \<in> add_set f {a} 0\<rbrakk> \<Longrightarrow> s \<^sub>f+ \<^sub>i- a = z"
 apply simp
 apply (cut_tac a_in_aug_pm_set[of a "{a}" z i],
        cut_tac addition_inc_add0[of "aug_pm_set z i {a}" f],
        frule subsetD[of "aug_pm_set z i {a}"
                      "addition_set f (aug_pm_set z i {a})" a], assumption+)
 apply (frule aug_ipp_closed [of "f" "z" "i" "{a}" "a"], assumption+)
  apply (frule aug_commute [of "f" "z" "i" "{a}" "a" "\<^sub>i- a"], assumption+)
  apply simp apply (thin_tac "a \<^sub>f+ \<^sub>i- a = \<^sub>i- a \<^sub>f+ a")
  apply (simp add:inv_aug_addition)
 apply simp
done

lemma ipp_conditions:"\<lbrakk>assoc_bpp (aug_pm_set z i {a}) f; ipp_cond1 {a} i;
        ipp_cond2 z {a} i f; ipp_cond3 z i; inv_ipp z i f {a};
        commute_bpp f (aug_pm_set z i {a}); zeroA z i f {a} z\<rbrakk> \<Longrightarrow>
        assoc_bpp (aug_pm_set z i { \<^sub>i- a}) f \<and> ipp_cond1 { \<^sub>i- a} i \<and>
        ipp_cond2 z { \<^sub>i- a} i f \<and> inv_ipp z i f { \<^sub>i- a} \<and>
        commute_bpp f (aug_pm_set z i { \<^sub>i- a}) \<and> zeroA z i f { \<^sub>i- a} z"
apply (simp add:aug_pm_aug_pm_minus[THEN sym])
apply (rule conjI)
 apply (subst ipp_cond1_def, rule ballI, simp, simp add:ipp_cond1_def)

apply (rule conjI)
 apply (subst ipp_cond2_def,
        simp add:aug_pm_aug_pm_minus[THEN sym] ipp_cond2_def)

apply (simp add:zeroA_def inv_ipp_def,
       simp add:aug_pm_aug_pm_minus)
done

lemma fag_single_additionTr3:"\<lbrakk>commute_bpp f (aug_pm_set z i {a});
      assoc_bpp (aug_pm_set z i {a}) f; ipp_cond1 {a} i; ipp_cond2 z {a} i f;
      ipp_cond3 z i; inv_ipp z i f {a}; commute_bpp f (aug_pm_set z i {a});
      zeroA z i f {a} z; s\<in> add_set f {\<^sub>i- a} n\<rbrakk> \<Longrightarrow>
          s \<^sub>f+ \<^sub>i- a \<in> add_set f {\<^sub>i- a} (Suc n)"
apply simp apply blast
done

lemma fag_single_elemTr:"\<lbrakk>commute_bpp f (aug_pm_set z i {a});
      assoc_bpp (aug_pm_set z i {a}) f; ipp_cond1 {a} i; ipp_cond2 z {a} i f;
      ipp_cond3 z i; inv_ipp z i f {a}; commute_bpp f (aug_pm_set z i {a});
      zeroA z i f {a} z\<rbrakk> \<Longrightarrow>
     \<forall>x. x \<in> add_set f (aug_pm_set z i {a}) n \<longrightarrow>
     (\<exists>n1. x \<in> add_set f {a} n1) \<or> (\<exists>m1. x \<in> add_set f {\<^sub>i- a} m1) \<or> x = z"
 apply (cut_tac a_in_aug_pm_set[of a "{a}" z i],
        cut_tac addition_inc_add0[of "aug_pm_set z i {a}" f],
        frule subsetD[of "aug_pm_set z i {a}"
                      "addition_set f (aug_pm_set z i {a})" a], assumption+)
 apply (cut_tac addition_set_inc_z[of z f i "{a}"])
 prefer 2 apply simp
 apply (cut_tac assoc_bpp_restrict[of "{a}" "aug_pm_set z i {a}" f])
apply (induct_tac n)
 apply (rule allI, rule impI, simp add:aug_pm_set_def)
 apply (erule disjE, simp)
  apply (subgoal_tac "a \<in> add_set f {a} 0", blast)
  apply simp
  apply (erule disjE, simp)
  apply (simp add:minus_set_def)
  apply (subgoal_tac " \<^sub>i- a \<in> add_set f {\<^sub>i- a} 0", blast, simp)
apply (rule allI, rule impI)
 apply (simp, (erule bexE)+)
 apply (drule_tac a = s in forall_spec, assumption)
 apply (subgoal_tac "t = a \<or> t = z \<or> t = \<^sub>i- a")
 prefer 2 apply (simp add:aug_pm_set_def minus_set_def, blast)
 apply (erule disjE, erule exE)
 apply (case_tac "n1 = 0", simp)
  apply (case_tac "t = a", simp)
  apply (cut_tac A_sub_aug_pm_set[of "{a}" z i])
  apply (cut_tac addition_inc_add0[of "{a}"f])
  apply (frule bpp_closed1[of "{a}" f a 0 a 0],
          simp, simp, blast)
  apply simp
  apply (case_tac "t = z", simp)
  apply (simp add:aug_commute[of f z i "{a}" a z])
  apply (simp add:zeroA_def,
         subgoal_tac "a \<in> add_set f {a} 0", blast, simp)

  apply simp
  apply (simp add:fag_single_additionTr2[of f z i a a])

  apply simp
  apply (case_tac "t = a", simp,
         frule_tac x = s and n = n1 and y = a in bpp_closed1[of "{a}" f
              _ _ _ 0], assumption, simp, blast)

 apply (case_tac "t = z", simp)
   apply (cut_tac n = n in addition_inc_add[of f "aug_pm_set z i {a}"],
          frule_tac c = s and A = "add_set f (aug_pm_set z i {a}) n" in
          subsetD[of _ "addition_set f (aug_pm_set z i {a})"], assumption+)
   apply (simp add:aug_commute[of f z i "{a}" _ z])
  apply (simp add:zeroA_def, blast)

 apply simp
 apply (frule_tac n = "n1 - Suc 0" in fag_single_additionTr1[of f z i a],
        assumption+, simp)
 apply (drule_tac a = s in forall_spec, assumption, blast)

 apply (rotate_tac -1, erule disjE)
 apply (erule exE)

 apply (frule ipp_conditions[of z i a f], assumption+, (erule conjE)+)

 apply (case_tac "m1 = 0", simp)
  apply (case_tac "t = a", simp)
  apply (cut_tac aug_pm_aug_pm_minus[of a i z])
  apply (cut_tac addition_inc_add0[of "{\<^sub>i- a}" f])
  apply (cut_tac A = "{\<^sub>i- a}" and B = "aug_pm_set z i {a}" in
          addition_set_mono[of _ _ f], simp add:aug_pm_set_def)
  apply (frule subsetD[of "{\<^sub>i- a}" "addition_set f {\<^sub>i- a}" "\<^sub>i- a"], simp,
         frule subsetD[of "addition_set f {\<^sub>i- a}"
              "addition_set f (aug_pm_set z i {a})"], assumption+)
  apply (frule inv_aug_addition[of f z i "{a}"], assumption+)
  apply (drule_tac x = a in bspec, assumption,
         simp, assumption+)

  apply (case_tac "t = z", simp,
         cut_tac n = n in addition_inc_add[of f "aug_pm_set z i {a}"],
         frule_tac c = "\<^sub>i- a" and A = "add_set f (aug_pm_set z i {a}) n" in
         subsetD[of _ "addition_set f (aug_pm_set z i {a})"], assumption+)
  apply (simp add:aug_commute)
  apply (simp add:zeroA_def)
  apply (subgoal_tac " \<^sub>i- a \<in> add_set f {\<^sub>i- a} 0", blast, simp)

  apply simp
  apply (cut_tac assoc_bpp_restrict[of "{\<^sub>i- a}" "aug_pm_set z i {a}"],
         frule bpp_closed1[of "{\<^sub>i- a}" f "\<^sub>i- a" 0 "\<^sub>i- a" 0], simp, simp, blast)
  apply (simp add:aug_pm_set_def, assumption+)

  apply simp
  apply (case_tac "t = a", simp)
  apply (frule_tac n = "m1 - Suc 0" in fag_single_additionTr1[of f z i "\<^sub>i- a"],
         assumption+, simp)
  apply (thin_tac "s \<in> add_set f (aug_pm_set z i {a}) n",
         drule_tac a = s in forall_spec, assumption,
         simp add:ipp_cond1_def, blast)

  apply (case_tac "t = z", simp,
         cut_tac n = n in addition_inc_add[of f "aug_pm_set z i {a}"],
         frule_tac c = s and A = "add_set f (aug_pm_set z i {a}) n" in
              subsetD[of _ "addition_set f (aug_pm_set z i {a})"], assumption+)
  apply (frule_tac x = s and y = z in aug_commute[of f z i "{a}"], assumption+,
          simp)
  apply (simp add:zeroA_def, blast)

  apply simp
  apply (cut_tac assoc_bpp_restrict[of "{\<^sub>i- a}" "aug_pm_set z i {\<^sub>i- a}" f],
         frule_tac x = s and n = m1 and y = "\<^sub>i- a" in
          bpp_closed1[of "{\<^sub>i- a}" f  _ _ _ 0], assumption, simp, blast,
          simp add:aug_pm_set_def, assumption)

  apply simp
  apply (case_tac "t = a", simp)
  apply (simp add:zeroA_def)
  apply (subgoal_tac "a \<in> add_set f {a} 0", blast, simp)

 apply (case_tac "t = z", simp, simp add:zeroA_def)

 apply simp
 apply (frule subsetD[of "aug_pm_set z i {a}"
        "addition_set f (aug_pm_set z i {a})" " \<^sub>i- a"], assumption+,
        simp add:zeroA_def,
        subgoal_tac " \<^sub>i- a \<in> add_set f {\<^sub>i- a} 0", blast, simp)

 apply (simp add:aug_pm_set_def)
 apply assumption
done

lemma fag_single_elem:"\<lbrakk>commute_bpp f (aug_pm_set z i {a});
      assoc_bpp (aug_pm_set z i {a}) f; ipp_cond1 {a} i; ipp_cond2 z {a} i f;
      ipp_cond3 z i; inv_ipp z i f {a}; commute_bpp f (aug_pm_set z i {a});
      zeroA z i f {a} z; x \<in> addition_set f (aug_pm_set z i {a})\<rbrakk> \<Longrightarrow>
    (\<exists>n1. x \<in> add_set f {a} n1) \<or> (\<exists>m1. x \<in> add_set f {\<^sub>i- a} m1) \<or> x = z"
apply (simp add:addition_set_def)
apply (erule exE, erule conjE, erule exE, simp)
apply (simp add:fag_single_elemTr)
done

lemma add_set_single1Tr:"\<lbrakk>commute_bpp f (aug_pm_set z i {a});
      assoc_bpp (aug_pm_set z i {a}) f; ipp_cond1 {a} i; ipp_cond2 z {a} i f;
      ipp_cond3 z i; inv_ipp z i f {a}; commute_bpp f (aug_pm_set z i {a});
      zeroA z i f {a} z\<rbrakk> \<Longrightarrow>
      \<forall>x y. x \<in> add_set f {a} n \<and> y \<in> add_set f {a} n \<longrightarrow> x = y"
apply (induct_tac n)
 apply ((rule allI)+, rule impI, erule conjE)
 apply simp
apply ((rule allI)+, rule impI, erule conjE, simp, (erule bexE)+)
 apply (drule_tac x = s in spec,
        drule_tac a = sa in forall_spec, simp)

apply simp
done

lemma add_set_single_nonempty1:"\<lbrakk>commute_bpp f (aug_pm_set z i {a});
      assoc_bpp (aug_pm_set z i {a}) f; ipp_cond1 {a} i; ipp_cond2 z {a} i f;
      ipp_cond3 z i; inv_ipp z i f {a}; commute_bpp f (aug_pm_set z i {a});
      zeroA z i f {a} z\<rbrakk> \<Longrightarrow>  \<exists>x. x\<in>add_set f {a} n"
apply (induct_tac n)
 apply simp
 apply (erule exE)
 apply simp apply blast
done

lemma add_set_single_nonempty2:"\<lbrakk>commute_bpp f (aug_pm_set z i {a});
      assoc_bpp (aug_pm_set z i {a}) f; ipp_cond1 {a} i; ipp_cond2 z {a} i f;
      ipp_cond3 z i; inv_ipp z i f {a}; commute_bpp f (aug_pm_set z i {a});
      zeroA z i f {a} z\<rbrakk> \<Longrightarrow>  \<exists>x. x\<in>add_set f {\<^sub>i- a} n"
apply (simp add:aug_pm_aug_pm_minus,
       frule ipp_cond1_minus[of "a" "i"],
       frule ipp_cond2_minus[of "a" "i" "z" "f"], assumption+,
       frule inv_ipp_minus[of "a" "i" "z" "f"], assumption+,
       frule zeroA_minus[of "a" "i" "z" "f" "z"], assumption+)
apply (simp add:add_set_single_nonempty1 [of "f" "z" "i" "\<^sub>i- a" "n"])
done

lemma add_set_single1:"\<lbrakk>commute_bpp f (aug_pm_set z i {a});
      assoc_bpp (aug_pm_set z i {a}) f; ipp_cond1 {a} i; ipp_cond2 z {a} i f;
      ipp_cond3 z i; inv_ipp z i f {a}; commute_bpp f (aug_pm_set z i {a});
      zeroA z i f {a} z; x \<in> add_set f {a} n; y \<in> add_set f {a} n\<rbrakk> \<Longrightarrow> x = y"
apply (frule add_set_single1Tr [of f z i a n], assumption+)
apply blast
done

lemma add_set_single2:"\<lbrakk>commute_bpp f (aug_pm_set z i {a});
      assoc_bpp (aug_pm_set z i {a}) f; ipp_cond1 {a} i; ipp_cond2 z {a} i f;
      ipp_cond3 z i; inv_ipp z i f {a}; commute_bpp f (aug_pm_set z i {a});
      zeroA z i f {a} z; x \<in> add_set f {\<^sub>i- a} n; y \<in> add_set f {\<^sub>i- a} n\<rbrakk> \<Longrightarrow>
      x = y"
apply (simp add:aug_pm_aug_pm_minus)
apply (frule ipp_cond1_minus[of "a" "i"])
apply (frule ipp_cond2_minus[of "a" "i" "z" "f"], assumption+)
apply (frule inv_ipp_minus[of "a" "i" "z" "f"], assumption+)
apply (frule zeroA_minus[of "a" "i" "z" "f" "z"], assumption+)
apply (rule add_set_single1 [of "f" "z" "i" "\<^sub>i- a" _ "n" _], assumption+)
done

lemma fag_single_additionTr4:"\<lbrakk>commute_bpp f (aug_pm_set z i {a});
      assoc_bpp (aug_pm_set z i {a}) f; ipp_cond1 {a} i; ipp_cond2 z {a} i f;
      ipp_cond3 z i; inv_ipp z i f {a}; commute_bpp f (aug_pm_set z i {a});
      zeroA z i f {a} z \<rbrakk> \<Longrightarrow>
      \<forall>s t. s \<in> add_set f {a} n \<and> t \<in> add_set f {\<^sub>i- a} n\<longrightarrow> s \<^sub>f+ t = z"
 apply (cut_tac a_in_aug_pm_set[of a "{a}" z i], simp,
        cut_tac addition_inc_add0[of "aug_pm_set z i {a}" f],
        frule subsetD[of "aug_pm_set z i {a}"
                     "addition_set f (aug_pm_set z i {a})" a], assumption+)

apply (induct_tac n)
 apply simp
 apply (frule inv_aug_addition [of "f" "z" "i" "{a}"], assumption+)
 apply (frule aug_ipp_closed [of "f" "z" "i" "{a}" "a"], assumption+)
 apply (frule fag_single_additionTr2 [of "f" "z" "i" "a" "a"], assumption+)
 apply (simp, assumption)
apply ((rule allI)+, rule impI, erule conjE)
 apply simp
 apply (erule bexE)+
 apply (frule aug_ipp_closed [of "f" "z" "i" "{a}" "a"], assumption+)
 apply simp
 apply (drule_tac x = sa in spec,
        drule_tac a = sb in forall_spec, simp)
 apply (cut_tac n = n in addition_inc_add[of f "{a}"],
        cut_tac addition_set_mono[of "{a}" "aug_pm_set z i {a}" f],
        frule_tac c = sa and A = "add_set f {a} n" in subsetD[of _
          "addition_set f {a}"], assumption+,
        frule_tac c = sa in subsetD[of "addition_set f {a}"
               "addition_set f (aug_pm_set z i {a})"], assumption+)
 apply (cut_tac n = n in addition_inc_add[of f "{\<^sub>i- a}"],
        cut_tac addition_set_mono[of "{\<^sub>i- a}" "aug_pm_set z i {\<^sub>i- a}" f],
        frule_tac c = sb and A = "add_set f {\<^sub>i- a} n" in subsetD[of _
          "addition_set f {\<^sub>i- a}"], assumption+,
        frule_tac c = sb in subsetD[of "addition_set f {\<^sub>i- a}"
               "addition_set f (aug_pm_set z i {\<^sub>i- a})"], assumption+)
  apply (simp add:aug_pm_aug_pm_minus[THEN sym])
  apply (frule_tac x = sb in aug_bpp_closed [of z i "{a}" f _ " \<^sub>i- a"],
         assumption+)
 apply (frule_tac x = sa and y = a and z = "sb \<^sub>f+ \<^sub>i- a" in
                 addition_assoc [of "aug_pm_set z i {a}" "f"], assumption+)
 apply simp apply (thin_tac "sa \<^sub>f+ a \<^sub>f+ (sb \<^sub>f+ \<^sub>i- a) = sa \<^sub>f+ (a \<^sub>f+ (sb \<^sub>f+ \<^sub>i- a))")
 apply (frule_tac x1 = a and y1 = sb and z1 = "\<^sub>i- a" in
        addition_assoc [THEN sym, of "aug_pm_set z i {a}" "f"], assumption+)
  apply simp
 apply (frule_tac y = sb in aug_commute [of "f" "z" "i" "{a}" "a"],
        assumption+, simp)
 apply (frule_tac x = sb and y = a and z = "\<^sub>i- a" in
                 addition_assoc [of "aug_pm_set z i {a}" "f"], assumption+)
 apply simp apply (thin_tac "a \<^sub>f+ (sb \<^sub>f+ \<^sub>i- a) = sb \<^sub>f+ (a \<^sub>f+ \<^sub>i- a)")
 apply (thin_tac "a \<^sub>f+ sb = sb \<^sub>f+ a",
        thin_tac "sb \<^sub>f+ a \<^sub>f+ \<^sub>i- a = sb \<^sub>f+ (a \<^sub>f+ \<^sub>i- a)",
        thin_tac "sb \<^sub>f+ \<^sub>i- a \<in> addition_set f (aug_pm_set z i {a})")
 apply (frule_tac y = " \<^sub>i- a" in aug_commute [of "f" "z" "i" "{a}" "a"],
            assumption+, simp)
 apply (frule_tac x = sa and y = a and z = "sb \<^sub>f+ \<^sub>i- a" in
                 addition_assoc [of "aug_pm_set z i {a}" "f"], assumption+)
 apply (frule_tac x = sb in aug_bpp_closed [of "z" "i" "{a}" "f" _ " \<^sub>i- a"],
  assumption+)
 apply (thin_tac "sa \<^sub>f+ a \<^sub>f+ (sb \<^sub>f+ \<^sub>i- a) = sa \<^sub>f+ (a \<^sub>f+ (sb \<^sub>f+ \<^sub>i- a))")
 apply (thin_tac "a \<^sub>f+ \<^sub>i- a = \<^sub>i- a \<^sub>f+ a")
 apply (frule inv_aug_addition [of "f" "z" "i" "{a}" ], assumption+)
 apply (drule_tac x = a in bspec, assumption, simp)

 apply (frule_tac x = sb and y = z in aug_commute [of "f" "z" "i" "{a}"],
             assumption+)
 apply (simp add:addition_set_inc_z)
apply (frule_tac x = sb and y = z in aug_commute [of "f" "z" "i" "{a}"],
       assumption+, simp add:addition_set_inc_z, simp)
 apply (simp add:zeroA_def)
 apply (rule subsetI, simp add:aug_pm_set_def minus_set_def)
 apply (simp add:aug_pm_set_def)
 apply simp
done

lemma fag_single_additionTr4_1:"\<lbrakk>commute_bpp f (aug_pm_set z i {a});
      assoc_bpp (aug_pm_set z i {a}) f; ipp_cond1 {a} i; ipp_cond2 z {a} i f;
      ipp_cond3 z i; inv_ipp z i f {a}; commute_bpp f (aug_pm_set z i {a});
      zeroA z i f {a} z;s \<in> add_set f {a} n; t \<in> add_set f {\<^sub>i- a} n \<rbrakk> \<Longrightarrow>
      s \<^sub>f+ t = z"
apply (frule fag_single_additionTr4[of "f" "z" "i" "a" "n"], assumption+)
 apply blast
done

lemma fag_single_additionTr5:"\<lbrakk>assoc_bpp (aug_pm_set z i {a}) f;
      ipp_cond1 {a} i; ipp_cond2 z {a} i f; ipp_cond3 z i; inv_ipp z i f {a};
      commute_bpp f (aug_pm_set z i {a}); zeroA z i f {a} z\<rbrakk> \<Longrightarrow>
      \<forall>m. m < Suc n \<longrightarrow> (THE x. x \<in> add_set f {a} (Suc n)) \<^sub>f+
         (THE x. x \<in> add_set f {\<^sub>i- a} m) = (THE x. x \<in> add_set f {a} (n - m))"
apply (cut_tac a_in_aug_pm_set[of a "{a}" z i],
        cut_tac addition_inc_add0[of "aug_pm_set z i {a}" f],
        frule subsetD[of "aug_pm_set z i {a}"
                     "addition_set f (aug_pm_set z i {a})" a], assumption+)
prefer 2 apply simp
 apply (cut_tac aug_addition_inc_z[of z f i "{a}"])
 apply (frule aug_ipp_closed [of "f" "z" "i" "{a}" "a"], assumption+)

apply (induct_tac n)
 apply (rule allI, rule impI, simp)
 apply (simp add: addition_assoc [of "aug_pm_set z i {a}" "f" "a" "a" "\<^sub>i- a"])
 apply (frule fag_single_additionTr2 [of "f" "z" "i" "a" "a"], assumption+)
 apply simp apply simp
 apply (thin_tac "a \<^sub>f+ \<^sub>i- a = z")
 apply (simp add:aug_commute [of "f" "z" "i" "{a}" "a" "z"])
 apply (simp add:zeroA_def)

apply (rule allI, rule impI)
apply (subgoal_tac "(THE x. x \<in> add_set f {a} (Suc (Suc n))) =
                (THE x. x \<in> add_set f {a} (Suc n)) \<^sub>f+ a")
 apply (simp del:add_set_Suc)
 apply (frule_tac m = m and n = "Suc (Suc n)" in Suc_leI,
        thin_tac "Suc m \<le> Suc (Suc n)")
 apply (case_tac "Suc m = Suc (Suc n)")
  apply (frule_tac x = m and y = "Suc n" in Suc_inject,
         thin_tac "Suc m = Suc (Suc n)")
  apply (rotate_tac -1, frule sym, thin_tac "m = Suc n",
         thin_tac "\<forall>m. m < Suc n \<longrightarrow> (THE x. x \<in> add_set f {a} (Suc n)) \<^sub>f+
  (THE x. x \<in> add_set f {\<^sub>i- a} m) = (THE x. x \<in> add_set f {a} (n - m))",
         thin_tac "(THE x. x \<in> add_set f {a} (Suc (Suc n))) =
             (THE x. x \<in> add_set f {a} (Suc n)) \<^sub>f+ a")
  apply simp
 apply (subgoal_tac "(THE x. x \<in> add_set f {a} m) \<in>
                             addition_set f (aug_pm_set z i {a})")
 apply (subgoal_tac "(THE x. x \<in> add_set f {\<^sub>i- a} m) \<in>
                             addition_set f (aug_pm_set z i {a})")
 apply (frule_tac x = "THE x. x \<in> add_set f {a} m" and y = a and
                  z = "THE x. x \<in> add_set f {\<^sub>i- a} m" in
                  addition_assoc [of "aug_pm_set z i {a}" "f"], assumption+)
 apply simp
 apply (thin_tac "(THE x. x \<in> add_set f {a} m) \<^sub>f+ a \<^sub>f+
       (THE x. x \<in> add_set f {\<^sub>i- a} m) =
       (THE x. x \<in> add_set f {a} m) \<^sub>f+ (a \<^sub>f+ (THE x. x \<in> add_set f {\<^sub>i- a} m))")
 apply (frule_tac x = a and y = "THE x. x \<in> add_set f {\<^sub>i- a} m" in
        aug_commute [of "f" "z" "i" "{a}"], assumption+) apply simp
 apply (thin_tac "a \<^sub>f+ (THE x. x \<in> add_set f {\<^sub>i- a} m) =
        (THE x. x \<in> add_set f {\<^sub>i- a} m) \<^sub>f+ a")
 apply (frule_tac x1 = "THE x. x \<in> add_set f {a} m" and
         y1 = "THE x. x \<in> add_set f {\<^sub>i- a} m" and z1 = a in
        addition_assoc[THEN sym, of "aug_pm_set z i {a}" "f"], assumption+)
 apply simp
 apply (frule_tac n = m in fag_single_additionTr4 [of "f" "z" "i" "a"],
        assumption+)
 apply (subgoal_tac "(THE x. x \<in> add_set f {a} m) \<^sub>f+
        (THE x. x \<in> add_set f {\<^sub>i- a} m) = z")
 prefer 2
 apply (thin_tac "(THE x. x \<in> add_set f {a} m)
             \<in> addition_set f (aug_pm_set z i {a})",
        thin_tac "(THE x. x \<in> add_set f {\<^sub>i- a} m)
             \<in> addition_set f (aug_pm_set z i {a})",
        thin_tac "(THE x. x \<in> add_set f {a} m) \<^sub>f+
        ((THE x. x \<in> add_set f {\<^sub>i- a} m) \<^sub>f+ a) =
        (THE x. x \<in> add_set f {a} m) \<^sub>f+ (THE x. x \<in> add_set f {\<^sub>i- a} m)  \<^sub>f+ a")
 apply (subgoal_tac "(THE x. x \<in> add_set f {a} m) \<in> add_set f {a} m")
 apply (subgoal_tac "(THE x. x \<in> add_set f {\<^sub>i- a} m) \<in> add_set f {\<^sub>i- a} m")
  apply simp
  apply (thin_tac "\<forall>s t. s \<in> add_set f {a} m \<and> t \<in> add_set f {\<^sub>i- a} m \<longrightarrow>
        s \<^sub>f+ t = z",
         thin_tac "(THE x. x \<in> add_set f {a} m) \<in> add_set f {a} m")
 apply (rule theI') apply (rule ex_ex1I)
  apply (simp add:add_set_single_nonempty2)
  apply (simp add:add_set_single2)
 apply (rule theI') apply (rule ex_ex1I)
  apply (simp add:add_set_single_nonempty1)
  apply (simp add:add_set_single1)
  apply (thin_tac "\<forall>s t. s \<in> add_set f {a} m \<and> t \<in> add_set f {\<^sub>i- a} m \<longrightarrow>
                   s \<^sub>f+ t = z")
  apply simp apply (simp add:zeroA_def)
 apply (subgoal_tac "(THE x. x \<in> add_set f {\<^sub>i- a} m) \<in> add_set f {\<^sub>i- a} m")
 apply (subgoal_tac "{\<^sub>i- a} \<subseteq> (aug_pm_set z i {a})")
 apply (frule_tac n = m in add_set_mono[of "{\<^sub>i- a}" "aug_pm_set z i {a}" "f"])
 apply (frule_tac A = "add_set f {\<^sub>i- a} m" and
        B = "add_set f (aug_pm_set z i {a}) m" and
        c = "THE x. x \<in> add_set f {\<^sub>i- a} m" in subsetD, assumption+)
 apply (subgoal_tac "add_set f (aug_pm_set z i {a}) m \<subseteq>
                                addition_set f (aug_pm_set z i {a})")
 apply (simp add:subsetD) apply (simp add:addition_inc_add)
 apply (rule subsetI) apply (simp add:aug_pm_set_def minus_set_def)
 apply (thin_tac "(THE x. x \<in> add_set f {a} m)
             \<in> addition_set f (aug_pm_set z i {a})")
 apply (rule theI') apply (rule ex_ex1I)
  apply (simp add:add_set_single_nonempty2)
  apply (simp add:add_set_single2)
 apply (subgoal_tac "(THE x. x \<in> add_set f {a} m) \<in> add_set f {a} m")
 apply (subgoal_tac "{a} \<subseteq> (aug_pm_set z i {a})")
 apply (frule_tac n = m in add_set_mono[of "{a}" "aug_pm_set z i {a}" "f"])
 apply (frule_tac A = "add_set f {a} m" and
        B = "add_set f (aug_pm_set z i {a}) m" and
        c = "THE x. x \<in> add_set f {a} m" in subsetD, assumption+)
 apply (subgoal_tac "add_set f (aug_pm_set z i {a}) m \<subseteq>
                                addition_set f (aug_pm_set z i {a})")
 apply (simp add:subsetD) apply (simp add:addition_inc_add)
 apply (rule subsetI) apply (simp add:aug_pm_set_def minus_set_def)
 apply (rule theI') apply (rule ex_ex1I)
  apply (simp add:add_set_single_nonempty1)
  apply (simp add:add_set_single1) apply (simp del:add_set_Suc)
  apply (subgoal_tac "(THE x. x \<in> add_set f {a} (Suc n)) \<^sub>f+
       (THE x. x \<in> add_set f {\<^sub>i- a} m) = (THE x. x \<in> add_set f {a} (n - m))")
 prefer 2 apply simp
 apply (thin_tac "\<forall>m. m < Suc n \<longrightarrow> (THE x. x \<in> add_set f {a} (Suc n)) \<^sub>f+
 (THE x. x \<in> add_set f {\<^sub>i- a} m) =  (THE x. x \<in> add_set f {a} (n - m))")
 apply (thin_tac "(THE x. x \<in> add_set f {a} (Suc (Suc n))) =
             (THE x. x \<in> add_set f {a} (Suc n)) \<^sub>f+ a")
 apply (subgoal_tac "(THE x. x \<in> add_set f {a} (Suc n)) \<in> add_set f {a} (Suc n)")
 prefer 2
 apply (rule theI') apply (rule ex_ex1I)
  apply (simp del:add_set_Suc add:add_set_single_nonempty1)
  apply (simp del:add_set_Suc add:add_set_single1)
 apply (subgoal_tac "(THE x. x \<in> add_set f {\<^sub>i- a} m) \<in> add_set f {\<^sub>i- a} m")
 apply (subgoal_tac "(THE x. x \<in> add_set f {a} (Suc n)) \<in> addition_set f (aug_pm_set z i {a})")
 apply (subgoal_tac "(THE x. x \<in> add_set f {\<^sub>i- a} m) \<in> addition_set f (aug_pm_set z i {a})")
 apply (frule_tac x = "THE x. x \<in> add_set f {a} (Suc n)" and y = a and z = "THE x. x \<in> add_set f {\<^sub>i- a} m" in addition_assoc [of "aug_pm_set z i {a}" "f"], assumption+) apply (simp del:add_set_Suc)
 apply (frule_tac x = a and y = "THE x. x \<in> add_set f {\<^sub>i- a} m" in aug_commute [of "f" "z" "i" "{a}"], assumption+) apply (simp del:add_set_Suc)
apply (frule_tac x1 = "THE x. x \<in> add_set f {a} (Suc n)" and y1 = "THE x. x \<in> add_set f {\<^sub>i- a} m" and z1 = a in addition_assoc[THEN sym, of "aug_pm_set z i {a}" "f"], assumption+)  apply (simp del:add_set_Suc)
 apply (thin_tac "(THE x. x \<in> add_set f {a} (Suc n)) \<^sub>f+
       (THE x. x \<in> add_set f {\<^sub>i- a} m) = (THE x. x \<in> add_set f {a} (n - m))",
        thin_tac " (THE x. x \<in> add_set f {a} (Suc n)) \<^sub>f+ a \<^sub>f+
  (THE x. x \<in> add_set f {\<^sub>i- a} m) = (THE x. x \<in> add_set f {a} (n - m)) \<^sub>f+ a",
        thin_tac "(THE x. x \<in> add_set f {a} (Suc n)) \<^sub>f+
  ((THE x. x \<in> add_set f {\<^sub>i- a} m) \<^sub>f+ a) = (THE x. x \<in>
                                             add_set f {a} (n - m)) \<^sub>f+ a",
       thin_tac "a \<^sub>f+ (THE x. x \<in> add_set f {\<^sub>i- a} m) =
                       (THE x. x \<in> add_set f {\<^sub>i- a} m) \<^sub>f+ a")
 apply (subgoal_tac "Suc n - m = Suc (n - m)", simp del:add_set_Suc)
 apply (thin_tac "Suc n - m = Suc (n - m)")
 apply (subgoal_tac "(THE x. x \<in> add_set f {a} (Suc (n - m))) \<in> add_set f {a}
 (Suc (n - m))")
 apply (subgoal_tac "\<exists>s\<in>add_set f {a} (n - m). (THE x. x \<in>add_set f {a} (Suc (n - m))) = s \<^sub>f+ a") prefer 2 apply simp
 apply (subgoal_tac "\<forall>s\<in>add_set f {a} (n - m). (THE x. x\<in>add_set f {a} (Suc (n - m))) = s \<^sub>f+ a \<longrightarrow> (THE x. x \<in> add_set f {a} (n - m)) \<^sub>f+ a =
             (THE x. x \<in> add_set f {a} (Suc (n - m)))")
 apply blast apply (thin_tac "\<exists>s\<in>add_set f {a} (n - m).
                (THE x. x \<in> add_set f {a} (Suc (n - m))) = s \<^sub>f+ a")
 apply (rule ballI) apply (rule impI) apply (simp del:add_set_Suc)
 apply (thin_tac "s \<^sub>f+ a \<in> add_set f {a} (Suc (n - m))")
 apply (thin_tac "(THE x. x \<in> add_set f {a} (Suc (n - m))) = s \<^sub>f+ a")
 apply (subgoal_tac "(THE x. x \<in> add_set f {a} (n - m)) = s ")
 apply simp
 apply (subgoal_tac "(THE x. x \<in> add_set f {a} (n - m)) \<in>
                                           add_set f {a} (n - m)")
 apply (simp add:add_set_single1)
 apply (rule theI') apply (rule ex_ex1I)
  apply (simp add:add_set_single_nonempty1)
  apply (simp add:add_set_single1)
 apply (thin_tac "(THE x. x \<in> add_set f {\<^sub>i- a} m) \<in>
                          addition_set f (aug_pm_set z i {a})",
        thin_tac "(THE x. x \<in> add_set f {a} (Suc n)) \<in> add_set f {a} (Suc n)",
        thin_tac "(THE x. x \<in> add_set f {\<^sub>i- a} m) \<in> add_set f {\<^sub>i- a} m",
        thin_tac "(THE x. x \<in> add_set f {a} (Suc n))
             \<in> addition_set f (aug_pm_set z i {a})")
 apply (rule theI') apply (rule ex_ex1I)
  apply (simp del:add_set_Suc add:add_set_single_nonempty1)
  apply (simp del:add_set_Suc add:add_set_single1)
  apply (simp add:Suc_diff_le)
  apply(thin_tac "(THE x. x \<in> add_set f {a} (Suc n)) \<^sub>f+
       (THE x. x \<in> add_set f {\<^sub>i- a} m) = (THE x. x \<in> add_set f {a} (n - m))",
        thin_tac "(THE x. x \<in> add_set f {a} (Suc n)) \<in> add_set f {a} (Suc n)",
        thin_tac "(THE x. x \<in> add_set f {\<^sub>i- a} m) \<in> add_set f {\<^sub>i- a} m",
        thin_tac "(THE x. x \<in> add_set f {a} (Suc n))
             \<in> addition_set f (aug_pm_set z i {a})")
 apply (subgoal_tac "{\<^sub>i- a} \<subseteq> (aug_pm_set z i {a})")
 apply (frule_tac A = "{\<^sub>i- a}" and B = "(aug_pm_set z i {a})" and
           n = m and f = f in add_set_mono)
 apply (subgoal_tac "(THE x. x \<in> add_set f {\<^sub>i- a} m) \<in> add_set f {\<^sub>i- a} m")
 apply (cut_tac n = m in addition_inc_add[of f "aug_pm_set z i {a}"])
 apply (simp add:subsetD)+
 apply (thin_tac "add_set f {\<^sub>i- a} m \<subseteq> add_set f (aug_pm_set z i {a}) m")
 apply (rule theI', rule ex_ex1I)
  apply (simp add:add_set_single_nonempty2)
  apply (simp add:add_set_single2)
  apply (rule subsetI, simp add:aug_pm_set_def minus_set_def)
 apply (thin_tac "(THE x. x \<in> add_set f {a} (Suc n)) \<^sub>f+
  (THE x. x \<in> add_set f {\<^sub>i- a} m) = (THE x. x \<in> add_set f {a} (n - m))",
        thin_tac "(THE x. x \<in> add_set f {\<^sub>i- a} m) \<in> add_set f {\<^sub>i- a} m")
  apply (subgoal_tac "{a} \<subseteq> (aug_pm_set z i {a})")
  apply (frule_tac A = "{a}" and B = "aug_pm_set z i {a}" and
                                 n = "Suc n" and f = f in add_set_mono)
   apply (cut_tac n = "Suc n" in addition_inc_add[of f "aug_pm_set z i {a}"])
  apply (simp del:add_set_Suc add:subsetD)+
 apply (thin_tac "(THE x. x \<in> add_set f {a} (Suc n)) \<^sub>f+
       (THE x. x \<in> add_set f {\<^sub>i- a} m) = (THE x. x \<in> add_set f {a} (n - m))",
        thin_tac "(THE x. x \<in> add_set f {a} (Suc n)) \<in> add_set f {a} (Suc n)")
 apply (rule theI') apply (rule ex_ex1I)
  apply (simp add:add_set_single_nonempty2)
  apply (simp add:add_set_single2)
 apply (thin_tac "\<forall>m. m < Suc n \<longrightarrow> (THE x. x \<in> add_set f {a} (Suc n)) \<^sub>f+
 (THE x. x \<in> add_set f {\<^sub>i- a} m) = (THE x. x \<in> add_set f {a} (n - m))")
 apply (subgoal_tac "(THE x. x \<in> add_set f {a} (Suc (Suc n))) \<in>
                                           add_set f {a} (Suc (Suc n))")
 apply (subgoal_tac "\<exists>s\<in>add_set f {a} (Suc n).
        (THE x. x \<in> add_set f {a} (Suc (Suc n))) = s \<^sub>f+ a")
 prefer 2 apply simp
 apply (erule bexE)
 apply (simp del:add_set_Suc)
 apply (thin_tac "(THE x. x \<in> add_set f {a} (Suc (Suc n))) = s \<^sub>f+ a")
 apply (subgoal_tac "s = (THE x. x \<in> add_set f {a} (Suc n))")
 apply (simp del:add_set_Suc)
 apply (subgoal_tac "(THE x. x \<in> add_set f {a} (Suc n)) \<in>
                                      add_set f {a} (Suc n)")
 apply (simp del:add_set_Suc add:add_set_single1)
 apply (rule theI') apply (rule ex_ex1I)
  apply (simp del:add_set_Suc add:add_set_single_nonempty1)
  apply (simp del:add_set_Suc add:add_set_single1)
 apply (rule theI') apply (rule ex_ex1I)
  apply (simp del:add_set_Suc add:add_set_single_nonempty1)
  apply (simp del:add_set_Suc add:add_set_single1)
done

lemma fag_single_additionTr5_1:"\<lbrakk>assoc_bpp (aug_pm_set z i {a}) f;
      ipp_cond1 {a} i; ipp_cond2 z {a} i f; ipp_cond3 z i; inv_ipp z i f {a};
      commute_bpp f (aug_pm_set z i {a}); zeroA z i f {a} z; m < Suc n\<rbrakk> \<Longrightarrow>
 (THE x. x \<in> add_set f {a} (Suc n)) \<^sub>f+ (THE x. x \<in> add_set f {\<^sub>i- a} m) =
                            (THE x. x \<in> add_set f {a} (n - m))"
apply (frule_tac n = n in fag_single_additionTr5 [of "z" "i" "a" "f"],
         assumption+) apply simp
done

lemma fag_single_additionTr5_2:"\<lbrakk>assoc_bpp (aug_pm_set z i {a}) f;
      ipp_cond1 {a} i; ipp_cond2 z {a} i f; ipp_cond3 z i; inv_ipp z i f {a};
      commute_bpp f (aug_pm_set z i {a}); zeroA z i f {a} z; n < Suc m\<rbrakk> \<Longrightarrow>
     (THE x. x \<in> add_set f {\<^sub>i- a} (Suc m)) \<^sub>f+ (THE x. x \<in> add_set f {a} n) =
           (THE x. x \<in> add_set f {\<^sub>i- a} (m - n))"
apply (simp del:add_set_Suc add:aug_pm_aug_pm_minus)
 apply (frule ipp_cond1_minus[of "a" "i"])
 apply (frule ipp_cond2_minus[of "a" "i" "z" "f"], assumption+)
 apply (frule inv_ipp_minus[of "a" "i" "z" "f"], assumption+)
 apply (frule zeroA_minus[of "a" "i" "z" "f" "z"], assumption+)
 apply (subgoal_tac "\<^sub>i- (\<^sub>i- a) = a")
 apply (frule fag_single_additionTr5_1 [of z i "\<^sub>i- a" f n m], assumption+)
  apply (simp del:add_set_Suc)
 apply (simp add:ipp_cond1_def)
done

definition
  free_gen_condition :: "['a \<Rightarrow> 'a \<Rightarrow> 'a, 'a \<Rightarrow> 'a, 'a, 'a] \<Rightarrow> bool" where
  "free_gen_condition f i a z \<longleftrightarrow> (\<forall>n. z \<notin> add_set f {a} n)"

definition
  fg_elem_single :: "['a \<Rightarrow> 'a \<Rightarrow> 'a, 'a \<Rightarrow> 'a, 'a, 'a] \<Rightarrow> int \<Rightarrow> 'a" where
  "fg_elem_single f i a z n = (if 0 = n then z else
      (if 0 < n then (THE x. x \<in> (add_set f {a} (nat (n - 1))))
        else (THE x. x \<in> (add_set f {\<^sub>i- a} (nat (- n - 1))))))"

abbreviation
  FGELEMSNGLE  ("(5_\<Odot>_\<^bsub>_,_,_\<^esub>)" [99,98,98,98,98]99) where
  "n\<Odot>a\<^bsub>f,i,z\<^esub> == fg_elem_single f i a z n"

lemma  single_addition_pm_mem:"\<lbrakk>assoc_bpp (aug_pm_set z i {a}) f;
       ipp_cond1 {a} i; ipp_cond2 z {a} i f; ipp_cond3 z i; inv_ipp z i f {a};
       commute_bpp f (aug_pm_set z i {a}); zeroA z i f {a} z\<rbrakk> \<Longrightarrow>
      (n\<Odot>a\<^bsub>f,i,z\<^esub>) \<in> addition_set f (aug_pm_set z i {a})"
apply (case_tac "n = 0")
 apply (simp add:fg_elem_single_def) apply (simp add:aug_addition_inc_z)
 apply (frule_tac non_zero_int [of "n"])
apply (case_tac "0 < n")
 apply (simp add:fg_elem_single_def)
 apply (subgoal_tac "(THE x. x \<in> add_set f {a} (nat (n - 1))) \<in>
                                           add_set f {a} (nat (n - 1))")
 apply (subgoal_tac "add_set f {a} (nat (n - 1)) \<subseteq> addition_set f {a}")
 apply (subgoal_tac "addition_set f {a}
                                \<subseteq> addition_set f (aug_pm_set z i {a})")
 apply (simp add:subsetD)+
 apply (rule addition_set_mono)
 apply (rule subsetI) apply (simp add:aug_pm_set_def minus_set_def)
 apply (simp add:addition_inc_add)
 apply (rule theI')
  apply (rule ex_ex1I)
  apply (simp add:add_set_single_nonempty1)
  apply (simp add:add_set_single1) apply (thin_tac "n \<noteq> 0")
 apply simp
 apply (simp add:fg_elem_single_def)
 apply (subgoal_tac "(THE x. x \<in> add_set f {\<^sub>i- a} (nat (- n - 1))) \<in>
                                       add_set f {\<^sub>i- a} (nat (- n - 1))")
 apply (subgoal_tac "add_set f {\<^sub>i- a} (nat (- n - 1)) \<subseteq>
                                       addition_set f {\<^sub>i- a}")
 apply (subgoal_tac "addition_set f {\<^sub>i- a} \<subseteq>
                         addition_set f (aug_pm_set z i {a})")
 apply (simp add:subsetD)+
 apply (rule addition_set_mono)
 apply (rule subsetI) apply (simp add:aug_pm_set_def minus_set_def)
 apply (simp add:addition_inc_add)
 apply (rule theI')
  apply (rule ex_ex1I)
  apply (simp add:add_set_single_nonempty2)
  apply (simp add:add_set_single2)
done

lemma assoc_aug_assoc:"assoc_bpp (aug_pm_set z i {a}) f \<Longrightarrow> assoc_bpp {a} f"
apply (simp add:assoc_bpp_def)
apply (rule ballI)+
apply (subgoal_tac "{a} \<subseteq> aug_pm_set z i {a}")
apply (frule addition_set_mono[of "{a}" "aug_pm_set z i {a}" "f"])
 apply (frule_tac c = aa in subsetD[of "addition_set f {a}"
                    "addition_set f (aug_pm_set z i {a})"], assumption+)
 apply (frule_tac c = b in subsetD[of "addition_set f {a}"
                    "addition_set f (aug_pm_set z i {a})"], assumption+)
 apply (frule_tac c = c in subsetD[of "addition_set f {a}"
                    "addition_set f (aug_pm_set z i {a})"], assumption+)
 apply simp
 apply (rule subsetI)
 apply (simp add:aug_pm_set_def minus_set_def)
done

lemma single_addition_posTr:"\<lbrakk>commute_bpp f (aug_pm_set z i {(a::'a)});
      assoc_bpp (aug_pm_set z i {a}) f; ipp_cond1 {a} i; ipp_cond2 z {a} i f;
      ipp_cond3 z i; inv_ipp z i f {a}; commute_bpp f (aug_pm_set z i {a});
      zeroA z i f {a} z; 0 < (n::int); 0 < (m::int)\<rbrakk> \<Longrightarrow>
  (THE x. x \<in> add_set f {a} (nat (n - 1))) \<^sub>f+
   (THE x. x \<in> add_set f {a} (nat (m - 1))) =
                              (THE x. x \<in> add_set f {a} (nat (n + m - 1)))"
apply (subgoal_tac "(THE x. x \<in> add_set f {a} (nat (n - 1))) \<in>
                                        add_set f {a} (nat (n - 1))")
apply (subgoal_tac "(THE x. x \<in> add_set f {a} (nat (m - 1)))
                                       \<in>
                                          add_set f {a} (nat (m - 1))")
apply (subgoal_tac "(THE x. x \<in> add_set f {a} (nat (n + m - 1)))
                                     \<in> add_set f {a} (nat (n + m - 1))")
apply (frule assoc_aug_assoc [of "z" "i" "a" "f"])
apply (frule_tac x = "THE x. x \<in> add_set f {a} (nat (n - 1))" and
       y = "THE x. x \<in> add_set f {a} (nat (m - 1))" in
       bpp_closed1 [of "{a}" "f" _ "nat (n - 1)" _ "nat (m - 1)"], assumption+)
apply (subgoal_tac "nat (n - 1) + nat (m - 1) + Suc 0 = nat (n + m - 1)")
apply (simp del:add_set_Suc)
apply (simp add:add_set_single1)
prefer 2
  apply (thin_tac "(THE x. x \<in> add_set f {a} (nat (n - 1)))
       \<in> add_set f {a} (nat (n - 1))")
  apply (thin_tac "(THE x. x \<in> add_set f {a} (nat (m - 1)))
       \<in> add_set f {a} (nat (m - 1))")
  apply (rule theI')
  apply (rule ex_ex1I)
  apply (simp add:add_set_single_nonempty1)
  apply (simp add:add_set_single1)
prefer 2
  apply (rule theI')
  apply (rule ex_ex1I)
  apply (simp add:add_set_single_nonempty1)
  apply (simp add:add_set_single1)
prefer 2
  apply (rule theI')
  apply (rule ex_ex1I)
  apply (simp add:add_set_single_nonempty1)
  apply (simp add:add_set_single1)
apply (rule int_nat_add, assumption+)
done

lemma single_addition_pos:"\<lbrakk>commute_bpp f (aug_pm_set z i {(a::'a)});
      assoc_bpp (aug_pm_set z i {a}) f; ipp_cond1 {a} i; ipp_cond2 z {a} i f;
      ipp_cond3 z i; inv_ipp z i f {a}; commute_bpp f (aug_pm_set z i {a});
      zeroA z i f {a} z; 0 < (n::int); 0 < (m::int)\<rbrakk> \<Longrightarrow>
     (n\<Odot>a\<^bsub>f,i,z\<^esub>) \<^sub>f+ (m\<Odot>a\<^bsub>f,i,z\<^esub>) = (n + m)\<Odot>a\<^bsub>f,i,z\<^esub>"
apply (frule_tac single_addition_posTr [of f z i a n m], assumption+)
apply (simp add:fg_elem_single_def)
done

lemma single_addition_neg:"\<lbrakk>commute_bpp f (aug_pm_set z i {(a::'a)});
      assoc_bpp (aug_pm_set z i {a}) f; ipp_cond1 {a} i; ipp_cond2 z {a} i f;
      ipp_cond3 z i; inv_ipp z i f {a}; commute_bpp f (aug_pm_set z i {a});
      zeroA z i f {a} z; (n::int) < 0; (m::int) < 0 \<rbrakk> \<Longrightarrow>
           (n\<Odot>a\<^bsub>f,i,z\<^esub>) \<^sub>f+ (m\<Odot>a\<^bsub>f,i,z\<^esub>) = (n + m)\<Odot>a\<^bsub>f,i,z\<^esub>"
apply (simp add:fg_elem_single_def)
apply (simp del:add_set_Suc add:aug_pm_aug_pm_minus)
 apply (frule ipp_cond1_minus[of "a" "i"])
 apply (frule ipp_cond2_minus[of "a" "i" "z" "f"], assumption+)
 apply (frule inv_ipp_minus[of "a" "i" "z" "f"], assumption+)
 apply (frule zeroA_minus[of "a" "i" "z" "f" "z"], assumption+)
apply (frule single_addition_posTr [of f z i "\<^sub>i- a" "- n" "- m"], assumption+)
apply simp+
done

lemma single_addition_zero:"\<lbrakk>commute_bpp f (aug_pm_set z i {(a::'a)});
      assoc_bpp (aug_pm_set z i {a}) f; ipp_cond1 {a} i; ipp_cond2 z {a} i f;
      ipp_cond3 z i; inv_ipp z i f {a}; commute_bpp f (aug_pm_set z i {a});
      zeroA z i f {a} z\<rbrakk> \<Longrightarrow> 0\<Odot>a\<^bsub>f,i,z\<^esub> = z"
apply (simp add:fg_elem_single_def)
done

lemma s_a_p_1:"\<lbrakk>assoc_bpp (aug_pm_set z i {a}) f; ipp_cond1 {a} i;
                ipp_cond2 z {a} i f; ipp_cond3 z i; inv_ipp z i f {a};
                commute_bpp f (aug_pm_set z i {a}); zeroA z i f {a} z;
                m < 0; 0 < n\<rbrakk> \<Longrightarrow> (n\<Odot>a\<^bsub>f,i,z\<^esub>) \<^sub>f+ (m\<Odot>a\<^bsub>f,i,z\<^esub>) = (n + m)\<Odot>a\<^bsub>f,i,z\<^esub>"

apply (case_tac "- m < n")
 apply (subst zminus_zadd_cancel [THEN sym, of "n" "m"])
 apply (subgoal_tac "0 < -m") apply (subgoal_tac "0 < m + n")
 apply (subst single_addition_pos[THEN sym, of "f" "z" "i" "a" "-m" "m + n"],
             assumption+)
 apply (simp add:zminus_zadd_cancel [of "m" "m + n"])
apply (frule single_addition_pm_mem[of "z" "i" "a" "f" "-m"], assumption+)
 apply (frule single_addition_pm_mem[of "z" "i" "a" "f" "m + n"], assumption+)
 apply (frule single_addition_pm_mem[of "z" "i" "a" "f" "m"], assumption+)
 apply (subst addition_assoc, assumption+)
 apply (simp add:aug_commute[of "f" "z" "i" "{a}" "(m + n)\<Odot>a\<^bsub>f,i,z\<^esub>" "m\<Odot>a\<^bsub>f,i,z\<^esub>"])
 apply (subst addition_assoc[THEN sym], assumption+)
 apply (subgoal_tac "((- m)\<Odot>a\<^bsub>f,i,z\<^esub>) \<^sub>f+ (m\<Odot>a\<^bsub>f,i,z\<^esub>) = z") apply simp
 apply (simp add:zeroA_def)  apply (simp add:add.commute)
 apply (simp add:fg_elem_single_def)
 apply (rule fag_single_additionTr4_1[of "f" "z" "i" "a"_ "nat (- m - 1)"], assumption+)
  apply (rule theI') apply (rule ex_ex1I)
   apply (simp add:add_set_single_nonempty1)
   apply (simp add:add_set_single1)
  apply (rule theI') apply (rule ex_ex1I)
   apply (simp add:add_set_single_nonempty2)
  apply (simp add:add_set_single2)
 apply simp+ apply (subgoal_tac "n \<le> - m") prefer 2 apply simp
 apply (thin_tac "\<not> - m < n")
 apply (frule zle_imp_zless_or_eq) apply (thin_tac "n \<le> - m")
 apply (case_tac "n = -m")
 apply (thin_tac "n < - m \<or> n = - m")   apply simp
 apply (subgoal_tac "0 < -m") apply (thin_tac "n = - m")
 apply (simp add:fg_elem_single_def)
 apply (rule fag_single_additionTr4_1 [of "f" "z" "i" "a" _ "nat (-m - 1)"], assumption+)
  apply (rule theI') apply (rule ex_ex1I)
   apply (simp add:add_set_single_nonempty1)
   apply (simp add:add_set_single1)
  apply (rule theI') apply (rule ex_ex1I)
   apply (simp add:add_set_single_nonempty2)
   apply (simp add:add_set_single2)
  apply simp
 apply simp
apply (subst zminus_zadd_cancel [THEN sym, of "m" "n"])
 apply (subst single_addition_neg[THEN sym, of "f" "z" "i" "a" "-n" "n + m"], assumption+) apply simp apply simp
 apply (frule single_addition_pm_mem[of "z" "i" "a" "f" "-n"], assumption+)
 apply (frule single_addition_pm_mem[of "z" "i" "a" "f" "n + m"], assumption+)  apply (frule single_addition_pm_mem[of "z" "i" "a" "f" "n"], assumption+)
 apply (simp add:addition_assoc[THEN sym])
 apply (subgoal_tac "(n\<Odot>a\<^bsub>f,i,z\<^esub>) \<^sub>f+ ((- n)\<Odot>a\<^bsub>f,i,z\<^esub>) = z") apply (simp add:zeroA_def)
 apply (thin_tac "(- n)\<Odot>a\<^bsub>f,i,z\<^esub> \<in> addition_set f (aug_pm_set z i {a})")
 apply (thin_tac "(n + m)\<Odot>a\<^bsub>f,i,z\<^esub> \<in> addition_set f (aug_pm_set z i {a})")
 apply (thin_tac "n\<Odot>a\<^bsub>f,i,z\<^esub> \<in> addition_set f (aug_pm_set z i {a})")
 apply (simp add:fg_elem_single_def)
 apply (subgoal_tac "(THE x. x \<in> add_set f {a} (nat (n - 1))) \<in>
                                      add_set f {a} (nat (n - 1))")
 apply (subgoal_tac "(THE x. x \<in> add_set f {\<^sub>i- a} (nat (n - 1))) \<in>
                                   add_set f {\<^sub>i- a} (nat (n - 1))")
 apply (simp add:fag_single_additionTr4_1)
 apply (rule theI') apply (rule ex_ex1I)
   apply (simp add:add_set_single_nonempty2)
   apply (simp add:add_set_single2)
  apply (rule theI') apply (rule ex_ex1I)
   apply (simp add:add_set_single_nonempty1)
   apply (simp add:add_set_single1)
done

lemma single_addition_pm:"\<lbrakk>commute_bpp f (aug_pm_set z i {(a::'a)});
      assoc_bpp (aug_pm_set z i {a}) f; ipp_cond1 {a} i; ipp_cond2 z {a} i f;
      ipp_cond3 z i; inv_ipp z i f {a}; commute_bpp f (aug_pm_set z i {a});
      zeroA z i f {a} z\<rbrakk> \<Longrightarrow> (n\<Odot>a\<^bsub>f,i,z\<^esub>) \<^sub>f+ (m\<Odot>a\<^bsub>f,i,z\<^esub>) = (n + m)\<Odot>a\<^bsub>f,i,z\<^esub>"
apply (frule single_addition_pm_mem[of "z" "i" "a" "f" "n"], assumption+)
 apply (frule single_addition_pm_mem[of "z" "i" "a" "f" "m"], assumption+)
 apply (case_tac "n = 0")
 apply (subgoal_tac "(n\<Odot>a\<^bsub>f,i,z\<^esub>) = z", simp)
 apply (simp add:zeroA_def, subst fg_elem_single_def, simp)
 apply (case_tac "m = 0")
 apply (simp add:aug_commute)
 apply (subgoal_tac " (0\<Odot>a\<^bsub>f,i,z\<^esub>) = z", simp)
 apply (simp add:zeroA_def, subst fg_elem_single_def, simp)
apply (frule_tac non_zero_int [of "n"], thin_tac "n \<noteq> 0")
apply (frule_tac non_zero_int [of "m"], thin_tac "m \<noteq> 0")
apply (case_tac "0 < n", thin_tac "0 < n \<or> n < 0")
 apply (case_tac "0 < m", thin_tac "0 < m \<or> m < 0")
 apply (simp add:single_addition_pos)
 apply (simp, thin_tac "m\<Odot>a\<^bsub>f,i,z\<^esub> \<in> addition_set f (aug_pm_set z i {a})")
apply (simp add:s_a_p_1)
 apply simp
 apply (subst aug_commute, assumption+)
 apply (case_tac "0 < m", thin_tac "0 < m \<or> m < 0")
 apply (simp add:s_a_p_1, simp add:add.commute)
apply simp
 apply (simp add:single_addition_neg, simp add:add.commute)
done

lemma single_inv:"\<lbrakk>commute_bpp f (aug_pm_set z i {(a::'a)});
      assoc_bpp (aug_pm_set z i {a}) f; ipp_cond1 {a} i; ipp_cond2 z {a} i f;
      ipp_cond3 z i; inv_ipp z i f {a}; commute_bpp f (aug_pm_set z i {a});
      zeroA z i f {a} z\<rbrakk> \<Longrightarrow>  \<^sub>i- (m\<Odot>a\<^bsub>f,i,z\<^esub>) = (-m)\<Odot>a\<^bsub>f,i,z\<^esub>"
apply (frule single_addition_pm_mem[of "z" "i" "a" "f" "m"], assumption+,
       frule single_addition_pm_mem[of "z" "i" "a" "f" "- m"], assumption+,
       frule single_addition_pm[THEN sym, of "f" "z" "i" "a" "-m" "m"],
                                         assumption+, simp)
apply (simp add:single_addition_zero)
apply (subgoal_tac "z \<^sub>f+ (\<^sub>i- (m\<Odot>a\<^bsub>f,i,z\<^esub>)) =
            ((- m)\<Odot>a\<^bsub>f,i,z\<^esub>) \<^sub>f+ (m\<Odot>a\<^bsub>f,i,z\<^esub>) \<^sub>f+ (\<^sub>i- (m\<Odot>a\<^bsub>f,i,z\<^esub>))") prefer 2 apply simp
 apply (frule aug_ipp_closed [of "f" "z" "i" "{a}" "m\<Odot>a\<^bsub>f,i,z\<^esub>"], assumption+)
 apply (thin_tac "z = ((- m)\<Odot>a\<^bsub>f,i,z\<^esub>) \<^sub>f+ (m\<Odot>a\<^bsub>f,i,z\<^esub>)")
 apply (simp add:addition_assoc)
 apply (simp add:aug_commute [of "f" "z" "i" "{a}" "(m\<Odot>a\<^bsub>f,i,z\<^esub>)" "\<^sub>i- (m\<Odot>a\<^bsub>f,i,z\<^esub>)"])
 apply (subgoal_tac "\<^sub>i- (m\<Odot>a\<^bsub>f,i,z\<^esub>) \<^sub>f+ (m\<Odot>a\<^bsub>f,i,z\<^esub>) = z") apply simp
 apply (subgoal_tac "z \<in> addition_set f (aug_pm_set z i {a})")
 prefer 2 apply (simp add:addition_set_inc_z)
 apply (simp add:aug_commute[of "f" "z" "i" "{a}" "(- m)\<Odot>a\<^bsub>f,i,z\<^esub>" "z"])
 apply (simp add:zeroA_def)
 apply (simp add:inv_ipp_def)
 apply (subgoal_tac "zeroA z i f {a} (\<^sub>i- (m\<Odot>a\<^bsub>f,i,z\<^esub>) \<^sub>f+ (m\<Odot>a\<^bsub>f,i,z\<^esub>))")
 prefer 2  apply simp
 apply (frule aug_zero_unique[of "f" "z" "i" "{a}" "\<^sub>i- (m\<Odot>a\<^bsub>f,i,z\<^esub>) \<^sub>f+ (m\<Odot>a\<^bsub>f,i,z\<^esub>)"])
 apply (rule aug_bpp_closed, assumption+)
 apply (rule sym) apply assumption
done

lemma free_ag_single:"\<lbrakk>commute_bpp f (aug_pm_set z i {a});
      assoc_bpp (aug_pm_set z i {a}) f; ipp_cond1 {a} i; ipp_cond2 z {a} i f;
      ipp_cond3 z i; inv_ipp z i f {a}; commute_bpp f (aug_pm_set z i {a});
      zeroA z i f {a} z; free_gen_condition f i a z; n \<noteq> m\<rbrakk> \<Longrightarrow>
      (n\<Odot>a\<^bsub>f,i,z\<^esub>) \<noteq> (m\<Odot>a\<^bsub>f,i,z\<^esub>)"
apply (rule contrapos_pp, simp+)
apply (frule single_addition_pm[THEN sym, of f z i a n "-m"], assumption+)
apply simp
apply (frule single_addition_pm_mem[of "z" "i" "a" "f" "m"], assumption+)
 apply (frule single_addition_pm_mem[of "z" "i" "a" "f" "- m"], assumption+)
 apply (simp add:aug_commute [of "f" "z" "i" "{a}" "(m\<Odot>a\<^bsub>f,i,z\<^esub>)" "(- m)\<Odot>a\<^bsub>f,i,z\<^esub>"])
 apply (simp add:single_inv[THEN sym, of "f" "z" "i" "a" "m"])
 apply (simp add:inv_aug_addition)
 apply (thin_tac "n\<Odot>a\<^bsub>f,i,z\<^esub> = m\<Odot>a\<^bsub>f,i,z\<^esub>")
 apply (thin_tac " \<^sub>i- (m\<Odot>a\<^bsub>f,i,z\<^esub>) \<in> addition_set f (aug_pm_set z i {a})")
 apply (thin_tac " m\<Odot>a\<^bsub>f,i,z\<^esub> \<in> addition_set f (aug_pm_set z i {a})")
 apply (insert int_neq_iff[of "n" "m"]) apply simp
 apply (case_tac "n < m") apply (thin_tac "n < m \<or> m < n")
 apply (frule single_inv [THEN sym, of "f" "z" "i" "a" "n - m"], assumption+)
 apply simp apply (subgoal_tac "\<^sub>i- z = z") apply simp
 apply (thin_tac " \<^sub>i- z = z") prefer 2  apply (simp add:ipp_cond3_def)
 apply (subgoal_tac "0 < m - n") prefer 2 apply simp
 apply (thin_tac "(n - m)\<Odot>a\<^bsub>f,i,z\<^esub> = z")
 apply (simp add:fg_elem_single_def)
 apply (subgoal_tac "(THE x. x \<in> add_set f {a} (nat (m - n - 1))) \<in> add_set f {a} (nat (m - n - 1))") apply simp
 apply (thin_tac "(THE x. x \<in> add_set f {a} (nat (m - n - 1))) = z")
 apply (simp add:free_gen_condition_def)
  apply (rule theI') apply (rule ex_ex1I)
  apply (simp add:add_set_single_nonempty1)
   apply (simp add:add_set_single1) apply simp
 apply (subgoal_tac "0 < n - m") prefer 2 apply simp
 apply (simp add:fg_elem_single_def)
 apply (subgoal_tac "(THE x. x \<in> add_set f {a} (nat (n - m - 1))) \<in> add_set f {a} (nat (n - m - 1))") apply simp
 apply (thin_tac "(THE x. x \<in> add_set f {a} (nat (n - m - 1))) = z")
apply (simp add:free_gen_condition_def)
  apply (rule theI') apply (rule ex_ex1I)
  apply (simp add:add_set_single_nonempty1)
   apply (simp add:add_set_single1)
done

definition
  fags_cond :: "['a \<Rightarrow> 'a \<Rightarrow> 'a, 'a, 'a \<Rightarrow> 'a, 'a] \<Rightarrow> bool" where
  "fags_cond f z i a \<longleftrightarrow> commute_bpp f (aug_pm_set z i {a}) \<and>
       assoc_bpp (aug_pm_set z i {a}) f \<and> ipp_cond1 {a} i \<and>
       ipp_cond2 z {a} i f \<and>  ipp_cond3 z i \<and> inv_ipp z i f {a} \<and>
       commute_bpp f (aug_pm_set z i {a}) \<and>  zeroA z i f {a} z \<and>
       free_gen_condition f i a z"

lemma fag_single_free:"\<lbrakk>fags_cond f z i a; n \<noteq> m\<rbrakk> \<Longrightarrow> (n\<Odot>a\<^bsub>f,i,z\<^esub>) \<noteq> (m\<Odot>a\<^bsub>f,i,z\<^esub>)"
apply (simp add:fags_cond_def) apply (erule conjE)+
 apply (simp add:free_ag_single)
done

lemma fag_single_free1:"\<lbrakk>fags_cond f z i a;(n\<Odot>a\<^bsub>f,i,z\<^esub>) = (m\<Odot>a\<^bsub>f,i,z\<^esub>)\<rbrakk> \<Longrightarrow> n = m"
apply (rule contrapos_pp, simp+)
apply (frule fag_single_free [of "f" "z" "i" "a" "n" "m"], assumption+)
apply simp
done

definition
  fags_carr :: "['a \<Rightarrow> 'a \<Rightarrow> 'a, 'a, 'a \<Rightarrow> 'a, 'a] \<Rightarrow> 'a set" where
  "fags_carr f z i a = {x. \<exists>n. x = n\<Odot>a\<^bsub>f,i,z\<^esub>}"

definition
  fags_bpp :: "['a \<Rightarrow> 'a \<Rightarrow> 'a, 'a, 'a \<Rightarrow> 'a, 'a] \<Rightarrow> 'a \<Rightarrow> 'a \<Rightarrow> 'a" where
  "fags_bpp f z i a = (\<lambda>x\<in>(fags_carr f z i a). \<lambda>y\<in>(fags_carr f z i a).
        ((THE n. x = n\<Odot>a\<^bsub>f,i,z\<^esub>) + (THE m. y = m\<Odot>a\<^bsub>f,i,z\<^esub>))\<Odot>a\<^bsub>f,i,z\<^esub>)"

definition
  fags_ipp :: "['a \<Rightarrow> 'a \<Rightarrow> 'a, 'a, 'a \<Rightarrow> 'a, 'a] \<Rightarrow> 'a \<Rightarrow> 'a" where
  "fags_ipp f z i a = (\<lambda>x\<in>(fags_carr f z i a).
                                   (- (THE n. x = n\<Odot>a\<^bsub>f,i,z\<^esub>))\<Odot>a\<^bsub>f,i,z\<^esub>)"

lemma fags_mem:"fags_cond f z i a \<Longrightarrow> (n\<Odot>a\<^bsub>f,i,z\<^esub>) \<in> fags_carr f z i a"
apply (simp add:fags_carr_def)
apply blast
done

lemma fags_ippTr:"fags_cond f z i a \<Longrightarrow>
                  fags_ipp f z i a (n\<Odot>a\<^bsub>f,i,z\<^esub>) = (- n)\<Odot>a\<^bsub>f,i,z\<^esub>"
apply (subgoal_tac "(n\<Odot>a\<^bsub>f,i,z\<^esub>) \<in>  fags_carr f z i a")
apply (simp add:fags_ipp_def)
 apply (subgoal_tac "n\<Odot>a\<^bsub>f,i,z\<^esub> = (THE na. n\<Odot>a\<^bsub>f,i,z\<^esub> = na\<Odot>a\<^bsub>f,i,z\<^esub>)\<Odot>a\<^bsub>f,i,z\<^esub>")
 apply (frule_tac m = "THE na. n\<Odot>a\<^bsub>f,i,z\<^esub> = na\<Odot>a\<^bsub>f,i,z\<^esub>" in
        fag_single_free1[of "f" "z" "i" "a" "n"], assumption+, simp)
 apply (rule theI', rule ex_ex1I, blast)
 apply (simp add:fag_single_free1 [of f z i a])
 apply (simp add:fags_mem)
done

lemma fags_bppTr:"fags_cond f z i a \<Longrightarrow>
                  fags_bpp f z i a (n\<Odot>a\<^bsub>f,i,z\<^esub>) (m\<Odot>a\<^bsub>f,i,z\<^esub>) = (n + m)\<Odot>a\<^bsub>f,i,z\<^esub>"
apply (subgoal_tac "(n\<Odot>a\<^bsub>f,i,z\<^esub>) \<in>  fags_carr f z i a")
apply (subgoal_tac "(m\<Odot>a\<^bsub>f,i,z\<^esub>) \<in>  fags_carr f z i a")
apply (simp add:fags_bpp_def)
 apply (subgoal_tac "n\<Odot>a\<^bsub>f,i,z\<^esub> = (THE na. n\<Odot>a\<^bsub>f,i,z\<^esub> = na\<Odot>a\<^bsub>f,i,z\<^esub>)\<Odot>a\<^bsub>f,i,z\<^esub>")
 apply (frule_tac m = "THE na. n\<Odot>a\<^bsub>f,i,z\<^esub> = na\<Odot>a\<^bsub>f,i,z\<^esub>" in
                  fag_single_free1 [of "f" "z" "i" "a" "n"], assumption+)
 apply (subgoal_tac "m\<Odot>a\<^bsub>f,i,z\<^esub> = (THE ma. m\<Odot>a\<^bsub>f,i,z\<^esub> = ma\<Odot>a\<^bsub>f,i,z\<^esub>)\<Odot>a\<^bsub>f,i,z\<^esub>")
 apply (frule_tac m = "THE ma. m\<Odot>a\<^bsub>f,i,z\<^esub> = ma\<Odot>a\<^bsub>f,i,z\<^esub>" in
                  fag_single_free1 [of f z i a m], assumption+)
 apply simp
 apply (rule theI', rule ex_ex1I, blast)
 apply (simp add:fag_single_free1 [of f z i a])
 apply (rule theI', rule ex_ex1I, blast)
 apply (simp add:fag_single_free1 [of f z i a])
apply (simp add:fags_carr_def, blast)
apply (simp add:fags_carr_def, blast)
done

definition
  fags :: "['a \<Rightarrow> 'a \<Rightarrow> 'a, 'a, 'a \<Rightarrow> 'a, 'a] \<Rightarrow> 'a aGroup" where
  "fags f z i a = \<lparr>carrier = fags_carr f z i a,
                   pop = fags_bpp f z i a,
                   mop = fags_ipp f z i a, zero = z\<rparr>"

lemma fags_ag:"fags_cond f z i a \<Longrightarrow> aGroup (fags f z i a)"
apply (rule aGroup.intro)
 apply (rule Pi_I)+
 apply (simp add:fags_def fags_carr_def)
 apply ((erule exE)+, simp)
  apply (simp add:fags_bppTr)
  apply blast

 apply (simp add:fags_def, simp add:fags_carr_def,
        (erule exE)+, simp)
 apply (simp add:fags_bppTr, simp add:add.assoc)

 apply (simp add:fags_def, simp add:fags_carr_def,
        (erule exE)+, simp)
 apply (simp add:fags_bppTr, simp add:add.commute)

 apply (rule Pi_I)
 apply (simp add:fags_def, simp add:fags_carr_def, erule exE, simp)
 apply (simp add:fags_ippTr, blast)

 apply (simp add:fags_def, simp add:fags_carr_def, erule exE, simp)
 apply (simp add:fags_ippTr fags_bppTr,
        simp add:fags_cond_def single_addition_zero[of f z i a])

 apply (simp add:fags_def fags_carr_def,
        simp add:fags_cond_def, (erule conjE)+,
        frule  single_addition_zero, assumption+, rotate_tac -1, frule sym,
        blast)

 apply (simp add:fags_def fags_carr_def, erule exE)
 apply (subgoal_tac "fags_bpp f z i a z aa = fags_bpp f z i a (0\<Odot>a\<^bsub>f,i,z\<^esub>) aa",
        simp add:fags_bppTr,
        thin_tac "aa = n\<Odot>a\<^bsub>f,i,z\<^esub>")
 apply (cut_tac single_addition_zero[of f z i a], simp)
  apply (simp add:fags_cond_def)+
done

section "Abelian Group generated by one element II (nonconstructive)"

definition
  ag_single_gen :: "[('a, 'm) aGroup_scheme, 'a] \<Rightarrow> bool" where
  "ag_single_gen A a \<longleftrightarrow> aGroup A \<and> carrier A = \<Inter> {H. asubGroup A H \<and> a \<in> H}"

primrec aSum :: "[('a, 'm) aGroup_scheme, nat,'a]  \<Rightarrow> 'a" where
  aSum_0: "aSum A 0 a = \<zero>\<^bsub>A\<^esub>"
| aSum_Suc: "aSum A (Suc n) a = aSum A n a \<plusminus>\<^bsub>A\<^esub> a"

definition
  sprod_n_a ::"[('a, 'm) aGroup_scheme, int, 'a]  \<Rightarrow> 'a" where
  "sprod_n_a A n x = (if 0 \<le> n then (aSum A (nat n) x)
                      else (aSum A (nat (- n)) (-\<^sub>a\<^bsub>A\<^esub> x)))"

abbreviation
  SPRODNA  ("(3_\<triangleright>_\<^bsub>_\<^esub>)" [95,95,96]95) where
  "n\<triangleright>a\<^bsub>A\<^esub> == sprod_n_a A n a"

lemma (in aGroup) asum_mem:"a \<in> carrier A \<Longrightarrow> aSum A n a \<in> carrier A"
apply (induct_tac n)
 apply simp apply (simp add:ag_inc_zero)
 apply simp
 apply (rule ag_pOp_closed, assumption+)
done

lemma (in aGroup) nt_mem0:"a \<in> carrier A \<Longrightarrow> n\<triangleright>a\<^bsub>A\<^esub> \<in> carrier A"
apply (case_tac "n = 0", simp add:sprod_n_a_def)
 apply (simp add:ag_inc_zero)
 apply (frule non_zero_int[of "n"])
 apply (case_tac "0 < n")
 apply (simp add:sprod_n_a_def)
 apply (simp add:asum_mem, thin_tac "n \<noteq> 0", simp)
apply (simp add:sprod_n_a_def)
 apply (rule asum_mem)
 apply (simp add:ag_mOp_closed)
done

lemma (in aGroup) nt_zero0:"a \<in> carrier A \<Longrightarrow> 0\<triangleright>a\<^bsub>A\<^esub> = \<zero>"
apply (simp add:sprod_n_a_def)
done

lemma (in aGroup) nt_1:"a \<in> carrier A \<Longrightarrow> 1\<triangleright>a\<^bsub>A\<^esub> = a"
apply (simp add:sprod_n_a_def)
apply (simp add:ag_l_zero)
done

lemma (in aGroup) asumTr:"a \<in> carrier A \<Longrightarrow>
              aSum A (n + m) a = aSum A n a \<plusminus> (aSum A m a)"
apply (induct_tac m)
 apply simp
 apply (frule asum_mem[of a n])
apply (rule ag_r_zero [THEN sym, of "aSum A n a"], assumption+)
 apply (subgoal_tac "n + Suc na = Suc (n + na)", simp)
 apply (rule ag_pOp_assoc)
 apply (simp add:asum_mem)+
done

lemma (in aGroup) aSum_zero:"a \<in> carrier A \<Longrightarrow> aSum A n \<zero> = \<zero>"
apply (induct_tac n)
 apply (simp, simp, rule ag_r_zero)
 apply (simp add:ag_inc_zero)
done

lemma (in aGroup)  agsum_add1p:"\<lbrakk> a \<in> carrier A; 0 \<le> n; 0 \<le> m\<rbrakk> \<Longrightarrow>
                      (n + m)\<triangleright>a\<^bsub>A\<^esub> = n\<triangleright>a\<^bsub>A\<^esub> \<plusminus> (m\<triangleright>a\<^bsub>A\<^esub>)"
apply (simp add:sprod_n_a_def)
apply (subst nat_add_distrib[of "n" "m"], assumption+)
apply (simp add:asumTr)
done

lemma (in aGroup)  agsum_add1m:"\<lbrakk> a \<in> carrier A; n < 0; m < 0\<rbrakk> \<Longrightarrow>
                      (n + m)\<triangleright>a\<^bsub>A\<^esub> = n\<triangleright>a\<^bsub>A\<^esub> \<plusminus> (m\<triangleright>a\<^bsub>A\<^esub>)"
apply (simp add:sprod_n_a_def)
 apply (subst zdiff)
 apply (subgoal_tac "0 \<le> -n") apply (thin_tac "n < 0")
 apply (subgoal_tac "0 \<le> -m") apply (thin_tac "m < 0")
 apply (subst nat_add_distrib [of "-n" "-m"], assumption+)
 apply (rule asumTr)
 apply (simp add:ag_mOp_closed) apply simp+
done

lemma (in aGroup) agsum_add2Tr:"a \<in> carrier A \<Longrightarrow>
                \<zero>  = aSum A n a \<plusminus> (aSum A n (-\<^sub>a a))"
apply (induct_tac n)
 apply simp
 apply (cut_tac ag_inc_zero)
 apply (simp add:ag_r_zero[THEN sym])
apply simp
 apply (frule  ag_mOp_closed[of a])
 apply (frule_tac n = n in asum_mem [of "-\<^sub>a a"])
 apply (frule_tac x = "aSum A n (-\<^sub>a a)" in ag_pOp_closed [of  _ "-\<^sub>a a"],
        assumption)
 apply (frule_tac n = n in asum_mem [of a])
 apply (subst ag_pOp_assoc[of  _ "a"], assumption+)
 apply (subst ag_pOp_assoc[THEN sym, of a _ "-\<^sub>a a"], assumption+)
 apply (subst ag_pOp_commute[of a], assumption+)
 apply (subst ag_pOp_assoc[of  _ a "-\<^sub>a a"], assumption+)
apply (frule sym) apply (thin_tac "\<zero> =  aSum A n a \<plusminus> (aSum A n (-\<^sub>a a))")
apply (simp add:ag_r_inv1[of a])
 apply (subst ag_r_zero, assumption+) apply simp
done

lemma (in aGroup) agsum_add2p:"\<lbrakk>a \<in> carrier A; 0 \<le> n\<rbrakk> \<Longrightarrow>
                                    \<zero> = n\<triangleright>a\<^bsub>A\<^esub> \<plusminus> ((-n)\<triangleright>a\<^bsub>A\<^esub>)"
apply (case_tac "n = 0")
 apply (simp add:sprod_n_a_def)
 apply (cut_tac ag_inc_zero)
 apply (simp add:ag_r_zero[THEN sym])
apply (frule non_zero_int[of "n"], thin_tac "n \<noteq> 0", simp)
 apply (subgoal_tac "-n < 0") prefer 2 apply simp
apply (simp add:sprod_n_a_def)
 apply (simp add:agsum_add2Tr)
done

lemma (in aGroup) agsum_add2m:"\<lbrakk>a \<in> carrier A; n < 0\<rbrakk> \<Longrightarrow>
                                    \<zero> = n\<triangleright>a\<^bsub>A\<^esub> \<plusminus> ((-n)\<triangleright>a\<^bsub>A\<^esub>)"
apply (simp add:sprod_n_a_def)
apply (subst ag_pOp_commute)
 apply (rule asum_mem)
 apply (simp add:ag_mOp_closed)
 apply (rule asum_mem, assumption+)
 apply (simp add:agsum_add2Tr)
done

lemma (in aGroup) agsum_add3pm:"\<lbrakk>a \<in> carrier A; 0 < n; m < 0\<rbrakk> \<Longrightarrow>
                        (n + m)\<triangleright>a\<^bsub>A\<^esub> = n\<triangleright>a\<^bsub>A\<^esub> \<plusminus> (m\<triangleright>a\<^bsub>A\<^esub>)"
apply (cut_tac less_linear[of n "- m"])
apply (case_tac "n = -m")
 apply simp
 apply (subst ag_pOp_commute)
 apply (simp add:nt_mem0)+
 apply (subgoal_tac "0\<triangleright>a\<^bsub>A\<^esub> = \<zero>") apply (simp add:agsum_add2m)
apply (simp add:sprod_n_a_def) apply simp
apply (case_tac "n < -m")
 apply (subst zminus_zadd_cancel[THEN sym, of "m" "n"])
 apply (subgoal_tac "-n < 0") prefer 2 apply simp  (** atode shiraberu **)
 apply (subgoal_tac "n + m < 0") prefer 2 apply simp  (** atode shiraberu *)
 apply simp
 apply (cut_tac agsum_add1m [of "a" "-n" "n + m"])
 apply simp
 apply (subst ag_pOp_assoc [THEN sym])
 apply (simp add:nt_mem0)+
 apply (subst agsum_add2p [THEN sym, of a n], assumption+)
 apply simp
 apply (rule ag_l_zero[THEN sym, of  "(n + m)\<triangleright>a\<^bsub>A\<^esub>"])
 apply (simp add:nt_mem0, assumption) apply arith apply assumption
 apply (thin_tac "n \<noteq> - m") apply simp
apply (subst zminus_zadd_cancel[THEN sym, of "n" "m"])
 apply (frule zminus_minus_pos[of m], frule zless_imp_zle[of 0 "- m"])
 apply (subgoal_tac "0 \<le> n + m") prefer 2 apply simp
 apply (frule agsum_add1p [of "a" "-m" "n + m"], assumption+)
 apply simp apply (thin_tac "n\<triangleright>a\<^bsub>A\<^esub> =  (- m)\<triangleright>a\<^bsub>A\<^esub> \<plusminus> (n + m)\<triangleright>a\<^bsub>A\<^esub>")
 apply (subst ag_pOp_commute[of "(- m)\<triangleright>a\<^bsub>A\<^esub>" "(n + m)\<triangleright>a\<^bsub>A\<^esub>"])
 apply (simp add:nt_mem0)+
 apply (subst ag_pOp_assoc)
 apply (simp add:nt_mem0)+
 apply (subst ag_pOp_commute [of "(- m)\<triangleright>a\<^bsub>A\<^esub>" "m\<triangleright>a\<^bsub>A\<^esub>"])
 apply (simp add:nt_mem0)+
 apply (simp add:agsum_add2m[THEN sym])
apply (rule ag_r_zero[THEN sym])
 apply (simp add:nt_mem0)
done

lemma (in aGroup)  agsum_add3mp:"\<lbrakk> a \<in> carrier A; n < 0; 0 < m\<rbrakk> \<Longrightarrow>
                        (n + m)\<triangleright>a\<^bsub>A\<^esub> = n\<triangleright>a\<^bsub>A\<^esub> \<plusminus> (m\<triangleright>a\<^bsub>A\<^esub>)"
apply (simp add:add.commute)
apply (subst ag_pOp_commute, (simp add:nt_mem0)+)
apply (simp add:agsum_add3pm)
done

lemma (in aGroup)  nt_sum0:"\<lbrakk> a \<in> carrier A\<rbrakk> \<Longrightarrow> (n + m)\<triangleright>a\<^bsub>A\<^esub> = n\<triangleright>a\<^bsub>A\<^esub> \<plusminus> (m\<triangleright>a\<^bsub>A\<^esub>)"
apply (cut_tac less_linear[of n 0])
 apply (case_tac "n < 0")
  apply (cut_tac less_linear[of m 0])
  apply (case_tac "m < 0", simp add:agsum_add1m, simp)
  apply (thin_tac "\<not> m < 0")
  apply (case_tac "m = 0", simp)
  apply (simp add:nt_zero0)
  apply (rule ag_r_zero[THEN sym], simp add:nt_mem0)
  apply (simp, simp add:agsum_add3mp, simp)
  apply (thin_tac "\<not> n < 0")
 apply (case_tac "n = 0", simp, simp add:nt_zero0)
  apply (rule ag_l_zero[THEN sym], simp add:nt_mem0)
  apply simp
  apply (cut_tac less_linear[of m 0])
  apply (case_tac "m < 0")
  apply (simp add:agsum_add3pm, simp, thin_tac "\<not> m < 0")
   apply (case_tac "m = 0", simp, simp add:nt_zero0)
   apply (rule ag_r_zero[THEN sym], simp add:nt_mem0)
   apply simp
  apply (simp add:agsum_add1p)
done

lemma (in aGroup)  nt_inv0:"a \<in> carrier A \<Longrightarrow> -\<^sub>a (n\<triangleright>a\<^bsub>A\<^esub>) = (- n)\<triangleright>a\<^bsub>A\<^esub>"
apply (subgoal_tac "(n + -n)\<triangleright>a\<^bsub>A\<^esub> = n\<triangleright>a\<^bsub>A\<^esub> \<plusminus> ((-n)\<triangleright>a\<^bsub>A\<^esub>)")
 prefer 2 apply (rule nt_sum0, assumption+) apply (simp add:nt_zero0)
 apply (subgoal_tac "-\<^sub>a (n\<triangleright>a\<^bsub>A\<^esub>) \<plusminus> \<zero> = -\<^sub>a (n\<triangleright>a\<^bsub>A\<^esub>) \<plusminus> (n\<triangleright>a\<^bsub>A\<^esub> \<plusminus> (- n)\<triangleright>a\<^bsub>A\<^esub>)")
 apply (subgoal_tac "n\<triangleright>a\<^bsub>A\<^esub> \<in> carrier A")
 apply (frule ag_mOp_closed [of "n\<triangleright>a\<^bsub>A\<^esub>"])
 apply (thin_tac "\<zero> =  n\<triangleright>a\<^bsub>A\<^esub> \<plusminus> (- n)\<triangleright>a\<^bsub>A\<^esub>")
 apply (simp add:ag_r_zero)
 apply (subgoal_tac "(- n)\<triangleright>a\<^bsub>A\<^esub> \<in> carrier A")
 apply (simp add:ag_pOp_assoc[THEN sym])
 apply (simp add:ag_l_inv1) apply (simp add:ag_l_zero)
 apply (simp add:nt_mem0)+
done

lemma (in aGroup) m_x_asum:"\<lbrakk> a \<in> carrier A; b \<in> carrier A\<rbrakk>
        \<Longrightarrow> aSum A m (a \<plusminus> b) = (aSum A m a) \<plusminus> (aSum A m b)"
apply (induct_tac m) apply simp
 apply (rule ag_r_zero[THEN sym])
 apply (simp add:ag_inc_zero)
 apply simp
 apply (frule_tac n = n in asum_mem[of "a"])
 apply (frule_tac n = n in asum_mem[of  "b"])
 apply (frule_tac a = "aSum A n a" and c = "aSum A n b" in
         pOp_assocTr43 [of  _ "a" _ "b"], assumption+) apply simp
 apply (frule_tac x = a and y = "aSum A n b" in ag_pOp_commute, assumption+)
 apply simp
 apply (simp add:pOp_assocTr43[THEN sym])
done

lemma (in aGroup) asum_multTr_pp:"a \<in> carrier A \<Longrightarrow>
                  aSum A m (aSum A n a) = aSum A (m * n) a"
apply (induct_tac n)
 apply simp
 apply (induct_tac m, simp)
 apply (simp, rule ag_r_zero, simp add:ag_inc_zero)
 apply simp
 apply (frule_tac n = n in asum_mem[of a])
 apply (frule_tac a = "aSum A n a" and b = a and m= m in m_x_asum,
                                           assumption+, simp)
 apply (frule_tac n = m and m = "m * n" in asumTr [of a])
 apply simp
 apply (frule_tac n = "m * n" in asum_mem[of a])
 apply (frule_tac n = m in asum_mem[of "a"])
 apply (simp add:ag_pOp_commute)
done

lemma (in aGroup) nt_mult_pp:"\<lbrakk> a \<in> carrier A; 0 \<le> m; 0 \<le> n\<rbrakk>
                                   \<Longrightarrow> m\<triangleright>(n\<triangleright>a\<^bsub>A\<^esub>)\<^bsub>A\<^esub> = (m * n)\<triangleright>a\<^bsub>A\<^esub>"
apply (simp add:sprod_n_a_def)
 apply (subgoal_tac "0 \<le> m * n", simp)
 apply (simp add:asum_multTr_pp)
 apply (simp add:nat_mult_distrib)
 apply (frule int_mult_le [of "0" "m" "n"], assumption+)
 apply (simp add:mult.commute)
done

lemma (in aGroup) asum_multTr_pm:"\<lbrakk>a \<in> carrier A; 0 \<le> m; n < 0\<rbrakk> \<Longrightarrow>
       aSum A (nat m) (aSum A (nat (- n)) (-\<^sub>a a)) =
                                    aSum A (nat (m * (- n))) (-\<^sub>a a)"
apply (frule ag_mOp_closed [of  a])
 apply (simp add:asum_multTr_pp)
 apply (subgoal_tac "nat m * nat (- n) = nat (- (m * n))", simp)
 apply (subgoal_tac "(nat m) * (nat (- n)) = nat (m * (- n))", simp)
 apply simp
apply (subst zmult_zminus_right[THEN sym, of "m" "n"])
 apply (rule nat_mult_distrib [THEN sym, of "m"], assumption+)
done

lemma (in aGroup) nt_mult_pm:"\<lbrakk>a \<in> carrier A; 0 \<le> m; n < 0\<rbrakk> \<Longrightarrow>
                        m\<triangleright>(n\<triangleright>a\<^bsub>A\<^esub>)\<^bsub>A\<^esub> = (m * n)\<triangleright>a\<^bsub>A\<^esub>"
apply (frule zmult_zle_mono1_neg [of "0" "m" "n"])
 apply (simp add:zless_imp_zle, simp)
 apply (simp add:sprod_n_a_def)
 apply (rule impI)
 apply (simp add: asum_multTr_pm)
done

lemma (in aGroup) asum_multTr_mp:"\<lbrakk>a \<in> carrier A; m < 0; 0 \<le> n\<rbrakk> \<Longrightarrow>
 aSum A (nat (-m))(-\<^sub>a (aSum A (nat n) a)) = aSum A (nat ((- m) * n)) (-\<^sub>a a)"
apply (frule asum_mem [of  "a" "nat n"])
apply (frule ag_mOp_closed [of  "aSum A (nat n) a"])
apply (simp add:sprod_n_a_def)
apply (subgoal_tac "-\<^sub>a (aSum A (nat n) a) = aSum A (nat n) (-\<^sub>a a)")
 apply simp
 apply (subst asum_multTr_pp)
 apply (simp add:ag_mOp_closed)
 apply (subgoal_tac "(nat (- m)) * (nat n) = nat ((- m) * n)", simp)
 apply (subst nat_mult_distrib, simp, simp)
 apply (frule nt_inv0 [of  "a" "n"])
 apply (simp add:sprod_n_a_def)
done

lemma (in aGroup) nt_mult_mp:"\<lbrakk>a \<in> carrier A; m < 0; 0 \<le> n\<rbrakk> \<Longrightarrow>
                        m\<triangleright>(n\<triangleright>a\<^bsub>A\<^esub>)\<^bsub>A\<^esub> = (m * n)\<triangleright>a\<^bsub>A\<^esub>"
apply (simp add:sprod_n_a_def)
 apply (cut_tac zless_imp_zle[of m 0])
 apply (frule int_mult_le [of "m" "0" "n"], assumption, simp)
 apply (case_tac "0 \<le> m * n", simp)
 apply (frule zle_imp_zless_or_eq [of "0" "m * n"])
 apply (thin_tac "0 \<le> m * n", simp add:zle mult.commute)
 apply (simp add:ag_inv_zero, simp add:aSum_zero)
apply simp
 apply (simp add:asum_multTr_mp)
 apply (simp add:zle_imp_zless_or_eq)
done

lemma (in aGroup) asum_multTr_mm:"\<lbrakk>a \<in> carrier A; m < 0; n < 0\<rbrakk> \<Longrightarrow>
       aSum A (nat (-m))(-\<^sub>a (aSum A (nat (- n)) (-\<^sub>a a))) =
                                   aSum A (nat ((- m) * (- n))) a"
apply (simp add:sprod_n_a_def)
apply (subgoal_tac "-\<^sub>a (aSum A (nat (- n)) (-\<^sub>a a)) = aSum A (nat (- n)) a")
 apply simp
 apply (simp add:asum_multTr_pp)
 apply (subst nat_mult_distrib[THEN sym]) apply simp
 apply simp
 apply (frule ag_mOp_closed [of  "a"])
 apply (frule nt_inv0 [of  "-\<^sub>a a" "- n"])
 apply (simp add:sprod_n_a_def)
 apply (simp add:ag_inv_inv)
done

lemma (in aGroup)  nt_mult_mm:"\<lbrakk> a \<in> carrier A; m < 0; n < 0\<rbrakk> \<Longrightarrow>
                     m\<triangleright>(n\<triangleright>a\<^bsub>A\<^esub>)\<^bsub>A\<^esub> = (m * n)\<triangleright>a\<^bsub>A\<^esub>"
apply (simp add:sprod_n_a_def)
apply (subgoal_tac "0 \<le> m * n") apply simp
 apply (simp add:asum_multTr_mm)
 apply (frule zmult_neg_neg[of "m" "n"], assumption+)
 apply (simp add:zle_imp_zless_or_eq)
done

lemma (in aGroup)  nt_mult_assoc0:"a \<in> carrier A \<Longrightarrow> m\<triangleright>n\<triangleright>a\<^bsub>A\<^esub>\<^bsub>A\<^esub> = (m * n)\<triangleright>a\<^bsub>A\<^esub>"
apply (case_tac "0 \<le> n")
 apply (case_tac "0 \<le> m")
  apply (simp add:nt_mult_pp,  simp add:zle)
  apply (frule nt_mult_mp[of a m n], assumption, simp, simp)
  apply (cut_tac less_linear[of 0 m])
 apply (case_tac "0 \<le> m")
 apply (simp add:nt_mult_pm)
apply (simp add:zle)
 apply (simp add:nt_mult_mm)
done

lemma (in aGroup) single_gen_carrTr:"a \<in> carrier A \<Longrightarrow>
                               asubGroup A {x. \<exists>n. x = (n\<triangleright>a\<^bsub>A\<^esub>)}"
apply (rule asubg_test)
 apply (rule subsetI, simp)
 apply (erule exE, simp add:nt_mem0)
 apply (simp, blast)
apply ((rule ballI)+, simp)
 apply (erule exE)+
 apply (simp add:nt_inv0)
 apply (subst nt_sum0[THEN sym], assumption+)
 apply blast
done

lemma (in aGroup) ag_single_inc_a:"ag_single_gen A a \<Longrightarrow> a \<in> carrier A"
apply (simp add:ag_single_gen_def)
done

lemma (in aGroup) single_gen:"ag_single_gen A a \<Longrightarrow>
                           carrier A = {g. \<exists>n. g = (n\<triangleright>a\<^bsub>A\<^esub>)}"
apply (rule equalityI)
 apply (frule ag_single_inc_a [of  "a"])
 apply (rule subsetI, simp)
apply (unfold ag_single_gen_def, erule conjE)
apply (frule single_gen_carrTr [of  "a"])
apply (subgoal_tac "a \<in> {x. \<exists>n. x = n\<triangleright>a\<^bsub>A\<^esub>}")
 apply (subgoal_tac "\<Inter>{H. A +> H \<and> a \<in> H} \<subseteq> {x. \<exists>n. x = n\<triangleright>a\<^bsub>A\<^esub>}")
 apply (frule_tac A = "\<Inter>{H. A +> H \<and> a \<in> H}" and B = "{x. \<exists>n. x = n\<triangleright>a\<^bsub>A\<^esub>}" and
         c = x in  subsetD)
 apply (frule sym, thin_tac "carrier A = \<Inter>{H. A +> H \<and> a \<in> H}")
 apply (simp, simp)
 apply (thin_tac "carrier A = \<Inter>{H. A +> H \<and> a \<in> H}")
 apply (rule subsetI, blast)
apply (thin_tac "carrier A = \<Inter>{H. A +> H \<and> a \<in> H}",
       thin_tac "A +> {x. \<exists>n. x = n\<triangleright>a\<^bsub>A\<^esub>}")
 apply (subgoal_tac "a = 1\<triangleright>a\<^bsub>A\<^esub>", blast)
 apply (simp add:sprod_n_a_def, simp add:ag_l_zero[THEN sym])
apply (fold ag_single_gen_def)
  apply (frule ag_single_inc_a [of  "a"])
 apply (unfold ag_single_gen_def)
 apply (erule conjE)
 apply (thin_tac "carrier A = \<Inter>{H. A +> H \<and> a \<in> H}")
 apply (rule subsetI, simp)
 apply (erule exE)
 apply (simp, simp add:nt_mem0)
done

definition
  single_gen_free :: "[('a, 'm) aGroup_scheme, 'a] \<Rightarrow> bool" where
  "single_gen_free A a == \<forall>n. n \<noteq> 0 \<longrightarrow> \<zero>\<^bsub>A\<^esub> \<noteq> n\<triangleright>a\<^bsub>A\<^esub>"

definition
  sfg :: "[('a, 'm) aGroup_scheme, 'a] \<Rightarrow> bool" where
  "sfg A a \<longleftrightarrow> ag_single_gen A a \<and> single_gen_free A a"
  (** single free generated by a **)

lemma (in aGroup) single_gen_free_neg:"\<lbrakk>sfg A a; n\<triangleright>a\<^bsub>A\<^esub> = \<zero>\<rbrakk> \<Longrightarrow> n = 0"
apply (simp add:sfg_def, erule conjE)
apply (rule contrapos_pp, simp+)
apply (simp add:single_gen_free_def)
 apply (drule_tac a = n in forall_spec, simp)
 apply simp
done

lemma (in aGroup) sfg_G_inc_a:"sfg A a \<Longrightarrow> a \<in> carrier A"
apply (simp add:sfg_def ag_single_inc_a)
done

lemma sfg_agroup:"sfg A a \<Longrightarrow> aGroup A"
apply (simp add:sfg_def ag_single_gen_def)
done

lemma (in aGroup) mem_G_nt:"\<lbrakk>sfg A a; x \<in> carrier A\<rbrakk> \<Longrightarrow> \<exists>n. x = n\<triangleright>a\<^bsub>A\<^esub>"
apply (simp add:sfg_def)  apply (erule conjE)
 apply (frule single_gen [of  "a"]) apply simp
done

lemma (in aGroup) nt_mem:"sfg A a \<Longrightarrow> n\<triangleright>a\<^bsub>A\<^esub> \<in> carrier A"
apply (frule sfg_G_inc_a)
apply (frule sfg_agroup)
apply (simp add:nt_mem0)
done

lemma (in aGroup) nt_zero:"sfg A a \<Longrightarrow> 0\<triangleright>a\<^bsub>A\<^esub> = \<zero>"
apply (frule sfg_G_inc_a)
apply (frule sfg_agroup)
apply (simp add:nt_zero0)
done

lemma (in aGroup) nt_sum:"sfg A a \<Longrightarrow> (n + m)\<triangleright>a\<^bsub>A\<^esub> = n\<triangleright>a\<^bsub>A\<^esub> \<plusminus> (m\<triangleright>a\<^bsub>A\<^esub>)"
apply (frule sfg_G_inc_a)
apply (frule sfg_agroup)
apply (simp add:nt_sum0)
done

lemma (in aGroup) nt_inv:"sfg A a \<Longrightarrow> -\<^sub>a(n\<triangleright>a\<^bsub>A\<^esub>) = (- n)\<triangleright>a\<^bsub>A\<^esub>"
apply (frule sfg_G_inc_a)
apply (frule sfg_agroup)
apply (simp add:nt_inv0)
done

lemma (in aGroup) nt_mult_assoc:"sfg A a \<Longrightarrow> m\<triangleright>n\<triangleright>a\<^bsub>A\<^esub>\<^bsub>A\<^esub> = (m * n)\<triangleright>a\<^bsub>A\<^esub>"
apply (frule sfg_G_inc_a)
apply (frule sfg_agroup )
apply (simp add:nt_mult_assoc0)
done

lemma (in aGroup) sfg_free:"\<lbrakk>sfg A a; n \<noteq> m \<rbrakk> \<Longrightarrow> n\<triangleright>a\<^bsub>A\<^esub> \<noteq> (m\<triangleright>a\<^bsub>A\<^esub>)"
apply (rule contrapos_pp, simp+)
apply (frule sfg_G_inc_a)
apply (frule sfg_agroup )
 apply (frule nt_mem [of  "a" "m"])
 apply (frule nt_mem [of  "a" "n"])
 apply (subgoal_tac "n\<triangleright>a\<^bsub>A\<^esub> \<plusminus> (-\<^sub>a (m\<triangleright>a\<^bsub>A\<^esub>)) = \<zero>")
 apply (thin_tac "n\<triangleright>a\<^bsub>A\<^esub> = m\<triangleright>a\<^bsub>A\<^esub>")  (*  remove this equation *)
 apply (simp add:nt_inv)
 apply (simp add:nt_sum[THEN sym])
 apply (frule single_gen_free_neg[of  "a" "n - m"], assumption+)
 apply simp
apply (simp add:ag_r_inv1)
done

lemma (in aGroup) sfg_free_inj:"\<lbrakk>sfg A a; n\<triangleright>a\<^bsub>A\<^esub> = (m\<triangleright>a\<^bsub>A\<^esub>) \<rbrakk> \<Longrightarrow> n = m"
apply (rule contrapos_pp, simp+)
apply (simp add:sfg_free)
done

section "Free Generated Modules (constructive)"

definition
  sop_one::"[('r, 'm) Ring_scheme, 'r \<Rightarrow> 'a \<Rightarrow> 'a, 'a set] \<Rightarrow> bool" where
  "sop_one R s A \<longleftrightarrow> (\<forall>x\<in>A. (1\<^sub>r\<^bsub>R\<^esub>) \<^sub>s\<cdot> x = x)"

definition
  sop_assoc :: "[('r, 'm) Ring_scheme, 'r \<Rightarrow> 'a \<Rightarrow> 'a, 'a set] \<Rightarrow> bool" where
  "sop_assoc R s A \<longleftrightarrow> (\<forall>a\<in>carrier R. \<forall>b\<in>carrier R. \<forall>x\<in>A.
                         (a \<cdot>\<^sub>r\<^bsub>R\<^esub> b) \<^sub>s\<cdot> x = a \<^sub>s\<cdot> (b \<^sub>s\<cdot> x))"

definition
  sop_inv :: "[('r, 'm) Ring_scheme, 'r \<Rightarrow> 'a \<Rightarrow> 'a, 'a \<Rightarrow> 'a, 'a set]
      \<Rightarrow> bool" where
  "sop_inv R s i A \<longleftrightarrow> (\<forall>r\<in>carrier R. \<forall>x\<in>A. r \<^sub>s\<cdot> (\<^sub>i- x) = (-\<^sub>a\<^bsub>R\<^esub> r) \<^sub>s\<cdot> x)"

definition
  sop_distr1 :: "[('r, 'm) Ring_scheme, 'r \<Rightarrow> 'a \<Rightarrow> 'a, 'a \<Rightarrow> 'a \<Rightarrow> 'a,
    'a \<Rightarrow> 'a, 'a set, 'a] \<Rightarrow> bool" where
  "sop_distr1 R s f i A z \<longleftrightarrow> (\<forall>a\<in>carrier R. \<forall>b\<in>carrier R.
          \<forall>x\<in>(aug_pm_set z i A). (a \<plusminus>\<^bsub>R\<^esub> b) \<^sub>s\<cdot> x = (a \<^sub>s\<cdot> x) \<^sub>f+ (b \<^sub>s\<cdot> x))"

definition
  sop_distr2 :: "[('r, 'm) Ring_scheme, 'r \<Rightarrow> 'a \<Rightarrow> 'a, 'a \<Rightarrow> 'a \<Rightarrow> 'a,
                'a \<Rightarrow> 'a, 'a set, 'a] \<Rightarrow> bool" where
  "sop_distr2 R s f i A z \<longleftrightarrow> (\<forall>a\<in>carrier R.
         \<forall>x\<in>addition_set f (aug_pm_set z i A).
           \<forall>y\<in>addition_set f (aug_pm_set z i A).
                 a \<^sub>s\<cdot> (x \<^sub>f+ y) = (a \<^sub>s\<cdot> x) \<^sub>f+ (a \<^sub>s\<cdot> y))"

definition
  sop_z :: "[('r, 'm) Ring_scheme, 'r \<Rightarrow> 'a \<Rightarrow> 'a, 'a] \<Rightarrow> bool" where
  "sop_z R s z \<longleftrightarrow> (\<forall>r\<in>carrier R. r \<^sub>s\<cdot> z = z)"

definition
  fgmodule :: "[('r, 'm) Ring_scheme, 'a set, 'a, 'a \<Rightarrow> 'a, 'a \<Rightarrow> 'a \<Rightarrow> 'a,
      'r \<Rightarrow> 'a \<Rightarrow> 'a] \<Rightarrow> ('a, 'r) Module" where
  "fgmodule R A z i f s =
     \<lparr>carrier = addition_set f (aug_pm_set z i (s_set R s A)),
       pop = \<lambda>x\<in>addition_set f (aug_pm_set z i (s_set R s A)).
               \<lambda>y\<in>addition_set f (aug_pm_set z i (s_set R s A)). x \<^sub>f+ y,
       mop = \<lambda>x\<in>addition_set f (aug_pm_set z i (s_set R s A)). \<^sub>i- x,
       zero = z,
       sprod = \<lambda>r\<in>carrier R.
                 \<lambda>x\<in>addition_set f (aug_pm_set z i (s_set R s A)). r \<^sub>s\<cdot> x \<rparr>"

lemma fgmodule_carr:"carrier (fgmodule R A z i f s) =
             addition_set f (aug_pm_set z i (s_set R s A))"
by (simp add:fgmodule_def)

lemma a_in_s_set:"a \<in> A \<Longrightarrow> a \<in> s_set R s A"
by (simp add:s_set_def)

lemma (in Ring) ra_in_s_set:"\<lbrakk>r \<in> carrier R; a \<in> A\<rbrakk> \<Longrightarrow> r \<^sub>s\<cdot> a \<in> s_set R s A"
by (simp add:s_set_def, blast)

lemma in_aug_pm_set:
       "x \<in> aug_pm_set z i A = (x = z \<or> x \<in> A \<or> x \<in> minus_set i A)"
by (simp add:aug_pm_set_def)

lemma (in Ring) in_s_set:"x \<in> s_set R s A \<Longrightarrow> (\<exists>r \<in> carrier R. \<exists>a \<in> A.
      x = r \<^sub>s\<cdot> a ) \<or> x \<in> A"
by (simp add:s_set_def)

lemma (in Ring) sop_closedTr0:"\<lbrakk>ipp_cond1 (s_set R s A) i;
       ipp_cond2 z (s_set R s A) i f; ipp_cond3 z i;
       inv_ipp z i f (s_set R s A); zeroA z i f (s_set R s A) z;
       sop_distr2 R s f i (s_set R s A) z;
       sop_assoc R s (aug_pm_set z i (s_set R s A));
       sop_inv R s i (s_set R s A);
       sop_one R s (aug_pm_set z i (s_set R s A)); sop_z R s z;
       r \<in> carrier R; x \<in> aug_pm_set z i (s_set R s A)\<rbrakk> \<Longrightarrow>
                        r \<^sub>s\<cdot> x \<in> aug_pm_set z i (s_set R s A)"
apply (simp add:in_aug_pm_set)
apply (case_tac "x = z", simp, simp add:sop_z_def)

apply (case_tac "x \<in> s_set R s A", simp add:s_set_def, fold s_set_def)
 apply (case_tac "x \<in> A", simp, blast)

apply simp
apply ((erule bexE)+, simp)
 apply (simp add:sop_assoc_def)
 apply (drule_tac x = r in bspec, assumption,
        drule_tac x = ra in bspec, assumption,
        frule_tac x = a in bspec,
        subst in_aug_pm_set, simp add:a_in_s_set)
 apply (rotate_tac -1, frule sym, thin_tac "r \<cdot>\<^sub>r ra \<^sub>s\<cdot> a = r \<^sub>s\<cdot> (ra \<^sub>s\<cdot> a)",
        simp)
 apply (frule_tac x = r and y = ra in ring_tOp_closed, assumption+, blast)

apply simp apply (thin_tac "x \<noteq> z", thin_tac "x \<notin> s_set R s A")
apply (simp add:minus_set_def, erule bexE, simp)
 apply (simp add:sop_inv_def[of R s i "s_set R s A"])
 apply (cut_tac ring_is_ag,
        frule_tac x = r in aGroup.ag_mOp_closed[of R], assumption)
 apply (frule_tac a = y in ra_in_s_set[of "-\<^sub>a r" _ "s_set R s A" s],
         assumption+)
 apply (frule_tac x = y in in_s_set[of _ s "A"])
 apply (case_tac "y \<in> A", simp, simp add:ra_in_s_set)

apply simp apply ((erule bexE)+, simp)
 apply (simp add:sop_assoc_def)
 apply (drule_tac x = "-\<^sub>a r" in bspec, assumption,
        thin_tac "\<forall>r\<in>carrier R. \<forall>x\<in>s_set R s A. r \<^sub>s\<cdot> (\<^sub>i- x) = (-\<^sub>a r) \<^sub>s\<cdot> x",
        drule_tac x = ra in bspec, assumption,
        drule_tac x = a in bspec,
                simp add:aug_pm_set_def, simp add:a_in_s_set)
 apply (rotate_tac -1, frule sym,
              thin_tac "(-\<^sub>a r) \<cdot>\<^sub>r ra \<^sub>s\<cdot> a = (-\<^sub>a r) \<^sub>s\<cdot> (ra \<^sub>s\<cdot> a)", simp,
        frule_tac x = "-\<^sub>a r" and y = ra in ring_tOp_closed, assumption,
              simp add:ra_in_s_set)
done

lemma (in Ring) sop_closedTr:"\<lbrakk>ipp_cond1 (s_set R s A) i;
    ipp_cond2 z (s_set R s A) i f; ipp_cond3 z i;
     inv_ipp z i f (s_set R s A); zeroA z i f (s_set R s A) z;
      sop_distr2 R s f i (s_set R s A) z;
       sop_assoc R s (aug_pm_set z i (s_set R s A));
        sop_inv R s i (s_set R s A);
         sop_one R s (aug_pm_set z i (s_set R s A)); sop_z R s z\<rbrakk> \<Longrightarrow>
    \<forall>r\<in>carrier R. \<forall>x\<in>add_set f (aug_pm_set z i (s_set R s A)) n.
                  r \<^sub>s\<cdot> x \<in> add_set f (aug_pm_set z i (s_set R s A)) n"
apply (induct_tac n)
 apply (simp, (rule ballI)+, simp add:sop_closedTr0)

apply (rule ballI)+ apply simp
 apply (erule bexE)+
 apply (frule_tac r = r and x = t in sop_closedTr0 [of s A i z f],
         assumption+)

 apply (subgoal_tac "sa \<in> addition_set f (aug_pm_set z i (s_set R s A))")
 apply (subgoal_tac "t \<in> addition_set f (aug_pm_set z i (s_set R s A))")
 apply (simp add:sop_distr2_def) apply blast
 apply (cut_tac addition_inc_add0[of "aug_pm_set z i (s_set R s A)" f])
 apply (simp add:subsetD)
 apply (cut_tac n = n in addition_inc_add[of f
                                         "aug_pm_set z i (s_set R s A)"])
 apply (simp add:subsetD)
done

lemma (in Ring) sop_closed:"\<lbrakk>ipp_cond1 (s_set R s A) i;
     ipp_cond2 z (s_set R s A) i f; ipp_cond3 z i;
      inv_ipp z i f (s_set R s A); zeroA z i f (s_set R s A) z;
       sop_distr2 R s f i (s_set R s A) z;
        sop_assoc R s (aug_pm_set z i (s_set R s A));
         sop_inv R s i (s_set R s A);
          sop_one R s (aug_pm_set z i (s_set R s A)); sop_z R s z\<rbrakk> \<Longrightarrow>
     \<forall>r\<in>carrier R. \<forall>x\<in>addition_set f (aug_pm_set z i (s_set R s A)).
          r \<^sub>s\<cdot> x \<in> addition_set f (aug_pm_set z i (s_set R s A))"
apply (subst addition_set_def)
 apply simp
 apply (rule ballI) apply (rule allI) apply (rule impI)
 apply (erule exE)
 apply (rule ballI) apply simp
 apply (thin_tac "y = add_set f (aug_pm_set z i (s_set R s A)) n")
 apply (frule_tac n = n in sop_closedTr[of s A i z f], assumption+)
 apply (drule_tac x = r in bspec, assumption,
        drule_tac x = x in bspec, assumption)

 apply (cut_tac n = n in addition_inc_add [of f
                                  "aug_pm_set z i (s_set R s A)"],
        simp add:subsetD)
done

lemma (in Ring) sop_oneTr:"\<lbrakk>commute_bpp f (aug_pm_set z i (s_set R s A));
  assoc_bpp (aug_pm_set z i (s_set R s A)) f;
   ipp_cond1 (s_set R s A) i; ipp_cond2 z (s_set R s A) i f;
    ipp_cond3 z i; inv_ipp z i f (s_set R s A); zeroA z i f (s_set R s A) z;
     sop_distr2 R s f i (s_set R s A) z;
      sop_assoc R s (aug_pm_set z i (s_set R s A));
       sop_one R s (aug_pm_set z i (s_set R s A))\<rbrakk>  \<Longrightarrow>
   \<forall>x\<in>add_set f (aug_pm_set z i (s_set R s A)) n.  (1\<^sub>r) \<^sub>s\<cdot> x = x"
apply (induct_tac n)
 apply (rule ballI, simp, simp add:sop_one_def)

apply (rule ballI)
 apply (simp, (erule bexE)+, simp)
 apply (subgoal_tac "t \<in> addition_set f (aug_pm_set z i (s_set R s A))")
 apply (subgoal_tac "sa \<in> addition_set f (aug_pm_set z i (s_set R s A))")
 apply (cut_tac ring_one)
 apply (simp add:sop_distr2_def)
 apply (thin_tac "\<forall>x\<in>add_set f (aug_pm_set z i (s_set R s A)) n. (1\<^sub>r) \<^sub>s\<cdot> x
                       = x") apply (simp add:sop_one_def)
 apply (cut_tac n = n in addition_inc_add[of f
                     "aug_pm_set z i (s_set R s A)"], simp add:subsetD,
        cut_tac addition_inc_add0[of "aug_pm_set z i (s_set R s A)" f],
                           simp add:subsetD)
done

lemma (in Ring) sop_one:"\<lbrakk>commute_bpp f (aug_pm_set z i (s_set R s A));
   assoc_bpp (aug_pm_set z i (s_set R s A)) f; ipp_cond1 (s_set R s A) i;
    ipp_cond2 z (s_set R s A) i f; ipp_cond3 z i;
     inv_ipp z i f (s_set R s A); zeroA z i f (s_set R s A) z;
      sop_distr2 R s f i (s_set R s A) z;
       sop_assoc R s (aug_pm_set z i (s_set R s A));
        sop_one R s (aug_pm_set z i (s_set R s A))\<rbrakk>  \<Longrightarrow>
   \<forall>x\<in>addition_set f (aug_pm_set z i (s_set R s A)). (1\<^sub>r) \<^sub>s\<cdot> x = x"
apply (rule ballI) apply (simp add:addition_set_def)
apply (erule exE, erule conjE, erule exE, simp,
       thin_tac "xa = add_set f (aug_pm_set z i (s_set R s A)) n")
apply (simp add:sop_oneTr)
done

lemma (in Ring) sop_assocTr:"\<lbrakk>ipp_cond1 (s_set R s A) i;
      ipp_cond2 z (s_set R s A) i f; ipp_cond3 z i;
      inv_ipp z i f (s_set R s A); zeroA z i f (s_set R s A) z;
      sop_distr2 R s f i (s_set R s A) z;
      sop_assoc R s (aug_pm_set z i (s_set R s A));
      sop_inv R s i (s_set R s A);
      sop_one R s (aug_pm_set z i (s_set R s A)); sop_z R s z\<rbrakk>  \<Longrightarrow>
     \<forall>a\<in>carrier R. \<forall>b\<in>carrier R.
      \<forall>x\<in>add_set f (aug_pm_set z i (s_set R s A)) n.
                         a \<^sub>s\<cdot> ( b \<^sub>s\<cdot> x) = (a \<cdot>\<^sub>r b) \<^sub>s\<cdot> x"
apply (induct_tac n)
apply (rule ballI)+
apply (simp add:sop_assoc_def)
apply (rule ballI)+ apply simp
apply (erule bexE)+
 apply (drule_tac x = a in bspec, assumption,
        drule_tac x = b in bspec, assumption,
        drule_tac x = sa in bspec, assumption)

 apply simp
 apply (cut_tac n = n in addition_inc_add[of f
                     "aug_pm_set z i (s_set R s A)"],
        cut_tac addition_inc_add0[of "aug_pm_set z i (s_set R s A)" f])
 apply (frule_tac c = sa and A = "add_set f (aug_pm_set z i (s_set R s A)) n"
         in subsetD[of _ "addition_set f (aug_pm_set z i (s_set R s A))"],
         assumption+,
        frule_tac c = t in subsetD[of "aug_pm_set z i (s_set R s A)"
         "addition_set f (aug_pm_set z i (s_set R s A))"], assumption+,
        frule_tac x = a and y = b in  ring_tOp_closed, assumption+)
 apply (simp add:sop_distr2_def[of R s f i "s_set R s A" z])
 apply (frule sop_closed[of s A i z f], assumption+, simp add:sop_distr2_def,
        assumption+, rotate_tac -1)
 apply (drule_tac x = b in bspec, assumption,
        rotate_tac -1,
        frule_tac x = sa in bspec, assumption,
        drule_tac x = t in bspec, assumption)
  apply (simp,
        thin_tac "\<forall>a\<in>carrier R.
           \<forall>x\<in>addition_set f (aug_pm_set z i (s_set R s A)).
              \<forall>y\<in>addition_set f (aug_pm_set z i (s_set R s A)).
                 a \<^sub>s\<cdot> (x \<^sub>f+ y) = a \<^sub>s\<cdot> x \<^sub>f+ a \<^sub>s\<cdot> y")
  apply (simp add:sop_assoc_def)
done

lemma (in Ring) sop_assoc:"\<lbrakk>ipp_cond1 (s_set R s A) i;
    ipp_cond2 z (s_set R s A) i f; ipp_cond3 z i;
     inv_ipp z i f (s_set R s A); zeroA z i f (s_set R s A) z;
      sop_distr2 R s f i (s_set R s A) z;
       sop_assoc R s (aug_pm_set z i (s_set R s A));
        sop_inv R s i (s_set R s A); sop_z R s z;
         sop_one R s (aug_pm_set z i (s_set R s A))\<rbrakk> \<Longrightarrow>
   \<forall>a\<in>carrier R. \<forall>b\<in>carrier R.
      \<forall>x\<in>addition_set f (aug_pm_set z i (s_set R s A)).
                           a \<^sub>s\<cdot> (b \<^sub>s\<cdot> x) = ( a \<cdot>\<^sub>r b) \<^sub>s\<cdot> x"
apply (rule ballI)+ apply (simp add:addition_set_def)
 apply (erule exE, erule conjE, erule exE, simp)
 apply (simp add:sop_assocTr)
done

lemma (in Ring) s_set_commute:"\<lbrakk>commute_bpp f (aug_pm_set z i (s_set R s A));
       x \<in> addition_set f (aug_pm_set z i (s_set R s A));
        y \<in> addition_set f (aug_pm_set z i (s_set R s A))\<rbrakk> \<Longrightarrow>
               x \<^sub>f+ y = y \<^sub>f+ x"
apply (simp add:commute_bpp_def)
done

lemma (in Ring) add_s_set_inc_add_set:"
      add_set f (aug_pm_set z i A) n \<subseteq>
             add_set f (aug_pm_set z i (s_set R s A)) n"
apply (rule add_set_mono[of "aug_pm_set z i A"
                            "aug_pm_set z i (s_set R s A)" f n])
apply (rule subsetI, simp add:aug_pm_set_def s_set_def)
apply (case_tac "x = z", simp)
 apply (case_tac "x \<in> A", simp)

 apply simp
 apply (simp add:minus_set_def, erule bexE)
 apply blast
done

lemma (in Ring) sop_distr1Tr:"\<lbrakk>commute_bpp f (aug_pm_set z i (s_set R s A));
    assoc_bpp (aug_pm_set z i (s_set R s A)) f; ipp_cond1 (s_set R s A) i;
     ipp_cond2 z (s_set R s A) i f; ipp_cond3 z i;
      inv_ipp z i f (s_set R s A); zeroA z i f (s_set R s A) z;
       sop_distr1 R s f i (s_set R s A) z;
        sop_distr2 R s f i (s_set R s A) z;
         sop_assoc R s (aug_pm_set z i (s_set R s A));
          sop_inv R s i (s_set R s A);
           sop_one R s (aug_pm_set z i (s_set R s A)); sop_z R s z\<rbrakk>  \<Longrightarrow>
 \<forall>a\<in>carrier R. \<forall>b\<in>carrier R. \<forall>x\<in> add_set f (aug_pm_set z i (s_set R s A)) n.
          (a \<plusminus> b) \<^sub>s\<cdot> x = a \<^sub>s\<cdot> x \<^sub>f+ (b \<^sub>s\<cdot> x)"
apply (induct_tac n)
 apply ((rule ballI)+, simp add:sop_distr1_def)

apply (rule ballI)+ apply simp
 apply (erule bexE)+
 apply (cut_tac ring_is_ag,
        frule_tac x = a and y = b in aGroup.ag_pOp_closed [of "R"],
        assumption+)
  apply (cut_tac n = n in addition_inc_add[of f
                     "aug_pm_set z i (s_set R s A)"],
        cut_tac addition_inc_add0[of "aug_pm_set z i (s_set R s A)" f])
 apply (frule_tac c = sa and A = "add_set f (aug_pm_set z i (s_set R s A)) n"
         in subsetD[of _ "addition_set f (aug_pm_set z i (s_set R s A))"],
         assumption+,
        frule_tac c = t in subsetD[of "aug_pm_set z i (s_set R s A)"
         "addition_set f (aug_pm_set z i (s_set R s A))"], assumption+,
        frule_tac x = a and y = b in  ring_tOp_closed, assumption+)
 apply simp
 apply (simp add:sop_distr2_def sop_distr1_def)
 apply (frule sop_closed[of s A i z f], assumption+,
        simp add:sop_distr2_def, simp add:sop_assoc_def, assumption+)
 apply (rotate_tac -1,
        frule_tac x = a in bspec, assumption,
        rotate_tac -1,
        frule_tac x = sa in bspec, assumption,
        drule_tac x = t in bspec, assumption)
  apply (frule_tac x = b in bspec, assumption,
        rotate_tac -1,
        frule_tac x = sa in bspec, assumption,
        drule_tac x = t in bspec, assumption,
        thin_tac "\<forall>r\<in>carrier R.
           \<forall>x\<in>addition_set f (aug_pm_set z i (s_set R s A)).
              r \<^sub>s\<cdot> x \<in> addition_set f (aug_pm_set z i (s_set R s A))")
apply (frule_tac x = "a \<^sub>s\<cdot> t" and y = "b \<^sub>s\<cdot> t" in
       bpp_closed [of "(aug_pm_set z i (s_set R s A))" "f"], assumption+)
apply (subst addition_assoc, assumption+)
 apply (frule_tac ?x1 = "b \<^sub>s\<cdot> sa" and  ?y1 = "a \<^sub>s\<cdot> t" and ?z1 = "b \<^sub>s\<cdot> t" in
          addition_assoc[THEN sym, of "aug_pm_set z i (s_set R s A)" f],
          assumption+, simp,
        thin_tac "b \<^sub>s\<cdot> sa \<^sub>f+ (a \<^sub>s\<cdot> t \<^sub>f+ b \<^sub>s\<cdot> t) = b \<^sub>s\<cdot> sa \<^sub>f+ a \<^sub>s\<cdot> t \<^sub>f+ b \<^sub>s\<cdot> t")
 apply (frule_tac x = "b \<^sub>s\<cdot> sa" and y = "a \<^sub>s\<cdot> t" in
           s_set_commute[of f z i s A], assumption+, simp)
 apply (frule_tac x = "a \<^sub>s\<cdot> t" and y = "b \<^sub>s\<cdot> sa" and z = "b \<^sub>s\<cdot> t" in
          addition_assoc[of "aug_pm_set z i (s_set R s A)" f],
          assumption+, simp,
        thin_tac "a \<^sub>s\<cdot> t \<^sub>f+ b \<^sub>s\<cdot> sa \<^sub>f+ b \<^sub>s\<cdot> t = a \<^sub>s\<cdot> t \<^sub>f+ (b \<^sub>s\<cdot> sa \<^sub>f+ b \<^sub>s\<cdot> t)",
        frule_tac x = "b \<^sub>s\<cdot> sa" and y = "b \<^sub>s\<cdot> t" in
        bpp_closed [of "(aug_pm_set z i (s_set R s A))" "f"], assumption+,
        subst addition_assoc, assumption+, simp)
done

lemma (in Ring) sop_distr1:"\<lbrakk>commute_bpp f (aug_pm_set z i (s_set R s A));
      assoc_bpp (aug_pm_set z i (s_set R s A)) f; ipp_cond1 (s_set R s A) i;
       ipp_cond2 z (s_set R s A) i f; ipp_cond3 z i;
        inv_ipp z i f (s_set R s A); zeroA z i f (s_set R s A) z;
         sop_distr1 R s f i (s_set R s A) z;
          sop_distr2 R s f i (s_set R s A) z;
           sop_assoc R s (aug_pm_set z i (s_set R s A));
            sop_inv R s i (s_set R s A);
             sop_one R s (aug_pm_set z i (s_set R s A)); sop_z R s z\<rbrakk>  \<Longrightarrow>
      \<forall>a\<in>carrier R. \<forall>b\<in>carrier R.
         \<forall>x\<in> addition_set f (aug_pm_set z i (s_set R s A)).
                      (a \<plusminus> b) \<^sub>s\<cdot> x = a \<^sub>s\<cdot> x \<^sub>f+ (b \<^sub>s\<cdot> x)"
apply (rule ballI)+
 apply (simp add:addition_set_def)
 apply (erule exE, erule conjE, erule exE, simp,
        thin_tac "xa = add_set f (aug_pm_set z i (s_set R s A)) n")
apply (simp add:sop_distr1Tr)
done

definition
  fgmodule_condition ::"[('r, 'm) Ring_scheme, 'a \<Rightarrow> 'a \<Rightarrow> 'a, 'a \<Rightarrow> 'a,
         'r \<Rightarrow> 'a \<Rightarrow> 'a, 'a set, 'a] \<Rightarrow> bool" where
  "fgmodule_condition R f i s A z \<longleftrightarrow>
    commute_bpp f (aug_pm_set z i (s_set R s A)) \<and>
      assoc_bpp (aug_pm_set z i (s_set R s A)) f \<and>
       ipp_cond1 (s_set R s A) i \<and> ipp_cond2 z (s_set R s A) i f \<and>
        ipp_cond3 z i \<and> inv_ipp z i f (s_set R s A) \<and>
         zeroA z i f (s_set R s A) z \<and> sop_distr1 R s f i (s_set R s A) z \<and>
          sop_distr2 R s f i (s_set R s A) z \<and>
           sop_assoc R s (aug_pm_set z i (s_set R s A)) \<and>
          sop_inv R s i (s_set R s A) \<and>
         sop_one R s (aug_pm_set z i (s_set R s A)) \<and> sop_z R s z"

lemma (in Ring) sop_closed1:"\<lbrakk>fgmodule_condition R f i s A z; r \<in> carrier R;
      x \<in> addition_set f (aug_pm_set z i (s_set R s A))\<rbrakk> \<Longrightarrow>
          r \<^sub>s\<cdot> x \<in> addition_set f (aug_pm_set z i (s_set R s A))"
apply(simp add:fgmodule_condition_def, (erule conjE)+)
 apply (simp add:sop_closed)
done

lemma (in Ring) fgmodule_is_module:"fgmodule_condition R f i s A z
                                \<Longrightarrow>  R module (fgmodule R A z i f s)"
apply (simp add:fgmodule_condition_def, (erule conjE)+)
apply (rule Module.intro)
 apply (frule fag_aGroup [of f z i "s_set R s A"], assumption+)
apply (simp add:fag_gen_by_def fgmodule_def, simp add:aGroup_def)
 apply (rule allI, rule impI)
 apply (simp add:zeroA_def)

apply (rule Module_axioms.intro)
 apply (rule Ring_axioms)

 apply (simp add:fgmodule_carr, subst fgmodule_def, simp,
        simp add:sop_closed)

  apply (simp add:fgmodule_carr, (subst fgmodule_def)+, simp,
         simp add:sop_closed,
         cut_tac ring_is_ag,
         frule_tac x = a and y = b in aGroup.ag_pOp_closed, assumption+, simp)
  apply (simp add:sop_distr1)

  apply (simp add:fgmodule_carr, (subst fgmodule_def)+, simp,
         simp add:sop_closed bpp_closed)
  apply (simp add:sop_distr2_def)

  apply (frule_tac x = a and y = b in ring_tOp_closed, assumption+,
         simp add:fgmodule_carr, (subst fgmodule_def)+, simp,
         simp add:sop_closed bpp_closed)
  apply (simp add:sop_assoc)

 apply (cut_tac ring_one)
 apply (simp add:fgmodule_carr, (subst fgmodule_def)+, simp)
 apply (simp add:sop_one)
done

lemma (in Ring) a_in_carr_fgmodule:"a \<in> A
                                \<Longrightarrow>  a \<in> carrier (fgmodule R A z i f s)"
apply (simp add:fgmodule_carr)
 apply (cut_tac addition_inc_add0[of "aug_pm_set z i (s_set R s A)"],
        rule subsetD[of "aug_pm_set z i (s_set R s A)"
           "addition_set f (aug_pm_set z i (s_set R s A))" a], assumption)
 apply (simp add:aug_pm_set_def s_set_def)
done

section "A fgmodule and a free module"

lemma (in Ring) fg_zeroTr:"\<lbrakk>fgmodule_condition R f i s A z; a \<in> A\<rbrakk> \<Longrightarrow>
                     \<zero>  \<^sub>s\<cdot> a = z"
apply (frule fgmodule_is_module [of f i s A z])
apply (frule a_in_carr_fgmodule[of a A z i f s])
apply (frule Module.sc_0_m [of "fgmodule R A z i f s" R "a"],
       simp add:a_in_carr_fgmodule)
apply (cut_tac ring_zero,
       simp add:fgmodule_def)
done

lemma (in Ring) fg_genTr0:"\<lbrakk>fgmodule_condition R f i s A z;
      x \<in> aug_pm_set z i (s_set R s A)\<rbrakk> \<Longrightarrow>
        x \<in> linear_span R (fgmodule R A z i f s) (carrier R) A"
 apply (simp add:aug_pm_set_def s_set_def)
 apply (case_tac "x = z")
 apply simp
 apply (simp add:linear_span_def)
  apply (case_tac "A = {}", simp, simp add:fgmodule_def)
  apply simp
  apply (frule nonempty_ex[of "A"], thin_tac "A \<noteq> {}")
  apply (erule exE)
  apply (subgoal_tac "(\<lambda>j\<in>{j. j \<le> (0::nat)}. xa) \<in> {j. j \<le> (0::nat)} \<rightarrow> A")
  apply (subgoal_tac "(\<lambda>k\<in>{j. j \<le> (0::nat)}. \<zero>) \<in> {j. j \<le> (0::nat)} \<rightarrow>
                                        carrier R")
  apply (subgoal_tac "z = l_comb R (fgmodule R A z i f s) 0
          (\<lambda>k\<in>{j. j \<le> (0::nat)}. \<zero>) (\<lambda>j\<in>{j. j \<le> (0::nat)}. xa)") apply blast
  apply (simp add:l_comb_def)
  apply (frule_tac a1 = xa in fg_zeroTr [THEN sym, of f i s A z],
                      assumption+)
  apply (frule_tac a = xa in a_in_carr_fgmodule [of _ A z i f s])
  apply (frule fgmodule_is_module [of f i s A z])
  apply (cut_tac ring_zero, simp add:fgmodule_def)
  apply (simp add:ring_zero)
  apply (simp)
 apply (case_tac "x \<in> A",
        frule_tac x = x and A = A in nonempty,
        simp add:linear_span_def)
  apply (subgoal_tac "(\<lambda>j\<in>{j. j \<le> (0::nat)}. x) \<in> {j. j \<le> (0::nat)} \<rightarrow> A")
  apply (subgoal_tac "(\<lambda>k\<in>{j. j \<le> (0::nat)}. 1\<^sub>r) \<in> {j. j \<le> (0::nat)} \<rightarrow>
                        carrier R")
  apply (subgoal_tac "x = l_comb R (fgmodule R A z i f s) 0
                 (\<lambda>k\<in>{j. j \<le> (0::nat)}. 1\<^sub>r) (\<lambda>j\<in>{j. j \<le> (0::nat)}. x)")
  apply blast
  apply (simp add:l_comb_def)
  apply (frule fgmodule_is_module [of f i s A z])
  apply (frule_tac a = x in a_in_carr_fgmodule[of _ A z i f s])
  apply (simp add:fgmodule_def, fold fgmodule_def,
         simp add:ring_one, simp add:fgmodule_condition_def,
         (erule conjE)+, simp add:sop_one)

  apply (simp add:ring_one)
  apply (simp)

apply (case_tac "\<exists>r\<in>carrier R. \<exists>a\<in>A. x = r \<^sub>s\<cdot> a")
  apply ((erule bexE)+, simp)
  apply (frule_tac x = a and A = A in nonempty, simp add:linear_span_def)
  apply (subgoal_tac "(\<lambda>j\<in>{j. j \<le> (0::nat)}. a) \<in> {j. j \<le> (0::nat)} \<rightarrow> A")
  apply (subgoal_tac "(\<lambda>k\<in>{j. j \<le> (0::nat)}. r) \<in> {j. j \<le> (0::nat)} \<rightarrow>
                        carrier R")
  apply (subgoal_tac "r \<^sub>s\<cdot> a = l_comb R (fgmodule R A z i f s) 0
                 (\<lambda>k\<in>{j. j \<le> (0::nat)}. r) (\<lambda>j\<in>{j. j \<le> (0::nat)}. a)")
  apply blast
  apply (frule_tac a = a in a_in_carr_fgmodule[of _ A z i f s])
  apply (simp add:l_comb_def fgmodule_def)
  apply (simp)
  apply (simp)

apply (simp add:minus_set_def,
      thin_tac "x \<noteq> z", thin_tac "x \<notin> A",
      thin_tac "\<forall>r\<in>carrier R. \<forall>a\<in>A. x \<noteq> r \<^sub>s\<cdot> a")
  apply (erule bexE)
  apply simp
  apply (erule disjE)
  apply ((erule bexE)+, simp)
apply (frule fgmodule_is_module [of f i s A z])
 apply (frule_tac a = r and m = a in
         Module.sc_minus_am1[of "fgmodule R A z i f s" R], assumption+)
 apply (frule_tac a = a in a_in_carr_fgmodule[of _ A z i f s], assumption)
 apply (cut_tac ring_is_ag,
        frule_tac x = r in aGroup.ag_mOp_closed, assumption+)

 apply (frule_tac a = a in a_in_carr_fgmodule[of _ A z i f s])
 apply (simp add:fgmodule_def, fold fgmodule_def,
        simp add:sop_closed1)
 apply (frule_tac x = a and A = A in nonempty, simp add:linear_span_def)
  apply (subgoal_tac "(\<lambda>j\<in>{j. j \<le> (0::nat)}. a) \<in> {j. j \<le> (0::nat)} \<rightarrow> A")
  apply (subgoal_tac "(\<lambda>k\<in>{j. j \<le> (0::nat)}. (-\<^sub>a r)) \<in> {j. j \<le> (0::nat)} \<rightarrow>
                        carrier R")
  apply (subgoal_tac "(-\<^sub>a r) \<^sub>s\<cdot> a = l_comb R (fgmodule R A z i f s) 0
                 (\<lambda>k\<in>{j. j \<le> (0::nat)}. (-\<^sub>a r)) (\<lambda>j\<in>{j. j \<le> (0::nat)}. a)")
  apply blast
  apply (simp add:l_comb_def fgmodule_def)
  apply (simp)
  apply (simp)

apply (frule_tac x = y and A = A in nonempty, simp add:linear_span_def)
  apply (subgoal_tac "(\<lambda>j\<in>{j. j \<le> (0::nat)}. y) \<in> {j. j \<le> (0::nat)} \<rightarrow> A")
  apply (subgoal_tac "(\<lambda>k\<in>{j. j \<le> (0::nat)}. (-\<^sub>a 1\<^sub>r)) \<in> {j. j \<le> (0::nat)} \<rightarrow>
                        carrier R")
  apply (subgoal_tac "\<^sub>i- y = l_comb R (fgmodule R A z i f s) 0
                 (\<lambda>k\<in>{j. j \<le> (0::nat)}. (-\<^sub>a 1\<^sub>r)) (\<lambda>j\<in>{j. j \<le> (0::nat)}. y)")
  apply blast
  apply (simp add:l_comb_def)
  apply (frule fgmodule_is_module [of "f" "i" "s" "A" "z"])
  apply (frule_tac a = y in a_in_carr_fgmodule [of  _ A z i f s])
  apply (cut_tac ring_one , cut_tac ring_is_ag,
         frule aGroup.ag_mOp_closed [of R "1\<^sub>r"], assumption)
  apply (simp add:Module.sc_minus_am1[THEN sym, of "fgmodule R A z i f s" R])
  apply (simp add:Module.sprod_one)
  apply (simp add:fgmodule_def)
  apply (rule Pi_I, simp,
         cut_tac ring_one, cut_tac ring_is_ag,
         simp add:aGroup.ag_mOp_closed[of R])
    apply (simp)
done

lemma (in Ring) fg_genTr:"fgmodule_condition R f i s A z \<Longrightarrow>
      \<forall>x. x \<in> (add_set f (aug_pm_set z i (s_set R s A)) n) \<longrightarrow>
             x \<in> linear_span R (fgmodule R A z i f s) (carrier R) A"
apply (induct_tac n)
apply (rule allI, rule impI, simp)
apply (simp add:fg_genTr0)
apply (rule allI, rule impI, simp)
 apply (erule bexE)+
 apply (drule_tac x = sa in spec)
 apply simp
 apply (frule_tac x = t in fg_genTr0[of f i s A z], assumption+)
 apply (cut_tac whole_ideal)
 apply (frule fgmodule_is_module[of f i s A z])
 apply (frule_tac a = sa and b = t in Module.linear_span_pOp_closed[of
          "fgmodule R A z i f s" R "carrier R" A], assumption+,
        rule subsetI, simp add:a_in_carr_fgmodule, assumption+)
 apply (cut_tac n = n in addition_inc_add[of f "aug_pm_set z i (s_set R s A)"],
        cut_tac addition_inc_add0[of "aug_pm_set z i (s_set R s A)" f],
        frule_tac c = sa and A = "add_set f (aug_pm_set z i (s_set R s A)) n"
        in subsetD[of _ "addition_set f (aug_pm_set z i (s_set R s A))"],
        assumption+,
         frule_tac c = t and A = "aug_pm_set z i (s_set R s A)"
        in subsetD[of _ "addition_set f (aug_pm_set z i (s_set R s A))"],
        assumption+)
 apply (simp add:fgmodule_def)
done

lemma (in Ring) generator_of_fgm:"fgmodule_condition R f i s A z \<Longrightarrow>
                 generator R (fgmodule R A z i f s) A"
apply (cut_tac whole_ideal)
apply (simp add:generator_def)
apply (frule fgmodule_is_module [of f i s A z])
apply (rule conjI)
 apply (rule subsetI, simp add:a_in_carr_fgmodule)
 apply (frule Module.linear_span_sub[of "fgmodule R A z i f s" R
                         "carrier R" A], assumption+)
 apply (rule subsetI,
        simp add:a_in_carr_fgmodule)
 apply (rule equalityI, assumption,
        thin_tac "linear_span R (fgmodule R A z i f s) (carrier R) A
     \<subseteq> carrier (fgmodule R A z i f s)")
 apply (rule subsetI)
 apply (simp add:fgmodule_carr, simp add:addition_set_def)
 apply (erule exE, erule conjE, erule exE, simp)
 apply (simp add: fg_genTr)
done

lemma (in Ring) fg_freeTr1:"\<lbrakk>R module M; free_generator R M A;
  R module fgmodule R A z i f s; free_generator R (fgmodule R A z i f s) A;
  g \<in> mHom R M (fgmodule R A z i f s); \<forall>x\<in>A. g x = x\<rbrakk> \<Longrightarrow>
  \<forall>fa sa. fa \<in> {j. j \<le> (n::nat)} \<rightarrow> A \<and> sa \<in> {j. j \<le> n} \<rightarrow> carrier R \<longrightarrow>
        l_comb R (fgmodule R A z i f s) n sa (cmp g fa) =
                      l_comb R (fgmodule R A z i f s) n sa fa"
apply (induct_tac n, (rule allI)+, rule impI, erule conjE)
 apply (simp add:l_comb_def)
 apply (simp add:cmp_def)
apply ((rule allI)+, rule impI, erule conjE)
 apply (frule_tac f = fa and n = n and A = A in func_pre,
        frule_tac f = sa and n = n and A = "carrier R" in func_pre)
 apply (drule_tac x = fa in spec,
        drule_tac x = sa in spec, simp)

 apply (frule_tac s = sa and f = fa and n = n in Module.l_comb_Suc[of
         "fgmodule R A z i f s" R A "carrier R"],
        rule subsetI,simp add:a_in_carr_fgmodule,
           cut_tac whole_ideal, simp, assumption+, simp)
 apply (frule_tac s = sa and f = "cmp g fa" and n = n in Module.l_comb_Suc[of
         "fgmodule R A z i f s" R A "carrier R"],
        rule subsetI,simp add:a_in_carr_fgmodule,
        cut_tac whole_ideal, simp, simp,
        rule Pi_I, simp add:cmp_def,
        frule_tac x = x and f = fa and A = "{j. j \<le> Suc n}" and B = A
               in funcset_mem, simp+)
 apply (frule_tac  x = "Suc n" and f = fa and A = "{j. j \<le> Suc n}" and B = A
               in funcset_mem, simp+, simp add:cmp_def)
done

lemma (in Ring) fg_freeTr:"\<lbrakk>R module M; free_generator R M A;
      R module fgmodule R A z i f s;
      free_generator R (fgmodule R A z i f s) A;
      g \<in> mHom R M (fgmodule R A z i f s); \<forall>x\<in>A. g x = x;
      fa \<in> {j. j \<le> (n::nat)} \<rightarrow> A; sa \<in> {j. j \<le> n} \<rightarrow> carrier R\<rbrakk> \<Longrightarrow>
      l_comb R (fgmodule R A z i f s) n sa (cmp g fa) =
                            l_comb R (fgmodule R A z i f s) n sa fa"
apply (simp add:fg_freeTr1)
done

lemma (in Ring) fg_free1:"\<lbrakk> A \<noteq> {}; fgmodule_condition R f i s A z;
      free_generator R (fgmodule R A z i f s) A; R module M;
      free_generator R M A\<rbrakk> \<Longrightarrow> M \<cong>\<^bsub>R\<^esub> (fgmodule R A z i f s)"
apply (subgoal_tac "(\<lambda>x\<in>A. x) \<in> A \<rightarrow> carrier (fgmodule R A z i f s)")
 prefer 2
   apply (rule Pi_I, simp, simp add:a_in_carr_fgmodule)
 apply (frule fgmodule_is_module [of f i s A z])
 apply (frule Module.exist_extension_mhom[of M R "fgmodule R A z i f s" A
         "\<lambda>x\<in>A. x"], assumption+)
 apply (erule bexE)
 apply (thin_tac "(\<lambda>x\<in>A. x) \<in> A \<rightarrow> carrier (fgmodule R A z i f s)")
 apply (simp add:misomorphic_def)
 apply (subgoal_tac "bijec\<^bsub>M,(fgmodule R A z i f s)\<^esub> g", blast)
 apply (simp add:bijec_def)
apply (rule conjI)
 apply (simp add:injec_def)
 apply (rule conjI, simp add:mHom_def)
 apply (rule equalityI)
 apply (rule subsetI)
 apply (simp add:ker_def, erule conjE)
 apply (frule Module.free_generator_generator[of M R A], assumption)
  apply (simp add:generator_def, erule conjE)
  apply (rotate_tac -1, frule sym,
         thin_tac "linear_span R M (carrier R) A = carrier M",
         frule_tac a = x and A = "carrier M" and
                B = "linear_span R M (carrier R) A" in eq_set_inc, assumption+,
         thin_tac "carrier M = linear_span R M (carrier R) A",
         simp add:linear_span_def)
  apply (erule exE, (erule bexE)+)
  apply (cut_tac whole_ideal)
 apply (frule_tac s = sa and n = n and f = fa and H = A in
        Module.same_together[of M R "carrier R"], assumption+)
 apply ((erule bexE)+, erule conjE)
 apply (fold l_comb_def[of R M], simp)
 apply (frule_tac f = g and s = t and n = "card (fa ` {j. j \<le> n}) - Suc 0"
        and g = ga in Module.linmap_im_lincomb[of M R "carrier R"
        "fgmodule R A z i f s" _  A], assumption+)
 apply (frule_tac f = fa and A = "{j. j \<le> n}" in img_subset[of _ _ A],
        frule_tac f = ga and A = "{j. j \<le> card (fa ` {j. j \<le> n}) - Suc 0}"
        and B = "fa ` {j. j \<le> n}" and ?B1.0 = A in extend_fun, assumption+)
 apply (rotate_tac -1, frule sym,
        thin_tac "g (l_comb R M (card (fa ` {j. j \<le> n}) - Suc 0) t ga) =
        l_comb R (fgmodule R A z i f s) (card (fa ` {j. j \<le> n}) - Suc 0) t
         (cmp g ga)", simp)

 apply (frule_tac g = g and fa = ga and sa = t and
        n = "card (fa ` {j. j \<le> n}) - Suc 0" in fg_freeTr[of M A z i f s],
        assumption+)
  apply (frule_tac f = fa and A = "{j. j \<le> n}" in img_subset[of _ _ A],
        frule_tac f = ga and A = "{j. j \<le> card (fa ` {j. j \<le> n}) - Suc 0}"
        and B = "fa ` {j. j \<le> n}" and ?B1.0 = A in extend_fun, assumption+)
  apply simp
  apply (cut_tac k = n in finite_Collect_le_nat,
         cut_tac k = "card (fa ` {j. j \<le> n}) - Suc 0" in finite_Collect_le_nat,
         cut_tac F = "{j. j \<le> n}" and h = fa in finite_imageI,
         assumption)
  apply (frule_tac f = fa and A = "{j. j \<le> n}" and B = A and a = 0 in
         mem_in_image, simp,
         frule_tac x = "fa 0" and A = "fa ` {j. j \<le> n}" in nonempty,
         frule_tac A = "fa ` {j. j \<le> n}" in nonempty_card_pos, assumption)
  apply (frule_tac A = "fa ` {j. j \<le> n}" and
         n = "card (fa ` {j. j \<le> n}) - Suc 0" and f = ga in Nset2finite_inj,
         simp, assumption)
  apply (frule Module.free_generator_sub[of "fgmodule R A z i f s" R A],
          assumption)
  apply (frule_tac s = t and m = ga and n = "card (fa ` {j. j \<le> n}) - Suc 0"
         in Module.unique_expression1[of "fgmodule R A z i f s" R A],
         assumption+)
   apply (frule_tac f = fa and A = "{j. j \<le> n}" in img_subset[of _ _ A],
        rule_tac f = ga and A = "{j. j \<le> card (fa ` {j. j \<le> n}) - Suc 0}"
        and B = "fa ` {j. j \<le> n}" and ?B1.0 = A in extend_fun, assumption+)
 apply (rule_tac s = t and n = "card (fa ` {j. j \<le> n}) - Suc 0" and
        m = ga in Module.linear_comb0_1[of M R A], assumption+,
        simp)
    apply (frule_tac f = fa and A = "{j. j \<le> n}" in img_subset[of _ _ A],
        rule_tac f = ga and A = "{j. j \<le> card (fa ` {j. j \<le> n}) - Suc 0}"
        and B = "fa ` {j. j \<le> n}" and ?B1.0 = A in extend_fun, assumption+)

apply (simp add:ker_def,
      frule Module.module_is_ag[of M],
      simp add: aGroup.ag_inc_zero[of M],
      simp add:Module.mHom_0)

apply (simp add:surjec_def,
       rule conjI, simp add:mHom_def)
 apply (rule surj_to_test, simp add:mHom_def aHom_def)
 apply (rule ballI)
 apply (frule Module.free_generator_generator[of "fgmodule R A z i f s" R A],
        assumption+)
 apply (cut_tac generator_def[of R "fgmodule R A z i f s" A], simp,
        erule conjE, rotate_tac -1, frule sym,
        thin_tac "linear_span R (fgmodule R A z i f s) (carrier R) A =
           carrier (fgmodule R A z i f s)", simp,
        thin_tac "carrier (fgmodule R A z i f s) =
           linear_span R (fgmodule R A z i f s) (carrier R) A",
        thin_tac "A \<subseteq> linear_span R (fgmodule R A z i f s) (carrier R) A",
        thin_tac "generator R (fgmodule R A z i f s) A \<equiv> True")
 apply (simp add:linear_span_def, erule exE, (erule bexE)+)
 apply (frule_tac g1 = g and fa1 = fa and n1 = n and sa1 = sa in
        fg_freeTr[THEN sym, of M A z i f s], assumption+, simp,
        thin_tac "l_comb R (fgmodule R A z i f s) n sa fa =
        l_comb R (fgmodule R A z i f s) n sa (cmp g fa)")
 apply (frule_tac f1 = g and s1 = sa and g1 = fa and n1 = n in
        Module.linmap_im_lincomb[THEN sym, of M R "carrier R"
              "fgmodule R A z i f s" _  A],
        simp add:whole_ideal, assumption+,
        simp add:Module.free_generator_sub, assumption+, simp)
 apply (cut_tac whole_ideal,
        frule_tac s = sa and n = n and m = fa in
        Module.l_comb_mem[of M R "carrier R" A], assumption+,
        simp add:Module.free_generator_sub, assumption+)
 apply blast
done

lemma (in Ring) fg_free:"\<lbrakk>fgmodule_condition R f i s A z;
       free_generator R (fgmodule R A z i f s) A; R module M;
       free_generator R M A\<rbrakk> \<Longrightarrow> M \<cong>\<^bsub>R\<^esub> (fgmodule R A z i f s)"
apply (case_tac "A = {}")
apply (simp add:free_generator_def generator_def linear_span_def)
 apply (erule conjE)+
apply (cut_tac fgmodule_is_module[of f i s A z])
apply (rule Module.Modules_single_carrier_isom[of M R "fgmodule R {} z i f s"],
       assumption+, simp, rule sym, assumption, rule sym, assumption, simp)
apply (simp add: fg_free1)
done

section "Direct sum, again"

definition
  miota :: "[('r, 'm) Ring_scheme, ('a, 'r, 'm1) Module_scheme,
    ('a, 'r, 'm1) Module_scheme] \<Rightarrow> 'a \<Rightarrow> 'a" where
  "miota R M1 M = (\<lambda>x\<in>carrier M1. x)"

definition
 msubmodule ::"[('r, 'm) Ring_scheme, ('a, 'r, 'm1) Module_scheme,
 ('a, 'r, 'm1) Module_scheme] \<Rightarrow> bool" where
 "msubmodule R M M1 \<longleftrightarrow> miota R M1 M \<in> mHom R M1 M \<and>
                         (carrier M1) \<subseteq> (carrier M)"
     (** M and M1 are R modules. **)

definition
  ds2 :: "[('r, 'm) Ring_scheme, ('a, 'r, 'm1) Module_scheme,
          ('a, 'r, 'm1) Module_scheme, ('a, 'r, 'm1) Module_scheme] \<Rightarrow> bool" where

  "ds2 R M M1 M2 \<longleftrightarrow> R module M \<and> msubmodule R M M1 \<and> msubmodule R M M2 \<and>
          (\<forall>x\<in>carrier M. \<exists>m1\<in>carrier M1. \<exists>m2\<in>carrier M2. x = m1 \<plusminus>\<^bsub>M\<^esub> m2) \<and>
           (carrier M1) \<inter> (carrier M2) = {\<zero>\<^bsub>M\<^esub>}"

abbreviation
  DS2  ("(4_/ \<Oplus>\<^bsub>_,_\<^esub> _)" [92,93,92,92]92) where
  "M1 \<Oplus>\<^bsub>R,M\<^esub> M2 == ds2 R M M1 M2"

lemma (in Ring) ds2_commute:"\<lbrakk>R module M1; R module M2; R module M;
               M1 \<Oplus>\<^bsub>R,M\<^esub> M2\<rbrakk> \<Longrightarrow> M2 \<Oplus>\<^bsub>R,M\<^esub> M1"
apply (simp add:ds2_def)
 apply (erule conjE)+
 apply (subst Int_commute, simp)
 apply (rule ballI,
       drule_tac x = x in bspec, assumption,
       (erule bexE)+)
 apply (simp add:msubmodule_def, (erule conjE)+,
        frule_tac c = m1 in subsetD[of "carrier M1" "carrier M"], assumption+,
        frule_tac c = m2 in subsetD[of "carrier M2" "carrier M"], assumption+)
 apply (frule Module.module_is_ag[of M R],
        frule_tac x = m1 and y = m2 in aGroup.ag_pOp_commute, assumption+,
        simp)
 apply blast
done

lemma (in Ring) msub_addition:"\<lbrakk>R module M; R module M1; msubmodule R M M1;
       x \<in> carrier M1; y \<in> carrier M1\<rbrakk> \<Longrightarrow> x \<plusminus>\<^bsub>M1\<^esub> y = x \<plusminus>\<^bsub>M\<^esub> y"
apply (simp add:msubmodule_def, (erule conjE)+)
apply (frule Module.mHom_add[of M1 R M "miota R M1 M" x y], assumption+)
apply (frule Module.module_is_ag[of M1],
       frule aGroup.ag_pOp_closed[of M1 x y], assumption+,
       simp add:miota_def)
done

lemma (in Ring) msub_mOp:"\<lbrakk>R module M; R module M1; msubmodule R M M1;
       x \<in> carrier M1\<rbrakk> \<Longrightarrow> -\<^sub>a\<^bsub>M1\<^esub> x  = -\<^sub>a\<^bsub>M\<^esub> x"
apply (simp add:msubmodule_def, (erule conjE)+)
apply (frule Module.module_is_ag[of M1],
       frule_tac x = x in aGroup.ag_mOp_closed[of M1], assumption+)
apply (frule Module.mHom_inv[of M1 R M x "miota R M1 M"], assumption+,
       simp add:miota_def)
done

lemma (in Ring) msub_sprod:"\<lbrakk>R module M; R module M1; msubmodule R M M1;
       a \<in> carrier R; x \<in> carrier M1\<rbrakk> \<Longrightarrow> a \<cdot>\<^sub>s\<^bsub>M1\<^esub> x = a \<cdot>\<^sub>s\<^bsub>M\<^esub> x"
apply (simp add:msubmodule_def, (erule conjE)+)
apply (frule Module.mHom_lin[of M1 R M x "miota R M1 M" a], assumption+)
apply (frule Module.sc_mem[of M1 R a x], assumption+)
apply (simp add:miota_def)
done

lemma (in Ring) msub_submodule:"\<lbrakk>R module M; R module M1; msubmodule R M M1\<rbrakk>
        \<Longrightarrow>  submodule R M (carrier M1)"
apply (simp add:submodule_def msubmodule_def, erule conjE)
apply (rule conjI)
 apply (frule Module.module_is_ag[of M R],
        frule Module.module_is_ag[of M1 R])
 apply (rule aGroup.asubg_test, assumption+,
        frule Module.module_inc_zero[of M1 R], blast)
 apply ((rule ballI)+,
       frule_tac x = b in aGroup.ag_mOp_closed[of M1], assumption+)
 apply (frule_tac m = a and n = "-\<^sub>a\<^bsub>M1\<^esub> b" in Module.mHom_add[of M1 R M
        "miota R M1 M"], assumption+,
        frule_tac x = a and y = "-\<^sub>a\<^bsub>M1\<^esub> b" in aGroup.ag_pOp_closed,
        assumption+, simp add:miota_def)
 apply (frule_tac m = b in Module.mHom_inv[of M1 R M _ "miota R M1 M"],
          assumption+, simp add:miota_def, simp add:miota_def)
apply ((rule allI)+, rule impI, erule conjE)
 apply (frule_tac m = m and a = a in Module.mHom_lin [of M1 R M _
       "miota R M1 M" _], assumption+)
 apply (frule_tac a = a and m = m in Module.sc_mem[of M1 R], assumption+)
 apply (simp add:miota_def)
done

lemma (in Ring) ds2_unique:"\<lbrakk>R module M; R module M1; R module M2;
       ds2 R M M1 M2;  m1 \<in> carrier M1; m1' \<in> carrier M1;
                       m2 \<in> carrier M2; m2' \<in> carrier M2;
       m1 \<plusminus>\<^bsub>M\<^esub> m2 = m1' \<plusminus>\<^bsub>M\<^esub> m2'\<rbrakk> \<Longrightarrow> m1 = m1' \<and> m2 = m2'"
apply (frule msub_submodule [of M M1], assumption+,
       simp add:ds2_def)
apply (frule msub_submodule [of M M2], assumption+,
       simp add:ds2_def)
 apply (frule Module.submodule_subset[of M R "carrier M1"], assumption,
        frule Module.submodule_subset[of M R "carrier M2"], assumption)
 apply (frule subsetD [of "carrier M1" "carrier M" m1], assumption+,
        frule subsetD [of "carrier M1" "carrier M" m1'], assumption+,
        frule subsetD [of "carrier M2" "carrier M" "m2"], assumption+,
        frule subsetD [of "carrier M2" "carrier M" "m2'"], assumption+)
 apply (frule_tac Module.module_is_ag[of M R],
        frule_tac x = m1 and y = m2 in aGroup.ag_pOp_closed, assumption+,
        frule_tac x = m1' and y = m2' in aGroup.ag_pOp_closed, assumption+,
        frule_tac x = m2' in aGroup.ag_mOp_closed, assumption+,
        frule_tac x = m2 in aGroup.ag_mOp_closed, assumption+)
 apply (frule_tac a = "m1 \<plusminus>\<^bsub>M\<^esub> m2" and b = "m1' \<plusminus>\<^bsub>M\<^esub> m2'" and c = "-\<^sub>a\<^bsub>M\<^esub> m2" in
        aGroup.ag_pOp_add_r, assumption+,
        thin_tac "m1 \<plusminus>\<^bsub>M\<^esub> m2 = m1' \<plusminus>\<^bsub>M\<^esub> m2'",
        simp add:aGroup.ag_pOp_assoc[of M m1 m2 "-\<^sub>a\<^bsub>M\<^esub> m2"]
                                     aGroup.ag_r_inv1 aGroup.ag_r_zero,
        simp add:aGroup.ag_pOp_assoc[of M m1' m2' "-\<^sub>a\<^bsub>M\<^esub> m2"],
        frule_tac x = m2' and y = "-\<^sub>a\<^bsub>M\<^esub> m2" in aGroup.ag_pOp_closed,
               assumption+,
        frule_tac x = m1' in aGroup.ag_mOp_closed, assumption+,
        frule_tac x = m1' and y = "m2' \<plusminus>\<^bsub>M\<^esub> -\<^sub>a\<^bsub>M\<^esub> m2" in
                           aGroup.ag_pOp_closed, assumption+,
        frule_tac a = m1 and b = "m1' \<plusminus>\<^bsub>M\<^esub> (m2' \<plusminus>\<^bsub>M\<^esub> -\<^sub>a\<^bsub>M\<^esub> m2)" and
        c = "-\<^sub>a\<^bsub>M\<^esub> m1'" in aGroup.ag_pOp_add_l[of M], simp, assumption+)
 apply (frule aGroup.ag_pOp_assoc[THEN sym, of M "-\<^sub>a\<^bsub>M\<^esub> m1'" "m1'"
                                                      "(m2' \<plusminus>\<^bsub>M\<^esub> -\<^sub>a\<^bsub>M\<^esub> m2)"],
        assumption+)
apply (rotate_tac -6, frule sym, thin_tac "m1 = m1' \<plusminus>\<^bsub>M\<^esub> (m2' \<plusminus>\<^bsub>M\<^esub> -\<^sub>a\<^bsub>M\<^esub> m2)",
       thin_tac "-\<^sub>a\<^bsub>M\<^esub> m1' \<plusminus>\<^bsub>M\<^esub> m1 = -\<^sub>a\<^bsub>M\<^esub> m1' \<plusminus>\<^bsub>M\<^esub> (m1' \<plusminus>\<^bsub>M\<^esub> (m2' \<plusminus>\<^bsub>M\<^esub> -\<^sub>a\<^bsub>M\<^esub> m2))",
       simp, simp add:aGroup.ag_l_inv1 aGroup.ag_l_zero)
 apply (frule Module.submodule_mOp_closed [of M R "carrier M1" m1'],
                                                     assumption+,
        frule Module.submodule_pOp_closed [of M R "carrier M1" "-\<^sub>a\<^bsub>M\<^esub> m1'"
                                                m1], assumption+,
        frule Module.submodule_pOp_closed [of M R "carrier M2" m2' "-\<^sub>a\<^bsub>M\<^esub> m2"],
                                                     assumption+,
     rule Module.submodule_mOp_closed [of M R "carrier M2" m2], assumption+)
 apply (subgoal_tac "(-\<^sub>a\<^bsub>M\<^esub> m1' \<plusminus>\<^bsub>M\<^esub> m1) \<in> carrier M1 \<inter> carrier M2")
 prefer 2 apply simp
 apply (subgoal_tac "carrier M1 \<inter> carrier M2 = {\<zero>\<^bsub>M\<^esub>}")
 apply (frule sym, thin_tac "-\<^sub>a\<^bsub>M\<^esub> m1' \<plusminus>\<^bsub>M\<^esub> m1 = m2' \<plusminus>\<^bsub>M\<^esub> -\<^sub>a\<^bsub>M\<^esub> m2")
 apply simp
 apply (simp add:aGroup.ag_eq_diffzero[THEN sym, of M m2' m2] aGroup.ag_r_zero)

 apply (simp add:ds2_def)
done

lemma (in Ring) miota_injec:"\<lbrakk>R module M; R module M1; R module M2;
       ds2 R M M1 M2; msubmodule R M M1\<rbrakk> \<Longrightarrow>
       miota R M1 M \<in> mHom R M1 M \<and> injec\<^bsub>M1,M\<^esub> (miota R M1 M)"
apply (rule conjI)
 apply (simp add:msubmodule_def)
apply (simp add:injec_def)
 apply (rule conjI)
 apply (simp add:msubmodule_def mHom_def)
apply (rule equalityI)
 prefer 2
 apply (rule subsetI, simp, simp add:ker_def)
 apply (simp add:Module.module_inc_zero, simp add:msubmodule_def)
 apply (erule conjE)
 apply (simp add:Module.mHom_0)
apply (rule subsetI)
 apply (simp add:ker_def, erule conjE)
 apply (simp add:miota_def, simp add:msubmodule_def)
 apply (erule conjE)
 apply (frule Module.mHom_0 [of M1 R M "miota R M1 M"], assumption+)
 apply (frule Module.module_inc_zero [of M1 R])
 apply (simp add:miota_def)
done

definition
  mproj1 :: "[('r, 'm) Ring_scheme, ('a, 'r, 'm1) Module_scheme,
    ('a, 'r, 'm1) Module_scheme, ('a, 'r, 'm1) Module_scheme] \<Rightarrow> 'a \<Rightarrow> 'a" where
  "mproj1 R M1 M2 M = (\<lambda>x\<in>carrier M. THE x1. x1 \<in> carrier M1 \<and>
                                          (x \<plusminus>\<^bsub>M\<^esub> (-\<^sub>a\<^bsub>M\<^esub> x1)) \<in> carrier M2)"

definition
  mproj2 :: "[('r, 'm) Ring_scheme, ('a, 'r, 'm1) Module_scheme,
    ('a, 'r, 'm1) Module_scheme, ('a, 'r, 'm1) Module_scheme] \<Rightarrow> 'a \<Rightarrow> 'a" where
  "mproj2 R M1 M2 M = mproj1 R M2 M1 M"

(** mproj is used under the condition ds2 R M M1 M2 **)

lemma (in Ring) ds2_components:"\<lbrakk>R module M1; R module M2; R module M;
       M1 \<Oplus>\<^bsub>R,M\<^esub> M2; a \<in> carrier M\<rbrakk> \<Longrightarrow>
         \<exists>a1\<in>carrier M1. \<exists>a2\<in>carrier M2. a = a1 \<plusminus>\<^bsub>M\<^esub> a2"
by (simp add:ds2_def)

lemma (in Ring) ds2_components1:"\<lbrakk>R module M1; R module M2; R module M;
       M1 \<Oplus>\<^bsub>R,M\<^esub> M2; a \<in> carrier M\<rbrakk> \<Longrightarrow>
         \<exists>a1\<in>carrier M1. a \<plusminus>\<^bsub>M\<^esub> -\<^sub>a\<^bsub>M\<^esub> a1 \<in> carrier M2"
apply (frule ds2_components[of M1 M2 M a], assumption+, (erule bexE)+,
       frule Module.module_is_ag[of M R],
       unfold ds2_def, frule conjunct2[THEN conjunct1],
       frule conjunct2[THEN conjunct2[THEN conjunct1]], fold ds2_def)
 apply (simp add:msubmodule_def, (erule conjE)+)
 apply (frule_tac c = a1 in subsetD[of "carrier M1" "carrier M"], assumption+,
        frule_tac c = a2 in subsetD[of "carrier M2" "carrier M"], assumption+)

 apply (frule Module.module_is_ag[of M],
        frule_tac x = a1 and y = a2 in aGroup.ag_pOp_commute, assumption+,
        simp)
 apply (frule_tac x = a1 and y = a2 in aGroup.ag_pOp_closed[of M], assumption+,
        frule_tac x = a1 in aGroup.ag_mOp_closed[of M], assumption+,
        frule_tac a = "a1 \<plusminus>\<^bsub>M\<^esub> a2" and b = "a2 \<plusminus>\<^bsub>M\<^esub> a1" and c = "-\<^sub>a\<^bsub>M\<^esub> a1" in
        aGroup.ag_pOp_add_r[of M], assumption+,
        frule_tac x = a2 and y = a1 and z = "-\<^sub>a\<^bsub>M\<^esub> a1" in
                                   aGroup.ag_pOp_assoc[of M], assumption+,
        simp add:aGroup.ag_r_inv1 aGroup.ag_r_zero)
 apply (thin_tac "a2 \<plusminus>\<^bsub>M\<^esub> a1 \<in> carrier M",
        thin_tac "a = a2 \<plusminus>\<^bsub>M\<^esub> a1",
        thin_tac "a2 \<in> carrier M",
        thin_tac "a1 \<plusminus>\<^bsub>M\<^esub> a2 = a2 \<plusminus>\<^bsub>M\<^esub> a1",
        frule sym, thin_tac "a2 \<plusminus>\<^bsub>M\<^esub> a1 \<plusminus>\<^bsub>M\<^esub> -\<^sub>a\<^bsub>M\<^esub> a1 = a2")
 apply (frule_tac a = a2 and b = "a2 \<plusminus>\<^bsub>M\<^esub> a1 \<plusminus>\<^bsub>M\<^esub> -\<^sub>a\<^bsub>M\<^esub> a1" in
                      eq_elem_in[of _ "carrier M2"], assumption, blast)
done

lemma (in Ring) mprojTr1:"\<lbrakk>R module M1; R module M2; R module M; ds2 R M M1 M2;
  x \<in> carrier M \<rbrakk> \<Longrightarrow> \<exists>!x1. x1 \<in> carrier M1 \<and> (x \<plusminus>\<^bsub>M\<^esub> -\<^sub>a\<^bsub>M\<^esub> x1) \<in> carrier M2"
apply (frule Module.module_is_ag[of M R])
apply (rule ex_ex1I)
 apply (frule ds2_components1 [of M1 M2 M x], assumption+, erule bexE, blast)

 apply (simp add:ds2_def, (erule conjE)+, simp add:msubmodule_def,
        (erule conjE)+,
        frule_tac c = x1 in subsetD[of "carrier M1" "carrier M"], assumption+,
        frule_tac x = x1 in aGroup.ag_mOp_closed, assumption+,
        frule_tac c = y in subsetD[of "carrier M1" "carrier M"], assumption+,
        frule_tac x = y in aGroup.ag_mOp_closed, assumption+,
        frule_tac ?m1.0 = x1 and ?m1' = y and ?m2.0 = "x \<plusminus>\<^bsub>M\<^esub> -\<^sub>a\<^bsub>M\<^esub> x1" and
         ?m2' = "x \<plusminus>\<^bsub>M\<^esub> -\<^sub>a\<^bsub>M\<^esub> y" in ds2_unique[of M M1 M2], assumption+)
 apply (simp add:ds2_def msubmodule_def, assumption+)
 apply (simp add:aGroup.ag_pOp_commute[of M x])
 apply (simp add:aGroup.ag_pOp_assoc[THEN sym, of M _ _ x])
 apply ((subst aGroup.ag_r_inv1, assumption+)+, simp, simp)
done

lemma (in Ring) mprojTr2:"\<lbrakk>R module M1; R module M2; R module M; ds2 R M M1 M2;
      x \<in> carrier M; x1 \<in> carrier M1; (x \<plusminus>\<^bsub>M\<^esub> (-\<^sub>a\<^bsub>M\<^esub> x1)) \<in> carrier M2;
      y1 \<in> carrier M1;(x \<plusminus>\<^bsub>M\<^esub> (-\<^sub>a\<^bsub>M\<^esub> y1)) \<in> carrier M2  \<rbrakk> \<Longrightarrow> x1 = y1"
apply (frule_tac x = x in mprojTr1[of M1 M2 M], assumption+)
apply blast
done

lemma (in Ring) mprojTr3:"\<lbrakk>R module M1; R module M2; R module M; ds2 R M M1 M2;
      a \<in> carrier M; a1 \<in> carrier M1; (a \<plusminus>\<^bsub>M\<^esub> (-\<^sub>a\<^bsub>M\<^esub> a1)) \<in> carrier M2\<rbrakk> \<Longrightarrow>
      (THE x1. x1 \<in> carrier M1 \<and> a \<plusminus>\<^bsub>M\<^esub> -\<^sub>a\<^bsub>M\<^esub> x1 \<in> carrier M2) = a1"
apply (subgoal_tac "(THE x1. x1 \<in> carrier M1 \<and> a \<plusminus>\<^bsub>M\<^esub> -\<^sub>a\<^bsub>M\<^esub> x1 \<in> carrier M2) \<in>
         carrier M1 \<and>  a \<plusminus>\<^bsub>M\<^esub> -\<^sub>a\<^bsub>M\<^esub> (THE x1. x1 \<in> carrier M1 \<and>
         a \<plusminus>\<^bsub>M\<^esub> -\<^sub>a\<^bsub>M\<^esub> x1 \<in> carrier M2) \<in> carrier M2",
       rule mprojTr2[of M1 M2 M a
       "THE x1. x1 \<in> carrier M1 \<and> a \<plusminus>\<^bsub>M\<^esub> -\<^sub>a\<^bsub>M\<^esub> x1 \<in> carrier M2" a1], assumption+,
       simp, simp, assumption+)
apply (rule theI')
apply (simp add:mprojTr1)
done

lemma (in Ring) mproj:"\<lbrakk>R module M1; R module M2; R module M; ds2 R M M1 M2\<rbrakk>
      \<Longrightarrow> mproj1 R M1 M2 M \<in> mHom R M M1"
apply (simp add:mHom_def)
apply (rule conjI)
 apply (simp add:aHom_def)
 apply (rule conjI)
 apply (rule Pi_I)
 apply (simp add:mproj1_def)
 apply (frule_tac a = x in ds2_components1[of M1 M2 M], assumption+,
        erule bexE,
        frule_tac a = x and ?a1.0 = a1 in mprojTr3[of M1 M2 M], assumption+,
        simp)

apply (simp add:restrict_def mproj1_def extensional_def)

 apply ((rule ballI)+,
        frule Module.module_is_ag[of M R], simp add:aGroup.ag_pOp_closed,
        frule_tac x = a and y = b in aGroup.ag_pOp_closed, assumption+,
        frule_tac a = a in ds2_components1[of M1 M2 M], assumption+,
        frule_tac a = b in ds2_components1[of M1 M2 M], assumption+,
        frule_tac a = "a \<plusminus>\<^bsub>M\<^esub> b" in ds2_components1[of M1 M2 M], assumption+,
        (erule bexE)+, rename_tac b1 ab,
        frule_tac a = "a \<plusminus>\<^bsub>M\<^esub> b" and ?a1.0 = ab in mprojTr3[of M1 M2 M],
        assumption+,
        frule_tac a = a and ?a1.0 = a1 in mprojTr3[of M1 M2 M], assumption+,
        frule_tac a = b and ?a1.0 = b1 in mprojTr3[of M1 M2 M], assumption+,
        simp,
        thin_tac "(THE x1. x1 \<in> carrier M1 \<and>
                                  a \<plusminus>\<^bsub>M\<^esub> b \<plusminus>\<^bsub>M\<^esub> -\<^sub>a\<^bsub>M\<^esub> x1 \<in> carrier M2) = ab",
        thin_tac "(THE x1. x1 \<in> carrier M1 \<and> a \<plusminus>\<^bsub>M\<^esub> -\<^sub>a\<^bsub>M\<^esub> x1 \<in> carrier M2) = a1",
        thin_tac "(THE x1. x1 \<in> carrier M1 \<and> b \<plusminus>\<^bsub>M\<^esub> -\<^sub>a\<^bsub>M\<^esub> x1 \<in> carrier M2) = b1")
 apply (frule Module.module_is_ag[of M2],
        frule_tac x = "a \<plusminus>\<^bsub>M\<^esub> -\<^sub>a\<^bsub>M\<^esub> a1" and y = "b \<plusminus>\<^bsub>M\<^esub> -\<^sub>a\<^bsub>M\<^esub> b1" in
                       aGroup.ag_pOp_closed[of M2], assumption+,
        frule_tac x = "a \<plusminus>\<^bsub>M\<^esub> -\<^sub>a\<^bsub>M\<^esub> a1" and y = "b \<plusminus>\<^bsub>M\<^esub> -\<^sub>a\<^bsub>M\<^esub> b1" in
                     msub_addition[of M M2], assumption+,
        simp add:ds2_def, assumption+, simp,
          thin_tac "a \<plusminus>\<^bsub>M\<^esub> -\<^sub>a\<^bsub>M\<^esub> a1 \<plusminus>\<^bsub>M2\<^esub> (b \<plusminus>\<^bsub>M\<^esub> -\<^sub>a\<^bsub>M\<^esub> b1) =
                                 a \<plusminus>\<^bsub>M\<^esub> -\<^sub>a\<^bsub>M\<^esub> a1 \<plusminus>\<^bsub>M\<^esub> (b \<plusminus>\<^bsub>M\<^esub> -\<^sub>a\<^bsub>M\<^esub> b1)",
        unfold ds2_def, frule conjunct2[THEN conjunct1], fold ds2_def,
          simp add:msubmodule_def, (erule conjE)+,
         frule_tac c = a1 in subsetD[of "carrier M1" "carrier M"], assumption+,
         frule_tac c = b1 in subsetD[of "carrier M1" "carrier M"], assumption+,
         frule_tac x = a1 in aGroup.ag_mOp_closed, assumption+,
         frule_tac x = b1 in aGroup.ag_mOp_closed, assumption+,
         frule_tac a = a and b = "-\<^sub>a\<^bsub>M\<^esub> a1" and c = b and d = "-\<^sub>a\<^bsub>M\<^esub> b1" in
                   aGroup.pOp_assocTr43[of M], assumption+, simp,
         thin_tac "a \<plusminus>\<^bsub>M\<^esub> -\<^sub>a\<^bsub>M\<^esub> a1 \<plusminus>\<^bsub>M\<^esub> (b \<plusminus>\<^bsub>M\<^esub> -\<^sub>a\<^bsub>M\<^esub> b1) =
                                      a \<plusminus>\<^bsub>M\<^esub> (-\<^sub>a\<^bsub>M\<^esub> a1 \<plusminus>\<^bsub>M\<^esub> b) \<plusminus>\<^bsub>M\<^esub> -\<^sub>a\<^bsub>M\<^esub> b1",
         frule_tac x = "-\<^sub>a\<^bsub>M\<^esub> a1" and y = b in aGroup.ag_pOp_commute,
         assumption+, simp,
         frule_tac a1 = a and b1 = b and c1 = "-\<^sub>a\<^bsub>M\<^esub> a1" and d1 = "-\<^sub>a\<^bsub>M\<^esub> b1" in
         aGroup.pOp_assocTr43[THEN sym], assumption+, simp,
         thin_tac "a \<plusminus>\<^bsub>M\<^esub> (b \<plusminus>\<^bsub>M\<^esub> -\<^sub>a\<^bsub>M\<^esub> a1) \<plusminus>\<^bsub>M\<^esub> -\<^sub>a\<^bsub>M\<^esub> b1 =
                                        a \<plusminus>\<^bsub>M\<^esub> b \<plusminus>\<^bsub>M\<^esub> (-\<^sub>a\<^bsub>M\<^esub> a1 \<plusminus>\<^bsub>M\<^esub> -\<^sub>a\<^bsub>M\<^esub> b1)",
         frule_tac x1 = a1 and y1 = b1 in aGroup.ag_p_inv[THEN sym, of M],
          assumption+, simp,
         thin_tac "-\<^sub>a\<^bsub>M\<^esub> a1 \<plusminus>\<^bsub>M\<^esub> -\<^sub>a\<^bsub>M\<^esub> b1 = -\<^sub>a\<^bsub>M\<^esub> (a1 \<plusminus>\<^bsub>M\<^esub> b1)")
  apply (rule_tac x = "a \<plusminus>\<^bsub>M\<^esub> b" and ?x1.0 = ab and ?y1.0 = "a1 \<plusminus>\<^bsub>M1\<^esub> b1" in
          mprojTr2[of M1 M2 M], assumption+,
         frule Module.module_is_ag[of M1],
         simp add:aGroup.ag_pOp_closed[of M1], unfold ds2_def,
         frule conjunct2[THEN conjunct1], fold ds2_def,
         subst msub_addition[of M M1], assumption+)

apply (rule ballI)+
 apply (simp add:mproj1_def, simp add:Module.sc_mem)
 apply (frule_tac a = m in ds2_components1[of M1 M2 M], assumption+,
        erule bexE,
        unfold ds2_def, frule conjunct2[THEN conjunct1], fold ds2_def,
          simp add:msubmodule_def, (erule conjE)+,
        frule_tac c = a1 in subsetD[of "carrier M1" "carrier M"], assumption+,
        frule_tac a = a and m = "m \<plusminus>\<^bsub>M\<^esub> -\<^sub>a\<^bsub>M\<^esub> a1" in Module.sc_mem[of M2 R],
        assumption+,
        unfold ds2_def, frule conjunct2[THEN conjunct1],
        frule conjunct2[THEN conjunct2[THEN conjunct1]], fold ds2_def,
        simp add:msub_sprod[of M M2],
        frule Module.module_is_ag[of M],
        frule_tac x = a1 in aGroup.ag_mOp_closed[of M], assumption+,
        simp add:Module.sc_r_distr,
        frule Module.module_is_ag[of M1],
        frule_tac x = a1 in aGroup.ag_mOp_closed[of M1], assumption+,
        frule_tac a1 = a and x1 = "-\<^sub>a\<^bsub>M\<^esub> a1" in msub_sprod[THEN sym, of M M1],
        assumption+)
  apply (simp add:msub_mOp,
        frule_tac x1 = a1 in msub_mOp[THEN sym, of M M1], assumption+, simp)
  apply (
        thin_tac "a \<cdot>\<^sub>s\<^bsub>M\<^esub> (-\<^sub>a\<^bsub>M1\<^esub> a1) = a \<cdot>\<^sub>s\<^bsub>M1\<^esub> (-\<^sub>a\<^bsub>M1\<^esub> a1)",
        thin_tac "-\<^sub>a\<^bsub>M\<^esub> a1 = -\<^sub>a\<^bsub>M1\<^esub> a1",
        thin_tac "-\<^sub>a\<^bsub>M1\<^esub> a1 \<in> carrier M",
        frule_tac a = a and m = a1 in Module.sc_mem[of M1 R],
        assumption+,
        frule_tac a = m and ?a1.0 = a1 in mprojTr3[of M1 M2 M],
           assumption+, simp add:msub_mOp, simp,
        thin_tac "(THE x1. x1 \<in> carrier M1 \<and> m \<plusminus>\<^bsub>M\<^esub> -\<^sub>a\<^bsub>M\<^esub> x1 \<in> carrier M2) = a1",
        frule_tac a = "a \<cdot>\<^sub>s\<^bsub>M\<^esub> m" and ?a1.0 = "a \<cdot>\<^sub>s\<^bsub>M1\<^esub> a1" in
         mprojTr3[of M1 M2 M], assumption+,
        simp add:Module.sc_mem, assumption)
  apply (simp add:msub_mOp msub_sprod,
         simp add:Module.sc_minus_am[of M R])
  apply simp
done

lemma (in Ring) mproj2:"\<lbrakk>R module M1; R module M2; R module M; M1 \<Oplus>\<^bsub>R,M\<^esub> M2\<rbrakk>
    \<Longrightarrow> mproj2 R M1 M2 M \<in> mHom R M M2"
 apply (frule ds2_commute[of M1 M2 M], assumption+)
 apply (simp add:mproj2_def)
 apply (simp add:mproj)
done

subsection "Existence of the tensor product"

definition
  fm_gen_by_prod :: "[('r, 'm) Ring_scheme, (('a * 'b), 'r, 'm1) Module_scheme,
      ('a, 'r, 'm1) Module_scheme, ('b, 'r, 'm1) Module_scheme] \<Rightarrow> bool"
    ("(4FM\<^bsub>_\<^esub>/ _ _ _)" [100,100,101]100) where
  "FM\<^bsub>R\<^esub> P M N \<longleftrightarrow> R module P \<and> free_generator R P (M \<times>\<^sub>c N)"

lemma (in Ring) free_gen_gen:"FM\<^bsub>R\<^esub> P M N \<Longrightarrow> generator R P (M \<times>\<^sub>c N)"
apply (simp add:fm_gen_by_prod_def)
apply (erule conjE)
apply (simp add:free_generator_def)
done

lemma (in Ring) free_gen_mem:"\<lbrakk>FM\<^bsub>R\<^esub> P M N; a \<in> (M \<times>\<^sub>c N)\<rbrakk> \<Longrightarrow>  a \<in> carrier P"
apply (simp add:fm_gen_by_prod_def)
 apply (erule conjE)
 apply (simp add:free_generator_def, (erule conjE)+)
 apply (simp add:generator_def)
 apply (erule conjE)+
 apply (simp add:subsetD)
done

lemma (in Ring) mHom_lin_nsumTr:"\<lbrakk>R module M; R module N; t \<in> mHom R M N\<rbrakk> \<Longrightarrow>
 f \<in> {j. j \<le> (n::nat)} \<rightarrow> carrier M  \<longrightarrow> t (nsum M f n) = nsum N (cmp t f) n"
apply (induct_tac n)
 apply (rule impI, simp add:cmp_def)
apply (rule impI)
 apply simp
 apply (frule_tac func_pre, simp)
 apply (frule Module.module_is_ag [of M R])
 apply (frule_tac n = n in aGroup.nsum_mem [of M _ f],
        rule allI, simp add:Pi_def,
        frule_tac x = "Suc n" and A = "{j. j \<le> Suc n}" and f = f and
        B = "carrier M" in funcset_mem, simp)
 apply (simp add:Module.mHom_add cmp_def)
done

lemma (in Ring) mHom_lin_nsum:"\<lbrakk>R module M; R module N; t \<in> mHom R M N;
       f \<in> {j. j \<le> (n::nat)} \<rightarrow> carrier M\<rbrakk> \<Longrightarrow>
                           t (nsum M f n) = nsum N (cmp t f) n"
apply (simp add:mHom_lin_nsumTr)
done

lemma (in Ring) module_over_zeroring:"\<lbrakk>zeroring R; R module M\<rbrakk> \<Longrightarrow>
                    carrier M = {\<zero>\<^bsub>M\<^esub>}"
apply (simp add:zeroring_def, erule conjE)
apply (rule equalityI)
 apply (rule subsetI)
 apply (frule_tac m = x in Module.sprod_one [of M R], assumption)
 apply (cut_tac ring_one, simp)
 apply (simp add:Module.sc_0_m[of M R])
apply (frule Module.module_is_ag [of M R])
 apply (simp add:aGroup.ag_inc_zero)
done

lemma (in Ring) submodule_over_zeroring:"\<lbrakk>zeroring R; R module M;
                 submodule R M N\<rbrakk> \<Longrightarrow>  N =  {\<zero>\<^bsub>M\<^esub>}"
apply (rule equalityI)
 apply (rule subsetI)
 apply (simp add:submodule_def, (erule conjE)+)
 apply (thin_tac "\<forall>a m. a \<in> carrier R \<and> m \<in> N \<longrightarrow> a \<cdot>\<^sub>s\<^bsub>M\<^esub> m \<in> N")
 apply (cut_tac module_over_zeroring [of M])
 apply simp
 apply (frule_tac A = N and B = "{\<zero>\<^bsub>M\<^esub>}" and c = x in subsetD, assumption+)
 apply (simp, assumption+)
apply (frule Module.submodule_inc_0 [of M R N], assumption+)
 apply simp
done

definition
  Least_submodule :: "[('r, 'm) Ring_scheme, ('a, 'r, 'm1) Module_scheme,
                       'a set] \<Rightarrow> 'a set"
         ("(3LSM\<^bsub>_\<^esub>/ _/ _)" [100,100,101]100) where
  "LSM\<^bsub>R\<^esub> M T = \<Inter>{N. submodule R M N \<and> T \<subseteq> N}"

lemma (in Ring) LSM_mem:"\<lbrakk>R module M; T \<subseteq> carrier M; t \<in> T\<rbrakk> \<Longrightarrow>
                                                     t \<in> (LSM\<^bsub>R\<^esub> M T)"
apply (simp add:Least_submodule_def, rule allI, rule impI)
apply (erule conjE)
apply (simp add:subsetD)
done

lemma (in Ring) LSM_sub_M:"\<lbrakk>R module M; T \<subseteq> carrier M\<rbrakk> \<Longrightarrow>
                              (LSM\<^bsub>R\<^esub> M T) \<subseteq> carrier M"
apply (rule subsetI, simp add:Least_submodule_def)
apply (frule Module.submodule_whole[of M R])
apply (drule_tac x = "carrier M" in spec,
       simp)
done

lemma (in Ring) LSM_sub_submodule:"\<lbrakk>R module M; T \<subseteq> carrier M;
      submodule R M N; T \<subseteq> N \<rbrakk> \<Longrightarrow> (LSM\<^bsub>R\<^esub> M T) \<subseteq> N"
by (rule subsetI, simp add:Least_submodule_def)

lemma (in Ring) LSM_inc_T:"\<lbrakk>R module M; T \<subseteq> carrier M\<rbrakk> \<Longrightarrow> T \<subseteq> (LSM\<^bsub>R\<^esub> M T)"
apply (rule subsetI)
apply (simp add:LSM_mem)
done

lemma (in Ring) LSM_submodule:"\<lbrakk>R module M; T \<subseteq> carrier M\<rbrakk> \<Longrightarrow>
                submodule R M (LSM\<^bsub>R\<^esub> M T)"
apply (frule LSM_sub_M[of M T], assumption+)
 apply (subst Least_submodule_def)
 apply (simp add:submodule_def)
apply (rule conjI)
 apply (rule subsetI, simp,
        drule_tac a = "carrier M" in forall_spec)
  apply simp
  apply (frule Module.submodule_whole[of M R])
  apply (simp add:submodule_def[of R M "carrier M"], assumption)

apply (frule Module.module_is_ag [of M R])
 apply (rule aGroup.asubg_test, assumption+)
 apply (rule subsetI, simp,
        drule_tac a = "carrier M" in forall_spec, simp,
        frule Module.submodule_whole[of M R],
        simp add:submodule_def[of R M "carrier M"], assumption)
 apply (cut_tac x = "\<zero>\<^bsub>M\<^esub>" and A = "\<Inter>{N. N \<subseteq> carrier M \<and>
          M +> N \<and> (\<forall>a m. a \<in> carrier R \<and> m \<in> N \<longrightarrow> a \<cdot>\<^sub>s\<^bsub>M\<^esub> m \<in> N) \<and> T \<subseteq> N}"
        in  nonempty)
 apply simp
 apply (rule allI, rule impI, (erule conjE)+,
        frule_tac H = x in aGroup.asubg_inc_zero[of M], assumption+)

apply ((rule ballI)+, simp, rule allI, rule impI)
 apply (drule_tac x = x in spec,
        drule_tac x = x in spec)
 apply simp
 apply (frule_tac H = x and x = b in aGroup.asubg_mOp_closed[of M], simp+)
 apply (rule_tac H = x and x = a and y = "-\<^sub>a\<^bsub>M\<^esub> b" in
        aGroup.asubg_pOp_closed[of M], assumption+, simp+)
done

lemma (in Ring) linear_comb_memTr:"\<lbrakk>R module M; submodule R M N; T \<subseteq> N\<rbrakk> \<Longrightarrow>
      \<forall>f s. f \<in> {j. j \<le> (n::nat)} \<rightarrow> T \<and> s \<in> {j. j \<le> n} \<rightarrow> carrier R \<longrightarrow>
      l_comb R M n s f \<in> N"
apply (induct_tac n)
 apply ((rule allI)+, rule impI, (erule conjE)+)
 apply (simp add:l_comb_def del: Pi_split_insert_domain)
 apply (rule Module.submodule_sc_closed, assumption+)
 apply (simp add:Pi_def, simp add:Pi_def subsetD)

apply ((rule allI)+, rule impI, erule conjE)
 apply (frule_tac f = f and n = n and A = T in func_pre)
 apply (frule_tac f = s and n = n and A = "carrier R" in func_pre)
 apply (drule_tac x = f in spec,
        drule_tac x = s in spec, simp)

 apply (cut_tac whole_ideal,
        frule_tac s = s and n = n and f = f in
                   Module.l_comb_Suc[of M R T "carrier R"],
        frule Module.submodule_subset[of M R N], assumption+,
        rule subset_trans[of T N "carrier M"], assumption+, simp,
        thin_tac "l_comb R M (Suc n) s f =
        l_comb R M n s f \<plusminus>\<^bsub>M\<^esub> s (Suc n) \<cdot>\<^sub>s\<^bsub>M\<^esub> f (Suc n)")
 apply (rule Module.submodule_pOp_closed[of M R N], assumption+,
        rule_tac a = "s (Suc n)" and h = "f (Suc n)" in
         Module.submodule_sc_closed[of M R N], assumption+,
        simp add:Pi_def, simp add:Pi_def subsetD)
done

lemma (in Ring) linear_comb_mem:"\<lbrakk>R module M; submodule R M N; T \<subseteq> N;
      f \<in> {j. j \<le> (n::nat)} \<rightarrow> T; s \<in> {j. j \<le> n} \<rightarrow> carrier R\<rbrakk> \<Longrightarrow>
                      l_comb R M n s f \<in> N"
apply (simp add:linear_comb_memTr)
done

lemma (in Ring) LSM_eq_linear_span:"\<lbrakk>R module M; T \<subseteq> carrier M\<rbrakk> \<Longrightarrow>
          (LSM\<^bsub>R\<^esub> M T) = linear_span R M (carrier R) T"
apply (cut_tac whole_ideal)
apply (rule equalityI)
 apply (frule Module.linear_span_subModule[of M R "carrier R" T], assumption+)
 apply (rule LSM_sub_submodule[of M T "linear_span R M (carrier R) T"],
        assumption+, simp add:Module.l_span_cont_H[of M R T])
 apply (frule LSM_submodule[of M T], assumption)
 apply (frule LSM_inc_T[of M T], assumption)
 apply (rule Module.l_span_sub_submodule[of M R "carrier R" "LSM\<^bsub>R\<^esub> M T" T],
         assumption+)
done

lemma (in Ring) LSM_sub_ker:"\<lbrakk>R module M; R module N; T \<subseteq> carrier M;
       f \<in> mHom R M N; T \<subseteq> ker\<^bsub>M,N\<^esub> f\<rbrakk> \<Longrightarrow> LSM\<^bsub>R\<^esub> M T \<subseteq> ker\<^bsub>M,N\<^esub> f"
apply (frule Module.mker_submodule[of M R N f], assumption+)
apply (rule LSM_sub_submodule[of M T "ker\<^bsub>M,N\<^esub> f"], assumption+)
done

(* in the following costdefs, MN is the free module generated by  M \<times>\<^sub>c N *)
definition
  tensor_relations1 :: "[('r, 'm) Ring_scheme, ('a, 'r, 'm1) Module_scheme,
       ('b, 'r, 'm1) Module_scheme, (('a * 'b), 'r, 'm1) Module_scheme] \<Rightarrow>
       ('a * 'b) set"
       ("(4TR1/ _/ _/ _/ _)" [100,100,100,101]100) where
  "TR1 R M N MN = {x. \<exists>m1\<in>carrier M. \<exists>m2\<in>carrier M. \<exists>n\<in>carrier N.
       x = (m1 \<plusminus>\<^bsub>M\<^esub> m2, n) \<plusminus>\<^bsub>MN\<^esub> (-\<^sub>a\<^bsub>MN\<^esub> ((m1, n) \<plusminus>\<^bsub>MN\<^esub> (m2, n)))}"

definition
  tensor_relations2 :: "[('r, 'm) Ring_scheme, ('a, 'r, 'm1) Module_scheme,
      ('b, 'r, 'm1) Module_scheme, (('a * 'b), 'r, 'm1) Module_scheme] \<Rightarrow>
       ('a * 'b) set"
       ("(4TR2/ _/ _/ _/ _)" [100,100,100, 101]100) where
   "TR2 R M N MN = {x. \<exists>m\<in>carrier M. \<exists>n1\<in>carrier N. \<exists>n2\<in>carrier N.
            x = (m, n1 \<plusminus>\<^bsub>N\<^esub> n2) \<plusminus>\<^bsub>MN\<^esub> (-\<^sub>a\<^bsub>MN\<^esub> ((m, n1) \<plusminus>\<^bsub>MN\<^esub> (m, n2)))}"

definition
  tensor_relations3 :: "[('r, 'm) Ring_scheme, ('a, 'r, 'm1) Module_scheme,
      ('b, 'r, 'm1) Module_scheme, (('a * 'b), 'r, 'm1) Module_scheme] \<Rightarrow>
      ('a * 'b ) set"
       ("(4TR3/ _/ _/ _/ _)" [100,100,100,101]100) where
  "TR3 R M N P = {x. \<exists>m\<in>carrier M. \<exists>n\<in>carrier N. \<exists> a\<in>carrier R.
        x = (a \<cdot>\<^sub>s\<^bsub>M\<^esub> m, n) \<plusminus>\<^bsub>P\<^esub> (-\<^sub>a\<^bsub>P\<^esub> (a \<cdot>\<^sub>s\<^bsub>P\<^esub> (m, n)))}"

definition
  tensor_relations4 :: "[('r, 'm) Ring_scheme, ('a, 'r, 'm1) Module_scheme,
    ('b, 'r, 'm1) Module_scheme, (('a * 'b), 'r, 'm1) Module_scheme] \<Rightarrow>
    ('a * 'b) set"
                  ("(4TR4/ _/ _/ _/ _)" [100,100,100,101]100) where
  "TR4 R M N MN = {x. \<exists>m\<in>carrier M. \<exists>n\<in>carrier N. \<exists> a\<in>carrier R.
  x = (m, a \<cdot>\<^sub>s\<^bsub>N\<^esub> n) \<plusminus>\<^bsub>MN\<^esub> (-\<^sub>a\<^bsub>MN\<^esub> (a \<cdot>\<^sub>s\<^bsub> MN\<^esub> (m, n)))}"

definition
  tensor_relations :: "[('r, 'm) Ring_scheme, ('a, 'r, 'm1) Module_scheme,
    ('b, 'r, 'm1) Module_scheme, (('a * 'b), 'r, 'm1) Module_scheme] \<Rightarrow>
    ('a * 'b) set"
                   ("(4TR\<^bsub>_\<^esub> _/ _/ _)" [100,100,101]100) where
  "TR\<^bsub>R\<^esub> M N MN = LSM\<^bsub>R\<^esub> MN ((TR1 R M N MN) \<union> (TR2 R M N MN) \<union>
                                     (TR3 R M N MN) \<union> (TR4 R M N MN))"

definition
  tensor_product :: "[('r, 'm) Ring_scheme, ('a, 'r, 'm1) Module_scheme,
   ('b, 'r, 'm1) Module_scheme, (('a * 'b), 'r, 'm1) Module_scheme] \<Rightarrow>
   (('a * 'b) set, 'r) Module" where
  "tensor_product R M N MN = MN /\<^sub>m (TR\<^bsub>R\<^esub> M N MN)"

abbreviation
  TENSORPROD  ("(4_/ \<^bsub>_\<^esub>\<Otimes>\<^bsub>_\<^esub>/ _)" [92,92,92,93]92) where
  "M \<^bsub>P\<^esub>\<Otimes>\<^bsub>R\<^esub> N == tensor_product R M N P"

lemma (in Ring) mem_cartesian:"\<lbrakk>R module M; R module N; m \<in> carrier M;
      n \<in> carrier N \<rbrakk> \<Longrightarrow> (m, n) \<in> M \<times>\<^sub>c N"
by (simp add:prod_carr_def)

lemma (in Ring) cartesianTr:"\<lbrakk>R module M; R module N; x \<in> M \<times>\<^sub>c N\<rbrakk> \<Longrightarrow>
       \<exists>m n. m\<in>carrier M \<and> n \<in> carrier N \<and> x = (m, n)"
by (cases x) (simp add: prod_carr_def)

lemma (in Ring) free_module_mem:"\<lbrakk>R module M; R module N; m \<in> carrier M;
         n \<in> carrier N; FM\<^bsub>R\<^esub> P M N\<rbrakk> \<Longrightarrow>  (m, n) \<in> carrier P"
 apply (rule free_gen_mem [of P M N], assumption+)
 apply (simp add:prod_carr_def)
done

lemma (in Ring) FM_P_module:"\<lbrakk>R module M; R module N; FM\<^bsub>R\<^esub> P M N\<rbrakk>
        \<Longrightarrow> R module P"
by (simp add:fm_gen_by_prod_def)

lemma (in Ring) TR1_sub_carr:"\<lbrakk>R module M; R module N; FM\<^bsub>R\<^esub> P M N\<rbrakk> \<Longrightarrow>
                                      (TR1 R M N P) \<subseteq> carrier P"
apply (simp add:fm_gen_by_prod_def)
apply (erule conjE)
 apply (rule subsetI, simp add:tensor_relations1_def)
 apply ((erule bexE)+,
        frule Module.module_is_ag [of P], simp)
 apply (rule aGroup.ag_pOp_closed, assumption,
        rule free_module_mem, assumption+)
 apply (frule Module.module_is_ag[of M R],
        rule aGroup.ag_pOp_closed [of "M"], assumption+,
        simp add:fm_gen_by_prod_def)
apply (rule aGroup.ag_mOp_closed[of P], assumption,
       rule aGroup.ag_pOp_closed [of "P"], assumption+,
       rule free_module_mem, assumption+,
       simp add:fm_gen_by_prod_def)
 apply (rule free_module_mem, assumption+, simp add:fm_gen_by_prod_def)
done

lemma (in Ring) TR2_sub_carr:"\<lbrakk>R module M; R module N; FM\<^bsub>R\<^esub> P M N\<rbrakk> \<Longrightarrow>
               (TR2 R M N P) \<subseteq> carrier P"
apply (simp add:fm_gen_by_prod_def, erule conjE)
 apply (rule subsetI)
 apply (simp add:tensor_relations2_def, (erule bexE)+, simp)
 apply (frule Module.module_is_ag[of P R])
 apply (rule aGroup.ag_pOp_closed, assumption)
 apply (rule free_module_mem, assumption+)
 apply (frule Module.module_is_ag [of N R])
 apply (rule aGroup.ag_pOp_closed [of "N"], assumption+,
        simp add:fm_gen_by_prod_def)
apply (rule aGroup.ag_mOp_closed [of "P"], assumption+,
       rule aGroup.ag_pOp_closed [of "P"], assumption+,
       rule free_module_mem, assumption+, simp add:fm_gen_by_prod_def)
 apply (rule free_module_mem, assumption+,
        simp add:fm_gen_by_prod_def)
done

lemma (in Ring) TR3_sub_carr:"\<lbrakk>R module M; R module N; FM\<^bsub>R\<^esub> P M N\<rbrakk> \<Longrightarrow>
                      (TR3 R M N P) \<subseteq> carrier P"
apply (simp add:fm_gen_by_prod_def)
apply (erule conjE)
 apply (rule subsetI)
 apply (simp add:tensor_relations3_def)
 apply ((erule bexE)+, simp,
        thin_tac "x = (a \<cdot>\<^sub>s\<^bsub>M\<^esub> m, n) \<plusminus>\<^bsub>P\<^esub> -\<^sub>a\<^bsub>P\<^esub> (a \<cdot>\<^sub>s\<^bsub>P\<^esub> (m, n))")

 apply (frule Module.module_is_ag [of P R])
 apply (rule aGroup.ag_pOp_closed, assumption)
 apply (rule free_module_mem, assumption+)
 apply (simp add:Module.sc_mem, assumption,
        simp add:fm_gen_by_prod_def)
 apply (rule aGroup.ag_mOp_closed[of "P"], assumption+)
 apply (rule Module.sc_mem, assumption+)
 apply (rule free_module_mem, assumption+,
        simp add:fm_gen_by_prod_def)
done

lemma (in Ring) TR4_sub_carr:"\<lbrakk>R module M; R module N; FM\<^bsub>R\<^esub> P M N\<rbrakk> \<Longrightarrow>
                       (TR4 R M N P) \<subseteq> carrier P"
apply (simp add:fm_gen_by_prod_def)
apply (erule conjE)
 apply (rule subsetI)
 apply (simp add:tensor_relations4_def)
 apply ((erule bexE)+, simp)

 apply (frule Module.module_is_ag [of P R])
 apply (rule aGroup.ag_pOp_closed, assumption)
 apply (rule free_module_mem, assumption+,
        simp add:Module.sc_mem, simp add:fm_gen_by_prod_def)
 apply (rule aGroup.ag_mOp_closed[of P], assumption+)
 apply (rule Module.sc_mem, assumption+)
 apply (rule free_module_mem, assumption+,
        simp add:fm_gen_by_prod_def)
done

lemma (in Ring) TR_sub_carr:"\<lbrakk>R module M; R module N; FM\<^bsub>R\<^esub> P M N\<rbrakk> \<Longrightarrow>
  (TR1 R M N P) \<union> (TR2 R M N P) \<union> (TR3 R M N P) \<union> (TR4 R M N P) \<subseteq> carrier P"
apply (rule subsetI)
 apply (case_tac "x \<in> TR1 R M N P", simp)
 apply (frule TR1_sub_carr [of M N P], assumption+, simp add:subsetD)

 apply (case_tac "x \<in> TR2 R M N P", simp,
        frule TR2_sub_carr [of M N P], assumption+, simp add:subsetD)

 apply (case_tac "x \<in> TR3 R M N P", simp,
         frule TR3_sub_carr [of M N P], assumption+, simp add:subsetD)

apply simp
 apply (frule TR4_sub_carr [of M N P], assumption+, simp add:subsetD)
done

lemma (in Ring) TR_submodule:"\<lbrakk>R module M; R module N; FM\<^bsub>R\<^esub> P M N\<rbrakk> \<Longrightarrow>
                 submodule R P (TR\<^bsub>R\<^esub> M N P)"
apply (simp add:tensor_relations_def)
 apply (rule LSM_submodule[of P _])
 apply (simp add:fm_gen_by_prod_def)
 apply (rule TR_sub_carr, assumption+)
done

lemma (in Ring) TR_cont_TR1234:"\<lbrakk>R module M; R module N; FM\<^bsub>R\<^esub> P M N\<rbrakk> \<Longrightarrow>
  TR1 R M N P \<union> TR2 R M N P \<union> TR3 R M N P \<union> TR4 R M N P \<subseteq> TR\<^bsub>R\<^esub> M N P"
apply (simp add:tensor_relations_def)
 apply (cut_tac LSM_inc_T [of P "TR1 R M N P \<union> TR2 R M N P \<union> TR3 R M N P \<union>
         TR4 R M N P"], simp)
 apply (simp add:fm_gen_by_prod_def)
 apply (rule TR_sub_carr, assumption+)
done

lemma (in Ring) TR1_mem:"\<lbrakk>R module M; R module N; FM\<^bsub>R\<^esub> P M N; m1 \<in> carrier M;
m2 \<in> carrier M; n \<in> carrier N\<rbrakk> \<Longrightarrow> (m1 \<plusminus>\<^bsub>M\<^esub> m2, n) \<plusminus>\<^bsub>P\<^esub> -\<^sub>a\<^bsub>P\<^esub> ((m1, n) \<plusminus>\<^bsub>P\<^esub> (m2, n))
 \<in> TR\<^bsub>R\<^esub> M N P"
apply (rule subsetD[of "TR1 R M N P" "TR\<^bsub>R\<^esub> M N P"
                          "(m1 \<plusminus>\<^bsub>M\<^esub> m2, n) \<plusminus>\<^bsub>P\<^esub> -\<^sub>a\<^bsub>P\<^esub> ((m1, n) \<plusminus>\<^bsub>P\<^esub> (m2, n))"])
apply (rule subset_trans[of "TR1 R M N P" "TR1 R M N P \<union> TR2 R M N P \<union>
       TR3 R M N P \<union> TR4 R M N P" "TR\<^bsub>R\<^esub> M N P"],
       rule subsetI, simp,
       cut_tac TR_cont_TR1234[of M N P], assumption+)
apply (simp add:tensor_relations1_def)
apply blast
done

lemma (in Ring) TR2_mem:"\<lbrakk>R module M; R module N; FM\<^bsub>R\<^esub> P M N; m \<in> carrier M;
       n1 \<in> carrier N; n2 \<in> carrier N \<rbrakk> \<Longrightarrow>
     (m, n1 \<plusminus>\<^bsub>N\<^esub> n2) \<plusminus>\<^bsub>P\<^esub> -\<^sub>a\<^bsub>P\<^esub> ((m, n1) \<plusminus>\<^bsub>P\<^esub> (m, n2)) \<in> TR\<^bsub>R\<^esub> M N P"
apply (rule subsetD[of "TR2 R M N P" "TR\<^bsub>R\<^esub> M N P"
                          "(m, n1 \<plusminus>\<^bsub>N\<^esub> n2) \<plusminus>\<^bsub>P\<^esub> -\<^sub>a\<^bsub>P\<^esub> ((m, n1) \<plusminus>\<^bsub>P\<^esub> (m, n2))"])
apply (rule subset_trans[of "TR2 R M N P" "TR1 R M N P \<union> TR2 R M N P \<union>
       TR3 R M N P \<union> TR4 R M N P" "TR\<^bsub>R\<^esub> M N P"],
       rule subsetI, simp,
       cut_tac TR_cont_TR1234[of M N P], assumption+)
apply (simp add:tensor_relations2_def)
apply blast
done

lemma (in Ring) TR3_mem:"\<lbrakk>R module M; R module N; FM\<^bsub>R\<^esub> P M N; m \<in> carrier M;
      n \<in> carrier N; a \<in> carrier R\<rbrakk> \<Longrightarrow>
         (a \<cdot>\<^sub>s\<^bsub>M\<^esub> m, n) \<plusminus>\<^bsub>P\<^esub> -\<^sub>a\<^bsub>P\<^esub> (a \<cdot>\<^sub>s\<^bsub>P\<^esub> (m, n)) \<in> TR\<^bsub>R\<^esub> M N P"
apply (rule subsetD[of "TR3 R M N P" "TR\<^bsub>R\<^esub> M N P"
                          "(a \<cdot>\<^sub>s\<^bsub>M\<^esub> m, n) \<plusminus>\<^bsub>P\<^esub> -\<^sub>a\<^bsub>P\<^esub> (a \<cdot>\<^sub>s\<^bsub>P\<^esub> (m, n))"])
apply (rule subset_trans[of "TR3 R M N P" "TR1 R M N P \<union> TR2 R M N P \<union>
       TR3 R M N P \<union> TR4 R M N P" "TR\<^bsub>R\<^esub> M N P"],
       rule subsetI, simp,
       cut_tac TR_cont_TR1234[of M N P], assumption+)
apply (simp add:tensor_relations3_def)
apply blast
done

lemma (in Ring) TR4_mem:"\<lbrakk>R module M; R module N; FM\<^bsub>R\<^esub> P M N; m \<in> carrier M;
       n \<in> carrier N; a \<in> carrier R\<rbrakk> \<Longrightarrow>
            (m, a \<cdot>\<^sub>s\<^bsub>N\<^esub> n) \<plusminus>\<^bsub>P\<^esub> -\<^sub>a\<^bsub>P\<^esub> (a \<cdot>\<^sub>s\<^bsub>P\<^esub> (m, n)) \<in> TR\<^bsub>R\<^esub> M N P"
apply (rule subsetD[of "TR4 R M N P" "TR\<^bsub>R\<^esub> M N P"
                          "(m, a \<cdot>\<^sub>s\<^bsub>N\<^esub> n) \<plusminus>\<^bsub>P\<^esub> -\<^sub>a\<^bsub>P\<^esub> (a \<cdot>\<^sub>s\<^bsub>P\<^esub> (m, n))"])
apply (rule subset_trans[of "TR4 R M N P" "TR1 R M N P \<union> TR2 R M N P \<union>
       TR3 R M N P \<union> TR4 R M N P" "TR\<^bsub>R\<^esub> M N P"],
       rule subsetI, simp,
       cut_tac TR_cont_TR1234[of M N P], assumption+)
apply (simp add:tensor_relations4_def)
apply blast
done

lemma (in Ring) tensor_product_module:"\<lbrakk>R module M; R module N; FM\<^bsub>R\<^esub> P M N\<rbrakk> \<Longrightarrow>
       R module (tensor_product R M N P)"
apply (simp add:fm_gen_by_prod_def, erule conjE)
apply (frule TR_submodule [of M N P], assumption+)
 apply (simp add:fm_gen_by_prod_def)
 apply (simp add:tensor_product_def)
 apply (simp add:Module.qmodule_module [of P R "TR\<^bsub>R\<^esub> M N P"])
done

lemma (in Ring) tau_mpj_bilin1:"\<lbrakk> R module M; R module N; FM\<^bsub>R\<^esub> P M N;
        x1 \<in> carrier M; x2 \<in> carrier M; y \<in> carrier N\<rbrakk>  \<Longrightarrow>
  (mpj P (TR\<^bsub>R\<^esub> M N P)) ( x1 \<plusminus>\<^bsub>M\<^esub> x2, y) =
    (mpj P (TR\<^bsub>R\<^esub> M N P)) (x1, y) \<plusminus>\<^bsub>(M \<^bsub>P\<^esub>\<Otimes>\<^bsub>R\<^esub> N)\<^esub> (mpj   P (TR\<^bsub>R\<^esub> M N P) (x2, y))"
apply (frule FM_P_module[of M N P], assumption+)
apply (subgoal_tac "(x1 \<plusminus>\<^bsub>M\<^esub> x2, y) \<plusminus>\<^bsub>P\<^esub> (-\<^sub>a\<^bsub>P\<^esub> ((x1, y) \<plusminus>\<^bsub>P\<^esub> (x2, y))) \<in>
              ker\<^bsub>P,(P /\<^sub>m (TR\<^bsub>R\<^esub> M N P))\<^esub> (mpj P (TR\<^bsub>R\<^esub> M N P))")
apply (frule TR_submodule [of M N P], assumption+,
       frule Module.qmodule_module [of P R "TR\<^bsub>R\<^esub> M N P"], assumption+,
       frule Module.mpj_mHom [of P R "TR\<^bsub>R\<^esub> M N P"], assumption+,
       frule  Module.mHom_eq_ker[of P R "P /\<^sub>m (TR\<^bsub>R\<^esub> M N P)" "mpj P (TR\<^bsub>R\<^esub> M N P)"
              "( x1 \<plusminus>\<^bsub>M\<^esub> x2, y)" "(x1, y) \<plusminus>\<^bsub>P\<^esub> (x2, y)"], assumption+,
       rule free_module_mem, assumption+)
  apply (frule Module.module_is_ag [of M R],
         simp add:aGroup.ag_pOp_closed, assumption+,
         frule Module.module_is_ag [of P R],
         rule aGroup.ag_pOp_closed, assumption+,
         rule free_module_mem, assumption+,
         rule free_module_mem, assumption+)
 apply (frule_tac m = x1 and n = y in free_module_mem[of M N _ _ P],
                  assumption+,
        frule_tac m = x2 and n = y in free_module_mem[of M N _ _ P],
                  assumption+,
        simp add:Module.mHom_add[of P R "P /\<^sub>m (TR\<^bsub>R\<^esub> M N P)" "mpj P (TR\<^bsub>R\<^esub> M N P)"
          "(x1, y)" "(x2, y)"],
        simp add:tensor_product_def)
apply (frule TR_submodule [of M N P], assumption+,
       simp add:Module.mker_of_mpj, thin_tac "submodule R P (TR\<^bsub>R\<^esub> M N P)",
       simp add:TR1_mem)
done

lemma (in Ring) tau_mpj_bilin2:"\<lbrakk>R module M; R module N; FM\<^bsub>R\<^esub> P M N;
       m \<in> carrier M; n1 \<in> carrier N; n2 \<in> carrier N\<rbrakk>  \<Longrightarrow>
  (mpj P (TR\<^bsub>R\<^esub> M N P)) (m, n1 \<plusminus>\<^bsub>N\<^esub> n2) =
   (mpj P (TR\<^bsub>R\<^esub> M N P)) (m, n1) \<plusminus>\<^bsub>(M \<^bsub>P\<^esub>\<Otimes>\<^bsub>R\<^esub> N)\<^esub> (mpj P (TR\<^bsub>R\<^esub> M N P) (m, n2))"
apply (frule FM_P_module[of M N P], assumption+)
apply (subgoal_tac "(m, n1 \<plusminus>\<^bsub>N\<^esub> n2) \<plusminus>\<^bsub>P\<^esub> (-\<^sub>a\<^bsub>P\<^esub> ((m, n1) \<plusminus>\<^bsub>P\<^esub> (m, n2))) \<in>
              ker\<^bsub>P,(P /\<^sub>m (TR\<^bsub>R\<^esub> M N P))\<^esub> (mpj P (TR\<^bsub>R\<^esub> M N P))")
apply (frule TR_submodule [of M N P], assumption+,
       frule Module.qmodule_module [of P R "TR\<^bsub>R\<^esub> M N P"], assumption+,
       frule Module.mpj_mHom [of P R "TR\<^bsub>R\<^esub> M N P"], assumption+,
       frule  Module.mHom_eq_ker[of P R "P /\<^sub>m (TR\<^bsub>R\<^esub> M N P)" "mpj P (TR\<^bsub>R\<^esub> M N P)"
              "(m, n1 \<plusminus>\<^bsub>N\<^esub> n2)" "(m, n1) \<plusminus>\<^bsub>P\<^esub> (m, n2)"], assumption+,
       rule free_module_mem, assumption+)
  apply (frule Module.module_is_ag [of N R],
         simp add:aGroup.ag_pOp_closed, assumption+,
         frule Module.module_is_ag [of P R],
         rule aGroup.ag_pOp_closed, assumption+,
         rule free_module_mem, assumption+,
         rule free_module_mem, assumption+)
 apply (frule_tac m = m and n = n1 in free_module_mem[of M N _ _ P],
                  assumption+,
        frule_tac m = m and n = n2 in free_module_mem[of M N _ _ P],
                  assumption+, simp add:tensor_product_def)
 apply (rule Module.mHom_add[of P R "P /\<^sub>m (TR\<^bsub>R\<^esub> M N P)" "mpj P (TR\<^bsub>R\<^esub> M N P)"
          "(m, n1)" "(m, n2)"], assumption+)
apply (frule TR_submodule [of M N P], assumption+,
       simp add:Module.mker_of_mpj, thin_tac "submodule R P (TR\<^bsub>R\<^esub> M N P)",
       simp add:TR2_mem)
done

lemma (in Ring) tau_mpj_bilin3:"\<lbrakk>R module M; R module N; FM\<^bsub>R\<^esub> P M N;
   m \<in> carrier M; n \<in> carrier N; a \<in> carrier R\<rbrakk>  \<Longrightarrow>
  (mpj P (TR\<^bsub>R\<^esub> M N P)) (a \<cdot>\<^sub>s\<^bsub>M\<^esub> m, n) = a \<cdot>\<^sub>s\<^bsub>(M \<^bsub>P\<^esub>\<Otimes>\<^bsub>R\<^esub> N)\<^esub>
                                        (mpj P (TR\<^bsub>R\<^esub> M N P) (m, n))"
apply (frule FM_P_module[of M N P], assumption+)
apply (subgoal_tac "(a \<cdot>\<^sub>s\<^bsub>M\<^esub> m, n) \<plusminus>\<^bsub>P\<^esub> -\<^sub>a\<^bsub>P\<^esub> (a \<cdot>\<^sub>s\<^bsub>P\<^esub> (m, n)) \<in>
          ker\<^bsub>P,(P /\<^sub>m (TR\<^bsub>R\<^esub> M N P))\<^esub> (mpj P (TR\<^bsub>R\<^esub> M N P))")
apply (frule TR_submodule [of M N P], assumption+,
       frule Module.qmodule_module [of P R "TR\<^bsub>R\<^esub> M N P"], assumption+,
       frule Module.mpj_mHom [of P R "TR\<^bsub>R\<^esub> M N P"], assumption+,
       frule  Module.mHom_eq_ker[of P R "P /\<^sub>m (TR\<^bsub>R\<^esub> M N P)" "mpj P (TR\<^bsub>R\<^esub> M N P)"
              "(a \<cdot>\<^sub>s\<^bsub>M\<^esub> m, n)" "a \<cdot>\<^sub>s\<^bsub>P\<^esub> (m, n)"], assumption+,
       rule free_module_mem, assumption+)
  apply (simp add:Module.sc_mem, assumption+)
 apply (frule_tac m = m and n = n in free_module_mem[of M N _ _ P],
                  assumption+,
        simp add:Module.sc_mem,
                  assumption+, simp add:tensor_product_def)
 apply (rule Module.mHom_lin[of P R "P /\<^sub>m (TR\<^bsub>R\<^esub> M N P)" "(m, n)"
        "mpj P (TR\<^bsub>R\<^esub> M N P)" a], assumption+, simp add:free_module_mem,
        assumption+)
apply (frule TR_submodule [of M N P], assumption+,
       simp add:Module.mker_of_mpj, thin_tac "submodule R P (TR\<^bsub>R\<^esub> M N P)",
       simp add:TR3_mem)
done

lemma (in Ring) tau_mpj_bilin4:"\<lbrakk>R module M; R module N; FM\<^bsub>R\<^esub> P M N;
      m \<in> carrier M; n \<in> carrier N; a \<in> carrier R\<rbrakk>  \<Longrightarrow>
     (mpj P (TR\<^bsub>R\<^esub> M N P)) (m, a \<cdot>\<^sub>s\<^bsub>N\<^esub> n) = a \<cdot>\<^sub>s\<^bsub>(M \<^bsub>P\<^esub>\<Otimes>\<^bsub>R\<^esub> N)\<^esub>
            (mpj P (TR\<^bsub>R\<^esub> M N P) (m, n))"
apply (frule FM_P_module[of M N P], assumption+)
apply (subgoal_tac "(m, a \<cdot>\<^sub>s\<^bsub>N\<^esub> n) \<plusminus>\<^bsub>P\<^esub> -\<^sub>a\<^bsub>P\<^esub> (a \<cdot>\<^sub>s\<^bsub>P\<^esub> (m, n)) \<in>
          ker\<^bsub>P,(P /\<^sub>m (TR\<^bsub>R\<^esub> M N P))\<^esub> (mpj P (TR\<^bsub>R\<^esub> M N P))")
apply (frule TR_submodule [of M N P], assumption+,
       frule Module.qmodule_module [of P R "TR\<^bsub>R\<^esub> M N P"], assumption+,
       frule Module.mpj_mHom [of P R "TR\<^bsub>R\<^esub> M N P"], assumption+,
       frule  Module.mHom_eq_ker[of P R "P /\<^sub>m (TR\<^bsub>R\<^esub> M N P)" "mpj P (TR\<^bsub>R\<^esub> M N P)"
              "(m, a \<cdot>\<^sub>s\<^bsub>N\<^esub> n)" "a \<cdot>\<^sub>s\<^bsub>P\<^esub> (m, n)"], assumption+,
       rule free_module_mem, assumption+)
  apply (simp add:Module.sc_mem, assumption+)
 apply (frule_tac m = m and n = n in free_module_mem[of M N _ _ P],
                  assumption+,
        simp add:Module.sc_mem,
                  assumption+, simp add:tensor_product_def)
 apply (rule Module.mHom_lin[of P R "P /\<^sub>m (TR\<^bsub>R\<^esub> M N P)" "(m, n)"
        "mpj P (TR\<^bsub>R\<^esub> M N P)" a], assumption+, simp add:free_module_mem,
        assumption+)
apply (frule TR_submodule [of M N P], assumption+,
       simp add:Module.mker_of_mpj, thin_tac "submodule R P (TR\<^bsub>R\<^esub> M N P)",
       simp add:TR4_mem)
done

definition
  tau :: "[('r, 'm) Ring_scheme, ('a, 'r, 'm1) Module_scheme,
        ('b, 'r, 'm1) Module_scheme, (('a * 'b), 'r, 'm1) Module_scheme] \<Rightarrow>
                                            ('a * 'b) \<Rightarrow> ('a * 'b)" where
  "tau R M N P = (\<lambda>x\<in>(M \<times>\<^sub>c N). x)"

lemma (in Ring) tau_func:"\<lbrakk>R module M; R module N; FM\<^bsub>R\<^esub> P M N\<rbrakk> \<Longrightarrow>
                                 tau R M N P \<in> M \<times>\<^sub>c N \<rightarrow> carrier P"
 apply (rule Pi_I)
 apply (frule_tac x = x in cartesianTr [of M N], assumption+)
 apply ((erule exE)+, (erule conjE)+, simp add:tau_def)
apply (simp add:free_module_mem)
done

lemma (in Ring) tau_mem:"\<lbrakk>R module M; R module N; m \<in> carrier M;
      n \<in> carrier N; FM\<^bsub>R\<^esub> P M N\<rbrakk> \<Longrightarrow> tau R M N P (m, n) \<in> carrier P"
apply (frule tau_func [of M N P], assumption+)
apply (rule funcset_mem, assumption+)
apply (simp add:prod_carr_mem)
done

lemma (in Ring) tau_inj0:"\<lbrakk>\<not> zeroring R;  R module M; R module N; FM\<^bsub>R\<^esub> P M N\<rbrakk>
      \<Longrightarrow> inj_on (tau R M N P) (M \<times>\<^sub>c N)"
apply (simp add:inj_on_def, (rule ballI)+)
 apply (rule impI)
 apply (simp add:tau_def)
done

lemma (in Ring) tau_inj1:"\<lbrakk>zeroring R; R module M; R module N; FM\<^bsub>R\<^esub> P M N\<rbrakk> \<Longrightarrow>
           inj_on (tau R M N P) (M \<times>\<^sub>c N)"
apply (simp add:inj_on_def)
apply ((rule ballI)+, rule impI)
apply (frule module_over_zeroring[of M], assumption+)
apply (frule module_over_zeroring[of N], assumption+)
apply (simp add:zeroring_def, erule conjE)
apply (frule_tac x = x in cartesianTr[of M N], assumption+)
 apply ((erule exE)+, (erule conjE)+, simp add:tau_def)
done

lemma (in Ring) tau_inj:"\<lbrakk>R module M; R module N; FM\<^bsub>R\<^esub> P M N\<rbrakk> \<Longrightarrow>
                inj_on (tau R M N P) (M \<times>\<^sub>c N)"
apply (case_tac "zeroring R")
 apply (simp add:tau_inj1)
 apply (simp add:tau_inj0)
done

lemma (in Ring) tau_mpj_bilinear:"\<lbrakk>R module M; R module N; FM\<^bsub>R\<^esub> P M N\<rbrakk> \<Longrightarrow>
      bilinear_map (compose (M \<times>\<^sub>c N) (mpj P (TR\<^bsub>R\<^esub> M N P)) (tau R M N P))
                     R M N (M \<^bsub>P\<^esub>\<Otimes>\<^bsub>R\<^esub> N)"
apply (simp add:bilinear_map_def)
apply (rule conjI)
 apply (rule Pi_I)
 apply (simp add:compose_def tau_def tensor_product_def)
 apply (frule TR_submodule [of M N P], assumption+)
 apply (frule FM_P_module[of M N P], assumption+,
        frule Module.mpj_mHom[of P R "TR\<^bsub>R\<^esub> M N P"], assumption+)
 apply (frule Module.qmodule_module [of P R "TR\<^bsub>R\<^esub> M N P"], assumption+,
       rule Module.mHom_mem [of P R "P /\<^sub>m (TR\<^bsub>R\<^esub> M N P)" "(mpj P (TR\<^bsub>R\<^esub> M N P))"],
       assumption+, simp add:free_gen_mem)
apply (rule conjI)
 apply (rule ballI)+
 apply (simp add:compose_def tau_def mem_cartesian)
 apply (frule Module.module_is_ag[of M R],
        frule_tac x = x1 and y = x2 in aGroup.ag_pOp_closed, assumption+,
        simp add:mem_cartesian, simp add:tau_mpj_bilin1)
apply (rule conjI)
 apply (rule ballI)+
 apply (simp add:compose_def tau_def mem_cartesian)
 apply (frule Module.module_is_ag[of N R],
        frule_tac x = y1 and y = y2 in aGroup.ag_pOp_closed, assumption+,
        simp add:mem_cartesian, simp add:tau_mpj_bilin2)
apply (rule ballI)+
 apply (rule conjI)
 apply (simp add:compose_def tau_def mem_cartesian)
 apply (frule_tac a = r and m = x in Module.sc_mem[of M R], assumption+,
        simp add:mem_cartesian, simp add:tau_mpj_bilin3)
 apply (simp add:compose_def tau_def mem_cartesian)
 apply (frule_tac a = r and m = y in Module.sc_mem[of N R], assumption+,
        simp add:mem_cartesian, simp add:tau_mpj_bilin4)
done

definition
  tnm :: "[('r, 'm) Ring_scheme, (('a * 'b), 'r, 'm1) Module_scheme,
        ('a, 'r, 'm1) Module_scheme, ('b, 'r, 'm1) Module_scheme] \<Rightarrow>
        ('a * 'b) \<Rightarrow> ('a * 'b) set" where
  "tnm R P M N = compose (M \<times>\<^sub>c N) (mpj P (TR\<^bsub>R\<^esub> M N P)) (tau R M N P)"
 (* tensor natural map *)

lemma (in Ring) tnm_bilinear:"\<lbrakk>R module M; R module N; FM\<^bsub>R\<^esub> P M N\<rbrakk> \<Longrightarrow>
        bilinear_map (tnm R P M N) R M N (M \<^bsub>P\<^esub>\<Otimes>\<^bsub>R\<^esub> N)"
apply (simp add:tnm_def)
apply (simp add:tau_mpj_bilinear)
done

lemma (in Ring) tnm_mem:"\<lbrakk> R module M; R module N; FM\<^bsub>R\<^esub> P M N; m \<in> carrier M;
       n \<in> carrier N\<rbrakk>  \<Longrightarrow> tnm R P M N (m, n) \<in> carrier (M \<^bsub>P\<^esub>\<Otimes>\<^bsub>R\<^esub> N)"
apply (simp add:tnm_def)
apply (frule tau_mem [of M N m n], assumption+)
 apply (simp add:compose_def, simp add:prod_carr_def)
 apply (simp add:tensor_product_def)
 apply (frule TR_submodule [of M N P], assumption+)
apply (rule Module.mpj_mem[of P R "TR\<^bsub>R\<^esub> M N P" "tau R M N P (m, n)"],
       rule FM_P_module[of M N P], assumption+)
done

definition
  tensor_elem :: "[('r, 'm) Ring_scheme, (('a * 'b), 'r, 'm1) Module_scheme,
   ('a, 'r, 'm1) Module_scheme, ('b, 'r, 'm1) Module_scheme] \<Rightarrow> 'a \<Rightarrow>  'b
   \<Rightarrow> ('a * 'b) set" where
  "tensor_elem R P M N m n = tnm R P M N (m, n)"

abbreviation
  TNSELEM  ("(6_ \<^bsub>_,_\<^esub>\<otimes>\<^bsub>_,_\<^esub>/ _)" [100,100,100,100,100,101]101) where
  "m \<^bsub>R,P\<^esub>\<otimes>\<^bsub>M,N\<^esub> n == tensor_elem R P M N m n"

lemma (in Ring) tensor_univ_propTr:"\<lbrakk>R module M; R module N; FM\<^bsub>R\<^esub> P M N;
      R module Z; bilinear_map f R M N Z\<rbrakk> \<Longrightarrow>
     \<exists>g. g \<in> mHom R P Z \<and> (compose (M \<times>\<^sub>c N) g (tau R M N P)) = f"
apply (unfold fm_gen_by_prod_def)
 apply (frule conjunct1, frule conjunct2)
 apply (fold fm_gen_by_prod_def)
 apply (frule bilinear_func[of f M N Z])
apply (frule Module.exist_extension_mhom [of P R Z "M \<times>\<^sub>c N" "f"], assumption+)
 apply (erule bexE, rename_tac h)
 apply (subgoal_tac "compose (M \<times>\<^sub>c N) h (tau R M N P) = f")
 apply blast
apply (rule funcset_eq [of _ "M \<times>\<^sub>c N"])
 apply (simp add:compose_def, simp add:bilinear_map_def)
 apply (rule ballI)
 apply (simp add:compose_def tau_def)
done

lemma (in Ring) tensor_univ_propTr1:"\<lbrakk>R module M; R module N; FM\<^bsub>R\<^esub> P M N;
      R module Z; bilinear_map f R M N Z\<rbrakk> \<Longrightarrow>
     \<exists>!g. g\<in>(mHom R (M \<^bsub>P\<^esub>\<Otimes>\<^bsub>R\<^esub> N) Z) \<and> (compose (M \<times>\<^sub>c N) g (tnm R P M N)) = f"
apply (frule Module.module_is_ag[of M],
       frule Module.module_is_ag[of N],
       frule FM_P_module[of M N P], assumption+,
       frule Module.module_is_ag[of P])
apply (simp add:tnm_def)

 apply (frule tensor_univ_propTr[of M N P Z f], assumption+)
 apply (erule exE, erule conjE,
        frule TR_submodule[of M N P], assumption+,
        frule_tac Module.indmhom1[of P R "TR\<^bsub>R\<^esub> M N P" Z], assumption+,
        frule Module.submodule_subset[of P R "TR\<^bsub>R\<^esub> M N P"], assumption+,
        simp add:tensor_relations_def)
 apply (rule_tac f = g in LSM_sub_ker[of P Z "(TR1 R M N P \<union> TR2 R M N P
        \<union> TR3 R M N P \<union> TR4 R M N P)"], assumption+,
        rule TR_sub_carr, assumption+,
        thin_tac "submodule R P
          (LSM\<^bsub>R\<^esub> P (TR1 R M N P \<union> TR2 R M N P \<union> TR3 R M N P \<union> TR4 R M N P))",
        thin_tac "LSM\<^bsub>R\<^esub> P (TR1 R M N P \<union> TR2 R M N P \<union> TR3 R M N P \<union>
          TR4 R M N P) \<subseteq> carrier P")

(** show member of TR1 is in ker\<^bsub>P,Z\<^esub> g **)
 apply (rule subsetI, simp, erule disjE,
        frule TR1_sub_carr[of M N P], assumption+,
        frule_tac c = x in subsetD[of "TR1 R M N P" "carrier P"], assumption+,
        thin_tac "TR1 R M N P \<subseteq> carrier P",
        simp add:tensor_relations1_def, (erule bexE)+, simp add:ker_def)
 apply (frule_tac x = m1 and y = m2 in aGroup.ag_pOp_closed, assumption+,
        frule_tac m = "m1 \<plusminus>\<^bsub>M\<^esub> m2" and n = n in free_module_mem[of M N],
         assumption+,
        frule_tac m = m1 and n = n in free_module_mem[of M N], assumption+,
        frule_tac m = m2 and n = n in free_module_mem[of M N], assumption+)
apply (subst Module.mHom_add[of P R Z], assumption+,
       rule aGroup.ag_mOp_closed, assumption+,
       rule aGroup.ag_pOp_closed, assumption+,
       frule_tac x = "(m1, n)" and y = "(m2, n)" in aGroup.ag_pOp_closed,
       assumption+,
       simp add:Module.mHom_inv[of P R Z] Module.mHom_add)
 apply (frule_tac f = "compose (M \<times>\<^sub>c N) g (tau R M N P)" and g = f and
                x = "(m1 \<plusminus>\<^bsub>M\<^esub> m2, n)" in eq_fun_eq_val,
        frule_tac f = "compose (M \<times>\<^sub>c N) g (tau R M N P)" and g = f and
                x = "(m1, n)" in eq_fun_eq_val,
        frule_tac f = "compose (M \<times>\<^sub>c N) g (tau R M N P)" and g = f and
                x = "(m2, n)" in eq_fun_eq_val,
        thin_tac "compose (M \<times>\<^sub>c N) g (tau R M N P) = f",
        simp add:compose_def cmp_def, simp add:mem_cartesian tau_def,
        simp add:bilinear_l_add1)

(** show member of TR2 is in ker\<^bsub>P,Z\<^esub> g **)
 apply (erule disjE,
        frule TR2_sub_carr[of M N P], assumption+,
        frule_tac c = x in subsetD[of "TR2 R M N P" "carrier P"], assumption+,
        thin_tac "TR2 R M N P \<subseteq> carrier P",
        simp add:tensor_relations2_def, (erule bexE)+, simp add:ker_def)
 apply (frule_tac x = n1 and y = n2 in aGroup.ag_pOp_closed, assumption+,
        frule_tac m = m and n = "n1 \<plusminus>\<^bsub>N\<^esub> n2" in free_module_mem[of M N],
         assumption+,
        frule_tac m = m and n = n1 in free_module_mem[of M N], assumption+,
        frule_tac m = m and n = n2 in free_module_mem[of M N], assumption+)
apply (subst Module.mHom_add[of P R Z], assumption+,
       rule aGroup.ag_mOp_closed, assumption+,
       rule aGroup.ag_pOp_closed, assumption+,
       frule_tac x = "(m, n1)" and y = "(m, n2)" in aGroup.ag_pOp_closed,
       assumption+,
       simp add:Module.mHom_inv[of P R Z] Module.mHom_add)
 apply (frule_tac f = "compose (M \<times>\<^sub>c N) g (tau R M N P)" and g = f and
                x = "(m, n1 \<plusminus>\<^bsub>N\<^esub> n2)" in eq_fun_eq_val,
        frule_tac f = "compose (M \<times>\<^sub>c N) g (tau R M N P)" and g = f and
                x = "(m, n1)" in eq_fun_eq_val,
        frule_tac f = "compose (M \<times>\<^sub>c N) g (tau R M N P)" and g = f and
                x = "(m, n2)" in eq_fun_eq_val,
        thin_tac "compose (M \<times>\<^sub>c N) g (tau R M N P) = f",
        simp add:compose_def cmp_def, simp add:mem_cartesian tau_def,
        simp add:bilinear_r_add1)

(** show member of TR3 is in ker\<^bsub>P,Z\<^esub> g **)
 apply (erule disjE,
        frule TR3_sub_carr[of M N P], assumption+,
        frule_tac c = x in subsetD[of "TR3 R M N P" "carrier P"], assumption+,
        thin_tac "TR3 R M N P \<subseteq> carrier P",
        simp add:tensor_relations3_def, (erule bexE)+, simp add:ker_def)
 apply (frule_tac a = a and m = m in Module.sc_mem, assumption+,
        frule_tac m = "a \<cdot>\<^sub>s\<^bsub>M\<^esub> m" and n = n in free_module_mem[of M N],
         assumption+,
        frule_tac m = m and n = n in free_module_mem[of M N], assumption+,
        frule_tac a = a and m = "(m, n)" in Module.sc_mem, assumption+,
        frule_tac x = "(a \<cdot>\<^sub>s\<^bsub>P\<^esub> (m, n))" in aGroup.ag_mOp_closed, assumption+)
apply (subst Module.mHom_add[of P R Z], assumption+,
       simp add:Module.mHom_inv[of P R Z],
       simp add:Module.mHom_lin)
 apply (frule_tac f = "compose (M \<times>\<^sub>c N) g (tau R M N P)" and g = f and
                x = "(a \<cdot>\<^sub>s\<^bsub>M\<^esub> m, n)" in eq_fun_eq_val,
        frule_tac f = "compose (M \<times>\<^sub>c N) g (tau R M N P)" and g = f and
                x = "(m, n)" in eq_fun_eq_val)
     apply (thin_tac "compose (M \<times>\<^sub>c N) g (tau R M N P) = f",
        simp add:compose_def cmp_def, simp add:mem_cartesian tau_def,
        simp add:bilinear_l_lin1)

(** show member of TR4 is in ker\<^bsub>P,Z\<^esub> g **)
 apply (frule TR4_sub_carr[of M N P], assumption+,
        frule_tac c = x in subsetD[of "TR4 R M N P" "carrier P"], assumption+,
        thin_tac "TR4 R M N P \<subseteq> carrier P",
        simp add:tensor_relations4_def, (erule bexE)+, simp add:ker_def)
 apply (frule_tac a = a and m = n in Module.sc_mem, assumption+,
        frule_tac m = m and n = "a \<cdot>\<^sub>s\<^bsub>N\<^esub> n" in free_module_mem[of M N],
         assumption+,
        frule_tac m = m and n = n in free_module_mem[of M N], assumption+,
        frule_tac a = a and m = "(m, n)" in Module.sc_mem, assumption+,
        frule_tac x = "(a \<cdot>\<^sub>s\<^bsub>P\<^esub> (m, n))" in aGroup.ag_mOp_closed, assumption+)
apply (subst Module.mHom_add[of P R Z], assumption+,
       simp add:Module.mHom_inv[of P R Z],
       simp add:Module.mHom_lin)
 apply (frule_tac f = "compose (M \<times>\<^sub>c N) g (tau R M N P)" and g = f and
                x = "(m, a \<cdot>\<^sub>s\<^bsub>N\<^esub> n)" in eq_fun_eq_val,
        frule_tac f = "compose (M \<times>\<^sub>c N) g (tau R M N P)" and g = f and
                x = "(m, n)" in eq_fun_eq_val)
     apply (thin_tac "compose (M \<times>\<^sub>c N) g (tau R M N P) = f",
        simp add:compose_def cmp_def, simp add:mem_cartesian tau_def)
        apply (simp add:bilinear_r_lin1)
 apply (frule Module.qmodule_module [of P R "TR\<^bsub>R\<^esub> M N P"], assumption+)
 apply (rule ex_ex1I)
     apply (erule ex1E, erule conjE,
            thin_tac "\<forall>y. y \<in> mHom R (P /\<^sub>m (TR\<^bsub>R\<^esub> M N P)) Z \<and>
            compos P y (mpj P (TR\<^bsub>R\<^esub> M N P)) = g \<longrightarrow> y = ga")
   apply (simp add:tensor_product_def)
   apply (cut_tac g = "mpj P (TR\<^bsub>R\<^esub> M N P)" and h = ga
          in compose_assoc[of "tau R M N P" "M \<times>\<^sub>c N" "carrier P"],
         simp add:tau_func,
        simp add:compos_def, blast)
 apply (simp add:tensor_product_def,
        thin_tac "\<exists>!ga. ga \<in> mHom R (P /\<^sub>m (TR\<^bsub>R\<^esub> M N P)) Z \<and>
              compos P ga (mpj P (TR\<^bsub>R\<^esub> M N P)) = g")
  apply (frule free_gen_gen[of P M N],
         frule Module.surjec_generator[of P R "P /\<^sub>m (TR\<^bsub>R\<^esub> M N P)"
         "mpj P (TR\<^bsub>R\<^esub> M N P)" "M \<times>\<^sub>c N"],
         simp add:Module.qmodule_module,
         simp add:Module.mpj_mHom,
         simp add:Module.mpj_surjec, assumption)
  apply (rule_tac f = ga and g = y in Module.gen_mHom_eq[of "P /\<^sub>m (TR\<^bsub>R\<^esub> M N P)"
         R Z "mpj P (TR\<^bsub>R\<^esub> M N P) ` M \<times>\<^sub>c N"], assumption+, simp, simp)
  apply (erule conjE)+
  apply (rule ballI,
      thin_tac "generator R (P /\<^sub>m (TR\<^bsub>R\<^esub> M N P)) (mpj P (TR\<^bsub>R\<^esub> M N P) ` M \<times>\<^sub>c N)",
      simp add:image_def, erule bexE)
  apply (frule_tac f = "compose (M \<times>\<^sub>c N) ga
         (compose (M \<times>\<^sub>c N) (mpj P (TR\<^bsub>R\<^esub> M N P)) (tau R M N P))" and g = f and
         x = x in eq_fun_eq_val,
         thin_tac "compose (M \<times>\<^sub>c N) ga (compose (M \<times>\<^sub>c N) (mpj P (TR\<^bsub>R\<^esub> M N P))
                   (tau R M N P)) = f",
         frule_tac f = "compose (M \<times>\<^sub>c N) y
         (compose (M \<times>\<^sub>c N) (mpj P (TR\<^bsub>R\<^esub> M N P)) (tau R M N P))" and g = f and
         x = x in eq_fun_eq_val,
         thin_tac "compose (M \<times>\<^sub>c N) y (compose (M \<times>\<^sub>c N) (mpj P (TR\<^bsub>R\<^esub> M N P))
                   (tau R M N P)) = f")
   apply (simp add:compose_def tau_def)
done

lemma (in Ring) tensor_universal_property:"\<lbrakk>R module M; R module N; FM\<^bsub>R\<^esub> P M N \<rbrakk>
 \<Longrightarrow>  universal_property R M N (M \<^bsub>P\<^esub>\<Otimes>\<^bsub>R\<^esub> N) (tnm R P M N)"
apply (simp add:universal_property_def)
 apply (frule tau_mpj_bilinear [of M N], assumption+)
 apply (rule conjI, simp add:tnm_def)
apply ((rule allI)+, rule impI, erule conjE)
 apply (rule_tac Z = Z and f = g in tensor_univ_propTr1 [of M N],
             assumption+)
done

    (*                    f
                  M \<times> N  \<longrightarrow> Z
                    |       /
         tnp R M N  |      / g
                    |     /
                  M \<Otimes>\<^sub>R N
     *)

end