/-
Copyright (c) 2018 Andreas Swerdlow. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Andreas Swerdlow
-/
import algebra.module.linear_map
import linear_algebra.bilinear_map
import linear_algebra.matrix.basis
import linear_algebra.linear_pmap

/-!
# Sesquilinear form

This files provides properties about sesquilinear forms. The maps considered are of the form
`M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R`, where `I₁ : R₁ →+* R` and `I₂ : R₂ →+* R` are ring homomorphisms and
`M₁` is a module over `R₁` and `M₂` is a module over `R₂`.
Sesquilinear forms are the special case that `M₁ = M₂`, `R₁ = R₂ = R`, and `I₁ = ring_hom.id R`.
Taking additionally `I₂ = ring_hom.id R`, then one obtains bilinear forms.

These forms are a special case of the bilinear maps defined in `bilinear_map.lean` and all basic
lemmas about construction and elementary calculations are found there.

## Main declarations

* `is_ortho`: states that two vectors are orthogonal with respect to a sesquilinear form
* `is_symm`, `is_alt`: states that a sesquilinear form is symmetric and alternating, respectively
* `orthogonal_bilin`: provides the orthogonal complement with respect to sesquilinear form

## References

* <https://en.wikipedia.org/wiki/Sesquilinear_form#Over_arbitrary_rings>

## Tags

Sesquilinear form,
-/

open_locale big_operators

variables {R R₁ R₂ R₃ M M₁ M₂ K K₁ K₂ V V₁ V₂ n: Type*}

namespace linear_map

/-! ### Orthogonal vectors -/

section comm_ring

-- the `ₗ` subscript variables are for special cases about linear (as opposed to semilinear) maps
variables [comm_semiring R] [comm_semiring R₁] [add_comm_monoid M₁] [module R₁ M₁]
  [comm_semiring R₂] [add_comm_monoid M₂] [module R₂ M₂]
  {I₁ : R₁ →+* R} {I₂ : R₂ →+* R} {I₁' : R₁ →+* R}

/-- The proposition that two elements of a sesquilinear form space are orthogonal -/
def is_ortho (B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R) (x y) : Prop := B x y = 0

lemma is_ortho_def {B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R} {x y} : B.is_ortho x y ↔ B x y = 0 := iff.rfl

lemma is_ortho_zero_left (B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R) (x) : is_ortho B (0 : M₁) x :=
by { dunfold is_ortho, rw [ map_zero B, zero_apply] }

lemma is_ortho_zero_right (B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R) (x) : is_ortho B x (0 : M₂) :=
map_zero (B x)

/-- A set of vectors `v` is orthogonal with respect to some bilinear form `B` if and only
if for all `i ≠ j`, `B (v i) (v j) = 0`. For orthogonality between two elements, use
`bilin_form.is_ortho` -/
def is_Ortho (B : M₁ →ₛₗ[I₁] M₁ →ₛₗ[I₁'] R) (v : n → M₁) : Prop :=
pairwise (B.is_ortho on v)

lemma is_Ortho_def {B : M₁ →ₛₗ[I₁] M₁ →ₛₗ[I₁'] R} {v : n → M₁} :
  B.is_Ortho v ↔ ∀ i j : n, i ≠ j → B (v i) (v j) = 0 := iff.rfl

lemma is_Ortho_flip (B : M₁ →ₛₗ[I₁] M₁ →ₛₗ[I₁'] R) {v : n → M₁} :
  B.is_Ortho v ↔ B.flip.is_Ortho v :=
begin
  simp_rw is_Ortho_def,
  split; intros h i j hij,
  { rw flip_apply,
    exact h j i (ne.symm hij) },
  simp_rw flip_apply at h,
  exact h j i (ne.symm hij),
end

end comm_ring
section field

variables [field K] [field K₁] [add_comm_group V₁] [module K₁ V₁]
  [field K₂] [add_comm_group V₂] [module K₂ V₂]
  {I₁ : K₁ →+* K} {I₂ : K₂ →+* K} {I₁' : K₁ →+* K}
  {J₁ : K →+* K} {J₂ : K →+* K}

-- todo: this also holds for [comm_ring R] [is_domain R] when J₁ is invertible
lemma ortho_smul_left {B : V₁ →ₛₗ[I₁] V₂ →ₛₗ[I₂] K} {x y} {a : K₁} (ha : a ≠ 0) :
  (is_ortho B x y) ↔ (is_ortho B (a • x) y) :=
begin
  dunfold is_ortho,
  split; intro H,
  { rw [map_smulₛₗ₂, H, smul_zero]},
  { rw [map_smulₛₗ₂, smul_eq_zero] at H,
    cases H,
    { rw I₁.map_eq_zero at H, trivial },
    { exact H }}
end

-- todo: this also holds for [comm_ring R] [is_domain R] when J₂ is invertible
lemma ortho_smul_right {B : V₁ →ₛₗ[I₁] V₂ →ₛₗ[I₂] K} {x y} {a : K₂} {ha : a ≠ 0} :
(is_ortho B x y) ↔ (is_ortho B x (a • y)) :=
begin
  dunfold is_ortho,
  split; intro H,
  { rw [map_smulₛₗ, H, smul_zero] },
  { rw [map_smulₛₗ, smul_eq_zero] at H,
    cases H,
    { simp at H,
      exfalso,
      exact ha H },
    { exact H }}
end

/-- A set of orthogonal vectors `v` with respect to some sesquilinear form `B` is linearly
  independent if for all `i`, `B (v i) (v i) ≠ 0`. -/
lemma linear_independent_of_is_Ortho {B : V₁ →ₛₗ[I₁] V₁ →ₛₗ[I₁'] K} {v : n → V₁}
  (hv₁ : B.is_Ortho v) (hv₂ : ∀ i, ¬ B.is_ortho (v i) (v i)) : linear_independent K₁ v :=
begin
  classical,
  rw linear_independent_iff',
  intros s w hs i hi,
  have : B (s.sum $ λ (i : n), w i • v i) (v i) = 0,
  { rw [hs, map_zero, zero_apply] },
  have hsum : s.sum (λ (j : n), I₁(w j) * B (v j) (v i)) = I₁(w i) * B (v i) (v i),
  { apply finset.sum_eq_single_of_mem i hi,
    intros j hj hij,
    rw [is_Ortho_def.1 hv₁ _ _ hij, mul_zero], },
  simp_rw [B.map_sum₂, map_smulₛₗ₂, smul_eq_mul, hsum] at this,
  apply I₁.map_eq_zero.mp,
  exact eq_zero_of_ne_zero_of_mul_right_eq_zero (hv₂ i) this,
end

end field

/-! ### Reflexive bilinear forms -/

section reflexive

variables [comm_semiring R] [comm_semiring R₁] [add_comm_monoid M₁] [module R₁ M₁]
  {I₁ : R₁ →+* R} {I₂ : R₁ →+* R}
  {B : M₁ →ₛₗ[I₁] M₁ →ₛₗ[I₂] R}

/-- The proposition that a sesquilinear form is reflexive -/
def is_refl (B : M₁ →ₛₗ[I₁] M₁ →ₛₗ[I₂] R) : Prop :=
  ∀ (x y), B x y = 0 → B y x = 0

namespace is_refl

variable (H : B.is_refl)

lemma eq_zero : ∀ {x y}, B x y = 0 → B y x = 0 := λ x y, H x y

lemma ortho_comm {x y} : is_ortho B x y ↔ is_ortho B y x := ⟨eq_zero H, eq_zero H⟩

end is_refl
end reflexive

/-! ### Symmetric bilinear forms -/

section symmetric

variables [comm_semiring R] [add_comm_monoid M] [module R M]
  {I : R →+* R} {B : M →ₛₗ[I] M →ₗ[R] R}

/-- The proposition that a sesquilinear form is symmetric -/
def is_symm (B : M →ₛₗ[I] M →ₗ[R] R) : Prop :=
  ∀ (x y), I (B x y) = B y x

namespace is_symm

protected lemma eq (H : B.is_symm) (x y) : I (B x y) = B y x := H x y

lemma is_refl (H : B.is_symm) : B.is_refl := λ x y H1, by { rw ←H.eq, simp [H1] }

lemma ortho_comm (H : B.is_symm) {x y} : is_ortho B x y ↔ is_ortho B y x := H.is_refl.ortho_comm

lemma dom_restrict_symm (H : B.is_symm) (p : submodule R M) : (B.dom_restrict₁₂ p p).is_symm :=
begin
  intros x y,
  simp_rw dom_restrict₁₂_apply,
  exact H x y,
end

end is_symm

lemma is_symm_iff_eq_flip {B : M →ₗ[R] M →ₗ[R] R} : B.is_symm ↔ B = B.flip :=
begin
  split; intro h,
  { ext,
    rw [←h, flip_apply, ring_hom.id_apply] },
  intros x y,
  conv_lhs { rw h },
  rw [flip_apply, ring_hom.id_apply],
end

end symmetric

/-! ### Alternating bilinear forms -/

section alternating

variables [comm_ring R] [comm_semiring R₁] [add_comm_monoid M₁] [module R₁ M₁]
  {I₁ : R₁ →+* R} {I₂ : R₁ →+* R} {I : R₁ →+* R} {B : M₁ →ₛₗ[I₁] M₁ →ₛₗ[I₂] R}

/-- The proposition that a sesquilinear form is alternating -/
def is_alt (B : M₁ →ₛₗ[I₁] M₁ →ₛₗ[I₂] R) : Prop := ∀ x, B x x = 0

namespace is_alt

variable (H : B.is_alt)
include H

lemma self_eq_zero (x) : B x x = 0 := H x

lemma neg (x y) : - B x y = B y x :=
begin
  have H1 : B (y + x) (y + x) = 0,
  { exact self_eq_zero H (y + x) },
  simp [map_add, self_eq_zero H] at H1,
  rw [add_eq_zero_iff_neg_eq] at H1,
  exact H1,
end

lemma is_refl : B.is_refl :=
begin
  intros x y h,
  rw [←neg H, h, neg_zero],
end

lemma ortho_comm {x y} : is_ortho B x y ↔ is_ortho B y x := H.is_refl.ortho_comm

end is_alt

lemma is_alt_iff_eq_neg_flip  [no_zero_divisors R] [char_zero R] {B : M₁ →ₛₗ[I] M₁ →ₛₗ[I] R} :
  B.is_alt ↔ B = -B.flip :=
begin
  split; intro h,
  { ext,
    simp_rw [neg_apply, flip_apply],
    exact (h.neg _ _).symm },
  intros x,
  let h' := congr_fun₂ h x x,
  simp only [neg_apply, flip_apply, ←add_eq_zero_iff_eq_neg] at h',
  exact add_self_eq_zero.mp h',
end

end alternating

end linear_map

namespace submodule

/-! ### The orthogonal complement -/

variables [comm_ring R] [comm_ring R₁] [add_comm_group M₁] [module R₁ M₁]
  {I₁ : R₁ →+* R} {I₂ : R₁ →+* R}
  {B : M₁ →ₛₗ[I₁] M₁ →ₛₗ[I₂] R}

/-- The orthogonal complement of a submodule `N` with respect to some bilinear form is the set of
elements `x` which are orthogonal to all elements of `N`; i.e., for all `y` in `N`, `B x y = 0`.

Note that for general (neither symmetric nor antisymmetric) bilinear forms this definition has a
chirality; in addition to this "left" orthogonal complement one could define a "right" orthogonal
complement for which, for all `y` in `N`, `B y x = 0`.  This variant definition is not currently
provided in mathlib. -/
def orthogonal_bilin (N : submodule R₁ M₁) (B : M₁ →ₛₗ[I₁] M₁ →ₛₗ[I₂] R) : submodule R₁ M₁ :=
{ carrier := { m | ∀ n ∈ N, B.is_ortho n m },
  zero_mem' := λ x _, B.is_ortho_zero_right x,
  add_mem' := λ x y hx hy n hn,
    by rw [linear_map.is_ortho, map_add, show B n x = 0, by exact hx n hn,
        show B n y = 0, by exact hy n hn, zero_add],
  smul_mem' := λ c x hx n hn,
    by rw [linear_map.is_ortho, linear_map.map_smulₛₗ, show B n x = 0, by exact hx n hn,
        smul_zero] }

variables {N L : submodule R₁ M₁}

@[simp] lemma mem_orthogonal_bilin_iff {m : M₁} :
  m ∈ N.orthogonal_bilin B ↔ ∀ n ∈ N, B.is_ortho n m := iff.rfl

lemma orthogonal_bilin_le (h : N ≤ L) : L.orthogonal_bilin B ≤ N.orthogonal_bilin B :=
λ _ hn l hl, hn l (h hl)

lemma le_orthogonal_bilin_orthogonal_bilin (b : B.is_refl) :
  N ≤ (N.orthogonal_bilin B).orthogonal_bilin B :=
λ n hn m hm, b _ _ (hm n hn)

end submodule

namespace linear_map

section orthogonal

variables [field K] [add_comm_group V] [module K V]
  [field K₁] [add_comm_group V₁] [module K₁ V₁]
  {J : K →+* K} {J₁ : K₁ →+* K} {J₁' : K₁ →+* K}

-- ↓ This lemma only applies in fields as we require `a * b = 0 → a = 0 ∨ b = 0`
lemma span_singleton_inf_orthogonal_eq_bot
  (B : V₁ →ₛₗ[J₁] V₁ →ₛₗ[J₁'] K) (x : V₁) (hx : ¬ B.is_ortho x x) :
  (K₁ ∙ x) ⊓ submodule.orthogonal_bilin (K₁ ∙ x) B = ⊥ :=
begin
  rw ← finset.coe_singleton,
  refine eq_bot_iff.2 (λ y h, _),
  rcases mem_span_finset.1 h.1 with ⟨μ, rfl⟩,
  have := h.2 x _,
  { rw finset.sum_singleton at this ⊢,
    suffices hμzero : μ x = 0,
    { rw [hμzero, zero_smul, submodule.mem_bot] },
    change B x (μ x • x) = 0 at this, rw [map_smulₛₗ, smul_eq_mul] at this,
    exact or.elim (zero_eq_mul.mp this.symm)
    (λ y, by { simp at y, exact y })
    (λ hfalse, false.elim $ hx hfalse) },
  { rw submodule.mem_span; exact λ _ hp, hp $ finset.mem_singleton_self _ }
end

-- ↓ This lemma only applies in fields since we use the `mul_eq_zero`
lemma orthogonal_span_singleton_eq_to_lin_ker {B : V →ₗ[K] V →ₛₗ[J] K} (x : V) :
  submodule.orthogonal_bilin (K ∙ x) B = (B x).ker :=
begin
  ext y,
  simp_rw [submodule.mem_orthogonal_bilin_iff, linear_map.mem_ker,
           submodule.mem_span_singleton ],
  split,
  { exact λ h, h x ⟨1, one_smul _ _⟩ },
  { rintro h _ ⟨z, rfl⟩,
    rw [is_ortho, map_smulₛₗ₂, smul_eq_zero],
    exact or.intro_right _ h }
end

-- todo: Generalize this to sesquilinear maps
lemma span_singleton_sup_orthogonal_eq_top {B : V →ₗ[K] V →ₗ[K] K}
  {x : V} (hx : ¬ B.is_ortho x x) :
  (K ∙ x) ⊔ submodule.orthogonal_bilin (K ∙ x) B = ⊤ :=
begin
  rw orthogonal_span_singleton_eq_to_lin_ker,
  exact (B x).span_singleton_sup_ker_eq_top hx,
end

-- todo: Generalize this to sesquilinear maps
/-- Given a bilinear form `B` and some `x` such that `B x x ≠ 0`, the span of the singleton of `x`
  is complement to its orthogonal complement. -/
lemma is_compl_span_singleton_orthogonal {B : V →ₗ[K] V →ₗ[K] K}
  {x : V} (hx : ¬ B.is_ortho x x) : is_compl (K ∙ x) (submodule.orthogonal_bilin (K ∙ x) B) :=
{ inf_le_bot := eq_bot_iff.1 $
    (span_singleton_inf_orthogonal_eq_bot B x hx),
  top_le_sup := eq_top_iff.1 $ span_singleton_sup_orthogonal_eq_top hx }

end orthogonal

/-! ### Nondegenerate bilinear forms -/

section nondegenerate

section comm_semiring
variables [comm_semiring R] [comm_semiring R₁] [add_comm_monoid M₁] [module R₁ M₁]
  [comm_semiring R₂] [add_comm_monoid M₂] [module R₂ M₂]
  {I₁ : R₁ →+* R} {I₂ : R₂ →+* R} {I₁' : R₁ →+* R}

/-- A bilinear form is called left-separating if
the only element that is left-orthogonal to every other element is `0`; i.e.,
for every nonzero `x` in `M₁`, there exists `y` in `M₂` with `B x y ≠ 0`.-/
def separating_left (B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R) : Prop :=
∀ x : M₁, (∀ y : M₂, B x y = 0) → x = 0

/-- A bilinear form is called right-separating if
the only element that is right-orthogonal to every other element is `0`; i.e.,
for every nonzero `y` in `M₂`, there exists `x` in `M₁` with `B x y ≠ 0`.-/
def separating_right (B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R) : Prop :=
∀ y : M₂, (∀ x : M₁, B x y = 0) → y = 0

/-- A bilinear form is called non-degenerate if it is left-separating and right-separating. -/
def nondegenerate (B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R) : Prop := separating_left B ∧ separating_right B

@[simp] lemma flip_separating_right {B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R} :
  B.flip.separating_right ↔ B.separating_left := ⟨λ hB x hy, hB x hy, λ hB x hy, hB x hy⟩

@[simp] lemma flip_separating_left {B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R} :
  B.flip.separating_left ↔ separating_right B := by rw [←flip_separating_right, flip_flip]

@[simp] lemma flip_nondegenerate {B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R} :
  B.flip.nondegenerate ↔ B.nondegenerate :=
iff.trans and.comm (and_congr flip_separating_right flip_separating_left)

lemma separating_left_iff_linear_nontrivial {B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R} :
  B.separating_left ↔ ∀ x : M₁, B x = 0 → x = 0 :=
begin
  split; intros h x hB,
  { let h' := h x,
    simp only [hB, zero_apply, eq_self_iff_true, forall_const] at h',
    exact h' },
  have h' : B x = 0 := by { ext, rw [zero_apply], exact hB _ },
  exact h x h',
end

lemma separating_right_iff_linear_flip_nontrivial {B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R} :
  B.separating_right ↔ ∀ y : M₂, B.flip y = 0 → y = 0 :=
by rw [←flip_separating_left, separating_left_iff_linear_nontrivial]

/-- A bilinear form is left-separating if and only if it has a trivial kernel. -/
theorem separating_left_iff_ker_eq_bot {B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R} :
  B.separating_left ↔ B.ker = ⊥ :=
iff.trans separating_left_iff_linear_nontrivial linear_map.ker_eq_bot'.symm

/-- A bilinear form is right-separating if and only if its flip has a trivial kernel. -/
theorem separating_right_iff_flip_ker_eq_bot {B : M₁ →ₛₗ[I₁] M₂ →ₛₗ[I₂] R} :
  B.separating_right ↔ B.flip.ker = ⊥ :=
by rw [←flip_separating_left, separating_left_iff_ker_eq_bot]

end comm_semiring

section comm_ring

variables [comm_ring R] [add_comm_group M] [module R M]
  {I I' : R →+* R}

lemma is_symm.nondegenerate_of_separating_left {B : M →ₗ[R] M →ₗ[R] R}
  (hB : B.is_symm) (hB' : B.separating_left) : B.nondegenerate :=
begin
  refine ⟨hB', _⟩,
  rw [is_symm_iff_eq_flip.mp hB, flip_separating_right],
  exact hB',
end

lemma is_symm.nondegenerate_of_separating_right {B : M →ₗ[R] M →ₗ[R] R}
  (hB : B.is_symm) (hB' : B.separating_right) : B.nondegenerate :=
begin
  refine ⟨_, hB'⟩,
  rw [is_symm_iff_eq_flip.mp hB, flip_separating_left],
  exact hB',
end

/-- The restriction of a symmetric bilinear form `B` onto a submodule `W` is
nondegenerate if `W` has trivial intersection with its orthogonal complement,
that is `disjoint W (W.orthogonal_bilin B)`. -/
lemma nondegenerate_restrict_of_disjoint_orthogonal
  {B : M →ₗ[R] M →ₗ[R] R} (hB : B.is_symm)
  {W : submodule R M} (hW : disjoint W (W.orthogonal_bilin B)) :
  (B.dom_restrict₁₂ W W).nondegenerate :=
begin
  refine (hB.dom_restrict_symm W).nondegenerate_of_separating_left  _,
  rintro ⟨x, hx⟩ b₁,
  rw [submodule.mk_eq_zero, ← submodule.mem_bot R],
  refine hW ⟨hx, λ y hy, _⟩,
  specialize b₁ ⟨y, hy⟩,
  simp_rw [dom_restrict₁₂_apply, submodule.coe_mk] at b₁,
  rw hB.ortho_comm,
  exact b₁,
end

/-- An orthogonal basis with respect to a left-separating bilinear form has no self-orthogonal
elements. -/
lemma is_Ortho.not_is_ortho_basis_self_of_separating_left [nontrivial R]
  {B : M →ₛₗ[I] M →ₛₗ[I'] R} {v : basis n R M} (h : B.is_Ortho v) (hB : B.separating_left)
  (i : n) : ¬B.is_ortho (v i) (v i) :=
begin
  intro ho,
  refine v.ne_zero i (hB (v i) $ λ m, _),
  obtain ⟨vi, rfl⟩ := v.repr.symm.surjective m,
  rw [basis.repr_symm_apply, finsupp.total_apply, finsupp.sum, map_sum],
  apply finset.sum_eq_zero,
  rintros j -,
  rw map_smulₛₗ,
  convert mul_zero _ using 2,
  obtain rfl | hij := eq_or_ne i j,
  { exact ho },
  { exact h i j hij },
end

/-- An orthogonal basis with respect to a right-separating bilinear form has no self-orthogonal
elements. -/
lemma is_Ortho.not_is_ortho_basis_self_of_separating_right [nontrivial R]
  {B : M →ₛₗ[I] M →ₛₗ[I'] R} {v : basis n R M} (h : B.is_Ortho v) (hB : B.separating_right)
  (i : n) : ¬B.is_ortho (v i) (v i) :=
begin
  rw is_Ortho_flip at h,
  rw is_ortho_flip,
  exact h.not_is_ortho_basis_self_of_separating_left (flip_separating_left.mpr hB) i,
end

/-- Given an orthogonal basis with respect to a bilinear form, the bilinear form is left-separating
if the basis has no elements which are self-orthogonal. -/
lemma is_Ortho.separating_left_of_not_is_ortho_basis_self [no_zero_divisors R]
  {B : M →ₗ[R] M →ₗ[R] R} (v : basis n R M) (hO : B.is_Ortho v) (h : ∀ i, ¬B.is_ortho (v i) (v i)) :
  B.separating_left :=
begin
  intros m hB,
  obtain ⟨vi, rfl⟩ := v.repr.symm.surjective m,
  rw linear_equiv.map_eq_zero_iff,
  ext i,
  rw [finsupp.zero_apply],
  specialize hB (v i),
  simp_rw [basis.repr_symm_apply, finsupp.total_apply, finsupp.sum, map_sum₂, map_smulₛₗ₂,
    smul_eq_mul] at hB,
  rw finset.sum_eq_single i at hB,
  { exact eq_zero_of_ne_zero_of_mul_right_eq_zero (h i) hB, },
  { intros j hj hij, convert mul_zero _ using 2, exact hO j i hij, },
  { intros hi, convert zero_mul _ using 2, exact finsupp.not_mem_support_iff.mp hi }
end

/-- Given an orthogonal basis with respect to a bilinear form, the bilinear form is right-separating
if the basis has no elements which are self-orthogonal. -/
lemma is_Ortho.separating_right_iff_not_is_ortho_basis_self [no_zero_divisors R]
  {B : M →ₗ[R] M →ₗ[R] R} (v : basis n R M) (hO : B.is_Ortho v) (h : ∀ i, ¬B.is_ortho (v i) (v i)) :
  B.separating_right :=
begin
  rw is_Ortho_flip at hO,
  rw [←flip_separating_left],
  refine is_Ortho.separating_left_of_not_is_ortho_basis_self v hO (λ i, _),
  rw is_ortho_flip,
  exact h i,
end

/-- Given an orthogonal basis with respect to a bilinear form, the bilinear form is nondegenerate
if the basis has no elements which are self-orthogonal. -/
lemma is_Ortho.nondegenerate_of_not_is_ortho_basis_self [no_zero_divisors R]
  {B : M →ₗ[R] M →ₗ[R] R} (v : basis n R M) (hO : B.is_Ortho v) (h : ∀ i, ¬B.is_ortho (v i) (v i)) :
  B.nondegenerate :=
⟨is_Ortho.separating_left_of_not_is_ortho_basis_self v hO h,
  is_Ortho.separating_right_iff_not_is_ortho_basis_self v hO h⟩

end comm_ring

end nondegenerate

end linear_map


/-
Copyright (c) 2020 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Myers
-/
import data.set.pointwise.interval
import linear_algebra.affine_space.basic
import linear_algebra.bilinear_map
import linear_algebra.pi
import linear_algebra.prod

/-!
# Affine maps

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

This file defines affine maps.

## Main definitions

* `affine_map` is the type of affine maps between two affine spaces with the same ring `k`.  Various
  basic examples of affine maps are defined, including `const`, `id`, `line_map` and `homothety`.

## Notations

* `P1 →ᵃ[k] P2` is a notation for `affine_map k P1 P2`;
* `affine_space V P`: a localized notation for `add_torsor V P` defined in
  `linear_algebra.affine_space.basic`.

## Implementation notes

`out_param` is used in the definition of `[add_torsor V P]` to make `V` an implicit argument
(deduced from `P`) in most cases; `include V` is needed in many cases for `V`, and type classes
using it, to be added as implicit arguments to individual lemmas.  As for modules, `k` is an
explicit argument rather than implied by `P` or `V`.

This file only provides purely algebraic definitions and results. Those depending on analysis or
topology are defined elsewhere; see `analysis.normed_space.add_torsor` and
`topology.algebra.affine`.

## References

* https://en.wikipedia.org/wiki/Affine_space
* https://en.wikipedia.org/wiki/Principal_homogeneous_space
-/

open_locale affine

/-- An `affine_map k P1 P2` (notation: `P1 →ᵃ[k] P2`) is a map from `P1` to `P2` that
induces a corresponding linear map from `V1` to `V2`. -/
structure affine_map (k : Type*) {V1 : Type*} (P1 : Type*) {V2 : Type*} (P2 : Type*)
    [ring k]
    [add_comm_group V1] [module k V1] [affine_space V1 P1]
    [add_comm_group V2] [module k V2] [affine_space V2 P2] :=
(to_fun : P1 → P2)
(linear : V1 →ₗ[k] V2)
(map_vadd' : ∀ (p : P1) (v : V1), to_fun (v +ᵥ p) =  linear v +ᵥ to_fun p)

notation P1 ` →ᵃ[`:25 k:25 `] `:0 P2:0 := affine_map k P1 P2

instance affine_map.fun_like (k : Type*) {V1 : Type*} (P1 : Type*) {V2 : Type*} (P2 : Type*)
  [ring k]
  [add_comm_group V1] [module k V1] [affine_space V1 P1]
  [add_comm_group V2] [module k V2] [affine_space V2 P2]:
  fun_like (P1 →ᵃ[k] P2) P1 (λ _, P2) :=
{ coe := affine_map.to_fun,
  coe_injective' := λ ⟨f, f_linear, f_add⟩ ⟨g, g_linear, g_add⟩ (h : f = g), begin
    cases (add_torsor.nonempty : nonempty P1) with p,
    congr' with v,
    apply vadd_right_cancel (f p),
    erw [← f_add, h, ← g_add]
  end }

instance affine_map.has_coe_to_fun (k : Type*) {V1 : Type*} (P1 : Type*) {V2 : Type*} (P2 : Type*)
  [ring k]
  [add_comm_group V1] [module k V1] [affine_space V1 P1]
  [add_comm_group V2] [module k V2] [affine_space V2 P2] :
  has_coe_to_fun (P1 →ᵃ[k] P2) (λ _, P1 → P2) := fun_like.has_coe_to_fun

namespace linear_map

variables {k : Type*} {V₁ : Type*} {V₂ : Type*} [ring k] [add_comm_group V₁] [module k V₁]
  [add_comm_group V₂] [module k V₂] (f : V₁ →ₗ[k] V₂)

/-- Reinterpret a linear map as an affine map. -/
def to_affine_map : V₁ →ᵃ[k] V₂ :=
{ to_fun := f,
  linear := f,
  map_vadd' := λ p v, f.map_add v p }

@[simp] lemma coe_to_affine_map : ⇑f.to_affine_map = f := rfl

@[simp] lemma to_affine_map_linear : f.to_affine_map.linear = f := rfl

end linear_map

namespace affine_map

variables {k : Type*} {V1 : Type*} {P1 : Type*} {V2 : Type*} {P2 : Type*}
    {V3 : Type*} {P3 : Type*} {V4 : Type*} {P4 : Type*} [ring k]
    [add_comm_group V1] [module k V1] [affine_space V1 P1]
    [add_comm_group V2] [module k V2] [affine_space V2 P2]
    [add_comm_group V3] [module k V3] [affine_space V3 P3]
    [add_comm_group V4] [module k V4] [affine_space V4 P4]
include V1 V2

/-- Constructing an affine map and coercing back to a function
produces the same map. -/
@[simp] lemma coe_mk (f : P1 → P2) (linear add) :
  ((mk f linear add : P1 →ᵃ[k] P2) : P1 → P2) = f := rfl

/-- `to_fun` is the same as the result of coercing to a function. -/
@[simp] lemma to_fun_eq_coe (f : P1 →ᵃ[k] P2) : f.to_fun = ⇑f := rfl

/-- An affine map on the result of adding a vector to a point produces
the same result as the linear map applied to that vector, added to the
affine map applied to that point. -/
@[simp] lemma map_vadd (f : P1 →ᵃ[k] P2) (p : P1) (v : V1) :
  f (v +ᵥ p) = f.linear v +ᵥ f p := f.map_vadd' p v

/-- The linear map on the result of subtracting two points is the
result of subtracting the result of the affine map on those two
points. -/
@[simp] lemma linear_map_vsub (f : P1 →ᵃ[k] P2) (p1 p2 : P1) :
  f.linear (p1 -ᵥ p2) = f p1 -ᵥ f p2 :=
by conv_rhs { rw [←vsub_vadd p1 p2, map_vadd, vadd_vsub] }

/-- Two affine maps are equal if they coerce to the same function. -/
@[ext] lemma ext {f g : P1 →ᵃ[k] P2} (h : ∀ p, f p = g p) : f = g :=
fun_like.ext _ _ h

lemma ext_iff {f g : P1 →ᵃ[k] P2} : f = g ↔ ∀ p, f p = g p := ⟨λ h p, h ▸ rfl, ext⟩

lemma coe_fn_injective : @function.injective (P1 →ᵃ[k] P2) (P1 → P2) coe_fn :=
fun_like.coe_injective

protected lemma congr_arg (f : P1 →ᵃ[k] P2) {x y : P1} (h : x = y) : f x = f y :=
congr_arg _ h

protected lemma congr_fun {f g : P1 →ᵃ[k] P2} (h : f = g) (x : P1) : f x = g x :=
h ▸ rfl

variables (k P1)

/-- Constant function as an `affine_map`. -/
def const (p : P2) : P1 →ᵃ[k] P2 :=
{ to_fun := function.const P1 p,
  linear := 0,
  map_vadd' := λ p v, by simp }

@[simp] lemma coe_const (p : P2) : ⇑(const k P1 p) = function.const P1 p := rfl

@[simp] lemma const_linear (p : P2) : (const k P1 p).linear = 0 := rfl

variables {k P1}

lemma linear_eq_zero_iff_exists_const (f : P1 →ᵃ[k] P2) :
  f.linear = 0 ↔ ∃ q, f = const k P1 q :=
begin
  refine ⟨λ h, _, λ h, _⟩,
  { use f (classical.arbitrary P1),
    ext,
    rw [coe_const, function.const_apply, ← @vsub_eq_zero_iff_eq V2, ← f.linear_map_vsub, h,
      linear_map.zero_apply], },
  { rcases h with ⟨q, rfl⟩,
    exact const_linear k P1 q, },
end

instance nonempty : nonempty (P1 →ᵃ[k] P2) :=
(add_torsor.nonempty : nonempty P2).elim $ λ p, ⟨const k P1 p⟩

/-- Construct an affine map by verifying the relation between the map and its linear part at one
base point. Namely, this function takes a map `f : P₁ → P₂`, a linear map `f' : V₁ →ₗ[k] V₂`, and
a point `p` such that for any other point `p'` we have `f p' = f' (p' -ᵥ p) +ᵥ f p`. -/
def mk' (f : P1 → P2) (f' : V1 →ₗ[k] V2) (p : P1) (h : ∀ p' : P1, f p' = f' (p' -ᵥ p) +ᵥ f p) :
  P1 →ᵃ[k] P2 :=
{ to_fun := f,
  linear := f',
  map_vadd' := λ p' v, by rw [h, h p', vadd_vsub_assoc, f'.map_add, vadd_vadd] }

@[simp] lemma coe_mk' (f : P1 → P2) (f' : V1 →ₗ[k] V2) (p h) : ⇑(mk' f f' p h) = f := rfl

@[simp] lemma mk'_linear (f : P1 → P2) (f' : V1 →ₗ[k] V2) (p h) : (mk' f f' p h).linear = f' := rfl

section has_smul
variables {R : Type*} [monoid R] [distrib_mul_action R V2] [smul_comm_class k R V2]

/-- The space of affine maps to a module inherits an `R`-action from the action on its codomain. -/
instance : mul_action R (P1 →ᵃ[k] V2) :=
{ smul := λ c f, ⟨c • f, c • f.linear, λ p v, by simp [smul_add]⟩,
  one_smul := λ f, ext $ λ p, one_smul _ _,
  mul_smul := λ c₁ c₂ f, ext $ λ p, mul_smul _ _ _ }

@[simp, norm_cast] lemma coe_smul (c : R) (f : P1 →ᵃ[k] V2) : ⇑(c • f) = c • f := rfl

@[simp] lemma smul_linear (t : R) (f : P1 →ᵃ[k] V2) : (t • f).linear = t • f.linear := rfl

instance [distrib_mul_action Rᵐᵒᵖ V2] [is_central_scalar R V2] :
  is_central_scalar R (P1 →ᵃ[k] V2) :=
{ op_smul_eq_smul := λ r x, ext $ λ _, op_smul_eq_smul _ _ }

end has_smul

instance : has_zero (P1 →ᵃ[k] V2) := { zero := ⟨0, 0, λ p v, (zero_vadd _ _).symm⟩ }
instance : has_add (P1 →ᵃ[k] V2) :=
{ add := λ f g, ⟨f + g, f.linear + g.linear, λ p v, by simp [add_add_add_comm]⟩ }
instance : has_sub (P1 →ᵃ[k] V2) :=
{ sub := λ f g, ⟨f - g, f.linear - g.linear, λ p v, by simp [sub_add_sub_comm]⟩ }
instance : has_neg (P1 →ᵃ[k] V2) := { neg := λ f, ⟨-f, -f.linear, λ p v, by simp [add_comm]⟩ }

@[simp, norm_cast] lemma coe_zero : ⇑(0 : P1 →ᵃ[k] V2) = 0 := rfl
@[simp, norm_cast] lemma coe_add (f g : P1 →ᵃ[k] V2) : ⇑(f + g) = f + g := rfl
@[simp, norm_cast] lemma coe_neg (f : P1 →ᵃ[k] V2) : ⇑(-f) = -f := rfl
@[simp, norm_cast] lemma coe_sub (f g : P1 →ᵃ[k] V2) : ⇑(f - g) = f - g := rfl
@[simp] lemma zero_linear : (0 : P1 →ᵃ[k] V2).linear = 0 := rfl
@[simp] lemma add_linear (f g : P1 →ᵃ[k] V2) : (f + g).linear = f.linear + g.linear := rfl
@[simp] lemma sub_linear (f g : P1 →ᵃ[k] V2) : (f - g).linear = f.linear - g.linear := rfl
@[simp] lemma neg_linear (f : P1 →ᵃ[k] V2) : (-f).linear = -f.linear := rfl

/-- The set of affine maps to a vector space is an additive commutative group. -/
instance : add_comm_group (P1 →ᵃ[k] V2) :=
coe_fn_injective.add_comm_group _
  coe_zero coe_add coe_neg coe_sub (λ _ _, coe_smul _ _) (λ _ _, coe_smul _ _)

/-- The space of affine maps from `P1` to `P2` is an affine space over the space of affine maps
from `P1` to the vector space `V2` corresponding to `P2`. -/
instance : affine_space (P1 →ᵃ[k] V2) (P1 →ᵃ[k] P2) :=
{ vadd := λ f g, ⟨λ p, f p +ᵥ g p, f.linear + g.linear, λ p v,
    by simp [vadd_vadd, add_right_comm]⟩,
  zero_vadd := λ f, ext $ λ p, zero_vadd _ (f p),
  add_vadd := λ f₁ f₂ f₃, ext $ λ p, add_vadd (f₁ p) (f₂ p) (f₃ p),
  vsub := λ f g, ⟨λ p, f p -ᵥ g p, f.linear - g.linear, λ p v,
    by simp [vsub_vadd_eq_vsub_sub, vadd_vsub_assoc, add_sub, sub_add_eq_add_sub]⟩,
  vsub_vadd' := λ f g, ext $ λ p, vsub_vadd (f p) (g p),
  vadd_vsub' := λ f g, ext $ λ p, vadd_vsub (f p) (g p) }

@[simp] lemma vadd_apply (f : P1 →ᵃ[k] V2) (g : P1 →ᵃ[k] P2) (p : P1) :
  (f +ᵥ g) p = f p +ᵥ g p :=
rfl

@[simp] lemma vsub_apply (f g : P1 →ᵃ[k] P2) (p : P1) :
  (f -ᵥ g : P1 →ᵃ[k] V2) p = f p -ᵥ g p :=
rfl

/-- `prod.fst` as an `affine_map`. -/
def fst : (P1 × P2) →ᵃ[k] P1 :=
{ to_fun := prod.fst,
  linear := linear_map.fst k V1 V2,
  map_vadd' := λ _ _, rfl }

@[simp] lemma coe_fst : ⇑(fst : (P1 × P2) →ᵃ[k] P1) = prod.fst := rfl
@[simp] lemma fst_linear : (fst : (P1 × P2) →ᵃ[k] P1).linear = linear_map.fst k V1 V2 := rfl

/-- `prod.snd` as an `affine_map`. -/
def snd : (P1 × P2) →ᵃ[k] P2 :=
{ to_fun := prod.snd,
  linear := linear_map.snd k V1 V2,
  map_vadd' := λ _ _, rfl }

@[simp] lemma coe_snd : ⇑(snd : (P1 × P2) →ᵃ[k] P2) = prod.snd := rfl
@[simp] lemma snd_linear : (snd : (P1 × P2) →ᵃ[k] P2).linear = linear_map.snd k V1 V2 := rfl

variables (k P1)
omit V2

/-- Identity map as an affine map. -/
def id : P1 →ᵃ[k] P1 :=
{ to_fun := id,
  linear := linear_map.id,
  map_vadd' := λ p v, rfl }

/-- The identity affine map acts as the identity. -/
@[simp] lemma coe_id : ⇑(id k P1) = _root_.id := rfl

@[simp] lemma id_linear : (id k P1).linear = linear_map.id := rfl

variable {P1}

/-- The identity affine map acts as the identity. -/
lemma id_apply (p : P1) : id k P1 p = p := rfl

variables {k P1}

instance : inhabited (P1 →ᵃ[k] P1) := ⟨id k P1⟩

include V2 V3

/-- Composition of affine maps. -/
def comp (f : P2 →ᵃ[k] P3) (g : P1 →ᵃ[k] P2) : P1 →ᵃ[k] P3 :=
{ to_fun := f ∘ g,
  linear := f.linear.comp g.linear,
  map_vadd' := begin
    intros p v,
    rw [function.comp_app, g.map_vadd, f.map_vadd],
    refl
  end }

/-- Composition of affine maps acts as applying the two functions. -/
@[simp] lemma coe_comp (f : P2 →ᵃ[k] P3) (g : P1 →ᵃ[k] P2) :
  ⇑(f.comp g) = f ∘ g := rfl

/-- Composition of affine maps acts as applying the two functions. -/
lemma comp_apply (f : P2 →ᵃ[k] P3) (g : P1 →ᵃ[k] P2) (p : P1) :
  f.comp g p = f (g p) := rfl

omit V3

@[simp] lemma comp_id (f : P1 →ᵃ[k] P2) : f.comp (id k P1) = f := ext $ λ p, rfl

@[simp] lemma id_comp (f : P1 →ᵃ[k] P2) : (id k P2).comp f = f := ext $ λ p, rfl

include V3 V4

lemma comp_assoc (f₃₄ : P3 →ᵃ[k] P4) (f₂₃ : P2 →ᵃ[k] P3) (f₁₂ : P1 →ᵃ[k] P2) :
  (f₃₄.comp f₂₃).comp f₁₂ = f₃₄.comp (f₂₃.comp f₁₂) :=
rfl

omit V2 V3 V4

instance : monoid (P1 →ᵃ[k] P1) :=
{ one := id k P1,
  mul := comp,
  one_mul := id_comp,
  mul_one := comp_id,
  mul_assoc := comp_assoc }

@[simp] lemma coe_mul (f g : P1 →ᵃ[k] P1) : ⇑(f * g) = f ∘ g := rfl
@[simp] lemma coe_one : ⇑(1 : P1 →ᵃ[k] P1) = _root_.id := rfl

/-- `affine_map.linear` on endomorphisms is a `monoid_hom`. -/
@[simps] def linear_hom : (P1 →ᵃ[k] P1) →* (V1 →ₗ[k] V1) :=
{ to_fun := linear,
  map_one' := rfl,
  map_mul' := λ _ _, rfl }

include V2

@[simp] lemma linear_injective_iff (f : P1 →ᵃ[k] P2) :
  function.injective f.linear ↔ function.injective f :=
begin
  obtain ⟨p⟩ := (infer_instance : nonempty P1),
  have h : ⇑f.linear = (equiv.vadd_const (f p)).symm ∘ f ∘ (equiv.vadd_const p),
  { ext v, simp [f.map_vadd, vadd_vsub_assoc], },
  rw [h, equiv.comp_injective, equiv.injective_comp],
end

@[simp] lemma linear_surjective_iff (f : P1 →ᵃ[k] P2) :
  function.surjective f.linear ↔ function.surjective f :=
begin
  obtain ⟨p⟩ := (infer_instance : nonempty P1),
  have h : ⇑f.linear = (equiv.vadd_const (f p)).symm ∘ f ∘ (equiv.vadd_const p),
  { ext v, simp [f.map_vadd, vadd_vsub_assoc], },
  rw [h, equiv.comp_surjective, equiv.surjective_comp],
end

@[simp] lemma linear_bijective_iff (f : P1 →ᵃ[k] P2) :
  function.bijective f.linear ↔ function.bijective f :=
and_congr f.linear_injective_iff f.linear_surjective_iff

lemma image_vsub_image {s t : set P1} (f : P1 →ᵃ[k] P2) :
  (f '' s) -ᵥ (f '' t) = f.linear '' (s -ᵥ t) :=
begin
  ext v,
  simp only [set.mem_vsub, set.mem_image, exists_exists_and_eq_and, exists_and_distrib_left,
    ← f.linear_map_vsub],
  split,
  { rintros ⟨x, hx, y, hy, hv⟩,
    exact ⟨x -ᵥ y, ⟨x, hx, y, hy, rfl⟩, hv⟩, },
  { rintros ⟨-, ⟨x, hx, y, hy, rfl⟩, rfl⟩,
    exact ⟨x, hx, y, hy, rfl⟩, },
end

omit V2

/-! ### Definition of `affine_map.line_map` and lemmas about it -/

/-- The affine map from `k` to `P1` sending `0` to `p₀` and `1` to `p₁`. -/
def line_map (p₀ p₁ : P1) : k →ᵃ[k] P1 :=
((linear_map.id : k →ₗ[k] k).smul_right (p₁ -ᵥ p₀)).to_affine_map +ᵥ const k k p₀

lemma coe_line_map (p₀ p₁ : P1) : (line_map p₀ p₁ : k → P1) = λ c, c • (p₁ -ᵥ p₀) +ᵥ p₀ := rfl

lemma line_map_apply (p₀ p₁ : P1) (c : k) : line_map p₀ p₁ c = c • (p₁ -ᵥ p₀) +ᵥ p₀ := rfl

lemma line_map_apply_module' (p₀ p₁ : V1) (c : k) : line_map p₀ p₁ c = c • (p₁ - p₀) + p₀ := rfl

omit V1

lemma line_map_apply_ring' (a b c : k) : line_map a b c = c * (b - a) + a :=
rfl

lemma line_map_apply_ring (a b c : k) : line_map a b c = (1 - c) * a + c * b :=
line_map_apply_module a b c

include V1

lemma line_map_vadd_apply (p : P1) (v : V1) (c : k) :
  line_map p (v +ᵥ p) c = c • v +ᵥ p :=
by rw [line_map_apply, vadd_vsub]

@[simp] lemma line_map_linear (p₀ p₁ : P1) :
  (line_map p₀ p₁ : k →ᵃ[k] P1).linear = linear_map.id.smul_right (p₁ -ᵥ p₀) :=
add_zero _

lemma line_map_same_apply (p : P1) (c : k) : line_map p p c = p := by simp [line_map_apply]

@[simp] lemma line_map_same (p : P1) : line_map p p = const k k p :=
ext $ line_map_same_apply p

@[simp] lemma line_map_apply_zero (p₀ p₁ : P1) : line_map p₀ p₁ (0:k) = p₀ :=
by simp [line_map_apply]

@[simp] lemma line_map_apply_one (p₀ p₁ : P1) : line_map p₀ p₁ (1:k) = p₁ :=
by simp [line_map_apply]

@[simp] lemma line_map_eq_line_map_iff [no_zero_smul_divisors k V1] {p₀ p₁ : P1} {c₁ c₂ : k} :
  line_map p₀ p₁ c₁ = line_map p₀ p₁ c₂ ↔ p₀ = p₁ ∨ c₁ = c₂ :=
by rw [line_map_apply, line_map_apply, ←@vsub_eq_zero_iff_eq V1, vadd_vsub_vadd_cancel_right,
       ←sub_smul, smul_eq_zero, sub_eq_zero, vsub_eq_zero_iff_eq, or_comm, eq_comm]

@[simp] lemma line_map_eq_left_iff [no_zero_smul_divisors k V1] {p₀ p₁ : P1} {c : k} :
  line_map p₀ p₁ c = p₀ ↔ p₀ = p₁ ∨ c = 0 :=
by rw [←@line_map_eq_line_map_iff k V1, line_map_apply_zero]

@[simp] lemma line_map_eq_right_iff [no_zero_smul_divisors k V1] {p₀ p₁ : P1} {c : k} :
  line_map p₀ p₁ c = p₁ ↔ p₀ = p₁ ∨ c = 1 :=
by rw [←@line_map_eq_line_map_iff k V1, line_map_apply_one]

variables (k)

lemma line_map_injective [no_zero_smul_divisors k V1] {p₀ p₁ : P1} (h : p₀ ≠ p₁) :
  function.injective (line_map p₀ p₁ : k → P1) :=
λ c₁ c₂ hc, (line_map_eq_line_map_iff.mp hc).resolve_left h

variables {k}

include V2

@[simp] lemma apply_line_map (f : P1 →ᵃ[k] P2) (p₀ p₁ : P1) (c : k) :
  f (line_map p₀ p₁ c) = line_map (f p₀) (f p₁) c :=
by simp [line_map_apply]

@[simp] lemma comp_line_map (f : P1 →ᵃ[k] P2) (p₀ p₁ : P1) :
  f.comp (line_map p₀ p₁) = line_map (f p₀) (f p₁) :=
ext $ f.apply_line_map p₀ p₁

@[simp] lemma fst_line_map (p₀ p₁ : P1 × P2) (c : k) :
  (line_map p₀ p₁ c).1 = line_map p₀.1 p₁.1 c :=
fst.apply_line_map p₀ p₁ c

@[simp] lemma snd_line_map (p₀ p₁ : P1 × P2) (c : k) :
  (line_map p₀ p₁ c).2 = line_map p₀.2 p₁.2 c :=
snd.apply_line_map p₀ p₁ c

omit V2

lemma line_map_symm (p₀ p₁ : P1) :
  line_map p₀ p₁ = (line_map p₁ p₀).comp (line_map (1:k) (0:k)) :=
by { rw [comp_line_map], simp }

lemma line_map_apply_one_sub (p₀ p₁ : P1) (c : k) :
  line_map p₀ p₁ (1 - c) = line_map p₁ p₀ c :=
by { rw [line_map_symm p₀, comp_apply], congr, simp [line_map_apply] }

@[simp] lemma line_map_vsub_left (p₀ p₁ : P1) (c : k) :
  line_map p₀ p₁ c -ᵥ p₀ = c • (p₁ -ᵥ p₀) :=
vadd_vsub _ _

@[simp] lemma left_vsub_line_map (p₀ p₁ : P1) (c : k) :
  p₀ -ᵥ line_map p₀ p₁ c = c • (p₀ -ᵥ p₁) :=
by rw [← neg_vsub_eq_vsub_rev, line_map_vsub_left, ← smul_neg, neg_vsub_eq_vsub_rev]

@[simp] lemma line_map_vsub_right (p₀ p₁ : P1) (c : k) :
  line_map p₀ p₁ c -ᵥ p₁ = (1 - c) • (p₀ -ᵥ p₁) :=
by rw [← line_map_apply_one_sub, line_map_vsub_left]

@[simp] lemma right_vsub_line_map (p₀ p₁ : P1) (c : k) :
  p₁ -ᵥ line_map p₀ p₁ c = (1 - c) • (p₁ -ᵥ p₀) :=
by rw [← line_map_apply_one_sub, left_vsub_line_map]

lemma line_map_vadd_line_map (v₁ v₂ : V1) (p₁ p₂ : P1) (c : k) :
  line_map v₁ v₂ c +ᵥ line_map p₁ p₂ c = line_map (v₁ +ᵥ p₁) (v₂ +ᵥ p₂) c :=
((fst : V1 × P1 →ᵃ[k] V1) +ᵥ snd).apply_line_map  (v₁, p₁) (v₂, p₂) c

lemma line_map_vsub_line_map (p₁ p₂ p₃ p₄ : P1) (c : k) :
  line_map p₁ p₂ c -ᵥ line_map p₃ p₄ c = line_map (p₁ -ᵥ p₃) (p₂ -ᵥ p₄) c :=
-- Why Lean fails to find this instance without a hint?
by letI : affine_space (V1 × V1) (P1 × P1) := prod.add_torsor; exact
((fst : P1 × P1 →ᵃ[k] P1) -ᵥ (snd : P1 × P1 →ᵃ[k] P1)).apply_line_map (_, _) (_, _) c

/-- Decomposition of an affine map in the special case when the point space and vector space
are the same. -/
lemma decomp (f : V1 →ᵃ[k] V2) : (f : V1 → V2) = f.linear + (λ z, f 0) :=
begin
  ext x,
  calc
    f x = f.linear x +ᵥ f 0                      : by simp [← f.map_vadd]
    ... = (f.linear.to_fun + λ (z : V1), f 0) x  : by simp
end

/-- Decomposition of an affine map in the special case when the point space and vector space
are the same. -/
lemma decomp' (f : V1 →ᵃ[k] V2) : (f.linear : V1 → V2) = f - (λ z, f 0) :=
by rw decomp ; simp only [linear_map.map_zero, pi.add_apply, add_sub_cancel, zero_add]

omit V1

lemma image_uIcc {k : Type*} [linear_ordered_field k] (f : k →ᵃ[k] k)
  (a b : k) :
  f '' set.uIcc a b = set.uIcc (f a) (f b) :=
begin
  have : ⇑f = (λ x, x + f 0) ∘ λ x, x * (f 1 - f 0),
  { ext x,
    change f x = x • (f 1 -ᵥ f 0) +ᵥ f 0,
    rw [← f.linear_map_vsub, ← f.linear.map_smul, ← f.map_vadd],
    simp only [vsub_eq_sub, add_zero, mul_one, vadd_eq_add, sub_zero, smul_eq_mul] },
  rw [this, set.image_comp],
  simp only [set.image_add_const_uIcc, set.image_mul_const_uIcc]
end

section

variables {ι : Type*} {V : Π i : ι, Type*} {P : Π i : ι, Type*} [Π i, add_comm_group (V i)]
  [Π i, module k (V i)] [Π i, add_torsor (V i) (P i)]

include V

/-- Evaluation at a point as an affine map. -/
def proj (i : ι) : (Π i : ι, P i) →ᵃ[k] P i :=
{ to_fun := λ f, f i,
  linear := @linear_map.proj k ι _ V _ _ i,
  map_vadd' := λ p v, rfl }

@[simp] lemma proj_apply (i : ι) (f : Π i, P i) : @proj k _ ι V P _ _ _ i f = f i := rfl

@[simp] lemma proj_linear (i : ι) :
   (@proj k _ ι V P _ _ _ i).linear = @linear_map.proj k ι _ V _ _ i := rfl

lemma pi_line_map_apply (f g : Π i, P i) (c : k) (i : ι) :
  line_map f g c i = line_map (f i) (g i) c :=
(proj i : (Π i, P i) →ᵃ[k] P i).apply_line_map f g c

end

end affine_map

namespace affine_map

variables {R k V1 P1 V2 : Type*}

section ring
variables [ring k] [add_comm_group V1] [affine_space V1 P1] [add_comm_group V2]
variables [module k V1] [module k V2]
include V1

section distrib_mul_action
variables [monoid R] [distrib_mul_action R V2] [smul_comm_class k R V2]

/-- The space of affine maps to a module inherits an `R`-action from the action on its codomain. -/
instance : distrib_mul_action R (P1 →ᵃ[k] V2) :=
{ smul_add := λ c f g, ext $ λ p, smul_add _ _ _,
  smul_zero := λ c, ext $ λ p, smul_zero _ }

end distrib_mul_action

section module
variables [semiring R] [module R V2] [smul_comm_class k R V2]

/-- The space of affine maps taking values in an `R`-module is an `R`-module. -/
instance : module R (P1 →ᵃ[k] V2) :=
{ smul := (•),
  add_smul := λ c₁ c₂ f, ext $ λ p, add_smul _ _ _,
  zero_smul := λ f, ext $ λ p, zero_smul _ _,
  .. affine_map.distrib_mul_action }

variables (R)

/-- The space of affine maps between two modules is linearly equivalent to the product of the
domain with the space of linear maps, by taking the value of the affine map at `(0 : V1)` and the
linear part.

See note [bundled maps over different rings]-/
@[simps] def to_const_prod_linear_map : (V1 →ᵃ[k] V2) ≃ₗ[R] V2 × (V1 →ₗ[k] V2) :=
{ to_fun    := λ f, ⟨f 0, f.linear⟩,
  inv_fun   := λ p, p.2.to_affine_map + const k V1 p.1,
  left_inv  := λ f, by { ext, rw f.decomp, simp, },
  right_inv := by { rintros ⟨v, f⟩, ext; simp, },
  map_add'  := by simp,
  map_smul' := by simp, }

end module

end ring

section comm_ring

variables [comm_ring k] [add_comm_group V1] [affine_space V1 P1] [add_comm_group V2]
variables [module k V1] [module k V2]
include V1

/-- `homothety c r` is the homothety (also known as dilation) about `c` with scale factor `r`. -/
def homothety (c : P1) (r : k) : P1 →ᵃ[k] P1 :=
r • (id k P1 -ᵥ const k P1 c) +ᵥ const k P1 c

lemma homothety_def (c : P1) (r : k) :
  homothety c r = r • (id k P1 -ᵥ const k P1 c) +ᵥ const k P1 c :=
rfl

lemma homothety_apply (c : P1) (r : k) (p : P1) : homothety c r p = r • (p -ᵥ c : V1) +ᵥ c := rfl

lemma homothety_eq_line_map (c : P1) (r : k) (p : P1) : homothety c r p = line_map c p r := rfl

@[simp] lemma homothety_one (c : P1) : homothety c (1:k) = id k P1 :=
by { ext p, simp [homothety_apply] }

@[simp] lemma homothety_apply_same (c : P1) (r : k) : homothety c r c = c := line_map_same_apply c r

lemma homothety_mul_apply (c : P1) (r₁ r₂ : k) (p : P1) :
  homothety c (r₁ * r₂) p = homothety c r₁ (homothety c r₂ p) :=
by simp [homothety_apply, mul_smul]

lemma homothety_mul (c : P1) (r₁ r₂ : k) :
  homothety c (r₁ * r₂) = (homothety c r₁).comp (homothety c r₂) :=
ext $ homothety_mul_apply c r₁ r₂

@[simp] lemma homothety_zero (c : P1) : homothety c (0:k) = const k P1 c :=
by { ext p, simp [homothety_apply] }

@[simp] lemma homothety_add (c : P1) (r₁ r₂ : k) :
  homothety c (r₁ + r₂) = r₁ • (id k P1 -ᵥ const k P1 c) +ᵥ homothety c r₂ :=
by simp only [homothety_def, add_smul, vadd_vadd]

/-- `homothety` as a multiplicative monoid homomorphism. -/
def homothety_hom (c : P1) : k →* P1 →ᵃ[k] P1 :=
⟨homothety c, homothety_one c, homothety_mul c⟩

@[simp] lemma coe_homothety_hom (c : P1) : ⇑(homothety_hom c : k →* _) = homothety c := rfl

/-- `homothety` as an affine map. -/
def homothety_affine (c : P1) : k →ᵃ[k] (P1 →ᵃ[k] P1) :=
⟨homothety c, (linear_map.lsmul k _).flip (id k P1 -ᵥ const k P1 c),
  function.swap (homothety_add c)⟩

@[simp] lemma coe_homothety_affine (c : P1) :
  ⇑(homothety_affine c : k →ᵃ[k] _) = homothety c :=
rfl

end comm_ring

end affine_map

section
variables {𝕜 E F : Type*} [ring 𝕜] [add_comm_group E] [add_comm_group F] [module 𝕜 E] [module 𝕜 F]

/-- Applying an affine map to an affine combination of two points yields an affine combination of
the images. -/
lemma convex.combo_affine_apply {x y : E} {a b : 𝕜} {f : E →ᵃ[𝕜] F} (h : a + b = 1) :
  f (a • x + b • y) = a • f x + b • f y :=
by { simp only [convex.combo_eq_smul_sub_add h, ←vsub_eq_sub], exact f.apply_line_map _ _ _ }

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 Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.pi
import Mathlib.data.prod
import Mathlib.logic.unique
import Mathlib.logic.function.basic
import Mathlib.PostPort

universes u_3 l u_1 u_2 u_4

namespace Mathlib

/-!
# 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.
-/

/-- 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 u_3) where
  exists_pair_ne : ∃ (x : α), ∃ (y : α), x ≠ y

theorem nontrivial_iff {α : Type u_1} : nontrivial α ↔ ∃ (x : α), ∃ (y : α), x ≠ y :=
  { mp := fun (h : nontrivial α) => nontrivial.exists_pair_ne,
    mpr := fun (h : ∃ (x : α), ∃ (y : α), x ≠ y) => nontrivial.mk h }

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

theorem exists_ne {α : Type u_1} [nontrivial α] (x : α) : ∃ (y : α), y ≠ x := sorry

-- `x` and `y` are explicit here, as they are often needed to guide typechecking of `h`.

theorem nontrivial_of_ne {α : Type u_1} (x : α) (y : α) (h : x ≠ y) : nontrivial α :=
  nontrivial.mk (Exists.intro x (Exists.intro y h))

-- `x` and `y` are explicit here, as they are often needed to guide typechecking of `h`.

theorem nontrivial_of_lt {α : Type u_1} [preorder α] (x : α) (y : α) (h : x < y) : nontrivial α :=
  nontrivial.mk (Exists.intro x (Exists.intro y (ne_of_lt h)))

protected instance nontrivial.to_nonempty {α : Type u_1} [nontrivial α] : Nonempty α := sorry

/-- An inhabited type is either nontrivial, or has a unique element. -/
def nontrivial_psum_unique (α : Type u_1) [Inhabited α] : psum (nontrivial α) (unique α) :=
  dite (nontrivial α) (fun (h : nontrivial α) => psum.inl h)
    fun (h : ¬nontrivial α) => psum.inr (unique.mk { default := Inhabited.default } sorry)

theorem subsingleton_iff {α : Type u_1} : subsingleton α ↔ ∀ (x y : α), x = y :=
  { mp := fun (h : subsingleton α) => subsingleton.elim,
    mpr := fun (h : ∀ (x y : α), x = y) => subsingleton.intro h }

theorem not_nontrivial_iff_subsingleton {α : Type u_1} : ¬nontrivial α ↔ subsingleton α := sorry

theorem not_subsingleton (α : Type u_1) [h : nontrivial α] : ¬subsingleton α := sorry

/-- A type is either a subsingleton or nontrivial. -/
theorem subsingleton_or_nontrivial (α : Type u_1) : subsingleton α ∨ nontrivial α :=
  eq.mpr
    (id
      (Eq._oldrec (Eq.refl (subsingleton α ∨ nontrivial α))
        (Eq.symm (propext not_nontrivial_iff_subsingleton))))
    (eq.mpr
      (id
        (Eq._oldrec (Eq.refl (¬nontrivial α ∨ nontrivial α))
          (propext (or_comm (¬nontrivial α) (nontrivial α)))))
      (classical.em (nontrivial α)))

theorem false_of_nontrivial_of_subsingleton (α : Type u_1) [nontrivial α] [subsingleton α] :
    False :=
  sorry

protected instance option.nontrivial {α : Type u_1} [Nonempty α] : nontrivial (Option α) :=
  nonempty.elim_to_inhabited
    fun (inst : Inhabited α) =>
      nontrivial.mk
        (Exists.intro none
          (Exists.intro (some Inhabited.default)
            (id (id fun (ᾰ : none = some Inhabited.default) => option.no_confusion ᾰ))))

/-- Pushforward a `nontrivial` instance along an injective function. -/
protected theorem function.injective.nontrivial {α : Type u_1} {β : Type u_2} [nontrivial α]
    {f : α → β} (hf : function.injective f) : nontrivial β :=
  sorry

/-- Pullback a `nontrivial` instance along a surjective function. -/
protected theorem function.surjective.nontrivial {α : Type u_1} {β : Type u_2} [nontrivial β]
    {f : α → β} (hf : function.surjective f) : nontrivial α :=
  sorry

/-- An injective function from a nontrivial type has an argument at
which it does not take a given value. -/
protected theorem function.injective.exists_ne {α : Type u_1} {β : Type u_2} [nontrivial α]
    {f : α → β} (hf : function.injective f) (y : β) : ∃ (x : α), f x ≠ y :=
  sorry

protected instance nontrivial_prod_right {α : Type u_1} {β : Type u_2} [Nonempty α] [nontrivial β] :
    nontrivial (α × β) :=
  function.surjective.nontrivial prod.snd_surjective

protected instance nontrivial_prod_left {α : Type u_1} {β : Type u_2} [nontrivial α] [Nonempty β] :
    nontrivial (α × β) :=
  function.surjective.nontrivial prod.fst_surjective

namespace pi

/-- A pi type is nontrivial if it's nonempty everywhere and nontrivial somewhere. -/
theorem nontrivial_at {I : Type u_3} {f : I → Type u_4} (i' : I) [inst : ∀ (i : I), Nonempty (f i)]
    [nontrivial (f i')] : nontrivial ((i : I) → f i) :=
  function.injective.nontrivial
    (function.update_injective (fun (i : I) => Classical.choice (inst i)) i')

/--
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`.
-/
protected instance nontrivial {I : Type u_3} {f : I → Type u_4} [Inhabited I]
    [inst : ∀ (i : I), Nonempty (f i)] [nontrivial (f Inhabited.default)] :
    nontrivial ((i : I) → f i) :=
  nontrivial_at Inhabited.default

end pi

protected instance function.nontrivial {α : Type u_1} {β : Type u_2} [h : Nonempty α]
    [nontrivial β] : nontrivial (α → β) :=
  nonempty.elim h fun (a : α) => pi.nontrivial_at a

protected theorem subsingleton.le {α : Type u_1} [preorder α] [subsingleton α] (x : α) (y : α) :
    x ≤ y :=
  le_of_eq (subsingleton.elim x y)

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`.
-/
/--
Tries to generate a `nontrivial α` instance using `nontrivial_of_ne` or `nontrivial_of_lt`
and local hypotheses.
-/
end tactic

namespace tactic.interactive

/--
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
```
-/
end tactic.interactive

namespace bool

protected instance nontrivial : nontrivial Bool :=
  nontrivial.mk (Exists.intro tt (Exists.intro false tt_eq_ff_eq_false))

end Mathlib


/-
Copyright (c) 2020 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anatole Dedecker
-/
import analysis.calculus.mean_value

/-!
# L'Hôpital's rule for 0/0 indeterminate forms

In this file, we prove several forms of "L'Hopital's rule" for computing 0/0
indeterminate forms. The proof of `has_deriv_at.lhopital_zero_right_on_Ioo`
is based on the one given in the corresponding
[Wikibooks](https://en.wikibooks.org/wiki/Calculus/L%27H%C3%B4pital%27s_Rule)
chapter, and all other statements are derived from this one by composing by
carefully chosen functions.

Note that the filter `f'/g'` tends to isn't required to be one of `𝓝 a`,
`at_top` or `at_bot`. In fact, we give a slightly stronger statement by
allowing it to be any filter on `ℝ`.

Each statement is available in a `has_deriv_at` form and a `deriv` form, which
is denoted by each statement being in either the `has_deriv_at` or the `deriv`
namespace.

## Tags

L'Hôpital's rule, L'Hopital's rule
-/

open filter set
open_locale filter topological_space pointwise

variables {a b : ℝ} (hab : a < b) {l : filter ℝ} {f f' g g' : ℝ → ℝ}

/-!
## Interval-based versions

We start by proving statements where all conditions (derivability, `g' ≠ 0`) have
to be satisfied on an explicitly-provided interval.
-/

namespace has_deriv_at

include hab

theorem lhopital_zero_right_on_Ioo
  (hff' : ∀ x ∈ Ioo a b, has_deriv_at f (f' x) x) (hgg' : ∀ x ∈ Ioo a b, has_deriv_at g (g' x) x)
  (hg' : ∀ x ∈ Ioo a b, g' x ≠ 0)
  (hfa : tendsto f (𝓝[>] a) (𝓝 0)) (hga : tendsto g (𝓝[>] a) (𝓝 0))
  (hdiv : tendsto (λ x, (f' x) / (g' x)) (𝓝[>] a) l) :
  tendsto (λ x, (f x) / (g x)) (𝓝[>] a) l :=
begin
  have sub : ∀ x ∈ Ioo a b, Ioo a x ⊆ Ioo a b := λ x hx, Ioo_subset_Ioo (le_refl a) (le_of_lt hx.2),
  have hg : ∀ x ∈ (Ioo a b), g x ≠ 0,
  { intros x hx h,
    have : tendsto g (𝓝[<] x) (𝓝 0),
    { rw [← h, ← nhds_within_Ioo_eq_nhds_within_Iio hx.1],
      exact ((hgg' x hx).continuous_at.continuous_within_at.mono $ sub x hx).tendsto },
    obtain ⟨y, hyx, hy⟩ : ∃ c ∈ Ioo a x, g' c = 0,
      from exists_has_deriv_at_eq_zero' hx.1 hga this (λ y hy, hgg' y $ sub x hx hy),
    exact hg' y (sub x hx hyx) hy },
  have : ∀ x ∈ Ioo a b, ∃ c ∈ Ioo a x, (f x) * (g' c) = (g x) * (f' c),
  { intros x hx,
    rw [← sub_zero (f x), ← sub_zero (g x)],
    exact exists_ratio_has_deriv_at_eq_ratio_slope' g g' hx.1 f f'
      (λ y hy, hgg' y $ sub x hx hy) (λ y hy, hff' y $ sub x hx hy) hga hfa
      (tendsto_nhds_within_of_tendsto_nhds (hgg' x hx).continuous_at.tendsto)
      (tendsto_nhds_within_of_tendsto_nhds (hff' x hx).continuous_at.tendsto) },
  choose! c hc using this,
  have : ∀ x ∈ Ioo a b, ((λ x', (f' x') / (g' x')) ∘ c) x = f x / g x,
  { intros x hx,
    rcases hc x hx with ⟨h₁, h₂⟩,
    field_simp [hg x hx, hg' (c x) ((sub x hx) h₁)],
    simp only [h₂],
    rwa mul_comm },
  have cmp : ∀ x ∈ Ioo a b, a < c x ∧ c x < x,
    from λ x hx, (hc x hx).1,
  rw ← nhds_within_Ioo_eq_nhds_within_Ioi hab,
  apply tendsto_nhds_within_congr this,
  simp only,
  apply hdiv.comp,
  refine tendsto_nhds_within_of_tendsto_nhds_of_eventually_within _
    (tendsto_of_tendsto_of_tendsto_of_le_of_le' tendsto_const_nhds
      (tendsto_nhds_within_of_tendsto_nhds tendsto_id) _ _) _,
  all_goals
  { apply eventually_nhds_within_of_forall,
    intros x hx,
    have := cmp x hx,
    try {simp},
    linarith [this] }
end

theorem lhopital_zero_right_on_Ico
  (hff' : ∀ x ∈ Ioo a b, has_deriv_at f (f' x) x) (hgg' : ∀ x ∈ Ioo a b, has_deriv_at g (g' x) x)
  (hcf : continuous_on f (Ico a b)) (hcg : continuous_on g (Ico a b))
  (hg' : ∀ x ∈ Ioo a b, g' x ≠ 0)
  (hfa : f a = 0) (hga : g a = 0)
  (hdiv : tendsto (λ x, (f' x) / (g' x)) (nhds_within a (Ioi a)) l) :
  tendsto (λ x, (f x) / (g x)) (nhds_within a (Ioi a)) l :=
begin
  refine lhopital_zero_right_on_Ioo hab hff' hgg' hg' _ _ hdiv,
  { rw [← hfa, ← nhds_within_Ioo_eq_nhds_within_Ioi hab],
    exact ((hcf a $ left_mem_Ico.mpr hab).mono Ioo_subset_Ico_self).tendsto },
  { rw [← hga, ← nhds_within_Ioo_eq_nhds_within_Ioi hab],
    exact ((hcg a $ left_mem_Ico.mpr hab).mono Ioo_subset_Ico_self).tendsto },
end

theorem lhopital_zero_left_on_Ioo
  (hff' : ∀ x ∈ Ioo a b, has_deriv_at f (f' x) x) (hgg' : ∀ x ∈ Ioo a b, has_deriv_at g (g' x) x)
  (hg' : ∀ x ∈ Ioo a b, g' x ≠ 0)
  (hfb : tendsto f (nhds_within b (Iio b)) (𝓝 0)) (hgb : tendsto g (nhds_within b (Iio b)) (𝓝 0))
  (hdiv : tendsto (λ x, (f' x) / (g' x)) (nhds_within b (Iio b)) l) :
  tendsto (λ x, (f x) / (g x)) (nhds_within b (Iio b)) l :=
begin
  -- Here, we essentially compose by `has_neg.neg`. The following is mostly technical details.
  have hdnf : ∀ x ∈ -Ioo a b, has_deriv_at (f ∘ has_neg.neg) (f' (-x) * (-1)) x,
    from λ x hx, comp x (hff' (-x) hx) (has_deriv_at_neg x),
  have hdng : ∀ x ∈ -Ioo a b, has_deriv_at (g ∘ has_neg.neg) (g' (-x) * (-1)) x,
    from λ x hx, comp x (hgg' (-x) hx) (has_deriv_at_neg x),
  rw preimage_neg_Ioo at hdnf,
  rw preimage_neg_Ioo at hdng,
  have := lhopital_zero_right_on_Ioo (neg_lt_neg hab) hdnf hdng
    (by { intros x hx h,
          apply hg' _ (by {rw ← preimage_neg_Ioo at hx, exact hx}),
          rwa [mul_comm, ← neg_eq_neg_one_mul, neg_eq_zero] at h })
    (hfb.comp tendsto_neg_nhds_within_Ioi_neg)
    (hgb.comp tendsto_neg_nhds_within_Ioi_neg)
    (by { simp only [neg_div_neg_eq, mul_one, mul_neg_eq_neg_mul_symm],
          exact (tendsto_congr $ λ x, rfl).mp (hdiv.comp tendsto_neg_nhds_within_Ioi_neg) }),
  have := this.comp tendsto_neg_nhds_within_Iio,
  unfold function.comp at this,
  simpa only [neg_neg]
end

theorem lhopital_zero_left_on_Ioc
  (hff' : ∀ x ∈ Ioo a b, has_deriv_at f (f' x) x) (hgg' : ∀ x ∈ Ioo a b, has_deriv_at g (g' x) x)
  (hcf : continuous_on f (Ioc a b)) (hcg : continuous_on g (Ioc a b))
  (hg' : ∀ x ∈ Ioo a b, g' x ≠ 0)
  (hfb : f b = 0) (hgb : g b = 0)
  (hdiv : tendsto (λ x, (f' x) / (g' x)) (nhds_within b (Iio b)) l) :
  tendsto (λ x, (f x) / (g x)) (nhds_within b (Iio b)) l :=
begin
  refine lhopital_zero_left_on_Ioo hab hff' hgg' hg' _ _ hdiv,
  { rw [← hfb, ← nhds_within_Ioo_eq_nhds_within_Iio hab],
    exact ((hcf b $ right_mem_Ioc.mpr hab).mono Ioo_subset_Ioc_self).tendsto },
  { rw [← hgb, ← nhds_within_Ioo_eq_nhds_within_Iio hab],
    exact ((hcg b $ right_mem_Ioc.mpr hab).mono Ioo_subset_Ioc_self).tendsto },
end

omit hab

theorem lhopital_zero_at_top_on_Ioi
  (hff' : ∀ x ∈ Ioi a, has_deriv_at f (f' x) x) (hgg' : ∀ x ∈ Ioi a, has_deriv_at g (g' x) x)
  (hg' : ∀ x ∈ Ioi a, g' x ≠ 0)
  (hftop : tendsto f at_top (𝓝 0)) (hgtop : tendsto g at_top (𝓝 0))
  (hdiv : tendsto (λ x, (f' x) / (g' x)) at_top l) :
  tendsto (λ x, (f x) / (g x)) at_top l :=
begin
  obtain ⟨ a', haa', ha'⟩ : ∃ a', a < a' ∧ 0 < a' :=
    ⟨1 + max a 0, ⟨lt_of_le_of_lt (le_max_left a 0) (lt_one_add _),
                   lt_of_le_of_lt (le_max_right a 0) (lt_one_add _)⟩⟩,
  have fact1 : ∀ (x:ℝ), x ∈ Ioo 0 a'⁻¹ → x ≠ 0 := λ _ hx, (ne_of_lt hx.1).symm,
  have fact2 : ∀ x ∈ Ioo 0 a'⁻¹, a < x⁻¹,
    from λ _ hx, lt_trans haa' ((lt_inv ha' hx.1).mpr hx.2),
  have hdnf : ∀ x ∈ Ioo 0 a'⁻¹, has_deriv_at (f ∘ has_inv.inv) (f' (x⁻¹) * (-(x^2)⁻¹)) x,
    from λ x hx, comp x (hff' (x⁻¹) $ fact2 x hx) (has_deriv_at_inv $ fact1 x hx),
  have hdng : ∀ x ∈ Ioo 0 a'⁻¹, has_deriv_at (g ∘ has_inv.inv) (g' (x⁻¹) * (-(x^2)⁻¹)) x,
    from λ x hx, comp x (hgg' (x⁻¹) $ fact2 x hx) (has_deriv_at_inv $ fact1 x hx),
  have := lhopital_zero_right_on_Ioo (inv_pos.mpr ha') hdnf hdng
    (by { intros x hx,
          refine mul_ne_zero _ (neg_ne_zero.mpr $ inv_ne_zero $ pow_ne_zero _ $ fact1 x hx),
          exact hg' _ (fact2 x hx) })
    (hftop.comp tendsto_inv_zero_at_top)
    (hgtop.comp tendsto_inv_zero_at_top)
    (by { refine (tendsto_congr' _).mp (hdiv.comp tendsto_inv_zero_at_top),
          rw eventually_eq_iff_exists_mem,
          use [Ioi 0, self_mem_nhds_within],
          intros x hx,
          unfold function.comp,
          erw mul_div_mul_right,
          refine neg_ne_zero.mpr (inv_ne_zero $ pow_ne_zero _ $ ne_of_gt hx) }),
  have := this.comp tendsto_inv_at_top_zero',
  unfold function.comp at this,
  simpa only [inv_inv₀],
end

theorem lhopital_zero_at_bot_on_Iio
  (hff' : ∀ x ∈ Iio a, has_deriv_at f (f' x) x) (hgg' : ∀ x ∈ Iio a, has_deriv_at g (g' x) x)
  (hg' : ∀ x ∈ Iio a, g' x ≠ 0)
  (hfbot : tendsto f at_bot (𝓝 0)) (hgbot : tendsto g at_bot (𝓝 0))
  (hdiv : tendsto (λ x, (f' x) / (g' x)) at_bot l) :
  tendsto (λ x, (f x) / (g x)) at_bot l :=
begin
  -- Here, we essentially compose by `has_neg.neg`. The following is mostly technical details.
  have hdnf : ∀ x ∈ -Iio a, has_deriv_at (f ∘ has_neg.neg) (f' (-x) * (-1)) x,
    from λ x hx, comp x (hff' (-x) hx) (has_deriv_at_neg x),
  have hdng : ∀ x ∈ -Iio a, has_deriv_at (g ∘ has_neg.neg) (g' (-x) * (-1)) x,
    from λ x hx, comp x (hgg' (-x) hx) (has_deriv_at_neg x),
  rw preimage_neg_Iio at hdnf,
  rw preimage_neg_Iio at hdng,
  have := lhopital_zero_at_top_on_Ioi hdnf hdng
    (by { intros x hx h,
          apply hg' _ (by {rw ← preimage_neg_Iio at hx, exact hx}),
          rwa [mul_comm, ← neg_eq_neg_one_mul, neg_eq_zero] at h })
    (hfbot.comp tendsto_neg_at_top_at_bot)
    (hgbot.comp tendsto_neg_at_top_at_bot)
    (by { simp only [mul_one, mul_neg_eq_neg_mul_symm, neg_div_neg_eq],
          exact (tendsto_congr $ λ x, rfl).mp (hdiv.comp tendsto_neg_at_top_at_bot) }),
  have := this.comp tendsto_neg_at_bot_at_top,
  unfold function.comp at this,
  simpa only [neg_neg],
end

end has_deriv_at

namespace deriv

include hab

theorem lhopital_zero_right_on_Ioo
  (hdf : differentiable_on ℝ f (Ioo a b)) (hg' : ∀ x ∈ Ioo a b, deriv g x ≠ 0)
  (hfa : tendsto f (𝓝[>] a) (𝓝 0)) (hga : tendsto g (𝓝[>] a) (𝓝 0))
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) (𝓝[>] a) l) :
  tendsto (λ x, (f x) / (g x)) (𝓝[>] a) l :=
begin
  have hdf : ∀ x ∈ Ioo a b, differentiable_at ℝ f x,
    from λ x hx, (hdf x hx).differentiable_at (Ioo_mem_nhds hx.1 hx.2),
  have hdg : ∀ x ∈ Ioo a b, differentiable_at ℝ g x,
    from λ x hx, classical.by_contradiction (λ h, hg' x hx (deriv_zero_of_not_differentiable_at h)),
  exact has_deriv_at.lhopital_zero_right_on_Ioo hab (λ x hx, (hdf x hx).has_deriv_at)
    (λ x hx, (hdg x hx).has_deriv_at) hg' hfa hga hdiv
end

theorem lhopital_zero_right_on_Ico
  (hdf : differentiable_on ℝ f (Ioo a b))
  (hcf : continuous_on f (Ico a b)) (hcg : continuous_on g (Ico a b))
  (hg' : ∀ x ∈ (Ioo a b), (deriv g) x ≠ 0)
  (hfa : f a = 0) (hga : g a = 0)
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) (nhds_within a (Ioi a)) l) :
  tendsto (λ x, (f x) / (g x)) (nhds_within a (Ioi a)) l :=
begin
  refine lhopital_zero_right_on_Ioo hab hdf hg' _ _ hdiv,
  { rw [← hfa, ← nhds_within_Ioo_eq_nhds_within_Ioi hab],
    exact ((hcf a $ left_mem_Ico.mpr hab).mono Ioo_subset_Ico_self).tendsto },
  { rw [← hga, ← nhds_within_Ioo_eq_nhds_within_Ioi hab],
    exact ((hcg a $ left_mem_Ico.mpr hab).mono Ioo_subset_Ico_self).tendsto },
end

theorem lhopital_zero_left_on_Ioo
  (hdf : differentiable_on ℝ f (Ioo a b))
  (hg' : ∀ x ∈ (Ioo a b), (deriv g) x ≠ 0)
  (hfb : tendsto f (nhds_within b (Iio b)) (𝓝 0)) (hgb : tendsto g (nhds_within b (Iio b)) (𝓝 0))
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) (nhds_within b (Iio b)) l) :
  tendsto (λ x, (f x) / (g x)) (nhds_within b (Iio b)) l :=
begin
  have hdf : ∀ x ∈ Ioo a b, differentiable_at ℝ f x,
    from λ x hx, (hdf x hx).differentiable_at (Ioo_mem_nhds hx.1 hx.2),
  have hdg : ∀ x ∈ Ioo a b, differentiable_at ℝ g x,
    from λ x hx, classical.by_contradiction (λ h, hg' x hx (deriv_zero_of_not_differentiable_at h)),
  exact has_deriv_at.lhopital_zero_left_on_Ioo hab (λ x hx, (hdf x hx).has_deriv_at)
    (λ x hx, (hdg x hx).has_deriv_at) hg' hfb hgb hdiv
end

omit hab

theorem lhopital_zero_at_top_on_Ioi
  (hdf : differentiable_on ℝ f (Ioi a))
  (hg' : ∀ x ∈ (Ioi a), (deriv g) x ≠ 0)
  (hftop : tendsto f at_top (𝓝 0)) (hgtop : tendsto g at_top (𝓝 0))
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) at_top l) :
  tendsto (λ x, (f x) / (g x)) at_top l :=
begin
  have hdf : ∀ x ∈ Ioi a, differentiable_at ℝ f x,
    from λ x hx, (hdf x hx).differentiable_at (Ioi_mem_nhds hx),
  have hdg : ∀ x ∈ Ioi a, differentiable_at ℝ g x,
    from λ x hx, classical.by_contradiction (λ h, hg' x hx (deriv_zero_of_not_differentiable_at h)),
  exact has_deriv_at.lhopital_zero_at_top_on_Ioi (λ x hx, (hdf x hx).has_deriv_at)
    (λ x hx, (hdg x hx).has_deriv_at) hg' hftop hgtop hdiv,
end

theorem lhopital_zero_at_bot_on_Iio
  (hdf : differentiable_on ℝ f (Iio a))
  (hg' : ∀ x ∈ (Iio a), (deriv g) x ≠ 0)
  (hfbot : tendsto f at_bot (𝓝 0)) (hgbot : tendsto g at_bot (𝓝 0))
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) at_bot l) :
  tendsto (λ x, (f x) / (g x)) at_bot l :=
begin
  have hdf : ∀ x ∈ Iio a, differentiable_at ℝ f x,
    from λ x hx, (hdf x hx).differentiable_at (Iio_mem_nhds hx),
  have hdg : ∀ x ∈ Iio a, differentiable_at ℝ g x,
    from λ x hx, classical.by_contradiction (λ h, hg' x hx (deriv_zero_of_not_differentiable_at h)),
  exact has_deriv_at.lhopital_zero_at_bot_on_Iio (λ x hx, (hdf x hx).has_deriv_at)
    (λ x hx, (hdg x hx).has_deriv_at) hg' hfbot hgbot hdiv,
end

end deriv

/-!
## Generic versions

The following statements no longer any explicit interval, as they only require
conditions holding eventually.
-/

namespace has_deriv_at

/-- L'Hôpital's rule for approaching a real from the right, `has_deriv_at` version -/
theorem lhopital_zero_nhds_right
  (hff' : ∀ᶠ x in 𝓝[>] a, has_deriv_at f (f' x) x)
  (hgg' : ∀ᶠ x in 𝓝[>] a, has_deriv_at g (g' x) x)
  (hg' : ∀ᶠ x in 𝓝[>] a, g' x ≠ 0)
  (hfa : tendsto f (𝓝[>] a) (𝓝 0)) (hga : tendsto g (𝓝[>] a) (𝓝 0))
  (hdiv : tendsto (λ x, (f' x) / (g' x)) (𝓝[>] a) l) :
  tendsto (λ x, (f x) / (g x)) (𝓝[>] a) l :=
begin
  rw eventually_iff_exists_mem at *,
  rcases hff' with ⟨s₁, hs₁, hff'⟩,
  rcases hgg' with ⟨s₂, hs₂, hgg'⟩,
  rcases hg' with ⟨s₃, hs₃, hg'⟩,
  let s := s₁ ∩ s₂ ∩ s₃,
  have hs : s ∈ 𝓝[>] a := inter_mem (inter_mem hs₁ hs₂) hs₃,
  rw mem_nhds_within_Ioi_iff_exists_Ioo_subset at hs,
  rcases hs with ⟨u, hau, hu⟩,
  refine lhopital_zero_right_on_Ioo hau _ _ _ hfa hga hdiv;
  intros x hx;
  apply_assumption;
  exact (hu hx).1.1 <|> exact (hu hx).1.2 <|> exact (hu hx).2
end

/-- L'Hôpital's rule for approaching a real from the left, `has_deriv_at` version -/
theorem lhopital_zero_nhds_left
  (hff' : ∀ᶠ x in 𝓝[<] a, has_deriv_at f (f' x) x)
  (hgg' : ∀ᶠ x in 𝓝[<] a, has_deriv_at g (g' x) x)
  (hg' : ∀ᶠ x in 𝓝[<] a, g' x ≠ 0)
  (hfa : tendsto f (𝓝[<] a) (𝓝 0)) (hga : tendsto g (𝓝[<] a) (𝓝 0))
  (hdiv : tendsto (λ x, (f' x) / (g' x)) (𝓝[<] a) l) :
  tendsto (λ x, (f x) / (g x)) (𝓝[<] a) l :=
begin
  rw eventually_iff_exists_mem at *,
  rcases hff' with ⟨s₁, hs₁, hff'⟩,
  rcases hgg' with ⟨s₂, hs₂, hgg'⟩,
  rcases hg' with ⟨s₃, hs₃, hg'⟩,
  let s := s₁ ∩ s₂ ∩ s₃,
  have hs : s ∈ 𝓝[<] a := inter_mem (inter_mem hs₁ hs₂) hs₃,
  rw mem_nhds_within_Iio_iff_exists_Ioo_subset at hs,
  rcases hs with ⟨l, hal, hl⟩,
  refine lhopital_zero_left_on_Ioo hal _ _ _ hfa hga hdiv;
  intros x hx;
  apply_assumption;
  exact (hl hx).1.1 <|> exact (hl hx).1.2 <|> exact (hl hx).2
end

/-- L'Hôpital's rule for approaching a real, `has_deriv_at` version. This
  does not require anything about the situation at `a` -/
theorem lhopital_zero_nhds'
  (hff' : ∀ᶠ x in 𝓝[univ \ {a}] a, has_deriv_at f (f' x) x)
  (hgg' : ∀ᶠ x in 𝓝[univ \ {a}] a, has_deriv_at g (g' x) x)
  (hg' : ∀ᶠ x in 𝓝[univ \ {a}] a, g' x ≠ 0)
  (hfa : tendsto f (𝓝[univ \ {a}] a) (𝓝 0)) (hga : tendsto g (𝓝[univ \ {a}] a) (𝓝 0))
  (hdiv : tendsto (λ x, (f' x) / (g' x)) (𝓝[univ \ {a}] a) l) :
  tendsto (λ x, (f x) / (g x)) (𝓝[univ \ {a}] a) l :=
begin
  have : univ \ {a} = Iio a ∪ Ioi a,
  { ext, rw [mem_diff_singleton, eq_true_intro $ mem_univ x, true_and, ne_iff_lt_or_gt], refl },
  simp only [this, nhds_within_union, tendsto_sup, eventually_sup] at *,
  exact ⟨lhopital_zero_nhds_left hff'.1 hgg'.1 hg'.1 hfa.1 hga.1 hdiv.1,
          lhopital_zero_nhds_right hff'.2 hgg'.2 hg'.2 hfa.2 hga.2 hdiv.2⟩
end

/-- **L'Hôpital's rule** for approaching a real, `has_deriv_at` version -/
theorem lhopital_zero_nhds
  (hff' : ∀ᶠ x in 𝓝 a, has_deriv_at f (f' x) x)
  (hgg' : ∀ᶠ x in 𝓝 a, has_deriv_at g (g' x) x)
  (hg' : ∀ᶠ x in 𝓝 a, g' x ≠ 0)
  (hfa : tendsto f (𝓝 a) (𝓝 0)) (hga : tendsto g (𝓝 a) (𝓝 0))
  (hdiv : tendsto (λ x, f' x / g' x) (𝓝 a) l) :
  tendsto (λ x, f x / g x) (𝓝[univ \ {a}] a) l :=
begin
  apply @lhopital_zero_nhds' _ _ _ f' _ g';
  apply eventually_nhds_within_of_eventually_nhds <|> apply tendsto_nhds_within_of_tendsto_nhds;
  assumption
end

/-- L'Hôpital's rule for approaching +∞, `has_deriv_at` version -/
theorem lhopital_zero_at_top
  (hff' : ∀ᶠ x in at_top, has_deriv_at f (f' x) x)
  (hgg' : ∀ᶠ x in at_top, has_deriv_at g (g' x) x)
  (hg' : ∀ᶠ x in at_top, g' x ≠ 0)
  (hftop : tendsto f at_top (𝓝 0)) (hgtop : tendsto g at_top (𝓝 0))
  (hdiv : tendsto (λ x, (f' x) / (g' x)) at_top l) :
  tendsto (λ x, (f x) / (g x)) at_top l :=
begin
  rw eventually_iff_exists_mem at *,
  rcases hff' with ⟨s₁, hs₁, hff'⟩,
  rcases hgg' with ⟨s₂, hs₂, hgg'⟩,
  rcases hg' with ⟨s₃, hs₃, hg'⟩,
  let s := s₁ ∩ s₂ ∩ s₃,
  have hs : s ∈ at_top := inter_mem (inter_mem hs₁ hs₂) hs₃,
  rw mem_at_top_sets at hs,
  rcases hs with ⟨l, hl⟩,
  have hl' : Ioi l ⊆ s := λ x hx, hl x (le_of_lt hx),
  refine lhopital_zero_at_top_on_Ioi _ _ (λ x hx, hg' x $ (hl' hx).2) hftop hgtop hdiv;
  intros x hx;
  apply_assumption;
  exact (hl' hx).1.1 <|> exact (hl' hx).1.2
end

/-- L'Hôpital's rule for approaching -∞, `has_deriv_at` version -/
theorem lhopital_zero_at_bot
  (hff' : ∀ᶠ x in at_bot, has_deriv_at f (f' x) x)
  (hgg' : ∀ᶠ x in at_bot, has_deriv_at g (g' x) x)
  (hg' : ∀ᶠ x in at_bot, g' x ≠ 0)
  (hfbot : tendsto f at_bot (𝓝 0)) (hgbot : tendsto g at_bot (𝓝 0))
  (hdiv : tendsto (λ x, (f' x) / (g' x)) at_bot l) :
  tendsto (λ x, (f x) / (g x)) at_bot l :=
begin
  rw eventually_iff_exists_mem at *,
  rcases hff' with ⟨s₁, hs₁, hff'⟩,
  rcases hgg' with ⟨s₂, hs₂, hgg'⟩,
  rcases hg' with ⟨s₃, hs₃, hg'⟩,
  let s := s₁ ∩ s₂ ∩ s₃,
  have hs : s ∈ at_bot := inter_mem (inter_mem hs₁ hs₂) hs₃,
  rw mem_at_bot_sets at hs,
  rcases hs with ⟨l, hl⟩,
  have hl' : Iio l ⊆ s := λ x hx, hl x (le_of_lt hx),
  refine lhopital_zero_at_bot_on_Iio _ _ (λ x hx, hg' x $ (hl' hx).2) hfbot hgbot hdiv;
  intros x hx;
  apply_assumption;
  exact (hl' hx).1.1 <|> exact (hl' hx).1.2
end

end has_deriv_at

namespace deriv

/-- **L'Hôpital's rule** for approaching a real from the right, `deriv` version -/
theorem lhopital_zero_nhds_right
  (hdf : ∀ᶠ x in 𝓝[>] a, differentiable_at ℝ f x)
  (hg' : ∀ᶠ x in 𝓝[>] a, deriv g x ≠ 0)
  (hfa : tendsto f (𝓝[>] a) (𝓝 0)) (hga : tendsto g (𝓝[>] a) (𝓝 0))
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) (𝓝[>] a) l) :
  tendsto (λ x, (f x) / (g x)) (𝓝[>] a) l :=
begin
  have hdg : ∀ᶠ x in 𝓝[>] a, differentiable_at ℝ g x,
    from hg'.mp (eventually_of_forall $
      λ _ hg', classical.by_contradiction (λ h, hg' (deriv_zero_of_not_differentiable_at h))),
  have hdf' : ∀ᶠ x in 𝓝[>] a, has_deriv_at f (deriv f x) x,
    from hdf.mp (eventually_of_forall $ λ _, differentiable_at.has_deriv_at),
  have hdg' : ∀ᶠ x in 𝓝[>] a, has_deriv_at g (deriv g x) x,
    from hdg.mp (eventually_of_forall $ λ _, differentiable_at.has_deriv_at),
  exact has_deriv_at.lhopital_zero_nhds_right hdf' hdg' hg' hfa hga hdiv
end

/-- **L'Hôpital's rule** for approaching a real from the left, `deriv` version -/
theorem lhopital_zero_nhds_left
  (hdf : ∀ᶠ x in 𝓝[<] a, differentiable_at ℝ f x)
  (hg' : ∀ᶠ x in 𝓝[<] a, deriv g x ≠ 0)
  (hfa : tendsto f (𝓝[<] a) (𝓝 0)) (hga : tendsto g (𝓝[<] a) (𝓝 0))
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) (𝓝[<] a) l) :
  tendsto (λ x, (f x) / (g x)) (𝓝[<] a) l :=
begin
  have hdg : ∀ᶠ x in 𝓝[<] a, differentiable_at ℝ g x,
    from hg'.mp (eventually_of_forall $
      λ _ hg', classical.by_contradiction (λ h, hg' (deriv_zero_of_not_differentiable_at h))),
  have hdf' : ∀ᶠ x in 𝓝[<] a, has_deriv_at f (deriv f x) x,
    from hdf.mp (eventually_of_forall $ λ _, differentiable_at.has_deriv_at),
  have hdg' : ∀ᶠ x in 𝓝[<] a, has_deriv_at g (deriv g x) x,
    from hdg.mp (eventually_of_forall $ λ _, differentiable_at.has_deriv_at),
  exact has_deriv_at.lhopital_zero_nhds_left hdf' hdg' hg' hfa hga hdiv
end

/-- **L'Hôpital's rule** for approaching a real, `deriv` version. This
  does not require anything about the situation at `a` -/
theorem lhopital_zero_nhds'
  (hdf : ∀ᶠ x in 𝓝[univ \ {a}] a, differentiable_at ℝ f x)
  (hg' : ∀ᶠ x in 𝓝[univ \ {a}] a, deriv g x ≠ 0)
  (hfa : tendsto f (𝓝[univ \ {a}] a) (𝓝 0)) (hga : tendsto g (𝓝[univ \ {a}] a) (𝓝 0))
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) (𝓝[univ \ {a}] a) l) :
  tendsto (λ x, (f x) / (g x)) (𝓝[univ \ {a}] a) l :=
begin
  have : univ \ {a} = Iio a ∪ Ioi a,
  { ext, rw [mem_diff_singleton, eq_true_intro $ mem_univ x, true_and, ne_iff_lt_or_gt], refl },
  simp only [this, nhds_within_union, tendsto_sup, eventually_sup] at *,
  exact ⟨lhopital_zero_nhds_left hdf.1 hg'.1 hfa.1 hga.1 hdiv.1,
          lhopital_zero_nhds_right hdf.2 hg'.2 hfa.2 hga.2 hdiv.2⟩,
end

/-- **L'Hôpital's rule** for approaching a real, `deriv` version -/
theorem lhopital_zero_nhds
  (hdf : ∀ᶠ x in 𝓝 a, differentiable_at ℝ f x)
  (hg' : ∀ᶠ x in 𝓝 a, deriv g x ≠ 0)
  (hfa : tendsto f (𝓝 a) (𝓝 0)) (hga : tendsto g (𝓝 a) (𝓝 0))
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) (𝓝 a) l) :
  tendsto (λ x, (f x) / (g x)) (𝓝[univ \ {a}] a) l :=
begin
  apply lhopital_zero_nhds';
  apply eventually_nhds_within_of_eventually_nhds <|> apply tendsto_nhds_within_of_tendsto_nhds;
  assumption
end

/-- **L'Hôpital's rule** for approaching +∞, `deriv` version -/
theorem lhopital_zero_at_top
  (hdf : ∀ᶠ (x : ℝ) in at_top, differentiable_at ℝ f x)
  (hg' : ∀ᶠ (x : ℝ) in at_top, deriv g x ≠ 0)
  (hftop : tendsto f at_top (𝓝 0)) (hgtop : tendsto g at_top (𝓝 0))
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) at_top l) :
  tendsto (λ x, (f x) / (g x)) at_top l :=
begin
  have hdg : ∀ᶠ x in at_top, differentiable_at ℝ g x,
    from hg'.mp (eventually_of_forall $
      λ _ hg', classical.by_contradiction (λ h, hg' (deriv_zero_of_not_differentiable_at h))),
  have hdf' : ∀ᶠ x in at_top, has_deriv_at f (deriv f x) x,
    from hdf.mp (eventually_of_forall $ λ _, differentiable_at.has_deriv_at),
  have hdg' : ∀ᶠ x in at_top, has_deriv_at g (deriv g x) x,
    from hdg.mp (eventually_of_forall $ λ _, differentiable_at.has_deriv_at),
  exact has_deriv_at.lhopital_zero_at_top hdf' hdg' hg' hftop hgtop hdiv
end

/-- **L'Hôpital's rule** for approaching -∞, `deriv` version -/
theorem lhopital_zero_at_bot
  (hdf : ∀ᶠ (x : ℝ) in at_bot, differentiable_at ℝ f x)
  (hg' : ∀ᶠ (x : ℝ) in at_bot, deriv g x ≠ 0)
  (hfbot : tendsto f at_bot (𝓝 0)) (hgbot : tendsto g at_bot (𝓝 0))
  (hdiv : tendsto (λ x, ((deriv f) x) / ((deriv g) x)) at_bot l) :
  tendsto (λ x, (f x) / (g x)) at_bot l :=
begin
  have hdg : ∀ᶠ x in at_bot, differentiable_at ℝ g x,
    from hg'.mp (eventually_of_forall $
      λ _ hg', classical.by_contradiction (λ h, hg' (deriv_zero_of_not_differentiable_at h))),
  have hdf' : ∀ᶠ x in at_bot, has_deriv_at f (deriv f x) x,
    from hdf.mp (eventually_of_forall $ λ _, differentiable_at.has_deriv_at),
  have hdg' : ∀ᶠ x in at_bot, has_deriv_at g (deriv g x) x,
    from hdg.mp (eventually_of_forall $ λ _, differentiable_at.has_deriv_at),
  exact has_deriv_at.lhopital_zero_at_bot hdf' hdg' hg' hfbot hgbot hdiv
end

end deriv


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Reid Barton
-/
import category_theory.functor.fully_faithful

/-!
# Induced categories and full subcategories

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

Given a category `D` and a function `F : C → D `from a type `C` to the
objects of `D`, there is an essentially unique way to give `C` a
category structure such that `F` becomes a fully faithful functor,
namely by taking $$ Hom_C(X, Y) = Hom_D(FX, FY) $$. We call this the
category induced from `D` along `F`.

As a special case, if `C` is a subtype of `D`,
this produces the full subcategory of `D` on the objects belonging to `C`.
In general the induced category is equivalent to the full subcategory of `D` on the
image of `F`.

## Implementation notes

It looks odd to make `D` an explicit argument of `induced_category`,
when it is determined by the argument `F` anyways. The reason to make `D`
explicit is in order to control its syntactic form, so that instances
like `induced_category.has_forget₂` (elsewhere) refer to the correct
form of D. This is used to set up several algebraic categories like

  def CommMon : Type (u+1) := induced_category Mon (bundled.map @comm_monoid.to_monoid)
  -- not `induced_category (bundled monoid) (bundled.map @comm_monoid.to_monoid)`,
  -- even though `Mon = bundled monoid`!
-/

namespace category_theory

universes v v₂ u₁ u₂ -- morphism levels before object levels. See note [category_theory universes].

section induced

variables {C : Type u₁} (D : Type u₂) [category.{v} D]
variables (F : C → D)
include F

/--
`induced_category D F`, where `F : C → D`, is a typeclass synonym for `C`,
which provides a category structure so that the morphisms `X ⟶ Y` are the morphisms
in `D` from `F X` to `F Y`.
-/
@[nolint has_nonempty_instance unused_arguments]
def induced_category : Type u₁ := C

variables {D}

instance induced_category.has_coe_to_sort {α : Sort*} [has_coe_to_sort D α] :
  has_coe_to_sort (induced_category D F) α :=
⟨λ c, ↥(F c)⟩

instance induced_category.category : category.{v} (induced_category D F) :=
{ hom  := λ X Y, F X ⟶ F Y,
  id   := λ X, 𝟙 (F X),
  comp := λ _ _ _ f g, f ≫ g }

/--
The forgetful functor from an induced category to the original category,
forgetting the extra data.
-/
@[simps] def induced_functor : induced_category D F ⥤ D :=
{ obj := F, map := λ x y f, f }

instance induced_category.full : full (induced_functor F) :=
{ preimage := λ x y f, f }
instance induced_category.faithful : faithful (induced_functor F) := {}

end induced

section full_subcategory
/- A full subcategory is the special case of an induced category with F = subtype.val. -/

variables {C : Type u₁} [category.{v} C]
variables (Z : C → Prop)

/--
A subtype-like structure for full subcategories. Morphisms just ignore the property. We don't use
actual subtypes since the simp-normal form `↑X` of `X.val` does not work well for full
subcategories.

See <https://stacks.math.columbia.edu/tag/001D>. We do not define 'strictly full' subcategories.
-/
@[ext, nolint has_nonempty_instance] structure full_subcategory :=
(obj : C)
(property : Z obj)

instance full_subcategory.category : category.{v} (full_subcategory Z) :=
induced_category.category full_subcategory.obj

/--
The forgetful functor from a full subcategory into the original category
("forgetting" the condition).
-/
def full_subcategory_inclusion : full_subcategory Z ⥤ C :=
induced_functor full_subcategory.obj

@[simp] lemma full_subcategory_inclusion.obj {X} :
  (full_subcategory_inclusion Z).obj X = X.obj := rfl
@[simp] lemma full_subcategory_inclusion.map {X Y} {f : X ⟶ Y} :
  (full_subcategory_inclusion Z).map f = f := rfl

instance full_subcategory.full : full (full_subcategory_inclusion Z) :=
induced_category.full _
instance full_subcategory.faithful : faithful (full_subcategory_inclusion Z) :=
induced_category.faithful _

variables {Z} {Z' : C → Prop}

/-- An implication of predicates `Z → Z'` induces a functor between full subcategories. -/
@[simps]
def full_subcategory.map (h : ∀ ⦃X⦄, Z X → Z' X) : full_subcategory Z ⥤ full_subcategory Z' :=
{ obj := λ X, ⟨X.1, h X.2⟩,
  map := λ X Y f, f }

instance (h : ∀ ⦃X⦄, Z X → Z' X) : full (full_subcategory.map h) :=
{ preimage := λ X Y f, f }

instance (h : ∀ ⦃X⦄, Z X → Z' X) : faithful (full_subcategory.map h) := {}

@[simp] lemma full_subcategory.map_inclusion (h : ∀ ⦃X⦄, Z X → Z' X) :
  full_subcategory.map h ⋙ full_subcategory_inclusion Z' = full_subcategory_inclusion Z :=
rfl

section lift
variables {D : Type u₂} [category.{v₂} D] (P Q : D → Prop)

/-- A functor which maps objects to objects satisfying a certain property induces a lift through
    the full subcategory of objects satisfying that property. -/
@[simps]
def full_subcategory.lift (F : C ⥤ D) (hF : ∀ X, P (F.obj X)) : C ⥤ full_subcategory P :=
{ obj := λ X, ⟨F.obj X, hF X⟩,
  map := λ X Y f, F.map f }

/-- Composing the lift of a functor through a full subcategory with the inclusion yields the
    original functor. Unfortunately, this is not true by definition, so we only get a natural
    isomorphism, but it is pointwise definitionally true, see
    `full_subcategory.inclusion_obj_lift_obj` and `full_subcategory.inclusion_map_lift_map`. -/
def full_subcategory.lift_comp_inclusion (F : C ⥤ D) (hF : ∀ X, P (F.obj X)) :
  full_subcategory.lift P F hF ⋙ full_subcategory_inclusion P ≅ F :=
nat_iso.of_components (λ X, iso.refl _) (by simp)

@[simp]
lemma full_subcategory.inclusion_obj_lift_obj (F : C ⥤ D) (hF : ∀ X, P (F.obj X)) {X : C} :
  (full_subcategory_inclusion P).obj ((full_subcategory.lift P F hF).obj X) = F.obj X :=
rfl

lemma full_subcategory.inclusion_map_lift_map (F : C ⥤ D) (hF : ∀ X, P (F.obj X)) {X Y : C}
  (f : X ⟶ Y) :
  (full_subcategory_inclusion P).map ((full_subcategory.lift P F hF).map f) = F.map f :=
rfl

instance (F : C ⥤ D) (hF : ∀ X, P (F.obj X)) [faithful F] :
  faithful (full_subcategory.lift P F hF) :=
faithful.of_comp_iso (full_subcategory.lift_comp_inclusion P F hF)

instance (F : C ⥤ D) (hF : ∀ X, P (F.obj X)) [full F] : full (full_subcategory.lift P F hF) :=
full.of_comp_faithful_iso (full_subcategory.lift_comp_inclusion P F hF)

@[simp]
lemma full_subcategory.lift_comp_map (F : C ⥤ D) (hF : ∀ X, P (F.obj X)) (h : ∀ ⦃X⦄, P X → Q X) :
  full_subcategory.lift P F hF ⋙ full_subcategory.map h =
    full_subcategory.lift Q F (λ X, h (hF X)) :=
rfl

end lift

end full_subcategory

end category_theory


inductive day : Type
| monday
| tuesday
| wednesday
| thursday
| friday
| saturday
| sunday

def next_weekday : day -> day
| day.monday := day.tuesday
| day.tuesday := day.wednesday
| day.wednesday := day.thursday
| day.thursday := day.friday
| day.friday := day.saturday
| day.saturday := day.sunday
| day.sunday := day.monday

example : next_weekday (next_weekday day.saturday) = day.monday := rfl


/-
Copyright (c) 2020 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.category.default
import Mathlib.data.equiv.functor
import Mathlib.PostPort

universes u₀ u₁ l

namespace Mathlib

/-!
# Functions functorial with respect to equivalences

An `equiv_functor` is a function from `Type → Type` equipped with the additional data of
coherently mapping equivalences to equivalences.

In categorical language, it is an endofunctor of the "core" of the category `Type`.
-/

/--
An `equiv_functor` is only functorial with respect to equivalences.

To construct an `equiv_functor`, it suffices to supply just the function `f α → f β` from
an equivalence `α ≃ β`, and then prove the functor laws. It's then a consequence that
this function is part of an equivalence, provided by `equiv_functor.map_equiv`.
-/
class equiv_functor (f : Type u₀ → Type u₁) where
  map : {α β : Type u₀} → α ≃ β → f α → f β
  map_refl' :
    autoParam (∀ (α : Type u₀), map (equiv.refl α) = id)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])
  map_trans' :
    autoParam (∀ {α β γ : Type u₀} (k : α ≃ β) (h : β ≃ γ), map (equiv.trans k h) = map h ∘ map k)
      (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
        (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])

@[simp] theorem equiv_functor.map_refl {f : Type u₀ → Type u₁} [c : equiv_functor f] (α : Type u₀) :
    equiv_functor.map (equiv.refl α) = id :=
  sorry

theorem equiv_functor.map_trans {f : Type u₀ → Type u₁} [c : equiv_functor f] {α : Type u₀}
    {β : Type u₀} {γ : Type u₀} (k : α ≃ β) (h : β ≃ γ) :
    equiv_functor.map (equiv.trans k h) = equiv_functor.map h ∘ equiv_functor.map k :=
  sorry

namespace equiv_functor

/-- An `equiv_functor` in fact takes every equiv to an equiv. -/
def map_equiv (f : Type u₀ → Type u₁) [equiv_functor f] {α : Type u₀} {β : Type u₀} (e : α ≃ β) :
    f α ≃ f β :=
  equiv.mk (map e) (map (equiv.symm e)) sorry sorry

@[simp] theorem map_equiv_apply (f : Type u₀ → Type u₁) [equiv_functor f] {α : Type u₀}
    {β : Type u₀} (e : α ≃ β) (x : f α) : coe_fn (map_equiv f e) x = map e x :=
  rfl

theorem map_equiv_symm_apply (f : Type u₀ → Type u₁) [equiv_functor f] {α : Type u₀} {β : Type u₀}
    (e : α ≃ β) (y : f β) : coe_fn (equiv.symm (map_equiv f e)) y = map (equiv.symm e) y :=
  rfl

@[simp] theorem map_equiv_refl (f : Type u₀ → Type u₁) [equiv_functor f] (α : Type u₀) :
    map_equiv f (equiv.refl α) = equiv.refl (f α) :=
  sorry

@[simp] theorem map_equiv_symm (f : Type u₀ → Type u₁) [equiv_functor f] {α : Type u₀} {β : Type u₀}
    (e : α ≃ β) : equiv.symm (map_equiv f e) = map_equiv f (equiv.symm e) :=
  equiv.ext (map_equiv_symm_apply f e)

/--
The composition of `map_equiv`s is carried over the `equiv_functor`.
For plain `functor`s, this lemma is named `map_map` when applied
or `map_comp_map` when not applied.
-/
@[simp] theorem map_equiv_trans (f : Type u₀ → Type u₁) [equiv_functor f] {α : Type u₀}
    {β : Type u₀} {γ : Type u₀} (ab : α ≃ β) (bc : β ≃ γ) :
    equiv.trans (map_equiv f ab) (map_equiv f bc) = map_equiv f (equiv.trans ab bc) :=
  sorry

protected instance of_is_lawful_functor (f : Type u₀ → Type u₁) [Functor f] [is_lawful_functor f] :
    equiv_functor f :=
  mk fun (α β : Type u₀) (e : α ≃ β) => Functor.map ⇑e

theorem map_equiv.injective (f : Type u₀ → Type u₁) [Applicative f] [is_lawful_applicative f]
    {α : Type u₀} {β : Type u₀} (h : Type u₀ → function.injective pure) :
    function.injective (map_equiv f) :=
  sorry

end Mathlib


/-
Copyright (c) 2020 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen, Eric Wieser
-/
import data.matrix.basic
import data.fin.vec_notation
import tactic.fin_cases
import algebra.big_operators.fin

/-!
# Matrix and vector notation

This file includes `simp` lemmas for applying operations in `data.matrix.basic` to values built out
of the matrix notation `![a, b] = vec_cons a (vec_cons b vec_empty)` defined in
`data.fin.vec_notation`.

This also provides the new notation `!![a, b; c, d] = matrix.of ![![a, b], ![c, d]]`.
This notation also works for empty matrices; `!![,,,] : matrix (fin 0) (fin 3)` and
`!![;;;] : matrix (fin 3) (fin 0)`.

## Implementation notes

The `simp` lemmas require that one of the arguments is of the form `vec_cons _ _`.
This ensures `simp` works with entries only when (some) entries are already given.
In other words, this notation will only appear in the output of `simp` if it
already appears in the input.

## Notations

This file provide notation `!![a, b; c, d]` for matrices, which corresponds to
`matrix.of ![![a, b], ![c, d]]`.
A parser for `a, b; c, d`-style strings is provided as `matrix.entry_parser`, while
`matrix.notation` provides the hook for the `!!` notation.
Note that in lean 3 the pretty-printer will not show `!!` notation, instead showing the version
with `of ![![...]]`.

## Examples

Examples of usage can be found in the `test/matrix.lean` file.
-/

namespace matrix

universe u
variables {α : Type u} {o n m : ℕ} {m' n' o' : Type*}

open_locale matrix

/-- Matrices can be reflected whenever their entries can. We insert an `@id (matrix m' n' α)` to
prevent immediate decay to a function. -/
meta instance matrix.reflect [reflected_univ.{u}] [reflected_univ.{u_1}] [reflected_univ.{u_2}]
  [reflected _ α] [reflected _ m'] [reflected _ n']
  [h : has_reflect (m' → n' → α)] : has_reflect (matrix m' n' α) :=
λ m, (by reflect_name : reflected _ @id.{(max u_1 u_2 u) + 1}).subst₂
  ((by reflect_name : reflected _ @matrix.{u_1 u_2 u}).subst₃ `(_) `(_) `(_)) $
  by { dunfold matrix, exact h m }

section parser
open lean
open lean.parser
open interactive
open interactive.types

/-- Parse the entries of a matrix -/
meta def entry_parser {α : Type} (p : parser α) :
  parser (Σ m n, fin m → fin n → α) :=
do
  -- a list of lists if the matrix has at least one row, or the number of columns if the matrix has
  -- zero rows.
  let p : parser (list (list α) ⊕ ℕ) :=
    (sum.inl <$> (
      (pure [] <* tk ";").repeat_at_least 1 <|> -- empty rows
      (sep_by_trailing (tk ";") $ sep_by_trailing (tk ",") p)) <|>
    (sum.inr <$> list.length <$> many (tk ","))), -- empty columns
  which ← p,
  match which with
  | (sum.inl l) := do
    h :: tl ← pure l,
    let n := h.length,
    l : list (vector α n) ← l.mmap (λ row,
      if h : row.length = n then
        pure (⟨row, h⟩ : vector α n)
      else
        interaction_monad.fail "Rows must be of equal length"),
    pure ⟨l.length, n, λ i j, (l.nth_le _ i.prop).nth j⟩
  | (sum.inr n) :=
    pure ⟨0, n, fin_zero_elim⟩
  end

-- Lean can't find this instance without some help. We only need it available in `Type 0`, and it is
-- a massive amount of effort to make it universe-polymorphic.
@[instance] meta def sigma_sigma_fin_matrix_has_reflect {α : Type}
  [has_reflect α] [reflected _ α] :
  has_reflect (Σ (m n : ℕ), fin m → fin n → α) :=
@sigma.reflect.{0 0} _ _ ℕ (λ m, Σ n, fin m → fin n → α) _ _ _ $ λ i,
  @sigma.reflect.{0 0} _ _ ℕ _ _ _ _ (λ j, infer_instance)

/-- `!![a, b; c, d]` notation for matrices indexed by `fin m` and `fin n`. See the module docstring
for details. -/
@[user_notation]
meta def «notation» (_ : parse $ tk "!![")
  (val : parse (entry_parser (parser.pexpr 1) <* tk "]")) : parser pexpr :=
do
  let ⟨m, n, entries⟩ := val,
  let entry_vals := pi_fin.to_pexpr (pi_fin.to_pexpr ∘ entries),
  pure (``(@matrix.of (fin %%`(m)) (fin %%`(n)) _).app entry_vals)

end parser

variables (a b : ℕ)

/-- Use `![...]` notation for displaying a `fin`-indexed matrix, for example:

```
#eval !![1, 2; 3, 4] + !![3, 4; 5, 6]  -- !![4, 6; 8, 10]
```
-/
instance [has_repr α] : has_repr (matrix (fin m) (fin n) α) :=
{ repr := λ f,
  "!![" ++ (string.intercalate "; " $ (list.fin_range m).map $ λ i,
    string.intercalate ", " $ (list.fin_range n).map (λ j, repr (f i j)))  ++ "]" }

@[simp] lemma cons_val' (v : n' → α) (B : fin m → n' → α) (i j) :
  vec_cons v B i j = vec_cons (v j) (λ i, B i j) i :=
by { refine fin.cases _ _ i; simp }

@[simp] lemma head_val' (B : fin m.succ → n' → α) (j : n') :
  vec_head (λ i, B i j) = vec_head B j := rfl

@[simp] lemma tail_val' (B : fin m.succ → n' → α) (j : n') :
  vec_tail (λ i, B i j) = λ i, vec_tail B i j :=
by { ext, simp [vec_tail] }

section dot_product

variables [add_comm_monoid α] [has_mul α]

@[simp] lemma dot_product_empty (v w : fin 0 → α) :
  dot_product v w = 0 := finset.sum_empty

@[simp] lemma cons_dot_product (x : α) (v : fin n → α) (w : fin n.succ → α) :
  dot_product (vec_cons x v) w = x * vec_head w + dot_product v (vec_tail w) :=
by simp [dot_product, fin.sum_univ_succ, vec_head, vec_tail]

@[simp] lemma dot_product_cons (v : fin n.succ → α) (x : α) (w : fin n → α) :
  dot_product v (vec_cons x w) = vec_head v * x + dot_product (vec_tail v) w :=
by simp [dot_product, fin.sum_univ_succ, vec_head, vec_tail]

@[simp] lemma cons_dot_product_cons (x : α) (v : fin n → α) (y : α) (w : fin n → α) :
  dot_product (vec_cons x v) (vec_cons y w) = x * y + dot_product v w :=
by simp

end dot_product

section col_row

@[simp] lemma col_empty (v : fin 0 → α) : col v = vec_empty :=
empty_eq _

@[simp] lemma col_cons (x : α) (u : fin m → α) :
  col (vec_cons x u) = vec_cons (λ _, x) (col u) :=
by { ext i j, refine fin.cases _ _ i; simp [vec_head, vec_tail] }

@[simp] lemma row_empty : row (vec_empty : fin 0 → α) = λ _, vec_empty :=
by { ext, refl }

@[simp] lemma row_cons (x : α) (u : fin m → α) :
  row (vec_cons x u) = λ _, vec_cons x u :=
by { ext, refl }

end col_row

section transpose

@[simp] lemma transpose_empty_rows (A : matrix m' (fin 0) α) : Aᵀ = of ![] := empty_eq _

@[simp] lemma transpose_empty_cols (A : matrix (fin 0) m' α) : Aᵀ = of (λ i, ![]) :=
funext (λ i, empty_eq _)

@[simp] lemma cons_transpose (v : n' → α) (A : matrix (fin m) n' α) :
  (of (vec_cons v A))ᵀ = of (λ i, vec_cons (v i) (Aᵀ i)) :=
by { ext i j, refine fin.cases _ _ j; simp }

@[simp] lemma head_transpose (A : matrix m' (fin n.succ) α) :
  vec_head (of.symm Aᵀ) = vec_head ∘ (of.symm A) :=
rfl

@[simp] lemma tail_transpose (A : matrix m' (fin n.succ) α) :
  vec_tail (of.symm Aᵀ) = (vec_tail ∘ A)ᵀ :=
by { ext i j, refl }

end transpose

section mul

variables [semiring α]

@[simp] lemma empty_mul [fintype n'] (A : matrix (fin 0) n' α) (B : matrix n' o' α) :
  A ⬝ B = of ![] :=
empty_eq _

@[simp] lemma empty_mul_empty (A : matrix m' (fin 0) α) (B : matrix (fin 0) o' α) :
  A ⬝ B = 0 :=
rfl

@[simp] lemma mul_empty [fintype n'] (A : matrix m' n' α) (B : matrix n' (fin 0) α) :
  A ⬝ B = of (λ _, ![]) :=
funext (λ _, empty_eq _)

lemma mul_val_succ [fintype n']
  (A : matrix (fin m.succ) n' α) (B : matrix n' o' α) (i : fin m) (j : o') :
  (A ⬝ B) i.succ j = (of (vec_tail (of.symm A)) ⬝ B) i j := rfl

@[simp] lemma cons_mul [fintype n'] (v : n' → α) (A : fin m → n' → α) (B : matrix n' o' α) :
  of (vec_cons v A) ⬝ B = of (vec_cons (vec_mul v B) (of.symm (of A ⬝ B))) :=
by { ext i j, refine fin.cases _ _ i, { refl },  simp [mul_val_succ], }

end mul

section vec_mul

variables [semiring α]

@[simp] lemma empty_vec_mul (v : fin 0 → α) (B : matrix (fin 0) o' α) :
  vec_mul v B = 0 :=
rfl

@[simp] lemma vec_mul_empty [fintype n'] (v : n' → α) (B : matrix n' (fin 0) α) :
  vec_mul v B = ![] :=
empty_eq _

@[simp] lemma cons_vec_mul (x : α) (v : fin n → α) (B : fin n.succ → o' → α) :
  vec_mul (vec_cons x v) (of B) = x • (vec_head B) + vec_mul v (of $ vec_tail B) :=
by { ext i, simp [vec_mul] }

@[simp] lemma vec_mul_cons (v : fin n.succ → α) (w : o' → α) (B : fin n → o' → α) :
  vec_mul v (of $ vec_cons w B) = vec_head v • w + vec_mul (vec_tail v) (of B) :=
by { ext i, simp [vec_mul] }

@[simp] lemma cons_vec_mul_cons (x : α) (v : fin n → α) (w : o' → α) (B : fin n → o' → α) :
  vec_mul (vec_cons x v) (of $ vec_cons w B) = x • w + vec_mul v (of B) :=
by simp

end vec_mul

section mul_vec

variables [semiring α]

@[simp] lemma empty_mul_vec [fintype n'] (A : matrix (fin 0) n' α) (v : n' → α) :
  mul_vec A v = ![] :=
empty_eq _

@[simp] lemma mul_vec_empty (A : matrix m' (fin 0) α) (v : fin 0 → α) :
  mul_vec A v = 0 :=
rfl

@[simp] lemma cons_mul_vec [fintype n'] (v : n' → α) (A : fin m → n' → α) (w : n' → α) :
  mul_vec (of $ vec_cons v A) w = vec_cons (dot_product v w) (mul_vec (of A) w) :=
by { ext i, refine fin.cases _ _ i; simp [mul_vec] }

@[simp] lemma mul_vec_cons {α} [comm_semiring α] (A : m' → (fin n.succ) → α) (x : α)
  (v : fin n → α) :
  mul_vec (of A) (vec_cons x v) = (x • vec_head ∘ A) + mul_vec (of (vec_tail ∘ A)) v :=
by { ext i, simp [mul_vec, mul_comm] }

end mul_vec

section vec_mul_vec

variables [semiring α]

@[simp] lemma empty_vec_mul_vec (v : fin 0 → α) (w : n' → α) :
  vec_mul_vec v w = ![] :=
empty_eq _

@[simp] lemma vec_mul_vec_empty (v : m' → α) (w : fin 0 → α) :
  vec_mul_vec v w = λ _, ![] :=
funext (λ i, empty_eq _)

@[simp] lemma cons_vec_mul_vec (x : α) (v : fin m → α) (w : n' → α) :
  vec_mul_vec (vec_cons x v) w = vec_cons (x • w) (vec_mul_vec v w) :=
by { ext i, refine fin.cases _ _ i; simp [vec_mul_vec] }

@[simp] lemma vec_mul_vec_cons (v : m' → α) (x : α) (w : fin n → α) :
  vec_mul_vec v (vec_cons x w) = λ i, v i • vec_cons x w :=
by { ext i j, rw [vec_mul_vec_apply, pi.smul_apply, smul_eq_mul] }

end vec_mul_vec

section smul

variables [semiring α]

@[simp] lemma smul_mat_empty {m' : Type*} (x : α) (A : fin 0 → m' → α) : x • A = ![] := empty_eq _

@[simp] lemma smul_mat_cons (x : α) (v : n' → α) (A : fin m → n' → α) :
  x • vec_cons v A = vec_cons (x • v) (x • A) :=
by { ext i, refine fin.cases _ _ i; simp }

end smul

section submatrix

@[simp] lemma submatrix_empty (A : matrix m' n' α) (row : fin 0 → m') (col : o' → n') :
  submatrix A row col = ![] :=
empty_eq _

@[simp]

end submatrix

section vec2_and_vec3

section one

variables [has_zero α] [has_one α]

lemma one_fin_two : (1 : matrix (fin 2) (fin 2) α) = !![1, 0; 0, 1] :=
by { ext i j, fin_cases i; fin_cases j; refl }

lemma one_fin_three : (1 : matrix (fin 3) (fin 3) α) = !![1, 0, 0; 0, 1, 0; 0, 0, 1] :=
by { ext i j, fin_cases i; fin_cases j; refl }

end one

lemma eta_fin_two (A : matrix (fin 2) (fin 2) α) : A = !![A 0 0, A 0 1; A 1 0, A 1 1] :=
by { ext i j, fin_cases i; fin_cases j; refl }

lemma eta_fin_three (A : matrix (fin 3) (fin 3) α) :
  A = !![A 0 0, A 0 1, A 0 2;
         A 1 0, A 1 1, A 1 2;
         A 2 0, A 2 1, A 2 2] :=
by { ext i j, fin_cases i; fin_cases j; refl }

lemma mul_fin_two [add_comm_monoid α] [has_mul α] (a₁₁ a₁₂ a₂₁ a₂₂ b₁₁ b₁₂ b₂₁ b₂₂ : α) :
  !![a₁₁, a₁₂;
     a₂₁, a₂₂] ⬝ !![b₁₁, b₁₂;
                    b₂₁, b₂₂] = !![a₁₁ * b₁₁ + a₁₂ * b₂₁, a₁₁ * b₁₂ + a₁₂ * b₂₂;
                                   a₂₁ * b₁₁ + a₂₂ * b₂₁, a₂₁ * b₁₂ + a₂₂ * b₂₂] :=
begin
  ext i j,
  fin_cases i; fin_cases j; simp [matrix.mul, dot_product, fin.sum_univ_succ]
end

lemma mul_fin_three [add_comm_monoid α] [has_mul α]
  (a₁₁ a₁₂ a₁₃ a₂₁ a₂₂ a₂₃ a₃₁ a₃₂ a₃₃ b₁₁ b₁₂ b₁₃ b₂₁ b₂₂ b₂₃ b₃₁ b₃₂ b₃₃ : α) :
  !![a₁₁, a₁₂, a₁₃;
     a₂₁, a₂₂, a₂₃;
     a₃₁, a₃₂, a₃₃] ⬝ !![b₁₁, b₁₂, b₁₃;
                         b₂₁, b₂₂, b₂₃;
                         b₃₁, b₃₂, b₃₃] =
  !![a₁₁*b₁₁ + a₁₂*b₂₁ + a₁₃*b₃₁, a₁₁*b₁₂ + a₁₂*b₂₂ + a₁₃*b₃₂, a₁₁*b₁₃ + a₁₂*b₂₃ + a₁₃*b₃₃;
     a₂₁*b₁₁ + a₂₂*b₂₁ + a₂₃*b₃₁, a₂₁*b₁₂ + a₂₂*b₂₂ + a₂₃*b₃₂, a₂₁*b₁₃ + a₂₂*b₂₃ + a₂₃*b₃₃;
     a₃₁*b₁₁ + a₃₂*b₂₁ + a₃₃*b₃₁, a₃₁*b₁₂ + a₃₂*b₂₂ + a₃₃*b₃₂, a₃₁*b₁₃ + a₃₂*b₂₃ + a₃₃*b₃₃] :=
begin
  ext i j,
  fin_cases i; fin_cases j; simp [matrix.mul, dot_product, fin.sum_univ_succ, ←add_assoc],
end

lemma vec2_eq {a₀ a₁ b₀ b₁ : α} (h₀ : a₀ = b₀) (h₁ : a₁ = b₁) :
  ![a₀, a₁] = ![b₀, b₁] :=
by subst_vars

lemma vec3_eq {a₀ a₁ a₂ b₀ b₁ b₂ : α} (h₀ : a₀ = b₀) (h₁ : a₁ = b₁) (h₂ : a₂ = b₂) :
  ![a₀, a₁, a₂] = ![b₀, b₁, b₂] :=
by subst_vars

lemma vec2_add [has_add α] (a₀ a₁ b₀ b₁ : α) :
  ![a₀, a₁] + ![b₀, b₁] = ![a₀ + b₀, a₁ + b₁] :=
by rw [cons_add_cons, cons_add_cons, empty_add_empty]

lemma vec3_add [has_add α] (a₀ a₁ a₂ b₀ b₁ b₂ : α) :
  ![a₀, a₁, a₂] + ![b₀, b₁, b₂] = ![a₀ + b₀, a₁ + b₁, a₂ + b₂] :=
by rw [cons_add_cons, cons_add_cons, cons_add_cons, empty_add_empty]

lemma smul_vec2 {R : Type*} [has_smul R α] (x : R) (a₀ a₁ : α) :
  x • ![a₀, a₁] = ![x • a₀, x • a₁] :=
by rw [smul_cons, smul_cons, smul_empty]

lemma smul_vec3 {R : Type*} [has_smul R α] (x : R) (a₀ a₁ a₂ : α) :
  x • ![a₀, a₁, a₂] = ![x • a₀, x • a₁, x • a₂] :=
by rw [smul_cons, smul_cons, smul_cons, smul_empty]

variables [add_comm_monoid α] [has_mul α]

lemma vec2_dot_product' {a₀ a₁ b₀ b₁ : α} :
  ![a₀, a₁] ⬝ᵥ ![b₀, b₁] = a₀ * b₀ + a₁ * b₁ :=
by rw [cons_dot_product_cons, cons_dot_product_cons, dot_product_empty, add_zero]

@[simp] lemma vec2_dot_product (v w : fin 2 → α) :
  v ⬝ᵥ w = v 0 * w 0 + v 1 * w 1 :=
vec2_dot_product'

lemma vec3_dot_product' {a₀ a₁ a₂ b₀ b₁ b₂ : α} :
  ![a₀, a₁, a₂] ⬝ᵥ ![b₀, b₁, b₂] = a₀ * b₀ + a₁ * b₁ + a₂ * b₂ :=
by rw [cons_dot_product_cons, cons_dot_product_cons, cons_dot_product_cons,
       dot_product_empty, add_zero, add_assoc]

@[simp] lemma vec3_dot_product (v w : fin 3 → α) :
  v ⬝ᵥ w = v 0 * w 0 + v 1 * w 1 + v 2 * w 2 :=
vec3_dot_product'

end vec2_and_vec3

end matrix