/-
Copyright (c) 2019 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/
import order.filter.bases

/-!
# Lift filters along filter and set functions

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

open set

open_locale classical filter

namespace filter
variables {α : Type*} {β : Type*} {γ : Type*} {ι : Sort*}

section lift

/-- A variant on `bind` using a function `g` taking a set instead of a member of `α`.
This is essentially a push-forward along a function mapping each set to a filter. -/
protected def lift (f : filter α) (g : set α → filter β) :=
⨅s ∈ f, g s

variables {f f₁ f₂ : filter α} {g g₁ g₂ : set α → filter β}

@[simp] lemma lift_top (g : set α → filter β) : (⊤ : filter α).lift g = g univ :=
by simp [filter.lift]

/-- If `(p : ι → Prop, s : ι → set α)` is a basis of a filter `f`, `g` is a monotone function
`set α → filter γ`, and for each `i`, `(pg : β i → Prop, sg : β i → set α)` is a basis
of the filter `g (s i)`, then `(λ (i : ι) (x : β i), p i ∧ pg i x, λ (i : ι) (x : β i), sg i x)`
is a basis of the filter `f.lift g`.

This basis is parametrized by `i : ι` and `x : β i`, so in order to formulate this fact using
`has_basis` one has to use `Σ i, β i` as the index type, see `filter.has_basis.lift`.
This lemma states the corresponding `mem_iff` statement without using a sigma type. -/
lemma has_basis.mem_lift_iff {ι} {p : ι → Prop} {s : ι → set α} {f : filter α}
  (hf : f.has_basis p s) {β : ι → Type*} {pg : Π i, β i → Prop} {sg : Π i, β i → set γ}
  {g : set α → filter γ} (hg : ∀ i, (g $ s i).has_basis (pg i) (sg i)) (gm : monotone g)
  {s : set γ} :
  s ∈ f.lift g ↔ ∃ (i : ι) (hi : p i) (x : β i) (hx : pg i x), sg i x ⊆ s :=
begin
  refine (mem_binfi_of_directed _ ⟨univ, univ_sets _⟩).trans _,
  { intros t₁ ht₁ t₂ ht₂,
    exact ⟨t₁ ∩ t₂, inter_mem ht₁ ht₂, gm $ inter_subset_left _ _,
      gm $ inter_subset_right _ _⟩ },
  { simp only [← (hg _).mem_iff],
    exact hf.exists_iff (λ t₁ t₂ ht H, gm ht H) }
end

/-- If `(p : ι → Prop, s : ι → set α)` is a basis of a filter `f`, `g` is a monotone function
`set α → filter γ`, and for each `i`, `(pg : β i → Prop, sg : β i → set α)` is a basis
of the filter `g (s i)`, then `(λ (i : ι) (x : β i), p i ∧ pg i x, λ (i : ι) (x : β i), sg i x)`
is a basis of the filter `f.lift g`.

This basis is parametrized by `i : ι` and `x : β i`, so in order to formulate this fact using
`has_basis` one has to use `Σ i, β i` as the index type. See also `filter.has_basis.mem_lift_iff`
for the corresponding `mem_iff` statement formulated without using a sigma type. -/
lemma has_basis.lift {ι} {p : ι → Prop} {s : ι → set α} {f : filter α} (hf : f.has_basis p s)
  {β : ι → Type*} {pg : Π i, β i → Prop} {sg : Π i, β i → set γ} {g : set α → filter γ}
  (hg : ∀ i, (g $ s i).has_basis (pg i) (sg i)) (gm : monotone g) :
  (f.lift g).has_basis (λ i : Σ i, β i, p i.1 ∧ pg i.1 i.2) (λ i : Σ i, β i, sg i.1 i.2) :=
begin
  refine ⟨λ t, (hf.mem_lift_iff hg gm).trans _⟩,
  simp [sigma.exists, and_assoc, exists_and_distrib_left]
end

lemma mem_lift_sets (hg : monotone g) {s : set β} :
  s ∈ f.lift g ↔ ∃t∈f, s ∈ g t :=
(f.basis_sets.mem_lift_iff (λ s, (g s).basis_sets) hg).trans $
  by simp only [id, exists_mem_subset_iff]

lemma sInter_lift_sets (hg : monotone g) :
  ⋂₀ {s | s ∈ f.lift g} = ⋂ s ∈ f, ⋂₀ {t | t ∈ g s} :=
by simp only [sInter_eq_bInter, mem_set_of_eq, filter.mem_sets, mem_lift_sets hg,
  Inter_exists, @Inter_comm _ (set β)]

lemma mem_lift {s : set β} {t : set α} (ht : t ∈ f) (hs : s ∈ g t) :
  s ∈ f.lift g :=
le_principal_iff.mp $ show f.lift g ≤ 𝓟 s,
  from infi_le_of_le t $ infi_le_of_le ht $ le_principal_iff.mpr hs

lemma lift_le {f : filter α} {g : set α → filter β} {h : filter β} {s : set α}
  (hs : s ∈ f) (hg : g s ≤ h) : f.lift g ≤ h :=
infi₂_le_of_le s hs hg

lemma le_lift {f : filter α} {g : set α → filter β} {h : filter β} :
  h ≤ f.lift g ↔ ∀ s ∈ f, h ≤ g s :=
le_infi₂_iff

lemma lift_mono (hf : f₁ ≤ f₂) (hg : g₁ ≤ g₂) : f₁.lift g₁ ≤ f₂.lift g₂ :=
infi_mono $ λ s, infi_mono' $ λ hs, ⟨hf hs, hg s⟩

lemma lift_mono' (hg : ∀s ∈ f, g₁ s ≤ g₂ s) : f.lift g₁ ≤ f.lift g₂ := infi₂_mono hg

lemma tendsto_lift {m : γ → β} {l : filter γ} :
  tendsto m l (f.lift g) ↔ ∀ s ∈ f, tendsto m l (g s) :=
by simp only [filter.lift, tendsto_infi]

lemma map_lift_eq {m : β → γ} (hg : monotone g) : map m (f.lift g) = f.lift (map m ∘ g) :=
have monotone (map m ∘ g),
  from map_mono.comp hg,
filter.ext $ λ s,
  by simp only [mem_lift_sets hg, mem_lift_sets this, exists_prop, mem_map, function.comp_app]

lemma comap_lift_eq {m : γ → β} : comap m (f.lift g) = f.lift (comap m ∘ g) :=
by simp only [filter.lift, comap_infi]

theorem comap_lift_eq2 {m : β → α} {g : set β → filter γ} (hg : monotone g) :
  (comap m f).lift g = f.lift (g ∘ preimage m) :=
le_antisymm
  (le_infi₂ $ λ s hs, infi₂_le (m ⁻¹' s) ⟨s, hs, subset.rfl⟩)
  (le_infi₂ $ λ s ⟨s', hs', (h_sub : m ⁻¹' s' ⊆ s)⟩, infi₂_le_of_le s' hs' $ hg h_sub)

lemma lift_map_le {g : set β → filter γ} {m : α → β} :
  (map m f).lift g ≤ f.lift (g ∘ image m) :=
le_lift.2 $ λ s hs, lift_le (image_mem_map hs) le_rfl

lemma map_lift_eq2 {g : set β → filter γ} {m : α → β} (hg : monotone g) :
  (map m f).lift g = f.lift (g ∘ image m) :=
lift_map_le.antisymm $ le_lift.2 $ λ s hs, lift_le hs $ hg $ image_preimage_subset _ _

lemma lift_comm {g : filter β} {h : set α → set β → filter γ} :
  f.lift (λs, g.lift (h s)) = g.lift (λt, f.lift (λs, h s t)) :=
le_antisymm
  (le_infi $ assume i, le_infi $ assume hi, le_infi $ assume j, le_infi $ assume hj,
    infi_le_of_le j $ infi_le_of_le hj $ infi_le_of_le i $ infi_le _ hi)
  (le_infi $ assume i, le_infi $ assume hi, le_infi $ assume j, le_infi $ assume hj,
    infi_le_of_le j $ infi_le_of_le hj $ infi_le_of_le i $ infi_le _ hi)

lemma lift_assoc {h : set β → filter γ} (hg : monotone g)  :
  (f.lift g).lift h = f.lift (λs, (g s).lift h) :=
le_antisymm
  (le_infi $ assume s, le_infi $ assume hs, le_infi $ assume t, le_infi $ assume ht,
    infi_le_of_le t $ infi_le _ $ (mem_lift_sets hg).mpr ⟨_, hs, ht⟩)
  (le_infi $ assume t, le_infi $ assume ht,
    let ⟨s, hs, h'⟩ := (mem_lift_sets hg).mp ht in
    infi_le_of_le s $ infi_le_of_le hs $ infi_le_of_le t $ infi_le _ h')

lemma lift_lift_same_le_lift {g : set α → set α → filter β} :
  f.lift (λs, f.lift (g s)) ≤ f.lift (λs, g s s) :=
le_lift.2 $ λ s hs, lift_le hs $ lift_le hs le_rfl

lemma lift_lift_same_eq_lift {g : set α → set α → filter β}
  (hg₁ : ∀s, monotone (λt, g s t)) (hg₂ : ∀t, monotone (λs, g s t)) :
  f.lift (λs, f.lift (g s)) = f.lift (λs, g s s) :=
lift_lift_same_le_lift.antisymm $
  le_lift.2 $ λ s hs, le_lift.2 $ λ t ht, lift_le (inter_mem hs ht) $
    calc g (s ∩ t) (s ∩ t) ≤ g s (s ∩ t) : hg₂ (s ∩ t) (inter_subset_left _ _)
                       ... ≤ g s t       : hg₁ s (inter_subset_right _ _)

lemma lift_principal {s : set α} (hg : monotone g) :
  (𝓟 s).lift g = g s :=
(lift_le (mem_principal_self _) le_rfl).antisymm (le_lift.2 $ λ t ht, hg ht)

theorem monotone_lift [preorder γ] {f : γ → filter α} {g : γ → set α → filter β}
  (hf : monotone f) (hg : monotone g) : monotone (λc, (f c).lift (g c)) :=
assume a b h, lift_mono (hf h) (hg h)

lemma lift_ne_bot_iff (hm : monotone g) : (ne_bot $ f.lift g) ↔ (∀s∈f, ne_bot (g s)) :=
by simp only [ne_bot_iff, ne.def, ← empty_mem_iff_bot, mem_lift_sets hm, not_exists]

@[simp] lemma lift_const {f : filter α} {g : filter β} : f.lift (λx, g) = g :=
infi_subtype'.trans infi_const

@[simp] lemma lift_inf {f : filter α} {g h : set α → filter β} :
  f.lift (λx, g x ⊓ h x) = f.lift g ⊓ f.lift h :=
by simp only [filter.lift, infi_inf_eq]

@[simp] lemma lift_principal2 {f : filter α} : f.lift 𝓟 = f :=
le_antisymm
  (assume s hs, mem_lift hs (mem_principal_self s))
  (le_infi $ assume s, le_infi $ assume hs, by simp only [hs, le_principal_iff])

lemma lift_infi_le {f : ι → filter α} {g : set α → filter β} :
  (infi f).lift g ≤ ⨅ i, (f i).lift g :=
le_infi $ λ i, lift_mono (infi_le _ _) le_rfl

lemma lift_infi [nonempty ι] {f : ι → filter α} {g : set α → filter β}
  (hg : ∀ s t, g (s ∩ t) = g s ⊓ g t) : (infi f).lift g = (⨅i, (f i).lift g) :=
begin
  refine lift_infi_le.antisymm (λ s, _),
  have H : ∀ t ∈ infi f, (⨅ i, (f i).lift g) ≤ g t,
  { intros t ht,
    refine infi_sets_induct ht _ (λ i s t hs ht, _),
    { inhabit ι,
      exact infi₂_le_of_le default univ (infi_le _ univ_mem) },
    { rw hg,
      exact le_inf (infi₂_le_of_le i s $ infi_le _ hs) ht } },
  simp only [mem_lift_sets (monotone.of_map_inf hg), exists_imp_distrib],
  exact λ t ht hs, H t ht hs
end

lemma lift_infi_of_directed [nonempty ι] {f : ι → filter α} {g : set α → filter β}
  (hf : directed (≥) f) (hg : monotone g) : (infi f).lift g = (⨅i, (f i).lift g) :=
lift_infi_le.antisymm $ λ s,
  begin
    simp only [mem_lift_sets hg, exists_imp_distrib, mem_infi_of_directed hf],
    exact assume t i ht hs, mem_infi_of_mem i $ mem_lift ht hs
  end

lemma lift_infi_of_map_univ {f : ι → filter α} {g : set α → filter β}
  (hg : ∀ s t, g (s ∩ t) = g s ⊓ g t) (hg' : g univ = ⊤) :
  (infi f).lift g = (⨅i, (f i).lift g) :=
begin
  casesI is_empty_or_nonempty ι,
  { simp [infi_of_empty, hg'] },
  { exact lift_infi hg }
end

end lift

section lift'
/-- Specialize `lift` to functions `set α → set β`. This can be viewed as a generalization of `map`.
This is essentially a push-forward along a function mapping each set to a set. -/
protected def lift' (f : filter α) (h : set α → set β) :=
f.lift (𝓟 ∘ h)

variables {f f₁ f₂ : filter α} {h h₁ h₂ : set α → set β}

@[simp] lemma lift'_top (h : set α → set β) : (⊤ : filter α).lift' h = 𝓟 (h univ) :=
lift_top _

lemma mem_lift' {t : set α} (ht : t ∈ f) : h t ∈ (f.lift' h) :=
le_principal_iff.mp $ show f.lift' h ≤ 𝓟 (h t),
  from infi_le_of_le t $ infi_le_of_le ht $ le_rfl

lemma tendsto_lift' {m : γ → β} {l : filter γ} :
  tendsto m l (f.lift' h) ↔ ∀ s ∈ f, ∀ᶠ a in l, m a ∈ h s :=
by simp only [filter.lift', tendsto_lift, tendsto_principal]

lemma has_basis.lift' {ι} {p : ι → Prop} {s} (hf : f.has_basis p s) (hh : monotone h) :
  (f.lift' h).has_basis p (h ∘ s) :=
begin
  refine ⟨λ t, (hf.mem_lift_iff _ (monotone_principal.comp hh)).trans _⟩,
  show ∀ i, (𝓟 (h (s i))).has_basis (λ j : unit, true) (λ (j : unit), h (s i)),
    from λ i, has_basis_principal _,
  simp only [exists_const]
end

lemma mem_lift'_sets (hh : monotone h) {s : set β} : s ∈ f.lift' h ↔ ∃ t ∈ f, h t ⊆ s :=
mem_lift_sets $ monotone_principal.comp hh

lemma eventually_lift'_iff (hh : monotone h) {p : β → Prop} :
  (∀ᶠ y in f.lift' h, p y) ↔ (∃ t ∈ f, ∀ y ∈ h t, p y) :=
mem_lift'_sets hh

lemma sInter_lift'_sets (hh : monotone h) :
  ⋂₀ {s | s ∈ f.lift' h} = ⋂ s ∈ f, h s :=
(sInter_lift_sets (monotone_principal.comp hh)).trans $ Inter₂_congr $ λ s hs, cInf_Ici

lemma lift'_le {f : filter α} {g : set α → set β} {h : filter β} {s : set α}
  (hs : s ∈ f) (hg : 𝓟 (g s) ≤ h) : f.lift' g ≤ h :=
lift_le hs hg

lemma lift'_mono (hf : f₁ ≤ f₂) (hh : h₁ ≤ h₂) : f₁.lift' h₁ ≤ f₂.lift' h₂ :=
lift_mono hf $ assume s, principal_mono.mpr $ hh s

lemma lift'_mono' (hh : ∀s∈f, h₁ s ⊆ h₂ s) : f.lift' h₁ ≤ f.lift' h₂ :=
infi₂_mono $ λ s hs, principal_mono.mpr $ hh s hs

lemma lift'_cong (hh : ∀s∈f, h₁ s = h₂ s) : f.lift' h₁ = f.lift' h₂ :=
le_antisymm (lift'_mono' $ assume s hs, le_of_eq $ hh s hs)
  (lift'_mono' $ assume s hs, le_of_eq $ (hh s hs).symm)

lemma map_lift'_eq {m : β → γ} (hh : monotone h) : map m (f.lift' h) = f.lift' (image m ∘ h) :=
calc map m (f.lift' h) = f.lift (map m ∘ 𝓟 ∘ h) :
    map_lift_eq $ monotone_principal.comp hh
  ... = f.lift' (image m ∘ h) : by simp only [(∘), filter.lift', map_principal, eq_self_iff_true]

lemma lift'_map_le {g : set β → set γ} {m : α → β} : (map m f).lift' g ≤ f.lift' (g ∘ image m) :=
lift_map_le

lemma map_lift'_eq2 {g : set β → set γ} {m : α → β} (hg : monotone g) :
  (map m f).lift' g = f.lift' (g ∘ image m) :=
map_lift_eq2 $ monotone_principal.comp hg

theorem comap_lift'_eq {m : γ → β} : comap m (f.lift' h) = f.lift' (preimage m ∘ h) :=
by simp only [filter.lift', comap_lift_eq, (∘), comap_principal]

theorem comap_lift'_eq2 {m : β → α} {g : set β → set γ} (hg : monotone g) :
  (comap m f).lift' g = f.lift' (g ∘ preimage m) :=
comap_lift_eq2 $ monotone_principal.comp hg

lemma lift'_principal {s : set α} (hh : monotone h) :
  (𝓟 s).lift' h = 𝓟 (h s) :=
lift_principal $ monotone_principal.comp hh

lemma lift'_bot (hh : monotone h) : (⊥ : filter α).lift' h = 𝓟 (h ∅) :=
by rw [← principal_empty, lift'_principal hh]

lemma le_lift' {f : filter α} {h : set α → set β} {g : filter β} :
  g ≤ f.lift' h ↔ ∀ s ∈ f, h s ∈ g :=
le_lift.trans $ forall₂_congr $ λ s hs, le_principal_iff

lemma principal_le_lift' {t : set β} : 𝓟 t ≤ f.lift' h ↔ ∀ s ∈ f, t ⊆ h s := le_lift'

theorem monotone_lift' [preorder γ] {f : γ → filter α} {g : γ → set α → set β}
  (hf : monotone f) (hg : monotone g) : monotone (λc, (f c).lift' (g c)) :=
assume a b h, lift'_mono (hf h) (hg h)

lemma lift_lift'_assoc {g : set α → set β} {h : set β → filter γ}
  (hg : monotone g) (hh : monotone h) :
  (f.lift' g).lift h = f.lift (λs, h (g s)) :=
calc (f.lift' g).lift h = f.lift (λs, (𝓟 (g s)).lift h) :
    lift_assoc (monotone_principal.comp hg)
  ... = f.lift (λs, h (g s)) : by simp only [lift_principal, hh, eq_self_iff_true]

lemma lift'_lift'_assoc {g : set α → set β} {h : set β → set γ}
  (hg : monotone g) (hh : monotone h) :
  (f.lift' g).lift' h = f.lift' (λs, h (g s)) :=
lift_lift'_assoc hg (monotone_principal.comp hh)

lemma lift'_lift_assoc {g : set α → filter β} {h : set β → set γ}
  (hg : monotone g) : (f.lift g).lift' h = f.lift (λs, (g s).lift' h) :=
lift_assoc hg

lemma lift_lift'_same_le_lift' {g : set α → set α → set β} :
  f.lift (λs, f.lift' (g s)) ≤ f.lift' (λs, g s s) :=
lift_lift_same_le_lift

lemma lift_lift'_same_eq_lift' {g : set α → set α → set β}
  (hg₁ : ∀s, monotone (λt, g s t)) (hg₂ : ∀t, monotone (λs, g s t)) :
  f.lift (λs, f.lift' (g s)) = f.lift' (λs, g s s) :=
lift_lift_same_eq_lift
  (assume s, monotone_principal.comp (hg₁ s))
  (assume t, monotone_principal.comp (hg₂ t))

lemma lift'_inf_principal_eq {h : set α → set β} {s : set β} :
  f.lift' h ⊓ 𝓟 s = f.lift' (λt, h t ∩ s) :=
by simp only [filter.lift', filter.lift, (∘), ← inf_principal, infi_subtype', ← infi_inf]

lemma lift'_ne_bot_iff (hh : monotone h) : (ne_bot (f.lift' h)) ↔ (∀s∈f, (h s).nonempty) :=
calc (ne_bot (f.lift' h)) ↔ (∀s∈f, ne_bot (𝓟 (h s))) :
    lift_ne_bot_iff (monotone_principal.comp hh)
  ... ↔ (∀s∈f, (h s).nonempty) : by simp only [principal_ne_bot_iff]

@[simp] lemma lift'_id {f : filter α} : f.lift' id = f :=
lift_principal2

lemma lift'_infi [nonempty ι] {f : ι → filter α} {g : set α → set β}
  (hg : ∀ s t, g (s ∩ t) = g s ∩ g t) : (infi f).lift' g = (⨅ i, (f i).lift' g) :=
lift_infi $ λ s t, by rw [inf_principal, (∘), ← hg]

lemma lift'_infi_of_map_univ {f : ι → filter α} {g : set α → set β}
  (hg : ∀{s t}, g (s ∩ t) = g s ∩ g t) (hg' : g univ = univ) :
  (infi f).lift' g = (⨅ i, (f i).lift' g) :=
lift_infi_of_map_univ (λ s t, by rw [inf_principal, (∘), ← hg])
  (by rw [function.comp_app, hg', principal_univ])

lemma lift'_inf (f g : filter α) {s : set α → set β} (hs : ∀ t₁ t₂, s (t₁ ∩ t₂) = s t₁ ∩ s t₂) :
  (f ⊓ g).lift' s = f.lift' s ⊓ g.lift' s :=
have (⨅ b : bool, cond b f g).lift' s = ⨅ b : bool, (cond b f g).lift' s :=
  lift'_infi @hs,
by simpa only [infi_bool_eq]

lemma lift'_inf_le (f g : filter α) (s : set α → set β) :
  (f ⊓ g).lift' s ≤ f.lift' s ⊓ g.lift' s :=
le_inf (lift'_mono inf_le_left le_rfl) (lift'_mono inf_le_right le_rfl)

theorem comap_eq_lift' {f : filter β} {m : α → β} :
  comap m f = f.lift' (preimage m) :=
filter.ext $ λ s, (mem_lift'_sets monotone_preimage).symm

end lift'

section prod
variables {f : filter α}

lemma prod_def {f : filter α} {g : filter β} : f ×ᶠ g = (f.lift $ λ s, g.lift' $ λ t, s ×ˢ t) :=
have ∀(s:set α) (t : set β),
    𝓟 (s ×ˢ t) = (𝓟 s).comap prod.fst ⊓ (𝓟 t).comap prod.snd,
  by simp only [principal_eq_iff_eq, comap_principal, inf_principal]; intros; refl,
begin
  simp only [filter.lift', function.comp, this, lift_inf, lift_const, lift_inf],
  rw [← comap_lift_eq, ← comap_lift_eq],
  simp only [filter.prod, lift_principal2]
end

lemma prod_same_eq : f ×ᶠ f = f.lift' (λ t : set α, t ×ˢ t) :=
prod_def.trans $ lift_lift'_same_eq_lift'
  (λ s, monotone_const.set_prod monotone_id)
  (λ t, monotone_id.set_prod monotone_const)

lemma mem_prod_same_iff {s : set (α×α)} :
  s ∈ f ×ᶠ f ↔ (∃t∈f, t ×ˢ t ⊆ s) :=
by { rw [prod_same_eq, mem_lift'_sets], exact monotone_id.set_prod monotone_id }

lemma tendsto_prod_self_iff {f : α × α → β} {x : filter α} {y : filter β} :
  filter.tendsto f (x ×ᶠ x) y ↔
  ∀ W ∈ y, ∃ U ∈ x, ∀ (x x' : α), x ∈ U → x' ∈ U → f (x, x') ∈ W :=
by simp only [tendsto_def, mem_prod_same_iff, prod_sub_preimage_iff, exists_prop, iff_self]

variables {α₁ : Type*} {α₂ : Type*} {β₁ : Type*} {β₂ : Type*}

lemma prod_lift_lift
  {f₁ : filter α₁} {f₂ : filter α₂} {g₁ : set α₁ → filter β₁} {g₂ : set α₂ → filter β₂}
  (hg₁ : monotone g₁) (hg₂ : monotone g₂) :
  (f₁.lift g₁) ×ᶠ (f₂.lift g₂) = f₁.lift (λs, f₂.lift (λt, g₁ s ×ᶠ g₂ t)) :=
begin
  simp only [prod_def, lift_assoc hg₁],
  apply congr_arg, funext x,
  rw [lift_comm],
  apply congr_arg, funext y,
  apply lift'_lift_assoc hg₂
end

lemma prod_lift'_lift'
  {f₁ : filter α₁} {f₂ : filter α₂} {g₁ : set α₁ → set β₁} {g₂ : set α₂ → set β₂}
  (hg₁ : monotone g₁) (hg₂ : monotone g₂) :
  f₁.lift' g₁ ×ᶠ f₂.lift' g₂ = f₁.lift (λ s, f₂.lift' (λ t, g₁ s ×ˢ g₂ t)) :=
calc f₁.lift' g₁ ×ᶠ f₂.lift' g₂ = f₁.lift (λ s, f₂.lift (λ t, 𝓟 (g₁ s) ×ᶠ 𝓟 (g₂ t))) :
  prod_lift_lift (monotone_principal.comp hg₁) (monotone_principal.comp hg₂)
... = f₁.lift (λ s, f₂.lift (λ t, 𝓟 (g₁ s ×ˢ g₂ t))) :
  by simp only [prod_principal_principal]

end prod

end filter


/-
Copyright (c) 2020 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Patrick Massot, Eric Wieser
-/
import tactic.split_ifs
import tactic.simpa
import tactic.congr
import algebra.group.to_additive
import data.prod
import logic.unique
/-!
# Instances and theorems on pi types

This file provides basic definitions and notation instances for Pi types.

Instances of more sophisticated classes are defined in `pi.lean` files elsewhere.
-/

open function

universes u v₁ v₂ v₃
variable {I : Type u}     -- The indexing type
variables {α β γ : Type*}
-- The families of types already equipped with instances
variables {f : I → Type v₁} {g : I → Type v₂} {h : I → Type v₃}
variables (x y : Π i, f i) (i : I)

namespace pi

/-! `1`, `0`, `+`, `*`, `-`, `⁻¹`, and `/` are defined pointwise. -/

@[to_additive] instance has_one [∀ i, has_one $ f i] :
  has_one (Π i : I, f i) :=
⟨λ _, 1⟩
@[simp, to_additive] lemma one_apply [∀ i, has_one $ f i] : (1 : Π i, f i) i = 1 := rfl

@[to_additive] lemma one_def [Π i, has_one $ f i] : (1 : Π i, f i) = λ i, 1 := rfl

@[simp, to_additive] lemma const_one [has_one β] : const α (1 : β) = 1 := rfl

@[simp, to_additive] lemma one_comp [has_one γ] (x : α → β) : (1 : β → γ) ∘ x = 1 := rfl

@[simp, to_additive] lemma comp_one [has_one β] (x : β → γ) : x ∘ 1 = const α (x 1) := rfl

@[to_additive]
instance has_mul [∀ i, has_mul $ f i] :
  has_mul (Π i : I, f i) :=
⟨λ f g i, f i * g i⟩
@[simp, to_additive] lemma mul_apply [∀ i, has_mul $ f i] : (x * y) i = x i * y i := rfl

@[to_additive] lemma mul_def [Π i, has_mul $ f i] : x * y = λ i, x i * y i := rfl

@[simp, to_additive] lemma const_mul [has_mul β] (a b : β) :
  const α a * const α b = const α (a * b) := rfl

@[to_additive] lemma mul_comp [has_mul γ] (x y : β → γ) (z : α → β) :
  (x * y) ∘ z = x ∘ z * y ∘ z := rfl

@[simp] lemma bit0_apply [Π i, has_add $ f i] : (bit0 x) i = bit0 (x i) := rfl

@[simp] lemma bit1_apply [Π i, has_add $ f i] [Π i, has_one $ f i] : (bit1 x) i = bit1 (x i) := rfl

@[to_additive] instance has_inv [∀ i, has_inv $ f i] :
  has_inv (Π i : I, f i) :=
  ⟨λ f i, (f i)⁻¹⟩
@[simp, to_additive] lemma inv_apply [∀ i, has_inv $ f i] : x⁻¹ i = (x i)⁻¹ := rfl
@[to_additive] lemma inv_def [Π i, has_inv $ f i] : x⁻¹ = λ i, (x i)⁻¹ := rfl

@[to_additive] lemma const_inv [has_inv β] (a : β) : (const α a)⁻¹ = const α a⁻¹ := rfl

@[to_additive] lemma inv_comp [has_inv γ] (x : β → γ) (y : α → β) : x⁻¹ ∘ y = (x ∘ y)⁻¹ := rfl

@[to_additive] instance has_div [Π i, has_div $ f i] :
  has_div (Π i : I, f i) :=
⟨λ f g i, f i / g i⟩
@[simp, to_additive] lemma div_apply [Π i, has_div $ f i] : (x / y) i = x i / y i := rfl
@[to_additive] lemma div_def [Π i, has_div $ f i] : x / y = λ i, x i / y i := rfl

@[to_additive] lemma div_comp [has_div γ] (x y : β → γ) (z : α → β) :
  (x / y) ∘ z = x ∘ z / y ∘ z := rfl

@[simp, to_additive] lemma const_div [has_div β] (a b : β) :
  const α a / const α b = const α (a / b) := rfl

section

variables [decidable_eq I]
variables [Π i, has_one (f i)] [Π i, has_one (g i)] [Π i, has_one (h i)]

/-- The function supported at `i`, with value `x` there, and `1` elsewhere. -/
@[to_additive pi.single "The function supported at `i`, with value `x` there, and `0` elsewhere." ]
def mul_single (i : I) (x : f i) : Π i, f i :=
function.update 1 i x

@[simp, to_additive]
lemma mul_single_eq_same (i : I) (x : f i) : mul_single i x i = x :=
function.update_same i x _

@[simp, to_additive]
lemma mul_single_eq_of_ne {i i' : I} (h : i' ≠ i) (x : f i) : mul_single i x i' = 1 :=
function.update_noteq h x _

/-- Abbreviation for `mul_single_eq_of_ne h.symm`, for ease of use by `simp`. -/
@[simp, to_additive "Abbreviation for `single_eq_of_ne h.symm`, for ease of
use by `simp`."]
lemma mul_single_eq_of_ne' {i i' : I} (h : i ≠ i') (x : f i) : mul_single i x i' = 1 :=
mul_single_eq_of_ne h.symm x

@[simp, to_additive]
lemma mul_single_one (i : I) : mul_single i (1 : f i) = 1 :=
function.update_eq_self _ _

/-- On non-dependent functions, `pi.mul_single` can be expressed as an `ite` -/
@[to_additive "On non-dependent functions, `pi.single` can be expressed as an `ite`"]
lemma mul_single_apply {β : Sort*} [has_one β] (i : I) (x : β) (i' : I) :
  mul_single i x i' = if i' = i then x else 1 :=
function.update_apply 1 i x i'

/-- On non-dependent functions, `pi.mul_single` is symmetric in the two indices. -/
@[to_additive "On non-dependent functions, `pi.single` is symmetric in the two
indices."]
lemma mul_single_comm {β : Sort*} [has_one β] (i : I) (x : β) (i' : I) :
  mul_single i x i' = mul_single i' x i :=
by simp [mul_single_apply, eq_comm]

@[to_additive]
lemma apply_mul_single (f' : Π i, f i → g i) (hf' : ∀ i, f' i 1 = 1) (i : I) (x : f i) (j : I):
  f' j (mul_single i x j) = mul_single i (f' i x) j :=
by simpa only [pi.one_apply, hf', mul_single] using function.apply_update f' 1 i x j

@[to_additive apply_single₂]
lemma apply_mul_single₂ (f' : Π i, f i → g i → h i) (hf' : ∀ i, f' i 1 1 = 1)
  (i : I) (x : f i) (y : g i) (j : I):
  f' j (mul_single i x j) (mul_single i y j) = mul_single i (f' i x y) j :=
begin
  by_cases h : j = i,
  { subst h, simp only [mul_single_eq_same] },
  { simp only [mul_single_eq_of_ne h, hf'] },
end

@[to_additive]
lemma mul_single_op {g : I → Type*} [Π i, has_one (g i)] (op : Π i, f i → g i) (h : ∀ i, op i 1 = 1)
  (i : I) (x : f i) :
  mul_single i (op i x) = λ j, op j (mul_single i x j) :=
eq.symm $ funext $ apply_mul_single op h i x

@[to_additive]
lemma mul_single_op₂ {g₁ g₂ : I → Type*} [Π i, has_one (g₁ i)] [Π i, has_one (g₂ i)]
  (op : Π i, g₁ i → g₂ i → f i) (h : ∀ i, op i 1 1 = 1) (i : I) (x₁ : g₁ i) (x₂ : g₂ i) :
  mul_single i (op i x₁ x₂) = λ j, op j (mul_single i x₁ j) (mul_single i x₂ j) :=
eq.symm $ funext $ apply_mul_single₂ op h i x₁ x₂

variables (f)

@[to_additive]
lemma mul_single_injective (i : I) : function.injective (mul_single i : f i → Π i, f i) :=
function.update_injective _ i

@[simp, to_additive]
lemma mul_single_inj (i : I) {x y : f i} : mul_single i x = mul_single i y ↔ x = y :=
(pi.mul_single_injective _ _).eq_iff

end

/-- The mapping into a product type built from maps into each component. -/
@[simp] protected def prod (f' : Π i, f i) (g' : Π i, g i) (i : I) : f i × g i := (f' i, g' i)

@[simp] lemma prod_fst_snd : pi.prod (prod.fst : α × β → α) (prod.snd : α × β → β) = id :=
funext $ λ _, prod.mk.eta

@[simp] lemma prod_snd_fst : pi.prod (prod.snd : α × β → β) (prod.fst : α × β → α) = prod.swap :=
rfl

end pi

namespace function

section extend
@[to_additive]
lemma extend_one [has_one γ] (f : α → β) :
  function.extend f (1 : α → γ) (1 : β → γ) = 1 :=
funext $ λ _, by apply if_t_t _ _

@[to_additive]
lemma extend_mul [has_mul γ] (f : α → β) (g₁ g₂ : α → γ) (e₁ e₂ : β → γ) :
  function.extend f (g₁ * g₂) (e₁ * e₂) = function.extend f g₁ e₁ * function.extend f g₂ e₂ :=
funext $ λ _, by convert (apply_dite2 (*) _ _ _ _ _).symm

@[to_additive]
lemma extend_inv [has_inv γ] (f : α → β) (g : α → γ) (e : β → γ) :
  function.extend f (g⁻¹) (e⁻¹) = (function.extend f g e)⁻¹ :=
funext $ λ _, by convert (apply_dite has_inv.inv _ _ _).symm

@[to_additive]
lemma extend_div [has_div γ] (f : α → β) (g₁ g₂ : α → γ) (e₁ e₂ : β → γ) :
  function.extend f (g₁ / g₂) (e₁ / e₂) = function.extend f g₁ e₁ / function.extend f g₂ e₂ :=
funext $ λ _, by convert (apply_dite2 (/) _ _ _ _ _).symm

end extend

lemma surjective_pi_map {F : Π i, f i → g i} (hF : ∀ i, surjective (F i)) :
  surjective (λ x : Π i, f i, λ i, F i (x i)) :=
λ y, ⟨λ i, (hF i (y i)).some, funext $ λ i, (hF i (y i)).some_spec⟩

lemma injective_pi_map {F : Π i, f i → g i} (hF : ∀ i, injective (F i)) :
  injective (λ x : Π i, f i, λ i, F i (x i)) :=
λ x y h, funext $ λ i, hF i $ (congr_fun h i : _)

lemma bijective_pi_map {F : Π i, f i → g i} (hF : ∀ i, bijective (F i)) :
  bijective (λ x : Π i, f i, λ i, F i (x i)) :=
⟨injective_pi_map (λ i, (hF i).injective), surjective_pi_map (λ i, (hF i).surjective)⟩

end function

/-- If the one function is surjective, the codomain is trivial. -/
@[to_additive "If the zero function is surjective, the codomain is trivial."]
def unique_of_surjective_one (α : Type*) {β : Type*} [has_one β]
  (h : function.surjective (1 : α → β)) : unique β :=
h.unique_of_surjective_const α (1 : β)

@[to_additive subsingleton.pi_single_eq]
lemma subsingleton.pi_mul_single_eq {α : Type*} [decidable_eq I] [subsingleton I] [has_one α]
  (i : I) (x : α) :
  pi.mul_single i x = λ _, x :=
funext $ λ j, by rw [subsingleton.elim j i, pi.mul_single_eq_same]


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

! This file was ported from Lean 3 source module combinatorics.set_family.intersecting
! leanprover-community/mathlib commit 0ebfdb71919ac6ca5d7fbc61a082fa2519556818
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Fintype.Card
import Mathbin.Order.UpperLower.Basic

/-!
# Intersecting families

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

This file defines intersecting families and proves their basic properties.

## Main declarations

* `set.intersecting`: Predicate for a set of elements in a generalized boolean algebra to be an
  intersecting family.
* `set.intersecting.card_le`: An intersecting family can only take up to half the elements, because
  `a` and `aᶜ` cannot simultaneously be in it.
* `set.intersecting.is_max_iff_card_eq`: Any maximal intersecting family takes up half the elements.

## References

* [D. J. Kleitman, *Families of non-disjoint subsets*][kleitman1966]
-/

open Finset

variable {α : Type _}

namespace Set

section SemilatticeInf

variable [SemilatticeInf α] [OrderBot α] {s t : Set α} {a b c : α}

#print Set.Intersecting /-
/-- A set family is intersecting if every pair of elements is non-disjoint. -/
def Intersecting (s : Set α) : Prop :=
  ∀ ⦃a⦄, a ∈ s → ∀ ⦃b⦄, b ∈ s → ¬Disjoint a b
#align set.intersecting Set.Intersecting
-/

#print Set.Intersecting.mono /-
@[mono]
theorem Intersecting.mono (h : t ⊆ s) (hs : s.Intersecting) : t.Intersecting := fun a ha b hb =>
  hs (h ha) (h hb)
#align set.intersecting.mono Set.Intersecting.mono
-/

/- warning: set.intersecting.not_bot_mem -> Set.Intersecting.not_bot_mem is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : SemilatticeInf.{u1} α] [_inst_2 : OrderBot.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_1)))] {s : Set.{u1} α}, (Set.Intersecting.{u1} α _inst_1 _inst_2 s) -> (Not (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) (Bot.bot.{u1} α (OrderBot.toHasBot.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_1))) _inst_2)) s))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : SemilatticeInf.{u1} α] [_inst_2 : OrderBot.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_1)))] {s : Set.{u1} α}, (Set.Intersecting.{u1} α _inst_1 _inst_2 s) -> (Not (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) (Bot.bot.{u1} α (OrderBot.toBot.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_1))) _inst_2)) s))
Case conversion may be inaccurate. Consider using '#align set.intersecting.not_bot_mem Set.Intersecting.not_bot_memₓ'. -/
theorem Intersecting.not_bot_mem (hs : s.Intersecting) : ⊥ ∉ s := fun h => hs h h disjoint_bot_left
#align set.intersecting.not_bot_mem Set.Intersecting.not_bot_mem

/- warning: set.intersecting.ne_bot -> Set.Intersecting.ne_bot is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : SemilatticeInf.{u1} α] [_inst_2 : OrderBot.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_1)))] {s : Set.{u1} α} {a : α}, (Set.Intersecting.{u1} α _inst_1 _inst_2 s) -> (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) a s) -> (Ne.{succ u1} α a (Bot.bot.{u1} α (OrderBot.toHasBot.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_1))) _inst_2)))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : SemilatticeInf.{u1} α] [_inst_2 : OrderBot.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_1)))] {s : Set.{u1} α} {a : α}, (Set.Intersecting.{u1} α _inst_1 _inst_2 s) -> (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) a s) -> (Ne.{succ u1} α a (Bot.bot.{u1} α (OrderBot.toBot.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_1))) _inst_2)))
Case conversion may be inaccurate. Consider using '#align set.intersecting.ne_bot Set.Intersecting.ne_botₓ'. -/
theorem Intersecting.ne_bot (hs : s.Intersecting) (ha : a ∈ s) : a ≠ ⊥ :=
  ne_of_mem_of_not_mem ha hs.not_bot_mem
#align set.intersecting.ne_bot Set.Intersecting.ne_bot

#print Set.intersecting_empty /-
theorem intersecting_empty : (∅ : Set α).Intersecting := fun _ => False.elim
#align set.intersecting_empty Set.intersecting_empty
-/

/- warning: set.intersecting_singleton -> Set.intersecting_singleton is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : SemilatticeInf.{u1} α] [_inst_2 : OrderBot.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_1)))] {a : α}, Iff (Set.Intersecting.{u1} α _inst_1 _inst_2 (Singleton.singleton.{u1, u1} α (Set.{u1} α) (Set.hasSingleton.{u1} α) a)) (Ne.{succ u1} α a (Bot.bot.{u1} α (OrderBot.toHasBot.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_1))) _inst_2)))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : SemilatticeInf.{u1} α] [_inst_2 : OrderBot.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_1)))] {a : α}, Iff (Set.Intersecting.{u1} α _inst_1 _inst_2 (Singleton.singleton.{u1, u1} α (Set.{u1} α) (Set.instSingletonSet.{u1} α) a)) (Ne.{succ u1} α a (Bot.bot.{u1} α (OrderBot.toBot.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_1))) _inst_2)))
Case conversion may be inaccurate. Consider using '#align set.intersecting_singleton Set.intersecting_singletonₓ'. -/
@[simp]
theorem intersecting_singleton : ({a} : Set α).Intersecting ↔ a ≠ ⊥ := by simp [intersecting]
#align set.intersecting_singleton Set.intersecting_singleton

/- warning: set.intersecting.insert -> Set.Intersecting.insert is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : SemilatticeInf.{u1} α] [_inst_2 : OrderBot.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_1)))] {s : Set.{u1} α} {a : α}, (Set.Intersecting.{u1} α _inst_1 _inst_2 s) -> (Ne.{succ u1} α a (Bot.bot.{u1} α (OrderBot.toHasBot.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_1))) _inst_2))) -> (forall (b : α), (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) b s) -> (Not (Disjoint.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_1) _inst_2 a b))) -> (Set.Intersecting.{u1} α _inst_1 _inst_2 (Insert.insert.{u1, u1} α (Set.{u1} α) (Set.hasInsert.{u1} α) a s))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : SemilatticeInf.{u1} α] [_inst_2 : OrderBot.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_1)))] {s : Set.{u1} α} {a : α}, (Set.Intersecting.{u1} α _inst_1 _inst_2 s) -> (Ne.{succ u1} α a (Bot.bot.{u1} α (OrderBot.toBot.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_1))) _inst_2))) -> (forall (b : α), (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) b s) -> (Not (Disjoint.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_1) _inst_2 a b))) -> (Set.Intersecting.{u1} α _inst_1 _inst_2 (Insert.insert.{u1, u1} α (Set.{u1} α) (Set.instInsertSet.{u1} α) a s))
Case conversion may be inaccurate. Consider using '#align set.intersecting.insert Set.Intersecting.insertₓ'. -/
theorem Intersecting.insert (hs : s.Intersecting) (ha : a ≠ ⊥) (h : ∀ b ∈ s, ¬Disjoint a b) :
    (insert a s).Intersecting := by
  rintro b (rfl | hb) c (rfl | hc)
  · rwa [disjoint_self]
  · exact h _ hc
  · exact fun H => h _ hb H.symm
  · exact hs hb hc
#align set.intersecting.insert Set.Intersecting.insert

/- warning: set.intersecting_insert -> Set.intersecting_insert is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : SemilatticeInf.{u1} α] [_inst_2 : OrderBot.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_1)))] {s : Set.{u1} α} {a : α}, Iff (Set.Intersecting.{u1} α _inst_1 _inst_2 (Insert.insert.{u1, u1} α (Set.{u1} α) (Set.hasInsert.{u1} α) a s)) (And (Set.Intersecting.{u1} α _inst_1 _inst_2 s) (And (Ne.{succ u1} α a (Bot.bot.{u1} α (OrderBot.toHasBot.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_1))) _inst_2))) (forall (b : α), (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) b s) -> (Not (Disjoint.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_1) _inst_2 a b)))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : SemilatticeInf.{u1} α] [_inst_2 : OrderBot.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_1)))] {s : Set.{u1} α} {a : α}, Iff (Set.Intersecting.{u1} α _inst_1 _inst_2 (Insert.insert.{u1, u1} α (Set.{u1} α) (Set.instInsertSet.{u1} α) a s)) (And (Set.Intersecting.{u1} α _inst_1 _inst_2 s) (And (Ne.{succ u1} α a (Bot.bot.{u1} α (OrderBot.toBot.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_1))) _inst_2))) (forall (b : α), (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) b s) -> (Not (Disjoint.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_1) _inst_2 a b)))))
Case conversion may be inaccurate. Consider using '#align set.intersecting_insert Set.intersecting_insertₓ'. -/
theorem intersecting_insert :
    (insert a s).Intersecting ↔ s.Intersecting ∧ a ≠ ⊥ ∧ ∀ b ∈ s, ¬Disjoint a b :=
  ⟨fun h =>
    ⟨h.mono <| subset_insert _ _, h.ne_bot <| mem_insert _ _, fun b hb =>
      h (mem_insert _ _) <| mem_insert_of_mem _ hb⟩,
    fun h => h.1.insert h.2.1 h.2.2⟩
#align set.intersecting_insert Set.intersecting_insert

/- warning: set.intersecting_iff_pairwise_not_disjoint -> Set.intersecting_iff_pairwise_not_disjoint is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : SemilatticeInf.{u1} α] [_inst_2 : OrderBot.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_1)))] {s : Set.{u1} α}, Iff (Set.Intersecting.{u1} α _inst_1 _inst_2 s) (And (Set.Pairwise.{u1} α s (fun (a : α) (b : α) => Not (Disjoint.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_1) _inst_2 a b))) (Ne.{succ u1} (Set.{u1} α) s (Singleton.singleton.{u1, u1} α (Set.{u1} α) (Set.hasSingleton.{u1} α) (Bot.bot.{u1} α (OrderBot.toHasBot.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_1))) _inst_2)))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : SemilatticeInf.{u1} α] [_inst_2 : OrderBot.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_1)))] {s : Set.{u1} α}, Iff (Set.Intersecting.{u1} α _inst_1 _inst_2 s) (And (Set.Pairwise.{u1} α s (fun (a : α) (b : α) => Not (Disjoint.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_1) _inst_2 a b))) (Ne.{succ u1} (Set.{u1} α) s (Singleton.singleton.{u1, u1} α (Set.{u1} α) (Set.instSingletonSet.{u1} α) (Bot.bot.{u1} α (OrderBot.toBot.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_1))) _inst_2)))))
Case conversion may be inaccurate. Consider using '#align set.intersecting_iff_pairwise_not_disjoint Set.intersecting_iff_pairwise_not_disjointₓ'. -/
theorem intersecting_iff_pairwise_not_disjoint :
    s.Intersecting ↔ (s.Pairwise fun a b => ¬Disjoint a b) ∧ s ≠ {⊥} :=
  by
  refine' ⟨fun h => ⟨fun a ha b hb _ => h ha hb, _⟩, fun h a ha b hb hab => _⟩
  · rintro rfl
    exact intersecting_singleton.1 h rfl
  · have := h.1.Eq ha hb (Classical.not_not.2 hab)
    rw [this, disjoint_self] at hab
    rw [hab] at hb
    exact
      h.2
        (eq_singleton_iff_unique_mem.2
          ⟨hb, fun c hc => not_ne_iff.1 fun H => h.1 hb hc H.symm disjoint_bot_left⟩)
#align set.intersecting_iff_pairwise_not_disjoint Set.intersecting_iff_pairwise_not_disjoint

/- warning: set.subsingleton.intersecting -> Set.Subsingleton.intersecting is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : SemilatticeInf.{u1} α] [_inst_2 : OrderBot.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_1)))] {s : Set.{u1} α}, (Set.Subsingleton.{u1} α s) -> (Iff (Set.Intersecting.{u1} α _inst_1 _inst_2 s) (Ne.{succ u1} (Set.{u1} α) s (Singleton.singleton.{u1, u1} α (Set.{u1} α) (Set.hasSingleton.{u1} α) (Bot.bot.{u1} α (OrderBot.toHasBot.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_1))) _inst_2)))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : SemilatticeInf.{u1} α] [_inst_2 : OrderBot.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_1)))] {s : Set.{u1} α}, (Set.Subsingleton.{u1} α s) -> (Iff (Set.Intersecting.{u1} α _inst_1 _inst_2 s) (Ne.{succ u1} (Set.{u1} α) s (Singleton.singleton.{u1, u1} α (Set.{u1} α) (Set.instSingletonSet.{u1} α) (Bot.bot.{u1} α (OrderBot.toBot.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α _inst_1))) _inst_2)))))
Case conversion may be inaccurate. Consider using '#align set.subsingleton.intersecting Set.Subsingleton.intersectingₓ'. -/
protected theorem Subsingleton.intersecting (hs : s.Subsingleton) : s.Intersecting ↔ s ≠ {⊥} :=
  intersecting_iff_pairwise_not_disjoint.trans <| and_iff_right <| hs.Pairwise _
#align set.subsingleton.intersecting Set.Subsingleton.intersecting

#print Set.intersecting_iff_eq_empty_of_subsingleton /-
theorem intersecting_iff_eq_empty_of_subsingleton [Subsingleton α] (s : Set α) :
    s.Intersecting ↔ s = ∅ :=
  by
  refine'
    subsingleton_of_subsingleton.intersecting.trans
      ⟨not_imp_comm.2 fun h => subsingleton_of_subsingleton.eq_singleton_of_mem _, _⟩
  · obtain ⟨a, ha⟩ := nonempty_iff_ne_empty.2 h
    rwa [Subsingleton.elim ⊥ a]
  · rintro rfl
    exact (Set.singleton_nonempty _).ne_empty.symm
#align set.intersecting_iff_eq_empty_of_subsingleton Set.intersecting_iff_eq_empty_of_subsingleton
-/

#print Set.Intersecting.isUpperSet /-
/-- Maximal intersecting families are upper sets. -/
protected theorem Intersecting.isUpperSet (hs : s.Intersecting)
    (h : ∀ t : Set α, t.Intersecting → s ⊆ t → s = t) : IsUpperSet s := by
  classical
    rintro a b hab ha
    rw [h (insert b s) _ (subset_insert _ _)]
    · exact mem_insert _ _
    exact
      hs.insert (mt (eq_bot_mono hab) <| hs.ne_bot ha) fun c hc hbc => hs ha hc <| hbc.mono_left hab
#align set.intersecting.is_upper_set Set.Intersecting.isUpperSet
-/

#print Set.Intersecting.isUpperSet' /-
/-- Maximal intersecting families are upper sets. Finset version. -/
theorem Intersecting.isUpperSet' {s : Finset α} (hs : (s : Set α).Intersecting)
    (h : ∀ t : Finset α, (t : Set α).Intersecting → s ⊆ t → s = t) : IsUpperSet (s : Set α) := by
  classical
    rintro a b hab ha
    rw [h (insert b s) _ (Finset.subset_insert _ _)]
    · exact mem_insert_self _ _
    rw [coe_insert]
    exact
      hs.insert (mt (eq_bot_mono hab) <| hs.ne_bot ha) fun c hc hbc => hs ha hc <| hbc.mono_left hab
#align set.intersecting.is_upper_set' Set.Intersecting.isUpperSet'
-/

end SemilatticeInf

/- warning: set.intersecting.exists_mem_set -> Set.Intersecting.exists_mem_set is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {𝒜 : Set.{u1} (Set.{u1} α)}, (Set.Intersecting.{u1} (Set.{u1} α) (Lattice.toSemilatticeInf.{u1} (Set.{u1} α) (CompleteLattice.toLattice.{u1} (Set.{u1} α) (Order.Coframe.toCompleteLattice.{u1} (Set.{u1} α) (CompleteDistribLattice.toCoframe.{u1} (Set.{u1} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u1} (Set.{u1} α) (Set.completeBooleanAlgebra.{u1} α)))))) (GeneralizedBooleanAlgebra.toOrderBot.{u1} (Set.{u1} α) (BooleanAlgebra.toGeneralizedBooleanAlgebra.{u1} (Set.{u1} α) (Set.booleanAlgebra.{u1} α))) 𝒜) -> (forall {s : Set.{u1} α} {t : Set.{u1} α}, (Membership.Mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.hasMem.{u1} (Set.{u1} α)) s 𝒜) -> (Membership.Mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.hasMem.{u1} (Set.{u1} α)) t 𝒜) -> (Exists.{succ u1} α (fun (a : α) => And (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) a s) (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) a t))))
but is expected to have type
  forall {α : Type.{u1}} {𝒜 : Set.{u1} (Set.{u1} α)}, (Set.Intersecting.{u1} (Set.{u1} α) (Lattice.toSemilatticeInf.{u1} (Set.{u1} α) (CompleteLattice.toLattice.{u1} (Set.{u1} α) (Order.Coframe.toCompleteLattice.{u1} (Set.{u1} α) (CompleteDistribLattice.toCoframe.{u1} (Set.{u1} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u1} (Set.{u1} α) (Set.instCompleteBooleanAlgebraSet.{u1} α)))))) (BoundedOrder.toOrderBot.{u1} (Set.{u1} α) (Preorder.toLE.{u1} (Set.{u1} α) (PartialOrder.toPreorder.{u1} (Set.{u1} α) (SemilatticeInf.toPartialOrder.{u1} (Set.{u1} α) (Lattice.toSemilatticeInf.{u1} (Set.{u1} α) (CompleteLattice.toLattice.{u1} (Set.{u1} α) (Order.Coframe.toCompleteLattice.{u1} (Set.{u1} α) (CompleteDistribLattice.toCoframe.{u1} (Set.{u1} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u1} (Set.{u1} α) (Set.instCompleteBooleanAlgebraSet.{u1} α))))))))) (CompleteLattice.toBoundedOrder.{u1} (Set.{u1} α) (Order.Coframe.toCompleteLattice.{u1} (Set.{u1} α) (CompleteDistribLattice.toCoframe.{u1} (Set.{u1} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u1} (Set.{u1} α) (Set.instCompleteBooleanAlgebraSet.{u1} α)))))) 𝒜) -> (forall {s : Set.{u1} α} {t : Set.{u1} α}, (Membership.mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.instMembershipSet.{u1} (Set.{u1} α)) s 𝒜) -> (Membership.mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.instMembershipSet.{u1} (Set.{u1} α)) t 𝒜) -> (Exists.{succ u1} α (fun (a : α) => And (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) a s) (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) a t))))
Case conversion may be inaccurate. Consider using '#align set.intersecting.exists_mem_set Set.Intersecting.exists_mem_setₓ'. -/
theorem Intersecting.exists_mem_set {𝒜 : Set (Set α)} (h𝒜 : 𝒜.Intersecting) {s t : Set α}
    (hs : s ∈ 𝒜) (ht : t ∈ 𝒜) : ∃ a, a ∈ s ∧ a ∈ t :=
  not_disjoint_iff.1 <| h𝒜 hs ht
#align set.intersecting.exists_mem_set Set.Intersecting.exists_mem_set

/- warning: set.intersecting.exists_mem_finset -> Set.Intersecting.exists_mem_finset is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] {𝒜 : Set.{u1} (Finset.{u1} α)}, (Set.Intersecting.{u1} (Finset.{u1} α) (Lattice.toSemilatticeInf.{u1} (Finset.{u1} α) (Finset.lattice.{u1} α (fun (a : α) (b : α) => _inst_1 a b))) (Finset.orderBot.{u1} α) 𝒜) -> (forall {s : Finset.{u1} α} {t : Finset.{u1} α}, (Membership.Mem.{u1, u1} (Finset.{u1} α) (Set.{u1} (Finset.{u1} α)) (Set.hasMem.{u1} (Finset.{u1} α)) s 𝒜) -> (Membership.Mem.{u1, u1} (Finset.{u1} α) (Set.{u1} (Finset.{u1} α)) (Set.hasMem.{u1} (Finset.{u1} α)) t 𝒜) -> (Exists.{succ u1} α (fun (a : α) => And (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a s) (Membership.Mem.{u1, u1} α (Finset.{u1} α) (Finset.hasMem.{u1} α) a t))))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : DecidableEq.{succ u1} α] {𝒜 : Set.{u1} (Finset.{u1} α)}, (Set.Intersecting.{u1} (Finset.{u1} α) (Lattice.toSemilatticeInf.{u1} (Finset.{u1} α) (Finset.instLatticeFinset.{u1} α (fun (a : α) (b : α) => _inst_1 a b))) (Finset.instOrderBotFinsetToLEToPreorderPartialOrder.{u1} α) 𝒜) -> (forall {s : Finset.{u1} α} {t : Finset.{u1} α}, (Membership.mem.{u1, u1} (Finset.{u1} α) (Set.{u1} (Finset.{u1} α)) (Set.instMembershipSet.{u1} (Finset.{u1} α)) s 𝒜) -> (Membership.mem.{u1, u1} (Finset.{u1} α) (Set.{u1} (Finset.{u1} α)) (Set.instMembershipSet.{u1} (Finset.{u1} α)) t 𝒜) -> (Exists.{succ u1} α (fun (a : α) => And (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a s) (Membership.mem.{u1, u1} α (Finset.{u1} α) (Finset.instMembershipFinset.{u1} α) a t))))
Case conversion may be inaccurate. Consider using '#align set.intersecting.exists_mem_finset Set.Intersecting.exists_mem_finsetₓ'. -/
theorem Intersecting.exists_mem_finset [DecidableEq α] {𝒜 : Set (Finset α)} (h𝒜 : 𝒜.Intersecting)
    {s t : Finset α} (hs : s ∈ 𝒜) (ht : t ∈ 𝒜) : ∃ a, a ∈ s ∧ a ∈ t :=
  not_disjoint_iff.1 <| disjoint_coe.Not.2 <| h𝒜 hs ht
#align set.intersecting.exists_mem_finset Set.Intersecting.exists_mem_finset

variable [BooleanAlgebra α]

#print Set.Intersecting.not_compl_mem /-
theorem Intersecting.not_compl_mem {s : Set α} (hs : s.Intersecting) {a : α} (ha : a ∈ s) :
    aᶜ ∉ s := fun h => hs ha h disjoint_compl_right
#align set.intersecting.not_compl_mem Set.Intersecting.not_compl_mem
-/

#print Set.Intersecting.not_mem /-
theorem Intersecting.not_mem {s : Set α} (hs : s.Intersecting) {a : α} (ha : aᶜ ∈ s) : a ∉ s :=
  fun h => hs ha h disjoint_compl_left
#align set.intersecting.not_mem Set.Intersecting.not_mem
-/

/- warning: set.intersecting.disjoint_map_compl -> Set.Intersecting.disjoint_map_compl is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : BooleanAlgebra.{u1} α] {s : Finset.{u1} α}, (Set.Intersecting.{u1} α (Lattice.toSemilatticeInf.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (GeneralizedBooleanAlgebra.toGeneralizedCoheytingAlgebra.{u1} α (BooleanAlgebra.toGeneralizedBooleanAlgebra.{u1} α _inst_1)))) (GeneralizedBooleanAlgebra.toOrderBot.{u1} α (BooleanAlgebra.toGeneralizedBooleanAlgebra.{u1} α _inst_1)) ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (Finset.{u1} α) (Set.{u1} α) (HasLiftT.mk.{succ u1, succ u1} (Finset.{u1} α) (Set.{u1} α) (CoeTCₓ.coe.{succ u1, succ u1} (Finset.{u1} α) (Set.{u1} α) (Finset.Set.hasCoeT.{u1} α))) s)) -> (Disjoint.{u1} (Finset.{u1} α) (Finset.partialOrder.{u1} α) (Finset.orderBot.{u1} α) s (Finset.map.{u1, u1} α α (Function.Embedding.mk.{succ u1, succ u1} α α (HasCompl.compl.{u1} α (BooleanAlgebra.toHasCompl.{u1} α _inst_1)) (compl_injective.{u1} α _inst_1)) s))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : BooleanAlgebra.{u1} α] {s : Finset.{u1} α}, (Set.Intersecting.{u1} α (Lattice.toSemilatticeInf.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α (BiheytingAlgebra.toCoheytingAlgebra.{u1} α (BooleanAlgebra.toBiheytingAlgebra.{u1} α _inst_1))))) (BoundedOrder.toOrderBot.{u1} α (Preorder.toLE.{u1} α (PartialOrder.toPreorder.{u1} α (SemilatticeInf.toPartialOrder.{u1} α (Lattice.toSemilatticeInf.{u1} α (GeneralizedCoheytingAlgebra.toLattice.{u1} α (CoheytingAlgebra.toGeneralizedCoheytingAlgebra.{u1} α (BiheytingAlgebra.toCoheytingAlgebra.{u1} α (BooleanAlgebra.toBiheytingAlgebra.{u1} α _inst_1)))))))) (BooleanAlgebra.toBoundedOrder.{u1} α _inst_1)) (Finset.toSet.{u1} α s)) -> (Disjoint.{u1} (Finset.{u1} α) (Finset.partialOrder.{u1} α) (Finset.instOrderBotFinsetToLEToPreorderPartialOrder.{u1} α) s (Finset.map.{u1, u1} α α (Function.Embedding.mk.{succ u1, succ u1} α α (HasCompl.compl.{u1} α (BooleanAlgebra.toHasCompl.{u1} α _inst_1)) (compl_injective.{u1} α _inst_1)) s))
Case conversion may be inaccurate. Consider using '#align set.intersecting.disjoint_map_compl Set.Intersecting.disjoint_map_complₓ'. -/
theorem Intersecting.disjoint_map_compl {s : Finset α} (hs : (s : Set α).Intersecting) :
    Disjoint s (s.map ⟨compl, compl_injective⟩) :=
  by
  rw [Finset.disjoint_left]
  rintro x hx hxc
  obtain ⟨x, hx', rfl⟩ := mem_map.mp hxc
  exact hs.not_compl_mem hx' hx
#align set.intersecting.disjoint_map_compl Set.Intersecting.disjoint_map_compl

#print Set.Intersecting.card_le /-
theorem Intersecting.card_le [Fintype α] {s : Finset α} (hs : (s : Set α).Intersecting) :
    2 * s.card ≤ Fintype.card α := by
  classical
    refine' (s.disj_union _ hs.disjoint_map_compl).card_le_univ.trans_eq' _
    rw [two_mul, card_disj_union, card_map]
#align set.intersecting.card_le Set.Intersecting.card_le
-/

variable [Nontrivial α] [Fintype α] {s : Finset α}

#print Set.Intersecting.is_max_iff_card_eq /-
-- Note, this lemma is false when `α` has exactly one element and boring when `α` is empty.
theorem Intersecting.is_max_iff_card_eq (hs : (s : Set α).Intersecting) :
    (∀ t : Finset α, (t : Set α).Intersecting → s ⊆ t → s = t) ↔ 2 * s.card = Fintype.card α := by
  classical
    refine'
      ⟨fun h => _, fun h t ht hst =>
        Finset.eq_of_subset_of_card_le hst <|
          le_of_mul_le_mul_left (ht.card_le.trans_eq h.symm) two_pos⟩
    suffices s.disj_union (s.map ⟨compl, compl_injective⟩) hs.disjoint_map_compl = Finset.univ by
      rw [Fintype.card, ← this, two_mul, card_disj_union, card_map]
    rw [← coe_eq_univ, disj_union_eq_union, coe_union, coe_map, Function.Embedding.coeFn_mk,
      image_eq_preimage_of_inverse compl_compl compl_compl]
    refine' eq_univ_of_forall fun a => _
    simp_rw [mem_union, mem_preimage]
    by_contra' ha
    refine' s.ne_insert_of_not_mem _ ha.1 (h _ _ <| s.subset_insert _)
    rw [coe_insert]
    refine' hs.insert _ fun b hb hab => ha.2 <| (hs.is_upper_set' h) hab.le_compl_left hb
    rintro rfl
    have :=
      h {⊤}
        (by
          rw [coe_singleton]
          exact intersecting_singleton.2 top_ne_bot)
    rw [compl_bot] at ha
    rw [coe_eq_empty.1 ((hs.is_upper_set' h).not_top_mem.1 ha.2)] at this
    exact Finset.singleton_ne_empty _ (this <| empty_subset _).symm
#align set.intersecting.is_max_iff_card_eq Set.Intersecting.is_max_iff_card_eq
-/

#print Set.Intersecting.exists_card_eq /-
theorem Intersecting.exists_card_eq (hs : (s : Set α).Intersecting) :
    ∃ t, s ⊆ t ∧ 2 * t.card = Fintype.card α ∧ (t : Set α).Intersecting :=
  by
  have := hs.card_le
  rw [mul_comm, ← Nat.le_div_iff_mul_le' two_pos] at this
  revert hs
  refine' s.strong_downward_induction_on _ this
  rintro s ih hcard hs
  by_cases ∀ t : Finset α, (t : Set α).Intersecting → s ⊆ t → s = t
  · exact ⟨s, subset.rfl, hs.is_max_iff_card_eq.1 h, hs⟩
  push_neg  at h
  obtain ⟨t, ht, hst⟩ := h
  refine' (ih _ (_root_.ssubset_iff_subset_ne.2 hst) ht).imp fun u => And.imp_left hst.1.trans
  rw [Nat.le_div_iff_mul_le' two_pos, mul_comm]
  exact ht.card_le
#align set.intersecting.exists_card_eq Set.Intersecting.exists_card_eq
-/

end Set


import tactic
import data.real.basic
import data.set.function

noncomputable theory
open_locale classical
open set function

@[protect_proj]
class subset (A : Type*) (B : out_param $ Type*) :=
(mem : B → A → Prop)

namespace subset
-- The following allows us to use the symbol `∈`
instance {A : Type*} {B : Type*} [subset A B] : has_mem B A := ⟨subset.mem⟩

-- This says that two "subset"s are equivalent (written `≈`, type with \approx) when
-- they have the same points.
instance {A : Type*} {B : Type*} [subset A B] : has_equiv A := ⟨λ X Y, ∀ t, t ∈ X ↔ t ∈ Y⟩
@[simp] lemma equiv_iff {A : Type*} {B : Type*} [subset A B] (X Y : A) : X ≈ Y ↔ ∀ t, t ∈ X ↔ t ∈ Y := iff.rfl

-- A "subset" can always be considered as an actual subset, in Lean this is `set B`
instance {A : Type*} {B : Type*} [subset A B] : has_coe_t A (set B) := ⟨λ x p, p ∈ x⟩

@[simp] lemma mem_pts  {A : Type*} {B : Type*} [subset A B] (a : A) (P : B) : P ∈ (a : set B) ↔ P ∈ a
:= iff.rfl

end subset

@[simp] def pts {A : Type*} {B : Type*} [subset A B] : A → set B := λ a, {x : B | x ∈ a}

notation p `xor` q := (p ∧ ¬ q) ∨ (q ∧ ¬ p)
def xor3 (p q r : Prop) : Prop := (p ∧ ¬ q ∧ ¬ r) ∨ (¬ p ∧ q ∧ ¬ r) ∨ (¬ p ∧ ¬ q ∧ r)

/--
We define an incidence plane as having the undefined terms `Point` and `Line`,
a function `distance` that takes every two points to a real number, and a predicate
`belongs` that relates points and lines.

There are essentially two axioms: existence of two distinct points, and the incidence postulate.
-/
class IncidencePlane (Point : Type*) :=
	(Line : Type*)

	-- Belongs is an undefined concept
  (belongs : Point → Line → Prop)
	(infix `∈`:100 := belongs)

	-- I1 postulate is divided into 4 statements
	(line_through' : Point → Point → Line)
	(line_through_left' (P Q : Point) : P ∈ (line_through' P Q))
	(line_through_right' (P Q : Point) : Q ∈ (line_through' P Q))
	(incidence' {P Q : Point} {ℓ : Line} : P ≠ Q → P ∈ ℓ → Q ∈ ℓ → ℓ = line_through' P Q)

	-- I2 postulate
	(line_contains_two_points' (ℓ : Line) : ∃ P Q : Point, P ≠ Q ∧ ℓ = line_through' P Q)

	-- I3 postulate (existence postulate)
	(existence' : ∃ P Q R : Point, P ≠ Q ∧ P ≠ R ∧ Q ≠ R ∧ ¬ R ∈ (line_through' P Q))

	-- Betweenness is an undefined concept
	(between : Point → Point → Point → Prop)
	(notation A `*` B `*` C := between A B C)

	/- Betweenness is symmetric -/
	(between_symmetric' {A B C : Point} : (A * B * C) → (C * B * A))
	/- If A * B * C then the three points are distinct and collinear. -/
	(different_of_between' {A B C : Point} : (A * B * C) → (A ≠ B ∧ A ≠ C ∧ B ≠ C))
	(collinear_of_between' {A B C : Point} : (A * B * C) → ∃ ℓ, A ∈ ℓ ∧ B ∈ ℓ ∧ C ∈ ℓ)

	/- Given two distinct points A, B, there is a third point C such that A * B * C.-/
	(point_on_ray' {A B : Point} (h: A ≠ B) : ∃ C, A * B * C)

	/- Given 3 distinct collinear points A B C, exactly one of them is between the other two.-/
	(between_of_collinear' {A B C : Point} (h: ∃ℓ, A ∈ ℓ ∧ B ∈ ℓ ∧ C ∈ ℓ) : xor3 (A * B * C) ( B * A * C ) (A * C * B))

	/- Pasch -/
	(pasch' {A B C D : Point} {ℓ : Line}
		(hnc: ¬ C ∈ line_through' A B)
		(hnAl: ¬ (A ∈ ℓ)) (hnBl: ¬ B ∈ ℓ) (hnCl: ¬ C ∈ ℓ)
		(hDl: D ∈ ℓ) (hADB: A * D * B) : (∃ E ,  E ∈ ℓ ∧ (A * E * C)) xor (∃ E, E ∈ ℓ ∧ (B * E * C)))

namespace IncidencePlane
variables {Ω Point : Type*} [IncidencePlane Ω] [IncidencePlane Point]

-- From here on, we can use the symbol `∈` for Lines
instance : subset (Line Ω) Ω := {mem := belongs}

notation A `*` B `*` C := IncidencePlane.between A B C

-- Define again everything

-- A1
def line_through (P Q : Ω) : Line Ω := line_through' P Q
@[simp] lemma line_through_left (P Q : Ω) : P ∈ (line_through P Q) := line_through_left' P Q
@[simp] lemma line_through_right (P Q : Ω) : Q ∈ (line_through P Q) := line_through_right' P Q
lemma incidence {P Q : Ω} {ℓ : Line Ω} : P ≠ Q → P ∈ ℓ → Q ∈ ℓ → ℓ = line_through P Q
:= incidence'

-- A2
lemma line_contains_two_points (ℓ : Line Ω) : ∃ P Q : Ω, P ≠ Q ∧ ℓ = line_through P Q
:= line_contains_two_points' ℓ

-- A3
lemma existence (Ω : Type*) [IncidencePlane Ω] : ∃ P Q R : Ω, P ≠ Q ∧ P ≠ R ∧ Q ≠ R ∧
R ∉ (line_through P Q) := existence'

lemma between_symmetric {A B C : Ω} : (A * B * C) → (C * B * A)  := between_symmetric'
lemma different_of_between {A B C : Ω} : (A * B * C) → (A ≠ B ∧ A ≠ C ∧ B ≠ C) := different_of_between'
lemma collinear_of_between {A B C : Ω} : (A * B * C) → ∃ ℓ : Line Ω, A ∈ ℓ ∧ B ∈ ℓ ∧ C ∈ ℓ := collinear_of_between'
lemma point_on_ray {A B : Ω} (h: A ≠ B) : ∃ (C : Ω), A * B * C := point_on_ray' h
lemma between_of_collinear {A B C : Ω} (h: ∃(ℓ : Line Ω), A ∈ ℓ ∧ B ∈ ℓ ∧ C ∈ ℓ) : xor3 (A * B * C) ( B * A * C ) (A * C * B)
:= between_of_collinear' h
lemma pasch {A B C D : Ω} {ℓ : Line Ω} (hnc: ¬ C ∈ line_through A B)
(hnAl: ¬ (A ∈ ℓ)) (hnBl: ¬ B ∈ ℓ) (hnCl: ¬ C ∈ ℓ) (hDl: D ∈ ℓ) (hADB: A * D * B) :
(∃ E ,  E ∈ ℓ ∧ (A * E * C)) xor (∃ E, E ∈ ℓ ∧ (B * E * C)) := pasch' hnc hnAl hnBl hnCl hDl hADB

-- Define collinearity of a set of points to mean that they all lie on some line
def collinear (S : set Ω) : Prop := ∃ (ℓ : Line Ω), ∀ {P : Ω}, P ∈ S → P ∈ ℓ

/--
Two lines intersect if they share a point
-/
def intersect (r s : Line Ω) : Prop := ∃ A, A ∈ r ∧ A ∈ s

/--
Two lines are parallel if they dont intersect (so a line is never parallel to itself)
-/
def parallel (r s : Line Ω) : Prop := ¬ intersect r s

-- Next we introduce the notion of a Segment.

/--
A segment is the giving two points, A and B.
We will use the notation A⬝B to denote the segment denoted by A and B. The segment A⬝B consists
of all the points X such that A * X * B.
-/
structure Segment (Ω : Type*) :=
(A : Ω) (B : Ω)

infix `⬝`:100 := Segment.mk

namespace Segment

-- Declare when P ∈ A⬝B
instance : subset (Segment Ω) Ω := { mem := λ P S, P = S.A ∨ P = S.B ∨ S.A * P * S.B }
@[simp] lemma mem_pts (S : Segment Ω) (P : Ω) : P ∈ S ↔ P = S.A ∨ P = S.B ∨ (S.A * P * S.B) := iff.rfl

end Segment

end IncidencePlane


/-
https://leanprover.zulipchat.com/#narrow/stream/217875-Is-there.20code.20for.20X.3F/topic/(list.2Econs.20a.20l).20.E2.89.A0.20l
-/
import tactic

universe u

example {α : Type u} (a : α) (l : list α) : (list.cons a l) ≠ l := begin
  induction l,
  { simp },
  simp only [not_and, ne.def],
  rintro ⟨⟩,
  exact l_ih,
end

-- example {α : Type u} (a : α) (l : list α) : (list.cons a l) ≠ l := begin
--   refl <|> ac_refl <|> assumption <|> squeeze_simp <|> cc <|> ring <|> nlinarith <|> norm_cast <|> norm_num <|> tauto <|> trivial <|> hint <|> suggest <|> tidy? <|> finish <|> clarify <|> safe <|> library_search!
-- end

example {α : Type u} (a : α) (l : list α) : (list.cons a l) ≠ l := begin
  rw ne.def,
  induction l,
  {
    simp only [not_false_iff],
  },
  {
    simp only [not_and],
    intro h,
    cases h,
    assumption,
  }
end

example {α} (a : α) (l : list α) : list.cons a l ≠ l :=
begin
  apply mt (congr_arg list.length),
  apply ne_of_gt,
  apply nat.lt_succ_self l.length,
end

example {α} (a : α) (l : list α) : list.cons a l ≠ l :=
begin
  apply mt (congr_arg list.length),
  apply ne_of_gt,
  apply nat.lt_succ_self l.length,
end

example (a : ℕ) (l : list ℕ) : list.cons a l ≠ list.nil
| h := by cases h

-- set_option trace.eqn_compiler.elim_match true

namespace hidden
open list

-- https://github.com/leanprover-community/mathlib/issues/3584
lemma cons_ne_self' {α : Type u} : ∀ (a : α) (l : list α), (cons a l) ≠ l
| a nil := cons_ne_nil a nil
| a (h :: t) := cons_ne_self' h t ∘ tail_eq_of_cons_eq

/-
equation compiler failed to create auxiliary declaration '_example._main._pack.equations._eqn_2'
nested exception message:
invalid equation lemma, unexpected form
-/
-- example {α : Type u} : ∀ (a : α) (l : list α), (cons a l) ≠ l
-- | a nil := by simp
-- | a (cons h t) := by solve_by_elim

/-
failed to prove recursive application is decreasing, well founded relation
  @has_well_founded.r (Σ' (a : α), list α)
    (@psigma.has_well_founded α (λ (a : α), list α) (@has_well_founded_of_has_sizeof α (default_has_sizeof α))
       (λ (a : α), @has_well_founded_of_has_sizeof (list α) (@list.has_sizeof α (default_has_sizeof α))))
The nested exception contains the failure state for the decreasing tactic.
nested exception message:
invalid apply tactic, failed to unify
  0 < 0
with
  ?m_1 < ?m_1 + ?m_2
state:
α : Type u,
cons_ne_self : ∀ (_p : Σ' (a : α), list α), _p.fst :: _p.snd ≠ _p.snd,
a h : α,
t : list α,
a : α,
l : list α
⊢ 0 < 0
-/
-- lemma cons_ne_self'' {α : Type u} : ∀ (a : α) (l : list α), (cons a l) ≠ l
-- | a nil := by simp
-- | a (cons h t) := by simp [cons_ne_self'']
-- using_well_founded {
--   dec_tac := well_founded_tactics.default_dec_tac
-- }

lemma cons_ne_self {α : Type u} : ∀ (a : α) (l : list α), (cons a l) ≠ l
| a nil := by simp
| a (cons h t) := by simp [cons_ne_self h t]

end hidden


/-
Copyright (c) 2021 Kalle Kytölä. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kalle Kytölä
-/
import tactic
import analysis.normed_space.bounded_linear_maps
import analysis.normed_space.weak_dual
import analysis.seminorm
import linear_algebra.affine_space.basic

noncomputable theory
open normed_space
open metric
open basis
open set
open function
open filter
open_locale topological_space

section alaoglu
/-!
### Banach-Alaoglu theorem
We prove that the dual unit ball of a normed space `E` over either `ℝ` or `ℂ` is compact
in the weak-star topology. (In fact more generally any polar of a neighborhood of the origin
is compact in `weak_dual 𝕜 E` for `[is_R_or_C 𝕜]`.)
-/

-- Where to place?
lemma linear_map_bound_of_sphere_bound
  {𝕜 : Type*} [is_R_or_C 𝕜] {E : Type*} [normed_group E] [normed_space 𝕜 E]
  {r : ℝ} (r_pos : 0 < r) (c : ℝ) (f : E →ₗ[𝕜] 𝕜)
  (h : ∀ z ∈ sphere (0 : E) r, ∥ f z ∥ ≤ c) (z : E) : ∥ f z ∥ ≤ c / r * ∥ z ∥ :=
begin
  by_cases z_zero : z = 0,
  { rw z_zero, simp only [linear_map.map_zero, norm_zero, mul_zero], },
  have norm_z_eq : ∥(∥ z ∥ : 𝕜)∥ =  ∥ z ∥ := norm_norm' 𝕜 E z,
  have norm_r_eq : ∥(r : 𝕜)∥ = r,
  { rw [is_R_or_C.norm_eq_abs, is_R_or_C.abs_of_real],
    exact abs_of_pos r_pos, },
  set z₁ := (r * ∥ z ∥⁻¹ : 𝕜) • z with hz₁,
  have norm_f_z₁ : ∥ f z₁ ∥ ≤ c,
  { apply h z₁,
    rw [mem_sphere_zero_iff_norm, hz₁, norm_smul, normed_field.norm_mul],
    simp only [normed_field.norm_inv],
    rw [norm_z_eq, mul_assoc, inv_mul_cancel (norm_pos_iff.mpr z_zero).ne.symm, mul_one],
    unfold_coes,
    simp only [norm_algebra_map_eq, ring_hom.to_fun_eq_coe],
    exact abs_of_pos r_pos, },
  have r_ne_zero : (r : 𝕜) ≠ 0 := (algebra_map ℝ 𝕜).map_ne_zero.mpr r_pos.ne.symm,
  have eq : f z = ∥ z ∥ / r * (f z₁),
  { rw [hz₁, linear_map.map_smul, smul_eq_mul],
    rw [← mul_assoc, ← mul_assoc, div_mul_cancel _ r_ne_zero, mul_inv_cancel, one_mul],
    simp only [z_zero, is_R_or_C.of_real_eq_zero, norm_eq_zero, ne.def, not_false_iff], },
  rw [eq, normed_field.norm_mul, normed_field.norm_div, norm_z_eq, norm_r_eq,
      div_mul_eq_mul_div, div_mul_eq_mul_div, mul_comm],
  apply div_le_div _ _ r_pos rfl.ge,
  { exact mul_nonneg ((norm_nonneg _).trans norm_f_z₁) (norm_nonneg z), },
  apply mul_le_mul norm_f_z₁ rfl.le (norm_nonneg z) ((norm_nonneg _).trans norm_f_z₁),
end

-- Where to place? `analysis/normed_space/operator_norm`?
lemma linear_map_bound_of_ball_bound
  {𝕜 : Type*} [is_R_or_C 𝕜] {E : Type*} [normed_group E] [normed_space 𝕜 E]
  {r : ℝ} (r_pos : 0 < r) (c : ℝ) (f : E →ₗ[𝕜] 𝕜)
  (h : ∀ z ∈ closed_ball (0 : E) r, ∥ f z ∥ ≤ c) :
  ∀ (z : E), ∥ f z ∥ ≤ c / r * ∥ z ∥ :=
begin
  apply linear_map_bound_of_sphere_bound r_pos c f,
  exact λ z hz, h z hz.le,
end

-- Where to place? `analysis/normed_space/operator_norm`?
lemma _root_.continuous_linear_map.op_norm_bound_of_ball_bound
  {𝕜 : Type*} [is_R_or_C 𝕜] {E : Type*} [normed_group E] [normed_space 𝕜 E]
  {r : ℝ} (r_pos : 0 < r) (c : ℝ) (f : E →L[𝕜] 𝕜)
  (h : ∀ z ∈ closed_ball (0 : E) r, ∥ f z ∥ ≤ c) : ∥ f ∥ ≤ c / r :=
begin
  apply continuous_linear_map.op_norm_le_bound,
  { apply div_nonneg _ r_pos.le,
    exact (norm_nonneg _).trans
          (h 0 (by simp only [norm_zero, mem_closed_ball, dist_zero_left, r_pos.le])), },
  apply linear_map_bound_of_ball_bound r_pos,
  exact λ z hz, h z hz,
end

variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
variables {E : Type*} [normed_group E] [normed_space 𝕜 E]

namespace weak_dual

/-- Given a subset `s` in a normed space `E` (over a field `𝕜`), the polar
`polar s` is the subset of `weak_dual 𝕜 E` consisting of those functionals which
evaluate to something of norm at most one at all points `z ∈ s`. -/
def polar (s : set E) : set (weak_dual 𝕜 E) :=
{x' : weak_dual 𝕜 E | ∀ z ∈ s, ∥ x' z ∥ ≤ 1 }

@[simp] lemma zero_mem_polar (s : set E) :
  (0 : weak_dual 𝕜 E) ∈ (@polar 𝕜 _ E _ _ s) :=
λ _ _, by simp only [zero_le_one, continuous_linear_map.zero_apply, norm_zero]

lemma polar_eq_Inter (s : set E) :
  (@polar 𝕜 _ E _ _ s) = ⋂ z ∈ s, {x' : weak_dual 𝕜 E | ∥ x' z ∥ ≤ 1 } :=
by { dunfold polar, ext, simp only [mem_bInter_iff, mem_set_of_eq], }

-- Exists already? If not, where to place? `topology/basic`?
lemma _root_.continuous.is_closed_preimage {α β : Type*} [topological_space α] [topological_space β]
  {f : α → β} (f_cont : continuous f) {s : set β} (s_closed : is_closed s) :
  is_closed (f⁻¹' s) :=
begin
  apply is_open_compl_iff.mp,
  rw ← preimage_compl,
  exact f_cont.is_open_preimage _ (is_open_compl_iff.mpr s_closed),
end

/-- The polar `polar s` of a set `s : E` is a closed subset of `weak_dual 𝕜 E`. -/
lemma polar_closed (s : set E) : is_closed (@polar 𝕜 _ E _ _ s) :=
begin
  rw polar_eq_Inter,
  apply is_closed_bInter,
  intros z hz,
  have eq : {x' : weak_dual 𝕜 E | ∥x' z∥ ≤ 1} = (λ (x' : weak_dual 𝕜 E), ∥x' z∥)⁻¹' (Iic 1),
  by refl,
  rw eq,
  refine continuous.is_closed_preimage _ (is_closed_Iic),
  apply continuous.comp continuous_norm (eval_continuous _ _ z),
end

/-- If `x'` is a dual element such that the norms `∥ x' z ∥` are bounded for `z ∈ s`, then a
small scalar multiple of `x'` is in `polar s`. -/
lemma smul_mem_polar {s : set E} {x' : weak_dual 𝕜 E} {c : 𝕜}
  (hc : ∀ z, z ∈ s → ∥ x' z ∥ ≤ ∥c∥) : (c⁻¹ • x') ∈ (@polar 𝕜 _ E _ _ s) :=
begin
  by_cases c_zero : c = 0,
  { rw c_zero,
    dunfold polar,
    simp only [zero_le_one, continuous_linear_map.zero_apply, norm_zero,
               mem_set_of_eq, implies_true_iff, inv_zero, zero_smul], },
  have eq : ∀ z, ∥ c⁻¹ • (x' z) ∥ = ∥ c⁻¹ ∥ * ∥ x' z ∥ := λ z, norm_smul c⁻¹ _,
  have le : ∀ z, z ∈ s → ∥ c⁻¹ • (x' z) ∥ ≤ ∥ c⁻¹ ∥ * ∥ c ∥,
  { intros z hzs,
    rw eq z,
    apply mul_le_mul (le_of_eq rfl) (hc z hzs) (norm_nonneg _) (norm_nonneg _), },
  have cancel : ∥ c⁻¹ ∥ * ∥ c ∥ = 1,
  by simp only [c_zero, norm_eq_zero, ne.def, not_false_iff,
                inv_mul_cancel, normed_field.norm_inv],
  rwa cancel at le,
end

/-- The `polar` of closed unit ball in a normed space `E` is the closed unit ball of the (normed) dual
(seen as a subset of the weak dual). -/
lemma polar_closed_unit_ball
  {𝕜 : Type*} [is_R_or_C 𝕜] {E : Type*} [normed_group E] [normed_space 𝕜 E] :
  (@polar 𝕜 _ E _ _ (closed_ball (0 : E) 1))
    = {x' : weak_dual 𝕜 E | (∥ x'.to_normed_dual ∥ ≤ 1) } :=
begin
  ext x',
  simp only [mem_closed_ball, mem_set_of_eq, dist_zero_right],
  split,
  { intros h,
    apply continuous_linear_map.op_norm_le_of_ball zero_lt_one zero_le_one,
    intros z hz,
    have key := linear_map_bound_of_ball_bound zero_lt_one 1 x'.to_normed_dual.to_linear_map h z,
    simp only [continuous_linear_map.to_linear_map_eq_coe, continuous_linear_map.coe_coe, div_one] at key,
    exact key, },
  { intros h z hz,
    simp only [mem_closed_ball, dist_zero_right] at hz,
    apply (continuous_linear_map.unit_le_op_norm x'.to_normed_dual z hz).trans h, },
end

/-- If `s` is a neighborhood of the origin in a normed space `E`, then at any point `z : E` there
exists a bound for the norms of the values `x' z` of the elements `x' ∈ polar s` of the polar of `s`. -/
lemma polar_eval_bounded_of_nbhd_zero {s : set E} (s_nhd : s ∈ 𝓝 (0 : E)) (z : E) :
  ∃ (r : ℝ), ∀ (x' : weak_dual 𝕜 E), x' ∈ @polar 𝕜 _ E _ _ s → (∥ x' z ∥ ≤ r) :=
begin
  have s_absnt : absorbent 𝕜 s := absorbent_nhds_zero s_nhd,
  rcases s_absnt z with ⟨c, ⟨c_pos, hc⟩⟩,
  cases normed_field.exists_lt_norm 𝕜 c with a ha,
  specialize hc a ha.le,
  have a_norm_pos : 0 < ∥ a ∥ := lt_trans c_pos ha,
  have a_ne_zero : a ≠ 0 := norm_pos_iff.mp a_norm_pos,
  have w_in_s : a⁻¹ • z ∈ s,
  { rcases hc with ⟨ w , ⟨hws, haw⟩⟩,
    rwa [← haw, ← mul_smul, inv_mul_cancel a_ne_zero, one_smul], },
  use ∥a∥,
  intros x' hx',
  specialize hx' _ w_in_s,
  simp only [algebra.id.smul_eq_mul, normed_field.norm_mul,
             continuous_linear_map.map_smul, normed_field.norm_inv] at hx',
  have key := mul_le_mul (@rfl _ ∥ a ∥).ge hx' _ (norm_nonneg a),
  rwa [mul_one, ← mul_assoc, mul_inv_cancel (ne_of_gt a_norm_pos), one_mul] at key,
  apply mul_nonneg _ (norm_nonneg _),
  simp only [inv_nonneg, norm_nonneg],
end

/-- If `s` is a neighborhood of the origin in a normed space `E`, then there exists a
function `r : E → ℝ` such that for all elements `x' ∈ polar s` one has `∥ x' z ∥ ≤ r(z)`. -/
lemma polar_finite_values_of_nbhd_zero {s : set E} (s_nhd : s ∈ 𝓝 (0 : E)) :
  ∃ (r : E → ℝ), ∀ (x' : weak_dual 𝕜 E) (z : E), x' ∈ (@polar 𝕜 _ E _ _ s) → ∥ x' z ∥ ≤ r z :=
begin
  cases classical.axiom_of_choice (@polar_eval_bounded_of_nbhd_zero 𝕜 _ E _ _ s s_nhd) with r hr,
  use r,
  intros x' z,
  exact hr z x',
end

/-- Given a neighborhood `s` of the origin in a normed space `E` over `ℝ` or `ℂ`, the dual norms
of all elements of the polar `polar s` are bounded by a constant. -/
lemma polar_bounded_of_nbhd_zero
  {𝕜 : Type*} [is_R_or_C 𝕜] {E : Type*} [normed_group E] [normed_space 𝕜 E]
  {s : set E} (s_nhd : s ∈ 𝓝 (0 : E)) :
  ∃ (c : ℝ), ∀ (x' : weak_dual 𝕜 E), x' ∈ @polar 𝕜 _ E _ _ s → (∥ x'.to_normed_dual ∥ ≤ c) :=
begin
  rcases metric.mem_nhds_iff.mp s_nhd with ⟨r, ⟨r_pos, r_ball⟩⟩,
  have half_r_pos : 0 < r / 2 := by linarith,
  use 2 / r,
  intros x' hx',
  have key := continuous_linear_map.op_norm_bound_of_ball_bound half_r_pos 1 x',
  simp only [one_div_div] at key,
  apply key,
  intros z hz,
  have z_mem_ball : z ∈ ball (0 : E) r,
  { simp only [mem_ball_zero_iff],
    simp only [mem_closed_ball, dist_zero_right] at hz,
    linarith, },
  exact hx' z (r_ball z_mem_ball),
end

/-- Given a neighborhood `s` of the origin in a normed space `E`, for any `z : E` it
is possible to choose a real number `r` such that for any functional `x' ∈ polar s` in
the polar of `s`, the value at `z` satisfies the norm bound `∥ x' z ∥ ≤ r`. Such an `r`
is given by `bounds_fun _ z`. -/
private def bounds_fun {s : set E} (s_nhd : s ∈ 𝓝 (0 : E)) : E → ℝ :=
classical.some (classical.axiom_of_choice (@polar_eval_bounded_of_nbhd_zero 𝕜 _ E _ _ s s_nhd))

private lemma bounds_fun_spec {s : set E} (s_nhd : s ∈ 𝓝 (0 : E))
  (x' : weak_dual 𝕜 E) (z : E) :
  x' ∈ @polar 𝕜 _ E _ _ s → ∥ x' z ∥ ≤ @bounds_fun 𝕜 _ E _ _ s s_nhd z :=
classical.some_spec
  (classical.axiom_of_choice (@polar_eval_bounded_of_nbhd_zero 𝕜 _ E _ _ s s_nhd)) z x'

/-- The (weak) dual `weak_dual 𝕜 E` of a normed space `E` consists of bounded linear
functionals `E → 𝕜`. Such functionals can be interpreted as elements of the Cartesian
product `Π (_ : E), 𝕜` via the function `weak_dual.to_Pi : weak_dual 𝕜 E → Π (_ : E), 𝕜`. -/
def _root_.weak_dual.to_Pi {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
  {E : Type*} [topological_space E] [add_comm_group E] [module 𝕜 E]
  (x' : weak_dual 𝕜 E) := ((λ z, (x' z)) : (Π (_ : E), 𝕜))

/-- The function `weak_dual.to_Pi : weak_dual 𝕜 E → Π (_ : E), 𝕜` is an embedding. -/
lemma embedding_weak_dual_to_pi :
  embedding (λ (x' : weak_dual 𝕜 E), x'.to_Pi) :=
{ induced := eq_of_nhds_eq_nhds (congr_fun rfl),
  inj := begin
    intros φ₁ φ₂ h,
    ext z,
    exact congr_fun h z,
  end, }

lemma pi_ball_bounds_fun_cpt [proper_space 𝕜] {s : set E} (s_nhd : s ∈ 𝓝 (0 : E)) :
  is_compact (set.pi (univ : set E) (λ z, (closed_ball (0 : 𝕜) (@bounds_fun 𝕜 _ E _ _ s s_nhd z)))) :=
begin
  apply is_compact_univ_pi,
  exact λ z, proper_space.is_compact_closed_ball 0 _,
end

/-- The image of the polar `polar s` of a neighborhood `s` of the origin under
`weak_dual.to_Pi : weak_dual 𝕜 E → Π (_ : E), 𝕜` is contained in a product of closed balls. -/
lemma embedding_weak_dual_to_pi.image_polar_nhd_subset {s : set E} (s_nhd : s ∈ 𝓝 (0 : E)) :
  (@weak_dual.to_Pi 𝕜 _ E _ _ _) '' (polar s) ⊆
    (set.pi (univ : set E) (λ z, (closed_ball (0 : 𝕜) (@bounds_fun 𝕜 _ E _ _ s s_nhd z)))) :=
begin
  intros f hf,
  simp at hf,
  rcases hf with ⟨x', hx', f_eq⟩,
  simp only [mem_closed_ball, dist_zero_right, mem_univ_pi],
  intros z,
  have key := bounds_fun_spec s_nhd x' z,
  have eq : x' z = f z := congr_fun f_eq z,
  rw eq at key,
  exact key hx',
end

/-- In the product of copies of a normed field, sets of the form `{g | ∥ f(i) - g(i) ∥ < ε}` for
`ε > 0` are neighborhoods of `f`. -/
lemma basic_nhd_of_Pi_normed_field {ι : Type*}
  (f : (Π (_ : ι), 𝕜)) (i : ι) {ε : ℝ} (ε_pos : 0 < ε) :
  {g : (Π (_ : ι), 𝕜) | ∥ f i - g i ∥ < ε} ∈ 𝓝 f :=
begin
  have eq : { g : (Π (_ : ι), 𝕜) | ∥ f i - g i ∥ < ε}
            = set.pi ({i} : set ι) (λ _, ball (f i) ε),
  { ext g,
    simp only [mem_ball, eval_apply, singleton_pi, mem_set_of_eq, mem_preimage],
    rw dist_comm,
    exact mem_ball_iff_norm.symm, },
  rw eq,
  apply set_pi_mem_nhds,
  exact finite_singleton i,
  intros j hj,
  have eq₀ : j = i := hj,
  rw eq₀,
  exact ball_mem_nhds (f i) ε_pos,
end

/-- Elements of the closure of the range of the embedding
`weak_dual.to_Pi : weak_dual 𝕜 E → Π (_ : E), 𝕜` are linear. Here it is stated as the elements
respecting linear combinations. -/
lemma embedding_weak_dual_to_pi.linear_of_mem_closure_range'
  (f : (Π (_ : E), 𝕜)) (hf : f ∈ closure (range (@weak_dual.to_Pi 𝕜 _ E _ _ _)))
  (c₁ c₂ : 𝕜) (z₁ z₂ : E) : f (c₁ • z₁ + c₂ • z₂) = c₁ • f(z₁) + c₂ • f(z₂) :=
begin
  set φ : (Π (_ : E), 𝕜) → 𝕜 := (λ g, g (c₁ • z₁ + c₂ • z₂) - c₁ • g(z₁) - c₂ • g(z₂)) with hφ,
  have φ_cont : continuous φ,
  { apply continuous.sub,
    { apply continuous.sub,
      { exact continuous_apply (c₁ • z₁ + c₂ • z₂), },
      exact continuous.smul continuous_const (continuous_apply _), },
    exact continuous.smul continuous_const (continuous_apply _), },
  have sin_closed : is_closed ({0} : set 𝕜) := t1_space.t1 0,
  have preim_cl : is_closed (φ⁻¹' ({0} : set 𝕜)) := φ_cont.is_closed_preimage sin_closed,
  suffices : range (@weak_dual.to_Pi 𝕜 _ E _ _ _) ⊆ φ⁻¹' ({0} : set 𝕜),
  { have key := (is_closed.closure_subset_iff preim_cl).mpr this hf,
    exact sub_eq_iff_eq_add'.mp (sub_eq_zero.mp key), },
  intros g hg,
  cases hg with g₀ hg₀,
  simp only [algebra.id.smul_eq_mul, mem_singleton_iff, norm_eq_zero, mem_preimage],
  rw [hφ, ← hg₀],
  dunfold weak_dual.to_Pi,
  rw add_comm,
  simp only [algebra.id.smul_eq_mul, continuous_linear_map.map_add, add_sub_cancel,
             sub_self, continuous_linear_map.map_smul],
end

/-- Elements of the closure of the range of the embedding
`weak_dual.to_Pi : weak_dual 𝕜 E → Π (_ : E), 𝕜` can be viewed as linear maps `E → 𝕜`. -/
def embedding_weak_dual_to_pi.linear_of_mem_closure_range
  (f : (Π (_ : E), 𝕜)) (hf : f ∈ closure (range (@weak_dual.to_Pi 𝕜 _ E _ _ _))) :
  E →ₗ[𝕜] 𝕜 :=
{ to_fun := f,
  map_add' := begin
    intros z₁ z₂,
    have key := embedding_weak_dual_to_pi.linear_of_mem_closure_range' f hf (1 : 𝕜) (1 : 𝕜) z₁ z₂,
    rwa [one_smul, one_smul, one_smul 𝕜 _, one_smul 𝕜 _] at key,
  end,
  map_smul' := begin
    intros c z,
    have key := embedding_weak_dual_to_pi.linear_of_mem_closure_range' f hf c (0 : 𝕜) z (0 : E),
    rwa [zero_smul, zero_smul, add_zero, add_zero] at key,
  end, }

lemma embedding_weak_dual_to_pi.linear_of_mem_closure_range_apply
  (f : (Π (_ : E), 𝕜)) (hf : f ∈ closure (range (@weak_dual.to_Pi 𝕜 _ E _ _ _))) (z : E) :
  embedding_weak_dual_to_pi.linear_of_mem_closure_range f hf z = f z := rfl

/-- Elements of the closure of the image under `weak_dual.to_Pi : weak_dual 𝕜 E → Π (_ : E), 𝕜` of
a subset defined by a non-strict bound on the norm still satisfy the same bound. -/
lemma embedding_weak_dual_to_pi.norm_eval_le_of_mem_closure_norm_eval_le
  (z : E) (c : ℝ) (f : (Π (_ : E), 𝕜))
  (hf : f ∈ closure ((@weak_dual.to_Pi 𝕜 _ E _ _ _) '' {x' : weak_dual 𝕜 E | ∥ x' z ∥ ≤ c})) :
  ∥ f z ∥ ≤ c :=
begin
  suffices : ∀ (ε : ℝ), 0 < ε → ∥ f (z) ∥ ≤ c + ε,
  { exact le_of_forall_pos_le_add this, },
  intros ε ε_pos,
  have nhd := basic_nhd_of_Pi_normed_field f z ε_pos,
  have clos := mem_closure_iff_nhds.mp hf _ nhd,
  cases clos with g hg,
  simp only [mem_image, mem_inter_eq, mem_set_of_eq] at hg,
  rcases hg with ⟨tri, ⟨y', ⟨at_z_le, eq_g⟩⟩⟩,
  have eq : y'.to_Pi z = y' z := rfl,
  rw [← eq_g, eq] at tri,
  have key := norm_add_le_of_le tri.le at_z_le,
  rwa [sub_add_cancel, add_comm] at key,
end

/-- Elements of the closure of the image under `weak_dual.to_Pi : weak_dual 𝕜 E → Π (_ : E), 𝕜` of
a polar `polar s` of a neighborhood `s` of the origin are continuous (linear) functions. -/
lemma embedding_weak_dual_to_pi.continuous_of_mem_closure_polar_nhd
  {𝕜 : Type*} [is_R_or_C 𝕜] {E : Type*} [normed_group E] [normed_space 𝕜 E]
  {s : set E} (s_nhd : s ∈ 𝓝 (0 : E)) (φ : (Π (_ : E), 𝕜))
  (hφ : φ ∈ closure ((@weak_dual.to_Pi 𝕜 _ E _ _ _) '' (@polar 𝕜 _ E _ _ s))) :
  @continuous E 𝕜 _ _ φ :=
begin
  cases @polar_bounded_of_nbhd_zero 𝕜 _ E _ _ s s_nhd with c hc,
  have c_nn : 0 ≤ c := le_trans (norm_nonneg _) (hc 0 (zero_mem_polar s)),
  have hφ' : φ ∈ closure (range (@weak_dual.to_Pi 𝕜 _ E _ _ _)),
  { apply mem_of_mem_of_subset hφ _,
    apply closure_mono,
    simp only [preimage_range, subset_univ, image_subset_iff], },
  set flin := embedding_weak_dual_to_pi.linear_of_mem_closure_range φ hφ' with hflin,
  suffices : continuous flin,
  { assumption, },
  apply linear_map.continuous_of_bound flin c,
  intros z,
  set θ := λ (ψ : Π (_ : E), 𝕜), ∥ ψ z ∥ with hθ,
  have θ_cont : continuous θ,
  { apply continuous.comp continuous_norm,
    exact continuous_apply z, },
  have sin_closed : is_closed (Icc (-c * ∥z∥) (c * ∥z∥) : set ℝ) := is_closed_Icc,
  have preim_cl := θ_cont.is_closed_preimage sin_closed,
  suffices :
    (@weak_dual.to_Pi 𝕜 _ E _ _ _) '' (@polar 𝕜 _ E _ _ s) ⊆ θ⁻¹' (Icc (-c * ∥z∥) (c * ∥z∥)),
  { exact ((is_closed.closure_subset_iff preim_cl).mpr this hφ).right, },
  intros ψ hψ,
  rcases hψ with ⟨x', ⟨polar_x', ψ_x'⟩⟩,
  rw ← ψ_x',
  simp only [neg_mul_eq_neg_mul_symm, mem_preimage, mem_Icc, hθ],
  split,
  { apply le_trans _ (norm_nonneg _),
    rw right.neg_nonpos_iff,
    exact mul_nonneg c_nn (norm_nonneg _), },
  apply le_trans (continuous_linear_map.le_op_norm x' z) _,
  exact mul_le_mul (hc x' polar_x') rfl.ge (norm_nonneg z) c_nn,
end

/-- The image under `weak_dual.to_Pi : weak_dual 𝕜 E → Π (_ : E), 𝕜` of a polar `polar s` of a
neighborhood `s` of the origin is a closed set. -/
lemma embedding_weak_dual_to_pi.image_polar_nhd_closed
  {𝕜 : Type*} [is_R_or_C 𝕜] {E : Type*} [normed_group E] [normed_space 𝕜 E]
  {s : set E} (s_nhd : s ∈ 𝓝 (0 : E)) :
  is_closed ((@weak_dual.to_Pi 𝕜 _ E _ _ _) '' (@polar 𝕜 _ E _ _ s)) :=
begin
  apply is_closed_iff_cluster_pt.mpr,
  intros f hf,
  simp only [mem_image, mem_set_of_eq],
  have f_in_closure : f ∈ closure ((@weak_dual.to_Pi 𝕜 _ E _ _ _) '' (@polar 𝕜 _ E _ _ s)),
  from mem_closure_iff_cluster_pt.mpr hf,
  have f_in_closure₀ : f ∈ closure (range (@weak_dual.to_Pi 𝕜 _ E _ _ _)),
  { apply closure_mono (image_subset_range _ _),
    exact mem_closure_iff_cluster_pt.mpr hf, },
  set f_lin := embedding_weak_dual_to_pi.linear_of_mem_closure_range f f_in_closure₀ with h_f_lin,
  have f_cont := embedding_weak_dual_to_pi.continuous_of_mem_closure_polar_nhd s_nhd f f_in_closure,
  set φ : weak_dual 𝕜 E :=
    { to_fun := f,
      map_add' := begin
        intros z₁ z₂,
        have key := f_lin.map_add z₁ z₂,
        rw h_f_lin at key,
        repeat {rwa embedding_weak_dual_to_pi.linear_of_mem_closure_range_apply
          f f_in_closure₀ _ at key, },
      end,
      map_smul' := begin
        intros c z,
        have key := f_lin.map_smul c z,
        rw h_f_lin at key,
        repeat {rwa embedding_weak_dual_to_pi.linear_of_mem_closure_range_apply
          f f_in_closure₀ _ at key, },
      end,
      cont := f_cont, } with hφ,
  use φ,
  split,
  { dunfold polar,
    simp,
    intros z hz,
    apply embedding_weak_dual_to_pi.norm_eval_le_of_mem_closure_norm_eval_le z 1 f,
    have ss : polar s ⊆ {x' : weak_dual 𝕜 E | ∥x' z∥ ≤ 1},
    { intros x' hx',
      exact hx' z hz, },
    apply closure_mono (image_subset _ ss),
    exact mem_closure_iff_cluster_pt.mpr hf, },
  { ext z,
    dunfold to_Pi,
    rw hφ,
    simp, },
end

/-- The image under `weak_dual.to_Pi : weak_dual 𝕜 E → Π (_ : E), 𝕜` of the polar `polar s` of
a neighborhood `s` of the origin is compact. -/
lemma embedding_weak_dual_to_pi.image_polar_nhd_compact
  {𝕜 : Type*} [is_R_or_C 𝕜] {E : Type*} [normed_group E] [normed_space 𝕜 E]
  {s : set E} (s_nhd : s ∈ 𝓝 (0 : E)) :
  is_compact ((@weak_dual.to_Pi 𝕜 _ E _ _ _) '' (polar s)) :=
begin
  apply compact_of_is_closed_subset _ _ (embedding_weak_dual_to_pi.image_polar_nhd_subset s_nhd),
  exact pi_ball_bounds_fun_cpt s_nhd,
  exact embedding_weak_dual_to_pi.image_polar_nhd_closed s_nhd,
end

/-- The Banach-Alaoglu theorem: the polar `polar s` of a neighborhood `s` of the origin in a
normed space `E` over `𝕜` is compact subset of `weak_dual 𝕜 E` (assuming `[is_R_or_C 𝕜]`). -/
theorem polar_nhd_weak_star_compact
  {𝕜 : Type*} [is_R_or_C 𝕜] {E : Type*} [normed_group E] [normed_space 𝕜 E]
  {s : set E} (s_nhd : s ∈ 𝓝 (0 : E)) : is_compact (@polar 𝕜 _ E _ _ s) :=
begin
  apply (@embedding_weak_dual_to_pi 𝕜 _ E _ _ ).is_compact_iff_is_compact_image.mpr,
  exact embedding_weak_dual_to_pi.image_polar_nhd_compact s_nhd,
end

/-- The Banach-Alaoglu theorem: the dual unit ball is compact in the weak-star topology. -/
theorem unit_ball_weak_star_compact
  {𝕜 : Type*} [is_R_or_C 𝕜] {E : Type*} [normed_group E] [normed_space 𝕜 E] :
  is_compact {x' : weak_dual 𝕜 E | (∥ x'.to_normed_dual ∥ ≤ 1)} :=
begin
  rw ← polar_closed_unit_ball,
  apply polar_nhd_weak_star_compact (closed_ball_mem_nhds (0 : E) (@zero_lt_one ℝ _ _)),
end

end weak_dual

end alaoglu


namespace xena

inductive xnat
| zero : xnat
| succ : xnat → xnat

open xnat

definition add : xnat → xnat → xnat
| n zero := n
| n (succ p) := succ (add n p)

notation a + b := add a b

definition one := succ zero
definition two := succ one
definition three := succ two
definition four := succ three

example : two + two = four :=
begin
dunfold two, -- goal now succ one + succ one = four
admit,
end


/-
Copyright (c) 2022 Riccardo Brasca. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Riccardo Brasca

! This file was ported from Lean 3 source module ring_theory.polynomial.eisenstein.basic
! leanprover-community/mathlib commit 2032a878972d5672e7c27c957e7a6e297b044973
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.RingTheory.EisensteinCriterion
import Mathbin.RingTheory.Polynomial.ScaleRoots

/-!
# Eisenstein polynomials
Given an ideal `𝓟` of a commutative semiring `R`, we say that a polynomial `f : R[X]` is
*Eisenstein at `𝓟`* if `f.leading_coeff ∉ 𝓟`, `∀ n, n < f.nat_degree → f.coeff n ∈ 𝓟` and
`f.coeff 0 ∉ 𝓟 ^ 2`. In this file we gather miscellaneous results about Eisenstein polynomials.

## Main definitions
* `polynomial.is_eisenstein_at f 𝓟`: the property of being Eisenstein at `𝓟`.

## Main results
* `polynomial.is_eisenstein_at.irreducible`: if a primitive `f` satisfies `f.is_eisenstein_at 𝓟`,
  where `𝓟.is_prime`, then `f` is irreducible.

## Implementation details
We also define a notion `is_weakly_eisenstein_at` requiring only that
`∀ n < f.nat_degree → f.coeff n ∈ 𝓟`. This makes certain results slightly more general and it is
useful since it is sometimes better behaved (for example it is stable under `polynomial.map`).

-/

universe u v w z

variable {R : Type u}

open Ideal Algebra Finset

open BigOperators Polynomial

namespace Polynomial

/-- Given an ideal `𝓟` of a commutative semiring `R`, we say that a polynomial `f : R[X]`
is *weakly Eisenstein at `𝓟`* if `∀ n, n < f.nat_degree → f.coeff n ∈ 𝓟`. -/
@[mk_iff]
structure IsWeaklyEisensteinAt [CommSemiring R] (f : R[X]) (𝓟 : Ideal R) : Prop where
  Mem : ∀ {n}, n < f.natDegree → f.coeff n ∈ 𝓟
#align polynomial.is_weakly_eisenstein_at Polynomial.IsWeaklyEisensteinAt

/-- Given an ideal `𝓟` of a commutative semiring `R`, we say that a polynomial `f : R[X]`
is *Eisenstein at `𝓟`* if `f.leading_coeff ∉ 𝓟`, `∀ n, n < f.nat_degree → f.coeff n ∈ 𝓟` and
`f.coeff 0 ∉ 𝓟 ^ 2`. -/
@[mk_iff]
structure IsEisensteinAt [CommSemiring R] (f : R[X]) (𝓟 : Ideal R) : Prop where
  leading : f.leadingCoeff ∉ 𝓟
  Mem : ∀ {n}, n < f.natDegree → f.coeff n ∈ 𝓟
  not_mem : f.coeff 0 ∉ 𝓟 ^ 2
#align polynomial.is_eisenstein_at Polynomial.IsEisensteinAt

namespace IsWeaklyEisensteinAt

section CommSemiring

variable [CommSemiring R] {𝓟 : Ideal R} {f : R[X]} (hf : f.IsWeaklyEisensteinAt 𝓟)

include hf

theorem map {A : Type v} [CommRing A] (φ : R →+* A) : (f.map φ).IsWeaklyEisensteinAt (𝓟.map φ) :=
  by
  refine' (is_weakly_eisenstein_at_iff _ _).2 fun n hn => _
  rw [coeff_map]
  exact mem_map_of_mem _ (hf.mem (lt_of_lt_of_le hn (nat_degree_map_le _ _)))
#align polynomial.is_weakly_eisenstein_at.map Polynomial.IsWeaklyEisensteinAt.map

end CommSemiring

section CommRing

variable [CommRing R] {𝓟 : Ideal R} {f : R[X]} (hf : f.IsWeaklyEisensteinAt 𝓟)

variable {S : Type v} [CommRing S] [Algebra R S]

section Principal

variable {p : R}

-- mathport name: exprP
local notation "P" => Submodule.span R {p}

theorem exists_mem_adjoin_mul_eq_pow_natDegree {x : S} (hx : aeval x f = 0) (hmo : f.Monic)
    (hf : f.IsWeaklyEisensteinAt P) :
    ∃ y ∈ adjoin R ({x} : Set S), (algebraMap R S) p * y = x ^ (f.map (algebraMap R S)).natDegree :=
  by
  rw [aeval_def, Polynomial.eval₂_eq_eval_map, eval_eq_sum_range, range_add_one,
    sum_insert not_mem_range_self, sum_range, (hmo.map (algebraMap R S)).coeff_natDegree,
    one_mul] at hx
  replace hx := eq_neg_of_add_eq_zero_left hx
  have : ∀ n < f.nat_degree, p ∣ f.coeff n :=
    by
    intro n hn
    refine' mem_span_singleton.1 (by simpa using hf.mem hn)
  choose! φ hφ using this
  conv_rhs at hx =>
    congr
    congr
    skip
    ext
    rw [[anonymous], coeff_map, hφ i.1 (lt_of_lt_of_le i.2 (nat_degree_map_le _ _)),
      RingHom.map_mul, mul_assoc]
  rw [hx, ← mul_sum, neg_eq_neg_one_mul, ← mul_assoc (-1 : S), mul_comm (-1 : S), mul_assoc]
  refine'
    ⟨-1 * ∑ i : Fin (f.map (algebraMap R S)).natDegree, (algebraMap R S) (φ i.1) * x ^ i.1, _, rfl⟩
  exact
    Subalgebra.mul_mem _ (Subalgebra.neg_mem _ (Subalgebra.one_mem _))
      (Subalgebra.sum_mem _ fun i hi =>
        Subalgebra.mul_mem _ (Subalgebra.algebraMap_mem _ _)
          (Subalgebra.pow_mem _ (subset_adjoin (Set.mem_singleton x)) _))
#align polynomial.is_weakly_eisenstein_at.exists_mem_adjoin_mul_eq_pow_nat_degree Polynomial.IsWeaklyEisensteinAt.exists_mem_adjoin_mul_eq_pow_natDegree

theorem exists_mem_adjoin_mul_eq_pow_natDegree_le {x : S} (hx : aeval x f = 0) (hmo : f.Monic)
    (hf : f.IsWeaklyEisensteinAt P) :
    ∀ i,
      (f.map (algebraMap R S)).natDegree ≤ i →
        ∃ y ∈ adjoin R ({x} : Set S), (algebraMap R S) p * y = x ^ i :=
  by
  intro i hi
  obtain ⟨k, hk⟩ := exists_add_of_le hi
  rw [hk, pow_add]
  obtain ⟨y, hy, H⟩ := exists_mem_adjoin_mul_eq_pow_nat_degree hx hmo hf
  refine' ⟨y * x ^ k, _, _⟩
  · exact Subalgebra.mul_mem _ hy (Subalgebra.pow_mem _ (subset_adjoin (Set.mem_singleton x)) _)
  · rw [← mul_assoc _ y, H]
#align polynomial.is_weakly_eisenstein_at.exists_mem_adjoin_mul_eq_pow_nat_degree_le Polynomial.IsWeaklyEisensteinAt.exists_mem_adjoin_mul_eq_pow_natDegree_le

end Principal

include hf

theorem pow_natDegree_le_of_root_of_monic_mem {x : R} (hroot : IsRoot f x) (hmo : f.Monic) :
    ∀ i, f.natDegree ≤ i → x ^ i ∈ 𝓟 := by
  intro i hi
  obtain ⟨k, hk⟩ := exists_add_of_le hi
  rw [hk, pow_add]
  suffices x ^ f.nat_degree ∈ 𝓟 by exact mul_mem_right (x ^ k) 𝓟 this
  rw [is_root.def, eval_eq_sum_range, Finset.range_add_one,
    Finset.sum_insert Finset.not_mem_range_self, Finset.sum_range, hmo.coeff_nat_degree, one_mul] at
    hroot
  rw [eq_neg_of_add_eq_zero_left hroot, neg_mem_iff]
  refine' Submodule.sum_mem _ fun i hi => mul_mem_right _ _ (hf.mem (Fin.is_lt i))
#align polynomial.is_weakly_eisenstein_at.pow_nat_degree_le_of_root_of_monic_mem Polynomial.IsWeaklyEisensteinAt.pow_natDegree_le_of_root_of_monic_mem

theorem pow_natDegree_le_of_aeval_zero_of_monic_mem_map {x : S} (hx : aeval x f = 0)
    (hmo : f.Monic) :
    ∀ i, (f.map (algebraMap R S)).natDegree ≤ i → x ^ i ∈ 𝓟.map (algebraMap R S) :=
  by
  suffices x ^ (f.map (algebraMap R S)).natDegree ∈ 𝓟.map (algebraMap R S)
    by
    intro i hi
    obtain ⟨k, hk⟩ := exists_add_of_le hi
    rw [hk, pow_add]
    refine' mul_mem_right _ _ this
  rw [aeval_def, eval₂_eq_eval_map, ← is_root.def] at hx
  refine' pow_nat_degree_le_of_root_of_monic_mem (hf.map _) hx (hmo.map _) _ rfl.le
#align polynomial.is_weakly_eisenstein_at.pow_nat_degree_le_of_aeval_zero_of_monic_mem_map Polynomial.IsWeaklyEisensteinAt.pow_natDegree_le_of_aeval_zero_of_monic_mem_map

end CommRing

end IsWeaklyEisensteinAt

section ScaleRoots

variable {A : Type _} [CommRing R] [CommRing A]

theorem scaleRoots.isWeaklyEisensteinAt (p : R[X]) {x : R} {P : Ideal R} (hP : x ∈ P) :
    (scaleRoots p x).IsWeaklyEisensteinAt P :=
  by
  refine' ⟨fun i hi => _⟩
  rw [coeff_scale_roots]
  rw [nat_degree_scale_roots, ← tsub_pos_iff_lt] at hi
  exact Ideal.mul_mem_left _ _ (Ideal.pow_mem_of_mem P hP _ hi)
#align polynomial.scale_roots.is_weakly_eisenstein_at Polynomial.scaleRoots.isWeaklyEisensteinAt

theorem dvd_pow_natDegree_of_eval₂_eq_zero {f : R →+* A} (hf : Function.Injective f) {p : R[X]}
    (hp : p.Monic) (x y : R) (z : A) (h : p.eval₂ f z = 0) (hz : f x * z = f y) :
    x ∣ y ^ p.natDegree :=
  by
  rw [← nat_degree_scale_roots p x, ← Ideal.mem_span_singleton]
  refine'
    (scale_roots.is_weakly_eisenstein_at _
          (ideal.mem_span_singleton.mpr <| dvd_refl x)).pow_natDegree_le_of_root_of_monic_mem
      _ ((monic_scale_roots_iff x).mpr hp) _ le_rfl
  rw [injective_iff_map_eq_zero'] at hf
  have := scale_roots_eval₂_eq_zero f h
  rwa [hz, Polynomial.eval₂_at_apply, hf] at this
#align polynomial.dvd_pow_nat_degree_of_eval₂_eq_zero Polynomial.dvd_pow_natDegree_of_eval₂_eq_zero

theorem dvd_pow_natDegree_of_aeval_eq_zero [Algebra R A] [Nontrivial A] [NoZeroSMulDivisors R A]
    {p : R[X]} (hp : p.Monic) (x y : R) (z : A) (h : Polynomial.aeval z p = 0)
    (hz : z * algebraMap R A x = algebraMap R A y) : x ∣ y ^ p.natDegree :=
  dvd_pow_natDegree_of_eval₂_eq_zero (NoZeroSMulDivisors.algebraMap_injective R A) hp x y z h
    ((mul_comm _ _).trans hz)
#align polynomial.dvd_pow_nat_degree_of_aeval_eq_zero Polynomial.dvd_pow_natDegree_of_aeval_eq_zero

end ScaleRoots

namespace IsEisensteinAt

section CommSemiring

variable [CommSemiring R] {𝓟 : Ideal R} {f : R[X]} (hf : f.IsEisensteinAt 𝓟)

theorem Polynomial.Monic.leadingCoeff_not_mem (hf : f.Monic) (h : 𝓟 ≠ ⊤) : ¬f.leadingCoeff ∈ 𝓟 :=
  hf.leadingCoeff.symm ▸ (Ideal.ne_top_iff_one _).1 h
#align polynomial.monic.leading_coeff_not_mem Polynomial.Monic.leadingCoeff_not_mem

theorem Polynomial.Monic.isEisensteinAt_of_mem_of_not_mem (hf : f.Monic) (h : 𝓟 ≠ ⊤)
    (hmem : ∀ {n}, n < f.natDegree → f.coeff n ∈ 𝓟) (hnot_mem : f.coeff 0 ∉ 𝓟 ^ 2) :
    f.IsEisensteinAt 𝓟 :=
  { leading := hf.leadingCoeff_not_mem h
    Mem := fun n hn => hmem hn
    not_mem := hnot_mem }
#align polynomial.monic.is_eisenstein_at_of_mem_of_not_mem Polynomial.Monic.isEisensteinAt_of_mem_of_not_mem

include hf

theorem isWeaklyEisensteinAt : IsWeaklyEisensteinAt f 𝓟 :=
  ⟨fun _ => hf.Mem⟩
#align polynomial.is_eisenstein_at.is_weakly_eisenstein_at Polynomial.IsEisensteinAt.isWeaklyEisensteinAt

theorem coeff_mem {n : ℕ} (hn : n ≠ f.natDegree) : f.coeff n ∈ 𝓟 :=
  by
  cases ne_iff_lt_or_gt.1 hn
  · exact hf.mem h
  · rw [coeff_eq_zero_of_nat_degree_lt h]
    exact Ideal.zero_mem _
#align polynomial.is_eisenstein_at.coeff_mem Polynomial.IsEisensteinAt.coeff_mem

end CommSemiring

section IsDomain

variable [CommRing R] [IsDomain R] {𝓟 : Ideal R} {f : R[X]} (hf : f.IsEisensteinAt 𝓟)

/-- If a primitive `f` satisfies `f.is_eisenstein_at 𝓟`, where `𝓟.is_prime`, then `f` is
irreducible. -/
theorem irreducible (hprime : 𝓟.IsPrime) (hu : f.IsPrimitive) (hfd0 : 0 < f.natDegree) :
    Irreducible f :=
  irreducible_of_eisenstein_criterion hprime hf.leading (fun n hn => hf.Mem (coe_lt_degree.1 hn))
    (natDegree_pos_iff_degree_pos.1 hfd0) hf.not_mem hu
#align polynomial.is_eisenstein_at.irreducible Polynomial.IsEisensteinAt.irreducible

end IsDomain

end IsEisensteinAt

end Polynomial