/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Heather Macbeth
-/
import topology.continuous_function.weierstrass
import analysis.complex.basic

/-!
# The Stone-Weierstrass theorem

If a subalgebra `A` of `C(X, ℝ)`, where `X` is a compact topological space,
separates points, then it is dense.

We argue as follows.

* In any subalgebra `A` of `C(X, ℝ)`, if `f ∈ A`, then `abs f ∈ A.topological_closure`.
  This follows from the Weierstrass approximation theorem on `[-∥f∥, ∥f∥]` by
  approximating `abs` uniformly thereon by polynomials.
* This ensures that `A.topological_closure` is actually a sublattice:
  if it contains `f` and `g`, then it contains the pointwise supremum `f ⊔ g`
  and the pointwise infimum `f ⊓ g`.
* Any nonempty sublattice `L` of `C(X, ℝ)` which separates points is dense,
  by a nice argument approximating a given `f` above and below using separating functions.
  For each `x y : X`, we pick a function `g x y ∈ L` so `g x y x = f x` and `g x y y = f y`.
  By continuity these functions remain close to `f` on small patches around `x` and `y`.
  We use compactness to identify a certain finitely indexed infimum of finitely indexed supremums
  which is then close to `f` everywhere, obtaining the desired approximation.
* Finally we put these pieces together. `L = A.topological_closure` is a nonempty sublattice
  which separates points since `A` does, and so is dense (in fact equal to `⊤`).

We then prove the complex version for self-adjoint subalgebras `A`, by separately approximating
the real and imaginary parts using the real subalgebra of real-valued functions in `A`
(which still separates points, by taking the norm-square of a separating function).

## Future work

Extend to cover the case of subalgebras of the continuous functions vanishing at infinity,
on non-compact spaces.

-/

noncomputable theory

namespace continuous_map

variables {X : Type*} [topological_space X] [compact_space X]

/--
Turn a function `f : C(X, ℝ)` into a continuous map into `set.Icc (-∥f∥) (∥f∥)`,
thereby explicitly attaching bounds.
-/
def attach_bound (f : C(X, ℝ)) : C(X, set.Icc (-∥f∥) (∥f∥)) :=
{ to_fun := λ x, ⟨f x, ⟨neg_norm_le_apply f x, apply_le_norm f x⟩⟩ }

@[simp] lemma attach_bound_apply_coe (f : C(X, ℝ)) (x : X) : ((attach_bound f) x : ℝ) = f x := rfl

lemma polynomial_comp_attach_bound (A : subalgebra ℝ C(X, ℝ)) (f : A) (g : polynomial ℝ) :
  (g.to_continuous_map_on (set.Icc (-∥f∥) ∥f∥)).comp (f : C(X, ℝ)).attach_bound =
    polynomial.aeval f g :=
begin
  ext,
  simp only [continuous_map.comp_coe, function.comp_app,
    continuous_map.attach_bound_apply_coe,
    polynomial.to_continuous_map_on_to_fun,
    polynomial.aeval_subalgebra_coe,
    polynomial.aeval_continuous_map_apply,
    polynomial.to_continuous_map_to_fun],
end

/--
Given a continuous function `f` in a subalgebra of `C(X, ℝ)`, postcomposing by a polynomial
gives another function in `A`.

This lemma proves something slightly more subtle than this:
we take `f`, and think of it as a function into the restricted target `set.Icc (-∥f∥) ∥f∥)`,
and then postcompose with a polynomial function on that interval.
This is in fact the same situation as above, and so also gives a function in `A`.
-/
lemma polynomial_comp_attach_bound_mem (A : subalgebra ℝ C(X, ℝ)) (f : A) (g : polynomial ℝ) :
  (g.to_continuous_map_on (set.Icc (-∥f∥) ∥f∥)).comp (f : C(X, ℝ)).attach_bound ∈ A :=
begin
  rw polynomial_comp_attach_bound,
  apply set_like.coe_mem,
end

theorem comp_attach_bound_mem_closure
  (A : subalgebra ℝ C(X, ℝ)) (f : A) (p : C(set.Icc (-∥f∥) (∥f∥), ℝ)) :
  p.comp (attach_bound f) ∈ A.topological_closure :=
begin
  -- `p` itself is in the closure of polynomials, by the Weierstrass theorem,
  have mem_closure : p ∈ (polynomial_functions (set.Icc (-∥f∥) (∥f∥))).topological_closure :=
    continuous_map_mem_polynomial_functions_closure _ _ p,
  -- and so there are polynomials arbitrarily close.
  have frequently_mem_polynomials := mem_closure_iff_frequently.mp mem_closure,
  -- To prove `p.comp (attached_bound f)` is in the closure of `A`,
  -- we show there are elements of `A` arbitrarily close.
  apply mem_closure_iff_frequently.mpr,
  -- To show that, we pull back the polynomials close to `p`,
  refine ((comp_right_continuous_map ℝ (attach_bound (f : C(X, ℝ)))).continuous_at p).tendsto
    .frequently_map _ _ frequently_mem_polynomials,
  -- but need to show that those pullbacks are actually in `A`.
  rintros _ ⟨g, ⟨-,rfl⟩⟩,
  simp only [set_like.mem_coe, alg_hom.coe_to_ring_hom, comp_right_continuous_map_apply,
    polynomial.to_continuous_map_on_alg_hom_apply],
  apply polynomial_comp_attach_bound_mem,
end

theorem abs_mem_subalgebra_closure (A : subalgebra ℝ C(X, ℝ)) (f : A) :
  (f : C(X, ℝ)).abs ∈ A.topological_closure :=
begin
  let M := ∥f∥,
  let f' := attach_bound (f : C(X, ℝ)),
  let abs : C(set.Icc (-∥f∥) (∥f∥), ℝ) :=
  { to_fun := λ x : set.Icc (-∥f∥) (∥f∥), |(x : ℝ)| },
  change (abs.comp f') ∈ A.topological_closure,
  apply comp_attach_bound_mem_closure,
end

theorem inf_mem_subalgebra_closure (A : subalgebra ℝ C(X, ℝ)) (f g : A) :
  (f : C(X, ℝ)) ⊓ (g : C(X, ℝ)) ∈ A.topological_closure :=
begin
  rw inf_eq,
  refine A.topological_closure.smul_mem
    (A.topological_closure.sub_mem
      (A.topological_closure.add_mem (A.subalgebra_topological_closure f.property)
          (A.subalgebra_topological_closure g.property)) _) _,
  exact_mod_cast abs_mem_subalgebra_closure A _,
end

theorem inf_mem_closed_subalgebra (A : subalgebra ℝ C(X, ℝ)) (h : is_closed (A : set C(X, ℝ)))
  (f g : A) : (f : C(X, ℝ)) ⊓ (g : C(X, ℝ)) ∈ A :=
begin
  convert inf_mem_subalgebra_closure A f g,
  apply set_like.ext',
  symmetry,
  erw closure_eq_iff_is_closed,
  exact h,
end

theorem sup_mem_subalgebra_closure (A : subalgebra ℝ C(X, ℝ)) (f g : A) :
  (f : C(X, ℝ)) ⊔ (g : C(X, ℝ)) ∈ A.topological_closure :=
begin
  rw sup_eq,
  refine A.topological_closure.smul_mem
    (A.topological_closure.add_mem
      (A.topological_closure.add_mem (A.subalgebra_topological_closure f.property)
          (A.subalgebra_topological_closure g.property)) _) _,
  exact_mod_cast abs_mem_subalgebra_closure A _,
end

theorem sup_mem_closed_subalgebra (A : subalgebra ℝ C(X, ℝ)) (h : is_closed (A : set C(X, ℝ)))
  (f g : A) : (f : C(X, ℝ)) ⊔ (g : C(X, ℝ)) ∈ A :=
begin
  convert sup_mem_subalgebra_closure A f g,
  apply set_like.ext',
  symmetry,
  erw closure_eq_iff_is_closed,
  exact h,
end

open_locale topological_space

-- Here's the fun part of Stone-Weierstrass!
theorem sublattice_closure_eq_top
  (L : set C(X, ℝ)) (nA : L.nonempty)
  (inf_mem : ∀ f g ∈ L, f ⊓ g ∈ L) (sup_mem : ∀ f g ∈ L, f ⊔ g ∈ L)
  (sep : L.separates_points_strongly) :
  closure L = ⊤ :=
begin
  -- We start by boiling down to a statement about close approximation.
  apply eq_top_iff.mpr,
  rintros f -,
  refine filter.frequently.mem_closure
    ((filter.has_basis.frequently_iff metric.nhds_basis_ball).mpr (λ ε pos, _)),
  simp only [exists_prop, metric.mem_ball],

  -- It will be helpful to assume `X` is nonempty later,
  -- so we get that out of the way here.
  by_cases nX : nonempty X,
  swap,
  exact ⟨nA.some, (dist_lt_iff pos).mpr (λ x, false.elim (nX ⟨x⟩)), nA.some_spec⟩,

  /-
  The strategy now is to pick a family of continuous functions `g x y` in `A`
  with the property that `g x y x = f x` and `g x y y = f y`
  (this is immediate from `h : separates_points_strongly`)
  then use continuity to see that `g x y` is close to `f` near both `x` and `y`,
  and finally using compactness to produce the desired function `h`
  as a maximum over finitely many `x` of a minimum over finitely many `y` of the `g x y`.
  -/
  dsimp [set.separates_points_strongly] at sep,

  let g : X → X → L := λ x y, (sep f x y).some,
  have w₁ : ∀ x y, g x y x = f x := λ x y, (sep f x y).some_spec.1,
  have w₂ : ∀ x y, g x y y = f y := λ x y, (sep f x y).some_spec.2,

  -- For each `x y`, we define `U x y` to be `{z | f z - ε < g x y z}`,
  -- and observe this is a neighbourhood of `y`.
  let U : X → X → set X := λ x y, {z | f z - ε < g x y z},
  have U_nhd_y : ∀ x y, U x y ∈ 𝓝 y,
  { intros x y,
    refine is_open.mem_nhds _ _,
    { apply is_open_lt; continuity, },
    { rw [set.mem_set_of_eq, w₂],
      exact sub_lt_self _ pos, }, },

  -- Fixing `x` for a moment, we have a family of functions `λ y, g x y`
  -- which on different patches (the `U x y`) are greater than `f z - ε`.
  -- Taking the supremum of these functions
  -- indexed by a finite collection of patches which cover `X`
  -- will give us an element of `A` that is globally greater than `f z - ε`
  -- and still equal to `f x` at `x`.

  -- Since `X` is compact, for every `x` there is some finset `ys t`
  -- so the union of the `U x y` for `y ∈ ys x` still covers everything.
  let ys : Π x, finset X := λ x, (compact_space.elim_nhds_subcover (U x) (U_nhd_y x)).some,
  let ys_w : ∀ x, (⋃ y ∈ ys x, U x y) = ⊤ :=
    λ x, (compact_space.elim_nhds_subcover (U x) (U_nhd_y x)).some_spec,

  have ys_nonempty : ∀ x, (ys x).nonempty :=
    λ x, set.nonempty_of_union_eq_top_of_nonempty _ _ nX (ys_w x),

  -- Thus for each `x` we have the desired `h x : A` so `f z - ε < h x z` everywhere
  -- and `h x x = f x`.
  let h : Π x, L := λ x,
    ⟨(ys x).sup' (ys_nonempty x) (λ y, (g x y : C(X, ℝ))),
      finset.sup'_mem _ sup_mem _ _ _ (λ y _, (g x y).2)⟩,
  have lt_h : ∀ x z, f z - ε < h x z,
  { intros x z,
    obtain ⟨y, ym, zm⟩ := set.exists_set_mem_of_union_eq_top _ _ (ys_w x) z,
    dsimp [h],
    simp only [coe_fn_coe_base', subtype.coe_mk, sup'_coe, finset.sup'_apply, finset.lt_sup'_iff],
    exact ⟨y, ym, zm⟩ },
  have h_eq : ∀ x, h x x = f x,
  { intro x, simp only [coe_fn_coe_base'] at w₁, simp [coe_fn_coe_base', w₁], },

  -- For each `x`, we define `W x` to be `{z | h x z < f z + ε}`,
  let W : Π x, set X := λ x, {z | h x z < f z + ε},
  -- This is still a neighbourhood of `x`.
  have W_nhd : ∀ x, W x ∈ 𝓝 x,
  { intros x,
    refine is_open.mem_nhds _ _,
    { apply is_open_lt; continuity, },
    { dsimp only [W, set.mem_set_of_eq],
      rw h_eq,
      exact lt_add_of_pos_right _ pos}, },

  -- Since `X` is compact, there is some finset `ys t`
  -- so the union of the `W x` for `x ∈ xs` still covers everything.
  let xs : finset X := (compact_space.elim_nhds_subcover W W_nhd).some,
  let xs_w : (⋃ x ∈ xs, W x) = ⊤ :=
    (compact_space.elim_nhds_subcover W W_nhd).some_spec,
  have xs_nonempty : xs.nonempty := set.nonempty_of_union_eq_top_of_nonempty _ _ nX xs_w,

  -- Finally our candidate function is the infimum over `x ∈ xs` of the `h x`.
  -- This function is then globally less than `f z + ε`.
  let k : (L : Type*) :=
    ⟨xs.inf' xs_nonempty (λ x, (h x : C(X, ℝ))),
      finset.inf'_mem _ inf_mem _ _ _ (λ x _, (h x).2)⟩,

  refine ⟨k.1, _, k.2⟩,

  -- We just need to verify the bound, which we do pointwise.
  rw dist_lt_iff pos,
  intro z,

  -- We rewrite into this particular form,
  -- so that simp lemmas about inequalities involving `finset.inf'` can fire.
  rw [(show ∀ a b ε : ℝ, dist a b < ε ↔ a < b + ε ∧ b - ε < a,
    by { intros, simp only [← metric.mem_ball, real.ball_eq_Ioo, set.mem_Ioo, and_comm], })],

  fsplit,
  { dsimp [k],
    simp only [finset.inf'_lt_iff, continuous_map.inf'_apply],
    exact set.exists_set_mem_of_union_eq_top _ _ xs_w z, },
  { dsimp [k],
    simp only [finset.lt_inf'_iff, continuous_map.inf'_apply],
    intros x xm,
    apply lt_h, },
end

/--
The **Stone-Weierstrass Approximation Theorem**,
that a subalgebra `A` of `C(X, ℝ)`, where `X` is a compact topological space,
is dense if it separates points.
-/
theorem subalgebra_topological_closure_eq_top_of_separates_points
  (A : subalgebra ℝ C(X, ℝ)) (w : A.separates_points) :
  A.topological_closure = ⊤ :=
begin
  -- The closure of `A` is closed under taking `sup` and `inf`,
  -- and separates points strongly (since `A` does),
  -- so we can apply `sublattice_closure_eq_top`.
  apply set_like.ext',
  let L := A.topological_closure,
  have n : set.nonempty (L : set C(X, ℝ)) :=
    ⟨(1 : C(X, ℝ)), A.subalgebra_topological_closure A.one_mem⟩,
  convert sublattice_closure_eq_top
    (L : set C(X, ℝ)) n
    (λ f g fm gm, inf_mem_closed_subalgebra L A.is_closed_topological_closure ⟨f, fm⟩ ⟨g, gm⟩)
    (λ f g fm gm, sup_mem_closed_subalgebra L A.is_closed_topological_closure ⟨f, fm⟩ ⟨g, gm⟩)
    (subalgebra.separates_points.strongly
      (subalgebra.separates_points_monotone (A.subalgebra_topological_closure) w)),
  { simp, },
end

/--
An alternative statement of the Stone-Weierstrass theorem.

If `A` is a subalgebra of `C(X, ℝ)` which separates points (and `X` is compact),
every real-valued continuous function on `X` is a uniform limit of elements of `A`.
-/
theorem continuous_map_mem_subalgebra_closure_of_separates_points
  (A : subalgebra ℝ C(X, ℝ)) (w : A.separates_points)
  (f : C(X, ℝ)) :
  f ∈ A.topological_closure :=
begin
  rw subalgebra_topological_closure_eq_top_of_separates_points A w,
  simp,
end

/--
An alternative statement of the Stone-Weierstrass theorem,
for those who like their epsilons.

If `A` is a subalgebra of `C(X, ℝ)` which separates points (and `X` is compact),
every real-valued continuous function on `X` is within any `ε > 0` of some element of `A`.
-/
theorem exists_mem_subalgebra_near_continuous_map_of_separates_points
  (A : subalgebra ℝ C(X, ℝ)) (w : A.separates_points)
  (f : C(X, ℝ)) (ε : ℝ) (pos : 0 < ε) :
  ∃ (g : A), ∥(g : C(X, ℝ)) - f∥ < ε :=
begin
  have w := mem_closure_iff_frequently.mp
    (continuous_map_mem_subalgebra_closure_of_separates_points A w f),
  rw metric.nhds_basis_ball.frequently_iff at w,
  obtain ⟨g, H, m⟩ := w ε pos,
  rw [metric.mem_ball, dist_eq_norm] at H,
  exact ⟨⟨g, m⟩, H⟩,
end

/--
An alternative statement of the Stone-Weierstrass theorem,
for those who like their epsilons and don't like bundled continuous functions.

If `A` is a subalgebra of `C(X, ℝ)` which separates points (and `X` is compact),
every real-valued continuous function on `X` is within any `ε > 0` of some element of `A`.
-/
theorem exists_mem_subalgebra_near_continuous_of_separates_points
  (A : subalgebra ℝ C(X, ℝ)) (w : A.separates_points)
  (f : X → ℝ) (c : continuous f) (ε : ℝ) (pos : 0 < ε) :
  ∃ (g : A), ∀ x, ∥g x - f x∥ < ε :=
begin
  obtain ⟨g, b⟩ := exists_mem_subalgebra_near_continuous_map_of_separates_points A w ⟨f, c⟩ ε pos,
  use g,
  rwa norm_lt_iff _ pos at b,
end

end continuous_map

section complex
open complex

-- Redefine `X`, since for the next few lemmas it need not be compact
variables {X : Type*} [topological_space X]

namespace continuous_map

/-- A real subalgebra of `C(X, ℂ)` is `conj_invariant`, if it contains all its conjugates. -/
def conj_invariant_subalgebra (A : subalgebra ℝ C(X, ℂ)) : Prop :=
A.map (conj_ae.to_alg_hom.comp_left_continuous ℝ conj_cle.continuous) ≤ A

lemma mem_conj_invariant_subalgebra {A : subalgebra ℝ C(X, ℂ)} (hA : conj_invariant_subalgebra A)
  {f : C(X, ℂ)} (hf : f ∈ A) :
  (conj_ae.to_alg_hom.comp_left_continuous ℝ conj_cle.continuous) f ∈ A :=
hA ⟨f, hf, rfl⟩

end continuous_map

open continuous_map

/-- If a conjugation-invariant subalgebra of `C(X, ℂ)` separates points, then the real subalgebra
of its purely real-valued elements also separates points. -/
lemma subalgebra.separates_points.complex_to_real {A : subalgebra ℂ C(X, ℂ)}
  (hA : A.separates_points) (hA' : conj_invariant_subalgebra (A.restrict_scalars ℝ)) :
  ((A.restrict_scalars ℝ).comap'
    (of_real_am.comp_left_continuous ℝ continuous_of_real)).separates_points :=
begin
  intros x₁ x₂ hx,
  -- Let `f` in the subalgebra `A` separate the points `x₁`, `x₂`
  obtain ⟨_, ⟨f, hfA, rfl⟩, hf⟩ := hA hx,
  let F : C(X, ℂ) := f - const (f x₂),
  -- Subtract the constant `f x₂` from `f`; this is still an element of the subalgebra
  have hFA : F ∈ A,
  { refine A.sub_mem hfA _,
    convert A.smul_mem A.one_mem (f x₂),
    ext1,
    simp },
  -- Consider now the function `λ x, |f x - f x₂| ^ 2`
  refine ⟨_, ⟨(⟨complex.norm_sq, continuous_norm_sq⟩ : C(ℂ, ℝ)).comp F, _, rfl⟩, _⟩,
  { -- This is also an element of the subalgebra, and takes only real values
    rw [set_like.mem_coe, subalgebra.mem_comap],
    convert (A.restrict_scalars ℝ).mul_mem (mem_conj_invariant_subalgebra hA' hFA) hFA,
    ext1,
    exact complex.norm_sq_eq_conj_mul_self },
  { -- And it also separates the points `x₁`, `x₂`
    have : f x₁ - f x₂ ≠ 0 := sub_ne_zero.mpr hf,
    simpa using this },
end

variables [compact_space X]

/--
The Stone-Weierstrass approximation theorem, complex version,
that a subalgebra `A` of `C(X, ℂ)`, where `X` is a compact topological space,
is dense if it is conjugation-invariant and separates points.
-/
theorem continuous_map.subalgebra_complex_topological_closure_eq_top_of_separates_points
  (A : subalgebra ℂ C(X, ℂ)) (hA : A.separates_points)
  (hA' : conj_invariant_subalgebra (A.restrict_scalars ℝ)) :
  A.topological_closure = ⊤ :=
begin
  rw algebra.eq_top_iff,
  -- Let `I` be the natural inclusion of `C(X, ℝ)` into `C(X, ℂ)`
  let I : C(X, ℝ) →ₗ[ℝ] C(X, ℂ) := of_real_clm.comp_left_continuous ℝ X,
  -- The main point of the proof is that its range (i.e., every real-valued function) is contained
  -- in the closure of `A`
  have key : I.range ≤ (A.to_submodule.restrict_scalars ℝ).topological_closure,
  { -- Let `A₀` be the subalgebra of `C(X, ℝ)` consisting of `A`'s purely real elements; it is the
    -- preimage of `A` under `I`.  In this argument we only need its submodule structure.
    let A₀ : submodule ℝ C(X, ℝ) := (A.to_submodule.restrict_scalars ℝ).comap I,
    -- By `subalgebra.separates_points.complex_to_real`, this subalgebra also separates points, so
    -- we may apply the real Stone-Weierstrass result to it.
    have SW : A₀.topological_closure = ⊤,
    { have := subalgebra_topological_closure_eq_top_of_separates_points _ (hA.complex_to_real hA'),
      exact congr_arg subalgebra.to_submodule this },
    rw [← submodule.map_top, ← SW],
    -- So it suffices to prove that the image under `I` of the closure of `A₀` is contained in the
    -- closure of `A`, which follows by abstract nonsense
    have h₁ := A₀.topological_closure_map (of_real_clm.comp_left_continuous_compact X),
    have h₂ := (A.to_submodule.restrict_scalars ℝ).map_comap_le I,
    exact h₁.trans (submodule.topological_closure_mono h₂) },
  -- In particular, for a function `f` in `C(X, ℂ)`, the real and imaginary parts of `f` are in the
  -- closure of `A`
  intros f,
  let f_re : C(X, ℝ) := (⟨complex.re, complex.re_clm.continuous⟩ : C(ℂ, ℝ)).comp f,
  let f_im : C(X, ℝ) := (⟨complex.im, complex.im_clm.continuous⟩ : C(ℂ, ℝ)).comp f,
  have h_f_re : I f_re ∈ A.topological_closure := key ⟨f_re, rfl⟩,
  have h_f_im : I f_im ∈ A.topological_closure := key ⟨f_im, rfl⟩,
  -- So `f_re + complex.I • f_im` is in the closure of `A`
  convert A.topological_closure.add_mem h_f_re (A.topological_closure.smul_mem h_f_im complex.I),
  -- And this, of course, is just `f`
  ext; simp [I]
end

end complex


/-
Copyright (c) 2019 Seul Baek. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Seul Baek
-/

/-
Non-constant terms of linear constraints are represented
by storing their coefficients in integer lists.
-/

import data.list.func
import tactic.ring
import tactic.omega.misc

namespace omega
namespace coeffs

open list.func

variable {v : nat → int}

/-- `val_between v as l o` is the value (under valuation `v`) of the term
    obtained taking the term represented by `(0, as)` and dropping all
    subterms that include variables outside the range `[l,l+o)` -/
@[simp] def val_between (v : nat → int) (as : list int) (l : nat) : nat → int
| 0     := 0
| (o+1) := (val_between o) + (get (l+o) as * v (l+o))

@[simp] lemma val_between_nil {l : nat} :
  ∀ m, val_between v [] l m = 0
| 0     := by simp only [val_between]
| (m+1) :=
  by simp only [val_between_nil m, omega.coeffs.val_between,
     get_nil, zero_add, zero_mul, int.default_eq_zero]

/-- Evaluation of the nonconstant component of a normalized linear arithmetic term. -/
def val (v : nat → int) (as : list int) : int :=
val_between v as 0 as.length

@[simp] lemma val_nil : val v [] = 0 := rfl

lemma val_between_eq_of_le {as : list int} {l : nat} :
  ∀ m, as.length ≤ l + m →
  val_between v as l m = val_between v as l (as.length - l)
| 0 h1 :=
  begin rw (nat.sub_eq_zero_iff_le.elim_right _), apply h1 end
| (m+1) h1 :=
  begin
    rw le_iff_eq_or_lt at h1, cases h1,
    { rw [h1, add_comm l, nat.add_sub_cancel] },
    have h2 :  list.length as ≤ l + m,
    { rw ← nat.lt_succ_iff, apply h1 },
    simpa [ get_eq_default_of_le _ h2, zero_mul, add_zero,
      val_between ] using val_between_eq_of_le _ h2
  end

lemma val_eq_of_le {as : list int} {k : nat} :
  as.length ≤ k → val v as = val_between v as 0 k :=
begin
  intro h1, unfold val,
  rw [val_between_eq_of_le k _], refl,
  rw zero_add, exact h1
end

lemma val_between_eq_val_between
  {v w : nat → int} {as bs : list int} {l : nat} :
  ∀ {m}, (∀ x, l ≤ x → x < l + m → v x = w x) →
    (∀ x, l ≤ x → x < l + m → get x as = get x bs) →
    val_between v as l m = val_between w bs l m
| 0 h1 h2 := rfl
| (m+1) h1 h2 :=
  begin
    unfold val_between,
    have h3 : l + m < l + (m + 1),
    { rw ← add_assoc, apply lt_add_one },
    apply fun_mono_2,
    apply val_between_eq_val_between; intros x h4 h5,
    { apply h1 _ h4 (lt_trans h5 h3) },
    { apply h2 _ h4 (lt_trans h5 h3) },
    rw [h1 _ _ h3, h2 _ _ h3];
    apply nat.le_add_right
  end

open_locale list.func

lemma val_between_set {a : int} {l n : nat} :
  ∀ {m}, l ≤ n → n < l + m → val_between v ([] {n ↦ a}) l m = a * v n
| 0 h1 h2 :=
  begin exfalso, apply lt_irrefl l (lt_of_le_of_lt h1 h2) end
| (m+1) h1 h2 :=
  begin
    rw [← add_assoc, nat.lt_succ_iff, le_iff_eq_or_lt] at h2,
    cases h2; unfold val_between,
    { have h3 : val_between v ([] {l + m ↦ a}) l m = 0,
      { apply @eq.trans _ _ (val_between v [] l m),
        { apply val_between_eq_val_between,
          { intros, refl },
          { intros x h4 h5, rw [get_nil,
            get_set_eq_of_ne, get_nil],
            apply ne_of_lt h5 } },
        apply val_between_nil },
      rw h2,
      simp only [h3, zero_add, list.func.get_set] },
    { have h3 : l + m ≠ n,
      { apply ne_of_gt h2 },
      rw [@val_between_set m h1 h2, get_set_eq_of_ne _ _ h3],
      simp only [h3, get_nil, add_zero, zero_mul, int.default_eq_zero] }
  end

@[simp] lemma val_set {m : nat} {a : int} :
  val v ([] {m ↦ a}) = a * v m :=
begin
  apply val_between_set, apply zero_le,
  apply lt_of_lt_of_le (lt_add_one _),
  simp only [length_set, zero_add, le_max_right],
  apply_instance,
end

lemma val_between_neg {as : list int} {l : nat} :
  ∀ {o}, val_between v (neg as) l o = -(val_between v as l o)
| 0 := rfl
| (o+1) :=
  begin
    unfold val_between,
    rw [neg_add, neg_mul_eq_neg_mul],
    apply fun_mono_2,
    apply val_between_neg,
    apply fun_mono_2 _ rfl,
    apply get_neg
  end

@[simp] lemma val_neg {as : list int} :
   val v (neg as) = -(val v as) :=
by simpa only [val, length_neg] using val_between_neg

lemma val_between_add {is js : list int} {l : nat} :
  ∀ m, val_between v (add is js) l m =
  (val_between v is l m) + (val_between v js l m)
| 0     := rfl
| (m+1) :=
  by { simp only [val_between, val_between_add m,
      list.func.get, get_add], ring }

@[simp] lemma val_add {is js : list int} :
  val v (add is js) = (val v is) + (val v js) :=
begin
  unfold val,
  rw val_between_add, apply fun_mono_2;
  apply val_between_eq_of_le;
  rw [zero_add, length_add],
  apply le_max_left, apply le_max_right
end

lemma val_between_sub {is js : list int} {l : nat} :
  ∀ m, val_between v (sub is js) l m =
  (val_between v is l m) - (val_between v js l m)
| 0 := rfl
| (m+1) :=
  by { simp only [val_between, val_between_sub m,
      list.func.get, get_sub], ring }

@[simp] lemma val_sub {is js : list int} :
  val v (sub is js) = (val v is) - (val v js) :=
begin
  unfold val,
  rw val_between_sub,
  apply fun_mono_2;
  apply val_between_eq_of_le;
  rw [zero_add, length_sub],
  apply le_max_left,
  apply le_max_right
end

/-- `val_except k v as` is the value (under valuation `v`) of the term
    obtained taking the term represented by `(0, as)` and dropping the
    subterm that includes the `k`th variable. -/
def val_except (k : nat) (v : nat → int) (as) :=
val_between v as 0 k + val_between v as (k+1) (as.length - (k+1))

lemma val_except_eq_val_except
  {k : nat} {is js : list int} {v w : nat → int} :
  (∀ x ≠ k, v x = w x) → (∀ x ≠ k, get x is = get x js) →
  val_except k v is = val_except k w js :=
begin
  intros h1 h2, unfold val_except,
  apply fun_mono_2,
  { apply val_between_eq_val_between;
    intros x h3 h4;
    [ {apply h1}, {apply h2} ];
    apply ne_of_lt;
    rw zero_add at h4;
    apply h4 },
  { repeat { rw ← val_between_eq_of_le
      ((max is.length js.length) - (k+1)) },
    { apply val_between_eq_val_between;
      intros x h3 h4;
      [ {apply h1}, {apply h2} ];
      apply ne.symm;
      apply ne_of_lt;
      rw nat.lt_iff_add_one_le;
      exact h3 },
    repeat { rw add_comm,
             apply le_trans _ (nat.le_sub_add _ _),
            { apply le_max_right <|> apply le_max_left } } }
end

open_locale omega

lemma val_except_update_set
  {n : nat} {as : list int} {i j : int} :
  val_except n (v⟨n ↦ i⟩) (as {n ↦ j}) = val_except n v as :=
by apply val_except_eq_val_except update_eq_of_ne (get_set_eq_of_ne _)

lemma val_between_add_val_between {as : list int} {l m : nat} :
  ∀ {n}, val_between v as l m + val_between v as (l+m) n =
  val_between v as l (m+n)
| 0 := by simp only [val_between, add_zero]
| (n+1) :=
  begin
    rw ← add_assoc,
    unfold val_between,
    rw add_assoc,
    rw ← @val_between_add_val_between n,
    ring,
  end

lemma val_except_add_eq (n : nat) {as : list int} :
  (val_except n v as) + ((get n as) * (v n)) = val v as :=
begin
  unfold val_except, unfold val,
  by_cases h1 : n + 1 ≤ as.length,
  { have h4 := @val_between_add_val_between v as 0 (n+1) (as.length - (n+1)),
    have h5 : n + 1 + (as.length - (n + 1)) = as.length,
    { rw [add_comm, nat.sub_add_cancel h1] },
    rw h5 at h4, apply eq.trans _ h4,
     simp only [val_between, zero_add], ring },
  have h2 : (list.length as - (n + 1)) = 0,
  { apply nat.sub_eq_zero_of_le
    (le_trans (not_lt.1 h1) (nat.le_add_right _ _)) },
  have h3 : val_between v as 0 (list.length as) =
            val_between v as 0 (n + 1),
  { simpa only [val] using @val_eq_of_le v as (n+1)
      (le_trans (not_lt.1 h1) (nat.le_add_right _ _)) },
  simp only [add_zero, val_between, zero_add, h2, h3]
end

@[simp] lemma val_between_map_mul {i : int} {as: list int} {l : nat} :
  ∀ {m}, val_between v (list.map ((*) i) as) l m = i * val_between v as l m
| 0     := by simp only [val_between, mul_zero, list.map]
| (m+1) :=
  begin
    unfold val_between,
    rw [@val_between_map_mul m, mul_add],
    apply fun_mono_2 rfl,
    by_cases h1 : l + m < as.length,
    { rw [get_map h1, mul_assoc] },
    rw not_lt at h1,
    rw [get_eq_default_of_le, get_eq_default_of_le];
    try {simp}; apply h1
  end

lemma forall_val_dvd_of_forall_mem_dvd {i : int} {as : list int} :
  (∀ x ∈ as, i ∣ x) → (∀ n, i ∣ get n as) | h1 n :=
by { apply forall_val_of_forall_mem _ h1,
     apply dvd_zero }

lemma dvd_val_between {i} {as: list int} {l : nat} :
  ∀ {m}, (∀ x ∈ as, i ∣ x) → (i ∣ val_between v as l m)
| 0 h1 := dvd_zero _
| (m+1) h1 :=
  begin
    unfold val_between,
    apply dvd_add,
    apply dvd_val_between h1,
    apply dvd_mul_of_dvd_left,
    by_cases h2 : get (l+m) as = 0,
    { rw h2, apply dvd_zero },
    apply h1, apply mem_get_of_ne_zero h2
  end

lemma dvd_val {as : list int} {i : int} :
  (∀ x ∈ as, i ∣ x) → (i ∣ val v as) := by apply dvd_val_between

@[simp] lemma val_between_map_div
  {as: list int} {i : int} {l : nat} (h1 : ∀ x ∈ as, i ∣ x) :
  ∀ {m}, val_between v (list.map (λ x, x / i) as) l m = (val_between v as l m) / i
| 0     := by simp only [int.zero_div, val_between, list.map]
| (m+1) :=
  begin
    unfold val_between,
    rw [@val_between_map_div m, int.add_div_of_dvd_right],
    apply fun_mono_2 rfl,
    { apply calc get (l + m) (list.map (λ (x : ℤ), x / i) as) * v (l + m)
          = ((get (l + m) as) / i) * v (l + m) :
            begin
              apply fun_mono_2 _ rfl,
              rw get_map',
              apply int.zero_div
            end
      ... =  get (l + m) as * v (l + m) / i :
            begin
              repeat {rw mul_comm _ (v (l+m))},
              rw int.mul_div_assoc,
              apply forall_val_dvd_of_forall_mem_dvd h1
            end },
    apply dvd_mul_of_dvd_left,
    apply forall_val_dvd_of_forall_mem_dvd h1,
  end

@[simp] lemma val_map_div {as : list int} {i : int} :
  (∀ x ∈ as, i ∣ x) → val v (list.map (λ x, x / i) as) = (val v as) / i :=
by {intro h1, simpa only [val, list.length_map] using val_between_map_div h1}

lemma val_between_eq_zero {is: list int} {l : nat} :
  ∀ {m}, (∀ x : int, x ∈ is → x = 0) → val_between v is l m = 0
| 0 h1 := rfl
| (m+1) h1 :=
  begin
    have h2 := @forall_val_of_forall_mem _ _ is (λ x, x = 0) rfl h1,
    simpa only [val_between, h2 (l+m), zero_mul, add_zero]
      using @val_between_eq_zero m h1,
  end

lemma val_eq_zero {is : list int} :
  (∀ x : int, x ∈ is → x = 0) → val v is = 0 :=
by apply val_between_eq_zero

end coeffs

end omega


/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.big_operators.order
import Mathlib.tactic.default
import Mathlib.data.nat.prime
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Divisor finsets

This file defines sets of divisors of a natural number. This is particularly useful as background
for defining Dirichlet convolution.

## Main Definitions
Let `n : ℕ`. All of the following definitions are in the `nat` namespace:
 * `divisors n` is the `finset` of natural numbers that divide `n`.
 * `proper_divisors n` is the `finset` of natural numbers that divide `n`, other than `n`.
 * `divisors_antidiagonal n` is the `finset` of pairs `(x,y)` such that `x * y = n`.
 * `perfect n` is true when `n` is positive and the sum of `proper_divisors n` is `n`.

## Implementation details
 * `divisors 0`, `proper_divisors 0`, and `divisors_antidiagonal 0` are defined to be `∅`.

## Tags
divisors, perfect numbers

-/

namespace nat

/-- `divisors n` is the `finset` of divisors of `n`. As a special case, `divisors 0 = ∅`. -/
def divisors (n : ℕ) : finset ℕ :=
  finset.filter (fun (x : ℕ) => x ∣ n) (finset.Ico 1 (n + 1))

/-- `proper_divisors n` is the `finset` of divisors of `n`, other than `n`.
  As a special case, `proper_divisors 0 = ∅`. -/
def proper_divisors (n : ℕ) : finset ℕ :=
  finset.filter (fun (x : ℕ) => x ∣ n) (finset.Ico 1 n)

/-- `divisors_antidiagonal n` is the `finset` of pairs `(x,y)` such that `x * y = n`.
  As a special case, `divisors_antidiagonal 0 = ∅`. -/
def divisors_antidiagonal (n : ℕ) : finset (ℕ × ℕ) :=
  finset.filter (fun (x : ℕ × ℕ) => prod.fst x * prod.snd x = n)
    (finset.product (finset.Ico 1 (n + 1)) (finset.Ico 1 (n + 1)))

theorem proper_divisors.not_self_mem {n : ℕ} : ¬n ∈ proper_divisors n := sorry

@[simp] theorem mem_proper_divisors {n : ℕ} {m : ℕ} : n ∈ proper_divisors m ↔ n ∣ m ∧ n < m := sorry

theorem divisors_eq_proper_divisors_insert_self_of_pos {n : ℕ} (h : 0 < n) : divisors n = insert n (proper_divisors n) := sorry

@[simp] theorem mem_divisors {n : ℕ} {m : ℕ} : n ∈ divisors m ↔ n ∣ m ∧ m ≠ 0 := sorry

theorem dvd_of_mem_divisors {n : ℕ} {m : ℕ} (h : n ∈ divisors m) : n ∣ m := sorry

@[simp] theorem mem_divisors_antidiagonal {n : ℕ} {x : ℕ × ℕ} : x ∈ divisors_antidiagonal n ↔ prod.fst x * prod.snd x = n ∧ n ≠ 0 := sorry

theorem divisor_le {n : ℕ} {m : ℕ} : n ∈ divisors m → n ≤ m := sorry

theorem divisors_subset_of_dvd {n : ℕ} {m : ℕ} (hzero : n ≠ 0) (h : m ∣ n) : divisors m ⊆ divisors n :=
  iff.mpr finset.subset_iff
    fun (x : ℕ) (hx : x ∈ divisors m) =>
      iff.mpr mem_divisors { left := dvd.trans (and.left (iff.mp mem_divisors hx)) h, right := hzero }

theorem divisors_subset_proper_divisors {n : ℕ} {m : ℕ} (hzero : n ≠ 0) (h : m ∣ n) (hdiff : m ≠ n) : divisors m ⊆ proper_divisors n := sorry

@[simp] theorem divisors_zero : divisors 0 = ∅ := sorry

@[simp] theorem proper_divisors_zero : proper_divisors 0 = ∅ := sorry

theorem proper_divisors_subset_divisors {n : ℕ} : proper_divisors n ⊆ divisors n := sorry

@[simp] theorem divisors_one : divisors 1 = singleton 1 := sorry

@[simp] theorem proper_divisors_one : proper_divisors 1 = ∅ := sorry

theorem pos_of_mem_divisors {n : ℕ} {m : ℕ} (h : m ∈ divisors n) : 0 < m := sorry

theorem pos_of_mem_proper_divisors {n : ℕ} {m : ℕ} (h : m ∈ proper_divisors n) : 0 < m :=
  pos_of_mem_divisors (proper_divisors_subset_divisors h)

theorem one_mem_proper_divisors_iff_one_lt {n : ℕ} : 1 ∈ proper_divisors n ↔ 1 < n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (1 ∈ proper_divisors n ↔ 1 < n)) (propext mem_proper_divisors)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (1 ∣ n ∧ 1 < n ↔ 1 < n)) (propext (and_iff_right (one_dvd n))))) (iff.refl (1 < n)))

@[simp] theorem divisors_antidiagonal_zero : divisors_antidiagonal 0 = ∅ := sorry

@[simp] theorem divisors_antidiagonal_one : divisors_antidiagonal 1 = singleton (1, 1) := sorry

theorem swap_mem_divisors_antidiagonal {n : ℕ} {x : ℕ × ℕ} (h : x ∈ divisors_antidiagonal n) : prod.swap x ∈ divisors_antidiagonal n := sorry

theorem fst_mem_divisors_of_mem_antidiagonal {n : ℕ} {x : ℕ × ℕ} (h : x ∈ divisors_antidiagonal n) : prod.fst x ∈ divisors n := sorry

theorem snd_mem_divisors_of_mem_antidiagonal {n : ℕ} {x : ℕ × ℕ} (h : x ∈ divisors_antidiagonal n) : prod.snd x ∈ divisors n := sorry

@[simp] theorem map_swap_divisors_antidiagonal {n : ℕ} : finset.map (function.embedding.mk prod.swap (function.right_inverse.injective prod.swap_right_inverse))
    (divisors_antidiagonal n) =
  divisors_antidiagonal n := sorry

theorem sum_divisors_eq_sum_proper_divisors_add_self {n : ℕ} : (finset.sum (divisors n) fun (i : ℕ) => i) = (finset.sum (proper_divisors n) fun (i : ℕ) => i) + n := sorry

/-- `n : ℕ` is perfect if and only the sum of the proper divisors of `n` is `n` and `n`
  is positive. -/
def perfect (n : ℕ) :=
  (finset.sum (proper_divisors n) fun (i : ℕ) => i) = n ∧ 0 < n

theorem perfect_iff_sum_proper_divisors {n : ℕ} (h : 0 < n) : perfect n ↔ (finset.sum (proper_divisors n) fun (i : ℕ) => i) = n :=
  and_iff_left h

theorem perfect_iff_sum_divisors_eq_two_mul {n : ℕ} (h : 0 < n) : perfect n ↔ (finset.sum (divisors n) fun (i : ℕ) => i) = bit0 1 * n := sorry

theorem mem_divisors_prime_pow {p : ℕ} (pp : prime p) (k : ℕ) {x : ℕ} : x ∈ divisors (p ^ k) ↔ ∃ (j : ℕ), ∃ (H : j ≤ k), x = p ^ j := sorry

theorem prime.divisors {p : ℕ} (pp : prime p) : divisors p = insert 1 (singleton p) := sorry

theorem prime.proper_divisors {p : ℕ} (pp : prime p) : proper_divisors p = singleton 1 := sorry

theorem divisors_prime_pow {p : ℕ} (pp : prime p) (k : ℕ) : divisors (p ^ k) =
  finset.map (function.embedding.mk (pow p) (pow_right_injective (prime.two_le pp))) (finset.range (k + 1)) := sorry

theorem eq_proper_divisors_of_subset_of_sum_eq_sum {n : ℕ} {s : finset ℕ} (hsub : s ⊆ proper_divisors n) : ((finset.sum s fun (x : ℕ) => x) = finset.sum (proper_divisors n) fun (x : ℕ) => x) → s = proper_divisors n := sorry

theorem sum_proper_divisors_dvd {n : ℕ} (h : (finset.sum (proper_divisors n) fun (x : ℕ) => x) ∣ n) : (finset.sum (proper_divisors n) fun (x : ℕ) => x) = 1 ∨ (finset.sum (proper_divisors n) fun (x : ℕ) => x) = n := sorry

@[simp] theorem prime.sum_proper_divisors {α : Type u_1} [add_comm_monoid α] {p : ℕ} {f : ℕ → α} (h : prime p) : (finset.sum (proper_divisors p) fun (x : ℕ) => f x) = f 1 := sorry

@[simp] theorem prime.sum_divisors {α : Type u_1} [add_comm_monoid α] {p : ℕ} {f : ℕ → α} (h : prime p) : (finset.sum (divisors p) fun (x : ℕ) => f x) = f p + f 1 := sorry

theorem proper_divisors_eq_singleton_one_iff_prime {n : ℕ} : proper_divisors n = singleton 1 ↔ prime n := sorry

theorem sum_proper_divisors_eq_one_iff_prime {n : ℕ} : (finset.sum (proper_divisors n) fun (x : ℕ) => x) = 1 ↔ prime n := sorry

@[simp] theorem prod_divisors_prime {α : Type u_1} [comm_monoid α] {p : ℕ} {f : ℕ → α} (h : prime p) : (finset.prod (divisors p) fun (x : ℕ) => f x) = f p * f 1 :=
  prime.sum_divisors h

@[simp] theorem sum_divisors_prime_pow {α : Type u_1} [add_comm_monoid α] {k : ℕ} {p : ℕ} {f : ℕ → α} (h : prime p) : (finset.sum (divisors (p ^ k)) fun (x : ℕ) => f x) = finset.sum (finset.range (k + 1)) fun (x : ℕ) => f (p ^ x) := sorry

@[simp] theorem prod_divisors_prime_pow {α : Type u_1} [comm_monoid α] {k : ℕ} {p : ℕ} {f : ℕ → α} (h : prime p) : (finset.prod (divisors (p ^ k)) fun (x : ℕ) => f x) = finset.prod (finset.range (k + 1)) fun (x : ℕ) => f (p ^ x) :=
  sum_divisors_prime_pow h

@[simp] theorem filter_dvd_eq_divisors {n : ℕ} (h : n ≠ 0) : finset.filter (fun (x : ℕ) => x ∣ n) (finset.range (Nat.succ n)) = divisors n := sorry


import Mathlib.Algebra.BigOperators.Intervals
import Mathlib.Algebra.BigOperators.Ring
import Mathlib.Data.Nat.Prime
import Mathlib.Algebra.Associated
import Mathlib.Data.Int.Basic
import Mathlib.Tactic.Ring

/-
Hungarian Mathematical Olympiad 1998, Problem 6

Let x, y, z be integers with z > 1. Show that

 (x + 1)² + (x + 2)² + ... + (x + 99)² ≠ yᶻ.
-/

open BigOperators

lemma sum_range_square_mul_six (n : ℕ) :
    (∑i in Finset.range n, (i+1)^2) * 6 = n * (n + 1) * (2*n + 1) := by
  induction n with
  | zero => rfl
  | succ n ih =>
    have h : n.succ = n + 1 := rfl
    rw[Finset.sum_range_succ, add_mul, ih, h]
    ring_nf

lemma sum_range_square (n : ℕ) :
    ∑i in Finset.range n, (i+1)^2 = n * (n + 1) * (2*n + 1)/6 :=
  by rw [← sum_range_square_mul_six n, Nat.mul_div_cancel]
     norm_num

lemma cast_sum_square (n : ℕ) :
  ∑i in Finset.range n, ((i:ℤ)+1)^2 =
   (((∑i in Finset.range n, (i+1)^2):ℕ) :ℤ) := by norm_cast

theorem hungary1998_q6 (x y : ℤ) (z : ℕ) (hz : 1 < z) :
    (∑ i in Finset.range 99, (x + i + 1)^2) ≠ y^z := by
  -- Suppose (x + 1)² + (x + 2)² + ... + (x + 99)² = yᶻ.

  intro he

  -- We notice that
  -- y^z = (x + 1)² + (x + 2)² + ... + (x + 99)²
  --     = 99x² + 2(1 + 2 + ... + 99)x + (1² + 2² + ... + 99²)
  --     = 99x² + 2[(99 ⬝ 100)/2]x + (99 ⬝ 100 ⬝ 199)/6
  --     = 33(3x² + 300x + 50 ⬝ 199).

  have h2 : ∑ i in Finset.range 99, (x^2) = 99 * x^2 := by norm_num

  have h3 : ∑ i in Finset.range 99, (2 * x * ((i:ℤ) + 1)) =
         2 * x * ∑ i in Finset.range 99, ((i:ℤ) + 1) := Finset.mul_sum.symm

  have h4 : ∑ i in Finset.range 99, ((i:ℤ) + 1) =
          ∑ i in Finset.range 100, (i:ℤ) := by
    rw[@Finset.sum_range_succ' _ _ _ 99]
    rfl

  have h5 : ∑ i in Finset.range 100, (i:ℤ) = 99 * 100 / 2 := by
    rw[←Nat.cast_sum, Finset.sum_range_id]; norm_num

  have h6 : ∑ i in Finset.range 99, ((i:ℤ) + 1)^2 = (99 * 100 * 199)/6 := by
    rw[cast_sum_square, sum_range_square]; norm_num

  have hnn1 : (99:ℤ) * 100 / 2 = 99 * 50 := by norm_num
  have hnn2 : ((99:ℤ) * 100 * 199)/6 = 33 * 50 * 199 := by norm_num

  have h7 := calc y^z
      = ∑ i in Finset.range 99, ((x + i) + 1)^2 := he.symm
    _ = ∑ i in Finset.range 99,
          (x^2 + 2 * x * ((i:ℤ) + 1) + ((i:ℤ) + 1)^2) :=
               by with_reducible congr; funext; ring
    _ = ∑ i in Finset.range 99, (x^2 + 2 * x * ((i:ℤ) + 1)) +
         ∑ i in Finset.range 99, (((i:ℤ) + 1)^2) := Finset.sum_add_distrib
    _ = ∑ i in Finset.range 99, x^2 +
          ∑ i in Finset.range 99, (2 * x * ((i:ℤ) + 1)) +
         ∑ i in Finset.range 99, (((i:ℤ) + 1)^2) := by rw[Finset.sum_add_distrib]
    _ = 99 * x^2 + 2 * x * (99 * 100 / 2) +  (99 * 100 * 199)/6
        := by rw[h2, h3, h4, h5, h6]
    _ = 3 * (11 * (3 * x^2 + 300 * x + 50 * 199)) := by rw[hnn1,hnn2]; ring

  -- which implies that 3∣y.
  have h8 : 3 ∣ y^z := Dvd.intro _ (Eq.symm h7)
  have h9 : 3 ∣ y := Prime.dvd_of_dvd_pow Int.prime_three h8

  obtain ⟨k,hk⟩ := h9
  rw[hk] at h7

  cases z with | zero => exact Nat.not_lt_zero 1 hz | succ z =>
  cases z with | zero => exact Nat.lt_asymm hz hz | succ z =>
  rw[pow_succ,pow_succ] at h7

  -- Since z ≥ 2, 3²∣yᶻ, but 3² does not divide
  -- 33(3x² + 300x + 50 ⬝ 199), contradiction.

  have h10 : 3 * k * (3 * k * (3 * k) ^ z) = 3 * (k * (3 * k * (3 * k) ^ z))
       := by ring
  rw[h10] at h7
  have h11 : (3:ℤ) ≠ 0 := by norm_num
  have h12 : k * (3 * k * (3 * k) ^ z) = (11 * (3 * x ^ 2 + 300 * x + 50 * 199)) :=
    (mul_right_inj' h11).mp h7
  have h14 : (k * (3 * k * (3 * k) ^ z)) = (3 * (k * k * (3 * k) ^ z)) :=
    by ring
  have h16 : 11 * (3 * x ^ 2 + 300 * x + 50 * 199) =
    3 * (11 * (x ^ 2 + 100 * x + 3316) + 7) + 1 := by ring
  rw[h14,h16] at h12

  have h18 : (3 * (k * k * (3 * k) ^ z)) % 3 =
    (3 * (11 * (x ^ 2 + 100 * x + 3316) + 7) + 1) % 3 :=
    congr_fun (congr_arg HMod.hMod h12) 3

  have h19 : (3 * (11 * (x ^ 2 + 100 * x + 3316) + 7) + 1) % 3 =
     (((3 * (11 * (x ^ 2 + 100 * x + 3316) + 7))% 3) + (1%3)) % 3 :=
   Int.add_emod _ _ _

  rw[h19] at h18
  norm_num at h18


@[simp] def List.count [DecidableEq α] : List α → α → Nat
  | [], _    => 0
  | a::as, b => if a = b then as.count b + 1 else as.count b

inductive StarsAndBars : Nat → Nat → Type where
  | nil  : StarsAndBars 0 0
  | star : StarsAndBars s b → StarsAndBars (s+1) b
  | bar  : StarsAndBars s b → StarsAndBars s (b+1)

namespace StarsAndBars

namespace Ex1

def toList : StarsAndBars s b → { bs : List Bool // bs.count false = s ∧ bs.count true = b }
  | nil    => ⟨[], by simp⟩
  | star h => ⟨false :: toList h, by simp [(toList h).2]⟩
  | bar  h => ⟨true :: toList h, by simp [(toList h).2]⟩

theorem toList_star (h : StarsAndBars s b) (h') : toList (star h) = ⟨false :: toList h, h'⟩ := by
  rfl

theorem toList_bar (h : StarsAndBars s b) (h') : toList (bar h) = ⟨true :: toList h, h'⟩ := by
  rfl

end Ex1

/- Same example with explicit proofs -/
namespace Ex2

theorem toList_star_proof (h : bs.count false = s ∧ bs.count true = b) : (false :: bs).count false = s.succ ∧ (false :: bs).count true = b := by
  simp [*]

theorem toList_bar_proof (h : bs.count false = s ∧ bs.count true = b) : (true :: bs).count false = s ∧ (true :: bs).count true = b.succ := by
  simp [*]

def toList : StarsAndBars s b → { bs : List Bool // bs.count false = s ∧ bs.count true = b }
  | nil    => ⟨[], by simp⟩
  | star h => ⟨false :: toList h, toList_star_proof (toList h).property⟩
  | bar  h => ⟨true :: toList h,  toList_bar_proof (toList h).property⟩

theorem toList_star (h : StarsAndBars s b) : toList (star h) = ⟨false :: toList h, toList_star_proof (toList h).property⟩ := by
  rfl

theorem toList_bar (h : StarsAndBars s b) : toList (bar h) = ⟨true :: toList h, toList_bar_proof (toList h).property⟩ := by
  rfl

end Ex2

end StarsAndBars


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

! This file was ported from Lean 3 source module analysis.matrix
! leanprover-community/mathlib commit 46b633fd842bef9469441c0209906f6dddd2b4f5
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.NormedSpace.Basic
import Mathbin.Analysis.NormedSpace.PiLp
import Mathbin.Analysis.InnerProductSpace.PiL2

/-!
# Matrices as a normed space

In this file we provide the following non-instances for norms on matrices:

* The elementwise norm:

  * `matrix.seminormed_add_comm_group`
  * `matrix.normed_add_comm_group`
  * `matrix.normed_space`

* The Frobenius norm:

  * `matrix.frobenius_seminormed_add_comm_group`
  * `matrix.frobenius_normed_add_comm_group`
  * `matrix.frobenius_normed_space`
  * `matrix.frobenius_normed_ring`
  * `matrix.frobenius_normed_algebra`

* The $L^\infty$ operator norm:

  * `matrix.linfty_op_seminormed_add_comm_group`
  * `matrix.linfty_op_normed_add_comm_group`
  * `matrix.linfty_op_normed_space`
  * `matrix.linfty_op_non_unital_semi_normed_ring`
  * `matrix.linfty_op_semi_normed_ring`
  * `matrix.linfty_op_non_unital_normed_ring`
  * `matrix.linfty_op_normed_ring`
  * `matrix.linfty_op_normed_algebra`

These are not declared as instances because there are several natural choices for defining the norm
of a matrix.
-/

noncomputable section

open BigOperators NNReal Matrix

namespace Matrix

variable {R l m n α β : Type _} [Fintype l] [Fintype m] [Fintype n]

/-! ### The elementwise supremum norm -/

section LinfLinf

section SeminormedAddCommGroup

variable [SeminormedAddCommGroup α] [SeminormedAddCommGroup β]

/-- Seminormed group instance (using sup norm of sup norm) for matrices over a seminormed group. Not
declared as an instance because there are several natural choices for defining the norm of a
matrix. -/
protected def seminormedAddCommGroup : SeminormedAddCommGroup (Matrix m n α) :=
  Pi.seminormedAddCommGroup
#align matrix.seminormed_add_comm_group Matrix.seminormedAddCommGroup

attribute [local instance] Matrix.seminormedAddCommGroup

theorem norm_le_iff {r : ℝ} (hr : 0 ≤ r) {A : Matrix m n α} : ‖A‖ ≤ r ↔ ∀ i j, ‖A i j‖ ≤ r := by
  simp [pi_norm_le_iff_of_nonneg hr]
#align matrix.norm_le_iff Matrix.norm_le_iff

theorem nnnorm_le_iff {r : ℝ≥0} {A : Matrix m n α} : ‖A‖₊ ≤ r ↔ ∀ i j, ‖A i j‖₊ ≤ r := by
  simp [pi_nnnorm_le_iff]
#align matrix.nnnorm_le_iff Matrix.nnnorm_le_iff

theorem norm_lt_iff {r : ℝ} (hr : 0 < r) {A : Matrix m n α} : ‖A‖ < r ↔ ∀ i j, ‖A i j‖ < r := by
  simp [pi_norm_lt_iff hr]
#align matrix.norm_lt_iff Matrix.norm_lt_iff

theorem nnnorm_lt_iff {r : ℝ≥0} (hr : 0 < r) {A : Matrix m n α} : ‖A‖₊ < r ↔ ∀ i j, ‖A i j‖₊ < r :=
  by simp [pi_nnnorm_lt_iff hr]
#align matrix.nnnorm_lt_iff Matrix.nnnorm_lt_iff

theorem norm_entry_le_entrywise_sup_norm (A : Matrix m n α) {i : m} {j : n} : ‖A i j‖ ≤ ‖A‖ :=
  (norm_le_pi_norm (A i) j).trans (norm_le_pi_norm A i)
#align matrix.norm_entry_le_entrywise_sup_norm Matrix.norm_entry_le_entrywise_sup_norm

theorem nnnorm_entry_le_entrywise_sup_nnnorm (A : Matrix m n α) {i : m} {j : n} : ‖A i j‖₊ ≤ ‖A‖₊ :=
  (nnnorm_le_pi_nnnorm (A i) j).trans (nnnorm_le_pi_nnnorm A i)
#align matrix.nnnorm_entry_le_entrywise_sup_nnnorm Matrix.nnnorm_entry_le_entrywise_sup_nnnorm

@[simp]
theorem nnnorm_map_eq (A : Matrix m n α) (f : α → β) (hf : ∀ a, ‖f a‖₊ = ‖a‖₊) :
    ‖A.map f‖₊ = ‖A‖₊ := by simp_rw [Pi.nnnorm_def, Matrix.map_apply, hf]
#align matrix.nnnorm_map_eq Matrix.nnnorm_map_eq

@[simp]
theorem norm_map_eq (A : Matrix m n α) (f : α → β) (hf : ∀ a, ‖f a‖ = ‖a‖) : ‖A.map f‖ = ‖A‖ :=
  (congr_arg (coe : ℝ≥0 → ℝ) <| nnnorm_map_eq A f fun a => Subtype.ext <| hf a : _)
#align matrix.norm_map_eq Matrix.norm_map_eq

@[simp]
theorem nnnorm_transpose (A : Matrix m n α) : ‖Aᵀ‖₊ = ‖A‖₊ :=
  by
  simp_rw [Pi.nnnorm_def]
  exact Finset.sup_comm _ _ _
#align matrix.nnnorm_transpose Matrix.nnnorm_transpose

@[simp]
theorem norm_transpose (A : Matrix m n α) : ‖Aᵀ‖ = ‖A‖ :=
  congr_arg coe <| nnnorm_transpose A
#align matrix.norm_transpose Matrix.norm_transpose

@[simp]
theorem nnnorm_conjTranspose [StarAddMonoid α] [NormedStarGroup α] (A : Matrix m n α) :
    ‖Aᴴ‖₊ = ‖A‖₊ :=
  (nnnorm_map_eq _ _ nnnorm_star).trans A.nnnorm_transpose
#align matrix.nnnorm_conj_transpose Matrix.nnnorm_conjTranspose

@[simp]
theorem norm_conjTranspose [StarAddMonoid α] [NormedStarGroup α] (A : Matrix m n α) : ‖Aᴴ‖ = ‖A‖ :=
  congr_arg coe <| nnnorm_conjTranspose A
#align matrix.norm_conj_transpose Matrix.norm_conjTranspose

instance [StarAddMonoid α] [NormedStarGroup α] : NormedStarGroup (Matrix m m α) :=
  ⟨norm_conjTranspose⟩

@[simp]
theorem nnnorm_col (v : m → α) : ‖col v‖₊ = ‖v‖₊ := by simp [Pi.nnnorm_def]
#align matrix.nnnorm_col Matrix.nnnorm_col

@[simp]
theorem norm_col (v : m → α) : ‖col v‖ = ‖v‖ :=
  congr_arg coe <| nnnorm_col v
#align matrix.norm_col Matrix.norm_col

@[simp]
theorem nnnorm_row (v : n → α) : ‖row v‖₊ = ‖v‖₊ := by simp [Pi.nnnorm_def]
#align matrix.nnnorm_row Matrix.nnnorm_row

@[simp]
theorem norm_row (v : n → α) : ‖row v‖ = ‖v‖ :=
  congr_arg coe <| nnnorm_row v
#align matrix.norm_row Matrix.norm_row

@[simp]
theorem nnnorm_diagonal [DecidableEq n] (v : n → α) : ‖diagonal v‖₊ = ‖v‖₊ :=
  by
  simp_rw [Pi.nnnorm_def]
  congr 1 with i : 1
  refine' le_antisymm (Finset.sup_le fun j hj => _) _
  · obtain rfl | hij := eq_or_ne i j
    · rw [diagonal_apply_eq]
    · rw [diagonal_apply_ne _ hij, nnnorm_zero]
      exact zero_le _
  · refine' Eq.trans_le _ (Finset.le_sup (Finset.mem_univ i))
    rw [diagonal_apply_eq]
#align matrix.nnnorm_diagonal Matrix.nnnorm_diagonal

@[simp]
theorem norm_diagonal [DecidableEq n] (v : n → α) : ‖diagonal v‖ = ‖v‖ :=
  congr_arg coe <| nnnorm_diagonal v
#align matrix.norm_diagonal Matrix.norm_diagonal

/-- Note this is safe as an instance as it carries no data. -/
@[nolint fails_quickly]
instance [Nonempty n] [DecidableEq n] [One α] [NormOneClass α] : NormOneClass (Matrix n n α) :=
  ⟨(norm_diagonal _).trans <| norm_one⟩

end SeminormedAddCommGroup

/-- Normed group instance (using sup norm of sup norm) for matrices over a normed group.  Not
declared as an instance because there are several natural choices for defining the norm of a
matrix. -/
protected def normedAddCommGroup [NormedAddCommGroup α] : NormedAddCommGroup (Matrix m n α) :=
  Pi.normedAddCommGroup
#align matrix.normed_add_comm_group Matrix.normedAddCommGroup

section NormedSpace

attribute [local instance] Matrix.seminormedAddCommGroup

variable [NormedField R] [SeminormedAddCommGroup α] [NormedSpace R α]

/-- Normed space instance (using sup norm of sup norm) for matrices over a normed space.  Not
declared as an instance because there are several natural choices for defining the norm of a
matrix. -/
protected def normedSpace : NormedSpace R (Matrix m n α) :=
  Pi.normedSpace
#align matrix.normed_space Matrix.normedSpace

end NormedSpace

end LinfLinf

/-! ### The $L_\infty$ operator norm

This section defines the matrix norm $\|A\|_\infty = \operatorname{sup}_i (\sum_j \|A_{ij}\|)$.

Note that this is equivalent to the operator norm, considering $A$ as a linear map between two
$L^\infty$ spaces.
-/

section LinftyOp

/-- Seminormed group instance (using sup norm of L1 norm) for matrices over a seminormed group. Not
declared as an instance because there are several natural choices for defining the norm of a
matrix. -/
@[local instance]
protected def linftyOpSeminormedAddCommGroup [SeminormedAddCommGroup α] :
    SeminormedAddCommGroup (Matrix m n α) :=
  (by infer_instance : SeminormedAddCommGroup (m → PiLp 1 fun j : n => α))
#align matrix.linfty_op_seminormed_add_comm_group Matrix.linftyOpSeminormedAddCommGroup

/-- Normed group instance (using sup norm of L1 norm) for matrices over a normed ring.  Not
declared as an instance because there are several natural choices for defining the norm of a
matrix. -/
@[local instance]
protected def linftyOpNormedAddCommGroup [NormedAddCommGroup α] :
    NormedAddCommGroup (Matrix m n α) :=
  (by infer_instance : NormedAddCommGroup (m → PiLp 1 fun j : n => α))
#align matrix.linfty_op_normed_add_comm_group Matrix.linftyOpNormedAddCommGroup

/-- Normed space instance (using sup norm of L1 norm) for matrices over a normed space.  Not
declared as an instance because there are several natural choices for defining the norm of a
matrix. -/
@[local instance]
protected def linftyOpNormedSpace [NormedField R] [SeminormedAddCommGroup α] [NormedSpace R α] :
    NormedSpace R (Matrix m n α) :=
  (by infer_instance : NormedSpace R (m → PiLp 1 fun j : n => α))
#align matrix.linfty_op_normed_space Matrix.linftyOpNormedSpace

section SeminormedAddCommGroup

variable [SeminormedAddCommGroup α]

theorem linfty_op_norm_def (A : Matrix m n α) :
    ‖A‖ = ((Finset.univ : Finset m).sup fun i : m => ∑ j : n, ‖A i j‖₊ : ℝ≥0) := by
  simp [Pi.norm_def, PiLp.nnnorm_eq_sum ENNReal.one_ne_top]
#align matrix.linfty_op_norm_def Matrix.linfty_op_norm_def

theorem linfty_op_nnnorm_def (A : Matrix m n α) :
    ‖A‖₊ = (Finset.univ : Finset m).sup fun i : m => ∑ j : n, ‖A i j‖₊ :=
  Subtype.ext <| linfty_op_norm_def A
#align matrix.linfty_op_nnnorm_def Matrix.linfty_op_nnnorm_def

@[simp]
theorem linfty_op_nnnorm_col (v : m → α) : ‖col v‖₊ = ‖v‖₊ :=
  by
  rw [linfty_op_nnnorm_def, Pi.nnnorm_def]
  simp
#align matrix.linfty_op_nnnorm_col Matrix.linfty_op_nnnorm_col

@[simp]
theorem linfty_op_norm_col (v : m → α) : ‖col v‖ = ‖v‖ :=
  congr_arg coe <| linfty_op_nnnorm_col v
#align matrix.linfty_op_norm_col Matrix.linfty_op_norm_col

@[simp]
theorem linfty_op_nnnorm_row (v : n → α) : ‖row v‖₊ = ∑ i, ‖v i‖₊ := by simp [linfty_op_nnnorm_def]
#align matrix.linfty_op_nnnorm_row Matrix.linfty_op_nnnorm_row

@[simp]
theorem linfty_op_norm_row (v : n → α) : ‖row v‖ = ∑ i, ‖v i‖ :=
  (congr_arg coe <| linfty_op_nnnorm_row v).trans <| by simp [NNReal.coe_sum]
#align matrix.linfty_op_norm_row Matrix.linfty_op_norm_row

@[simp]
theorem linfty_op_nnnorm_diagonal [DecidableEq m] (v : m → α) : ‖diagonal v‖₊ = ‖v‖₊ :=
  by
  rw [linfty_op_nnnorm_def, Pi.nnnorm_def]
  congr 1 with i : 1
  refine' (Finset.sum_eq_single_of_mem _ (Finset.mem_univ i) fun j hj hij => _).trans _
  · rw [diagonal_apply_ne' _ hij, nnnorm_zero]
  · rw [diagonal_apply_eq]
#align matrix.linfty_op_nnnorm_diagonal Matrix.linfty_op_nnnorm_diagonal

@[simp]
theorem linfty_op_norm_diagonal [DecidableEq m] (v : m → α) : ‖diagonal v‖ = ‖v‖ :=
  congr_arg coe <| linfty_op_nnnorm_diagonal v
#align matrix.linfty_op_norm_diagonal Matrix.linfty_op_norm_diagonal

end SeminormedAddCommGroup

section NonUnitalSeminormedRing

variable [NonUnitalSeminormedRing α]

/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (k j) -/
theorem linfty_op_nnnorm_mul (A : Matrix l m α) (B : Matrix m n α) : ‖A ⬝ B‖₊ ≤ ‖A‖₊ * ‖B‖₊ :=
  by
  simp_rw [linfty_op_nnnorm_def, Matrix.mul_apply]
  calc
    (finset.univ.sup fun i => ∑ k, ‖∑ j, A i j * B j k‖₊) ≤
        finset.univ.sup fun i => ∑ (k) (j), ‖A i j‖₊ * ‖B j k‖₊ :=
      Finset.sup_mono_fun fun i hi =>
        Finset.sum_le_sum fun k hk => nnnorm_sum_le_of_le _ fun j hj => nnnorm_mul_le _ _
    _ = finset.univ.sup fun i => ∑ j, ‖A i j‖₊ * ∑ k, ‖B j k‖₊ := by
      simp_rw [@Finset.sum_comm _ m n, Finset.mul_sum]
    _ ≤ finset.univ.sup fun i => ∑ j, ‖A i j‖₊ * finset.univ.sup fun i => ∑ j, ‖B i j‖₊ :=
      (Finset.sup_mono_fun fun i hi =>
        Finset.sum_le_sum fun j hj => mul_le_mul_of_nonneg_left (Finset.le_sup hj) (zero_le _))
    _ ≤ (finset.univ.sup fun i => ∑ j, ‖A i j‖₊) * finset.univ.sup fun i => ∑ j, ‖B i j‖₊ := by
      simp_rw [← Finset.sum_mul, ← NNReal.finset_sup_mul]

#align matrix.linfty_op_nnnorm_mul Matrix.linfty_op_nnnorm_mul

theorem linfty_op_norm_mul (A : Matrix l m α) (B : Matrix m n α) : ‖A ⬝ B‖ ≤ ‖A‖ * ‖B‖ :=
  linfty_op_nnnorm_mul _ _
#align matrix.linfty_op_norm_mul Matrix.linfty_op_norm_mul

theorem linfty_op_nnnorm_mulVec (A : Matrix l m α) (v : m → α) : ‖A.mulVec v‖₊ ≤ ‖A‖₊ * ‖v‖₊ :=
  by
  rw [← linfty_op_nnnorm_col (A.mul_vec v), ← linfty_op_nnnorm_col v]
  exact linfty_op_nnnorm_mul A (col v)
#align matrix.linfty_op_nnnorm_mul_vec Matrix.linfty_op_nnnorm_mulVec

theorem linfty_op_norm_mulVec (A : Matrix l m α) (v : m → α) : ‖Matrix.mulVec A v‖ ≤ ‖A‖ * ‖v‖ :=
  linfty_op_nnnorm_mulVec _ _
#align matrix.linfty_op_norm_mul_vec Matrix.linfty_op_norm_mulVec

end NonUnitalSeminormedRing

/-- Seminormed non-unital ring instance (using sup norm of L1 norm) for matrices over a semi normed
non-unital ring. Not declared as an instance because there are several natural choices for defining
the norm of a matrix. -/
@[local instance]
protected def linftyOpNonUnitalSemiNormedRing [NonUnitalSeminormedRing α] :
    NonUnitalSeminormedRing (Matrix n n α) :=
  { Matrix.linftyOpSeminormedAddCommGroup, Matrix.nonUnitalRing with
    norm_mul := linfty_op_norm_mul }
#align matrix.linfty_op_non_unital_semi_normed_ring Matrix.linftyOpNonUnitalSemiNormedRing

/-- The `L₁-L∞` norm preserves one on non-empty matrices. Note this is safe as an instance, as it
carries no data. -/
instance linfty_op_normOneClass [SeminormedRing α] [NormOneClass α] [DecidableEq n] [Nonempty n] :
    NormOneClass (Matrix n n α) where norm_one := (linfty_op_norm_diagonal _).trans norm_one
#align matrix.linfty_op_norm_one_class Matrix.linfty_op_normOneClass

/-- Seminormed ring instance (using sup norm of L1 norm) for matrices over a semi normed ring.  Not
declared as an instance because there are several natural choices for defining the norm of a
matrix. -/
@[local instance]
protected def linftyOpSemiNormedRing [SeminormedRing α] [DecidableEq n] :
    SeminormedRing (Matrix n n α) :=
  { Matrix.linftyOpNonUnitalSemiNormedRing, Matrix.ring with }
#align matrix.linfty_op_semi_normed_ring Matrix.linftyOpSemiNormedRing

/-- Normed non-unital ring instance (using sup norm of L1 norm) for matrices over a normed
non-unital ring. Not declared as an instance because there are several natural choices for defining
the norm of a matrix. -/
@[local instance]
protected def linftyOpNonUnitalNormedRing [NonUnitalNormedRing α] :
    NonUnitalNormedRing (Matrix n n α) :=
  { Matrix.linftyOpNonUnitalSemiNormedRing with }
#align matrix.linfty_op_non_unital_normed_ring Matrix.linftyOpNonUnitalNormedRing

/-- Normed ring instance (using sup norm of L1 norm) for matrices over a normed ring.  Not
declared as an instance because there are several natural choices for defining the norm of a
matrix. -/
@[local instance]
protected def linftyOpNormedRing [NormedRing α] [DecidableEq n] : NormedRing (Matrix n n α) :=
  { Matrix.linftyOpSemiNormedRing with }
#align matrix.linfty_op_normed_ring Matrix.linftyOpNormedRing

/-- Normed algebra instance (using sup norm of L1 norm) for matrices over a normed algebra. Not
declared as an instance because there are several natural choices for defining the norm of a
matrix. -/
@[local instance]
protected def linftyOpNormedAlgebra [NormedField R] [SeminormedRing α] [NormedAlgebra R α]
    [DecidableEq n] : NormedAlgebra R (Matrix n n α) :=
  { Matrix.linftyOpNormedSpace with }
#align matrix.linfty_op_normed_algebra Matrix.linftyOpNormedAlgebra

end LinftyOp

/-! ### The Frobenius norm

This is defined as $\|A\| = \sqrt{\sum_{i,j} \|A_{ij}\|^2}$.
When the matrix is over the real or complex numbers, this norm is submultiplicative.
-/

section frobenius

open Matrix BigOperators

/-- Seminormed group instance (using frobenius norm) for matrices over a seminormed group. Not
declared as an instance because there are several natural choices for defining the norm of a
matrix. -/
@[local instance]
def frobeniusSeminormedAddCommGroup [SeminormedAddCommGroup α] :
    SeminormedAddCommGroup (Matrix m n α) :=
  (by infer_instance : SeminormedAddCommGroup (PiLp 2 fun i : m => PiLp 2 fun j : n => α))
#align matrix.frobenius_seminormed_add_comm_group Matrix.frobeniusSeminormedAddCommGroup

/-- Normed group instance (using frobenius norm) for matrices over a normed group.  Not
declared as an instance because there are several natural choices for defining the norm of a
matrix. -/
@[local instance]
def frobeniusNormedAddCommGroup [NormedAddCommGroup α] : NormedAddCommGroup (Matrix m n α) :=
  (by infer_instance : NormedAddCommGroup (PiLp 2 fun i : m => PiLp 2 fun j : n => α))
#align matrix.frobenius_normed_add_comm_group Matrix.frobeniusNormedAddCommGroup

/-- Normed space instance (using frobenius norm) for matrices over a normed space.  Not
declared as an instance because there are several natural choices for defining the norm of a
matrix. -/
@[local instance]
def frobeniusNormedSpace [NormedField R] [SeminormedAddCommGroup α] [NormedSpace R α] :
    NormedSpace R (Matrix m n α) :=
  (by infer_instance : NormedSpace R (PiLp 2 fun i : m => PiLp 2 fun j : n => α))
#align matrix.frobenius_normed_space Matrix.frobeniusNormedSpace

section SeminormedAddCommGroup

variable [SeminormedAddCommGroup α] [SeminormedAddCommGroup β]

/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (i j) -/
theorem frobenius_nnnorm_def (A : Matrix m n α) :
    ‖A‖₊ = (∑ (i) (j), ‖A i j‖₊ ^ (2 : ℝ)) ^ (1 / 2 : ℝ) := by
  simp_rw [PiLp.nnnorm_eq_of_L2, NNReal.sq_sqrt, NNReal.sqrt_eq_rpow, NNReal.rpow_two]
#align matrix.frobenius_nnnorm_def Matrix.frobenius_nnnorm_def

/- ./././Mathport/Syntax/Translate/Expr.lean:107:6: warning: expanding binder group (i j) -/
theorem frobenius_norm_def (A : Matrix m n α) :
    ‖A‖ = (∑ (i) (j), ‖A i j‖ ^ (2 : ℝ)) ^ (1 / 2 : ℝ) :=
  (congr_arg coe (frobenius_nnnorm_def A)).trans <| by simp [NNReal.coe_sum]
#align matrix.frobenius_norm_def Matrix.frobenius_norm_def

@[simp]
theorem frobenius_nnnorm_map_eq (A : Matrix m n α) (f : α → β) (hf : ∀ a, ‖f a‖₊ = ‖a‖₊) :
    ‖A.map f‖₊ = ‖A‖₊ := by simp_rw [frobenius_nnnorm_def, Matrix.map_apply, hf]
#align matrix.frobenius_nnnorm_map_eq Matrix.frobenius_nnnorm_map_eq

@[simp]
theorem frobenius_norm_map_eq (A : Matrix m n α) (f : α → β) (hf : ∀ a, ‖f a‖ = ‖a‖) :
    ‖A.map f‖ = ‖A‖ :=
  (congr_arg (coe : ℝ≥0 → ℝ) <| frobenius_nnnorm_map_eq A f fun a => Subtype.ext <| hf a : _)
#align matrix.frobenius_norm_map_eq Matrix.frobenius_norm_map_eq

@[simp]
theorem frobenius_nnnorm_transpose (A : Matrix m n α) : ‖Aᵀ‖₊ = ‖A‖₊ :=
  by
  rw [frobenius_nnnorm_def, frobenius_nnnorm_def, Finset.sum_comm]
  rfl
#align matrix.frobenius_nnnorm_transpose Matrix.frobenius_nnnorm_transpose

@[simp]
theorem frobenius_norm_transpose (A : Matrix m n α) : ‖Aᵀ‖ = ‖A‖ :=
  congr_arg coe <| frobenius_nnnorm_transpose A
#align matrix.frobenius_norm_transpose Matrix.frobenius_norm_transpose

@[simp]
theorem frobenius_nnnorm_conjTranspose [StarAddMonoid α] [NormedStarGroup α] (A : Matrix m n α) :
    ‖Aᴴ‖₊ = ‖A‖₊ :=
  (frobenius_nnnorm_map_eq _ _ nnnorm_star).trans A.frobenius_nnnorm_transpose
#align matrix.frobenius_nnnorm_conj_transpose Matrix.frobenius_nnnorm_conjTranspose

@[simp]
theorem frobenius_norm_conjTranspose [StarAddMonoid α] [NormedStarGroup α] (A : Matrix m n α) :
    ‖Aᴴ‖ = ‖A‖ :=
  congr_arg coe <| frobenius_nnnorm_conjTranspose A
#align matrix.frobenius_norm_conj_transpose Matrix.frobenius_norm_conjTranspose

instance frobenius_normedStarGroup [StarAddMonoid α] [NormedStarGroup α] :
    NormedStarGroup (Matrix m m α) :=
  ⟨frobenius_norm_conjTranspose⟩
#align matrix.frobenius_normed_star_group Matrix.frobenius_normedStarGroup

@[simp]
theorem frobenius_norm_row (v : m → α) : ‖row v‖ = ‖(PiLp.equiv 2 _).symm v‖ :=
  by
  rw [frobenius_norm_def, Fintype.sum_unique, PiLp.norm_eq_of_L2, Real.sqrt_eq_rpow]
  simp only [row_apply, Real.rpow_two, PiLp.equiv_symm_apply]
#align matrix.frobenius_norm_row Matrix.frobenius_norm_row

@[simp]
theorem frobenius_nnnorm_row (v : m → α) : ‖row v‖₊ = ‖(PiLp.equiv 2 _).symm v‖₊ :=
  Subtype.ext <| frobenius_norm_row v
#align matrix.frobenius_nnnorm_row Matrix.frobenius_nnnorm_row

@[simp]
theorem frobenius_norm_col (v : n → α) : ‖col v‖ = ‖(PiLp.equiv 2 _).symm v‖ :=
  by
  simp_rw [frobenius_norm_def, Fintype.sum_unique, PiLp.norm_eq_of_L2, Real.sqrt_eq_rpow]
  simp only [col_apply, Real.rpow_two, PiLp.equiv_symm_apply]
#align matrix.frobenius_norm_col Matrix.frobenius_norm_col

@[simp]
theorem frobenius_nnnorm_col (v : n → α) : ‖col v‖₊ = ‖(PiLp.equiv 2 _).symm v‖₊ :=
  Subtype.ext <| frobenius_norm_col v
#align matrix.frobenius_nnnorm_col Matrix.frobenius_nnnorm_col

@[simp]
theorem frobenius_nnnorm_diagonal [DecidableEq n] (v : n → α) :
    ‖diagonal v‖₊ = ‖(PiLp.equiv 2 _).symm v‖₊ :=
  by
  simp_rw [frobenius_nnnorm_def, ← Finset.sum_product', Finset.univ_product_univ,
    PiLp.nnnorm_eq_of_L2]
  let s := (Finset.univ : Finset n).map ⟨fun i : n => (i, i), fun i j h => congr_arg Prod.fst h⟩
  rw [← Finset.sum_subset (Finset.subset_univ s) fun i hi his => _]
  · rw [Finset.sum_map, NNReal.sqrt_eq_rpow]
    dsimp
    simp_rw [diagonal_apply_eq, NNReal.rpow_two]
  · suffices i.1 ≠ i.2 by rw [diagonal_apply_ne _ this, nnnorm_zero, NNReal.zero_rpow two_ne_zero]
    intro h
    exact finset.mem_map.not.mp his ⟨i.1, Finset.mem_univ _, Prod.ext rfl h⟩
#align matrix.frobenius_nnnorm_diagonal Matrix.frobenius_nnnorm_diagonal

@[simp]
theorem frobenius_norm_diagonal [DecidableEq n] (v : n → α) :
    ‖diagonal v‖ = ‖(PiLp.equiv 2 _).symm v‖ :=
  (congr_arg coe <| frobenius_nnnorm_diagonal v : _).trans rfl
#align matrix.frobenius_norm_diagonal Matrix.frobenius_norm_diagonal

end SeminormedAddCommGroup

theorem frobenius_nnnorm_one [DecidableEq n] [SeminormedAddCommGroup α] [One α] :
    ‖(1 : Matrix n n α)‖₊ = NNReal.sqrt (Fintype.card n) * ‖(1 : α)‖₊ :=
  by
  refine' (frobenius_nnnorm_diagonal _).trans _
  simp_rw [PiLp.nnnorm_equiv_symm_const ENNReal.two_ne_top, NNReal.sqrt_eq_rpow]
  simp only [ENNReal.toReal_div, ENNReal.one_toReal, [anonymous]]
#align matrix.frobenius_nnnorm_one Matrix.frobenius_nnnorm_one

section IsROrC

variable [IsROrC α]

theorem frobenius_nnnorm_mul (A : Matrix l m α) (B : Matrix m n α) : ‖A ⬝ B‖₊ ≤ ‖A‖₊ * ‖B‖₊ :=
  by
  simp_rw [frobenius_nnnorm_def, Matrix.mul_apply]
  rw [← NNReal.mul_rpow, @Finset.sum_comm _ n m, Finset.sum_mul_sum, Finset.sum_product]
  refine' NNReal.rpow_le_rpow _ one_half_pos.le
  refine' Finset.sum_le_sum fun i hi => Finset.sum_le_sum fun j hj => _
  rw [← NNReal.rpow_le_rpow_iff one_half_pos, ← NNReal.rpow_mul,
    mul_div_cancel' (1 : ℝ) two_ne_zero, NNReal.rpow_one, NNReal.mul_rpow]
  dsimp only
  have :=
    @nnnorm_inner_le_nnnorm α _ _ _ _ ((PiLp.equiv 2 fun i => α).symm fun j => star (A i j))
      ((PiLp.equiv 2 fun i => α).symm fun k => B k j)
  simpa only [PiLp.equiv_symm_apply, PiLp.inner_apply, IsROrC.inner_apply, starRingEnd_apply,
    Pi.nnnorm_def, PiLp.nnnorm_eq_of_L2, star_star, nnnorm_star, NNReal.sqrt_eq_rpow,
    NNReal.rpow_two] using this
#align matrix.frobenius_nnnorm_mul Matrix.frobenius_nnnorm_mul

theorem frobenius_norm_mul (A : Matrix l m α) (B : Matrix m n α) : ‖A ⬝ B‖ ≤ ‖A‖ * ‖B‖ :=
  frobenius_nnnorm_mul A B
#align matrix.frobenius_norm_mul Matrix.frobenius_norm_mul

/-- Normed ring instance (using frobenius norm) for matrices over `ℝ` or `ℂ`.  Not
declared as an instance because there are several natural choices for defining the norm of a
matrix. -/
@[local instance]
def frobeniusNormedRing [DecidableEq m] : NormedRing (Matrix m m α) :=
  {
    Matrix.frobeniusSeminormedAddCommGroup with
    norm := Norm.norm
    norm_mul := frobenius_norm_mul }
#align matrix.frobenius_normed_ring Matrix.frobeniusNormedRing

/-- Normed algebra instance (using frobenius norm) for matrices over `ℝ` or `ℂ`.  Not
declared as an instance because there are several natural choices for defining the norm of a
matrix. -/
@[local instance]
def frobeniusNormedAlgebra [DecidableEq m] [NormedField R] [NormedAlgebra R α] :
    NormedAlgebra R (Matrix m m α) :=
  { Matrix.frobeniusNormedSpace with }
#align matrix.frobenius_normed_algebra Matrix.frobeniusNormedAlgebra

end IsROrC

end frobenius

end Matrix


/- Tactic : exact

## Summary

If the goal is `⊢ X` then `exact x` will close the goal if
and only if `x` is a term of type `X`.

## Details

Say `P`, `Q` and `R` are types (i.e., what a mathematician
might think of as either sets or propositions),
and the local context looks like this:

```
p : P,
h : P → Q,
j : Q → R
⊢ R
```

If you can spot how to make a term of type `R`, then you
can just make it and say you're done using the `exact` tactic
together with the formula you have spotted. For example the
above goal could be solved with

`exact j(h(p)),`

because `j(h(p))` is easily checked to be a term of type `R`
(i.e., an element of the set `R`, or a proof of the proposition `R`).

-/

/-
# Tutorial World

## Level 4: the `exact` tactic.

In this level, we learn the `exact` tactic, which solves a goal that is exactly one of the hypotheses.
For example, if the finishing goal is ⊢ `A = B` and we have the hypothesis `z : A = B`, then `exact z`
will complete the level.

This level is a new variant of the the previous one, but we will solve it in a different way. As you can imagine,
mathematical proofs can be solved in many differents ways, which is something that definitely makes this field special.

## The tactics index

In case you forgot how to use some of the tactics, click on the top left menu to see what we have learned so far.
Play around with the menus on the left and see what is there currently. More information will appear as you progress.
-/

/- Hint : Click here for a hint, in case you get stuck.
By using the `rw` tactic you will get the goal to look exactly like one of the hypotheses...
-/

variables {Ω : Type} -- hide

/- Lemma : no-side-bar
If A, B and C are points with A = B and B = C, then A = C.
-/
lemma example_exact (A B C: Ω) (h1 : A = B) (h2 : B = C) : A = C :=
begin
  rw h1,
  exact h2,

end


/-
Copyright (c) 2021 Bhavik Mehta. 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.shadow
! leanprover-community/mathlib commit 13a5329a8625701af92e9a96ffc90fa787fff24d
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Finset.Slice
import Mathbin.Logic.Function.Iterate

/-!
# Shadows

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

This file defines shadows of a set family. The shadow of a set family is the set family of sets we
get by removing any element from any set of the original family. If one pictures `finset α` as a big
hypercube (each dimension being membership of a given element), then taking the shadow corresponds
to projecting each finset down once in all available directions.

## Main definitions

* `finset.shadow`: The shadow of a set family. Everything we can get by removing a new element from
  some set.
* `finset.up_shadow`: The upper shadow of a set family. Everything we can get by adding an element
  to some set.

## Notation

We define notation in locale `finset_family`:
* `∂ 𝒜`: Shadow of `𝒜`.
* `∂⁺ 𝒜`: Upper shadow of `𝒜`.

We also maintain the convention that `a, b : α` are elements of the ground type, `s, t : finset α`
are finsets, and `𝒜, ℬ : finset (finset α)` are finset families.

## References

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

## Tags

shadow, set family
-/

open Finset Nat

variable {α : Type _}

namespace Finset

section Shadow

variable [DecidableEq α] {𝒜 : Finset (Finset α)} {s t : Finset α} {a : α} {k r : ℕ}

#print Finset.shadow /-
/-- The shadow of a set family `𝒜` is all sets we can get by removing one element from any set in
`𝒜`, and the (`k` times) iterated shadow (`shadow^[k]`) is all sets we can get by removing `k`
elements from any set in `𝒜`. -/
def shadow (𝒜 : Finset (Finset α)) : Finset (Finset α) :=
  𝒜.sup fun s => s.image (erase s)
#align finset.shadow Finset.shadow
-/

-- mathport name: finset.shadow
scoped[FinsetFamily] notation:90 "∂ " => Finset.shadow

#print Finset.shadow_empty /-
/-- The shadow of the empty set is empty. -/
@[simp]
theorem shadow_empty : (∂ ) (∅ : Finset (Finset α)) = ∅ :=
  rfl
#align finset.shadow_empty Finset.shadow_empty
-/

#print Finset.shadow_singleton_empty /-
@[simp]
theorem shadow_singleton_empty : (∂ ) ({∅} : Finset (Finset α)) = ∅ :=
  rfl
#align finset.shadow_singleton_empty Finset.shadow_singleton_empty
-/

#print Finset.shadow_monotone /-
--TODO: Prove `∂ {{a}} = {∅}` quickly using `covers` and `grade_order`
/-- The shadow is monotone. -/
@[mono]
theorem shadow_monotone : Monotone (shadow : Finset (Finset α) → Finset (Finset α)) := fun 𝒜 ℬ =>
  sup_mono
#align finset.shadow_monotone Finset.shadow_monotone
-/

/- warning: finset.mem_shadow_iff -> Finset.mem_shadow_iff is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] {𝒜 : Finset.{u1} (Finset.{u1} α)} {s : Finset.{u1} α}, Iff (Membership.Mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.hasMem.{u1} (Finset.{u1} α)) s (Finset.shadow.{u1} α (fun (a : α) (b : α) => _inst_1 a b) 𝒜)) (Exists.{succ u1} (Finset.{u1} α) (fun (t : Finset.{u1} α) => Exists.{0} (Membership.Mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.hasMem.{u1} (Finset.{u1} α)) t 𝒜) (fun (H : Membership.Mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.hasMem.{u1} (Finset.{u1} α)) t 𝒜) => Exists.{succ u1} α (fun (a : α) => Exists.{0} (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a t) (fun (H : Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a t) => Eq.{succ u1} (Finset.{u1} α) (Finset.erase.{u1} α (fun (a : α) (b : α) => _inst_1 a b) t a) s)))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] {𝒜 : Finset.{u1} (Finset.{u1} α)} {s : Finset.{u1} α}, Iff (Membership.mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.instMembershipFinset.{u1} (Finset.{u1} α)) s (Finset.shadow.{u1} α (fun (a : α) (b : α) => _inst_1 a b) 𝒜)) (Exists.{succ u1} (Finset.{u1} α) (fun (t : Finset.{u1} α) => And (Membership.mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.instMembershipFinset.{u1} (Finset.{u1} α)) t 𝒜) (Exists.{succ u1} α (fun (a : α) => And (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a t) (Eq.{succ u1} (Finset.{u1} α) (Finset.erase.{u1} α (fun (a : α) (b : α) => _inst_1 a b) t a) s)))))
Case conversion may be inaccurate. Consider using '#align finset.mem_shadow_iff Finset.mem_shadow_iffₓ'. -/
/-- `s` is in the shadow of `𝒜` iff there is an `t ∈ 𝒜` from which we can remove one element to
get `s`. -/
theorem mem_shadow_iff : s ∈ (∂ ) 𝒜 ↔ ∃ t ∈ 𝒜, ∃ a ∈ t, erase t a = s := by
  simp only [shadow, mem_sup, mem_image]
#align finset.mem_shadow_iff Finset.mem_shadow_iff

#print Finset.erase_mem_shadow /-
theorem erase_mem_shadow (hs : s ∈ 𝒜) (ha : a ∈ s) : erase s a ∈ (∂ ) 𝒜 :=
  mem_shadow_iff.2 ⟨s, hs, a, ha, rfl⟩
#align finset.erase_mem_shadow Finset.erase_mem_shadow
-/

/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (a «expr ∉ » s) -/
#print Finset.mem_shadow_iff_insert_mem /-
/-- `t` is in the shadow of `𝒜` iff we can add an element to it so that the resulting finset is in
`𝒜`. -/
theorem mem_shadow_iff_insert_mem : s ∈ (∂ ) 𝒜 ↔ ∃ (a : _)(_ : a ∉ s), insert a s ∈ 𝒜 :=
  by
  refine' mem_shadow_iff.trans ⟨_, _⟩
  · rintro ⟨s, hs, a, ha, rfl⟩
    refine' ⟨a, not_mem_erase a s, _⟩
    rwa [insert_erase ha]
  · rintro ⟨a, ha, hs⟩
    exact ⟨insert a s, hs, a, mem_insert_self _ _, erase_insert ha⟩
#align finset.mem_shadow_iff_insert_mem Finset.mem_shadow_iff_insert_mem
-/

/-- The shadow of a family of `r`-sets is a family of `r - 1`-sets. -/
protected theorem Set.Sized.shadow (h𝒜 : (𝒜 : Set (Finset α)).Sized r) :
    ((∂ ) 𝒜 : Set (Finset α)).Sized (r - 1) :=
  by
  intro A h
  obtain ⟨A, hA, i, hi, rfl⟩ := mem_shadow_iff.1 h
  rw [card_erase_of_mem hi, h𝒜 hA]
#align set.sized.shadow Set.Sized.shadow

#print Finset.sized_shadow_iff /-
theorem sized_shadow_iff (h : ∅ ∉ 𝒜) :
    ((∂ ) 𝒜 : Set (Finset α)).Sized r ↔ (𝒜 : Set (Finset α)).Sized (r + 1) :=
  by
  refine' ⟨fun h𝒜 s hs => _, Set.Sized.shadow⟩
  obtain ⟨a, ha⟩ := nonempty_iff_ne_empty.2 (ne_of_mem_of_not_mem hs h)
  rw [← h𝒜 (erase_mem_shadow hs ha), card_erase_add_one ha]
#align finset.sized_shadow_iff Finset.sized_shadow_iff
-/

/- warning: finset.mem_shadow_iff_exists_mem_card_add_one -> Finset.mem_shadow_iff_exists_mem_card_add_one is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] {𝒜 : Finset.{u1} (Finset.{u1} α)} {s : Finset.{u1} α}, Iff (Membership.Mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.hasMem.{u1} (Finset.{u1} α)) s (Finset.shadow.{u1} α (fun (a : α) (b : α) => _inst_1 a b) 𝒜)) (Exists.{succ u1} (Finset.{u1} α) (fun (t : Finset.{u1} α) => Exists.{0} (Membership.Mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.hasMem.{u1} (Finset.{u1} α)) t 𝒜) (fun (H : Membership.Mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.hasMem.{u1} (Finset.{u1} α)) t 𝒜) => And (HasSubset.Subset.{u1} (Finset.{u1} α) (Finset.hasSubset.{u1} α) s t) (Eq.{1} Nat (Finset.card.{u1} α t) (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) (Finset.card.{u1} α s) (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne))))))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] {𝒜 : Finset.{u1} (Finset.{u1} α)} {s : Finset.{u1} α}, Iff (Membership.mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.instMembershipFinset.{u1} (Finset.{u1} α)) s (Finset.shadow.{u1} α (fun (a : α) (b : α) => _inst_1 a b) 𝒜)) (Exists.{succ u1} (Finset.{u1} α) (fun (t : Finset.{u1} α) => And (Membership.mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.instMembershipFinset.{u1} (Finset.{u1} α)) t 𝒜) (And (HasSubset.Subset.{u1} (Finset.{u1} α) (Finset.instHasSubsetFinset.{u1} α) s t) (Eq.{1} Nat (Finset.card.{u1} α t) (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) (Finset.card.{u1} α s) (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))))))
Case conversion may be inaccurate. Consider using '#align finset.mem_shadow_iff_exists_mem_card_add_one Finset.mem_shadow_iff_exists_mem_card_add_oneₓ'. -/
/-- `s ∈ ∂ 𝒜` iff `s` is exactly one element less than something from `𝒜` -/
theorem mem_shadow_iff_exists_mem_card_add_one :
    s ∈ (∂ ) 𝒜 ↔ ∃ t ∈ 𝒜, s ⊆ t ∧ t.card = s.card + 1 :=
  by
  refine' mem_shadow_iff_insert_mem.trans ⟨_, _⟩
  · rintro ⟨a, ha, hs⟩
    exact ⟨insert a s, hs, subset_insert _ _, card_insert_of_not_mem ha⟩
  · rintro ⟨t, ht, hst, h⟩
    obtain ⟨a, ha⟩ : ∃ a, t \ s = {a} :=
      card_eq_one.1 (by rw [card_sdiff hst, h, add_tsub_cancel_left])
    exact
      ⟨a, fun hat => not_mem_sdiff_of_mem_right hat ((ha.ge : _ ⊆ _) <| mem_singleton_self a), by
        rwa [insert_eq a s, ← ha, sdiff_union_of_subset hst]⟩
#align finset.mem_shadow_iff_exists_mem_card_add_one Finset.mem_shadow_iff_exists_mem_card_add_one

/- warning: finset.exists_subset_of_mem_shadow -> Finset.exists_subset_of_mem_shadow is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] {𝒜 : Finset.{u1} (Finset.{u1} α)} {s : Finset.{u1} α}, (Membership.Mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.hasMem.{u1} (Finset.{u1} α)) s (Finset.shadow.{u1} α (fun (a : α) (b : α) => _inst_1 a b) 𝒜)) -> (Exists.{succ u1} (Finset.{u1} α) (fun (t : Finset.{u1} α) => Exists.{0} (Membership.Mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.hasMem.{u1} (Finset.{u1} α)) t 𝒜) (fun (H : Membership.Mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.hasMem.{u1} (Finset.{u1} α)) t 𝒜) => HasSubset.Subset.{u1} (Finset.{u1} α) (Finset.hasSubset.{u1} α) s t)))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] {𝒜 : Finset.{u1} (Finset.{u1} α)} {s : Finset.{u1} α}, (Membership.mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.instMembershipFinset.{u1} (Finset.{u1} α)) s (Finset.shadow.{u1} α (fun (a : α) (b : α) => _inst_1 a b) 𝒜)) -> (Exists.{succ u1} (Finset.{u1} α) (fun (t : Finset.{u1} α) => And (Membership.mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.instMembershipFinset.{u1} (Finset.{u1} α)) t 𝒜) (HasSubset.Subset.{u1} (Finset.{u1} α) (Finset.instHasSubsetFinset.{u1} α) s t)))
Case conversion may be inaccurate. Consider using '#align finset.exists_subset_of_mem_shadow Finset.exists_subset_of_mem_shadowₓ'. -/
/-- Being in the shadow of `𝒜` means we have a superset in `𝒜`. -/
theorem exists_subset_of_mem_shadow (hs : s ∈ (∂ ) 𝒜) : ∃ t ∈ 𝒜, s ⊆ t :=
  let ⟨t, ht, hst⟩ := mem_shadow_iff_exists_mem_card_add_one.1 hs
  ⟨t, ht, hst.1⟩
#align finset.exists_subset_of_mem_shadow Finset.exists_subset_of_mem_shadow

/- warning: finset.mem_shadow_iff_exists_mem_card_add -> Finset.mem_shadow_iff_exists_mem_card_add is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] {𝒜 : Finset.{u1} (Finset.{u1} α)} {s : Finset.{u1} α} {k : Nat}, Iff (Membership.Mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.hasMem.{u1} (Finset.{u1} α)) s (Nat.iterate.{succ u1} (Finset.{u1} (Finset.{u1} α)) (Finset.shadow.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) k 𝒜)) (Exists.{succ u1} (Finset.{u1} α) (fun (t : Finset.{u1} α) => Exists.{0} (Membership.Mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.hasMem.{u1} (Finset.{u1} α)) t 𝒜) (fun (H : Membership.Mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.hasMem.{u1} (Finset.{u1} α)) t 𝒜) => And (HasSubset.Subset.{u1} (Finset.{u1} α) (Finset.hasSubset.{u1} α) s t) (Eq.{1} Nat (Finset.card.{u1} α t) (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) (Finset.card.{u1} α s) k)))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] {𝒜 : Finset.{u1} (Finset.{u1} α)} {s : Finset.{u1} α} {k : Nat}, Iff (Membership.mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.instMembershipFinset.{u1} (Finset.{u1} α)) s (Nat.iterate.{succ u1} (Finset.{u1} (Finset.{u1} α)) (Finset.shadow.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) k 𝒜)) (Exists.{succ u1} (Finset.{u1} α) (fun (t : Finset.{u1} α) => And (Membership.mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.instMembershipFinset.{u1} (Finset.{u1} α)) t 𝒜) (And (HasSubset.Subset.{u1} (Finset.{u1} α) (Finset.instHasSubsetFinset.{u1} α) s t) (Eq.{1} Nat (Finset.card.{u1} α t) (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) (Finset.card.{u1} α s) k)))))
Case conversion may be inaccurate. Consider using '#align finset.mem_shadow_iff_exists_mem_card_add Finset.mem_shadow_iff_exists_mem_card_addₓ'. -/
/-- `t ∈ ∂^k 𝒜` iff `t` is exactly `k` elements less than something in `𝒜`. -/
theorem mem_shadow_iff_exists_mem_card_add :
    s ∈ (∂ ^[k]) 𝒜 ↔ ∃ t ∈ 𝒜, s ⊆ t ∧ t.card = s.card + k :=
  by
  induction' k with k ih generalizing 𝒜 s
  · refine' ⟨fun hs => ⟨s, hs, subset.refl _, rfl⟩, _⟩
    rintro ⟨t, ht, hst, hcard⟩
    rwa [eq_of_subset_of_card_le hst hcard.le]
  simp only [exists_prop, Function.comp_apply, Function.iterate_succ]
  refine' ih.trans _
  clear ih
  constructor
  · rintro ⟨t, ht, hst, hcardst⟩
    obtain ⟨u, hu, htu, hcardtu⟩ := mem_shadow_iff_exists_mem_card_add_one.1 ht
    refine' ⟨u, hu, hst.trans htu, _⟩
    rw [hcardtu, hcardst]
    rfl
  · rintro ⟨t, ht, hst, hcard⟩
    obtain ⟨u, hsu, hut, hu⟩ :=
      Finset.exists_intermediate_set k
        (by
          rw [add_comm, hcard]
          exact le_succ _)
        hst
    rw [add_comm] at hu
    refine' ⟨u, mem_shadow_iff_exists_mem_card_add_one.2 ⟨t, ht, hut, _⟩, hsu, hu⟩
    rw [hcard, hu]
    rfl
#align finset.mem_shadow_iff_exists_mem_card_add Finset.mem_shadow_iff_exists_mem_card_add

end Shadow

open FinsetFamily

section UpShadow

variable [DecidableEq α] [Fintype α] {𝒜 : Finset (Finset α)} {s t : Finset α} {a : α} {k r : ℕ}

#print Finset.upShadow /-
/-- The upper shadow of a set family `𝒜` is all sets we can get by adding one element to any set in
`𝒜`, and the (`k` times) iterated upper shadow (`up_shadow^[k]`) is all sets we can get by adding
`k` elements from any set in `𝒜`. -/
def upShadow (𝒜 : Finset (Finset α)) : Finset (Finset α) :=
  𝒜.sup fun s => sᶜ.image fun a => insert a s
#align finset.up_shadow Finset.upShadow
-/

-- mathport name: finset.up_shadow
scoped[FinsetFamily] notation:90 "∂⁺ " => Finset.upShadow

#print Finset.upShadow_empty /-
/-- The upper shadow of the empty set is empty. -/
@[simp]
theorem upShadow_empty : (∂⁺ ) (∅ : Finset (Finset α)) = ∅ :=
  rfl
#align finset.up_shadow_empty Finset.upShadow_empty
-/

#print Finset.upShadow_monotone /-
/-- The upper shadow is monotone. -/
@[mono]
theorem upShadow_monotone : Monotone (upShadow : Finset (Finset α) → Finset (Finset α)) :=
  fun 𝒜 ℬ => sup_mono
#align finset.up_shadow_monotone Finset.upShadow_monotone
-/

/- warning: finset.mem_up_shadow_iff -> Finset.mem_upShadow_iff is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] [_inst_2 : Fintype.{u1} α] {𝒜 : Finset.{u1} (Finset.{u1} α)} {s : Finset.{u1} α}, Iff (Membership.Mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.hasMem.{u1} (Finset.{u1} α)) s (Finset.upShadow.{u1} α (fun (a : α) (b : α) => _inst_1 a b) _inst_2 𝒜)) (Exists.{succ u1} (Finset.{u1} α) (fun (t : Finset.{u1} α) => Exists.{0} (Membership.Mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.hasMem.{u1} (Finset.{u1} α)) t 𝒜) (fun (H : Membership.Mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.hasMem.{u1} (Finset.{u1} α)) t 𝒜) => Exists.{succ u1} α (fun (a : α) => Exists.{0} (Not (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a t)) (fun (H : Not (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a t)) => Eq.{succ u1} (Finset.{u1} α) (Insert.insert.{u1, u1} α (Finset.{u1} α) (Finset.hasInsert.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) a t) s)))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] [_inst_2 : Fintype.{u1} α] {𝒜 : Finset.{u1} (Finset.{u1} α)} {s : Finset.{u1} α}, Iff (Membership.mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.instMembershipFinset.{u1} (Finset.{u1} α)) s (Finset.upShadow.{u1} α (fun (a : α) (b : α) => _inst_1 a b) _inst_2 𝒜)) (Exists.{succ u1} (Finset.{u1} α) (fun (t : Finset.{u1} α) => And (Membership.mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.instMembershipFinset.{u1} (Finset.{u1} α)) t 𝒜) (Exists.{succ u1} α (fun (a : α) => Exists.{0} (Not (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a t)) (fun (x._@.Mathlib.Combinatorics.SetFamily.Shadow._hyg.2641 : Not (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a t)) => Eq.{succ u1} (Finset.{u1} α) (Insert.insert.{u1, u1} α (Finset.{u1} α) (Finset.instInsertFinset.{u1} α (fun (a : α) (b : α) => _inst_1 a b)) a t) s)))))
Case conversion may be inaccurate. Consider using '#align finset.mem_up_shadow_iff Finset.mem_upShadow_iffₓ'. -/
/- ./././Mathport/Syntax/Translate/Basic.lean:635:2: warning: expanding binder collection (a «expr ∉ » t) -/
/-- `s` is in the upper shadow of `𝒜` iff there is an `t ∈ 𝒜` from which we can remove one element
to get `s`. -/
theorem mem_upShadow_iff : s ∈ (∂⁺ ) 𝒜 ↔ ∃ t ∈ 𝒜, ∃ (a : _)(_ : a ∉ t), insert a t = s := by
  simp_rw [up_shadow, mem_sup, mem_image, exists_prop, mem_compl]
#align finset.mem_up_shadow_iff Finset.mem_upShadow_iff

#print Finset.insert_mem_upShadow /-
theorem insert_mem_upShadow (hs : s ∈ 𝒜) (ha : a ∉ s) : insert a s ∈ (∂⁺ ) 𝒜 :=
  mem_upShadow_iff.2 ⟨s, hs, a, ha, rfl⟩
#align finset.insert_mem_up_shadow Finset.insert_mem_upShadow
-/

/-- The upper shadow of a family of `r`-sets is a family of `r + 1`-sets. -/
protected theorem Set.Sized.upShadow (h𝒜 : (𝒜 : Set (Finset α)).Sized r) :
    ((∂⁺ ) 𝒜 : Set (Finset α)).Sized (r + 1) :=
  by
  intro A h
  obtain ⟨A, hA, i, hi, rfl⟩ := mem_up_shadow_iff.1 h
  rw [card_insert_of_not_mem hi, h𝒜 hA]
#align set.sized.up_shadow Set.Sized.upShadow

/- warning: finset.mem_up_shadow_iff_erase_mem -> Finset.mem_upShadow_iff_erase_mem is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] [_inst_2 : Fintype.{u1} α] {𝒜 : Finset.{u1} (Finset.{u1} α)} {s : Finset.{u1} α}, Iff (Membership.Mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.hasMem.{u1} (Finset.{u1} α)) s (Finset.upShadow.{u1} α (fun (a : α) (b : α) => _inst_1 a b) _inst_2 𝒜)) (Exists.{succ u1} α (fun (a : α) => Exists.{0} (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a s) (fun (H : Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a s) => Membership.Mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.hasMem.{u1} (Finset.{u1} α)) (Finset.erase.{u1} α (fun (a : α) (b : α) => _inst_1 a b) s a) 𝒜)))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] [_inst_2 : Fintype.{u1} α] {𝒜 : Finset.{u1} (Finset.{u1} α)} {s : Finset.{u1} α}, Iff (Membership.mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.instMembershipFinset.{u1} (Finset.{u1} α)) s (Finset.upShadow.{u1} α (fun (a : α) (b : α) => _inst_1 a b) _inst_2 𝒜)) (Exists.{succ u1} α (fun (a : α) => And (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a s) (Membership.mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.instMembershipFinset.{u1} (Finset.{u1} α)) (Finset.erase.{u1} α (fun (a : α) (b : α) => _inst_1 a b) s a) 𝒜)))
Case conversion may be inaccurate. Consider using '#align finset.mem_up_shadow_iff_erase_mem Finset.mem_upShadow_iff_erase_memₓ'. -/
/-- `t` is in the upper shadow of `𝒜` iff we can remove an element from it so that the resulting
finset is in `𝒜`. -/
theorem mem_upShadow_iff_erase_mem : s ∈ (∂⁺ ) 𝒜 ↔ ∃ a ∈ s, s.eraseₓ a ∈ 𝒜 :=
  by
  refine' mem_up_shadow_iff.trans ⟨_, _⟩
  · rintro ⟨s, hs, a, ha, rfl⟩
    refine' ⟨a, mem_insert_self a s, _⟩
    rwa [erase_insert ha]
  · rintro ⟨a, ha, hs⟩
    exact ⟨s.erase a, hs, a, not_mem_erase _ _, insert_erase ha⟩
#align finset.mem_up_shadow_iff_erase_mem Finset.mem_upShadow_iff_erase_mem

/- warning: finset.mem_up_shadow_iff_exists_mem_card_add_one -> Finset.mem_upShadow_iff_exists_mem_card_add_one is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] [_inst_2 : Fintype.{u1} α] {𝒜 : Finset.{u1} (Finset.{u1} α)} {s : Finset.{u1} α}, Iff (Membership.Mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.hasMem.{u1} (Finset.{u1} α)) s (Finset.upShadow.{u1} α (fun (a : α) (b : α) => _inst_1 a b) _inst_2 𝒜)) (Exists.{succ u1} (Finset.{u1} α) (fun (t : Finset.{u1} α) => Exists.{0} (Membership.Mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.hasMem.{u1} (Finset.{u1} α)) t 𝒜) (fun (H : Membership.Mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.hasMem.{u1} (Finset.{u1} α)) t 𝒜) => And (HasSubset.Subset.{u1} (Finset.{u1} α) (Finset.hasSubset.{u1} α) t s) (Eq.{1} Nat (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) (Finset.card.{u1} α t) (OfNat.ofNat.{0} Nat 1 (OfNat.mk.{0} Nat 1 (One.one.{0} Nat Nat.hasOne)))) (Finset.card.{u1} α s)))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] [_inst_2 : Fintype.{u1} α] {𝒜 : Finset.{u1} (Finset.{u1} α)} {s : Finset.{u1} α}, Iff (Membership.mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.instMembershipFinset.{u1} (Finset.{u1} α)) s (Finset.upShadow.{u1} α (fun (a : α) (b : α) => _inst_1 a b) _inst_2 𝒜)) (Exists.{succ u1} (Finset.{u1} α) (fun (t : Finset.{u1} α) => And (Membership.mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.instMembershipFinset.{u1} (Finset.{u1} α)) t 𝒜) (And (HasSubset.Subset.{u1} (Finset.{u1} α) (Finset.instHasSubsetFinset.{u1} α) t s) (Eq.{1} Nat (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) (Finset.card.{u1} α t) (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1))) (Finset.card.{u1} α s)))))
Case conversion may be inaccurate. Consider using '#align finset.mem_up_shadow_iff_exists_mem_card_add_one Finset.mem_upShadow_iff_exists_mem_card_add_oneₓ'. -/
/-- `s ∈ ∂⁺ 𝒜` iff `s` is exactly one element less than something from `𝒜`. -/
theorem mem_upShadow_iff_exists_mem_card_add_one :
    s ∈ (∂⁺ ) 𝒜 ↔ ∃ t ∈ 𝒜, t ⊆ s ∧ t.card + 1 = s.card :=
  by
  refine' mem_up_shadow_iff_erase_mem.trans ⟨_, _⟩
  · rintro ⟨a, ha, hs⟩
    exact ⟨s.erase a, hs, erase_subset _ _, card_erase_add_one ha⟩
  · rintro ⟨t, ht, hts, h⟩
    obtain ⟨a, ha⟩ : ∃ a, s \ t = {a} :=
      card_eq_one.1 (by rw [card_sdiff hts, ← h, add_tsub_cancel_left])
    refine' ⟨a, sdiff_subset _ _ ((ha.ge : _ ⊆ _) <| mem_singleton_self a), _⟩
    rwa [← sdiff_singleton_eq_erase, ← ha, sdiff_sdiff_eq_self hts]
#align finset.mem_up_shadow_iff_exists_mem_card_add_one Finset.mem_upShadow_iff_exists_mem_card_add_one

/- warning: finset.exists_subset_of_mem_up_shadow -> Finset.exists_subset_of_mem_upShadow is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] [_inst_2 : Fintype.{u1} α] {𝒜 : Finset.{u1} (Finset.{u1} α)} {s : Finset.{u1} α}, (Membership.Mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.hasMem.{u1} (Finset.{u1} α)) s (Finset.upShadow.{u1} α (fun (a : α) (b : α) => _inst_1 a b) _inst_2 𝒜)) -> (Exists.{succ u1} (Finset.{u1} α) (fun (t : Finset.{u1} α) => Exists.{0} (Membership.Mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.hasMem.{u1} (Finset.{u1} α)) t 𝒜) (fun (H : Membership.Mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.hasMem.{u1} (Finset.{u1} α)) t 𝒜) => HasSubset.Subset.{u1} (Finset.{u1} α) (Finset.hasSubset.{u1} α) t s)))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] [_inst_2 : Fintype.{u1} α] {𝒜 : Finset.{u1} (Finset.{u1} α)} {s : Finset.{u1} α}, (Membership.mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.instMembershipFinset.{u1} (Finset.{u1} α)) s (Finset.upShadow.{u1} α (fun (a : α) (b : α) => _inst_1 a b) _inst_2 𝒜)) -> (Exists.{succ u1} (Finset.{u1} α) (fun (t : Finset.{u1} α) => And (Membership.mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.instMembershipFinset.{u1} (Finset.{u1} α)) t 𝒜) (HasSubset.Subset.{u1} (Finset.{u1} α) (Finset.instHasSubsetFinset.{u1} α) t s)))
Case conversion may be inaccurate. Consider using '#align finset.exists_subset_of_mem_up_shadow Finset.exists_subset_of_mem_upShadowₓ'. -/
/-- Being in the upper shadow of `𝒜` means we have a superset in `𝒜`. -/
theorem exists_subset_of_mem_upShadow (hs : s ∈ (∂⁺ ) 𝒜) : ∃ t ∈ 𝒜, t ⊆ s :=
  let ⟨t, ht, hts, _⟩ := mem_upShadow_iff_exists_mem_card_add_one.1 hs
  ⟨t, ht, hts⟩
#align finset.exists_subset_of_mem_up_shadow Finset.exists_subset_of_mem_upShadow

/- warning: finset.mem_up_shadow_iff_exists_mem_card_add -> Finset.mem_upShadow_iff_exists_mem_card_add is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] [_inst_2 : Fintype.{u1} α] {𝒜 : Finset.{u1} (Finset.{u1} α)} {s : Finset.{u1} α} {k : Nat}, Iff (Membership.Mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.hasMem.{u1} (Finset.{u1} α)) s (Nat.iterate.{succ u1} (Finset.{u1} (Finset.{u1} α)) (Finset.upShadow.{u1} α (fun (a : α) (b : α) => _inst_1 a b) _inst_2) k 𝒜)) (Exists.{succ u1} (Finset.{u1} α) (fun (t : Finset.{u1} α) => Exists.{0} (Membership.Mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.hasMem.{u1} (Finset.{u1} α)) t 𝒜) (fun (H : Membership.Mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.hasMem.{u1} (Finset.{u1} α)) t 𝒜) => And (HasSubset.Subset.{u1} (Finset.{u1} α) (Finset.hasSubset.{u1} α) t s) (Eq.{1} Nat (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat Nat.hasAdd) (Finset.card.{u1} α t) k) (Finset.card.{u1} α s)))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] [_inst_2 : Fintype.{u1} α] {𝒜 : Finset.{u1} (Finset.{u1} α)} {s : Finset.{u1} α} {k : Nat}, Iff (Membership.mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.instMembershipFinset.{u1} (Finset.{u1} α)) s (Nat.iterate.{succ u1} (Finset.{u1} (Finset.{u1} α)) (Finset.upShadow.{u1} α (fun (a : α) (b : α) => _inst_1 a b) _inst_2) k 𝒜)) (Exists.{succ u1} (Finset.{u1} α) (fun (t : Finset.{u1} α) => And (Membership.mem.{u1, u1} (Finset.{u1} α) (Finset.{u1} (Finset.{u1} α)) (Finset.instMembershipFinset.{u1} (Finset.{u1} α)) t 𝒜) (And (HasSubset.Subset.{u1} (Finset.{u1} α) (Finset.instHasSubsetFinset.{u1} α) t s) (Eq.{1} Nat (HAdd.hAdd.{0, 0, 0} Nat Nat Nat (instHAdd.{0} Nat instAddNat) (Finset.card.{u1} α t) k) (Finset.card.{u1} α s)))))
Case conversion may be inaccurate. Consider using '#align finset.mem_up_shadow_iff_exists_mem_card_add Finset.mem_upShadow_iff_exists_mem_card_addₓ'. -/
/-- `t ∈ ∂^k 𝒜` iff `t` is exactly `k` elements more than something in `𝒜`. -/
theorem mem_upShadow_iff_exists_mem_card_add :
    s ∈ (∂⁺ ^[k]) 𝒜 ↔ ∃ t ∈ 𝒜, t ⊆ s ∧ t.card + k = s.card :=
  by
  induction' k with k ih generalizing 𝒜 s
  · refine' ⟨fun hs => ⟨s, hs, subset.refl _, rfl⟩, _⟩
    rintro ⟨t, ht, hst, hcard⟩
    rwa [← eq_of_subset_of_card_le hst hcard.ge]
  simp only [exists_prop, Function.comp_apply, Function.iterate_succ]
  refine' ih.trans _
  clear ih
  constructor
  · rintro ⟨t, ht, hts, hcardst⟩
    obtain ⟨u, hu, hut, hcardtu⟩ := mem_up_shadow_iff_exists_mem_card_add_one.1 ht
    refine' ⟨u, hu, hut.trans hts, _⟩
    rw [← hcardst, ← hcardtu, add_right_comm]
    rfl
  · rintro ⟨t, ht, hts, hcard⟩
    obtain ⟨u, htu, hus, hu⟩ :=
      Finset.exists_intermediate_set 1
        (by
          rw [add_comm, ← hcard]
          exact add_le_add_left (zero_lt_succ _) _)
        hts
    rw [add_comm] at hu
    refine' ⟨u, mem_up_shadow_iff_exists_mem_card_add_one.2 ⟨t, ht, htu, hu.symm⟩, hus, _⟩
    rw [hu, ← hcard, add_right_comm]
    rfl
#align finset.mem_up_shadow_iff_exists_mem_card_add Finset.mem_upShadow_iff_exists_mem_card_add

#print Finset.shadow_image_compl /-
@[simp]
theorem shadow_image_compl : ((∂ ) 𝒜).image compl = (∂⁺ ) (𝒜.image compl) :=
  by
  ext s
  simp only [mem_image, exists_prop, mem_shadow_iff, mem_up_shadow_iff]
  constructor
  · rintro ⟨_, ⟨s, hs, a, ha, rfl⟩, rfl⟩
    exact ⟨sᶜ, ⟨s, hs, rfl⟩, a, not_mem_compl.2 ha, compl_erase.symm⟩
  · rintro ⟨_, ⟨s, hs, rfl⟩, a, ha, rfl⟩
    exact ⟨s.erase a, ⟨s, hs, a, not_mem_compl.1 ha, rfl⟩, compl_erase⟩
#align finset.shadow_image_compl Finset.shadow_image_compl
-/

#print Finset.upShadow_image_compl /-
@[simp]
theorem upShadow_image_compl : ((∂⁺ ) 𝒜).image compl = (∂ ) (𝒜.image compl) :=
  by
  ext s
  simp only [mem_image, exists_prop, mem_shadow_iff, mem_up_shadow_iff]
  constructor
  · rintro ⟨_, ⟨s, hs, a, ha, rfl⟩, rfl⟩
    exact ⟨sᶜ, ⟨s, hs, rfl⟩, a, mem_compl.2 ha, compl_insert.symm⟩
  · rintro ⟨_, ⟨s, hs, rfl⟩, a, ha, rfl⟩
    exact ⟨insert a s, ⟨s, hs, a, mem_compl.1 ha, rfl⟩, compl_insert⟩
#align finset.up_shadow_image_compl Finset.upShadow_image_compl
-/

end UpShadow

end Finset


-- Transitividad de la igualdad en Lean
-- ====================================

-- Demostrar que si x, y y z son números reales tales que
-- x = y e y = z, entonces x = z.

import data.real.basic

variables (x y z : ℝ)

-- 1ª demostración
example
  (h : x = y)
  (h' : y = z)
  : x = z :=
begin
  rw h,
  exact h',
end

-- 2ª demostración
example
  (h : x = y)
  (h' : y = z)
  : x = z :=
begin
  rw ← h',
  exact h,
end

-- 3ª demostración
example
  (h : x = y)
  (h' : y = z)
  : x = z :=
begin
  rw h' at h,
  exact h,
end

-- 4ª demostración
example
  (h : x = y)
  (h' : y = z)
  : x = z :=
begin
  rw ← h at h',
  exact h',
end

-- 5ª demostración
example
  (h : x = y)
  (h' : y = z)
  : x = z :=
eq.trans h h'

-- 6ª demostración
example
  (h : x = y)
  (h' : y = z)
  : x = z :=
h' ▸ h

-- 7ª demostración
example
  (h : x = y)
  (h' : y = z)
  : x = z :=
by linarith

-- 8ª demostración
example
  (h : x = y)
  (h' : y = z)
  : x = z :=
by finish