/-
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 order.filter.basic
import data.set.countable
import data.pprod

/-!
# Filter bases

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 }⟩

/-- `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],
    finish },
  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, finite t ∧ t ⊆ s) (λ t, ⋂₀ t) :=
⟨begin
  intro U,
  rw mem_generate_iff,
  apply exists_congr,
  tauto
end⟩

/-- The smallest filter basis containing a given collection of sets. -/
def filter_basis.of_sets (s : set (set α)) : filter_basis α :=
{ sets := sInter '' { t | 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 | 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, ← ne_empty_iff_nonempty]

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

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

/-- 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_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.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 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 inf_eq_bot_iff {f g : filter α} :
  f ⊓ g = ⊥ ↔ ∃ (U ∈ f) (V ∈ g), U ∩ V = ∅ :=
not_iff_not.1 $ ne_bot_iff.symm.trans $ inf_ne_bot_iff.trans $
by simp [← ne_empty_iff_nonempty]

protected lemma disjoint_iff {f g : filter α} :
  disjoint f g ↔ ∃ (U ∈ f) (V ∈ g), U ∩ V = ∅ :=
disjoint_iff.trans inf_eq_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 [empty_not_nonempty] 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

lemma mem_iff_disjoint_principal_compl {f : filter α} {s : set α} :
  s ∈ f ↔ disjoint f (𝓟 sᶜ) :=
mem_iff_inf_principal_compl.trans disjoint_iff.symm

lemma le_iff_forall_disjoint_principal_compl {f g : filter α} :
  f ≤ g ↔ ∀ V ∈ g, disjoint f (𝓟 Vᶜ) :=
forall_congr $ λ _, forall_congr $ λ _, mem_iff_disjoint_principal_compl

lemma le_iff_forall_inf_principal_compl {f g : filter α} :
  f ≤ g ↔ ∀ V ∈ g, f ⊓ 𝓟 Vᶜ = ⊥ :=
forall_congr $ λ _, 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 ι, finite t) (λ 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⟩

lemma has_basis.prod_self (hl : l.has_basis p s) :
  (l ×ᶠ l).has_basis p (λ i, (s i).prod (s i)) :=
⟨begin
  intro t,
  apply mem_prod_iff.trans,
  split,
  { rintros ⟨t₁, ht₁, t₂, ht₂, H⟩,
    rcases hl.mem_iff.1 (inter_mem ht₁ ht₂) with ⟨i, hi, ht⟩,
    exact ⟨i, hi, λ p ⟨hp₁, hp₂⟩, H ⟨(ht hp₁).1, (ht hp₂).2⟩⟩ },
  { rintros ⟨i, hi, H⟩,
    exact ⟨s i, hl.mem_of_mem hi, s i, hl.mem_of_mem hi, H⟩ }
end⟩

lemma mem_prod_self_iff {s} : s ∈ l ×ᶠ l ↔ ∃ t ∈ l, set.prod t t ⊆ s :=
l.basis_sets.prod_self.mem_iff

lemma has_basis.sInter_sets (h : has_basis l p s) :
  ⋂₀ l.sets = ⋂ i (hi : p i), s i :=
begin
  ext x,
  suffices : (∀ t ∈ l, x ∈ t) ↔ ∀ i, p i → x ∈ s i,
    by simpa only [mem_Inter, mem_set_of_eq, mem_sInter],
  simp_rw h.mem_iff,
  split,
  { intros h i hi,
    exact h (s i) ⟨i, hi, subset.refl _⟩ },
  { rintros h _ ⟨i, hi, sub⟩,
    exact sub (h i hi) },
end

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)

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'' (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).prod (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).prod (sb i.2)) :=
(hla.comap prod.fst).inf (hlb.comap prod.snd)

lemma has_basis.prod' {la : filter α} {lb : filter β} {ι : Type*} {p : ι → Prop}
  {sa : ι → set α} {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).prod (sb i)) :=
begin
  simp only [has_basis_iff, (hla.prod hlb).mem_iff],
  refine λ t, ⟨_, _⟩,
  { rintros ⟨⟨i, j⟩, ⟨hi, hj⟩, hsub : (sa i).prod (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

end two_types

end filter

end sort

namespace filter

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

/-- `is_countably_generated f` means `f = generate s` for some countable `s`. -/
class is_countably_generated (f : filter α) : Prop :=
(out [] : ∃ s : set (set α), countable s ∧ 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 : countable $ set_of p)

/-- 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 : countable $ set_of p)

/-- 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 : countable sets)

-- 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 _, apply le_refl _ },
  { 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 : countable B)
  (Bne : B.nonempty) (f : ι → α) :
  ∃ (x : ℕ → ι), (⨅ t ∈ B, f t) = ⨅ i, f (x i) :=
begin
  rw countable_iff_exists_surjective_to_subtype Bne at Bcbl,
  rcases Bcbl with ⟨g, gsurj⟩,
  rw infi_subtype',
  use (λ n, g n), apply le_antisymm; rw le_infi_iff,
  { intro i, apply infi_le_of_le (g i) _, apply le_refl _ },
  { intros a, rcases gsurj a with ⟨i, rfl⟩, apply infi_le }
end

lemma countable_binfi_eq_infi_seq' [complete_lattice α] {B : set ι} (Bcbl : countable B) (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 : countable B) :
  ∃ (x : ℕ → set α), (⨅ t ∈ B, 𝓟 t) = ⨅ i, 𝓟 (x i) :=
countable_binfi_eq_infi_seq' Bcbl 𝓟 principal_univ

section is_countably_generated

/-- 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.coe_prop))),
  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.countable_encodable _⟩
end

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 _, countable_encodable _⟩

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.countable_encodable _⟩
end

end is_countably_generated

@[instance] lemma is_countably_generated_seq [encodable β] (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 : countable B) :
  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_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 _

end filter


/-
Copyright (c) 2021 Julian Kuelshammer. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Julian Kuelshammer
-/
import category_theory.concrete_category.bundled_hom
import category_theory.concrete_category.reflects_isomorphisms
import algebra.pempty_instances

/-!
# Category instances for has_mul, has_add, semigroup and add_semigroup

We introduce the bundled categories:
* `Magma`
* `AddMagma`
* `Semigroup`
* `AddSemigroup`
along with the relevant forgetful functors between them.

This closely follows `algebra.category.Mon.basic`.

## TODO

* Limits in these categories
* free/forgetful adjunctions
-/

universes u v

open category_theory

/-- The category of magmas and magma morphisms. -/
@[to_additive AddMagma]
def Magma : Type (u+1) := bundled has_mul

/-- The category of additive magmas and additive magma morphisms. -/
add_decl_doc AddMagma

namespace Magma

@[to_additive]
instance bundled_hom : bundled_hom @mul_hom :=
⟨@mul_hom.to_fun, @mul_hom.id, @mul_hom.comp, @mul_hom.coe_inj⟩

attribute [derive [has_coe_to_sort, large_category, concrete_category]] Magma AddMagma

/-- Construct a bundled `Magma` from the underlying type and typeclass. -/
@[to_additive]
def of (M : Type u) [has_mul M] : Magma := bundled.of M

/-- Construct a bundled `Magma` from the underlying type and typeclass. -/
add_decl_doc AddMagma.of

@[to_additive]
instance : inhabited Magma := ⟨Magma.of pempty⟩

@[to_additive]
instance (M : Magma) : has_mul M := M.str

@[simp, to_additive] lemma coe_of (R : Type u) [has_mul R] : (Magma.of R : Type u) = R := rfl

end Magma

/-- The category of semigroups and semigroup morphisms. -/
@[to_additive AddSemigroup]
def Semigroup : Type (u+1) := bundled semigroup

/-- The category of additive semigroups and semigroup morphisms. -/
add_decl_doc AddSemigroup

namespace Semigroup

@[to_additive]
instance : bundled_hom.parent_projection semigroup.to_has_mul := ⟨⟩

attribute [derive [has_coe_to_sort, large_category, concrete_category]] Semigroup AddSemigroup

/-- Construct a bundled `Semigroup` from the underlying type and typeclass. -/
@[to_additive]
def of (M : Type u) [semigroup M] : Semigroup := bundled.of M

/-- Construct a bundled `AddSemigroup` from the underlying type and typeclass. -/
add_decl_doc AddSemigroup.of

@[to_additive]
instance : inhabited Semigroup := ⟨Semigroup.of pempty⟩

@[to_additive]
instance (M : Semigroup) : semigroup M := M.str

@[simp, to_additive] lemma coe_of (R : Type u) [semigroup R] : (Semigroup.of R : Type u) = R := rfl

@[to_additive has_forget_to_AddMagma]
instance has_forget_to_Magma : has_forget₂ Semigroup Magma := bundled_hom.forget₂ _ _

end Semigroup

variables {X Y : Type u}

section
variables [has_mul X] [has_mul Y]

/-- Build an isomorphism in the category `Magma` from a `mul_equiv` between `has_mul`s. -/
@[to_additive add_equiv.to_AddMagma_iso "Build an isomorphism in the category `AddMagma` from
an `add_equiv` between `has_add`s.", simps]
def mul_equiv.to_Magma_iso (e : X ≃* Y) : Magma.of X ≅ Magma.of Y :=
{ hom := e.to_mul_hom,
  inv := e.symm.to_mul_hom }

end

section
variables [semigroup X] [semigroup Y]

/-- Build an isomorphism in the category `Semigroup` from a `mul_equiv` between `semigroup`s. -/
@[to_additive add_equiv.to_AddSemigroup_iso "Build an isomorphism in the category
`AddSemigroup` from an `add_equiv` between `add_semigroup`s.", simps]
def mul_equiv.to_Semigroup_iso (e : X ≃* Y) : Semigroup.of X ≅ Semigroup.of Y :=
{ hom := e.to_mul_hom,
  inv := e.symm.to_mul_hom }

end

namespace category_theory.iso

/-- Build a `mul_equiv` from an isomorphism in the category `Magma`. -/
@[to_additive AddMagma_iso_to_add_equiv "Build an `add_equiv` from an isomorphism in the category
`AddMagma`."]
def Magma_iso_to_mul_equiv {X Y : Magma} (i : X ≅ Y) : X ≃* Y :=
{ to_fun := i.hom,
  inv_fun := i.inv,
  left_inv := begin rw function.left_inverse, simp end,
  right_inv := begin rw function.right_inverse, rw function.left_inverse, simp end,
  map_mul' := by simp }

/-- Build a `mul_equiv` from an isomorphism in the category `Semigroup`. -/
@[to_additive "Build an `add_equiv` from an isomorphism in the category
`AddSemigroup`."]
def Semigroup_iso_to_mul_equiv {X Y : Semigroup} (i : X ≅ Y) : X ≃* Y :=
{ to_fun := i.hom,
  inv_fun := i.inv,
  left_inv := begin rw function.left_inverse, simp end,
  right_inv := begin rw function.right_inverse, rw function.left_inverse, simp end,
  map_mul' := by simp }

end category_theory.iso

/-- multiplicative equivalences between `has_mul`s are the same as (isomorphic to) isomorphisms
in `Magma` -/
@[to_additive add_equiv_iso_AddMagma_iso "additive equivalences between `has_add`s are the same
as (isomorphic to) isomorphisms in `AddMagma`"]
def mul_equiv_iso_Magma_iso {X Y : Type u} [has_mul X] [has_mul Y] :
  (X ≃* Y) ≅ (Magma.of X ≅ Magma.of Y) :=
{ hom := λ e, e.to_Magma_iso,
  inv := λ i, i.Magma_iso_to_mul_equiv }

/-- multiplicative equivalences between `semigroup`s are the same as (isomorphic to) isomorphisms
in `Semigroup` -/
@[to_additive add_equiv_iso_AddSemigroup_iso "additive equivalences between `add_semigroup`s are
the same as (isomorphic to) isomorphisms in `AddSemigroup`"]
def mul_equiv_iso_Semigroup_iso {X Y : Type u} [semigroup X] [semigroup Y] :
  (X ≃* Y) ≅ (Semigroup.of X ≅ Semigroup.of Y) :=
{ hom := λ e, e.to_Semigroup_iso,
  inv := λ i, i.Semigroup_iso_to_mul_equiv }

@[to_additive]
instance Magma.forget_reflects_isos : reflects_isomorphisms (forget Magma.{u}) :=
{ reflects := λ X Y f _,
  begin
    resetI,
    let i := as_iso ((forget Magma).map f),
    let e : X ≃* Y := { ..f, ..i.to_equiv },
    exact ⟨(is_iso.of_iso e.to_Magma_iso).1⟩,
  end }

@[to_additive]
instance Semigroup.forget_reflects_isos : reflects_isomorphisms (forget Semigroup.{u}) :=
{ reflects := λ X Y f _,
  begin
    resetI,
    let i := as_iso ((forget Semigroup).map f),
    let e : X ≃* Y := { ..f, ..i.to_equiv },
    exact ⟨(is_iso.of_iso e.to_Semigroup_iso).1⟩,
  end }

/-!
Once we've shown that the forgetful functors to type reflect isomorphisms,
we automatically obtain that the `forget₂` functors between our concrete categories
reflect isomorphisms.
-/
example : reflects_isomorphisms (forget₂ Semigroup Magma) := by apply_instance


/-
Copyright (c) 2019 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Yakov Pechersky
-/
import data.list.perm
import data.list.range

/-!
# List rotation

This file proves basic results about `list.rotate`, the list rotation.

## Main declarations

* `is_rotated l₁ l₂`: States that `l₁` is a rotated version of `l₂`.
* `cyclic_permutations l`: The list of all cyclic permutants of `l`, up to the length of `l`.

## Tags

rotated, rotation, permutation, cycle
-/

universe u
variables {α : Type u}

open nat

namespace list

lemma rotate_mod (l : list α) (n : ℕ) : l.rotate (n % l.length) = l.rotate n :=
by simp [rotate]

@[simp] lemma rotate_nil (n : ℕ) : ([] : list α).rotate n = [] := by cases n; simp [rotate]

@[simp] lemma rotate_zero (l : list α) : l.rotate 0 = l := by simp [rotate]

@[simp] lemma rotate'_nil (n : ℕ) : ([] : list α).rotate' n = [] := by cases n; refl

@[simp] lemma rotate'_zero (l : list α) : l.rotate' 0 = l := by cases l; refl

lemma rotate'_cons_succ (l : list α) (a : α) (n : ℕ) :
  (a :: l : list α).rotate' n.succ = (l ++ [a]).rotate' n := by simp [rotate']

@[simp] lemma length_rotate' : ∀ (l : list α) (n : ℕ), (l.rotate' n).length = l.length
| []     n     := rfl
| (a::l) 0     := rfl
| (a::l) (n+1) := by rw [list.rotate', length_rotate' (l ++ [a]) n]; simp

lemma rotate'_eq_drop_append_take : ∀ {l : list α} {n : ℕ}, n ≤ l.length →
  l.rotate' n = l.drop n ++ l.take n
| []     n     h := by simp [drop_append_of_le_length h]
| l      0     h := by simp [take_append_of_le_length h]
| (a::l) (n+1) h :=
have hnl : n ≤ l.length, from le_of_succ_le_succ h,
have hnl' : n ≤ (l ++ [a]).length,
  by rw [length_append, length_cons, list.length, zero_add];
    exact (le_of_succ_le h),
by rw [rotate'_cons_succ, rotate'_eq_drop_append_take hnl', drop, take,
     drop_append_of_le_length hnl, take_append_of_le_length hnl];
   simp

lemma rotate'_rotate' : ∀ (l : list α) (n m : ℕ), (l.rotate' n).rotate' m = l.rotate' (n + m)
| (a::l) 0     m := by simp
| []     n     m := by simp
| (a::l) (n+1) m := by rw [rotate'_cons_succ, rotate'_rotate', add_right_comm, rotate'_cons_succ]

@[simp] lemma rotate'_length (l : list α) : rotate' l l.length = l :=
by rw rotate'_eq_drop_append_take (le_refl _); simp

@[simp] lemma rotate'_length_mul (l : list α) : ∀ n : ℕ, l.rotate' (l.length * n) = l
| 0     := by simp
| (n+1) :=
calc l.rotate' (l.length * (n + 1)) =
  (l.rotate' (l.length * n)).rotate' (l.rotate' (l.length * n)).length :
    by simp [-rotate'_length, nat.mul_succ, rotate'_rotate']
... = l : by rw [rotate'_length, rotate'_length_mul]

lemma rotate'_mod (l : list α) (n : ℕ) : l.rotate' (n % l.length) = l.rotate' n :=
calc l.rotate' (n % l.length) = (l.rotate' (n % l.length)).rotate'
    ((l.rotate' (n % l.length)).length * (n / l.length)) : by rw rotate'_length_mul
... = l.rotate' n : by rw [rotate'_rotate', length_rotate', nat.mod_add_div]

lemma rotate_eq_rotate' (l : list α) (n : ℕ) : l.rotate n = l.rotate' n :=
if h : l.length = 0 then by simp [length_eq_zero, *] at *
else by
  rw [← rotate'_mod, rotate'_eq_drop_append_take (le_of_lt (nat.mod_lt _ (nat.pos_of_ne_zero h)))];
  simp [rotate]

lemma rotate_cons_succ (l : list α) (a : α) (n : ℕ) :
  (a :: l : list α).rotate n.succ = (l ++ [a]).rotate n :=
by rw [rotate_eq_rotate', rotate_eq_rotate', rotate'_cons_succ]

@[simp] lemma mem_rotate : ∀ {l : list α} {a : α} {n : ℕ}, a ∈ l.rotate n ↔ a ∈ l
| []     _ n     := by simp
| (a::l) _ 0     := by simp
| (a::l) _ (n+1) := by simp [rotate_cons_succ, mem_rotate, or.comm]

@[simp] lemma length_rotate (l : list α) (n : ℕ) : (l.rotate n).length = l.length :=
by rw [rotate_eq_rotate', length_rotate']

lemma rotate_eq_drop_append_take {l : list α} {n : ℕ} : n ≤ l.length →
  l.rotate n = l.drop n ++ l.take n :=
by rw rotate_eq_rotate'; exact rotate'_eq_drop_append_take

lemma rotate_eq_drop_append_take_mod {l : list α} {n : ℕ} :
  l.rotate n = l.drop (n % l.length) ++ l.take (n % l.length) :=
begin
  cases l.length.zero_le.eq_or_lt with hl hl,
  { simp [eq_nil_of_length_eq_zero hl.symm ] },
  rw [←rotate_eq_drop_append_take (n.mod_lt hl).le, rotate_mod]
end

@[simp] lemma rotate_append_length_eq (l l' : list α) : (l ++ l').rotate l.length = l' ++ l :=
begin
  rw rotate_eq_rotate',
  induction l generalizing l',
  { simp, },
  { simp [rotate', l_ih] },
end

lemma rotate_rotate (l : list α) (n m : ℕ) : (l.rotate n).rotate m = l.rotate (n + m) :=
by rw [rotate_eq_rotate', rotate_eq_rotate', rotate_eq_rotate', rotate'_rotate']

@[simp] lemma rotate_length (l : list α) : rotate l l.length = l :=
by rw [rotate_eq_rotate', rotate'_length]

@[simp] lemma rotate_length_mul (l : list α) (n : ℕ) : l.rotate (l.length * n) = l :=
by rw [rotate_eq_rotate', rotate'_length_mul]

lemma prod_rotate_eq_one_of_prod_eq_one [group α] : ∀ {l : list α} (hl : l.prod = 1) (n : ℕ),
  (l.rotate n).prod = 1
| []     _  _ := by simp
| (a::l) hl n :=
have n % list.length (a :: l) ≤ list.length (a :: l), from le_of_lt (nat.mod_lt _ dec_trivial),
by rw ← list.take_append_drop (n % list.length (a :: l)) (a :: l) at hl;
  rw [← rotate_mod, rotate_eq_drop_append_take this, list.prod_append, mul_eq_one_iff_inv_eq,
    ← one_mul (list.prod _)⁻¹, ← hl, list.prod_append, mul_assoc, mul_inv_self, mul_one]

lemma rotate_perm (l : list α) (n : ℕ) : l.rotate n ~ l :=
begin
  rw rotate_eq_rotate',
  induction n with n hn generalizing l,
  { simp },
  { cases l with hd tl,
    { simp },
    { rw rotate'_cons_succ,
      exact (hn _).trans (perm_append_singleton _ _) } }
end

@[simp] lemma nodup_rotate {l : list α} {n : ℕ} : nodup (l.rotate n) ↔ nodup l :=
(rotate_perm l n).nodup_iff

@[simp] lemma rotate_eq_nil_iff {l : list α} {n : ℕ} : l.rotate n = [] ↔ l = [] :=
begin
  induction n with n hn generalizing l,
  { simp },
  { cases l with hd tl,
    { simp },
    { simp [rotate_cons_succ, hn] } }
end

@[simp] lemma nil_eq_rotate_iff {l : list α} {n : ℕ} : [] = l.rotate n ↔ [] = l :=
by rw [eq_comm, rotate_eq_nil_iff, eq_comm]

@[simp] lemma rotate_singleton (x : α) (n : ℕ) :
  [x].rotate n = [x] :=
begin
  induction n with n hn,
  { simp },
  { rwa [rotate_cons_succ] }
end

@[simp] lemma rotate_eq_singleton_iff {l : list α} {n : ℕ} {x : α} : l.rotate n = [x] ↔ l = [x] :=
begin
  induction n with n hn generalizing l,
  { simp },
  { cases l with hd tl,
    { simp },
    { simp [rotate_cons_succ, hn, append_eq_cons_iff, and_comm] } }
end

@[simp] lemma singleton_eq_rotate_iff {l : list α} {n : ℕ} {x : α} : [x] = l.rotate n ↔ [x] = l :=
by rw [eq_comm, rotate_eq_singleton_iff, eq_comm]

lemma zip_with_rotate_distrib {α β γ : Type*} (f : α → β → γ) (l : list α) (l' : list β) (n : ℕ)
  (h : l.length = l'.length) :
  (zip_with f l l').rotate n = zip_with f (l.rotate n) (l'.rotate n) :=
begin
  rw [rotate_eq_drop_append_take_mod, rotate_eq_drop_append_take_mod,
      rotate_eq_drop_append_take_mod, h, zip_with_append, ←zip_with_distrib_drop,
      ←zip_with_distrib_take, list.length_zip_with, h, min_self],
  rw [length_drop, length_drop, h]
end

local attribute [simp] rotate_cons_succ

@[simp] lemma zip_with_rotate_one {β : Type*} (f : α → α → β) (x y : α) (l : list α) :
  zip_with f (x :: y :: l) ((x :: y :: l).rotate 1) =
  f x y :: zip_with f (y :: l) (l ++ [x]) :=
by simp

lemma nth_le_rotate_one (l : list α) (k : ℕ) (hk : k < (l.rotate 1).length) :
  (l.rotate 1).nth_le k hk = l.nth_le ((k + 1) % l.length)
    (mod_lt _ (length_rotate l 1 ▸ k.zero_le.trans_lt hk)) :=
begin
  cases l with hd tl,
  { simp },
  { have : k ≤ tl.length,
    { refine nat.le_of_lt_succ _,
      simpa using hk },
    rcases this.eq_or_lt with rfl|hk',
    { simp [nth_le_append_right (le_refl _)] },
    { simpa [nth_le_append _ hk', length_cons, nat.mod_eq_of_lt (nat.succ_lt_succ hk')] } }
end

lemma nth_le_rotate (l : list α) (n k : ℕ) (hk : k < (l.rotate n).length) :
  (l.rotate n).nth_le k hk = l.nth_le ((k + n) % l.length)
    (mod_lt _ (length_rotate l n ▸ k.zero_le.trans_lt hk)) :=
begin
  induction n with n hn generalizing l k,
  { have hk' : k < l.length := by simpa using hk,
    simp [nat.mod_eq_of_lt hk'] },
  { simp [nat.succ_eq_add_one, ←rotate_rotate, nth_le_rotate_one, hn l, add_comm, add_left_comm] }
end

/-- A variant of `nth_le_rotate` useful for rewrites. -/
lemma nth_le_rotate' (l : list α) (n k : ℕ) (hk : k < l.length) :
  (l.rotate n).nth_le ((l.length - n % l.length + k) % l.length)
      ((nat.mod_lt _ (k.zero_le.trans_lt hk)).trans_le (length_rotate _ _).ge) = l.nth_le k hk :=
begin
  rw nth_le_rotate,
  congr,
  set m := l.length,
  rw [mod_add_mod, add_assoc, add_left_comm, add_comm, add_mod, add_mod _ n],
  cases (n % m).zero_le.eq_or_lt with hn hn,
  { simpa [←hn] using nat.mod_eq_of_lt hk },
  { have mpos : 0 < m := k.zero_le.trans_lt hk,
    have hm : m - n % m < m := tsub_lt_self mpos hn,
    have hn' : n % m < m := nat.mod_lt _ mpos,
    simpa [mod_eq_of_lt hm, tsub_add_cancel_of_le hn'.le] using nat.mod_eq_of_lt hk }
end

lemma rotate_injective (n : ℕ) : function.injective (λ l : list α, l.rotate n) :=
begin
  rintros l l' (h : l.rotate n = l'.rotate n),
  have hle : l.length = l'.length := (l.length_rotate n).symm.trans (h.symm ▸ l'.length_rotate n),
  rw [rotate_eq_drop_append_take_mod, rotate_eq_drop_append_take_mod] at h,
  obtain ⟨hd, ht⟩ := append_inj h _,
  { rw [←take_append_drop _ l, ht, hd, take_append_drop] },
  { rw [length_drop, length_drop, hle] }
end

-- possibly easier to find in doc-gen, otherwise not that useful.
lemma rotate_eq_rotate {l l' : list α} {n : ℕ} :
  l.rotate n = l'.rotate n ↔ l = l' :=
(rotate_injective n).eq_iff

lemma rotate_eq_iff {l l' : list α} {n : ℕ} :
  l.rotate n = l' ↔ l = l'.rotate (l'.length - n % l'.length) :=
begin
  rw [←@rotate_eq_rotate _ l _ n, rotate_rotate, ←rotate_mod l', add_mod],
  cases l'.length.zero_le.eq_or_lt with hl hl,
  { rw [eq_nil_of_length_eq_zero hl.symm, rotate_nil, rotate_eq_nil_iff] },
  { cases (nat.zero_le (n % l'.length)).eq_or_lt with hn hn,
    { simp [←hn] },
    { rw [mod_eq_of_lt (tsub_lt_self hl hn), tsub_add_cancel_of_le, mod_self, rotate_zero],
      exact (nat.mod_lt _ hl).le } }
end

lemma reverse_rotate (l : list α) (n : ℕ) :
  (l.rotate n).reverse = l.reverse.rotate (l.length - (n % l.length)) :=
begin
  rw [←length_reverse l, ←rotate_eq_iff],
  induction n with n hn generalizing l,
  { simp },
  { cases l with hd tl,
    { simp },
    { rw [rotate_cons_succ, nat.succ_eq_add_one, ←rotate_rotate, hn],
      simp } }
end

lemma rotate_reverse (l : list α) (n : ℕ) :
  l.reverse.rotate n = (l.rotate (l.length - (n % l.length))).reverse :=
begin
  rw [←reverse_reverse l],
  simp_rw [reverse_rotate, reverse_reverse, rotate_eq_iff, rotate_rotate, length_rotate,
           length_reverse],
  rw [←length_reverse l],
  set k := n % l.reverse.length with hk,
  cases hk' : k with k',
  { simp [-length_reverse, ←rotate_rotate] },
  { cases l with x l,
    { simp },
    { have : k'.succ < (x :: l).length,
      { simp [←hk', hk, nat.mod_lt] },
      rw [nat.mod_eq_of_lt, tsub_add_cancel_of_le, rotate_length],
      { exact tsub_le_self },
      { exact tsub_lt_self (by simp) nat.succ_pos' } } }
end

lemma map_rotate {β : Type*} (f : α → β) (l : list α) (n : ℕ) :
  map f (l.rotate n) = (map f l).rotate n :=
begin
  induction n with n hn IH generalizing l,
  { simp },
  { cases l with hd tl,
    { simp },
    { simp [hn] } }
end

theorem nodup.rotate_eq_self_iff {l : list α} (hl : l.nodup) {n : ℕ} :
  l.rotate n = l ↔ n % l.length = 0 ∨ l = [] :=
begin
  split,
  { intro h,
    cases l.length.zero_le.eq_or_lt with hl' hl',
    { simp [←length_eq_zero, ←hl'] },
    left,
    rw nodup_iff_nth_le_inj at hl,
    refine hl _ _ (mod_lt _ hl') hl' _,
    rw ←nth_le_rotate' _ n,
    simp_rw [h, tsub_add_cancel_of_le (mod_lt _ hl').le, mod_self] },
  { rintro (h|h),
    { rw [←rotate_mod, h],
      exact rotate_zero l },
    { simp [h] } }
end

section is_rotated

variables (l l' : list α)

/-- `is_rotated l₁ l₂` or `l₁ ~r l₂` asserts that `l₁` and `l₂` are cyclic permutations
  of each other. This is defined by claiming that `∃ n, l.rotate n = l'`. -/
def is_rotated : Prop := ∃ n, l.rotate n = l'

infixr ` ~r `:1000 := is_rotated

variables {l l'}

@[refl] lemma is_rotated.refl (l : list α) : l ~r l :=
⟨0, by simp⟩

@[symm] lemma is_rotated.symm (h : l ~r l') : l' ~r l :=
begin
  obtain ⟨n, rfl⟩ := h,
  cases l with hd tl,
  { simp },
  { use (hd :: tl).length * n - n,
    rw [rotate_rotate, add_tsub_cancel_of_le, rotate_length_mul],
    exact nat.le_mul_of_pos_left (by simp) }
end

lemma is_rotated_comm : l ~r l' ↔ l' ~r l :=
⟨is_rotated.symm, is_rotated.symm⟩

@[simp] protected lemma is_rotated.forall (l : list α) (n : ℕ) : l.rotate n ~r l :=
is_rotated.symm ⟨n, rfl⟩

@[trans] lemma is_rotated.trans {l'' : list α} (h : l ~r l') (h' : l' ~r l'') :
  l ~r l'' :=
begin
  obtain ⟨n, rfl⟩ := h,
  obtain ⟨m, rfl⟩ := h',
  rw rotate_rotate,
  use (n + m)
end

lemma is_rotated.eqv : equivalence (@is_rotated α) :=
mk_equivalence _ is_rotated.refl (λ _ _, is_rotated.symm) (λ _ _ _, is_rotated.trans)

/-- The relation `list.is_rotated l l'` forms a `setoid` of cycles. -/
def is_rotated.setoid (α : Type*) : setoid (list α) :=
{ r := is_rotated, iseqv := is_rotated.eqv }

lemma is_rotated.perm (h : l ~r l') : l ~ l' :=
exists.elim h (λ _ hl, hl ▸ (rotate_perm _ _).symm)

lemma is_rotated.nodup_iff (h : l ~r l') : nodup l ↔ nodup l' :=
h.perm.nodup_iff

lemma is_rotated.mem_iff (h : l ~r l') {a : α} : a ∈ l ↔ a ∈ l' :=
h.perm.mem_iff

@[simp] lemma is_rotated_nil_iff : l ~r [] ↔ l = [] :=
⟨λ ⟨n, hn⟩, by simpa using hn, λ h, h ▸ by refl⟩

@[simp] lemma is_rotated_nil_iff' : [] ~r l ↔ [] = l :=
by rw [is_rotated_comm, is_rotated_nil_iff, eq_comm]

@[simp] lemma is_rotated_singleton_iff {x : α} : l ~r [x] ↔ l = [x] :=
⟨λ ⟨n, hn⟩, by simpa using hn, λ h, h ▸ by refl⟩

@[simp] lemma is_rotated_singleton_iff' {x : α} : [x] ~r l ↔ [x] = l :=
by rw [is_rotated_comm, is_rotated_singleton_iff, eq_comm]

lemma is_rotated_concat (hd : α) (tl : list α) :
  (tl ++ [hd]) ~r (hd :: tl) :=
is_rotated.symm ⟨1, by simp⟩

lemma is_rotated_append : (l ++ l') ~r (l' ++ l) :=
⟨l.length, by simp⟩

lemma is_rotated.reverse (h : l ~r l') : l.reverse ~r l'.reverse :=
begin
  obtain ⟨n, rfl⟩ := h,
  exact ⟨_, (reverse_rotate _ _).symm⟩
end

lemma is_rotated_reverse_comm_iff :
  l.reverse ~r l' ↔ l ~r l'.reverse :=
begin
  split;
  { intro h,
    simpa using h.reverse }
end

@[simp] lemma is_rotated_reverse_iff :
  l.reverse ~r l'.reverse ↔ l ~r l' :=
by simp [is_rotated_reverse_comm_iff]

lemma is_rotated_iff_mod : l ~r l' ↔ ∃ n ≤ l.length, l.rotate n = l' :=
begin
  refine ⟨λ h, _, λ ⟨n, _, h⟩, ⟨n, h⟩⟩,
  obtain ⟨n, rfl⟩ := h,
  cases l with hd tl,
  { simp },
  { refine ⟨n % (hd :: tl).length, _, rotate_mod _ _⟩,
    refine (nat.mod_lt _ _).le,
    simp }
end

lemma is_rotated_iff_mem_map_range : l ~r l' ↔ l' ∈ (list.range (l.length + 1)).map l.rotate :=
begin
  simp_rw [mem_map, mem_range, is_rotated_iff_mod],
  exact ⟨λ ⟨n, hn, h⟩, ⟨n, nat.lt_succ_of_le hn, h⟩, λ ⟨n, hn, h⟩, ⟨n, nat.le_of_lt_succ hn, h⟩⟩
end

@[congr] theorem is_rotated.map {β : Type*} {l₁ l₂ : list α} (h : l₁ ~r l₂) (f : α → β) :
  map f l₁ ~r map f l₂ :=
begin
  obtain ⟨n, rfl⟩ := h,
  rw map_rotate,
  use n
end

/-- List of all cyclic permutations of `l`.
The `cyclic_permutations` of a nonempty list `l` will always contain `list.length l` elements.
This implies that under certain conditions, there are duplicates in `list.cyclic_permutations l`.
The `n`th entry is equal to `l.rotate n`, proven in `list.nth_le_cyclic_permutations`.
The proof that every cyclic permutant of `l` is in the list is `list.mem_cyclic_permutations_iff`.

     cyclic_permutations [1, 2, 3, 2, 4] =
       [[1, 2, 3, 2, 4], [2, 3, 2, 4, 1], [3, 2, 4, 1, 2],
        [2, 4, 1, 2, 3], [4, 1, 2, 3, 2]] -/
def cyclic_permutations : list α → list (list α)
| []         := [[]]
| l@(_ :: _) := init (zip_with (++) (tails l) (inits l))

@[simp] lemma cyclic_permutations_nil : cyclic_permutations ([] : list α) = [[]] := rfl

lemma cyclic_permutations_cons (x : α) (l : list α) :
  cyclic_permutations (x :: l) = init (zip_with (++) (tails (x :: l)) (inits (x :: l))) := rfl

lemma cyclic_permutations_of_ne_nil (l : list α) (h : l ≠ []) :
  cyclic_permutations l = init (zip_with (++) (tails l) (inits l)) :=
begin
  obtain ⟨hd, tl, rfl⟩ := exists_cons_of_ne_nil h,
  exact cyclic_permutations_cons _ _,
end

lemma length_cyclic_permutations_cons (x : α) (l : list α) :
  length (cyclic_permutations (x :: l)) = length l + 1 :=
by simp [cyclic_permutations_of_ne_nil]

@[simp] lemma length_cyclic_permutations_of_ne_nil (l : list α) (h : l ≠ []) :
  length (cyclic_permutations l) = length l :=
by simp [cyclic_permutations_of_ne_nil _ h]

@[simp] lemma nth_le_cyclic_permutations (l : list α) (n : ℕ)
  (hn : n < length (cyclic_permutations l)) :
  nth_le (cyclic_permutations l) n hn = l.rotate n :=
begin
  obtain rfl | h := eq_or_ne l [],
  { simp },
  { rw length_cyclic_permutations_of_ne_nil _ h at hn,
    simp [init_eq_take, cyclic_permutations_of_ne_nil _ h, nth_le_take',
          rotate_eq_drop_append_take hn.le] }
end

lemma mem_cyclic_permutations_self (l : list α) :
  l ∈ cyclic_permutations l :=
begin
  cases l with x l,
  { simp },
  { rw mem_iff_nth_le,
    refine ⟨0, by simp, _⟩,
    simp }
end

lemma length_mem_cyclic_permutations (l : list α) (h : l' ∈ cyclic_permutations l) :
  length l' = length l :=
begin
  obtain ⟨k, hk, rfl⟩ := nth_le_of_mem h,
  simp
end

@[simp] lemma mem_cyclic_permutations_iff {l l' : list α} :
  l ∈ cyclic_permutations l' ↔ l ~r l' :=
begin
  split,
  { intro h,
    obtain ⟨k, hk, rfl⟩ := nth_le_of_mem h,
    simp },
  { intro h,
    obtain ⟨k, rfl⟩ := h.symm,
    rw mem_iff_nth_le,
    simp only [exists_prop, nth_le_cyclic_permutations],
    cases l' with x l,
    { simp },
    { refine ⟨k % length (x :: l), _, rotate_mod _ _⟩,
      simpa using nat.mod_lt _ (zero_lt_succ _) } }
end

@[simp] lemma cyclic_permutations_eq_nil_iff {l : list α} :
  cyclic_permutations l = [[]] ↔ l = [] :=
begin
  refine ⟨λ h, _, λ h, by simp [h]⟩,
  rw [eq_comm, ←is_rotated_nil_iff', ←mem_cyclic_permutations_iff, h, mem_singleton]
end

@[simp] lemma cyclic_permutations_eq_singleton_iff {l : list α} {x : α} :
  cyclic_permutations l = [[x]] ↔ l = [x] :=
begin
  refine ⟨λ h, _, λ h, by simp [cyclic_permutations, h, init_eq_take]⟩,
  rw [eq_comm, ←is_rotated_singleton_iff', ←mem_cyclic_permutations_iff, h, mem_singleton]
end

/-- If a `l : list α` is `nodup l`, then all of its cyclic permutants are distinct. -/
lemma nodup.cyclic_permutations {l : list α} (hn : nodup l) :
  nodup (cyclic_permutations l) :=
begin
  cases l with x l,
  { simp },
  rw nodup_iff_nth_le_inj,
  intros i j hi hj h,
  simp only [length_cyclic_permutations_cons] at hi hj,
  rw [←mod_eq_of_lt hi, ←mod_eq_of_lt hj, ←length_cons x l],
  apply hn.rotate_congr,
  { simp },
  { simpa using h }
end

@[simp] lemma cyclic_permutations_rotate (l : list α) (k : ℕ) :
  (l.rotate k).cyclic_permutations = l.cyclic_permutations.rotate k :=
begin
  have : (l.rotate k).cyclic_permutations.length = length (l.cyclic_permutations.rotate k),
  { cases l,
    { simp },
    { rw length_cyclic_permutations_of_ne_nil;
      simp } },
  refine ext_le this (λ n hn hn', _),
  rw [nth_le_cyclic_permutations, nth_le_rotate, nth_le_cyclic_permutations,
      rotate_rotate, ←rotate_mod, add_comm],
  cases l;
  simp
end

lemma is_rotated.cyclic_permutations {l l' : list α} (h : l ~r l') :
  l.cyclic_permutations ~r l'.cyclic_permutations :=
begin
  obtain ⟨k, rfl⟩ := h,
  exact ⟨k, by simp⟩
end

@[simp] lemma is_rotated_cyclic_permutations_iff {l l' : list α} :
  l.cyclic_permutations ~r l'.cyclic_permutations ↔ l ~r l' :=
begin
  by_cases hl : l = [],
  { simp [hl, eq_comm] },
  have hl' : l.cyclic_permutations.length = l.length := length_cyclic_permutations_of_ne_nil _ hl,
  refine ⟨λ h, _, is_rotated.cyclic_permutations⟩,
  obtain ⟨k, hk⟩ := h,
  refine ⟨k % l.length, _⟩,
  have hk' : k % l.length < l.length := mod_lt _ (length_pos_of_ne_nil hl),
  rw [←nth_le_cyclic_permutations _ _ (hk'.trans_le hl'.ge), ←nth_le_rotate' _ k],
  simp [hk, hl', tsub_add_cancel_of_le hk'.le]
end

section decidable

variables [decidable_eq α]

instance is_rotated_decidable (l l' : list α) : decidable (l ~r l') :=
decidable_of_iff' _ is_rotated_iff_mem_map_range

instance {l l' : list α} : decidable (@setoid.r _ (is_rotated.setoid α) l l') :=
list.is_rotated_decidable _ _

end decidable

end is_rotated

end list


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Johan Commelin
-/
import algebra.hom.equiv
import algebra.ring.basic
import logic.equiv.basic
import logic.equiv.option

/-!
# Adjoining a zero/one to semigroups and related algebraic structures

This file contains different results about adjoining an element to an algebraic structure which then
behaves like a zero or a one. An example is adjoining a one to a semigroup to obtain a monoid. That
this provides an example of an adjunction is proved in `algebra.category.Mon.adjunctions`.

Another result says that adjoining to a group an element `zero` gives a `group_with_zero`. For more
information about these structures (which are not that standard in informal mathematics, see
`algebra.group_with_zero.basic`)
-/

universes u v w
variables {α : Type u} {β : Type v} {γ : Type w}

/-- Add an extra element `1` to a type -/
@[to_additive "Add an extra element `0` to a type"]
def with_one (α) := option α

namespace with_one

instance [has_repr α] : has_repr (with_zero α) :=
⟨λ o, match o with | none := "0" | (some a) := "↑" ++ repr a end⟩

@[to_additive]
instance [has_repr α] : has_repr (with_one α) :=
⟨λ o, match o with | none := "1" | (some a) := "↑" ++ repr a end⟩

@[to_additive]
instance : monad with_one := option.monad

@[to_additive]
instance : has_one (with_one α) := ⟨none⟩

@[to_additive]
instance [has_mul α] : has_mul (with_one α) := ⟨option.lift_or_get (*)⟩

@[to_additive] instance [has_inv α] : has_inv (with_one α) := ⟨λ a, option.map has_inv.inv a⟩

@[to_additive] instance [has_involutive_inv α] : has_involutive_inv (with_one α) :=
{ inv_inv := λ a, (option.map_map _ _ _).trans $ by simp_rw [inv_comp_inv, option.map_id, id],
  ..with_one.has_inv }

@[to_additive]
instance : inhabited (with_one α) := ⟨1⟩

@[to_additive]
instance [nonempty α] : nontrivial (with_one α) := option.nontrivial

@[to_additive]
instance : has_coe_t α (with_one α) := ⟨some⟩

/-- Recursor for `with_one` using the preferred forms `1` and `↑a`. -/
@[elab_as_eliminator,
  to_additive "Recursor for `with_zero` using the preferred forms `0` and `↑a`."]
def rec_one_coe {C : with_one α → Sort*} (h₁ : C 1) (h₂ : Π (a : α), C a) :
  Π (n : with_one α), C n :=
option.rec h₁ h₂

@[to_additive]
lemma some_eq_coe {a : α} : (some a : with_one α) = ↑a := rfl

@[simp, to_additive]
lemma coe_ne_one {a : α} : (a : with_one α) ≠ (1 : with_one α) :=
option.some_ne_none a

@[simp, to_additive]
lemma one_ne_coe {a : α} : (1 : with_one α) ≠ a :=
coe_ne_one.symm

@[to_additive]
lemma ne_one_iff_exists {x : with_one α} : x ≠ 1 ↔ ∃ (a : α), ↑a = x :=
option.ne_none_iff_exists

@[to_additive]
instance : can_lift (with_one α) α :=
{ coe := coe,
  cond := λ a, a ≠ 1,
  prf := λ a, ne_one_iff_exists.1 }

@[simp, norm_cast, to_additive]
lemma coe_inj {a b : α} : (a : with_one α) = b ↔ a = b :=
option.some_inj

@[elab_as_eliminator, to_additive]
protected lemma cases_on {P : with_one α → Prop} :
  ∀ (x : with_one α), P 1 → (∀ a : α, P a) → P x :=
option.cases_on

-- the `show` statements in the proofs are important, because otherwise the generated lemmas
-- `with_one.mul_one_class._proof_{1,2}` have an ill-typed statement after `with_one` is made
-- irreducible.
@[to_additive]
instance [has_mul α] : mul_one_class (with_one α) :=
{ mul := (*),
  one := (1),
  one_mul   := show ∀ x : with_one α, 1 * x = x, from (option.lift_or_get_is_left_id _).1,
  mul_one   := show ∀ x : with_one α, x * 1 = x, from (option.lift_or_get_is_right_id _).1 }

@[to_additive]
instance [semigroup α] : monoid (with_one α) :=
{ mul_assoc := (option.lift_or_get_assoc _).1,
  ..with_one.mul_one_class }

example [semigroup α] :
  @monoid.to_mul_one_class _ (@with_one.monoid α _) = @with_one.mul_one_class α _ := rfl

@[to_additive]
instance [comm_semigroup α] : comm_monoid (with_one α) :=
{ mul_comm := (option.lift_or_get_comm _).1,
  ..with_one.monoid }

section
-- workaround: we make `with_one`/`with_zero` irreducible for this definition, otherwise `simps`
-- will unfold it in the statement of the lemma it generates.
local attribute [irreducible] with_one with_zero
/-- `coe` as a bundled morphism -/
@[to_additive "`coe` as a bundled morphism", simps apply]
def coe_mul_hom [has_mul α] : α →ₙ* (with_one α) :=
{ to_fun := coe, map_mul' := λ x y, rfl }

end

section lift

variables [has_mul α] [mul_one_class β]

/-- Lift a semigroup homomorphism `f` to a bundled monoid homorphism. -/
@[to_additive "Lift an add_semigroup homomorphism `f` to a bundled add_monoid homorphism."]
def lift : (α →ₙ* β) ≃ (with_one α →* β) :=
{ to_fun := λ f,
  { to_fun := λ x, option.cases_on x 1 f,
    map_one' := rfl,
    map_mul' := λ x y,
      with_one.cases_on x (by { rw one_mul, exact (one_mul _).symm }) $ λ x,
      with_one.cases_on y (by { rw mul_one, exact (mul_one _).symm }) $ λ y,
      f.map_mul x y },
  inv_fun := λ F, F.to_mul_hom.comp coe_mul_hom,
  left_inv := λ f, mul_hom.ext $ λ x, rfl,
  right_inv := λ F, monoid_hom.ext $ λ x, with_one.cases_on x F.map_one.symm $ λ x, rfl }

variables (f : α →ₙ* β)

@[simp, to_additive]
lemma lift_coe (x : α) : lift f x = f x := rfl

@[simp, to_additive]
lemma lift_one : lift f 1 = 1 := rfl

@[to_additive]
theorem lift_unique (f : with_one α →* β) : f = lift (f.to_mul_hom.comp coe_mul_hom) :=
(lift.apply_symm_apply f).symm

end lift

attribute [irreducible] with_one

section map

variables [has_mul α] [has_mul β] [has_mul γ]

/-- Given a multiplicative map from `α → β` returns a monoid homomorphism
  from `with_one α` to `with_one β` -/
@[to_additive "Given an additive map from `α → β` returns an add_monoid homomorphism
  from `with_zero α` to `with_zero β`"]
def map (f : α →ₙ* β) : with_one α →* with_one β :=
lift (coe_mul_hom.comp f)

@[simp, to_additive] lemma map_coe (f : α →ₙ* β) (a : α) : map f (a : with_one α) = f a :=
lift_coe _ _

@[simp, to_additive]
lemma map_id : map (mul_hom.id α) = monoid_hom.id (with_one α) :=
by { ext, induction x using with_one.cases_on; refl }

@[to_additive]
lemma map_map (f : α →ₙ* β) (g : β →ₙ* γ) (x) :
  map g (map f x) = map (g.comp f) x :=
by { induction x using with_one.cases_on; refl }

@[simp, to_additive]
lemma map_comp (f : α →ₙ* β) (g : β →ₙ* γ) :
  map (g.comp f) = (map g).comp (map f) :=
monoid_hom.ext $ λ x, (map_map f g x).symm

/-- A version of `equiv.option_congr` for `with_one`. -/
@[to_additive "A version of `equiv.option_congr` for `with_zero`.", simps apply]
def _root_.mul_equiv.with_one_congr (e : α ≃* β) : with_one α ≃* with_one β :=
{ to_fun := map e.to_mul_hom,
  inv_fun := map e.symm.to_mul_hom,
  left_inv := λ x, (map_map _ _ _).trans $ by induction x using with_one.cases_on; { simp },
  right_inv := λ x, (map_map _ _ _).trans $ by induction x using with_one.cases_on; { simp },
  .. map e.to_mul_hom }

@[simp]
lemma _root_.mul_equiv.with_one_congr_refl : (mul_equiv.refl α).with_one_congr = mul_equiv.refl _ :=
mul_equiv.to_monoid_hom_injective map_id

@[simp]
lemma _root_.mul_equiv.with_one_congr_symm (e : α ≃* β) :
  e.with_one_congr.symm = e.symm.with_one_congr := rfl

@[simp]
lemma _root_.mul_equiv.with_one_congr_trans (e₁ : α ≃* β) (e₂ : β ≃* γ) :
  e₁.with_one_congr.trans e₂.with_one_congr = (e₁.trans e₂).with_one_congr :=
mul_equiv.to_monoid_hom_injective (map_comp _ _).symm

end map

@[simp, norm_cast, to_additive]
lemma coe_mul [has_mul α] (a b : α) : ((a * b : α) : with_one α) = a * b := rfl

@[simp, norm_cast, to_additive]
lemma coe_inv [has_inv α] (a : α) : ((a⁻¹ : α) : with_one α) = a⁻¹ := rfl

end with_one

namespace with_zero

instance [one : has_one α] : has_one (with_zero α) :=
{ ..one }

@[simp, norm_cast] lemma coe_one [has_one α] : ((1 : α) : with_zero α) = 1 := rfl

instance [has_mul α] : mul_zero_class (with_zero α) :=
{ mul       := λ o₁ o₂, o₁.bind (λ a, option.map (λ b, a * b) o₂),
  zero_mul  := λ a, rfl,
  mul_zero  := λ a, by cases a; refl,
  ..with_zero.has_zero }

@[simp, norm_cast] lemma coe_mul {α : Type u} [has_mul α]
  {a b : α} : ((a * b : α) : with_zero α) = a * b := rfl

@[simp] lemma zero_mul {α : Type u} [has_mul α]
  (a : with_zero α) : 0 * a = 0 := rfl

@[simp] lemma mul_zero {α : Type u} [has_mul α]
  (a : with_zero α) : a * 0 = 0 := by cases a; refl

instance [has_mul α] : no_zero_divisors (with_zero α) :=
⟨by { rintro (a|a) (b|b) h, exacts [or.inl rfl, or.inl rfl, or.inr rfl, option.no_confusion h] }⟩

instance [semigroup α] : semigroup_with_zero (with_zero α) :=
{ mul_assoc := λ a b c, match a, b, c with
    | none,   _,      _      := rfl
    | some a, none,   _      := rfl
    | some a, some b, none   := rfl
    | some a, some b, some c := congr_arg some (mul_assoc _ _ _)
    end,
  ..with_zero.mul_zero_class }

instance [comm_semigroup α] : comm_semigroup (with_zero α) :=
{ mul_comm := λ a b, match a, b with
    | none,   _      := (mul_zero _).symm
    | some a, none   := rfl
    | some a, some b := congr_arg some (mul_comm _ _)
    end,
  ..with_zero.semigroup_with_zero }

instance [mul_one_class α] : mul_zero_one_class (with_zero α) :=
{ one_mul := λ a, match a with
    | none   := rfl
    | some a := congr_arg some $ one_mul _
    end,
  mul_one := λ a, match a with
    | none   := rfl
    | some a := congr_arg some $ mul_one _
    end,
  ..with_zero.mul_zero_class,
  ..with_zero.has_one }

instance [has_one α] [has_pow α ℕ] : has_pow (with_zero α) ℕ :=
⟨λ x n, match x, n with
  | none, 0 := 1
  | none, n + 1 := 0
  | some x, n := ↑(x ^ n)
  end⟩

@[simp, norm_cast] lemma coe_pow [has_one α] [has_pow α ℕ] {a : α} (n : ℕ) :
  ↑(a ^ n : α) = (↑a ^ n : with_zero α) := rfl

instance [monoid α] : monoid_with_zero (with_zero α) :=
{ npow := λ n x, x ^ n,
  npow_zero' := λ x, match x with
    | none   := rfl
    | some x := congr_arg some $ pow_zero _
    end,
  npow_succ' := λ n x, match x with
    | none   := rfl
    | some x := congr_arg some $ pow_succ _ _
    end,
  .. with_zero.mul_zero_one_class,
  .. with_zero.semigroup_with_zero }

instance [comm_monoid α] : comm_monoid_with_zero (with_zero α) :=
{ ..with_zero.monoid_with_zero, ..with_zero.comm_semigroup }

/-- Given an inverse operation on `α` there is an inverse operation
  on `with_zero α` sending `0` to `0`-/
instance [has_inv α] : has_inv (with_zero α) := ⟨λ a, option.map has_inv.inv a⟩

@[simp, norm_cast] lemma coe_inv [has_inv α] (a : α) : ((a⁻¹ : α) : with_zero α) = a⁻¹ := rfl

@[simp] lemma inv_zero [has_inv α] : (0 : with_zero α)⁻¹ = 0 := rfl

instance [has_involutive_inv α] : has_involutive_inv (with_zero α) :=
{ inv_inv := λ a, (option.map_map _ _ _).trans $ by simp_rw [inv_comp_inv, option.map_id, id],
  ..with_zero.has_inv }

instance [has_div α] : has_div (with_zero α) :=
⟨λ o₁ o₂, o₁.bind (λ a, option.map (λ b, a / b) o₂)⟩

@[norm_cast] lemma coe_div [has_div α] (a b : α) : ↑(a / b : α) = (a / b : with_zero α) := rfl

instance [has_one α] [has_pow α ℤ] : has_pow (with_zero α) ℤ :=
⟨λ x n, match x, n with
  | none, int.of_nat 0            := 1
  | none, int.of_nat (nat.succ n) := 0
  | none, int.neg_succ_of_nat n   := 0
  | some x, n                     := ↑(x ^ n)
  end⟩

@[simp, norm_cast] lemma coe_zpow [div_inv_monoid α] {a : α} (n : ℤ) :
  ↑(a ^ n : α) = (↑a ^ n : with_zero α) := rfl

instance [div_inv_monoid α] : div_inv_monoid (with_zero α) :=
{ div_eq_mul_inv := λ a b, match a, b with
    | none,   _      := rfl
    | some a, none   := rfl
    | some a, some b := congr_arg some (div_eq_mul_inv _ _)
    end,
  zpow := λ n x, x ^ n,
  zpow_zero' := λ x, match x with
    | none   := rfl
    | some x := congr_arg some $ zpow_zero _
    end,
  zpow_succ' := λ n x, match x with
    | none   := rfl
    | some x := congr_arg some $ div_inv_monoid.zpow_succ' _ _
    end,
  zpow_neg' := λ n x, match x with
    | none   := rfl
    | some x := congr_arg some $ div_inv_monoid.zpow_neg' _ _
    end,
  .. with_zero.has_div,
  .. with_zero.has_inv,
  .. with_zero.monoid_with_zero, }

instance [division_monoid α] : division_monoid (with_zero α) :=
{ mul_inv_rev := λ a b, match a, b with
    | none,   none   := rfl
    | none,   some b := rfl
    | some a, none   := rfl
    | some a, some b := congr_arg some $ mul_inv_rev _ _
    end,
  inv_eq_of_mul := λ a b, match a, b with
    | none,   none   := λ _, rfl
    | none,   some b := by contradiction
    | some a, none   := by contradiction
    | some a, some b := λ h, congr_arg some $ inv_eq_of_mul_eq_one_right $ option.some_injective _ h
    end,
  .. with_zero.div_inv_monoid, .. with_zero.has_involutive_inv }

instance [division_comm_monoid α] : division_comm_monoid (with_zero α) :=
{ .. with_zero.division_monoid, .. with_zero.comm_semigroup }

section group
variables [group α]

@[simp] lemma inv_one : (1 : with_zero α)⁻¹ = 1 :=
show ((1⁻¹ : α) : with_zero α) = 1, by simp

/-- if `G` is a group then `with_zero G` is a group with zero. -/
instance : group_with_zero (with_zero α) :=
{ inv_zero := inv_zero,
  mul_inv_cancel := λ a ha, by { lift a to α using ha, norm_cast, apply mul_right_inv },
  .. with_zero.monoid_with_zero,
  .. with_zero.div_inv_monoid,
  .. with_zero.nontrivial }

end group

instance [comm_group α] : comm_group_with_zero (with_zero α) :=
{ .. with_zero.group_with_zero, .. with_zero.comm_monoid_with_zero }

instance [add_monoid_with_one α] : add_monoid_with_one (with_zero α) :=
{ nat_cast := λ n, if n = 0 then 0 else (n.cast : α),
  nat_cast_zero := rfl,
  nat_cast_succ := λ n, begin
    cases n,
    show (((1 : ℕ) : α) : with_zero α) = 0 + 1, by rw [nat.cast_one, coe_one, zero_add],
    show (((n + 2 : ℕ) : α) : with_zero α) = ((n + 1 : ℕ) : α) + 1,
    by rw [nat.cast_succ, coe_add, coe_one],
  end,
  .. with_zero.add_monoid, ..with_zero.has_one }

instance [semiring α] : semiring (with_zero α) :=
{ left_distrib := λ a b c, begin
    cases a with a, {refl},
    cases b with b; cases c with c; try {refl},
    exact congr_arg some (left_distrib _ _ _)
  end,
  right_distrib := λ a b c, begin
    cases c with c,
    { change (a + b) * 0 = a * 0 + b * 0, simp },
    cases a with a; cases b with b; try {refl},
    exact congr_arg some (right_distrib _ _ _)
  end,
  ..with_zero.add_monoid_with_one,
  ..with_zero.add_comm_monoid,
  ..with_zero.mul_zero_class,
  ..with_zero.monoid_with_zero }

attribute [irreducible] with_zero

end with_zero