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

! This file was ported from Lean 3 source module topology.fiber_bundle.trivialization
! leanprover-community/mathlib commit f2ce6086713c78a7f880485f7917ea547a215982
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Bundle
import Mathlib.Topology.Algebra.Order.Field
import Mathlib.Topology.LocalHomeomorph

/-!
# Trivializations

## Main definitions

### Basic definitions

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

* `Pretrivialization F proj` : trivialization as a local equivalence, mainly used when the
  topology on the total space has not yet been defined.

### Operations on bundles

We provide the following operations on `Trivialization`s.

* `Trivialization.compHomeomorph`: 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`.

## Implementation notes

Previously, in mathlib, there was a structure `topological_vector_bundle.trivialization` which
extended another structure `topological_fibre_bundle.trivialization` by a linearity hypothesis. As
of PR leanprover-community/mathlib#17359, we have changed this to a single structure
`Trivialization` (no namespace), together with a mixin class `trivialization.is_linear`.

This permits all the *data* of a vector bundle to be held at the level of fibre bundles, so that the
same trivializations can underlie an object's structure as (say) a vector bundle over `ℂ` and as a
vector bundle over `ℝ`, as well as its structure simply as a fibre bundle.

This might be a little surprising, given the general trend of the library to ever-increased
bundling.  But in this case the typical motivation for more bundling does not apply: there is no
algebraic or order structure on the whole type of linear (say) trivializations of a bundle.
Indeed, since trivializations only have meaning on their base sets (taking junk values outside), the
type of linear trivializations is not even particularly well-behaved.
-/

open TopologicalSpace Filter Set Function Bundle Topology
open scoped Classical

variable {ι : Type _} {B : Type _} {F : Type _} {E : B → Type _}

variable (F) {Z : Type _} [TopologicalSpace B] [TopologicalSpace F] {proj : Z → B}

/-- This structure contains the information left for a local trivialization (which is implemented
below as `Trivialization F proj`) if the total space has not been given a topology, but we
have a topology on both the fiber and the base space. Through the construction
`topological_fiber_prebundle F proj` it will be possible to promote a
`Pretrivialization F proj` to a `Trivialization F proj`. -/
structure Pretrivialization (proj : Z → B) extends LocalEquiv Z (B × F) where
  open_target : IsOpen target
  baseSet : Set B
  open_baseSet : IsOpen baseSet
  source_eq : source = proj ⁻¹' baseSet
  target_eq : target = baseSet ×ˢ univ
  proj_toFun : ∀ p ∈ source, (toFun p).1 = proj p
#align pretrivialization Pretrivialization

namespace Pretrivialization

variable {F}
variable (e : Pretrivialization F proj) {x : Z}

/-- Coercion of a pretrivialization to a function. We don't use `e.toFun` in the `CoeFun` instance
because it is actually `e.toLocalEquiv.toFun`, so `simp` will apply lemmas about
`toLocalEquiv`. While we may want to switch to this behavior later, doing it mid-port will break a
lot of proofs.  -/
@[coe] def toFun' : Z → (B × F) := e.toFun

instance : CoeFun (Pretrivialization F proj) fun _ => Z → B × F := ⟨toFun'⟩

@[ext]
lemma ext' (e e' : Pretrivialization F proj) (h₁ : e.toLocalEquiv = e'.toLocalEquiv)
    (h₂ : e.baseSet = e'.baseSet) : e = e' := by
  cases e; cases e'; congr
#align pretrivialization.ext Pretrivialization.ext'

-- porting note: todo: move `ext` here?
lemma ext {e e' : Pretrivialization F proj} (h₁ : ∀ x, e x = e' x)
    (h₂ : ∀ x, e.toLocalEquiv.symm x = e'.toLocalEquiv.symm x) (h₃ : e.baseSet = e'.baseSet) :
    e = e' := by
  ext1 <;> [ext1, exact h₃]
  · apply h₁
  · apply h₂
  · rw [e.source_eq, e'.source_eq, h₃]

/-- If the fiber is nonempty, then the projection to -/
lemma toLocalEquiv_injective [Nonempty F] :
    Injective (toLocalEquiv : Pretrivialization F proj → LocalEquiv Z (B × F)) := fun e e' h => by
  refine ext' _ _ h ?_
  simpa only [fst_image_prod, univ_nonempty, target_eq]
    using congr_arg (Prod.fst '' LocalEquiv.target ·) h

@[simp, mfld_simps]
theorem coe_coe : ⇑e.toLocalEquiv = e :=
  rfl
#align pretrivialization.coe_coe Pretrivialization.coe_coe

@[simp, mfld_simps]
theorem coe_fst (ex : x ∈ e.source) : (e x).1 = proj x :=
  e.proj_toFun x ex
#align pretrivialization.coe_fst Pretrivialization.coe_fst

theorem mem_source : x ∈ e.source ↔ proj x ∈ e.baseSet := by rw [e.source_eq, mem_preimage]
#align pretrivialization.mem_source Pretrivialization.mem_source

theorem coe_fst' (ex : proj x ∈ e.baseSet) : (e x).1 = proj x :=
  e.coe_fst (e.mem_source.2 ex)
#align pretrivialization.coe_fst' Pretrivialization.coe_fst'

protected theorem eqOn : EqOn (Prod.fst ∘ e) proj e.source := fun _ hx => e.coe_fst hx
#align pretrivialization.eq_on Pretrivialization.eqOn

theorem mk_proj_snd (ex : x ∈ e.source) : (proj x, (e x).2) = e x :=
  Prod.ext (e.coe_fst ex).symm rfl
#align pretrivialization.mk_proj_snd Pretrivialization.mk_proj_snd

theorem mk_proj_snd' (ex : proj x ∈ e.baseSet) : (proj x, (e x).2) = e x :=
  Prod.ext (e.coe_fst' ex).symm rfl
#align pretrivialization.mk_proj_snd' Pretrivialization.mk_proj_snd'

/-- Composition of inverse and coercion from the subtype of the target. -/
def setSymm : e.target → Z :=
  e.target.restrict e.toLocalEquiv.symm
#align pretrivialization.set_symm Pretrivialization.setSymm

theorem mem_target {x : B × F} : x ∈ e.target ↔ x.1 ∈ e.baseSet := by
  rw [e.target_eq, prod_univ, mem_preimage]
#align pretrivialization.mem_target Pretrivialization.mem_target

theorem proj_symm_apply {x : B × F} (hx : x ∈ e.target) : proj (e.toLocalEquiv.symm x) = x.1 := by
  have := (e.coe_fst (e.map_target hx)).symm
  rwa [← e.coe_coe, e.right_inv hx] at this
#align pretrivialization.proj_symm_apply Pretrivialization.proj_symm_apply

theorem proj_symm_apply' {b : B} {x : F} (hx : b ∈ e.baseSet) :
    proj (e.toLocalEquiv.symm (b, x)) = b :=
  e.proj_symm_apply (e.mem_target.2 hx)
#align pretrivialization.proj_symm_apply' Pretrivialization.proj_symm_apply'

theorem proj_surjOn_baseSet [Nonempty F] : Set.SurjOn proj e.source e.baseSet := fun b hb =>
  let ⟨y⟩ := ‹Nonempty F›
  ⟨e.toLocalEquiv.symm (b, y), e.toLocalEquiv.map_target <| e.mem_target.2 hb,
    e.proj_symm_apply' hb⟩
#align pretrivialization.proj_surj_on_base_set Pretrivialization.proj_surjOn_baseSet

theorem apply_symm_apply {x : B × F} (hx : x ∈ e.target) : e (e.toLocalEquiv.symm x) = x :=
  e.toLocalEquiv.right_inv hx
#align pretrivialization.apply_symm_apply Pretrivialization.apply_symm_apply

theorem apply_symm_apply' {b : B} {x : F} (hx : b ∈ e.baseSet) :
    e (e.toLocalEquiv.symm (b, x)) = (b, x) :=
  e.apply_symm_apply (e.mem_target.2 hx)
#align pretrivialization.apply_symm_apply' Pretrivialization.apply_symm_apply'

theorem symm_apply_apply {x : Z} (hx : x ∈ e.source) : e.toLocalEquiv.symm (e x) = x :=
  e.toLocalEquiv.left_inv hx
#align pretrivialization.symm_apply_apply Pretrivialization.symm_apply_apply

@[simp, mfld_simps]
theorem symm_apply_mk_proj {x : Z} (ex : x ∈ e.source) :
    e.toLocalEquiv.symm (proj x, (e x).2) = x := by
  rw [← e.coe_fst ex, Prod.mk.eta, ← e.coe_coe, e.left_inv ex]
#align pretrivialization.symm_apply_mk_proj Pretrivialization.symm_apply_mk_proj

@[simp, mfld_simps]
theorem preimage_symm_proj_baseSet :
    e.toLocalEquiv.symm ⁻¹' (proj ⁻¹' e.baseSet) ∩ e.target = e.target := by
  refine' inter_eq_right_iff_subset.mpr fun x hx => _
  simp only [mem_preimage, LocalEquiv.invFun_as_coe, e.proj_symm_apply hx]
  exact e.mem_target.mp hx
#align pretrivialization.preimage_symm_proj_base_set Pretrivialization.preimage_symm_proj_baseSet

@[simp, mfld_simps]
theorem preimage_symm_proj_inter (s : Set B) :
    e.toLocalEquiv.symm ⁻¹' (proj ⁻¹' s) ∩ e.baseSet ×ˢ univ = (s ∩ e.baseSet) ×ˢ univ := by
  ext ⟨x, y⟩
  suffices x ∈ e.baseSet → (proj (e.toLocalEquiv.symm (x, y)) ∈ s ↔ x ∈ s) by
    simpa only [prod_mk_mem_set_prod_eq, mem_inter_iff, and_true_iff, mem_univ, and_congr_left_iff]
  intro h
  rw [e.proj_symm_apply' h]
#align pretrivialization.preimage_symm_proj_inter Pretrivialization.preimage_symm_proj_inter

theorem target_inter_preimage_symm_source_eq (e f : Pretrivialization F proj) :
    f.target ∩ f.toLocalEquiv.symm ⁻¹' e.source = (e.baseSet ∩ f.baseSet) ×ˢ univ := by
  rw [inter_comm, f.target_eq, e.source_eq, f.preimage_symm_proj_inter]
#align pretrivialization.target_inter_preimage_symm_source_eq Pretrivialization.target_inter_preimage_symm_source_eq

theorem trans_source (e f : Pretrivialization F proj) :
    (f.toLocalEquiv.symm.trans e.toLocalEquiv).source = (e.baseSet ∩ f.baseSet) ×ˢ univ := by
  rw [LocalEquiv.trans_source, LocalEquiv.symm_source, e.target_inter_preimage_symm_source_eq]
#align pretrivialization.trans_source Pretrivialization.trans_source

theorem symm_trans_symm (e e' : Pretrivialization F proj) :
    (e.toLocalEquiv.symm.trans e'.toLocalEquiv).symm = e'.toLocalEquiv.symm.trans e.toLocalEquiv :=
  by rw [LocalEquiv.trans_symm_eq_symm_trans_symm, LocalEquiv.symm_symm]
#align pretrivialization.symm_trans_symm Pretrivialization.symm_trans_symm

theorem symm_trans_source_eq (e e' : Pretrivialization F proj) :
    (e.toLocalEquiv.symm.trans e'.toLocalEquiv).source = (e.baseSet ∩ e'.baseSet) ×ˢ univ := by
  rw [LocalEquiv.trans_source, e'.source_eq, LocalEquiv.symm_source, e.target_eq, inter_comm,
    e.preimage_symm_proj_inter, inter_comm]
#align pretrivialization.symm_trans_source_eq Pretrivialization.symm_trans_source_eq

variable (e' : Pretrivialization F (π E)) {x' : TotalSpace E} {b : B} {y : E b}

theorem coe_mem_source : ↑y ∈ e'.source ↔ b ∈ e'.baseSet :=
  e'.mem_source
#align pretrivialization.coe_mem_source Pretrivialization.coe_mem_source

@[simp, mfld_simps]
theorem coe_coe_fst (hb : b ∈ e'.baseSet) : (e' y).1 = b :=
  e'.coe_fst (e'.mem_source.2 hb)
#align pretrivialization.coe_coe_fst Pretrivialization.coe_coe_fst

theorem mk_mem_target {x : B} {y : F} : (x, y) ∈ e'.target ↔ x ∈ e'.baseSet :=
  e'.mem_target
#align pretrivialization.mk_mem_target Pretrivialization.mk_mem_target

theorem symm_coe_proj {x : B} {y : F} (e' : Pretrivialization F (π E)) (h : x ∈ e'.baseSet) :
    (e'.toLocalEquiv.symm (x, y)).1 = x :=
  e'.proj_symm_apply' h
#align pretrivialization.symm_coe_proj Pretrivialization.symm_coe_proj

section Zero

variable [∀ x, Zero (E x)]

/-- A fiberwise inverse to `e`. This is the function `F → E b` that induces a local inverse
`B × F → total_space E` of `e` on `e.baseSet`. It is defined to be `0` outside `e.baseSet`. -/
protected noncomputable def symm (e : Pretrivialization F (π E)) (b : B) (y : F) : E b :=
  if hb : b ∈ e.baseSet then
    cast (congr_arg E (e.proj_symm_apply' hb)) (e.toLocalEquiv.symm (b, y)).2
  else 0
#align pretrivialization.symm Pretrivialization.symm

theorem symm_apply (e : Pretrivialization F (π E)) {b : B} (hb : b ∈ e.baseSet) (y : F) :
    e.symm b y = cast (congr_arg E (e.symm_coe_proj hb)) (e.toLocalEquiv.symm (b, y)).2 :=
  dif_pos hb
#align pretrivialization.symm_apply Pretrivialization.symm_apply

theorem symm_apply_of_not_mem (e : Pretrivialization F (π E)) {b : B} (hb : b ∉ e.baseSet) (y : F) :
    e.symm b y = 0 :=
  dif_neg hb
#align pretrivialization.symm_apply_of_not_mem Pretrivialization.symm_apply_of_not_mem

theorem coe_symm_of_not_mem (e : Pretrivialization F (π E)) {b : B} (hb : b ∉ e.baseSet) :
    (e.symm b : F → E b) = 0 :=
  funext fun _ => dif_neg hb
#align pretrivialization.coe_symm_of_not_mem Pretrivialization.coe_symm_of_not_mem

theorem mk_symm (e : Pretrivialization F (π E)) {b : B} (hb : b ∈ e.baseSet) (y : F) :
    totalSpaceMk b (e.symm b y) = e.toLocalEquiv.symm (b, y) := by
  rw [e.symm_apply hb, TotalSpace.mk_cast (e.proj_symm_apply' hb), TotalSpace.eta]
#align pretrivialization.mk_symm Pretrivialization.mk_symm

theorem symm_proj_apply (e : Pretrivialization F (π E)) (z : TotalSpace E)
    (hz : z.proj ∈ e.baseSet) : e.symm z.proj (e z).2 = z.2 := by
  rw [e.symm_apply hz, cast_eq_iff_heq, e.mk_proj_snd' hz, e.symm_apply_apply (e.mem_source.mpr hz)]
#align pretrivialization.symm_proj_apply Pretrivialization.symm_proj_apply

theorem symm_apply_apply_mk (e : Pretrivialization F (π E)) {b : B} (hb : b ∈ e.baseSet) (y : E b) :
    e.symm b (e (totalSpaceMk b y)).2 = y :=
  e.symm_proj_apply (totalSpaceMk b y) hb
#align pretrivialization.symm_apply_apply_mk Pretrivialization.symm_apply_apply_mk

theorem apply_mk_symm (e : Pretrivialization F (π E)) {b : B} (hb : b ∈ e.baseSet) (y : F) :
    e (totalSpaceMk b (e.symm b y)) = (b, y) := by
  rw [e.mk_symm hb, e.apply_symm_apply (e.mk_mem_target.mpr hb)]
#align pretrivialization.apply_mk_symm Pretrivialization.apply_mk_symm

end Zero

end Pretrivialization

variable [TopologicalSpace Z] [TopologicalSpace (TotalSpace E)]

/-- 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 ⁻¹' baseSet` and `baseSet × F`, acting trivially on the first coordinate.
-/
-- porting note: todo: was @[nolint has_nonempty_instance]
structure Trivialization (proj : Z → B) extends LocalHomeomorph Z (B × F) where
  baseSet : Set B
  open_baseSet : IsOpen baseSet
  source_eq : source = proj ⁻¹' baseSet
  target_eq : target = baseSet ×ˢ univ
  proj_toFun : ∀ p ∈ source, (toLocalHomeomorph p).1 = proj p
#align trivialization Trivialization

namespace Trivialization

variable {F}
variable (e : Trivialization F proj) {x : Z}

@[ext]
lemma ext' (e e' : Trivialization F proj) (h₁ : e.toLocalHomeomorph = e'.toLocalHomeomorph)
    (h₂ : e.baseSet = e'.baseSet) : e = e' := by
  cases e; cases e'; congr
#align trivialization.ext Trivialization.ext'

/-- Coercion of a trivialization to a function. We don't use `e.toFun` in the `CoeFun` instance
because it is actually `e.toLocalEquiv.toFun`, so `simp` will apply lemmas about
`toLocalEquiv`. While we may want to switch to this behavior later, doing it mid-port will break a
lot of proofs.  -/
@[coe] def toFun' : Z → (B × F) := e.toFun

/-- Natural identification as a `Pretrivialization`. -/
def toPretrivialization : Pretrivialization F proj :=
  { e with }
#align trivialization.to_pretrivialization Trivialization.toPretrivialization

instance : CoeFun (Trivialization F proj) fun _ => Z → B × F := ⟨toFun'⟩

instance : Coe (Trivialization F proj) (Pretrivialization F proj) :=
  ⟨toPretrivialization⟩

theorem toPretrivialization_injective :
    Function.Injective fun e : Trivialization F proj => e.toPretrivialization := fun e e' h => by
  ext1
  exacts [LocalHomeomorph.toLocalEquiv_injective (congr_arg Pretrivialization.toLocalEquiv h),
    congr_arg Pretrivialization.baseSet h]
#align trivialization.to_pretrivialization_injective Trivialization.toPretrivialization_injective

@[simp, mfld_simps]
theorem coe_coe : ⇑e.toLocalHomeomorph = e :=
  rfl
#align trivialization.coe_coe Trivialization.coe_coe

@[simp, mfld_simps]
theorem coe_fst (ex : x ∈ e.source) : (e x).1 = proj x :=
  e.proj_toFun x ex
#align trivialization.coe_fst Trivialization.coe_fst

protected theorem eqOn : EqOn (Prod.fst ∘ e) proj e.source := fun _x hx => e.coe_fst hx
#align trivialization.eq_on Trivialization.eqOn

theorem mem_source : x ∈ e.source ↔ proj x ∈ e.baseSet := by rw [e.source_eq, mem_preimage]
#align trivialization.mem_source Trivialization.mem_source

theorem coe_fst' (ex : proj x ∈ e.baseSet) : (e x).1 = proj x :=
  e.coe_fst (e.mem_source.2 ex)
#align trivialization.coe_fst' Trivialization.coe_fst'

theorem mk_proj_snd (ex : x ∈ e.source) : (proj x, (e x).2) = e x :=
  Prod.ext (e.coe_fst ex).symm rfl
#align trivialization.mk_proj_snd Trivialization.mk_proj_snd

theorem mk_proj_snd' (ex : proj x ∈ e.baseSet) : (proj x, (e x).2) = e x :=
  Prod.ext (e.coe_fst' ex).symm rfl
#align trivialization.mk_proj_snd' Trivialization.mk_proj_snd'

theorem source_inter_preimage_target_inter (s : Set (B × F)) :
    e.source ∩ e ⁻¹' (e.target ∩ s) = e.source ∩ e ⁻¹' s :=
  e.toLocalHomeomorph.source_inter_preimage_target_inter s
#align trivialization.source_inter_preimage_target_inter Trivialization.source_inter_preimage_target_inter

@[simp, mfld_simps]
theorem coe_mk (e : LocalHomeomorph Z (B × F)) (i j k l m) (x : Z) :
    (Trivialization.mk e i j k l m : Trivialization F proj) x = e x :=
  rfl
#align trivialization.coe_mk Trivialization.coe_mk

theorem mem_target {x : B × F} : x ∈ e.target ↔ x.1 ∈ e.baseSet :=
  e.toPretrivialization.mem_target
#align trivialization.mem_target Trivialization.mem_target

theorem map_target {x : B × F} (hx : x ∈ e.target) : e.toLocalHomeomorph.symm x ∈ e.source :=
  e.toLocalHomeomorph.map_target hx
#align trivialization.map_target Trivialization.map_target

theorem proj_symm_apply {x : B × F} (hx : x ∈ e.target) : proj (e.toLocalHomeomorph.symm x) = x.1 :=
  e.toPretrivialization.proj_symm_apply hx
#align trivialization.proj_symm_apply Trivialization.proj_symm_apply

theorem proj_symm_apply' {b : B} {x : F} (hx : b ∈ e.baseSet) :
    proj (e.toLocalHomeomorph.symm (b, x)) = b :=
  e.toPretrivialization.proj_symm_apply' hx
#align trivialization.proj_symm_apply' Trivialization.proj_symm_apply'

theorem proj_surjOn_baseSet [Nonempty F] : Set.SurjOn proj e.source e.baseSet :=
  e.toPretrivialization.proj_surjOn_baseSet
#align trivialization.proj_surj_on_base_set Trivialization.proj_surjOn_baseSet

theorem apply_symm_apply {x : B × F} (hx : x ∈ e.target) : e (e.toLocalHomeomorph.symm x) = x :=
  e.toLocalHomeomorph.right_inv hx
#align trivialization.apply_symm_apply Trivialization.apply_symm_apply

theorem apply_symm_apply' {b : B} {x : F} (hx : b ∈ e.baseSet) :
    e (e.toLocalHomeomorph.symm (b, x)) = (b, x) :=
  e.toPretrivialization.apply_symm_apply' hx
#align trivialization.apply_symm_apply' Trivialization.apply_symm_apply'

@[simp, mfld_simps]
theorem symm_apply_mk_proj (ex : x ∈ e.source) : e.toLocalHomeomorph.symm (proj x, (e x).2) = x :=
  e.toPretrivialization.symm_apply_mk_proj ex
#align trivialization.symm_apply_mk_proj Trivialization.symm_apply_mk_proj

theorem symm_trans_source_eq (e e' : Trivialization F proj) :
    (e.toLocalEquiv.symm.trans e'.toLocalEquiv).source = (e.baseSet ∩ e'.baseSet) ×ˢ univ :=
  Pretrivialization.symm_trans_source_eq e.toPretrivialization e'
#align trivialization.symm_trans_source_eq Trivialization.symm_trans_source_eq

theorem symm_trans_target_eq (e e' : Trivialization F proj) :
    (e.toLocalEquiv.symm.trans e'.toLocalEquiv).target = (e.baseSet ∩ e'.baseSet) ×ˢ univ :=
  Pretrivialization.symm_trans_target_eq e.toPretrivialization e'
#align trivialization.symm_trans_target_eq Trivialization.symm_trans_target_eq

theorem coe_fst_eventuallyEq_proj (ex : x ∈ e.source) : Prod.fst ∘ e =ᶠ[𝓝 x] proj :=
  mem_nhds_iff.2 ⟨e.source, fun _y hy => e.coe_fst hy, e.open_source, ex⟩
#align trivialization.coe_fst_eventually_eq_proj Trivialization.coe_fst_eventuallyEq_proj

theorem coe_fst_eventuallyEq_proj' (ex : proj x ∈ e.baseSet) : Prod.fst ∘ e =ᶠ[𝓝 x] proj :=
  e.coe_fst_eventuallyEq_proj (e.mem_source.2 ex)
#align trivialization.coe_fst_eventually_eq_proj' Trivialization.coe_fst_eventuallyEq_proj'

theorem map_proj_nhds (ex : x ∈ e.source) : map proj (𝓝 x) = 𝓝 (proj x) := by
  rw [← e.coe_fst ex, ← map_congr (e.coe_fst_eventuallyEq_proj ex), ← map_map, ← e.coe_coe,
    e.map_nhds_eq ex, map_fst_nhds]
#align trivialization.map_proj_nhds Trivialization.map_proj_nhds

theorem preimage_subset_source {s : Set B} (hb : s ⊆ e.baseSet) : proj ⁻¹' s ⊆ e.source :=
  fun _p hp => e.mem_source.mpr (hb hp)
#align trivialization.preimage_subset_source Trivialization.preimage_subset_source

theorem image_preimage_eq_prod_univ {s : Set B} (hb : s ⊆ e.baseSet) :
    e '' (proj ⁻¹' s) = s ×ˢ univ :=
  Subset.antisymm
    (image_subset_iff.mpr fun p hp =>
      ⟨(e.proj_toFun p (e.preimage_subset_source hb hp)).symm ▸ hp, trivial⟩)
    fun p hp =>
    let hp' : p ∈ e.target := e.mem_target.mpr (hb hp.1)
    ⟨e.invFun p, mem_preimage.mpr ((e.proj_symm_apply hp').symm ▸ hp.1), e.apply_symm_apply hp'⟩
#align trivialization.image_preimage_eq_prod_univ Trivialization.image_preimage_eq_prod_univ

/-- The preimage of a subset of the base set is homeomorphic to the product with the fiber. -/
def preimageHomeomorph {s : Set B} (hb : s ⊆ e.baseSet) : proj ⁻¹' s ≃ₜ s × F :=
  (e.toLocalHomeomorph.homeomorphOfImageSubsetSource (e.preimage_subset_source hb)
        (e.image_preimage_eq_prod_univ hb)).trans
    ((Homeomorph.Set.prod s univ).trans ((Homeomorph.refl s).prodCongr (Homeomorph.Set.univ F)))
#align trivialization.preimage_homeomorph Trivialization.preimageHomeomorph

@[simp]
theorem preimageHomeomorph_apply {s : Set B} (hb : s ⊆ e.baseSet) (p : proj ⁻¹' s) :
    e.preimageHomeomorph hb p = (⟨proj p, p.2⟩, (e p).2) :=
  Prod.ext (Subtype.ext (e.proj_toFun p (e.mem_source.mpr (hb p.2)))) rfl
#align trivialization.preimage_homeomorph_apply Trivialization.preimageHomeomorph_apply

@[simp]
theorem preimageHomeomorph_symm_apply {s : Set B} (hb : s ⊆ e.baseSet) (p : s × F) :
    (e.preimageHomeomorph hb).symm p = ⟨e.symm (p.1, p.2), ((e.preimageHomeomorph hb).symm p).2⟩ :=
  rfl
#align trivialization.preimage_homeomorph_symm_apply Trivialization.preimageHomeomorph_symm_apply

/-- The source is homeomorphic to the product of the base set with the fiber. -/
def sourceHomeomorphBaseSetProd : e.source ≃ₜ e.baseSet × F :=
  (Homeomorph.setCongr e.source_eq).trans (e.preimageHomeomorph subset_rfl)
#align trivialization.source_homeomorph_base_set_prod Trivialization.sourceHomeomorphBaseSetProd

@[simp]
theorem sourceHomeomorphBaseSetProd_apply (p : e.source) :
    e.sourceHomeomorphBaseSetProd p = (⟨proj p, e.mem_source.mp p.2⟩, (e p).2) :=
  e.preimageHomeomorph_apply subset_rfl ⟨p, e.mem_source.mp p.2⟩
#align trivialization.source_homeomorph_base_set_prod_apply Trivialization.sourceHomeomorphBaseSetProd_apply

@[simp]
theorem sourceHomeomorphBaseSetProd_symm_apply (p : e.baseSet × F) :
    e.sourceHomeomorphBaseSetProd.symm p =
      ⟨e.symm (p.1, p.2), (e.sourceHomeomorphBaseSetProd.symm p).2⟩ :=
  rfl
#align trivialization.source_homeomorph_base_set_prod_symm_apply Trivialization.sourceHomeomorphBaseSetProd_symm_apply

/-- Each fiber of a trivialization is homeomorphic to the specified fiber. -/
def preimageSingletonHomeomorph {b : B} (hb : b ∈ e.baseSet) : proj ⁻¹' {b} ≃ₜ F :=
  .trans (e.preimageHomeomorph (Set.singleton_subset_iff.mpr hb)) <|
    .trans (.prodCongr (Homeomorph.homeomorphOfUnique ({b} : Set B) PUnit.{1}) (Homeomorph.refl F))
      (Homeomorph.punitProd F)
#align trivialization.preimage_singleton_homeomorph Trivialization.preimageSingletonHomeomorph

@[simp]
theorem preimageSingletonHomeomorph_apply {b : B} (hb : b ∈ e.baseSet) (p : proj ⁻¹' {b}) :
    e.preimageSingletonHomeomorph hb p = (e p).2 :=
  rfl
#align trivialization.preimage_singleton_homeomorph_apply Trivialization.preimageSingletonHomeomorph_apply

@[simp]
theorem preimageSingletonHomeomorph_symm_apply {b : B} (hb : b ∈ e.baseSet) (p : F) :
    (e.preimageSingletonHomeomorph hb).symm p =
      ⟨e.symm (b, p), by rw [mem_preimage, e.proj_symm_apply' hb, mem_singleton_iff]⟩ :=
  rfl
#align trivialization.preimage_singleton_homeomorph_symm_apply Trivialization.preimageSingletonHomeomorph_symm_apply

/-- In the domain of a bundle trivialization, the projection is continuous-/
theorem continuousAt_proj (ex : x ∈ e.source) : ContinuousAt proj x :=
  (e.map_proj_nhds ex).le
#align trivialization.continuous_at_proj Trivialization.continuousAt_proj

/-- Composition of a `Trivialization` and a `Homeomorph`. -/
protected def compHomeomorph {Z' : Type _} [TopologicalSpace Z'] (h : Z' ≃ₜ Z) :
    Trivialization F (proj ∘ h) where
  toLocalHomeomorph := h.toLocalHomeomorph.trans e.toLocalHomeomorph
  baseSet := e.baseSet
  open_baseSet := e.open_baseSet
  source_eq := by simp [source_eq, preimage_preimage, (· ∘ ·)]
  target_eq := by simp [target_eq]
  proj_toFun p hp := by
    have hp : h p ∈ e.source := by simpa using hp
    simp [hp]
#align trivialization.comp_homeomorph Trivialization.compHomeomorph

/-- Read off the continuity of a function `f : Z → X` at `z : Z` by transferring via a
trivialization of `Z` containing `z`. -/
theorem continuousAt_of_comp_right {X : Type _} [TopologicalSpace X] {f : Z → X} {z : Z}
    (e : Trivialization F proj) (he : proj z ∈ e.baseSet)
    (hf : ContinuousAt (f ∘ e.toLocalEquiv.symm) (e z)) : ContinuousAt f z := by
  have hez : z ∈ e.toLocalEquiv.symm.target := by
    rw [LocalEquiv.symm_target, e.mem_source]
    exact he
  rwa [e.toLocalHomeomorph.symm.continuousAt_iff_continuousAt_comp_right hez,
    LocalHomeomorph.symm_symm]
#align trivialization.continuous_at_of_comp_right Trivialization.continuousAt_of_comp_right

/-- Read off the continuity of a function `f : X → Z` at `x : X` by transferring via a
trivialization of `Z` containing `f x`. -/
theorem continuousAt_of_comp_left {X : Type _} [TopologicalSpace X] {f : X → Z} {x : X}
    (e : Trivialization F proj) (hf_proj : ContinuousAt (proj ∘ f) x) (he : proj (f x) ∈ e.baseSet)
    (hf : ContinuousAt (e ∘ f) x) : ContinuousAt f x := by
  rw [e.continuousAt_iff_continuousAt_comp_left]
  · exact hf
  rw [e.source_eq, ← preimage_comp]
  exact hf_proj.preimage_mem_nhds (e.open_baseSet.mem_nhds he)
#align trivialization.continuous_at_of_comp_left Trivialization.continuousAt_of_comp_left

variable (e' : Trivialization F (π E)) {x' : TotalSpace E} {b : B} {y : E b}

protected theorem continuousOn : ContinuousOn e' e'.source :=
  e'.continuous_toFun
#align trivialization.continuous_on Trivialization.continuousOn

theorem coe_mem_source : ↑y ∈ e'.source ↔ b ∈ e'.baseSet :=
  e'.mem_source
#align trivialization.coe_mem_source Trivialization.coe_mem_source

@[deprecated LocalHomeomorph.open_target]
theorem open_target' : IsOpen e'.target := e'.open_target
#align trivialization.open_target Trivialization.open_target'

@[simp, mfld_simps]
theorem coe_coe_fst (hb : b ∈ e'.baseSet) : (e' y).1 = b :=
  e'.coe_fst (e'.mem_source.2 hb)
#align trivialization.coe_coe_fst Trivialization.coe_coe_fst

theorem mk_mem_target {y : F} : (b, y) ∈ e'.target ↔ b ∈ e'.baseSet :=
  e'.toPretrivialization.mem_target
#align trivialization.mk_mem_target Trivialization.mk_mem_target

theorem symm_apply_apply {x : TotalSpace E} (hx : x ∈ e'.source) :
    e'.toLocalHomeomorph.symm (e' x) = x :=
  e'.toLocalEquiv.left_inv hx
#align trivialization.symm_apply_apply Trivialization.symm_apply_apply

@[simp, mfld_simps]
theorem symm_coe_proj {x : B} {y : F} (e : Trivialization F (π E)) (h : x ∈ e.baseSet) :
    (e.toLocalHomeomorph.symm (x, y)).1 = x :=
  e.proj_symm_apply' h
#align trivialization.symm_coe_proj Trivialization.symm_coe_proj

section Zero

variable [∀ x, Zero (E x)]

/-- A fiberwise inverse to `e'`. The function `F → E x` that induces a local inverse
`B × F → total_space E` of `e'` on `e'.baseSet`. It is defined to be `0` outside `e'.baseSet`. -/
protected noncomputable def symm (e : Trivialization F (π E)) (b : B) (y : F) : E b :=
  e.toPretrivialization.symm b y
#align trivialization.symm Trivialization.symm

theorem symm_apply (e : Trivialization F (π E)) {b : B} (hb : b ∈ e.baseSet) (y : F) :
    e.symm b y = cast (congr_arg E (e.symm_coe_proj hb)) (e.toLocalHomeomorph.symm (b, y)).2 :=
  dif_pos hb
#align trivialization.symm_apply Trivialization.symm_apply

theorem symm_apply_of_not_mem (e : Trivialization F (π E)) {b : B} (hb : b ∉ e.baseSet) (y : F) :
    e.symm b y = 0 :=
  dif_neg hb
#align trivialization.symm_apply_of_not_mem Trivialization.symm_apply_of_not_mem

theorem mk_symm (e : Trivialization F (π E)) {b : B} (hb : b ∈ e.baseSet) (y : F) :
    totalSpaceMk b (e.symm b y) = e.toLocalHomeomorph.symm (b, y) :=
  e.toPretrivialization.mk_symm hb y
#align trivialization.mk_symm Trivialization.mk_symm

theorem symm_proj_apply (e : Trivialization F (π E)) (z : TotalSpace E) (hz : z.proj ∈ e.baseSet) :
    e.symm z.proj (e z).2 = z.2 :=
  e.toPretrivialization.symm_proj_apply z hz
#align trivialization.symm_proj_apply Trivialization.symm_proj_apply

theorem symm_apply_apply_mk (e : Trivialization F (π E)) {b : B} (hb : b ∈ e.baseSet) (y : E b) :
    e.symm b (e (totalSpaceMk b y)).2 = y :=
  e.symm_proj_apply (totalSpaceMk b y) hb
#align trivialization.symm_apply_apply_mk Trivialization.symm_apply_apply_mk

theorem apply_mk_symm (e : Trivialization F (π E)) {b : B} (hb : b ∈ e.baseSet) (y : F) :
    e (totalSpaceMk b (e.symm b y)) = (b, y) :=
  e.toPretrivialization.apply_mk_symm hb y
#align trivialization.apply_mk_symm Trivialization.apply_mk_symm

theorem continuousOn_symm (e : Trivialization F (π E)) :
    ContinuousOn (fun z : B × F => totalSpaceMk z.1 (e.symm z.1 z.2)) (e.baseSet ×ˢ univ) := by
  have : ∀ z ∈ e.baseSet ×ˢ (univ : Set F),
      totalSpaceMk z.1 (e.symm z.1 z.2) = e.toLocalHomeomorph.symm z := by
    rintro x ⟨hx : x.1 ∈ e.baseSet, _⟩
    rw [e.mk_symm hx]
  refine' ContinuousOn.congr _ this
  rw [← e.target_eq]
  exact e.toLocalHomeomorph.continuousOn_symm
#align trivialization.continuous_on_symm Trivialization.continuousOn_symm

end Zero

/-- If `e` is a `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 transFiberHomeomorph {F' : Type _} [TopologicalSpace F'] (e : Trivialization F proj)
    (h : F ≃ₜ F') : Trivialization F' proj where
  toLocalHomeomorph := e.toLocalHomeomorph.transHomeomorph <| (Homeomorph.refl _).prodCongr h
  baseSet := e.baseSet
  open_baseSet := e.open_baseSet
  source_eq := e.source_eq
  target_eq := by simp [target_eq, prod_univ, preimage_preimage]
  proj_toFun := e.proj_toFun
#align trivialization.trans_fiber_homeomorph Trivialization.transFiberHomeomorph

@[simp]
theorem transFiberHomeomorph_apply {F' : Type _} [TopologicalSpace F'] (e : Trivialization F proj)
    (h : F ≃ₜ F') (x : Z) : e.transFiberHomeomorph h x = ((e x).1, h (e x).2) :=
  rfl
#align trivialization.trans_fiber_homeomorph_apply Trivialization.transFiberHomeomorph_apply

/-- Coordinate transformation in the fiber induced by a pair of bundle trivializations. See also
`Trivialization.coordChangeHomeomorph` for a version bundled as `F ≃ₜ F`. -/
def coordChange (e₁ e₂ : Trivialization F proj) (b : B) (x : F) : F :=
  (e₂ <| e₁.toLocalHomeomorph.symm (b, x)).2
#align trivialization.coord_change Trivialization.coordChange

theorem mk_coordChange (e₁ e₂ : Trivialization F proj) {b : B} (h₁ : b ∈ e₁.baseSet)
    (h₂ : b ∈ e₂.baseSet) (x : F) :
    (b, e₁.coordChange e₂ b x) = e₂ (e₁.toLocalHomeomorph.symm (b, x)) := by
  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₁]
#align trivialization.mk_coord_change Trivialization.mk_coordChange

theorem coordChange_apply_snd (e₁ e₂ : Trivialization F proj) {p : Z} (h : proj p ∈ e₁.baseSet) :
    e₁.coordChange e₂ (proj p) (e₁ p).snd = (e₂ p).snd := by
  rw [coordChange, e₁.symm_apply_mk_proj (e₁.mem_source.2 h)]
#align trivialization.coord_change_apply_snd Trivialization.coordChange_apply_snd

theorem coordChange_same_apply (e : Trivialization F proj) {b : B} (h : b ∈ e.baseSet) (x : F) :
    e.coordChange e b x = x := by rw [coordChange, e.apply_symm_apply' h]
#align trivialization.coord_change_same_apply Trivialization.coordChange_same_apply

theorem coordChange_same (e : Trivialization F proj) {b : B} (h : b ∈ e.baseSet) :
    e.coordChange e b = id :=
  funext <| e.coordChange_same_apply h
#align trivialization.coord_change_same Trivialization.coordChange_same

theorem coordChange_coordChange (e₁ e₂ e₃ : Trivialization F proj) {b : B} (h₁ : b ∈ e₁.baseSet)
    (h₂ : b ∈ e₂.baseSet) (x : F) :
    e₂.coordChange e₃ b (e₁.coordChange e₂ b x) = e₁.coordChange e₃ b x := by
  rw [coordChange, e₁.mk_coordChange _ h₁ h₂, ← e₂.coe_coe, e₂.left_inv, coordChange]
  rwa [e₂.mem_source, e₁.proj_symm_apply' h₁]
#align trivialization.coord_change_coord_change Trivialization.coordChange_coordChange

theorem continuous_coordChange (e₁ e₂ : Trivialization F proj) {b : B} (h₁ : b ∈ e₁.baseSet)
    (h₂ : b ∈ e₂.baseSet) : Continuous (e₁.coordChange e₂ b) := by
  refine' continuous_snd.comp (e₂.toLocalHomeomorph.continuousOn.comp_continuous
    (e₁.toLocalHomeomorph.continuousOn_symm.comp_continuous _ _) _)
  · exact continuous_const.prod_mk continuous_id
  · exact fun x => e₁.mem_target.2 h₁
  · intro x
    rwa [e₂.mem_source, e₁.proj_symm_apply' h₁]
#align trivialization.continuous_coord_change Trivialization.continuous_coordChange

/-- Coordinate transformation in the fiber induced by a pair of bundle trivializations,
as a homeomorphism. -/
protected def coordChangeHomeomorph (e₁ e₂ : Trivialization F proj) {b : B} (h₁ : b ∈ e₁.baseSet)
    (h₂ : b ∈ e₂.baseSet) : F ≃ₜ F where
  toFun := e₁.coordChange e₂ b
  invFun := e₂.coordChange e₁ b
  left_inv x := by simp only [*, coordChange_coordChange, coordChange_same_apply]
  right_inv x := by simp only [*, coordChange_coordChange, coordChange_same_apply]
  continuous_toFun := e₁.continuous_coordChange e₂ h₁ h₂
  continuous_invFun := e₂.continuous_coordChange e₁ h₂ h₁
#align trivialization.coord_change_homeomorph Trivialization.coordChangeHomeomorph

@[simp]
theorem coordChangeHomeomorph_coe (e₁ e₂ : Trivialization F proj) {b : B} (h₁ : b ∈ e₁.baseSet)
    (h₂ : b ∈ e₂.baseSet) : ⇑(e₁.coordChangeHomeomorph e₂ h₁ h₂) = e₁.coordChange e₂ b :=
  rfl
#align trivialization.coord_change_homeomorph_coe Trivialization.coordChangeHomeomorph_coe

variable {B' : Type _} [TopologicalSpace B']

theorem isImage_preimage_prod (e : Trivialization F proj) (s : Set B) :
    e.toLocalHomeomorph.IsImage (proj ⁻¹' s) (s ×ˢ univ) := fun x hx => by simp [e.coe_fst', hx]
#align trivialization.is_image_preimage_prod Trivialization.isImage_preimage_prod

/-- Restrict a `Trivialization` to an open set in the base. `-/
protected def restrOpen (e : Trivialization F proj) (s : Set B) (hs : IsOpen s) :
    Trivialization F proj where
  toLocalHomeomorph :=
    ((e.isImage_preimage_prod s).symm.restr (IsOpen.inter e.open_target (hs.prod isOpen_univ))).symm
  baseSet := e.baseSet ∩ s
  open_baseSet := IsOpen.inter e.open_baseSet hs
  source_eq := by simp [source_eq]
  target_eq := by simp [target_eq, prod_univ]
  proj_toFun p hp := e.proj_toFun p hp.1
#align trivialization.restr_open Trivialization.restrOpen

section Piecewise

theorem frontier_preimage (e : Trivialization F proj) (s : Set B) :
    e.source ∩ frontier (proj ⁻¹' s) = proj ⁻¹' (e.baseSet ∩ frontier s) := by
  rw [← (e.isImage_preimage_prod s).frontier.preimage_eq, frontier_prod_univ_eq,
    (e.isImage_preimage_prod _).preimage_eq, e.source_eq, preimage_inter]
#align trivialization.frontier_preimage Trivialization.frontier_preimage

/-- 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.baseSet ∩ frontier s`, `e.piecewise e' s Hs Heq` is the bundle trivialization over
`Set.ite s e.baseSet e'.baseSet` that is equal to `e` on `proj ⁻¹ s` and is equal to `e'`
otherwise. -/
noncomputable def piecewise (e e' : Trivialization F proj) (s : Set B)
    (Hs : e.baseSet ∩ frontier s = e'.baseSet ∩ frontier s)
    (Heq : EqOn e e' <| proj ⁻¹' (e.baseSet ∩ frontier s)) : Trivialization F proj where
  toLocalHomeomorph :=
    e.toLocalHomeomorph.piecewise e'.toLocalHomeomorph (proj ⁻¹' s) (s ×ˢ univ)
      (e.isImage_preimage_prod s) (e'.isImage_preimage_prod s)
      (by rw [e.frontier_preimage, e'.frontier_preimage, Hs]) (by rwa [e.frontier_preimage])
  baseSet := s.ite e.baseSet e'.baseSet
  open_baseSet := e.open_baseSet.ite e'.open_baseSet Hs
  source_eq := by simp [source_eq]
  target_eq := by simp [target_eq, prod_univ]
  proj_toFun p := by
    rintro (⟨he, hs⟩ | ⟨he, hs⟩)
    -- porting note: was `<;> simp [*]`
    · simp [piecewise_eq_of_mem _ _ _ hs, *]
    · simp [piecewise_eq_of_not_mem _ _ _ hs, *]
#align trivialization.piecewise Trivialization.piecewise

/-- 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.baseSet ∩ e'.baseSet` 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.baseSet e'.baseSet` that is equal to `e` on points `p`
such that `proj p ≤ a` and is equal to `e'` otherwise. -/
noncomputable def piecewiseLeOfEq [LinearOrder B] [OrderTopology B] (e e' : Trivialization F proj)
    (a : B) (He : a ∈ e.baseSet) (He' : a ∈ e'.baseSet) (Heq : ∀ p, proj p = a → e p = e' p) :
    Trivialization F proj :=
  e.piecewise e' (Iic a)
    (Set.ext fun x => and_congr_left_iff.2 fun hx => by
      obtain rfl : x = a := mem_singleton_iff.1 (frontier_Iic_subset _ hx)
      simp [He, He'])
    fun p hp => Heq p <| frontier_Iic_subset _ hp.2
#align trivialization.piecewise_le_of_eq Trivialization.piecewiseLeOfEq

/-- 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.baseSet ∩ e'.baseSet`, `e.piecewise_le e' a He He'`
is the bundle trivialization over `Set.ite (Iic a) e.baseSet e'.baseSet` 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 piecewiseLe [LinearOrder B] [OrderTopology B] (e e' : Trivialization F proj)
    (a : B) (He : a ∈ e.baseSet) (He' : a ∈ e'.baseSet) : Trivialization F proj :=
  e.piecewiseLeOfEq (e'.transFiberHomeomorph (e'.coordChangeHomeomorph e He' He)) a He He' <| by
    rintro p rfl
    ext1
    · simp [e.coe_fst', e'.coe_fst', *]
    · simp [coordChange_apply_snd, *]
#align trivialization.piecewise_le Trivialization.piecewiseLe

/-- 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 disjointUnion (e e' : Trivialization F proj) (H : Disjoint e.baseSet e'.baseSet) :
    Trivialization F proj where
  toLocalHomeomorph :=
    e.toLocalHomeomorph.disjointUnion e'.toLocalHomeomorph
      (by
        rw [e.source_eq, e'.source_eq]
        exact H.preimage _)
      (by
        rw [e.target_eq, e'.target_eq, disjoint_iff_inf_le]
        intro x hx
        exact H.le_bot ⟨hx.1.1, hx.2.1⟩)
  baseSet := e.baseSet ∪ e'.baseSet
  open_baseSet := IsOpen.union e.open_baseSet e'.open_baseSet
  source_eq := congr_arg₂ (· ∪ ·) e.source_eq e'.source_eq
  target_eq := (congr_arg₂ (· ∪ ·) e.target_eq e'.target_eq).trans union_prod.symm
  proj_toFun := by
    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 [source_eq] at hp' ⊢
      exact fun h => H.le_bot ⟨h, hp'⟩
#align trivialization.disjoint_union Trivialization.disjointUnion

end Piecewise

end Trivialization


/- Inaccessible names -/

example : ∀ x y : Nat, x = y → y = x := by
  intros
  apply Eq.symm
  assumption

example : ∀ x y : Nat, x = y → y = x := by
  intros
  apply Eq.symm
  rename_i a b hab
  exact hab


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/
import logic.relator

/-!
# Quotient types

This module extends the core library's treatment of quotient types (`init.data.quot`).

## Tags

quotient
-/

variables {α : Sort*} {β : Sort*}

namespace setoid

lemma ext {α : Sort*} :
  ∀{s t : setoid α}, (∀a b, @setoid.r α s a b ↔ @setoid.r α t a b) → s = t
| ⟨r, _⟩ ⟨p, _⟩ eq :=
  have r = p, from funext $ assume a, funext $ assume b, propext $ eq a b,
  by subst this

end setoid

namespace quot
variables {ra : α → α → Prop} {rb : β → β → Prop} {φ : quot ra → quot rb → Sort*}
local notation `⟦`:max a `⟧` := quot.mk _ a

instance (r : α → α → Prop) [inhabited α] : inhabited (quot r) := ⟨⟦default⟧⟩

instance [subsingleton α] : subsingleton (quot ra) :=
⟨λ x, quot.induction_on x (λ y, quot.ind (λ b, congr_arg _ (subsingleton.elim _ _)))⟩

/-- Recursion on two `quotient` arguments `a` and `b`, result type depends on `⟦a⟧` and `⟦b⟧`. -/
protected def hrec_on₂ (qa : quot ra) (qb : quot rb) (f : Π a b, φ ⟦a⟧ ⟦b⟧)
  (ca : ∀ {b a₁ a₂}, ra a₁ a₂ → f a₁ b == f a₂ b)
  (cb : ∀ {a b₁ b₂}, rb b₁ b₂ → f a b₁ == f a b₂) : φ qa qb :=
quot.hrec_on qa (λ a, quot.hrec_on qb (f a) (λ b₁ b₂ pb, cb pb)) $ λ a₁ a₂ pa,
  quot.induction_on qb $ λ b,
    calc @quot.hrec_on _ _ (φ _) ⟦b⟧ (f a₁) (@cb _)
          == f a₁ b                                     : by simp [heq_self_iff_true]
      ... == f a₂ b                                     : ca pa
      ... == @quot.hrec_on _ _ (φ _) ⟦b⟧ (f a₂) (@cb _) : by simp [heq_self_iff_true]

/-- Map a function `f : α → β` such that `ra x y` implies `rb (f x) (f y)`
to a map `quot ra → quot rb`. -/
protected def map (f : α → β) (h : (ra ⇒ rb) f f) : quot ra → quot rb :=
quot.lift (λ x, ⟦f x⟧) $ assume x y (h₁ : ra x y), quot.sound $ h h₁

/-- If `ra` is a subrelation of `ra'`, then we have a natural map `quot ra → quot ra'`. -/
protected def map_right {ra' : α → α → Prop} (h : ∀a₁ a₂, ra a₁ a₂ → ra' a₁ a₂) :
  quot ra → quot ra' :=
quot.map id h

/-- weaken the relation of a quotient -/
def factor {α : Type*} (r s : α → α → Prop) (h : ∀ x y, r x y → s x y) :
  quot r → quot s :=
quot.lift (quot.mk s) (λ x y rxy, quot.sound (h x y rxy))

lemma factor_mk_eq {α : Type*} (r s : α → α → Prop) (h : ∀ x y, r x y → s x y) :
  factor r s h ∘ quot.mk _ = quot.mk _ := rfl

variables {γ : Sort*} {r : α → α → Prop} {s : β → β → Prop}

/-- **Alias** of `quot.lift_beta`. -/
lemma lift_mk (f : α → γ) (h : ∀ a₁ a₂, r a₁ a₂ → f a₁ = f a₂) (a : α) :
  quot.lift f h (quot.mk r a) = f a := quot.lift_beta f h a

@[simp]
lemma lift_on_mk (a : α) (f : α → γ) (h : ∀ a₁ a₂, r a₁ a₂ → f a₁ = f a₂) :
  quot.lift_on (quot.mk r a) f h = f a := rfl

/-- Descends a function `f : α → β → γ` to quotients of `α` and `β`. -/
attribute [reducible, elab_as_eliminator]
protected def lift₂
  (f : α → β → γ)
  (hr : ∀ a b₁ b₂, s b₁ b₂ → f a b₁ = f a b₂)
  (hs : ∀ a₁ a₂ b, r a₁ a₂ → f a₁ b = f a₂ b)
  (q₁ : quot r) (q₂ : quot s) : γ :=
quot.lift (λ a, quot.lift (f a) (hr a))
(λ a₁ a₂ ha, funext (λ q, quot.induction_on q (λ b, hs a₁ a₂ b ha)))
q₁ q₂

@[simp]
lemma lift₂_mk (f : α → β → γ)
  (hr : ∀ a b₁ b₂, s b₁ b₂ → f a b₁ = f a b₂)
  (hs : ∀ a₁ a₂ b, r a₁ a₂ → f a₁ b = f a₂ b) (a : α) (b : β) :
  quot.lift₂ f hr hs (quot.mk r a) (quot.mk s b) = f a b := rfl

/-- Descends a function `f : α → β → γ` to quotients of `α` and `β` and applies it. -/
attribute [reducible, elab_as_eliminator]
protected def lift_on₂ (p : quot r) (q : quot s) (f : α → β → γ)
  (hr : ∀ a b₁ b₂, s b₁ b₂ → f a b₁ = f a b₂)
  (hs : ∀ a₁ a₂ b, r a₁ a₂ → f a₁ b = f a₂ b) : γ := quot.lift₂ f hr hs p q

@[simp]
lemma lift_on₂_mk (a : α) (b : β) (f : α → β → γ)
  (hr : ∀ a b₁ b₂, s b₁ b₂ → f a b₁ = f a b₂)
  (hs : ∀ a₁ a₂ b, r a₁ a₂ → f a₁ b = f a₂ b) :
  quot.lift_on₂ (quot.mk r a) (quot.mk s b) f hr hs = f a b := rfl

variables {t : γ → γ → Prop}

/-- Descends a function `f : α → β → γ` to quotients of `α` and `β` wih values in a quotient of
`γ`. -/
protected def map₂ (f : α → β → γ)
  (hr : ∀ a b₁ b₂, s b₁ b₂ → t (f a b₁) (f a b₂))
  (hs : ∀ a₁ a₂ b, r a₁ a₂ → t (f a₁ b) (f a₂ b))
  (q₁ : quot r) (q₂ : quot s) : quot t :=
quot.lift₂ (λ a b, quot.mk t $ f a b) (λ a b₁ b₂ hb, quot.sound (hr a b₁ b₂ hb))
(λ a₁ a₂ b ha, quot.sound (hs a₁ a₂ b ha)) q₁ q₂

@[simp]
lemma map₂_mk (f : α → β → γ)
  (hr : ∀ a b₁ b₂, s b₁ b₂ → t (f a b₁) (f a b₂))
  (hs : ∀ a₁ a₂ b, r a₁ a₂ → t (f a₁ b) (f a₂ b))
  (a : α) (b : β) : quot.map₂ f hr hs (quot.mk r a) (quot.mk s b) = quot.mk t (f a b) := rfl

attribute [elab_as_eliminator]
protected lemma induction_on₂
  {δ : quot r → quot s → Prop} (q₁ : quot r) (q₂ : quot s)
  (h : ∀ a b, δ (quot.mk r a) (quot.mk s b)) : δ q₁ q₂ :=
quot.ind (λ a₁, quot.ind (λ a₂, h a₁ a₂) q₂) q₁

attribute [elab_as_eliminator]
protected lemma induction_on₃
  {δ : quot r → quot s → quot t → Prop} (q₁ : quot r) (q₂ : quot s) (q₃ : quot t)
  (h : ∀ a b c, δ (quot.mk r a) (quot.mk s b) (quot.mk t c)) : δ q₁ q₂ q₃ :=
quot.ind (λ a₁, quot.ind (λ a₂, quot.ind (λ a₃, h a₁ a₂ a₃) q₃) q₂) q₁

end quot

namespace quotient
variables [sa : setoid α] [sb : setoid β]
variables {φ : quotient sa → quotient sb → Sort*}

instance (s : setoid α) [inhabited α] : inhabited (quotient s) := ⟨⟦default⟧⟩

instance (s : setoid α) [subsingleton α] : subsingleton (quotient s) :=
quot.subsingleton

/-- Induction on two `quotient` arguments `a` and `b`, result type depends on `⟦a⟧` and `⟦b⟧`. -/
protected def hrec_on₂ (qa : quotient sa) (qb : quotient sb) (f : Π a b, φ ⟦a⟧ ⟦b⟧)
  (c : ∀ a₁ b₁ a₂ b₂, a₁ ≈ a₂ → b₁ ≈ b₂ → f a₁ b₁ == f a₂ b₂) : φ qa qb :=
quot.hrec_on₂ qa qb f
  (λ _ _ _ p, c _ _ _ _ p (setoid.refl _))
  (λ _ _ _ p, c _ _ _ _ (setoid.refl _) p)

/-- Map a function `f : α → β` that sends equivalent elements to equivalent elements
to a function `quotient sa → quotient sb`. Useful to define unary operations on quotients. -/
protected def map (f : α → β) (h : ((≈) ⇒ (≈)) f f) : quotient sa → quotient sb :=
quot.map f h

@[simp] lemma map_mk (f : α → β) (h : ((≈) ⇒ (≈)) f f) (x : α) :
  quotient.map f h (⟦x⟧ : quotient sa) = (⟦f x⟧ : quotient sb) :=
rfl

variables {γ : Sort*} [sc : setoid γ]

/-- Map a function `f : α → β → γ` that sends equivalent elements to equivalent elements
to a function `f : quotient sa → quotient sb → quotient sc`.
Useful to define binary operations on quotients. -/
protected def map₂ (f : α → β → γ) (h : ((≈) ⇒ (≈) ⇒ (≈)) f f) :
  quotient sa → quotient sb → quotient sc :=
quotient.lift₂ (λ x y, ⟦f x y⟧) (λ x₁ y₁ x₂ y₂ h₁ h₂, quot.sound $ h h₁ h₂)

@[simp] lemma map₂_mk (f : α → β → γ) (h : ((≈) ⇒ (≈) ⇒ (≈)) f f) (x : α) (y : β) :
  quotient.map₂ f h (⟦x⟧ : quotient sa) (⟦y⟧ : quotient sb) = (⟦f x y⟧ : quotient sc) := rfl

end quotient

lemma quot.eq {α : Type*} {r : α → α → Prop} {x y : α} :
  quot.mk r x = quot.mk r y ↔ eqv_gen r x y :=
⟨quot.exact r, quot.eqv_gen_sound⟩

@[simp] theorem quotient.eq [r : setoid α] {x y : α} : ⟦x⟧ = ⟦y⟧ ↔ x ≈ y :=
⟨quotient.exact, quotient.sound⟩

theorem forall_quotient_iff {α : Type*} [r : setoid α] {p : quotient r → Prop} :
  (∀a:quotient r, p a) ↔ (∀a:α, p ⟦a⟧) :=
⟨assume h x, h _, assume h a, a.induction_on h⟩

@[simp] lemma quotient.lift_mk [s : setoid α] (f : α → β) (h : ∀ (a b : α), a ≈ b → f a = f b)
  (x : α) :
  quotient.lift f h (quotient.mk x) = f x := rfl

@[simp] lemma quotient.lift_comp_mk [setoid α] (f : α → β) (h : ∀ (a b : α), a ≈ b → f a = f b) :
  quotient.lift f h ∘ quotient.mk = f :=
rfl

@[simp] lemma quotient.lift₂_mk {α : Sort*} {β : Sort*} {γ : Sort*} [setoid α] [setoid β]
  (f : α → β → γ)
  (h : ∀ (a₁ : α) (a₂ : β) (b₁ : α) (b₂ : β), a₁ ≈ b₁ → a₂ ≈ b₂ → f a₁ a₂ = f b₁ b₂)
  (a : α) (b : β) :
  quotient.lift₂ f h (quotient.mk a) (quotient.mk b) = f a b := rfl

@[simp] lemma quotient.lift_on_mk [s : setoid α] (f : α → β) (h : ∀ (a b : α), a ≈ b → f a = f b)
  (x : α) :
  quotient.lift_on (quotient.mk x) f h = f x := rfl

@[simp] theorem quotient.lift_on₂_mk {α : Sort*} {β : Sort*} [setoid α] (f : α → α → β)
  (h : ∀ (a₁ a₂ b₁ b₂ : α), a₁ ≈ b₁ → a₂ ≈ b₂ → f a₁ a₂ = f b₁ b₂) (x y : α) :
  quotient.lift_on₂ (quotient.mk x) (quotient.mk y) f h = f x y := rfl

/-- `quot.mk r` is a surjective function. -/
lemma surjective_quot_mk (r : α → α → Prop) : function.surjective (quot.mk r) :=
quot.exists_rep

/-- `quotient.mk` is a surjective function. -/
lemma surjective_quotient_mk (α : Sort*) [s : setoid α] :
  function.surjective (quotient.mk : α → quotient s) :=
quot.exists_rep

/-- Choose an element of the equivalence class using the axiom of choice.
  Sound but noncomputable. -/
noncomputable def quot.out {r : α → α → Prop} (q : quot r) : α :=
classical.some (quot.exists_rep q)

/-- Unwrap the VM representation of a quotient to obtain an element of the equivalence class.
  Computable but unsound. -/
meta def quot.unquot {r : α → α → Prop} : quot r → α := unchecked_cast

@[simp] theorem quot.out_eq {r : α → α → Prop} (q : quot r) : quot.mk r q.out = q :=
classical.some_spec (quot.exists_rep q)

/-- Choose an element of the equivalence class using the axiom of choice.
  Sound but noncomputable. -/
noncomputable def quotient.out [s : setoid α] : quotient s → α := quot.out

@[simp] theorem quotient.out_eq [s : setoid α] (q : quotient s) : ⟦q.out⟧ = q := q.out_eq

theorem quotient.mk_out [s : setoid α] (a : α) : ⟦a⟧.out ≈ a :=
quotient.exact (quotient.out_eq _)

lemma quotient.mk_eq_iff_out [s : setoid α] {x : α} {y : quotient s} :
  ⟦x⟧ = y ↔ x ≈ quotient.out y :=
begin
  refine iff.trans _ quotient.eq,
  rw quotient.out_eq y,
end

lemma quotient.eq_mk_iff_out [s : setoid α] {x : quotient s} {y : α} :
  x = ⟦y⟧ ↔ quotient.out x ≈ y  :=
begin
  refine iff.trans _ quotient.eq,
  rw quotient.out_eq x,
end

@[simp] lemma quotient.out_equiv_out {s : setoid α} {x y : quotient s} :
  x.out ≈ y.out ↔ x = y :=
by rw [← quotient.eq_mk_iff_out, quotient.out_eq]

@[simp] lemma quotient.out_inj {s : setoid α} {x y : quotient s} :
  x.out = y.out ↔ x = y :=
⟨λ h, quotient.out_equiv_out.1 $ h ▸ setoid.refl _, λ h, h ▸ rfl⟩

section pi

instance pi_setoid {ι : Sort*} {α : ι → Sort*} [∀ i, setoid (α i)] : setoid (Π i, α i) :=
{ r := λ a b, ∀ i, a i ≈ b i,
  iseqv := ⟨
    λ a i, setoid.refl _,
    λ a b h i, setoid.symm (h _),
    λ a b c h₁ h₂ i, setoid.trans (h₁ _) (h₂ _)⟩ }

/-- Given a function `f : Π i, quotient (S i)`, returns the class of functions `Π i, α i` sending
each `i` to an element of the class `f i`. -/
noncomputable def quotient.choice {ι : Type*} {α : ι → Type*} [S : Π i, setoid (α i)]
  (f : Π i, quotient (S i)) : @quotient (Π i, α i) (by apply_instance) :=
⟦λ i, (f i).out⟧

@[simp] theorem quotient.choice_eq {ι : Type*} {α : ι → Type*} [Π i, setoid (α i)]
  (f : Π i, α i) : quotient.choice (λ i, ⟦f i⟧) = ⟦f⟧ :=
quotient.sound $ λ i, quotient.mk_out _

@[elab_as_eliminator] lemma quotient.induction_on_pi
   {ι : Type*} {α : ι → Sort*} [s : ∀ i, setoid (α i)]
   {p : (Π i, quotient (s i)) → Prop} (f : Π i, quotient (s i))
   (h : ∀ a : Π i, α i, p (λ i, ⟦a i⟧)) : p f :=
begin
  rw ← (funext (λ i, quotient.out_eq (f i)) : (λ i,  ⟦(f i).out⟧) = f),
  apply h,
end

end pi

lemma nonempty_quotient_iff (s : setoid α) : nonempty (quotient s) ↔ nonempty α :=
⟨assume ⟨a⟩, quotient.induction_on a nonempty.intro, assume ⟨a⟩, ⟨⟦a⟧⟩⟩

/-- `trunc α` is the quotient of `α` by the always-true relation. This
  is related to the propositional truncation in HoTT, and is similar
  in effect to `nonempty α`, but unlike `nonempty α`, `trunc α` is data,
  so the VM representation is the same as `α`, and so this can be used to
  maintain computability. -/
def {u} trunc (α : Sort u) : Sort u := @quot α (λ _ _, true)

theorem true_equivalence : @equivalence α (λ _ _, true) :=
⟨λ _, trivial, λ _ _ _, trivial, λ _ _ _ _ _, trivial⟩

namespace trunc

/-- Constructor for `trunc α` -/
def mk (a : α) : trunc α := quot.mk _ a

instance [inhabited α] : inhabited (trunc α) := ⟨mk default⟩

/-- Any constant function lifts to a function out of the truncation -/
def lift (f : α → β) (c : ∀ a b : α, f a = f b) : trunc α → β :=
quot.lift f (λ a b _, c a b)

theorem ind {β : trunc α → Prop} : (∀ a : α, β (mk a)) → ∀ q : trunc α, β q := quot.ind

protected theorem lift_mk (f : α → β) (c) (a : α) : lift f c (mk a) = f a := rfl

/-- Lift a constant function on `q : trunc α`. -/
@[reducible, elab_as_eliminator]
protected def lift_on (q : trunc α) (f : α → β)
  (c : ∀ a b : α, f a = f b) : β := lift f c q

@[elab_as_eliminator]
protected theorem induction_on {β : trunc α → Prop} (q : trunc α)
  (h : ∀ a, β (mk a)) : β q := ind h q

theorem exists_rep (q : trunc α) : ∃ a : α, mk a = q := quot.exists_rep q

attribute [elab_as_eliminator]
protected theorem induction_on₂ {C : trunc α → trunc β → Prop} (q₁ : trunc α) (q₂ : trunc β)
  (h : ∀ a b, C (mk a) (mk b)) : C q₁ q₂ :=
trunc.induction_on q₁ $ λ a₁, trunc.induction_on q₂ (h a₁)

protected theorem eq (a b : trunc α) : a = b :=
trunc.induction_on₂ a b (λ x y, quot.sound trivial)

instance : subsingleton (trunc α) := ⟨trunc.eq⟩

/-- The `bind` operator for the `trunc` monad. -/
def bind (q : trunc α) (f : α → trunc β) : trunc β :=
trunc.lift_on q f (λ a b, trunc.eq _ _)

/-- A function `f : α → β` defines a function `map f : trunc α → trunc β`. -/
def map (f : α → β) (q : trunc α) : trunc β := bind q (trunc.mk ∘ f)

instance : monad trunc :=
{ pure := @trunc.mk,
  bind := @trunc.bind }

instance : is_lawful_monad trunc :=
{ id_map := λ α q, trunc.eq _ _,
  pure_bind := λ α β q f, rfl,
  bind_assoc := λ α β γ x f g, trunc.eq _ _ }

variable {C : trunc α → Sort*}

/-- Recursion/induction principle for `trunc`. -/
@[reducible, elab_as_eliminator]
protected def rec
   (f : Π a, C (mk a)) (h : ∀ (a b : α), (eq.rec (f a) (trunc.eq (mk a) (mk b)) : C (mk b)) = f b)
   (q : trunc α) : C q :=
quot.rec f (λ a b _, h a b) q

/-- A version of `trunc.rec` taking `q : trunc α` as the first argument. -/
@[reducible, elab_as_eliminator]
protected def rec_on (q : trunc α) (f : Π a, C (mk a))
  (h : ∀ (a b : α), (eq.rec (f a) (trunc.eq (mk a) (mk b)) : C (mk b)) = f b) : C q :=
trunc.rec f h q

/-- A version of `trunc.rec_on` assuming the codomain is a `subsingleton`. -/
@[reducible, elab_as_eliminator]
protected def rec_on_subsingleton
   [∀ a, subsingleton (C (mk a))] (q : trunc α) (f : Π a, C (mk a)) : C q :=
trunc.rec f (λ a b, subsingleton.elim _ (f b)) q

/-- Noncomputably extract a representative of `trunc α` (using the axiom of choice). -/
noncomputable def out : trunc α → α := quot.out

@[simp] theorem out_eq (q : trunc α) : mk q.out = q := trunc.eq _ _

protected theorem nonempty (q : trunc α) : nonempty α :=
nonempty_of_exists q.exists_rep

end trunc

namespace quotient
variables {γ : Sort*} {φ : Sort*}
  {s₁ : setoid α} {s₂ : setoid β} {s₃ : setoid γ}

/-! Versions of quotient definitions and lemmas ending in `'` use unification instead
of typeclass inference for inferring the `setoid` argument. This is useful when there are
several different quotient relations on a type, for example quotient groups, rings and modules. -/

/-- A version of `quotient.mk` taking `{s : setoid α}` as an implicit argument instead of an
instance argument. -/
protected def mk' (a : α) : quotient s₁ := quot.mk s₁.1 a

/-- `quotient.mk'` is a surjective function. -/
lemma surjective_quotient_mk' : function.surjective (quotient.mk' : α → quotient s₁) :=
quot.exists_rep

/-- A version of `quotient.lift_on` taking `{s : setoid α}` as an implicit argument instead of an
instance argument. -/
@[elab_as_eliminator, reducible]
protected def lift_on' (q : quotient s₁) (f : α → φ)
  (h : ∀ a b, @setoid.r α s₁ a b → f a = f b) : φ := quotient.lift_on q f h

@[simp]
protected lemma lift_on'_mk' (f : α → φ) (h) (x : α) :
  quotient.lift_on' (@quotient.mk' _ s₁ x) f h = f x := rfl

/-- A version of `quotient.lift_on₂` taking `{s₁ : setoid α} {s₂ : setoid β}` as implicit arguments
instead of instance arguments. -/
@[elab_as_eliminator, reducible]
protected def lift_on₂' (q₁ : quotient s₁) (q₂ : quotient s₂) (f : α → β → γ)
  (h : ∀ a₁ a₂ b₁ b₂, @setoid.r α s₁ a₁ b₁ → @setoid.r β s₂ a₂ b₂ → f a₁ a₂ = f b₁ b₂) : γ :=
quotient.lift_on₂ q₁ q₂ f h

@[simp]
protected lemma lift_on₂'_mk' (f : α → β → γ) (h) (a : α) (b : β) :
  quotient.lift_on₂' (@quotient.mk' _ s₁ a) (@quotient.mk' _ s₂ b) f h = f a b := rfl

/-- A version of `quotient.ind` taking `{s : setoid α}` as an implicit argument instead of an
instance argument. -/
@[elab_as_eliminator]
protected lemma ind' {p : quotient s₁ → Prop}
  (h : ∀ a, p (quotient.mk' a)) (q : quotient s₁) : p q :=
quotient.ind h q

/-- A version of `quotient.ind₂` taking `{s₁ : setoid α} {s₂ : setoid β}` as implicit arguments
instead of instance arguments. -/
@[elab_as_eliminator]
protected lemma ind₂' {p : quotient s₁ → quotient s₂ → Prop}
  (h : ∀ a₁ a₂, p (quotient.mk' a₁) (quotient.mk' a₂))
  (q₁ : quotient s₁) (q₂ : quotient s₂) : p q₁ q₂ :=
quotient.ind₂ h q₁ q₂

/-- A version of `quotient.induction_on` taking `{s : setoid α}` as an implicit argument instead
of an instance argument. -/
@[elab_as_eliminator]
protected lemma induction_on' {p : quotient s₁ → Prop} (q : quotient s₁)
  (h : ∀ a, p (quotient.mk' a)) : p q := quotient.induction_on q h

/-- A version of `quotient.induction_on₂` taking `{s₁ : setoid α} {s₂ : setoid β}` as implicit
arguments instead of instance arguments. -/
@[elab_as_eliminator]
protected lemma induction_on₂' {p : quotient s₁ → quotient s₂ → Prop} (q₁ : quotient s₁)
  (q₂ : quotient s₂) (h : ∀ a₁ a₂, p (quotient.mk' a₁) (quotient.mk' a₂)) : p q₁ q₂ :=
quotient.induction_on₂ q₁ q₂ h

/-- A version of `quotient.induction_on₃` taking `{s₁ : setoid α} {s₂ : setoid β} {s₃ : setoid γ}`
as implicit arguments instead of instance arguments. -/
@[elab_as_eliminator]
protected lemma induction_on₃' {p : quotient s₁ → quotient s₂ → quotient s₃ → Prop}
  (q₁ : quotient s₁) (q₂ : quotient s₂) (q₃ : quotient s₃)
  (h : ∀ a₁ a₂ a₃, p (quotient.mk' a₁) (quotient.mk' a₂) (quotient.mk' a₃)) : p q₁ q₂ q₃ :=
quotient.induction_on₃ q₁ q₂ q₃ h

/-- A version of `quotient.rec_on_subsingleton` taking `{s₁ : setoid α}` as an implicit argument
instead of an instance argument. -/
@[elab_as_eliminator]
protected def rec_on_subsingleton' {φ : quotient s₁ → Sort*}
  [h : ∀ a, subsingleton (φ ⟦a⟧)] (q : quotient s₁) (f : Π a, φ (quotient.mk' a)) : φ q :=
quotient.rec_on_subsingleton q f

/-- A version of `quotient.rec_on_subsingleton₂` taking `{s₁ : setoid α} {s₂ : setoid α}`
as implicit arguments instead of instance arguments. -/
attribute [reducible, elab_as_eliminator]
protected def rec_on_subsingleton₂'
   {φ : quotient s₁ → quotient s₂ → Sort*} [h : ∀ a b, subsingleton (φ ⟦a⟧ ⟦b⟧)]
   (q₁ : quotient s₁) (q₂ : quotient s₂) (f : Π a₁ a₂, φ (quotient.mk' a₁) (quotient.mk' a₂)) :
   φ q₁ q₂ :=
quotient.rec_on_subsingleton₂ q₁ q₂ f

/-- Recursion on a `quotient` argument `a`, result type depends on `⟦a⟧`. -/
protected def hrec_on' {φ : quotient s₁ → Sort*} (qa : quotient s₁) (f : Π a, φ (quotient.mk' a))
  (c : ∀ a₁ a₂, a₁ ≈ a₂ → f a₁ == f a₂) : φ qa :=
quot.hrec_on qa f c

@[simp]

/-- Recursion on two `quotient` arguments `a` and `b`, result type depends on `⟦a⟧` and `⟦b⟧`. -/
protected def hrec_on₂' {φ : quotient s₁ → quotient s₂ → Sort*} (qa : quotient s₁)
  (qb : quotient s₂) (f : ∀ a b, φ (quotient.mk' a) (quotient.mk' b))
  (c : ∀ a₁ b₁ a₂ b₂, a₁ ≈ a₂ → b₁ ≈ b₂ → f a₁ b₁ == f a₂ b₂) : φ qa qb :=
quotient.hrec_on₂ qa qb f c

@[simp] lemma hrec_on₂'_mk' {φ : quotient s₁ → quotient s₂ → Sort*}
  (f : ∀ a b, φ (quotient.mk' a) (quotient.mk' b))
  (c : ∀ a₁ b₁ a₂ b₂, a₁ ≈ a₂ → b₁ ≈ b₂ → f a₁ b₁ == f a₂ b₂) (x : α) (qb : quotient s₂) :
  (quotient.mk' x).hrec_on₂' qb f c = qb.hrec_on' (f x) (λ b₁ b₂, c _ _ _ _ (setoid.refl _)) :=
rfl

/-- Map a function `f : α → β` that sends equivalent elements to equivalent elements
to a function `quotient sa → quotient sb`. Useful to define unary operations on quotients. -/
protected def map' (f : α → β) (h : (s₁.r ⇒ s₂.r) f f) :
  quotient s₁ → quotient s₂ :=
quot.map f h

@[simp] lemma map'_mk' (f : α → β) (h) (x : α) :
  (quotient.mk' x : quotient s₁).map' f h = (quotient.mk' (f x) : quotient s₂) :=
rfl

/-- A version of `quotient.map₂` using curly braces and unification. -/
protected def map₂' (f : α → β → γ) (h : (s₁.r ⇒ s₂.r ⇒ s₃.r) f f) :
  quotient s₁ → quotient s₂ → quotient s₃ :=
quotient.map₂ f h

@[simp] lemma map₂'_mk' (f : α → β → γ) (h) (x : α) :
  (quotient.mk' x : quotient s₁).map₂' f h =
    (quotient.map' (f x) (h (setoid.refl x)) : quotient s₂ → quotient s₃) :=
rfl

lemma exact' {a b : α} :
  (quotient.mk' a : quotient s₁) = quotient.mk' b → @setoid.r _ s₁ a b :=
quotient.exact

lemma sound' {a b : α} : @setoid.r _ s₁ a b → @quotient.mk' α s₁ a = quotient.mk' b :=
quotient.sound

@[simp]
protected lemma eq' {a b : α} : @quotient.mk' α s₁ a = quotient.mk' b ↔ @setoid.r _ s₁ a b :=
quotient.eq

/-- A version of `quotient.out` taking `{s₁ : setoid α}` as an implicit argument instead of an
instance argument. -/
noncomputable def out' (a : quotient s₁) : α := quotient.out a

@[simp] theorem out_eq' (q : quotient s₁) : quotient.mk' q.out' = q := q.out_eq

theorem mk_out' (a : α) : @setoid.r α s₁ (quotient.mk' a : quotient s₁).out' a :=
quotient.exact (quotient.out_eq _)

section

variables [setoid α]

protected lemma mk'_eq_mk (x : α) : quotient.mk' x = ⟦x⟧ := rfl

@[simp] protected lemma lift_on'_mk (x : α) (f : α → β) (h) : ⟦x⟧.lift_on' f h = f x := rfl

@[simp] protected lemma lift_on₂'_mk [setoid β] (f : α → β → γ) (h) (a : α) (b : β) :
  quotient.lift_on₂' ⟦a⟧ ⟦b⟧ f h = f a b := quotient.lift_on₂'_mk' _ _ _ _

@[simp] lemma map'_mk [setoid β] (f : α → β) (h) (x : α) : ⟦x⟧.map' f h = ⟦f x⟧ := rfl

end

end quotient


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

import control.functor.multivariate
import data.qpf.multivariate.basic

/-!
# Constant functors are QPFs

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

Constant functors map every type vectors to the same target type. This
is a useful device for constructing data types from more basic types
that are not actually functorial. For instance `const n nat` makes
`nat` into a functor that can be used in a functor-based data type
specification.
-/

universes u

namespace mvqpf
open_locale mvfunctor

variables (n : ℕ)

/-- Constant multivariate functor -/
@[nolint unused_arguments]
def const (A : Type*) (v : typevec.{u} n) : Type* :=
A

instance const.inhabited {A α} [inhabited A] : inhabited (const n A α) :=
⟨ (default : A) ⟩

namespace const
open mvfunctor mvpfunctor
variables {n} {A : Type u} {α β : typevec.{u} n} (f : α ⟹ β)

/-- Constructor for constant functor -/
protected def mk (x : A) : (const n A) α := x

/-- Destructor for constant functor -/
protected def get (x : (const n A) α) : A := x

@[simp] protected lemma mk_get (x : (const n A) α) : const.mk (const.get x) = x := rfl

@[simp] protected lemma get_mk (x : A) : const.get (const.mk x : const n A α) = x := rfl

/-- `map` for constant functor -/
protected def map : (const n A) α → (const n A) β :=
λ x, x

instance : mvfunctor (const n A) :=
{ map := λ α β f, const.map }

lemma map_mk (x : A) :
  f <$$> const.mk x = const.mk x := rfl

lemma get_map (x : (const n A) α) :
  const.get (f <$$> x) = const.get x := rfl

instance mvqpf : @mvqpf _ (const n A) (mvqpf.const.mvfunctor) :=
{ P         := mvpfunctor.const n A,
  abs       := λ α x, mvpfunctor.const.get x,
  repr      := λ α x, mvpfunctor.const.mk n x,
  abs_repr  := by intros; simp,
  abs_map   := by intros; simp; refl, }

end const

end mvqpf


def Hd : List α → Type
  | []     => PUnit
  | a :: _ => α

def hd : (as : List α) → Hd as
  | []     => ()
  | a :: l => a

theorem inj_hd (α : Type) : (a a': α) → (l l' : List α) → a :: l = a' :: l' → a = a' := by
  intro a a' l l' h
  show hd (a :: l) = hd (a' :: l')
  cases h
  rfl


/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Jeremy Avigad

Weak orders "≤", strict orders "<", and structures that include both.
-/
import .binary
universes u v w
hott_theory
set_option old_structure_cmd true

namespace hott

open algebra

variable {A : Type _}

/- weak orders -/

class has_le (α : Type u) := (le : α → α → Type u)
class has_lt (α : Type u) := (lt : α → α → Type u)

@[reducible] def ge {α : Type u} [has_le α] (a b : α) : Type u := has_le.le b a
@[reducible] def gt {α : Type u} [has_lt α] (a b : α) : Type u := has_lt.lt b a

hott_theory_cmd "local infix [parsing_only] ` <= ` := hott.has_le.le"
hott_theory_cmd "local infix ` ≤ `  := hott.has_le.le"
hott_theory_cmd "local infix ` < ` := hott.has_lt.lt"
hott_theory_cmd "local infix [parsing_only] ` >= ` := hott.ge"
hott_theory_cmd "local infix ` ≥ `  := hott.ge"
hott_theory_cmd "local infix ` > ` := hott.gt"

namespace algebra
@[hott, class] structure weak_order (A : Type _) extends has_le A :=
(le_refl : Πa, le a a)
(le_trans : Πa b c, le a b → le b c → le a c)
(le_antisymm : Πa b, le a b → le b a → a = b)

section
  variable [s : weak_order A]
  include s

  @[hott, refl] def le.rfl {a : A} : a ≤ a := weak_order.le_refl _
  @[hott] def le.refl (a : A) : a ≤ a := weak_order.le_refl _

  @[hott] def le_of_eq {a b : A} (H : a = b) : a ≤ b := transport (λx, a ≤ x) H (le.refl a)
  @[hott] def ge_of_eq {a b : A} (H : a = b) : a ≥ b := le_of_eq H⁻¹

  @[hott, trans] def le.trans {a b c : A} : a ≤ b → b ≤ c → a ≤ c := weak_order.le_trans _ _ _

  @[hott, trans] def le.trans_eq {a b c : A} (H1 : a ≤ b) (H2 : b = c) : a ≤ c :=
  le.trans H1 (le_of_eq H2)

  @[hott, trans] def le.eq_trans {a b c : A} (H1 : a = b) (H2 : b ≤ c) : a ≤ c :=
  le.trans (le_of_eq H1) H2

  @[hott, trans] def ge.trans {a b c : A} (H1 : a ≥ b) (H2: b ≥ c) : a ≥ c := le.trans H2 H1

  @[hott, trans] def ge.trans_eq {a b c : A} (H1 : a ≥ b) (H2 : b = c) : a ≥ c :=
  le.eq_trans H2⁻¹ H1

  @[hott, trans] def ge.eq_trans {a b c : A} (H1 : a = b) (H2 : b ≥ c) : a ≥ c :=
  le.trans_eq H2 H1⁻¹

  @[hott] def le.antisymm {a b : A} : a ≤ b → b ≤ a → a = b := weak_order.le_antisymm _ _

  -- Alternate syntax. (Abbreviations do not migrate well.)
  @[hott] def eq_of_le_of_ge {a b : A} : a ≤ b → b ≤ a → a = b := le.antisymm
end

@[hott, class] structure linear_weak_order (A : Type _) extends weak_order A :=
(le_total : Πa b, le a b ⊎ le b a)

section
  variables [linear_weak_order A]

  @[hott] def le.total (a b : A) : a ≤ b ⊎ b ≤ a := linear_weak_order.le_total _ _

  @[hott] theorem le_of_not_ge {a b : A} (H : ¬ a ≥ b) : a ≤ b := sum.resolve_left (le.total _ _) H

  @[hott] def le_by_cases (a b : A) {P : Type _} (H1 : a ≤ b → P) (H2 : b ≤ a → P) : P :=
  begin
    cases (le.total a b) with H H,
    { exact H1 H},
    { exact H2 H}
  end
end

/- strict orders -/

@[hott, class] structure strict_order (A : Type _) extends has_lt A :=
(lt_irrefl : Πa, ¬ lt a a)
(lt_trans : Πa b c, lt a b → lt b c → lt a c)

section
  variable [s : strict_order A]
  include s

  @[hott] def lt.irrefl (a : A) : ¬ a < a := strict_order.lt_irrefl _
  @[hott] def not_lt_self (a : A) : ¬ a < a := lt.irrefl _   -- alternate syntax

  @[hott] theorem lt_self_iff_empty (a : A) : a < a ↔ empty :=
  iff_empty_intro (lt.irrefl a)

  @[hott, trans] def lt.trans {a b c : A} : a < b → b < c → a < c := strict_order.lt_trans _ _ _

  @[hott, trans] def lt.trans_eq {a b c : A} (H1 : a < b) (H2 : b = c) : a < c :=
  by hinduction H2; exact H1

  @[hott, trans] def lt.eq_trans {a b c : A} (H1 : a = b) (H2 : b < c) : a < c :=
  by hinduction H1; exact H2

  @[hott, trans] def gt.trans {a b c : A} (H1 : a > b) (H2: b > c) : a > c := lt.trans H2 H1

  @[hott, trans] def gt.trans_eq {a b c : A} (H1 : a > b) (H2 : b = c) : a > c :=
  by hinduction H2; exact H1

  @[hott, trans] def gt.eq_trans {a b c : A} (H1 : a = b) (H2 : b > c) : a > c :=
  by hinduction H1; exact H2

  @[hott] def ne_of_lt {a b : A} (lt_ab : a < b) : a ≠ b :=
  assume eq_ab : a = b,
  show empty, from lt.irrefl b (eq_ab ▸ lt_ab)

  @[hott] theorem ne_of_gt {a b : A} (gt_ab : a > b) : a ≠ b :=
  ne.symm (ne_of_lt gt_ab)

  @[hott] theorem lt.asymm {a b : A} (H : a < b) : ¬ b < a :=
  assume H1 : b < a, lt.irrefl _ (lt.trans H H1)

  @[hott] theorem not_lt_of_gt {a b : A} (H : a > b) : ¬ a < b := lt.asymm H    -- alternate syntax
end

/- well-founded orders -/

@[hott, class] structure wf_strict_order (A : Type _) extends strict_order A :=
(wf_rec : ΠP : A → Type _, (Πx, (Πy, lt y x → P y) → P x) → Πx, P x)

@[hott] def wf.rec_on {A : Type _} [s : wf_strict_order A] {P : A → Type _}
    (x : A) (H : Πx, (Πy, wf_strict_order.lt y x → P y) → P x) : P x :=
wf_strict_order.wf_rec P H x

/- structures with a weak and a strict order -/

@[hott, class] structure order_pair (A : Type _) extends weak_order A, has_lt A :=
(le_of_lt : Π a b, lt a b → le a b)
(lt_of_lt_of_le : Π a b c, lt a b → le b c → lt a c)
(lt_of_le_of_lt : Π a b c, le a b → lt b c → lt a c)
(lt_irrefl : Π a, ¬ lt a a)

section
  variable [s : order_pair A]
  variables {a b c : A}
  include s

  @[hott] def le_of_lt : a < b → a ≤ b := order_pair.le_of_lt _ _

  @[hott, trans] def lt_of_lt_of_le : a < b → b ≤ c → a < c := order_pair.lt_of_lt_of_le _ _ _

  @[hott, trans] def lt_of_le_of_lt : a ≤ b → b < c → a < c := order_pair.lt_of_le_of_lt _ _ _

  @[hott] private def lt_irrefl (s' : order_pair A) (a : A) : ¬ a < a := order_pair.lt_irrefl _

  @[hott] private def lt_trans (s' : order_pair A) (a b c: A) (lt_ab : a < b) (lt_bc : b < c) :
    a < c :=
  lt_of_lt_of_le lt_ab (le_of_lt lt_bc)

  @[hott, instance] def order_pair.to_strict_order : strict_order A :=
  { lt_irrefl := lt_irrefl s, lt_trans := lt_trans s, ..s }

  @[hott, trans] def gt_of_gt_of_ge (H1 : a > b) (H2 : b ≥ c) : a > c := lt_of_le_of_lt H2 H1

  @[hott, trans] def gt_of_ge_of_gt (H1 : a ≥ b) (H2 : b > c) : a > c := lt_of_lt_of_le H2 H1

  @[hott] def not_le_of_gt (H : a > b) : ¬ a ≤ b :=
  assume H1 : a ≤ b,
  lt.irrefl _ (lt_of_lt_of_le H H1)

  @[hott] theorem not_lt_of_ge (H : a ≥ b) : ¬ a < b :=
  assume H1 : a < b,
  lt.irrefl _ (lt_of_le_of_lt H H1)
end

@[hott, class] structure strong_order_pair (A : Type _) extends weak_order A, has_lt A :=
(le_iff_lt_sum_eq : Πa b, le a b ↔ lt a b ⊎ a = b)
(lt_irrefl : Π a, ¬ lt a a)

@[hott] def le_iff_lt_sum_eq [s : strong_order_pair A] {a b : A} : a ≤ b ↔ a < b ⊎ a = b :=
strong_order_pair.le_iff_lt_sum_eq _ _

@[hott] def lt_sum_eq_of_le [s : strong_order_pair A] {a b : A} (le_ab : a ≤ b) : a < b ⊎ a = b :=
iff.mp le_iff_lt_sum_eq le_ab

@[hott] def le_of_lt_sum_eq [s : strong_order_pair A] {a b : A} (lt_sum_eq : a < b ⊎ a = b) :
  a ≤ b :=
iff.mpr le_iff_lt_sum_eq lt_sum_eq

@[hott] private def lt_irrefl' [s : strong_order_pair A] (a : A) : ¬ a < a :=
strong_order_pair.lt_irrefl _

@[hott] private def le_of_lt' [s : strong_order_pair A] (a b : A) : a < b → a ≤ b :=
λHlt, le_of_lt_sum_eq (sum.inl Hlt)

@[hott] private def lt_iff_le_prod_ne [s : strong_order_pair A] {a b : A} :
  a < b ↔ (a ≤ b × a ≠ b) :=
iff.intro
  (λHlt, pair (le_of_lt_sum_eq (sum.inl Hlt)) (λHab, absurd (Hab ▸ Hlt) (lt_irrefl' _)))
  (λHand,
   have Hor : a < b ⊎ a = b, from lt_sum_eq_of_le Hand.fst,
   sum.resolve_right Hor Hand.snd)

@[hott] theorem lt_of_le_of_ne [s : strong_order_pair A] {a b : A} : a ≤ b → a ≠ b → a < b :=
λH1 H2, iff.mpr lt_iff_le_prod_ne (pair H1 H2)

@[hott] private def ne_of_lt' [s : strong_order_pair A] {a b : A} (H : a < b) : a ≠ b :=
((iff.mp (@lt_iff_le_prod_ne _ _ _ _)) H).snd

@[hott] private def lt_of_lt_of_le' [s : strong_order_pair A] (a b c : A) : a < b → b ≤ c → a < c :=
assume lt_ab : a < b,
assume le_bc : b ≤ c,
have le_ac : a ≤ c, from le.trans (le_of_lt' _ _ lt_ab) le_bc,
have ne_ac : a ≠ c, from
  assume eq_ac : a = c,
  have le_ba : b ≤ a, from eq_ac⁻¹ ▸ le_bc,
  have eq_ab : a = b, from le.antisymm  (le_of_lt' _ _ lt_ab) le_ba,
  show empty, from ne_of_lt' lt_ab eq_ab,
show a < c, from iff.mpr (lt_iff_le_prod_ne) (pair le_ac ne_ac)

@[hott] def lt_of_le_of_lt' [s : strong_order_pair A] (a b c : A) : a ≤ b → b < c → a < c :=
assume le_ab : a ≤ b,
assume lt_bc : b < c,
have le_ac : a ≤ c, from le.trans le_ab (le_of_lt' _ _ lt_bc),
have ne_ac : a ≠ c, from
  assume eq_ac : a = c,
  have le_cb : c ≤ b, from eq_ac ▸ le_ab,
  have eq_bc : b = c, from le.antisymm  (le_of_lt' _ _ lt_bc) le_cb,
  show empty, from ne_of_lt' lt_bc eq_bc,
show a < c, from iff.mpr (lt_iff_le_prod_ne) (pair le_ac ne_ac)

@[hott, instance] def strong_order_pair.to_order_pair [s : strong_order_pair A] : order_pair A :=
{ lt_irrefl := lt_irrefl',
  le_of_lt := le_of_lt',
  lt_of_le_of_lt := lt_of_le_of_lt',
  lt_of_lt_of_le := lt_of_lt_of_le', ..s }

/- linear orders -/

@[hott, class] structure linear_order_pair (A : Type _) extends order_pair A, linear_weak_order A

@[hott, class] structure linear_strong_order_pair (A : Type _) extends strong_order_pair A,
    linear_weak_order A

@[hott, instance] def linear_strong_order_pair.to_linear_order_pair
    [s : linear_strong_order_pair A] : linear_order_pair A :=
{ ..s, ..strong_order_pair.to_order_pair }

section
  variable [s : linear_strong_order_pair A]
  variables (a b c : A)
  include s

  @[hott] def lt.trichotomy : a < b ⊎ a = b ⊎ b < a :=
  sum.elim (le.total a b)
    (assume H : a ≤ b,
      sum.elim (iff.mp le_iff_lt_sum_eq H) sum.inl (assume H1, sum.inr (sum.inl H1)))
    (assume H : b ≤ a,
      sum.elim (iff.mp le_iff_lt_sum_eq H)
        (assume H1, sum.inr (sum.inr H1))
        (assume H1, sum.inr (sum.inl (H1⁻¹))))

  @[hott] def lt.by_cases {a b : A} {P : Type _}
    (H1 : a < b → P) (H2 : a = b → P) (H3 : b < a → P) : P :=
  sum.elim (lt.trichotomy _ _)
    (assume H, H1 H)
    (assume H, sum.elim H (assume H', H2 H') (assume H', H3 H'))

  @[hott] def lt_ge_by_cases {a b : A} {P : Type _} (H1 : a < b → P) (H2 : a ≥ b → P) : P :=
  lt.by_cases H1 (λH, H2 (le_of_eq H⁻¹)) (λH, H2 (le_of_lt H))

  @[hott] def le_of_not_gt {a b : A} (H : ¬ a > b) : a ≤ b :=
  lt.by_cases (assume H', absurd H' H) (assume H', le_of_eq H'⁻¹) (assume H', le_of_lt H')

  @[hott] theorem lt_of_not_ge {a b : A} (H : ¬ a ≥ b) : a < b :=
  lt.by_cases
    (assume H', absurd begin exact le_of_lt H' end H)
    (assume H', absurd (le_of_eq H') H)
    (assume H', H')

  @[hott] theorem lt_sum_ge : a < b ⊎ a ≥ b :=
  lt.by_cases
    (assume H1 : a < b, sum.inl H1)
    (assume H1 : a = b, sum.inr (le_of_eq H1⁻¹))
    (assume H1 : a > b, sum.inr (le_of_lt H1))

  @[hott] theorem le_sum_gt : a ≤ b ⊎ a > b :=
  sum.swap (lt_sum_ge b a)

  @[hott] theorem lt_sum_gt_of_ne {a b : A} (H : a ≠ b) : a < b ⊎ a > b :=
  lt.by_cases (assume H1, sum.inl H1) (assume H1, absurd H1 H) (assume H1, sum.inr H1)
end

open decidable

@[hott, class] structure decidable_linear_order (A : Type _) extends linear_strong_order_pair A :=
(decidable_lt : decidable_rel lt)

section
  variable [s : decidable_linear_order A]
  variables {a b c d : A}
  include s
  open hott.decidable

  @[hott, instance] def decidable_lt : decidable (a < b) :=
  @decidable_linear_order.decidable_lt _ _ _ _

  @[hott, instance] def decidable_le : decidable (a ≤ b) :=
  by_cases
    (assume H : a < b, inl (le_of_lt H))
    (assume H : ¬ a < b,
      have H1 : b ≤ a, from le_of_not_gt H,
      by_cases
        (assume H2 : b < a, inr (not_le_of_gt H2))
        (assume H2 : ¬ b < a, inl (le_of_not_gt H2)))

  @[hott, instance] def has_decidable_eq : decidable (a = b) :=
  by_cases
    (assume H : a ≤ b,
      by_cases
        (assume H1 : b ≤ a, inl (le.antisymm H H1))
        (assume H1 : ¬ b ≤ a, inr (assume H2 : a = b, H1 (le_of_eq H2⁻¹))))
    (assume H : ¬ a ≤ b,
      (inr (assume H1 : a = b, H (le_of_eq H1))))

  @[hott] theorem eq_sum_lt_of_not_lt {a b : A} (H : ¬ a < b) : a = b ⊎ b < a :=
  if Heq :: a = b then sum.inl Heq else sum.inr (lt_of_not_ge (λ Hge, H (lt_of_le_of_ne Hge Heq)))

  @[hott] theorem eq_sum_lt_of_le {a b : A} (H : a ≤ b) : a = b ⊎ a < b :=
    begin
      hinduction eq_sum_lt_of_not_lt (not_lt_of_ge H) with x1 H' H',
      exact sum.inl H'⁻¹,
      exact sum.inr H'
    end

  @[hott] def lt.cases {B : Type _} (a b : A) (t_lt t_eq t_gt : B) : B :=
  if' a = b then t_eq else (if' a < b then t_lt else t_gt)

  @[hott] theorem lt.cases_of_eq {B : Type _} {a b : A} {t_lt t_eq t_gt : B} (H : a = b) :
  lt.cases a b t_lt t_eq t_gt = t_eq := if_pos H

  @[hott] theorem lt.cases_of_lt {B : Type _} {a b : A} {t_lt t_eq t_gt : B} (H : a < b) :
    lt.cases a b t_lt t_eq t_gt = t_lt :=
  if_neg (ne_of_lt H) ⬝ if_pos H

  @[hott] theorem lt.cases_of_gt {B : Type _} {a b : A} {t_lt t_eq t_gt : B} (H : a > b) :
    lt.cases a b t_lt t_eq t_gt = t_gt :=
  if_neg (ne.symm (ne_of_lt H)) ⬝ if_neg (lt.asymm H)

  @[hott] def min (a b : A) : A := if' a ≤ b then a else b
  @[hott] def max (a b : A) : A := if' a ≤ b then b else a

  /- these show min and max form a lattice -/

  @[hott] theorem min_le_left (a b : A) : min a b ≤ a :=
  hott.decidable.by_cases
    (assume H : a ≤ b, by dsimp [min]; rwr [if_pos H])
    (assume H : ¬ a ≤ b, by dsimp [min]; rwr [if_neg H]; apply le_of_lt (lt_of_not_ge H))

  @[hott] theorem min_le_right (a b : A) : min a b ≤ b :=
  hott.decidable.by_cases
    (assume H : a ≤ b, by dsimp [min]; rwr [if_pos H]; apply H)
    (assume H : ¬ a ≤ b, by dsimp [min]; rwr [if_neg H])

  @[hott] theorem le_min {a b c : A} (H₁ : c ≤ a) (H₂ : c ≤ b) : c ≤ min a b :=
  hott.decidable.by_cases
    (assume H : a ≤ b, by dsimp [min]; rwr [if_pos H]; apply H₁)
    (assume H : ¬ a ≤ b, by dsimp [min]; rwr [if_neg H]; apply H₂)

  @[hott] theorem le_max_left (a b : A) : a ≤ max a b :=
  hott.decidable.by_cases
    (assume H : a ≤ b, by dsimp [max]; rwr [if_pos H]; apply H)
    (assume H : ¬ a ≤ b, by dsimp [max]; rwr [if_neg H])

  @[hott] theorem le_max_right (a b : A) : b ≤ max a b :=
  hott.decidable.by_cases
    (assume H : a ≤ b, by dsimp [max]; rwr [if_pos H])
    (assume H : ¬ a ≤ b, by dsimp [max]; rwr [if_neg H]; apply le_of_lt (lt_of_not_ge H))

  @[hott] theorem max_le {a b c : A} (H₁ : a ≤ c) (H₂ : b ≤ c) : max a b ≤ c :=
  hott.decidable.by_cases
    (assume H : a ≤ b, by dsimp [max]; rwr [if_pos H]; apply H₂)
    (assume H : ¬ a ≤ b, by dsimp [max]; rwr [if_neg H]; apply H₁)

  @[hott] theorem le_max_left_iff_unit (a b : A) : a ≤ max a b ↔ unit :=
  iff_unit_intro (le_max_left a b)

  @[hott] theorem le_max_right_iff_unit (a b : A) : b ≤ max a b ↔ unit :=
  iff_unit_intro (le_max_right a b)

  /- these are also proved for lattices, but with inf and sup in place of min and max -/

  @[hott] theorem eq_min {a b c : A} (H₁ : c ≤ a) (H₂ : c ≤ b) (H₃ : Π{d}, d ≤ a → d ≤ b → d ≤ c) :
    c = min a b :=
  le.antisymm (le_min H₁ H₂) (H₃ (min_le_left _ _) (min_le_right _ _))

  @[hott] theorem min.comm (a b : A) : min a b = min b a :=
  eq_min (min_le_right _ _) (min_le_left _ _) (λ c H₁ H₂, le_min H₂ H₁)

  @[hott] theorem min.assoc (a b c : A) : min (min a b) c = min a (min b c) :=
  begin
    apply eq_min,
    { apply le.trans, apply min_le_left, apply min_le_left },
    { apply le_min, apply le.trans, apply min_le_left, apply min_le_right, apply min_le_right },
    { intros d H₁ H₂, apply le_min, apply le_min H₁, apply le.trans H₂, apply min_le_left,
      apply le.trans H₂, apply min_le_right }
  end

  @[hott] theorem min.left_comm (a b c : A) : min a (min b c) = min b (min a c) :=
  binary.left_comm (@min.comm A s) (@min.assoc A s) a b c

  @[hott] theorem min.right_comm (a b c : A) : min (min a b) c = min (min a c) b :=
  binary.right_comm (@min.comm A s) (@min.assoc A s) a b c

  @[hott] theorem min_self (a : A) : min a a = a :=
  by apply inverse; apply eq_min (le.refl a) le.rfl; intros; assumption

  @[hott] theorem min_eq_left {a b : A} (H : a ≤ b) : min a b = a :=
  by apply inverse; apply eq_min le.rfl H; intros; assumption

  @[hott] theorem min_eq_right {a b : A} (H : b ≤ a) : min a b = b :=
  by rwr min.comm; exact min_eq_left H

  @[hott] theorem eq_max {a b c : A} (H₁ : a ≤ c) (H₂ : b ≤ c) (H₃ : Π{d}, a ≤ d → b ≤ d → c ≤ d) :
    c = max a b :=
  le.antisymm (H₃ (le_max_left _ _) (le_max_right _ _)) (max_le H₁ H₂)

  @[hott] theorem max.comm (a b : A) : max a b = max b a :=
  eq_max (le_max_right _ _) (le_max_left _ _) (λ c H₁ H₂, max_le H₂ H₁)

  @[hott] theorem max.assoc (a b c : A) : max (max a b) c = max a (max b c) :=
  begin
    apply eq_max,
    { apply le.trans, apply le_max_left a b, apply le_max_left },
    { apply max_le, apply le.trans, apply le_max_right a b, apply le_max_left, apply le_max_right },
    { intros d H₁ H₂, apply max_le, apply max_le H₁, apply le.trans (le_max_left _ _) H₂,
      apply le.trans (le_max_right _ _) H₂}
  end

  @[hott] theorem max.left_comm (a b c : A) : max a (max b c) = max b (max a c) :=
  binary.left_comm (@max.comm A s) (@max.assoc A s) a b c

  @[hott] theorem max.right_comm (a b c : A) : max (max a b) c = max (max a c) b :=
  binary.right_comm (@max.comm A s) (@max.assoc A s) a b c

  @[hott] theorem max_self (a : A) : max a a = a :=
  by apply inverse; apply eq_max (le.refl a) le.rfl; intros; assumption

  @[hott] theorem max_eq_left {a b : A} (H : b ≤ a) : max a b = a :=
  by apply inverse; apply eq_max le.rfl H; intros; assumption

  @[hott] theorem max_eq_right {a b : A} (H : a ≤ b) : max a b = b :=
  by rwr max.comm; exact max_eq_left H

  /- these rely on lt_of_lt -/

  @[hott] theorem min_eq_left_of_lt {a b : A} (H : a < b) : min a b = a :=
  min_eq_left (le_of_lt H)

  @[hott] theorem min_eq_right_of_lt {a b : A} (H : b < a) : min a b = b :=
  min_eq_right (le_of_lt H)

  @[hott] theorem max_eq_left_of_lt {a b : A} (H : b < a) : max a b = a :=
  max_eq_left (le_of_lt H)

  @[hott] theorem max_eq_right_of_lt {a b : A} (H : a < b) : max a b = b :=
  max_eq_right (le_of_lt H)

  /- these use the fact that it is a linear ordering -/

  @[hott] theorem lt_min {a b c : A} (H₁ : a < b) (H₂ : a < c) : a < min b c :=
  sum.elim (le_sum_gt _ _)
    (assume H : b ≤ c, by rwr (min_eq_left H); apply H₁)
    (assume H : b > c, by rwr (min_eq_right_of_lt H); apply H₂)

  @[hott] theorem max_lt {a b c : A} (H₁ : a < c) (H₂ : b < c) : max a b < c :=
  sum.elim (le_sum_gt _ _)
    (assume H : a ≤ b, by rwr (max_eq_right H); apply H₂)
    (assume H : a > b, by rwr (max_eq_left_of_lt H); apply H₁)
end
end algebra
end hott


/-
Copyright (c) 2018 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Simon Hudon

! This file was ported from Lean 3 source module data.pfunctor.multivariate.basic
! leanprover-community/mathlib commit 23aa88e32dcc9d2a24cca7bc23268567ed4cd7d6
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Control.Functor.Multivariate
import Mathbin.Data.Pfunctor.Univariate.Basic

/-!
# Multivariate polynomial functors.

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

Multivariate polynomial functors are used for defining M-types and W-types.
They map a type vector `α` to the type `Σ a : A, B a ⟹ α`, with `A : Type` and
`B : A → typevec n`. They interact well with Lean's inductive definitions because
they guarantee that occurrences of `α` are positive.
-/

universe u v

open MvFunctor

#print MvPFunctor /-
/-- multivariate polynomial functors
-/
structure MvPFunctor (n : ℕ) where
  A : Type u
  B : A → TypeVec.{u} n
#align mvpfunctor MvPFunctor
-/

namespace MvPFunctor

open MvFunctor (Liftp Liftr)

variable {n m : ℕ} (P : MvPFunctor.{u} n)

#print MvPFunctor.Obj /-
/-- Applying `P` to an object of `Type` -/
def Obj (α : TypeVec.{u} n) : Type u :=
  Σa : P.A, P.B a ⟹ α
#align mvpfunctor.obj MvPFunctor.Obj
-/

#print MvPFunctor.map /-
/-- Applying `P` to a morphism of `Type` -/
def map {α β : TypeVec n} (f : α ⟹ β) : P.Obj α → P.Obj β := fun ⟨a, g⟩ => ⟨a, TypeVec.comp f g⟩
#align mvpfunctor.map MvPFunctor.map
-/

instance : Inhabited (MvPFunctor n) :=
  ⟨⟨default, default⟩⟩

#print MvPFunctor.Obj.inhabited /-
instance Obj.inhabited {α : TypeVec n} [Inhabited P.A] [∀ i, Inhabited (α i)] :
    Inhabited (P.Obj α) :=
  ⟨⟨default, fun _ _ => default⟩⟩
#align mvpfunctor.obj.inhabited MvPFunctor.Obj.inhabited
-/

instance : MvFunctor P.Obj :=
  ⟨@MvPFunctor.map n P⟩

#print MvPFunctor.map_eq /-
theorem map_eq {α β : TypeVec n} (g : α ⟹ β) (a : P.A) (f : P.B a ⟹ α) :
    @MvFunctor.map _ P.Obj _ _ _ g ⟨a, f⟩ = ⟨a, g ⊚ f⟩ :=
  rfl
#align mvpfunctor.map_eq MvPFunctor.map_eq
-/

#print MvPFunctor.id_map /-
theorem id_map {α : TypeVec n} : ∀ x : P.Obj α, TypeVec.id <$$> x = x
  | ⟨a, g⟩ => rfl
#align mvpfunctor.id_map MvPFunctor.id_map
-/

#print MvPFunctor.comp_map /-
theorem comp_map {α β γ : TypeVec n} (f : α ⟹ β) (g : β ⟹ γ) :
    ∀ x : P.Obj α, (g ⊚ f) <$$> x = g <$$> f <$$> x
  | ⟨a, h⟩ => rfl
#align mvpfunctor.comp_map MvPFunctor.comp_map
-/

instance : LawfulMvFunctor P.Obj where
  id_map := @id_map _ P
  comp_map := @comp_map _ P

#print MvPFunctor.const /-
/-- Constant functor where the input object does not affect the output -/
def const (n : ℕ) (A : Type u) : MvPFunctor n :=
  { A
    B := fun a i => PEmpty }
#align mvpfunctor.const MvPFunctor.const
-/

section Const

variable (n) {A : Type u} {α β : TypeVec.{u} n}

#print MvPFunctor.const.mk /-
/-- Constructor for the constant functor -/
def const.mk (x : A) {α} : (const n A).Obj α :=
  ⟨x, fun i a => PEmpty.elim a⟩
#align mvpfunctor.const.mk MvPFunctor.const.mk
-/

variable {n A}

#print MvPFunctor.const.get /-
/-- Destructor for the constant functor -/
def const.get (x : (const n A).Obj α) : A :=
  x.1
#align mvpfunctor.const.get MvPFunctor.const.get
-/

#print MvPFunctor.const.get_map /-
@[simp]
theorem const.get_map (f : α ⟹ β) (x : (const n A).Obj α) : const.get (f <$$> x) = const.get x :=
  by
  cases x
  rfl
#align mvpfunctor.const.get_map MvPFunctor.const.get_map
-/

#print MvPFunctor.const.get_mk /-
@[simp]
theorem const.get_mk (x : A) : const.get (const.mk n x : (const n A).Obj α) = x := by rfl
#align mvpfunctor.const.get_mk MvPFunctor.const.get_mk
-/

#print MvPFunctor.const.mk_get /-
@[simp]
theorem const.mk_get (x : (const n A).Obj α) : const.mk n (const.get x) = x :=
  by
  cases x
  dsimp [const.get, const.mk]
  congr with (_⟨⟩)
#align mvpfunctor.const.mk_get MvPFunctor.const.mk_get
-/

end Const

#print MvPFunctor.comp /-
/-- Functor composition on polynomial functors -/
def comp (P : MvPFunctor.{u} n) (Q : Fin2 n → MvPFunctor.{u} m) : MvPFunctor m
    where
  A := Σa₂ : P.1, ∀ i, P.2 a₂ i → (Q i).1
  B a i := Σ(j : _)(b : P.2 a.1 j), (Q j).2 (a.snd j b) i
#align mvpfunctor.comp MvPFunctor.comp
-/

variable {P} {Q : Fin2 n → MvPFunctor.{u} m} {α β : TypeVec.{u} m}

#print MvPFunctor.comp.mk /-
/-- Constructor for functor composition -/
def comp.mk (x : P.Obj fun i => (Q i).Obj α) : (comp P Q).Obj α :=
  ⟨⟨x.1, fun i a => (x.2 _ a).1⟩, fun i a => (x.snd a.fst a.snd.fst).snd i a.snd.snd⟩
#align mvpfunctor.comp.mk MvPFunctor.comp.mk
-/

#print MvPFunctor.comp.get /-
/-- Destructor for functor composition -/
def comp.get (x : (comp P Q).Obj α) : P.Obj fun i => (Q i).Obj α :=
  ⟨x.1.1, fun i a => ⟨x.fst.snd i a, fun (j : Fin2 m) (b : (Q i).B _ j) => x.snd j ⟨i, ⟨a, b⟩⟩⟩⟩
#align mvpfunctor.comp.get MvPFunctor.comp.get
-/

#print MvPFunctor.comp.get_map /-
theorem comp.get_map (f : α ⟹ β) (x : (comp P Q).Obj α) :
    comp.get (f <$$> x) = (fun i (x : (Q i).Obj α) => f <$$> x) <$$> comp.get x :=
  by
  cases x
  rfl
#align mvpfunctor.comp.get_map MvPFunctor.comp.get_map
-/

#print MvPFunctor.comp.get_mk /-
@[simp]
theorem comp.get_mk (x : P.Obj fun i => (Q i).Obj α) : comp.get (comp.mk x) = x :=
  by
  cases x
  simp! [comp.get, comp.mk]
#align mvpfunctor.comp.get_mk MvPFunctor.comp.get_mk
-/

#print MvPFunctor.comp.mk_get /-
@[simp]
theorem comp.mk_get (x : (comp P Q).Obj α) : comp.mk (comp.get x) = x :=
  by
  cases x
  dsimp [comp.get, comp.mk]
  ext : 2 <;> intros ; rfl; rfl
  congr ; ext1 <;> intros <;> rfl
  ext : 2; congr ; rcases x_1 with ⟨a, b, c⟩ <;> rfl
#align mvpfunctor.comp.mk_get MvPFunctor.comp.mk_get
-/

#print MvPFunctor.liftP_iff /-
/-
lifting predicates and relations
-/
theorem liftP_iff {α : TypeVec n} (p : ∀ ⦃i⦄, α i → Prop) (x : P.Obj α) :
    LiftP p x ↔ ∃ a f, x = ⟨a, f⟩ ∧ ∀ i j, p (f i j) :=
  by
  constructor
  · rintro ⟨y, hy⟩
    cases' h : y with a f
    refine' ⟨a, fun i j => (f i j).val, _, fun i j => (f i j).property⟩
    rw [← hy, h, map_eq]
    rfl
  rintro ⟨a, f, xeq, pf⟩
  use ⟨a, fun i j => ⟨f i j, pf i j⟩⟩
  rw [xeq]; rfl
#align mvpfunctor.liftp_iff MvPFunctor.liftP_iff
-/

#print MvPFunctor.liftP_iff' /-
theorem liftP_iff' {α : TypeVec n} (p : ∀ ⦃i⦄, α i → Prop) (a : P.A) (f : P.B a ⟹ α) :
    @LiftP.{u} _ P.Obj _ α p ⟨a, f⟩ ↔ ∀ i x, p (f i x) :=
  by
  simp only [liftp_iff, Sigma.mk.inj_iff] <;> constructor <;> intro
  · casesm*Exists _, _ ∧ _
    subst_vars
    assumption
  repeat' first |constructor|assumption
#align mvpfunctor.liftp_iff' MvPFunctor.liftP_iff'
-/

#print MvPFunctor.liftR_iff /-
theorem liftR_iff {α : TypeVec n} (r : ∀ ⦃i⦄, α i → α i → Prop) (x y : P.Obj α) :
    LiftR r x y ↔ ∃ a f₀ f₁, x = ⟨a, f₀⟩ ∧ y = ⟨a, f₁⟩ ∧ ∀ i j, r (f₀ i j) (f₁ i j) :=
  by
  constructor
  · rintro ⟨u, xeq, yeq⟩
    cases' h : u with a f
    use a, fun i j => (f i j).val.fst, fun i j => (f i j).val.snd
    constructor
    · rw [← xeq, h]
      rfl
    constructor
    · rw [← yeq, h]
      rfl
    intro i j
    exact (f i j).property
  rintro ⟨a, f₀, f₁, xeq, yeq, h⟩
  use ⟨a, fun i j => ⟨(f₀ i j, f₁ i j), h i j⟩⟩
  dsimp; constructor
  · rw [xeq]
    rfl
  rw [yeq]; rfl
#align mvpfunctor.liftr_iff MvPFunctor.liftR_iff
-/

open Set MvFunctor

#print MvPFunctor.supp_eq /-
theorem supp_eq {α : TypeVec n} (a : P.A) (f : P.B a ⟹ α) (i) :
    @supp.{u} _ P.Obj _ α (⟨a, f⟩ : P.Obj α) i = f i '' univ :=
  by
  ext; simp only [supp, image_univ, mem_range, mem_set_of_eq]
  constructor <;> intro h
  · apply @h fun i x => ∃ y : P.B a i, f i y = x
    rw [liftp_iff']
    intros
    refine' ⟨_, rfl⟩
  · simp only [liftp_iff']
    cases h
    subst x
    tauto
#align mvpfunctor.supp_eq MvPFunctor.supp_eq
-/

end MvPFunctor

/-
Decomposing an n+1-ary pfunctor.
-/
namespace MvPFunctor

open TypeVec

variable {n : ℕ} (P : MvPFunctor.{u} (n + 1))

#print MvPFunctor.drop /-
/-- Split polynomial functor, get a n-ary functor
from a `n+1`-ary functor -/
def drop : MvPFunctor n where
  A := P.A
  B a := (P.B a).drop
#align mvpfunctor.drop MvPFunctor.drop
-/

#print MvPFunctor.last /-
/-- Split polynomial functor, get a univariate functor
from a `n+1`-ary functor -/
def last : PFunctor where
  A := P.A
  B a := (P.B a).getLast
#align mvpfunctor.last MvPFunctor.last
-/

/- ./././Mathport/Syntax/Translate/Expr.lean:177:8: unsupported: ambiguous notation -/
#print MvPFunctor.appendContents /-
/-- append arrows of a polynomial functor application -/
@[reducible]
def appendContents {α : TypeVec n} {β : Type _} {a : P.A} (f' : P.drop.B a ⟹ α)
    (f : P.getLast.B a → β) : P.B a ⟹ (α ::: β) :=
  splitFun f' f
#align mvpfunctor.append_contents MvPFunctor.appendContents
-/

end MvPFunctor