src/HOL/Algebra/QuotRing.thy
author paulson <lp15@cam.ac.uk>
Sat Jun 30 15:44:04 2018 +0100 (12 months ago)
changeset 68551 b680e74eb6f2
parent 67443 3abf6a722518
child 68582 b9b9e2985878
child 68583 654e73d05495
permissions -rw-r--r--
More on Algebra by Paulo and Martin
wenzelm@35849
     1
(*  Title:      HOL/Algebra/QuotRing.thy
wenzelm@35849
     2
    Author:     Stephan Hohe
lp15@68551
     3
    Author:     Paulo Emílio de Vilhena
lp15@68551
     4
ballarin@20318
     5
*)
ballarin@20318
     6
ballarin@20318
     7
theory QuotRing
ballarin@20318
     8
imports RingHom
ballarin@20318
     9
begin
ballarin@20318
    10
wenzelm@61382
    11
section \<open>Quotient Rings\<close>
ballarin@27717
    12
wenzelm@61382
    13
subsection \<open>Multiplication on Cosets\<close>
ballarin@20318
    14
wenzelm@45005
    15
definition rcoset_mult :: "[('a, _) ring_scheme, 'a set, 'a set, 'a set] \<Rightarrow> 'a set"
wenzelm@23463
    16
    ("[mod _:] _ \<Otimes>\<index> _" [81,81,81] 80)
wenzelm@35848
    17
  where "rcoset_mult R I A B = (\<Union>a\<in>A. \<Union>b\<in>B. I +>\<^bsub>R\<^esub> (a \<otimes>\<^bsub>R\<^esub> b))"
ballarin@20318
    18
ballarin@20318
    19
wenzelm@61382
    20
text \<open>@{const "rcoset_mult"} fulfils the properties required by
wenzelm@61382
    21
  congruences\<close>
ballarin@20318
    22
lemma (in ideal) rcoset_mult_add:
wenzelm@45005
    23
    "x \<in> carrier R \<Longrightarrow> y \<in> carrier R \<Longrightarrow> [mod I:] (I +> x) \<Otimes> (I +> y) = I +> (x \<otimes> y)"
wenzelm@45005
    24
  apply rule
wenzelm@45005
    25
  apply (rule, simp add: rcoset_mult_def, clarsimp)
wenzelm@45005
    26
  defer 1
wenzelm@45005
    27
  apply (rule, simp add: rcoset_mult_def)
wenzelm@45005
    28
  defer 1
ballarin@20318
    29
proof -
ballarin@20318
    30
  fix z x' y'
ballarin@20318
    31
  assume carr: "x \<in> carrier R" "y \<in> carrier R"
wenzelm@45005
    32
    and x'rcos: "x' \<in> I +> x"
wenzelm@45005
    33
    and y'rcos: "y' \<in> I +> y"
wenzelm@45005
    34
    and zrcos: "z \<in> I +> x' \<otimes> y'"
wenzelm@45005
    35
wenzelm@45005
    36
  from x'rcos have "\<exists>h\<in>I. x' = h \<oplus> x"
wenzelm@45005
    37
    by (simp add: a_r_coset_def r_coset_def)
wenzelm@45005
    38
  then obtain hx where hxI: "hx \<in> I" and x': "x' = hx \<oplus> x"
wenzelm@45005
    39
    by fast+
ballarin@20318
    40
wenzelm@45005
    41
  from y'rcos have "\<exists>h\<in>I. y' = h \<oplus> y"
wenzelm@45005
    42
    by (simp add: a_r_coset_def r_coset_def)
wenzelm@45005
    43
  then obtain hy where hyI: "hy \<in> I" and y': "y' = hy \<oplus> y"
wenzelm@45005
    44
    by fast+
ballarin@20318
    45
wenzelm@45005
    46
  from zrcos have "\<exists>h\<in>I. z = h \<oplus> (x' \<otimes> y')"
wenzelm@45005
    47
    by (simp add: a_r_coset_def r_coset_def)
wenzelm@45005
    48
  then obtain hz where hzI: "hz \<in> I" and z: "z = hz \<oplus> (x' \<otimes> y')"
wenzelm@45005
    49
    by fast+
ballarin@20318
    50
ballarin@20318
    51
  note carr = carr hxI[THEN a_Hcarr] hyI[THEN a_Hcarr] hzI[THEN a_Hcarr]
ballarin@20318
    52
ballarin@20318
    53
  from z have "z = hz \<oplus> (x' \<otimes> y')" .
wenzelm@45005
    54
  also from x' y' have "\<dots> = hz \<oplus> ((hx \<oplus> x) \<otimes> (hy \<oplus> y))" by simp
wenzelm@45005
    55
  also from carr have "\<dots> = (hz \<oplus> (hx \<otimes> (hy \<oplus> y)) \<oplus> x \<otimes> hy) \<oplus> x \<otimes> y" by algebra
wenzelm@45005
    56
  finally have z2: "z = (hz \<oplus> (hx \<otimes> (hy \<oplus> y)) \<oplus> x \<otimes> hy) \<oplus> x \<otimes> y" .
ballarin@20318
    57
wenzelm@45005
    58
  from hxI hyI hzI carr have "hz \<oplus> (hx \<otimes> (hy \<oplus> y)) \<oplus> x \<otimes> hy \<in> I"
wenzelm@45005
    59
    by (simp add: I_l_closed I_r_closed)
ballarin@20318
    60
wenzelm@45005
    61
  with z2 have "\<exists>h\<in>I. z = h \<oplus> x \<otimes> y" by fast
wenzelm@45005
    62
  then show "z \<in> I +> x \<otimes> y" by (simp add: a_r_coset_def r_coset_def)
ballarin@20318
    63
next
ballarin@20318
    64
  fix z
ballarin@20318
    65
  assume xcarr: "x \<in> carrier R"
wenzelm@45005
    66
    and ycarr: "y \<in> carrier R"
wenzelm@45005
    67
    and zrcos: "z \<in> I +> x \<otimes> y"
wenzelm@45005
    68
  from xcarr have xself: "x \<in> I +> x" by (intro a_rcos_self)
wenzelm@45005
    69
  from ycarr have yself: "y \<in> I +> y" by (intro a_rcos_self)
wenzelm@45005
    70
  show "\<exists>a\<in>I +> x. \<exists>b\<in>I +> y. z \<in> I +> a \<otimes> b"
wenzelm@45005
    71
    using xself and yself and zrcos by fast
ballarin@20318
    72
qed
ballarin@20318
    73
ballarin@20318
    74
wenzelm@61382
    75
subsection \<open>Quotient Ring Definition\<close>
ballarin@20318
    76
wenzelm@45005
    77
definition FactRing :: "[('a,'b) ring_scheme, 'a set] \<Rightarrow> ('a set) ring"
wenzelm@45005
    78
    (infixl "Quot" 65)
wenzelm@35848
    79
  where "FactRing R I =
wenzelm@45005
    80
    \<lparr>carrier = a_rcosets\<^bsub>R\<^esub> I, mult = rcoset_mult R I,
wenzelm@45005
    81
      one = (I +>\<^bsub>R\<^esub> \<one>\<^bsub>R\<^esub>), zero = I, add = set_add R\<rparr>"
ballarin@20318
    82
ballarin@20318
    83
wenzelm@61382
    84
subsection \<open>Factorization over General Ideals\<close>
ballarin@20318
    85
wenzelm@61382
    86
text \<open>The quotient is a ring\<close>
wenzelm@45005
    87
lemma (in ideal) quotient_is_ring: "ring (R Quot I)"
ballarin@20318
    88
apply (rule ringI)
wenzelm@67443
    89
   \<comment> \<open>abelian group\<close>
ballarin@20318
    90
   apply (rule comm_group_abelian_groupI)
ballarin@20318
    91
   apply (simp add: FactRing_def)
ballarin@20318
    92
   apply (rule a_factorgroup_is_comm_group[unfolded A_FactGroup_def'])
wenzelm@67443
    93
  \<comment> \<open>mult monoid\<close>
ballarin@20318
    94
  apply (rule monoidI)
ballarin@20318
    95
      apply (simp_all add: FactRing_def A_RCOSETS_def RCOSETS_def
ballarin@20318
    96
             a_r_coset_def[symmetric])
wenzelm@67443
    97
      \<comment> \<open>mult closed\<close>
ballarin@20318
    98
      apply (clarify)
ballarin@20318
    99
      apply (simp add: rcoset_mult_add, fast)
wenzelm@67443
   100
     \<comment> \<open>mult \<open>one_closed\<close>\<close>
wenzelm@45005
   101
     apply force
wenzelm@67443
   102
    \<comment> \<open>mult assoc\<close>
ballarin@20318
   103
    apply clarify
ballarin@20318
   104
    apply (simp add: rcoset_mult_add m_assoc)
wenzelm@67443
   105
   \<comment> \<open>mult one\<close>
ballarin@20318
   106
   apply clarify
wenzelm@45005
   107
   apply (simp add: rcoset_mult_add)
ballarin@20318
   108
  apply clarify
wenzelm@45005
   109
  apply (simp add: rcoset_mult_add)
wenzelm@67443
   110
 \<comment> \<open>distr\<close>
ballarin@20318
   111
 apply clarify
ballarin@20318
   112
 apply (simp add: rcoset_mult_add a_rcos_sum l_distr)
ballarin@20318
   113
apply clarify
ballarin@20318
   114
apply (simp add: rcoset_mult_add a_rcos_sum r_distr)
ballarin@20318
   115
done
ballarin@20318
   116
ballarin@20318
   117
wenzelm@61382
   118
text \<open>This is a ring homomorphism\<close>
ballarin@20318
   119
nipkow@67399
   120
lemma (in ideal) rcos_ring_hom: "((+>) I) \<in> ring_hom R (R Quot I)"
ballarin@20318
   121
apply (rule ring_hom_memI)
ballarin@20318
   122
   apply (simp add: FactRing_def a_rcosetsI[OF a_subset])
ballarin@20318
   123
  apply (simp add: FactRing_def rcoset_mult_add)
ballarin@20318
   124
 apply (simp add: FactRing_def a_rcos_sum)
ballarin@20318
   125
apply (simp add: FactRing_def)
ballarin@20318
   126
done
ballarin@20318
   127
nipkow@67399
   128
lemma (in ideal) rcos_ring_hom_ring: "ring_hom_ring R (R Quot I) ((+>) I)"
ballarin@20318
   129
apply (rule ring_hom_ringI)
ballarin@20318
   130
     apply (rule is_ring, rule quotient_is_ring)
ballarin@20318
   131
   apply (simp add: FactRing_def a_rcosetsI[OF a_subset])
ballarin@20318
   132
  apply (simp add: FactRing_def rcoset_mult_add)
ballarin@20318
   133
 apply (simp add: FactRing_def a_rcos_sum)
ballarin@20318
   134
apply (simp add: FactRing_def)
ballarin@20318
   135
done
ballarin@20318
   136
wenzelm@61382
   137
text \<open>The quotient of a cring is also commutative\<close>
ballarin@20318
   138
lemma (in ideal) quotient_is_cring:
ballarin@27611
   139
  assumes "cring R"
ballarin@20318
   140
  shows "cring (R Quot I)"
ballarin@27611
   141
proof -
ballarin@29237
   142
  interpret cring R by fact
wenzelm@45005
   143
  show ?thesis
wenzelm@45005
   144
    apply (intro cring.intro comm_monoid.intro comm_monoid_axioms.intro)
wenzelm@45005
   145
      apply (rule quotient_is_ring)
wenzelm@45005
   146
     apply (rule ring.axioms[OF quotient_is_ring])
wenzelm@45005
   147
    apply (simp add: FactRing_def A_RCOSETS_defs a_r_coset_def[symmetric])
wenzelm@45005
   148
    apply clarify
wenzelm@45005
   149
    apply (simp add: rcoset_mult_add m_comm)
wenzelm@45005
   150
    done
ballarin@27611
   151
qed
ballarin@20318
   152
wenzelm@61382
   153
text \<open>Cosets as a ring homomorphism on crings\<close>
ballarin@20318
   154
lemma (in ideal) rcos_ring_hom_cring:
ballarin@27611
   155
  assumes "cring R"
nipkow@67399
   156
  shows "ring_hom_cring R (R Quot I) ((+>) I)"
ballarin@27611
   157
proof -
ballarin@29237
   158
  interpret cring R by fact
wenzelm@45005
   159
  show ?thesis
wenzelm@45005
   160
    apply (rule ring_hom_cringI)
wenzelm@45005
   161
      apply (rule rcos_ring_hom_ring)
wenzelm@45005
   162
     apply (rule is_cring)
wenzelm@45005
   163
    apply (rule quotient_is_cring)
wenzelm@45005
   164
   apply (rule is_cring)
wenzelm@45005
   165
   done
ballarin@27611
   166
qed
ballarin@20318
   167
wenzelm@35849
   168
wenzelm@61382
   169
subsection \<open>Factorization over Prime Ideals\<close>
ballarin@20318
   170
wenzelm@61382
   171
text \<open>The quotient ring generated by a prime ideal is a domain\<close>
wenzelm@45005
   172
lemma (in primeideal) quotient_is_domain: "domain (R Quot I)"
wenzelm@45005
   173
  apply (rule domain.intro)
wenzelm@45005
   174
   apply (rule quotient_is_cring, rule is_cring)
wenzelm@45005
   175
  apply (rule domain_axioms.intro)
wenzelm@45005
   176
   apply (simp add: FactRing_def) defer 1
wenzelm@45005
   177
    apply (simp add: FactRing_def A_RCOSETS_defs a_r_coset_def[symmetric], clarify)
wenzelm@45005
   178
    apply (simp add: rcoset_mult_add) defer 1
ballarin@20318
   179
proof (rule ccontr, clarsimp)
ballarin@20318
   180
  assume "I +> \<one> = I"
wenzelm@45005
   181
  then have "\<one> \<in> I" by (simp only: a_coset_join1 one_closed a_subgroup)
wenzelm@45005
   182
  then have "carrier R \<subseteq> I" by (subst one_imp_carrier, simp, fast)
wenzelm@45005
   183
  with a_subset have "I = carrier R" by fast
wenzelm@45005
   184
  with I_notcarr show False by fast
ballarin@20318
   185
next
ballarin@20318
   186
  fix x y
ballarin@20318
   187
  assume carr: "x \<in> carrier R" "y \<in> carrier R"
wenzelm@45005
   188
    and a: "I +> x \<otimes> y = I"
wenzelm@45005
   189
    and b: "I +> y \<noteq> I"
ballarin@20318
   190
ballarin@20318
   191
  have ynI: "y \<notin> I"
ballarin@20318
   192
  proof (rule ccontr, simp)
ballarin@20318
   193
    assume "y \<in> I"
wenzelm@45005
   194
    then have "I +> y = I" by (rule a_rcos_const)
wenzelm@45005
   195
    with b show False by simp
ballarin@20318
   196
  qed
ballarin@20318
   197
wenzelm@45005
   198
  from carr have "x \<otimes> y \<in> I +> x \<otimes> y" by (simp add: a_rcos_self)
wenzelm@45005
   199
  then have xyI: "x \<otimes> y \<in> I" by (simp add: a)
ballarin@20318
   200
wenzelm@45005
   201
  from xyI and carr have xI: "x \<in> I \<or> y \<in> I" by (simp add: I_prime)
wenzelm@45005
   202
  with ynI have "x \<in> I" by fast
wenzelm@45005
   203
  then show "I +> x = I" by (rule a_rcos_const)
ballarin@20318
   204
qed
ballarin@20318
   205
wenzelm@61382
   206
text \<open>Generating right cosets of a prime ideal is a homomorphism
wenzelm@61382
   207
        on commutative rings\<close>
nipkow@67399
   208
lemma (in primeideal) rcos_ring_hom_cring: "ring_hom_cring R (R Quot I) ((+>) I)"
wenzelm@45005
   209
  by (rule rcos_ring_hom_cring) (rule is_cring)
ballarin@20318
   210
ballarin@20318
   211
wenzelm@61382
   212
subsection \<open>Factorization over Maximal Ideals\<close>
ballarin@20318
   213
wenzelm@61382
   214
text \<open>In a commutative ring, the quotient ring over a maximal ideal
ballarin@20318
   215
        is a field.
ballarin@20318
   216
        The proof follows ``W. Adkins, S. Weintraub: Algebra --
wenzelm@61382
   217
        An Approach via Module Theory''\<close>
ballarin@20318
   218
lemma (in maximalideal) quotient_is_field:
ballarin@27611
   219
  assumes "cring R"
ballarin@20318
   220
  shows "field (R Quot I)"
ballarin@27611
   221
proof -
ballarin@29237
   222
  interpret cring R by fact
wenzelm@45005
   223
  show ?thesis
wenzelm@45005
   224
    apply (intro cring.cring_fieldI2)
wenzelm@45005
   225
      apply (rule quotient_is_cring, rule is_cring)
wenzelm@45005
   226
     defer 1
wenzelm@45005
   227
     apply (simp add: FactRing_def A_RCOSETS_defs a_r_coset_def[symmetric], clarsimp)
wenzelm@45005
   228
     apply (simp add: rcoset_mult_add) defer 1
wenzelm@45005
   229
  proof (rule ccontr, simp)
wenzelm@67443
   230
    \<comment> \<open>Quotient is not empty\<close>
wenzelm@45005
   231
    assume "\<zero>\<^bsub>R Quot I\<^esub> = \<one>\<^bsub>R Quot I\<^esub>"
wenzelm@45005
   232
    then have II1: "I = I +> \<one>" by (simp add: FactRing_def)
wenzelm@45005
   233
    from a_rcos_self[OF one_closed] have "\<one> \<in> I"
wenzelm@45005
   234
      by (simp add: II1[symmetric])
wenzelm@45005
   235
    then have "I = carrier R" by (rule one_imp_carrier)
wenzelm@45005
   236
    with I_notcarr show False by simp
wenzelm@45005
   237
  next
wenzelm@67443
   238
    \<comment> \<open>Existence of Inverse\<close>
wenzelm@45005
   239
    fix a
wenzelm@45005
   240
    assume IanI: "I +> a \<noteq> I" and acarr: "a \<in> carrier R"
ballarin@20318
   241
wenzelm@67443
   242
    \<comment> \<open>Helper ideal \<open>J\<close>\<close>
wenzelm@63040
   243
    define J :: "'a set" where "J = (carrier R #> a) <+> I"
wenzelm@45005
   244
    have idealJ: "ideal J R"
wenzelm@45005
   245
      apply (unfold J_def, rule add_ideals)
wenzelm@45005
   246
       apply (simp only: cgenideal_eq_rcos[symmetric], rule cgenideal_ideal, rule acarr)
wenzelm@45005
   247
      apply (rule is_ideal)
wenzelm@45005
   248
      done
ballarin@20318
   249
wenzelm@67443
   250
    \<comment> \<open>Showing @{term "J"} not smaller than @{term "I"}\<close>
wenzelm@45005
   251
    have IinJ: "I \<subseteq> J"
wenzelm@45005
   252
    proof (rule, simp add: J_def r_coset_def set_add_defs)
wenzelm@45005
   253
      fix x
wenzelm@45005
   254
      assume xI: "x \<in> I"
wenzelm@45005
   255
      have Zcarr: "\<zero> \<in> carrier R" by fast
wenzelm@45005
   256
      from xI[THEN a_Hcarr] acarr
wenzelm@45005
   257
      have "x = \<zero> \<otimes> a \<oplus> x" by algebra
wenzelm@45005
   258
      with Zcarr and xI show "\<exists>xa\<in>carrier R. \<exists>k\<in>I. x = xa \<otimes> a \<oplus> k" by fast
wenzelm@45005
   259
    qed
ballarin@20318
   260
wenzelm@67443
   261
    \<comment> \<open>Showing @{term "J \<noteq> I"}\<close>
wenzelm@45005
   262
    have anI: "a \<notin> I"
wenzelm@45005
   263
    proof (rule ccontr, simp)
wenzelm@45005
   264
      assume "a \<in> I"
wenzelm@45005
   265
      then have "I +> a = I" by (rule a_rcos_const)
wenzelm@45005
   266
      with IanI show False by simp
wenzelm@45005
   267
    qed
ballarin@20318
   268
wenzelm@45005
   269
    have aJ: "a \<in> J"
wenzelm@45005
   270
    proof (simp add: J_def r_coset_def set_add_defs)
wenzelm@45005
   271
      from acarr
wenzelm@45005
   272
      have "a = \<one> \<otimes> a \<oplus> \<zero>" by algebra
wenzelm@45005
   273
      with one_closed and additive_subgroup.zero_closed[OF is_additive_subgroup]
wenzelm@45005
   274
      show "\<exists>x\<in>carrier R. \<exists>k\<in>I. a = x \<otimes> a \<oplus> k" by fast
wenzelm@45005
   275
    qed
ballarin@20318
   276
wenzelm@45005
   277
    from aJ and anI have JnI: "J \<noteq> I" by fast
ballarin@20318
   278
wenzelm@67443
   279
    \<comment> \<open>Deducing @{term "J = carrier R"} because @{term "I"} is maximal\<close>
wenzelm@45005
   280
    from idealJ and IinJ have "J = I \<or> J = carrier R"
wenzelm@45005
   281
    proof (rule I_maximal, unfold J_def)
wenzelm@45005
   282
      have "carrier R #> a \<subseteq> carrier R"
wenzelm@45005
   283
        using subset_refl acarr by (rule r_coset_subset_G)
wenzelm@45005
   284
      then show "carrier R #> a <+> I \<subseteq> carrier R"
wenzelm@45005
   285
        using a_subset by (rule set_add_closed)
wenzelm@45005
   286
    qed
wenzelm@45005
   287
wenzelm@45005
   288
    with JnI have Jcarr: "J = carrier R" by simp
ballarin@20318
   289
wenzelm@67443
   290
    \<comment> \<open>Calculating an inverse for @{term "a"}\<close>
wenzelm@45005
   291
    from one_closed[folded Jcarr]
wenzelm@45005
   292
    have "\<exists>r\<in>carrier R. \<exists>i\<in>I. \<one> = r \<otimes> a \<oplus> i"
wenzelm@45005
   293
      by (simp add: J_def r_coset_def set_add_defs)
wenzelm@45005
   294
    then obtain r i where rcarr: "r \<in> carrier R"
wenzelm@45005
   295
      and iI: "i \<in> I" and one: "\<one> = r \<otimes> a \<oplus> i" by fast
wenzelm@45005
   296
    from one and rcarr and acarr and iI[THEN a_Hcarr]
wenzelm@45005
   297
    have rai1: "a \<otimes> r = \<ominus>i \<oplus> \<one>" by algebra
ballarin@20318
   298
wenzelm@67443
   299
    \<comment> \<open>Lifting to cosets\<close>
wenzelm@45005
   300
    from iI have "\<ominus>i \<oplus> \<one> \<in> I +> \<one>"
wenzelm@45005
   301
      by (intro a_rcosI, simp, intro a_subset, simp)
wenzelm@45005
   302
    with rai1 have "a \<otimes> r \<in> I +> \<one>" by simp
wenzelm@45005
   303
    then have "I +> \<one> = I +> a \<otimes> r"
wenzelm@45005
   304
      by (rule a_repr_independence, simp) (rule a_subgroup)
wenzelm@45005
   305
wenzelm@45005
   306
    from rcarr and this[symmetric]
wenzelm@45005
   307
    show "\<exists>r\<in>carrier R. I +> a \<otimes> r = I +> \<one>" by fast
wenzelm@45005
   308
  qed
ballarin@27611
   309
qed
ballarin@20318
   310
lp15@68551
   311
lp15@68551
   312
lemma (in ring_hom_ring) trivial_hom_iff:
lp15@68551
   313
  "(h ` (carrier R) = { \<zero>\<^bsub>S\<^esub> }) = (a_kernel R S h = carrier R)"
lp15@68551
   314
  using group_hom.trivial_hom_iff[OF a_group_hom] by (simp add: a_kernel_def)
lp15@68551
   315
lp15@68551
   316
lemma (in ring_hom_ring) trivial_ker_imp_inj:
lp15@68551
   317
  assumes "a_kernel R S h = { \<zero> }"
lp15@68551
   318
  shows "inj_on h (carrier R)"
lp15@68551
   319
  using group_hom.trivial_ker_imp_inj[OF a_group_hom] assms a_kernel_def[of R S h] by simp 
lp15@68551
   320
lp15@68551
   321
lemma (in ring_hom_ring) non_trivial_field_hom_imp_inj:
lp15@68551
   322
  assumes "field R"
lp15@68551
   323
  shows "h ` (carrier R) \<noteq> { \<zero>\<^bsub>S\<^esub> } \<Longrightarrow> inj_on h (carrier R)"
lp15@68551
   324
proof -
lp15@68551
   325
  assume "h ` (carrier R) \<noteq> { \<zero>\<^bsub>S\<^esub> }"
lp15@68551
   326
  hence "a_kernel R S h \<noteq> carrier R"
lp15@68551
   327
    using trivial_hom_iff by linarith
lp15@68551
   328
  hence "a_kernel R S h = { \<zero> }"
lp15@68551
   329
    using field.all_ideals[OF assms] kernel_is_ideal by blast
lp15@68551
   330
  thus "inj_on h (carrier R)"
lp15@68551
   331
    using trivial_ker_imp_inj by blast
lp15@68551
   332
qed
lp15@68551
   333
lp15@68551
   334
lemma (in ring_hom_ring) img_is_add_subgroup:
lp15@68551
   335
  assumes "subgroup H (add_monoid R)"
lp15@68551
   336
  shows "subgroup (h ` H) (add_monoid S)"
lp15@68551
   337
proof -
lp15@68551
   338
  have "group ((add_monoid R) \<lparr> carrier := H \<rparr>)"
lp15@68551
   339
    using assms R.add.subgroup_imp_group by blast
lp15@68551
   340
  moreover have "H \<subseteq> carrier R" by (simp add: R.add.subgroupE(1) assms)
lp15@68551
   341
  hence "h \<in> hom ((add_monoid R) \<lparr> carrier := H \<rparr>) (add_monoid S)"
lp15@68551
   342
    unfolding hom_def by (auto simp add: subsetD)
lp15@68551
   343
  ultimately have "subgroup (h ` carrier ((add_monoid R) \<lparr> carrier := H \<rparr>)) (add_monoid S)"
lp15@68551
   344
    using group_hom.img_is_subgroup[of "(add_monoid R) \<lparr> carrier := H \<rparr>" "add_monoid S" h]
lp15@68551
   345
    using a_group_hom group_hom_axioms.intro group_hom_def by blast
lp15@68551
   346
  thus "subgroup (h ` H) (add_monoid S)" by simp
lp15@68551
   347
qed
lp15@68551
   348
lp15@68551
   349
lemma (in ring) ring_ideal_imp_quot_ideal:
lp15@68551
   350
  assumes "ideal I R"
lp15@68551
   351
  shows "ideal J R \<Longrightarrow> ideal ((+>) I ` J) (R Quot I)"
lp15@68551
   352
proof -
lp15@68551
   353
  assume A: "ideal J R" show "ideal (((+>) I) ` J) (R Quot I)"
lp15@68551
   354
  proof (rule idealI)
lp15@68551
   355
    show "ring (R Quot I)"
lp15@68551
   356
      by (simp add: assms(1) ideal.quotient_is_ring) 
lp15@68551
   357
  next
lp15@68551
   358
    have "subgroup J (add_monoid R)"
lp15@68551
   359
      by (simp add: additive_subgroup.a_subgroup A ideal.axioms(1))
lp15@68551
   360
    moreover have "((+>) I) \<in> ring_hom R (R Quot I)"
lp15@68551
   361
      by (simp add: assms(1) ideal.rcos_ring_hom)
lp15@68551
   362
    ultimately show "subgroup ((+>) I ` J) (add_monoid (R Quot I))"
lp15@68551
   363
      using assms(1) ideal.rcos_ring_hom_ring ring_hom_ring.img_is_add_subgroup by blast
lp15@68551
   364
  next
lp15@68551
   365
    fix a x assume "a \<in> (+>) I ` J" "x \<in> carrier (R Quot I)"
lp15@68551
   366
    then obtain i j where i: "i \<in> carrier R" "x = I +> i"
lp15@68551
   367
                      and j: "j \<in> J" "a = I +> j"
lp15@68551
   368
      unfolding FactRing_def using A_RCOSETS_def'[of R I] by auto
lp15@68551
   369
    hence "a \<otimes>\<^bsub>R Quot I\<^esub> x = [mod I:] (I +> j) \<Otimes> (I +> i)"
lp15@68551
   370
      unfolding FactRing_def by simp
lp15@68551
   371
    hence "a \<otimes>\<^bsub>R Quot I\<^esub> x = I +> (j \<otimes> i)"
lp15@68551
   372
      using ideal.rcoset_mult_add[OF assms(1), of j i] i(1) j(1) A ideal.Icarr by force
lp15@68551
   373
    thus "a \<otimes>\<^bsub>R Quot I\<^esub> x \<in> (+>) I ` J"
lp15@68551
   374
      using A i(1) j(1) by (simp add: ideal.I_r_closed)
lp15@68551
   375
  
lp15@68551
   376
    have "x \<otimes>\<^bsub>R Quot I\<^esub> a = [mod I:] (I +> i) \<Otimes> (I +> j)"
lp15@68551
   377
      unfolding FactRing_def i j by simp
lp15@68551
   378
    hence "x \<otimes>\<^bsub>R Quot I\<^esub> a = I +> (i \<otimes> j)"
lp15@68551
   379
      using ideal.rcoset_mult_add[OF assms(1), of i j] i(1) j(1) A ideal.Icarr by force
lp15@68551
   380
    thus "x \<otimes>\<^bsub>R Quot I\<^esub> a \<in> (+>) I ` J"
lp15@68551
   381
      using A i(1) j(1) by (simp add: ideal.I_l_closed)
lp15@68551
   382
  qed
lp15@68551
   383
qed
lp15@68551
   384
lp15@68551
   385
lemma (in ring_hom_ring) ideal_vimage:
lp15@68551
   386
  assumes "ideal I S"
lp15@68551
   387
  shows "ideal { r \<in> carrier R. h r \<in> I } R" (* or (carrier R) \<inter> (h -` I) *)
lp15@68551
   388
proof
lp15@68551
   389
  show "{ r \<in> carrier R. h r \<in> I } \<subseteq> carrier (add_monoid R)" by auto
lp15@68551
   390
next
lp15@68551
   391
  show "\<one>\<^bsub>add_monoid R\<^esub> \<in> { r \<in> carrier R. h r \<in> I }"
lp15@68551
   392
    by (simp add: additive_subgroup.zero_closed assms ideal.axioms(1))
lp15@68551
   393
next
lp15@68551
   394
  fix a b
lp15@68551
   395
  assume "a \<in> { r \<in> carrier R. h r \<in> I }"
lp15@68551
   396
     and "b \<in> { r \<in> carrier R. h r \<in> I }"
lp15@68551
   397
  hence a: "a \<in> carrier R" "h a \<in> I"
lp15@68551
   398
    and b: "b \<in> carrier R" "h b \<in> I" by auto
lp15@68551
   399
  hence "h (a \<oplus> b) = (h a) \<oplus>\<^bsub>S\<^esub> (h b)" using hom_add by blast
lp15@68551
   400
  moreover have "(h a) \<oplus>\<^bsub>S\<^esub> (h b) \<in> I" using a b assms
lp15@68551
   401
    by (simp add: additive_subgroup.a_closed ideal.axioms(1))
lp15@68551
   402
  ultimately show "a \<otimes>\<^bsub>add_monoid R\<^esub> b \<in> { r \<in> carrier R. h r \<in> I }"
lp15@68551
   403
    using a(1) b (1) by auto
lp15@68551
   404
lp15@68551
   405
  have "h (\<ominus> a) = \<ominus>\<^bsub>S\<^esub> (h a)" by (simp add: a)
lp15@68551
   406
  moreover have "\<ominus>\<^bsub>S\<^esub> (h a) \<in> I"
lp15@68551
   407
    by (simp add: a(2) additive_subgroup.a_inv_closed assms ideal.axioms(1))
lp15@68551
   408
  ultimately show "inv\<^bsub>add_monoid R\<^esub> a \<in> { r \<in> carrier R. h r \<in> I }"
lp15@68551
   409
    using a by (simp add: a_inv_def)
lp15@68551
   410
next
lp15@68551
   411
  fix a r
lp15@68551
   412
  assume "a \<in> { r \<in> carrier R. h r \<in> I }" and r: "r \<in> carrier R"
lp15@68551
   413
  hence a: "a \<in> carrier R" "h a \<in> I" by auto
lp15@68551
   414
lp15@68551
   415
  have "h a \<otimes>\<^bsub>S\<^esub> h r \<in> I"
lp15@68551
   416
    using assms a r by (simp add: ideal.I_r_closed)
lp15@68551
   417
  thus "a \<otimes> r \<in> { r \<in> carrier R. h r \<in> I }" by (simp add: a(1) r)
lp15@68551
   418
lp15@68551
   419
  have "h r \<otimes>\<^bsub>S\<^esub> h a \<in> I"
lp15@68551
   420
    using assms a r by (simp add: ideal.I_l_closed)
lp15@68551
   421
  thus "r \<otimes> a \<in> { r \<in> carrier R. h r \<in> I }" by (simp add: a(1) r)
lp15@68551
   422
qed
lp15@68551
   423
lp15@68551
   424
lemma (in ring) canonical_proj_vimage_in_carrier:
lp15@68551
   425
  assumes "ideal I R"
lp15@68551
   426
  shows "J \<subseteq> carrier (R Quot I) \<Longrightarrow> \<Union> J \<subseteq> carrier R"
lp15@68551
   427
proof -
lp15@68551
   428
  assume A: "J \<subseteq> carrier (R Quot I)" show "\<Union> J \<subseteq> carrier R"
lp15@68551
   429
  proof
lp15@68551
   430
    fix j assume j: "j \<in> \<Union> J"
lp15@68551
   431
    then obtain j' where j': "j' \<in> J" "j \<in> j'" by blast
lp15@68551
   432
    then obtain r where r: "r \<in> carrier R" "j' = I +> r"
lp15@68551
   433
      using A j' unfolding FactRing_def using A_RCOSETS_def'[of R I] by auto
lp15@68551
   434
    thus "j \<in> carrier R" using j' assms
lp15@68551
   435
      by (meson a_r_coset_subset_G additive_subgroup.a_subset contra_subsetD ideal.axioms(1)) 
lp15@68551
   436
  qed
lp15@68551
   437
qed
lp15@68551
   438
lp15@68551
   439
lemma (in ring) canonical_proj_vimage_mem_iff:
lp15@68551
   440
  assumes "ideal I R" "J \<subseteq> carrier (R Quot I)"
lp15@68551
   441
  shows "\<And>a. a \<in> carrier R \<Longrightarrow> (a \<in> (\<Union> J)) = (I +> a \<in> J)"
lp15@68551
   442
proof -
lp15@68551
   443
  fix a assume a: "a \<in> carrier R" show "(a \<in> (\<Union> J)) = (I +> a \<in> J)"
lp15@68551
   444
  proof
lp15@68551
   445
    assume "a \<in> \<Union> J"
lp15@68551
   446
    then obtain j where j: "j \<in> J" "a \<in> j" by blast
lp15@68551
   447
    then obtain r where r: "r \<in> carrier R" "j = I +> r"
lp15@68551
   448
      using assms j unfolding FactRing_def using A_RCOSETS_def'[of R I] by auto
lp15@68551
   449
    hence "I +> r = I +> a"
lp15@68551
   450
      using add.repr_independence[of a I r] j r
lp15@68551
   451
      by (metis a_r_coset_def additive_subgroup.a_subgroup assms(1) ideal.axioms(1))
lp15@68551
   452
    thus "I +> a \<in> J" using r j by simp
lp15@68551
   453
  next
lp15@68551
   454
    assume "I +> a \<in> J"
lp15@68551
   455
    hence "\<zero> \<oplus> a \<in> I +> a"
lp15@68551
   456
      using additive_subgroup.zero_closed[OF ideal.axioms(1)[OF assms(1)]]
lp15@68551
   457
            a_r_coset_def'[of R I a] by blast
lp15@68551
   458
    thus "a \<in> \<Union> J" using a \<open>I +> a \<in> J\<close> by auto 
lp15@68551
   459
  qed
lp15@68551
   460
qed
lp15@68551
   461
lp15@68551
   462
corollary (in ring) quot_ideal_imp_ring_ideal:
lp15@68551
   463
  assumes "ideal I R"
lp15@68551
   464
  shows "ideal J (R Quot I) \<Longrightarrow> ideal (\<Union> J) R"
lp15@68551
   465
proof -
lp15@68551
   466
  assume A: "ideal J (R Quot I)"
lp15@68551
   467
  have "\<Union> J = { r \<in> carrier R. I +> r \<in> J }"
lp15@68551
   468
    using canonical_proj_vimage_in_carrier[OF assms, of J]
lp15@68551
   469
          canonical_proj_vimage_mem_iff[OF assms, of J]
lp15@68551
   470
          additive_subgroup.a_subset[OF ideal.axioms(1)[OF A]] by blast
lp15@68551
   471
  thus "ideal (\<Union> J) R"
lp15@68551
   472
    using ring_hom_ring.ideal_vimage[OF ideal.rcos_ring_hom_ring[OF assms] A] by simp
lp15@68551
   473
qed
lp15@68551
   474
lp15@68551
   475
lemma (in ring) ideal_incl_iff:
lp15@68551
   476
  assumes "ideal I R" "ideal J R"
lp15@68551
   477
  shows "(I \<subseteq> J) = (J = (\<Union> j \<in> J. I +> j))"
lp15@68551
   478
proof
lp15@68551
   479
  assume A: "J = (\<Union> j \<in> J. I +> j)" hence "I +> \<zero> \<subseteq> J"
lp15@68551
   480
    using additive_subgroup.zero_closed[OF ideal.axioms(1)[OF assms(2)]] by blast
lp15@68551
   481
  thus "I \<subseteq> J" using additive_subgroup.a_subset[OF ideal.axioms(1)[OF assms(1)]] by simp 
lp15@68551
   482
next
lp15@68551
   483
  assume A: "I \<subseteq> J" show "J = (\<Union>j\<in>J. I +> j)"
lp15@68551
   484
  proof
lp15@68551
   485
    show "J \<subseteq> (\<Union> j \<in> J. I +> j)"
lp15@68551
   486
    proof
lp15@68551
   487
      fix j assume j: "j \<in> J"
lp15@68551
   488
      have "\<zero> \<in> I" by (simp add: additive_subgroup.zero_closed assms(1) ideal.axioms(1))
lp15@68551
   489
      hence "\<zero> \<oplus> j \<in> I +> j"
lp15@68551
   490
        using a_r_coset_def'[of R I j] by blast
lp15@68551
   491
      thus "j \<in> (\<Union>j\<in>J. I +> j)"
lp15@68551
   492
        using assms(2) j additive_subgroup.a_Hcarr ideal.axioms(1) by fastforce 
lp15@68551
   493
    qed
lp15@68551
   494
  next
lp15@68551
   495
    show "(\<Union> j \<in> J. I +> j) \<subseteq> J"
lp15@68551
   496
    proof
lp15@68551
   497
      fix x assume "x \<in> (\<Union> j \<in> J. I +> j)"
lp15@68551
   498
      then obtain j where j: "j \<in> J" "x \<in> I +> j" by blast
lp15@68551
   499
      then obtain i where i: "i \<in> I" "x = i \<oplus> j"
lp15@68551
   500
        using a_r_coset_def'[of R I j] by blast
lp15@68551
   501
      thus "x \<in> J"
lp15@68551
   502
        using assms(2) j A additive_subgroup.a_closed[OF ideal.axioms(1)[OF assms(2)]] by blast
lp15@68551
   503
    qed
lp15@68551
   504
  qed
lp15@68551
   505
qed
lp15@68551
   506
lp15@68551
   507
theorem (in ring) quot_ideal_correspondence:
lp15@68551
   508
  assumes "ideal I R"
lp15@68551
   509
  shows "bij_betw (\<lambda>J. (+>) I ` J) { J. ideal J R \<and> I \<subseteq> J } { J . ideal J (R Quot I) }"
lp15@68551
   510
proof (rule bij_betw_byWitness[where ?f' = "\<lambda>X. \<Union> X"])
lp15@68551
   511
  show "\<forall>J \<in> { J. ideal J R \<and> I \<subseteq> J }. (\<lambda>X. \<Union> X) ((+>) I ` J) = J"
lp15@68551
   512
    using assms ideal_incl_iff by blast
lp15@68551
   513
next
lp15@68551
   514
  show "(\<lambda>J. (+>) I ` J) ` { J. ideal J R \<and> I \<subseteq> J } \<subseteq> { J. ideal J (R Quot I) }"
lp15@68551
   515
    using assms ring_ideal_imp_quot_ideal by auto
lp15@68551
   516
next
lp15@68551
   517
  show "(\<lambda>X. \<Union> X) ` { J. ideal J (R Quot I) } \<subseteq> { J. ideal J R \<and> I \<subseteq> J }"
lp15@68551
   518
  proof
lp15@68551
   519
    fix J assume "J \<in> ((\<lambda>X. \<Union> X) ` { J. ideal J (R Quot I) })"
lp15@68551
   520
    then obtain J' where J': "ideal J' (R Quot I)" "J = \<Union> J'" by blast
lp15@68551
   521
    hence "ideal J R"
lp15@68551
   522
      using assms quot_ideal_imp_ring_ideal by auto
lp15@68551
   523
    moreover have "I \<in> J'"
lp15@68551
   524
      using additive_subgroup.zero_closed[OF ideal.axioms(1)[OF J'(1)]] unfolding FactRing_def by simp
lp15@68551
   525
    ultimately show "J \<in> { J. ideal J R \<and> I \<subseteq> J }" using J'(2) by auto
lp15@68551
   526
  qed
lp15@68551
   527
next
lp15@68551
   528
  show "\<forall>J' \<in> { J. ideal J (R Quot I) }. ((+>) I ` (\<Union> J')) = J'"
lp15@68551
   529
  proof
lp15@68551
   530
    fix J' assume "J' \<in> { J. ideal J (R Quot I) }"
lp15@68551
   531
    hence subset: "J' \<subseteq> carrier (R Quot I) \<and> ideal J' (R Quot I)"
lp15@68551
   532
      using additive_subgroup.a_subset ideal_def by blast
lp15@68551
   533
    hence "((+>) I ` (\<Union> J')) \<subseteq> J'"
lp15@68551
   534
      using canonical_proj_vimage_in_carrier canonical_proj_vimage_mem_iff
lp15@68551
   535
      by (meson assms contra_subsetD image_subsetI)
lp15@68551
   536
    moreover have "J' \<subseteq> ((+>) I ` (\<Union> J'))"
lp15@68551
   537
    proof
lp15@68551
   538
      fix x assume "x \<in> J'"
lp15@68551
   539
      then obtain r where r: "r \<in> carrier R" "x = I +> r"
lp15@68551
   540
        using subset unfolding FactRing_def A_RCOSETS_def'[of R I] by auto
lp15@68551
   541
      hence "r \<in> (\<Union> J')"
lp15@68551
   542
        using \<open>x \<in> J'\<close> assms canonical_proj_vimage_mem_iff subset by blast
lp15@68551
   543
      thus "x \<in> ((+>) I ` (\<Union> J'))" using r(2) by blast
lp15@68551
   544
    qed
lp15@68551
   545
    ultimately show "((+>) I ` (\<Union> J')) = J'" by blast
lp15@68551
   546
  qed
lp15@68551
   547
qed
lp15@68551
   548
lp15@68551
   549
lemma (in cring) quot_domain_imp_primeideal:
lp15@68551
   550
  assumes "ideal P R"
lp15@68551
   551
  shows "domain (R Quot P) \<Longrightarrow> primeideal P R"
lp15@68551
   552
proof -
lp15@68551
   553
  assume A: "domain (R Quot P)" show "primeideal P R"
lp15@68551
   554
  proof (rule primeidealI)
lp15@68551
   555
    show "ideal P R" using assms .
lp15@68551
   556
    show "cring R" using is_cring .
lp15@68551
   557
  next
lp15@68551
   558
    show "carrier R \<noteq> P"
lp15@68551
   559
    proof (rule ccontr)
lp15@68551
   560
      assume "\<not> carrier R \<noteq> P" hence "carrier R = P" by simp
lp15@68551
   561
      hence "\<And>I. I \<in> carrier (R Quot P) \<Longrightarrow> I = P"
lp15@68551
   562
        unfolding FactRing_def A_RCOSETS_def' apply simp
lp15@68551
   563
        using a_coset_join2 additive_subgroup.a_subgroup assms ideal.axioms(1) by blast
lp15@68551
   564
      hence "\<one>\<^bsub>(R Quot P)\<^esub> = \<zero>\<^bsub>(R Quot P)\<^esub>"
lp15@68551
   565
        by (metis assms ideal.quotient_is_ring ring.ring_simprules(2) ring.ring_simprules(6))
lp15@68551
   566
      thus False using domain.one_not_zero[OF A] by simp
lp15@68551
   567
    qed
lp15@68551
   568
  next
lp15@68551
   569
    fix a b assume a: "a \<in> carrier R" and b: "b \<in> carrier R" and ab: "a \<otimes> b \<in> P"
lp15@68551
   570
    hence "P +> (a \<otimes> b) = \<zero>\<^bsub>(R Quot P)\<^esub>" unfolding FactRing_def
lp15@68551
   571
      by (simp add: a_coset_join2 additive_subgroup.a_subgroup assms ideal.axioms(1))
lp15@68551
   572
    moreover have "(P +> a) \<otimes>\<^bsub>(R Quot P)\<^esub> (P +> b) = P +> (a \<otimes> b)" unfolding FactRing_def
lp15@68551
   573
      using a b by (simp add: assms ideal.rcoset_mult_add)
lp15@68551
   574
    moreover have "P +> a \<in> carrier (R Quot P) \<and> P +> b \<in> carrier (R Quot P)"
lp15@68551
   575
      by (simp add: a b FactRing_def a_rcosetsI additive_subgroup.a_subset assms ideal.axioms(1))
lp15@68551
   576
    ultimately have "P +> a = \<zero>\<^bsub>(R Quot P)\<^esub> \<or> P +> b = \<zero>\<^bsub>(R Quot P)\<^esub>"
lp15@68551
   577
      using domain.integral[OF A, of "P +> a" "P +> b"] by auto
lp15@68551
   578
    thus "a \<in> P \<or> b \<in> P" unfolding FactRing_def apply simp
lp15@68551
   579
      using a b assms a_coset_join1 additive_subgroup.a_subgroup ideal.axioms(1) by blast
lp15@68551
   580
  qed
lp15@68551
   581
qed
lp15@68551
   582
lp15@68551
   583
lemma (in cring) quot_domain_iff_primeideal:
lp15@68551
   584
  assumes "ideal P R"
lp15@68551
   585
  shows "domain (R Quot P) = primeideal P R"
lp15@68551
   586
  using quot_domain_imp_primeideal[OF assms] primeideal.quotient_is_domain[of P R] by auto
lp15@68551
   587
lp15@68551
   588
lp15@68551
   589
subsection \<open>Isomorphism\<close>
lp15@68551
   590
lp15@68551
   591
definition
lp15@68551
   592
  ring_iso :: "_ \<Rightarrow> _ \<Rightarrow> ('a \<Rightarrow> 'b) set"
lp15@68551
   593
  where "ring_iso R S = { h. h \<in> ring_hom R S \<and> bij_betw h (carrier R) (carrier S) }"
lp15@68551
   594
lp15@68551
   595
definition
lp15@68551
   596
  is_ring_iso :: "_ \<Rightarrow> _ \<Rightarrow> bool" (infixr "\<simeq>" 60)
lp15@68551
   597
  where "R \<simeq> S = (ring_iso R S \<noteq> {})"
lp15@68551
   598
lp15@68551
   599
definition
lp15@68551
   600
  morphic_prop :: "_ \<Rightarrow> ('a \<Rightarrow> bool) \<Rightarrow> bool"
lp15@68551
   601
  where "morphic_prop R P =
lp15@68551
   602
           ((P \<one>\<^bsub>R\<^esub>) \<and>
lp15@68551
   603
            (\<forall>r \<in> carrier R. P r) \<and>
lp15@68551
   604
            (\<forall>r1 \<in> carrier R. \<forall>r2 \<in> carrier R. P (r1 \<otimes>\<^bsub>R\<^esub> r2)) \<and>
lp15@68551
   605
            (\<forall>r1 \<in> carrier R. \<forall>r2 \<in> carrier R. P (r1 \<oplus>\<^bsub>R\<^esub> r2)))"
lp15@68551
   606
lp15@68551
   607
lemma ring_iso_memI:
lp15@68551
   608
  fixes R (structure) and S (structure)
lp15@68551
   609
  assumes "\<And>x. x \<in> carrier R \<Longrightarrow> h x \<in> carrier S"
lp15@68551
   610
      and "\<And>x y. \<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> h (x \<otimes> y) = h x \<otimes>\<^bsub>S\<^esub> h y"
lp15@68551
   611
      and "\<And>x y. \<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> h (x \<oplus> y) = h x \<oplus>\<^bsub>S\<^esub> h y"
lp15@68551
   612
      and "h \<one> = \<one>\<^bsub>S\<^esub>"
lp15@68551
   613
      and "bij_betw h (carrier R) (carrier S)"
lp15@68551
   614
  shows "h \<in> ring_iso R S"
lp15@68551
   615
  by (auto simp add: ring_hom_memI assms ring_iso_def)
lp15@68551
   616
lp15@68551
   617
lemma ring_iso_memE:
lp15@68551
   618
  fixes R (structure) and S (structure)
lp15@68551
   619
  assumes "h \<in> ring_iso R S"
lp15@68551
   620
  shows "\<And>x. x \<in> carrier R \<Longrightarrow> h x \<in> carrier S"
lp15@68551
   621
   and "\<And>x y. \<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> h (x \<otimes> y) = h x \<otimes>\<^bsub>S\<^esub> h y"
lp15@68551
   622
   and "\<And>x y. \<lbrakk> x \<in> carrier R; y \<in> carrier R \<rbrakk> \<Longrightarrow> h (x \<oplus> y) = h x \<oplus>\<^bsub>S\<^esub> h y"
lp15@68551
   623
   and "h \<one> = \<one>\<^bsub>S\<^esub>"
lp15@68551
   624
   and "bij_betw h (carrier R) (carrier S)"
lp15@68551
   625
  using assms unfolding ring_iso_def ring_hom_def by auto
lp15@68551
   626
lp15@68551
   627
lemma morphic_propI:
lp15@68551
   628
  fixes R (structure)
lp15@68551
   629
  assumes "P \<one>"
lp15@68551
   630
    and "\<And>r. r \<in> carrier R \<Longrightarrow> P r"
lp15@68551
   631
    and "\<And>r1 r2. \<lbrakk> r1 \<in> carrier R; r2 \<in> carrier R \<rbrakk> \<Longrightarrow> P (r1 \<otimes> r2)"
lp15@68551
   632
    and "\<And>r1 r2. \<lbrakk> r1 \<in> carrier R; r2 \<in> carrier R \<rbrakk> \<Longrightarrow> P (r1 \<oplus> r2)"
lp15@68551
   633
  shows "morphic_prop R P"
lp15@68551
   634
  unfolding morphic_prop_def using assms by auto
lp15@68551
   635
lp15@68551
   636
lemma morphic_propE:
lp15@68551
   637
  fixes R (structure)
lp15@68551
   638
  assumes "morphic_prop R P"
lp15@68551
   639
  shows "P \<one>"
lp15@68551
   640
    and "\<And>r. r \<in> carrier R \<Longrightarrow> P r"
lp15@68551
   641
    and "\<And>r1 r2. \<lbrakk> r1 \<in> carrier R; r2 \<in> carrier R \<rbrakk> \<Longrightarrow> P (r1 \<otimes> r2)"
lp15@68551
   642
    and "\<And>r1 r2. \<lbrakk> r1 \<in> carrier R; r2 \<in> carrier R \<rbrakk> \<Longrightarrow> P (r1 \<oplus> r2)"
lp15@68551
   643
  using assms unfolding morphic_prop_def by auto
lp15@68551
   644
lp15@68551
   645
lemma ring_iso_restrict:
lp15@68551
   646
  assumes "f \<in> ring_iso R S"
lp15@68551
   647
    and "\<And>r. r \<in> carrier R \<Longrightarrow> f r = g r"
lp15@68551
   648
    and "ring R"
lp15@68551
   649
  shows "g \<in> ring_iso R S"
lp15@68551
   650
proof (rule ring_iso_memI)
lp15@68551
   651
  show "bij_betw g (carrier R) (carrier S)"
lp15@68551
   652
    using assms(1-2) bij_betw_cong ring_iso_memE(5) by blast
lp15@68551
   653
  show "g \<one>\<^bsub>R\<^esub> = \<one>\<^bsub>S\<^esub>"
lp15@68551
   654
    using assms ring.ring_simprules(6) ring_iso_memE(4) by force
lp15@68551
   655
next
lp15@68551
   656
  fix x y assume x: "x \<in> carrier R" and y: "y \<in> carrier R"
lp15@68551
   657
  show "g x \<in> carrier S"
lp15@68551
   658
    using assms(1-2) ring_iso_memE(1) x by fastforce
lp15@68551
   659
  show "g (x \<otimes>\<^bsub>R\<^esub> y) = g x \<otimes>\<^bsub>S\<^esub> g y"
lp15@68551
   660
    by (metis assms ring.ring_simprules(5) ring_iso_memE(2) x y)
lp15@68551
   661
  show "g (x \<oplus>\<^bsub>R\<^esub> y) = g x \<oplus>\<^bsub>S\<^esub> g y"
lp15@68551
   662
    by (metis assms ring.ring_simprules(1) ring_iso_memE(3) x y)
lp15@68551
   663
qed
lp15@68551
   664
lp15@68551
   665
lemma ring_iso_morphic_prop:
lp15@68551
   666
  assumes "f \<in> ring_iso R S"
lp15@68551
   667
    and "morphic_prop R P"
lp15@68551
   668
    and "\<And>r. P r \<Longrightarrow> f r = g r"
lp15@68551
   669
  shows "g \<in> ring_iso R S"
lp15@68551
   670
proof -
lp15@68551
   671
  have eq0: "\<And>r. r \<in> carrier R \<Longrightarrow> f r = g r"
lp15@68551
   672
   and eq1: "f \<one>\<^bsub>R\<^esub> = g \<one>\<^bsub>R\<^esub>"
lp15@68551
   673
   and eq2: "\<And>r1 r2. \<lbrakk> r1 \<in> carrier R; r2 \<in> carrier R \<rbrakk> \<Longrightarrow> f (r1 \<otimes>\<^bsub>R\<^esub> r2) = g (r1 \<otimes>\<^bsub>R\<^esub> r2)"
lp15@68551
   674
   and eq3: "\<And>r1 r2. \<lbrakk> r1 \<in> carrier R; r2 \<in> carrier R \<rbrakk> \<Longrightarrow> f (r1 \<oplus>\<^bsub>R\<^esub> r2) = g (r1 \<oplus>\<^bsub>R\<^esub> r2)"
lp15@68551
   675
    using assms(2-3) unfolding morphic_prop_def by auto
lp15@68551
   676
  show ?thesis
lp15@68551
   677
    apply (rule ring_iso_memI)
lp15@68551
   678
    using assms(1) eq0 ring_iso_memE(1) apply fastforce
lp15@68551
   679
    apply (metis assms(1) eq0 eq2 ring_iso_memE(2))
lp15@68551
   680
    apply (metis assms(1) eq0 eq3 ring_iso_memE(3))
lp15@68551
   681
    using assms(1) eq1 ring_iso_memE(4) apply fastforce
lp15@68551
   682
    using assms(1) bij_betw_cong eq0 ring_iso_memE(5) by blast
lp15@68551
   683
qed
lp15@68551
   684
lp15@68551
   685
lemma (in ring) ring_hom_imp_img_ring:
lp15@68551
   686
  assumes "h \<in> ring_hom R S"
lp15@68551
   687
  shows "ring (S \<lparr> carrier := h ` (carrier R), one := h \<one>, zero := h \<zero> \<rparr>)" (is "ring ?h_img")
lp15@68551
   688
proof -
lp15@68551
   689
  have "h \<in> hom (add_monoid R) (add_monoid S)"
lp15@68551
   690
    using assms unfolding hom_def ring_hom_def by auto
lp15@68551
   691
  hence "comm_group ((add_monoid S) \<lparr>  carrier := h ` (carrier R), one := h \<zero> \<rparr>)"
lp15@68551
   692
    using add.hom_imp_img_comm_group[of h "add_monoid S"] by simp
lp15@68551
   693
  hence comm_group: "comm_group (add_monoid ?h_img)"
lp15@68551
   694
    by (auto intro: comm_monoidI simp add: monoid.defs)
lp15@68551
   695
lp15@68551
   696
  moreover have "h \<in> hom R S"
lp15@68551
   697
    using assms unfolding ring_hom_def hom_def by auto
lp15@68551
   698
  hence "monoid (S \<lparr>  carrier := h ` (carrier R), one := h \<one> \<rparr>)"
lp15@68551
   699
    using hom_imp_img_monoid[of h S] by simp
lp15@68551
   700
  hence monoid: "monoid ?h_img"
lp15@68551
   701
    unfolding monoid_def by (simp add: monoid.defs)
lp15@68551
   702
lp15@68551
   703
  show ?thesis
lp15@68551
   704
  proof (rule ringI, simp_all add: comm_group_abelian_groupI[OF comm_group] monoid)
lp15@68551
   705
    fix x y z assume "x \<in> h ` carrier R" "y \<in> h ` carrier R" "z \<in> h ` carrier R"
lp15@68551
   706
    then obtain r1 r2 r3
lp15@68551
   707
      where r1: "r1 \<in> carrier R" "x = h r1"
lp15@68551
   708
        and r2: "r2 \<in> carrier R" "y = h r2"
lp15@68551
   709
        and r3: "r3 \<in> carrier R" "z = h r3" by blast
lp15@68551
   710
    hence "(x \<oplus>\<^bsub>S\<^esub> y) \<otimes>\<^bsub>S\<^esub> z = h ((r1 \<oplus> r2) \<otimes> r3)"
lp15@68551
   711
      using ring_hom_memE[OF assms] by auto
lp15@68551
   712
    also have " ... = h ((r1 \<otimes> r3) \<oplus> (r2 \<otimes> r3))"
lp15@68551
   713
      using l_distr[OF r1(1) r2(1) r3(1)] by simp
lp15@68551
   714
    also have " ... = (x \<otimes>\<^bsub>S\<^esub> z) \<oplus>\<^bsub>S\<^esub> (y \<otimes>\<^bsub>S\<^esub> z)"
lp15@68551
   715
      using ring_hom_memE[OF assms] r1 r2 r3 by auto
lp15@68551
   716
    finally show "(x \<oplus>\<^bsub>S\<^esub> y) \<otimes>\<^bsub>S\<^esub> z = (x \<otimes>\<^bsub>S\<^esub> z) \<oplus>\<^bsub>S\<^esub> (y \<otimes>\<^bsub>S\<^esub> z)" .
lp15@68551
   717
lp15@68551
   718
    have "z \<otimes>\<^bsub>S\<^esub> (x \<oplus>\<^bsub>S\<^esub> y) = h (r3 \<otimes> (r1 \<oplus> r2))"
lp15@68551
   719
      using ring_hom_memE[OF assms] r1 r2 r3 by auto
lp15@68551
   720
    also have " ... =  h ((r3 \<otimes> r1) \<oplus> (r3 \<otimes> r2))"
lp15@68551
   721
      using r_distr[OF r1(1) r2(1) r3(1)] by simp
lp15@68551
   722
    also have " ... = (z \<otimes>\<^bsub>S\<^esub> x) \<oplus>\<^bsub>S\<^esub> (z \<otimes>\<^bsub>S\<^esub> y)"
lp15@68551
   723
      using ring_hom_memE[OF assms] r1 r2 r3 by auto
lp15@68551
   724
    finally show "z \<otimes>\<^bsub>S\<^esub> (x \<oplus>\<^bsub>S\<^esub> y) = (z \<otimes>\<^bsub>S\<^esub> x) \<oplus>\<^bsub>S\<^esub> (z \<otimes>\<^bsub>S\<^esub> y)" .
lp15@68551
   725
  qed
lp15@68551
   726
qed
lp15@68551
   727
lp15@68551
   728
lemma (in ring) ring_iso_imp_img_ring:
lp15@68551
   729
  assumes "h \<in> ring_iso R S"
lp15@68551
   730
  shows "ring (S \<lparr> one := h \<one>, zero := h \<zero> \<rparr>)"
lp15@68551
   731
proof -
lp15@68551
   732
  have "ring (S \<lparr> carrier := h ` (carrier R), one := h \<one>, zero := h \<zero> \<rparr>)"
lp15@68551
   733
    using ring_hom_imp_img_ring[of h S] assms unfolding ring_iso_def by auto
lp15@68551
   734
  moreover have "h ` (carrier R) = carrier S"
lp15@68551
   735
    using assms unfolding ring_iso_def bij_betw_def by auto
lp15@68551
   736
  ultimately show ?thesis by simp
lp15@68551
   737
qed
lp15@68551
   738
lp15@68551
   739
lemma (in cring) ring_iso_imp_img_cring:
lp15@68551
   740
  assumes "h \<in> ring_iso R S"
lp15@68551
   741
  shows "cring (S \<lparr> one := h \<one>, zero := h \<zero> \<rparr>)" (is "cring ?h_img")
lp15@68551
   742
proof -
lp15@68551
   743
  note m_comm
lp15@68551
   744
  interpret h_img?: ring ?h_img
lp15@68551
   745
    using ring_iso_imp_img_ring[OF assms] .
lp15@68551
   746
  show ?thesis 
lp15@68551
   747
  proof (unfold_locales)
lp15@68551
   748
    fix x y assume "x \<in> carrier ?h_img" "y \<in> carrier ?h_img"
lp15@68551
   749
    then obtain r1 r2
lp15@68551
   750
      where r1: "r1 \<in> carrier R" "x = h r1"
lp15@68551
   751
        and r2: "r2 \<in> carrier R" "y = h r2"
lp15@68551
   752
      using assms image_iff[where ?f = h and ?A = "carrier R"]
lp15@68551
   753
      unfolding ring_iso_def bij_betw_def by auto
lp15@68551
   754
    have "x \<otimes>\<^bsub>(?h_img)\<^esub> y = h (r1 \<otimes> r2)"
lp15@68551
   755
      using assms r1 r2 unfolding ring_iso_def ring_hom_def by auto
lp15@68551
   756
    also have " ... = h (r2 \<otimes> r1)"
lp15@68551
   757
      using m_comm[OF r1(1) r2(1)] by simp
lp15@68551
   758
    also have " ... = y \<otimes>\<^bsub>(?h_img)\<^esub> x"
lp15@68551
   759
      using assms r1 r2 unfolding ring_iso_def ring_hom_def by auto
lp15@68551
   760
    finally show "x \<otimes>\<^bsub>(?h_img)\<^esub> y = y \<otimes>\<^bsub>(?h_img)\<^esub> x" .
lp15@68551
   761
  qed
lp15@68551
   762
qed
lp15@68551
   763
lp15@68551
   764
lemma (in domain) ring_iso_imp_img_domain:
lp15@68551
   765
  assumes "h \<in> ring_iso R S"
lp15@68551
   766
  shows "domain (S \<lparr> one := h \<one>, zero := h \<zero> \<rparr>)" (is "domain ?h_img")
lp15@68551
   767
proof -
lp15@68551
   768
  note aux = m_closed integral one_not_zero one_closed zero_closed
lp15@68551
   769
  interpret h_img?: cring ?h_img
lp15@68551
   770
    using ring_iso_imp_img_cring[OF assms] .
lp15@68551
   771
  show ?thesis 
lp15@68551
   772
  proof (unfold_locales)
lp15@68551
   773
    show "\<one>\<^bsub>?h_img\<^esub> \<noteq> \<zero>\<^bsub>?h_img\<^esub>"
lp15@68551
   774
      using ring_iso_memE(5)[OF assms] aux(3-4)
lp15@68551
   775
      unfolding bij_betw_def inj_on_def by force
lp15@68551
   776
  next
lp15@68551
   777
    fix a b
lp15@68551
   778
    assume A: "a \<otimes>\<^bsub>?h_img\<^esub> b = \<zero>\<^bsub>?h_img\<^esub>" "a \<in> carrier ?h_img" "b \<in> carrier ?h_img"
lp15@68551
   779
    then obtain r1 r2
lp15@68551
   780
      where r1: "r1 \<in> carrier R" "a = h r1"
lp15@68551
   781
        and r2: "r2 \<in> carrier R" "b = h r2"
lp15@68551
   782
      using assms image_iff[where ?f = h and ?A = "carrier R"]
lp15@68551
   783
      unfolding ring_iso_def bij_betw_def by auto
lp15@68551
   784
    hence "a \<otimes>\<^bsub>?h_img\<^esub> b = h (r1 \<otimes> r2)"
lp15@68551
   785
      using assms r1 r2 unfolding ring_iso_def ring_hom_def by auto
lp15@68551
   786
    hence "h (r1 \<otimes> r2) = h \<zero>"
lp15@68551
   787
      using A(1) by simp
lp15@68551
   788
    hence "r1 \<otimes> r2 = \<zero>"
lp15@68551
   789
      using ring_iso_memE(5)[OF assms] aux(1)[OF r1(1) r2(1)] aux(5)
lp15@68551
   790
      unfolding bij_betw_def inj_on_def by force
lp15@68551
   791
    hence "r1 = \<zero> \<or> r2 = \<zero>"
lp15@68551
   792
      using aux(2)[OF _ r1(1) r2(1)] by simp
lp15@68551
   793
    thus "a = \<zero>\<^bsub>?h_img\<^esub> \<or> b = \<zero>\<^bsub>?h_img\<^esub>"
lp15@68551
   794
      unfolding r1 r2 by auto
lp15@68551
   795
  qed
lp15@68551
   796
qed
lp15@68551
   797
lp15@68551
   798
lemma (in field) ring_iso_imp_img_field:
lp15@68551
   799
  assumes "h \<in> ring_iso R S"
lp15@68551
   800
  shows "field (S \<lparr> one := h \<one>, zero := h \<zero> \<rparr>)" (is "field ?h_img")
lp15@68551
   801
proof -
lp15@68551
   802
  interpret h_img?: domain ?h_img
lp15@68551
   803
    using ring_iso_imp_img_domain[OF assms] .
lp15@68551
   804
  show ?thesis
lp15@68551
   805
  proof (unfold_locales, auto simp add: Units_def)
lp15@68551
   806
    interpret field R using field_axioms .
lp15@68551
   807
    fix a assume a: "a \<in> carrier S" "a \<otimes>\<^bsub>S\<^esub> h \<zero> = h \<one>"
lp15@68551
   808
    then obtain r where r: "r \<in> carrier R" "a = h r"
lp15@68551
   809
      using assms image_iff[where ?f = h and ?A = "carrier R"]
lp15@68551
   810
      unfolding ring_iso_def bij_betw_def by auto
lp15@68551
   811
    have "a \<otimes>\<^bsub>S\<^esub> h \<zero> = h (r \<otimes> \<zero>)" unfolding r(2)
lp15@68551
   812
      using ring_iso_memE(2)[OF assms r(1)] by simp
lp15@68551
   813
    hence "h \<one> = h \<zero>"
lp15@68551
   814
      using r(1) a(2) by simp
lp15@68551
   815
    thus False
lp15@68551
   816
      using ring_iso_memE(5)[OF assms]
lp15@68551
   817
      unfolding bij_betw_def inj_on_def by force
lp15@68551
   818
  next
lp15@68551
   819
    interpret field R using field_axioms .
lp15@68551
   820
    fix s assume s: "s \<in> carrier S" "s \<noteq> h \<zero>"
lp15@68551
   821
    then obtain r where r: "r \<in> carrier R" "s = h r"
lp15@68551
   822
      using assms image_iff[where ?f = h and ?A = "carrier R"]
lp15@68551
   823
      unfolding ring_iso_def bij_betw_def by auto
lp15@68551
   824
    hence "r \<noteq> \<zero>" using s(2) by auto 
lp15@68551
   825
    hence inv_r: "inv r \<in> carrier R" "inv r \<noteq> \<zero>" "r \<otimes> inv r = \<one>" "inv r \<otimes> r = \<one>"
lp15@68551
   826
      using field_Units r(1) by auto
lp15@68551
   827
    have "h (inv r) \<otimes>\<^bsub>S\<^esub> h r = h \<one>" and "h r \<otimes>\<^bsub>S\<^esub> h (inv r) = h \<one>"
lp15@68551
   828
      using ring_iso_memE(2)[OF assms inv_r(1) r(1)] inv_r(3-4)
lp15@68551
   829
            ring_iso_memE(2)[OF assms r(1) inv_r(1)] by auto
lp15@68551
   830
    thus "\<exists>s' \<in> carrier S. s' \<otimes>\<^bsub>S\<^esub> s = h \<one> \<and> s \<otimes>\<^bsub>S\<^esub> s' = h \<one>"
lp15@68551
   831
      using ring_iso_memE(1)[OF assms inv_r(1)] r(2) by auto
lp15@68551
   832
  qed
lp15@68551
   833
qed
lp15@68551
   834
lp15@68551
   835
lemma ring_iso_same_card: "R \<simeq> S \<Longrightarrow> card (carrier R) = card (carrier S)"
lp15@68551
   836
proof -
lp15@68551
   837
  assume "R \<simeq> S"
lp15@68551
   838
  then obtain h where "bij_betw h (carrier R) (carrier S)"
lp15@68551
   839
    unfolding is_ring_iso_def ring_iso_def by auto
lp15@68551
   840
  thus "card (carrier R) = card (carrier S)"
lp15@68551
   841
    using bij_betw_same_card[of h "carrier R" "carrier S"] by simp
lp15@68551
   842
qed
lp15@68551
   843
lp15@68551
   844
lemma ring_iso_set_refl: "id \<in> ring_iso R R"
lp15@68551
   845
  by (rule ring_iso_memI) (auto)
lp15@68551
   846
lp15@68551
   847
corollary ring_iso_refl: "R \<simeq> R"
lp15@68551
   848
  using is_ring_iso_def ring_iso_set_refl by auto 
lp15@68551
   849
lp15@68551
   850
lemma ring_iso_set_trans:
lp15@68551
   851
  "\<lbrakk> f \<in> ring_iso R S; g \<in> ring_iso S Q \<rbrakk> \<Longrightarrow> (g \<circ> f) \<in> ring_iso R Q"
lp15@68551
   852
  unfolding ring_iso_def using bij_betw_trans ring_hom_trans by fastforce 
lp15@68551
   853
lp15@68551
   854
corollary ring_iso_trans: "\<lbrakk> R \<simeq> S; S \<simeq> Q \<rbrakk> \<Longrightarrow> R \<simeq> Q"
lp15@68551
   855
  using ring_iso_set_trans unfolding is_ring_iso_def by blast 
lp15@68551
   856
lp15@68551
   857
lemma ring_iso_set_sym:
lp15@68551
   858
  assumes "ring R"
lp15@68551
   859
  shows "h \<in> ring_iso R S \<Longrightarrow> (inv_into (carrier R) h) \<in> ring_iso S R"
lp15@68551
   860
proof -
lp15@68551
   861
  assume h: "h \<in> ring_iso R S"
lp15@68551
   862
  hence h_hom:  "h \<in> ring_hom R S"
lp15@68551
   863
    and h_surj: "h ` (carrier R) = (carrier S)"
lp15@68551
   864
    and h_inj:  "\<And> x1 x2. \<lbrakk> x1 \<in> carrier R; x2 \<in> carrier R \<rbrakk> \<Longrightarrow>  h x1 = h x2 \<Longrightarrow> x1 = x2"
lp15@68551
   865
    unfolding ring_iso_def bij_betw_def inj_on_def by auto
lp15@68551
   866
lp15@68551
   867
  have h_inv_bij: "bij_betw (inv_into (carrier R) h) (carrier S) (carrier R)"
lp15@68551
   868
      using bij_betw_inv_into h ring_iso_def by fastforce
lp15@68551
   869
lp15@68551
   870
  show "inv_into (carrier R) h \<in> ring_iso S R"
lp15@68551
   871
    apply (rule ring_iso_memI)
lp15@68551
   872
    apply (simp add: h_surj inv_into_into)
lp15@68551
   873
    apply (auto simp add: h_inv_bij)
lp15@68551
   874
    apply (smt assms f_inv_into_f h_hom h_inj h_surj inv_into_into
lp15@68551
   875
           ring.ring_simprules(5) ring_hom_closed ring_hom_mult)
lp15@68551
   876
    apply (smt assms f_inv_into_f h_hom h_inj h_surj inv_into_into
lp15@68551
   877
           ring.ring_simprules(1) ring_hom_add ring_hom_closed)
lp15@68551
   878
    by (metis (no_types, hide_lams) assms f_inv_into_f h_hom h_inj
lp15@68551
   879
        imageI inv_into_into ring.ring_simprules(6) ring_hom_one)
lp15@68551
   880
qed
lp15@68551
   881
lp15@68551
   882
corollary ring_iso_sym:
lp15@68551
   883
  assumes "ring R"
lp15@68551
   884
  shows "R \<simeq> S \<Longrightarrow> S \<simeq> R"
lp15@68551
   885
  using assms ring_iso_set_sym unfolding is_ring_iso_def by auto 
lp15@68551
   886
lp15@68551
   887
lemma (in ring_hom_ring) the_elem_simp [simp]:
lp15@68551
   888
  "\<And>x. x \<in> carrier R \<Longrightarrow> the_elem (h ` ((a_kernel R S h) +> x)) = h x"
lp15@68551
   889
proof -
lp15@68551
   890
  fix x assume x: "x \<in> carrier R"
lp15@68551
   891
  hence "h x \<in> h ` ((a_kernel R S h) +> x)"
lp15@68551
   892
    using homeq_imp_rcos by blast
lp15@68551
   893
  thus "the_elem (h ` ((a_kernel R S h) +> x)) = h x"
lp15@68551
   894
    by (metis (no_types, lifting) x empty_iff homeq_imp_rcos rcos_imp_homeq the_elem_image_unique)
lp15@68551
   895
qed
lp15@68551
   896
lp15@68551
   897
lemma (in ring_hom_ring) the_elem_inj:
lp15@68551
   898
  "\<And>X Y. \<lbrakk> X \<in> carrier (R Quot (a_kernel R S h)); Y \<in> carrier (R Quot (a_kernel R S h)) \<rbrakk> \<Longrightarrow>
lp15@68551
   899
           the_elem (h ` X) = the_elem (h ` Y) \<Longrightarrow> X = Y"
lp15@68551
   900
proof -
lp15@68551
   901
  fix X Y
lp15@68551
   902
  assume "X \<in> carrier (R Quot (a_kernel R S h))"
lp15@68551
   903
     and "Y \<in> carrier (R Quot (a_kernel R S h))"
lp15@68551
   904
     and Eq: "the_elem (h ` X) = the_elem (h ` Y)"
lp15@68551
   905
  then obtain x y where x: "x \<in> carrier R" "X = (a_kernel R S h) +> x"
lp15@68551
   906
                    and y: "y \<in> carrier R" "Y = (a_kernel R S h) +> y"
lp15@68551
   907
    unfolding FactRing_def A_RCOSETS_def' by auto
lp15@68551
   908
  hence "h x = h y" using Eq by simp
lp15@68551
   909
  hence "x \<ominus> y \<in> (a_kernel R S h)"
lp15@68551
   910
    by (simp add: a_minus_def abelian_subgroup.a_rcos_module_imp
lp15@68551
   911
                  abelian_subgroup_a_kernel homeq_imp_rcos x(1) y(1))
lp15@68551
   912
  thus "X = Y"
lp15@68551
   913
    by (metis R.a_coset_add_inv1 R.minus_eq abelian_subgroup.a_rcos_const
lp15@68551
   914
        abelian_subgroup_a_kernel additive_subgroup.a_subset additive_subgroup_a_kernel x y)
lp15@68551
   915
qed
lp15@68551
   916
lp15@68551
   917
lemma (in ring_hom_ring) quot_mem:
lp15@68551
   918
  "\<And>X. X \<in> carrier (R Quot (a_kernel R S h)) \<Longrightarrow> \<exists>x \<in> carrier R. X = (a_kernel R S h) +> x"
lp15@68551
   919
proof -
lp15@68551
   920
  fix X assume "X \<in> carrier (R Quot (a_kernel R S h))"
lp15@68551
   921
  thus "\<exists>x \<in> carrier R. X = (a_kernel R S h) +> x"
lp15@68551
   922
    unfolding FactRing_def RCOSETS_def A_RCOSETS_def by (simp add: a_r_coset_def)
lp15@68551
   923
qed
lp15@68551
   924
lp15@68551
   925
lemma (in ring_hom_ring) the_elem_wf:
lp15@68551
   926
  "\<And>X. X \<in> carrier (R Quot (a_kernel R S h)) \<Longrightarrow> \<exists>y \<in> carrier S. (h ` X) = { y }"
lp15@68551
   927
proof -
lp15@68551
   928
  fix X assume "X \<in> carrier (R Quot (a_kernel R S h))"
lp15@68551
   929
  then obtain x where x: "x \<in> carrier R" and X: "X = (a_kernel R S h) +> x"
lp15@68551
   930
    using quot_mem by blast
lp15@68551
   931
  hence "\<And>x'. x' \<in> X \<Longrightarrow> h x' = h x"
lp15@68551
   932
  proof -
lp15@68551
   933
    fix x' assume "x' \<in> X" hence "x' \<in> (a_kernel R S h) +> x" using X by simp
lp15@68551
   934
    then obtain k where k: "k \<in> a_kernel R S h" "x' = k \<oplus> x"
lp15@68551
   935
      by (metis R.add.inv_closed R.add.m_assoc R.l_neg R.r_zero
lp15@68551
   936
          abelian_subgroup.a_elemrcos_carrier
lp15@68551
   937
          abelian_subgroup.a_rcos_module_imp abelian_subgroup_a_kernel x)
lp15@68551
   938
    hence "h x' = h k \<oplus>\<^bsub>S\<^esub> h x"
lp15@68551
   939
      by (meson additive_subgroup.a_Hcarr additive_subgroup_a_kernel hom_add x)
lp15@68551
   940
    also have " ... =  h x"
lp15@68551
   941
      using k by (auto simp add: x)
lp15@68551
   942
    finally show "h x' = h x" .
lp15@68551
   943
  qed
lp15@68551
   944
  moreover have "h x \<in> h ` X"
lp15@68551
   945
    by (simp add: X homeq_imp_rcos x)
lp15@68551
   946
  ultimately have "(h ` X) = { h x }"
lp15@68551
   947
    by blast
lp15@68551
   948
  thus "\<exists>y \<in> carrier S. (h ` X) = { y }" using x by simp
lp15@68551
   949
qed
lp15@68551
   950
lp15@68551
   951
corollary (in ring_hom_ring) the_elem_wf':
lp15@68551
   952
  "\<And>X. X \<in> carrier (R Quot (a_kernel R S h)) \<Longrightarrow> \<exists>r \<in> carrier R. (h ` X) = { h r }"
lp15@68551
   953
  using the_elem_wf by (metis quot_mem the_elem_eq the_elem_simp) 
lp15@68551
   954
lp15@68551
   955
lemma (in ring_hom_ring) the_elem_hom:
lp15@68551
   956
  "(\<lambda>X. the_elem (h ` X)) \<in> ring_hom (R Quot (a_kernel R S h)) S"
lp15@68551
   957
proof (rule ring_hom_memI)
lp15@68551
   958
  show "\<And>x. x \<in> carrier (R Quot a_kernel R S h) \<Longrightarrow> the_elem (h ` x) \<in> carrier S"
lp15@68551
   959
    using the_elem_wf by fastforce
lp15@68551
   960
  
lp15@68551
   961
  show "the_elem (h ` \<one>\<^bsub>R Quot a_kernel R S h\<^esub>) = \<one>\<^bsub>S\<^esub>"
lp15@68551
   962
    unfolding FactRing_def  using the_elem_simp[of "\<one>\<^bsub>R\<^esub>"] by simp
lp15@68551
   963
lp15@68551
   964
  fix X Y
lp15@68551
   965
  assume "X \<in> carrier (R Quot a_kernel R S h)"
lp15@68551
   966
     and "Y \<in> carrier (R Quot a_kernel R S h)"
lp15@68551
   967
  then obtain x y where x: "x \<in> carrier R" "X = (a_kernel R S h) +> x"
lp15@68551
   968
                    and y: "y \<in> carrier R" "Y = (a_kernel R S h) +> y"
lp15@68551
   969
    using quot_mem by blast
lp15@68551
   970
lp15@68551
   971
  have "X \<otimes>\<^bsub>R Quot a_kernel R S h\<^esub> Y = (a_kernel R S h) +> (x \<otimes> y)"
lp15@68551
   972
    by (simp add: FactRing_def ideal.rcoset_mult_add kernel_is_ideal x y)
lp15@68551
   973
  thus "the_elem (h ` (X \<otimes>\<^bsub>R Quot a_kernel R S h\<^esub> Y)) = the_elem (h ` X) \<otimes>\<^bsub>S\<^esub> the_elem (h ` Y)"
lp15@68551
   974
    by (simp add: x y)
lp15@68551
   975
lp15@68551
   976
  have "X \<oplus>\<^bsub>R Quot a_kernel R S h\<^esub> Y = (a_kernel R S h) +> (x \<oplus> y)"
lp15@68551
   977
    using ideal.rcos_ring_hom kernel_is_ideal ring_hom_add x y by fastforce
lp15@68551
   978
  thus "the_elem (h ` (X \<oplus>\<^bsub>R Quot a_kernel R S h\<^esub> Y)) = the_elem (h ` X) \<oplus>\<^bsub>S\<^esub> the_elem (h ` Y)"
lp15@68551
   979
    by (simp add: x y)
lp15@68551
   980
qed
lp15@68551
   981
lp15@68551
   982
lemma (in ring_hom_ring) the_elem_surj:
lp15@68551
   983
    "(\<lambda>X. (the_elem (h ` X))) ` carrier (R Quot (a_kernel R S h)) = (h ` (carrier R))"
lp15@68551
   984
proof
lp15@68551
   985
  show "(\<lambda>X. the_elem (h ` X)) ` carrier (R Quot a_kernel R S h) \<subseteq> h ` carrier R"
lp15@68551
   986
    using the_elem_wf' by fastforce
lp15@68551
   987
next
lp15@68551
   988
  show "h ` carrier R \<subseteq> (\<lambda>X. the_elem (h ` X)) ` carrier (R Quot a_kernel R S h)"
lp15@68551
   989
  proof
lp15@68551
   990
    fix y assume "y \<in> h ` carrier R"
lp15@68551
   991
    then obtain x where x: "x \<in> carrier R" "h x = y"
lp15@68551
   992
      by (metis image_iff)
lp15@68551
   993
    hence "the_elem (h ` ((a_kernel R S h) +> x)) = y" by simp
lp15@68551
   994
    moreover have "(a_kernel R S h) +> x \<in> carrier (R Quot (a_kernel R S h))"
lp15@68551
   995
     unfolding FactRing_def RCOSETS_def A_RCOSETS_def by (auto simp add: x a_r_coset_def)
lp15@68551
   996
    ultimately show "y \<in> (\<lambda>X. (the_elem (h ` X))) ` carrier (R Quot (a_kernel R S h))" by blast
lp15@68551
   997
  qed
lp15@68551
   998
qed
lp15@68551
   999
lp15@68551
  1000
proposition (in ring_hom_ring) FactRing_iso_set_aux:
lp15@68551
  1001
  "(\<lambda>X. the_elem (h ` X)) \<in> ring_iso (R Quot (a_kernel R S h)) (S \<lparr> carrier := h ` (carrier R) \<rparr>)"
lp15@68551
  1002
proof -
lp15@68551
  1003
  have "bij_betw (\<lambda>X. the_elem (h ` X)) (carrier (R Quot a_kernel R S h)) (h ` (carrier R))"
lp15@68551
  1004
    unfolding bij_betw_def inj_on_def using the_elem_surj the_elem_inj by simp
lp15@68551
  1005
lp15@68551
  1006
  moreover
lp15@68551
  1007
  have "(\<lambda>X. the_elem (h ` X)): carrier (R Quot (a_kernel R S h)) \<rightarrow> h ` (carrier R)"
lp15@68551
  1008
    using the_elem_wf' by fastforce
lp15@68551
  1009
  hence "(\<lambda>X. the_elem (h ` X)) \<in> ring_hom (R Quot (a_kernel R S h)) (S \<lparr> carrier := h ` (carrier R) \<rparr>)"
lp15@68551
  1010
    using the_elem_hom the_elem_wf' unfolding ring_hom_def by simp
lp15@68551
  1011
lp15@68551
  1012
  ultimately show ?thesis unfolding ring_iso_def using the_elem_hom by simp
lp15@68551
  1013
qed
lp15@68551
  1014
lp15@68551
  1015
theorem (in ring_hom_ring) FactRing_iso_set:
lp15@68551
  1016
  assumes "h ` carrier R = carrier S"
lp15@68551
  1017
  shows "(\<lambda>X. the_elem (h ` X)) \<in> ring_iso (R Quot (a_kernel R S h)) S"
lp15@68551
  1018
  using FactRing_iso_set_aux assms by auto
lp15@68551
  1019
lp15@68551
  1020
corollary (in ring_hom_ring) FactRing_iso:
lp15@68551
  1021
  assumes "h ` carrier R = carrier S"
lp15@68551
  1022
  shows "R Quot (a_kernel R S h) \<simeq> S"
lp15@68551
  1023
  using FactRing_iso_set assms is_ring_iso_def by auto
lp15@68551
  1024
lp15@68551
  1025
lemma (in ring_hom_ring) img_is_ring: "ring (S \<lparr> carrier := h ` (carrier R) \<rparr>)"
lp15@68551
  1026
proof -
lp15@68551
  1027
  let ?the_elem = "\<lambda>X. the_elem (h ` X)"
lp15@68551
  1028
  have FactRing_is_ring: "ring (R Quot (a_kernel R S h))"
lp15@68551
  1029
    by (simp add: ideal.quotient_is_ring kernel_is_ideal)
lp15@68551
  1030
  have "ring ((S \<lparr> carrier := ?the_elem ` (carrier (R Quot (a_kernel R S h))) \<rparr>)
lp15@68551
  1031
                 \<lparr>     one := ?the_elem \<one>\<^bsub>(R Quot (a_kernel R S h))\<^esub>,
lp15@68551
  1032
                      zero := ?the_elem \<zero>\<^bsub>(R Quot (a_kernel R S h))\<^esub> \<rparr>)"
lp15@68551
  1033
    using ring.ring_iso_imp_img_ring[OF FactRing_is_ring, of ?the_elem
lp15@68551
  1034
          "S \<lparr> carrier := ?the_elem ` (carrier (R Quot (a_kernel R S h))) \<rparr>"]
lp15@68551
  1035
          FactRing_iso_set_aux the_elem_surj by auto
lp15@68551
  1036
lp15@68551
  1037
  moreover
lp15@68551
  1038
  have "\<zero> \<in> (a_kernel R S h)"
lp15@68551
  1039
    using a_kernel_def'[of R S h] by auto
lp15@68551
  1040
  hence "\<one> \<in> (a_kernel R S h) +> \<one>"
lp15@68551
  1041
    using a_r_coset_def'[of R "a_kernel R S h" \<one>] by force
lp15@68551
  1042
  hence "\<one>\<^bsub>S\<^esub> \<in> (h ` ((a_kernel R S h) +> \<one>))"
lp15@68551
  1043
    using hom_one by force
lp15@68551
  1044
  hence "?the_elem \<one>\<^bsub>(R Quot (a_kernel R S h))\<^esub> = \<one>\<^bsub>S\<^esub>"
lp15@68551
  1045
    using the_elem_wf[of "(a_kernel R S h) +> \<one>"] by (simp add: FactRing_def)
lp15@68551
  1046
  
lp15@68551
  1047
  moreover
lp15@68551
  1048
  have "\<zero>\<^bsub>S\<^esub> \<in> (h ` (a_kernel R S h))"
lp15@68551
  1049
    using a_kernel_def'[of R S h] hom_zero by force
lp15@68551
  1050
  hence "\<zero>\<^bsub>S\<^esub> \<in> (h ` \<zero>\<^bsub>(R Quot (a_kernel R S h))\<^esub>)"
lp15@68551
  1051
    by (simp add: FactRing_def)
lp15@68551
  1052
  hence "?the_elem \<zero>\<^bsub>(R Quot (a_kernel R S h))\<^esub> = \<zero>\<^bsub>S\<^esub>"
lp15@68551
  1053
    using the_elem_wf[OF ring.ring_simprules(2)[OF FactRing_is_ring]]
lp15@68551
  1054
    by (metis singletonD the_elem_eq) 
lp15@68551
  1055
lp15@68551
  1056
  ultimately
lp15@68551
  1057
  have "ring ((S \<lparr> carrier := h ` (carrier R) \<rparr>) \<lparr> one := \<one>\<^bsub>S\<^esub>, zero := \<zero>\<^bsub>S\<^esub> \<rparr>)"
lp15@68551
  1058
    using the_elem_surj by simp
lp15@68551
  1059
  thus ?thesis
lp15@68551
  1060
    by auto
lp15@68551
  1061
qed
lp15@68551
  1062
lp15@68551
  1063
lemma (in ring_hom_ring) img_is_cring:
lp15@68551
  1064
  assumes "cring S"
lp15@68551
  1065
  shows "cring (S \<lparr> carrier := h ` (carrier R) \<rparr>)"
lp15@68551
  1066
proof -
lp15@68551
  1067
  interpret ring "S \<lparr> carrier := h ` (carrier R) \<rparr>"
lp15@68551
  1068
    using img_is_ring .
lp15@68551
  1069
  show ?thesis
lp15@68551
  1070
    apply unfold_locales
lp15@68551
  1071
    using assms unfolding cring_def comm_monoid_def comm_monoid_axioms_def by auto
lp15@68551
  1072
qed
lp15@68551
  1073
lp15@68551
  1074
lemma (in ring_hom_ring) img_is_domain:
lp15@68551
  1075
  assumes "domain S"
lp15@68551
  1076
  shows "domain (S \<lparr> carrier := h ` (carrier R) \<rparr>)"
lp15@68551
  1077
proof -
lp15@68551
  1078
  interpret cring "S \<lparr> carrier := h ` (carrier R) \<rparr>"
lp15@68551
  1079
    using img_is_cring assms unfolding domain_def by simp
lp15@68551
  1080
  show ?thesis
lp15@68551
  1081
    apply unfold_locales
lp15@68551
  1082
    using assms unfolding domain_def domain_axioms_def apply auto
lp15@68551
  1083
    using hom_closed by blast 
lp15@68551
  1084
qed
lp15@68551
  1085
lp15@68551
  1086
proposition (in ring_hom_ring) primeideal_vimage:
lp15@68551
  1087
  assumes "cring R"
lp15@68551
  1088
  shows "primeideal P S \<Longrightarrow> primeideal { r \<in> carrier R. h r \<in> P } R"
lp15@68551
  1089
proof -
lp15@68551
  1090
  assume A: "primeideal P S"
lp15@68551
  1091
  hence is_ideal: "ideal P S" unfolding primeideal_def by simp
lp15@68551
  1092
  have "ring_hom_ring R (S Quot P) (((+>\<^bsub>S\<^esub>) P) \<circ> h)" (is "ring_hom_ring ?A ?B ?h")
lp15@68551
  1093
    using ring_hom_trans[OF homh, of "(+>\<^bsub>S\<^esub>) P" "S Quot P"]
lp15@68551
  1094
          ideal.rcos_ring_hom_ring[OF is_ideal] assms
lp15@68551
  1095
    unfolding ring_hom_ring_def ring_hom_ring_axioms_def cring_def by simp
lp15@68551
  1096
  then interpret hom: ring_hom_ring R "S Quot P" "((+>\<^bsub>S\<^esub>) P) \<circ> h" by simp
lp15@68551
  1097
  
lp15@68551
  1098
  have "inj_on (\<lambda>X. the_elem (?h ` X)) (carrier (R Quot (a_kernel R (S Quot P) ?h)))"
lp15@68551
  1099
    using hom.the_elem_inj unfolding inj_on_def by simp
lp15@68551
  1100
  moreover
lp15@68551
  1101
  have "ideal (a_kernel R (S Quot P) ?h) R"
lp15@68551
  1102
    using hom.kernel_is_ideal by auto
lp15@68551
  1103
  have hom': "ring_hom_ring (R Quot (a_kernel R (S Quot P) ?h)) (S Quot P) (\<lambda>X. the_elem (?h ` X))"
lp15@68551
  1104
    using hom.the_elem_hom hom.kernel_is_ideal
lp15@68551
  1105
    by (meson hom.ring_hom_ring_axioms ideal.rcos_ring_hom_ring ring_hom_ring_axioms_def ring_hom_ring_def)
lp15@68551
  1106
  
lp15@68551
  1107
  ultimately
lp15@68551
  1108
  have "primeideal (a_kernel R (S Quot P) ?h) R"
lp15@68551
  1109
    using ring_hom_ring.inj_on_domain[OF hom'] primeideal.quotient_is_domain[OF A]
lp15@68551
  1110
          cring.quot_domain_imp_primeideal[OF assms hom.kernel_is_ideal] by simp
lp15@68551
  1111
  
lp15@68551
  1112
  moreover have "a_kernel R (S Quot P) ?h = { r \<in> carrier R. h r \<in> P }"
lp15@68551
  1113
  proof
lp15@68551
  1114
    show "a_kernel R (S Quot P) ?h \<subseteq> { r \<in> carrier R. h r \<in> P }"
lp15@68551
  1115
    proof 
lp15@68551
  1116
      fix r assume "r \<in> a_kernel R (S Quot P) ?h"
lp15@68551
  1117
      hence r: "r \<in> carrier R" "P +>\<^bsub>S\<^esub> (h r) = P"
lp15@68551
  1118
        unfolding a_kernel_def kernel_def FactRing_def by auto
lp15@68551
  1119
      hence "h r \<in> P"
lp15@68551
  1120
        using S.a_rcosI R.l_zero S.l_zero additive_subgroup.a_subset[OF ideal.axioms(1)[OF is_ideal]]
lp15@68551
  1121
              additive_subgroup.zero_closed[OF ideal.axioms(1)[OF is_ideal]] hom_closed by metis
lp15@68551
  1122
      thus "r \<in> { r \<in> carrier R. h r \<in> P }" using r by simp
lp15@68551
  1123
    qed
lp15@68551
  1124
  next
lp15@68551
  1125
    show "{ r \<in> carrier R. h r \<in> P } \<subseteq> a_kernel R (S Quot P) ?h"
lp15@68551
  1126
    proof
lp15@68551
  1127
      fix r assume "r \<in> { r \<in> carrier R. h r \<in> P }"
lp15@68551
  1128
      hence r: "r \<in> carrier R" "h r \<in> P" by simp_all
lp15@68551
  1129
      hence "?h r = P"
lp15@68551
  1130
        by (simp add: S.a_coset_join2 additive_subgroup.a_subgroup ideal.axioms(1) is_ideal)
lp15@68551
  1131
      thus "r \<in> a_kernel R (S Quot P) ?h"
lp15@68551
  1132
        unfolding a_kernel_def kernel_def FactRing_def using r(1) by auto
lp15@68551
  1133
    qed
lp15@68551
  1134
  qed
lp15@68551
  1135
  ultimately show "primeideal { r \<in> carrier R. h r \<in> P } R" by simp
lp15@68551
  1136
qed
lp15@68551
  1137
ballarin@20318
  1138
end