/-
Copyright (c) 2019 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Yury Kudryashov
-/
import data.list.big_operators

/-!
# Free monoid over a given alphabet

## Main definitions

* `free_monoid α`: free monoid over alphabet `α`; defined as a synonym for `list α`
  with multiplication given by `(++)`.
* `free_monoid.of`: embedding `α → free_monoid α` sending each element `x` to `[x]`;
* `free_monoid.lift`: natural equivalence between `α → M` and `free_monoid α →* M`
* `free_monoid.map`: embedding of `α → β` into `free_monoid α →* free_monoid β` given by `list.map`.
-/

variables {α : Type*} {β : Type*} {γ : Type*} {M : Type*} [monoid M] {N : Type*} [monoid N]

/-- Free monoid over a given alphabet. -/
@[to_additive "Free nonabelian additive monoid over a given alphabet"]
def free_monoid (α) := list α

namespace free_monoid

@[to_additive]
instance : monoid (free_monoid α) :=
{ one := [],
  mul := λ x y, (x ++ y : list α),
  mul_one := by intros; apply list.append_nil,
  one_mul := by intros; refl,
  mul_assoc := by intros; apply list.append_assoc }

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

@[to_additive]
lemma one_def : (1 : free_monoid α) = [] := rfl

@[to_additive]
lemma mul_def (xs ys : list α) : (xs * ys : free_monoid α) = (xs ++ ys : list α) :=
rfl

/-- Embeds an element of `α` into `free_monoid α` as a singleton list. -/
@[to_additive "Embeds an element of `α` into `free_add_monoid α` as a singleton list." ]
def of (x : α) : free_monoid α := [x]

@[to_additive]
lemma of_def (x : α) : of x = [x] := rfl

@[to_additive]
lemma of_injective : function.injective (@of α) :=
λ a b, list.head_eq_of_cons_eq

/-- Recursor for `free_monoid` using `1` and `of x * xs` instead of `[]` and `x :: xs`. -/
@[elab_as_eliminator, to_additive
  "Recursor for `free_add_monoid` using `0` and `of x + xs` instead of `[]` and `x :: xs`."]
def rec_on {C : free_monoid α → Sort*} (xs : free_monoid α) (h0 : C 1)
  (ih : Π x xs, C xs → C (of x * xs)) : C xs := list.rec_on xs h0 ih

@[ext, to_additive]
lemma hom_eq ⦃f g : free_monoid α →* M⦄ (h : ∀ x, f (of x) = g (of x)) :
  f = g :=
monoid_hom.ext $ λ l, rec_on l (f.map_one.trans g.map_one.symm) $
  λ x xs hxs, by simp only [h, hxs, monoid_hom.map_mul]

/-- Equivalence between maps `α → M` and monoid homomorphisms `free_monoid α →* M`. -/
@[to_additive "Equivalence between maps `α → A` and additive monoid homomorphisms
`free_add_monoid α →+ A`."]
def lift : (α → M) ≃ (free_monoid α →* M) :=
{ to_fun := λ f, ⟨λ l, (l.map f).prod, rfl,
    λ l₁ l₂, by simp only [mul_def, list.map_append, list.prod_append]⟩,
  inv_fun := λ f x, f (of x),
  left_inv := λ f, funext $ λ x, one_mul (f x),
  right_inv := λ f, hom_eq $ λ x, one_mul (f (of x)) }

@[simp, to_additive]
lemma lift_symm_apply (f : free_monoid α →* M) : lift.symm f = f ∘ of := rfl

@[to_additive]
lemma lift_apply (f : α → M) (l : free_monoid α) : lift f l = (l.map f).prod := rfl

@[to_additive]
lemma lift_comp_of (f : α → M) : (lift f) ∘ of = f := lift.symm_apply_apply f

@[simp, to_additive]
lemma lift_eval_of (f : α → M) (x : α) : lift f (of x) = f x :=
congr_fun (lift_comp_of f) x

@[simp, to_additive]
lemma lift_restrict (f : free_monoid α →* M) : lift (f ∘ of) = f :=
lift.apply_symm_apply f

@[to_additive]
lemma comp_lift (g : M →* N) (f : α → M) : g.comp (lift f) = lift (g ∘ f) :=
by { ext, simp }

@[to_additive]
lemma hom_map_lift (g : M →* N) (f : α → M) (x : free_monoid α) : g (lift f x) = lift (g ∘ f) x :=
monoid_hom.ext_iff.1 (comp_lift g f) x

/-- The unique monoid homomorphism `free_monoid α →* free_monoid β` that sends
each `of x` to `of (f x)`. -/
@[to_additive "The unique additive monoid homomorphism `free_add_monoid α →+ free_add_monoid β`
that sends each `of x` to `of (f x)`."]
def map (f : α → β) : free_monoid α →* free_monoid β :=
{ to_fun := list.map f,
  map_one' := rfl,
  map_mul' := λ l₁ l₂, list.map_append _ _ _ }

@[simp, to_additive] lemma map_of (f : α → β) (x : α) : map f (of x) = of (f x) := rfl

@[to_additive]
lemma lift_of_comp_eq_map (f : α → β) :
  lift (λ x, of (f x)) = map f :=
hom_eq $ λ x, rfl

@[to_additive]
lemma map_comp (g : β → γ) (f : α → β) : map (g ∘ f) = (map g).comp (map f) :=
hom_eq $ λ x, rfl

end free_monoid


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

/-!
# Pointwise order on finitely supported dependent functions

This file lifts order structures on the `α i` to `Π₀ i, α i`.

## Main declarations

* `dfinsupp.order_embedding_to_fun`: The order embedding from finitely supported dependent functions
  to functions.

## TODO

Add `is_well_order (Π₀ i, α i) (<)`.
-/

open_locale big_operators

open finset

variables {ι : Type*} {α : ι → Type*}

namespace dfinsupp

/-! ### Order structures -/

section has_zero
variables (α) [Π i, has_zero (α i)]

section has_le
variables [Π i, has_le (α i)]

instance : has_le (Π₀ i, α i) := ⟨λ f g, ∀ i, f i ≤ g i⟩

variables {α}

lemma le_def {f g : Π₀ i, α i} : f ≤ g ↔ ∀ i, f i ≤ g i := iff.rfl

/-- The order on `dfinsupp`s over a partial order embeds into the order on functions -/
def order_embedding_to_fun : (Π₀ i, α i) ↪o Π i, α i :=
{ to_fun := λ f, f,
  inj' := λ f g h, dfinsupp.ext $ λ i, by { dsimp at h, rw h },
  map_rel_iff' := λ a b, (@le_def _ _ _ _ a b).symm }

@[simp] lemma order_embedding_to_fun_apply {f : Π₀ i, α i} {i : ι} :
  order_embedding_to_fun f i = f i := rfl

end has_le

section preorder
variables [Π i, preorder (α i)]

instance : preorder (Π₀ i, α i) :=
{ le_refl := λ f i, le_rfl,
  le_trans := λ f g h hfg hgh i, (hfg i).trans (hgh i),
  .. dfinsupp.has_le α }

end preorder

instance [Π i, partial_order (α i)] : partial_order (Π₀ i, α i) :=
{ le_antisymm := λ f g hfg hgf, ext $ λ i, (hfg i).antisymm (hgf i),
  .. dfinsupp.preorder α}

instance [Π i, semilattice_inf (α i)] : semilattice_inf (Π₀ i, α i) :=
{ inf := zip_with (λ _, (⊓)) (λ _, inf_idem),
  inf_le_left := λ f g i, by { rw zip_with_apply, exact inf_le_left },
  inf_le_right := λ f g i, by { rw zip_with_apply, exact inf_le_right },
  le_inf := λ f g h hf hg i, by { rw zip_with_apply, exact le_inf (hf i) (hg i) },
  ..dfinsupp.partial_order α }

@[simp] lemma inf_apply [Π i, semilattice_inf (α i)] (f g : Π₀ i, α i) (i : ι) :
  (f ⊓ g) i = f i ⊓ g i :=
zip_with_apply _ _ _ _ _

instance [Π i, semilattice_sup (α i)] : semilattice_sup (Π₀ i, α i) :=
{ sup := zip_with (λ _, (⊔)) (λ _, sup_idem),
  le_sup_left := λ f g i, by { rw zip_with_apply, exact le_sup_left },
  le_sup_right := λ f g i, by { rw zip_with_apply, exact le_sup_right },
  sup_le := λ f g h hf hg i, by { rw zip_with_apply, exact sup_le (hf i) (hg i) },
  ..dfinsupp.partial_order α }

@[simp] lemma sup_apply [Π i, semilattice_sup (α i)] (f g : Π₀ i, α i) (i : ι) :
  (f ⊔ g) i = f i ⊔ g i :=
zip_with_apply _ _ _ _ _

instance lattice [Π i, lattice (α i)] : lattice (Π₀ i, α i) :=
{ .. dfinsupp.semilattice_inf α, .. dfinsupp.semilattice_sup α }

end has_zero

/-! ### Algebraic order structures -/

instance (α : ι → Type*) [Π i, ordered_add_comm_monoid (α i)] :
  ordered_add_comm_monoid (Π₀ i, α i) :=
{ add_le_add_left := λ a b h c i,
    by { rw [add_apply, add_apply], exact add_le_add_left (h i) (c i) },
  .. dfinsupp.add_comm_monoid, .. dfinsupp.partial_order α }

instance (α : ι → Type*) [Π i, ordered_cancel_add_comm_monoid (α i)] :
  ordered_cancel_add_comm_monoid (Π₀ i, α i) :=
{ le_of_add_le_add_left := λ f g h H i, begin
    specialize H i,
    rw [add_apply, add_apply] at H,
    exact le_of_add_le_add_left H,
  end,
  add_left_cancel := λ f g h H, ext $ λ i, begin
    refine add_left_cancel _,
    exact f i,
    rw [←add_apply, ←add_apply, H],
  end,
  .. dfinsupp.ordered_add_comm_monoid α }

instance [Π i, ordered_add_comm_monoid (α i)] [Π i, contravariant_class (α i) (α i) (+) (≤)] :
  contravariant_class (Π₀ i, α i) (Π₀ i, α i) (+) (≤) :=
⟨λ f g h H i, by { specialize H i, rw [add_apply, add_apply] at H, exact le_of_add_le_add_left H }⟩

section canonically_ordered_add_monoid
variables (α) [Π i, canonically_ordered_add_monoid (α i)]

instance : order_bot (Π₀ i, α i) :=
{ bot := 0,
  bot_le := by simp only [le_def, coe_zero, pi.zero_apply, implies_true_iff, zero_le] }

variables {α}

protected lemma bot_eq_zero : (⊥ : Π₀ i, α i) = 0 := rfl

@[simp] lemma add_eq_zero_iff (f g : Π₀ i, α i) : f + g = 0 ↔ f = 0 ∧ g = 0 :=
by simp [ext_iff, forall_and_distrib]

section le
variables [decidable_eq ι] [Π i (x : α i), decidable (x ≠ 0)] {f g : Π₀ i, α i} {s : finset ι}

lemma le_iff' (hf : f.support ⊆ s) : f ≤ g ↔ ∀ i ∈ s, f i ≤ g i :=
⟨λ h s hs, h s,
λ h s, if H : s ∈ f.support then h s (hf H) else (not_mem_support_iff.1 H).symm ▸ zero_le (g s)⟩

lemma le_iff : f ≤ g ↔ ∀ i ∈ f.support, f i ≤ g i := le_iff' $ subset.refl _

variables (α)

instance decidable_le [Π i, decidable_rel (@has_le.le (α i) _)] :
  decidable_rel (@has_le.le (Π₀ i, α i) _) :=
λ f g, decidable_of_iff _ le_iff.symm

variables {α}

@[simp] lemma single_le_iff {i : ι} {a : α i} : single i a ≤ f ↔ a ≤ f i :=
(le_iff' support_single_subset).trans $ by simp

end le

variables (α) [Π i, has_sub (α i)] [Π i, has_ordered_sub (α i)] {f g : Π₀ i, α i} {i : ι}
  {a b : α i}

/-- This is called `tsub` for truncated subtraction, to distinguish it with subtraction in an
additive group. -/
instance tsub : has_sub (Π₀ i, α i) := ⟨zip_with (λ i m n, m - n) (λ i, tsub_self 0)⟩

variables {α}

lemma tsub_apply (f g : Π₀ i, α i) (i : ι) : (f - g) i = f i - g i := zip_with_apply _ _ _ _ _

@[simp] lemma coe_tsub (f g : Π₀ i, α i) : ⇑(f - g) = f - g := by { ext i, exact tsub_apply f g i }

variables (α)

instance : has_ordered_sub (Π₀ i, α i) :=
⟨λ n m k, forall_congr $ λ i, by { rw [add_apply, tsub_apply], exact tsub_le_iff_right }⟩

instance : canonically_ordered_add_monoid (Π₀ i, α i) :=
{ le_iff_exists_add := λ f g, begin
      refine ⟨λ h, ⟨g - f, _⟩, _⟩,
      { ext i,
        rw [add_apply, tsub_apply],
        exact (add_tsub_cancel_of_le $ h i).symm },
      { rintro ⟨g, rfl⟩ i,
        rw add_apply,
        exact self_le_add_right (f i) (g i) }
    end,
 .. dfinsupp.order_bot α,
 .. dfinsupp.ordered_add_comm_monoid α }

variables {α} [decidable_eq ι]

@[simp] lemma single_tsub : single i (a - b) = single i a - single i b :=
begin
  ext j,
  obtain rfl | h := eq_or_ne i j,
  { rw [tsub_apply, single_eq_same, single_eq_same, single_eq_same] },
  { rw [tsub_apply, single_eq_of_ne h, single_eq_of_ne h, single_eq_of_ne h, tsub_self] }
end

variables [Π i (x : α i), decidable (x ≠ 0)]

lemma support_tsub : (f - g).support ⊆ f.support :=
by simp only [subset_iff, tsub_eq_zero_iff_le, mem_support_iff, ne.def, coe_tsub, pi.sub_apply,
    not_imp_not, zero_le, implies_true_iff] {contextual := tt}

lemma subset_support_tsub : f.support \ g.support ⊆ (f - g).support :=
by simp [subset_iff] {contextual := tt}

end canonically_ordered_add_monoid

section canonically_linear_ordered_add_monoid
variables [Π i, canonically_linear_ordered_add_monoid (α i)] [decidable_eq ι] {f g : Π₀ i, α i}

@[simp] lemma support_inf : (f ⊓ g).support = f.support ∩ g.support :=
begin
  ext,
  simp only [inf_apply, mem_support_iff,  ne.def,
    finset.mem_union, finset.mem_filter, finset.mem_inter],
  simp only [inf_eq_min, ←nonpos_iff_eq_zero, min_le_iff, not_or_distrib],
end

@[simp] lemma support_sup : (f ⊔ g).support = f.support ∪ g.support :=
begin
  ext,
  simp only [finset.mem_union, mem_support_iff, sup_apply, ne.def, ←bot_eq_zero],
  rw [_root_.sup_eq_bot_iff, not_and_distrib],
end

lemma disjoint_iff : disjoint f g ↔ disjoint f.support g.support :=
begin
  rw [disjoint_iff, disjoint_iff, dfinsupp.bot_eq_zero, ← dfinsupp.support_eq_empty,
    dfinsupp.support_inf],
  refl,
end

end canonically_linear_ordered_add_monoid
end dfinsupp


/-
Copyright (c) 2021 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import data.nat.interval
import data.pnat.basic

/-!
# Finite intervals of positive naturals

This file proves that `ℕ+` is a `locally_finite_order` and calculates the cardinality of its
intervals as finsets and fintypes.
-/

open finset pnat

instance : locally_finite_order ℕ+ := subtype.locally_finite_order _

namespace pnat
variables (a b : ℕ+)

lemma Icc_eq_finset_subtype : Icc a b = (Icc (a : ℕ) b).subtype (λ (n : ℕ), 0 < n) := rfl
lemma Ico_eq_finset_subtype : Ico a b = (Ico (a : ℕ) b).subtype (λ (n : ℕ), 0 < n) := rfl
lemma Ioc_eq_finset_subtype : Ioc a b = (Ioc (a : ℕ) b).subtype (λ (n : ℕ), 0 < n) := rfl
lemma Ioo_eq_finset_subtype : Ioo a b = (Ioo (a : ℕ) b).subtype (λ (n : ℕ), 0 < n) := rfl

lemma map_subtype_embedding_Icc : (Icc a b).map (function.embedding.subtype _) = Icc (a : ℕ) b :=
map_subtype_embedding_Icc _ _ _ (λ c _ x hx _ hc _, hc.trans_le hx)

lemma map_subtype_embedding_Ico : (Ico a b).map (function.embedding.subtype _) = Ico (a : ℕ) b :=
map_subtype_embedding_Ico _ _ _ (λ c _ x hx _ hc _, hc.trans_le hx)

lemma map_subtype_embedding_Ioc : (Ioc a b).map (function.embedding.subtype _) = Ioc (a : ℕ) b :=
map_subtype_embedding_Ioc _ _ _ (λ c _ x hx _ hc _, hc.trans_le hx)

lemma map_subtype_embedding_Ioo : (Ioo a b).map (function.embedding.subtype _) = Ioo (a : ℕ) b :=
map_subtype_embedding_Ioo _ _ _ (λ c _ x hx _ hc _, hc.trans_le hx)

@[simp] lemma card_Icc : (Icc a b).card = b + 1 - a :=
by rw [←nat.card_Icc, ←map_subtype_embedding_Icc, card_map]

@[simp] lemma card_Ico : (Ico a b).card = b - a :=
by rw [←nat.card_Ico, ←map_subtype_embedding_Ico, card_map]

@[simp] lemma card_Ioc : (Ioc a b).card = b - a :=
by rw [←nat.card_Ioc, ←map_subtype_embedding_Ioc, card_map]

@[simp] lemma card_Ioo : (Ioo a b).card = b - a - 1 :=
by rw [←nat.card_Ioo, ←map_subtype_embedding_Ioo, card_map]

@[simp] lemma card_fintype_Icc : fintype.card (set.Icc a b) = b + 1 - a :=
by rw [←card_Icc, fintype.card_of_finset]

@[simp] lemma card_fintype_Ico : fintype.card (set.Ico a b) = b - a :=
by rw [←card_Ico, fintype.card_of_finset]

@[simp] lemma card_fintype_Ioc : fintype.card (set.Ioc a b) = b - a :=
by rw [←card_Ioc, fintype.card_of_finset]

@[simp] lemma card_fintype_Ioo : fintype.card (set.Ioo a b) = b - a - 1 :=
by rw [←card_Ioo, fintype.card_of_finset]

end pnat


/-
Copyright (c) 2022 Peter Nelson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Peter Nelson.
-/
import .supermatroid.dual

/-!
# Matroids

In this file we define a `matroid`, namely a subset of the power set of a ground type `E` that is
down-closed, and satisfies certain augmentation axioms; its members are 'independent sets'.

The definition and theory below is for matroids on an arbitrary type `E`, though most of the
literature on matroids deals with the finite case.

## Main content

- `indep`, `dep`, `coindep`, `basis`, `circuit`, `spanning` : predicates of the form `set E → Prop`
  for various matroid properties on sets. Defining these as predicates enables dot notation, but
  most also have an alternative `set (set E)` version which can work more smoothly with some parts
  of mathlib.
- `matroid.dual` : the dual matroid of a matroid `M`; its bases are the complements of the bases
  of `M`.
- `dual_dual`    : duality is idempotent.

## References

See [Oxley] for a general reference of matroids, and [Diestel,et,al] for the specific axiomatization
developed here.

TODO : rank, circuits, theory for finite matroids, etc etc.
-/

universes u v

variables {E : Type u}

def matroid (E : Type u) := supermatroid (set E)

open set

namespace matroid

variables {M : matroid E} {I J B X Y C : set E}

section basic

def indep (M : matroid E) : (set E → Prop) := M.indep
def basis (M : matroid E) : (set E → Prop) := M.basis
def coindep (M : matroid E) : (set E → Prop) := M.coindep
def spanning (M : matroid E) : (set E → Prop) := M.spanning
def circuit (M : matroid E) : (set E → Prop) := M.circuit

lemma empty_indep (M : matroid E): M.indep ∅ := M.bot_indep

lemma indep.indep_of_subset (hI : M.indep I) (hJI : J ⊆ I) : M.indep J := hI.indep_of_le hJI

lemma indep.inter_left_indep (hI : M.indep I) (X : set E) : M.indep (X ∩ I) := hI.inf_left_indep X

lemma indep.inter_right_indep (hI : M.indep I) (X : set E) : M.indep (I ∩ X) := hI.inf_right_indep X

lemma indep.diff_indep (hI : M.indep I) (X : set E) : M.indep (I \ X) := hI.inter_right_indep _

lemma dep.dep_of_supset (hX : M.dep X) (hXY : X ⊆ Y) : M.dep Y := hX.dep_of_lt hXY

lemma indep.extension (hI : M.indep I) (hIX : I ⊆ X) : ∃ J, I ⊆ J ∧ M.basis_of J X :=
hI.le_basis_of hIX

lemma indep.augment (hI : M.indep I) (hI_nb : ¬M.basis I) (hJ : M.basis J) :
  ∃ I', I ⊂ I' ∧ I' ⊆ I ∪ J ∧ M.indep I' :=
hI.augment hI_nb hJ

lemma indep.augment_insert (hI : M.indep I) (hI_nb : ¬ M.basis I) (hJ : M.basis J):
  ∃ x, x ∉ I ∧ x ∈ J ∧ M.indep (I.insert x) :=
begin
  obtain ⟨I', hII', hI'IJ, hI'⟩ := hI.augment hI_nb hJ,
  obtain ⟨x, hxI, hx⟩ :=  ssubset_iff_insert.mp hII',
  refine ⟨x, hxI, _, hI'.indep_of_subset hx⟩,

  have h := mem_of_mem_of_subset
    ((mem_diff x).mpr ⟨(mem_insert x I), hxI⟩)
    (diff_subset_diff_left (hx.trans hI'IJ)),
  simp only [union_diff_left, mem_diff] at h,
  exact h.1,
end

lemma indep.basis_of (hI : M.indep I) (hIX : I ⊆ X) (h : ∀ J, M.indep J → I ⊆ J → J ⊆ X → I = J) :
  M.basis_of I X :=
hI.basis_of hIX h

lemma indep.basis (hI : M.indep I) (h : ∀ J, M.indep J → I ⊆ J → I = J) : M.basis I := hI.basis h

lemma basis.indep (h : M.basis B) : M.indep B := h.1

lemma basis_of.indep (h : M.basis_of B X) : M.indep B := h.1.2

lemma basis_of.subset (h : M.basis_of B X) : B ⊆ X := h.1.1

lemma basis.eq_of_supset_indep (h : M.basis B) (hBI : B ⊆ I) (hI : M.indep I) : B = I :=
h.2 hI hBI

lemma basis.not_indep_of_ssupset (hB : M.basis B) (hBX : B ⊂ X) : ¬ M.indep X :=
hB.not_indep_of_lt hBX

lemma basis_of.ssupset_not_indep (h : M.basis_of B X) (hBY : B ⊂ Y) (hYX : Y ⊆ X) : ¬ M.indep Y :=
h.not_indep_of_lt hBY hYX

lemma basis_of.eq_of_supset_indep (h : M.basis_of B X) (hBY : B ⊆ Y) (hYX : Y ⊆ X) (hY : M.indep Y):
  B = Y :=
h.eq_of_le_indep hBY hYX hY

lemma basis_of.indep_of_subset (hB : M.basis_of B X) (hIB : I ⊆ B)  : M.indep I :=
hB.indep_of_le hIB

lemma basis.basis_of_univ (hB : M.basis B) : M.basis_of B univ := hB.basis_of_top

lemma basis.indep_of_subset (hB : M.basis B) (hIB : I ⊆ B) : M.indep I := hB.indep_of_le hIB

lemma basis.not_basis_of_ssupset (hB : M.basis B) (hBX : B ⊂ X) : ¬M.basis X := hB.lt_not_basis hBX

lemma basis.not_basis_of_ssubset (hB : M.basis B) (hXB : X ⊂ B) : ¬M.basis X :=
hB.not_basis_of_lt hXB

lemma basis_antichain (M : matroid E): is_antichain (⊆) M.basis := M.basis_antichain

lemma circuit.dep (hC : M.circuit C) : ¬ M.indep C := hC.1

lemma circuit.indep_of_ssubset (hC : M.circuit C) (hIC : I ⊂ C) : M.indep I := hC.indep_of_lt hIC

lemma exists_basis_of (M : matroid E) (X : set E) : ∃ I, M.basis_of I X := M.exists_basis_of X

lemma basis_of.basis (hB : M.basis_of B X) (hX : M.spanning X) : M.basis B := hB.basis hX

lemma indep.extend_to_union_basis {I B : set E} (hI: M.indep I) (hB : M.basis B) :
   ∃ B', M.basis B' ∧ I ⊆ B' ∧ B' ⊆ I ∪ B :=
hI.le_basis_sup hB

lemma exists_basis (M : matroid E): ∃ B, M.basis B := M.exists_basis

lemma univ_spanning (M : matroid E) : M.spanning univ := M.top_spanning

lemma indep.extends_to_basis (hI : M.indep I) : ∃ B, I ⊆ B ∧ M.basis B := hI.le_basis

lemma indep_iff_subset_basis {I : set E}: M.indep I ↔ ∃ B, I ⊆ B ∧ M.basis B :=
supermatroid.indep_iff_le_basis

-- rewriting using the above lemma doesn't work here, for some reason.
lemma bases_inj {M₁ M₂ : matroid E} (hB : M₁.basis = M₂.basis) : M₁ = M₂ :=
begin
  ext I, refine ⟨λ h, _, λ h, _⟩,
  all_goals {
    apply indep_iff_subset_basis.mpr, obtain ⟨B,hB₁,hB₂⟩ := indep_iff_subset_basis.mp h,
    refine ⟨B, hB₁, by {try {rwa hB}, try {rwa ←hB},}⟩},
end

end basic

section dual

lemma cobases_eq_image_compl_bases (M : matroid E) :
  M.cobasis = compl '' M.basis :=
by {convert (M.basis_antichain.image_compl.max_lower_closure), simpa [supermatroid.cobasis]}

lemma coindep_iff (M : matroid E) :
   M.coindep X ↔ ∃ B, (M.basis B ∧ X ⊆ Bᶜ) := iff.rfl

lemma coindep.exists_disj_basis (hI : M.coindep I): ∃ B, M.basis B ∧ disjoint I B :=
  exists.elim hI (λ B hB, ⟨B, hB.1, disjoint_iff_subset_compl_right.mpr hB.2⟩)

lemma cobasis_iff_compl_basis (M : matroid E) : M.cobasis B ↔ M.basis Bᶜ :=
M.cobasis_iff_pcompl_basis

lemma empty_coindep (M : matroid E) : M.coindep ∅ :=
M.coindep_iff.mpr (exists.elim (M.exists_basis) (λ B hB, ⟨B, hB, Bᶜ.empty_subset⟩))

lemma coindep.subset (hJ : M.coindep J) (hIJ : I ⊆ J) : M.coindep I :=
M.coindep_iff.mpr (exists.elim (M.coindep_iff.mp hJ) (λ B hB', ⟨B, hB'.1, hIJ.trans hB'.2⟩))

def dual (M : matroid E) : matroid E := M.dual

end dual

end matroid


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

! This file was ported from Lean 3 source module data.fin.interval
! leanprover-community/mathlib commit f93c11933efbc3c2f0299e47b8ff83e9b539cbf6
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Nat.Interval
import Mathlib.Data.Finset.LocallyFinite

/-!
# Finite intervals in `Fin n`

This file proves that `Fin n` is a `LocallyFiniteOrder` and calculates the cardinality of its
intervals as Finsets and Fintypes.
-/

open Finset Fin Function

open BigOperators

variable (n : ℕ)

instance : LocallyFiniteOrder (Fin n) :=
  OrderIso.locallyFiniteOrder Fin.orderIsoSubtype

instance : LocallyFiniteOrderBot (Fin n) :=
  OrderIso.locallyFiniteOrderBot Fin.orderIsoSubtype

instance : ∀ n, LocallyFiniteOrderTop (Fin n)
  | 0 => IsEmpty.toLocallyFiniteOrderTop
  | _ + 1 => inferInstance

namespace Fin

variable {n} (a b : Fin n)

theorem Icc_eq_finset_subtype : Icc a b = (Icc (a : ℕ) b).fin n :=
  rfl
#align fin.Icc_eq_finset_subtype Fin.Icc_eq_finset_subtype

theorem Ico_eq_finset_subtype : Ico a b = (Ico (a : ℕ) b).fin n :=
  rfl
#align fin.Ico_eq_finset_subtype Fin.Ico_eq_finset_subtype

theorem Ioc_eq_finset_subtype : Ioc a b = (Ioc (a : ℕ) b).fin n :=
  rfl
#align fin.Ioc_eq_finset_subtype Fin.Ioc_eq_finset_subtype

theorem Ioo_eq_finset_subtype : Ioo a b = (Ioo (a : ℕ) b).fin n :=
  rfl
#align fin.Ioo_eq_finset_subtype Fin.Ioo_eq_finset_subtype

@[simp]
theorem map_valEmbedding_Icc : (Icc a b).map Fin.valEmbedding = Icc ↑a ↑b := by
  simp [Icc_eq_finset_subtype, Finset.fin, Finset.map_map, Icc_filter_lt_of_lt_right]
#align fin.map_subtype_embedding_Icc Fin.map_valEmbedding_Icc

@[simp]
theorem map_valEmbedding_Ico : (Ico a b).map Fin.valEmbedding = Ico ↑a ↑b := by
  simp [Ico_eq_finset_subtype, Finset.fin, Finset.map_map]
#align fin.map_subtype_embedding_Ico Fin.map_valEmbedding_Ico

@[simp]
theorem map_valEmbedding_Ioc : (Ioc a b).map Fin.valEmbedding = Ioc ↑a ↑b := by
  simp [Ioc_eq_finset_subtype, Finset.fin, Finset.map_map, Ioc_filter_lt_of_lt_right]
#align fin.map_subtype_embedding_Ioc Fin.map_valEmbedding_Ioc

@[simp]
theorem map_valEmbedding_Ioo : (Ioo a b).map Fin.valEmbedding = Ioo ↑a ↑b := by
  simp [Ioo_eq_finset_subtype, Finset.fin, Finset.map_map]
#align fin.map_subtype_embedding_Ioo Fin.map_valEmbedding_Ioo

@[simp]
theorem card_Icc : (Icc a b).card = b + 1 - a := by
  rw [← Nat.card_Icc, ← map_valEmbedding_Icc, card_map]
#align fin.card_Icc Fin.card_Icc

@[simp]
theorem card_Ico : (Ico a b).card = b - a := by
  rw [← Nat.card_Ico, ← map_valEmbedding_Ico, card_map]
#align fin.card_Ico Fin.card_Ico

@[simp]
theorem card_Ioc : (Ioc a b).card = b - a := by
  rw [← Nat.card_Ioc, ← map_valEmbedding_Ioc, card_map]
#align fin.card_Ioc Fin.card_Ioc

@[simp]
theorem card_Ioo : (Ioo a b).card = b - a - 1 := by
  rw [← Nat.card_Ioo, ← map_valEmbedding_Ioo, card_map]
#align fin.card_Ioo Fin.card_Ioo

-- Porting note: simp can prove this
-- @[simp]
theorem card_fintypeIcc : Fintype.card (Set.Icc a b) = b + 1 - a := by
  rw [← card_Icc, Fintype.card_ofFinset]
#align fin.card_fintype_Icc Fin.card_fintypeIcc

-- Porting note: simp can prove this
-- @[simp]
theorem card_fintypeIco : Fintype.card (Set.Ico a b) = b - a := by
  rw [← card_Ico, Fintype.card_ofFinset]
#align fin.card_fintype_Ico Fin.card_fintypeIco

-- Porting note: simp can prove this
-- @[simp]
theorem card_fintypeIoc : Fintype.card (Set.Ioc a b) = b - a := by
  rw [← card_Ioc, Fintype.card_ofFinset]
#align fin.card_fintype_Ioc Fin.card_fintypeIoc

-- Porting note: simp can prove this
-- @[simp]
theorem card_fintypeIoo : Fintype.card (Set.Ioo a b) = b - a - 1 := by
  rw [← card_Ioo, Fintype.card_ofFinset]
#align fin.card_fintype_Ioo Fin.card_fintypeIoo

theorem Ici_eq_finset_subtype : Ici a = (Icc (a : ℕ) n).fin n := by
  ext
  simp
#align fin.Ici_eq_finset_subtype Fin.Ici_eq_finset_subtype

theorem Ioi_eq_finset_subtype : Ioi a = (Ioc (a : ℕ) n).fin n := by
  ext
  simp
#align fin.Ioi_eq_finset_subtype Fin.Ioi_eq_finset_subtype

theorem Iic_eq_finset_subtype : Iic b = (Iic (b : ℕ)).fin n :=
  rfl
#align fin.Iic_eq_finset_subtype Fin.Iic_eq_finset_subtype

theorem Iio_eq_finset_subtype : Iio b = (Iio (b : ℕ)).fin n :=
  rfl
#align fin.Iio_eq_finset_subtype Fin.Iio_eq_finset_subtype

@[simp]
theorem map_valEmbedding_Ici : (Ici a).map Fin.valEmbedding = Icc ↑a (n - 1) := by
  ext x
  simp only [exists_prop, Embedding.coe_subtype, mem_Ici, mem_map, mem_Icc]
  constructor
  · rintro ⟨x, hx, rfl⟩
    exact ⟨hx, le_tsub_of_add_le_right <| x.2⟩
  cases n
  · exact Fin.elim0 a
  · exact fun hx => ⟨⟨x, Nat.lt_succ_iff.2 hx.2⟩, hx.1, rfl⟩
#align fin.map_subtype_embedding_Ici Fin.map_valEmbedding_Ici

@[simp]
theorem map_valEmbedding_Ioi : (Ioi a).map Fin.valEmbedding = Ioc ↑a (n - 1) := by
  ext x
  simp only [exists_prop, Embedding.coe_subtype, mem_Ioi, mem_map, mem_Ioc]
  constructor
  · rintro ⟨x, hx, rfl⟩
    exact ⟨hx, le_tsub_of_add_le_right <| x.2⟩
  cases n
  · exact Fin.elim0 a
  · exact fun hx => ⟨⟨x, Nat.lt_succ_iff.2 hx.2⟩, hx.1, rfl⟩
#align fin.map_subtype_embedding_Ioi Fin.map_valEmbedding_Ioi

@[simp]
theorem map_valEmbedding_Iic : (Iic b).map Fin.valEmbedding = Iic ↑b := by
  simp [Iic_eq_finset_subtype, Finset.fin, Finset.map_map, Iic_filter_lt_of_lt_right]
#align fin.map_subtype_embedding_Iic Fin.map_valEmbedding_Iic

@[simp]
theorem map_valEmbedding_Iio : (Iio b).map Fin.valEmbedding = Iio ↑b := by
  simp [Iio_eq_finset_subtype, Finset.fin, Finset.map_map]
#align fin.map_subtype_embedding_Iio Fin.map_valEmbedding_Iio

@[simp]
theorem card_Ici : (Ici a).card = n - a := by
  cases n with
  | zero => exact Fin.elim0 a
  | succ =>
    rw [← card_map, map_valEmbedding_Ici, Nat.card_Icc, Nat.succ_sub_one]
    assumption
#align fin.card_Ici Fin.card_Ici

@[simp]
theorem card_Ioi : (Ioi a).card = n - 1 - a := by
  rw [← card_map, map_valEmbedding_Ioi, Nat.card_Ioc]
  assumption
#align fin.card_Ioi Fin.card_Ioi

@[simp]
theorem card_Iic : (Iic b).card = b + 1 := by
  rw [← Nat.card_Iic b, ← map_valEmbedding_Iic, card_map]
#align fin.card_Iic Fin.card_Iic

@[simp]
theorem card_Iio : (Iio b).card = b := by
  rw [← Nat.card_Iio b, ← map_valEmbedding_Iio, card_map]
#align fin.card_Iio Fin.card_Iio

-- Porting note: simp can prove this
-- @[simp]
theorem card_fintypeIci : Fintype.card (Set.Ici a) = n - a := by
  rw [Fintype.card_ofFinset, card_Ici]
  assumption
#align fin.card_fintype_Ici Fin.card_fintypeIci

-- Porting note: simp can prove this
-- @[simp]
theorem card_fintypeIoi : Fintype.card (Set.Ioi a) = n - 1 - a := by
  rw [Fintype.card_ofFinset, card_Ioi]
  assumption
#align fin.card_fintype_Ioi Fin.card_fintypeIoi

-- Porting note: simp can prove this
-- @[simp]
theorem card_fintypeIic : Fintype.card (Set.Iic b) = b + 1 := by
  rw [Fintype.card_ofFinset, card_Iic]
#align fin.card_fintype_Iic Fin.card_fintypeIic

-- Porting note: simp can prove this
-- @[simp]

end Fin


/-
Copyright (c) 2019 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.finset.basic
import Mathlib.data.multiset.intervals
import Mathlib.PostPort

namespace Mathlib

/-!
# Intervals in ℕ as finsets

For now this only covers `Ico n m`, the "closed-open" interval containing `[n, ..., m-1]`.
-/

namespace finset

/-! ### intervals -/

/- Ico (a closed open interval) -/

/-- `Ico n m` is the set of natural numbers `n ≤ k < m`. -/
def Ico (n : ℕ) (m : ℕ) : finset ℕ :=
  mk (multiset.Ico n m) (multiset.Ico.nodup n m)

namespace Ico

@[simp] theorem val (n : ℕ) (m : ℕ) : val (Ico n m) = multiset.Ico n m :=
  rfl

@[simp] theorem to_finset (n : ℕ) (m : ℕ) : multiset.to_finset (multiset.Ico n m) = Ico n m :=
  Eq.symm (multiset.to_finset_eq (multiset.Ico.nodup n m))

theorem image_add (n : ℕ) (m : ℕ) (k : ℕ) : image (Add.add k) (Ico n m) = Ico (n + k) (m + k) := sorry

theorem image_sub (n : ℕ) (m : ℕ) (k : ℕ) (h : k ≤ n) : image (fun (x : ℕ) => x - k) (Ico n m) = Ico (n - k) (m - k) := sorry

theorem zero_bot (n : ℕ) : Ico 0 n = range n :=
  eq_of_veq (multiset.Ico.zero_bot n)

@[simp] theorem card (n : ℕ) (m : ℕ) : card (Ico n m) = m - n :=
  multiset.Ico.card n m

@[simp] theorem mem {n : ℕ} {m : ℕ} {l : ℕ} : l ∈ Ico n m ↔ n ≤ l ∧ l < m :=
  multiset.Ico.mem

@[simp] theorem coe_eq_Ico {n : ℕ} {m : ℕ} : ↑(Ico n m) = set.Ico n m := sorry

theorem eq_empty_of_le {n : ℕ} {m : ℕ} (h : m ≤ n) : Ico n m = ∅ :=
  eq_of_veq (multiset.Ico.eq_zero_of_le h)

@[simp] theorem self_eq_empty (n : ℕ) : Ico n n = ∅ :=
  eq_empty_of_le (le_refl n)

@[simp] theorem eq_empty_iff {n : ℕ} {m : ℕ} : Ico n m = ∅ ↔ m ≤ n :=
  iff.trans (iff.symm val_eq_zero) multiset.Ico.eq_zero_iff

theorem subset_iff {m₁ : ℕ} {n₁ : ℕ} {m₂ : ℕ} {n₂ : ℕ} (hmn : m₁ < n₁) : Ico m₁ n₁ ⊆ Ico m₂ n₂ ↔ m₂ ≤ m₁ ∧ n₁ ≤ n₂ := sorry

protected theorem subset {m₁ : ℕ} {n₁ : ℕ} {m₂ : ℕ} {n₂ : ℕ} (hmm : m₂ ≤ m₁) (hnn : n₁ ≤ n₂) : Ico m₁ n₁ ⊆ Ico m₂ n₂ :=
  eq.mpr (id (Eq.trans (propext subset_iff) (forall_congr_eq fun (x : ℕ) => imp_congr_eq (propext mem) (propext mem))))
    fun (x : ℕ) (hx : m₁ ≤ x ∧ x < n₁) =>
      { left := le_trans hmm (and.left hx), right := lt_of_lt_of_le (and.right hx) hnn }

theorem union_consecutive {n : ℕ} {m : ℕ} {l : ℕ} (hnm : n ≤ m) (hml : m ≤ l) : Ico n m ∪ Ico m l = Ico n l := sorry

theorem union' {n : ℕ} {m : ℕ} {l : ℕ} {k : ℕ} (hlm : l ≤ m) (hnk : n ≤ k) : Ico n m ∪ Ico l k = Ico (min n l) (max m k) := sorry

theorem union {n : ℕ} {m : ℕ} {l : ℕ} {k : ℕ} (h₁ : min n m ≤ max l k) (h₂ : min l k ≤ max n m) : Ico n m ∪ Ico l k = Ico (min n l) (max m k) := sorry

@[simp] theorem inter_consecutive (n : ℕ) (m : ℕ) (l : ℕ) : Ico n m ∩ Ico m l = ∅ := sorry

theorem inter {n : ℕ} {m : ℕ} {l : ℕ} {k : ℕ} : Ico n m ∩ Ico l k = Ico (max n l) (min m k) := sorry

theorem disjoint_consecutive (n : ℕ) (m : ℕ) (l : ℕ) : disjoint (Ico n m) (Ico m l) :=
  le_of_eq (inter_consecutive n m l)

@[simp] theorem succ_singleton (n : ℕ) : Ico n (n + 1) = singleton n :=
  eq_of_veq multiset.Ico.succ_singleton

theorem succ_top {n : ℕ} {m : ℕ} (h : n ≤ m) : Ico n (m + 1) = insert m (Ico n m) := sorry

theorem succ_top' {n : ℕ} {m : ℕ} (h : n < m) : Ico n m = insert (m - 1) (Ico n (m - 1)) := sorry

theorem insert_succ_bot {n : ℕ} {m : ℕ} (h : n < m) : insert n (Ico (n + 1) m) = Ico n m := sorry

@[simp] theorem pred_singleton {m : ℕ} (h : 0 < m) : Ico (m - 1) m = singleton (m - 1) :=
  eq_of_veq (multiset.Ico.pred_singleton h)

@[simp] theorem not_mem_top {n : ℕ} {m : ℕ} : ¬m ∈ Ico n m :=
  multiset.Ico.not_mem_top

theorem filter_lt_of_top_le {n : ℕ} {m : ℕ} {l : ℕ} (hml : m ≤ l) : filter (fun (x : ℕ) => x < l) (Ico n m) = Ico n m :=
  eq_of_veq (multiset.Ico.filter_lt_of_top_le hml)

theorem filter_lt_of_le_bot {n : ℕ} {m : ℕ} {l : ℕ} (hln : l ≤ n) : filter (fun (x : ℕ) => x < l) (Ico n m) = ∅ :=
  eq_of_veq (multiset.Ico.filter_lt_of_le_bot hln)

theorem filter_Ico_bot {n : ℕ} {m : ℕ} (hnm : n < m) : filter (fun (x : ℕ) => x ≤ n) (Ico n m) = singleton n :=
  eq_of_veq (multiset.Ico.filter_le_of_bot hnm)

theorem filter_lt_of_ge {n : ℕ} {m : ℕ} {l : ℕ} (hlm : l ≤ m) : filter (fun (x : ℕ) => x < l) (Ico n m) = Ico n l :=
  eq_of_veq (multiset.Ico.filter_lt_of_ge hlm)

@[simp] theorem filter_lt (n : ℕ) (m : ℕ) (l : ℕ) : filter (fun (x : ℕ) => x < l) (Ico n m) = Ico n (min m l) :=
  eq_of_veq (multiset.Ico.filter_lt n m l)

theorem filter_le_of_le_bot {n : ℕ} {m : ℕ} {l : ℕ} (hln : l ≤ n) : filter (fun (x : ℕ) => l ≤ x) (Ico n m) = Ico n m :=
  eq_of_veq (multiset.Ico.filter_le_of_le_bot hln)

theorem filter_le_of_top_le {n : ℕ} {m : ℕ} {l : ℕ} (hml : m ≤ l) : filter (fun (x : ℕ) => l ≤ x) (Ico n m) = ∅ :=
  eq_of_veq (multiset.Ico.filter_le_of_top_le hml)

theorem filter_le_of_le {n : ℕ} {m : ℕ} {l : ℕ} (hnl : n ≤ l) : filter (fun (x : ℕ) => l ≤ x) (Ico n m) = Ico l m :=
  eq_of_veq (multiset.Ico.filter_le_of_le hnl)

@[simp] theorem filter_le (n : ℕ) (m : ℕ) (l : ℕ) : filter (fun (x : ℕ) => l ≤ x) (Ico n m) = Ico (max n l) m :=
  eq_of_veq (multiset.Ico.filter_le n m l)

@[simp] theorem diff_left (l : ℕ) (n : ℕ) (m : ℕ) : Ico n m \ Ico n l = Ico (max n l) m := sorry

@[simp] theorem diff_right (l : ℕ) (n : ℕ) (m : ℕ) : Ico n m \ Ico l m = Ico n (min m l) := sorry

theorem image_const_sub {k : ℕ} {m : ℕ} {n : ℕ} (hkn : k ≤ n) : image (fun (j : ℕ) => n - j) (Ico k m) = Ico (n + 1 - m) (n + 1 - k) := sorry

end Ico

theorem range_eq_Ico (n : ℕ) : range n = Ico 0 n := sorry

theorem range_image_pred_top_sub (n : ℕ) : image (fun (j : ℕ) => n - 1 - j) (range n) = range n := sorry

-- TODO We don't yet attempt to reproduce the entire interface for `Ico` for `Ico_ℤ`.

/-- `Ico_ℤ l u` is the set of integers `l ≤ k < u`. -/
def Ico_ℤ (l : ℤ) (u : ℤ) : finset ℤ :=
  map (function.embedding.mk (fun (n : ℕ) => ↑n + l) sorry) (range (int.to_nat (u - l)))

@[simp] theorem Ico_ℤ.mem {n : ℤ} {m : ℤ} {l : ℤ} : l ∈ Ico_ℤ n m ↔ n ≤ l ∧ l < m := sorry

@[simp] theorem Ico_ℤ.card (l : ℤ) (u : ℤ) : card (Ico_ℤ l u) = int.to_nat (u - l) := sorry


import ring_theory.noetherian -- the concept of a Noetherian ring
import data.polynomial -- the concept of a polynomial
import tactic -- we love all tactics

import ring_theory.algebra_operations -- just in case

-- polynomials "don't compute" so we go noncomputable
noncomputable theory
-- The reason is that if R doesn't have decidable equality
-- then blah blah something possibly about diamonds.
/-!

# The Hilbert Basis Theorem

A commutative ring is said to be *Noetherian* if all ideals
are finitely generated. This turns out to be an extremely
important finiteness condition for rings. It is named after
the German mathematician Emmy Noether.

The Hilbert Basis Theorem says that if `R` is
a Noetherian ring, then so is the ring `R[X]` of polynomials
in one variable over `R`. Here is how to state the Hilbert
basis theorem in Lean:

-/

/-
*TODO: is this right for non-comm rings? Seems vague (from mathlib)
`ring_theory.noetherian`

A ring is Noetherian if it is Noetherian as a module over itself,
i.e. all its ideals are finitely generated.

@[class] def is_noetherian_ring (R) [ring R] : Prop := is_noetherian R R

-/
variables (R : Type) [comm_ring R] (hR : is_noetherian_ring R)

/-! # Statement of the theorem

The Hilbert Basis Theorem (LaTeX):

Let $R$ be a Noetherian commutative ring with a 1. Then
the polynomial ring $R[X]$ is also Noetherian.

Here's the statement in Lean:

theorem Hilbert_Basis_Theorem
  (R : Type) [comm_ring R] (hR : is_noetherian_ring R) :
  is_noetherian_ring (polynomial R) := ...

-/

-- Stuff that should be in mathlib

-- If S is an R-algebra, how come an ideal of S is an R-submodule of S?
def ideal.to_submodule {S : Type} [comm_ring S] [algebra R S] (I : ideal S) :
  submodule R S :=
{ carrier := I.carrier,
  zero_mem' := I.zero_mem,
  add_mem' := λ a b, I.add_mem,
    smul_mem' := λ r s h, begin
      rw algebra.smul_def'' r s,
      exact I.smul_mem _ h,
    end,
}

-- Before we start, some definitions.

namespace Hilbert_Basis_Theorem

/-- n'th coefficient of a polynomial, as an R-module homomorphism -/
noncomputable def coeff (n : ℕ) : (polynomial R) →ₗ[R] R :=
finsupp.lapply n -- I used `library_search` to find this

example (n : ℕ) (f : polynomial R) : polynomial.coeff f n = coeff R n f := rfl

example (S : Type) [comm_ring S] [algebra R S] (s : S) : S →ₗ[R] S :=
algebra.lmul_left R S s

open polynomial

/-- The coefficient of X^{a+b} in X^a*F equals the coefficient of X^b in f -/
lemma coeff_X_pow_mul (a b : ℕ) : (coeff R (a + b)).comp (algebra.lmul_left _ _ (X^a)) = coeff R b
:=
begin
  ext f,
  show polynomial.coeff (X^a * f) (a + b) = polynomial.coeff f b,
  rw [mul_comm, add_comm],
  apply coeff_mul_X_pow,
end

-- lemma above takes a long time to compile for some reason

-- R-submodules of R[X] are a lattice, so there is hopefully a theory
-- of Infs
noncomputable instance foo :
  lattice (submodule R (polynomial R)) := by apply_instance

--#check has_Inf.Inf

/-
TODO: add to docs.

`⨅` or `\Glb`, is Lean's notation for greatest lower bound, or
intersection, of a set of modules. It is notation for `infi`:

infi : Π {α : Type u} {ι : Sort u_1} [_inst_1 : has_Inf α], (ι → α) → α

Example of notation usage:

lemma vanishing_ideal_Union {ι : Sort*} (t : ι → set (prime_spectrum R)) :
  vanishing_ideal (⋃ i, t i) = (⨅ i, vanishing_ideal (t i)) :=
(gc R).u_infi
-/

-- want: kernel of an R-mod hom M →ₗ N is an R-submodule of M
--#check linear_map.ker
/-- Define the R-submodule M_n of R[X] to be polys of degree less than n -/
def M (n : ℕ) := Inf (set.image (λ j, linear_map.ker (coeff R j)) {j : ℕ | n ≤ j})
-- Example: M 0 is {0}, M 1 is the constant polys R.

--old def M (n : ℕ) := infi (λ j : {j : ℕ // n ≤ j}, linear_map.ker (coeff R j))

example : complete_lattice (ideal R) := by apply_instance

-- failing to use `\Glb` notation
lemma infi_mono (X Y : Type) (L : Type) [complete_lattice L] (f : X → Y) (g : Y → L) :
  infi g ≤ infi (g ∘ f) :=
begin
  apply infi_le_infi2,
  intro x,
  use (f x),
end

-- We need a lemma saying that M is monotone, i.e. M j ⊆ M (j + k)

--@[mono]
lemma M_mono : monotone (M R) :=
begin
  intros a b hab,
  -- I want to prove that ⨅ of some set of submodules is ⊆ of an ⨅ of a bigger set
  unfold M,
  refine Inf_le_Inf _,
  rintros _ ⟨i, hi, rfl⟩,
  use i,
  split,
  { exact le_trans hab hi},
  { refl}
end

-- I an ideal of R[X], I want that n ↦ Jₙ is monotonic

-- What does is_noetherian_ring mean?

--#check is_noetherian_ring

-- example (R : Type) [comm_ring R] (hR : is_noetherian_ring R) (I : ideal R) : I.fg :=
-- begin
--   apply hR.noetherian,
-- end

section In

variable {R}

-- the submodule of elements of an ideal with degree at most n
def I_deg_le (I : ideal (polynomial R)) (n : ℕ) : submodule R (polynomial R) := ((M R n) ⊓ (I.to_submodule R))

variable (I : ideal (polynomial R))

lemma I_deg_le_sub_I (n : ℕ) : I_deg_le I n ≤ ideal.to_submodule R I :=
inf_le_right

lemma I_deg_le_mono : monotone (I_deg_le I) :=
λ _ _ hab, inf_le_inf_right _ (M_mono R hab)

example (A B C D : Prop) (h1 : A ↔ C) (h2 : B ↔ D) : (A ∧ B) ↔ (C ∧ D) := and_congr h1 h2

--#check le_degree_of_ne_zero
--#check finsupp.mem_support_iff

open_locale classical

lemma aux {f : polynomial R} (n : ℕ) (h : ∀ m, n ≤ m → polynomial.coeff f m = 0) : degree f < n :=
if hf0 : f = 0
  then by simp [hf0, with_bot.bot_lt_coe]
  else lt_of_not_ge (λ hfn, mt leading_coeff_eq_zero.1 hf0 (h (nat_degree f) (with_bot.coe_le_coe.1 (by simpa only [ge, degree_eq_nat_degree hf0] using hfn))))

-- mathlib?
lemma degree_lt_iff_coeff_zero (f : polynomial R) (n : ℕ) :
  degree f < n ↔ ∀ m, n ≤ m → polynomial.coeff f m = 0 :=
begin
  --rw finsupp.mem_support_iff,
  split,
  { intros hfn m hmn,
    apply coeff_eq_zero_of_degree_lt,
    apply lt_of_lt_of_le hfn,
    simp [hmn]},
  { intro h,
--    have meh : polynomial.coeff f n ≠ 0 → ↑n ≤ degree f := le_degree_of_ne_zero,
    -- meh contra says : deg(f) < m → coeff f m = 0
    apply aux n h}
end

--#check linear_map.mem_ker

lemma I_deg_le.def (f : polynomial R) (n : ℕ) : f ∈ I_deg_le I n ↔ f ∈ I ∧ degree f < n :=
begin
  unfold I_deg_le,
  rw and.comm,
  rw submodule.mem_inf,
  apply and_congr,
  { unfold M,
    rw degree_lt_iff_coeff_zero,
    convert submodule.mem_infi (λ (j : {j : ℕ | n ≤ j}), (coeff R j).ker),
    { ext, simp},
    { ext, simp [linear_map.mem_ker], congr'}},
  { refl }
end

lemma I_deg_le.def' (f : polynomial R) (n : ℕ) : f ∈ (I_deg_le I n : set (polynomial R)) ↔ f ∈ I ∧ degree f < n :=
I_deg_le.def I f n

lemma degree_mul_monic {p q : polynomial R} (hq : monic q) :
  degree (p * q) = degree p + degree q :=
begin
  by_cases hp : p = 0,
    subst hp, simp,
  rw degree_mul',
  rw monic.def at hq,
  rw hq,
  rw mul_one,
  intro hp0,
  apply hp,
  rw leading_coeff_eq_zero_iff_deg_eq_bot at hp0,
  rwa degree_eq_bot at hp0,
end

lemma degree_mul_pow_X {p : polynomial R} {c : ℕ} :
degree (p * X ^ c) = degree p + c :=
begin
  by_cases hp : p = 0,
    subst hp, simp,
  have hc : leading_coeff p ≠ 0,
  { intro h, apply hp, rw leading_coeff_eq_zero_iff_deg_eq_bot at h,
    rwa degree_eq_bot at h },
  letI : nontrivial R := ⟨⟨_, _, hc⟩⟩,
  convert degree_mul_monic _,
  symmetry,
  rw degree_X_pow,
  rw monic.def,
  simp
end

end In

--#check @add_lt_add_right {a b : α}, a < b → ∀ (c : α), a + c < b + c

universe u
def with_bot.cases {X : Type u} (a : with_bot X) :
  a = ⊥ ∨ ∃ b : X, a = b := by cases a; tidy.

def with_bot.bot_ne_some {X : Type u} (a : X) :
  (⊥ : with_bot X) ≠ a.

def with_bot.some_ne_bot {X : Type u} (a : X) :
  (a : with_bot X) ≠ ⊥.

def with_bot.ne_bot_iff_exists_some {X : Type u} {a : with_bot X} :
  a ≠ (⊥ : with_bot X) ↔ ∃ b : X, a = b :=
begin
  cases with_bot.cases a,
    subst h,simp [with_bot.bot_ne_some],
  rcases h with ⟨b, rfl⟩, simp [with_bot.some_ne_bot],
end

lemma with_bot_nat.add_lt_add_right {a b : with_bot ℕ} :
  a < b → ∀ (c : ℕ), a + c < b + c :=
begin
  intros hab c,
  cases with_bot.cases a,
    subst h, rw [with_bot.bot_add], rw bot_lt_iff_ne_bot at ⊢ hab,
    rw with_bot.ne_bot_iff_exists_some at hab ⊢,
    rcases hab with ⟨b, rfl⟩,
    use b + c, norm_cast,
  rcases h with ⟨a, rfl⟩,
  rcases with_bot.cases b with rfl | ⟨b, rfl⟩,
    exfalso, apply not_lt_bot hab,
  norm_cast at hab ⊢,
  exact add_lt_add_right hab c,
end

open_locale classical

theorem Hilbert_Basis_Theorem'
  (R : Type) [comm_ring R] (hR : is_noetherian_ring R) :
  is_noetherian_ring (polynomial R) :=
begin
  /- Mathematical proof in the comments

    Let I be an element of the lattice of ideals of R[X].
    Goal statement: Want to prove I is finitely generated.
  -/
  suffices : ∀ (I : ideal (polynomial R)), submodule.fg I,
    -- this should be better
    unfold is_noetherian_ring,
    constructor,
    exact this,
  /-
    Let I be an ideal of R[X].
  -/
    intro I,
  /-
    Goal statement: Want to prove I is finitely generated.
    Recall earlier definition : M_n = {f ∈ R[X] | deg(f)<=n}
  -/
  /-
    Proof. Define J_n to be the ideal pr_n (Mₙ ∩ I)

  -/
    -- need that n ↦ Iₙ is monotonic (a ≤ b → Iₐ ≤ Ib)
    set Jn : ∀ (n : ℕ), ideal R := λ (n : ℕ), submodule.map (coeff R n) (I_deg_le I n) with hJn,

    -- J_n are an increasing collection of ideals of R.
    have Jn_mono : monotone Jn,
    { intros a b hab,
      -- Multiplication by X^i is a map M R n → M R (n + i)
      -- Iₐ → I_b given by multiplication by X^{b-a}
      rw le_iff_exists_add at hab,
      rcases hab with ⟨c, rfl⟩,
      rw add_comm,
      rw hJn,
      dsimp,
      rintros x ⟨f, hf, rfl⟩,
      use (X : polynomial R)^c • f,
      split,
      { rw I_deg_le.def',
        split,
          cases hf with _ hf,
          exact submodule.smul_mem _ _ hf,
        rw algebra.id.smul_eq_mul,
        rw mul_comm,
        rw degree_mul_pow_X,
        rw add_comm,
        push_cast,
        rw I_deg_le.def' at hf,
        cases hf with _ hf,
        cases with_bot.cases (f.degree) with hd hd,
          rw hd, simp, norm_cast, rw bot_lt_iff_ne_bot, exact (with_bot.bot_ne_some _).symm,
        rcases hd with ⟨e, he⟩,
        rw he at ⊢ hf,
        apply with_bot_nat.add_lt_add_right hf },
      { rw smul_eq_mul,
        rw mul_comm,
        rw add_comm,
        convert polynomial.coeff_mul_X_pow f c a },
    },

  /-

    Sublemma:

    Let J, an ideal of R, be union of the J_n
-/
/-

  -/
    set J : ideal R := ⨆ n, Jn n with hJ,
  /-
    J is a finitely generated R-mod, generated by {j₁, j₂,…jₙ}
    -/
  have hJ2 : J.fg := is_noetherian.noetherian _,
  -- Now each of those generators lives in some jᵢ
  -- and I need some N such that they're all in J_N
  -- I have monotonicity of J_n.
  -- Say S is a finset of generators for J
  cases hJ2 with S hS,
  -- Each of the terms of S is in J
  have hS2 : ∀ s : R, s ∈ S → s ∈ J,
    rw ← hS,
    apply submodule.subset_span,
  -- so each is in some Jn (n(s))
  have hSJ : ∀ s : R, s ∈ S → ∃ n : ℕ, s ∈ Jn n,
    intros s hs,
    specialize hS2 s hs,
    rw hJ at hS2,
    rw submodule.mem_supr_of_directed at hS2,
      exact hS2,
    intros a b, use max a b, split; apply Jn_mono,
      apply le_max_left,
    apply le_max_right,

  -- so we can take some max
  have hN : ∃ N : ℕ, ∀ (s : R) (hs : s ∈ S), classical.some (hSJ s hs) ≤ N,
    by_cases hS : S.nonempty,
    -- obtain?
      rcases finset.exists_max_image S
        (λ s, if h : s ∈ S then classical.some (hSJ s h) else 37) hS
        with ⟨x, hxS, h⟩,
      use classical.some (hSJ x hxS),
      intros s hs,
      convert h s hs,
        simp_rw dif_pos hs,
      simp_rw dif_pos hxS,
    use 37,
    intros s hs,
    exfalso,
    apply hS,
    exact ⟨s, hs⟩,
  cases hN with N hN,
  -- we are finally in a position to write down the generators
  --
  let Jngens : ℕ → finset R :=
    λ n : ℕ, classical.some (is_noetherian.noetherian (Jn n)),
  have Jngens_spec : ∀ n : ℕ, (↑(Jngens n) : set R) ⊆ Jn n,
    intro n, have hn := classical.some_spec (is_noetherian.noetherian (Jn n)),
    convert submodule.subset_span, rw hn,
  -- Jn n is submodule.map something, and so for every x ∈ Jn n,
  -- there's some f : I_deg_le I n such that coeff R n f = x
  have hIn : ∀ (n : ℕ) (x : R) (hx : x ∈ Jn n), ∃ f : polynomial R,
    f ∈ I_deg_le I n ∧ coeff R n f = x,
    rintros n h ⟨f, hf, rfl⟩,
    use [f, hf],
  let auxfun : ℕ → finset (polynomial R) := λ n, finset.image
    (λ x, if hx : x ∈ Jn n then classical.some (hIn n x hx) else 0)
    (Jngens n),
  have auxfun_spec : ∀ (n : ℕ) (x : R) (hx : x ∈ Jn n), classical.some (hIn n x hx) ∈ _ ∧ _ :=
    λ n x hx, classical.some_spec (hIn n x hx),
  use finset.bind (finset.range N.succ) auxfun,
  apply le_antisymm,
  { -- easy way
    rw submodule.span_le,
    rw finset.coe_bind,
    apply set.bUnion_subset,
    intros n hn,
    intros f hf,
    change f ∈ auxfun n at hf,
    rw finset.mem_image at hf,
    rcases hf with ⟨r, hr, rfl⟩,
    rw dif_pos, swap, apply Jngens_spec n hr,
    apply (I_deg_le_sub_I),
    exact (auxfun_spec n r _).1 },
  -- main goal
  sorry
    /-
  -- where is my finite set of generators of an ideal of a Noetherian ring?

    choose hᵢ ∈ I representing jᵢ
    Let N be max of the degrees of the jᵢ, so J=J_N.
    Now here is a finite set S of generators for I.
    It's the obviously finite union /of the following things
    * h's corresponding to generators of
    all the J_n for n ≤ N.
    * The hᵢ from above
    Proof:
    Say f is in J
    By strong Induction on deg(f) it suffices to prove that for
    every non-zero poly f in I, there exists g in the ideal (S)
    such that f-g has smaller degree than f
    So say f is non-zero. Two cases.
    1) deg(f) = d ≤ N
    Then the h's corresponding to J_d will do the job.
    2) deg(f) =d > N
    Then the leading coefficient of f is in J=J_N
    and we can use X^{d-N}
  -/
end

end Hilbert_Basis_Theorem


def f : Nat → Nat → Nat
  | 0,   y   => y
  | x+1, y+1 => f (x-2) y
  | x+1, 0   => 0

example : f 0 y = y :=
  rfl -- Error, it does not hold by reflexivity since the recursion is on `y`

example : f 0 0 = 0 := rfl

example : f 0 (y+1) = y+1 := rfl

inductive Vector (α : Type u) : Nat → Type u where
  | nil  : Vector α 0
  | cons : α → Vector α n → Vector α (n+1)

namespace Vector
  def insert (a: α): Fin (n+1) → Vector α n → Vector α (n+1)
  | ⟨0  , _⟩,        xs => cons a   xs
  | ⟨i+1, h⟩, cons x xs => cons x $ xs.insert a ⟨i, Nat.lt_of_succ_lt_succ h⟩

  theorem insert_at_0_eq_cons1 (a: α) (v: Vector α n):  v.insert a ⟨0, Nat.zero_lt_succ n⟩ = cons a v :=
    rfl -- Error, it does not hold by reflexivity because the recursion is on v

  example (a : α) :  nil.insert a ⟨0, by simp_arith⟩ = cons a nil :=
    rfl

  example (a : α) (b : α) (bs : Vector α n) :  (cons b bs).insert a ⟨0, by simp_arith⟩ = cons a (cons b bs) :=
    rfl

  theorem insert_at_0_eq_cons2 (a: α) (v: Vector α n):  v.insert a ⟨0, Nat.zero_lt_succ n⟩ = cons a v := by
    rw [insert]

  theorem insert_at_0_eq_cons3 (a: α) (v: Vector α n):  v.insert a ⟨0, Nat.zero_lt_succ n⟩ = cons a v := by
    simp only [insert]

end Vector


/-
Copyright (c) 2018 Reid Barton. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Reid Barton

! This file was ported from Lean 3 source module topology.stone_cech
! leanprover-community/mathlib commit 3e32bc908f617039c74c06ea9a897e30c30803c2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.Bases
import Mathbin.Topology.DenseEmbedding

/-! # Stone-Čech compactification

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

Construction of the Stone-Čech compactification using ultrafilters.

Parts of the formalization are based on "Ultrafilters and Topology"
by Marius Stekelenburg, particularly section 5.
-/

noncomputable section

open Filter Set

open Topology

universe u v

section Ultrafilter

#print ultrafilterBasis /-
/- The set of ultrafilters on α carries a natural topology which makes
  it the Stone-Čech compactification of α (viewed as a discrete space). -/
/-- Basis for the topology on `ultrafilter α`. -/
def ultrafilterBasis (α : Type u) : Set (Set (Ultrafilter α)) :=
  range fun s : Set α => { u | s ∈ u }
#align ultrafilter_basis ultrafilterBasis
-/

variable {α : Type u}

instance : TopologicalSpace (Ultrafilter α) :=
  TopologicalSpace.generateFrom (ultrafilterBasis α)

#print ultrafilterBasis_is_basis /-
theorem ultrafilterBasis_is_basis : TopologicalSpace.IsTopologicalBasis (ultrafilterBasis α) :=
  ⟨by
    rintro _ ⟨a, rfl⟩ _ ⟨b, rfl⟩ u ⟨ua, ub⟩
    refine' ⟨_, ⟨a ∩ b, rfl⟩, inter_mem ua ub, fun v hv => ⟨_, _⟩⟩ <;> apply mem_of_superset hv <;>
      simp [inter_subset_right a b],
    eq_univ_of_univ_subset <| subset_unionₛ_of_mem <| ⟨univ, eq_univ_of_forall fun u => univ_mem⟩,
    rfl⟩
#align ultrafilter_basis_is_basis ultrafilterBasis_is_basis
-/

#print ultrafilter_isOpen_basic /-
/-- The basic open sets for the topology on ultrafilters are open. -/
theorem ultrafilter_isOpen_basic (s : Set α) : IsOpen { u : Ultrafilter α | s ∈ u } :=
  ultrafilterBasis_is_basis.IsOpen ⟨s, rfl⟩
#align ultrafilter_is_open_basic ultrafilter_isOpen_basic
-/

#print ultrafilter_isClosed_basic /-
/-- The basic open sets for the topology on ultrafilters are also closed. -/
theorem ultrafilter_isClosed_basic (s : Set α) : IsClosed { u : Ultrafilter α | s ∈ u } :=
  by
  rw [← isOpen_compl_iff]
  convert ultrafilter_isOpen_basic (sᶜ)
  ext u
  exact ultrafilter.compl_mem_iff_not_mem.symm
#align ultrafilter_is_closed_basic ultrafilter_isClosed_basic
-/

/- warning: ultrafilter_converges_iff -> ultrafilter_converges_iff is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {u : Ultrafilter.{u1} (Ultrafilter.{u1} α)} {x : Ultrafilter.{u1} α}, Iff (LE.le.{u1} (Filter.{u1} (Ultrafilter.{u1} α)) (Preorder.toLE.{u1} (Filter.{u1} (Ultrafilter.{u1} α)) (PartialOrder.toPreorder.{u1} (Filter.{u1} (Ultrafilter.{u1} α)) (Filter.partialOrder.{u1} (Ultrafilter.{u1} α)))) ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (Ultrafilter.{u1} (Ultrafilter.{u1} α)) (Filter.{u1} (Ultrafilter.{u1} α)) (HasLiftT.mk.{succ u1, succ u1} (Ultrafilter.{u1} (Ultrafilter.{u1} α)) (Filter.{u1} (Ultrafilter.{u1} α)) (CoeTCₓ.coe.{succ u1, succ u1} (Ultrafilter.{u1} (Ultrafilter.{u1} α)) (Filter.{u1} (Ultrafilter.{u1} α)) (Ultrafilter.Filter.hasCoeT.{u1} (Ultrafilter.{u1} α)))) u) (nhds.{u1} (Ultrafilter.{u1} α) (Ultrafilter.topologicalSpace.{u1} α) x)) (Eq.{succ u1} (Ultrafilter.{u1} α) x (joinM.{u1} Ultrafilter.{u1} Ultrafilter.monad.{u1} α u))
but is expected to have type
  forall {α : Type.{u1}} {u : Ultrafilter.{u1} (Ultrafilter.{u1} α)} {x : Ultrafilter.{u1} α}, Iff (LE.le.{u1} (Filter.{u1} (Ultrafilter.{u1} α)) (Preorder.toLE.{u1} (Filter.{u1} (Ultrafilter.{u1} α)) (PartialOrder.toPreorder.{u1} (Filter.{u1} (Ultrafilter.{u1} α)) (Filter.instPartialOrderFilter.{u1} (Ultrafilter.{u1} α)))) (Ultrafilter.toFilter.{u1} (Ultrafilter.{u1} α) u) (nhds.{u1} (Ultrafilter.{u1} α) (Ultrafilter.topologicalSpace.{u1} α) x)) (Eq.{succ u1} (Ultrafilter.{u1} α) x (joinM.{u1} Ultrafilter.{u1} Ultrafilter.monad.{u1} α u))
Case conversion may be inaccurate. Consider using '#align ultrafilter_converges_iff ultrafilter_converges_iffₓ'. -/
/-- Every ultrafilter `u` on `ultrafilter α` converges to a unique
  point of `ultrafilter α`, namely `mjoin u`. -/
theorem ultrafilter_converges_iff {u : Ultrafilter (Ultrafilter α)} {x : Ultrafilter α} :
    ↑u ≤ 𝓝 x ↔ x = joinM u := by
  rw [eq_comm, ← Ultrafilter.coe_le_coe]
  change ↑u ≤ 𝓝 x ↔ ∀ s ∈ x, { v : Ultrafilter α | s ∈ v } ∈ u
  simp only [TopologicalSpace.nhds_generateFrom, le_infᵢ_iff, ultrafilterBasis, le_principal_iff,
    mem_set_of_eq]
  constructor
  · intro h a ha
    exact h _ ⟨ha, a, rfl⟩
  · rintro h a ⟨xi, a, rfl⟩
    exact h _ xi
#align ultrafilter_converges_iff ultrafilter_converges_iff

#print ultrafilter_compact /-
instance ultrafilter_compact : CompactSpace (Ultrafilter α) :=
  ⟨isCompact_iff_ultrafilter_le_nhds.mpr fun f _ =>
      ⟨joinM f, trivial, ultrafilter_converges_iff.mpr rfl⟩⟩
#align ultrafilter_compact ultrafilter_compact
-/

#print Ultrafilter.t2Space /-
instance Ultrafilter.t2Space : T2Space (Ultrafilter α) :=
  t2_iff_ultrafilter.mpr fun x y f fx fy =>
    have hx : x = joinM f := ultrafilter_converges_iff.mp fx
    have hy : y = joinM f := ultrafilter_converges_iff.mp fy
    hx.trans hy.symm
#align ultrafilter.t2_space Ultrafilter.t2Space
-/

instance : TotallyDisconnectedSpace (Ultrafilter α) :=
  by
  rw [totallyDisconnectedSpace_iff_connectedComponent_singleton]
  intro A
  simp only [Set.eq_singleton_iff_unique_mem, mem_connectedComponent, true_and_iff]
  intro B hB
  rw [← Ultrafilter.coe_le_coe]
  intro s hs
  rw [connectedComponent_eq_interᵢ_clopen, Set.mem_interᵢ] at hB
  let Z := { F : Ultrafilter α | s ∈ F }
  have hZ : IsClopen Z := ⟨ultrafilter_isOpen_basic s, ultrafilter_isClosed_basic s⟩
  exact hB ⟨Z, hZ, hs⟩

/- warning: ultrafilter_comap_pure_nhds -> ultrafilter_comap_pure_nhds is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (b : Ultrafilter.{u1} α), LE.le.{u1} (Filter.{u1} α) (Preorder.toLE.{u1} (Filter.{u1} α) (PartialOrder.toPreorder.{u1} (Filter.{u1} α) (Filter.partialOrder.{u1} α))) (Filter.comap.{u1, u1} α (Ultrafilter.{u1} α) (Pure.pure.{u1, u1} Ultrafilter.{u1} Ultrafilter.hasPure.{u1} α) (nhds.{u1} (Ultrafilter.{u1} α) (Ultrafilter.topologicalSpace.{u1} α) b)) ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (Ultrafilter.{u1} α) (Filter.{u1} α) (HasLiftT.mk.{succ u1, succ u1} (Ultrafilter.{u1} α) (Filter.{u1} α) (CoeTCₓ.coe.{succ u1, succ u1} (Ultrafilter.{u1} α) (Filter.{u1} α) (Ultrafilter.Filter.hasCoeT.{u1} α))) b)
but is expected to have type
  forall {α : Type.{u1}} (b : Ultrafilter.{u1} α), LE.le.{u1} (Filter.{u1} α) (Preorder.toLE.{u1} (Filter.{u1} α) (PartialOrder.toPreorder.{u1} (Filter.{u1} α) (Filter.instPartialOrderFilter.{u1} α))) (Filter.comap.{u1, u1} α (Ultrafilter.{u1} α) (Pure.pure.{u1, u1} Ultrafilter.{u1} Ultrafilter.instPureUltrafilter.{u1} α) (nhds.{u1} (Ultrafilter.{u1} α) (Ultrafilter.topologicalSpace.{u1} α) b)) (Ultrafilter.toFilter.{u1} α b)
Case conversion may be inaccurate. Consider using '#align ultrafilter_comap_pure_nhds ultrafilter_comap_pure_nhdsₓ'. -/
theorem ultrafilter_comap_pure_nhds (b : Ultrafilter α) : comap pure (𝓝 b) ≤ b :=
  by
  rw [TopologicalSpace.nhds_generateFrom]
  simp only [comap_infi, comap_principal]
  intro s hs
  rw [← le_principal_iff]
  refine' infᵢ_le_of_le { u | s ∈ u } _
  refine' infᵢ_le_of_le ⟨hs, ⟨s, rfl⟩⟩ _
  exact principal_mono.2 fun a => id
#align ultrafilter_comap_pure_nhds ultrafilter_comap_pure_nhds

section Embedding

/- warning: ultrafilter_pure_injective -> ultrafilter_pure_injective is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}}, Function.Injective.{succ u1, succ u1} α (Ultrafilter.{u1} α) (Pure.pure.{u1, u1} (fun {α : Type.{u1}} => Ultrafilter.{u1} α) Ultrafilter.hasPure.{u1} α)
but is expected to have type
  forall {α : Type.{u1}}, Function.Injective.{succ u1, succ u1} α (Ultrafilter.{u1} α) (Pure.pure.{u1, u1} Ultrafilter.{u1} Ultrafilter.instPureUltrafilter.{u1} α)
Case conversion may be inaccurate. Consider using '#align ultrafilter_pure_injective ultrafilter_pure_injectiveₓ'. -/
theorem ultrafilter_pure_injective : Function.Injective (pure : α → Ultrafilter α) :=
  by
  intro x y h
  have : {x} ∈ (pure x : Ultrafilter α) := singleton_mem_pure
  rw [h] at this
  exact (mem_singleton_iff.mp (mem_pure.mp this)).symm
#align ultrafilter_pure_injective ultrafilter_pure_injective

open TopologicalSpace

/- warning: dense_range_pure -> denseRange_pure is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}}, DenseRange.{u1, u1} (Ultrafilter.{u1} α) (Ultrafilter.topologicalSpace.{u1} α) α (Pure.pure.{u1, u1} (fun {α : Type.{u1}} => Ultrafilter.{u1} α) Ultrafilter.hasPure.{u1} α)
but is expected to have type
  forall {α : Type.{u1}}, DenseRange.{u1, u1} (Ultrafilter.{u1} α) (Ultrafilter.topologicalSpace.{u1} α) α (Pure.pure.{u1, u1} Ultrafilter.{u1} Ultrafilter.instPureUltrafilter.{u1} α)
Case conversion may be inaccurate. Consider using '#align dense_range_pure denseRange_pureₓ'. -/
/-- The range of `pure : α → ultrafilter α` is dense in `ultrafilter α`. -/
theorem denseRange_pure : DenseRange (pure : α → Ultrafilter α) := fun x =>
  mem_closure_iff_ultrafilter.mpr
    ⟨x.map pure, range_mem_map, ultrafilter_converges_iff.mpr (bind_pure x).symm⟩
#align dense_range_pure denseRange_pure

/- warning: induced_topology_pure -> induced_topology_pure is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}}, Eq.{succ u1} (TopologicalSpace.{u1} α) (TopologicalSpace.induced.{u1, u1} α (Ultrafilter.{u1} α) (Pure.pure.{u1, u1} (fun {α : Type.{u1}} => Ultrafilter.{u1} α) Ultrafilter.hasPure.{u1} α) (Ultrafilter.topologicalSpace.{u1} α)) (Bot.bot.{u1} (TopologicalSpace.{u1} α) (CompleteLattice.toHasBot.{u1} (TopologicalSpace.{u1} α) (TopologicalSpace.completeLattice.{u1} α)))
but is expected to have type
  forall {α : Type.{u1}}, Eq.{succ u1} (TopologicalSpace.{u1} α) (TopologicalSpace.induced.{u1, u1} α (Ultrafilter.{u1} α) (Pure.pure.{u1, u1} Ultrafilter.{u1} Ultrafilter.instPureUltrafilter.{u1} α) (Ultrafilter.topologicalSpace.{u1} α)) (Bot.bot.{u1} (TopologicalSpace.{u1} α) (CompleteLattice.toBot.{u1} (TopologicalSpace.{u1} α) (TopologicalSpace.instCompleteLatticeTopologicalSpace.{u1} α)))
Case conversion may be inaccurate. Consider using '#align induced_topology_pure induced_topology_pureₓ'. -/
/-- The map `pure : α → ultra_filter α` induces on `α` the discrete topology. -/
theorem induced_topology_pure :
    TopologicalSpace.induced (pure : α → Ultrafilter α) Ultrafilter.topologicalSpace = ⊥ :=
  by
  apply eq_bot_of_singletons_open
  intro x
  use { u : Ultrafilter α | {x} ∈ u }, ultrafilter_isOpen_basic _
  simp
#align induced_topology_pure induced_topology_pure

/- warning: dense_inducing_pure -> denseInducing_pure is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}}, DenseInducing.{u1, u1} α (Ultrafilter.{u1} α) (Bot.bot.{u1} (TopologicalSpace.{u1} α) (CompleteLattice.toHasBot.{u1} (TopologicalSpace.{u1} α) (TopologicalSpace.completeLattice.{u1} α))) (Ultrafilter.topologicalSpace.{u1} α) (Pure.pure.{u1, u1} (fun {α : Type.{u1}} => Ultrafilter.{u1} α) Ultrafilter.hasPure.{u1} α)
but is expected to have type
  forall {α : Type.{u1}}, DenseInducing.{u1, u1} α (Ultrafilter.{u1} α) (Bot.bot.{u1} (TopologicalSpace.{u1} α) (CompleteLattice.toBot.{u1} (TopologicalSpace.{u1} α) (TopologicalSpace.instCompleteLatticeTopologicalSpace.{u1} α))) (Ultrafilter.topologicalSpace.{u1} α) (Pure.pure.{u1, u1} Ultrafilter.{u1} Ultrafilter.instPureUltrafilter.{u1} α)
Case conversion may be inaccurate. Consider using '#align dense_inducing_pure denseInducing_pureₓ'. -/
/-- `pure : α → ultrafilter α` defines a dense inducing of `α` in `ultrafilter α`. -/
theorem denseInducing_pure : @DenseInducing _ _ ⊥ _ (pure : α → Ultrafilter α) :=
  letI : TopologicalSpace α := ⊥
  ⟨⟨induced_topology_pure.symm⟩, denseRange_pure⟩
#align dense_inducing_pure denseInducing_pure

/- warning: dense_embedding_pure -> denseEmbedding_pure is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}}, DenseEmbedding.{u1, u1} α (Ultrafilter.{u1} α) (Bot.bot.{u1} (TopologicalSpace.{u1} α) (CompleteLattice.toHasBot.{u1} (TopologicalSpace.{u1} α) (TopologicalSpace.completeLattice.{u1} α))) (Ultrafilter.topologicalSpace.{u1} α) (Pure.pure.{u1, u1} (fun {α : Type.{u1}} => Ultrafilter.{u1} α) Ultrafilter.hasPure.{u1} α)
but is expected to have type
  forall {α : Type.{u1}}, DenseEmbedding.{u1, u1} α (Ultrafilter.{u1} α) (Bot.bot.{u1} (TopologicalSpace.{u1} α) (CompleteLattice.toBot.{u1} (TopologicalSpace.{u1} α) (TopologicalSpace.instCompleteLatticeTopologicalSpace.{u1} α))) (Ultrafilter.topologicalSpace.{u1} α) (Pure.pure.{u1, u1} Ultrafilter.{u1} Ultrafilter.instPureUltrafilter.{u1} α)
Case conversion may be inaccurate. Consider using '#align dense_embedding_pure denseEmbedding_pureₓ'. -/
-- The following refined version will never be used
/-- `pure : α → ultrafilter α` defines a dense embedding of `α` in `ultrafilter α`. -/
theorem denseEmbedding_pure : @DenseEmbedding _ _ ⊥ _ (pure : α → Ultrafilter α) :=
  letI : TopologicalSpace α := ⊥
  { denseInducing_pure with inj := ultrafilter_pure_injective }
#align dense_embedding_pure denseEmbedding_pure

end Embedding

section Extension

/- Goal: Any function `α → γ` to a compact Hausdorff space `γ` has a
  unique extension to a continuous function `ultrafilter α → γ`. We
  already know it must be unique because `α → ultrafilter α` is a
  dense embedding and `γ` is Hausdorff. For existence, we will invoke
  `dense_embedding.continuous_extend`. -/
variable {γ : Type _} [TopologicalSpace γ]

#print Ultrafilter.extend /-
/-- The extension of a function `α → γ` to a function `ultrafilter α → γ`.
  When `γ` is a compact Hausdorff space it will be continuous. -/
def Ultrafilter.extend (f : α → γ) : Ultrafilter α → γ :=
  letI : TopologicalSpace α := ⊥
  dense_inducing_pure.extend f
#align ultrafilter.extend Ultrafilter.extend
-/

variable [T2Space γ]

/- warning: ultrafilter_extend_extends -> ultrafilter_extend_extends is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {γ : Type.{u2}} [_inst_1 : TopologicalSpace.{u2} γ] [_inst_2 : T2Space.{u2} γ _inst_1] (f : α -> γ), Eq.{max (succ u1) (succ u2)} (α -> γ) (Function.comp.{succ u1, succ u1, succ u2} α (Ultrafilter.{u1} α) γ (Ultrafilter.extend.{u1, u2} α γ _inst_1 f) (Pure.pure.{u1, u1} Ultrafilter.{u1} Ultrafilter.hasPure.{u1} α)) f
but is expected to have type
  forall {α : Type.{u2}} {γ : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} γ] [_inst_2 : T2Space.{u1} γ _inst_1] (f : α -> γ), Eq.{max (succ u2) (succ u1)} (α -> γ) (Function.comp.{succ u2, succ u2, succ u1} α (Ultrafilter.{u2} α) γ (Ultrafilter.extend.{u2, u1} α γ _inst_1 f) (Pure.pure.{u2, u2} Ultrafilter.{u2} Ultrafilter.instPureUltrafilter.{u2} α)) f
Case conversion may be inaccurate. Consider using '#align ultrafilter_extend_extends ultrafilter_extend_extendsₓ'. -/
theorem ultrafilter_extend_extends (f : α → γ) : Ultrafilter.extend f ∘ pure = f :=
  by
  letI : TopologicalSpace α := ⊥
  haveI : DiscreteTopology α := ⟨rfl⟩
  exact funext (dense_inducing_pure.extend_eq continuous_of_discreteTopology)
#align ultrafilter_extend_extends ultrafilter_extend_extends

variable [CompactSpace γ]

/- warning: continuous_ultrafilter_extend -> continuous_ultrafilter_extend is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {γ : Type.{u2}} [_inst_1 : TopologicalSpace.{u2} γ] [_inst_2 : T2Space.{u2} γ _inst_1] [_inst_3 : CompactSpace.{u2} γ _inst_1] (f : α -> γ), Continuous.{u1, u2} (Ultrafilter.{u1} α) γ (Ultrafilter.topologicalSpace.{u1} α) _inst_1 (Ultrafilter.extend.{u1, u2} α γ _inst_1 f)
but is expected to have type
  forall {α : Type.{u2}} {γ : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} γ] [_inst_2 : T2Space.{u1} γ _inst_1] [_inst_3 : CompactSpace.{u1} γ _inst_1] (f : α -> γ), Continuous.{u2, u1} (Ultrafilter.{u2} α) γ (Ultrafilter.topologicalSpace.{u2} α) _inst_1 (Ultrafilter.extend.{u2, u1} α γ _inst_1 f)
Case conversion may be inaccurate. Consider using '#align continuous_ultrafilter_extend continuous_ultrafilter_extendₓ'. -/
theorem continuous_ultrafilter_extend (f : α → γ) : Continuous (Ultrafilter.extend f) :=
  by
  have : ∀ b : Ultrafilter α, ∃ c, Tendsto f (comap pure (𝓝 b)) (𝓝 c) := fun b =>
    -- b.map f is an ultrafilter on γ, which is compact, so it converges to some c in γ.
    let ⟨c, _, h⟩ :=
      isCompact_univ.ultrafilter_le_nhds (b.map f) (by rw [le_principal_iff] <;> exact univ_mem)
    ⟨c, le_trans (map_mono (ultrafilter_comap_pure_nhds _)) h⟩
  letI : TopologicalSpace α := ⊥
  haveI : NormalSpace γ := normalOfCompactT2
  exact dense_inducing_pure.continuous_extend this
#align continuous_ultrafilter_extend continuous_ultrafilter_extend

/- warning: ultrafilter_extend_eq_iff -> ultrafilter_extend_eq_iff is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {γ : Type.{u2}} [_inst_1 : TopologicalSpace.{u2} γ] [_inst_2 : T2Space.{u2} γ _inst_1] [_inst_3 : CompactSpace.{u2} γ _inst_1] {f : α -> γ} {b : Ultrafilter.{u1} α} {c : γ}, Iff (Eq.{succ u2} γ (Ultrafilter.extend.{u1, u2} α γ _inst_1 f b) c) (LE.le.{u2} (Filter.{u2} γ) (Preorder.toLE.{u2} (Filter.{u2} γ) (PartialOrder.toPreorder.{u2} (Filter.{u2} γ) (Filter.partialOrder.{u2} γ))) ((fun (a : Type.{u2}) (b : Type.{u2}) [self : HasLiftT.{succ u2, succ u2} a b] => self.0) (Ultrafilter.{u2} γ) (Filter.{u2} γ) (HasLiftT.mk.{succ u2, succ u2} (Ultrafilter.{u2} γ) (Filter.{u2} γ) (CoeTCₓ.coe.{succ u2, succ u2} (Ultrafilter.{u2} γ) (Filter.{u2} γ) (Ultrafilter.Filter.hasCoeT.{u2} γ))) (Ultrafilter.map.{u1, u2} α γ f b)) (nhds.{u2} γ _inst_1 c))
but is expected to have type
  forall {α : Type.{u2}} {γ : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} γ] [_inst_2 : T2Space.{u1} γ _inst_1] [_inst_3 : CompactSpace.{u1} γ _inst_1] {f : α -> γ} {b : Ultrafilter.{u2} α} {c : γ}, Iff (Eq.{succ u1} γ (Ultrafilter.extend.{u2, u1} α γ _inst_1 f b) c) (LE.le.{u1} (Filter.{u1} γ) (Preorder.toLE.{u1} (Filter.{u1} γ) (PartialOrder.toPreorder.{u1} (Filter.{u1} γ) (Filter.instPartialOrderFilter.{u1} γ))) (Ultrafilter.toFilter.{u1} γ (Ultrafilter.map.{u2, u1} α γ f b)) (nhds.{u1} γ _inst_1 c))
Case conversion may be inaccurate. Consider using '#align ultrafilter_extend_eq_iff ultrafilter_extend_eq_iffₓ'. -/
/-- The value of `ultrafilter.extend f` on an ultrafilter `b` is the
  unique limit of the ultrafilter `b.map f` in `γ`. -/
theorem ultrafilter_extend_eq_iff {f : α → γ} {b : Ultrafilter α} {c : γ} :
    Ultrafilter.extend f b = c ↔ ↑(b.map f) ≤ 𝓝 c :=
  ⟨fun h =>
    by
    -- Write b as an ultrafilter limit of pure ultrafilters, and use
    -- the facts that ultrafilter.extend is a continuous extension of f.
    let b' : Ultrafilter (Ultrafilter α) := b.map pure
    have t : ↑b' ≤ 𝓝 b := ultrafilter_converges_iff.mpr (bind_pure _).symm
    rw [← h]
    have := (continuous_ultrafilter_extend f).Tendsto b
    refine' le_trans _ (le_trans (map_mono t) this)
    change _ ≤ map (Ultrafilter.extend f ∘ pure) ↑b
    rw [ultrafilter_extend_extends]
    exact le_rfl, fun h =>
    letI : TopologicalSpace α := ⊥
    dense_inducing_pure.extend_eq_of_tendsto
      (le_trans (map_mono (ultrafilter_comap_pure_nhds _)) h)⟩
#align ultrafilter_extend_eq_iff ultrafilter_extend_eq_iff

end Extension

end Ultrafilter

section StoneCech

/- Now, we start with a (not necessarily discrete) topological space α
  and we want to construct its Stone-Čech compactification. We can
  build it as a quotient of `ultrafilter α` by the relation which
  identifies two points if the extension of every continuous function
  α → γ to a compact Hausdorff space sends the two points to the same
  point of γ. -/
variable (α : Type u) [TopologicalSpace α]

#print stoneCechSetoid /-
instance stoneCechSetoid : Setoid (Ultrafilter α)
    where
  R x y :=
    ∀ (γ : Type u) [TopologicalSpace γ],
      ∀ [T2Space γ] [CompactSpace γ] (f : α → γ) (hf : Continuous f),
        Ultrafilter.extend f x = Ultrafilter.extend f y
  iseqv :=
    ⟨fun x γ tγ h₁ h₂ f hf => rfl, fun x y xy γ tγ h₁ h₂ f hf => (xy γ f hf).symm,
      fun x y z xy yz γ tγ h₁ h₂ f hf => (xy γ f hf).trans (yz γ f hf)⟩
#align stone_cech_setoid stoneCechSetoid
-/

#print StoneCech /-
/-- The Stone-Čech compactification of a topological space. -/
def StoneCech : Type u :=
  Quotient (stoneCechSetoid α)
#align stone_cech StoneCech
-/

variable {α}

instance : TopologicalSpace (StoneCech α) := by unfold StoneCech <;> infer_instance

instance [Inhabited α] : Inhabited (StoneCech α) := by unfold StoneCech <;> infer_instance

#print stoneCechUnit /-
/-- The natural map from α to its Stone-Čech compactification. -/
def stoneCechUnit (x : α) : StoneCech α :=
  ⟦pure x⟧
#align stone_cech_unit stoneCechUnit
-/

#print denseRange_stoneCechUnit /-
/-- The image of stone_cech_unit is dense. (But stone_cech_unit need
  not be an embedding, for example if α is not Hausdorff.) -/
theorem denseRange_stoneCechUnit : DenseRange (stoneCechUnit : α → StoneCech α) :=
  denseRange_pure.Quotient
#align dense_range_stone_cech_unit denseRange_stoneCechUnit
-/

section Extension

variable {γ : Type u} [TopologicalSpace γ] [T2Space γ] [CompactSpace γ]

variable {γ' : Type u} [TopologicalSpace γ'] [T2Space γ']

variable {f : α → γ} (hf : Continuous f)

attribute [local elab_with_expected_type] Quotient.lift

#print stoneCechExtend /-
/-- The extension of a continuous function from α to a compact
  Hausdorff space γ to the Stone-Čech compactification of α. -/
def stoneCechExtend : StoneCech α → γ :=
  Quotient.lift (Ultrafilter.extend f) fun x y xy => xy γ f hf
#align stone_cech_extend stoneCechExtend
-/

#print stoneCechExtend_extends /-
theorem stoneCechExtend_extends : stoneCechExtend hf ∘ stoneCechUnit = f :=
  ultrafilter_extend_extends f
#align stone_cech_extend_extends stoneCechExtend_extends
-/

#print continuous_stoneCechExtend /-
theorem continuous_stoneCechExtend : Continuous (stoneCechExtend hf) :=
  continuous_quot_lift _ (continuous_ultrafilter_extend f)
#align continuous_stone_cech_extend continuous_stoneCechExtend
-/

#print stoneCech_hom_ext /-
theorem stoneCech_hom_ext {g₁ g₂ : StoneCech α → γ'} (h₁ : Continuous g₁) (h₂ : Continuous g₂)
    (h : g₁ ∘ stoneCechUnit = g₂ ∘ stoneCechUnit) : g₁ = g₂ :=
  by
  apply Continuous.ext_on denseRange_stoneCechUnit h₁ h₂
  rintro x ⟨x, rfl⟩
  apply congr_fun h x
#align stone_cech_hom_ext stoneCech_hom_ext
-/

end Extension

/- warning: convergent_eqv_pure -> convergent_eqv_pure is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} α] {u : Ultrafilter.{u1} α} {x : α}, (LE.le.{u1} (Filter.{u1} α) (Preorder.toLE.{u1} (Filter.{u1} α) (PartialOrder.toPreorder.{u1} (Filter.{u1} α) (Filter.partialOrder.{u1} α))) ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (Ultrafilter.{u1} α) (Filter.{u1} α) (HasLiftT.mk.{succ u1, succ u1} (Ultrafilter.{u1} α) (Filter.{u1} α) (CoeTCₓ.coe.{succ u1, succ u1} (Ultrafilter.{u1} α) (Filter.{u1} α) (Ultrafilter.Filter.hasCoeT.{u1} α))) u) (nhds.{u1} α _inst_1 x)) -> (HasEquivₓ.Equiv.{succ u1} (Ultrafilter.{u1} α) (setoidHasEquiv.{succ u1} (Ultrafilter.{u1} α) (stoneCechSetoid.{u1} α _inst_1)) u (Pure.pure.{u1, u1} Ultrafilter.{u1} Ultrafilter.hasPure.{u1} α x))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} α] {u : Ultrafilter.{u1} α} {x : α}, (LE.le.{u1} (Filter.{u1} α) (Preorder.toLE.{u1} (Filter.{u1} α) (PartialOrder.toPreorder.{u1} (Filter.{u1} α) (Filter.instPartialOrderFilter.{u1} α))) (Ultrafilter.toFilter.{u1} α u) (nhds.{u1} α _inst_1 x)) -> (HasEquiv.Equiv.{succ u1, 0} (Ultrafilter.{u1} α) (instHasEquiv.{succ u1} (Ultrafilter.{u1} α) (stoneCechSetoid.{u1} α _inst_1)) u (Pure.pure.{u1, u1} Ultrafilter.{u1} Ultrafilter.instPureUltrafilter.{u1} α x))
Case conversion may be inaccurate. Consider using '#align convergent_eqv_pure convergent_eqv_pureₓ'. -/
theorem convergent_eqv_pure {u : Ultrafilter α} {x : α} (ux : ↑u ≤ 𝓝 x) : u ≈ pure x :=
  fun γ tγ h₁ h₂ f hf => by
  skip
  trans f x; swap; symm
  all_goals refine' ultrafilter_extend_eq_iff.mpr (le_trans (map_mono _) (hf.tendsto _))
  · apply pure_le_nhds; · exact ux
#align convergent_eqv_pure convergent_eqv_pure

#print continuous_stoneCechUnit /-
theorem continuous_stoneCechUnit : Continuous (stoneCechUnit : α → StoneCech α) :=
  continuous_iff_ultrafilter.mpr fun x g gx =>
    by
    have : ↑(g.map pure) ≤ 𝓝 g := by rw [ultrafilter_converges_iff] <;> exact (bind_pure _).symm
    have : (g.map stoneCechUnit : Filter (StoneCech α)) ≤ 𝓝 ⟦g⟧ :=
      continuousAt_iff_ultrafilter.mp (continuous_quotient_mk'.Tendsto g) _ this
    rwa [show ⟦g⟧ = ⟦pure x⟧ from Quotient.sound <| convergent_eqv_pure gx] at this
#align continuous_stone_cech_unit continuous_stoneCechUnit
-/

#print StoneCech.t2Space /-
instance StoneCech.t2Space : T2Space (StoneCech α) :=
  by
  rw [t2_iff_ultrafilter]
  rintro ⟨x⟩ ⟨y⟩ g gx gy
  apply Quotient.sound
  intro γ tγ h₁ h₂ f hf
  skip
  let ff := stoneCechExtend hf
  change ff ⟦x⟧ = ff ⟦y⟧
  have lim := fun (z : Ultrafilter α) (gz : (g : Filter (StoneCech α)) ≤ 𝓝 ⟦z⟧) =>
    ((continuous_stoneCechExtend hf).Tendsto _).mono_left gz
  exact tendsto_nhds_unique (limUnder x gx) (limUnder y gy)
#align stone_cech.t2_space StoneCech.t2Space
-/

#print StoneCech.compactSpace /-
instance StoneCech.compactSpace : CompactSpace (StoneCech α) :=
  Quotient.compactSpace
#align stone_cech.compact_space StoneCech.compactSpace
-/

end StoneCech


lemma add_squared (a b : mynat) :
  (a + b) ^ (2 : mynat) = a ^ (2 : mynat) + b ^ (2 : mynat) + 2 * a * b :=
begin
rw two_eq_succ_one,
rw one_eq_succ_zero,
repeat { rw pow_succ },
repeat { rw pow_zero },
repeat { rw one_mul },

rw mul_add,
repeat { rw add_mul },
rw mul_comm b a,
rw add_assoc,
rw ← add_assoc (a * b) _ _,
rw ← one_mul (a * b),
rw ← add_mul,
rw ← one_eq_succ_zero,
rw ← succ_eq_add_one,
rw add_comm _ (b * b),
rw ← add_assoc,
rw ← mul_assoc,
refl,
end


import EggTactic
namespace Egg

-- From: lean4/tests/lean/run/alg.lean

-- class Group (α : Type u) extends Mul α where
--   one : α
--   one_mul (a : α) : one * a = a
--   mul_one (a : α) : a * one = a
--   inv : α → α
--   mul_assoc (a b c : α) : a * b * c = a * (b * c)
--   mul_left_inv (a : α) : (inv a) * a = one
--
-- instance [Group α] : OfNat α (nat_lit 1) where
-- ofNat := Group.one

-- Does not work with typeclasses (problem with metavariables)

-- We'll just take the integers for now and not use any additional properties
-- Copied form stdlib
inductive G : Type where
| ofNat   : Nat → G
| negSucc : Nat → G

def negOfNat : Nat → G
| 0       => .ofNat 0
| .succ m => .negSucc m

def neg (n : G) : G :=
match n with
 | .ofNat n   => negOfNat n
 | .negSucc n => .ofNat $ Nat.succ n

def subNatNat (m n : Nat) : G :=
 match (n - m : Nat) with
 | 0        => G.ofNat (m - n)  -- m ≥ n
 | (.succ k) => .negSucc k

def add (m n : G) : G :=
match m, n with
  | .ofNat m,   .ofNat n   => .ofNat (m + n)
  | .ofNat m,   .negSucc n => subNatNat m (Nat.succ n)
  | .negSucc m, .ofNat n   => subNatNat n (Nat.succ m)
  | .negSucc m, .negSucc n => .negSucc (Nat.succ (m + n))

postfix:max "⁻¹" => neg
infix:80 "∘" => add
notation "e" => G.ofNat 0

theorem one_mul (a : G) : e ∘ a = a := by sorry
theorem mul_assoc (a b c : G) : (a ∘ b) ∘ c = a ∘ (b ∘ c) := by sorry
theorem mul_one (a : G) : a ∘ e = a := by sorry
theorem mul_left_inv (a : G) : a⁻¹ ∘ a = e by sorry
theorem mul_right_inv (a : G) : a ∘ a⁻¹  = e by sorry

theorem inv_mul_cancel_left (a b : G) : a⁻¹ ∘ (a ∘ b) = b := by
  try simp [mul_assoc,mul_left_inv,mul_assoc,one_mul,mul_one, mul_right_inv]
  rawEgg [mul_assoc,mul_left_inv,mul_assoc,one_mul,mul_one, mul_right_inv]

theorem mul_inv_cancel_left : a ∘ (a⁻¹ ∘ b) = b := by
 try simp [mul_assoc,mul_left_inv,mul_assoc,one_mul,mul_one, mul_right_inv]
 rawEgg [mul_assoc,mul_left_inv,mul_assoc,one_mul,mul_one, mul_right_inv]

theorem inv_mul : (a ∘ b)⁻¹ = b⁻¹ ∘ a⁻¹ := by
 try simp [mul_assoc,mul_left_inv,mul_assoc,one_mul,mul_one, mul_right_inv]
 rawEgg [mul_assoc,mul_left_inv,mul_assoc,one_mul,mul_one, mul_right_inv]

theorem one_inv : e⁻¹ = e := by
 try simp [mul_assoc,mul_left_inv,mul_assoc,one_mul,mul_one, mul_right_inv]
 rawEgg [mul_assoc,mul_left_inv,mul_assoc,one_mul,mul_one, mul_right_inv]

theorem inv_inv : a ⁻¹ ⁻¹ = a := by
  try simp [mul_assoc,mul_left_inv,mul_assoc,one_mul,mul_one, mul_right_inv]
  rawEgg [mul_assoc,mul_left_inv,mul_assoc,one_mul,mul_one, mul_right_inv]


import category_theory.category
import category_theory.functor
import category_theory.types

import tactic.tidy

import set_category.diagram_lemmas
import help_functions

namespace category_set

universes v u

open classical function set category_theory help_functions

local notation f ` ⊚ `:80 g:80 := category_struct.comp g f

abbreviation left_cancel {C : Type v} [category C]
    {A B C : C}
    (f : A ⟶ B) [mo : mono f] {g h : C ⟶ A} :
    (f ⊚ g = f ⊚ h) → g = h := assume m, (cancel_mono f).1 m

abbreviation right_cancel {C : Type v} [category C]
    {A B C : C}
    (f : A ⟶ B) [ep: epi f] {g h : B ⟶ C} :
    (g ⊚ f = h ⊚ f) → g = h := assume e, (cancel_epi f).1 e

variables {F : Type u ⥤ Type u}
        {A B : Type u}

/--
    The next two lemmas are already shown in the category of types
    in mathlib.category_theory.types.lean
-/
@[simp , tidy] lemma surjective_then_epi
    (f : A ⟶ B)
    (sur : surjective f)
        : epi f :=
            ⟨
                have inv_id : f ∘ (surj_inv sur) = id := funext (surj_inv_eq sur) ,
                assume Z g h (w: g ∘ f = h ∘ f),
                show g = h, from
                calc g = g ∘ id : by simp
                    ... = g ∘ f ∘ (surj_inv sur)    : by rw [inv_id]
                    ... = (g ∘ f) ∘ (surj_inv sur)  : by simp
                    ... = h ∘ f ∘ (surj_inv sur)    : by rw [w]
                    ... = h ∘ id                    : by rw [inv_id]
                    ... = h                         : by simp
            ⟩

 @[simp , tidy] lemma injective_then_mono
    (f : A ⟶ B) (inj: injective f)
        : mono f :=
        ⟨
            assume C (g h : C ⟶ A) gh,
            have s1 : ∀ a₁ a₂ , f a₁ = f a₂ → a₁ = a₂ := inj,
            have s2 : ∀ c , f (g c) = f (h c) :=
                assume c , show (f ⊚ g) c = (f ⊚ h) c,
                from by rw [gh],
            have s3 : ∀ c , g c = h c := assume c , s1 (g c) (h c) (s2 c),
            funext s3
        ⟩

lemma mono_preserving_functor
    (f : A ⟶ B)
    (inj : injective f)
    [inhabited A]
        : mono (F.map f) :=
{ right_cancellation :=
begin
    assume (Z:Type u)
           (Fg Fh : Z ⟶ F.obj A)
           (w : (F.map f) ∘ Fg = (F.map f) ∘ Fh),
    let inv : B ⟶ A := inv_fun f,
    have id_inv : inv ∘ f = id := funext (left_inverse_inv_fun inj),

    calc
        Fg  = (@id (F.obj A)) ∘ Fg              : rfl
        ... = (𝟙 (F.obj A)) ∘ Fg                : rfl
        ... = (F.map (𝟙 A)) ∘ Fg                : by rw functor.map_id'
        ... = (F.map (@id A)) ∘ Fg              : rfl
        ... = (F.map (inv ∘ f)) ∘ Fg            : by rw id_inv
        ... = (F.map (inv ⊚ f)) ∘ Fg           : rfl
        ... = ((F.map inv) ⊚ (F.map f)) ∘ Fg   : by rw functor.map_comp
        ... = (F.map inv) ∘ ((F.map f) ∘ Fg)    : rfl
        ... = (F.map inv) ∘ ((F.map f) ⊚ Fg)   : rfl
        ... = (F.map inv) ∘ ((F.map f) ⊚ Fh)   : by rw w
        ... = (F.map inv) ∘ ((F.map f) ∘ Fh)    : rfl
        ... = ((F.map inv) ∘ (F.map f)) ∘ Fh    : rfl
        ... = ((F.map inv) ⊚ (F.map f)) ∘ Fh   : rfl
        ... = (F.map (inv ⊚ f)) ∘ Fh           : by rw functor.map_comp
        ... = (F.map (inv ∘ f)) ∘ Fh            : rfl
        ... = (F.map (@id A)) ∘ Fh              : by rw id_inv
        ... = (F.map (𝟙 A)) ∘ Fh                : rfl
        ... = (𝟙 (F.obj A)) ∘ Fh                : by rw functor.map_id'
        ... = (@id (F.obj A)) ∘ Fh              : rfl
        ... = Fh                                : rfl
end
}

end category_set