/-
Copyright (c) 2020 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Myers
-/
import linear_algebra.affine_space.affine_equiv

/-!
# Affine spaces

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

This file defines affine subspaces (over modules) and the affine span of a set of points.

## Main definitions

* `affine_subspace k P` is the type of affine subspaces.  Unlike
  affine spaces, affine subspaces are allowed to be empty, and lemmas
  that do not apply to empty affine subspaces have `nonempty`
  hypotheses.  There is a `complete_lattice` structure on affine
  subspaces.
* `affine_subspace.direction` gives the `submodule` spanned by the
  pairwise differences of points in an `affine_subspace`.  There are
  various lemmas relating to the set of vectors in the `direction`,
  and relating the lattice structure on affine subspaces to that on
  their directions.
* `affine_subspace.parallel`, notation `∥`, gives the property of two affine subspaces being
  parallel (one being a translate of the other).
* `affine_span` gives the affine subspace spanned by a set of points,
  with `vector_span` giving its direction.  `affine_span` is defined
  in terms of `span_points`, which gives an explicit description of
  the points contained in the affine span; `span_points` itself should
  generally only be used when that description is required, with
  `affine_span` being the main definition for other purposes.  Two
  other descriptions of the affine span are proved equivalent: it is
  the `Inf` of affine subspaces containing the points, and (if
  `[nontrivial k]`) it contains exactly those points that are affine
  combinations of points in the given set.

## Implementation notes

`out_param` is used in the definiton 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
-/

noncomputable theory
open_locale big_operators affine

open set

section

variables (k : Type*) {V : Type*} {P : Type*} [ring k] [add_comm_group V] [module k V]
variables [affine_space V P]
include V

/-- The submodule spanning the differences of a (possibly empty) set
of points. -/
def vector_span (s : set P) : submodule k V := submodule.span k (s -ᵥ s)

/-- The definition of `vector_span`, for rewriting. -/
lemma vector_span_def (s : set P) : vector_span k s = submodule.span k (s -ᵥ s) :=
rfl

/-- `vector_span` is monotone. -/
lemma vector_span_mono {s₁ s₂ : set P} (h : s₁ ⊆ s₂) : vector_span k s₁ ≤ vector_span k s₂ :=
submodule.span_mono (vsub_self_mono h)

variables (P)

/-- The `vector_span` of the empty set is `⊥`. -/
@[simp] lemma vector_span_empty : vector_span k (∅ : set P) = (⊥ : submodule k V) :=
by rw [vector_span_def, vsub_empty, submodule.span_empty]

variables {P}

/-- The `vector_span` of a single point is `⊥`. -/
@[simp] lemma vector_span_singleton (p : P) : vector_span k ({p} : set P) = ⊥ :=
by simp [vector_span_def]

/-- The `s -ᵥ s` lies within the `vector_span k s`. -/
lemma vsub_set_subset_vector_span (s : set P) : s -ᵥ s ⊆ ↑(vector_span k s) :=
submodule.subset_span

/-- Each pairwise difference is in the `vector_span`. -/
lemma vsub_mem_vector_span {s : set P} {p1 p2 : P} (hp1 : p1 ∈ s) (hp2 : p2 ∈ s) :
  p1 -ᵥ p2 ∈ vector_span k s :=
vsub_set_subset_vector_span k s (vsub_mem_vsub hp1 hp2)

/-- The points in the affine span of a (possibly empty) set of
points. Use `affine_span` instead to get an `affine_subspace k P`. -/
def span_points (s : set P) : set P :=
{p | ∃ p1 ∈ s, ∃ v ∈ (vector_span k s), p = v +ᵥ p1}

/-- A point in a set is in its affine span. -/
lemma mem_span_points (p : P) (s : set P) : p ∈ s → p ∈ span_points k s
| hp := ⟨p, hp, 0, submodule.zero_mem _, (zero_vadd V p).symm⟩

/-- A set is contained in its `span_points`. -/
lemma subset_span_points (s : set P) : s ⊆ span_points k s :=
λ p, mem_span_points k p s

/-- The `span_points` of a set is nonempty if and only if that set
is. -/
@[simp] lemma span_points_nonempty (s : set P) :
  (span_points k s).nonempty ↔ s.nonempty :=
begin
  split,
  { contrapose,
    rw [set.not_nonempty_iff_eq_empty, set.not_nonempty_iff_eq_empty],
    intro h,
    simp [h, span_points] },
  { exact λ h, h.mono (subset_span_points _ _) }
end

/-- Adding a point in the affine span and a vector in the spanning
submodule produces a point in the affine span. -/
lemma vadd_mem_span_points_of_mem_span_points_of_mem_vector_span {s : set P} {p : P} {v : V}
    (hp : p ∈ span_points k s) (hv : v ∈ vector_span k s) : v +ᵥ p ∈ span_points k s :=
begin
  rcases hp with ⟨p2, ⟨hp2, ⟨v2, ⟨hv2, hv2p⟩⟩⟩⟩,
  rw [hv2p, vadd_vadd],
  use [p2, hp2, v + v2, (vector_span k s).add_mem hv hv2, rfl]
end

/-- Subtracting two points in the affine span produces a vector in the
spanning submodule. -/
lemma vsub_mem_vector_span_of_mem_span_points_of_mem_span_points {s : set P} {p1 p2 : P}
    (hp1 : p1 ∈ span_points k s) (hp2 : p2 ∈ span_points k s) :
  p1 -ᵥ p2 ∈ vector_span k s :=
begin
  rcases hp1 with ⟨p1a, ⟨hp1a, ⟨v1, ⟨hv1, hv1p⟩⟩⟩⟩,
  rcases hp2 with ⟨p2a, ⟨hp2a, ⟨v2, ⟨hv2, hv2p⟩⟩⟩⟩,
  rw [hv1p, hv2p, vsub_vadd_eq_vsub_sub (v1 +ᵥ p1a), vadd_vsub_assoc, add_comm, add_sub_assoc],
  have hv1v2 : v1 - v2 ∈ vector_span k s,
  { rw sub_eq_add_neg,
    apply (vector_span k s).add_mem hv1,
    rw ←neg_one_smul k v2,
    exact (vector_span k s).smul_mem (-1 : k) hv2 },
  refine (vector_span k s).add_mem _ hv1v2,
  exact vsub_mem_vector_span k hp1a hp2a
end

end

/-- An `affine_subspace k P` is a subset of an `affine_space V P`
that, if not empty, has an affine space structure induced by a
corresponding subspace of the `module k V`. -/
structure affine_subspace (k : Type*) {V : Type*} (P : Type*) [ring k] [add_comm_group V]
    [module k V] [affine_space V P] :=
(carrier : set P)
(smul_vsub_vadd_mem : ∀ (c : k) {p1 p2 p3 : P}, p1 ∈ carrier → p2 ∈ carrier → p3 ∈ carrier →
  c • (p1 -ᵥ p2 : V) +ᵥ p3 ∈ carrier)

namespace submodule

variables {k V : Type*} [ring k] [add_comm_group V] [module k V]

/-- Reinterpret `p : submodule k V` as an `affine_subspace k V`. -/
def to_affine_subspace (p : submodule k V) : affine_subspace k V :=
{ carrier := p,
  smul_vsub_vadd_mem := λ c p₁ p₂ p₃ h₁ h₂ h₃, p.add_mem (p.smul_mem _ (p.sub_mem h₁ h₂)) h₃ }

end submodule

namespace affine_subspace

variables (k : Type*) {V : Type*} (P : Type*) [ring k] [add_comm_group V] [module k V]
          [affine_space V P]
include V

instance : set_like (affine_subspace k P) P :=
{ coe := carrier,
  coe_injective' := λ p q _, by cases p; cases q; congr' }

/-- A point is in an affine subspace coerced to a set if and only if
it is in that affine subspace. -/
@[simp] lemma mem_coe (p : P) (s : affine_subspace k P) :
  p ∈ (s : set P) ↔ p ∈ s :=
iff.rfl

variables {k P}

/-- The direction of an affine subspace is the submodule spanned by
the pairwise differences of points.  (Except in the case of an empty
affine subspace, where the direction is the zero submodule, every
vector in the direction is the difference of two points in the affine
subspace.) -/
def direction (s : affine_subspace k P) : submodule k V := vector_span k (s : set P)

/-- The direction equals the `vector_span`. -/
lemma direction_eq_vector_span (s : affine_subspace k P) :
  s.direction = vector_span k (s : set P) :=
rfl

/-- Alternative definition of the direction when the affine subspace
is nonempty.  This is defined so that the order on submodules (as used
in the definition of `submodule.span`) can be used in the proof of
`coe_direction_eq_vsub_set`, and is not intended to be used beyond
that proof. -/
def direction_of_nonempty {s : affine_subspace k P} (h : (s : set P).nonempty) :
  submodule k V :=
{ carrier := (s : set P) -ᵥ s,
  zero_mem' := begin
    cases h with p hp,
    exact (vsub_self p) ▸ vsub_mem_vsub hp hp
  end,
  add_mem' := begin
    intros a b ha hb,
    rcases ha with ⟨p1, p2, hp1, hp2, rfl⟩,
    rcases hb with ⟨p3, p4, hp3, hp4, rfl⟩,
    rw [←vadd_vsub_assoc],
    refine vsub_mem_vsub _ hp4,
    convert s.smul_vsub_vadd_mem 1 hp1 hp2 hp3,
    rw one_smul
  end,
  smul_mem' := begin
    intros c v hv,
    rcases hv with ⟨p1, p2, hp1, hp2, rfl⟩,
    rw [←vadd_vsub (c • (p1 -ᵥ p2)) p2],
    refine vsub_mem_vsub _ hp2,
    exact s.smul_vsub_vadd_mem c hp1 hp2 hp2
  end }

/-- `direction_of_nonempty` gives the same submodule as
`direction`. -/
lemma direction_of_nonempty_eq_direction {s : affine_subspace k P} (h : (s : set P).nonempty) :
  direction_of_nonempty h = s.direction :=
le_antisymm (vsub_set_subset_vector_span k s) (submodule.span_le.2 set.subset.rfl)

/-- The set of vectors in the direction of a nonempty affine subspace
is given by `vsub_set`. -/
lemma coe_direction_eq_vsub_set {s : affine_subspace k P} (h : (s : set P).nonempty) :
  (s.direction : set V) = (s : set P) -ᵥ s :=
direction_of_nonempty_eq_direction h ▸ rfl

/-- A vector is in the direction of a nonempty affine subspace if and
only if it is the subtraction of two vectors in the subspace. -/
lemma mem_direction_iff_eq_vsub {s : affine_subspace k P} (h : (s : set P).nonempty) (v : V) :
  v ∈ s.direction ↔ ∃ p1 ∈ s, ∃ p2 ∈ s, v = p1 -ᵥ p2 :=
begin
  rw [←set_like.mem_coe, coe_direction_eq_vsub_set h],
  exact ⟨λ ⟨p1, p2, hp1, hp2, hv⟩, ⟨p1, hp1, p2, hp2, hv.symm⟩,
         λ ⟨p1, hp1, p2, hp2, hv⟩, ⟨p1, p2, hp1, hp2, hv.symm⟩⟩
end

/-- Adding a vector in the direction to a point in the subspace
produces a point in the subspace. -/
lemma vadd_mem_of_mem_direction {s : affine_subspace k P} {v : V} (hv : v ∈ s.direction) {p : P}
    (hp : p ∈ s) : v +ᵥ p ∈ s :=
begin
  rw mem_direction_iff_eq_vsub ⟨p, hp⟩ at hv,
  rcases hv with ⟨p1, hp1, p2, hp2, hv⟩,
  rw hv,
  convert s.smul_vsub_vadd_mem 1 hp1 hp2 hp,
  rw one_smul
end

/-- Subtracting two points in the subspace produces a vector in the
direction. -/
lemma vsub_mem_direction {s : affine_subspace k P} {p1 p2 : P} (hp1 : p1 ∈ s) (hp2 : p2 ∈ s) :
  (p1 -ᵥ p2) ∈ s.direction :=
vsub_mem_vector_span k hp1 hp2

/-- Adding a vector to a point in a subspace produces a point in the
subspace if and only if the vector is in the direction. -/
lemma vadd_mem_iff_mem_direction {s : affine_subspace k P} (v : V) {p : P} (hp : p ∈ s) :
  v +ᵥ p ∈ s ↔ v ∈ s.direction :=
⟨λ h, by simpa using vsub_mem_direction h hp, λ h, vadd_mem_of_mem_direction h hp⟩

/-- Adding a vector in the direction to a point produces a point in the subspace if and only if
the original point is in the subspace. -/
lemma vadd_mem_iff_mem_of_mem_direction {s : affine_subspace k P} {v : V} (hv : v ∈ s.direction)
  {p : P} : v +ᵥ p ∈ s ↔ p ∈ s :=
begin
  refine ⟨λ h, _, λ h, vadd_mem_of_mem_direction hv h⟩,
  convert vadd_mem_of_mem_direction (submodule.neg_mem _ hv) h,
  simp
end

/-- Given a point in an affine subspace, the set of vectors in its
direction equals the set of vectors subtracting that point on the
right. -/
lemma coe_direction_eq_vsub_set_right {s : affine_subspace k P} {p : P} (hp : p ∈ s) :
  (s.direction : set V) = (-ᵥ p) '' s :=
begin
  rw coe_direction_eq_vsub_set ⟨p, hp⟩,
  refine le_antisymm _ _,
  { rintros v ⟨p1, p2, hp1, hp2, rfl⟩,
    exact ⟨p1 -ᵥ p2 +ᵥ p,
           vadd_mem_of_mem_direction (vsub_mem_direction hp1 hp2) hp,
           (vadd_vsub _ _)⟩ },
  { rintros v ⟨p2, hp2, rfl⟩,
    exact ⟨p2, p, hp2, hp, rfl⟩ }
end

/-- Given a point in an affine subspace, the set of vectors in its
direction equals the set of vectors subtracting that point on the
left. -/
lemma coe_direction_eq_vsub_set_left {s : affine_subspace k P} {p : P} (hp : p ∈ s) :
  (s.direction : set V) = (-ᵥ) p '' s :=
begin
  ext v,
  rw [set_like.mem_coe, ←submodule.neg_mem_iff, ←set_like.mem_coe,
      coe_direction_eq_vsub_set_right hp, set.mem_image_iff_bex, set.mem_image_iff_bex],
  conv_lhs { congr, funext, rw [←neg_vsub_eq_vsub_rev, neg_inj] }
end

/-- Given a point in an affine subspace, a vector is in its direction
if and only if it results from subtracting that point on the right. -/
lemma mem_direction_iff_eq_vsub_right {s : affine_subspace k P} {p : P} (hp : p ∈ s) (v : V) :
  v ∈ s.direction ↔ ∃ p2 ∈ s, v = p2 -ᵥ p :=
begin
  rw [←set_like.mem_coe, coe_direction_eq_vsub_set_right hp],
  exact ⟨λ ⟨p2, hp2, hv⟩, ⟨p2, hp2, hv.symm⟩, λ ⟨p2, hp2, hv⟩, ⟨p2, hp2, hv.symm⟩⟩
end

/-- Given a point in an affine subspace, a vector is in its direction
if and only if it results from subtracting that point on the left. -/
lemma mem_direction_iff_eq_vsub_left {s : affine_subspace k P} {p : P} (hp : p ∈ s) (v : V) :
  v ∈ s.direction ↔ ∃ p2 ∈ s, v = p -ᵥ p2 :=
begin
  rw [←set_like.mem_coe, coe_direction_eq_vsub_set_left hp],
  exact ⟨λ ⟨p2, hp2, hv⟩, ⟨p2, hp2, hv.symm⟩, λ ⟨p2, hp2, hv⟩, ⟨p2, hp2, hv.symm⟩⟩
end

/-- Given a point in an affine subspace, a result of subtracting that
point on the right is in the direction if and only if the other point
is in the subspace. -/
lemma vsub_right_mem_direction_iff_mem {s : affine_subspace k P} {p : P} (hp : p ∈ s) (p2 : P) :
  p2 -ᵥ p ∈ s.direction ↔ p2 ∈ s :=
begin
  rw mem_direction_iff_eq_vsub_right hp,
  simp
end

/-- Given a point in an affine subspace, a result of subtracting that
point on the left is in the direction if and only if the other point
is in the subspace. -/
lemma vsub_left_mem_direction_iff_mem {s : affine_subspace k P} {p : P} (hp : p ∈ s) (p2 : P) :
  p -ᵥ p2 ∈ s.direction ↔ p2 ∈ s :=
begin
  rw mem_direction_iff_eq_vsub_left hp,
  simp
end

/-- Two affine subspaces are equal if they have the same points. -/
lemma coe_injective : function.injective (coe : affine_subspace k P → set P) :=
set_like.coe_injective

@[ext] theorem ext {p q : affine_subspace k P} (h : ∀ x, x ∈ p ↔ x ∈ q) : p = q :=
set_like.ext h

@[simp] lemma ext_iff (s₁ s₂ : affine_subspace k P) :
  (s₁ : set P) = s₂ ↔ s₁ = s₂ :=
set_like.ext'_iff.symm

/-- Two affine subspaces with the same direction and nonempty
intersection are equal. -/
lemma ext_of_direction_eq {s1 s2 : affine_subspace k P} (hd : s1.direction = s2.direction)
    (hn : ((s1 : set P) ∩ s2).nonempty) : s1 = s2 :=
begin
  ext p,
  have hq1 := set.mem_of_mem_inter_left hn.some_mem,
  have hq2 := set.mem_of_mem_inter_right hn.some_mem,
  split,
  { intro hp,
    rw ←vsub_vadd p hn.some,
    refine vadd_mem_of_mem_direction _ hq2,
    rw ←hd,
    exact vsub_mem_direction hp hq1 },
  { intro hp,
    rw ←vsub_vadd p hn.some,
    refine vadd_mem_of_mem_direction _ hq1,
    rw hd,
    exact vsub_mem_direction hp hq2 }
end

/-- This is not an instance because it loops with `add_torsor.nonempty`. -/
@[reducible] -- See note [reducible non instances]
def to_add_torsor (s : affine_subspace k P) [nonempty s] : add_torsor s.direction s :=
{ vadd := λ a b, ⟨(a:V) +ᵥ (b:P), vadd_mem_of_mem_direction a.2 b.2⟩,
  zero_vadd := by simp,
  add_vadd := λ a b c, by { ext, apply add_vadd },
  vsub := λ a b, ⟨(a:P) -ᵥ (b:P), (vsub_left_mem_direction_iff_mem a.2 _).mpr b.2 ⟩,
  nonempty := by apply_instance,
  vsub_vadd' := λ a b, by { ext, apply add_torsor.vsub_vadd' },
  vadd_vsub' := λ a b, by { ext, apply add_torsor.vadd_vsub' } }

local attribute [instance] to_add_torsor

@[simp, norm_cast] lemma coe_vsub (s : affine_subspace k P) [nonempty s] (a b : s) :
  ↑(a -ᵥ b) = (a:P) -ᵥ (b:P) :=
rfl

@[simp, norm_cast] lemma coe_vadd (s : affine_subspace k P) [nonempty s] (a : s.direction) (b : s) :
  ↑(a +ᵥ b) = (a:V) +ᵥ (b:P) :=
rfl

/-- Embedding of an affine subspace to the ambient space, as an affine map. -/
protected def subtype (s : affine_subspace k P) [nonempty s] : s →ᵃ[k] P :=
{ to_fun := coe,
  linear := s.direction.subtype,
  map_vadd' := λ p v, rfl }

@[simp] lemma subtype_linear (s : affine_subspace k P) [nonempty s] :
  s.subtype.linear = s.direction.subtype :=
rfl

lemma subtype_apply (s : affine_subspace k P) [nonempty s] (p : s) : s.subtype p = p :=
rfl

@[simp] lemma coe_subtype (s : affine_subspace k P) [nonempty s] : (s.subtype : s → P) = coe :=
rfl

lemma injective_subtype (s : affine_subspace k P) [nonempty s] : function.injective s.subtype :=
subtype.coe_injective

/-- Two affine subspaces with nonempty intersection are equal if and
only if their directions are equal. -/
lemma eq_iff_direction_eq_of_mem {s₁ s₂ : affine_subspace k P} {p : P} (h₁ : p ∈ s₁)
  (h₂ : p ∈ s₂) : s₁ = s₂ ↔ s₁.direction = s₂.direction :=
⟨λ h, h ▸ rfl, λ h, ext_of_direction_eq h ⟨p, h₁, h₂⟩⟩

/-- Construct an affine subspace from a point and a direction. -/
def mk' (p : P) (direction : submodule k V) : affine_subspace k P :=
{ carrier := {q | ∃ v ∈ direction, q = v +ᵥ p},
  smul_vsub_vadd_mem := λ c p1 p2 p3 hp1 hp2 hp3, begin
    rcases hp1 with ⟨v1, hv1, hp1⟩,
    rcases hp2 with ⟨v2, hv2, hp2⟩,
    rcases hp3 with ⟨v3, hv3, hp3⟩,
    use [c • (v1 - v2) + v3,
         direction.add_mem (direction.smul_mem c (direction.sub_mem hv1 hv2)) hv3],
    simp [hp1, hp2, hp3, vadd_vadd]
  end }

/-- An affine subspace constructed from a point and a direction contains
that point. -/
lemma self_mem_mk' (p : P) (direction : submodule k V) :
  p ∈ mk' p direction :=
⟨0, ⟨direction.zero_mem, (zero_vadd _ _).symm⟩⟩

/-- An affine subspace constructed from a point and a direction contains
the result of adding a vector in that direction to that point. -/
lemma vadd_mem_mk' {v : V} (p : P) {direction : submodule k V} (hv : v ∈ direction) :
  v +ᵥ p ∈ mk' p direction :=
⟨v, hv, rfl⟩

/-- An affine subspace constructed from a point and a direction is
nonempty. -/
lemma mk'_nonempty (p : P) (direction : submodule k V) : (mk' p direction : set P).nonempty :=
⟨p, self_mem_mk' p direction⟩

/-- The direction of an affine subspace constructed from a point and a
direction. -/
@[simp] lemma direction_mk' (p : P) (direction : submodule k V) :
  (mk' p direction).direction = direction :=
begin
  ext v,
  rw mem_direction_iff_eq_vsub (mk'_nonempty _ _),
  split,
  { rintros ⟨p1, ⟨v1, hv1, hp1⟩, p2, ⟨v2, hv2, hp2⟩, hv⟩,
    rw [hv, hp1, hp2, vadd_vsub_vadd_cancel_right],
    exact direction.sub_mem  hv1 hv2 },
  { exact λ hv, ⟨v +ᵥ p, vadd_mem_mk' _ hv, p,
                 self_mem_mk' _ _, (vadd_vsub _ _).symm⟩ }
end

/-- A point lies in an affine subspace constructed from another point and a direction if and only
if their difference is in that direction. -/
lemma mem_mk'_iff_vsub_mem {p₁ p₂ : P} {direction : submodule k V} :
  p₂ ∈ mk' p₁ direction ↔ p₂ -ᵥ p₁ ∈ direction :=
begin
  refine ⟨λ h, _, λ h, _⟩,
  { rw ←direction_mk' p₁ direction,
    exact vsub_mem_direction h (self_mem_mk' _ _) },
  { rw ← vsub_vadd p₂ p₁,
    exact vadd_mem_mk' p₁ h }
end

/-- Constructing an affine subspace from a point in a subspace and
that subspace's direction yields the original subspace. -/
@[simp] lemma mk'_eq {s : affine_subspace k P} {p : P} (hp : p ∈ s) : mk' p s.direction = s :=
ext_of_direction_eq (direction_mk' p s.direction)
                    ⟨p, set.mem_inter (self_mem_mk' _ _) hp⟩

/-- If an affine subspace contains a set of points, it contains the
`span_points` of that set. -/
lemma span_points_subset_coe_of_subset_coe {s : set P} {s1 : affine_subspace k P} (h : s ⊆ s1) :
  span_points k s ⊆ s1 :=
begin
  rintros p ⟨p1, hp1, v, hv, hp⟩,
  rw hp,
  have hp1s1 : p1 ∈ (s1 : set P) := set.mem_of_mem_of_subset hp1 h,
  refine vadd_mem_of_mem_direction _ hp1s1,
  have hs : vector_span k s ≤ s1.direction := vector_span_mono k h,
  rw set_like.le_def at hs,
  rw ←set_like.mem_coe,
  exact set.mem_of_mem_of_subset hv hs
end

end affine_subspace

lemma affine_map.line_map_mem
  {k V P : Type*} [ring k] [add_comm_group V] [module k V] [add_torsor V P]
  {Q : affine_subspace k P} {p₀ p₁ : P} (c : k) (h₀ : p₀ ∈ Q) (h₁ : p₁ ∈ Q) :
  affine_map.line_map p₀ p₁ c ∈ Q :=
begin
  rw affine_map.line_map_apply,
  exact Q.smul_vsub_vadd_mem c h₁ h₀ h₀,
end

section affine_span

variables (k : Type*) {V : Type*} {P : Type*} [ring k] [add_comm_group V] [module k V]
          [affine_space V P]
include V

/-- The affine span of a set of points is the smallest affine subspace
containing those points. (Actually defined here in terms of spans in
modules.) -/
def affine_span (s : set P) : affine_subspace k P :=
{ carrier := span_points k s,
  smul_vsub_vadd_mem := λ c p1 p2 p3 hp1 hp2 hp3,
    vadd_mem_span_points_of_mem_span_points_of_mem_vector_span k hp3
      ((vector_span k s).smul_mem c
        (vsub_mem_vector_span_of_mem_span_points_of_mem_span_points k hp1 hp2)) }

/-- The affine span, converted to a set, is `span_points`. -/
@[simp] lemma coe_affine_span (s : set P) :
  (affine_span k s : set P) = span_points k s :=
rfl

/-- A set is contained in its affine span. -/
lemma subset_affine_span (s : set P) : s ⊆ affine_span k s :=
subset_span_points k s

/-- The direction of the affine span is the `vector_span`. -/
lemma direction_affine_span (s : set P) : (affine_span k s).direction = vector_span k s :=
begin
  apply le_antisymm,
  { refine submodule.span_le.2 _,
    rintros v ⟨p1, p3, ⟨p2, hp2, v1, hv1, hp1⟩, ⟨p4, hp4, v2, hv2, hp3⟩, rfl⟩,
    rw [hp1, hp3, vsub_vadd_eq_vsub_sub, vadd_vsub_assoc, set_like.mem_coe],
    exact (vector_span k s).sub_mem ((vector_span k s).add_mem hv1
      (vsub_mem_vector_span k hp2 hp4)) hv2 },
  { exact vector_span_mono k (subset_span_points k s) }
end

/-- A point in a set is in its affine span. -/
lemma mem_affine_span {p : P} {s : set P} (hp : p ∈ s) : p ∈ affine_span k s :=
mem_span_points k p s hp

end affine_span

namespace affine_subspace

variables {k : Type*} {V : Type*} {P : Type*} [ring k] [add_comm_group V] [module k V]
          [S : affine_space V P]
include S

instance : complete_lattice (affine_subspace k P) :=
{ sup := λ s1 s2, affine_span k (s1 ∪ s2),
  le_sup_left := λ s1 s2, set.subset.trans (set.subset_union_left s1 s2)
                                           (subset_span_points k _),
  le_sup_right :=  λ s1 s2, set.subset.trans (set.subset_union_right s1 s2)
                                             (subset_span_points k _),
  sup_le := λ s1 s2 s3 hs1 hs2, span_points_subset_coe_of_subset_coe (set.union_subset hs1 hs2),
  inf := λ s1 s2, mk (s1 ∩ s2)
                     (λ c p1 p2 p3 hp1 hp2 hp3,
                       ⟨s1.smul_vsub_vadd_mem c hp1.1 hp2.1 hp3.1,
                       s2.smul_vsub_vadd_mem c hp1.2 hp2.2 hp3.2⟩),
  inf_le_left := λ _ _, set.inter_subset_left _ _,
  inf_le_right := λ _ _, set.inter_subset_right _ _,
  le_inf := λ _ _ _, set.subset_inter,
  top := { carrier := set.univ,
    smul_vsub_vadd_mem := λ _ _ _ _ _ _ _, set.mem_univ _ },
  le_top := λ _ _ _, set.mem_univ _,
  bot := { carrier := ∅,
    smul_vsub_vadd_mem := λ _ _ _ _, false.elim },
  bot_le := λ _ _, false.elim,
  Sup := λ s, affine_span k (⋃ s' ∈ s, (s' : set P)),
  Inf := λ s, mk (⋂ s' ∈ s, (s' : set P))
                 (λ c p1 p2 p3 hp1 hp2 hp3, set.mem_Inter₂.2 $ λ s2 hs2, begin
                   rw set.mem_Inter₂ at *,
                   exact s2.smul_vsub_vadd_mem c (hp1 s2 hs2) (hp2 s2 hs2) (hp3 s2 hs2)
                 end),
  le_Sup := λ _ _ h, set.subset.trans (set.subset_bUnion_of_mem h) (subset_span_points k _),
  Sup_le := λ _ _ h, span_points_subset_coe_of_subset_coe (set.Union₂_subset h),
  Inf_le := λ _ _, set.bInter_subset_of_mem,
  le_Inf := λ _ _, set.subset_Inter₂,
  .. partial_order.lift (coe : affine_subspace k P → set P) coe_injective }

instance : inhabited (affine_subspace k P) := ⟨⊤⟩

/-- The `≤` order on subspaces is the same as that on the corresponding
sets. -/
lemma le_def (s1 s2 : affine_subspace k P) : s1 ≤ s2 ↔ (s1 : set P) ⊆ s2 :=
iff.rfl

/-- One subspace is less than or equal to another if and only if all
its points are in the second subspace. -/
lemma le_def' (s1 s2 : affine_subspace k P) : s1 ≤ s2 ↔ ∀ p ∈ s1, p ∈ s2 :=
iff.rfl

/-- The `<` order on subspaces is the same as that on the corresponding
sets. -/
lemma lt_def (s1 s2 : affine_subspace k P) : s1 < s2 ↔ (s1 : set P) ⊂ s2 :=
iff.rfl

/-- One subspace is not less than or equal to another if and only if
it has a point not in the second subspace. -/
lemma not_le_iff_exists (s1 s2 : affine_subspace k P) : ¬ s1 ≤ s2 ↔ ∃ p ∈ s1, p ∉ s2 :=
set.not_subset

/-- If a subspace is less than another, there is a point only in the
second. -/
lemma exists_of_lt {s1 s2 : affine_subspace k P} (h : s1 < s2) : ∃ p ∈ s2, p ∉ s1 :=
set.exists_of_ssubset h

/-- A subspace is less than another if and only if it is less than or
equal to the second subspace and there is a point only in the
second. -/
lemma lt_iff_le_and_exists (s1 s2 : affine_subspace k P) : s1 < s2 ↔ s1 ≤ s2 ∧ ∃ p ∈ s2, p ∉ s1 :=
by rw [lt_iff_le_not_le, not_le_iff_exists]

/-- If an affine subspace is nonempty and contained in another with
the same direction, they are equal. -/
lemma eq_of_direction_eq_of_nonempty_of_le {s₁ s₂ : affine_subspace k P}
  (hd : s₁.direction = s₂.direction) (hn : (s₁ : set P).nonempty) (hle : s₁ ≤ s₂) :
  s₁ = s₂ :=
let ⟨p, hp⟩ := hn in ext_of_direction_eq hd ⟨p, hp, hle hp⟩

variables (k V)

/-- The affine span is the `Inf` of subspaces containing the given
points. -/
lemma affine_span_eq_Inf (s : set P) : affine_span k s = Inf {s' | s ⊆ s'} :=
le_antisymm (span_points_subset_coe_of_subset_coe $ set.subset_Inter₂ $ λ _, id)
            (Inf_le (subset_span_points k _))

variables (P)

/-- The Galois insertion formed by `affine_span` and coercion back to
a set. -/
protected def gi : galois_insertion (affine_span k) (coe : affine_subspace k P → set P) :=
{ choice := λ s _, affine_span k s,
  gc := λ s1 s2, ⟨λ h, set.subset.trans (subset_span_points k s1) h,
                       span_points_subset_coe_of_subset_coe⟩,
  le_l_u := λ _, subset_span_points k _,
  choice_eq := λ _ _, rfl }

/-- The span of the empty set is `⊥`. -/
@[simp] lemma span_empty : affine_span k (∅ : set P) = ⊥ :=
(affine_subspace.gi k V P).gc.l_bot

/-- The span of `univ` is `⊤`. -/
@[simp] lemma span_univ : affine_span k (set.univ : set P) = ⊤ :=
eq_top_iff.2 $ subset_span_points k _

variables {k V P}

lemma _root_.affine_span_le {s : set P} {Q : affine_subspace k P} :
  affine_span k s ≤ Q ↔ s ⊆ (Q : set P) :=
(affine_subspace.gi k V P).gc _ _

variables (k V) {P} {p₁ p₂ : P}

/-- The affine span of a single point, coerced to a set, contains just
that point. -/
@[simp] lemma coe_affine_span_singleton (p : P) : (affine_span k ({p} : set P) : set P) = {p} :=
begin
  ext x,
  rw [mem_coe, ←vsub_right_mem_direction_iff_mem (mem_affine_span k (set.mem_singleton p)) _,
      direction_affine_span],
  simp
end

/-- A point is in the affine span of a single point if and only if
they are equal. -/
@[simp] lemma mem_affine_span_singleton : p₁ ∈ affine_span k ({p₂} : set P) ↔ p₁ = p₂ :=
by simp [←mem_coe]

@[simp] lemma preimage_coe_affine_span_singleton (x : P) :
  (coe : affine_span k ({x} : set P) → P) ⁻¹' {x} = univ :=
eq_univ_of_forall $ λ y, (affine_subspace.mem_affine_span_singleton _ _).1 y.2

/-- The span of a union of sets is the sup of their spans. -/
lemma span_union (s t : set P) : affine_span k (s ∪ t) = affine_span k s ⊔ affine_span k t :=
(affine_subspace.gi k V P).gc.l_sup

/-- The span of a union of an indexed family of sets is the sup of
their spans. -/
lemma span_Union {ι : Type*} (s : ι → set P) :
  affine_span k (⋃ i, s i) = ⨆ i, affine_span k (s i) :=
(affine_subspace.gi k V P).gc.l_supr

variables (P)

/-- `⊤`, coerced to a set, is the whole set of points. -/
@[simp] lemma top_coe : ((⊤ : affine_subspace k P) : set P) = set.univ :=
rfl

variables {P}

/-- All points are in `⊤`. -/
lemma mem_top (p : P) : p ∈ (⊤ : affine_subspace k P) :=
set.mem_univ p

variables (P)

/-- The direction of `⊤` is the whole module as a submodule. -/
@[simp] lemma direction_top : (⊤ : affine_subspace k P).direction = ⊤ :=
begin
  cases S.nonempty with p,
  ext v,
  refine ⟨imp_intro submodule.mem_top, λ hv, _⟩,
  have hpv : (v +ᵥ p -ᵥ p : V) ∈ (⊤ : affine_subspace k P).direction :=
    vsub_mem_direction (mem_top k V _) (mem_top k V _),
  rwa vadd_vsub at hpv
end

/-- `⊥`, coerced to a set, is the empty set. -/
@[simp] lemma bot_coe : ((⊥ : affine_subspace k P) : set P) = ∅ :=
rfl

lemma bot_ne_top : (⊥ : affine_subspace k P) ≠ ⊤ :=
begin
  intros contra,
  rw [← ext_iff, bot_coe, top_coe] at contra,
  exact set.empty_ne_univ contra,
end

instance : nontrivial (affine_subspace k P) := ⟨⟨⊥, ⊤, bot_ne_top k V P⟩⟩

lemma nonempty_of_affine_span_eq_top {s : set P} (h : affine_span k s = ⊤) : s.nonempty :=
begin
  rw set.nonempty_iff_ne_empty,
  rintros rfl,
  rw affine_subspace.span_empty at h,
  exact bot_ne_top k V P h,
end

/-- If the affine span of a set is `⊤`, then the vector span of the same set is the `⊤`. -/
lemma vector_span_eq_top_of_affine_span_eq_top {s : set P} (h : affine_span k s = ⊤) :
  vector_span k s = ⊤ :=
by rw [← direction_affine_span, h, direction_top]

/-- For a nonempty set, the affine span is `⊤` iff its vector span is `⊤`. -/
lemma affine_span_eq_top_iff_vector_span_eq_top_of_nonempty {s : set P} (hs : s.nonempty) :
  affine_span k s = ⊤ ↔ vector_span k s = ⊤ :=
begin
  refine ⟨vector_span_eq_top_of_affine_span_eq_top k V P, _⟩,
  intros h,
  suffices : nonempty (affine_span k s),
  { obtain ⟨p, hp : p ∈ affine_span k s⟩ := this,
    rw [eq_iff_direction_eq_of_mem hp (mem_top k V p), direction_affine_span, h, direction_top] },
  obtain ⟨x, hx⟩ := hs,
  exact ⟨⟨x, mem_affine_span k hx⟩⟩,
end

/-- For a non-trivial space, the affine span of a set is `⊤` iff its vector span is `⊤`. -/
lemma affine_span_eq_top_iff_vector_span_eq_top_of_nontrivial {s : set P} [nontrivial P] :
  affine_span k s = ⊤ ↔ vector_span k s = ⊤ :=
begin
  cases s.eq_empty_or_nonempty with hs hs,
  { simp [hs, subsingleton_iff_bot_eq_top, add_torsor.subsingleton_iff V P, not_subsingleton], },
  { rw affine_span_eq_top_iff_vector_span_eq_top_of_nonempty k V P hs, },
end

lemma card_pos_of_affine_span_eq_top {ι : Type*} [fintype ι] {p : ι → P}
  (h : affine_span k (range p) = ⊤) :
  0 < fintype.card ι :=
begin
  obtain ⟨-, ⟨i, -⟩⟩ := nonempty_of_affine_span_eq_top k V P h,
  exact fintype.card_pos_iff.mpr ⟨i⟩,
end

variables {P}

/-- No points are in `⊥`. -/
lemma not_mem_bot (p : P) : p ∉ (⊥ : affine_subspace k P) :=
set.not_mem_empty p

variables (P)

/-- The direction of `⊥` is the submodule `⊥`. -/
@[simp] lemma direction_bot : (⊥ : affine_subspace k P).direction = ⊥ :=
by rw [direction_eq_vector_span, bot_coe, vector_span_def, vsub_empty, submodule.span_empty]

variables {k V P}

@[simp] lemma coe_eq_bot_iff (Q : affine_subspace k P) : (Q : set P) = ∅ ↔ Q = ⊥ :=
coe_injective.eq_iff' (bot_coe _ _ _)

@[simp] lemma coe_eq_univ_iff (Q : affine_subspace k P) : (Q : set P) = univ ↔ Q = ⊤ :=
coe_injective.eq_iff' (top_coe _ _ _)

lemma nonempty_iff_ne_bot (Q : affine_subspace k P) : (Q : set P).nonempty ↔ Q ≠ ⊥ :=
by { rw nonempty_iff_ne_empty, exact not_congr Q.coe_eq_bot_iff }

lemma eq_bot_or_nonempty (Q : affine_subspace k P) : Q = ⊥ ∨ (Q : set P).nonempty :=
by { rw nonempty_iff_ne_bot, apply eq_or_ne }

lemma subsingleton_of_subsingleton_span_eq_top {s : set P} (h₁ : s.subsingleton)
  (h₂ : affine_span k s = ⊤) : subsingleton P :=
begin
  obtain ⟨p, hp⟩ := affine_subspace.nonempty_of_affine_span_eq_top k V P h₂,
  have : s = {p}, { exact subset.antisymm (λ q hq, h₁ hq hp) (by simp [hp]), },
  rw [this, ← affine_subspace.ext_iff, affine_subspace.coe_affine_span_singleton,
    affine_subspace.top_coe, eq_comm, ← subsingleton_iff_singleton (mem_univ _)] at h₂,
  exact subsingleton_of_univ_subsingleton h₂,
end

lemma eq_univ_of_subsingleton_span_eq_top {s : set P} (h₁ : s.subsingleton)
  (h₂ : affine_span k s = ⊤) : s = (univ : set P) :=
begin
  obtain ⟨p, hp⟩ := affine_subspace.nonempty_of_affine_span_eq_top k V P h₂,
  have : s = {p}, { exact subset.antisymm (λ q hq, h₁ hq hp) (by simp [hp]), },
  rw [this, eq_comm, ← subsingleton_iff_singleton (mem_univ p), subsingleton_univ_iff],
  exact subsingleton_of_subsingleton_span_eq_top h₁ h₂,
end

/-- A nonempty affine subspace is `⊤` if and only if its direction is
`⊤`. -/
@[simp] lemma direction_eq_top_iff_of_nonempty {s : affine_subspace k P}
  (h : (s : set P).nonempty) : s.direction = ⊤ ↔ s = ⊤ :=
begin
  split,
  { intro hd,
    rw ←direction_top k V P at hd,
    refine ext_of_direction_eq hd _,
    simp [h] },
  { rintro rfl,
    simp }
end

/-- The inf of two affine subspaces, coerced to a set, is the
intersection of the two sets of points. -/
@[simp] lemma inf_coe (s1 s2 : affine_subspace k P) : ((s1 ⊓ s2) : set P) = s1 ∩ s2 :=
rfl

/-- A point is in the inf of two affine subspaces if and only if it is
in both of them. -/
lemma mem_inf_iff (p : P) (s1 s2 : affine_subspace k P) : p ∈ s1 ⊓ s2 ↔ p ∈ s1 ∧ p ∈ s2 :=
iff.rfl

/-- The direction of the inf of two affine subspaces is less than or
equal to the inf of their directions. -/
lemma direction_inf (s1 s2 : affine_subspace k P) :
  (s1 ⊓ s2).direction ≤ s1.direction ⊓ s2.direction :=
begin
  repeat { rw [direction_eq_vector_span, vector_span_def] },
  exact le_inf
    (Inf_le_Inf (λ p hp, trans (vsub_self_mono (inter_subset_left _ _)) hp))
    (Inf_le_Inf (λ p hp, trans (vsub_self_mono (inter_subset_right _ _)) hp))
end

/-- If two affine subspaces have a point in common, the direction of
their inf equals the inf of their directions. -/
lemma direction_inf_of_mem {s₁ s₂ : affine_subspace k P} {p : P} (h₁ : p ∈ s₁) (h₂ : p ∈ s₂) :
  (s₁ ⊓ s₂).direction = s₁.direction ⊓ s₂.direction :=
begin
  ext v,
  rw [submodule.mem_inf, ←vadd_mem_iff_mem_direction v h₁, ←vadd_mem_iff_mem_direction v h₂,
      ←vadd_mem_iff_mem_direction v ((mem_inf_iff p s₁ s₂).2 ⟨h₁, h₂⟩), mem_inf_iff]
end

/-- If two affine subspaces have a point in their inf, the direction
of their inf equals the inf of their directions. -/
lemma direction_inf_of_mem_inf {s₁ s₂ : affine_subspace k P} {p : P} (h : p ∈ s₁ ⊓ s₂) :
  (s₁ ⊓ s₂).direction = s₁.direction ⊓ s₂.direction :=
direction_inf_of_mem ((mem_inf_iff p s₁ s₂).1 h).1 ((mem_inf_iff p s₁ s₂).1 h).2

/-- If one affine subspace is less than or equal to another, the same
applies to their directions. -/
lemma direction_le {s1 s2 : affine_subspace k P} (h : s1 ≤ s2) : s1.direction ≤ s2.direction :=
begin
  repeat { rw [direction_eq_vector_span, vector_span_def] },
  exact vector_span_mono k h
end

/-- If one nonempty affine subspace is less than another, the same
applies to their directions -/
lemma direction_lt_of_nonempty {s1 s2 : affine_subspace k P} (h : s1 < s2)
    (hn : (s1 : set P).nonempty) : s1.direction < s2.direction :=
begin
  cases hn with p hp,
  rw lt_iff_le_and_exists at h,
  rcases h with ⟨hle, p2, hp2, hp2s1⟩,
  rw set_like.lt_iff_le_and_exists,
  use [direction_le hle, p2 -ᵥ p, vsub_mem_direction hp2 (hle hp)],
  intro hm,
  rw vsub_right_mem_direction_iff_mem hp p2 at hm,
  exact hp2s1 hm
end

/-- The sup of the directions of two affine subspaces is less than or
equal to the direction of their sup. -/
lemma sup_direction_le (s1 s2 : affine_subspace k P) :
  s1.direction ⊔ s2.direction ≤ (s1 ⊔ s2).direction :=
begin
  repeat { rw [direction_eq_vector_span, vector_span_def] },
  exact sup_le
    (Inf_le_Inf (λ p hp, set.subset.trans (vsub_self_mono (le_sup_left : s1 ≤ s1 ⊔ s2)) hp))
    (Inf_le_Inf (λ p hp, set.subset.trans (vsub_self_mono (le_sup_right : s2 ≤ s1 ⊔ s2)) hp))
end

/-- The sup of the directions of two nonempty affine subspaces with
empty intersection is less than the direction of their sup. -/
lemma sup_direction_lt_of_nonempty_of_inter_empty {s1 s2 : affine_subspace k P}
    (h1 : (s1 : set P).nonempty) (h2 : (s2 : set P).nonempty) (he : (s1 ∩ s2 : set P) = ∅) :
  s1.direction ⊔ s2.direction < (s1 ⊔ s2).direction :=
begin
  cases h1 with p1 hp1,
  cases h2 with p2 hp2,
  rw set_like.lt_iff_le_and_exists,
  use [sup_direction_le s1 s2, p2 -ᵥ p1,
       vsub_mem_direction ((le_sup_right : s2 ≤ s1 ⊔ s2) hp2) ((le_sup_left : s1 ≤ s1 ⊔ s2) hp1)],
  intro h,
  rw submodule.mem_sup at h,
  rcases h with ⟨v1, hv1, v2, hv2, hv1v2⟩,
  rw [←sub_eq_zero, sub_eq_add_neg, neg_vsub_eq_vsub_rev, add_comm v1, add_assoc,
      ←vadd_vsub_assoc, ←neg_neg v2, add_comm, ←sub_eq_add_neg, ←vsub_vadd_eq_vsub_sub,
      vsub_eq_zero_iff_eq] at hv1v2,
  refine set.nonempty.ne_empty _ he,
  use [v1 +ᵥ p1, vadd_mem_of_mem_direction hv1 hp1],
  rw hv1v2,
  exact vadd_mem_of_mem_direction (submodule.neg_mem _ hv2) hp2
end

/-- If the directions of two nonempty affine subspaces span the whole
module, they have nonempty intersection. -/
lemma inter_nonempty_of_nonempty_of_sup_direction_eq_top {s1 s2 : affine_subspace k P}
    (h1 : (s1 : set P).nonempty) (h2 : (s2 : set P).nonempty)
    (hd : s1.direction ⊔ s2.direction = ⊤) : ((s1 : set P) ∩ s2).nonempty :=
begin
  by_contradiction h,
  rw set.not_nonempty_iff_eq_empty at h,
  have hlt := sup_direction_lt_of_nonempty_of_inter_empty h1 h2 h,
  rw hd at hlt,
  exact not_top_lt hlt
end

/-- If the directions of two nonempty affine subspaces are complements
of each other, they intersect in exactly one point. -/
lemma inter_eq_singleton_of_nonempty_of_is_compl {s1 s2 : affine_subspace k P}
    (h1 : (s1 : set P).nonempty) (h2 : (s2 : set P).nonempty)
    (hd : is_compl s1.direction s2.direction) : ∃ p, (s1 : set P) ∩ s2 = {p} :=
begin
  cases inter_nonempty_of_nonempty_of_sup_direction_eq_top h1 h2 hd.sup_eq_top with p hp,
  use p,
  ext q,
  rw set.mem_singleton_iff,
  split,
  { rintros ⟨hq1, hq2⟩,
    have hqp : q -ᵥ p ∈ s1.direction ⊓ s2.direction :=
      ⟨vsub_mem_direction hq1 hp.1, vsub_mem_direction hq2 hp.2⟩,
    rwa [hd.inf_eq_bot, submodule.mem_bot, vsub_eq_zero_iff_eq] at hqp },
  { exact λ h, h.symm ▸ hp }
end

/-- Coercing a subspace to a set then taking the affine span produces
the original subspace. -/
@[simp] lemma affine_span_coe (s : affine_subspace k P) : affine_span k (s : set P) = s :=
begin
  refine le_antisymm _ (subset_span_points _ _),
  rintros p ⟨p1, hp1, v, hv, rfl⟩,
  exact vadd_mem_of_mem_direction hv hp1
end

end affine_subspace

section affine_space'

variables (k : Type*) {V : Type*} {P : Type*} [ring k] [add_comm_group V] [module k V]
          [affine_space V P]
variables {ι : Type*}
include V

open affine_subspace set

/-- The `vector_span` is the span of the pairwise subtractions with a
given point on the left. -/
lemma vector_span_eq_span_vsub_set_left {s : set P} {p : P} (hp : p ∈ s) :
  vector_span k s = submodule.span k ((-ᵥ) p '' s) :=
begin
  rw vector_span_def,
  refine le_antisymm _ (submodule.span_mono _),
  { rw submodule.span_le,
    rintros v ⟨p1, p2, hp1, hp2, hv⟩,
    rw ←vsub_sub_vsub_cancel_left p1 p2 p at hv,
    rw [←hv, set_like.mem_coe, submodule.mem_span],
    exact λ m hm, submodule.sub_mem _ (hm ⟨p2, hp2, rfl⟩) (hm ⟨p1, hp1, rfl⟩) },
  { rintros v ⟨p2, hp2, hv⟩,
    exact ⟨p, p2, hp, hp2, hv⟩ }
end

/-- The `vector_span` is the span of the pairwise subtractions with a
given point on the right. -/
lemma vector_span_eq_span_vsub_set_right {s : set P} {p : P} (hp : p ∈ s) :
  vector_span k s = submodule.span k ((-ᵥ p) '' s) :=
begin
  rw vector_span_def,
  refine le_antisymm _ (submodule.span_mono _),
  { rw submodule.span_le,
    rintros v ⟨p1, p2, hp1, hp2, hv⟩,
    rw ←vsub_sub_vsub_cancel_right p1 p2 p at hv,
    rw [←hv, set_like.mem_coe, submodule.mem_span],
    exact λ m hm, submodule.sub_mem _ (hm ⟨p1, hp1, rfl⟩) (hm ⟨p2, hp2, rfl⟩) },
  { rintros v ⟨p2, hp2, hv⟩,
    exact ⟨p2, p, hp2, hp, hv⟩ }
end

/-- The `vector_span` is the span of the pairwise subtractions with a
given point on the left, excluding the subtraction of that point from
itself. -/
lemma vector_span_eq_span_vsub_set_left_ne {s : set P} {p : P} (hp : p ∈ s) :
  vector_span k s = submodule.span k ((-ᵥ) p '' (s \ {p})) :=
begin
  conv_lhs { rw [vector_span_eq_span_vsub_set_left k hp, ←set.insert_eq_of_mem hp,
                 ←set.insert_diff_singleton, set.image_insert_eq] },
  simp [submodule.span_insert_eq_span]
end

/-- The `vector_span` is the span of the pairwise subtractions with a
given point on the right, excluding the subtraction of that point from
itself. -/
lemma vector_span_eq_span_vsub_set_right_ne {s : set P} {p : P} (hp : p ∈ s) :
  vector_span k s = submodule.span k ((-ᵥ p) '' (s \ {p})) :=
begin
  conv_lhs { rw [vector_span_eq_span_vsub_set_right k hp, ←set.insert_eq_of_mem hp,
                 ←set.insert_diff_singleton, set.image_insert_eq] },
  simp [submodule.span_insert_eq_span]
end

/-- The `vector_span` is the span of the pairwise subtractions with a
given point on the right, excluding the subtraction of that point from
itself. -/
lemma vector_span_eq_span_vsub_finset_right_ne [decidable_eq P] [decidable_eq V] {s : finset P}
  {p : P} (hp : p ∈ s) :
  vector_span k (s : set P) = submodule.span k ((s.erase p).image (-ᵥ p)) :=
by simp [vector_span_eq_span_vsub_set_right_ne _ (finset.mem_coe.mpr hp)]

/-- The `vector_span` of the image of a function is the span of the
pairwise subtractions with a given point on the left, excluding the
subtraction of that point from itself. -/
lemma vector_span_image_eq_span_vsub_set_left_ne (p : ι → P) {s : set ι} {i : ι} (hi : i ∈ s) :
  vector_span k (p '' s) = submodule.span k ((-ᵥ) (p i) '' (p '' (s \ {i}))) :=
begin
  conv_lhs { rw [vector_span_eq_span_vsub_set_left k (set.mem_image_of_mem p hi),
                 ←set.insert_eq_of_mem hi, ←set.insert_diff_singleton, set.image_insert_eq,
                 set.image_insert_eq] },
  simp [submodule.span_insert_eq_span]
end

/-- The `vector_span` of the image of a function is the span of the
pairwise subtractions with a given point on the right, excluding the
subtraction of that point from itself. -/
lemma vector_span_image_eq_span_vsub_set_right_ne (p : ι → P) {s : set ι} {i : ι} (hi : i ∈ s) :
  vector_span k (p '' s) = submodule.span k ((-ᵥ (p i)) '' (p '' (s \ {i}))) :=
begin
  conv_lhs { rw [vector_span_eq_span_vsub_set_right k (set.mem_image_of_mem p hi),
                 ←set.insert_eq_of_mem hi, ←set.insert_diff_singleton, set.image_insert_eq,
                 set.image_insert_eq] },
  simp [submodule.span_insert_eq_span]
end

/-- The `vector_span` of an indexed family is the span of the pairwise
subtractions with a given point on the left. -/
lemma vector_span_range_eq_span_range_vsub_left (p : ι → P) (i0 : ι) :
  vector_span k (set.range p) = submodule.span k (set.range (λ (i : ι), p i0 -ᵥ p i)) :=
by rw [vector_span_eq_span_vsub_set_left k (set.mem_range_self i0), ←set.range_comp]

/-- The `vector_span` of an indexed family is the span of the pairwise
subtractions with a given point on the right. -/
lemma vector_span_range_eq_span_range_vsub_right (p : ι → P) (i0 : ι) :
  vector_span k (set.range p) = submodule.span k (set.range (λ (i : ι), p i -ᵥ p i0)) :=
by rw [vector_span_eq_span_vsub_set_right k (set.mem_range_self i0), ←set.range_comp]

/-- The `vector_span` of an indexed family is the span of the pairwise
subtractions with a given point on the left, excluding the subtraction
of that point from itself. -/
lemma vector_span_range_eq_span_range_vsub_left_ne (p : ι → P) (i₀ : ι) :
  vector_span k (set.range p) = submodule.span k (set.range (λ (i : {x // x ≠ i₀}), p i₀ -ᵥ p i)) :=
begin
  rw [←set.image_univ, vector_span_image_eq_span_vsub_set_left_ne k _ (set.mem_univ i₀)],
  congr' with v,
  simp only [set.mem_range, set.mem_image, set.mem_diff, set.mem_singleton_iff, subtype.exists,
             subtype.coe_mk],
  split,
  { rintros ⟨x, ⟨i₁, ⟨⟨hi₁u, hi₁⟩, rfl⟩⟩, hv⟩,
    exact ⟨i₁, hi₁, hv⟩ },
  { exact λ ⟨i₁, hi₁, hv⟩, ⟨p i₁, ⟨i₁, ⟨set.mem_univ _, hi₁⟩, rfl⟩, hv⟩ }
end

/-- The `vector_span` of an indexed family is the span of the pairwise
subtractions with a given point on the right, excluding the subtraction
of that point from itself. -/
lemma vector_span_range_eq_span_range_vsub_right_ne (p : ι → P) (i₀ : ι) :
  vector_span k (set.range p) = submodule.span k (set.range (λ (i : {x // x ≠ i₀}), p i -ᵥ p i₀)) :=
begin
  rw [←set.image_univ, vector_span_image_eq_span_vsub_set_right_ne k _ (set.mem_univ i₀)],
  congr' with v,
  simp only [set.mem_range, set.mem_image, set.mem_diff, set.mem_singleton_iff, subtype.exists,
             subtype.coe_mk],
  split,
  { rintros ⟨x, ⟨i₁, ⟨⟨hi₁u, hi₁⟩, rfl⟩⟩, hv⟩,
    exact ⟨i₁, hi₁, hv⟩ },
  { exact λ ⟨i₁, hi₁, hv⟩, ⟨p i₁, ⟨i₁, ⟨set.mem_univ _, hi₁⟩, rfl⟩, hv⟩ }
end

section
variables {s : set P}

/-- The affine span of a set is nonempty if and only if that set is. -/
lemma affine_span_nonempty : (affine_span k s : set P).nonempty ↔ s.nonempty :=
span_points_nonempty k s

alias affine_span_nonempty ↔ _ _root_.set.nonempty.affine_span

/-- The affine span of a nonempty set is nonempty. -/
instance [nonempty s] : nonempty (affine_span k s) :=
((nonempty_coe_sort.1 ‹_›).affine_span _).to_subtype

/-- The affine span of a set is `⊥` if and only if that set is empty. -/
@[simp] lemma affine_span_eq_bot : affine_span k s = ⊥ ↔ s = ∅ :=
by rw [←not_iff_not, ←ne.def, ←ne.def, ←nonempty_iff_ne_bot, affine_span_nonempty,
       nonempty_iff_ne_empty]

@[simp] lemma bot_lt_affine_span : ⊥ < affine_span k s ↔ s.nonempty :=
by { rw [bot_lt_iff_ne_bot, nonempty_iff_ne_empty], exact (affine_span_eq_bot _).not }

end

variables {k}

/--
An induction principle for span membership. If `p` holds for all elements of `s` and is
preserved under certain affine combinations, then `p` holds for all elements of the span of `s`.
-/
lemma affine_span_induction {x : P} {s : set P} {p : P → Prop} (h : x ∈ affine_span k s)
  (Hs : ∀ x : P, x ∈ s → p x)
  (Hc : ∀ (c : k) (u v w : P), p u → p v → p w → p (c • (u -ᵥ v) +ᵥ w)) : p x :=
(@affine_span_le _ _ _ _ _ _ _ _ ⟨p, Hc⟩).mpr Hs h

/-- A dependent version of `affine_span_induction`. -/
lemma affine_span_induction' {s : set P} {p : Π x, x ∈ affine_span k s → Prop}
  (Hs : ∀ y (hys : y ∈ s), p y (subset_affine_span k _ hys))
  (Hc : ∀ (c : k) u hu v hv w hw, p u hu → p v hv → p w hw →
    p (c • (u -ᵥ v) +ᵥ w) (affine_subspace.smul_vsub_vadd_mem _ _ hu hv hw))
  {x : P} (h : x ∈ affine_span k s) : p x h :=
begin
  refine exists.elim _ (λ (hx : x ∈ affine_span k s) (hc : p x hx), hc),
  refine @affine_span_induction k V P _ _ _ _ _ _ _ h _ _,
  { exact (λ y hy, ⟨subset_affine_span _ _ hy, Hs y hy⟩) },
  { exact (λ c u v w hu hv hw, exists.elim hu $ λ hu' hu, exists.elim hv $ λ hv' hv,
      exists.elim hw $ λ hw' hw,
        ⟨affine_subspace.smul_vsub_vadd_mem _ _ hu' hv' hw', Hc _ _ _ _ _ _ _ hu hv hw⟩) },
end

section with_local_instance

local attribute [instance] affine_subspace.to_add_torsor

/-- A set, considered as a subset of its spanned affine subspace, spans the whole subspace. -/
@[simp] lemma affine_span_coe_preimage_eq_top (A : set P) [nonempty A] :
  affine_span k ((coe : affine_span k A → P) ⁻¹' A) = ⊤ :=
begin
  rw [eq_top_iff],
  rintro ⟨x, hx⟩ -,
  refine affine_span_induction' (λ y hy, _) (λ c u hu v hv w hw, _) hx,
  { exact subset_affine_span _ _ hy },
  { exact affine_subspace.smul_vsub_vadd_mem _ _ },
end

end with_local_instance

/-- Suppose a set of vectors spans `V`.  Then a point `p`, together
with those vectors added to `p`, spans `P`. -/
lemma affine_span_singleton_union_vadd_eq_top_of_span_eq_top {s : set V} (p : P)
    (h : submodule.span k (set.range (coe : s → V)) = ⊤) :
  affine_span k ({p} ∪ (λ v, v +ᵥ p) '' s) = ⊤ :=
begin
  convert ext_of_direction_eq _
    ⟨p,
     mem_affine_span k (set.mem_union_left _ (set.mem_singleton _)),
     mem_top k V p⟩,
  rw [direction_affine_span, direction_top,
      vector_span_eq_span_vsub_set_right k
        ((set.mem_union_left _ (set.mem_singleton _)) : p ∈ _), eq_top_iff, ←h],
  apply submodule.span_mono,
  rintros v ⟨v', rfl⟩,
  use (v' : V) +ᵥ p,
  simp
end

variables (k)

/-- The `vector_span` of two points is the span of their difference. -/
lemma vector_span_pair (p₁ p₂ : P) : vector_span k ({p₁, p₂} : set P) = k ∙ (p₁ -ᵥ p₂) :=
by rw [vector_span_eq_span_vsub_set_left k (mem_insert p₁ _), image_pair, vsub_self,
       submodule.span_insert_zero]

/-- The `vector_span` of two points is the span of their difference (reversed). -/
lemma vector_span_pair_rev (p₁ p₂ : P) : vector_span k ({p₁, p₂} : set P) = k ∙ (p₂ -ᵥ p₁) :=
by rw [pair_comm, vector_span_pair]

/-- The difference between two points lies in their `vector_span`. -/
lemma vsub_mem_vector_span_pair (p₁ p₂ : P) : p₁ -ᵥ p₂ ∈ vector_span k ({p₁, p₂} : set P) :=
vsub_mem_vector_span _ (set.mem_insert _ _) (set.mem_insert_of_mem _ (set.mem_singleton _))

/-- The difference between two points (reversed) lies in their `vector_span`. -/
lemma vsub_rev_mem_vector_span_pair (p₁ p₂ : P) : p₂ -ᵥ p₁ ∈ vector_span k ({p₁, p₂} : set P) :=
vsub_mem_vector_span _ (set.mem_insert_of_mem _ (set.mem_singleton _)) (set.mem_insert _ _)

variables {k}

/-- A multiple of the difference between two points lies in their `vector_span`. -/
lemma smul_vsub_mem_vector_span_pair (r : k) (p₁ p₂ : P) :
  r • (p₁ -ᵥ p₂) ∈ vector_span k ({p₁, p₂} : set P) :=
submodule.smul_mem _ _ (vsub_mem_vector_span_pair k p₁ p₂)

/-- A multiple of the difference between two points (reversed) lies in their `vector_span`. -/
lemma smul_vsub_rev_mem_vector_span_pair (r : k) (p₁ p₂ : P) :
  r • (p₂ -ᵥ p₁) ∈ vector_span k ({p₁, p₂} : set P) :=
submodule.smul_mem _ _ (vsub_rev_mem_vector_span_pair k p₁ p₂)

/-- A vector lies in the `vector_span` of two points if and only if it is a multiple of their
difference. -/
lemma mem_vector_span_pair {p₁ p₂ : P} {v : V} :
  v ∈ vector_span k ({p₁, p₂} : set P) ↔ ∃ r : k, r • (p₁ -ᵥ p₂) = v :=
by rw [vector_span_pair, submodule.mem_span_singleton]

/-- A vector lies in the `vector_span` of two points if and only if it is a multiple of their
difference (reversed). -/
lemma mem_vector_span_pair_rev {p₁ p₂ : P} {v : V} :
  v ∈ vector_span k ({p₁, p₂} : set P) ↔ ∃ r : k, r • (p₂ -ᵥ p₁) = v :=
by rw [vector_span_pair_rev, submodule.mem_span_singleton]

variables (k)

notation `line[` k `, ` p₁ `, ` p₂ `]` :=
affine_span k (insert p₁ (@singleton _ _ set.has_singleton p₂))

/-- The first of two points lies in their affine span. -/
lemma left_mem_affine_span_pair (p₁ p₂ : P) : p₁ ∈ line[k, p₁, p₂] :=
mem_affine_span _ (set.mem_insert _ _)

/-- The second of two points lies in their affine span. -/
lemma right_mem_affine_span_pair (p₁ p₂ : P) : p₂ ∈ line[k, p₁, p₂] :=
mem_affine_span _ (set.mem_insert_of_mem _ (set.mem_singleton _))

variables {k}

/-- A combination of two points expressed with `line_map` lies in their affine span. -/
lemma affine_map.line_map_mem_affine_span_pair (r : k) (p₁ p₂ : P) :
  affine_map.line_map p₁ p₂ r ∈ line[k, p₁, p₂] :=
affine_map.line_map_mem _ (left_mem_affine_span_pair _ _ _) (right_mem_affine_span_pair _ _ _)

/-- A combination of two points expressed with `line_map` (with the two points reversed) lies in
their affine span. -/
lemma affine_map.line_map_rev_mem_affine_span_pair (r : k) (p₁ p₂ : P) :
  affine_map.line_map p₂ p₁ r ∈ line[k, p₁, p₂] :=
affine_map.line_map_mem _ (right_mem_affine_span_pair _ _ _) (left_mem_affine_span_pair _ _ _)

/-- A multiple of the difference of two points added to the first point lies in their affine
span. -/
lemma smul_vsub_vadd_mem_affine_span_pair (r : k) (p₁ p₂ : P) :
  r • (p₂ -ᵥ p₁) +ᵥ p₁ ∈ line[k, p₁, p₂] :=
affine_map.line_map_mem_affine_span_pair _ _ _

/-- A multiple of the difference of two points added to the second point lies in their affine
span. -/
lemma smul_vsub_rev_vadd_mem_affine_span_pair (r : k) (p₁ p₂ : P) :
  r • (p₁ -ᵥ p₂) +ᵥ p₂ ∈ line[k, p₁, p₂] :=
affine_map.line_map_rev_mem_affine_span_pair _ _ _

/-- A vector added to the first point lies in the affine span of two points if and only if it is
a multiple of their difference. -/
lemma vadd_left_mem_affine_span_pair {p₁ p₂ : P} {v : V} :
  v +ᵥ p₁ ∈ line[k, p₁, p₂] ↔ ∃ r : k, r • (p₂ -ᵥ p₁) = v :=
by rw [vadd_mem_iff_mem_direction _ (left_mem_affine_span_pair _ _ _), direction_affine_span,
       mem_vector_span_pair_rev]

/-- A vector added to the second point lies in the affine span of two points if and only if it is
a multiple of their difference. -/
lemma vadd_right_mem_affine_span_pair {p₁ p₂ : P} {v : V} :
  v +ᵥ p₂ ∈ line[k, p₁, p₂] ↔ ∃ r : k, r • (p₁ -ᵥ p₂) = v :=
by rw [vadd_mem_iff_mem_direction _ (right_mem_affine_span_pair _ _ _), direction_affine_span,
       mem_vector_span_pair]

/-- The span of two points that lie in an affine subspace is contained in that subspace. -/
lemma affine_span_pair_le_of_mem_of_mem {p₁ p₂ : P} {s : affine_subspace k P} (hp₁ : p₁ ∈ s)
  (hp₂ : p₂ ∈ s) : line[k, p₁, p₂] ≤ s :=
begin
  rw [affine_span_le, set.insert_subset, set.singleton_subset_iff],
  exact ⟨hp₁, hp₂⟩
end

/-- One line is contained in another differing in the first point if the first point of the first
line is contained in the second line. -/
lemma affine_span_pair_le_of_left_mem {p₁ p₂ p₃ : P} (h : p₁ ∈ line[k, p₂, p₃]) :
  line[k, p₁, p₃] ≤ line[k, p₂, p₃] :=
affine_span_pair_le_of_mem_of_mem h (right_mem_affine_span_pair _ _ _)

/-- One line is contained in another differing in the second point if the second point of the
first line is contained in the second line. -/
lemma affine_span_pair_le_of_right_mem {p₁ p₂ p₃ : P} (h : p₁ ∈ line[k, p₂, p₃]) :
  line[k, p₂, p₁] ≤ line[k, p₂, p₃] :=
affine_span_pair_le_of_mem_of_mem (left_mem_affine_span_pair _ _ _) h

variables (k)

/-- `affine_span` is monotone. -/
@[mono]
lemma affine_span_mono {s₁ s₂ : set P} (h : s₁ ⊆ s₂) : affine_span k s₁ ≤ affine_span k s₂ :=
span_points_subset_coe_of_subset_coe (set.subset.trans h (subset_affine_span k _))

/-- Taking the affine span of a set, adding a point and taking the
span again produces the same results as adding the point to the set
and taking the span. -/
lemma affine_span_insert_affine_span (p : P) (ps : set P) :
  affine_span k (insert p (affine_span k ps : set P)) = affine_span k (insert p ps) :=
by rw [set.insert_eq, set.insert_eq, span_union, span_union, affine_span_coe]

/-- If a point is in the affine span of a set, adding it to that set
does not change the affine span. -/
lemma affine_span_insert_eq_affine_span {p : P} {ps : set P} (h : p ∈ affine_span k ps) :
  affine_span k (insert p ps) = affine_span k ps :=
begin
  rw ←mem_coe at h,
  rw [←affine_span_insert_affine_span, set.insert_eq_of_mem h, affine_span_coe]
end

variables {k}

/-- If a point is in the affine span of a set, adding it to that set
does not change the vector span. -/
lemma vector_span_insert_eq_vector_span {p : P} {ps : set P} (h : p ∈ affine_span k ps) :
  vector_span k (insert p ps) = vector_span k ps :=
by simp_rw [←direction_affine_span, affine_span_insert_eq_affine_span _ h]

end affine_space'

namespace affine_subspace

variables {k : Type*} {V : Type*} {P : Type*} [ring k] [add_comm_group V] [module k V]
          [affine_space V P]
include V

/-- The direction of the sup of two nonempty affine subspaces is the
sup of the two directions and of any one difference between points in
the two subspaces. -/
lemma direction_sup {s1 s2 : affine_subspace k P} {p1 p2 : P} (hp1 : p1 ∈ s1) (hp2 : p2 ∈ s2) :
  (s1 ⊔ s2).direction = s1.direction ⊔ s2.direction ⊔ k ∙ (p2 -ᵥ p1) :=
begin
  refine le_antisymm _ _,
  { change (affine_span k ((s1 : set P) ∪ s2)).direction ≤ _,
    rw ←mem_coe at hp1,
    rw [direction_affine_span, vector_span_eq_span_vsub_set_right k (set.mem_union_left _ hp1),
        submodule.span_le],
    rintros v ⟨p3, hp3, rfl⟩,
    cases hp3,
    { rw [sup_assoc, sup_comm, set_like.mem_coe, submodule.mem_sup],
      use [0, submodule.zero_mem _, p3 -ᵥ p1, vsub_mem_direction hp3 hp1],
      rw zero_add },
    { rw [sup_assoc, set_like.mem_coe, submodule.mem_sup],
      use [0, submodule.zero_mem _, p3 -ᵥ p1],
      rw [and_comm, zero_add],
      use rfl,
      rw [←vsub_add_vsub_cancel p3 p2 p1, submodule.mem_sup],
      use [p3 -ᵥ p2, vsub_mem_direction hp3 hp2, p2 -ᵥ p1,
           submodule.mem_span_singleton_self _] } },
  { refine sup_le (sup_direction_le _ _) _,
    rw [direction_eq_vector_span, vector_span_def],
    exact Inf_le_Inf (λ p hp, set.subset.trans
      (set.singleton_subset_iff.2
        (vsub_mem_vsub (mem_span_points k p2 _ (set.mem_union_right _ hp2))
                       (mem_span_points k p1 _ (set.mem_union_left _ hp1))))
      hp) }
end

/-- The direction of the span of the result of adding a point to a
nonempty affine subspace is the sup of the direction of that subspace
and of any one difference between that point and a point in the
subspace. -/
lemma direction_affine_span_insert {s : affine_subspace k P} {p1 p2 : P} (hp1 : p1 ∈ s) :
  (affine_span k (insert p2 (s : set P))).direction = submodule.span k {p2 -ᵥ p1} ⊔ s.direction :=
begin
  rw [sup_comm, ←set.union_singleton, ←coe_affine_span_singleton k V p2],
  change (s ⊔ affine_span k {p2}).direction = _,
  rw [direction_sup hp1 (mem_affine_span k (set.mem_singleton _)), direction_affine_span],
  simp
end

/-- Given a point `p1` in an affine subspace `s`, and a point `p2`, a
point `p` is in the span of `s` with `p2` added if and only if it is a
multiple of `p2 -ᵥ p1` added to a point in `s`. -/
lemma mem_affine_span_insert_iff {s : affine_subspace k P} {p1 : P} (hp1 : p1 ∈ s) (p2 p : P) :
  p ∈ affine_span k (insert p2 (s : set P)) ↔
    ∃ (r : k) (p0 : P) (hp0 : p0 ∈ s), p = r • (p2 -ᵥ p1 : V) +ᵥ p0 :=
begin
  rw ←mem_coe at hp1,
  rw [←vsub_right_mem_direction_iff_mem (mem_affine_span k (set.mem_insert_of_mem _ hp1)),
      direction_affine_span_insert hp1, submodule.mem_sup],
  split,
  { rintros ⟨v1, hv1, v2, hv2, hp⟩,
    rw submodule.mem_span_singleton at hv1,
    rcases hv1 with ⟨r, rfl⟩,
    use [r, v2 +ᵥ p1, vadd_mem_of_mem_direction hv2 hp1],
    symmetry' at hp,
    rw [←sub_eq_zero, ←vsub_vadd_eq_vsub_sub, vsub_eq_zero_iff_eq] at hp,
    rw [hp, vadd_vadd] },
  { rintros ⟨r, p3, hp3, rfl⟩,
    use [r • (p2 -ᵥ p1), submodule.mem_span_singleton.2 ⟨r, rfl⟩, p3 -ᵥ p1,
         vsub_mem_direction hp3 hp1],
    rw [vadd_vsub_assoc, add_comm] }
end

end affine_subspace

section map_comap

variables {k V₁ P₁ V₂ P₂ V₃ P₃ : Type*} [ring k]
variables [add_comm_group V₁] [module k V₁] [add_torsor V₁ P₁]
variables [add_comm_group V₂] [module k V₂] [add_torsor V₂ P₂]
variables [add_comm_group V₃] [module k V₃] [add_torsor V₃ P₃]
include V₁ V₂

section

variables (f : P₁ →ᵃ[k] P₂)

@[simp] lemma affine_map.vector_span_image_eq_submodule_map {s : set P₁} :
  submodule.map f.linear (vector_span k s) = vector_span k (f '' s) :=
by simp [f.image_vsub_image, vector_span_def]

namespace affine_subspace

/-- The image of an affine subspace under an affine map as an affine subspace. -/
def map (s : affine_subspace k P₁) : affine_subspace k P₂ :=
{ carrier := f '' s,
  smul_vsub_vadd_mem :=
    begin
      rintros t - - - ⟨p₁, h₁, rfl⟩ ⟨p₂, h₂, rfl⟩ ⟨p₃, h₃, rfl⟩,
      use t • (p₁ -ᵥ p₂) +ᵥ p₃,
      suffices : t • (p₁ -ᵥ p₂) +ᵥ p₃ ∈ s, { simp [this], },
      exact s.smul_vsub_vadd_mem t h₁ h₂ h₃,
    end }

@[simp] lemma coe_map (s : affine_subspace k P₁) : (s.map f : set P₂) = f '' s := rfl

@[simp] lemma mem_map {f : P₁ →ᵃ[k] P₂} {x : P₂} {s : affine_subspace k P₁} :
  x ∈ s.map f ↔ ∃ y ∈ s, f y = x := mem_image_iff_bex

lemma mem_map_of_mem {x : P₁} {s : affine_subspace k P₁} (h : x ∈ s) : f x ∈ s.map f :=
set.mem_image_of_mem _ h

lemma mem_map_iff_mem_of_injective {f : P₁ →ᵃ[k] P₂} {x : P₁} {s : affine_subspace k P₁}
  (hf : function.injective f) : f x ∈ s.map f ↔ x ∈ s :=
hf.mem_set_image

@[simp] lemma map_bot : (⊥ : affine_subspace k P₁).map f = ⊥ :=
coe_injective $ image_empty f

@[simp] lemma map_eq_bot_iff {s : affine_subspace k P₁} : s.map f = ⊥ ↔ s = ⊥ :=
begin
  refine ⟨λ h, _, λ h, _⟩,
  { rwa [←coe_eq_bot_iff, coe_map, image_eq_empty, coe_eq_bot_iff] at h },
  { rw [h, map_bot] }
end

omit V₂

@[simp] lemma map_id (s : affine_subspace k P₁) : s.map (affine_map.id k P₁) = s :=
coe_injective $ image_id _

include V₂ V₃

lemma map_map (s : affine_subspace k P₁) (f : P₁ →ᵃ[k] P₂) (g : P₂ →ᵃ[k] P₃) :
  (s.map f).map g = s.map (g.comp f) :=
coe_injective $ image_image _ _ _

omit V₃

@[simp] lemma map_direction (s : affine_subspace k P₁) :
  (s.map f).direction = s.direction.map f.linear :=
by simp [direction_eq_vector_span]

lemma map_span (s : set P₁) :
  (affine_span k s).map f = affine_span k (f '' s) :=
begin
  rcases s.eq_empty_or_nonempty with rfl | ⟨p, hp⟩, { simp, },
  apply ext_of_direction_eq,
  { simp [direction_affine_span], },
  { exact ⟨f p, mem_image_of_mem f (subset_affine_span k _ hp),
                subset_affine_span k _ (mem_image_of_mem f hp)⟩, },
end

end affine_subspace

namespace affine_map

@[simp] lemma map_top_of_surjective (hf : function.surjective f) : affine_subspace.map f ⊤ = ⊤ :=
begin
  rw ← affine_subspace.ext_iff,
  exact image_univ_of_surjective hf,
end

lemma span_eq_top_of_surjective {s : set P₁}
  (hf : function.surjective f) (h : affine_span k s = ⊤) :
  affine_span k (f '' s) = ⊤ :=
by rw [← affine_subspace.map_span, h, map_top_of_surjective f hf]

end affine_map

namespace affine_equiv

lemma span_eq_top_iff {s : set P₁} (e : P₁ ≃ᵃ[k] P₂) :
  affine_span k s = ⊤ ↔ affine_span k (e '' s) = ⊤ :=
begin
  refine ⟨(e : P₁ →ᵃ[k] P₂).span_eq_top_of_surjective e.surjective, _⟩,
  intros h,
  have : s = e.symm '' (e '' s), { simp [← image_comp], },
  rw this,
  exact (e.symm : P₂ →ᵃ[k] P₁).span_eq_top_of_surjective e.symm.surjective h,
end

end affine_equiv

end

namespace affine_subspace

/-- The preimage of an affine subspace under an affine map as an affine subspace. -/
def comap (f : P₁ →ᵃ[k] P₂) (s : affine_subspace k P₂) : affine_subspace k P₁ :=
{ carrier := f ⁻¹' s,
  smul_vsub_vadd_mem := λ t p₁ p₂ p₃ (hp₁ : f p₁ ∈ s) (hp₂ : f p₂ ∈ s) (hp₃ : f p₃ ∈ s),
    show f _ ∈ s, begin
      rw [affine_map.map_vadd, linear_map.map_smul, affine_map.linear_map_vsub],
      apply s.smul_vsub_vadd_mem _ hp₁ hp₂ hp₃,
    end }

@[simp] lemma coe_comap (f : P₁ →ᵃ[k] P₂) (s : affine_subspace k P₂) :
  (s.comap f : set P₁) = f ⁻¹' ↑s := rfl

@[simp] lemma mem_comap {f : P₁ →ᵃ[k] P₂} {x : P₁} {s : affine_subspace k P₂} :
  x ∈ s.comap f ↔ f x ∈ s := iff.rfl

lemma comap_mono {f : P₁ →ᵃ[k] P₂} {s t : affine_subspace k P₂} : s ≤ t → s.comap f ≤ t.comap f :=
preimage_mono

@[simp] lemma comap_top {f : P₁ →ᵃ[k] P₂} : (⊤ : affine_subspace k P₂).comap f = ⊤ :=
by { rw ← ext_iff, exact preimage_univ, }

omit V₂

@[simp] lemma comap_id (s : affine_subspace k P₁) : s.comap (affine_map.id k P₁) = s :=
coe_injective rfl

include V₂ V₃

lemma comap_comap (s : affine_subspace k P₃) (f : P₁ →ᵃ[k] P₂) (g : P₂ →ᵃ[k] P₃) :
  (s.comap g).comap f = s.comap (g.comp f) :=
coe_injective rfl

omit V₃

-- lemmas about map and comap derived from the galois connection

lemma map_le_iff_le_comap {f : P₁ →ᵃ[k] P₂} {s : affine_subspace k P₁} {t : affine_subspace k P₂} :
  s.map f ≤ t ↔ s ≤ t.comap f :=
image_subset_iff

lemma gc_map_comap (f : P₁ →ᵃ[k] P₂) : galois_connection (map f) (comap f) :=
λ _ _, map_le_iff_le_comap

lemma map_comap_le (f : P₁ →ᵃ[k] P₂) (s : affine_subspace k P₂) : (s.comap f).map f ≤ s :=
(gc_map_comap f).l_u_le _

lemma le_comap_map (f : P₁ →ᵃ[k] P₂) (s : affine_subspace k P₁) : s ≤ (s.map f).comap f :=
(gc_map_comap f).le_u_l _

lemma map_sup (s t : affine_subspace k P₁) (f : P₁ →ᵃ[k] P₂) : (s ⊔ t).map f = s.map f ⊔ t.map f :=
(gc_map_comap f).l_sup

lemma map_supr {ι : Sort*} (f : P₁ →ᵃ[k] P₂) (s : ι → affine_subspace k P₁) :
  (supr s).map f = ⨆ i, (s i).map f :=
(gc_map_comap f).l_supr

lemma comap_inf (s t : affine_subspace k P₂) (f : P₁ →ᵃ[k] P₂) :
  (s ⊓ t).comap f = s.comap f ⊓ t.comap f :=
(gc_map_comap f).u_inf

lemma comap_supr {ι : Sort*} (f : P₁ →ᵃ[k] P₂) (s : ι → affine_subspace k P₂) :
  (infi s).comap f = ⨅ i, (s i).comap f :=
(gc_map_comap f).u_infi

@[simp] lemma comap_symm (e : P₁ ≃ᵃ[k] P₂) (s : affine_subspace k P₁) :
  s.comap (e.symm : P₂ →ᵃ[k] P₁) = s.map e :=
coe_injective $ e.preimage_symm _

@[simp] lemma map_symm (e : P₁ ≃ᵃ[k] P₂) (s : affine_subspace k P₂) :
  s.map (e.symm : P₂ →ᵃ[k] P₁) = s.comap e :=
coe_injective $ e.image_symm _

lemma comap_span (f : P₁ ≃ᵃ[k] P₂) (s : set P₂) :
  (affine_span k s).comap (f : P₁ →ᵃ[k] P₂) = affine_span k (f ⁻¹' s) :=
by rw [←map_symm, map_span, affine_equiv.coe_coe, f.image_symm]

end affine_subspace

end map_comap

namespace affine_subspace

open affine_equiv

variables {k : Type*} {V : Type*} {P : Type*} [ring k] [add_comm_group V] [module k V]
variables [affine_space V P]
include V

/-- Two affine subspaces are parallel if one is related to the other by adding the same vector
to all points. -/
def parallel (s₁ s₂ : affine_subspace k P) : Prop :=
∃ v : V, s₂ = s₁.map (const_vadd k P v)

localized "infix (name := affine_subspace.parallel) ` ∥ `:50 := affine_subspace.parallel" in affine

@[symm] lemma parallel.symm {s₁ s₂ : affine_subspace k P} (h : s₁ ∥ s₂) : s₂ ∥ s₁ :=
begin
  rcases h with ⟨v, rfl⟩,
  refine ⟨-v, _⟩,
  rw [map_map, ←coe_trans_to_affine_map, ←const_vadd_add, neg_add_self, const_vadd_zero,
      coe_refl_to_affine_map, map_id]
end

lemma parallel_comm {s₁ s₂ : affine_subspace k P} : s₁ ∥ s₂ ↔ s₂ ∥ s₁ :=
⟨parallel.symm, parallel.symm⟩

@[refl] lemma parallel.refl (s : affine_subspace k P) : s ∥ s :=
⟨0, by simp⟩

@[trans] lemma parallel.trans {s₁ s₂ s₃ : affine_subspace k P} (h₁₂ : s₁ ∥ s₂) (h₂₃ : s₂ ∥ s₃) :
  s₁ ∥ s₃ :=
begin
  rcases h₁₂ with ⟨v₁₂, rfl⟩,
  rcases h₂₃ with ⟨v₂₃, rfl⟩,
  refine ⟨v₂₃ + v₁₂, _⟩,
  rw [map_map, ←coe_trans_to_affine_map, ←const_vadd_add]
end

lemma parallel.direction_eq {s₁ s₂ : affine_subspace k P} (h : s₁ ∥ s₂) :
  s₁.direction = s₂.direction :=
begin
  rcases h with ⟨v, rfl⟩,
  simp
end

@[simp] lemma parallel_bot_iff_eq_bot {s : affine_subspace k P} :
  s ∥ ⊥ ↔ s = ⊥ :=
begin
  refine ⟨λ h, _, λ h, h ▸ parallel.refl _⟩,
  rcases h with ⟨v, h⟩,
  rwa [eq_comm, map_eq_bot_iff] at h
end

@[simp] lemma bot_parallel_iff_eq_bot {s : affine_subspace k P} :
  ⊥ ∥ s ↔ s = ⊥ :=
by rw [parallel_comm, parallel_bot_iff_eq_bot]

lemma parallel_iff_direction_eq_and_eq_bot_iff_eq_bot {s₁ s₂ : affine_subspace k P} :
  s₁ ∥ s₂ ↔ s₁.direction = s₂.direction ∧ (s₁ = ⊥ ↔ s₂ = ⊥) :=
begin
  refine ⟨λ h, ⟨h.direction_eq, _, _⟩, λ h, _⟩,
  { rintro rfl, exact bot_parallel_iff_eq_bot.1 h },
  { rintro rfl, exact parallel_bot_iff_eq_bot.1 h },
  { rcases h with ⟨hd, hb⟩,
    by_cases hs₁ : s₁ = ⊥,
    { rw [hs₁, bot_parallel_iff_eq_bot],
      exact hb.1 hs₁ },
    { have hs₂ : s₂ ≠ ⊥ := hb.not.1 hs₁,
      rcases (nonempty_iff_ne_bot s₁).2 hs₁ with ⟨p₁, hp₁⟩,
      rcases (nonempty_iff_ne_bot s₂).2 hs₂ with ⟨p₂, hp₂⟩,
      refine ⟨p₂ -ᵥ p₁, (eq_iff_direction_eq_of_mem hp₂ _).2 _⟩,
      { rw mem_map,
        refine ⟨p₁, hp₁, _⟩,
        simp },
      { simpa using hd.symm } } }
end

lemma parallel.vector_span_eq {s₁ s₂ : set P} (h : affine_span k s₁ ∥ affine_span k s₂) :
  vector_span k s₁ = vector_span k s₂ :=
begin
  simp_rw ←direction_affine_span,
  exact h.direction_eq
end

lemma affine_span_parallel_iff_vector_span_eq_and_eq_empty_iff_eq_empty {s₁ s₂ : set P} :
  affine_span k s₁ ∥ affine_span k s₂ ↔ vector_span k s₁ = vector_span k s₂ ∧ (s₁ = ∅ ↔ s₂ = ∅) :=
begin
  simp_rw [←direction_affine_span, ←affine_span_eq_bot k],
  exact parallel_iff_direction_eq_and_eq_bot_iff_eq_bot
end

lemma affine_span_pair_parallel_iff_vector_span_eq {p₁ p₂ p₃ p₄ : P} :
  line[k, p₁, p₂] ∥ line[k, p₃, p₄] ↔
    vector_span k ({p₁, p₂} : set P) = vector_span k ({p₃, p₄} : set P) :=
by simp [affine_span_parallel_iff_vector_span_eq_and_eq_empty_iff_eq_empty,
         ←not_nonempty_iff_eq_empty]

end affine_subspace


-- Imagen_de_la_union_general.lean
-- Imagen de la unión general
-- José A. Alonso Jiménez
-- Sevilla, 23 de junio de 2021
-- ---------------------------------------------------------------------

-- ----------------------------------------------------------------------
-- Demostrar que
--    f '' (⋃ i, A i) = ⋃ i, f '' A i
-- ----------------------------------------------------------------------

import data.set.basic
import tactic

open set

variables {α : Type*} {β : Type*} {I : Type*}
variable  f : α → β
variables A : ℕ → set α

-- 1ª demostración
-- ===============

example : f '' (⋃ i, A i) = ⋃ i, f '' A i :=
begin
  ext y,
  split,
  { intro hy,
    rw mem_image at hy,
    cases hy with x hx,
    cases hx with xUA fxy,
    rw mem_Union at xUA,
    cases xUA with i xAi,
    rw mem_Union,
    use i,
    rw ← fxy,
    apply mem_image_of_mem,
    exact xAi, },
  { intro hy,
    rw mem_Union at hy,
    cases hy with i yAi,
    cases yAi with x hx,
    cases hx with xAi fxy,
    rw ← fxy,
    apply mem_image_of_mem,
    rw mem_Union,
    use i,
    exact xAi, },
end

-- 2ª demostración
-- ===============

example : f '' (⋃ i, A i) = ⋃ i, f '' A i :=
begin
  ext y,
  simp,
  split,
  { rintros ⟨x, ⟨i, xAi⟩, fxy⟩,
    use [i, x, xAi, fxy] },
  { rintros ⟨i, x, xAi, fxy⟩,
    exact ⟨x, ⟨i, xAi⟩, fxy⟩ },
end

-- 3ª demostración
-- ===============

example : f '' (⋃ i, A i) = ⋃ i, f '' A i :=
by tidy

-- 4ª demostración
-- ===============

example : f '' (⋃ i, A i) = ⋃ i, f '' A i :=
image_Union


/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura
-/
import Mathlib.Data.Nat.Basic
import Mathlib.Init.Dvd

/-!
# Definitions and properties of `gcd`, `lcm`, and `coprime`

-/

namespace Nat

--- TODO all of these dvd preliminaries belong elsewhere.

protected theorem dvd_mul_left (a b : ℕ) : a ∣ b * a := Exists.intro b (Nat.mul_comm b a)
protected theorem dvd_refl (a : ℕ) : a ∣ a := Exists.intro 1 (by simp)
protected theorem dvd_zero (a : ℕ) : a ∣ 0 := Exists.intro 0 (by simp)

protected theorem mul_dvd_mul : ∀ {a b c d : ℕ}, a ∣ b → c ∣ d → a * c ∣ b * d
| a, b, c, d, ⟨e, he⟩, ⟨f, hf⟩ => ⟨e * f, by rw [he, hf,
                                                 Nat.mul_assoc a _,
                                                 ←Nat.mul_assoc e _,
                                                 Nat.mul_comm e c,
                                                 Nat.mul_assoc a c _,
                                                 Nat.mul_assoc c e _,]⟩

protected theorem mul_dvd_mul_left (a : ℕ) {b c : ℕ} (h : b ∣ c) : a * b ∣ a * c :=
Nat.mul_dvd_mul (Nat.dvd_refl a) h

protected theorem mul_dvd_mul_right {a b : ℕ} (h: a ∣ b) (c : ℕ) : a * c ∣ b * c :=
Nat.mul_dvd_mul h (Nat.dvd_refl c)

----
-- Here's where we get into the main gcd results

theorem gcd_rec (m n : ℕ) : gcd m n = gcd (n % m) m :=
  match m with
  | 0 => by have := (mod_zero n).symm
            rwa [gcd_zero_right]
  | pm + 1 => by simp [gcd_succ]

theorem gcd.induction
  {P : ℕ → ℕ → Prop}
  (m n : ℕ)
  (H0 : ∀n, P 0 n)
  (H1 : ∀ m n, 0 < m → P (n % m) m → P m n) :
  P m n :=
  @WellFounded.induction _ _ lt_wfRel.wf (λ m => ∀ n, P m n) m
    (λ k IH =>
      match k with
      | 0 => H0
      | pk+1 => λ n => H1 _ _ (succ_pos _) (IH _ (mod_lt _ (succ_pos _)) _) )
    n

def lcm (m n : ℕ) : ℕ := m * n / gcd m n

@[reducible] def coprime (m n : ℕ) : Prop := gcd m n = 1

---

theorem gcd_dvd (m n : ℕ) : (gcd m n ∣ m) ∧ (gcd m n ∣ n) := by
  induction m, n using gcd.induction with
  | H0 n => exact And.intro (Exists.intro 0 (by simp))
                            (Exists.intro 1 (by simp))
  | H1 m n mpos IH =>
    let ⟨IH₁, IH₂⟩ := IH
    exact And.intro (by rwa [gcd_rec])
                    (by rw [←gcd_rec] at IH₁
                        rw [←gcd_rec] at IH₂
                        exact (dvd_mod_iff IH₂).1 IH₁)

theorem gcd_dvd_left (m n : ℕ) : gcd m n ∣ m := (gcd_dvd m n).left

theorem gcd_dvd_right (m n : ℕ) : gcd m n ∣ n := (gcd_dvd m n).right

theorem gcd_le_left {m} (n) (h : 0 < m) : gcd m n ≤ m := le_of_dvd h $ gcd_dvd_left m n

theorem gcd_le_right {m} (n) (h : 0 < n) : gcd m n ≤ n := le_of_dvd h $ gcd_dvd_right m n

theorem dvd_gcd {m n k : ℕ} : k ∣ m → k ∣ n → k ∣ gcd m n := by
  induction m, n using gcd.induction with
  | H0 n => intros _ kn
            rw [gcd_zero_left]
            exact kn
  | H1 m n mpos IH => intros H1 H2
                      rw [gcd_rec]
                      exact IH ((dvd_mod_iff H1).mpr H2) H1

theorem dvd_gcd_iff {m n k : ℕ} : k ∣ gcd m n ↔ k ∣ m ∧ k ∣ n :=
Iff.intro (λ h => And.intro (Nat.dvd_trans h (gcd_dvd m n).left) (Nat.dvd_trans h (gcd_dvd m n).right))
          (λ h => dvd_gcd h.left h.right)

theorem gcd_comm (m n : ℕ) : gcd m n = gcd n m :=
  dvd_antisymm
    (dvd_gcd (gcd_dvd_right m n) (gcd_dvd_left m n))
    (dvd_gcd (gcd_dvd_right n m) (gcd_dvd_left n m))

theorem gcd_eq_left_iff_dvd {m n :ℕ} : m ∣ n ↔ gcd m n = m :=
Iff.intro
  (λ h => by rw [gcd_rec, mod_eq_zero_of_dvd h, gcd_zero_left])
  (λ h => h ▸ gcd_dvd_right m n)

theorem gcd_eq_right_iff_dvd {m n : ℕ} : m ∣ n ↔ gcd n m = m :=
by rw [gcd_comm]
   apply gcd_eq_left_iff_dvd

theorem gcd_assoc (m n k : ℕ) : gcd (gcd m n) k = gcd m (gcd n k) :=
dvd_antisymm
  (dvd_gcd
    (Nat.dvd_trans (gcd_dvd_left (gcd m n) k) (gcd_dvd_left m n))
    (dvd_gcd (Nat.dvd_trans (gcd_dvd_left (gcd m n) k) (gcd_dvd_right m n))
      (gcd_dvd_right (gcd m n) k)))
  (dvd_gcd
    (dvd_gcd (gcd_dvd_left m (gcd n k)) (Nat.dvd_trans (gcd_dvd_right m (gcd n k)) (gcd_dvd_left n k)))
    (Nat.dvd_trans (gcd_dvd_right m (gcd n k)) (gcd_dvd_right n k)))

@[simp] theorem gcd_one_right (n : ℕ) : gcd n 1 = 1 :=
Eq.trans (gcd_comm n 1) $ gcd_one_left n

theorem gcd_mul_left (m n k : ℕ) : gcd (m * n) (m * k) = m * gcd n k := by
  induction n, k using gcd.induction with
  | H0 k => simp
  | H1 n k npos IH => rwa [←mul_mod_mul_left, ←gcd_rec, ←gcd_rec] at IH

theorem gcd_mul_right (m n k : ℕ) : gcd (m * n) (k * n) = gcd m k * n :=
by rw [Nat.mul_comm m n, Nat.mul_comm k n, Nat.mul_comm (gcd m k) n, gcd_mul_left]

theorem gcd_pos_of_pos_left {m : ℕ} (n : ℕ) (mpos : 0 < m) : 0 < gcd m n :=
pos_of_dvd_of_pos (gcd_dvd_left m n) mpos

theorem gcd_pos_of_pos_right (m : ℕ) {n : ℕ} (npos : 0 < n) : 0 < gcd m n :=
pos_of_dvd_of_pos (gcd_dvd_right m n) npos

theorem eq_zero_of_gcd_eq_zero_left {m n : ℕ} (H : gcd m n = 0) : m = 0 :=
match eq_zero_or_pos m with
| Or.inl H0 => H0
| Or.inr H1 => absurd (Eq.symm H) (ne_of_lt (gcd_pos_of_pos_left _ H1))

theorem eq_zero_of_gcd_eq_zero_right {m n : ℕ} (H : gcd m n = 0) : n = 0 :=
by rw [gcd_comm] at H
   exact eq_zero_of_gcd_eq_zero_left H

theorem gcd_div {m n k : ℕ} (H1 : k ∣ m) (H2 : k ∣ n) :
  gcd (m / k) (n / k) = gcd m n / k :=
match eq_zero_or_pos k with
| Or.inl H0 => by rw [H0, Nat.div_zero, Nat.div_zero, Nat.div_zero, gcd_zero_right]
| Or.inr H3 =>
  Nat.eq_of_mul_eq_mul_right H3 $ by rw [Nat.div_mul_cancel (dvd_gcd H1 H2), ←gcd_mul_right,
                                         Nat.div_mul_cancel H1, Nat.div_mul_cancel H2]

theorem gcd_dvd_gcd_of_dvd_left {m k : ℕ} (n : ℕ) (H : m ∣ k) : gcd m n ∣ gcd k n :=
dvd_gcd (Nat.dvd_trans (gcd_dvd_left m n) H) (gcd_dvd_right m n)

theorem gcd_dvd_gcd_of_dvd_right {m k : ℕ} (n : ℕ) (H : m ∣ k) : gcd n m ∣ gcd n k :=
dvd_gcd (gcd_dvd_left n m) (Nat.dvd_trans (gcd_dvd_right n m) H)

theorem gcd_dvd_gcd_mul_left (m n k : ℕ) : gcd m n ∣ gcd (k * m) n :=
gcd_dvd_gcd_of_dvd_left _ (Nat.dvd_mul_left _ _)

theorem gcd_dvd_gcd_mul_right (m n k : ℕ) : gcd m n ∣ gcd (m * k) n :=
gcd_dvd_gcd_of_dvd_left _ (Nat.dvd_mul_right _ _)

theorem gcd_dvd_gcd_mul_left_right (m n k : ℕ) : gcd m n ∣ gcd m (k * n) :=
gcd_dvd_gcd_of_dvd_right _ (Nat.dvd_mul_left _ _)

theorem gcd_dvd_gcd_mul_right_right (m n k : ℕ) : gcd m n ∣ gcd m (n * k) :=
gcd_dvd_gcd_of_dvd_right _ (Nat.dvd_mul_right _ _)

theorem gcd_eq_left {m n : ℕ} (H : m ∣ n) : gcd m n = m :=
dvd_antisymm (gcd_dvd_left _ _) (dvd_gcd (Nat.dvd_refl _) H)

theorem gcd_eq_right {m n : ℕ} (H : n ∣ m) : gcd m n = n :=
by rw [gcd_comm, gcd_eq_left H]

@[simp] lemma gcd_mul_left_left (m n : ℕ) : gcd (m * n) n = n :=
dvd_antisymm (gcd_dvd_right _ _) (dvd_gcd (Nat.dvd_mul_left _ _) (Nat.dvd_refl _))

@[simp] lemma gcd_mul_left_right (m n : ℕ) : gcd n (m * n) = n :=
by rw [gcd_comm, gcd_mul_left_left]

@[simp] lemma gcd_mul_right_left (m n : ℕ) : gcd (n * m) n = n :=
by rw [Nat.mul_comm, gcd_mul_left_left]

@[simp] lemma gcd_mul_right_right (m n : ℕ) : gcd n (n * m) = n :=
by rw [gcd_comm, gcd_mul_right_left]

@[simp] lemma gcd_gcd_self_right_left (m n : ℕ) : gcd m (gcd m n) = gcd m n :=
dvd_antisymm (gcd_dvd_right _ _) (dvd_gcd (gcd_dvd_left _ _) (Nat.dvd_refl _))

@[simp] lemma gcd_gcd_self_right_right (m n : ℕ) : gcd m (gcd n m) = gcd n m :=
by rw [gcd_comm n m, gcd_gcd_self_right_left]

@[simp] lemma gcd_gcd_self_left_right (m n : ℕ) : gcd (gcd n m) m = gcd n m :=
by rw [gcd_comm, gcd_gcd_self_right_right]

@[simp] lemma gcd_gcd_self_left_left (m n : ℕ) : gcd (gcd m n) m = gcd m n :=
by rw [gcd_comm m n, gcd_gcd_self_left_right]

lemma gcd_add_mul_self (m n k : ℕ) : gcd m (n + k * m) = gcd m n :=
by simp [gcd_rec m (n + k * m), gcd_rec m n]

theorem gcd_eq_zero_iff {i j : ℕ} : gcd i j = 0 ↔ i = 0 ∧ j = 0 :=
Iff.intro
  (λ h => ⟨eq_zero_of_gcd_eq_zero_left h, eq_zero_of_gcd_eq_zero_right h⟩)
  (λ h => by rw [h.1, h.2]
             exact Nat.gcd_zero_right _)

/-! ### `lcm` -/

theorem lcm_comm (m n : ℕ) : lcm m n = lcm n m :=
by have h1 : lcm m n = m * n / gcd m n := rfl
   have h2 : lcm n m = n * m / gcd n m := rfl
   rw [h1, h2, Nat.mul_comm n m, gcd_comm n m]

@[simp]
theorem lcm_zero_left (m : ℕ) : lcm 0 m = 0 :=
by have h : lcm 0 m = 0 * m / gcd 0 m := rfl
   simp [h]

@[simp]
theorem lcm_zero_right (m : ℕ) : lcm m 0 = 0 := lcm_comm 0 m ▸ lcm_zero_left m

@[simp]
theorem lcm_one_left (m : ℕ) : lcm 1 m = m :=
by have h : lcm 1 m = 1 * m / gcd 1 m := rfl
   simp [h]

@[simp]
theorem lcm_one_right (m : ℕ) : lcm m 1 = m := lcm_comm 1 m ▸ lcm_one_left m

@[simp]
theorem lcm_self (m : ℕ) : lcm m m = m :=
match eq_zero_or_pos m with
| Or.inl h => by rw [h, lcm_zero_left]
| Or.inr h => by have h1 : lcm m m = m * m / gcd m m := rfl
                 simp [h1, Nat.mul_div_cancel _ h]

theorem dvd_lcm_left (m n : ℕ) : m ∣ lcm m n :=
Exists.intro (n / gcd m n)
             (by rw [← Nat.mul_div_assoc m (Nat.gcd_dvd_right m n)]
                 rfl)

theorem dvd_lcm_right (m n : ℕ) : n ∣ lcm m n :=
lcm_comm n m ▸ dvd_lcm_left n m

theorem gcd_mul_lcm (m n : ℕ) : gcd m n * lcm m n = m * n :=
by have h1 : lcm m n = m * n / gcd m n := rfl
   rw [h1]
   rw [Nat.mul_div_cancel' (Nat.dvd_trans (gcd_dvd_left m n) (Nat.dvd_mul_right m n))]

theorem lcm_dvd {m n k : ℕ} (H1 : m ∣ k) (H2 : n ∣ k) : lcm m n ∣ k :=
match eq_zero_or_pos k with
| Or.inl h => by rw [h]
                 exact Nat.dvd_zero _
| Or.inr kpos => Nat.dvd_of_mul_dvd_mul_left (gcd_pos_of_pos_left n (pos_of_dvd_of_pos H1 kpos)) $
                   by rw [gcd_mul_lcm, ←gcd_mul_right, Nat.mul_comm n k];
                      exact dvd_gcd (Nat.mul_dvd_mul_left _ H2) (Nat.mul_dvd_mul_right H1 _)

theorem lcm_assoc (m n k : ℕ) : lcm (lcm m n) k = lcm m (lcm n k) :=
dvd_antisymm
  (lcm_dvd
    (lcm_dvd (dvd_lcm_left m (lcm n k)) (Nat.dvd_trans (dvd_lcm_left n k) (dvd_lcm_right m (lcm n k))))
    (Nat.dvd_trans (dvd_lcm_right n k) (dvd_lcm_right m (lcm n k))))
  (lcm_dvd
    (Nat.dvd_trans (dvd_lcm_left m n) (dvd_lcm_left (lcm m n) k))
    (lcm_dvd (Nat.dvd_trans (dvd_lcm_right m n) (dvd_lcm_left (lcm m n) k))
      (dvd_lcm_right (lcm m n) k)))

theorem lcm_ne_zero {m n : ℕ} (hm : m ≠ 0) (hn : n ≠ 0) : lcm m n ≠ 0 :=
by intro h
   have h1 := gcd_mul_lcm m n
   rw [h, Nat.mul_zero] at h1
   match eq_zero_of_mul_eq_zero h1.symm with
   | Or.inl hm1 => exact hm hm1
   | Or.inr hn1 => exact hn hn1

/-!
### `coprime`

See also `nat.coprime_of_dvd` and `nat.coprime_of_dvd'` to prove `nat.coprime m n`.
-/

instance (m n : ℕ) : Decidable (coprime m n) :=
  if h: gcd m n = 1 then isTrue h else isFalse h

theorem coprime_iff_gcd_eq_one {m n : ℕ} : coprime m n ↔ gcd m n = 1 := Iff.rfl

theorem coprime.gcd_eq_one {m n : ℕ} : coprime m n → gcd m n = 1 := id

theorem coprime.symm {m n : ℕ} : coprime n m → coprime m n := (gcd_comm m n).trans

theorem coprime_comm {m n : ℕ} : coprime n m ↔ coprime m n := ⟨coprime.symm, coprime.symm⟩

theorem coprime.dvd_of_dvd_mul_right {m n k : ℕ} (H1 : coprime k n) (H2 : k ∣ m * n) : k ∣ m :=
let t := dvd_gcd (Nat.dvd_mul_left k m) H2
by rwa [gcd_mul_left, H1.gcd_eq_one, Nat.mul_one] at t

theorem coprime.dvd_of_dvd_mul_left {m n k : ℕ} (H1 : coprime k m) (H2 : k ∣ m * n) : k ∣ n :=
by rw [Nat.mul_comm] at H2
   exact H1.dvd_of_dvd_mul_right H2

theorem coprime.gcd_mul_left_cancel {k : ℕ} (m : ℕ) {n : ℕ} (H : coprime k n) :
   gcd (k * m) n = gcd m n :=
let H1 : coprime (gcd (k * m) n) k :=
   by have h1 : coprime (gcd (k * m) n) k = (gcd (gcd (k * m) n) k = 1) := rfl
      rw [h1, Nat.gcd_assoc, H.symm.gcd_eq_one, gcd_one_right]
dvd_antisymm
  (dvd_gcd (H1.dvd_of_dvd_mul_left (gcd_dvd_left _ _)) (gcd_dvd_right _ _))
  (gcd_dvd_gcd_mul_left _ _ _)

theorem coprime.gcd_mul_right_cancel (m : ℕ) {k n : ℕ} (H : coprime k n) :
   gcd (m * k) n = gcd m n :=
by rw [Nat.mul_comm m k, H.gcd_mul_left_cancel m]

theorem coprime.gcd_mul_left_cancel_right {k m : ℕ} (n : ℕ) (H : coprime k m) :
   gcd m (k * n) = gcd m n :=
by rw [gcd_comm m n, gcd_comm m (k * n), H.gcd_mul_left_cancel n]

theorem coprime.gcd_mul_right_cancel_right {k m : ℕ} (n : ℕ) (H : coprime k m) :
   gcd m (n * k) = gcd m n :=
by rw [Nat.mul_comm n k, H.gcd_mul_left_cancel_right n]

theorem coprime_div_gcd_div_gcd {m n : ℕ} (H : 0 < gcd m n) :
  coprime (m / gcd m n) (n / gcd m n) :=
by rw [coprime_iff_gcd_eq_one, gcd_div (gcd_dvd_left m n) (gcd_dvd_right m n), Nat.div_self H]

theorem not_coprime_of_dvd_of_dvd {m n d : ℕ} (dgt1 : 1 < d) (Hm : d ∣ m) (Hn : d ∣ n) :
  ¬ coprime m n :=
λ co => by have hd : ¬ d ≤ 1 := Nat.not_le_of_gt dgt1
           have := (Nat.le_of_dvd Nat.zero_lt_one $ by rw [←co.gcd_eq_one]; exact dvd_gcd Hm Hn)
           exact hd this

theorem exists_coprime {m n : ℕ} (H : 0 < gcd m n) :
  ∃ m' n', coprime m' n' ∧ m = m' * gcd m n ∧ n = n' * gcd m n :=
⟨_, _, coprime_div_gcd_div_gcd H,
  (Nat.div_mul_cancel (gcd_dvd_left m n)).symm,
  (Nat.div_mul_cancel (gcd_dvd_right m n)).symm⟩

theorem exists_coprime' {m n : ℕ} (H : 0 < gcd m n) :
  ∃ g m' n', 0 < g ∧ coprime m' n' ∧ m = m' * g ∧ n = n' * g :=
  let ⟨m', n', h⟩ := exists_coprime H
  ⟨_, m', n', H, h⟩

theorem coprime.mul {m n k : ℕ} (H1 : coprime m k) (H2 : coprime n k) : coprime (m * n) k :=
(H1.gcd_mul_left_cancel n).trans H2

theorem coprime.mul_right {k m n : ℕ} (H1 : coprime k m) (H2 : coprime k n) : coprime k (m * n) :=
(H1.symm.mul H2.symm).symm

theorem coprime.coprime_dvd_left {m k n : ℕ} (H1 : m ∣ k) (H2 : coprime k n) : coprime m n :=
by apply eq_one_of_dvd_one
   have h1 : coprime k n = (gcd k n = 1) := rfl
   rw [h1] at H2
   have := @Nat.gcd_dvd_gcd_of_dvd_left m k n H1
   rwa [←H2]

theorem coprime.coprime_dvd_right {m k n : ℕ} (H1 : n ∣ m) (H2 : coprime k m) : coprime k n :=
(H2.symm.coprime_dvd_left H1).symm

theorem coprime.coprime_mul_left {k m n : ℕ} (H : coprime (k * m) n) : coprime m n :=
H.coprime_dvd_left (Nat.dvd_mul_left _ _)

theorem coprime.coprime_mul_right {k m n : ℕ} (H : coprime (m * k) n) : coprime m n :=
H.coprime_dvd_left (Nat.dvd_mul_right _ _)

theorem coprime.coprime_mul_left_right {k m n : ℕ} (H : coprime m (k * n)) : coprime m n :=
H.coprime_dvd_right (Nat.dvd_mul_left _ _)

theorem coprime.coprime_mul_right_right {k m n : ℕ} (H : coprime m (n * k)) : coprime m n :=
H.coprime_dvd_right (Nat.dvd_mul_right _ _)

theorem coprime.coprime_div_left {m n a : ℕ} (cmn : coprime m n) (dvd : a ∣ m) :
  coprime (m / a) n :=
match eq_zero_or_pos a with
| Or.inl h0 => by rw [h0] at dvd
                  rw [Nat.eq_zero_of_zero_dvd dvd]
                  rw [Nat.eq_zero_of_zero_dvd dvd] at cmn
                  simp
                  assumption
| Or.inr hpos =>
   match dvd with
   | ⟨k, hk⟩ => by rw [hk, Nat.mul_div_cancel_left _ hpos]
                   rw [hk] at cmn
                   exact coprime.coprime_mul_left cmn

theorem coprime.coprime_div_right {m n a : ℕ} (cmn : coprime m n) (dvd : a ∣ n) :
  coprime m (n / a) :=
(coprime.coprime_div_left cmn.symm dvd).symm

lemma coprime_mul_iff_left {k m n : ℕ} : coprime (m * n) k ↔ coprime m k ∧ coprime n k :=
⟨λ h => ⟨coprime.coprime_mul_right h, coprime.coprime_mul_left h⟩,
  λ ⟨h, _⟩ => by rwa [coprime_iff_gcd_eq_one, coprime.gcd_mul_left_cancel n h]⟩

lemma coprime_mul_iff_right {k m n : ℕ} : coprime k (m * n) ↔ coprime k m ∧ coprime k n :=
by rw [@coprime_comm (m*n) k, @coprime_comm m k, @coprime_comm n k, coprime_mul_iff_left]

lemma coprime.gcd_left (k : ℕ) {m n : ℕ} (hmn : coprime m n) : coprime (gcd k m) n :=
hmn.coprime_dvd_left $ gcd_dvd_right k m

lemma coprime.gcd_right (k : ℕ) {m n : ℕ} (hmn : coprime m n) : coprime m (gcd k n) :=
hmn.coprime_dvd_right $ gcd_dvd_right k n

lemma coprime.gcd_both (k l : ℕ) {m n : ℕ} (hmn : coprime m n) : coprime (gcd k m) (gcd l n) :=
(hmn.gcd_left k).gcd_right l

lemma coprime.mul_dvd_of_dvd_of_dvd {a n m : ℕ} (hmn : coprime m n)
  (hm : m ∣ a) (hn : n ∣ a) : m * n ∣ a :=
  let ⟨k, hk⟩ := hm
  hk.symm ▸ Nat.mul_dvd_mul_left _ (hmn.symm.dvd_of_dvd_mul_left (hk ▸ hn))

theorem coprime_one_left : ∀ n, coprime 1 n := gcd_one_left

theorem coprime_one_right : ∀ n, coprime n 1 := gcd_one_right

theorem coprime.pow_left {m k : ℕ} (n : ℕ) (H1 : coprime m k) : coprime (m ^ n) k :=
by induction n with
   | zero => exact coprime_one_left _
   | succ n ih => have hm := H1.mul ih
                  have : m ^ succ n = m * m ^ n := by rw [Nat.pow_succ, Nat.mul_comm]
                  rwa [this]

theorem coprime.pow_right {m k : ℕ} (n : ℕ) (H1 : coprime k m) : coprime k (m ^ n) :=
(H1.symm.pow_left n).symm

theorem coprime.pow {k l : ℕ} (m n : ℕ) (H1 : coprime k l) : coprime (k ^ m) (l ^ n) :=
(H1.pow_left _).pow_right _

theorem coprime.eq_one_of_dvd {k m : ℕ} (H : coprime k m) (d : k ∣ m) : k = 1 :=
by rw [← H.gcd_eq_one, gcd_eq_left d]

@[simp] theorem coprime_zero_left (n : ℕ) : coprime 0 n ↔ n = 1 :=
by simp [coprime]

@[simp] theorem coprime_zero_right (n : ℕ) : coprime n 0 ↔ n = 1 :=
by simp [coprime]

@[simp] theorem coprime_one_left_iff (n : ℕ) : coprime 1 n ↔ true :=
by simp [coprime]

@[simp] theorem coprime_one_right_iff (n : ℕ) : coprime n 1 ↔ true :=
by simp [coprime]

@[simp] theorem coprime_self (n : ℕ) : coprime n n ↔ n = 1 :=
by simp [coprime]

/-- Represent a divisor of `m * n` as a product of a divisor of `m` and a divisor of `n`. -/
def prod_dvd_and_dvd_of_dvd_prod {m n k : ℕ} (H : k ∣ m * n) :
  { d : {m' // m' ∣ m} × {n' // n' ∣ n} // k = d.1.val * d.2.val } :=
by cases h0 : gcd k m with
   | zero => have : k = 0 := eq_zero_of_gcd_eq_zero_left h0
             subst this
             have : m = 0 := eq_zero_of_gcd_eq_zero_right h0
             subst this
             exact ⟨⟨⟨0, Nat.dvd_refl 0⟩, ⟨n, Nat.dvd_refl n⟩⟩, (Nat.zero_mul n).symm⟩
   | succ p => have hpos : 0 < gcd k m := h0.symm ▸ Nat.zero_lt_succ _;
               clear h0
               have hd : gcd k m * (k / gcd k m) = k := (Nat.mul_div_cancel' (gcd_dvd_left k m))
               have hn : (k / gcd k m) ∣ n := by apply Nat.dvd_of_mul_dvd_mul_left hpos
                                                 rw [hd, ← gcd_mul_right]
                                                 exact Nat.dvd_gcd (Nat.dvd_mul_right _ _) H
               exact ⟨⟨⟨gcd k m,  gcd_dvd_right k m⟩, ⟨k / gcd k m, hn⟩⟩, hd.symm⟩

theorem gcd_mul_dvd_mul_gcd (k m n : ℕ) : gcd k (m * n) ∣ gcd k m * gcd k n :=
match (prod_dvd_and_dvd_of_dvd_prod $ gcd_dvd_right k (m * n)) with
| ⟨⟨⟨m', hm'⟩, ⟨n', hn'⟩⟩, h⟩ =>
  by have h' : gcd k (m * n) = m' * n' := h
     rw [h']
     have hm'n' : m' * n' ∣ k := h ▸ gcd_dvd_left _ _
     exact Nat.mul_dvd_mul
       (by have hm'k : m' ∣ k := Nat.dvd_trans (Nat.dvd_mul_right m' n') hm'n'
           exact dvd_gcd hm'k hm')
       (by have hn'k : n' ∣ k := Nat.dvd_trans (Nat.dvd_mul_left n' m') hm'n'
           exact dvd_gcd hn'k hn')

theorem coprime.gcd_mul (k : ℕ) {m n : ℕ} (h : coprime m n) : gcd k (m * n) = gcd k m * gcd k n :=
dvd_antisymm
  (gcd_mul_dvd_mul_gcd k m n)
  ((h.gcd_both k k).mul_dvd_of_dvd_of_dvd
    (gcd_dvd_gcd_mul_right_right _ _ _)
    (gcd_dvd_gcd_mul_left_right _ _ _))

-- TODO: pow_dvd_pow_iff

lemma gcd_mul_gcd_of_coprime_of_mul_eq_mul {a b c d : ℕ} (cop : c.coprime d) (h : a * b = c * d) :
  a.gcd c * b.gcd c = c :=
dvd_antisymm
  (by apply Nat.coprime.dvd_of_dvd_mul_right (Nat.coprime.mul (cop.gcd_left _) (cop.gcd_left _))
      rw [← h]
      apply Nat.mul_dvd_mul (gcd_dvd _ _).1 (gcd_dvd _ _).1)
  (by rw [gcd_comm a _, gcd_comm b _]
      have h1 : c ∣ gcd c (a * b) :=
        by rw [h, gcd_mul_right_right d c]
           exact Nat.dvd_refl _
      have h2 : gcd c (a * b) ∣ gcd c a * gcd c b :=
        by apply gcd_mul_dvd_mul_gcd
      exact Nat.dvd_trans h1 h2)


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Leonardo de Moura
-/
prelude
import init.data.nat init.data.fin.basic

namespace fin
open nat
variable {n : nat}

protected def succ : fin n → fin (succ n)
| ⟨a, h⟩ := ⟨nat.succ a, succ_lt_succ h⟩

def of_nat {n : nat} (a : nat) : fin (succ n) :=
⟨a % succ n, nat.mod_lt _ (nat.zero_lt_succ _)⟩

private lemma mlt {n b : nat} : ∀ {a}, n > a → b % n < n
| 0     h := nat.mod_lt _ h
| (a+1) h :=
  have n > 0, from lt_trans (nat.zero_lt_succ _) h,
  nat.mod_lt _ this

protected def add : fin n → fin n → fin n
| ⟨a, h⟩ ⟨b, _⟩ := ⟨(a + b) % n, mlt h⟩

protected def mul : fin n → fin n → fin n
| ⟨a, h⟩ ⟨b, _⟩ := ⟨(a * b) % n, mlt h⟩

private lemma sublt {a b n : nat} (h : a < n) : a - b < n :=
lt_of_le_of_lt (nat.sub_le a b) h

protected def sub : fin n → fin n → fin n
| ⟨a, h⟩ ⟨b, _⟩ := ⟨(a + (n - b)) % n, mlt h⟩

private lemma modlt {a b n : nat} (h₁ : a < n) (h₂ : b < n) : a % b < n :=
begin
  cases b with b,
  {simp [mod_zero], assumption},
  {have h : a % (succ b) < succ b,
   apply nat.mod_lt _ (nat.zero_lt_succ _),
   exact lt_trans h h₂}
end

protected def mod : fin n → fin n → fin n
| ⟨a, h₁⟩ ⟨b, h₂⟩ := ⟨a % b, modlt h₁ h₂⟩

private lemma divlt {a b n : nat} (h : a < n) : a / b < n :=
lt_of_le_of_lt (nat.div_le_self a b) h

protected def div : fin n → fin n → fin n
| ⟨a, h⟩ ⟨b, _⟩ := ⟨a / b, divlt h⟩

instance : has_zero (fin (succ n)) := ⟨⟨0, succ_pos n⟩⟩
instance : has_one (fin (succ n))  := ⟨of_nat 1⟩
instance : has_add (fin n)         := ⟨fin.add⟩
instance : has_sub (fin n)         := ⟨fin.sub⟩
instance : has_mul (fin n)         := ⟨fin.mul⟩
instance : has_mod (fin n)         := ⟨fin.mod⟩
instance : has_div (fin n)         := ⟨fin.div⟩

lemma of_nat_zero : @of_nat n 0 = 0 := rfl

lemma add_def (a b : fin n) : (a + b).val = (a.val + b.val) % n :=
show (fin.add a b).val = (a.val + b.val) % n, from
by cases a; cases b; simp [fin.add]

lemma mul_def (a b : fin n) : (a * b).val = (a.val * b.val) % n :=
show (fin.mul a b).val = (a.val * b.val) % n, from
by cases a; cases b; simp [fin.mul]

lemma sub_def (a b : fin n) : (a - b).val = (a.val + (n - b.val)) % n :=
by cases a; cases b; refl

lemma mod_def (a b : fin n) : (a % b).val = a.val % b.val :=
show (fin.mod a b).val = a.val % b.val, from
by cases a; cases b; simp [fin.mod]

lemma div_def (a b : fin n) : (a / b).val = a.val / b.val :=
show (fin.div a b).val = a.val / b.val, from
by cases a; cases b; simp [fin.div]

lemma lt_def (a b : fin n) : (a < b) = (a.val < b.val) :=
show (fin.lt a b) = (a.val < b.val), from
by cases a; cases b; simp [fin.lt]

lemma le_def (a b : fin n) : (a ≤ b) = (a.val ≤ b.val) :=
show (fin.le a b) = (a.val ≤ b.val), from
by cases a; cases b; simp [fin.le]

lemma val_zero : (0 : fin (succ n)).val = 0 := rfl

def pred {n : nat} : ∀ i : fin (succ n), i ≠ 0 → fin n
| ⟨a, h₁⟩ h₂ := ⟨a.pred,
  begin
    have this : a ≠ 0,
    { have aux₁ := vne_of_ne h₂,
      dsimp at aux₁, rw val_zero at aux₁, exact aux₁ },
    exact nat.pred_lt_pred this h₁
  end⟩

end fin


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import algebra.quaternion
import analysis.inner_product_space.basic

/-!
# Quaternions as a normed algebra

In this file we define the following structures on the space `ℍ := ℍ[ℝ]` of quaternions:

* inner product space;
* normed ring;
* normed space over `ℝ`.

## Notation

The following notation is available with `open_locale quaternion`:

* `ℍ` : quaternions

## Tags

quaternion, normed ring, normed space, normed algebra
-/

localized "notation `ℍ` := quaternion ℝ" in quaternion
open_locale real_inner_product_space

noncomputable theory

namespace quaternion

instance : has_inner ℝ ℍ := ⟨λ a b, (a * b.conj).re⟩

lemma inner_self (a : ℍ) : ⟪a, a⟫ = norm_sq a := rfl

lemma inner_def (a b : ℍ) : ⟪a, b⟫ = (a * b.conj).re := rfl

instance : inner_product_space ℝ ℍ :=
inner_product_space.of_core
{ inner := has_inner.inner,
  conj_sym := λ x y, by simp [inner_def, mul_comm],
  nonneg_re := λ x, norm_sq_nonneg,
  definite := λ x, norm_sq_eq_zero.1,
  add_left := λ x y z, by simp only [inner_def, add_mul, add_re],
  smul_left := λ x y r, by simp [inner_def] }

lemma norm_sq_eq_norm_sq (a : ℍ) : norm_sq a = ∥a∥ * ∥a∥ :=
by rw [← inner_self, real_inner_self_eq_norm_mul_norm]

instance : norm_one_class ℍ :=
⟨by rw [norm_eq_sqrt_real_inner, inner_self, norm_sq.map_one, real.sqrt_one]⟩

@[simp, norm_cast] lemma norm_coe (a : ℝ) : ∥(a : ℍ)∥ = ∥a∥ :=
by rw [norm_eq_sqrt_real_inner, inner_self, norm_sq_coe, real.sqrt_sq_eq_abs, real.norm_eq_abs]

@[simp, norm_cast] lemma nnnorm_coe (a : ℝ) : ∥(a : ℍ)∥₊ = ∥a∥₊ :=
subtype.ext $ norm_coe a

noncomputable instance : normed_division_ring ℍ :=
{ dist_eq := λ _ _, rfl,
  norm_mul' := λ a b, by { simp only [norm_eq_sqrt_real_inner, inner_self, norm_sq.map_mul],
                           exact real.sqrt_mul norm_sq_nonneg _ } }

noncomputable instance : normed_algebra ℝ ℍ :=
{ norm_smul_le := λ a x, (norm_smul a x).le,
  to_algebra := quaternion.algebra }

instance : has_coe ℂ ℍ := ⟨λ z, ⟨z.re, z.im, 0, 0⟩⟩

@[simp, norm_cast]

@[simp, norm_cast] lemma coe_complex_add (z w : ℂ) : ↑(z + w) = (z + w : ℍ) := by ext; simp
@[simp, norm_cast] lemma coe_complex_mul (z w : ℂ) : ↑(z * w) = (z * w : ℍ) := by ext; simp
@[simp, norm_cast] lemma coe_complex_zero : ((0 : ℂ) : ℍ) = 0 := rfl
@[simp, norm_cast] lemma coe_complex_one : ((1 : ℂ) : ℍ) = 1 := rfl
@[simp, norm_cast] lemma coe_real_complex_mul (r : ℝ) (z : ℂ) : (r • z : ℍ) = ↑r * ↑z :=
by ext; simp
@[simp, norm_cast] lemma coe_complex_coe (r : ℝ) : ((r : ℂ) : ℍ) = r := rfl

/-- Coercion `ℂ →ₐ[ℝ] ℍ` as an algebra homomorphism. -/
def of_complex : ℂ →ₐ[ℝ] ℍ :=
{ to_fun := coe,
  map_one' := rfl,
  map_zero' := rfl,
  map_add' := coe_complex_add,
  map_mul' := coe_complex_mul,
  commutes' := λ x, rfl }

@[simp] lemma coe_of_complex : ⇑of_complex = coe := rfl

end quaternion