Theory Hypergraph

(* Theory: Hypergraph
   Author: Chelsea Edmonds *)

section ‹Basic Hypergraphs ›

text ‹Converting Design theory to hypergraph notation. Hypergraphs have technically already
been formalised›

theory Hypergraph
  imports 
    "Design_Theory.Block_Designs" 
    "Design_Theory.Sub_Designs" 
    "Fishers_Inequality.Design_Extras"
begin

lemma is_singleton_image: 
  "is_singleton C ⟹ is_singleton (f ` C)"
  by (metis image_empty image_insert is_singletonE is_singletonI)

lemma bij_betw_singleton_image: 
  assumes "bij_betw f A B"
  assumes "C ⊆ A"
  shows "is_singleton C ⟷ is_singleton (f ` C)"
proof (intro iffI)
  show " is_singleton C ⟹ is_singleton (f ` C)" by (rule is_singleton_image)
  show "is_singleton (f ` C) ⟹ is_singleton C " using assms is_singleton_image
    by (metis bij_betw_def inv_into_image_cancel)
qed

lemma image_singleton: 
  assumes "A ≠ {}"
  assumes "⋀ x. x ∈ A ⟹ f x = c"
  shows "f ` A = {c}"
  using assms(1) assms(2) by blast

type_synonym colour = nat

type_synonym 'a hyp_edge = "'a set"

type_synonym 'a hyp_graph = "('a set) × ('a hyp_edge multiset)"

abbreviation hyp_edges :: "'a hyp_graph ⇒ 'a hyp_edge multiset" where
  "hyp_edges H ≡ snd H"

abbreviation hyp_verts :: "'a hyp_graph ⇒ 'a set" where
  "hyp_verts H ≡ fst H"

locale hypersystem = incidence_system "vertices :: 'a set" "edges :: 'a hyp_edge multiset" 
  for "vertices" (‹𝒱›) and "edges" (‹E›) 

begin

text‹Basic definitions using hypergraph language›

abbreviation horder :: "nat" where
"horder ≡ card (𝒱)"

definition hdegree :: "'a ⇒ nat" where
"hdegree v ≡ size {#e ∈# E . v ∈ e #}"

lemma hdegree_rep_num: "hdegree v = point_replication_number E v"
  unfolding hdegree_def point_replication_number_def by simp

definition hdegree_set :: "'a set ⇒ nat" where
"hdegree_set vs ≡ size {#e ∈# E. vs ⊆ e#}"

lemma hdegree_set_points_index: "hdegree_set vs = points_index E vs"
  unfolding hdegree_set_def points_index_def by simp

definition hvert_adjacent :: "'a ⇒ 'a ⇒ bool" where
"hvert_adjacent v1 v2 ≡ ∃ e . e ∈# E ∧ v1 ∈ e ∧ v2 ∈ e ∧ v1 ∈ 𝒱 ∧ v2 ∈ 𝒱"

definition hedge_adjacent :: "'a hyp_edge ⇒ 'a hyp_edge ⇒ bool" where
"hedge_adjacent e1 e2 ≡ e1 ∩ e2 ≠ {} ∧ e1 ∈# E ∧ e2 ∈# E"

lemma edge_adjacent_alt_def: "e1 ∈# E ⟹ e2 ∈# E ⟹ ∃ x . x ∈ 𝒱 ∧ x ∈ e1 ∧ x ∈ e2 ⟹ 
    hedge_adjacent e1 e2"
  unfolding hedge_adjacent_def by auto

definition hneighborhood :: "'a ⇒ 'a set" where
"hneighborhood x ≡ {v ∈ 𝒱 . hvert_adjacent x v}"

definition hmax_degree :: "nat" where
"hmax_degree ≡ Max {hdegree v | v. v ∈ 𝒱}"

definition hrank :: "nat" where
"hrank ≡ Max {card e | e . e ∈# E}"

definition hcorank :: "nat" where
"hcorank = Min {card e | e . e ∈# E}"

definition hedge_neighbourhood :: "'a ⇒ 'a hyp_edge multiset" where
"hedge_neighbourhood x ≡ {# e ∈# E . x ∈ e #}"

lemma degree_alt_neigbourhood: "hdegree x = size (hedge_neighbourhood x)"
  using hedge_neighbourhood_def by (simp add: hdegree_def) 

definition hinduced_edges:: "'a set ⇒ 'a hyp_edge multiset" where
"hinduced_edges V' = {#e ∈# E . e ⊆ V'#}"

end

text‹Sublocale for rewriting definition purposes rather than inheritance›
sublocale hypersystem ⊆ incidence_system 𝒱 E
  rewrites "point_replication_number E v = hdegree v" and "points_index E vs = hdegree_set vs"
  by (unfold_locales) (simp_all add: hdegree_rep_num hdegree_set_points_index)

text ‹Reverse sublocale to establish equality ›
sublocale incidence_system ⊆ hypersystem 𝒱 ℬ
  rewrites "hdegree v = point_replication_number ℬ v" and "hdegree_set vs = points_index ℬ vs"
proof (unfold_locales)
  interpret hs: hypersystem 𝒱 ℬ by (unfold_locales)
  show "hs.hdegree v = ℬ rep v" using hs.hdegree_rep_num by simp
  show " hs.hdegree_set vs = ℬ index vs" using hs.hdegree_set_points_index by simp
qed

text‹Missing design identified in the design theory hierarchy ›
locale inf_design = incidence_system + 
  assumes blocks_nempty: "bl ∈# ℬ ⟹ bl ≠ {}"

sublocale design ⊆ inf_design
  by unfold_locales (simp add: blocks_nempty)

locale fin_hypersystem = hypersystem + finite_incidence_system 𝒱 E

sublocale finite_incidence_system ⊆ fin_hypersystem 𝒱 ℬ
  by unfold_locales

locale hypergraph = hypersystem + inf_design 𝒱 E

sublocale inf_design ⊆ hypergraph 𝒱 ℬ
  by unfold_locales (simp add: wellformed)

locale fin_hypergraph = hypergraph + fin_hypersystem

sublocale design ⊆ fin_hypergraph 𝒱 ℬ
  by unfold_locales

sublocale fin_hypergraph ⊆ design 𝒱 E
  using blocks_nempty by (unfold_locales) simp

subsection ‹Sub hypergraphs›
text ‹Sub hypergraphs and related concepts (spanning hypergraphs etc)›

locale sub_hypergraph = sub: hypergraph 𝒱H EH + orig: hypergraph "𝒱 :: 'a set" E + 
  sub_set_system 𝒱H EH 𝒱 E for 𝒱H EH 𝒱 E 

locale spanning_hypergraph = sub_hypergraph + 
  assumes "𝒱 = 𝒱H"

lemma spanning_hypergraphI:  "sub_hypergraph VH EH V E ⟹ V = VH ⟹ spanning_hypergraph VH EH V E"
  using spanning_hypergraph_def spanning_hypergraph_axioms_def by blast

context hypergraph
begin

definition is_subhypergraph :: "'a hyp_graph ⇒ bool" where
"is_subhypergraph H ≡ sub_hypergraph (hyp_verts H) (hyp_edges H) 𝒱 E"

lemma is_subhypergraphI: 
  assumes "(hyp_verts H ⊆ 𝒱)"
  assumes "(hyp_edges H ⊆# E)"
  assumes "hypergraph (hyp_verts H) (hyp_edges H)"
  shows "is_subhypergraph H"
  unfolding is_subhypergraph_def 
proof -
  interpret h: hypergraph "hyp_verts H" "hyp_edges H"
    using assms(3) by simp
  show "sub_hypergraph (hyp_verts H) (hyp_edges H) 𝒱 E"
    by (unfold_locales) (simp_all add: assms)
qed

definition hypergraph_decomposition :: "'a hyp_graph multiset ⇒ bool" where
"hypergraph_decomposition S ≡ (∀ h ∈# S . is_subhypergraph  h) ∧ 
  partition_on_mset E {#hyp_edges h . h ∈# S#}"

definition is_spanning_subhypergraph :: "'a hyp_graph ⇒ bool" where
"is_spanning_subhypergraph H ≡ spanning_hypergraph (hyp_verts H) (hyp_edges H) 𝒱 E"

lemma is_spanning_subhypergraphI: "is_subhypergraph H ⟹ (hyp_verts H) = 𝒱 ⟹ 
    is_spanning_subhypergraph H"
  unfolding is_subhypergraph_def is_spanning_subhypergraph_def using spanning_hypergraphI by blast

lemma spanning_subhypergraphI:  "(hyp_verts H) = 𝒱 ⟹ (hyp_edges H) ⊆# E ⟹
  hypergraph (hyp_verts H) (hyp_edges H) ⟹ is_spanning_subhypergraph H"
  using is_spanning_subhypergraphI by (simp add: is_subhypergraphI)

end
end