Theory CZH_DG_TDGHM

(* Copyright 2021 (C) Mihails Milehins *)

section‹Transformation of digraph homomorphisms›
theory CZH_DG_TDGHM
  imports CZH_DG_DGHM
begin



subsection‹Background›

named_theorems tdghm_cs_simps
named_theorems tdghm_cs_intros
named_theorems nt_field_simps

definition NTMap :: V where [nt_field_simps]: "NTMap = 0"
definition NTDom :: V where [nt_field_simps]: "NTDom = 1"
definition NTCod :: V where [nt_field_simps]: "NTCod = 2"
definition NTDGDom :: V where [nt_field_simps]: "NTDGDom = 3"
definition NTDGCod :: V where [nt_field_simps]: "NTDGCod = 4"



subsection‹Definition and elementary properties›


text‹
A transformation of digraph homomorphisms, as presented in this work, 
is a generalization of the concept of a natural transformation, as presented in
Chapter I-4 in cite"mac_lane_categories_2010", to digraphs and digraph
homomorphisms. The generalization is performed by excluding the commutativity 
axiom from the definition. 

The definition of a transformation of digraph homomorphisms is 
parameterized by a limit ordinal α› such that ω < α›. 
Such transformations of digraph homomorphisms are referred to either as
α›-transformations of digraph homomorphisms or 
transformations of α›-digraph homomorphisms.
›

locale is_tdghm = 
  𝒵 α + 
  vfsequence 𝔑 + 
  NTDom: is_dghm α 𝔄 𝔅 𝔉 +
  NTCod: is_dghm α 𝔄 𝔅 𝔊 
  for α 𝔄 𝔅 𝔉 𝔊 𝔑 +
  assumes tdghm_length[dg_cs_simps]: "vcard 𝔑 = 5"
    and tdghm_NTMap_vsv: "vsv (𝔑NTMap)"
    and tdghm_NTMap_vdomain[dg_cs_simps]: "𝒟 (𝔑NTMap) = 𝔄Obj"
    and tdghm_NTDom[dg_cs_simps]: "𝔑NTDom = 𝔉"
    and tdghm_NTCod[dg_cs_simps]: "𝔑NTCod = 𝔊"
    and tdghm_NTDGDom[dg_cs_simps]: "𝔑NTDGDom = 𝔄"
    and tdghm_NTDGCod[dg_cs_simps]: "𝔑NTDGCod = 𝔅"
    and tdghm_NTMap_is_arr: 
      "a  𝔄Obj  𝔑NTMapa : 𝔉ObjMapa 𝔅𝔊ObjMapa"

syntax "_is_tdghm" :: "V  V  V  V  V  V  bool"
  ((_ :/ _ DGHM _ :/ _ ↦↦DGı _) [51, 51, 51, 51, 51] 51)
translations "𝔑 : 𝔉 DGHM 𝔊 : 𝔄 ↦↦DGα𝔅" 
  "CONST is_tdghm α 𝔄 𝔅 𝔉 𝔊 𝔑"

abbreviation all_tdghms :: "V  V"
  where "all_tdghms α  set {𝔑. 𝔉 𝔊 𝔄 𝔅. 𝔑 : 𝔉 DGHM 𝔊 : 𝔄 ↦↦DGα𝔅}"

abbreviation tdghms :: "V  V  V  V"
  where "tdghms α 𝔄 𝔅  set {𝔑. 𝔉 𝔊. 𝔑 : 𝔉 DGHM 𝔊 : 𝔄 ↦↦DGα𝔅}"

abbreviation these_tdghms :: "V  V  V  V  V  V"
  where "these_tdghms α 𝔄 𝔅 𝔉 𝔊  set {𝔑. 𝔑 : 𝔉 DGHM 𝔊 : 𝔄 ↦↦DGα𝔅}"

sublocale is_tdghm  NTMap: vsv 𝔑NTMap
  rewrites "𝒟 (𝔑NTMap) = 𝔄Obj"
  by (rule tdghm_NTMap_vsv) (simp add: dg_cs_simps)

lemmas [dg_cs_simps] =  
  is_tdghm.tdghm_length
  is_tdghm.tdghm_NTMap_vdomain
  is_tdghm.tdghm_NTDom
  is_tdghm.tdghm_NTCod
  is_tdghm.tdghm_NTDGDom
  is_tdghm.tdghm_NTDGCod

lemma (in is_tdghm) tdghm_NTMap_is_arr'[dg_cs_intros]:
  assumes "a  𝔄Obj"
    and "A = 𝔉ObjMapa"
    and "B = 𝔊ObjMapa"
  shows "𝔑NTMapa : A 𝔅B"
  using assms(1) unfolding assms(2,3) by (rule tdghm_NTMap_is_arr)

lemmas [dg_cs_intros] = is_tdghm.tdghm_NTMap_is_arr'


text‹Rules.›

lemma (in is_tdghm) is_tdghm_axioms'[dg_cs_intros]:
  assumes "α' = α" and "𝔄' = 𝔄" and "𝔅' = 𝔅" and "𝔉' = 𝔉" and "𝔊' = 𝔊"
  shows "𝔑 : 𝔉' DGHM 𝔊' : 𝔄' ↦↦DGα'𝔅'"
  unfolding assms by (rule is_tdghm_axioms)

mk_ide rf is_tdghm_def[unfolded is_tdghm_axioms_def]
  |intro is_tdghmI|
  |dest is_tdghmD[dest]|
  |elim is_tdghmE[elim]|

lemmas [dg_cs_intros] =
  is_tdghmD(3,4)


text‹Elementary properties.›

lemma tdghm_eqI:
  assumes "𝔑 : 𝔉 DGHM 𝔊 : 𝔄 ↦↦DGα𝔅" 
    and "𝔑' : 𝔉' DGHM 𝔊' : 𝔄' ↦↦DGα𝔅'"
    and "𝔑NTMap = 𝔑'NTMap"
    and "𝔉 = 𝔉'"
    and "𝔊 = 𝔊'"
    and "𝔄 = 𝔄'"
    and "𝔅 = 𝔅'"
  shows "𝔑 = 𝔑'"
proof-
  interpret L: is_tdghm α 𝔄 𝔅 𝔉 𝔊 𝔑 by (rule assms(1))
  interpret R: is_tdghm α 𝔄' 𝔅' 𝔉' 𝔊' 𝔑' by (rule assms(2))
  show ?thesis
  proof(rule vsv_eqI)
    have dom: "𝒟 𝔑 = 5" 
      by (cs_concl cs_shallow cs_simp: dg_cs_simps V_cs_simps)
    show "𝒟 𝔑 = 𝒟 𝔑'"
      by (cs_concl cs_shallow cs_simp: dg_cs_simps V_cs_simps)
    from assms(4-7) have sup: 
      "𝔑NTDom = 𝔑'NTDom" "𝔑NTCod = 𝔑'NTCod" 
      "𝔑NTDGDom = 𝔑'NTDGDom" "𝔑NTDGCod = 𝔑'NTDGCod" 
      by (simp_all add: dg_cs_simps)
    show "a  𝒟 𝔑  𝔑a = 𝔑'a" for a 
      by (unfold dom, elim_in_numeral, insert assms(3) sup)
        (auto simp: nt_field_simps)
  qed (auto simp: L.vsv_axioms R.vsv_axioms)
qed

lemma (in is_tdghm) tdghm_def:
  "𝔑 = [𝔑NTMap, 𝔑NTDom, 𝔑NTCod, 𝔑NTDGDom, 𝔑NTDGCod]"
proof(rule vsv_eqI)
  have dom_lhs: "𝒟 𝔑 = 5" 
    by (cs_concl cs_shallow cs_simp: dg_cs_simps V_cs_simps)
  have dom_rhs:
    "𝒟 [𝔑NTMap, 𝔑NTDGDom, 𝔑NTDGCod, 𝔑NTDom, 𝔑NTCod] = 5"
    by (simp add: nat_omega_simps)
  then show 
    "𝒟 𝔑 = 𝒟 [𝔑NTMap, 𝔑NTDom, 𝔑NTCod, 𝔑NTDGDom, 𝔑NTDGCod]"
    unfolding dom_lhs dom_rhs by (simp add: nat_omega_simps)
  show "a  𝒟 𝔑 
    𝔑a = [𝔑NTMap, 𝔑NTDom, 𝔑NTCod, 𝔑NTDGDom, 𝔑NTDGCod]a" 
    for a
    by (unfold dom_lhs, elim_in_numeral, unfold nt_field_simps)
      (simp_all add: nat_omega_simps)
qed (auto simp: vsv_axioms)

lemma (in is_tdghm) tdghm_NTMap_app_in_Arr[dg_cs_intros]:
  assumes "a  𝔄Obj"
  shows "𝔑NTMapa  𝔅Arr"
  using assms using tdghm_NTMap_is_arr by auto

lemmas [dg_cs_intros] = is_tdghm.tdghm_NTMap_app_in_Arr

lemma (in is_tdghm) tdghm_NTMap_vrange_vifunion:
  " (𝔑NTMap)  (a (𝔉ObjMap). b (𝔊ObjMap). Hom 𝔅 a b)"
proof(intro NTMap.vsv_vrange_vsubset)
  fix x assume prems: "x  𝔄Obj"
  note 𝔑x = tdghm_NTMap_is_arr[OF prems]
  from prems show 
    "𝔑NTMapx  (a (𝔉ObjMap). b (𝔊ObjMap). Hom 𝔅 a b)"
    by (intro vifunionI, unfold in_Hom_iff) 
      (
        auto intro: 
          dg_cs_intros NTDom.ObjMap.vsv_vimageI2' NTCod.ObjMap.vsv_vimageI2' 
      )
qed

lemma (in is_tdghm) tdghm_NTMap_vrange: " (𝔑NTMap)  𝔅Arr"
proof(intro NTMap.vsv_vrange_vsubset)
  fix x assume "x  𝔄Obj"
  with is_tdghm_axioms show "𝔑NTMapx  𝔅Arr"
    by (cs_concl cs_shallow cs_simp: dg_cs_simps cs_intro: dg_cs_intros)
qed


text‹Size.›

lemma (in is_tdghm) tdghm_NTMap_vsubset_Vset: "𝔑NTMap  Vset α"
proof(intro NTMap.vbrelation_Limit_vsubset_VsetI)
  show " (𝔑NTMap)  Vset α"
    by 
      (
        rule vsubset_transitive, 
        rule tdghm_NTMap_vrange,
        rule NTDom.HomCod.dg_Arr_vsubset_Vset
      )
qed (simp_all add: NTDom.HomDom.dg_Obj_vsubset_Vset)

lemma (in is_tdghm) tdghm_NTMap_in_Vset: 
  assumes "α  β"
  shows "𝔑NTMap  Vset β"
  by (meson assms tdghm_NTMap_vsubset_Vset Vset_in_mono vsubset_in_VsetI)

lemma (in is_tdghm) tdghm_in_Vset: 
  assumes "𝒵 β" and "α  β"
  shows "𝔑  Vset β"
proof-
  interpret β: 𝒵 β by (rule assms(1))
  note [dg_cs_intros] = 
    tdghm_NTMap_in_Vset
    NTDom.dghm_in_Vset
    NTCod.dghm_in_Vset
    NTDom.HomDom.dg_in_Vset
    NTDom.HomCod.dg_in_Vset
  from assms(2) show ?thesis
    by (subst tdghm_def) 
      (
        cs_concl cs_shallow 
          cs_simp: dg_cs_simps cs_intro: dg_cs_intros V_cs_intros
      )
qed

lemma (in is_tdghm) tdghm_is_tdghm_if_ge_Limit:
  assumes "𝒵 β" and "α  β"
  shows "𝔑 : 𝔉 DGHM 𝔊 : 𝔄 ↦↦DGβ𝔅"
proof(rule is_tdghmI)
  show "𝔑NTMapa : 𝔉ObjMapa 𝔅𝔊ObjMapa" if "a  𝔄Obj" for a
    using that by (cs_concl cs_shallow cs_intro: dg_cs_intros)
qed 
  (
    cs_concl cs_shallow 
      cs_simp: dg_cs_simps 
      cs_intro:
        V_cs_intros
        assms NTDom.dghm_is_dghm_if_ge_Limit NTCod.dghm_is_dghm_if_ge_Limit  
   )+

lemma small_all_tdghms[simp]: 
  "small {𝔑. 𝔉 𝔊 𝔄 𝔅. 𝔑 : 𝔉 DGHM 𝔊 : 𝔄 ↦↦DGα𝔅}"
proof(cases 𝒵 α)
  case True
  from is_tdghm.tdghm_in_Vset show ?thesis
    by (intro down[of _ Vset (α + ω)]) 
      (auto simp: True 𝒵.𝒵_Limit_αω 𝒵.𝒵_ω_αω 𝒵.intro 𝒵.𝒵_α_αω)
next
  case False
  then have "{𝔑. 𝔉 𝔊 𝔄 𝔅. 𝔑 : 𝔉 DGHM 𝔊 : 𝔄 ↦↦DGα𝔅} = {}" by auto
  then show ?thesis by simp
qed

lemma small_tdghms[simp]: "small {𝔑. 𝔉 𝔊. 𝔑 : 𝔉 DGHM 𝔊 : 𝔄 ↦↦DGα𝔅}"
  by (rule down[of _ set {𝔑. 𝔉 𝔊 𝔄 𝔅. 𝔑 : 𝔉 DGHM 𝔊 : 𝔄 ↦↦DGα𝔅}])
    auto

lemma small_these_tdghms[simp]: "small {𝔑. 𝔑 : 𝔉 DGHM 𝔊 : 𝔄 ↦↦DGα𝔅}"
  by (rule down[of _ set {𝔑. 𝔉 𝔊 𝔄 𝔅. 𝔑 : 𝔉 DGHM 𝔊 : 𝔄 ↦↦DGα𝔅}]) 
    auto


text‹Further elementary results.›

lemma these_tdghms_iff(*not simp*): 
  "𝔑  these_tdghms α 𝔄 𝔅 𝔉 𝔊  𝔑 : 𝔉 DGHM 𝔊 : 𝔄 ↦↦DGα𝔅"
  by auto



subsection‹Opposite transformation of digraph homomorphisms›


subsubsection‹Definition and elementary properties›


text‹See section 1.5 in cite"bodo_categories_1970".›

definition op_tdghm :: "V  V"
  where "op_tdghm 𝔑 =
    [
      𝔑NTMap,
      op_dghm (𝔑NTCod),
      op_dghm (𝔑NTDom),
      op_dg (𝔑NTDGDom),
      op_dg (𝔑NTDGCod)
    ]"


text‹Components.›

lemma op_tdghm_components[dg_op_simps]:
  shows "op_tdghm 𝔑NTMap = 𝔑NTMap"
    and "op_tdghm 𝔑NTDom = op_dghm (𝔑NTCod)"
    and "op_tdghm 𝔑NTCod = op_dghm (𝔑NTDom)"
    and "op_tdghm 𝔑NTDGDom = op_dg (𝔑NTDGDom)"
    and "op_tdghm 𝔑NTDGCod = op_dg (𝔑NTDGCod)"
  unfolding op_tdghm_def nt_field_simps by (auto simp: nat_omega_simps)


subsubsection‹Further properties›

lemma (in is_tdghm) is_tdghm_op: 
  "op_tdghm 𝔑 : op_dghm 𝔊 DGHM op_dghm 𝔉 : op_dg 𝔄 ↦↦DGαop_dg 𝔅"
proof(rule is_tdghmI, unfold dg_op_simps)
  show "vfsequence (op_tdghm 𝔑)" by (simp add: op_tdghm_def)
  show "vcard (op_tdghm 𝔑) = 5" by (simp add: op_tdghm_def nat_omega_simps)
  show "𝔑NTMapa : 𝔉ObjMapa 𝔅𝔊ObjMapa" if "a  𝔄Obj" for a
    using that by (cs_concl cs_shallow cs_intro: dg_cs_intros)
qed 
  (
    cs_concl cs_shallow
      cs_simp: dg_cs_simps cs_intro: dg_cs_intros dg_op_intros V_cs_intros
  )+

lemma (in is_tdghm) is_tdghm_op'[dg_op_intros]: 
  assumes "𝔊' = op_dghm 𝔊"
    and "𝔉' = op_dghm 𝔉"
    and "𝔄' = op_dg 𝔄"
    and "𝔅' = op_dg 𝔅"
  shows "op_tdghm 𝔑 : 𝔊' DGHM 𝔉' : 𝔄' ↦↦DGα𝔅'"
  unfolding assms by (rule is_tdghm_op)

lemmas is_tdghm_op[dg_op_intros] = is_tdghm.is_tdghm_op'

lemma (in is_tdghm) tdghm_op_tdghm_op_tdghm[dg_op_simps]: 
  "op_tdghm (op_tdghm 𝔑) = 𝔑"
proof(rule tdghm_eqI[of α 𝔄 𝔅 𝔉 𝔊 _ 𝔄 𝔅 𝔉 𝔊], unfold dg_op_simps)
  interpret op: 
    is_tdghm α op_dg 𝔄 op_dg 𝔅 op_dghm 𝔊 op_dghm 𝔉 op_tdghm 𝔑
    by (rule is_tdghm_op)
  from op.is_tdghm_op show 
    "op_tdghm (op_tdghm 𝔑) : 𝔉 DGHM 𝔊 : 𝔄 ↦↦DGα𝔅"
    by (simp add: dg_op_simps)
qed (auto simp: dg_cs_intros)

lemmas tdghm_op_tdghm_op_tdghm[dg_op_simps] = 
  is_tdghm.tdghm_op_tdghm_op_tdghm

lemma eq_op_tdghm_iff: 
  assumes "𝔑 : 𝔉 DGHM 𝔊 : 𝔄 ↦↦DGα𝔅" 
    and "𝔑' : 𝔉' DGHM 𝔊' : 𝔄' ↦↦DGα𝔅'"
  shows "op_tdghm 𝔑 = op_tdghm 𝔑'  𝔑 = 𝔑'"
proof
  interpret L: is_tdghm α 𝔄 𝔅 𝔉 𝔊 𝔑 by (rule assms(1))
  interpret R: is_tdghm α 𝔄' 𝔅' 𝔉' 𝔊' 𝔑' by (rule assms(2))
  assume prems: "op_tdghm 𝔑 = op_tdghm 𝔑'"
  show "𝔑 = 𝔑'"
  proof(rule tdghm_eqI[OF assms])
    from prems L.tdghm_op_tdghm_op_tdghm R.tdghm_op_tdghm_op_tdghm show 
      "𝔑NTMap = 𝔑'NTMap"
      by metis+
    from prems L.tdghm_op_tdghm_op_tdghm R.tdghm_op_tdghm_op_tdghm 
    have "𝔑NTDom = 𝔑'NTDom" 
      and "𝔑NTCod = 𝔑'NTCod" 
      and "𝔑NTDGDom = 𝔑'NTDGDom" 
      and "𝔑NTDGCod = 𝔑'NTDGCod" 
      by metis+
    then show "𝔉 = 𝔉'" "𝔊 = 𝔊'" "𝔄 = 𝔄'" "𝔅 = 𝔅'" by (auto simp: dg_cs_simps)
  qed
qed auto



subsection‹
Composition of a transformation of digraph homomorphisms 
and a digraph homomorphism
›


subsubsection‹Definition and elementary properties›

definition tdghm_dghm_comp :: "V  V  V" (infixl TDGHM-DGHM 55)
  where "𝔑 TDGHM-DGHM  =
    [
      (λaHomDomObj. 𝔑NTMapObjMapa),
      𝔑NTDom DGHM ,
      𝔑NTCod DGHM ,
      HomDom,
      𝔑NTDGCod
    ]"


text‹Components.›

lemma tdghm_dghm_comp_components:
  shows "(𝔑 TDGHM-DGHM )NTMap =
    (λaHomDomObj. 𝔑NTMapObjMapa)"
    and [dg_shared_cs_simps, dg_cs_simps]: 
      "(𝔑 TDGHM-DGHM )NTDom = 𝔑NTDom DGHM "
    and [dg_shared_cs_simps, dg_cs_simps]: 
      "(𝔑 TDGHM-DGHM )NTCod = 𝔑NTCod DGHM "
    and [dg_shared_cs_simps, dg_cs_simps]: 
      "(𝔑 TDGHM-DGHM )NTDGDom = HomDom"
    and [dg_shared_cs_simps, dg_cs_simps]: 
      "(𝔑 TDGHM-DGHM )NTDGCod = 𝔑NTDGCod"
  unfolding tdghm_dghm_comp_def nt_field_simps 
  by (simp_all add: nat_omega_simps)


subsubsection‹Transformation map›

mk_VLambda tdghm_dghm_comp_components(1)
  |vsv tdghm_dghm_comp_NTMap_vsv[dg_shared_cs_intros, dg_cs_intros]|

mk_VLambda (in is_dghm) 
  tdghm_dghm_comp_components(1)[where=𝔉, unfolded dghm_HomDom]
  |vdomain tdghm_dghm_comp_NTMap_vdomain|
  |app tdghm_dghm_comp_NTMap_app|

lemmas [dg_cs_simps] = 
  is_dghm.tdghm_dghm_comp_NTMap_vdomain
  is_dghm.tdghm_dghm_comp_NTMap_app

lemma tdghm_dghm_comp_NTMap_vrange: 
  assumes "𝔑 : 𝔉 DGHM 𝔊 : 𝔅 ↦↦DGα" and " : 𝔄 ↦↦DGα𝔅"
  shows " ((𝔑 TDGHM-DGHM )NTMap)  Arr"
proof-
  interpret 𝔑: is_tdghm α 𝔅  𝔉 𝔊 𝔑 by (rule assms(1))
  interpret: is_dghm α 𝔄 𝔅  by (rule assms(2))
  show ?thesis 
    unfolding tdghm_dghm_comp_components
  proof(rule vrange_VLambda_vsubset, unfold dg_cs_simps)
    fix x assume "x  𝔄Obj"
    then show "𝔑NTMapObjMapx  Arr"
      by (cs_concl cs_shallow cs_intro: dg_cs_intros)
  qed
qed


subsubsection‹
Opposite of the composition of a transformation of 
digraph homomorphisms and a digraph homomorphism
›

lemma op_tdghm_tdghm_dghm_comp[dg_op_simps]: 
  "op_tdghm (𝔑 TDGHM-DGHM ) = op_tdghm 𝔑 TDGHM-DGHM op_dghm "
  unfolding 
    tdghm_dghm_comp_def 
    dghm_comp_def 
    op_tdghm_def 
    op_dghm_def 
    op_dg_def
    dg_field_simps
    dghm_field_simps
    nt_field_simps
  by (simp add: nat_omega_simps) (*slow*)


subsubsection‹
Composition of a transformation of digraph homomorphisms and a digraph
homomorphism is a transformation of digraph homomorphisms
›

lemma tdghm_dghm_comp_is_tdghm:
  assumes "𝔑 : 𝔉 DGHM 𝔊 : 𝔅 ↦↦DGα" and " : 𝔄 ↦↦DGα𝔅"
  shows "𝔑 TDGHM-DGHM  : 𝔉 DGHM  DGHM 𝔊 DGHM  : 𝔄 ↦↦DGα"
proof-
  interpret 𝔑: is_tdghm α 𝔅  𝔉 𝔊 𝔑 by (rule assms(1))
  interpret: is_dghm α 𝔄 𝔅  by (rule assms(2))
  show ?thesis
  proof(rule is_tdghmI)
    show "vfsequence (𝔑 TDGHM-DGHM )" unfolding tdghm_dghm_comp_def by simp
    show "vcard (𝔑 TDGHM-DGHM ) = 5"
      unfolding tdghm_dghm_comp_def by (simp add: nat_omega_simps)
    show "(𝔑 TDGHM-DGHM )NTMapa :
      (𝔉 DGHM )ObjMapa (𝔊 DGHM )ObjMapa"
      if "a  𝔄Obj" for a 
      by 
        (
          use that in 
            cs_concl cs_shallow cs_simp: dg_cs_simps cs_intro: dg_cs_intros
        )
  qed (cs_concl cs_simp: dg_cs_simps cs_intro: dg_cs_intros)+
qed

lemma tdghm_dghm_comp_is_tdghm'[dg_cs_intros]:
  assumes "𝔑 : 𝔉 DGHM 𝔊 : 𝔅 ↦↦DGα" 
    and " : 𝔄 ↦↦DGα𝔅"
    and "𝔉' = 𝔉 DGHM "
    and "𝔊' = 𝔊 DGHM "
  shows "𝔑 TDGHM-DGHM  : 𝔉' DGHM 𝔊' : 𝔄 ↦↦DGα"
  using assms(1,2) unfolding assms(3,4) by (rule tdghm_dghm_comp_is_tdghm)


subsubsection‹Further properties›

lemma tdghm_dghm_comp_tdghm_dghm_comp_assoc:
  assumes "𝔑 :  DGHM ℌ' :  ↦↦DGα𝔇" 
    and "𝔊 : 𝔅 ↦↦DGα" 
    and "𝔉 : 𝔄 ↦↦DGα𝔅"
  shows "(𝔑 TDGHM-DGHM 𝔊) TDGHM-DGHM 𝔉 = 𝔑 TDGHM-DGHM (𝔊 DGHM 𝔉)"
proof-
  interpret 𝔑: is_tdghm α  𝔇  ℌ' 𝔑 by (rule assms(1))
  interpret 𝔊: is_dghm α 𝔅  𝔊 by (rule assms(2))
  interpret 𝔉: is_dghm α 𝔄 𝔅 𝔉 by (rule assms(3))
  show ?thesis  
  proof(rule tdghm_eqI)
    from assms show 
      "(𝔑 TDGHM-DGHM 𝔊) TDGHM-DGHM 𝔉 :
         DGHM 𝔊 DGHM 𝔉 DGHM ℌ' DGHM 𝔊 DGHM 𝔉 :
        𝔄 ↦↦DGα𝔇"
      by (cs_concl cs_shallow cs_intro: dg_cs_intros)
    then have dom_lhs: "𝒟 (((𝔑 TDGHM-DGHM 𝔊) TDGHM-DGHM 𝔉)NTMap) = 𝔄Obj"
      by (cs_concl cs_simp: dg_cs_simps)
    show "𝔑 TDGHM-DGHM (𝔊 DGHM 𝔉) :
       DGHM 𝔊 DGHM 𝔉 DGHM ℌ' DGHM 𝔊 DGHM 𝔉 :
      𝔄 ↦↦DGα𝔇"
      by (cs_concl cs_simp: dg_cs_simps cs_intro: dg_cs_intros)
    then have dom_rhs: "𝒟 ((𝔑 TDGHM-DGHM (𝔊 DGHM 𝔉))NTMap) = 𝔄Obj"
      by (cs_concl cs_simp: dg_cs_simps)
    show 
      "((𝔑 TDGHM-DGHM 𝔊) TDGHM-DGHM 𝔉)NTMap = 
        (𝔑 TDGHM-DGHM (𝔊 DGHM 𝔉))NTMap"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
      fix a assume "a  𝔄Obj"
      with assms show 
        "((𝔑 TDGHM-DGHM 𝔊) TDGHM-DGHM 𝔉)NTMapa =
          (𝔑 TDGHM-DGHM (𝔊 DGHM 𝔉))NTMapa"
        by (cs_concl cs_simp: dg_cs_simps cs_intro: dg_cs_intros)
    qed (cs_concl cs_shallow cs_intro: dg_cs_intros)
  qed simp_all
qed

lemma (in is_tdghm) tdghm_tdghm_dghm_comp_dghm_id[dg_cs_simps]:
  "𝔑 TDGHM-DGHM dghm_id 𝔄 = 𝔑"
proof(rule tdghm_eqI)
  show "𝔑 TDGHM-DGHM dghm_id 𝔄 : 𝔉 DGHM 𝔊 : 𝔄 ↦↦DGα𝔅"
    by (cs_concl cs_simp: dg_cs_simps cs_intro: dg_cs_intros)
  show "𝔑 : 𝔉 DGHM 𝔊 : 𝔄 ↦↦DGα𝔅"
    by (cs_concl cs_shallow cs_simp: dg_cs_simps cs_intro: dg_cs_intros)
  have dom_lhs: "𝒟 ((𝔑 TDGHM-DGHM dghm_id 𝔄)NTMap) = 𝔄Obj"
    by (cs_concl cs_simp: dg_cs_simps cs_intro: dg_cs_intros)
  show "(𝔑 TDGHM-DGHM dghm_id 𝔄)NTMap = 𝔑NTMap"
  proof(rule vsv_eqI, unfold dom_lhs dg_cs_simps)
    fix a assume "a  𝔄Obj"
    then show "(𝔑 TDGHM-DGHM dghm_id 𝔄)NTMapa = 𝔑NTMapa"
      by (cs_concl cs_simp: dg_cs_simps cs_intro: dg_cs_intros)
  qed (cs_concl cs_intro: dg_cs_intros V_cs_intros)+
qed simp_all

lemmas [dg_cs_simps] = is_tdghm.tdghm_tdghm_dghm_comp_dghm_id



subsection‹
Composition of a digraph homomorphism and a transformation of
digraph homomorphisms
›


subsubsection‹Definition and elementary properties›

definition dghm_tdghm_comp :: "V  V  V" (infixl DGHM-TDGHM 55)
  where " DGHM-TDGHM 𝔑 =
    [
      (λa𝔑NTDGDomObj. ArrMap𝔑NTMapa),
       DGHM 𝔑NTDom,
       DGHM 𝔑NTCod,
      𝔑NTDGDom,
      HomCod
    ]"


text‹Components.›

lemma dghm_tdghm_comp_components:
  shows "( DGHM-TDGHM 𝔑)NTMap =
    (λa𝔑NTDGDomObj. ArrMap𝔑NTMapa)"
    and [dg_shared_cs_simps, dg_cs_simps]: 
      "( DGHM-TDGHM 𝔑)NTDom =  DGHM 𝔑NTDom"
    and [dg_shared_cs_simps, dg_cs_simps]: 
      "( DGHM-TDGHM 𝔑)NTCod =  DGHM 𝔑NTCod"
    and [dg_shared_cs_simps, dg_cs_simps]: 
      "( DGHM-TDGHM 𝔑)NTDGDom = 𝔑NTDGDom"
    and [dg_shared_cs_simps, dg_cs_simps]: 
      "( DGHM-TDGHM 𝔑)NTDGCod = HomCod"
  unfolding dghm_tdghm_comp_def nt_field_simps 
  by (simp_all add: nat_omega_simps)


subsubsection‹Transformation map›

mk_VLambda dghm_tdghm_comp_components(1)
  |vsv dghm_tdghm_comp_NTMap_vsv[dg_shared_cs_intros, dg_cs_intros]|

mk_VLambda (in is_tdghm) 
  dghm_tdghm_comp_components(1)[where 𝔑=𝔑, unfolded tdghm_NTDGDom]
  |vdomain dghm_tdghm_comp_NTMap_vdomain|
  |app dghm_tdghm_comp_NTMap_app|

lemmas [dg_cs_simps] = 
  is_tdghm.dghm_tdghm_comp_NTMap_vdomain
  is_tdghm.dghm_tdghm_comp_NTMap_app

lemma dghm_tdghm_comp_NTMap_vrange: 
  assumes " : 𝔅 ↦↦DGα" and "𝔑 : 𝔉 DGHM 𝔊 : 𝔄 ↦↦DGα𝔅"
  shows " (( DGHM-TDGHM 𝔑)NTMap)  Arr"
proof-
  interpret: is_dghm α 𝔅   by (rule assms(1))
  interpret 𝔑: is_tdghm α 𝔄 𝔅 𝔉 𝔊 𝔑 by (rule assms(2))
  show ?thesis 
    unfolding dghm_tdghm_comp_components
  proof(rule vrange_VLambda_vsubset, unfold dg_cs_simps)
    fix x assume "x  𝔄Obj"
    then show "ArrMap𝔑NTMapx  Arr"
      by (cs_concl cs_shallow cs_intro: dg_cs_intros)
  qed
qed


subsubsection‹
Opposite of the composition of a digraph homomorphism 
and a transformation of digraph homomorphisms
›

lemma op_tdghm_dghm_tdghm_comp[dg_op_simps]: 
  "op_tdghm ( DGHM-TDGHM 𝔑) = op_dghm  DGHM-TDGHM op_tdghm 𝔑"
  unfolding 
    dghm_tdghm_comp_def
    dghm_comp_def
    op_tdghm_def
    op_dghm_def
    op_dg_def
    dg_field_simps
    dghm_field_simps
    nt_field_simps
  by (simp add: nat_omega_simps) (*slow*)


subsubsection‹
Composition of a digraph homomorphism and a transformation of
digraph homomorphisms is a transformation of digraph homomorphisms
›

lemma dghm_tdghm_comp_is_tdghm:
  assumes " : 𝔅 ↦↦DGα" and "𝔑 : 𝔉 DGHM 𝔊 : 𝔄 ↦↦DGα𝔅"
  shows " DGHM-TDGHM 𝔑 :  DGHM 𝔉 DGHM  DGHM 𝔊 : 𝔄 ↦↦DGα"
proof-
  interpret: is_dghm α 𝔅   by (rule assms(1))
  interpret 𝔑: is_tdghm α 𝔄 𝔅 𝔉 𝔊 𝔑 by (rule assms(2))
  show ?thesis
  proof(rule is_tdghmI)
    show "vfsequence ( DGHM-TDGHM 𝔑)"
      unfolding dghm_tdghm_comp_def by simp
    show "vcard ( DGHM-TDGHM 𝔑) = 5"
      unfolding dghm_tdghm_comp_def  by (simp add: nat_omega_simps)
    show "( DGHM-TDGHM 𝔑)NTMapa : 
      ( DGHM 𝔉)ObjMapa ( DGHM 𝔊)ObjMapa"
      if "a  𝔄Obj" for a 
      by (use that in cs_concl cs_simp: dg_cs_simps cs_intro: dg_cs_intros)
  qed (cs_concl cs_simp: dg_cs_simps cs_intro: dg_cs_intros)+
qed

lemma dghm_tdghm_comp_is_tdghm'[dg_cs_intros]:
  assumes " : 𝔅 ↦↦DGα"
    and "𝔑 : 𝔉 DGHM 𝔊 : 𝔄 ↦↦DGα𝔅"
    and "𝔉' =  DGHM 𝔉"
    and "𝔊' =  DGHM 𝔊"
  shows " DGHM-TDGHM 𝔑 : 𝔉' DGHM 𝔊' : 𝔄 ↦↦DGα"
  using assms(1,2) unfolding assms(3,4) by (rule dghm_tdghm_comp_is_tdghm)


subsubsection‹Further properties›

lemma dghm_comp_dghm_tdghm_comp_assoc:
  assumes "𝔑 :  DGHM ℌ' : 𝔄 ↦↦DGα𝔅"
    and "𝔉 : 𝔅 ↦↦DGα"
    and "𝔊 :  ↦↦DGα𝔇"
  shows "(𝔊 DGHM 𝔉) DGHM-TDGHM 𝔑 = 𝔊 DGHM-TDGHM (𝔉 DGHM-TDGHM 𝔑)"
proof(rule tdghm_eqI)
  interpret 𝔑: is_tdghm α 𝔄 𝔅  ℌ' 𝔑 by (rule assms(1))
  interpret 𝔉: is_dghm α 𝔅  𝔉 by (rule assms(2))
  interpret 𝔊: is_dghm α  𝔇 𝔊 by (rule assms(3))
  from assms show "(𝔊 DGHM 𝔉) DGHM-TDGHM 𝔑 :
    𝔊 DGHM 𝔉 DGHM  DGHM 𝔊 DGHM 𝔉 DGHM ℌ' : 𝔄 ↦↦DGα𝔇"
    by (cs_concl cs_simp: dg_cs_simps cs_intro: dg_cs_intros)
  then have dom_lhs: "𝒟 ((𝔊 DGHM 𝔉 DGHM-TDGHM 𝔑)NTMap) = 𝔄Obj"
    by (cs_concl cs_simp: dg_cs_simps)
  from assms show "𝔊 DGHM-TDGHM (𝔉 DGHM-TDGHM 𝔑) :
    𝔊 DGHM 𝔉 DGHM  DGHM 𝔊 DGHM 𝔉 DGHM ℌ' : 𝔄 ↦↦DGα𝔇"
    by (cs_concl cs_shallow cs_simp: dg_cs_simps cs_intro: dg_cs_intros)
  then have dom_rhs: 
    "𝒟 ((𝔊 DGHM-TDGHM (𝔉 DGHM-TDGHM 𝔑))NTMap) = 𝔄Obj"
    by (cs_concl cs_simp: dg_cs_simps)
  show 
    "((𝔊 DGHM 𝔉) DGHM-TDGHM 𝔑)NTMap = 
      (𝔊 DGHM-TDGHM (𝔉 DGHM-TDGHM 𝔑))NTMap"
  proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
    fix a assume "a  𝔄Obj"
    then show 
      "(𝔊 DGHM 𝔉 DGHM-TDGHM 𝔑)NTMapa =
        (𝔊 DGHM-TDGHM (𝔉 DGHM-TDGHM 𝔑))NTMapa"
      by (cs_concl cs_shallow cs_simp: dg_cs_simps cs_intro: dg_cs_intros)
  qed (cs_concl cs_shallow cs_simp: dg_cs_simps cs_intro: dg_cs_intros)+
qed simp_all

lemma (in is_tdghm) tdghm_dghm_tdghm_comp_dghm_id[dg_cs_simps]:
  "dghm_id 𝔅 DGHM-TDGHM 𝔑 = 𝔑"
proof(rule tdghm_eqI)
  show "dghm_id 𝔅 DGHM-TDGHM 𝔑 : 𝔉 DGHM 𝔊 : 𝔄 ↦↦DGα𝔅"
    by (cs_concl cs_simp: dg_cs_simps cs_intro: dg_cs_intros)
  then have dom_lhs: "𝒟 ((dghm_id 𝔅 DGHM-TDGHM 𝔑)NTMap) = 𝔄Obj"
    by (cs_concl cs_simp: dg_cs_simps)
  show "𝔑 : 𝔉 DGHM 𝔊 : 𝔄 ↦↦DGα𝔅"
    by (cs_concl cs_shallow cs_simp: dg_cs_simps cs_intro: dg_cs_intros)
  show "(dghm_id 𝔅 DGHM-TDGHM 𝔑)NTMap = 𝔑NTMap"
  proof(rule vsv_eqI, unfold dom_lhs dg_cs_simps)
    show "vsv (𝔑NTMap)" by auto
    fix a assume "a  𝔄Obj"
    then show "(dghm_id 𝔅 DGHM-TDGHM 𝔑)NTMapa = 𝔑NTMapa"
      by (cs_concl cs_shallow cs_simp: dg_cs_simps cs_intro: dg_cs_intros)
  qed (cs_concl cs_shallow cs_intro: dg_cs_intros)+
qed simp_all

lemmas [dg_cs_simps] = is_tdghm.tdghm_dghm_tdghm_comp_dghm_id

lemma dghm_tdghm_comp_tdghm_dghm_comp_assoc:
  assumes "𝔑 : 𝔉 DGHM 𝔊 : 𝔅 ↦↦DGα"
    and " :  ↦↦DGα𝔇"
    and "𝔎 : 𝔄 ↦↦DGα𝔅"
  shows "( DGHM-TDGHM 𝔑) TDGHM-DGHM 𝔎 =  DGHM-TDGHM (𝔑 TDGHM-DGHM 𝔎)"
proof-
  interpret 𝔑: is_tdghm α 𝔅  𝔉 𝔊 𝔑 by (rule assms(1))
  interpret: is_dghm α  𝔇  by (rule assms(2))
  interpret 𝔎: is_dghm α 𝔄 𝔅 𝔎 by (rule assms(3))
  show ?thesis
  proof(rule tdghm_eqI)
    from assms have dom_lhs: 
      "𝒟 ((( DGHM-TDGHM 𝔑) TDGHM-DGHM 𝔎)NTMap) = 𝔄Obj"
      by (cs_concl cs_shallow cs_simp: dg_cs_simps)
    from assms have dom_rhs: 
      "𝒟 (( DGHM-TDGHM (𝔑 TDGHM-DGHM 𝔎))NTMap) = 𝔄Obj"
      by (cs_concl cs_shallow cs_simp: dg_cs_simps cs_intro: dg_cs_intros)
    show 
      "(( DGHM-TDGHM 𝔑) TDGHM-DGHM 𝔎)NTMap =
        ( DGHM-TDGHM (𝔑 TDGHM-DGHM 𝔎))NTMap"
    proof(rule vsv_eqI, unfold dom_lhs dom_rhs)
      fix a assume "a  𝔄Obj"
      then show 
        "(( DGHM-TDGHM 𝔑) TDGHM-DGHM 𝔎)NTMapa =
          (( DGHM-TDGHM (𝔑 TDGHM-DGHM 𝔎)))NTMapa"
        by (cs_concl cs_shallow cs_simp: dg_cs_simps cs_intro: dg_cs_intros)
    qed (cs_concl cs_shallow cs_intro: dg_cs_intros)
  qed (cs_concl cs_shallow cs_simp: dg_cs_simps cs_intro: dg_cs_intros)+
qed

text‹\newpage›

end