/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Johannes Hölzl, Mario Carneiro, Patrick Massot
-/
import data.prod.pprod
import data.set.countable
import order.filter.prod

/-!
# Filter bases

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

A filter basis `B : filter_basis α` on a type `α` is a nonempty collection of sets of `α`
such that the intersection of two elements of this collection contains some element of
the collection. Compared to filters, filter bases do not require that any set containing
an element of `B` belongs to `B`.
A filter basis `B` can be used to construct `B.filter : filter α` such that a set belongs
to `B.filter` if and only if it contains an element of `B`.

Given an indexing type `ι`, a predicate `p : ι → Prop`, and a map `s : ι → set α`,
the proposition `h : filter.is_basis p s` makes sure the range of `s` bounded by `p`
(ie. `s '' set_of p`) defines a filter basis `h.filter_basis`.

If one already has a filter `l` on `α`, `filter.has_basis l p s` (where `p : ι → Prop`
and `s : ι → set α` as above) means that a set belongs to `l` if and
only if it contains some `s i` with `p i`. It implies `h : filter.is_basis p s`, and
`l = h.filter_basis.filter`. The point of this definition is that checking statements
involving elements of `l` often reduces to checking them on the basis elements.

We define a function `has_basis.index (h : filter.has_basis l p s) (t) (ht : t ∈ l)` that returns
some index `i` such that `p i` and `s i ⊆ t`. This function can be useful to avoid manual
destruction of `h.mem_iff.mpr ht` using `cases` or `let`.

This file also introduces more restricted classes of bases, involving monotonicity or
countability. In particular, for `l : filter α`, `l.is_countably_generated` means
there is a countable set of sets which generates `s`. This is reformulated in term of bases,
and consequences are derived.

## Main statements

* `has_basis.mem_iff`, `has_basis.mem_of_superset`, `has_basis.mem_of_mem` : restate `t ∈ f`
  in terms of a basis;
* `basis_sets` : all sets of a filter form a basis;
* `has_basis.inf`, `has_basis.inf_principal`, `has_basis.prod`, `has_basis.prod_self`,
  `has_basis.map`, `has_basis.comap` : combinators to construct filters of `l ⊓ l'`,
  `l ⊓ 𝓟 t`, `l ×ᶠ l'`, `l ×ᶠ l`, `l.map f`, `l.comap f` respectively;
* `has_basis.le_iff`, `has_basis.ge_iff`, has_basis.le_basis_iff` : restate `l ≤ l'` in terms
  of bases.
* `has_basis.tendsto_right_iff`, `has_basis.tendsto_left_iff`, `has_basis.tendsto_iff` : restate
  `tendsto f l l'` in terms of bases.
* `is_countably_generated_iff_exists_antitone_basis` : proves a filter is
  countably generated if and only if it admits a basis parametrized by a
  decreasing sequence of sets indexed by `ℕ`.
* `tendsto_iff_seq_tendsto ` : an abstract version of "sequentially continuous implies continuous".

## Implementation notes

As with `Union`/`bUnion`/`sUnion`, there are three different approaches to filter bases:

* `has_basis l s`, `s : set (set α)`;
* `has_basis l s`, `s : ι → set α`;
* `has_basis l p s`, `p : ι → Prop`, `s : ι → set α`.

We use the latter one because, e.g., `𝓝 x` in an `emetric_space` or in a `metric_space` has a basis
of this form. The other two can be emulated using `s = id` or `p = λ _, true`.

With this approach sometimes one needs to `simp` the statement provided by the `has_basis`
machinery, e.g., `simp only [exists_prop, true_and]` or `simp only [forall_const]` can help
with the case `p = λ _, true`.
-/

open set filter
open_locale filter classical

section sort

variables {α β γ : Type*} {ι ι' : Sort*}

/-- A filter basis `B` on a type `α` is a nonempty collection of sets of `α`
such that the intersection of two elements of this collection contains some element
of the collection. -/
structure filter_basis (α : Type*) :=
(sets                   : set (set α))
(nonempty               : sets.nonempty)
(inter_sets {x y}       : x ∈ sets → y ∈ sets → ∃ z ∈ sets, z ⊆ x ∩ y)

instance filter_basis.nonempty_sets (B : filter_basis α) : nonempty B.sets := B.nonempty.to_subtype

/-- If `B` is a filter basis on `α`, and `U` a subset of `α` then we can write `U ∈ B` as
on paper. -/
@[reducible]
instance {α : Type*}: has_mem (set α) (filter_basis α) := ⟨λ U B, U ∈ B.sets⟩

-- For illustration purposes, the filter basis defining (at_top : filter ℕ)
instance : inhabited (filter_basis ℕ) :=
⟨{ sets := range Ici,
  nonempty := ⟨Ici 0, mem_range_self 0⟩,
  inter_sets := begin
    rintros _ _ ⟨n, rfl⟩ ⟨m, rfl⟩,
    refine ⟨Ici (max n m), mem_range_self _, _⟩,
    rintros p p_in,
    split ; rw mem_Ici at *,
    exact le_of_max_le_left p_in,
    exact le_of_max_le_right p_in,
  end }⟩

/-- View a filter as a filter basis. -/
def filter.as_basis (f : filter α) : filter_basis α :=
⟨f.sets, ⟨univ, univ_mem⟩, λ x y hx hy, ⟨x ∩ y, inter_mem hx hy, subset_rfl⟩⟩

/-- `is_basis p s` means the image of `s` bounded by `p` is a filter basis. -/
protected structure filter.is_basis (p : ι → Prop) (s : ι → set α) : Prop :=
(nonempty : ∃ i, p i)
(inter : ∀ {i j}, p i → p j → ∃ k, p k ∧ s k ⊆ s i ∩ s j)

namespace filter
namespace is_basis

/-- Constructs a filter basis from an indexed family of sets satisfying `is_basis`. -/
protected def filter_basis {p : ι → Prop} {s : ι → set α} (h : is_basis p s) : filter_basis α :=
{ sets := {t | ∃ i, p i ∧ s i = t},
  nonempty := let ⟨i, hi⟩ := h.nonempty in ⟨s i, ⟨i, hi, rfl⟩⟩,
  inter_sets := by { rintros _ _ ⟨i, hi, rfl⟩ ⟨j, hj, rfl⟩,
                     rcases h.inter hi hj with ⟨k, hk, hk'⟩,
                     exact ⟨_, ⟨k, hk, rfl⟩, hk'⟩ } }

variables {p : ι → Prop} {s : ι → set α} (h : is_basis p s)

lemma mem_filter_basis_iff {U : set α} : U ∈ h.filter_basis ↔ ∃ i, p i ∧ s i = U :=
iff.rfl
end is_basis
end filter

namespace filter_basis

/-- The filter associated to a filter basis. -/
protected def filter (B : filter_basis α) : filter α :=
{ sets := {s | ∃ t ∈ B, t ⊆ s},
  univ_sets := let ⟨s, s_in⟩ := B.nonempty in ⟨s, s_in, s.subset_univ⟩,
  sets_of_superset := λ x y ⟨s, s_in, h⟩ hxy, ⟨s, s_in, set.subset.trans h hxy⟩,
  inter_sets := λ x y ⟨s, s_in, hs⟩ ⟨t, t_in, ht⟩,
                let ⟨u, u_in, u_sub⟩ := B.inter_sets s_in t_in in
                ⟨u, u_in, set.subset.trans u_sub $ set.inter_subset_inter hs ht⟩ }

lemma mem_filter_iff (B : filter_basis α) {U : set α} : U ∈ B.filter ↔ ∃ s ∈ B, s ⊆ U :=
iff.rfl

lemma mem_filter_of_mem (B : filter_basis α) {U : set α} : U ∈ B → U ∈ B.filter:=
λ U_in, ⟨U, U_in, subset.refl _⟩

lemma eq_infi_principal (B : filter_basis α) : B.filter = ⨅ s : B.sets, 𝓟 s :=
begin
  have : directed (≥) (λ (s : B.sets), 𝓟 (s : set α)),
  { rintros ⟨U, U_in⟩ ⟨V, V_in⟩,
    rcases B.inter_sets U_in V_in with ⟨W, W_in, W_sub⟩,
    use [W, W_in],
    simp only [ge_iff_le, le_principal_iff, mem_principal, subtype.coe_mk],
    exact subset_inter_iff.mp W_sub },
  ext U,
  simp [mem_filter_iff, mem_infi_of_directed this]
end

protected lemma generate (B : filter_basis α) : generate B.sets = B.filter :=
begin
  apply le_antisymm,
  { intros U U_in,
    rcases B.mem_filter_iff.mp U_in with ⟨V, V_in, h⟩,
    exact generate_sets.superset (generate_sets.basic V_in) h },
  { rw sets_iff_generate,
    apply mem_filter_of_mem }
end
end filter_basis

namespace filter
namespace is_basis
variables {p : ι → Prop} {s : ι → set α}

/-- Constructs a filter from an indexed family of sets satisfying `is_basis`. -/
protected def filter (h : is_basis p s) : filter α := h.filter_basis.filter

protected lemma mem_filter_iff (h : is_basis p s) {U : set α} :
  U ∈ h.filter ↔ ∃ i, p i ∧ s i ⊆ U :=
begin
  erw [h.filter_basis.mem_filter_iff],
  simp only [mem_filter_basis_iff h, exists_prop],
  split,
  { rintros ⟨_, ⟨i, pi, rfl⟩, h⟩,
    tauto },
  { tauto }
end

lemma filter_eq_generate (h : is_basis p s) : h.filter = generate {U | ∃ i, p i ∧ s i = U} :=
by erw h.filter_basis.generate ; refl
end is_basis

/-- We say that a filter `l` has a basis `s : ι → set α` bounded by `p : ι → Prop`,
if `t ∈ l` if and only if `t` includes `s i` for some `i` such that `p i`. -/
protected structure has_basis (l : filter α) (p : ι → Prop) (s : ι → set α) : Prop :=
(mem_iff' : ∀ (t : set α), t ∈ l ↔ ∃ i (hi : p i), s i ⊆ t)

section same_type

variables {l l' : filter α} {p : ι → Prop} {s : ι → set α} {t : set α} {i : ι}
  {p' : ι' → Prop} {s' : ι' → set α} {i' : ι'}

lemma has_basis_generate (s : set (set α)) :
  (generate s).has_basis (λ t, set.finite t ∧ t ⊆ s) (λ t, ⋂₀ t) :=
⟨λ U, by simp only [mem_generate_iff, exists_prop, and.assoc, and.left_comm]⟩

/-- The smallest filter basis containing a given collection of sets. -/
def filter_basis.of_sets (s : set (set α)) : filter_basis α :=
{ sets := sInter '' { t | set.finite t ∧ t ⊆ s},
  nonempty := ⟨univ, ∅, ⟨⟨finite_empty, empty_subset s⟩, sInter_empty⟩⟩,
  inter_sets := begin
    rintros _ _ ⟨a, ⟨fina, suba⟩, rfl⟩ ⟨b, ⟨finb, subb⟩, rfl⟩,
    exact ⟨⋂₀ (a ∪ b), mem_image_of_mem _ ⟨fina.union finb, union_subset suba subb⟩,
           by rw sInter_union⟩,
  end }

/-- Definition of `has_basis` unfolded with implicit set argument. -/
lemma has_basis.mem_iff (hl : l.has_basis p s) : t ∈ l ↔ ∃ i (hi : p i), s i ⊆ t :=
hl.mem_iff' t

lemma has_basis.eq_of_same_basis (hl : l.has_basis p s) (hl' : l'.has_basis p s) : l = l' :=
begin
  ext t,
  rw [hl.mem_iff, hl'.mem_iff]
end

lemma has_basis_iff : l.has_basis p s ↔ ∀ t, t ∈ l ↔ ∃ i (hi : p i), s i ⊆ t :=
⟨λ ⟨h⟩, h, λ h, ⟨h⟩⟩

lemma has_basis.ex_mem (h : l.has_basis p s) : ∃ i, p i :=
let ⟨i, pi, h⟩ := h.mem_iff.mp univ_mem in ⟨i, pi⟩

protected lemma has_basis.nonempty (h : l.has_basis p s) : nonempty ι :=
nonempty_of_exists h.ex_mem

protected lemma is_basis.has_basis (h : is_basis p s) : has_basis h.filter p s :=
⟨λ t, by simp only [h.mem_filter_iff, exists_prop]⟩

lemma has_basis.mem_of_superset (hl : l.has_basis p s) (hi : p i) (ht : s i ⊆ t) : t ∈ l :=
(hl.mem_iff).2 ⟨i, hi, ht⟩

lemma has_basis.mem_of_mem (hl : l.has_basis p s) (hi : p i) : s i ∈ l :=
hl.mem_of_superset hi $ subset.refl _

/-- Index of a basis set such that `s i ⊆ t` as an element of `subtype p`. -/
noncomputable def has_basis.index (h : l.has_basis p s) (t : set α) (ht : t ∈ l) :
  {i : ι // p i} :=
⟨(h.mem_iff.1 ht).some, (h.mem_iff.1 ht).some_spec.fst⟩

lemma has_basis.property_index (h : l.has_basis p s) (ht : t ∈ l) : p (h.index t ht) :=
(h.index t ht).2

lemma has_basis.set_index_mem (h : l.has_basis p s) (ht : t ∈ l) : s (h.index t ht) ∈ l :=
h.mem_of_mem $ h.property_index _

lemma has_basis.set_index_subset (h : l.has_basis p s) (ht : t ∈ l) : s (h.index t ht) ⊆ t :=
(h.mem_iff.1 ht).some_spec.snd

lemma has_basis.is_basis (h : l.has_basis p s) : is_basis p s :=
{ nonempty := let ⟨i, hi, H⟩ := h.mem_iff.mp univ_mem in ⟨i, hi⟩,
  inter := λ i j hi hj, by simpa [h.mem_iff]
    using l.inter_sets (h.mem_of_mem hi) (h.mem_of_mem hj) }

lemma has_basis.filter_eq (h : l.has_basis p s) : h.is_basis.filter = l :=
by { ext U, simp [h.mem_iff, is_basis.mem_filter_iff] }

lemma has_basis.eq_generate (h : l.has_basis p s) : l = generate { U | ∃ i, p i ∧ s i = U } :=
by rw [← h.is_basis.filter_eq_generate, h.filter_eq]

lemma generate_eq_generate_inter (s : set (set α)) :
  generate s = generate (sInter '' { t | set.finite t ∧ t ⊆ s}) :=
by erw [(filter_basis.of_sets s).generate, ← (has_basis_generate s).filter_eq] ; refl

lemma of_sets_filter_eq_generate (s : set (set α)) : (filter_basis.of_sets s).filter = generate s :=
by rw [← (filter_basis.of_sets s).generate, generate_eq_generate_inter s] ; refl

protected lemma _root_.filter_basis.has_basis {α : Type*} (B : filter_basis α) :
  has_basis (B.filter) (λ s : set α, s ∈ B) id :=
⟨λ t, B.mem_filter_iff⟩

lemma has_basis.to_has_basis' (hl : l.has_basis p s) (h : ∀ i, p i → ∃ i', p' i' ∧ s' i' ⊆ s i)
  (h' : ∀ i', p' i' → s' i' ∈ l) : l.has_basis p' s' :=
begin
  refine ⟨λ t, ⟨λ ht, _, λ ⟨i', hi', ht⟩, mem_of_superset (h' i' hi') ht⟩⟩,
  rcases hl.mem_iff.1 ht with ⟨i, hi, ht⟩,
  rcases h i hi with ⟨i', hi', hs's⟩,
  exact ⟨i', hi', subset.trans hs's ht⟩
end

lemma has_basis.to_has_basis (hl : l.has_basis p s) (h : ∀ i, p i → ∃ i', p' i' ∧ s' i' ⊆ s i)
  (h' : ∀ i', p' i' → ∃ i, p i ∧ s i ⊆ s' i') : l.has_basis p' s' :=
hl.to_has_basis' h $ λ i' hi', let ⟨i, hi, hss'⟩ := h' i' hi' in hl.mem_iff.2 ⟨i, hi, hss'⟩

lemma has_basis.to_subset (hl : l.has_basis p s) {t : ι → set α} (h : ∀ i, p i → t i ⊆ s i)
  (ht : ∀ i, p i → t i ∈ l) : l.has_basis p t :=
hl.to_has_basis' (λ i hi, ⟨i, hi, h i hi⟩) ht

lemma has_basis.eventually_iff (hl : l.has_basis p s) {q : α → Prop} :
  (∀ᶠ x in l, q x) ↔ ∃ i, p i ∧ ∀ ⦃x⦄, x ∈ s i → q x :=
by simpa using hl.mem_iff

lemma has_basis.frequently_iff (hl : l.has_basis p s) {q : α → Prop} :
  (∃ᶠ x in l, q x) ↔ ∀ i, p i → ∃ x ∈ s i, q x :=
by simp [filter.frequently, hl.eventually_iff]

lemma has_basis.exists_iff (hl : l.has_basis p s) {P : set α → Prop}
  (mono : ∀ ⦃s t⦄, s ⊆ t → P t → P s) :
  (∃ s ∈ l, P s) ↔ ∃ (i) (hi : p i), P (s i) :=
⟨λ ⟨s, hs, hP⟩, let ⟨i, hi, his⟩ := hl.mem_iff.1 hs in ⟨i, hi, mono his hP⟩,
  λ ⟨i, hi, hP⟩, ⟨s i, hl.mem_of_mem hi, hP⟩⟩

lemma has_basis.forall_iff (hl : l.has_basis p s) {P : set α → Prop}
  (mono : ∀ ⦃s t⦄, s ⊆ t → P s → P t) :
  (∀ s ∈ l, P s) ↔ ∀ i, p i → P (s i) :=
⟨λ H i hi, H (s i) $ hl.mem_of_mem hi,
  λ H s hs, let ⟨i, hi, his⟩ := hl.mem_iff.1 hs in mono his (H i hi)⟩

lemma has_basis.ne_bot_iff (hl : l.has_basis p s) :
  ne_bot l ↔ (∀ {i}, p i → (s i).nonempty) :=
forall_mem_nonempty_iff_ne_bot.symm.trans $ hl.forall_iff $ λ _ _, nonempty.mono

lemma has_basis.eq_bot_iff (hl : l.has_basis p s) :
  l = ⊥ ↔ ∃ i, p i ∧ s i = ∅ :=
not_iff_not.1 $ ne_bot_iff.symm.trans $ hl.ne_bot_iff.trans $
by simp only [not_exists, not_and, nonempty_iff_ne_empty]

lemma generate_ne_bot_iff {s : set (set α)} :
  ne_bot (generate s) ↔ ∀ t ⊆ s, t.finite → (⋂₀ t).nonempty :=
(has_basis_generate s).ne_bot_iff.trans $ by simp only [← and_imp, and_comm]

lemma basis_sets (l : filter α) : l.has_basis (λ s : set α, s ∈ l) id :=
⟨λ t, exists_mem_subset_iff.symm⟩

lemma as_basis_filter (f : filter α) : f.as_basis.filter = f :=
by ext t; exact exists_mem_subset_iff

lemma has_basis_self {l : filter α} {P : set α → Prop} :
  has_basis l (λ s, s ∈ l ∧ P s) id ↔ ∀ t ∈ l, ∃ r ∈ l, P r ∧ r ⊆ t :=
begin
  simp only [has_basis_iff, exists_prop, id, and_assoc],
  exact forall_congr (λ s, ⟨λ h, h.1, λ h, ⟨h, λ ⟨t, hl, hP, hts⟩, mem_of_superset hl hts⟩⟩)
end

lemma has_basis.comp_surjective (h : l.has_basis p s) {g : ι' → ι} (hg : function.surjective g) :
  l.has_basis (p ∘ g) (s ∘ g) :=
⟨λ t, h.mem_iff.trans hg.exists⟩

lemma has_basis.comp_equiv (h : l.has_basis p s) (e : ι' ≃ ι) : l.has_basis (p ∘ e) (s ∘ e) :=
h.comp_surjective e.surjective

/-- If `{s i | p i}` is a basis of a filter `l` and each `s i` includes `s j` such that
`p j ∧ q j`, then `{s j | p j ∧ q j}` is a basis of `l`. -/
lemma has_basis.restrict (h : l.has_basis p s) {q : ι → Prop}
  (hq : ∀ i, p i → ∃ j, p j ∧ q j ∧ s j ⊆ s i) :
  l.has_basis (λ i, p i ∧ q i) s :=
begin
  refine ⟨λ t, ⟨λ ht, _, λ ⟨i, hpi, hti⟩, h.mem_iff.2 ⟨i, hpi.1, hti⟩⟩⟩,
  rcases h.mem_iff.1 ht with ⟨i, hpi, hti⟩,
  rcases hq i hpi with ⟨j, hpj, hqj, hji⟩,
  exact ⟨j, ⟨hpj, hqj⟩, subset.trans hji hti⟩
end

/-- If `{s i | p i}` is a basis of a filter `l` and `V ∈ l`, then `{s i | p i ∧ s i ⊆ V}`
is a basis of `l`. -/
lemma has_basis.restrict_subset (h : l.has_basis p s) {V : set α} (hV : V ∈ l) :
  l.has_basis (λ i, p i ∧ s i ⊆ V) s :=
h.restrict $ λ i hi, (h.mem_iff.1 (inter_mem hV (h.mem_of_mem hi))).imp $
  λ j hj, ⟨hj.fst, subset_inter_iff.1 hj.snd⟩

lemma has_basis.has_basis_self_subset {p : set α → Prop} (h : l.has_basis (λ s, s ∈ l ∧ p s) id)
  {V : set α} (hV : V ∈ l) : l.has_basis (λ s, s ∈ l ∧ p s ∧ s ⊆ V) id :=
by simpa only [and_assoc] using h.restrict_subset hV

theorem has_basis.ge_iff (hl' : l'.has_basis p' s')  : l ≤ l' ↔ ∀ i', p' i' → s' i' ∈ l :=
⟨λ h i' hi', h $ hl'.mem_of_mem hi',
  λ h s hs, let ⟨i', hi', hs⟩ := hl'.mem_iff.1 hs in mem_of_superset (h _ hi') hs⟩

theorem has_basis.le_iff (hl : l.has_basis p s) : l ≤ l' ↔ ∀ t ∈ l', ∃ i (hi : p i), s i ⊆ t :=
by simp only [le_def, hl.mem_iff]

theorem has_basis.le_basis_iff (hl : l.has_basis p s) (hl' : l'.has_basis p' s') :
  l ≤ l' ↔ ∀ i', p' i' → ∃ i (hi : p i), s i ⊆ s' i' :=
by simp only [hl'.ge_iff, hl.mem_iff]

lemma has_basis.ext (hl : l.has_basis p s) (hl' : l'.has_basis p' s')
  (h : ∀ i, p i → ∃ i', p' i' ∧ s' i' ⊆ s i)
  (h' : ∀ i', p' i' → ∃ i, p i ∧ s i ⊆ s' i') : l = l' :=
begin
  apply le_antisymm,
  { rw hl.le_basis_iff hl',
    simpa using h' },
  { rw hl'.le_basis_iff hl,
    simpa using h },
end

lemma has_basis.inf' (hl : l.has_basis p s) (hl' : l'.has_basis p' s') :
  (l ⊓ l').has_basis (λ i : pprod ι ι', p i.1 ∧ p' i.2) (λ i, s i.1 ∩ s' i.2) :=
⟨begin
  intro t,
  split,
  { simp only [mem_inf_iff, exists_prop, hl.mem_iff, hl'.mem_iff],
    rintros ⟨t, ⟨i, hi, ht⟩, t', ⟨i', hi', ht'⟩, rfl⟩,
    use [⟨i, i'⟩, ⟨hi, hi'⟩, inter_subset_inter ht ht'] },
  { rintros ⟨⟨i, i'⟩, ⟨hi, hi'⟩, H⟩,
    exact mem_inf_of_inter (hl.mem_of_mem hi) (hl'.mem_of_mem hi') H }
end⟩

lemma has_basis.inf {ι ι' : Type*} {p : ι → Prop} {s : ι → set α} {p' : ι' → Prop}
  {s' : ι' → set α} (hl : l.has_basis p s) (hl' : l'.has_basis p' s') :
  (l ⊓ l').has_basis (λ i : ι × ι', p i.1 ∧ p' i.2) (λ i, s i.1 ∩ s' i.2) :=
(hl.inf' hl').to_has_basis (λ i hi, ⟨⟨i.1, i.2⟩, hi, subset.rfl⟩)
  (λ i hi, ⟨⟨i.1, i.2⟩, hi, subset.rfl⟩)

lemma has_basis_infi' {ι : Type*} {ι' : ι → Type*} {l : ι → filter α}
  {p : Π i, ι' i → Prop} {s : Π i, ι' i → set α} (hl : ∀ i, (l i).has_basis (p i) (s i)) :
  (⨅ i, l i).has_basis (λ If : set ι × Π i, ι' i, If.1.finite ∧ ∀ i ∈ If.1, p i (If.2 i))
    (λ If : set ι × Π i, ι' i, ⋂ i ∈ If.1, s i (If.2 i)) :=
⟨begin
  intro t,
  split,
  { simp only [mem_infi', (hl _).mem_iff],
    rintros ⟨I, hI, V, hV, -, rfl, -⟩,
    choose u hu using hV,
    exact ⟨⟨I, u⟩, ⟨hI, λ i _, (hu i).1⟩, Inter_mono (λ i, Inter_mono $ λ hi, (hu i).2)⟩ },
  { rintros ⟨⟨I, f⟩, ⟨hI₁, hI₂⟩, hsub⟩,
    refine mem_of_superset _ hsub,
    exact (bInter_mem hI₁).mpr (λ i hi, mem_infi_of_mem i $ (hl i).mem_of_mem $ hI₂ _ hi) }
end⟩

lemma has_basis_infi {ι : Type*} {ι' : ι → Type*} {l : ι → filter α}
  {p : Π i, ι' i → Prop} {s : Π i, ι' i → set α} (hl : ∀ i, (l i).has_basis (p i) (s i)) :
  (⨅ i, l i).has_basis (λ If : Σ I : set ι, Π i : I, ι' i, If.1.finite ∧ ∀ i : If.1, p i (If.2 i))
    (λ If, ⋂ i : If.1, s i (If.2 i)) :=
begin
  refine ⟨λ t, ⟨λ ht, _, _⟩⟩,
  { rcases (has_basis_infi' hl).mem_iff.mp ht with ⟨⟨I, f⟩, ⟨hI, hf⟩, hsub⟩,
    exact ⟨⟨I, λ i, f i⟩, ⟨hI, subtype.forall.mpr hf⟩,
      trans_rel_right _ (Inter_subtype _ _) hsub⟩ },
  { rintro ⟨⟨I, f⟩, ⟨hI, hf⟩, hsub⟩,
    refine mem_of_superset _ hsub,
    casesI hI.nonempty_fintype,
    exact Inter_mem.2 (λ i, mem_infi_of_mem i $ (hl i).mem_of_mem $ hf _) }
end

lemma has_basis_infi_of_directed' {ι : Type*} {ι' : ι → Sort*}
  [nonempty ι]
  {l : ι → filter α} (s : Π i, (ι' i) → set α) (p : Π i, (ι' i) → Prop)
  (hl : ∀ i, (l i).has_basis (p i) (s i)) (h : directed (≥) l) :
  (⨅ i, l i).has_basis (λ (ii' : Σ i, ι' i), p ii'.1 ii'.2) (λ ii', s ii'.1 ii'.2) :=
begin
  refine ⟨λ t, _⟩,
  rw [mem_infi_of_directed h, sigma.exists],
  exact exists_congr (λ i, (hl i).mem_iff)
end

lemma has_basis_infi_of_directed {ι : Type*} {ι' : Sort*}
  [nonempty ι]
  {l : ι → filter α} (s : ι → ι' → set α) (p : ι → ι' → Prop)
  (hl : ∀ i, (l i).has_basis (p i) (s i)) (h : directed (≥) l) :
  (⨅ i, l i).has_basis (λ (ii' : ι × ι'), p ii'.1 ii'.2) (λ ii', s ii'.1 ii'.2) :=
begin
  refine ⟨λ t, _⟩,
  rw [mem_infi_of_directed h, prod.exists],
  exact exists_congr (λ i, (hl i).mem_iff)
end

lemma has_basis_binfi_of_directed' {ι : Type*} {ι' : ι → Sort*}
  {dom : set ι} (hdom : dom.nonempty)
  {l : ι → filter α} (s : Π i, (ι' i) → set α) (p : Π i, (ι' i) → Prop)
  (hl : ∀ i ∈ dom, (l i).has_basis (p i) (s i)) (h : directed_on (l ⁻¹'o ge) dom) :
  (⨅ i ∈ dom, l i).has_basis (λ (ii' : Σ i, ι' i), ii'.1 ∈ dom ∧ p ii'.1 ii'.2)
    (λ ii', s ii'.1 ii'.2) :=
begin
  refine ⟨λ t, _⟩,
  rw [mem_binfi_of_directed h hdom, sigma.exists],
  refine exists_congr (λ i, ⟨_, _⟩),
  { rintros ⟨hi, hti⟩,
    rcases (hl i hi).mem_iff.mp hti with ⟨b, hb, hbt⟩,
    exact ⟨b, ⟨hi, hb⟩, hbt⟩ },
  { rintros ⟨b, ⟨hi, hb⟩, hibt⟩,
    exact ⟨hi, (hl i hi).mem_iff.mpr ⟨b, hb, hibt⟩⟩ }
end

lemma has_basis_binfi_of_directed {ι : Type*} {ι' : Sort*}
  {dom : set ι} (hdom : dom.nonempty)
  {l : ι → filter α} (s : ι → ι' → set α) (p : ι → ι' → Prop)
  (hl : ∀ i ∈ dom, (l i).has_basis (p i) (s i)) (h : directed_on (l ⁻¹'o ge) dom) :
  (⨅ i ∈ dom, l i).has_basis (λ (ii' : ι × ι'), ii'.1 ∈ dom ∧ p ii'.1 ii'.2)
    (λ ii', s ii'.1 ii'.2) :=
begin
  refine ⟨λ t, _⟩,
  rw [mem_binfi_of_directed h hdom, prod.exists],
  refine exists_congr (λ i, ⟨_, _⟩),
  { rintros ⟨hi, hti⟩,
    rcases (hl i hi).mem_iff.mp hti with ⟨b, hb, hbt⟩,
    exact ⟨b, ⟨hi, hb⟩, hbt⟩ },
  { rintros ⟨b, ⟨hi, hb⟩, hibt⟩,
    exact ⟨hi, (hl i hi).mem_iff.mpr ⟨b, hb, hibt⟩⟩ }
end

lemma has_basis_principal (t : set α) : (𝓟 t).has_basis (λ i : unit, true) (λ i, t) :=
⟨λ U, by simp⟩

lemma has_basis_pure (x : α) : (pure x : filter α).has_basis (λ i : unit, true) (λ i, {x}) :=
by simp only [← principal_singleton, has_basis_principal]

lemma has_basis.sup' (hl : l.has_basis p s) (hl' : l'.has_basis p' s') :
  (l ⊔ l').has_basis (λ i : pprod ι ι', p i.1 ∧ p' i.2) (λ i, s i.1 ∪ s' i.2) :=
⟨begin
  intros t,
  simp only [mem_sup, hl.mem_iff, hl'.mem_iff, pprod.exists, union_subset_iff, exists_prop,
    and_assoc, exists_and_distrib_left],
  simp only [← and_assoc, exists_and_distrib_right, and_comm]
end⟩

lemma has_basis.sup {ι ι' : Type*} {p : ι → Prop} {s : ι → set α} {p' : ι' → Prop}
  {s' : ι' → set α} (hl : l.has_basis p s) (hl' : l'.has_basis p' s') :
  (l ⊔ l').has_basis (λ i : ι × ι', p i.1 ∧ p' i.2) (λ i, s i.1 ∪ s' i.2) :=
(hl.sup' hl').to_has_basis (λ i hi, ⟨⟨i.1, i.2⟩, hi, subset.rfl⟩)
  (λ i hi, ⟨⟨i.1, i.2⟩, hi, subset.rfl⟩)

lemma has_basis_supr {ι : Sort*} {ι' : ι → Type*} {l : ι → filter α}
  {p : Π i, ι' i → Prop} {s : Π i, ι' i → set α} (hl : ∀ i, (l i).has_basis (p i) (s i)) :
  (⨆ i, l i).has_basis (λ f : Π i, ι' i, ∀ i, p i (f i)) (λ f : Π i, ι' i, ⋃ i, s i (f i)) :=
has_basis_iff.mpr $ λ t, by simp only [has_basis_iff, (hl _).mem_iff, classical.skolem,
  forall_and_distrib, Union_subset_iff, mem_supr]

lemma has_basis.sup_principal (hl : l.has_basis p s) (t : set α) :
  (l ⊔ 𝓟 t).has_basis p (λ i, s i ∪ t) :=
⟨λ u, by simp only [(hl.sup' (has_basis_principal t)).mem_iff, pprod.exists, exists_prop, and_true,
  unique.exists_iff]⟩

lemma has_basis.sup_pure (hl : l.has_basis p s) (x : α) :
  (l ⊔ pure x).has_basis p (λ i, s i ∪ {x}) :=
by simp only [← principal_singleton, hl.sup_principal]

lemma has_basis.inf_principal (hl : l.has_basis p s) (s' : set α) :
  (l ⊓ 𝓟 s').has_basis p (λ i, s i ∩ s') :=
⟨λ t, by simp only [mem_inf_principal, hl.mem_iff, subset_def, mem_set_of_eq,
  mem_inter_iff, and_imp]⟩

lemma has_basis.principal_inf (hl : l.has_basis p s) (s' : set α) :
  (𝓟 s' ⊓ l).has_basis p (λ i, s' ∩ s i) :=
by simpa only [inf_comm, inter_comm] using hl.inf_principal s'

lemma has_basis.inf_basis_ne_bot_iff (hl : l.has_basis p s) (hl' : l'.has_basis p' s') :
  ne_bot (l ⊓ l') ↔ ∀ ⦃i⦄ (hi : p i) ⦃i'⦄ (hi' : p' i'), (s i ∩ s' i').nonempty :=
(hl.inf' hl').ne_bot_iff.trans $ by simp [@forall_swap _ ι']

lemma has_basis.inf_ne_bot_iff (hl : l.has_basis p s) :
  ne_bot (l ⊓ l') ↔ ∀ ⦃i⦄ (hi : p i) ⦃s'⦄ (hs' : s' ∈ l'), (s i ∩ s').nonempty :=
hl.inf_basis_ne_bot_iff l'.basis_sets

lemma has_basis.inf_principal_ne_bot_iff (hl : l.has_basis p s) {t : set α} :
  ne_bot (l ⊓ 𝓟 t) ↔ ∀ ⦃i⦄ (hi : p i), (s i ∩ t).nonempty :=
(hl.inf_principal t).ne_bot_iff

lemma has_basis.disjoint_iff (hl : l.has_basis p s) (hl' : l'.has_basis p' s') :
  disjoint l l' ↔ ∃ i (hi : p i) i' (hi' : p' i'), disjoint (s i) (s' i') :=
not_iff_not.mp $ by simp only [disjoint_iff, ← ne.def, ← ne_bot_iff, hl.inf_basis_ne_bot_iff hl',
  not_exists, bot_eq_empty, ←nonempty_iff_ne_empty, inf_eq_inter]

lemma _root_.disjoint.exists_mem_filter_basis (h : disjoint l l') (hl : l.has_basis p s)
  (hl' : l'.has_basis p' s') :
  ∃ i (hi : p i) i' (hi' : p' i'), disjoint (s i) (s' i') :=
(hl.disjoint_iff hl').1 h

lemma _root_.pairwise.exists_mem_filter_basis_of_disjoint {I : Type*} [finite I]
  {l : I → filter α} {ι : I → Sort*} {p : Π i, ι i → Prop} {s : Π i, ι i → set α}
  (hd : pairwise (disjoint on l)) (h : ∀ i, (l i).has_basis (p i) (s i)) :
  ∃ ind : Π i, ι i, (∀ i, p i (ind i)) ∧ pairwise (disjoint on λ i, s i (ind i)) :=
begin
  rcases hd.exists_mem_filter_of_disjoint with ⟨t, htl, hd⟩,
  choose ind hp ht using λ i, (h i).mem_iff.1 (htl i),
  exact ⟨ind, hp, hd.mono $ λ i j hij, hij.mono (ht _) (ht _)⟩
end

lemma _root_.set.pairwise_disjoint.exists_mem_filter_basis {I : Type*} {l : I → filter α}
  {ι : I → Sort*} {p : Π i, ι i → Prop} {s : Π i, ι i → set α} {S : set I}
  (hd : S.pairwise_disjoint l) (hS : S.finite) (h : ∀ i, (l i).has_basis (p i) (s i)) :
  ∃ ind : Π i, ι i, (∀ i, p i (ind i)) ∧ S.pairwise_disjoint (λ i, s i (ind i)) :=
begin
  rcases hd.exists_mem_filter hS with ⟨t, htl, hd⟩,
  choose ind hp ht using λ i, (h i).mem_iff.1 (htl i),
  exact ⟨ind, hp, hd.mono ht⟩
end

lemma inf_ne_bot_iff :
  ne_bot (l ⊓ l') ↔ ∀ ⦃s : set α⦄ (hs : s ∈ l) ⦃s'⦄ (hs' : s' ∈ l'), (s ∩ s').nonempty :=
l.basis_sets.inf_ne_bot_iff

lemma inf_principal_ne_bot_iff {s : set α} :
  ne_bot (l ⊓ 𝓟 s) ↔ ∀ U ∈ l, (U ∩ s).nonempty :=
l.basis_sets.inf_principal_ne_bot_iff

lemma mem_iff_inf_principal_compl {f : filter α} {s : set α} :
  s ∈ f ↔ f ⊓ 𝓟 sᶜ = ⊥ :=
begin
  refine not_iff_not.1 ((inf_principal_ne_bot_iff.trans _).symm.trans ne_bot_iff),
  exact ⟨λ h hs, by simpa [not_nonempty_empty] using h s hs,
    λ hs t ht, inter_compl_nonempty_iff.2 $ λ hts, hs $ mem_of_superset ht hts⟩,
end

lemma not_mem_iff_inf_principal_compl {f : filter α} {s : set α} :
  s ∉ f ↔ ne_bot (f ⊓ 𝓟 sᶜ) :=
(not_congr mem_iff_inf_principal_compl).trans ne_bot_iff.symm

@[simp] lemma disjoint_principal_right {f : filter α} {s : set α} :
  disjoint f (𝓟 s) ↔ sᶜ ∈ f :=
by rw [mem_iff_inf_principal_compl, compl_compl, disjoint_iff]

@[simp] lemma disjoint_principal_left {f : filter α} {s : set α} :
  disjoint (𝓟 s) f ↔ sᶜ ∈ f :=
by rw [disjoint.comm, disjoint_principal_right]

@[simp] lemma disjoint_principal_principal {s t : set α} :
  disjoint (𝓟 s) (𝓟 t) ↔ disjoint s t :=
by simp [←subset_compl_iff_disjoint_left]

alias disjoint_principal_principal ↔ _ _root_.disjoint.filter_principal

@[simp] lemma disjoint_pure_pure {x y : α} :
  disjoint (pure x : filter α) (pure y) ↔ x ≠ y :=
by simp only [← principal_singleton, disjoint_principal_principal, disjoint_singleton]

@[simp] lemma compl_diagonal_mem_prod {l₁ l₂ : filter α} :
  (diagonal α)ᶜ ∈ l₁ ×ᶠ l₂ ↔ disjoint l₁ l₂ :=
by simp only [mem_prod_iff, filter.disjoint_iff, prod_subset_compl_diagonal_iff_disjoint]

lemma has_basis.disjoint_iff_left (h : l.has_basis p s) :
  disjoint l l' ↔ ∃ i (hi : p i), (s i)ᶜ ∈ l' :=
by simp only [h.disjoint_iff l'.basis_sets, exists_prop, id, ← disjoint_principal_left,
  (has_basis_principal _).disjoint_iff l'.basis_sets, unique.exists_iff]

lemma has_basis.disjoint_iff_right (h : l.has_basis p s) :
  disjoint l' l ↔ ∃ i (hi : p i), (s i)ᶜ ∈ l' :=
disjoint.comm.trans h.disjoint_iff_left

lemma le_iff_forall_inf_principal_compl {f g : filter α} :
  f ≤ g ↔ ∀ V ∈ g, f ⊓ 𝓟 Vᶜ = ⊥ :=
forall₂_congr $ λ _ _, mem_iff_inf_principal_compl

lemma inf_ne_bot_iff_frequently_left {f g : filter α} :
  ne_bot (f ⊓ g) ↔ ∀ {p : α → Prop}, (∀ᶠ x in f, p x) → ∃ᶠ x in g, p x :=
by simpa only [inf_ne_bot_iff, frequently_iff, exists_prop, and_comm]

lemma inf_ne_bot_iff_frequently_right {f g : filter α} :
  ne_bot (f ⊓ g) ↔ ∀ {p : α → Prop}, (∀ᶠ x in g, p x) → ∃ᶠ x in f, p x :=
by { rw inf_comm, exact inf_ne_bot_iff_frequently_left }

lemma has_basis.eq_binfi (h : l.has_basis p s) :
  l = ⨅ i (_ : p i), 𝓟 (s i) :=
eq_binfi_of_mem_iff_exists_mem $ λ t, by simp only [h.mem_iff, mem_principal]

lemma has_basis.eq_infi (h : l.has_basis (λ _, true) s) :
  l = ⨅ i, 𝓟 (s i) :=
by simpa only [infi_true] using h.eq_binfi

lemma has_basis_infi_principal {s : ι → set α} (h : directed (≥) s) [nonempty ι] :
  (⨅ i, 𝓟 (s i)).has_basis (λ _, true) s :=
⟨begin
  refine λ t, (mem_infi_of_directed (h.mono_comp _ _) t).trans $
    by simp only [exists_prop, true_and, mem_principal],
  exact λ _ _, principal_mono.2
end⟩

/-- If `s : ι → set α` is an indexed family of sets, then finite intersections of `s i` form a basis
of `⨅ i, 𝓟 (s i)`.  -/
lemma has_basis_infi_principal_finite {ι : Type*} (s : ι → set α) :
  (⨅ i, 𝓟 (s i)).has_basis (λ t : set ι, t.finite) (λ t, ⋂ i ∈ t, s i) :=
begin
  refine ⟨λ U, (mem_infi_finite _).trans _⟩,
  simp only [infi_principal_finset, mem_Union, mem_principal, exists_prop,
    exists_finite_iff_finset, finset.set_bInter_coe]
end

lemma has_basis_binfi_principal {s : β → set α} {S : set β} (h : directed_on (s ⁻¹'o (≥)) S)
  (ne : S.nonempty) :
  (⨅ i ∈ S, 𝓟 (s i)).has_basis (λ i, i ∈ S) s :=
⟨begin
  refine λ t, (mem_binfi_of_directed _ ne).trans $ by simp only [mem_principal],
  rw [directed_on_iff_directed, ← directed_comp, (∘)] at h ⊢,
  apply h.mono_comp _ _,
  exact λ _ _, principal_mono.2
end⟩

lemma has_basis_binfi_principal' {ι : Type*} {p : ι → Prop} {s : ι → set α}
  (h : ∀ i, p i → ∀ j, p j → ∃ k (h : p k), s k ⊆ s i ∧ s k ⊆ s j) (ne : ∃ i, p i) :
  (⨅ i (h : p i), 𝓟 (s i)).has_basis p s :=
filter.has_basis_binfi_principal h ne

lemma has_basis.map (f : α → β) (hl : l.has_basis p s) :
  (l.map f).has_basis p (λ i, f '' (s i)) :=
⟨λ t, by simp only [mem_map, image_subset_iff, hl.mem_iff, preimage]⟩

lemma has_basis.comap (f : β → α) (hl : l.has_basis p s) :
  (l.comap f).has_basis p (λ i, f ⁻¹' (s i)) :=
⟨begin
  intro t,
  simp only [mem_comap, exists_prop, hl.mem_iff],
  split,
  { rintros ⟨t', ⟨i, hi, ht'⟩, H⟩,
    exact ⟨i, hi, subset.trans (preimage_mono ht') H⟩ },
  { rintros ⟨i, hi, H⟩,
    exact ⟨s i, ⟨i, hi, subset.refl _⟩, H⟩ }
end⟩

lemma comap_has_basis (f : α → β) (l : filter β) :
  has_basis (comap f l) (λ s : set β, s ∈ l) (λ s, f ⁻¹' s) :=
⟨λ t, mem_comap⟩

protected lemma has_basis.binfi_mem [complete_lattice β] {f : set α → β} (h : has_basis l p s)
  (hf : monotone f) :
  (⨅ t ∈ l, f t) = ⨅ i (hi : p i), f (s i) :=
le_antisymm (le_infi₂ $ λ i hi, infi₂_le (s i) (h.mem_of_mem hi)) $
  le_infi₂ $ λ t ht, let ⟨i, hpi, hi⟩ := h.mem_iff.1 ht in infi₂_le_of_le i hpi (hf hi)

protected lemma has_basis.bInter_mem {f : set α → set β} (h : has_basis l p s) (hf : monotone f) :
  (⋂ t ∈ l, f t) = ⋂ i (hi : p i), f (s i) :=
h.binfi_mem hf

lemma has_basis.sInter_sets (h : has_basis l p s) : ⋂₀ l.sets = ⋂ i (hi : p i), s i :=
by { rw [sInter_eq_bInter], exact h.bInter_mem monotone_id }

variables {ι'' : Type*} [preorder ι''] (l) (s'' : ι'' → set α)

/-- `is_antitone_basis s` means the image of `s` is a filter basis such that `s` is decreasing. -/
@[protect_proj] structure is_antitone_basis extends is_basis (λ _, true) s'' : Prop :=
(antitone : antitone s'')

/-- We say that a filter `l` has an antitone basis `s : ι → set α`, if `t ∈ l` if and only if `t`
includes `s i` for some `i`, and `s` is decreasing. -/
@[protect_proj] structure has_antitone_basis (l : filter α) (s : ι'' → set α)
  extends has_basis l (λ _, true) s : Prop :=
(antitone : antitone s)

lemma has_antitone_basis.map {l : filter α} {s : ι'' → set α} {m : α → β}
  (hf : has_antitone_basis l s) :
  has_antitone_basis (map m l) (λ n, m '' s n) :=
⟨has_basis.map _ hf.to_has_basis, λ i j hij, image_subset _ $ hf.2 hij⟩

end same_type

section two_types

variables {la : filter α} {pa : ι → Prop} {sa : ι → set α}
  {lb : filter β} {pb : ι' → Prop} {sb : ι' → set β} {f : α → β}

lemma has_basis.tendsto_left_iff (hla : la.has_basis pa sa) :
  tendsto f la lb ↔ ∀ t ∈ lb, ∃ i (hi : pa i), maps_to f (sa i) t :=
by { simp only [tendsto, (hla.map f).le_iff, image_subset_iff], refl }

lemma has_basis.tendsto_right_iff (hlb : lb.has_basis pb sb) :
  tendsto f la lb ↔ ∀ i (hi : pb i), ∀ᶠ x in la, f x ∈ sb i :=
by simpa only [tendsto, hlb.ge_iff, mem_map, filter.eventually]

lemma has_basis.tendsto_iff (hla : la.has_basis pa sa) (hlb : lb.has_basis pb sb) :
  tendsto f la lb ↔ ∀ ib (hib : pb ib), ∃ ia (hia : pa ia), ∀ x ∈ sa ia, f x ∈ sb ib :=
by simp [hlb.tendsto_right_iff, hla.eventually_iff]

lemma tendsto.basis_left (H : tendsto f la lb) (hla : la.has_basis pa sa) :
  ∀ t ∈ lb, ∃ i (hi : pa i), maps_to f (sa i) t :=
hla.tendsto_left_iff.1 H

lemma tendsto.basis_right (H : tendsto f la lb) (hlb : lb.has_basis pb sb) :
  ∀ i (hi : pb i), ∀ᶠ x in la, f x ∈ sb i :=
hlb.tendsto_right_iff.1 H

lemma tendsto.basis_both (H : tendsto f la lb) (hla : la.has_basis pa sa)
  (hlb : lb.has_basis pb sb) :
  ∀ ib (hib : pb ib), ∃ ia (hia : pa ia), ∀ x ∈ sa ia, f x ∈ sb ib :=
(hla.tendsto_iff hlb).1 H

lemma has_basis.prod_pprod (hla : la.has_basis pa sa) (hlb : lb.has_basis pb sb) :
  (la ×ᶠ lb).has_basis (λ i : pprod ι ι', pa i.1 ∧ pb i.2) (λ i, sa i.1 ×ˢ sb i.2) :=
(hla.comap prod.fst).inf' (hlb.comap prod.snd)

lemma has_basis.prod {ι ι' : Type*} {pa : ι → Prop} {sa : ι → set α} {pb : ι' → Prop}
  {sb : ι' → set β} (hla : la.has_basis pa sa) (hlb : lb.has_basis pb sb) :
  (la ×ᶠ lb).has_basis (λ i : ι × ι', pa i.1 ∧ pb i.2) (λ i, sa i.1 ×ˢ sb i.2) :=
(hla.comap prod.fst).inf (hlb.comap prod.snd)

lemma has_basis.prod_same_index {p : ι → Prop} {sb : ι → set β}
  (hla : la.has_basis p sa) (hlb : lb.has_basis p sb)
  (h_dir : ∀ {i j}, p i → p j → ∃ k, p k ∧ sa k ⊆ sa i ∧ sb k ⊆ sb j) :
  (la ×ᶠ lb).has_basis p (λ i, sa i ×ˢ sb i) :=
begin
  simp only [has_basis_iff, (hla.prod_pprod hlb).mem_iff],
  refine λ t, ⟨_, _⟩,
  { rintros ⟨⟨i, j⟩, ⟨hi, hj⟩, hsub : sa i ×ˢ sb j ⊆ t⟩,
    rcases h_dir hi hj with ⟨k, hk, ki, kj⟩,
    exact ⟨k, hk, (set.prod_mono ki kj).trans hsub⟩ },
  { rintro ⟨i, hi, h⟩,
    exact ⟨⟨i, i⟩, ⟨hi, hi⟩, h⟩ },
end

lemma has_basis.prod_same_index_mono {ι : Type*} [linear_order ι]
  {p : ι → Prop} {sa : ι → set α} {sb : ι → set β}
  (hla : la.has_basis p sa) (hlb : lb.has_basis p sb)
  (hsa : monotone_on sa {i | p i}) (hsb : monotone_on sb {i | p i}) :
  (la ×ᶠ lb).has_basis p (λ i, sa i ×ˢ sb i) :=
hla.prod_same_index hlb $ λ i j hi hj,
  have p (min i j), from min_rec' _ hi hj,
  ⟨min i j, this, hsa this hi $ min_le_left _ _, hsb this hj $ min_le_right _ _⟩

lemma has_basis.prod_same_index_anti {ι : Type*} [linear_order ι]
  {p : ι → Prop} {sa : ι → set α} {sb : ι → set β}
  (hla : la.has_basis p sa) (hlb : lb.has_basis p sb)
  (hsa : antitone_on sa {i | p i}) (hsb : antitone_on sb {i | p i}) :
  (la ×ᶠ lb).has_basis p (λ i, sa i ×ˢ sb i) :=
@has_basis.prod_same_index_mono _ _ _ _ ιᵒᵈ _ _ _ _  hla hlb hsa.dual_left hsb.dual_left

lemma has_basis.prod_self (hl : la.has_basis pa sa) :
  (la ×ᶠ la).has_basis pa (λ i, sa i ×ˢ sa i) :=
hl.prod_same_index hl $ λ i j hi hj, by simpa only [exists_prop, subset_inter_iff]
  using hl.mem_iff.1 (inter_mem (hl.mem_of_mem hi) (hl.mem_of_mem hj))

lemma mem_prod_self_iff {s} : s ∈ la ×ᶠ la ↔ ∃ t ∈ la, t ×ˢ t ⊆ s :=
la.basis_sets.prod_self.mem_iff

lemma has_antitone_basis.prod {ι : Type*} [linear_order ι] {f : filter α} {g : filter β}
  {s : ι → set α} {t : ι → set β} (hf : has_antitone_basis f s) (hg : has_antitone_basis g t) :
  has_antitone_basis (f ×ᶠ g) (λ n, s n ×ˢ t n) :=
⟨hf.1.prod_same_index_anti hg.1 (hf.2.antitone_on _) (hg.2.antitone_on _), hf.2.set_prod hg.2⟩

lemma has_basis.coprod {ι ι' : Type*} {pa : ι → Prop} {sa : ι → set α} {pb : ι' → Prop}
  {sb : ι' → set β} (hla : la.has_basis pa sa) (hlb : lb.has_basis pb sb) :
  (la.coprod lb).has_basis (λ i : ι × ι', pa i.1 ∧ pb i.2)
    (λ i, prod.fst ⁻¹' sa i.1 ∪ prod.snd ⁻¹' sb i.2) :=
(hla.comap prod.fst).sup (hlb.comap prod.snd)

end two_types

lemma map_sigma_mk_comap {π : α → Type*} {π' : β → Type*} {f : α → β}
  (hf : function.injective f) (g : Π a, π a → π' (f a)) (a : α) (l : filter (π' (f a))) :
  map (sigma.mk a) (comap (g a) l) = comap (sigma.map f g) (map (sigma.mk (f a)) l) :=
begin
  refine (((basis_sets _).comap _).map _).eq_of_same_basis _,
  convert ((basis_sets _).map _).comap _,
  ext1 s,
  apply image_sigma_mk_preimage_sigma_map hf
end

end filter

end sort

namespace filter

variables {α β γ ι : Type*} {ι' : Sort*}

/-- `is_countably_generated f` means `f = generate s` for some countable `s`. -/
class is_countably_generated (f : filter α) : Prop :=
(out [] : ∃ s : set (set α), s.countable ∧ f = generate s)

/-- `is_countable_basis p s` means the image of `s` bounded by `p` is a countable filter basis. -/
structure is_countable_basis (p : ι → Prop) (s : ι → set α) extends is_basis p s : Prop :=
(countable : (set_of p).countable)

/-- We say that a filter `l` has a countable basis `s : ι → set α` bounded by `p : ι → Prop`,
if `t ∈ l` if and only if `t` includes `s i` for some `i` such that `p i`, and the set
defined by `p` is countable. -/
structure has_countable_basis (l : filter α) (p : ι → Prop) (s : ι → set α)
  extends has_basis l p s : Prop :=
(countable : (set_of p).countable)

/-- A countable filter basis `B` on a type `α` is a nonempty countable collection of sets of `α`
such that the intersection of two elements of this collection contains some element
of the collection. -/
structure countable_filter_basis (α : Type*) extends filter_basis α :=
(countable : sets.countable)

-- For illustration purposes, the countable filter basis defining (at_top : filter ℕ)
instance nat.inhabited_countable_filter_basis : inhabited (countable_filter_basis ℕ) :=
⟨{ countable := countable_range (λ n, Ici n),
   ..(default : filter_basis ℕ) }⟩

lemma has_countable_basis.is_countably_generated {f : filter α} {p : ι → Prop} {s : ι → set α}
  (h : f.has_countable_basis p s) :
  f.is_countably_generated :=
⟨⟨{t | ∃ i, p i ∧ s i = t}, h.countable.image s, h.to_has_basis.eq_generate⟩⟩

lemma antitone_seq_of_seq (s : ℕ → set α) :
  ∃ t : ℕ → set α, antitone t ∧ (⨅ i, 𝓟 $ s i) = ⨅ i, 𝓟 (t i) :=
begin
  use λ n, ⋂ m ≤ n, s m, split,
  { exact λ i j hij, bInter_mono (Iic_subset_Iic.2 hij) (λ n hn, subset.refl _) },
  apply le_antisymm; rw le_infi_iff; intro i,
  { rw le_principal_iff, refine (bInter_mem (finite_le_nat _)).2 (λ j hji, _),
    rw ← le_principal_iff, apply infi_le_of_le j _, exact le_rfl },
  { apply infi_le_of_le i _, rw principal_mono, intro a, simp, intro h, apply h, refl },
end

lemma countable_binfi_eq_infi_seq [complete_lattice α] {B : set ι} (Bcbl : B.countable)
  (Bne : B.nonempty) (f : ι → α) :
  ∃ (x : ℕ → ι), (⨅ t ∈ B, f t) = ⨅ i, f (x i) :=
let ⟨g, hg⟩ := Bcbl.exists_eq_range Bne in ⟨g, hg.symm ▸ infi_range⟩

lemma countable_binfi_eq_infi_seq' [complete_lattice α] {B : set ι} (Bcbl : B.countable) (f : ι → α)
  {i₀ : ι} (h : f i₀ = ⊤) :
  ∃ (x : ℕ → ι), (⨅ t ∈ B, f t) = ⨅ i, f (x i) :=
begin
  cases B.eq_empty_or_nonempty with hB Bnonempty,
  { rw [hB, infi_emptyset],
    use λ n, i₀,
    simp [h] },
  { exact countable_binfi_eq_infi_seq Bcbl Bnonempty f }
end

lemma countable_binfi_principal_eq_seq_infi {B : set (set α)} (Bcbl : B.countable) :
  ∃ (x : ℕ → set α), (⨅ t ∈ B, 𝓟 t) = ⨅ i, 𝓟 (x i) :=
countable_binfi_eq_infi_seq' Bcbl 𝓟 principal_univ

section is_countably_generated

protected lemma has_antitone_basis.mem_iff [preorder ι] {l : filter α} {s : ι → set α}
  (hs : l.has_antitone_basis s) {t : set α} : t ∈ l ↔ ∃ i, s i ⊆ t :=
hs.to_has_basis.mem_iff.trans $ by simp only [exists_prop, true_and]

protected lemma has_antitone_basis.mem [preorder ι] {l : filter α} {s : ι → set α}
  (hs : l.has_antitone_basis s) (i : ι) : s i ∈ l :=
hs.to_has_basis.mem_of_mem trivial

lemma has_antitone_basis.has_basis_ge [preorder ι] [is_directed ι (≤)] {l : filter α}
  {s : ι → set α} (hs : l.has_antitone_basis s) (i : ι) :
  l.has_basis (λ j, i ≤ j) s :=
hs.1.to_has_basis (λ j _, (exists_ge_ge i j).imp $ λ k hk, ⟨hk.1, hs.2 hk.2⟩)
  (λ j hj, ⟨j, trivial, subset.rfl⟩)

/-- If `f` is countably generated and `f.has_basis p s`, then `f` admits a decreasing basis
enumerated by natural numbers such that all sets have the form `s i`. More precisely, there is a
sequence `i n` such that `p (i n)` for all `n` and `s (i n)` is a decreasing sequence of sets which
forms a basis of `f`-/
lemma has_basis.exists_antitone_subbasis {f : filter α} [h : f.is_countably_generated]
  {p : ι' → Prop} {s : ι' → set α} (hs : f.has_basis p s) :
  ∃ x : ℕ → ι', (∀ i, p (x i)) ∧ f.has_antitone_basis (λ i, s (x i)) :=
begin
  obtain ⟨x', hx'⟩ : ∃ x : ℕ → set α, f = ⨅ i, 𝓟 (x i),
  { unfreezingI { rcases h with ⟨s, hsc, rfl⟩ },
    rw generate_eq_binfi,
    exact countable_binfi_principal_eq_seq_infi hsc },
  have : ∀ i, x' i ∈ f := λ i, hx'.symm ▸ (infi_le (λ i, 𝓟 (x' i)) i) (mem_principal_self _),
  let x : ℕ → {i : ι' // p i} := λ n, nat.rec_on n (hs.index _ $ this 0)
    (λ n xn, (hs.index _ $ inter_mem (this $ n + 1) (hs.mem_of_mem xn.2))),
  have x_mono : antitone (λ i, s (x i)),
  { refine antitone_nat_of_succ_le (λ i, _),
    exact (hs.set_index_subset _).trans (inter_subset_right _ _) },
  have x_subset : ∀ i, s (x i) ⊆ x' i,
  { rintro (_|i),
    exacts [hs.set_index_subset _, subset.trans (hs.set_index_subset _) (inter_subset_left _ _)] },
  refine ⟨λ i, x i, λ i, (x i).2, _⟩,
  have : (⨅ i, 𝓟 (s (x i))).has_antitone_basis (λ i, s (x i)) :=
    ⟨has_basis_infi_principal (directed_of_sup x_mono), x_mono⟩,
  convert this,
  exact le_antisymm (le_infi $ λ i, le_principal_iff.2 $ by cases i; apply hs.set_index_mem)
    (hx'.symm ▸ le_infi (λ i, le_principal_iff.2 $
      this.to_has_basis.mem_iff.2 ⟨i, trivial, x_subset i⟩))
end

/-- A countably generated filter admits a basis formed by an antitone sequence of sets. -/
lemma exists_antitone_basis (f : filter α) [f.is_countably_generated] :
  ∃ x : ℕ → set α, f.has_antitone_basis x :=
let ⟨x, hxf, hx⟩ := f.basis_sets.exists_antitone_subbasis in ⟨x, hx⟩

lemma exists_antitone_seq (f : filter α) [f.is_countably_generated] :
  ∃ x : ℕ → set α, antitone x ∧ ∀ {s}, (s ∈ f ↔ ∃ i, x i ⊆ s) :=
let ⟨x, hx⟩ := f.exists_antitone_basis in
⟨x, hx.antitone, λ s, by simp [hx.to_has_basis.mem_iff]⟩

instance inf.is_countably_generated (f g : filter α) [is_countably_generated f]
  [is_countably_generated g] :
  is_countably_generated (f ⊓ g) :=
begin
  rcases f.exists_antitone_basis with ⟨s, hs⟩,
  rcases g.exists_antitone_basis with ⟨t, ht⟩,
  exact has_countable_basis.is_countably_generated
    ⟨hs.to_has_basis.inf ht.to_has_basis, set.to_countable _⟩
end

instance map.is_countably_generated (l : filter α) [l.is_countably_generated] (f : α → β) :
  (map f l).is_countably_generated :=
let ⟨x, hxl⟩ := l.exists_antitone_basis in
has_countable_basis.is_countably_generated ⟨hxl.map.to_has_basis, to_countable _⟩

instance comap.is_countably_generated (l : filter β) [l.is_countably_generated] (f : α → β) :
  (comap f l).is_countably_generated :=
let ⟨x, hxl⟩ := l.exists_antitone_basis in
has_countable_basis.is_countably_generated ⟨hxl.to_has_basis.comap _, to_countable _⟩

instance sup.is_countably_generated (f g : filter α) [is_countably_generated f]
  [is_countably_generated g] :
  is_countably_generated (f ⊔ g) :=
begin
  rcases f.exists_antitone_basis with ⟨s, hs⟩,
  rcases g.exists_antitone_basis with ⟨t, ht⟩,
  exact has_countable_basis.is_countably_generated
    ⟨hs.to_has_basis.sup ht.to_has_basis, set.to_countable _⟩
end

instance prod.is_countably_generated (la : filter α) (lb : filter β) [is_countably_generated la]
  [is_countably_generated lb] : is_countably_generated (la ×ᶠ lb) :=
filter.inf.is_countably_generated _ _

instance coprod.is_countably_generated (la : filter α) (lb : filter β) [is_countably_generated la]
  [is_countably_generated lb] : is_countably_generated (la.coprod lb) :=
filter.sup.is_countably_generated _ _

end is_countably_generated

lemma is_countably_generated_seq [countable β] (x : β → set α) :
  is_countably_generated (⨅ i, 𝓟 $ x i) :=
begin
  use [range x, countable_range x],
  rw [generate_eq_binfi, infi_range]
end

lemma is_countably_generated_of_seq {f : filter α} (h : ∃ x : ℕ → set α, f = ⨅ i, 𝓟 $ x i) :
  f.is_countably_generated  :=
let ⟨x, h⟩ := h in by rw h ; apply is_countably_generated_seq

lemma is_countably_generated_binfi_principal {B : set $ set α} (h : B.countable) :
  is_countably_generated (⨅ (s ∈ B), 𝓟 s) :=
is_countably_generated_of_seq (countable_binfi_principal_eq_seq_infi h)

lemma is_countably_generated_iff_exists_antitone_basis {f : filter α} :
  is_countably_generated f ↔ ∃ x : ℕ → set α, f.has_antitone_basis x :=
begin
  split,
  { introI h, exact f.exists_antitone_basis },
  { rintros ⟨x, h⟩,
    rw h.to_has_basis.eq_infi,
    exact is_countably_generated_seq x },
end

@[instance] lemma is_countably_generated_principal (s : set α) : is_countably_generated (𝓟 s) :=
is_countably_generated_of_seq ⟨λ _, s, infi_const.symm⟩

@[instance] lemma is_countably_generated_pure (a : α) : is_countably_generated (pure a) :=
by { rw ← principal_singleton, exact is_countably_generated_principal _, }

@[instance] lemma is_countably_generated_bot : is_countably_generated (⊥ : filter α) :=
@principal_empty α ▸ is_countably_generated_principal _

@[instance] lemma is_countably_generated_top : is_countably_generated (⊤ : filter α) :=
@principal_univ α ▸ is_countably_generated_principal _

instance infi.is_countably_generated {ι : Sort*} [countable ι] (f : ι → filter α)
  [∀ i, is_countably_generated (f i)] : is_countably_generated (⨅ i, f i) :=
begin
  choose s hs using λ i, exists_antitone_basis (f i),
  rw [← plift.down_surjective.infi_comp],
  refine has_countable_basis.is_countably_generated
    ⟨has_basis_infi (λ n, (hs _).to_has_basis), _⟩,
  refine (countable_range $ sigma.map (coe : finset (plift ι) → set (plift ι)) (λ _, id)).mono _,
  rintro ⟨I, f⟩ ⟨hI, -⟩,
  lift I to finset (plift ι) using hI,
  exact ⟨⟨I, f⟩, rfl⟩
end

end filter


/-
Copyright (c) 2020 Bhavik Mehta, Edward Ayers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta, Edward Ayers
-/

import category_theory.limits.shapes.binary_products
import category_theory.adjunction
import adjunction
import tactic
import to_mathlib
import binary_products

/-!
# Cartesian closed categories

Define exponentiable objects and cartesian closed categories.
Show that exponential forms a difunctor.
-/
universes v u

namespace category_theory

open limits category
section
variables {C : Type u} [𝒞 : category.{v} C] [has_binary_products.{v} C] {A U V W X Y Z : C}
include 𝒞

local attribute [tidy] tactic.case_bash

def prodinl (X : C) : C ⥤ C := prod_functor.obj X

@[simp] lemma prodinl_map_def {f : Y ⟶ Z} : (prodinl X).map f = limits.prod.map (𝟙 X) f := rfl
@[simp] lemma map_fst {f : U ⟶ V} {g : W ⟶ X} : limits.prod.map f g ≫ limits.prod.fst = limits.prod.fst ≫ f := by simp
@[simp] lemma map_snd {f : U ⟶ V} {g : W ⟶ X} : limits.prod.map f g ≫ limits.prod.snd = limits.prod.snd ≫ g := by simp
@[simp] lemma prod.map_id : limits.prod.map (𝟙 X) (𝟙 Y) = 𝟙 (X⨯Y) := begin apply prod.hom_ext, simp, simp end
@[simp] lemma lift_fst {f : W ⟶ X} {g : W ⟶ Y} : limits.prod.lift f g ≫ limits.prod.fst = f := by simp
@[simp] lemma lift_snd {f : W ⟶ X} {g : W ⟶ Y} : limits.prod.lift f g ≫ limits.prod.snd = g := by simp
open category

def prodinl_comp (X Y : C) : prodinl (X ⨯ Y) ≅ prodinl Y ⋙ prodinl X :=
nat_iso.of_components (limits.prod.associator _ _) (by tidy)

end

class exponentiable {C : Type u} [𝒞 : category.{v} C] [bp : @has_binary_products C 𝒞] (X : C) :=
(exponentiable : is_left_adjoint (prodinl X))

def binary_product_exponentiable {C : Type u} [𝒞 : category.{v} C] [bp : @has_binary_products C 𝒞] {X Y : C}
  (hX : exponentiable X) (hY : exponentiable Y) : exponentiable (X ⨯ Y) :=
{ exponentiable :=
  { right := hX.exponentiable.right ⋙ hY.exponentiable.right,
    adj := adjunction_of_nat_iso_left (adjunction.comp _ _ hY.exponentiable.adj hX.exponentiable.adj) (prodinl_comp _ _).symm } }

class is_cartesian_closed (C : Type u) [𝒞 : category.{v} C] [has_binary_products.{v} C] extends has_terminal.{v} C :=
(cart_closed : Π (X : C), exponentiable X)

instance exponentiable_of_cc {C : Type u} [𝒞 : category.{v} C] [@has_binary_products C 𝒞] [is_cartesian_closed C] {A : C} :
  exponentiable A := is_cartesian_closed.cart_closed A

variables {C : Type u} [𝒞 : category.{v} C] [has_binary_products.{v} C] {X X' Y Y' Z A B : C} [exponentiable A]
include 𝒞

/-- This is (-)^A -/
def exp.functor (A : C) [exponentiable A] : C ⥤ C :=
(exponentiable.exponentiable A).right

def exp.adjunction : prodinl A ⊣ exp.functor A :=
(exponentiable.exponentiable A).adj

def ev.nat_trans (A : C) [exponentiable A] : exp.functor A ⋙ prodinl A ⟶ 𝟭 C :=
exp.adjunction.counit

def coev.nat_trans (A : C) [exponentiable A] : 𝟭 C ⟶ prodinl A ⋙ exp.functor A :=
exp.adjunction.unit

/-- `B ^ A` or `A ⟹ B` -/
def exp (A : C) (B : C) [exponentiable A] : C := (exp.functor A).obj B

infixl `⟹`:20 := exp

-- [todo] rename as 'post compose' or similar?
def post (A : C) [exponentiable A] {X Y : C} (f : X ⟶ Y) : A⟹X ⟶ A⟹Y :=
(exp.functor A).map f

lemma post.map_comp {f : X ⟶ Y} {g : Y ⟶ Z} : post A (f ≫ g) = post A f ≫ post A g :=
begin
  show functor.map _ _ = _ ≫ _,
  rw (exp.functor A).map_comp',
  refl,
end

def ev : A ⨯ (A⟹B) ⟶ B :=
(ev.nat_trans A).app B

def coev : B ⟶ A⟹(A⨯B) :=
(coev.nat_trans A).app B

@[simp] lemma ev_coev : limits.prod.map (𝟙 A) coev ≫ ev = 𝟙 (A⨯B) :=
(@adjunction.left_triangle_components C _ C _ (prodinl A) (exp.functor A) exp.adjunction B)

@[simp] lemma coev_ev : coev ≫ post _ ev = 𝟙 (A⟹B) :=
(@adjunction.right_triangle_components C _ C _ (prodinl A) (exp.functor A) exp.adjunction B)

lemma coev_nat (f : X ⟶ Y) : f ≫ coev = coev ≫ post _ (limits.prod.map (𝟙 A) f) :=
(coev.nat_trans A).naturality f

lemma ev_nat {f : X ⟶ Y} : limits.prod.map (𝟙 A) (post _ f) ≫ ev = ev ≫ f :=
(ev.nat_trans A).naturality f

def exp_transpose : (A ⨯ Y ⟶ X) ≃ (Y ⟶ A⟹X) :=
exp.adjunction.hom_equiv _ _

lemma exp_transpose_natural_left  (f : X ⟶ X') (g : A ⨯ X' ⟶ Y) :
  exp_transpose.to_fun (limits.prod.map (𝟙 _) f ≫ g) = f ≫ exp_transpose.to_fun g :=
adjunction.hom_equiv_naturality_left _ _ _

lemma exp_transpose_natural_right (f : A ⨯ X ⟶ Y) (g : Y ⟶ Y') :
  exp_transpose.to_fun (f ≫ g) = exp_transpose.to_fun f ≫ post _ g :=
adjunction.hom_equiv_naturality_right _ _ _

lemma exp_transpose_natural_right_symm  (f : X ⟶ A⟹Y) (g : Y ⟶ Y') :
  exp_transpose.inv_fun (f ≫ post A g) = exp_transpose.inv_fun f ≫ g :=
adjunction.hom_equiv_naturality_right_symm _ _ _

lemma exp_transpose_natural_left_symm  (f : X ⟶ X') (g : X' ⟶ A⟹Y) :
  exp_transpose.inv_fun (f ≫ g) = limits.prod.map (𝟙 _) f ≫ exp_transpose.inv_fun g :=
adjunction.hom_equiv_naturality_left_symm _ _ _

section terminal
variable [has_terminal.{v} C]

lemma prod_left_unitor_naturality (f : X ⟶ Y):
  (prod.left_unitor X).inv ≫ limits.prod.map (𝟙 _) f = f ≫ (prod.left_unitor Y).inv :=
begin
  apply prod.hom_ext,
  { apply subsingleton.elim },
  { simp [id_comp C f] }
end

def terminal_exponentiable : exponentiable ⊤_C :=
{ exponentiable := {
  right := 𝟭 C,
  adj := adjunction.mk_of_hom_equiv
  { hom_equiv := λ X _, have unitor : _, from prod.left_unitor X,
      ⟨λ a, unitor.inv ≫ a, λ a, unitor.hom ≫ a, by tidy, by tidy⟩ } } }

attribute [instance] terminal_exponentiable

def exp_terminal_iso : (⊤_C ⟹ X) ≅ X :=
begin
  apply yoneda.ext (⊤_ C ⟹ X) X _ _ _ _ _,
  intros Y f, exact (prod.left_unitor Y).inv ≫ exp_transpose.inv_fun f,
  intros Y f, exact exp_transpose.to_fun ((prod.left_unitor Y).hom ≫ f),
  { intros Z g, dsimp,
    rw ← assoc, erw iso.hom_inv_id (prod.left_unitor Z),
    simp [exp_transpose.right_inv g] },
  { intros Z g, dsimp,
    rw exp_transpose.left_inv,
    rw ← assoc,
    erw iso.inv_hom_id (prod.left_unitor Z),
    simp },
  { intros Z W f g, dsimp,
    rw exp_transpose_natural_left_symm,
    rw ← assoc, rw ← assoc,
    erw prod_left_unitor_naturality _, refl },
end

@[reducible]
def point_at_hom (f : A ⟶ Y) : ⊤_C ⟶ (A ⟹ Y) :=
exp_transpose.to_fun (limits.prod.fst ≫ f)
end terminal

section pre

variables [exponentiable B]

-- this notation (and the hats) are just here so i could figure out how to
-- do pre_map - I think the ⟨f,g⟩ might be nice but the rest can go (TODO)
local notation `⟨`f`, `g`⟩` := limits.prod.map f g

@[reducible]
def hat : (A ⨯ Y ⟶ X) → (Y ⟶ A ⟹ X) := exp_transpose.to_fun
@[reducible]
def unhat : (Y ⟶ A ⟹ X) → (A ⨯ Y ⟶ X) := exp_transpose.inv_fun

def pre (X : C) (f : B ⟶ A) :  (A⟹X) ⟶ B⟹X :=
hat (⟨f, 𝟙 (A ⟹ X)⟩ ≫ unhat (𝟙 (A ⟹ X)))

lemma pre_id : pre X (𝟙 A) = 𝟙 (A⟹X) :=
begin
  dunfold pre hat, erw exp_transpose_natural_left, rw exp_transpose.right_inv, simp
end

lemma pre_map {D : C} [exponentiable D] {f : A ⟶ B} {g : B ⟶ D} : pre X (f ≫ g) = pre X g ≫ pre X f :=
begin
  dunfold pre, apply function.injective_of_left_inverse exp_transpose.right_inv,
  rw exp_transpose.left_inv, rw ← exp_transpose_natural_left, rw exp_transpose.left_inv,
  show ⟨f ≫ g, 𝟙 (D ⟹ X)⟩ ≫ unhat (𝟙 (D ⟹ X)) =
    ⟨𝟙 A, (hat (⟨g, 𝟙 (D ⟹ X)⟩ ≫ unhat (𝟙 (D ⟹ X))))⟩ ≫
      ⟨f, 𝟙 (B ⟹ X)⟩ ≫ unhat (𝟙 (B ⟹ X)),
  suffices: ⟨f ≫ g, 𝟙 (D ⟹ X)⟩ ≫ unhat (𝟙 (D ⟹ X)) =
    (⟨f, 𝟙 (D ⟹ X)⟩ ≫ ⟨𝟙 B, (hat (⟨g, 𝟙 (D ⟹ X)⟩ ≫ unhat (𝟙 (D ⟹ X))))⟩) ≫ unhat (𝟙 (B ⟹ X)),
  rw this, rw ← assoc, congr' 1, apply prod.hom_ext, simp, dsimp, simp, simp, dsimp, simp,
  have: ⟨f ≫ g, 𝟙 (D ⟹ X)⟩ = ⟨f, 𝟙 _⟩ ≫ ⟨g, 𝟙 _⟩, apply prod.hom_ext, simp, simp,
  rw this, rw assoc, rw assoc, congr' 1, erw ← exp_transpose_natural_left_symm,
  apply function.injective_of_left_inverse exp_transpose.left_inv, rw exp_transpose_natural_right,
  rw exp_transpose.right_inv, simp, exact (exp_transpose_natural_right _ _).symm
end

def pre.functor [is_cartesian_closed C] (X : C) : Cᵒᵖ ⥤ C :=
{ obj := λ A, (A.unop) ⟹ X,
  map := λ A B f, pre X f.unop,
  map_id' := begin intros, apply pre_id, end,
  map_comp' := begin intros, apply pre_map, end,
}
end pre

lemma exp_natural [is_cartesian_closed C] (A B : C) (X Y : Cᵒᵖ) (f : A ⟶ B) (g : X ⟶ Y) :
  (pre.functor A).map g ≫ post (opposite.unop Y) f = post (opposite.unop X) f ≫ (pre.functor B).map g :=
begin
  dunfold pre.functor,
  dsimp, dunfold pre,
  show _ = _,
  rw ← exp_transpose_natural_right,
  rw ← exp_transpose_natural_left,
  congr' 1,
  rw assoc,
  rw ← exp_transpose_natural_right_symm,
  rw ← assoc,
  show _ = (limits.prod.map _ _ ≫ _) ≫ _,
  rw prod_map_comm,
  rw assoc,
  erw ← exp_transpose_natural_left_symm,
  rw id_comp,
  rw comp_id
end

def exp.difunctor [is_cartesian_closed C] : C ⥤ Cᵒᵖ ⥤ C :=
{ obj := pre.functor,
  map := λ A B f, { app := λ X, post X.unop f, naturality' := λ X Y g, begin apply exp_natural end },
  map_id' := λ X, begin ext, apply functor.map_id end,
  map_comp' := λ X Y Z f g, begin ext, apply functor.map_comp end
}

section functor

universes v₂ u₂

variables {D : Type u} [category.{v} D] [has_binary_products.{v} D]
variables (F : C ⥤ D) [preserves_limits_of_shape (discrete walking_pair) F]

-- (implementation)
def alternative_cone (A B : C) : cone (pair A B ⋙ F) :=
{ X := F.obj A ⨯ F.obj B,
  π := nat_trans.of_homs (λ j, walking_pair.cases_on j limits.prod.fst limits.prod.snd)}

-- (implementation)
def alt_is_limit (A B : C) : is_limit (functor.map_cone F (limit.cone (pair A B))) :=
preserves_limit.preserves F (limit.is_limit (pair A B))

-- the multiplicative comparison isomorphism
def mult_comparison (A B : C) : F.obj (A ⨯ B) ≅ F.obj A ⨯ F.obj B :=
{ hom := prod.lift (F.map limits.prod.fst) (F.map limits.prod.snd),
  inv := (alt_is_limit F A B).lift (alternative_cone F A B),
  hom_inv_id' :=
  begin
    apply is_limit.hom_ext (alt_is_limit F A B),
    rintro ⟨j⟩,
      rw assoc, rw (alt_is_limit F A B).fac,
      erw limit.lift_π, simp,
    rw assoc, rw (alt_is_limit F A B).fac,
    erw limit.lift_π, simp
  end,
  inv_hom_id' :=
  begin
    ext ⟨j⟩, simp, erw (alt_is_limit F A B).fac, refl,
    simp, erw (alt_is_limit F A B).fac, refl,
  end
}

variables [is_cartesian_closed C] [is_cartesian_closed D]

-- the exponential comparison map
def exp_comparison (A B : C) :
  F.obj (A ⟹ B) ⟶ F.obj A ⟹ F.obj B :=
hat ((mult_comparison F A _).inv ≫ F.map ev)

end functor

end category_theory


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.polynomial.big_operators
import Mathlib.field_theory.minpoly
import Mathlib.field_theory.splitting_field
import Mathlib.field_theory.tower
import Mathlib.algebra.squarefree
import Mathlib.PostPort

universes u u_1 v u_2 u_3

namespace Mathlib

/-!

# Separable polynomials

We define a polynomial to be separable if it is coprime with its derivative. We prove basic
properties about separable polynomials here.

## Main definitions

* `polynomial.separable f`: a polynomial `f` is separable iff it is coprime with its derivative.
* `polynomial.expand R p f`: expand the polynomial `f` with coefficients in a
  commutative semiring `R` by a factor of p, so `expand R p (∑ aₙ xⁿ)` is `∑ aₙ xⁿᵖ`.
* `polynomial.contract p f`: the opposite of `expand`, so it sends `∑ aₙ xⁿᵖ` to `∑ aₙ xⁿ`.

-/

namespace polynomial

/-- A polynomial is separable iff it is coprime with its derivative. -/
def separable {R : Type u} [comm_semiring R] (f : polynomial R) :=
  is_coprime f (coe_fn derivative f)

theorem separable_def {R : Type u} [comm_semiring R] (f : polynomial R) : separable f ↔ is_coprime f (coe_fn derivative f) :=
  iff.rfl

theorem separable_def' {R : Type u} [comm_semiring R] (f : polynomial R) : separable f ↔ ∃ (a : polynomial R), ∃ (b : polynomial R), a * f + b * coe_fn derivative f = 1 :=
  iff.rfl

theorem separable_one {R : Type u} [comm_semiring R] : separable 1 :=
  is_coprime_one_left

theorem separable_X_add_C {R : Type u} [comm_semiring R] (a : R) : separable (X + coe_fn C a) := sorry

theorem separable_X {R : Type u} [comm_semiring R] : separable X :=
  eq.mpr (id (Eq._oldrec (Eq.refl (separable X)) (propext (separable_def X))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (is_coprime X (coe_fn derivative X))) derivative_X)) is_coprime_one_right)

theorem separable_C {R : Type u} [comm_semiring R] (r : R) : separable (coe_fn C r) ↔ is_unit r := sorry

theorem separable.of_mul_left {R : Type u} [comm_semiring R] {f : polynomial R} {g : polynomial R} (h : separable (f * g)) : separable f := sorry

theorem separable.of_mul_right {R : Type u} [comm_semiring R] {f : polynomial R} {g : polynomial R} (h : separable (f * g)) : separable g :=
  separable.of_mul_left (eq.mp (Eq._oldrec (Eq.refl (separable (f * g))) (mul_comm f g)) h)

theorem separable.of_dvd {R : Type u} [comm_semiring R] {f : polynomial R} {g : polynomial R} (hf : separable f) (hfg : g ∣ f) : separable g :=
  Exists.dcases_on hfg
    fun (f' : polynomial R) (hfg_h : f = g * f') =>
      Eq._oldrec (fun (hf : separable (g * f')) => separable.of_mul_left hf) (Eq.symm hfg_h) hf

theorem separable_gcd_left {F : Type u_1} [field F] {f : polynomial F} (hf : separable f) (g : polynomial F) : separable (euclidean_domain.gcd f g) :=
  separable.of_dvd hf (euclidean_domain.gcd_dvd_left f g)

theorem separable_gcd_right {F : Type u_1} [field F] {g : polynomial F} (f : polynomial F) (hg : separable g) : separable (euclidean_domain.gcd f g) :=
  separable.of_dvd hg (euclidean_domain.gcd_dvd_right f g)

theorem separable.is_coprime {R : Type u} [comm_semiring R] {f : polynomial R} {g : polynomial R} (h : separable (f * g)) : is_coprime f g := sorry

theorem separable.of_pow' {R : Type u} [comm_semiring R] {f : polynomial R} {n : ℕ} (h : separable (f ^ n)) : is_unit f ∨ separable f ∧ n = 1 ∨ n = 0 := sorry

theorem separable.of_pow {R : Type u} [comm_semiring R] {f : polynomial R} (hf : ¬is_unit f) {n : ℕ} (hn : n ≠ 0) (hfs : separable (f ^ n)) : separable f ∧ n = 1 :=
  or.resolve_right (or.resolve_left (separable.of_pow' hfs) hf) hn

theorem separable.map {R : Type u} [comm_semiring R] {S : Type v} [comm_semiring S] {p : polynomial R} (h : separable p) {f : R →+* S} : separable (map f p) := sorry

/-- Expand the polynomial by a factor of p, so `∑ aₙ xⁿ` becomes `∑ aₙ xⁿᵖ`. -/
def expand (R : Type u) [comm_semiring R] (p : ℕ) : alg_hom R (polynomial R) (polynomial R) :=
  alg_hom.mk (ring_hom.to_fun (eval₂_ring_hom C (X ^ p))) sorry sorry sorry sorry sorry

theorem coe_expand (R : Type u) [comm_semiring R] (p : ℕ) : ⇑(expand R p) = eval₂ C (X ^ p) :=
  rfl

theorem expand_eq_sum {R : Type u} [comm_semiring R] (p : ℕ) {f : polynomial R} : coe_fn (expand R p) f = finsupp.sum f fun (e : ℕ) (a : R) => coe_fn C a * (X ^ p) ^ e :=
  id (Eq.refl (finsupp.sum f fun (e : ℕ) (a : R) => coe_fn C a * (X ^ p) ^ e))

@[simp] theorem expand_C {R : Type u} [comm_semiring R] (p : ℕ) (r : R) : coe_fn (expand R p) (coe_fn C r) = coe_fn C r :=
  eval₂_C C (X ^ p)

@[simp] theorem expand_X {R : Type u} [comm_semiring R] (p : ℕ) : coe_fn (expand R p) X = X ^ p :=
  eval₂_X C (X ^ p)

@[simp] theorem expand_monomial {R : Type u} [comm_semiring R] (p : ℕ) (q : ℕ) (r : R) : coe_fn (expand R p) (coe_fn (monomial q) r) = coe_fn (monomial (q * p)) r := sorry

theorem expand_expand {R : Type u} [comm_semiring R] (p : ℕ) (q : ℕ) (f : polynomial R) : coe_fn (expand R p) (coe_fn (expand R q) f) = coe_fn (expand R (p * q)) f := sorry

theorem expand_mul {R : Type u} [comm_semiring R] (p : ℕ) (q : ℕ) (f : polynomial R) : coe_fn (expand R (p * q)) f = coe_fn (expand R p) (coe_fn (expand R q) f) :=
  Eq.symm (expand_expand p q f)

@[simp] theorem expand_one {R : Type u} [comm_semiring R] (f : polynomial R) : coe_fn (expand R 1) f = f := sorry

theorem expand_pow {R : Type u} [comm_semiring R] (p : ℕ) (q : ℕ) (f : polynomial R) : coe_fn (expand R (p ^ q)) f = nat.iterate (⇑(expand R p)) q f := sorry

theorem derivative_expand {R : Type u} [comm_semiring R] (p : ℕ) (f : polynomial R) : coe_fn derivative (coe_fn (expand R p) f) = coe_fn (expand R p) (coe_fn derivative f) * (↑p * X ^ (p - 1)) := sorry

theorem coeff_expand {R : Type u} [comm_semiring R] {p : ℕ} (hp : 0 < p) (f : polynomial R) (n : ℕ) : coeff (coe_fn (expand R p) f) n = ite (p ∣ n) (coeff f (n / p)) 0 := sorry

@[simp] theorem coeff_expand_mul {R : Type u} [comm_semiring R] {p : ℕ} (hp : 0 < p) (f : polynomial R) (n : ℕ) : coeff (coe_fn (expand R p) f) (n * p) = coeff f n := sorry

@[simp] theorem coeff_expand_mul' {R : Type u} [comm_semiring R] {p : ℕ} (hp : 0 < p) (f : polynomial R) (n : ℕ) : coeff (coe_fn (expand R p) f) (p * n) = coeff f n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (coeff (coe_fn (expand R p) f) (p * n) = coeff f n)) (mul_comm p n)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (coeff (coe_fn (expand R p) f) (n * p) = coeff f n)) (coeff_expand_mul hp f n)))
      (Eq.refl (coeff f n)))

theorem expand_eq_map_domain {R : Type u} [comm_semiring R] (p : ℕ) (f : polynomial R) : coe_fn (expand R p) f = finsupp.map_domain (fun (_x : ℕ) => _x * p) f := sorry

theorem expand_inj {R : Type u} [comm_semiring R] {p : ℕ} (hp : 0 < p) {f : polynomial R} {g : polynomial R} : coe_fn (expand R p) f = coe_fn (expand R p) g ↔ f = g := sorry

theorem expand_eq_zero {R : Type u} [comm_semiring R] {p : ℕ} (hp : 0 < p) {f : polynomial R} : coe_fn (expand R p) f = 0 ↔ f = 0 := sorry

theorem expand_eq_C {R : Type u} [comm_semiring R] {p : ℕ} (hp : 0 < p) {f : polynomial R} {r : R} : coe_fn (expand R p) f = coe_fn C r ↔ f = coe_fn C r := sorry

theorem nat_degree_expand {R : Type u} [comm_semiring R] (p : ℕ) (f : polynomial R) : nat_degree (coe_fn (expand R p) f) = nat_degree f * p := sorry

theorem map_expand {R : Type u} [comm_semiring R] {S : Type v} [comm_semiring S] {p : ℕ} (hp : 0 < p) {f : R →+* S} {q : polynomial R} : map f (coe_fn (expand R p) q) = coe_fn (expand S p) (map f q) := sorry

theorem separable_X_sub_C {R : Type u} [comm_ring R] {x : R} : separable (X - coe_fn C x) := sorry

theorem separable.mul {R : Type u} [comm_ring R] {f : polynomial R} {g : polynomial R} (hf : separable f) (hg : separable g) (h : is_coprime f g) : separable (f * g) := sorry

theorem separable_prod' {R : Type u} [comm_ring R] {ι : Type u_1} {f : ι → polynomial R} {s : finset ι} : (∀ (x : ι), x ∈ s → ∀ (y : ι), y ∈ s → x ≠ y → is_coprime (f x) (f y)) →
  (∀ (x : ι), x ∈ s → separable (f x)) → separable (finset.prod s fun (x : ι) => f x) := sorry

theorem separable_prod {R : Type u} [comm_ring R] {ι : Type u_1} [fintype ι] {f : ι → polynomial R} (h1 : pairwise (is_coprime on f)) (h2 : ∀ (x : ι), separable (f x)) : separable (finset.prod finset.univ fun (x : ι) => f x) :=
  separable_prod' (fun (x : ι) (hx : x ∈ finset.univ) (y : ι) (hy : y ∈ finset.univ) (hxy : x ≠ y) => h1 x y hxy)
    fun (x : ι) (hx : x ∈ finset.univ) => h2 x

theorem separable.inj_of_prod_X_sub_C {R : Type u} [comm_ring R] [nontrivial R] {ι : Type u_1} {f : ι → R} {s : finset ι} (hfs : separable (finset.prod s fun (i : ι) => X - coe_fn C (f i))) {x : ι} {y : ι} (hx : x ∈ s) (hy : y ∈ s) (hfxy : f x = f y) : x = y := sorry

theorem separable.injective_of_prod_X_sub_C {R : Type u} [comm_ring R] [nontrivial R] {ι : Type u_1} [fintype ι] {f : ι → R} (hfs : separable (finset.prod finset.univ fun (i : ι) => X - coe_fn C (f i))) : function.injective f :=
  fun (x y : ι) (hfxy : f x = f y) => separable.inj_of_prod_X_sub_C hfs (finset.mem_univ x) (finset.mem_univ y) hfxy

theorem is_unit_of_self_mul_dvd_separable {R : Type u} [comm_ring R] {p : polynomial R} {q : polynomial R} (hp : separable p) (hq : q * q ∣ p) : is_unit q := sorry

theorem is_local_ring_hom_expand (R : Type u) [integral_domain R] {p : ℕ} (hp : 0 < p) : is_local_ring_hom ↑(expand R p) := sorry

theorem separable_iff_derivative_ne_zero {F : Type u} [field F] {f : polynomial F} (hf : irreducible f) : separable f ↔ coe_fn derivative f ≠ 0 := sorry

theorem separable_map {F : Type u} [field F] {K : Type v} [field K] (f : F →+* K) {p : polynomial F} : separable (map f p) ↔ separable p := sorry

/-- The opposite of `expand`: sends `∑ aₙ xⁿᵖ` to `∑ aₙ xⁿ`. -/
def contract {F : Type u} [field F] (p : ℕ) [hp : fact (nat.prime p)] (f : polynomial F) : polynomial F :=
  finsupp.mk (finset.preimage (finsupp.support f) (fun (_x : ℕ) => _x * p) sorry) (fun (n : ℕ) => coeff f (n * p)) sorry

theorem coeff_contract {F : Type u} [field F] (p : ℕ) [hp : fact (nat.prime p)] (f : polynomial F) (n : ℕ) : coeff (contract p f) n = coeff f (n * p) :=
  rfl

theorem of_irreducible_expand {F : Type u} [field F] (p : ℕ) [hp : fact (nat.prime p)] {f : polynomial F} (hf : irreducible (coe_fn (expand F p) f)) : irreducible f :=
  of_irreducible_map (↑(expand F p)) hf

theorem of_irreducible_expand_pow {F : Type u} [field F] (p : ℕ) [hp : fact (nat.prime p)] {f : polynomial F} {n : ℕ} : irreducible (coe_fn (expand F (p ^ n)) f) → irreducible f := sorry

theorem expand_char {F : Type u} [field F] (p : ℕ) [hp : fact (nat.prime p)] [HF : char_p F p] (f : polynomial F) : map (frobenius F p) (coe_fn (expand F p) f) = f ^ p := sorry

theorem map_expand_pow_char {F : Type u} [field F] (p : ℕ) [hp : fact (nat.prime p)] [HF : char_p F p] (f : polynomial F) (n : ℕ) : map (frobenius F p ^ n) (coe_fn (expand F (p ^ n)) f) = f ^ p ^ n := sorry

theorem expand_contract {F : Type u} [field F] (p : ℕ) [hp : fact (nat.prime p)] [HF : char_p F p] {f : polynomial F} (hf : coe_fn derivative f = 0) : coe_fn (expand F p) (contract p f) = f := sorry

theorem separable_or {F : Type u} [field F] (p : ℕ) [hp : fact (nat.prime p)] [HF : char_p F p] {f : polynomial F} (hf : irreducible f) : separable f ∨ ¬separable f ∧ ∃ (g : polynomial F), irreducible g ∧ coe_fn (expand F p) g = f := sorry

theorem exists_separable_of_irreducible {F : Type u} [field F] (p : ℕ) [hp : fact (nat.prime p)] [HF : char_p F p] {f : polynomial F} (hf : irreducible f) (hf0 : f ≠ 0) : ∃ (n : ℕ), ∃ (g : polynomial F), separable g ∧ coe_fn (expand F (p ^ n)) g = f := sorry

theorem is_unit_or_eq_zero_of_separable_expand {F : Type u} [field F] (p : ℕ) [hp : fact (nat.prime p)] [HF : char_p F p] {f : polynomial F} (n : ℕ) (hf : separable (coe_fn (expand F (p ^ n)) f)) : is_unit f ∨ n = 0 := sorry

theorem unique_separable_of_irreducible {F : Type u} [field F] (p : ℕ) [hp : fact (nat.prime p)] [HF : char_p F p] {f : polynomial F} (hf : irreducible f) (hf0 : f ≠ 0) (n₁ : ℕ) (g₁ : polynomial F) (hg₁ : separable g₁) (hgf₁ : coe_fn (expand F (p ^ n₁)) g₁ = f) (n₂ : ℕ) (g₂ : polynomial F) (hg₂ : separable g₂) (hgf₂ : coe_fn (expand F (p ^ n₂)) g₂ = f) : n₁ = n₂ ∧ g₁ = g₂ := sorry

theorem separable_prod_X_sub_C_iff' {F : Type u} [field F] {ι : Type u_1} {f : ι → F} {s : finset ι} : separable (finset.prod s fun (i : ι) => X - coe_fn C (f i)) ↔ ∀ (x : ι), x ∈ s → ∀ (y : ι), y ∈ s → f x = f y → x = y := sorry

theorem separable_prod_X_sub_C_iff {F : Type u} [field F] {ι : Type u_1} [fintype ι] {f : ι → F} : separable (finset.prod finset.univ fun (i : ι) => X - coe_fn C (f i)) ↔ function.injective f := sorry

theorem not_unit_X_sub_C {F : Type u} [field F] (a : F) : ¬is_unit (X - coe_fn C a) := sorry

theorem nodup_of_separable_prod {F : Type u} [field F] {s : multiset F} (hs : separable (multiset.prod (multiset.map (fun (a : F) => X - coe_fn C a) s))) : multiset.nodup s := sorry

theorem multiplicity_le_one_of_separable {F : Type u} [field F] {p : polynomial F} {q : polynomial F} (hq : ¬is_unit q) (hsep : separable p) : multiplicity q p ≤ 1 := sorry

theorem separable.squarefree {F : Type u} [field F] {p : polynomial F} (hsep : separable p) : squarefree p := sorry

/--If `n ≠ 0` in `F`, then ` X ^ n - a` is separable for any `a ≠ 0`. -/
theorem separable_X_pow_sub_C {F : Type u} [field F] {n : ℕ} (a : F) (hn : ↑n ≠ 0) (ha : a ≠ 0) : separable (X ^ n - coe_fn C a) := sorry

/--If `n ≠ 0` in `F`, then ` X ^ n - a` is squarefree for any `a ≠ 0`. -/
theorem squarefree_X_pow_sub_C {F : Type u} [field F] {n : ℕ} (a : F) (hn : ↑n ≠ 0) (ha : a ≠ 0) : squarefree (X ^ n - coe_fn C a) :=
  separable.squarefree (separable_X_pow_sub_C a hn ha)

theorem root_multiplicity_le_one_of_separable {F : Type u} [field F] {p : polynomial F} (hp : p ≠ 0) (hsep : separable p) (x : F) : root_multiplicity x p ≤ 1 := sorry

theorem count_roots_le_one {F : Type u} [field F] {p : polynomial F} (hsep : separable p) (x : F) : multiset.count x (roots p) ≤ 1 := sorry

theorem nodup_roots {F : Type u} [field F] {p : polynomial F} (hsep : separable p) : multiset.nodup (roots p) :=
  iff.mpr multiset.nodup_iff_count_le_one (count_roots_le_one hsep)

theorem eq_X_sub_C_of_separable_of_root_eq {F : Type u} [field F] {K : Type v} [field K] {i : F →+* K} {x : F} {h : polynomial F} (h_ne_zero : h ≠ 0) (h_sep : separable h) (h_root : eval x h = 0) (h_splits : splits i h) (h_roots : ∀ (y : K), y ∈ roots (map i h) → y = coe_fn i x) : h = coe_fn C (leading_coeff h) * (X - coe_fn C x) := sorry

end polynomial

theorem irreducible.separable {F : Type u} [field F] [char_zero F] {f : polynomial F} (hf : irreducible f) : polynomial.separable f := sorry

-- TODO: refactor to allow transcendental extensions?

-- See: https://en.wikipedia.org/wiki/Separable_extension#Separability_of_transcendental_extensions

/-- Typeclass for separable field extension: `K` is a separable field extension of `F` iff
the minimal polynomial of every `x : K` is separable. -/
def is_separable (F : Type u_1) (K : Type u_2) [field F] [field K] [algebra F K] :=
  ∀ (x : K), is_integral F x ∧ polynomial.separable (minpoly F x)

protected instance is_separable_self (F : Type u_1) [field F] : is_separable F F :=
  fun (x : F) =>
    { left := is_integral_algebra_map,
      right :=
        eq.mpr (id (Eq._oldrec (Eq.refl (polynomial.separable (minpoly F x))) (minpoly.eq_X_sub_C' x)))
          polynomial.separable_X_sub_C }

theorem is_separable_tower_top_of_is_separable (F : Type u_1) (K : Type u_2) (E : Type u_3) [field F] [field K] [field E] [algebra F K] [algebra F E] [algebra K E] [is_scalar_tower F K E] [h : is_separable F E] : is_separable K E := sorry

theorem is_separable_tower_bot_of_is_separable (F : Type u_1) (K : Type u_2) (E : Type u_3) [field F] [field K] [field E] [algebra F K] [algebra F E] [algebra K E] [is_scalar_tower F K E] [h : is_separable F E] : is_separable F K := sorry

theorem is_separable.of_alg_hom (F : Type u_1) {E : Type u_3} [field F] [field E] [algebra F E] (E' : Type u_2) [field E'] [algebra F E'] (f : alg_hom F E E') [is_separable F E'] : is_separable F E :=
  let _inst : algebra E E' := ring_hom.to_algebra (alg_hom.to_ring_hom f);
  is_separable_tower_bot_of_is_separable F E E'


namespace Ex1

mutual
def h (c : Nat) (x : Nat) := match g c x c c with
  | 0 => 1
  | r => r + 2
def g (c : Nat) (t : Nat) (a b : Nat) : Nat := match t with
  | (n+1) => match g c n a b with
    | 0 => 0
    | m => match g c (n - m) a b with
      | 0 => 0
      | m + 1 => g c m a b
  | 0 => f c 0
def f (c : Nat) (x : Nat) := match h c x with
  | 0 => 1
  | r => f c r
end
termination_by
  g x a b => 0
  f c x => 0
  h c x => 0
decreasing_by sorry

attribute [simp] g
attribute [simp] h
attribute [simp] f

#check g._eq_1
#check g._eq_2

#check h._eq_1

#check f._eq_1

end Ex1

namespace Ex2

def g (t : Nat) : Nat := match t with
  | (n+1) => match g n with
    | 0 => 0
    | m + 1 => match g (n - m) with
      | 0 => 0
      | m + 1 => g n
  | 0 => 0
termination_by' sorry
decreasing_by sorry

theorem ex1 : g 0 = 0 := by
  rw [g]

#check g._eq_1
#check g._eq_2

theorem ex2 : g 0 = 0 := by
  unfold g
  simp

#check g._unfold

end Ex2