import analysis.normed.field.basic
import analysis.special_functions.pow

noncomputable theory

open_locale topological_space nnreal

def is_pow_mult {α : Type*} [ring α] (f : α → nnreal) :=
∀ (a : α) {n : ℕ} (hn : 1 ≤ n), f (a^n) = (f a) ^ n

structure is_seminorm {α : Type*} [ring α] (f : α → nnreal) : Prop :=
(zero : f 0 = 0)
(add : ∀ a b, f (a + b) ≤ f a + f b)
(mul : ∀ a b, f (a * b) ≤ f a * f b)

def is_norm_le_one_class {α : Type*} [ring α] (f : α → nnreal) : Prop := f 1 ≤  1

lemma is_seminorm.pow_le {α : Type*} [ring α] {f : α → nnreal} (hf : is_seminorm f) (a : α) :
  ∀ {n : ℕ}, 0 < n → f (a ^ n) ≤ (f a) ^ n
| 1 h := by simp only [pow_one]
| (n + 2) h := by simpa [pow_succ _ (n + 1)] using le_trans (hf.mul a _)
    (mul_le_mul_left' (is_seminorm.pow_le n.succ_pos) _)

def is_norm_one_class {α : Type*} [ring α] (f : α → nnreal) : Prop := f 1 = 1

lemma is_norm_one_le_class_norm_one {α : Type*} [ring α] {f : α → nnreal} (hsn : is_seminorm f)
  (hf1 : is_norm_le_one_class f) : f 1 = 0 ∨ f 1 = 1 :=
begin
  by_cases h0 : f 1 = 0,
  { exact or.inl h0 },
  { have h1 : f 1 * 1 ≤ f 1 * f 1,
    { conv_lhs{ rw ← one_mul (1 : α)},
      convert hsn.mul 1 1,
      rw mul_one, },
    rw mul_le_mul_left (lt_of_le_of_ne (zero_le (f 1)) (ne.symm h0)) at h1,
    exact or.inr (le_antisymm hf1 h1), }
end

lemma is_norm_one_class_iff_nontrivial {α : Type*} [ring α] {f : α → nnreal} (hsn : is_seminorm f)
  (hf1 : is_norm_le_one_class f) :
  is_norm_one_class f ↔ ∃ x : α, f x ≠ 0 :=
begin
  rw is_norm_one_class,
  refine ⟨λ h, _, λ h, _⟩,
  { use 1,
    rw h, exact one_ne_zero, },
  { obtain ⟨x, hx⟩ := h,
    by_cases hf0 : f 1 = 0,
    { have hx' : f x ≤ 0,
      { rw ← mul_one x,
        apply le_trans (hsn.mul x 1) _,
        rw [hf0, mul_zero], },
      exact absurd (le_antisymm hx' (f x).2 ) hx, },
    { cases is_norm_one_le_class_norm_one hsn hf1 with h0 h1,
      exacts [absurd h0 hf0, h1] }}
end

structure is_norm {α : Type*} [ring α] (f : α → nnreal) extends (is_seminorm f) : Prop :=
(ne_zero : ∀ a, a ≠ 0 → 0 < f a)

lemma is_norm.zero_of_norm_zero {α : Type*} [ring α] {f : α → nnreal} (hf : is_norm f) {x : α}
  (hfx : f x = 0) : x = 0 :=
begin
  by_contradiction hx,
  exact (ne_of_gt (hf.ne_zero x hx)) hfx,
end

structure is_mul_norm {α : Type*} [ring α] (f : α → nnreal) extends (is_norm f) : Prop :=
(mul_eq : ∀ a b, f (a * b) = f a * f b)

lemma is_mul_norm.to_is_pow_mult {α : Type*} [ring α] {f : α → nnreal} (hf : is_mul_norm f) :
  is_pow_mult f := λ x n hn,
begin
  induction n with n ih,
  { exfalso, linarith },
  { --rw [pow_succ, pow_succ, hf.mul_eq],
    by_cases hn1 : 1 ≤ n,
    { rw [pow_succ, pow_succ, hf.mul_eq, ih hn1] },
    { rw [not_le, nat.lt_one_iff] at hn1,
      rw [hn1, pow_one, pow_one], } }
end

structure is_algebra_norm {α : Type*} [comm_ring α] {g : α → nnreal} (hg : is_norm g)
  {β : Type*} [ring β] [algebra α β] (f : β → nnreal) extends (is_norm f) : Prop :=
(smul : ∀ (a : α) (x : β) , f (a • x) = g a * f x)

lemma is_algebra_norm_extends' {α : Type*} [comm_ring α] {g : α → nnreal} (hg : is_norm g)
  {β : Type*} [ring β] [algebra α β] {f : β → nnreal} (hf : is_algebra_norm hg f)
  (hf1 : is_norm_one_class f) (a : α) : f (a • 1) = g a :=
begin
  rw is_norm_one_class at hf1,
  rw [← mul_one (g a), ← hf1],
  exact hf.smul _ _,
end

lemma is_algebra_norm_extends {α : Type*} [comm_ring α] {g : α → nnreal} (hg : is_norm g)
  {β : Type*} [ring β] [algebra α β] {f : β → nnreal} (hf : is_algebra_norm hg f)
  (hf1 : is_norm_one_class f) (a : α) : f (algebra_map α β a) = g a :=
begin
  rw algebra.algebra_map_eq_smul_one,
  exact is_algebra_norm_extends' hg hf hf1 _,
end

lemma is_norm.zero_iff {α : Type*} [ring α] {f : α → nnreal} (hf : is_norm f) (a : α ) :
  f a = 0 ↔ a = 0 :=
begin
  refine ⟨_, λ h, by simpa [h] using hf.to_is_seminorm.zero⟩,
  { contrapose, intro h, exact ne_of_gt (hf.ne_zero a h), },
end
/- lemma root_norm_le_spectral_value (hf_pm : is_pow_mult f) (hf_u : is_ultrametric f)
  (hf_alg_norm : is_algebra_norm (normed_ring.to_is_norm K) f) {p : K[X]} (hp : p.monic) {x : L}
  (hx : polynomial.aeval x p = 0) : f x ≤ spectral_value hp  -/

-- Def. 2.1.1/2. Probably won't need to use this, since in is_algebra_norm I already assume faithful
structure is_faithful_norm {α : Type*} [comm_ring α] {g : α → nnreal} (hg : is_mul_norm g)
  {β : Type*} [ring β] [algebra α β] (f : β → nnreal) extends (is_norm f) : Prop :=
(smul : ∀ (a : α) (x : β) , f ((algebra_map α β a) * x) = g a * f x)

def function_extends {α : Type*} [comm_ring α] (g : α → nnreal) {β : Type*} [ring β] [algebra α β]
  (f : β → nnreal) : Prop :=
∀ x : α, f (algebra_map α β x) = g x

def is_nonarchimedean {α : Type*} [add_group α] (f : α → nnreal) : Prop :=
∀ a b, f (a - b) ≤ max (f a) (f b)

lemma is_nonarchimedean.neg {α : Type*} [add_group α] {f : α → nnreal} (hu : is_nonarchimedean f)
  (h0 : f 0 = 0) (x : α) : f (-x) = f x :=
begin
  apply le_antisymm,
  { rw [neg_eq_zero_sub, ← max_eq_right (zero_le (f x)), ← h0], exact hu _ _, },
  { nth_rewrite 0 [← neg_neg x],
    rw [neg_eq_zero_sub, ← max_eq_right (zero_le (f (-x))), ← h0], exact hu _ _, },
end

lemma is_nonarchimedean.add_le {α : Type*} [add_group α] {f : α → nnreal} (h0 : f 0 = 0)
  (hu : is_nonarchimedean f) (a b : α) : f (a + b) ≤ max (f a) (f b) :=
begin
  rw [← neg_neg b, ← sub_eq_add_neg, neg_neg, ← hu.neg h0 b], exact hu _ _,
end

/- def is_nonarchimedean {α : Type*} [add_monoid α] (f : α → nnreal) : Prop :=
∀ a b, f (a + b) ≤ max (f a) (f b) -/

lemma is_nonarchimedean_nmul {α : Type*} [ring α] {f : α → nnreal} (hsn : is_seminorm f)
  (hna : is_nonarchimedean f) (n : ℕ) (a : α) : f (n * a) ≤ (f a) :=
begin
  induction n with n hn,
  { rw [nat.cast_zero, zero_mul, hsn.zero], exact zero_le _ },
  { rw [nat.cast_succ, add_mul, one_mul],
    exact le_trans (is_nonarchimedean.add_le hsn.zero hna _ _) (max_le_iff.mpr ⟨hn, le_refl _⟩) }
end

lemma is_nonarchimedean_add_eq_max_of_ne {α : Type*} [ring α] {f : α → nnreal} (hsn : is_seminorm f)
  (hu : is_nonarchimedean f) {x y : α} (hne : f y ≠ f x) :
  f (x + y) = max (f x) (f y) :=
begin
  wlog hle := le_total (f y) (f x) using [x y],
  have hlt : f y < f x, from lt_of_le_of_ne hle hne,
  have : f x ≤ max (f (x + y)) (f y), from calc
    f x = f (x + y - y) : by congr; rw [add_sub_cancel]
               ... ≤ max (f (x + y)) (f (y)) : hu _ _,
  have hnge : f y ≤ f (x + y),
  { apply le_of_not_gt,
    intro hgt,
    rw max_eq_right_of_lt hgt at this,
    apply not_lt_of_ge this,
    assumption },
  have : f x ≤ f (x + y), by rwa [max_eq_left hnge] at this,
  apply le_antisymm,
  { exact hu.add_le hsn.zero _ _ },
  { rw max_eq_left_of_lt hlt,
    assumption },
  rw [add_comm, max_comm], exact this (ne.symm hne),
end

open_locale classical

lemma is_nonarchimedean_finset_add {α : Type*} [ring α] {f : α → nnreal} (hf0 : f 0 = 0)
  (hna : is_nonarchimedean f) (s : finset α) :
  ∃ (a : α) (ha : if s.nonempty then a ∈ s else a = 0), f (s.sum id) ≤ f a :=
begin
  apply finset.induction_on s,
  { rw [finset.sum_empty], use 0, simp only [finset.not_nonempty_empty, if_false],
    exact ⟨eq.refl _, le_refl _⟩, },
  { rintros a s has ⟨M, hMs, hM⟩,
    rw [finset.sum_insert has, id.def],
    by_cases hMa : f M ≤ f a,
    { refine ⟨a, by simp only [finset.insert_nonempty, finset.mem_insert, if_true, eq_self_iff_true,
        true_or], le_trans (is_nonarchimedean.add_le hf0 hna _ _)
        ( max_le_iff.mpr (⟨le_refl _,le_trans hM hMa⟩))⟩ },
    { rw not_le at hMa,
      by_cases hs : s.nonempty,
      { rw if_pos hs at hMs,
        refine ⟨M, _, le_trans (is_nonarchimedean.add_le hf0 hna _ _)
          (max_le_iff.mpr ⟨le_of_lt hMa, hM⟩)⟩,
        simp only [finset.insert_nonempty, finset.mem_insert, if_true],
        exact or.intro_right _ hMs, },
      { rw if_neg hs at hMs,
        exfalso,
        simp only [hMs, hf0, not_lt_zero'] at hMa,
        exact hMa, }}}
end

/- f ((finset.range n).sum (λ (i : ℕ), g i) -/

lemma is_nonarchimedean_finset_image_add {α : Type*} [ring α] {f : α → nnreal} (hf0 : f 0 = 0)
  (hna : is_nonarchimedean f) {β : Type*} [hβ : nonempty β] (g : β → α) (t : finset β) :
  ∃ (b : β) (hb : t.nonempty → b ∈ t), f (t.sum g) ≤ f (g b) :=
begin
  apply finset.induction_on t,
  { rw [finset.sum_empty],
    refine ⟨hβ.some, by simp only [finset.not_nonempty_empty, is_empty.forall_iff], _⟩,
    rw hf0, exact zero_le _, },
  { rintros a s has ⟨M, hMs, hM⟩,
    rw [finset.sum_insert has],
    by_cases hMa : f (g M) ≤ f (g a),
    { refine ⟨a, _, le_trans (is_nonarchimedean.add_le hf0 hna _ _)
        (max_le_iff.mpr (⟨le_refl _,le_trans hM hMa⟩))⟩,
      simp only [finset.nonempty_coe_sort, finset.insert_nonempty, finset.mem_insert,
        eq_self_iff_true, true_or, forall_true_left], },
    { rw not_le at hMa,
      by_cases hs : s.nonempty,
      { refine ⟨M, _, le_trans (is_nonarchimedean.add_le hf0 hna _ _)
          (max_le_iff.mpr ⟨le_of_lt hMa, hM⟩)⟩,
        simp only [finset.nonempty_coe_sort, finset.insert_nonempty, finset.mem_insert,
          forall_true_left],
          exact or.intro_right _ (hMs hs) },
      { use a,
        split,
        { simp only [finset.insert_nonempty, finset.mem_insert, eq_self_iff_true, true_or,
            forall_true_left] },
          have h0 : f (s.sum g) = 0,
          { rw [finset.not_nonempty_iff_eq_empty.mp hs, finset.sum_empty, hf0],},
          apply le_trans (is_nonarchimedean.add_le hf0 hna _ _),
          rw h0,
          exact max_le_iff.mpr ⟨le_refl _, zero_le _⟩, }}}
end

lemma is_nonarchimedean_multiset_image_add {α : Type*} [ring α] {f : α → nnreal} (hf0 : f 0 = 0)
  (hna : is_nonarchimedean f) {β : Type*} [hβ : nonempty β] (g : β → α) (s : multiset β) :
  ∃ (b : β) (hb : 0 < s.card → b ∈ s), f ((multiset.map g s).sum) ≤ f (g b) :=
begin
  apply multiset.induction_on s,
  { rw [multiset.map_zero, multiset.sum_zero, multiset.card_zero, hf0],
    exact ⟨hβ.some, by simp only [not_lt_zero', is_empty.forall_iff], zero_le'⟩ },
  { rintros a t ⟨M, hMs, hM⟩,
    by_cases hMa : f (g M) ≤ f (g a),
    { refine ⟨a, _, _⟩,
      { simp only [multiset.card_cons, nat.succ_pos', multiset.mem_cons_self, forall_true_left] },
      { rw [multiset.map_cons, multiset.sum_cons],
        exact le_trans (is_nonarchimedean.add_le hf0 hna _ _)
          (max_le_iff.mpr (⟨le_refl _,le_trans hM hMa⟩)), }},
    { rw not_le at hMa,
      by_cases ht : 0 < t.card,
      { refine ⟨M, _, _⟩,
        { simp only [multiset.card_cons, nat.succ_pos', multiset.mem_cons, forall_true_left],
          exact or.intro_right _ (hMs ht) },
          rw [multiset.map_cons, multiset.sum_cons],
          exact le_trans (is_nonarchimedean.add_le hf0 hna _ _)
            (max_le_iff.mpr ⟨le_of_lt hMa, hM⟩) },
      { refine ⟨a, _, _⟩,
        { simp only [multiset.card_cons, nat.succ_pos', multiset.mem_cons_self, forall_true_left] },
        { have h0 : f (multiset.map g t).sum = 0,
          { simp only [not_lt, le_zero_iff, multiset.card_eq_zero] at ht,
            rw [ht, multiset.map_zero, multiset.sum_zero, hf0] },
          rw [multiset.map_cons, multiset.sum_cons],
          apply le_trans (is_nonarchimedean.add_le hf0 hna _ _),
          rw h0,
          exact max_le_iff.mpr ⟨le_refl _, zero_le _⟩ }}}}
end

lemma is_nonarchimedean_finset_range_add_le {α : Type*} [ring α] {f : α → nnreal} (hf0 : f 0 = 0)
  (hna : is_nonarchimedean f) (n : ℕ) (g : ℕ → α) : ∃ (m : ℕ) (hm : 0 < n → m < n),
  f ((finset.range n).sum g) ≤ f (g m) :=
begin
  obtain ⟨m, hm, h⟩ := is_nonarchimedean_finset_image_add hf0 hna g (finset.range n),
  rw [finset.nonempty_range_iff, ← zero_lt_iff, finset.mem_range] at hm,
  exact ⟨m, hm, h⟩,
end

lemma is_nonarchimedean_add_pow {α : Type*} [comm_ring α] {f : α → nnreal} (hsn : is_seminorm f)
  (hna : is_nonarchimedean f) (n : ℕ) (a b : α) : ∃ (m : ℕ) (hm : m ∈ list.range(n + 1)),
  f ((a + b) ^ n) ≤ (f (a ^ m)) * (f (b ^ (n - m))) :=
begin
  obtain ⟨m, hm_lt, hM⟩ := is_nonarchimedean_finset_image_add hsn.zero hna
    (λ (m : ℕ), a ^ m * b ^ (n - m) * ↑(n.choose m)) (finset.range (n + 1)),
  simp only [finset.nonempty_range_iff, ne.def, nat.succ_ne_zero, not_false_iff, finset.mem_range,
    if_true, forall_true_left] at hm_lt,
  refine ⟨m, list.mem_range.mpr hm_lt, _⟩,
  simp only [← add_pow] at hM,
  rw mul_comm at hM,
  exact le_trans hM (le_trans (is_nonarchimedean_nmul hsn hna _ _) (hsn.mul _ _)),
end

lemma add_le_of_is_nonarchimedean {α : Type*} [ring α] {f : α → nnreal} (hf0 : f 0 = 0)
  (hna : is_nonarchimedean f) (a b : α) : f (a + b) ≤ f a + f b :=
begin
  apply le_trans (is_nonarchimedean.add_le hf0 hna _ _),
  simp only [max_le_iff, le_add_iff_nonneg_right, zero_le', le_add_iff_nonneg_left, and_self],
end

lemma field.is_norm_of_is_seminorm {α : Type*} [field α] {f : α → nnreal} (hf : is_seminorm f)
  (hnt : ∃ x : α, 0 ≠ f x) : is_norm f :=
{ ne_zero := λ x hx, begin
    obtain ⟨c, hc⟩ := hnt,
    have hfx : 0 ≠ f x,
    { intro h0,
      have hc' : f c ≤ 0,
      { rw [← mul_one c, ← mul_inv_cancel hx, ← mul_assoc, mul_comm c, mul_assoc],
        refine le_trans (hf.mul x _) _,
        rw [← h0, zero_mul] },
      exact hc (ge_antisymm hc' (zero_le (f c))), },
    exact lt_of_le_of_ne (zero_le (f _)) hfx,
  end,
  ..hf }

lemma seminormed_ring.to_is_seminorm (R : Type*) [semi_normed_ring R] :
  is_seminorm (λ r : R, ∥r∥₊) :=
{ zero := nnnorm_zero,
  add  := nnnorm_add_le,
  mul  := nnnorm_mul_le }

lemma normed_ring.to_is_norm (R : Type*) [normed_ring R] :
  is_norm (λ r : R, ∥r∥₊) :=
{ zero    := nnnorm_zero,
  add     := nnnorm_add_le,
  mul     := nnnorm_mul_le,
  ne_zero := λ x hx, by { rw [pos_iff_ne_zero, ne.def, nnnorm_eq_zero], exact hx }}

lemma normed_field.to_is_mul_norm (R : Type*) [normed_field R] :
  is_mul_norm (λ r : R, ∥r∥₊) :=
{ zero    := nnnorm_zero,
  add     := nnnorm_add_le,
  mul     := nnnorm_mul_le,
  ne_zero := λ x hx, by { rw [pos_iff_ne_zero, ne.def, nnnorm_eq_zero], exact hx },
  mul_eq  := nnnorm_mul }

def ring_hom.is_bounded {α : Type*} [semi_normed_ring α] {β : Type*} [semi_normed_ring β]
  (f : α →+* β) : Prop := ∃ C : nnreal, 0 < C ∧ ∀ x : α, norm (f x) ≤ C * norm x

def ring_hom.is_bounded_wrt {α : Type*} [ring α] {β : Type*} [ring β] (nα : α → nnreal)
  (nβ : β → nnreal) (f : α →+* β) : Prop :=
∃ C : nnreal, 0 < C ∧ ∀ x : α, nβ (f x) ≤ C * nα x

example {C : ℝ} (hC : 0 < C) : filter.tendsto (λ n : ℕ, C ^ (1 / (n : ℝ))) filter.at_top (𝓝 1) :=
begin
  apply filter.tendsto.comp _ (tendsto_const_div_at_top_nhds_0_nat 1),
  rw ← real.rpow_zero C,
  apply continuous_at.tendsto (real.continuous_at_const_rpow (ne_of_gt hC)),
end

lemma contraction_of_is_pm_wrt {α : Type*} [ring α] {β : Type*} [ring β] {nα : α → nnreal}
  (hnα : is_seminorm nα) (nβ : β → nnreal) (hβ : is_pow_mult nβ)
  {f : α →+* β} (hf : f.is_bounded_wrt nα nβ) (x : α) : nβ (f x) ≤ nα x :=
begin
  obtain ⟨C, hC0, hC⟩ := hf,
  have hlim : filter.tendsto (λ n : ℕ, C ^ (1 / (n : ℝ)) * nα x) filter.at_top (𝓝 (nα x)),
  { have : (𝓝 (nα x)) = (𝓝 (1 * (nα x))) := by rw one_mul,
    rw this,
    apply filter.tendsto.mul,
    { apply filter.tendsto.comp _ (tendsto_const_div_at_top_nhds_0_nat 1),
      rw ← nnreal.rpow_zero C,
      rw ← nnreal.tendsto_coe,
      apply continuous_at.tendsto (real.continuous_at_const_rpow (ne_of_gt hC0)), },
    exact tendsto_const_nhds, },
  apply ge_of_tendsto hlim,
  simp only [filter.eventually_at_top, ge_iff_le],
  use 1,
  intros n hn,
  have h : (C^(1/n : ℝ))^n  = C,
  { have hn0 : (n : ℝ) ≠ 0 := nat.cast_ne_zero.mpr (ne_of_gt hn),
      rw [← nnreal.rpow_nat_cast, ← nnreal.rpow_mul, one_div, inv_mul_cancel hn0,
        nnreal.rpow_one] },
  apply le_of_pow_le_pow n _ hn,
  { rw [mul_pow, h, ← hβ _ hn, ← ring_hom.map_pow],
    refine le_trans (hC (x^n)) (mul_le_mul (le_refl C)
      (hnα.pow_le  _ (lt_of_lt_of_le zero_lt_one hn)) (zero_le _) (le_of_lt hC0)) },
    { exact zero_le _ },
end

lemma contraction_of_is_pm {α : Type*} [semi_normed_ring α] {β : Type*} [semi_normed_ring β]
  (hβ : is_pow_mult (λ x : β, (⟨∥x∥, norm_nonneg _⟩ : nnreal))) {f : α →+* β} (hf : f.is_bounded)
  (x : α) : norm (f x) ≤ norm x :=
contraction_of_is_pm_wrt (seminormed_ring.to_is_seminorm α) (λ x : β, (∥x∥₊))
  hβ hf x

lemma eq_seminorms  {α : Type*} [ring α] {f : α → nnreal} (hf : is_seminorm f) (hfpm : is_pow_mult f)
  {g : α → nnreal} (hg : is_seminorm g) (hgpm : is_pow_mult g)
  (hfg : ∃ (r : nnreal) (hr : 0 < r), ∀ (a : α), f a ≤ r * g a)
  (hgf : ∃ (r : nnreal) (hr : 0 < r), ∀ (a : α), g a ≤ r * f a) : f = g :=
begin
  obtain ⟨r, hr0, hr⟩ := hfg,
  obtain ⟨s, hs0, hs⟩ := hgf,
  have hle : ring_hom.is_bounded_wrt f g (ring_hom.id _) := ⟨s, hs0, hs⟩,
  have hge : ring_hom.is_bounded_wrt g f (ring_hom.id _) := ⟨r, hr0, hr⟩,
  ext x,
  exact le_antisymm (contraction_of_is_pm_wrt hg f hfpm hge x)
    (contraction_of_is_pm_wrt hf g hgpm hle x),
end

-- Def. 1.5.1/2
def is_degenerate {α : Type*} [ring α] {f : α → nnreal} (hf : is_mul_norm f) : Prop :=
(∀ (x : α), f x = 0 ∨ 1 ≤ f x) ∨ (∀ (x : α), f x ≤ 1)

-- I might not need the following two defs:

--TODO: check if I can use any mathlib def
def is_bdd_above {α : Type*} [ring α] {f : α → nnreal} (hf : is_mul_norm f) : Prop :=
∃ B : ℝ≥0, ∀ x : α, f x ≤ B

def is_trivial {α : Type*} [ring α] {f : α → nnreal} (hf : is_mul_norm f) : Prop :=
∀ (x : α) (hx : x ≠ 0), f x = 1


/-
Copyright (c) 2021 Kyle Miller. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kyle Miller

! This file was ported from Lean 3 source module data.fin.tuple.sort
! leanprover-community/mathlib commit 4d392a6c9c4539cbeca399b3ee0afea398fbd2eb
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Finset.Sort
import Mathbin.Data.List.FinRange
import Mathbin.Data.Prod.Lex
import Mathbin.GroupTheory.Perm.Basic

/-!

# Sorting tuples by their values

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

Given an `n`-tuple `f : fin n → α` where `α` is ordered,
we may want to turn it into a sorted `n`-tuple.
This file provides an API for doing so, with the sorted `n`-tuple given by
`f ∘ tuple.sort f`.

## Main declarations

* `tuple.sort`: given `f : fin n → α`, produces a permutation on `fin n`
* `tuple.monotone_sort`: `f ∘ tuple.sort f` is `monotone`

-/

namespace Tuple

variable {n : ℕ}

variable {α : Type _} [LinearOrder α]

#print Tuple.graph /-
/-- `graph f` produces the finset of pairs `(f i, i)`
equipped with the lexicographic order.
-/
def graph (f : Fin n → α) : Finset (α ×ₗ Fin n) :=
  Finset.univ.image fun i => (f i, i)
#align tuple.graph Tuple.graph
-/

#print Tuple.graph.proj /-
/-- Given `p : α ×ₗ (fin n) := (f i, i)` with `p ∈ graph f`,
`graph.proj p` is defined to be `f i`.
-/
def graph.proj {f : Fin n → α} : graph f → α := fun p => p.1.1
#align tuple.graph.proj Tuple.graph.proj
-/

#print Tuple.graph.card /-
@[simp]
theorem graph.card (f : Fin n → α) : (graph f).card = n :=
  by
  rw [graph, Finset.card_image_of_injective]
  · exact Finset.card_fin _
  · intro _ _
    simp
#align tuple.graph.card Tuple.graph.card
-/

#print Tuple.graphEquiv₁ /-
/-- `graph_equiv₁ f` is the natural equivalence between `fin n` and `graph f`,
mapping `i` to `(f i, i)`. -/
def graphEquiv₁ (f : Fin n → α) : Fin n ≃ graph f
    where
  toFun i := ⟨(f i, i), by simp [graph]⟩
  invFun p := p.1.2
  left_inv i := by simp
  right_inv := fun ⟨⟨x, i⟩, h⟩ => by simpa [graph] using h
#align tuple.graph_equiv₁ Tuple.graphEquiv₁
-/

#print Tuple.proj_equiv₁' /-
@[simp]
theorem proj_equiv₁' (f : Fin n → α) : graph.proj ∘ graphEquiv₁ f = f :=
  rfl
#align tuple.proj_equiv₁' Tuple.proj_equiv₁'
-/

#print Tuple.graphEquiv₂ /-
/-- `graph_equiv₂ f` is an equivalence between `fin n` and `graph f` that respects the order.
-/
def graphEquiv₂ (f : Fin n → α) : Fin n ≃o graph f :=
  Finset.orderIsoOfFin _ (by simp)
#align tuple.graph_equiv₂ Tuple.graphEquiv₂
-/

#print Tuple.sort /-
/-- `sort f` is the permutation that orders `fin n` according to the order of the outputs of `f`. -/
def sort (f : Fin n → α) : Equiv.Perm (Fin n) :=
  (graphEquiv₂ f).toEquiv.trans (graphEquiv₁ f).symm
#align tuple.sort Tuple.sort
-/

/- warning: tuple.graph_equiv₂_apply -> Tuple.graphEquiv₂_apply is a dubious translation:
lean 3 declaration is
  forall {n : Nat} {α : Type.{u1}} [_inst_1 : LinearOrder.{u1} α] (f : (Fin n) -> α) (i : Fin n), Eq.{succ u1} (coeSort.{succ u1, succ (succ u1)} (Finset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) Type.{u1} (Finset.hasCoeToSort.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) (Tuple.graph.{u1} n α _inst_1 f)) (coeFn.{succ u1, succ u1} (OrderIso.{0, u1} (Fin n) (coeSort.{succ u1, succ (succ u1)} (Finset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) Type.{u1} (Finset.hasCoeToSort.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) (Tuple.graph.{u1} n α _inst_1 f)) (Fin.hasLe n) (Subtype.hasLe.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (Prod.Lex.instLE.{u1, 0} α (Fin n) (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1))))) (Fin.hasLe n)) (fun (x : Lex.{u1} (Prod.{u1, 0} α (Fin n))) => Membership.Mem.{u1, u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (Finset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) (Finset.hasMem.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) x (Tuple.graph.{u1} n α _inst_1 f)))) (fun (_x : RelIso.{0, u1} (Fin n) (coeSort.{succ u1, succ (succ u1)} (Finset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) Type.{u1} (Finset.hasCoeToSort.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) (Tuple.graph.{u1} n α _inst_1 f)) (LE.le.{0} (Fin n) (Fin.hasLe n)) (LE.le.{u1} (coeSort.{succ u1, succ (succ u1)} (Finset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) Type.{u1} (Finset.hasCoeToSort.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) (Tuple.graph.{u1} n α _inst_1 f)) (Subtype.hasLe.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (Prod.Lex.instLE.{u1, 0} α (Fin n) (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1))))) (Fin.hasLe n)) (fun (x : Lex.{u1} (Prod.{u1, 0} α (Fin n))) => Membership.Mem.{u1, u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (Finset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) (Finset.hasMem.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) x (Tuple.graph.{u1} n α _inst_1 f))))) => (Fin n) -> (coeSort.{succ u1, succ (succ u1)} (Finset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) Type.{u1} (Finset.hasCoeToSort.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) (Tuple.graph.{u1} n α _inst_1 f))) (RelIso.hasCoeToFun.{0, u1} (Fin n) (coeSort.{succ u1, succ (succ u1)} (Finset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) Type.{u1} (Finset.hasCoeToSort.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) (Tuple.graph.{u1} n α _inst_1 f)) (LE.le.{0} (Fin n) (Fin.hasLe n)) (LE.le.{u1} (coeSort.{succ u1, succ (succ u1)} (Finset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) Type.{u1} (Finset.hasCoeToSort.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) (Tuple.graph.{u1} n α _inst_1 f)) (Subtype.hasLe.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (Prod.Lex.instLE.{u1, 0} α (Fin n) (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1))))) (Fin.hasLe n)) (fun (x : Lex.{u1} (Prod.{u1, 0} α (Fin n))) => Membership.Mem.{u1, u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (Finset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) (Finset.hasMem.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) x (Tuple.graph.{u1} n α _inst_1 f))))) (Tuple.graphEquiv₂.{u1} n α _inst_1 f) i) (coeFn.{succ u1, succ u1} (Equiv.{1, succ u1} (Fin n) (coeSort.{succ u1, succ (succ u1)} (Finset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) Type.{u1} (Finset.hasCoeToSort.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) (Tuple.graph.{u1} n α _inst_1 f))) (fun (_x : Equiv.{1, succ u1} (Fin n) (coeSort.{succ u1, succ (succ u1)} (Finset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) Type.{u1} (Finset.hasCoeToSort.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) (Tuple.graph.{u1} n α _inst_1 f))) => (Fin n) -> (coeSort.{succ u1, succ (succ u1)} (Finset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) Type.{u1} (Finset.hasCoeToSort.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) (Tuple.graph.{u1} n α _inst_1 f))) (Equiv.hasCoeToFun.{1, succ u1} (Fin n) (coeSort.{succ u1, succ (succ u1)} (Finset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) Type.{u1} (Finset.hasCoeToSort.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) (Tuple.graph.{u1} n α _inst_1 f))) (Tuple.graphEquiv₁.{u1} n α _inst_1 f) (coeFn.{1, 1} (Equiv.Perm.{1} (Fin n)) (fun (_x : Equiv.{1, 1} (Fin n) (Fin n)) => (Fin n) -> (Fin n)) (Equiv.hasCoeToFun.{1, 1} (Fin n) (Fin n)) (Tuple.sort.{u1} n α _inst_1 f) i))
but is expected to have type
  forall {n : Nat} {α : Type.{u1}} [_inst_1 : LinearOrder.{u1} α] (f : (Fin n) -> α) (i : Fin n), Eq.{succ u1} ((fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : Fin n) => Subtype.{succ u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (fun (x : Lex.{u1} (Prod.{u1, 0} α (Fin n))) => Membership.mem.{u1, u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (Finset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) (Finset.instMembershipFinset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) x (Tuple.graph.{u1} n α _inst_1 f))) i) (FunLike.coe.{succ u1, 1, succ u1} (Function.Embedding.{1, succ u1} (Fin n) (Subtype.{succ u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (fun (x : Lex.{u1} (Prod.{u1, 0} α (Fin n))) => Membership.mem.{u1, u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (Finset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) (Finset.instMembershipFinset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) x (Tuple.graph.{u1} n α _inst_1 f)))) (Fin n) (fun (_x : Fin n) => (fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : Fin n) => Subtype.{succ u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (fun (x : Lex.{u1} (Prod.{u1, 0} α (Fin n))) => Membership.mem.{u1, u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (Finset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) (Finset.instMembershipFinset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) x (Tuple.graph.{u1} n α _inst_1 f))) _x) (EmbeddingLike.toFunLike.{succ u1, 1, succ u1} (Function.Embedding.{1, succ u1} (Fin n) (Subtype.{succ u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (fun (x : Lex.{u1} (Prod.{u1, 0} α (Fin n))) => Membership.mem.{u1, u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (Finset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) (Finset.instMembershipFinset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) x (Tuple.graph.{u1} n α _inst_1 f)))) (Fin n) (Subtype.{succ u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (fun (x : Lex.{u1} (Prod.{u1, 0} α (Fin n))) => Membership.mem.{u1, u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (Finset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) (Finset.instMembershipFinset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) x (Tuple.graph.{u1} n α _inst_1 f))) (Function.instEmbeddingLikeEmbedding.{1, succ u1} (Fin n) (Subtype.{succ u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (fun (x : Lex.{u1} (Prod.{u1, 0} α (Fin n))) => Membership.mem.{u1, u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (Finset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) (Finset.instMembershipFinset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) x (Tuple.graph.{u1} n α _inst_1 f))))) (RelEmbedding.toEmbedding.{0, u1} (Fin n) (Subtype.{succ u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (fun (x : Lex.{u1} (Prod.{u1, 0} α (Fin n))) => Membership.mem.{u1, u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (Finset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) (Finset.instMembershipFinset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) x (Tuple.graph.{u1} n α _inst_1 f))) (fun (x._@.Mathlib.Order.Hom.Basic._hyg.1281 : Fin n) (x._@.Mathlib.Order.Hom.Basic._hyg.1283 : Fin n) => LE.le.{0} (Fin n) (instLEFin n) x._@.Mathlib.Order.Hom.Basic._hyg.1281 x._@.Mathlib.Order.Hom.Basic._hyg.1283) (fun (x._@.Mathlib.Order.Hom.Basic._hyg.1296 : Subtype.{succ u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (fun (x : Lex.{u1} (Prod.{u1, 0} α (Fin n))) => Membership.mem.{u1, u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (Finset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) (Finset.instMembershipFinset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) x (Tuple.graph.{u1} n α _inst_1 f))) (x._@.Mathlib.Order.Hom.Basic._hyg.1298 : Subtype.{succ u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (fun (x : Lex.{u1} (Prod.{u1, 0} α (Fin n))) => Membership.mem.{u1, u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (Finset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) (Finset.instMembershipFinset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) x (Tuple.graph.{u1} n α _inst_1 f))) => LE.le.{u1} (Subtype.{succ u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (fun (x : Lex.{u1} (Prod.{u1, 0} α (Fin n))) => Membership.mem.{u1, u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (Finset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) (Finset.instMembershipFinset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) x (Tuple.graph.{u1} n α _inst_1 f))) (Subtype.le.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (Prod.Lex.instLE.{u1, 0} α (Fin n) (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (DistribLattice.toLattice.{u1} α (instDistribLattice.{u1} α _inst_1)))))) (instLEFin n)) (fun (x : Lex.{u1} (Prod.{u1, 0} α (Fin n))) => Membership.mem.{u1, u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (Finset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) (Finset.instMembershipFinset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) x (Tuple.graph.{u1} n α _inst_1 f))) x._@.Mathlib.Order.Hom.Basic._hyg.1296 x._@.Mathlib.Order.Hom.Basic._hyg.1298) (RelIso.toRelEmbedding.{0, u1} (Fin n) (Subtype.{succ u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (fun (x : Lex.{u1} (Prod.{u1, 0} α (Fin n))) => Membership.mem.{u1, u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (Finset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) (Finset.instMembershipFinset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) x (Tuple.graph.{u1} n α _inst_1 f))) (fun (x._@.Mathlib.Order.Hom.Basic._hyg.1281 : Fin n) (x._@.Mathlib.Order.Hom.Basic._hyg.1283 : Fin n) => LE.le.{0} (Fin n) (instLEFin n) x._@.Mathlib.Order.Hom.Basic._hyg.1281 x._@.Mathlib.Order.Hom.Basic._hyg.1283) (fun (x._@.Mathlib.Order.Hom.Basic._hyg.1296 : Subtype.{succ u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (fun (x : Lex.{u1} (Prod.{u1, 0} α (Fin n))) => Membership.mem.{u1, u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (Finset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) (Finset.instMembershipFinset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) x (Tuple.graph.{u1} n α _inst_1 f))) (x._@.Mathlib.Order.Hom.Basic._hyg.1298 : Subtype.{succ u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (fun (x : Lex.{u1} (Prod.{u1, 0} α (Fin n))) => Membership.mem.{u1, u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (Finset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) (Finset.instMembershipFinset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) x (Tuple.graph.{u1} n α _inst_1 f))) => LE.le.{u1} (Subtype.{succ u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (fun (x : Lex.{u1} (Prod.{u1, 0} α (Fin n))) => Membership.mem.{u1, u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (Finset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) (Finset.instMembershipFinset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) x (Tuple.graph.{u1} n α _inst_1 f))) (Subtype.le.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (Prod.Lex.instLE.{u1, 0} α (Fin n) (Preorder.toLT.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (DistribLattice.toLattice.{u1} α (instDistribLattice.{u1} α _inst_1)))))) (instLEFin n)) (fun (x : Lex.{u1} (Prod.{u1, 0} α (Fin n))) => Membership.mem.{u1, u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (Finset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) (Finset.instMembershipFinset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) x (Tuple.graph.{u1} n α _inst_1 f))) x._@.Mathlib.Order.Hom.Basic._hyg.1296 x._@.Mathlib.Order.Hom.Basic._hyg.1298) (Tuple.graphEquiv₂.{u1} n α _inst_1 f))) i) (FunLike.coe.{succ u1, 1, succ u1} (Equiv.{1, succ u1} (Fin n) (Subtype.{succ u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (fun (x : Lex.{u1} (Prod.{u1, 0} α (Fin n))) => Membership.mem.{u1, u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (Finset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) (Finset.instMembershipFinset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) x (Tuple.graph.{u1} n α _inst_1 f)))) (Fin n) (fun (_x : Fin n) => (fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : Fin n) => Subtype.{succ u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (fun (x : Lex.{u1} (Prod.{u1, 0} α (Fin n))) => Membership.mem.{u1, u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (Finset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) (Finset.instMembershipFinset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) x (Tuple.graph.{u1} n α _inst_1 f))) _x) (Equiv.instFunLikeEquiv.{1, succ u1} (Fin n) (Subtype.{succ u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (fun (x : Lex.{u1} (Prod.{u1, 0} α (Fin n))) => Membership.mem.{u1, u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (Finset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) (Finset.instMembershipFinset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) x (Tuple.graph.{u1} n α _inst_1 f)))) (Tuple.graphEquiv₁.{u1} n α _inst_1 f) (FunLike.coe.{1, 1, 1} (Equiv.Perm.{1} (Fin n)) (Fin n) (fun (_x : Fin n) => (fun (x._@.Mathlib.Logic.Equiv.Defs._hyg.808 : Fin n) => Fin n) _x) (Equiv.instFunLikeEquiv.{1, 1} (Fin n) (Fin n)) (Tuple.sort.{u1} n α _inst_1 f) i))
Case conversion may be inaccurate. Consider using '#align tuple.graph_equiv₂_apply Tuple.graphEquiv₂_applyₓ'. -/
theorem graphEquiv₂_apply (f : Fin n → α) (i : Fin n) :
    graphEquiv₂ f i = graphEquiv₁ f (sort f i) :=
  ((graphEquiv₁ f).apply_symm_apply _).symm
#align tuple.graph_equiv₂_apply Tuple.graphEquiv₂_apply

#print Tuple.self_comp_sort /-
theorem self_comp_sort (f : Fin n → α) : f ∘ sort f = graph.proj ∘ graphEquiv₂ f :=
  show graph.proj ∘ (graphEquiv₁ f ∘ (graphEquiv₁ f).symm) ∘ (graphEquiv₂ f).toEquiv = _ by simp
#align tuple.self_comp_sort Tuple.self_comp_sort
-/

/- warning: tuple.monotone_proj -> Tuple.monotone_proj is a dubious translation:
lean 3 declaration is
  forall {n : Nat} {α : Type.{u1}} [_inst_1 : LinearOrder.{u1} α] (f : (Fin n) -> α), Monotone.{u1, u1} (coeSort.{succ u1, succ (succ u1)} (Finset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) Type.{u1} (Finset.hasCoeToSort.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) (Tuple.graph.{u1} n α _inst_1 f)) α (Subtype.preorder.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (Prod.Lex.preorder.{u1, 0} α (Fin n) (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) (PartialOrder.toPreorder.{0} (Fin n) (Fin.partialOrder n))) (fun (x : Lex.{u1} (Prod.{u1, 0} α (Fin n))) => Membership.Mem.{u1, u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (Finset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) (Finset.hasMem.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) x (Tuple.graph.{u1} n α _inst_1 f))) (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) (Tuple.graph.proj.{u1} n α _inst_1 f)
but is expected to have type
  forall {n : Nat} {α : Type.{u1}} [_inst_1 : LinearOrder.{u1} α] (f : (Fin n) -> α), Monotone.{u1, u1} (Subtype.{succ u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (fun (x : Lex.{u1} (Prod.{u1, 0} α (Fin n))) => Membership.mem.{u1, u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (Finset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) (Finset.instMembershipFinset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) x (Tuple.graph.{u1} n α _inst_1 f))) α (Subtype.preorder.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (Prod.Lex.preorder.{u1, 0} α (Fin n) (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (DistribLattice.toLattice.{u1} α (instDistribLattice.{u1} α _inst_1))))) (PartialOrder.toPreorder.{0} (Fin n) (Fin.instPartialOrderFin n))) (fun (x : Lex.{u1} (Prod.{u1, 0} α (Fin n))) => Membership.mem.{u1, u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n))) (Finset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) (Finset.instMembershipFinset.{u1} (Lex.{u1} (Prod.{u1, 0} α (Fin n)))) x (Tuple.graph.{u1} n α _inst_1 f))) (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (DistribLattice.toLattice.{u1} α (instDistribLattice.{u1} α _inst_1))))) (Tuple.graph.proj.{u1} n α _inst_1 f)
Case conversion may be inaccurate. Consider using '#align tuple.monotone_proj Tuple.monotone_projₓ'. -/
theorem monotone_proj (f : Fin n → α) : Monotone (graph.proj : graph f → α) :=
  by
  rintro ⟨⟨x, i⟩, hx⟩ ⟨⟨y, j⟩, hy⟩ (_ | h)
  · exact le_of_lt ‹_›
  · simp [graph.proj]
#align tuple.monotone_proj Tuple.monotone_proj

#print Tuple.monotone_sort /-
theorem monotone_sort (f : Fin n → α) : Monotone (f ∘ sort f) :=
  by
  rw [self_comp_sort]
  exact (monotone_proj f).comp (graph_equiv₂ f).Monotone
#align tuple.monotone_sort Tuple.monotone_sort
-/

end Tuple

namespace Tuple

open List

variable {n : ℕ} {α : Type _}

#print Tuple.unique_monotone /-
/-- If two permutations of a tuple `f` are both monotone, then they are equal. -/
theorem unique_monotone [PartialOrder α] {f : Fin n → α} {σ τ : Equiv.Perm (Fin n)}
    (hfσ : Monotone (f ∘ σ)) (hfτ : Monotone (f ∘ τ)) : f ∘ σ = f ∘ τ :=
  ofFn_injective <|
    eq_of_perm_of_sorted ((σ.ofFn_comp_perm f).trans (τ.ofFn_comp_perm f).symm) hfσ.ofFn_sorted
      hfτ.ofFn_sorted
#align tuple.unique_monotone Tuple.unique_monotone
-/

variable [LinearOrder α] {f : Fin n → α} {σ : Equiv.Perm (Fin n)}

#print Tuple.eq_sort_iff' /-
/-- A permutation `σ` equals `sort f` if and only if the map `i ↦ (f (σ i), σ i)` is
strictly monotone (w.r.t. the lexicographic ordering on the target). -/
theorem eq_sort_iff' : σ = sort f ↔ StrictMono (σ.trans <| graphEquiv₁ f) :=
  by
  constructor <;> intro h
  · rw [h, sort, Equiv.trans_assoc, Equiv.symm_trans_self]
    exact (graph_equiv₂ f).StrictMono
  · have := Subsingleton.elim (graph_equiv₂ f) (h.order_iso_of_surjective _ <| Equiv.surjective _)
    ext1
    exact (graph_equiv₁ f).apply_eq_iff_eq_symm_apply.1 (FunLike.congr_fun this x).symm
#align tuple.eq_sort_iff' Tuple.eq_sort_iff'
-/

#print Tuple.eq_sort_iff /-
/-- A permutation `σ` equals `sort f` if and only if `f ∘ σ` is monotone and whenever `i < j`
and `f (σ i) = f (σ j)`, then `σ i < σ j`. This means that `sort f` is the lexicographically
smallest permutation `σ` such that `f ∘ σ` is monotone. -/
theorem eq_sort_iff :
    σ = sort f ↔ Monotone (f ∘ σ) ∧ ∀ i j, i < j → f (σ i) = f (σ j) → σ i < σ j :=
  by
  rw [eq_sort_iff']
  refine' ⟨fun h => ⟨(monotone_proj f).comp h.Monotone, fun i j hij hfij => _⟩, fun h i j hij => _⟩
  · exact (((Prod.Lex.lt_iff _ _).1 <| h hij).resolve_left hfij.not_lt).2
  · obtain he | hl := (h.1 hij.le).eq_or_lt <;> apply (Prod.Lex.lt_iff _ _).2
    exacts[Or.inr ⟨he, h.2 i j hij he⟩, Or.inl hl]
#align tuple.eq_sort_iff Tuple.eq_sort_iff
-/

/- warning: tuple.sort_eq_refl_iff_monotone -> Tuple.sort_eq_refl_iff_monotone is a dubious translation:
lean 3 declaration is
  forall {n : Nat} {α : Type.{u1}} [_inst_1 : LinearOrder.{u1} α] {f : (Fin n) -> α}, Iff (Eq.{1} (Equiv.Perm.{1} (Fin n)) (Tuple.sort.{u1} n α _inst_1 f) (Equiv.refl.{1} (Fin n))) (Monotone.{0, u1} (Fin n) α (PartialOrder.toPreorder.{0} (Fin n) (Fin.partialOrder n)) (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (LinearOrder.toLattice.{u1} α _inst_1)))) f)
but is expected to have type
  forall {n : Nat} {α : Type.{u1}} [_inst_1 : LinearOrder.{u1} α] {f : (Fin n) -> α}, Iff (Eq.{1} (Equiv.Perm.{1} (Fin n)) (Tuple.sort.{u1} n α _inst_1 f) (Equiv.refl.{1} (Fin n))) (Monotone.{0, u1} (Fin n) α (PartialOrder.toPreorder.{0} (Fin n) (Fin.instPartialOrderFin n)) (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (DistribLattice.toLattice.{u1} α (instDistribLattice.{u1} α _inst_1))))) f)
Case conversion may be inaccurate. Consider using '#align tuple.sort_eq_refl_iff_monotone Tuple.sort_eq_refl_iff_monotoneₓ'. -/
/-- The permutation that sorts `f` is the identity if and only if `f` is monotone. -/
theorem sort_eq_refl_iff_monotone : sort f = Equiv.refl _ ↔ Monotone f :=
  by
  rw [eq_comm, eq_sort_iff, Equiv.coe_refl, Function.comp.right_id]
  simp only [id.def, and_iff_left_iff_imp]
  exact fun _ _ _ hij _ => hij
#align tuple.sort_eq_refl_iff_monotone Tuple.sort_eq_refl_iff_monotone

#print Tuple.comp_sort_eq_comp_iff_monotone /-
/-- A permutation of a tuple `f` is `f` sorted if and only if it is monotone. -/
theorem comp_sort_eq_comp_iff_monotone : f ∘ σ = f ∘ sort f ↔ Monotone (f ∘ σ) :=
  ⟨fun h => h.symm ▸ monotone_sort f, fun h => unique_monotone h (monotone_sort f)⟩
#align tuple.comp_sort_eq_comp_iff_monotone Tuple.comp_sort_eq_comp_iff_monotone
-/

#print Tuple.comp_perm_comp_sort_eq_comp_sort /-
/-- The sorted versions of a tuple `f` and of any permutation of `f` agree. -/
theorem comp_perm_comp_sort_eq_comp_sort : (f ∘ σ) ∘ sort (f ∘ σ) = f ∘ sort f :=
  by
  rw [Function.comp.assoc, ← Equiv.Perm.coe_mul]
  exact unique_monotone (monotone_sort (f ∘ σ)) (monotone_sort f)
#align tuple.comp_perm_comp_sort_eq_comp_sort Tuple.comp_perm_comp_sort_eq_comp_sort
-/

#print Tuple.antitone_pair_of_not_sorted' /-
/-- If a permutation `f ∘ σ` of the tuple `f` is not the same as `f ∘ sort f`, then `f ∘ σ`
has a pair of strictly decreasing entries. -/
theorem antitone_pair_of_not_sorted' (h : f ∘ σ ≠ f ∘ sort f) :
    ∃ i j, i < j ∧ (f ∘ σ) j < (f ∘ σ) i :=
  by
  contrapose! h
  exact comp_sort_eq_comp_iff_monotone.mpr (monotone_iff_forall_lt.mpr h)
#align tuple.antitone_pair_of_not_sorted' Tuple.antitone_pair_of_not_sorted'
-/

#print Tuple.antitone_pair_of_not_sorted /-
/-- If the tuple `f` is not the same as `f ∘ sort f`, then `f` has a pair of strictly decreasing
entries. -/
theorem antitone_pair_of_not_sorted (h : f ≠ f ∘ sort f) : ∃ i j, i < j ∧ f j < f i :=
  antitone_pair_of_not_sorted' (id h : f ∘ Equiv.refl _ ≠ _)
#align tuple.antitone_pair_of_not_sorted Tuple.antitone_pair_of_not_sorted
-/

end Tuple


/-
Copyright (c) 2022 Bhavik Mehta, Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta, Alena Gusakov, Yaël Dillies

! This file was ported from Lean 3 source module combinatorics.set_family.lym
! leanprover-community/mathlib commit 0ebfdb71919ac6ca5d7fbc61a082fa2519556818
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.BigOperators.Ring
import Mathbin.Algebra.Order.Field.Basic
import Mathbin.Combinatorics.DoubleCounting
import Mathbin.Combinatorics.SetFamily.Shadow
import Mathbin.Data.Rat.Order

/-!
# Lubell-Yamamoto-Meshalkin inequality and Sperner's theorem

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.

This file proves the local LYM and LYM inequalities as well as Sperner's theorem.

## Main declarations

* `finset.card_div_choose_le_card_shadow_div_choose`: Local Lubell-Yamamoto-Meshalkin inequality.
  The shadow of a set `𝒜` in a layer takes a greater proportion of its layer than `𝒜` does.
* `finset.sum_card_slice_div_choose_le_one`: Lubell-Yamamoto-Meshalkin inequality. The sum of
  densities of `𝒜` in each layer is at most `1` for any antichain `𝒜`.
* `is_antichain.sperner`: Sperner's theorem. The size of any antichain in `finset α` is at most the
  size of the maximal layer of `finset α`. It is a corollary of `sum_card_slice_div_choose_le_one`.

## TODO

Prove upward local LYM.

Provide equality cases. Local LYM gives that the equality case of LYM and Sperner is precisely when
`𝒜` is a middle layer.

`falling` could be useful more generally in grade orders.

## References

* http://b-mehta.github.io/maths-notes/iii/mich/combinatorics.pdf
* http://discretemath.imp.fu-berlin.de/DMII-2015-16/kruskal.pdf

## Tags

shadow, lym, slice, sperner, antichain
-/

open Finset Nat

open BigOperators FinsetFamily

variable {𝕜 α : Type _} [LinearOrderedField 𝕜]

namespace Finset

/-! ### Local LYM inequality -/

section LocalLym

variable [DecidableEq α] [Fintype α] {𝒜 : Finset (Finset α)} {r : ℕ}

#print Finset.card_mul_le_card_shadow_mul /-
/-- The downward **local LYM inequality**, with cancelled denominators. `𝒜` takes up less of `α^(r)`
(the finsets of card `r`) than `∂𝒜` takes up of `α^(r - 1)`. -/
theorem card_mul_le_card_shadow_mul (h𝒜 : (𝒜 : Set (Finset α)).Sized r) :
    𝒜.card * r ≤ ((∂ ) 𝒜).card * (Fintype.card α - r + 1) :=
  by
  refine' card_mul_le_card_mul' (· ⊆ ·) (fun s hs => _) fun s hs => _
  · rw [← h𝒜 hs, ← card_image_of_inj_on s.erase_inj_on]
    refine' card_le_of_subset _
    simp_rw [image_subset_iff, mem_bipartite_below]
    exact fun a ha => ⟨erase_mem_shadow hs ha, erase_subset _ _⟩
  refine' le_trans _ tsub_tsub_le_tsub_add
  rw [← h𝒜.shadow hs, ← card_compl, ← card_image_of_inj_on (insert_inj_on' _)]
  refine' card_le_of_subset fun t ht => _
  infer_instance
  rw [mem_bipartite_above] at ht
  have : ∅ ∉ 𝒜 := by
    rw [← mem_coe, h𝒜.empty_mem_iff, coe_eq_singleton]
    rintro rfl
    rwa [shadow_singleton_empty] at hs
  obtain ⟨a, ha, rfl⟩ :=
    exists_eq_insert_iff.2 ⟨ht.2, by rw [(sized_shadow_iff this).1 h𝒜.shadow ht.1, h𝒜.shadow hs]⟩
  exact mem_image_of_mem _ (mem_compl.2 ha)
#align finset.card_mul_le_card_shadow_mul Finset.card_mul_le_card_shadow_mul
-/

/- warning: finset.card_div_choose_le_card_shadow_div_choose -> Finset.card_div_choose_le_card_shadow_div_choose is a dubious translation:
lean 3 declaration is
  forall {𝕜 : Type.{u1}} {α : Type.{u2}} [_inst_1 : LinearOrderedField.{u1} 𝕜] [_inst_2 : DecidableEq.{succ u2} α] [_inst_3 : Fintype.{u2} α] {𝒜 : Finset.{u2} (Finset.{u2} α)} {r : Nat}, (Ne.{1} Nat r (OfNat.ofNat.{0} Nat 0 (OfNat.mk.{0} Nat 0 (Zero.zero.{0} Nat Nat.hasZero)))) -> (Set.Sized.{u2} α r ((fun (a : Type.{u2}) (b : Type.{u2}) [self : HasLiftT.{succ u2, succ u2} a b] => self.0) (Finset.{u2} (Finset.{u2} α)) (Set.{u2} (Finset.{u2} α)) (HasLiftT.mk.{succ u2, succ u2} (Finset.{u2} (Finset.{u2} α)) (Set.{u2} (Finset.{u2} α)) (CoeTCₓ.coe.{succ u2, succ u2} (Finset.{u2} (Finset.{u2} α)) (Set.{u2} (Finset.{u2} α)) (Finset.Set.hasCoeT.{u2} (Finset.{u2} α)))) 𝒜)) -> (LE.le.{u1} 𝕜 (Preorder.toLE.{u1} 𝕜 (PartialOrder.toPreorder.{u1} 𝕜 (OrderedAddCommGroup.toPartialOrder.{u1} 𝕜 (StrictOrderedRing.toOrderedAddCommGroup.{u1} 𝕜 (LinearOrderedRing.toStrictOrderedRing.{u1} 𝕜 (LinearOrderedCommRing.toLinearOrderedRing.{u1} 𝕜 (LinearOrderedField.toLinearOrderedCommRing.{u1} 𝕜 _inst_1))))))) (HDiv.hDiv.{u1, u1, u1} 𝕜 𝕜 𝕜 (instHDiv.{u1} 𝕜 (DivInvMonoid.toHasDiv.{u1} 𝕜 (DivisionRing.toDivInvMonoid.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_1))))) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat 𝕜 (HasLiftT.mk.{1, succ u1} Nat 𝕜 (CoeTCₓ.coe.{1, succ u1} Nat 𝕜 (Nat.castCoe.{u1} 𝕜 (AddMonoidWithOne.toNatCast.{u1} 𝕜 (AddGroupWithOne.toAddMonoidWithOne.{u1} 𝕜 (AddCommGroupWithOne.toAddGroupWithOne.{u1} 𝕜 (Ring.toAddCommGroupWithOne.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_1)))))))))) (Finset.card.{u2} (Finset.{u2} α) 𝒜)) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat 𝕜 (HasLiftT.mk.{1, succ u1} Nat 𝕜 (CoeTCₓ.coe.{1, succ u1} Nat 𝕜 (Nat.castCoe.{u1} 𝕜 (AddMonoidWithOne.toNatCast.{u1} 𝕜 (AddGroupWithOne.toAddMonoidWithOne.{u1} 𝕜 (AddCommGroupWithOne.toAddGroupWithOne.{u1} 𝕜 (Ring.toAddCommGroupWithOne.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_1)))))))))) (Nat.choose (Fintype.card.{u2} α _inst_3) r))) (HDiv.hDiv.{u1, u1, u1} 𝕜 𝕜 𝕜 (instHDiv.{u1} 𝕜 (DivInvMonoid.toHasDiv.{u1} 𝕜 (DivisionRing.toDivInvMonoid.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_1))))) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat 𝕜 (HasLiftT.mk.{1, succ u1} Nat 𝕜 (CoeTCₓ.coe.{1, succ u1} Nat 𝕜 (Nat.castCoe.{u1} 𝕜 (AddMonoidWithOne.toNatCast.{u1} 𝕜 (AddGroupWithOne.toAddMonoidWithOne.{u1} 𝕜 (AddCommGroupWithOne.toAddGroupWithOne.{u1} 𝕜 (Ring.toAddCommGroupWithOne.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_1)))))))))) (Finset.card.{u2} (Finset.{u2} α) (Finset.shadow.{u2} α (fun (a : α) (b : α) => _inst_2 a b) 𝒜))) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat 𝕜 (HasLiftT.mk.{1, succ u1} Nat 𝕜 (CoeTCₓ.coe.{1, succ u1} Nat 𝕜 (Nat.castCoe.{u1} 𝕜 (AddMonoidWithOne.toNatCast.{u1} 𝕜 (AddGroupWithOne.toAddMonoidWithOne.{u1} 𝕜 (AddCommGroupWithOne.toAddGroupWithOne.{u1} 𝕜 (Ring.toAddCommGroupWithOne.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_1)))))))))) (Nat.choose (Fintype.card.{u2} α _inst_3) (HSub.hSub.{0, 0, 0} Nat Nat Nat (instHSub.{0} Nat Nat.hasSub) r (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))))))
but is expected to have type
  forall {𝕜 : Type.{u1}} {α : Type.{u2}} [_inst_1 : LinearOrderedField.{u1} 𝕜] [_inst_2 : DecidableEq.{succ u2} α] [_inst_3 : Fintype.{u2} α] {𝒜 : Finset.{u2} (Finset.{u2} α)} {r : Nat}, (Ne.{1} Nat r (OfNat.ofNat.{0} Nat 0 (instOfNatNat 0))) -> (Set.Sized.{u2} α r (Finset.toSet.{u2} (Finset.{u2} α) 𝒜)) -> (LE.le.{u1} 𝕜 (Preorder.toLE.{u1} 𝕜 (PartialOrder.toPreorder.{u1} 𝕜 (StrictOrderedRing.toPartialOrder.{u1} 𝕜 (LinearOrderedRing.toStrictOrderedRing.{u1} 𝕜 (LinearOrderedCommRing.toLinearOrderedRing.{u1} 𝕜 (LinearOrderedField.toLinearOrderedCommRing.{u1} 𝕜 _inst_1)))))) (HDiv.hDiv.{u1, u1, u1} 𝕜 𝕜 𝕜 (instHDiv.{u1} 𝕜 (LinearOrderedField.toDiv.{u1} 𝕜 _inst_1)) (Nat.cast.{u1} 𝕜 (NonAssocRing.toNatCast.{u1} 𝕜 (Ring.toNonAssocRing.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_1))))) (Finset.card.{u2} (Finset.{u2} α) 𝒜)) (Nat.cast.{u1} 𝕜 (NonAssocRing.toNatCast.{u1} 𝕜 (Ring.toNonAssocRing.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_1))))) (Nat.choose (Fintype.card.{u2} α _inst_3) r))) (HDiv.hDiv.{u1, u1, u1} 𝕜 𝕜 𝕜 (instHDiv.{u1} 𝕜 (LinearOrderedField.toDiv.{u1} 𝕜 _inst_1)) (Nat.cast.{u1} 𝕜 (NonAssocRing.toNatCast.{u1} 𝕜 (Ring.toNonAssocRing.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_1))))) (Finset.card.{u2} (Finset.{u2} α) (Finset.shadow.{u2} α (fun (a : α) (b : α) => _inst_2 a b) 𝒜))) (Nat.cast.{u1} 𝕜 (NonAssocRing.toNatCast.{u1} 𝕜 (Ring.toNonAssocRing.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_1))))) (Nat.choose (Fintype.card.{u2} α _inst_3) (HSub.hSub.{0, 0, 0} Nat Nat Nat (instHSub.{0} Nat instSubNat) r (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))))))
Case conversion may be inaccurate. Consider using '#align finset.card_div_choose_le_card_shadow_div_choose Finset.card_div_choose_le_card_shadow_div_chooseₓ'. -/
/-- The downward **local LYM inequality**. `𝒜` takes up less of `α^(r)` (the finsets of card `r`)
than `∂𝒜` takes up of `α^(r - 1)`. -/
theorem card_div_choose_le_card_shadow_div_choose (hr : r ≠ 0) (h𝒜 : (𝒜 : Set (Finset α)).Sized r) :
    (𝒜.card : 𝕜) / (Fintype.card α).choose r ≤ ((∂ ) 𝒜).card / (Fintype.card α).choose (r - 1) :=
  by
  obtain hr' | hr' := lt_or_le (Fintype.card α) r
  · rw [choose_eq_zero_of_lt hr', cast_zero, div_zero]
    exact div_nonneg (cast_nonneg _) (cast_nonneg _)
  replace h𝒜 := card_mul_le_card_shadow_mul h𝒜
  rw [div_le_div_iff] <;> norm_cast
  · cases r
    · exact (hr rfl).elim
    rw [Nat.succ_eq_add_one] at *
    rw [tsub_add_eq_add_tsub hr', add_tsub_add_eq_tsub_right] at h𝒜
    apply le_of_mul_le_mul_right _ (pos_iff_ne_zero.2 hr)
    convert Nat.mul_le_mul_right ((Fintype.card α).choose r) h𝒜 using 1
    · simp [mul_assoc, Nat.choose_succ_right_eq]
      exact Or.inl (mul_comm _ _)
    · simp only [mul_assoc, choose_succ_right_eq, mul_eq_mul_left_iff]
      exact Or.inl (mul_comm _ _)
  · exact Nat.choose_pos hr'
  · exact Nat.choose_pos (r.pred_le.trans hr')
#align finset.card_div_choose_le_card_shadow_div_choose Finset.card_div_choose_le_card_shadow_div_choose

end LocalLym

/-! ### LYM inequality -/

section Lym

section Falling

variable [DecidableEq α] (k : ℕ) (𝒜 : Finset (Finset α))

#print Finset.falling /-
/-- `falling k 𝒜` is all the finsets of cardinality `k` which are a subset of something in `𝒜`. -/
def falling : Finset (Finset α) :=
  𝒜.sup <| powersetLen k
#align finset.falling Finset.falling
-/

variable {𝒜 k} {s : Finset α}

/- warning: finset.mem_falling -> Finset.mem_falling is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_2 : DecidableEq.{succ u1} α] {k : Nat} {𝒜 : Finset.{u1} (Finset.{u1} α)} {s : Finset.{u1} α}, Iff (Membership.Mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.hasMem.{u1} (Finset.{u1} α)) s (Finset.falling.{u1} α (fun (a : α) (b : α) => _inst_2 a b) k 𝒜)) (And (Exists.{succ u1} (Finset.{u1} α) (fun (t : Finset.{u1} α) => Exists.{0} (Membership.Mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.hasMem.{u1} (Finset.{u1} α)) t 𝒜) (fun (H : Membership.Mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.hasMem.{u1} (Finset.{u1} α)) t 𝒜) => HasSubset.Subset.{u1} (Finset.{u1} α) (Finset.hasSubset.{u1} α) s t))) (Eq.{1} Nat (Finset.card.{u1} α s) k))
but is expected to have type
  forall {α : Type.{u1}} [_inst_2 : DecidableEq.{succ u1} α] {k : Nat} {𝒜 : Finset.{u1} (Finset.{u1} α)} {s : Finset.{u1} α}, Iff (Membership.mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.instMembershipFinset.{u1} (Finset.{u1} α)) s (Finset.falling.{u1} α (fun (a : α) (b : α) => _inst_2 a b) k 𝒜)) (And (Exists.{succ u1} (Finset.{u1} α) (fun (t : Finset.{u1} α) => And (Membership.mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.instMembershipFinset.{u1} (Finset.{u1} α)) t 𝒜) (HasSubset.Subset.{u1} (Finset.{u1} α) (Finset.instHasSubsetFinset.{u1} α) s t))) (Eq.{1} Nat (Finset.card.{u1} α s) k))
Case conversion may be inaccurate. Consider using '#align finset.mem_falling Finset.mem_fallingₓ'. -/
theorem mem_falling : s ∈ falling k 𝒜 ↔ (∃ t ∈ 𝒜, s ⊆ t) ∧ s.card = k := by
  simp_rw [falling, mem_sup, mem_powerset_len, exists_and_right]
#align finset.mem_falling Finset.mem_falling

variable (𝒜 k)

#print Finset.sized_falling /-
theorem sized_falling : (falling k 𝒜 : Set (Finset α)).Sized k := fun s hs => (mem_falling.1 hs).2
#align finset.sized_falling Finset.sized_falling
-/

#print Finset.slice_subset_falling /-
theorem slice_subset_falling : 𝒜 # k ⊆ falling k 𝒜 := fun s hs =>
  mem_falling.2 <| (mem_slice.1 hs).imp_left fun h => ⟨s, h, Subset.refl _⟩
#align finset.slice_subset_falling Finset.slice_subset_falling
-/

#print Finset.falling_zero_subset /-
theorem falling_zero_subset : falling 0 𝒜 ⊆ {∅} :=
  subset_singleton_iff'.2 fun t ht => card_eq_zero.1 <| sized_falling _ _ ht
#align finset.falling_zero_subset Finset.falling_zero_subset
-/

#print Finset.slice_union_shadow_falling_succ /-
theorem slice_union_shadow_falling_succ : 𝒜 # k ∪ (∂ ) (falling (k + 1) 𝒜) = falling k 𝒜 :=
  by
  ext s
  simp_rw [mem_union, mem_slice, mem_shadow_iff, exists_prop, mem_falling]
  constructor
  · rintro (h | ⟨s, ⟨⟨t, ht, hst⟩, hs⟩, a, ha, rfl⟩)
    · exact ⟨⟨s, h.1, subset.refl _⟩, h.2⟩
    refine' ⟨⟨t, ht, (erase_subset _ _).trans hst⟩, _⟩
    rw [card_erase_of_mem ha, hs]
    rfl
  · rintro ⟨⟨t, ht, hst⟩, hs⟩
    by_cases s ∈ 𝒜
    · exact Or.inl ⟨h, hs⟩
    obtain ⟨a, ha, hst⟩ := ssubset_iff.1 (ssubset_of_subset_of_ne hst (ht.ne_of_not_mem h).symm)
    refine' Or.inr ⟨insert a s, ⟨⟨t, ht, hst⟩, _⟩, a, mem_insert_self _ _, erase_insert ha⟩
    rw [card_insert_of_not_mem ha, hs]
#align finset.slice_union_shadow_falling_succ Finset.slice_union_shadow_falling_succ
-/

variable {𝒜 k}

/-- The shadow of `falling m 𝒜` is disjoint from the `n`-sized elements of `𝒜`, thanks to the
antichain property. -/
theorem IsAntichain.disjoint_slice_shadow_falling {m n : ℕ}
    (h𝒜 : IsAntichain (· ⊆ ·) (𝒜 : Set (Finset α))) : Disjoint (𝒜 # m) ((∂ ) (falling n 𝒜)) :=
  disjoint_right.2 fun s h₁ h₂ =>
    by
    simp_rw [mem_shadow_iff, exists_prop, mem_falling] at h₁
    obtain ⟨s, ⟨⟨t, ht, hst⟩, hs⟩, a, ha, rfl⟩ := h₁
    refine' h𝒜 (slice_subset h₂) ht _ ((erase_subset _ _).trans hst)
    rintro rfl
    exact not_mem_erase _ _ (hst ha)
#align is_antichain.disjoint_slice_shadow_falling IsAntichain.disjoint_slice_shadow_falling

/- warning: finset.le_card_falling_div_choose -> Finset.le_card_falling_div_choose is a dubious translation:
lean 3 declaration is
  forall {𝕜 : Type.{u1}} {α : Type.{u2}} [_inst_1 : LinearOrderedField.{u1} 𝕜] [_inst_2 : DecidableEq.{succ u2} α] {k : Nat} {𝒜 : Finset.{u2} (Finset.{u2} α)} [_inst_3 : Fintype.{u2} α], (LE.le.{0} Nat Nat.hasLe k (Fintype.card.{u2} α _inst_3)) -> (IsAntichain.{u2} (Finset.{u2} α) (HasSubset.Subset.{u2} (Finset.{u2} α) (Finset.hasSubset.{u2} α)) ((fun (a : Type.{u2}) (b : Type.{u2}) [self : HasLiftT.{succ u2, succ u2} a b] => self.0) (Finset.{u2} (Finset.{u2} α)) (Set.{u2} (Finset.{u2} α)) (HasLiftT.mk.{succ u2, succ u2} (Finset.{u2} (Finset.{u2} α)) (Set.{u2} (Finset.{u2} α)) (CoeTCₓ.coe.{succ u2, succ u2} (Finset.{u2} (Finset.{u2} α)) (Set.{u2} (Finset.{u2} α)) (Finset.Set.hasCoeT.{u2} (Finset.{u2} α)))) 𝒜)) -> (LE.le.{u1} 𝕜 (Preorder.toLE.{u1} 𝕜 (PartialOrder.toPreorder.{u1} 𝕜 (OrderedAddCommGroup.toPartialOrder.{u1} 𝕜 (StrictOrderedRing.toOrderedAddCommGroup.{u1} 𝕜 (LinearOrderedRing.toStrictOrderedRing.{u1} 𝕜 (LinearOrderedCommRing.toLinearOrderedRing.{u1} 𝕜 (LinearOrderedField.toLinearOrderedCommRing.{u1} 𝕜 _inst_1))))))) (Finset.sum.{u1, 0} 𝕜 Nat (AddCommGroup.toAddCommMonoid.{u1} 𝕜 (OrderedAddCommGroup.toAddCommGroup.{u1} 𝕜 (StrictOrderedRing.toOrderedAddCommGroup.{u1} 𝕜 (LinearOrderedRing.toStrictOrderedRing.{u1} 𝕜 (LinearOrderedCommRing.toLinearOrderedRing.{u1} 𝕜 (LinearOrderedField.toLinearOrderedCommRing.{u1} 𝕜 _inst_1)))))) (Finset.range (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) k (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (fun (r : Nat) => HDiv.hDiv.{u1, u1, u1} 𝕜 𝕜 𝕜 (instHDiv.{u1} 𝕜 (DivInvMonoid.toHasDiv.{u1} 𝕜 (DivisionRing.toDivInvMonoid.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_1))))) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat 𝕜 (HasLiftT.mk.{1, succ u1} Nat 𝕜 (CoeTCₓ.coe.{1, succ u1} Nat 𝕜 (Nat.castCoe.{u1} 𝕜 (AddMonoidWithOne.toNatCast.{u1} 𝕜 (AddGroupWithOne.toAddMonoidWithOne.{u1} 𝕜 (AddCommGroupWithOne.toAddGroupWithOne.{u1} 𝕜 (Ring.toAddCommGroupWithOne.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_1)))))))))) (Finset.card.{u2} (Finset.{u2} α) (Finset.slice.{u2} α 𝒜 (HSub.hSub.{0, 0, 0} Nat Nat Nat (instHSub.{0} Nat Nat.hasSub) (Fintype.card.{u2} α _inst_3) r)))) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat 𝕜 (HasLiftT.mk.{1, succ u1} Nat 𝕜 (CoeTCₓ.coe.{1, succ u1} Nat 𝕜 (Nat.castCoe.{u1} 𝕜 (AddMonoidWithOne.toNatCast.{u1} 𝕜 (AddGroupWithOne.toAddMonoidWithOne.{u1} 𝕜 (AddCommGroupWithOne.toAddGroupWithOne.{u1} 𝕜 (Ring.toAddCommGroupWithOne.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_1)))))))))) (Nat.choose (Fintype.card.{u2} α _inst_3) (HSub.hSub.{0, 0, 0} Nat Nat Nat (instHSub.{0} Nat Nat.hasSub) (Fintype.card.{u2} α _inst_3) r))))) (HDiv.hDiv.{u1, u1, u1} 𝕜 𝕜 𝕜 (instHDiv.{u1} 𝕜 (DivInvMonoid.toHasDiv.{u1} 𝕜 (DivisionRing.toDivInvMonoid.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_1))))) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat 𝕜 (HasLiftT.mk.{1, succ u1} Nat 𝕜 (CoeTCₓ.coe.{1, succ u1} Nat 𝕜 (Nat.castCoe.{u1} 𝕜 (AddMonoidWithOne.toNatCast.{u1} 𝕜 (AddGroupWithOne.toAddMonoidWithOne.{u1} 𝕜 (AddCommGroupWithOne.toAddGroupWithOne.{u1} 𝕜 (Ring.toAddCommGroupWithOne.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_1)))))))))) (Finset.card.{u2} (Finset.{u2} α) (Finset.falling.{u2} α (fun (a : α) (b : α) => _inst_2 a b) (HSub.hSub.{0, 0, 0} Nat Nat Nat (instHSub.{0} Nat Nat.hasSub) (Fintype.card.{u2} α _inst_3) k) 𝒜))) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat 𝕜 (HasLiftT.mk.{1, succ u1} Nat 𝕜 (CoeTCₓ.coe.{1, succ u1} Nat 𝕜 (Nat.castCoe.{u1} 𝕜 (AddMonoidWithOne.toNatCast.{u1} 𝕜 (AddGroupWithOne.toAddMonoidWithOne.{u1} 𝕜 (AddCommGroupWithOne.toAddGroupWithOne.{u1} 𝕜 (Ring.toAddCommGroupWithOne.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_1)))))))))) (Nat.choose (Fintype.card.{u2} α _inst_3) (HSub.hSub.{0, 0, 0} Nat Nat Nat (instHSub.{0} Nat Nat.hasSub) (Fintype.card.{u2} α _inst_3) k)))))
but is expected to have type
  forall {𝕜 : Type.{u1}} {α : Type.{u2}} [_inst_1 : LinearOrderedField.{u1} 𝕜] [_inst_2 : DecidableEq.{succ u2} α] {k : Nat} {𝒜 : Finset.{u2} (Finset.{u2} α)} [_inst_3 : Fintype.{u2} α], (LE.le.{0} Nat instLENat k (Fintype.card.{u2} α _inst_3)) -> (IsAntichain.{u2} (Finset.{u2} α) (fun (x._@.Mathlib.Combinatorics.SetFamily.LYM._hyg.1722 : Finset.{u2} α) (x._@.Mathlib.Combinatorics.SetFamily.LYM._hyg.1724 : Finset.{u2} α) => HasSubset.Subset.{u2} (Finset.{u2} α) (Finset.instHasSubsetFinset.{u2} α) x._@.Mathlib.Combinatorics.SetFamily.LYM._hyg.1722 x._@.Mathlib.Combinatorics.SetFamily.LYM._hyg.1724) (Finset.toSet.{u2} (Finset.{u2} α) 𝒜)) -> (LE.le.{u1} 𝕜 (Preorder.toLE.{u1} 𝕜 (PartialOrder.toPreorder.{u1} 𝕜 (StrictOrderedRing.toPartialOrder.{u1} 𝕜 (LinearOrderedRing.toStrictOrderedRing.{u1} 𝕜 (LinearOrderedCommRing.toLinearOrderedRing.{u1} 𝕜 (LinearOrderedField.toLinearOrderedCommRing.{u1} 𝕜 _inst_1)))))) (Finset.sum.{u1, 0} 𝕜 Nat (OrderedCancelAddCommMonoid.toAddCommMonoid.{u1} 𝕜 (StrictOrderedSemiring.toOrderedCancelAddCommMonoid.{u1} 𝕜 (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} 𝕜 (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} 𝕜 (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} 𝕜 (LinearOrderedField.toLinearOrderedSemifield.{u1} 𝕜 _inst_1)))))) (Finset.range (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) k (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (fun (r : Nat) => HDiv.hDiv.{u1, u1, u1} 𝕜 𝕜 𝕜 (instHDiv.{u1} 𝕜 (LinearOrderedField.toDiv.{u1} 𝕜 _inst_1)) (Nat.cast.{u1} 𝕜 (NonAssocRing.toNatCast.{u1} 𝕜 (Ring.toNonAssocRing.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_1))))) (Finset.card.{u2} (Finset.{u2} α) (Finset.slice.{u2} α 𝒜 (HSub.hSub.{0, 0, 0} Nat Nat Nat (instHSub.{0} Nat instSubNat) (Fintype.card.{u2} α _inst_3) r)))) (Nat.cast.{u1} 𝕜 (NonAssocRing.toNatCast.{u1} 𝕜 (Ring.toNonAssocRing.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_1))))) (Nat.choose (Fintype.card.{u2} α _inst_3) (HSub.hSub.{0, 0, 0} Nat Nat Nat (instHSub.{0} Nat instSubNat) (Fintype.card.{u2} α _inst_3) r))))) (HDiv.hDiv.{u1, u1, u1} 𝕜 𝕜 𝕜 (instHDiv.{u1} 𝕜 (LinearOrderedField.toDiv.{u1} 𝕜 _inst_1)) (Nat.cast.{u1} 𝕜 (NonAssocRing.toNatCast.{u1} 𝕜 (Ring.toNonAssocRing.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_1))))) (Finset.card.{u2} (Finset.{u2} α) (Finset.falling.{u2} α (fun (a : α) (b : α) => _inst_2 a b) (HSub.hSub.{0, 0, 0} Nat Nat Nat (instHSub.{0} Nat instSubNat) (Fintype.card.{u2} α _inst_3) k) 𝒜))) (Nat.cast.{u1} 𝕜 (NonAssocRing.toNatCast.{u1} 𝕜 (Ring.toNonAssocRing.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_1))))) (Nat.choose (Fintype.card.{u2} α _inst_3) (HSub.hSub.{0, 0, 0} Nat Nat Nat (instHSub.{0} Nat instSubNat) (Fintype.card.{u2} α _inst_3) k)))))
Case conversion may be inaccurate. Consider using '#align finset.le_card_falling_div_choose Finset.le_card_falling_div_chooseₓ'. -/
/-- A bound on any top part of the sum in LYM in terms of the size of `falling k 𝒜`. -/
theorem le_card_falling_div_choose [Fintype α] (hk : k ≤ Fintype.card α)
    (h𝒜 : IsAntichain (· ⊆ ·) (𝒜 : Set (Finset α))) :
    (∑ r in range (k + 1),
        ((𝒜 # (Fintype.card α - r)).card : 𝕜) / (Fintype.card α).choose (Fintype.card α - r)) ≤
      (falling (Fintype.card α - k) 𝒜).card / (Fintype.card α).choose (Fintype.card α - k) :=
  by
  induction' k with k ih
  · simp only [tsub_zero, cast_one, cast_le, sum_singleton, div_one, choose_self, range_one]
    exact card_le_of_subset (slice_subset_falling _ _)
  rw [succ_eq_add_one] at *
  rw [sum_range_succ, ← slice_union_shadow_falling_succ,
    card_disjoint_union h𝒜.disjoint_slice_shadow_falling, cast_add, _root_.add_div, add_comm]
  rw [← tsub_tsub, tsub_add_cancel_of_le (le_tsub_of_add_le_left hk)]
  exact
    add_le_add_left
      ((ih <| le_of_succ_le hk).trans <|
        card_div_choose_le_card_shadow_div_choose (tsub_pos_iff_lt.2 <| Nat.succ_le_iff.1 hk).ne' <|
          sized_falling _ _)
      _
#align finset.le_card_falling_div_choose Finset.le_card_falling_div_choose

end Falling

variable {𝒜 : Finset (Finset α)} {s : Finset α} {k : ℕ}

/- warning: finset.sum_card_slice_div_choose_le_one -> Finset.sum_card_slice_div_choose_le_one is a dubious translation:
lean 3 declaration is
  forall {𝕜 : Type.{u1}} {α : Type.{u2}} [_inst_1 : LinearOrderedField.{u1} 𝕜] {𝒜 : Finset.{u2} (Finset.{u2} α)} [_inst_2 : Fintype.{u2} α], (IsAntichain.{u2} (Finset.{u2} α) (HasSubset.Subset.{u2} (Finset.{u2} α) (Finset.hasSubset.{u2} α)) ((fun (a : Type.{u2}) (b : Type.{u2}) [self : HasLiftT.{succ u2, succ u2} a b] => self.0) (Finset.{u2} (Finset.{u2} α)) (Set.{u2} (Finset.{u2} α)) (HasLiftT.mk.{succ u2, succ u2} (Finset.{u2} (Finset.{u2} α)) (Set.{u2} (Finset.{u2} α)) (CoeTCₓ.coe.{succ u2, succ u2} (Finset.{u2} (Finset.{u2} α)) (Set.{u2} (Finset.{u2} α)) (Finset.Set.hasCoeT.{u2} (Finset.{u2} α)))) 𝒜)) -> (LE.le.{u1} 𝕜 (Preorder.toLE.{u1} 𝕜 (PartialOrder.toPreorder.{u1} 𝕜 (OrderedAddCommGroup.toPartialOrder.{u1} 𝕜 (StrictOrderedRing.toOrderedAddCommGroup.{u1} 𝕜 (LinearOrderedRing.toStrictOrderedRing.{u1} 𝕜 (LinearOrderedCommRing.toLinearOrderedRing.{u1} 𝕜 (LinearOrderedField.toLinearOrderedCommRing.{u1} 𝕜 _inst_1))))))) (Finset.sum.{u1, 0} 𝕜 Nat (AddCommGroup.toAddCommMonoid.{u1} 𝕜 (OrderedAddCommGroup.toAddCommGroup.{u1} 𝕜 (StrictOrderedRing.toOrderedAddCommGroup.{u1} 𝕜 (LinearOrderedRing.toStrictOrderedRing.{u1} 𝕜 (LinearOrderedCommRing.toLinearOrderedRing.{u1} 𝕜 (LinearOrderedField.toLinearOrderedCommRing.{u1} 𝕜 _inst_1)))))) (Finset.range (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) (Fintype.card.{u2} α _inst_2) (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))) (fun (r : Nat) => HDiv.hDiv.{u1, u1, u1} 𝕜 𝕜 𝕜 (instHDiv.{u1} 𝕜 (DivInvMonoid.toHasDiv.{u1} 𝕜 (DivisionRing.toDivInvMonoid.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_1))))) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat 𝕜 (HasLiftT.mk.{1, succ u1} Nat 𝕜 (CoeTCₓ.coe.{1, succ u1} Nat 𝕜 (Nat.castCoe.{u1} 𝕜 (AddMonoidWithOne.toNatCast.{u1} 𝕜 (AddGroupWithOne.toAddMonoidWithOne.{u1} 𝕜 (AddCommGroupWithOne.toAddGroupWithOne.{u1} 𝕜 (Ring.toAddCommGroupWithOne.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_1)))))))))) (Finset.card.{u2} (Finset.{u2} α) (Finset.slice.{u2} α 𝒜 r))) ((fun (a : Type) (b : Type.{u1}) [self : HasLiftT.{1, succ u1} a b] => self.0) Nat 𝕜 (HasLiftT.mk.{1, succ u1} Nat 𝕜 (CoeTCₓ.coe.{1, succ u1} Nat 𝕜 (Nat.castCoe.{u1} 𝕜 (AddMonoidWithOne.toNatCast.{u1} 𝕜 (AddGroupWithOne.toAddMonoidWithOne.{u1} 𝕜 (AddCommGroupWithOne.toAddGroupWithOne.{u1} 𝕜 (Ring.toAddCommGroupWithOne.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_1)))))))))) (Nat.choose (Fintype.card.{u2} α _inst_2) r)))) (OfNat.ofNat.{u1} 𝕜 1 (OfNat.mk.{u1} 𝕜 1 (One.one.{u1} 𝕜 (AddMonoidWithOne.toOne.{u1} 𝕜 (AddGroupWithOne.toAddMonoidWithOne.{u1} 𝕜 (AddCommGroupWithOne.toAddGroupWithOne.{u1} 𝕜 (Ring.toAddCommGroupWithOne.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_1)))))))))))
but is expected to have type
  forall {𝕜 : Type.{u1}} {α : Type.{u2}} [_inst_1 : LinearOrderedField.{u1} 𝕜] {𝒜 : Finset.{u2} (Finset.{u2} α)} [_inst_2 : Fintype.{u2} α], (IsAntichain.{u2} (Finset.{u2} α) (fun (x._@.Mathlib.Combinatorics.SetFamily.LYM._hyg.2025 : Finset.{u2} α) (x._@.Mathlib.Combinatorics.SetFamily.LYM._hyg.2027 : Finset.{u2} α) => HasSubset.Subset.{u2} (Finset.{u2} α) (Finset.instHasSubsetFinset.{u2} α) x._@.Mathlib.Combinatorics.SetFamily.LYM._hyg.2025 x._@.Mathlib.Combinatorics.SetFamily.LYM._hyg.2027) (Finset.toSet.{u2} (Finset.{u2} α) 𝒜)) -> (LE.le.{u1} 𝕜 (Preorder.toLE.{u1} 𝕜 (PartialOrder.toPreorder.{u1} 𝕜 (StrictOrderedRing.toPartialOrder.{u1} 𝕜 (LinearOrderedRing.toStrictOrderedRing.{u1} 𝕜 (LinearOrderedCommRing.toLinearOrderedRing.{u1} 𝕜 (LinearOrderedField.toLinearOrderedCommRing.{u1} 𝕜 _inst_1)))))) (Finset.sum.{u1, 0} 𝕜 Nat (OrderedCancelAddCommMonoid.toAddCommMonoid.{u1} 𝕜 (StrictOrderedSemiring.toOrderedCancelAddCommMonoid.{u1} 𝕜 (LinearOrderedSemiring.toStrictOrderedSemiring.{u1} 𝕜 (LinearOrderedCommSemiring.toLinearOrderedSemiring.{u1} 𝕜 (LinearOrderedSemifield.toLinearOrderedCommSemiring.{u1} 𝕜 (LinearOrderedField.toLinearOrderedSemifield.{u1} 𝕜 _inst_1)))))) (Finset.range (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) (Fintype.card.{u2} α _inst_2) (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (fun (r : Nat) => HDiv.hDiv.{u1, u1, u1} 𝕜 𝕜 𝕜 (instHDiv.{u1} 𝕜 (LinearOrderedField.toDiv.{u1} 𝕜 _inst_1)) (Nat.cast.{u1} 𝕜 (NonAssocRing.toNatCast.{u1} 𝕜 (Ring.toNonAssocRing.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_1))))) (Finset.card.{u2} (Finset.{u2} α) (Finset.slice.{u2} α 𝒜 r))) (Nat.cast.{u1} 𝕜 (NonAssocRing.toNatCast.{u1} 𝕜 (Ring.toNonAssocRing.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_1))))) (Nat.choose (Fintype.card.{u2} α _inst_2) r)))) (OfNat.ofNat.{u1} 𝕜 1 (One.toOfNat1.{u1} 𝕜 (NonAssocRing.toOne.{u1} 𝕜 (Ring.toNonAssocRing.{u1} 𝕜 (DivisionRing.toRing.{u1} 𝕜 (Field.toDivisionRing.{u1} 𝕜 (LinearOrderedField.toField.{u1} 𝕜 _inst_1))))))))
Case conversion may be inaccurate. Consider using '#align finset.sum_card_slice_div_choose_le_one Finset.sum_card_slice_div_choose_le_oneₓ'. -/
/-- The **Lubell-Yamamoto-Meshalkin inequality**. If `𝒜` is an antichain, then the sum of the
proportion of elements it takes from each layer is less than `1`. -/
theorem sum_card_slice_div_choose_le_one [Fintype α]
    (h𝒜 : IsAntichain (· ⊆ ·) (𝒜 : Set (Finset α))) :
    (∑ r in range (Fintype.card α + 1), ((𝒜 # r).card : 𝕜) / (Fintype.card α).choose r) ≤ 1 := by
  classical
    rw [← sum_flip]
    refine' (le_card_falling_div_choose le_rfl h𝒜).trans _
    rw [div_le_iff] <;> norm_cast
    ·
      simpa only [Nat.sub_self, one_mul, Nat.choose_zero_right, falling] using
        (sized_falling 0 𝒜).card_le
    · rw [tsub_self, choose_zero_right]
      exact zero_lt_one
#align finset.sum_card_slice_div_choose_le_one Finset.sum_card_slice_div_choose_le_one

end Lym

/-! ### Sperner's theorem -/

/-- **Sperner's theorem**. The size of an antichain in `finset α` is bounded by the size of the
maximal layer in `finset α`. This precisely means that `finset α` is a Sperner order. -/
theorem IsAntichain.sperner [Fintype α] {𝒜 : Finset (Finset α)}
    (h𝒜 : IsAntichain (· ⊆ ·) (𝒜 : Set (Finset α))) :
    𝒜.card ≤ (Fintype.card α).choose (Fintype.card α / 2) := by
  classical
    suffices
      (∑ r in Iic (Fintype.card α),
          ((𝒜 # r).card : ℚ) / (Fintype.card α).choose (Fintype.card α / 2)) ≤
        1
      by
      rwa [← sum_div, ← Nat.cast_sum, div_le_one, cast_le, sum_card_slice] at this
      norm_cast
      exact choose_pos (Nat.div_le_self _ _)
    rw [Iic_eq_Icc, ← Ico_succ_right, bot_eq_zero, Ico_zero_eq_range]
    refine' (sum_le_sum fun r hr => _).trans (sum_card_slice_div_choose_le_one h𝒜)
    rw [mem_range] at hr
    refine' div_le_div_of_le_left _ _ _ <;> norm_cast
    · exact Nat.zero_le _
    · exact choose_pos (lt_succ_iff.1 hr)
    · exact choose_le_middle _ _
#align is_antichain.sperner IsAntichain.sperner

end Finset


class HasMem (α : outParam $ Type u) (β : Type v) where
    mem : α → β → Prop

class PartialOrder (P : Type u) extends LE P where
  refl (s : P) : s ≤ s
  antisymm (s t : P) : s ≤ t → t ≤ s → s = t
  trans (s t u : P) : s ≤ t → t ≤ u → s ≤ u

theorem LE.le.trans {P : Type _} [PartialOrder P] {x y z : P} : x ≤ y → y ≤ z → x ≤ z := PartialOrder.trans _ _ _

infix:50 " ∈ " => HasMem.mem

def Set (α : Type u) := α → Prop

namespace Set

instance : HasMem α (Set α) := ⟨λ a s => s a⟩

theorem ext {s t : Set α} (h : ∀ x, x ∈ s ↔ x ∈ t) : s = t :=
  funext $ λ x => propext $ h x

instance : LE (Set α) := ⟨λ s t => ∀ {x : α}, x ∈ s → x ∈ t⟩

instance : PartialOrder (Set α) where
  refl := λ s x => id
  antisymm := λ s t hst hts => ext $ λ x => ⟨hst, hts⟩
  trans := λ s t u hst htu x hxs => htu $ hst hxs

variable (x y z : Set α) (hxy : x ≤ y) (hyz : y ≤ z)

example : x ≤ z := hxy.trans hyz

example : x ≤ z := by
  refine hxy.trans ?_
  exact hyz

example : x ≤ z := by
  apply hxy.trans
  assumption

example : x ≤ y → y ≤ z → x ≤ z :=
  λ h h' => _ -- goal view has the unfolded `x✝ ∈ x → x✝ ∈ z` instead of `x ≤ y`


example (x₁ x₂ y₁ y₂ : Nat) : (x₁ + x₂) + (y₁ + y₂) = (x₁ + y₁) + (x₂ + y₂) := by
  calc (x₁ + x₂) + (y₁ + y₂)
      = x₁ + (x₂ + (y₁ + y₂)) := by rw [Nat.add_assoc]
    _ = x₁ + (y₁ + (x₂ + y₂)) := by rw [Nat.add_left_comm x₂ y₁ y₂]
    _ = (x₁ + y₁) + (x₂ + y₂) := by rw [Nat.add_assoc]

example (n x₁ x₂ y₁ y₂ : Nat) : n = 0 → (x₁ + x₂) + (y₁ + y₂) = (x₁ + y₁) + (x₂ + y₂) := by
  intro h
  induction n with
  | zero =>
    calc (x₁ + x₂) + (y₁ + y₂)
       = x₁ + (x₂ + (y₁ + y₂)) := by rw [Nat.add_assoc]
     _ = x₁ + (y₁ + (x₂ + y₂)) := by rw [Nat.add_left_comm x₂ y₁ y₂]
     _ = (x₁ + y₁) + (x₂ + y₂) := by rw [Nat.add_assoc]
  | succ _ _ => contradiction


import game.world7.level5 -- hide
/-
# Advanced proposition world.

## Level 6: Or, and the `left` and `right` tactics.

`P ∨ Q` means "$P$ or $Q$". So to prove it, you
need to choose one of `P` or `Q`, and prove that one.
If `⊢ P ∨ Q` is your goal, then `left` changes this
goal to `⊢ P`, and `right` changes it to `⊢ Q`.
Note that you can take a wrong turn here. Let's
start with trying to prove $Q\implies (P\lor Q)$.
After the `intro`, one of `left` and `right` leads
to an impossible goal, the other to an easy finish.
-/

/- Lemma : no-side-bar
If $P$ and $Q$ are true/false statements, then
$$Q\implies(P\lor Q).$$
-/
example (P Q : Prop) : Q → (P ∨ Q) :=
begin
  intro q,
  right,
  assumption,

end
/- Tactic : left and right

## Summary

`left` and `right` work on the goal, and they change
`⊢ P ∨ Q` to `⊢ P` and `⊢ Q` respectively.

## Details

The tactics `left` and `right` work on a goal which is a type with
two constructors, the classic example being `P ∨ Q`.
To prove `P ∨ Q` it suffices to either prove `P` or prove `Q`,
and once you know which one you are going for you can change
the goal with `left` or `right` to the appropriate choice.
-/


import topology.metric_space.baire
import measure_theory.constructions.borel_space
import order.filter.curry
import topology.homeomorph

#check @residual

section cfilter

variables {α : Type*}

open set filter

namespace filter

inductive countable_generate_sets (g : set (set α)) : set α → Prop
| basic {s : set α}      : s ∈ g → countable_generate_sets s
| univ                   : countable_generate_sets univ
| superset {s t : set α} : countable_generate_sets s → s ⊆ t → countable_generate_sets t
| Inter {S : set (set α)}  : S.countable → (∀ s ∈ S, countable_generate_sets s) → countable_generate_sets ⋂₀ S

def countable_generate (g : set (set α)) : filter α :=
{ sets := countable_generate_sets g,
  univ_sets := countable_generate_sets.univ,
  sets_of_superset := λ s t, countable_generate_sets.superset,
  inter_sets := λ s t hs ht,
  begin
    let S : set (set α) := {s,t},
    have : s ∩ t = ⋂₀ S := by rw [sInter_insert, sInter_singleton],
    rw this,
    apply countable_generate_sets.Inter S.to_countable,
    rintros u (rfl | hu), --why wont the second hu work as rfl?
    assumption,
    rw mem_singleton_iff at hu,
    rw hu,
    assumption,
  end }

instance countable_generate_countable_Inter_filter {g : set (set α)} :
  countable_Inter_filter (countable_generate g) :=
begin
  constructor,
  apply countable_generate_sets.Inter,
end

lemma mem_countable_generate_of_mem {g : set (set α)} {s : set α} (h : s ∈ g) :
  s ∈ countable_generate g := countable_generate_sets.basic h

lemma mem_countable_generate_iff {g : set (set α)} {s : set α} :
  s ∈ countable_generate g ↔ ∃ S : set (set α), S ⊆ g ∧ S.countable ∧ ⋂₀ S ⊆ s :=
begin
  split, swap,
  { rintros ⟨S,Sg,Sct,Ss⟩,
    apply mem_of_superset _ Ss,
    apply countable_generate_sets.Inter Sct,
    intros s hs,
    apply mem_countable_generate_of_mem,
    exact Sg hs, },
  intros hs,
  induction hs with s h s t dum st ih T Tct hT ih,
  { exact ⟨{s}, singleton_subset_iff.mpr h, countable_singleton _, by simp⟩ },
  { exact ⟨∅, empty_subset _, countable_empty,subset_univ _⟩, },
  { refine Exists.imp _ ih,
    rintros S ⟨S1,S2,hS⟩,
    exact ⟨S1,S2,hS.trans st⟩, },
  dsimp at ih,
  choose S Sg Sct hS using ih,
  refine ⟨⋃ (s : set α) (H : s ∈ T), S s H, _, _, _⟩,
  { simp only [Union_subset_iff], exact Sg, },
  { exact countable.bUnion Tct Sct, },
  apply subset_sInter,
  intros s H,
  apply subset_trans _ (hS s H),
  apply sInter_subset_sInter,
  apply subset_Union₂,
end

lemma eventually.eventually_eq {f : filter α} {p q : α → Prop}
  (hp : ∀ᶠ x in f, p x) (heq : q =ᶠ[f] p) : ∀ᶠ x in f, q x :=
begin
  rw [filter.eventually,← eventually_eq_univ] at *,
  exact heq.trans hp,
end

lemma frequently.eventually_eq {f : filter α} {p q : α → Prop}
  (hp : ∃ᶠ x in f, p x) (heq : q =ᶠ[f] p) : ∃ᶠ x in f, q x :=
begin
  rw [filter.frequently] at *,
  intros h,
  apply hp,
  exact h.eventually_eq heq.compl.symm,
end

end filter
end cfilter

section

open set filter

variables (α : Type*) [topological_space α]

def comeager : filter α := filter.countable_generate (λ s, is_open s ∧ dense s)

notation s ` =ᵇ `:50 t := s =ᶠ[comeager _] t
notation s ` ≤ᵇ `:50 t := s ≤ᶠ[comeager _] t
--notation `∀ᵇ `:50 x := ∀ᶠ x in (comeager _) not working
--notation `∃ᵇ `:50 x := ∃ᶠ x in (comeager _)

instance comeager_countable_Inter : countable_Inter_filter (comeager α) :=
begin
  rw[comeager],
  apply_instance,
end

variables {α}

@[reducible]
def is_comeager (s : set α) : Prop := s ∈ comeager α
def is_meager (s : set α) : Prop := is_comeager sᶜ

lemma is_comeager_def {s : set α} : s ∈ comeager α ↔ is_comeager s := by refl --rfl doesnt work

lemma is_comeager_iff_eventually_eq_univ {s : set α} : is_comeager s ↔ s =ᵇ univ :=
by rw[eventually_eq_univ]

lemma is_meager_iff_eventually_eq_empty {s : set α} : is_meager s ↔ s =ᵇ (∅ : set α) :=--????
begin
  rw [is_meager,eventually_eq_empty],
  refl,
end

lemma is_comeager_iff_sInter {s : set α} : is_comeager s ↔
  ∃ T : set (set α), (∀ t ∈ T, is_open t ∧ dense t) ∧ T.countable ∧ ⋂₀ T ⊆ s :=
begin
  rw [is_comeager,comeager,mem_countable_generate_iff],
  refl,
end

lemma is_meager_iff_sUnion {s : set α} : is_meager s ↔
  ∃ T : set (set α), (∀ t ∈ T, is_closed t ∧ interior t = ∅) ∧ T.countable ∧ s ⊆ ⋃₀ T :=
begin
  rw [is_meager,is_comeager_iff_sInter],
  sorry,
end

lemma is_comeager_of_sInter {S : set (set α)} (Sct : S.countable)
  (hS : ∀ s ∈ S, is_comeager s) : is_comeager ⋂₀ S :=
(countable_sInter_mem Sct).mpr hS

lemma is_meager_of_sUnion {S : set (set α)} (Sct : S.countable)
  (hS : ∀ s ∈ S, is_meager s) : is_meager ⋃₀ S :=
begin
  rw[is_meager, compl_sUnion],
  apply is_comeager_of_sInter (Sct.image _),
  rintros s ⟨t,tS,rfl⟩,
  apply hS,
  exact tS,
end

lemma is_comeager.eventually_eq {s t : set α} (hs : is_comeager s) (hst : t =ᵇ s) :
  is_comeager t := eventually.eventually_eq hs hst

lemma is_meager.eventually_eq {s t : set α} (hs : is_meager s) (hst : t =ᵇ s) :
  is_meager t := is_comeager.eventually_eq hs hst.compl

@[simp]
theorem is_meager_compl_iff {s : set α} : is_meager sᶜ ↔ is_comeager s :=
by rw[is_meager,compl_compl]

@[simp]
theorem is_comeager_compl_iff {s : set α} : is_comeager sᶜ ↔ is_meager s := by refl

lemma is_comeager_of_open_dense {s : set α} (hopen : is_open s)(hdense : dense s) :
  is_comeager s := filter.mem_countable_generate_of_mem ⟨hopen,hdense⟩

lemma is_closed.sdiff_interior_meager {s : set α} (hs : is_closed s) :
  is_meager (s \ interior s) :=
begin
  apply is_comeager_of_open_dense,
  { rw is_open_compl_iff,
    exact hs.sdiff is_open_interior, },
  rw [← interior_eq_empty_iff_dense_compl, ← subset_empty_iff],
  have : ∅ = interior s ∩ (s \ interior s), { rw inter_diff_self, },
  rw [this, subset_inter_iff],
  split, { apply interior_mono, apply diff_subset,},
  apply interior_subset,
end

lemma is_open.closure_sdiff_meager {s : set α} (hs : is_open s) : is_meager (closure s \ s) :=
begin
  have := hs.is_closed_compl.sdiff_interior_meager,
  simpa,
end

--def baire_measurable_space (α : Type*) [topological_space α] : Type* := α

variables (α)

def baire_measurable : measurable_space α :=
{ measurable_set' := λ s, ∃ u, is_open u ∧ s =ᵇ u,
  measurable_set_empty := ⟨∅, ⟨is_open_empty, by refl⟩⟩,
  measurable_set_compl := λ s ⟨u,uop,su⟩, by {
    refine ⟨interior uᶜ, is_open_interior, _⟩,
    calc
    sᶜ =ᵇ uᶜ : su.compl
    ... =ᵇ (uᶜ ∩ interior uᶜ : set α) : by {
      symmetry,
      rw filter.inter_eventually_eq_left,
      rw [filter.eventually,is_comeager_def, ← is_meager_compl_iff],
      convert uop.is_closed_compl.sdiff_interior_meager,
      ext x,
      simp[and_comm], --this is terrible
     }
    ... = interior uᶜ : by { apply inter_eq_self_of_subset_right, exact interior_subset, }
  },
  measurable_set_Union := λ s hs, by {
    choose u uop hu using hs,
    exact ⟨⋃ i : ℕ, u i, is_open_Union uop, eventually_eq.countable_Union hu⟩,
  }}

variable {α}

def baire_measurable_set (s : set α) : Prop := @measurable_set _ (baire_measurable α) s

lemma borel_le_measurable : borel α ≤ baire_measurable α :=
begin
  apply measurable_space.generate_from_le,
  intros u uop,
  exact ⟨u,uop,by refl⟩,
end

--example (s t : set α) : Prop := s ≤ᶠ[comeager α] t

namespace baire_measurable_set

open topological_space

theorem localization {s : set α} (hs : baire_measurable_set s) :
  is_meager s ∨ ∃ u : set α, is_open u ∧ u.nonempty ∧ s =ᵇ u :=
begin
  rcases hs with ⟨u,uop,hu⟩,
  cases eq_empty_or_nonempty u with h h,
  { left, rwa [is_meager_iff_eventually_eq_empty, ←h], },
  right, exact ⟨u,uop,h,hu⟩,
end

theorem basis_localization {s : set α} (hs : baire_measurable_set s)  {b : set (set α)}
  (hb : is_topological_basis b) : is_meager s ∨ ∃ u ∈ b, u ≤ᵇ s :=
begin
  cases hs.localization with h h,
  {left, exact h},
  right,
  rcases h with ⟨v,vop,vnon,hv⟩,
  rcases hb.exists_nonempty_subset vnon vop with ⟨u,ub,-,uv⟩,
  use [u,ub],
  calc
  u ≤ᵇ v : uv.eventually_le
  ... =ᵇ s : hv.symm
end

end baire_measurable_set

section homeomorphism

#check homeomorph
variables {β : Type*} [topological_space β] (f : α ≃ₜ β)

#check filter.map f

theorem map_comeager_eq_comeager : filter.map f (comeager α) = comeager β :=
begin
  sorry,
end

theorem map_baire_measurable_eq_baire_measurable :
  measurable_space.map f (baire_measurable α) = baire_measurable β :=
begin
  sorry,
end

end homeomorphism

section KU

open topological_space function

variables {β : Type*} [topological_space β]
variables {A : set (α × β)}

lemma curry_eq {α β γ : Type*} (f : α × β → γ) (x : α) (y : β) :
  f (x,y) = f.curry x y := by simp[function.curry]

instance countable_Inter_filter_curry {α β: Type*} {f : filter α} {g : filter β}
  [countable_Inter_filter f] [countable_Inter_filter g] : countable_Inter_filter (f.curry g) :=
begin
  constructor,
  intros S Sct hS,
  dsimp[filter.curry],
  simp_rw[eventually_countable_ball Sct],
  exact hS,
end

lemma filter.frequently_curry_iff {α β: Type*} {f : filter α} {g : filter β} {p : α × β → Prop} :
  (∃ᶠ z in f.curry g, p z) ↔ (∃ᶠ x in f, ∃ᶠ y in g, p (x,y)) :=
by simp only[filter.frequently, eventually_curry_iff, not_not]

lemma is_open.section (h : is_open A) (x : α) : is_open (A.curry x) :=
begin
  refine continuous_def.mp _ A h,
  exact continuous.prod.mk x,
end

#check is_open.section
#check λ x, A.curry x
#check λ y, λ x, A.curry x y

--set_option pp.all true
theorem curry_le_comeager [second_countable_topology β] :
  (comeager α).curry (comeager β) ≤ comeager (α × β) :=
begin
  intros A hA,
  rw [is_comeager_def,is_comeager_iff_sInter] at hA,
  rcases hA with ⟨T,hT,Tct,TA⟩,
  apply mem_of_superset _ TA,
  rw countable_sInter_mem Tct, swap, { apply_instance }, --why didn't this instance get found?
  intros t ht,
  obtain ⟨top,tdense⟩ := hT _ ht,
  apply eventually_curry_iff.mpr,
  simp_rw [curry_eq t],
  have : ∀ x : α, dense (t.curry x) → is_comeager (t.curry x) := λ x h, is_comeager_of_open_dense (top.section x) h,
  apply eventually.mono _ this,
  --apply eventually.mono _ (λ x : α, is_comeager_of_open_dense (topen.section x)),
  obtain ⟨b,bct,-,bbasis⟩ := exists_countable_basis β,
  simp_rw [bbasis.dense_iff, eventually_countable_ball bct],
  intros u ub,
  have uop := bbasis.is_open ub,
  rw eventually_imp_distrib_left,
  intro hu,
  have : {x : α | (u ∩ curry t x).nonempty} = (prod.fst) '' ((univ ×ˢ u) ∩ t),
  { simp only [set.nonempty, image, function.curry, mem_inter_iff,
      mem_prod, mem_univ, true_and, prod.exists,
    exists_and_distrib_right, exists_eq_right], refl, },
  apply is_comeager_of_open_dense; rw this,
  { apply is_open_map_fst,
    exact (is_open_univ.prod uop).inter top, },
  rw dense_iff_inter_open at *,
  intros v vop hv,
  rcases tdense _ (vop.prod uop) (hv.prod hu) with ⟨⟨x,y⟩,⟨xv,yu⟩,xyt⟩,
  refine ⟨x,xv,_⟩,
  simp only [mem_image, mem_inter_iff, mem_prod, mem_univ, true_and, prod.exists, exists_and_distrib_right, exists_eq_right],
  exact ⟨y,yu,xyt⟩,
end

lemma topological_space.is_topological_basis.is_open_Union_countable_basis
  [second_countable_topology α] {b : set (set α)} (hb : is_topological_basis b)
  {U : set α} (hU : is_open U) : ∃ t : set (set α), t.countable ∧ t ⊆ b ∧ ⋃₀ t = U :=
begin
  rw hb.open_iff_eq_sUnion at hU,
  rcases hU with ⟨S,hS,rfl⟩,
  apply exists_imp_exists _ (is_open_sUnion_countable S _), { tauto },
  refine hS.trans _,
  intro u,
  exact hb.is_open,
end

lemma is_meager.prod_left {u : set α} {v : set β} (hu : is_meager u) : is_meager (u ×ˢ v) :=
begin
  rw [is_meager, is_comeager_iff_sInter] at *,
  rcases hu with ⟨T, hT, Tct, Tu⟩,
  use (λ t : set α, t ×ˢ univ) '' T,
  refine ⟨_, by apply Tct.image, _⟩,
  { rintros s ⟨t,tT,rfl⟩,
    specialize hT t tT,
    split, { exact hT.1.prod is_open_univ, },
    exact hT.2.prod dense_univ,},
  intros p,
  simp only [sInter_image, mem_Inter, mem_prod, mem_univ, and_true, mem_compl_iff, not_and],
  intros pT pu,
  exfalso,
  exact Tu pT pu,
end

lemma is_meager.prod_right {u : set α} {v : set β} (hv : is_meager v) : is_meager (u ×ˢ v) :=
begin
  rw [is_meager, ← is_comeager_def, ← map_comeager_eq_comeager (homeomorph.prod_comm _ _),
    homeomorph.coe_prod_comm, mem_map, preimage_compl, preimage_swap_prod,
    is_comeager_def, is_comeager_compl_iff],
  apply hv.prod_left,
end

theorem eventually_eventually_of_comeager [second_countable_topology β] (hA : is_comeager A) :
  ∀ᶠ x in (comeager α), ∀ᶠ y in (comeager β), (x,y) ∈ A := curry_le_comeager hA

theorem frequently_frequently_of_not_meager [second_countable_topology α]
  [second_countable_topology β]
  (hmeas : baire_measurable_set A) (hA : ¬ is_meager A) :
  ∃ᶠ x in (comeager α), ∃ᶠ y in (comeager β), (x,y) ∈ A :=
begin
  rcases hmeas with ⟨U,Uop,hU⟩,
  rcases ((@is_topological_basis_opens α _).prod
    (@is_topological_basis_opens β _)).is_open_Union_countable_basis Uop with ⟨T, Tct, Trect, rfl⟩,
  obtain ⟨t, tT, ht⟩ : ∃ t, t ∈ T ∧ ¬ is_meager t,
  { contrapose! hA,
    apply is_meager.eventually_eq _ hU,
    exact is_meager_of_sUnion Tct hA, },
  rcases Trect tT with ⟨u, v, -, -, rfl⟩,
  have hu : ¬ is_meager u := λ h, ht h.prod_left,
  have hv : ¬ is_meager v := λ h, ht h.prod_right,
  apply (@filter.frequently_curry_iff _ _ _ _ A).mp,
  apply frequently.eventually_eq _ (curry_le_comeager hU),
  apply frequently.mono _ (subset_sUnion_of_mem tT),
  simp only [filter.frequently_curry_iff, mem_prod,
    frequently_and_distrib_left, frequently_and_distrib_right],
  exact ⟨hu, hv⟩,
end

theorem baire_measurable_sections_left [second_countable_topology β]
  (hA : baire_measurable_set A) : ∀ᶠ x in (comeager α), baire_measurable_set (A.curry x) :=
begin
  rcases hA with ⟨U,Uop,hU⟩,
  apply eventually.mono (eventually_eventually_of_comeager hU),
  intros x hx,
  refine ⟨U.curry x,_,hx⟩,
  apply Uop.section,
end

--set_option pp.implicit true
theorem baire_measurable_sections_right [second_countable_topology α]
  (hA : baire_measurable_set A) : ∀ᶠ y in (comeager β), baire_measurable_set (λ x, A.curry x y) :=
begin
  let B := prod.swap ⁻¹' A,
  have : ∀ y : β, (λ x : α, A.curry x y) = B.curry y,
  { intros y, refl, },
  simp_rw this,
  apply baire_measurable_sections_left,
  dsimp[B],
  rw [baire_measurable_set, measurable_set,
    ← map_baire_measurable_eq_baire_measurable (homeomorph.prod_comm _ _),
     measurable_space.map] at hA,
  exact hA,
end

theorem curry_eq_comeager [second_countable_topology α] [second_countable_topology β]
  (hmeas : baire_measurable_set A) :
  is_comeager A ↔ ∀ᶠ x in (comeager α), ∀ᶠ y in (comeager β), (x,y) ∈ A :=
begin
  split, { apply curry_le_comeager, },
  contrapose,
  intro hA,
  simp only [not_eventually, ← mem_compl_iff],
  apply frequently_frequently_of_not_meager hmeas.compl,
  simp[hA],
end

theorem eventually_comeager_comm [second_countable_topology α] [second_countable_topology β]
  (hmeas : baire_measurable_set A) :
  (∀ᶠ x in (comeager α), ∀ᶠ y in (comeager β), (x,y) ∈ A) ↔ ∀ᶠ y in (comeager β), ∀ᶠ x in (comeager α), (x,y) ∈ A :=
begin
  rw ← curry_eq_comeager hmeas,
end

/-
theorem curry_eq_comeager [second_countable_topology α] [second_countable_topology β]
  (hmeas : baire_measurable_set A) :
  is_comeager A ↔ ∀ᶠ x in (comeager α), ∀ᶠ y in (comeager β), (x,y) ∈ A :=
begin
  split, { apply curry_le_comeager },
  intro hA,
  rcases hmeas.compl with ⟨U,Uop,hU⟩,
  rcases ((@is_topological_basis_opens α _).prod
    (@is_topological_basis_opens β _)).is_open_Union_countable_basis Uop with ⟨T, Tct, Trect, rfl⟩,
  have : ∀ t ∈ T, is_meager t,
  { intros t ht,
    rcases Trect ht with ⟨u, v, uop, vop, rfl⟩,
    suffices : (is_meager u) ∨ (is_meager v),
    { cases this with hu hv,
      { exact hu.prod_left, },
      exact hv.prod_right, },
    by_contra',
    let f := (comeager α).curry (comeager β),
    have h1 : A ∈ f := hA,
    have h2 : (⋃₀ T)ᶜ ∈ f,
    { rw ← eventually_eq_univ at *,
      calc
      (⋃₀ T)ᶜ =ᶠ[f] Aᶜᶜ : curry_le_comeager (hU.compl.symm)
      ... = A : by rw compl_compl
      ... =ᶠ[f] univ : h1 },
    have h3 : (u ×ˢ v)ᶜ ∈ f,
    { apply filter.mem_of_superset h2,
      rw [compl_subset_compl],
      exact subset_sUnion_of_mem ht,  },
    have h4 : ∃ᶠ x in (comeager α), ∃ᶠ y in (comeager β), (x,y) ∈ (u ×ˢ v),
    { simp only [prod_mk_mem_set_prod_eq, frequently_and_distrib_left, frequently_and_distrib_right],
      exact this, },
    have h5 : ∃ᶠ p in f, p ∈ (u ×ˢ v),
    { rw[filter.frequently, eventually_curry_iff],
      simp_rw [not_eventually,not_not],
      exact h4, },
    contradiction, },
  rw [is_comeager_iff_eventually_eq_univ],
  calc
  A = Aᶜᶜ : by rw compl_compl
  ... =ᵇ (⋃₀ T)ᶜ : hU.compl
  ... =ᵇ univ : by
  { rw [compl_sUnion, eventually_eq_univ, countable_sInter_mem],
    { rintros - ⟨t,tT,rfl⟩, apply this, exact tT, },
    apply Tct.image, },
end
-/

end KU

end


import mynat.definition -- hide
import mynat.add -- hide
import game.world8.level2 -- hide
namespace mynat -- hide

/-

# Advanced Addition World

## Level 3: `succ_eq_succ_of_eq`.
-/

/-
We are going to prove something completely obvious: if $a=b$ then
$succ(a)=succ(b)$. This is *not* `succ_inj`!
This is trivial -- we can just rewrite our proof of `a=b`.
But how do we get to that proof? Use the `intro` tactic.
-/

/- Theorem
For all naturals $a$ and $b$, $a=b\implies succ(a)=succ(b)$.
-/
theorem succ_eq_succ_of_eq {a b : mynat} : a = b → succ(a) = succ(b) :=
begin [nat_num_game]
  intro h,
  rw h,
  refl,
end

end mynat -- hide