From 252ab260edf08b525bc41afc4fcdab4d040be1df Mon Sep 17 00:00:00 2001 From: Jakob Zimmermann Date: Tue, 10 Dec 2024 09:58:17 +0100 Subject: [PATCH 01/26] first attempt for proving sperner theorem --- TheBook/SpernerProof.lean | 1307 +++++++++++++++++++++++++++++++++++++ 1 file changed, 1307 insertions(+) create mode 100644 TheBook/SpernerProof.lean diff --git a/TheBook/SpernerProof.lean b/TheBook/SpernerProof.lean new file mode 100644 index 0000000..8d49473 --- /dev/null +++ b/TheBook/SpernerProof.lean @@ -0,0 +1,1307 @@ +/- +Copyright 2022 Google LLC + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + https://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. + +Authors: Moritz Firsching, Jakob Zimmermann +-/ +import Mathlib.Tactic +import Mathlib.Combinatorics.Enumerative.DoubleCounting +import Mathlib.Combinatorics.Derangements.Finite +import Mathlib.Logic.Equiv.Defs +import Mathlib.Data.Set.Basic +import FormalBook.Chapter_28 + +/-! +# Three famous lemmas on finite sets + +## TODO + - **Sperners Theorem** + - Add the proofs of equivalences + - Adapt variable names and proof style + - **Erd\{o}s Ko Rado** + - Add statement and proof + - **Halls Theorem** + - Add statement and proof +-/ + +namespace chapter30 + +open Function Nat Set + +/- + Definition of the basic structures +-/ + +structure TopDownChain (n : ℕ) where + X : Finset (Finset (Fin n)) + chain : IsChain (· ⊆ ·) X.toSet + top_down : Fintype.card X = n + 1 + +example : TopDownChain 0 := { + X := {∅}, + chain := by + intros x hx y hy xnegy + simp at hx hy + simp [hx, hy] at xnegy + top_down := by simp +} + +structure TopDownChainThrough (n : ℕ) (a : Finset (Fin n)) where + top_down_chain : TopDownChain n + through : a ∈ top_down_chain.X + +structure TopDownChainSplitThrough (n : ℕ) (a : Finset (Fin n)) where + bottom_chain : TopDownChain (Finset.card a) + top_chain : TopDownChain (n - Finset.card a) + +instance (n : ℕ) : DecidableEq (TopDownChain n) := + fun a b => + if h_eq : a.X = b.X then + isTrue (by + obtain ⟨aX, achain, atop_down⟩ := a + obtain ⟨bX, bchain, btop_down⟩ := b + simp + exact h_eq) + else + isFalse (fun h => h_eq (congrArg (·.X) h)) + +instance {n : ℕ} (a : Finset (Fin n)) : DecidableEq (TopDownChainThrough n a) := + fun C₁ C₂ => + if h_eq : C₁.top_down_chain.X = C₂.top_down_chain.X then + isTrue (by + obtain ⟨⟨a₁, b₁, c₁⟩, through₁⟩ := C₁ + obtain ⟨⟨a₂, b₂, c₂⟩, through₂⟩ := C₂ + simp + exact h_eq) + else + isFalse (fun h => h_eq (congrArg (·.top_down_chain.X) h)) + +instance (n : ℕ) (a : Finset (Fin n)) : DecidableEq (TopDownChainSplitThrough n a) := + fun C₁ C₂ => + if h_eq : C₁.bottom_chain.X = C₂.bottom_chain.X ∧ C₁.top_chain.X = C₂.top_chain.X then + isTrue (by + obtain ⟨⟨a₁₁, b₁₁, c₁₁⟩, ⟨a₁₂, b₁₂, c₁₂⟩⟩ := C₁ + obtain ⟨⟨a₂₁, b₂₁, c₂₁⟩, ⟨a₂₂, b₂₂, c₂₂⟩⟩ := C₂ + simp + exact h_eq) + else + isFalse (fun h => + have h' : C₁.bottom_chain.X = C₂.bottom_chain.X ∧ C₁.top_chain.X = C₂.top_chain.X := by rw [h]; exact ⟨rfl, rfl⟩ + h_eq h') + +/- + Equivalence between **TopDownChain** n and **Equiv.Perm (Fin n)** +-/ + +def permutation_to_edge {n : ℕ} (k : Fin (n + 1)) (π : Equiv.Perm (Fin n)) : Finset (Fin n) := + Finset.image (fun (j : Fin k) => π ⟨j, Nat.lt_of_lt_of_le j.isLt (Nat.le_of_lt_succ k.isLt)⟩) (Finset.univ : Finset (Fin k)) + +lemma permutation_to_edge_cardinality {n : ℕ} (π : Equiv.Perm (Fin n)) : ∀ k : Fin (n + 1), Finset.card (permutation_to_edge k π) = k := by + intro k + simp [permutation_to_edge] + rw [Finset.card_image_of_injective] + · simp + · rw [Injective] + intro a₁ a₂ h₁ + apply Fin.eq_of_val_eq + injection (Equiv.injective π) h₁ + +def permutation_to_chain {n : ℕ} (π : Equiv.Perm (Fin n)) : Finset (Finset (Fin n)) := + Finset.image (fun (j : Fin (n + 1)) => permutation_to_edge j π) (Finset.univ : Finset (Fin (n + 1))) + +lemma subset_from_permutation_injective {n : ℕ} {π : Equiv.Perm (Fin n)} : Injective (fun (k : Fin (n + 1)) => permutation_to_edge k π) := by + rw [Injective] + intro a₁ a₂ h + have : a₁.val = a₂.val := by + rw [←((permutation_to_edge_cardinality π) a₁), ←((permutation_to_edge_cardinality π) a₂), h] + exact Fin.eq_of_val_eq this + +def permutation_to_top_down_chain (n : ℕ) (π : Equiv.Perm (Fin n)) : TopDownChain n := { + X := permutation_to_chain π, + chain := by + intros x₁ hx₁ x₂ hx₂ _ + simp [permutation_to_chain, permutation_to_edge] at hx₁ hx₂ + rcases hx₁ with ⟨k₁, hk₁⟩ + rcases hx₂ with ⟨k₂, hk₂⟩ + simp [←hk₁, ←hk₂] + cases Nat.lt_or_ge k₁ k₂ with + | inl k₁ltk₂ => + left + intros y hy + simp only [Finset.mem_image] at hy + obtain ⟨x, _, hx2⟩ := hy + rw [←hx2] + simp only [Finset.mem_image] + use ⟨x.val, Nat.lt_trans x.isLt k₁ltk₂⟩ + simp + | inr k₁gek₂ => + right + intros y hy + simp only [Finset.mem_image] at hy + obtain ⟨x, _, hx2⟩ := hy + rw [←hx2] + simp only [Finset.mem_image] + use ⟨x.val, Nat.lt_of_lt_of_le x.isLt k₁gek₂⟩ + simp + top_down := by + simp + rw [permutation_to_chain] + rw [Finset.card_image_of_injective] + · simp + · exact subset_from_permutation_injective +} + +/- + A helping lemma based on the *piegon hole principle* in order to prove the existence of an edge for a given cardinality. Observe that the injectivity of edge_by_cardinality is easily verified +-/ +lemma finset_exists_duplicate_image {α : Type*} [Fintype α] [DecidableEq α] (f : α → α) (b : α) (h : ∀ a ∈ (Finset.univ : Finset α), f a ≠ b) : + ∃ x ∈ (Finset.univ : Finset α), ∃ y ∈ (Finset.univ : Finset α), x ≠ y ∧ f x = f y := by + let g : α → (Finset.erase (Finset.univ : Finset α) b) := fun a => ⟨f a, Finset.mem_erase.mpr ⟨h a (Finset.mem_univ a), Finset.mem_univ (f a)⟩⟩ + have imagesmaller : Fintype.card (Finset.erase (Finset.univ : Finset α) b) < Fintype.card α := by + have : ((Finset.univ : Finset α).erase b).card < (Finset.univ : Finset α).card := by + rw [Finset.card_erase_of_mem (Finset.mem_univ b)] + exact Nat.sub_lt (Finset.card_pos.mpr ⟨b, by simp⟩) (Nat.one_pos) + simp [this] + exact (Finset.card_pos.mpr ⟨b, by simp⟩) + obtain ⟨x, y, xneqy, hg⟩ := (Fintype.exists_ne_map_eq_of_card_lt g imagesmaller) + have : f x = f y := by + have hgx : f x = ↑(g x) := by rfl + have hgy : f y = ↑(g y) := by rfl + rw [hgx, hgy] + rw [hg] + exact ⟨x, Finset.mem_univ x, y, Finset.mem_univ y, xneqy, this⟩ + +/- + In order to construct a permutation from a TopDownChain we need to have access to chain elements given their cardinality +-/ +lemma edge_cardinality_upperbound {m : ℕ} (e : Finset (Fin m)): Finset.card (e) ≤ m := by + have edge_inclusion : e ⊆ Finset.univ := Finset.subset_univ e + have h_univ_card : m = (Finset.univ : Finset (Fin m)).card := by + simp [Finset.card_univ] + have := Finset.card_le_card edge_inclusion + rw [←h_univ_card] at this + exact this + +lemma card_not_twice {n : ℕ} (C : TopDownChain n) : ∀ e₁ ∈ C.X, ∀ e₂ ∈ C.X, Finset.card e₁ = Finset.card e₂ → e₁ = e₂ := by + intro e₁ he₁ e₂ he₂ h + by_contra hna + cases ((C.chain he₁ he₂) hna) with + | inl e₁sube₂ => + simp at e₁sube₂ + have : e₁ ⊂ e₂ := Finset.ssubset_iff_subset_ne.mpr ⟨e₁sube₂, hna⟩ + have : e₁.card < e₂.card := Finset.card_lt_card this + linarith + | inr e₂sube₁ => + simp at e₂sube₁ + have : e₂ ⊂ e₁ := Finset.ssubset_iff_subset_ne.mpr ⟨e₂sube₁, fun h => hna (Eq.symm h)⟩ + have : e₂.card < e₁.card := Finset.card_lt_card this + linarith + +def edge_by_cardinality {n : ℕ} (C : TopDownChain n) (k : Fin (n + 1)) : ∃! e ∈ C.X, Finset.card e = k := by + have existence_edge_by_cardinality : ∃ e ∈ C.X, e.card = k := by + by_contra ass + simp at ass + let list : List (Finset (Fin n)) := C.X.toList + have list_length : list.length = n + 1 := by simp [←C.top_down, list] + let kth_edge (j : Fin (n + 1)) : Finset (Fin n) := List.get list ⟨j.val, by rw [list_length]; exact j.isLt⟩ + have kth_edge_wd : ∀ j : Fin (n + 1), kth_edge j ∈ C.X := by + intro j + have : kth_edge j ∈ C.X.toList := by simp [kth_edge] + exact Finset.mem_toList.mp this + + have edge_cardinality_range (j : Fin (n + 1)) : Finset.card (kth_edge j) < n + 1 := + Nat.lt_of_le_of_lt (edge_cardinality_upperbound (kth_edge j)) (Nat.lt_succ_self n) + + let kth_cardinality (j : Fin (n + 1)) : Fin (n + 1) := ⟨Finset.card (kth_edge j), edge_cardinality_range j⟩ + + have h : ∀ s ∈ (Finset.univ : Finset (Fin (n + 1))), kth_cardinality s ≠ k := by + intro s _ h₁ + simp [kth_cardinality] at h₁ + have h₂ := ass (kth_edge s) (kth_edge_wd s) + have h₃ := congr_arg (fun (x : Fin (n + 1)) => x.val) h₁ + exact h₂ h₃ + + rcases (finset_exists_duplicate_image kth_cardinality k h) with ⟨x, _, y, _, xneqy, card_equal⟩ + simp [kth_cardinality] at card_equal + have q : list[↑x] = list[↑y] := card_not_twice C (kth_edge x) (kth_edge_wd x) (kth_edge y) (kth_edge_wd y) card_equal + have : ↑x = ↑y := by + let nx : Fin list.length := ⟨x.val, by rw [list_length]; exact x.isLt⟩ + let ny : Fin list.length := ⟨y.val, by rw [list_length]; exact y.isLt⟩ + by_contra ass + have neq : nx ≠ ny := by + intro nxeqny + simp [nx, ny] at nxeqny + exact ass (Fin.ext nxeqny) + have := List.not_nodup_of_get_eq_of_ne list nx ⟨y.val, by rw [list_length]; exact y.isLt⟩ q neq + exact this C.X.nodup_toList + + exact xneqy this + + obtain ⟨e, he⟩ := existence_edge_by_cardinality + + have uniqueness_edge_by_cardinality : ∀ (y : Finset (Fin n)), (fun u ↦ u ∈ C.X ∧ u.card = ↑k) y → y = e := by + obtain ⟨eelt, ecard⟩ := he + intros y hy + obtain ⟨yelt, ycard⟩ := hy + exact card_not_twice C y yelt e eelt (by simp [ecard, ycard]) + + exact ⟨e, he, uniqueness_edge_by_cardinality⟩ + +instance {n : ℕ} (C : TopDownChain n) (k : Fin (n + 1)) : DecidablePred (fun (e : Finset (Fin n)) => e ∈ C.X ∧ e.card = k) := fun e => inferInstanceAs (Decidable (e ∈ C.X ∧ e.card = k)) + +/- + Helper function for defining a permutation from a TopDownChain. We split the existence and uniqueness in elt_by_index into two simpler helper functions +-/ + +def elt_by_index_existence {n : ℕ} (C : TopDownChain n) (k : Fin n) : ∃! x ∈ (Finset.univ : Finset (Fin n)), ∀ u₁ ∈ C.X, ∀ u₂ ∈ C.X, (u₁.card = k → u₂.card = k + 1 → u₂ \ u₁ = {x}) := by + let e₁ := (edge_by_cardinality C k).choose + have he₁ := (edge_by_cardinality C k).choose_spec + have e₁elt : e₁ ∈ C.X := he₁.left.left + have e₁card : e₁.card = k := by simp [he₁.left.right] + have e₁unique : ∀ (y : Finset (Fin n)), (fun u ↦ u ∈ C.X ∧ u.card = k) y → y = e₁ := by + intro y hy + have := (he₁.right y) + simp at this + have := this hy.1 hy.2 + simp [this, e₁] + + let e₂ := (edge_by_cardinality C (k + 1)).choose + have he₂ := (edge_by_cardinality C (k + 1)).choose_spec + have e₂elt : e₂ ∈ C.X := he₂.left.left + have e₂card : e₂.card = k + 1 := by simp [he₂.left.right] + have e₂unique : ∀ (y : Finset (Fin n)), (fun u ↦ u ∈ C.X ∧ u.card = k + 1) y → y = e₂ := by + intro y hy + have := (he₂.right y) + simp at this + have := this hy.1 hy.2 + simp [this, e₂] + + have e₁sube₂ : e₁ ⊂ e₂ := by + have e₁nege₂ : e₁ ≠ e₂ := by + intro ass + have : e₁.card = k + 1 := ass.symm ▸ e₂card + rw [e₁card] at this + omega + cases C.chain e₁elt e₂elt e₁nege₂ with + | inl h => + exact Finset.ssubset_iff_subset_ne.mpr ⟨h, e₁nege₂⟩ + | inr h => + simp at h + have := Finset.card_mono h + rw [e₁card, e₂card] at this + omega + + have card_difference : (e₂ \ e₁).card = 1 := by + have := Finset.card_sdiff ((Finset.ssubset_def.mp e₁sube₂).1) + rw [e₁card, e₂card] at this + simp [this] + + let x := (Finset.card_eq_one.mp card_difference).choose + let hx : e₂ \ e₁ = {x} := (Finset.card_eq_one.mp card_difference).choose_spec + + use x + simp + constructor + · intro u₁ u₁elt u₂ u₂elt u₁card u₂card + have u₁eqe₁ : u₁ = e₁ := by + have := e₁unique u₁ + simp at this + exact this u₁elt u₁card + have u₂eqe₂ : u₂ = e₂ := by + have := e₂unique u₂ + simp at this + exact this u₂elt u₂card + rw [u₁eqe₁, u₂eqe₂] + exact hx + · intros y hy + have : e₂ \ e₁ = {y} := hy e₁ e₁elt e₂ e₂elt e₁card e₂card + rw [hx] at this + exact Finset.singleton_injective this.symm + +def filter_fun_elt_by_index {n : ℕ} (C : TopDownChain n) (k : Fin (n + 1)) : Fin n → Prop := (fun (x : Fin n) => ∀ u₁ ∈ C.X, ∀ u₂ ∈ C.X, (u₁.card = k → u₂.card = k + 1 → u₂ \ u₁ = {x})) +instance {n : ℕ} (C : TopDownChain n) (k : Fin (n + 1)) : DecidablePred (filter_fun_elt_by_index C k) := fun x => inferInstanceAs (Decidable (∀ u₁ ∈ C.X, ∀ u₂ ∈ C.X, (u₁.card = k → u₂.card = k + 1 → u₂ \ u₁ = {x}))) + +lemma elt_by_index_unique {n : ℕ} (C : TopDownChain n) (k : Fin n) : ∃! a, a ∈ Finset.univ ∧ filter_fun_elt_by_index C k a := by + simp [filter_fun_elt_by_index] + have := elt_by_index_existence C k + simp at this + exact this + +def elt_by_index {n : ℕ} (C : TopDownChain n) : (Fin n) → (Fin n) := fun k => Finset.choose (filter_fun_elt_by_index C k) (Finset.univ : Finset (Fin n)) (elt_by_index_unique C k) + +lemma elt_by_index_injective {n : ℕ} (C : TopDownChain n) : Injective (elt_by_index C) := by + intro x₁ x₂ fx₁x₂ + + simp only [elt_by_index] at fx₁x₂ + + let y₁ := Finset.choose (filter_fun_elt_by_index C x₁) Finset.univ (elt_by_index_unique C x₁) + let hy₁ := (Finset.choose_spec (filter_fun_elt_by_index C x₁) Finset.univ (elt_by_index_unique C x₁)).right + have hy₁_eq : y₁ = Finset.choose (filter_fun_elt_by_index C ↑↑x₁) Finset.univ (elt_by_index_unique C x₁) := rfl + simp only [filter_fun_elt_by_index, ←hy₁_eq] at hy₁ + + let y₂ := Finset.choose (filter_fun_elt_by_index C x₂) Finset.univ (elt_by_index_unique C x₂) + let hy₂ := (Finset.choose_spec (filter_fun_elt_by_index C x₂) Finset.univ (elt_by_index_unique C x₂)).right + have hy₂_eq : y₂ = Finset.choose (filter_fun_elt_by_index C ↑↑x₂) Finset.univ (elt_by_index_unique C x₂) := rfl + simp only [filter_fun_elt_by_index, ←hy₂_eq] at hy₂ + + have y₁eqy₂ : y₁ = y₂ := fx₁x₂ + + let e₁₁ := (edge_by_cardinality C x₁).choose + have he₁₁ := (edge_by_cardinality C x₁).choose_spec + have e₁₁elt : e₁₁ ∈ C.X := he₁₁.left.left + have e₁₁card : e₁₁.card = x₁ := by simp [he₁₁.left.right] + + let e₂₁ := (edge_by_cardinality C (x₁ + 1)).choose + have he₂₁ := (edge_by_cardinality C (x₁ + 1)).choose_spec + have e₂₁elt : e₂₁ ∈ C.X := he₂₁.left.left + have e₂₁card : e₂₁.card = x₁ + 1 := by simp [he₂₁.left.right] + + let e₁₂ := (edge_by_cardinality C x₂).choose + have he₁₂ := (edge_by_cardinality C x₂).choose_spec + have e₁₂elt : e₁₂ ∈ C.X := he₁₂.left.left + have e₁₂card : e₁₂.card = x₂ := by simp [he₁₂.left.right] + + let e₂₂ := (edge_by_cardinality C (x₂ + 1)).choose + have he₂₂ := (edge_by_cardinality C (x₂ + 1)).choose_spec + have e₂₂elt : e₂₂ ∈ C.X := he₂₂.left.left + have e₂₂card : e₂₂.card = x₂ + 1 := by simp [he₂₂.left.right] + + have q₁ := hy₁ e₁₁ e₁₁elt e₂₁ e₂₁elt (by simp [e₁₁card]) (by simp [e₂₁card]) + have q₂ := hy₂ e₁₂ e₁₂elt e₂₂ e₂₂elt (by simp [e₁₂card]) (by simp [e₂₂card]) + + have e₁₁nege₂₁ : e₁₁ ≠ e₂₁ := by + intro ass + have : e₁₁.card = e₂₁.card := by rw [ass] + rw [e₁₁card, e₂₁card] at this + omega + + have e₁₁sube₂₁ : e₁₁ ⊆ e₂₁ := by + cases (C.chain e₁₁elt e₂₁elt e₁₁nege₂₁) with + | inl h => exact h + | inr h => + simp at h + have : e₂₁.card ≤ e₁₁.card := Finset.card_mono h + rw [e₁₁card, e₂₁card] at this + omega + + have e₁₂nege₂₂ : e₁₂ ≠ e₂₂ := by + intro ass + have : e₁₂.card = e₂₂.card := by rw [ass] + rw [e₁₂card, e₂₂card] at this + omega + + have e₁₂sube₂₂ : e₁₂ ⊆ e₂₂ := by + cases (C.chain e₁₂elt e₂₂elt e₁₂nege₂₂) with + | inl h => exact h + | inr h => + simp at h + have : e₂₂.card ≤ e₁₂.card := Finset.card_mono h + rw [e₁₂card, e₂₂card] at this + omega + + have y₁ine₂₁ : y₁ ∈ e₂₁ := by + apply Finset.mem_of_subset Finset.sdiff_subset + rw [q₁] + exact Finset.mem_singleton_self y₁ + + have y₂ine₂₂ : y₂ ∈ e₂₂ := by + apply Finset.mem_of_subset Finset.sdiff_subset + rw [q₂] + exact Finset.mem_singleton_self y₂ + + have : e₂₁ = e₂₂ := by + by_contra ass + cases (C.chain e₂₁elt e₂₂elt ass) with + | inl e₂₁sube₂₂ => + simp at e₂₁sube₂₂ + have e₂₁sube₁₂ : e₂₁ ⊆ e₁₂ := + if h : (e₂₁ = e₁₂) then (Finset.subset_of_eq h) else by + cases (C.chain e₂₁elt e₁₂elt h) with + | inl e₂₁sube₁₂ => exact e₂₁sube₁₂ + | inr e₁₂sube₂₁ => + simp at e₁₂sube₂₁ + have : e₁₂.card < e₂₁.card := Finset.card_strictMono (Finset.ssubset_iff_subset_ne.mpr ⟨e₁₂sube₂₁, (fun o => h o.symm)⟩) + have : e₂₁.card < e₂₂.card := Finset.card_strictMono (Finset.ssubset_iff_subset_ne.mpr ⟨e₂₁sube₂₂, (fun o => ass o)⟩) + have e₁₂union₂₂ := Finset.union_eq_right.mpr e₁₂sube₂₂ + rw [Finset.union_comm] at e₁₂union₂₂ + have := Finset.card_sdiff_add_card e₂₂ e₁₂ + rw [q₂, Finset.card_singleton, e₁₂union₂₂] at this + linarith + + have y₂ine₁₂ : y₂ ∈ e₁₂ := by + rw [←y₁eqy₂] + exact Finset.mem_of_subset e₂₁sube₁₂ y₁ine₂₁ + have : y₂ ∈ e₂₂ \ e₁₂ := by + rw [q₂] + exact Finset.mem_singleton_self y₂ + + exact False.elim ((Finset.mem_sdiff.mp this).right y₂ine₁₂) + | inr e₂₂sube₂₁ => + have e₂₂sube₁₁ : e₂₂ ⊆ e₁₁ := + if h : (e₂₂ = e₁₁) then (Finset.subset_of_eq h) else by + cases (C.chain e₂₂elt e₁₁elt h) with + | inl e₂₂sube₁₁ => exact e₂₂sube₁₁ + | inr e₁₁sube₂₂ => + simp at e₁₁sube₂₂ + have : e₁₁.card < e₂₂.card := Finset.card_strictMono (Finset.ssubset_iff_subset_ne.mpr ⟨e₁₁sube₂₂, (fun o => h o.symm)⟩) + have : e₂₂.card < e₂₁.card := Finset.card_strictMono (Finset.ssubset_iff_subset_ne.mpr ⟨e₂₂sube₂₁, (fun o => ass o.symm)⟩) + have e₁₁union₂₁ := Finset.union_eq_right.mpr e₁₁sube₂₁ + rw [Finset.union_comm] at e₁₁union₂₁ + have := Finset.card_sdiff_add_card e₂₁ e₁₁ + rw [q₁, Finset.card_singleton, e₁₁union₂₁] at this + linarith + have y₁ine₁₁ : y₁ ∈ e₁₁ := by + rw [y₁eqy₂] + exact Finset.mem_of_subset e₂₂sube₁₁ y₂ine₂₂ + have : y₁ ∈ e₂₁ \ e₁₁ := by + rw [q₁] + exact Finset.mem_singleton_self y₁ + + exact False.elim ((Finset.mem_sdiff.mp this).right y₁ine₁₁) + + have : e₂₁.card = e₂₂.card := by rw [this] + rw [e₂₁card, e₂₂card] at this + norm_num at this + exact Fin.ext this + +/- + In order to use Finset.choose we need some stronger property than given by Bijective (elt_by_index C) +-/ +instance {n : ℕ} (C : TopDownChain n) (y : Fin n) : DecidablePred (fun (x : Fin n) => x ∈ (Finset.univ : Finset (Fin n)) ∧ elt_by_index C x = y) := fun x => inferInstanceAs (Decidable (x ∈ (Finset.univ : Finset (Fin n)) ∧ elt_by_index C x = y)) + +lemma elt_by_index_surjective_constructive {n : ℕ} (C : TopDownChain n) : ∀ y : Fin n, ∃! x : Fin n, x ∈ (Finset.univ : Finset (Fin n)) ∧ elt_by_index C x = y := by + intro y + + let e : Fin (n + 1) → Finset (Fin n) := fun x => (edge_by_cardinality C x).choose + let I := Finset.filter (fun x => y ∈ (e x)) (Finset.univ : Finset (Fin (n + 1))) + have image_univ : e ⟨n, by norm_num⟩ = (Finset.univ : Finset (Fin n)) := by + let A := e ⟨n, by norm_num⟩ + have h : A = e ⟨n, by norm_num⟩ := rfl + rw [←h] + simp [e] at h + have := ((edge_by_cardinality C n).choose_spec).left + simp [←h] at this + + apply Finset.eq_univ_of_card A + rw [←Finset.card_univ, Finset.card_fin n] + exact this.right + + have image_empty : e ⟨0, by norm_num⟩ = ∅ := by + let A := e ⟨0, by norm_num⟩ + have h : A = e ⟨0, by norm_num⟩ := rfl + rw [←h] + simp [e] at h + have := ((edge_by_cardinality C 0).choose_spec).left + simp [←h] at this + exact this.right + + have ninI : ⟨n, by norm_num⟩ ∈ I := by + simp [I] + rw [image_univ] + exact Finset.mem_univ y + + have h : I.Nonempty := ⟨⟨n, by norm_num⟩, ninI⟩ + + let x := (Finset.min_of_nonempty h).choose + let hx : I.min = x := (Finset.min_of_nonempty h).choose_spec + + have : ∀ z : Fin (n + 1), z < x → y ∉ (e z) := by + intro z zlty + have : z < I.min := by simp [hx]; exact zlty + have : z ∉ I := Finset.not_mem_of_coe_lt_min this + contrapose this + simp + simp at this + apply Finset.mem_filter.mpr + constructor + · exact Finset.mem_univ z + · exact this + + have zeroltx : 0 < x := by + by_contra ass + have xzero : x = 0 := by + have : ¬0 < x.val := fun h => ass (Fin.lt_def.mpr h) + have : x.val = 0 := Nat.eq_zero_of_not_pos this + exact Fin.ext this + have : 0 ∈ I := by rw [←xzero]; exact Finset.mem_of_min hx + have := (Finset.mem_filter.mp this).right + rw [image_empty] at this + simp at this + + have xminusoneltn : x.val - 1 < n := by + have : x.val < n + 1 := x.isLt + simp [Nat.add_comm n 1] at this + exact Nat.sub_lt_left_of_lt_add (by norm_cast) this + + let w : Fin n := ⟨x - 1, xminusoneltn⟩ + use w + + simp + + have hw : elt_by_index C w = y := by + have hy₁ : y ∉ e w := by + have wltx : w < x := by + simp [w] + apply Fin.lt_def.mpr + norm_num + have : (↑x - 1) % (n + 1) = (↑x - 1) := by + apply Nat.mod_eq_of_lt + have : ↑x < n + 1 := x.isLt + linarith + rw [this] + norm_num + exact zeroltx + exact this w wltx + + have hy₂ : y ∈ e (w + 1) := by + have xw : x = ↑↑w + 1 := by + simp [w] + norm_cast + rw [Nat.sub_add_cancel] + simp + norm_cast + + have : x ∈ I := Finset.mem_of_min hx + simp [I] at this + rw [xw] at this + exact this + + have hy : y ∈ e (w + 1) \ e w := by simp [hy₁, hy₂] + + let u := elt_by_index C w + + let hu : filter_fun_elt_by_index C w u:= (Finset.choose_spec (filter_fun_elt_by_index C w) (Finset.univ : Finset (Fin n)) (elt_by_index_unique C w)).right + simp [filter_fun_elt_by_index] at hu + + let e₁ := e w + have he₁ := (edge_by_cardinality C w).choose_spec + have e₁elt : e₁ ∈ C.X := he₁.left.left + have e₁card : e₁.card = (↑x - 1) % (n + 1) := by simp [he₁.left.right] + + let e₂ := e (w + 1) + have he₂ := (edge_by_cardinality C (w + 1)).choose_spec + have e₂elt : e₂ ∈ C.X := he₂.left.left + have e₂card : e₂.card = (↑x - 1) % (n + 1) + 1 := by + simp [he₂.left.right] + norm_cast + rw [Nat.sub_add_cancel] + simp + apply (Nat.sub_eq_iff_eq_add (by norm_cast)).mp + apply Eq.symm + apply (Nat.mod_eq_iff_lt (by norm_cast)).mpr + linarith + norm_cast + + have usingleton : e₂ \ e₁ = {u} := hu e₁ e₁elt e₂ e₂elt e₁card e₂card + + have e₁nege₂ : e₁ ≠ e₂ := by + intro ass + have : e₁.card = e₂.card := by rw [ass] + rw [e₁card, e₂card] at this + omega + + have e₁sube₂ : e₁ ⊆ e₂ := by + cases (C.chain e₁elt e₂elt e₁nege₂) with + | inl h => exact h + | inr h => + simp at h + have : e₂.card ≤ e₁.card := Finset.card_mono h + rw [e₁card, e₂card] at this + omega + + have : e₂ \ e₁ = {y} := by + have diff_card : (e₂ \ e₁).card = 1 := by + calc + (e₂ \ e₁).card = e₂.card - e₁.card := Finset.card_sdiff e₁sube₂ + _ = (↑x - 1) % (n + 1) + 1 - (↑x - 1) % (n + 1) := by rw [e₁card, e₂card] + _ = 1 := by norm_num + + obtain ⟨y_, hy_⟩ := Finset.card_eq_one.mp diff_card + simp [hy_] + apply Eq.symm + apply Finset.mem_singleton.mp + rw [←hy_] + exact hy + + rw [usingleton] at this + exact Finset.singleton_injective this + + constructor + · exact hw + · intro x₂ hwx₂ + rw [←hw] at hwx₂ + exact (elt_by_index_injective C) hwx₂ + +def elt_by_index_inverse {n : ℕ} (C : TopDownChain n) : Fin n → Fin n := fun y => Finset.choose (fun (x : Fin n) => elt_by_index C x = y) (Finset.univ : Finset (Fin n)) (elt_by_index_surjective_constructive C y) + +def top_down_chain_to_permutation (n : ℕ) (C : TopDownChain n) : Equiv.Perm (Fin n) := { + toFun := elt_by_index C + + invFun := elt_by_index_inverse C + + left_inv := by + intro x + let y := elt_by_index C x + have hy : y = elt_by_index C x := rfl + simp [elt_by_index_inverse, ←hy] + have unique_existence := (elt_by_index_surjective_constructive C y) + obtain ⟨_, exprop⟩ := Finset.choose_spec (fun (x : Fin n) => elt_by_index C x = y) (Finset.univ : Finset (Fin n)) unique_existence + + apply ExistsUnique.unique unique_existence + + · constructor + · simp + · exact exprop + · constructor + · simp + · exact hy + + right_inv := by + intro y + let x := elt_by_index_inverse C y + have hx : x = elt_by_index_inverse C y := rfl + simp only [←hx] + + simp only [elt_by_index_inverse] at hx + + have unique_existence := elt_by_index_surjective_constructive C y + have ⟨_, exprop⟩ := Finset.choose_spec (fun (x : Fin n) => elt_by_index C x = y) (Finset.univ : Finset (Fin n)) unique_existence + simp only [←hx] at exprop + + exact exprop +} + + +theorem top_down_chain_to_permutation_bijective (n : ℕ) : (Bijective (top_down_chain_to_permutation n)) := by sorry + +theorem permutation_to_top_down_chain_bijective (n : ℕ) : (Bijective (permutation_to_top_down_chain n)) := by sorry + +instance (n : ℕ) : Fintype (TopDownChain n) := { + elems := Finset.image (fun π => permutation_to_top_down_chain n π) (Finset.univ : Finset (Equiv.Perm (Fin n))) + complete := by + intro C + simp + exact (permutation_to_top_down_chain_bijective n).right C +} + +/- + Equivalence between **TopDownChainThrough n a** and **TopDownChainSplitThrough n a** +-/ + +def TopDownChainSplitThrough_embedding (n : ℕ) (a : Finset (Fin n)) : ((TopDownChain a.card) × (TopDownChain (n - a.card))) → TopDownChainSplitThrough n a := + fun (bottom, top) => (⟨bottom, top⟩ : TopDownChainSplitThrough n a) + +instance (n : ℕ) (a : Finset (Fin n)) : Fintype (TopDownChainSplitThrough n a) := { + elems := Finset.image (TopDownChainSplitThrough_embedding n a) (Finset.univ : Finset ((TopDownChain a.card) × (TopDownChain (n - a.card)))), + complete := by + intro C + simp [TopDownChainSplitThrough_embedding] +} + +lemma TopDownChainSplitThrough_embedding_bijective (n : ℕ) (a : Finset (Fin n)) : Bijective (TopDownChainSplitThrough_embedding n a) := by + constructor + · intro ⟨bottom₁, top₁⟩ ⟨bottom₂, top₂⟩ ass + simp [TopDownChainSplitThrough_embedding] at ass + simp [ass] + · intro ⟨bottom, top⟩ + use (bottom, top) + simp [TopDownChainSplitThrough_embedding] + +def translate_edge {n m : ℕ} (list : List (Fin n)) (list_length : list.length = m) : Finset (Fin m) → Finset (Fin n) := fun e => (Finset.image (fun j : Fin m => (list.get ⟨j.val, by rw [list_length]; exact j.isLt⟩)) e) + +lemma translate_edge_injective (n m : ℕ) (list : List (Fin n)) (list_length : list.length = m) (nodups : list.Nodup): Injective (translate_edge list list_length) := by + intro e₁ e₂ he₁e₂ + ext x + constructor + · intro xine₁ + have x_in_filter₁ : list.get ⟨x, by simp [list_length]⟩ ∈ translate_edge list list_length e₂ := by + rw [←he₁e₂] + simp [translate_edge] + exact ⟨x, ⟨xine₁, rfl⟩⟩ + simp [translate_edge] at x_in_filter₁ + obtain ⟨j, ⟨jine₂, hj⟩⟩ := x_in_filter₁ + have get_injective : Function.Injective list.get := List.nodup_iff_injective_get.mp nodups + have := Fin.ext_iff.mp (get_injective hj) + simp at this + have := Fin.ext this + rw [this] at jine₂ + exact jine₂ + · intro xine₁ + have x_in_filter₂ : list.get ⟨x, by simp [list_length]⟩ ∈ translate_edge list list_length e₁ := by + rw [he₁e₂] + simp [translate_edge] + exact ⟨x, ⟨xine₁, rfl⟩⟩ + simp [translate_edge] at x_in_filter₂ + obtain ⟨j, ⟨jine₁, hj⟩⟩ := x_in_filter₂ + have get_injective : Function.Injective list.get := List.nodup_iff_injective_get.mp nodups + have := Fin.ext_iff.mp (get_injective hj) + simp at this + have := Fin.ext this + rw [this] at jine₁ + exact jine₁ + +def translate_bottom_chain {n m : ℕ} (X : Finset (Finset (Fin m))) (list : List (Fin n)) (list_length : list.length = m) : Finset (Finset (Fin n)) := Finset.image (translate_edge list list_length) X + +lemma chain_translate_chain {n m : ℕ} (X : Finset (Finset (Fin m))) (list : List (Fin n)) (list_length : list.length = m) (chain : IsChain (· ⊆ ·) X.toSet) + (e₁ : Finset (Fin n)) (e₁elt : ∃ x ∈ X, translate_edge list list_length x = e₁) (e₂ : Finset (Fin n)) (e₂elt : ∃ x ∈ X, translate_edge list list_length x = e₂) (e₁nee₂ : e₁ ≠ e₂) : e₁ ⊆ e₂ ∨ e₂ ⊆ e₁ := by + + obtain ⟨u₁, ⟨u₁elt, u₁image⟩⟩ := e₁elt + obtain ⟨u₂, ⟨u₂elt, u₂image⟩⟩ := e₂elt + + have u₁neu₂ : u₁ ≠ u₂ := by + intro ass + have := + calc + e₁ = translate_edge list list_length u₁ := u₁image.symm + _ = translate_edge list list_length u₂ := by rw [ass] + _ = e₂ := u₂image + exact e₁nee₂ this + + cases chain u₁elt u₂elt u₁neu₂ with + | inl u₁subu₂ => + left + intro x xine₁ + simp [←u₁image, translate_edge] at xine₁ + obtain ⟨j₁, ⟨j₁inu₁, hj₁⟩⟩ := xine₁ + have j₁inu₂ := u₁subu₂ j₁inu₁ + simp [←u₂image, translate_edge] + exact ⟨j₁, ⟨j₁inu₂, hj₁⟩⟩ + | inr u₂subu₁ => + right + intro x xine₂ + simp [←u₂image, translate_edge] at xine₂ + obtain ⟨j₂, ⟨j₂inu₂, hj₂⟩⟩ := xine₂ + have j₂inu₁ := u₂subu₁ j₂inu₂ + simp [←u₁image, translate_edge] + exact ⟨j₂, ⟨j₂inu₁, hj₂⟩⟩ + +noncomputable def split_to_TopDownChainThrough (n : ℕ) (a : Finset (Fin n)) : TopDownChainSplitThrough n a → TopDownChainThrough n a := by + intro C + + let top_elements := (Finset.univ : Finset (Fin n)) \ a + + have top_elements_card : top_elements.card = n - a.card := by + have h_univ : (Finset.univ : Finset (Fin n)).card = n := Finset.card_fin n + have : top_elements.card + a.card = Finset.univ.card := Finset.card_sdiff_add_card_eq_card (Finset.subset_univ a) + rw [h_univ] at this + exact (Nat.sub_eq_of_eq_add this.symm).symm + + have disjoint_helper (e : Finset (Fin (n - a.card))) : Disjoint ((translate_edge top_elements.toList (by simp [top_elements_card])) e) a := by + intro u usub usuba + simp [translate_edge] at usub + intro x xinu + have := usub xinu + simp at this + obtain ⟨j, ⟨_, hj⟩⟩ := this + + have : x ∈ top_elements.toList := by + rw [←hj] + apply List.getElem_mem + + have xintop : x ∈ top_elements := Finset.mem_toList.mp this + simp [top_elements] at xintop + exact False.elim (xintop (usuba xinu)) + + let bottom_chain_embedding := Finset.image (translate_edge a.toList (by simp)) C.bottom_chain.X + let top_translate_edge : Finset (Fin (n - a.card)) → Finset (Fin n) := fun e => Finset.disjUnion ((translate_edge top_elements.toList (by simp [top_elements_card])) e) a (disjoint_helper e) + let top_chain_embedding := Finset.image top_translate_edge (C.top_chain.X \ {∅}) + + have embeddings_disjoint : Disjoint bottom_chain_embedding top_chain_embedding := by + intro E Ebottom Etop + simp + intro e einE + + have einbottom := Ebottom einE + simp [bottom_chain_embedding] at einbottom + obtain ⟨_, ⟨_, hebottom⟩⟩ := einbottom + + have eintop := Etop einE + simp [top_chain_embedding] at eintop + obtain ⟨w, ⟨welt, hetop⟩⟩ := eintop + + have : 1 + a.card ≤ e.card := by + simp [top_translate_edge] at hetop + have : e = Finset.disjUnion ((translate_edge top_elements.toList (by simp [top_elements_card])) w) a (disjoint_helper w) := by simp [hetop] + rw [this, Finset.card_disjUnion] + simp + apply Finset.image_nonempty.mpr + exact Finset.nonempty_iff_ne_empty.mpr welt.right + + have : e.card ≤ a.card := by + simp [←hebottom] + apply Finset.card_mono + intro y yelt + simp [translate_edge] at yelt + obtain ⟨_, ⟨_, h⟩⟩ := yelt + apply Finset.mem_toList.mp + rw [←h] + apply List.getElem_mem + + linarith + + let top_down_chain : TopDownChain n := { + X := Finset.disjUnion bottom_chain_embedding top_chain_embedding embeddings_disjoint + chain := by + intro e₁ e₁elt e₂ e₂elt e₁nee₂ + cases Finset.mem_disjUnion.mp e₁elt with + | inl e₁inbottom => + simp [bottom_chain_embedding] at e₁inbottom + cases Finset.mem_disjUnion.mp e₂elt with + | inl e₂inbottom => + simp [bottom_chain_embedding] at e₂inbottom + exact chain_translate_chain C.bottom_chain.X a.toList (by simp) C.bottom_chain.chain e₁ e₁inbottom e₂ e₂inbottom e₁nee₂ + | inr e₂intop => + left + simp [top_chain_embedding] at e₂intop + obtain ⟨preimagee₂, ⟨_, h₃⟩⟩ := e₂intop + have : e₁ ⊆ a := by + obtain ⟨preimagee₁, ⟨_, he₁⟩⟩ := e₁inbottom + rw [←he₁] + intro x xelt + simp [translate_edge] at xelt + obtain ⟨j, ⟨_, hj⟩⟩ := xelt + rw [←hj] + apply Finset.mem_toList.mp + apply List.getElem_mem + rw [←h₃] + intro x xine₁ + simp [top_translate_edge] + right + exact this xine₁ + | inr e₁intop => + simp [top_chain_embedding] at e₁intop + cases Finset.mem_disjUnion.mp e₂elt with + | inr e₂intop => + simp [top_chain_embedding] at e₂intop + obtain ⟨preimagee₁, ⟨preimagee₁elt, _⟩, hpreimagee₁⟩ := e₁intop + obtain ⟨preimagee₂, ⟨preimagee₂elt, _⟩, hpreimagee₂⟩ := e₂intop + let u₁ := e₁ \ a + let u₂ := e₂ \ a + have u₁neu₂ : u₁ ≠ u₂ := by + intro ass + have : (e₁ \ a) ∪ a = (e₂ \ a) ∪ a := by + have hu₁ : e₁ \ a = u₁ := rfl + have hu₂ : e₂ \ a = u₂ := rfl + rw [hu₁, hu₂, ass] + have h₁ : e₁ \ a ∪ a = e₁ := by + rw [←hpreimagee₁] + simp [top_translate_edge] + have h₂ : e₂ \ a ∪ a = e₂ := by + rw [←hpreimagee₂] + simp [top_translate_edge] + rw [h₁, h₂] at this + exact e₁nee₂ this + + have hu₁ : u₁ = translate_edge top_elements.toList (by simp [top_elements_card]) preimagee₁ := by + let u := translate_edge top_elements.toList (by simp [top_elements_card]) preimagee₁ + have hu : u = translate_edge top_elements.toList (by simp [top_elements_card]) preimagee₁ := rfl + simp [u₁, ←hpreimagee₁, ←hu, top_translate_edge] + apply Finset.union_sdiff_cancel_right + + exact disjoint_helper preimagee₁ + + have hu₂ : u₂ = translate_edge top_elements.toList (by simp [top_elements_card]) preimagee₂ := by + let u := translate_edge top_elements.toList (by simp [top_elements_card]) preimagee₂ + have hu : u = translate_edge top_elements.toList (by simp [top_elements_card]) preimagee₂ := rfl + simp [u₂, ←hpreimagee₂, ←hu, top_translate_edge] + apply Finset.union_sdiff_cancel_right + + exact disjoint_helper preimagee₂ + + + have := chain_translate_chain C.top_chain.X top_elements.toList (by simp [top_elements_card]) C.top_chain.chain u₁ ⟨preimagee₁, ⟨preimagee₁elt, hu₁.symm⟩⟩ u₂ ⟨preimagee₂, ⟨preimagee₂elt, hu₂.symm⟩⟩ u₁neu₂ + simp [top_translate_edge, ←hu₁] at hpreimagee₁ + simp [top_translate_edge, ←hu₂] at hpreimagee₂ + + have disjoint₁ := disjoint_helper preimagee₁ + rw [←hu₁] at disjoint₁ + have u₁indisjoint : e₁ = Finset.disjUnion u₁ a disjoint₁ := by simp [hpreimagee₁] + + have disjoint₂ := disjoint_helper preimagee₂ + rw [←hu₂] at disjoint₂ + have u₂indisjoint : e₂ = Finset.disjUnion u₂ a disjoint₂ := by simp [hpreimagee₂] + + cases this with + | inl u₁inu₂ => + left + intro x xine₁ + + rw [u₁indisjoint] at xine₁ + rw [u₂indisjoint] + + cases Finset.mem_disjUnion.mp xine₁ with + | inl h => + apply Finset.mem_disjUnion.mpr + left + exact u₁inu₂ h + + | inr h => + apply Finset.mem_disjUnion.mpr + right + exact h + | inr u₂inu₁ => + right + intro x xine₂ + + rw [u₂indisjoint] at xine₂ + rw [u₁indisjoint] + + cases Finset.mem_disjUnion.mp xine₂ with + | inl h => + apply Finset.mem_disjUnion.mpr + left + exact u₂inu₁ h + + | inr h => + apply Finset.mem_disjUnion.mpr + right + exact h + + | inl e₂inbottom => + right + simp [bottom_chain_embedding] at e₂inbottom + obtain ⟨preimagee₁, ⟨_, h₃⟩⟩ := e₁intop + + have : e₂ ⊆ a := by + obtain ⟨preimagee₂, ⟨_, he₂⟩⟩ := e₂inbottom + rw [←he₂] + intro x xelt + simp [translate_edge] at xelt + obtain ⟨j, ⟨_, hj⟩⟩ := xelt + rw [←hj] + apply Finset.mem_toList.mp + apply List.getElem_mem + + rw [←h₃] + intro x xine₂ + simp [top_translate_edge] + right + exact this xine₂ + + top_down := by + have : Fintype.card { x // x ∈ bottom_chain_embedding.disjUnion top_chain_embedding embeddings_disjoint } + = Finset.card (bottom_chain_embedding.disjUnion top_chain_embedding embeddings_disjoint) := Fintype.card_ofFinset _ (fun x => Iff.rfl) + rw [this, Finset.card_disjUnion] + simp [bottom_chain_embedding, top_chain_embedding] + rw [Finset.card_image_of_injective C.bottom_chain.X (translate_edge_injective n a.card a.toList (by simp) a.nodup_toList)] + have top_translate_edge_injective : Injective top_translate_edge := by + intro e₁ e₂ he₁e₂ + simp only [top_translate_edge] at he₁e₂ + + let specific_translate_edge : Finset (Fin (n - a.card)) → Finset (Fin n) := translate_edge top_elements.toList (by simp [top_elements_card]) + have h : (specific_translate_edge : Finset (Fin (n - a.card)) → Finset (Fin n)) = translate_edge top_elements.toList (by simp [top_elements_card]) := rfl + + simp [←h] at he₁e₂ + + have : specific_translate_edge e₁ = specific_translate_edge e₂ := by + ext z + constructor + · intro zelt + have : z ∈ (specific_translate_edge e₁) ∪ a := by simp [zelt] + simp [he₁e₂] at this + cases this with + | inl zin => exact zin + | inr zina => + have := disjoint_helper e₁ + rw [←h] at this + have := (Finset.disjoint_iff_ne.mp this) z zelt z zina + simp at this + · intro zelt + have : z ∈ (specific_translate_edge e₂) ∪ a := by simp [zelt] + simp [←he₁e₂] at this + cases this with + | inl zin => exact zin + | inr zina => + have := disjoint_helper e₂ + rw [←h] at this + have := (Finset.disjoint_iff_ne.mp this) z zelt z zina + simp at this + + have injectivity : Injective specific_translate_edge := (translate_edge_injective n (n - a.card) top_elements.toList (by simp [top_elements_card]) top_elements.nodup_toList) + + exact injectivity this + + + rw [Finset.card_image_of_injective (C.top_chain.X \ {∅}) top_translate_edge_injective] + have fst_term : Fintype.card C.bottom_chain.X = C.bottom_chain.X.card := Fintype.card_ofFinset _ (fun x => Iff.rfl) + have get_rid_of_empty : (C.top_chain.X \ {∅}).card = C.top_chain.X.card - 1 := by + apply Eq.symm + apply Nat.sub_eq_of_eq_add + apply Eq.symm + rw [←(Finset.card_singleton (∅ : Finset (Fin n)))] + apply Finset.card_sdiff_add_card_eq_card + simp + obtain ⟨⟨e, ecard⟩, _⟩ := (edge_by_cardinality C.top_chain ⟨0, by norm_num⟩).choose_spec + simp at ecard + simp [ecard] at e + exact e + have snd_term : Fintype.card C.top_chain.X = C.top_chain.X.card := Fintype.card_ofFinset _ (fun x => Iff.rfl) + rw [←fst_term, C.bottom_chain.top_down, get_rid_of_empty, ←snd_term, C.top_chain.top_down] + rw [Nat.add_sub_cancel, Nat.add_assoc, Nat.add_comm, Nat.add_assoc, Nat.sub_add_cancel, Nat.add_comm] + + · simp_rw [←(Finset.card_fin n)] + apply Finset.card_mono + simp + + } + + let result : TopDownChainThrough n a := { + top_down_chain := top_down_chain + through := by + simp [bottom_chain_embedding] + left + let preimage := (edge_by_cardinality C.bottom_chain a.card).choose + have : preimage ∈ C.bottom_chain.X ∧ preimage.card = a.card := by simp [(edge_by_cardinality C.bottom_chain a.card).choose_spec.left] + use preimage + constructor + · exact this.left + · apply Finset.eq_of_subset_of_card_le + · simp [translate_edge] + intro x xin + simp at xin + obtain ⟨j, ⟨_, hj⟩⟩ := xin + + apply Finset.mem_toList.mp + rw [←hj] + apply List.getElem_mem + · apply Nat.le_of_eq + + simp [translate_edge] + have injectivity_get : Injective (fun j : Fin a.card => (a.toList[j.val])) := by + intro a₁ a₂ ha₁a₂ + have := Fin.ext_iff.mp ((List.nodup_iff_injective_get.mp a.nodup_toList) ha₁a₂) + exact Fin.ext this + + simp_rw [Finset.card_image_of_injective (preimage) injectivity_get] + exact this.right.symm + } + + exact result + +theorem split_to_TopDownChainThrough_bijective (n : ℕ) (a : Finset (Fin n)) : Bijective (split_to_TopDownChainThrough n a) := by sorry + + +noncomputable instance (n : ℕ) (a : Finset (Fin n)) : Fintype (TopDownChainThrough n a) := { + elems := Finset.image (fun π => split_to_TopDownChainThrough n a π) (Finset.univ : Finset (TopDownChainSplitThrough n a)) + complete := by + intro C + simp + exact (split_to_TopDownChainThrough_bijective n a).right C +} + +/- + Lemmata about cardinalities +-/ + +lemma cardinality_ChainThrough {n : ℕ} (a : Finset (Fin n)) : + (Finset.univ : Finset (TopDownChainThrough n a)).card = (Finset.univ : Finset (TopDownChainSplitThrough n a)).card := by + apply Eq.symm + apply Finset.card_eq_of_equiv + have := Equiv.ofBijective (split_to_TopDownChainThrough n a) (split_to_TopDownChainThrough_bijective n a) + have tdc_through_equiv := Equiv.Set.univ (TopDownChainThrough n a) + have tdc_split_equiv := Equiv.Set.univ (TopDownChainSplitThrough n a) + simp + + exact (tdc_split_equiv.trans this).trans tdc_through_equiv.symm + +lemma cardinality_TopDownChain (n : ℕ) : (Finset.univ : Finset (TopDownChain n)).card = (n)! := by + calc + (Finset.univ : Finset (TopDownChain n)).card = (Finset.univ : Finset (Equiv.Perm (Fin n))).card := by + apply Finset.card_bijective (top_down_chain_to_permutation n) (top_down_chain_to_permutation_bijective n) (fun i => ⟨fun _ => by simp, fun _ => by simp⟩) + _ = Fintype.card (Equiv.Perm (Fin n)) := by simp + _ = (Fintype.card (Fin n))! := Fintype.card_perm + _ = (n)! := by rw [Fintype.card_fin n] + +lemma cardinality_ChainSplitThrough {n : ℕ} (a : Finset (Fin n)) : + (Finset.univ : Finset (TopDownChainSplitThrough n a)).card = (a.card)! * (n - a.card)! := by + have hst : ∀ i, i ∈ (Finset.univ : Finset ((TopDownChain a.card) × (TopDownChain (n - a.card)))) ↔ (TopDownChainSplitThrough_embedding n a) i ∈ (Finset.univ : Finset (TopDownChainSplitThrough n a)) := by + intro i + constructor <;> simp + rw [←Finset.card_bijective (TopDownChainSplitThrough_embedding n a) (TopDownChainSplitThrough_embedding_bijective n a) hst] + rw [Finset.card_univ] + rw [Fintype.card_prod] + have fst_eq : Fintype.card (TopDownChain a.card) = a.card ! := by rw [←(cardinality_TopDownChain a.card)]; simp + have snd_eq: Fintype.card (TopDownChain (n - a.card)) = (n - a.card)! := by rw [←(cardinality_TopDownChain (n - a.card))]; simp + rw [fst_eq, snd_eq] + +/- + **Sperners Theorem** +-/ + +theorem Sperner {n : ℕ} {A : Finset (Finset (Fin n))} : + (∀ e₁ ∈ A, ∀ e₂ ∈ A, e₁ ≠ e₂ → ¬(e₁ ⊆ e₂)) → A.card ≤ n.choose (n / 2) := by + intro h_antichain + + let M : Fin (n + 1) → Finset (Finset (Fin n)) := fun k => { e | e ∈ A ∧ Finset.card e = k } + let m : Fin (n + 1) → ℕ := fun k => Finset.card (M k) + + have pairwisedisjointM : (Set.univ : Set (Fin (n + 1))).PairwiseDisjoint M := by + intro i hi j hj inegj + intro a hai haj b bina + simp [M] at * + have bcardi : b.card = i := by + have := hai bina + simp at this + exact this.2 + have bcardj : b.card = j := by + have := haj bina + simp at this + exact this.2 + have : i.val = j.val := by rw [←bcardi, ←bcardj] + exact inegj (Fin.ext this) + + have disjointcardinalityunion : A = (Finset.univ : Finset (Fin (n + 1))).disjiUnion M (by simp [pairwisedisjointM]) := by + ext e + constructor + · intro he + apply Finset.mem_disjiUnion.mpr + use ⟨Finset.card e, Nat.lt_succ.mpr (edge_cardinality_upperbound e)⟩ + simp [M, he] + · intro he + simp [Finset.biUnion, M] at he + exact he.1 + + have cardassum : A.card = ∑ (k : Fin (n + 1)), m k := by + rw [disjointcardinalityunion, Finset.card_disjiUnion (Finset.univ : Finset (Fin (n + 1))) M (by simp [pairwisedisjointM])] + + have disjoint_top_down_chains: ∀ e₁ ∈ A, ∀ e₂ ∈ A, e₁ ≠ e₂ → ∀ C₁ : TopDownChainThrough n e₁, ∀ C₂ : TopDownChainThrough n e₂, C₁.top_down_chain.X ≠ C₂.top_down_chain.X := by + intro e₁ he₁ e₂ he₂ e₁nege₂ C₁ C₂ + by_contra ass + have e₁inC₂ : e₁ ∈ C₂.top_down_chain.X := by + rw [←ass] + exact C₁.through + cases (C₂.top_down_chain.chain e₁inC₂ C₂.through e₁nege₂ : e₁ ⊆ e₂ ∨ e₂ ⊆ e₁) with + | inl e₁ine₂ => exact h_antichain e₁ he₁ e₂ he₂ e₁nege₂ e₁ine₂ + | inr e₂ine₁ => exact h_antichain e₂ he₂ e₁ he₁ (by by_contra q; exact e₁nege₂ (Eq.symm q)) e₂ine₁ + + let f_embedded_chains (e : Finset (Fin n)) : (TopDownChainThrough n e) → (TopDownChain n) := fun C => C.top_down_chain + + let embedded_chains : Finset (Fin n) → Finset (TopDownChain n) := fun e => ((Finset.univ : Finset (TopDownChainThrough n e)).image (f_embedded_chains e)) + + have embedded_chains_cardinality (e : Finset (Fin n)) : (embedded_chains e).card = (Finset.univ : Finset (TopDownChainThrough n e)).card := by + simp [embedded_chains] + apply Finset.card_image_of_injective + · intro e₁ e₂ he₁e₂ + simp [f_embedded_chains] at he₁e₂ + cases e₁ + cases e₂ + simp at he₁e₂ + simp [he₁e₂] + + have hf : Set.PairwiseDisjoint A embedded_chains := by + intros e₁ e₁elt e₂ e₂elt e₁nee₂ + intros u usub₁ usub₂ + intro x xinu + have xelt₁ := usub₁ xinu + simp [embedded_chains] at xelt₁ + have xelt₂ := usub₂ xinu + simp [embedded_chains] at xelt₂ + obtain ⟨C₁, hC₁⟩ := xelt₁ + obtain ⟨C₂, hC₂⟩ := xelt₂ + + simp [f_embedded_chains] at hC₁ + simp [f_embedded_chains] at hC₂ + + have := disjoint_top_down_chains e₁ e₁elt e₂ e₂elt e₁nee₂ C₁ C₂ + rw [←hC₂] at hC₁ + have h : C₁.top_down_chain.X = C₂.top_down_chain.X := by rw [hC₁] + exact False.elim (this h) + + let chains_through_A := A.disjiUnion embedded_chains hf + + have central_inequality : ∑ k : Fin (n + 1), (m k) * (k)! * (n - k)! ≤ (n)! := by + calc + ∑ k : Fin (n + 1), (m k) * (k)! * (n - k)! = ∑ k : Fin (n + 1), ∑ e ∈ (M k), (e.card)! * (n - e.card)! := by + apply Finset.sum_congr + simp + intro k _ + have hq : ∀ e ∈ M k, (e.card)! * (n - e.card)! = (k)! * (n - k)! := by + intro e he + simp [M] at he + rw [he.2] + rw [Finset.sum_congr rfl (fun x q => hq x q)] + simp [m] + ring + _ = ∑ e ∈ A, (e.card)! * (n - e.card)! := by + rw [disjointcardinalityunion] + exact (Finset.univ.sum_disjiUnion M (by simp [pairwisedisjointM])).symm + _ = ∑ e ∈ A, (Finset.univ : Finset (TopDownChainSplitThrough n e)).card := by + apply Finset.sum_congr + simp + intro e _ + exact Eq.symm (cardinality_ChainSplitThrough e) + _ = ∑ e ∈ A, (embedded_chains e).card := by + apply Finset.sum_congr + simp + intro e _ + rw [embedded_chains_cardinality, cardinality_ChainThrough e] + _ = chains_through_A.card := (Finset.card_disjiUnion A embedded_chains hf).symm + _ ≤ (Finset.univ : Finset (TopDownChain n)).card := by + have : chains_through_A ⊆ (Finset.univ : Finset (TopDownChain n)) := by simp + exact Finset.card_mono this + _ = (n)! := cardinality_TopDownChain n + + have div_helper (a b c : ℚ) : 1 / (a / (b * c)) = b * c * (1 / a) := by rw [←div_eq_mul_one_div (b * c) a]; simp + + have : A.card / (n.choose (n / 2) : ℚ) ≤ 1 := by + calc + A.card / ↑(n.choose (n / 2)) = (∑ (k : Fin (n + 1)), ↑(m k)) * (1 / (n.choose (n / 2) : ℚ)) := by rw [div_eq_mul_one_div, cardassum]; norm_num + _ = ∑ (k : Fin (n + 1)), ↑(m k) * (1 / ↑(n.choose (n / 2))) := by rw [Finset.sum_mul] + _ ≤ ∑ (k : Fin (n + 1)), ↑(m k) * (1 / ↑(n.choose k)) := by + apply Finset.sum_le_sum + intros k _ + rw [←div_eq_mul_one_div, ←div_eq_mul_one_div, div_le_div_iff] + norm_cast + apply mul_le_mul_left (m k) + exact Nat.choose_le_middle k n + · norm_num + exact Nat.choose_pos (Nat.div_le_self n 2) + · norm_num + exact Nat.choose_pos (Nat.le_of_lt_succ k.isLt) + _ = ∑ (k : Fin (n + 1)), (m k) * (k)! * (n - k)! * (1 / (n)! : ℚ) := by + apply Finset.sum_congr + rfl + intro x _ + rw [Nat.choose_eq_factorial_div_factorial, mul_assoc, mul_assoc] + congr + rw [←mul_assoc, ←(div_helper (n)! (↑x)! (n - ↑x)!)] + congr + have xlen : ↑x ≤ n := Nat.le_of_lt_succ x.isLt + + have choose_divisibility (a b : ℕ) (h : a ≤ b) : ((a)! * (b - a)!) ∣ (b)! := by + use b.choose a + rw [Nat.mul_comm, ←Nat.mul_assoc] + exact (Nat.choose_mul_factorial_mul_factorial h).symm + + rw [Nat.cast_div (choose_divisibility ↑x n xlen), Nat.cast_mul] + · norm_num + constructor <;> apply Nat.factorial_ne_zero + · exact Nat.le_of_lt_succ x.isLt + _ = (∑ (k : Fin (n + 1)), (m k) * (k)! * (n - k)!) * (1 / (n)! : ℚ) := by rw [←Finset.sum_mul]; norm_num + _ ≤ (n)! * (1 / (n)! : ℚ) := by + apply mul_le_mul + exact cast_le.mpr central_inequality + simp + simp + simp + _ ≤ 1 := by field_simp + + have choose_pos : (0 : ℚ) < (n.choose (n / 2) : ℚ) := by + apply cast_lt.mpr + apply Nat.choose_pos + apply Nat.div_le_self + + exact cast_le.mp ((div_le_one choose_pos).mp this) + +end chapter30 From 410ee701ad56d0002cb38385b024a1e1402ce1f2 Mon Sep 17 00:00:00 2001 From: Jakob Zimmermann Date: Mon, 16 Dec 2024 23:24:56 +0100 Subject: [PATCH 02/26] Added the sketch for a second implementation of Sperner's Theorem using more mathlib functionality. --- TheBook/Sperner.lean | 487 ++++++++++++++++++ ...n => Sperner_handcrafted_definitions.lean} | 5 +- TheBook/ToMathlib/IndependentSet.lean | 2 - elan-init.sh | 378 ++++++++++++++ 4 files changed, 867 insertions(+), 5 deletions(-) create mode 100644 TheBook/Sperner.lean rename TheBook/{SpernerProof.lean => Sperner_handcrafted_definitions.lean} (99%) create mode 100755 elan-init.sh diff --git a/TheBook/Sperner.lean b/TheBook/Sperner.lean new file mode 100644 index 0000000..bc4e17e --- /dev/null +++ b/TheBook/Sperner.lean @@ -0,0 +1,487 @@ +/- +Copyright 2022 Google LLC + +Licensed under the Apache License, Version 2.0 (the "License"); +you may not use this file except in compliance with the License. +You may obtain a copy of the License at + + https://www.apache.org/licenses/LICENSE-2.0 + +Unless required by applicable law or agreed to in writing, software +distributed under the License is distributed on an "AS IS" BASIS, +WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. +See the License for the specific language governing permissions and +limitations under the License. + +Authors: Moritz Firsching, Jakob Zimmermann +-/ +import Mathlib.Tactic +import Mathlib.Combinatorics.Enumerative.DoubleCounting +import Mathlib.Combinatorics.Derangements.Finite +import Mathlib.Logic.Equiv.Defs +import Mathlib.Data.Set.Basic +import Mathlib.Data.Finset.Slice +import Mathlib.Order.Antichain +import Mathlib.Order.Chain + +/-! +# Proof of the LYM inequality and some observations on chains wrt the subset order +-/ + +open Function Finset Nat Set BigOperators + +variable {α : Type*} {n m : ℕ} {𝒜 : Finset (Finset α)} {𝒞 : Set (Finset α)} + +namespace Finset + +structure MaxChainThrough (ℬ : Finset (Finset α)) where + 𝒜 : Finset (Finset α) + isMaxChain : IsMaxChain (· ⊂ ·) (𝒜 : Set (Finset α)) + superChain : SuperChain (· ⊂ ·) (ℬ : Set (Finset α)) (𝒜 : Set (Finset α)) + +instance instFintypeMaxChainThrough {ℬ : Finset (Finset α)} : Fintype (MaxChainThrough ℬ) := by sorry + +lemma IsChain.equivalence_subset_relations : (IsChain (· ⊆ .) 𝒞) ↔ (IsChain (· ⊂ .) 𝒞) := by + constructor + · intro h e₁ e₁mem e₂ e₂mem e₁neqe₂ + cases h e₁mem e₂mem e₁neqe₂ with + | inl e₁sube₂ => + left + exact Finset.ssubset_iff_subset_ne.mpr ⟨e₁sube₂, e₁neqe₂⟩ + | inr e₂sube₁ => + right + exact Finset.ssubset_iff_subset_ne.mpr ⟨e₂sube₁, e₁neqe₂.symm⟩ + · intro h e₁ e₁mem e₂ e₂mem e₁neqe₂ + cases h e₁mem e₂mem e₁neqe₂ with + | inl e₁sube₂ => + left + exact e₁sube₂.left + | inr e₂sube₁ => + right + exact e₂sube₁.left + +lemma IsMaxChain.equivalence_subset_relations : (IsMaxChain (· ⊆ .) 𝒞) ↔ (IsMaxChain (· ⊂ .) 𝒞) := by sorry +lemma SuperChain.equivalence_subset_relations {ℬ : Finset (Finset α)} : (SuperChain (· ⊆ .) ℬ 𝒞) ↔ (SuperChain (· ⊂ .) ℬ 𝒞) := by sorry + +/-- In a chain with respect to the subset order there can not be two sets of same cardinality -/ +lemma IsChain.unique_of_cardinality_chain (chain𝒞 : IsChain (· ⊂ ·) 𝒞) {a b : Finset α} + (amem : a ∈ 𝒞) (bmem : b ∈ 𝒞) (hcard : a.card = b.card) : a = b := by + by_contra aneb + cases chain𝒞 amem bmem aneb with + | inl h => + have := Finset.card_strictMono h + linarith + | inr h => + have := Finset.card_strictMono h + linarith + +/-- In a chain with respect to the subset order there can be at most one set of a given cardinality -/ +lemma IsChain.max_one_elt_chain_layer (chain𝒜 : IsChain (· ⊂ ·) (𝒜 : Set (Finset α))) (j : Finset.range (n + 1)) : #(𝒜 # j) ≤ 1 := by + by_contra! ass + have : (𝒜 # j) ≠ (∅ : Finset (Finset α)) := by + intro assempty + have := Finset.card_eq_zero.mpr assempty + linarith + obtain ⟨a, amem⟩ := Finset.nonempty_iff_ne_empty.mpr this + obtain ⟨b, ⟨bmem, aneb⟩⟩ := Finset.exists_mem_ne ass a + have cardeqab : #a = #b := by rw [(Finset.mem_slice.mp amem).right, (Finset.mem_slice.mp bmem).right] + exact aneb (IsChain.unique_of_cardinality_chain chain𝒜 (Finset.slice_subset bmem) (Finset.slice_subset amem) cardeqab.symm) + +/-- If a chain intersects a layer of the boolean lattice this intersection is a singleton -/ +lemma layer_singleton_of_nonempty (chain𝒜 : IsChain (· ⊂ ·) (𝒜 : Set (Finset α))) (j : Finset.range (n + 1)) (layer_nonempty : (𝒜 # j) ≠ ∅): + ∃! e : Finset α, 𝒜 # j = {e} := by + have : # (𝒜 # j) = 1 := by + cases Nat.le_one_iff_eq_zero_or_eq_one.mp (IsChain.max_one_elt_chain_layer chain𝒜 j) with + | inl card_zero => + simp at card_zero + exact False.elim (layer_nonempty card_zero) + | inr card_one => exact card_one + obtain ⟨e, he⟩ := Finset.card_eq_one.mp this + have unique : ∀ a : Finset α, 𝒜 # j = {a} → a = e := by + intro a ha + rw [he] at ha + simp at ha + exact ha.symm + + exact ⟨e, he, unique⟩ + +lemma IsChain.ssubset_of_lt_cardinality (chain𝒞 : IsChain (· ⊂ ·) 𝒞) {e₁ e₂ : Finset α} (e₁mem : e₁ ∈ 𝒞) (e₂mem : e₂ ∈ 𝒞) + (hcard : e₁.card < e₂.card) : e₁ ⊂ e₂ := by + have e₁nee₂ : e₁ ≠ e₂ := by + intro ass + have : e₁.card = e₂.card := by rw [ass] + linarith + cases chain𝒞 e₁mem e₂mem e₁nee₂ with + | inl h => exact Finset.ssubset_iff_subset_ne.mpr ⟨h.left, e₁nee₂⟩ + | inr h => + have : e₂.card < e₁.card := Finset.card_strictMono h + linarith + +lemma IsChain.subset_of_le_cardinality (chain𝒞 : IsChain (· ⊂ ·) 𝒞) {e₁ e₂ : Finset α} (e₁mem : e₁ ∈ 𝒞) (e₂mem : e₂ ∈ 𝒞) + (hcard : e₁.card ≤ e₂.card) : e₁ ⊆ e₂ := by + cases Nat.eq_or_lt_of_le hcard with + | inr hcard_lt => + exact (IsChain.ssubset_of_lt_cardinality chain𝒞 e₁mem e₂mem hcard_lt).left + | inl hcard_eq => + exact Finset.subset_of_eq (IsChain.unique_of_cardinality_chain chain𝒞 e₁mem e₂mem hcard_eq) + + + +variable [Fintype α] [DecidableEq α] [DecidableEq (Set (Finset α))] + +def chain_extension_filter_function (𝒜 : Finset (Finset α)) (e : Finset α) : α → Prop := + fun a : α ↦ IsChain (· ⊂ ·) (insert (insert a e) (𝒜 : Set (Finset α))) ∧ insert a e ∉ (𝒜 : Set (Finset α)) + +instance instDecidablePredChainExtension (e : Finset α) : + DecidablePred (chain_extension_filter_function 𝒜 e) := by sorry + +lemma chain_extension (hn : Fintype.card α = n) {i j : Finset.range (n + 1)} (iltj : i < j) (chain𝒜 : IsChain (· ⊂ ·) (𝒜 : Set (Finset α))) + (hi : (𝒜 # i) = {layer_i}) (hj : (𝒜 # j) = {layer_j}) (emptylayer : ∀ l ∈ (Finset.range (n + 1)), i < l → l < j → #(𝒜 # l) = 0): + Finset.filter (chain_extension_filter_function 𝒜 layer_i) (Finset.univ : Finset α) = layer_j \ layer_i := by + have layer_j_mem : layer_j ∈ 𝒜 := by + apply (slice_subset : 𝒜 # j ⊆ 𝒜) + rw [hj] + exact Finset.mem_singleton.mpr rfl + + have layer_i_mem : layer_i ∈ 𝒜 := by + apply (slice_subset : 𝒜 # i ⊆ 𝒜) + rw [hi] + exact Finset.mem_singleton.mpr rfl + + have layer_i_card : layer_i.card = i := by + have := Finset.mem_singleton_self layer_i + simp [←hi, slice] at this + exact this.right + have layer_j_card : layer_j.card = j := by + have := Finset.mem_singleton_self layer_j + simp [←hj, slice] at this + exact this.right + + ext x + let e_new := insert x layer_i + have he_new : e_new = insert x layer_i := rfl + + have e_new_card_le_layer_j_card: e_new.card ≤ layer_j.card := by + + rw [layer_j_card] + have : #e_new ≤ #layer_i + 1 := by + rw [he_new] + exact Finset.card_insert_le x layer_i + rw [layer_i_card] at this + apply Nat.le_trans this + exact Nat.succ_le_of_lt iltj + + constructor + · intro hx + simp [chain_extension_filter_function] at hx + + simp [←he_new] at hx + have e_new_neq_layer_j : e_new ≠ layer_j := by + intro ass + rw [←ass] at layer_j_mem + exact hx.right layer_j_mem + simp + constructor + · have e_new_mem : e_new ∈ insert e_new (𝒜 : Set (Finset α)) := by simp + have layer_j_mem_insert : layer_j ∈ insert e_new (𝒜 : Set (Finset α)) := by + simp + right + exact layer_j_mem + have e_new_sub_layer_j := IsChain.subset_of_le_cardinality hx.left e_new_mem layer_j_mem_insert e_new_card_le_layer_j_card + rw [he_new] at e_new_sub_layer_j + exact e_new_sub_layer_j (mem_insert_self x layer_i) + · intro x_mem_layer_i + have : e_new = layer_i := Finset.insert_eq_self.mpr x_mem_layer_i + rw [←this] at layer_i_mem + exact hx.right layer_i_mem + · intro hx + simp at hx + simp [chain_extension_filter_function] + constructor + · intro e₁ e₁mem e₂ e₂mem e₁neqe₂ + simp [←he_new] at e₁mem e₂mem + simp + cases e₁mem with + | inl e₁_new => + cases e₂mem with + | inl e₂_new => + rw [←e₂_new] at e₁_new + left + exact Finset.ssubset_iff_subset_ne.mpr ⟨Finset.subset_of_eq e₁_new, e₁neqe₂⟩ + | inr e₂_not_new => + have := chain𝒜 layer_i_mem e₂_not_new + by_cases h : layer_i = e₂ + · right + rw [←h, e₁_new, he_new] + apply Finset.ssubset_iff_subset_ne.mpr + constructor + · simp + · exact (Finset.insert_ne_self.mpr hx.right).symm + · cases chain𝒜 e₂_not_new layer_i_mem (fun q => h q.symm) with + | inl e₂_sub_layer_i => + right + simp at e₂_sub_layer_i + rw [e₁_new, he_new] + refine Finset.ssubset_of_ssubset_of_subset e₂_sub_layer_i _ + exact Finset.ssubset_iff_subset_ne.mpr ⟨Finset.subset_insert x layer_i, (Finset.insert_ne_self.mpr hx.right).symm⟩ + | inr layer_i_sub_e₂ => + simp at layer_i_sub_e₂ + left + by_contra e₂_sub_e₁ + + have e₁_sub_e₂ : e₁ ⊆ e₂ := by + rw [e₁_new, he_new] + have layer_j_card_le_e₂_card : #layer_j ≤ #e₂ := by + rw [layer_j_card] + by_contra! + have e₂_card_gt_i : #e₂ > ↑i := by + rw [←layer_i_card] + exact Finset.card_strictMono layer_i_sub_e₂ + have e₂_card_lt_n_succ : #e₂ < n + 1 := by + apply Nat.lt_succ_of_le + rw [←hn] + apply Finset.card_le_univ + have e₂_empty_layer := emptylayer #e₂ (by simp; exact e₂_card_lt_n_succ) e₂_card_gt_i this + simp at e₂_empty_layer + have : e₂ ∈ 𝒜 # #e₂ := by simpa [slice] + simp [e₂_empty_layer] at this + + have layer_j_sub_e₂ := IsChain.subset_of_le_cardinality chain𝒜 layer_j_mem e₂_not_new layer_j_card_le_e₂_card + + apply Finset.insert_subset + · exact layer_j_sub_e₂ hx.left + · have : #layer_i ≤ #e₂ := by + rw [layer_i_card] + rw [layer_j_card] at layer_j_card_le_e₂_card + exact Nat.le_trans (Nat.le_of_lt iltj) layer_j_card_le_e₂_card + + exact IsChain.subset_of_le_cardinality chain𝒜 layer_i_mem e₂_not_new this + + have : ¬(e₁ ⊆ e₂ ∧ e₁ ≠ e₂) := fun q => e₂_sub_e₁ (Finset.ssubset_iff_subset_ne.mpr q) + simp at this + exact e₁neqe₂ (this e₁_sub_e₂) + + | inr e₁_not_new => sorry + · --rw [←he_new] + intro e_new_mem_𝒜 + sorry + + +lemma one_elt_max_chain_layer (hn : Fintype.card α = n) (maxchain𝒜 : IsMaxChain (· ⊂ ·) (𝒜 : Set (Finset α))) (j : Finset.range (n + 1)) : #(𝒜 # j) = 1 := by + by_contra! ass + have empty_layer : 𝒜 # j = ∅ := by + cases Nat.le_one_iff_eq_zero_or_eq_one.mp (IsChain.max_one_elt_chain_layer maxchain𝒜.left j) with + | inl h => simp at h; exact h + | inr h => omega + + if htop : ∀ i : Finset.range (n + 1), i > j → 𝒜 # i = ∅ then + have univnotin𝒜 : (Finset.univ : Finset α) ∉ 𝒜 := by + intro ass₂ + have nslicemem : (Finset.univ : Finset α) ∈ 𝒜 # n := by + simp [Finset.slice] + exact ⟨ass₂, hn⟩ + cases Nat.lt_or_ge j n with + | inl jltn => + have nsliceempty : 𝒜 # n = ∅ := htop ⟨n, Finset.mem_range.mpr (Nat.lt_succ_self n)⟩ jltn + simp [nsliceempty] at nslicemem + | inr jgen => + have jeqn : j = n := Nat.eq_of_le_of_lt_succ jgen (Finset.mem_range.1 (by simp)) + rw [jeqn] at empty_layer + simp [empty_layer] at nslicemem + simp [IsMaxChain] at maxchain𝒜 + have larger_chain_with_univ : IsChain (· ⊂ ·) ((Insert.insert (Finset.univ : Finset α) 𝒜) : Set (Finset α)) := by + refine' IsChain.insert maxchain𝒜.left _ + intro b bmem bneq + right + exact Finset.ssubset_iff_subset_ne.mpr ⟨by simp, fun h => bneq h.symm⟩ + + have univin𝒜 := Set.insert_eq_self.mp (maxchain𝒜.right larger_chain_with_univ (by simp)).symm + exact univnotin𝒜 univin𝒜 + else if hbottom : ∀ i : Finset.range (n + 1), i < j → 𝒜 # i = ∅ then + have emptynotin𝒜 : (∅ : Finset α) ∉ 𝒜 := by + intro ass₃ + have zeroslicemem : (∅ : Finset α) ∈ 𝒜 # 0 := by + simp [Finset.slice] + exact ass₃ + cases Nat.eq_zero_or_pos j with + | inl jeqzero => + rw [jeqzero] at empty_layer + simp [empty_layer] at zeroslicemem + | inr jgen => + simp [hbottom ⟨0, by simp⟩ jgen] at zeroslicemem + simp [IsMaxChain] at maxchain𝒜 + have larger_chain_with_empty : IsChain (· ⊂ ·) ((Insert.insert (∅ : Finset α) 𝒜) : Set (Finset α)) := by + refine' IsChain.insert maxchain𝒜.left _ + intro b bmem bneq + left + exact Finset.ssubset_iff_subset_ne.mpr ⟨by simp, bneq⟩ + + have emptyin𝒜 := Set.insert_eq_self.mp (maxchain𝒜.right larger_chain_with_empty (by simp)).symm + exact emptynotin𝒜 emptyin𝒜 + + else + simp at htop hbottom + let indices_nonempty_top := Finset.filter (fun i : Finset.range (n + 1) ↦ i > j ∧ 𝒜 # i ≠ ∅) (Finset.univ : Finset (Finset.range (n + 1))) + let indices_nonempty_bottom := Finset.filter (fun i : Finset.range (n + 1) ↦ i < j ∧ 𝒜 # i ≠ ∅) (Finset.univ : Finset (Finset.range (n + 1))) + have nonempty_indices_nonempty_top : indices_nonempty_top.Nonempty := by + simp [Finset.Nonempty] + obtain ⟨i, ⟨⟨ilen, jlti⟩, jlayernotempty⟩⟩ := htop + use i + simp [indices_nonempty_top] + constructor + · use ilen + · exact jlayernotempty + + have nonempty_indices_nonempty_bottom : indices_nonempty_bottom.Nonempty := by + simp [Finset.Nonempty] + obtain ⟨i, ⟨⟨ilen, iltj⟩, jlayernotempty⟩⟩ := hbottom + use i + simp [indices_nonempty_bottom] + constructor + · use ilen + · exact jlayernotempty + + obtain ⟨s_top, s_top_min⟩ := Finset.min_of_nonempty nonempty_indices_nonempty_top + have h_s_top := Finset.mem_of_min s_top_min + simp [indices_nonempty_top] at h_s_top + + obtain ⟨s_bottom, s_bottom_max⟩ := Finset.max_of_nonempty nonempty_indices_nonempty_bottom + have h_s_bottom := Finset.mem_of_max s_bottom_max + simp [indices_nonempty_bottom] at h_s_bottom + + have emptylayer : ∀ l ∈ (Finset.range (n + 1)), s_bottom < l → l < s_top → #(𝒜 # l) = 0 := by + intro l lmem s_bottom_lt_l l_lt_s_top + + have h_top : ⟨l, lmem⟩ ∉ indices_nonempty_top := Finset.not_mem_of_lt_min l_lt_s_top s_top_min + have h_bottom : ⟨l, lmem⟩ ∉ indices_nonempty_bottom := Finset.not_mem_of_max_lt s_bottom_lt_l s_bottom_max + + simp [indices_nonempty_top] at h_top + simp [indices_nonempty_bottom] at h_bottom + + simp + + by_cases jeql : j = ⟨l, lmem⟩ + · rw [←empty_layer, jeql] + · cases (Nat.lt_or_gt_of_ne (fun ass : ↑j = l => jeql (by simp [←ass]))) with + | inl jltl => exact h_top jltl + | inr jgtl => exact h_bottom jgtl + + let e_bottom := (layer_singleton_of_nonempty maxchain𝒜.left s_bottom h_s_bottom.right).choose + have bottom_singleton : 𝒜 # s_bottom = {e_bottom} := (layer_singleton_of_nonempty maxchain𝒜.left s_bottom h_s_bottom.right).choose_spec.left + + let e_top := (layer_singleton_of_nonempty maxchain𝒜.left s_top h_s_top.right).choose + have top_singleton : 𝒜 # s_top = {e_top} := (layer_singleton_of_nonempty maxchain𝒜.left s_top h_s_top.right).choose_spec.left + + let chain_extension_candidates := Finset.filter (chain_extension_filter_function 𝒜 e_bottom) (Finset.univ : Finset α) + + have chain_extension_candidates_eq : chain_extension_candidates = e_top \ e_bottom := + chain_extension hn (Nat.lt_trans h_s_bottom.left h_s_top.left) maxchain𝒜.left bottom_singleton top_singleton emptylayer + simp at chain_extension_candidates_eq + + have e_bottom_mem_card : e_bottom ∈ 𝒜 ∧ e_bottom.card = s_bottom := by + have := Finset.mem_singleton_self e_bottom + rw [←bottom_singleton] at this + simp [slice] at this + exact this + + have e_top_mem_card : e_top ∈ 𝒜 ∧ e_top.card = s_top := by + have := Finset.mem_singleton_self e_top + rw [←top_singleton] at this + simp [slice] at this + exact this + + have chain_extension_candidates_ne_empty : chain_extension_candidates.card > 0 := by + rw [chain_extension_candidates_eq] + have card_bottom_lt_card_top : e_bottom.card < e_top.card := by + rw [e_top_mem_card.right, e_bottom_mem_card.right] + exact Nat.lt_trans h_s_bottom.left h_s_top.left + have bottom_subset_top : e_bottom ⊂ e_top := + IsChain.ssubset_of_lt_cardinality maxchain𝒜.left e_bottom_mem_card.left e_top_mem_card.left card_bottom_lt_card_top + have := Finset.card_sdiff_add_card_eq_card bottom_subset_top.left + linarith + simp at chain_extension_candidates_ne_empty + obtain ⟨a, ha⟩ := chain_extension_candidates_ne_empty + simp [chain_extension_candidates, chain_extension_filter_function] at ha + have := Set.insert_eq_self.mp (maxchain𝒜.right ha.left (by simp)).symm + exact ha.right this + + +lemma card_maxChainThrough {ℬ : Finset (Finset α)} (hn : Fintype.card α = n) (chain : MaxChainThrough ℬ) : #chain.𝒜 = n + 1 := by + rw [←sum_card_slice chain.𝒜] + calc + ∑ r ∈ Iic (Fintype.card α), #(chain.𝒜 # r) = ∑ r ∈ Iic (Fintype.card α), 1 := by + apply Finset.sum_congr (by rfl) + intro j jmem + simp [hn] at jmem + exact one_elt_max_chain_layer hn chain.isMaxChain ⟨j, by simp [Nat.lt_succ_of_le jmem]⟩ + _ = n + 1 := by rw [←(Finset.card_eq_sum_ones (Iic (Fintype.card α)))]; simp [hn] + +lemma count_maxChainsThrough {c : ℕ → ℕ} (monc : Monotone c) (hcn : c m = n) + (ℬ : Finset (Finset α)) (cardℬ : ℬ.card = m) (chainℬ : IsChain (· ⊂ ·) (ℬ : Set (Finset α))) (cardsℬ : Finset.image Finset.card ℬ = Finset.image c (Finset.range m)) : + Fintype.card (ℬ.MaxChainThrough) = ∏ j : Fin m, (c (j + 1) - c j)! := by + induction n - m generalizing n m ℬ with + | zero => sorry + | succ s ih => sorry + +lemma count_maxChains_through_singleton (e : Finset α) (hn : Fintype.card α = n): Fintype.card (MaxChainThrough {e}) = (#e)! * (n - #e)! := by sorry + +/-- The **Lubell-Yamamoto-Meshalkin inequality**. Sperner's Theorem follows as in Mathlib.Combinatorics.SetFamily.LYM as a corollary -/ +theorem lym_inequality (antichain𝒜 : IsAntichain (· ⊂ ·) (𝒜 : Set (Finset α))) (hn : Fintype.card α = n): + ∑ k ∈ Iic n, #(𝒜 # k) / (n.choose k : ℚ) ≤ (1 : ℚ) := by + have : ∑ k ∈ Iic n, #(𝒜 # k) / (n.choose k : ℚ) ≤ (∑ k ∈ Iic n, #(𝒜 # k) * (k)! * (n - k)!) * (1 / (n)! : ℚ) := by + calc + ∑ k ∈ Iic n, #(𝒜 # k) / (n.choose k : ℚ) = ∑ k ∈ Iic n, #(𝒜 # k) * (k)! * (n - k)! * (1 / (n)! : ℚ) := by + apply Finset.sum_congr (by simp) + intro j jmem + simp at jmem + rw [div_eq_mul_inv, mul_assoc, mul_assoc, Nat.choose_eq_factorial_div_factorial] + congr + field_simp + + have choose_divisibility (a b : ℕ) (h : a ≤ b) : ((a)! * (b - a)!) ∣ (b)! := by + use b.choose a + rw [Nat.mul_comm, ←Nat.mul_assoc] + exact (Nat.choose_mul_factorial_mul_factorial h).symm + + rw [Nat.cast_div (choose_divisibility j n jmem), Nat.cast_mul] + · field_simp + · norm_num + constructor <;> apply Nat.factorial_ne_zero + · exact jmem + _ = (∑ k ∈ Iic n, #(𝒜 # k) * (k)! * (n - k)!) * (1 / (n)! : ℚ) := by simp [←Finset.sum_mul] + rfl + + refine' le_trans this _ + rw [mul_one_div] + apply (div_le_one (by simp [Nat.factorial_pos n])).mpr + + norm_cast + + have slice_partition : Finset.disjiUnion (Iic n) 𝒜.slice (Finset.pairwiseDisjoint_slice.subset (Set.subset_univ _)) = (𝒜 : Finset (Finset α)) := by + rw [Finset.disjiUnion_eq_biUnion (Iic n) 𝒜.slice (Finset.pairwiseDisjoint_slice.subset (Set.subset_univ _))] + rw [←hn] + simp [biUnion_slice 𝒜] + + calc + ∑ k ∈ Iic n, #(𝒜 # k) * (k)! * (n - k)! = ∑ k ∈ Iic n, ∑ e ∈ (𝒜 # k), (#e)! * (n - #e)! := by + apply Finset.sum_congr (by simp) + intro k _ + have hq : ∀ e ∈ (𝒜 # k), (#e)! * (n - #e)! = (k)! * (n - k)! := by + intro e he + simp [slice] at he + rw [he.2] + rw [Finset.sum_congr rfl hq, Finset.sum_const] + ring + _ = ∑ e ∈ 𝒜, (#e)! * (n - #e)! := by + conv => + rhs + rw [←slice_partition] + apply Eq.symm + apply sum_disjiUnion + _ = ∑ e ∈ 𝒜, Fintype.card (MaxChainThrough {e}) := by + apply Finset.sum_congr (by simp) + intro e _ + apply Eq.symm + exact count_maxChains_through_singleton e hn + _ ≤ (n)! := by sorry + --here one must embedd the chains into some common space for counting as solved in 'Sperner_handcrafted_definitions.lean' with the function 'f_embedded_chains' diff --git a/TheBook/SpernerProof.lean b/TheBook/Sperner_handcrafted_definitions.lean similarity index 99% rename from TheBook/SpernerProof.lean rename to TheBook/Sperner_handcrafted_definitions.lean index 8d49473..d9e7e32 100644 --- a/TheBook/SpernerProof.lean +++ b/TheBook/Sperner_handcrafted_definitions.lean @@ -20,7 +20,6 @@ import Mathlib.Combinatorics.Enumerative.DoubleCounting import Mathlib.Combinatorics.Derangements.Finite import Mathlib.Logic.Equiv.Defs import Mathlib.Data.Set.Basic -import FormalBook.Chapter_28 /-! # Three famous lemmas on finite sets @@ -120,7 +119,7 @@ lemma permutation_to_edge_cardinality {n : ℕ} (π : Equiv.Perm (Fin n)) : ∀ def permutation_to_chain {n : ℕ} (π : Equiv.Perm (Fin n)) : Finset (Finset (Fin n)) := Finset.image (fun (j : Fin (n + 1)) => permutation_to_edge j π) (Finset.univ : Finset (Fin (n + 1))) -lemma subset_from_permutation_injective {n : ℕ} {π : Equiv.Perm (Fin n)} : Injective (fun (k : Fin (n + 1)) => permutation_to_edge k π) := by +lemma permutation_to_edge_injective {n : ℕ} {π : Equiv.Perm (Fin n)} : Injective (fun (k : Fin (n + 1)) => permutation_to_edge k π) := by rw [Injective] intro a₁ a₂ h have : a₁.val = a₂.val := by @@ -159,7 +158,7 @@ def permutation_to_top_down_chain (n : ℕ) (π : Equiv.Perm (Fin n)) : TopDownC rw [permutation_to_chain] rw [Finset.card_image_of_injective] · simp - · exact subset_from_permutation_injective + · exact permutation_to_edge_injective } /- diff --git a/TheBook/ToMathlib/IndependentSet.lean b/TheBook/ToMathlib/IndependentSet.lean index 2d01ff3..efdede5 100644 --- a/TheBook/ToMathlib/IndependentSet.lean +++ b/TheBook/ToMathlib/IndependentSet.lean @@ -13,8 +13,6 @@ An independent set is a set of vertices that are pairwise nonadjacent. -/ - - open Finset Fintype Function namespace SimpleGraph diff --git a/elan-init.sh b/elan-init.sh new file mode 100755 index 0000000..d4d978d --- /dev/null +++ b/elan-init.sh @@ -0,0 +1,378 @@ +#!/bin/sh +# Copyright 2016 The Rust Project Developers. See the COPYRIGHT +# file at the top-level directory of this distribution and at +# http://rust-lang.org/COPYRIGHT. +# +# Licensed under the Apache License, Version 2.0 or the MIT license +# , at your +# option. This file may not be copied, modified, or distributed +# except according to those terms. + +# This is just a little script that can be downloaded from the internet to +# install elan. It just does platform detection, downloads the installer +# and runs it. + +set -u + +ELAN_UPDATE_ROOT="https://github.com/leanprover/elan/releases" + +#XXX: If you change anything here, please make the same changes in setup_mode.rs +usage() { + cat 1>&2 < Choose a default toolchain + --default-toolchain none Do not set a default toolchain +EOF +} + +main() { + need_cmd curl + need_cmd awk + need_cmd uname + need_cmd mktemp + need_cmd chmod + need_cmd mkdir + need_cmd rm + need_cmd rmdir + + get_architecture || return 1 + local _arch="$RETVAL" + assert_nz "$_arch" "arch" + + local _ext="" + case "$_arch" in + *windows*) + _ext=".exe" + ;; + esac + + local _dir="$(mktemp -d 2>/dev/null || ensure mktemp -d -t elan)" + local _file="$_dir/elan-init$_ext" + + local _ansi_escapes_are_valid=false + if [ -t 2 ]; then + if [ "${TERM+set}" = 'set' ]; then + case "$TERM" in + xterm*|rxvt*|urxvt*|linux*|vt*) + _ansi_escapes_are_valid=true + ;; + esac + fi + fi + + # check if we have to use /dev/tty to prompt the user + local need_tty=yes + for arg in "$@"; do + case "$arg" in + -h|--help) + usage + exit 0 + ;; + -y) + # user wants to skip the prompt -- we don't need /dev/tty + need_tty=no + ;; + *) + ;; + esac + done + + if $_ansi_escapes_are_valid; then + printf "\33[1minfo:\33[0m downloading installer\n" 1>&2 + else + printf '%s\n' 'info: downloading installer' 1>&2 + fi + + ensure mkdir -p "$_dir" + case "$_arch" in + *windows*) + ensure curl -sSfL "$ELAN_UPDATE_ROOT/latest/download/elan-$_arch.zip" > "$_dir/elan-init.zip" + (cd "$_dir"; ensure unzip elan-init.zip; ignore rm elan-init.zip) + ;; + *) + ensure curl -sSfL "$ELAN_UPDATE_ROOT/latest/download/elan-$_arch.tar.gz" > "$_dir/elan-init.tar.gz" + (cd "$_dir"; ensure tar xf elan-init.tar.gz; ignore rm elan-init.tar.gz) + ;; + esac + + ensure chmod u+x "$_file" + if [ ! -x "$_file" ]; then + printf '%s\n' "Cannot execute $_file (likely because of mounting /tmp as noexec)." 1>&2 + printf '%s\n' "Please copy the file to a location where you can execute binaries and run ./elan-init$_ext." 1>&2 + exit 1 + fi + + + + if [ "$need_tty" = "yes" ]; then + # The installer is going to want to ask for confirmation by + # reading stdin. This script was piped into `sh` though and + # doesn't have stdin to pass to its children. Instead we're going + # to explicitly connect /dev/tty to the installer's stdin. + if [ ! -t 1 ]; then + err "Unable to run interactively. Run with -y to accept defaults, --help for additional options" + fi + + ignore "$_file" "$@" < /dev/tty + else + ignore "$_file" "$@" + fi + + local _retval=$? + + ignore rm "$_file" + ignore rmdir "$_dir" + + return "$_retval" +} + +get_bitness() { + need_cmd head + # Architecture detection without dependencies beyond coreutils. + # ELF files start out "\x7fELF", and the following byte is + # 0x01 for 32-bit and + # 0x02 for 64-bit. + # The printf builtin on some shells like dash only supports octal + # escape sequences, so we use those. + local _current_exe_head=$(head -c 5 /proc/self/exe ) + if [ "$_current_exe_head" = "$(printf '\177ELF\001')" ]; then + echo 32 + elif [ "$_current_exe_head" = "$(printf '\177ELF\002')" ]; then + echo 64 + else + err "unknown platform bitness" + fi +} + +get_endianness() { + local cputype=$1 + local suffix_eb=$2 + local suffix_el=$3 + + # detect endianness without od/hexdump, like get_bitness() does. + need_cmd head + need_cmd tail + + local _current_exe_endianness="$(head -c 6 /proc/self/exe | tail -c 1)" + if [ "$_current_exe_endianness" = "$(printf '\001')" ]; then + echo "${cputype}${suffix_el}" + elif [ "$_current_exe_endianness" = "$(printf '\002')" ]; then + echo "${cputype}${suffix_eb}" + else + err "unknown platform endianness" + fi +} + +get_architecture() { + + local _ostype="$(uname -s)" + local _cputype="$(uname -m)" + + if [ "$_ostype" = Linux ]; then + if [ "$(uname -o)" = Android ]; then + local _ostype=Android + fi + if ldd --version 2>&1 | grep -q 'musl'; then + err "musl-based systems are unsupported at the moment" + fi + fi + + if [ "$_ostype" = Darwin -a "$_cputype" = i386 ]; then + # Darwin `uname -s` lies + if sysctl hw.optional.x86_64 | grep -q ': 1'; then + local _cputype=x86_64 + fi + fi + + case "$_ostype" in + + Android) + local _ostype=linux-android + ;; + + Linux) + local _ostype=unknown-linux-gnu + ;; + + FreeBSD) + local _ostype=unknown-freebsd + ;; + + NetBSD) + local _ostype=unknown-netbsd + ;; + + DragonFly) + local _ostype=unknown-dragonfly + ;; + + Darwin) + local _ostype=apple-darwin + ;; + + MINGW* | MSYS* | CYGWIN*) + local _ostype=pc-windows-msvc + ;; + + *) + err "unrecognized OS type: $_ostype" + ;; + + esac + + case "$_cputype" in + + i386 | i486 | i686 | i786 | x86) + local _cputype=i686 + ;; + + xscale | arm) + local _cputype=arm + if [ "$_ostype" = "linux-android" ]; then + local _ostype=linux-androideabi + fi + ;; + + armv6l) + local _cputype=arm + if [ "$_ostype" = "linux-android" ]; then + local _ostype=linux-androideabi + else + local _ostype="${_ostype}eabihf" + fi + ;; + + armv7l | armv8l) + local _cputype=armv7 + if [ "$_ostype" = "linux-android" ]; then + local _ostype=linux-androideabi + else + local _ostype="${_ostype}eabihf" + fi + ;; + + arm64 | aarch64) + local _cputype=aarch64 + ;; + + x86_64 | x86-64 | x64 | amd64) + local _cputype=x86_64 + ;; + + mips) + local _cputype="$(get_endianness $_cputype "" 'el')" + ;; + + mips64) + local _bitness="$(get_bitness)" + if [ $_bitness = "32" ]; then + if [ $_ostype = "unknown-linux-gnu" ]; then + # 64-bit kernel with 32-bit userland + # endianness suffix is appended later + local _cputype=mips + fi + else + # only n64 ABI is supported for now + local _ostype="${_ostype}abi64" + fi + + local _cputype="$(get_endianness $_cputype "" 'el')" + ;; + + ppc) + local _cputype=powerpc + ;; + + ppc64) + local _cputype=powerpc64 + ;; + + ppc64le) + local _cputype=powerpc64le + ;; + + *) + err "unknown CPU type: $_cputype" + + esac + + # Detect 64-bit linux with 32-bit userland + if [ $_ostype = unknown-linux-gnu -a $_cputype = x86_64 ]; then + if [ "$(get_bitness)" = "32" ]; then + local _cputype=i686 + fi + fi + + # Detect armv7 but without the CPU features Lean needs in that build, + # and fall back to arm. + # See https://github.com/rust-lang-nursery/rustup.rs/issues/587. + if [ $_ostype = "unknown-linux-gnueabihf" -a $_cputype = armv7 ]; then + if ensure grep '^Features' /proc/cpuinfo | grep -q -v neon; then + # At least one processor does not have NEON. + local _cputype=arm + fi + fi + + local _arch="$_cputype-$_ostype" + + RETVAL="$_arch" +} + +say() { + echo "elan: $1" +} + +err() { + say "$1" >&2 + exit 1 +} + +need_cmd() { + if ! check_cmd "$1" + then err "need '$1' (command not found)" + fi +} + +check_cmd() { + command -v "$1" > /dev/null 2>&1 + return $? +} + +need_ok() { + if [ $? != 0 ]; then err "$1"; fi +} + +assert_nz() { + if [ -z "$1" ]; then err "assert_nz $2"; fi +} + +# Run a command that should never fail. If the command fails execution +# will immediately terminate with an error showing the failing +# command. +ensure() { + "$@" + need_ok "command failed: $*" +} + +# This is just for indicating that commands' results are being +# intentionally ignored. Usually, because it's being executed +# as part of error handling. +ignore() { + "$@" +} + +main "$@" || exit 1 From b9ca0dc6c96d050faa3210532f91cbf5896a21c7 Mon Sep 17 00:00:00 2001 From: Jakob Zimmermann Date: Mon, 16 Dec 2024 23:26:04 +0100 Subject: [PATCH 03/26] Made new directory for Combinatorial results --- TheBook/{ => Combinatorics}/Sperner.lean | 0 TheBook/{ => Combinatorics}/Sperner_handcrafted_definitions.lean | 0 2 files changed, 0 insertions(+), 0 deletions(-) rename TheBook/{ => Combinatorics}/Sperner.lean (100%) rename TheBook/{ => Combinatorics}/Sperner_handcrafted_definitions.lean (100%) diff --git a/TheBook/Sperner.lean b/TheBook/Combinatorics/Sperner.lean similarity index 100% rename from TheBook/Sperner.lean rename to TheBook/Combinatorics/Sperner.lean diff --git a/TheBook/Sperner_handcrafted_definitions.lean b/TheBook/Combinatorics/Sperner_handcrafted_definitions.lean similarity index 100% rename from TheBook/Sperner_handcrafted_definitions.lean rename to TheBook/Combinatorics/Sperner_handcrafted_definitions.lean From f8bf564179be369956a89b3268b3256c19f33a5f Mon Sep 17 00:00:00 2001 From: Jakob Zimmermann Date: Mon, 16 Dec 2024 23:45:28 +0100 Subject: [PATCH 04/26] small correction in assumptions for chain_extension --- TheBook/Combinatorics/Sperner.lean | 6 ++++-- 1 file changed, 4 insertions(+), 2 deletions(-) diff --git a/TheBook/Combinatorics/Sperner.lean b/TheBook/Combinatorics/Sperner.lean index bc4e17e..bf3d166 100644 --- a/TheBook/Combinatorics/Sperner.lean +++ b/TheBook/Combinatorics/Sperner.lean @@ -135,7 +135,7 @@ def chain_extension_filter_function (𝒜 : Finset (Finset α)) (e : Finset α) instance instDecidablePredChainExtension (e : Finset α) : DecidablePred (chain_extension_filter_function 𝒜 e) := by sorry -lemma chain_extension (hn : Fintype.card α = n) {i j : Finset.range (n + 1)} (iltj : i < j) (chain𝒜 : IsChain (· ⊂ ·) (𝒜 : Set (Finset α))) +lemma chain_extension (hn : Fintype.card α = n) {i j : Finset.range (n + 1)} (ilej_succ_succ : (i : ℕ) + 2 ≤ ↑j) (chain𝒜 : IsChain (· ⊂ ·) (𝒜 : Set (Finset α))) (hi : (𝒜 # i) = {layer_i}) (hj : (𝒜 # j) = {layer_j}) (emptylayer : ∀ l ∈ (Finset.range (n + 1)), i < l → l < j → #(𝒜 # l) = 0): Finset.filter (chain_extension_filter_function 𝒜 layer_i) (Finset.univ : Finset α) = layer_j \ layer_i := by have layer_j_mem : layer_j ∈ 𝒜 := by @@ -143,6 +143,8 @@ lemma chain_extension (hn : Fintype.card α = n) {i j : Finset.range (n + 1)} (i rw [hj] exact Finset.mem_singleton.mpr rfl + have iltj : i < j := Nat.lt_of_succ_lt ilej_succ_succ + have layer_i_mem : layer_i ∈ 𝒜 := by apply (slice_subset : 𝒜 # i ⊆ 𝒜) rw [hi] @@ -264,7 +266,7 @@ lemma chain_extension (hn : Fintype.card α = n) {i j : Finset.range (n + 1)} (i | inr e₁_not_new => sorry · --rw [←he_new] intro e_new_mem_𝒜 - sorry + #check ilej_succ_succ lemma one_elt_max_chain_layer (hn : Fintype.card α = n) (maxchain𝒜 : IsMaxChain (· ⊂ ·) (𝒜 : Set (Finset α))) (j : Finset.range (n + 1)) : #(𝒜 # j) = 1 := by From f83d729a43fa26fc995d90c1781d18a020e501a6 Mon Sep 17 00:00:00 2001 From: Jakob Zimmermann Date: Tue, 17 Dec 2024 13:32:30 +0100 Subject: [PATCH 05/26] Finished proof of chain_extension lemma --- TheBook/Combinatorics/Sperner.lean | 166 ++++++++++++++++------------- 1 file changed, 93 insertions(+), 73 deletions(-) diff --git a/TheBook/Combinatorics/Sperner.lean b/TheBook/Combinatorics/Sperner.lean index bf3d166..6d2fcb6 100644 --- a/TheBook/Combinatorics/Sperner.lean +++ b/TheBook/Combinatorics/Sperner.lean @@ -65,7 +65,7 @@ lemma SuperChain.equivalence_subset_relations {ℬ : Finset (Finset α)} : (Supe /-- In a chain with respect to the subset order there can not be two sets of same cardinality -/ lemma IsChain.unique_of_cardinality_chain (chain𝒞 : IsChain (· ⊂ ·) 𝒞) {a b : Finset α} - (amem : a ∈ 𝒞) (bmem : b ∈ 𝒞) (hcard : a.card = b.card) : a = b := by + (amem : a ∈ 𝒞) (bmem : b ∈ 𝒞) (hcard : #a = #b) : a = b := by by_contra aneb cases chain𝒞 amem bmem aneb with | inl h => @@ -106,19 +106,19 @@ lemma layer_singleton_of_nonempty (chain𝒜 : IsChain (· ⊂ ·) (𝒜 : Set ( exact ⟨e, he, unique⟩ lemma IsChain.ssubset_of_lt_cardinality (chain𝒞 : IsChain (· ⊂ ·) 𝒞) {e₁ e₂ : Finset α} (e₁mem : e₁ ∈ 𝒞) (e₂mem : e₂ ∈ 𝒞) - (hcard : e₁.card < e₂.card) : e₁ ⊂ e₂ := by + (hcard : #e₁ < #e₂) : e₁ ⊂ e₂ := by have e₁nee₂ : e₁ ≠ e₂ := by intro ass - have : e₁.card = e₂.card := by rw [ass] + have : #e₁ = #e₂ := by rw [ass] linarith cases chain𝒞 e₁mem e₂mem e₁nee₂ with | inl h => exact Finset.ssubset_iff_subset_ne.mpr ⟨h.left, e₁nee₂⟩ | inr h => - have : e₂.card < e₁.card := Finset.card_strictMono h + have : #e₂ < #e₁ := Finset.card_strictMono h linarith lemma IsChain.subset_of_le_cardinality (chain𝒞 : IsChain (· ⊂ ·) 𝒞) {e₁ e₂ : Finset α} (e₁mem : e₁ ∈ 𝒞) (e₂mem : e₂ ∈ 𝒞) - (hcard : e₁.card ≤ e₂.card) : e₁ ⊆ e₂ := by + (hcard : #e₁ ≤ #e₂) : e₁ ⊆ e₂ := by cases Nat.eq_or_lt_of_le hcard with | inr hcard_lt => exact (IsChain.ssubset_of_lt_cardinality chain𝒞 e₁mem e₂mem hcard_lt).left @@ -150,11 +150,11 @@ lemma chain_extension (hn : Fintype.card α = n) {i j : Finset.range (n + 1)} (i rw [hi] exact Finset.mem_singleton.mpr rfl - have layer_i_card : layer_i.card = i := by + have layer_i_card : #layer_i = i := by have := Finset.mem_singleton_self layer_i simp [←hi, slice] at this exact this.right - have layer_j_card : layer_j.card = j := by + have layer_j_card : #layer_j = j := by have := Finset.mem_singleton_self layer_j simp [←hj, slice] at this exact this.right @@ -163,15 +163,14 @@ lemma chain_extension (hn : Fintype.card α = n) {i j : Finset.range (n + 1)} (i let e_new := insert x layer_i have he_new : e_new = insert x layer_i := rfl - have e_new_card_le_layer_j_card: e_new.card ≤ layer_j.card := by - + have e_new_card_lt_layer_j_card: #e_new < #layer_j := by rw [layer_j_card] have : #e_new ≤ #layer_i + 1 := by rw [he_new] exact Finset.card_insert_le x layer_i rw [layer_i_card] at this - apply Nat.le_trans this - exact Nat.succ_le_of_lt iltj + apply Nat.lt_of_le_of_lt this + exact Nat.succ_le_of_lt ilej_succ_succ constructor · intro hx @@ -189,7 +188,7 @@ lemma chain_extension (hn : Fintype.card α = n) {i j : Finset.range (n + 1)} (i simp right exact layer_j_mem - have e_new_sub_layer_j := IsChain.subset_of_le_cardinality hx.left e_new_mem layer_j_mem_insert e_new_card_le_layer_j_card + have e_new_sub_layer_j := IsChain.subset_of_le_cardinality hx.left e_new_mem layer_j_mem_insert (Nat.le_of_lt e_new_card_lt_layer_j_card) rw [he_new] at e_new_sub_layer_j exact e_new_sub_layer_j (mem_insert_self x layer_i) · intro x_mem_layer_i @@ -199,6 +198,60 @@ lemma chain_extension (hn : Fintype.card α = n) {i j : Finset.range (n + 1)} (i · intro hx simp at hx simp [chain_extension_filter_function] + + have case_helper {e₁ e₂ : Finset α} (e₁neqe₂ : e₁ ≠ e₂) (e₂_not_new : e₂ ∈ 𝒜) (e₁_new : e₁ = e_new) : e₁ ⊂ e₂ ∨ e₂ ⊂ e₁ := by + have := chain𝒜 layer_i_mem e₂_not_new + by_cases h : layer_i = e₂ + · right + rw [←h, e₁_new, he_new] + apply Finset.ssubset_iff_subset_ne.mpr + constructor + · simp + · exact (Finset.insert_ne_self.mpr hx.right).symm + · cases chain𝒜 e₂_not_new layer_i_mem (fun q => h q.symm) with + | inl e₂_sub_layer_i => + right + simp at e₂_sub_layer_i + rw [e₁_new, he_new] + refine Finset.ssubset_of_ssubset_of_subset e₂_sub_layer_i _ + exact Finset.ssubset_iff_subset_ne.mpr ⟨Finset.subset_insert x layer_i, (Finset.insert_ne_self.mpr hx.right).symm⟩ + | inr layer_i_sub_e₂ => + simp at layer_i_sub_e₂ + left + by_contra e₂_sub_e₁ + + have e₁_sub_e₂ : e₁ ⊆ e₂ := by + rw [e₁_new, he_new] + have layer_j_card_le_e₂_card : #layer_j ≤ #e₂ := by + rw [layer_j_card] + by_contra! + have e₂_card_gt_i : #e₂ > ↑i := by + rw [←layer_i_card] + exact Finset.card_strictMono layer_i_sub_e₂ + have e₂_card_lt_n_succ : #e₂ < n + 1 := by + apply Nat.lt_succ_of_le + rw [←hn] + apply Finset.card_le_univ + have e₂_empty_layer := emptylayer #e₂ (by simp; exact e₂_card_lt_n_succ) e₂_card_gt_i this + simp at e₂_empty_layer + have : e₂ ∈ 𝒜 # #e₂ := by simpa [slice] + simp [e₂_empty_layer] at this + + have layer_j_sub_e₂ := IsChain.subset_of_le_cardinality chain𝒜 layer_j_mem e₂_not_new layer_j_card_le_e₂_card + + apply Finset.insert_subset + · exact layer_j_sub_e₂ hx.left + · have : #layer_i ≤ #e₂ := by + rw [layer_i_card] + rw [layer_j_card] at layer_j_card_le_e₂_card + exact Nat.le_trans (Nat.le_of_lt iltj) layer_j_card_le_e₂_card + + exact IsChain.subset_of_le_cardinality chain𝒜 layer_i_mem e₂_not_new this + + have : ¬(e₁ ⊆ e₂ ∧ e₁ ≠ e₂) := fun q => e₂_sub_e₁ (Finset.ssubset_iff_subset_ne.mpr q) + simp at this + exact e₁neqe₂ (this e₁_sub_e₂) + constructor · intro e₁ e₁mem e₂ e₂mem e₁neqe₂ simp [←he_new] at e₁mem e₂mem @@ -211,62 +264,29 @@ lemma chain_extension (hn : Fintype.card α = n) {i j : Finset.range (n + 1)} (i left exact Finset.ssubset_iff_subset_ne.mpr ⟨Finset.subset_of_eq e₁_new, e₁neqe₂⟩ | inr e₂_not_new => - have := chain𝒜 layer_i_mem e₂_not_new - by_cases h : layer_i = e₂ - · right - rw [←h, e₁_new, he_new] - apply Finset.ssubset_iff_subset_ne.mpr - constructor - · simp - · exact (Finset.insert_ne_self.mpr hx.right).symm - · cases chain𝒜 e₂_not_new layer_i_mem (fun q => h q.symm) with - | inl e₂_sub_layer_i => - right - simp at e₂_sub_layer_i - rw [e₁_new, he_new] - refine Finset.ssubset_of_ssubset_of_subset e₂_sub_layer_i _ - exact Finset.ssubset_iff_subset_ne.mpr ⟨Finset.subset_insert x layer_i, (Finset.insert_ne_self.mpr hx.right).symm⟩ - | inr layer_i_sub_e₂ => - simp at layer_i_sub_e₂ - left - by_contra e₂_sub_e₁ - - have e₁_sub_e₂ : e₁ ⊆ e₂ := by - rw [e₁_new, he_new] - have layer_j_card_le_e₂_card : #layer_j ≤ #e₂ := by - rw [layer_j_card] - by_contra! - have e₂_card_gt_i : #e₂ > ↑i := by - rw [←layer_i_card] - exact Finset.card_strictMono layer_i_sub_e₂ - have e₂_card_lt_n_succ : #e₂ < n + 1 := by - apply Nat.lt_succ_of_le - rw [←hn] - apply Finset.card_le_univ - have e₂_empty_layer := emptylayer #e₂ (by simp; exact e₂_card_lt_n_succ) e₂_card_gt_i this - simp at e₂_empty_layer - have : e₂ ∈ 𝒜 # #e₂ := by simpa [slice] - simp [e₂_empty_layer] at this - - have layer_j_sub_e₂ := IsChain.subset_of_le_cardinality chain𝒜 layer_j_mem e₂_not_new layer_j_card_le_e₂_card - - apply Finset.insert_subset - · exact layer_j_sub_e₂ hx.left - · have : #layer_i ≤ #e₂ := by - rw [layer_i_card] - rw [layer_j_card] at layer_j_card_le_e₂_card - exact Nat.le_trans (Nat.le_of_lt iltj) layer_j_card_le_e₂_card - - exact IsChain.subset_of_le_cardinality chain𝒜 layer_i_mem e₂_not_new this - - have : ¬(e₁ ⊆ e₂ ∧ e₁ ≠ e₂) := fun q => e₂_sub_e₁ (Finset.ssubset_iff_subset_ne.mpr q) - simp at this - exact e₁neqe₂ (this e₁_sub_e₂) - - | inr e₁_not_new => sorry - · --rw [←he_new] - intro e_new_mem_𝒜 - #check ilej_succ_succ + exact case_helper e₁neqe₂ e₂_not_new e₁_new + | inr e₁_not_new => + cases e₂mem with + | inl e₂_new => + apply Or.symm + exact case_helper e₁neqe₂.symm e₁_not_new e₂_new + | inr e₂_not_new => + exact chain𝒜 e₁_not_new e₂_not_new e₁neqe₂ + + · intro e_new_mem_𝒜 + have e_new_card_gt_layer_i : #e_new > i := by simp [Finset.card_insert_of_not_mem hx.right, layer_i_card] + + rw [layer_j_card] at e_new_card_lt_layer_j_card + have : #(𝒜 # #e_new) = 0 := by + refine' emptylayer #e_new _ e_new_card_gt_layer_i e_new_card_lt_layer_j_card + · simp + exact Nat.lt_trans e_new_card_lt_layer_j_card (mem_range.mp j.property) + have : (𝒜 # #e_new).Nonempty := by + have : e_new ∈ 𝒜 # #e_new := by simpa [slice] + exact nonempty_of_mem this + have : #(𝒜 # #e_new) > 0 := Finset.card_pos.mpr this + linarith + lemma one_elt_max_chain_layer (hn : Fintype.card α = n) (maxchain𝒜 : IsMaxChain (· ⊂ ·) (𝒜 : Set (Finset α))) (j : Finset.range (n + 1)) : #(𝒜 # j) = 1 := by @@ -380,21 +400,21 @@ lemma one_elt_max_chain_layer (hn : Fintype.card α = n) (maxchain𝒜 : IsMaxCh chain_extension hn (Nat.lt_trans h_s_bottom.left h_s_top.left) maxchain𝒜.left bottom_singleton top_singleton emptylayer simp at chain_extension_candidates_eq - have e_bottom_mem_card : e_bottom ∈ 𝒜 ∧ e_bottom.card = s_bottom := by + have e_bottom_mem_card : e_bottom ∈ 𝒜 ∧ #e_bottom = s_bottom := by have := Finset.mem_singleton_self e_bottom rw [←bottom_singleton] at this simp [slice] at this exact this - have e_top_mem_card : e_top ∈ 𝒜 ∧ e_top.card = s_top := by + have e_top_mem_card : e_top ∈ 𝒜 ∧ #e_top = s_top := by have := Finset.mem_singleton_self e_top rw [←top_singleton] at this simp [slice] at this exact this - have chain_extension_candidates_ne_empty : chain_extension_candidates.card > 0 := by + have chain_extension_candidates_ne_empty : #chain_extension_candidates > 0 := by rw [chain_extension_candidates_eq] - have card_bottom_lt_card_top : e_bottom.card < e_top.card := by + have card_bottom_lt_card_top : #e_bottom < #e_top := by rw [e_top_mem_card.right, e_bottom_mem_card.right] exact Nat.lt_trans h_s_bottom.left h_s_top.left have bottom_subset_top : e_bottom ⊂ e_top := @@ -419,7 +439,7 @@ lemma card_maxChainThrough {ℬ : Finset (Finset α)} (hn : Fintype.card α = n) _ = n + 1 := by rw [←(Finset.card_eq_sum_ones (Iic (Fintype.card α)))]; simp [hn] lemma count_maxChainsThrough {c : ℕ → ℕ} (monc : Monotone c) (hcn : c m = n) - (ℬ : Finset (Finset α)) (cardℬ : ℬ.card = m) (chainℬ : IsChain (· ⊂ ·) (ℬ : Set (Finset α))) (cardsℬ : Finset.image Finset.card ℬ = Finset.image c (Finset.range m)) : + (ℬ : Finset (Finset α)) (cardℬ : #ℬ = m) (chainℬ : IsChain (· ⊂ ·) (ℬ : Set (Finset α))) (cardsℬ : Finset.image Finset.card ℬ = Finset.image c (Finset.range m)) : Fintype.card (ℬ.MaxChainThrough) = ∏ j : Fin m, (c (j + 1) - c j)! := by induction n - m generalizing n m ℬ with | zero => sorry From 93db0f8a48afb4827e016655edd031a7bd532df4 Mon Sep 17 00:00:00 2001 From: Jakob Zimmermann Date: Tue, 17 Dec 2024 13:41:19 +0100 Subject: [PATCH 06/26] fix of application of the chain_extension lemma --- TheBook/Combinatorics/Sperner.lean | 13 +++++++------ 1 file changed, 7 insertions(+), 6 deletions(-) diff --git a/TheBook/Combinatorics/Sperner.lean b/TheBook/Combinatorics/Sperner.lean index 6d2fcb6..8650a20 100644 --- a/TheBook/Combinatorics/Sperner.lean +++ b/TheBook/Combinatorics/Sperner.lean @@ -213,8 +213,8 @@ lemma chain_extension (hn : Fintype.card α = n) {i j : Finset.range (n + 1)} (i right simp at e₂_sub_layer_i rw [e₁_new, he_new] - refine Finset.ssubset_of_ssubset_of_subset e₂_sub_layer_i _ - exact Finset.ssubset_iff_subset_ne.mpr ⟨Finset.subset_insert x layer_i, (Finset.insert_ne_self.mpr hx.right).symm⟩ + refine' Finset.ssubset_of_ssubset_of_subset e₂_sub_layer_i _ + apply Finset.subset_insert | inr layer_i_sub_e₂ => simp at layer_i_sub_e₂ left @@ -287,8 +287,6 @@ lemma chain_extension (hn : Fintype.card α = n) {i j : Finset.range (n + 1)} (i have : #(𝒜 # #e_new) > 0 := Finset.card_pos.mpr this linarith - - lemma one_elt_max_chain_layer (hn : Fintype.card α = n) (maxchain𝒜 : IsMaxChain (· ⊂ ·) (𝒜 : Set (Finset α))) (j : Finset.range (n + 1)) : #(𝒜 # j) = 1 := by by_contra! ass have empty_layer : 𝒜 # j = ∅ := by @@ -396,8 +394,11 @@ lemma one_elt_max_chain_layer (hn : Fintype.card α = n) (maxchain𝒜 : IsMaxCh let chain_extension_candidates := Finset.filter (chain_extension_filter_function 𝒜 e_bottom) (Finset.univ : Finset α) - have chain_extension_candidates_eq : chain_extension_candidates = e_top \ e_bottom := - chain_extension hn (Nat.lt_trans h_s_bottom.left h_s_top.left) maxchain𝒜.left bottom_singleton top_singleton emptylayer + have chain_extension_candidates_eq : chain_extension_candidates = e_top \ e_bottom := by + refine' chain_extension hn _ maxchain𝒜.left bottom_singleton top_singleton emptylayer + apply Nat.succ_le_of_lt + have : (s_bottom : ℕ) + 1 ≤ ↑j := Nat.succ_le_of_lt h_s_bottom.left + exact Nat.lt_of_le_of_lt this h_s_top.left simp at chain_extension_candidates_eq have e_bottom_mem_card : e_bottom ∈ 𝒜 ∧ #e_bottom = s_bottom := by From d9591d7277946c7c75de84a2591c4abeacc5141e Mon Sep 17 00:00:00 2001 From: Jakob Zimmermann Date: Wed, 8 Jan 2025 11:32:45 +0100 Subject: [PATCH 07/26] Added short proofs for simple theorems regarding chains and changed statement of count_maxChainsThrough --- TheBook/Combinatorics/Sperner.lean | 49 ++++++++++++++++++------------ package-lock.json | 6 ++++ 2 files changed, 36 insertions(+), 19 deletions(-) create mode 100644 package-lock.json diff --git a/TheBook/Combinatorics/Sperner.lean b/TheBook/Combinatorics/Sperner.lean index 8650a20..0635f0d 100644 --- a/TheBook/Combinatorics/Sperner.lean +++ b/TheBook/Combinatorics/Sperner.lean @@ -45,23 +45,26 @@ lemma IsChain.equivalence_subset_relations : (IsChain (· ⊆ .) 𝒞) ↔ (IsCh constructor · intro h e₁ e₁mem e₂ e₂mem e₁neqe₂ cases h e₁mem e₂mem e₁neqe₂ with - | inl e₁sube₂ => - left - exact Finset.ssubset_iff_subset_ne.mpr ⟨e₁sube₂, e₁neqe₂⟩ - | inr e₂sube₁ => - right - exact Finset.ssubset_iff_subset_ne.mpr ⟨e₂sube₁, e₁neqe₂.symm⟩ + | inl e₁sube₂ => left; exact Finset.ssubset_iff_subset_ne.mpr ⟨e₁sube₂, e₁neqe₂⟩ + | inr e₂sube₁ => right; exact Finset.ssubset_iff_subset_ne.mpr ⟨e₂sube₁, e₁neqe₂.symm⟩ · intro h e₁ e₁mem e₂ e₂mem e₁neqe₂ cases h e₁mem e₂mem e₁neqe₂ with - | inl e₁sube₂ => - left - exact e₁sube₂.left - | inr e₂sube₁ => - right - exact e₂sube₁.left + | inl e₁sube₂ => left; exact e₁sube₂.left + | inr e₂sube₁ => right; exact e₂sube₁.left + +lemma IsMaxChain.equivalence_subset_relations : (IsMaxChain (· ⊆ .) 𝒞) ↔ (IsMaxChain (· ⊂ .) 𝒞) := by + constructor + · intro h + exact ⟨IsChain.equivalence_subset_relations.mp h.left, fun t chain => h.right (IsChain.equivalence_subset_relations.mpr chain)⟩ + · intro h + exact ⟨IsChain.equivalence_subset_relations.mpr h.left, fun t chain => h.right (IsChain.equivalence_subset_relations.mp chain)⟩ -lemma IsMaxChain.equivalence_subset_relations : (IsMaxChain (· ⊆ .) 𝒞) ↔ (IsMaxChain (· ⊂ .) 𝒞) := by sorry -lemma SuperChain.equivalence_subset_relations {ℬ : Finset (Finset α)} : (SuperChain (· ⊆ .) ℬ 𝒞) ↔ (SuperChain (· ⊂ .) ℬ 𝒞) := by sorry +lemma SuperChain.equivalence_subset_relations {ℬ : Finset (Finset α)} : (SuperChain (· ⊆ .) ℬ 𝒞) ↔ (SuperChain (· ⊂ .) ℬ 𝒞) := by + constructor + · intro h + exact ⟨IsChain.equivalence_subset_relations.mp h.left, h.right⟩ + · intro h + exact ⟨IsChain.equivalence_subset_relations.mpr h.left, h.right⟩ /-- In a chain with respect to the subset order there can not be two sets of same cardinality -/ lemma IsChain.unique_of_cardinality_chain (chain𝒞 : IsChain (· ⊂ ·) 𝒞) {a b : Finset α} @@ -132,8 +135,14 @@ variable [Fintype α] [DecidableEq α] [DecidableEq (Set (Finset α))] def chain_extension_filter_function (𝒜 : Finset (Finset α)) (e : Finset α) : α → Prop := fun a : α ↦ IsChain (· ⊂ ·) (insert (insert a e) (𝒜 : Set (Finset α))) ∧ insert a e ∉ (𝒜 : Set (Finset α)) +instance instDecidableIsChain (𝒜 : Set (Finset α)) : Decidable (IsChain (· ⊂ ·) 𝒜) := by + have 𝒜_finite : Set.Finite 𝒜 := Set.toFinite 𝒜 + simp [IsChain, Set.Pairwise] + sorry + instance instDecidablePredChainExtension (e : Finset α) : - DecidablePred (chain_extension_filter_function 𝒜 e) := by sorry + DecidablePred (chain_extension_filter_function 𝒜 e) := + fun a : α => inferInstanceAs (Decidable (IsChain (· ⊂ ·) (insert (insert a e) (𝒜 : Set (Finset α))) ∧ insert a e ∉ (𝒜 : Set (Finset α)))) lemma chain_extension (hn : Fintype.card α = n) {i j : Finset.range (n + 1)} (ilej_succ_succ : (i : ℕ) + 2 ≤ ↑j) (chain𝒜 : IsChain (· ⊂ ·) (𝒜 : Set (Finset α))) (hi : (𝒜 # i) = {layer_i}) (hj : (𝒜 # j) = {layer_j}) (emptylayer : ∀ l ∈ (Finset.range (n + 1)), i < l → l < j → #(𝒜 # l) = 0): @@ -428,7 +437,6 @@ lemma one_elt_max_chain_layer (hn : Fintype.card α = n) (maxchain𝒜 : IsMaxCh have := Set.insert_eq_self.mp (maxchain𝒜.right ha.left (by simp)).symm exact ha.right this - lemma card_maxChainThrough {ℬ : Finset (Finset α)} (hn : Fintype.card α = n) (chain : MaxChainThrough ℬ) : #chain.𝒜 = n + 1 := by rw [←sum_card_slice chain.𝒜] calc @@ -439,9 +447,12 @@ lemma card_maxChainThrough {ℬ : Finset (Finset α)} (hn : Fintype.card α = n) exact one_elt_max_chain_layer hn chain.isMaxChain ⟨j, by simp [Nat.lt_succ_of_le jmem]⟩ _ = n + 1 := by rw [←(Finset.card_eq_sum_ones (Iic (Fintype.card α)))]; simp [hn] -lemma count_maxChainsThrough {c : ℕ → ℕ} (monc : Monotone c) (hcn : c m = n) - (ℬ : Finset (Finset α)) (cardℬ : #ℬ = m) (chainℬ : IsChain (· ⊂ ·) (ℬ : Set (Finset α))) (cardsℬ : Finset.image Finset.card ℬ = Finset.image c (Finset.range m)) : - Fintype.card (ℬ.MaxChainThrough) = ∏ j : Fin m, (c (j + 1) - c j)! := by +variable (C : Nat → Type u) +#check (@Nat.below C : Nat → Type u) + +lemma count_maxChainsThrough (ℬ : Finset (Finset α)) (cardℬ : #ℬ = m) (chainℬ : IsChain (· ⊂ ·) (ℬ : Set (Finset α))) (hn : Fintype.card α = n) + (monotone_cards: Monotone (fun i : Fin ℬ.toList.length ↦ (ℬ.toList.get i).card)) (empty_in_chain : ∅ ∈ ℬ) (univ_in_chain : univ ∈ ℬ) : + Fintype.card (ℬ.MaxChainThrough) = ∏ j : Fin (ℬ.toList.length - 1), (((ℬ.toList.get ⟨j + 1, by apply add_lt_of_lt_sub j.prop⟩).card) - (ℬ.toList.get ⟨j, lt_of_lt_pred j.prop⟩).card)! := by induction n - m generalizing n m ℬ with | zero => sorry | succ s ih => sorry diff --git a/package-lock.json b/package-lock.json new file mode 100644 index 0000000..7c59aab --- /dev/null +++ b/package-lock.json @@ -0,0 +1,6 @@ +{ + "name": "thebook.lean", + "lockfileVersion": 3, + "requires": true, + "packages": {} +} From 5b8ee3ac79695a9fad237aa8c5e0bc7752bc08ab Mon Sep 17 00:00:00 2001 From: Jakob Zimmermann Date: Fri, 17 Jan 2025 10:02:43 +0100 Subject: [PATCH 08/26] initialized induction for count_maxChainsThrough --- TheBook/Combinatorics/Sperner.lean | 64 ++++++++++++++++++++++++++---- 1 file changed, 56 insertions(+), 8 deletions(-) diff --git a/TheBook/Combinatorics/Sperner.lean b/TheBook/Combinatorics/Sperner.lean index 0635f0d..322200f 100644 --- a/TheBook/Combinatorics/Sperner.lean +++ b/TheBook/Combinatorics/Sperner.lean @@ -24,6 +24,14 @@ import Mathlib.Data.Finset.Slice import Mathlib.Order.Antichain import Mathlib.Order.Chain + +example (n : Nat) : Nat.choose n 2 = n * (n - 1) / 2 := by + induction' n with n ih + · simp + · rw [Nat.triangle_succ n] + rw [Nat.choose, ih] + simp [Nat.add_comm] + /-! # Proof of the LYM inequality and some observations on chains wrt the subset order -/ @@ -34,10 +42,11 @@ variable {α : Type*} {n m : ℕ} {𝒜 : Finset (Finset α)} {𝒞 : Set (Finse namespace Finset + structure MaxChainThrough (ℬ : Finset (Finset α)) where 𝒜 : Finset (Finset α) isMaxChain : IsMaxChain (· ⊂ ·) (𝒜 : Set (Finset α)) - superChain : SuperChain (· ⊂ ·) (ℬ : Set (Finset α)) (𝒜 : Set (Finset α)) + subChain : ℬ ⊆ 𝒜 instance instFintypeMaxChainThrough {ℬ : Finset (Finset α)} : Fintype (MaxChainThrough ℬ) := by sorry @@ -437,6 +446,31 @@ lemma one_elt_max_chain_layer (hn : Fintype.card α = n) (maxchain𝒜 : IsMaxCh have := Set.insert_eq_self.mp (maxchain𝒜.right ha.left (by simp)).symm exact ha.right this +lemma IsMaxChain.card {ℬ : Finset (Finset α)} (hn : Fintype.card α = n) (maxChainℬ : IsMaxChain (· ⊂ ·) ℬ.toSet) : ℬ.card = n + 1 := by + rw [←sum_card_slice ℬ] + calc + ∑ r ∈ Iic (Fintype.card α), #(ℬ # r) = ∑ r ∈ Iic (Fintype.card α), 1 := by + apply Finset.sum_congr (by rfl) + intro j jmem + simp [hn] at jmem + exact one_elt_max_chain_layer hn maxChainℬ ⟨j, by simp [Nat.lt_succ_of_le jmem]⟩ + _ = n + 1 := by rw [←(Finset.card_eq_sum_ones (Iic (Fintype.card α)))]; simp [hn] + +lemma IsChain.card_le {ℬ : Finset (Finset α)} (hn : Fintype.card α = n) (chainℬ : IsChain (· ⊂ ·) ℬ.toSet) : ℬ.card ≤ n + 1 := by sorry + +lemma IsMaxChain.iff_card {ℬ : Finset (Finset α)} (hn : Fintype.card α = n) (chainℬ : IsChain (· ⊂ ·) ℬ.toSet) : IsMaxChain (· ⊂ ·) ℬ.toSet ↔ ℬ.card = n + 1 := by + constructor + · intro maxChainℬ + exact IsMaxChain.card hn maxChainℬ + · intro cardℬ + constructor + · exact chainℬ + · sorry + -- · intro 𝒜 chain𝒜 ℬssub𝒜 + -- have : Set.Finite 𝒜 := by sorry + -- let finset𝒜 : Finset (Finset α):= 𝒜.toFinset + -- have : 𝒜.card ≤ n + 1:= IsChain.card_le hn (by sorry) + lemma card_maxChainThrough {ℬ : Finset (Finset α)} (hn : Fintype.card α = n) (chain : MaxChainThrough ℬ) : #chain.𝒜 = n + 1 := by rw [←sum_card_slice chain.𝒜] calc @@ -447,15 +481,29 @@ lemma card_maxChainThrough {ℬ : Finset (Finset α)} (hn : Fintype.card α = n) exact one_elt_max_chain_layer hn chain.isMaxChain ⟨j, by simp [Nat.lt_succ_of_le jmem]⟩ _ = n + 1 := by rw [←(Finset.card_eq_sum_ones (Iic (Fintype.card α)))]; simp [hn] -variable (C : Nat → Type u) -#check (@Nat.below C : Nat → Type u) - -lemma count_maxChainsThrough (ℬ : Finset (Finset α)) (cardℬ : #ℬ = m) (chainℬ : IsChain (· ⊂ ·) (ℬ : Set (Finset α))) (hn : Fintype.card α = n) +lemma count_maxChainsThrough (n m : ℕ) (h_mn : m ≤ n + 1) (hn : Fintype.card α = n) + (ℬ : Finset (Finset α)) (cardℬ : #ℬ = m) (chainℬ : IsChain (· ⊂ ·) (ℬ : Set (Finset α))) (monotone_cards: Monotone (fun i : Fin ℬ.toList.length ↦ (ℬ.toList.get i).card)) (empty_in_chain : ∅ ∈ ℬ) (univ_in_chain : univ ∈ ℬ) : Fintype.card (ℬ.MaxChainThrough) = ∏ j : Fin (ℬ.toList.length - 1), (((ℬ.toList.get ⟨j + 1, by apply add_lt_of_lt_sub j.prop⟩).card) - (ℬ.toList.get ⟨j, lt_of_lt_pred j.prop⟩).card)! := by - induction n - m generalizing n m ℬ with - | zero => sorry - | succ s ih => sorry + induction' h_mn using decreasingInduction with n q ih + · sorry + · have entry_cards : ∀ j : Fin (ℬ.toList.length - 1), (ℬ.toList.get ⟨j, lt_of_lt_pred j.prop⟩).card = j.val := by sorry + have rhs_one := by calc + ∏ j : Fin (ℬ.toList.length - 1), (((ℬ.toList.get ⟨j + 1, by apply add_lt_of_lt_sub j.prop⟩).card) - (ℬ.toList.get ⟨j, lt_of_lt_pred j.prop⟩).card)! = ∏ j : Fin (ℬ.toList.length - 1), 1 := by + apply Finset.prod_congr (by simp) + intro j _ + rw [entry_cards, entry_cards ⟨j + 1, by sorry⟩] + simp + _ = 1 := Fintype.prod_eq_one (fun a => 1) (congrFun rfl) + rw [rhs_one, Fintype.card_eq_one_iff] + use { + 𝒜 := ℬ, + isMaxChain := (IsMaxChain.iff_card hn chainℬ).mpr cardℬ, + superChain := by + constructor + · exact chainℬ + · subset_rfl ℬ + } lemma count_maxChains_through_singleton (e : Finset α) (hn : Fintype.card α = n): Fintype.card (MaxChainThrough {e}) = (#e)! * (n - #e)! := by sorry From e03e4a80c62e6ba053dd08d0671337e0c5781823 Mon Sep 17 00:00:00 2001 From: Jakob Zimmermann Date: Fri, 17 Jan 2025 12:45:46 +0100 Subject: [PATCH 09/26] Added proposal definitions for chains in Finset namespace and rewritten proof using these definitions instead of the usual chain definition, that is made for general sets --- TheBook/Combinatorics/Sperner.lean | 186 ++++++++++++++++++----------- 1 file changed, 116 insertions(+), 70 deletions(-) diff --git a/TheBook/Combinatorics/Sperner.lean b/TheBook/Combinatorics/Sperner.lean index 322200f..7f2cad6 100644 --- a/TheBook/Combinatorics/Sperner.lean +++ b/TheBook/Combinatorics/Sperner.lean @@ -25,32 +25,60 @@ import Mathlib.Order.Antichain import Mathlib.Order.Chain -example (n : Nat) : Nat.choose n 2 = n * (n - 1) / 2 := by - induction' n with n ih - · simp - · rw [Nat.triangle_succ n] - rw [Nat.choose, ih] - simp [Nat.add_comm] - /-! # Proof of the LYM inequality and some observations on chains wrt the subset order -/ open Function Finset Nat Set BigOperators -variable {α : Type*} {n m : ℕ} {𝒜 : Finset (Finset α)} {𝒞 : Set (Finset α)} +variable {α : Type*} {n m : ℕ} {𝒜 : Finset (Finset α)} namespace Finset +/- +## Proposals for new definitions of chains in Finset namespace +-/ + +variable {β : Type*} (r : β → β → Prop) + +/-- In this file, we use `≺` as a local notation for any relation `r`. -/ +local infixl:50 " ≺ " => r + +def IsChain (s : Finset β) : Prop := + s.toSet.Pairwise fun x y => x ≺ y ∨ y ≺ x + +/-- `SuperChain s t` means that `t` is a chain that strictly includes `s`. -/ +def SuperChain (s t : Finset β) : Prop := + IsChain r t ∧ s ⊂ t + +/-- A chain `s` is a maximal chain if there does not exists a chain strictly including `s`. -/ +def IsMaxChain (s : Finset β) : Prop := + IsChain r s ∧ ∀ ⦃t⦄, IsChain r t → s ⊆ t → s = t + +def IsAntichain (r : α → α → Prop) (s : Finset α) : Prop := + s.toSet.Pairwise rᶜ + +end Finset + +instance : Coe (IsChain (· ⊂ ·) 𝒜.toSet) (𝒜.IsChain (· ⊂ ·)) := + ⟨λ h => h⟩ + +instance : Coe (𝒜.IsChain (· ⊂ ·)) (IsChain (· ⊂ ·) 𝒜.toSet) := + ⟨λ h => h⟩ + +example (h : IsChain (· ⊂ ·) 𝒜.toSet) : 𝒜.IsChain (· ⊂ ·) := h +example (h : 𝒜.IsChain (· ⊂ ·)) : IsChain (· ⊂ ·) 𝒜.toSet := h + +namespace Finset structure MaxChainThrough (ℬ : Finset (Finset α)) where 𝒜 : Finset (Finset α) - isMaxChain : IsMaxChain (· ⊂ ·) (𝒜 : Set (Finset α)) + isMaxChain : Finset.IsMaxChain (· ⊂ ·) 𝒜 subChain : ℬ ⊆ 𝒜 instance instFintypeMaxChainThrough {ℬ : Finset (Finset α)} : Fintype (MaxChainThrough ℬ) := by sorry -lemma IsChain.equivalence_subset_relations : (IsChain (· ⊆ .) 𝒞) ↔ (IsChain (· ⊂ .) 𝒞) := by +lemma IsChain.equivalence_subset_relations : (IsChain (· ⊆ .) 𝒜) ↔ (IsChain (· ⊂ .) 𝒜) := by constructor · intro h e₁ e₁mem e₂ e₂mem e₁neqe₂ cases h e₁mem e₂mem e₁neqe₂ with @@ -61,14 +89,14 @@ lemma IsChain.equivalence_subset_relations : (IsChain (· ⊆ .) 𝒞) ↔ (IsCh | inl e₁sube₂ => left; exact e₁sube₂.left | inr e₂sube₁ => right; exact e₂sube₁.left -lemma IsMaxChain.equivalence_subset_relations : (IsMaxChain (· ⊆ .) 𝒞) ↔ (IsMaxChain (· ⊂ .) 𝒞) := by +lemma IsMaxChain.equivalence_subset_relations : (IsMaxChain (· ⊆ .) 𝒜) ↔ (IsMaxChain (· ⊂ .) 𝒜) := by constructor · intro h exact ⟨IsChain.equivalence_subset_relations.mp h.left, fun t chain => h.right (IsChain.equivalence_subset_relations.mpr chain)⟩ · intro h exact ⟨IsChain.equivalence_subset_relations.mpr h.left, fun t chain => h.right (IsChain.equivalence_subset_relations.mp chain)⟩ -lemma SuperChain.equivalence_subset_relations {ℬ : Finset (Finset α)} : (SuperChain (· ⊆ .) ℬ 𝒞) ↔ (SuperChain (· ⊂ .) ℬ 𝒞) := by +lemma SuperChain.equivalence_subset_relations {ℬ : Finset (Finset α)} : (SuperChain (· ⊆ .) ℬ 𝒜) ↔ (SuperChain (· ⊂ .) ℬ 𝒜) := by constructor · intro h exact ⟨IsChain.equivalence_subset_relations.mp h.left, h.right⟩ @@ -76,10 +104,10 @@ lemma SuperChain.equivalence_subset_relations {ℬ : Finset (Finset α)} : (Supe exact ⟨IsChain.equivalence_subset_relations.mpr h.left, h.right⟩ /-- In a chain with respect to the subset order there can not be two sets of same cardinality -/ -lemma IsChain.unique_of_cardinality_chain (chain𝒞 : IsChain (· ⊂ ·) 𝒞) {a b : Finset α} - (amem : a ∈ 𝒞) (bmem : b ∈ 𝒞) (hcard : #a = #b) : a = b := by +lemma IsChain.unique_of_cardinality_chain (chain𝒜 : IsChain (· ⊂ ·) 𝒜) {a b : Finset α} + (amem : a ∈ 𝒜) (bmem : b ∈ 𝒜) (hcard : #a = #b) : a = b := by by_contra aneb - cases chain𝒞 amem bmem aneb with + cases chain𝒜 amem bmem aneb with | inl h => have := Finset.card_strictMono h linarith @@ -88,7 +116,7 @@ lemma IsChain.unique_of_cardinality_chain (chain𝒞 : IsChain (· ⊂ ·) 𝒞) linarith /-- In a chain with respect to the subset order there can be at most one set of a given cardinality -/ -lemma IsChain.max_one_elt_chain_layer (chain𝒜 : IsChain (· ⊂ ·) (𝒜 : Set (Finset α))) (j : Finset.range (n + 1)) : #(𝒜 # j) ≤ 1 := by +lemma IsChain.max_one_elt_chain_layer (chain𝒜 : IsChain (· ⊂ ·) 𝒜) (j : ℕ) : #(𝒜 # j) ≤ 1 := by by_contra! ass have : (𝒜 # j) ≠ (∅ : Finset (Finset α)) := by intro assempty @@ -100,7 +128,7 @@ lemma IsChain.max_one_elt_chain_layer (chain𝒜 : IsChain (· ⊂ ·) (𝒜 : S exact aneb (IsChain.unique_of_cardinality_chain chain𝒜 (Finset.slice_subset bmem) (Finset.slice_subset amem) cardeqab.symm) /-- If a chain intersects a layer of the boolean lattice this intersection is a singleton -/ -lemma layer_singleton_of_nonempty (chain𝒜 : IsChain (· ⊂ ·) (𝒜 : Set (Finset α))) (j : Finset.range (n + 1)) (layer_nonempty : (𝒜 # j) ≠ ∅): +lemma layer_singleton_of_nonempty (chain𝒜 : IsChain (· ⊂ ·) 𝒜) (j : Finset.range (n + 1)) (layer_nonempty : (𝒜 # j) ≠ ∅): ∃! e : Finset α, 𝒜 # j = {e} := by have : # (𝒜 # j) = 1 := by cases Nat.le_one_iff_eq_zero_or_eq_one.mp (IsChain.max_one_elt_chain_layer chain𝒜 j) with @@ -117,43 +145,46 @@ lemma layer_singleton_of_nonempty (chain𝒜 : IsChain (· ⊂ ·) (𝒜 : Set ( exact ⟨e, he, unique⟩ -lemma IsChain.ssubset_of_lt_cardinality (chain𝒞 : IsChain (· ⊂ ·) 𝒞) {e₁ e₂ : Finset α} (e₁mem : e₁ ∈ 𝒞) (e₂mem : e₂ ∈ 𝒞) +lemma IsChain.ssubset_of_lt_cardinality (chain𝒜 : IsChain (· ⊂ ·) 𝒜) {e₁ e₂ : Finset α} (e₁mem : e₁ ∈ 𝒜) (e₂mem : e₂ ∈ 𝒜) (hcard : #e₁ < #e₂) : e₁ ⊂ e₂ := by have e₁nee₂ : e₁ ≠ e₂ := by intro ass have : #e₁ = #e₂ := by rw [ass] linarith - cases chain𝒞 e₁mem e₂mem e₁nee₂ with + cases chain𝒜 e₁mem e₂mem e₁nee₂ with | inl h => exact Finset.ssubset_iff_subset_ne.mpr ⟨h.left, e₁nee₂⟩ | inr h => have : #e₂ < #e₁ := Finset.card_strictMono h linarith -lemma IsChain.subset_of_le_cardinality (chain𝒞 : IsChain (· ⊂ ·) 𝒞) {e₁ e₂ : Finset α} (e₁mem : e₁ ∈ 𝒞) (e₂mem : e₂ ∈ 𝒞) +lemma IsChain.subset_of_le_cardinality (chain𝒜 : IsChain (· ⊂ ·) 𝒜) {e₁ e₂ : Finset α} (e₁mem : e₁ ∈ 𝒜) (e₂mem : e₂ ∈ 𝒜) (hcard : #e₁ ≤ #e₂) : e₁ ⊆ e₂ := by cases Nat.eq_or_lt_of_le hcard with | inr hcard_lt => - exact (IsChain.ssubset_of_lt_cardinality chain𝒞 e₁mem e₂mem hcard_lt).left + exact (IsChain.ssubset_of_lt_cardinality chain𝒜 e₁mem e₂mem hcard_lt).left | inl hcard_eq => - exact Finset.subset_of_eq (IsChain.unique_of_cardinality_chain chain𝒞 e₁mem e₂mem hcard_eq) + exact Finset.subset_of_eq (IsChain.unique_of_cardinality_chain chain𝒜 e₁mem e₂mem hcard_eq) + +variable [Fintype α] [DecidableEq α] [DecidableEq (Finset (Finset α))] -variable [Fintype α] [DecidableEq α] [DecidableEq (Set (Finset α))] +instance : Coe (Set (Finset α)) (Finset (Finset α)) := + ⟨λ s => by sorry⟩ + +example (ℬ : Set (Finset α)) : Finset (Finset α) := ℬ def chain_extension_filter_function (𝒜 : Finset (Finset α)) (e : Finset α) : α → Prop := - fun a : α ↦ IsChain (· ⊂ ·) (insert (insert a e) (𝒜 : Set (Finset α))) ∧ insert a e ∉ (𝒜 : Set (Finset α)) + fun a : α ↦ IsChain (· ⊂ ·) (insert (insert a e) 𝒜) ∧ insert a e ∉ 𝒜 -instance instDecidableIsChain (𝒜 : Set (Finset α)) : Decidable (IsChain (· ⊂ ·) 𝒜) := by - have 𝒜_finite : Set.Finite 𝒜 := Set.toFinite 𝒜 - simp [IsChain, Set.Pairwise] +instance instDecidableIsChain (𝒜 : Finset (Finset α)) : Decidable (IsChain (· ⊂ ·) 𝒜) := by sorry instance instDecidablePredChainExtension (e : Finset α) : DecidablePred (chain_extension_filter_function 𝒜 e) := - fun a : α => inferInstanceAs (Decidable (IsChain (· ⊂ ·) (insert (insert a e) (𝒜 : Set (Finset α))) ∧ insert a e ∉ (𝒜 : Set (Finset α)))) + fun a : α => inferInstanceAs (Decidable (IsChain (· ⊂ ·) (insert (insert a e) 𝒜) ∧ insert a e ∉ 𝒜)) -lemma chain_extension (hn : Fintype.card α = n) {i j : Finset.range (n + 1)} (ilej_succ_succ : (i : ℕ) + 2 ≤ ↑j) (chain𝒜 : IsChain (· ⊂ ·) (𝒜 : Set (Finset α))) +lemma chain_extension (hn : Fintype.card α = n) {i j : Finset.range (n + 1)} (ilej_succ_succ : (i : ℕ) + 2 ≤ ↑j) (chain𝒜 : IsChain (· ⊂ ·) 𝒜) (hi : (𝒜 # i) = {layer_i}) (hj : (𝒜 # j) = {layer_j}) (emptylayer : ∀ l ∈ (Finset.range (n + 1)), i < l → l < j → #(𝒜 # l) = 0): Finset.filter (chain_extension_filter_function 𝒜 layer_i) (Finset.univ : Finset α) = layer_j \ layer_i := by have layer_j_mem : layer_j ∈ 𝒜 := by @@ -201,8 +232,8 @@ lemma chain_extension (hn : Fintype.card α = n) {i j : Finset.range (n + 1)} (i exact hx.right layer_j_mem simp constructor - · have e_new_mem : e_new ∈ insert e_new (𝒜 : Set (Finset α)) := by simp - have layer_j_mem_insert : layer_j ∈ insert e_new (𝒜 : Set (Finset α)) := by + · have e_new_mem : e_new ∈ insert e_new 𝒜 := by simp + have layer_j_mem_insert : layer_j ∈ insert e_new 𝒜 := by simp right exact layer_j_mem @@ -305,7 +336,7 @@ lemma chain_extension (hn : Fintype.card α = n) {i j : Finset.range (n + 1)} (i have : #(𝒜 # #e_new) > 0 := Finset.card_pos.mpr this linarith -lemma one_elt_max_chain_layer (hn : Fintype.card α = n) (maxchain𝒜 : IsMaxChain (· ⊂ ·) (𝒜 : Set (Finset α))) (j : Finset.range (n + 1)) : #(𝒜 # j) = 1 := by +lemma one_elt_max_chain_layer (hn : Fintype.card α = n) (maxchain𝒜 : IsMaxChain (· ⊂ ·) 𝒜) (j : Finset.range (n + 1)) : #(𝒜 # j) = 1 := by by_contra! ass have empty_layer : 𝒜 # j = ∅ := by cases Nat.le_one_iff_eq_zero_or_eq_one.mp (IsChain.max_one_elt_chain_layer maxchain𝒜.left j) with @@ -327,13 +358,17 @@ lemma one_elt_max_chain_layer (hn : Fintype.card α = n) (maxchain𝒜 : IsMaxCh rw [jeqn] at empty_layer simp [empty_layer] at nslicemem simp [IsMaxChain] at maxchain𝒜 - have larger_chain_with_univ : IsChain (· ⊂ ·) ((Insert.insert (Finset.univ : Finset α) 𝒜) : Set (Finset α)) := by + have larger_chain_with_univ' : _root_.IsChain (· ⊂ ·) (Insert.insert (Finset.univ : Finset α) 𝒜).toSet := by + have : ((Insert.insert (Finset.univ : Finset α) 𝒜) : Finset (Finset α)).toSet = ((Insert.insert (Finset.univ : Finset α) 𝒜) : Set (Finset α)) := by simp + rw [this] refine' IsChain.insert maxchain𝒜.left _ intro b bmem bneq right exact Finset.ssubset_iff_subset_ne.mpr ⟨by simp, fun h => bneq h.symm⟩ - have univin𝒜 := Set.insert_eq_self.mp (maxchain𝒜.right larger_chain_with_univ (by simp)).symm + have larger_chain_with_univ : Finset.IsChain (· ⊂ ·) ((Insert.insert (Finset.univ : Finset α) 𝒜) : Finset (Finset α)) := larger_chain_with_univ' + + have univin𝒜 := Finset.insert_eq_self.mp (maxchain𝒜.right larger_chain_with_univ (by simp)).symm exact univnotin𝒜 univin𝒜 else if hbottom : ∀ i : Finset.range (n + 1), i < j → 𝒜 # i = ∅ then have emptynotin𝒜 : (∅ : Finset α) ∉ 𝒜 := by @@ -348,13 +383,17 @@ lemma one_elt_max_chain_layer (hn : Fintype.card α = n) (maxchain𝒜 : IsMaxCh | inr jgen => simp [hbottom ⟨0, by simp⟩ jgen] at zeroslicemem simp [IsMaxChain] at maxchain𝒜 - have larger_chain_with_empty : IsChain (· ⊂ ·) ((Insert.insert (∅ : Finset α) 𝒜) : Set (Finset α)) := by + have larger_chain_with_empty' : _root_.IsChain (· ⊂ ·) ((Insert.insert (∅ : Finset α) 𝒜)).toSet := by + have : ((Insert.insert (∅ : Finset α) 𝒜)).toSet = (Insert.insert (∅ : Finset α) 𝒜.toSet) := by simp + rw [this] refine' IsChain.insert maxchain𝒜.left _ intro b bmem bneq left exact Finset.ssubset_iff_subset_ne.mpr ⟨by simp, bneq⟩ - have emptyin𝒜 := Set.insert_eq_self.mp (maxchain𝒜.right larger_chain_with_empty (by simp)).symm + have larger_chain_with_empty : IsChain (· ⊂ ·) ((Insert.insert (∅ : Finset α) 𝒜)) := larger_chain_with_empty' + + have emptyin𝒜 := Finset.insert_eq_self.mp (maxchain𝒜.right larger_chain_with_empty (by simp)).symm exact emptynotin𝒜 emptyin𝒜 else @@ -443,10 +482,10 @@ lemma one_elt_max_chain_layer (hn : Fintype.card α = n) (maxchain𝒜 : IsMaxCh simp at chain_extension_candidates_ne_empty obtain ⟨a, ha⟩ := chain_extension_candidates_ne_empty simp [chain_extension_candidates, chain_extension_filter_function] at ha - have := Set.insert_eq_self.mp (maxchain𝒜.right ha.left (by simp)).symm + have := Finset.insert_eq_self.mp (maxchain𝒜.right ha.left (by simp)).symm exact ha.right this -lemma IsMaxChain.card {ℬ : Finset (Finset α)} (hn : Fintype.card α = n) (maxChainℬ : IsMaxChain (· ⊂ ·) ℬ.toSet) : ℬ.card = n + 1 := by +lemma IsMaxChain.card {ℬ : Finset (Finset α)} (hn : Fintype.card α = n) (maxChainℬ : IsMaxChain (· ⊂ ·) ℬ) : ℬ.card = n + 1 := by rw [←sum_card_slice ℬ] calc ∑ r ∈ Iic (Fintype.card α), #(ℬ # r) = ∑ r ∈ Iic (Fintype.card α), 1 := by @@ -456,20 +495,27 @@ lemma IsMaxChain.card {ℬ : Finset (Finset α)} (hn : Fintype.card α = n) (max exact one_elt_max_chain_layer hn maxChainℬ ⟨j, by simp [Nat.lt_succ_of_le jmem]⟩ _ = n + 1 := by rw [←(Finset.card_eq_sum_ones (Iic (Fintype.card α)))]; simp [hn] -lemma IsChain.card_le {ℬ : Finset (Finset α)} (hn : Fintype.card α = n) (chainℬ : IsChain (· ⊂ ·) ℬ.toSet) : ℬ.card ≤ n + 1 := by sorry +lemma IsChain.card_le {ℬ : Finset (Finset α)} (hn : Fintype.card α = n) (chainℬ : IsChain (· ⊂ ·) ℬ) : ℬ.card ≤ n + 1 := by + rw [←sum_card_slice ℬ] + calc + ∑ r ∈ Iic (Fintype.card α), #(ℬ # r) ≤ ∑ r ∈ Iic (Fintype.card α), 1 := by + apply sum_le_sum + intro j jmem + exact IsChain.max_one_elt_chain_layer chainℬ j + _ = n + 1 := by rw [←(Finset.card_eq_sum_ones (Iic (Fintype.card α)))]; simp [hn] -lemma IsMaxChain.iff_card {ℬ : Finset (Finset α)} (hn : Fintype.card α = n) (chainℬ : IsChain (· ⊂ ·) ℬ.toSet) : IsMaxChain (· ⊂ ·) ℬ.toSet ↔ ℬ.card = n + 1 := by +lemma IsMaxChain.iff_card {ℬ : Finset (Finset α)} (hn : Fintype.card α = n) (chainℬ : IsChain (· ⊂ ·) ℬ) : IsMaxChain (· ⊂ ·) ℬ ↔ ℬ.card = n + 1 := by constructor · intro maxChainℬ exact IsMaxChain.card hn maxChainℬ · intro cardℬ constructor · exact chainℬ - · sorry - -- · intro 𝒜 chain𝒜 ℬssub𝒜 - -- have : Set.Finite 𝒜 := by sorry - -- let finset𝒜 : Finset (Finset α):= 𝒜.toFinset - -- have : 𝒜.card ≤ n + 1:= IsChain.card_le hn (by sorry) + · intro 𝒜 chain𝒜 ℬssub𝒜 + have hcard𝒜 : #𝒜 ≤ #ℬ := by + · rw [cardℬ] + exact IsChain.card_le hn chain𝒜 + exact (Finset.subset_iff_eq_of_card_le hcard𝒜).mp ℬssub𝒜 lemma card_maxChainThrough {ℬ : Finset (Finset α)} (hn : Fintype.card α = n) (chain : MaxChainThrough ℬ) : #chain.𝒜 = n + 1 := by rw [←sum_card_slice chain.𝒜] @@ -481,34 +527,34 @@ lemma card_maxChainThrough {ℬ : Finset (Finset α)} (hn : Fintype.card α = n) exact one_elt_max_chain_layer hn chain.isMaxChain ⟨j, by simp [Nat.lt_succ_of_le jmem]⟩ _ = n + 1 := by rw [←(Finset.card_eq_sum_ones (Iic (Fintype.card α)))]; simp [hn] -lemma count_maxChainsThrough (n m : ℕ) (h_mn : m ≤ n + 1) (hn : Fintype.card α = n) - (ℬ : Finset (Finset α)) (cardℬ : #ℬ = m) (chainℬ : IsChain (· ⊂ ·) (ℬ : Set (Finset α))) - (monotone_cards: Monotone (fun i : Fin ℬ.toList.length ↦ (ℬ.toList.get i).card)) (empty_in_chain : ∅ ∈ ℬ) (univ_in_chain : univ ∈ ℬ) : - Fintype.card (ℬ.MaxChainThrough) = ∏ j : Fin (ℬ.toList.length - 1), (((ℬ.toList.get ⟨j + 1, by apply add_lt_of_lt_sub j.prop⟩).card) - (ℬ.toList.get ⟨j, lt_of_lt_pred j.prop⟩).card)! := by - induction' h_mn using decreasingInduction with n q ih - · sorry - · have entry_cards : ∀ j : Fin (ℬ.toList.length - 1), (ℬ.toList.get ⟨j, lt_of_lt_pred j.prop⟩).card = j.val := by sorry - have rhs_one := by calc - ∏ j : Fin (ℬ.toList.length - 1), (((ℬ.toList.get ⟨j + 1, by apply add_lt_of_lt_sub j.prop⟩).card) - (ℬ.toList.get ⟨j, lt_of_lt_pred j.prop⟩).card)! = ∏ j : Fin (ℬ.toList.length - 1), 1 := by - apply Finset.prod_congr (by simp) - intro j _ - rw [entry_cards, entry_cards ⟨j + 1, by sorry⟩] - simp - _ = 1 := Fintype.prod_eq_one (fun a => 1) (congrFun rfl) - rw [rhs_one, Fintype.card_eq_one_iff] - use { - 𝒜 := ℬ, - isMaxChain := (IsMaxChain.iff_card hn chainℬ).mpr cardℬ, - superChain := by - constructor - · exact chainℬ - · subset_rfl ℬ - } +-- lemma count_maxChainsThrough (n m : ℕ) (h_mn : m ≤ n + 1) (hn : Fintype.card α = n) +-- (ℬ : Finset (Finset α)) (cardℬ : #ℬ = m) (chainℬ : IsChain (· ⊂ ·) ℬ) +-- (monotone_cards: Monotone (fun i : Fin ℬ.toList.length ↦ (ℬ.toList.get i).card)) (empty_in_chain : ∅ ∈ ℬ) (univ_in_chain : univ ∈ ℬ) : +-- Fintype.card (ℬ.MaxChainThrough) = ∏ j : Fin (ℬ.toList.length - 1), (((ℬ.toList.get ⟨j + 1, by apply add_lt_of_lt_sub j.prop⟩).card) - (ℬ.toList.get ⟨j, lt_of_lt_pred j.prop⟩).card)! := by +-- induction' h_mn using decreasingInduction with n q ih +-- · sorry +-- · have entry_cards : ∀ j : Fin (ℬ.toList.length - 1), (ℬ.toList.get ⟨j, lt_of_lt_pred j.prop⟩).card = j.val := by sorry +-- have rhs_one := by calc +-- ∏ j : Fin (ℬ.toList.length - 1), (((ℬ.toList.get ⟨j + 1, by apply add_lt_of_lt_sub j.prop⟩).card) - (ℬ.toList.get ⟨j, lt_of_lt_pred j.prop⟩).card)! = ∏ j : Fin (ℬ.toList.length - 1), 1 := by +-- apply Finset.prod_congr (by simp) +-- intro j _ +-- rw [entry_cards, entry_cards ⟨j + 1, by sorry⟩] +-- simp +-- _ = 1 := Fintype.prod_eq_one (fun a => 1) (congrFun rfl) +-- rw [rhs_one, Fintype.card_eq_one_iff] +-- use { +-- 𝒜 := ℬ, +-- isMaxChain := (IsMaxChain.iff_card hn chainℬ).mpr cardℬ, +-- superChain := by +-- constructor +-- · exact chainℬ +-- · subset_rfl ℬ +-- } lemma count_maxChains_through_singleton (e : Finset α) (hn : Fintype.card α = n): Fintype.card (MaxChainThrough {e}) = (#e)! * (n - #e)! := by sorry /-- The **Lubell-Yamamoto-Meshalkin inequality**. Sperner's Theorem follows as in Mathlib.Combinatorics.SetFamily.LYM as a corollary -/ -theorem lym_inequality (antichain𝒜 : IsAntichain (· ⊂ ·) (𝒜 : Set (Finset α))) (hn : Fintype.card α = n): +theorem lym_inequality (antichain𝒜 : IsAntichain (· ⊂ ·) 𝒜) (hn : Fintype.card α = n): ∑ k ∈ Iic n, #(𝒜 # k) / (n.choose k : ℚ) ≤ (1 : ℚ) := by have : ∑ k ∈ Iic n, #(𝒜 # k) / (n.choose k : ℚ) ≤ (∑ k ∈ Iic n, #(𝒜 # k) * (k)! * (n - k)!) * (1 / (n)! : ℚ) := by calc @@ -539,7 +585,7 @@ theorem lym_inequality (antichain𝒜 : IsAntichain (· ⊂ ·) (𝒜 : Set (Fin norm_cast - have slice_partition : Finset.disjiUnion (Iic n) 𝒜.slice (Finset.pairwiseDisjoint_slice.subset (Set.subset_univ _)) = (𝒜 : Finset (Finset α)) := by + have slice_partition : Finset.disjiUnion (Iic n) 𝒜.slice (Finset.pairwiseDisjoint_slice.subset (Set.subset_univ _)) = 𝒜 := by rw [Finset.disjiUnion_eq_biUnion (Iic n) 𝒜.slice (Finset.pairwiseDisjoint_slice.subset (Set.subset_univ _))] rw [←hn] simp [biUnion_slice 𝒜] From 65cd88b26ee0af5292206d7f69a799a871eb59c8 Mon Sep 17 00:00:00 2001 From: Jakob Zimmermann Date: Fri, 17 Jan 2025 17:56:37 +0100 Subject: [PATCH 10/26] worked on count_maxChainsThrough --- TheBook/Combinatorics/Sperner.lean | 179 +++++++++++++++++++++++++---- 1 file changed, 154 insertions(+), 25 deletions(-) diff --git a/TheBook/Combinatorics/Sperner.lean b/TheBook/Combinatorics/Sperner.lean index 7f2cad6..4353154 100644 --- a/TheBook/Combinatorics/Sperner.lean +++ b/TheBook/Combinatorics/Sperner.lean @@ -76,6 +76,10 @@ structure MaxChainThrough (ℬ : Finset (Finset α)) where isMaxChain : Finset.IsMaxChain (· ⊂ ·) 𝒜 subChain : ℬ ⊆ 𝒜 +def emb_MaxChainThrough (ℬ : Finset (Finset α)) (X : ℬ.MaxChainThrough) : Finset (Finset α) := X.𝒜 + +lemma inj_emb_MaxChainThrough (ℬ : Finset (Finset α)) : Injective (emb_MaxChainThrough ℬ) := by sorry + instance instFintypeMaxChainThrough {ℬ : Finset (Finset α)} : Fintype (MaxChainThrough ℬ) := by sorry lemma IsChain.equivalence_subset_relations : (IsChain (· ⊆ .) 𝒜) ↔ (IsChain (· ⊂ .) 𝒜) := by @@ -166,7 +170,6 @@ lemma IsChain.subset_of_le_cardinality (chain𝒜 : IsChain (· ⊂ ·) 𝒜) {e exact Finset.subset_of_eq (IsChain.unique_of_cardinality_chain chain𝒜 e₁mem e₂mem hcard_eq) - variable [Fintype α] [DecidableEq α] [DecidableEq (Finset (Finset α))] instance : Coe (Set (Finset α)) (Finset (Finset α)) := @@ -184,7 +187,28 @@ instance instDecidablePredChainExtension (e : Finset α) : DecidablePred (chain_extension_filter_function 𝒜 e) := fun a : α => inferInstanceAs (Decidable (IsChain (· ⊂ ·) (insert (insert a e) 𝒜) ∧ insert a e ∉ 𝒜)) -lemma chain_extension (hn : Fintype.card α = n) {i j : Finset.range (n + 1)} (ilej_succ_succ : (i : ℕ) + 2 ≤ ↑j) (chain𝒜 : IsChain (· ⊂ ·) 𝒜) +lemma IsChain.empty_layer_by_card (hn : Fintype.card α = n) (chain𝒜 : IsChain (· ⊂ ·) 𝒜) (card𝒜 : #𝒜 < n+1) : ∃ i : Fin (n + 1), #(𝒜 # i) = 0 := by + by_contra! ass + have : ∀ (i : Fin (n + 1)), #(𝒜 # i) = 1 := by + intro i + have non_zero := ass i + cases Nat.le_one_iff_eq_zero_or_eq_one.mp (IsChain.max_one_elt_chain_layer chain𝒜 i) with + | inl h => exfalso; exact (non_zero h) + | inr h => exact h + rw [←sum_card_slice 𝒜] at card𝒜 + have := calc + ∑ r ∈ Iic (Fintype.card α), #(𝒜 # r) = ∑ r ∈ Iic (Fintype.card α), 1 := by + apply Finset.sum_congr (by rfl) + intro j jmem + simp [hn] at jmem + exact this ⟨j, by simp [Nat.lt_succ_of_le jmem]⟩ + _ = n + 1 := by rw [←(Finset.card_eq_sum_ones (Iic (Fintype.card α)))]; simp [hn] + linarith + +lemma range_empty_layer (hn : Fintype.card α = n) (chain𝒜 : IsChain (· ⊂ ·) 𝒜) (empty_layer : ∃ i : Fin (n + 1), #(𝒜 # i) = 0) (empty_elt : ∅ ∈ 𝒜) (univ_elt : Finset.univ ∈ 𝒜) : + ∃ s : Fin (n + 1), ∃ t : Fin (n + 1), s + 2 ≤ t ∧ #(𝒜 # s) = 1 ∧ #(𝒜 # t) = 1 ∧ ∀ j : Fin (n + 1), s < j ∧ j < t → #(𝒜 # j) = 0 := by sorry + +lemma chain_extension (hn : Fintype.card α = n) {i j : Finset.range (n + 1)} (ilej_succ_succ : (i : ℕ) + 2 ≤ (j : ℕ)) (chain𝒜 : IsChain (· ⊂ ·) 𝒜) (hi : (𝒜 # i) = {layer_i}) (hj : (𝒜 # j) = {layer_j}) (emptylayer : ∀ l ∈ (Finset.range (n + 1)), i < l → l < j → #(𝒜 # l) = 0): Finset.filter (chain_extension_filter_function 𝒜 layer_i) (Finset.univ : Finset α) = layer_j \ layer_i := by have layer_j_mem : layer_j ∈ 𝒜 := by @@ -527,29 +551,134 @@ lemma card_maxChainThrough {ℬ : Finset (Finset α)} (hn : Fintype.card α = n) exact one_elt_max_chain_layer hn chain.isMaxChain ⟨j, by simp [Nat.lt_succ_of_le jmem]⟩ _ = n + 1 := by rw [←(Finset.card_eq_sum_ones (Iic (Fintype.card α)))]; simp [hn] --- lemma count_maxChainsThrough (n m : ℕ) (h_mn : m ≤ n + 1) (hn : Fintype.card α = n) --- (ℬ : Finset (Finset α)) (cardℬ : #ℬ = m) (chainℬ : IsChain (· ⊂ ·) ℬ) --- (monotone_cards: Monotone (fun i : Fin ℬ.toList.length ↦ (ℬ.toList.get i).card)) (empty_in_chain : ∅ ∈ ℬ) (univ_in_chain : univ ∈ ℬ) : --- Fintype.card (ℬ.MaxChainThrough) = ∏ j : Fin (ℬ.toList.length - 1), (((ℬ.toList.get ⟨j + 1, by apply add_lt_of_lt_sub j.prop⟩).card) - (ℬ.toList.get ⟨j, lt_of_lt_pred j.prop⟩).card)! := by --- induction' h_mn using decreasingInduction with n q ih --- · sorry --- · have entry_cards : ∀ j : Fin (ℬ.toList.length - 1), (ℬ.toList.get ⟨j, lt_of_lt_pred j.prop⟩).card = j.val := by sorry --- have rhs_one := by calc --- ∏ j : Fin (ℬ.toList.length - 1), (((ℬ.toList.get ⟨j + 1, by apply add_lt_of_lt_sub j.prop⟩).card) - (ℬ.toList.get ⟨j, lt_of_lt_pred j.prop⟩).card)! = ∏ j : Fin (ℬ.toList.length - 1), 1 := by --- apply Finset.prod_congr (by simp) --- intro j _ --- rw [entry_cards, entry_cards ⟨j + 1, by sorry⟩] --- simp --- _ = 1 := Fintype.prod_eq_one (fun a => 1) (congrFun rfl) --- rw [rhs_one, Fintype.card_eq_one_iff] --- use { --- 𝒜 := ℬ, --- isMaxChain := (IsMaxChain.iff_card hn chainℬ).mpr cardℬ, --- superChain := by --- constructor --- · exact chainℬ --- · subset_rfl ℬ --- } +lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Fintype.card α = n) + (ℬ : Finset (Finset α)) (cardℬ : #ℬ = m) (chainℬ : IsChain (· ⊂ ·) ℬ) + (monotone_cards: Monotone (fun i : Fin ℬ.toList.length ↦ (ℬ.toList.get i).card)) (empty_in_chain : ∅ ∈ ℬ) (univ_in_chain : univ ∈ ℬ) : + Fintype.card (ℬ.MaxChainThrough) = ∏ j : Fin (ℬ.toList.length - 1), (((ℬ.toList.get ⟨j + 1, by apply add_lt_of_lt_sub j.prop⟩).card) - (ℬ.toList.get ⟨j, lt_of_lt_pred j.prop⟩).card)! := by + revert ℬ + induction' h_mn using decreasingInduction with n_ q ih + · intro ℬ cardℬ chainℬ monotone_cards empty_in_chain univ_in_chain + have cardℬ_lt : #ℬ < n + 1 := lt_of_eq_of_lt cardℬ q + have empty_range_existence := range_empty_layer hn chainℬ (IsChain.empty_layer_by_card hn chainℬ cardℬ_lt) empty_in_chain univ_in_chain + let s' : Fin (n + 1) := empty_range_existence.choose + let t' : Fin (n + 1) := empty_range_existence.choose_spec.choose + have empty_range : s' + 2 ≤ t' ∧ #(ℬ # s') = 1 ∧ #(ℬ # t') = 1 ∧ ∀ (j : Fin (n + 1)), s' < j ∧ j < t' → #(ℬ # ↑j) = 0 := empty_range_existence.choose_spec.choose_spec + + let s : Finset.range (n + 1) := ⟨s'.val, mem_range.mpr s'.is_lt⟩ + let t : Finset.range (n + 1) := ⟨t'.val, mem_range.mpr t'.is_lt⟩ + + have ilej_succ_succ : (s : ℕ) + 2 < (t : ℕ) := by + simp + sorry + + have layer_s_exists := Finset.card_eq_one.mp empty_range.right.left + let layer_s := layer_s_exists.choose + have hs : (ℬ # s) = {layer_s} := layer_s_exists.choose_spec + + have layer_t_exists := Finset.card_eq_one.mp empty_range.right.right.left + let layer_t := layer_t_exists.choose + have ht : (ℬ # t) = {layer_t} := layer_t_exists.choose_spec + + have empty_layer : ∀ j ∈ Finset.range (n + 1), s < j ∧ j < t → #(ℬ # ↑j) = 0 := by sorry + -- simp + -- intro j j_lt jgt jlt + -- have := empty_range.right.right.right j ⟨jgt, jlt⟩ + -- simp at this + -- exact this + + have := chain_extension hn (by sorry) chainℬ hs ht (by sorry) + + let chain_extension_candidates := Finset.filter (chain_extension_filter_function ℬ layer_s) (Finset.univ : Finset α) + + have chain_extension_candidates_eq : chain_extension_candidates = layer_t \ layer_s := by + refine' chain_extension hn (by sorry) chainℬ hs ht (by sorry) + + have layer_s_mem_card : layer_s ∈ ℬ ∧ #layer_s = s := by + have := Finset.mem_singleton_self layer_s + rw [←hs] at this + simp [slice] at this + exact this + + have layer_t_mem_card : layer_t ∈ ℬ ∧ #layer_t = t := by + have := Finset.mem_singleton_self layer_t + rw [←ht] at this + simp [slice] at this + exact this + + have chain_extension_candidates_card : #chain_extension_candidates = t - s := by + rw [chain_extension_candidates_eq] + have card_bottom_lt_card_top : #layer_s < #layer_t := by + rw [layer_s_mem_card.right, layer_t_mem_card.right] + linarith + have bottom_subset_top : layer_s ⊂ layer_t := + IsChain.ssubset_of_lt_cardinality chainℬ layer_s_mem_card.left layer_t_mem_card.left card_bottom_lt_card_top + have := Finset.card_sdiff_add_card_eq_card bottom_subset_top.left + rw [←layer_s_mem_card.right, ←layer_t_mem_card.right] + exact Nat.eq_sub_of_add_eq this + + let i_s := ℬ.toList.indexOf layer_s + have layer_s_memList : layer_s ∈ ℬ.toList := by + rw [mem_toList] + exact layer_s_mem_card.left + have i_s_in_range : i_s < ℬ.toList.length := List.indexOf_lt_length.mpr layer_s_memList + have h_i_s : ℬ.toList.get ⟨i_s, i_s_in_range⟩ = layer_s := ℬ.toList.indexOf_get i_s_in_range + + let i_t := ℬ.toList.indexOf layer_t + have layer_t_memList : layer_t ∈ ℬ.toList := by + rw [mem_toList] + exact layer_t_mem_card.left + have i_t_in_range : i_t < ℬ.toList.length := List.indexOf_lt_length.mpr layer_t_memList + have h_i_t : ℬ.toList.get ⟨i_t, i_t_in_range⟩ = layer_t := ℬ.toList.indexOf_get i_t_in_range + + have i_s_i_t : i_t = i_s + 1 := by sorry + + have is_upperbound : i_s < ℬ.toList.length - 1 := + have : i_s + 1 < ℬ.toList.length := by rw [←i_s_i_t]; exact i_t_in_range + lt_sub_of_add_lt this + + let extensions_wrt (x : α) : Finset (Finset (Finset α)) := by + let ℬ' : Finset (Finset α) := Insert.insert (Insert.insert x layer_s) ℬ + exact (Finset.univ : Finset ℬ'.MaxChainThrough).image (emb_MaxChainThrough ℬ') + + /- Here the induction hypothesis ih is applied-/ + have card_extensions_wrt (x : chain_extension_candidates) : #(extensions_wrt x) = (#((ℬ.toList.get ⟨i_s + 1, by sorry⟩)) - #(ℬ.toList.get ⟨i_s, by sorry⟩) - 1)! * ∏ j : { j : Fin (ℬ.toList.length - 1) // j ≠ ⟨i_s, is_upperbound⟩ }, (#((ℬ.toList.get ⟨j + 1, by sorry⟩)) - #(ℬ.toList.get ⟨j, by sorry⟩))! := by sorry + + /-The set of maximal chains through ℬ is the disjoint union of maximal chains through the union of ℬ with some chain extension candidate-/ + have central_identity: (Finset.univ : Finset ℬ.MaxChainThrough).image (emb_MaxChainThrough ℬ) = chain_extension_candidates.disjiUnion extensions_wrt (by sorry) := by sorry + + have := Finset.card_image_of_injective (Finset.univ : Finset ℬ.MaxChainThrough) (inj_emb_MaxChainThrough ℬ) + + rw [Fintype.card, ←this, central_identity, card_disjiUnion] + + calc + ∑ a ∈ chain_extension_candidates, #(extensions_wrt a) = + ∑ a ∈ chain_extension_candidates, ∏ j : { j : Fin (ℬ.toList.length - 1) // j ≠ ⟨i_s, is_upperbound⟩ }, (#((ℬ.toList.get ⟨i_s + 1, by sorry⟩)) - #(ℬ.toList.get ⟨i_s, by sorry⟩) - 1)! * (#((ℬ.toList.get ⟨j + 1, by sorry⟩)) - #(ℬ.toList.get ⟨j, by sorry⟩))! := by + apply sum_congr (by simp) + intro x hx + sorry + --exact card_extensions_wrt ⟨x, hx⟩ + _ = (#((ℬ.toList.get ⟨i_s + 1, by sorry⟩)) - #(ℬ.toList.get ⟨i_s, by sorry⟩) - 1)! * ∑ a ∈ chain_extension_candidates, ∏ j : { j : Fin (ℬ.toList.length - 1) // j ≠ ⟨i_s, is_upperbound⟩ }, (#((ℬ.toList.get ⟨j + 1, by sorry⟩)) - #(ℬ.toList.get ⟨j, by sorry⟩))! + + · intro ℬ cardℬ chainℬ monotone_cards empty_in_chain univ_in_chain + have entry_cards : ∀ j : Fin (ℬ.toList.length - 1), (ℬ.toList.get ⟨j, lt_of_lt_pred j.prop⟩).card = j.val := by sorry + have rhs_one := by calc + ∏ j : Fin (ℬ.toList.length - 1), (((ℬ.toList.get ⟨j + 1, by apply add_lt_of_lt_sub j.prop⟩).card) - (ℬ.toList.get ⟨j, lt_of_lt_pred j.prop⟩).card)! = ∏ j : Fin (ℬ.toList.length - 1), 1 := by + apply Finset.prod_congr (by simp) + intro j _ + rw [entry_cards, entry_cards ⟨j + 1, by sorry⟩] + simp + _ = 1 := Fintype.prod_eq_one (fun a => 1) (congrFun rfl) + rw [rhs_one, Fintype.card_eq_one_iff] + have ℬmaxChain := (IsMaxChain.iff_card hn chainℬ).mpr cardℬ + use { + 𝒜 := ℬ, + isMaxChain := ℬmaxChain, + subChain := by simp + } + intro X + have same_elements : X.𝒜 = ℬ := (ℬmaxChain.right X.isMaxChain.left X.subChain).symm + rcases X with ⟨X.𝒜, b, c⟩ + simpa lemma count_maxChains_through_singleton (e : Finset α) (hn : Fintype.card α = n): Fintype.card (MaxChainThrough {e}) = (#e)! * (n - #e)! := by sorry From ad6527da76979a421387d04e89c62bd3cccab5bc Mon Sep 17 00:00:00 2001 From: Jakob Zimmermann Date: Sat, 18 Jan 2025 13:06:40 +0100 Subject: [PATCH 11/26] cleaning up, outsourcing proof components and continuing work on count_maxChainsThrough --- TheBook/Combinatorics/Sperner.lean | 227 +++++++++++++++++++---------- 1 file changed, 152 insertions(+), 75 deletions(-) diff --git a/TheBook/Combinatorics/Sperner.lean b/TheBook/Combinatorics/Sperner.lean index 4353154..ca99d33 100644 --- a/TheBook/Combinatorics/Sperner.lean +++ b/TheBook/Combinatorics/Sperner.lean @@ -206,7 +206,7 @@ lemma IsChain.empty_layer_by_card (hn : Fintype.card α = n) (chain𝒜 : IsChai linarith lemma range_empty_layer (hn : Fintype.card α = n) (chain𝒜 : IsChain (· ⊂ ·) 𝒜) (empty_layer : ∃ i : Fin (n + 1), #(𝒜 # i) = 0) (empty_elt : ∅ ∈ 𝒜) (univ_elt : Finset.univ ∈ 𝒜) : - ∃ s : Fin (n + 1), ∃ t : Fin (n + 1), s + 2 ≤ t ∧ #(𝒜 # s) = 1 ∧ #(𝒜 # t) = 1 ∧ ∀ j : Fin (n + 1), s < j ∧ j < t → #(𝒜 # j) = 0 := by sorry + ∃ s : Fin (n + 1), ∃ t : Fin (n + 1), s.val + 2 ≤ t.val ∧ #(𝒜 # s) = 1 ∧ #(𝒜 # t) = 1 ∧ ∀ j : Fin (n + 1), s < j ∧ j < t → #(𝒜 # j) = 0 := by sorry lemma chain_extension (hn : Fintype.card α = n) {i j : Finset.range (n + 1)} (ilej_succ_succ : (i : ℕ) + 2 ≤ (j : ℕ)) (chain𝒜 : IsChain (· ⊂ ·) 𝒜) (hi : (𝒜 # i) = {layer_i}) (hj : (𝒜 # j) = {layer_j}) (emptylayer : ∀ l ∈ (Finset.range (n + 1)), i < l → l < j → #(𝒜 # l) = 0): @@ -467,20 +467,18 @@ lemma one_elt_max_chain_layer (hn : Fintype.card α = n) (maxchain𝒜 : IsMaxCh | inl jltl => exact h_top jltl | inr jgtl => exact h_bottom jgtl - let e_bottom := (layer_singleton_of_nonempty maxchain𝒜.left s_bottom h_s_bottom.right).choose - have bottom_singleton : 𝒜 # s_bottom = {e_bottom} := (layer_singleton_of_nonempty maxchain𝒜.left s_bottom h_s_bottom.right).choose_spec.left + obtain ⟨e_bottom, ⟨bottom_singleton : 𝒜 # s_bottom = {e_bottom}, _⟩⟩ := layer_singleton_of_nonempty maxchain𝒜.left s_bottom h_s_bottom.right - let e_top := (layer_singleton_of_nonempty maxchain𝒜.left s_top h_s_top.right).choose - have top_singleton : 𝒜 # s_top = {e_top} := (layer_singleton_of_nonempty maxchain𝒜.left s_top h_s_top.right).choose_spec.left + obtain ⟨e_top, ⟨top_singleton : 𝒜 # s_top = {e_top}, _⟩⟩ := layer_singleton_of_nonempty maxchain𝒜.left s_top h_s_top.right - let chain_extension_candidates := Finset.filter (chain_extension_filter_function 𝒜 e_bottom) (Finset.univ : Finset α) + let extension_candidates := Finset.filter (chain_extension_filter_function 𝒜 e_bottom) (Finset.univ : Finset α) - have chain_extension_candidates_eq : chain_extension_candidates = e_top \ e_bottom := by + have extension_candidates_eq : extension_candidates = e_top \ e_bottom := by refine' chain_extension hn _ maxchain𝒜.left bottom_singleton top_singleton emptylayer apply Nat.succ_le_of_lt have : (s_bottom : ℕ) + 1 ≤ ↑j := Nat.succ_le_of_lt h_s_bottom.left exact Nat.lt_of_le_of_lt this h_s_top.left - simp at chain_extension_candidates_eq + simp at extension_candidates_eq have e_bottom_mem_card : e_bottom ∈ 𝒜 ∧ #e_bottom = s_bottom := by have := Finset.mem_singleton_self e_bottom @@ -494,8 +492,8 @@ lemma one_elt_max_chain_layer (hn : Fintype.card α = n) (maxchain𝒜 : IsMaxCh simp [slice] at this exact this - have chain_extension_candidates_ne_empty : #chain_extension_candidates > 0 := by - rw [chain_extension_candidates_eq] + have extension_candidates_ne_empty : #extension_candidates > 0 := by + rw [extension_candidates_eq] have card_bottom_lt_card_top : #e_bottom < #e_top := by rw [e_top_mem_card.right, e_bottom_mem_card.right] exact Nat.lt_trans h_s_bottom.left h_s_top.left @@ -503,9 +501,9 @@ lemma one_elt_max_chain_layer (hn : Fintype.card α = n) (maxchain𝒜 : IsMaxCh IsChain.ssubset_of_lt_cardinality maxchain𝒜.left e_bottom_mem_card.left e_top_mem_card.left card_bottom_lt_card_top have := Finset.card_sdiff_add_card_eq_card bottom_subset_top.left linarith - simp at chain_extension_candidates_ne_empty - obtain ⟨a, ha⟩ := chain_extension_candidates_ne_empty - simp [chain_extension_candidates, chain_extension_filter_function] at ha + simp at extension_candidates_ne_empty + obtain ⟨a, ha⟩ := extension_candidates_ne_empty + simp [extension_candidates, chain_extension_filter_function] at ha have := Finset.insert_eq_self.mp (maxchain𝒜.right ha.left (by simp)).symm exact ha.right this @@ -551,62 +549,153 @@ lemma card_maxChainThrough {ℬ : Finset (Finset α)} (hn : Fintype.card α = n) exact one_elt_max_chain_layer hn chain.isMaxChain ⟨j, by simp [Nat.lt_succ_of_le jmem]⟩ _ = n + 1 := by rw [←(Finset.card_eq_sum_ones (Iic (Fintype.card α)))]; simp [hn] +lemma mem_card_of_slice {ℬ : Finset (Finset α)} (h : (ℬ # s) = {layer_s}) : layer_s ∈ ℬ ∧ #layer_s = s := by + have := Finset.mem_singleton_self layer_s + rw [←h] at this + simp [slice] at this + exact this + +#check length_toList + +lemma incident_indices_monotone_cards {n: ℕ} {s t : Fin (n + 1)} {ℬ : Finset (Finset α)} (ilej_succ_succ : s.val + 2 ≤ t.val) (hn : Fintype.card α = n) + (monotone_cards: StrictMono (fun i : Fin ℬ.toList.length ↦ (ℬ.toList.get i).card)) + (hs : (ℬ # s) = {layer_s}) (ht : (ℬ # t) = {layer_t}) + (empty_layer : ∀ j : Fin (n + 1), s < j → j < t → #(ℬ # ↑j) = 0) : + ∃ i_s : Fin (ℬ.toList.length - 1), ℬ.toList.get? i_s = layer_s ∧ ℬ.toList.get? (i_s.val + 1) = layer_t := by + + let i_s := ℬ.toList.indexOf layer_s + have i_s_in_range : i_s < ℬ.toList.length := List.indexOf_lt_length.mpr (mem_toList.mpr (mem_card_of_slice hs).left) + have h_i_s : ℬ.toList.get ⟨i_s, i_s_in_range⟩ = layer_s := ℬ.toList.indexOf_get i_s_in_range + + let i_t := ℬ.toList.indexOf layer_t + have i_t_in_range : i_t < ℬ.toList.length := List.indexOf_lt_length.mpr (mem_toList.mpr (mem_card_of_slice ht).left) + have h_i_t : ℬ.toList.get ⟨i_t, i_t_in_range⟩ = layer_t := ℬ.toList.indexOf_get i_t_in_range + + have i_s_eq_i_t_succ : i_t = i_s + 1 := by + by_contra ass₁ + have : (⟨i_t, i_t_in_range⟩ : Fin ℬ.toList.length) > (⟨i_s, i_s_in_range⟩ : Fin ℬ.toList.length) := by + by_contra! ass₂ + have := (StrictMono.monotone monotone_cards) ass₂ + simp only [h_i_s, h_i_t, (mem_card_of_slice hs).right, (mem_card_of_slice ht).right] at this + linarith + have i_s_succ_lt : i_s + 1 < i_t := Nat.lt_of_le_of_ne this fun a => ass₁ (id (Eq.symm a)) + + let e := ℬ.toList.get ⟨i_s + 1, Nat.lt_trans i_s_succ_lt i_t_in_range⟩ + + have e_card_gt' : #e > s := by + have : (⟨i_s, i_s_in_range⟩ : Fin ℬ.toList.length) < (⟨i_s + 1, Nat.lt_trans i_s_succ_lt i_t_in_range⟩ : Fin ℬ.toList.length) := by simp + have := monotone_cards this + simp only [h_i_s, (mem_card_of_slice hs).right] at this + exact this + + have e_card_lt' : #e < t := by + have : (⟨i_t, i_t_in_range⟩ : Fin ℬ.toList.length) > (⟨i_s + 1, Nat.lt_trans i_s_succ_lt i_t_in_range⟩ : Fin ℬ.toList.length) := by simp [i_s_succ_lt] + have := monotone_cards this + simp only [h_i_t, (mem_card_of_slice ht).right] at this + exact this + + have card_e_mod : #e % (n + 1) = #e := mod_eq_of_lt (Nat.lt_trans e_card_lt' t.is_lt) + + have e_card_gt : Fin.ofNat #e > s := by simp [Fin.ofNat, card_e_mod]; exact e_card_gt' + have e_card_lt : Fin.ofNat #e < t := by simp [Fin.ofNat, card_e_mod]; exact e_card_lt' + + + have layer_empty := empty_layer (Fin.ofNat #e) e_card_gt e_card_lt + + have layer_nonempty : e ∈ (ℬ # ↑(Fin.ofNat #e : Fin (n + 1))) := by + simp [mem_slice] + constructor + · apply mem_toList.mp + exact List.get_mem ℬ.toList (i_s + 1) (Nat.lt_trans i_s_succ_lt i_t_in_range) + · simp [Fin.ofNat, card_e_mod] + + simp at layer_empty + + simp [layer_empty] at layer_nonempty + + have i_s_upperbound : i_s < ℬ.toList.length - 1 := + have : i_s + 1 < ℬ.toList.length := by rw [←i_s_eq_i_t_succ]; exact i_t_in_range + lt_sub_of_add_lt this + + use ⟨i_s, i_s_upperbound⟩ + + simp only [i_s_eq_i_t_succ] at h_i_t + + + have h_i_s' : ℬ.toList.get? i_s = layer_s := by + refine' List.get?_eq_some.mpr _ + use Nat.lt_of_lt_of_le i_s_upperbound (Nat.pred_le ℬ.toList.length) + + have h_i_t' : ℬ.toList.get? (i_s + 1) = layer_t := by + refine' List.get?_eq_some.mpr _ + use add_lt_of_lt_sub i_s_upperbound + + exact ⟨h_i_s', h_i_t'⟩ + + lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Fintype.card α = n) (ℬ : Finset (Finset α)) (cardℬ : #ℬ = m) (chainℬ : IsChain (· ⊂ ·) ℬ) - (monotone_cards: Monotone (fun i : Fin ℬ.toList.length ↦ (ℬ.toList.get i).card)) (empty_in_chain : ∅ ∈ ℬ) (univ_in_chain : univ ∈ ℬ) : - Fintype.card (ℬ.MaxChainThrough) = ∏ j : Fin (ℬ.toList.length - 1), (((ℬ.toList.get ⟨j + 1, by apply add_lt_of_lt_sub j.prop⟩).card) - (ℬ.toList.get ⟨j, lt_of_lt_pred j.prop⟩).card)! := by + (monotone_cards: StrictMono (fun i : Fin ℬ.toList.length ↦ (ℬ.toList.get i).card)) (empty_in_chain : ∅ ∈ ℬ) (univ_in_chain : univ ∈ ℬ) : + Fintype.card (ℬ.MaxChainThrough) = ∏ j : Fin (ℬ.toList.length - 1), (#(ℬ.toList.get ⟨j + 1, by apply add_lt_of_lt_sub j.prop⟩) - #(ℬ.toList.get ⟨j, lt_of_lt_pred j.prop⟩))! := by revert ℬ induction' h_mn using decreasingInduction with n_ q ih · intro ℬ cardℬ chainℬ monotone_cards empty_in_chain univ_in_chain - have cardℬ_lt : #ℬ < n + 1 := lt_of_eq_of_lt cardℬ q - have empty_range_existence := range_empty_layer hn chainℬ (IsChain.empty_layer_by_card hn chainℬ cardℬ_lt) empty_in_chain univ_in_chain - let s' : Fin (n + 1) := empty_range_existence.choose - let t' : Fin (n + 1) := empty_range_existence.choose_spec.choose - have empty_range : s' + 2 ≤ t' ∧ #(ℬ # s') = 1 ∧ #(ℬ # t') = 1 ∧ ∀ (j : Fin (n + 1)), s' < j ∧ j < t' → #(ℬ # ↑j) = 0 := empty_range_existence.choose_spec.choose_spec + + obtain ⟨s', t', empty_range : s'.val + 2 ≤ t'.val ∧ #(ℬ # s') = 1 ∧ #(ℬ # t') = 1 ∧ ∀ (j : Fin (n + 1)), s' < j ∧ j < t' → #(ℬ # ↑j) = 0⟩ := + range_empty_layer hn chainℬ (IsChain.empty_layer_by_card hn chainℬ (lt_of_eq_of_lt cardℬ q)) empty_in_chain univ_in_chain let s : Finset.range (n + 1) := ⟨s'.val, mem_range.mpr s'.is_lt⟩ let t : Finset.range (n + 1) := ⟨t'.val, mem_range.mpr t'.is_lt⟩ - have ilej_succ_succ : (s : ℕ) + 2 < (t : ℕ) := by + have ilej_succ_succ : (s : ℕ) + 2 ≤ (t : ℕ) := by simp [empty_range.left] + + obtain ⟨layer_t, ht : (ℬ # t) = {layer_t}⟩ := Finset.card_eq_one.mp empty_range.right.right.left + obtain ⟨layer_s, hs : (ℬ # s) = {layer_s}⟩ := Finset.card_eq_one.mp empty_range.right.left + + + have empty_layer' : ∀ j ∈ Finset.range (n + 1), s < j → j < t → #(ℬ # ↑j) = 0 := by + simp + intro j jinrange jgt jlt + + have nsuccnezero : n + 1 ≠ 0 := by simp + have jmod : j % (n + 1) = j := (mod_eq_iff_lt nsuccnezero).mpr jinrange + have s'ltj : s' < Fin.ofNat j := by simp [Fin.ofNat, jmod]; exact jgt + have jltt' : Fin.ofNat j < t' := by simp [Fin.ofNat, jmod]; exact jlt + have := empty_range.right.right.right j ⟨s'ltj, jltt'⟩ + simp [jmod] at this + exact this + + have empty_layer : ∀ j : Fin (n + 1), s' < j → j < t' → #(ℬ # ↑j) = 0 := by simp - sorry + intro j jgt jlt - have layer_s_exists := Finset.card_eq_one.mp empty_range.right.left - let layer_s := layer_s_exists.choose - have hs : (ℬ # s) = {layer_s} := layer_s_exists.choose_spec + have nsuccnezero : n + 1 ≠ 0 := by simp + have := empty_range.right.right.right j ⟨jgt, jlt⟩ + simp at this + exact this - have layer_t_exists := Finset.card_eq_one.mp empty_range.right.right.left - let layer_t := layer_t_exists.choose - have ht : (ℬ # t) = {layer_t} := layer_t_exists.choose_spec + let extension_candidates := Finset.filter (chain_extension_filter_function ℬ layer_s) (Finset.univ : Finset α) - have empty_layer : ∀ j ∈ Finset.range (n + 1), s < j ∧ j < t → #(ℬ # ↑j) = 0 := by sorry - -- simp - -- intro j j_lt jgt jlt - -- have := empty_range.right.right.right j ⟨jgt, jlt⟩ - -- simp at this - -- exact this + have extension_candidates_eq : extension_candidates = layer_t \ layer_s := by + refine' chain_extension hn ilej_succ_succ chainℬ hs ht empty_layer' - have := chain_extension hn (by sorry) chainℬ hs ht (by sorry) + have layer_s_mem_card := mem_card_of_slice hs + have layer_t_mem_card := mem_card_of_slice ht - let chain_extension_candidates := Finset.filter (chain_extension_filter_function ℬ layer_s) (Finset.univ : Finset α) + obtain ⟨i_s, ⟨entry_i_s', entry_i_s_succ'⟩⟩ := incident_indices_monotone_cards ilej_succ_succ hn monotone_cards hs ht empty_layer - have chain_extension_candidates_eq : chain_extension_candidates = layer_t \ layer_s := by - refine' chain_extension hn (by sorry) chainℬ hs ht (by sorry) + have i_s_in_range : i_s < ℬ.toList.length := Nat.lt_of_lt_of_le i_s.is_lt (Nat.pred_le ℬ.toList.length) + have i_s_succ_in_range : i_s.val + 1 < ℬ.toList.length := add_lt_of_lt_sub i_s.is_lt - have layer_s_mem_card : layer_s ∈ ℬ ∧ #layer_s = s := by - have := Finset.mem_singleton_self layer_s - rw [←hs] at this - simp [slice] at this - exact this + have entry_i_s : ℬ.toList.get ⟨i_s, i_s_in_range⟩ = layer_s := by sorry + have entry_i_s_succ : ℬ.toList.get ⟨i_s + 1, i_s_succ_in_range⟩ = layer_t := by sorry - have layer_t_mem_card : layer_t ∈ ℬ ∧ #layer_t = t := by - have := Finset.mem_singleton_self layer_t - rw [←ht] at this - simp [slice] at this - exact this + let multiplicant' (j : Fin (ℬ.toList.length - 1)) : ℕ := (#((ℬ.toList.get ⟨j + 1, add_lt_of_lt_sub j.is_lt⟩)) - #(ℬ.toList.get ⟨j, Nat.lt_of_lt_of_le j.is_lt (Nat.pred_le ℬ.toList.length)⟩) - 1)! + let multiplicant (j : Fin (ℬ.toList.length - 1)) : ℕ := (#((ℬ.toList.get ⟨j + 1, add_lt_of_lt_sub j.is_lt⟩)) - #(ℬ.toList.get ⟨j, Nat.lt_of_lt_of_le j.is_lt (Nat.pred_le ℬ.toList.length)⟩))! - have chain_extension_candidates_card : #chain_extension_candidates = t - s := by - rw [chain_extension_candidates_eq] + have extension_candidates_card : #extension_candidates = #((ℬ.toList.get ⟨i_s + 1, i_s_succ_in_range⟩)) - #(ℬ.toList.get ⟨i_s, i_s_in_range⟩) := by + rw [entry_i_s, entry_i_s_succ, layer_s_mem_card.right, layer_t_mem_card.right] + rw [extension_candidates_eq] have card_bottom_lt_card_top : #layer_s < #layer_t := by rw [layer_s_mem_card.right, layer_t_mem_card.right] linarith @@ -616,48 +705,36 @@ lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Finty rw [←layer_s_mem_card.right, ←layer_t_mem_card.right] exact Nat.eq_sub_of_add_eq this - let i_s := ℬ.toList.indexOf layer_s - have layer_s_memList : layer_s ∈ ℬ.toList := by - rw [mem_toList] - exact layer_s_mem_card.left - have i_s_in_range : i_s < ℬ.toList.length := List.indexOf_lt_length.mpr layer_s_memList - have h_i_s : ℬ.toList.get ⟨i_s, i_s_in_range⟩ = layer_s := ℬ.toList.indexOf_get i_s_in_range - - let i_t := ℬ.toList.indexOf layer_t - have layer_t_memList : layer_t ∈ ℬ.toList := by - rw [mem_toList] - exact layer_t_mem_card.left - have i_t_in_range : i_t < ℬ.toList.length := List.indexOf_lt_length.mpr layer_t_memList - have h_i_t : ℬ.toList.get ⟨i_t, i_t_in_range⟩ = layer_t := ℬ.toList.indexOf_get i_t_in_range - - have i_s_i_t : i_t = i_s + 1 := by sorry - - have is_upperbound : i_s < ℬ.toList.length - 1 := - have : i_s + 1 < ℬ.toList.length := by rw [←i_s_i_t]; exact i_t_in_range - lt_sub_of_add_lt this + let 𝒥 := { j : Fin (ℬ.toList.length - 1) // j ≠ ⟨i_s, i_s.is_lt⟩ } let extensions_wrt (x : α) : Finset (Finset (Finset α)) := by let ℬ' : Finset (Finset α) := Insert.insert (Insert.insert x layer_s) ℬ exact (Finset.univ : Finset ℬ'.MaxChainThrough).image (emb_MaxChainThrough ℬ') /- Here the induction hypothesis ih is applied-/ - have card_extensions_wrt (x : chain_extension_candidates) : #(extensions_wrt x) = (#((ℬ.toList.get ⟨i_s + 1, by sorry⟩)) - #(ℬ.toList.get ⟨i_s, by sorry⟩) - 1)! * ∏ j : { j : Fin (ℬ.toList.length - 1) // j ≠ ⟨i_s, is_upperbound⟩ }, (#((ℬ.toList.get ⟨j + 1, by sorry⟩)) - #(ℬ.toList.get ⟨j, by sorry⟩))! := by sorry + have card_extensions_wrt (a : extension_candidates) : #(extensions_wrt a) = (multiplicant' i_s) * ∏ j : 𝒥, (multiplicant j.1) := by sorry /-The set of maximal chains through ℬ is the disjoint union of maximal chains through the union of ℬ with some chain extension candidate-/ - have central_identity: (Finset.univ : Finset ℬ.MaxChainThrough).image (emb_MaxChainThrough ℬ) = chain_extension_candidates.disjiUnion extensions_wrt (by sorry) := by sorry + have central_identity: (Finset.univ : Finset ℬ.MaxChainThrough).image (emb_MaxChainThrough ℬ) = extension_candidates.disjiUnion extensions_wrt (by sorry) := by sorry have := Finset.card_image_of_injective (Finset.univ : Finset ℬ.MaxChainThrough) (inj_emb_MaxChainThrough ℬ) rw [Fintype.card, ←this, central_identity, card_disjiUnion] calc - ∑ a ∈ chain_extension_candidates, #(extensions_wrt a) = - ∑ a ∈ chain_extension_candidates, ∏ j : { j : Fin (ℬ.toList.length - 1) // j ≠ ⟨i_s, is_upperbound⟩ }, (#((ℬ.toList.get ⟨i_s + 1, by sorry⟩)) - #(ℬ.toList.get ⟨i_s, by sorry⟩) - 1)! * (#((ℬ.toList.get ⟨j + 1, by sorry⟩)) - #(ℬ.toList.get ⟨j, by sorry⟩))! := by + ∑ a ∈ extension_candidates, #(extensions_wrt a) = + ∑ a ∈ extension_candidates, (multiplicant' i_s) * ∏ j : 𝒥, (multiplicant j.1) := by apply sum_congr (by simp) intro x hx + exact card_extensions_wrt ⟨x, hx⟩ + _ = (multiplicant i_s) * ∏ j : 𝒥, (multiplicant j.1) := by + simp only [Finset.sum_const, extension_candidates_card, multiplicant'] + have : (#ℬ.toList[↑i_s + 1] - #ℬ.toList[↑i_s]) > 0 := by sorry + have := mul_factorial_pred this + simp sorry - --exact card_extensions_wrt ⟨x, hx⟩ - _ = (#((ℬ.toList.get ⟨i_s + 1, by sorry⟩)) - #(ℬ.toList.get ⟨i_s, by sorry⟩) - 1)! * ∑ a ∈ chain_extension_candidates, ∏ j : { j : Fin (ℬ.toList.length - 1) // j ≠ ⟨i_s, is_upperbound⟩ }, (#((ℬ.toList.get ⟨j + 1, by sorry⟩)) - #(ℬ.toList.get ⟨j, by sorry⟩))! + + _ = ∏ j : Fin (ℬ.toList.length - 1), (#((ℬ.toList.get ⟨j + 1, add_lt_of_lt_sub j.is_lt⟩)) - #(ℬ.toList.get ⟨j, Nat.lt_of_lt_of_le j.is_lt (Nat.pred_le ℬ.toList.length)⟩))! := by sorry · intro ℬ cardℬ chainℬ monotone_cards empty_in_chain univ_in_chain have entry_cards : ∀ j : Fin (ℬ.toList.length - 1), (ℬ.toList.get ⟨j, lt_of_lt_pred j.prop⟩).card = j.val := by sorry From 5069d32be4d0f097e6b34df9c51879e906fbab6e Mon Sep 17 00:00:00 2001 From: Jakob Zimmermann Date: Sat, 18 Jan 2025 15:11:34 +0100 Subject: [PATCH 12/26] instead of .get and .get? use getElem with the get_elem_tactic --- TheBook/Combinatorics/Sperner.lean | 80 +++++++++++++++--------------- 1 file changed, 41 insertions(+), 39 deletions(-) diff --git a/TheBook/Combinatorics/Sperner.lean b/TheBook/Combinatorics/Sperner.lean index ca99d33..8e28dcd 100644 --- a/TheBook/Combinatorics/Sperner.lean +++ b/TheBook/Combinatorics/Sperner.lean @@ -557,19 +557,19 @@ lemma mem_card_of_slice {ℬ : Finset (Finset α)} (h : (ℬ # s) = {layer_s}) : #check length_toList -lemma incident_indices_monotone_cards {n: ℕ} {s t : Fin (n + 1)} {ℬ : Finset (Finset α)} (ilej_succ_succ : s.val + 2 ≤ t.val) (hn : Fintype.card α = n) - (monotone_cards: StrictMono (fun i : Fin ℬ.toList.length ↦ (ℬ.toList.get i).card)) +lemma incident_indices_monotone_cards {n: ℕ} {s t : Fin (n + 1)} {ℬ : Finset (Finset α)} (ilej_succ_succ : s.val + 2 ≤ t.val) + (monotone_cards: StrictMono (fun i : Fin ℬ.toList.length ↦ (ℬ.toList[i.val]).card)) (hs : (ℬ # s) = {layer_s}) (ht : (ℬ # t) = {layer_t}) (empty_layer : ∀ j : Fin (n + 1), s < j → j < t → #(ℬ # ↑j) = 0) : - ∃ i_s : Fin (ℬ.toList.length - 1), ℬ.toList.get? i_s = layer_s ∧ ℬ.toList.get? (i_s.val + 1) = layer_t := by + ∃ i_s : Fin (ℬ.toList.length - 1), ℬ.toList[i_s.val] = layer_s ∧ ℬ.toList[i_s.val + 1] = layer_t := by let i_s := ℬ.toList.indexOf layer_s have i_s_in_range : i_s < ℬ.toList.length := List.indexOf_lt_length.mpr (mem_toList.mpr (mem_card_of_slice hs).left) - have h_i_s : ℬ.toList.get ⟨i_s, i_s_in_range⟩ = layer_s := ℬ.toList.indexOf_get i_s_in_range + have h_i_s : ℬ.toList[i_s] = layer_s := ℬ.toList.indexOf_get i_s_in_range let i_t := ℬ.toList.indexOf layer_t have i_t_in_range : i_t < ℬ.toList.length := List.indexOf_lt_length.mpr (mem_toList.mpr (mem_card_of_slice ht).left) - have h_i_t : ℬ.toList.get ⟨i_t, i_t_in_range⟩ = layer_t := ℬ.toList.indexOf_get i_t_in_range + have h_i_t : ℬ.toList[i_t] = layer_t := ℬ.toList.indexOf_get i_t_in_range have i_s_eq_i_t_succ : i_t = i_s + 1 := by by_contra ass₁ @@ -580,7 +580,7 @@ lemma incident_indices_monotone_cards {n: ℕ} {s t : Fin (n + 1)} {ℬ : Finset linarith have i_s_succ_lt : i_s + 1 < i_t := Nat.lt_of_le_of_ne this fun a => ass₁ (id (Eq.symm a)) - let e := ℬ.toList.get ⟨i_s + 1, Nat.lt_trans i_s_succ_lt i_t_in_range⟩ + let e := ℬ.toList[i_s + 1] have e_card_gt' : #e > s := by have : (⟨i_s, i_s_in_range⟩ : Fin ℬ.toList.length) < (⟨i_s + 1, Nat.lt_trans i_s_succ_lt i_t_in_range⟩ : Fin ℬ.toList.length) := by simp @@ -621,22 +621,12 @@ lemma incident_indices_monotone_cards {n: ℕ} {s t : Fin (n + 1)} {ℬ : Finset simp only [i_s_eq_i_t_succ] at h_i_t - - have h_i_s' : ℬ.toList.get? i_s = layer_s := by - refine' List.get?_eq_some.mpr _ - use Nat.lt_of_lt_of_le i_s_upperbound (Nat.pred_le ℬ.toList.length) - - have h_i_t' : ℬ.toList.get? (i_s + 1) = layer_t := by - refine' List.get?_eq_some.mpr _ - use add_lt_of_lt_sub i_s_upperbound - - exact ⟨h_i_s', h_i_t'⟩ - + exact ⟨h_i_s, h_i_t⟩ lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Fintype.card α = n) (ℬ : Finset (Finset α)) (cardℬ : #ℬ = m) (chainℬ : IsChain (· ⊂ ·) ℬ) - (monotone_cards: StrictMono (fun i : Fin ℬ.toList.length ↦ (ℬ.toList.get i).card)) (empty_in_chain : ∅ ∈ ℬ) (univ_in_chain : univ ∈ ℬ) : - Fintype.card (ℬ.MaxChainThrough) = ∏ j : Fin (ℬ.toList.length - 1), (#(ℬ.toList.get ⟨j + 1, by apply add_lt_of_lt_sub j.prop⟩) - #(ℬ.toList.get ⟨j, lt_of_lt_pred j.prop⟩))! := by + (monotone_cards: StrictMono (fun (i : Fin ℬ.toList.length) ↦ #ℬ.toList[i])) (empty_in_chain : ∅ ∈ ℬ) (univ_in_chain : univ ∈ ℬ) : + Fintype.card (ℬ.MaxChainThrough) = ∏ j : Fin (ℬ.toList.length - 1), (#ℬ.toList[j.val + 1] - #ℬ.toList[j.val])! := by revert ℬ induction' h_mn using decreasingInduction with n_ q ih · intro ℬ cardℬ chainℬ monotone_cards empty_in_chain univ_in_chain @@ -652,7 +642,6 @@ lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Finty obtain ⟨layer_t, ht : (ℬ # t) = {layer_t}⟩ := Finset.card_eq_one.mp empty_range.right.right.left obtain ⟨layer_s, hs : (ℬ # s) = {layer_s}⟩ := Finset.card_eq_one.mp empty_range.right.left - have empty_layer' : ∀ j ∈ Finset.range (n + 1), s < j → j < t → #(ℬ # ↑j) = 0 := by simp intro j jinrange jgt jlt @@ -682,18 +671,15 @@ lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Finty have layer_s_mem_card := mem_card_of_slice hs have layer_t_mem_card := mem_card_of_slice ht - obtain ⟨i_s, ⟨entry_i_s', entry_i_s_succ'⟩⟩ := incident_indices_monotone_cards ilej_succ_succ hn monotone_cards hs ht empty_layer + obtain ⟨i_s, ⟨entry_i_s, entry_i_s_succ⟩⟩ := incident_indices_monotone_cards ilej_succ_succ monotone_cards hs ht empty_layer have i_s_in_range : i_s < ℬ.toList.length := Nat.lt_of_lt_of_le i_s.is_lt (Nat.pred_le ℬ.toList.length) have i_s_succ_in_range : i_s.val + 1 < ℬ.toList.length := add_lt_of_lt_sub i_s.is_lt - have entry_i_s : ℬ.toList.get ⟨i_s, i_s_in_range⟩ = layer_s := by sorry - have entry_i_s_succ : ℬ.toList.get ⟨i_s + 1, i_s_succ_in_range⟩ = layer_t := by sorry - - let multiplicant' (j : Fin (ℬ.toList.length - 1)) : ℕ := (#((ℬ.toList.get ⟨j + 1, add_lt_of_lt_sub j.is_lt⟩)) - #(ℬ.toList.get ⟨j, Nat.lt_of_lt_of_le j.is_lt (Nat.pred_le ℬ.toList.length)⟩) - 1)! - let multiplicant (j : Fin (ℬ.toList.length - 1)) : ℕ := (#((ℬ.toList.get ⟨j + 1, add_lt_of_lt_sub j.is_lt⟩)) - #(ℬ.toList.get ⟨j, Nat.lt_of_lt_of_le j.is_lt (Nat.pred_le ℬ.toList.length)⟩))! + let multiplicant' (j : Fin (ℬ.toList.length - 1)) : ℕ := (#ℬ.toList[j.val + 1] - #ℬ.toList[j.val] - 1)! + let multiplicant (j : Fin (ℬ.toList.length - 1)) : ℕ := (#ℬ.toList[j.val + 1] - #ℬ.toList[j.val])! - have extension_candidates_card : #extension_candidates = #((ℬ.toList.get ⟨i_s + 1, i_s_succ_in_range⟩)) - #(ℬ.toList.get ⟨i_s, i_s_in_range⟩) := by + have extension_candidates_card : #extension_candidates = #ℬ.toList[i_s.val + 1] - #ℬ.toList[i_s.val] := by rw [entry_i_s, entry_i_s_succ, layer_s_mem_card.right, layer_t_mem_card.right] rw [extension_candidates_eq] have card_bottom_lt_card_top : #layer_s < #layer_t := by @@ -705,14 +691,17 @@ lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Finty rw [←layer_s_mem_card.right, ←layer_t_mem_card.right] exact Nat.eq_sub_of_add_eq this - let 𝒥 := { j : Fin (ℬ.toList.length - 1) // j ≠ ⟨i_s, i_s.is_lt⟩ } + let 𝒥' := { j : Fin (ℬ.toList.length - 1) // j ≠ ⟨i_s, i_s.is_lt⟩ } + let 𝒥 := Fin (ℬ.toList.length - 1) + let 𝒬 := (Finset.univ : Finset (Fin (ℬ.toList.length - 1))) + let 𝒬' := (Finset.univ : Finset (Fin (ℬ.toList.length - 1))) \ {i_s} let extensions_wrt (x : α) : Finset (Finset (Finset α)) := by let ℬ' : Finset (Finset α) := Insert.insert (Insert.insert x layer_s) ℬ exact (Finset.univ : Finset ℬ'.MaxChainThrough).image (emb_MaxChainThrough ℬ') /- Here the induction hypothesis ih is applied-/ - have card_extensions_wrt (a : extension_candidates) : #(extensions_wrt a) = (multiplicant' i_s) * ∏ j : 𝒥, (multiplicant j.1) := by sorry + have card_extensions_wrt (a : extension_candidates) : #(extensions_wrt a) = (multiplicant' i_s) * ∏ j : 𝒥', (multiplicant j.1) := by sorry /-The set of maximal chains through ℬ is the disjoint union of maximal chains through the union of ℬ with some chain extension candidate-/ have central_identity: (Finset.univ : Finset ℬ.MaxChainThrough).image (emb_MaxChainThrough ℬ) = extension_candidates.disjiUnion extensions_wrt (by sorry) := by sorry @@ -721,25 +710,38 @@ lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Finty rw [Fintype.card, ←this, central_identity, card_disjiUnion] + #check Finset.prod_mul_distrib + #check Finset.prod_eq_mul_prod_diff_singleton + #check Finset.prod + calc ∑ a ∈ extension_candidates, #(extensions_wrt a) = - ∑ a ∈ extension_candidates, (multiplicant' i_s) * ∏ j : 𝒥, (multiplicant j.1) := by + ∑ a ∈ extension_candidates, (multiplicant' i_s) * ∏ j : 𝒥', (multiplicant j.1) := by apply sum_congr (by simp) intro x hx exact card_extensions_wrt ⟨x, hx⟩ - _ = (multiplicant i_s) * ∏ j : 𝒥, (multiplicant j.1) := by - simp only [Finset.sum_const, extension_candidates_card, multiplicant'] - have : (#ℬ.toList[↑i_s + 1] - #ℬ.toList[↑i_s]) > 0 := by sorry - have := mul_factorial_pred this - simp - sorry + _ = (multiplicant i_s) * ∏ j : 𝒥', (multiplicant j.1) := by + simp [Finset.sum_const, extension_candidates_card, multiplicant'] + rw [←mul_assoc] + congr + simp [multiplicant] + apply mul_factorial_pred _ + · simp [entry_i_s, entry_i_s_succ, layer_s_mem_card.right, layer_t_mem_card.right] + have : s'.val < t'.val := by linarith [empty_range.left] + exact this + _ = (multiplicant i_s) * ∏ j ∈ 𝒬', (multiplicant j) := by simp + _ = ∏ j : Fin (ℬ.toList.length - 1), (multiplicant j) := by + simp [𝒥'] + apply Finset.prod_eq_mul_prod_diff_singleton + + _ = ∏ j : Fin (ℬ.toList.length - 1), (#ℬ.toList[j.val + 1] - #ℬ.toList[j.val])! := by sorry + - _ = ∏ j : Fin (ℬ.toList.length - 1), (#((ℬ.toList.get ⟨j + 1, add_lt_of_lt_sub j.is_lt⟩)) - #(ℬ.toList.get ⟨j, Nat.lt_of_lt_of_le j.is_lt (Nat.pred_le ℬ.toList.length)⟩))! := by sorry · intro ℬ cardℬ chainℬ monotone_cards empty_in_chain univ_in_chain - have entry_cards : ∀ j : Fin (ℬ.toList.length - 1), (ℬ.toList.get ⟨j, lt_of_lt_pred j.prop⟩).card = j.val := by sorry + have entry_cards : ∀ j : Fin (ℬ.toList.length - 1), #ℬ.toList[j.val] = j.val := by sorry have rhs_one := by calc - ∏ j : Fin (ℬ.toList.length - 1), (((ℬ.toList.get ⟨j + 1, by apply add_lt_of_lt_sub j.prop⟩).card) - (ℬ.toList.get ⟨j, lt_of_lt_pred j.prop⟩).card)! = ∏ j : Fin (ℬ.toList.length - 1), 1 := by + ∏ j : Fin (ℬ.toList.length - 1), (#ℬ.toList[j.val + 1] - #ℬ.toList[j.val])! = ∏ j : Fin (ℬ.toList.length - 1), 1 := by apply Finset.prod_congr (by simp) intro j _ rw [entry_cards, entry_cards ⟨j + 1, by sorry⟩] From 83f31a4dc02ab5fdd54cc0897369324b5eeeee6c Mon Sep 17 00:00:00 2001 From: Jakob Zimmermann Date: Sat, 18 Jan 2025 15:21:21 +0100 Subject: [PATCH 13/26] changed product notation in count_maxChainsThrough --- TheBook/Combinatorics/Sperner.lean | 31 +++++++++++++----------------- 1 file changed, 13 insertions(+), 18 deletions(-) diff --git a/TheBook/Combinatorics/Sperner.lean b/TheBook/Combinatorics/Sperner.lean index 8e28dcd..cea200b 100644 --- a/TheBook/Combinatorics/Sperner.lean +++ b/TheBook/Combinatorics/Sperner.lean @@ -626,7 +626,7 @@ lemma incident_indices_monotone_cards {n: ℕ} {s t : Fin (n + 1)} {ℬ : Finset lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Fintype.card α = n) (ℬ : Finset (Finset α)) (cardℬ : #ℬ = m) (chainℬ : IsChain (· ⊂ ·) ℬ) (monotone_cards: StrictMono (fun (i : Fin ℬ.toList.length) ↦ #ℬ.toList[i])) (empty_in_chain : ∅ ∈ ℬ) (univ_in_chain : univ ∈ ℬ) : - Fintype.card (ℬ.MaxChainThrough) = ∏ j : Fin (ℬ.toList.length - 1), (#ℬ.toList[j.val + 1] - #ℬ.toList[j.val])! := by + Fintype.card (ℬ.MaxChainThrough) = ∏ j ∈ (Finset.univ : Finset (Fin (ℬ.toList.length - 1))), (#ℬ.toList[j.val + 1] - #ℬ.toList[j.val])! := by revert ℬ induction' h_mn using decreasingInduction with n_ q ih · intro ℬ cardℬ chainℬ monotone_cards empty_in_chain univ_in_chain @@ -691,17 +691,15 @@ lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Finty rw [←layer_s_mem_card.right, ←layer_t_mem_card.right] exact Nat.eq_sub_of_add_eq this - let 𝒥' := { j : Fin (ℬ.toList.length - 1) // j ≠ ⟨i_s, i_s.is_lt⟩ } - let 𝒥 := Fin (ℬ.toList.length - 1) let 𝒬 := (Finset.univ : Finset (Fin (ℬ.toList.length - 1))) - let 𝒬' := (Finset.univ : Finset (Fin (ℬ.toList.length - 1))) \ {i_s} + let 𝒬' := 𝒬 \ {i_s} let extensions_wrt (x : α) : Finset (Finset (Finset α)) := by let ℬ' : Finset (Finset α) := Insert.insert (Insert.insert x layer_s) ℬ exact (Finset.univ : Finset ℬ'.MaxChainThrough).image (emb_MaxChainThrough ℬ') /- Here the induction hypothesis ih is applied-/ - have card_extensions_wrt (a : extension_candidates) : #(extensions_wrt a) = (multiplicant' i_s) * ∏ j : 𝒥', (multiplicant j.1) := by sorry + have card_extensions_wrt (a : extension_candidates) : #(extensions_wrt a) = (multiplicant' i_s) * ∏ j ∈ 𝒬', (multiplicant j) := by sorry /-The set of maximal chains through ℬ is the disjoint union of maximal chains through the union of ℬ with some chain extension candidate-/ have central_identity: (Finset.univ : Finset ℬ.MaxChainThrough).image (emb_MaxChainThrough ℬ) = extension_candidates.disjiUnion extensions_wrt (by sorry) := by sorry @@ -710,17 +708,13 @@ lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Finty rw [Fintype.card, ←this, central_identity, card_disjiUnion] - #check Finset.prod_mul_distrib - #check Finset.prod_eq_mul_prod_diff_singleton - #check Finset.prod - calc ∑ a ∈ extension_candidates, #(extensions_wrt a) = - ∑ a ∈ extension_candidates, (multiplicant' i_s) * ∏ j : 𝒥', (multiplicant j.1) := by + ∑ a ∈ extension_candidates, (multiplicant' i_s) * ∏ j ∈ 𝒬', (multiplicant j) := by apply sum_congr (by simp) intro x hx exact card_extensions_wrt ⟨x, hx⟩ - _ = (multiplicant i_s) * ∏ j : 𝒥', (multiplicant j.1) := by + _ = (multiplicant i_s) * ∏ j ∈ 𝒬', (multiplicant j) := by simp [Finset.sum_const, extension_candidates_card, multiplicant'] rw [←mul_assoc] congr @@ -730,13 +724,14 @@ lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Finty have : s'.val < t'.val := by linarith [empty_range.left] exact this _ = (multiplicant i_s) * ∏ j ∈ 𝒬', (multiplicant j) := by simp - _ = ∏ j : Fin (ℬ.toList.length - 1), (multiplicant j) := by - simp [𝒥'] - apply Finset.prod_eq_mul_prod_diff_singleton - - _ = ∏ j : Fin (ℬ.toList.length - 1), (#ℬ.toList[j.val + 1] - #ℬ.toList[j.val])! := by sorry - - + _ = ∏ j ∈ 𝒬, (multiplicant j) := by + simp [𝒬'] + have : i_s ∈ 𝒬 := by simp [𝒬] + exact (Finset.prod_eq_mul_prod_diff_singleton this multiplicant).symm + _ = ∏ j ∈ 𝒬, (#ℬ.toList[j.val + 1] - #ℬ.toList[j.val])! := by + apply prod_congr (by simp) + intro x hx + rfl · intro ℬ cardℬ chainℬ monotone_cards empty_in_chain univ_in_chain have entry_cards : ∀ j : Fin (ℬ.toList.length - 1), #ℬ.toList[j.val] = j.val := by sorry From 8db27fc2ebc6ee179c0dfb8a5f4948c70eda9638 Mon Sep 17 00:00:00 2001 From: Jakob Zimmermann Date: Sat, 18 Jan 2025 17:00:13 +0100 Subject: [PATCH 14/26] continued work on count_maxChainsThrough --- TheBook/Combinatorics/Sperner.lean | 46 ++++++++++++++++++++++++++++-- 1 file changed, 44 insertions(+), 2 deletions(-) diff --git a/TheBook/Combinatorics/Sperner.lean b/TheBook/Combinatorics/Sperner.lean index cea200b..2f5323c 100644 --- a/TheBook/Combinatorics/Sperner.lean +++ b/TheBook/Combinatorics/Sperner.lean @@ -24,6 +24,7 @@ import Mathlib.Data.Finset.Slice import Mathlib.Order.Antichain import Mathlib.Order.Chain +-- set_option maxHeartbeats 200000 /-! # Proof of the LYM inequality and some observations on chains wrt the subset order @@ -626,7 +627,7 @@ lemma incident_indices_monotone_cards {n: ℕ} {s t : Fin (n + 1)} {ℬ : Finset lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Fintype.card α = n) (ℬ : Finset (Finset α)) (cardℬ : #ℬ = m) (chainℬ : IsChain (· ⊂ ·) ℬ) (monotone_cards: StrictMono (fun (i : Fin ℬ.toList.length) ↦ #ℬ.toList[i])) (empty_in_chain : ∅ ∈ ℬ) (univ_in_chain : univ ∈ ℬ) : - Fintype.card (ℬ.MaxChainThrough) = ∏ j ∈ (Finset.univ : Finset (Fin (ℬ.toList.length - 1))), (#ℬ.toList[j.val + 1] - #ℬ.toList[j.val])! := by + Fintype.card (ℬ.MaxChainThrough) = ∏ j : Fin (ℬ.toList.length - 1), (#ℬ.toList[j.val + 1] - #ℬ.toList[j.val])! := by revert ℬ induction' h_mn using decreasingInduction with n_ q ih · intro ℬ cardℬ chainℬ monotone_cards empty_in_chain univ_in_chain @@ -699,7 +700,48 @@ lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Finty exact (Finset.univ : Finset ℬ'.MaxChainThrough).image (emb_MaxChainThrough ℬ') /- Here the induction hypothesis ih is applied-/ - have card_extensions_wrt (a : extension_candidates) : #(extensions_wrt a) = (multiplicant' i_s) * ∏ j ∈ 𝒬', (multiplicant j) := by sorry + have card_extensions_wrt (a : extension_candidates) : #(extensions_wrt a) = (multiplicant' i_s) * ∏ j ∈ 𝒬', (multiplicant j) := by + let e_new := Insert.insert (↑a) layer_s + let ℬ' := (Insert.insert e_new ℬ) + + have a_property₁ := a.prop + simp only [extension_candidates, mem_filter, chain_extension_filter_function] at a_property₁ + + have a_property₂ := a.prop + simp [extension_candidates_eq] at a_property₂ + + have ℬ'card : #ℬ' = n_ + 1 := by + simp [ℬ', ←cardℬ] + apply Finset.card_insert_of_not_mem + · exact a_property₁.right.right + + have monotone_cards' : StrictMono (fun (i : Fin ℬ'.toList.length) ↦ #ℬ'.toList[i]) := by sorry + + have := Finset.card_image_of_injective (Finset.univ : Finset (MaxChainThrough ℬ')) (inj_emb_MaxChainThrough ℬ') + simp [extensions_wrt, this] + + have empty_in_chain' : ∅ ∈ ℬ' := by simp [ℬ']; exact mem_insert_iff.mpr (Or.inr empty_in_chain) + have univ_in_chain' : univ ∈ ℬ' := by simp [ℬ']; exact mem_insert_iff.mpr (Or.inr univ_in_chain) + + let i_new := ℬ'.toList.indexOf e_new + have i_new_in_range : i_new < ℬ'.toList.length := List.indexOf_lt_length.mpr (mem_toList.mpr (mem_insert_self e_new ℬ)) + have h_i_new : ℬ'.toList[i_new] = e_new := ℬ'.toList.indexOf_get i_new_in_range + + let i_new' : Fin (ℬ'.toList.length - 1) := ⟨i_new, by sorry⟩ + have h_i_new' : i_new' ∈ (Finset.univ : Finset (Fin (ℬ'.toList.length - 1))) := by simp + + have ind_present := ih ℬ' ℬ'card a_property₁.right.left monotone_cards' empty_in_chain' univ_in_chain' + + have product_split := Finset.prod_eq_mul_prod_diff_singleton h_i_new' (fun (i : Fin (ℬ'.toList.length - 1)) ↦ (#ℬ'.toList[i.val + 1] - #ℬ'.toList[i.val])!) + + rw [ind_present, product_split] + + have prod_identity : ∏ j ∈ 𝒬', multiplicant j = ∏ x ∈ univ \ {i_new'}, (#ℬ'.toList[↑x + 1] - #ℬ'.toList[↑x])! := by sorry + + have mul_identity : multiplicant' i_s = (#ℬ'.toList[↑i_new' + 1] - #ℬ'.toList[↑i_new'])! := by sorry + + rw [prod_identity, mul_identity] + /-The set of maximal chains through ℬ is the disjoint union of maximal chains through the union of ℬ with some chain extension candidate-/ have central_identity: (Finset.univ : Finset ℬ.MaxChainThrough).image (emb_MaxChainThrough ℬ) = extension_candidates.disjiUnion extensions_wrt (by sorry) := by sorry From 5c073af9fea3521402b0a1d8f2ddea2a6251c52a Mon Sep 17 00:00:00 2001 From: Jakob Zimmermann Date: Sun, 19 Jan 2025 23:54:19 +0100 Subject: [PATCH 15/26] added IsChain.card_strict_mono and beginning typeclass definitions --- TheBook/Combinatorics/Sperner.lean | 135 ++++++++++++++++++----------- 1 file changed, 85 insertions(+), 50 deletions(-) diff --git a/TheBook/Combinatorics/Sperner.lean b/TheBook/Combinatorics/Sperner.lean index 2f5323c..75520d0 100644 --- a/TheBook/Combinatorics/Sperner.lean +++ b/TheBook/Combinatorics/Sperner.lean @@ -132,6 +132,38 @@ lemma IsChain.max_one_elt_chain_layer (chain𝒜 : IsChain (· ⊂ ·) 𝒜) (j have cardeqab : #a = #b := by rw [(Finset.mem_slice.mp amem).right, (Finset.mem_slice.mp bmem).right] exact aneb (IsChain.unique_of_cardinality_chain chain𝒜 (Finset.slice_subset bmem) (Finset.slice_subset amem) cardeqab.symm) + +instance IsChain.sub_is_trans : IsTrans 𝒜 (fun (e₁ e₂ : 𝒜) ↦ e₁.val ⊆ e₂.val) := + ⟨fun _ _ _ h₁ h₂ => subset_trans h₁ h₂⟩ + +instance card_le : LE (Finset α) where + le x y := #x ≤ #y + +instance card_le_is_total : IsTotal 𝒜 (fun (e₁ e₂ : 𝒜) ↦ e₁.val ≤ e₂.val) := + ⟨fun a b ↦ Nat.le_total #a.val #b.val⟩ + +instance card_le_is_trans : IsTrans 𝒜 (fun (e₁ e₂ : 𝒜) ↦ e₁.val ≤ e₂.val) := + ⟨fun _ _ _ h₁ h₂ ↦ Nat.le_trans h₁ h₂⟩ + +instance IsChain.card_le_is_trans : IsTrans 𝒜 (fun (e₁ e₂ : 𝒜) ↦ e₁.val ⊆ e₂.val) := + ⟨fun _ _ _ h₁ h₂ => subset_trans h₁ h₂⟩ + +theorem List.nodup_insertionSort [LE α] [DecidableRel (fun (x₁ x₂ : α) ↦ x₁ ≤ x₂)] {l : List α} (h : l.Nodup) : (l.insertionSort (fun (x₁ x₂ : α) ↦ x₁ ≤ x₂)).Nodup := by sorry + +lemma IsChain.card_strict_mono (chain𝒜 : IsChain (· ⊂ ·) 𝒜) : ((Finset.univ : Finset 𝒜).toList.insertionSort (fun (e₁ e₂ : 𝒜) ↦ #e₁.val ≤ #e₂.val)).Sorted (fun (e₁ e₂ : 𝒜) ↦ #e₁.val < #e₂.val) := by + apply List.pairwise_iff_get.mpr + intro x y xlty + let elt_x := ((List.insertionSort (fun (e₁ e₂ : 𝒜) => #e₁.val ≤ #e₂.val) univ.toList).get x) + let elt_y := ((List.insertionSort (fun (e₁ e₂ : 𝒜) => #e₁.val ≤ #e₂.val) univ.toList).get y) + have card_le : elt_x.val ≤ elt_y.val := List.pairwise_iff_get.mp (List.sorted_insertionSort (fun (e₁ e₂ : 𝒜) ↦ #e₁.val ≤ #e₂.val) (Finset.univ : Finset 𝒜).toList) x y xlty + by_contra! ass + have card_eq := Nat.le_antisymm card_le ass + + have elt_x_eq_elt_y := Subtype.eq (IsChain.unique_of_cardinality_chain chain𝒜 elt_x.prop elt_y.prop card_eq) + have elt_x_neq_elt_y : elt_x ≠ elt_y := List.pairwise_iff_get.mp (List.nodup_insertionSort ((Finset.univ : Finset 𝒜).nodup_toList)) x y xlty + + exact elt_x_neq_elt_y elt_x_eq_elt_y + /-- If a chain intersects a layer of the boolean lattice this intersection is a singleton -/ lemma layer_singleton_of_nonempty (chain𝒜 : IsChain (· ⊂ ·) 𝒜) (j : Finset.range (n + 1)) (layer_nonempty : (𝒜 # j) ≠ ∅): ∃! e : Finset α, 𝒜 # j = {e} := by @@ -176,6 +208,7 @@ variable [Fintype α] [DecidableEq α] [DecidableEq (Finset (Finset α))] instance : Coe (Set (Finset α)) (Finset (Finset α)) := ⟨λ s => by sorry⟩ + example (ℬ : Set (Finset α)) : Finset (Finset α) := ℬ def chain_extension_filter_function (𝒜 : Finset (Finset α)) (e : Finset α) : α → Prop := @@ -209,40 +242,28 @@ lemma IsChain.empty_layer_by_card (hn : Fintype.card α = n) (chain𝒜 : IsChai lemma range_empty_layer (hn : Fintype.card α = n) (chain𝒜 : IsChain (· ⊂ ·) 𝒜) (empty_layer : ∃ i : Fin (n + 1), #(𝒜 # i) = 0) (empty_elt : ∅ ∈ 𝒜) (univ_elt : Finset.univ ∈ 𝒜) : ∃ s : Fin (n + 1), ∃ t : Fin (n + 1), s.val + 2 ≤ t.val ∧ #(𝒜 # s) = 1 ∧ #(𝒜 # t) = 1 ∧ ∀ j : Fin (n + 1), s < j ∧ j < t → #(𝒜 # j) = 0 := by sorry +lemma mem_card_of_slice {ℬ : Finset (Finset α)} (h : (ℬ # s) = {layer_s}) : layer_s ∈ ℬ ∧ #layer_s = s := by + have := Finset.mem_singleton_self layer_s + rw [←h] at this + simp [slice] at this + exact this + lemma chain_extension (hn : Fintype.card α = n) {i j : Finset.range (n + 1)} (ilej_succ_succ : (i : ℕ) + 2 ≤ (j : ℕ)) (chain𝒜 : IsChain (· ⊂ ·) 𝒜) (hi : (𝒜 # i) = {layer_i}) (hj : (𝒜 # j) = {layer_j}) (emptylayer : ∀ l ∈ (Finset.range (n + 1)), i < l → l < j → #(𝒜 # l) = 0): Finset.filter (chain_extension_filter_function 𝒜 layer_i) (Finset.univ : Finset α) = layer_j \ layer_i := by - have layer_j_mem : layer_j ∈ 𝒜 := by - apply (slice_subset : 𝒜 # j ⊆ 𝒜) - rw [hj] - exact Finset.mem_singleton.mpr rfl - - have iltj : i < j := Nat.lt_of_succ_lt ilej_succ_succ - - have layer_i_mem : layer_i ∈ 𝒜 := by - apply (slice_subset : 𝒜 # i ⊆ 𝒜) - rw [hi] - exact Finset.mem_singleton.mpr rfl - - have layer_i_card : #layer_i = i := by - have := Finset.mem_singleton_self layer_i - simp [←hi, slice] at this - exact this.right - have layer_j_card : #layer_j = j := by - have := Finset.mem_singleton_self layer_j - simp [←hj, slice] at this - exact this.right + have layer_j_mem_card := mem_card_of_slice hj + have layer_i_mem_card := mem_card_of_slice hi ext x let e_new := insert x layer_i have he_new : e_new = insert x layer_i := rfl have e_new_card_lt_layer_j_card: #e_new < #layer_j := by - rw [layer_j_card] + rw [layer_j_mem_card.right] have : #e_new ≤ #layer_i + 1 := by - rw [he_new] + simp only [e_new] exact Finset.card_insert_le x layer_i - rw [layer_i_card] at this + rw [layer_i_mem_card.right] at this apply Nat.lt_of_le_of_lt this exact Nat.succ_le_of_lt ilej_succ_succ @@ -253,28 +274,29 @@ lemma chain_extension (hn : Fintype.card α = n) {i j : Finset.range (n + 1)} (i simp [←he_new] at hx have e_new_neq_layer_j : e_new ≠ layer_j := by intro ass - rw [←ass] at layer_j_mem - exact hx.right layer_j_mem + have := layer_j_mem_card.left + rw [←ass] at this + exact hx.right this simp constructor · have e_new_mem : e_new ∈ insert e_new 𝒜 := by simp have layer_j_mem_insert : layer_j ∈ insert e_new 𝒜 := by simp right - exact layer_j_mem + exact layer_j_mem_card.left have e_new_sub_layer_j := IsChain.subset_of_le_cardinality hx.left e_new_mem layer_j_mem_insert (Nat.le_of_lt e_new_card_lt_layer_j_card) rw [he_new] at e_new_sub_layer_j exact e_new_sub_layer_j (mem_insert_self x layer_i) · intro x_mem_layer_i - have : e_new = layer_i := Finset.insert_eq_self.mpr x_mem_layer_i - rw [←this] at layer_i_mem - exact hx.right layer_i_mem + have := layer_i_mem_card.left + rw [←(Finset.insert_eq_self.mpr x_mem_layer_i)] at this + exact hx.right this · intro hx simp at hx simp [chain_extension_filter_function] have case_helper {e₁ e₂ : Finset α} (e₁neqe₂ : e₁ ≠ e₂) (e₂_not_new : e₂ ∈ 𝒜) (e₁_new : e₁ = e_new) : e₁ ⊂ e₂ ∨ e₂ ⊂ e₁ := by - have := chain𝒜 layer_i_mem e₂_not_new + have := chain𝒜 layer_i_mem_card.left e₂_not_new by_cases h : layer_i = e₂ · right rw [←h, e₁_new, he_new] @@ -282,7 +304,7 @@ lemma chain_extension (hn : Fintype.card α = n) {i j : Finset.range (n + 1)} (i constructor · simp · exact (Finset.insert_ne_self.mpr hx.right).symm - · cases chain𝒜 e₂_not_new layer_i_mem (fun q => h q.symm) with + · cases chain𝒜 e₂_not_new layer_i_mem_card.left (fun q => h q.symm) with | inl e₂_sub_layer_i => right simp at e₂_sub_layer_i @@ -297,10 +319,10 @@ lemma chain_extension (hn : Fintype.card α = n) {i j : Finset.range (n + 1)} (i have e₁_sub_e₂ : e₁ ⊆ e₂ := by rw [e₁_new, he_new] have layer_j_card_le_e₂_card : #layer_j ≤ #e₂ := by - rw [layer_j_card] + rw [layer_j_mem_card.right] by_contra! have e₂_card_gt_i : #e₂ > ↑i := by - rw [←layer_i_card] + rw [←layer_i_mem_card.right] exact Finset.card_strictMono layer_i_sub_e₂ have e₂_card_lt_n_succ : #e₂ < n + 1 := by apply Nat.lt_succ_of_le @@ -311,16 +333,16 @@ lemma chain_extension (hn : Fintype.card α = n) {i j : Finset.range (n + 1)} (i have : e₂ ∈ 𝒜 # #e₂ := by simpa [slice] simp [e₂_empty_layer] at this - have layer_j_sub_e₂ := IsChain.subset_of_le_cardinality chain𝒜 layer_j_mem e₂_not_new layer_j_card_le_e₂_card + have layer_j_sub_e₂ := IsChain.subset_of_le_cardinality chain𝒜 layer_j_mem_card.left e₂_not_new layer_j_card_le_e₂_card apply Finset.insert_subset · exact layer_j_sub_e₂ hx.left · have : #layer_i ≤ #e₂ := by - rw [layer_i_card] - rw [layer_j_card] at layer_j_card_le_e₂_card - exact Nat.le_trans (Nat.le_of_lt iltj) layer_j_card_le_e₂_card + rw [layer_i_mem_card.right] + rw [layer_j_mem_card.right] at layer_j_card_le_e₂_card + exact Nat.le_trans (Nat.le_of_lt (Nat.lt_of_succ_lt ilej_succ_succ)) layer_j_card_le_e₂_card - exact IsChain.subset_of_le_cardinality chain𝒜 layer_i_mem e₂_not_new this + exact IsChain.subset_of_le_cardinality chain𝒜 layer_i_mem_card.left e₂_not_new this have : ¬(e₁ ⊆ e₂ ∧ e₁ ≠ e₂) := fun q => e₂_sub_e₁ (Finset.ssubset_iff_subset_ne.mpr q) simp at this @@ -348,9 +370,9 @@ lemma chain_extension (hn : Fintype.card α = n) {i j : Finset.range (n + 1)} (i exact chain𝒜 e₁_not_new e₂_not_new e₁neqe₂ · intro e_new_mem_𝒜 - have e_new_card_gt_layer_i : #e_new > i := by simp [Finset.card_insert_of_not_mem hx.right, layer_i_card] + have e_new_card_gt_layer_i : #e_new > i := by simp [Finset.card_insert_of_not_mem hx.right, layer_i_mem_card.right] - rw [layer_j_card] at e_new_card_lt_layer_j_card + rw [layer_j_mem_card.right] at e_new_card_lt_layer_j_card have : #(𝒜 # #e_new) = 0 := by refine' emptylayer #e_new _ e_new_card_gt_layer_i e_new_card_lt_layer_j_card · simp @@ -550,14 +572,6 @@ lemma card_maxChainThrough {ℬ : Finset (Finset α)} (hn : Fintype.card α = n) exact one_elt_max_chain_layer hn chain.isMaxChain ⟨j, by simp [Nat.lt_succ_of_le jmem]⟩ _ = n + 1 := by rw [←(Finset.card_eq_sum_ones (Iic (Fintype.card α)))]; simp [hn] -lemma mem_card_of_slice {ℬ : Finset (Finset α)} (h : (ℬ # s) = {layer_s}) : layer_s ∈ ℬ ∧ #layer_s = s := by - have := Finset.mem_singleton_self layer_s - rw [←h] at this - simp [slice] at this - exact this - -#check length_toList - lemma incident_indices_monotone_cards {n: ℕ} {s t : Fin (n + 1)} {ℬ : Finset (Finset α)} (ilej_succ_succ : s.val + 2 ≤ t.val) (monotone_cards: StrictMono (fun i : Fin ℬ.toList.length ↦ (ℬ.toList[i.val]).card)) (hs : (ℬ # s) = {layer_s}) (ht : (ℬ # t) = {layer_t}) @@ -710,6 +724,13 @@ lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Finty have a_property₂ := a.prop simp [extension_candidates_eq] at a_property₂ + have card_e_new : #e_new = s + 1 := by + have := layer_s_mem_card.right + simp [s] at this + simp [e_new, ←this] + apply card_insert_of_not_mem + · exact a_property₂.right + have ℬ'card : #ℬ' = n_ + 1 := by simp [ℬ', ←cardℬ] apply Finset.card_insert_of_not_mem @@ -727,7 +748,19 @@ lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Finty have i_new_in_range : i_new < ℬ'.toList.length := List.indexOf_lt_length.mpr (mem_toList.mpr (mem_insert_self e_new ℬ)) have h_i_new : ℬ'.toList[i_new] = e_new := ℬ'.toList.indexOf_get i_new_in_range - let i_new' : Fin (ℬ'.toList.length - 1) := ⟨i_new, by sorry⟩ + let i_univ := ℬ'.toList.indexOf univ + have i_univ_in_range : i_univ < ℬ'.toList.length := List.indexOf_lt_length.mpr (mem_toList.mpr univ_in_chain') + have h_i_univ : ℬ'.toList[i_univ] = univ := ℬ'.toList.indexOf_get i_univ_in_range + + have i_new_lt_i_univ' : (⟨i_new, i_new_in_range⟩ : Fin ℬ'.toList.length) < (⟨i_univ, i_univ_in_range⟩ : Fin ℬ'.toList.length) := by + by_contra! ass + have := (StrictMono.monotone monotone_cards') ass + simp [h_i_new, h_i_univ, card_e_new, hn] at this + linarith [empty_range.left, t'.is_lt] + + have i_new_lt_i_univ_pred : i_new < ℬ'.toList.length - 1 := Nat.lt_of_lt_of_le i_new_lt_i_univ' (Nat.le_pred_of_lt i_univ_in_range) + + let i_new' : Fin (ℬ'.toList.length - 1) := ⟨i_new, i_new_lt_i_univ_pred⟩ have h_i_new' : i_new' ∈ (Finset.univ : Finset (Fin (ℬ'.toList.length - 1))) := by simp have ind_present := ih ℬ' ℬ'card a_property₁.right.left monotone_cards' empty_in_chain' univ_in_chain' @@ -736,7 +769,9 @@ lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Finty rw [ind_present, product_split] - have prod_identity : ∏ j ∈ 𝒬', multiplicant j = ∏ x ∈ univ \ {i_new'}, (#ℬ'.toList[↑x + 1] - #ℬ'.toList[↑x])! := by sorry + have prod_identity : ∏ j ∈ 𝒬', multiplicant j = ∏ x ∈ univ \ {i_new'}, (#ℬ'.toList[↑x + 1] - #ℬ'.toList[↑x])! := by + simp [𝒬', multiplicant] + sorry have mul_identity : multiplicant' i_s = (#ℬ'.toList[↑i_new' + 1] - #ℬ'.toList[↑i_new'])! := by sorry From 8787c5b6b9e28a3e04906a9eb03d9c758285205f Mon Sep 17 00:00:00 2001 From: Jakob Zimmermann Date: Thu, 23 Jan 2025 07:53:44 +0100 Subject: [PATCH 16/26] defining small decidable instances --- TheBook/Combinatorics/Sperner.lean | 17 +++++++++++++---- 1 file changed, 13 insertions(+), 4 deletions(-) diff --git a/TheBook/Combinatorics/Sperner.lean b/TheBook/Combinatorics/Sperner.lean index 75520d0..cd9be18 100644 --- a/TheBook/Combinatorics/Sperner.lean +++ b/TheBook/Combinatorics/Sperner.lean @@ -79,7 +79,16 @@ structure MaxChainThrough (ℬ : Finset (Finset α)) where def emb_MaxChainThrough (ℬ : Finset (Finset α)) (X : ℬ.MaxChainThrough) : Finset (Finset α) := X.𝒜 -lemma inj_emb_MaxChainThrough (ℬ : Finset (Finset α)) : Injective (emb_MaxChainThrough ℬ) := by sorry +@[ext] lemma MaxChainThrough_eq {ℬ : Finset (Finset α)} (𝒞₁ 𝒞₂ : ℬ.MaxChainThrough) (hA : 𝒞₁.𝒜 = 𝒞₂.𝒜) : 𝒞₁ = 𝒞₂ := by + cases 𝒞₁ + cases 𝒞₂ + congr + +lemma inj_emb_MaxChainThrough {ℬ : Finset (Finset α)} : Injective (emb_MaxChainThrough ℬ) := by + intro 𝒞₁ 𝒞₂ h + unfold emb_MaxChainThrough at h + ext + rw [h] instance instFintypeMaxChainThrough {ℬ : Finset (Finset α)} : Fintype (MaxChainThrough ℬ) := by sorry @@ -203,7 +212,7 @@ lemma IsChain.subset_of_le_cardinality (chain𝒜 : IsChain (· ⊂ ·) 𝒜) {e exact Finset.subset_of_eq (IsChain.unique_of_cardinality_chain chain𝒜 e₁mem e₂mem hcard_eq) -variable [Fintype α] [DecidableEq α] [DecidableEq (Finset (Finset α))] +variable [Fintype α] [DecidableEq α] [DecidableEq (Finset (Finset α))] [DecidableEq (Finset α)] instance : Coe (Set (Finset α)) (Finset (Finset α)) := ⟨λ s => by sorry⟩ @@ -215,7 +224,7 @@ def chain_extension_filter_function (𝒜 : Finset (Finset α)) (e : Finset α) fun a : α ↦ IsChain (· ⊂ ·) (insert (insert a e) 𝒜) ∧ insert a e ∉ 𝒜 instance instDecidableIsChain (𝒜 : Finset (Finset α)) : Decidable (IsChain (· ⊂ ·) 𝒜) := by - sorry + apply Finset.decidableDforallFinset instance instDecidablePredChainExtension (e : Finset α) : DecidablePred (chain_extension_filter_function 𝒜 e) := @@ -738,7 +747,7 @@ lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Finty have monotone_cards' : StrictMono (fun (i : Fin ℬ'.toList.length) ↦ #ℬ'.toList[i]) := by sorry - have := Finset.card_image_of_injective (Finset.univ : Finset (MaxChainThrough ℬ')) (inj_emb_MaxChainThrough ℬ') + have := Finset.card_image_of_injective (Finset.univ : Finset (MaxChainThrough ℬ')) inj_emb_MaxChainThrough simp [extensions_wrt, this] have empty_in_chain' : ∅ ∈ ℬ' := by simp [ℬ']; exact mem_insert_iff.mpr (Or.inr empty_in_chain) From b8a746b3d8a450e28015fb59e9c784e96b572cb7 Mon Sep 17 00:00:00 2001 From: Jakob Zimmermann Date: Thu, 23 Jan 2025 16:59:55 +0100 Subject: [PATCH 17/26] working on incident_indices_monotone_cards --- TheBook/Combinatorics/Sperner.lean | 56 +++++++++++++++++++++++------- 1 file changed, 43 insertions(+), 13 deletions(-) diff --git a/TheBook/Combinatorics/Sperner.lean b/TheBook/Combinatorics/Sperner.lean index cd9be18..5a5425a 100644 --- a/TheBook/Combinatorics/Sperner.lean +++ b/TheBook/Combinatorics/Sperner.lean @@ -148,6 +148,17 @@ instance IsChain.sub_is_trans : IsTrans 𝒜 (fun (e₁ e₂ : 𝒜) ↦ e₁.va instance card_le : LE (Finset α) where le x y := #x ≤ #y +instance card_lt : LT (Finset α) where + lt x y := #x < #y + +instance card_preorder : Preorder (Finset α) := { + le := (· ≤ ·), + lt := (· < ·), + le_refl := fun x => Nat.le_refl #x, + le_trans := fun _ _ _ hxy hyz => Nat.le_trans hxy hyz, + lt_iff_le_not_le := fun _ _ => Nat.lt_iff_le_not_le +} + instance card_le_is_total : IsTotal 𝒜 (fun (e₁ e₂ : 𝒜) ↦ e₁.val ≤ e₂.val) := ⟨fun a b ↦ Nat.le_total #a.val #b.val⟩ @@ -582,7 +593,7 @@ lemma card_maxChainThrough {ℬ : Finset (Finset α)} (hn : Fintype.card α = n) _ = n + 1 := by rw [←(Finset.card_eq_sum_ones (Iic (Fintype.card α)))]; simp [hn] lemma incident_indices_monotone_cards {n: ℕ} {s t : Fin (n + 1)} {ℬ : Finset (Finset α)} (ilej_succ_succ : s.val + 2 ≤ t.val) - (monotone_cards: StrictMono (fun i : Fin ℬ.toList.length ↦ (ℬ.toList[i.val]).card)) + (monotone_cards: List.Sorted (fun (e₁ e₂) ↦ #e₁ < #e₂) ℬ.toList) (hs : (ℬ # s) = {layer_s}) (ht : (ℬ # t) = {layer_t}) (empty_layer : ∀ j : Fin (n + 1), s < j → j < t → #(ℬ # ↑j) = 0) : ∃ i_s : Fin (ℬ.toList.length - 1), ℬ.toList[i_s.val] = layer_s ∧ ℬ.toList[i_s.val + 1] = layer_t := by @@ -595,27 +606,42 @@ lemma incident_indices_monotone_cards {n: ℕ} {s t : Fin (n + 1)} {ℬ : Finset have i_t_in_range : i_t < ℬ.toList.length := List.indexOf_lt_length.mpr (mem_toList.mpr (mem_card_of_slice ht).left) have h_i_t : ℬ.toList[i_t] = layer_t := ℬ.toList.indexOf_get i_t_in_range + simp at i_t_in_range + simp at i_s_in_range + have i_s_eq_i_t_succ : i_t = i_s + 1 := by by_contra ass₁ - have : (⟨i_t, i_t_in_range⟩ : Fin ℬ.toList.length) > (⟨i_s, i_s_in_range⟩ : Fin ℬ.toList.length) := by + have : i_t > i_s := by by_contra! ass₂ - have := (StrictMono.monotone monotone_cards) ass₂ - simp only [h_i_s, h_i_t, (mem_card_of_slice hs).right, (mem_card_of_slice ht).right] at this + unfold List.Sorted at monotone_cards + have : ℬ.toList[i_t] ≤ ℬ.toList[i_s] := by + cases le_iff_eq_or_lt.mp ass₂ with + | inl h => + simp [h] + | inr h => + have : i_t < (Finset.univ : Finset ℬ).toList.length := by + simpa + have := ((List.pairwise_iff_get.mp monotone_cards) ⟨i_t, by simpa⟩ ⟨i_s, by simpa⟩ h) + simp at this + exact le_of_lt this + simp [h_i_s, h_i_t] at this + have : t.val ≤ s.val := by + simp [←(mem_card_of_slice hs).right, ←(mem_card_of_slice ht).right] + exact this linarith have i_s_succ_lt : i_s + 1 < i_t := Nat.lt_of_le_of_ne this fun a => ass₁ (id (Eq.symm a)) let e := ℬ.toList[i_s + 1] have e_card_gt' : #e > s := by - have : (⟨i_s, i_s_in_range⟩ : Fin ℬ.toList.length) < (⟨i_s + 1, Nat.lt_trans i_s_succ_lt i_t_in_range⟩ : Fin ℬ.toList.length) := by simp - have := monotone_cards this - simp only [h_i_s, (mem_card_of_slice hs).right] at this + have := (List.pairwise_iff_get.mp monotone_cards) ⟨i_s, by simpa⟩ ⟨i_s + 1, by apply Nat.lt_trans i_s_succ_lt; simpa ⟩ (by simp : i_s < i_s + 1) + simp [h_i_s, (mem_card_of_slice hs).right] at this + unfold e exact this have e_card_lt' : #e < t := by - have : (⟨i_t, i_t_in_range⟩ : Fin ℬ.toList.length) > (⟨i_s + 1, Nat.lt_trans i_s_succ_lt i_t_in_range⟩ : Fin ℬ.toList.length) := by simp [i_s_succ_lt] - have := monotone_cards this - simp only [h_i_t, (mem_card_of_slice ht).right] at this + have := (List.pairwise_iff_get.mp monotone_cards) ⟨i_s + 1, by apply Nat.lt_trans i_s_succ_lt; simpa⟩ ⟨i_t, by simpa⟩ i_s_succ_lt + simp [h_i_t, (mem_card_of_slice ht).right] at this exact this have card_e_mod : #e % (n + 1) = #e := mod_eq_of_lt (Nat.lt_trans e_card_lt' t.is_lt) @@ -644,16 +670,20 @@ lemma incident_indices_monotone_cards {n: ℕ} {s t : Fin (n + 1)} {ℬ : Finset use ⟨i_s, i_s_upperbound⟩ simp only [i_s_eq_i_t_succ] at h_i_t - exact ⟨h_i_s, h_i_t⟩ + lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Fintype.card α = n) (ℬ : Finset (Finset α)) (cardℬ : #ℬ = m) (chainℬ : IsChain (· ⊂ ·) ℬ) - (monotone_cards: StrictMono (fun (i : Fin ℬ.toList.length) ↦ #ℬ.toList[i])) (empty_in_chain : ∅ ∈ ℬ) (univ_in_chain : univ ∈ ℬ) : + (empty_in_chain : ∅ ∈ ℬ) (univ_in_chain : univ ∈ ℬ) : Fintype.card (ℬ.MaxChainThrough) = ∏ j : Fin (ℬ.toList.length - 1), (#ℬ.toList[j.val + 1] - #ℬ.toList[j.val])! := by revert ℬ induction' h_mn using decreasingInduction with n_ q ih - · intro ℬ cardℬ chainℬ monotone_cards empty_in_chain univ_in_chain + · intro ℬ cardℬ chainℬ empty_in_chain univ_in_chain + + let sorted_list := ((Finset.univ : Finset ℬ).toList.insertionSort (fun (e₁ e₂ : ℬ) ↦ #e₁.val ≤ #e₂.val)) + + have monotone_cards : sorted_list.Sorted (fun (e₁ e₂ : ℬ) ↦ #e₁.val < #e₂.val) := IsChain.card_strict_mono chainℬ obtain ⟨s', t', empty_range : s'.val + 2 ≤ t'.val ∧ #(ℬ # s') = 1 ∧ #(ℬ # t') = 1 ∧ ∀ (j : Fin (n + 1)), s' < j ∧ j < t' → #(ℬ # ↑j) = 0⟩ := range_empty_layer hn chainℬ (IsChain.empty_layer_by_card hn chainℬ (lt_of_eq_of_lt cardℬ q)) empty_in_chain univ_in_chain From b37f021e8ab4ff5713239e8b029c47b9fd4d4b22 Mon Sep 17 00:00:00 2001 From: Jakob Zimmermann Date: Thu, 23 Jan 2025 19:45:04 +0100 Subject: [PATCH 18/26] using sorted list in induction --- TheBook/Combinatorics/Sperner.lean | 162 +++++++++++++++++++---------- 1 file changed, 105 insertions(+), 57 deletions(-) diff --git a/TheBook/Combinatorics/Sperner.lean b/TheBook/Combinatorics/Sperner.lean index 5a5425a..0d61ff4 100644 --- a/TheBook/Combinatorics/Sperner.lean +++ b/TheBook/Combinatorics/Sperner.lean @@ -23,14 +23,13 @@ import Mathlib.Data.Set.Basic import Mathlib.Data.Finset.Slice import Mathlib.Order.Antichain import Mathlib.Order.Chain - --- set_option maxHeartbeats 200000 +import Mathlib.Data.List.Perm.Basic /-! # Proof of the LYM inequality and some observations on chains wrt the subset order -/ -open Function Finset Nat Set BigOperators +open Function Finset Nat Set BigOperators List variable {α : Type*} {n m : ℕ} {𝒜 : Finset (Finset α)} @@ -141,7 +140,6 @@ lemma IsChain.max_one_elt_chain_layer (chain𝒜 : IsChain (· ⊂ ·) 𝒜) (j have cardeqab : #a = #b := by rw [(Finset.mem_slice.mp amem).right, (Finset.mem_slice.mp bmem).right] exact aneb (IsChain.unique_of_cardinality_chain chain𝒜 (Finset.slice_subset bmem) (Finset.slice_subset amem) cardeqab.symm) - instance IsChain.sub_is_trans : IsTrans 𝒜 (fun (e₁ e₂ : 𝒜) ↦ e₁.val ⊆ e₂.val) := ⟨fun _ _ _ h₁ h₂ => subset_trans h₁ h₂⟩ @@ -170,7 +168,7 @@ instance IsChain.card_le_is_trans : IsTrans 𝒜 (fun (e₁ e₂ : 𝒜) ↦ e theorem List.nodup_insertionSort [LE α] [DecidableRel (fun (x₁ x₂ : α) ↦ x₁ ≤ x₂)] {l : List α} (h : l.Nodup) : (l.insertionSort (fun (x₁ x₂ : α) ↦ x₁ ≤ x₂)).Nodup := by sorry -lemma IsChain.card_strict_mono (chain𝒜 : IsChain (· ⊂ ·) 𝒜) : ((Finset.univ : Finset 𝒜).toList.insertionSort (fun (e₁ e₂ : 𝒜) ↦ #e₁.val ≤ #e₂.val)).Sorted (fun (e₁ e₂ : 𝒜) ↦ #e₁.val < #e₂.val) := by +lemma card_strict_mono' (chain𝒜 : IsChain (· ⊂ ·) 𝒜) : ((Finset.univ : Finset 𝒜).toList.insertionSort (fun (e₁ e₂ : 𝒜) ↦ #e₁.val ≤ #e₂.val)).Sorted (fun (e₁ e₂ : 𝒜) ↦ #e₁.val < #e₂.val) := by apply List.pairwise_iff_get.mpr intro x y xlty let elt_x := ((List.insertionSort (fun (e₁ e₂ : 𝒜) => #e₁.val ≤ #e₂.val) univ.toList).get x) @@ -184,6 +182,35 @@ lemma IsChain.card_strict_mono (chain𝒜 : IsChain (· ⊂ ·) 𝒜) : ((Finset exact elt_x_neq_elt_y elt_x_eq_elt_y +#check Perm.map Subtype.val + +def IsChain.card_strict_mono (chain𝒜 : IsChain (· ⊂ ·) 𝒜) : ∃ l : List (Finset α), l ~ 𝒜.toList ∧ l.Sorted (#· < #·) := by + let l' := ((Finset.univ : Finset 𝒜).toList.insertionSort (fun (e₁ e₂ : 𝒜) ↦ #e₁.val ≤ #e₂.val)) + have l'_sorted : l'.Sorted (fun (e₁ e₂ : 𝒜) ↦ #e₁.val < #e₂.val) := card_strict_mono' chain𝒜 + + let l := l'.map Subtype.val + use l + constructor + · calc + l ~ (Finset.univ : Finset 𝒜).toList.map Subtype.val := Perm.map Subtype.val (perm_insertionSort (fun e₁ e₂ => #e₁.val ≤ #e₂.val) (Finset.univ : Finset 𝒜).toList) + _ ~ 𝒜.toList := by + sorry + · unfold l Sorted + apply List.pairwise_iff_get.mpr + intro i j iltj + simp [List.getElem_map, List.unattach, -List.map_subtype] + + have : (l'.map Subtype.val).length = l'.length := length_map l' Subtype.val + + have iltj_coe : (Fin.cast this i) < (Fin.cast this j) := by + apply Fin.lt_def.mpr + simp + exact iltj + + have := List.pairwise_iff_get.mp l'_sorted (Fin.cast this i) (Fin.cast this j) iltj_coe + exact this + + /-- If a chain intersects a layer of the boolean lattice this intersection is a singleton -/ lemma layer_singleton_of_nonempty (chain𝒜 : IsChain (· ⊂ ·) 𝒜) (j : Finset.range (n + 1)) (layer_nonempty : (𝒜 # j) ≠ ∅): ∃! e : Finset α, 𝒜 # j = {e} := by @@ -592,19 +619,19 @@ lemma card_maxChainThrough {ℬ : Finset (Finset α)} (hn : Fintype.card α = n) exact one_elt_max_chain_layer hn chain.isMaxChain ⟨j, by simp [Nat.lt_succ_of_le jmem]⟩ _ = n + 1 := by rw [←(Finset.card_eq_sum_ones (Iic (Fintype.card α)))]; simp [hn] -lemma incident_indices_monotone_cards {n: ℕ} {s t : Fin (n + 1)} {ℬ : Finset (Finset α)} (ilej_succ_succ : s.val + 2 ≤ t.val) - (monotone_cards: List.Sorted (fun (e₁ e₂) ↦ #e₁ < #e₂) ℬ.toList) +lemma incident_indices_monotone_cards {n: ℕ} {s t : Fin (n + 1)} {ℬ : Finset (Finset α)} (ilej_succ_succ : s.val + 2 ≤ t.val) (list : List (Finset α)) + (monotone_cards: List.Sorted (fun (e₁ e₂) ↦ #e₁ < #e₂) list) (h_list: ℬ.toList ~ list) (hs : (ℬ # s) = {layer_s}) (ht : (ℬ # t) = {layer_t}) (empty_layer : ∀ j : Fin (n + 1), s < j → j < t → #(ℬ # ↑j) = 0) : - ∃ i_s : Fin (ℬ.toList.length - 1), ℬ.toList[i_s.val] = layer_s ∧ ℬ.toList[i_s.val + 1] = layer_t := by + ∃ i_s : Fin (list.length - 1), list[i_s.val] = layer_s ∧ list[i_s.val + 1] = layer_t := by - let i_s := ℬ.toList.indexOf layer_s - have i_s_in_range : i_s < ℬ.toList.length := List.indexOf_lt_length.mpr (mem_toList.mpr (mem_card_of_slice hs).left) - have h_i_s : ℬ.toList[i_s] = layer_s := ℬ.toList.indexOf_get i_s_in_range + let i_s := list.indexOf layer_s + have i_s_in_range : i_s < list.length := List.indexOf_lt_length.mpr (h_list.subset (mem_toList.mpr (mem_card_of_slice hs).left)) + have h_i_s : list[i_s] = layer_s := list.indexOf_get i_s_in_range - let i_t := ℬ.toList.indexOf layer_t - have i_t_in_range : i_t < ℬ.toList.length := List.indexOf_lt_length.mpr (mem_toList.mpr (mem_card_of_slice ht).left) - have h_i_t : ℬ.toList[i_t] = layer_t := ℬ.toList.indexOf_get i_t_in_range + let i_t := list.indexOf layer_t + have i_t_in_range : i_t < list.length := List.indexOf_lt_length.mpr (h_list.subset (mem_toList.mpr (mem_card_of_slice ht).left)) + have h_i_t : list[i_t] = layer_t := list.indexOf_get i_t_in_range simp at i_t_in_range simp at i_s_in_range @@ -614,12 +641,12 @@ lemma incident_indices_monotone_cards {n: ℕ} {s t : Fin (n + 1)} {ℬ : Finset have : i_t > i_s := by by_contra! ass₂ unfold List.Sorted at monotone_cards - have : ℬ.toList[i_t] ≤ ℬ.toList[i_s] := by + have : list[i_t] ≤ list[i_s] := by cases le_iff_eq_or_lt.mp ass₂ with | inl h => simp [h] | inr h => - have : i_t < (Finset.univ : Finset ℬ).toList.length := by + have : i_t < list.length := by simpa have := ((List.pairwise_iff_get.mp monotone_cards) ⟨i_t, by simpa⟩ ⟨i_s, by simpa⟩ h) simp at this @@ -631,7 +658,7 @@ lemma incident_indices_monotone_cards {n: ℕ} {s t : Fin (n + 1)} {ℬ : Finset linarith have i_s_succ_lt : i_s + 1 < i_t := Nat.lt_of_le_of_ne this fun a => ass₁ (id (Eq.symm a)) - let e := ℬ.toList[i_s + 1] + let e := list[i_s + 1] have e_card_gt' : #e > s := by have := (List.pairwise_iff_get.mp monotone_cards) ⟨i_s, by simpa⟩ ⟨i_s + 1, by apply Nat.lt_trans i_s_succ_lt; simpa ⟩ (by simp : i_s < i_s + 1) @@ -649,22 +676,21 @@ lemma incident_indices_monotone_cards {n: ℕ} {s t : Fin (n + 1)} {ℬ : Finset have e_card_gt : Fin.ofNat #e > s := by simp [Fin.ofNat, card_e_mod]; exact e_card_gt' have e_card_lt : Fin.ofNat #e < t := by simp [Fin.ofNat, card_e_mod]; exact e_card_lt' - have layer_empty := empty_layer (Fin.ofNat #e) e_card_gt e_card_lt have layer_nonempty : e ∈ (ℬ # ↑(Fin.ofNat #e : Fin (n + 1))) := by simp [mem_slice] constructor · apply mem_toList.mp - exact List.get_mem ℬ.toList (i_s + 1) (Nat.lt_trans i_s_succ_lt i_t_in_range) + exact (List.Perm.symm h_list).subset ((List.get_mem list (i_s + 1)) (Nat.lt_trans i_s_succ_lt i_t_in_range)) · simp [Fin.ofNat, card_e_mod] simp at layer_empty simp [layer_empty] at layer_nonempty - have i_s_upperbound : i_s < ℬ.toList.length - 1 := - have : i_s + 1 < ℬ.toList.length := by rw [←i_s_eq_i_t_succ]; exact i_t_in_range + have i_s_upperbound : i_s < list.length - 1 := + have : i_s + 1 < list.length := by rw [←i_s_eq_i_t_succ]; exact i_t_in_range lt_sub_of_add_lt this use ⟨i_s, i_s_upperbound⟩ @@ -674,17 +700,15 @@ lemma incident_indices_monotone_cards {n: ℕ} {s t : Fin (n + 1)} {ℬ : Finset lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Fintype.card α = n) - (ℬ : Finset (Finset α)) (cardℬ : #ℬ = m) (chainℬ : IsChain (· ⊂ ·) ℬ) - (empty_in_chain : ∅ ∈ ℬ) (univ_in_chain : univ ∈ ℬ) : - Fintype.card (ℬ.MaxChainThrough) = ∏ j : Fin (ℬ.toList.length - 1), (#ℬ.toList[j.val + 1] - #ℬ.toList[j.val])! := by - revert ℬ + (ℬ : Finset (Finset α)) (cardℬ : #ℬ = m) (chainℬ : IsChain (· ⊂ ·) ℬ) (empty_in_chain : ∅ ∈ ℬ) (univ_in_chain : univ ∈ ℬ) + (list : List (Finset α)) (list_per : ℬ.toList ~ list) (list_sorted : list.Sorted (#· < #·)): + Fintype.card (ℬ.MaxChainThrough) = ∏ j : Fin (list.length - 1), (#list[j.val + 1] - #list[j.val])! := by + revert ℬ list induction' h_mn using decreasingInduction with n_ q ih - · intro ℬ cardℬ chainℬ empty_in_chain univ_in_chain + · intro ℬ cardℬ chainℬ empty_in_chain univ_in_chain list list_sorted list_per let sorted_list := ((Finset.univ : Finset ℬ).toList.insertionSort (fun (e₁ e₂ : ℬ) ↦ #e₁.val ≤ #e₂.val)) - have monotone_cards : sorted_list.Sorted (fun (e₁ e₂ : ℬ) ↦ #e₁.val < #e₂.val) := IsChain.card_strict_mono chainℬ - obtain ⟨s', t', empty_range : s'.val + 2 ≤ t'.val ∧ #(ℬ # s') = 1 ∧ #(ℬ # t') = 1 ∧ ∀ (j : Fin (n + 1)), s' < j ∧ j < t' → #(ℬ # ↑j) = 0⟩ := range_empty_layer hn chainℬ (IsChain.empty_layer_by_card hn chainℬ (lt_of_eq_of_lt cardℬ q)) empty_in_chain univ_in_chain @@ -725,15 +749,17 @@ lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Finty have layer_s_mem_card := mem_card_of_slice hs have layer_t_mem_card := mem_card_of_slice ht - obtain ⟨i_s, ⟨entry_i_s, entry_i_s_succ⟩⟩ := incident_indices_monotone_cards ilej_succ_succ monotone_cards hs ht empty_layer + have := list_per + + obtain ⟨i_s, ⟨entry_i_s, entry_i_s_succ⟩⟩ := incident_indices_monotone_cards ilej_succ_succ list list_per list_sorted hs ht empty_layer - have i_s_in_range : i_s < ℬ.toList.length := Nat.lt_of_lt_of_le i_s.is_lt (Nat.pred_le ℬ.toList.length) - have i_s_succ_in_range : i_s.val + 1 < ℬ.toList.length := add_lt_of_lt_sub i_s.is_lt + have i_s_in_range : i_s < list.length := Nat.lt_of_lt_of_le i_s.is_lt (Nat.pred_le list.length) + have i_s_succ_in_range : i_s.val + 1 < list.length := add_lt_of_lt_sub i_s.is_lt - let multiplicant' (j : Fin (ℬ.toList.length - 1)) : ℕ := (#ℬ.toList[j.val + 1] - #ℬ.toList[j.val] - 1)! - let multiplicant (j : Fin (ℬ.toList.length - 1)) : ℕ := (#ℬ.toList[j.val + 1] - #ℬ.toList[j.val])! + let multiplicant' (j : Fin (list.length - 1)) : ℕ := (#list[j.val + 1] - #list[j.val] - 1)! + let multiplicant (j : Fin (list.length - 1)) : ℕ := (#list[j.val + 1] - #list[j.val])! - have extension_candidates_card : #extension_candidates = #ℬ.toList[i_s.val + 1] - #ℬ.toList[i_s.val] := by + have extension_candidates_card : #extension_candidates = #list[i_s.val + 1] - #list[i_s.val] := by rw [entry_i_s, entry_i_s_succ, layer_s_mem_card.right, layer_t_mem_card.right] rw [extension_candidates_eq] have card_bottom_lt_card_top : #layer_s < #layer_t := by @@ -745,7 +771,7 @@ lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Finty rw [←layer_s_mem_card.right, ←layer_t_mem_card.right] exact Nat.eq_sub_of_add_eq this - let 𝒬 := (Finset.univ : Finset (Fin (ℬ.toList.length - 1))) + let 𝒬 := (Finset.univ : Finset (Fin (list.length - 1))) let 𝒬' := 𝒬 \ {i_s} let extensions_wrt (x : α) : Finset (Finset (Finset α)) := by @@ -775,44 +801,66 @@ lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Finty apply Finset.card_insert_of_not_mem · exact a_property₁.right.right - have monotone_cards' : StrictMono (fun (i : Fin ℬ'.toList.length) ↦ #ℬ'.toList[i]) := by sorry - - have := Finset.card_image_of_injective (Finset.univ : Finset (MaxChainThrough ℬ')) inj_emb_MaxChainThrough - simp [extensions_wrt, this] + obtain ⟨list', ⟨list_per' : list' ~ (insert e_new ℬ).toList, list_sorted' ⟩⟩ := IsChain.card_strict_mono a_property₁.right.left + have embedding_card := Finset.card_image_of_injective (Finset.univ : Finset (MaxChainThrough ℬ')) inj_emb_MaxChainThrough + simp [extensions_wrt, embedding_card] have empty_in_chain' : ∅ ∈ ℬ' := by simp [ℬ']; exact mem_insert_iff.mpr (Or.inr empty_in_chain) have univ_in_chain' : univ ∈ ℬ' := by simp [ℬ']; exact mem_insert_iff.mpr (Or.inr univ_in_chain) - let i_new := ℬ'.toList.indexOf e_new - have i_new_in_range : i_new < ℬ'.toList.length := List.indexOf_lt_length.mpr (mem_toList.mpr (mem_insert_self e_new ℬ)) - have h_i_new : ℬ'.toList[i_new] = e_new := ℬ'.toList.indexOf_get i_new_in_range + let i_new := list'.indexOf e_new + have := list_per'.symm.subset (mem_toList.mpr (mem_insert_self e_new ℬ)) - let i_univ := ℬ'.toList.indexOf univ - have i_univ_in_range : i_univ < ℬ'.toList.length := List.indexOf_lt_length.mpr (mem_toList.mpr univ_in_chain') - have h_i_univ : ℬ'.toList[i_univ] = univ := ℬ'.toList.indexOf_get i_univ_in_range + have := (mem_toList.mpr (mem_insert_self e_new ℬ)) + have i_new_in_range : i_new < list'.length := (List.indexOf_lt_length.mpr (list_per'.symm.subset (mem_toList.mpr (mem_insert_self e_new ℬ)))) + have h_i_new : list'[i_new] = e_new := list'.indexOf_get i_new_in_range - have i_new_lt_i_univ' : (⟨i_new, i_new_in_range⟩ : Fin ℬ'.toList.length) < (⟨i_univ, i_univ_in_range⟩ : Fin ℬ'.toList.length) := by + let i_univ := list'.indexOf univ + have i_univ_in_range : i_univ < list'.length := List.indexOf_lt_length.mpr (list_per'.symm.subset (mem_toList.mpr univ_in_chain')) + have h_i_univ : list'[i_univ] = univ := list'.indexOf_get i_univ_in_range + + have i_new_lt_i_univ' : (⟨i_new, i_new_in_range⟩ : Fin list'.length) < (⟨i_univ, i_univ_in_range⟩ : Fin list'.length) := by by_contra! ass - have := (StrictMono.monotone monotone_cards') ass - simp [h_i_new, h_i_univ, card_e_new, hn] at this - linarith [empty_range.left, t'.is_lt] - have i_new_lt_i_univ_pred : i_new < ℬ'.toList.length - 1 := Nat.lt_of_lt_of_le i_new_lt_i_univ' (Nat.le_pred_of_lt i_univ_in_range) + have : s'.val + 2 < n + 1 := lt_of_le_of_lt empty_range.left t'.is_lt + have : s'.val < n + 1 := s'.isLt + + cases lt_or_eq_of_le ass with + | inl h => + have := List.pairwise_iff_get.mp list_sorted' ⟨i_univ, i_univ_in_range⟩ ⟨i_new, i_new_in_range⟩ h + simp at this + simp [h_i_new, h_i_univ, card_e_new, hn] at this + + linarith + | inr h => + have : e_new = univ := by + calc + e_new = list'[i_new] := h_i_new.symm + _ = list'[i_univ] := by simp [Fin.mk.inj_iff.mp h] + _ = univ := h_i_univ + have : s.val + 1 = n := by + rw [←card_e_new, ←hn, this] + rfl + linarith + + have i_new_lt_i_univ_pred : i_new < list'.length - 1 := Nat.lt_of_lt_of_le i_new_lt_i_univ' (Nat.le_pred_of_lt i_univ_in_range) + + let i_new' : Fin (list'.length - 1) := ⟨i_new, i_new_lt_i_univ_pred⟩ + have h_i_new' : i_new' ∈ (Finset.univ : Finset (Fin (list'.length - 1))) := by simp + + have ind_present := ih ℬ' ℬ'card a_property₁.right.left empty_in_chain' univ_in_chain' list' list_per'.symm list_sorted' - let i_new' : Fin (ℬ'.toList.length - 1) := ⟨i_new, i_new_lt_i_univ_pred⟩ - have h_i_new' : i_new' ∈ (Finset.univ : Finset (Fin (ℬ'.toList.length - 1))) := by simp - have ind_present := ih ℬ' ℬ'card a_property₁.right.left monotone_cards' empty_in_chain' univ_in_chain' - have product_split := Finset.prod_eq_mul_prod_diff_singleton h_i_new' (fun (i : Fin (ℬ'.toList.length - 1)) ↦ (#ℬ'.toList[i.val + 1] - #ℬ'.toList[i.val])!) + have product_split := Finset.prod_eq_mul_prod_diff_singleton h_i_new' (fun (i : Fin (list'.length - 1)) ↦ (#list'[i.val + 1] - #list'[i.val])!) rw [ind_present, product_split] - have prod_identity : ∏ j ∈ 𝒬', multiplicant j = ∏ x ∈ univ \ {i_new'}, (#ℬ'.toList[↑x + 1] - #ℬ'.toList[↑x])! := by + have prod_identity : ∏ j ∈ 𝒬', multiplicant j = ∏ x ∈ univ \ {i_new'}, (#list'[↑x + 1] - #list'[↑x])! := by simp [𝒬', multiplicant] sorry - have mul_identity : multiplicant' i_s = (#ℬ'.toList[↑i_new' + 1] - #ℬ'.toList[↑i_new'])! := by sorry + have mul_identity : multiplicant' i_s = (#list'[↑i_new' + 1] - #list'[↑i_new'])! := by sorry rw [prod_identity, mul_identity] @@ -844,7 +892,7 @@ lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Finty simp [𝒬'] have : i_s ∈ 𝒬 := by simp [𝒬] exact (Finset.prod_eq_mul_prod_diff_singleton this multiplicant).symm - _ = ∏ j ∈ 𝒬, (#ℬ.toList[j.val + 1] - #ℬ.toList[j.val])! := by + _ = ∏ j ∈ 𝒬, (#list[j.val + 1] - #list[j.val])! := by apply prod_congr (by simp) intro x hx rfl From caa32e2b7891f510dda03f799cdc25b7b81173b1 Mon Sep 17 00:00:00 2001 From: Jakob Zimmermann Date: Thu, 23 Jan 2025 21:25:44 +0100 Subject: [PATCH 19/26] further progression with count_maxChainsThrough --- TheBook/Combinatorics/Sperner.lean | 60 +++++++++++++++++++++++------- 1 file changed, 46 insertions(+), 14 deletions(-) diff --git a/TheBook/Combinatorics/Sperner.lean b/TheBook/Combinatorics/Sperner.lean index 0d61ff4..b18883a 100644 --- a/TheBook/Combinatorics/Sperner.lean +++ b/TheBook/Combinatorics/Sperner.lean @@ -619,6 +619,14 @@ lemma card_maxChainThrough {ℬ : Finset (Finset α)} (hn : Fintype.card α = n) exact one_elt_max_chain_layer hn chain.isMaxChain ⟨j, by simp [Nat.lt_succ_of_le jmem]⟩ _ = n + 1 := by rw [←(Finset.card_eq_sum_ones (Iic (Fintype.card α)))]; simp [hn] +lemma first_entry {ℬ : Finset (Finset α)} (list : List (Finset α)) + (monotone_cards: List.Sorted (fun (e₁ e₂) ↦ #e₁ < #e₂) list) (h_list: ℬ.toList ~ list) + (empty_in_chain : ∅ ∈ ℬ) : list[0]'(by sorry) = ∅ := by sorry + +lemma last_entry {list : List (Finset α)} {ℬ : Finset (Finset α)} + (monotone_cards: List.Sorted (fun (e₁ e₂) ↦ #e₁ < #e₂) list) (h_list: ℬ.toList ~ list) + (univ_in_chain : univ ∈ ℬ) : list[list.length - 1]'(by sorry) = univ := by sorry + lemma incident_indices_monotone_cards {n: ℕ} {s t : Fin (n + 1)} {ℬ : Finset (Finset α)} (ilej_succ_succ : s.val + 2 ≤ t.val) (list : List (Finset α)) (monotone_cards: List.Sorted (fun (e₁ e₂) ↦ #e₁ < #e₂) list) (h_list: ℬ.toList ~ list) (hs : (ℬ # s) = {layer_s}) (ht : (ℬ # t) = {layer_t}) @@ -846,29 +854,52 @@ lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Finty have i_new_lt_i_univ_pred : i_new < list'.length - 1 := Nat.lt_of_lt_of_le i_new_lt_i_univ' (Nat.le_pred_of_lt i_univ_in_range) let i_new' : Fin (list'.length - 1) := ⟨i_new, i_new_lt_i_univ_pred⟩ - have h_i_new' : i_new' ∈ (Finset.univ : Finset (Fin (list'.length - 1))) := by simp + let i_new'_pred : Fin (list'.length - 1) := ⟨i_new - 1, Nat.lt_of_le_of_lt (Nat.pred_le i_new) i_new_lt_i_univ_pred⟩ + + have ind_present : Fintype.card (ℬ'.MaxChainThrough) = ∏ j : Fin (list'.length - 1), (#list'[j.val + 1] - #list'[j.val])! := + ih ℬ' ℬ'card a_property₁.right.left empty_in_chain' univ_in_chain' list' list_per'.symm list_sorted' - have ind_present := ih ℬ' ℬ'card a_property₁.right.left empty_in_chain' univ_in_chain' list' list_per'.symm list_sorted' + have product_split : ∏ j : Fin (list'.length - 1), (#list'[j.val + 1] - #list'[j.val])! = + (#list'[i_new'.val + 1] - #list'[i_new'.val])! * ∏ j ∈ univ \ {i_new'}, (#list'[j.val + 1] - #list'[j.val])! := + Finset.prod_eq_mul_prod_diff_singleton (by simp) (fun (i : Fin (list'.length - 1)) ↦ (#list'[i.val + 1] - #list'[i.val])!) + rw [ind_present, product_split] + have prod_identity : ∏ j ∈ (Finset.univ : Finset (Fin (list'.length - 1))) \ {i_new'}, (#list'[j.val + 1] - #list'[j.val])! = ∏ j ∈ 𝒬', multiplicant j := by + calc + ∏ j ∈ (Finset.univ : Finset (Fin (list'.length - 1))) \ {i_new'}, (#list'[j.val + 1] - #list'[j.val])! + = (#list'[i_new'_pred.val + 1] - #list'[i_new'_pred.val])! * ∏ j ∈ ((Finset.univ : Finset (Fin (list'.length - 1))) \ {i_new'}) \ {i_new'_pred}, (#list'[j.val + 1] - #list'[j.val])! := by + refine' Finset.prod_eq_mul_prod_diff_singleton _ (fun (i : Fin (list'.length - 1)) ↦ (#list'[i.val + 1] - #list'[i.val])!) + apply mem_sdiff.mpr + constructor + · simp + · unfold i_new'_pred i_new' + simp + apply sub_one_ne_self - have product_split := Finset.prod_eq_mul_prod_diff_singleton h_i_new' (fun (i : Fin (list'.length - 1)) ↦ (#list'[i.val + 1] - #list'[i.val])!) + have list_first_entry : list'[0] = ∅ := first_entry list' list_sorted' list_per'.symm empty_in_chain' - rw [ind_present, product_split] + by_contra ass - have prod_identity : ∏ j ∈ 𝒬', multiplicant j = ∏ x ∈ univ \ {i_new'}, (#list'[↑x + 1] - #list'[↑x])! := by - simp [𝒬', multiplicant] - sorry + simp [←ass, h_i_new] at list_first_entry + unfold e_new at list_first_entry + + have := nonempty_iff_ne_empty.mp (Finset.insert_nonempty a.val layer_s) + + exact this list_first_entry - have mul_identity : multiplicant' i_s = (#list'[↑i_new' + 1] - #list'[↑i_new'])! := by sorry + _ = 1 * ∏ j ∈ ((Finset.univ : Finset (Fin (list'.length - 1))) \ {i_new'}) \ {i_new'_pred}, (#list'[j.val + 1] - #list'[j.val])! := by + congr + sorry - rw [prod_identity, mul_identity] + sorry + -- have mul_identity : multiplicant' i_s = (#list'[↑i_new' + 1] - #list'[↑i_new'])! := by sorry /-The set of maximal chains through ℬ is the disjoint union of maximal chains through the union of ℬ with some chain extension candidate-/ have central_identity: (Finset.univ : Finset ℬ.MaxChainThrough).image (emb_MaxChainThrough ℬ) = extension_candidates.disjiUnion extensions_wrt (by sorry) := by sorry - have := Finset.card_image_of_injective (Finset.univ : Finset ℬ.MaxChainThrough) (inj_emb_MaxChainThrough ℬ) + have := Finset.card_image_of_injective (Finset.univ : Finset ℬ.MaxChainThrough) inj_emb_MaxChainThrough rw [Fintype.card, ←this, central_identity, card_disjiUnion] @@ -897,10 +928,10 @@ lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Finty intro x hx rfl - · intro ℬ cardℬ chainℬ monotone_cards empty_in_chain univ_in_chain - have entry_cards : ∀ j : Fin (ℬ.toList.length - 1), #ℬ.toList[j.val] = j.val := by sorry + · intro ℬ cardℬ chainℬ empty_in_chain univ_in_chain list list_sorted list_perm + have entry_cards : ∀ j : Fin (list.length - 1), #list[j.val] = j.val := by sorry have rhs_one := by calc - ∏ j : Fin (ℬ.toList.length - 1), (#ℬ.toList[j.val + 1] - #ℬ.toList[j.val])! = ∏ j : Fin (ℬ.toList.length - 1), 1 := by + ∏ j : Fin (list.length - 1), (#list[j.val + 1] - #list[j.val])! = ∏ j : Fin (list.length - 1), 1 := by apply Finset.prod_congr (by simp) intro j _ rw [entry_cards, entry_cards ⟨j + 1, by sorry⟩] @@ -955,7 +986,8 @@ theorem lym_inequality (antichain𝒜 : IsAntichain (· ⊂ ·) 𝒜) (hn : Fint have slice_partition : Finset.disjiUnion (Iic n) 𝒜.slice (Finset.pairwiseDisjoint_slice.subset (Set.subset_univ _)) = 𝒜 := by rw [Finset.disjiUnion_eq_biUnion (Iic n) 𝒜.slice (Finset.pairwiseDisjoint_slice.subset (Set.subset_univ _))] rw [←hn] - simp [biUnion_slice 𝒜] + --simp (biUnion_slice 𝒜) + sorry calc ∑ k ∈ Iic n, #(𝒜 # k) * (k)! * (n - k)! = ∑ k ∈ Iic n, ∑ e ∈ (𝒜 # k), (#e)! * (n - #e)! := by From c20dee1fbb3045399cfe9e5688c5f9dd0d5631ad Mon Sep 17 00:00:00 2001 From: Jakob Zimmermann Date: Fri, 24 Jan 2025 23:09:46 +0100 Subject: [PATCH 20/26] working on coercion instances --- TheBook/Combinatorics/Sperner.lean | 132 +- .../Sperner_handcrafted_definitions.lean | 1306 ----------------- 2 files changed, 113 insertions(+), 1325 deletions(-) delete mode 100644 TheBook/Combinatorics/Sperner_handcrafted_definitions.lean diff --git a/TheBook/Combinatorics/Sperner.lean b/TheBook/Combinatorics/Sperner.lean index b18883a..c95c363 100644 --- a/TheBook/Combinatorics/Sperner.lean +++ b/TheBook/Combinatorics/Sperner.lean @@ -44,6 +44,10 @@ variable {β : Type*} (r : β → β → Prop) /-- In this file, we use `≺` as a local notation for any relation `r`. -/ local infixl:50 " ≺ " => r +/- + The following definitions match the ones in Mathlib.Order.Chain, but use Finset in order to be able to carry information on finiteness inside the chain property. +-/ + def IsChain (s : Finset β) : Prop := s.toSet.Pairwise fun x y => x ≺ y ∨ y ≺ x @@ -60,14 +64,42 @@ def IsAntichain (r : α → α → Prop) (s : Finset α) : Prop := end Finset -instance : Coe (IsChain (· ⊂ ·) 𝒜.toSet) (𝒜.IsChain (· ⊂ ·)) := - ⟨λ h => h⟩ +variable (ℬ₀ : Set β) (ℬ₁ : Finset β) (r : β → β → Prop) + +/- The usual definition of chains are compatible if used along the toSet method-/ +example (h : Finset.IsChain r ℬ₁) : IsChain r ℬ₁.toSet := h +example (h : IsChain r ℬ₁.toSet) : Finset.IsChain r ℬ₁ := h + + +instance [Fintype ℬ₀] : Coe (IsChain r ℬ₀) (Finset.IsChain r ℬ₀.toFinset) := + ⟨fun h ↦ (fun _ hx _ hy xneqy ↦ h (Set.mem_toFinset.mp hx) (Set.mem_toFinset.mp hy) xneqy)⟩ + +example [Fintype ℬ₀] (h : IsChain r ℬ₀) : Finset.IsChain r ℬ₀.toFinset := h + +variable {γ : Type*} + +instance [Fintype β] : Fintype (Finset β) := { + elems := Finset.powerset (@Finset.univ β _), + complete := by simp +} + +noncomputable instance [Fintype β] : Fintype ℬ₀ := Fintype.ofFinite ↑ℬ₀ + +noncomputable instance [Fintype β] : Coe (Set β) (Finset β) := ⟨fun s ↦ s.toFinset⟩ + +noncomputable example [Fintype β] (𝒟 : Set β) : Finset β := 𝒟 + +instance [Fintype β] : Coe (_root_.IsChain r ℬ₀) (Finset.IsChain r ℬ₀.toFinset) := + ⟨fun h ↦ (fun _ hx _ hy xneqy ↦ h (Set.mem_toFinset.mp hx) (Set.mem_toFinset.mp hy) xneqy)⟩ + +instance [Fintype β] : Fintype (Set β) := { + elems := (Finset.powerset (@Finset.univ β _)).map ⟨Finset.toSet, Finset.coe_injective⟩, + complete := by intro x; simp; use x.toFinset; simp +} -instance : Coe (𝒜.IsChain (· ⊂ ·)) (IsChain (· ⊂ ·) 𝒜.toSet) := - ⟨λ h => h⟩ +variable (β : Type*) [Fintype β] (𝒞₀ : Set β) (𝒞₁ : Finset β) (r₁ : β → β → Prop) [Fintype 𝒞₀] -example (h : IsChain (· ⊂ ·) 𝒜.toSet) : 𝒜.IsChain (· ⊂ ·) := h -example (h : 𝒜.IsChain (· ⊂ ·)) : IsChain (· ⊂ ·) 𝒜.toSet := h +example (h : _root_.IsChain r₁ 𝒞₀) : Finset.IsChain r₁ 𝒞₀.toFinset := h namespace Finset @@ -166,7 +198,54 @@ instance card_le_is_trans : IsTrans 𝒜 (fun (e₁ e₂ : 𝒜) ↦ e₁.val instance IsChain.card_le_is_trans : IsTrans 𝒜 (fun (e₁ e₂ : 𝒜) ↦ e₁.val ⊆ e₂.val) := ⟨fun _ _ _ h₁ h₂ => subset_trans h₁ h₂⟩ -theorem List.nodup_insertionSort [LE α] [DecidableRel (fun (x₁ x₂ : α) ↦ x₁ ≤ x₂)] {l : List α} (h : l.Nodup) : (l.insertionSort (fun (x₁ x₂ : α) ↦ x₁ ≤ x₂)).Nodup := by sorry +#check List.Nodup.insert + +theorem List.Nodup.orderedInsert [LE α] [DecidableRel (fun (x₁ x₂ : α) ↦ x₁ ≤ x₂)] + {l : List α} {a : α} (l_nodup : l.Nodup) (a_not_mem : a ∉ l) : + (orderedInsert (· ≤ ·) a l).Nodup := by + induction l with + | nil => + simp [orderedInsert] + | cons x xs ih => + simp [orderedInsert] + simp at a_not_mem + simp at l_nodup + split + · simp [List.Nodup] + constructor + · constructor + · exact a_not_mem.left + · intro u hu + by_contra ass + rw [←ass] at hu + exact a_not_mem.right hu + · constructor + · intro u hu + by_contra ass + rw [←ass] at hu + exact l_nodup.left hu + · exact l_nodup.right + · simp + constructor + · constructor + · exact fun x ↦ a_not_mem.left x.symm + · exact l_nodup.left + · exact ih l_nodup.right a_not_mem.right + +theorem List.Nodup.insertionSort [LE α] [DecidableRel (fun (x₁ x₂ : α) ↦ x₁ ≤ x₂)] {l : List α} (h : l.Nodup) : (l.insertionSort (fun (x₁ x₂ : α) ↦ x₁ ≤ x₂)).Nodup := by + induction l with + | nil => + simp [List.insertionSort, List.Nodup] + | cons x xs ih => + simp [List.insertionSort] + have sorted_nodup : (xs.insertionSort (fun x₁ x₂ => x₁ ≤ x₂)).Nodup := ih h.tail + have x_ne_mem_sorted : x ∉ xs.insertionSort (fun x₁ x₂ => x₁ ≤ x₂) := by + by_contra ass + simp at h + exact h.left ((List.mem_insertionSort (· ≤ ·)).mp ass) + exact List.Nodup.orderedInsert sorted_nodup x_ne_mem_sorted + +#check List.attach lemma card_strict_mono' (chain𝒜 : IsChain (· ⊂ ·) 𝒜) : ((Finset.univ : Finset 𝒜).toList.insertionSort (fun (e₁ e₂ : 𝒜) ↦ #e₁.val ≤ #e₂.val)).Sorted (fun (e₁ e₂ : 𝒜) ↦ #e₁.val < #e₂.val) := by apply List.pairwise_iff_get.mpr @@ -178,12 +257,10 @@ lemma card_strict_mono' (chain𝒜 : IsChain (· ⊂ ·) 𝒜) : ((Finset.univ : have card_eq := Nat.le_antisymm card_le ass have elt_x_eq_elt_y := Subtype.eq (IsChain.unique_of_cardinality_chain chain𝒜 elt_x.prop elt_y.prop card_eq) - have elt_x_neq_elt_y : elt_x ≠ elt_y := List.pairwise_iff_get.mp (List.nodup_insertionSort ((Finset.univ : Finset 𝒜).nodup_toList)) x y xlty + have elt_x_neq_elt_y : elt_x ≠ elt_y := List.pairwise_iff_get.mp (List.Nodup.insertionSort ((Finset.univ : Finset 𝒜).nodup_toList)) x y xlty exact elt_x_neq_elt_y elt_x_eq_elt_y -#check Perm.map Subtype.val - def IsChain.card_strict_mono (chain𝒜 : IsChain (· ⊂ ·) 𝒜) : ∃ l : List (Finset α), l ~ 𝒜.toList ∧ l.Sorted (#· < #·) := by let l' := ((Finset.univ : Finset 𝒜).toList.insertionSort (fun (e₁ e₂ : 𝒜) ↦ #e₁.val ≤ #e₂.val)) have l'_sorted : l'.Sorted (fun (e₁ e₂ : 𝒜) ↦ #e₁.val < #e₂.val) := card_strict_mono' chain𝒜 @@ -210,7 +287,6 @@ def IsChain.card_strict_mono (chain𝒜 : IsChain (· ⊂ ·) 𝒜) : ∃ l : Li have := List.pairwise_iff_get.mp l'_sorted (Fin.cast this i) (Fin.cast this j) iltj_coe exact this - /-- If a chain intersects a layer of the boolean lattice this intersection is a singleton -/ lemma layer_singleton_of_nonempty (chain𝒜 : IsChain (· ⊂ ·) 𝒜) (j : Finset.range (n + 1)) (layer_nonempty : (𝒜 # j) ≠ ∅): ∃! e : Finset α, 𝒜 # j = {e} := by @@ -252,12 +328,6 @@ lemma IsChain.subset_of_le_cardinality (chain𝒜 : IsChain (· ⊂ ·) 𝒜) {e variable [Fintype α] [DecidableEq α] [DecidableEq (Finset (Finset α))] [DecidableEq (Finset α)] -instance : Coe (Set (Finset α)) (Finset (Finset α)) := - ⟨λ s => by sorry⟩ - - -example (ℬ : Set (Finset α)) : Finset (Finset α) := ℬ - def chain_extension_filter_function (𝒜 : Finset (Finset α)) (e : Finset α) : α → Prop := fun a : α ↦ IsChain (· ⊂ ·) (insert (insert a e) 𝒜) ∧ insert a e ∉ 𝒜 @@ -707,6 +777,31 @@ lemma incident_indices_monotone_cards {n: ℕ} {s t : Fin (n + 1)} {ℬ : Finset exact ⟨h_i_s, h_i_t⟩ +def extension_candidates (ℬ : Finset (Finset α)) (e : Finset α) := Finset.filter (chain_extension_filter_function ℬ e) (Finset.univ : Finset α) + +def extensions_wrt (ℬ : Finset (Finset α)) (e : Finset α) (x : α) : Finset (Finset (Finset α)) := by + let ℬ' : Finset (Finset α) := Insert.insert (Insert.insert x e) ℬ + exact (Finset.univ : Finset ℬ'.MaxChainThrough).image (emb_MaxChainThrough ℬ') + +lemma chain_through_extension_candidates_pairwiseDisjoint (ℬ : Finset (Finset α)) (e : Finset α) (e_mem : e ∈ ℬ) : PairwiseDisjoint (extension_candidates ℬ e) (extensions_wrt ℬ e) := by + intro x hx y hy xneqy + simp [_root_.Disjoint] + simp [extensions_wrt] + intro A hA_x hA_y + intro 𝒜 h𝒜 + have a_extension_e_x := hA_x h𝒜 + have a_extension_e_y := hA_y h𝒜 + + sorry + + + +/-The set of maximal chains through ℬ is the disjoint union of maximal chains through the union of ℬ with some chain extension candidate-/ +lemma central_identity {ℬ : Finset (Finset α)} (e : Finset α) (e_mem : e ∈ ℬ) : + Finset.univ.image (emb_MaxChainThrough ℬ) = (extension_candidates ℬ e).disjiUnion (extensions_wrt ℬ e) + (chain_through_extension_candidates_pairwiseDisjoint ℬ e e_mem) := by sorry + + lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Fintype.card α = n) (ℬ : Finset (Finset α)) (cardℬ : #ℬ = m) (chainℬ : IsChain (· ⊂ ·) ℬ) (empty_in_chain : ∅ ∈ ℬ) (univ_in_chain : univ ∈ ℬ) (list : List (Finset α)) (list_per : ℬ.toList ~ list) (list_sorted : list.Sorted (#· < #·)): @@ -896,8 +991,7 @@ lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Finty -- have mul_identity : multiplicant' i_s = (#list'[↑i_new' + 1] - #list'[↑i_new'])! := by sorry - /-The set of maximal chains through ℬ is the disjoint union of maximal chains through the union of ℬ with some chain extension candidate-/ - have central_identity: (Finset.univ : Finset ℬ.MaxChainThrough).image (emb_MaxChainThrough ℬ) = extension_candidates.disjiUnion extensions_wrt (by sorry) := by sorry + have central_identity := central_identity layer_s layer_s_mem_card.left have := Finset.card_image_of_injective (Finset.univ : Finset ℬ.MaxChainThrough) inj_emb_MaxChainThrough diff --git a/TheBook/Combinatorics/Sperner_handcrafted_definitions.lean b/TheBook/Combinatorics/Sperner_handcrafted_definitions.lean deleted file mode 100644 index d9e7e32..0000000 --- a/TheBook/Combinatorics/Sperner_handcrafted_definitions.lean +++ /dev/null @@ -1,1306 +0,0 @@ -/- -Copyright 2022 Google LLC - -Licensed under the Apache License, Version 2.0 (the "License"); -you may not use this file except in compliance with the License. -You may obtain a copy of the License at - - https://www.apache.org/licenses/LICENSE-2.0 - -Unless required by applicable law or agreed to in writing, software -distributed under the License is distributed on an "AS IS" BASIS, -WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -See the License for the specific language governing permissions and -limitations under the License. - -Authors: Moritz Firsching, Jakob Zimmermann --/ -import Mathlib.Tactic -import Mathlib.Combinatorics.Enumerative.DoubleCounting -import Mathlib.Combinatorics.Derangements.Finite -import Mathlib.Logic.Equiv.Defs -import Mathlib.Data.Set.Basic - -/-! -# Three famous lemmas on finite sets - -## TODO - - **Sperners Theorem** - - Add the proofs of equivalences - - Adapt variable names and proof style - - **Erd\{o}s Ko Rado** - - Add statement and proof - - **Halls Theorem** - - Add statement and proof --/ - -namespace chapter30 - -open Function Nat Set - -/- - Definition of the basic structures --/ - -structure TopDownChain (n : ℕ) where - X : Finset (Finset (Fin n)) - chain : IsChain (· ⊆ ·) X.toSet - top_down : Fintype.card X = n + 1 - -example : TopDownChain 0 := { - X := {∅}, - chain := by - intros x hx y hy xnegy - simp at hx hy - simp [hx, hy] at xnegy - top_down := by simp -} - -structure TopDownChainThrough (n : ℕ) (a : Finset (Fin n)) where - top_down_chain : TopDownChain n - through : a ∈ top_down_chain.X - -structure TopDownChainSplitThrough (n : ℕ) (a : Finset (Fin n)) where - bottom_chain : TopDownChain (Finset.card a) - top_chain : TopDownChain (n - Finset.card a) - -instance (n : ℕ) : DecidableEq (TopDownChain n) := - fun a b => - if h_eq : a.X = b.X then - isTrue (by - obtain ⟨aX, achain, atop_down⟩ := a - obtain ⟨bX, bchain, btop_down⟩ := b - simp - exact h_eq) - else - isFalse (fun h => h_eq (congrArg (·.X) h)) - -instance {n : ℕ} (a : Finset (Fin n)) : DecidableEq (TopDownChainThrough n a) := - fun C₁ C₂ => - if h_eq : C₁.top_down_chain.X = C₂.top_down_chain.X then - isTrue (by - obtain ⟨⟨a₁, b₁, c₁⟩, through₁⟩ := C₁ - obtain ⟨⟨a₂, b₂, c₂⟩, through₂⟩ := C₂ - simp - exact h_eq) - else - isFalse (fun h => h_eq (congrArg (·.top_down_chain.X) h)) - -instance (n : ℕ) (a : Finset (Fin n)) : DecidableEq (TopDownChainSplitThrough n a) := - fun C₁ C₂ => - if h_eq : C₁.bottom_chain.X = C₂.bottom_chain.X ∧ C₁.top_chain.X = C₂.top_chain.X then - isTrue (by - obtain ⟨⟨a₁₁, b₁₁, c₁₁⟩, ⟨a₁₂, b₁₂, c₁₂⟩⟩ := C₁ - obtain ⟨⟨a₂₁, b₂₁, c₂₁⟩, ⟨a₂₂, b₂₂, c₂₂⟩⟩ := C₂ - simp - exact h_eq) - else - isFalse (fun h => - have h' : C₁.bottom_chain.X = C₂.bottom_chain.X ∧ C₁.top_chain.X = C₂.top_chain.X := by rw [h]; exact ⟨rfl, rfl⟩ - h_eq h') - -/- - Equivalence between **TopDownChain** n and **Equiv.Perm (Fin n)** --/ - -def permutation_to_edge {n : ℕ} (k : Fin (n + 1)) (π : Equiv.Perm (Fin n)) : Finset (Fin n) := - Finset.image (fun (j : Fin k) => π ⟨j, Nat.lt_of_lt_of_le j.isLt (Nat.le_of_lt_succ k.isLt)⟩) (Finset.univ : Finset (Fin k)) - -lemma permutation_to_edge_cardinality {n : ℕ} (π : Equiv.Perm (Fin n)) : ∀ k : Fin (n + 1), Finset.card (permutation_to_edge k π) = k := by - intro k - simp [permutation_to_edge] - rw [Finset.card_image_of_injective] - · simp - · rw [Injective] - intro a₁ a₂ h₁ - apply Fin.eq_of_val_eq - injection (Equiv.injective π) h₁ - -def permutation_to_chain {n : ℕ} (π : Equiv.Perm (Fin n)) : Finset (Finset (Fin n)) := - Finset.image (fun (j : Fin (n + 1)) => permutation_to_edge j π) (Finset.univ : Finset (Fin (n + 1))) - -lemma permutation_to_edge_injective {n : ℕ} {π : Equiv.Perm (Fin n)} : Injective (fun (k : Fin (n + 1)) => permutation_to_edge k π) := by - rw [Injective] - intro a₁ a₂ h - have : a₁.val = a₂.val := by - rw [←((permutation_to_edge_cardinality π) a₁), ←((permutation_to_edge_cardinality π) a₂), h] - exact Fin.eq_of_val_eq this - -def permutation_to_top_down_chain (n : ℕ) (π : Equiv.Perm (Fin n)) : TopDownChain n := { - X := permutation_to_chain π, - chain := by - intros x₁ hx₁ x₂ hx₂ _ - simp [permutation_to_chain, permutation_to_edge] at hx₁ hx₂ - rcases hx₁ with ⟨k₁, hk₁⟩ - rcases hx₂ with ⟨k₂, hk₂⟩ - simp [←hk₁, ←hk₂] - cases Nat.lt_or_ge k₁ k₂ with - | inl k₁ltk₂ => - left - intros y hy - simp only [Finset.mem_image] at hy - obtain ⟨x, _, hx2⟩ := hy - rw [←hx2] - simp only [Finset.mem_image] - use ⟨x.val, Nat.lt_trans x.isLt k₁ltk₂⟩ - simp - | inr k₁gek₂ => - right - intros y hy - simp only [Finset.mem_image] at hy - obtain ⟨x, _, hx2⟩ := hy - rw [←hx2] - simp only [Finset.mem_image] - use ⟨x.val, Nat.lt_of_lt_of_le x.isLt k₁gek₂⟩ - simp - top_down := by - simp - rw [permutation_to_chain] - rw [Finset.card_image_of_injective] - · simp - · exact permutation_to_edge_injective -} - -/- - A helping lemma based on the *piegon hole principle* in order to prove the existence of an edge for a given cardinality. Observe that the injectivity of edge_by_cardinality is easily verified --/ -lemma finset_exists_duplicate_image {α : Type*} [Fintype α] [DecidableEq α] (f : α → α) (b : α) (h : ∀ a ∈ (Finset.univ : Finset α), f a ≠ b) : - ∃ x ∈ (Finset.univ : Finset α), ∃ y ∈ (Finset.univ : Finset α), x ≠ y ∧ f x = f y := by - let g : α → (Finset.erase (Finset.univ : Finset α) b) := fun a => ⟨f a, Finset.mem_erase.mpr ⟨h a (Finset.mem_univ a), Finset.mem_univ (f a)⟩⟩ - have imagesmaller : Fintype.card (Finset.erase (Finset.univ : Finset α) b) < Fintype.card α := by - have : ((Finset.univ : Finset α).erase b).card < (Finset.univ : Finset α).card := by - rw [Finset.card_erase_of_mem (Finset.mem_univ b)] - exact Nat.sub_lt (Finset.card_pos.mpr ⟨b, by simp⟩) (Nat.one_pos) - simp [this] - exact (Finset.card_pos.mpr ⟨b, by simp⟩) - obtain ⟨x, y, xneqy, hg⟩ := (Fintype.exists_ne_map_eq_of_card_lt g imagesmaller) - have : f x = f y := by - have hgx : f x = ↑(g x) := by rfl - have hgy : f y = ↑(g y) := by rfl - rw [hgx, hgy] - rw [hg] - exact ⟨x, Finset.mem_univ x, y, Finset.mem_univ y, xneqy, this⟩ - -/- - In order to construct a permutation from a TopDownChain we need to have access to chain elements given their cardinality --/ -lemma edge_cardinality_upperbound {m : ℕ} (e : Finset (Fin m)): Finset.card (e) ≤ m := by - have edge_inclusion : e ⊆ Finset.univ := Finset.subset_univ e - have h_univ_card : m = (Finset.univ : Finset (Fin m)).card := by - simp [Finset.card_univ] - have := Finset.card_le_card edge_inclusion - rw [←h_univ_card] at this - exact this - -lemma card_not_twice {n : ℕ} (C : TopDownChain n) : ∀ e₁ ∈ C.X, ∀ e₂ ∈ C.X, Finset.card e₁ = Finset.card e₂ → e₁ = e₂ := by - intro e₁ he₁ e₂ he₂ h - by_contra hna - cases ((C.chain he₁ he₂) hna) with - | inl e₁sube₂ => - simp at e₁sube₂ - have : e₁ ⊂ e₂ := Finset.ssubset_iff_subset_ne.mpr ⟨e₁sube₂, hna⟩ - have : e₁.card < e₂.card := Finset.card_lt_card this - linarith - | inr e₂sube₁ => - simp at e₂sube₁ - have : e₂ ⊂ e₁ := Finset.ssubset_iff_subset_ne.mpr ⟨e₂sube₁, fun h => hna (Eq.symm h)⟩ - have : e₂.card < e₁.card := Finset.card_lt_card this - linarith - -def edge_by_cardinality {n : ℕ} (C : TopDownChain n) (k : Fin (n + 1)) : ∃! e ∈ C.X, Finset.card e = k := by - have existence_edge_by_cardinality : ∃ e ∈ C.X, e.card = k := by - by_contra ass - simp at ass - let list : List (Finset (Fin n)) := C.X.toList - have list_length : list.length = n + 1 := by simp [←C.top_down, list] - let kth_edge (j : Fin (n + 1)) : Finset (Fin n) := List.get list ⟨j.val, by rw [list_length]; exact j.isLt⟩ - have kth_edge_wd : ∀ j : Fin (n + 1), kth_edge j ∈ C.X := by - intro j - have : kth_edge j ∈ C.X.toList := by simp [kth_edge] - exact Finset.mem_toList.mp this - - have edge_cardinality_range (j : Fin (n + 1)) : Finset.card (kth_edge j) < n + 1 := - Nat.lt_of_le_of_lt (edge_cardinality_upperbound (kth_edge j)) (Nat.lt_succ_self n) - - let kth_cardinality (j : Fin (n + 1)) : Fin (n + 1) := ⟨Finset.card (kth_edge j), edge_cardinality_range j⟩ - - have h : ∀ s ∈ (Finset.univ : Finset (Fin (n + 1))), kth_cardinality s ≠ k := by - intro s _ h₁ - simp [kth_cardinality] at h₁ - have h₂ := ass (kth_edge s) (kth_edge_wd s) - have h₃ := congr_arg (fun (x : Fin (n + 1)) => x.val) h₁ - exact h₂ h₃ - - rcases (finset_exists_duplicate_image kth_cardinality k h) with ⟨x, _, y, _, xneqy, card_equal⟩ - simp [kth_cardinality] at card_equal - have q : list[↑x] = list[↑y] := card_not_twice C (kth_edge x) (kth_edge_wd x) (kth_edge y) (kth_edge_wd y) card_equal - have : ↑x = ↑y := by - let nx : Fin list.length := ⟨x.val, by rw [list_length]; exact x.isLt⟩ - let ny : Fin list.length := ⟨y.val, by rw [list_length]; exact y.isLt⟩ - by_contra ass - have neq : nx ≠ ny := by - intro nxeqny - simp [nx, ny] at nxeqny - exact ass (Fin.ext nxeqny) - have := List.not_nodup_of_get_eq_of_ne list nx ⟨y.val, by rw [list_length]; exact y.isLt⟩ q neq - exact this C.X.nodup_toList - - exact xneqy this - - obtain ⟨e, he⟩ := existence_edge_by_cardinality - - have uniqueness_edge_by_cardinality : ∀ (y : Finset (Fin n)), (fun u ↦ u ∈ C.X ∧ u.card = ↑k) y → y = e := by - obtain ⟨eelt, ecard⟩ := he - intros y hy - obtain ⟨yelt, ycard⟩ := hy - exact card_not_twice C y yelt e eelt (by simp [ecard, ycard]) - - exact ⟨e, he, uniqueness_edge_by_cardinality⟩ - -instance {n : ℕ} (C : TopDownChain n) (k : Fin (n + 1)) : DecidablePred (fun (e : Finset (Fin n)) => e ∈ C.X ∧ e.card = k) := fun e => inferInstanceAs (Decidable (e ∈ C.X ∧ e.card = k)) - -/- - Helper function for defining a permutation from a TopDownChain. We split the existence and uniqueness in elt_by_index into two simpler helper functions --/ - -def elt_by_index_existence {n : ℕ} (C : TopDownChain n) (k : Fin n) : ∃! x ∈ (Finset.univ : Finset (Fin n)), ∀ u₁ ∈ C.X, ∀ u₂ ∈ C.X, (u₁.card = k → u₂.card = k + 1 → u₂ \ u₁ = {x}) := by - let e₁ := (edge_by_cardinality C k).choose - have he₁ := (edge_by_cardinality C k).choose_spec - have e₁elt : e₁ ∈ C.X := he₁.left.left - have e₁card : e₁.card = k := by simp [he₁.left.right] - have e₁unique : ∀ (y : Finset (Fin n)), (fun u ↦ u ∈ C.X ∧ u.card = k) y → y = e₁ := by - intro y hy - have := (he₁.right y) - simp at this - have := this hy.1 hy.2 - simp [this, e₁] - - let e₂ := (edge_by_cardinality C (k + 1)).choose - have he₂ := (edge_by_cardinality C (k + 1)).choose_spec - have e₂elt : e₂ ∈ C.X := he₂.left.left - have e₂card : e₂.card = k + 1 := by simp [he₂.left.right] - have e₂unique : ∀ (y : Finset (Fin n)), (fun u ↦ u ∈ C.X ∧ u.card = k + 1) y → y = e₂ := by - intro y hy - have := (he₂.right y) - simp at this - have := this hy.1 hy.2 - simp [this, e₂] - - have e₁sube₂ : e₁ ⊂ e₂ := by - have e₁nege₂ : e₁ ≠ e₂ := by - intro ass - have : e₁.card = k + 1 := ass.symm ▸ e₂card - rw [e₁card] at this - omega - cases C.chain e₁elt e₂elt e₁nege₂ with - | inl h => - exact Finset.ssubset_iff_subset_ne.mpr ⟨h, e₁nege₂⟩ - | inr h => - simp at h - have := Finset.card_mono h - rw [e₁card, e₂card] at this - omega - - have card_difference : (e₂ \ e₁).card = 1 := by - have := Finset.card_sdiff ((Finset.ssubset_def.mp e₁sube₂).1) - rw [e₁card, e₂card] at this - simp [this] - - let x := (Finset.card_eq_one.mp card_difference).choose - let hx : e₂ \ e₁ = {x} := (Finset.card_eq_one.mp card_difference).choose_spec - - use x - simp - constructor - · intro u₁ u₁elt u₂ u₂elt u₁card u₂card - have u₁eqe₁ : u₁ = e₁ := by - have := e₁unique u₁ - simp at this - exact this u₁elt u₁card - have u₂eqe₂ : u₂ = e₂ := by - have := e₂unique u₂ - simp at this - exact this u₂elt u₂card - rw [u₁eqe₁, u₂eqe₂] - exact hx - · intros y hy - have : e₂ \ e₁ = {y} := hy e₁ e₁elt e₂ e₂elt e₁card e₂card - rw [hx] at this - exact Finset.singleton_injective this.symm - -def filter_fun_elt_by_index {n : ℕ} (C : TopDownChain n) (k : Fin (n + 1)) : Fin n → Prop := (fun (x : Fin n) => ∀ u₁ ∈ C.X, ∀ u₂ ∈ C.X, (u₁.card = k → u₂.card = k + 1 → u₂ \ u₁ = {x})) -instance {n : ℕ} (C : TopDownChain n) (k : Fin (n + 1)) : DecidablePred (filter_fun_elt_by_index C k) := fun x => inferInstanceAs (Decidable (∀ u₁ ∈ C.X, ∀ u₂ ∈ C.X, (u₁.card = k → u₂.card = k + 1 → u₂ \ u₁ = {x}))) - -lemma elt_by_index_unique {n : ℕ} (C : TopDownChain n) (k : Fin n) : ∃! a, a ∈ Finset.univ ∧ filter_fun_elt_by_index C k a := by - simp [filter_fun_elt_by_index] - have := elt_by_index_existence C k - simp at this - exact this - -def elt_by_index {n : ℕ} (C : TopDownChain n) : (Fin n) → (Fin n) := fun k => Finset.choose (filter_fun_elt_by_index C k) (Finset.univ : Finset (Fin n)) (elt_by_index_unique C k) - -lemma elt_by_index_injective {n : ℕ} (C : TopDownChain n) : Injective (elt_by_index C) := by - intro x₁ x₂ fx₁x₂ - - simp only [elt_by_index] at fx₁x₂ - - let y₁ := Finset.choose (filter_fun_elt_by_index C x₁) Finset.univ (elt_by_index_unique C x₁) - let hy₁ := (Finset.choose_spec (filter_fun_elt_by_index C x₁) Finset.univ (elt_by_index_unique C x₁)).right - have hy₁_eq : y₁ = Finset.choose (filter_fun_elt_by_index C ↑↑x₁) Finset.univ (elt_by_index_unique C x₁) := rfl - simp only [filter_fun_elt_by_index, ←hy₁_eq] at hy₁ - - let y₂ := Finset.choose (filter_fun_elt_by_index C x₂) Finset.univ (elt_by_index_unique C x₂) - let hy₂ := (Finset.choose_spec (filter_fun_elt_by_index C x₂) Finset.univ (elt_by_index_unique C x₂)).right - have hy₂_eq : y₂ = Finset.choose (filter_fun_elt_by_index C ↑↑x₂) Finset.univ (elt_by_index_unique C x₂) := rfl - simp only [filter_fun_elt_by_index, ←hy₂_eq] at hy₂ - - have y₁eqy₂ : y₁ = y₂ := fx₁x₂ - - let e₁₁ := (edge_by_cardinality C x₁).choose - have he₁₁ := (edge_by_cardinality C x₁).choose_spec - have e₁₁elt : e₁₁ ∈ C.X := he₁₁.left.left - have e₁₁card : e₁₁.card = x₁ := by simp [he₁₁.left.right] - - let e₂₁ := (edge_by_cardinality C (x₁ + 1)).choose - have he₂₁ := (edge_by_cardinality C (x₁ + 1)).choose_spec - have e₂₁elt : e₂₁ ∈ C.X := he₂₁.left.left - have e₂₁card : e₂₁.card = x₁ + 1 := by simp [he₂₁.left.right] - - let e₁₂ := (edge_by_cardinality C x₂).choose - have he₁₂ := (edge_by_cardinality C x₂).choose_spec - have e₁₂elt : e₁₂ ∈ C.X := he₁₂.left.left - have e₁₂card : e₁₂.card = x₂ := by simp [he₁₂.left.right] - - let e₂₂ := (edge_by_cardinality C (x₂ + 1)).choose - have he₂₂ := (edge_by_cardinality C (x₂ + 1)).choose_spec - have e₂₂elt : e₂₂ ∈ C.X := he₂₂.left.left - have e₂₂card : e₂₂.card = x₂ + 1 := by simp [he₂₂.left.right] - - have q₁ := hy₁ e₁₁ e₁₁elt e₂₁ e₂₁elt (by simp [e₁₁card]) (by simp [e₂₁card]) - have q₂ := hy₂ e₁₂ e₁₂elt e₂₂ e₂₂elt (by simp [e₁₂card]) (by simp [e₂₂card]) - - have e₁₁nege₂₁ : e₁₁ ≠ e₂₁ := by - intro ass - have : e₁₁.card = e₂₁.card := by rw [ass] - rw [e₁₁card, e₂₁card] at this - omega - - have e₁₁sube₂₁ : e₁₁ ⊆ e₂₁ := by - cases (C.chain e₁₁elt e₂₁elt e₁₁nege₂₁) with - | inl h => exact h - | inr h => - simp at h - have : e₂₁.card ≤ e₁₁.card := Finset.card_mono h - rw [e₁₁card, e₂₁card] at this - omega - - have e₁₂nege₂₂ : e₁₂ ≠ e₂₂ := by - intro ass - have : e₁₂.card = e₂₂.card := by rw [ass] - rw [e₁₂card, e₂₂card] at this - omega - - have e₁₂sube₂₂ : e₁₂ ⊆ e₂₂ := by - cases (C.chain e₁₂elt e₂₂elt e₁₂nege₂₂) with - | inl h => exact h - | inr h => - simp at h - have : e₂₂.card ≤ e₁₂.card := Finset.card_mono h - rw [e₁₂card, e₂₂card] at this - omega - - have y₁ine₂₁ : y₁ ∈ e₂₁ := by - apply Finset.mem_of_subset Finset.sdiff_subset - rw [q₁] - exact Finset.mem_singleton_self y₁ - - have y₂ine₂₂ : y₂ ∈ e₂₂ := by - apply Finset.mem_of_subset Finset.sdiff_subset - rw [q₂] - exact Finset.mem_singleton_self y₂ - - have : e₂₁ = e₂₂ := by - by_contra ass - cases (C.chain e₂₁elt e₂₂elt ass) with - | inl e₂₁sube₂₂ => - simp at e₂₁sube₂₂ - have e₂₁sube₁₂ : e₂₁ ⊆ e₁₂ := - if h : (e₂₁ = e₁₂) then (Finset.subset_of_eq h) else by - cases (C.chain e₂₁elt e₁₂elt h) with - | inl e₂₁sube₁₂ => exact e₂₁sube₁₂ - | inr e₁₂sube₂₁ => - simp at e₁₂sube₂₁ - have : e₁₂.card < e₂₁.card := Finset.card_strictMono (Finset.ssubset_iff_subset_ne.mpr ⟨e₁₂sube₂₁, (fun o => h o.symm)⟩) - have : e₂₁.card < e₂₂.card := Finset.card_strictMono (Finset.ssubset_iff_subset_ne.mpr ⟨e₂₁sube₂₂, (fun o => ass o)⟩) - have e₁₂union₂₂ := Finset.union_eq_right.mpr e₁₂sube₂₂ - rw [Finset.union_comm] at e₁₂union₂₂ - have := Finset.card_sdiff_add_card e₂₂ e₁₂ - rw [q₂, Finset.card_singleton, e₁₂union₂₂] at this - linarith - - have y₂ine₁₂ : y₂ ∈ e₁₂ := by - rw [←y₁eqy₂] - exact Finset.mem_of_subset e₂₁sube₁₂ y₁ine₂₁ - have : y₂ ∈ e₂₂ \ e₁₂ := by - rw [q₂] - exact Finset.mem_singleton_self y₂ - - exact False.elim ((Finset.mem_sdiff.mp this).right y₂ine₁₂) - | inr e₂₂sube₂₁ => - have e₂₂sube₁₁ : e₂₂ ⊆ e₁₁ := - if h : (e₂₂ = e₁₁) then (Finset.subset_of_eq h) else by - cases (C.chain e₂₂elt e₁₁elt h) with - | inl e₂₂sube₁₁ => exact e₂₂sube₁₁ - | inr e₁₁sube₂₂ => - simp at e₁₁sube₂₂ - have : e₁₁.card < e₂₂.card := Finset.card_strictMono (Finset.ssubset_iff_subset_ne.mpr ⟨e₁₁sube₂₂, (fun o => h o.symm)⟩) - have : e₂₂.card < e₂₁.card := Finset.card_strictMono (Finset.ssubset_iff_subset_ne.mpr ⟨e₂₂sube₂₁, (fun o => ass o.symm)⟩) - have e₁₁union₂₁ := Finset.union_eq_right.mpr e₁₁sube₂₁ - rw [Finset.union_comm] at e₁₁union₂₁ - have := Finset.card_sdiff_add_card e₂₁ e₁₁ - rw [q₁, Finset.card_singleton, e₁₁union₂₁] at this - linarith - have y₁ine₁₁ : y₁ ∈ e₁₁ := by - rw [y₁eqy₂] - exact Finset.mem_of_subset e₂₂sube₁₁ y₂ine₂₂ - have : y₁ ∈ e₂₁ \ e₁₁ := by - rw [q₁] - exact Finset.mem_singleton_self y₁ - - exact False.elim ((Finset.mem_sdiff.mp this).right y₁ine₁₁) - - have : e₂₁.card = e₂₂.card := by rw [this] - rw [e₂₁card, e₂₂card] at this - norm_num at this - exact Fin.ext this - -/- - In order to use Finset.choose we need some stronger property than given by Bijective (elt_by_index C) --/ -instance {n : ℕ} (C : TopDownChain n) (y : Fin n) : DecidablePred (fun (x : Fin n) => x ∈ (Finset.univ : Finset (Fin n)) ∧ elt_by_index C x = y) := fun x => inferInstanceAs (Decidable (x ∈ (Finset.univ : Finset (Fin n)) ∧ elt_by_index C x = y)) - -lemma elt_by_index_surjective_constructive {n : ℕ} (C : TopDownChain n) : ∀ y : Fin n, ∃! x : Fin n, x ∈ (Finset.univ : Finset (Fin n)) ∧ elt_by_index C x = y := by - intro y - - let e : Fin (n + 1) → Finset (Fin n) := fun x => (edge_by_cardinality C x).choose - let I := Finset.filter (fun x => y ∈ (e x)) (Finset.univ : Finset (Fin (n + 1))) - have image_univ : e ⟨n, by norm_num⟩ = (Finset.univ : Finset (Fin n)) := by - let A := e ⟨n, by norm_num⟩ - have h : A = e ⟨n, by norm_num⟩ := rfl - rw [←h] - simp [e] at h - have := ((edge_by_cardinality C n).choose_spec).left - simp [←h] at this - - apply Finset.eq_univ_of_card A - rw [←Finset.card_univ, Finset.card_fin n] - exact this.right - - have image_empty : e ⟨0, by norm_num⟩ = ∅ := by - let A := e ⟨0, by norm_num⟩ - have h : A = e ⟨0, by norm_num⟩ := rfl - rw [←h] - simp [e] at h - have := ((edge_by_cardinality C 0).choose_spec).left - simp [←h] at this - exact this.right - - have ninI : ⟨n, by norm_num⟩ ∈ I := by - simp [I] - rw [image_univ] - exact Finset.mem_univ y - - have h : I.Nonempty := ⟨⟨n, by norm_num⟩, ninI⟩ - - let x := (Finset.min_of_nonempty h).choose - let hx : I.min = x := (Finset.min_of_nonempty h).choose_spec - - have : ∀ z : Fin (n + 1), z < x → y ∉ (e z) := by - intro z zlty - have : z < I.min := by simp [hx]; exact zlty - have : z ∉ I := Finset.not_mem_of_coe_lt_min this - contrapose this - simp - simp at this - apply Finset.mem_filter.mpr - constructor - · exact Finset.mem_univ z - · exact this - - have zeroltx : 0 < x := by - by_contra ass - have xzero : x = 0 := by - have : ¬0 < x.val := fun h => ass (Fin.lt_def.mpr h) - have : x.val = 0 := Nat.eq_zero_of_not_pos this - exact Fin.ext this - have : 0 ∈ I := by rw [←xzero]; exact Finset.mem_of_min hx - have := (Finset.mem_filter.mp this).right - rw [image_empty] at this - simp at this - - have xminusoneltn : x.val - 1 < n := by - have : x.val < n + 1 := x.isLt - simp [Nat.add_comm n 1] at this - exact Nat.sub_lt_left_of_lt_add (by norm_cast) this - - let w : Fin n := ⟨x - 1, xminusoneltn⟩ - use w - - simp - - have hw : elt_by_index C w = y := by - have hy₁ : y ∉ e w := by - have wltx : w < x := by - simp [w] - apply Fin.lt_def.mpr - norm_num - have : (↑x - 1) % (n + 1) = (↑x - 1) := by - apply Nat.mod_eq_of_lt - have : ↑x < n + 1 := x.isLt - linarith - rw [this] - norm_num - exact zeroltx - exact this w wltx - - have hy₂ : y ∈ e (w + 1) := by - have xw : x = ↑↑w + 1 := by - simp [w] - norm_cast - rw [Nat.sub_add_cancel] - simp - norm_cast - - have : x ∈ I := Finset.mem_of_min hx - simp [I] at this - rw [xw] at this - exact this - - have hy : y ∈ e (w + 1) \ e w := by simp [hy₁, hy₂] - - let u := elt_by_index C w - - let hu : filter_fun_elt_by_index C w u:= (Finset.choose_spec (filter_fun_elt_by_index C w) (Finset.univ : Finset (Fin n)) (elt_by_index_unique C w)).right - simp [filter_fun_elt_by_index] at hu - - let e₁ := e w - have he₁ := (edge_by_cardinality C w).choose_spec - have e₁elt : e₁ ∈ C.X := he₁.left.left - have e₁card : e₁.card = (↑x - 1) % (n + 1) := by simp [he₁.left.right] - - let e₂ := e (w + 1) - have he₂ := (edge_by_cardinality C (w + 1)).choose_spec - have e₂elt : e₂ ∈ C.X := he₂.left.left - have e₂card : e₂.card = (↑x - 1) % (n + 1) + 1 := by - simp [he₂.left.right] - norm_cast - rw [Nat.sub_add_cancel] - simp - apply (Nat.sub_eq_iff_eq_add (by norm_cast)).mp - apply Eq.symm - apply (Nat.mod_eq_iff_lt (by norm_cast)).mpr - linarith - norm_cast - - have usingleton : e₂ \ e₁ = {u} := hu e₁ e₁elt e₂ e₂elt e₁card e₂card - - have e₁nege₂ : e₁ ≠ e₂ := by - intro ass - have : e₁.card = e₂.card := by rw [ass] - rw [e₁card, e₂card] at this - omega - - have e₁sube₂ : e₁ ⊆ e₂ := by - cases (C.chain e₁elt e₂elt e₁nege₂) with - | inl h => exact h - | inr h => - simp at h - have : e₂.card ≤ e₁.card := Finset.card_mono h - rw [e₁card, e₂card] at this - omega - - have : e₂ \ e₁ = {y} := by - have diff_card : (e₂ \ e₁).card = 1 := by - calc - (e₂ \ e₁).card = e₂.card - e₁.card := Finset.card_sdiff e₁sube₂ - _ = (↑x - 1) % (n + 1) + 1 - (↑x - 1) % (n + 1) := by rw [e₁card, e₂card] - _ = 1 := by norm_num - - obtain ⟨y_, hy_⟩ := Finset.card_eq_one.mp diff_card - simp [hy_] - apply Eq.symm - apply Finset.mem_singleton.mp - rw [←hy_] - exact hy - - rw [usingleton] at this - exact Finset.singleton_injective this - - constructor - · exact hw - · intro x₂ hwx₂ - rw [←hw] at hwx₂ - exact (elt_by_index_injective C) hwx₂ - -def elt_by_index_inverse {n : ℕ} (C : TopDownChain n) : Fin n → Fin n := fun y => Finset.choose (fun (x : Fin n) => elt_by_index C x = y) (Finset.univ : Finset (Fin n)) (elt_by_index_surjective_constructive C y) - -def top_down_chain_to_permutation (n : ℕ) (C : TopDownChain n) : Equiv.Perm (Fin n) := { - toFun := elt_by_index C - - invFun := elt_by_index_inverse C - - left_inv := by - intro x - let y := elt_by_index C x - have hy : y = elt_by_index C x := rfl - simp [elt_by_index_inverse, ←hy] - have unique_existence := (elt_by_index_surjective_constructive C y) - obtain ⟨_, exprop⟩ := Finset.choose_spec (fun (x : Fin n) => elt_by_index C x = y) (Finset.univ : Finset (Fin n)) unique_existence - - apply ExistsUnique.unique unique_existence - - · constructor - · simp - · exact exprop - · constructor - · simp - · exact hy - - right_inv := by - intro y - let x := elt_by_index_inverse C y - have hx : x = elt_by_index_inverse C y := rfl - simp only [←hx] - - simp only [elt_by_index_inverse] at hx - - have unique_existence := elt_by_index_surjective_constructive C y - have ⟨_, exprop⟩ := Finset.choose_spec (fun (x : Fin n) => elt_by_index C x = y) (Finset.univ : Finset (Fin n)) unique_existence - simp only [←hx] at exprop - - exact exprop -} - - -theorem top_down_chain_to_permutation_bijective (n : ℕ) : (Bijective (top_down_chain_to_permutation n)) := by sorry - -theorem permutation_to_top_down_chain_bijective (n : ℕ) : (Bijective (permutation_to_top_down_chain n)) := by sorry - -instance (n : ℕ) : Fintype (TopDownChain n) := { - elems := Finset.image (fun π => permutation_to_top_down_chain n π) (Finset.univ : Finset (Equiv.Perm (Fin n))) - complete := by - intro C - simp - exact (permutation_to_top_down_chain_bijective n).right C -} - -/- - Equivalence between **TopDownChainThrough n a** and **TopDownChainSplitThrough n a** --/ - -def TopDownChainSplitThrough_embedding (n : ℕ) (a : Finset (Fin n)) : ((TopDownChain a.card) × (TopDownChain (n - a.card))) → TopDownChainSplitThrough n a := - fun (bottom, top) => (⟨bottom, top⟩ : TopDownChainSplitThrough n a) - -instance (n : ℕ) (a : Finset (Fin n)) : Fintype (TopDownChainSplitThrough n a) := { - elems := Finset.image (TopDownChainSplitThrough_embedding n a) (Finset.univ : Finset ((TopDownChain a.card) × (TopDownChain (n - a.card)))), - complete := by - intro C - simp [TopDownChainSplitThrough_embedding] -} - -lemma TopDownChainSplitThrough_embedding_bijective (n : ℕ) (a : Finset (Fin n)) : Bijective (TopDownChainSplitThrough_embedding n a) := by - constructor - · intro ⟨bottom₁, top₁⟩ ⟨bottom₂, top₂⟩ ass - simp [TopDownChainSplitThrough_embedding] at ass - simp [ass] - · intro ⟨bottom, top⟩ - use (bottom, top) - simp [TopDownChainSplitThrough_embedding] - -def translate_edge {n m : ℕ} (list : List (Fin n)) (list_length : list.length = m) : Finset (Fin m) → Finset (Fin n) := fun e => (Finset.image (fun j : Fin m => (list.get ⟨j.val, by rw [list_length]; exact j.isLt⟩)) e) - -lemma translate_edge_injective (n m : ℕ) (list : List (Fin n)) (list_length : list.length = m) (nodups : list.Nodup): Injective (translate_edge list list_length) := by - intro e₁ e₂ he₁e₂ - ext x - constructor - · intro xine₁ - have x_in_filter₁ : list.get ⟨x, by simp [list_length]⟩ ∈ translate_edge list list_length e₂ := by - rw [←he₁e₂] - simp [translate_edge] - exact ⟨x, ⟨xine₁, rfl⟩⟩ - simp [translate_edge] at x_in_filter₁ - obtain ⟨j, ⟨jine₂, hj⟩⟩ := x_in_filter₁ - have get_injective : Function.Injective list.get := List.nodup_iff_injective_get.mp nodups - have := Fin.ext_iff.mp (get_injective hj) - simp at this - have := Fin.ext this - rw [this] at jine₂ - exact jine₂ - · intro xine₁ - have x_in_filter₂ : list.get ⟨x, by simp [list_length]⟩ ∈ translate_edge list list_length e₁ := by - rw [he₁e₂] - simp [translate_edge] - exact ⟨x, ⟨xine₁, rfl⟩⟩ - simp [translate_edge] at x_in_filter₂ - obtain ⟨j, ⟨jine₁, hj⟩⟩ := x_in_filter₂ - have get_injective : Function.Injective list.get := List.nodup_iff_injective_get.mp nodups - have := Fin.ext_iff.mp (get_injective hj) - simp at this - have := Fin.ext this - rw [this] at jine₁ - exact jine₁ - -def translate_bottom_chain {n m : ℕ} (X : Finset (Finset (Fin m))) (list : List (Fin n)) (list_length : list.length = m) : Finset (Finset (Fin n)) := Finset.image (translate_edge list list_length) X - -lemma chain_translate_chain {n m : ℕ} (X : Finset (Finset (Fin m))) (list : List (Fin n)) (list_length : list.length = m) (chain : IsChain (· ⊆ ·) X.toSet) - (e₁ : Finset (Fin n)) (e₁elt : ∃ x ∈ X, translate_edge list list_length x = e₁) (e₂ : Finset (Fin n)) (e₂elt : ∃ x ∈ X, translate_edge list list_length x = e₂) (e₁nee₂ : e₁ ≠ e₂) : e₁ ⊆ e₂ ∨ e₂ ⊆ e₁ := by - - obtain ⟨u₁, ⟨u₁elt, u₁image⟩⟩ := e₁elt - obtain ⟨u₂, ⟨u₂elt, u₂image⟩⟩ := e₂elt - - have u₁neu₂ : u₁ ≠ u₂ := by - intro ass - have := - calc - e₁ = translate_edge list list_length u₁ := u₁image.symm - _ = translate_edge list list_length u₂ := by rw [ass] - _ = e₂ := u₂image - exact e₁nee₂ this - - cases chain u₁elt u₂elt u₁neu₂ with - | inl u₁subu₂ => - left - intro x xine₁ - simp [←u₁image, translate_edge] at xine₁ - obtain ⟨j₁, ⟨j₁inu₁, hj₁⟩⟩ := xine₁ - have j₁inu₂ := u₁subu₂ j₁inu₁ - simp [←u₂image, translate_edge] - exact ⟨j₁, ⟨j₁inu₂, hj₁⟩⟩ - | inr u₂subu₁ => - right - intro x xine₂ - simp [←u₂image, translate_edge] at xine₂ - obtain ⟨j₂, ⟨j₂inu₂, hj₂⟩⟩ := xine₂ - have j₂inu₁ := u₂subu₁ j₂inu₂ - simp [←u₁image, translate_edge] - exact ⟨j₂, ⟨j₂inu₁, hj₂⟩⟩ - -noncomputable def split_to_TopDownChainThrough (n : ℕ) (a : Finset (Fin n)) : TopDownChainSplitThrough n a → TopDownChainThrough n a := by - intro C - - let top_elements := (Finset.univ : Finset (Fin n)) \ a - - have top_elements_card : top_elements.card = n - a.card := by - have h_univ : (Finset.univ : Finset (Fin n)).card = n := Finset.card_fin n - have : top_elements.card + a.card = Finset.univ.card := Finset.card_sdiff_add_card_eq_card (Finset.subset_univ a) - rw [h_univ] at this - exact (Nat.sub_eq_of_eq_add this.symm).symm - - have disjoint_helper (e : Finset (Fin (n - a.card))) : Disjoint ((translate_edge top_elements.toList (by simp [top_elements_card])) e) a := by - intro u usub usuba - simp [translate_edge] at usub - intro x xinu - have := usub xinu - simp at this - obtain ⟨j, ⟨_, hj⟩⟩ := this - - have : x ∈ top_elements.toList := by - rw [←hj] - apply List.getElem_mem - - have xintop : x ∈ top_elements := Finset.mem_toList.mp this - simp [top_elements] at xintop - exact False.elim (xintop (usuba xinu)) - - let bottom_chain_embedding := Finset.image (translate_edge a.toList (by simp)) C.bottom_chain.X - let top_translate_edge : Finset (Fin (n - a.card)) → Finset (Fin n) := fun e => Finset.disjUnion ((translate_edge top_elements.toList (by simp [top_elements_card])) e) a (disjoint_helper e) - let top_chain_embedding := Finset.image top_translate_edge (C.top_chain.X \ {∅}) - - have embeddings_disjoint : Disjoint bottom_chain_embedding top_chain_embedding := by - intro E Ebottom Etop - simp - intro e einE - - have einbottom := Ebottom einE - simp [bottom_chain_embedding] at einbottom - obtain ⟨_, ⟨_, hebottom⟩⟩ := einbottom - - have eintop := Etop einE - simp [top_chain_embedding] at eintop - obtain ⟨w, ⟨welt, hetop⟩⟩ := eintop - - have : 1 + a.card ≤ e.card := by - simp [top_translate_edge] at hetop - have : e = Finset.disjUnion ((translate_edge top_elements.toList (by simp [top_elements_card])) w) a (disjoint_helper w) := by simp [hetop] - rw [this, Finset.card_disjUnion] - simp - apply Finset.image_nonempty.mpr - exact Finset.nonempty_iff_ne_empty.mpr welt.right - - have : e.card ≤ a.card := by - simp [←hebottom] - apply Finset.card_mono - intro y yelt - simp [translate_edge] at yelt - obtain ⟨_, ⟨_, h⟩⟩ := yelt - apply Finset.mem_toList.mp - rw [←h] - apply List.getElem_mem - - linarith - - let top_down_chain : TopDownChain n := { - X := Finset.disjUnion bottom_chain_embedding top_chain_embedding embeddings_disjoint - chain := by - intro e₁ e₁elt e₂ e₂elt e₁nee₂ - cases Finset.mem_disjUnion.mp e₁elt with - | inl e₁inbottom => - simp [bottom_chain_embedding] at e₁inbottom - cases Finset.mem_disjUnion.mp e₂elt with - | inl e₂inbottom => - simp [bottom_chain_embedding] at e₂inbottom - exact chain_translate_chain C.bottom_chain.X a.toList (by simp) C.bottom_chain.chain e₁ e₁inbottom e₂ e₂inbottom e₁nee₂ - | inr e₂intop => - left - simp [top_chain_embedding] at e₂intop - obtain ⟨preimagee₂, ⟨_, h₃⟩⟩ := e₂intop - have : e₁ ⊆ a := by - obtain ⟨preimagee₁, ⟨_, he₁⟩⟩ := e₁inbottom - rw [←he₁] - intro x xelt - simp [translate_edge] at xelt - obtain ⟨j, ⟨_, hj⟩⟩ := xelt - rw [←hj] - apply Finset.mem_toList.mp - apply List.getElem_mem - rw [←h₃] - intro x xine₁ - simp [top_translate_edge] - right - exact this xine₁ - | inr e₁intop => - simp [top_chain_embedding] at e₁intop - cases Finset.mem_disjUnion.mp e₂elt with - | inr e₂intop => - simp [top_chain_embedding] at e₂intop - obtain ⟨preimagee₁, ⟨preimagee₁elt, _⟩, hpreimagee₁⟩ := e₁intop - obtain ⟨preimagee₂, ⟨preimagee₂elt, _⟩, hpreimagee₂⟩ := e₂intop - let u₁ := e₁ \ a - let u₂ := e₂ \ a - have u₁neu₂ : u₁ ≠ u₂ := by - intro ass - have : (e₁ \ a) ∪ a = (e₂ \ a) ∪ a := by - have hu₁ : e₁ \ a = u₁ := rfl - have hu₂ : e₂ \ a = u₂ := rfl - rw [hu₁, hu₂, ass] - have h₁ : e₁ \ a ∪ a = e₁ := by - rw [←hpreimagee₁] - simp [top_translate_edge] - have h₂ : e₂ \ a ∪ a = e₂ := by - rw [←hpreimagee₂] - simp [top_translate_edge] - rw [h₁, h₂] at this - exact e₁nee₂ this - - have hu₁ : u₁ = translate_edge top_elements.toList (by simp [top_elements_card]) preimagee₁ := by - let u := translate_edge top_elements.toList (by simp [top_elements_card]) preimagee₁ - have hu : u = translate_edge top_elements.toList (by simp [top_elements_card]) preimagee₁ := rfl - simp [u₁, ←hpreimagee₁, ←hu, top_translate_edge] - apply Finset.union_sdiff_cancel_right - - exact disjoint_helper preimagee₁ - - have hu₂ : u₂ = translate_edge top_elements.toList (by simp [top_elements_card]) preimagee₂ := by - let u := translate_edge top_elements.toList (by simp [top_elements_card]) preimagee₂ - have hu : u = translate_edge top_elements.toList (by simp [top_elements_card]) preimagee₂ := rfl - simp [u₂, ←hpreimagee₂, ←hu, top_translate_edge] - apply Finset.union_sdiff_cancel_right - - exact disjoint_helper preimagee₂ - - - have := chain_translate_chain C.top_chain.X top_elements.toList (by simp [top_elements_card]) C.top_chain.chain u₁ ⟨preimagee₁, ⟨preimagee₁elt, hu₁.symm⟩⟩ u₂ ⟨preimagee₂, ⟨preimagee₂elt, hu₂.symm⟩⟩ u₁neu₂ - simp [top_translate_edge, ←hu₁] at hpreimagee₁ - simp [top_translate_edge, ←hu₂] at hpreimagee₂ - - have disjoint₁ := disjoint_helper preimagee₁ - rw [←hu₁] at disjoint₁ - have u₁indisjoint : e₁ = Finset.disjUnion u₁ a disjoint₁ := by simp [hpreimagee₁] - - have disjoint₂ := disjoint_helper preimagee₂ - rw [←hu₂] at disjoint₂ - have u₂indisjoint : e₂ = Finset.disjUnion u₂ a disjoint₂ := by simp [hpreimagee₂] - - cases this with - | inl u₁inu₂ => - left - intro x xine₁ - - rw [u₁indisjoint] at xine₁ - rw [u₂indisjoint] - - cases Finset.mem_disjUnion.mp xine₁ with - | inl h => - apply Finset.mem_disjUnion.mpr - left - exact u₁inu₂ h - - | inr h => - apply Finset.mem_disjUnion.mpr - right - exact h - | inr u₂inu₁ => - right - intro x xine₂ - - rw [u₂indisjoint] at xine₂ - rw [u₁indisjoint] - - cases Finset.mem_disjUnion.mp xine₂ with - | inl h => - apply Finset.mem_disjUnion.mpr - left - exact u₂inu₁ h - - | inr h => - apply Finset.mem_disjUnion.mpr - right - exact h - - | inl e₂inbottom => - right - simp [bottom_chain_embedding] at e₂inbottom - obtain ⟨preimagee₁, ⟨_, h₃⟩⟩ := e₁intop - - have : e₂ ⊆ a := by - obtain ⟨preimagee₂, ⟨_, he₂⟩⟩ := e₂inbottom - rw [←he₂] - intro x xelt - simp [translate_edge] at xelt - obtain ⟨j, ⟨_, hj⟩⟩ := xelt - rw [←hj] - apply Finset.mem_toList.mp - apply List.getElem_mem - - rw [←h₃] - intro x xine₂ - simp [top_translate_edge] - right - exact this xine₂ - - top_down := by - have : Fintype.card { x // x ∈ bottom_chain_embedding.disjUnion top_chain_embedding embeddings_disjoint } - = Finset.card (bottom_chain_embedding.disjUnion top_chain_embedding embeddings_disjoint) := Fintype.card_ofFinset _ (fun x => Iff.rfl) - rw [this, Finset.card_disjUnion] - simp [bottom_chain_embedding, top_chain_embedding] - rw [Finset.card_image_of_injective C.bottom_chain.X (translate_edge_injective n a.card a.toList (by simp) a.nodup_toList)] - have top_translate_edge_injective : Injective top_translate_edge := by - intro e₁ e₂ he₁e₂ - simp only [top_translate_edge] at he₁e₂ - - let specific_translate_edge : Finset (Fin (n - a.card)) → Finset (Fin n) := translate_edge top_elements.toList (by simp [top_elements_card]) - have h : (specific_translate_edge : Finset (Fin (n - a.card)) → Finset (Fin n)) = translate_edge top_elements.toList (by simp [top_elements_card]) := rfl - - simp [←h] at he₁e₂ - - have : specific_translate_edge e₁ = specific_translate_edge e₂ := by - ext z - constructor - · intro zelt - have : z ∈ (specific_translate_edge e₁) ∪ a := by simp [zelt] - simp [he₁e₂] at this - cases this with - | inl zin => exact zin - | inr zina => - have := disjoint_helper e₁ - rw [←h] at this - have := (Finset.disjoint_iff_ne.mp this) z zelt z zina - simp at this - · intro zelt - have : z ∈ (specific_translate_edge e₂) ∪ a := by simp [zelt] - simp [←he₁e₂] at this - cases this with - | inl zin => exact zin - | inr zina => - have := disjoint_helper e₂ - rw [←h] at this - have := (Finset.disjoint_iff_ne.mp this) z zelt z zina - simp at this - - have injectivity : Injective specific_translate_edge := (translate_edge_injective n (n - a.card) top_elements.toList (by simp [top_elements_card]) top_elements.nodup_toList) - - exact injectivity this - - - rw [Finset.card_image_of_injective (C.top_chain.X \ {∅}) top_translate_edge_injective] - have fst_term : Fintype.card C.bottom_chain.X = C.bottom_chain.X.card := Fintype.card_ofFinset _ (fun x => Iff.rfl) - have get_rid_of_empty : (C.top_chain.X \ {∅}).card = C.top_chain.X.card - 1 := by - apply Eq.symm - apply Nat.sub_eq_of_eq_add - apply Eq.symm - rw [←(Finset.card_singleton (∅ : Finset (Fin n)))] - apply Finset.card_sdiff_add_card_eq_card - simp - obtain ⟨⟨e, ecard⟩, _⟩ := (edge_by_cardinality C.top_chain ⟨0, by norm_num⟩).choose_spec - simp at ecard - simp [ecard] at e - exact e - have snd_term : Fintype.card C.top_chain.X = C.top_chain.X.card := Fintype.card_ofFinset _ (fun x => Iff.rfl) - rw [←fst_term, C.bottom_chain.top_down, get_rid_of_empty, ←snd_term, C.top_chain.top_down] - rw [Nat.add_sub_cancel, Nat.add_assoc, Nat.add_comm, Nat.add_assoc, Nat.sub_add_cancel, Nat.add_comm] - - · simp_rw [←(Finset.card_fin n)] - apply Finset.card_mono - simp - - } - - let result : TopDownChainThrough n a := { - top_down_chain := top_down_chain - through := by - simp [bottom_chain_embedding] - left - let preimage := (edge_by_cardinality C.bottom_chain a.card).choose - have : preimage ∈ C.bottom_chain.X ∧ preimage.card = a.card := by simp [(edge_by_cardinality C.bottom_chain a.card).choose_spec.left] - use preimage - constructor - · exact this.left - · apply Finset.eq_of_subset_of_card_le - · simp [translate_edge] - intro x xin - simp at xin - obtain ⟨j, ⟨_, hj⟩⟩ := xin - - apply Finset.mem_toList.mp - rw [←hj] - apply List.getElem_mem - · apply Nat.le_of_eq - - simp [translate_edge] - have injectivity_get : Injective (fun j : Fin a.card => (a.toList[j.val])) := by - intro a₁ a₂ ha₁a₂ - have := Fin.ext_iff.mp ((List.nodup_iff_injective_get.mp a.nodup_toList) ha₁a₂) - exact Fin.ext this - - simp_rw [Finset.card_image_of_injective (preimage) injectivity_get] - exact this.right.symm - } - - exact result - -theorem split_to_TopDownChainThrough_bijective (n : ℕ) (a : Finset (Fin n)) : Bijective (split_to_TopDownChainThrough n a) := by sorry - - -noncomputable instance (n : ℕ) (a : Finset (Fin n)) : Fintype (TopDownChainThrough n a) := { - elems := Finset.image (fun π => split_to_TopDownChainThrough n a π) (Finset.univ : Finset (TopDownChainSplitThrough n a)) - complete := by - intro C - simp - exact (split_to_TopDownChainThrough_bijective n a).right C -} - -/- - Lemmata about cardinalities --/ - -lemma cardinality_ChainThrough {n : ℕ} (a : Finset (Fin n)) : - (Finset.univ : Finset (TopDownChainThrough n a)).card = (Finset.univ : Finset (TopDownChainSplitThrough n a)).card := by - apply Eq.symm - apply Finset.card_eq_of_equiv - have := Equiv.ofBijective (split_to_TopDownChainThrough n a) (split_to_TopDownChainThrough_bijective n a) - have tdc_through_equiv := Equiv.Set.univ (TopDownChainThrough n a) - have tdc_split_equiv := Equiv.Set.univ (TopDownChainSplitThrough n a) - simp - - exact (tdc_split_equiv.trans this).trans tdc_through_equiv.symm - -lemma cardinality_TopDownChain (n : ℕ) : (Finset.univ : Finset (TopDownChain n)).card = (n)! := by - calc - (Finset.univ : Finset (TopDownChain n)).card = (Finset.univ : Finset (Equiv.Perm (Fin n))).card := by - apply Finset.card_bijective (top_down_chain_to_permutation n) (top_down_chain_to_permutation_bijective n) (fun i => ⟨fun _ => by simp, fun _ => by simp⟩) - _ = Fintype.card (Equiv.Perm (Fin n)) := by simp - _ = (Fintype.card (Fin n))! := Fintype.card_perm - _ = (n)! := by rw [Fintype.card_fin n] - -lemma cardinality_ChainSplitThrough {n : ℕ} (a : Finset (Fin n)) : - (Finset.univ : Finset (TopDownChainSplitThrough n a)).card = (a.card)! * (n - a.card)! := by - have hst : ∀ i, i ∈ (Finset.univ : Finset ((TopDownChain a.card) × (TopDownChain (n - a.card)))) ↔ (TopDownChainSplitThrough_embedding n a) i ∈ (Finset.univ : Finset (TopDownChainSplitThrough n a)) := by - intro i - constructor <;> simp - rw [←Finset.card_bijective (TopDownChainSplitThrough_embedding n a) (TopDownChainSplitThrough_embedding_bijective n a) hst] - rw [Finset.card_univ] - rw [Fintype.card_prod] - have fst_eq : Fintype.card (TopDownChain a.card) = a.card ! := by rw [←(cardinality_TopDownChain a.card)]; simp - have snd_eq: Fintype.card (TopDownChain (n - a.card)) = (n - a.card)! := by rw [←(cardinality_TopDownChain (n - a.card))]; simp - rw [fst_eq, snd_eq] - -/- - **Sperners Theorem** --/ - -theorem Sperner {n : ℕ} {A : Finset (Finset (Fin n))} : - (∀ e₁ ∈ A, ∀ e₂ ∈ A, e₁ ≠ e₂ → ¬(e₁ ⊆ e₂)) → A.card ≤ n.choose (n / 2) := by - intro h_antichain - - let M : Fin (n + 1) → Finset (Finset (Fin n)) := fun k => { e | e ∈ A ∧ Finset.card e = k } - let m : Fin (n + 1) → ℕ := fun k => Finset.card (M k) - - have pairwisedisjointM : (Set.univ : Set (Fin (n + 1))).PairwiseDisjoint M := by - intro i hi j hj inegj - intro a hai haj b bina - simp [M] at * - have bcardi : b.card = i := by - have := hai bina - simp at this - exact this.2 - have bcardj : b.card = j := by - have := haj bina - simp at this - exact this.2 - have : i.val = j.val := by rw [←bcardi, ←bcardj] - exact inegj (Fin.ext this) - - have disjointcardinalityunion : A = (Finset.univ : Finset (Fin (n + 1))).disjiUnion M (by simp [pairwisedisjointM]) := by - ext e - constructor - · intro he - apply Finset.mem_disjiUnion.mpr - use ⟨Finset.card e, Nat.lt_succ.mpr (edge_cardinality_upperbound e)⟩ - simp [M, he] - · intro he - simp [Finset.biUnion, M] at he - exact he.1 - - have cardassum : A.card = ∑ (k : Fin (n + 1)), m k := by - rw [disjointcardinalityunion, Finset.card_disjiUnion (Finset.univ : Finset (Fin (n + 1))) M (by simp [pairwisedisjointM])] - - have disjoint_top_down_chains: ∀ e₁ ∈ A, ∀ e₂ ∈ A, e₁ ≠ e₂ → ∀ C₁ : TopDownChainThrough n e₁, ∀ C₂ : TopDownChainThrough n e₂, C₁.top_down_chain.X ≠ C₂.top_down_chain.X := by - intro e₁ he₁ e₂ he₂ e₁nege₂ C₁ C₂ - by_contra ass - have e₁inC₂ : e₁ ∈ C₂.top_down_chain.X := by - rw [←ass] - exact C₁.through - cases (C₂.top_down_chain.chain e₁inC₂ C₂.through e₁nege₂ : e₁ ⊆ e₂ ∨ e₂ ⊆ e₁) with - | inl e₁ine₂ => exact h_antichain e₁ he₁ e₂ he₂ e₁nege₂ e₁ine₂ - | inr e₂ine₁ => exact h_antichain e₂ he₂ e₁ he₁ (by by_contra q; exact e₁nege₂ (Eq.symm q)) e₂ine₁ - - let f_embedded_chains (e : Finset (Fin n)) : (TopDownChainThrough n e) → (TopDownChain n) := fun C => C.top_down_chain - - let embedded_chains : Finset (Fin n) → Finset (TopDownChain n) := fun e => ((Finset.univ : Finset (TopDownChainThrough n e)).image (f_embedded_chains e)) - - have embedded_chains_cardinality (e : Finset (Fin n)) : (embedded_chains e).card = (Finset.univ : Finset (TopDownChainThrough n e)).card := by - simp [embedded_chains] - apply Finset.card_image_of_injective - · intro e₁ e₂ he₁e₂ - simp [f_embedded_chains] at he₁e₂ - cases e₁ - cases e₂ - simp at he₁e₂ - simp [he₁e₂] - - have hf : Set.PairwiseDisjoint A embedded_chains := by - intros e₁ e₁elt e₂ e₂elt e₁nee₂ - intros u usub₁ usub₂ - intro x xinu - have xelt₁ := usub₁ xinu - simp [embedded_chains] at xelt₁ - have xelt₂ := usub₂ xinu - simp [embedded_chains] at xelt₂ - obtain ⟨C₁, hC₁⟩ := xelt₁ - obtain ⟨C₂, hC₂⟩ := xelt₂ - - simp [f_embedded_chains] at hC₁ - simp [f_embedded_chains] at hC₂ - - have := disjoint_top_down_chains e₁ e₁elt e₂ e₂elt e₁nee₂ C₁ C₂ - rw [←hC₂] at hC₁ - have h : C₁.top_down_chain.X = C₂.top_down_chain.X := by rw [hC₁] - exact False.elim (this h) - - let chains_through_A := A.disjiUnion embedded_chains hf - - have central_inequality : ∑ k : Fin (n + 1), (m k) * (k)! * (n - k)! ≤ (n)! := by - calc - ∑ k : Fin (n + 1), (m k) * (k)! * (n - k)! = ∑ k : Fin (n + 1), ∑ e ∈ (M k), (e.card)! * (n - e.card)! := by - apply Finset.sum_congr - simp - intro k _ - have hq : ∀ e ∈ M k, (e.card)! * (n - e.card)! = (k)! * (n - k)! := by - intro e he - simp [M] at he - rw [he.2] - rw [Finset.sum_congr rfl (fun x q => hq x q)] - simp [m] - ring - _ = ∑ e ∈ A, (e.card)! * (n - e.card)! := by - rw [disjointcardinalityunion] - exact (Finset.univ.sum_disjiUnion M (by simp [pairwisedisjointM])).symm - _ = ∑ e ∈ A, (Finset.univ : Finset (TopDownChainSplitThrough n e)).card := by - apply Finset.sum_congr - simp - intro e _ - exact Eq.symm (cardinality_ChainSplitThrough e) - _ = ∑ e ∈ A, (embedded_chains e).card := by - apply Finset.sum_congr - simp - intro e _ - rw [embedded_chains_cardinality, cardinality_ChainThrough e] - _ = chains_through_A.card := (Finset.card_disjiUnion A embedded_chains hf).symm - _ ≤ (Finset.univ : Finset (TopDownChain n)).card := by - have : chains_through_A ⊆ (Finset.univ : Finset (TopDownChain n)) := by simp - exact Finset.card_mono this - _ = (n)! := cardinality_TopDownChain n - - have div_helper (a b c : ℚ) : 1 / (a / (b * c)) = b * c * (1 / a) := by rw [←div_eq_mul_one_div (b * c) a]; simp - - have : A.card / (n.choose (n / 2) : ℚ) ≤ 1 := by - calc - A.card / ↑(n.choose (n / 2)) = (∑ (k : Fin (n + 1)), ↑(m k)) * (1 / (n.choose (n / 2) : ℚ)) := by rw [div_eq_mul_one_div, cardassum]; norm_num - _ = ∑ (k : Fin (n + 1)), ↑(m k) * (1 / ↑(n.choose (n / 2))) := by rw [Finset.sum_mul] - _ ≤ ∑ (k : Fin (n + 1)), ↑(m k) * (1 / ↑(n.choose k)) := by - apply Finset.sum_le_sum - intros k _ - rw [←div_eq_mul_one_div, ←div_eq_mul_one_div, div_le_div_iff] - norm_cast - apply mul_le_mul_left (m k) - exact Nat.choose_le_middle k n - · norm_num - exact Nat.choose_pos (Nat.div_le_self n 2) - · norm_num - exact Nat.choose_pos (Nat.le_of_lt_succ k.isLt) - _ = ∑ (k : Fin (n + 1)), (m k) * (k)! * (n - k)! * (1 / (n)! : ℚ) := by - apply Finset.sum_congr - rfl - intro x _ - rw [Nat.choose_eq_factorial_div_factorial, mul_assoc, mul_assoc] - congr - rw [←mul_assoc, ←(div_helper (n)! (↑x)! (n - ↑x)!)] - congr - have xlen : ↑x ≤ n := Nat.le_of_lt_succ x.isLt - - have choose_divisibility (a b : ℕ) (h : a ≤ b) : ((a)! * (b - a)!) ∣ (b)! := by - use b.choose a - rw [Nat.mul_comm, ←Nat.mul_assoc] - exact (Nat.choose_mul_factorial_mul_factorial h).symm - - rw [Nat.cast_div (choose_divisibility ↑x n xlen), Nat.cast_mul] - · norm_num - constructor <;> apply Nat.factorial_ne_zero - · exact Nat.le_of_lt_succ x.isLt - _ = (∑ (k : Fin (n + 1)), (m k) * (k)! * (n - k)!) * (1 / (n)! : ℚ) := by rw [←Finset.sum_mul]; norm_num - _ ≤ (n)! * (1 / (n)! : ℚ) := by - apply mul_le_mul - exact cast_le.mpr central_inequality - simp - simp - simp - _ ≤ 1 := by field_simp - - have choose_pos : (0 : ℚ) < (n.choose (n / 2) : ℚ) := by - apply cast_lt.mpr - apply Nat.choose_pos - apply Nat.div_le_self - - exact cast_le.mp ((div_le_one choose_pos).mp this) - -end chapter30 From 95149f47ebd7ef39fbf8a62b8f204884a18a0642 Mon Sep 17 00:00:00 2001 From: Jakob Zimmermann Date: Sat, 25 Jan 2025 00:02:01 +0100 Subject: [PATCH 21/26] split the code into several files. Add two files to the ToMatlib folder --- TheBook/Combinatorics/LYM.lean | 80 ++++ ...lean => SpernerHelpingDataStructures.lean} | 389 +----------------- TheBook/ToMathlib/Chain.lean | 161 ++++++++ TheBook/ToMathlib/Chain_optional.lean | 66 +++ TheBook/ToMathlib/List.lean | 49 +++ 5 files changed, 369 insertions(+), 376 deletions(-) create mode 100644 TheBook/Combinatorics/LYM.lean rename TheBook/Combinatorics/{Sperner.lean => SpernerHelpingDataStructures.lean} (68%) create mode 100644 TheBook/ToMathlib/Chain.lean create mode 100644 TheBook/ToMathlib/Chain_optional.lean create mode 100644 TheBook/ToMathlib/List.lean diff --git a/TheBook/Combinatorics/LYM.lean b/TheBook/Combinatorics/LYM.lean new file mode 100644 index 0000000..0f2d007 --- /dev/null +++ b/TheBook/Combinatorics/LYM.lean @@ -0,0 +1,80 @@ +import Mathlib.Tactic +import Mathlib.Combinatorics.Enumerative.DoubleCounting +import Mathlib.Combinatorics.Derangements.Finite +import Mathlib.Logic.Equiv.Defs +import Mathlib.Data.Set.Basic +import Mathlib.Data.Finset.Slice +import Mathlib.Order.Antichain +import Mathlib.Order.Chain +import Mathlib.Data.List.Perm.Basic +import TheBook.ToMathlib.Chain_optional +import TheBook.ToMathlib.Chain +import TheBook.ToMathlib.List +import TheBook.Combinatorics.SpernerHelpingDataStructures + +open Function Finset Nat Set BigOperators List + +variable {α : Type*} {n m : ℕ} {𝒜 : Finset (Finset α)} [Fintype α] [DecidableEq α] [DecidableEq (Finset α)] + +namespace Finset + +/-- The **Lubell-Yamamoto-Meshalkin inequality**. Sperner's Theorem follows as in Mathlib.Combinatorics.SetFamily.LYM as a corollary -/ +theorem lym_inequality (antichain𝒜 : IsAntichain (· ⊂ ·) 𝒜) (hn : Fintype.card α = n): + ∑ k ∈ Iic n, #(𝒜 # k) / (n.choose k : ℚ) ≤ (1 : ℚ) := by + have : ∑ k ∈ Iic n, #(𝒜 # k) / (n.choose k : ℚ) ≤ (∑ k ∈ Iic n, #(𝒜 # k) * (k)! * (n - k)!) * (1 / (n)! : ℚ) := by + calc + ∑ k ∈ Iic n, #(𝒜 # k) / (n.choose k : ℚ) = ∑ k ∈ Iic n, #(𝒜 # k) * (k)! * (n - k)! * (1 / (n)! : ℚ) := by + apply Finset.sum_congr (by simp) + intro j jmem + simp at jmem + rw [div_eq_mul_inv, mul_assoc, mul_assoc, Nat.choose_eq_factorial_div_factorial] + congr + field_simp + + have choose_divisibility (a b : ℕ) (h : a ≤ b) : ((a)! * (b - a)!) ∣ (b)! := by + use b.choose a + rw [Nat.mul_comm, ←Nat.mul_assoc] + exact (Nat.choose_mul_factorial_mul_factorial h).symm + + rw [Nat.cast_div (choose_divisibility j n jmem), Nat.cast_mul] + · field_simp + · norm_num + constructor <;> apply Nat.factorial_ne_zero + · exact jmem + _ = (∑ k ∈ Iic n, #(𝒜 # k) * (k)! * (n - k)!) * (1 / (n)! : ℚ) := by simp [←Finset.sum_mul] + rfl + + refine' le_trans this _ + rw [mul_one_div] + apply (div_le_one (by simp [Nat.factorial_pos n])).mpr + + norm_cast + + have slice_partition : Finset.disjiUnion (Iic n) 𝒜.slice (Finset.pairwiseDisjoint_slice.subset (Set.subset_univ _)) = 𝒜 := by + rw [Finset.disjiUnion_eq_biUnion (Iic n) 𝒜.slice (Finset.pairwiseDisjoint_slice.subset (Set.subset_univ _))] + rw [←hn] + --simp (biUnion_slice 𝒜) + sorry + + calc + ∑ k ∈ Iic n, #(𝒜 # k) * (k)! * (n - k)! = ∑ k ∈ Iic n, ∑ e ∈ (𝒜 # k), (#e)! * (n - #e)! := by + apply Finset.sum_congr (by simp) + intro k _ + have hq : ∀ e ∈ (𝒜 # k), (#e)! * (n - #e)! = (k)! * (n - k)! := by + intro e he + simp [slice] at he + rw [he.2] + rw [Finset.sum_congr rfl hq, Finset.sum_const] + ring + _ = ∑ e ∈ 𝒜, (#e)! * (n - #e)! := by + conv => + rhs + rw [←slice_partition] + apply Eq.symm + apply sum_disjiUnion + _ = ∑ e ∈ 𝒜, Fintype.card (MaxChainThrough {e}) := by + apply Finset.sum_congr (by simp) + intro e _ + apply Eq.symm + exact count_maxChains_through_singleton e hn + _ ≤ (n)! := by sorry diff --git a/TheBook/Combinatorics/Sperner.lean b/TheBook/Combinatorics/SpernerHelpingDataStructures.lean similarity index 68% rename from TheBook/Combinatorics/Sperner.lean rename to TheBook/Combinatorics/SpernerHelpingDataStructures.lean index c95c363..ed89135 100644 --- a/TheBook/Combinatorics/Sperner.lean +++ b/TheBook/Combinatorics/SpernerHelpingDataStructures.lean @@ -1,105 +1,10 @@ -/- -Copyright 2022 Google LLC - -Licensed under the Apache License, Version 2.0 (the "License"); -you may not use this file except in compliance with the License. -You may obtain a copy of the License at - - https://www.apache.org/licenses/LICENSE-2.0 - -Unless required by applicable law or agreed to in writing, software -distributed under the License is distributed on an "AS IS" BASIS, -WITHOUT WARRANTIES OR CONDITIONS OF ANY KIND, either express or implied. -See the License for the specific language governing permissions and -limitations under the License. - -Authors: Moritz Firsching, Jakob Zimmermann --/ -import Mathlib.Tactic -import Mathlib.Combinatorics.Enumerative.DoubleCounting -import Mathlib.Combinatorics.Derangements.Finite -import Mathlib.Logic.Equiv.Defs -import Mathlib.Data.Set.Basic -import Mathlib.Data.Finset.Slice -import Mathlib.Order.Antichain -import Mathlib.Order.Chain -import Mathlib.Data.List.Perm.Basic - -/-! -# Proof of the LYM inequality and some observations on chains wrt the subset order --/ +import TheBook.ToMathlib.Chain_optional +import TheBook.ToMathlib.Chain +import TheBook.ToMathlib.List open Function Finset Nat Set BigOperators List -variable {α : Type*} {n m : ℕ} {𝒜 : Finset (Finset α)} - -namespace Finset - -/- -## Proposals for new definitions of chains in Finset namespace --/ - -variable {β : Type*} (r : β → β → Prop) - -/-- In this file, we use `≺` as a local notation for any relation `r`. -/ -local infixl:50 " ≺ " => r - -/- - The following definitions match the ones in Mathlib.Order.Chain, but use Finset in order to be able to carry information on finiteness inside the chain property. --/ - -def IsChain (s : Finset β) : Prop := - s.toSet.Pairwise fun x y => x ≺ y ∨ y ≺ x - -/-- `SuperChain s t` means that `t` is a chain that strictly includes `s`. -/ -def SuperChain (s t : Finset β) : Prop := - IsChain r t ∧ s ⊂ t - -/-- A chain `s` is a maximal chain if there does not exists a chain strictly including `s`. -/ -def IsMaxChain (s : Finset β) : Prop := - IsChain r s ∧ ∀ ⦃t⦄, IsChain r t → s ⊆ t → s = t - -def IsAntichain (r : α → α → Prop) (s : Finset α) : Prop := - s.toSet.Pairwise rᶜ - -end Finset - -variable (ℬ₀ : Set β) (ℬ₁ : Finset β) (r : β → β → Prop) - -/- The usual definition of chains are compatible if used along the toSet method-/ -example (h : Finset.IsChain r ℬ₁) : IsChain r ℬ₁.toSet := h -example (h : IsChain r ℬ₁.toSet) : Finset.IsChain r ℬ₁ := h - - -instance [Fintype ℬ₀] : Coe (IsChain r ℬ₀) (Finset.IsChain r ℬ₀.toFinset) := - ⟨fun h ↦ (fun _ hx _ hy xneqy ↦ h (Set.mem_toFinset.mp hx) (Set.mem_toFinset.mp hy) xneqy)⟩ - -example [Fintype ℬ₀] (h : IsChain r ℬ₀) : Finset.IsChain r ℬ₀.toFinset := h - -variable {γ : Type*} - -instance [Fintype β] : Fintype (Finset β) := { - elems := Finset.powerset (@Finset.univ β _), - complete := by simp -} - -noncomputable instance [Fintype β] : Fintype ℬ₀ := Fintype.ofFinite ↑ℬ₀ - -noncomputable instance [Fintype β] : Coe (Set β) (Finset β) := ⟨fun s ↦ s.toFinset⟩ - -noncomputable example [Fintype β] (𝒟 : Set β) : Finset β := 𝒟 - -instance [Fintype β] : Coe (_root_.IsChain r ℬ₀) (Finset.IsChain r ℬ₀.toFinset) := - ⟨fun h ↦ (fun _ hx _ hy xneqy ↦ h (Set.mem_toFinset.mp hx) (Set.mem_toFinset.mp hy) xneqy)⟩ - -instance [Fintype β] : Fintype (Set β) := { - elems := (Finset.powerset (@Finset.univ β _)).map ⟨Finset.toSet, Finset.coe_injective⟩, - complete := by intro x; simp; use x.toFinset; simp -} - -variable (β : Type*) [Fintype β] (𝒞₀ : Set β) (𝒞₁ : Finset β) (r₁ : β → β → Prop) [Fintype 𝒞₀] - -example (h : _root_.IsChain r₁ 𝒞₀) : Finset.IsChain r₁ 𝒞₀.toFinset := h +variable {α : Type*} {n m : ℕ} {𝒜 : Finset (Finset α)} (𝒞₀ : Set α) (𝒞₁ : Finset α) [Fintype 𝒞₀] namespace Finset @@ -123,209 +28,6 @@ lemma inj_emb_MaxChainThrough {ℬ : Finset (Finset α)} : Injective (emb_MaxCha instance instFintypeMaxChainThrough {ℬ : Finset (Finset α)} : Fintype (MaxChainThrough ℬ) := by sorry -lemma IsChain.equivalence_subset_relations : (IsChain (· ⊆ .) 𝒜) ↔ (IsChain (· ⊂ .) 𝒜) := by - constructor - · intro h e₁ e₁mem e₂ e₂mem e₁neqe₂ - cases h e₁mem e₂mem e₁neqe₂ with - | inl e₁sube₂ => left; exact Finset.ssubset_iff_subset_ne.mpr ⟨e₁sube₂, e₁neqe₂⟩ - | inr e₂sube₁ => right; exact Finset.ssubset_iff_subset_ne.mpr ⟨e₂sube₁, e₁neqe₂.symm⟩ - · intro h e₁ e₁mem e₂ e₂mem e₁neqe₂ - cases h e₁mem e₂mem e₁neqe₂ with - | inl e₁sube₂ => left; exact e₁sube₂.left - | inr e₂sube₁ => right; exact e₂sube₁.left - -lemma IsMaxChain.equivalence_subset_relations : (IsMaxChain (· ⊆ .) 𝒜) ↔ (IsMaxChain (· ⊂ .) 𝒜) := by - constructor - · intro h - exact ⟨IsChain.equivalence_subset_relations.mp h.left, fun t chain => h.right (IsChain.equivalence_subset_relations.mpr chain)⟩ - · intro h - exact ⟨IsChain.equivalence_subset_relations.mpr h.left, fun t chain => h.right (IsChain.equivalence_subset_relations.mp chain)⟩ - -lemma SuperChain.equivalence_subset_relations {ℬ : Finset (Finset α)} : (SuperChain (· ⊆ .) ℬ 𝒜) ↔ (SuperChain (· ⊂ .) ℬ 𝒜) := by - constructor - · intro h - exact ⟨IsChain.equivalence_subset_relations.mp h.left, h.right⟩ - · intro h - exact ⟨IsChain.equivalence_subset_relations.mpr h.left, h.right⟩ - -/-- In a chain with respect to the subset order there can not be two sets of same cardinality -/ -lemma IsChain.unique_of_cardinality_chain (chain𝒜 : IsChain (· ⊂ ·) 𝒜) {a b : Finset α} - (amem : a ∈ 𝒜) (bmem : b ∈ 𝒜) (hcard : #a = #b) : a = b := by - by_contra aneb - cases chain𝒜 amem bmem aneb with - | inl h => - have := Finset.card_strictMono h - linarith - | inr h => - have := Finset.card_strictMono h - linarith - -/-- In a chain with respect to the subset order there can be at most one set of a given cardinality -/ -lemma IsChain.max_one_elt_chain_layer (chain𝒜 : IsChain (· ⊂ ·) 𝒜) (j : ℕ) : #(𝒜 # j) ≤ 1 := by - by_contra! ass - have : (𝒜 # j) ≠ (∅ : Finset (Finset α)) := by - intro assempty - have := Finset.card_eq_zero.mpr assempty - linarith - obtain ⟨a, amem⟩ := Finset.nonempty_iff_ne_empty.mpr this - obtain ⟨b, ⟨bmem, aneb⟩⟩ := Finset.exists_mem_ne ass a - have cardeqab : #a = #b := by rw [(Finset.mem_slice.mp amem).right, (Finset.mem_slice.mp bmem).right] - exact aneb (IsChain.unique_of_cardinality_chain chain𝒜 (Finset.slice_subset bmem) (Finset.slice_subset amem) cardeqab.symm) - -instance IsChain.sub_is_trans : IsTrans 𝒜 (fun (e₁ e₂ : 𝒜) ↦ e₁.val ⊆ e₂.val) := - ⟨fun _ _ _ h₁ h₂ => subset_trans h₁ h₂⟩ - -instance card_le : LE (Finset α) where - le x y := #x ≤ #y - -instance card_lt : LT (Finset α) where - lt x y := #x < #y - -instance card_preorder : Preorder (Finset α) := { - le := (· ≤ ·), - lt := (· < ·), - le_refl := fun x => Nat.le_refl #x, - le_trans := fun _ _ _ hxy hyz => Nat.le_trans hxy hyz, - lt_iff_le_not_le := fun _ _ => Nat.lt_iff_le_not_le -} - -instance card_le_is_total : IsTotal 𝒜 (fun (e₁ e₂ : 𝒜) ↦ e₁.val ≤ e₂.val) := - ⟨fun a b ↦ Nat.le_total #a.val #b.val⟩ - -instance card_le_is_trans : IsTrans 𝒜 (fun (e₁ e₂ : 𝒜) ↦ e₁.val ≤ e₂.val) := - ⟨fun _ _ _ h₁ h₂ ↦ Nat.le_trans h₁ h₂⟩ - -instance IsChain.card_le_is_trans : IsTrans 𝒜 (fun (e₁ e₂ : 𝒜) ↦ e₁.val ⊆ e₂.val) := - ⟨fun _ _ _ h₁ h₂ => subset_trans h₁ h₂⟩ - -#check List.Nodup.insert - -theorem List.Nodup.orderedInsert [LE α] [DecidableRel (fun (x₁ x₂ : α) ↦ x₁ ≤ x₂)] - {l : List α} {a : α} (l_nodup : l.Nodup) (a_not_mem : a ∉ l) : - (orderedInsert (· ≤ ·) a l).Nodup := by - induction l with - | nil => - simp [orderedInsert] - | cons x xs ih => - simp [orderedInsert] - simp at a_not_mem - simp at l_nodup - split - · simp [List.Nodup] - constructor - · constructor - · exact a_not_mem.left - · intro u hu - by_contra ass - rw [←ass] at hu - exact a_not_mem.right hu - · constructor - · intro u hu - by_contra ass - rw [←ass] at hu - exact l_nodup.left hu - · exact l_nodup.right - · simp - constructor - · constructor - · exact fun x ↦ a_not_mem.left x.symm - · exact l_nodup.left - · exact ih l_nodup.right a_not_mem.right - -theorem List.Nodup.insertionSort [LE α] [DecidableRel (fun (x₁ x₂ : α) ↦ x₁ ≤ x₂)] {l : List α} (h : l.Nodup) : (l.insertionSort (fun (x₁ x₂ : α) ↦ x₁ ≤ x₂)).Nodup := by - induction l with - | nil => - simp [List.insertionSort, List.Nodup] - | cons x xs ih => - simp [List.insertionSort] - have sorted_nodup : (xs.insertionSort (fun x₁ x₂ => x₁ ≤ x₂)).Nodup := ih h.tail - have x_ne_mem_sorted : x ∉ xs.insertionSort (fun x₁ x₂ => x₁ ≤ x₂) := by - by_contra ass - simp at h - exact h.left ((List.mem_insertionSort (· ≤ ·)).mp ass) - exact List.Nodup.orderedInsert sorted_nodup x_ne_mem_sorted - -#check List.attach - -lemma card_strict_mono' (chain𝒜 : IsChain (· ⊂ ·) 𝒜) : ((Finset.univ : Finset 𝒜).toList.insertionSort (fun (e₁ e₂ : 𝒜) ↦ #e₁.val ≤ #e₂.val)).Sorted (fun (e₁ e₂ : 𝒜) ↦ #e₁.val < #e₂.val) := by - apply List.pairwise_iff_get.mpr - intro x y xlty - let elt_x := ((List.insertionSort (fun (e₁ e₂ : 𝒜) => #e₁.val ≤ #e₂.val) univ.toList).get x) - let elt_y := ((List.insertionSort (fun (e₁ e₂ : 𝒜) => #e₁.val ≤ #e₂.val) univ.toList).get y) - have card_le : elt_x.val ≤ elt_y.val := List.pairwise_iff_get.mp (List.sorted_insertionSort (fun (e₁ e₂ : 𝒜) ↦ #e₁.val ≤ #e₂.val) (Finset.univ : Finset 𝒜).toList) x y xlty - by_contra! ass - have card_eq := Nat.le_antisymm card_le ass - - have elt_x_eq_elt_y := Subtype.eq (IsChain.unique_of_cardinality_chain chain𝒜 elt_x.prop elt_y.prop card_eq) - have elt_x_neq_elt_y : elt_x ≠ elt_y := List.pairwise_iff_get.mp (List.Nodup.insertionSort ((Finset.univ : Finset 𝒜).nodup_toList)) x y xlty - - exact elt_x_neq_elt_y elt_x_eq_elt_y - -def IsChain.card_strict_mono (chain𝒜 : IsChain (· ⊂ ·) 𝒜) : ∃ l : List (Finset α), l ~ 𝒜.toList ∧ l.Sorted (#· < #·) := by - let l' := ((Finset.univ : Finset 𝒜).toList.insertionSort (fun (e₁ e₂ : 𝒜) ↦ #e₁.val ≤ #e₂.val)) - have l'_sorted : l'.Sorted (fun (e₁ e₂ : 𝒜) ↦ #e₁.val < #e₂.val) := card_strict_mono' chain𝒜 - - let l := l'.map Subtype.val - use l - constructor - · calc - l ~ (Finset.univ : Finset 𝒜).toList.map Subtype.val := Perm.map Subtype.val (perm_insertionSort (fun e₁ e₂ => #e₁.val ≤ #e₂.val) (Finset.univ : Finset 𝒜).toList) - _ ~ 𝒜.toList := by - sorry - · unfold l Sorted - apply List.pairwise_iff_get.mpr - intro i j iltj - simp [List.getElem_map, List.unattach, -List.map_subtype] - - have : (l'.map Subtype.val).length = l'.length := length_map l' Subtype.val - - have iltj_coe : (Fin.cast this i) < (Fin.cast this j) := by - apply Fin.lt_def.mpr - simp - exact iltj - - have := List.pairwise_iff_get.mp l'_sorted (Fin.cast this i) (Fin.cast this j) iltj_coe - exact this - -/-- If a chain intersects a layer of the boolean lattice this intersection is a singleton -/ -lemma layer_singleton_of_nonempty (chain𝒜 : IsChain (· ⊂ ·) 𝒜) (j : Finset.range (n + 1)) (layer_nonempty : (𝒜 # j) ≠ ∅): - ∃! e : Finset α, 𝒜 # j = {e} := by - have : # (𝒜 # j) = 1 := by - cases Nat.le_one_iff_eq_zero_or_eq_one.mp (IsChain.max_one_elt_chain_layer chain𝒜 j) with - | inl card_zero => - simp at card_zero - exact False.elim (layer_nonempty card_zero) - | inr card_one => exact card_one - obtain ⟨e, he⟩ := Finset.card_eq_one.mp this - have unique : ∀ a : Finset α, 𝒜 # j = {a} → a = e := by - intro a ha - rw [he] at ha - simp at ha - exact ha.symm - - exact ⟨e, he, unique⟩ - -lemma IsChain.ssubset_of_lt_cardinality (chain𝒜 : IsChain (· ⊂ ·) 𝒜) {e₁ e₂ : Finset α} (e₁mem : e₁ ∈ 𝒜) (e₂mem : e₂ ∈ 𝒜) - (hcard : #e₁ < #e₂) : e₁ ⊂ e₂ := by - have e₁nee₂ : e₁ ≠ e₂ := by - intro ass - have : #e₁ = #e₂ := by rw [ass] - linarith - cases chain𝒜 e₁mem e₂mem e₁nee₂ with - | inl h => exact Finset.ssubset_iff_subset_ne.mpr ⟨h.left, e₁nee₂⟩ - | inr h => - have : #e₂ < #e₁ := Finset.card_strictMono h - linarith - -lemma IsChain.subset_of_le_cardinality (chain𝒜 : IsChain (· ⊂ ·) 𝒜) {e₁ e₂ : Finset α} (e₁mem : e₁ ∈ 𝒜) (e₂mem : e₂ ∈ 𝒜) - (hcard : #e₁ ≤ #e₂) : e₁ ⊆ e₂ := by - cases Nat.eq_or_lt_of_le hcard with - | inr hcard_lt => - exact (IsChain.ssubset_of_lt_cardinality chain𝒜 e₁mem e₂mem hcard_lt).left - | inl hcard_eq => - exact Finset.subset_of_eq (IsChain.unique_of_cardinality_chain chain𝒜 e₁mem e₂mem hcard_eq) - - variable [Fintype α] [DecidableEq α] [DecidableEq (Finset (Finset α))] [DecidableEq (Finset α)] def chain_extension_filter_function (𝒜 : Finset (Finset α)) (e : Finset α) : α → Prop := @@ -338,6 +40,8 @@ instance instDecidablePredChainExtension (e : Finset α) : DecidablePred (chain_extension_filter_function 𝒜 e) := fun a : α => inferInstanceAs (Decidable (IsChain (· ⊂ ·) (insert (insert a e) 𝒜) ∧ insert a e ∉ 𝒜)) +def extension_candidates (ℬ : Finset (Finset α)) (e : Finset α) := Finset.filter (chain_extension_filter_function ℬ e) (Finset.univ : Finset α) + lemma IsChain.empty_layer_by_card (hn : Fintype.card α = n) (chain𝒜 : IsChain (· ⊂ ·) 𝒜) (card𝒜 : #𝒜 < n+1) : ∃ i : Fin (n + 1), #(𝒜 # i) = 0 := by by_contra! ass have : ∀ (i : Fin (n + 1)), #(𝒜 # i) = 1 := by @@ -365,9 +69,11 @@ lemma mem_card_of_slice {ℬ : Finset (Finset α)} (h : (ℬ # s) = {layer_s}) : simp [slice] at this exact this -lemma chain_extension (hn : Fintype.card α = n) {i j : Finset.range (n + 1)} (ilej_succ_succ : (i : ℕ) + 2 ≤ (j : ℕ)) (chain𝒜 : IsChain (· ⊂ ·) 𝒜) +lemma extension_candidates_characterisation (hn : Fintype.card α = n) {i j : Finset.range (n + 1)} (ilej_succ_succ : (i : ℕ) + 2 ≤ (j : ℕ)) (chain𝒜 : IsChain (· ⊂ ·) 𝒜) (hi : (𝒜 # i) = {layer_i}) (hj : (𝒜 # j) = {layer_j}) (emptylayer : ∀ l ∈ (Finset.range (n + 1)), i < l → l < j → #(𝒜 # l) = 0): - Finset.filter (chain_extension_filter_function 𝒜 layer_i) (Finset.univ : Finset α) = layer_j \ layer_i := by + extension_candidates 𝒜 layer_i = layer_j \ layer_i := by + unfold extension_candidates + have layer_j_mem_card := mem_card_of_slice hj have layer_i_mem_card := mem_card_of_slice hi @@ -614,7 +320,7 @@ lemma one_elt_max_chain_layer (hn : Fintype.card α = n) (maxchain𝒜 : IsMaxCh let extension_candidates := Finset.filter (chain_extension_filter_function 𝒜 e_bottom) (Finset.univ : Finset α) have extension_candidates_eq : extension_candidates = e_top \ e_bottom := by - refine' chain_extension hn _ maxchain𝒜.left bottom_singleton top_singleton emptylayer + refine' extension_candidates_characterisation hn _ maxchain𝒜.left bottom_singleton top_singleton emptylayer apply Nat.succ_le_of_lt have : (s_bottom : ℕ) + 1 ≤ ↑j := Nat.succ_le_of_lt h_s_bottom.left exact Nat.lt_of_le_of_lt this h_s_top.left @@ -776,9 +482,6 @@ lemma incident_indices_monotone_cards {n: ℕ} {s t : Fin (n + 1)} {ℬ : Finset simp only [i_s_eq_i_t_succ] at h_i_t exact ⟨h_i_s, h_i_t⟩ - -def extension_candidates (ℬ : Finset (Finset α)) (e : Finset α) := Finset.filter (chain_extension_filter_function ℬ e) (Finset.univ : Finset α) - def extensions_wrt (ℬ : Finset (Finset α)) (e : Finset α) (x : α) : Finset (Finset (Finset α)) := by let ℬ' : Finset (Finset α) := Insert.insert (Insert.insert x e) ℬ exact (Finset.univ : Finset ℬ'.MaxChainThrough).image (emb_MaxChainThrough ℬ') @@ -794,14 +497,10 @@ lemma chain_through_extension_candidates_pairwiseDisjoint (ℬ : Finset (Finset sorry - - -/-The set of maximal chains through ℬ is the disjoint union of maximal chains through the union of ℬ with some chain extension candidate-/ lemma central_identity {ℬ : Finset (Finset α)} (e : Finset α) (e_mem : e ∈ ℬ) : Finset.univ.image (emb_MaxChainThrough ℬ) = (extension_candidates ℬ e).disjiUnion (extensions_wrt ℬ e) (chain_through_extension_candidates_pairwiseDisjoint ℬ e e_mem) := by sorry - lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Fintype.card α = n) (ℬ : Finset (Finset α)) (cardℬ : #ℬ = m) (chainℬ : IsChain (· ⊂ ·) ℬ) (empty_in_chain : ∅ ∈ ℬ) (univ_in_chain : univ ∈ ℬ) (list : List (Finset α)) (list_per : ℬ.toList ~ list) (list_sorted : list.Sorted (#· < #·)): @@ -847,7 +546,7 @@ lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Finty let extension_candidates := Finset.filter (chain_extension_filter_function ℬ layer_s) (Finset.univ : Finset α) have extension_candidates_eq : extension_candidates = layer_t \ layer_s := by - refine' chain_extension hn ilej_succ_succ chainℬ hs ht empty_layer' + refine' extension_candidates_characterisation hn ilej_succ_succ chainℬ hs ht empty_layer' have layer_s_mem_card := mem_card_of_slice hs have layer_t_mem_card := mem_card_of_slice ht @@ -986,7 +685,7 @@ lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Finty _ = 1 * ∏ j ∈ ((Finset.univ : Finset (Fin (list'.length - 1))) \ {i_new'}) \ {i_new'_pred}, (#list'[j.val + 1] - #list'[j.val])! := by congr sorry - + sorry sorry -- have mul_identity : multiplicant' i_s = (#list'[↑i_new' + 1] - #list'[↑i_new'])! := by sorry @@ -1044,65 +743,3 @@ lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Finty simpa lemma count_maxChains_through_singleton (e : Finset α) (hn : Fintype.card α = n): Fintype.card (MaxChainThrough {e}) = (#e)! * (n - #e)! := by sorry - -/-- The **Lubell-Yamamoto-Meshalkin inequality**. Sperner's Theorem follows as in Mathlib.Combinatorics.SetFamily.LYM as a corollary -/ -theorem lym_inequality (antichain𝒜 : IsAntichain (· ⊂ ·) 𝒜) (hn : Fintype.card α = n): - ∑ k ∈ Iic n, #(𝒜 # k) / (n.choose k : ℚ) ≤ (1 : ℚ) := by - have : ∑ k ∈ Iic n, #(𝒜 # k) / (n.choose k : ℚ) ≤ (∑ k ∈ Iic n, #(𝒜 # k) * (k)! * (n - k)!) * (1 / (n)! : ℚ) := by - calc - ∑ k ∈ Iic n, #(𝒜 # k) / (n.choose k : ℚ) = ∑ k ∈ Iic n, #(𝒜 # k) * (k)! * (n - k)! * (1 / (n)! : ℚ) := by - apply Finset.sum_congr (by simp) - intro j jmem - simp at jmem - rw [div_eq_mul_inv, mul_assoc, mul_assoc, Nat.choose_eq_factorial_div_factorial] - congr - field_simp - - have choose_divisibility (a b : ℕ) (h : a ≤ b) : ((a)! * (b - a)!) ∣ (b)! := by - use b.choose a - rw [Nat.mul_comm, ←Nat.mul_assoc] - exact (Nat.choose_mul_factorial_mul_factorial h).symm - - rw [Nat.cast_div (choose_divisibility j n jmem), Nat.cast_mul] - · field_simp - · norm_num - constructor <;> apply Nat.factorial_ne_zero - · exact jmem - _ = (∑ k ∈ Iic n, #(𝒜 # k) * (k)! * (n - k)!) * (1 / (n)! : ℚ) := by simp [←Finset.sum_mul] - rfl - - refine' le_trans this _ - rw [mul_one_div] - apply (div_le_one (by simp [Nat.factorial_pos n])).mpr - - norm_cast - - have slice_partition : Finset.disjiUnion (Iic n) 𝒜.slice (Finset.pairwiseDisjoint_slice.subset (Set.subset_univ _)) = 𝒜 := by - rw [Finset.disjiUnion_eq_biUnion (Iic n) 𝒜.slice (Finset.pairwiseDisjoint_slice.subset (Set.subset_univ _))] - rw [←hn] - --simp (biUnion_slice 𝒜) - sorry - - calc - ∑ k ∈ Iic n, #(𝒜 # k) * (k)! * (n - k)! = ∑ k ∈ Iic n, ∑ e ∈ (𝒜 # k), (#e)! * (n - #e)! := by - apply Finset.sum_congr (by simp) - intro k _ - have hq : ∀ e ∈ (𝒜 # k), (#e)! * (n - #e)! = (k)! * (n - k)! := by - intro e he - simp [slice] at he - rw [he.2] - rw [Finset.sum_congr rfl hq, Finset.sum_const] - ring - _ = ∑ e ∈ 𝒜, (#e)! * (n - #e)! := by - conv => - rhs - rw [←slice_partition] - apply Eq.symm - apply sum_disjiUnion - _ = ∑ e ∈ 𝒜, Fintype.card (MaxChainThrough {e}) := by - apply Finset.sum_congr (by simp) - intro e _ - apply Eq.symm - exact count_maxChains_through_singleton e hn - _ ≤ (n)! := by sorry - --here one must embedd the chains into some common space for counting as solved in 'Sperner_handcrafted_definitions.lean' with the function 'f_embedded_chains' diff --git a/TheBook/ToMathlib/Chain.lean b/TheBook/ToMathlib/Chain.lean new file mode 100644 index 0000000..9a095d5 --- /dev/null +++ b/TheBook/ToMathlib/Chain.lean @@ -0,0 +1,161 @@ +import TheBook.ToMathlib.Chain_optional +import TheBook.ToMathlib.List + +namespace Finset + +open Function Finset Nat Set BigOperators List + +variable {α : Type*} {n m : ℕ} {𝒜 : Finset (Finset α)} (r : α → α → Prop) +local infixl:50 " ≺ " => r + + +lemma IsChain.equivalence_subset_relations : (IsChain (· ⊆ .) 𝒜) ↔ (IsChain (· ⊂ .) 𝒜) := by + constructor + · intro h e₁ e₁mem e₂ e₂mem e₁neqe₂ + cases h e₁mem e₂mem e₁neqe₂ with + | inl e₁sube₂ => left; exact Finset.ssubset_iff_subset_ne.mpr ⟨e₁sube₂, e₁neqe₂⟩ + | inr e₂sube₁ => right; exact Finset.ssubset_iff_subset_ne.mpr ⟨e₂sube₁, e₁neqe₂.symm⟩ + · intro h e₁ e₁mem e₂ e₂mem e₁neqe₂ + cases h e₁mem e₂mem e₁neqe₂ with + | inl e₁sube₂ => left; exact e₁sube₂.left + | inr e₂sube₁ => right; exact e₂sube₁.left + +lemma IsMaxChain.equivalence_subset_relations : (IsMaxChain (· ⊆ .) 𝒜) ↔ (IsMaxChain (· ⊂ .) 𝒜) := by + constructor + · intro h + exact ⟨IsChain.equivalence_subset_relations.mp h.left, fun t chain => h.right (IsChain.equivalence_subset_relations.mpr chain)⟩ + · intro h + exact ⟨IsChain.equivalence_subset_relations.mpr h.left, fun t chain => h.right (IsChain.equivalence_subset_relations.mp chain)⟩ + +lemma SuperChain.equivalence_subset_relations {ℬ : Finset (Finset α)} : (SuperChain (· ⊆ .) ℬ 𝒜) ↔ (SuperChain (· ⊂ .) ℬ 𝒜) := by + constructor + · intro h + exact ⟨IsChain.equivalence_subset_relations.mp h.left, h.right⟩ + · intro h + exact ⟨IsChain.equivalence_subset_relations.mpr h.left, h.right⟩ + +lemma IsChain.unique_of_cardinality_chain (chain𝒜 : IsChain (· ⊂ ·) 𝒜) {a b : Finset α} + (amem : a ∈ 𝒜) (bmem : b ∈ 𝒜) (hcard : #a = #b) : a = b := by + by_contra aneb + cases chain𝒜 amem bmem aneb with + | inl h => + have := Finset.card_strictMono h + linarith + | inr h => + have := Finset.card_strictMono h + linarith + +lemma IsChain.max_one_elt_chain_layer (chain𝒜 : IsChain (· ⊂ ·) 𝒜) (j : ℕ) : #(𝒜 # j) ≤ 1 := by + by_contra! ass + have : (𝒜 # j) ≠ (∅ : Finset (Finset α)) := by + intro assempty + have := Finset.card_eq_zero.mpr assempty + linarith + obtain ⟨a, amem⟩ := Finset.nonempty_iff_ne_empty.mpr this + obtain ⟨b, ⟨bmem, aneb⟩⟩ := Finset.exists_mem_ne ass a + have cardeqab : #a = #b := by rw [(Finset.mem_slice.mp amem).right, (Finset.mem_slice.mp bmem).right] + exact aneb (IsChain.unique_of_cardinality_chain chain𝒜 (Finset.slice_subset bmem) (Finset.slice_subset amem) cardeqab.symm) + +instance IsChain.sub_is_trans : IsTrans 𝒜 (fun (e₁ e₂ : 𝒜) ↦ e₁.val ⊆ e₂.val) := + ⟨fun _ _ _ h₁ h₂ => subset_trans h₁ h₂⟩ + +instance card_le : LE (Finset α) where + le x y := #x ≤ #y + +instance card_lt : LT (Finset α) where + lt x y := #x < #y + +instance card_preorder : Preorder (Finset α) := { + le := (· ≤ ·), + lt := (· < ·), + le_refl := fun x => Nat.le_refl #x, + le_trans := fun _ _ _ hxy hyz => Nat.le_trans hxy hyz, + lt_iff_le_not_le := fun _ _ => Nat.lt_iff_le_not_le +} + +instance card_le_is_total : IsTotal 𝒜 (fun (e₁ e₂ : 𝒜) ↦ e₁.val ≤ e₂.val) := + ⟨fun a b ↦ Nat.le_total #a.val #b.val⟩ + +instance card_le_is_trans : IsTrans 𝒜 (fun (e₁ e₂ : 𝒜) ↦ e₁.val ≤ e₂.val) := + ⟨fun _ _ _ h₁ h₂ ↦ Nat.le_trans h₁ h₂⟩ + +instance IsChain.card_le_is_trans : IsTrans 𝒜 (fun (e₁ e₂ : 𝒜) ↦ e₁.val ⊆ e₂.val) := + ⟨fun _ _ _ h₁ h₂ => subset_trans h₁ h₂⟩ + +lemma card_strict_mono' (chain𝒜 : IsChain (· ⊂ ·) 𝒜) : ((Finset.univ : Finset 𝒜).toList.insertionSort (fun (e₁ e₂ : 𝒜) ↦ #e₁.val ≤ #e₂.val)).Sorted (fun (e₁ e₂ : 𝒜) ↦ #e₁.val < #e₂.val) := by + apply List.pairwise_iff_get.mpr + intro x y xlty + let elt_x := ((List.insertionSort (fun (e₁ e₂ : 𝒜) => #e₁.val ≤ #e₂.val) univ.toList).get x) + let elt_y := ((List.insertionSort (fun (e₁ e₂ : 𝒜) => #e₁.val ≤ #e₂.val) univ.toList).get y) + have card_le : elt_x.val ≤ elt_y.val := List.pairwise_iff_get.mp (List.sorted_insertionSort (fun (e₁ e₂ : 𝒜) ↦ #e₁.val ≤ #e₂.val) (Finset.univ : Finset 𝒜).toList) x y xlty + by_contra! ass + have card_eq := Nat.le_antisymm card_le ass + + have elt_x_eq_elt_y := Subtype.eq (IsChain.unique_of_cardinality_chain chain𝒜 elt_x.prop elt_y.prop card_eq) + have elt_x_neq_elt_y : elt_x ≠ elt_y := List.pairwise_iff_get.mp (List.Nodup.insertionSort ((Finset.univ : Finset 𝒜).nodup_toList)) x y xlty + + exact elt_x_neq_elt_y elt_x_eq_elt_y + +lemma IsChain.card_strict_mono (chain𝒜 : IsChain (· ⊂ ·) 𝒜) : ∃ l : List (Finset α), l ~ 𝒜.toList ∧ l.Sorted (#· < #·) := by + let l' := ((Finset.univ : Finset 𝒜).toList.insertionSort (fun (e₁ e₂ : 𝒜) ↦ #e₁.val ≤ #e₂.val)) + have l'_sorted : l'.Sorted (fun (e₁ e₂ : 𝒜) ↦ #e₁.val < #e₂.val) := card_strict_mono' chain𝒜 + + let l := l'.map Subtype.val + use l + constructor + · calc + l ~ (Finset.univ : Finset 𝒜).toList.map Subtype.val := Perm.map Subtype.val (perm_insertionSort (fun e₁ e₂ => #e₁.val ≤ #e₂.val) (Finset.univ : Finset 𝒜).toList) + _ ~ 𝒜.toList := by + sorry + · unfold l Sorted + apply List.pairwise_iff_get.mpr + intro i j iltj + simp [List.getElem_map, List.unattach, -List.map_subtype] + + have : (l'.map Subtype.val).length = l'.length := length_map l' Subtype.val + + have iltj_coe : (Fin.cast this i) < (Fin.cast this j) := by + apply Fin.lt_def.mpr + simp + exact iltj + + have := List.pairwise_iff_get.mp l'_sorted (Fin.cast this i) (Fin.cast this j) iltj_coe + exact this + +/-- If a chain intersects a layer of the boolean lattice this intersection is a singleton -/ +lemma layer_singleton_of_nonempty (chain𝒜 : IsChain (· ⊂ ·) 𝒜) (j : Finset.range (n + 1)) (layer_nonempty : (𝒜 # j) ≠ ∅): + ∃! e : Finset α, 𝒜 # j = {e} := by + have : # (𝒜 # j) = 1 := by + cases Nat.le_one_iff_eq_zero_or_eq_one.mp (IsChain.max_one_elt_chain_layer chain𝒜 j) with + | inl card_zero => + simp at card_zero + exact False.elim (layer_nonempty card_zero) + | inr card_one => exact card_one + obtain ⟨e, he⟩ := Finset.card_eq_one.mp this + have unique : ∀ a : Finset α, 𝒜 # j = {a} → a = e := by + intro a ha + rw [he] at ha + simp at ha + exact ha.symm + + exact ⟨e, he, unique⟩ + +lemma IsChain.ssubset_of_lt_cardinality (chain𝒜 : IsChain (· ⊂ ·) 𝒜) {e₁ e₂ : Finset α} (e₁mem : e₁ ∈ 𝒜) (e₂mem : e₂ ∈ 𝒜) + (hcard : #e₁ < #e₂) : e₁ ⊂ e₂ := by + have e₁nee₂ : e₁ ≠ e₂ := by + intro ass + have : #e₁ = #e₂ := by rw [ass] + linarith + cases chain𝒜 e₁mem e₂mem e₁nee₂ with + | inl h => exact Finset.ssubset_iff_subset_ne.mpr ⟨h.left, e₁nee₂⟩ + | inr h => + have : #e₂ < #e₁ := Finset.card_strictMono h + linarith + +lemma IsChain.subset_of_le_cardinality (chain𝒜 : IsChain (· ⊂ ·) 𝒜) {e₁ e₂ : Finset α} (e₁mem : e₁ ∈ 𝒜) (e₂mem : e₂ ∈ 𝒜) + (hcard : #e₁ ≤ #e₂) : e₁ ⊆ e₂ := by + cases Nat.eq_or_lt_of_le hcard with + | inr hcard_lt => + exact (IsChain.ssubset_of_lt_cardinality chain𝒜 e₁mem e₂mem hcard_lt).left + | inl hcard_eq => + exact Finset.subset_of_eq (IsChain.unique_of_cardinality_chain chain𝒜 e₁mem e₂mem hcard_eq) diff --git a/TheBook/ToMathlib/Chain_optional.lean b/TheBook/ToMathlib/Chain_optional.lean new file mode 100644 index 0000000..8457971 --- /dev/null +++ b/TheBook/ToMathlib/Chain_optional.lean @@ -0,0 +1,66 @@ +import Mathlib.Tactic +import Mathlib.Combinatorics.Enumerative.DoubleCounting +import Mathlib.Combinatorics.Derangements.Finite +import Mathlib.Logic.Equiv.Defs +import Mathlib.Data.Set.Basic +import Mathlib.Data.Finset.Slice +import Mathlib.Order.Antichain +import Mathlib.Order.Chain +import Mathlib.Data.List.Perm.Basic + +open Function Finset Nat Set BigOperators List + +variable {α : Type*} {n m : ℕ} {𝒜 : Finset (Finset α)} (r : α → α → Prop) + +namespace Finset + +/-- In this file, we use `≺` as a local notation for any relation `r`. -/ +local infixl:50 " ≺ " => r + +/- + The following definitions match the ones in Mathlib.Order.Chain, but use Finset in order to be able to carry information on finiteness inside the chain property. +-/ + +def IsChain (s : Finset α) : Prop := + s.toSet.Pairwise fun x y => x ≺ y ∨ y ≺ x + +/-- `SuperChain s t` means that `t` is a chain that strictly includes `s`. -/ +def SuperChain (s t : Finset α) : Prop := + IsChain r t ∧ s ⊂ t + +/-- A chain `s` is a maximal chain if there does not exists a chain strictly including `s`. -/ +def IsMaxChain (s : Finset α) : Prop := + IsChain r s ∧ ∀ ⦃t⦄, IsChain r t → s ⊆ t → s = t + +def IsAntichain (r : α → α → Prop) (s : Finset α) : Prop := + s.toSet.Pairwise rᶜ + +end Finset + +variable (ℬ₀ : Set α) (ℬ₁ : Finset α) (r : α → α → Prop) + +/- The usual definition of chains are compatible if used along the toSet method-/ +example (h : Finset.IsChain r ℬ₁) : IsChain r ℬ₁.toSet := h +example (h : IsChain r ℬ₁.toSet) : Finset.IsChain r ℬ₁ := h + +instance [Fintype ℬ₀] : Coe (IsChain r ℬ₀) (Finset.IsChain r ℬ₀.toFinset) := + ⟨fun h ↦ (fun _ hx _ hy xneqy ↦ h (Set.mem_toFinset.mp hx) (Set.mem_toFinset.mp hy) xneqy)⟩ + +example [Fintype ℬ₀] (h : IsChain r ℬ₀) : Finset.IsChain r ℬ₀.toFinset := h + +instance [Fintype α] : Fintype (Finset α) := { + elems := Finset.powerset (@Finset.univ α _), + complete := by simp +} + +noncomputable instance [Fintype α] : Fintype ℬ₀ := Fintype.ofFinite ↑ℬ₀ +noncomputable instance [Fintype α] : Coe (Set α) (Finset α) := ⟨fun s ↦ s.toFinset⟩ +noncomputable example [Fintype α] (𝒟 : Set α) : Finset α := 𝒟 + +instance [Fintype α] : Coe (_root_.IsChain r ℬ₀) (Finset.IsChain r ℬ₀.toFinset) := + ⟨fun h ↦ (fun _ hx _ hy xneqy ↦ h (Set.mem_toFinset.mp hx) (Set.mem_toFinset.mp hy) xneqy)⟩ + +instance [Fintype α] : Fintype (Set α) := { + elems := (Finset.powerset (@Finset.univ α _)).map ⟨Finset.toSet, Finset.coe_injective⟩, + complete := by intro x; simp; use x.toFinset; simp +} diff --git a/TheBook/ToMathlib/List.lean b/TheBook/ToMathlib/List.lean new file mode 100644 index 0000000..7bce695 --- /dev/null +++ b/TheBook/ToMathlib/List.lean @@ -0,0 +1,49 @@ +import Mathlib.Tactic +import Mathlib.Data.List.Perm.Basic + +variable {α : Type*} (r : α → α → Prop) [LE α] [DecidableRel (fun (x₁ x₂ : α) ↦ x₁ ≤ x₂)] + +theorem List.Nodup.orderedInsert + {l : List α} {a : α} (l_nodup : l.Nodup) (a_not_mem : a ∉ l) : + (orderedInsert (· ≤ ·) a l).Nodup := by + induction l with + | nil => + simp [orderedInsert] + | cons x xs ih => + simp [orderedInsert] + simp at a_not_mem + simp at l_nodup + split + · simp [List.Nodup] + constructor + · constructor + · exact a_not_mem.left + · intro u hu + by_contra ass + rw [←ass] at hu + exact a_not_mem.right hu + · constructor + · intro u hu + by_contra ass + rw [←ass] at hu + exact l_nodup.left hu + · exact l_nodup.right + · simp + constructor + · constructor + · exact fun x ↦ a_not_mem.left x.symm + · exact l_nodup.left + · exact ih l_nodup.right a_not_mem.right + +theorem List.Nodup.insertionSort {l : List α} (h : l.Nodup) : (l.insertionSort (fun (x₁ x₂ : α) ↦ x₁ ≤ x₂)).Nodup := by + induction l with + | nil => + simp [List.insertionSort, List.Nodup] + | cons x xs ih => + simp [List.insertionSort] + have sorted_nodup : (xs.insertionSort (fun x₁ x₂ => x₁ ≤ x₂)).Nodup := ih h.tail + have x_ne_mem_sorted : x ∉ xs.insertionSort (fun x₁ x₂ => x₁ ≤ x₂) := by + by_contra ass + simp at h + exact h.left ((List.mem_insertionSort (· ≤ ·)).mp ass) + exact List.Nodup.orderedInsert sorted_nodup x_ne_mem_sorted From 89760085294d4a839d9ec90c5850d922c1e983b7 Mon Sep 17 00:00:00 2001 From: Jakob Zimmermann Date: Tue, 28 Jan 2025 10:26:14 +0100 Subject: [PATCH 22/26] continuing restructuring and adding small lemmata for mathlib --- TheBook/Combinatorics/LYM.lean | 12 +- .../SpernerHelpingDataStructures.lean | 214 +--------------- .../Combinatorics/SpernerHelpingLemmata.lean | 0 TheBook/ToMathlib/Antichain.lean | 35 +++ TheBook/ToMathlib/Chain.lean | 234 +++++++++++++++++- TheBook/ToMathlib/CliqueNumber.lean | 1 - TheBook/ToMathlib/List.lean | 37 ++- 7 files changed, 309 insertions(+), 224 deletions(-) create mode 100644 TheBook/Combinatorics/SpernerHelpingLemmata.lean create mode 100644 TheBook/ToMathlib/Antichain.lean diff --git a/TheBook/Combinatorics/LYM.lean b/TheBook/Combinatorics/LYM.lean index 0f2d007..347e216 100644 --- a/TheBook/Combinatorics/LYM.lean +++ b/TheBook/Combinatorics/LYM.lean @@ -9,12 +9,13 @@ import Mathlib.Order.Chain import Mathlib.Data.List.Perm.Basic import TheBook.ToMathlib.Chain_optional import TheBook.ToMathlib.Chain +import TheBook.ToMathlib.Antichain import TheBook.ToMathlib.List import TheBook.Combinatorics.SpernerHelpingDataStructures open Function Finset Nat Set BigOperators List -variable {α : Type*} {n m : ℕ} {𝒜 : Finset (Finset α)} [Fintype α] [DecidableEq α] [DecidableEq (Finset α)] +variable {α : Type*} {n m : ℕ} {𝒜 : Finset (Finset α)} [Fintype α] [DecidableEq α] namespace Finset @@ -53,8 +54,8 @@ theorem lym_inequality (antichain𝒜 : IsAntichain (· ⊂ ·) 𝒜) (hn : Fint have slice_partition : Finset.disjiUnion (Iic n) 𝒜.slice (Finset.pairwiseDisjoint_slice.subset (Set.subset_univ _)) = 𝒜 := by rw [Finset.disjiUnion_eq_biUnion (Iic n) 𝒜.slice (Finset.pairwiseDisjoint_slice.subset (Set.subset_univ _))] rw [←hn] - --simp (biUnion_slice 𝒜) - sorry + have := biUnion_slice 𝒜 + exact this calc ∑ k ∈ Iic n, #(𝒜 # k) * (k)! * (n - k)! = ∑ k ∈ Iic n, ∑ e ∈ (𝒜 # k), (#e)! * (n - #e)! := by @@ -77,4 +78,9 @@ theorem lym_inequality (antichain𝒜 : IsAntichain (· ⊂ ·) 𝒜) (hn : Fint intro e _ apply Eq.symm exact count_maxChains_through_singleton e hn + _ = ∑ e ∈ 𝒜, #((Finset.univ : Finset (MaxChainThrough {e})).image (emb_MaxChainThrough {e})) := by + apply Finset.sum_congr (by simp) + intro e e_mem + rw [Finset.card_image_of_injective (Finset.univ : Finset (MaxChainThrough {e})) inj_emb_MaxChainThrough, Finset.card_univ] + _ = #(𝒜.disjiUnion (fun e : Finset α ↦ (Finset.univ : Finset (MaxChainThrough {e})).image (emb_MaxChainThrough {e})) (AntiChain.disj_union_chain_through antichain𝒜)) _ ≤ (n)! := by sorry diff --git a/TheBook/Combinatorics/SpernerHelpingDataStructures.lean b/TheBook/Combinatorics/SpernerHelpingDataStructures.lean index ed89135..acf9af8 100644 --- a/TheBook/Combinatorics/SpernerHelpingDataStructures.lean +++ b/TheBook/Combinatorics/SpernerHelpingDataStructures.lean @@ -30,36 +30,6 @@ instance instFintypeMaxChainThrough {ℬ : Finset (Finset α)} : Fintype (MaxCha variable [Fintype α] [DecidableEq α] [DecidableEq (Finset (Finset α))] [DecidableEq (Finset α)] -def chain_extension_filter_function (𝒜 : Finset (Finset α)) (e : Finset α) : α → Prop := - fun a : α ↦ IsChain (· ⊂ ·) (insert (insert a e) 𝒜) ∧ insert a e ∉ 𝒜 - -instance instDecidableIsChain (𝒜 : Finset (Finset α)) : Decidable (IsChain (· ⊂ ·) 𝒜) := by - apply Finset.decidableDforallFinset - -instance instDecidablePredChainExtension (e : Finset α) : - DecidablePred (chain_extension_filter_function 𝒜 e) := - fun a : α => inferInstanceAs (Decidable (IsChain (· ⊂ ·) (insert (insert a e) 𝒜) ∧ insert a e ∉ 𝒜)) - -def extension_candidates (ℬ : Finset (Finset α)) (e : Finset α) := Finset.filter (chain_extension_filter_function ℬ e) (Finset.univ : Finset α) - -lemma IsChain.empty_layer_by_card (hn : Fintype.card α = n) (chain𝒜 : IsChain (· ⊂ ·) 𝒜) (card𝒜 : #𝒜 < n+1) : ∃ i : Fin (n + 1), #(𝒜 # i) = 0 := by - by_contra! ass - have : ∀ (i : Fin (n + 1)), #(𝒜 # i) = 1 := by - intro i - have non_zero := ass i - cases Nat.le_one_iff_eq_zero_or_eq_one.mp (IsChain.max_one_elt_chain_layer chain𝒜 i) with - | inl h => exfalso; exact (non_zero h) - | inr h => exact h - rw [←sum_card_slice 𝒜] at card𝒜 - have := calc - ∑ r ∈ Iic (Fintype.card α), #(𝒜 # r) = ∑ r ∈ Iic (Fintype.card α), 1 := by - apply Finset.sum_congr (by rfl) - intro j jmem - simp [hn] at jmem - exact this ⟨j, by simp [Nat.lt_succ_of_le jmem]⟩ - _ = n + 1 := by rw [←(Finset.card_eq_sum_ones (Iic (Fintype.card α)))]; simp [hn] - linarith - lemma range_empty_layer (hn : Fintype.card α = n) (chain𝒜 : IsChain (· ⊂ ·) 𝒜) (empty_layer : ∃ i : Fin (n + 1), #(𝒜 # i) = 0) (empty_elt : ∅ ∈ 𝒜) (univ_elt : Finset.univ ∈ 𝒜) : ∃ s : Fin (n + 1), ∃ t : Fin (n + 1), s.val + 2 ≤ t.val ∧ #(𝒜 # s) = 1 ∧ #(𝒜 # t) = 1 ∧ ∀ j : Fin (n + 1), s < j ∧ j < t → #(𝒜 # j) = 0 := by sorry @@ -206,185 +176,6 @@ lemma extension_candidates_characterisation (hn : Fintype.card α = n) {i j : Fi have : #(𝒜 # #e_new) > 0 := Finset.card_pos.mpr this linarith -lemma one_elt_max_chain_layer (hn : Fintype.card α = n) (maxchain𝒜 : IsMaxChain (· ⊂ ·) 𝒜) (j : Finset.range (n + 1)) : #(𝒜 # j) = 1 := by - by_contra! ass - have empty_layer : 𝒜 # j = ∅ := by - cases Nat.le_one_iff_eq_zero_or_eq_one.mp (IsChain.max_one_elt_chain_layer maxchain𝒜.left j) with - | inl h => simp at h; exact h - | inr h => omega - - if htop : ∀ i : Finset.range (n + 1), i > j → 𝒜 # i = ∅ then - have univnotin𝒜 : (Finset.univ : Finset α) ∉ 𝒜 := by - intro ass₂ - have nslicemem : (Finset.univ : Finset α) ∈ 𝒜 # n := by - simp [Finset.slice] - exact ⟨ass₂, hn⟩ - cases Nat.lt_or_ge j n with - | inl jltn => - have nsliceempty : 𝒜 # n = ∅ := htop ⟨n, Finset.mem_range.mpr (Nat.lt_succ_self n)⟩ jltn - simp [nsliceempty] at nslicemem - | inr jgen => - have jeqn : j = n := Nat.eq_of_le_of_lt_succ jgen (Finset.mem_range.1 (by simp)) - rw [jeqn] at empty_layer - simp [empty_layer] at nslicemem - simp [IsMaxChain] at maxchain𝒜 - have larger_chain_with_univ' : _root_.IsChain (· ⊂ ·) (Insert.insert (Finset.univ : Finset α) 𝒜).toSet := by - have : ((Insert.insert (Finset.univ : Finset α) 𝒜) : Finset (Finset α)).toSet = ((Insert.insert (Finset.univ : Finset α) 𝒜) : Set (Finset α)) := by simp - rw [this] - refine' IsChain.insert maxchain𝒜.left _ - intro b bmem bneq - right - exact Finset.ssubset_iff_subset_ne.mpr ⟨by simp, fun h => bneq h.symm⟩ - - have larger_chain_with_univ : Finset.IsChain (· ⊂ ·) ((Insert.insert (Finset.univ : Finset α) 𝒜) : Finset (Finset α)) := larger_chain_with_univ' - - have univin𝒜 := Finset.insert_eq_self.mp (maxchain𝒜.right larger_chain_with_univ (by simp)).symm - exact univnotin𝒜 univin𝒜 - else if hbottom : ∀ i : Finset.range (n + 1), i < j → 𝒜 # i = ∅ then - have emptynotin𝒜 : (∅ : Finset α) ∉ 𝒜 := by - intro ass₃ - have zeroslicemem : (∅ : Finset α) ∈ 𝒜 # 0 := by - simp [Finset.slice] - exact ass₃ - cases Nat.eq_zero_or_pos j with - | inl jeqzero => - rw [jeqzero] at empty_layer - simp [empty_layer] at zeroslicemem - | inr jgen => - simp [hbottom ⟨0, by simp⟩ jgen] at zeroslicemem - simp [IsMaxChain] at maxchain𝒜 - have larger_chain_with_empty' : _root_.IsChain (· ⊂ ·) ((Insert.insert (∅ : Finset α) 𝒜)).toSet := by - have : ((Insert.insert (∅ : Finset α) 𝒜)).toSet = (Insert.insert (∅ : Finset α) 𝒜.toSet) := by simp - rw [this] - refine' IsChain.insert maxchain𝒜.left _ - intro b bmem bneq - left - exact Finset.ssubset_iff_subset_ne.mpr ⟨by simp, bneq⟩ - - have larger_chain_with_empty : IsChain (· ⊂ ·) ((Insert.insert (∅ : Finset α) 𝒜)) := larger_chain_with_empty' - - have emptyin𝒜 := Finset.insert_eq_self.mp (maxchain𝒜.right larger_chain_with_empty (by simp)).symm - exact emptynotin𝒜 emptyin𝒜 - - else - simp at htop hbottom - let indices_nonempty_top := Finset.filter (fun i : Finset.range (n + 1) ↦ i > j ∧ 𝒜 # i ≠ ∅) (Finset.univ : Finset (Finset.range (n + 1))) - let indices_nonempty_bottom := Finset.filter (fun i : Finset.range (n + 1) ↦ i < j ∧ 𝒜 # i ≠ ∅) (Finset.univ : Finset (Finset.range (n + 1))) - have nonempty_indices_nonempty_top : indices_nonempty_top.Nonempty := by - simp [Finset.Nonempty] - obtain ⟨i, ⟨⟨ilen, jlti⟩, jlayernotempty⟩⟩ := htop - use i - simp [indices_nonempty_top] - constructor - · use ilen - · exact jlayernotempty - - have nonempty_indices_nonempty_bottom : indices_nonempty_bottom.Nonempty := by - simp [Finset.Nonempty] - obtain ⟨i, ⟨⟨ilen, iltj⟩, jlayernotempty⟩⟩ := hbottom - use i - simp [indices_nonempty_bottom] - constructor - · use ilen - · exact jlayernotempty - - obtain ⟨s_top, s_top_min⟩ := Finset.min_of_nonempty nonempty_indices_nonempty_top - have h_s_top := Finset.mem_of_min s_top_min - simp [indices_nonempty_top] at h_s_top - - obtain ⟨s_bottom, s_bottom_max⟩ := Finset.max_of_nonempty nonempty_indices_nonempty_bottom - have h_s_bottom := Finset.mem_of_max s_bottom_max - simp [indices_nonempty_bottom] at h_s_bottom - - have emptylayer : ∀ l ∈ (Finset.range (n + 1)), s_bottom < l → l < s_top → #(𝒜 # l) = 0 := by - intro l lmem s_bottom_lt_l l_lt_s_top - - have h_top : ⟨l, lmem⟩ ∉ indices_nonempty_top := Finset.not_mem_of_lt_min l_lt_s_top s_top_min - have h_bottom : ⟨l, lmem⟩ ∉ indices_nonempty_bottom := Finset.not_mem_of_max_lt s_bottom_lt_l s_bottom_max - - simp [indices_nonempty_top] at h_top - simp [indices_nonempty_bottom] at h_bottom - - simp - - by_cases jeql : j = ⟨l, lmem⟩ - · rw [←empty_layer, jeql] - · cases (Nat.lt_or_gt_of_ne (fun ass : ↑j = l => jeql (by simp [←ass]))) with - | inl jltl => exact h_top jltl - | inr jgtl => exact h_bottom jgtl - - obtain ⟨e_bottom, ⟨bottom_singleton : 𝒜 # s_bottom = {e_bottom}, _⟩⟩ := layer_singleton_of_nonempty maxchain𝒜.left s_bottom h_s_bottom.right - - obtain ⟨e_top, ⟨top_singleton : 𝒜 # s_top = {e_top}, _⟩⟩ := layer_singleton_of_nonempty maxchain𝒜.left s_top h_s_top.right - - let extension_candidates := Finset.filter (chain_extension_filter_function 𝒜 e_bottom) (Finset.univ : Finset α) - - have extension_candidates_eq : extension_candidates = e_top \ e_bottom := by - refine' extension_candidates_characterisation hn _ maxchain𝒜.left bottom_singleton top_singleton emptylayer - apply Nat.succ_le_of_lt - have : (s_bottom : ℕ) + 1 ≤ ↑j := Nat.succ_le_of_lt h_s_bottom.left - exact Nat.lt_of_le_of_lt this h_s_top.left - simp at extension_candidates_eq - - have e_bottom_mem_card : e_bottom ∈ 𝒜 ∧ #e_bottom = s_bottom := by - have := Finset.mem_singleton_self e_bottom - rw [←bottom_singleton] at this - simp [slice] at this - exact this - - have e_top_mem_card : e_top ∈ 𝒜 ∧ #e_top = s_top := by - have := Finset.mem_singleton_self e_top - rw [←top_singleton] at this - simp [slice] at this - exact this - - have extension_candidates_ne_empty : #extension_candidates > 0 := by - rw [extension_candidates_eq] - have card_bottom_lt_card_top : #e_bottom < #e_top := by - rw [e_top_mem_card.right, e_bottom_mem_card.right] - exact Nat.lt_trans h_s_bottom.left h_s_top.left - have bottom_subset_top : e_bottom ⊂ e_top := - IsChain.ssubset_of_lt_cardinality maxchain𝒜.left e_bottom_mem_card.left e_top_mem_card.left card_bottom_lt_card_top - have := Finset.card_sdiff_add_card_eq_card bottom_subset_top.left - linarith - simp at extension_candidates_ne_empty - obtain ⟨a, ha⟩ := extension_candidates_ne_empty - simp [extension_candidates, chain_extension_filter_function] at ha - have := Finset.insert_eq_self.mp (maxchain𝒜.right ha.left (by simp)).symm - exact ha.right this - -lemma IsMaxChain.card {ℬ : Finset (Finset α)} (hn : Fintype.card α = n) (maxChainℬ : IsMaxChain (· ⊂ ·) ℬ) : ℬ.card = n + 1 := by - rw [←sum_card_slice ℬ] - calc - ∑ r ∈ Iic (Fintype.card α), #(ℬ # r) = ∑ r ∈ Iic (Fintype.card α), 1 := by - apply Finset.sum_congr (by rfl) - intro j jmem - simp [hn] at jmem - exact one_elt_max_chain_layer hn maxChainℬ ⟨j, by simp [Nat.lt_succ_of_le jmem]⟩ - _ = n + 1 := by rw [←(Finset.card_eq_sum_ones (Iic (Fintype.card α)))]; simp [hn] - -lemma IsChain.card_le {ℬ : Finset (Finset α)} (hn : Fintype.card α = n) (chainℬ : IsChain (· ⊂ ·) ℬ) : ℬ.card ≤ n + 1 := by - rw [←sum_card_slice ℬ] - calc - ∑ r ∈ Iic (Fintype.card α), #(ℬ # r) ≤ ∑ r ∈ Iic (Fintype.card α), 1 := by - apply sum_le_sum - intro j jmem - exact IsChain.max_one_elt_chain_layer chainℬ j - _ = n + 1 := by rw [←(Finset.card_eq_sum_ones (Iic (Fintype.card α)))]; simp [hn] - -lemma IsMaxChain.iff_card {ℬ : Finset (Finset α)} (hn : Fintype.card α = n) (chainℬ : IsChain (· ⊂ ·) ℬ) : IsMaxChain (· ⊂ ·) ℬ ↔ ℬ.card = n + 1 := by - constructor - · intro maxChainℬ - exact IsMaxChain.card hn maxChainℬ - · intro cardℬ - constructor - · exact chainℬ - · intro 𝒜 chain𝒜 ℬssub𝒜 - have hcard𝒜 : #𝒜 ≤ #ℬ := by - · rw [cardℬ] - exact IsChain.card_le hn chain𝒜 - exact (Finset.subset_iff_eq_of_card_le hcard𝒜).mp ℬssub𝒜 - lemma card_maxChainThrough {ℬ : Finset (Finset α)} (hn : Fintype.card α = n) (chain : MaxChainThrough ℬ) : #chain.𝒜 = n + 1 := by rw [←sum_card_slice chain.𝒜] calc @@ -392,7 +183,7 @@ lemma card_maxChainThrough {ℬ : Finset (Finset α)} (hn : Fintype.card α = n) apply Finset.sum_congr (by rfl) intro j jmem simp [hn] at jmem - exact one_elt_max_chain_layer hn chain.isMaxChain ⟨j, by simp [Nat.lt_succ_of_le jmem]⟩ + exact IsMaxChain.one_elt_max_chain_layer hn chain.isMaxChain ⟨j, by simp [Nat.lt_succ_of_le jmem]⟩ _ = n + 1 := by rw [←(Finset.card_eq_sum_ones (Iic (Fintype.card α)))]; simp [hn] lemma first_entry {ℬ : Finset (Finset α)} (list : List (Finset α)) @@ -494,7 +285,6 @@ lemma chain_through_extension_candidates_pairwiseDisjoint (ℬ : Finset (Finset intro 𝒜 h𝒜 have a_extension_e_x := hA_x h𝒜 have a_extension_e_y := hA_y h𝒜 - sorry lemma central_identity {ℬ : Finset (Finset α)} (e : Finset α) (e_mem : e ∈ ℬ) : @@ -603,7 +393,7 @@ lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Finty apply Finset.card_insert_of_not_mem · exact a_property₁.right.right - obtain ⟨list', ⟨list_per' : list' ~ (insert e_new ℬ).toList, list_sorted' ⟩⟩ := IsChain.card_strict_mono a_property₁.right.left + obtain ⟨list', ⟨list_per' : list' ~ (insert e_new ℬ).toList, list_sorted' ⟩⟩ := Chain.card_strict_mono a_property₁.right.left have embedding_card := Finset.card_image_of_injective (Finset.univ : Finset (MaxChainThrough ℬ')) inj_emb_MaxChainThrough simp [extensions_wrt, embedding_card] diff --git a/TheBook/Combinatorics/SpernerHelpingLemmata.lean b/TheBook/Combinatorics/SpernerHelpingLemmata.lean new file mode 100644 index 0000000..e69de29 diff --git a/TheBook/ToMathlib/Antichain.lean b/TheBook/ToMathlib/Antichain.lean new file mode 100644 index 0000000..a02075d --- /dev/null +++ b/TheBook/ToMathlib/Antichain.lean @@ -0,0 +1,35 @@ +import TheBook.Combinatorics.SpernerHelpingDataStructures + +open Function Finset Nat Set BigOperators List + +variable {α : Type*} {n m : ℕ} {𝒜 : Finset (Finset α)} [DecidableEq α] + +namespace Finset + +lemma AntiChain.disj_union_chain_through (anti_chain : IsAntichain (· ⊂ ·) 𝒜) : + 𝒜.toSet.PairwiseDisjoint (fun e ↦ ((Finset.univ : Finset (MaxChainThrough {e})).image (emb_MaxChainThrough {e}))) := by + intro e₁ e₁_mem_𝒜 e₂ e₂_mem_𝒜 e₁neqe₂ + simp [onFun] + + refine' disjoint_left.mpr _ + intro C C_mem₁ C_mem₂ + + obtain ⟨C₁, ⟨_, C₁_image⟩⟩ := mem_image.mp C_mem₁ + obtain ⟨C₂, ⟨_, C₂_image⟩⟩ := mem_image.mp C_mem₂ + + have e₁_mem_C₁ := singleton_subset_iff.mp C₁.subChain + have e₂_mem_C₂ := singleton_subset_iff.mp C₂.subChain + unfold emb_MaxChainThrough at C₁_image C₂_image + rw [C₂_image, ←C₁_image] at e₂_mem_C₂ + + have comparable := C₁.isMaxChain.left e₁_mem_C₁ e₂_mem_C₂ e₁neqe₂ + simp at comparable + + have noncomparable₁ := anti_chain e₁_mem_𝒜 e₂_mem_𝒜 e₁neqe₂ + have noncomparable₂ := anti_chain e₂_mem_𝒜 e₁_mem_𝒜 e₁neqe₂.symm + simp at noncomparable₁ + simp at noncomparable₂ + + cases comparable with + | inl h => exact noncomparable₁ h + | inr h => exact noncomparable₂ h diff --git a/TheBook/ToMathlib/Chain.lean b/TheBook/ToMathlib/Chain.lean index 9a095d5..afb8c9c 100644 --- a/TheBook/ToMathlib/Chain.lean +++ b/TheBook/ToMathlib/Chain.lean @@ -1,5 +1,7 @@ import TheBook.ToMathlib.Chain_optional import TheBook.ToMathlib.List +import Mathlib.Data.Finset.Slice +import Init.Core namespace Finset @@ -8,7 +10,6 @@ open Function Finset Nat Set BigOperators List variable {α : Type*} {n m : ℕ} {𝒜 : Finset (Finset α)} (r : α → α → Prop) local infixl:50 " ≺ " => r - lemma IsChain.equivalence_subset_relations : (IsChain (· ⊆ .) 𝒜) ↔ (IsChain (· ⊂ .) 𝒜) := by constructor · intro h e₁ e₁mem e₂ e₂mem e₁neqe₂ @@ -96,7 +97,7 @@ lemma card_strict_mono' (chain𝒜 : IsChain (· ⊂ ·) 𝒜) : ((Finset.univ : exact elt_x_neq_elt_y elt_x_eq_elt_y -lemma IsChain.card_strict_mono (chain𝒜 : IsChain (· ⊂ ·) 𝒜) : ∃ l : List (Finset α), l ~ 𝒜.toList ∧ l.Sorted (#· < #·) := by +lemma Chain.card_strict_mono [DecidableEq α] (chain𝒜 : IsChain (· ⊂ ·) 𝒜) : ∃ l : List (Finset α), l ~ 𝒜.toList ∧ l.Sorted (#· < #·) := by let l' := ((Finset.univ : Finset 𝒜).toList.insertionSort (fun (e₁ e₂ : 𝒜) ↦ #e₁.val ≤ #e₂.val)) have l'_sorted : l'.Sorted (fun (e₁ e₂ : 𝒜) ↦ #e₁.val < #e₂.val) := card_strict_mono' chain𝒜 @@ -105,8 +106,7 @@ lemma IsChain.card_strict_mono (chain𝒜 : IsChain (· ⊂ ·) 𝒜) : ∃ l : constructor · calc l ~ (Finset.univ : Finset 𝒜).toList.map Subtype.val := Perm.map Subtype.val (perm_insertionSort (fun e₁ e₂ => #e₁.val ≤ #e₂.val) (Finset.univ : Finset 𝒜).toList) - _ ~ 𝒜.toList := by - sorry + _ ~ 𝒜.toList := by apply Finset.subtype_toList · unfold l Sorted apply List.pairwise_iff_get.mpr intro i j iltj @@ -122,8 +122,7 @@ lemma IsChain.card_strict_mono (chain𝒜 : IsChain (· ⊂ ·) 𝒜) : ∃ l : have := List.pairwise_iff_get.mp l'_sorted (Fin.cast this i) (Fin.cast this j) iltj_coe exact this -/-- If a chain intersects a layer of the boolean lattice this intersection is a singleton -/ -lemma layer_singleton_of_nonempty (chain𝒜 : IsChain (· ⊂ ·) 𝒜) (j : Finset.range (n + 1)) (layer_nonempty : (𝒜 # j) ≠ ∅): +lemma Chain.layer_singleton_of_nonempty (chain𝒜 : IsChain (· ⊂ ·) 𝒜) (j : Finset.range (n + 1)) (layer_nonempty : (𝒜 # j) ≠ ∅): ∃! e : Finset α, 𝒜 # j = {e} := by have : # (𝒜 # j) = 1 := by cases Nat.le_one_iff_eq_zero_or_eq_one.mp (IsChain.max_one_elt_chain_layer chain𝒜 j) with @@ -159,3 +158,226 @@ lemma IsChain.subset_of_le_cardinality (chain𝒜 : IsChain (· ⊂ ·) 𝒜) {e exact (IsChain.ssubset_of_lt_cardinality chain𝒜 e₁mem e₂mem hcard_lt).left | inl hcard_eq => exact Finset.subset_of_eq (IsChain.unique_of_cardinality_chain chain𝒜 e₁mem e₂mem hcard_eq) + + + +section ChainExtension + +variable {α : Type*} [DecidableEq α] [Fintype α] + +def chain_extension_filter_function (𝒜 : Finset (Finset α)) (e : Finset α) : α → Prop := + fun a : α ↦ IsChain (· ⊂ ·) (insert (insert a e) 𝒜) ∧ insert a e ∉ 𝒜 + +variable {𝒜 : Finset (Finset α)} + +instance instDecidableIsChain : Decidable (IsChain (· ⊂ ·) 𝒜) := by + apply Finset.decidableDforallFinset + +instance instDecidablePredChainExtension {𝒜 : Finset (Finset α)} (e : Finset α) : + DecidablePred (chain_extension_filter_function 𝒜 e) := + fun a : α => inferInstanceAs (Decidable (IsChain (· ⊂ ·) (insert (insert a e) 𝒜) ∧ insert a e ∉ 𝒜)) + +def extension_candidates (ℬ : Finset (Finset α)) (e : Finset α) := Finset.filter (chain_extension_filter_function ℬ e) (Finset.univ : Finset α) + + + +lemma IsChain.empty_layer_by_card (hn : Fintype.card α = n) (chain𝒜 : IsChain (· ⊂ ·) 𝒜) (card𝒜 : #𝒜 < n+1) : ∃ i : Fin (n + 1), #(𝒜 # i) = 0 := by + by_contra! ass + have : ∀ (i : Fin (n + 1)), #(𝒜 # i) = 1 := by + intro i + have non_zero := ass i + cases Nat.le_one_iff_eq_zero_or_eq_one.mp (IsChain.max_one_elt_chain_layer chain𝒜 i) with + | inl h => exfalso; exact (non_zero h) + | inr h => exact h + rw [←sum_card_slice 𝒜] at card𝒜 + have := calc + ∑ r ∈ Iic (Fintype.card α), #(𝒜 # r) = ∑ r ∈ Iic (Fintype.card α), 1 := by + apply Finset.sum_congr (by rfl) + intro j jmem + simp [hn] at jmem + exact this ⟨j, by simp [Nat.lt_succ_of_le jmem]⟩ + _ = n + 1 := by rw [←(Finset.card_eq_sum_ones (Iic (Fintype.card α)))]; simp [hn] + linarith + +lemma IsMaxChain.one_elt_max_chain_layer [Fintype α] [DecidableEq α] (hn : Fintype.card α = n) (maxchain𝒜 : IsMaxChain (· ⊂ ·) 𝒜) + (j : Finset.range (n + 1)) : #(𝒜 # j) = 1 := by + by_contra! ass + have empty_layer : 𝒜 # j = ∅ := by + cases Nat.le_one_iff_eq_zero_or_eq_one.mp (IsChain.max_one_elt_chain_layer maxchain𝒜.left j) with + | inl h => simp at h; exact h + | inr h => omega + + if htop : ∀ i : Finset.range (n + 1), i > j → 𝒜 # i = ∅ then + have univnotin𝒜 : (Finset.univ : Finset α) ∉ 𝒜 := by + intro ass₂ + have nslicemem : (Finset.univ : Finset α) ∈ 𝒜 # n := by + simp [Finset.slice] + exact ⟨ass₂, hn⟩ + cases Nat.lt_or_ge j n with + | inl jltn => + have nsliceempty : 𝒜 # n = ∅ := htop ⟨n, Finset.mem_range.mpr (Nat.lt_succ_self n)⟩ jltn + simp [nsliceempty] at nslicemem + | inr jgen => + have jeqn : j = n := Nat.eq_of_le_of_lt_succ jgen (Finset.mem_range.1 (by simp)) + rw [jeqn] at empty_layer + simp [empty_layer] at nslicemem + simp [IsMaxChain] at maxchain𝒜 + + have larger_chain_with_univ' : _root_.IsChain (· ⊂ ·) (Insert.insert (Finset.univ : Finset α) 𝒜).toSet := by + have : ((Insert.insert (Finset.univ : Finset α) 𝒜) : Finset (Finset α)).toSet = ((Insert.insert (Finset.univ : Finset α) 𝒜) : Set (Finset α)) := by simp + rw [this] + refine' IsChain.insert maxchain𝒜.left _ + intro b bmem bneq + right + exact Finset.ssubset_iff_subset_ne.mpr ⟨by simp, fun h => bneq h.symm⟩ + + have larger_chain_with_univ : Finset.IsChain (· ⊂ ·) ((Insert.insert (Finset.univ : Finset α) 𝒜) : Finset (Finset α)) := larger_chain_with_univ' + + have univin𝒜 := Finset.insert_eq_self.mp (maxchain𝒜.right larger_chain_with_univ (by simp)).symm + exact univnotin𝒜 univin𝒜 + else if hbottom : ∀ i : Finset.range (n + 1), i < j → 𝒜 # i = ∅ then + have emptynotin𝒜 : (∅ : Finset α) ∉ 𝒜 := by + intro ass₃ + have zeroslicemem : (∅ : Finset α) ∈ 𝒜 # 0 := by + simp [Finset.slice] + exact ass₃ + cases Nat.eq_zero_or_pos j with + | inl jeqzero => + rw [jeqzero] at empty_layer + simp [empty_layer] at zeroslicemem + | inr jgen => + simp [hbottom ⟨0, by simp⟩ jgen] at zeroslicemem + simp [IsMaxChain] at maxchain𝒜 + have larger_chain_with_empty' : _root_.IsChain (· ⊂ ·) ((Insert.insert (∅ : Finset α) 𝒜)).toSet := by + have : ((Insert.insert (∅ : Finset α) 𝒜)).toSet = (Insert.insert (∅ : Finset α) 𝒜.toSet) := by simp + rw [this] + refine' IsChain.insert maxchain𝒜.left _ + intro b bmem bneq + left + exact Finset.ssubset_iff_subset_ne.mpr ⟨by simp, bneq⟩ + + have larger_chain_with_empty : IsChain (· ⊂ ·) ((Insert.insert (∅ : Finset α) 𝒜)) := larger_chain_with_empty' + + have emptyin𝒜 := Finset.insert_eq_self.mp (maxchain𝒜.right larger_chain_with_empty (by simp)).symm + exact emptynotin𝒜 emptyin𝒜 + + else + simp at htop hbottom + let indices_nonempty_top := Finset.filter (fun i : Finset.range (n + 1) ↦ i > j ∧ 𝒜 # i ≠ ∅) (Finset.univ : Finset (Finset.range (n + 1))) + let indices_nonempty_bottom := Finset.filter (fun i : Finset.range (n + 1) ↦ i < j ∧ 𝒜 # i ≠ ∅) (Finset.univ : Finset (Finset.range (n + 1))) + have nonempty_indices_nonempty_top : indices_nonempty_top.Nonempty := by + simp [Finset.Nonempty] + obtain ⟨i, ⟨⟨ilen, jlti⟩, jlayernotempty⟩⟩ := htop + use i + simp [indices_nonempty_top] + constructor + · use ilen + · exact jlayernotempty + + have nonempty_indices_nonempty_bottom : indices_nonempty_bottom.Nonempty := by + simp [Finset.Nonempty] + obtain ⟨i, ⟨⟨ilen, iltj⟩, jlayernotempty⟩⟩ := hbottom + use i + simp [indices_nonempty_bottom] + constructor + · use ilen + · exact jlayernotempty + + obtain ⟨s_top, s_top_min⟩ := Finset.min_of_nonempty nonempty_indices_nonempty_top + have h_s_top := Finset.mem_of_min s_top_min + simp [indices_nonempty_top] at h_s_top + + obtain ⟨s_bottom, s_bottom_max⟩ := Finset.max_of_nonempty nonempty_indices_nonempty_bottom + have h_s_bottom := Finset.mem_of_max s_bottom_max + simp [indices_nonempty_bottom] at h_s_bottom + + have emptylayer : ∀ l ∈ (Finset.range (n + 1)), s_bottom < l → l < s_top → #(𝒜 # l) = 0 := by + intro l lmem s_bottom_lt_l l_lt_s_top + + have h_top : ⟨l, lmem⟩ ∉ indices_nonempty_top := Finset.not_mem_of_lt_min l_lt_s_top s_top_min + have h_bottom : ⟨l, lmem⟩ ∉ indices_nonempty_bottom := Finset.not_mem_of_max_lt s_bottom_lt_l s_bottom_max + + simp [indices_nonempty_top] at h_top + simp [indices_nonempty_bottom] at h_bottom + + simp + + by_cases jeql : j = ⟨l, lmem⟩ + · rw [←empty_layer, jeql] + · cases (Nat.lt_or_gt_of_ne (fun ass : ↑j = l => jeql (by simp [←ass]))) with + | inl jltl => exact h_top jltl + | inr jgtl => exact h_bottom jgtl + + obtain ⟨e_bottom, ⟨bottom_singleton : 𝒜 # s_bottom = {e_bottom}, _⟩⟩ := Chain.layer_singleton_of_nonempty maxchain𝒜.left s_bottom h_s_bottom.right + + obtain ⟨e_top, ⟨top_singleton : 𝒜 # s_top = {e_top}, _⟩⟩ := Chain.layer_singleton_of_nonempty maxchain𝒜.left s_top h_s_top.right + + let extension_candidates := Finset.filter (chain_extension_filter_function 𝒜 e_bottom) (Finset.univ : Finset α) + + have extension_candidates_eq : extension_candidates = e_top \ e_bottom := by + refine' extension_candidates_characterisation hn _ maxchain𝒜.left bottom_singleton top_singleton emptylayer + apply Nat.succ_le_of_lt + have : (s_bottom : ℕ) + 1 ≤ ↑j := Nat.succ_le_of_lt h_s_bottom.left + exact Nat.lt_of_le_of_lt this h_s_top.left + simp at extension_candidates_eq + + have e_bottom_mem_card : e_bottom ∈ 𝒜 ∧ #e_bottom = s_bottom := by + have := Finset.mem_singleton_self e_bottom + rw [←bottom_singleton] at this + simp [slice] at this + exact this + + have e_top_mem_card : e_top ∈ 𝒜 ∧ #e_top = s_top := by + have := Finset.mem_singleton_self e_top + rw [←top_singleton] at this + simp [slice] at this + exact this + + have extension_candidates_ne_empty : #extension_candidates > 0 := by + rw [extension_candidates_eq] + have card_bottom_lt_card_top : #e_bottom < #e_top := by + rw [e_top_mem_card.right, e_bottom_mem_card.right] + exact Nat.lt_trans h_s_bottom.left h_s_top.left + have bottom_subset_top : e_bottom ⊂ e_top := + IsChain.ssubset_of_lt_cardinality maxchain𝒜.left e_bottom_mem_card.left e_top_mem_card.left card_bottom_lt_card_top + have := Finset.card_sdiff_add_card_eq_card bottom_subset_top.left + linarith + simp at extension_candidates_ne_empty + obtain ⟨a, ha⟩ := extension_candidates_ne_empty + simp [extension_candidates, chain_extension_filter_function] at ha + have := Finset.insert_eq_self.mp (maxchain𝒜.right ha.left (by simp)).symm + exact ha.right this + +lemma IsMaxChain.card [Fintype α] [DecidableEq α] {ℬ : Finset (Finset α)} (hn : Fintype.card α = n) + (maxChainℬ : IsMaxChain (· ⊂ ·) ℬ) : ℬ.card = n + 1 := by + rw [←sum_card_slice ℬ] + calc + ∑ r ∈ Iic (Fintype.card α), #(ℬ # r) = ∑ r ∈ Iic (Fintype.card α), 1 := by + apply Finset.sum_congr (by rfl) + intro j jmem + simp [hn] at jmem + exact IsMaxChain.one_elt_max_chain_layer hn maxChainℬ ⟨j, by simp [Nat.lt_succ_of_le jmem]⟩ + _ = n + 1 := by rw [←(Finset.card_eq_sum_ones (Iic (Fintype.card α)))]; simp [hn] + +lemma IsChain.card_le {ℬ : Finset (Finset α)} [Fintype α] (hn : Fintype.card α = n) (chainℬ : IsChain (· ⊂ ·) ℬ) : ℬ.card ≤ n + 1 := by + rw [←sum_card_slice ℬ] + calc + ∑ r ∈ Iic (Fintype.card α), #(ℬ # r) ≤ ∑ r ∈ Iic (Fintype.card α), 1 := by + apply sum_le_sum + intro j jmem + exact IsChain.max_one_elt_chain_layer chainℬ j + _ = n + 1 := by rw [←(Finset.card_eq_sum_ones (Iic (Fintype.card α)))]; simp [hn] + +lemma IsMaxChain.iff_card [Fintype α] [DecidableEq α] {ℬ : Finset (Finset α)} (hn : Fintype.card α = n) + (chainℬ : IsChain (· ⊂ ·) ℬ) : IsMaxChain (· ⊂ ·) ℬ ↔ ℬ.card = n + 1 := by + constructor + · intro maxChainℬ + exact IsMaxChain.card hn maxChainℬ + · intro cardℬ + constructor + · exact chainℬ + · intro 𝒜 chain𝒜 ℬssub𝒜 + have hcard𝒜 : #𝒜 ≤ #ℬ := by + · rw [cardℬ] + exact IsChain.card_le hn chain𝒜 + exact (Finset.subset_iff_eq_of_card_le hcard𝒜).mp ℬssub𝒜 diff --git a/TheBook/ToMathlib/CliqueNumber.lean b/TheBook/ToMathlib/CliqueNumber.lean index 3874ac8..68ddfb2 100644 --- a/TheBook/ToMathlib/CliqueNumber.lean +++ b/TheBook/ToMathlib/CliqueNumber.lean @@ -44,7 +44,6 @@ lemma maximal_of_maximum (s : Finset α) (M : G.IsMaximumClique s) : G.IsMaximal exact lt_irrefl _ (lt_of_lt_of_le hlt hle) } - variable [Fintype α] private lemma fintype_cliqueNum_bddAbove : BddAbove {n | ∃ s, G.IsNClique n s} := by diff --git a/TheBook/ToMathlib/List.lean b/TheBook/ToMathlib/List.lean index 7bce695..2e436e4 100644 --- a/TheBook/ToMathlib/List.lean +++ b/TheBook/ToMathlib/List.lean @@ -1,9 +1,13 @@ import Mathlib.Tactic import Mathlib.Data.List.Perm.Basic +open Function Finset Nat Set BigOperators List + +section Nodup + variable {α : Type*} (r : α → α → Prop) [LE α] [DecidableRel (fun (x₁ x₂ : α) ↦ x₁ ≤ x₂)] -theorem List.Nodup.orderedInsert +lemma List.Nodup.orderedInsert {l : List α} {a : α} (l_nodup : l.Nodup) (a_not_mem : a ∉ l) : (orderedInsert (· ≤ ·) a l).Nodup := by induction l with @@ -35,7 +39,7 @@ theorem List.Nodup.orderedInsert · exact l_nodup.left · exact ih l_nodup.right a_not_mem.right -theorem List.Nodup.insertionSort {l : List α} (h : l.Nodup) : (l.insertionSort (fun (x₁ x₂ : α) ↦ x₁ ≤ x₂)).Nodup := by +lemma List.Nodup.insertionSort {l : List α} (h : l.Nodup) : (l.insertionSort (fun (x₁ x₂ : α) ↦ x₁ ≤ x₂)).Nodup := by induction l with | nil => simp [List.insertionSort, List.Nodup] @@ -47,3 +51,32 @@ theorem List.Nodup.insertionSort {l : List α} (h : l.Nodup) : (l.insertionSort simp at h exact h.left ((List.mem_insertionSort (· ≤ ·)).mp ass) exact List.Nodup.orderedInsert sorted_nodup x_ne_mem_sorted + +end Nodup + +section Perm + +variable {α : Type*} {𝒜 : Finset α} [DecidableEq α] + +lemma Finset.subtype_toList : List.map Subtype.val (Finset.univ : Finset 𝒜).toList ~ 𝒜.toList := by + refine' perm_iff_count.mpr _ + intro a + by_cases h : a ∈ 𝒜 + case pos => + have count_rhs := nodup_iff_count_eq_one.mp 𝒜.nodup_toList a (mem_toList.mpr h) + have count_lhs₀ := count_map_of_injective (Finset.univ : Finset 𝒜).toList Subtype.val Subtype.val_injective ⟨a, h⟩ + have count_lhs₁ := nodup_iff_count_eq_one.mp (Finset.univ : Finset 𝒜).nodup_toList ⟨a, h⟩ (mem_toList.mpr (by simp)) + rw [count_rhs, count_lhs₀, count_lhs₁] + case neg => + have count_rhs := List.count_eq_zero_of_not_mem (fun ass ↦ h (mem_toList.mp ass)) + have count_lhs : List.count a (List.map Subtype.val (Finset.univ : Finset 𝒜).toList) = 0 := by + apply List.count_eq_zero_of_not_mem + by_contra! ass + obtain ⟨x, ⟨x_mem_list, x_eq_a⟩⟩ := List.mem_map.mp ass + + have := x.prop + rw [x_eq_a] at this + exact h this + + rw [count_rhs, count_lhs] +end Perm From ebb6bfb10966487aa906263f3e5591940f897d75 Mon Sep 17 00:00:00 2001 From: Jakob Zimmermann Date: Tue, 28 Jan 2025 11:09:46 +0100 Subject: [PATCH 23/26] adding sections in Chain.lean --- TheBook/Combinatorics/LYM.lean | 1 - .../SpernerHelpingDataStructures.lean | 3 +- .../Combinatorics/SpernerHelpingLemmata.lean | 0 TheBook/ToMathlib/Chain.lean | 178 ++++++++++-------- TheBook/ToMathlib/Chain_optional.lean | 66 ------- 5 files changed, 99 insertions(+), 149 deletions(-) delete mode 100644 TheBook/Combinatorics/SpernerHelpingLemmata.lean delete mode 100644 TheBook/ToMathlib/Chain_optional.lean diff --git a/TheBook/Combinatorics/LYM.lean b/TheBook/Combinatorics/LYM.lean index 347e216..9b57b43 100644 --- a/TheBook/Combinatorics/LYM.lean +++ b/TheBook/Combinatorics/LYM.lean @@ -7,7 +7,6 @@ import Mathlib.Data.Finset.Slice import Mathlib.Order.Antichain import Mathlib.Order.Chain import Mathlib.Data.List.Perm.Basic -import TheBook.ToMathlib.Chain_optional import TheBook.ToMathlib.Chain import TheBook.ToMathlib.Antichain import TheBook.ToMathlib.List diff --git a/TheBook/Combinatorics/SpernerHelpingDataStructures.lean b/TheBook/Combinatorics/SpernerHelpingDataStructures.lean index acf9af8..e889a04 100644 --- a/TheBook/Combinatorics/SpernerHelpingDataStructures.lean +++ b/TheBook/Combinatorics/SpernerHelpingDataStructures.lean @@ -1,4 +1,3 @@ -import TheBook.ToMathlib.Chain_optional import TheBook.ToMathlib.Chain import TheBook.ToMathlib.List @@ -302,7 +301,7 @@ lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Finty let sorted_list := ((Finset.univ : Finset ℬ).toList.insertionSort (fun (e₁ e₂ : ℬ) ↦ #e₁.val ≤ #e₂.val)) obtain ⟨s', t', empty_range : s'.val + 2 ≤ t'.val ∧ #(ℬ # s') = 1 ∧ #(ℬ # t') = 1 ∧ ∀ (j : Fin (n + 1)), s' < j ∧ j < t' → #(ℬ # ↑j) = 0⟩ := - range_empty_layer hn chainℬ (IsChain.empty_layer_by_card hn chainℬ (lt_of_eq_of_lt cardℬ q)) empty_in_chain univ_in_chain + range_empty_layer hn chainℬ (Chain.empty_layer_by_card hn chainℬ (lt_of_eq_of_lt cardℬ q)) empty_in_chain univ_in_chain let s : Finset.range (n + 1) := ⟨s'.val, mem_range.mpr s'.is_lt⟩ let t : Finset.range (n + 1) := ⟨t'.val, mem_range.mpr t'.is_lt⟩ diff --git a/TheBook/Combinatorics/SpernerHelpingLemmata.lean b/TheBook/Combinatorics/SpernerHelpingLemmata.lean deleted file mode 100644 index e69de29..0000000 diff --git a/TheBook/ToMathlib/Chain.lean b/TheBook/ToMathlib/Chain.lean index afb8c9c..4743a83 100644 --- a/TheBook/ToMathlib/Chain.lean +++ b/TheBook/ToMathlib/Chain.lean @@ -1,4 +1,3 @@ -import TheBook.ToMathlib.Chain_optional import TheBook.ToMathlib.List import Mathlib.Data.Finset.Slice import Init.Core @@ -7,10 +6,13 @@ namespace Finset open Function Finset Nat Set BigOperators List -variable {α : Type*} {n m : ℕ} {𝒜 : Finset (Finset α)} (r : α → α → Prop) -local infixl:50 " ≺ " => r +section ChainSubset -lemma IsChain.equivalence_subset_relations : (IsChain (· ⊆ .) 𝒜) ↔ (IsChain (· ⊂ .) 𝒜) := by +/- Here we proof lemmata concerning the poset of the subset relation on sets-/ + +variable {α : Type*} {𝒜 : Finset (Finset α)} + +lemma IsChain.equivalence_subset_relations : (IsChain (· ⊆ .) 𝒜.toSet) ↔ (IsChain (· ⊂ .) 𝒜.toSet) := by constructor · intro h e₁ e₁mem e₂ e₂mem e₁neqe₂ cases h e₁mem e₂mem e₁neqe₂ with @@ -21,21 +23,21 @@ lemma IsChain.equivalence_subset_relations : (IsChain (· ⊆ .) 𝒜) ↔ (IsCh | inl e₁sube₂ => left; exact e₁sube₂.left | inr e₂sube₁ => right; exact e₂sube₁.left -lemma IsMaxChain.equivalence_subset_relations : (IsMaxChain (· ⊆ .) 𝒜) ↔ (IsMaxChain (· ⊂ .) 𝒜) := by +lemma IsMaxChain.equivalence_subset_relations : (IsMaxChain (· ⊆ .) 𝒜.toSet) ↔ (IsMaxChain (· ⊂ .) 𝒜.toSet) := by constructor · intro h exact ⟨IsChain.equivalence_subset_relations.mp h.left, fun t chain => h.right (IsChain.equivalence_subset_relations.mpr chain)⟩ · intro h exact ⟨IsChain.equivalence_subset_relations.mpr h.left, fun t chain => h.right (IsChain.equivalence_subset_relations.mp chain)⟩ -lemma SuperChain.equivalence_subset_relations {ℬ : Finset (Finset α)} : (SuperChain (· ⊆ .) ℬ 𝒜) ↔ (SuperChain (· ⊂ .) ℬ 𝒜) := by +lemma SuperChain.equivalence_subset_relations {ℬ : Finset (Finset α)} : (SuperChain (· ⊆ .) ℬ 𝒜.toSet) ↔ (SuperChain (· ⊂ .) ℬ 𝒜.toSet) := by constructor · intro h exact ⟨IsChain.equivalence_subset_relations.mp h.left, h.right⟩ · intro h exact ⟨IsChain.equivalence_subset_relations.mpr h.left, h.right⟩ -lemma IsChain.unique_of_cardinality_chain (chain𝒜 : IsChain (· ⊂ ·) 𝒜) {a b : Finset α} +lemma IsChain.unique_of_cardinality_chain (chain𝒜 : IsChain (· ⊂ ·) 𝒜.toSet) {a b : Finset α} (amem : a ∈ 𝒜) (bmem : b ∈ 𝒜) (hcard : #a = #b) : a = b := by by_contra aneb cases chain𝒜 amem bmem aneb with @@ -46,7 +48,7 @@ lemma IsChain.unique_of_cardinality_chain (chain𝒜 : IsChain (· ⊂ ·) 𝒜) have := Finset.card_strictMono h linarith -lemma IsChain.max_one_elt_chain_layer (chain𝒜 : IsChain (· ⊂ ·) 𝒜) (j : ℕ) : #(𝒜 # j) ≤ 1 := by +lemma IsChain.max_one_elt_chain_layer (chain𝒜 : IsChain (· ⊂ ·) 𝒜.toSet) (j : ℕ) : #(𝒜 # j) ≤ 1 := by by_contra! ass have : (𝒜 # j) ≠ (∅ : Finset (Finset α)) := by intro assempty @@ -57,9 +59,85 @@ lemma IsChain.max_one_elt_chain_layer (chain𝒜 : IsChain (· ⊂ ·) 𝒜) (j have cardeqab : #a = #b := by rw [(Finset.mem_slice.mp amem).right, (Finset.mem_slice.mp bmem).right] exact aneb (IsChain.unique_of_cardinality_chain chain𝒜 (Finset.slice_subset bmem) (Finset.slice_subset amem) cardeqab.symm) -instance IsChain.sub_is_trans : IsTrans 𝒜 (fun (e₁ e₂ : 𝒜) ↦ e₁.val ⊆ e₂.val) := +instance IsChain.subset_is_trans : IsTrans 𝒜 (fun (e₁ e₂ : 𝒜) ↦ e₁.val ⊆ e₂.val) := ⟨fun _ _ _ h₁ h₂ => subset_trans h₁ h₂⟩ +lemma Chain.layer_singleton_of_nonempty (chain𝒜 : IsChain (· ⊂ ·) 𝒜.toSet) (j : Finset.range (n + 1)) (layer_nonempty : (𝒜 # j) ≠ ∅): + ∃! e : Finset α, 𝒜 # j = {e} := by + have : # (𝒜 # j) = 1 := by + cases Nat.le_one_iff_eq_zero_or_eq_one.mp (IsChain.max_one_elt_chain_layer chain𝒜 j) with + | inl card_zero => + simp at card_zero + exact False.elim (layer_nonempty card_zero) + | inr card_one => exact card_one + obtain ⟨e, he⟩ := Finset.card_eq_one.mp this + have unique : ∀ a : Finset α, 𝒜 # j = {a} → a = e := by + intro a ha + rw [he] at ha + simp at ha + exact ha.symm + + exact ⟨e, he, unique⟩ + +lemma IsChain.ssubset_of_lt_cardinality (chain𝒜 : IsChain (· ⊂ ·) 𝒜.toSet) {e₁ e₂ : Finset α} (e₁mem : e₁ ∈ 𝒜) (e₂mem : e₂ ∈ 𝒜) + (hcard : #e₁ < #e₂) : e₁ ⊂ e₂ := by + have e₁nee₂ : e₁ ≠ e₂ := by + intro ass + have : #e₁ = #e₂ := by rw [ass] + linarith + cases chain𝒜 e₁mem e₂mem e₁nee₂ with + | inl h => exact Finset.ssubset_iff_subset_ne.mpr ⟨h.left, e₁nee₂⟩ + | inr h => + have : #e₂ < #e₁ := Finset.card_strictMono h + linarith + +lemma IsChain.subset_of_le_cardinality (chain𝒜 : IsChain (· ⊂ ·) 𝒜.toSet) {e₁ e₂ : Finset α} (e₁mem : e₁ ∈ 𝒜) (e₂mem : e₂ ∈ 𝒜) + (hcard : #e₁ ≤ #e₂) : e₁ ⊆ e₂ := by + cases Nat.eq_or_lt_of_le hcard with + | inr hcard_lt => + exact (IsChain.ssubset_of_lt_cardinality chain𝒜 e₁mem e₂mem hcard_lt).left + | inl hcard_eq => + exact Finset.subset_of_eq (IsChain.unique_of_cardinality_chain chain𝒜 e₁mem e₂mem hcard_eq) + +end ChainSubset + + +section ChainSubsetFinset + +/- Here we proof lemmata concerning the poset of the subset relation on finite sets-/ + +variable {α : Type*} {𝒜 : Finset (Finset α)} [Fintype α] + +lemma Chain.empty_layer_by_card (hn : Fintype.card α = n) (chain𝒜 : IsChain (· ⊂ ·) 𝒜.toSet) (card𝒜 : #𝒜 < n+1) : ∃ i : Fin (n + 1), #(𝒜 # i) = 0 := by + by_contra! ass + have : ∀ (i : Fin (n + 1)), #(𝒜 # i) = 1 := by + intro i + have non_zero := ass i + cases Nat.le_one_iff_eq_zero_or_eq_one.mp (IsChain.max_one_elt_chain_layer chain𝒜 i) with + | inl h => exfalso; exact (non_zero h) + | inr h => exact h + rw [←sum_card_slice 𝒜] at card𝒜 + have := calc + ∑ r ∈ Iic (Fintype.card α), #(𝒜 # r) = ∑ r ∈ Iic (Fintype.card α), 1 := by + apply Finset.sum_congr (by rfl) + intro j jmem + simp [hn] at jmem + exact this ⟨j, by simp [Nat.lt_succ_of_le jmem]⟩ + _ = n + 1 := by rw [←(Finset.card_eq_sum_ones (Iic (Fintype.card α)))]; simp [hn] + linarith + +end ChainSubsetFinset + +section ChainCardinalityOrder + + +/- + Given a finite chain of finite sets with respect to the subset relation, we consider the list of chain elements. + Here we proof that if this list is sorted with respect to the cardinalities it is actually sorted in a strictly monotone manner. +-/ + +variable {α : Type*} {𝒜 : Finset (Finset α)} + instance card_le : LE (Finset α) where le x y := #x ≤ #y @@ -80,10 +158,7 @@ instance card_le_is_total : IsTotal 𝒜 (fun (e₁ e₂ : 𝒜) ↦ e₁.val instance card_le_is_trans : IsTrans 𝒜 (fun (e₁ e₂ : 𝒜) ↦ e₁.val ≤ e₂.val) := ⟨fun _ _ _ h₁ h₂ ↦ Nat.le_trans h₁ h₂⟩ -instance IsChain.card_le_is_trans : IsTrans 𝒜 (fun (e₁ e₂ : 𝒜) ↦ e₁.val ⊆ e₂.val) := - ⟨fun _ _ _ h₁ h₂ => subset_trans h₁ h₂⟩ - -lemma card_strict_mono' (chain𝒜 : IsChain (· ⊂ ·) 𝒜) : ((Finset.univ : Finset 𝒜).toList.insertionSort (fun (e₁ e₂ : 𝒜) ↦ #e₁.val ≤ #e₂.val)).Sorted (fun (e₁ e₂ : 𝒜) ↦ #e₁.val < #e₂.val) := by +lemma card_strict_mono' (chain𝒜 : IsChain (· ⊂ ·) 𝒜.toSet) : ((Finset.univ : Finset 𝒜).toList.insertionSort (fun (e₁ e₂ : 𝒜) ↦ #e₁.val ≤ #e₂.val)).Sorted (fun (e₁ e₂ : 𝒜) ↦ #e₁.val < #e₂.val) := by apply List.pairwise_iff_get.mpr intro x y xlty let elt_x := ((List.insertionSort (fun (e₁ e₂ : 𝒜) => #e₁.val ≤ #e₂.val) univ.toList).get x) @@ -97,7 +172,7 @@ lemma card_strict_mono' (chain𝒜 : IsChain (· ⊂ ·) 𝒜) : ((Finset.univ : exact elt_x_neq_elt_y elt_x_eq_elt_y -lemma Chain.card_strict_mono [DecidableEq α] (chain𝒜 : IsChain (· ⊂ ·) 𝒜) : ∃ l : List (Finset α), l ~ 𝒜.toList ∧ l.Sorted (#· < #·) := by +theorem Chain.card_strict_mono [DecidableEq α] (chain𝒜 : IsChain (· ⊂ ·) 𝒜.toSet) : ∃ l : List (Finset α), l ~ 𝒜.toList ∧ l.Sorted (#· < #·) := by let l' := ((Finset.univ : Finset 𝒜).toList.insertionSort (fun (e₁ e₂ : 𝒜) ↦ #e₁.val ≤ #e₂.val)) have l'_sorted : l'.Sorted (fun (e₁ e₂ : 𝒜) ↦ #e₁.val < #e₂.val) := card_strict_mono' chain𝒜 @@ -122,84 +197,27 @@ lemma Chain.card_strict_mono [DecidableEq α] (chain𝒜 : IsChain (· ⊂ ·) have := List.pairwise_iff_get.mp l'_sorted (Fin.cast this i) (Fin.cast this j) iltj_coe exact this -lemma Chain.layer_singleton_of_nonempty (chain𝒜 : IsChain (· ⊂ ·) 𝒜) (j : Finset.range (n + 1)) (layer_nonempty : (𝒜 # j) ≠ ∅): - ∃! e : Finset α, 𝒜 # j = {e} := by - have : # (𝒜 # j) = 1 := by - cases Nat.le_one_iff_eq_zero_or_eq_one.mp (IsChain.max_one_elt_chain_layer chain𝒜 j) with - | inl card_zero => - simp at card_zero - exact False.elim (layer_nonempty card_zero) - | inr card_one => exact card_one - obtain ⟨e, he⟩ := Finset.card_eq_one.mp this - have unique : ∀ a : Finset α, 𝒜 # j = {a} → a = e := by - intro a ha - rw [he] at ha - simp at ha - exact ha.symm - - exact ⟨e, he, unique⟩ - -lemma IsChain.ssubset_of_lt_cardinality (chain𝒜 : IsChain (· ⊂ ·) 𝒜) {e₁ e₂ : Finset α} (e₁mem : e₁ ∈ 𝒜) (e₂mem : e₂ ∈ 𝒜) - (hcard : #e₁ < #e₂) : e₁ ⊂ e₂ := by - have e₁nee₂ : e₁ ≠ e₂ := by - intro ass - have : #e₁ = #e₂ := by rw [ass] - linarith - cases chain𝒜 e₁mem e₂mem e₁nee₂ with - | inl h => exact Finset.ssubset_iff_subset_ne.mpr ⟨h.left, e₁nee₂⟩ - | inr h => - have : #e₂ < #e₁ := Finset.card_strictMono h - linarith - -lemma IsChain.subset_of_le_cardinality (chain𝒜 : IsChain (· ⊂ ·) 𝒜) {e₁ e₂ : Finset α} (e₁mem : e₁ ∈ 𝒜) (e₂mem : e₂ ∈ 𝒜) - (hcard : #e₁ ≤ #e₂) : e₁ ⊆ e₂ := by - cases Nat.eq_or_lt_of_le hcard with - | inr hcard_lt => - exact (IsChain.ssubset_of_lt_cardinality chain𝒜 e₁mem e₂mem hcard_lt).left - | inl hcard_eq => - exact Finset.subset_of_eq (IsChain.unique_of_cardinality_chain chain𝒜 e₁mem e₂mem hcard_eq) - +end ChainCardinalityOrder section ChainExtension -variable {α : Type*} [DecidableEq α] [Fintype α] +variable {α : Type*} [DecidableEq α] [Fintype α] {𝒜 : Finset (Finset α)} -def chain_extension_filter_function (𝒜 : Finset (Finset α)) (e : Finset α) : α → Prop := - fun a : α ↦ IsChain (· ⊂ ·) (insert (insert a e) 𝒜) ∧ insert a e ∉ 𝒜 +def chain_extension_filter_function (ℬ : Finset (Finset α)) (e : Finset α) : α → Prop := + fun a : α ↦ IsChain (· ⊂ ·) (insert (insert a e) ℬ) ∧ insert a e ∉ ℬ -variable {𝒜 : Finset (Finset α)} - -instance instDecidableIsChain : Decidable (IsChain (· ⊂ ·) 𝒜) := by +instance instDecidableIsChain : Decidable (IsChain (· ⊂ ·) 𝒜.toSet) := by apply Finset.decidableDforallFinset -instance instDecidablePredChainExtension {𝒜 : Finset (Finset α)} (e : Finset α) : +instance instDecidablePredChainExtension (e : Finset α) : DecidablePred (chain_extension_filter_function 𝒜 e) := - fun a : α => inferInstanceAs (Decidable (IsChain (· ⊂ ·) (insert (insert a e) 𝒜) ∧ insert a e ∉ 𝒜)) + fun a : α => by sorry --inferInstanceAs (Decidable (IsChain (· ⊂ ·) (insert (insert a e) 𝒜).toSet ∧ insert a e ∉ 𝒜)) def extension_candidates (ℬ : Finset (Finset α)) (e : Finset α) := Finset.filter (chain_extension_filter_function ℬ e) (Finset.univ : Finset α) - -lemma IsChain.empty_layer_by_card (hn : Fintype.card α = n) (chain𝒜 : IsChain (· ⊂ ·) 𝒜) (card𝒜 : #𝒜 < n+1) : ∃ i : Fin (n + 1), #(𝒜 # i) = 0 := by - by_contra! ass - have : ∀ (i : Fin (n + 1)), #(𝒜 # i) = 1 := by - intro i - have non_zero := ass i - cases Nat.le_one_iff_eq_zero_or_eq_one.mp (IsChain.max_one_elt_chain_layer chain𝒜 i) with - | inl h => exfalso; exact (non_zero h) - | inr h => exact h - rw [←sum_card_slice 𝒜] at card𝒜 - have := calc - ∑ r ∈ Iic (Fintype.card α), #(𝒜 # r) = ∑ r ∈ Iic (Fintype.card α), 1 := by - apply Finset.sum_congr (by rfl) - intro j jmem - simp [hn] at jmem - exact this ⟨j, by simp [Nat.lt_succ_of_le jmem]⟩ - _ = n + 1 := by rw [←(Finset.card_eq_sum_ones (Iic (Fintype.card α)))]; simp [hn] - linarith - -lemma IsMaxChain.one_elt_max_chain_layer [Fintype α] [DecidableEq α] (hn : Fintype.card α = n) (maxchain𝒜 : IsMaxChain (· ⊂ ·) 𝒜) +lemma IsMaxChain.one_elt_max_chain_layer [Fintype α] [DecidableEq α] (hn : Fintype.card α = n) (maxchain𝒜 : IsMaxChain (· ⊂ ·) 𝒜.toSet) (j : Finset.range (n + 1)) : #(𝒜 # j) = 1 := by by_contra! ass have empty_layer : 𝒜 # j = ∅ := by @@ -231,7 +249,7 @@ lemma IsMaxChain.one_elt_max_chain_layer [Fintype α] [DecidableEq α] (hn : Fin right exact Finset.ssubset_iff_subset_ne.mpr ⟨by simp, fun h => bneq h.symm⟩ - have larger_chain_with_univ : Finset.IsChain (· ⊂ ·) ((Insert.insert (Finset.univ : Finset α) 𝒜) : Finset (Finset α)) := larger_chain_with_univ' + have larger_chain_with_univ : IsChain (· ⊂ ·) ((Insert.insert (Finset.univ : Finset α) 𝒜) : Finset (Finset α)) := larger_chain_with_univ' have univin𝒜 := Finset.insert_eq_self.mp (maxchain𝒜.right larger_chain_with_univ (by simp)).symm exact univnotin𝒜 univin𝒜 diff --git a/TheBook/ToMathlib/Chain_optional.lean b/TheBook/ToMathlib/Chain_optional.lean deleted file mode 100644 index 8457971..0000000 --- a/TheBook/ToMathlib/Chain_optional.lean +++ /dev/null @@ -1,66 +0,0 @@ -import Mathlib.Tactic -import Mathlib.Combinatorics.Enumerative.DoubleCounting -import Mathlib.Combinatorics.Derangements.Finite -import Mathlib.Logic.Equiv.Defs -import Mathlib.Data.Set.Basic -import Mathlib.Data.Finset.Slice -import Mathlib.Order.Antichain -import Mathlib.Order.Chain -import Mathlib.Data.List.Perm.Basic - -open Function Finset Nat Set BigOperators List - -variable {α : Type*} {n m : ℕ} {𝒜 : Finset (Finset α)} (r : α → α → Prop) - -namespace Finset - -/-- In this file, we use `≺` as a local notation for any relation `r`. -/ -local infixl:50 " ≺ " => r - -/- - The following definitions match the ones in Mathlib.Order.Chain, but use Finset in order to be able to carry information on finiteness inside the chain property. --/ - -def IsChain (s : Finset α) : Prop := - s.toSet.Pairwise fun x y => x ≺ y ∨ y ≺ x - -/-- `SuperChain s t` means that `t` is a chain that strictly includes `s`. -/ -def SuperChain (s t : Finset α) : Prop := - IsChain r t ∧ s ⊂ t - -/-- A chain `s` is a maximal chain if there does not exists a chain strictly including `s`. -/ -def IsMaxChain (s : Finset α) : Prop := - IsChain r s ∧ ∀ ⦃t⦄, IsChain r t → s ⊆ t → s = t - -def IsAntichain (r : α → α → Prop) (s : Finset α) : Prop := - s.toSet.Pairwise rᶜ - -end Finset - -variable (ℬ₀ : Set α) (ℬ₁ : Finset α) (r : α → α → Prop) - -/- The usual definition of chains are compatible if used along the toSet method-/ -example (h : Finset.IsChain r ℬ₁) : IsChain r ℬ₁.toSet := h -example (h : IsChain r ℬ₁.toSet) : Finset.IsChain r ℬ₁ := h - -instance [Fintype ℬ₀] : Coe (IsChain r ℬ₀) (Finset.IsChain r ℬ₀.toFinset) := - ⟨fun h ↦ (fun _ hx _ hy xneqy ↦ h (Set.mem_toFinset.mp hx) (Set.mem_toFinset.mp hy) xneqy)⟩ - -example [Fintype ℬ₀] (h : IsChain r ℬ₀) : Finset.IsChain r ℬ₀.toFinset := h - -instance [Fintype α] : Fintype (Finset α) := { - elems := Finset.powerset (@Finset.univ α _), - complete := by simp -} - -noncomputable instance [Fintype α] : Fintype ℬ₀ := Fintype.ofFinite ↑ℬ₀ -noncomputable instance [Fintype α] : Coe (Set α) (Finset α) := ⟨fun s ↦ s.toFinset⟩ -noncomputable example [Fintype α] (𝒟 : Set α) : Finset α := 𝒟 - -instance [Fintype α] : Coe (_root_.IsChain r ℬ₀) (Finset.IsChain r ℬ₀.toFinset) := - ⟨fun h ↦ (fun _ hx _ hy xneqy ↦ h (Set.mem_toFinset.mp hx) (Set.mem_toFinset.mp hy) xneqy)⟩ - -instance [Fintype α] : Fintype (Set α) := { - elems := (Finset.powerset (@Finset.univ α _)).map ⟨Finset.toSet, Finset.coe_injective⟩, - complete := by intro x; simp; use x.toFinset; simp -} From 03bb9a16843f99a4eb34ccffdcca416e357f4645 Mon Sep 17 00:00:00 2001 From: Jakob Zimmermann Date: Thu, 30 Jan 2025 00:25:40 +0100 Subject: [PATCH 24/26] changed project structure and variable assumptions. Work directly on sets instead of Finsets --- TheBook/Combinatorics/LYM.lean | 23 +- .../SpernerHelpingDataStructures.lean | 464 ++++++++------- TheBook/ToMathlib/Antichain.lean | 9 +- TheBook/ToMathlib/Chain.lean | 544 ++++++++++++------ TheBook/ToMathlib/List.lean | 17 +- TheBook/ToMathlib/Slice.lean | 27 + 6 files changed, 657 insertions(+), 427 deletions(-) create mode 100644 TheBook/ToMathlib/Slice.lean diff --git a/TheBook/Combinatorics/LYM.lean b/TheBook/Combinatorics/LYM.lean index 9b57b43..0a08ed8 100644 --- a/TheBook/Combinatorics/LYM.lean +++ b/TheBook/Combinatorics/LYM.lean @@ -14,16 +14,17 @@ import TheBook.Combinatorics.SpernerHelpingDataStructures open Function Finset Nat Set BigOperators List -variable {α : Type*} {n m : ℕ} {𝒜 : Finset (Finset α)} [Fintype α] [DecidableEq α] +variable {α : Type*} {n m : ℕ} [DecidableEq α] [Fintype α] {𝒜 : Set (Finset α)} [DecidablePred (· ∈ 𝒜)] [DecidableEq (Set (Finset α))] +instance : Fintype 𝒜 := setFintype 𝒜 namespace Finset /-- The **Lubell-Yamamoto-Meshalkin inequality**. Sperner's Theorem follows as in Mathlib.Combinatorics.SetFamily.LYM as a corollary -/ theorem lym_inequality (antichain𝒜 : IsAntichain (· ⊂ ·) 𝒜) (hn : Fintype.card α = n): - ∑ k ∈ Iic n, #(𝒜 # k) / (n.choose k : ℚ) ≤ (1 : ℚ) := by - have : ∑ k ∈ Iic n, #(𝒜 # k) / (n.choose k : ℚ) ≤ (∑ k ∈ Iic n, #(𝒜 # k) * (k)! * (n - k)!) * (1 / (n)! : ℚ) := by + ∑ k ∈ Iic n, #(𝒜.toFinset # k) / (n.choose k : ℚ) ≤ (1 : ℚ) := by + have : ∑ k ∈ Iic n, #(𝒜.toFinset # k) / (n.choose k : ℚ) ≤ (∑ k ∈ Iic n, #(𝒜.toFinset # k) * (k)! * (n - k)!) * (1 / (n)! : ℚ) := by calc - ∑ k ∈ Iic n, #(𝒜 # k) / (n.choose k : ℚ) = ∑ k ∈ Iic n, #(𝒜 # k) * (k)! * (n - k)! * (1 / (n)! : ℚ) := by + ∑ k ∈ Iic n, #(𝒜.toFinset # k) / (n.choose k : ℚ) = ∑ k ∈ Iic n, #(𝒜.toFinset # k) * (k)! * (n - k)! * (1 / (n)! : ℚ) := by apply Finset.sum_congr (by simp) intro j jmem simp at jmem @@ -41,7 +42,7 @@ theorem lym_inequality (antichain𝒜 : IsAntichain (· ⊂ ·) 𝒜) (hn : Fint · norm_num constructor <;> apply Nat.factorial_ne_zero · exact jmem - _ = (∑ k ∈ Iic n, #(𝒜 # k) * (k)! * (n - k)!) * (1 / (n)! : ℚ) := by simp [←Finset.sum_mul] + _ = (∑ k ∈ Iic n, #(𝒜.toFinset # k) * (k)! * (n - k)!) * (1 / (n)! : ℚ) := by simp [←Finset.sum_mul] rfl refine' le_trans this _ @@ -50,17 +51,17 @@ theorem lym_inequality (antichain𝒜 : IsAntichain (· ⊂ ·) 𝒜) (hn : Fint norm_cast - have slice_partition : Finset.disjiUnion (Iic n) 𝒜.slice (Finset.pairwiseDisjoint_slice.subset (Set.subset_univ _)) = 𝒜 := by - rw [Finset.disjiUnion_eq_biUnion (Iic n) 𝒜.slice (Finset.pairwiseDisjoint_slice.subset (Set.subset_univ _))] + have slice_partition : Finset.disjiUnion (Iic n) 𝒜.toFinset.slice (Finset.pairwiseDisjoint_slice.subset (Set.subset_univ _)) = 𝒜.toFinset := by + rw [Finset.disjiUnion_eq_biUnion (Iic n) 𝒜.toFinset.slice (Finset.pairwiseDisjoint_slice.subset (Set.subset_univ _))] rw [←hn] - have := biUnion_slice 𝒜 + have := biUnion_slice 𝒜.toFinset exact this calc - ∑ k ∈ Iic n, #(𝒜 # k) * (k)! * (n - k)! = ∑ k ∈ Iic n, ∑ e ∈ (𝒜 # k), (#e)! * (n - #e)! := by + ∑ k ∈ Iic n, #(𝒜.toFinset # k) * (k)! * (n - k)! = ∑ k ∈ Iic n, ∑ e ∈ (𝒜.toFinset # k), (#e)! * (n - #e)! := by apply Finset.sum_congr (by simp) intro k _ - have hq : ∀ e ∈ (𝒜 # k), (#e)! * (n - #e)! = (k)! * (n - k)! := by + have hq : ∀ e ∈ (𝒜.toFinset # k), (#e)! * (n - #e)! = (k)! * (n - k)! := by intro e he simp [slice] at he rw [he.2] @@ -81,5 +82,5 @@ theorem lym_inequality (antichain𝒜 : IsAntichain (· ⊂ ·) 𝒜) (hn : Fint apply Finset.sum_congr (by simp) intro e e_mem rw [Finset.card_image_of_injective (Finset.univ : Finset (MaxChainThrough {e})) inj_emb_MaxChainThrough, Finset.card_univ] - _ = #(𝒜.disjiUnion (fun e : Finset α ↦ (Finset.univ : Finset (MaxChainThrough {e})).image (emb_MaxChainThrough {e})) (AntiChain.disj_union_chain_through antichain𝒜)) + _ = #(𝒜.toFinset.disjiUnion (fun e : Finset α ↦ (Finset.univ : Finset (MaxChainThrough {e})).image (emb_MaxChainThrough {e})) (by simp [AntiChain.disj_union_chain_through antichain𝒜])) := by sorry _ ≤ (n)! := by sorry diff --git a/TheBook/Combinatorics/SpernerHelpingDataStructures.lean b/TheBook/Combinatorics/SpernerHelpingDataStructures.lean index e889a04..3fbe254 100644 --- a/TheBook/Combinatorics/SpernerHelpingDataStructures.lean +++ b/TheBook/Combinatorics/SpernerHelpingDataStructures.lean @@ -3,208 +3,80 @@ import TheBook.ToMathlib.List open Function Finset Nat Set BigOperators List -variable {α : Type*} {n m : ℕ} {𝒜 : Finset (Finset α)} (𝒞₀ : Set α) (𝒞₁ : Finset α) [Fintype 𝒞₀] +variable {α : Type*} {n m : ℕ} {𝒜 ℬ : Set (Finset α)} + +set_option maxHeartbeats 500000 namespace Finset -structure MaxChainThrough (ℬ : Finset (Finset α)) where - 𝒜 : Finset (Finset α) - isMaxChain : Finset.IsMaxChain (· ⊂ ·) 𝒜 +section MaxChainThrough + +/- + In this section we define the maximal chains with respect to the subset relation that extend a given chain. + Further in the finite case we give an explicit formula for the number of such maximal extensions. +-/ + +structure MaxChainThrough (ℬ : Set (Finset α)) where + 𝒜 : Set (Finset α) + isMaxChain : IsMaxChain (· ⊂ ·) 𝒜 subChain : ℬ ⊆ 𝒜 -def emb_MaxChainThrough (ℬ : Finset (Finset α)) (X : ℬ.MaxChainThrough) : Finset (Finset α) := X.𝒜 +def emb_MaxChainThrough (ℬ : Set (Finset α)) (X : MaxChainThrough ℬ) : Set (Finset α) := X.𝒜 -@[ext] lemma MaxChainThrough_eq {ℬ : Finset (Finset α)} (𝒞₁ 𝒞₂ : ℬ.MaxChainThrough) (hA : 𝒞₁.𝒜 = 𝒞₂.𝒜) : 𝒞₁ = 𝒞₂ := by +@[ext] lemma MaxChainThrough_eq (𝒞₁ 𝒞₂ : MaxChainThrough ℬ) (hA : 𝒞₁.𝒜 = 𝒞₂.𝒜) : 𝒞₁ = 𝒞₂ := by cases 𝒞₁ cases 𝒞₂ congr -lemma inj_emb_MaxChainThrough {ℬ : Finset (Finset α)} : Injective (emb_MaxChainThrough ℬ) := by +lemma inj_emb_MaxChainThrough : Injective (emb_MaxChainThrough ℬ) := by intro 𝒞₁ 𝒞₂ h unfold emb_MaxChainThrough at h ext rw [h] -instance instFintypeMaxChainThrough {ℬ : Finset (Finset α)} : Fintype (MaxChainThrough ℬ) := by sorry - -variable [Fintype α] [DecidableEq α] [DecidableEq (Finset (Finset α))] [DecidableEq (Finset α)] - -lemma range_empty_layer (hn : Fintype.card α = n) (chain𝒜 : IsChain (· ⊂ ·) 𝒜) (empty_layer : ∃ i : Fin (n + 1), #(𝒜 # i) = 0) (empty_elt : ∅ ∈ 𝒜) (univ_elt : Finset.univ ∈ 𝒜) : - ∃ s : Fin (n + 1), ∃ t : Fin (n + 1), s.val + 2 ≤ t.val ∧ #(𝒜 # s) = 1 ∧ #(𝒜 # t) = 1 ∧ ∀ j : Fin (n + 1), s < j ∧ j < t → #(𝒜 # j) = 0 := by sorry +instance instFintypeMaxChainThrough : Fintype (MaxChainThrough ℬ) := by sorry -lemma mem_card_of_slice {ℬ : Finset (Finset α)} (h : (ℬ # s) = {layer_s}) : layer_s ∈ ℬ ∧ #layer_s = s := by - have := Finset.mem_singleton_self layer_s - rw [←h] at this - simp [slice] at this - exact this +variable [Fintype α] [DecidableEq α] [DecidableEq (Set (Finset α))] -lemma extension_candidates_characterisation (hn : Fintype.card α = n) {i j : Finset.range (n + 1)} (ilej_succ_succ : (i : ℕ) + 2 ≤ (j : ℕ)) (chain𝒜 : IsChain (· ⊂ ·) 𝒜) - (hi : (𝒜 # i) = {layer_i}) (hj : (𝒜 # j) = {layer_j}) (emptylayer : ∀ l ∈ (Finset.range (n + 1)), i < l → l < j → #(𝒜 # l) = 0): - extension_candidates 𝒜 layer_i = layer_j \ layer_i := by - unfold extension_candidates +instance {C : MaxChainThrough ℬ} : DecidablePred (· ∈ C.𝒜) := by sorry +instance : DecidablePred (· ∈ ℬ) := by sorry +instance : DecidablePred (· ∈ 𝒜) := by sorry - have layer_j_mem_card := mem_card_of_slice hj - have layer_i_mem_card := mem_card_of_slice hi +instance {C : MaxChainThrough ℬ} : Fintype C.𝒜 := setFintype C.𝒜 - ext x - let e_new := insert x layer_i - have he_new : e_new = insert x layer_i := rfl +instance : Fintype ℬ := setFintype ℬ +instance : Fintype 𝒜 := setFintype 𝒜 - have e_new_card_lt_layer_j_card: #e_new < #layer_j := by - rw [layer_j_mem_card.right] - have : #e_new ≤ #layer_i + 1 := by - simp only [e_new] - exact Finset.card_insert_le x layer_i - rw [layer_i_mem_card.right] at this - apply Nat.lt_of_le_of_lt this - exact Nat.succ_le_of_lt ilej_succ_succ - - constructor - · intro hx - simp [chain_extension_filter_function] at hx - - simp [←he_new] at hx - have e_new_neq_layer_j : e_new ≠ layer_j := by - intro ass - have := layer_j_mem_card.left - rw [←ass] at this - exact hx.right this - simp - constructor - · have e_new_mem : e_new ∈ insert e_new 𝒜 := by simp - have layer_j_mem_insert : layer_j ∈ insert e_new 𝒜 := by - simp - right - exact layer_j_mem_card.left - have e_new_sub_layer_j := IsChain.subset_of_le_cardinality hx.left e_new_mem layer_j_mem_insert (Nat.le_of_lt e_new_card_lt_layer_j_card) - rw [he_new] at e_new_sub_layer_j - exact e_new_sub_layer_j (mem_insert_self x layer_i) - · intro x_mem_layer_i - have := layer_i_mem_card.left - rw [←(Finset.insert_eq_self.mpr x_mem_layer_i)] at this - exact hx.right this - · intro hx - simp at hx - simp [chain_extension_filter_function] - - have case_helper {e₁ e₂ : Finset α} (e₁neqe₂ : e₁ ≠ e₂) (e₂_not_new : e₂ ∈ 𝒜) (e₁_new : e₁ = e_new) : e₁ ⊂ e₂ ∨ e₂ ⊂ e₁ := by - have := chain𝒜 layer_i_mem_card.left e₂_not_new - by_cases h : layer_i = e₂ - · right - rw [←h, e₁_new, he_new] - apply Finset.ssubset_iff_subset_ne.mpr - constructor - · simp - · exact (Finset.insert_ne_self.mpr hx.right).symm - · cases chain𝒜 e₂_not_new layer_i_mem_card.left (fun q => h q.symm) with - | inl e₂_sub_layer_i => - right - simp at e₂_sub_layer_i - rw [e₁_new, he_new] - refine' Finset.ssubset_of_ssubset_of_subset e₂_sub_layer_i _ - apply Finset.subset_insert - | inr layer_i_sub_e₂ => - simp at layer_i_sub_e₂ - left - by_contra e₂_sub_e₁ - - have e₁_sub_e₂ : e₁ ⊆ e₂ := by - rw [e₁_new, he_new] - have layer_j_card_le_e₂_card : #layer_j ≤ #e₂ := by - rw [layer_j_mem_card.right] - by_contra! - have e₂_card_gt_i : #e₂ > ↑i := by - rw [←layer_i_mem_card.right] - exact Finset.card_strictMono layer_i_sub_e₂ - have e₂_card_lt_n_succ : #e₂ < n + 1 := by - apply Nat.lt_succ_of_le - rw [←hn] - apply Finset.card_le_univ - have e₂_empty_layer := emptylayer #e₂ (by simp; exact e₂_card_lt_n_succ) e₂_card_gt_i this - simp at e₂_empty_layer - have : e₂ ∈ 𝒜 # #e₂ := by simpa [slice] - simp [e₂_empty_layer] at this - - have layer_j_sub_e₂ := IsChain.subset_of_le_cardinality chain𝒜 layer_j_mem_card.left e₂_not_new layer_j_card_le_e₂_card - - apply Finset.insert_subset - · exact layer_j_sub_e₂ hx.left - · have : #layer_i ≤ #e₂ := by - rw [layer_i_mem_card.right] - rw [layer_j_mem_card.right] at layer_j_card_le_e₂_card - exact Nat.le_trans (Nat.le_of_lt (Nat.lt_of_succ_lt ilej_succ_succ)) layer_j_card_le_e₂_card - - exact IsChain.subset_of_le_cardinality chain𝒜 layer_i_mem_card.left e₂_not_new this - - have : ¬(e₁ ⊆ e₂ ∧ e₁ ≠ e₂) := fun q => e₂_sub_e₁ (Finset.ssubset_iff_subset_ne.mpr q) - simp at this - exact e₁neqe₂ (this e₁_sub_e₂) - - constructor - · intro e₁ e₁mem e₂ e₂mem e₁neqe₂ - simp [←he_new] at e₁mem e₂mem - simp - cases e₁mem with - | inl e₁_new => - cases e₂mem with - | inl e₂_new => - rw [←e₂_new] at e₁_new - left - exact Finset.ssubset_iff_subset_ne.mpr ⟨Finset.subset_of_eq e₁_new, e₁neqe₂⟩ - | inr e₂_not_new => - exact case_helper e₁neqe₂ e₂_not_new e₁_new - | inr e₁_not_new => - cases e₂mem with - | inl e₂_new => - apply Or.symm - exact case_helper e₁neqe₂.symm e₁_not_new e₂_new - | inr e₂_not_new => - exact chain𝒜 e₁_not_new e₂_not_new e₁neqe₂ - - · intro e_new_mem_𝒜 - have e_new_card_gt_layer_i : #e_new > i := by simp [Finset.card_insert_of_not_mem hx.right, layer_i_mem_card.right] - - rw [layer_j_mem_card.right] at e_new_card_lt_layer_j_card - have : #(𝒜 # #e_new) = 0 := by - refine' emptylayer #e_new _ e_new_card_gt_layer_i e_new_card_lt_layer_j_card - · simp - exact Nat.lt_trans e_new_card_lt_layer_j_card (mem_range.mp j.property) - have : (𝒜 # #e_new).Nonempty := by - have : e_new ∈ 𝒜 # #e_new := by simpa [slice] - exact nonempty_of_mem this - have : #(𝒜 # #e_new) > 0 := Finset.card_pos.mpr this - linarith - -lemma card_maxChainThrough {ℬ : Finset (Finset α)} (hn : Fintype.card α = n) (chain : MaxChainThrough ℬ) : #chain.𝒜 = n + 1 := by - rw [←sum_card_slice chain.𝒜] +lemma card_maxChainThrough (hn : Fintype.card α = n) (chain : MaxChainThrough ℬ) : #chain.𝒜.toFinset = n + 1 := by + rw [←sum_card_slice chain.𝒜.toFinset] calc - ∑ r ∈ Iic (Fintype.card α), #(chain.𝒜 # r) = ∑ r ∈ Iic (Fintype.card α), 1 := by - apply Finset.sum_congr (by rfl) + ∑ r ∈ Iic (Fintype.card α), #(chain.𝒜.toFinset # r) = ∑ r ∈ Iic (Fintype.card α), 1 := by + apply sum_congr (by rfl) intro j jmem simp [hn] at jmem exact IsMaxChain.one_elt_max_chain_layer hn chain.isMaxChain ⟨j, by simp [Nat.lt_succ_of_le jmem]⟩ - _ = n + 1 := by rw [←(Finset.card_eq_sum_ones (Iic (Fintype.card α)))]; simp [hn] + _ = n + 1 := by rw [←(card_eq_sum_ones (Iic (Fintype.card α)))]; simp [hn] -lemma first_entry {ℬ : Finset (Finset α)} (list : List (Finset α)) - (monotone_cards: List.Sorted (fun (e₁ e₂) ↦ #e₁ < #e₂) list) (h_list: ℬ.toList ~ list) - (empty_in_chain : ∅ ∈ ℬ) : list[0]'(by sorry) = ∅ := by sorry +lemma first_entry (list : List (Finset α)) + (monotone_cards: List.Sorted (fun (e₁ e₂) ↦ #e₁ < #e₂) list) (h_list: ℬ.toFinset.toList ~ list) + (empty_in_chain : ∅ ∈ ℬ) : list[0]'(by rw [←Perm.length_eq h_list]; exact length_pos_of_mem (mem_toList.mpr (mem_toFinset.mpr empty_in_chain))) = ∅ := by sorry -lemma last_entry {list : List (Finset α)} {ℬ : Finset (Finset α)} - (monotone_cards: List.Sorted (fun (e₁ e₂) ↦ #e₁ < #e₂) list) (h_list: ℬ.toList ~ list) +lemma last_entry {list : List (Finset α)} + (monotone_cards: List.Sorted (fun (e₁ e₂) ↦ #e₁ < #e₂) list) (h_list: ℬ.toFinset.toList ~ list) (univ_in_chain : univ ∈ ℬ) : list[list.length - 1]'(by sorry) = univ := by sorry -lemma incident_indices_monotone_cards {n: ℕ} {s t : Fin (n + 1)} {ℬ : Finset (Finset α)} (ilej_succ_succ : s.val + 2 ≤ t.val) (list : List (Finset α)) +lemma incident_indices_monotone_cards {s t : Fin (n + 1)} {ℬ : Finset (Finset α)} (ilej_succ_succ : s.val + 2 ≤ t.val) (list : List (Finset α)) (monotone_cards: List.Sorted (fun (e₁ e₂) ↦ #e₁ < #e₂) list) (h_list: ℬ.toList ~ list) (hs : (ℬ # s) = {layer_s}) (ht : (ℬ # t) = {layer_t}) (empty_layer : ∀ j : Fin (n + 1), s < j → j < t → #(ℬ # ↑j) = 0) : ∃ i_s : Fin (list.length - 1), list[i_s.val] = layer_s ∧ list[i_s.val + 1] = layer_t := by let i_s := list.indexOf layer_s - have i_s_in_range : i_s < list.length := List.indexOf_lt_length.mpr (h_list.subset (mem_toList.mpr (mem_card_of_slice hs).left)) + have i_s_in_range : i_s < list.length := List.indexOf_lt_length.mpr (h_list.subset (mem_toList.mpr (Slice.singleton_explicit.mp hs).left)) have h_i_s : list[i_s] = layer_s := list.indexOf_get i_s_in_range let i_t := list.indexOf layer_t - have i_t_in_range : i_t < list.length := List.indexOf_lt_length.mpr (h_list.subset (mem_toList.mpr (mem_card_of_slice ht).left)) + have i_t_in_range : i_t < list.length := List.indexOf_lt_length.mpr (h_list.subset (mem_toList.mpr (Slice.singleton_explicit.mp ht).left)) have h_i_t : list[i_t] = layer_t := list.indexOf_get i_t_in_range simp at i_t_in_range @@ -227,7 +99,7 @@ lemma incident_indices_monotone_cards {n: ℕ} {s t : Fin (n + 1)} {ℬ : Finset exact le_of_lt this simp [h_i_s, h_i_t] at this have : t.val ≤ s.val := by - simp [←(mem_card_of_slice hs).right, ←(mem_card_of_slice ht).right] + simp [←(Slice.singleton_explicit.mp hs).right.left, ←(Slice.singleton_explicit.mp ht).right.left] exact this linarith have i_s_succ_lt : i_s + 1 < i_t := Nat.lt_of_le_of_ne this fun a => ass₁ (id (Eq.symm a)) @@ -236,13 +108,13 @@ lemma incident_indices_monotone_cards {n: ℕ} {s t : Fin (n + 1)} {ℬ : Finset have e_card_gt' : #e > s := by have := (List.pairwise_iff_get.mp monotone_cards) ⟨i_s, by simpa⟩ ⟨i_s + 1, by apply Nat.lt_trans i_s_succ_lt; simpa ⟩ (by simp : i_s < i_s + 1) - simp [h_i_s, (mem_card_of_slice hs).right] at this + simp [h_i_s, (Slice.singleton_explicit.mp hs).right.left] at this unfold e exact this have e_card_lt' : #e < t := by have := (List.pairwise_iff_get.mp monotone_cards) ⟨i_s + 1, by apply Nat.lt_trans i_s_succ_lt; simpa⟩ ⟨i_t, by simpa⟩ i_s_succ_lt - simp [h_i_t, (mem_card_of_slice ht).right] at this + simp [h_i_t, (Slice.singleton_explicit.mp ht).right.left] at this exact this have card_e_mod : #e % (n + 1) = #e := mod_eq_of_lt (Nat.lt_trans e_card_lt' t.is_lt) @@ -272,46 +144,121 @@ lemma incident_indices_monotone_cards {n: ℕ} {s t : Fin (n + 1)} {ℬ : Finset simp only [i_s_eq_i_t_succ] at h_i_t exact ⟨h_i_s, h_i_t⟩ -def extensions_wrt (ℬ : Finset (Finset α)) (e : Finset α) (x : α) : Finset (Finset (Finset α)) := by - let ℬ' : Finset (Finset α) := Insert.insert (Insert.insert x e) ℬ - exact (Finset.univ : Finset ℬ'.MaxChainThrough).image (emb_MaxChainThrough ℬ') +def extensions_wrt [DecidableEq (Set (Finset α))] [DecidableEq (Finset α)] (ℬ : Set (Finset α)) (e : Finset α) (x : α) : Finset (Set (Finset α)) := by + let ℬ' := Insert.insert (Insert.insert x e) ℬ + let e := (emb_MaxChainThrough ℬ') + exact (univ : Finset (MaxChainThrough ℬ')).image (emb_MaxChainThrough ℬ') + +variable [DecidableEq (Set (Finset α))] [DecidableEq (Finset α)] -lemma chain_through_extension_candidates_pairwiseDisjoint (ℬ : Finset (Finset α)) (e : Finset α) (e_mem : e ∈ ℬ) : PairwiseDisjoint (extension_candidates ℬ e) (extensions_wrt ℬ e) := by +lemma chain_through_extension_candidates_pairwiseDisjoint {e : Finset α} (e_mem : e ∈ ℬ) : PairwiseDisjoint (extension_candidates ℬ e) (extensions_wrt ℬ e) := by intro x hx y hy xneqy simp [_root_.Disjoint] simp [extensions_wrt] intro A hA_x hA_y intro 𝒜 h𝒜 + simp + + simp [extension_candidates,chain_extension_filter_function] at hx hy + have a_extension_e_x := hA_x h𝒜 have a_extension_e_y := hA_y h𝒜 - sorry + simp at a_extension_e_x a_extension_e_y + + obtain ⟨𝒜_x, image_𝒜_x⟩ := a_extension_e_x + obtain ⟨𝒜_y, image_𝒜_y⟩ := a_extension_e_y + + unfold emb_MaxChainThrough at image_𝒜_x image_𝒜_y + + have x_e_mem_𝒜_y : (insert x e) ∈ 𝒜_y.𝒜 := by + rw [image_𝒜_y, ←image_𝒜_x] + apply 𝒜_x.subChain + simp -lemma central_identity {ℬ : Finset (Finset α)} (e : Finset α) (e_mem : e ∈ ℬ) : - Finset.univ.image (emb_MaxChainThrough ℬ) = (extension_candidates ℬ e).disjiUnion (extensions_wrt ℬ e) - (chain_through_extension_candidates_pairwiseDisjoint ℬ e e_mem) := by sorry + have y_e_mem_𝒜_y : (insert y e) ∈ 𝒜_y.𝒜 := by apply 𝒜_y.subChain; simp + + have x_nmem : x ∉ e := by + by_contra! ass + rw [insert_eq_of_mem ass] at hx + exact hx.right e_mem + + have y_nmem : y ∉ e := by + by_contra! ass + rw [insert_eq_of_mem ass] at hy + exact hy.right e_mem + + have eq_card : #(insert x e) = #(insert y e) := by + rw [Finset.card_insert_of_not_mem x_nmem, Finset.card_insert_of_not_mem y_nmem] + + have : y = x ∨ y ∈ e := by + apply mem_insert.mp + rw [IsChain.unique_of_cardinality_chain 𝒜_y.isMaxChain.left x_e_mem_𝒜_y y_e_mem_𝒜_y eq_card] + exact mem_insert_self y e + + cases this with + | inl h => exact xneqy h.symm + | inr h => exact y_nmem h + +lemma central_identity (e : Finset α) (e_mem : e ∈ ℬ) (h : extension_candidates ℬ e ≠ ∅): + (univ : Finset (MaxChainThrough ℬ)).image (emb_MaxChainThrough ℬ) = (extension_candidates ℬ e).disjiUnion (extensions_wrt ℬ e) + (chain_through_extension_candidates_pairwiseDisjoint e_mem) := by + ext + constructor + · intro 𝒜_mem_image + simp at 𝒜_mem_image -lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Fintype.card α = n) - (ℬ : Finset (Finset α)) (cardℬ : #ℬ = m) (chainℬ : IsChain (· ⊂ ·) ℬ) (empty_in_chain : ∅ ∈ ℬ) (univ_in_chain : univ ∈ ℬ) - (list : List (Finset α)) (list_per : ℬ.toList ~ list) (list_sorted : list.Sorted (#· < #·)): - Fintype.card (ℬ.MaxChainThrough) = ∏ j : Fin (list.length - 1), (#list[j.val + 1] - #list[j.val])! := by + simp [extension_candidates, chain_extension_filter_function, extensions_wrt] + + have e_card_lt := (extension_candidates_nonempty rfl h).left + + obtain ⟨C,C_emb⟩ := 𝒜_mem_image + simp [emb_MaxChainThrough] at C_emb + + have card_next := IsMaxChain.one_elt_max_chain_layer rfl C.isMaxChain ⟨#e + 1, mem_range.mpr ((add_lt_add_iff_right 1).mpr e_card_lt)⟩ + obtain ⟨u, hu⟩ := card_eq_one.mp card_next + + have u_slice := mem_singleton_self u + rw [←hu] at u_slice + simp [slice] at u_slice + + have card_e_lt_u : #e < #u := by sorry + + have e_ssub_u := IsChain.ssubset_of_lt_cardinality C.isMaxChain.left (C.subChain e_mem) u_slice.left card_e_lt_u + + obtain ⟨a, ha⟩ := sdiff_nonempty.mpr (not_subset_of_ssubset e_ssub_u) + + use a + + constructor + · sorry + · sorry + · sorry + +lemma range_empty_layer (hn : Fintype.card α = n) (chain𝒜 : IsChain (· ⊂ ·) 𝒜) (empty_layer : ∃ i : Fin (n + 1), #(𝒜.toFinset # i) = 0) (empty_elt : ∅ ∈ 𝒜) (univ_elt : univ ∈ 𝒜) : + ∃ s : Fin (n + 1), ∃ t : Fin (n + 1), s.val + 2 ≤ t.val ∧ #(𝒜.toFinset # s) = 1 ∧ #(𝒜.toFinset # t) = 1 ∧ ∀ j : Fin (n + 1), s < j ∧ j < t → #(𝒜.toFinset # j) = 0 := by sorry + +lemma count_maxChainsThrough (h_mn : m ≤ n + 1) (hn : Fintype.card α = n) + (cardℬ : #ℬ.toFinset = m) (chainℬ : IsChain (· ⊂ ·) ℬ) (empty_in_chain : ∅ ∈ ℬ) (univ_in_chain : univ ∈ ℬ) + (list : List (Finset α)) (list_per : ℬ.toFinset.toList ~ list) (list_sorted : list.Sorted (#· < #·)): + Fintype.card (MaxChainThrough ℬ) = ∏ j : Fin (list.length - 1), (#list[j.val + 1] - #list[j.val])! := by revert ℬ list induction' h_mn using decreasingInduction with n_ q ih - · intro ℬ cardℬ chainℬ empty_in_chain univ_in_chain list list_sorted list_per + · intro ℬ cardℬ chainℬ empty_in_chain univ_in_chain list list_per list_sorted - let sorted_list := ((Finset.univ : Finset ℬ).toList.insertionSort (fun (e₁ e₂ : ℬ) ↦ #e₁.val ≤ #e₂.val)) + let sorted_list := ((univ : Finset ℬ).toList.insertionSort (fun (e₁ e₂ : ℬ) ↦ #e₁.val ≤ #e₂.val)) - obtain ⟨s', t', empty_range : s'.val + 2 ≤ t'.val ∧ #(ℬ # s') = 1 ∧ #(ℬ # t') = 1 ∧ ∀ (j : Fin (n + 1)), s' < j ∧ j < t' → #(ℬ # ↑j) = 0⟩ := - range_empty_layer hn chainℬ (Chain.empty_layer_by_card hn chainℬ (lt_of_eq_of_lt cardℬ q)) empty_in_chain univ_in_chain + obtain ⟨s', t', empty_range : s'.val + 2 ≤ t'.val ∧ #(ℬ.toFinset # s') = 1 ∧ #(ℬ.toFinset # t') = 1 ∧ ∀ (j : Fin (n + 1)), s' < j ∧ j < t' → #(ℬ.toFinset # ↑j) = 0⟩ := + range_empty_layer hn chainℬ (by sorry) empty_in_chain univ_in_chain - let s : Finset.range (n + 1) := ⟨s'.val, mem_range.mpr s'.is_lt⟩ - let t : Finset.range (n + 1) := ⟨t'.val, mem_range.mpr t'.is_lt⟩ + let s : range (n + 1) := ⟨s'.val, mem_range.mpr s'.is_lt⟩ + let t : range (n + 1) := ⟨t'.val, mem_range.mpr t'.is_lt⟩ have ilej_succ_succ : (s : ℕ) + 2 ≤ (t : ℕ) := by simp [empty_range.left] - obtain ⟨layer_t, ht : (ℬ # t) = {layer_t}⟩ := Finset.card_eq_one.mp empty_range.right.right.left - obtain ⟨layer_s, hs : (ℬ # s) = {layer_s}⟩ := Finset.card_eq_one.mp empty_range.right.left + obtain ⟨layer_t, ht : (ℬ.toFinset # t) = {layer_t}⟩ := card_eq_one.mp empty_range.right.right.left + obtain ⟨layer_s, hs : (ℬ.toFinset # s) = {layer_s}⟩ := card_eq_one.mp empty_range.right.left - have empty_layer' : ∀ j ∈ Finset.range (n + 1), s < j → j < t → #(ℬ # ↑j) = 0 := by + have empty_layer' : ∀ j ∈ range (n + 1), s < j → j < t → #(ℬ.toFinset # ↑j) = 0 := by simp intro j jinrange jgt jlt @@ -323,7 +270,7 @@ lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Finty simp [jmod] at this exact this - have empty_layer : ∀ j : Fin (n + 1), s' < j → j < t' → #(ℬ # ↑j) = 0 := by + have empty_layer : ∀ j : Fin (n + 1), s' < j → j < t' → #(ℬ.toFinset # ↑j) = 0 := by simp intro j jgt jlt @@ -332,17 +279,17 @@ lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Finty simp at this exact this - let extension_candidates := Finset.filter (chain_extension_filter_function ℬ layer_s) (Finset.univ : Finset α) + let extension_candidates := extension_candidates ℬ layer_s have extension_candidates_eq : extension_candidates = layer_t \ layer_s := by refine' extension_candidates_characterisation hn ilej_succ_succ chainℬ hs ht empty_layer' - have layer_s_mem_card := mem_card_of_slice hs - have layer_t_mem_card := mem_card_of_slice ht + have layer_s_mem_card := Slice.singleton_explicit.mp hs + have layer_t_mem_card := Slice.singleton_explicit.mp ht have := list_per - obtain ⟨i_s, ⟨entry_i_s, entry_i_s_succ⟩⟩ := incident_indices_monotone_cards ilej_succ_succ list list_per list_sorted hs ht empty_layer + obtain ⟨i_s, ⟨entry_i_s, entry_i_s_succ⟩⟩ := incident_indices_monotone_cards ilej_succ_succ list list_sorted list_per hs ht empty_layer have i_s_in_range : i_s < list.length := Nat.lt_of_lt_of_le i_s.is_lt (Nat.pred_le list.length) have i_s_succ_in_range : i_s.val + 1 < list.length := add_lt_of_lt_sub i_s.is_lt @@ -351,23 +298,23 @@ lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Finty let multiplicant (j : Fin (list.length - 1)) : ℕ := (#list[j.val + 1] - #list[j.val])! have extension_candidates_card : #extension_candidates = #list[i_s.val + 1] - #list[i_s.val] := by - rw [entry_i_s, entry_i_s_succ, layer_s_mem_card.right, layer_t_mem_card.right] + rw [entry_i_s, entry_i_s_succ, layer_s_mem_card.right.left, layer_t_mem_card.right.left] rw [extension_candidates_eq] have card_bottom_lt_card_top : #layer_s < #layer_t := by - rw [layer_s_mem_card.right, layer_t_mem_card.right] + rw [layer_s_mem_card.right.left, layer_t_mem_card.right.left] linarith have bottom_subset_top : layer_s ⊂ layer_t := - IsChain.ssubset_of_lt_cardinality chainℬ layer_s_mem_card.left layer_t_mem_card.left card_bottom_lt_card_top - have := Finset.card_sdiff_add_card_eq_card bottom_subset_top.left - rw [←layer_s_mem_card.right, ←layer_t_mem_card.right] + IsChain.ssubset_of_lt_cardinality chainℬ (mem_toFinset.mp layer_s_mem_card.left) (mem_toFinset.mp layer_t_mem_card.left) card_bottom_lt_card_top + have := card_sdiff_add_card_eq_card bottom_subset_top.left + rw [←layer_s_mem_card.right.left, ←layer_t_mem_card.right.left] exact Nat.eq_sub_of_add_eq this - let 𝒬 := (Finset.univ : Finset (Fin (list.length - 1))) + let 𝒬 := (univ : Finset (Fin (list.length - 1))) let 𝒬' := 𝒬 \ {i_s} - let extensions_wrt (x : α) : Finset (Finset (Finset α)) := by - let ℬ' : Finset (Finset α) := Insert.insert (Insert.insert x layer_s) ℬ - exact (Finset.univ : Finset ℬ'.MaxChainThrough).image (emb_MaxChainThrough ℬ') + let extensions_wrt (x : α) : Finset (Set (Finset α)) := by + let ℬ' : Set (Finset α) := Insert.insert (Insert.insert x layer_s) ℬ + exact (univ : Finset (MaxChainThrough ℬ')).image (emb_MaxChainThrough ℬ') /- Here the induction hypothesis ih is applied-/ have card_extensions_wrt (a : extension_candidates) : #(extensions_wrt a) = (multiplicant' i_s) * ∏ j ∈ 𝒬', (multiplicant j) := by @@ -375,39 +322,40 @@ lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Finty let ℬ' := (Insert.insert e_new ℬ) have a_property₁ := a.prop - simp only [extension_candidates, mem_filter, chain_extension_filter_function] at a_property₁ + simp only [extension_candidates, Finset.extension_candidates, mem_filter, chain_extension_filter_function] at a_property₁ have a_property₂ := a.prop simp [extension_candidates_eq] at a_property₂ have card_e_new : #e_new = s + 1 := by - have := layer_s_mem_card.right + have := layer_s_mem_card.right.left simp [s] at this simp [e_new, ←this] apply card_insert_of_not_mem · exact a_property₂.right - have ℬ'card : #ℬ' = n_ + 1 := by - simp [ℬ', ←cardℬ] - apply Finset.card_insert_of_not_mem - · exact a_property₁.right.right + have ℬ'card : #ℬ'.toFinset = n_ + 1 := by + simp only [ℬ', ←cardℬ, e_new] + sorry + -- have := card_insert_of_not_mem a_property₁.right.right + -- · exact a_property₁.right.right - obtain ⟨list', ⟨list_per' : list' ~ (insert e_new ℬ).toList, list_sorted' ⟩⟩ := Chain.card_strict_mono a_property₁.right.left - have embedding_card := Finset.card_image_of_injective (Finset.univ : Finset (MaxChainThrough ℬ')) inj_emb_MaxChainThrough + obtain ⟨list', ⟨list_per' : list' ~ (insert e_new ℬ).toFinset.toList, list_sorted' ⟩⟩ := Chain.card_strict_mono a_property₁.right.left + have embedding_card := card_image_of_injective (univ : Finset (MaxChainThrough ℬ')) inj_emb_MaxChainThrough simp [extensions_wrt, embedding_card] have empty_in_chain' : ∅ ∈ ℬ' := by simp [ℬ']; exact mem_insert_iff.mpr (Or.inr empty_in_chain) have univ_in_chain' : univ ∈ ℬ' := by simp [ℬ']; exact mem_insert_iff.mpr (Or.inr univ_in_chain) let i_new := list'.indexOf e_new - have := list_per'.symm.subset (mem_toList.mpr (mem_insert_self e_new ℬ)) + have := list_per'.symm.subset (mem_toList.mpr (mem_toFinset.mpr (Set.mem_insert e_new ℬ))) - have := (mem_toList.mpr (mem_insert_self e_new ℬ)) - have i_new_in_range : i_new < list'.length := (List.indexOf_lt_length.mpr (list_per'.symm.subset (mem_toList.mpr (mem_insert_self e_new ℬ)))) + have := (mem_toList.mpr (mem_insert_self e_new ℬ.toFinset)) + have i_new_in_range : i_new < list'.length := (List.indexOf_lt_length.mpr (list_per'.symm.subset (mem_toList.mpr (mem_toFinset.mpr (Set.mem_insert e_new ℬ))))) have h_i_new : list'[i_new] = e_new := list'.indexOf_get i_new_in_range let i_univ := list'.indexOf univ - have i_univ_in_range : i_univ < list'.length := List.indexOf_lt_length.mpr (list_per'.symm.subset (mem_toList.mpr univ_in_chain')) + have i_univ_in_range : i_univ < list'.length := List.indexOf_lt_length.mpr (list_per'.symm.subset (mem_toList.mpr (mem_toFinset.mpr univ_in_chain'))) have h_i_univ : list'[i_univ] = univ := list'.indexOf_get i_univ_in_range have i_new_lt_i_univ' : (⟨i_new, i_new_in_range⟩ : Fin list'.length) < (⟨i_univ, i_univ_in_range⟩ : Fin list'.length) := by @@ -439,20 +387,20 @@ lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Finty let i_new' : Fin (list'.length - 1) := ⟨i_new, i_new_lt_i_univ_pred⟩ let i_new'_pred : Fin (list'.length - 1) := ⟨i_new - 1, Nat.lt_of_le_of_lt (Nat.pred_le i_new) i_new_lt_i_univ_pred⟩ - have ind_present : Fintype.card (ℬ'.MaxChainThrough) = ∏ j : Fin (list'.length - 1), (#list'[j.val + 1] - #list'[j.val])! := - ih ℬ' ℬ'card a_property₁.right.left empty_in_chain' univ_in_chain' list' list_per'.symm list_sorted' + have ind_present : Fintype.card (MaxChainThrough ℬ') = ∏ j : Fin (list'.length - 1), (#list'[j.val + 1] - #list'[j.val])! := + ih ℬ'card a_property₁.right.left empty_in_chain' univ_in_chain' list' list_per'.symm list_sorted' have product_split : ∏ j : Fin (list'.length - 1), (#list'[j.val + 1] - #list'[j.val])! = (#list'[i_new'.val + 1] - #list'[i_new'.val])! * ∏ j ∈ univ \ {i_new'}, (#list'[j.val + 1] - #list'[j.val])! := - Finset.prod_eq_mul_prod_diff_singleton (by simp) (fun (i : Fin (list'.length - 1)) ↦ (#list'[i.val + 1] - #list'[i.val])!) + prod_eq_mul_prod_diff_singleton (by simp) (fun (i : Fin (list'.length - 1)) ↦ (#list'[i.val + 1] - #list'[i.val])!) rw [ind_present, product_split] - have prod_identity : ∏ j ∈ (Finset.univ : Finset (Fin (list'.length - 1))) \ {i_new'}, (#list'[j.val + 1] - #list'[j.val])! = ∏ j ∈ 𝒬', multiplicant j := by + have prod_identity : ∏ j ∈ (univ : Finset (Fin (list'.length - 1))) \ {i_new'}, (#list'[j.val + 1] - #list'[j.val])! = ∏ j ∈ 𝒬', multiplicant j := by calc - ∏ j ∈ (Finset.univ : Finset (Fin (list'.length - 1))) \ {i_new'}, (#list'[j.val + 1] - #list'[j.val])! - = (#list'[i_new'_pred.val + 1] - #list'[i_new'_pred.val])! * ∏ j ∈ ((Finset.univ : Finset (Fin (list'.length - 1))) \ {i_new'}) \ {i_new'_pred}, (#list'[j.val + 1] - #list'[j.val])! := by - refine' Finset.prod_eq_mul_prod_diff_singleton _ (fun (i : Fin (list'.length - 1)) ↦ (#list'[i.val + 1] - #list'[i.val])!) + ∏ j ∈ (univ : Finset (Fin (list'.length - 1))) \ {i_new'}, (#list'[j.val + 1] - #list'[j.val])! + = (#list'[i_new'_pred.val + 1] - #list'[i_new'_pred.val])! * ∏ j ∈ ((univ : Finset (Fin (list'.length - 1))) \ {i_new'}) \ {i_new'_pred}, (#list'[j.val + 1] - #list'[j.val])! := by + refine' prod_eq_mul_prod_diff_singleton _ (fun (i : Fin (list'.length - 1)) ↦ (#list'[i.val + 1] - #list'[i.val])!) apply mem_sdiff.mpr constructor · simp @@ -467,21 +415,29 @@ lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Finty simp [←ass, h_i_new] at list_first_entry unfold e_new at list_first_entry - have := nonempty_iff_ne_empty.mp (Finset.insert_nonempty a.val layer_s) + have := nonempty_iff_ne_empty.mp (insert_nonempty a.val layer_s) exact this list_first_entry - _ = 1 * ∏ j ∈ ((Finset.univ : Finset (Fin (list'.length - 1))) \ {i_new'}) \ {i_new'_pred}, (#list'[j.val + 1] - #list'[j.val])! := by + _ = 1 * ∏ j ∈ ((univ : Finset (Fin (list'.length - 1))) \ {i_new'}) \ {i_new'_pred}, (#list'[j.val + 1] - #list'[j.val])! := by congr sorry sorry sorry - -- have mul_identity : multiplicant' i_s = (#list'[↑i_new' + 1] - #list'[↑i_new'])! := by sorry + --have mul_identity : multiplicant' i_s = (#list'[↑i_new' + 1] - #list'[↑i_new'])! := by sorry + + have : extension_candidates ≠ ∅ := by + by_contra! ass + have equality : #extension_candidates = 0 := by simp [ass] + rw [extension_candidates_card] at equality + have : #list[i_s.val + 1] = #list[i_s.val] := by sorry + have inequality := (pairwise_iff_getElem.mp list_sorted) i_s.val (i_s.val + 1) i_s_in_range i_s_succ_in_range (Nat.lt_succ_self i_s.val) + linarith - have central_identity := central_identity layer_s layer_s_mem_card.left + have central_identity := central_identity layer_s (mem_toFinset.mp layer_s_mem_card.left) (by sorry) - have := Finset.card_image_of_injective (Finset.univ : Finset ℬ.MaxChainThrough) inj_emb_MaxChainThrough + have := card_image_of_injective (univ : Finset (MaxChainThrough ℬ)) inj_emb_MaxChainThrough rw [Fintype.card, ←this, central_identity, card_disjiUnion] @@ -492,29 +448,29 @@ lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Finty intro x hx exact card_extensions_wrt ⟨x, hx⟩ _ = (multiplicant i_s) * ∏ j ∈ 𝒬', (multiplicant j) := by - simp [Finset.sum_const, extension_candidates_card, multiplicant'] + simp [sum_const, extension_candidates_card, multiplicant'] rw [←mul_assoc] congr simp [multiplicant] apply mul_factorial_pred _ - · simp [entry_i_s, entry_i_s_succ, layer_s_mem_card.right, layer_t_mem_card.right] + · simp [entry_i_s, entry_i_s_succ, layer_s_mem_card.right.left, layer_t_mem_card.right.left] have : s'.val < t'.val := by linarith [empty_range.left] exact this _ = (multiplicant i_s) * ∏ j ∈ 𝒬', (multiplicant j) := by simp _ = ∏ j ∈ 𝒬, (multiplicant j) := by simp [𝒬'] have : i_s ∈ 𝒬 := by simp [𝒬] - exact (Finset.prod_eq_mul_prod_diff_singleton this multiplicant).symm + exact (prod_eq_mul_prod_diff_singleton this multiplicant).symm _ = ∏ j ∈ 𝒬, (#list[j.val + 1] - #list[j.val])! := by apply prod_congr (by simp) intro x hx rfl - · intro ℬ cardℬ chainℬ empty_in_chain univ_in_chain list list_sorted list_perm + · intro ℬ cardℬ chainℬ empty_in_chain univ_in_chain list list_perm list_sorted have entry_cards : ∀ j : Fin (list.length - 1), #list[j.val] = j.val := by sorry have rhs_one := by calc ∏ j : Fin (list.length - 1), (#list[j.val + 1] - #list[j.val])! = ∏ j : Fin (list.length - 1), 1 := by - apply Finset.prod_congr (by simp) + apply prod_congr (by simp) intro j _ rw [entry_cards, entry_cards ⟨j + 1, by sorry⟩] simp @@ -531,4 +487,46 @@ lemma count_maxChainsThrough {n: ℕ} (m : ℕ) (h_mn : m ≤ n + 1) (hn : Finty rcases X with ⟨X.𝒜, b, c⟩ simpa -lemma count_maxChains_through_singleton (e : Finset α) (hn : Fintype.card α = n): Fintype.card (MaxChainThrough {e}) = (#e)! * (n - #e)! := by sorry +lemma count_maxChains_through_singleton_insert_empty : Fintype.card (MaxChainThrough ℬ) = Fintype.card (MaxChainThrough (insert ∅ ℬ)) := by sorry + +lemma count_maxChains_through_singleton_insert_univ : Fintype.card (MaxChainThrough ℬ) = Fintype.card (MaxChainThrough (insert univ ℬ)) := by sorry + +lemma count_maxChains_through_empty (hn : Fintype.card α = n): Fintype.card (MaxChainThrough {(∅ : Finset α)}) = n! := by sorry + +lemma count_maxChains_through_univ (hn : Fintype.card α = n): Fintype.card (MaxChainThrough {(Finset.univ : Finset α)}) = n! := by sorry + +lemma count_maxChains_through_singleton (e : Finset α) (hn : Fintype.card α = n): Fintype.card (MaxChainThrough {e}) = (#e)! * (n - #e)! := by + by_cases e_empty : ∅ ≠ e + · by_cases e_univ : univ ≠ e + · let 𝒞 : Set (Finset α) := {∅, univ, e} + have req : #𝒞.toFinset ≤ n + 1 := by sorry + have empty_in_chain : ∅ ∈ 𝒞 := Set.mem_insert ∅ {univ, e} + have univ_in_chain : univ ∈ 𝒞 := by sorry + have chain_singleton : IsChain (· ⊂ ·) 𝒞 := by sorry + + obtain ⟨list, ⟨list_per, list_sorted⟩⟩ := Chain.card_strict_mono chain_singleton + + have := count_maxChainsThrough req hn rfl chain_singleton empty_in_chain univ_in_chain list list_per.symm list_sorted + + rw [count_maxChains_through_singleton_insert_univ, count_maxChains_through_singleton_insert_empty, this] + + have list_length : list.length = 3 := by + calc + list.length = 𝒞.toFinset.toList.length := Perm.length_eq list_per + _ = #𝒞.toFinset := length_toList 𝒞.toFinset + _ = 𝒞.ncard := Eq.symm (ncard_eq_toFinset_card' 𝒞) + _ = 3 := by + refine' ncard_eq_three.mpr _ + use ∅, univ, e + have : ∅ ≠ (univ : Finset α) := by sorry + exact ⟨this, e_empty, e_univ, by simp⟩ + + sorry + · sorry + · sorry + + + + + +end MaxChainThrough diff --git a/TheBook/ToMathlib/Antichain.lean b/TheBook/ToMathlib/Antichain.lean index a02075d..b0130bd 100644 --- a/TheBook/ToMathlib/Antichain.lean +++ b/TheBook/ToMathlib/Antichain.lean @@ -2,12 +2,13 @@ import TheBook.Combinatorics.SpernerHelpingDataStructures open Function Finset Nat Set BigOperators List -variable {α : Type*} {n m : ℕ} {𝒜 : Finset (Finset α)} [DecidableEq α] +variable {α : Type*} [Fintype α] {𝒜 : Set (Finset α)} [DecidablePred (· ∈ 𝒜)] [DecidableEq (Set (Finset α))] +instance : Fintype 𝒜 := setFintype 𝒜 namespace Finset lemma AntiChain.disj_union_chain_through (anti_chain : IsAntichain (· ⊂ ·) 𝒜) : - 𝒜.toSet.PairwiseDisjoint (fun e ↦ ((Finset.univ : Finset (MaxChainThrough {e})).image (emb_MaxChainThrough {e}))) := by + 𝒜.PairwiseDisjoint (fun e ↦ ((Finset.univ : Finset (MaxChainThrough {e})).image (emb_MaxChainThrough {e}))) := by intro e₁ e₁_mem_𝒜 e₂ e₂_mem_𝒜 e₁neqe₂ simp [onFun] @@ -17,8 +18,8 @@ lemma AntiChain.disj_union_chain_through (anti_chain : IsAntichain (· ⊂ ·) obtain ⟨C₁, ⟨_, C₁_image⟩⟩ := mem_image.mp C_mem₁ obtain ⟨C₂, ⟨_, C₂_image⟩⟩ := mem_image.mp C_mem₂ - have e₁_mem_C₁ := singleton_subset_iff.mp C₁.subChain - have e₂_mem_C₂ := singleton_subset_iff.mp C₂.subChain + have e₁_mem_C₁ := Set.singleton_subset_iff.mp C₁.subChain + have e₂_mem_C₂ := Set.singleton_subset_iff.mp C₂.subChain unfold emb_MaxChainThrough at C₁_image C₂_image rw [C₂_image, ←C₁_image] at e₂_mem_C₂ diff --git a/TheBook/ToMathlib/Chain.lean b/TheBook/ToMathlib/Chain.lean index 4743a83..08e49a9 100644 --- a/TheBook/ToMathlib/Chain.lean +++ b/TheBook/ToMathlib/Chain.lean @@ -1,5 +1,7 @@ import TheBook.ToMathlib.List +import TheBook.ToMathlib.Slice import Mathlib.Data.Finset.Slice +import Mathlib.Data.Fintype.Basic import Init.Core namespace Finset @@ -8,39 +10,69 @@ open Function Finset Nat Set BigOperators List section ChainSubset -/- Here we proof lemmata concerning the poset of the subset relation on sets-/ +/- Here we proof lemmata concerning the poset of the subset relation on sets of any type-/ -variable {α : Type*} {𝒜 : Finset (Finset α)} +variable {α : Type*} {𝒜 : Finset (Finset α)} {ℬ : Finset (Set α)} {𝒞 : Set (Finset α)} {𝒟 : Set (Set α)} -lemma IsChain.equivalence_subset_relations : (IsChain (· ⊆ .) 𝒜.toSet) ↔ (IsChain (· ⊂ .) 𝒜.toSet) := by +instance : Coe (IsChain (· ⊂ ·) 𝒞) (IsChain (· ⊂ ·) (toSet '' 𝒞)) := ⟨ by + intro h + intro x hx y hy x_neg_y + obtain ⟨x', hx'⟩ := hx + obtain ⟨y', hy'⟩ := hy + have x'_neg_y' : x' ≠ y' := by + by_contra ass + rw [ass] at hx' + rw [←hx'.right, hy'.right] at x_neg_y + simp at x_neg_y + + simp [←hx'.right, ←hy'.right] + exact h hx'.left hy'.left x'_neg_y' +⟩ + +instance : Coe (IsChain (· ⊂ ·) (toSet '' 𝒞)) (IsChain (· ⊂ ·) 𝒞) := + ⟨ fun h _ hx _ hy x_neg_y ↦ h (Set.mem_image_of_mem toSet hx) (Set.mem_image_of_mem toSet hy) (fun ass ↦ x_neg_y (coe_inj.mp ass))⟩ + +instance : Coe (IsChain (· ⊆ ·) (toSet '' 𝒞)) (IsChain (· ⊆ ·) 𝒞) := + ⟨ fun h _ hx _ hy x_neg_y ↦ h (Set.mem_image_of_mem toSet hx) (Set.mem_image_of_mem toSet hy) (fun ass ↦ x_neg_y (coe_inj.mp ass))⟩ + +instance : Coe (IsChain (· ⊂ ·) (toSet '' 𝒞)) (IsChain (· ⊂ ·) 𝒞) := ⟨ by + intro h + intro x hx y hy x_neg_y + exact h (Set.mem_image_of_mem toSet hx) (Set.mem_image_of_mem toSet hy) (fun ass ↦ x_neg_y (coe_inj.mp ass)) +⟩ + +instance [Fintype 𝒞] : Coe (IsChain (· ⊂ ·) 𝒞) (IsChain (· ⊂ ·) 𝒞.toFinset.toSet) := ⟨ by + intro h x hx Real.young_inequality hy x_neg_y + simp at hx hy + exact h hx hy x_neg_y +⟩ + +lemma IsChain.equivalence_subset_relations : (IsChain (· ⊆ .) 𝒟) ↔ (IsChain (· ⊂ .) 𝒟) := by constructor · intro h e₁ e₁mem e₂ e₂mem e₁neqe₂ cases h e₁mem e₂mem e₁neqe₂ with - | inl e₁sube₂ => left; exact Finset.ssubset_iff_subset_ne.mpr ⟨e₁sube₂, e₁neqe₂⟩ - | inr e₂sube₁ => right; exact Finset.ssubset_iff_subset_ne.mpr ⟨e₂sube₁, e₁neqe₂.symm⟩ + | inl e₁sube₂ => left; exact Set.ssubset_iff_subset_ne.mpr ⟨e₁sube₂, e₁neqe₂⟩ + | inr e₂sube₁ => right; exact Set.ssubset_iff_subset_ne.mpr ⟨e₂sube₁, e₁neqe₂.symm⟩ · intro h e₁ e₁mem e₂ e₂mem e₁neqe₂ cases h e₁mem e₂mem e₁neqe₂ with | inl e₁sube₂ => left; exact e₁sube₂.left | inr e₂sube₁ => right; exact e₂sube₁.left -lemma IsMaxChain.equivalence_subset_relations : (IsMaxChain (· ⊆ .) 𝒜.toSet) ↔ (IsMaxChain (· ⊂ .) 𝒜.toSet) := by +example (h : IsChain (· ⊂ ·) 𝒞) : (IsChain (· ⊆ ·) (toSet '' 𝒞)) := IsChain.equivalence_subset_relations.mpr h + +example (h : IsChain (· ⊂ ·) 𝒞) : (IsChain (· ⊆ ·) 𝒞) := (IsChain.equivalence_subset_relations.mpr h : IsChain (· ⊆ ·) (toSet '' 𝒞)) + +lemma IsMaxChain.equivalence_subset_relations : (IsMaxChain (· ⊆ .) 𝒟) ↔ (IsMaxChain (· ⊂ .) 𝒟) := by constructor · intro h exact ⟨IsChain.equivalence_subset_relations.mp h.left, fun t chain => h.right (IsChain.equivalence_subset_relations.mpr chain)⟩ · intro h exact ⟨IsChain.equivalence_subset_relations.mpr h.left, fun t chain => h.right (IsChain.equivalence_subset_relations.mp chain)⟩ -lemma SuperChain.equivalence_subset_relations {ℬ : Finset (Finset α)} : (SuperChain (· ⊆ .) ℬ 𝒜.toSet) ↔ (SuperChain (· ⊂ .) ℬ 𝒜.toSet) := by - constructor - · intro h - exact ⟨IsChain.equivalence_subset_relations.mp h.left, h.right⟩ - · intro h - exact ⟨IsChain.equivalence_subset_relations.mpr h.left, h.right⟩ - -lemma IsChain.unique_of_cardinality_chain (chain𝒜 : IsChain (· ⊂ ·) 𝒜.toSet) {a b : Finset α} - (amem : a ∈ 𝒜) (bmem : b ∈ 𝒜) (hcard : #a = #b) : a = b := by +lemma IsChain.unique_of_cardinality_chain (chain𝒞 : IsChain (· ⊂ ·) 𝒞) {a b : Finset α} + (amem : a ∈ 𝒞) (bmem : b ∈ 𝒞) (hcard : #a = #b) : a = b := by by_contra aneb - cases chain𝒜 amem bmem aneb with + cases chain𝒞 amem bmem aneb with | inl h => have := Finset.card_strictMono h linarith @@ -48,30 +80,31 @@ lemma IsChain.unique_of_cardinality_chain (chain𝒜 : IsChain (· ⊂ ·) 𝒜. have := Finset.card_strictMono h linarith -lemma IsChain.max_one_elt_chain_layer (chain𝒜 : IsChain (· ⊂ ·) 𝒜.toSet) (j : ℕ) : #(𝒜 # j) ≤ 1 := by +lemma IsChain.max_one_elt_chain_layer [Fintype 𝒞] (chain𝒞 : IsChain (· ⊂ ·) 𝒞) (j : ℕ) : #(𝒞.toFinset # j) ≤ 1 := by by_contra! ass - have : (𝒜 # j) ≠ (∅ : Finset (Finset α)) := by + have : (𝒞.toFinset # j) ≠ (∅ : Finset (Finset α)) := by intro assempty have := Finset.card_eq_zero.mpr assempty linarith obtain ⟨a, amem⟩ := Finset.nonempty_iff_ne_empty.mpr this obtain ⟨b, ⟨bmem, aneb⟩⟩ := Finset.exists_mem_ne ass a have cardeqab : #a = #b := by rw [(Finset.mem_slice.mp amem).right, (Finset.mem_slice.mp bmem).right] - exact aneb (IsChain.unique_of_cardinality_chain chain𝒜 (Finset.slice_subset bmem) (Finset.slice_subset amem) cardeqab.symm) + have := Finset.slice_subset (bmem) + exact aneb (IsChain.unique_of_cardinality_chain chain𝒞 (mem_toFinset.mp (Finset.slice_subset bmem)) (mem_toFinset.mp (Finset.slice_subset amem)) cardeqab.symm) instance IsChain.subset_is_trans : IsTrans 𝒜 (fun (e₁ e₂ : 𝒜) ↦ e₁.val ⊆ e₂.val) := ⟨fun _ _ _ h₁ h₂ => subset_trans h₁ h₂⟩ -lemma Chain.layer_singleton_of_nonempty (chain𝒜 : IsChain (· ⊂ ·) 𝒜.toSet) (j : Finset.range (n + 1)) (layer_nonempty : (𝒜 # j) ≠ ∅): - ∃! e : Finset α, 𝒜 # j = {e} := by - have : # (𝒜 # j) = 1 := by - cases Nat.le_one_iff_eq_zero_or_eq_one.mp (IsChain.max_one_elt_chain_layer chain𝒜 j) with +lemma Chain.layer_singleton_of_nonempty [Fintype 𝒞] (chain𝒞 : IsChain (· ⊂ ·) 𝒞) (j : Finset.range (n + 1)) (layer_nonempty : (𝒞.toFinset # j) ≠ ∅): + ∃! e : Finset α, 𝒞.toFinset # j = {e} := by + have : # (𝒞.toFinset # j) = 1 := by + cases Nat.le_one_iff_eq_zero_or_eq_one.mp (IsChain.max_one_elt_chain_layer chain𝒞 j) with | inl card_zero => simp at card_zero exact False.elim (layer_nonempty card_zero) | inr card_one => exact card_one obtain ⟨e, he⟩ := Finset.card_eq_one.mp this - have unique : ∀ a : Finset α, 𝒜 # j = {a} → a = e := by + have unique : ∀ a : Finset α, 𝒞.toFinset # j = {a} → a = e := by intro a ha rw [he] at ha simp at ha @@ -79,161 +112,256 @@ lemma Chain.layer_singleton_of_nonempty (chain𝒜 : IsChain (· ⊂ ·) 𝒜.to exact ⟨e, he, unique⟩ -lemma IsChain.ssubset_of_lt_cardinality (chain𝒜 : IsChain (· ⊂ ·) 𝒜.toSet) {e₁ e₂ : Finset α} (e₁mem : e₁ ∈ 𝒜) (e₂mem : e₂ ∈ 𝒜) +lemma IsChain.ssubset_of_lt_cardinality (chain𝒞 : IsChain (· ⊂ ·) 𝒞) {e₁ e₂ : Finset α} (e₁mem : e₁ ∈ 𝒞) (e₂mem : e₂ ∈ 𝒞) (hcard : #e₁ < #e₂) : e₁ ⊂ e₂ := by have e₁nee₂ : e₁ ≠ e₂ := by intro ass have : #e₁ = #e₂ := by rw [ass] linarith - cases chain𝒜 e₁mem e₂mem e₁nee₂ with + cases chain𝒞 e₁mem e₂mem e₁nee₂ with | inl h => exact Finset.ssubset_iff_subset_ne.mpr ⟨h.left, e₁nee₂⟩ | inr h => have : #e₂ < #e₁ := Finset.card_strictMono h linarith -lemma IsChain.subset_of_le_cardinality (chain𝒜 : IsChain (· ⊂ ·) 𝒜.toSet) {e₁ e₂ : Finset α} (e₁mem : e₁ ∈ 𝒜) (e₂mem : e₂ ∈ 𝒜) +lemma IsChain.subset_of_le_cardinality (chain𝒞 : IsChain (· ⊂ ·) 𝒞) {e₁ e₂ : Finset α} (e₁mem : e₁ ∈ 𝒞) (e₂mem : e₂ ∈ 𝒞) (hcard : #e₁ ≤ #e₂) : e₁ ⊆ e₂ := by cases Nat.eq_or_lt_of_le hcard with | inr hcard_lt => - exact (IsChain.ssubset_of_lt_cardinality chain𝒜 e₁mem e₂mem hcard_lt).left + exact (IsChain.ssubset_of_lt_cardinality chain𝒞 e₁mem e₂mem hcard_lt).left | inl hcard_eq => - exact Finset.subset_of_eq (IsChain.unique_of_cardinality_chain chain𝒜 e₁mem e₂mem hcard_eq) + exact Finset.subset_of_eq (IsChain.unique_of_cardinality_chain chain𝒞 e₁mem e₂mem hcard_eq) end ChainSubset -section ChainSubsetFinset - -/- Here we proof lemmata concerning the poset of the subset relation on finite sets-/ - -variable {α : Type*} {𝒜 : Finset (Finset α)} [Fintype α] - -lemma Chain.empty_layer_by_card (hn : Fintype.card α = n) (chain𝒜 : IsChain (· ⊂ ·) 𝒜.toSet) (card𝒜 : #𝒜 < n+1) : ∃ i : Fin (n + 1), #(𝒜 # i) = 0 := by - by_contra! ass - have : ∀ (i : Fin (n + 1)), #(𝒜 # i) = 1 := by - intro i - have non_zero := ass i - cases Nat.le_one_iff_eq_zero_or_eq_one.mp (IsChain.max_one_elt_chain_layer chain𝒜 i) with - | inl h => exfalso; exact (non_zero h) - | inr h => exact h - rw [←sum_card_slice 𝒜] at card𝒜 - have := calc - ∑ r ∈ Iic (Fintype.card α), #(𝒜 # r) = ∑ r ∈ Iic (Fintype.card α), 1 := by - apply Finset.sum_congr (by rfl) - intro j jmem - simp [hn] at jmem - exact this ⟨j, by simp [Nat.lt_succ_of_le jmem]⟩ - _ = n + 1 := by rw [←(Finset.card_eq_sum_ones (Iic (Fintype.card α)))]; simp [hn] - linarith - -end ChainSubsetFinset - -section ChainCardinalityOrder - - -/- - Given a finite chain of finite sets with respect to the subset relation, we consider the list of chain elements. - Here we proof that if this list is sorted with respect to the cardinalities it is actually sorted in a strictly monotone manner. --/ +section ChainExtension -variable {α : Type*} {𝒜 : Finset (Finset α)} +variable {α : Type*} [DecidableEq α] [Fintype α] {𝒜 : Set (Finset α)} [DecidablePred (· ∈ 𝒜)] +instance : Fintype 𝒜 := setFintype 𝒜 -instance card_le : LE (Finset α) where - le x y := #x ≤ #y - -instance card_lt : LT (Finset α) where - lt x y := #x < #y +def chain_extension_filter_function (ℬ : Set (Finset α)) (e : Finset α) : α → Prop := + fun a : α ↦ IsChain (· ⊂ ·) (insert (insert a e) ℬ) ∧ insert a e ∉ ℬ -instance card_preorder : Preorder (Finset α) := { - le := (· ≤ ·), - lt := (· < ·), - le_refl := fun x => Nat.le_refl #x, - le_trans := fun _ _ _ hxy hyz => Nat.le_trans hxy hyz, - lt_iff_le_not_le := fun _ _ => Nat.lt_iff_le_not_le -} +instance instDecidableIsChain : Decidable (IsChain (· ⊂ ·) 𝒜) := by + sorry --apply Finset.decidableDforallFinset -instance card_le_is_total : IsTotal 𝒜 (fun (e₁ e₂ : 𝒜) ↦ e₁.val ≤ e₂.val) := - ⟨fun a b ↦ Nat.le_total #a.val #b.val⟩ +instance instDecidablePredChainExtension (e : Finset α) : + DecidablePred (chain_extension_filter_function 𝒜 e) := + fun a : α => by sorry --inferInstanceAs (Decidable (IsChain (· ⊂ ·) (insert (insert a e) 𝒜).toSet ∧ insert a e ∉ 𝒜)) -instance card_le_is_trans : IsTrans 𝒜 (fun (e₁ e₂ : 𝒜) ↦ e₁.val ≤ e₂.val) := - ⟨fun _ _ _ h₁ h₂ ↦ Nat.le_trans h₁ h₂⟩ +def extension_candidates (ℬ : Set (Finset α)) (e : Finset α) := Finset.filter (chain_extension_filter_function ℬ e) (Finset.univ : Finset α) -lemma card_strict_mono' (chain𝒜 : IsChain (· ⊂ ·) 𝒜.toSet) : ((Finset.univ : Finset 𝒜).toList.insertionSort (fun (e₁ e₂ : 𝒜) ↦ #e₁.val ≤ #e₂.val)).Sorted (fun (e₁ e₂ : 𝒜) ↦ #e₁.val < #e₂.val) := by - apply List.pairwise_iff_get.mpr - intro x y xlty - let elt_x := ((List.insertionSort (fun (e₁ e₂ : 𝒜) => #e₁.val ≤ #e₂.val) univ.toList).get x) - let elt_y := ((List.insertionSort (fun (e₁ e₂ : 𝒜) => #e₁.val ≤ #e₂.val) univ.toList).get y) - have card_le : elt_x.val ≤ elt_y.val := List.pairwise_iff_get.mp (List.sorted_insertionSort (fun (e₁ e₂ : 𝒜) ↦ #e₁.val ≤ #e₂.val) (Finset.univ : Finset 𝒜).toList) x y xlty - by_contra! ass - have card_eq := Nat.le_antisymm card_le ass +theorem extension_candidates_characterisation {i j : Finset.range (n + 1)} (hn : Fintype.card α = n) (ilej_succ_succ : (i : ℕ) + 2 ≤ (j : ℕ)) (chain𝒜 : IsChain (· ⊂ ·) 𝒜) + (hi : (𝒜.toFinset # i) = {layer_i}) (hj : (𝒜.toFinset # j) = {layer_j}) (emptylayer : ∀ l ∈ (Finset.range (n + 1)), i < l → l < j → #(𝒜.toFinset # l) = 0): + extension_candidates 𝒜 layer_i = layer_j \ layer_i := by + unfold extension_candidates - have elt_x_eq_elt_y := Subtype.eq (IsChain.unique_of_cardinality_chain chain𝒜 elt_x.prop elt_y.prop card_eq) - have elt_x_neq_elt_y : elt_x ≠ elt_y := List.pairwise_iff_get.mp (List.Nodup.insertionSort ((Finset.univ : Finset 𝒜).nodup_toList)) x y xlty + have layer_j_mem_card := Slice.singleton_explicit.mp hj + have layer_i_mem_card := Slice.singleton_explicit.mp hi - exact elt_x_neq_elt_y elt_x_eq_elt_y + ext x + let e_new := insert x layer_i + have he_new : e_new = insert x layer_i := rfl -theorem Chain.card_strict_mono [DecidableEq α] (chain𝒜 : IsChain (· ⊂ ·) 𝒜.toSet) : ∃ l : List (Finset α), l ~ 𝒜.toList ∧ l.Sorted (#· < #·) := by - let l' := ((Finset.univ : Finset 𝒜).toList.insertionSort (fun (e₁ e₂ : 𝒜) ↦ #e₁.val ≤ #e₂.val)) - have l'_sorted : l'.Sorted (fun (e₁ e₂ : 𝒜) ↦ #e₁.val < #e₂.val) := card_strict_mono' chain𝒜 + have e_new_card_lt_layer_j_card: #e_new < #layer_j := by + rw [layer_j_mem_card.right.left] + have : #e_new ≤ #layer_i + 1 := by + simp only [e_new] + exact Finset.card_insert_le x layer_i + rw [layer_i_mem_card.right.left] at this + apply Nat.lt_of_le_of_lt this + exact Nat.succ_le_of_lt ilej_succ_succ - let l := l'.map Subtype.val - use l constructor - · calc - l ~ (Finset.univ : Finset 𝒜).toList.map Subtype.val := Perm.map Subtype.val (perm_insertionSort (fun e₁ e₂ => #e₁.val ≤ #e₂.val) (Finset.univ : Finset 𝒜).toList) - _ ~ 𝒜.toList := by apply Finset.subtype_toList - · unfold l Sorted - apply List.pairwise_iff_get.mpr - intro i j iltj - simp [List.getElem_map, List.unattach, -List.map_subtype] - - have : (l'.map Subtype.val).length = l'.length := length_map l' Subtype.val + · intro hx + simp only [mem_filter, chain_extension_filter_function, ←he_new] at hx + have hx := hx.right + + have e_new_neq_layer_j : e_new ≠ layer_j := by + intro ass + have := mem_toFinset.mp layer_j_mem_card.left + rw [←ass] at this + exact hx.right this + simp + constructor + · have e_new_mem : e_new ∈ insert e_new 𝒜 := by simp + have layer_j_mem_insert : layer_j ∈ insert e_new 𝒜 := by + simp + right + exact Set.mem_toFinset.mp (layer_j_mem_card.left) + have e_new_sub_layer_j := IsChain.subset_of_le_cardinality hx.left e_new_mem (layer_j_mem_insert) (Nat.le_of_lt e_new_card_lt_layer_j_card) + rw [he_new] at e_new_sub_layer_j + exact e_new_sub_layer_j (mem_insert_self x layer_i) + · intro x_mem_layer_i + have := mem_toFinset.mp layer_i_mem_card.left + rw [←(Finset.insert_eq_self.mpr x_mem_layer_i)] at this + exact hx.right this + · intro hx + simp at hx + simp [chain_extension_filter_function] + + have case_helper {e₁ e₂ : Finset α} (e₁neqe₂ : e₁ ≠ e₂) (e₂_not_new : e₂ ∈ 𝒜) (e₁_new : e₁ = e_new) : e₁ ⊂ e₂ ∨ e₂ ⊂ e₁ := by + have := chain𝒜 (mem_toFinset.mp layer_i_mem_card.left) e₂_not_new + by_cases h : layer_i = e₂ + · right + rw [←h, e₁_new, he_new] + apply Finset.ssubset_iff_subset_ne.mpr + constructor + · simp + · exact (Finset.insert_ne_self.mpr hx.right).symm + · cases chain𝒜 e₂_not_new (mem_toFinset.mp layer_i_mem_card.left) (fun q => h q.symm) with + | inl e₂_sub_layer_i => + right + simp at e₂_sub_layer_i + rw [e₁_new, he_new] + refine' Finset.ssubset_of_ssubset_of_subset e₂_sub_layer_i _ + apply Finset.subset_insert + | inr layer_i_sub_e₂ => + simp at layer_i_sub_e₂ + left + by_contra e₂_sub_e₁ + + have e₁_sub_e₂ : e₁ ⊆ e₂ := by + rw [e₁_new, he_new] + have layer_j_card_le_e₂_card : #layer_j ≤ #e₂ := by + rw [layer_j_mem_card.right.left] + by_contra! + have e₂_card_gt_i : #e₂ > ↑i := by + rw [←layer_i_mem_card.right.left] + exact Finset.card_strictMono layer_i_sub_e₂ + have e₂_card_lt_n_succ : #e₂ < n + 1 := by + apply Nat.lt_succ_of_le + rw [←hn] + apply Finset.card_le_univ + have e₂_empty_layer := emptylayer #e₂ (by simp; exact e₂_card_lt_n_succ) e₂_card_gt_i this + simp at e₂_empty_layer + have : e₂ ∈ 𝒜.toFinset # #e₂ := by simpa [slice] + simp [e₂_empty_layer] at this + + have layer_j_sub_e₂ := IsChain.subset_of_le_cardinality chain𝒜 (mem_toFinset.mp layer_j_mem_card.left) e₂_not_new layer_j_card_le_e₂_card + + apply Finset.insert_subset + · exact layer_j_sub_e₂ hx.left + · have : #layer_i ≤ #e₂ := by + rw [layer_i_mem_card.right.left] + rw [layer_j_mem_card.right.left] at layer_j_card_le_e₂_card + exact Nat.le_trans (Nat.le_of_lt (Nat.lt_of_succ_lt ilej_succ_succ)) layer_j_card_le_e₂_card + + exact IsChain.subset_of_le_cardinality chain𝒜 (mem_toFinset.mp layer_i_mem_card.left) e₂_not_new this + + have : ¬(e₁ ⊆ e₂ ∧ e₁ ≠ e₂) := fun q => e₂_sub_e₁ (Finset.ssubset_iff_subset_ne.mpr q) + simp at this + exact e₁neqe₂ (this e₁_sub_e₂) - have iltj_coe : (Fin.cast this i) < (Fin.cast this j) := by - apply Fin.lt_def.mpr + constructor + · intro e₁ e₁mem e₂ e₂mem e₁neqe₂ + simp [←he_new] at e₁mem e₂mem simp - exact iltj + cases e₁mem with + | inl e₁_new => + cases e₂mem with + | inl e₂_new => + rw [←e₂_new] at e₁_new + left + exact Finset.ssubset_iff_subset_ne.mpr ⟨Finset.subset_of_eq e₁_new, e₁neqe₂⟩ + | inr e₂_not_new => + exact case_helper e₁neqe₂ e₂_not_new e₁_new + | inr e₁_not_new => + cases e₂mem with + | inl e₂_new => + apply Or.symm + exact case_helper e₁neqe₂.symm e₁_not_new e₂_new + | inr e₂_not_new => + exact chain𝒜 e₁_not_new e₂_not_new e₁neqe₂ + + · intro e_new_mem_𝒜 + have e_new_card_gt_layer_i : #e_new > i := by simp [Finset.card_insert_of_not_mem hx.right, layer_i_mem_card.right.left] + + rw [layer_j_mem_card.right.left] at e_new_card_lt_layer_j_card + have : #(𝒜.toFinset # #e_new) = 0 := by + refine' emptylayer #e_new _ e_new_card_gt_layer_i e_new_card_lt_layer_j_card + · simp + exact Nat.lt_trans e_new_card_lt_layer_j_card (mem_range.mp j.property) + have : (𝒜.toFinset # #e_new).Nonempty := by + have : e_new ∈ 𝒜.toFinset # #e_new := by simpa [slice] + exact nonempty_of_mem this + have : #(𝒜.toFinset # #e_new) > 0 := Finset.card_pos.mpr this + linarith - have := List.pairwise_iff_get.mp l'_sorted (Fin.cast this i) (Fin.cast this j) iltj_coe - exact this +lemma extension_candidates_nonempty {e : Finset α} (hn : Fintype.card α = n) (h : extension_candidates 𝒜 e ≠ ∅) : #e < n ∧ (𝒜.toFinset # (#e + 1)) = ∅ := by + by_contra! ass₀ + apply h + have : (𝒜.toFinset # (#e + 1)) ≠ ∅ ∨ #e ≥ n := by + by_cases h : #e < n + · exact Or.inl (ass₀ h) + · exact Or.inr (Nat.ge_of_not_lt h) + + cases this with + | inl next_ne_empty => + by_contra! ass₁ + obtain ⟨a, ha⟩ := nonempty_of_ne_empty ass₁ + simp [extension_candidates, chain_extension_filter_function] at ha -end ChainCardinalityOrder + obtain ⟨u, hu⟩ := nonempty_of_ne_empty next_ne_empty + simp [slice] at hu + have insert_a_mem : (insert a e) ∈ insert (insert a e) 𝒜 := Set.mem_insert (insert a e) 𝒜 + have u_mem : u ∈ insert (insert a e) 𝒜 := Set.mem_insert_of_mem (insert a e) hu.left -section ChainExtension + have card_eq : #(insert a e) = #u := by sorry -variable {α : Type*} [DecidableEq α] [Fintype α] {𝒜 : Finset (Finset α)} + have := IsChain.unique_of_cardinality_chain ha.left insert_a_mem u_mem card_eq + rw [this] at ha + exact ha.right hu.left + | inr card_ge => + sorry -def chain_extension_filter_function (ℬ : Finset (Finset α)) (e : Finset α) : α → Prop := - fun a : α ↦ IsChain (· ⊂ ·) (insert (insert a e) ℬ) ∧ insert a e ∉ ℬ +end ChainExtension -instance instDecidableIsChain : Decidable (IsChain (· ⊂ ·) 𝒜.toSet) := by - apply Finset.decidableDforallFinset +section ChainSubsetFintype -instance instDecidablePredChainExtension (e : Finset α) : - DecidablePred (chain_extension_filter_function 𝒜 e) := - fun a : α => by sorry --inferInstanceAs (Decidable (IsChain (· ⊂ ·) (insert (insert a e) 𝒜).toSet ∧ insert a e ∉ 𝒜)) +/- Here we proof lemmata concerning the poset of the subset relation on sets of finite type-/ -def extension_candidates (ℬ : Finset (Finset α)) (e : Finset α) := Finset.filter (chain_extension_filter_function ℬ e) (Finset.univ : Finset α) +variable {α : Type*} [Fintype α] {𝒜 : Set (Finset α)} [DecidablePred (· ∈ 𝒜)] +instance : Fintype 𝒜 := setFintype 𝒜 -lemma IsMaxChain.one_elt_max_chain_layer [Fintype α] [DecidableEq α] (hn : Fintype.card α = n) (maxchain𝒜 : IsMaxChain (· ⊂ ·) 𝒜.toSet) - (j : Finset.range (n + 1)) : #(𝒜 # j) = 1 := by +lemma Chain.empty_layer_by_card (hn : Fintype.card α = n) (chain𝒜 : IsChain (· ⊂ ·) 𝒜) (card𝒜 : #𝒜.toFinset < n+1) : ∃ i : Fin (n + 1), #(𝒜.toFinset # i) = 0 := by by_contra! ass - have empty_layer : 𝒜 # j = ∅ := by + have : ∀ (i : Fin (n + 1)), #(𝒜.toFinset # i) = 1 := by + intro i + have non_zero := ass i + cases Nat.le_one_iff_eq_zero_or_eq_one.mp (IsChain.max_one_elt_chain_layer chain𝒜 i) with + | inl h => exfalso; exact (non_zero h) + | inr h => exact h + rw [←sum_card_slice 𝒜.toFinset] at card𝒜 + have := calc + ∑ r ∈ Iic (Fintype.card α), #(𝒜.toFinset # r) = ∑ r ∈ Iic (Fintype.card α), 1 := by + apply Finset.sum_congr (by rfl) + intro j jmem + simp [hn] at jmem + exact this ⟨j, by simp [Nat.lt_succ_of_le jmem]⟩ + _ = n + 1 := by rw [←(Finset.card_eq_sum_ones (Iic (Fintype.card α)))]; simp [hn] + linarith + +lemma IsMaxChain.one_elt_max_chain_layer [DecidableEq α] (hn : Fintype.card α = n) (maxchain𝒜 : IsMaxChain (· ⊂ ·) 𝒜) + (j : Finset.range (n + 1)) : #(𝒜.toFinset # j) = 1 := by + by_contra! ass + have empty_layer : 𝒜.toFinset # j = ∅ := by cases Nat.le_one_iff_eq_zero_or_eq_one.mp (IsChain.max_one_elt_chain_layer maxchain𝒜.left j) with | inl h => simp at h; exact h | inr h => omega - if htop : ∀ i : Finset.range (n + 1), i > j → 𝒜 # i = ∅ then + if htop : ∀ i : Finset.range (n + 1), i > j → 𝒜.toFinset # i = ∅ then have univnotin𝒜 : (Finset.univ : Finset α) ∉ 𝒜 := by intro ass₂ - have nslicemem : (Finset.univ : Finset α) ∈ 𝒜 # n := by + have nslicemem : (Finset.univ : Finset α) ∈ 𝒜.toFinset # n := by simp [Finset.slice] exact ⟨ass₂, hn⟩ cases Nat.lt_or_ge j n with | inl jltn => - have nsliceempty : 𝒜 # n = ∅ := htop ⟨n, Finset.mem_range.mpr (Nat.lt_succ_self n)⟩ jltn + have nsliceempty : 𝒜.toFinset # n = ∅ := htop ⟨n, Finset.mem_range.mpr (Nat.lt_succ_self n)⟩ jltn simp [nsliceempty] at nslicemem | inr jgen => have jeqn : j = n := Nat.eq_of_le_of_lt_succ jgen (Finset.mem_range.1 (by simp)) @@ -241,22 +369,20 @@ lemma IsMaxChain.one_elt_max_chain_layer [Fintype α] [DecidableEq α] (hn : Fin simp [empty_layer] at nslicemem simp [IsMaxChain] at maxchain𝒜 - have larger_chain_with_univ' : _root_.IsChain (· ⊂ ·) (Insert.insert (Finset.univ : Finset α) 𝒜).toSet := by - have : ((Insert.insert (Finset.univ : Finset α) 𝒜) : Finset (Finset α)).toSet = ((Insert.insert (Finset.univ : Finset α) 𝒜) : Set (Finset α)) := by simp - rw [this] + have larger_chain_with_univ' : _root_.IsChain (· ⊂ ·) (Insert.insert (Finset.univ : Finset α) 𝒜) := by refine' IsChain.insert maxchain𝒜.left _ intro b bmem bneq right exact Finset.ssubset_iff_subset_ne.mpr ⟨by simp, fun h => bneq h.symm⟩ - have larger_chain_with_univ : IsChain (· ⊂ ·) ((Insert.insert (Finset.univ : Finset α) 𝒜) : Finset (Finset α)) := larger_chain_with_univ' + have larger_chain_with_univ : IsChain (· ⊂ ·) ((Insert.insert (Finset.univ : Finset α) 𝒜)) := larger_chain_with_univ' - have univin𝒜 := Finset.insert_eq_self.mp (maxchain𝒜.right larger_chain_with_univ (by simp)).symm + have univin𝒜 := Set.insert_eq_self.mp (maxchain𝒜.right larger_chain_with_univ (by simp)).symm exact univnotin𝒜 univin𝒜 - else if hbottom : ∀ i : Finset.range (n + 1), i < j → 𝒜 # i = ∅ then + else if hbottom : ∀ i : Finset.range (n + 1), i < j → 𝒜.toFinset # i = ∅ then have emptynotin𝒜 : (∅ : Finset α) ∉ 𝒜 := by intro ass₃ - have zeroslicemem : (∅ : Finset α) ∈ 𝒜 # 0 := by + have zeroslicemem : (∅ : Finset α) ∈ 𝒜.toFinset # 0 := by simp [Finset.slice] exact ass₃ cases Nat.eq_zero_or_pos j with @@ -266,23 +392,23 @@ lemma IsMaxChain.one_elt_max_chain_layer [Fintype α] [DecidableEq α] (hn : Fin | inr jgen => simp [hbottom ⟨0, by simp⟩ jgen] at zeroslicemem simp [IsMaxChain] at maxchain𝒜 - have larger_chain_with_empty' : _root_.IsChain (· ⊂ ·) ((Insert.insert (∅ : Finset α) 𝒜)).toSet := by - have : ((Insert.insert (∅ : Finset α) 𝒜)).toSet = (Insert.insert (∅ : Finset α) 𝒜.toSet) := by simp + have larger_chain_with_empty' : _root_.IsChain (· ⊂ ·) (Insert.insert (∅ : Finset α) 𝒜) := by + have : (Insert.insert (∅ : Finset α) 𝒜) = Insert.insert (∅ : Finset α) 𝒜 := by simp rw [this] refine' IsChain.insert maxchain𝒜.left _ intro b bmem bneq left exact Finset.ssubset_iff_subset_ne.mpr ⟨by simp, bneq⟩ - have larger_chain_with_empty : IsChain (· ⊂ ·) ((Insert.insert (∅ : Finset α) 𝒜)) := larger_chain_with_empty' + have larger_chain_with_empty : IsChain (· ⊂ ·) (Insert.insert (∅ : Finset α) 𝒜) := larger_chain_with_empty' - have emptyin𝒜 := Finset.insert_eq_self.mp (maxchain𝒜.right larger_chain_with_empty (by simp)).symm + have emptyin𝒜 := Set.insert_eq_self.mp (maxchain𝒜.right larger_chain_with_empty (by simp)).symm exact emptynotin𝒜 emptyin𝒜 else simp at htop hbottom - let indices_nonempty_top := Finset.filter (fun i : Finset.range (n + 1) ↦ i > j ∧ 𝒜 # i ≠ ∅) (Finset.univ : Finset (Finset.range (n + 1))) - let indices_nonempty_bottom := Finset.filter (fun i : Finset.range (n + 1) ↦ i < j ∧ 𝒜 # i ≠ ∅) (Finset.univ : Finset (Finset.range (n + 1))) + let indices_nonempty_top := Finset.filter (fun i : Finset.range (n + 1) ↦ i > j ∧ 𝒜.toFinset # i ≠ ∅) (Finset.univ : Finset (Finset.range (n + 1))) + let indices_nonempty_bottom := Finset.filter (fun i : Finset.range (n + 1) ↦ i < j ∧ 𝒜.toFinset # i ≠ ∅) (Finset.univ : Finset (Finset.range (n + 1))) have nonempty_indices_nonempty_top : indices_nonempty_top.Nonempty := by simp [Finset.Nonempty] obtain ⟨i, ⟨⟨ilen, jlti⟩, jlayernotempty⟩⟩ := htop @@ -309,7 +435,7 @@ lemma IsMaxChain.one_elt_max_chain_layer [Fintype α] [DecidableEq α] (hn : Fin have h_s_bottom := Finset.mem_of_max s_bottom_max simp [indices_nonempty_bottom] at h_s_bottom - have emptylayer : ∀ l ∈ (Finset.range (n + 1)), s_bottom < l → l < s_top → #(𝒜 # l) = 0 := by + have emptylayer : ∀ l ∈ (Finset.range (n + 1)), s_bottom < l → l < s_top → #(𝒜.toFinset # l) = 0 := by intro l lmem s_bottom_lt_l l_lt_s_top have h_top : ⟨l, lmem⟩ ∉ indices_nonempty_top := Finset.not_mem_of_lt_min l_lt_s_top s_top_min @@ -326,18 +452,16 @@ lemma IsMaxChain.one_elt_max_chain_layer [Fintype α] [DecidableEq α] (hn : Fin | inl jltl => exact h_top jltl | inr jgtl => exact h_bottom jgtl - obtain ⟨e_bottom, ⟨bottom_singleton : 𝒜 # s_bottom = {e_bottom}, _⟩⟩ := Chain.layer_singleton_of_nonempty maxchain𝒜.left s_bottom h_s_bottom.right - - obtain ⟨e_top, ⟨top_singleton : 𝒜 # s_top = {e_top}, _⟩⟩ := Chain.layer_singleton_of_nonempty maxchain𝒜.left s_top h_s_top.right + obtain ⟨e_bottom, ⟨bottom_singleton : 𝒜.toFinset # s_bottom = {e_bottom}, _⟩⟩ := Chain.layer_singleton_of_nonempty maxchain𝒜.left s_bottom h_s_bottom.right - let extension_candidates := Finset.filter (chain_extension_filter_function 𝒜 e_bottom) (Finset.univ : Finset α) + obtain ⟨e_top, ⟨top_singleton : 𝒜.toFinset # s_top = {e_top}, _⟩⟩ := Chain.layer_singleton_of_nonempty maxchain𝒜.left s_top h_s_top.right - have extension_candidates_eq : extension_candidates = e_top \ e_bottom := by - refine' extension_candidates_characterisation hn _ maxchain𝒜.left bottom_singleton top_singleton emptylayer - apply Nat.succ_le_of_lt - have : (s_bottom : ℕ) + 1 ≤ ↑j := Nat.succ_le_of_lt h_s_bottom.left - exact Nat.lt_of_le_of_lt this h_s_top.left - simp at extension_candidates_eq + have extension_candidates_eq : extension_candidates 𝒜 e_bottom = e_top \ e_bottom := by + have ilej_succ_succ : (s_bottom : ℕ) + 2 ≤ (s_top : ℕ) := by + apply Nat.succ_le_of_lt + have : (s_bottom : ℕ) + 1 ≤ ↑j := Nat.succ_le_of_lt h_s_bottom.left + exact Nat.lt_of_le_of_lt this h_s_top.left + exact extension_candidates_characterisation hn ilej_succ_succ maxchain𝒜.left bottom_singleton top_singleton emptylayer have e_bottom_mem_card : e_bottom ∈ 𝒜 ∧ #e_bottom = s_bottom := by have := Finset.mem_singleton_self e_bottom @@ -351,7 +475,7 @@ lemma IsMaxChain.one_elt_max_chain_layer [Fintype α] [DecidableEq α] (hn : Fin simp [slice] at this exact this - have extension_candidates_ne_empty : #extension_candidates > 0 := by + have extension_candidates_ne_empty : #(extension_candidates 𝒜 e_bottom) > 0 := by rw [extension_candidates_eq] have card_bottom_lt_card_top : #e_bottom < #e_top := by rw [e_top_mem_card.right, e_bottom_mem_card.right] @@ -363,39 +487,115 @@ lemma IsMaxChain.one_elt_max_chain_layer [Fintype α] [DecidableEq α] (hn : Fin simp at extension_candidates_ne_empty obtain ⟨a, ha⟩ := extension_candidates_ne_empty simp [extension_candidates, chain_extension_filter_function] at ha - have := Finset.insert_eq_self.mp (maxchain𝒜.right ha.left (by simp)).symm + have := Set.insert_eq_self.mp (maxchain𝒜.right ha.left (by simp)).symm exact ha.right this -lemma IsMaxChain.card [Fintype α] [DecidableEq α] {ℬ : Finset (Finset α)} (hn : Fintype.card α = n) - (maxChainℬ : IsMaxChain (· ⊂ ·) ℬ) : ℬ.card = n + 1 := by - rw [←sum_card_slice ℬ] +lemma IsMaxChain.card [DecidableEq α] (hn : Fintype.card α = n) + (maxChain𝒜 : IsMaxChain (· ⊂ ·) 𝒜) : #𝒜.toFinset = n + 1 := by + rw [←sum_card_slice 𝒜.toFinset] calc - ∑ r ∈ Iic (Fintype.card α), #(ℬ # r) = ∑ r ∈ Iic (Fintype.card α), 1 := by + ∑ r ∈ Iic (Fintype.card α), #(𝒜.toFinset # r) = ∑ r ∈ Iic (Fintype.card α), 1 := by apply Finset.sum_congr (by rfl) intro j jmem simp [hn] at jmem - exact IsMaxChain.one_elt_max_chain_layer hn maxChainℬ ⟨j, by simp [Nat.lt_succ_of_le jmem]⟩ + exact IsMaxChain.one_elt_max_chain_layer hn maxChain𝒜 ⟨j, by simp [Nat.lt_succ_of_le jmem]⟩ _ = n + 1 := by rw [←(Finset.card_eq_sum_ones (Iic (Fintype.card α)))]; simp [hn] -lemma IsChain.card_le {ℬ : Finset (Finset α)} [Fintype α] (hn : Fintype.card α = n) (chainℬ : IsChain (· ⊂ ·) ℬ) : ℬ.card ≤ n + 1 := by - rw [←sum_card_slice ℬ] +lemma IsChain.card_le (hn : Fintype.card α = n) (chain𝒜 : IsChain (· ⊂ ·) 𝒜) : #𝒜.toFinset ≤ n + 1 := by + rw [←sum_card_slice 𝒜.toFinset] calc - ∑ r ∈ Iic (Fintype.card α), #(ℬ # r) ≤ ∑ r ∈ Iic (Fintype.card α), 1 := by + ∑ r ∈ Iic (Fintype.card α), #(𝒜.toFinset # r) ≤ ∑ r ∈ Iic (Fintype.card α), 1 := by apply sum_le_sum intro j jmem - exact IsChain.max_one_elt_chain_layer chainℬ j + exact IsChain.max_one_elt_chain_layer chain𝒜 j _ = n + 1 := by rw [←(Finset.card_eq_sum_ones (Iic (Fintype.card α)))]; simp [hn] -lemma IsMaxChain.iff_card [Fintype α] [DecidableEq α] {ℬ : Finset (Finset α)} (hn : Fintype.card α = n) - (chainℬ : IsChain (· ⊂ ·) ℬ) : IsMaxChain (· ⊂ ·) ℬ ↔ ℬ.card = n + 1 := by +lemma IsMaxChain.iff_card [DecidableEq α] (hn : Fintype.card α = n) + (chain𝒜 : IsChain (· ⊂ ·) 𝒜) : IsMaxChain (· ⊂ ·) 𝒜 ↔ #𝒜.toFinset = n + 1 := by constructor - · intro maxChainℬ - exact IsMaxChain.card hn maxChainℬ - · intro cardℬ + · intro maxChain𝒜 + exact IsMaxChain.card hn maxChain𝒜 + · intro card𝒜 constructor - · exact chainℬ - · intro 𝒜 chain𝒜 ℬssub𝒜 - have hcard𝒜 : #𝒜 ≤ #ℬ := by - · rw [cardℬ] - exact IsChain.card_le hn chain𝒜 - exact (Finset.subset_iff_eq_of_card_le hcard𝒜).mp ℬssub𝒜 + · exact chain𝒜 + · intro ℬ chainℬ 𝒜ssubℬ + have : DecidablePred (fun e : Finset α ↦ e ∈ ℬ) := by sorry + have := setFintype ℬ + have hcard𝒜 : #ℬ.toFinset ≤ #𝒜.toFinset := by + rw [card𝒜, ←hn] + sorry + exact toFinset_inj.mp ((Finset.subset_iff_eq_of_card_le hcard𝒜).mp (toFinset_subset_toFinset.mpr 𝒜ssubℬ)) + +end ChainSubsetFintype + +section ChainCardinalityOrder + +/- + Given a finite chain of finite sets with respect to the subset relation, we consider the list of chain elements. + Here we proof that if this list is sorted with respect to the cardinalities it is actually sorted in a strictly monotone manner. +-/ + +variable {α : Type*} {𝒜 : Set (Finset α)} [DecidablePred (· ∈ 𝒜)] [Fintype α] + +instance : Fintype 𝒜 := setFintype 𝒜 + +instance card_le : LE (Finset α) where + le x y := #x ≤ #y + +instance card_lt : LT (Finset α) where + lt x y := #x < #y + +instance card_preorder : Preorder (Finset α) := { + le := (· ≤ ·), + lt := (· < ·), + le_refl := fun x => Nat.le_refl #x, + le_trans := fun _ _ _ hxy hyz => Nat.le_trans hxy hyz, + lt_iff_le_not_le := fun _ _ => Nat.lt_iff_le_not_le +} + +instance card_le_is_total : IsTotal 𝒜 (fun (e₁ e₂ : 𝒜) ↦ e₁.val ≤ e₂.val) := + ⟨fun a b ↦ Nat.le_total #a.val #b.val⟩ + +instance card_le_is_trans : IsTrans 𝒜 (fun (e₁ e₂ : 𝒜) ↦ e₁.val ≤ e₂.val) := + ⟨fun _ _ _ h₁ h₂ ↦ Nat.le_trans h₁ h₂⟩ + +lemma card_strict_mono' (chain𝒜 : IsChain (· ⊂ ·) 𝒜) : ((Finset.univ : Finset 𝒜).toList.insertionSort (fun (e₁ e₂ : 𝒜) ↦ #e₁.val ≤ #e₂.val)).Sorted (fun (e₁ e₂ : 𝒜) ↦ #e₁.val < #e₂.val) := by + apply List.pairwise_iff_get.mpr + intro x y xlty + let elt_x := ((List.insertionSort (fun (e₁ e₂ : 𝒜) => #e₁.val ≤ #e₂.val) univ.toList).get x) + let elt_y := ((List.insertionSort (fun (e₁ e₂ : 𝒜) => #e₁.val ≤ #e₂.val) univ.toList).get y) + have card_le : elt_x.val ≤ elt_y.val := List.pairwise_iff_get.mp (List.sorted_insertionSort (fun (e₁ e₂ : 𝒜) ↦ #e₁.val ≤ #e₂.val) (Finset.univ : Finset 𝒜).toList) x y xlty + by_contra! ass + have card_eq := Nat.le_antisymm card_le ass + + have elt_x_eq_elt_y := Subtype.eq (IsChain.unique_of_cardinality_chain chain𝒜 elt_x.prop elt_y.prop card_eq) + have elt_x_neq_elt_y : elt_x ≠ elt_y := List.pairwise_iff_get.mp (List.Nodup.insertionSort ((Finset.univ : Finset 𝒜).nodup_toList)) x y xlty + + exact elt_x_neq_elt_y elt_x_eq_elt_y + +theorem Chain.card_strict_mono [DecidableEq α] (chain𝒜 : IsChain (· ⊂ ·) 𝒜) : ∃ l : List (Finset α), l ~ 𝒜.toFinset.toList ∧ l.Sorted (#· < #·) := by + let l' := ((Finset.univ : Finset 𝒜).toList.insertionSort (fun (e₁ e₂ : 𝒜) ↦ #e₁.val ≤ #e₂.val)) + have l'_sorted : l'.Sorted (fun (e₁ e₂ : 𝒜) ↦ #e₁.val < #e₂.val) := card_strict_mono' chain𝒜 + + let l := l'.map Subtype.val + use l + constructor + · calc + l ~ (Finset.univ : Finset 𝒜).toList.map Subtype.val := Perm.map Subtype.val (perm_insertionSort (fun e₁ e₂ => #e₁.val ≤ #e₂.val) (Finset.univ : Finset 𝒜).toList) + _ ~ 𝒜.toFinset.toList := by apply Finset.subtype_toList + · unfold l Sorted + apply List.pairwise_iff_get.mpr + intro i j iltj + simp [List.getElem_map, List.unattach, -List.map_subtype] + + have : (l'.map Subtype.val).length = l'.length := length_map l' Subtype.val + + have iltj_coe : (Fin.cast this i) < (Fin.cast this j) := by + apply Fin.lt_def.mpr + simp + exact iltj + + have := List.pairwise_iff_get.mp l'_sorted (Fin.cast this i) (Fin.cast this j) iltj_coe + exact this + +end ChainCardinalityOrder diff --git a/TheBook/ToMathlib/List.lean b/TheBook/ToMathlib/List.lean index 2e436e4..0421b1c 100644 --- a/TheBook/ToMathlib/List.lean +++ b/TheBook/ToMathlib/List.lean @@ -54,18 +54,21 @@ lemma List.Nodup.insertionSort {l : List α} (h : l.Nodup) : (l.insertionSort (f end Nodup + section Perm -variable {α : Type*} {𝒜 : Finset α} [DecidableEq α] +variable {α : Type*} {𝒜 : Set (Finset α)} [DecidablePred (· ∈ 𝒜)] [Fintype α] [DecidableEq α] + +instance : Fintype 𝒜 := setFintype 𝒜 -lemma Finset.subtype_toList : List.map Subtype.val (Finset.univ : Finset 𝒜).toList ~ 𝒜.toList := by +lemma Finset.subtype_toList : List.map Subtype.val (Finset.univ : Finset 𝒜).toList ~ 𝒜.toFinset.toList := by refine' perm_iff_count.mpr _ intro a - by_cases h : a ∈ 𝒜 + by_cases h : a ∈ 𝒜.toFinset case pos => - have count_rhs := nodup_iff_count_eq_one.mp 𝒜.nodup_toList a (mem_toList.mpr h) - have count_lhs₀ := count_map_of_injective (Finset.univ : Finset 𝒜).toList Subtype.val Subtype.val_injective ⟨a, h⟩ - have count_lhs₁ := nodup_iff_count_eq_one.mp (Finset.univ : Finset 𝒜).nodup_toList ⟨a, h⟩ (mem_toList.mpr (by simp)) + have count_rhs := nodup_iff_count_eq_one.mp 𝒜.toFinset.nodup_toList a (mem_toList.mpr h) + have count_lhs₀ := count_map_of_injective (Finset.univ : Finset 𝒜).toList Subtype.val Subtype.val_injective ⟨a, mem_toFinset.mp h⟩ + have count_lhs₁ := nodup_iff_count_eq_one.mp (Finset.univ : Finset 𝒜).nodup_toList ⟨a, mem_toFinset.mp h⟩ (mem_toList.mpr (by simp)) rw [count_rhs, count_lhs₀, count_lhs₁] case neg => have count_rhs := List.count_eq_zero_of_not_mem (fun ass ↦ h (mem_toList.mp ass)) @@ -76,7 +79,7 @@ lemma Finset.subtype_toList : List.map Subtype.val (Finset.univ : Finset 𝒜).t have := x.prop rw [x_eq_a] at this - exact h this + exact h (mem_toFinset.mpr this) rw [count_rhs, count_lhs] end Perm diff --git a/TheBook/ToMathlib/Slice.lean b/TheBook/ToMathlib/Slice.lean new file mode 100644 index 0000000..ad5ba3a --- /dev/null +++ b/TheBook/ToMathlib/Slice.lean @@ -0,0 +1,27 @@ +import Mathlib.Algebra.BigOperators.Group.Finset +import Mathlib.Order.Antichain +import Mathlib.Order.Interval.Finset.Nat +import Mathlib.Data.Finset.Slice + +namespace Slice + +open Finset + +variable {α : Type*} {𝒜 : Finset (Finset α)} {A A₁ A₂ : Finset α} {r r₁ r₂ : ℕ} + +lemma singleton_explicit : (𝒜 # s) = {layer_s} ↔ layer_s ∈ 𝒜 ∧ #layer_s = s ∧ #(𝒜 # s) = 1 := by + constructor + · intro h + have := Finset.mem_singleton_self layer_s + rw [←h] at this + simp [slice] at this + exact ⟨this.left, this.right, by simp [h]⟩ + · intro h + refine' eq_singleton_iff_unique_mem.mpr _ + constructor + · simp [slice] + constructor + · exact h.left + · exact h.right.left + · intro x hx + sorry From 076c165afc94eea20aeb6bf24af2f30e76be03b6 Mon Sep 17 00:00:00 2001 From: Jakob Zimmermann Date: Fri, 7 Feb 2025 20:01:22 +0100 Subject: [PATCH 25/26] Added doc strings. --- .../SpernerHelpingDataStructures.lean | 13 +- TheBook/ToMathlib/Antichain.lean | 1 + TheBook/ToMathlib/Chain.lean | 210 ++++++++++++++---- TheBook/ToMathlib/List.lean | 17 +- TheBook/ToMathlib/Slice.lean | 1 + 5 files changed, 193 insertions(+), 49 deletions(-) diff --git a/TheBook/Combinatorics/SpernerHelpingDataStructures.lean b/TheBook/Combinatorics/SpernerHelpingDataStructures.lean index 3fbe254..f9bfbe5 100644 --- a/TheBook/Combinatorics/SpernerHelpingDataStructures.lean +++ b/TheBook/Combinatorics/SpernerHelpingDataStructures.lean @@ -17,17 +17,23 @@ section MaxChainThrough -/ structure MaxChainThrough (ℬ : Set (Finset α)) where + /- The set of elements in the chain.-/ 𝒜 : Set (Finset α) + /- '𝒜' is a maximal chain.-/ isMaxChain : IsMaxChain (· ⊂ ·) 𝒜 + /- '𝒜' is a subset of 'ℬ'.-/ subChain : ℬ ⊆ 𝒜 +/- Projection of 'MaxChainThrough' on the set of elements.-/ def emb_MaxChainThrough (ℬ : Set (Finset α)) (X : MaxChainThrough ℬ) : Set (Finset α) := X.𝒜 +/- Definition of equality of two variables of type 'MaxChainThrough'-/ @[ext] lemma MaxChainThrough_eq (𝒞₁ 𝒞₂ : MaxChainThrough ℬ) (hA : 𝒞₁.𝒜 = 𝒞₂.𝒜) : 𝒞₁ = 𝒞₂ := by cases 𝒞₁ cases 𝒞₂ congr +/- 'emb_MaxChainThrough' is injective.-/ lemma inj_emb_MaxChainThrough : Injective (emb_MaxChainThrough ℬ) := by intro 𝒞₁ 𝒞₂ h unfold emb_MaxChainThrough at h @@ -47,6 +53,7 @@ instance {C : MaxChainThrough ℬ} : Fintype C.𝒜 := setFintype C.𝒜 instance : Fintype ℬ := setFintype ℬ instance : Fintype 𝒜 := setFintype 𝒜 + lemma card_maxChainThrough (hn : Fintype.card α = n) (chain : MaxChainThrough ℬ) : #chain.𝒜.toFinset = n + 1 := by rw [←sum_card_slice chain.𝒜.toFinset] calc @@ -159,7 +166,7 @@ lemma chain_through_extension_candidates_pairwiseDisjoint {e : Finset α} (e_mem intro 𝒜 h𝒜 simp - simp [extension_candidates,chain_extension_filter_function] at hx hy + simp [extension_candidates,insert_extends_chain] at hx hy have a_extension_e_x := hA_x h𝒜 have a_extension_e_y := hA_y h𝒜 @@ -207,7 +214,7 @@ lemma central_identity (e : Finset α) (e_mem : e ∈ ℬ) (h : extension_candid · intro 𝒜_mem_image simp at 𝒜_mem_image - simp [extension_candidates, chain_extension_filter_function, extensions_wrt] + simp [extension_candidates, insert_extends_chain, extensions_wrt] have e_card_lt := (extension_candidates_nonempty rfl h).left @@ -322,7 +329,7 @@ lemma count_maxChainsThrough (h_mn : m ≤ n + 1) (hn : Fintype.card α = n) let ℬ' := (Insert.insert e_new ℬ) have a_property₁ := a.prop - simp only [extension_candidates, Finset.extension_candidates, mem_filter, chain_extension_filter_function] at a_property₁ + simp only [extension_candidates, Finset.extension_candidates, mem_filter, insert_extends_chain] at a_property₁ have a_property₂ := a.prop simp [extension_candidates_eq] at a_property₂ diff --git a/TheBook/ToMathlib/Antichain.lean b/TheBook/ToMathlib/Antichain.lean index b0130bd..5824578 100644 --- a/TheBook/ToMathlib/Antichain.lean +++ b/TheBook/ToMathlib/Antichain.lean @@ -7,6 +7,7 @@ instance : Fintype 𝒜 := setFintype 𝒜 namespace Finset +/- The maximal chains through different elements of an antichain are pairwise disjoint.-/ lemma AntiChain.disj_union_chain_through (anti_chain : IsAntichain (· ⊂ ·) 𝒜) : 𝒜.PairwiseDisjoint (fun e ↦ ((Finset.univ : Finset (MaxChainThrough {e})).image (emb_MaxChainThrough {e}))) := by intro e₁ e₁_mem_𝒜 e₂ e₂_mem_𝒜 e₁neqe₂ diff --git a/TheBook/ToMathlib/Chain.lean b/TheBook/ToMathlib/Chain.lean index 08e49a9..5a38c5b 100644 --- a/TheBook/ToMathlib/Chain.lean +++ b/TheBook/ToMathlib/Chain.lean @@ -4,16 +4,72 @@ import Mathlib.Data.Finset.Slice import Mathlib.Data.Fintype.Basic import Init.Core +/-! +# Chain + +In this file we introduce introduce Lemmata for chains with respect to the subset relation. +First we consider finite chains of sets in general. Then we consider chains of sets containing elements of some 'Fintype α'. + +This module is organized into the sections 'ChainCoercions', 'ChainSubset', 'ChainExtension', 'ChainSubsetFintype' and 'ChainCardinalityOrder'. + +## Main results + +- `IsChain.equivalence_subset_relations`: A set of sets is a chain with respect to the proper subset relation if and only if it is a chain with respect to the subset relation. +- `IsChain.max_one_elt_chain_layer`: In a finite chain each slice (layer) contains at most one element. +- `IsChain.ssubset_of_lt_cardinality`: A strong inequality of the cardinality of two chain elements implies a proper subset relation. +- `IsChain.subset_of_le_cardinality`: A weak inequality of the cardinality of two chain elements implies a subset relation. +- `extension_candidates_characterisation`: Given two sets 'layer_i' and 'layer_j' in a chain such that there is no set of intermediate cardinality and '#layer_j ≥ #layer_i + 2', the extension candidates for 'layer_i' are given by 'layer_j \ layer_i'. +- `Chain.empty_layer_by_card`: Any chain of sets of 'Fintype α' that contains less than 'Fintype.card α' sets, contains an empty slice. +- `Chain.empty_layer_by_card`: In a maximal chain every slice contains exactly one element. +- `IsMaxChain.card`: The cardinality of a maximal chain of sets of some 'Fintpype α' is 'Fintype.card α + 1'. +- `IsChain.card_le`: The cardinality of a chain of sets of some 'Fintpype α' is at most 'Fintype.card α + 1'. +- `IsMaxChain.iff_card`: A chain of sets of some 'Fintpype α' is maximal if and only if it contains 'Fintype.card α + 1' sets. +- `Chain.card_strict_mono`: Given a chain of sets of some 'Fintype α' there exists a permutation of the list of its elements, such that its elements cardinalities are sorted by strict inequalities. +-/ + namespace Finset open Function Finset Nat Set BigOperators List -section ChainSubset +section ChainCoercions -/- Here we proof lemmata concerning the poset of the subset relation on sets of any type-/ +/-! +# ChainCoercions + +In this section we introduce coercions such that we can use the 'IsChain' relation together with the coercions 'toSet' and 'toFinset' in a natural way +and use the subset and the proper subset relation interchangably. + +## Main results + +- `IsChain.equivalence_subset_relations`: A set of sets is a chain with respect to the proper subset relation if and only if it is a chain with respect to the subset relation. +-/ variable {α : Type*} {𝒜 : Finset (Finset α)} {ℬ : Finset (Set α)} {𝒞 : Set (Finset α)} {𝒟 : Set (Set α)} +/- A set of sets is a chain with respect to the proper subset relation if and only if it is a chain with respect to the subset relation.-/ +lemma IsChain.equivalence_subset_relations : (IsChain (· ⊆ .) 𝒟) ↔ (IsChain (· ⊂ .) 𝒟) := by + constructor + · intro h e₁ e₁mem e₂ e₂mem e₁neqe₂ + cases h e₁mem e₂mem e₁neqe₂ with + | inl e₁sube₂ => left; exact Set.ssubset_iff_subset_ne.mpr ⟨e₁sube₂, e₁neqe₂⟩ + | inr e₂sube₁ => right; exact Set.ssubset_iff_subset_ne.mpr ⟨e₂sube₁, e₁neqe₂.symm⟩ + · intro h e₁ e₁mem e₂ e₂mem e₁neqe₂ + cases h e₁mem e₂mem e₁neqe₂ with + | inl e₁sube₂ => left; exact e₁sube₂.left + | inr e₂sube₁ => right; exact e₂sube₁.left + +/- A set of sets is a maximal chain with respect to the proper subset relation if and only if it is a chain with respect to the subset relation-/ +lemma IsMaxChain.equivalence_subset_relations : (IsMaxChain (· ⊆ .) 𝒟) ↔ (IsMaxChain (· ⊂ .) 𝒟) := by + constructor + · intro h + exact ⟨IsChain.equivalence_subset_relations.mp h.left, fun t chain => h.right (IsChain.equivalence_subset_relations.mpr chain)⟩ + · intro h + exact ⟨IsChain.equivalence_subset_relations.mpr h.left, fun t chain => h.right (IsChain.equivalence_subset_relations.mp chain)⟩ + +instance : Coe (IsChain (· ⊆ ·) 𝒟) (IsChain (· ⊂ ·) 𝒟) := ⟨fun h => IsChain.equivalence_subset_relations.mp h⟩ +instance : Coe (IsChain (· ⊂ ·) 𝒟) (IsChain (· ⊆ ·) 𝒟) := ⟨fun h => IsChain.equivalence_subset_relations.mpr h⟩ + +/- A set of sets is a chain if the set of the corresponding finite sets is a chain (with respect to the proper subset relation).-/ instance : Coe (IsChain (· ⊂ ·) 𝒞) (IsChain (· ⊂ ·) (toSet '' 𝒞)) := ⟨ by intro h intro x hx y hy x_neg_y @@ -29,46 +85,68 @@ instance : Coe (IsChain (· ⊂ ·) 𝒞) (IsChain (· ⊂ ·) (toSet '' 𝒞)) exact h hx'.left hy'.left x'_neg_y' ⟩ +/- A set of sets is a chain if the set of the corresponding finite sets is a chain (with respect to the subset relation).-/ +instance : Coe (IsChain (· ⊆ ·) 𝒞) (IsChain (· ⊆ ·) (toSet '' 𝒞)) := ⟨ by + intro h + intro x hx y hy x_neg_y + obtain ⟨x', hx'⟩ := hx + obtain ⟨y', hy'⟩ := hy + have x'_neg_y' : x' ≠ y' := by + by_contra ass + rw [ass] at hx' + rw [←hx'.right, hy'.right] at x_neg_y + simp at x_neg_y + + simp [←hx'.right, ←hy'.right] + exact h hx'.left hy'.left x'_neg_y' +⟩ + +/- A set of finite sets is a chain if the set of the corresponding sets is a chain (with respect to the proper subset relation).-/ instance : Coe (IsChain (· ⊂ ·) (toSet '' 𝒞)) (IsChain (· ⊂ ·) 𝒞) := ⟨ fun h _ hx _ hy x_neg_y ↦ h (Set.mem_image_of_mem toSet hx) (Set.mem_image_of_mem toSet hy) (fun ass ↦ x_neg_y (coe_inj.mp ass))⟩ +/- A set of finite sets is a chain if the set of the corresponding sets is a chain (with respect to the subset relation).-/ instance : Coe (IsChain (· ⊆ ·) (toSet '' 𝒞)) (IsChain (· ⊆ ·) 𝒞) := ⟨ fun h _ hx _ hy x_neg_y ↦ h (Set.mem_image_of_mem toSet hx) (Set.mem_image_of_mem toSet hy) (fun ass ↦ x_neg_y (coe_inj.mp ass))⟩ -instance : Coe (IsChain (· ⊂ ·) (toSet '' 𝒞)) (IsChain (· ⊂ ·) 𝒞) := ⟨ by - intro h - intro x hx y hy x_neg_y - exact h (Set.mem_image_of_mem toSet hx) (Set.mem_image_of_mem toSet hy) (fun ass ↦ x_neg_y (coe_inj.mp ass)) -⟩ +/- Now we can write the following examples without coercion errors.-/ +example (h : IsChain (· ⊂ ·) 𝒞) : (IsChain (· ⊆ ·) (toSet '' 𝒞)) := h +example (h : IsChain (· ⊂ ·) (toSet '' 𝒞)) : (IsChain (· ⊆ ·) 𝒞) := h -instance [Fintype 𝒞] : Coe (IsChain (· ⊂ ·) 𝒞) (IsChain (· ⊂ ·) 𝒞.toFinset.toSet) := ⟨ by - intro h x hx Real.young_inequality hy x_neg_y - simp at hx hy - exact h hx hy x_neg_y -⟩ +/- Considering the next two examples we might want to have also a coercion from 'IsChain (· ⊂ ·) 𝒞' to 'IsChain (· ⊂ ·) 𝒞.toFinset.toSet', but we do not need it.-/ +example [Fintype 𝒞] (h : IsChain (· ⊂ ·) 𝒞) : (IsChain (· ⊆ ·) 𝒞.toFinset.toSet) := by simp; exact (h : IsChain (· ⊆ ·) 𝒞) +example [Fintype 𝒟] (h : IsChain (· ⊆ ·) 𝒟) : (IsChain (· ⊂ ·) 𝒟.toFinset.toSet) := by simp; exact (h : IsChain (· ⊂ ·) 𝒟) -lemma IsChain.equivalence_subset_relations : (IsChain (· ⊆ .) 𝒟) ↔ (IsChain (· ⊂ .) 𝒟) := by - constructor - · intro h e₁ e₁mem e₂ e₂mem e₁neqe₂ - cases h e₁mem e₂mem e₁neqe₂ with - | inl e₁sube₂ => left; exact Set.ssubset_iff_subset_ne.mpr ⟨e₁sube₂, e₁neqe₂⟩ - | inr e₂sube₁ => right; exact Set.ssubset_iff_subset_ne.mpr ⟨e₂sube₁, e₁neqe₂.symm⟩ - · intro h e₁ e₁mem e₂ e₂mem e₁neqe₂ - cases h e₁mem e₂mem e₁neqe₂ with - | inl e₁sube₂ => left; exact e₁sube₂.left - | inr e₂sube₁ => right; exact e₂sube₁.left +/- For completion consider also the following examples.-/ +example (h : IsChain (· ⊂ ·) 𝒜.toSet) : (IsChain (· ⊆ ·) 𝒜.toSet) := h +example (h : IsChain (· ⊂ ·) ℬ.toSet) : (IsChain (· ⊆ ·) ℬ.toSet) := h +example (h : IsChain (· ⊆ ·) 𝒜.toSet) : (IsChain (· ⊂ ·) 𝒜.toSet) := h +example (h : IsChain (· ⊆ ·) ℬ.toSet) : (IsChain (· ⊂ ·) ℬ.toSet) := h +example (h : IsChain (· ⊂ ·) 𝒜.toSet) : (IsChain (· ⊆ ·) (toSet '' 𝒜.toSet)) := h -example (h : IsChain (· ⊂ ·) 𝒞) : (IsChain (· ⊆ ·) (toSet '' 𝒞)) := IsChain.equivalence_subset_relations.mpr h +/- A general observation-/ +example : IsTrans 𝒟 (fun (e₁ e₂ : 𝒟) ↦ e₁.val ⊆ e₂.val) := by apply IsTrans.swap -example (h : IsChain (· ⊂ ·) 𝒞) : (IsChain (· ⊆ ·) 𝒞) := (IsChain.equivalence_subset_relations.mpr h : IsChain (· ⊆ ·) (toSet '' 𝒞)) +end ChainCoercions -lemma IsMaxChain.equivalence_subset_relations : (IsMaxChain (· ⊆ .) 𝒟) ↔ (IsMaxChain (· ⊂ .) 𝒟) := by - constructor - · intro h - exact ⟨IsChain.equivalence_subset_relations.mp h.left, fun t chain => h.right (IsChain.equivalence_subset_relations.mpr chain)⟩ - · intro h - exact ⟨IsChain.equivalence_subset_relations.mpr h.left, fun t chain => h.right (IsChain.equivalence_subset_relations.mp chain)⟩ +section ChainSubset + +/-! +# ChainSubset + +In this section we consider Lemmata on general chains with respect to the subset relation + +## Main results + +- `IsChain.max_one_elt_chain_layer`: In a finite chain each slice (layer) contains at most one element. +- `IsChain.ssubset_of_lt_cardinality`: A strong inequality of the cardinality of two chain elements implies a proper subset relation. +- `IsChain.subset_of_le_cardinality`: A weak inequality of the cardinality of two chain elements implies a subset relation. +-/ + +variable {α : Type*} {𝒞 : Set (Finset α)} {𝒟 : Set (Set α)} + +/- Two elements in a chain of equal cardinality must be equal.-/ lemma IsChain.unique_of_cardinality_chain (chain𝒞 : IsChain (· ⊂ ·) 𝒞) {a b : Finset α} (amem : a ∈ 𝒞) (bmem : b ∈ 𝒞) (hcard : #a = #b) : a = b := by by_contra aneb @@ -80,6 +158,7 @@ lemma IsChain.unique_of_cardinality_chain (chain𝒞 : IsChain (· ⊂ ·) 𝒞) have := Finset.card_strictMono h linarith +/- In a finite chain each slice (layer) contains at most one element.-/ lemma IsChain.max_one_elt_chain_layer [Fintype 𝒞] (chain𝒞 : IsChain (· ⊂ ·) 𝒞) (j : ℕ) : #(𝒞.toFinset # j) ≤ 1 := by by_contra! ass have : (𝒞.toFinset # j) ≠ (∅ : Finset (Finset α)) := by @@ -92,9 +171,7 @@ lemma IsChain.max_one_elt_chain_layer [Fintype 𝒞] (chain𝒞 : IsChain (· have := Finset.slice_subset (bmem) exact aneb (IsChain.unique_of_cardinality_chain chain𝒞 (mem_toFinset.mp (Finset.slice_subset bmem)) (mem_toFinset.mp (Finset.slice_subset amem)) cardeqab.symm) -instance IsChain.subset_is_trans : IsTrans 𝒜 (fun (e₁ e₂ : 𝒜) ↦ e₁.val ⊆ e₂.val) := - ⟨fun _ _ _ h₁ h₂ => subset_trans h₁ h₂⟩ - +/- In a finite chain a non-empty layer is a singleton.-/ lemma Chain.layer_singleton_of_nonempty [Fintype 𝒞] (chain𝒞 : IsChain (· ⊂ ·) 𝒞) (j : Finset.range (n + 1)) (layer_nonempty : (𝒞.toFinset # j) ≠ ∅): ∃! e : Finset α, 𝒞.toFinset # j = {e} := by have : # (𝒞.toFinset # j) = 1 := by @@ -112,6 +189,7 @@ lemma Chain.layer_singleton_of_nonempty [Fintype 𝒞] (chain𝒞 : IsChain (· exact ⟨e, he, unique⟩ +/- A strong inequality of the cardinality of two chain elements implies a proper subset relation.-/ lemma IsChain.ssubset_of_lt_cardinality (chain𝒞 : IsChain (· ⊂ ·) 𝒞) {e₁ e₂ : Finset α} (e₁mem : e₁ ∈ 𝒞) (e₂mem : e₂ ∈ 𝒞) (hcard : #e₁ < #e₂) : e₁ ⊂ e₂ := by have e₁nee₂ : e₁ ≠ e₂ := by @@ -124,6 +202,7 @@ lemma IsChain.ssubset_of_lt_cardinality (chain𝒞 : IsChain (· ⊂ ·) 𝒞) { have : #e₂ < #e₁ := Finset.card_strictMono h linarith +/- A weak inequality of the cardinality of two chain elements implies a subset relation.-/ lemma IsChain.subset_of_le_cardinality (chain𝒞 : IsChain (· ⊂ ·) 𝒞) {e₁ e₂ : Finset α} (e₁mem : e₁ ∈ 𝒞) (e₂mem : e₂ ∈ 𝒞) (hcard : #e₁ ≤ #e₂) : e₁ ⊆ e₂ := by cases Nat.eq_or_lt_of_le hcard with @@ -137,21 +216,37 @@ end ChainSubset section ChainExtension +/-! +# ChainExtension + +In this section we consider Lemmata on the extension of chains of sets containing a Fintype. + +## Main results + +- `extension_candidates_characterisation`: Given two sets 'layer_i' and 'layer_j' in a chain such that there is no set of intermediate cardinality and '#layer_j ≥ #layer_i + 2', the extension candidates for 'layer_i' are given by 'layer_j \ layer_i'. +-/ + variable {α : Type*} [DecidableEq α] [Fintype α] {𝒜 : Set (Finset α)} [DecidablePred (· ∈ 𝒜)] instance : Fintype 𝒜 := setFintype 𝒜 -def chain_extension_filter_function (ℬ : Set (Finset α)) (e : Finset α) : α → Prop := - fun a : α ↦ IsChain (· ⊂ ·) (insert (insert a e) ℬ) ∧ insert a e ∉ ℬ +def extends_chain (ℬ : Set (Finset α)) : Finset α → Prop := + fun e ↦ (IsChain (· ⊂ ·) (insert e ℬ)) ∧ e ∉ ℬ + +/- In order to count maximal chains through a chain, we are interested in the following way of chain extension-/ +def insert_extends_chain (ℬ : Set (Finset α)) (e : Finset α) : α → Prop := + fun a : α ↦ extends_chain ℬ (insert a e) + --fun a : α ↦ IsChain (· ⊂ ·) (insert (insert a e) ℬ) ∧ insert a e ∉ ℬ instance instDecidableIsChain : Decidable (IsChain (· ⊂ ·) 𝒜) := by sorry --apply Finset.decidableDforallFinset instance instDecidablePredChainExtension (e : Finset α) : - DecidablePred (chain_extension_filter_function 𝒜 e) := + DecidablePred (insert_extends_chain 𝒜 e) := fun a : α => by sorry --inferInstanceAs (Decidable (IsChain (· ⊂ ·) (insert (insert a e) 𝒜).toSet ∧ insert a e ∉ 𝒜)) -def extension_candidates (ℬ : Set (Finset α)) (e : Finset α) := Finset.filter (chain_extension_filter_function ℬ e) (Finset.univ : Finset α) +def extension_candidates (ℬ : Set (Finset α)) (e : Finset α) := Finset.filter (insert_extends_chain ℬ e) (Finset.univ : Finset α) +/- Given two sets 'layer_i' and 'layer_j' in a chain such that there is no set of intermediate cardinality and '#layer_j ≥ #layer_i + 2', the extension candidates for 'layer_i' are given by 'layer_j \ layer_i'.-/ theorem extension_candidates_characterisation {i j : Finset.range (n + 1)} (hn : Fintype.card α = n) (ilej_succ_succ : (i : ℕ) + 2 ≤ (j : ℕ)) (chain𝒜 : IsChain (· ⊂ ·) 𝒜) (hi : (𝒜.toFinset # i) = {layer_i}) (hj : (𝒜.toFinset # j) = {layer_j}) (emptylayer : ∀ l ∈ (Finset.range (n + 1)), i < l → l < j → #(𝒜.toFinset # l) = 0): extension_candidates 𝒜 layer_i = layer_j \ layer_i := by @@ -175,7 +270,7 @@ theorem extension_candidates_characterisation {i j : Finset.range (n + 1)} (hn : constructor · intro hx - simp only [mem_filter, chain_extension_filter_function, ←he_new] at hx + simp only [mem_filter, insert_extends_chain, ←he_new] at hx have hx := hx.right have e_new_neq_layer_j : e_new ≠ layer_j := by @@ -199,7 +294,7 @@ theorem extension_candidates_characterisation {i j : Finset.range (n + 1)} (hn : exact hx.right this · intro hx simp at hx - simp [chain_extension_filter_function] + simp [insert_extends_chain] have case_helper {e₁ e₂ : Finset α} (e₁neqe₂ : e₁ ≠ e₂) (e₂_not_new : e₂ ∈ 𝒜) (e₁_new : e₁ = e_new) : e₁ ⊂ e₂ ∨ e₂ ⊂ e₁ := by have := chain𝒜 (mem_toFinset.mp layer_i_mem_card.left) e₂_not_new @@ -289,6 +384,7 @@ theorem extension_candidates_characterisation {i j : Finset.range (n + 1)} (hn : have : #(𝒜.toFinset # #e_new) > 0 := Finset.card_pos.mpr this linarith +/- For any finite set 'e' in a chain with nonempty extension candidates, we know that 'e' is not 'univ' and the slice of the chain above 'e' is empty. -/ lemma extension_candidates_nonempty {e : Finset α} (hn : Fintype.card α = n) (h : extension_candidates 𝒜 e ≠ ∅) : #e < n ∧ (𝒜.toFinset # (#e + 1)) = ∅ := by by_contra! ass₀ apply h @@ -301,7 +397,7 @@ lemma extension_candidates_nonempty {e : Finset α} (hn : Fintype.card α = n) ( | inl next_ne_empty => by_contra! ass₁ obtain ⟨a, ha⟩ := nonempty_of_ne_empty ass₁ - simp [extension_candidates, chain_extension_filter_function] at ha + simp [extension_candidates, insert_extends_chain] at ha obtain ⟨u, hu⟩ := nonempty_of_ne_empty next_ne_empty simp [slice] at hu @@ -321,12 +417,25 @@ end ChainExtension section ChainSubsetFintype -/- Here we proof lemmata concerning the poset of the subset relation on sets of finite type-/ +/-! +# ChainSubsetFintype + +Here we proof Lemmata on the poset of the subset relation on sets containing elements of a 'Fintype'. + +## Main results + +- `Chain.empty_layer_by_card`: Any chain of sets of 'Fintype α' that contains less than 'Fintype.card α' sets, contains an empty slice. +- `Chain.empty_layer_by_card`: In a maximal chain every slice contains exactly one element. +- `IsMaxChain.card`: The cardinality of a maximal chain of sets of some 'Fintpype α' is 'Fintype.card α + 1'. +- `IsChain.card_le`: The cardinality of a chain of sets of some 'Fintpype α' is at most 'Fintype.card α + 1'. +- `IsMaxChain.iff_card`: A chain of sets of some 'Fintpype α' is maximal if and only if it contains 'Fintype.card α + 1' sets. +-/ variable {α : Type*} [Fintype α] {𝒜 : Set (Finset α)} [DecidablePred (· ∈ 𝒜)] instance : Fintype 𝒜 := setFintype 𝒜 +/- Any chain of sets of 'Fintype α' that contains less than 'Fintype.card α' sets, contains an empty slice.-/ lemma Chain.empty_layer_by_card (hn : Fintype.card α = n) (chain𝒜 : IsChain (· ⊂ ·) 𝒜) (card𝒜 : #𝒜.toFinset < n+1) : ∃ i : Fin (n + 1), #(𝒜.toFinset # i) = 0 := by by_contra! ass have : ∀ (i : Fin (n + 1)), #(𝒜.toFinset # i) = 1 := by @@ -345,6 +454,7 @@ lemma Chain.empty_layer_by_card (hn : Fintype.card α = n) (chain𝒜 : IsChain _ = n + 1 := by rw [←(Finset.card_eq_sum_ones (Iic (Fintype.card α)))]; simp [hn] linarith +/- In a maximal chain every slice contains exactly one element.-/ lemma IsMaxChain.one_elt_max_chain_layer [DecidableEq α] (hn : Fintype.card α = n) (maxchain𝒜 : IsMaxChain (· ⊂ ·) 𝒜) (j : Finset.range (n + 1)) : #(𝒜.toFinset # j) = 1 := by by_contra! ass @@ -486,10 +596,11 @@ lemma IsMaxChain.one_elt_max_chain_layer [DecidableEq α] (hn : Fintype.card α linarith simp at extension_candidates_ne_empty obtain ⟨a, ha⟩ := extension_candidates_ne_empty - simp [extension_candidates, chain_extension_filter_function] at ha + simp [extension_candidates, insert_extends_chain] at ha have := Set.insert_eq_self.mp (maxchain𝒜.right ha.left (by simp)).symm exact ha.right this +/- The cardinality of a maximal chain of sets of some 'Fintpype α' is 'Fintype.card α + 1'.-/ lemma IsMaxChain.card [DecidableEq α] (hn : Fintype.card α = n) (maxChain𝒜 : IsMaxChain (· ⊂ ·) 𝒜) : #𝒜.toFinset = n + 1 := by rw [←sum_card_slice 𝒜.toFinset] @@ -501,6 +612,7 @@ lemma IsMaxChain.card [DecidableEq α] (hn : Fintype.card α = n) exact IsMaxChain.one_elt_max_chain_layer hn maxChain𝒜 ⟨j, by simp [Nat.lt_succ_of_le jmem]⟩ _ = n + 1 := by rw [←(Finset.card_eq_sum_ones (Iic (Fintype.card α)))]; simp [hn] +/- The cardinality of a chain of sets of some 'Fintpype α' is at most 'Fintype.card α + 1'.-/ lemma IsChain.card_le (hn : Fintype.card α = n) (chain𝒜 : IsChain (· ⊂ ·) 𝒜) : #𝒜.toFinset ≤ n + 1 := by rw [←sum_card_slice 𝒜.toFinset] calc @@ -510,6 +622,7 @@ lemma IsChain.card_le (hn : Fintype.card α = n) (chain𝒜 : IsChain (· ⊂ · exact IsChain.max_one_elt_chain_layer chain𝒜 j _ = n + 1 := by rw [←(Finset.card_eq_sum_ones (Iic (Fintype.card α)))]; simp [hn] +/- A chain of sets of some 'Fintpype α' is maximal if and only if it contains 'Fintype.card α + 1' sets.-/ lemma IsMaxChain.iff_card [DecidableEq α] (hn : Fintype.card α = n) (chain𝒜 : IsChain (· ⊂ ·) 𝒜) : IsMaxChain (· ⊂ ·) 𝒜 ↔ #𝒜.toFinset = n + 1 := by constructor @@ -530,9 +643,15 @@ end ChainSubsetFintype section ChainCardinalityOrder -/- - Given a finite chain of finite sets with respect to the subset relation, we consider the list of chain elements. - Here we proof that if this list is sorted with respect to the cardinalities it is actually sorted in a strictly monotone manner. +/-! +# ChainCardinalityOrder + +In this chapter we consider the list of the elements of a finite chain of finite sets with respect to the subset relation. +Further we introduce the total order of the cardinalities of the sets in a chain. + +## Main results + +- `Chain.card_strict_mono`: Given a chain of sets of some 'Fintype α' there exists a permutation of the list of its elements, such that its elements cardinalities are sorted by strict inequalities. -/ variable {α : Type*} {𝒜 : Set (Finset α)} [DecidablePred (· ∈ 𝒜)] [Fintype α] @@ -573,6 +692,7 @@ lemma card_strict_mono' (chain𝒜 : IsChain (· ⊂ ·) 𝒜) : ((Finset.univ : exact elt_x_neq_elt_y elt_x_eq_elt_y +/- Given a chain of sets of some 'Fintype α' there exists a permutation of the list of its elements, such that its elements cardinalities are sorted by strict inequalities.-/ theorem Chain.card_strict_mono [DecidableEq α] (chain𝒜 : IsChain (· ⊂ ·) 𝒜) : ∃ l : List (Finset α), l ~ 𝒜.toFinset.toList ∧ l.Sorted (#· < #·) := by let l' := ((Finset.univ : Finset 𝒜).toList.insertionSort (fun (e₁ e₂ : 𝒜) ↦ #e₁.val ≤ #e₂.val)) have l'_sorted : l'.Sorted (fun (e₁ e₂ : 𝒜) ↦ #e₁.val < #e₂.val) := card_strict_mono' chain𝒜 diff --git a/TheBook/ToMathlib/List.lean b/TheBook/ToMathlib/List.lean index 0421b1c..253d192 100644 --- a/TheBook/ToMathlib/List.lean +++ b/TheBook/ToMathlib/List.lean @@ -3,10 +3,23 @@ import Mathlib.Data.List.Perm.Basic open Function Finset Nat Set BigOperators List +/-! +# List + +In this file we proof some simple facts about list duplicates and insertion sort. + +## Main results + +- `List.Nodup.orderedInsert`: Inserting a nonpresent element into a list by 'orderedInsert' does not create a list duplicate. +- `List.Nodup.insertionSort`: 'insertionSort' does not create duplicates in lists. +- `Finset.subtype_toList`: /- Mapping with 'Subtype.val' and the operation 'toList' commute. +-/ + section Nodup variable {α : Type*} (r : α → α → Prop) [LE α] [DecidableRel (fun (x₁ x₂ : α) ↦ x₁ ≤ x₂)] +/- Inserting a nonpresent element into a list by 'orderedInsert' does not create a list duplicate.-/ lemma List.Nodup.orderedInsert {l : List α} {a : α} (l_nodup : l.Nodup) (a_not_mem : a ∉ l) : (orderedInsert (· ≤ ·) a l).Nodup := by @@ -39,7 +52,8 @@ lemma List.Nodup.orderedInsert · exact l_nodup.left · exact ih l_nodup.right a_not_mem.right -lemma List.Nodup.insertionSort {l : List α} (h : l.Nodup) : (l.insertionSort (fun (x₁ x₂ : α) ↦ x₁ ≤ x₂)).Nodup := by +/- 'insertionSort' does not create duplicates in lists.-/ +theorem List.Nodup.insertionSort {l : List α} (h : l.Nodup) : (l.insertionSort (fun (x₁ x₂ : α) ↦ x₁ ≤ x₂)).Nodup := by induction l with | nil => simp [List.insertionSort, List.Nodup] @@ -61,6 +75,7 @@ variable {α : Type*} {𝒜 : Set (Finset α)} [DecidablePred (· ∈ 𝒜)] [Fi instance : Fintype 𝒜 := setFintype 𝒜 +/- Mapping with 'Subtype.val' and the operation 'toList' commute.-/ lemma Finset.subtype_toList : List.map Subtype.val (Finset.univ : Finset 𝒜).toList ~ 𝒜.toFinset.toList := by refine' perm_iff_count.mpr _ intro a diff --git a/TheBook/ToMathlib/Slice.lean b/TheBook/ToMathlib/Slice.lean index ad5ba3a..f14ea57 100644 --- a/TheBook/ToMathlib/Slice.lean +++ b/TheBook/ToMathlib/Slice.lean @@ -9,6 +9,7 @@ open Finset variable {α : Type*} {𝒜 : Finset (Finset α)} {A A₁ A₂ : Finset α} {r r₁ r₂ : ℕ} +/- Equivalence for a slice to be a singleton.-/ lemma singleton_explicit : (𝒜 # s) = {layer_s} ↔ layer_s ∈ 𝒜 ∧ #layer_s = s ∧ #(𝒜 # s) = 1 := by constructor · intro h From 6b4343a6766561e17669f7e83bd0db60c1c5fe37 Mon Sep 17 00:00:00 2001 From: Jakob Zimmermann Date: Fri, 7 Feb 2025 21:17:29 +0100 Subject: [PATCH 26/26] Completed doc strings. --- TheBook/Combinatorics/LYM.lean | 16 ++++- .../SpernerHelpingDataStructures.lean | 67 +++++++++++-------- TheBook/ToMathlib/Antichain.lean | 2 +- TheBook/ToMathlib/Chain.lean | 48 ++++++------- TheBook/ToMathlib/List.lean | 12 ++-- TheBook/ToMathlib/Slice.lean | 2 +- TheBook/ToMathlib/fsda.txt | 0 7 files changed, 85 insertions(+), 62 deletions(-) create mode 100644 TheBook/ToMathlib/fsda.txt diff --git a/TheBook/Combinatorics/LYM.lean b/TheBook/Combinatorics/LYM.lean index 0a08ed8..7a6d4ee 100644 --- a/TheBook/Combinatorics/LYM.lean +++ b/TheBook/Combinatorics/LYM.lean @@ -12,6 +12,16 @@ import TheBook.ToMathlib.Antichain import TheBook.ToMathlib.List import TheBook.Combinatorics.SpernerHelpingDataStructures +/-! +# LYM + +In this file we give the proof of the **Lubell-Yamamoto-Meshalkin inequality** as it is given in the book of the proofs. +Sperner's Theorem follows from this as a corollary (compare with Mathlib.Combinatorics.SetFamily.LYM). + +## Main results +- `lym_inequality`: The sum of the proportional cardinalities of all slices of an antichain is at most '1'. +-/ + open Function Finset Nat Set BigOperators List variable {α : Type*} {n m : ℕ} [DecidableEq α] [Fintype α] {𝒜 : Set (Finset α)} [DecidablePred (· ∈ 𝒜)] [DecidableEq (Set (Finset α))] @@ -19,7 +29,7 @@ instance : Fintype 𝒜 := setFintype 𝒜 namespace Finset -/-- The **Lubell-Yamamoto-Meshalkin inequality**. Sperner's Theorem follows as in Mathlib.Combinatorics.SetFamily.LYM as a corollary -/ +/-- The sum of the proportional cardinalities of all slices of an antichain is at most '1'. -/ theorem lym_inequality (antichain𝒜 : IsAntichain (· ⊂ ·) 𝒜) (hn : Fintype.card α = n): ∑ k ∈ Iic n, #(𝒜.toFinset # k) / (n.choose k : ℚ) ≤ (1 : ℚ) := by have : ∑ k ∈ Iic n, #(𝒜.toFinset # k) / (n.choose k : ℚ) ≤ (∑ k ∈ Iic n, #(𝒜.toFinset # k) * (k)! * (n - k)!) * (1 / (n)! : ℚ) := by @@ -82,5 +92,7 @@ theorem lym_inequality (antichain𝒜 : IsAntichain (· ⊂ ·) 𝒜) (hn : Fint apply Finset.sum_congr (by simp) intro e e_mem rw [Finset.card_image_of_injective (Finset.univ : Finset (MaxChainThrough {e})) inj_emb_MaxChainThrough, Finset.card_univ] - _ = #(𝒜.toFinset.disjiUnion (fun e : Finset α ↦ (Finset.univ : Finset (MaxChainThrough {e})).image (emb_MaxChainThrough {e})) (by simp [AntiChain.disj_union_chain_through antichain𝒜])) := by sorry + _ = #(𝒜.toFinset.disjiUnion (fun e : Finset α ↦ (Finset.univ : Finset (MaxChainThrough {e})).image (emb_MaxChainThrough {e})) (by simp [AntiChain.disj_union_chain_through antichain𝒜])) := by + + sorry _ ≤ (n)! := by sorry diff --git a/TheBook/Combinatorics/SpernerHelpingDataStructures.lean b/TheBook/Combinatorics/SpernerHelpingDataStructures.lean index f9bfbe5..bb25fa9 100644 --- a/TheBook/Combinatorics/SpernerHelpingDataStructures.lean +++ b/TheBook/Combinatorics/SpernerHelpingDataStructures.lean @@ -11,20 +11,31 @@ namespace Finset section MaxChainThrough -/- - In this section we define the maximal chains with respect to the subset relation that extend a given chain. - Further in the finite case we give an explicit formula for the number of such maximal extensions. +/-! +# Sperner Helping Data Structures + +## Main results +- `incident_indices_monotone_cards`: Two sets in a chain with no intermediate sets are incident in the list of chain elements that is sorted by cardinality. +- `chain_through_extension_candidates_pairwiseDisjoint`: The maximal chains through 'Insert x e' and 'ℬ' for extension candidates of 'e' in 'ℬ' are pairwise disjoint. +- `central_identity`: The set of maximal chains through 'ℬ' equals the disjoint union all chains through 'ℬ' and 'Insert x e' for all extension candidates 'x' of 'e' in 'ℬ' in case that these extension candidates are nonempty. +- `count_maxChainsThrough`: An exact formula for the number of maximal chains through any given chain. +- `count_maxChains_through_singleton_insert_empty`: Inserting the empty set into a chain does not change the maximal chains running through. +- `count_maxChains_through_singleton_insert_univ`: Inserting the universal set into a chain does not change the maximal chains running through. +- `count_maxChains_through_empty`: The count of maximal chains through the empty set is 'n!'. +- `count_maxChains_through_univ`: The count of maximal chains through the universal set is 'n!'. +- `count_maxChains_through_singleton`: The count of maximal chains through a set 'e' is '(n - #e)! * (#e)!'. -/ + structure MaxChainThrough (ℬ : Set (Finset α)) where - /- The set of elements in the chain.-/ + /- The set of elements in the chain. -/ 𝒜 : Set (Finset α) - /- '𝒜' is a maximal chain.-/ + /- '𝒜' is a maximal chain. -/ isMaxChain : IsMaxChain (· ⊂ ·) 𝒜 - /- '𝒜' is a subset of 'ℬ'.-/ + /- '𝒜' is a subset of 'ℬ'. -/ subChain : ℬ ⊆ 𝒜 -/- Projection of 'MaxChainThrough' on the set of elements.-/ +/- Projection of 'MaxChainThrough' on the set of elements. -/ def emb_MaxChainThrough (ℬ : Set (Finset α)) (X : MaxChainThrough ℬ) : Set (Finset α) := X.𝒜 /- Definition of equality of two variables of type 'MaxChainThrough'-/ @@ -33,7 +44,7 @@ def emb_MaxChainThrough (ℬ : Set (Finset α)) (X : MaxChainThrough ℬ) : Set cases 𝒞₂ congr -/- 'emb_MaxChainThrough' is injective.-/ +/- 'emb_MaxChainThrough' is injective. -/ lemma inj_emb_MaxChainThrough : Injective (emb_MaxChainThrough ℬ) := by intro 𝒞₁ 𝒞₂ h unfold emb_MaxChainThrough at h @@ -53,30 +64,22 @@ instance {C : MaxChainThrough ℬ} : Fintype C.𝒜 := setFintype C.𝒜 instance : Fintype ℬ := setFintype ℬ instance : Fintype 𝒜 := setFintype 𝒜 - -lemma card_maxChainThrough (hn : Fintype.card α = n) (chain : MaxChainThrough ℬ) : #chain.𝒜.toFinset = n + 1 := by - rw [←sum_card_slice chain.𝒜.toFinset] - calc - ∑ r ∈ Iic (Fintype.card α), #(chain.𝒜.toFinset # r) = ∑ r ∈ Iic (Fintype.card α), 1 := by - apply sum_congr (by rfl) - intro j jmem - simp [hn] at jmem - exact IsMaxChain.one_elt_max_chain_layer hn chain.isMaxChain ⟨j, by simp [Nat.lt_succ_of_le jmem]⟩ - _ = n + 1 := by rw [←(card_eq_sum_ones (Iic (Fintype.card α)))]; simp [hn] - +/- The first entry in a list of Finsets containing the empty set that is ordered by cardinality is the empty set. -/ lemma first_entry (list : List (Finset α)) (monotone_cards: List.Sorted (fun (e₁ e₂) ↦ #e₁ < #e₂) list) (h_list: ℬ.toFinset.toList ~ list) (empty_in_chain : ∅ ∈ ℬ) : list[0]'(by rw [←Perm.length_eq h_list]; exact length_pos_of_mem (mem_toList.mpr (mem_toFinset.mpr empty_in_chain))) = ∅ := by sorry +/- The first entry in a list of Finsets containing the universal set that is ordered by cardinality is the universal set. -/ lemma last_entry {list : List (Finset α)} (monotone_cards: List.Sorted (fun (e₁ e₂) ↦ #e₁ < #e₂) list) (h_list: ℬ.toFinset.toList ~ list) (univ_in_chain : univ ∈ ℬ) : list[list.length - 1]'(by sorry) = univ := by sorry -lemma incident_indices_monotone_cards {s t : Fin (n + 1)} {ℬ : Finset (Finset α)} (ilej_succ_succ : s.val + 2 ≤ t.val) (list : List (Finset α)) +/- Two sets in a chain with no intermediate sets are incident in the list of chain elements that is sorted by cardinality. -/ +lemma incident_indices_monotone_cards {s t : Fin (n + 1)} {ℬ : Finset (Finset α)} (s_lt_t : s < t) (list : List (Finset α)) (monotone_cards: List.Sorted (fun (e₁ e₂) ↦ #e₁ < #e₂) list) (h_list: ℬ.toList ~ list) (hs : (ℬ # s) = {layer_s}) (ht : (ℬ # t) = {layer_t}) (empty_layer : ∀ j : Fin (n + 1), s < j → j < t → #(ℬ # ↑j) = 0) : - ∃ i_s : Fin (list.length - 1), list[i_s.val] = layer_s ∧ list[i_s.val + 1] = layer_t := by + ∃ i_s : Fin (list.length - 1), list[i_s.val] = layer_s ∧ list[i_s.val + 1] = layer_t := by let i_s := list.indexOf layer_s have i_s_in_range : i_s < list.length := List.indexOf_lt_length.mpr (h_list.subset (mem_toList.mpr (Slice.singleton_explicit.mp hs).left)) @@ -108,7 +111,8 @@ lemma incident_indices_monotone_cards {s t : Fin (n + 1)} {ℬ : Finset (Finset have : t.val ≤ s.val := by simp [←(Slice.singleton_explicit.mp hs).right.left, ←(Slice.singleton_explicit.mp ht).right.left] exact this - linarith + simp at this + omega have i_s_succ_lt : i_s + 1 < i_t := Nat.lt_of_le_of_ne this fun a => ass₁ (id (Eq.symm a)) let e := list[i_s + 1] @@ -151,13 +155,14 @@ lemma incident_indices_monotone_cards {s t : Fin (n + 1)} {ℬ : Finset (Finset simp only [i_s_eq_i_t_succ] at h_i_t exact ⟨h_i_s, h_i_t⟩ +/- The projections of all maximal chains through '(Insert.insert x e)' and 'ℬ'. -/ def extensions_wrt [DecidableEq (Set (Finset α))] [DecidableEq (Finset α)] (ℬ : Set (Finset α)) (e : Finset α) (x : α) : Finset (Set (Finset α)) := by let ℬ' := Insert.insert (Insert.insert x e) ℬ - let e := (emb_MaxChainThrough ℬ') exact (univ : Finset (MaxChainThrough ℬ')).image (emb_MaxChainThrough ℬ') variable [DecidableEq (Set (Finset α))] [DecidableEq (Finset α)] +/- The maximal chains through 'Insert x e' and 'ℬ' for extension candidates 'e' are pairwise disjoint. -/ lemma chain_through_extension_candidates_pairwiseDisjoint {e : Finset α} (e_mem : e ∈ ℬ) : PairwiseDisjoint (extension_candidates ℬ e) (extensions_wrt ℬ e) := by intro x hx y hy xneqy simp [_root_.Disjoint] @@ -206,6 +211,7 @@ lemma chain_through_extension_candidates_pairwiseDisjoint {e : Finset α} (e_mem | inl h => exact xneqy h.symm | inr h => exact y_nmem h +/- The set of maximal chains through 'ℬ' equals the disjoint union all chains through 'ℬ' and 'Insert x e' for all extension candidates 'x' of 'e' in 'ℬ' in case that these extension candidates are nonempty. -/ lemma central_identity (e : Finset α) (e_mem : e ∈ ℬ) (h : extension_candidates ℬ e ≠ ∅): (univ : Finset (MaxChainThrough ℬ)).image (emb_MaxChainThrough ℬ) = (extension_candidates ℬ e).disjiUnion (extensions_wrt ℬ e) (chain_through_extension_candidates_pairwiseDisjoint e_mem) := by @@ -241,10 +247,12 @@ lemma central_identity (e : Finset α) (e_mem : e ∈ ℬ) (h : extension_candid · sorry · sorry +/- In a non-maximal chain containing the empty and universal set there are two non-neighbouring slices with no intermediate chain elements. -/ lemma range_empty_layer (hn : Fintype.card α = n) (chain𝒜 : IsChain (· ⊂ ·) 𝒜) (empty_layer : ∃ i : Fin (n + 1), #(𝒜.toFinset # i) = 0) (empty_elt : ∅ ∈ 𝒜) (univ_elt : univ ∈ 𝒜) : ∃ s : Fin (n + 1), ∃ t : Fin (n + 1), s.val + 2 ≤ t.val ∧ #(𝒜.toFinset # s) = 1 ∧ #(𝒜.toFinset # t) = 1 ∧ ∀ j : Fin (n + 1), s < j ∧ j < t → #(𝒜.toFinset # j) = 0 := by sorry -lemma count_maxChainsThrough (h_mn : m ≤ n + 1) (hn : Fintype.card α = n) +/- An exact formula for the number of maximal chains through any given chain. -/ +theorem count_maxChainsThrough (h_mn : m ≤ n + 1) (hn : Fintype.card α = n) (cardℬ : #ℬ.toFinset = m) (chainℬ : IsChain (· ⊂ ·) ℬ) (empty_in_chain : ∅ ∈ ℬ) (univ_in_chain : univ ∈ ℬ) (list : List (Finset α)) (list_per : ℬ.toFinset.toList ~ list) (list_sorted : list.Sorted (#· < #·)): Fintype.card (MaxChainThrough ℬ) = ∏ j : Fin (list.length - 1), (#list[j.val + 1] - #list[j.val])! := by @@ -296,7 +304,7 @@ lemma count_maxChainsThrough (h_mn : m ≤ n + 1) (hn : Fintype.card α = n) have := list_per - obtain ⟨i_s, ⟨entry_i_s, entry_i_s_succ⟩⟩ := incident_indices_monotone_cards ilej_succ_succ list list_sorted list_per hs ht empty_layer + obtain ⟨i_s, ⟨entry_i_s, entry_i_s_succ⟩⟩ := incident_indices_monotone_cards (by sorry) list list_sorted list_per hs ht empty_layer have i_s_in_range : i_s < list.length := Nat.lt_of_lt_of_le i_s.is_lt (Nat.pred_le list.length) have i_s_succ_in_range : i_s.val + 1 < list.length := add_lt_of_lt_sub i_s.is_lt @@ -494,14 +502,19 @@ lemma count_maxChainsThrough (h_mn : m ≤ n + 1) (hn : Fintype.card α = n) rcases X with ⟨X.𝒜, b, c⟩ simpa +/- Inserting the empty set into a chain does not change the maximal chains running through. -/ lemma count_maxChains_through_singleton_insert_empty : Fintype.card (MaxChainThrough ℬ) = Fintype.card (MaxChainThrough (insert ∅ ℬ)) := by sorry +/- Inserting the universal set into a chain does not change the maximal chains running through. -/ lemma count_maxChains_through_singleton_insert_univ : Fintype.card (MaxChainThrough ℬ) = Fintype.card (MaxChainThrough (insert univ ℬ)) := by sorry +/- The count of maximal chains through the empty set is 'n!'. -/ lemma count_maxChains_through_empty (hn : Fintype.card α = n): Fintype.card (MaxChainThrough {(∅ : Finset α)}) = n! := by sorry +/- The count of maximal chains through the universal set is 'n!'. -/ lemma count_maxChains_through_univ (hn : Fintype.card α = n): Fintype.card (MaxChainThrough {(Finset.univ : Finset α)}) = n! := by sorry +/- The count of maximal chains through a set 'e' is '(n - #e)! * (#e)!'. -/ lemma count_maxChains_through_singleton (e : Finset α) (hn : Fintype.card α = n): Fintype.card (MaxChainThrough {e}) = (#e)! * (n - #e)! := by by_cases e_empty : ∅ ≠ e · by_cases e_univ : univ ≠ e @@ -532,8 +545,4 @@ lemma count_maxChains_through_singleton (e : Finset α) (hn : Fintype.card α = · sorry · sorry - - - - end MaxChainThrough diff --git a/TheBook/ToMathlib/Antichain.lean b/TheBook/ToMathlib/Antichain.lean index 5824578..2ea2c18 100644 --- a/TheBook/ToMathlib/Antichain.lean +++ b/TheBook/ToMathlib/Antichain.lean @@ -7,7 +7,7 @@ instance : Fintype 𝒜 := setFintype 𝒜 namespace Finset -/- The maximal chains through different elements of an antichain are pairwise disjoint.-/ +/- The maximal chains through different elements of an antichain are pairwise disjoint. -/ lemma AntiChain.disj_union_chain_through (anti_chain : IsAntichain (· ⊂ ·) 𝒜) : 𝒜.PairwiseDisjoint (fun e ↦ ((Finset.univ : Finset (MaxChainThrough {e})).image (emb_MaxChainThrough {e}))) := by intro e₁ e₁_mem_𝒜 e₂ e₂_mem_𝒜 e₁neqe₂ diff --git a/TheBook/ToMathlib/Chain.lean b/TheBook/ToMathlib/Chain.lean index 5a38c5b..67841b2 100644 --- a/TheBook/ToMathlib/Chain.lean +++ b/TheBook/ToMathlib/Chain.lean @@ -46,7 +46,7 @@ and use the subset and the proper subset relation interchangably. variable {α : Type*} {𝒜 : Finset (Finset α)} {ℬ : Finset (Set α)} {𝒞 : Set (Finset α)} {𝒟 : Set (Set α)} -/- A set of sets is a chain with respect to the proper subset relation if and only if it is a chain with respect to the subset relation.-/ +/- A set of sets is a chain with respect to the proper subset relation if and only if it is a chain with respect to the subset relation. -/ lemma IsChain.equivalence_subset_relations : (IsChain (· ⊆ .) 𝒟) ↔ (IsChain (· ⊂ .) 𝒟) := by constructor · intro h e₁ e₁mem e₂ e₂mem e₁neqe₂ @@ -58,7 +58,7 @@ lemma IsChain.equivalence_subset_relations : (IsChain (· ⊆ .) 𝒟) ↔ (IsCh | inl e₁sube₂ => left; exact e₁sube₂.left | inr e₂sube₁ => right; exact e₂sube₁.left -/- A set of sets is a maximal chain with respect to the proper subset relation if and only if it is a chain with respect to the subset relation-/ +/- A set of sets is a maximal chain with respect to the proper subset relation if and only if it is a chain with respect to the subset relation. -/ lemma IsMaxChain.equivalence_subset_relations : (IsMaxChain (· ⊆ .) 𝒟) ↔ (IsMaxChain (· ⊂ .) 𝒟) := by constructor · intro h @@ -69,7 +69,7 @@ lemma IsMaxChain.equivalence_subset_relations : (IsMaxChain (· ⊆ .) 𝒟) ↔ instance : Coe (IsChain (· ⊆ ·) 𝒟) (IsChain (· ⊂ ·) 𝒟) := ⟨fun h => IsChain.equivalence_subset_relations.mp h⟩ instance : Coe (IsChain (· ⊂ ·) 𝒟) (IsChain (· ⊆ ·) 𝒟) := ⟨fun h => IsChain.equivalence_subset_relations.mpr h⟩ -/- A set of sets is a chain if the set of the corresponding finite sets is a chain (with respect to the proper subset relation).-/ +/- A set of sets is a chain if the set of the corresponding finite sets is a chain (with respect to the proper subset relation). -/ instance : Coe (IsChain (· ⊂ ·) 𝒞) (IsChain (· ⊂ ·) (toSet '' 𝒞)) := ⟨ by intro h intro x hx y hy x_neg_y @@ -85,7 +85,7 @@ instance : Coe (IsChain (· ⊂ ·) 𝒞) (IsChain (· ⊂ ·) (toSet '' 𝒞)) exact h hx'.left hy'.left x'_neg_y' ⟩ -/- A set of sets is a chain if the set of the corresponding finite sets is a chain (with respect to the subset relation).-/ +/- A set of sets is a chain if the set of the corresponding finite sets is a chain (with respect to the subset relation). -/ instance : Coe (IsChain (· ⊆ ·) 𝒞) (IsChain (· ⊆ ·) (toSet '' 𝒞)) := ⟨ by intro h intro x hx y hy x_neg_y @@ -101,30 +101,30 @@ instance : Coe (IsChain (· ⊆ ·) 𝒞) (IsChain (· ⊆ ·) (toSet '' 𝒞)) exact h hx'.left hy'.left x'_neg_y' ⟩ -/- A set of finite sets is a chain if the set of the corresponding sets is a chain (with respect to the proper subset relation).-/ +/- A set of finite sets is a chain if the set of the corresponding sets is a chain (with respect to the proper subset relation). -/ instance : Coe (IsChain (· ⊂ ·) (toSet '' 𝒞)) (IsChain (· ⊂ ·) 𝒞) := - ⟨ fun h _ hx _ hy x_neg_y ↦ h (Set.mem_image_of_mem toSet hx) (Set.mem_image_of_mem toSet hy) (fun ass ↦ x_neg_y (coe_inj.mp ass))⟩ + ⟨fun h _ hx _ hy x_neg_y ↦ h (Set.mem_image_of_mem toSet hx) (Set.mem_image_of_mem toSet hy) (fun ass ↦ x_neg_y (coe_inj.mp ass))⟩ -/- A set of finite sets is a chain if the set of the corresponding sets is a chain (with respect to the subset relation).-/ +/- A set of finite sets is a chain if the set of the corresponding sets is a chain (with respect to the subset relation). -/ instance : Coe (IsChain (· ⊆ ·) (toSet '' 𝒞)) (IsChain (· ⊆ ·) 𝒞) := - ⟨ fun h _ hx _ hy x_neg_y ↦ h (Set.mem_image_of_mem toSet hx) (Set.mem_image_of_mem toSet hy) (fun ass ↦ x_neg_y (coe_inj.mp ass))⟩ + ⟨fun h _ hx _ hy x_neg_y ↦ h (Set.mem_image_of_mem toSet hx) (Set.mem_image_of_mem toSet hy) (fun ass ↦ x_neg_y (coe_inj.mp ass))⟩ -/- Now we can write the following examples without coercion errors.-/ +/- Now we can write the following examples without coercion errors. -/ example (h : IsChain (· ⊂ ·) 𝒞) : (IsChain (· ⊆ ·) (toSet '' 𝒞)) := h example (h : IsChain (· ⊂ ·) (toSet '' 𝒞)) : (IsChain (· ⊆ ·) 𝒞) := h -/- Considering the next two examples we might want to have also a coercion from 'IsChain (· ⊂ ·) 𝒞' to 'IsChain (· ⊂ ·) 𝒞.toFinset.toSet', but we do not need it.-/ +/- Considering the next two examples we might want to have also a coercion from 'IsChain (· ⊂ ·) 𝒞' to 'IsChain (· ⊂ ·) 𝒞.toFinset.toSet', but we do not need it. -/ example [Fintype 𝒞] (h : IsChain (· ⊂ ·) 𝒞) : (IsChain (· ⊆ ·) 𝒞.toFinset.toSet) := by simp; exact (h : IsChain (· ⊆ ·) 𝒞) example [Fintype 𝒟] (h : IsChain (· ⊆ ·) 𝒟) : (IsChain (· ⊂ ·) 𝒟.toFinset.toSet) := by simp; exact (h : IsChain (· ⊂ ·) 𝒟) -/- For completion consider also the following examples.-/ +/- For completion consider also the following examples. -/ example (h : IsChain (· ⊂ ·) 𝒜.toSet) : (IsChain (· ⊆ ·) 𝒜.toSet) := h example (h : IsChain (· ⊂ ·) ℬ.toSet) : (IsChain (· ⊆ ·) ℬ.toSet) := h example (h : IsChain (· ⊆ ·) 𝒜.toSet) : (IsChain (· ⊂ ·) 𝒜.toSet) := h example (h : IsChain (· ⊆ ·) ℬ.toSet) : (IsChain (· ⊂ ·) ℬ.toSet) := h example (h : IsChain (· ⊂ ·) 𝒜.toSet) : (IsChain (· ⊆ ·) (toSet '' 𝒜.toSet)) := h -/- A general observation-/ +/- A general observation. -/ example : IsTrans 𝒟 (fun (e₁ e₂ : 𝒟) ↦ e₁.val ⊆ e₂.val) := by apply IsTrans.swap end ChainCoercions @@ -146,7 +146,7 @@ In this section we consider Lemmata on general chains with respect to the subset variable {α : Type*} {𝒞 : Set (Finset α)} {𝒟 : Set (Set α)} -/- Two elements in a chain of equal cardinality must be equal.-/ +/- Two elements in a chain of equal cardinality must be equal. -/ lemma IsChain.unique_of_cardinality_chain (chain𝒞 : IsChain (· ⊂ ·) 𝒞) {a b : Finset α} (amem : a ∈ 𝒞) (bmem : b ∈ 𝒞) (hcard : #a = #b) : a = b := by by_contra aneb @@ -158,7 +158,7 @@ lemma IsChain.unique_of_cardinality_chain (chain𝒞 : IsChain (· ⊂ ·) 𝒞) have := Finset.card_strictMono h linarith -/- In a finite chain each slice (layer) contains at most one element.-/ +/- In a finite chain each slice (layer) contains at most one element. -/ lemma IsChain.max_one_elt_chain_layer [Fintype 𝒞] (chain𝒞 : IsChain (· ⊂ ·) 𝒞) (j : ℕ) : #(𝒞.toFinset # j) ≤ 1 := by by_contra! ass have : (𝒞.toFinset # j) ≠ (∅ : Finset (Finset α)) := by @@ -171,7 +171,7 @@ lemma IsChain.max_one_elt_chain_layer [Fintype 𝒞] (chain𝒞 : IsChain (· have := Finset.slice_subset (bmem) exact aneb (IsChain.unique_of_cardinality_chain chain𝒞 (mem_toFinset.mp (Finset.slice_subset bmem)) (mem_toFinset.mp (Finset.slice_subset amem)) cardeqab.symm) -/- In a finite chain a non-empty layer is a singleton.-/ +/- In a finite chain a non-empty layer is a singleton. -/ lemma Chain.layer_singleton_of_nonempty [Fintype 𝒞] (chain𝒞 : IsChain (· ⊂ ·) 𝒞) (j : Finset.range (n + 1)) (layer_nonempty : (𝒞.toFinset # j) ≠ ∅): ∃! e : Finset α, 𝒞.toFinset # j = {e} := by have : # (𝒞.toFinset # j) = 1 := by @@ -189,7 +189,7 @@ lemma Chain.layer_singleton_of_nonempty [Fintype 𝒞] (chain𝒞 : IsChain (· exact ⟨e, he, unique⟩ -/- A strong inequality of the cardinality of two chain elements implies a proper subset relation.-/ +/- A strong inequality of the cardinality of two chain elements implies a proper subset relation. -/ lemma IsChain.ssubset_of_lt_cardinality (chain𝒞 : IsChain (· ⊂ ·) 𝒞) {e₁ e₂ : Finset α} (e₁mem : e₁ ∈ 𝒞) (e₂mem : e₂ ∈ 𝒞) (hcard : #e₁ < #e₂) : e₁ ⊂ e₂ := by have e₁nee₂ : e₁ ≠ e₂ := by @@ -202,7 +202,7 @@ lemma IsChain.ssubset_of_lt_cardinality (chain𝒞 : IsChain (· ⊂ ·) 𝒞) { have : #e₂ < #e₁ := Finset.card_strictMono h linarith -/- A weak inequality of the cardinality of two chain elements implies a subset relation.-/ +/- A weak inequality of the cardinality of two chain elements implies a subset relation. -/ lemma IsChain.subset_of_le_cardinality (chain𝒞 : IsChain (· ⊂ ·) 𝒞) {e₁ e₂ : Finset α} (e₁mem : e₁ ∈ 𝒞) (e₂mem : e₂ ∈ 𝒞) (hcard : #e₁ ≤ #e₂) : e₁ ⊆ e₂ := by cases Nat.eq_or_lt_of_le hcard with @@ -246,7 +246,7 @@ instance instDecidablePredChainExtension (e : Finset α) : def extension_candidates (ℬ : Set (Finset α)) (e : Finset α) := Finset.filter (insert_extends_chain ℬ e) (Finset.univ : Finset α) -/- Given two sets 'layer_i' and 'layer_j' in a chain such that there is no set of intermediate cardinality and '#layer_j ≥ #layer_i + 2', the extension candidates for 'layer_i' are given by 'layer_j \ layer_i'.-/ +/- Given two sets 'layer_i' and 'layer_j' in a chain such that there is no set of intermediate cardinality and '#layer_j ≥ #layer_i + 2', the extension candidates for 'layer_i' are given by 'layer_j \ layer_i'. -/ theorem extension_candidates_characterisation {i j : Finset.range (n + 1)} (hn : Fintype.card α = n) (ilej_succ_succ : (i : ℕ) + 2 ≤ (j : ℕ)) (chain𝒜 : IsChain (· ⊂ ·) 𝒜) (hi : (𝒜.toFinset # i) = {layer_i}) (hj : (𝒜.toFinset # j) = {layer_j}) (emptylayer : ∀ l ∈ (Finset.range (n + 1)), i < l → l < j → #(𝒜.toFinset # l) = 0): extension_candidates 𝒜 layer_i = layer_j \ layer_i := by @@ -435,7 +435,7 @@ variable {α : Type*} [Fintype α] {𝒜 : Set (Finset α)} [DecidablePred (· instance : Fintype 𝒜 := setFintype 𝒜 -/- Any chain of sets of 'Fintype α' that contains less than 'Fintype.card α' sets, contains an empty slice.-/ +/- Any chain of sets of 'Fintype α' that contains less than 'Fintype.card α' sets, contains an empty slice. -/ lemma Chain.empty_layer_by_card (hn : Fintype.card α = n) (chain𝒜 : IsChain (· ⊂ ·) 𝒜) (card𝒜 : #𝒜.toFinset < n+1) : ∃ i : Fin (n + 1), #(𝒜.toFinset # i) = 0 := by by_contra! ass have : ∀ (i : Fin (n + 1)), #(𝒜.toFinset # i) = 1 := by @@ -454,7 +454,7 @@ lemma Chain.empty_layer_by_card (hn : Fintype.card α = n) (chain𝒜 : IsChain _ = n + 1 := by rw [←(Finset.card_eq_sum_ones (Iic (Fintype.card α)))]; simp [hn] linarith -/- In a maximal chain every slice contains exactly one element.-/ +/- In a maximal chain every slice contains exactly one element. -/ lemma IsMaxChain.one_elt_max_chain_layer [DecidableEq α] (hn : Fintype.card α = n) (maxchain𝒜 : IsMaxChain (· ⊂ ·) 𝒜) (j : Finset.range (n + 1)) : #(𝒜.toFinset # j) = 1 := by by_contra! ass @@ -600,7 +600,7 @@ lemma IsMaxChain.one_elt_max_chain_layer [DecidableEq α] (hn : Fintype.card α have := Set.insert_eq_self.mp (maxchain𝒜.right ha.left (by simp)).symm exact ha.right this -/- The cardinality of a maximal chain of sets of some 'Fintpype α' is 'Fintype.card α + 1'.-/ +/- The cardinality of a maximal chain of sets of some 'Fintpype α' is 'Fintype.card α + 1'. -/ lemma IsMaxChain.card [DecidableEq α] (hn : Fintype.card α = n) (maxChain𝒜 : IsMaxChain (· ⊂ ·) 𝒜) : #𝒜.toFinset = n + 1 := by rw [←sum_card_slice 𝒜.toFinset] @@ -612,7 +612,7 @@ lemma IsMaxChain.card [DecidableEq α] (hn : Fintype.card α = n) exact IsMaxChain.one_elt_max_chain_layer hn maxChain𝒜 ⟨j, by simp [Nat.lt_succ_of_le jmem]⟩ _ = n + 1 := by rw [←(Finset.card_eq_sum_ones (Iic (Fintype.card α)))]; simp [hn] -/- The cardinality of a chain of sets of some 'Fintpype α' is at most 'Fintype.card α + 1'.-/ +/- The cardinality of a chain of sets of some 'Fintpype α' is at most 'Fintype.card α + 1'. -/ lemma IsChain.card_le (hn : Fintype.card α = n) (chain𝒜 : IsChain (· ⊂ ·) 𝒜) : #𝒜.toFinset ≤ n + 1 := by rw [←sum_card_slice 𝒜.toFinset] calc @@ -622,7 +622,7 @@ lemma IsChain.card_le (hn : Fintype.card α = n) (chain𝒜 : IsChain (· ⊂ · exact IsChain.max_one_elt_chain_layer chain𝒜 j _ = n + 1 := by rw [←(Finset.card_eq_sum_ones (Iic (Fintype.card α)))]; simp [hn] -/- A chain of sets of some 'Fintpype α' is maximal if and only if it contains 'Fintype.card α + 1' sets.-/ +/- A chain of sets of some 'Fintpype α' is maximal if and only if it contains 'Fintype.card α + 1' sets. -/ lemma IsMaxChain.iff_card [DecidableEq α] (hn : Fintype.card α = n) (chain𝒜 : IsChain (· ⊂ ·) 𝒜) : IsMaxChain (· ⊂ ·) 𝒜 ↔ #𝒜.toFinset = n + 1 := by constructor @@ -692,7 +692,7 @@ lemma card_strict_mono' (chain𝒜 : IsChain (· ⊂ ·) 𝒜) : ((Finset.univ : exact elt_x_neq_elt_y elt_x_eq_elt_y -/- Given a chain of sets of some 'Fintype α' there exists a permutation of the list of its elements, such that its elements cardinalities are sorted by strict inequalities.-/ +/- Given a chain of sets of some 'Fintype α' there exists a permutation of the list of its elements, such that its elements cardinalities are sorted by strict inequalities. -/ theorem Chain.card_strict_mono [DecidableEq α] (chain𝒜 : IsChain (· ⊂ ·) 𝒜) : ∃ l : List (Finset α), l ~ 𝒜.toFinset.toList ∧ l.Sorted (#· < #·) := by let l' := ((Finset.univ : Finset 𝒜).toList.insertionSort (fun (e₁ e₂ : 𝒜) ↦ #e₁.val ≤ #e₂.val)) have l'_sorted : l'.Sorted (fun (e₁ e₂ : 𝒜) ↦ #e₁.val < #e₂.val) := card_strict_mono' chain𝒜 diff --git a/TheBook/ToMathlib/List.lean b/TheBook/ToMathlib/List.lean index 253d192..a09daf6 100644 --- a/TheBook/ToMathlib/List.lean +++ b/TheBook/ToMathlib/List.lean @@ -6,20 +6,21 @@ open Function Finset Nat Set BigOperators List /-! # List -In this file we proof some simple facts about list duplicates and insertion sort. +In this file we introduce `foo` and `bar`, +two main concepts in the theory of xyzzyology. ## Main results - `List.Nodup.orderedInsert`: Inserting a nonpresent element into a list by 'orderedInsert' does not create a list duplicate. - `List.Nodup.insertionSort`: 'insertionSort' does not create duplicates in lists. -- `Finset.subtype_toList`: /- Mapping with 'Subtype.val' and the operation 'toList' commute. +- `Finset.subtype_toList`: Mapping with 'Subtype.val' and the operation 'toList' commute. -/ section Nodup variable {α : Type*} (r : α → α → Prop) [LE α] [DecidableRel (fun (x₁ x₂ : α) ↦ x₁ ≤ x₂)] -/- Inserting a nonpresent element into a list by 'orderedInsert' does not create a list duplicate.-/ +/-- Inserting a nonpresent element into a list by 'orderedInsert' does not create a list duplicate. -/ lemma List.Nodup.orderedInsert {l : List α} {a : α} (l_nodup : l.Nodup) (a_not_mem : a ∉ l) : (orderedInsert (· ≤ ·) a l).Nodup := by @@ -52,7 +53,7 @@ lemma List.Nodup.orderedInsert · exact l_nodup.left · exact ih l_nodup.right a_not_mem.right -/- 'insertionSort' does not create duplicates in lists.-/ +/-- 'insertionSort' does not create duplicates in lists. -/ theorem List.Nodup.insertionSort {l : List α} (h : l.Nodup) : (l.insertionSort (fun (x₁ x₂ : α) ↦ x₁ ≤ x₂)).Nodup := by induction l with | nil => @@ -75,7 +76,7 @@ variable {α : Type*} {𝒜 : Set (Finset α)} [DecidablePred (· ∈ 𝒜)] [Fi instance : Fintype 𝒜 := setFintype 𝒜 -/- Mapping with 'Subtype.val' and the operation 'toList' commute.-/ +/-- Mapping with 'Subtype.val' and the operation 'toList' commute. -/ lemma Finset.subtype_toList : List.map Subtype.val (Finset.univ : Finset 𝒜).toList ~ 𝒜.toFinset.toList := by refine' perm_iff_count.mpr _ intro a @@ -97,4 +98,5 @@ lemma Finset.subtype_toList : List.map Subtype.val (Finset.univ : Finset 𝒜).t exact h (mem_toFinset.mpr this) rw [count_rhs, count_lhs] + end Perm diff --git a/TheBook/ToMathlib/Slice.lean b/TheBook/ToMathlib/Slice.lean index f14ea57..44f2227 100644 --- a/TheBook/ToMathlib/Slice.lean +++ b/TheBook/ToMathlib/Slice.lean @@ -9,7 +9,7 @@ open Finset variable {α : Type*} {𝒜 : Finset (Finset α)} {A A₁ A₂ : Finset α} {r r₁ r₂ : ℕ} -/- Equivalence for a slice to be a singleton.-/ +/- Equivalence for a slice to be a singleton. -/ lemma singleton_explicit : (𝒜 # s) = {layer_s} ↔ layer_s ∈ 𝒜 ∧ #layer_s = s ∧ #(𝒜 # s) = 1 := by constructor · intro h diff --git a/TheBook/ToMathlib/fsda.txt b/TheBook/ToMathlib/fsda.txt new file mode 100644 index 0000000..e69de29