/-
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 topology.local_homeomorph
import topology.algebra.ordered

/-!
# Fiber bundles

A topological fiber bundle with fiber `F` over a base `B` is a space projecting on `B` for which the
fibers are all homeomorphic to `F`, such that the local situation around each point is a direct
product. We define a predicate `is_topological_fiber_bundle F p` saying that `p : Z → B` is a
topological fiber bundle with fiber `F`.

It is in general nontrivial to construct a fiber bundle. A way is to start from the knowledge of
how changes of local trivializations act on the fiber. From this, one can construct the total space
of the bundle and its topology by a suitable gluing construction. The main content of this file is
an implementation of this construction: starting from an object of type
`topological_fiber_bundle_core` registering the trivialization changes, one gets the corresponding
fiber bundle and projection.

## Main definitions

### Basic definitions

* `bundle_trivialization F p` : structure extending local homeomorphisms, defining a local
                  trivialization of a topological space `Z` with projection `p` and fiber `F`.

* `is_topological_fiber_bundle F p` : Prop saying that the map `p` between topological spaces is a
                  fiber bundle with fiber `F`.

* `is_trivial_topological_fiber_bundle F p` : Prop saying that the map `p : Z → B` between
  topological spaces is a trivial topological fiber bundle, i.e., there exists a homeomorphism
  `h : Z ≃ₜ B × F` such that `proj x = (h x).1`.

### Operations on bundles

We provide the following operations on `bundle_trivialization`s.

* `bundle_trivialization.comap`: given a local trivialization `e` of a fiber bundle `p : Z → B`, a
  continuous map `f : B' → B` and a point `b' : B'` such that `f b' ∈ e.base_set`,
  `e.comap f hf b' hb'` is a trivialization of the pullback bundle. The pullback bundle
  (a.k.a., the induced bundle) has total space `{(x, y) : B' × Z | f x = p y}`, and is given by
  `λ ⟨(x, y), h⟩, x`.

* `is_topological_fiber_bundle.comap`: if `p : Z → B` is a topological fiber bundle, then its
  pullback along a continuous map `f : B' → B` is a topological fiber bundle as well.

* `bundle_trivialization.comp_homeomorph`: given a local trivialization `e` of a fiber bundle
  `p : Z → B` and a homeomorphism `h : Z' ≃ₜ Z`, returns a local trivialization of the fiber bundle
  `p ∘ h`.

* `is_topological_fiber_bundle.comp_homeomorph`: if `p : Z → B` is a topological fiber bundle
  and `h : Z' ≃ₜ Z` is a homeomorphism, then `p ∘ h : Z' → B` is a topological fiber bundle with
  the same fiber.

### Construction of a bundle from trivializations

* `bundle.total_space E` is a type synonym for `Σ (x : B), E x`, that we can endow with a suitable
  topology.
* `topological_fiber_bundle_core ι B F` : structure registering how changes of coordinates act
  on the fiber `F` above open subsets of `B`, where local trivializations are indexed by `ι`.

Let `Z : topological_fiber_bundle_core ι B F`. Then we define

* `Z.fiber x`     : the fiber above `x`, homeomorphic to `F` (and defeq to `F` as a type).
* `Z.total_space` : the total space of `Z`, defined as a `Type` as `Σ (b : B), F`, but with a
  twisted topology coming from the fiber bundle structure. It is (reducibly) the same as
  `bundle.total_space Z.fiber`.
* `Z.proj`        : projection from `Z.total_space` to `B`. It is continuous.
* `Z.local_triv i`: for `i : ι`, a local homeomorphism from `Z.total_space` to `B × F`, that
  realizes a trivialization above the set `Z.base_set i`, which is an open set in `B`.

## Implementation notes

A topological fiber bundle with fiber `F` over a base `B` is a family of spaces isomorphic to `F`,
indexed by `B`, which is locally trivial in the following sense: there is a covering of `B` by open
sets such that, on each such open set `s`, the bundle is isomorphic to `s × F`.

To construct a fiber bundle formally, the main data is what happens when one changes trivializations
from `s × F` to `s' × F` on `s ∩ s'`: one should get a family of homeomorphisms of `F`, depending
continuously on the base point, satisfying basic compatibility conditions (cocycle property).
Useful classes of bundles can then be specified by requiring that these homeomorphisms of `F`
belong to some subgroup, preserving some structure (the "structure group of the bundle"): then
these structures are inherited by the fibers of the bundle.

Given such trivialization change data (encoded below in a structure called
`topological_fiber_bundle_core`), one can construct the fiber bundle. The intrinsic canonical
mathematical construction is the following.
The fiber above `x` is the disjoint union of `F` over all trivializations, modulo the gluing
identifications: one gets a fiber which is isomorphic to `F`, but non-canonically
(each choice of one of the trivializations around `x` gives such an isomorphism). Given a
trivialization over a set `s`, one gets an isomorphism between `s × F` and `proj^{-1} s`, by using
the identification corresponding to this trivialization. One chooses the topology on the bundle that
makes all of these into homeomorphisms.

For the practical implementation, it turns out to be more convenient to avoid completely the
gluing and quotienting construction above, and to declare above each `x` that the fiber is `F`,
but thinking that it corresponds to the `F` coming from the choice of one trivialization around `x`.
This has several practical advantages:
* without any work, one gets a topological space structure on the fiber. And if `F` has more
structure it is inherited for free by the fiber.
* In the case of the tangent bundle of manifolds, this implies that on vector spaces the derivative
(from `F` to `F`) and the manifold derivative (from `tangent_space I x` to `tangent_space I' (f x)`)
are equal.

A drawback is that some silly constructions will typecheck: in the case of the tangent bundle, one
can add two vectors in different tangent spaces (as they both are elements of `F` from the point of
view of Lean). To solve this, one could mark the tangent space as irreducible, but then one would
lose the identification of the tangent space to `F` with `F`. There is however a big advantage of
this situation: even if Lean can not check that two basepoints are defeq, it will accept the fact
that the tangent spaces are the same. For instance, if two maps `f` and `g` are locally inverse to
each other, one can express that the composition of their derivatives is the identity of
`tangent_space I x`. One could fear issues as this composition goes from `tangent_space I x` to
`tangent_space I (g (f x))` (which should be the same, but should not be obvious to Lean
as it does not know that `g (f x) = x`). As these types are the same to Lean (equal to `F`), there
are in fact no dependent type difficulties here!

For this construction of a fiber bundle from a `topological_fiber_bundle_core`, we should thus
choose for each `x` one specific trivialization around it. We include this choice in the definition
of the `topological_fiber_bundle_core`, as it makes some constructions more
functorial and it is a nice way to say that the trivializations cover the whole space `B`.

With this definition, the type of the fiber bundle space constructed from the core data is just
`Σ (b : B), F `, but the topology is not the product one, in general.

We also take the indexing type (indexing all the trivializations) as a parameter to the fiber bundle
core: it could always be taken as a subtype of all the maps from open subsets of `B` to continuous
maps of `F`, but in practice it will sometimes be something else. For instance, on a manifold, one
will use the set of charts as a good parameterization for the trivializations of the tangent bundle.
Or for the pullback of a `topological_fiber_bundle_core`, the indexing type will be the same as
for the initial bundle.

## Tags
Fiber bundle, topological bundle, vector bundle, local trivialization, structure group
-/

variables {ι : Type*} {B : Type*} {F : Type*}

open topological_space filter set
open_locale topological_space classical

/-! ### General definition of topological fiber bundles -/

section topological_fiber_bundle

variables (F) {Z : Type*} [topological_space B] [topological_space Z]
  [topological_space F] {proj : Z → B}

/--
A structure extending local homeomorphisms, defining a local trivialization of a projection
`proj : Z → B` with fiber `F`, as a local homeomorphism between `Z` and `B × F` defined between two
sets of the form `proj ⁻¹' base_set` and `base_set × F`, acting trivially on the first coordinate.
-/
@[nolint has_inhabited_instance]
structure bundle_trivialization (proj : Z → B) extends local_homeomorph Z (B × F) :=
(base_set      : set B)
(open_base_set : is_open base_set)
(source_eq     : source = proj ⁻¹' base_set)
(target_eq     : target = set.prod base_set univ)
(proj_to_fun   : ∀ p ∈ source, (to_local_homeomorph p).1 = proj p)

instance : has_coe_to_fun (bundle_trivialization F proj) := ⟨_, λ e, e.to_fun⟩

variable {F}

@[simp, mfld_simps] lemma bundle_trivialization.coe_coe (e : bundle_trivialization F proj) :
  ⇑e.to_local_homeomorph = e := rfl

@[simp, mfld_simps] lemma bundle_trivialization.coe_mk
  (e : local_homeomorph Z (B × F)) (i j k l m) (x : Z) :
  (bundle_trivialization.mk e i j k l m : bundle_trivialization F proj) x = e x := rfl

variable (F)

/-- A topological fiber bundle with fiber `F` over a base `B` is a space projecting on `B`
for which the fibers are all homeomorphic to `F`, such that the local situation around each point
is a direct product. -/
def is_topological_fiber_bundle (proj : Z → B) : Prop :=
∀ x : B, ∃e : bundle_trivialization F proj, x ∈ e.base_set

/-- A trivial topological fiber bundle with fiber `F` over a base `B` is a space `Z`
projecting on `B` for which there exists a homeomorphism to `B × F` that sends `proj`
to `prod.fst`. -/
def is_trivial_topological_fiber_bundle (proj : Z → B) : Prop :=
∃ e : Z ≃ₜ (B × F), ∀ x, (e x).1 = proj x

variables {F}

lemma bundle_trivialization.mem_source (e : bundle_trivialization F proj)
  {x : Z} : x ∈ e.source ↔ proj x ∈ e.base_set :=
by rw [e.source_eq, mem_preimage]

lemma bundle_trivialization.mem_target (e : bundle_trivialization F proj)
  {x : B × F} : x ∈ e.target ↔ x.1 ∈ e.base_set :=
by rw [e.target_eq, prod_univ, mem_preimage]

@[simp, mfld_simps] lemma bundle_trivialization.coe_fst (e : bundle_trivialization F proj) {x : Z}
  (ex : x ∈ e.source) : (e x).1 = proj x :=
e.proj_to_fun x ex

lemma bundle_trivialization.coe_fst' (e : bundle_trivialization F proj) {x : Z}
  (ex : proj x ∈ e.base_set) : (e x).1 = proj x :=
e.coe_fst (e.mem_source.2 ex)

lemma bundle_trivialization.mk_proj_snd (e : bundle_trivialization F proj) {x : Z}
  (ex : x ∈ e.source) : (proj x, (e x).2) = e x :=
prod.ext (e.coe_fst ex).symm rfl

lemma bundle_trivialization.mk_proj_snd' (e : bundle_trivialization F proj) {x : Z}
  (ex : proj x ∈ e.base_set) : (proj x, (e x).2) = e x :=
prod.ext (e.coe_fst' ex).symm rfl

protected lemma bundle_trivialization.eq_on (e : bundle_trivialization F proj) :
  eq_on (prod.fst ∘ e) proj e.source :=
λ x hx, e.coe_fst hx

lemma bundle_trivialization.proj_symm_apply (e : bundle_trivialization F proj) {x : B × F}
  (hx : x ∈ e.target) : proj (e.to_local_homeomorph.symm x) = x.1 :=
begin
  have := (e.coe_fst (e.to_local_homeomorph.map_target hx)).symm,
  rwa [← e.coe_coe, e.to_local_homeomorph.right_inv hx] at this
end

lemma bundle_trivialization.proj_symm_apply' (e : bundle_trivialization F proj) {b : B} {x : F}
  (hx : b ∈ e.base_set) : proj (e.to_local_homeomorph.symm (b, x)) = b :=
e.proj_symm_apply (e.mem_target.2 hx)

lemma bundle_trivialization.apply_symm_apply (e : bundle_trivialization F proj)
  {x : B × F} (hx : x ∈ e.target) : e (e.to_local_homeomorph.symm x) = x :=
e.to_local_homeomorph.right_inv hx

lemma bundle_trivialization.apply_symm_apply' (e : bundle_trivialization F proj)
  {b : B} {x : F} (hx : b ∈ e.base_set) : e (e.to_local_homeomorph.symm (b, x)) = (b, x) :=
e.apply_symm_apply (e.mem_target.2 hx)

@[simp, mfld_simps] lemma bundle_trivialization.symm_apply_mk_proj
  (e : bundle_trivialization F proj) {x : Z} (ex : x ∈ e.source) :
  e.to_local_homeomorph.symm (proj x, (e x).2) = x :=
by rw [← e.coe_fst ex, prod.mk.eta, ← e.coe_coe, e.to_local_homeomorph.left_inv ex]

lemma bundle_trivialization.coe_fst_eventually_eq_proj (e : bundle_trivialization F proj)
  {x : Z} (ex : x ∈ e.source) : prod.fst ∘ e =ᶠ[𝓝 x] proj  :=
mem_nhds_sets_iff.2 ⟨e.source, λ y hy, e.coe_fst hy, e.open_source, ex⟩

lemma bundle_trivialization.coe_fst_eventually_eq_proj' (e : bundle_trivialization F proj)
  {x : Z} (ex : proj x ∈ e.base_set) : prod.fst ∘ e =ᶠ[𝓝 x] proj  :=
e.coe_fst_eventually_eq_proj (e.mem_source.2 ex)

lemma is_trivial_topological_fiber_bundle.is_topological_fiber_bundle
  (h : is_trivial_topological_fiber_bundle F proj) :
  is_topological_fiber_bundle F proj :=
let ⟨e, he⟩ := h in λ x,
⟨⟨e.to_local_homeomorph, univ, is_open_univ, rfl, univ_prod_univ.symm, λ x _, he x⟩, mem_univ x⟩

lemma bundle_trivialization.map_proj_nhds (e : bundle_trivialization F proj) {x : Z}
  (ex : x ∈ e.source) : map proj (𝓝 x) = 𝓝 (proj x) :=
by rw [← e.coe_fst ex, ← map_congr (e.coe_fst_eventually_eq_proj ex), ← map_map, ← e.coe_coe,
  e.to_local_homeomorph.map_nhds_eq ex, map_fst_nhds]

/-- In the domain of a bundle trivialization, the projection is continuous-/
lemma bundle_trivialization.continuous_at_proj (e : bundle_trivialization F proj) {x : Z}
  (ex : x ∈ e.source) : continuous_at proj x :=
(e.map_proj_nhds ex).le

/-- The projection from a topological fiber bundle to its base is continuous. -/
lemma is_topological_fiber_bundle.continuous_proj (h : is_topological_fiber_bundle F proj) :
  continuous proj :=
begin
  rw continuous_iff_continuous_at,
  assume x,
  rcases h (proj x) with ⟨e, ex⟩,
  apply e.continuous_at_proj,
  rwa e.source_eq
end

/-- The projection from a topological fiber bundle to its base is an open map. -/
lemma is_topological_fiber_bundle.is_open_map_proj (h : is_topological_fiber_bundle F proj) :
  is_open_map proj :=
begin
  refine is_open_map_iff_nhds_le.2 (λ x, _),
  rcases h (proj x) with ⟨e, ex⟩,
  refine (e.map_proj_nhds _).ge,
  rwa e.source_eq
end

/-- The first projection in a product is a trivial topological fiber bundle. -/
lemma is_trivial_topological_fiber_bundle_fst :
  is_trivial_topological_fiber_bundle F (prod.fst : B × F → B) :=
⟨homeomorph.refl _, λ x, rfl⟩

/-- The first projection in a product is a topological fiber bundle. -/
lemma is_topological_fiber_bundle_fst : is_topological_fiber_bundle F (prod.fst : B × F → B) :=
is_trivial_topological_fiber_bundle_fst.is_topological_fiber_bundle

/-- The second projection in a product is a trivial topological fiber bundle. -/
lemma is_trivial_topological_fiber_bundle_snd :
  is_trivial_topological_fiber_bundle F (prod.snd : F × B → B) :=
⟨homeomorph.prod_comm _ _, λ x, rfl⟩

/-- The second projection in a product is a topological fiber bundle. -/
lemma is_topological_fiber_bundle_snd : is_topological_fiber_bundle F (prod.snd : F × B → B) :=
is_trivial_topological_fiber_bundle_snd.is_topological_fiber_bundle

/-- Composition of a `bundle_trivialization` and a `homeomorph`. -/
def bundle_trivialization.comp_homeomorph {Z' : Type*} [topological_space Z']
  (e : bundle_trivialization F proj) (h : Z' ≃ₜ Z) :
  bundle_trivialization F (proj ∘ h) :=
{ to_local_homeomorph := h.to_local_homeomorph.trans e.to_local_homeomorph,
  base_set := e.base_set,
  open_base_set := e.open_base_set,
  source_eq := by simp [e.source_eq, preimage_preimage],
  target_eq := by simp [e.target_eq],
  proj_to_fun := λ p hp,
    have hp : h p ∈ e.source, by simpa using hp,
    by simp [hp] }

lemma is_topological_fiber_bundle.comp_homeomorph {Z' : Type*} [topological_space Z']
  (e : is_topological_fiber_bundle F proj) (h : Z' ≃ₜ Z) :
  is_topological_fiber_bundle F (proj ∘ h) :=
λ x, let ⟨e, he⟩ := e x in
⟨e.comp_homeomorph h, by simpa [bundle_trivialization.comp_homeomorph] using he⟩

namespace bundle_trivialization

/-- If `e` is a `bundle_trivialization` of `proj : Z → B` with fiber `F` and `h` is a homeomorphism
`F ≃ₜ F'`, then `e.trans_fiber_homeomorph h` is the trivialization of `proj` with the fiber `F'`
that sends `p : Z` to `((e p).1, h (e p).2)`. -/
def trans_fiber_homeomorph {F' : Type*} [topological_space F']
  (e : bundle_trivialization F proj) (h : F ≃ₜ F') : bundle_trivialization F' proj :=
{ to_local_homeomorph := e.to_local_homeomorph.trans
    ((homeomorph.refl _).prod_congr h).to_local_homeomorph,
  base_set := e.base_set,
  open_base_set := e.open_base_set,
  source_eq := by simp [e.source_eq],
  target_eq := by { ext, simp [e.target_eq] },
  proj_to_fun := λ p hp, have p ∈ e.source, by simpa using hp, by simp [this] }

@[simp] lemma trans_fiber_homeomorph_apply {F' : Type*} [topological_space F']
  (e : bundle_trivialization F proj) (h : F ≃ₜ F') (x : Z) :
  e.trans_fiber_homeomorph h x = ((e x).1, h (e x).2) :=
rfl

/-- Coordinate transformation in the fiber induced by a pair of bundle trivializations. See also
`bundle_trivialization.coord_change_homeomorph` for a version bundled as `F ≃ₜ F`. -/
def coord_change (e₁ e₂ : bundle_trivialization F proj) (b : B) (x : F) : F :=
(e₂ $ e₁.to_local_homeomorph.symm (b, x)).2

lemma mk_coord_change
  (e₁ e₂ : bundle_trivialization F proj) {b : B}
  (h₁ : b ∈ e₁.base_set) (h₂ : b ∈ e₂.base_set) (x : F) :
  (b, e₁.coord_change e₂ b x) = e₂ (e₁.to_local_homeomorph.symm (b, x)) :=
begin
  refine prod.ext _ rfl,
  rw [e₂.coe_fst', ← e₁.coe_fst', e₁.apply_symm_apply' h₁],
  { rwa [e₁.proj_symm_apply' h₁] },
  { rwa [e₁.proj_symm_apply' h₁] }
end

lemma coord_change_apply_snd
  (e₁ e₂ : bundle_trivialization F proj) {p : Z}
  (h : proj p ∈ e₁.base_set) :
  e₁.coord_change e₂ (proj p) (e₁ p).snd = (e₂ p).snd :=
by rw [coord_change, e₁.symm_apply_mk_proj (e₁.mem_source.2 h)]

lemma coord_change_same_apply
  (e : bundle_trivialization F proj) {b : B} (h : b ∈ e.base_set) (x : F) :
  e.coord_change e b x = x :=
by rw [bundle_trivialization.coord_change, e.apply_symm_apply' h]

lemma coord_change_same
  (e : bundle_trivialization F proj) {b : B} (h : b ∈ e.base_set) :
  e.coord_change e b = id :=
funext $ e.coord_change_same_apply h

lemma coord_change_coord_change
  (e₁ e₂ e₃ : bundle_trivialization F proj) {b : B}
  (h₁ : b ∈ e₁.base_set) (h₂ : b ∈ e₂.base_set) (x : F) :
  e₂.coord_change e₃ b (e₁.coord_change e₂ b x) = e₁.coord_change e₃ b x :=
begin
  rw [bundle_trivialization.coord_change, e₁.mk_coord_change _ h₁ h₂, ← e₂.coe_coe,
    e₂.to_local_homeomorph.left_inv, bundle_trivialization.coord_change],
  rwa [e₂.mem_source, e₁.proj_symm_apply' h₁]
end

lemma continuous_coord_change (e₁ e₂ : bundle_trivialization F proj) {b : B}
  (h₁ : b ∈ e₁.base_set) (h₂ : b ∈ e₂.base_set) :
  continuous (e₁.coord_change e₂ b) :=
begin
  refine continuous_snd.comp (e₂.to_local_homeomorph.continuous_on.comp_continuous
    (e₁.to_local_homeomorph.continuous_on_symm.comp_continuous _ _) _),
  { exact continuous_const.prod_mk continuous_id },
  { exact λ x, e₁.mem_target.2 h₁ },
  { intro x,
    rwa [e₂.mem_source, e₁.proj_symm_apply' h₁] }
end

/-- Coordinate transformation in the fiber induced by a pair of bundle trivializations,
as a homeomorphism. -/
def coord_change_homeomorph
  (e₁ e₂ : bundle_trivialization F proj) {b : B} (h₁ : b ∈ e₁.base_set) (h₂ : b ∈ e₂.base_set) :
  F ≃ₜ F :=
{ to_fun := e₁.coord_change e₂ b,
  inv_fun := e₂.coord_change e₁ b,
  left_inv := λ x, by simp only [*, coord_change_coord_change, coord_change_same_apply],
  right_inv := λ x, by simp only [*, coord_change_coord_change, coord_change_same_apply],
  continuous_to_fun := e₁.continuous_coord_change e₂ h₁ h₂,
  continuous_inv_fun := e₂.continuous_coord_change e₁ h₂ h₁ }

@[simp] lemma coord_change_homeomorph_coe
  (e₁ e₂ : bundle_trivialization F proj) {b : B} (h₁ : b ∈ e₁.base_set) (h₂ : b ∈ e₂.base_set) :
  ⇑(e₁.coord_change_homeomorph e₂ h₁ h₂) = e₁.coord_change e₂ b :=
rfl

end bundle_trivialization

section comap

open_locale classical

variables {B' : Type*} [topological_space B']

/-- Given a bundle trivialization of `proj : Z → B` and a continuous map `f : B' → B`,
construct a bundle trivialization of `φ : {p : B' × Z | f p.1 = proj p.2} → B'`
given by `φ x = (x : B' × Z).1`. -/
noncomputable def bundle_trivialization.comap
  (e : bundle_trivialization F proj) (f : B' → B) (hf : continuous f)
  (b' : B') (hb' : f b' ∈ e.base_set) :
  bundle_trivialization F (λ x : {p : B' × Z | f p.1 = proj p.2}, (x : B' × Z).1) :=
{ to_fun := λ p, ((p : B' × Z).1, (e (p : B' × Z).2).2),
  inv_fun := λ p, if h : f p.1 ∈ e.base_set
    then ⟨⟨p.1, e.to_local_homeomorph.symm (f p.1, p.2)⟩, by simp [e.proj_symm_apply' h]⟩
    else ⟨⟨b', e.to_local_homeomorph.symm (f b', p.2)⟩, by simp [e.proj_symm_apply' hb']⟩,
  source := {p | f (p : B' × Z).1 ∈ e.base_set},
  target := {p | f p.1 ∈ e.base_set},
  map_source' := λ p hp, hp,
  map_target' := λ p (hp : f p.1 ∈ e.base_set), by simp [hp],
  left_inv' :=
    begin
      rintro ⟨⟨b, x⟩, hbx⟩ hb,
      dsimp at *,
      have hx : x ∈ e.source, from e.mem_source.2 (hbx ▸ hb),
      ext; simp *
    end,
  right_inv' := λ p (hp : f p.1 ∈ e.base_set), by simp [*, e.apply_symm_apply'],
  open_source := e.open_base_set.preimage (hf.comp $ continuous_fst.comp continuous_subtype_coe),
  open_target := e.open_base_set.preimage (hf.comp continuous_fst),
  continuous_to_fun := ((continuous_fst.comp continuous_subtype_coe).continuous_on).prod $
    continuous_snd.comp_continuous_on $ e.continuous_to_fun.comp
      (continuous_snd.comp continuous_subtype_coe).continuous_on $
      by { rintro ⟨⟨b, x⟩, (hbx : f b = proj x)⟩ (hb : f b ∈ e.base_set),
           rw hbx at hb,
           exact e.mem_source.2 hb },
  continuous_inv_fun :=
    begin
      rw [embedding_subtype_coe.continuous_on_iff],
      suffices : continuous_on (λ p : B' × F, (p.1, e.to_local_homeomorph.symm (f p.1, p.2)))
        {p : B' × F | f p.1 ∈ e.base_set},
      { refine this.congr (λ p (hp : f p.1 ∈ e.base_set), _),
        simp [hp] },
      { refine continuous_on_fst.prod (e.to_local_homeomorph.symm.continuous_on.comp _ _),
        { exact ((hf.comp continuous_fst).prod_mk continuous_snd).continuous_on },
        { exact λ p hp, e.mem_target.2 hp } }
    end,
  base_set := f ⁻¹' e.base_set,
  source_eq := rfl,
  target_eq := by { ext, simp },
  open_base_set := e.open_base_set.preimage hf,
  proj_to_fun := λ _ _, rfl }

/-- If `proj : Z → B` is a topological fiber bundle with fiber `F` and `f : B' → B` is a continuous
map, then the pullback bundle (a.k.a. induced bundle) is the topological bundle with the total space
`{(x, y) : B' × Z | f x = proj y}` given by `λ ⟨(x, y), h⟩, x`. -/
lemma is_topological_fiber_bundle.comap (h : is_topological_fiber_bundle F proj)
  {f : B' → B} (hf : continuous f) :
  is_topological_fiber_bundle F (λ x : {p : B' × Z | f p.1 = proj p.2}, (x : B' × Z).1) :=
λ x, let ⟨e, he⟩ := h (f x) in ⟨e.comap f hf x he, he⟩

end comap

lemma bundle_trivialization.is_image_preimage_prod (e : bundle_trivialization F proj) (s : set B) :
  e.to_local_homeomorph.is_image (proj ⁻¹' s) (s.prod univ) :=
λ x hx, by simp [e.coe_fst', hx]

/-- Restrict a `bundle_trivialization` to an open set in the base. `-/
def bundle_trivialization.restr_open (e : bundle_trivialization F proj) (s : set B)
  (hs : is_open s) :
  bundle_trivialization F proj :=
{ to_local_homeomorph := ((e.is_image_preimage_prod s).symm.restr
    (is_open_inter e.open_target (hs.prod is_open_univ))).symm,
  base_set := e.base_set ∩ s,
  open_base_set := is_open_inter e.open_base_set hs,
  source_eq := by simp [e.source_eq],
  target_eq := by simp [e.target_eq, prod_univ],
  proj_to_fun := λ p hp, e.proj_to_fun p hp.1 }

section piecewise

lemma bundle_trivialization.frontier_preimage (e : bundle_trivialization F proj) (s : set B) :
  e.source ∩ frontier (proj ⁻¹' s) = proj ⁻¹' (e.base_set ∩ frontier s) :=
by rw [← (e.is_image_preimage_prod s).frontier.preimage_eq, frontier_prod_univ_eq,
  (e.is_image_preimage_prod _).preimage_eq, e.source_eq, preimage_inter]

/-- Given two bundle trivializations `e`, `e'` of `proj : Z → B` and a set `s : set B` such that
the base sets of `e` and `e'` intersect `frontier s` on the same set and `e p = e' p` whenever
`proj p ∈ e.base_set ∩ frontier s`, `e.piecewise e' s Hs Heq` is the bundle trivialization over
`set.ite s e.base_set e'.base_set` that is equal to `e` on `proj ⁻¹ s` and is equal to `e'`
otherwise. -/
noncomputable def bundle_trivialization.piecewise (e e' : bundle_trivialization F proj) (s : set B)
  (Hs : e.base_set ∩ frontier s = e'.base_set ∩ frontier s)
  (Heq : eq_on e e' $ proj ⁻¹' (e.base_set ∩ frontier s)) :
  bundle_trivialization F proj :=
{ to_local_homeomorph := e.to_local_homeomorph.piecewise e'.to_local_homeomorph
    (proj ⁻¹' s) (s.prod univ) (e.is_image_preimage_prod s) (e'.is_image_preimage_prod s)
    (by rw [e.frontier_preimage, e'.frontier_preimage, Hs])
    (by rwa e.frontier_preimage),
  base_set := s.ite e.base_set e'.base_set,
  open_base_set := e.open_base_set.ite e'.open_base_set Hs,
  source_eq := by simp [e.source_eq, e'.source_eq],
  target_eq := by simp [e.target_eq, e'.target_eq, prod_univ],
  proj_to_fun := by rintro p (⟨he, hs⟩|⟨he, hs⟩); simp * }

/-- Given two bundle trivializations `e`, `e'` of a topological fiber bundle `proj : Z → B`
over a linearly ordered base `B` and a point `a ∈ e.base_set ∩ e'.base_set` such that
`e` equals `e'` on `proj ⁻¹' {a}`, `e.piecewise_le_of_eq e' a He He' Heq` is the bundle
trivialization over `set.ite (Iic a) e.base_set e'.base_set` that is equal to `e` on points `p`
such that `proj p ≤ a` and is equal to `e'` otherwise. -/
noncomputable def bundle_trivialization.piecewise_le_of_eq [linear_order B] [order_topology B]
  (e e' : bundle_trivialization F proj) (a : B) (He : a ∈ e.base_set) (He' : a ∈ e'.base_set)
  (Heq : ∀ p, proj p = a → e p = e' p) :
  bundle_trivialization F proj :=
e.piecewise e' (Iic a)
  (set.ext $ λ x, and.congr_left_iff.2 $ λ hx,
    by simp [He, He', mem_singleton_iff.1 (frontier_Iic_subset _ hx)])
  (λ p hp, Heq p $ frontier_Iic_subset _ hp.2)

/-- Given two bundle trivializations `e`, `e'` of a topological fiber bundle `proj : Z → B` over a
linearly ordered base `B` and a point `a ∈ e.base_set ∩ e'.base_set`, `e.piecewise_le e' a He He'`
is the bundle trivialization over `set.ite (Iic a) e.base_set e'.base_set` that is equal to `e` on
points `p` such that `proj p ≤ a` and is equal to `((e' p).1, h (e' p).2)` otherwise, where
`h = `e'.coord_change_homeomorph e _ _` is the homeomorphism of the fiber such that
`h (e' p).2 = (e p).2` whenever `e p = a`. -/
noncomputable def bundle_trivialization.piecewise_le [linear_order B] [order_topology B]
  (e e' : bundle_trivialization F proj) (a : B) (He : a ∈ e.base_set) (He' : a ∈ e'.base_set) :
  bundle_trivialization F proj :=
e.piecewise_le_of_eq (e'.trans_fiber_homeomorph (e'.coord_change_homeomorph e He' He))
  a He He' $ by { unfreezingI {rintro p rfl },
    ext1,
    { simp [e.coe_fst', e'.coe_fst', *] },
    { simp [e'.coord_change_apply_snd, *] } }

/-- Given two bundle trivializations `e`, `e'` over disjoint sets, `e.disjoint_union e' H` is the
bundle trivialization over the union of the base sets that agrees with `e` and `e'` over their
base sets. -/
noncomputable def bundle_trivialization.disjoint_union (e e' : bundle_trivialization F proj)
  (H : disjoint e.base_set e'.base_set) :
  bundle_trivialization F proj :=
{ to_local_homeomorph := e.to_local_homeomorph.disjoint_union e'.to_local_homeomorph
    (λ x hx, by { rw [e.source_eq, e'.source_eq] at hx, exact H hx })
    (λ x hx, by { rw [e.target_eq, e'.target_eq] at hx, exact H ⟨hx.1.1, hx.2.1⟩ }),
  base_set := e.base_set ∪ e'.base_set,
  open_base_set := is_open_union e.open_base_set e'.open_base_set,
  source_eq := congr_arg2 (∪) e.source_eq e'.source_eq,
  target_eq := (congr_arg2 (∪) e.target_eq e'.target_eq).trans union_prod.symm,
  proj_to_fun :=
    begin
      rintro p (hp|hp'),
      { show (e.source.piecewise e e' p).1 = proj p,
        rw [piecewise_eq_of_mem, e.coe_fst]; exact hp },
      { show (e.source.piecewise e e' p).1 = proj p,
        rw [piecewise_eq_of_not_mem, e'.coe_fst hp'],
        simp only [e.source_eq, e'.source_eq] at hp' ⊢,
        exact λ h, H ⟨h, hp'⟩ }
    end }

/-- If `h` is a topological fiber bundle over a conditionally complete linear order,
then it is trivial over any closed interval. -/
lemma is_topological_fiber_bundle.exists_trivialization_Icc_subset
  [conditionally_complete_linear_order B] [order_topology B]
  (h : is_topological_fiber_bundle F proj) (a b : B) :
  ∃ e : bundle_trivialization F proj, Icc a b ⊆ e.base_set :=
begin
  classical,
  obtain ⟨ea, hea⟩ : ∃ ea : bundle_trivialization F proj, a ∈ ea.base_set := h a,
  -- If `a < b`, then `[a, b] = ∅`, and the statement is trivial
  cases le_or_lt a b with hab hab; [skip, exact ⟨ea, by simp *⟩],
  /- Let `s` be the set of points `x ∈ [a, b]` such that `proj` is trivializable over `[a, x]`.
  We need to show that `b ∈ s`. Let `c = Sup s`. We will show that `c ∈ s` and `c = b`. -/
  set s : set B := {x ∈ Icc a b | ∃ e : bundle_trivialization F proj, Icc a x ⊆ e.base_set},
  have ha : a ∈ s, from ⟨left_mem_Icc.2 hab, ea, by simp [hea]⟩,
  have sne : s.nonempty := ⟨a, ha⟩,
  have hsb : b ∈ upper_bounds s, from λ x hx, hx.1.2,
  have sbd : bdd_above s := ⟨b, hsb⟩,
  set c := Sup s,
  have hsc : is_lub s c, from is_lub_cSup sne sbd,
  have hc : c ∈ Icc a b, from ⟨hsc.1 ha, hsc.2 hsb⟩,
  obtain ⟨-, ec : bundle_trivialization F proj, hec : Icc a c ⊆ ec.base_set⟩ : c ∈ s,
  { cases hc.1.eq_or_lt with heq hlt, { rwa ← heq },
    refine ⟨hc, _⟩,
    /- In order to show that `c ∈ s`, consider a trivialization `ec` of `proj` over a neighborhood
    of `c`. Its base set includes `(c', c]` for some `c' ∈ [a, c)`. -/
    rcases h c with ⟨ec, hc⟩,
    obtain ⟨c', hc', hc'e⟩ : ∃ c' ∈ Ico a c, Ioc c' c ⊆ ec.base_set :=
      (mem_nhds_within_Iic_iff_exists_mem_Ico_Ioc_subset hlt).1
        (mem_nhds_within_of_mem_nhds $ mem_nhds_sets ec.open_base_set hc),
    /- Since `c' < c = Sup s`, there exists `d ∈ s ∩ (c', c]`. Let `ead` be a trivialization of
    `proj` over `[a, d]`. Then we can glue `ead` and `ec` into a trivialization over `[a, c]`. -/
    obtain ⟨d, ⟨hdab, ead, had⟩, hd⟩ : ∃ d ∈ s, d ∈ Ioc c' c := hsc.exists_between hc'.2,
    refine ⟨ead.piecewise_le ec d (had ⟨hdab.1, le_rfl⟩) (hc'e hd), subset_ite.2 _⟩,
    refine ⟨λ x hx, had ⟨hx.1.1, hx.2⟩, λ x hx, hc'e ⟨hd.1.trans (not_le.1 hx.2), hx.1.2⟩⟩ },
  /- So, `c ∈ s`. Let `ec` be a trivialization of `proj` over `[a, c]`.  If `c = b`, then we are
  done. Otherwise we show that `proj` can be trivialized over a larger interval `[a, d]`,
  `d ∈ (c, b]`, hence `c` is not an upper bound of `s`. -/
  cases hc.2.eq_or_lt with heq hlt, { exact ⟨ec, heq ▸ hec⟩ },
  suffices : ∃ (d ∈ Ioc c b) (e : bundle_trivialization F proj), Icc a d ⊆ e.base_set,
  { rcases this with ⟨d, hdcb, hd⟩,
    exact ((hsc.1 ⟨⟨hc.1.trans hdcb.1.le, hdcb.2⟩, hd⟩).not_lt hdcb.1).elim },
  /- Since the base set of `ec` is open, it includes `[c, d)` (hence, `[a, d)`) for some
  `d ∈ (c, b]`. -/
  obtain ⟨d, hdcb, hd⟩ : ∃ d ∈ Ioc c b, Ico c d ⊆ ec.base_set :=
    (mem_nhds_within_Ici_iff_exists_mem_Ioc_Ico_subset hlt).1
      (mem_nhds_within_of_mem_nhds $ mem_nhds_sets ec.open_base_set (hec ⟨hc.1, le_rfl⟩)),
  have had : Ico a d ⊆ ec.base_set,
    from subset.trans Ico_subset_Icc_union_Ico (union_subset hec hd),
  by_cases he : disjoint (Iio d) (Ioi c),
  { /- If `(c, d) = ∅`, then let `ed` be a trivialization of `proj` over a neighborhood of `d`.
    Then the disjoint union of `ec` restricted to `(-∞, d)` and `ed` restricted to `(c, ∞)` is
    a trivialization over `[a, d]`. -/
    rcases h d with ⟨ed, hed⟩,
    refine ⟨d, hdcb, (ec.restr_open (Iio d) is_open_Iio).disjoint_union
      (ed.restr_open (Ioi c) is_open_Ioi) (he.mono (inter_subset_right _ _)
        (inter_subset_right _ _)), λ x hx, _⟩,
    rcases hx.2.eq_or_lt with rfl|hxd,
    exacts [or.inr ⟨hed, hdcb.1⟩, or.inl ⟨had ⟨hx.1, hxd⟩, hxd⟩] },
  { /- If `(c, d)` is nonempty, then take `d' ∈ (c, d)`. Since the base set of `ec` includes
    `[a, d)`, it includes `[a, d'] ⊆ [a, d)` as well. -/
    rw [disjoint_left] at he, push_neg at he, rcases he with ⟨d', hdd' : d' < d, hd'c⟩,
    exact ⟨d', ⟨hd'c, hdd'.le.trans hdcb.2⟩, ec, subset.trans (Icc_subset_Ico_right hdd') had⟩ }
end

end piecewise

end topological_fiber_bundle

/-! ### Constructing topological fiber bundles -/

namespace bundle
/- We provide a type synonym of `Σ x, E x` as `bundle.total_space E`, to be able to endow it with
a topology which is not the disjoint union topology. In general, the constructions of fiber bundles
we will make will be of this form. -/

variable (E : B → Type*)

/--
`total_space E` is the total space of the bundle `Σ x, E x`. This type synonym is used to avoid
conflicts with general sigma types.
-/
def total_space := Σ x, E x

instance [inhabited B] [inhabited (E (default B))] :
  inhabited (total_space E) := ⟨⟨default B, default (E (default B))⟩⟩

/-- `bundle.proj E` is the canonical projection `total_space E → B` on the base space. -/
@[simp, mfld_simps] def proj : total_space E → B :=
λ (y : total_space E), y.1

instance {x : B} : has_coe_t (E x) (total_space E) := ⟨λ y, (⟨x, y⟩ : total_space E)⟩

lemma to_total_space_coe {x : B} (v : E x) : (v : total_space E) = ⟨x, v⟩ := rfl

/-- `bundle.trivial B F` is the trivial bundle over `B` of fiber `F`. -/
@[nolint unused_arguments]
def trivial (B : Type*) (F : Type*) : B → Type* := λ x, F

instance [inhabited F] {b : B} : inhabited (bundle.trivial B F b) :=
⟨(default F : F)⟩

/-- The trivial bundle, unlike other bundles, has a canonical projection on the fiber. -/
def trivial.proj_snd (B : Type*) (F : Type*) : (total_space (bundle.trivial B F)) → F := sigma.snd

instance [I : topological_space F] : ∀ x : B, topological_space (trivial B F x) := λ x, I

instance [t₁ : topological_space B] [t₂ : topological_space F] :
  topological_space (total_space (trivial B F)) :=
topological_space.induced (proj (trivial B F)) t₁ ⊓
  topological_space.induced (trivial.proj_snd B F) t₂

end bundle

/-- Core data defining a locally trivial topological bundle with fiber `F` over a topological
space `B`. Note that "bundle" is used in its mathematical sense. This is the (computer science)
bundled version, i.e., all the relevant data is contained in the following structure. A family of
local trivializations is indexed by a type ι, on open subsets `base_set i` for each `i : ι`.
Trivialization changes from `i` to `j` are given by continuous maps `coord_change i j` from
`base_set i ∩ base_set j` to the set of homeomorphisms of `F`, but we express them as maps
`B → F → F` and require continuity on `(base_set i ∩ base_set j) × F` to avoid the topology on the
space of continuous maps on `F`. -/
@[nolint has_inhabited_instance]
structure topological_fiber_bundle_core (ι : Type*) (B : Type*) [topological_space B]
  (F : Type*) [topological_space F] :=
(base_set          : ι → set B)
(is_open_base_set  : ∀i, is_open (base_set i))
(index_at          : B → ι)
(mem_base_set_at   : ∀x, x ∈ base_set (index_at x))
(coord_change      : ι → ι → B → F → F)
(coord_change_self : ∀i, ∀ x ∈ base_set i, ∀v, coord_change i i x v = v)
(coord_change_continuous : ∀i j, continuous_on (λp : B × F, coord_change i j p.1 p.2)
                                               (set.prod ((base_set i) ∩ (base_set j)) univ))
(coord_change_comp : ∀i j k, ∀x ∈ (base_set i) ∩ (base_set j) ∩ (base_set k), ∀v,
  (coord_change j k x) (coord_change i j x v) = coord_change i k x v)

attribute [simp, mfld_simps] topological_fiber_bundle_core.mem_base_set_at

namespace topological_fiber_bundle_core

variables [topological_space B] [topological_space F] (Z : topological_fiber_bundle_core ι B F)

include Z

/-- The index set of a topological fiber bundle core, as a convenience function for dot notation -/
@[nolint unused_arguments has_inhabited_instance]
def index := ι

/-- The base space of a topological fiber bundle core, as a convenience function for dot notation -/
@[nolint unused_arguments, reducible]
def base := B

/-- The fiber of a topological fiber bundle core, as a convenience function for dot notation and
typeclass inference -/
@[nolint unused_arguments has_inhabited_instance]
def fiber (x : B) := F

instance topological_space_fiber (x : B) : topological_space (Z.fiber x) :=
by { dsimp [fiber], apply_instance }

/-- The total space of the topological fiber bundle, as a convenience function for dot notation.
It is by definition equal to `bundle.total_space Z.fiber`, a.k.a. `Σ x, Z.fiber x` but with a
different name for typeclass inference. -/
@[nolint unused_arguments, reducible]
def total_space := bundle.total_space Z.fiber

/-- The projection from the total space of a topological fiber bundle core, on its base. -/
@[reducible, simp, mfld_simps] def proj : Z.total_space → B := bundle.proj Z.fiber

/-- Local homeomorphism version of the trivialization change. -/
def triv_change (i j : ι) : local_homeomorph (B × F) (B × F) :=
{ source      := set.prod (Z.base_set i ∩ Z.base_set j) univ,
  target      := set.prod (Z.base_set i ∩ Z.base_set j) univ,
  to_fun      := λp, ⟨p.1, Z.coord_change i j p.1 p.2⟩,
  inv_fun     := λp, ⟨p.1, Z.coord_change j i p.1 p.2⟩,
  map_source' := λp hp, by simpa using hp,
  map_target' := λp hp, by simpa using hp,
  left_inv'   := begin
    rintros ⟨x, v⟩ hx,
    simp only [prod_mk_mem_set_prod_eq, mem_inter_eq, and_true, mem_univ] at hx,
    rw [Z.coord_change_comp, Z.coord_change_self],
    { exact hx.1 },
    { simp [hx] }
  end,
  right_inv'  := begin
    rintros ⟨x, v⟩ hx,
    simp only [prod_mk_mem_set_prod_eq, mem_inter_eq, and_true, mem_univ] at hx,
    rw [Z.coord_change_comp, Z.coord_change_self],
    { exact hx.2 },
    { simp [hx] },
  end,
  open_source :=
    (is_open_inter (Z.is_open_base_set i) (Z.is_open_base_set j)).prod is_open_univ,
  open_target :=
    (is_open_inter (Z.is_open_base_set i) (Z.is_open_base_set j)).prod is_open_univ,
  continuous_to_fun  :=
    continuous_on.prod continuous_fst.continuous_on (Z.coord_change_continuous i j),
  continuous_inv_fun := by simpa [inter_comm]
    using continuous_on.prod continuous_fst.continuous_on (Z.coord_change_continuous j i) }

@[simp, mfld_simps] lemma mem_triv_change_source (i j : ι) (p : B × F) :
  p ∈ (Z.triv_change i j).source ↔ p.1 ∈ Z.base_set i ∩ Z.base_set j :=
by { erw [mem_prod], simp }

/-- Associate to a trivialization index `i : ι` the corresponding trivialization, i.e., a bijection
between `proj ⁻¹ (base_set i)` and `base_set i × F`. As the fiber above `x` is `F` but read in the
chart with index `index_at x`, the trivialization in the fiber above x is by definition the
coordinate change from i to `index_at x`, so it depends on `x`.
The local trivialization will ultimately be a local homeomorphism. For now, we only introduce the
local equiv version, denoted with a prime. In further developments, avoid this auxiliary version,
and use `Z.local_triv` instead.
-/
def local_triv' (i : ι) : local_equiv Z.total_space (B × F) :=
{ source      := Z.proj ⁻¹' (Z.base_set i),
  target      := set.prod (Z.base_set i) univ,
  inv_fun     := λp, ⟨p.1, Z.coord_change i (Z.index_at p.1) p.1 p.2⟩,
  to_fun      := λp, ⟨p.1, Z.coord_change (Z.index_at p.1) i p.1 p.2⟩,
  map_source' := λp hp,
    by simpa only [set.mem_preimage, and_true, set.mem_univ, set.prod_mk_mem_set_prod_eq] using hp,
  map_target' := λp hp,
    by simpa only [set.mem_preimage, and_true, set.mem_univ, set.mem_prod] using hp,
  left_inv'   := begin
    rintros ⟨x, v⟩ hx,
    change x ∈ Z.base_set i at hx,
    dsimp,
    rw [Z.coord_change_comp, Z.coord_change_self],
    { exact Z.mem_base_set_at _ },
    { simp [hx] }
  end,
  right_inv' := begin
    rintros ⟨x, v⟩ hx,
    simp only [prod_mk_mem_set_prod_eq, and_true, mem_univ] at hx,
    rw [Z.coord_change_comp, Z.coord_change_self],
    { exact hx },
    { simp [hx] }
  end }

@[simp, mfld_simps] lemma mem_local_triv'_source (i : ι) (p : Z.total_space) :
  p ∈ (Z.local_triv' i).source ↔ p.1 ∈ Z.base_set i :=
iff.rfl

@[simp, mfld_simps] lemma mem_local_triv'_target (i : ι) (p : B × F) :
  p ∈ (Z.local_triv' i).target ↔ p.1 ∈ Z.base_set i :=
by { erw [mem_prod], simp }

@[simp, mfld_simps] lemma local_triv'_apply (i : ι) (p : Z.total_space) :
  (Z.local_triv' i) p = ⟨p.1, Z.coord_change (Z.index_at p.1) i p.1 p.2⟩ := rfl

@[simp, mfld_simps] lemma local_triv'_symm_apply (i : ι) (p : B × F) :
  (Z.local_triv' i).symm p = ⟨p.1, Z.coord_change i (Z.index_at p.1) p.1 p.2⟩ := rfl

/-- The composition of two local trivializations is the trivialization change Z.triv_change i j. -/
lemma local_triv'_trans (i j : ι) :
  (Z.local_triv' i).symm.trans (Z.local_triv' j) ≈ (Z.triv_change i j).to_local_equiv :=
begin
  split,
  { ext x, erw [mem_prod], simp [local_equiv.trans_source] },
  { rintros ⟨x, v⟩ hx,
    simp only [triv_change, local_triv', local_equiv.symm, true_and, prod_mk_mem_set_prod_eq,
      local_equiv.trans_source, mem_inter_eq, and_true, mem_univ, prod.mk.inj_iff, mem_preimage,
      proj, local_equiv.coe_mk, eq_self_iff_true, local_equiv.coe_trans, bundle.proj] at hx ⊢,
    simp [Z.coord_change_comp, hx], }
end

/-- Topological structure on the total space of a topological bundle created from core, designed so
that all the local trivialization are continuous. -/
instance to_topological_space : topological_space (bundle.total_space Z.fiber) :=
topological_space.generate_from $ ⋃ (i : ι) (s : set (B × F)) (s_open : is_open s),
  {(Z.local_triv' i).source ∩ (Z.local_triv' i) ⁻¹' s}

lemma open_source' (i : ι) : is_open (Z.local_triv' i).source :=
begin
  apply topological_space.generate_open.basic,
  simp only [exists_prop, mem_Union, mem_singleton_iff],
  refine ⟨i, set.prod (Z.base_set i) univ, (Z.is_open_base_set i).prod is_open_univ, _⟩,
  ext p,
  simp only with mfld_simps
end

lemma open_target' (i : ι) : is_open (Z.local_triv' i).target :=
(Z.is_open_base_set i).prod is_open_univ

/-- Local trivialization of a topological bundle created from core, as a local homeomorphism. -/
def local_triv (i : ι) : local_homeomorph Z.total_space (B × F) :=
{ open_source := Z.open_source' i,
  open_target := Z.open_target' i,
  continuous_to_fun := begin
    rw continuous_on_open_iff (Z.open_source' i),
    assume s s_open,
    apply topological_space.generate_open.basic,
    simp only [exists_prop, mem_Union, mem_singleton_iff],
    exact ⟨i, s, s_open, rfl⟩
  end,
  continuous_inv_fun := begin
    apply continuous_on_open_of_generate_from (Z.open_target' i),
    assume t ht,
    simp only [exists_prop, mem_Union, mem_singleton_iff] at ht,
    obtain ⟨j, s, s_open, ts⟩ : ∃ j s,
      is_open s ∧ t = (local_triv' Z j).source ∩ (local_triv' Z j) ⁻¹' s := ht,
    rw ts,
    simp only [local_equiv.right_inv, preimage_inter, local_equiv.left_inv],
    let e := Z.local_triv' i,
    let e' := Z.local_triv' j,
    let f := e.symm.trans e',
    have : is_open (f.source ∩ f ⁻¹' s),
    { rw [(Z.local_triv'_trans i j).source_inter_preimage_eq],
      exact (continuous_on_open_iff (Z.triv_change i j).open_source).1
        ((Z.triv_change i j).continuous_on) _ s_open },
    convert this using 1,
    dsimp [local_equiv.trans_source],
    rw [← preimage_comp, inter_assoc]
  end,
  to_local_equiv := Z.local_triv' i }

/- We will now state again the basic properties of the local trivializations, but without primes,
i.e., for the local homeomorphism instead of the local equiv. -/

@[simp, mfld_simps] lemma mem_local_triv_source (i : ι) (p : Z.total_space) :
  p ∈ (Z.local_triv i).source ↔ p.1 ∈ Z.base_set i :=
iff.rfl

@[simp, mfld_simps] lemma mem_local_triv_target (i : ι) (p : B × F) :
  p ∈ (Z.local_triv i).target ↔ p.1 ∈ Z.base_set i :=
by { erw [mem_prod], simp }

@[simp, mfld_simps] lemma local_triv_apply (i : ι) (p : Z.total_space) :
  (Z.local_triv i) p = ⟨p.1, Z.coord_change (Z.index_at p.1) i p.1 p.2⟩ := rfl

@[simp, mfld_simps] lemma local_triv_symm_fst (i : ι) (p : B × F) :
  (Z.local_triv i).symm p = ⟨p.1, Z.coord_change i (Z.index_at p.1) p.1 p.2⟩ := rfl

/-- The composition of two local trivializations is the trivialization change Z.triv_change i j. -/
lemma local_triv_trans (i j : ι) :
  (Z.local_triv i).symm.trans (Z.local_triv j) ≈ Z.triv_change i j :=
Z.local_triv'_trans i j

/-- Extended version of the local trivialization of a fiber bundle constructed from core,
registering additionally in its type that it is a local bundle trivialization. -/
def local_triv_ext (i : ι) : bundle_trivialization F Z.proj :=
{ base_set      := Z.base_set i,
  open_base_set := Z.is_open_base_set i,
  source_eq     := rfl,
  target_eq     := rfl,
  proj_to_fun   := λp hp, by simp,
  to_local_homeomorph := Z.local_triv i }

/-- A topological fiber bundle constructed from core is indeed a topological fiber bundle. -/
protected theorem is_topological_fiber_bundle : is_topological_fiber_bundle F Z.proj :=
λx, ⟨Z.local_triv_ext (Z.index_at x), Z.mem_base_set_at x⟩

/-- The projection on the base of a topological bundle created from core is continuous -/
lemma continuous_proj : continuous Z.proj :=
Z.is_topological_fiber_bundle.continuous_proj

/-- The projection on the base of a topological bundle created from core is an open map -/
lemma is_open_map_proj : is_open_map Z.proj :=
Z.is_topological_fiber_bundle.is_open_map_proj

/-- Preferred local trivialization of a fiber bundle constructed from core, at a given point, as
a local homeomorphism -/
def local_triv_at (p : Z.total_space) :
  local_homeomorph Z.total_space (B × F) :=
Z.local_triv (Z.index_at (Z.proj p))

@[simp, mfld_simps] lemma mem_local_triv_at_source (p : Z.total_space) :
  p ∈ (Z.local_triv_at p).source :=
by simp [local_triv_at]

@[simp, mfld_simps] lemma local_triv_at_fst (p q : Z.total_space) :
  ((Z.local_triv_at p) q).1 = q.1 := rfl

@[simp, mfld_simps] lemma local_triv_at_symm_fst (p : Z.total_space) (q : B × F) :
  ((Z.local_triv_at p).symm q).1 = q.1 := rfl

/-- Preferred local trivialization of a fiber bundle constructed from core, at a given point, as
a bundle trivialization -/
def local_triv_at_ext (p : Z.total_space) : bundle_trivialization F Z.proj :=
Z.local_triv_ext (Z.index_at (Z.proj p))

@[simp, mfld_simps] lemma local_triv_at_ext_to_local_homeomorph (p : Z.total_space) :
  (Z.local_triv_at_ext p).to_local_homeomorph = Z.local_triv_at p := rfl

/-- If an element of `F` is invariant under all coordinate changes, then one can define a
corresponding section of the fiber bundle, which is continuous. This applies in particular to the
zero section of a vector bundle. Another example (not yet defined) would be the identity
section of the endomorphism bundle of a vector bundle. -/
lemma continuous_const_section (v : F)
  (h : ∀ i j, ∀ x ∈ (Z.base_set i) ∩ (Z.base_set j), Z.coord_change i j x v = v) :
  continuous (show B → Z.total_space, from λ x, ⟨x, v⟩) :=
begin
  apply continuous_iff_continuous_at.2 (λ x, _),
  have A : Z.base_set (Z.index_at x) ∈ 𝓝 x :=
    mem_nhds_sets (Z.is_open_base_set (Z.index_at x)) (Z.mem_base_set_at x),
  apply ((Z.local_triv (Z.index_at x)).continuous_at_iff_continuous_at_comp_left _).2,
  { simp only [(∘)] with mfld_simps,
    apply continuous_at_id.prod,
    have : continuous_on (λ (y : B), v) (Z.base_set (Z.index_at x)) := continuous_on_const,
    apply (this.congr _).continuous_at A,
    assume y hy,
    simp only [h, hy] with mfld_simps },
  { exact A }
end

end topological_fiber_bundle_core


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Abhimanyu Pallavi Sudhir, Jean Lo, Calle Sönne
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.complex.exponential
import Mathlib.analysis.calculus.mean_value
import Mathlib.measure_theory.borel_space
import Mathlib.analysis.complex.real_deriv
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# Complex and real exponential, real logarithm

## Main statements

This file establishes the basic analytical properties of the complex and real exponential functions
(continuity, differentiability, computation of the derivative).

It also contains the definition of the real logarithm function (as the inverse of the
exponential on `(0, +∞)`, extended to `ℝ` by setting `log (-x) = log x`) and its basic
properties (continuity, differentiability, formula for the derivative).

The complex logarithm is *not* defined in this file as it relies on trigonometric functions. See
instead `trigonometric.lean`.

## Tags

exp, log
-/

namespace complex

/-- The complex exponential is everywhere differentiable, with the derivative `exp x`. -/
theorem has_deriv_at_exp (x : ℂ) : has_deriv_at exp (exp x) x := sorry

theorem differentiable_exp : differentiable ℂ exp :=
  fun (x : ℂ) => has_deriv_at.differentiable_at (has_deriv_at_exp x)

theorem differentiable_at_exp {x : ℂ} : differentiable_at ℂ exp x :=
  differentiable_exp x

@[simp] theorem deriv_exp : deriv exp = exp :=
  funext fun (x : ℂ) => has_deriv_at.deriv (has_deriv_at_exp x)

@[simp] theorem iter_deriv_exp (n : ℕ) : nat.iterate deriv n exp = exp := sorry

theorem continuous_exp : continuous exp :=
  differentiable.continuous differentiable_exp

theorem times_cont_diff_exp {n : with_top ℕ} : times_cont_diff ℂ n exp := sorry

theorem measurable_exp : measurable exp :=
  continuous.measurable continuous_exp

end complex

theorem has_deriv_at.cexp {f : ℂ → ℂ} {f' : ℂ} {x : ℂ} (hf : has_deriv_at f f' x) : has_deriv_at (fun (x : ℂ) => complex.exp (f x)) (complex.exp (f x) * f') x :=
  has_deriv_at.comp x (complex.has_deriv_at_exp (f x)) hf

theorem has_deriv_within_at.cexp {f : ℂ → ℂ} {f' : ℂ} {x : ℂ} {s : set ℂ} (hf : has_deriv_within_at f f' s x) : has_deriv_within_at (fun (x : ℂ) => complex.exp (f x)) (complex.exp (f x) * f') s x :=
  has_deriv_at.comp_has_deriv_within_at x (complex.has_deriv_at_exp (f x)) hf

theorem deriv_within_cexp {f : ℂ → ℂ} {x : ℂ} {s : set ℂ} (hf : differentiable_within_at ℂ f s x) (hxs : unique_diff_within_at ℂ s x) : deriv_within (fun (x : ℂ) => complex.exp (f x)) s x = complex.exp (f x) * deriv_within f s x :=
  has_deriv_within_at.deriv_within (has_deriv_within_at.cexp (differentiable_within_at.has_deriv_within_at hf)) hxs

@[simp] theorem deriv_cexp {f : ℂ → ℂ} {x : ℂ} (hc : differentiable_at ℂ f x) : deriv (fun (x : ℂ) => complex.exp (f x)) x = complex.exp (f x) * deriv f x :=
  has_deriv_at.deriv (has_deriv_at.cexp (differentiable_at.has_deriv_at hc))

theorem measurable.cexp {α : Type u_1} [measurable_space α] {f : α → ℂ} (hf : measurable f) : measurable fun (x : α) => complex.exp (f x) :=
  measurable.comp complex.measurable_exp hf

theorem has_fderiv_within_at.cexp {E : Type u_1} [normed_group E] [normed_space ℂ E] {f : E → ℂ} {f' : continuous_linear_map ℂ E ℂ} {x : E} {s : set E} (hf : has_fderiv_within_at f f' s x) : has_fderiv_within_at (fun (x : E) => complex.exp (f x)) (complex.exp (f x) • f') s x :=
  has_deriv_at.comp_has_fderiv_within_at x (complex.has_deriv_at_exp (f x)) hf

theorem has_fderiv_at.cexp {E : Type u_1} [normed_group E] [normed_space ℂ E] {f : E → ℂ} {f' : continuous_linear_map ℂ E ℂ} {x : E} (hf : has_fderiv_at f f' x) : has_fderiv_at (fun (x : E) => complex.exp (f x)) (complex.exp (f x) • f') x :=
  iff.mp has_fderiv_within_at_univ (has_fderiv_within_at.cexp (has_fderiv_at.has_fderiv_within_at hf))

theorem differentiable_within_at.cexp {E : Type u_1} [normed_group E] [normed_space ℂ E] {f : E → ℂ} {x : E} {s : set E} (hf : differentiable_within_at ℂ f s x) : differentiable_within_at ℂ (fun (x : E) => complex.exp (f x)) s x :=
  has_fderiv_within_at.differentiable_within_at
    (has_fderiv_within_at.cexp (differentiable_within_at.has_fderiv_within_at hf))

@[simp] theorem differentiable_at.cexp {E : Type u_1} [normed_group E] [normed_space ℂ E] {f : E → ℂ} {x : E} (hc : differentiable_at ℂ f x) : differentiable_at ℂ (fun (x : E) => complex.exp (f x)) x :=
  has_fderiv_at.differentiable_at (has_fderiv_at.cexp (differentiable_at.has_fderiv_at hc))

theorem differentiable_on.cexp {E : Type u_1} [normed_group E] [normed_space ℂ E] {f : E → ℂ} {s : set E} (hc : differentiable_on ℂ f s) : differentiable_on ℂ (fun (x : E) => complex.exp (f x)) s :=
  fun (x : E) (h : x ∈ s) => differentiable_within_at.cexp (hc x h)

@[simp] theorem differentiable.cexp {E : Type u_1} [normed_group E] [normed_space ℂ E] {f : E → ℂ} (hc : differentiable ℂ f) : differentiable ℂ fun (x : E) => complex.exp (f x) :=
  fun (x : E) => differentiable_at.cexp (hc x)

theorem times_cont_diff.cexp {E : Type u_1} [normed_group E] [normed_space ℂ E] {f : E → ℂ} {n : with_top ℕ} (h : times_cont_diff ℂ n f) : times_cont_diff ℂ n fun (x : E) => complex.exp (f x) :=
  times_cont_diff.comp complex.times_cont_diff_exp h

theorem times_cont_diff_at.cexp {E : Type u_1} [normed_group E] [normed_space ℂ E] {f : E → ℂ} {x : E} {n : with_top ℕ} (hf : times_cont_diff_at ℂ n f x) : times_cont_diff_at ℂ n (fun (x : E) => complex.exp (f x)) x :=
  times_cont_diff_at.comp x (times_cont_diff.times_cont_diff_at complex.times_cont_diff_exp) hf

theorem times_cont_diff_on.cexp {E : Type u_1} [normed_group E] [normed_space ℂ E] {f : E → ℂ} {s : set E} {n : with_top ℕ} (hf : times_cont_diff_on ℂ n f s) : times_cont_diff_on ℂ n (fun (x : E) => complex.exp (f x)) s :=
  times_cont_diff.comp_times_cont_diff_on complex.times_cont_diff_exp hf

theorem times_cont_diff_within_at.cexp {E : Type u_1} [normed_group E] [normed_space ℂ E] {f : E → ℂ} {x : E} {s : set E} {n : with_top ℕ} (hf : times_cont_diff_within_at ℂ n f s x) : times_cont_diff_within_at ℂ n (fun (x : E) => complex.exp (f x)) s x :=
  times_cont_diff_at.comp_times_cont_diff_within_at x (times_cont_diff.times_cont_diff_at complex.times_cont_diff_exp) hf

namespace real

theorem has_deriv_at_exp (x : ℝ) : has_deriv_at exp (exp x) x :=
  has_deriv_at.real_of_complex (complex.has_deriv_at_exp ↑x)

theorem times_cont_diff_exp {n : with_top ℕ} : times_cont_diff ℝ n exp :=
  times_cont_diff.real_of_complex complex.times_cont_diff_exp

theorem differentiable_exp : differentiable ℝ exp :=
  fun (x : ℝ) => has_deriv_at.differentiable_at (has_deriv_at_exp x)

theorem differentiable_at_exp {x : ℝ} : differentiable_at ℝ exp x :=
  differentiable_exp x

@[simp] theorem deriv_exp : deriv exp = exp :=
  funext fun (x : ℝ) => has_deriv_at.deriv (has_deriv_at_exp x)

@[simp] theorem iter_deriv_exp (n : ℕ) : nat.iterate deriv n exp = exp := sorry

theorem continuous_exp : continuous exp :=
  differentiable.continuous differentiable_exp

theorem measurable_exp : measurable exp :=
  continuous.measurable continuous_exp

end real

/-! Register lemmas for the derivatives of the composition of `real.exp` with a differentiable
function, for standalone use and use with `simp`. -/

theorem has_deriv_at.exp {f : ℝ → ℝ} {f' : ℝ} {x : ℝ} (hf : has_deriv_at f f' x) : has_deriv_at (fun (x : ℝ) => real.exp (f x)) (real.exp (f x) * f') x :=
  has_deriv_at.comp x (real.has_deriv_at_exp (f x)) hf

theorem has_deriv_within_at.exp {f : ℝ → ℝ} {f' : ℝ} {x : ℝ} {s : set ℝ} (hf : has_deriv_within_at f f' s x) : has_deriv_within_at (fun (x : ℝ) => real.exp (f x)) (real.exp (f x) * f') s x :=
  has_deriv_at.comp_has_deriv_within_at x (real.has_deriv_at_exp (f x)) hf

theorem deriv_within_exp {f : ℝ → ℝ} {x : ℝ} {s : set ℝ} (hf : differentiable_within_at ℝ f s x) (hxs : unique_diff_within_at ℝ s x) : deriv_within (fun (x : ℝ) => real.exp (f x)) s x = real.exp (f x) * deriv_within f s x :=
  has_deriv_within_at.deriv_within (has_deriv_within_at.exp (differentiable_within_at.has_deriv_within_at hf)) hxs

@[simp] theorem deriv_exp {f : ℝ → ℝ} {x : ℝ} (hc : differentiable_at ℝ f x) : deriv (fun (x : ℝ) => real.exp (f x)) x = real.exp (f x) * deriv f x :=
  has_deriv_at.deriv (has_deriv_at.exp (differentiable_at.has_deriv_at hc))

/-! Register lemmas for the derivatives of the composition of `real.exp` with a differentiable
function, for standalone use and use with `simp`. -/

theorem measurable.exp {α : Type u_1} [measurable_space α] {f : α → ℝ} (hf : measurable f) : measurable fun (x : α) => real.exp (f x) :=
  measurable.comp real.measurable_exp hf

theorem times_cont_diff.exp {E : Type u_1} [normed_group E] [normed_space ℝ E] {f : E → ℝ} {n : with_top ℕ} (hf : times_cont_diff ℝ n f) : times_cont_diff ℝ n fun (x : E) => real.exp (f x) :=
  times_cont_diff.comp real.times_cont_diff_exp hf

theorem times_cont_diff_at.exp {E : Type u_1} [normed_group E] [normed_space ℝ E] {f : E → ℝ} {x : E} {n : with_top ℕ} (hf : times_cont_diff_at ℝ n f x) : times_cont_diff_at ℝ n (fun (x : E) => real.exp (f x)) x :=
  times_cont_diff_at.comp x (times_cont_diff.times_cont_diff_at real.times_cont_diff_exp) hf

theorem times_cont_diff_on.exp {E : Type u_1} [normed_group E] [normed_space ℝ E] {f : E → ℝ} {s : set E} {n : with_top ℕ} (hf : times_cont_diff_on ℝ n f s) : times_cont_diff_on ℝ n (fun (x : E) => real.exp (f x)) s :=
  times_cont_diff.comp_times_cont_diff_on real.times_cont_diff_exp hf

theorem times_cont_diff_within_at.exp {E : Type u_1} [normed_group E] [normed_space ℝ E] {f : E → ℝ} {x : E} {s : set E} {n : with_top ℕ} (hf : times_cont_diff_within_at ℝ n f s x) : times_cont_diff_within_at ℝ n (fun (x : E) => real.exp (f x)) s x :=
  times_cont_diff_at.comp_times_cont_diff_within_at x (times_cont_diff.times_cont_diff_at real.times_cont_diff_exp) hf

theorem has_fderiv_within_at.exp {E : Type u_1} [normed_group E] [normed_space ℝ E] {f : E → ℝ} {f' : continuous_linear_map ℝ E ℝ} {x : E} {s : set E} (hf : has_fderiv_within_at f f' s x) : has_fderiv_within_at (fun (x : E) => real.exp (f x)) (real.exp (f x) • f') s x := sorry

theorem has_fderiv_at.exp {E : Type u_1} [normed_group E] [normed_space ℝ E] {f : E → ℝ} {f' : continuous_linear_map ℝ E ℝ} {x : E} (hf : has_fderiv_at f f' x) : has_fderiv_at (fun (x : E) => real.exp (f x)) (real.exp (f x) • f') x :=
  iff.mp has_fderiv_within_at_univ (has_fderiv_within_at.exp (has_fderiv_at.has_fderiv_within_at hf))

theorem differentiable_within_at.exp {E : Type u_1} [normed_group E] [normed_space ℝ E] {f : E → ℝ} {x : E} {s : set E} (hf : differentiable_within_at ℝ f s x) : differentiable_within_at ℝ (fun (x : E) => real.exp (f x)) s x :=
  has_fderiv_within_at.differentiable_within_at
    (has_fderiv_within_at.exp (differentiable_within_at.has_fderiv_within_at hf))

@[simp] theorem differentiable_at.exp {E : Type u_1} [normed_group E] [normed_space ℝ E] {f : E → ℝ} {x : E} (hc : differentiable_at ℝ f x) : differentiable_at ℝ (fun (x : E) => real.exp (f x)) x :=
  has_fderiv_at.differentiable_at (has_fderiv_at.exp (differentiable_at.has_fderiv_at hc))

theorem differentiable_on.exp {E : Type u_1} [normed_group E] [normed_space ℝ E] {f : E → ℝ} {s : set E} (hc : differentiable_on ℝ f s) : differentiable_on ℝ (fun (x : E) => real.exp (f x)) s :=
  fun (x : E) (h : x ∈ s) => differentiable_within_at.exp (hc x h)

@[simp] theorem differentiable.exp {E : Type u_1} [normed_group E] [normed_space ℝ E] {f : E → ℝ} (hc : differentiable ℝ f) : differentiable ℝ fun (x : E) => real.exp (f x) :=
  fun (x : E) => differentiable_at.exp (hc x)

theorem fderiv_within_exp {E : Type u_1} [normed_group E] [normed_space ℝ E] {f : E → ℝ} {x : E} {s : set E} (hf : differentiable_within_at ℝ f s x) (hxs : unique_diff_within_at ℝ s x) : fderiv_within ℝ (fun (x : E) => real.exp (f x)) s x = real.exp (f x) • fderiv_within ℝ f s x :=
  has_fderiv_within_at.fderiv_within (has_fderiv_within_at.exp (differentiable_within_at.has_fderiv_within_at hf)) hxs

@[simp] theorem fderiv_exp {E : Type u_1} [normed_group E] [normed_space ℝ E] {f : E → ℝ} {x : E} (hc : differentiable_at ℝ f x) : fderiv ℝ (fun (x : E) => real.exp (f x)) x = real.exp (f x) • fderiv ℝ f x :=
  has_fderiv_at.fderiv (has_fderiv_at.exp (differentiable_at.has_fderiv_at hc))

namespace real

/-- The real exponential function tends to `+∞` at `+∞`. -/
theorem tendsto_exp_at_top : filter.tendsto exp filter.at_top filter.at_top :=
  filter.tendsto_at_top_mono' filter.at_top
    (iff.mpr filter.eventually_at_top (Exists.intro 0 fun (x : ℝ) (hx : x ≥ 0) => add_one_le_exp_of_nonneg hx))
    (filter.tendsto_at_top_add_const_right filter.at_top 1 filter.tendsto_id)

/-- The real exponential function tends to `0` at `-∞` or, equivalently, `exp(-x)` tends to `0`
at `+∞` -/
theorem tendsto_exp_neg_at_top_nhds_0 : filter.tendsto (fun (x : ℝ) => exp (-x)) filter.at_top (nhds 0) :=
  filter.tendsto.congr (fun (x : ℝ) => Eq.symm (exp_neg x))
    (filter.tendsto.comp tendsto_inv_at_top_zero tendsto_exp_at_top)

/-- The real exponential function tends to `1` at `0`. -/
theorem tendsto_exp_nhds_0_nhds_1 : filter.tendsto exp (nhds 0) (nhds 1) := sorry

theorem tendsto_exp_at_bot : filter.tendsto exp filter.at_bot (nhds 0) :=
  filter.tendsto.congr (fun (x : ℝ) => congr_arg exp (neg_neg x))
    (filter.tendsto.comp tendsto_exp_neg_at_top_nhds_0 filter.tendsto_neg_at_bot_at_top)

theorem tendsto_exp_at_bot_nhds_within : filter.tendsto exp filter.at_bot (nhds_within 0 (set.Ioi 0)) :=
  iff.mpr filter.tendsto_inf
    { left := tendsto_exp_at_bot, right := iff.mpr filter.tendsto_principal (filter.eventually_of_forall exp_pos) }

/-- `real.exp` as an order isomorphism between `ℝ` and `(0, +∞)`. -/
def exp_order_iso : ℝ ≃o ↥(set.Ioi 0) :=
  strict_mono.order_iso_of_surjective (set.cod_restrict exp (set.Ioi 0) exp_pos) sorry sorry

@[simp] theorem coe_exp_order_iso_apply (x : ℝ) : ↑(coe_fn exp_order_iso x) = exp x :=
  rfl

@[simp] theorem coe_comp_exp_order_iso : coe ∘ ⇑exp_order_iso = exp :=
  rfl

@[simp] theorem range_exp : set.range exp = set.Ioi 0 := sorry

@[simp] theorem map_exp_at_top : filter.map exp filter.at_top = filter.at_top := sorry

@[simp] theorem comap_exp_at_top : filter.comap exp filter.at_top = filter.at_top := sorry

@[simp] theorem tendsto_exp_comp_at_top {α : Type u_1} {l : filter α} {f : α → ℝ} : filter.tendsto (fun (x : α) => exp (f x)) l filter.at_top ↔ filter.tendsto f l filter.at_top := sorry

theorem tendsto_comp_exp_at_top {α : Type u_1} {l : filter α} {f : ℝ → α} : filter.tendsto (fun (x : ℝ) => f (exp x)) filter.at_top l ↔ filter.tendsto f filter.at_top l := sorry

@[simp] theorem map_exp_at_bot : filter.map exp filter.at_bot = nhds_within 0 (set.Ioi 0) := sorry

theorem comap_exp_nhds_within_Ioi_zero : filter.comap exp (nhds_within 0 (set.Ioi 0)) = filter.at_bot := sorry

theorem tendsto_comp_exp_at_bot {α : Type u_1} {l : filter α} {f : ℝ → α} : filter.tendsto (fun (x : ℝ) => f (exp x)) filter.at_bot l ↔ filter.tendsto f (nhds_within 0 (set.Ioi 0)) l := sorry

/-- The real logarithm function, equal to the inverse of the exponential for `x > 0`,
to `log |x|` for `x < 0`, and to `0` for `0`. We use this unconventional extension to
`(-∞, 0]` as it gives the formula `log (x * y) = log x + log y` for all nonzero `x` and `y`, and
the derivative of `log` is `1/x` away from `0`. -/
def log (x : ℝ) : ℝ :=
  dite (x = 0) (fun (hx : x = 0) => 0)
    fun (hx : ¬x = 0) => coe_fn (order_iso.symm exp_order_iso) { val := abs x, property := sorry }

theorem log_of_ne_zero {x : ℝ} (hx : x ≠ 0) : log x = coe_fn (order_iso.symm exp_order_iso) { val := abs x, property := iff.mpr abs_pos hx } :=
  dif_neg hx

theorem log_of_pos {x : ℝ} (hx : 0 < x) : log x = coe_fn (order_iso.symm exp_order_iso) { val := x, property := hx } := sorry

theorem exp_log_eq_abs {x : ℝ} (hx : x ≠ 0) : exp (log x) = abs x := sorry

theorem exp_log {x : ℝ} (hx : 0 < x) : exp (log x) = x :=
  eq.mpr (id (Eq._oldrec (Eq.refl (exp (log x) = x)) (exp_log_eq_abs (has_lt.lt.ne' hx)))) (abs_of_pos hx)

theorem exp_log_of_neg {x : ℝ} (hx : x < 0) : exp (log x) = -x :=
  eq.mpr (id (Eq._oldrec (Eq.refl (exp (log x) = -x)) (exp_log_eq_abs (ne_of_lt hx)))) (abs_of_neg hx)

@[simp] theorem log_exp (x : ℝ) : log (exp x) = x :=
  exp_injective (exp_log (exp_pos x))

theorem surj_on_log : set.surj_on log (set.Ioi 0) set.univ :=
  fun (x : ℝ) (_x : x ∈ set.univ) => Exists.intro (exp x) { left := exp_pos x, right := log_exp x }

theorem log_surjective : function.surjective log :=
  fun (x : ℝ) => Exists.intro (exp x) (log_exp x)

@[simp] theorem range_log : set.range log = set.univ :=
  function.surjective.range_eq log_surjective

@[simp] theorem log_zero : log 0 = 0 :=
  dif_pos rfl

@[simp] theorem log_one : log 1 = 0 :=
  exp_injective
    (eq.mpr (id (Eq._oldrec (Eq.refl (exp (log 1) = exp 0)) (exp_log zero_lt_one)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (1 = exp 0)) exp_zero)) (Eq.refl 1)))

@[simp] theorem log_abs (x : ℝ) : log (abs x) = log x := sorry

@[simp] theorem log_neg_eq_log (x : ℝ) : log (-x) = log x :=
  eq.mpr (id (Eq._oldrec (Eq.refl (log (-x) = log x)) (Eq.symm (log_abs x))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (log (-x) = log (abs x))) (Eq.symm (log_abs (-x)))))
      (eq.mpr (id (Eq._oldrec (Eq.refl (log (abs (-x)) = log (abs x))) (abs_neg x))) (Eq.refl (log (abs x)))))

theorem surj_on_log' : set.surj_on log (set.Iio 0) set.univ := sorry

theorem log_mul {x : ℝ} {y : ℝ} (hx : x ≠ 0) (hy : y ≠ 0) : log (x * y) = log x + log y := sorry

@[simp] theorem log_inv (x : ℝ) : log (x⁻¹) = -log x := sorry

theorem log_le_log {x : ℝ} {y : ℝ} (h : 0 < x) (h₁ : 0 < y) : log x ≤ log y ↔ x ≤ y :=
  eq.mpr (id (Eq._oldrec (Eq.refl (log x ≤ log y ↔ x ≤ y)) (Eq.symm (propext exp_le_exp))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (exp (log x) ≤ exp (log y) ↔ x ≤ y)) (exp_log h)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (x ≤ exp (log y) ↔ x ≤ y)) (exp_log h₁))) (iff.refl (x ≤ y))))

theorem log_lt_log {x : ℝ} {y : ℝ} (hx : 0 < x) : x < y → log x < log y := sorry

theorem log_lt_log_iff {x : ℝ} {y : ℝ} (hx : 0 < x) (hy : 0 < y) : log x < log y ↔ x < y :=
  eq.mpr (id (Eq._oldrec (Eq.refl (log x < log y ↔ x < y)) (Eq.symm (propext exp_lt_exp))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (exp (log x) < exp (log y) ↔ x < y)) (exp_log hx)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (x < exp (log y) ↔ x < y)) (exp_log hy))) (iff.refl (x < y))))

theorem log_pos_iff {x : ℝ} (hx : 0 < x) : 0 < log x ↔ 1 < x :=
  eq.mpr (id (Eq._oldrec (Eq.refl (0 < log x ↔ 1 < x)) (Eq.symm log_one))) (log_lt_log_iff zero_lt_one hx)

theorem log_pos {x : ℝ} (hx : 1 < x) : 0 < log x :=
  iff.mpr (log_pos_iff (lt_trans zero_lt_one hx)) hx

theorem log_neg_iff {x : ℝ} (h : 0 < x) : log x < 0 ↔ x < 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (log x < 0 ↔ x < 1)) (Eq.symm log_one))) (log_lt_log_iff h zero_lt_one)

theorem log_neg {x : ℝ} (h0 : 0 < x) (h1 : x < 1) : log x < 0 :=
  iff.mpr (log_neg_iff h0) h1

theorem log_nonneg_iff {x : ℝ} (hx : 0 < x) : 0 ≤ log x ↔ 1 ≤ x :=
  eq.mpr (id (Eq._oldrec (Eq.refl (0 ≤ log x ↔ 1 ≤ x)) (Eq.symm (propext not_lt))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (¬log x < 0 ↔ 1 ≤ x)) (propext (log_neg_iff hx))))
      (eq.mpr (id (Eq._oldrec (Eq.refl (¬x < 1 ↔ 1 ≤ x)) (propext not_lt))) (iff.refl (1 ≤ x))))

theorem log_nonneg {x : ℝ} (hx : 1 ≤ x) : 0 ≤ log x :=
  iff.mpr (log_nonneg_iff (has_lt.lt.trans_le zero_lt_one hx)) hx

theorem log_nonpos_iff {x : ℝ} (hx : 0 < x) : log x ≤ 0 ↔ x ≤ 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (log x ≤ 0 ↔ x ≤ 1)) (Eq.symm (propext not_lt))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (¬0 < log x ↔ x ≤ 1)) (propext (log_pos_iff hx))))
      (eq.mpr (id (Eq._oldrec (Eq.refl (¬1 < x ↔ x ≤ 1)) (propext not_lt))) (iff.refl (x ≤ 1))))

theorem log_nonpos_iff' {x : ℝ} (hx : 0 ≤ x) : log x ≤ 0 ↔ x ≤ 1 := sorry

theorem log_nonpos {x : ℝ} (hx : 0 ≤ x) (h'x : x ≤ 1) : log x ≤ 0 :=
  iff.mpr (log_nonpos_iff' hx) h'x

theorem strict_mono_incr_on_log : strict_mono_incr_on log (set.Ioi 0) :=
  fun (x : ℝ) (hx : x ∈ set.Ioi 0) (y : ℝ) (hy : y ∈ set.Ioi 0) (hxy : x < y) => log_lt_log hx hxy

theorem strict_mono_decr_on_log : strict_mono_decr_on log (set.Iio 0) := sorry

/-- The real logarithm function tends to `+∞` at `+∞`. -/
theorem tendsto_log_at_top : filter.tendsto log filter.at_top filter.at_top := sorry

theorem tendsto_log_nhds_within_zero : filter.tendsto log (nhds_within 0 (singleton 0ᶜ)) filter.at_bot := sorry

theorem continuous_on_log : continuous_on log (singleton 0ᶜ) := sorry

theorem continuous_log' : continuous fun (x : Subtype fun (x : ℝ) => 0 < x) => log ↑x := sorry

theorem continuous_at_log {x : ℝ} (hx : x ≠ 0) : continuous_at log x :=
  continuous_within_at.continuous_at (continuous_on_log x hx) (mem_nhds_sets is_open_compl_singleton hx)

@[simp] theorem continuous_at_log_iff {x : ℝ} : continuous_at log x ↔ x ≠ 0 := sorry

theorem has_deriv_at_log_of_pos {x : ℝ} (hx : 0 < x) : has_deriv_at log (x⁻¹) x := sorry

theorem has_deriv_at_log {x : ℝ} (hx : x ≠ 0) : has_deriv_at log (x⁻¹) x := sorry

theorem differentiable_at_log {x : ℝ} (hx : x ≠ 0) : differentiable_at ℝ log x :=
  has_deriv_at.differentiable_at (has_deriv_at_log hx)

theorem differentiable_on_log : differentiable_on ℝ log (singleton 0ᶜ) :=
  fun (x : ℝ) (hx : x ∈ (singleton 0ᶜ)) => differentiable_at.differentiable_within_at (differentiable_at_log hx)

@[simp] theorem differentiable_at_log_iff {x : ℝ} : differentiable_at ℝ log x ↔ x ≠ 0 :=
  { mp := fun (h : differentiable_at ℝ log x) => iff.mp continuous_at_log_iff (differentiable_at.continuous_at h),
    mpr := differentiable_at_log }

theorem deriv_log (x : ℝ) : deriv log x = (x⁻¹) := sorry

@[simp] theorem deriv_log' : deriv log = has_inv.inv :=
  funext deriv_log

theorem measurable_log : measurable log :=
  measurable_of_measurable_on_compl_singleton 0
    (continuous.measurable (iff.mp continuous_on_iff_continuous_restrict continuous_on_log))

theorem times_cont_diff_on_log {n : with_top ℕ} : times_cont_diff_on ℝ n log (singleton 0ᶜ) := sorry

theorem times_cont_diff_at_log {x : ℝ} (hx : x ≠ 0) {n : with_top ℕ} : times_cont_diff_at ℝ n log x :=
  times_cont_diff_within_at.times_cont_diff_at (times_cont_diff_on_log x hx) (mem_nhds_sets is_open_compl_singleton hx)

end real

theorem filter.tendsto.log {α : Type u_1} {f : α → ℝ} {l : filter α} {x : ℝ} (h : filter.tendsto f l (nhds x)) (hx : x ≠ 0) : filter.tendsto (fun (x : α) => real.log (f x)) l (nhds (real.log x)) :=
  filter.tendsto.comp (continuous_at.tendsto (real.continuous_at_log hx)) h

theorem continuous.log {α : Type u_1} [topological_space α] {f : α → ℝ} (hf : continuous f) (h₀ : ∀ (x : α), f x ≠ 0) : continuous fun (x : α) => real.log (f x) :=
  continuous_on.comp_continuous real.continuous_on_log hf h₀

theorem continuous_at.log {α : Type u_1} [topological_space α] {f : α → ℝ} {a : α} (hf : continuous_at f a) (h₀ : f a ≠ 0) : continuous_at (fun (x : α) => real.log (f x)) a :=
  filter.tendsto.log hf h₀

theorem continuous_within_at.log {α : Type u_1} [topological_space α] {f : α → ℝ} {s : set α} {a : α} (hf : continuous_within_at f s a) (h₀ : f a ≠ 0) : continuous_within_at (fun (x : α) => real.log (f x)) s a :=
  filter.tendsto.log hf h₀

theorem continuous_on.log {α : Type u_1} [topological_space α] {f : α → ℝ} {s : set α} (hf : continuous_on f s) (h₀ : ∀ (x : α), x ∈ s → f x ≠ 0) : continuous_on (fun (x : α) => real.log (f x)) s :=
  fun (x : α) (hx : x ∈ s) => continuous_within_at.log (hf x hx) (h₀ x hx)

theorem measurable.log {α : Type u_1} [measurable_space α] {f : α → ℝ} (hf : measurable f) : measurable fun (x : α) => real.log (f x) :=
  measurable.comp real.measurable_log hf

theorem has_deriv_within_at.log {f : ℝ → ℝ} {x : ℝ} {f' : ℝ} {s : set ℝ} (hf : has_deriv_within_at f f' s x) (hx : f x ≠ 0) : has_deriv_within_at (fun (y : ℝ) => real.log (f y)) (f' / f x) s x :=
  eq.mpr (id (Eq._oldrec (Eq.refl (has_deriv_within_at (fun (y : ℝ) => real.log (f y)) (f' / f x) s x)) div_eq_inv_mul))
    (has_deriv_at.comp_has_deriv_within_at x (real.has_deriv_at_log hx) hf)

theorem has_deriv_at.log {f : ℝ → ℝ} {x : ℝ} {f' : ℝ} (hf : has_deriv_at f f' x) (hx : f x ≠ 0) : has_deriv_at (fun (y : ℝ) => real.log (f y)) (f' / f x) x := sorry

theorem deriv_within.log {f : ℝ → ℝ} {x : ℝ} {s : set ℝ} (hf : differentiable_within_at ℝ f s x) (hx : f x ≠ 0) (hxs : unique_diff_within_at ℝ s x) : deriv_within (fun (x : ℝ) => real.log (f x)) s x = deriv_within f s x / f x :=
  has_deriv_within_at.deriv_within (has_deriv_within_at.log (differentiable_within_at.has_deriv_within_at hf) hx) hxs

@[simp] theorem deriv.log {f : ℝ → ℝ} {x : ℝ} (hf : differentiable_at ℝ f x) (hx : f x ≠ 0) : deriv (fun (x : ℝ) => real.log (f x)) x = deriv f x / f x :=
  has_deriv_at.deriv (has_deriv_at.log (differentiable_at.has_deriv_at hf) hx)

theorem has_fderiv_within_at.log {E : Type u_1} [normed_group E] [normed_space ℝ E] {f : E → ℝ} {x : E} {f' : continuous_linear_map ℝ E ℝ} {s : set E} (hf : has_fderiv_within_at f f' s x) (hx : f x ≠ 0) : has_fderiv_within_at (fun (x : E) => real.log (f x)) (f x⁻¹ • f') s x :=
  has_deriv_at.comp_has_fderiv_within_at x (real.has_deriv_at_log hx) hf

theorem has_fderiv_at.log {E : Type u_1} [normed_group E] [normed_space ℝ E] {f : E → ℝ} {x : E} {f' : continuous_linear_map ℝ E ℝ} (hf : has_fderiv_at f f' x) (hx : f x ≠ 0) : has_fderiv_at (fun (x : E) => real.log (f x)) (f x⁻¹ • f') x :=
  has_deriv_at.comp_has_fderiv_at x (real.has_deriv_at_log hx) hf

theorem differentiable_within_at.log {E : Type u_1} [normed_group E] [normed_space ℝ E] {f : E → ℝ} {x : E} {s : set E} (hf : differentiable_within_at ℝ f s x) (hx : f x ≠ 0) : differentiable_within_at ℝ (fun (x : E) => real.log (f x)) s x :=
  has_fderiv_within_at.differentiable_within_at
    (has_fderiv_within_at.log (differentiable_within_at.has_fderiv_within_at hf) hx)

@[simp] theorem differentiable_at.log {E : Type u_1} [normed_group E] [normed_space ℝ E] {f : E → ℝ} {x : E} (hf : differentiable_at ℝ f x) (hx : f x ≠ 0) : differentiable_at ℝ (fun (x : E) => real.log (f x)) x :=
  has_fderiv_at.differentiable_at (has_fderiv_at.log (differentiable_at.has_fderiv_at hf) hx)

theorem differentiable_on.log {E : Type u_1} [normed_group E] [normed_space ℝ E] {f : E → ℝ} {s : set E} (hf : differentiable_on ℝ f s) (hx : ∀ (x : E), x ∈ s → f x ≠ 0) : differentiable_on ℝ (fun (x : E) => real.log (f x)) s :=
  fun (x : E) (h : x ∈ s) => differentiable_within_at.log (hf x h) (hx x h)

@[simp] theorem differentiable.log {E : Type u_1} [normed_group E] [normed_space ℝ E] {f : E → ℝ} (hf : differentiable ℝ f) (hx : ∀ (x : E), f x ≠ 0) : differentiable ℝ fun (x : E) => real.log (f x) :=
  fun (x : E) => differentiable_at.log (hf x) (hx x)

theorem fderiv_within.log {E : Type u_1} [normed_group E] [normed_space ℝ E] {f : E → ℝ} {x : E} {s : set E} (hf : differentiable_within_at ℝ f s x) (hx : f x ≠ 0) (hxs : unique_diff_within_at ℝ s x) : fderiv_within ℝ (fun (x : E) => real.log (f x)) s x = f x⁻¹ • fderiv_within ℝ f s x :=
  has_fderiv_within_at.fderiv_within (has_fderiv_within_at.log (differentiable_within_at.has_fderiv_within_at hf) hx) hxs

@[simp] theorem fderiv.log {E : Type u_1} [normed_group E] [normed_space ℝ E] {f : E → ℝ} {x : E} (hf : differentiable_at ℝ f x) (hx : f x ≠ 0) : fderiv ℝ (fun (x : E) => real.log (f x)) x = f x⁻¹ • fderiv ℝ f x :=
  has_fderiv_at.fderiv (has_fderiv_at.log (differentiable_at.has_fderiv_at hf) hx)

namespace real

/-- The function `exp(x)/x^n` tends to `+∞` at `+∞`, for any natural number `n` -/
theorem tendsto_exp_div_pow_at_top (n : ℕ) : filter.tendsto (fun (x : ℝ) => exp x / x ^ n) filter.at_top filter.at_top := sorry

/-- The function `x^n * exp(-x)` tends to `0` at `+∞`, for any natural number `n`. -/
theorem tendsto_pow_mul_exp_neg_at_top_nhds_0 (n : ℕ) : filter.tendsto (fun (x : ℝ) => x ^ n * exp (-x)) filter.at_top (nhds 0) := sorry

/-- The function `(b * exp x + c) / (x ^ n)` tends to `+∞` at `+∞`, for any positive natural number
`n` and any real numbers `b` and `c` such that `b` is positive. -/
theorem tendsto_mul_exp_add_div_pow_at_top (b : ℝ) (c : ℝ) (n : ℕ) (hb : 0 < b) (hn : 1 ≤ n) : filter.tendsto (fun (x : ℝ) => (b * exp x + c) / x ^ n) filter.at_top filter.at_top := sorry

/-- The function `(x ^ n) / (b * exp x + c)` tends to `0` at `+∞`, for any positive natural number
`n` and any real numbers `b` and `c` such that `b` is nonzero. -/
theorem tendsto_div_pow_mul_exp_add_at_top (b : ℝ) (c : ℝ) (n : ℕ) (hb : 0 ≠ b) (hn : 1 ≤ n) : filter.tendsto (fun (x : ℝ) => x ^ n / (b * exp x + c)) filter.at_top (nhds 0) := sorry

/-- A crude lemma estimating the difference between `log (1-x)` and its Taylor series at `0`,
where the main point of the bound is that it tends to `0`. The goal is to deduce the series
expansion of the logarithm, in `has_sum_pow_div_log_of_abs_lt_1`.
-/
theorem abs_log_sub_add_sum_range_le {x : ℝ} (h : abs x < 1) (n : ℕ) : abs ((finset.sum (finset.range n) fun (i : ℕ) => x ^ (i + 1) / (↑i + 1)) + log (1 - x)) ≤ abs x ^ (n + 1) / (1 - abs x) := sorry

/-- Power series expansion of the logarithm around `1`. -/
theorem has_sum_pow_div_log_of_abs_lt_1 {x : ℝ} (h : abs x < 1) : has_sum (fun (n : ℕ) => x ^ (n + 1) / (↑n + 1)) (-log (1 - x)) := sorry


/-
Copyright (c) 2022 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson
-/
import data.fintype.order
import algebra.direct_limit
import model_theory.quotients
import model_theory.finitely_generated

/-!
# Direct Limits of First-Order Structures
This file constructs the direct limit of a directed system of first-order embeddings.

## Main Definitions
* `first_order.language.direct_limit G f`  is the direct limit of the directed system `f` of
  first-order embeddings between the structures indexed by `G`.
-/

universes v w u₁ u₂

open_locale first_order
namespace first_order
namespace language
open Structure set

variables {L : language} {ι : Type v} [preorder ι]
variables {G : ι → Type w} [Π i, L.Structure (G i)]
variables (f : Π i j, i ≤ j → G i ↪[L] G j)

namespace directed_system

/-- A copy of `directed_system.map_self` specialized to `L`-embeddings, as otherwise the
`λ i j h, f i j h` can confuse the simplifier. -/
lemma map_self [directed_system G (λ i j h, f i j h)] (i x h) :
  f i i h x = x :=
directed_system.map_self (λ i j h, f i j h) i x h

/-- A copy of `directed_system.map_map` specialized to `L`-embeddings, as otherwise the
`λ i j h, f i j h` can confuse the simplifier. -/
lemma map_map [directed_system G (λ i j h, f i j h)] {i j k} (hij hjk x) :
  f j k hjk (f i j hij x) = f i k (le_trans hij hjk) x :=
directed_system.map_map (λ i j h, f i j h) hij hjk x

variables {G' : ℕ → Type w} [Π i, L.Structure (G' i)] (f' : Π (n : ℕ), G' n ↪[L] G' (n + 1))

/-- Given a chain of embeddings of structures indexed by `ℕ`, defines a `directed_system` by
composing them. -/
def nat_le_rec (m n : ℕ) (h : m ≤ n) : G' m ↪[L] G' n :=
nat.le_rec_on h (λ k g, (f' k).comp g) (embedding.refl L _)

@[simp] lemma coe_nat_le_rec (m n : ℕ) (h : m ≤ n) :
  (nat_le_rec f' m n h : G' m → G' n) = nat.le_rec_on h (λ n, f' n) :=
begin
  obtain ⟨k, rfl⟩ := nat.exists_eq_add_of_le h,
  ext x,
  induction k with k ih,
  { rw [nat_le_rec, nat.le_rec_on_self, embedding.refl_apply, nat.le_rec_on_self] },
  { rw [nat.le_rec_on_succ le_self_add, nat_le_rec, nat.le_rec_on_succ le_self_add, ← nat_le_rec,
      embedding.comp_apply, ih] }
end

instance nat_le_rec.directed_system : directed_system G' (λ i j h, nat_le_rec f' i j h) :=
⟨λ i x h, congr (congr rfl (nat.le_rec_on_self _)) rfl,
  λ i j k ij jk, by simp [nat.le_rec_on_trans ij jk]⟩

end directed_system

namespace direct_limit

/-- Raises a family of elements in the `Σ`-type to the same level along the embeddings. -/
def unify {α : Type*} (x : α → (Σ i, G i)) (i : ι)
  (h : i ∈ upper_bounds (range (sigma.fst ∘ x))) (a : α) : G i :=
f (x a).1 i (h (mem_range_self a)) (x a).2

variable [directed_system G (λ i j h, f i j h)]

@[simp] lemma unify_sigma_mk_self {α : Type*} {i : ι}
  {x : α → G i} :
  unify f (sigma.mk i ∘ x) i (λ j ⟨a, hj⟩, trans (le_of_eq hj.symm) (refl _)) = x :=
begin
  ext a,
  simp only [unify, directed_system.map_self],
end

lemma comp_unify {α : Type*} {x : α → (Σ i, G i)} {i j : ι}
  (ij : i ≤ j) (h : i ∈ upper_bounds (range (sigma.fst ∘ x))) :
  (f i j ij) ∘ (unify f x i h) = unify f x j (λ k hk, trans (mem_upper_bounds.1 h k hk) ij) :=
begin
  ext a,
  simp [unify, directed_system.map_map],
end

end direct_limit

variables (G)

namespace direct_limit

/-- The directed limit glues together the structures along the embeddings. -/
def setoid [directed_system G (λ i j h, f i j h)] [is_directed ι (≤)] :
  setoid (Σ i, G i) :=
{ r := λ ⟨i, x⟩ ⟨j, y⟩, ∃ (k : ι) (ik : i ≤ k) (jk : j ≤ k), f i k ik x = f j k jk y,
  iseqv := ⟨λ ⟨i, x⟩, ⟨i, refl i, refl i, rfl⟩,
    λ ⟨i, x⟩ ⟨j, y⟩ ⟨k, ik, jk, h⟩, ⟨k, jk, ik, h.symm⟩,
    λ ⟨i, x⟩ ⟨j, y⟩ ⟨k, z⟩ ⟨ij, hiij, hjij, hij⟩ ⟨jk, hjjk, hkjk, hjk⟩,
      begin
        obtain ⟨ijk, hijijk, hjkijk⟩ := (directed_of (≤) ij jk),
        refine ⟨ijk, le_trans hiij hijijk, le_trans hkjk hjkijk, _⟩,
        rw [← directed_system.map_map, hij, directed_system.map_map],
        symmetry,
        rw [← directed_system.map_map, ← hjk, directed_system.map_map],
      end ⟩ }

/-- The structure on the `Σ`-type which becomes the structure on the direct limit after quotienting.
 -/
noncomputable def sigma_structure [is_directed ι (≤)] [nonempty ι] : L.Structure (Σ i, G i) :=
{ fun_map := λ n F x, ⟨_, fun_map F (unify f x
  (classical.some (fintype.bdd_above_range (λ a, (x a).1)))
  (classical.some_spec (fintype.bdd_above_range (λ a, (x a).1))))⟩,
                    rel_map := λ n R x, rel_map R (unify f x
  (classical.some (fintype.bdd_above_range (λ a, (x a).1)))
  (classical.some_spec (fintype.bdd_above_range (λ a, (x a).1)))) }

end direct_limit

/-- The direct limit of a directed system is the structures glued together along the embeddings. -/
def direct_limit [directed_system G (λ i j h, f i j h)] [is_directed ι (≤)] :=
quotient (direct_limit.setoid G f)

local attribute [instance] direct_limit.setoid

instance [directed_system G (λ i j h, f i j h)] [is_directed ι (≤)] [inhabited ι]
  [inhabited (G default)] : inhabited (direct_limit G f) :=
⟨⟦⟨default, default⟩⟧⟩

namespace direct_limit

variables [is_directed ι (≤)] [directed_system G (λ i j h, f i j h)]

lemma equiv_iff {x y : Σ i, G i} {i : ι} (hx : x.1 ≤ i) (hy : y.1 ≤ i) :
  x ≈ y ↔ (f x.1 i hx) x.2 = (f y.1 i hy) y.2 :=
begin
  cases x,
  cases y,
  refine ⟨λ xy, _, λ xy, ⟨i, hx, hy, xy⟩⟩,
  obtain ⟨j, _, _, h⟩ := xy,
  obtain ⟨k, ik, jk⟩ := directed_of (≤) i j,
  have h := congr_arg (f j k jk) h,
  apply (f i k ik).injective,
  rw [directed_system.map_map, directed_system.map_map] at *,
  exact h
end

lemma fun_map_unify_equiv {n : ℕ} (F : L.functions n) (x : (fin n) → (Σ i, G i)) (i j : ι)
  (hi : i ∈ upper_bounds (range (sigma.fst ∘ x))) (hj : j ∈ upper_bounds (range (sigma.fst ∘ x))) :
  (⟨i, fun_map F (unify f x i hi)⟩ : Σ i, G i) ≈ ⟨j, fun_map F (unify f x j hj)⟩ :=
begin
  obtain ⟨k, ik, jk⟩ := directed_of (≤) i j,
  refine ⟨k, ik, jk, _⟩,
  rw [(f i k ik).map_fun, (f j k jk).map_fun, comp_unify, comp_unify],
end

lemma rel_map_unify_equiv {n : ℕ} (R : L.relations n) (x : (fin n) → (Σ i, G i)) (i j : ι)
  (hi : i ∈ upper_bounds (range (sigma.fst ∘ x))) (hj : j ∈ upper_bounds (range (sigma.fst ∘ x)))  :
  rel_map R (unify f x i hi) = rel_map R (unify f x j hj) :=
begin
  obtain ⟨k, ik, jk⟩ := directed_of (≤) i j,
  rw [← (f i k ik).map_rel, comp_unify, ← (f j k jk).map_rel, comp_unify],
end

variable [nonempty ι]

lemma exists_unify_eq {α : Type*} [fintype α] {x y : α → (Σ i, G i)} (xy : x ≈ y) :
  ∃ (i : ι) (hx : i ∈ upper_bounds (range (sigma.fst ∘ x)))
    (hy : i ∈ upper_bounds (range (sigma.fst ∘ y))),
  unify f x i hx = unify f y i hy :=
begin
  obtain ⟨i, hi⟩ := fintype.bdd_above_range (sum.elim (λ a, (x a).1) (λ a, (y a).1)),
  rw [sum.elim_range, upper_bounds_union] at hi,
  simp_rw [← function.comp_apply sigma.fst _] at hi,
  exact ⟨i, hi.1, hi.2, funext (λ a, (equiv_iff G f _ _).1 (xy a))⟩,
end

lemma fun_map_equiv_unify {n : ℕ} (F : L.functions n) (x : (fin n) → (Σ i, G i)) (i : ι)
  (hi : i ∈ upper_bounds (range (sigma.fst ∘ x))) :
  @fun_map _ _ (sigma_structure G f) _ F x ≈ ⟨_, fun_map F (unify f x i hi)⟩ :=
fun_map_unify_equiv G f F x (classical.some (fintype.bdd_above_range (λ a, (x a).1))) i _ hi

lemma rel_map_equiv_unify {n : ℕ} (R : L.relations n) (x : (fin n) → (Σ i, G i)) (i : ι)
  (hi : i ∈ upper_bounds (range (sigma.fst ∘ x)))  :
  @rel_map _ _ (sigma_structure G f) _ R x = rel_map R (unify f x i hi) :=
rel_map_unify_equiv G f R x (classical.some (fintype.bdd_above_range (λ a, (x a).1))) i _ hi

/-- The direct limit `setoid` respects the structure `sigma_structure`, so quotienting by it
  gives rise to a valid structure. -/
noncomputable instance prestructure : L.prestructure (direct_limit.setoid G f) :=
{ to_structure := sigma_structure G f,
  fun_equiv := λ n F x y xy, begin
    obtain ⟨i, hx, hy, h⟩ := exists_unify_eq G f xy,
    refine setoid.trans (fun_map_equiv_unify G f F x i hx)
      (setoid.trans _ (setoid.symm (fun_map_equiv_unify G f F y i hy))),
    rw h,
  end,
  rel_equiv := λ n R x y xy, begin
    obtain ⟨i, hx, hy, h⟩ := exists_unify_eq G f xy,
    refine trans (rel_map_equiv_unify G f R x i hx)
      (trans _ (symm (rel_map_equiv_unify G f R y i hy))),
    rw h,
  end }

/-- The `L.Structure` on a direct limit of `L.Structure`s. -/
noncomputable instance Structure : L.Structure (direct_limit G f) := language.quotient_structure

@[simp] lemma fun_map_quotient_mk_sigma_mk {n : ℕ} {F : L.functions n} {i : ι} {x : fin n → G i} :
  fun_map F (λ a, (⟦⟨i, x a⟩⟧ : direct_limit G f)) = ⟦⟨i, fun_map F x⟩⟧ :=
begin
  simp only [function.comp_app, fun_map_quotient_mk, quotient.eq],
  obtain ⟨k, ik, jk⟩ := directed_of (≤) i (classical.some (fintype.bdd_above_range
    (λ (a : fin n), i))),
  refine ⟨k, jk, ik, _⟩,
  simp only [embedding.map_fun, comp_unify],
  refl
end

@[simp] lemma rel_map_quotient_mk_sigma_mk {n : ℕ} {R : L.relations n} {i : ι} {x : fin n → G i} :
  rel_map R (λ a, (⟦⟨i, x a⟩⟧ : direct_limit G f)) = rel_map R x :=
begin
  rw [rel_map_quotient_mk],
  obtain ⟨k, ik, jk⟩ := directed_of (≤) i (classical.some (fintype.bdd_above_range
    (λ (a : fin n), i))),
  rw [rel_map_equiv_unify G f R (λ a, ⟨i, x a⟩) i, unify_sigma_mk_self],
end

lemma exists_quotient_mk_sigma_mk_eq {α : Type*} [fintype α] (x : α → direct_limit G f) :
  ∃ (i : ι) (y : α → G i), x = quotient.mk ∘ (sigma.mk i) ∘ y :=
begin
  obtain ⟨i, hi⟩ := fintype.bdd_above_range (λ a, (x a).out.1),
  refine ⟨i, unify f (quotient.out ∘ x) i hi, _⟩,
  ext a,
  rw [quotient.eq_mk_iff_out, function.comp_app, unify, equiv_iff G f _],
  { simp only [directed_system.map_self] },
  { refl }
end

variables (L ι)

/-- The canonical map from a component to the direct limit. -/
def of (i : ι) : G i ↪[L] direct_limit G f :=
{ to_fun := quotient.mk ∘ sigma.mk i,
  inj' := λ x y h, begin
    simp only [quotient.eq] at h,
    obtain ⟨j, h1, h2, h3⟩ := h,
    exact (f i j h1).injective h3,
  end }

variables {L ι G f}

@[simp] lemma of_apply {i : ι} {x : G i} : of L ι G f i x = ⟦⟨i, x⟩⟧ := rfl

@[simp] lemma of_f {i j : ι} {hij : i ≤ j} {x : G i} :
  (of L ι G f j (f i j hij x)) = of L ι G f i x :=
begin
  simp only [of_apply, quotient.eq],
  refine setoid.symm ⟨j, hij, refl j, _⟩,
  simp only [directed_system.map_self],
end

/-- Every element of the direct limit corresponds to some element in
some component of the directed system. -/
theorem exists_of (z : direct_limit G f) :
  ∃ i x, of L ι G f i x = z :=
⟨z.out.1, z.out.2, by simp⟩

@[elab_as_eliminator]
protected theorem induction_on {C : direct_limit G f → Prop}
  (z : direct_limit G f)
  (ih : ∀ i x, C (of L ι G f i x)) : C z :=
let ⟨i, x, h⟩ := exists_of z in h ▸ ih i x

variables {P : Type u₁} [L.Structure P] (g : Π i, G i ↪[L] P)
variables (Hg : ∀ i j hij x, g j (f i j hij x) = g i x)
include Hg

variables (L ι G f)
/-- The universal property of the direct limit: maps from the components to another module
that respect the directed system structure (i.e. make some diagram commute) give rise
to a unique map out of the direct limit. -/
def lift : direct_limit G f ↪[L] P :=
{ to_fun := quotient.lift (λ (x : Σ i, G i), (g x.1) x.2) (λ x y xy, begin
    simp only,
    obtain ⟨i, hx, hy⟩ := directed_of (≤) x.1 y.1,
    rw [← Hg x.1 i hx, ← Hg y.1 i hy],
    exact congr_arg _ ((equiv_iff _ _ _ _).1 xy),
  end),
  inj' := λ x y xy, begin
    rw [← quotient.out_eq x, ← quotient.out_eq y, quotient.lift_mk, quotient.lift_mk] at xy,
    obtain ⟨i, hx, hy⟩ := directed_of (≤) x.out.1 y.out.1,
    rw [← Hg x.out.1 i hx, ← Hg y.out.1 i hy] at xy,
    rw [← quotient.out_eq x, ← quotient.out_eq y, quotient.eq, equiv_iff G f hx hy],
    exact (g i).injective xy,
  end,
  map_fun' := λ n F x, begin
    obtain ⟨i, y, rfl⟩ := exists_quotient_mk_sigma_mk_eq G f x,
    rw [fun_map_quotient_mk_sigma_mk, ← function.comp.assoc, quotient.lift_comp_mk],
    simp only [quotient.lift_mk, embedding.map_fun],
  end,
  map_rel' := λ n R x, begin
    obtain ⟨i, y, rfl⟩ := exists_quotient_mk_sigma_mk_eq G f x,
    rw [rel_map_quotient_mk_sigma_mk G f, ← (g i).map_rel R y,
      ← function.comp.assoc, quotient.lift_comp_mk],
  end }

variables {L ι G f}

omit Hg

@[simp] lemma lift_quotient_mk_sigma_mk {i} (x : G i) :
  lift L ι G f g Hg (⟦⟨i, x⟩⟧) = (g i) x :=
begin
  change (lift L ι G f g Hg).to_fun (⟦⟨i, x⟩⟧) = _,
  simp only [lift, quotient.lift_mk],
end

lemma lift_of {i} (x : G i) : lift L ι G f g Hg (of L ι G f i x) = g i x :=
by simp

theorem lift_unique (F : direct_limit G f ↪[L] P) (x) :
  F x = lift L ι G f (λ i, F.comp $ of L ι G f i)
    (λ i j hij x, by rw [F.comp_apply, F.comp_apply, of_f]) x :=
direct_limit.induction_on x $ λ i x, by rw lift_of; refl

/-- The direct limit of countably many countably generated structures is countably generated. -/
theorem cg {ι : Type*} [encodable ι] [preorder ι] [is_directed ι (≤)] [nonempty ι]
  {G : ι → Type w} [Π i, L.Structure (G i)]
  (f : Π i j, i ≤ j → G i ↪[L] G j) (h : ∀ i, Structure.cg L (G i))
  [directed_system G (λ i j h, f i j h)] :
  Structure.cg L (direct_limit G f) :=
begin
  refine ⟨⟨⋃ i, direct_limit.of L ι G f i '' (classical.some (h i).out), _, _⟩⟩,
  { exact set.countable_Union (λ i, set.countable.image (classical.some_spec (h i).out).1 _) },
  { rw [eq_top_iff, substructure.closure_Union],
    simp_rw [← embedding.coe_to_hom, substructure.closure_image],
    rw le_supr_iff,
    intros S hS x hx,
    let out := @quotient.out _ (direct_limit.setoid G f),
    refine hS (out x).1 ⟨(out x).2, _, _⟩,
    { rw [(classical.some_spec (h (out x).1).out).2],
      simp only [substructure.coe_top] },
    { simp only [embedding.coe_to_hom, direct_limit.of_apply, sigma.eta, quotient.out_eq] } }
end

instance cg' {ι : Type*} [encodable ι] [preorder ι] [is_directed ι (≤)] [nonempty ι]
  {G : ι → Type w} [Π i, L.Structure (G i)]
  (f : Π i j, i ≤ j → G i ↪[L] G j) [h : ∀ i, Structure.cg L (G i)]
  [directed_system G (λ i j h, f i j h)] :
  Structure.cg L (direct_limit G f) :=
cg f h

end direct_limit

end language
end first_order


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

import algebraic_topology.dold_kan.normalized

/-!

# The normalized Moore complex and the alternating face map complex are homotopy equivalent

In this file, when the category `A` is abelian, we obtain the homotopy equivalence
`homotopy_equiv_normalized_Moore_complex_alternating_face_map_complex` between the
normalized Moore complex and the alternating face map complex of a simplicial object in `A`.

-/

open category_theory category_theory.category category_theory.limits
  category_theory.preadditive
open_locale simplicial dold_kan

noncomputable theory

namespace algebraic_topology

namespace dold_kan

variables {C : Type*} [category C] [preadditive C] (X : simplicial_object C)

/-- Inductive construction of homotopies from `P q` to `𝟙 _` -/
noncomputable def homotopy_P_to_id : Π (q : ℕ),
  homotopy (P q : K[X] ⟶ _) (𝟙 _)
| 0     := homotopy.refl _
| (q+1) := begin
    refine homotopy.trans (homotopy.of_eq _)
      (homotopy.trans
        (homotopy.add (homotopy_P_to_id q) (homotopy.comp_left (homotopy_Hσ_to_zero q) (P q)))
        (homotopy.of_eq _)),
    { unfold P, simp only [comp_add, comp_id], },
    { simp only [add_zero, comp_zero], },
  end

/-- The complement projection `Q q` to `P q` is homotopic to zero. -/
def homotopy_Q_to_zero (q : ℕ) : homotopy (Q q : K[X] ⟶ _) 0 :=
homotopy.equiv_sub_zero.to_fun (homotopy_P_to_id X q).symm

lemma homotopy_P_to_id_eventually_constant {q n : ℕ} (hqn : n<q):
  ((homotopy_P_to_id X (q+1)).hom n (n+1) : X _[n] ⟶ X _[n+1]) =
  (homotopy_P_to_id X q).hom n (n+1) :=
begin
  unfold homotopy_P_to_id,
  simp only [homotopy_Hσ_to_zero, hσ'_eq_zero hqn (c_mk (n+1) n rfl), homotopy.trans_hom,
    pi.add_apply, homotopy.of_eq_hom, pi.zero_apply, homotopy.add_hom, homotopy.comp_left_hom,
    homotopy.null_homotopy'_hom, complex_shape.down_rel, eq_self_iff_true, dite_eq_ite,
    if_true, comp_zero, add_zero, zero_add],
end

variable (X)

/-- Construction of the homotopy from `P_infty` to the identity using eventually
(termwise) constant homotopies from `P q` to the identity for all `q` -/
@[simps]
def homotopy_P_infty_to_id :
  homotopy (P_infty : K[X] ⟶ _) (𝟙 _) :=
{ hom := λ i j, (homotopy_P_to_id X (j+1)).hom i j,
  zero' := λ i j hij, homotopy.zero _ i j hij,
  comm := λ n, begin
    cases n,
    { simpa only [homotopy.d_next_zero_chain_complex, homotopy.prev_d_chain_complex,  P_f_0_eq,
        zero_add, homological_complex.id_f, P_infty_f] using (homotopy_P_to_id X 2).comm 0, },
    { simpa only [homotopy.d_next_succ_chain_complex, homotopy.prev_d_chain_complex,
        homological_complex.id_f, P_infty_f, ← P_is_eventually_constant (rfl.le : n+1 ≤ n+1),
        homotopy_P_to_id_eventually_constant X (lt_add_one (n+1))]
        using (homotopy_P_to_id X (n+2)).comm (n+1), },
  end }

/-- The inclusion of the Moore complex in the alternating face map complex
is an homotopy equivalence -/
@[simps]
def homotopy_equiv_normalized_Moore_complex_alternating_face_map_complex {A : Type*}
  [category A] [abelian A] {Y : simplicial_object A} :
  homotopy_equiv ((normalized_Moore_complex A).obj Y) ((alternating_face_map_complex A).obj Y) :=
{ hom := inclusion_of_Moore_complex_map Y,
  inv := P_infty_to_normalized_Moore_complex Y,
  homotopy_hom_inv_id := homotopy.of_eq (split_mono_inclusion_of_Moore_complex_map Y).id,
  homotopy_inv_hom_id := homotopy.trans
    (homotopy.of_eq (P_infty_to_normalized_Moore_complex_comp_inclusion_of_Moore_complex_map Y))
    (homotopy_P_infty_to_id Y), }

end dold_kan

end algebraic_topology