Quelle  Simplicial.thy

sectionthat

text
  In this section we
  finite sets,  teach
  this development we allow
  theoryPrelim> notions›
›>

theory Simplicial
imports Prelim

begin 'a set ==>⊲›

subsection ‹

text \<open>
  The geometric notions attached to a simplicial complex of main interest to us are hoseeffacets
  (subsets of codimension one), adjacency (sharing a facet in common)ainsjacent
  simplices.
\<close>

subsubsection \<open>Facets\<close>

definitionetrel aset<Rightarrow 'a set \<Rightarrow> bool" (infix \<open>\<lhd\close 60)
  wherey\<hd> x \> \<exists>.  \> y\nd x = insert v y"

lemma facetrelI: "v\notin> y \<> x =insert v y \<Longrightarrowy\hd x"
  using facetrel_def by fast

lemma facetrelI_card: "y \<subseteq> x \<Longrightarrow> card (x-y) = 1 \<Longrightarrow> y  \lhd> x"
  using card1[of "x-y"] by (blast intro: facetrelI)

lemma facetrel_complement_vertex:"\<> \<Longrightarrow> x = insert v y \<Longrightarrow> v\<notin>y"
  using facetrel_def[of ymoreoverassmsvhavex  u y

lemma facetrel_diff_vertex: "v\<in>x \<Longrightarrow  _nv_into_fassms)(centrofacetrelI
  by (auto ntro etrelI

lemma facetrel_conv_insert: "y \<hd> x \Longrightarrow v \<in> x - y \<Longrightarrow    v y"
  unfolding facetrel_def by fast

lemma: " <> x \<Longrightarrow> y \<subset> x"
  unfolding facetrel_def adjacent_def  

lemma facetrel_subset:" \hd> x \<Longrightarrow> y \<subseteq> x"
  using facetrel_psubsetbyfast

lemma facetrel_card: "y \<lhd> x \<Longrightarrow> card (x-y) = 1"
   common_facet "\lbrakk> z\<lhd>x; z<lhdy; x \<noteq> y \<rbrakk> \<Longrightarrow> z = x \<inter> y"

lemma finite_facetrel_card: "finite x \<Longrightarrow> y\<lhd>x \<Longrightarrow> card x = Suc (card y)"
  using facetrel_def[of ]card_insert_disjoint[of]by auto

lemma facetrelI_cardSucz\>\card x = Suc (card z) \<Longrightarrow> z<x"
  using card_ge_0_finite finite_subset[of z] card_Diff_subset]
  by    (force intro: facetrelI_card)

lemma facet2_subset: "\< whave "<>. v\<in>x-y \<Longrightarrow> v=w" by java.lang.StringIndexOutOfBoundsException: Index 64 out of bounds for length 64
  unfolding facetrel_defjava.lang.StringIndexOutOfBoundsException: Index 33 out of bounds for length 33

lemma  this  a1 a2
  assumes "inj_on f x" "z       a2:a2<D" "b = f a2"
  obtains y where ">x" "f`y = z"
proof
  from assms(2) obtain v where v adjacent_to_adjacent_int_subset byjava.lang.StringIndexOutOfBoundsException: Index 47 out of bounds for length 47
using[of   
   u and y  "u <>the_inv_into x fv"dy equiv {v\<in>x. f v \<in> z}"
  moreoverwith sms)havex =  u y"
    he_inv_into_f_eqthe_inv_into_intosms)
    by fastforce
  ultimately show "ubcomplex Y \<equiv> Y <subseteq X \<and> SimplicialComplex Y"
    using v f_the_inv_into_fsms]yforcece trofacetrelIrelI
  fromyassms(2) show "f`y =z  acetrel_subset
qed


subsubsection <>Adjacency\<close>

definition adjacent :: "'a set \<Rightarrow> 'a set 
  where "x \<sim> < \<exists>z. z\<lhd>x \<and> z\<lhd>y"

lemma adjacentI: z<hd> \<Longrightarrow> z\<lhd>y \<Longrightarrow> x \<sim> y"
  using adjacent_def by fast

lemma empty_not_adjacent: "\<not> {} \<sim> x"
  unfolding facetrel_def adjacent_def by fast

ymx<>y \<Longrightarrow> y \<sim> x"
  unfolding adjacent_def by fast

lemma adjacent_refl:
  assumes   usingmaxsimpD_maximal troimplicialComplexI
  howssim x"
proof-
  assmsainwhere"inx" by fast
  thus "x \<sim> x" using facetrelI[of v "v"nfoldingacent_def t
qed

lemma common_facet: "\<lbrakk> z\<lhd>x; z\<lhd>y; x using _ases"uto
  usingjava.lang.StringIndexOutOfBoundsException: Index 3 out of bounds for length 3

adjacent_int_facet1 y \<Longrightarrow> x \<noteq> y \<Longrightarrow>  <inter <>
  using common_facetnfoldingldingdingdjacent_defent_defefyfast

lemma adjacent_int_facet2: "x \<sim
  using adjacent_sym adjacent_int_facet1 by (fastforcesimpdt_commute

lemmaChains of maximal simplices (with espectadjacency owtoalkughmber
using _ty

lemma adjacent_int_decomp:
  "x \<sim> y \<Longrightarrow> x \<noteq> y<Longrightarrow> \<exists>v. v \<notin> y and x = insert v (x\<inter>y)"
  

lemma adj_antivertex:
  assumes "x\<sim>y" x\<noteq"
  shows   "\<exists>!v<>java.lang.StringIndexOutOfBoundsException: Index 34 out of bounds for length 34
proof (rule ex_ex1I)
  lemma_ce:
    using adjacent_int_decomp by fast
  thus exists>v. v\<in>x-y" by auto
 ve<>. v\<in>x-y \<Longrightarrow> v=w" by fast
 Andv v'. v\<in>x-y \<Longrightarrow> v'\<in>x-y\Longrightarrow> vv"auto
qed

lemmat_card< y \<Longrightarrow> card x = card y"
  unfoldingjava.lang.StringIndexOutOfBoundsException: Index 0 out of bounds for length 0

lemmajacent_to_adjacent_int_subset
  assumes  chain_append_reduce1
  `inter> f`D \<subseteq> f`(C\<inter>D)"
proof
  from assms(1,3) obtain erev v<notin> D C nsert \<nter>)"
    jacent_int_decomp
  from assms(2,3) obtain w where w: "w \notin `D" "f`C = insert w (f`C\<inter>f`D)"
    using adjacent_int_decomp[of "f`C"Dyjava.lang.StringIndexOutOfBoundsException: Index 53 out of bounds for length 53
  from w have wusing pis_arg_min_linorderI
  with v assms(1,2) have fv_w: "showsx"
  fix b assume "b )
  from this obtain a1 a2
    where a1: "a1 \<in> C" from)asjava.lang.StringIndexOutOfBoundsException: Index 50 out of bounds for length 50
    and   a2: "
    by    fast
  rom1a22 vea1<otin D \<Longrightarrow> f a2 = w" using fv_w by auto
  with a2(1) w' have "a1 \<in        tforce
wbin f`(C\<inter>D)" by fast
qed

adjacent_to_adjacent_int
  lbrakkC \<sim> D; f`C \<sim> f`D; f`C \<noteq> f`D \<rbrakk> \<Longrightarrow> f`(C\<inter>D) = f`C \<inter
  using adjacent_to_adjacent_int_subsetbyt

subsubsection \<open>Chains of adjacent setsmaxsimpchain_Cons_reduce

abbreviation "adjacentchain  \<equiv> binrelchain adjacent"
abbreviationentchainequiv proper_binrelchain adjacent"

lemmas adjacentchain_Cons_reduce   = binrelchain_Cons_reduce   [of adjacentmin_maxsimpchainD_maxsimpchain
lemmas adjacentchain_obtain_proper = binrelchain_obtain_proper_djacent

lemma adjacentchain_card: "acentchain@<Longrightarrow> cardx ard"
  using adjacent_card by (induct xs arbitrary:  uto


subsection \<open>Locale and basic facts\<close>

locale SimplicialComplex =
  fixes   X :: "'a set set"
  assumes finite_simplices: "\<forall>x\<in>X. finite x"
  and     faces           : "x\<in>X \<Longrightarrow> y<subseteq>x \<Longrightarrow> y\<in>X"

context SimplicialComplex
begin

abbreviation "Subcomplex Y \<equiv> Y \<subseteq> X \ndSimplicialComplex

definition "maxsimp x \<equiv> x\<in>X \<and> (\<forallz\<in>X. x\<subseteq>z \<longrightarrow> z=x)"

definitionusingfinite_maxsimpof`x<inter"-<>f`y"] by fast
  where "adjacentset x = {y\<in>X. x\<sim>y}"

lemmate_simplexinX \<Longrightarrow> finite x"
  using finite_simplices by simp

lemma singleton_simplex: "v\<in>\<moreover ,have    f`y) \<noteq> 0"
  using faces by auto

lemma pmaxsimpchain_map
  using maxsimp_def by auto

lemma 
  using maxsimp_def  pmaxsimpchainD_maxsimp

lemma maxsimpD_maximal: "maxsimp x \<Longrightarrow> haveimplicialComplexchain\turnstile> X) ( f`x # f`y # f\<Turnstile>)
  using maxsimp_defbyauto

lemmas finite_maxsimp = finite_simplexusingimpD_simplex_stmapim

lemma maxsimp_nempty: "X \<noteq> {{}} \<Longrightarrow> maxsimp x \<Longrightarrow> x \<noteq> {}"
  unfolding maxsimp_def byast

lemma maxsimp_vertices: "maxsimp x \<Longrightarrow> x\<subseteq>\<Union>X"
  using maxsimpD_simplex by fast

lemma adjacentsetD_adj < adjacentset x \<Longrightarrow> x\<sim>y"
  using adjacentset_def by fast

lemma max_in_subcomplex:
  "\<lbrakk> Subcomplex Yfixame in PosetComplex P" "b\<subseteq>a"
  using maxsimpD_maximal by stintro:mplicialComplex)

lemma face_im:
  assumes "w \<in> X" "y \<subseteq> f`w"
  defines "u \usingominimals_below_in_posetP]
  shows "y \<in> eudominimals_below_in_eq
  using assms faces[of w


lemma im_faces: "x \< <>X \<Longrightarrow> y \<subseteq> x \<Longrightarrow> y \<in> f \<turnstile> X"
  using faces face_im[from

lemma map_is_simplicial_morph: "SimplicialComplex             subseteq poset_simplex_map P b"
proof
  show "\<forall>x\<in>f\<turnstile>X. finite x" using finite_simplices by fast
  show "\<And>yx<f\<turnstile>X \<Longrightarrow> y\<subseteq>x \<Longrightarrow> y>f\<turnstile>X" using im_faces by fast
qed

lemma vertex_set_int:
  assumes "SimplicialComplex Y"
  shows   
proof
  have "\<And>v. v \<in> \<Union>X \<lemma ordsetmap_smap\lbrakk> a\< in>; a\<^bold>\<le>b \<rbrakk> \<Longrightarrow> smap a \<subseteq ap"
 faces SimplicialComplex.faces[OF assms] by auto
  thus "\<Union>(X\<inter>Y) \<supseteq> \<Union>X \<inter> \<Union>Y" by fast
qed auto

end end (* context SimplicialComplex *)

subsection

text
  Chains of maximal simplices
  complexes. But theremplexeslchain
  of maximal by
  if nolex reources
  chains prechains, andocribe
  weaker notion of properismalex
  itessentiallynct
  @{term
›

context SimplicialComplexjava.lang.StringIndexOutOfBoundsException: Index 14 out of bounds for length 14
begin

definition "maxsimpchain xs ≡ (∀x∈set xs. maxsimp x) ∧ adjacentchain xs"
definition "pmaxsimpchain xs ≡ (∀x∈set xs. maxsimp x) ∧ padjacentchain xs"

function min_maxsimpchain :: "'a set list ==> bool"
  where
    "min_maxsimpchain [] = True"
  | "min_maxsimpchain [x] = maxsimp x"
  | "min_maxsimpchain (x#xs@[y]) =
      (x≠y ∧ is_arg_min length (λzs. maxsimpchain (x#zs@[y])) xs)"
  by (auto, rule list_cases_Cons_snoc)
  termination by (relation "measure length") auto

lemma maxsimpchain_snocI:
  "[ maxsimpchain (xs@[x]); maxsimp y; x∼y ] ==> maxsimpchain (xs@[x,y])"
  using maxsimpchain_def binrelchain_snoc maxsimpchain_def by auto

lemma maxsimpchainD_maxsimp:
  "maxsimpchain xs ==> x ∈ set xs ==> maxsimp x"
  using maxsimpchain_def by fast

lemma maxsimpchainD_adj: "maxsimpchain xs ==> adjacentchain xs"
  using maxsimpchain_def by fast

lemma maxsimpchain_CConsI:
  "[ maxsimp w; maxsimpchain (x#xs); w∼x ] ==> maxsimpchain (w#x#xs)"
  using maxsimpchain_def by auto

lemma maxsimpchain_Cons_reduce:
  "maxsimpchain (x#xs) ==> maxsimpchain xs"
  using     adjacentchain_Cons_reduce maxsimpchain_def by fastforce

lemma maxsimpchain_append_reduce1:
  "maxsimpchain (xs@ys) ==> maxsimpchain xs"
  using binrelchain_append_reduce1 maxsimpchain_def by auto

lemma maxsimpchain_append_reduce2:
  "maxsimpchain (xs@ys) ==> maxsimpchain ys"
  using binrelchain_append_reduce2 maxsimpchain_def by auto

lemma maxsimpchain_remdup_adj:
  "maxsimpchain (xs@[x,x]@ys) ==> maxsimpchain (xs@[x]@ys)"
  using maxsimpchain_def binrelchain_remdup_adj by auto

lemma maxsimpchain_rev: "maxsimpchain xs ==> maxsimpchain (rev xs)"
  using     maxsimpchainD_maxsimp adjacent_sym
            binrelchain_sym_rev[of adjacent]
  unfolding maxsimpchain_def
  by        fastforce

lemma maxsimpchain_overlap_join:
  "maxsimpchain (xs@[w]) ==> maxsimpchain (w#ys) ==>
    maxsimpchain (xs@w#ys)"
  using binrelchain_overlap_join maxsimpchain_def by auto

lemma pmaxsimpchain: "pmaxsimpchain xs ==> maxsimpchain xs"
  using maxsimpchain_def pmaxsimpchain_def by fast

lemma pmaxsimpchainI_maxsimpchain:
  "maxsimpchain xs ==> distinct xs ==> pmaxsimpchain xs"
  using maxsimpchain_def pmaxsimpchain_def by fast

lemma pmaxsimpchain_CConsI:
  "[ maxsimp w; pmaxsimpchain (x#xs); w∼x; w ∉ set (x#xs) ] ==>
    pmaxsimpchain (w#x#xs)"
  using pmaxsimpchain_def by auto

lemmas pmaxsimpchainD_maxsimp =
  maxsimpchainD_maxsimp[OF pmaxsimpchain]
lemmas pmaxsimpchainD_adj =
  maxsimpchainD_adj [OF pmaxsimpchain]

lemma pmaxsimpchainD_distinct: "pmaxsimpchain xs ==> distinct xs"
  using pmaxsimpchain_def by fast

lemma pmaxsimpchain_Cons_reduce:
  "pmaxsimpchain (x#xs) ==> pmaxsimpchain xs"
  using maxsimpchain_Cons_reduce pmaxsimpchain pmaxsimpchainD_distinct
  by    (fastforce intro: pmaxsimpchainI_maxsimpchain)

lemma pmaxsimpchain_append_reduce1:
  "pmaxsimpchain (xs@ys) ==> pmaxsimpchain xs"
  using maxsimpchain_append_reduce1 pmaxsimpchain pmaxsimpchainD_distinct
  by    (fastforce intro: pmaxsimpchainI_maxsimpchain)

lemma maxsimpchain_obtain_pmaxsimpchain:
  assumes "x≠y" "maxsimpchain (x#xs@[y])"
  shows   "∃ys. set ys ⊆ set xs ∧ length ys ≤ length xs ∧
            pmaxsimpchain (x#ys@[y])"
proof-
  obtain ys
    where ys: "set ys ⊆ set xs" "length ys ≤ length xs" "padjacentchain (x#ys@[y])"
    using maxsimpchainD_adj[OF assms(2)]
          adjacentchain_obtain_proper[OF assms(1)]
    by    auto
  from ys(1) assms(2) have "∀a∈set (x#ys@[y]). maxsimp a"
    using maxsimpchainD_maxsimp by auto
  with ys show ?thesis unfolding pmaxsimpchain_def by auto
qed

lemma min_maxsimpchainD_maxsimpchain:
  assumes "min_maxsimpchain xs"
  shows   "maxsimpchain xs"
proof (cases xs rule: list_cases_Cons_snoc)
  case Nil thus ?thesis using maxsimpchain_def by simp
next
  case Single with assms show ?thesis using maxsimpchain_def by simp
next
  case Cons_snoc with assms show ?thesis using is_arg_minD1 by fastforce
qed

lemma min_maxsimpchainD_min_betw:
  "min_maxsimpchain (x#xs@[y]) ==> maxsimpchain (x#ys@[y]) ==>
    length ys ≥ length xs"
  using is_arg_minD2 by fastforce

lemma min_maxsimpchainI_betw:
  assumes "x≠y" "maxsimpchain (x#xs@[y])"
          "∧ys. maxsimpchain (x#ys@[y]) ==> length xs ≤ length ys"
  shows   "min_maxsimpchain (x#xs@[y])"
  using   assms by (simp add: is_arg_min_linorderI)

lemma min_maxsimpchainI_betw_compare:
  assumes "x≠y" "maxsimpchain (x#xs@[y])"
          "min_maxsimpchain (x#ys@[y])" "length xs = length ys"
  shows   "min_maxsimpchain (x#xs@[y])"
  using   assms min_maxsimpchainD_min_betw min_maxsimpchainI_betw
  by      auto

lemma min_maxsimpchain_pmaxsimpchain:
  assumes "min_maxsimpchain xs"
  shows   "pmaxsimpchain xs"
proof (
  rule pmaxsimpchainI_maxsimpchain, rule min_maxsimpchainD_maxsimpchain,
  rule assms, cases xs rule: list_cases_Cons_snoc
)
  case (Cons_snoc x ys y)
  have "¬ distinct (x#ys@[y]) ==> False"
  proof (cases "x∈set ys" "y∈set ys" rule: two_cases)
    case both
    from both(1) obtain as bs where "ys = as@x#bs"
      using in_set_conv_decomp[of x ys] by fast
    with assms Cons_snoc show False
      using min_maxsimpchainD_maxsimpchain[OF assms]
            maxsimpchain_append_reduce2[of "x#as"]
            min_maxsimpchainD_min_betw[of x ys y]
      by    fastforce
  next
    case one
    from one(1) obtain as bs where "ys = as@x#bs"
      using in_set_conv_decomp[of x ys] by fast
    with assms Cons_snoc show False
      using min_maxsimpchainD_maxsimpchain[OF assms]
            maxsimpchain_append_reduce2[of "x#as"]
            min_maxsimpchainD_min_betw[of x ys y]
      by    fastforce
  next
    case other
    from other(2) obtain as bs where "ys = as@y#bs"
      using in_set_conv_decomp[of y ys] by fast
    with assms Cons_snoc show False
      using min_maxsimpchainD_maxsimpchain[OF assms]
            maxsimpchain_append_reduce1[of "x#as@[y]"]
            min_maxsimpchainD_min_betw[of x ys y]
      by    fastforce
  next
    case neither
    moreover assume "¬ distinct (x # ys @ [y])"
    ultimately obtain as a bs cs where "ys = as@[a]@bs@[a]@cs"
      using assms Cons_snoc not_distinct_decomp[of ys] by auto
    with assms Cons_snoc show False
      using min_maxsimpchainD_maxsimpchain[OF assms]
            maxsimpchain_append_reduce1[of "x#as@[a]"]
            maxsimpchain_append_reduce2[of "x#as@[a]@bs" "a#cs@[y]"]
            maxsimpchain_overlap_join[of "x#as" a "cs@[y]"]
            min_maxsimpchainD_min_betw[of x ys y "as@a#cs"]
      by    auto
  qed
  with Cons_snoc show "distinct xs" by fast
qed auto

lemma min_maxsimpchain_rev:
  assumes "min_maxsimpchain xs"
  shows   "min_maxsimpchain (rev xs)"
proof (cases xs rule: list_cases_Cons_snoc)
  case Single with assms show ?thesis
    using min_maxsimpchainD_maxsimpchain maxsimpchainD_maxsimp by simp
next
  case (Cons_snoc x ys y)
  moreover have "min_maxsimpchain (y # rev ys @ [x])"
  proof (rule min_maxsimpchainI_betw)
    from Cons_snoc assms show "y≠x"
      using min_maxsimpchain_pmaxsimpchain pmaxsimpchainD_distinct by auto
    from Cons_snoc show "maxsimpchain (y # rev ys @ [x])"
      using min_maxsimpchainD_maxsimpchain[OF assms] maxsimpchain_rev
      by    fastforce
    from Cons_snoc assms
      show  "∧zs. maxsimpchain (y#zs@[x]) ==> length (rev ys) ≤ length zs"
      using maxsimpchain_rev min_maxsimpchainD_min_betw[of x ys y]
      by    fastforce
  qed
  ultimately show ?thesis by simp
qed simp

lemma min_maxsimpchain_adj:
  "[ maxsimp x; maxsimp y; x∼y; x≠y ] ==> min_maxsimpchain [x,y]"
  using maxsimpchain_def min_maxsimpchainI_betw[of x y "[]"] by simp

lemma min_maxsimpchain_betw_CCons_reduce:
  assumes "min_maxsimpchain (w#x#ys@[z])"
  shows   "min_maxsimpchain (x#ys@[z])"
proof (rule min_maxsimpchainI_betw)
  from assms show "x≠z"
    using min_maxsimpchain_pmaxsimpchain pmaxsimpchainD_distinct
    by    fastforce
  show "maxsimpchain (x#ys@[z])" 
    using min_maxsimpchainD_maxsimpchain[OF assms]
          maxsimpchain_Cons_reduce
    by    fast
next
 fix zs assume "maxsimpchain (x#zs@[z])"
  hence "maxsimpchain (w#x#zs@[z])"
    using min_maxsimpchainD_maxsimpchain[OF assms] maxsimpchain_def
    by    fastforce
  with assms show "length ys ≤ length zs"
    using min_maxsimpchainD_min_betw[of w "x#ys" z "x#zs"] by simp
qed

lemma min_maxsimpchain_betw_uniform_length:
  assumes "min_maxsimpchain (x#xs@[y])" "min_maxsimpchain (x#ys@[y])"
  shows   "length xs = length ys"
  using   min_maxsimpchainD_min_betw[OF assms(1)]
          min_maxsimpchainD_min_betw[OF assms(2)]
          min_maxsimpchainD_maxsimpchain[OF assms(1)]
          min_maxsimpchainD_maxsimpchain[OF assms(2)]
  by      fastforce

lemma not_min_maxsimpchainI_betw:
  "[ maxsimpchain (x#ys@[y]); length ys < length xs ] ==>
    ¬ min_maxsimpchain (x#xs@[y])"
  using min_maxsimpchainD_min_betw not_less by blast

lemma maxsimpchain_in_subcomplex:
  "[ Subcomplex Y; set ys ⊆ Y; maxsimpchain ys ] ==>
    SimplicialComplex.maxsimpchain Y ys"
  using maxsimpchain_def max_in_subcomplex
        SimplicialComplex.maxsimpchain_def
  by    force

end (* context SimplicialComplex *)

subsection ‹Isomorphisms of simplicial complexes›

text \<open>
  Here we develop the concept of isomorphism of simplicial complexes. Note that we have not
  bothered to first develop the concept of morphism of simplicial complexes, since every function
  on the vertex set of a simplicial complex can be considered a morphism of complexes (see lemma
  \<open>map_is_simplicial_morph\<close> above).
\<close>

locale SimplicialComplexIsomorphism = SimplicialComplex X
  for X :: "'a set set"
+ fixes f :: "'a \<Rightarrow> 'b"
  assumes inj: "inj_on f (\<Union>X)"
begin

lemmas morph = map_is_simplicial_morph[of f]

lemma iso_codim_map:
  "x \<in> X \<Longrightarrow> y \<in> X \<Longrightarrow> card (f`x - f`y) = card (x-y)"
  using inj inj_on_image_set_diff[of f _ x y] finite_simplex inj_on_subset[of f _ "x-y"]
        inj_on_iff_eq_card[of "x-y"]
  by    fastforce

lemma maxsimp_im_max: "maxsimp x \<Longrightarrow> w \<in> X \<Longrightarrow> f`x \<subseteq> f`w \<Longrightarrow> f`w = f`x"
  using maxsimpD_simplex inj_onD[OF inj] maxsimpD_maximal[of x w] by blast

lemma maxsimp_map:
  "maxsimp x \<Longrightarrow> SimplicialComplex.maxsimp (f\<turnstile>X) (f`x)"
  using maxsimpD_simplex maxsimp_im_max morph
        SimplicialComplex.maxsimpI[of "f\<turnstile>X" "f`x"]
  by    fastforce

lemma iso_adj_int_im:
  assumes "maxsimp x" "maxsimp y" "x\<sim>y" "x\<noteq>y"
  shows "(f`x \<inter> f`y) \<lhd> f`x"
proof (rule facetrelI_card)
  from assms(1,2) have  1: "f ` x \<subseteq> f ` y \<Longrightarrow> f ` y = f ` x"
    using maxsimp_map SimplicialComplex.maxsimpD_simplex[OF morph]
          SimplicialComplex.maxsimpD_maximal[OF morph]
    by    simp
  thus "f`x \<inter> f`y \<subseteq> f`x" by fast

  from assms(1) have "card (f`x - f`x \<inter> f`y) \<le> card (f`x - f`(x\<inter>y))"
    using finite_maxsimp card_mono[of "f`x - f`(x\<inter>y)" "f`x - f`x \<inter> f`y"] by fast
  moreover from assms(1,3,4) have "card (f`x - f`(x\<inter>y)) = 1"
    using maxsimpD_simplex faces[of x] maxsimpD_simplex
          iso_codim_map adjacent_int_facet1[of x y] facetrel_card
    by    fastforce
  ultimately have "card (f`x - f`x \<inter> f`y) \<le> 1" by simp
  moreover from assms(1,2,4) have "card (f`x - f`x \<inter> f`y) \<noteq> 0"
    using 1 maxsimpD_simplex finite_maxsimp
          inj_onD[OF induced_pow_fun_inj_on, OF inj, of x y]
    by    auto
  ultimately show "card (f`x - f`x \<inter> f`y) = 1" by simp
qed

lemma iso_adj_map:
  assumes "maxsimp x" "maxsimp y" "x\<sim>y" "x\<noteq>y"
  shows   "f`x \<sim> f`y"
  using assms(3,4) iso_adj_int_im[OF assms] adjacent_sym
        iso_adj_int_im[OF assms(2) assms(1)]
  by    (auto simp add: Int_commute intro: adjacentI)

lemma pmaxsimpchain_map:
  "pmaxsimpchain xs \<Longrightarrow> SimplicialComplex.pmaxsimpchain (f\<turnstile>X) (f\<Turnstile>xs)"
proof (induct xs rule: list_induct_CCons)
  case Nil show ?case
    using map_is_simplicial_morph SimplicialComplex.pmaxsimpchain_def
    by    fastforce
next
  case (Single x) thus ?case
    using map_is_simplicial_morph pmaxsimpchainD_maxsimp maxsimp_map
          SimplicialComplex.pmaxsimpchain_def
    by    fastforce
next
  case (CCons x y xs)
  have "SimplicialComplex.pmaxsimpchain (f \<turnstile> X) ( f`x # f`y # f\<Turnstile>xs)"
  proof (
    rule SimplicialComplex.pmaxsimpchain_CConsI,
    rule map_is_simplicial_morph
  )
    from CCons(2) show "SimplicialComplex.maxsimp (f\<turnstile>X) (f`x)"
      using pmaxsimpchainD_maxsimp maxsimp_map by simp
    from CCons show "SimplicialComplex.pmaxsimpchain (f\<turnstile>X) (f`y # f\<Turnstile>xs)"
      using pmaxsimpchain_Cons_reduce by simp
    from CCons(2) show "f`x \<sim> f`y"
      using pmaxsimpchain_def iso_adj_map by simp
    from inj CCons(2) have "distinct (f\<Turnstile>(x#y#xs))"
      using     maxsimpD_simplex inj_on_distinct_setlistmapim
      unfolding pmaxsimpchain_def
      by        blast
    thus "f`x \<notin> set (f`y # f\<Turnstile>xs)" by simp
  qed
  thus ?case by simp
qed

end (* context SimplicialComplexIsomorphism *)

subsection ‹The complex associated to a poset›

text ‹
 A simplicial complex is naturally a poset under the subset relation. The following develops the
 reverse direction: constructing a simplicial complex from a suitable poset.
 ›

context ordering
begin

definition PosetComplex :: "'a set ==> 'a set set"
  where "PosetComplex P ≡ (∪x∈P. { {y. pseudominimal_in (P.\<le>x) y} })"

lemma poset_is_SimplicialComplex:
  assumes "∀x∈P. simplex_like (P.\<le>x)"
  shows   "SimplicialComplex (PosetComplex P)"
proof (rule SimplicialComplex.intro, rule ballI)
  fix a assume "a ∈ PosetComplex P"
  from this obtain x where "x∈P" "a = {y. pseudominimal_in (P.\<le>x) y}"
    unfolding PosetComplex_def by fast
  with assms show "finite a"
    using pseudominimal_inD1 simplex_likeD_finite finite_subset[of a "P.\<le>x"] by fast
next
  fix a b assume ab: "a ∈ PosetComplex P" "b⊆a"
  from ab(1) obtain x where x: "x∈P" "a = {y. pseudominimal_in (P.\<le>x) y}"
    unfolding PosetComplex_def by fast
  from assms x(1) obtain f and A::"nat set"
    where fA: "OrderingSetIso less_eq less (⊆) (⊂) (P.\<le>x) f"
              "f`(P.\<le>x) = Pow A"
    using simplex_likeD_iso[of "P.\<le>x"]
    by    auto
  define x' where x': "x' ≡ the_inv_into (P.\<le>x) f (∪(f`b))"
  from fA x(2) ab(2) x' have x'_P: "x'∈P"
    using collect_pseudominimals_below_in_poset[of P x f] by simp
  moreover from x fA ab(2) x' have "b = {y. pseudominimal_in (P.\<le>x') y}"
    using collect_pseudominimals_below_in_eq[of x P f] by simp
  ultimately show "b ∈ PosetComplex P" unfolding PosetComplex_def by fast
qed

definition poset_simplex_map :: "'a set ==> 'a ==> 'a set"
  where "poset_simplex_map P x = {y. pseudominimal_in (P.\<le>x) y}"

lemma poset_to_PosetComplex_OrderingSetMap:
  assumes "∧x. x∈P ==> simplex_like (P.\<le>x)"
  shows   "OrderingSetMap (\<le>) (<) (⊆) (⊂) P (poset_simplex_map P)"
proof
  from assms
    show  "∧a b. [ a∈P; b∈P; a\<le>b ] ==>
            poset_simplex_map P a ⊆ poset_simplex_map P b"
    using     simplex_like_has_bottom pseudominimal_in_below_in
    unfolding poset_simplex_map_def
    by        fast
qed

end (* context ordering *)

text ‹
 When a poset affords a simplicial complex, there is a natural morphism of posets from the
 source poset into the poset of sets in the complex, as above. However, some further assumptions
 are necessary to ensure that this morphism is an isomorphism. These conditions are collected in
 the following locale.
 ›

locale ComplexLikePoset = ordering less_eq less
  for less_eq  :: "'a==>'a==>bool" (infix ‹\≤›  50)
  and less     :: "'a==>'a==>bool" (infix ‹<›  50)
+ fixes   P :: "'a set"
  assumes below_in_P_simplex_like: "x∈P ==> simplex_like (P.\<le>x)"
  and     P_has_bottom           : "has_bottom P"
  and     P_has_glbs             : "x∈P ==> y∈P ==> ∃b. glbound_in_of P x y b"
begin

abbreviation "smap ≡ poset_simplex_map P"

lemma smap_onto_PosetComplex: "smap ` P = PosetComplex P"
  using poset_simplex_map_def PosetComplex_def by auto

lemma ordsetmap_smap: "[ a∈P; b∈P; a\<le>b ] ==> smap a ⊆ smap b"
  using OrderingSetMap.ordsetmap[
          OF poset_to_PosetComplex_OrderingSetMap, OF below_in_P_simplex_like
        ]
        poset_simplex_map_def
  by    simp

lemma inj_on_smap: "inj_on smap P"
proof (rule inj_onI)
  fix x y assume xy: "x∈P" "y∈P" "smap x = smap y"
  show "x = y"
  proof (cases "smap x = {}")
    case True with xy show ?thesis
      using poset_simplex_map_def below_in_P_simplex_like P_has_bottom
            simplex_like_no_pseudominimal_in_below_in_imp_singleton[of x P]
            simplex_like_no_pseudominimal_in_below_in_imp_singleton[of y P]
            below_in_singleton_is_bottom[of P x] below_in_singleton_is_bottom[of P y]
      by    auto
  next
    case False
    from this obtain z where "z ∈ smap x" by fast
    with xy(3) have z1: "z ∈ P.\<le>x" "z ∈ P.\<le>y"
      using pseudominimal_inD1 poset_simplex_map_def by auto
    hence "lbound_of x y z" by (auto intro: lbound_ofI)
    with z1(1) obtain b where b: "glbound_in_of P x y b"
      using xy(1,2) P_has_glbs by fast
    moreover have "b ∈ P.\<le>x" "b ∈ P.\<le>y"
      using glbound_in_ofD_in[OF b] glbound_in_of_less_eq1[OF b]
            glbound_in_of_less_eq2[OF b]
      by    auto
    ultimately show ?thesis
      using     xy below_in_P_simplex_like 
                pseudominimal_in_below_in_less_eq_glbound[of P x _ y b]
                simplex_like_below_in_above_pseudominimal_is_top[of x P]
                simplex_like_below_in_above_pseudominimal_is_top[of y P]
      unfolding poset_simplex_map_def
      by        force
  qed
qed

lemma OrderingSetIso_smap:
  "OrderingSetIso (\<le>) (<) (⊆) (⊂) P smap"
proof (rule OrderingSetMap.isoI)
  show "OrderingSetMap (\<le>) (<) (⊆) (⊂) P smap"
    using poset_simplex_map_def below_in_P_simplex_like
          poset_to_PosetComplex_OrderingSetMap
    by    simp
next
  fix x y assume xy: "x∈P" "y∈P" "smap x ⊆ smap y"
  from xy(2) have "simplex_like (P.\<le>y)" using below_in_P_simplex_like by fast
  from this obtain g and A::"nat set"
    where "OrderingSetIso (\<le>) (<) (⊆) (⊂) (P.\<le>y) g"
          "g`(P.\<le>y) = Pow A"
    using simplex_likeD_iso[of "P.\<le>y"]
    by    auto
  with xy show "x\<le>y"
    using poset_simplex_map_def collect_pseudominimals_below_in_eq[of y P g]
          collect_pseudominimals_below_in_poset[of P y g]
          inj_onD[OF inj_on_smap, of "the_inv_into (P.\<le>y) g (∪(g ` smap x))" x]
          collect_pseudominimals_below_in_less_eq_top[of P y g A "smap x"]
    by    simp
qed (rule inj_on_smap)

lemmas rev_ordsetmap_smap =
  OrderingSetIso.rev_ordsetmap[OF OrderingSetIso_smap]

end (* context ComplexLikePoset *)

end (* theory *)