import data.list.cycle
import data.nat.modeq
import ia.groups.hom

namespace notes

@[reducible] def sym (X : Type*) := X ≃ X

instance {X : Type*} : semigroup (sym X) := ⟨λ σ τ υ, rfl⟩
instance {X : Type*} : monoid (sym X) := ⟨λ σ, by simp, λ σ, by simp⟩
instance {X : Type*} : group (sym X) := ⟨λ σ, by simp, λ σ, by simp⟩

@[reducible] def sym_fin := sym ∘ fin

-- Cycles

structure cycle_perm (X : Type*) :=
(cy : cycle X)
(nodup : cy.nodup)

variables {X : Type*} [decidable_eq X]

def cycle_perm.next_if_mem (c : cycle_perm X) (x : X) :=
dite (x ∈ c.cy) (c.cy.next c.nodup x) (λ _, x)

lemma cycle_perm.next_if_mem_of_mem {c : cycle_perm X} {x : X} (h : x ∈ c.cy) :
cycle_perm.next_if_mem c x = c.cy.next c.nodup x h :=
begin
  unfold cycle_perm.next_if_mem,
  rw dite_eq_iff, simp, left, exact h
end

lemma cycle_perm.next_if_mem_of_not_mem {c : cycle_perm X} {x : X} (h : x ∉ c.cy) :
cycle_perm.next_if_mem c x = x :=
begin
  unfold cycle_perm.next_if_mem,
  rw dite_eq_iff, simp, right, exact h
end

def cycle_perm.prev_if_mem (c : cycle_perm X) (x : X) :=
dite (x ∈ c.cy) (c.cy.prev c.nodup x) (λ _, x)

lemma cycle_perm.prev_if_mem_of_mem {c : cycle_perm X} {x : X} (h : x ∈ c.cy) :
cycle_perm.prev_if_mem c x = c.cy.prev c.nodup x h :=
begin
  unfold cycle_perm.prev_if_mem,
  rw dite_eq_iff, simp, left, exact h
end

lemma cycle_perm.prev_if_mem_of_not_mem {c : cycle_perm X} {x : X} (h : x ∉ c.cy) :
cycle_perm.prev_if_mem c x = x :=
begin
  unfold cycle_perm.prev_if_mem,
  rw dite_eq_iff, simp, right, exact h
end

instance : has_coe (cycle_perm X) (sym X) := ⟨λ c, ⟨
  cycle_perm.next_if_mem c,
  cycle_perm.prev_if_mem c,
  begin
    intro x,
    by_cases x ∈ c.cy,
    { rw cycle_perm.next_if_mem_of_mem h,
      rw cycle_perm.prev_if_mem_of_mem (cycle.next_mem c.cy c.nodup x h),
      simp },
    { rw cycle_perm.next_if_mem_of_not_mem h,
      rw cycle_perm.prev_if_mem_of_not_mem h }
  end,
  begin
    intro x,
    by_cases x ∈ c.cy,
    { rw cycle_perm.prev_if_mem_of_mem h,
      rw cycle_perm.next_if_mem_of_mem (cycle.prev_mem c.cy c.nodup x h),
      simp },
    { rw cycle_perm.prev_if_mem_of_not_mem h,
      rw cycle_perm.next_if_mem_of_not_mem h }
  end
⟩⟩

lemma cycle_perm.act_def (c : cycle_perm X) (x : X) :
c x = cycle_perm.next_if_mem c x := rfl

@[simp]
lemma cycle_perm.act_of_not_mem {c : cycle_perm X} {x : X} (h : x ∉ c.cy) : c x = x :=
by rw [cycle_perm.act_def, cycle_perm.next_if_mem_of_not_mem h]

@[simp]
lemma cycle_perm.act_mem_of_mem {c : cycle_perm X} {x : X} (h : x ∈ c.cy) : c x ∈ c.cy :=
begin
  rw cycle_perm.act_def,
  rw cycle_perm.next_if_mem_of_mem h,
  simp
end

@[simp]
lemma cycle_perm.act_mem_iff_mem (c : cycle_perm X) (x : X) : x ∈ c.cy ↔ c x ∈ c.cy :=
begin
  split,
  { intro h, exact cycle_perm.act_mem_of_mem h },
  { intro h, by_contradiction g,
    rw cycle_perm.act_of_not_mem g at h,
    exact g h }
end

@[simp]
lemma cycle_perm.act_not_mem_of_not_mem {c : cycle_perm X} {x : X} (h : x ∉ c.cy) : c x ∉ c.cy :=
by { rw cycle_perm.act_of_not_mem h, exact h }

@[simp]
lemma cycle_perm.act_not_mem_iff_not_mem (c : cycle_perm X) (x : X) : x ∉ c.cy ↔ c x ∉ c.cy :=
by rw cycle_perm.act_mem_iff_mem

def cycle_perm.disjoint (c d : cycle_perm X) : Prop := ∀ (x : X), x ∈ c.cy → x ∉ d.cy

lemma cycle_perm.disjoint.symm {c d : cycle_perm X} :
c.disjoint d → d.disjoint c := λ h x hx hc, h x hc hx

lemma cycle_perm.disjoint.symm_iff (c d : cycle_perm X) :
c.disjoint d ↔ d.disjoint c := ⟨cycle_perm.disjoint.symm, cycle_perm.disjoint.symm⟩

lemma cycle_perm.comm_of_disjoint (c d : cycle_perm X) (hcd : cycle_perm.disjoint c d) :
(c : sym X) * d = d * c :=
begin
  ext x,
  change c (d x) = d (c x),
  by_cases x ∈ c.cy,
  { rw cycle_perm.act_of_not_mem (hcd x h),
    rw cycle_perm.act_of_not_mem (hcd _ (cycle_perm.act_mem_of_mem h)) },
  { rw cycle_perm.act_of_not_mem h,
    by_cases x ∈ d.cy,
    { rw cycle_perm.act_of_not_mem (hcd.symm _ (cycle_perm.act_mem_of_mem h) : d x ∉ c.cy) },
    { rw cycle_perm.act_of_not_mem,
      rw cycle_perm.act_of_not_mem,
      assumption, assumption } }
end

-- Cycle decomposition

variable {n : ℕ}

lemma sym_fin.ex_order (σ : sym_fin n) (x : fin n) :
∃ (n_1 : ℕ), (λ (n_1 : ℕ), 0 < n_1 ∧ (σ ^ n_1) x = x) n_1 :=
begin
  obtain ⟨a, b, hne, hab⟩ := fintype.exists_ne_map_eq_of_infinite (λ (n : ℕ), (σ ^ n) x),
  wlog : a < b,
  { exact ne.lt_or_lt hne },
  dsimp at hab,
  refine ⟨b - a, _, _⟩,
  { exact lt_tsub_comm.mp case },
  have : σ ^ b = (σ ^ a) * (σ ^ (b - a)),
  { rw group.nat_pow_comm_pow_of_comm,
    rw group.sub_nat_pow_of_le,
    exact le_of_lt case,
    refl },
  rw this at hab,
  symmetry,
  exact equiv.injective _ hab
end

def sym_fin.order (σ : sym_fin n) (x : fin n) : ℕ :=
@nat.find (λ n, 0 < n ∧ (σ ^ n) x = x) _ (sym_fin.ex_order σ x)

@[simp]
lemma sym_fin.order_pos (σ : sym_fin n) (x : fin n) : 0 < σ.order x :=
by { unfold sym_fin.order, simp }

@[simp]
lemma sym_fin.pow_order (σ : sym_fin n) (x : fin n) : (σ ^ σ.order x) x = x :=
(nat.find_spec (sym_fin.ex_order σ x)).right

@[simp]
lemma sym_fin.pow_pow_order (σ : sym_fin n) (x : fin n) (n : ℕ) :
((σ ^ σ.order x) ^ n) x = x :=
begin
  induction n,
  { simp },
  { rw nat.succ_eq_add_one,
    rw nat.add_comm,
    rw group.add_nat_pow,
    simp,
    rw n_ih,
    exact sym_fin.pow_order σ x }
end

def sym_fin.orbit_of (σ : sym_fin n) (x : fin n) : list (fin n) :=
list.map (λ n, (σ ^ n) x) $ list.range (sym_fin.order σ x)

@[simp]
lemma sym_fin.orbit_length_eq_order (σ : sym_fin n) (x : fin n) :
(σ.orbit_of x).length = σ.order x :=
by { unfold sym_fin.orbit_of, simp }

@[simp]
lemma sym_fin.orbit_of_nth (σ : sym_fin n) (x : fin n) (k : ℕ) :
(σ.orbit_of x).nth k = if k < σ.order x then some ((σ ^ k) x) else none :=
begin
  split_ifs,
  { unfold sym_fin.orbit_of,
    simp,
    exact ⟨k, list.nth_range h, rfl⟩ },
  { rw list.nth_eq_none_iff,
    simp,
    exact not_lt.mp h }
end

lemma sym_fin.eq_pow_of_mem_orbit_of {σ : sym_fin n} {x y : fin n}
(h : y ∈ σ.orbit_of x) : ∃ (n : ℕ), n < σ.order x ∧ (σ ^ n) x = y :=
begin
  unfold sym_fin.orbit_of at h,
  simp at h,
  exact h
end

@[simp]
lemma sym_fin.mem_orbit_of_ext (σ : sym_fin n) (x y : fin n) :
y ∈ σ.orbit_of x ↔ ∃ (n : ℕ), (σ ^ n) x = y :=
begin
  unfold sym_fin.orbit_of,
  simp,
  split,
  { rintro ⟨a, ha₁, ha₂⟩,
    exact ⟨a, ha₂⟩ },
  { rintro ⟨a, ha⟩,
    refine ⟨a % σ.order x, _, _⟩,
    { apply nat.mod_lt,
      simp },
    { rw ← nat.div_add_mod a (σ.order x) at ha,
      rw ← ha,
      rw nat.add_comm,
      rw group.add_nat_pow,
      simp,
      rw ← group.nat_pow_pow,
      simp } }
end

@[simp]
lemma sym_fin.mem_orbit_of_self (σ : sym_fin n) (x : fin n) : x ∈ σ.orbit_of x :=
by { simp, exact ⟨0, rfl⟩ }

@[simp]
lemma sym_fin.orbit_of_nodup (σ : sym_fin n) (x : fin n) : (sym_fin.orbit_of σ x).nodup :=
begin
  unfold sym_fin.orbit_of,
  rw list.nodup_map_iff_inj_on,
  { intros a ha b hb hab,
    by_contradiction hne,
    wlog : a < b,
    { exact ne.lt_or_lt hne },
    have : (σ ^ (b - a)) x = x,
    { have : σ ^ b = (σ ^ a) * (σ ^ (b - a)),
      { rw group.nat_pow_comm_pow_of_comm,
        rw group.sub_nat_pow_of_le,
        exact le_of_lt case,
        refl },
      rw this at hab,
      symmetry,
      exact equiv.injective _ hab },
    have : b - a < σ.order x,
    { rw list.mem_range at ha hb,
      apply lt_of_le_of_lt _ hb,
      norm_num },
    unfold sym_fin.order at this,
    rw nat.lt_find_iff at this,
    refine this (b - a) (le_refl _) ⟨_, _⟩,
    { norm_num, exact case },
    { assumption } },
  { exact list.nodup_range _ }
end

def sym_fin.cycle_of (σ : sym_fin n) (x : fin n) : cycle (fin n) :=
↑(sym_fin.orbit_of σ x)

@[simp]
lemma sym_fin.mem_cycle_of (σ : sym_fin n) (x y : fin n) :
y ∈ σ.cycle_of x ↔ y ∈ σ.orbit_of x := iff.rfl

@[simp]
lemma sym_fin.mem_cycle_of_self (σ : sym_fin n) (x : fin n) : x ∈ σ.cycle_of x :=
by simp

@[simp]
lemma sym_fin.cycle_of_nodup (σ : sym_fin n) (x : fin n) : (sym_fin.cycle_of σ x).nodup :=
by { unfold sym_fin.cycle_of, simp }

def sym_fin.cycle_perm_of (σ : sym_fin n) (x : fin n) : cycle_perm (fin n) :=
⟨sym_fin.cycle_of σ x, sym_fin.cycle_of_nodup σ x⟩

@[simp]
lemma sym_fin.mem_cycle_perm_of (σ : sym_fin n) (x y : fin n) :
y ∈ (σ.cycle_perm_of x).cy ↔ y ∈ σ.cycle_of x := iff.rfl

@[simp]
lemma sym_fin.cycle_perm_next_eq_cycle_next (σ : sym_fin n) (x y : fin n)
(hmem : y ∈ σ.cycle_of x) :
(σ.cycle_perm_of x).cy.next (sym_fin.cycle_of_nodup σ x) y ((sym_fin.mem_cycle_perm_of σ x y).mp hmem) =
(σ.cycle_of x).next (sym_fin.cycle_of_nodup σ x) y hmem :=
by unfold sym_fin.cycle_perm_of

@[simp]
lemma sym_fin.mem_cycle_perm_of_self (σ : sym_fin n) (x : fin n) : x ∈ (σ.cycle_perm_of x).cy :=
by simp

lemma quotient.hrec_on'_eq_hrec_on {α : Sort u_1} [s₁ : setoid α] {φ : quotient s₁ → Sort*}
(qa : quotient s₁) (f : Π (a : α), φ (quotient.mk' a)) (c : ∀ (a₁ a₂ : α), a₁ ≈ a₂ → f a₁ == f a₂)
: quotient.hrec_on' qa f c = quotient.hrec_on qa f c := rfl

lemma cycle_next_eq_list_next {α : Type*} [decidable_eq α] (s : list α) (hs : s.nodup) (x : α) (hx : x ∈ s) :
s.next x hx = (↑s : cycle α).next hs x hx := by refl

lemma range_eq_cons_cons (a : ℕ) : ∃ ys, list.range (a + 2) = 0 :: 1 :: ys :=
begin
  induction a,
  { have : list.range 2 = [0, 1] := rfl,
    rw this,
    exact ⟨[], rfl⟩ },
  { obtain ⟨ys, hys⟩:= a_ih,
    refine ⟨ys ++ [a_n + 2], _⟩,
    rw list.range_succ,
    rw hys,
    rw list.cons_append,
    rw list.cons_append }
end

@[simp]
lemma sym_fin.cycle_perm_act (σ : sym_fin n) (x : fin n) : sym_fin.cycle_perm_of σ x x = σ x :=
begin
  rw cycle_perm.act_def,
  rw cycle_perm.next_if_mem_of_mem (sym_fin.mem_cycle_perm_of_self σ x),
  have := sym_fin.cycle_perm_next_eq_cycle_next σ x x (sym_fin.mem_cycle_of_self σ x),
  convert this,
  unfold sym_fin.cycle_of,
  unfold sym_fin.orbit_of,
  convert cycle_next_eq_list_next (list.map (λ (n_1 : ℕ), (σ ^ n_1) x) (list.range (σ.order x))) _ _ _,
  by_cases σ.order x ≤ 1,
  { have ord_one := ge_antisymm (nat.succ_le_of_lt $ sym_fin.order_pos σ x) h,
    suffices : list.map (λ (m : ℕ), (σ ^ m) x) (list.range (σ.order x)) = [x],
    { simp_rw this,
      rw list.next_singleton x x,
      obtain ⟨_, hord⟩ := nat.find_spec (sym_fin.ex_order σ x),
      unfold sym_fin.order at ord_one,
      rw ord_one at hord,
      simp at hord,
      exact hord },
    rw ord_one,
    have : list.range 1 = [0] := rfl,
    rw this,
    simp },
  { obtain ⟨k, hk⟩ : ∃ (k : ℕ), σ.order x = k.succ.succ,
    { obtain ⟨k₁, hk₁⟩ := nat.exists_eq_succ_of_ne_zero (_ : σ.order x ≠ 0),
      obtain ⟨k₂, hk₂⟩ := nat.exists_eq_succ_of_ne_zero (_ : k₁ ≠ 0),
      refine ⟨k₂, _⟩,
      rw hk₁, rw hk₂,
      { intro hzero,
        rw hzero at hk₁,
        rw hk₁ at h,
        exact h (le_refl 1) },
      { intro hzero,
        rw hzero at h,
        exact h (zero_le 1) } },
    obtain ⟨ys, hys⟩ := range_eq_cons_cons k,
    rw ← nat.succ_eq_add_one at hys,
    rw ← nat.succ_eq_add_one at hys,
    rw ← hk at hys,
    simp_rw hys,
    simp,
    rw list.next_cons_cons_eq _ x (σ x) }
end

@[simp]
lemma sym_fin.cycle_perm_eq_of_mem_orbit (σ : sym_fin n) (x y : fin n)
(horb : y ∈ σ.orbit_of x) : σ.cycle_perm_of x = σ.cycle_perm_of y :=
begin
  unfold sym_fin.cycle_perm_of,
  unfold sym_fin.cycle_of,
  simp,
  rw list.is_rotated_iff_mod,
  obtain ⟨k, hk₁, hk₂⟩ := sym_fin.eq_pow_of_mem_orbit_of horb,
  refine ⟨k, _, _⟩,
  { unfold sym_fin.orbit_of,
    simp,
    exact le_of_lt hk₁ },
  { ext a a',
    simp,
    by_cases case : a < (σ.orbit_of x).length,
    { rw list.nth_rotate case,
      simp at case ⊢,
      have : (a + k) % σ.order x < σ.order x,
      { apply nat.mod_lt,
        simp },
      have : a < σ.order y,
      { sorry },
      split_ifs,
      suffices : (σ ^ ((a + k) % σ.order x)) x = (σ ^ a) y,
      { rw this },
      have rw_ak : (↑a + ↑k : ℤ) % (σ.order x) = (↑a + ↑k) - ↑(σ.order x) * ((↑a + ↑k) / (σ.order x))
      := int.mod_def (↑a + ↑k) ↑(sym_fin.order σ x),
      rw ← group.pow_int_coe,
      rw int.coe_nat_mod,
      rw int.coe_nat_add,
      rw rw_ak,
      rw int.sub_eq_add_neg,
      rw int.add_comm,
      rw group.add_int_pow,
      rw ← int.coe_nat_add,
      rw group.pow_int_coe,
      rw group.add_nat_pow,
      simp,
      rw hk₂, }
     }
end

end notes


/-
Copyright (c) 2022 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import measure_theory.function.jacobian

/-!
# Polar coordinates

We define polar coordinates, as a local homeomorphism in `ℝ^2` between `ℝ^2 - (-∞, 0]` and
`(0, +∞) × (-π, π)`. Its inverse is given by `(r, θ) ↦ (r cos θ, r sin θ)`.

It satisfies the following change of variables formula (see `integral_comp_polar_coord_symm`):
`∫ p in polar_coord.target, p.1 • f (polar_coord.symm p) = ∫ p, f p`

-/

noncomputable theory

open real set measure_theory
open_locale real topology

/-- The polar coordinates local homeomorphism in `ℝ^2`, mapping `(r cos θ, r sin θ)` to `(r, θ)`.
It is a homeomorphism between `ℝ^2 - (-∞, 0]` and `(0, +∞) × (-π, π)`. -/
@[simps] def polar_coord : local_homeomorph (ℝ × ℝ) (ℝ × ℝ) :=
{ to_fun := λ q, (real.sqrt (q.1^2 + q.2^2), complex.arg (complex.equiv_real_prod.symm q)),
  inv_fun := λ p, (p.1 * cos p.2, p.1 * sin p.2),
  source := {q | 0 < q.1} ∪ {q | q.2 ≠ 0},
  target := Ioi (0 : ℝ) ×ˢ Ioo (-π) π,
  map_target' :=
  begin
    rintros ⟨r, θ⟩ ⟨hr, hθ⟩,
    dsimp at hr hθ,
    rcases eq_or_ne θ 0 with rfl|h'θ,
    { simpa using hr },
    { right,
      simpa only [ne_of_gt hr, ne.def, mem_set_of_eq, mul_eq_zero, false_or,
        sin_eq_zero_iff_of_lt_of_lt hθ.1 hθ.2] using h'θ }
  end,
  map_source' :=
  begin
    rintros ⟨x, y⟩ hxy,
    simp only [prod_mk_mem_set_prod_eq, mem_Ioi, sqrt_pos, mem_Ioo, complex.neg_pi_lt_arg,
      true_and, complex.arg_lt_pi_iff],
    split,
    { cases hxy,
      { dsimp at hxy, linarith [sq_pos_of_ne_zero _ (hxy.ne'), sq_nonneg y] },
      { linarith [sq_nonneg x, sq_pos_of_ne_zero _ hxy] } },
    { cases hxy,
      { exact or.inl (le_of_lt hxy) },
      { exact or.inr hxy } }
  end,
  right_inv' :=
  begin
    rintros ⟨r, θ⟩ ⟨hr, hθ⟩,
    dsimp at hr hθ,
    simp only [prod.mk.inj_iff],
    split,
    { conv_rhs { rw [← sqrt_sq (le_of_lt hr), ← one_mul (r^2), ← sin_sq_add_cos_sq θ], },
      congr' 1,
      ring_exp },
    { convert complex.arg_mul_cos_add_sin_mul_I hr ⟨hθ.1, hθ.2.le⟩,
      simp only [complex.equiv_real_prod_symm_apply, complex.of_real_mul, complex.of_real_cos,
        complex.of_real_sin],
      ring }
  end,
  left_inv' :=
  begin
    rintros ⟨x, y⟩ hxy,
    have A : sqrt (x ^ 2 + y ^ 2) = complex.abs (x + y * complex.I),
      by simp only [complex.abs_def, complex.norm_sq, pow_two, monoid_with_zero_hom.coe_mk,
        complex.add_re, complex.of_real_re, complex.mul_re, complex.I_re, mul_zero,
        complex.of_real_im, complex.I_im, sub_self, add_zero, complex.add_im,
        complex.mul_im, mul_one, zero_add],
    have Z := complex.abs_mul_cos_add_sin_mul_I (x + y * complex.I),
    simp only [← complex.of_real_cos, ← complex.of_real_sin, mul_add, ← complex.of_real_mul,
      ← mul_assoc] at Z,
    simpa [A, -complex.of_real_cos, -complex.of_real_sin] using complex.ext_iff.1 Z,
  end,
  open_target := is_open_Ioi.prod is_open_Ioo,
  open_source := (is_open_lt continuous_const continuous_fst).union
    (is_open_ne_fun continuous_snd continuous_const),
  continuous_inv_fun := ((continuous_fst.mul (continuous_cos.comp continuous_snd)).prod_mk
    (continuous_fst.mul (continuous_sin.comp continuous_snd))).continuous_on,
  continuous_to_fun :=
  begin
    apply ((continuous_fst.pow 2).add (continuous_snd.pow 2)).sqrt.continuous_on.prod,
    have A : maps_to complex.equiv_real_prod.symm
      ({q : ℝ × ℝ | 0 < q.1} ∪ {q : ℝ × ℝ | q.2 ≠ 0}) {z | 0 < z.re ∨ z.im ≠ 0},
    { rintros ⟨x, y⟩ hxy, simpa only using hxy },
    apply continuous_on.comp (λ z hz, _) _ A,
    { exact (complex.continuous_at_arg hz).continuous_within_at },
    { exact complex.equiv_real_prod_clm.symm.continuous.continuous_on }
  end }

lemma has_fderiv_at_polar_coord_symm (p : ℝ × ℝ) :
  has_fderiv_at polar_coord.symm
    (matrix.to_lin (basis.fin_two_prod ℝ) (basis.fin_two_prod ℝ)
      (!![cos p.2, -p.1 * sin p.2; sin p.2, p.1 * cos p.2])).to_continuous_linear_map p :=
begin
  rw matrix.to_lin_fin_two_prod_to_continuous_linear_map,
  convert has_fderiv_at.prod
    (has_fderiv_at_fst.mul ((has_deriv_at_cos p.2).comp_has_fderiv_at p has_fderiv_at_snd))
    (has_fderiv_at_fst.mul ((has_deriv_at_sin p.2).comp_has_fderiv_at p has_fderiv_at_snd)) using 2;
  simp only [smul_smul, add_comm, neg_mul, neg_smul, smul_neg],
end

lemma polar_coord_source_ae_eq_univ :
  polar_coord.source =ᵐ[volume] univ :=
begin
  have A : polar_coord.sourceᶜ ⊆ (linear_map.snd ℝ ℝ ℝ).ker,
  { assume x hx,
    simp only [polar_coord_source, compl_union, mem_inter_iff, mem_compl_iff, mem_set_of_eq, not_lt,
      not_not] at hx,
    exact hx.2 },
  have B : volume ((linear_map.snd ℝ ℝ ℝ).ker : set (ℝ × ℝ)) = 0,
  { apply measure.add_haar_submodule,
    rw [ne.def, linear_map.ker_eq_top],
    assume h,
    have : (linear_map.snd ℝ ℝ ℝ) (0, 1) = (0 : (ℝ × ℝ →ₗ[ℝ] ℝ)) (0, 1), by rw h,
    simpa using this },
  simp only [ae_eq_univ],
  exact le_antisymm ((measure_mono A).trans (le_of_eq B)) bot_le,
end

theorem integral_comp_polar_coord_symm
  {E : Type*} [normed_add_comm_group E] [normed_space ℝ E] [complete_space E] (f : ℝ × ℝ → E) :
  ∫ p in polar_coord.target, p.1 • f (polar_coord.symm p) = ∫ p, f p :=
begin
  set B : (ℝ × ℝ) → ((ℝ × ℝ) →L[ℝ] (ℝ × ℝ)) := λ p,
    (matrix.to_lin (basis.fin_two_prod ℝ) (basis.fin_two_prod ℝ)
      !![cos p.2, -p.1 * sin p.2; sin p.2, p.1 * cos p.2]).to_continuous_linear_map with hB,
  have A : ∀ p ∈ polar_coord.symm.source, has_fderiv_at polar_coord.symm (B p) p :=
    λ p hp, has_fderiv_at_polar_coord_symm p,
  have B_det : ∀ p, (B p).det = p.1,
  { assume p,
    conv_rhs {rw [← one_mul p.1, ← cos_sq_add_sin_sq p.2] },
    simp only [neg_mul, linear_map.det_to_continuous_linear_map, linear_map.det_to_lin,
      matrix.det_fin_two_of, sub_neg_eq_add],
    ring_exp },
  symmetry,
  calc
  ∫ p, f p
      = ∫ p in polar_coord.source, f p :
  begin
    rw ← integral_univ,
    apply set_integral_congr_set_ae,
    exact polar_coord_source_ae_eq_univ.symm
  end
  ... = ∫ p in polar_coord.target, abs ((B p).det) • f (polar_coord.symm p) :
    by apply integral_target_eq_integral_abs_det_fderiv_smul volume A
  ... = ∫ p in polar_coord.target, p.1 • f (polar_coord.symm p) :
  begin
    apply set_integral_congr (polar_coord.open_target.measurable_set) (λ x hx, _),
    rw [B_det, abs_of_pos],
    exact hx.1,
  end
end


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.

Authors: Leonardo de Moura
-/
prelude
import init.relation

structure setoid [class] (A : Type) :=
(r : A → A → Prop) (iseqv : equivalence r)

namespace setoid
  infix ` ≈ ` := setoid.r

  variable {A : Type}
  variable [s : setoid A]
  include s

  theorem refl [refl] (a : A) : a ≈ a :=
  and.elim_left (@setoid.iseqv A s) a

  theorem symm [symm] {a b : A} : a ≈ b → b ≈ a :=
  λ H, and.elim_left (and.elim_right (@setoid.iseqv A s)) a b H

  theorem trans [trans] {a b c : A} : a ≈ b → b ≈ c → a ≈ c :=
  λ H₁ H₂, and.elim_right (and.elim_right (@setoid.iseqv A s)) a b c H₁ H₂
end setoid


/-
Copyright (c) 2022 Henrik Böving. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henrik Böving
-/
namespace Cpdt
namespace Chapter7

variable {α : Type} [LE α] [DecidableRel (@LE.le α _)]

def insert (x : α) : List α → List α
  | [] => [x]
  | y :: ys => if x ≤ y then x :: y :: ys else y :: (insert x ys)

def merge (l1 l2 : List α) : List α :=
  match l1 with
  | [] => l2
  | x :: xs => insert x (merge xs l2)

def split : List α → List α × List α
  | [] => ([], [])
  | [x] => ([x], [])
  | x :: y :: zs =>
    let (l1, l2) := split zs
    (x :: l1, y :: l2)

theorem split_wf_match (x y : α) (zs : List α) :
    let spl := split (x :: y :: zs);
    spl.fst.length < zs.length + 2 ∧ spl.snd.length < zs.length + 2 :=
    match zs with
    | [] => by simp[split]
    | [a] => by simp[split]
    | a :: b :: cs => by
      have helper := split_wf_match a b cs
      simp_all_arith[split]
      constructor
      apply Nat.le_trans helper.left
      simp_arith
      apply Nat.le_trans helper.right
      simp_arith

def mergeSort : List α → List α
  | [] => []
  | [x] => [x]
  | ls@(x :: y :: zs) =>
    let lss := split ls
    have h1 : List.length (split ls).fst < Nat.succ (Nat.succ (List.length zs)) := by
      have helper := (split_wf_match x y zs).left
      simp_all
    have h2 : List.length (split ls).snd < Nat.succ (Nat.succ (List.length zs)) := by
      have helper := (split_wf_match x y zs).right
      simp_all
    merge (mergeSort lss.fst) (mergeSort lss.snd)
  termination_by mergeSort ls => ls.length

end Chapter7
end Cpdt


import .affine_frame
import .affine_space_type

/-
def std_frame : affine_frame (aff_pt_coord_tuple K n) K (aff_vec_coord_tuple K n) (fin n) :=
    ⟨pt_zero K n, std_basis K n, std_is_basis K n⟩
-/

/-
inductive affine_frame --need proof that "standard" is THE standard basis?
| standard (origin : X) (vec : ι → V) (basis : is_basis K vec ) : affine_frame
| derived (origin : X) (vec : ι → V) (basis :  is_basis K vec ) : affine_frame → affine_frame
-/

namespace aff_fr

/-
(1) Can we equip the bare affine space with a standard frame
(2) Then view a new frame as an isomorphism between spaces

Assume you're given "standard" real affine 3-space. And suppose
that conceptually you want a new coordinatizion of that space.
So you define a new origin point, P, and new vectors, V_i, in
that standard space. And from the P and the V_i you now create
a new frame, but you do by creating a new *coordinate* space,
and one that by construction comes with an isomorphic mapping
to the original standard space.
-/
universes u v w
variables (X : Type u) (K : Type v) (V : Type w) (ι : Type*)
[ring K] [add_comm_group V] [module K V]

variables (s : finset ι) (g : ι → K) (v : ι → V) [is_basis K v] [affine_space V X]

@[ext]
structure vec_with_frame (frame : affine_frame X K V ι) :=
(vec : V)

@[ext]
structure pt_with_frame (frame : affine_frame X K V ι) :=
(pt : X)

/-
aff space 1 : (aff_vec real 3) real ( aff_pt real 3)
std : (affine frame  (aff_vec real 3) real ( aff_pt real 3) (fin 3)) := std_frame aff space 1
der_fr1 : (pt with frame (affine frame  (aff_vec real 3) real ( aff_pt real 3) (fin 3))
                )
                real
          (vec with frame (affine frame  (aff_vec real 3) real ( aff_pt real 3) (fin 3)))( fin 3)
der_fr1 : (pt with frame (der_f1)) real (vec with frame der_fr1)( fin 3)

def my_pt : pt frame_n := ⟨⟨⟨⟨⟩⟩⟩⟩

aff space 2 : (pt with frame std) real (vec with frame std)
std2 : std_frame aff space 2

-/

variables (basis : affine_frame X K V ι) (pt : X)

def vecf_add : vec_with_frame X K V ι basis → vec_with_frame X K V ι basis → vec_with_frame X K V ι basis :=
λ x y, ⟨x.1 + y.1⟩

def vecf_neg : vec_with_frame X K V ι basis → vec_with_frame X K V ι basis :=
λ x, ⟨-x.1⟩

def vecf_scalar : K → vec_with_frame X K V ι basis → vec_with_frame X K V ι basis :=
λ c x, ⟨c • x.1⟩

instance : has_add (vec_with_frame X K V ι basis) := ⟨vecf_add X K V ι basis⟩

instance : has_neg (vec_with_frame X K V ι basis) := ⟨vecf_neg X K V ι basis⟩

instance vec_has_zero : has_zero V := by refine add_monoid.to_has_zero V

def vecf_zero : vec_with_frame X K V ι basis := ⟨(aff_fr.vec_has_zero V).zero⟩

instance : has_zero (vec_with_frame X K V ι basis) := ⟨vecf_zero X K V ι basis⟩

instance : has_scalar K (vec_with_frame X K V ι basis) := ⟨vecf_scalar X K V ι basis⟩

#print add_comm_group

lemma vadd_assoc : ∀ x y z : vec_with_frame X K V ι basis, x + y + z = x + (y + z) :=
begin
intros,
cases x, cases y, cases z,
ext,
exact add_assoc x y z,
end

lemma vzero_add : ∀ x : vec_with_frame X K V ι basis, 0 + x = x :=
begin
intros,
cases x,
ext,
exact zero_add x,
end

lemma vadd_zero : ∀ x : vec_with_frame X K V ι basis, x + 0 = x :=
begin
intros,
cases x,
ext,
exact add_zero x,
end

lemma vadd_left_neg : ∀ x : vec_with_frame X K V ι basis, -x + x = 0 :=
begin
intros,
cases x,
ext,
exact add_left_neg x,
end

lemma vadd_comm : ∀ x y : vec_with_frame X K V ι basis, x + y = y + x :=
begin
intros,
cases x, cases y,
ext,
exact add_comm x y,
end

instance : add_comm_group (vec_with_frame X K V ι basis) :=
⟨
  vecf_add X K V ι basis,
  vadd_assoc X K V ι basis,
  vecf_zero X K V ι basis,
  vzero_add X K V ι basis,
  vadd_zero X K V ι basis,
  vecf_neg X K V ι basis,
  vadd_left_neg X K V ι basis,
  vadd_comm X K V ι basis
⟩

#print vector_space
#print semimodule

instance : module K (vec_with_frame X K V ι basis) := sorry

instance : affine_space (vec_with_frame X K V ι basis) (pt_with_frame X K V ι basis) := sorry

def framed_affine_coord_space_type
        (k : Type v) (n : ℕ) [ring k] [inhabited k] [module k V]
          (fr : affine_frame X k V (fin n))
          :=
    affine_space_type
        (pt_with_frame X k V (fin n) fr)
        k
        (vec_with_frame X k V (fin n) fr)

-- do the same thing here we did before
--create a framed affine coordinate space, get a standard frame on it
--rewrite charlie's std frame
-- create a point, create a vector in that framed space
end aff_fr


structure S where
  x : Bool
  y : Nat

def S.Z (s : S) : Type :=
  if s.x then Nat else Int

def S.z : (s : S) → s.Z
  | s@{ x := true, .. } => s.y
  | s@{ x := false, .. } => Int.ofNat s.y

def S.a : (s : S) → s.Z
  | s => s.z

def S.b : (s : S) → s.Z
  | s@h:{ x := true, .. } => h ▸ s.z
  | s => s.z

#check @S.b.match_1

theorem zeropow : ∀ {m : Nat}, m > 0 → 0 ^ m = 0
  | 0,   h => by cases h
  | _+1, _ => rfl

theorem pow_nonneg : ∀ m : Nat, 0 ^ m ≥ 0
  | 0 => by decide
  | m@(_+1) => by
    rw [zeropow]
    . decide
    . apply Nat.zero_lt_succ


/-
Copyright (c) 2020 Alexander Bentkamp. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alexander Bentkamp
-/

import field_theory.algebraic_closure
import linear_algebra.finsupp
import linear_algebra.matrix
import order.preorder_hom

/-!
# Eigenvectors and eigenvalues

This file defines eigenspaces, eigenvalues, and eigenvalues, as well as their generalized
counterparts. We follow Axler's approach [axler2015] because it allows us to derive many properties
without choosing a basis and without using matrices.

An eigenspace of a linear map `f` for a scalar `μ` is the kernel of the map `(f - μ • id)`. The
nonzero elements of an eigenspace are eigenvectors `x`. They have the property `f x = μ • x`. If
there are eigenvectors for a scalar `μ`, the scalar `μ` is called an eigenvalue.

There is no consensus in the literature whether `0` is an eigenvector. Our definition of
`has_eigenvector` permits only nonzero vectors. For an eigenvector `x` that may also be `0`, we
write `x ∈ f.eigenspace μ`.

A generalized eigenspace of a linear map `f` for a natural number `k` and a scalar `μ` is the kernel
of the map `(f - μ • id) ^ k`. The nonzero elements of a generalized eigenspace are generalized
eigenvectors `x`. If there are generalized eigenvectors for a natural number `k` and a scalar `μ`,
the scalar `μ` is called a generalized eigenvalue.

## References

* [Sheldon Axler, *Linear Algebra Done Right*][axler2015]
* https://en.wikipedia.org/wiki/Eigenvalues_and_eigenvectors

## Tags

eigenspace, eigenvector, eigenvalue, eigen
-/

universes u v w

namespace module
namespace End

open module principal_ideal_ring polynomial finite_dimensional

variables {K R : Type v} {V M : Type w}
  [comm_ring R] [add_comm_group M] [module R M] [field K] [add_comm_group V] [module K V]

/-- The submodule `eigenspace f μ` for a linear map `f` and a scalar `μ` consists of all vectors `x`
    such that `f x = μ • x`. (Def 5.36 of [axler2015])-/
def eigenspace (f : End R M) (μ : R) : submodule R M :=
(f - algebra_map R (End R M) μ).ker

/-- A nonzero element of an eigenspace is an eigenvector. (Def 5.7 of [axler2015]) -/
def has_eigenvector (f : End R M) (μ : R) (x : M) : Prop :=
x ∈ eigenspace f μ ∧ x ≠ 0

/-- A scalar `μ` is an eigenvalue for a linear map `f` if there are nonzero vectors `x`
    such that `f x = μ • x`. (Def 5.5 of [axler2015]) -/
def has_eigenvalue (f : End R M) (a : R) : Prop :=
eigenspace f a ≠ ⊥

lemma has_eigenvalue_of_has_eigenvector {f : End R M} {μ : R} {x : M} (h : has_eigenvector f μ x) :
  has_eigenvalue f μ :=
begin
  rw [has_eigenvalue, submodule.ne_bot_iff],
  use x, exact h,
end

lemma mem_eigenspace_iff {f : End R M} {μ : R} {x : M} : x ∈ eigenspace f μ ↔ f x = μ • x :=
by rw [eigenspace, linear_map.mem_ker, linear_map.sub_apply, algebra_map_End_apply,
  sub_eq_zero]

lemma eigenspace_div (f : End K V) (a b : K) (hb : b ≠ 0) :
  eigenspace f (a / b) = (b • f - algebra_map K (End K V) a).ker :=
calc
  eigenspace f (a / b) = eigenspace f (b⁻¹ * a) : by { rw [div_eq_mul_inv, mul_comm] }
  ... = (f - (b⁻¹ * a) • linear_map.id).ker : rfl
  ... = (f - b⁻¹ • a • linear_map.id).ker : by rw smul_smul
  ... = (f - b⁻¹ • algebra_map K (End K V) a).ker : rfl
  ... = (b • (f - b⁻¹ • algebra_map K (End K V) a)).ker : by rw linear_map.ker_smul _ b hb
  ... = (b • f - algebra_map K (End K V) a).ker : by rw [smul_sub, smul_inv_smul' hb]

lemma eigenspace_aeval_polynomial_degree_1
  (f : End K V) (q : polynomial K) (hq : degree q = 1) :
  eigenspace f (- q.coeff 0 / q.leading_coeff) = (aeval f q).ker :=
calc
  eigenspace f (- q.coeff 0 / q.leading_coeff)
      = (q.leading_coeff • f - algebra_map K (End K V) (- q.coeff 0)).ker
    : by { rw eigenspace_div, intro h, rw leading_coeff_eq_zero_iff_deg_eq_bot.1 h at hq, cases hq }
  ... = (aeval f (C q.leading_coeff * X + C (q.coeff 0))).ker
    : by { rw [C_mul', aeval_def], simpa [algebra_map, algebra.to_ring_hom], }
  ... = (aeval f q).ker
     : by { congr, apply (eq_X_add_C_of_degree_eq_one hq).symm }

lemma ker_aeval_ring_hom'_unit_polynomial
  (f : End K V) (c : units (polynomial K)) :
  (aeval f (c : polynomial K)).ker = ⊥ :=
begin
  rw polynomial.eq_C_of_degree_eq_zero (degree_coe_units c),
  simp only [aeval_def, eval₂_C],
  apply ker_algebra_map_End,
  apply coeff_coe_units_zero_ne_zero c
end

theorem aeval_apply_of_has_eigenvector {f : End K V}
  {p : polynomial K} {μ : K} {x : V} (h : f.has_eigenvector μ x) :
  aeval f p x = (p.eval μ) • x :=
begin
  apply p.induction_on,
  { intro a, simp [module.algebra_map_End_apply] },
  { intros p q hp hq, simp [hp, hq, add_smul] },
  { intros n a hna,
    rw [mul_comm, pow_succ, mul_assoc, alg_hom.map_mul, linear_map.mul_apply, mul_comm, hna],
    simp [algebra_map_End_apply, mem_eigenspace_iff.1 h.1, smul_smul, mul_comm] }
end

section minpoly

theorem is_root_of_has_eigenvalue {f : End K V} {μ : K} (h : f.has_eigenvalue μ) :
  (minpoly K f).is_root μ :=
begin
  rcases (submodule.ne_bot_iff _).1 h with ⟨w, ⟨H, ne0⟩⟩,
  refine or.resolve_right (smul_eq_zero.1 _) ne0,
  simp [← aeval_apply_of_has_eigenvector ⟨H, ne0⟩, minpoly.aeval K f],
end

variables [finite_dimensional K V] (f : End K V)

protected theorem is_integral : is_integral K f :=
is_integral_of_noetherian (by apply_instance) f

variables {f} {μ : K}

theorem has_eigenvalue_of_is_root (h : (minpoly K f).is_root μ) :
  f.has_eigenvalue μ :=
begin
  cases dvd_iff_is_root.2 h with p hp,
  rw [has_eigenvalue, eigenspace],
  intro con,
  cases (linear_map.is_unit_iff _).2 con with u hu,
  have p_ne_0 : p ≠ 0,
  { intro con,
    apply minpoly.ne_zero f.is_integral,
    rw [hp, con, mul_zero] },
  have h_deg := minpoly.degree_le_of_ne_zero K f p_ne_0 _,
  { rw [hp, degree_mul, degree_X_sub_C, polynomial.degree_eq_nat_degree p_ne_0] at h_deg,
    norm_cast at h_deg,
    linarith, },
  { have h_aeval := minpoly.aeval K f,
    revert h_aeval,
    simp [hp, ← hu] },
end

theorem has_eigenvalue_iff_is_root :
  f.has_eigenvalue μ ↔ (minpoly K f).is_root μ :=
⟨is_root_of_has_eigenvalue, has_eigenvalue_of_is_root⟩

end minpoly

/-- Every linear operator on a vector space over an algebraically closed field has
    an eigenvalue. -/
-- This is Lemma 5.21 of [axler2015], although we are no longer following that proof.
lemma exists_eigenvalue [is_alg_closed K] [finite_dimensional K V] [nontrivial V] (f : End K V) :
  ∃ (c : K), f.has_eigenvalue c :=
begin
  obtain ⟨c, nu⟩ := exists_spectrum_of_is_alg_closed_of_finite_dimensional K f,
  use c,
  rw linear_map.is_unit_iff at nu,
  exact has_eigenvalue_of_has_eigenvector (exists_mem_ne_zero_of_ne_bot nu).some_spec,
end

/-- Eigenvectors corresponding to distinct eigenvalues of a linear operator are linearly
    independent. (Lemma 5.10 of [axler2015])

    We use the eigenvalues as indexing set to ensure that there is only one eigenvector for each
    eigenvalue in the image of `xs`. -/
lemma eigenvectors_linear_independent (f : End K V) (μs : set K) (xs : μs → V)
  (h_eigenvec : ∀ μ : μs, f.has_eigenvector μ (xs μ)) :
  linear_independent K xs :=
begin
  classical,
  -- We need to show that if a linear combination `l` of the eigenvectors `xs` is `0`, then all
  -- its coefficients are zero.
  suffices : ∀ l, finsupp.total μs V K xs l = 0 → l = 0,
  { rw linear_independent_iff,
    apply this },
  intros l hl,
  -- We apply induction on the finite set of eigenvalues whose eigenvectors have nonzero
  -- coefficients, i.e. on the support of `l`.
  induction h_l_support : l.support using finset.induction with μ₀ l_support' hμ₀ ih generalizing l,
  -- If the support is empty, all coefficients are zero and we are done.
  { exact finsupp.support_eq_empty.1 h_l_support },
  -- Now assume that the support of `l` contains at least one eigenvalue `μ₀`. We define a new
  -- linear combination `l'` to apply the induction hypothesis on later. The linear combination `l'`
  -- is derived from `l` by multiplying the coefficient of the eigenvector with eigenvalue `μ`
  -- by `μ - μ₀`.
  -- To get started, we define `l'` as a function `l'_f : μs → K` with potentially infinite support.
  { let l'_f : μs → K := (λ μ : μs, (↑μ - ↑μ₀) * l μ),
    -- The support of `l'_f` is the support of `l` without `μ₀`.
    have h_l_support' : ∀ (μ : μs), μ ∈ l_support' ↔ l'_f μ ≠ 0 ,
    { intro μ,
      suffices : μ ∈ l_support' → μ ≠ μ₀,
      { simp [l'_f, ← finsupp.not_mem_support_iff, h_l_support, sub_eq_zero, ←subtype.ext_iff],
        tauto },
      rintro hμ rfl,
      contradiction },
    -- Now we can define `l'_f` as an actual linear combination `l'` because we know that the
    -- support is finite.
    let l' : μs →₀ K :=
      { to_fun := l'_f, support := l_support', mem_support_to_fun := h_l_support' },
    -- The linear combination `l'` over `xs` adds up to `0`.
    have total_l' : finsupp.total μs V K xs l' = 0,
    { let g := f - algebra_map K (End K V) μ₀,
      have h_gμ₀: g (l μ₀ • xs μ₀) = 0,
        by rw [linear_map.map_smul, linear_map.sub_apply, mem_eigenspace_iff.1 (h_eigenvec _).1,
          algebra_map_End_apply, sub_self, smul_zero],
      have h_useless_filter : finset.filter (λ (a : μs), l'_f a ≠ 0) l_support' = l_support',
      { rw finset.filter_congr _,
        { apply finset.filter_true },
        { apply_instance },
        exact λ μ hμ, (iff_true _).mpr ((h_l_support' μ).1 hμ) },
      have bodies_eq : ∀ (μ : μs), l'_f μ • xs μ = g (l μ • xs μ),
      { intro μ,
        dsimp only [g, l'_f],
        rw [linear_map.map_smul, linear_map.sub_apply, mem_eigenspace_iff.1 (h_eigenvec _).1,
          algebra_map_End_apply, ←sub_smul, smul_smul, mul_comm] },
      rw [←linear_map.map_zero g, ←hl, finsupp.total_apply, finsupp.total_apply,
          finsupp.sum, finsupp.sum, linear_map.map_sum, h_l_support,
          finset.sum_insert hμ₀, h_gμ₀, zero_add],
      refine finset.sum_congr rfl (λ μ _, _),
      apply bodies_eq },
    -- Therefore, by the induction hypothesis, all coefficients in `l'` are zero.
    have l'_eq_0 : l' = 0 := ih l' total_l' rfl,
    -- By the defintion of `l'`, this means that `(μ - μ₀) * l μ = 0` for all `μ`.
    have h_mul_eq_0 : ∀ μ : μs, (↑μ - ↑μ₀) * l μ = 0,
    { intro μ,
      calc (↑μ - ↑μ₀) * l μ = l' μ : rfl
      ... = 0 : by { rw [l'_eq_0], refl } },
    -- Thus, the coefficients in `l` for all `μ ≠ μ₀` are `0`.
    have h_lμ_eq_0 : ∀ μ : μs, μ ≠ μ₀ → l μ = 0,
    { intros μ hμ,
      apply or_iff_not_imp_left.1 (mul_eq_zero.1 (h_mul_eq_0 μ)),
      rwa [sub_eq_zero, ←subtype.ext_iff] },
    -- So if we sum over all these coefficients, we obtain `0`.
    have h_sum_l_support'_eq_0 : finset.sum l_support' (λ (μ : ↥μs), l μ • xs μ) = 0,
    { rw ←finset.sum_const_zero,
      apply finset.sum_congr rfl,
      intros μ hμ,
      rw h_lμ_eq_0,
      apply zero_smul,
      intro h,
      rw h at hμ,
      contradiction },
    -- The only potentially nonzero coefficient in `l` is the one corresponding to `μ₀`. But since
    -- the overall sum is `0` by assumption, this coefficient must also be `0`.
    have : l μ₀ = 0,
    { rw [finsupp.total_apply, finsupp.sum, h_l_support,
          finset.sum_insert hμ₀, h_sum_l_support'_eq_0, add_zero] at hl,
      by_contra h,
      exact (h_eigenvec μ₀).2 ((smul_eq_zero.1 hl).resolve_left h) },
    -- Thus, all coefficients in `l` are `0`.
    show l = 0,
    { ext μ,
      by_cases h_cases : μ = μ₀,
      { rw h_cases,
        assumption },
      exact h_lμ_eq_0 μ h_cases } }
end

/-- The generalized eigenspace for a linear map `f`, a scalar `μ`, and an exponent `k ∈ ℕ` is the
kernel of `(f - μ • id) ^ k`. (Def 8.10 of [axler2015]). Furthermore, a generalized eigenspace for
some exponent `k` is contained in the generalized eigenspace for exponents larger than `k`. -/
def generalized_eigenspace (f : End R M) (μ : R) : ℕ →ₘ submodule R M :=
{ to_fun    := λ k, ((f - algebra_map R (End R M) μ) ^ k).ker,
  monotone' := λ k m hm,
  begin
    simp only [← pow_sub_mul_pow _ hm],
    exact linear_map.ker_le_ker_comp
      ((f - algebra_map R (End R M) μ) ^ k) ((f - algebra_map R (End R M) μ) ^ (m - k)),
  end }

@[simp] lemma mem_generalized_eigenspace (f : End R M) (μ : R) (k : ℕ) (m : M) :
  m ∈ f.generalized_eigenspace μ k ↔ ((f - μ • 1)^k) m = 0 :=
iff.rfl

/-- A nonzero element of a generalized eigenspace is a generalized eigenvector.
    (Def 8.9 of [axler2015])-/
def has_generalized_eigenvector (f : End R M) (μ : R) (k : ℕ) (x : M) : Prop :=
x ≠ 0 ∧ x ∈ generalized_eigenspace f μ k

/-- A scalar `μ` is a generalized eigenvalue for a linear map `f` and an exponent `k ∈ ℕ` if there
    are generalized eigenvectors for `f`, `k`, and `μ`. -/
def has_generalized_eigenvalue (f : End R M) (μ : R) (k : ℕ) : Prop :=
generalized_eigenspace f μ k ≠ ⊥

/-- The generalized eigenrange for a linear map `f`, a scalar `μ`, and an exponent `k ∈ ℕ` is the
    range of `(f - μ • id) ^ k`. -/
def generalized_eigenrange (f : End R M) (μ : R) (k : ℕ) : submodule R M :=
((f - algebra_map R (End R M) μ) ^ k).range

/-- The exponent of a generalized eigenvalue is never 0. -/
lemma exp_ne_zero_of_has_generalized_eigenvalue {f : End R M} {μ : R} {k : ℕ}
  (h : f.has_generalized_eigenvalue μ k) : k ≠ 0 :=
begin
  rintro rfl,
  exact h linear_map.ker_id
end

/-- The union of the kernels of `(f - μ • id) ^ k` over all `k`. -/
def maximal_generalized_eigenspace (f : End R M) (μ : R) : submodule R M :=
⨆ k, f.generalized_eigenspace μ k

lemma generalized_eigenspace_le_maximal (f : End R M) (μ : R) (k : ℕ) :
  f.generalized_eigenspace μ k ≤ f.maximal_generalized_eigenspace μ :=
le_supr _ _

@[simp] lemma mem_maximal_generalized_eigenspace (f : End R M) (μ : R) (m : M) :
  m ∈ f.maximal_generalized_eigenspace μ ↔ ∃ (k : ℕ), ((f - μ • 1)^k) m = 0 :=
by simp only [maximal_generalized_eigenspace, ← mem_generalized_eigenspace,
  submodule.mem_supr_of_chain]

/-- If there exists a natural number `k` such that the kernel of `(f - μ • id) ^ k` is the
maximal generalized eigenspace, then this value is the least such `k`. If not, this value is not
meaningful. -/
noncomputable def maximal_generalized_eigenspace_index (f : End R M) (μ : R) :=
monotonic_sequence_limit_index (f.generalized_eigenspace μ)

/-- For an endomorphism of a Noetherian module, the maximal eigenspace is always of the form kernel
`(f - μ • id) ^ k` for some `k`. -/
lemma maximal_generalized_eigenspace_eq [h : is_noetherian R M] (f : End R M) (μ : R) :
  maximal_generalized_eigenspace f μ =
  f.generalized_eigenspace μ (maximal_generalized_eigenspace_index f μ) :=
begin
  rw is_noetherian_iff_well_founded at h,
  exact (well_founded.supr_eq_monotonic_sequence_limit h (f.generalized_eigenspace μ) : _),
end

/-- A generalized eigenvalue for some exponent `k` is also
    a generalized eigenvalue for exponents larger than `k`. -/
lemma has_generalized_eigenvalue_of_has_generalized_eigenvalue_of_le
  {f : End R M} {μ : R} {k : ℕ} {m : ℕ} (hm : k ≤ m) (hk : f.has_generalized_eigenvalue μ k) :
  f.has_generalized_eigenvalue μ m :=
begin
  unfold has_generalized_eigenvalue at *,
  contrapose! hk,
  rw [←le_bot_iff, ←hk],
  exact (f.generalized_eigenspace μ).monotone hm,
end

/-- The eigenspace is a subspace of the generalized eigenspace. -/
lemma eigenspace_le_generalized_eigenspace {f : End R M} {μ : R} {k : ℕ} (hk : 0 < k) :
  f.eigenspace μ ≤ f.generalized_eigenspace μ k :=
(f.generalized_eigenspace μ).monotone (nat.succ_le_of_lt hk)

/-- All eigenvalues are generalized eigenvalues. -/
lemma has_generalized_eigenvalue_of_has_eigenvalue
  {f : End R M} {μ : R} {k : ℕ} (hk : 0 < k) (hμ : f.has_eigenvalue μ) :
  f.has_generalized_eigenvalue μ k :=
begin
  apply has_generalized_eigenvalue_of_has_generalized_eigenvalue_of_le hk,
  rw [has_generalized_eigenvalue, generalized_eigenspace, preorder_hom.coe_fun_mk, pow_one],
  exact hμ,
end

/-- All generalized eigenvalues are eigenvalues. -/
lemma has_eigenvalue_of_has_generalized_eigenvalue
  {f : End R M} {μ : R} {k : ℕ} (hμ : f.has_generalized_eigenvalue μ k) :
  f.has_eigenvalue μ :=
begin
  intros contra, apply hμ,
  erw linear_map.ker_eq_bot at ⊢ contra, rw linear_map.coe_pow,
  exact function.injective.iterate contra k,
end

/-- Generalized eigenvalues are actually just eigenvalues. -/
@[simp] lemma has_generalized_eigenvalue_iff_has_eigenvalue
  {f : End R M} {μ : R} {k : ℕ} (hk : 0 < k) :
  f.has_generalized_eigenvalue μ k ↔ f.has_eigenvalue μ :=
⟨has_eigenvalue_of_has_generalized_eigenvalue, has_generalized_eigenvalue_of_has_eigenvalue hk⟩

/-- Every generalized eigenvector is a generalized eigenvector for exponent `finrank K V`.
    (Lemma 8.11 of [axler2015]) -/
lemma generalized_eigenspace_le_generalized_eigenspace_finrank
  [finite_dimensional K V] (f : End K V) (μ : K) (k : ℕ) :
  f.generalized_eigenspace μ k ≤ f.generalized_eigenspace μ (finrank K V) :=
ker_pow_le_ker_pow_finrank _ _

/-- Generalized eigenspaces for exponents at least `finrank K V` are equal to each other. -/
lemma generalized_eigenspace_eq_generalized_eigenspace_finrank_of_le [finite_dimensional K V]
  (f : End K V) (μ : K) {k : ℕ} (hk : finrank K V ≤ k) :
  f.generalized_eigenspace μ k = f.generalized_eigenspace μ (finrank K V) :=
ker_pow_eq_ker_pow_finrank_of_le hk

/-- If `f` maps a subspace `p` into itself, then the generalized eigenspace of the restriction
    of `f` to `p` is the part of the generalized eigenspace of `f` that lies in `p`. -/
lemma generalized_eigenspace_restrict
  (f : End R M) (p : submodule R M) (k : ℕ) (μ : R) (hfp : ∀ (x : M), x ∈ p → f x ∈ p) :
  generalized_eigenspace (linear_map.restrict f hfp) μ k =
    submodule.comap p.subtype (f.generalized_eigenspace μ k) :=
begin
  simp only [generalized_eigenspace, preorder_hom.coe_fun_mk, ← linear_map.ker_comp],
  induction k with k ih,
  { rw [pow_zero, pow_zero, linear_map.one_eq_id],
    apply (submodule.ker_subtype _).symm },
  { erw [pow_succ', pow_succ', linear_map.ker_comp,
      ih, ←linear_map.ker_comp, linear_map.comp_assoc], }
end

/-- Generalized eigenrange and generalized eigenspace for exponent `finrank K V` are disjoint. -/
lemma generalized_eigenvec_disjoint_range_ker [finite_dimensional K V] (f : End K V) (μ : K) :
  disjoint (f.generalized_eigenrange μ (finrank K V)) (f.generalized_eigenspace μ (finrank K V))  :=
begin
  have h := calc
    submodule.comap ((f - algebra_map _ _ μ) ^ finrank K V)
        (f.generalized_eigenspace μ (finrank K V))
      = ((f - algebra_map _ _ μ) ^ finrank K V *
          (f - algebra_map K (End K V) μ) ^ finrank K V).ker :
        by { simpa only [generalized_eigenspace, preorder_hom.coe_fun_mk, ← linear_map.ker_comp] }
  ... = f.generalized_eigenspace μ (finrank K V + finrank K V) :
        by { rw ←pow_add, refl }
  ... = f.generalized_eigenspace μ (finrank K V) :
        by { rw generalized_eigenspace_eq_generalized_eigenspace_finrank_of_le, linarith },
  rw [disjoint, generalized_eigenrange, linear_map.range_eq_map, submodule.map_inf_eq_map_inf_comap,
    top_inf_eq, h],
  apply submodule.map_comap_le
end

/-- The generalized eigenspace of an eigenvalue has positive dimension for positive exponents. -/
lemma pos_finrank_generalized_eigenspace_of_has_eigenvalue [finite_dimensional K V]
  {f : End K V} {k : ℕ} {μ : K} (hx : f.has_eigenvalue μ) (hk : 0 < k):
  0 < finrank K (f.generalized_eigenspace μ k) :=
calc
    0 = finrank K (⊥ : submodule K V) : by rw finrank_bot
  ... < finrank K (f.eigenspace μ) : submodule.finrank_lt_finrank_of_lt (bot_lt_iff_ne_bot.2 hx)
  ... ≤ finrank K (f.generalized_eigenspace μ k) :
    submodule.finrank_mono ((f.generalized_eigenspace μ).monotone (nat.succ_le_of_lt hk))

/-- A linear map maps a generalized eigenrange into itself. -/
lemma map_generalized_eigenrange_le {f : End K V} {μ : K} {n : ℕ} :
  submodule.map f (f.generalized_eigenrange μ n) ≤ f.generalized_eigenrange μ n :=
calc submodule.map f (f.generalized_eigenrange μ n)
       = (f * ((f - algebra_map _ _ μ) ^ n)).range : (linear_map.range_comp _ _).symm
   ... = (((f - algebra_map _ _ μ) ^ n) * f).range : by rw algebra.mul_sub_algebra_map_pow_commutes
   ... = submodule.map ((f - algebra_map _ _ μ) ^ n) f.range : linear_map.range_comp _ _
   ... ≤ f.generalized_eigenrange μ n : linear_map.map_le_range

/-- The generalized eigenvectors span the entire vector space (Lemma 8.21 of [axler2015]). -/
lemma supr_generalized_eigenspace_eq_top [is_alg_closed K] [finite_dimensional K V] (f : End K V) :
  (⨆ (μ : K) (k : ℕ), f.generalized_eigenspace μ k) = ⊤ :=
begin
  tactic.unfreeze_local_instances,
  -- We prove the claim by strong induction on the dimension of the vector space.
  induction h_dim : finrank K V using nat.strong_induction_on with n ih generalizing V,
  cases n,
  -- If the vector space is 0-dimensional, the result is trivial.
  { rw ←top_le_iff,
    simp only [finrank_eq_zero.1 (eq.trans finrank_top h_dim), bot_le] },
  -- Otherwise the vector space is nontrivial.
  { haveI : nontrivial V := finrank_pos_iff.1 (by { rw h_dim, apply nat.zero_lt_succ }),
    -- Hence, `f` has an eigenvalue `μ₀`.
    obtain ⟨μ₀, hμ₀⟩ : ∃ μ₀, f.has_eigenvalue μ₀ := exists_eigenvalue f,
    -- We define `ES` to be the generalized eigenspace
    let ES := f.generalized_eigenspace μ₀ (finrank K V),
    -- and `ER` to be the generalized eigenrange.
    let ER := f.generalized_eigenrange μ₀ (finrank K V),
    -- `f` maps `ER` into itself.
    have h_f_ER : ∀ (x : V), x ∈ ER → f x ∈ ER,
      from λ x hx, map_generalized_eigenrange_le (submodule.mem_map_of_mem hx),
    -- Therefore, we can define the restriction `f'` of `f` to `ER`.
    let f' : End K ER := f.restrict h_f_ER,
    -- The dimension of `ES` is positive
    have h_dim_ES_pos : 0 < finrank K ES,
    { dsimp only [ES],
      rw h_dim,
      apply pos_finrank_generalized_eigenspace_of_has_eigenvalue hμ₀ (nat.zero_lt_succ n) },
    -- and the dimensions of `ES` and `ER` add up to `finrank K V`.
    have h_dim_add : finrank K ER + finrank K ES = finrank K V,
    { apply linear_map.finrank_range_add_finrank_ker },
    -- Therefore the dimension `ER` mus be smaller than `finrank K V`.
    have h_dim_ER : finrank K ER < n.succ, by linarith,
    -- This allows us to apply the induction hypothesis on `ER`:
    have ih_ER : (⨆ (μ : K) (k : ℕ), f'.generalized_eigenspace μ k) = ⊤,
      from ih (finrank K ER) h_dim_ER f' rfl,
    -- The induction hypothesis gives us a statement about subspaces of `ER`. We can transfer this
    -- to a statement about subspaces of `V` via `submodule.subtype`:
    have ih_ER' : (⨆ (μ : K) (k : ℕ), (f'.generalized_eigenspace μ k).map ER.subtype) = ER,
      by simp only [(submodule.map_supr _ _).symm, ih_ER, submodule.map_subtype_top ER],
    -- Moreover, every generalized eigenspace of `f'` is contained in the corresponding generalized
    -- eigenspace of `f`.
    have hff' : ∀ μ k,
        (f'.generalized_eigenspace μ k).map ER.subtype ≤ f.generalized_eigenspace μ k,
    { intros,
      rw generalized_eigenspace_restrict,
      apply submodule.map_comap_le },
    -- It follows that `ER` is contained in the span of all generalized eigenvectors.
    have hER : ER ≤ ⨆ (μ : K) (k : ℕ), f.generalized_eigenspace μ k,
    { rw ← ih_ER',
      apply supr_le_supr _,
      exact λ μ, supr_le_supr (λ k, hff' μ k), },
    -- `ES` is contained in this span by definition.
    have hES : ES ≤ ⨆ (μ : K) (k : ℕ), f.generalized_eigenspace μ k,
      from le_trans
        (le_supr (λ k, f.generalized_eigenspace μ₀ k) (finrank K V))
        (le_supr (λ (μ : K), ⨆ (k : ℕ), f.generalized_eigenspace μ k) μ₀),
    -- Moreover, we know that `ER` and `ES` are disjoint.
    have h_disjoint : disjoint ER ES,
      from generalized_eigenvec_disjoint_range_ker f μ₀,
    -- Since the dimensions of `ER` and `ES` add up to the dimension of `V`, it follows that the
    -- span of all generalized eigenvectors is all of `V`.
    show (⨆ (μ : K) (k : ℕ), f.generalized_eigenspace μ k) = ⊤,
    { rw [←top_le_iff, ←submodule.eq_top_of_disjoint ER ES h_dim_add h_disjoint],
      apply sup_le hER hES } }
end

end End
end module
variables {K V : Type*} [field K] [add_comm_group V] [module K V] [finite_dimensional K V]

protected lemma linear_map.is_integral (f : V →ₗ[K] V) : is_integral K f :=
module.End.is_integral f


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Eric Wieser
-/

import algebra.direct_sum.internal
import algebra.graded_monoid
import data.fintype.card
import data.mv_polynomial.variables

/-!
# Homogeneous polynomials

A multivariate polynomial `φ` is homogeneous of degree `n`
if all monomials occuring in `φ` have degree `n`.

## Main definitions/lemmas

* `is_homogeneous φ n`: a predicate that asserts that `φ` is homogeneous of degree `n`.
* `homogeneous_submodule σ R n`: the submodule of homogeneous polynomials of degree `n`.
* `homogeneous_component n`: the additive morphism that projects polynomials onto
  their summand that is homogeneous of degree `n`.
* `sum_homogeneous_component`: every polynomial is the sum of its homogeneous components

-/

open_locale big_operators

namespace mv_polynomial
variables {σ : Type*} {τ : Type*} {R : Type*} {S : Type*}

/-
TODO
* create definition for `∑ i in d.support, d i`
* show that `mv_polynomial σ R ≃ₐ[R] ⨁ i, homogeneous_submodule σ R i`
-/

/-- A multivariate polynomial `φ` is homogeneous of degree `n`
if all monomials occuring in `φ` have degree `n`. -/
def is_homogeneous [comm_semiring R] (φ : mv_polynomial σ R) (n : ℕ) :=
∀ ⦃d⦄, coeff d φ ≠ 0 → ∑ i in d.support, d i = n

variables (σ R)

/-- The submodule of homogeneous `mv_polynomial`s of degree `n`. -/
def homogeneous_submodule [comm_semiring R] (n : ℕ) :
  submodule R (mv_polynomial σ R) :=
{ carrier := { x | x.is_homogeneous n },
  smul_mem' := λ r a ha c hc, begin
    rw coeff_smul at hc,
    apply ha,
    intro h,
    apply hc,
    rw h,
    exact smul_zero r,
  end,
  zero_mem' := λ d hd, false.elim (hd $ coeff_zero _),
  add_mem' := λ a b ha hb c hc, begin
    rw coeff_add at hc,
    obtain h|h : coeff c a ≠ 0 ∨ coeff c b ≠ 0,
    { contrapose! hc, simp only [hc, add_zero] },
    { exact ha h },
    { exact hb h }
  end }

variables {σ R}

@[simp] lemma mem_homogeneous_submodule [comm_semiring R] (n : ℕ) (p : mv_polynomial σ R) :
  p ∈ homogeneous_submodule σ R n ↔ p.is_homogeneous n := iff.rfl

variables (σ R)

/-- While equal, the former has a convenient definitional reduction. -/
lemma homogeneous_submodule_eq_finsupp_supported [comm_semiring R] (n : ℕ) :
  homogeneous_submodule σ R n = finsupp.supported _ R {d | ∑ i in d.support, d i = n} :=
begin
  ext,
  rw [finsupp.mem_supported, set.subset_def],
  simp only [finsupp.mem_support_iff, finset.mem_coe],
  refl,
end

variables {σ R}

lemma homogeneous_submodule_mul [comm_semiring R] (m n : ℕ) :
  homogeneous_submodule σ R m * homogeneous_submodule σ R n ≤ homogeneous_submodule σ R (m + n) :=
begin
  rw submodule.mul_le,
  intros φ hφ ψ hψ c hc,
  rw [coeff_mul] at hc,
  obtain ⟨⟨d, e⟩, hde, H⟩ := finset.exists_ne_zero_of_sum_ne_zero hc,
  have aux : coeff d φ ≠ 0 ∧ coeff e ψ ≠ 0,
  { contrapose! H,
    by_cases h : coeff d φ = 0;
    simp only [*, ne.def, not_false_iff, zero_mul, mul_zero] at * },
  specialize hφ aux.1, specialize hψ aux.2,
  rw finsupp.mem_antidiagonal at hde,
  classical,
  have hd' : d.support ⊆ d.support ∪ e.support := finset.subset_union_left _ _,
  have he' : e.support ⊆ d.support ∪ e.support := finset.subset_union_right _ _,
  rw [← hde, ← hφ, ← hψ, finset.sum_subset (finsupp.support_add),
    finset.sum_subset hd', finset.sum_subset he', ← finset.sum_add_distrib],
  { congr },
  all_goals { intros i hi, apply finsupp.not_mem_support_iff.mp },
end

section
variables [comm_semiring R]

variables {σ R}

lemma is_homogeneous_monomial (d : σ →₀ ℕ) (r : R) (n : ℕ) (hn : ∑ i in d.support, d i = n) :
  is_homogeneous (monomial d r) n :=
begin
  intros c hc,
  classical,
  rw coeff_monomial at hc,
  split_ifs at hc with h,
  { subst c, exact hn },
  { contradiction }
end
variables (σ) {R}

lemma is_homogeneous_of_total_degree_zero {p : mv_polynomial σ R} (hp : p.total_degree = 0) :
  is_homogeneous p 0 :=
begin
  erw [total_degree, finset.sup_eq_bot_iff] at hp,
  -- we have to do this in two steps to stop simp changing bot to zero
  simp_rw [mem_support_iff] at hp,
  exact hp,
end

lemma is_homogeneous_C (r : R) :
  is_homogeneous (C r : mv_polynomial σ R) 0 :=
begin
  apply is_homogeneous_monomial,
  simp only [finsupp.zero_apply, finset.sum_const_zero],
end

variables (σ R)

lemma is_homogeneous_zero (n : ℕ) : is_homogeneous (0 : mv_polynomial σ R) n :=
(homogeneous_submodule σ R n).zero_mem

lemma is_homogeneous_one : is_homogeneous (1 : mv_polynomial σ R) 0 :=
is_homogeneous_C _ _

variables {σ} (R)

lemma is_homogeneous_X (i : σ) :
  is_homogeneous (X i : mv_polynomial σ R) 1 :=
begin
  apply is_homogeneous_monomial,
  simp only [finsupp.support_single_ne_zero one_ne_zero, finset.sum_singleton],
  exact finsupp.single_eq_same
end

end

namespace is_homogeneous
variables [comm_semiring R] {φ ψ : mv_polynomial σ R} {m n : ℕ}

lemma coeff_eq_zero (hφ : is_homogeneous φ n) (d : σ →₀ ℕ) (hd : ∑ i in d.support, d i ≠ n) :
  coeff d φ = 0 :=
by { have aux := mt (@hφ d) hd, classical, rwa not_not at aux }

lemma inj_right (hm : is_homogeneous φ m) (hn : is_homogeneous φ n) (hφ : φ ≠ 0) :
  m = n :=
begin
  obtain ⟨d, hd⟩ : ∃ d, coeff d φ ≠ 0 := exists_coeff_ne_zero hφ,
  rw [← hm hd, ← hn hd]
end

lemma add (hφ : is_homogeneous φ n) (hψ : is_homogeneous ψ n) :
  is_homogeneous (φ + ψ) n :=
(homogeneous_submodule σ R n).add_mem hφ hψ

lemma sum {ι : Type*} (s : finset ι) (φ : ι → mv_polynomial σ R) (n : ℕ)
  (h : ∀ i ∈ s, is_homogeneous (φ i) n) :
  is_homogeneous (∑ i in s, φ i) n :=
(homogeneous_submodule σ R n).sum_mem h

lemma mul (hφ : is_homogeneous φ m) (hψ : is_homogeneous ψ n) :
  is_homogeneous (φ * ψ) (m + n) :=
homogeneous_submodule_mul m n $ submodule.mul_mem_mul hφ hψ

lemma prod {ι : Type*} (s : finset ι) (φ : ι → mv_polynomial σ R) (n : ι → ℕ)
  (h : ∀ i ∈ s, is_homogeneous (φ i) (n i)) :
  is_homogeneous (∏ i in s, φ i) (∑ i in s, n i) :=
begin
  classical,
  revert h,
  apply finset.induction_on s,
  { intro, simp only [is_homogeneous_one, finset.sum_empty, finset.prod_empty] },
  { intros i s his IH h,
    simp only [his, finset.prod_insert, finset.sum_insert, not_false_iff],
    apply (h i (finset.mem_insert_self _ _)).mul (IH _),
    intros j hjs,
    exact h j (finset.mem_insert_of_mem hjs) }
end

lemma total_degree (hφ : is_homogeneous φ n) (h : φ ≠ 0) :
  total_degree φ = n :=
begin
  rw total_degree,
  apply le_antisymm,
  { apply finset.sup_le,
    intros d hd,
    rw mem_support_iff at hd,
    rw [finsupp.sum, hφ hd], },
  { obtain ⟨d, hd⟩ : ∃ d, coeff d φ ≠ 0 := exists_coeff_ne_zero h,
    simp only [← hφ hd, finsupp.sum],
    replace hd := finsupp.mem_support_iff.mpr hd,
    exact finset.le_sup hd, }
end

/--
The homogeneous submodules form a graded ring. This instance is used by `direct_sum.comm_semiring`
and `direct_sum.algebra`. -/
instance homogeneous_submodule.gcomm_semiring :
  set_like.graded_monoid (homogeneous_submodule σ R) :=
{ one_mem := is_homogeneous_one σ R,
  mul_mem := λ i j xi xj, is_homogeneous.mul}

open_locale direct_sum
noncomputable example : comm_semiring (⨁ i, homogeneous_submodule σ R i) := infer_instance
noncomputable example : algebra R (⨁ i, homogeneous_submodule σ R i) := infer_instance

end is_homogeneous

section
noncomputable theory
open_locale classical
open finset

/-- `homogeneous_component n φ` is the part of `φ` that is homogeneous of degree `n`.
See `sum_homogeneous_component` for the statement that `φ` is equal to the sum
of all its homogeneous components. -/
def homogeneous_component [comm_semiring R] (n : ℕ) :
  mv_polynomial σ R →ₗ[R] mv_polynomial σ R :=
(submodule.subtype _).comp $ finsupp.restrict_dom _ _ {d | ∑ i in d.support, d i = n}

section homogeneous_component
open finset
variables [comm_semiring R] (n : ℕ) (φ ψ : mv_polynomial σ R)

lemma coeff_homogeneous_component (d : σ →₀ ℕ) :
  coeff d (homogeneous_component n φ) = if ∑ i in d.support, d i = n then coeff d φ else 0 :=
by convert finsupp.filter_apply (λ d : σ →₀ ℕ, ∑ i in d.support, d i = n) φ d

lemma homogeneous_component_apply :
  homogeneous_component n φ =
  ∑ d in φ.support.filter (λ d, ∑ i in d.support, d i = n), monomial d (coeff d φ) :=
by convert finsupp.filter_eq_sum (λ d : σ →₀ ℕ, ∑ i in d.support, d i = n) φ

lemma homogeneous_component_is_homogeneous :
  (homogeneous_component n φ).is_homogeneous n :=
begin
  intros d hd,
  contrapose! hd,
  rw [coeff_homogeneous_component, if_neg hd]
end

@[simp]
lemma homogeneous_component_zero : homogeneous_component 0 φ = C (coeff 0 φ) :=
begin
  ext1 d,
  rcases em (d = 0) with (rfl|hd),
  { simp only [coeff_homogeneous_component, sum_eq_zero_iff, finsupp.zero_apply, if_true, coeff_C,
      eq_self_iff_true, forall_true_iff] },
  { rw [coeff_homogeneous_component, if_neg, coeff_C, if_neg (ne.symm hd)],
    simp only [finsupp.ext_iff, finsupp.zero_apply] at hd,
    simp [hd] }
end

@[simp]
lemma homogeneous_component_C_mul (n : ℕ) (r : R) :
  homogeneous_component n (C r * φ) = C r * homogeneous_component n φ :=
by simp only [C_mul', linear_map.map_smul]

lemma homogeneous_component_eq_zero' (h : ∀ d : σ →₀ ℕ, d ∈ φ.support → ∑ i in d.support, d i ≠ n) :
  homogeneous_component n φ = 0 :=
begin
  rw [homogeneous_component_apply, sum_eq_zero],
  intros d hd, rw mem_filter at hd,
  exfalso, exact h _ hd.1 hd.2
end

lemma homogeneous_component_eq_zero (h : φ.total_degree < n) :
  homogeneous_component n φ = 0 :=
begin
  apply homogeneous_component_eq_zero',
  rw [total_degree, finset.sup_lt_iff] at h,
  { intros d hd, exact ne_of_lt (h d hd), },
  { exact lt_of_le_of_lt (nat.zero_le _) h, }
end

lemma sum_homogeneous_component :
  ∑ i in range (φ.total_degree + 1), homogeneous_component i φ = φ :=
begin
  ext1 d,
  suffices : φ.total_degree < d.support.sum d → 0 = coeff d φ,
    by simpa [coeff_sum, coeff_homogeneous_component],
  exact λ h, (coeff_eq_zero_of_total_degree_lt h).symm
end

lemma homogeneous_component_homogeneous_polynomial (m n : ℕ)
  (p : mv_polynomial σ R) (h : p ∈ homogeneous_submodule σ R n) :
  homogeneous_component m p = if m = n then p else 0 :=
begin
  simp only [mem_homogeneous_submodule] at h,
  ext x,
  rw coeff_homogeneous_component,
  by_cases zero_coeff : coeff x p = 0,
  { split_ifs,
    all_goals { simp only [zero_coeff, coeff_zero], }, },
  { rw h zero_coeff,
    simp only [show n = m ↔ m = n, from eq_comm],
    split_ifs with h1,
    { refl },
    { simp only [coeff_zero] } }
end

end homogeneous_component

end

end mv_polynomial


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import set_theory.game
import data.fintype.basic

/-!
# Short games

A combinatorial game is `short` [Conway, ch.9][conway2001] if it has only finitely many positions.
In particular, this means there is a finite set of moves at every point.

We prove that the order relations `≤` and `<`, and the equivalence relation `≈`, are decidable on
short games, although unfortunately in practice `dec_trivial` doesn't seem to be able to
prove anything using these instances.
-/
universes u

namespace pgame

/-- A short game is a game with a finite set of moves at every turn. -/
inductive short : pgame.{u} → Type (u+1)
| mk : Π {α β : Type u} {L : α → pgame.{u}} {R : β → pgame.{u}}
         (sL : ∀ i : α, short (L i)) (sR : ∀ j : β, short (R j))
         [fintype α] [fintype β],
       short ⟨α, β, L, R⟩

instance subsingleton_short : Π (x : pgame), subsingleton (short x)
| (mk xl xr xL xR) :=
⟨λ a b, begin
  cases a, cases b,
  congr,
  { funext,
    apply @subsingleton.elim _ (subsingleton_short (xL x)) },
  { funext,
    apply @subsingleton.elim _ (subsingleton_short (xR x)) },
end⟩
using_well_founded { dec_tac := pgame_wf_tac }

/-- A synonym for `short.mk` that specifies the pgame in an implicit argument. -/
def short.mk' {x : pgame} [fintype x.left_moves] [fintype x.right_moves]
  (sL : ∀ i : x.left_moves, short (x.move_left i))
  (sR : ∀ j : x.right_moves, short (x.move_right j)) :
  short x :=
by unfreezingI { cases x, dsimp at * }; exact short.mk sL sR

attribute [class] short

/--
Extracting the `fintype` instance for the indexing type for Left's moves in a short game.
This is an unindexed typeclass, so it can't be made a global instance.
-/
def fintype_left {α β : Type u} {L : α → pgame.{u}} {R : β → pgame.{u}} [S : short ⟨α, β, L, R⟩] :
  fintype α :=
by { casesI S with _ _ _ _ _ _ F _, exact F }
local attribute [instance] fintype_left
instance fintype_left_moves (x : pgame) [S : short x] : fintype (x.left_moves) :=
by { casesI x, dsimp, apply_instance }
/--
Extracting the `fintype` instance for the indexing type for Right's moves in a short game.
This is an unindexed typeclass, so it can't be made a global instance.
-/
def fintype_right {α β : Type u} {L : α → pgame.{u}} {R : β → pgame.{u}} [S : short ⟨α, β, L, R⟩] :
  fintype β :=
by { casesI S with _ _ _ _ _ _ _ F, exact F }
local attribute [instance] fintype_right
instance fintype_right_moves (x : pgame) [S : short x] : fintype (x.right_moves) :=
by { casesI x, dsimp, apply_instance }

instance move_left_short (x : pgame) [S : short x] (i : x.left_moves) : short (x.move_left i) :=
by { casesI S with _ _ _ _ L _ _ _, apply L }
/--
Extracting the `short` instance for a move by Left.
This would be a dangerous instance potentially introducing new metavariables
in typeclass search, so we only make it an instance locally.
-/
def move_left_short' {xl xr} (xL xR) [S : short (mk xl xr xL xR)] (i : xl) : short (xL i) :=
by { casesI S with _ _ _ _ L _ _ _, apply L }
local attribute [instance] move_left_short'
instance move_right_short (x : pgame) [S : short x] (j : x.right_moves) : short (x.move_right j) :=
by { casesI S with _ _ _ _ _ R _ _, apply R }
/--
Extracting the `short` instance for a move by Right.
This would be a dangerous instance potentially introducing new metavariables
in typeclass search, so we only make it an instance locally.
-/
def move_right_short' {xl xr} (xL xR) [S : short (mk xl xr xL xR)] (j : xr) : short (xR j) :=
by { casesI S with _ _ _ _ _ R _ _, apply R }
local attribute [instance] move_right_short'

instance short.of_pempty {xL} {xR} : short (mk pempty pempty xL xR) :=
short.mk (λ i, pempty.elim i) (λ j, pempty.elim j)

instance short_0 : short 0 :=
short.mk (λ i, by cases i) (λ j, by cases j)

instance short_1 : short 1 :=
short.mk (λ i, begin cases i, apply_instance, end) (λ j, by cases j)

/-- Evidence that every `pgame` in a list is `short`. -/
inductive list_short : list pgame.{u} → Type (u+1)
| nil : list_short []
| cons : Π (hd : pgame.{u}) [short hd] (tl : list pgame.{u}) [list_short tl], list_short (hd :: tl)

attribute [class] list_short
attribute [instance] list_short.nil list_short.cons

instance list_short_nth_le : Π (L : list pgame.{u}) [list_short L] (i : fin (list.length L)),
  short (list.nth_le L i i.is_lt)
| [] _ n := begin exfalso, rcases n with ⟨_, ⟨⟩⟩, end
| (hd :: tl) (@list_short.cons _ S _ _) ⟨0, _⟩ := S
| (hd :: tl) (@list_short.cons _ _ _ S) ⟨n+1, h⟩ :=
  @list_short_nth_le tl S ⟨n, (add_lt_add_iff_right 1).mp h⟩

instance short_of_lists : Π (L R : list pgame) [list_short L] [list_short R],
  short (pgame.of_lists L R)
| L R _ _ := by { resetI, apply short.mk,
  { intros, apply_instance },
  { intros, apply pgame.list_short_nth_le /- where does the subtype.val come from? -/ } }

/-- If `x` is a short game, and `y` is a relabelling of `x`, then `y` is also short. -/
def short_of_relabelling : Π {x y : pgame.{u}} (R : relabelling x y) (S : short x), short y
| x y ⟨L, R, rL, rR⟩ S :=
begin
  resetI,
  haveI := (fintype.of_equiv _ L),
  haveI := (fintype.of_equiv _ R),
  exact short.mk'
    (λ i, by { rw ←(L.right_inv i), apply short_of_relabelling (rL (L.symm i)) infer_instance, })
    (λ j, short_of_relabelling (rR j) infer_instance)
end

/-- If `x` has no left move or right moves, it is (very!) short. -/
def short_of_equiv_empty {x : pgame.{u}}
  (el : x.left_moves ≃ pempty) (er : x.right_moves ≃ pempty) : short x :=
short_of_relabelling (relabel_relabelling el er).symm short.of_pempty

instance short_neg : Π (x : pgame.{u}) [short x], short (-x)
| (mk xl xr xL xR) _ :=
begin
  resetI,
  apply short.mk,
  { rintro i,
    apply short_neg _,
    apply_instance, },
  { rintro j,
    apply short_neg _,
    apply_instance, }
end
using_well_founded { dec_tac := pgame_wf_tac }

instance short_add : Π (x y : pgame.{u}) [short x] [short y], short (x + y)
| (mk xl xr xL xR) (mk yl yr yL yR) _ _ :=
begin
  resetI,
  apply short.mk,
  { rintro ⟨i⟩,
    { apply short_add, },
    { change short (mk xl xr xL xR + yL i), apply short_add, } },
  { rintro ⟨j⟩,
    { apply short_add, },
    { change short (mk xl xr xL xR + yR j), apply short_add, } },
end
using_well_founded { dec_tac := pgame_wf_tac }

instance short_nat : Π n : ℕ, short n
| 0 := pgame.short_0
| (n+1) := @pgame.short_add _ _ (short_nat n) pgame.short_1

instance short_bit0 (x : pgame.{u}) [short x] : short (bit0 x) :=
by { dsimp [bit0], apply_instance }
instance short_bit1 (x : pgame.{u}) [short x] : short (bit1 x) :=
by { dsimp [bit1], apply_instance }

/--
Auxiliary construction of decidability instances.
We build `decidable (x ≤ y)` and `decidable (x < y)` in a simultaneous induction.
Instances for the two projections separately are provided below.
-/
def le_lt_decidable : Π (x y : pgame.{u}) [short x] [short y], decidable (x ≤ y) × decidable (x < y)
| (mk xl xr xL xR) (mk yl yr yL yR) shortx shorty :=
begin
  resetI,
  split,
  { refine @decidable_of_iff' _ _ mk_le_mk (id _),
    apply @and.decidable _ _ _ _,
    { apply @fintype.decidable_forall_fintype xl _ _ (by apply_instance),
      intro i,
      apply (@le_lt_decidable _ _ _ _).2; apply_instance, },
    { apply @fintype.decidable_forall_fintype yr _ _ (by apply_instance),
      intro i,
      apply (@le_lt_decidable _ _ _ _).2; apply_instance, }, },
  { refine @decidable_of_iff' _ _ mk_lt_mk (id _),
    apply @or.decidable _ _ _ _,
    { apply @fintype.decidable_exists_fintype yl _ _ (by apply_instance),
      intro i,
      apply (@le_lt_decidable _ _ _ _).1; apply_instance, },
    { apply @fintype.decidable_exists_fintype xr _ _ (by apply_instance),
      intro i,
      apply (@le_lt_decidable _ _ _ _).1; apply_instance, }, },
end
using_well_founded { dec_tac := pgame_wf_tac }

instance le_decidable (x y : pgame.{u}) [short x] [short y] : decidable (x ≤ y) :=
(le_lt_decidable x y).1

instance lt_decidable (x y : pgame.{u}) [short x] [short y] : decidable (x < y) :=
(le_lt_decidable x y).2

instance equiv_decidable (x y : pgame.{u}) [short x] [short y] : decidable (x ≈ y) :=
and.decidable

example : short 0 := by apply_instance
example : short 1 := by apply_instance
example : short 2 := by apply_instance
example : short (-2) := by apply_instance

example : short (of_lists [0] [1]) := by apply_instance
example : short (of_lists [-2, -1] [1]) := by apply_instance

example : short (0 + 0) := by apply_instance

example : decidable ((1 : pgame) ≤ 1) := by apply_instance

-- No longer works since definitional reduction of well-founded definitions has been restricted.
-- example : (0 : pgame) ≤ 0 := dec_trivial
-- example : (1 : pgame) ≤ 1 := dec_trivial

end pgame


variable U : Type
variables A B C : set U

example : ∀ x, x ∈ A ∩ C → x ∈ A ∪ B :=
    begin
        assume x,
        intro,
        have h1, from a.left,
        exact or.inl h1,
    end

example : ∀ x, x ∈ A ∩ C → x ∈ A ∪ B :=
    assume x,
    show x ∈ A ∩ C → x ∈ A ∪ B, from
        assume h1 : x ∈ A ∩ C,
        show x ∈ A ∪ B, from or.inl h1.left

example : ∀ x, x ∈ -(A ∪ B) → x ∈ -A :=
    begin
        intros x h1 h2,
        apply h1,
        exact or.inl h2
    end

example : ∀ x, x ∈ -(A ∪ B) → x ∈ -A :=
    assume x,
        assume h1 : x ∈ -(A ∪ B),
        show x ∈ -A, from
            assume h2 : x ∈ A,
            show false, from h1 $ or.inl h2


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_algebra_206
  (a b : ℝ)
  (f : ℝ → ℝ)
  (h₀ : ∀ x, f x = x^2 + a * x + b)
  (h₁ : 2 * a ≠ b)
  (h₂ : f (2 * a) = 0)
  (h₃ : f b = 0) :
  a + b = -1 :=
begin
  simp [*, pow_two] at *,
  ring_nf at *,
  simp [*, smul_eq_mul, pow_two, mul_assoc, mul_one] at *,
  cases h₃,
  nlinarith [h₁, h₀ 0],
  norm_num [*, add_comm] at *,
end


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.int.gcd
import data.list.rotate
import tactic.abel

/-!
# Congruences modulo a natural number

This file defines the equivalence relation `a ≡ b [MOD n]` on the natural numbers,
and proves basic properties about it such as the Chinese Remainder Theorem
`modeq_and_modeq_iff_modeq_mul`.

## Notations

`a ≡ b [MOD n]` is notation for `nat.modeq n a b`, which is defined to mean `a % n = b % n`.

## Tags

modeq, congruence, mod, MOD, modulo
-/

namespace nat

/-- Modular equality. `n.modeq a b`, or `a ≡ b [MOD n]`, means that `a - b` is a multiple of `n`. -/
@[derive decidable]
def modeq (n a b : ℕ) := a % n = b % n

notation a ` ≡ `:50 b ` [MOD `:50 n `]`:0 := modeq n a b

variables {m n a b c d : ℕ}

namespace modeq

@[refl] protected theorem refl (a : ℕ) : a ≡ a [MOD n] := @rfl _ _

protected theorem rfl : a ≡ a [MOD n] := modeq.refl _

@[symm] protected theorem symm : a ≡ b [MOD n] → b ≡ a [MOD n] := eq.symm

@[trans] protected theorem trans : a ≡ b [MOD n] → b ≡ c [MOD n] → a ≡ c [MOD n] := eq.trans

protected theorem comm : a ≡ b [MOD n] ↔ b ≡ a [MOD n] := ⟨modeq.symm, modeq.symm⟩

end modeq

theorem modeq_zero_iff_dvd : a ≡ 0 [MOD n] ↔ n ∣ a :=
by rw [modeq, zero_mod, dvd_iff_mod_eq_zero]

lemma _root_.has_dvd.dvd.modeq_zero_nat (h : n ∣ a) : a ≡ 0 [MOD n] := modeq_zero_iff_dvd.2 h
lemma _root_.has_dvd.dvd.zero_modeq_nat (h : n ∣ a) : 0 ≡ a [MOD n] := h.modeq_zero_nat.symm

theorem modeq_iff_dvd : a ≡ b [MOD n] ↔ (n:ℤ) ∣ b - a :=
by rw [modeq, eq_comm, ← int.coe_nat_inj', int.coe_nat_mod, int.coe_nat_mod,
   int.mod_eq_mod_iff_mod_sub_eq_zero, int.dvd_iff_mod_eq_zero]

protected theorem modeq.dvd : a ≡ b [MOD n] → (n:ℤ) ∣ b - a := modeq_iff_dvd.1
theorem modeq_of_dvd : (n:ℤ) ∣ b - a → a ≡ b [MOD n] := modeq_iff_dvd.2

/-- A variant of `modeq_iff_dvd` with `nat` divisibility -/
theorem modeq_iff_dvd' (h : a ≤ b) : a ≡ b [MOD n] ↔ n ∣ b - a :=
by rw [modeq_iff_dvd, ←int.coe_nat_dvd, int.coe_nat_sub h]

theorem mod_modeq (a n) : a % n ≡ a [MOD n] := mod_mod _ _

namespace modeq

protected theorem modeq_of_dvd (d : m ∣ n) (h : a ≡ b [MOD n]) : a ≡ b [MOD m] :=
modeq_of_dvd ((int.coe_nat_dvd.2 d).trans h.dvd)

protected theorem mul_left' (c : ℕ) (h : a ≡ b [MOD n]) : c * a ≡ c * b [MOD (c * n)] :=
by unfold modeq at *; rw [mul_mod_mul_left, mul_mod_mul_left, h]

protected theorem mul_left (c : ℕ) (h : a ≡ b [MOD n]) : c * a ≡ c * b [MOD n] :=
(h.mul_left' _ ).modeq_of_dvd (dvd_mul_left _ _)

protected theorem mul_right' (c : ℕ) (h : a ≡ b [MOD n]) : a * c ≡ b * c [MOD (n * c)] :=
by rw [mul_comm a, mul_comm b, mul_comm n]; exact h.mul_left' c

protected theorem mul_right (c : ℕ) (h : a ≡ b [MOD n]) : a * c ≡ b * c [MOD n] :=
by rw [mul_comm a, mul_comm b]; exact h.mul_left c

protected theorem mul (h₁ : a ≡ b [MOD n]) (h₂ : c ≡ d [MOD n]) : a * c ≡ b * d [MOD n] :=
(h₂.mul_left _ ).trans (h₁.mul_right _)

protected theorem pow (m : ℕ) (h : a ≡ b [MOD n]) : a ^ m ≡ b ^ m [MOD n] :=
begin
  induction m with d hd, {refl},
  rw [pow_succ, pow_succ],
  exact h.mul hd,
end

protected theorem add (h₁ : a ≡ b [MOD n]) (h₂ : c ≡ d [MOD n]) : a + c ≡ b + d [MOD n] :=
begin
  rw [modeq_iff_dvd, int.coe_nat_add, int.coe_nat_add, add_sub_comm],
  exact dvd_add h₁.dvd h₂.dvd,
end

protected theorem add_left (c : ℕ) (h : a ≡ b [MOD n]) : c + a ≡ c + b [MOD n] :=
modeq.rfl.add h

protected theorem add_right (c : ℕ) (h : a ≡ b [MOD n]) : a + c ≡ b + c [MOD n] :=
h.add modeq.rfl

protected theorem add_left_cancel (h₁ : a ≡ b [MOD n]) (h₂ : a + c ≡ b + d [MOD n]) :
  c ≡ d [MOD n] :=
begin
  simp only [modeq_iff_dvd, int.coe_nat_add] at *,
  rw add_sub_comm at h₂,
  convert _root_.dvd_sub h₂ h₁ using 1,
  rw add_sub_cancel',
end

protected theorem add_left_cancel' (c : ℕ) (h : c + a ≡ c + b [MOD n]) : a ≡ b [MOD n] :=
modeq.rfl.add_left_cancel h

protected theorem add_right_cancel (h₁ : c ≡ d [MOD n]) (h₂ : a + c ≡ b + d [MOD n]) :
  a ≡ b [MOD n] :=
by { rw [add_comm a, add_comm b] at h₂, exact h₁.add_left_cancel h₂ }

protected theorem add_right_cancel' (c : ℕ) (h : a + c ≡ b + c [MOD n]) : a ≡ b [MOD n] :=
modeq.rfl.add_right_cancel h

theorem of_modeq_mul_left (m : ℕ) (h : a ≡ b [MOD m * n]) : a ≡ b [MOD n] :=
by { rw [modeq_iff_dvd] at *, exact (dvd_mul_left (n : ℤ) (m : ℤ)).trans h }

theorem of_modeq_mul_right (m : ℕ) : a ≡ b [MOD n * m] → a ≡ b [MOD n] :=
mul_comm m n ▸ of_modeq_mul_left _

end modeq

theorem modeq_one : a ≡ b [MOD 1] := modeq_of_dvd (one_dvd _)

lemma modeq_sub (h : b ≤ a) : a ≡ b [MOD a - b] :=
(modeq_of_dvd $ by rw [int.coe_nat_sub h]).symm

@[simp] lemma modeq_zero_iff {a b : ℕ} : a ≡ b [MOD 0] ↔ a = b :=
by rw [nat.modeq, nat.mod_zero, nat.mod_zero]

@[simp] lemma add_modeq_left {a n : ℕ} : n + a ≡ a [MOD n] :=
by rw [nat.modeq, nat.add_mod_left]
@[simp] lemma add_modeq_right {a n : ℕ} : a + n ≡ a [MOD n] :=
by rw [nat.modeq, nat.add_mod_right]

namespace modeq

lemma le_of_lt_add (h1 : a ≡ b [MOD m]) (h2 : a < b + m) : a ≤ b :=
(le_total a b).elim id (λ h3, nat.le_of_sub_eq_zero
  (eq_zero_of_dvd_of_lt ((modeq_iff_dvd' h3).mp h1.symm) ((tsub_lt_iff_left h3).mpr h2)))

lemma add_le_of_lt (h1 : a ≡ b [MOD m]) (h2 : a < b) : a + m ≤ b :=
le_of_lt_add (add_modeq_right.trans h1) (add_lt_add_right h2 m)

end modeq

local attribute [semireducible] int.nonneg

/-- The natural number less than `lcm n m` congruent to `a` mod `n` and `b` mod `m` -/
def chinese_remainder' (h : a ≡ b [MOD gcd n m]) : {k // k ≡ a [MOD n] ∧ k ≡ b [MOD m]} :=
if hn : n = 0 then ⟨a, begin rw [hn, gcd_zero_left] at h, split, refl, exact h end⟩ else
if hm : m = 0 then ⟨b, begin rw [hm, gcd_zero_right] at h, split, exact h.symm, refl end⟩ else
⟨let (c, d) := xgcd n m in int.to_nat (((n * c * b + m * d * a) / gcd n m) % lcm n m), begin
  rw xgcd_val,
  dsimp [chinese_remainder'._match_1],
  rw [modeq_iff_dvd, modeq_iff_dvd,
    int.to_nat_of_nonneg (int.mod_nonneg _ (int.coe_nat_ne_zero.2 (lcm_ne_zero hn hm)))],
  have hnonzero : (gcd n m : ℤ) ≠ 0 := begin
    norm_cast,
    rw [nat.gcd_eq_zero_iff, not_and],
    exact λ _, hm,
  end,
  have hcoedvd : ∀ t, (gcd n m : ℤ) ∣ t * (b - a) := λ t, h.dvd.mul_left _,
  have := gcd_eq_gcd_ab n m,
  split; rw [int.mod_def, ← sub_add]; refine dvd_add _ (dvd_mul_of_dvd_left _ _); try {norm_cast},
  { rw ← sub_eq_iff_eq_add' at this,
    rw [← this, sub_mul, ← add_sub_assoc, add_comm, add_sub_assoc, ← mul_sub,
      int.add_div_of_dvd_left, int.mul_div_cancel_left _ hnonzero,
      int.mul_div_assoc _ h.dvd, ← sub_sub, sub_self, zero_sub, dvd_neg, mul_assoc],
    exact dvd_mul_right _ _,
    norm_cast, exact dvd_mul_right _ _, },
  { exact dvd_lcm_left n m, },
  { rw ← sub_eq_iff_eq_add at this,
    rw [← this, sub_mul, sub_add, ← mul_sub, int.sub_div_of_dvd, int.mul_div_cancel_left _ hnonzero,
      int.mul_div_assoc _ h.dvd, ← sub_add, sub_self, zero_add, mul_assoc],
    exact dvd_mul_right _ _,
    exact hcoedvd _ },
  { exact dvd_lcm_right n m, },
end⟩

/-- The natural number less than `n*m` congruent to `a` mod `n` and `b` mod `m` -/
def chinese_remainder (co : coprime n m) (a b : ℕ) : {k // k ≡ a [MOD n] ∧ k ≡ b [MOD m]} :=
chinese_remainder' (by convert modeq_one)

lemma chinese_remainder'_lt_lcm (h : a ≡ b [MOD gcd n m]) (hn : n ≠ 0) (hm : m ≠ 0) :
  ↑(chinese_remainder' h) < lcm n m :=
begin
  dsimp only [chinese_remainder'],
  rw [dif_neg hn, dif_neg hm, subtype.coe_mk, xgcd_val, ←int.to_nat_coe_nat (lcm n m)],
  have lcm_pos := int.coe_nat_pos.mpr (nat.pos_of_ne_zero (lcm_ne_zero hn hm)),
  exact (int.to_nat_lt_to_nat lcm_pos).mpr (int.mod_lt_of_pos _ lcm_pos),
end

lemma chinese_remainder_lt_mul (co : coprime n m) (a b : ℕ) (hn : n ≠ 0) (hm : m ≠ 0) :
  ↑(chinese_remainder co a b) < n * m :=
lt_of_lt_of_le (chinese_remainder'_lt_lcm _ hn hm) (le_of_eq co.lcm_eq_mul)

lemma modeq_and_modeq_iff_modeq_mul {a b m n : ℕ} (hmn : coprime m n) :
  a ≡ b [MOD m] ∧ a ≡ b [MOD n] ↔ (a ≡ b [MOD m * n]) :=
⟨λ h, begin
    rw [nat.modeq_iff_dvd, nat.modeq_iff_dvd, ← int.dvd_nat_abs,
      int.coe_nat_dvd, ← int.dvd_nat_abs, int.coe_nat_dvd] at h,
    rw [nat.modeq_iff_dvd, ← int.dvd_nat_abs, int.coe_nat_dvd],
    exact hmn.mul_dvd_of_dvd_of_dvd h.1 h.2
  end,
λ h, ⟨h.of_modeq_mul_right _, h.of_modeq_mul_left _⟩⟩

lemma coprime_of_mul_modeq_one (b : ℕ) {a n : ℕ} (h : a * b ≡ 1 [MOD n]) : coprime a n :=
nat.coprime_of_dvd' (λ k kp ⟨ka, hka⟩ ⟨kb, hkb⟩, int.coe_nat_dvd.1 begin
  rw [hka, hkb, modeq_iff_dvd] at h,
  cases h with z hz,
  rw [sub_eq_iff_eq_add] at hz,
  rw [hz, int.coe_nat_mul, mul_assoc, mul_assoc, int.coe_nat_mul, ← mul_add],
  exact dvd_mul_right _ _,
end)

@[simp] lemma mod_mul_right_mod (a b c : ℕ) : a % (b * c) % b = a % b :=
(mod_modeq _ _).of_modeq_mul_right _

@[simp] lemma mod_mul_left_mod (a b c : ℕ) : a % (b * c) % c = a % c :=
(mod_modeq _ _).of_modeq_mul_left _

lemma div_mod_eq_mod_mul_div (a b c : ℕ) : a / b % c = a % (b * c) / b :=
if hb0 : b = 0 then by simp [hb0]
else by rw [← @add_right_cancel_iff _ _ (c * (a / b / c)), mod_add_div, nat.div_div_eq_div_mul,
  ← nat.mul_right_inj (nat.pos_of_ne_zero hb0),← @add_left_cancel_iff _ _ (a % b), mod_add_div,
  mul_add, ← @add_left_cancel_iff _ _ (a % (b * c) % b), add_left_comm,
  ← add_assoc (a % (b * c) % b), mod_add_div, ← mul_assoc, mod_add_div, mod_mul_right_mod]

lemma add_mod_add_ite (a b c : ℕ) :
  (a + b) % c + (if c ≤ a % c + b % c then c else 0) = a % c + b % c :=
have (a + b) % c = (a % c + b % c) % c,
  from ((mod_modeq _ _).add $ mod_modeq _ _).symm,
if hc0 : c = 0 then by simp [hc0]
else
  begin
    rw this,
    split_ifs,
    { have h2 : (a % c + b % c) / c < 2,
        from nat.div_lt_of_lt_mul (by rw mul_two;
          exact add_lt_add (nat.mod_lt _ (nat.pos_of_ne_zero hc0))
            (nat.mod_lt _ (nat.pos_of_ne_zero hc0))),
      have h0 : 0 <  (a % c + b % c) / c, from nat.div_pos h (nat.pos_of_ne_zero hc0),
      rw [← @add_right_cancel_iff _ _ (c * ((a % c + b % c) / c)), add_comm _ c, add_assoc,
        mod_add_div, le_antisymm (le_of_lt_succ h2) h0, mul_one, add_comm] },
    { rw [nat.mod_eq_of_lt (lt_of_not_ge h), add_zero] }
  end

lemma add_mod_of_add_mod_lt {a b c : ℕ} (hc : a % c + b % c < c) :
  (a + b) % c = a % c + b % c :=
 by rw [← add_mod_add_ite, if_neg (not_le_of_lt hc), add_zero]

lemma add_mod_add_of_le_add_mod {a b c : ℕ} (hc : c ≤ a % c + b % c) :
  (a + b) % c + c = a % c + b % c :=
by rw [← add_mod_add_ite, if_pos hc]

lemma add_div {a b c : ℕ} (hc0 : 0 < c) : (a + b) / c = a / c + b / c +
  if c ≤ a % c + b % c then 1 else 0 :=
begin
  rw [← nat.mul_right_inj hc0, ← @add_left_cancel_iff _ _ ((a + b) % c + a % c + b % c)],
  suffices : (a + b) % c + c * ((a + b) / c) + a % c + b % c =
    a % c + c * (a / c) + (b % c + c * (b / c)) + c * (if c ≤ a % c + b % c then 1 else 0) +
      (a + b) % c,
  { simpa only [mul_add, add_comm, add_left_comm, add_assoc] },
  rw [mod_add_div, mod_add_div, mod_add_div, mul_ite, add_assoc, add_assoc],
  conv_lhs { rw ← add_mod_add_ite },
  simp, ac_refl
end

lemma add_div_eq_of_add_mod_lt {a b c : ℕ} (hc : a % c + b % c < c) :
  (a + b) / c = a / c + b / c :=
if hc0 : c = 0 then by simp [hc0]
else by rw [add_div (nat.pos_of_ne_zero hc0), if_neg (not_le_of_lt hc), add_zero]

protected lemma add_div_of_dvd_right {a b c : ℕ} (hca : c ∣ a) :
  (a + b) / c = a / c + b / c :=
if h : c = 0 then by simp [h] else add_div_eq_of_add_mod_lt begin
  rw [nat.mod_eq_zero_of_dvd hca, zero_add],
  exact nat.mod_lt _ (pos_iff_ne_zero.mpr h),
end

protected lemma add_div_of_dvd_left {a b c : ℕ} (hca : c ∣ b) :
  (a + b) / c = a / c + b / c :=
by rwa [add_comm, nat.add_div_of_dvd_right, add_comm]

lemma add_div_eq_of_le_mod_add_mod {a b c : ℕ} (hc : c ≤ a % c + b % c) (hc0 : 0 < c) :
  (a + b) / c = a / c + b / c + 1 :=
by rw [add_div hc0, if_pos hc]

lemma add_div_le_add_div (a b c : ℕ) : a / c + b / c ≤ (a + b) / c :=
if hc0 : c = 0 then by simp [hc0]
else by rw [nat.add_div (nat.pos_of_ne_zero hc0)]; exact nat.le_add_right _ _

lemma le_mod_add_mod_of_dvd_add_of_not_dvd {a b c : ℕ} (h : c ∣ a + b) (ha : ¬ c ∣ a) :
  c ≤ a % c + b % c :=
by_contradiction $ λ hc,
  have (a + b) % c = a % c + b % c, from add_mod_of_add_mod_lt (lt_of_not_ge hc),
  by simp [dvd_iff_mod_eq_zero, *] at *

lemma odd_mul_odd {n m : ℕ} : n % 2 = 1 → m % 2 = 1 → (n * m) % 2 = 1 :=
by simpa [nat.modeq] using @modeq.mul 2 n 1 m 1

lemma odd_mul_odd_div_two {m n : ℕ} (hm1 : m % 2 = 1) (hn1 : n % 2 = 1) :
  (m * n) / 2 = m * (n / 2) + m / 2 :=
have hm0 : 0 < m := nat.pos_of_ne_zero (λ h, by simp * at *),
have hn0 : 0 < n := nat.pos_of_ne_zero (λ h, by simp * at *),
(nat.mul_right_inj (show 0 < 2, from dec_trivial)).1 $
by rw [mul_add, two_mul_odd_div_two hm1, mul_left_comm, two_mul_odd_div_two hn1,
  two_mul_odd_div_two (nat.odd_mul_odd hm1 hn1), mul_tsub, mul_one,
  ← add_tsub_assoc_of_le (succ_le_of_lt hm0),
  tsub_add_cancel_of_le (le_mul_of_one_le_right (nat.zero_le _) hn0)]

lemma odd_of_mod_four_eq_one {n : ℕ} : n % 4 = 1 → n % 2 = 1 :=
by simpa [modeq, show 2 * 2 = 4, by norm_num] using @modeq.of_modeq_mul_left 2 n 1 2

lemma odd_of_mod_four_eq_three {n : ℕ} : n % 4 = 3 → n % 2 = 1 :=
by simpa [modeq, show 2 * 2 = 4, by norm_num, show 3 % 4 = 3, by norm_num]
  using @modeq.of_modeq_mul_left 2 n 3 2

end nat

namespace list
variable {α : Type*}

lemma nth_rotate : ∀ {l : list α} {n m : ℕ} (hml : m < l.length),
  (l.rotate n).nth m = l.nth ((m + n) % l.length)
| []     n     m hml := (nat.not_lt_zero _ hml).elim
| l      0     m hml := by simp [nat.mod_eq_of_lt hml]
| (a::l) (n+1) m hml :=
have h₃ : m < list.length (l ++ [a]), by simpa using hml,
(lt_or_eq_of_le (nat.le_of_lt_succ $ nat.mod_lt (m + n)
  (lt_of_le_of_lt (nat.zero_le _) hml))).elim
(λ hml',
  have h₁ : (m + (n + 1)) % ((a :: l : list α).length) =
      (m + n) % ((a :: l : list α).length) + 1,
    from calc (m + (n + 1)) % (l.length + 1) =
      ((m + n) % (l.length + 1) + 1) % (l.length + 1) :
        add_assoc m n 1 ▸ nat.modeq.add_right 1 (nat.mod_mod _ _).symm
    ... = (m + n) % (l.length + 1) + 1 : nat.mod_eq_of_lt (nat.succ_lt_succ hml'),
  have h₂ : (m + n) % (l ++ [a]).length < l.length, by simpa [nat.add_one] using hml',
  by rw [list.rotate_cons_succ, nth_rotate h₃, list.nth_append h₂, h₁, list.nth]; simp)
(λ hml',
  have h₁ : (m + (n + 1)) % (l.length + 1) = 0,
    from calc (m + (n + 1)) % (l.length + 1) = (l.length + 1) % (l.length + 1) :
      add_assoc m n 1 ▸ nat.modeq.add_right 1
        (hml'.trans (nat.mod_eq_of_lt (nat.lt_succ_self _)).symm)
    ... = 0 : by simp,
  by rw [list.length, list.rotate_cons_succ, nth_rotate h₃, list.length_append,
    list.length_cons, list.length, zero_add, hml', h₁, list.nth_concat_length]; refl)

lemma rotate_eq_self_iff_eq_repeat [hα : nonempty α] : ∀ {l : list α},
  (∀ n, l.rotate n = l) ↔ ∃ a, l = list.repeat a l.length
| []     := ⟨λ h, nonempty.elim hα (λ a, ⟨a, by simp⟩), by simp⟩
| (a::l) :=
⟨λ h, ⟨a, list.ext_le (by simp) $ λ n hn h₁,
  begin
    rw [← option.some_inj, ← list.nth_le_nth],
    conv {to_lhs, rw ← h ((list.length (a :: l)) - n)},
    rw [nth_rotate hn, add_tsub_cancel_of_le (le_of_lt hn),
      nat.mod_self, nth_le_repeat], refl
  end⟩,
  λ ⟨a, ha⟩ n, ha.symm ▸ list.ext_le (by simp)
    (λ m hm h,
      have hm' : (m + n) % (list.repeat a (list.length (a :: l))).length < list.length (a :: l),
        by rw list.length_repeat; exact nat.mod_lt _ (nat.succ_pos _),
      by rw [nth_le_repeat, ← option.some_inj, ← list.nth_le_nth, nth_rotate h, list.nth_le_nth,
        nth_le_repeat]; simp * at *)⟩

lemma rotate_repeat (a : α) (n : ℕ) (k : ℕ) :
  (list.repeat a n).rotate k = list.repeat a n :=
let h : nonempty α := ⟨a⟩ in by exactI rotate_eq_self_iff_eq_repeat.mpr ⟨a, by rw length_repeat⟩ k

lemma rotate_one_eq_self_iff_eq_repeat [nonempty α] {l : list α} :
  l.rotate 1 = l ↔ ∃ a : α, l = list.repeat a l.length :=
⟨λ h, rotate_eq_self_iff_eq_repeat.mp (λ n, nat.rec l.rotate_zero
  (λ n hn, by rwa [nat.succ_eq_add_one, ←l.rotate_rotate, hn]) n),
    λ h, rotate_eq_self_iff_eq_repeat.mpr h 1⟩

end list


/-
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 861a26926586cd46ff80264d121cdb6fa0e35cc1
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.BigOperators.Ring
import Mathlib.Algebra.Order.Field.Basic
import Mathlib.Combinatorics.DoubleCounting
import Mathlib.Combinatorics.SetFamily.Shadow
import Mathlib.Data.Rat.Order

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

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 `𝒜`.
* `IsAntichain.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 : ℕ}
/-- 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
  let i : DecidableRel ((. ⊆ .) : Finset α → Finset α → Prop) := fun _ _ => Classical.dec _
  refine' card_mul_le_card_mul' (· ⊆ ·) (fun s hs => _) (fun s hs => _)
  · rw [← h𝒜 hs, ← card_image_of_injOn s.erase_injOn]
    refine' card_le_of_subset _
    simp_rw [image_subset_iff, mem_bipartiteBelow]
    exact fun a ha => ⟨erase_mem_shadow hs ha, erase_subset _ _⟩
  refine' le_trans _ tsub_tsub_le_tsub_add
  rw [← (Set.Sized.shadow h𝒜) hs, ← card_compl, ← card_image_of_injOn (insert_inj_on' _)]
  refine' card_le_of_subset fun t ht => _
  -- porting note: commented out the following line
  -- infer_instance
  rw [mem_bipartiteAbove] at ht
  have : ∅ ∉ 𝒜 := by
    rw [← mem_coe, h𝒜.empty_mem_iff, coe_eq_singleton]
    rintro rfl
    rw [shadow_singleton_empty] at hs
    exact not_mem_empty s hs
  have h := exists_eq_insert_iff.2 ⟨ht.2, by
    rw [(sized_shadow_iff this).1 (Set.Sized.shadow h𝒜) ht.1, (Set.Sized.shadow h𝒜) hs]⟩
  rcases h with ⟨a, ha, rfl⟩
  exact mem_image_of_mem _ (mem_compl.2 ha)
#align finset.card_mul_le_card_shadow_mul Finset.card_mul_le_card_shadow_mul

/-- 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 with 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 α))

/-- `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 α}

theorem mem_falling : s ∈ falling k 𝒜 ↔ (∃ t ∈ 𝒜, s ⊆ t) ∧ s.card = k := by
  simp_rw [falling, mem_sup, mem_powersetLen, exists_and_right]
  aesop
#align finset.mem_falling Finset.mem_falling

variable (𝒜 k)

theorem sized_falling : (falling k 𝒜 : Set (Finset α)).Sized k := fun _ hs => (mem_falling.1 hs).2
#align finset.sized_falling Finset.sized_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

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

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 h : 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⟩, _⟩, a, ha, rfl⟩ := h₁
    refine' h𝒜 (slice_subset h₂) ht _ ((erase_subset _ _).trans hst)
    rintro rfl
    exact not_mem_erase _ _ (hst ha)
#align finset.is_antichain.disjoint_slice_shadow_falling Finset.IsAntichain.disjoint_slice_shadow_falling

/-- 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,
      zero_eq, zero_add, range_one, ge_iff_le, sum_singleton, nonpos_iff_eq_zero, tsub_zero,
      choose_self, cast_one, div_one, cast_le]
    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 (IsAntichain.disjoint_slice_shadow_falling h𝒜), 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 : ℕ}

/-- 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
        Set.Sized.card_le (sized_falling 0 𝒜)
    · 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
      rw [← sum_div, ← Nat.cast_sum, div_le_one] at this
      simp only [cast_le] at this
      rwa [sum_card_slice] at this
      simp only [cast_pos]
      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 finset.is_antichain.sperner Finset.IsAntichain.sperner

end Finset