Theory CZH_EX_Algebra

(* Copyright 2021 (C) Mihails Milehins *)

section‹Example III: abstract algebra›
theory CZH_EX_Algebra
  imports CZH_EX_TS
begin



subsection‹Background›


text‹
The section presents several examples of algebraic structures formalized
in ZFC in HOL›. The definitions were adopted (with amendments) from the
main library of Isabelle/HOL.
›

named_theorems sgrp_struct_field_simps

lemmas [sgrp_struct_field_simps] = 𝒜_def



subsection‹Semigroup›


subsubsection‹Foundations›

definition mbinop where [sgrp_struct_field_simps]: "mbinop = 1"

locale 𝒵_sgrp_basis = 𝒵_vfsequence α 𝔖 + op: binop 𝔖𝒜 𝔖mbinop 
  for α 𝔖 +
  assumes 𝒵_sgrp_length: "vcard 𝔖 = 2"

abbreviation sgrp_app :: "V  V  V  V" (infixl ı› 70)
  where "sgrp_app 𝔖 a b  𝔖mbinopa, b"
notation sgrp_app (infixl  70)


text‹Rules.›

lemma 𝒵_sgrp_basisI[intro]:
  assumes "𝒵_vfsequence α 𝔖"
    and "vcard 𝔖 = 2"
    and "binop (𝔖𝒜) (𝔖mbinop)"
  shows "𝒵_sgrp_basis α 𝔖"
  using assms unfolding 𝒵_sgrp_basis_def 𝒵_sgrp_basis_axioms_def by simp

lemma 𝒵_sgrp_basisD[dest]:
  assumes "𝒵_sgrp_basis α 𝔖"
  shows "𝒵_vfsequence α 𝔖"
    and "vcard 𝔖 = 2"
    and "binop (𝔖𝒜) (𝔖mbinop)"
  using assms unfolding 𝒵_sgrp_basis_def 𝒵_sgrp_basis_axioms_def by auto

lemma 𝒵_sgrp_basisE[elim]:
  assumes "𝒵_sgrp_basis α 𝔖"
  shows "𝒵_vfsequence α 𝔖"
    and "vcard 𝔖 = 2"
    and "binop (𝔖𝒜) (𝔖mbinop)"
  using assms unfolding 𝒵_sgrp_basis_def 𝒵_sgrp_basis_axioms_def by auto


subsubsection‹Simple semigroup›

locale 𝒵_sgrp = 𝒵_sgrp_basis α 𝔖 for α 𝔖 +
  assumes 𝒵_sgrp_assoc: 
    " a  𝔖𝒜; b  𝔖𝒜; c  𝔖𝒜   
      (a 𝔖b) 𝔖c = a 𝔖(b 𝔖c)"


text‹Rules.›

lemma 𝒵_sgrpI[intro]:
  assumes "𝒵_sgrp_basis α 𝔖" 
    and "a b c.  a  𝔖𝒜; b  𝔖𝒜; c  𝔖𝒜   
      (a 𝔖b) 𝔖c = a 𝔖(b 𝔖c)"
  shows "𝒵_sgrp α 𝔖"
  using assms unfolding 𝒵_sgrp_def 𝒵_sgrp_axioms_def by simp

lemma 𝒵_sgrpD[dest]:
  assumes "𝒵_sgrp α 𝔖"
  shows "𝒵_sgrp_basis α 𝔖" 
    and "a b c.  a  𝔖𝒜; b  𝔖𝒜; c  𝔖𝒜   
      (a 𝔖b) 𝔖c = a 𝔖(b 𝔖c)"
  using assms unfolding 𝒵_sgrp_def 𝒵_sgrp_axioms_def by simp_all

lemma 𝒵_sgrpE[elim]:
  assumes "𝒵_sgrp α 𝔖"
  obtains "𝒵_sgrp_basis α 𝔖" 
    and "a b c.  a  𝔖𝒜; b  𝔖𝒜; c  𝔖𝒜   
      (a 𝔖b) 𝔖c = a 𝔖(b 𝔖c)"
  using assms by auto



subsection‹Commutative semigroup›

locale 𝒵_csgrp = 𝒵_sgrp α 𝔖 for α 𝔖 +
  assumes 𝒵_csgrp_commutative: 
    " a  𝔖𝒜; b  𝔖𝒜   a 𝔖b = b 𝔖a"


text‹Rules.›

lemma 𝒵_csgrpI[intro]:
  assumes "𝒵_sgrp α 𝔖"
    and "a b.  a  𝔖𝒜; b  𝔖𝒜   a 𝔖b = b 𝔖a"
  shows "𝒵_csgrp α 𝔖"
  using assms unfolding 𝒵_csgrp_def 𝒵_csgrp_axioms_def by simp

lemma 𝒵_csgrpD[dest]:
  assumes "𝒵_csgrp α 𝔖"
  shows "𝒵_sgrp α 𝔖"
    and "a b.  a  𝔖𝒜; b  𝔖𝒜   a 𝔖b = b 𝔖a"
  using assms unfolding 𝒵_csgrp_def 𝒵_csgrp_axioms_def by simp_all

lemma 𝒵_csgrpE[elim]:
  assumes "𝒵_csgrp α 𝔖"
  obtains "𝒵_sgrp α 𝔖"
    and "a b.  a  𝔖𝒜; b  𝔖𝒜   a 𝔖b = b 𝔖a"
  using assms by auto



subsection‹Semiring›


subsubsection‹Foundations›

definition vplus :: V where [sgrp_struct_field_simps]: "vplus = 1"
definition vmult :: V where [sgrp_struct_field_simps]: "vmult = 2"

abbreviation vplus_app :: "V  V  V  V" (infixl +ı› 65)
  where "a +𝔖b  𝔖vplusa,b"
notation vplus_app (infixl +ı› 65)

abbreviation vmult_app :: "V  V  V  V" (infixl *ı› 70)
  where "a *𝔖b  𝔖vmulta,b"
notation vmult_app (infixl *ı› 70)


subsubsection‹Simple semiring›

locale 𝒵_srng = 𝒵_vfsequence α 𝔖 for α 𝔖 +
  assumes 𝒵_srng_length: "vcard 𝔖 = 3"
    and 𝒵_srng_𝒵_csgrp_vplus: "𝒵_csgrp α [𝔖𝒜, 𝔖vplus]"
    and 𝒵_srng_𝒵_sgrp_vmult: "𝒵_sgrp α [𝔖𝒜, 𝔖vmult]"
    and 𝒵_srng_distrib_right: 
      " a  𝔖𝒜; b  𝔖𝒜; c  𝔖𝒜  
        (a +𝔖b) *𝔖c = (a *𝔖c) +𝔖(b *𝔖c)"
    and 𝒵_srng_distrib_left: 
      " a  𝔖𝒜; b  𝔖𝒜; c  𝔖𝒜  
        a *𝔖(b +𝔖c) = (a *𝔖b) +𝔖(a *𝔖c)"
begin

sublocale vplus: 𝒵_csgrp α [𝔖𝒜, 𝔖vplus]
  rewrites "[𝔖𝒜, 𝔖vplus]𝒜 = 𝔖𝒜"
    and "[𝔖𝒜, 𝔖vplus]mbinop = 𝔖vplus"
    and "sgrp_app [𝔖𝒜, 𝔖vplus] = vplus_app 𝔖"
proof(rule 𝒵_srng_𝒵_csgrp_vplus)
  show "[𝔖𝒜, 𝔖vplus]𝒜 = 𝔖𝒜"
    and [simp]: "[𝔖𝒜, 𝔖vplus]mbinop = 𝔖vplus"
    by (auto simp: 𝒜_def mbinop_def nat_omega_simps)
  show "(⊙[𝔖𝒜, 𝔖vplus]) = (+𝔖)" by simp
qed

sublocale vmult: 𝒵_sgrp α [𝔖𝒜, 𝔖vmult]
  rewrites "[𝔖𝒜, 𝔖vmult]𝒜 = 𝔖𝒜"
    and "[𝔖𝒜, 𝔖vmult]mbinop = 𝔖vmult"
    and "sgrp_app [𝔖𝒜, 𝔖vmult] = vmult_app 𝔖"
proof(rule 𝒵_srng_𝒵_sgrp_vmult)
  show "[𝔖𝒜, 𝔖vmult]𝒜 = 𝔖𝒜"
    and [simp]: "[𝔖𝒜, 𝔖vmult]mbinop = 𝔖vmult"
    by (auto simp: 𝒜_def mbinop_def nat_omega_simps)
  show "(⊙[𝔖𝒜, 𝔖vmult]) = (*𝔖)" by simp
qed

end


text‹Rules.›

lemma 𝒵_srngI[intro]:
  assumes "𝒵_vfsequence α 𝔖"
    and "vcard 𝔖 = 3"
    and "𝒵_csgrp α [𝔖𝒜, 𝔖vplus]"
    and "𝒵_sgrp α [𝔖𝒜, 𝔖vmult]"
    and "a b c.  a  𝔖𝒜; b  𝔖𝒜; c  𝔖𝒜  
      (a +𝔖b) *𝔖c = (a *𝔖c) +𝔖(b *𝔖c)"
    and "a b c.  a  𝔖𝒜; b  𝔖𝒜; c  𝔖𝒜  
      a *𝔖(b +𝔖c) = (a *𝔖b) +𝔖(a *𝔖c)"
  shows "𝒵_srng α 𝔖"
  using assms unfolding 𝒵_srng_def 𝒵_srng_axioms_def by simp

lemma 𝒵_srngD[dest]:
  assumes "𝒵_srng α 𝔖"
  shows "𝒵_vfsequence α 𝔖"
    and "vcard 𝔖 = 3"
    and "𝒵_csgrp α [𝔖𝒜, 𝔖vplus]"
    and "𝒵_sgrp α [𝔖𝒜, 𝔖vmult]"
    and "a b c.  a  𝔖𝒜; b  𝔖𝒜; c  𝔖𝒜  
      (a +𝔖b) *𝔖c = (a *𝔖c) +𝔖(b *𝔖c)"
    and "a b c.  a  𝔖𝒜; b  𝔖𝒜; c  𝔖𝒜  
      a *𝔖(b +𝔖c) = (a *𝔖b) +𝔖(a *𝔖c)"
  using assms unfolding 𝒵_srng_def 𝒵_srng_axioms_def by simp_all

lemma 𝒵_srngE[elim]:
  assumes "𝒵_srng α 𝔖"
  obtains "𝒵_vfsequence α 𝔖"
    and "vcard 𝔖 = 3"
    and "𝒵_csgrp α [𝔖𝒜, 𝔖vplus]"
    and "𝒵_sgrp α [𝔖𝒜, 𝔖vmult]"
    and "a b c.  a  𝔖𝒜; b  𝔖𝒜; c  𝔖𝒜  
      (a +𝔖b) *𝔖c = (a *𝔖c) +𝔖(b *𝔖c)"
    and "a b c.  a  𝔖𝒜; b  𝔖𝒜; c  𝔖𝒜  
      a *𝔖(b +𝔖c) = (a *𝔖b) +𝔖(a *𝔖c)"
  using assms unfolding 𝒵_srng_def 𝒵_srng_axioms_def by auto



subsection‹Integer numbers form a semiring›

definition vint_struct :: V (𝔖)
  where "vint_struct = [, vint_plus, vint_mult]"

named_theorems vint_struct_simps

lemma vint_struct_𝒜[vint_struct_simps]: "𝔖𝒜 = "
  unfolding vint_struct_def by (auto simp: sgrp_struct_field_simps)

lemma vint_struct_vplus[vint_struct_simps]: "𝔖vplus = vint_plus"
  unfolding vint_struct_def 
  by (simp add: sgrp_struct_field_simps nat_omega_simps)

lemma vint_struct_vmult[vint_struct_simps]: "𝔖vmult = vint_mult"
  unfolding vint_struct_def 
  by (simp add: sgrp_struct_field_simps nat_omega_simps)

context 𝒵
begin

lemma 𝒵_srng_vint: "𝒵_srng α 𝔖"
proof(intro 𝒵_srngI, unfold vint_struct_simps)

  interpret 𝔖: vfsequence 𝔖 unfolding vint_struct_def by simp

  show vint_struct: "𝒵_vfsequence α 𝔖"
  proof(intro 𝒵_vfsequenceI)
    show "vfsequence 𝔖" unfolding vint_struct_def by simp
    show " 𝔖  Vset α"
    proof(intro vsubsetI)
      fix x assume "x   𝔖"
      then consider x =  | x = vint_plus | x = vint_mult 
        unfolding vint_struct_def by fastforce
      then show "x  Vset α"
      proof cases
        case 1 with 𝒵_Vset_ω2_vsubset_Vset vint_in_Vset_ω2 show ?thesis by auto
      next
        case 2
        have "𝒟 vint_plus  Vset α"
          unfolding vint_plus.nop_vdomain
        proof(rule Limit_vcpower_in_VsetI)
          from Axiom_of_Infinity show "2  Vset α" by auto
          from 𝒵_Vset_ω2_vsubset_Vset show "  Vset α" 
            by (auto intro: vint_in_Vset_ω2)
        qed auto
        moreover from 𝒵_Vset_ω2_vsubset_Vset have " vint_plus  Vset α"
          unfolding vint_plus.nop_onto_vrange by (auto intro: vint_in_Vset_ω2)
        ultimately show "x  Vset α"
          unfolding 2
          by (simp add: rel_VLambda.vbrelation_Limit_in_VsetI vint_plus_def)
      next
        case 3
        have "𝒟 vint_mult  Vset α"
          unfolding vint_mult.nop_vdomain
        proof(rule Limit_vcpower_in_VsetI)
          from Axiom_of_Infinity show "2  Vset α" by auto
          from 𝒵_Vset_ω2_vsubset_Vset show "  Vset α" 
            by (auto intro: vint_in_Vset_ω2)
        qed auto
        moreover from 𝒵_Vset_ω2_vsubset_Vset Axiom_of_Infinity have 
          " vint_mult  Vset α"
          unfolding vint_mult.nop_onto_vrange by (auto intro: vint_in_Vset_ω2)
        ultimately show "x  Vset α"
          unfolding 3
          by (simp add: rel_VLambda.vbrelation_Limit_in_VsetI vint_mult_def)
      qed
    qed
  qed (simp add: 𝒵_axioms)

  interpret vint_struct: 𝒵_vfsequence α 𝔖 by (rule vint_struct)
  
  show "vcard 𝔖 = 3" 
    unfolding vint_struct_def by (simp add: nat_omega_simps)

  have [vint_struct_simps]:
    "[, vint_plus]𝒜 = " "[, vint_plus]mbinop = vint_plus"
    "[, vint_mult]𝒜 = " "[, vint_mult]mbinop = vint_mult"
    by (auto simp: sgrp_struct_field_simps nat_omega_simps)

  have [vint_struct_simps]:
    "sgrp_app [, vint_plus] = (+)"
    "sgrp_app [, vint_mult] = (*)"
    unfolding vint_struct_simps by simp_all

  show "𝒵_csgrp α [, vint_plus]"
  proof(intro 𝒵_csgrpI, unfold vint_struct_simps)
    show "𝒵_sgrp α [, vint_plus]"
    proof(intro 𝒵_sgrpI 𝒵_sgrp_basisI, unfold vint_struct_simps)
      show "𝒵_vfsequence α [, vint_plus]"
      proof(intro 𝒵_vfsequenceI)
        show " [, vint_plus]  Vset α"
        proof(intro vfsequence_vrange_vconsI)
          from 𝒵_Vset_ω2_vsubset_Vset show [simp]: "  Vset α"
            by (auto intro: vint_in_Vset_ω2)
          show "vint_plus  Vset α"
          proof(rule vbrelation.vbrelation_Limit_in_VsetI)
            from Axiom_of_Infinity show "𝒟 vint_plus  Vset α"
              unfolding vint_plus.nop_vdomain 
              by (intro Limit_vcpower_in_VsetI) auto
            from Axiom_of_Infinity show " vint_plus  Vset α" 
              unfolding vint_plus.nop_onto_vrange by auto
          qed (simp_all add: vint_plus_def)
        qed simp_all
      qed (simp_all add: 𝒵_axioms)
    qed 
      (
         auto simp:
          nat_omega_simps
          vint_plus.binop_axioms
          vint_assoc_law_addition
      ) 
  qed (simp add: vint_commutative_law_addition)

  show "𝒵_sgrp α [, vint_mult]"
  proof
    (
      intro 𝒵_sgrpI 𝒵_sgrp_basisI; 
      (unfold vint_struct_simps | tacticall_tac)
    )
    show "𝒵_vfsequence α [, vint_mult]"
    proof(intro 𝒵_vfsequenceI; (unfold vint_struct_simps | tacticall_tac))
      from 𝒵_axioms show "𝒵 α" by simp
      show " [, vint_mult]  Vset α"
      proof(intro vfsequence_vrange_vconsI)
        from 𝒵_Vset_ω2_vsubset_Vset show [simp]: "  Vset α"
          by (auto intro: vint_in_Vset_ω2)
        show "vint_mult  Vset α"
        proof(rule vbrelation.vbrelation_Limit_in_VsetI)
          from Axiom_of_Infinity show "𝒟 vint_mult  Vset α"
            unfolding vint_mult.nop_vdomain 
            by (intro Limit_vcpower_in_VsetI) auto
          from Axiom_of_Infinity show " vint_mult  Vset α" 
            unfolding vint_mult.nop_onto_vrange by auto
        qed (simp_all add: vint_mult_def)
      qed simp_all
    qed auto
  qed
    (
      auto simp: 
        nat_omega_simps
        vint_mult.binop_axioms
        vint_assoc_law_multiplication
    )

qed
  (
    auto simp: 
      vint_commutative_law_multiplication 
      vint_plus_closed 
      vint_distributive_law
  )


text‹Interpretation.›

interpretation vint: 𝒵_srng α 𝔖
  rewrites "𝔖𝒜 = "
    and "𝔖vplus = vint_plus"
    and "𝔖vmult = vint_mult"
    and "vplus_app (𝔖) = vint_plus_app"
    and "vmult_app (𝔖) = vint_mult_app"
  unfolding vint_struct_simps by (rule 𝒵_srng_vint) simp_all

thm vint.vmult.𝒵_sgrp_assoc
thm vint.vplus.𝒵_sgrp_assoc
thm vint.𝒵_srng_distrib_left

end

text‹\newpage›

end