/-
Copyright © 2020 Nicolò Cavalleri. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Nicolò Cavalleri, Sebastien Gouezel, Heather Macbeth, Patrick Massot, Floris van Doorn
-/

import analysis.normed_space.bounded_linear_maps
import topology.fiber_bundle.basic

/-!
# Vector bundles

In this file we define (topological) vector bundles.

Let `B` be the base space, let `F` be a normed space over a normed field `R`, and let
`E : B → Type*` be a `fiber_bundle` with fiber `F`, in which, for each `x`, the fiber `E x` is a
topological vector space over `R`.

To have a vector bundle structure on `bundle.total_space E`, one should additionally have the
following properties:

* The bundle trivializations in the trivialization atlas should be continuous linear equivs in the
fibers;
* For any two trivializations `e`, `e'` in the atlas the transition function considered as a map
from `B` into `F →L[R] F` is continuous on `e.base_set ∩ e'.base_set` with respect to the operator
norm topology on `F →L[R] F`.

If these conditions are satisfied, we register the typeclass `vector_bundle R F E`.

We define constructions on vector bundles like pullbacks and direct sums in other files.

## Implementation notes

The implementation choices in the vector bundle definition are discussed in the "Implementation
notes" section of `topology.fiber_bundle.basic`.

## Tags
Vector bundle
-/

noncomputable theory

open bundle set
open_locale classical bundle

variables (R 𝕜 : Type*) {B : Type*} (F : Type*) (E : B → Type*)

section topological_vector_space
variables {B F E} [semiring R]
  [topological_space F]  [topological_space B]

/-- A mixin class for `pretrivialization`, stating that a pretrivialization is fiberwise linear with
respect to given module structures on its fibers and the model fiber. -/
protected class pretrivialization.is_linear [add_comm_monoid F] [module R F]
  [∀ x, add_comm_monoid (E x)] [∀ x, module R (E x)] (e : pretrivialization F (π E)) :
  Prop :=
(linear : ∀ b ∈ e.base_set, is_linear_map R (λ x : E b, (e (total_space_mk b x)).2))

namespace pretrivialization

variables {F E} (e : pretrivialization F (π E)) {x : total_space E} {b : B} {y : E b}

lemma linear [add_comm_monoid F] [module R F] [∀ x, add_comm_monoid (E x)] [∀ x, module R (E x)]
  [e.is_linear R] {b : B} (hb : b ∈ e.base_set) :
  is_linear_map R (λ x : E b, (e (total_space_mk b x)).2) :=
pretrivialization.is_linear.linear b hb

variables [add_comm_monoid F] [module R F] [∀ x, add_comm_monoid (E x)] [∀ x, module R (E x)]

/-- A fiberwise linear inverse to `e`. -/
@[simps] protected def symmₗ (e : pretrivialization F (π E)) [e.is_linear R] (b : B) :
  F →ₗ[R] E b :=
begin
  refine is_linear_map.mk' (e.symm b) _,
  by_cases hb : b ∈ e.base_set,
  { exact (((e.linear R hb).mk' _).inverse (e.symm b) (e.symm_apply_apply_mk hb)
      (λ v, congr_arg prod.snd $ e.apply_mk_symm hb v)).is_linear },
  { rw [e.coe_symm_of_not_mem hb], exact (0 : F →ₗ[R] E b).is_linear }
end

/-- A pretrivialization for a vector bundle defines linear equivalences between the
fibers and the model space. -/
@[simps {fully_applied := ff}] def linear_equiv_at (e : pretrivialization F (π E)) [e.is_linear R]
  (b : B) (hb : b ∈ e.base_set) :
  E b ≃ₗ[R] F :=
{ to_fun := λ y, (e (total_space_mk b y)).2,
  inv_fun := e.symm b,
  left_inv := e.symm_apply_apply_mk hb,
  right_inv := λ v, by simp_rw [e.apply_mk_symm hb v],
  map_add' := λ v w, (e.linear R hb).map_add v w,
  map_smul' := λ c v, (e.linear R hb).map_smul c v }

/-- A fiberwise linear map equal to `e` on `e.base_set`. -/
protected def linear_map_at (e : pretrivialization F (π E)) [e.is_linear R] (b : B) : E b →ₗ[R] F :=
if hb : b ∈ e.base_set then e.linear_equiv_at R b hb else 0

variables {R}

lemma coe_linear_map_at_of_mem (e : pretrivialization F (π E)) [e.is_linear R] {b : B}
  (hb : b ∈ e.base_set) :
  ⇑(e.linear_map_at R b) = λ y, (e (total_space_mk b y)).2 :=
by simp_rw [coe_linear_map_at, if_pos hb]

lemma linear_map_at_apply (e : pretrivialization F (π E)) [e.is_linear R] {b : B} (y : E b) :
  e.linear_map_at R b y = if b ∈ e.base_set then (e (total_space_mk b y)).2 else 0 :=
by rw [coe_linear_map_at]

lemma linear_map_at_def_of_mem (e : pretrivialization F (π E)) [e.is_linear R] {b : B}
  (hb : b ∈ e.base_set) :
  e.linear_map_at R b = e.linear_equiv_at R b hb :=
dif_pos hb

lemma linear_map_at_def_of_not_mem (e : pretrivialization F (π E)) [e.is_linear R] {b : B}
  (hb : b ∉ e.base_set) :
  e.linear_map_at R b = 0 :=
dif_neg hb

lemma linear_map_at_eq_zero (e : pretrivialization F (π E)) [e.is_linear R] {b : B}
  (hb : b ∉ e.base_set) :
  e.linear_map_at R b = 0 :=
dif_neg hb

lemma symmₗ_linear_map_at (e : pretrivialization F (π E)) [e.is_linear R] {b : B}
  (hb : b ∈ e.base_set) (y : E b) :
  e.symmₗ R b (e.linear_map_at R b y) = y :=
by { rw [e.linear_map_at_def_of_mem hb], exact (e.linear_equiv_at R b hb).left_inv y }

lemma linear_map_at_symmₗ (e : pretrivialization F (π E)) [e.is_linear R] {b : B}
  (hb : b ∈ e.base_set) (y : F) :
  e.linear_map_at R b (e.symmₗ R b y) = y :=
by { rw [e.linear_map_at_def_of_mem hb], exact (e.linear_equiv_at R b hb).right_inv y }

end pretrivialization

variables (R) [topological_space (total_space E)]

/-- A mixin class for `trivialization`, stating that a trivialization is fiberwise linear with
respect to given module structures on its fibers and the model fiber. -/
protected class trivialization.is_linear [add_comm_monoid F] [module R F]
  [∀ x, add_comm_monoid (E x)] [∀ x, module R (E x)] (e : trivialization F (π E)) : Prop :=
(linear : ∀ b ∈ e.base_set, is_linear_map R (λ x : E b, (e (total_space_mk b x)).2))

namespace trivialization

variables (e : trivialization F (π E)) {x : total_space E} {b : B} {y : E b}

protected lemma linear [add_comm_monoid F] [module R F] [∀ x, add_comm_monoid (E x)]
  [∀ x, module R (E x)] [e.is_linear R] {b : B} (hb : b ∈ e.base_set) :
  is_linear_map R (λ y : E b, (e (total_space_mk b y)).2) :=
trivialization.is_linear.linear b hb

instance to_pretrivialization.is_linear [add_comm_monoid F] [module R F]
  [∀ x, add_comm_monoid (E x)] [∀ x, module R (E x)] [e.is_linear R] :
  e.to_pretrivialization.is_linear R :=
{ ..(‹_› : e.is_linear R) }

variables [add_comm_monoid F] [module R F] [∀ x, add_comm_monoid (E x)] [∀ x, module R (E x)]

/-- A trivialization for a vector bundle defines linear equivalences between the
fibers and the model space. -/
def linear_equiv_at (e : trivialization F (π E)) [e.is_linear R] (b : B) (hb : b ∈ e.base_set) :
  E b ≃ₗ[R] F :=
e.to_pretrivialization.linear_equiv_at R b hb

variables {R}

@[simp]
lemma linear_equiv_at_apply (e : trivialization F (π E)) [e.is_linear R] (b : B)
  (hb : b ∈ e.base_set) (v : E b) :
  e.linear_equiv_at R b hb v = (e (total_space_mk b v)).2 := rfl

@[simp]
lemma linear_equiv_at_symm_apply (e : trivialization F (π E)) [e.is_linear R] (b : B)
  (hb : b ∈ e.base_set) (v : F) :
  (e.linear_equiv_at R b hb).symm v = e.symm b v := rfl

variables (R)

/-- A fiberwise linear inverse to `e`. -/
protected def symmₗ (e : trivialization F (π E)) [e.is_linear R] (b : B) : F →ₗ[R] E b :=
e.to_pretrivialization.symmₗ R b

variables {R}

lemma coe_symmₗ (e : trivialization F (π E)) [e.is_linear R] (b : B) : ⇑(e.symmₗ R b) = e.symm b :=
rfl

variables (R)

/-- A fiberwise linear map equal to `e` on `e.base_set`. -/
protected def linear_map_at (e : trivialization F (π E)) [e.is_linear R] (b : B) : E b →ₗ[R] F :=
e.to_pretrivialization.linear_map_at R b

variables {R}

lemma coe_linear_map_at (e : trivialization F (π E)) [e.is_linear R] (b : B) :
  ⇑(e.linear_map_at R b) = λ y, if b ∈ e.base_set then (e (total_space_mk b y)).2 else 0 :=
e.to_pretrivialization.coe_linear_map_at b

lemma coe_linear_map_at_of_mem (e : trivialization F (π E)) [e.is_linear R] {b : B}
  (hb : b ∈ e.base_set) :
  ⇑(e.linear_map_at R b) = λ y, (e (total_space_mk b y)).2 :=
by simp_rw [coe_linear_map_at, if_pos hb]

lemma linear_map_at_apply (e : trivialization F (π E)) [e.is_linear R] {b : B} (y : E b) :
  e.linear_map_at R b y = if b ∈ e.base_set then (e (total_space_mk b y)).2 else 0 :=
by rw [coe_linear_map_at]

lemma linear_map_at_def_of_mem (e : trivialization F (π E)) [e.is_linear R] {b : B}
  (hb : b ∈ e.base_set) :
  e.linear_map_at R b = e.linear_equiv_at R b hb :=
dif_pos hb

lemma linear_map_at_def_of_not_mem (e : trivialization F (π E)) [e.is_linear R] {b : B}
  (hb : b ∉ e.base_set) :
  e.linear_map_at R b = 0 :=
dif_neg hb

lemma symmₗ_linear_map_at (e : trivialization F (π E)) [e.is_linear R] {b : B} (hb : b ∈ e.base_set)
  (y : E b) :
  e.symmₗ R b (e.linear_map_at R b y) = y :=
e.to_pretrivialization.symmₗ_linear_map_at hb y

lemma linear_map_at_symmₗ (e : trivialization F (π E)) [e.is_linear R] {b : B} (hb : b ∈ e.base_set)
  (y : F) :
  e.linear_map_at R b (e.symmₗ R b y) = y :=
e.to_pretrivialization.linear_map_at_symmₗ hb y

variables (R)

/-- A coordinate change function between two trivializations, as a continuous linear equivalence.
  Defined to be the identity when `b` does not lie in the base set of both trivializations. -/
def coord_changeL (e e' : trivialization F (π E)) [e.is_linear R] [e'.is_linear R] (b : B) :
  F ≃L[R] F :=
{ continuous_to_fun := begin
    by_cases hb : b ∈ e.base_set ∩ e'.base_set,
    { simp_rw [dif_pos hb],
      refine (e'.continuous_on.comp_continuous _ _).snd,
      exact e.continuous_on_symm.comp_continuous (continuous.prod.mk b)
        (λ y, mk_mem_prod hb.1 (mem_univ y)),
      exact (λ y, e'.mem_source.mpr hb.2) },
    { rw [dif_neg hb], exact continuous_id }
  end,
  continuous_inv_fun := begin
    by_cases hb : b ∈ e.base_set ∩ e'.base_set,
    { simp_rw [dif_pos hb],
      refine (e.continuous_on.comp_continuous _ _).snd,
      exact e'.continuous_on_symm.comp_continuous (continuous.prod.mk b)
        (λ y, mk_mem_prod hb.2 (mem_univ y)),
      exact (λ y, e.mem_source.mpr hb.1) },
    { rw [dif_neg hb], exact continuous_id }
  end,
  .. if hb : b ∈ e.base_set ∩ e'.base_set then
     (e.linear_equiv_at R b (hb.1 : _)).symm.trans (e'.linear_equiv_at R b hb.2)
    else linear_equiv.refl R F }

variables {R}

lemma coe_coord_changeL (e e' : trivialization F (π E)) [e.is_linear R] [e'.is_linear R] {b : B}
  (hb : b ∈ e.base_set ∩ e'.base_set) :
  ⇑(coord_changeL R e e' b)
  = (e.linear_equiv_at R b hb.1).symm.trans (e'.linear_equiv_at R b hb.2) :=
congr_arg linear_equiv.to_fun (dif_pos hb)

lemma coe_coord_changeL' (e e' : trivialization F (π E)) [e.is_linear R] [e'.is_linear R] {b : B}
  (hb : b ∈ e.base_set ∩ e'.base_set) :
  (coord_changeL R e e' b).to_linear_equiv
  = (e.linear_equiv_at R b hb.1).symm.trans (e'.linear_equiv_at R b hb.2) :=
linear_equiv.coe_injective (coe_coord_changeL _ _ _)

lemma symm_coord_changeL (e e' : trivialization F (π E)) [e.is_linear R] [e'.is_linear R] {b : B}
  (hb : b ∈ e'.base_set ∩ e.base_set) :
  (e.coord_changeL R e' b).symm = e'.coord_changeL R e b :=
begin
  apply continuous_linear_equiv.to_linear_equiv_injective,
  rw [coe_coord_changeL' e' e hb, (coord_changeL R e e' b).symm_to_linear_equiv,
    coe_coord_changeL' e e' hb.symm, linear_equiv.trans_symm, linear_equiv.symm_symm],
end

lemma coord_changeL_apply (e e' : trivialization F (π E)) [e.is_linear R] [e'.is_linear R] {b : B}
  (hb : b ∈ e.base_set ∩ e'.base_set) (y : F) :
  coord_changeL R e e' b y = (e' (total_space_mk b (e.symm b y))).2 :=
congr_arg (λ f, linear_equiv.to_fun f y) (dif_pos hb)

lemma mk_coord_changeL (e e' : trivialization F (π E)) [e.is_linear R] [e'.is_linear R] {b : B}
  (hb : b ∈ e.base_set ∩ e'.base_set) (y : F) :
  (b, coord_changeL R e e' b y) = e' (total_space_mk b (e.symm b y)) :=
begin
  ext,
  { rw [e.mk_symm hb.1 y, e'.coe_fst', e.proj_symm_apply' hb.1],
    rw [e.proj_symm_apply' hb.1], exact hb.2 },
  { exact e.coord_changeL_apply e' hb y }
end

lemma apply_symm_apply_eq_coord_changeL (e e' : trivialization F (π E)) [e.is_linear R]
  [e'.is_linear R] {b : B} (hb : b ∈ e.base_set ∩ e'.base_set) (v : F) :
  e' (e.to_local_homeomorph.symm (b, v)) = (b, e.coord_changeL R e' b v) :=
by rw [e.mk_coord_changeL e' hb, e.mk_symm hb.1]

/-- A version of `coord_change_apply` that fully unfolds `coord_change`. The right-hand side is
ugly, but has good definitional properties for specifically defined trivializations. -/
lemma coord_changeL_apply' (e e' : trivialization F (π E)) [e.is_linear R] [e'.is_linear R] {b : B}
  (hb : b ∈ e.base_set ∩ e'.base_set) (y : F) :
  coord_changeL R e e' b y = (e' (e.to_local_homeomorph.symm (b, y))).2 :=
by rw [e.coord_changeL_apply e' hb, e.mk_symm hb.1]

lemma coord_changeL_symm_apply (e e' : trivialization F (π E)) [e.is_linear R] [e'.is_linear R]
  {b : B} (hb : b ∈ e.base_set ∩ e'.base_set) :
  ⇑(coord_changeL R e e' b).symm
  = (e'.linear_equiv_at R b hb.2).symm.trans (e.linear_equiv_at R b hb.1) :=
congr_arg linear_equiv.inv_fun (dif_pos hb)

end trivialization

end topological_vector_space

section

namespace bundle

/-- The zero section of a vector bundle -/
def zero_section [∀ x, has_zero (E x)] : B → total_space E :=
λ x, total_space_mk x 0

@[simp, mfld_simps]
lemma zero_section_proj [∀ x, has_zero (E x)] (x : B) : (zero_section E x).proj = x := rfl
@[simp, mfld_simps]
lemma zero_section_snd [∀ x, has_zero (E x)] (x : B) : (zero_section E x).2 = 0 := rfl

end bundle
open bundle

variables [nontrivially_normed_field R] [∀ x, add_comm_monoid (E x)] [∀ x, module R (E x)]
  [normed_add_comm_group F] [normed_space R F] [topological_space B]
  [topological_space (total_space E)] [∀ x, topological_space (E x)] [fiber_bundle F E]

/-- The space `total_space E` (for `E : B → Type*` such that each `E x` is a topological vector
space) has a topological vector space structure with fiber `F` (denoted with
`vector_bundle R F E`) if around every point there is a fiber bundle trivialization
which is linear in the fibers. -/
class vector_bundle : Prop :=
(trivialization_linear' : ∀ (e : trivialization F (π E)) [mem_trivialization_atlas e],
  e.is_linear R)
(continuous_on_coord_change' [] : ∀ (e e' : trivialization F (π E)) [mem_trivialization_atlas e]
  [mem_trivialization_atlas e'],
  continuous_on
  (λ b, by exactI trivialization.coord_changeL R e e' b : B → F →L[R] F) (e.base_set ∩ e'.base_set))

variables {F E}

@[priority 100]
instance trivialization_linear [vector_bundle R F E] (e : trivialization F (π E))
  [mem_trivialization_atlas e] :
  e.is_linear R :=
vector_bundle.trivialization_linear' e

lemma continuous_on_coord_change [vector_bundle R F E] (e e' : trivialization F (π E))
  [he : mem_trivialization_atlas e]
  [he' : mem_trivialization_atlas e'] :
  continuous_on
  (λ b, trivialization.coord_changeL R e e' b : B → F →L[R] F) (e.base_set ∩ e'.base_set) :=
vector_bundle.continuous_on_coord_change' R e e'

namespace trivialization

/-- Forward map of `continuous_linear_equiv_at` (only propositionally equal),
  defined everywhere (`0` outside domain). -/
@[simps apply {fully_applied := ff}]
def continuous_linear_map_at (e : trivialization F (π E)) [e.is_linear R] (b : B) :
  E b →L[R] F :=
{ to_fun := e.linear_map_at R b, -- given explicitly to help `simps`
  cont := begin
    dsimp,
    rw [e.coe_linear_map_at b],
    refine continuous_if_const _ (λ hb, _) (λ _, continuous_zero),
    exact continuous_snd.comp (e.continuous_on.comp_continuous
      (fiber_bundle.total_space_mk_inducing F E b).continuous
      (λ x, e.mem_source.mpr hb))
  end,
  .. e.linear_map_at R b }

/-- Backwards map of `continuous_linear_equiv_at`, defined everywhere. -/
@[simps apply {fully_applied := ff}]
def symmL (e : trivialization F (π E)) [e.is_linear R] (b : B) : F →L[R] E b :=
{ to_fun := e.symm b, -- given explicitly to help `simps`
  cont := begin
    by_cases hb : b ∈ e.base_set,
    { rw (fiber_bundle.total_space_mk_inducing F E b).continuous_iff,
      exact e.continuous_on_symm.comp_continuous (continuous_const.prod_mk continuous_id)
        (λ x, mk_mem_prod hb (mem_univ x)) },
    { refine continuous_zero.congr (λ x, (e.symm_apply_of_not_mem hb x).symm) },
  end,
  .. e.symmₗ R b }

variables {R}

lemma symmL_continuous_linear_map_at (e : trivialization F (π E)) [e.is_linear R] {b : B}
  (hb : b ∈ e.base_set) (y : E b) :
  e.symmL R b (e.continuous_linear_map_at R b y) = y :=
e.symmₗ_linear_map_at hb y

lemma continuous_linear_map_at_symmL (e : trivialization F (π E)) [e.is_linear R] {b : B}
  (hb : b ∈ e.base_set) (y : F) :
  e.continuous_linear_map_at R b (e.symmL R b y) = y :=
e.linear_map_at_symmₗ hb y

variables (R)

/-- In a vector bundle, a trivialization in the fiber (which is a priori only linear)
is in fact a continuous linear equiv between the fibers and the model fiber. -/
@[simps apply symm_apply {fully_applied := ff}]
def continuous_linear_equiv_at (e : trivialization F (π E)) [e.is_linear R] (b : B)
  (hb : b ∈ e.base_set) : E b ≃L[R] F :=
{ to_fun := λ y, (e (total_space_mk b y)).2, -- given explicitly to help `simps`
  inv_fun := e.symm b, -- given explicitly to help `simps`
  continuous_to_fun := continuous_snd.comp (e.continuous_on.comp_continuous
    (fiber_bundle.total_space_mk_inducing F E b).continuous
    (λ x, e.mem_source.mpr hb)),
  continuous_inv_fun := (e.symmL R b).continuous,
  .. e.to_pretrivialization.linear_equiv_at R b hb }

variables {R}

lemma coe_continuous_linear_equiv_at_eq (e : trivialization F (π E)) [e.is_linear R] {b : B}
  (hb : b ∈ e.base_set) :
  (e.continuous_linear_equiv_at R b hb : E b → F) = e.continuous_linear_map_at R b :=
(e.coe_linear_map_at_of_mem hb).symm

lemma symm_continuous_linear_equiv_at_eq (e : trivialization F (π E)) [e.is_linear R] {b : B}
  (hb : b ∈ e.base_set) :
  ((e.continuous_linear_equiv_at R b hb).symm : F → E b) = e.symmL R b :=
rfl

@[simp] lemma continuous_linear_equiv_at_apply' (e : trivialization F (π E)) [e.is_linear R]
  (x : total_space E) (hx : x ∈ e.source) :
  e.continuous_linear_equiv_at R x.proj (e.mem_source.1 hx) x.2 = (e x).2 := by { cases x, refl }

variables (R)

lemma apply_eq_prod_continuous_linear_equiv_at (e : trivialization F (π E)) [e.is_linear R] (b : B)
  (hb : b ∈ e.base_set) (z : E b) :
  e ⟨b, z⟩ = (b, e.continuous_linear_equiv_at R b hb z) :=
begin
  ext,
  { refine e.coe_fst _,
    rw e.source_eq,
    exact hb },
  { simp only [coe_coe, continuous_linear_equiv_at_apply] }
end

protected lemma zero_section (e : trivialization F (π E)) [e.is_linear R]
  {x : B} (hx : x ∈ e.base_set) : e (zero_section E x) = (x, 0) :=
by simp_rw [zero_section, total_space_mk, e.apply_eq_prod_continuous_linear_equiv_at R x hx 0,
  map_zero]

variables {R}

lemma symm_apply_eq_mk_continuous_linear_equiv_at_symm (e : trivialization F (π E)) [e.is_linear R]
  (b : B) (hb : b ∈ e.base_set) (z : F) :
  e.to_local_homeomorph.symm ⟨b, z⟩
  = total_space_mk b ((e.continuous_linear_equiv_at R b hb).symm z) :=
begin
  have h : (b, z) ∈ e.target,
  { rw e.target_eq,
    exact ⟨hb, mem_univ _⟩ },
  apply e.inj_on (e.map_target h),
  { simp only [e.source_eq, hb, mem_preimage] },
  simp_rw [e.right_inv h, coe_coe, e.apply_eq_prod_continuous_linear_equiv_at R b hb,
    continuous_linear_equiv.apply_symm_apply],
end

lemma comp_continuous_linear_equiv_at_eq_coord_change (e e' : trivialization F (π E))
  [e.is_linear R] [e'.is_linear R] {b : B} (hb : b ∈ e.base_set ∩ e'.base_set) :
  (e.continuous_linear_equiv_at R b hb.1).symm.trans (e'.continuous_linear_equiv_at R b hb.2)
  = coord_changeL R e e' b :=
by { ext v, rw [coord_changeL_apply e e' hb], refl }

end trivialization

include R F

/-! ### Constructing vector bundles -/

variables (R B F)

/-- Analogous construction of `fiber_bundle_core` for vector bundles. This
construction gives a way to construct vector bundles from a structure registering how
trivialization changes act on fibers. -/
structure vector_bundle_core (ι : Type*) :=
(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 →L[R] F))
(coord_change_self : ∀ i, ∀ x ∈ base_set i, ∀ v, coord_change i i x v = v)
(continuous_on_coord_change : ∀ i j, continuous_on (coord_change i j) (base_set i ∩ base_set j))
(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)

/-- The trivial vector bundle core, in which all the changes of coordinates are the
identity. -/
def trivial_vector_bundle_core (ι : Type*) [inhabited ι] :
  vector_bundle_core R B F ι :=
{ base_set := λ ι, univ,
  is_open_base_set := λ i, is_open_univ,
  index_at := default,
  mem_base_set_at := λ x, mem_univ x,
  coord_change := λ i j x, continuous_linear_map.id R F,
  coord_change_self := λ i x hx v, rfl,
  coord_change_comp := λ i j k x hx v, rfl,
  continuous_on_coord_change := λ i j, continuous_on_const }

instance (ι : Type*) [inhabited ι] : inhabited (vector_bundle_core R B F ι) :=
⟨trivial_vector_bundle_core R B F ι⟩

namespace vector_bundle_core

variables {R B F} {ι : Type*} (Z : vector_bundle_core R B F ι)

/-- Natural identification to a `fiber_bundle_core`. -/
@[simps (mfld_cfg)] def to_fiber_bundle_core : fiber_bundle_core ι B F :=
{ coord_change := λ i j b, Z.coord_change i j b,
  continuous_on_coord_change := λ i j, is_bounded_bilinear_map_apply.continuous.comp_continuous_on
      ((Z.continuous_on_coord_change i j).prod_map continuous_on_id),
  ..Z }

instance to_fiber_bundle_core_coe : has_coe (vector_bundle_core R B F ι)
  (fiber_bundle_core ι B F) := ⟨to_fiber_bundle_core⟩

include Z

lemma coord_change_linear_comp (i j k : ι): ∀ x ∈ (Z.base_set i) ∩ (Z.base_set j) ∩ (Z.base_set k),
  (Z.coord_change j k x).comp (Z.coord_change i j x) = Z.coord_change i k x :=
λ x hx, by { ext v, exact Z.coord_change_comp i j k x hx v }

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

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

/-- The fiber of a vector bundle core, as a convenience function for dot notation and
typeclass inference -/
@[nolint unused_arguments has_nonempty_instance]
def fiber : B → Type* := Z.to_fiber_bundle_core.fiber

instance topological_space_fiber (x : B) : topological_space (Z.fiber x) :=
by delta_instance vector_bundle_core.fiber
instance add_comm_monoid_fiber : ∀ (x : B), add_comm_monoid (Z.fiber x) :=
by dsimp [vector_bundle_core.fiber]; delta_instance fiber_bundle_core.fiber
instance module_fiber : ∀ (x : B), module R (Z.fiber x) :=
by dsimp [vector_bundle_core.fiber];  delta_instance fiber_bundle_core.fiber
instance add_comm_group_fiber [add_comm_group F] : ∀ (x : B), add_comm_group (Z.fiber x) :=
by dsimp [vector_bundle_core.fiber];  delta_instance fiber_bundle_core.fiber

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

/-- The total space of the vector 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

/-- Local homeomorphism version of the trivialization change. -/
def triv_change (i j : ι) : local_homeomorph (B × F) (B × F) :=
fiber_bundle_core.triv_change ↑Z i j

@[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 :=
fiber_bundle_core.mem_triv_change_source ↑Z i j p

/-- Topological structure on the total space of a vector bundle created from core, designed so
that all the local trivialization are continuous. -/
instance to_topological_space : topological_space Z.total_space :=
Z.to_fiber_bundle_core.to_topological_space

variables (b : B) (a : F)

@[simp, mfld_simps] lemma coe_coord_change (i j : ι) :
  Z.to_fiber_bundle_core.coord_change i j b = Z.coord_change i j b := rfl

/-- One of the standard local trivializations of a vector bundle constructed from core, taken by
considering this in particular as a fiber bundle constructed from core. -/
def local_triv (i : ι) : trivialization F (π Z.fiber) :=
by dsimp [vector_bundle_core.total_space, vector_bundle_core.fiber];
  exact Z.to_fiber_bundle_core.local_triv i

/-- The standard local trivializations of a vector bundle constructed from core are linear. -/
instance local_triv.is_linear (i : ι) : (Z.local_triv i).is_linear R :=
{ linear := λ x hx, by dsimp [vector_bundle_core.local_triv]; exact
  { map_add := λ v w, by simp only [continuous_linear_map.map_add] with mfld_simps,
    map_smul := λ r v, by simp only [continuous_linear_map.map_smul] with mfld_simps} }

variables (i j : ι)

@[simp, mfld_simps] lemma mem_local_triv_source (p : Z.total_space) :
  p ∈ (Z.local_triv i).source ↔ p.1 ∈ Z.base_set i :=
by dsimp [vector_bundle_core.fiber]; exact iff.rfl

@[simp, mfld_simps] lemma base_set_at : Z.base_set i = (Z.local_triv i).base_set := rfl

@[simp, mfld_simps] lemma local_triv_apply (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 mem_local_triv_target (p : B × F) :
  p ∈ (Z.local_triv i).target ↔ p.1 ∈ (Z.local_triv i).base_set :=
Z.to_fiber_bundle_core.mem_local_triv_target i p

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

@[simp, mfld_simps] lemma local_triv_symm_apply {b : B} (hb : b ∈ Z.base_set i) (v : F) :
  (Z.local_triv i).symm b v = Z.coord_change i (Z.index_at b) b v :=
by apply (Z.local_triv i).symm_apply hb v

@[simp, mfld_simps] lemma local_triv_coord_change_eq {b : B} (hb : b ∈ Z.base_set i ∩ Z.base_set j)
  (v : F) :
  (Z.local_triv i).coord_changeL R (Z.local_triv j) b v = Z.coord_change i j b v :=
begin
  rw [trivialization.coord_changeL_apply', local_triv_symm_fst, local_triv_apply,
    coord_change_comp],
  exacts [⟨⟨hb.1, Z.mem_base_set_at b⟩, hb.2⟩, hb]
end

/-- Preferred local trivialization of a vector bundle constructed from core, at a given point, as
a bundle trivialization -/
def local_triv_at (b : B) : trivialization F (π Z.fiber) :=
Z.local_triv (Z.index_at b)

@[simp, mfld_simps] lemma local_triv_at_def :
  Z.local_triv (Z.index_at b) = Z.local_triv_at b := rfl

@[simp, mfld_simps] lemma mem_source_at : (⟨b, a⟩ : Z.total_space) ∈ (Z.local_triv_at b).source :=
by { rw [local_triv_at, mem_local_triv_source], exact Z.mem_base_set_at b }

@[simp, mfld_simps] lemma local_triv_at_apply (p : Z.total_space) :
  ((Z.local_triv_at p.1) p) = ⟨p.1, p.2⟩ :=
fiber_bundle_core.local_triv_at_apply Z p

@[simp, mfld_simps] lemma local_triv_at_apply_mk (b : B) (a : F) :
  ((Z.local_triv_at b) ⟨b, a⟩) = ⟨b, a⟩ :=
Z.local_triv_at_apply _

@[simp, mfld_simps] lemma mem_local_triv_at_base_set :
  b ∈ (Z.local_triv_at b).base_set :=
fiber_bundle_core.mem_local_triv_at_base_set Z b

instance fiber_bundle : fiber_bundle F Z.fiber := Z.to_fiber_bundle_core.fiber_bundle

instance vector_bundle : vector_bundle R F Z.fiber :=
{ trivialization_linear' := begin
    rintros _ ⟨i, rfl⟩,
    apply local_triv.is_linear,
  end,
  continuous_on_coord_change' := begin
    rintros _ _ ⟨i, rfl⟩ ⟨i', rfl⟩,
    refine (Z.continuous_on_coord_change i i').congr (λ b hb, _),
    ext v,
    exact Z.local_triv_coord_change_eq i i' hb v,
  end }

/-- The projection on the base of a vector bundle created from core is continuous -/
@[continuity] lemma continuous_proj : continuous Z.proj :=
fiber_bundle_core.continuous_proj Z

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

end vector_bundle_core

end

/-! ### Vector prebundle -/

section
variables [nontrivially_normed_field R] [∀ x, add_comm_monoid (E x)] [∀ x, module R (E x)]
  [normed_add_comm_group F] [normed_space R F] [topological_space B]

open topological_space

open vector_bundle
/-- This structure permits to define a vector bundle when trivializations are given as local
equivalences but there is not yet a topology on the total space or the fibers.
The total space is hence given a topology in such a way that there is a fiber bundle structure for
which the local equivalences are also local homeomorphisms and hence vector bundle trivializations.
The topology on the fibers is induced from the one on the total space.

The field `exists_coord_change` is stated as an existential statement (instead of 3 separate
fields), since it depends on propositional information (namely `e e' ∈ pretrivialization_atlas`).
This makes it inconvenient to explicitly define a `coord_change` function when constructing a
`vector_prebundle`. -/
@[nolint has_nonempty_instance]
structure vector_prebundle :=
(pretrivialization_atlas : set (pretrivialization F (π E)))
(pretrivialization_linear' : ∀ (e : pretrivialization F (π E)) (he : e ∈ pretrivialization_atlas),
  e.is_linear R)
(pretrivialization_at : B → pretrivialization F (π E))
(mem_base_pretrivialization_at : ∀ x : B, x ∈ (pretrivialization_at x).base_set)
(pretrivialization_mem_atlas : ∀ x : B, pretrivialization_at x ∈ pretrivialization_atlas)
(exists_coord_change : ∀ (e e' ∈ pretrivialization_atlas), ∃ f : B → F →L[R] F,
  continuous_on f (e.base_set ∩ e'.base_set) ∧
  ∀ (b : B) (hb : b ∈ e.base_set ∩ e'.base_set) (v : F),
    f b v = (e' (total_space_mk b (e.symm b v))).2)

namespace vector_prebundle

variables {R E F}

/-- A randomly chosen coordinate change on a `vector_prebundle`, given by
  the field `exists_coord_change`. -/
def coord_change (a : vector_prebundle R F E)
  {e e' : pretrivialization F (π E)} (he : e ∈ a.pretrivialization_atlas)
  (he' : e' ∈ a.pretrivialization_atlas) (b : B) : F →L[R] F :=
classical.some (a.exists_coord_change e he e' he') b

lemma continuous_on_coord_change (a : vector_prebundle R F E)
  {e e' : pretrivialization F (π E)} (he : e ∈ a.pretrivialization_atlas)
  (he' : e' ∈ a.pretrivialization_atlas) :
  continuous_on (a.coord_change he he') (e.base_set ∩ e'.base_set) :=
(classical.some_spec (a.exists_coord_change e he e' he')).1

lemma coord_change_apply (a : vector_prebundle R F E)
  {e e' : pretrivialization F (π E)} (he : e ∈ a.pretrivialization_atlas)
  (he' : e' ∈ a.pretrivialization_atlas) {b : B} (hb : b ∈ e.base_set ∩ e'.base_set) (v : F) :
  a.coord_change he he' b v = (e' (total_space_mk b (e.symm b v))).2 :=
(classical.some_spec (a.exists_coord_change e he e' he')).2 b hb v

lemma mk_coord_change (a : vector_prebundle R F E)
  {e e' : pretrivialization F (π E)} (he : e ∈ a.pretrivialization_atlas)
  (he' : e' ∈ a.pretrivialization_atlas) {b : B} (hb : b ∈ e.base_set ∩ e'.base_set) (v : F) :
  (b, a.coord_change he he' b v) = e' (total_space_mk b (e.symm b v)) :=
begin
  ext,
  { rw [e.mk_symm hb.1 v, e'.coe_fst', e.proj_symm_apply' hb.1],
    rw [e.proj_symm_apply' hb.1], exact hb.2 },
  { exact a.coord_change_apply he he' hb v }
end

/-- Natural identification of `vector_prebundle` as a `fiber_prebundle`. -/
def to_fiber_prebundle (a : vector_prebundle R F E) :
  fiber_prebundle F E :=
{ continuous_triv_change := begin
    intros e he e' he',
    have := is_bounded_bilinear_map_apply.continuous.comp_continuous_on
      ((a.continuous_on_coord_change he' he).prod_map continuous_on_id),
    have H : e'.to_local_equiv.target ∩ e'.to_local_equiv.symm ⁻¹'
      e.to_local_equiv.source =(e'.base_set ∩ e.base_set) ×ˢ univ,
    { rw [e'.target_eq, e.source_eq],
      ext ⟨b, f⟩,
      simp only [-total_space.proj, and.congr_right_iff, e'.proj_symm_apply', iff_self,
        implies_true_iff] with mfld_simps {contextual := tt} },
    rw [H],
    refine (continuous_on_fst.prod this).congr _,
    rintros ⟨b, f⟩ ⟨hb, -⟩,
    dsimp only [function.comp, prod.map],
    rw [a.mk_coord_change _ _ hb, e'.mk_symm hb.1],
    refl,
  end,
  .. a }

/-- Topology on the total space that will make the prebundle into a bundle. -/
def total_space_topology (a : vector_prebundle R F E) :
  topological_space (total_space E) :=
a.to_fiber_prebundle.total_space_topology

/-- Promotion from a `trivialization` in the `pretrivialization_atlas` of a
`vector_prebundle` to a `trivialization`. -/
def trivialization_of_mem_pretrivialization_atlas (a : vector_prebundle R F E)
  {e : pretrivialization F (π E)} (he : e ∈ a.pretrivialization_atlas) :
  @trivialization B F _ _ _ a.total_space_topology (π E) :=
a.to_fiber_prebundle.trivialization_of_mem_pretrivialization_atlas he

lemma linear_of_mem_pretrivialization_atlas (a : vector_prebundle R F E)
  {e : pretrivialization F (π E)} (he : e ∈ a.pretrivialization_atlas) :
  @trivialization.is_linear R B F _ _ _ _ a.total_space_topology _ _ _ _
    (trivialization_of_mem_pretrivialization_atlas a he) :=
{ linear := (a.pretrivialization_linear' e he).linear }

variable (a : vector_prebundle R F E)

lemma mem_trivialization_at_source (b : B) (x : E b) :
  total_space_mk b x ∈ (a.pretrivialization_at b).source :=
a.to_fiber_prebundle.mem_trivialization_at_source b x

@[simp] lemma total_space_mk_preimage_source (b : B) :
  (total_space_mk b) ⁻¹' (a.pretrivialization_at b).source = univ :=
a.to_fiber_prebundle.total_space_mk_preimage_source b

/-- Topology on the fibers `E b` induced by the map `E b → E.total_space`. -/
def fiber_topology (b : B) : topological_space (E b) :=
a.to_fiber_prebundle.fiber_topology b

@[continuity] lemma inducing_total_space_mk (b : B) :
  @inducing _ _ (a.fiber_topology b) a.total_space_topology (total_space_mk b) :=
a.to_fiber_prebundle.inducing_total_space_mk b

@[continuity] lemma continuous_total_space_mk (b : B) :
  @continuous _ _ (a.fiber_topology b) a.total_space_topology (total_space_mk b) :=
a.to_fiber_prebundle.continuous_total_space_mk b

/-- Make a `fiber_bundle` from a `vector_prebundle`; auxiliary construction for
`vector_prebundle.vector_bundle`. -/
def to_fiber_bundle : @fiber_bundle B F _ _ _ a.total_space_topology a.fiber_topology :=
a.to_fiber_prebundle.to_fiber_bundle

/-- Make a `vector_bundle` from a `vector_prebundle`.  Concretely this means
that, given a `vector_prebundle` structure for a sigma-type `E` -- which consists of a
number of "pretrivializations" identifying parts of `E` with product spaces `U × F` -- one
establishes that for the topology constructed on the sigma-type using
`vector_prebundle.total_space_topology`, these "pretrivializations" are actually
"trivializations" (i.e., homeomorphisms with respect to the constructed topology). -/
lemma to_vector_bundle :
  @vector_bundle R _ F E _ _ _ _ _ _ a.total_space_topology a.fiber_topology a.to_fiber_bundle :=
{ trivialization_linear' := begin
    rintros _ ⟨e, he, rfl⟩,
    apply linear_of_mem_pretrivialization_atlas,
  end,
  continuous_on_coord_change' := begin
    rintros _ _ ⟨e, he, rfl⟩ ⟨e', he', rfl⟩,
    refine (a.continuous_on_coord_change he he').congr _,
    intros b hb,
    ext v,
    rw [a.coord_change_apply he he' hb v, continuous_linear_equiv.coe_coe,
      trivialization.coord_changeL_apply],
    exacts [rfl, hb]
  end }

end vector_prebundle

end


example :
    ∀ (x : Type),
    ∀ p :  x → Prop,
    ∀ q : x → Prop,
    (∀ x, p x) ∨ (∀ x, q x) →
    ∀ x, p x ∨ q x :=
/-
What does this proposition say, and
do you believe it at least might be
true? What it says is that if every
x has property p or every x has property
q, then every has the property of having
property p or property q. It seems this
should be true. Consider the cases: if
every x has property p, then certainly
every x has the property of having
property p or having property q,
because every x has property p. In
the other case, where every x has
property q, every x still has the
property of having property p or q,
because every x has property q. So
let's now go ahead and prove it.
-/
begin
/-
First, use ∀ introduction by introducing
the universally quantified variables as
assumptions: that x is an arbitrary type;
and p and q are arbitrary properties of
values of this type.
-/
intro x,
intros p q,
/-
To prove the remaining implication, start
by assuming the premise of the goal, then
proceed to prove the conclusion.
-/
assume pf : (∀ x, p x) ∨ (∀ x, q x),
/-
To prove this ∀, we once again use the
rule for ∀ introduction: assume that we
have an arbitrary value (of the right
type), then show that the remaining
predicate is true for that arbitrary
value. That proves that it is true no
matter what value we picked, and thus
for all values of that type. The value
here will become the witness for the
final or introduction, so we'll call it
w.
-/
assume w,
/-
What we now need to prove is that w has
property, p, or that it has property, q.
What we now have to work with is a value,
is a proof that every x has property p or
that every x has property q. From that we
should be able to prove that w has either
property p or property q. To prove it we will use an elimination rule for ∀. If we have a proof, pf, of ∀ t : T, P t, and we have a value, v : T, then, treating pf as a function, we can apply pf to v to get a proof of P v.  Unfortunately, both of the ∀s are stuck inside the disjunction, pf.
And we don't know which one is true, only that at least one of them is. To use them,we have to apply or elimination, which is tantamount to proof by case analysis on pf.
-/
apply or.elim pf,
/-
Now we have to show that now matter which
of the two cases holds, the goal is true.
-/

-- Case, all x have property p

/-
When you use the cases tactic, it takes
care of introducing the assumptions of the proofs of the respective disjuncts.
When you apply or.intro directly, you
have to do it yourself. We do this for
each of the two cases that follow.
-/
intro all_x_px,
/-
Now we have w, a value of type x,
and a proof that every x has property
p. This is where we use ∀ elimination,
applying the proof that every value
has a property to a specific property
to get a proof that that specific value
has the property.
-/
have w_p := (all_x_px w),
/-
And now it's a simple matter of using
or an introduction rule to finish off
this case.
-/
exact or.inl w_p,

/-
We've now proven that if pf is true
because every x has property p then
the goal is true. Now we show that
the goal is also true if every x has
property q. The goal thus follows from
the truth of pf. The proof is symmetric
to the one we just gave/
-/
intro all_x_q,
have w_q := (all_x_q w),
exact or.inr w_q,
end

example:
    ∀ (X : Type),
    ∀ (p q : X → Prop),
    (exists x, p x) ∧ (exists x, q x) →
    exists x, (p x ∧ q x)
/-
What this proposition asserts is that
there is some object with property p
and there is some (possibly other) object with property q then there is some object
with the property of having both property
p and property q. To make this concrete,
it could be saying that if there's a ball
that is green and there is a ball that is
yellow, then there is a ball that is both
green and yellow. But that conclusion does
not follow logically from the premises!
This proposition is not true, and it's
easy to come up with counter-examples.

Let's go ahead and see what happens if
we try to prove it, and how you can get
yourself into what looks like a state
where a proof is possible, even though
it's not.
-/
    :=
begin
-- first, the usual ∀ introductions
intros,
/-
we'll need to do ∃ intro with a witness,
w, and a proof that w has both properties,
p and q.

What we have to work with is the proof,
a, a conjunction of two existentially
quantified propositions. We use and elim
to get at the constituent proofs, then we
will try exists elim to get witnesses to
each predicate, (p x) and (q x).
-/

have ex_x_p := a.left,
have ex_x_q := a.right,
apply exists.elim ex_x_p,
intro x, intro px,
apply exists.elim ex_x_q,
intro x, intro qx,

/-
It looks like we're almost done!
All we need is a proof of p x ∧ q x.
-/
have px_and_qx := and.intro px qx,

exact px_and_qx,

/-
Houston, we've had a problem!

invalid type ascription, term has type
  p x ∧ q x_1
but is expected to have type
  ∃ (x : X), p x ∧ q x
types contain aliased name(s): x
-/

-- Cannot finish proof.

/-
What went wrong? The problem is that
the two existentially quantified parts
of the original premise do correctly
promise that there some object with
property p and some object with property
q, but there's no promise that they are
the same object. For that, the premise
would have to be ∃ x, p x ∧ q x. Be
sure you understand that the scope of
the quantified variable, x, extends
only to the end of the proposition!
Somewhat annoyingly, Lean let's you
use the same name when you introduce
these two objects into your context.
But note carefully: There really are
two things named x, and there is no
way to conclude that they're the same
object! "Under the hood", Lean knows
they're not the same, and when you
finally try to pass off what *looks*
like a proof of p x ∧ q x as such a
proof, Lean actually tells you, hey,
what you've actually got here is a
proof of p x ∧ q x_1, where x_1 is
not necessarily the same as x.

A crucial lesson to learn from this
example is that you really have to
think about whether a proposition to
be proved actually makes logical sense.
In this case, it doesn't. The fact
that Lean let's you get to the end
of what looks like a valid proof
before it reminds you that you are
using the same name, x, for objects
that are not the same, is annoying,
but now you will remember!

We will give full credit for getting
to this point in the proof, because
this one was tricky.
-/
end

example:
    ∀ (X : Type),
    ∀ (p q : X → Prop),
    (exists x, p x) ∨ (exists x, q x) →
    exists x, p x ∨ q x :=
begin
/-
Here the proposition asserts that
if there's object with property p
or there's an object with property
q, then there's an object that has
the property of having either property
p or property q. That seems logically
sensible, so we will go ahead and try
to prove it.

We see that what we have to work with
is the assumption that either there's
and object with property p or one with
property q, and what we have to prove
is there's an object with one of these
properties. To construct the required
proof, we'll have to use ∃ introduction.
To get the "ingredients" we'll need to
do that, namely a witness and a proof,
we're going to have to use (1) or elim,
i.e., case analysis, on the disjunction,
and (2) ∃ elim in each case. We'll use
the cases tactic to do or elimination.
-/
intros,
cases a with ex_px ex_qx,
-- case ex_px
apply exists.elim ex_px, intros,
apply exists.intro a,
exact or.inl a_1,
-- case ex_qx
apply exists.elim ex_qx, intros,
apply exists.intro a,
exact or.inr a_1,
end


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

/-!
# Nontrivial types

A type is *nontrivial* if it contains at least two elements. This is useful in particular for rings
(where it is equivalent to the fact that zero is different from one) and for vector spaces
(where it is equivalent to the fact that the dimension is positive).

We introduce a typeclass `nontrivial` formalizing this property.
-/

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

open_locale classical

/-- Predicate typeclass for expressing that a type is not reduced to a single element. In rings,
this is equivalent to `0 ≠ 1`. In vector spaces, this is equivalent to positive dimension. -/
class nontrivial (α : Type*) : Prop :=
(exists_pair_ne : ∃ (x y : α), x ≠ y)

lemma nontrivial_iff : nontrivial α ↔ ∃ (x y : α), x ≠ y :=
⟨λ h, h.exists_pair_ne, λ h, ⟨h⟩⟩

lemma exists_pair_ne (α : Type*) [nontrivial α] : ∃ (x y : α), x ≠ y :=
nontrivial.exists_pair_ne

-- See Note [decidable namespace]
protected lemma decidable.exists_ne [nontrivial α] [decidable_eq α] (x : α) : ∃ y, y ≠ x :=
begin
  rcases exists_pair_ne α with ⟨y, y', h⟩,
  by_cases hx : x = y,
  { rw ← hx at h,
    exact ⟨y', h.symm⟩ },
  { exact ⟨y, ne.symm hx⟩ }
end

lemma exists_ne [nontrivial α] (x : α) : ∃ y, y ≠ x :=
by classical; exact decidable.exists_ne x

-- `x` and `y` are explicit here, as they are often needed to guide typechecking of `h`.
lemma nontrivial_of_ne (x y : α) (h : x ≠ y) : nontrivial α :=
⟨⟨x, y, h⟩⟩

-- `x` and `y` are explicit here, as they are often needed to guide typechecking of `h`.
lemma nontrivial_of_lt [preorder α] (x y : α) (h : x < y) : nontrivial α :=
⟨⟨x, y, ne_of_lt h⟩⟩

lemma nontrivial_iff_exists_ne (x : α) : nontrivial α ↔ ∃ y, y ≠ x :=
⟨λ h, @exists_ne α h x, λ ⟨y, hy⟩, nontrivial_of_ne _ _ hy⟩

lemma subtype.nontrivial_iff_exists_ne (p : α → Prop) (x : subtype p) :
  nontrivial (subtype p) ↔ ∃ (y : α) (hy : p y), y ≠ x :=
by simp only [nontrivial_iff_exists_ne x, subtype.exists, ne.def, subtype.ext_iff, subtype.coe_mk]

instance : nontrivial Prop := ⟨⟨true, false, true_ne_false⟩⟩

/--
See Note [lower instance priority]

Note that since this and `nonempty_of_inhabited` are the most "obvious" way to find a nonempty
instance if no direct instance can be found, we give this a higher priority than the usual `100`.
-/
@[priority 500]
instance nontrivial.to_nonempty [nontrivial α] : nonempty α :=
let ⟨x, _⟩ := exists_pair_ne α in ⟨x⟩

attribute [instance, priority 500] nonempty_of_inhabited

/-- An inhabited type is either nontrivial, or has a unique element. -/
noncomputable def nontrivial_psum_unique (α : Type*) [inhabited α] :
  psum (nontrivial α) (unique α) :=
if h : nontrivial α then psum.inl h else psum.inr
{ default := default α,
  uniq := λ (x : α),
  begin
    change x = default α,
    contrapose! h,
    use [x, default α]
  end }

lemma subsingleton_iff : subsingleton α ↔ ∀ (x y : α), x = y :=
⟨by { introsI h, exact subsingleton.elim }, λ h, ⟨h⟩⟩

lemma not_nontrivial_iff_subsingleton : ¬(nontrivial α) ↔ subsingleton α :=
by { rw [nontrivial_iff, subsingleton_iff], push_neg, refl }

lemma not_subsingleton (α) [h : nontrivial α] : ¬subsingleton α :=
let ⟨⟨x, y, hxy⟩⟩ := h in λ ⟨h'⟩, hxy $ h' x y

/-- A type is either a subsingleton or nontrivial. -/
lemma subsingleton_or_nontrivial (α : Type*) : subsingleton α ∨ nontrivial α :=
by { rw [← not_nontrivial_iff_subsingleton, or_comm], exact classical.em _ }

lemma false_of_nontrivial_of_subsingleton (α : Type*) [nontrivial α] [subsingleton α] : false :=
let ⟨x, y, h⟩ := exists_pair_ne α in h $ subsingleton.elim x y

instance option.nontrivial [nonempty α] : nontrivial (option α) :=
by { inhabit α, use [none, some (default α)] }

/-- Pushforward a `nontrivial` instance along an injective function. -/
protected lemma function.injective.nontrivial [nontrivial α]
  {f : α → β} (hf : function.injective f) : nontrivial β :=
let ⟨x, y, h⟩ := exists_pair_ne α in ⟨⟨f x, f y, hf.ne h⟩⟩

/-- Pullback a `nontrivial` instance along a surjective function. -/
protected lemma function.surjective.nontrivial [nontrivial β]
  {f : α → β} (hf : function.surjective f) : nontrivial α :=
begin
  rcases exists_pair_ne β with ⟨x, y, h⟩,
  rcases hf x with ⟨x', hx'⟩,
  rcases hf y with ⟨y', hy'⟩,
  have : x' ≠ y', by { contrapose! h, rw [← hx', ← hy', h] },
  exact ⟨⟨x', y', this⟩⟩
end

/-- An injective function from a nontrivial type has an argument at
which it does not take a given value. -/
protected lemma function.injective.exists_ne [nontrivial α] {f : α → β}
  (hf : function.injective f) (y : β) : ∃ x, f x ≠ y :=
begin
  rcases exists_pair_ne α with ⟨x₁, x₂, hx⟩,
  by_cases h : f x₂ = y,
  { exact ⟨x₁, (hf.ne_iff' h).2 hx⟩ },
  { exact ⟨x₂, h⟩ }
end

instance nontrivial_prod_right [nonempty α] [nontrivial β] : nontrivial (α × β) :=
prod.snd_surjective.nontrivial

instance nontrivial_prod_left [nontrivial α] [nonempty β] : nontrivial (α × β) :=
prod.fst_surjective.nontrivial

namespace pi

variables {I : Type*} {f : I → Type*}

/-- A pi type is nontrivial if it's nonempty everywhere and nontrivial somewhere. -/
lemma nontrivial_at (i' : I) [inst : Π i, nonempty (f i)] [nontrivial (f i')] :
  nontrivial (Π i : I, f i) :=
by classical; exact
(function.update_injective (λ i, classical.choice (inst i)) i').nontrivial

/--
As a convenience, provide an instance automatically if `(f (default I))` is nontrivial.

If a different index has the non-trivial type, then use `haveI := nontrivial_at that_index`.
-/
instance nontrivial [inhabited I] [inst : Π i, nonempty (f i)] [nontrivial (f (default I))] :
  nontrivial (Π i : I, f i) :=
nontrivial_at (default I)

end pi

instance function.nontrivial [h : nonempty α] [nontrivial β] : nontrivial (α → β) :=
h.elim $ λ a, pi.nontrivial_at a

mk_simp_attribute nontriviality "Simp lemmas for `nontriviality` tactic"

protected lemma subsingleton.le [preorder α] [subsingleton α] (x y : α) : x ≤ y :=
le_of_eq (subsingleton.elim x y)

attribute [nontriviality] eq_iff_true_of_subsingleton subsingleton.le

namespace tactic

/--
Tries to generate a `nontrivial α` instance by performing case analysis on
`subsingleton_or_nontrivial α`,
attempting to discharge the subsingleton branch using lemmas with `@[nontriviality]` attribute,
including `subsingleton.le` and `eq_iff_true_of_subsingleton`.
-/
meta def nontriviality_by_elim (α : expr) (lems : interactive.parse simp_arg_list) : tactic unit :=
do
  alternative ← to_expr ``(subsingleton_or_nontrivial %%α),
  n ← get_unused_name "_inst",
  tactic.cases alternative [n, n],
  (solve1 $ do
    reset_instance_cache,
    apply_instance <|>
      interactive.simp none none ff lems [`nontriviality] (interactive.loc.ns [none])) <|>
      fail format!"Could not prove goal assuming `subsingleton {α}`",
  reset_instance_cache

/--
Tries to generate a `nontrivial α` instance using `nontrivial_of_ne` or `nontrivial_of_lt`
and local hypotheses.
-/
meta def nontriviality_by_assumption (α : expr) : tactic unit :=
do
  n ← get_unused_name "_inst",
  to_expr ``(nontrivial %%α) >>= assert n,
  apply_instance <|> `[solve_by_elim [nontrivial_of_ne, nontrivial_of_lt]],
  reset_instance_cache

end tactic

namespace tactic.interactive

open tactic

setup_tactic_parser

/--
Attempts to generate a `nontrivial α` hypothesis.

The tactic first looks for an instance using `apply_instance`.

If the goal is an (in)equality, the type `α` is inferred from the goal.
Otherwise, the type needs to be specified in the tactic invocation, as `nontriviality α`.

The `nontriviality` tactic will first look for strict inequalities amongst the hypotheses,
and use these to derive the `nontrivial` instance directly.

Otherwise, it will perform a case split on `subsingleton α ∨ nontrivial α`, and attempt to discharge
the `subsingleton` goal using `simp [lemmas] with nontriviality`, where `[lemmas]` is a list of
additional `simp` lemmas that can be passed to `nontriviality` using the syntax
`nontriviality α using [lemmas]`.

```
example {R : Type} [ordered_ring R] {a : R} (h : 0 < a) : 0 < a :=
begin
  nontriviality, -- There is now a `nontrivial R` hypothesis available.
  assumption,
end
```

```
example {R : Type} [comm_ring R] {r s : R} : r * s = s * r :=
begin
  nontriviality, -- There is now a `nontrivial R` hypothesis available.
  apply mul_comm,
end
```

```
example {R : Type} [ordered_ring R] {a : R} (h : 0 < a) : (2 : ℕ) ∣ 4 :=
begin
  nontriviality R, -- there is now a `nontrivial R` hypothesis available.
  dec_trivial
end
```

```
def myeq {α : Type} (a b : α) : Prop := a = b

example {α : Type} (a b : α) (h : a = b) : myeq a b :=
begin
  success_if_fail { nontriviality α }, -- Fails
  nontriviality α using [myeq], -- There is now a `nontrivial α` hypothesis available
  assumption
end
```
-/
meta def nontriviality (t : parse texpr?)
  (lems : parse (tk "using" *> simp_arg_list <|> pure [])) :
  tactic unit :=
do
  α ← match t with
  | some α := to_expr α
  | none :=
    (do t ← mk_mvar, e ← to_expr ``(@eq %%t _ _), target >>= unify e, return t) <|>
    (do t ← mk_mvar, e ← to_expr ``(@has_le.le %%t _ _ _), target >>= unify e, return t) <|>
    (do t ← mk_mvar, e ← to_expr ``(@ne %%t _ _), target >>= unify e, return t) <|>
    (do t ← mk_mvar, e ← to_expr ``(@has_lt.lt %%t _ _ _), target >>= unify e, return t) <|>
    fail "The goal is not an (in)equality, so you'll need to specify the desired `nontrivial α`
      instance by invoking `nontriviality α`."
  end,
  nontriviality_by_assumption α <|> nontriviality_by_elim α lems

add_tactic_doc
{ name                     := "nontriviality",
  category                 := doc_category.tactic,
  decl_names               := [`tactic.interactive.nontriviality],
  tags                     := ["logic", "type class"] }

end tactic.interactive

namespace bool

instance : nontrivial bool := ⟨⟨tt,ff, tt_eq_ff_eq_false⟩⟩

end bool


import algebra.module

instance field.to_vector_space {K : Type} [field K] :
vector_space K K := ⟨ring.to_module⟩

lemma eq_zero_of_add_self_eq {α : Type} [add_group α]
{a : α} (H : a + a = a) : a = 0 :=
add_left_cancel (by {rw add_zero, exact H})

class subspace (K : Type) (V : Type) [field K] [vector_space K V] (p : V → Prop) :=
    (p_zero : p 0)
    (p_add : ∀ u v, p u → p v → p (u + v))
    (p_neg : ∀ v, p v → p (-v))
    (p_smul : ∀ c v, p v → p (c • v))

namespace subspace

variables (K : Type) {V : Type} [field K] [vector_space K V]
{p : V → Prop} [subspace K V p]

variables {c d : K} (u v : {x // p x})

include K

def add (u v : {x // p x}) : {x // p x} :=
{
    val := u.val + v.val,
    property := p_add K u.val v.val u.property v.property
}

def zero : {x // p x} :=
{
    val := 0,
    property := p_zero K p
}

def neg (v : {x // p x}) : {x // p x} :=
{
    val := -v.val,
    property := p_neg K v.val v.property
}

def smul (c : K) (v : {x // p x}) : {x // p x} :=
{
    val := c • v.val,
    property := p_smul c v.val v.property
}

instance : has_add {x // p x} := ⟨add K⟩
instance : has_zero {x // p x} := ⟨zero K⟩
instance : has_neg {x // p x} := ⟨neg K⟩
instance : has_scalar K {x // p x} := ⟨smul K⟩

@[simp] lemma add_simp : (add K u v).val = u.val + v.val := rfl
@[simp] lemma zero_simp : (zero K : {x // p x}).val = 0 := rfl
@[simp] lemma neg_simp : (neg K v).val = -v.val := rfl
@[simp] lemma smul_simp : (smul K c v).val = c • v.val := rfl
@[simp] lemma add_simp' : (u + v).val = u.val + v.val := rfl
@[simp] lemma zero_simp' : (0 : {x // p x}).val = 0 := rfl
@[simp] lemma neg_simp' : (-v).val = -v.val := rfl
@[simp] lemma smul_simp' : (c • v).val = c • v.val := rfl

instance : vector_space K {x // p x} :=
{
    add                 := add K,
    add_assoc           := (λ u v w, subtype.eq (by simp [add_assoc])),
    zero                := zero K,
    zero_add            := (λ v, subtype.eq (by simp [zero_add])),
    add_zero            := (λ v, subtype.eq (by simp [add_zero])),
    neg                 := neg K,
    add_left_neg        := (λ v, subtype.eq (by simp [add_left_neg])),
    add_comm            := (λ u v, subtype.eq (by simp [add_comm])),
    smul                := smul K,
    smul_left_distrib   := (λ c u v, subtype.eq (by simp [smul_left_distrib])),
    smul_right_distrib  := (λ c u v, subtype.eq (by simp [smul_right_distrib])),
    mul_smul            := (λ c d v, subtype.eq (by simp [mul_smul])),
    one_smul            := (λ v, subtype.eq (by simp [one_smul]))
}

end subspace

structure linear_space (K V W : Type) [field K]
[vector_space K V] [vector_space K W] :=
    (T : V → W)
    (map_add : ∀ u v, T (u+v) = T u + T v)
    (map_mul : ∀ (c:K) v, T (c • v) = c • (T v))

namespace linear_space

variables {K V W : Type} [field K] [vector_space K V] [vector_space K W]
variables {c d : K}

section basic

variables {u v : V} {A B C : linear_space K V W}

@[simp] lemma map_add_simp : A.T (u+v) = A.T u + A.T v := map_add A u v
@[simp] lemma map_mul_simp : A.T (c•v) = c • (A.T v) := map_mul A c v

theorem ext (HAB : ∀ v, A.T v = B.T v) : A = B :=
by {cases A, cases B, congr, exact funext HAB}

@[simp] lemma map_zero : A.T 0 = 0 :=
begin
    have := eq.symm (map_add A 0 0),
    rw [add_zero] at this,
    exact eq_zero_of_add_self_eq this
end

@[simp] lemma map_neg : A.T (-v) = -(A.T v) :=
eq_neg_of_add_eq_zero (by {rw [←map_add], simp})

@[simp] lemma map_sub : A.T (u-v) = A.T u - A.T v := by simp

end basic

@[simp] def ker (A : linear_space K V W) : V → Prop := (λ v, A.T v = 0)

namespace ker

variables {A : linear_space K V W}
variables (u v : V)

theorem ker_of_map_eq_map (Huv : A.T u = A.T v) : A.ker (u-v) :=
by {rw [ker,map_sub], exact sub_eq_zero_of_eq Huv}

theorem inj_of_trivial_ker (H: ∀ v, A.ker v → v = 0) (Huv: A.T u = A.T v) : u = v :=
eq_of_sub_eq_zero (H _ (ker_of_map_eq_map _ _ Huv))

theorem ker_add (HU : A.ker u) (HV : A.ker v) : A.ker (u + v) :=
by {unfold ker at *, simp [HU,HV]}

theorem ker_zero : A.ker 0 := map_zero

theorem ker_neg (HV : A.ker v) : A.ker (-v) :=
by {unfold ker at *, simp [HV]}

theorem ker_sub (HU : A.ker u) (HV : A.ker v) : A.ker (u - v) :=
by {unfold ker at *, simp [HU,HV]}

theorem ker_smul (c : K) (v : V) (HV : A.ker v) : A.ker (c • v) :=
by {unfold ker at *, simp [HV]}

instance : subspace K V A.ker :=
{
    p_add := ker_add,
    p_zero := ker_zero,
    p_neg := ker_neg,
    p_smul := ker_smul
}

end ker

section Hom

variables {u v : V} {A B C : linear_space K V W}

def add (A B : linear_space K V W) : (linear_space K V W) :=
{
    T       := (λ v, (A.T v) + (B.T v)),
    map_add := (λ u v, by simp),
    map_mul := (λ c v, by simp [smul_left_distrib])
}

def zero : linear_space K V W :=
{
    T       := (λ v, 0),
    map_add := (λ u v, by simp),
    map_mul := (λ c v, by simp)
}

def neg (A : linear_space K V W) : linear_space K V W :=
{
    T       := (λ v, -A.T v),
    map_add := (λ u v, by simp),
    map_mul := (λ c v, by simp)
}

instance : has_add (linear_space K V W) := ⟨add⟩
instance : has_zero (linear_space K V W) := ⟨zero⟩
instance : has_neg (linear_space K V W) := ⟨neg⟩

@[simp] lemma add_simp : (A + B).T v = A.T v + B.T v := rfl
@[simp] lemma zero_simp : (0:linear_space K V W).T v = 0 := rfl
@[simp] lemma neg_simp : (-A).T v = -(A.T v) := rfl

def smul (c : K) (A : linear_space K V W) : linear_space K V W :=
{
    T       := (λ v, c•(A.T v)),
    map_add := (λ u v, by simp [smul_left_distrib]),
    map_mul := (λ k v, by simp [smul_smul])
}

local infix `⬝` := smul

@[simp] lemma smul_simp : (c⬝A).T v = c•(A.T v) := rfl

variables (c d u v A B C)

theorem add_zero : A + 0 = A := ext (λ v, by simp [add_zero])
theorem zero_add : 0 + A = A := ext (λ v, by simp [zero_add])
theorem add_right_neg : A + (-A) = 0 := ext (λ v, by simp [add_right_neg])
theorem add_left_neg : (-A) + A = 0 := ext (λ v, by simp [add_left_neg])
theorem add_assoc : A + B + C = A + (B + C) := ext (λ v, by simp [add_assoc])
theorem add_comm : A + B = B + A := ext (λ v, by simp [add_comm])
theorem smul_left_distrib : c⬝(A+B) = c⬝A + c⬝B := ext (λ v, by simp [smul_left_distrib])
theorem smul_right_distrib : (c+d)⬝A = c⬝A + d⬝A := ext (λ v, by simp [smul_right_distrib])
theorem mul_smul : (c*d)⬝A = c⬝(d⬝A) := ext (λ v, by simp [mul_smul])
theorem one_smul : 1⬝A = A := ext (λ v, by simp [one_smul])

instance : vector_space K (linear_space K V W) :=
{
    add                 := add,
    add_assoc           := add_assoc,
    zero                := zero,
    zero_add            := zero_add,
    add_zero            := add_zero,
    neg                 := neg,
    add_left_neg        := add_left_neg,
    add_comm            := add_comm,
    smul                := smul,
    smul_left_distrib   := smul_left_distrib,
    smul_right_distrib  := smul_right_distrib,
    mul_smul            := mul_smul,
    one_smul            := one_smul
}

end Hom

def Hom {K : Type} (V W : Type) [field K] [vector_space K V] [vector_space K W] :=
vector_space K (linear_space K V W)

def vector_space.dual {K: Type} (V: Type) [field K] [vector_space K V] :=
@Hom K V K _ _ field.to_vector_space

-- \ast
postfix `∗`:100 := vector_space.dual

section matrix_ring

variables {v : V} {A B C : linear_space K V V}

def id : linear_space K V V :=
{
    T       := id,
    map_add := (λ u v, rfl),
    map_mul := (λ u v, rfl),
}

def comp (A B : linear_space K V V) : linear_space K V V :=
{
    T       := (λ v, A.T $ B.T v),
    map_add := (λ u v, by simp),
    map_mul := (λ c v, by simp)
}

instance : has_mul (linear_space K V V) := ⟨comp⟩

@[simp] lemma id_simp : (id : linear_space K V V).T v = v := rfl
@[simp] lemma comp_simp : (A * B).T v = A.T (B.T v) := rfl

variables (v A B C)

@[simp] lemma comp_id : A * id = A := ext (λ v, rfl)
@[simp] lemma id_comp : id * A = A := ext (λ v, rfl)
theorem comp_assoc : (A * B) * C = A * (B * C) := ext (λ v, rfl)
theorem comp_add : A * (B + C) = A * B + A * C := ext (λ v, by simp)
theorem add_comp : (A + B) * C = A * C + B * C := ext (λ v, rfl)

instance : ring (linear_space K V V) :=
{
    add             := add,
    add_assoc       := add_assoc,
    zero            := zero,
    zero_add        := zero_add,
    add_zero        := add_zero,
    neg             := neg,
    add_left_neg    := add_left_neg,
    add_comm        := add_comm,
    mul             := comp,
    mul_assoc       := comp_assoc,
    one             := id,
    one_mul         := id_comp,
    mul_one         := comp_id,
    left_distrib    := comp_add,
    right_distrib   := add_comp
}

end matrix_ring

variables (K V)

namespace general_linear

structure invertible :=
    (val : linear_space K V V)
    (inv : linear_space K V V)
    (property : val*inv = (id:linear_space K V V) ∧ inv*val = id)

variables {A B C : invertible K V}
variables {K V}

def ext (HAB : (∀ v:V, A.val.T v = B.val.T v)) : A = B :=
begin
    cases A,
    cases B,
    congr,
    apply ext HAB,
    have HAB : val = val_1 := ext HAB,
    exact calc
        inv = inv * (val_1 * inv_1) : by rw [property_1.1,comp_id]
        ... = (inv * val_1) * inv_1 : by rw [mul_assoc]
        ... = (inv * val) * inv_1   : by rw [HAB]
        ... = inv_1                 : by rw [property.2,id_comp]
end

lemma mul_four {α : Type} [monoid α]
{a b c d : α} : (a * b) * (c * d) = a * (b * c) * d := by simp

def comp (A B : invertible K V) : invertible K V :=
{
    val := A.val * B.val,
    inv := B.inv * A.inv,
    property := ⟨by simp [mul_four,B.property.1,A.property.1],
                by simp [mul_four,A.property.2,B.property.2]⟩
}

def id : invertible K V :=
{
    val := id,
    inv := id,
    property := ⟨comp_id id, id_comp id⟩
}

def inv (A : invertible K V) : invertible K V :=
{
    val := A.inv,
    inv := A.val,
    property := ⟨A.property.2, A.property.1⟩
}

instance : has_mul (invertible K V) := ⟨comp⟩
instance : has_one (invertible K V) := ⟨id⟩
instance : has_inv (invertible K V) := ⟨inv⟩

variables (A B C) (u v : V)

@[simp] lemma comp_simp : (comp A B).val.T v = A.val.T (B.val.T v) := rfl
@[simp] lemma id_simp : (id : invertible K V).val.T v = v := rfl
@[simp] lemma inv_simp : (inv A).val.T v = A.inv.T v := rfl
@[simp] lemma comp_simp' : (A * B).val.T v = A.val.T (B.val.T v) := rfl
@[simp] lemma id_simp' : (1 : invertible K V).val.T v = v := rfl
@[simp] lemma inv_simp' : (A⁻¹).val.T v = A.inv.T v := rfl
@[simp] lemma comp_inv_simp' : (A*A⁻¹).val.T v = v :=
begin
    have := A.property.1,
    have : (A.val * A.inv).T v = linear_space.id.T v := by rw [this],
    simp at this,
    simp [this]
end
@[simp] lemma inv_comp_simp' : (A⁻¹*A).val.T v = v :=
begin
    have := A.property.2,
    have : (A.inv * A.val).T v = linear_space.id.T v := by rw [this],
    simp at this,
    simp [this]
end

theorem comp_assoc : (A * B) * C = A * (B * C) := ext (λ v, by simp)
theorem comp_id : A * id = A := ext (λ v, by simp)
theorem id_comp : id * A = A := ext (λ v, by simp)
theorem comp_right_inv : A * A⁻¹ = 1 := ext (λ v, by simp)
theorem comp_left_inv : A⁻¹ * A = 1 := ext (λ v, by simp)

instance : group (invertible K V) :=
{
    mul := comp,
    mul_assoc := comp_assoc,
    one := id,
    mul_one := comp_id,
    one_mul := id_comp,
    inv := inv,
    mul_left_inv := comp_left_inv
}

end general_linear

end linear_space


/-
Copyright (c) 2018 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Y. Lewis, Mario Carneiro

Define the p-adic integers ℤ_p as a subtype of ℚ_p. Construct algebraic structures on ℤ_p.
-/

import data.padics.padic_numbers ring_theory.ideals data.int.modeq
import tactic.linarith

open nat padic metric
noncomputable theory
local attribute [instance] classical.prop_decidable

def padic_int (p : ℕ) [p.prime] := {x : ℚ_[p] // ∥x∥ ≤ 1}
notation `ℤ_[`p`]` := padic_int p

namespace padic_int
variables {p : ℕ} [nat.prime p]

def add : ℤ_[p] → ℤ_[p] → ℤ_[p]
| ⟨x, hx⟩ ⟨y, hy⟩ := ⟨x+y,
    le_trans (padic_norm_e.nonarchimedean _ _) (max_le_iff.2 ⟨hx,hy⟩)⟩

def mul : ℤ_[p] → ℤ_[p] → ℤ_[p]
| ⟨x, hx⟩ ⟨y, hy⟩ := ⟨x*y,
    begin rw padic_norm_e.mul, apply mul_le_one; {assumption <|> apply norm_nonneg} end⟩

def neg : ℤ_[p] → ℤ_[p]
| ⟨x, hx⟩ := ⟨-x, by simpa⟩

instance : ring ℤ_[p] :=
begin
  refine { add := add,
           mul := mul,
           neg := neg,
           zero := ⟨0, by simp [zero_le_one]⟩,
           one := ⟨1, by simp⟩,
           .. };
  {repeat {rintro ⟨_, _⟩}, simp [mul_assoc, left_distrib, right_distrib, add, mul, neg]}
end

lemma zero_def : ∀ x : ℤ_[p], x = 0 ↔ x.val = 0
| ⟨x, _⟩ := ⟨subtype.mk.inj, λ h, by simp at h; simp only [h]; refl⟩

@[simp] lemma add_def : ∀ (x y : ℤ_[p]), (x+y).val = x.val + y.val
| ⟨x, hx⟩ ⟨y, hy⟩ := rfl

@[simp] lemma mul_def : ∀ (x y : ℤ_[p]), (x*y).val = x.val * y.val
| ⟨x, hx⟩ ⟨y, hy⟩ := rfl

@[simp] lemma mk_zero {h} : (⟨0, h⟩ : ℤ_[p]) = (0 : ℤ_[p]) := rfl

instance : has_coe ℤ_[p] ℚ_[p] := ⟨subtype.val⟩

@[simp] lemma val_eq_coe (z : ℤ_[p]) : z.val = ↑z := rfl

@[simp] lemma coe_add : ∀ (z1 z2 : ℤ_[p]), (↑(z1 + z2) : ℚ_[p]) = ↑z1 + ↑z2
| ⟨_, _⟩ ⟨_, _⟩ := rfl

@[simp] lemma coe_mul : ∀ (z1 z2 : ℤ_[p]), (↑(z1 * z2) : ℚ_[p]) = ↑z1 * ↑z2
| ⟨_, _⟩ ⟨_, _⟩ := rfl

@[simp] lemma coe_neg : ∀ (z1 : ℤ_[p]), (↑(-z1) : ℚ_[p]) = -↑z1
| ⟨_, _⟩ := rfl

@[simp] lemma coe_sub : ∀ (z1 z2 : ℤ_[p]), (↑(z1 - z2) : ℚ_[p]) = ↑z1 - ↑z2
| ⟨_, _⟩ ⟨_, _⟩ := rfl

@[simp] lemma coe_one : (↑(1 : ℤ_[p]) : ℚ_[p]) = 1 := rfl

@[simp] lemma coe_coe : ∀ n : ℕ, (↑(↑n : ℤ_[p]) : ℚ_[p]) = (↑n : ℚ_[p])
| 0 := rfl
| (k+1) := by simp [coe_coe]

@[simp] lemma coe_zero : (↑(0 : ℤ_[p]) : ℚ_[p]) = 0 := rfl

@[simp] lemma cast_pow (x : ℤ_[p]) : ∀ (n : ℕ), (↑(x^n) : ℚ_[p]) = (↑x : ℚ_[p])^n
| 0 := by simp
| (k+1) := by simp [monoid.pow, pow]; congr; apply cast_pow

lemma mk_coe : ∀ (k : ℤ_[p]), (⟨↑k, k.2⟩ : ℤ_[p]) = k
| ⟨_, _⟩ := rfl

def inv : ℤ_[p] → ℤ_[p]
| ⟨k, _⟩ := if h : ∥k∥ = 1 then ⟨1/k, by simp [h]⟩ else 0

end padic_int

section instances
variables {p : ℕ} [nat.prime p]

@[reducible] def padic_norm_z (z : ℤ_[p]) : ℝ := ∥z.val∥

instance : metric_space ℤ_[p] := subtype.metric_space

instance : has_norm ℤ_[p] := ⟨padic_norm_z⟩

instance : normed_ring ℤ_[p] :=
{ dist_eq := λ ⟨_, _⟩ ⟨_, _⟩, rfl,
  norm_mul := λ ⟨_, _⟩ ⟨_, _⟩, norm_mul_le _ _ }

instance padic_norm_z.is_absolute_value : is_absolute_value (λ z : ℤ_[p], ∥z∥) :=
{ abv_nonneg := norm_nonneg,
  abv_eq_zero := λ ⟨_, _⟩, by simp [norm_eq_zero, padic_int.zero_def],
  abv_add := λ ⟨_,_⟩ ⟨_, _⟩, norm_triangle _ _,
  abv_mul := λ _ _, by unfold norm; simp [padic_norm_z] }

protected lemma padic_int.pmul_comm : ∀ z1 z2 : ℤ_[p], z1*z2 = z2*z1
| ⟨q1, h1⟩ ⟨q2, h2⟩ := show (⟨q1*q2, _⟩ : ℤ_[p]) = ⟨q2*q1, _⟩, by simp [mul_comm]

instance : comm_ring ℤ_[p] :=
{ mul_comm := padic_int.pmul_comm,
  ..padic_int.ring }

protected lemma padic_int.zero_ne_one : (0 : ℤ_[p]) ≠ 1 :=
show (⟨(0 : ℚ_[p]), _⟩ : ℤ_[p]) ≠ ⟨(1 : ℚ_[p]), _⟩, from mt subtype.ext.1 zero_ne_one

protected lemma padic_int.eq_zero_or_eq_zero_of_mul_eq_zero :
          ∀ (a b : ℤ_[p]), a * b = 0 → a = 0 ∨ b = 0
| ⟨a, ha⟩ ⟨b, hb⟩ := λ h : (⟨a * b, _⟩ : ℤ_[p]) = ⟨0, _⟩,
have a * b = 0, from subtype.ext.1 h,
(mul_eq_zero_iff_eq_zero_or_eq_zero.1 this).elim
  (λ h1, or.inl (by simp [h1]; refl))
  (λ h2, or.inr (by simp [h2]; refl))

instance : integral_domain ℤ_[p] :=
{ eq_zero_or_eq_zero_of_mul_eq_zero := padic_int.eq_zero_or_eq_zero_of_mul_eq_zero,
  zero_ne_one := padic_int.zero_ne_one,
  ..padic_int.comm_ring }

end instances

namespace padic_norm_z

variables {p : ℕ} [nat.prime p]

lemma le_one : ∀ z : ℤ_[p], ∥z∥ ≤ 1
| ⟨_, h⟩ := h

@[simp] lemma one : ∥(1 : ℤ_[p])∥ = 1 := by simp [norm, padic_norm_z]

@[simp] lemma mul (z1 z2 : ℤ_[p]) : ∥z1 * z2∥ = ∥z1∥ * ∥z2∥ :=
by unfold norm; simp [padic_norm_z]

@[simp] lemma pow (z : ℤ_[p]) : ∀ n : ℕ, ∥z^n∥ = ∥z∥^n
| 0 := by simp
| (k+1) := show ∥z*z^k∥ = ∥z∥*∥z∥^k, by {rw mul, congr, apply pow}

theorem nonarchimedean : ∀ (q r : ℤ_[p]), ∥q + r∥ ≤ max (∥q∥) (∥r∥)
| ⟨_, _⟩ ⟨_, _⟩ := padic_norm_e.nonarchimedean _ _

theorem add_eq_max_of_ne : ∀ {q r : ℤ_[p]}, ∥q∥ ≠ ∥r∥ → ∥q+r∥ = max (∥q∥) (∥r∥)
| ⟨_, _⟩ ⟨_, _⟩ := padic_norm_e.add_eq_max_of_ne

@[simp] lemma norm_one : ∥(1 : ℤ_[p])∥ = 1 := norm_one

lemma eq_of_norm_add_lt_right {z1 z2 : ℤ_[p]}
  (h : ∥z1 + z2∥ < ∥z2∥) : ∥z1∥ = ∥z2∥ :=
by_contradiction $ λ hne,
  not_lt_of_ge (by rw padic_norm_z.add_eq_max_of_ne hne; apply le_max_right) h

lemma eq_of_norm_add_lt_left {z1 z2 : ℤ_[p]}
  (h : ∥z1 + z2∥ < ∥z1∥) : ∥z1∥ = ∥z2∥ :=
by_contradiction $ λ hne,
  not_lt_of_ge (by rw padic_norm_z.add_eq_max_of_ne hne; apply le_max_left) h

@[simp] lemma padic_norm_e_of_padic_int (z : ℤ_[p]) : ∥(↑z : ℚ_[p])∥ = ∥z∥ :=
by simp [norm, padic_norm_z]

@[simp] lemma padic_norm_z_eq_padic_norm_e {q : ℚ_[p]} (hq : ∥q∥ ≤ 1) :
  @norm ℤ_[p] _ ⟨q, hq⟩ = ∥q∥ := rfl

end padic_norm_z

private lemma mul_lt_one {α} [decidable_linear_ordered_comm_ring α] {a b : α} (hbz : 0 < b)
  (ha : a < 1) (hb : b < 1) : a * b < 1 :=
suffices a*b < 1*1, by simpa,
mul_lt_mul ha (le_of_lt hb) hbz zero_le_one

private lemma mul_lt_one_of_le_of_lt {α} [decidable_linear_ordered_comm_ring α] {a b : α} (ha : a ≤ 1)
  (hbz : 0 ≤ b) (hb : b < 1) : a * b < 1 :=
if hb' : b = 0 then by simpa [hb'] using zero_lt_one
else if ha' : a = 1 then by simpa [ha']
else mul_lt_one (lt_of_le_of_ne hbz (ne.symm hb')) (lt_of_le_of_ne ha ha') hb

namespace padic_int

variables {p : ℕ} [nat.prime p]

local attribute [reducible] padic_int

lemma mul_inv : ∀ {z : ℤ_[p]}, ∥z∥ = 1 → z * z.inv = 1
| ⟨k, _⟩ h :=
  begin
    have hk : k ≠ 0, from λ h', @zero_ne_one ℚ_[p] _ (by simpa [h'] using h),
    unfold padic_int.inv, split_ifs,
    { change (⟨k * (1/k), _⟩ : ℤ_[p]) = 1,
      simp [hk], refl },
    { apply subtype.ext.2, simp [mul_inv_cancel hk] }
  end

lemma inv_mul {z : ℤ_[p]} (hz : ∥z∥ = 1) : z.inv * z = 1 :=
by rw [mul_comm, mul_inv hz]

lemma is_unit_iff {z : ℤ_[p]} : is_unit z ↔ ∥z∥ = 1 :=
⟨λ h, begin
  rcases is_unit_iff_dvd_one.1 h with ⟨w, eq⟩,
  refine le_antisymm (padic_norm_z.le_one _) _,
  have := mul_le_mul_of_nonneg_left (padic_norm_z.le_one w) (norm_nonneg z),
  rwa [mul_one, ← padic_norm_z.mul, ← eq, padic_norm_z.one] at this
end, λ h, ⟨⟨z, z.inv, mul_inv h, inv_mul h⟩, rfl⟩⟩

lemma norm_lt_one_add {z1 z2 : ℤ_[p]} (hz1 : ∥z1∥ < 1) (hz2 : ∥z2∥ < 1) : ∥z1 + z2∥ < 1 :=
lt_of_le_of_lt (padic_norm_z.nonarchimedean _ _) (max_lt hz1 hz2)

lemma norm_lt_one_mul {z1 z2 : ℤ_[p]} (hz2 : ∥z2∥ < 1) : ∥z1 * z2∥ < 1 :=
calc  ∥z1 * z2∥ = ∥z1∥ * ∥z2∥ : by simp
           ... < 1 : mul_lt_one_of_le_of_lt (padic_norm_z.le_one _) (norm_nonneg _) hz2

@[simp] lemma mem_nonunits {z : ℤ_[p]} : z ∈ nonunits ℤ_[p] ↔ ∥z∥ < 1 :=
by rw lt_iff_le_and_ne; simp [padic_norm_z.le_one z, nonunits, is_unit_iff]

instance : is_local_ring ℤ_[p] :=
local_of_nonunits_ideal zero_ne_one $ λ x y, by simp; exact norm_lt_one_add

private def cau_seq_to_rat_cau_seq (f : cau_seq ℤ_[p] norm) :
  cau_seq ℚ_[p] (λ a, ∥a∥) :=
⟨ λ n, f n,
  λ _ hε, by simpa [norm, padic_norm_z] using f.cauchy hε ⟩

instance complete : cau_seq.is_complete ℤ_[p] norm :=
⟨ λ f,
  have hqn : ∥cau_seq.lim (cau_seq_to_rat_cau_seq f)∥ ≤ 1,
    from padic_norm_e_lim_le zero_lt_one (λ _, padic_norm_z.le_one _),
  ⟨ ⟨_, hqn⟩,
    λ ε, by simpa [norm, padic_norm_z] using cau_seq.equiv_lim (cau_seq_to_rat_cau_seq f) ε⟩⟩

end padic_int

namespace padic_norm_z
variables {p : ℕ} [nat.prime p]

lemma padic_val_of_cong_pow_p {z1 z2 : ℤ} {n : ℕ} (hz : z1 ≡ z2 [ZMOD ↑(p^n)]) :
      ∥(z1 - z2 : ℚ_[p])∥ ≤ ↑(↑p ^ (-n : ℤ) : ℚ) :=
have hdvd : ↑(p^n) ∣ z2 - z1, from int.modeq.modeq_iff_dvd.1 hz,
have (↑(z2 - z1) : ℚ_[p]) = padic.of_rat p ↑(z2 - z1), by simp,
begin
  rw [norm_sub_rev, ←int.cast_sub, this, padic_norm_e.eq_padic_norm],
  simpa using padic_norm.le_of_dvd p hdvd
end

end padic_norm_z


-- Eliminación de la disyunción en Lean
-- ====================================

-- Demostrar que si
--    P → R y
--    Q → R
-- entonces
--    P ∨ Q → R

import tactic

variables (P Q R : Prop)

-- 1ª demostración
example
  (hPR : P → R)
  (hQR : Q → R)
  : P ∨ Q → R :=
begin
  intro h,
  cases h with hP hQ,
  { exact hPR hP },
  { exact hQR hQ },
end

-- 2ª demostración
example
  (hPR : P → R)
  (hQR : Q → R)
  : P ∨ Q → R :=
begin
  rintro (hP | hQ),
  { exact hPR hP },
  { exact hQR hQ },
end

-- 3ª demostración
example
  (hPR : P → R)
  (hQR : Q → R)
  : P ∨ Q → R :=
λ h, or.elim h hPR hQR

-- 4ª demostración
example
  (hPR : P → R)
  (hQR : Q → R)
  : P ∨ Q → R :=
-- by library_search
or.rec hPR hQR

-- 5ª demostración
example
  (hPR : P → R)
  (hQR : Q → R)
  : P ∨ Q → R :=
by tauto

-- 6ª demostración
example
  (hPR : P → R)
  (hQR : Q → R)
  : P ∨ Q → R :=
by finish


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

! This file was ported from Lean 3 source module order.succ_pred.interval_succ
! leanprover-community/mathlib commit c227d107bbada5d0d9d20287e3282c0a7f1651a0
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Set.Pairwise.Basic
import Mathlib.Order.SuccPred.Basic

/-!
# Intervals `Ixx (f x) (f (Order.succ x))`

In this file we prove

* `Monotone.bunionᵢ_Ico_Ioc_map_succ`: if `α` is a linear archimedean succ order and `β` is a linear
  order, then for any monotone function `f` and `m n : α`, the union of intervals
  `Set.Ioc (f i) (f (Order.succ i))`, `m ≤ i < n`, is equal to `Set.Ioc (f m) (f n)`;

* `Monotone.pairwise_disjoint_on_Ioc_succ`: if `α` is a linear succ order, `β` is a preorder, and
  `f : α → β` is a monotone function, then the intervals `Set.Ioc (f n) (f (Order.succ n))` are
  pairwise disjoint.

For the latter lemma, we also prove various order dual versions.
-/

open Set Order

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

namespace Monotone

/-- If `α` is a linear archimedean succ order and `β` is a linear order, then for any monotone
function `f` and `m n : α`, the union of intervals `Set.Ioc (f i) (f (Order.succ i))`, `m ≤ i < n`,
is equal to `Set.Ioc (f m) (f n)` -/
theorem bunionᵢ_Ico_Ioc_map_succ [SuccOrder α] [IsSuccArchimedean α] [LinearOrder β] {f : α → β}
    (hf : Monotone f) (m n : α) : (⋃ i ∈ Ico m n, Ioc (f i) (f (succ i))) = Ioc (f m) (f n) := by
  cases' le_total n m with hnm hmn
  · rw [Ico_eq_empty_of_le hnm, Ioc_eq_empty_of_le (hf hnm), bunionᵢ_empty]
  · refine' Succ.rec _ _ hmn
    · simp only [Ioc_self, Ico_self, bunionᵢ_empty]
    · intro k hmk ihk
      rw [← Ioc_union_Ioc_eq_Ioc (hf hmk) (hf <| le_succ _), union_comm, ← ihk]
      by_cases hk : IsMax k
      · rw [hk.succ_eq, Ioc_self, empty_union]
      · rw [Ico_succ_right_eq_insert_of_not_isMax hmk hk, bunionᵢ_insert]
#align monotone.bUnion_Ico_Ioc_map_succ Monotone.bunionᵢ_Ico_Ioc_map_succ

/-- If `α` is a linear succ order, `β` is a preorder, and `f : α → β` is a monotone function, then
the intervals `Set.Ioc (f n) (f (Order.succ n))` are pairwise disjoint. -/
theorem pairwise_disjoint_on_Ioc_succ [SuccOrder α] [Preorder β] {f : α → β} (hf : Monotone f) :
    Pairwise (Disjoint on fun n => Ioc (f n) (f (succ n))) :=
  (pairwise_disjoint_on _).2 fun _ _ hmn =>
    disjoint_iff_inf_le.mpr fun _ ⟨⟨_, h₁⟩, ⟨h₂, _⟩⟩ =>
      h₂.not_le <| h₁.trans <| hf <| succ_le_of_lt hmn
#align monotone.pairwise_disjoint_on_Ioc_succ Monotone.pairwise_disjoint_on_Ioc_succ

/-- If `α` is a linear succ order, `β` is a preorder, and `f : α → β` is a monotone function, then
the intervals `Set.Ico (f n) (f (Order.succ n))` are pairwise disjoint. -/
theorem pairwise_disjoint_on_Ico_succ [SuccOrder α] [Preorder β] {f : α → β} (hf : Monotone f) :
    Pairwise (Disjoint on fun n => Ico (f n) (f (succ n))) :=
  (pairwise_disjoint_on _).2 fun _ _ hmn =>
    disjoint_iff_inf_le.mpr fun _ ⟨⟨_, h₁⟩, ⟨h₂, _⟩⟩ =>
      h₁.not_le <| (hf <| succ_le_of_lt hmn).trans h₂
#align monotone.pairwise_disjoint_on_Ico_succ Monotone.pairwise_disjoint_on_Ico_succ

/-- If `α` is a linear succ order, `β` is a preorder, and `f : α → β` is a monotone function, then
the intervals `Set.Ioo (f n) (f (Order.succ n))` are pairwise disjoint. -/
theorem pairwise_disjoint_on_Ioo_succ [SuccOrder α] [Preorder β] {f : α → β} (hf : Monotone f) :
    Pairwise (Disjoint on fun n => Ioo (f n) (f (succ n))) :=
  hf.pairwise_disjoint_on_Ico_succ.mono fun _ _ h => h.mono Ioo_subset_Ico_self Ioo_subset_Ico_self
#align monotone.pairwise_disjoint_on_Ioo_succ Monotone.pairwise_disjoint_on_Ioo_succ

/-- If `α` is a linear pred order, `β` is a preorder, and `f : α → β` is a monotone function, then
the intervals `Set.Ioc (f Order.pred n) (f n)` are pairwise disjoint. -/
theorem pairwise_disjoint_on_Ioc_pred [PredOrder α] [Preorder β] {f : α → β} (hf : Monotone f) :
    Pairwise (Disjoint on fun n => Ioc (f (pred n)) (f n)) := by
  simpa only [(· ∘ ·), dual_Ico] using hf.dual.pairwise_disjoint_on_Ico_succ
#align monotone.pairwise_disjoint_on_Ioc_pred Monotone.pairwise_disjoint_on_Ioc_pred

/-- If `α` is a linear pred order, `β` is a preorder, and `f : α → β` is a monotone function, then
the intervals `Set.Ico (f Order.pred n) (f n)` are pairwise disjoint. -/
theorem pairwise_disjoint_on_Ico_pred [PredOrder α] [Preorder β] {f : α → β} (hf : Monotone f) :
    Pairwise (Disjoint on fun n => Ico (f (pred n)) (f n)) := by
  simpa only [(· ∘ ·), dual_Ioc] using hf.dual.pairwise_disjoint_on_Ioc_succ
#align monotone.pairwise_disjoint_on_Ico_pred Monotone.pairwise_disjoint_on_Ico_pred

/-- If `α` is a linear pred order, `β` is a preorder, and `f : α → β` is a monotone function, then
the intervals `Set.Ioo (f Order.pred n) (f n)` are pairwise disjoint. -/
theorem pairwise_disjoint_on_Ioo_pred [PredOrder α] [Preorder β] {f : α → β} (hf : Monotone f) :
    Pairwise (Disjoint on fun n => Ioo (f (pred n)) (f n)) := by
  simpa only [(· ∘ ·), dual_Ioo] using hf.dual.pairwise_disjoint_on_Ioo_succ
#align monotone.pairwise_disjoint_on_Ioo_pred Monotone.pairwise_disjoint_on_Ioo_pred

end Monotone

namespace Antitone

/-- If `α` is a linear succ order, `β` is a preorder, and `f : α → β` is an antitone function, then
the intervals `Set.Ioc (f (Order.succ n)) (f n)` are pairwise disjoint. -/
theorem pairwise_disjoint_on_Ioc_succ [SuccOrder α] [Preorder β] {f : α → β} (hf : Antitone f) :
    Pairwise (Disjoint on fun n => Ioc (f (succ n)) (f n)) :=
  hf.dual_left.pairwise_disjoint_on_Ioc_pred
#align antitone.pairwise_disjoint_on_Ioc_succ Antitone.pairwise_disjoint_on_Ioc_succ

/-- If `α` is a linear succ order, `β` is a preorder, and `f : α → β` is an antitone function, then
the intervals `Set.Ico (f (Order.succ n)) (f n)` are pairwise disjoint. -/
theorem pairwise_disjoint_on_Ico_succ [SuccOrder α] [Preorder β] {f : α → β} (hf : Antitone f) :
    Pairwise (Disjoint on fun n => Ico (f (succ n)) (f n)) :=
  hf.dual_left.pairwise_disjoint_on_Ico_pred
#align antitone.pairwise_disjoint_on_Ico_succ Antitone.pairwise_disjoint_on_Ico_succ

/-- If `α` is a linear succ order, `β` is a preorder, and `f : α → β` is an antitone function, then
the intervals `Set.Ioo (f (Order.succ n)) (f n)` are pairwise disjoint. -/
theorem pairwise_disjoint_on_Ioo_succ [SuccOrder α] [Preorder β] {f : α → β} (hf : Antitone f) :
    Pairwise (Disjoint on fun n => Ioo (f (succ n)) (f n)) :=
  hf.dual_left.pairwise_disjoint_on_Ioo_pred
#align antitone.pairwise_disjoint_on_Ioo_succ Antitone.pairwise_disjoint_on_Ioo_succ

/-- If `α` is a linear pred order, `β` is a preorder, and `f : α → β` is an antitone function, then
the intervals `Set.Ioc (f n) (f (Order.pred n))` are pairwise disjoint. -/
theorem pairwise_disjoint_on_Ioc_pred [PredOrder α] [Preorder β] {f : α → β} (hf : Antitone f) :
    Pairwise (Disjoint on fun n => Ioc (f n) (f (pred n))) :=
  hf.dual_left.pairwise_disjoint_on_Ioc_succ
#align antitone.pairwise_disjoint_on_Ioc_pred Antitone.pairwise_disjoint_on_Ioc_pred

/-- If `α` is a linear pred order, `β` is a preorder, and `f : α → β` is an antitone function, then
the intervals `Set.Ico (f n) (f (Order.pred n))` are pairwise disjoint. -/
theorem pairwise_disjoint_on_Ico_pred [PredOrder α] [Preorder β] {f : α → β} (hf : Antitone f) :
    Pairwise (Disjoint on fun n => Ico (f n) (f (pred n))) :=
  hf.dual_left.pairwise_disjoint_on_Ico_succ
#align antitone.pairwise_disjoint_on_Ico_pred Antitone.pairwise_disjoint_on_Ico_pred

/-- If `α` is a linear pred order, `β` is a preorder, and `f : α → β` is an antitone function, then
the intervals `Set.Ioo (f n) (f (Order.pred n))` are pairwise disjoint. -/
theorem pairwise_disjoint_on_Ioo_pred [PredOrder α] [Preorder β] {f : α → β} (hf : Antitone f) :
    Pairwise (Disjoint on fun n => Ioo (f n) (f (pred n))) :=
  hf.dual_left.pairwise_disjoint_on_Ioo_succ
#align antitone.pairwise_disjoint_on_Ioo_pred Antitone.pairwise_disjoint_on_Ioo_pred

end Antitone


import UnitConjecture.FreeAbelianGroup

def induced_map {A : Type _} [AddCommGroup A] (x y z : A) : ℤ × ℤ × ℤ → A :=
 let f : Unit ⊕ Unit ⊕ Unit → A := (fun | Sum.inl _ => x | Sum.inr (Sum.inl _) => y | Sum.inr (Sum.inr _) => z)
 FreeAbelianGroup.inducedMap A f

theorem induced_ext {A : Type _} [AddCommGroup A] (x y z : A) :  ((induced_map x y z) (1, 0, 0) = x ∧ (induced_map x y z) (0, 1, 0) = y ∧ (induced_map x y z) (0, 0, 1) = z) :=
  let f : Unit ⊕ Unit ⊕ Unit → A := (fun | Sum.inl _ => x | Sum.inr (Sum.inl _) => y | Sum.inr (Sum.inr _) => z)
  let f_extends := FreeAbelianGroup.induced_extends f
  ⟨congrFun f_extends (Sum.inl ()), congrFun f_extends (Sum.inr (Sum.inl ())), congrFun f_extends (Sum.inr (Sum.inr ()))⟩

instance ind_hom {A : Type _} [AddCommGroup A] {x y z : A} : AddCommGroup.Homomorphism (induced_map x y z) := FreeAbelianGroup.induced_hom A _

def ν (A : Type) [AddCommGroup A] (x y z : A) := x + y + z + (-x + -z) = y

theorem eqn_iff_free_basis : (∀ (A : Type) [AddCommGroup A], ∀ x y z : A, (ν A x y z)) ↔ (ν (ℤ × ℤ × ℤ) (1, 0, 0) (0, 1, 0) (0, 0, 1)) := by
  apply Iff.intro
  · intro h
    apply h
  · intro h
    intro A _ x y z
    let ⟨hx, hy, hz⟩ := induced_ext x y z
    have eqn := congrArg (induced_map x y z) h
    simp only [AddCommGroup.Homomorphism.add_dist, AddCommGroup.Homomorphism.neg_push, hx, hy, hz] at eqn
    assumption

theorem eqn_check : ∀ (A : Type) [AddCommGroup A], ∀ x y z : A, ν A x y z :=
  Iff.mpr eqn_iff_free_basis rfl


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

! This file was ported from Lean 3 source module category_theory.monoidal.linear
! leanprover-community/mathlib commit 986c4d5761f938b2e1c43c01f001b6d9d88c2055
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.CategoryTheory.Linear.LinearFunctor
import Mathlib.CategoryTheory.Monoidal.Preadditive

/-!
# Linear monoidal categories

A monoidal category is `MonoidalLinear R` if it is monoidal preadditive and
tensor product of morphisms is `R`-linear in both factors.
-/

namespace CategoryTheory

open CategoryTheory.Limits

open CategoryTheory.MonoidalCategory

variable (R : Type _) [Semiring R]

variable (C : Type _) [Category C] [Preadditive C] [Linear R C]

variable [MonoidalCategory C]

-- porting note: added `MonoidalPreadditive` as argument ``
/-- A category is `MonoidalLinear R` if tensoring is `R`-linear in both factors.
-/
class MonoidalLinear [MonoidalPreadditive C] : Prop where
  tensor_smul : ∀ {W X Y Z : C} (f : W ⟶ X) (r : R) (g : Y ⟶ Z), f ⊗ r • g = r • (f ⊗ g) := by
    aesop_cat
  smul_tensor : ∀ {W X Y Z : C} (r : R) (f : W ⟶ X) (g : Y ⟶ Z), r • f ⊗ g = r • (f ⊗ g) := by
    aesop_cat
#align category_theory.monoidal_linear CategoryTheory.MonoidalLinear

attribute [simp] MonoidalLinear.tensor_smul MonoidalLinear.smul_tensor

variable {C}
variable [MonoidalPreadditive C] [MonoidalLinear R C]

instance tensorLeft_linear (X : C) : (tensorLeft X).Linear R where
#align category_theory.tensor_left_linear CategoryTheory.tensorLeft_linear

instance tensorRight_linear (X : C) : (tensorRight X).Linear R where
#align category_theory.tensor_right_linear CategoryTheory.tensorRight_linear

instance tensoringLeft_linear (X : C) : ((tensoringLeft C).obj X).Linear R where
#align category_theory.tensoring_left_linear CategoryTheory.tensoringLeft_linear

instance tensoringRight_linear (X : C) : ((tensoringRight C).obj X).Linear R where
#align category_theory.tensoring_right_linear CategoryTheory.tensoringRight_linear

/-- A faithful linear monoidal functor to a linear monoidal category
ensures that the domain is linear monoidal. -/
theorem monoidalLinearOfFaithful {D : Type _} [Category D] [Preadditive D] [Linear R D]
    [MonoidalCategory D] [MonoidalPreadditive D] (F : MonoidalFunctor D C) [Faithful F.toFunctor]
    [F.toFunctor.Additive] [F.toFunctor.Linear R] : MonoidalLinear R D :=
  { tensor_smul := by
      intros W X Y Z f r g
      apply F.toFunctor.map_injective
      simp only [F.toFunctor.map_smul r (f ⊗ g), F.toFunctor.map_smul r g, F.map_tensor,
        MonoidalLinear.tensor_smul, Linear.smul_comp, Linear.comp_smul]
    smul_tensor := by
      intros W X Y Z r f g
      apply F.toFunctor.map_injective
      simp only [F.toFunctor.map_smul r (f ⊗ g), F.toFunctor.map_smul r f, F.map_tensor,
        MonoidalLinear.smul_tensor, Linear.smul_comp, Linear.comp_smul] }
#align category_theory.monoidal_linear_of_faithful CategoryTheory.monoidalLinearOfFaithful

end CategoryTheory


def is_even (a : ℕ) := ∃ b, a = 2 * b

theorem even_plus_even {a b : ℕ} (h1 : is_even a) (h2 : is_even b) : is_even (a + b) :=
  exists.elim h1
    (assume w1,
      assume hw1,
      exists.elim h2
        (assume w2,
          assume hw2,
          exists.intro (w1 + w2)
            (calc
              a + b     = 2 * w1 + 2 * w2 : by rw [hw1, hw2]
                    ... = 2 * (w1 + w2)   : by rw mul_add)))


import mynat.definition
import mynat.mul
import world2.level2
import world2.level5
import world2.level6

namespace mynat

lemma add_mul (a b c : mynat) : (a + b) * c = a * c + b * c :=
begin [nat_num_game]
    induction c with d hd,
    {
        repeat {rw mul_zero},
        rw add_zero,
        refl,
    },
    {
        rw mul_succ,
        rw hd,
        rw mul_succ,
        rw mul_succ,
        rw ← add_assoc,
        rw ← add_assoc,
        rw add_right_comm (a * d),
        refl,
    },
end

end mynat


/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import data.set.intervals.unordered_interval
import data.set.lattice

/-!
# Order-connected sets

We say that a set `s : set α` is `ord_connected` if for all `x y ∈ s` it includes the
interval `[x, y]`. If `α` is a `densely_ordered` `conditionally_complete_linear_order` with
the `order_topology`, then this condition is equivalent to `is_preconnected s`. If `α` is a
`linear_ordered_field`, then this condition is also equivalent to `convex α s`.

In this file we prove that intersection of a family of `ord_connected` sets is `ord_connected` and
that all standard intervals are `ord_connected`.
-/

namespace set
section preorder
variables {α : Type*} [preorder α] {s t : set α}

/--
We say that a set `s : set α` is `ord_connected` if for all `x y ∈ s` it includes the
interval `[x, y]`. If `α` is a `densely_ordered` `conditionally_complete_linear_order` with
the `order_topology`, then this condition is equivalent to `is_preconnected s`. If `α` is a
`linear_ordered_field`, then this condition is also equivalent to `convex α s`.
-/
class ord_connected (s : set α) : Prop :=
(out' ⦃x⦄ (hx : x ∈ s) ⦃y⦄ (hy : y ∈ s) : Icc x y ⊆ s)

lemma ord_connected.out (h : ord_connected s) :
  ∀ ⦃x⦄ (hx : x ∈ s) ⦃y⦄ (hy : y ∈ s), Icc x y ⊆ s := h.1

lemma ord_connected_def : ord_connected s ↔ ∀ ⦃x⦄ (hx : x ∈ s) ⦃y⦄ (hy : y ∈ s), Icc x y ⊆ s :=
⟨λ h, h.1, λ h, ⟨h⟩⟩

/-- It suffices to prove `[x, y] ⊆ s` for `x y ∈ s`, `x ≤ y`. -/
lemma ord_connected_iff : ord_connected s ↔ ∀ (x ∈ s) (y ∈ s), x ≤ y → Icc x y ⊆ s :=
ord_connected_def.trans
⟨λ hs x hx y hy hxy, hs hx hy, λ H x hx y hy z hz, H x hx y hy (le_trans hz.1 hz.2) hz⟩

lemma ord_connected_of_Ioo {α : Type*} [partial_order α] {s : set α}
  (hs : ∀ (x ∈ s) (y ∈ s), x < y → Ioo x y ⊆ s) :
  ord_connected s :=
begin
  rw ord_connected_iff,
  intros x hx y hy hxy,
  rcases eq_or_lt_of_le hxy with rfl|hxy', { simpa },
  have := hs x hx y hy hxy',
  rw [← union_diff_cancel Ioo_subset_Icc_self],
  simp [*, insert_subset]
end

protected lemma Icc_subset (s : set α) [hs : ord_connected s] {x y} (hx : x ∈ s) (hy : y ∈ s) :
  Icc x y ⊆ s := hs.out hx hy

lemma ord_connected.inter {s t : set α} (hs : ord_connected s) (ht : ord_connected t) :
  ord_connected (s ∩ t) :=
⟨λ x hx y hy, subset_inter (hs.out hx.1 hy.1) (ht.out hx.2 hy.2)⟩

instance ord_connected.inter' {s t : set α} [ord_connected s] [ord_connected t] :
  ord_connected (s ∩ t) :=
ord_connected.inter ‹_› ‹_›

lemma ord_connected.dual {s : set α} (hs : ord_connected s) :
  ord_connected (order_dual.of_dual ⁻¹' s) :=
⟨λ x hx y hy z hz, hs.out hy hx ⟨hz.2, hz.1⟩⟩

lemma ord_connected_dual {s : set α} : ord_connected (order_dual.of_dual ⁻¹' s) ↔ ord_connected s :=
⟨λ h, by simpa only [ord_connected_def] using h.dual, λ h, h.dual⟩

lemma ord_connected_sInter {S : set (set α)} (hS : ∀ s ∈ S, ord_connected s) :
  ord_connected (⋂₀ S) :=
⟨λ x hx y hy, subset_sInter $ λ s hs, (hS s hs).out (hx s hs) (hy s hs)⟩

lemma ord_connected_Inter {ι : Sort*} {s : ι → set α} (hs : ∀ i, ord_connected (s i)) :
  ord_connected (⋂ i, s i) :=
ord_connected_sInter $ forall_range_iff.2 hs

instance ord_connected_Inter' {ι : Sort*} {s : ι → set α} [∀ i, ord_connected (s i)] :
  ord_connected (⋂ i, s i) :=
ord_connected_Inter ‹_›

lemma ord_connected_bInter {ι : Sort*} {p : ι → Prop} {s : Π (i : ι) (hi : p i), set α}
  (hs : ∀ i hi, ord_connected (s i hi)) :
  ord_connected (⋂ i hi, s i hi) :=
ord_connected_Inter $ λ i, ord_connected_Inter $ hs i

lemma ord_connected_pi {ι : Type*} {α : ι → Type*} [Π i, preorder (α i)] {s : set ι}
  {t : Π i, set (α i)} (h : ∀ i ∈ s, ord_connected (t i)) : ord_connected (s.pi t) :=
⟨λ x hx y hy z hz i hi, (h i hi).out (hx i hi) (hy i hi) ⟨hz.1 i, hz.2 i⟩⟩

instance ord_connected_pi' {ι : Type*} {α : ι → Type*} [Π i, preorder (α i)] {s : set ι}
  {t : Π i, set (α i)} [h : ∀ i, ord_connected (t i)] : ord_connected (s.pi t) :=
ord_connected_pi $ λ i hi, h i

@[instance] lemma ord_connected_Ici {a : α} : ord_connected (Ici a) :=
⟨λ x hx y hy z hz, le_trans hx hz.1⟩

@[instance] lemma ord_connected_Iic {a : α} : ord_connected (Iic a) :=
⟨λ x hx y hy z hz, le_trans hz.2 hy⟩

@[instance] lemma ord_connected_Ioi {a : α} : ord_connected (Ioi a) :=
⟨λ x hx y hy z hz, lt_of_lt_of_le hx hz.1⟩

@[instance] lemma ord_connected_Iio {a : α} : ord_connected (Iio a) :=
⟨λ x hx y hy z hz, lt_of_le_of_lt hz.2 hy⟩

@[instance] lemma ord_connected_Icc {a b : α} : ord_connected (Icc a b) :=
ord_connected_Ici.inter ord_connected_Iic

@[instance] lemma ord_connected_Ico {a b : α} : ord_connected (Ico a b) :=
ord_connected_Ici.inter ord_connected_Iio

@[instance] lemma ord_connected_Ioc {a b : α} : ord_connected (Ioc a b) :=
ord_connected_Ioi.inter ord_connected_Iic

@[instance] lemma ord_connected_Ioo {a b : α} : ord_connected (Ioo a b) :=
ord_connected_Ioi.inter ord_connected_Iio

@[instance] lemma ord_connected_singleton {α : Type*} [partial_order α] {a : α} :
  ord_connected ({a} : set α) :=
by { rw ← Icc_self, exact ord_connected_Icc }

@[instance] lemma ord_connected_empty : ord_connected (∅ : set α) := ⟨λ x, false.elim⟩

@[instance] lemma ord_connected_univ : ord_connected (univ : set α) := ⟨λ _ _ _ _, subset_univ _⟩

/-- In a dense order `α`, the subtype from an `ord_connected` set is also densely ordered. -/
instance [densely_ordered α] {s : set α} [hs : ord_connected s] :
  densely_ordered s :=
⟨ begin
    intros a₁ a₂ ha,
    have ha' : ↑a₁ < ↑a₂ := ha,
    obtain ⟨x, ha₁x, hxa₂⟩ := exists_between ha',
    refine ⟨⟨x, _⟩, ⟨ha₁x, hxa₂⟩⟩,
    exact (hs.out a₁.2 a₂.2) (Ioo_subset_Icc_self ⟨ha₁x, hxa₂⟩),
  end ⟩

end preorder

section linear_order
variables {α : Type*} [linear_order α] {s : set α} {x : α}

@[instance] lemma ord_connected_interval {a b : α} : ord_connected (interval a b) :=
ord_connected_Icc

lemma ord_connected.interval_subset (hs : ord_connected s) ⦃x⦄ (hx : x ∈ s) ⦃y⦄ (hy : y ∈ s) :
  interval x y ⊆ s :=
by cases le_total x y; simp only [interval_of_le, interval_of_ge, *]; apply hs.out; assumption

lemma ord_connected_iff_interval_subset :
  ord_connected s ↔ ∀ ⦃x⦄ (hx : x ∈ s) ⦃y⦄ (hy : y ∈ s), interval x y ⊆ s :=
⟨λ h, h.interval_subset,
  λ h, ord_connected_iff.2 $ λ x hx y hy hxy, by simpa only [interval_of_le hxy] using h hx hy⟩

lemma ord_connected_iff_interval_subset_left (hx : x ∈ s) :
  ord_connected s ↔ ∀ ⦃y⦄, y ∈ s → interval x y ⊆ s :=
begin
  refine ⟨λ hs, hs.interval_subset hx, λ hs, ord_connected_iff_interval_subset.2 $ λ y hy z hz, _⟩,
  suffices h : interval y x ∪ interval x z ⊆ s,
  { exact interval_subset_interval_union_interval.trans h },
  rw [interval_swap, union_subset_iff],
  exact ⟨hs hy, hs hz⟩,
end

lemma ord_connected_iff_interval_subset_right (hx : x ∈ s) :
  ord_connected s ↔ ∀ ⦃y⦄, y ∈ s → interval y x ⊆ s :=
by simp_rw [ord_connected_iff_interval_subset_left hx, interval_swap]

end linear_order
end set