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

import computability.NFA

/-!
# Epsilon Nondeterministic Finite Automata
This file contains the definition of an epsilon Nondeterministic Finite Automaton (`ε_NFA`), a state
machine which determines whether a string (implemented as a list over an arbitrary alphabet) is in a
regular set by evaluating the string over every possible path, also having access to ε-transitons,
which can be followed without reading a character.
Since this definition allows for automata with infinite states, a `fintype` instance must be
supplied for true `ε_NFA`'s.
-/

open set

universes u v

/-- An `ε_NFA` is a set of states (`σ`), a transition function from state to state labelled by the
  alphabet (`step`), a starting state (`start`) and a set of acceptance states (`accept`).
  Note the transition function sends a state to a `set` of states and can make ε-transitions by
  inputing `none`.
  Since this definition allows for Automata with infinite states, a `fintype` instance must be
  supplied for true `ε_NFA`'s.-/
structure ε_NFA (α : Type u) (σ : Type v) :=
(step : σ → option α → set σ)
(start : set σ)
(accept : set σ)

variables {α : Type u} {σ σ' : Type v} (M : ε_NFA α σ) {S : set σ} {x : list α} {s : σ} {a : α}

namespace ε_NFA

/-- The `ε_closure` of a set is the set of states which can be reached by taking a finite string of
ε-transitions from an element of the set. -/
inductive ε_closure (S : set σ) : set σ
| base : ∀ s ∈ S, ε_closure s
| step : ∀ s (t ∈ M.step s none), ε_closure s → ε_closure t

@[simp] lemma subset_ε_closure (S : set σ) : S ⊆ M.ε_closure S := ε_closure.base

@[simp] lemma ε_closure_empty : M.ε_closure ∅ = ∅ :=
eq_empty_of_forall_not_mem $ λ s hs, by induction hs with t ht _ _ _ _ ih; assumption

@[simp] lemma ε_closure_univ : M.ε_closure univ = univ :=
eq_univ_of_univ_subset $ subset_ε_closure _ _

/-- `M.step_set S a` is the union of the ε-closure of `M.step s a` for all `s ∈ S`. -/
def step_set (S : set σ) (a : α) : set σ := ⋃ s ∈ S, M.ε_closure $ M.step s a

variables {M}

@[simp] lemma mem_step_set_iff : s ∈ M.step_set S a ↔ ∃ t ∈ S, s ∈ M.ε_closure (M.step t a) :=
mem_Union₂

@[simp] lemma step_set_empty (a : α) : M.step_set ∅ a = ∅ :=
by simp_rw [step_set, Union_false, Union_empty]

variables (M)

/-- `M.eval_from S x` computes all possible paths through `M` with input `x` starting at an element
of `S`. -/
def eval_from (start : set σ) : list α → set σ :=
list.foldl M.step_set (M.ε_closure start)

@[simp] lemma eval_from_nil (S : set σ) : M.eval_from S [] = M.ε_closure S := rfl
@[simp] lemma eval_from_singleton (S : set σ) (a : α) :
  M.eval_from S [a] = M.step_set (M.ε_closure S) a := rfl
@[simp] lemma eval_from_append_singleton (S : set σ) (x : list α) (a : α) :
  M.eval_from S (x ++ [a]) = M.step_set (M.eval_from S x) a :=
by simp only [eval_from, list.foldl_append, list.foldl_cons, list.foldl_nil]

@[simp] lemma eval_from_empty (x : list α) : M.eval_from ∅ x = ∅ :=
begin
  induction x using list.reverse_rec_on with x a ih,
  { rw [eval_from_nil, ε_closure_empty] },
  { rw [eval_from_append_singleton, ih, step_set_empty] }
end

/-- `M.eval x` computes all possible paths through `M` with input `x` starting at an element of
`M.start`. -/
def eval := M.eval_from M.start

@[simp] lemma eval_nil : M.eval [] = M.ε_closure M.start := rfl
@[simp] lemma eval_singleton (a : α) : M.eval [a] = M.step_set (M.ε_closure M.start) a := rfl
@[simp] lemma eval_append_singleton (x : list α) (a : α) :
  M.eval (x ++ [a]) = M.step_set (M.eval x) a :=
eval_from_append_singleton _ _ _ _

/-- `M.accepts` is the language of `x` such that there is an accept state in `M.eval x`. -/
def accepts : language α := {x | ∃ S ∈ M.accept, S ∈ M.eval x}

/-! ### Conversions between `ε_NFA` and `NFA` -/

/-- `M.to_NFA` is an `NFA` constructed from an `ε_NFA` `M`. -/
def to_NFA : NFA α σ :=
{ step := λ S a, M.ε_closure (M.step S a),
  start := M.ε_closure M.start,
  accept := M.accept }

@[simp] lemma to_NFA_eval_from_match (start : set σ) :
  M.to_NFA.eval_from (M.ε_closure start) = M.eval_from start := rfl

@[simp] lemma to_NFA_correct :
  M.to_NFA.accepts = M.accepts :=
begin
  ext x,
  rw [accepts, NFA.accepts, eval, NFA.eval, ←to_NFA_eval_from_match],
  refl
end

lemma pumping_lemma [fintype σ] {x : list α} (hx : x ∈ M.accepts)
  (hlen : fintype.card (set σ) ≤ list.length x) :
  ∃ a b c, x = a ++ b ++ c ∧ a.length + b.length ≤ fintype.card (set σ) ∧ b ≠ [] ∧
  {a} * language.star {b} * {c} ≤ M.accepts :=
begin
  rw ←to_NFA_correct at hx ⊢,
  exact M.to_NFA.pumping_lemma hx hlen
end

end ε_NFA

namespace NFA

/-- `M.to_ε_NFA` is an `ε_NFA` constructed from an `NFA` `M` by using the same start and accept
  states and transition functions. -/
def to_ε_NFA (M : NFA α σ) : ε_NFA α σ :=
{ step := λ s a, a.cases_on' ∅ (λ a, M.step s a),
  start := M.start,
  accept := M.accept }

@[simp] lemma to_ε_NFA_ε_closure (M : NFA α σ) (S : set σ) : M.to_ε_NFA.ε_closure S = S :=
begin
  ext a,
  refine ⟨_, ε_NFA.ε_closure.base _⟩,
  rintro (⟨_, h⟩ | ⟨_, _, h, _⟩),
  { exact h },
  { cases h }
end

@[simp] lemma to_ε_NFA_eval_from_match (M : NFA α σ) (start : set σ) :
  M.to_ε_NFA.eval_from start = M.eval_from start :=
begin
  rw [eval_from, ε_NFA.eval_from, to_ε_NFA_ε_closure],
  congr,
  ext S s,
  simp only [step_set, ε_NFA.step_set, exists_prop, set.mem_Union, set.bind_def],
  apply exists_congr,
  simp only [and.congr_right_iff],
  intros t ht,
  rw M.to_ε_NFA_ε_closure,
  refl
end

@[simp] lemma to_ε_NFA_correct (M : NFA α σ) :
  M.to_ε_NFA.accepts = M.accepts :=
begin
  rw [accepts, ε_NFA.accepts, eval, ε_NFA.eval, to_ε_NFA_eval_from_match],
  refl
end

end NFA

/-! ### Regex-like operations -/

namespace ε_NFA

instance : has_zero (ε_NFA α σ) := ⟨⟨λ _ _, ∅, ∅, ∅⟩⟩
instance : has_one (ε_NFA α σ) := ⟨⟨λ _ _, ∅, univ, univ⟩⟩

instance : inhabited (ε_NFA α σ) := ⟨0⟩

variables (P : ε_NFA α σ) (Q : ε_NFA α σ')

@[simp] lemma step_zero (s a) : (0 : ε_NFA α σ).step s a = ∅ := rfl
@[simp] lemma step_one (s a) : (1 : ε_NFA α σ).step s a = ∅ := rfl

@[simp] lemma start_zero : (0 : ε_NFA α σ).start = ∅ := rfl
@[simp] lemma start_one : (1 : ε_NFA α σ).start = univ := rfl

@[simp]

end ε_NFA


/-
Copyright (c) 2020 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.algebra.category.Group.abelian
import Mathlib.category_theory.limits.shapes.images
import Mathlib.category_theory.limits.types
import Mathlib.PostPort

namespace Mathlib

/-!
# The category of commutative additive groups has images.

Note that we don't need to register any of the constructions here as instances, because we get them
from the fact that `AddCommGroup` is an abelian category.
-/

namespace AddCommGroup

-- Note that because `injective_of_mono` is currently only proved in `Type 0`,

-- we restrict to the lowest universe here for now.

/-- the image of a morphism in AddCommGroup is just the bundling of `add_monoid_hom.range f` -/
def image {G : AddCommGroup} {H : AddCommGroup} (f : G ⟶ H) : AddCommGroup :=
  of ↥(add_monoid_hom.range f)

/-- the inclusion of `image f` into the target -/
def image.ι {G : AddCommGroup} {H : AddCommGroup} (f : G ⟶ H) : image f ⟶ H :=
  add_subgroup.subtype (add_monoid_hom.range f)

protected instance image.ι.category_theory.mono {G : AddCommGroup} {H : AddCommGroup} (f : G ⟶ H) : category_theory.mono (image.ι f) :=
  category_theory.concrete_category.mono_of_injective (image.ι f) subtype.val_injective

/-- the corestriction map to the image -/
def factor_thru_image {G : AddCommGroup} {H : AddCommGroup} (f : G ⟶ H) : G ⟶ image f :=
  add_monoid_hom.to_range f

theorem image.fac {G : AddCommGroup} {H : AddCommGroup} (f : G ⟶ H) : factor_thru_image f ≫ image.ι f = f :=
  ext G H (factor_thru_image f ≫ image.ι f) f fun (x : ↥G) => Eq.refl (coe_fn (factor_thru_image f ≫ image.ι f) x)

/-- the universal property for the image factorisation -/
def image.lift {G : AddCommGroup} {H : AddCommGroup} {f : G ⟶ H} (F' : category_theory.limits.mono_factorisation f) : image f ⟶ category_theory.limits.mono_factorisation.I F' :=
  add_monoid_hom.mk
    (fun (x : ↥(image f)) =>
      coe_fn (category_theory.limits.mono_factorisation.e F')
        (subtype.val (classical.indefinite_description (fun (x_1 : ↥G) => coe_fn f x_1 = subtype.val x) sorry)))
    sorry sorry

theorem image.lift_fac {G : AddCommGroup} {H : AddCommGroup} {f : G ⟶ H} (F' : category_theory.limits.mono_factorisation f) : image.lift F' ≫ category_theory.limits.mono_factorisation.m F' = image.ι f := sorry

/-- the factorisation of any morphism in AddCommGroup through a mono. -/
def mono_factorisation {G : AddCommGroup} {H : AddCommGroup} (f : G ⟶ H) : category_theory.limits.mono_factorisation f :=
  category_theory.limits.mono_factorisation.mk (image f) (image.ι f) (factor_thru_image f)

/-- the factorisation of any morphism in AddCommGroup through a mono has the universal property of
the image. -/
def is_image {G : AddCommGroup} {H : AddCommGroup} (f : G ⟶ H) : category_theory.limits.is_image (mono_factorisation f) :=
  category_theory.limits.is_image.mk image.lift

/--
The categorical image of a morphism in `AddCommGroup`
agrees with the usual group-theoretical range.
-/
def image_iso_range {G : AddCommGroup} {H : AddCommGroup} (f : G ⟶ H) : category_theory.limits.image f ≅ of ↥(add_monoid_hom.range f) :=
  category_theory.limits.is_image.iso_ext (category_theory.limits.image.is_image f) (is_image f)


/-
Copyright (c) 2019 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Fabian Glöckle
-/
import linear_algebra.finite_dimensional
import linear_algebra.projection

/-!
# Dual vector spaces

The dual space of an R-module M is the R-module of linear maps `M → R`.

## Main definitions

* `dual R M` defines the dual space of M over R.
* Given a basis for a K-vector space `V`, `is_basis.to_dual` produces a map from `V` to `dual K V`.
* Given families of vectors `e` and `ε`, `dual_pair e ε` states that these families have the
  characteristic properties of a basis and a dual.
* `dual_annihilator W` is the submodule of `dual R M` where every element annihilates `W`.

## Main results

* `to_dual_equiv` : the dual space is linearly equivalent to the primal space.
* `dual_pair.is_basis` and `dual_pair.eq_dual`: if `e` and `ε` form a dual pair, `e` is a basis and
  `ε` is its dual basis.
* `quot_equiv_annihilator`: the quotient by a subspace is isomorphic to its dual annihilator.

## Notation

We sometimes use `V'` as local notation for `dual K V`.

## TODO

Erdös-Kaplansky theorem about the dimension of a dual vector space in case of infinite dimension.
-/

noncomputable theory

namespace module

variables (R : Type*) (M : Type*)
variables [comm_semiring R] [add_comm_monoid M] [module R M]

/-- The dual space of an R-module M is the R-module of linear maps `M → R`. -/
@[derive [add_comm_monoid, module R]] def dual := M →ₗ[R] R

instance {S : Type*} [comm_ring S] {N : Type*} [add_comm_group N] [module S N] :
  add_comm_group (dual S N) := by {unfold dual, apply_instance}

namespace dual

instance : inhabited (dual R M) := by dunfold dual; apply_instance

instance : has_coe_to_fun (dual R M) := ⟨_, linear_map.to_fun⟩

/-- Maps a module M to the dual of the dual of M. See `module.erange_coe` and
`module.eval_equiv`. -/
def eval : M →ₗ[R] (dual R (dual R M)) := linear_map.flip linear_map.id

@[simp] lemma eval_apply (v : M) (a : dual R M) : eval R M v a = a v :=
begin
  dunfold eval,
  rw [linear_map.flip_apply, linear_map.id_apply]
end

variables {R M} {M' : Type*} [add_comm_monoid M'] [module R M']

/-- The transposition of linear maps, as a linear map from `M →ₗ[R] M'` to
`dual R M' →ₗ[R] dual R M`. -/
def transpose : (M →ₗ[R] M') →ₗ[R] (dual R M' →ₗ[R] dual R M) :=
(linear_map.llcomp R M M' R).flip

lemma transpose_apply (u : M →ₗ[R] M') (l : dual R M') : transpose u l = l.comp u := rfl

variables {M'' : Type*} [add_comm_monoid M''] [module R M'']

lemma transpose_comp (u : M' →ₗ[R] M'') (v : M →ₗ[R] M') :
  transpose (u.comp v) = (transpose v).comp (transpose u) := rfl

end dual

end module

namespace is_basis

universes u v w

variables {K : Type u} {V : Type v} {ι : Type w}
variables [field K] [add_comm_group V] [module K V]

open module module module.dual submodule linear_map cardinal function

variables [de : decidable_eq ι]
variables (B : ι → V) (h : is_basis K B)

include de h

/-- The linear map from a vector space equipped with basis to its dual vector space,
taking basis elements to corresponding dual basis elements. -/
def to_dual : V →ₗ[K] module.dual K V :=
h.constr $ λ v, h.constr $ λ w, if w = v then (1 : K) else 0

variable {B}

lemma to_dual_apply (i j : ι) :
  h.to_dual B (B i) (B j) = if i = j then 1 else 0 :=
by { erw [constr_basis h, constr_basis h], ac_refl }

@[simp] lemma to_dual_total_left (f : ι →₀ K) (i : ι) :
  h.to_dual B (finsupp.total ι V K B f) (B i) = f i :=
begin
  rw [finsupp.total_apply, finsupp.sum, linear_map.map_sum, linear_map.sum_apply],
  simp_rw [linear_map.map_smul, linear_map.smul_apply, to_dual_apply, smul_eq_mul,
           mul_boole, finset.sum_ite_eq'],
  split_ifs with h,
  { refl },
  { rw finsupp.not_mem_support_iff.mp h }
end

@[simp] lemma to_dual_total_right (f : ι →₀ K) (i : ι) :
  h.to_dual B (B i) (finsupp.total ι V K B f) = f i :=
begin
  rw [finsupp.total_apply, finsupp.sum, linear_map.map_sum],
  simp_rw [linear_map.map_smul, to_dual_apply, smul_eq_mul, mul_boole, finset.sum_ite_eq],
  split_ifs with h,
  { refl },
  { rw finsupp.not_mem_support_iff.mp h }
end

lemma to_dual_apply_left (v : V) (i : ι) : h.to_dual B v (B i) = h.repr v i :=
by rw [← h.to_dual_total_left, h.total_repr]

lemma to_dual_apply_right (i : ι) (v : V) : h.to_dual B (B i) v = h.repr v i :=
by rw [← h.to_dual_total_right, h.total_repr]

variable (B)

/-- `h.to_dual_flip v` is the linear map sending `w` to `h.to_dual w v`. -/
def to_dual_flip (v : V) : (V →ₗ[K] K) := (h.to_dual B).flip v

variable {B}

omit de

/-- `h.coord_fun i` sends vectors to their `i`'th coordinate with respect to the basis `h`. -/
def coord_fun (i : ι) : (V →ₗ[K] K) := (finsupp.lapply i).comp h.repr

lemma coord_fun_eq_repr (v : V) (i : ι) : h.coord_fun i v = h.repr v i := rfl

include de

-- TODO: this lemma should be called something like `to_dual_flip_apply`
lemma to_dual_swap_eq_to_dual (v w : V) : h.to_dual_flip B v w = h.to_dual B w v := rfl

lemma to_dual_eq_repr (v : V) (i : ι) : h.to_dual B v (B i) = h.repr v i :=
h.to_dual_apply_left v i

lemma to_dual_eq_equiv_fun [fintype ι] (v : V) (i : ι) : h.to_dual B v (B i) = h.equiv_fun v i :=
by rw [h.equiv_fun_apply, to_dual_eq_repr]

lemma to_dual_inj (v : V) (a : h.to_dual B v = 0) : v = 0 :=
begin
  rw [← mem_bot K, ← h.repr_ker, mem_ker],
  apply finsupp.ext,
  intro b,
  rw [←to_dual_eq_repr _ _ _, a],
  refl
end

theorem to_dual_ker : (h.to_dual B).ker = ⊥ :=
ker_eq_bot'.mpr h.to_dual_inj

theorem to_dual_range [fin : fintype ι] : (h.to_dual B).range = ⊤ :=
begin
  rw eq_top_iff',
  intro f,
  rw linear_map.mem_range,
  let lin_comb : ι →₀ K := finsupp.on_finset fin.elems (λ i, f.to_fun (B i)) _,
  { use finsupp.total ι V K B lin_comb,
    apply h.ext,
    { intros i,
      rw [h.to_dual_eq_repr _ i, repr_total h],
      { refl },
      { rw [finsupp.mem_supported],
        exact λ _ _, set.mem_univ _ } } },
  { intros a _,
    apply fin.complete }
end

/-- Maps a basis for `V` to a basis for the dual space. -/
def dual_basis : ι → dual K V := λ i, h.to_dual B (B i)

theorem dual_lin_independent : linear_independent K h.dual_basis :=
h.1.map' _ (to_dual_ker _)

@[simp] lemma dual_basis_apply_self (i j : ι) :
  h.dual_basis i (B j) = if i = j then 1 else 0 :=
h.to_dual_apply i j

variable (B)

/-- A vector space is linearly equivalent to its dual space. -/
def to_dual_equiv [fintype ι] : V ≃ₗ[K] (dual K V) :=
linear_equiv.of_bijective (h.to_dual B) h.to_dual_ker h.to_dual_range

variable {B}

theorem dual_basis_is_basis [fintype ι] : is_basis K h.dual_basis :=
(h.to_dual_equiv B).is_basis h

@[simp] lemma total_dual_basis [fintype ι] (f : ι →₀ K) (i : ι) :
  finsupp.total ι (dual K V) K h.dual_basis f (B i) = f i :=
begin
  rw [finsupp.total_apply, finsupp.sum_fintype, linear_map.sum_apply],
  { simp_rw [smul_apply, smul_eq_mul, dual_basis_apply_self, mul_boole,
             finset.sum_ite_eq', if_pos (finset.mem_univ i)] },
  { intro, rw zero_smul },
end

lemma dual_basis_repr [fintype ι] (l : dual K V) (i : ι) :
  h.dual_basis_is_basis.repr l i = l (B i) :=
by rw [← total_dual_basis h, is_basis.total_repr h.dual_basis_is_basis l ]

lemma dual_basis_equiv_fun [fintype ι] (l : dual K V) (i : ι) :
  h.dual_basis_is_basis.equiv_fun l i = l (B i) :=
by rw [is_basis.equiv_fun_apply, dual_basis_repr]

lemma dual_basis_apply [fintype ι] (i : ι) (v : V) : h.dual_basis i v = h.equiv_fun v i :=
h.to_dual_apply_right i v

@[simp] lemma to_dual_to_dual [fintype ι] :
  (h.dual_basis_is_basis.to_dual _).comp (h.to_dual B) = eval K V :=
begin
  refine h.ext (λ i, h.dual_basis_is_basis.ext (λ j, _)),
  simp [h.dual_basis_is_basis.to_dual_apply_left, h.dual_basis_repr, h.to_dual_apply_right],
end

omit de

theorem dual_dim_eq [fintype ι] :
  cardinal.lift.{v u} (module.rank K V) = module.rank K (dual K V) :=
begin
  classical,
  have := linear_equiv.dim_eq_lift (h.to_dual_equiv B),
  simp only [cardinal.lift_umax] at this,
  rw [this, ← cardinal.lift_umax],
  apply cardinal.lift_id,
end

end is_basis

namespace module

universes u v
variables {K : Type u} {V : Type v}
variables [field K] [add_comm_group V] [module K V]
open module module.dual submodule linear_map cardinal is_basis finite_dimensional

theorem eval_ker : (eval K V).ker = ⊥ :=
begin
  classical,
  rw ker_eq_bot',
  intros v h,
  rw linear_map.ext_iff at h,
  by_contradiction H,
  rcases exists_subset_is_basis (linear_independent_singleton H) with ⟨b, hv, hb⟩,
  swap 4, assumption,
  have hv' : v = (coe : b → V) ⟨v, hv (set.mem_singleton v)⟩ := rfl,
  let hx := h (hb.to_dual _ v),
  rw [eval_apply, hv', to_dual_apply, if_pos rfl, zero_apply] at hx,
  exact one_ne_zero hx
end

theorem dual_dim_eq [finite_dimensional K V] :
  cardinal.lift.{v u} (module.rank K V) = module.rank K (dual K V) :=
begin
  classical,
  rcases exists_is_basis_fintype (dim_lt_omega K V) with ⟨b, hb, ⟨hf⟩⟩,
  resetI,
  exact hb.dual_dim_eq
end

lemma erange_coe [finite_dimensional K V] : (eval K V).range = ⊤ :=
begin
  classical,
  rcases exists_is_basis_fintype (dim_lt_omega K V) with ⟨b, hb, ⟨hf⟩⟩,
  unfreezingI { rw [← hb.to_dual_to_dual, range_comp, hb.to_dual_range, map_top, to_dual_range _] },
  apply_instance
end

variables (K V)

/-- A vector space is linearly equivalent to the dual of its dual space. -/
def eval_equiv [finite_dimensional K V] : V ≃ₗ[K] dual K (dual K V) :=
linear_equiv.of_bijective (eval K V) eval_ker (erange_coe)

variables {K V}

@[simp] lemma eval_equiv_to_linear_map [finite_dimensional K V] :
  (eval_equiv K V).to_linear_map = dual.eval K V := rfl

end module

section dual_pair

open module module module.dual linear_map function

universes u v w

variables {K : Type u} {V : Type v} {ι : Type w} [decidable_eq ι]
variables [field K] [add_comm_group V] [module K V]

local notation `V'` := dual K V

/-- `e` and `ε` have characteristic properties of a basis and its dual -/
@[nolint has_inhabited_instance]
structure dual_pair (e : ι → V) (ε : ι → V') :=
(eval : ∀ i j : ι, ε i (e j) = if i = j then 1 else 0)
(total : ∀ {v : V}, (∀ i, ε i v = 0) → v = 0)
[finite : ∀ v : V, fintype {i | ε i v ≠ 0}]

end dual_pair

namespace dual_pair

open module module module.dual linear_map function

universes u v w
variables {K : Type u} {V : Type v} {ι : Type w} [dι : decidable_eq ι]
variables [field K] [add_comm_group V] [module K V]
variables {e : ι → V} {ε : ι → dual K V} (h : dual_pair e ε)

include h

/-- The coefficients of `v` on the basis `e` -/
def coeffs (v : V) : ι →₀ K :=
{ to_fun := λ i, ε i v,
  support := by { haveI := h.finite v, exact {i : ι | ε i v ≠ 0}.to_finset },
  mem_support_to_fun := by {intro i, rw set.mem_to_finset, exact iff.rfl } }

@[simp]

omit h
/-- linear combinations of elements of `e`.
This is a convenient abbreviation for `finsupp.total _ V K e l` -/
def lc (e : ι → V) (l : ι →₀ K) : V := l.sum (λ (i : ι) (a : K), a • (e i))

include h

lemma dual_lc (l : ι →₀ K) (i : ι) : ε i (dual_pair.lc e l) = l i :=
begin
  erw linear_map.map_sum,
  simp only [h.eval, map_smul, smul_eq_mul],
  rw finset.sum_eq_single i,
  { simp },
  { intros q q_in q_ne,
    simp [q_ne.symm] },
  { intro p_not_in,
    simp [finsupp.not_mem_support_iff.1 p_not_in] },
end

@[simp]
lemma coeffs_lc (l : ι →₀ K) : h.coeffs (dual_pair.lc e l) = l :=
by { ext i, rw [h.coeffs_apply, h.dual_lc] }

/-- For any v : V n, \sum_{p ∈ Q n} (ε p v) • e p = v -/
lemma decomposition (v : V) : dual_pair.lc e (h.coeffs v) = v :=
begin
  refine eq_of_sub_eq_zero (h.total _),
  intros i,
  simp [-sub_eq_add_neg, linear_map.map_sub, h.dual_lc, sub_eq_zero]
end

lemma mem_of_mem_span {H : set ι} {x : V} (hmem : x ∈ submodule.span K (e '' H)) :
  ∀ i : ι, ε i x ≠ 0 → i ∈ H :=
begin
  intros i hi,
  rcases (finsupp.mem_span_iff_total _).mp hmem with ⟨l, supp_l, sum_l⟩,
  change dual_pair.lc e l = x at sum_l,
  rw finsupp.mem_supported' at supp_l,
  apply classical.by_contradiction,
  intro i_not,
  apply hi,
  rw ← sum_l,
  simpa [h.dual_lc] using supp_l i i_not
end

lemma is_basis : is_basis K e :=
begin
  split,
  { rw linear_independent_iff,
    intros l H,
    change dual_pair.lc e l = 0 at H,
    ext i,
    apply_fun ε i at H,
    simpa [h.dual_lc] using H },
  { rw submodule.eq_top_iff',
    intro v,
    rw [← set.image_univ, finsupp.mem_span_iff_total],
    exact ⟨h.coeffs v, by simp, h.decomposition v⟩ },
end

lemma eq_dual : ε = is_basis.dual_basis h.is_basis :=
begin
  funext i,
  refine h.is_basis.ext (λ _, _),
  erw [is_basis.to_dual_apply, h.eval]
end

end dual_pair

namespace submodule

universes u v w

variables {R : Type u} {M : Type v} [comm_ring R] [add_comm_group M] [module R M]
variable {W : submodule R M}

/-- The `dual_restrict` of a submodule `W` of `M` is the linear map from the
  dual of `M` to the dual of `W` such that the domain of each linear map is
  restricted to `W`. -/
def dual_restrict (W : submodule R M) :
  module.dual R M →ₗ[R] module.dual R W :=
linear_map.dom_restrict' W

@[simp] lemma dual_restrict_apply
  (W : submodule R M) (φ : module.dual R M) (x : W) :
  W.dual_restrict φ x = φ (x : M) := rfl

/-- The `dual_annihilator` of a submodule `W` is the set of linear maps `φ` such
  that `φ w = 0` for all `w ∈ W`. -/
def dual_annihilator {R : Type u} {M : Type v} [comm_ring R] [add_comm_group M]
  [module R M] (W : submodule R M) : submodule R $ module.dual R M :=
W.dual_restrict.ker

@[simp] lemma mem_dual_annihilator (φ : module.dual R M) :
  φ ∈ W.dual_annihilator ↔ ∀ w ∈ W, φ w = 0 :=
begin
  refine linear_map.mem_ker.trans _,
  simp_rw [linear_map.ext_iff, dual_restrict_apply],
  exact ⟨λ h w hw, h ⟨w, hw⟩, λ h w, h w.1 w.2⟩
end

lemma dual_restrict_ker_eq_dual_annihilator (W : submodule R M) :
  W.dual_restrict.ker = W.dual_annihilator :=
rfl

lemma dual_annihilator_sup_eq_inf_dual_annihilator (U V : submodule R M) :
  (U ⊔ V).dual_annihilator = U.dual_annihilator ⊓ V.dual_annihilator :=
begin
  ext φ,
  rw [mem_inf, mem_dual_annihilator, mem_dual_annihilator, mem_dual_annihilator],
  split; intro h,
  { refine ⟨_, _⟩;
    intros x hx,
    exact h x (mem_sup.2 ⟨x, hx, 0, zero_mem _, add_zero _⟩),
    exact h x (mem_sup.2 ⟨0, zero_mem _, x, hx, zero_add _⟩) },
  { simp_rw mem_sup,
    rintro _ ⟨x, hx, y, hy, rfl⟩,
    rw [linear_map.map_add, h.1 _ hx, h.2 _ hy, add_zero] }
end

/-- The pullback of a submodule in the dual space along the evaluation map. -/
def dual_annihilator_comap (Φ : submodule R (module.dual R M)) : submodule R M :=
Φ.dual_annihilator.comap (module.dual.eval R M)

lemma mem_dual_annihilator_comap_iff {Φ : submodule R (module.dual R M)} (x : M) :
  x ∈ Φ.dual_annihilator_comap ↔ ∀ φ ∈ Φ, (φ x : R) = 0 :=
by simp_rw [dual_annihilator_comap, mem_comap, mem_dual_annihilator, module.dual.eval_apply]

end submodule

namespace subspace

open submodule linear_map

universes u v w

-- We work in vector spaces because `exists_is_compl` only hold for vector spaces
variables {K : Type u} {V : Type v} [field K] [add_comm_group V] [module K V]

/-- Given a subspace `W` of `V` and an element of its dual `φ`, `dual_lift W φ` is
the natural extension of `φ` to an element of the dual of `V`.
That is, `dual_lift W φ` sends `w ∈ W` to `φ x` and `x` in the complement of `W` to `0`. -/
noncomputable def dual_lift (W : subspace K V) :
  module.dual K W →ₗ[K] module.dual K V :=
let h := classical.indefinite_description _ W.exists_is_compl in
  (linear_map.of_is_compl_prod h.2).comp (linear_map.inl _ _ _)

variable {W : subspace K V}

@[simp] lemma dual_lift_of_subtype {φ : module.dual K W} (w : W) :
  W.dual_lift φ (w : V) = φ w :=
by { erw of_is_compl_left_apply _ w, refl }

lemma dual_lift_of_mem {φ : module.dual K W} {w : V} (hw : w ∈ W) :
  W.dual_lift φ w = φ ⟨w, hw⟩ :=
dual_lift_of_subtype ⟨w, hw⟩

@[simp] lemma dual_restrict_comp_dual_lift (W : subspace K V) :
  W.dual_restrict.comp W.dual_lift = 1 :=
by { ext φ x, simp }

lemma dual_restrict_left_inverse (W : subspace K V) :
  function.left_inverse W.dual_restrict W.dual_lift :=
λ x, show W.dual_restrict.comp W.dual_lift x = x,
  by { rw [dual_restrict_comp_dual_lift], refl }

lemma dual_lift_right_inverse (W : subspace K V) :
  function.right_inverse W.dual_lift W.dual_restrict :=
W.dual_restrict_left_inverse

lemma dual_restrict_surjective :
  function.surjective W.dual_restrict :=
W.dual_lift_right_inverse.surjective

lemma dual_lift_injective : function.injective W.dual_lift :=
W.dual_restrict_left_inverse.injective

/-- The quotient by the `dual_annihilator` of a subspace is isomorphic to the
  dual of that subspace. -/
noncomputable def quot_annihilator_equiv (W : subspace K V) :
  W.dual_annihilator.quotient ≃ₗ[K] module.dual K W :=
(quot_equiv_of_eq _ _ W.dual_restrict_ker_eq_dual_annihilator).symm.trans $
  W.dual_restrict.quot_ker_equiv_of_surjective dual_restrict_surjective

/-- The natural isomorphism forom the dual of a subspace `W` to `W.dual_lift.range`. -/
noncomputable def dual_equiv_dual (W : subspace K V) :
  module.dual K W ≃ₗ[K] W.dual_lift.range :=
linear_equiv.of_injective _ $ ker_eq_bot.2 dual_lift_injective

lemma dual_equiv_dual_def (W : subspace K V) :
  W.dual_equiv_dual.to_linear_map = W.dual_lift.range_restrict := rfl

@[simp] lemma dual_equiv_dual_apply (φ : module.dual K W) :
  W.dual_equiv_dual φ = ⟨W.dual_lift φ, mem_range.2 ⟨φ, rfl⟩⟩ := rfl

section

open_locale classical

open finite_dimensional

variables {V₁ : Type*} [add_comm_group V₁] [module K V₁]

instance [H : finite_dimensional K V] : finite_dimensional K (module.dual K V) :=
begin
  refine @linear_equiv.finite_dimensional _ _ _ _ _ _ _ _ _ H,
  have hB := classical.some_spec (exists_is_basis_finite K V),
  haveI := classical.choice hB.2,
  exact is_basis.to_dual_equiv _ hB.1
end

variables [finite_dimensional K V] [finite_dimensional K V₁]

@[simp] lemma dual_finrank_eq :
  finrank K (module.dual K V) = finrank K V :=
begin
  obtain ⟨n, hn, hf⟩ := exists_is_basis_finite K V,
  refine linear_equiv.finrank_eq _,
  haveI : fintype n := set.finite.fintype hf,
  refine (hn.to_dual_equiv _).symm,
end

/-- The quotient by the dual is isomorphic to its dual annihilator.  -/
noncomputable def quot_dual_equiv_annihilator (W : subspace K V) :
  W.dual_lift.range.quotient ≃ₗ[K] W.dual_annihilator :=
linear_equiv.quot_equiv_of_quot_equiv $
  linear_equiv.trans W.quot_annihilator_equiv W.dual_equiv_dual

/-- The quotient by a subspace is isomorphic to its dual annihilator. -/
noncomputable def quot_equiv_annihilator (W : subspace K V) :
  W.quotient ≃ₗ[K] W.dual_annihilator :=
begin
  refine linear_equiv.trans _ W.quot_dual_equiv_annihilator,
  refine linear_equiv.quot_equiv_of_equiv _ _,
  { refine linear_equiv.trans _ W.dual_equiv_dual,
    have hB := classical.some_spec (exists_is_basis_finite K W),
    haveI := classical.choice hB.2,
    exact is_basis.to_dual_equiv _ hB.1 },
  { have hB := classical.some_spec (exists_is_basis_finite K V),
    haveI := classical.choice hB.2,
    exact is_basis.to_dual_equiv _ hB.1 },
end

open finite_dimensional

@[simp]
lemma finrank_dual_annihilator_comap_eq {Φ : subspace K (module.dual K V)} :
  finrank K Φ.dual_annihilator_comap = finrank K Φ.dual_annihilator :=
begin
  rw [submodule.dual_annihilator_comap, ← module.eval_equiv_to_linear_map],
  exact linear_equiv.finrank_eq (linear_equiv.of_submodule' _ _),
end

lemma finrank_add_finrank_dual_annihilator_comap_eq
  (W : subspace K (module.dual K V)) :
  finrank K W + finrank K W.dual_annihilator_comap = finrank K V :=
begin
  rw [finrank_dual_annihilator_comap_eq, W.quot_equiv_annihilator.finrank_eq.symm, add_comm,
      submodule.finrank_quotient_add_finrank, subspace.dual_finrank_eq],
end

end

end subspace

variables {R : Type*} [comm_ring R] {M₁ : Type*} {M₂ : Type*}
variables [add_comm_group M₁] [module R M₁] [add_comm_group M₂] [module R M₂]

open module

/-- Given a linear map `f : M₁ →ₗ[R] M₂`, `f.dual_map` is the linear map between the dual of
`M₂` and `M₁` such that it maps the functional `φ` to `φ ∘ f`. -/
def linear_map.dual_map (f : M₁ →ₗ[R] M₂) : dual R M₂ →ₗ[R] dual R M₁ :=
linear_map.lcomp R R f

@[simp] lemma linear_map.dual_map_apply (f : M₁ →ₗ[R] M₂) (g : dual R M₂) (x : M₁) :
  f.dual_map g x = g (f x) :=
linear_map.lcomp_apply f g x

@[simp] lemma linear_map.dual_map_id :
  (linear_map.id : M₁ →ₗ[R] M₁).dual_map = linear_map.id :=
by { ext, refl }

lemma linear_map.dual_map_comp_dual_map {M₃ : Type*} [add_comm_group M₃] [module R M₃]
  (f : M₁ →ₗ[R] M₂) (g : M₂ →ₗ[R] M₃) :
  f.dual_map.comp g.dual_map = (g.comp f).dual_map :=
rfl

/-- The `linear_equiv` version of `linear_map.dual_map`. -/
def linear_equiv.dual_map (f : M₁ ≃ₗ[R] M₂) : dual R M₂ ≃ₗ[R] dual R M₁ :=
{ inv_fun := f.symm.to_linear_map.dual_map,
  left_inv :=
    begin
      intro φ, ext x,
      simp only [linear_map.dual_map_apply, linear_equiv.coe_to_linear_map,
                 linear_map.to_fun_eq_coe, linear_equiv.apply_symm_apply]
    end,
  right_inv :=
    begin
      intro φ, ext x,
      simp only [linear_map.dual_map_apply, linear_equiv.coe_to_linear_map,
                 linear_map.to_fun_eq_coe, linear_equiv.symm_apply_apply]
    end,
  .. f.to_linear_map.dual_map }

@[simp] lemma linear_equiv.dual_map_apply (f : M₁ ≃ₗ[R] M₂) (g : dual R M₂) (x : M₁) :
  f.dual_map g x = g (f x) :=
linear_map.lcomp_apply f g x

@[simp] lemma linear_equiv.dual_map_refl :
  (linear_equiv.refl R M₁).dual_map = linear_equiv.refl R (dual R M₁) :=
by { ext, refl }

@[simp] lemma linear_equiv.dual_map_symm {f : M₁ ≃ₗ[R] M₂} :
  (linear_equiv.dual_map f).symm = linear_equiv.dual_map f.symm := rfl

lemma linear_equiv.dual_map_trans {M₃ : Type*} [add_comm_group M₃] [module R M₃]
  (f : M₁ ≃ₗ[R] M₂) (g : M₂ ≃ₗ[R] M₃) :
  g.dual_map.trans f.dual_map = (f.trans g).dual_map :=
rfl

namespace linear_map

variable (f : M₁ →ₗ[R] M₂)

lemma ker_dual_map_eq_dual_annihilator_range :
  f.dual_map.ker = f.range.dual_annihilator :=
begin
  ext φ, split; intro hφ,
  { rw mem_ker at hφ,
    rw submodule.mem_dual_annihilator,
    rintro y ⟨x, rfl⟩,
    rw [← dual_map_apply, hφ, zero_apply] },
  { ext x,
    rw dual_map_apply,
    rw submodule.mem_dual_annihilator at hφ,
    exact hφ (f x) ⟨x, rfl⟩ }
end

lemma range_dual_map_le_dual_annihilator_ker :
  f.dual_map.range ≤ f.ker.dual_annihilator :=
begin
  rintro _ ⟨ψ, rfl⟩,
  simp_rw [submodule.mem_dual_annihilator, mem_ker],
  rintro x hx,
  rw [dual_map_apply, hx, map_zero]
end

section finite_dimensional

variables {K : Type*} [field K] {V₁ : Type*} {V₂ : Type*}
variables [add_comm_group V₁] [module K V₁] [add_comm_group V₂] [module K V₂]

open finite_dimensional

variable [finite_dimensional K V₂]

@[simp] lemma finrank_range_dual_map_eq_finrank_range (f : V₁ →ₗ[K] V₂) :
  finrank K f.dual_map.range = finrank K f.range :=
begin
  have := submodule.finrank_quotient_add_finrank f.range,
  rw [(subspace.quot_equiv_annihilator f.range).finrank_eq,
      ← ker_dual_map_eq_dual_annihilator_range] at this,
  conv_rhs at this { rw ← subspace.dual_finrank_eq },
  refine add_left_injective (finrank K f.dual_map.ker) _,
  change _ + _ = _ + _,
  rw [finrank_range_add_finrank_ker f.dual_map, add_comm, this],
end

lemma range_dual_map_eq_dual_annihilator_ker [finite_dimensional K V₁] (f : V₁ →ₗ[K] V₂) :
  f.dual_map.range = f.ker.dual_annihilator :=
begin
  refine eq_of_le_of_finrank_eq f.range_dual_map_le_dual_annihilator_ker _,
  have := submodule.finrank_quotient_add_finrank f.ker,
  rw (subspace.quot_equiv_annihilator f.ker).finrank_eq at this,
  refine add_left_injective (finrank K f.ker) _,
  simp_rw [this, finrank_range_dual_map_eq_finrank_range],
  exact finrank_range_add_finrank_ker f,
end

end finite_dimensional

end linear_map


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

! This file was ported from Lean 3 source module topology.noetherian_space
! leanprover-community/mathlib commit dc6c365e751e34d100e80fe6e314c3c3e0fd2988
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Order.CompactlyGenerated
import Mathlib.Topology.Sets.Closeds

/-!
# Noetherian space

A Noetherian space is a topological space that satisfies any of the following equivalent conditions:
- `WellFounded ((· > ·) : TopologicalSpace.Opens α → TopologicalSpace.Opens α → Prop)`
- `WellFounded ((· < ·) : TopologicalSpace.Closeds α → TopologicalSpace.Closeds α → Prop)`
- `∀ s : Set α, IsCompact s`
- `∀ s : TopologicalSpace.Opens α, IsCompact s`

The first is chosen as the definition, and the equivalence is shown in
`TopologicalSpace.noetherianSpace_TFAE`.

Many examples of noetherian spaces come from algebraic topology. For example, the underlying space
of a noetherian scheme (e.g., the spectrum of a noetherian ring) is noetherian.

## Main Results

- `TopologicalSpace.NoetherianSpace.set`: Every subspace of a noetherian space is noetherian.
- `TopologicalSpace.NoetherianSpace.isCompact`: Every set in a noetherian space is a compact set.
- `TopologicalSpace.noetherianSpace_TFAE`: Describes the equivalent definitions of noetherian
  spaces.
- `TopologicalSpace.NoetherianSpace.range`: The image of a noetherian space under a continuous map
  is noetherian.
- `TopologicalSpace.NoetherianSpace.unionᵢ`: The finite union of noetherian spaces is noetherian.
- `TopologicalSpace.NoetherianSpace.discrete`: A noetherian and Hausdorff space is discrete.
- `TopologicalSpace.NoetherianSpace.exists_finset_irreducible` : Every closed subset of a noetherian
  space is a finite union of irreducible closed subsets.
- `TopologicalSpace.NoetherianSpace.finite_irreducibleComponents `: The number of irreducible
  components of a noetherian space is finite.

-/

variable (α β : Type _) [TopologicalSpace α] [TopologicalSpace β]

namespace TopologicalSpace

/-- Type class for noetherian spaces. It is defined to be spaces whose open sets satisfies ACC. -/
@[mk_iff noetherianSpace_iff]
class NoetherianSpace : Prop where
  wellFounded_opens : WellFounded ((· > ·) : Opens α → Opens α → Prop)
#align topological_space.noetherian_space TopologicalSpace.NoetherianSpace

theorem noetherianSpace_iff_opens : NoetherianSpace α ↔ ∀ s : Opens α, IsCompact (s : Set α) := by
  rw [noetherianSpace_iff, CompleteLattice.wellFounded_iff_isSupFiniteCompact,
    CompleteLattice.isSupFiniteCompact_iff_all_elements_compact]
  exact forall_congr' Opens.isCompactElement_iff
#align topological_space.noetherian_space_iff_opens TopologicalSpace.noetherianSpace_iff_opens

instance (priority := 100) NoetherianSpace.compactSpace [h : NoetherianSpace α] : CompactSpace α :=
  ⟨(noetherianSpace_iff_opens α).mp h ⊤⟩
#align topological_space.noetherian_space.compact_space TopologicalSpace.NoetherianSpace.compactSpace

variable {α β}

/-- In a Noetherian space, all sets are compact. -/
protected theorem NoetherianSpace.isCompact [NoetherianSpace α] (s : Set α) : IsCompact s := by
  refine isCompact_iff_finite_subcover.2 fun U hUo hs => ?_
  rcases ((noetherianSpace_iff_opens α).mp ‹_› ⟨⋃ i, U i, isOpen_unionᵢ hUo⟩).elim_finite_subcover U
    hUo Set.Subset.rfl with ⟨t, ht⟩
  exact ⟨t, hs.trans ht⟩
#align topological_space.noetherian_space.is_compact TopologicalSpace.NoetherianSpace.isCompact

-- porting note: fixed NS
protected theorem _root_.Inducing.noetherianSpace [NoetherianSpace α] {i : β → α}
    (hi : Inducing i) : NoetherianSpace β :=
  (noetherianSpace_iff_opens _).2 fun _ => hi.isCompact_iff.1 (NoetherianSpace.isCompact _)
#align topological_space.inducing.noetherian_space Inducing.noetherianSpace

instance NoetherianSpace.set [NoetherianSpace α] (s : Set α) : NoetherianSpace s :=
  inducing_subtype_val.noetherianSpace
#align topological_space.noetherian_space.set TopologicalSpace.NoetherianSpace.set

variable (α)

open List in
theorem noetherianSpace_TFAE :
    TFAE [NoetherianSpace α,
      WellFounded fun s t : Closeds α => s < t,
      ∀ s : Set α, IsCompact s,
      ∀ s : Opens α, IsCompact (s : Set α)] := by
  tfae_have 1 ↔ 2
  · refine' (noetherianSpace_iff α).trans (Surjective.wellFounded_iff Opens.compl_bijective.2 _)
    exact (@OrderIso.compl (Set α)).lt_iff_lt.symm
  tfae_have 1 ↔ 4
  · exact noetherianSpace_iff_opens α
  tfae_have 1 → 3
  · exact @NoetherianSpace.isCompact α _
  tfae_have 3 → 4
  · exact fun h s => h s
  tfae_finish
#align topological_space.noetherian_space_tfae TopologicalSpace.noetherianSpace_TFAE

variable {α}

theorem noetherianSpace_iff_isCompact : NoetherianSpace α ↔ ∀ s : Set α, IsCompact s :=
  (noetherianSpace_TFAE α).out 0 2

theorem NoetherianSpace.wellFounded_closeds [NoetherianSpace α] :
    WellFounded fun s t : Closeds α => s < t :=
  Iff.mp ((noetherianSpace_TFAE α).out 0 1) ‹_›

instance {α} : NoetherianSpace (CofiniteTopology α) := by
  simp only [noetherianSpace_iff_isCompact, isCompact_iff_ultrafilter_le_nhds,
    CofiniteTopology.nhds_eq, Ultrafilter.le_sup_iff, Filter.le_principal_iff]
  intro s f hs
  rcases f.le_cofinite_or_eq_pure with (hf | ⟨a, rfl⟩)
  · rcases Filter.nonempty_of_mem hs with ⟨a, ha⟩
    exact ⟨a, ha, Or.inr hf⟩
  · exact ⟨a, hs, Or.inl le_rfl⟩

theorem noetherianSpace_of_surjective [NoetherianSpace α] (f : α → β) (hf : Continuous f)
    (hf' : Function.Surjective f) : NoetherianSpace β :=
  noetherianSpace_iff_isCompact.2 $ (Set.image_surjective.mpr hf').forall.2 $ fun s =>
    (NoetherianSpace.isCompact s).image hf
#align topological_space.noetherian_space_of_surjective TopologicalSpace.noetherianSpace_of_surjective

theorem noetherianSpace_iff_of_homeomorph (f : α ≃ₜ β) : NoetherianSpace α ↔ NoetherianSpace β :=
  ⟨fun _ => noetherianSpace_of_surjective f f.continuous f.surjective,
    fun _ => noetherianSpace_of_surjective f.symm f.symm.continuous f.symm.surjective⟩
#align topological_space.noetherian_space_iff_of_homeomorph TopologicalSpace.noetherianSpace_iff_of_homeomorph

theorem NoetherianSpace.range [NoetherianSpace α] (f : α → β) (hf : Continuous f) :
    NoetherianSpace (Set.range f) :=
  noetherianSpace_of_surjective (Set.rangeFactorization f) (hf.subtype_mk _)
    Set.surjective_onto_range
#align topological_space.noetherian_space.range TopologicalSpace.NoetherianSpace.range

theorem noetherianSpace_set_iff (s : Set α) :
    NoetherianSpace s ↔ ∀ t, t ⊆ s → IsCompact t := by
  simp only [noetherianSpace_iff_isCompact, embedding_subtype_val.isCompact_iff_isCompact_image,
    Subtype.forall_set_subtype]
#align topological_space.noetherian_space_set_iff TopologicalSpace.noetherianSpace_set_iff

@[simp]
theorem noetherian_univ_iff : NoetherianSpace (Set.univ : Set α) ↔ NoetherianSpace α :=
  noetherianSpace_iff_of_homeomorph (Homeomorph.Set.univ α)
#align topological_space.noetherian_univ_iff TopologicalSpace.noetherian_univ_iff

theorem NoetherianSpace.unionᵢ {ι : Type _} (f : ι → Set α) [Finite ι]
    [hf : ∀ i, NoetherianSpace (f i)] : NoetherianSpace (⋃ i, f i) := by
  simp_rw [noetherianSpace_set_iff] at hf ⊢
  intro t ht
  rw [← Set.inter_eq_left_iff_subset.mpr ht, Set.inter_unionᵢ]
  exact isCompact_unionᵢ fun i => hf i _ (Set.inter_subset_right _ _)
#align topological_space.noetherian_space.Union TopologicalSpace.NoetherianSpace.unionᵢ

-- This is not an instance since it makes a loop with `t2_space_discrete`.
theorem NoetherianSpace.discrete [NoetherianSpace α] [T2Space α] : DiscreteTopology α :=
  ⟨eq_bot_iff.mpr fun _ _ => isClosed_compl_iff.mp (NoetherianSpace.isCompact _).isClosed⟩
#align topological_space.noetherian_space.discrete TopologicalSpace.NoetherianSpace.discrete

attribute [local instance] NoetherianSpace.discrete

/-- Spaces that are both Noetherian and Hausdorff are finite. -/
theorem NoetherianSpace.finite [NoetherianSpace α] [T2Space α] : Finite α :=
  Finite.of_finite_univ (NoetherianSpace.isCompact Set.univ).finite_of_discrete
#align topological_space.noetherian_space.finite TopologicalSpace.NoetherianSpace.finite

instance (priority := 100) Finite.to_noetherianSpace [Finite α] : NoetherianSpace α :=
  ⟨Finite.wellFounded_of_trans_of_irrefl _⟩
#align topological_space.finite.to_noetherian_space TopologicalSpace.Finite.to_noetherianSpace

/-- In a Noetherian space, every closed set is a finite union of irreducible closed sets. -/
theorem NoetherianSpace.exists_finite_set_closeds_irreducible [NoetherianSpace α] (s : Closeds α) :
    ∃ S : Set (Closeds α), S.Finite ∧ (∀ t ∈ S, IsIrreducible (t : Set α)) ∧ s = supₛ S := by
  apply wellFounded_closeds.induction s; clear s
  intro s H
  rcases eq_or_ne s ⊥ with rfl | h₀
  · use ∅; simp
  · by_cases h₁ : IsPreirreducible (s : Set α)
    · replace h₁ : IsIrreducible (s : Set α) := ⟨Closeds.coe_nonempty.2 h₀, h₁⟩
      use {s}; simp [h₁]
    · simp only [isPreirreducible_iff_closed_union_closed, not_forall, not_or] at h₁
      obtain ⟨z₁, z₂, hz₁, hz₂, h, hz₁', hz₂'⟩ := h₁
      lift z₁ to Closeds α using hz₁
      lift z₂ to Closeds α using hz₂
      rcases H (s ⊓ z₁) (inf_lt_left.2 hz₁') with ⟨S₁, hSf₁, hS₁, h₁⟩
      rcases H (s ⊓ z₂) (inf_lt_left.2 hz₂') with ⟨S₂, hSf₂, hS₂, h₂⟩
      refine ⟨S₁ ∪ S₂, hSf₁.union hSf₂, Set.union_subset_iff.2 ⟨hS₁, hS₂⟩, ?_⟩
      rwa [supₛ_union, ← h₁, ← h₂, ← inf_sup_left, left_eq_inf]

/-- In a Noetherian space, every closed set is a finite union of irreducible closed sets. -/
theorem NoetherianSpace.exists_finite_set_isClosed_irreducible [NoetherianSpace α]
    {s : Set α} (hs : IsClosed s) : ∃ S : Set (Set α), S.Finite ∧
      (∀ t ∈ S, IsClosed t) ∧ (∀ t ∈ S, IsIrreducible t) ∧ s = ⋃₀ S := by
  lift s to Closeds α using hs
  rcases NoetherianSpace.exists_finite_set_closeds_irreducible s with ⟨S, hSf, hS, rfl⟩
  refine ⟨(↑) '' S, hSf.image _, Set.ball_image_iff.2 fun S _ => S.2, Set.ball_image_iff.2 hS, ?_⟩
  lift S to Finset (Closeds α) using hSf
  simp [← Finset.sup_id_eq_supₛ, Closeds.coe_finset_sup]

/-- In a Noetherian space, every closed set is a finite union of irreducible closed sets. -/
theorem NoetherianSpace.exists_finset_irreducible [NoetherianSpace α] (s : Closeds α) :
    ∃ S : Finset (Closeds α), (∀ k : S, IsIrreducible (k : Set α)) ∧ s = S.sup id := by
  simpa [Set.exists_finite_iff_finset, Finset.sup_id_eq_supₛ]
    using NoetherianSpace.exists_finite_set_closeds_irreducible s
#align topological_space.noetherian_space.exists_finset_irreducible TopologicalSpace.NoetherianSpace.exists_finset_irreducible

theorem NoetherianSpace.finite_irreducibleComponents [NoetherianSpace α] :
    (irreducibleComponents α).Finite := by
  obtain ⟨S : Set (Set α), hSf, hSc, hSi, hSU⟩ :=
    NoetherianSpace.exists_finite_set_isClosed_irreducible isClosed_univ
  refine hSf.subset fun s hs => ?_
  lift S to Finset (Set α) using hSf
  rcases isIrreducible_iff_unionₛ_closed.1 hs.1 S hSc (hSU ▸ Set.subset_univ _) with ⟨t, htS, ht⟩
  rwa [ht.antisymm (hs.2 (hSi _ htS) ht)]
#align topological_space.noetherian_space.finite_irreducible_components TopologicalSpace.NoetherianSpace.finite_irreducibleComponents

end TopologicalSpace


/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov, Patrick Massot

! This file was ported from Lean 3 source module data.set.intervals.proj_Icc
! leanprover-community/mathlib commit aba57d4d3dae35460225919dcd82fe91355162f9
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Set.Function
import Mathlib.Data.Set.Intervals.Basic

/-!
# Projection of a line onto a closed interval

Given a linearly ordered type `α`, in this file we define

* `Set.projIcc (a b : α) (h : a ≤ b)` to be the map `α → [a, b]` sending `(-∞, a]` to `a`, `[b, ∞)`
  to `b`, and each point `x ∈ [a, b]` to itself;
* `Set.IccExtend {a b : α} (h : a ≤ b) (f : Icc a b → β)` to be the extension of `f` to `α` defined
  as `f ∘ projIcc a b h`.

We also prove some trivial properties of these maps.
-/

variable {α β : Type _} [LinearOrder α]

open Function

namespace Set

/-- Projection of `α` to the closed interval `[a, b]`. -/
def projIcc (a b : α) (h : a ≤ b) (x : α) : Icc a b :=
  ⟨max a (min b x), le_max_left _ _, max_le h (min_le_left _ _)⟩
#align set.proj_Icc Set.projIcc

variable {a b : α} (h : a ≤ b) {x : α}

theorem projIcc_of_le_left (hx : x ≤ a) : projIcc a b h x = ⟨a, left_mem_Icc.2 h⟩ := by
  simp [projIcc, hx, hx.trans h]
#align set.proj_Icc_of_le_left Set.projIcc_of_le_left

@[simp]
theorem projIcc_left : projIcc a b h a = ⟨a, left_mem_Icc.2 h⟩ :=
  projIcc_of_le_left h le_rfl
#align set.proj_Icc_left Set.projIcc_left

theorem projIcc_of_right_le (hx : b ≤ x) : projIcc a b h x = ⟨b, right_mem_Icc.2 h⟩ := by
  simp [projIcc, hx, h]
#align set.proj_Icc_of_right_le Set.projIcc_of_right_le

@[simp]
theorem projIcc_right : projIcc a b h b = ⟨b, right_mem_Icc.2 h⟩ :=
  projIcc_of_right_le h le_rfl
#align set.proj_Icc_right Set.projIcc_right

theorem projIcc_eq_left (h : a < b) : projIcc a b h.le x = ⟨a, left_mem_Icc.mpr h.le⟩ ↔ x ≤ a := by
  refine' ⟨fun h' => _, projIcc_of_le_left _⟩
  simp_rw [Subtype.ext_iff_val, projIcc, max_eq_left_iff, min_le_iff, h.not_le, false_or_iff] at h'
  exact h'
#align set.proj_Icc_eq_left Set.projIcc_eq_left

theorem projIcc_of_mem (hx : x ∈ Icc a b) : projIcc a b h x = ⟨x, hx⟩ := by
  simp [projIcc, hx.1, hx.2]
#align set.proj_Icc_of_mem Set.projIcc_of_mem

@[simp]
theorem projIcc_val (x : Icc a b) : projIcc a b h x = x := by
  cases x
  apply projIcc_of_mem
#align set.proj_Icc_coe Set.projIcc_val

theorem projIcc_surjOn : SurjOn (projIcc a b h) (Icc a b) univ := fun x _ =>
  ⟨x, x.2, projIcc_val h x⟩
#align set.proj_Icc_surj_on Set.projIcc_surjOn

theorem projIcc_surjective : Surjective (projIcc a b h) := fun x => ⟨x, projIcc_val h x⟩
#align set.proj_Icc_surjective Set.projIcc_surjective

@[simp]
theorem range_projIcc : range (projIcc a b h) = univ :=
  Function.Surjective.range_eq (projIcc_surjective h)
#align set.range_proj_Icc Set.range_projIcc

theorem monotone_projIcc : Monotone (projIcc a b h) := fun _ _ hxy =>
  max_le_max le_rfl <| min_le_min le_rfl hxy
#align set.monotone_proj_Icc Set.monotone_projIcc

theorem strictMonoOn_projIcc : StrictMonoOn (projIcc a b h) (Icc a b) := fun x hx y hy hxy => by
  simpa only [projIcc_of_mem, hx, hy]
#align set.strict_mono_on_proj_Icc Set.strictMonoOn_projIcc

/-- Extend a function `[a, b] → β` to a map `α → β`. -/
def IccExtend {a b : α} (h : a ≤ b) (f : Icc a b → β) : α → β :=
  f ∘ projIcc a b h
#align set.Icc_extend Set.IccExtend

@[simp]
theorem IccExtend_range (f : Icc a b → β) : range (IccExtend h f) = range f := by
  simp only [IccExtend, range_comp f, range_projIcc, image_univ]
#align set.Icc_extend_range Set.IccExtend_range

theorem IccExtend_of_le_left (f : Icc a b → β) (hx : x ≤ a) :
    IccExtend h f x = f ⟨a, left_mem_Icc.2 h⟩ :=
  congr_arg f <| projIcc_of_le_left h hx
#align set.Icc_extend_of_le_left Set.IccExtend_of_le_left

@[simp]
theorem IccExtend_left (f : Icc a b → β) : IccExtend h f a = f ⟨a, left_mem_Icc.2 h⟩ :=
  IccExtend_of_le_left h f le_rfl
#align set.Icc_extend_left Set.IccExtend_left

theorem IccExtend_of_right_le (f : Icc a b → β) (hx : b ≤ x) :
    IccExtend h f x = f ⟨b, right_mem_Icc.2 h⟩ :=
  congr_arg f <| projIcc_of_right_le h hx
#align set.Icc_extend_of_right_le Set.IccExtend_of_right_le

@[simp]
theorem IccExtend_right (f : Icc a b → β) : IccExtend h f b = f ⟨b, right_mem_Icc.2 h⟩ :=
  IccExtend_of_right_le h f le_rfl
#align set.Icc_extend_right Set.IccExtend_right

theorem IccExtend_of_mem (f : Icc a b → β) (hx : x ∈ Icc a b) : IccExtend h f x = f ⟨x, hx⟩ :=
  congr_arg f <| projIcc_of_mem h hx
#align set.Icc_extend_of_mem Set.IccExtend_of_mem

@[simp]
theorem Icc_extend_coe (f : Icc a b → β) (x : Icc a b) : IccExtend h f x = f x :=
  congr_arg f <| projIcc_val h x
#align set.Icc_extend_coe Set.Icc_extend_coe

end Set

open Set

variable [Preorder β] {a b : α} (h : a ≤ b) {f : Icc a b → β}

theorem Monotone.IccExtend (hf : Monotone f) : Monotone (IccExtend h f) :=
  hf.comp <| monotone_projIcc h
#align monotone.Icc_extend Monotone.IccExtend

theorem StrictMono.strictMonoOn_IccExtend (hf : StrictMono f) :
    StrictMonoOn (IccExtend h f) (Icc a b) :=
  hf.comp_strictMonoOn (strictMonoOn_projIcc h)
#align strict_mono.strict_mono_on_Icc_extend StrictMono.strictMonoOn_IccExtend


/-
Copyright (c) 2018 Kevin Buzzard and Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Buzzard, Patrick Massot.

This file is to a certain extent based on `quotient_module.lean` by Johannes Hölzl.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.group_theory.coset
import Mathlib.PostPort

universes u u_1 v

namespace Mathlib

namespace quotient_group

-- Define the `div_inv_monoid` before the `group` structure,

-- to make sure we have `inv` fully defined before we show `mul_left_inv`.

-- TODO: is there a non-invasive way of defining this in one declaration?

protected instance Mathlib.quotient_add_group.div_inv_monoid {G : Type u} [add_group G] (N : add_subgroup G) [nN : add_subgroup.normal N] : sub_neg_monoid (quotient_add_group.quotient N) :=
  sub_neg_monoid.mk (quotient.map₂' Add.add sorry) sorry ↑0 sorry sorry
    (fun (a : quotient_add_group.quotient N) => quotient.lift_on' a (fun (a : G) => ↑(-a)) sorry)
    fun (a b : quotient_add_group.quotient N) =>
      quotient.map₂' Add.add sorry a (quotient.lift_on' b (fun (a : G) => ↑(-a)) sorry)

protected instance Mathlib.quotient_add_group.add_group {G : Type u} [add_group G] (N : add_subgroup G) [nN : add_subgroup.normal N] : add_group (quotient_add_group.quotient N) :=
  add_group.mk sub_neg_monoid.add sorry sub_neg_monoid.zero sorry sorry sub_neg_monoid.neg sub_neg_monoid.sub sorry

/-- The group homomorphism from `G` to `G/N`. -/
def mk' {G : Type u} [group G] (N : subgroup G) [nN : subgroup.normal N] : G →* quotient N :=
  monoid_hom.mk' mk sorry

@[simp] theorem Mathlib.quotient_add_group.ker_mk {G : Type u} [add_group G] (N : add_subgroup G) [nN : add_subgroup.normal N] : add_monoid_hom.ker (quotient_add_group.mk' N) = N := sorry

-- for commutative groups we don't need normality assumption

protected instance Mathlib.quotient_add_group.add_comm_group {G : Type u_1} [add_comm_group G] (N : add_subgroup G) : add_comm_group (quotient_add_group.quotient N) :=
  add_comm_group.mk add_group.add sorry add_group.zero sorry sorry add_group.neg add_group.sub sorry sorry

@[simp] theorem Mathlib.quotient_add_group.coe_zero {G : Type u} [add_group G] (N : add_subgroup G) [nN : add_subgroup.normal N] : ↑0 = 0 :=
  rfl

@[simp] theorem coe_mul {G : Type u} [group G] (N : subgroup G) [nN : subgroup.normal N] (a : G) (b : G) : ↑(a * b) = ↑a * ↑b :=
  rfl

@[simp] theorem Mathlib.quotient_add_group.coe_neg {G : Type u} [add_group G] (N : add_subgroup G) [nN : add_subgroup.normal N] (a : G) : ↑(-a) = -↑a :=
  rfl

@[simp] theorem coe_pow {G : Type u} [group G] (N : subgroup G) [nN : subgroup.normal N] (a : G) (n : ℕ) : ↑(a ^ n) = ↑a ^ n :=
  monoid_hom.map_pow (mk' N) a n

@[simp] theorem coe_gpow {G : Type u} [group G] (N : subgroup G) [nN : subgroup.normal N] (a : G) (n : ℤ) : ↑(a ^ n) = ↑a ^ n :=
  monoid_hom.map_gpow (mk' N) a n

/-- A group homomorphism `φ : G →* H` with `N ⊆ ker(φ)` descends (i.e. `lift`s) to a
group homomorphism `G/N →* H`. -/
def lift {G : Type u} [group G] (N : subgroup G) [nN : subgroup.normal N] {H : Type v} [group H] (φ : G →* H) (HN : ∀ (x : G), x ∈ N → coe_fn φ x = 1) : quotient N →* H :=
  monoid_hom.mk' (fun (q : quotient N) => quotient.lift_on' q ⇑φ sorry) sorry

@[simp] theorem Mathlib.quotient_add_group.lift_mk {G : Type u} [add_group G] (N : add_subgroup G) [nN : add_subgroup.normal N] {H : Type v} [add_group H] {φ : G →+ H} (HN : ∀ (x : G), x ∈ N → coe_fn φ x = 0) (g : G) : coe_fn (quotient_add_group.lift N φ HN) ↑g = coe_fn φ g :=
  rfl

@[simp] theorem lift_mk' {G : Type u} [group G] (N : subgroup G) [nN : subgroup.normal N] {H : Type v} [group H] {φ : G →* H} (HN : ∀ (x : G), x ∈ N → coe_fn φ x = 1) (g : G) : coe_fn (lift N φ HN) (mk g) = coe_fn φ g :=
  rfl

@[simp] theorem Mathlib.quotient_add_group.lift_quot_mk {G : Type u} [add_group G] (N : add_subgroup G) [nN : add_subgroup.normal N] {H : Type v} [add_group H] {φ : G →+ H} (HN : ∀ (x : G), x ∈ N → coe_fn φ x = 0) (g : G) : coe_fn (quotient_add_group.lift N φ HN) (Quot.mk setoid.r g) = coe_fn φ g :=
  rfl

/-- A group homomorphism `f : G →* H` induces a map `G/N →* H/M` if `N ⊆ f⁻¹(M)`. -/
def Mathlib.quotient_add_group.map {G : Type u} [add_group G] (N : add_subgroup G) [nN : add_subgroup.normal N] {H : Type v} [add_group H] (M : add_subgroup H) [add_subgroup.normal M] (f : G →+ H) (h : N ≤ add_subgroup.comap f M) : quotient_add_group.quotient N →+ quotient_add_group.quotient M :=
  quotient_add_group.lift N (add_monoid_hom.comp (quotient_add_group.mk' M) f) sorry

/-- The induced map from the quotient by the kernel to the codomain. -/
def ker_lift {G : Type u} [group G] {H : Type v} [group H] (φ : G →* H) : quotient (monoid_hom.ker φ) →* H :=
  lift (monoid_hom.ker φ) φ sorry

@[simp] theorem ker_lift_mk {G : Type u} [group G] {H : Type v} [group H] (φ : G →* H) (g : G) : coe_fn (ker_lift φ) ↑g = coe_fn φ g :=
  lift_mk (monoid_hom.ker φ) (ker_lift._proof_1 φ) g

@[simp] theorem Mathlib.quotient_add_group.ker_lift_mk' {G : Type u} [add_group G] {H : Type v} [add_group H] (φ : G →+ H) (g : G) : coe_fn (quotient_add_group.ker_lift φ) (quotient_add_group.mk g) = coe_fn φ g :=
  quotient_add_group.lift_mk' (add_monoid_hom.ker φ) (quotient_add_group.ker_lift._proof_1 φ) g

theorem ker_lift_injective {G : Type u} [group G] {H : Type v} [group H] (φ : G →* H) : function.injective ⇑(ker_lift φ) := sorry

-- Note that ker φ isn't definitionally ker (to_range φ)

-- so there is a bit of annoying code duplication here

/-- The induced map from the quotient by the kernel to the range. -/
def Mathlib.quotient_add_group.range_ker_lift {G : Type u} [add_group G] {H : Type v} [add_group H] (φ : G →+ H) : quotient_add_group.quotient (add_monoid_hom.ker φ) →+ ↥(add_monoid_hom.range φ) :=
  quotient_add_group.lift (add_monoid_hom.ker φ) (add_monoid_hom.to_range φ) sorry

theorem range_ker_lift_injective {G : Type u} [group G] {H : Type v} [group H] (φ : G →* H) : function.injective ⇑(range_ker_lift φ) := sorry

theorem Mathlib.quotient_add_group.range_ker_lift_surjective {G : Type u} [add_group G] {H : Type v} [add_group H] (φ : G →+ H) : function.surjective ⇑(quotient_add_group.range_ker_lift φ) := sorry

/-- The first isomorphism theorem (a definition): the canonical isomorphism between
`G/(ker φ)` to `range φ`. -/
def Mathlib.quotient_add_group.quotient_ker_equiv_range {G : Type u} [add_group G] {H : Type v} [add_group H] (φ : G →+ H) : quotient_add_group.quotient (add_monoid_hom.ker φ) ≃+ ↥(add_monoid_hom.range φ) :=
  add_equiv.of_bijective (quotient_add_group.range_ker_lift φ) sorry

/-- The canonical isomorphism `G/(ker φ) ≃* H` induced by a surjection `φ : G →* H`. -/
def Mathlib.quotient_add_group.quotient_ker_equiv_of_surjective {G : Type u} [add_group G] {H : Type v} [add_group H] (φ : G →+ H) (hφ : function.surjective ⇑φ) : quotient_add_group.quotient (add_monoid_hom.ker φ) ≃+ H :=
  add_equiv.of_bijective (quotient_add_group.ker_lift φ) sorry