/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import data.equiv.basic

/-!
# Local equivalences

This files defines equivalences between subsets of given types.
An element `e` of `local_equiv α β` is made of two maps `e.to_fun` and `e.inv_fun` respectively
from α to β and from  β to α (just like equivs), which are inverse to each other on the subsets
`e.source` and `e.target` of respectively α and β.

They are designed in particular to define charts on manifolds.

The main functionality is `e.trans f`, which composes the two local equivalences by restricting
the source and target to the maximal set where the composition makes sense.

As for equivs, we register a coercion to functions and use it in our simp normal form: we write
`e x` and `e.symm y` instead of `e.to_fun x` and `e.inv_fun y`.

## Main definitions

`equiv.to_local_equiv`: associating a local equiv to an equiv, with source = target = univ
`local_equiv.symm`    : the inverse of a local equiv
`local_equiv.trans`   : the composition of two local equivs
`local_equiv.refl`    : the identity local equiv
`local_equiv.of_set`  : the identity on a set `s`
`eq_on_source`        : equivalence relation describing the "right" notion of equality for local
                        equivs (see below in implementation notes)

## Implementation notes

There are at least three possible implementations of local equivalences:
* equivs on subtypes
* pairs of functions taking values in `option α` and `option β`, equal to none where the local
equivalence is not defined
* pairs of functions defined everywhere, keeping the source and target as additional data

Each of these implementations has pros and cons.
* When dealing with subtypes, one still need to define additional API for composition and
restriction of domains. Checking that one always belongs to the right subtype makes things very
tedious, and leads quickly to DTT hell (as the subtype `u ∩ v` is not the "same" as `v ∩ u`, for
instance).
* With option-valued functions, the composition is very neat (it is just the usual composition, and
the domain is restricted automatically). These are implemented in `pequiv.lean`. For manifolds,
where one wants to discuss thoroughly the smoothness of the maps, this creates however a lot of
overhead as one would need to extend all classes of smoothness to option-valued maps.
* The local_equiv version as explained above is easier to use for manifolds. The drawback is that
there is extra useless data (the values of `to_fun` and `inv_fun` outside of `source` and `target`).
In particular, the equality notion between local equivs is not "the right one", i.e., coinciding
source and target and equality there. Moreover, there are no local equivs in this sense between
an empty type and a nonempty type. Since empty types are not that useful, and since one almost never
needs to talk about equal local equivs, this is not an issue in practice.
Still, we introduce an equivalence relation `eq_on_source` that captures this right notion of
equality, and show that many properties are invariant under this equivalence relation.

### Local coding conventions

If a lemma deals with the intersection of a set with either source or target of a `local_equiv`,
then it should use `e.source ∩ s` or `e.target ∩ t`, not `s ∩ e.source` or `t ∩ e.target`.

-/

mk_simp_attribute mfld_simps "The simpset `mfld_simps` records several simp lemmas that are
especially useful in manifolds. It is a subset of the whole set of simp lemmas, but it makes it
possible to have quicker proofs (when used with `squeeze_simp` or `simp only`) while retaining
readability.

The typical use case is the following, in a file on manifolds:
If `simp [foo, bar]` is slow, replace it with `squeeze_simp [foo, bar] with mfld_simps` and paste
its output. The list of lemmas should be reasonable (contrary to the output of
`squeeze_simp [foo, bar]` which might contain tens of lemmas), and the outcome should be quick
enough.
"

-- register in the simpset `mfld_simps` several lemmas that are often useful when dealing
-- with manifolds
attribute [mfld_simps] id.def function.comp.left_id set.mem_set_of_eq set.image_eq_empty
set.univ_inter set.preimage_univ set.prod_mk_mem_set_prod_eq and_true set.mem_univ
set.mem_image_of_mem true_and set.mem_inter_eq set.mem_preimage function.comp_app
set.inter_subset_left set.mem_prod set.range_id and_self set.mem_range_self
eq_self_iff_true forall_const forall_true_iff set.inter_univ set.preimage_id function.comp.right_id
not_false_iff and_imp set.prod_inter_prod set.univ_prod_univ true_or or_true prod.map_mk
set.preimage_inter heq_iff_eq equiv.sigma_equiv_prod_apply equiv.sigma_equiv_prod_symm_apply
subtype.coe_mk equiv.to_fun_as_coe equiv.inv_fun_as_coe

/-- Common `@[simps]` configuration options used for manifold-related declarations. -/
def mfld_cfg : simps_cfg := {attrs := [`simp, `mfld_simps], fully_applied := ff}

namespace tactic.interactive

/-- A very basic tactic to show that sets showing up in manifolds coincide or are included in
one another. -/
meta def mfld_set_tac : tactic unit := do
  goal ← tactic.target,
  match goal with
  | `(%%e₁ = %%e₂) :=
      `[ext my_y,
        split;
        { assume h_my_y,
          try { simp only [*, -h_my_y] with mfld_simps at h_my_y },
          simp only [*] with mfld_simps }]
  | `(%%e₁ ⊆ %%e₂) :=
      `[assume my_y h_my_y,
        try { simp only [*, -h_my_y] with mfld_simps at h_my_y },
        simp only [*] with mfld_simps]
  | _ := tactic.fail "goal should be an equality or an inclusion"
  end

end tactic.interactive

open function set

variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*}

/-- Local equivalence between subsets `source` and `target` of α and β respectively. The (global)
maps `to_fun : α → β` and `inv_fun : β → α` map `source` to `target` and conversely, and are inverse
to each other there. The values of `to_fun` outside of `source` and of `inv_fun` outside of `target`
are irrelevant. -/
@[nolint has_inhabited_instance]
structure local_equiv (α : Type*) (β : Type*) :=
(to_fun      : α → β)
(inv_fun     : β → α)
(source      : set α)
(target      : set β)
(map_source' : ∀{x}, x ∈ source → to_fun x ∈ target)
(map_target' : ∀{x}, x ∈ target → inv_fun x ∈ source)
(left_inv'   : ∀{x}, x ∈ source → inv_fun (to_fun x) = x)
(right_inv'  : ∀{x}, x ∈ target → to_fun (inv_fun x) = x)

/-- Associating a local_equiv to an equiv-/
def equiv.to_local_equiv (e : α ≃ β) : local_equiv α β :=
{ to_fun      := e,
  inv_fun     := e.symm,
  source      := univ,
  target      := univ,
  map_source' := λx hx, mem_univ _,
  map_target' := λy hy, mem_univ _,
  left_inv'   := λx hx, e.left_inv x,
  right_inv'  := λx hx, e.right_inv x }

namespace local_equiv

variables (e : local_equiv α β) (e' : local_equiv β γ)

/-- The inverse of a local equiv -/
protected def symm : local_equiv β α :=
{ to_fun     := e.inv_fun,
  inv_fun    := e.to_fun,
  source     := e.target,
  target     := e.source,
  map_source' := e.map_target',
  map_target' := e.map_source',
  left_inv'   := e.right_inv',
  right_inv'  := e.left_inv' }

instance : has_coe_to_fun (local_equiv α β) := ⟨_, local_equiv.to_fun⟩

/-- See Note [custom simps projection] -/
def simps.symm_apply (e : local_equiv α β) : β → α := e.symm

initialize_simps_projections local_equiv (to_fun → apply, inv_fun → symm_apply)

@[simp, mfld_simps] theorem coe_mk (f : α → β) (g s t ml mr il ir) :
  (local_equiv.mk f g s t ml mr il ir : α → β) = f := rfl

@[simp, mfld_simps] theorem coe_symm_mk (f : α → β) (g s t ml mr il ir) :
  ((local_equiv.mk f g s t ml mr il ir).symm : β → α) = g := rfl

@[simp, mfld_simps] lemma to_fun_as_coe : e.to_fun = e := rfl

@[simp, mfld_simps] lemma inv_fun_as_coe : e.inv_fun = e.symm := rfl

@[simp, mfld_simps] lemma map_source {x : α} (h : x ∈ e.source) : e x ∈ e.target :=
e.map_source' h

@[simp, mfld_simps] lemma map_target {x : β} (h : x ∈ e.target) : e.symm x ∈ e.source :=
e.map_target' h

@[simp, mfld_simps] lemma left_inv {x : α} (h : x ∈ e.source) : e.symm (e x) = x :=
e.left_inv' h

@[simp, mfld_simps] lemma right_inv {x : β} (h : x ∈ e.target) : e (e.symm x) = x :=
e.right_inv' h

protected lemma maps_to : maps_to e e.source e.target := λ x, e.map_source
lemma symm_maps_to : maps_to e.symm e.target e.source := e.symm.maps_to
protected lemma left_inv_on : left_inv_on e.symm e e.source := λ x, e.left_inv
protected lemma right_inv_on : right_inv_on e.symm e e.target := λ x, e.right_inv
protected lemma inv_on : inv_on e.symm e e.source e.target := ⟨e.left_inv_on, e.right_inv_on⟩
protected lemma inj_on : inj_on e e.source := e.left_inv_on.inj_on
protected lemma bij_on : bij_on e e.source e.target := e.inv_on.bij_on e.maps_to e.symm_maps_to
protected lemma surj_on : surj_on e e.source e.target := e.bij_on.surj_on

/-- Create a copy of a `local_equiv` providing better definitional equalities. -/
@[simps] def copy (e : local_equiv α β) (f : α → β) (hf : ⇑e = f) (g : β → α) (hg : ⇑e.symm = g)
  (s : set α) (hs : e.source = s) (t : set β) (ht : e.target = t) :
  local_equiv α β :=
{ to_fun := f,
  inv_fun := g,
  source := s,
  target := t,
  map_source' := λ x, ht ▸ hs ▸ hf ▸ e.map_source,
  map_target' := λ y, hs ▸ ht ▸ hg ▸ e.map_target,
  left_inv' := λ x, hs ▸ hf ▸ hg ▸ e.left_inv,
  right_inv' := λ x, ht ▸ hf ▸ hg ▸ e.right_inv }

lemma copy_eq_self (e : local_equiv α β) (f : α → β) (hf : ⇑e = f) (g : β → α) (hg : ⇑e.symm = g)
  (s : set α) (hs : e.source = s) (t : set β) (ht : e.target = t) :
  e.copy f hf g hg s hs t ht = e :=
by { substs f g s t, cases e, refl }

/-- Associating to a local_equiv an equiv between the source and the target -/
protected def to_equiv : equiv (e.source) (e.target) :=
{ to_fun    := λ x, ⟨e x, e.map_source x.mem⟩,
  inv_fun   := λ y, ⟨e.symm y, e.map_target y.mem⟩,
  left_inv  := λ⟨x, hx⟩, subtype.eq $ e.left_inv hx,
  right_inv := λ⟨y, hy⟩, subtype.eq $ e.right_inv hy }

@[simp, mfld_simps] lemma symm_source : e.symm.source = e.target := rfl
@[simp, mfld_simps] lemma symm_target : e.symm.target = e.source := rfl
@[simp, mfld_simps] lemma symm_symm : e.symm.symm = e := by { cases e, refl }

lemma image_source_eq_target : e '' e.source = e.target := e.bij_on.image_eq

/-- We say that `t : set β` is an image of `s : set α` under a local equivalence if
any of the following equivalent conditions hold:

* `e '' (e.source ∩ s) = e.target ∩ t`;
* `e.source ∩ e ⁻¹ t = e.source ∩ s`;
* `∀ x ∈ e.source, e x ∈ t ↔ x ∈ s` (this one is used in the definition).
-/
def is_image (s : set α) (t : set β) : Prop := ∀ ⦃x⦄, x ∈ e.source → (e x ∈ t ↔ x ∈ s)

namespace is_image

variables {e} {s : set α} {t : set β} {x : α} {y : β}

lemma apply_mem_iff (h : e.is_image s t) (hx : x ∈ e.source) : e x ∈ t ↔ x ∈ s := h hx

lemma symm_apply_mem_iff (h : e.is_image s t) : ∀ ⦃y⦄, y ∈ e.target → (e.symm y ∈ s ↔ y ∈ t) :=
by { rw [← e.image_source_eq_target, ball_image_iff], intros x hx, rw [e.left_inv hx, h hx] }

protected lemma symm (h : e.is_image s t) : e.symm.is_image t s := h.symm_apply_mem_iff

@[simp] lemma symm_iff : e.symm.is_image t s ↔ e.is_image s t := ⟨λ h, h.symm, λ h, h.symm⟩

protected lemma maps_to (h : e.is_image s t) : maps_to e (e.source ∩ s) (e.target ∩ t) :=
λ x hx, ⟨e.maps_to hx.1, (h hx.1).2 hx.2⟩

lemma symm_maps_to (h : e.is_image s t) : maps_to e.symm (e.target ∩ t) (e.source ∩ s) :=
h.symm.maps_to

/-- Restrict a `local_equiv` to a pair of corresponding sets. -/
@[simps] def restr (h : e.is_image s t) : local_equiv α β :=
{ to_fun := e,
  inv_fun := e.symm,
  source := e.source ∩ s,
  target := e.target ∩ t,
  map_source' := h.maps_to,
  map_target' := h.symm_maps_to,
  left_inv' := e.left_inv_on.mono (inter_subset_left _ _),
  right_inv' := e.right_inv_on.mono (inter_subset_left _ _) }

lemma image_eq (h : e.is_image s t) : e '' (e.source ∩ s) = e.target ∩ t :=
h.restr.image_source_eq_target

lemma symm_image_eq (h : e.is_image s t) : e.symm '' (e.target ∩ t) = e.source ∩ s :=
h.symm.image_eq

lemma iff_preimage_eq : e.is_image s t ↔ e.source ∩ e ⁻¹' t = e.source ∩ s :=
by simp only [is_image, set.ext_iff, mem_inter_eq, and.congr_right_iff, mem_preimage]

alias iff_preimage_eq ↔ local_equiv.is_image.preimage_eq local_equiv.is_image.of_preimage_eq

lemma iff_symm_preimage_eq : e.is_image s t ↔ e.target ∩ e.symm ⁻¹' s = e.target ∩ t :=
symm_iff.symm.trans iff_preimage_eq

alias iff_symm_preimage_eq ↔ local_equiv.is_image.symm_preimage_eq
  local_equiv.is_image.of_symm_preimage_eq

lemma of_image_eq (h : e '' (e.source ∩ s) = e.target ∩ t) : e.is_image s t :=
of_symm_preimage_eq $ eq.trans (of_symm_preimage_eq rfl).image_eq.symm h

lemma of_symm_image_eq (h : e.symm '' (e.target ∩ t) = e.source ∩ s) : e.is_image s t :=
of_preimage_eq $ eq.trans (of_preimage_eq rfl).symm_image_eq.symm h

protected lemma compl (h : e.is_image s t) : e.is_image sᶜ tᶜ :=
λ x hx, not_congr (h hx)

protected lemma inter {s' t'} (h : e.is_image s t) (h' : e.is_image s' t') :
  e.is_image (s ∩ s') (t ∩ t') :=
λ x hx, and_congr (h hx) (h' hx)

protected lemma union {s' t'} (h : e.is_image s t) (h' : e.is_image s' t') :
  e.is_image (s ∪ s') (t ∪ t') :=
λ x hx, or_congr (h hx) (h' hx)

protected lemma diff {s' t'} (h : e.is_image s t) (h' : e.is_image s' t') :
  e.is_image (s \ s') (t \ t') :=
h.inter h'.compl

lemma left_inv_on_piecewise {e' : local_equiv α β} [∀ i, decidable (i ∈ s)] [∀ i, decidable (i ∈ t)]
  (h : e.is_image s t) (h' : e'.is_image s t) :
  left_inv_on (t.piecewise e.symm e'.symm) (s.piecewise e e') (s.ite e.source e'.source) :=
begin
  rintro x (⟨he, hs⟩|⟨he, hs : x ∉ s⟩),
  { rw [piecewise_eq_of_mem _ _ _ hs, piecewise_eq_of_mem _ _ _ ((h he).2 hs), e.left_inv he], },
  { rw [piecewise_eq_of_not_mem _ _ _ hs, piecewise_eq_of_not_mem _ _ _ ((h'.compl he).2 hs),
      e'.left_inv he] }
end

lemma inter_eq_of_inter_eq_of_eq_on {e' : local_equiv α β} (h : e.is_image s t)
  (h' : e'.is_image s t) (hs : e.source ∩ s = e'.source ∩ s) (Heq : eq_on e e' (e.source ∩ s)) :
  e.target ∩ t = e'.target ∩ t :=
by rw [← h.image_eq, ← h'.image_eq, ← hs, Heq.image_eq]

lemma symm_eq_on_of_inter_eq_of_eq_on {e' : local_equiv α β} (h : e.is_image s t)
  (hs : e.source ∩ s = e'.source ∩ s) (Heq : eq_on e e' (e.source ∩ s)) :
  eq_on e.symm e'.symm (e.target ∩ t) :=
begin
  rw [← h.image_eq],
  rintros y ⟨x, hx, rfl⟩,
  have hx' := hx, rw hs at hx',
  rw [e.left_inv hx.1, Heq hx, e'.left_inv hx'.1]
end

end is_image

lemma is_image_source_target : e.is_image e.source e.target := λ x hx, by simp [hx]

lemma is_image_source_target_of_disjoint (e' : local_equiv α β) (hs : disjoint e.source e'.source)
  (ht : disjoint e.target e'.target) :
  e.is_image e'.source e'.target :=
assume x hx,
have x ∉ e'.source, from λ hx', hs ⟨hx, hx'⟩,
have e x ∉ e'.target, from λ hx', ht ⟨e.maps_to hx, hx'⟩,
by simp only *

lemma image_source_inter_eq' (s : set α) :
  e '' (e.source ∩ s) = e.target ∩ e.symm ⁻¹' s :=
by rw [inter_comm, e.left_inv_on.image_inter', image_source_eq_target, inter_comm]

lemma image_source_inter_eq (s : set α) :
  e '' (e.source ∩ s) = e.target ∩ e.symm ⁻¹' (e.source ∩ s) :=
by rw [inter_comm, e.left_inv_on.image_inter, image_source_eq_target, inter_comm]

lemma image_eq_target_inter_inv_preimage {s : set α} (h : s ⊆ e.source) :
  e '' s = e.target ∩ e.symm ⁻¹' s :=
by rw [← e.image_source_inter_eq', inter_eq_self_of_subset_right h]

lemma symm_image_eq_source_inter_preimage {s : set β} (h : s ⊆ e.target) :
  e.symm '' s = e.source ∩ e ⁻¹' s :=
e.symm.image_eq_target_inter_inv_preimage h

lemma symm_image_target_inter_eq (s : set β) :
  e.symm '' (e.target ∩ s) = e.source ∩ e ⁻¹' (e.target ∩ s) :=
e.symm.image_source_inter_eq _

lemma symm_image_target_inter_eq' (s : set β) :
  e.symm '' (e.target ∩ s) = e.source ∩ e ⁻¹' s :=
e.symm.image_source_inter_eq' _

lemma source_inter_preimage_inv_preimage (s : set α) :
  e.source ∩ e ⁻¹' (e.symm ⁻¹' s) = e.source ∩ s :=
set.ext $ λ x, and.congr_right_iff.2 $ λ hx, by simp only [mem_preimage, e.left_inv hx]

lemma target_inter_inv_preimage_preimage (s : set β) :
  e.target ∩ e.symm ⁻¹' (e ⁻¹' s) = e.target ∩ s :=
e.symm.source_inter_preimage_inv_preimage _

lemma source_subset_preimage_target : e.source ⊆ e ⁻¹' e.target :=
e.maps_to

lemma symm_image_target_eq_source : e.symm '' e.target = e.source :=
e.symm.image_source_eq_target

lemma target_subset_preimage_source : e.target ⊆ e.symm ⁻¹' e.source :=
e.symm_maps_to

/-- Two local equivs that have the same `source`, same `to_fun` and same `inv_fun`, coincide. -/
@[ext]
protected lemma ext {e e' : local_equiv α β} (h : ∀x, e x = e' x)
  (hsymm : ∀x, e.symm x = e'.symm x) (hs : e.source = e'.source) : e = e' :=
begin
  have A : (e : α → β) = e', by { ext x, exact h x },
  have B : (e.symm : β → α) = e'.symm, by { ext x, exact hsymm x },
  have I : e '' e.source = e.target := e.image_source_eq_target,
  have I' : e' '' e'.source = e'.target := e'.image_source_eq_target,
  rw [A, hs, I'] at I,
  cases e; cases e',
  simp * at *
end

/-- Restricting a local equivalence to e.source ∩ s -/
protected def restr (s : set α) : local_equiv α β :=
(@is_image.of_symm_preimage_eq α β e s (e.symm ⁻¹' s) rfl).restr

@[simp, mfld_simps] lemma restr_coe (s : set α) : (e.restr s : α → β) = e := rfl
@[simp, mfld_simps] lemma restr_coe_symm (s : set α) : ((e.restr s).symm : β → α) = e.symm := rfl
@[simp, mfld_simps] lemma restr_source (s : set α) : (e.restr s).source = e.source ∩ s := rfl
@[simp, mfld_simps] lemma restr_target (s : set α) :
  (e.restr s).target = e.target ∩ e.symm ⁻¹' s := rfl

lemma restr_eq_of_source_subset {e : local_equiv α β} {s : set α} (h : e.source ⊆ s) :
  e.restr s = e :=
local_equiv.ext (λ_, rfl) (λ_, rfl) (by simp [inter_eq_self_of_subset_left h])

@[simp, mfld_simps] lemma restr_univ {e : local_equiv α β} : e.restr univ = e :=
restr_eq_of_source_subset (subset_univ _)

/-- The identity local equiv -/
protected def refl (α : Type*) : local_equiv α α := (equiv.refl α).to_local_equiv

@[simp, mfld_simps] lemma refl_source : (local_equiv.refl α).source = univ := rfl
@[simp, mfld_simps] lemma refl_target : (local_equiv.refl α).target = univ := rfl
@[simp, mfld_simps] lemma refl_coe : (local_equiv.refl α : α → α) = id := rfl
@[simp, mfld_simps] lemma refl_symm : (local_equiv.refl α).symm = local_equiv.refl α := rfl

@[simp, mfld_simps] lemma refl_restr_source (s : set α) :
  ((local_equiv.refl α).restr s).source = s :=
by simp

@[simp, mfld_simps] lemma refl_restr_target (s : set α) :
  ((local_equiv.refl α).restr s).target = s :=
by { change univ ∩ id⁻¹' s = s, simp }

/-- The identity local equiv on a set `s` -/
def of_set (s : set α) : local_equiv α α :=
{ to_fun      := id,
  inv_fun     := id,
  source      := s,
  target      := s,
  map_source' := λx hx, hx,
  map_target' := λx hx, hx,
  left_inv'   := λx hx, rfl,
  right_inv'  := λx hx, rfl }

@[simp, mfld_simps] lemma of_set_source (s : set α) : (local_equiv.of_set s).source = s := rfl
@[simp, mfld_simps] lemma of_set_target (s : set α) : (local_equiv.of_set s).target = s := rfl
@[simp, mfld_simps] lemma of_set_coe (s : set α) : (local_equiv.of_set s : α → α) = id := rfl
@[simp, mfld_simps] lemma of_set_symm (s : set α) :
  (local_equiv.of_set s).symm = local_equiv.of_set s := rfl

/-- Composing two local equivs if the target of the first coincides with the source of the
second. -/
protected def trans' (e' : local_equiv β γ) (h : e.target = e'.source) :
  local_equiv α γ :=
{ to_fun := e' ∘ e,
  inv_fun := e.symm ∘ e'.symm,
  source := e.source,
  target := e'.target,
  map_source' := λx hx, by simp [h.symm, hx],
  map_target' := λy hy, by simp [h, hy],
  left_inv' := λx hx, by simp [hx, h.symm],
  right_inv' := λy hy, by simp [hy, h] }

/-- Composing two local equivs, by restricting to the maximal domain where their composition
is well defined. -/
protected def trans : local_equiv α γ :=
  local_equiv.trans' (e.symm.restr (e'.source)).symm (e'.restr (e.target)) (inter_comm _ _)

@[simp, mfld_simps] lemma coe_trans : (e.trans e' : α → γ) = e' ∘ e := rfl
@[simp, mfld_simps] lemma coe_trans_symm : ((e.trans e').symm : γ → α) = e.symm ∘ e'.symm := rfl

lemma trans_symm_eq_symm_trans_symm : (e.trans e').symm = e'.symm.trans e.symm :=
by cases e; cases e'; refl

@[simp, mfld_simps] lemma trans_source : (e.trans e').source = e.source ∩ e ⁻¹' e'.source := rfl

lemma trans_source' : (e.trans e').source = e.source ∩ e ⁻¹' (e.target ∩ e'.source) :=
by mfld_set_tac

lemma trans_source'' : (e.trans e').source = e.symm '' (e.target ∩ e'.source) :=
by rw [e.trans_source', e.symm_image_target_inter_eq]

lemma image_trans_source : e '' (e.trans e').source = e.target ∩ e'.source :=
(e.symm.restr e'.source).symm.image_source_eq_target

@[simp, mfld_simps] lemma trans_target :
  (e.trans e').target = e'.target ∩ e'.symm ⁻¹' e.target := rfl

lemma trans_target' : (e.trans e').target = e'.target ∩ e'.symm ⁻¹' (e'.source ∩ e.target) :=
trans_source' e'.symm e.symm

lemma trans_target'' : (e.trans e').target = e' '' (e'.source ∩ e.target) :=
trans_source'' e'.symm e.symm

lemma inv_image_trans_target : e'.symm '' (e.trans e').target = e'.source ∩ e.target :=
image_trans_source e'.symm e.symm

lemma trans_assoc (e'' : local_equiv γ δ) : (e.trans e').trans e'' = e.trans (e'.trans e'') :=
local_equiv.ext (λx, rfl) (λx, rfl) (by simp [trans_source, @preimage_comp α β γ, inter_assoc])

@[simp, mfld_simps] lemma trans_refl : e.trans (local_equiv.refl β) = e :=
local_equiv.ext (λx, rfl) (λx, rfl) (by simp [trans_source])

@[simp, mfld_simps] lemma refl_trans : (local_equiv.refl α).trans e = e :=
local_equiv.ext (λx, rfl) (λx, rfl) (by simp [trans_source, preimage_id])

lemma trans_refl_restr (s : set β) :
  e.trans ((local_equiv.refl β).restr s) = e.restr (e ⁻¹' s) :=
local_equiv.ext (λx, rfl) (λx, rfl) (by simp [trans_source])

lemma trans_refl_restr' (s : set β) :
  e.trans ((local_equiv.refl β).restr s) = e.restr (e.source ∩ e ⁻¹' s) :=
local_equiv.ext (λx, rfl) (λx, rfl) $ by { simp [trans_source], rw [← inter_assoc, inter_self] }

lemma restr_trans (s : set α) :
  (e.restr s).trans e' = (e.trans e').restr s :=
local_equiv.ext (λx, rfl) (λx, rfl) $ by { simp [trans_source, inter_comm], rwa inter_assoc }

/-- `eq_on_source e e'` means that `e` and `e'` have the same source, and coincide there. Then `e`
and `e'` should really be considered the same local equiv. -/
def eq_on_source (e e' : local_equiv α β) : Prop :=
e.source = e'.source ∧ (e.source.eq_on e e')

/-- `eq_on_source` is an equivalence relation -/
instance eq_on_source_setoid : setoid (local_equiv α β) :=
{ r     := eq_on_source,
  iseqv := ⟨
    λe, by simp [eq_on_source],
    λe e' h, by { simp [eq_on_source, h.1.symm], exact λx hx, (h.2 hx).symm },
    λe e' e'' h h', ⟨by rwa [← h'.1, ← h.1], λx hx, by { rw [← h'.2, h.2 hx], rwa ← h.1 }⟩⟩ }

lemma eq_on_source_refl : e ≈ e := setoid.refl _

/-- Two equivalent local equivs have the same source -/
lemma eq_on_source.source_eq {e e' : local_equiv α β} (h : e ≈ e') : e.source = e'.source :=
h.1

/-- Two equivalent local equivs coincide on the source -/
lemma eq_on_source.eq_on {e e' : local_equiv α β} (h : e ≈ e') : e.source.eq_on e e' :=
h.2

/-- Two equivalent local equivs have the same target -/
lemma eq_on_source.target_eq {e e' : local_equiv α β} (h : e ≈ e') : e.target = e'.target :=
by simp only [← image_source_eq_target, ← h.source_eq, h.2.image_eq]

/-- If two local equivs are equivalent, so are their inverses. -/
lemma eq_on_source.symm' {e e' : local_equiv α β} (h : e ≈ e') : e.symm ≈ e'.symm :=
begin
  refine ⟨h.target_eq, eq_on_of_left_inv_on_of_right_inv_on e.left_inv_on _ _⟩;
    simp only [symm_source, h.target_eq, h.source_eq, e'.symm_maps_to],
  exact e'.right_inv_on.congr_right e'.symm_maps_to (h.source_eq ▸ h.eq_on.symm),
end

/-- Two equivalent local equivs have coinciding inverses on the target -/
lemma eq_on_source.symm_eq_on {e e' : local_equiv α β} (h : e ≈ e') :
  eq_on e.symm e'.symm e.target :=
h.symm'.eq_on

/-- Composition of local equivs respects equivalence -/
lemma eq_on_source.trans' {e e' : local_equiv α β} {f f' : local_equiv β γ}
  (he : e ≈ e') (hf : f ≈ f') : e.trans f ≈ e'.trans f' :=
begin
  split,
  { rw [trans_source'', trans_source'', ← he.target_eq, ← hf.1],
    exact (he.symm'.eq_on.mono $ inter_subset_left _ _).image_eq },
  { assume x hx,
    rw trans_source at hx,
    simp [(he.2 hx.1).symm, hf.2 hx.2] }
end

/-- Restriction of local equivs respects equivalence -/
lemma eq_on_source.restr {e e' : local_equiv α β} (he : e ≈ e') (s : set α) :
  e.restr s ≈ e'.restr s :=
begin
  split,
  { simp [he.1] },
  { assume x hx,
    simp only [mem_inter_eq, restr_source] at hx,
    exact he.2 hx.1 }
end

/-- Preimages are respected by equivalence -/
lemma eq_on_source.source_inter_preimage_eq {e e' : local_equiv α β} (he : e ≈ e') (s : set β) :
  e.source ∩ e ⁻¹' s = e'.source ∩ e' ⁻¹' s :=
by rw [he.eq_on.inter_preimage_eq, he.source_eq]

/-- Composition of a local equiv and its inverse is equivalent to the restriction of the identity
to the source -/
lemma trans_self_symm :
  e.trans e.symm ≈ local_equiv.of_set e.source :=
begin
  have A : (e.trans e.symm).source = e.source, by mfld_set_tac,
  refine ⟨by simp [A], λx hx, _⟩,
  rw A at hx,
  simp only [hx] with mfld_simps
end

/-- Composition of the inverse of a local equiv and this local equiv is equivalent to the
restriction of the identity to the target -/
lemma trans_symm_self :
  e.symm.trans e ≈ local_equiv.of_set e.target :=
trans_self_symm (e.symm)

/-- Two equivalent local equivs are equal when the source and target are univ -/
lemma eq_of_eq_on_source_univ (e e' : local_equiv α β) (h : e ≈ e')
  (s : e.source = univ) (t : e.target = univ) : e = e' :=
begin
  apply local_equiv.ext (λx, _) (λx, _) h.1,
  { apply h.2,
    rw s,
    exact mem_univ _ },
  { apply h.symm'.2,
    rw [symm_source, t],
    exact mem_univ _ }
end

section prod

/-- The product of two local equivs, as a local equiv on the product. -/
def prod (e : local_equiv α β) (e' : local_equiv γ δ) : local_equiv (α × γ) (β × δ) :=
{ source := set.prod e.source e'.source,
  target := set.prod e.target e'.target,
  to_fun := λp, (e p.1, e' p.2),
  inv_fun := λp, (e.symm p.1, e'.symm p.2),
  map_source' := λp hp, by { simp at hp, simp [hp] },
  map_target' := λp hp, by { simp at hp, simp [map_target, hp] },
  left_inv'   := λp hp, by { simp at hp, simp [hp] },
  right_inv'  := λp hp, by { simp at hp, simp [hp] } }

@[simp, mfld_simps] lemma prod_source (e : local_equiv α β) (e' : local_equiv γ δ) :
  (e.prod e').source = set.prod e.source e'.source := rfl

@[simp, mfld_simps] lemma prod_target (e : local_equiv α β) (e' : local_equiv γ δ) :
  (e.prod e').target = set.prod e.target e'.target := rfl

@[simp, mfld_simps] lemma prod_coe (e : local_equiv α β) (e' : local_equiv γ δ) :
  ((e.prod e') : α × γ → β × δ) = (λp, (e p.1, e' p.2)) := rfl

lemma prod_coe_symm (e : local_equiv α β) (e' : local_equiv γ δ) :
  ((e.prod e').symm : β × δ → α × γ) = (λp, (e.symm p.1, e'.symm p.2)) := rfl

@[simp, mfld_simps] lemma prod_symm (e : local_equiv α β) (e' : local_equiv γ δ) :
  (e.prod e').symm = (e.symm.prod e'.symm) :=
by ext x; simp [prod_coe_symm]

@[simp, mfld_simps] lemma prod_trans {η : Type*} {ε : Type*}
  (e : local_equiv α β) (f : local_equiv β γ) (e' : local_equiv δ η) (f' : local_equiv η ε) :
  (e.prod e').trans (f.prod f') = (e.trans f).prod (e'.trans f') :=
by ext x; simp [ext_iff]; tauto

end prod

/-- Combine two `local_equiv`s using `set.piecewise`. The source of the new `local_equiv` is
`s.ite e.source e'.source = e.source ∩ s ∪ e'.source \ s`, and similarly for target.  The function
sends `e.source ∩ s` to `e.target ∩ t` using `e` and `e'.source \ s` to `e'.target \ t` using `e'`,
and similarly for the inverse function. The definition assumes `e.is_image s t` and
`e'.is_image s t`. -/
@[simps] def piecewise (e e' : local_equiv α β) (s : set α) (t : set β)
  [∀ x, decidable (x ∈ s)] [∀ y, decidable (y ∈ t)] (H : e.is_image s t) (H' : e'.is_image s t) :
  local_equiv α β :=
{ to_fun := s.piecewise e e',
  inv_fun := t.piecewise e.symm e'.symm,
  source := s.ite e.source e'.source,
  target := t.ite e.target e'.target,
  map_source' := H.maps_to.piecewise_ite H'.compl.maps_to,
  map_target' := H.symm.maps_to.piecewise_ite H'.symm.compl.maps_to,
  left_inv' := H.left_inv_on_piecewise H',
  right_inv' := H.symm.left_inv_on_piecewise H'.symm }

lemma symm_piecewise (e e' : local_equiv α β) {s : set α} {t : set β}
  [∀ x, decidable (x ∈ s)] [∀ y, decidable (y ∈ t)]
  (H : e.is_image s t) (H' : e'.is_image s t) :
  (e.piecewise e' s t H H').symm = e.symm.piecewise e'.symm t s H.symm H'.symm :=
rfl

/-- Combine two `local_equiv`s with disjoint sources and disjoint targets. We reuse
`local_equiv.piecewise`, then override `source` and `target` to ensure better definitional
equalities. -/
@[simps] def disjoint_union (e e' : local_equiv α β) (hs : disjoint e.source e'.source)
  (ht : disjoint e.target e'.target) [∀ x, decidable (x ∈ e.source)]
  [∀ y, decidable (y ∈ e.target)] :
  local_equiv α β :=
(e.piecewise e' e.source e.target e.is_image_source_target $
  e'.is_image_source_target_of_disjoint _ hs.symm ht.symm).copy
  _ rfl _ rfl (e.source ∪ e'.source) (ite_left _ _) (e.target ∪ e'.target) (ite_left _ _)

lemma disjoint_union_eq_piecewise (e e' : local_equiv α β) (hs : disjoint e.source e'.source)
  (ht : disjoint e.target e'.target) [∀ x, decidable (x ∈ e.source)]
  [∀ y, decidable (y ∈ e.target)] :
  e.disjoint_union e' hs ht = e.piecewise e' e.source e.target e.is_image_source_target
    (e'.is_image_source_target_of_disjoint _ hs.symm ht.symm) :=
copy_eq_self _ _ _ _ _ _ _ _ _

section pi

variables {ι : Type*} {αi βi : ι → Type*} (ei : Π i, local_equiv (αi i) (βi i))

/-- The product of a family of local equivs, as a local equiv on the pi type. -/
@[simps source target] protected def pi : local_equiv (Π i, αi i) (Π i, βi i) :=
{ to_fun := λ f i, ei i (f i),
  inv_fun := λ f i, (ei i).symm (f i),
  source := pi univ (λ i, (ei i).source),
  target := pi univ (λ i, (ei i).target),
  map_source' := λ f hf i hi, (ei i).map_source (hf i hi),
  map_target' := λ f hf i hi, (ei i).map_target (hf i hi),
  left_inv' := λ f hf, funext $ λ i, (ei i).left_inv (hf i trivial),
  right_inv' := λ f hf, funext $ λ i, (ei i).right_inv (hf i trivial) }

attribute [mfld_simps] pi_source pi_target

@[simp, mfld_simps] lemma pi_coe : ⇑(local_equiv.pi ei) = λ (f : Π i, αi i) i, ei i (f i) := rfl
@[simp, mfld_simps] lemma pi_symm :
  (local_equiv.pi ei).symm = local_equiv.pi (λ i, (ei i).symm) := rfl

end pi

end local_equiv

namespace set

-- All arguments are explicit to avoid missing information in the pretty printer output
/-- A bijection between two sets `s : set α` and `t : set β` provides a local equivalence
between `α` and `β`. -/
@[simps] noncomputable def bij_on.to_local_equiv [nonempty α] (f : α → β) (s : set α) (t : set β)
  (hf : bij_on f s t) :
  local_equiv α β :=
{ to_fun := f,
  inv_fun := inv_fun_on f s,
  source := s,
  target := t,
  map_source' := hf.maps_to,
  map_target' := hf.surj_on.maps_to_inv_fun_on,
  left_inv'   := hf.inv_on_inv_fun_on.1,
  right_inv'  := hf.inv_on_inv_fun_on.2 }

/-- A map injective on a subset of its domain provides a local equivalence. -/
@[simp, mfld_simps] noncomputable def inj_on.to_local_equiv [nonempty α] (f : α → β) (s : set α)
  (hf : inj_on f s) :
  local_equiv α β :=
hf.bij_on_image.to_local_equiv f s (f '' s)

end set

namespace equiv
/- equivs give rise to local_equiv. We set up simp lemmas to reduce most properties of the local
equiv to that of the equiv. -/
variables (e : equiv α β) (e' : equiv β γ)

@[simp, mfld_simps] lemma to_local_equiv_coe : (e.to_local_equiv : α → β) = e := rfl
@[simp, mfld_simps] lemma to_local_equiv_symm_coe : (e.to_local_equiv.symm : β → α) = e.symm := rfl
@[simp, mfld_simps] lemma to_local_equiv_source : e.to_local_equiv.source = univ := rfl
@[simp, mfld_simps] lemma to_local_equiv_target : e.to_local_equiv.target = univ := rfl
@[simp, mfld_simps] lemma refl_to_local_equiv :
  (equiv.refl α).to_local_equiv = local_equiv.refl α := rfl
@[simp, mfld_simps] lemma symm_to_local_equiv : e.symm.to_local_equiv = e.to_local_equiv.symm := rfl
@[simp, mfld_simps] lemma trans_to_local_equiv :
  (e.trans e').to_local_equiv = e.to_local_equiv.trans e'.to_local_equiv :=
local_equiv.ext (λx, rfl) (λx, rfl) (by simp [local_equiv.trans_source, equiv.to_local_equiv])

end equiv


-- Si a es un punto de acumulación de u, entonces ∀ ε > 0, ∀ N, ∃ n ≥ N, |u n - a| ≤ ε
-- ===================================================================================

import data.real.basic

variable  {u : ℕ → ℝ}
variables {a : ℝ}
variable  {φ : ℕ → ℕ}

-- ----------------------------------------------------
-- Nota. Usaremos los siguientes conceptos estudiados
-- anteriormente.
-- ----------------------------------------------------

notation `|`x`|` := abs x

def limite : (ℕ → ℝ) → ℝ → Prop :=
λ u c, ∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - c| ≤ ε

def extraccion : (ℕ → ℕ) → Prop
| φ := ∀ n m, n < m → φ n < φ m

lemma id_mne_extraccion
  (h : extraccion φ)
  : ∀ n, n ≤ φ n :=
begin
  intros n,
  induction n with m HI,
  { linarith },
  { exact nat.succ_le_of_lt (by linarith [h m (m+1) (by linarith)]) },
end

lemma extraccion_mye
  (h : extraccion φ)
  : ∀ N N', ∃ n ≥ N', φ n ≥ N :=
λ N N',
  ⟨max N N', le_max_right N N',
             le_trans (le_max_left N N')
             (id_mne_extraccion h (max N N'))⟩

-- ----------------------------------------------------
-- Ejercicio 1. Definir la función
--    punto_acumulacion : (ℕ → ℝ) → ℝ → Prop
-- tal que (punto_acumulacion u a) expresa que a es un
-- punto de acumulación de u; es decir, que es el
-- límite de alguna subsucesión de u.
-- ----------------------------------------------------

def punto_acumulacion : (ℕ → ℝ) → ℝ → Prop
| u a := ∃ φ, extraccion φ ∧ limite (u ∘ φ) a

-- ----------------------------------------------------
-- Ejercicio 2. Demostrar que si a es un punto de
-- acumulación de u, entonces
--    ∀ ε > 0, ∀ N, ∃ k ≥ N, |u k - a| ≤ ε
-- ----------------------------------------------------

-- 1ª demostración
example
  (h : punto_acumulacion u a)
  : ∀ ε > 0, ∀ N, ∃ n ≥ N, |u n - a| ≤ ε :=
begin
  intros ε hε N,
  -- unfold punto_acumulacion at h,
  rcases h with ⟨φ, hφ1, hφ2⟩,
  -- unfold limite at hφ2,
  cases hφ2 ε hε with N' hN',
  rcases extraccion_mye hφ1 N N' with ⟨m, hm, hm'⟩,
  -- clear hφ1 hφ2,
  use φ m,
  split,
  { exact hm', },
  { exact hN' m hm, },
end

-- 2ª demostración
example
  (h : punto_acumulacion u a)
  : ∀ ε > 0, ∀ N, ∃ n ≥ N, |u n - a| ≤ ε :=
begin
  intros ε hε N,
  rcases h with ⟨φ, hφ1, hφ2⟩,
  cases hφ2 ε hε with N' hN',
  rcases extraccion_mye hφ1 N N' with ⟨m, hm, hm'⟩,
  use φ m,
  exact ⟨hm', hN' m hm⟩,
end

-- 3ª demostración
example
  (h : punto_acumulacion u a)
  : ∀ ε > 0, ∀ N, ∃ n ≥ N, |u n - a| ≤ ε :=
begin
  intros ε hε N,
  rcases h with ⟨φ, hφ1, hφ2⟩,
  cases hφ2 ε hε with N' hN',
  rcases extraccion_mye hφ1 N N' with ⟨m, hm, hm'⟩,
  exact ⟨φ m, hm', hN' _ hm⟩,
end

-- 4ª demostración
example
  (h : punto_acumulacion u a)
  : ∀ ε > 0, ∀ N, ∃ n ≥ N, |u n - a| ≤ ε :=
begin
  intros ε hε N,
  rcases h with ⟨φ, hφ1, hφ2⟩,
  cases hφ2 ε hε with N' hN',
  rcases extraccion_mye hφ1 N N' with ⟨m, hm, hm'⟩,
  use φ m ; finish
end

-- 5ª demostración
example
  (h : punto_acumulacion u a)
  : ∀ ε > 0, ∀ N, ∃ n ≥ N, |u n - a| ≤ ε :=
assume ε,
assume hε : ε > 0,
assume N,
exists.elim h
  ( assume φ,
    assume hφ : extraccion φ ∧ limite (u ∘ φ) a,
    exists.elim (hφ.2 ε hε)
      ( assume N',
        assume hN' : ∀ (n : ℕ), n ≥ N' → |(u ∘ φ) n - a| ≤ ε,
        have h1 : ∃ n ≥ N', φ n ≥ N,
          from extraccion_mye hφ.1 N N',
        exists.elim h1
          ( assume m,
            assume hm : ∃ (H : m ≥ N'), φ m ≥ N,
            exists.elim hm
              ( assume hm1 : m ≥ N',
                assume hm2 : φ m ≥ N,
                have h2 : |u (φ m) - a| ≤ ε,
                  from hN' m hm1,
                show ∃ n ≥ N, |u n - a| ≤ ε,
                  from exists.intro (φ m) (exists.intro hm2 h2)))))

-- 6ª demostración
example
  (h : punto_acumulacion u a)
  : ∀ ε > 0, ∀ N, ∃ n ≥ N, |u n - a| ≤ ε :=
assume ε,
assume hε : ε > 0,
assume N,
exists.elim h
  ( assume φ,
    assume hφ : extraccion φ ∧ limite (u ∘ φ) a,
    exists.elim (hφ.2 ε hε)
      ( assume N',
        assume hN' : ∀ (n : ℕ), n ≥ N' → |(u ∘ φ) n - a| ≤ ε,
        have h1 : ∃ n ≥ N', φ n ≥ N,
          from extraccion_mye hφ.1 N N',
        exists.elim h1
          ( assume m,
            assume hm : ∃ (H : m ≥ N'), φ m ≥ N,
            exists.elim hm
              ( assume hm1 : m ≥ N',
                assume hm2 : φ m ≥ N,
                have h2 : |u (φ m) - a| ≤ ε,
                  from hN' m hm1,
                show ∃ n ≥ N, |u n - a| ≤ ε,
                  from ⟨φ m, hm2, h2⟩))))

-- 7ª demostración
example
  (h : punto_acumulacion u a)
  : ∀ ε > 0, ∀ N, ∃ n ≥ N, |u n - a| ≤ ε :=
assume ε,
assume hε : ε > 0,
assume N,
exists.elim h
  ( assume φ,
    assume hφ : extraccion φ ∧ limite (u ∘ φ) a,
    exists.elim (hφ.2 ε hε)
      ( assume N',
        assume hN' : ∀ (n : ℕ), n ≥ N' → |(u ∘ φ) n - a| ≤ ε,
        have h1 : ∃ n ≥ N', φ n ≥ N,
          from extraccion_mye hφ.1 N N',
        exists.elim h1
          ( assume m,
            assume hm : ∃ (H : m ≥ N'), φ m ≥ N,
            exists.elim hm
              ( assume hm1 : m ≥ N',
                assume hm2 : φ m ≥ N,
                have h2 : |u (φ m) - a| ≤ ε,
                  from hN' m hm1,
                ⟨φ m, hm2, h2⟩))))

-- 8ª demostración
example
  (h : punto_acumulacion u a)
  : ∀ ε > 0, ∀ N, ∃ n ≥ N, |u n - a| ≤ ε :=
assume ε,
assume hε : ε > 0,
assume N,
exists.elim h
  ( assume φ,
    assume hφ : extraccion φ ∧ limite (u ∘ φ) a,
    exists.elim (hφ.2 ε hε)
      ( assume N',
        assume hN' : ∀ (n : ℕ), n ≥ N' → |(u ∘ φ) n - a| ≤ ε,
        have h1 : ∃ n ≥ N', φ n ≥ N,
          from extraccion_mye hφ.1 N N',
        exists.elim h1
          ( assume m,
            assume hm : ∃ (H : m ≥ N'), φ m ≥ N,
            exists.elim hm
              ( assume hm1 : m ≥ N',
                assume hm2 : φ m ≥ N,
                ⟨φ m, hm2, hN' m hm1⟩))))

-- 9ª demostración
example
  (h : punto_acumulacion u a)
  : ∀ ε > 0, ∀ N, ∃ n ≥ N, |u n - a| ≤ ε :=
assume ε,
assume hε : ε > 0,
assume N,
exists.elim h
  ( assume φ,
    assume hφ : extraccion φ ∧ limite (u ∘ φ) a,
    exists.elim (hφ.2 ε hε)
      ( assume N',
        assume hN' : ∀ (n : ℕ), n ≥ N' → |(u ∘ φ) n - a| ≤ ε,
        have h1 : ∃ n ≥ N', φ n ≥ N,
          from extraccion_mye hφ.1 N N',
        exists.elim h1
          ( assume m,
            assume hm : ∃ (H : m ≥ N'), φ m ≥ N,
            exists.elim hm
              (λ hm1 hm2, ⟨φ m, hm2, hN' m hm1⟩))))

-- 10ª demostración
example
  (h : punto_acumulacion u a)
  : ∀ ε > 0, ∀ N, ∃ n ≥ N, |u n - a| ≤ ε :=
assume ε,
assume hε : ε > 0,
assume N,
exists.elim h
  ( assume φ,
    assume hφ : extraccion φ ∧ limite (u ∘ φ) a,
    exists.elim (hφ.2 ε hε)
      ( assume N',
        assume hN' : ∀ (n : ℕ), n ≥ N' → |(u ∘ φ) n - a| ≤ ε,
        have h1 : ∃ n ≥ N', φ n ≥ N,
          from extraccion_mye hφ.1 N N',
        exists.elim h1
          (λ m hm, exists.elim hm (λ hm1 hm2, ⟨φ m, hm2, hN' m hm1⟩))))

-- 11ª demostración
example
  (h : punto_acumulacion u a)
  : ∀ ε > 0, ∀ N, ∃ n ≥ N, |u n - a| ≤ ε :=
assume ε,
assume hε : ε > 0,
assume N,
exists.elim h
  ( assume φ,
    assume hφ : extraccion φ ∧ limite (u ∘ φ) a,
    exists.elim (hφ.2 ε hε)
      ( assume N',
        assume hN' : ∀ (n : ℕ), n ≥ N' → |(u ∘ φ) n - a| ≤ ε,
        exists.elim (extraccion_mye hφ.1 N N')
          (λ m hm, exists.elim hm (λ hm1 hm2, ⟨φ m, hm2, hN' m hm1⟩))))

-- 12ª demostración
example
  (h : punto_acumulacion u a)
  : ∀ ε > 0, ∀ N, ∃ n ≥ N, |u n - a| ≤ ε :=
assume ε,
assume hε : ε > 0,
assume N,
exists.elim h
  ( assume φ,
    assume hφ : extraccion φ ∧ limite (u ∘ φ) a,
    exists.elim (hφ.2 ε hε)
      (λ N' hN', exists.elim (extraccion_mye hφ.1 N N')
        (λ m hm, exists.elim hm
          (λ hm1 hm2, ⟨φ m, hm2, hN' m hm1⟩))))

-- 13ª demostración
example
  (h : punto_acumulacion u a)
  : ∀ ε > 0, ∀ N, ∃ n ≥ N, |u n - a| ≤ ε :=
assume ε,
assume hε : ε > 0,
assume N,
exists.elim h
  (λ φ hφ, exists.elim (hφ.2 ε hε)
    (λ N' hN', exists.elim (extraccion_mye hφ.1 N N')
      (λ m hm, exists.elim hm
        (λ hm1 hm2, ⟨φ m, hm2, hN' m hm1⟩))))

-- 14ª demostración
example
  (h : punto_acumulacion u a)
  : ∀ ε > 0, ∀ N, ∃ n ≥ N, |u n - a| ≤ ε :=
λ ε hε N, exists.elim h
  (λ φ hφ, exists.elim (hφ.2 ε hε)
    (λ N' hN', exists.elim (extraccion_mye hφ.1 N N')
      (λ m hm, exists.elim hm
        (λ hm1 hm2, ⟨φ m, hm2, hN' m hm1⟩))))


/-
Copyright (c) 2022 Kexing Ying. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kexing Ying, Rémy Degenne
-/
import probability.stopping

/-!
# Hitting time

Given a stochastic process, the hitting time provides the first time the process ``hits'' some
subset of the state space. The hitting time is a stopping time in the case that the time index is
discrete and the process is adapted (this is true in a far more general setting however we have
only proved it for the discrete case so far).

## Main definition

* `measure_theory.hitting`: the hitting time of a stochastic process

## Main results

* `measure_theory.hitting_is_stopping_time`: a discrete hitting time of an adapted process is a
  stopping time

## Implementation notes

In the definition of the hitting time, we bound the hitting time by an upper and lower bound.
This is to ensure that our result is meaningful in the case we are taking the infimum of an
empty set or the infimum of a set which is unbounded from below. With this, we can talk about
hitting times indexed by the natural numbers or the reals. By taking the bounds to be
`⊤` and `⊥`, we obtain the standard definition in the case that the index is `with_top ℕ` or `ℝ≥0∞`.

-/

open filter order topological_space
open_locale classical measure_theory nnreal ennreal topological_space big_operators

namespace measure_theory

variables {α β ι : Type*} {m : measurable_space α}

/-- Hitting time: given a stochastic process `u` and a set `s`, `hitting u s n m` is the first time
`u` is in `s` after time `n` and before time `m` (if `u` does not hit `s` after time `n` and
before `m` then the hitting time is simply `m`).

The hitting time is a stopping time if the process is adapted and discrete. -/
noncomputable def hitting [preorder ι] [has_Inf ι] (u : ι → α → β) (s : set β) (n m : ι) : α → ι :=
λ x, if ∃ j ∈ set.Icc n m, u j x ∈ s then Inf (set.Icc n m ∩ {i : ι | u i x ∈ s}) else m

section inequalities

variables [conditionally_complete_linear_order ι] {u : ι → α → β} {s : set β} {n i : ι} {x : α}

lemma hitting_of_lt {m : ι} (h : m < n) : hitting u s n m x = m :=
begin
  simp_rw [hitting],
  have h_not : ¬∃ (j : ι) (H : j ∈ set.Icc n m), u j x ∈ s,
  { push_neg,
    intro j,
    rw set.Icc_eq_empty_of_lt h,
    simp only [set.mem_empty_eq, forall_false_left], },
  simp only [h_not, if_false],
end

lemma hitting_le {m : ι} (x : α) : hitting u s n m x ≤ m :=
begin
  cases le_or_lt n m with h_le h_lt,
  { simp only [hitting],
    split_ifs,
    { obtain ⟨j, hj₁, hj₂⟩ := h,
      exact (cInf_le (bdd_below.inter_of_left bdd_below_Icc) (set.mem_inter hj₁ hj₂)).trans hj₁.2 },
    { exact le_rfl }, },
  { rw hitting_of_lt h_lt, },
end

lemma le_hitting {m : ι} (hnm : n ≤ m) (x : α) : n ≤ hitting u s n m x :=
begin
  simp only [hitting],
  split_ifs,
  { refine le_cInf _ (λ b hb, _),
    { obtain ⟨k, hk_Icc, hk_s⟩ := h,
      exact ⟨k, hk_Icc, hk_s⟩, },
    { rw set.mem_inter_iff at hb,
      exact hb.1.1, }, },
  { exact hnm },
end

lemma le_hitting_of_exists {m : ι} (h_exists : ∃ j ∈ set.Icc n m, u j x ∈ s) :
  n ≤ hitting u s n m x :=
begin
  refine le_hitting _ x,
  by_contra,
  rw set.Icc_eq_empty_of_lt (not_le.mp h) at h_exists,
  simpa using h_exists,
end

lemma hitting_mem_Icc {m : ι} (hnm : n ≤ m) (x : α) : hitting u s n m x ∈ set.Icc n m :=
⟨le_hitting hnm x, hitting_le x⟩

lemma hitting_mem_set [is_well_order ι (<)] {m : ι} (h_exists : ∃ j ∈ set.Icc n m, u j x ∈ s) :
  u (hitting u s n m x) x ∈ s :=
begin
  simp_rw [hitting, if_pos h_exists],
  have h_nonempty : (set.Icc n m ∩ {i : ι | u i x ∈ s}).nonempty,
  { obtain ⟨k, hk₁, hk₂⟩ := h_exists,
    exact ⟨k, set.mem_inter hk₁ hk₂⟩, },
  have h_mem := Inf_mem h_nonempty,
  rw [set.mem_inter_iff] at h_mem,
  exact h_mem.2,
end

lemma hitting_le_of_mem {m : ι} (hin : n ≤ i) (him : i ≤ m) (his : u i x ∈ s) :
  hitting u s n m x ≤ i :=
begin
  have h_exists : ∃ k ∈ set.Icc n m, u k x ∈ s := ⟨i, ⟨hin, him⟩, his⟩,
  simp_rw [hitting, if_pos h_exists],
  exact cInf_le (bdd_below.inter_of_left bdd_below_Icc) (set.mem_inter ⟨hin, him⟩ his),
end

lemma hitting_le_iff_of_exists [is_well_order ι (<)] {m : ι}
  (h_exists : ∃ j ∈ set.Icc n m, u j x ∈ s) :
  hitting u s n m x ≤ i ↔ ∃ j ∈ set.Icc n i, u j x ∈ s :=
begin
  split; intro h',
  { exact ⟨hitting u s n m x, ⟨le_hitting_of_exists h_exists, h'⟩, hitting_mem_set h_exists⟩, },
  { have h'' : ∃ k ∈ set.Icc n (min m i), u k x ∈ s,
    { obtain ⟨k₁, hk₁_mem, hk₁_s⟩ := h_exists,
      obtain ⟨k₂, hk₂_mem, hk₂_s⟩ := h',
      refine ⟨min k₁ k₂, ⟨le_min hk₁_mem.1 hk₂_mem.1, min_le_min hk₁_mem.2 hk₂_mem.2⟩, _⟩,
      exact min_rec' (λ j, u j x ∈ s) hk₁_s hk₂_s, },
    obtain ⟨k, hk₁, hk₂⟩ := h'',
    refine le_trans _ (hk₁.2.trans (min_le_right _ _)),
    exact hitting_le_of_mem hk₁.1 (hk₁.2.trans (min_le_left _ _)) hk₂, },
end

lemma hitting_le_iff_of_lt [is_well_order ι (<)] {m : ι} (i : ι) (hi : i < m) :
  hitting u s n m x ≤ i ↔ ∃ j ∈ set.Icc n i, u j x ∈ s :=
begin
  by_cases h_exists : ∃ j ∈ set.Icc n m, u j x ∈ s,
  { rw hitting_le_iff_of_exists h_exists, },
  { simp_rw [hitting, if_neg h_exists],
    push_neg at h_exists,
    simp only [not_le.mpr hi, set.mem_Icc, false_iff, not_exists, and_imp],
    exact λ k hkn hki, h_exists k ⟨hkn, hki.trans hi.le⟩, },
end

lemma hitting_lt_iff [is_well_order ι (<)] {m : ι} (i : ι) (hi : i ≤ m) :
  hitting u s n m x < i ↔ ∃ j ∈ set.Ico n i, u j x ∈ s :=
begin
  split; intro h',
  { have h : ∃ j ∈ set.Icc n m, u j x ∈ s,
    { by_contra,
      simp_rw [hitting, if_neg h, ← not_le] at h',
      exact h' hi, },
    exact ⟨hitting u s n m x, ⟨le_hitting_of_exists h, h'⟩, hitting_mem_set h⟩, },
  { obtain ⟨k, hk₁, hk₂⟩ := h',
    refine lt_of_le_of_lt _ hk₁.2,
    exact hitting_le_of_mem hk₁.1 (hk₁.2.le.trans hi) hk₂, },
end

end inequalities

/-- A discrete hitting time is a stopping time. -/
lemma hitting_is_stopping_time
  [conditionally_complete_linear_order ι] [is_well_order ι (<)] [encodable ι]
  [topological_space β] [pseudo_metrizable_space β] [measurable_space β] [borel_space β]
  {f : filtration ι m} {u : ι → α → β} {s : set β} {n n' : ι}
  (hu : adapted f u) (hs : measurable_set s) :
  is_stopping_time f (hitting u s n n') :=
begin
  intro i,
  cases le_or_lt n' i with hi hi,
  { have h_le : ∀ x, hitting u s n n' x ≤ i := λ x, (hitting_le x).trans hi,
    simp [h_le], },
  { have h_set_eq_Union : {x | hitting u s n n' x ≤ i} = ⋃ j ∈ set.Icc n i, u j ⁻¹' s,
    { ext x,
      rw [set.mem_set_of_eq, hitting_le_iff_of_lt _ hi],
      simp only [set.mem_Icc, exists_prop, set.mem_Union, set.mem_preimage], },
    rw h_set_eq_Union,
    exact measurable_set.Union (λ j, measurable_set.Union_Prop $
      λ hj, f.mono hj.2 _ ((hu j).measurable hs)) }
end

section complete_lattice

variables [complete_lattice ι] {u : ι → α → β} {s : set β} {f : filtration ι m}

lemma hitting_eq_Inf (x : α) : hitting u s ⊥ ⊤ x = Inf {i : ι | u i x ∈ s} :=
begin
  simp only [hitting, set.mem_Icc, bot_le, le_top, and_self, exists_true_left, set.Icc_bot,
    set.Iic_top, set.univ_inter, ite_eq_left_iff, not_exists],
  intro h_nmem_s,
  symmetry,
  rw Inf_eq_top,
  exact λ i hi_mem_s, absurd hi_mem_s (h_nmem_s i),
end

end complete_lattice

section conditionally_complete_linear_order_bot

variables [conditionally_complete_linear_order_bot ι] [is_well_order ι (<)]
variables {u : ι → α → β} {s : set β} {f : filtration ℕ m}

lemma hitting_bot_le_iff {i n : ι} {x : α} (hx : ∃ j, j ≤ n ∧ u j x ∈ s) :
  hitting u s ⊥ n x ≤ i ↔ ∃ j ≤ i, u j x ∈ s :=
begin
  cases lt_or_le i n with hi hi,
  { rw hitting_le_iff_of_lt _ hi,
    simp, },
  { simp only [(hitting_le x).trans hi, true_iff],
    obtain ⟨j, hj₁, hj₂⟩ := hx,
    exact ⟨j, hj₁.trans hi, hj₂⟩, },
end

end conditionally_complete_linear_order_bot

end measure_theory


open classical
axiom not_iff_not_self ( P : Prop) : not (P <-> not P)
variable Person : Type
variable shaves : Person -> Person -> Prop
variable barber : Person
variable hA : forall x, shaves barber x
variable h : forall x, shaves barber x <-> not (shaves x x)
variable hB : forall x, not (shaves x x)
example : false :=
have h1 : shaves barber barber <-> not (shaves barber barber), from h barber,
have h2 : shaves barber barber, from hA barber,
have h3 : not(shaves barber barber), from hB barber,
show false, from h3 h2

/-section
variable U : Type

variables A B C : U → Prop

example : (¬ ∃ x, A x) → ∀ x, ¬ A x :=

assume h1: (¬ ∃ x, A x),
show ∀ x, ¬ A x,
from assume z,
assume h2: A z,
show false, from h1 (exists.intro z h2)
end -/


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import algebra.big_operators.basic
import data.finset.basic
import data.multiset.basic
import group_theory.group_action.defs

/-!
# Lemmas about group actions on big operators

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

Note that analogous lemmas for `module`s like `finset.sum_smul` appear in other files.
-/

variables {α β γ : Type*}

open_locale big_operators

section
variables [add_monoid β] [distrib_smul α β]

lemma list.smul_sum {r : α} {l : list β} :
  r • l.sum = (l.map ((•) r)).sum :=
(distrib_smul.to_add_monoid_hom β r).map_list_sum l

end

section
variables [monoid α] [monoid β] [mul_distrib_mul_action α β]

lemma list.smul_prod {r : α} {l : list β} :
  r • l.prod = (l.map ((•) r)).prod :=
(mul_distrib_mul_action.to_monoid_hom β r).map_list_prod l

end

section
variables [add_comm_monoid β] [distrib_smul α β]

lemma multiset.smul_sum {r : α} {s : multiset β} :
  r • s.sum = (s.map ((•) r)).sum :=
(distrib_smul.to_add_monoid_hom β r).map_multiset_sum s

lemma finset.smul_sum {r : α} {f : γ → β} {s : finset γ} :
  r • ∑ x in s, f x = ∑ x in s, r • f x :=
(distrib_smul.to_add_monoid_hom β r).map_sum f s

end

section
variables [monoid α] [comm_monoid β] [mul_distrib_mul_action α β]

lemma multiset.smul_prod {r : α} {s : multiset β} :
  r • s.prod = (s.map ((•) r)).prod :=
(mul_distrib_mul_action.to_monoid_hom β r).map_multiset_prod s

lemma finset.smul_prod {r : α} {f : γ → β} {s : finset γ} :
  r • ∏ x in s, f x = ∏ x in s, r • f x :=
(mul_distrib_mul_action.to_monoid_hom β r).map_prod f s

end


lemma ne_succ_self (n : mynat) : n ≠ succ n :=
begin
intro h,
rw ← zero_add n at h,
rw ← succ_add at h,
rw add_right_cancel_iff at h,
exact zero_ne_succ 0 h,
end

-- lemma ne_succ_self (n : mynat) : n ≠ succ n :=
-- begin
-- induction n with d hd,
-- apply zero_ne_succ,
-- intro h,
-- rw succ_eq_succ_iff at h,
-- exact hd(h),
-- end


/-
Copyright (c) 2018 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Johannes Hölzl

Completion of topological groups:
-/
import topology.uniform_space.completion topology.algebra.uniform_group
noncomputable theory

section group
open uniform_space Cauchy filter set
variables {α : Type*} [uniform_space α]

instance [has_zero α] : has_zero (completion α) := ⟨(0 : α)⟩
instance [has_neg α] : has_neg (completion α) := ⟨completion.map (λa, -a : α → α)⟩
instance [has_add α] : has_add (completion α) := ⟨completion.map₂ (+)⟩

lemma coe_zero [has_zero α] : ((0 : α) : completion α) = 0 := rfl
end group

namespace uniform_space.completion
section uniform_add_group
open uniform_space uniform_space.completion
variables {α : Type*} [uniform_space α] [add_group α] [uniform_add_group α]

lemma coe_neg (a : α) : ((- a : α) : completion α) = - a :=
(map_coe uniform_continuous_neg' a).symm

lemma coe_add (a b : α) : ((a + b : α) : completion α) = a + b :=
(map₂_coe_coe a b (+) uniform_continuous_add').symm

instance : add_group (completion α) :=
{ zero_add     := assume a, completion.induction_on a
   (is_closed_eq (continuous_map₂ continuous_const continuous_id) continuous_id)
    (assume a, show 0 + (a : completion α) = a, by rw [← coe_zero, ← coe_add, zero_add]),
  add_zero     := assume a, completion.induction_on a
    (is_closed_eq (continuous_map₂ continuous_id continuous_const) continuous_id)
    (assume a, show (a : completion α) + 0 = a, by rw [← coe_zero, ← coe_add, add_zero]),
  add_left_neg := assume a, completion.induction_on a
    (is_closed_eq (continuous_map₂ completion.continuous_map continuous_id) continuous_const)
    (assume a, show - (a : completion α) + a = 0, by rw [← coe_neg, ← coe_add, add_left_neg, coe_zero]),
  add_assoc    := assume a b c, completion.induction_on₃ a b c
    (is_closed_eq
      (continuous_map₂
        (continuous_map₂ continuous_fst (continuous_snd.comp continuous_fst)) (continuous_snd.comp continuous_snd))
      (continuous_map₂ continuous_fst
        (continuous_map₂ (continuous_snd.comp continuous_fst) (continuous_snd.comp continuous_snd))))
    (assume a b c, show (a : completion α) + b + c = a + (b + c),
      by repeat { rw [← coe_add] }; rw [add_assoc]),
  .. completion.has_zero, .. completion.has_neg, ..completion.has_add }

instance : uniform_add_group (completion α) :=
⟨ (uniform_continuous.prod_mk uniform_continuous_fst
  (uniform_continuous_snd.comp uniform_continuous_map)).comp (uniform_continuous_map₂' (+))  ⟩

instance is_add_group_hom_coe : is_add_group_hom (coe : α → completion α) :=
⟨ coe_add ⟩

variables {β : Type*} [uniform_space β] [add_group β] [uniform_add_group β]

lemma is_add_group_hom_extension  [complete_space β] [separated β]
  {f : α → β} [is_add_group_hom f] (hf : continuous f) : is_add_group_hom (completion.extension f) :=
have hf : uniform_continuous f, from uniform_continuous_of_continuous hf,
⟨assume a b, completion.induction_on₂ a b
  (is_closed_eq
    (continuous_add'.comp continuous_extension)
    (continuous_add (continuous_fst.comp continuous_extension) (continuous_snd.comp continuous_extension)))
  (assume a b, by rw [← coe_add, extension_coe hf, extension_coe hf, extension_coe hf, is_add_group_hom.add f])⟩

lemma is_add_group_hom_map [add_group β] [uniform_add_group β]
  {f : α → β} [is_add_group_hom f] (hf : continuous f) : is_add_group_hom (completion.map f) :=
is_add_group_hom_extension (hf.comp (continuous_coe _))

section instance_max_depth
-- TODO: continuous_add requires some long proofs through
-- uniform_add_group / topological_add_group w.r.t prod / completion etc
set_option class.instance_max_depth 52

lemma is_add_group_hom_prod [add_group β] [uniform_add_group β] :
  is_add_group_hom (@completion.prod α β _ _) :=
⟨assume ⟨a₁, a₂⟩ ⟨b₁, b₂⟩,
  begin
    refine completion.induction_on₄ a₁ a₂ b₁ b₂ (is_closed_eq _ _) _,
    { refine continuous.comp _ uniform_continuous_prod.continuous,
      refine continuous_add _ _,
      exact continuous.prod_mk (continuous_fst.comp continuous_fst) (continuous_fst.comp continuous_snd),
      exact continuous.prod_mk (continuous_snd.comp continuous_fst) (continuous_snd.comp continuous_snd) },
    { refine continuous_add _ _,
      refine continuous.comp _ uniform_continuous_prod.continuous,
      exact continuous.prod_mk (continuous_fst.comp continuous_fst) (continuous_fst.comp continuous_snd),
      refine continuous.comp _ uniform_continuous_prod.continuous,
      exact continuous.prod_mk (continuous_snd.comp continuous_fst) (continuous_snd.comp continuous_snd) },
    { assume a b c d,
      show completion.prod (↑a + ↑c, ↑b + ↑d) = completion.prod (↑a, ↑b) + completion.prod (↑c, ↑d),
      rw [← coe_add, ← coe_add, prod_coe_coe, prod_coe_coe, prod_coe_coe, ← coe_add],
      refl }
  end⟩

end instance_max_depth

instance {α : Type*} [uniform_space α] [add_comm_group α] [uniform_add_group α] : add_comm_group (completion α) :=
{ add_comm  := assume a b, completion.induction_on₂ a b
    (is_closed_eq (continuous_map₂ continuous_fst continuous_snd) (continuous_map₂ continuous_snd continuous_fst))
    (assume x y, by { change ↑x + ↑y = ↑y + ↑x, rw [← coe_add, ← coe_add, add_comm]}),
  .. completion.add_group }
end uniform_add_group

end uniform_space.completion


-- import SciLean.Core.Functions
-- import SciLean.Tactic

import SciLean.Core.Functions
import SciLean.Core.Extra

namespace SciLean

variable {α β γ : Type}
variable {X Y Z : Type} [Hilbert X] [Hilbert Y] [Hilbert Z]
variable {ι κ : Type} [Enumtype ι] [Enumtype κ]

variable {n : Nat} [Nonempty (Fin n)]

example (y : X)
  :
    ∇ (λ x : X => ⟪x,x⟫) = λ x : X => (1:ℝ) * x + (1:ℝ) * x
  := by simp; unfold hold; simp done

example
  : ∂ (fun (x : Fin n → ℝ) i => x (i + 1) * x i)
    =
    (fun x dx a => dx (a + 1) * x a + x (a + 1) * dx a) :=
by
  simp

-- set_option synthInstance.maxHeartbeats 2000
-- set_option maxHeartbeats 50000

-- set_option trace.Meta.Tactic.simp.discharge true in
-- set_option trace.Meta.Tactic.simp.rewrite true in
example : adjDiff (fun (x : Fin n → ℝ) => x i) = (fun x dx' j => kron i j * dx') :=
by
  simp
  done

-- set_option synthInstance.maxHeartbeats 2000 in
-- set_option maxHeartbeats 50000 in
-- set_option trace.Meta.Tactic.simp.discharge true in
-- set_option trace.Meta.Tactic.simp.rewrite true in
-- set_option trace.Meta.Tactic.simp.unify true in
example
  : ∇ (λ (f : Fin n → ℝ) => ∑ i, (f (i + 1))*(f i))
    =
    (λ (f : Fin n → ℝ) => (λ i => ⟪1, f (i - 1)⟫) + (λ i => f (i + 1)))
  :=
by
  simp[sum_of_add, sum_into_lambda]  done

/-

-- set_option synthInstance.maxHeartbeats 2000 in
-- set_option maxHeartbeats 50000 in
example
  : ∇ (λ (f : ℝ^n) => ∑ i, f[i + 1]*f[i])
    =
    λ (f : ℝ^n) => PowType.intro λ i => f[i - 1] + f[i + 1]
  :=
by
  simp[gradient, adjoint_differential]
  simp[AtomicAdjointFun.adj,hold]
  done

-/

-- set_option trace.Meta.Tactic.simp.discharge true in
example {X} [Hilbert X] (x : X)
  :
    ∇ (λ x : X => ∥x∥²) x = (2 : ℝ) * x
  :=
by simp done

set_option synthInstance.maxHeartbeats 1000 in
set_option synthInstance.maxSize 2000 in

example (g : Fin n → ℝ)
  :
    ∇ (λ (f : Fin n → ℝ) => ∑ i, ⟪(f (i + 1) - f i), (f (i + 1) - f i)⟫) g
    =
    (λ i => 2 * (g i - g (i - 1) + -(g (i + 1) - g i)))
  :=
by
  funext i; simp; --unfold hold; simp;

  rw[!?(i - 1 + 1 = i)]
  done

/-

-- set_option synthInstance.maxHeartbeats 50000 in
-- set_option synthInstance.maxSize 2048 in
-- example (c : Fin n → ℝ) (k : ℝ) : IsSmooth fun (x : Fin n → Fin 3 → ℝ) (i : Fin n) => ∥ ∥x i - x (i - 1)∥² - (c i) ∥² := by infer_instance

-- Too slow with `x : (ℝ^(3:ℕ))^n
-- Quite compicated
-- set_option trace.Meta.Tactic.simp.discharge true in
-- set_option synthInstance.maxHeartbeats 50000 in
-- set_option synthInstance.maxSize 2048 in
-- example (l : Fin n → ℝ)
--   : ∇ (λ (x : Fin n → Fin 3 → ℝ) => ∑ i, ∥ ∥x i  - x (i-1)∥² - (l i)^2∥²)
--     =
--     (fun (x : Fin n → Fin 3 → ℝ) =>
--       (2:ℝ) * fun j =>
--         (∥x j - x (j - 1)∥² - l j ^ 2) * ((2:ℝ) * (x j - x (j - 1))) -
--         (∥x (j + 1) - x (j + 1 - 1)∥² - l (j + 1) ^ 2) * ((2:ℝ) * (x (j + 1) - x (j + 1 - 1))))
--   :=
-- by
  -- conv =>
  --   lhs
  --   simp[gradient]
  -- conv =>
  --   lhs
  --   simp
  -- done

-- set_option trace.Meta.Tactic.simp.rewrite true in
-- set_option synthInstance.maxSize 256 in
-- example
--   : ∇ (λ x : Fin n → Fin 3 → ℝ => ∑ i j, ∥x i - x j∥²)
--     =
--     0
--    -- (fun x => (2:ℝ) * ((fun j => (n:ℝ) * x j - fun j => sum fun i => x i j) - fun j => (fun j => sum fun i => x i j) - (n:ℝ) * x j))
--  := by
--    autograd    -- I was unable to typecheck the rhs, so we are just checking if `autograd` terminates on this
--    admit

-- set_option trace.Meta.Tactic.simp true in
-- example
--   : 𝓑 (λ x : Fin n → Fin 3 → ℝ => ∑ i j, ∥x i - x j∥²)
--     =
--     0
--  := by
--    simp    -- I was unable to typecheck the rhs, so we are just checking if `autograd` terminates on this
--    admit

-- set_option synthInstance.maxHeartbeats 1000
-- example (g : ι → ℝ)
--   :
--     ∇ (λ (f : ι → ℝ) => ∑ i, (42 : ℝ) * f i) g
--     =
--     (λ _ => (42 : ℝ))
--   := by autograd done

-- example (g : ι → ℝ)
--   :
--     ∇ (λ (f : ι → ℝ) => ∑ i, (f i)*(f i)) g = (2 : ℝ) * g
--   :=
-- by autograd; done

-- example : ∂ (λ x : ℝ^n => ∑ i, x[i]) = λ x dx => ∑ i, dx[i] := by simp done
-- example : ∂ (λ x : ℝ^n => ∑ i, 2*x[i]) = λ x dx => ∑ i, (2:ℝ)*dx[i] := by simp done
-- example : ∂ (λ x : ℝ^n => (∑ i, x[i]*x[i])) = λ x dx => (∑ i, dx[i]*x[i]) + (∑ i, x[i]*dx[i]) := by simp done
-- example : ∇ (λ x : ℝ^n => ∑ i, x[i]) = λ x => PowType.intro (λ i => (1:ℝ)) := by autograd done
-- example : ∇ (λ x : ℝ^n => ∑ i, x[i]*x[i]) = λ x : ℝ^n => (2:ℝ)*x := by autograd admit -- not quite there,
-- not sure what to do about this case

  --   example : ∇ (λ x => ∑ i, x[i]*x[i-a]) x = ((lmk λ i => x[i-a]) + (lmk λ i => x[i+a])) := by autograd done
  --   -- example : ∇ (λ x => ∑ i, (x[i+a] - x[i])*(x[i+a] - x[i])) x = 0 := by autograd done -- Needs some more sophisticated simplifications

    -- variable {n : Nat} [NonZero n] (a : Fin n)

    -- example : ∇ (λ (f : Fin n → ℝ) => ∑ i, (f (i+a) - f i)*(f (i+a) - f i))
    --           =
    --           (λ (f : Fin n → ℝ) i => 2 * (f (i - a + a) - f (i - a) - (f (i + a) - f i))) := by autograd done
  --   example (c : ℝ) : ∇ (λ (f : Fin n → ℝ) => ∑ i, c*(f i)*(f i)) = (λ (f : Fin n → ℝ) => (2:ℝ)*c*f) := by autograd done

-/


/-
Copyright (c) 2021 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import algebra.lie.subalgebra
import ring_theory.noetherian

/-!
# Lie submodules of a Lie algebra

In this file we define Lie submodules and Lie ideals, we construct the lattice structure on Lie
submodules and we use it to define various important operations, notably the Lie span of a subset
of a Lie module.

## Main definitions

  * `lie_submodule`
  * `lie_submodule.well_founded_of_noetherian`
  * `lie_submodule.lie_span`
  * `lie_submodule.map`
  * `lie_submodule.comap`
  * `lie_ideal`
  * `lie_ideal.map`
  * `lie_ideal.comap`

## Tags

lie algebra, lie submodule, lie ideal, lattice structure
-/

universes u v w w₁ w₂

section lie_submodule

variables (R : Type u) (L : Type v) (M : Type w)
variables [comm_ring R] [lie_ring L] [lie_algebra R L] [add_comm_group M] [module R M]
variables [lie_ring_module L M] [lie_module R L M]

set_option old_structure_cmd true
/-- A Lie submodule of a Lie module is a submodule that is closed under the Lie bracket.
This is a sufficient condition for the subset itself to form a Lie module. -/
structure lie_submodule extends submodule R M :=
(lie_mem : ∀ {x : L} {m : M}, m ∈ carrier → ⁅x, m⁆ ∈ carrier)

attribute [nolint doc_blame] lie_submodule.to_submodule

namespace lie_submodule

variables {R L M} (N N' : lie_submodule R L M)

instance : set_like (lie_submodule R L M) M :=
{ coe := carrier,
  coe_injective' := λ N O h, by cases N; cases O; congr' }

/-- The zero module is a Lie submodule of any Lie module. -/
instance : has_zero (lie_submodule R L M) :=
⟨{ lie_mem := λ x m h, by { rw ((submodule.mem_bot R).1 h), apply lie_zero, },
   ..(0 : submodule R M)}⟩

instance : inhabited (lie_submodule R L M) := ⟨0⟩

instance coe_submodule : has_coe (lie_submodule R L M) (submodule R M) := ⟨to_submodule⟩

@[norm_cast]
lemma coe_to_submodule : ((N : submodule R M) : set M) = N := rfl

@[simp] lemma mem_carrier {x : M} : x ∈ N.carrier ↔ x ∈ (N : set M) :=
iff.rfl

@[simp] lemma mem_mk_iff (S : set M) (h₁ h₂ h₃ h₄) {x : M} :
  x ∈ (⟨S, h₁, h₂, h₃, h₄⟩ : lie_submodule R L M) ↔ x ∈ S :=
iff.rfl

@[simp] lemma mem_coe_submodule {x : M} : x ∈ (N : submodule R M) ↔ x ∈ N := iff.rfl

lemma mem_coe {x : M} : x ∈ (N : set M) ↔ x ∈ N := iff.rfl

@[simp] lemma zero_mem : (0 : M) ∈ N := (N : submodule R M).zero_mem

@[simp] lemma coe_to_set_mk (S : set M) (h₁ h₂ h₃ h₄) :
  ((⟨S, h₁, h₂, h₃, h₄⟩ : lie_submodule R L M) : set M) = S := rfl

@[simp] lemma coe_to_submodule_mk (p : submodule R M) (h) :
  (({lie_mem := h, ..p} : lie_submodule R L M) : submodule R M) = p :=
by { cases p, refl, }

lemma coe_submodule_injective :
  function.injective (to_submodule : lie_submodule R L M → submodule R M) :=
λ x y h, by { cases x, cases y, congr, injection h }

@[ext] lemma ext (h : ∀ m, m ∈ N ↔ m ∈ N') : N = N' := set_like.ext h

@[simp] lemma coe_to_submodule_eq_iff : (N : submodule R M) = (N' : submodule R M) ↔ N = N' :=
coe_submodule_injective.eq_iff

/-- Copy of a lie_submodule with a new `carrier` equal to the old one. Useful to fix definitional
equalities. -/
protected def copy (s : set M) (hs : s = ↑N) : lie_submodule R L M :=
{ carrier := s,
  zero_mem' := hs.symm ▸ N.zero_mem',
  add_mem'  := hs.symm ▸ N.add_mem',
  smul_mem' := hs.symm ▸ N.smul_mem',
  lie_mem   := hs.symm ▸ N.lie_mem, }

@[simp] lemma coe_copy (S : lie_submodule R L M) (s : set M) (hs : s = ↑S) :
  (S.copy s hs : set M) = s := rfl

lemma copy_eq (S : lie_submodule R L M) (s : set M) (hs : s = ↑S) : S.copy s hs = S :=
coe_submodule_injective (set_like.coe_injective hs)

instance : lie_ring_module L N :=
{ bracket     := λ (x : L) (m : N), ⟨⁅x, m.val⁆, N.lie_mem m.property⟩,
  add_lie     := by { intros x y m, apply set_coe.ext, apply add_lie, },
  lie_add     := by { intros x m n, apply set_coe.ext, apply lie_add, },
  leibniz_lie := by { intros x y m, apply set_coe.ext, apply leibniz_lie, }, }

instance : lie_module R L N :=
{ lie_smul := by { intros t x y, apply set_coe.ext, apply lie_smul, },
  smul_lie := by { intros t x y, apply set_coe.ext, apply smul_lie, }, }

@[simp, norm_cast] lemma coe_zero : ((0 : N) : M) = (0 : M) := rfl

@[simp, norm_cast] lemma coe_add (m m' : N) : (↑(m + m') : M) = (m : M) + (m' : M) := rfl

@[simp, norm_cast] lemma coe_neg (m : N) : (↑(-m) : M) = -(m : M) := rfl

@[simp, norm_cast] lemma coe_sub (m m' : N) : (↑(m - m') : M) = (m : M) - (m' : M) := rfl

@[simp, norm_cast] lemma coe_smul (t : R) (m : N) : (↑(t • m) : M) = t • (m : M) := rfl

@[simp, norm_cast] lemma coe_bracket (x : L) (m : N) : (↑⁅x, m⁆ : M) = ⁅x, ↑m⁆ := rfl

end lie_submodule

section lie_ideal

variables (L)

/-- An ideal of a Lie algebra is a Lie submodule of the Lie algebra as a Lie module over itself. -/
abbreviation lie_ideal := lie_submodule R L L

lemma lie_mem_right (I : lie_ideal R L) (x y : L) (h : y ∈ I) : ⁅x, y⁆ ∈ I := I.lie_mem h

lemma lie_mem_left (I : lie_ideal R L) (x y : L) (h : x ∈ I) : ⁅x, y⁆ ∈ I :=
 by { rw [←lie_skew, ←neg_lie], apply lie_mem_right, assumption, }

/-- An ideal of a Lie algebra is a Lie subalgebra. -/
def lie_ideal_subalgebra (I : lie_ideal R L) : lie_subalgebra R L :=
{ lie_mem' := by { intros x y hx hy, apply lie_mem_right, exact hy, },
  ..I.to_submodule, }

instance : has_coe (lie_ideal R L) (lie_subalgebra R L) := ⟨λ I, lie_ideal_subalgebra R L I⟩

@[norm_cast] lemma lie_ideal.coe_to_subalgebra (I : lie_ideal R L) :
  ((I : lie_subalgebra R L) : set L) = I := rfl

@[norm_cast] lemma lie_ideal.coe_to_lie_subalgebra_to_submodule (I : lie_ideal R L) :
  ((I : lie_subalgebra R L) : submodule R L) = I := rfl

end lie_ideal

variables {R M}

lemma submodule.exists_lie_submodule_coe_eq_iff (p : submodule R M) :
  (∃ (N : lie_submodule R L M), ↑N = p) ↔ ∀ (x : L) (m : M), m ∈ p → ⁅x, m⁆ ∈ p :=
begin
  split,
  { rintros ⟨N, rfl⟩, exact N.lie_mem, },
  { intros h, use { lie_mem := h, ..p }, exact lie_submodule.coe_to_submodule_mk p _, },
end

namespace lie_subalgebra

variables {L}

/-- Given a Lie subalgebra `K ⊆ L`, if we view `L` as a `K`-module by restriction, it contains
a distinguished Lie submodule for the action of `K`, namely `K` itself. -/
def to_lie_submodule (K : lie_subalgebra R L) : lie_submodule R K L :=
{ lie_mem := λ x y hy, K.lie_mem x.property hy,
  .. (K : submodule R L) }

@[simp] lemma coe_to_lie_submodule (K : lie_subalgebra R L) :
  (K.to_lie_submodule : submodule R L) = K :=
by { rcases K with ⟨⟨⟩⟩, refl, }

@[simp] lemma mem_to_lie_submodule {K : lie_subalgebra R L} (x : L) :
  x ∈ K.to_lie_submodule ↔ x ∈ K :=
iff.rfl

lemma exists_lie_ideal_coe_eq_iff (K : lie_subalgebra R L) :
  (∃ (I : lie_ideal R L), ↑I = K) ↔ ∀ (x y : L), y ∈ K → ⁅x, y⁆ ∈ K :=
begin
  simp only [← coe_to_submodule_eq_iff, lie_ideal.coe_to_lie_subalgebra_to_submodule,
    submodule.exists_lie_submodule_coe_eq_iff L],
  exact iff.rfl,
end

lemma exists_nested_lie_ideal_coe_eq_iff {K K' : lie_subalgebra R L} (h : K ≤ K') :
  (∃ (I : lie_ideal R K'), ↑I = of_le h) ↔ ∀ (x y : L), x ∈ K' → y ∈ K → ⁅x, y⁆ ∈ K :=
begin
  simp only [exists_lie_ideal_coe_eq_iff, coe_bracket, mem_of_le],
  split,
  { intros h' x y hx hy, exact h' ⟨x, hx⟩ ⟨y, h hy⟩ hy, },
  { rintros h' ⟨x, hx⟩ ⟨y, hy⟩ hy', exact h' x y hx hy', },
end

end lie_subalgebra

end lie_submodule

namespace lie_submodule

variables {R : Type u} {L : Type v} {M : Type w}
variables [comm_ring R] [lie_ring L] [lie_algebra R L] [add_comm_group M] [module R M]
variables [lie_ring_module L M] [lie_module R L M]
variables (N N' : lie_submodule R L M) (I J : lie_ideal R L)

section lattice_structure

open set

lemma coe_injective : function.injective (coe : lie_submodule R L M → set M) :=
set_like.coe_injective

@[simp, norm_cast] lemma coe_submodule_le_coe_submodule : (N : submodule R M) ≤ N' ↔ N ≤ N' :=
iff.rfl

instance : has_bot (lie_submodule R L M) := ⟨0⟩

@[simp] lemma bot_coe : ((⊥ : lie_submodule R L M) : set M) = {0} := rfl

@[simp] lemma bot_coe_submodule : ((⊥ : lie_submodule R L M) : submodule R M) = ⊥ := rfl

@[simp] lemma mem_bot (x : M) : x ∈ (⊥ : lie_submodule R L M) ↔ x = 0 := mem_singleton_iff

instance : has_top (lie_submodule R L M) :=
⟨{ lie_mem := λ x m h, mem_univ ⁅x, m⁆,
   ..(⊤ : submodule R M) }⟩

@[simp] lemma top_coe : ((⊤ : lie_submodule R L M) : set M) = univ := rfl

@[simp] lemma top_coe_submodule : ((⊤ : lie_submodule R L M) : submodule R M) = ⊤ := rfl

@[simp] lemma mem_top (x : M) : x ∈ (⊤ : lie_submodule R L M) := mem_univ x

instance : has_inf (lie_submodule R L M) :=
⟨λ N N', { lie_mem := λ x m h, mem_inter (N.lie_mem h.1) (N'.lie_mem h.2),
            ..(N ⊓ N' : submodule R M) }⟩

instance : has_Inf (lie_submodule R L M) :=
⟨λ S, { lie_mem := λ x m h, by
        { simp only [submodule.mem_carrier, mem_Inter, submodule.Inf_coe, mem_set_of_eq,
            forall_apply_eq_imp_iff₂, exists_imp_distrib] at *,
          intros N hN, apply N.lie_mem (h N hN), },
        ..Inf {(s : submodule R M) | s ∈ S} }⟩

@[simp] theorem inf_coe : (↑(N ⊓ N') : set M) = N ∩ N' := rfl

@[simp] lemma Inf_coe_to_submodule (S : set (lie_submodule R L M)) :
  (↑(Inf S) : submodule R M) = Inf {(s : submodule R M) | s ∈ S} := rfl

@[simp] lemma Inf_coe (S : set (lie_submodule R L M)) : (↑(Inf S) : set M) = ⋂ s ∈ S, (s : set M) :=
begin
  rw [← lie_submodule.coe_to_submodule, Inf_coe_to_submodule, submodule.Inf_coe],
  ext m,
  simpa only [mem_Inter, mem_set_of_eq, forall_apply_eq_imp_iff₂, exists_imp_distrib],
end

lemma Inf_glb (S : set (lie_submodule R L M)) : is_glb S (Inf S) :=
begin
  have h : ∀ (N N' : lie_submodule R L M), (N : set M) ≤ N' ↔ N ≤ N', { intros, refl },
  apply is_glb.of_image h,
  simp only [Inf_coe],
  exact is_glb_binfi
end

/-- The set of Lie submodules of a Lie module form a complete lattice.

We provide explicit values for the fields `bot`, `top`, `inf` to get more convenient definitions
than we would otherwise obtain from `complete_lattice_of_Inf`.  -/
instance : complete_lattice (lie_submodule R L M) :=
{ le           := (≤),
  lt           := (<),
  bot          := ⊥,
  bot_le       := λ N _ h, by { rw mem_bot at h, rw h, exact N.zero_mem', },
  top          := ⊤,
  le_top       := λ _ _ _, trivial,
  inf          := (⊓),
  le_inf       := λ N₁ N₂ N₃ h₁₂ h₁₃ m hm, ⟨h₁₂ hm, h₁₃ hm⟩,
  inf_le_left  := λ _ _ _, and.left,
  inf_le_right := λ _ _ _, and.right,
  ..set_like.partial_order,
  ..complete_lattice_of_Inf _ Inf_glb }

instance : add_comm_monoid (lie_submodule R L M) :=
{ add       := (⊔),
  add_assoc := λ _ _ _, sup_assoc,
  zero      := ⊥,
  zero_add  := λ _, bot_sup_eq,
  add_zero  := λ _, sup_bot_eq,
  add_comm  := λ _ _, sup_comm, }

@[simp] lemma add_eq_sup : N + N' = N ⊔ N' := rfl

@[norm_cast, simp] lemma sup_coe_to_submodule :
  (↑(N ⊔ N') : submodule R M) = (N : submodule R M) ⊔ (N' : submodule R M) :=
begin
  have aux : ∀ (x : L) m, m ∈ (N ⊔ N' : submodule R M) → ⁅x,m⁆ ∈ (N ⊔ N' : submodule R M),
  { simp only [submodule.mem_sup],
    rintro x m ⟨y, hy, z, hz, rfl⟩,
    refine ⟨⁅x, y⁆, N.lie_mem hy, ⁅x, z⁆, N'.lie_mem hz, (lie_add _ _ _).symm⟩ },
  refine le_antisymm (Inf_le ⟨{ lie_mem := aux, ..(N ⊔ N' : submodule R M) }, _⟩) _,
  { simp only [exists_prop, and_true, mem_set_of_eq, eq_self_iff_true, coe_to_submodule_mk,
      ← coe_submodule_le_coe_submodule, and_self, le_sup_left, le_sup_right] },
  { simp, },
end

@[norm_cast, simp] lemma inf_coe_to_submodule :
  (↑(N ⊓ N') : submodule R M) = (N : submodule R M) ⊓ (N' : submodule R M) := rfl

@[simp] lemma mem_inf (x : M) : x ∈ N ⊓ N' ↔ x ∈ N ∧ x ∈ N' :=
by rw [← mem_coe_submodule, ← mem_coe_submodule, ← mem_coe_submodule, inf_coe_to_submodule,
  submodule.mem_inf]

lemma mem_sup (x : M) : x ∈ N ⊔ N' ↔ ∃ (y ∈ N) (z ∈ N'), y + z = x :=
by { rw [← mem_coe_submodule, sup_coe_to_submodule, submodule.mem_sup], exact iff.rfl, }

lemma eq_bot_iff : N = ⊥ ↔ ∀ (m : M), m ∈ N → m = 0 :=
by { rw eq_bot_iff, exact iff.rfl, }

-- TODO[gh-6025]: make this an instance once safe to do so
lemma subsingleton_of_bot : subsingleton (lie_submodule R L ↥(⊥ : lie_submodule R L M)) :=
begin
  apply subsingleton_of_bot_eq_top,
  ext ⟨x, hx⟩, change x ∈ ⊥ at hx, rw submodule.mem_bot at hx, subst hx,
  simp only [true_iff, eq_self_iff_true, submodule.mk_eq_zero, lie_submodule.mem_bot],
end

instance : is_modular_lattice (lie_submodule R L M) :=
{ sup_inf_le_assoc_of_le := λ N₁ N₂ N₃,
    by { simp only [← coe_submodule_le_coe_submodule, sup_coe_to_submodule, inf_coe_to_submodule],
         exact is_modular_lattice.sup_inf_le_assoc_of_le ↑N₂, }, }

variables (R L M)

lemma well_founded_of_noetherian [is_noetherian R M] :
  well_founded ((>) : lie_submodule R L M → lie_submodule R L M → Prop) :=
begin
  let f : ((>) : lie_submodule R L M → lie_submodule R L M → Prop) →r
          ((>) : submodule R M → submodule R M → Prop) :=
  { to_fun       := coe,
    map_rel' := λ N N' h, h, },
  apply f.well_founded, rw ← is_noetherian_iff_well_founded, apply_instance,
end

@[simp] lemma subsingleton_iff : subsingleton (lie_submodule R L M) ↔ subsingleton M :=
have h : subsingleton (lie_submodule R L M) ↔ subsingleton (submodule R M),
{ rw [← subsingleton_iff_bot_eq_top, ← subsingleton_iff_bot_eq_top, ← coe_to_submodule_eq_iff,
    top_coe_submodule, bot_coe_submodule], },
h.trans $ submodule.subsingleton_iff R

@[simp] lemma nontrivial_iff : nontrivial (lie_submodule R L M) ↔ nontrivial M :=
not_iff_not.mp (
  (not_nontrivial_iff_subsingleton.trans $ subsingleton_iff R L M).trans
  not_nontrivial_iff_subsingleton.symm)

instance [nontrivial M] : nontrivial (lie_submodule R L M) := (nontrivial_iff R L M).mpr ‹_›

variables {R L M}

section inclusion_maps

/-- The inclusion of a Lie submodule into its ambient space is a morphism of Lie modules. -/
def incl : N →ₗ⁅R,L⁆ M :=
{ map_lie' := λ x m, rfl,
  ..submodule.subtype (N : submodule R M) }

@[simp] lemma incl_apply (m : N) : N.incl m = m := rfl

lemma incl_eq_val : (N.incl : N → M) = subtype.val := rfl

variables {N N'} (h : N ≤ N')

/-- Given two nested Lie submodules `N ⊆ N'`, the inclusion `N ↪ N'` is a morphism of Lie modules.-/
def hom_of_le : N →ₗ⁅R,L⁆ N' :=
{ map_lie' := λ x m, rfl,
  ..submodule.of_le (show N.to_submodule ≤ N'.to_submodule, from h) }

@[simp] lemma coe_hom_of_le (m : N) : (hom_of_le h m : M) = m := rfl

lemma hom_of_le_apply (m : N) : hom_of_le h m = ⟨m.1, h m.2⟩ := rfl

lemma hom_of_le_injective : function.injective (hom_of_le h) :=
λ x y, by simp only [hom_of_le_apply, imp_self, subtype.mk_eq_mk, set_like.coe_eq_coe,
  subtype.val_eq_coe]

end inclusion_maps

section lie_span

variables (R L) (s : set M)
/-- The `lie_span` of a set `s ⊆ M` is the smallest Lie submodule of `M` that contains `s`. -/
def lie_span : lie_submodule R L M := Inf {N | s ⊆ N}

variables {R L s}

lemma mem_lie_span {x : M} : x ∈ lie_span R L s ↔ ∀ N : lie_submodule R L M, s ⊆ N → x ∈ N :=
by { change x ∈ (lie_span R L s : set M) ↔ _, erw Inf_coe, exact mem_bInter_iff, }

lemma subset_lie_span : s ⊆ lie_span R L s :=
by { intros m hm, erw mem_lie_span, intros N hN, exact hN hm, }

lemma submodule_span_le_lie_span : submodule.span R s ≤ lie_span R L s :=
by { rw submodule.span_le, apply subset_lie_span, }

lemma lie_span_le {N} : lie_span R L s ≤ N ↔ s ⊆ N :=
begin
  split,
  { exact subset.trans subset_lie_span, },
  { intros hs m hm, rw mem_lie_span at hm, exact hm _ hs, },
end

lemma lie_span_mono {t : set M} (h : s ⊆ t) : lie_span R L s ≤ lie_span R L t :=
by { rw lie_span_le, exact subset.trans h subset_lie_span, }

lemma lie_span_eq : lie_span R L (N : set M) = N :=
le_antisymm (lie_span_le.mpr rfl.subset) subset_lie_span

lemma coe_lie_span_submodule_eq_iff {p : submodule R M} :
  (lie_span R L (p : set M) : submodule R M) = p ↔ ∃ (N : lie_submodule R L M), ↑N = p :=
begin
  rw p.exists_lie_submodule_coe_eq_iff L, split; intros h,
  { intros x m hm, rw [← h, mem_coe_submodule], exact lie_mem _ (subset_lie_span hm), },
  { rw [← coe_to_submodule_mk p h, coe_to_submodule, coe_to_submodule_eq_iff, lie_span_eq], },
end

variables (R L M)

/-- `lie_span` forms a Galois insertion with the coercion from `lie_submodule` to `set`. -/
protected def gi : galois_insertion (lie_span R L : set M → lie_submodule R L M) coe :=
{ choice    := λ s _, lie_span R L s,
  gc        := λ s t, lie_span_le,
  le_l_u    := λ s, subset_lie_span,
  choice_eq := λ s h, rfl }

@[simp] lemma span_empty : lie_span R L (∅ : set M) = ⊥ :=
(lie_submodule.gi R L M).gc.l_bot

@[simp] lemma span_univ : lie_span R L (set.univ : set M) = ⊤ :=
eq_top_iff.2 $ set_like.le_def.2 $ subset_lie_span

variables {M}

lemma span_union (s t : set M) : lie_span R L (s ∪ t) = lie_span R L s ⊔ lie_span R L t :=
(lie_submodule.gi R L M).gc.l_sup

lemma span_Union {ι} (s : ι → set M) : lie_span R L (⋃ i, s i) = ⨆ i, lie_span R L (s i) :=
(lie_submodule.gi R L M).gc.l_supr

end lie_span

end lattice_structure

end lie_submodule

section lie_submodule_map_and_comap

variables {R : Type u} {L : Type v} {L' : Type w₂} {M : Type w} {M' : Type w₁}
variables [comm_ring R] [lie_ring L] [lie_algebra R L] [lie_ring L'] [lie_algebra R L']
variables [add_comm_group M] [module R M] [lie_ring_module L M] [lie_module R L M]
variables [add_comm_group M'] [module R M'] [lie_ring_module L M'] [lie_module R L M']

namespace lie_submodule

variables (f : M →ₗ⁅R,L⁆ M') (N N₂ : lie_submodule R L M) (N' : lie_submodule R L M')

/-- A morphism of Lie modules `f : M → M'` pushes forward Lie submodules of `M` to Lie submodules
of `M'`. -/
def map : lie_submodule R L M' :=
{ lie_mem := λ x m' h, by
  { rcases h with ⟨m, hm, hfm⟩, use ⁅x, m⁆, split,
    { apply N.lie_mem hm, },
    { norm_cast at hfm, simp [hfm], }, },
  ..(N : submodule R M).map (f : M →ₗ[R] M') }

/-- A morphism of Lie modules `f : M → M'` pulls back Lie submodules of `M'` to Lie submodules of
`M`. -/
def comap : lie_submodule R L M :=
{ lie_mem := λ x m h, by { suffices : ⁅x, f m⁆ ∈ N', { simp [this], }, apply N'.lie_mem h, },
  ..(N' : submodule R M').comap (f : M →ₗ[R] M') }

variables {f N N₂ N'}

lemma map_le_iff_le_comap : map f N ≤ N' ↔ N ≤ comap f N' :=
set.image_subset_iff

variables (f)

lemma gc_map_comap : galois_connection (map f) (comap f) :=
λ N N', map_le_iff_le_comap

variables {f}

@[simp] lemma map_sup : (N ⊔ N₂).map f = N.map f ⊔ N₂.map f :=
(gc_map_comap f).l_sup

lemma mem_map (m' : M') : m' ∈ N.map f ↔ ∃ m, m ∈ N ∧ f m = m' :=
submodule.mem_map

@[simp] lemma mem_comap {m : M} : m ∈ comap f N' ↔ f m ∈ N' := iff.rfl

end lie_submodule

namespace lie_ideal

variables (f : L →ₗ⁅R⁆ L') (I I₂ : lie_ideal R L) (J : lie_ideal R L')

@[simp] lemma top_coe_lie_subalgebra : ((⊤ : lie_ideal R L) : lie_subalgebra R L) = ⊤ := rfl

/-- A morphism of Lie algebras `f : L → L'` pushes forward Lie ideals of `L` to Lie ideals of `L'`.

Note that unlike `lie_submodule.map`, we must take the `lie_span` of the image. Mathematically
this is because although `f` makes `L'` into a Lie module over `L`, in general the `L` submodules of
`L'` are not the same as the ideals of `L'`. -/
def map : lie_ideal R L' := lie_submodule.lie_span R L' $ (I : submodule R L).map (f : L →ₗ[R] L')

/-- A morphism of Lie algebras `f : L → L'` pulls back Lie ideals of `L'` to Lie ideals of `L`.

Note that `f` makes `L'` into a Lie module over `L` (turning `f` into a morphism of Lie modules)
and so this is a special case of `lie_submodule.comap` but we do not exploit this fact. -/
def comap : lie_ideal R L :=
{ lie_mem := λ x y h, by { suffices : ⁅f x, f y⁆ ∈ J, { simp [this], }, apply J.lie_mem h, },
  ..(J : submodule R L').comap (f : L →ₗ[R] L') }

@[simp] lemma map_coe_submodule (h : ↑(map f I) = f '' I) :
  (map f I : submodule R L') = (I : submodule R L).map (f : L →ₗ[R] L') :=
by { rw [set_like.ext'_iff, lie_submodule.coe_to_submodule, h, submodule.map_coe], refl, }

@[simp] lemma comap_coe_submodule :
  (comap f J : submodule R L) = (J : submodule R L').comap (f : L →ₗ[R] L') := rfl

lemma map_le : map f I ≤ J ↔ f '' I ⊆ J := lie_submodule.lie_span_le

variables {f I I₂ J}

lemma mem_map {x : L} (hx : x ∈ I) : f x ∈ map f I :=
by { apply lie_submodule.subset_lie_span, use x, exact ⟨hx, rfl⟩, }

@[simp] lemma mem_comap {x : L} : x ∈ comap f J ↔ f x ∈ J := iff.rfl

lemma map_le_iff_le_comap : map f I ≤ J ↔ I ≤ comap f J :=
by { rw map_le, exact set.image_subset_iff, }

variables (f)

lemma gc_map_comap : galois_connection (map f) (comap f) :=
λ I I', map_le_iff_le_comap

variables {f}

@[simp] lemma map_sup : (I ⊔ I₂).map f = I.map f ⊔ I₂.map f :=
(gc_map_comap f).l_sup

lemma map_comap_le : map f (comap f J) ≤ J :=
by { rw map_le_iff_le_comap, apply le_refl _, }

/-- See also `lie_ideal.map_comap_eq`. -/
lemma comap_map_le : I ≤ comap f (map f I) :=
by { rw ← map_le_iff_le_comap, apply le_refl _, }

@[mono] lemma map_mono : monotone (map f) :=
λ I₁ I₂ h,
by { rw set_like.le_def at h, apply lie_submodule.lie_span_mono (set.image_subset ⇑f h), }

@[mono] lemma comap_mono : monotone (comap f) :=
λ J₁ J₂ h, by { rw ← set_like.coe_subset_coe at h ⊢, exact set.preimage_mono h, }

lemma map_of_image (h : f '' I = J) : I.map f = J :=
begin
  apply le_antisymm,
  { erw [lie_submodule.lie_span_le, submodule.map_coe, h], },
  { rw [← set_like.coe_subset_coe, ← h], exact lie_submodule.subset_lie_span, },
end

/-- Note that this is not a special case of `lie_submodule.subsingleton_of_bot`. Indeed, given
`I : lie_ideal R L`, in general the two lattices `lie_ideal R I` and `lie_submodule R L I` are
different (though the latter does naturally inject into the former).

In other words, in general, ideals of `I`, regarded as a Lie algebra in its own right, are not the
same as ideals of `L` contained in `I`. -/
-- TODO[gh-6025]: make this an instance once safe to do so
lemma subsingleton_of_bot : subsingleton (lie_ideal R ↥(⊥ : lie_ideal R L)) :=
begin
  apply subsingleton_of_bot_eq_top,
  ext ⟨x, hx⟩, change x ∈ ⊥ at hx, rw submodule.mem_bot at hx, subst hx,
  simp only [true_iff, eq_self_iff_true, submodule.mk_eq_zero, lie_submodule.mem_bot],
end

end lie_ideal

namespace lie_hom

variables (f : L →ₗ⁅R⁆ L') (I : lie_ideal R L) (J : lie_ideal R L')

/-- The kernel of a morphism of Lie algebras, as an ideal in the domain. -/
def ker : lie_ideal R L := lie_ideal.comap f ⊥

/-- The range of a morphism of Lie algebras as an ideal in the codomain. -/
def ideal_range : lie_ideal R L' := lie_submodule.lie_span R L' f.range

lemma ideal_range_eq_lie_span_range :
  f.ideal_range = lie_submodule.lie_span R L' f.range := rfl

lemma ideal_range_eq_map :
  f.ideal_range = lie_ideal.map f ⊤ :=
by { ext, simp only [ideal_range, range_eq_map], refl }

/-- The condition that the image of a morphism of Lie algebras is an ideal. -/
def is_ideal_morphism : Prop := (f.ideal_range : lie_subalgebra R L') = f.range

@[simp] lemma is_ideal_morphism_def :
  f.is_ideal_morphism ↔ (f.ideal_range : lie_subalgebra R L') = f.range := iff.rfl

lemma is_ideal_morphism_iff :
  f.is_ideal_morphism ↔ ∀ (x : L') (y : L), ∃ (z : L), ⁅x, f y⁆ = f z :=
begin
  simp only [is_ideal_morphism_def, ideal_range_eq_lie_span_range,
    ← lie_subalgebra.coe_to_submodule_eq_iff, ← f.range.coe_to_submodule,
    lie_ideal.coe_to_lie_subalgebra_to_submodule, lie_submodule.coe_lie_span_submodule_eq_iff,
    lie_subalgebra.mem_coe_submodule, mem_range, exists_imp_distrib,
    submodule.exists_lie_submodule_coe_eq_iff],
  split,
  { intros h x y, obtain ⟨z, hz⟩ := h x (f y) y rfl, use z, exact hz.symm, },
  { intros h x y z hz, obtain ⟨w, hw⟩ := h x z, use w, rw [← hw, hz], },
end

lemma range_subset_ideal_range : (f.range : set L') ⊆ f.ideal_range := lie_submodule.subset_lie_span

lemma map_le_ideal_range : I.map f ≤ f.ideal_range :=
begin
  rw f.ideal_range_eq_map,
  exact lie_ideal.map_mono le_top,
end

lemma ker_le_comap : f.ker ≤ J.comap f := lie_ideal.comap_mono bot_le

@[simp] lemma ker_coe_submodule : (ker f : submodule R L) = (f : L →ₗ[R] L').ker := rfl

@[simp] lemma mem_ker {x : L} : x ∈ ker f ↔ f x = 0 :=
show x ∈ (f.ker : submodule R L) ↔ _,
by simp only [ker_coe_submodule, linear_map.mem_ker, coe_to_linear_map]

lemma mem_ideal_range {x : L} : f x ∈ ideal_range f :=
begin
  rw ideal_range_eq_map,
  exact lie_ideal.mem_map (lie_submodule.mem_top x)
end

@[simp]

lemma le_ker_iff : I ≤ f.ker ↔ ∀ x, x ∈ I → f x = 0 :=
begin
  split; intros h x hx,
  { specialize h hx, rw mem_ker at h, exact h, },
  { rw mem_ker, apply h x hx, },
end

lemma ker_eq_bot : f.ker = ⊥ ↔ function.injective f :=
by rw [← lie_submodule.coe_to_submodule_eq_iff, ker_coe_submodule, lie_submodule.bot_coe_submodule,
  linear_map.ker_eq_bot, coe_to_linear_map]

@[simp] lemma range_coe_submodule : (f.range : submodule R L') = (f : L →ₗ[R] L').range := rfl

lemma range_eq_top : f.range = ⊤ ↔ function.surjective f :=
begin
  rw [← lie_subalgebra.coe_to_submodule_eq_iff, range_coe_submodule,
    lie_subalgebra.top_coe_submodule],
  exact linear_map.range_eq_top,
end

@[simp] lemma ideal_range_eq_top_of_surjective (h : function.surjective f) : f.ideal_range = ⊤ :=
begin
  rw ← f.range_eq_top at h,
  rw [ideal_range_eq_lie_span_range, h, ← lie_subalgebra.coe_to_submodule,
    ← lie_submodule.coe_to_submodule_eq_iff, lie_submodule.top_coe_submodule,
      lie_subalgebra.top_coe_submodule, lie_submodule.coe_lie_span_submodule_eq_iff],
  use ⊤,
  exact lie_submodule.top_coe_submodule,
end

lemma is_ideal_morphism_of_surjective (h : function.surjective f) : f.is_ideal_morphism :=
by rw [is_ideal_morphism_def, f.ideal_range_eq_top_of_surjective h, f.range_eq_top.mpr h,
    lie_ideal.top_coe_lie_subalgebra]

end lie_hom

namespace lie_ideal

variables {f : L →ₗ⁅R⁆ L'} {I : lie_ideal R L} {J : lie_ideal R L'}

@[simp] lemma map_eq_bot_iff : I.map f = ⊥ ↔ I ≤ f.ker :=
by { rw ← le_bot_iff, exact lie_ideal.map_le_iff_le_comap }

lemma coe_map_of_surjective (h : function.surjective f) :
  (I.map f : submodule R L') = (I : submodule R L).map (f : L →ₗ[R] L') :=
begin
  let J : lie_ideal R L' :=
  { lie_mem := λ x y hy,
    begin
      have hy' : ∃ (x : L), x ∈ I ∧ f x = y, { simpa [hy], },
      obtain ⟨z₂, hz₂, rfl⟩ := hy',
      obtain ⟨z₁, rfl⟩ := h x,
      simp only [lie_hom.coe_to_linear_map, set_like.mem_coe, set.mem_image,
        lie_submodule.mem_coe_submodule, submodule.mem_carrier, submodule.map_coe],
      use ⁅z₁, z₂⁆,
      exact ⟨I.lie_mem hz₂, f.map_lie z₁ z₂⟩,
    end,
    ..(I : submodule R L).map (f : L →ₗ[R] L'), },
  erw lie_submodule.coe_lie_span_submodule_eq_iff,
  use J,
  apply lie_submodule.coe_to_submodule_mk,
end

lemma mem_map_of_surjective {y : L'} (h₁ : function.surjective f) (h₂ : y ∈ I.map f) :
  ∃ (x : I), f x = y :=
begin
  rw [← lie_submodule.mem_coe_submodule, coe_map_of_surjective h₁, submodule.mem_map] at h₂,
  obtain ⟨x, hx, rfl⟩ := h₂,
  use ⟨x, hx⟩,
  refl,
end

lemma bot_of_map_eq_bot {I : lie_ideal R L} (h₁ : function.injective f) (h₂ : I.map f = ⊥) :
  I = ⊥ :=
begin
  rw ← f.ker_eq_bot at h₁, change comap f ⊥ = ⊥ at h₁,
  rw [eq_bot_iff, map_le_iff_le_comap, h₁] at h₂,
  rw eq_bot_iff, exact h₂,
end

/-- Given two nested Lie ideals `I₁ ⊆ I₂`, the inclusion `I₁ ↪ I₂` is a morphism of Lie algebras. -/
def hom_of_le {I₁ I₂ : lie_ideal R L} (h : I₁ ≤ I₂) : I₁ →ₗ⁅R⁆ I₂ :=
{ map_lie' := λ x y, rfl,
  ..submodule.of_le (show I₁.to_submodule ≤ I₂.to_submodule, from h), }

@[simp] lemma coe_hom_of_le {I₁ I₂ : lie_ideal R L} (h : I₁ ≤ I₂) (x : I₁) :
  (hom_of_le h x : L) = x := rfl

lemma hom_of_le_apply {I₁ I₂ : lie_ideal R L} (h : I₁ ≤ I₂) (x : I₁) :
  hom_of_le h x = ⟨x.1, h x.2⟩ := rfl

lemma hom_of_le_injective {I₁ I₂ : lie_ideal R L} (h : I₁ ≤ I₂) :
  function.injective (hom_of_le h) :=
λ x y, by simp only [hom_of_le_apply, imp_self, subtype.mk_eq_mk, set_like.coe_eq_coe,
  subtype.val_eq_coe]

@[simp] lemma map_sup_ker_eq_map : lie_ideal.map f (I ⊔ f.ker) = lie_ideal.map f I :=
begin
  suffices : lie_ideal.map f (I ⊔ f.ker) ≤ lie_ideal.map f I,
  { exact le_antisymm this (lie_ideal.map_mono le_sup_left), },
  apply lie_submodule.lie_span_mono,
  rintros x ⟨y, hy₁, hy₂⟩, rw ← hy₂,
  erw lie_submodule.mem_sup at hy₁, obtain ⟨z₁, hz₁, z₂, hz₂, hy⟩ := hy₁, rw ← hy,
  rw [f.coe_to_linear_map, f.map_add, f.mem_ker.mp hz₂, add_zero], exact ⟨z₁, hz₁, rfl⟩,
end

@[simp] lemma map_comap_eq (h : f.is_ideal_morphism) : map f (comap f J) = f.ideal_range ⊓ J :=
begin
  apply le_antisymm,
  { rw le_inf_iff, exact ⟨f.map_le_ideal_range _, map_comap_le⟩, },
  { rw f.is_ideal_morphism_def at h,
    rw [← set_like.coe_subset_coe, lie_submodule.inf_coe, ← coe_to_subalgebra, h],
    rintros y ⟨⟨x, h₁⟩, h₂⟩, rw ← h₁ at h₂ ⊢, exact mem_map h₂, },
end

@[simp] lemma comap_map_eq (h : ↑(map f I) = f '' I) : comap f (map f I) = I ⊔ f.ker :=
by rw [← lie_submodule.coe_to_submodule_eq_iff, comap_coe_submodule, I.map_coe_submodule f h,
  lie_submodule.sup_coe_to_submodule, f.ker_coe_submodule, submodule.comap_map_eq]

variables (f I J)

/-- Regarding an ideal `I` as a subalgebra, the inclusion map into its ambient space is a morphism
of Lie algebras. -/
def incl : I →ₗ⁅R⁆ L := (I : lie_subalgebra R L).incl

@[simp] lemma incl_range : I.incl.range = I := (I : lie_subalgebra R L).incl_range

@[simp] lemma incl_apply (x : I) : I.incl x = x := rfl

@[simp] lemma incl_coe : (I.incl : I →ₗ[R] L) = (I : submodule R L).subtype := rfl

@[simp] lemma comap_incl_self : comap I.incl I = ⊤ :=
by { rw ← lie_submodule.coe_to_submodule_eq_iff, exact submodule.comap_subtype_self _, }

@[simp] lemma ker_incl : I.incl.ker = ⊥ :=
by rw [← lie_submodule.coe_to_submodule_eq_iff, I.incl.ker_coe_submodule,
  lie_submodule.bot_coe_submodule, incl_coe, submodule.ker_subtype]

@[simp] lemma incl_ideal_range : I.incl.ideal_range = I :=
begin
  rw [lie_hom.ideal_range_eq_lie_span_range, ← lie_subalgebra.coe_to_submodule,
    ← lie_submodule.coe_to_submodule_eq_iff, incl_range, coe_to_lie_subalgebra_to_submodule,
    lie_submodule.coe_lie_span_submodule_eq_iff],
  use I,
end

lemma incl_is_ideal_morphism : I.incl.is_ideal_morphism :=
begin
  rw [I.incl.is_ideal_morphism_def, incl_ideal_range],
  exact (I : lie_subalgebra R L).incl_range.symm,
end

end lie_ideal

end lie_submodule_map_and_comap

namespace lie_module_hom

variables {R : Type u} {L : Type v} {M : Type w} {N : Type w₁}
variables [comm_ring R] [lie_ring L] [lie_algebra R L]
variables [add_comm_group M] [module R M] [lie_ring_module L M] [lie_module R L M]
variables [add_comm_group N] [module R N] [lie_ring_module L N] [lie_module R L N]
variables (f : M →ₗ⁅R,L⁆ N)

/-- The range of a morphism of Lie modules `f : M → N` is a Lie submodule of `N`.
See Note [range copy pattern]. -/
def range : lie_submodule R L N :=
(lie_submodule.map f ⊤).copy (set.range f) set.image_univ.symm

@[simp] lemma coe_range : (f.range : set N) = set.range f := rfl

@[simp] lemma coe_submodule_range : (f.range : submodule R N) = (f : M →ₗ[R] N).range := rfl

@[simp] lemma mem_range (n : N) : n ∈ f.range ↔ ∃ m, f m = n :=
iff.rfl

lemma map_top : lie_submodule.map f ⊤ = f.range :=
by { ext, simp [lie_submodule.mem_map], }

end lie_module_hom

section top_equiv_self

variables {R : Type u} {L : Type v}
variables [comm_ring R] [lie_ring L] [lie_algebra R L]

/-- The natural equivalence between the 'top' Lie subalgebra and the enclosing Lie algebra. -/
def lie_subalgebra.top_equiv_self : (⊤ : lie_subalgebra R L) ≃ₗ⁅R⁆ L :=
{ inv_fun   := λ x, ⟨x, set.mem_univ x⟩,
  left_inv  := λ x, by { ext, refl, },
  right_inv := λ x, rfl,
  ..(⊤ : lie_subalgebra R L).incl, }

@[simp] lemma lie_subalgebra.top_equiv_self_apply (x : (⊤ : lie_subalgebra R L)) :
  lie_subalgebra.top_equiv_self x = x := rfl

/-- The natural equivalence between the 'top' Lie ideal and the enclosing Lie algebra. -/
def lie_ideal.top_equiv_self : (⊤ : lie_ideal R L) ≃ₗ⁅R⁆ L :=
lie_subalgebra.top_equiv_self

@[simp] lemma lie_ideal.top_equiv_self_apply (x : (⊤ : lie_ideal R L)) :
  lie_ideal.top_equiv_self x = x := rfl

end top_equiv_self