/-
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

! This file was ported from Lean 3 source module logic.equiv.local_equiv
! leanprover-community/mathlib commit aba57d4d3dae35460225919dcd82fe91355162f9
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Set.Function
import Mathlib.Logic.Equiv.Defs
import Mathlib.Logic.Equiv.MfldSimpsAttr
import Mathlib.Tactic.Core

/-!
# Local equivalences

This files defines equivalences between subsets of given types.
An element `e` of `LocalEquiv α β` is made of two maps `e.toFun` and `e.invFun` 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.toFun x` and `e.invFun y`.

## Main definitions

`Equiv.toLocalEquiv`: associating a local equiv to an equiv, with source = target = univ
`LocalEquiv.symm`    : the inverse of a local equiv
`LocalEquiv.trans`   : the composition of two local equivs
`LocalEquiv.refl`    : the identity local equiv
`LocalEquiv.ofSet`  : the identity on a set `s`
`EqOnSource`        : 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 `LocalEquiv` version as explained above is easier to use for manifolds. The drawback is that
there is extra useless data (the values of `toFun` and `invFun` 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 `EqOnSource` 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 `LocalEquiv`,
then it should use `e.source ∩ s` or `e.target ∩ t`, not `s ∩ e.source` or `t ∩ e.target`.

-/
open Lean Meta Elab Tactic

/-! Implementation of the `mfld_set_tac` tactic for working with the domains of partially-defined
functions (`LocalEquiv`, `LocalHomeomorph`, etc).

This is in a separate file from `Mathlib.Logic.Equiv.MfldSimpsAttr` because attributes need a new
file to become functional.
-/

-- 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_setOf_eq Set.image_eq_empty Set.univ_inter Set.preimage_univ
  Set.prod_mk_mem_set_prod_eq and_true_iff Set.mem_univ Set.mem_image_of_mem true_and_iff
  Set.mem_inter_iff Set.mem_preimage Function.comp_apply Set.inter_subset_left Set.mem_prod
  Set.range_id Set.range_prod_map and_self_iff 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_iff or_true_iff Prod.map_mk Set.preimage_inter
  heq_iff_eq Equiv.sigmaEquivProd_apply Equiv.sigmaEquivProd_symm_apply Subtype.coe_mk
  Equiv.toFun_as_coe Equiv.invFun_as_coe

/-- Common `@[simps]` configuration options used for manifold-related declarations. -/
def mfld_cfg : Simps.Config where
  attrs := [`mfld_simps]
  fullyApplied := false
#align mfld_cfg mfld_cfg

namespace Tactic.MfldSetTac

/-- A very basic tactic to show that sets showing up in manifolds coincide or are included
in one another. -/
elab (name := mfldSetTac) "mfld_set_tac" : tactic => withMainContext do
  let g ← getMainGoal
  let goalTy := (← instantiateMVars (← g.getDecl).type).getAppFnArgs
  match goalTy with
  | (``Eq, #[_ty, _e₁, _e₂]) =>
    evalTactic (← `(tactic| (
      apply Set.ext; intro my_y
      constructor <;>
        · intro h_my_y
          try (simp only [*, mfld_simps] at h_my_y; simp only [*, mfld_simps]))))
  | (``Subset, #[_ty, _inst, _e₁, _e₂]) =>
    evalTactic (← `(tactic| (
      intro my_y h_my_y
      try (simp only [*, mfld_simps] at h_my_y; simp only [*, mfld_simps]))))
  | _ => throwError "goal should be an equality or an inclusion"

attribute [mfld_simps] and_true eq_self_iff_true Function.comp_apply

end Tactic.MfldSetTac

open Function Set

variable {α : Type _} {β : Type _} {γ : Type _} {δ : Type _}

/-- Local equivalence between subsets `source` and `target` of `α` and `β` respectively. The
(global) maps `toFun : α → β` and `invFun : β → α` map `source` to `target` and conversely, and are
inverse to each other there. The values of `toFun` outside of `source` and of `invFun` outside of
`target` are irrelevant. -/
structure LocalEquiv (α : Type _) (β : Type _) where
  /-- The global function which has a local inverse. Its value outside of the `source` subset is
  irrelevant. -/
  toFun : α → β
  /-- The local inverse to `toFun`. Its value outside of the `target` subset is irrelevant. -/
  invFun : β → α
  /-- The domain of the local equivalence. -/
  source : Set α
  /-- The codomain of the local equivalence. -/
  target : Set β
  /-- The proposition that elements of `source` are mapped to elements of `target`. -/
  map_source' : ∀ ⦃x⦄, x ∈ source → toFun x ∈ target
  /-- The proposition that elements of `target` are mapped to elements of `source`. -/
  map_target' : ∀ ⦃x⦄, x ∈ target → invFun x ∈ source
  /-- The proposition that `invFun` is a local left-inverse of `toFun` on `source`. -/
  left_inv' : ∀ ⦃x⦄, x ∈ source → invFun (toFun x) = x
  /-- The proposition that `invFun` is a local right-inverse of `toFun` on `target`. -/
  right_inv' : ∀ ⦃x⦄, x ∈ target → toFun (invFun x) = x
#align local_equiv LocalEquiv

namespace LocalEquiv

variable (e : LocalEquiv α β) (e' : LocalEquiv β γ)

instance [Inhabited α] [Inhabited β] : Inhabited (LocalEquiv α β) :=
  ⟨⟨const α default, const β default, ∅, ∅, mapsTo_empty _ _, mapsTo_empty _ _, eqOn_empty _ _,
      eqOn_empty _ _⟩⟩

/-- The inverse of a local equiv -/
protected def symm : LocalEquiv β α where
  toFun := e.invFun
  invFun := e.toFun
  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'
#align local_equiv.symm LocalEquiv.symm

instance : CoeFun (LocalEquiv α β) fun _ => α → β :=
  ⟨LocalEquiv.toFun⟩

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

initialize_simps_projections LocalEquiv (toFun → apply, invFun → symm_apply)

-- Porting note: this can be proven with `dsimp only`
-- @[simp, mfld_simps]
-- theorem coe_mk (f : α → β) (g s t ml mr il ir) : (LocalEquiv.mk f g s t ml mr il ir : α → β) = f
-- := by dsimp only
-- #align local_equiv.coe_mk LocalEquiv.coe_mk
#noalign local_equiv.coe_mk

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

-- Porting note: this is now a syntactic tautology
-- @[simp, mfld_simps]
-- theorem toFun_as_coe : e.toFun = e := rfl
-- #align local_equiv.to_fun_as_coe LocalEquiv.toFun_as_coe
#noalign local_equiv.to_fun_as_coe

@[simp, mfld_simps]
theorem invFun_as_coe : e.invFun = e.symm :=
  rfl
#align local_equiv.inv_fun_as_coe LocalEquiv.invFun_as_coe

@[simp, mfld_simps]
theorem map_source {x : α} (h : x ∈ e.source) : e x ∈ e.target :=
  e.map_source' h
#align local_equiv.map_source LocalEquiv.map_source

@[simp, mfld_simps]
theorem map_target {x : β} (h : x ∈ e.target) : e.symm x ∈ e.source :=
  e.map_target' h
#align local_equiv.map_target LocalEquiv.map_target

@[simp, mfld_simps]
theorem left_inv {x : α} (h : x ∈ e.source) : e.symm (e x) = x :=
  e.left_inv' h
#align local_equiv.left_inv LocalEquiv.left_inv

@[simp, mfld_simps]
theorem right_inv {x : β} (h : x ∈ e.target) : e (e.symm x) = x :=
  e.right_inv' h
#align local_equiv.right_inv LocalEquiv.right_inv

theorem eq_symm_apply {x : α} {y : β} (hx : x ∈ e.source) (hy : y ∈ e.target) :
    x = e.symm y ↔ e x = y :=
  ⟨fun h => by rw [← e.right_inv hy, h], fun h => by rw [← e.left_inv hx, h]⟩
#align local_equiv.eq_symm_apply LocalEquiv.eq_symm_apply

protected theorem mapsTo : MapsTo e e.source e.target := fun _ => e.map_source
#align local_equiv.maps_to LocalEquiv.mapsTo

theorem symm_mapsTo : MapsTo e.symm e.target e.source :=
  e.symm.mapsTo
#align local_equiv.symm_maps_to LocalEquiv.symm_mapsTo

protected theorem leftInvOn : LeftInvOn e.symm e e.source := fun _ => e.left_inv
#align local_equiv.left_inv_on LocalEquiv.leftInvOn

protected theorem rightInvOn : RightInvOn e.symm e e.target := fun _ => e.right_inv
#align local_equiv.right_inv_on LocalEquiv.rightInvOn

protected theorem invOn : InvOn e.symm e e.source e.target :=
  ⟨e.leftInvOn, e.rightInvOn⟩
#align local_equiv.inv_on LocalEquiv.invOn

protected theorem injOn : InjOn e e.source :=
  e.leftInvOn.injOn
#align local_equiv.inj_on LocalEquiv.injOn

protected theorem bijOn : BijOn e e.source e.target :=
  e.invOn.bijOn e.mapsTo e.symm_mapsTo
#align local_equiv.bij_on LocalEquiv.bijOn

protected theorem surjOn : SurjOn e e.source e.target :=
  e.bijOn.surjOn
#align local_equiv.surj_on LocalEquiv.surjOn

/-- Associate a `LocalEquiv` to an `Equiv`. -/
@[simps (config := mfld_cfg)]
def _root_.Equiv.toLocalEquiv (e : α ≃ β) : LocalEquiv α β where
  toFun := e
  invFun := e.symm
  source := univ
  target := univ
  map_source' _ _ := mem_univ _
  map_target' _ _ := mem_univ _
  left_inv' x _ := e.left_inv x
  right_inv' x _ := e.right_inv x
#align equiv.to_local_equiv Equiv.toLocalEquiv
#align equiv.to_local_equiv_symm_apply Equiv.toLocalEquiv_symm_apply
#align equiv.to_local_equiv_target Equiv.toLocalEquiv_target
#align equiv.to_local_equiv_apply Equiv.toLocalEquiv_apply
#align equiv.to_local_equiv_source Equiv.toLocalEquiv_source

instance inhabitedOfEmpty [IsEmpty α] [IsEmpty β] : Inhabited (LocalEquiv α β) :=
  ⟨((Equiv.equivEmpty α).trans (Equiv.equivEmpty β).symm).toLocalEquiv⟩
#align local_equiv.inhabited_of_empty LocalEquiv.inhabitedOfEmpty

/-- Create a copy of a `LocalEquiv` providing better definitional equalities. -/
@[simps (config := { fullyApplied := false })]
def copy (e : LocalEquiv α β) (f : α → β) (hf : ⇑e = f) (g : β → α) (hg : ⇑e.symm = g) (s : Set α)
    (hs : e.source = s) (t : Set β) (ht : e.target = t) :
    LocalEquiv α β where
  toFun := f
  invFun := g
  source := s
  target := t
  map_source' _ := ht ▸ hs ▸ hf ▸ e.map_source
  map_target' _ := hs ▸ ht ▸ hg ▸ e.map_target
  left_inv' _ := hs ▸ hf ▸ hg ▸ e.left_inv
  right_inv' _ := ht ▸ hf ▸ hg ▸ e.right_inv
#align local_equiv.copy LocalEquiv.copy
#align local_equiv.copy_source LocalEquiv.copy_source
#align local_equiv.copy_apply LocalEquiv.copy_apply
#align local_equiv.copy_symm_apply LocalEquiv.copy_symm_apply
#align local_equiv.copy_target LocalEquiv.copy_target

theorem copy_eq (e : LocalEquiv α β) (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
  rfl
#align local_equiv.copy_eq LocalEquiv.copy_eq

/-- Associate to a `LocalEquiv` an `Equiv` between the source and the target. -/
protected def toEquiv : e.source ≃ e.target where
  toFun x := ⟨e x, e.map_source x.mem⟩
  invFun y := ⟨e.symm y, e.map_target y.mem⟩
  left_inv := fun ⟨_, hx⟩ => Subtype.eq <| e.left_inv hx
  right_inv := fun ⟨_, hy⟩ => Subtype.eq <| e.right_inv hy
#align local_equiv.to_equiv LocalEquiv.toEquiv

@[simp, mfld_simps]
theorem symm_source : e.symm.source = e.target :=
  rfl
#align local_equiv.symm_source LocalEquiv.symm_source

@[simp, mfld_simps]
theorem symm_target : e.symm.target = e.source :=
  rfl
#align local_equiv.symm_target LocalEquiv.symm_target

@[simp, mfld_simps]
theorem symm_symm : e.symm.symm = e := by
  cases e
  rfl
#align local_equiv.symm_symm LocalEquiv.symm_symm

theorem image_source_eq_target : e '' e.source = e.target :=
  e.bijOn.image_eq
#align local_equiv.image_source_eq_target LocalEquiv.image_source_eq_target

theorem forall_mem_target {p : β → Prop} : (∀ y ∈ e.target, p y) ↔ ∀ x ∈ e.source, p (e x) := by
  rw [← image_source_eq_target, ball_image_iff]
#align local_equiv.forall_mem_target LocalEquiv.forall_mem_target

theorem exists_mem_target {p : β → Prop} : (∃ y ∈ e.target, p y) ↔ ∃ x ∈ e.source, p (e x) := by
  rw [← image_source_eq_target, bex_image_iff]
#align local_equiv.exists_mem_target LocalEquiv.exists_mem_target

/-- 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 IsImage (s : Set α) (t : Set β) : Prop :=
  ∀ ⦃x⦄, x ∈ e.source → (e x ∈ t ↔ x ∈ s)
#align local_equiv.is_image LocalEquiv.IsImage

namespace IsImage

variable {e} {s : Set α} {t : Set β} {x : α} {y : β}

theorem apply_mem_iff (h : e.IsImage s t) (hx : x ∈ e.source) : e x ∈ t ↔ x ∈ s :=
  h hx
#align local_equiv.is_image.apply_mem_iff LocalEquiv.IsImage.apply_mem_iff

protected theorem symm (h : e.IsImage s t) : e.symm.IsImage t s :=
  h.symm_apply_mem_iff
#align local_equiv.is_image.symm LocalEquiv.IsImage.symm

@[simp]
theorem symm_iff : e.symm.IsImage t s ↔ e.IsImage s t :=
  ⟨fun h => h.symm, fun h => h.symm⟩
#align local_equiv.is_image.symm_iff LocalEquiv.IsImage.symm_iff

protected theorem mapsTo (h : e.IsImage s t) : MapsTo e (e.source ∩ s) (e.target ∩ t) :=
  fun _ hx => ⟨e.mapsTo hx.1, (h hx.1).2 hx.2⟩
#align local_equiv.is_image.maps_to LocalEquiv.IsImage.mapsTo

theorem symm_mapsTo (h : e.IsImage s t) : MapsTo e.symm (e.target ∩ t) (e.source ∩ s) :=
  h.symm.mapsTo
#align local_equiv.is_image.symm_maps_to LocalEquiv.IsImage.symm_mapsTo

/-- Restrict a `LocalEquiv` to a pair of corresponding sets. -/
@[simps (config := { fullyApplied := false })]
def restr (h : e.IsImage s t) : LocalEquiv α β where
  toFun := e
  invFun := e.symm
  source := e.source ∩ s
  target := e.target ∩ t
  map_source' := h.mapsTo
  map_target' := h.symm_mapsTo
  left_inv' := e.leftInvOn.mono (inter_subset_left _ _)
  right_inv' := e.rightInvOn.mono (inter_subset_left _ _)
#align local_equiv.is_image.restr LocalEquiv.IsImage.restr
#align local_equiv.is_image.restr_apply LocalEquiv.IsImage.restr_apply
#align local_equiv.is_image.restr_source LocalEquiv.IsImage.restr_source
#align local_equiv.is_image.restr_target LocalEquiv.IsImage.restr_target
#align local_equiv.is_image.restr_symm_apply LocalEquiv.IsImage.restr_symm_apply

theorem image_eq (h : e.IsImage s t) : e '' (e.source ∩ s) = e.target ∩ t :=
  h.restr.image_source_eq_target
#align local_equiv.is_image.image_eq LocalEquiv.IsImage.image_eq

theorem symm_image_eq (h : e.IsImage s t) : e.symm '' (e.target ∩ t) = e.source ∩ s :=
  h.symm.image_eq
#align local_equiv.is_image.symm_image_eq LocalEquiv.IsImage.symm_image_eq

theorem iff_preimage_eq : e.IsImage s t ↔ e.source ∩ e ⁻¹' t = e.source ∩ s := by
  simp only [IsImage, ext_iff, mem_inter_iff, mem_preimage, and_congr_right_iff]
#align local_equiv.is_image.iff_preimage_eq LocalEquiv.IsImage.iff_preimage_eq

alias iff_preimage_eq ↔ preimage_eq of_preimage_eq
#align local_equiv.is_image.of_preimage_eq LocalEquiv.IsImage.of_preimage_eq
#align local_equiv.is_image.preimage_eq LocalEquiv.IsImage.preimage_eq

theorem iff_symm_preimage_eq : e.IsImage s t ↔ e.target ∩ e.symm ⁻¹' s = e.target ∩ t :=
  symm_iff.symm.trans iff_preimage_eq
#align local_equiv.is_image.iff_symm_preimage_eq LocalEquiv.IsImage.iff_symm_preimage_eq

alias iff_symm_preimage_eq ↔ symm_preimage_eq of_symm_preimage_eq
#align local_equiv.is_image.of_symm_preimage_eq LocalEquiv.IsImage.of_symm_preimage_eq
#align local_equiv.is_image.symm_preimage_eq LocalEquiv.IsImage.symm_preimage_eq

theorem of_image_eq (h : e '' (e.source ∩ s) = e.target ∩ t) : e.IsImage s t :=
  of_symm_preimage_eq <| Eq.trans (of_symm_preimage_eq rfl).image_eq.symm h
#align local_equiv.is_image.of_image_eq LocalEquiv.IsImage.of_image_eq

theorem of_symm_image_eq (h : e.symm '' (e.target ∩ t) = e.source ∩ s) : e.IsImage s t :=
  of_preimage_eq <| Eq.trans (iff_preimage_eq.2 rfl).symm_image_eq.symm h
#align local_equiv.is_image.of_symm_image_eq LocalEquiv.IsImage.of_symm_image_eq

protected theorem compl (h : e.IsImage s t) : e.IsImage (sᶜ) (tᶜ) := fun _ hx => not_congr (h hx)
#align local_equiv.is_image.compl LocalEquiv.IsImage.compl

protected theorem inter {s' t'} (h : e.IsImage s t) (h' : e.IsImage s' t') :
    e.IsImage (s ∩ s') (t ∩ t') := fun _ hx => and_congr (h hx) (h' hx)
#align local_equiv.is_image.inter LocalEquiv.IsImage.inter

protected theorem union {s' t'} (h : e.IsImage s t) (h' : e.IsImage s' t') :
    e.IsImage (s ∪ s') (t ∪ t') := fun _ hx => or_congr (h hx) (h' hx)
#align local_equiv.is_image.union LocalEquiv.IsImage.union

protected theorem diff {s' t'} (h : e.IsImage s t) (h' : e.IsImage s' t') :
    e.IsImage (s \ s') (t \ t') :=
  h.inter h'.compl
#align local_equiv.is_image.diff LocalEquiv.IsImage.diff

theorem leftInvOn_piecewise {e' : LocalEquiv α β} [∀ i, Decidable (i ∈ s)]
    [∀ i, Decidable (i ∈ t)] (h : e.IsImage s t) (h' : e'.IsImage s t) :
    LeftInvOn (t.piecewise e.symm e'.symm) (s.piecewise e e') (s.ite e.source e'.source) := by
  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]
#align local_equiv.is_image.left_inv_on_piecewise LocalEquiv.IsImage.leftInvOn_piecewise

theorem inter_eq_of_inter_eq_of_eqOn {e' : LocalEquiv α β} (h : e.IsImage s t)
    (h' : e'.IsImage s t) (hs : e.source ∩ s = e'.source ∩ s) (heq : EqOn e e' (e.source ∩ s)) :
    e.target ∩ t = e'.target ∩ t := by rw [← h.image_eq, ← h'.image_eq, ← hs, heq.image_eq]
#align local_equiv.is_image.inter_eq_of_inter_eq_of_eq_on LocalEquiv.IsImage.inter_eq_of_inter_eq_of_eqOn

theorem symm_eq_on_of_inter_eq_of_eqOn {e' : LocalEquiv α β} (h : e.IsImage s t)
    (hs : e.source ∩ s = e'.source ∩ s) (heq : EqOn e e' (e.source ∩ s)) :
    EqOn e.symm e'.symm (e.target ∩ t) := by
  rw [← h.image_eq]
  rintro y ⟨x, hx, rfl⟩
  have hx' := hx; rw [hs] at hx'
  rw [e.left_inv hx.1, heq hx, e'.left_inv hx'.1]
#align local_equiv.is_image.symm_eq_on_of_inter_eq_of_eq_on LocalEquiv.IsImage.symm_eq_on_of_inter_eq_of_eqOn

end IsImage

theorem isImage_source_target : e.IsImage e.source e.target := fun x hx => by simp [hx]
#align local_equiv.is_image_source_target LocalEquiv.isImage_source_target

theorem isImage_source_target_of_disjoint (e' : LocalEquiv α β) (hs : Disjoint e.source e'.source)
    (ht : Disjoint e.target e'.target) : e.IsImage e'.source e'.target :=
  IsImage.of_image_eq <| by rw [hs.inter_eq, ht.inter_eq, image_empty]
#align local_equiv.is_image_source_target_of_disjoint LocalEquiv.isImage_source_target_of_disjoint

theorem image_source_inter_eq' (s : Set α) : e '' (e.source ∩ s) = e.target ∩ e.symm ⁻¹' s := by
  rw [inter_comm, e.leftInvOn.image_inter', image_source_eq_target, inter_comm]
#align local_equiv.image_source_inter_eq' LocalEquiv.image_source_inter_eq'

theorem image_source_inter_eq (s : Set α) :
    e '' (e.source ∩ s) = e.target ∩ e.symm ⁻¹' (e.source ∩ s) := by
  rw [inter_comm, e.leftInvOn.image_inter, image_source_eq_target, inter_comm]
#align local_equiv.image_source_inter_eq LocalEquiv.image_source_inter_eq

theorem 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]
#align local_equiv.image_eq_target_inter_inv_preimage LocalEquiv.image_eq_target_inter_inv_preimage

theorem 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
#align local_equiv.symm_image_eq_source_inter_preimage LocalEquiv.symm_image_eq_source_inter_preimage

theorem symm_image_target_inter_eq (s : Set β) :
    e.symm '' (e.target ∩ s) = e.source ∩ e ⁻¹' (e.target ∩ s) :=
  e.symm.image_source_inter_eq _
#align local_equiv.symm_image_target_inter_eq LocalEquiv.symm_image_target_inter_eq

theorem symm_image_target_inter_eq' (s : Set β) : e.symm '' (e.target ∩ s) = e.source ∩ e ⁻¹' s :=
  e.symm.image_source_inter_eq' _
#align local_equiv.symm_image_target_inter_eq' LocalEquiv.symm_image_target_inter_eq'

theorem source_inter_preimage_inv_preimage (s : Set α) :
    e.source ∩ e ⁻¹' (e.symm ⁻¹' s) = e.source ∩ s :=
  Set.ext fun x => and_congr_right_iff.2 fun hx =>
    by simp only [mem_preimage, e.left_inv hx]
#align local_equiv.source_inter_preimage_inv_preimage LocalEquiv.source_inter_preimage_inv_preimage

theorem source_inter_preimage_target_inter (s : Set β) :
    e.source ∩ e ⁻¹' (e.target ∩ s) = e.source ∩ e ⁻¹' s :=
  ext fun _ => ⟨fun hx => ⟨hx.1, hx.2.2⟩, fun hx => ⟨hx.1, e.map_source hx.1, hx.2⟩⟩
#align local_equiv.source_inter_preimage_target_inter LocalEquiv.source_inter_preimage_target_inter

theorem target_inter_inv_preimage_preimage (s : Set β) :
    e.target ∩ e.symm ⁻¹' (e ⁻¹' s) = e.target ∩ s :=
  e.symm.source_inter_preimage_inv_preimage _
#align local_equiv.target_inter_inv_preimage_preimage LocalEquiv.target_inter_inv_preimage_preimage

theorem symm_image_image_of_subset_source {s : Set α} (h : s ⊆ e.source) : e.symm '' (e '' s) = s :=
  (e.leftInvOn.mono h).image_image
#align local_equiv.symm_image_image_of_subset_source LocalEquiv.symm_image_image_of_subset_source

theorem image_symm_image_of_subset_target {s : Set β} (h : s ⊆ e.target) : e '' (e.symm '' s) = s :=
  e.symm.symm_image_image_of_subset_source h
#align local_equiv.image_symm_image_of_subset_target LocalEquiv.image_symm_image_of_subset_target

theorem source_subset_preimage_target : e.source ⊆ e ⁻¹' e.target :=
  e.mapsTo
#align local_equiv.source_subset_preimage_target LocalEquiv.source_subset_preimage_target

theorem symm_image_target_eq_source : e.symm '' e.target = e.source :=
  e.symm.image_source_eq_target
#align local_equiv.symm_image_target_eq_source LocalEquiv.symm_image_target_eq_source

theorem target_subset_preimage_source : e.target ⊆ e.symm ⁻¹' e.source :=
  e.symm_mapsTo
#align local_equiv.target_subset_preimage_source LocalEquiv.target_subset_preimage_source

/-- Two local equivs that have the same `source`, same `toFun` and same `invFun`, coincide. -/
@[ext]
protected theorem ext {e e' : LocalEquiv α β} (h : ∀ x, e x = e' x)
    (hsymm : ∀ x, e.symm x = e'.symm x) (hs : e.source = e'.source) : e = e' := by
  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 *
  simp [*]
#align local_equiv.ext LocalEquiv.ext

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

@[simp, mfld_simps]
theorem restr_coe (s : Set α) : (e.restr s : α → β) = e :=
  rfl
#align local_equiv.restr_coe LocalEquiv.restr_coe

@[simp, mfld_simps]
theorem restr_coe_symm (s : Set α) : ((e.restr s).symm : β → α) = e.symm :=
  rfl
#align local_equiv.restr_coe_symm LocalEquiv.restr_coe_symm

@[simp, mfld_simps]
theorem restr_source (s : Set α) : (e.restr s).source = e.source ∩ s :=
  rfl
#align local_equiv.restr_source LocalEquiv.restr_source

@[simp, mfld_simps]
theorem restr_target (s : Set α) : (e.restr s).target = e.target ∩ e.symm ⁻¹' s :=
  rfl
#align local_equiv.restr_target LocalEquiv.restr_target

theorem restr_eq_of_source_subset {e : LocalEquiv α β} {s : Set α} (h : e.source ⊆ s) :
    e.restr s = e :=
  LocalEquiv.ext (fun _ => rfl) (fun _ => rfl) (by simp [inter_eq_self_of_subset_left h])
#align local_equiv.restr_eq_of_source_subset LocalEquiv.restr_eq_of_source_subset

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

/-- The identity local equiv -/
protected def refl (α : Type _) : LocalEquiv α α :=
  (Equiv.refl α).toLocalEquiv
#align local_equiv.refl LocalEquiv.refl

@[simp, mfld_simps]
theorem refl_source : (LocalEquiv.refl α).source = univ :=
  rfl
#align local_equiv.refl_source LocalEquiv.refl_source

@[simp, mfld_simps]
theorem refl_target : (LocalEquiv.refl α).target = univ :=
  rfl
#align local_equiv.refl_target LocalEquiv.refl_target

@[simp, mfld_simps]
theorem refl_coe : (LocalEquiv.refl α : α → α) = id :=
  rfl
#align local_equiv.refl_coe LocalEquiv.refl_coe

@[simp, mfld_simps]
theorem refl_symm : (LocalEquiv.refl α).symm = LocalEquiv.refl α :=
  rfl
#align local_equiv.refl_symm LocalEquiv.refl_symm

-- Porting note: removed `simp` because `simp` can prove this
@[mfld_simps]
theorem refl_restr_source (s : Set α) : ((LocalEquiv.refl α).restr s).source = s := by simp
#align local_equiv.refl_restr_source LocalEquiv.refl_restr_source

-- Porting note: removed `simp` because `simp` can prove this
@[mfld_simps]
theorem refl_restr_target (s : Set α) : ((LocalEquiv.refl α).restr s).target = s := by
  change univ ∩ id ⁻¹' s = s
  simp
#align local_equiv.refl_restr_target LocalEquiv.refl_restr_target

/-- The identity local equiv on a set `s` -/
def ofSet (s : Set α) : LocalEquiv α α where
  toFun := id
  invFun := id
  source := s
  target := s
  map_source' _ hx := hx
  map_target' _ hx := hx
  left_inv' _ _ := rfl
  right_inv' _ _ := rfl
#align local_equiv.of_set LocalEquiv.ofSet

@[simp, mfld_simps]
theorem ofSet_source (s : Set α) : (LocalEquiv.ofSet s).source = s :=
  rfl
#align local_equiv.of_set_source LocalEquiv.ofSet_source

@[simp, mfld_simps]
theorem ofSet_target (s : Set α) : (LocalEquiv.ofSet s).target = s :=
  rfl
#align local_equiv.of_set_target LocalEquiv.ofSet_target

@[simp, mfld_simps]
theorem ofSet_coe (s : Set α) : (LocalEquiv.ofSet s : α → α) = id :=
  rfl
#align local_equiv.of_set_coe LocalEquiv.ofSet_coe

@[simp, mfld_simps]
theorem ofSet_symm (s : Set α) : (LocalEquiv.ofSet s).symm = LocalEquiv.ofSet s :=
  rfl
#align local_equiv.of_set_symm LocalEquiv.ofSet_symm

/-- Composing two local equivs if the target of the first coincides with the source of the
second. -/
protected def trans' (e' : LocalEquiv β γ) (h : e.target = e'.source) : LocalEquiv α γ where
  toFun := e' ∘ e
  invFun := e.symm ∘ e'.symm
  source := e.source
  target := e'.target
  map_source' x hx := by simp [←h, hx]
  map_target' y hy := by simp [h, hy]
  left_inv' x hx := by simp [hx, ←h]
  right_inv' y hy := by simp [hy, h]
#align local_equiv.trans' LocalEquiv.trans'

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

@[simp, mfld_simps]
theorem coe_trans : (e.trans e' : α → γ) = e' ∘ e :=
  rfl
#align local_equiv.coe_trans LocalEquiv.coe_trans

@[simp, mfld_simps]
theorem coe_trans_symm : ((e.trans e').symm : γ → α) = e.symm ∘ e'.symm :=
  rfl
#align local_equiv.coe_trans_symm LocalEquiv.coe_trans_symm

theorem trans_apply {x : α} : (e.trans e') x = e' (e x) :=
  rfl
#align local_equiv.trans_apply LocalEquiv.trans_apply

theorem trans_symm_eq_symm_trans_symm : (e.trans e').symm = e'.symm.trans e.symm := by
  cases e; cases e'; rfl
#align local_equiv.trans_symm_eq_symm_trans_symm LocalEquiv.trans_symm_eq_symm_trans_symm

@[simp, mfld_simps]
theorem trans_source : (e.trans e').source = e.source ∩ e ⁻¹' e'.source :=
  rfl
#align local_equiv.trans_source LocalEquiv.trans_source

theorem trans_source' : (e.trans e').source = e.source ∩ e ⁻¹' (e.target ∩ e'.source) := by
  mfld_set_tac
#align local_equiv.trans_source' LocalEquiv.trans_source'

theorem trans_source'' : (e.trans e').source = e.symm '' (e.target ∩ e'.source) := by
  rw [e.trans_source', e.symm_image_target_inter_eq]
#align local_equiv.trans_source'' LocalEquiv.trans_source''

theorem image_trans_source : e '' (e.trans e').source = e.target ∩ e'.source :=
  (e.symm.restr e'.source).symm.image_source_eq_target
#align local_equiv.image_trans_source LocalEquiv.image_trans_source

@[simp, mfld_simps]
theorem trans_target : (e.trans e').target = e'.target ∩ e'.symm ⁻¹' e.target :=
  rfl
#align local_equiv.trans_target LocalEquiv.trans_target

theorem trans_target' : (e.trans e').target = e'.target ∩ e'.symm ⁻¹' (e'.source ∩ e.target) :=
  trans_source' e'.symm e.symm
#align local_equiv.trans_target' LocalEquiv.trans_target'

theorem trans_target'' : (e.trans e').target = e' '' (e'.source ∩ e.target) :=
  trans_source'' e'.symm e.symm
#align local_equiv.trans_target'' LocalEquiv.trans_target''

theorem inv_image_trans_target : e'.symm '' (e.trans e').target = e'.source ∩ e.target :=
  image_trans_source e'.symm e.symm
#align local_equiv.inv_image_trans_target LocalEquiv.inv_image_trans_target

theorem trans_assoc (e'' : LocalEquiv γ δ) : (e.trans e').trans e'' = e.trans (e'.trans e'') :=
  LocalEquiv.ext (fun x => rfl) (fun x => rfl)
    (by simp [trans_source, @preimage_comp α β γ, inter_assoc])
#align local_equiv.trans_assoc LocalEquiv.trans_assoc

@[simp, mfld_simps]
theorem trans_refl : e.trans (LocalEquiv.refl β) = e :=
  LocalEquiv.ext (fun x => rfl) (fun x => rfl) (by simp [trans_source])
#align local_equiv.trans_refl LocalEquiv.trans_refl

@[simp, mfld_simps]
theorem refl_trans : (LocalEquiv.refl α).trans e = e :=
  LocalEquiv.ext (fun x => rfl) (fun x => rfl) (by simp [trans_source, preimage_id])
#align local_equiv.refl_trans LocalEquiv.refl_trans

theorem trans_ofSet (s : Set β) : e.trans (ofSet s) = e.restr (e ⁻¹' s) :=
  LocalEquiv.ext (fun _ => rfl) (fun _ => rfl) rfl

theorem trans_refl_restr (s : Set β) : e.trans ((LocalEquiv.refl β).restr s) = e.restr (e ⁻¹' s) :=
  LocalEquiv.ext (fun x => rfl) (fun x => rfl) (by simp [trans_source])
#align local_equiv.trans_refl_restr LocalEquiv.trans_refl_restr

theorem trans_refl_restr' (s : Set β) :
    e.trans ((LocalEquiv.refl β).restr s) = e.restr (e.source ∩ e ⁻¹' s) :=
  LocalEquiv.ext (fun x => rfl) (fun x => rfl) <| by
    simp [trans_source]
    rw [← inter_assoc, inter_self]
#align local_equiv.trans_refl_restr' LocalEquiv.trans_refl_restr'

theorem restr_trans (s : Set α) : (e.restr s).trans e' = (e.trans e').restr s :=
  LocalEquiv.ext (fun x => rfl) (fun x => rfl) <| by
    simp [trans_source, inter_comm, inter_assoc]
#align local_equiv.restr_trans LocalEquiv.restr_trans

/-- A lemma commonly useful when `e` and `e'` are charts of a manifold. -/
theorem mem_symm_trans_source {e' : LocalEquiv α γ} {x : α} (he : x ∈ e.source)
    (he' : x ∈ e'.source) : e x ∈ (e.symm.trans e').source :=
  ⟨e.mapsTo he, by rwa [mem_preimage, LocalEquiv.symm_symm, e.left_inv he]⟩
#align local_equiv.mem_symm_trans_source LocalEquiv.mem_symm_trans_source

/-- Postcompose a local equivalence with an equivalence.
We modify the source and target to have better definitional behavior. -/
@[simps!]
def transEquiv (e' : β ≃ γ) : LocalEquiv α γ :=
  (e.trans e'.toLocalEquiv).copy _ rfl _ rfl e.source (inter_univ _) (e'.symm ⁻¹' e.target)
    (univ_inter _)
#align local_equiv.trans_equiv LocalEquiv.transEquiv
#align local_equiv.trans_equiv_source LocalEquiv.transEquiv_source
#align local_equiv.trans_equiv_apply LocalEquiv.transEquiv_apply
#align local_equiv.trans_equiv_target LocalEquiv.transEquiv_target
#align local_equiv.trans_equiv_symm_apply LocalEquiv.transEquiv_symm_apply

theorem transEquiv_eq_trans (e' : β ≃ γ) : e.transEquiv e' = e.trans e'.toLocalEquiv :=
  copy_eq ..
#align local_equiv.trans_equiv_eq_trans LocalEquiv.transEquiv_eq_trans

/-- Precompose a local equivalence with an equivalence.
We modify the source and target to have better definitional behavior. -/
@[simps!]
def _root_.Equiv.transLocalEquiv (e : α ≃ β) : LocalEquiv α γ :=
  (e.toLocalEquiv.trans e').copy _ rfl _ rfl (e ⁻¹' e'.source) (univ_inter _) e'.target
    (inter_univ _)
#align equiv.trans_local_equiv Equiv.transLocalEquiv
#align equiv.trans_local_equiv_target Equiv.transLocalEquiv_target
#align equiv.trans_local_equiv_apply Equiv.transLocalEquiv_apply
#align equiv.trans_local_equiv_source Equiv.transLocalEquiv_source
#align equiv.trans_local_equiv_symm_apply Equiv.transLocalEquiv_symm_apply

theorem _root_.Equiv.transLocalEquiv_eq_trans (e : α ≃ β) :
    e.transLocalEquiv e' = e.toLocalEquiv.trans e' :=
  copy_eq ..
#align equiv.trans_local_equiv_eq_trans Equiv.transLocalEquiv_eq_trans

/-- `EqOnSource 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 EqOnSource (e e' : LocalEquiv α β) : Prop :=
  e.source = e'.source ∧ e.source.EqOn e e'
#align local_equiv.eq_on_source LocalEquiv.EqOnSource

/-- `EqOnSource` is an equivalence relation. This instance provides the `≈` notation between two
`LocalEquiv`s. -/
instance eqOnSourceSetoid : Setoid (LocalEquiv α β) where
  r := EqOnSource
  iseqv := by constructor <;> simp only [Equivalence, EqOnSource, EqOn] <;> aesop
#align local_equiv.eq_on_source_setoid LocalEquiv.eqOnSourceSetoid

theorem eqOnSource_refl : e ≈ e :=
  Setoid.refl _
#align local_equiv.eq_on_source_refl LocalEquiv.eqOnSource_refl

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

/-- Two equivalent local equivs coincide on the source -/
theorem EqOnSource.eqOn {e e' : LocalEquiv α β} (h : e ≈ e') : e.source.EqOn e e' :=
  h.2
#align local_equiv.eq_on_source.eq_on LocalEquiv.EqOnSource.eqOn

--Porting note: A lot of dot notation failures here. Maybe we should not use `≈`

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

/-- If two local equivs are equivalent, so are their inverses. -/
theorem EqOnSource.symm' {e e' : LocalEquiv α β} (h : e ≈ e') : e.symm ≈ e'.symm := by
  refine' ⟨target_eq h, eqOn_of_leftInvOn_of_rightInvOn e.leftInvOn _ _⟩ <;>
    simp only [symm_source, target_eq h, source_eq h, e'.symm_mapsTo]
  exact e'.rightInvOn.congr_right e'.symm_mapsTo (source_eq h ▸ h.eqOn.symm)
#align local_equiv.eq_on_source.symm' LocalEquiv.EqOnSource.symm'

/-- Two equivalent local equivs have coinciding inverses on the target -/
theorem EqOnSource.symm_eqOn {e e' : LocalEquiv α β} (h : e ≈ e') : EqOn e.symm e'.symm e.target :=
  -- Porting note: `h.symm'` dot notation doesn't work anymore because `h` is not recognised as
  -- `LocalEquiv.EqOnSource` for some reason.
  eqOn (symm' h)
#align local_equiv.eq_on_source.symm_eq_on LocalEquiv.EqOnSource.symm_eqOn

/-- Composition of local equivs respects equivalence -/
theorem EqOnSource.trans' {e e' : LocalEquiv α β} {f f' : LocalEquiv β γ} (he : e ≈ e')
    (hf : f ≈ f') : e.trans f ≈ e'.trans f' := by
  constructor
  · rw [trans_source'', trans_source'', ← target_eq he, ← hf.1]
    exact (he.symm'.eqOn.mono <| inter_subset_left _ _).image_eq
  · intro x hx
    rw [trans_source] at hx
    simp [Function.comp_apply, LocalEquiv.coe_trans, (he.2 hx.1).symm, hf.2 hx.2]
#align local_equiv.eq_on_source.trans' LocalEquiv.EqOnSource.trans'

/-- Restriction of local equivs respects equivalence -/
theorem EqOnSource.restr {e e' : LocalEquiv α β} (he : e ≈ e') (s : Set α) :
    e.restr s ≈ e'.restr s := by
  constructor
  · simp [he.1]
  · intro x hx
    simp only [mem_inter_iff, restr_source] at hx
    exact he.2 hx.1
#align local_equiv.eq_on_source.restr LocalEquiv.EqOnSource.restr

/-- Preimages are respected by equivalence -/
theorem EqOnSource.source_inter_preimage_eq {e e' : LocalEquiv α β} (he : e ≈ e') (s : Set β) :
    e.source ∩ e ⁻¹' s = e'.source ∩ e' ⁻¹' s := by rw [he.eqOn.inter_preimage_eq, source_eq he]
#align local_equiv.eq_on_source.source_inter_preimage_eq LocalEquiv.EqOnSource.source_inter_preimage_eq

/-- Composition of a local equiv and its inverse is equivalent to the restriction of the identity
to the source -/
theorem trans_self_symm : e.trans e.symm ≈ ofSet e.source := by
  have A : (e.trans e.symm).source = e.source := by mfld_set_tac
  refine' ⟨by rw [A, ofSet_source], fun x hx => _⟩
  rw [A] at hx
  simp only [hx, mfld_simps]
#align local_equiv.trans_self_symm LocalEquiv.trans_self_symm

/-- Composition of the inverse of a local equiv and this local equiv is equivalent to the
restriction of the identity to the target -/
theorem trans_symm_self : e.symm.trans e ≈ LocalEquiv.ofSet e.target :=
  trans_self_symm e.symm
#align local_equiv.trans_symm_self LocalEquiv.trans_symm_self

/-- Two equivalent local equivs are equal when the source and target are univ -/
theorem eq_of_eq_on_source_univ (e e' : LocalEquiv α β) (h : e ≈ e') (s : e.source = univ)
    (t : e.target = univ) : e = e' := by
  refine LocalEquiv.ext (fun x => ?_) (fun x => ?_) h.1
  · apply h.2
    rw [s]
    exact mem_univ _
  · apply h.symm'.2
    rw [symm_source, t]
    exact mem_univ _
#align local_equiv.eq_of_eq_on_source_univ LocalEquiv.eq_of_eq_on_source_univ

section Prod

/-- The product of two local equivs, as a local equiv on the product. -/
def prod (e : LocalEquiv α β) (e' : LocalEquiv γ δ) : LocalEquiv (α × γ) (β × δ) where
  source := e.source ×ˢ e'.source
  target := e.target ×ˢ e'.target
  toFun p := (e p.1, e' p.2)
  invFun 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]
#align local_equiv.prod LocalEquiv.prod

@[simp, mfld_simps]
theorem prod_source (e : LocalEquiv α β) (e' : LocalEquiv γ δ) :
    (e.prod e').source = e.source ×ˢ e'.source :=
  rfl
#align local_equiv.prod_source LocalEquiv.prod_source

@[simp, mfld_simps]
theorem prod_target (e : LocalEquiv α β) (e' : LocalEquiv γ δ) :
    (e.prod e').target = e.target ×ˢ e'.target :=
  rfl
#align local_equiv.prod_target LocalEquiv.prod_target

@[simp, mfld_simps]
theorem prod_coe (e : LocalEquiv α β) (e' : LocalEquiv γ δ) :
    (e.prod e' : α × γ → β × δ) = fun p => (e p.1, e' p.2) :=
  rfl
#align local_equiv.prod_coe LocalEquiv.prod_coe

theorem prod_coe_symm (e : LocalEquiv α β) (e' : LocalEquiv γ δ) :
    ((e.prod e').symm : β × δ → α × γ) = fun p => (e.symm p.1, e'.symm p.2) :=
  rfl
#align local_equiv.prod_coe_symm LocalEquiv.prod_coe_symm

@[simp, mfld_simps]
theorem prod_symm (e : LocalEquiv α β) (e' : LocalEquiv γ δ) :
    (e.prod e').symm = e.symm.prod e'.symm := by
  ext x <;> simp [prod_coe_symm]
#align local_equiv.prod_symm LocalEquiv.prod_symm

@[simp, mfld_simps]
theorem refl_prod_refl :
    (LocalEquiv.refl α).prod (LocalEquiv.refl β) = LocalEquiv.refl (α × β) := by
  -- Porting note: `ext1 ⟨x, y⟩` insufficient number of binders
  ext ⟨x, y⟩ <;> simp
#align local_equiv.refl_prod_refl LocalEquiv.refl_prod_refl

@[simp, mfld_simps]
theorem prod_trans {η : Type _} {ε : Type _} (e : LocalEquiv α β) (f : LocalEquiv β γ)
    (e' : LocalEquiv δ η) (f' : LocalEquiv η ε) :
    (e.prod e').trans (f.prod f') = (e.trans f).prod (e'.trans f') := by
  ext ⟨x, y⟩ <;> simp [ext_iff]; tauto
#align local_equiv.prod_trans LocalEquiv.prod_trans

end Prod

/-- Combine two `LocalEquiv`s using `Set.piecewise`. The source of the new `LocalEquiv` 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.isImage s t` and
`e'.isImage s t`. -/
@[simps (config := { fullyApplied := false })]
def piecewise (e e' : LocalEquiv α β) (s : Set α) (t : Set β) [∀ x, Decidable (x ∈ s)]
    [∀ y, Decidable (y ∈ t)] (H : e.IsImage s t) (H' : e'.IsImage s t) :
    LocalEquiv α β where
  toFun := s.piecewise e e'
  invFun := t.piecewise e.symm e'.symm
  source := s.ite e.source e'.source
  target := t.ite e.target e'.target
  map_source' := H.mapsTo.piecewise_ite H'.compl.mapsTo
  map_target' := H.symm.mapsTo.piecewise_ite H'.symm.compl.mapsTo
  left_inv' := H.leftInvOn_piecewise H'
  right_inv' := H.symm.leftInvOn_piecewise H'.symm
#align local_equiv.piecewise LocalEquiv.piecewise
#align local_equiv.piecewise_source LocalEquiv.piecewise_source
#align local_equiv.piecewise_target LocalEquiv.piecewise_target
#align local_equiv.piecewise_symm_apply LocalEquiv.piecewise_symm_apply
#align local_equiv.piecewise_apply LocalEquiv.piecewise_apply

theorem symm_piecewise (e e' : LocalEquiv α β) {s : Set α} {t : Set β} [∀ x, Decidable (x ∈ s)]
    [∀ y, Decidable (y ∈ t)] (H : e.IsImage s t) (H' : e'.IsImage s t) :
    (e.piecewise e' s t H H').symm = e.symm.piecewise e'.symm t s H.symm H'.symm :=
  rfl
#align local_equiv.symm_piecewise LocalEquiv.symm_piecewise

/-- Combine two `LocalEquiv`s with disjoint sources and disjoint targets. We reuse
`LocalEquiv.piecewise`, then override `source` and `target` to ensure better definitional
equalities. -/
@[simps! (config := { fullyApplied := false })]
def disjointUnion (e e' : LocalEquiv α β) (hs : Disjoint e.source e'.source)
    (ht : Disjoint e.target e'.target) [∀ x, Decidable (x ∈ e.source)]
    [∀ y, Decidable (y ∈ e.target)] : LocalEquiv α β :=
  (e.piecewise e' e.source e.target e.isImage_source_target <|
        e'.isImage_source_target_of_disjoint _ hs.symm ht.symm).copy
    _ rfl _ rfl (e.source ∪ e'.source) (ite_left _ _) (e.target ∪ e'.target) (ite_left _ _)
#align local_equiv.disjoint_union LocalEquiv.disjointUnion
#align local_equiv.disjoint_union_source LocalEquiv.disjointUnion_source
#align local_equiv.disjoint_union_target LocalEquiv.disjointUnion_target
#align local_equiv.disjoint_union_symm_apply LocalEquiv.disjointUnion_symm_apply
#align local_equiv.disjoint_union_apply LocalEquiv.disjointUnion_apply

theorem disjointUnion_eq_piecewise (e e' : LocalEquiv α β) (hs : Disjoint e.source e'.source)
    (ht : Disjoint e.target e'.target) [∀ x, Decidable (x ∈ e.source)]
    [∀ y, Decidable (y ∈ e.target)] :
    e.disjointUnion e' hs ht =
      e.piecewise e' e.source e.target e.isImage_source_target
        (e'.isImage_source_target_of_disjoint _ hs.symm ht.symm) :=
  copy_eq ..
#align local_equiv.disjoint_union_eq_piecewise LocalEquiv.disjointUnion_eq_piecewise

section Pi

variable {ι : Type _} {αi βi : ι → Type _} (ei : ∀ i, LocalEquiv (αi i) (βi i))

/-- The product of a family of local equivs, as a local equiv on the pi type. -/
@[simps (config := mfld_cfg)]
protected def pi : LocalEquiv (∀ i, αi i) (∀ i, βi i) where
  toFun f i := ei i (f i)
  invFun f i := (ei i).symm (f i)
  source := pi univ fun i => (ei i).source
  target := pi univ fun i => (ei i).target
  map_source' _ hf i hi := (ei i).map_source (hf i hi)
  map_target' _ hf i hi := (ei i).map_target (hf i hi)
  left_inv' _ hf := funext fun i => (ei i).left_inv (hf i trivial)
  right_inv' _ hf := funext fun i => (ei i).right_inv (hf i trivial)
#align local_equiv.pi LocalEquiv.pi
#align local_equiv.pi_symm_apply LocalEquiv.pi_symm_apply
#align local_equiv.pi_source LocalEquiv.pi_source
#align local_equiv.pi_apply LocalEquiv.pi_apply
#align local_equiv.pi_target LocalEquiv.pi_target

end Pi

end LocalEquiv

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 (config := { fullyApplied := false })]
noncomputable def BijOn.toLocalEquiv [Nonempty α] (f : α → β) (s : Set α) (t : Set β)
    (hf : BijOn f s t) : LocalEquiv α β where
  toFun := f
  invFun := invFunOn f s
  source := s
  target := t
  map_source' := hf.mapsTo
  map_target' := hf.surjOn.mapsTo_invFunOn
  left_inv' := hf.invOn_invFunOn.1
  right_inv' := hf.invOn_invFunOn.2
#align set.bij_on.to_local_equiv Set.BijOn.toLocalEquiv
#align set.bij_on.to_local_equiv_target Set.BijOn.toLocalEquiv_target
#align set.bij_on.to_local_equiv_symm_apply Set.BijOn.toLocalEquiv_symm_apply
#align set.bij_on.to_local_equiv_apply Set.BijOn.toLocalEquiv_apply
#align set.bij_on.to_local_equiv_source Set.BijOn.toLocalEquiv_source

/-- A map injective on a subset of its domain provides a local equivalence. -/
@[simp, mfld_simps]
noncomputable def InjOn.toLocalEquiv [Nonempty α] (f : α → β) (s : Set α) (hf : InjOn f s) :
    LocalEquiv α β :=
  hf.bijOn_image.toLocalEquiv f s (f '' s)
#align set.inj_on.to_local_equiv Set.InjOn.toLocalEquiv

end Set

namespace Equiv

/- `Equiv`s give rise to `LocalEquiv`s. We set up simp lemmas to reduce most properties of the
`LocalEquiv` to that of the `Equiv`. -/
variable (e : α ≃ β) (e' : β ≃ γ)

@[simp, mfld_simps]
theorem refl_toLocalEquiv : (Equiv.refl α).toLocalEquiv = LocalEquiv.refl α :=
  rfl
#align equiv.refl_to_local_equiv Equiv.refl_toLocalEquiv

@[simp, mfld_simps]
theorem symm_toLocalEquiv : e.symm.toLocalEquiv = e.toLocalEquiv.symm :=
  rfl
#align equiv.symm_to_local_equiv Equiv.symm_toLocalEquiv

@[simp, mfld_simps]
theorem trans_toLocalEquiv : (e.trans e').toLocalEquiv = e.toLocalEquiv.trans e'.toLocalEquiv :=
  LocalEquiv.ext (fun x => rfl) (fun x => rfl)
    (by simp [LocalEquiv.trans_source, Equiv.toLocalEquiv])
#align equiv.trans_to_local_equiv Equiv.trans_toLocalEquiv

end Equiv


/-
Copyright (c) 2020 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau
-/

import field_theory.perfect_closure
import field_theory.separable
import ring_theory.adjoin.field
import ring_theory.localization.integral

/-!
# Algebraically Closed Field

In this file we define the typeclass for algebraically closed fields and algebraic closures,
and prove some of their properties.

## Main Definitions

- `is_alg_closed k` is the typeclass saying `k` is an algebraically closed field, i.e. every
polynomial in `k` splits.

- `is_alg_closure R K` is the typeclass saying `K` is an algebraic closure of `R`, where `R` is a
  commutative ring. This means that the map from `R` to `K` is injective, and `K` is
  algebraically closed and algebraic over `R`

- `is_alg_closed.lift` is a map from an algebraic extension `L` of `R`, into any algebraically
  closed extension of `R`.

- `is_alg_closure.equiv` is a proof that any two algebraic closures of the
  same field are isomorphic.

## Tags

algebraic closure, algebraically closed

-/
universes u v w

open_locale classical big_operators polynomial
open polynomial

variables (k : Type u) [field k]

/-- Typeclass for algebraically closed fields.

To show `polynomial.splits p f` for an arbitrary ring homomorphism `f`,
see `is_alg_closed.splits_codomain` and `is_alg_closed.splits_domain`.
-/
class is_alg_closed : Prop :=
(splits : ∀ p : k[X], p.splits $ ring_hom.id k)

/-- Every polynomial splits in the field extension `f : K →+* k` if `k` is algebraically closed.

See also `is_alg_closed.splits_domain` for the case where `K` is algebraically closed.
-/
theorem is_alg_closed.splits_codomain {k K : Type*} [field k] [is_alg_closed k] [field K]
  {f : K →+* k} (p : K[X]) : p.splits f :=
by { convert is_alg_closed.splits (p.map f), simp [splits_map_iff] }

/-- Every polynomial splits in the field extension `f : K →+* k` if `K` is algebraically closed.

See also `is_alg_closed.splits_codomain` for the case where `k` is algebraically closed.
-/
theorem is_alg_closed.splits_domain {k K : Type*} [field k] [is_alg_closed k] [field K]
  {f : k →+* K} (p : k[X]) : p.splits f :=
polynomial.splits_of_splits_id _ $ is_alg_closed.splits _

namespace is_alg_closed

variables {k}

theorem exists_root [is_alg_closed k] (p : k[X]) (hp : p.degree ≠ 0) : ∃ x, is_root p x :=
exists_root_of_splits _ (is_alg_closed.splits p) hp

lemma exists_pow_nat_eq [is_alg_closed k] (x : k) {n : ℕ} (hn : 0 < n) : ∃ z, z ^ n = x :=
begin
  rcases exists_root (X ^ n - C x) _ with ⟨z, hz⟩, swap,
  { rw degree_X_pow_sub_C hn x,
    exact ne_of_gt (with_bot.coe_lt_coe.2 hn) },
  use z,
  simp only [eval_C, eval_X, eval_pow, eval_sub, is_root.def] at hz,
  exact sub_eq_zero.1 hz
end

lemma exists_eq_mul_self [is_alg_closed k] (x : k) : ∃ z, x = z * z :=
begin
  rcases exists_pow_nat_eq x zero_lt_two with ⟨z, rfl⟩,
  exact ⟨z, sq z⟩
end

theorem exists_eval₂_eq_zero_of_injective {R : Type*} [ring R] [is_alg_closed k] (f : R →+* k)
  (hf : function.injective f) (p : R[X]) (hp : p.degree ≠ 0) : ∃ x, p.eval₂ f x = 0 :=
let ⟨x, hx⟩ := exists_root (p.map f) (by rwa [degree_map_eq_of_injective hf]) in
⟨x, by rwa [eval₂_eq_eval_map, ← is_root]⟩

theorem exists_eval₂_eq_zero {R : Type*} [field R] [is_alg_closed k] (f : R →+* k)
  (p : R[X]) (hp : p.degree ≠ 0) : ∃ x, p.eval₂ f x = 0 :=
exists_eval₂_eq_zero_of_injective f f.injective p hp

variables (k)

theorem exists_aeval_eq_zero_of_injective {R : Type*} [comm_ring R] [is_alg_closed k] [algebra R k]
  (hinj : function.injective (algebra_map R k)) (p : R[X]) (hp : p.degree ≠ 0) :
  ∃ x : k, aeval x p = 0 :=
exists_eval₂_eq_zero_of_injective (algebra_map R k) hinj p hp

theorem exists_aeval_eq_zero {R : Type*} [field R] [is_alg_closed k] [algebra R k]
  (p : R[X]) (hp : p.degree ≠ 0) : ∃ x : k, aeval x p = 0 :=
exists_eval₂_eq_zero (algebra_map R k) p hp

theorem of_exists_root (H : ∀ p : k[X], p.monic → irreducible p → ∃ x, p.eval x = 0) :
  is_alg_closed k :=
⟨λ p, or.inr $ λ q hq hqp,
 have irreducible (q * C (leading_coeff q)⁻¹),
   by { rw ← coe_norm_unit_of_ne_zero hq.ne_zero,
        exact (associated_normalize _).irreducible hq },
 let ⟨x, hx⟩ := H (q * C (leading_coeff q)⁻¹) (monic_mul_leading_coeff_inv hq.ne_zero) this in
 degree_mul_leading_coeff_inv q hq.ne_zero ▸ degree_eq_one_of_irreducible_of_root this hx⟩

lemma degree_eq_one_of_irreducible [is_alg_closed k] {p : k[X]}
  (hp : irreducible p) :
  p.degree = 1 :=
degree_eq_one_of_irreducible_of_splits hp (is_alg_closed.splits_codomain _)

lemma algebra_map_surjective_of_is_integral {k K : Type*} [field k] [ring K] [is_domain K]
  [hk : is_alg_closed k] [algebra k K] (hf : algebra.is_integral k K) :
  function.surjective (algebra_map k K) :=
begin
  refine λ x, ⟨-((minpoly k x).coeff 0), _⟩,
  have hq : (minpoly k x).leading_coeff = 1 := minpoly.monic (hf x),
  have h : (minpoly k x).degree = 1 := degree_eq_one_of_irreducible k
    (minpoly.irreducible (hf x)),
  have : (aeval x (minpoly k x)) = 0 := minpoly.aeval k x,
  rw [eq_X_add_C_of_degree_eq_one h, hq, C_1, one_mul,
    aeval_add, aeval_X, aeval_C, add_eq_zero_iff_eq_neg] at this,
  exact (ring_hom.map_neg (algebra_map k K) ((minpoly k x).coeff 0)).symm ▸ this.symm,
end

lemma algebra_map_surjective_of_is_integral'
  {k K : Type*} [field k] [comm_ring K] [is_domain K]
  [hk : is_alg_closed k] (f : k →+* K) (hf : f.is_integral) : function.surjective f :=
@algebra_map_surjective_of_is_integral k K _ _ _ _ f.to_algebra hf

lemma algebra_map_surjective_of_is_algebraic {k K : Type*} [field k] [ring K] [is_domain K]
  [hk : is_alg_closed k] [algebra k K] (hf : algebra.is_algebraic k K) :
  function.surjective (algebra_map k K) :=
algebra_map_surjective_of_is_integral (algebra.is_algebraic_iff_is_integral.mp hf)

end is_alg_closed

/-- Typeclass for an extension being an algebraic closure. -/
class is_alg_closure (R : Type u) (K : Type v) [comm_ring R]
  [field K] [algebra R K] [no_zero_smul_divisors R K] : Prop :=
(alg_closed : is_alg_closed K)
(algebraic : algebra.is_algebraic R K)

theorem is_alg_closure_iff (K : Type v) [field K] [algebra k K] :
  is_alg_closure k K ↔ is_alg_closed K ∧ algebra.is_algebraic k K :=
⟨λ h, ⟨h.1, h.2⟩, λ h, ⟨h.1, h.2⟩⟩

namespace lift

/- In this section, the homomorphism from any algebraic extension into an algebraically
  closed extension is proven to exist. The assumption that M is algebraically closed could probably
  easily be switched to an assumption that M contains all the roots of polynomials in K -/
variables {K : Type u} {L : Type v} {M : Type w} [field K] [field L] [algebra K L]
  [field M] [algebra K M] [is_alg_closed M] (hL : algebra.is_algebraic K L)

variables (K L M)
include hL
open subalgebra alg_hom function

/-- This structure is used to prove the existence of a homomorphism from any algebraic extension
into an algebraic closure -/
structure subfield_with_hom :=
(carrier : subalgebra K L)
(emb : carrier →ₐ[K] M)

variables {K L M hL}

namespace subfield_with_hom
variables {E₁ E₂ E₃ : subfield_with_hom K L M hL}

instance : has_le (subfield_with_hom K L M hL) :=
{ le := λ E₁ E₂, ∃ h : E₁.carrier ≤ E₂.carrier, ∀ x, E₂.emb (inclusion h x) = E₁.emb x }

noncomputable instance : inhabited (subfield_with_hom K L M hL) :=
⟨{ carrier := ⊥,
   emb := (algebra.of_id K M).comp (algebra.bot_equiv K L).to_alg_hom }⟩

lemma le_def : E₁ ≤ E₂ ↔ ∃ h : E₁.carrier ≤ E₂.carrier, ∀ x, E₂.emb (inclusion h x) = E₁.emb x :=
iff.rfl

lemma compat (h : E₁ ≤ E₂) : ∀ x, E₂.emb (inclusion h.fst x) = E₁.emb x :=
by { rw le_def at h, cases h, assumption }

instance : preorder (subfield_with_hom K L M hL) :=
{ le := (≤),
  le_refl := λ E, ⟨le_rfl, by simp⟩,
  le_trans := λ E₁ E₂ E₃ h₁₂ h₂₃,
    ⟨le_trans h₁₂.fst h₂₃.fst,
    λ _, by erw [← inclusion_inclusion h₁₂.fst h₂₃.fst, compat, compat]⟩ }

open lattice

lemma maximal_subfield_with_hom_chain_bounded (c : set (subfield_with_hom K L M hL))
  (hc : is_chain (≤) c) :
  ∃ ub : subfield_with_hom K L M hL, ∀ N, N ∈ c → N ≤ ub :=
if hcn : c.nonempty then
let ub : subfield_with_hom K L M hL :=
by haveI : nonempty c := set.nonempty.to_subtype hcn; exact
{ carrier := ⨆ i : c, (i : subfield_with_hom K L M hL).carrier,
  emb := subalgebra.supr_lift
    (λ i : c, (i : subfield_with_hom K L M hL).carrier)
    (λ i j, let ⟨k, hik, hjk⟩ := directed_on_iff_directed.1 hc.directed_on i j in
      ⟨k, hik.fst, hjk.fst⟩)
    (λ i, (i : subfield_with_hom K L M hL).emb)
    begin
      assume i j h,
      ext x,
      cases hc.total i.prop j.prop with hij hji,
      { simp [← hij.snd x] },
      { erw [alg_hom.comp_apply, ← hji.snd (inclusion h x),
          inclusion_inclusion, inclusion_self, alg_hom.id_apply x] }
    end _ rfl } in
⟨ub, λ N hN, ⟨(le_supr (λ i : c, (i : subfield_with_hom K L M hL).carrier) ⟨N, hN⟩ : _),
  begin
    intro x,
    simp [ub],
    refl
  end⟩⟩
else by { rw [set.not_nonempty_iff_eq_empty] at hcn, simp [hcn], }

variables (hL M)

lemma exists_maximal_subfield_with_hom : ∃ E : subfield_with_hom K L M hL,
  ∀ N, E ≤ N → N ≤ E :=
exists_maximal_of_chains_bounded
  maximal_subfield_with_hom_chain_bounded (λ _ _ _, le_trans)

/-- The maximal `subfield_with_hom`. We later prove that this is equal to `⊤`. -/
noncomputable def maximal_subfield_with_hom : subfield_with_hom K L M hL :=
classical.some (exists_maximal_subfield_with_hom M hL)

lemma maximal_subfield_with_hom_is_maximal :
  ∀ (N : subfield_with_hom K L M hL),
    (maximal_subfield_with_hom M hL) ≤ N → N ≤ (maximal_subfield_with_hom M hL) :=
classical.some_spec (exists_maximal_subfield_with_hom M hL)

lemma maximal_subfield_with_hom_eq_top :
  (maximal_subfield_with_hom M hL).carrier = ⊤ :=
begin
  rw [eq_top_iff],
  intros x _,
  let p := minpoly K x,
  let N : subalgebra K L := (maximal_subfield_with_hom M hL).carrier,
  letI : field N := (subalgebra.is_field_of_algebraic N hL).to_field,
  letI : algebra N M := (maximal_subfield_with_hom M hL).emb.to_ring_hom.to_algebra,
  cases is_alg_closed.exists_aeval_eq_zero M (minpoly N x)
    (ne_of_gt (minpoly.degree_pos
      (is_algebraic_iff_is_integral.1
        (algebra.is_algebraic_of_larger_base _ _ hL x)))) with y hy,
  let O : subalgebra N L := algebra.adjoin N {(x : L)},
  let larger_emb := ((adjoin_root.lift_hom (minpoly N x) y hy).comp
     (alg_equiv.adjoin_singleton_equiv_adjoin_root_minpoly N x).to_alg_hom),
  have hNO : N ≤ O.restrict_scalars K,
  { intros z hz,
    show algebra_map N L ⟨z, hz⟩ ∈ O,
    exact O.algebra_map_mem _ },
  let O' : subfield_with_hom K L M hL :=
  { carrier := O.restrict_scalars K,
    emb := larger_emb.restrict_scalars K },
  have hO' : maximal_subfield_with_hom M hL ≤ O',
  { refine ⟨hNO, _⟩,
    intros z,
    show O'.emb (algebra_map N O z) = algebra_map N M z,
    simp only [O', restrict_scalars_apply, alg_hom.commutes] },
  refine (maximal_subfield_with_hom_is_maximal M hL O' hO').fst _,
  exact algebra.subset_adjoin (set.mem_singleton x),
end

end subfield_with_hom
end lift

namespace is_alg_closed

variables {K : Type u} [field K] {L : Type v} {M : Type w} [field L] [algebra K L]
  [field M] [algebra K M] [is_alg_closed M] (hL : algebra.is_algebraic K L)

variables (K L M)
include hL

/-- Less general version of `lift`. -/
@[irreducible] private noncomputable def lift_aux : L →ₐ[K] M :=
(lift.subfield_with_hom.maximal_subfield_with_hom M hL).emb.comp $
  eq.rec_on (lift.subfield_with_hom.maximal_subfield_with_hom_eq_top M hL).symm algebra.to_top

omit hL

variables {R : Type u} [comm_ring R]
variables {S : Type v} [comm_ring S] [is_domain S] [algebra R S]
  [algebra R M] [no_zero_smul_divisors R S]
  [no_zero_smul_divisors R M]
  (hS : algebra.is_algebraic R S)
variables {M}

include hS

private lemma fraction_ring.is_algebraic :
  by letI : is_domain R := (no_zero_smul_divisors.algebra_map_injective R S).is_domain _; exact
  algebra.is_algebraic (fraction_ring R) (fraction_ring S) :=
begin
  introsI inst x,
  exact (is_fraction_ring.is_algebraic_iff R (fraction_ring R) (fraction_ring S)).1
    ((is_fraction_ring.is_algebraic_iff' R S (fraction_ring S)).1 hS x)
end

/-- A (random) homomorphism from an algebraic extension of R into an algebraically
  closed extension of R. -/
@[irreducible] noncomputable def lift : S →ₐ[R] M :=
begin
  letI : is_domain R := (no_zero_smul_divisors.algebra_map_injective R S).is_domain _,
  have hfRfS : algebra.is_algebraic (fraction_ring R) (fraction_ring S) :=
    fraction_ring.is_algebraic hS,
  let f : fraction_ring S →ₐ[fraction_ring R] M :=
    lift_aux (fraction_ring R) (fraction_ring S) M hfRfS,
  exact (f.restrict_scalars R).comp ((algebra.of_id S (fraction_ring S)).restrict_scalars R),
end

omit hS
@[priority 100]
noncomputable instance perfect_ring (p : ℕ) [fact p.prime] [char_p k p]
  [is_alg_closed k] : perfect_ring k p :=
perfect_ring.of_surjective k p $ λ x, is_alg_closed.exists_pow_nat_eq _ $ ne_zero.pos p

/-- Algebraically closed fields are infinite since `Xⁿ⁺¹ - 1` is separable when `#K = n` -/
@[priority 500]
instance {K : Type*} [field K] [is_alg_closed K] : infinite K :=
begin
  apply infinite.of_not_fintype,
  introsI hfin,
  set n := fintype.card K with hn,
  set f := (X : K[X]) ^ (n + 1) - 1 with hf,
  have hfsep : separable f := separable_X_pow_sub_C 1 (by simp) one_ne_zero,
  apply nat.not_succ_le_self (fintype.card K),
  have hroot : n.succ = fintype.card (f.root_set K),
  { erw [card_root_set_eq_nat_degree hfsep (is_alg_closed.splits_domain _),
         nat_degree_X_pow_sub_C] },
  rw hroot,
  exact fintype.card_le_of_injective coe subtype.coe_injective,
end

end is_alg_closed

namespace is_alg_closure

variables (K : Type*) (J : Type*) (R : Type u) (S : Type*) [field K] [field J] [comm_ring R]
  (L : Type v) (M : Type w) [field L] [field M] [algebra R M] [no_zero_smul_divisors R M]
  [is_alg_closure R M] [algebra K M] [is_alg_closure K M]
  [comm_ring S] [algebra S L] [no_zero_smul_divisors S L] [is_alg_closure S L]

local attribute [instance] is_alg_closure.alg_closed

section
variables [algebra R L] [no_zero_smul_divisors R L] [is_alg_closure R L]

/-- A (random) isomorphism between two algebraic closures of `R`. -/
noncomputable def equiv : L ≃ₐ[R] M :=
let f : L →ₐ[R] M := is_alg_closed.lift is_alg_closure.algebraic in
alg_equiv.of_bijective f
  ⟨ring_hom.injective f.to_ring_hom,
    begin
      letI : algebra L M := ring_hom.to_algebra f,
      letI : is_scalar_tower R L M :=
        is_scalar_tower.of_algebra_map_eq (by simp [ring_hom.algebra_map_to_algebra]),
      show function.surjective (algebra_map L M),
      exact is_alg_closed.algebra_map_surjective_of_is_algebraic
        (algebra.is_algebraic_of_larger_base_of_injective
          (no_zero_smul_divisors.algebra_map_injective R _) is_alg_closure.algebraic),
    end⟩

end

section equiv_of_algebraic

variables [algebra R S] [algebra R L] [is_scalar_tower R S L]
variables [algebra K J] [algebra J L] [is_alg_closure J L] [algebra K L]
  [is_scalar_tower K J L]

/-- A (random) isomorphism between an algebraic closure of `R` and an algebraic closure of
  an algebraic extension of `R` -/
noncomputable def equiv_of_algebraic' [nontrivial S] [no_zero_smul_divisors R S]
  (hRL : algebra.is_algebraic R L) : L ≃ₐ[R] M :=
begin
  letI : no_zero_smul_divisors R L :=
    no_zero_smul_divisors.of_algebra_map_injective begin
      rw [is_scalar_tower.algebra_map_eq R S L],
      exact function.injective.comp
        (no_zero_smul_divisors.algebra_map_injective _ _)
        (no_zero_smul_divisors.algebra_map_injective _ _)
    end,
  letI : is_alg_closure R L :=
  { alg_closed := by apply_instance,
    algebraic := hRL },
  exact is_alg_closure.equiv _ _ _
end

/-- A (random) isomorphism between an algebraic closure of `K` and an algebraic closure
  of an algebraic extension of `K` -/
noncomputable def equiv_of_algebraic (hKJ : algebra.is_algebraic K J) : L ≃ₐ[K] M :=
equiv_of_algebraic' K J _ _ (algebra.is_algebraic_trans hKJ is_alg_closure.algebraic)

end equiv_of_algebraic

section equiv_of_equiv

variables {R S}

/-- Used in the definition of `equiv_of_equiv` -/
noncomputable def equiv_of_equiv_aux (hSR : S ≃+* R) :
  { e : L ≃+* M // e.to_ring_hom.comp (algebra_map S L) =
    (algebra_map R M).comp hSR.to_ring_hom }:=
begin
  letI : algebra R S := ring_hom.to_algebra hSR.symm.to_ring_hom,
  letI : algebra S R := ring_hom.to_algebra hSR.to_ring_hom,
  letI : is_domain R := (no_zero_smul_divisors.algebra_map_injective R M).is_domain _,
  letI : is_domain S := (no_zero_smul_divisors.algebra_map_injective S L).is_domain _,
  have : algebra.is_algebraic R S,
    from λ x, begin
      rw [← ring_equiv.symm_apply_apply hSR x],
      exact is_algebraic_algebra_map _
    end,
  letI : algebra R L := ring_hom.to_algebra ((algebra_map S L).comp (algebra_map R S)),
  haveI : is_scalar_tower R S L := is_scalar_tower.of_algebra_map_eq (λ _, rfl),
  haveI : is_scalar_tower S R L := is_scalar_tower.of_algebra_map_eq
    (by simp [ring_hom.algebra_map_to_algebra]),
  haveI : no_zero_smul_divisors R S :=
    no_zero_smul_divisors.of_algebra_map_injective hSR.symm.injective,
  refine ⟨equiv_of_algebraic' R S L M (algebra.is_algebraic_of_larger_base_of_injective
      (show function.injective (algebra_map S R), from hSR.injective)
      is_alg_closure.algebraic) , _⟩,
  ext,
  simp only [ring_equiv.to_ring_hom_eq_coe, function.comp_app, ring_hom.coe_comp,
    alg_equiv.coe_ring_equiv, ring_equiv.coe_to_ring_hom],
  conv_lhs { rw [← hSR.symm_apply_apply x] },
  show equiv_of_algebraic' R S L M _ (algebra_map R L (hSR x)) = _,
  rw [alg_equiv.commutes]
end

/-- Algebraic closure of isomorphic fields are isomorphic -/
noncomputable def equiv_of_equiv (hSR : S ≃+* R) : L ≃+* M :=
equiv_of_equiv_aux L M hSR

@[simp] lemma equiv_of_equiv_comp_algebra_map (hSR : S ≃+* R) :
  (↑(equiv_of_equiv L M hSR) : L →+* M).comp (algebra_map S L) =
  (algebra_map R M).comp hSR :=
(equiv_of_equiv_aux L M hSR).2

@[simp] lemma equiv_of_equiv_algebra_map (hSR : S ≃+* R) (s : S):
  equiv_of_equiv L M hSR (algebra_map S L s) =
  algebra_map R M (hSR s) :=
ring_hom.ext_iff.1 (equiv_of_equiv_comp_algebra_map L M hSR) s

@[simp] lemma equiv_of_equiv_symm_algebra_map (hSR : S ≃+* R) (r : R):
  (equiv_of_equiv L M hSR).symm (algebra_map R M r) =
  algebra_map S L (hSR.symm r) :=
(equiv_of_equiv L M hSR).injective (by simp)

@[simp] lemma equiv_of_equiv_symm_comp_algebra_map (hSR : S ≃+* R) :
  ((equiv_of_equiv L M hSR).symm : M →+* L).comp (algebra_map R M) =
  (algebra_map S L).comp hSR.symm :=
ring_hom.ext_iff.2 (equiv_of_equiv_symm_algebra_map L M hSR)

end equiv_of_equiv

end is_alg_closure

/-- Let `A` be an algebraically closed field and let `x ∈ K`, with `K/F` an algebraic extension
  of fields. Then the images of `x` by the `F`-algebra morphisms from `K` to `A` are exactly
  the roots in `A` of the minimal polynomial of `x` over `F`. -/
lemma algebra.is_algebraic.range_eval_eq_root_set_minpoly {F K} (A) [field F] [field K] [field A]
  [is_alg_closed A] [algebra F K] (hK : algebra.is_algebraic F K) [algebra F A] (x : K) :
  set.range (λ ψ : K →ₐ[F] A, ψ x) = (minpoly F x).root_set A :=
begin
  have := algebra.is_algebraic_iff_is_integral.1 hK,
  ext a, rw [mem_root_set_of_ne (minpoly.ne_zero (this x))]; [skip, apply_instance],
  refine ⟨_, λ ha, _⟩,
  { rintro ⟨ψ, rfl⟩, rw [aeval_alg_hom_apply ψ x, minpoly.aeval, map_zero] },
  let Fx := adjoin_root (minpoly F x),
  have hx : aeval x (minpoly F x) = 0 := minpoly.aeval F x,
  letI : algebra Fx A := (adjoin_root.lift (algebra_map F A) a ha).to_algebra,
  letI : algebra Fx K := (adjoin_root.lift (algebra_map F K) x hx).to_algebra,
  haveI : is_scalar_tower F Fx A := is_scalar_tower.of_ring_hom (adjoin_root.lift_hom _ a ha),
  haveI : is_scalar_tower F Fx K := is_scalar_tower.of_ring_hom (adjoin_root.lift_hom _ x hx),
  haveI : fact (irreducible $ minpoly F x) := ⟨minpoly.irreducible $ this x⟩,
  let ψ₀ : K →ₐ[Fx] A := is_alg_closed.lift (algebra.is_algebraic_of_larger_base F Fx hK),
  exact ⟨ψ₀.restrict_scalars F, (congr_arg ψ₀ (adjoin_root.lift_root hx).symm).trans $
    (ψ₀.commutes _).trans $ adjoin_root.lift_root ha⟩,
end


example : forall (n m : nat), n < m \/ n = m \/ n > m := nat.lt_trichotomy


import Mathlib.Data.Nat.Basic
import Mathlib.Data.Option.Basic
import Hata.Conventions

--
-- This file describes the filtering type system and syntax,
-- as originally invented by @undefdev and @MxmUrw on 2023-02-10.
--
--
-- # Type system
--
-- We concern ourselves with *table types*, denoted by `T I A` where `I` is a _finite_ index type,
-- and `A` is (any) content type. The tables have named dimensions and named indices. This is done
-- by having the names included in the index types.
--
-- The index types are as follows:

inductive Name where
  | mkName : String -> Name

open Name
instance : Coe String Name := ⟨ mkName ⟩

inductive IndexType : 𝒰 0 where
  | Idx : Name -> ℕ -> IndexType
  | Prod : List IndexType -> IndexType
  | Sum : List IndexType -> IndexType

open IndexType

--
-- For example, the index type for the m×n table, with indices called "row" and "col" would be:
example (m n : ℕ) : IndexType := Prod [Idx "row" m, Idx "col" n]
--
-- We can add another, single "err" row by writing:
example (m n : ℕ) : IndexType := Prod [(Sum [Idx "row" m, Idx "err" 1]), Idx "col" n]
--

--
-- The types of our type system are constructed from index types; we have a special filter function type.
--

inductive FTType : 𝒰 0 where
  | Filter : IndexType -> IndexType -> Option FTType -> FTType
  | Fun : FTType -> FTType -> FTType


import Hopf
import ring_theory.tensor_product
import tactic

open_locale tensor_product
open_locale polynomial
open algebra.tensor_product
open polynomial

-- TODO variables {K : Type*} [comm_ring K]
-- notation `K` := ℚ
variables (K : Type*) [comm_ring K]

-- set_option profiler true -- time everything

-- noncomputable def comm_ring.comul : K[X] →ₐ[K] K[X] ⊗[K] K[X] := aeval ((X ⊗ₜ 1) + (1 ⊗ₜ X))
noncomputable def comul : K[X] →ₐ[K] K[X] ⊗[K] K[X] := aeval ((X ⊗ₜ 1) + (1 ⊗ₜ X))

@[simp] lemma comul_1 : comul K (1 : K[X]) = (1 ⊗ₜ 1 : K[X] ⊗[K] K[X]) :=
begin
  rw alg_hom.map_one, -- ⊢ 1 = 1 ⊗ₜ[K] 1
  refl,
end

@[simp] lemma comul_X : comul K X = X ⊗ₜ 1 + 1 ⊗ₜ X :=
begin
  unfold comul,
  rw aeval_X,
end

-- TODO make this a linear equality to make it faster?
-- TODO convert to dot notation
lemma coassoc :  (algebra.tensor_product.assoc K K[X] K[X] K[X]).to_alg_hom.comp ((map (comul K) (alg_hom.id K K[X])).comp (comul K)) = (map (alg_hom.id K K[X]) (comul K)).comp (comul K) :=
begin
  ext,
  simp only [alg_hom.coe_comp, alg_hom.coe_comp, alg_hom.coe_comp,
      function.comp_app, function.comp_app, function.comp_app,
      comul_X K,
      alg_hom.map_add, alg_hom.map_add, alg_hom.map_add,
      map_tmul, map_tmul, map_tmul, map_tmul,
      comul_X K, comul_1 K,
      alg_hom.coe_id, id.def, id.def,
      tensor_product.tmul_add, tensor_product.add_tmul,
      alg_hom.map_add,
      alg_equiv.to_alg_hom_eq_coe, alg_equiv.coe_alg_hom,
      algebra.tensor_product.assoc_tmul, algebra.tensor_product.assoc_tmul, algebra.tensor_product.assoc_tmul],
  refl,
end

noncomputable def counit : K[X] →ₐ[K] K := aeval 0

@[simp] lemma counit_X : counit K X = 0 :=
begin
  unfold counit,
  rw [coe_aeval_eq_eval, eval_X],
end

@[simp] lemma counit_1 : counit K 1 = 1 :=
begin
  rw alg_hom.map_one,
end

.
-- TODO why do we get .coeff n after ext?
lemma counit_left : (algebra.tensor_product.lid K K[X]).to_alg_hom.comp ((map (counit K) (alg_hom.id K K[X])).comp (comul K)) = (alg_hom.id K K[X]) :=
begin
  ext,
  rw [alg_hom.coe_comp, alg_hom.coe_comp,
      function.comp_app, function.comp_app,
      comul_X K,
      alg_hom.map_add,
      map_tmul, map_tmul,
      counit_X K, counit_1 K,
      alg_hom.coe_id, id.def, id.def,
      alg_hom.map_add,
      alg_equiv.to_alg_hom_eq_coe, alg_equiv.coe_alg_hom,
      lid_tmul, lid_tmul,
      one_smul, zero_smul, zero_add],
end

lemma counit_right : (algebra.tensor_product.rid K K[X]).to_alg_hom.comp ((map (alg_hom.id K K[X]) (counit K)).comp (comul K)) = (alg_hom.id K K[X]) :=
begin
  ext,
  rw [alg_hom.coe_comp, alg_hom.coe_comp,
      function.comp_app, function.comp_app,
      comul_X K,
      alg_hom.map_add,
      map_tmul, map_tmul,
      counit_X K, counit_1 K,
      alg_hom.coe_id, id.def, id.def,
      alg_hom.map_add,
      alg_equiv.to_alg_hom_eq_coe, alg_equiv.coe_alg_hom,
      rid_tmul, rid_tmul,
      one_smul, zero_smul, add_zero],
end

noncomputable def coinv : K[X] →ₐ[K] K[X] := aeval (-X)

@[simp] lemma coinv_X : coinv K X = -X :=
begin
  unfold coinv,
  rw aeval_X,
end

@[simp] lemma coinv_1 : coinv K 1 = 1 :=
begin
  rw alg_hom.map_one,
end

lemma coinv_right : (lmul' K).comp ((map (alg_hom.id K K[X]) (coinv K)).comp (comul K)) = (algebra.of_id K K[X]).comp (counit K) :=
begin
  ext,
  rw [alg_hom.coe_comp, alg_hom.coe_comp, alg_hom.coe_comp,
      function.comp_app, function.comp_app, function.comp_app,
      comul_X K,
      alg_hom.map_add,
      map_tmul, map_tmul,
      counit_X K, coinv_X K, coinv_1 K,
      alg_hom.coe_id, id.def, id.def,
      alg_hom.map_add,
      lmul'_apply_tmul, lmul'_apply_tmul,
      _root_.mul_one, _root_.one_mul, add_right_neg, _root_.map_zero],
end

lemma coinv_left : (lmul' K).comp ((map (coinv K) (alg_hom.id K K[X])).comp (comul K) )= (algebra.of_id K K[X]).comp (counit K) :=
begin
  ext,
  rw [alg_hom.coe_comp, alg_hom.coe_comp, alg_hom.coe_comp,
      function.comp_app, function.comp_app, function.comp_app,
      comul_X K,
      alg_hom.map_add,
      map_tmul, map_tmul,
      counit_X K, coinv_X K, coinv_1 K,
      alg_hom.coe_id, id.def, id.def,
      alg_hom.map_add,
      lmul'_apply_tmul, lmul'_apply_tmul,
      _root_.mul_one, _root_.one_mul, add_left_neg, _root_.map_zero],
end
.

set_option profiler true -- time everything

#check hopf_algebra.mk

-- TODO figure out how to make an instance of a structure as opposed to a class
noncomputable instance polynomial_hopf : hopf_algebra K K[X] := {
  comul := comul K,
  counit := counit K,
  coinv := coinv K,
  coassoc := begin -- prevents timeout!
    have := coassoc K,
    exact this,
  end,
  counit_left := counit_left K,
  counit_right := counit_right K,
  coinv_right := coinv_right K,
  coinv_left := coinv_left K,
}


/-
Copyright (c) 2021 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import geometry.manifold.diffeomorph
import geometry.manifold.instances.real
import geometry.manifold.partition_of_unity

/-!
# Whitney embedding theorem

In this file we prove a version of the Whitney embedding theorem: for any compact real manifold `M`,
for sufficiently large `n` there exists a smooth embedding `M → ℝ^n`.

## TODO

* Prove the weak Whitney embedding theorem: any `σ`-compact smooth `m`-dimensional manifold can be
  embedded into `ℝ^(2m+1)`. This requires a version of Sard's theorem: for a locally Lipschitz
  continuous map `f : ℝ^m → ℝ^n`, `m < n`, the range has Hausdorff dimension at most `m`, hence it
  has measure zero.

## Tags

partition of unity, smooth bump function, whitney theorem
-/

universes uι uE uH uM
variables {ι : Type uι}
{E : Type uE} [normed_group E] [normed_space ℝ E] [finite_dimensional ℝ E]
{H : Type uH} [topological_space H] {I : model_with_corners ℝ E H}
{M : Type uM} [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M]

open function filter finite_dimensional set
open_locale topological_space manifold classical filter big_operators

noncomputable theory

namespace smooth_bump_covering

/-!
### Whitney embedding theorem

In this section we prove a version of the Whitney embedding theorem: for any compact real manifold
`M`, for sufficiently large `n` there exists a smooth embedding `M → ℝ^n`.
-/

variables [t2_space M] [fintype ι] {s : set M} (f : smooth_bump_covering ι I M s)

/-- Smooth embedding of `M` into `(E × ℝ) ^ ι`. -/
def embedding_pi_tangent : C^∞⟮I, M; 𝓘(ℝ, ι → (E × ℝ)), ι → (E × ℝ)⟯ :=
{ to_fun := λ x i, (f i x • ext_chart_at I (f.c i) x, f i x),
  cont_mdiff_to_fun := cont_mdiff_pi_space.2 $ λ i,
    ((f i).smooth_smul cont_mdiff_on_ext_chart_at).prod_mk_space ((f i).smooth) }

local attribute [simp] lemma embedding_pi_tangent_coe :
  ⇑f.embedding_pi_tangent = λ x i, (f i x • ext_chart_at I (f.c i) x, f i x) :=
rfl

lemma embedding_pi_tangent_inj_on : inj_on f.embedding_pi_tangent s :=
begin
  intros x hx y hy h,
  simp only [embedding_pi_tangent_coe, funext_iff] at h,
  obtain ⟨h₁, h₂⟩ := prod.mk.inj_iff.1 (h (f.ind x hx)),
  rw [f.apply_ind x hx] at h₂,
  rw [← h₂, f.apply_ind x hx, one_smul, one_smul] at h₁,
  have := f.mem_ext_chart_at_source_of_eq_one h₂.symm,
  exact (ext_chart_at I (f.c _)).inj_on (f.mem_ext_chart_at_ind_source x hx) this h₁
end

lemma embedding_pi_tangent_injective (f : smooth_bump_covering ι I M) :
  injective f.embedding_pi_tangent :=
injective_iff_inj_on_univ.2 f.embedding_pi_tangent_inj_on

lemma comp_embedding_pi_tangent_mfderiv (x : M) (hx : x ∈ s) :
  ((continuous_linear_map.fst ℝ E ℝ).comp
    (@continuous_linear_map.proj ℝ _ ι (λ _, E × ℝ) _ _
      (λ _, infer_instance) (f.ind x hx))).comp
      (mfderiv I 𝓘(ℝ, ι → (E × ℝ)) f.embedding_pi_tangent x) =
  mfderiv I I (chart_at H (f.c (f.ind x hx))) x :=
begin
  set L := ((continuous_linear_map.fst ℝ E ℝ).comp
    (@continuous_linear_map.proj ℝ _ ι (λ _, E × ℝ) _ _ (λ _, infer_instance) (f.ind x hx))),
  have := L.has_mfderiv_at.comp x f.embedding_pi_tangent.mdifferentiable_at.has_mfderiv_at,
  convert has_mfderiv_at_unique this _,
  refine (has_mfderiv_at_ext_chart_at I (f.mem_chart_at_ind_source x hx)).congr_of_eventually_eq _,
  refine (f.eventually_eq_one x hx).mono (λ y hy, _),
  simp only [embedding_pi_tangent_coe, continuous_linear_map.coe_comp', (∘),
    continuous_linear_map.coe_fst', continuous_linear_map.proj_apply],
  rw [hy, pi.one_apply, one_smul]
end

lemma embedding_pi_tangent_ker_mfderiv (x : M) (hx : x ∈ s) :
  (mfderiv I 𝓘(ℝ, ι → (E × ℝ)) f.embedding_pi_tangent x).ker = ⊥ :=
begin
  apply bot_unique,
  rw [← (mdifferentiable_chart I (f.c (f.ind x hx))).ker_mfderiv_eq_bot
    (f.mem_chart_at_ind_source x hx), ← comp_embedding_pi_tangent_mfderiv],
  exact linear_map.ker_le_ker_comp _ _
end

lemma embedding_pi_tangent_injective_mfderiv (x : M) (hx : x ∈ s) :
  injective (mfderiv I 𝓘(ℝ, ι → (E × ℝ)) f.embedding_pi_tangent x) :=
linear_map.ker_eq_bot.1 (f.embedding_pi_tangent_ker_mfderiv x hx)

/-- Baby version of the Whitney weak embedding theorem: if `M` admits a finite covering by
supports of bump functions, then for some `n` it can be immersed into the `n`-dimensional
Euclidean space. -/
lemma exists_immersion_euclidean (f : smooth_bump_covering ι I M) :
  ∃ (n : ℕ) (e : M → euclidean_space ℝ (fin n)), smooth I (𝓡 n) e ∧
    injective e ∧ ∀ x : M, injective (mfderiv I (𝓡 n) e x) :=
begin
  set F := euclidean_space ℝ (fin $ finrank ℝ (ι → (E × ℝ))),
  letI : is_noetherian ℝ (E × ℝ) := is_noetherian.iff_fg.2 infer_instance,
  letI : finite_dimensional ℝ (ι → E × ℝ) := is_noetherian.iff_fg.1 infer_instance,
  set eEF : (ι → (E × ℝ)) ≃L[ℝ] F :=
    continuous_linear_equiv.of_finrank_eq finrank_euclidean_space_fin.symm,
  refine ⟨_, eEF ∘ f.embedding_pi_tangent,
    eEF.to_diffeomorph.smooth.comp f.embedding_pi_tangent.smooth,
    eEF.injective.comp f.embedding_pi_tangent_injective, λ x, _⟩,
  rw [mfderiv_comp _ eEF.differentiable_at.mdifferentiable_at
    f.embedding_pi_tangent.mdifferentiable_at, eEF.mfderiv_eq],
  exact eEF.injective.comp (f.embedding_pi_tangent_injective_mfderiv _ trivial)
end

end smooth_bump_covering

/-- Baby version of the Whitney weak embedding theorem: if `M` admits a finite covering by
supports of bump functions, then for some `n` it can be embedded into the `n`-dimensional
Euclidean space. -/
lemma exists_embedding_euclidean_of_compact [t2_space M] [compact_space M] :
  ∃ (n : ℕ) (e : M → euclidean_space ℝ (fin n)), smooth I (𝓡 n) e ∧
    closed_embedding e ∧ ∀ x : M, injective (mfderiv I (𝓡 n) e x) :=
begin
  rcases smooth_bump_covering.exists_is_subordinate I is_closed_univ (λ (x : M) _, univ_mem)
    with ⟨ι, f, -⟩,
  haveI := f.fintype,
  rcases f.exists_immersion_euclidean with ⟨n, e, hsmooth, hinj, hinj_mfderiv⟩,
  exact ⟨n, e, hsmooth, hsmooth.continuous.closed_embedding hinj, hinj_mfderiv⟩
end


import deduction.deduction_cartesian data.set.basic
open deduction_basic

namespace PPC_defn

    inductive PPC_Form : Type
    | top : PPC_Form
    | var : ℕ → PPC_Form
    | and : PPC_Form → PPC_Form → PPC_Form
    | impl : PPC_Form → PPC_Form → PPC_Form

    @[reducible] def PPC_Hyp : Type := set (PPC_Form)

    instance : has_union PPC_Hyp := infer_instance
    instance : has_mem PPC_Form PPC_Hyp := infer_instance
    instance : has_insert PPC_Form PPC_Hyp := infer_instance
    instance : has_emptyc PPC_Hyp := infer_instance

    inductive PPC_derives : PPC_Hyp → PPC_Form → Prop
    | hyp {Φ : PPC_Hyp} {φ : PPC_Form}
        : (φ ∈ Φ) →  PPC_derives Φ φ
    | truth {Φ}
        : PPC_derives Φ PPC_Form.top
    | and_intro {Φ} {φ ψ : PPC_Form}
        : PPC_derives Φ φ → PPC_derives Φ ψ → PPC_derives Φ (PPC_Form.and φ ψ)
    | and_eliml {Φ} {φ ψ : PPC_Form}
        : PPC_derives Φ (PPC_Form.and φ ψ) → PPC_derives Φ φ
    | and_elimr {Φ} {φ ψ : PPC_Form}
        : PPC_derives Φ (PPC_Form.and φ ψ) → PPC_derives Φ ψ
    | impl_intro {Φ : PPC_Hyp} (φ : PPC_Form) {ψ : PPC_Form}
        : PPC_derives (insert φ Φ) ψ → PPC_derives Φ (PPC_Form.impl φ ψ)
    | impl_elim {Φ : PPC_Hyp} (φ : PPC_Form) {ψ : PPC_Form}
        : PPC_derives Φ (PPC_Form.impl φ ψ) → PPC_derives Φ φ → PPC_derives Φ ψ
    | weak {Φ Ψ : PPC_Hyp} {φ : PPC_Form}
        : PPC_derives Φ φ → PPC_derives (Φ ∪ Ψ) φ
    open PPC_derives

end PPC_defn

namespace PPC_has_derives

    open PPC_defn
    open PPC_defn.PPC_derives
    open deduction_basic
    open deduction_cart

    instance PPC_hasHyp : has_Hyp PPC_Form :=
      { Hyp := PPC_Hyp }

    instance PPC_singleton : has_singleton PPC_Form PPC_Hyp :=
      deduction_basic.singleHyp
    @[simp]
    lemma same_singles : ∀ φ : PPC_Form,
        PPC_has_derives.PPC_singleton.singleton φ = set.has_singleton.singleton φ :=
    begin
      assume φ,
      dsimp[PPC_has_derives.PPC_singleton,deduction_basic.singleHyp],
      rw set.is_lawful_singleton.insert_emptyc_eq,
    end

    lemma single_union {Φ : PPC_Hyp} {φ : PPC_Form}
        : insert φ Φ = {φ} ∪ Φ := by simp

    instance PPC_Der : has_struct_derives PPC_Form :=
    {
      derives := PPC_derives,
      derive_Trans :=
        begin
          assume Φ ψ θ hφψ hψθ,
          have helper : PPC_derives Φ (PPC_Form.impl ψ θ),
            apply impl_intro,
            rw single_union,
            apply weak,
            exact hψθ,
          apply impl_elim ψ,
          exact helper,
          exact hφψ,
        end,
      inInsert := set.mem_insert,
      hyp := @hyp,
      weak1 :=
        begin
          assume Φ φ ψ h,
          rw single_union,
          rw set.union_comm,
          apply weak,
          exact h,
        end,
    }

    instance PPC_top : deduction_cart.has_ltop PPC_Form :=
    {
      top := PPC_Form.top,
      truth := @truth,
    }
    instance PPC_and : deduction_cart.has_and PPC_Form :=
    {
      and := PPC_Form.and,
      and_intro := @and_intro,
      and_eliml := @and_eliml,
      and_elimr := @and_elimr,

    }
    instance PPC_impl : deduction_cart.has_impl PPC_Form :=
    {
      impl := PPC_Form.impl,
      impl_intro := @impl_intro,
      impl_elim := @impl_elim,
    }

end PPC_has_derives


import data.finset
import data.nat.choose
import tactic.squeeze

open nat
open finset

-- We apply the add_pow theorem, which is actually the binomial expansion under a pseudonym
theorem binomial_expansion_for_2 (n : ℕ) :
finset.sum (finset.range (n+1)) (λ (m : ℕ), choose n m) = 2^n :=
begin
    have h := add_pow 1 1 n,
    simp only [nat.one_pow, mul_one, one_mul, nat.cast_id, nat.pow_eq_pow] at h,
    simp only [h, eq_self_iff_true],
end