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

/-!
# Orientations of modules and rays in modules

This file defines rays in modules and orientations of modules.

## Main definitions

* `module.ray` is a type for the equivalence class of nonzero vectors in a module with some
common positive multiple.

* `orientation` is a type synonym for `module.ray` for the case where the module is that of
alternating maps from a module to its underlying ring.  An orientation may be associated with an
alternating map or with a basis.

* `module.oriented` is a type class for a choice of orientation of a module that is considered
the positive orientation.

## Implementation notes

`orientation` is defined for an arbitrary index type, but the main intended use case is when
that index type is a `fintype` and there exists a basis of the same cardinality.

## References

* https://en.wikipedia.org/wiki/Orientation_(vector_space)

-/

noncomputable theory

open_locale big_operators

section ordered_comm_semiring

variables (R : Type*) [ordered_comm_semiring R]
variables {M : Type*} [add_comm_monoid M] [module R M]
variables {N : Type*} [add_comm_monoid N] [module R N]
variables (ι : Type*) [decidable_eq ι]

/-- Two vectors are in the same ray if some positive multiples of them are equal (in the typical
case over a field, this means each is a positive multiple of the other).  Over a field, this
is equivalent to `mul_action.orbit_rel`. -/
def same_ray (v₁ v₂ : M) : Prop :=
∃ (r₁ r₂ : R), 0 < r₁ ∧ 0 < r₂ ∧ r₁ • v₁ = r₂ • v₂

variables {R}

/-- `same_ray` is reflexive. -/
@[refl] lemma same_ray.refl [nontrivial R] (x : M) : same_ray R x x :=
⟨1, 1, zero_lt_one, zero_lt_one, rfl⟩

/-- `same_ray` is symmetric. -/
@[symm] lemma same_ray.symm {x y : M} : same_ray R x y → same_ray R y x :=
λ ⟨r₁, r₂, hr₁, hr₂, h⟩, ⟨r₂, r₁, hr₂, hr₁, h.symm⟩

/-- `same_ray` is transitive. -/
@[trans] lemma same_ray.trans {x y z : M} : same_ray R x y → same_ray R y z → same_ray R x z :=
λ ⟨r₁, r₂, hr₁, hr₂, h₁⟩ ⟨r₃, r₄, hr₃, hr₄, h₂⟩,
  ⟨r₃ * r₁, r₂ * r₄, mul_pos hr₃ hr₁, mul_pos hr₂ hr₄,
   by rw [mul_smul, mul_smul, h₁, ←h₂, smul_comm]⟩

lemma same_ray_comm {x y : M} : same_ray R x y ↔ same_ray R y x :=
⟨same_ray.symm, same_ray.symm⟩

variables (R M)

/-- `same_ray` is an equivalence relation. -/
lemma equivalence_same_ray [nontrivial R] : equivalence (same_ray R : M → M → Prop) :=
⟨same_ray.refl, λ _ _, same_ray.symm, λ _ _ _, same_ray.trans⟩

variables {R M}

/-- A vector is in the same ray as a positive multiple of itself. -/
lemma same_ray_pos_smul_right (v : M) {r : R} (h : 0 < r) : same_ray R v (r • v) :=
⟨r, 1, h, let f := nontrivial_of_lt _ _ h in by exactI zero_lt_one, (one_smul _ _).symm⟩

/-- A vector is in the same ray as a positive multiple of one it is in the same ray as. -/
lemma same_ray.pos_smul_right {v₁ v₂ : M} {r : R} (h : same_ray R v₁ v₂) (hr : 0 < r) :
  same_ray R v₁ (r • v₂) :=
h.trans (same_ray_pos_smul_right v₂ hr)

/-- A positive multiple of a vector is in the same ray as that vector. -/
lemma same_ray_pos_smul_left (v : M) {r : R} (h : 0 < r) : same_ray R (r • v) v :=
⟨1, r, let f := nontrivial_of_lt _ _ h in by exactI zero_lt_one, h, one_smul _ _⟩

/-- A positive multiple of a vector is in the same ray as one it is in the same ray as. -/
lemma same_ray.pos_smul_left {v₁ v₂ : M} {r : R} (h : same_ray R v₁ v₂) (hr : 0 < r) :
  same_ray R (r • v₁) v₂ :=
(same_ray_pos_smul_left v₁ hr).trans h

/-- If two vectors are on the same ray then they remain so after appling a linear map. -/
lemma same_ray.map {v₁ v₂ : M} (f : M →ₗ[R] N)
  (h : same_ray R v₁ v₂) : same_ray R (f v₁) (f v₂) :=
let ⟨r₁, r₂, hr₁, hr₂, h⟩ := h in
⟨r₁, r₂, hr₁, hr₂, by rw [←f.map_smul, ←f.map_smul, h]⟩

/-- If two vectors are on the same ray then they remain so after appling a linear equivalence. -/
@[simp] lemma same_ray_map_iff {v₁ v₂ : M} (e : M ≃ₗ[R] N) :
  same_ray R (e v₁) (e v₂) ↔ same_ray R v₁ v₂ :=
⟨λ h, by simpa using same_ray.map e.symm.to_linear_map h, same_ray.map e.to_linear_map⟩

/-- If two vectors are on the same ray then both scaled by the same action are also on the same
ray. -/
lemma same_ray.smul {S : Type*} [has_scalar S M] [smul_comm_class R S M] {v₁ v₂ : M} (s : S)
  (h : same_ray R v₁ v₂) : same_ray R (s • v₁) (s • v₂) :=
let ⟨r₁, r₂, hr₁, hr₂, h⟩ := h in
⟨r₁, r₂, hr₁, hr₂, by rw [smul_comm r₁ s v₁, smul_comm r₂ s v₂, h]⟩

variables (R M)

/-- The setoid of the `same_ray` relation for elements of a module. -/
def same_ray_setoid [nontrivial R] : setoid M :=
{ r := same_ray R, iseqv := equivalence_same_ray R M }

/-- Nonzero vectors, as used to define rays. -/
@[reducible] def ray_vector := {v : M // v ≠ 0}

/-- The setoid of the `same_ray` relation for the subtype of nonzero vectors. -/
def ray_vector.same_ray_setoid [nontrivial R] : setoid (ray_vector M) :=
(same_ray_setoid R M).comap coe

local attribute [instance] ray_vector.same_ray_setoid

variables {R M}

/-- Equivalence of nonzero vectors, in terms of same_ray. -/
lemma equiv_iff_same_ray [nontrivial R] (v₁ v₂ : ray_vector M) :
  v₁ ≈ v₂ ↔ same_ray R (v₁ : M) v₂ :=
iff.rfl

variables (R M)

/-- A ray (equivalence class of nonzero vectors with common positive multiples) in a module. -/
@[nolint has_inhabited_instance]
def module.ray [nontrivial R] := quotient (ray_vector.same_ray_setoid R M)

/-- An orientation of a module, intended to be used when `ι` is a `fintype` with the same
cardinality as a basis. -/
abbreviation orientation [nontrivial R] := module.ray R (alternating_map R M R ι)

/-- A type class fixing an orientation of a module. -/
class module.oriented [nontrivial R] :=
(positive_orientation : orientation R M ι)

variables {M}

/-- The ray given by a nonzero vector. -/
protected def ray_of_ne_zero [nontrivial R] (v : M) (h : v ≠ 0) : module.ray R M :=
⟦⟨v, h⟩⟧

/-- An induction principle for `module.ray`, used as `induction x using module.ray.ind`. -/
lemma module.ray.ind [nontrivial R] {C : module.ray R M → Prop}
  (h : Π v (hv : v ≠ 0), C (ray_of_ne_zero R v hv)) (x : module.ray R M) : C x :=
quotient.ind (subtype.rec $ by exact h) x

/-- The rays given by two nonzero vectors are equal if and only if those vectors
satisfy `same_ray`. -/
lemma ray_eq_iff [nontrivial R] {v₁ v₂ : M} (hv₁ : v₁ ≠ 0) (hv₂ : v₂ ≠ 0) :
  ray_of_ne_zero R _ hv₁ = ray_of_ne_zero R _ hv₂ ↔ same_ray R v₁ v₂ :=
quotient.eq

variables {R}

/-- The ray given by a positive multiple of a nonzero vector. -/
@[simp] lemma ray_pos_smul [nontrivial R] {v : M} (h : v ≠ 0) {r : R} (hr : 0 < r)
  (hrv : r • v ≠ 0) : ray_of_ne_zero R _ hrv = ray_of_ne_zero R _ h :=
begin
  rw ray_eq_iff,
  exact same_ray_pos_smul_left v hr
end

/-- An equivalence between modules implies an equivalence between ray vectors. -/
def ray_vector.map_linear_equiv (e : M ≃ₗ[R] N) : ray_vector M ≃ ray_vector N :=
equiv.subtype_equiv e.to_equiv $ λ _, e.map_ne_zero_iff.symm

/-- An equivalence between modules implies an equivalence between rays. -/
def module.ray.map [nontrivial R] (e : M ≃ₗ[R] N) : module.ray R M ≃ module.ray R N :=
quotient.congr (ray_vector.map_linear_equiv e) $ λ ⟨a, ha⟩ ⟨b, hb⟩, (same_ray_map_iff _).symm

@[simp] lemma module.ray.map_apply [nontrivial R] (e : M ≃ₗ[R] N) (v : M) (hv : v ≠ 0) :
  module.ray.map e (ray_of_ne_zero _ v hv) = ray_of_ne_zero _ (e v) (e.map_ne_zero_iff.2 hv) := rfl

@[simp] lemma module.ray.map_refl [nontrivial R] :
  (module.ray.map $ linear_equiv.refl R M) = equiv.refl _ :=
equiv.ext $ module.ray.ind R $ λ _ _, rfl

@[simp] lemma module.ray.map_symm [nontrivial R] (e : M ≃ₗ[R] N) :
  (module.ray.map e).symm = module.ray.map e.symm := rfl

/-- An equivalence between modules implies an equivalence between orientations. -/
def orientation.map [nontrivial R] (e : M ≃ₗ[R] N) : orientation R M ι ≃ orientation R N ι :=
module.ray.map $ alternating_map.dom_lcongr R R ι R e

@[simp] lemma orientation.map_apply [nontrivial R] (e : M ≃ₗ[R] N) (v : alternating_map R M R ι)
  (hv : v ≠ 0) :
  orientation.map ι e (ray_of_ne_zero _ v hv) = ray_of_ne_zero _ (v.comp_linear_map e.symm)
      (mt (v.comp_linear_equiv_eq_zero_iff e.symm).mp hv) := rfl

@[simp] lemma orientation.map_refl [nontrivial R] :
  (orientation.map ι $ linear_equiv.refl R M) = equiv.refl _ :=
by rw [orientation.map, alternating_map.dom_lcongr_refl, module.ray.map_refl]

@[simp] lemma orientation.map_symm [nontrivial R] (e : M ≃ₗ[R] N) :
  (orientation.map ι e).symm = orientation.map ι e.symm := rfl

section action
variables {G : Type*} [group G] [nontrivial R] [distrib_mul_action G M] [smul_comm_class R G M]

/-- Any invertible action preserves the non-zeroness of ray vectors. This is primarily of interest
when `G = Rˣ` -/
instance : mul_action G (ray_vector M) :=
{ smul := λ r, (subtype.map ((•) r) $ λ a, (smul_ne_zero_iff_ne _).2),
  mul_smul := λ a b m, subtype.ext $ mul_smul a b _,
  one_smul := λ m, subtype.ext $ one_smul _ _ }

/-- Any invertible action preserves the non-zeroness of rays. This is primarily of interest when
`G = Rˣ` -/
instance : mul_action G (module.ray R M) :=
{ smul := λ r, quotient.map ((•) r) (λ a b, same_ray.smul _),
  mul_smul := λ a b, quotient.ind $ by exact(λ m, congr_arg quotient.mk $ mul_smul a b _),
  one_smul := quotient.ind $ by exact (λ m, congr_arg quotient.mk $ one_smul _ _), }

/-- The action via `linear_equiv.apply_distrib_mul_action` corresponds to `module.ray.map`. -/
@[simp] lemma module.ray.linear_equiv_smul_eq_map (e : M ≃ₗ[R] M) (v : module.ray R M) :
  e • v = module.ray.map e v := rfl

@[simp] lemma smul_ray_of_ne_zero (g : G) (v : M) (hv) :
  g • ray_of_ne_zero R v hv = ray_of_ne_zero R (g • v) ((smul_ne_zero_iff_ne _).2 hv) := rfl

end action

namespace module.ray

/-- Scaling by a positive unit is a no-op. -/
lemma units_smul_of_pos [nontrivial R] (u : Rˣ) (hu : 0 < (u : R)) (v : module.ray R M) :
  u • v = v :=
begin
  induction v using module.ray.ind,
  rw [smul_ray_of_ne_zero, ray_eq_iff],
  exact same_ray_pos_smul_left _ hu,
end

/-- An arbitrary `ray_vector` giving a ray. -/
def some_ray_vector [nontrivial R] (x : module.ray R M) : ray_vector M :=
quotient.out x

/-- The ray of `some_ray_vector`. -/
@[simp] lemma some_ray_vector_ray [nontrivial R] (x : module.ray R M) :
  (⟦x.some_ray_vector⟧ : module.ray R M) = x :=
quotient.out_eq _

/-- An arbitrary nonzero vector giving a ray. -/
def some_vector [nontrivial R] (x : module.ray R M) : M :=
x.some_ray_vector

/-- `some_vector` is nonzero. -/
@[simp] lemma some_vector_ne_zero [nontrivial R] (x : module.ray R M) : x.some_vector ≠ 0 :=
x.some_ray_vector.property

/-- The ray of `some_vector`. -/
@[simp] lemma some_vector_ray [nontrivial R] (x : module.ray R M) :
  ray_of_ne_zero R _ x.some_vector_ne_zero = x :=
(congr_arg _ (subtype.coe_eta _ _) : _).trans x.out_eq

end module.ray

end ordered_comm_semiring

section ordered_comm_ring

local attribute [instance] ray_vector.same_ray_setoid

variables {R : Type*} [ordered_comm_ring R]
variables {M N : Type*} [add_comm_group M] [add_comm_group N] [module R M] [module R N]

/-- If two vectors are in the same ray, so are their negations. -/
lemma same_ray.neg {v₁ v₂ : M} : same_ray R v₁ v₂ → same_ray R (-v₁) (-v₂) :=
λ ⟨r₁, r₂, hr₁, hr₂, h⟩, ⟨r₁, r₂, hr₁, hr₂, by rwa [smul_neg, smul_neg, neg_inj]⟩

/-- `same_ray.neg` as an `iff`. -/
@[simp] lemma same_ray_neg_iff {v₁ v₂ : M} : same_ray R (-v₁) (-v₂) ↔ same_ray R v₁ v₂ :=
⟨λ h, by simpa only [neg_neg] using h.neg, same_ray.neg⟩

lemma same_ray_neg_swap {v₁ v₂ : M} : same_ray R (-v₁) v₂ ↔ same_ray R v₁ (-v₂) :=
⟨λ h, by simpa only [neg_neg] using h.neg, λ h, by simpa only [neg_neg] using h.neg⟩

/-- If a vector is in the same ray as its negation, that vector is zero. -/
lemma eq_zero_of_same_ray_self_neg [no_zero_smul_divisors R M] {v₁ : M} (h : same_ray R v₁ (-v₁)) :
  v₁ = 0 :=
begin
  rcases h with ⟨r₁, r₂, hr₁, hr₂, h⟩,
  rw [smul_neg, ←neg_smul, ←sub_eq_zero, ←sub_smul, sub_neg_eq_add, smul_eq_zero] at h,
  exact h.resolve_left (add_pos hr₁ hr₂).ne',
end

namespace ray_vector

variables {R}

/-- Negating a nonzero vector. -/
instance : has_neg (ray_vector M) := ⟨λ v, ⟨-v, neg_ne_zero.2 v.prop⟩⟩

/-- Negating a nonzero vector commutes with coercion to the underlying module. -/
@[simp, norm_cast] lemma coe_neg (v : ray_vector M) : ↑(-v) = -(v : M) := rfl

/-- Negating a nonzero vector twice produces the original vector. -/
@[simp] protected lemma neg_neg (v : ray_vector M) : -(-v) = v :=
by rw [subtype.ext_iff, coe_neg, coe_neg, neg_neg]

variables (R)

/-- If two nonzero vectors are equivalent, so are their negations. -/
@[simp] lemma equiv_neg_iff [nontrivial R] (v₁ v₂ : ray_vector M) : -v₁ ≈ -v₂ ↔ v₁ ≈ v₂ :=
by rw [equiv_iff_same_ray, equiv_iff_same_ray, coe_neg, coe_neg, same_ray_neg_iff]

end ray_vector

variables (R)

/-- Negating a ray. -/
instance [nontrivial R] : has_neg (module.ray R M) :=
⟨quotient.map (λ v, -v) (λ v₁ v₂, (ray_vector.equiv_neg_iff R v₁ v₂).2)⟩

/-- The ray given by the negation of a nonzero vector. -/
lemma ray_neg [nontrivial R] (v : M) (h : v ≠ 0) :
  ray_of_ne_zero R _ (show -v ≠ 0, by rw neg_ne_zero; exact h) = -(ray_of_ne_zero R _ h) :=
rfl

namespace module.ray

variables {R}

/-- Negating a ray twice produces the original ray. -/
@[simp] protected lemma neg_neg [nontrivial R] (x : module.ray R M) : -(-x) = x :=
quotient.ind (λ a, congr_arg quotient.mk $ ray_vector.neg_neg _) x

variables (R M)

/-- Negating a ray is involutive. -/
lemma neg_involutive [nontrivial R] : function.involutive (λ x : module.ray R M, -x) :=
λ x, module.ray.neg_neg x

variables {R M}

protected lemma eq_neg_iff_eq_neg [nontrivial R] (x y : module.ray R M) : x = -y ↔ y = -x :=
by rw [←module.ray.neg_neg x, (neg_involutive R M).injective.eq_iff, module.ray.neg_neg x, eq_comm]

/-- A ray does not equal its own negation. -/
lemma ne_neg_self [nontrivial R] [no_zero_smul_divisors R M] (x : module.ray R M) : x ≠ -x :=
begin
  intro h,
  induction x using module.ray.ind,
  rw [←ray_neg, ray_eq_iff] at h,
  exact x_hv (eq_zero_of_same_ray_self_neg h)
end

/-- Scaling by a negative unit is negation. -/
lemma units_smul_of_neg [nontrivial R] (u : Rˣ) (hu : (u : R) < 0) (v : module.ray R M) :
  u • v = -v :=
begin
  induction v using module.ray.ind,
  rw [smul_ray_of_ne_zero, ←ray_neg, ray_eq_iff, ←same_ray_neg_swap, units.smul_def, ←neg_smul],
  exact same_ray_pos_smul_left _ (neg_pos_of_neg hu),
end

end module.ray

namespace basis

variables {R} {ι : Type*} [fintype ι] [decidable_eq ι]

/-- The orientation given by a basis. -/
protected def orientation [nontrivial R] (e : basis ι R M) : orientation R M ι :=
ray_of_ne_zero R _ e.det_ne_zero

lemma orientation_map [nontrivial R] (e : basis ι R M)
  (f : M ≃ₗ[R] N) : (e.map f).orientation = orientation.map ι f e.orientation :=
by simp_rw [basis.orientation, orientation.map_apply, basis.det_map']

/-- The value of `orientation.map` when the index type has the cardinality of a basis, in terms
of `f.det`. -/
lemma map_orientation_eq_det_inv_smul [nontrivial R] [is_domain R] (e : basis ι R M)
  (x : orientation R M ι) (f : M ≃ₗ[R] M) : orientation.map ι f x = (f.det)⁻¹ • x :=
begin
  induction x using module.ray.ind with g hg,
  rw [orientation.map_apply, smul_ray_of_ne_zero, ray_eq_iff, units.smul_def,
      (g.comp_linear_map ↑f.symm).eq_smul_basis_det e, g.eq_smul_basis_det e,
      alternating_map.comp_linear_map_apply, alternating_map.smul_apply, basis.det_comp,
      basis.det_self, mul_one, smul_eq_mul, mul_comm, mul_smul, linear_equiv.coe_inv_det],
end

/-- The orientation given by a basis derived using `units_smul`, in terms of the product of those
units. -/
lemma orientation_units_smul [nontrivial R] (e : basis ι R M) (w : ι → units R) :
  (e.units_smul w).orientation = (∏ i, w i)⁻¹ • e.orientation :=
begin
  rw [basis.orientation, basis.orientation, smul_ray_of_ne_zero, ray_eq_iff,
      e.det.eq_smul_basis_det (e.units_smul w), det_units_smul, units.smul_def, smul_smul],
  norm_cast,
  simp
end

end basis

end ordered_comm_ring

section linear_ordered_comm_ring

variables {R : Type*} [linear_ordered_comm_ring R]
variables {M : Type*} [add_comm_group M] [module R M]
variables {ι : Type*} [decidable_eq ι]

/-- `same_ray` follows from membership of `mul_action.orbit` for the `units.pos_subgroup`. -/
lemma same_ray_of_mem_orbit {v₁ v₂ : M} (h : v₁ ∈ mul_action.orbit (units.pos_subgroup R) v₂) :
  same_ray R v₁ v₂ :=
begin
  rcases h with ⟨⟨r, hr⟩, (rfl : r • v₂ = v₁)⟩,
  exact same_ray_pos_smul_left _ hr,
end

/-- Scaling by an inverse unit is the same as scaling by itself. -/
@[simp] lemma units_inv_smul (u : Rˣ) (v : module.ray R M) :
  u⁻¹ • v = u • v :=
begin
  induction v using module.ray.ind with v hv,
  rw [smul_ray_of_ne_zero, smul_ray_of_ne_zero, ray_eq_iff],
  have : ∀ {u : Rˣ}, 0 < (u : R) → same_ray R (u⁻¹ • v) (u • v) :=
    λ u h, ((same_ray.refl v).pos_smul_left $ units.inv_pos.mpr h).pos_smul_right h,
  cases lt_or_lt_iff_ne.2 u.ne_zero,
  { rw [←units.neg_neg u, units.neg_inv, (- u).neg_smul, units.neg_smul],
    refine (this _).neg,
    exact neg_pos_of_neg h },
  { exact this h, },
end

section
variables [no_zero_smul_divisors R M]

/-- A nonzero vector is in the same ray as a multiple of itself if and only if that multiple
is positive. -/
@[simp] lemma same_ray_smul_right_iff {v : M} (hv : v ≠ 0) (r : R) :
  same_ray R v (r • v) ↔ 0 < r :=
begin
  split,
  { rintros ⟨r₁, r₂, hr₁, hr₂, h⟩,
    rw [smul_smul, ←sub_eq_zero, ←sub_smul, sub_eq_add_neg, neg_mul_eq_mul_neg] at h,
    by_contradiction hr,
    rw [not_lt, ←neg_le_neg_iff, neg_zero] at hr,
    have hzzz := ne_of_gt (add_pos_of_pos_of_nonneg hr₁ (mul_nonneg hr₂.le hr)),
    simpa [ne_of_gt (add_pos_of_pos_of_nonneg hr₁ (mul_nonneg hr₂.le hr)),
           -mul_neg_eq_neg_mul_symm] using h },
  { exact λ h, same_ray_pos_smul_right v h }
end

/-- A multiple of a nonzero vector is in the same ray as that vector if and only if that multiple
is positive. -/
@[simp] lemma same_ray_smul_left_iff {v : M} (hv : v ≠ 0) (r : R) :
  same_ray R (r • v) v ↔ 0 < r :=
begin
  rw same_ray_comm,
  exact same_ray_smul_right_iff hv r
end

/-- The negation of a nonzero vector is in the same ray as a multiple of that vector if and
only if that multiple is negative. -/
@[simp] lemma same_ray_neg_smul_right_iff {v : M} (hv : v ≠ 0) (r : R) :
  same_ray R (-v) (r • v) ↔ r < 0 :=
begin
  rw [←same_ray_neg_iff, neg_neg, ←neg_smul, same_ray_smul_right_iff hv (-r)],
  exact right.neg_pos_iff
end

/-- A multiple of a nonzero vector is in the same ray as the negation of that vector if and
only if that multiple is negative. -/
@[simp] lemma same_ray_neg_smul_left_iff {v : M} (hv : v ≠ 0) (r : R) :
  same_ray R (r • v) (-v) ↔ r < 0 :=
begin
  rw [←same_ray_neg_iff, neg_neg, ←neg_smul, same_ray_smul_left_iff hv (-r)],
  exact left.neg_pos_iff
end

/-- A nonzero vector is in the same ray as a multiple of itself if and only if that multiple
is positive. -/
@[simp] lemma units_smul_eq_self_iff {u : Rˣ} {v : module.ray R M} :
  u • v = v ↔ (0 : R) < u :=
begin
  induction v using module.ray.ind with v hv,
  rw [smul_ray_of_ne_zero, ray_eq_iff, units.smul_def],
  exact same_ray_smul_left_iff hv _,
end

/-- A nonzero vector is in the same ray as a multiple of itself if and only if that multiple
is positive. -/
@[simp] lemma units_smul_eq_neg_iff {u : Rˣ} {v : module.ray R M} :
  u • v = -v ↔ ↑u < (0 : R) :=
begin
  induction v using module.ray.ind with v hv,
  rw [smul_ray_of_ne_zero, ←ray_neg, ray_eq_iff, units.smul_def],
  exact same_ray_neg_smul_left_iff hv _,
end

end

namespace basis

variables [fintype ι]

/-- The orientations given by two bases are equal if and only if the determinant of one basis
with respect to the other is positive. -/
lemma orientation_eq_iff_det_pos (e₁ e₂ : basis ι R M) :
  e₁.orientation = e₂.orientation ↔ 0 < e₁.det e₂ :=
by rw [basis.orientation, basis.orientation, ray_eq_iff,
       e₁.det.eq_smul_basis_det e₂, alternating_map.smul_apply, basis.det_self, smul_eq_mul,
       mul_one, same_ray_smul_left_iff e₂.det_ne_zero (_ : R)]

/-- Given a basis, any orientation equals the orientation given by that basis or its negation. -/
lemma orientation_eq_or_eq_neg (e : basis ι R M) (x : orientation R M ι) :
  x = e.orientation ∨ x = -e.orientation :=
begin
  induction x using module.ray.ind with x hx,
  rw [basis.orientation, ray_eq_iff, ←ray_neg, ray_eq_iff, x.eq_smul_basis_det e,
    same_ray_neg_smul_left_iff e.det_ne_zero (_ : R), same_ray_smul_left_iff e.det_ne_zero (_ : R),
    lt_or_lt_iff_ne, ne_comm, alternating_map.map_basis_ne_zero_iff],
  exact hx
end

/-- Given a basis, an orientation equals the negation of that given by that basis if and only
if it does not equal that given by that basis. -/
lemma orientation_ne_iff_eq_neg (e : basis ι R M) (x : orientation R M ι) :
  x ≠ e.orientation ↔ x = -e.orientation :=
⟨λ h, (e.orientation_eq_or_eq_neg x).resolve_left h,
 λ h, h.symm ▸ (module.ray.ne_neg_self e.orientation).symm⟩

/-- Composing a basis with a linear equiv gives the same orientation if and only if the
determinant is positive. -/
lemma orientation_comp_linear_equiv_eq_iff_det_pos (e : basis ι R M) (f : M ≃ₗ[R] M) :
  (e.map f).orientation = e.orientation ↔ 0 < (f : M →ₗ[R] M).det :=
by rw [orientation_map, e.map_orientation_eq_det_inv_smul, units_inv_smul, units_smul_eq_self_iff,
  linear_equiv.coe_det]

/-- Composing a basis with a linear equiv gives the negation of that orientation if and only if
the determinant is negative. -/
lemma orientation_comp_linear_equiv_eq_neg_iff_det_neg (e : basis ι R M) (f : M ≃ₗ[R] M) :
  (e.map f).orientation = -e.orientation ↔ (f : M →ₗ[R] M).det < 0 :=
by rw [orientation_map, e.map_orientation_eq_det_inv_smul, units_inv_smul, units_smul_eq_neg_iff,
  linear_equiv.coe_det]

/-- Negating a single basis vector (represented using `units_smul`) negates the corresponding
orientation. -/
@[simp] lemma orientation_neg_single [nontrivial R] (e : basis ι R M) (i : ι) :
  (e.units_smul (function.update 1 i (-1))).orientation = -e.orientation :=
begin
  rw [orientation_units_smul, finset.prod_update_of_mem (finset.mem_univ _)],
  simp
end

/-- Given a basis and an orientation, return a basis giving that orientation: either the original
basis, or one constructed by negating a single (arbitrary) basis vector. -/
def adjust_to_orientation [nontrivial R] [nonempty ι] (e : basis ι R M) (x : orientation R M ι) :
  basis ι R M :=
by haveI := classical.dec_eq (orientation R M ι); exact if e.orientation = x then e else
  (e.units_smul (function.update 1 (classical.arbitrary ι) (-1)))

/-- `adjust_to_orientation` gives a basis with the required orientation. -/
@[simp] lemma orientation_adjust_to_orientation [nontrivial R] [nonempty ι] (e : basis ι R M)
  (x : orientation R M ι) : (e.adjust_to_orientation x).orientation = x :=
begin
  rw adjust_to_orientation,
  split_ifs with h,
  { exact h },
  { rw [orientation_neg_single, eq_comm, ←orientation_ne_iff_eq_neg, ne_comm],
    exact h }
end

/-- Every basis vector from `adjust_to_orientation` is either that from the original basis or its
negation. -/
lemma adjust_to_orientation_apply_eq_or_eq_neg [nontrivial R] [nonempty ι] (e : basis ι R M)
  (x : orientation R M ι) (i : ι) :
  e.adjust_to_orientation x i = e i ∨ e.adjust_to_orientation x i = -(e i) :=
begin
  rw adjust_to_orientation,
  split_ifs with h,
  { simp },
  { by_cases hi : i = classical.arbitrary ι;
      simp [units_smul_apply, hi] }
end

end basis

end linear_ordered_comm_ring

section linear_ordered_field

variables (R : Type*) [linear_ordered_field R]
variables {M : Type*} [add_comm_group M] [module R M]
variables {ι : Type*} [decidable_eq ι]

/-- `same_ray` is equivalent to membership of `mul_action.orbit` for the `units.pos_subgroup`. -/
lemma same_ray_iff_mem_orbit (v₁ v₂ : M) :
  same_ray R v₁ v₂ ↔ v₁ ∈ mul_action.orbit (units.pos_subgroup R) v₂ :=
begin
  split,
  { rintros ⟨r₁, r₂, hr₁, hr₂, h⟩,
    rw mul_action.mem_orbit_iff,
    have h' : (r₁⁻¹ * r₂) • v₂ = v₁,
    { rw [mul_smul, ←h, ←mul_smul, inv_mul_cancel (ne_of_lt hr₁).symm, one_smul] },
    have hr' : 0 < (r₁⁻¹ * r₂) := mul_pos (inv_pos.2 hr₁) hr₂,
    change (⟨units.mk0 (r₁⁻¹ * r₂) (ne_of_lt hr').symm, hr'⟩ : units.pos_subgroup R) • v₂ = v₁
      at h',
    exact ⟨_, h'⟩ },
  { exact same_ray_of_mem_orbit }
end

/-- `same_ray_setoid` equals `mul_action.orbit_rel` for the `units.pos_subgroup`. -/
lemma same_ray_setoid_eq_orbit_rel :
  same_ray_setoid R M = mul_action.orbit_rel (units.pos_subgroup R) M :=
setoid.ext' $ same_ray_iff_mem_orbit R

variables {R}

namespace orientation

variables [fintype ι] [finite_dimensional R M]

open finite_dimensional

/-- If the index type has cardinality equal to the finite dimension, any two orientations are
equal or negations. -/
lemma eq_or_eq_neg (x₁ x₂ : orientation R M ι) (h : fintype.card ι = finrank R M) :
  x₁ = x₂ ∨ x₁ = -x₂ :=
begin
  have e := (fin_basis R M).reindex (fintype.equiv_fin_of_card_eq h).symm,
  rcases e.orientation_eq_or_eq_neg x₁ with h₁|h₁;
    rcases e.orientation_eq_or_eq_neg x₂ with h₂|h₂;
    simp [h₁, h₂]
end

/-- If the index type has cardinality equal to the finite dimension, an orientation equals the
negation of another orientation if and only if they are not equal. -/
lemma ne_iff_eq_neg (x₁ x₂ : orientation R M ι) (h : fintype.card ι = finrank R M) :
  x₁ ≠ x₂ ↔ x₁ = -x₂ :=
⟨λ hn, (eq_or_eq_neg x₁ x₂ h).resolve_left hn, λ he, he.symm ▸ (module.ray.ne_neg_self x₂).symm⟩

/-- The value of `orientation.map` when the index type has cardinality equal to the finite
dimension, in terms of `f.det`. -/
lemma map_eq_det_inv_smul (x : orientation R M ι) (f : M ≃ₗ[R] M)
  (h : fintype.card ι = finrank R M) :
  orientation.map ι f x = (f.det)⁻¹ • x :=
begin
  have e := (fin_basis R M).reindex (fintype.equiv_fin_of_card_eq h).symm,
  exact e.map_orientation_eq_det_inv_smul x f
end

/-- If the index type has cardinality equal to the finite dimension, composing an alternating
map with the same linear equiv on each argument gives the same orientation if and only if the
determinant is positive. -/
lemma map_eq_iff_det_pos (x : orientation R M ι) (f : M ≃ₗ[R] M)
  (h : fintype.card ι = finrank R M) :
  orientation.map ι f x = x ↔  0 < (f : M →ₗ[R] M).det :=
by rw [map_eq_det_inv_smul _ _ h, units_inv_smul, units_smul_eq_self_iff, linear_equiv.coe_det]

/-- If the index type has cardinality equal to the finite dimension, composing an alternating
map with the same linear equiv on each argument gives the negation of that orientation if and
only if the determinant is negative. -/
lemma map_eq_neg_iff_det_neg (x : orientation R M ι) (f : M ≃ₗ[R] M)
  (h : fintype.card ι = finrank R M) :
  orientation.map ι f x = -x ↔ (f : M →ₗ[R] M).det < 0 :=
by rw [map_eq_det_inv_smul _ _ h, units_inv_smul, units_smul_eq_neg_iff, linear_equiv.coe_det]

/-- If the index type has cardinality equal to the finite dimension, a basis with the given
orientation. -/
def some_basis [nonempty ι] (x : orientation R M ι) (h : fintype.card ι = finrank R M) :
  basis ι R M :=
((fin_basis R M).reindex (fintype.equiv_fin_of_card_eq h).symm).adjust_to_orientation x

/-- `some_basis` gives a basis with the required orientation. -/
@[simp] lemma some_basis_orientation [nonempty ι] (x : orientation R M ι)
  (h : fintype.card ι = finrank R M) : (x.some_basis h).orientation = x :=
basis.orientation_adjust_to_orientation _ _

end orientation

end linear_ordered_field


lemma mul_one (m : mynat) : m * 1 = m :=
begin
rw one_eq_succ_zero,
rw mul_succ,
rw mul_zero,
rw zero_add,
refl,
end


theorem ex1 (x y : Nat) (h : x + 2 = y + 2) : x = y := by
  injection h with h
  trace_state -- without smart unfolding the state would be a mess
  injection h


open classical
variables (α : Type) (p q : α -> Prop)
variable a : α
variable r : Prop
example : (∃ x, p x) ↔ ¬ (∀ x, ¬ p x) :=
iff.intro
      (assume h: ∃ x, p x,
      exists.elim h $
      assume y(hp : p y),
        assume hn': ∀ x, ¬p x,
        have ht : ¬ p y, from hn' y,
        show false, from ht hp)
      (assume h: ¬(∀ x, ¬p x),
      by_contradiction
        (assume hex : ¬(∃ x, p x),
        have hf : ∀ x, ¬p x, from forall_not_of_not_exists hex,
show false, from h hf))


import .tab

variables {p q r s : Prop}

open tactic

#exit

#check imp_iff_not_or

/- simp -/
example : p → q :=
by simp only [ imp_iff_not_or ]

/- simp hypothesis -/
example (h : p → q) : false :=
by simp only [ imp_iff_not_or ] -- at h

/- simp everywhere -/
example (h1 : p → q) (h2 : ¬ (q ∨ r)) : false :=
by simp only [ imp_iff_not_or, not_or_distrib ] at h1 -- at *

/- simp subformula -/
example (h : p ∧ ¬ (q ∨ r)) : false :=
by simp only [ not_or_distrib ] at *

/- simp repeatedly -/
example (h : p → (q → r)) : false :=
by simp only [ imp_iff_not_or ] at *

example (h1 : ¬ ((p → q) → r)) (h2 : p ∧ ¬ q) : false :=
by normalize


/- ------------------------------------------------------------------------- -|
| @project: riemann_hypothesis                                                |
| @file:    complex.lean                                                      |
| @author:  Brandon H. Gomes and Alex Kontorovich                                                 |
| @affil:   Rutgers University                                                |
|- ------------------------------------------------------------------------- -/

import .exponential

/-!
-/

namespace riemann_hypothesis --——————————————————————————————————————————————————————————--

/--
-/
class Algebra (α : Type*)
    extends has_zero α, has_one α, has_neg α, has_add α, has_sub α, has_mul α, has_inv α

--———————————————————————————————————————————————————————————————————————————————————————--
variables (ℂ : Type*) (ℝ : Type*)

variables [preorder ℝ] [Algebra ℝ]

variables [Algebra ℂ]

variables [has_lift_t ℝ ℂ]

/--
-/
structure Complex
    := (real_part                : ℂ → ℝ)
       (abs                      : ℂ → ℝ)
       (exp                      : ℂ → ℂ)
       (real_explog              : ExpLog ℝ ℝ)
       (abs_nonneg               : Π z, 0 ≤ abs z)
       (exp_nonzero              : Π z, exp z ≠ 0)
       (exp_homomorphism_zero    : exp 0 = 1)
       (exp_homomorphism         : Π w z, exp (w + z) = exp w * exp z)
       (exp_homomorphism_inv     : Π w z, exp (w - z) = exp w * (exp z)⁻¹)
       (real_part_scaling        : Π x z, real_part (↑x * z) = x * real_part z)
       (abs_exp_is_exp_real_part : Π z, abs (exp z) = real_explog.exp (real_part z))
       (exp_linearization        : Π x, abs x ≤ 1
                                 → Π z, abs (exp (x * z) - (x * z + 1))
                                      ≤ (abs x * abs x) * real_explog.exp (abs z))
       (real_log_bound           : Π x (p : 0 < 1 - x), abs ↑x ≤ 2⁻¹
                                      → abs ↑(real_explog.log (1 - x) p)
                                      ≤ abs ↑x + abs ↑x)

namespace Complex --—————————————————————————————————————————————————————————————————————--
variables {ℂ ℝ} (ℭ : Complex ℂ ℝ)

open algebra

/--
-/
def real_abs (x : ℝ)
    := ℭ.abs (↑x)

/--
-/
def real_exp (x)
    := ℭ.real_explog.exp x

/--
-/
def real_log (x)
    := ℭ.real_explog.log x

/--
-/
def pow (a apos x)
    := ℭ.exp (↑(ℭ.real_explog.log a apos) * x)

/--
-/
def pow_domain_irrel
    (x xpos)
    (y ypos)
    (z)
    : x = y → ℭ.pow x xpos z = ℭ.pow y ypos z :=
    begin
        intros x_eq_y,
        rw [pow, pow],
        rw ExpLog.log_domain_irrel _ _ _ _ _ x_eq_y,
    end

/--
-/
def pow_nonzero (a apos x)
    : ℭ.pow a apos x ≠ 0
    := ℭ.exp_nonzero _

/--
-/
def pow_neg_exponent_inverts
    [has_left_sub_distributivity ℂ]
    [has_mul_zero_is_zero ℂ]
    [has_left_unit ℂ]
    (a apos x)
    : ℭ.pow a apos (0 - x) = (ℭ.pow a apos x)⁻¹ :=
    begin
        rw pow,
        rw has_left_sub_distributivity.eq,
        rw has_mul_zero_is_zero.eq,
        rw exp_homomorphism_inv,
        rw exp_homomorphism_zero,
        rw has_left_unit.eq,
        rw ← pow,
    end

/--
-/
def abs_pow_is_real_pow (x xpos z)
    : ℭ.abs (ℭ.pow x xpos z) = ℭ.real_explog.pow x xpos (ℭ.real_part z)
    := by rw [pow, abs_exp_is_exp_real_part, real_part_scaling, ExpLog.pow]

--———————————————————————————————————————————————————————————————————————————————————————--
local notation `|` z `|` := ℭ.abs z

/--
-/
def one_minus_pow_bound
    [has_lift_t nat ℝ]

    [has_add_le_add ℝ]

    [has_left_unit ℝ]
    [has_right_unit ℝ]

    [has_squared_le_monotonic ℝ]

    [has_inv_mul_right_cancel_self ℝ]

    [has_le_nonneg_mul_preserves_left ℝ]
    [has_le_nonneg_mul_preserves_right ℝ]

    [has_mul_assoc ℝ]

    [has_left_add_distributivity ℝ]
    [has_right_add_distributivity ℝ]

    [has_sub_add_sub_cancel ℂ]
    [has_add_sub_assoc ℂ]
    [has_sub_self_is_zero ℂ]
    [has_zero_right_add_cancel ℂ]

    [has_zero_right_add_cancel ℝ]

    (zero_lt_two : 0 < (2 : ℝ))
    (one_le_two  : 1 ≤ (2 : ℝ))

    (abs_mul      : Π a b, |a * b| = |a| * |b|)
    (abs_triangle : Π a b, |a + b| ≤ |a| + |b|)

    (z) (x : ℝ) (abs_x_le_half : |↑x| ≤ 2⁻¹) (one_minus_x_pos : 0 < 1 - x)

    : | ℭ.pow (1 - x) one_minus_x_pos z  - 1 | ≤ |↑x| * (4 * ℭ.real_exp (|z|) + (|z| + |z|)) :=

    begin
        rw ← has_sub_add_sub_cancel.eq _ (↑(ℭ.real_log (1 - x) one_minus_x_pos) * z + 1) _,

        refine le_trans (abs_triangle _ _) _,

        rw has_add_sub_assoc.eq,
        rw has_sub_self_is_zero.eq,
        rw has_zero_right_add_cancel.eq,
        rw abs_mul,
        rw has_left_add_distributivity.eq,
        rw ← has_mul_assoc.eq,

        let log_bound
            := ℭ.real_log_bound _ one_minus_x_pos abs_x_le_half,

        let abs_x_inequality
            := has_le_nonneg_mul_preserves_left.le (le_of_lt zero_lt_two) abs_x_le_half,

        rw has_inv_mul_right_cancel_self.eq _ (ne_of_lt zero_lt_two).symm
            at abs_x_inequality,

        rw two_mul_lemma at abs_x_inequality,

        refine has_add_le_add.le
            (le_trans
                (ℭ.exp_linearization _ (le_trans log_bound abs_x_inequality) _)
                (has_le_nonneg_mul_preserves_right.le
                    (le_of_lt (ExpLog.exp_positive _ _))
                    (le_trans
                        (has_squared_le_monotonic.le (abs_nonneg _ _) log_bound) _))) _,

        rw ← two_squares_is_four_lemma',

        refine has_le_nonneg_mul_preserves_right.le _ _,

        let zero_le_four
            := has_add_le_add.le (le_of_lt zero_lt_two) (le_of_lt zero_lt_two),

        rw has_zero_right_add_cancel.eq at zero_le_four,

        refine zero_le_four,

        have abs_x_le_one : |↑x| ≤ 1,
        {
            refine le_trans _ abs_x_inequality,

            rw ← two_mul_lemma',
            rw ← has_right_unit.eq (|↑x|),
            rw has_mul_assoc.eq,
            rw has_left_unit.eq,

            refine has_le_nonneg_mul_preserves_left.le (abs_nonneg _ _) one_le_two,
        },

        let square_le_id
            := has_le_nonneg_mul_preserves_right.le (abs_nonneg _ _) abs_x_le_one,

        rw has_left_unit.eq at square_le_id,

        refine square_le_id,

        rw has_left_add_distributivity.eq,
        rw ← has_right_add_distributivity.eq,

        refine has_le_nonneg_mul_preserves_right.le (abs_nonneg _ _) log_bound,
    end

end Complex --———————————————————————————————————————————————————————————————————————————--

end riemann_hypothesis --————————————————————————————————————————————————————————————————--


import geometry.tarski_7 linear_algebra.basic
open classical set
namespace Euclidean_plane
variables {point : Type} [Euclidean_plane point]

local attribute [instance, priority 0] prop_decidable

-- Pappus, Pascal and Desargues

theorem thirteen1 {a b c p q r : point} {A : set point} : ¬col a b c → M c p b → M c q a → M a r b → xperp r A (l a b) → perp A (l p q) :=
begin
intros h h1 h2 h3 g1,
have h4 : c ∉ l p q,
  intro h_1,
  suffices : line (l p q),
    apply h (six23.2 ⟨l p q, this, _, _, h_1⟩),
      rw seven6 h2,
      exact (seven24 this (six17b p q)).1 h_1,
    rw seven6 h1,
    exact (seven24 this (six17a p q)).1 h_1,
  apply six14,
  intro h_2,
  subst q,
  exact (six26 h).1 (seven4 h2 h1),
cases exists_of_exists_unique (eight17 (six14 (six26 h4).1) h4) with c' hc,
cases exists_of_exists_unique (eight22 (S q c') (S p c')) with x hx,
cases exists_of_exists_unique (unique_perp x hc.1) with A' hA,
suffices : A = A',
  exact this.symm ▸ hA.2.symm,
apply unique_of_exists_unique (unique_xperp g1.2.1 g1.2.2.2.1) g1.symm,
haveI h5 := (eight14e hA.2).2,
suffices : Sl A' a = b,
  have h6 : a ∉ A',
    intro h_1,
    have h_2 := ten3b h5 h_1,
    exact (six26 h).1 (h_2.symm.trans this),
  have h7 := ten3a h5 h6,
  rw this at *,
  rw M_to_mid h3 at h7,
  exact eight15 h7.2.symm (or.inr (or.inl h3.1.symm)) h7.1,
have h6 : l (S q c') (S p c') = l p q,
  exact (six18 hc.1 (seven18a c' (six13 hc.1).symm) ((seven24 hc.1 (six17b p q)).1 hc.2.2.1) ((seven24 hc.1 (six17a p q)).1 hc.2.2.1)).symm,
have h7 : Sl A' (S q c') = S p c',
  apply (unique_of_Sl h5 _ _ _).symm,
      apply six21b,
          refine ⟨hc.1, h5, eight14a hA.2, _, hA.1⟩,
          rw ←h6,
          exact (or.inr (or.inl hx.1.symm)),
        intro h_1,
        subst x,
        exact (six13 hc.1).symm (seven18 (id_eqd hx.2.symm)),
      rw ←h6,
      simp,
    rw M_to_mid hx,
    exact hA.1,
  rw h6,
  exact hA.2.symm,
have h8 : xperp (S q c') (l a (S q c')) (l (S q c') (S p c')),
  rw [seven6 h2, h6],
  apply (ten18 hc (six17b p q)).symm,
have h9 : xperp (S p c') (l b (S p c')) (l (S q c') (S p c')),
  rw [seven6 h1, h6],
  apply (ten18 hc (six17a p q)).symm,
apply six11a,
  suffices : side (l (S q c') (S p c')) a b,
    apply eleven15b (nine11 this).2.2 (nine11 this).2.2 _ _ _ (side.refla (nine11 this).2.2),
        rw seven6 h1,
        apply eleven16 (seven18a c' (six13 hc.1).symm) (seven9a p (six13 hc.2.1)) (seven18a c' (six13 hc.1).symm) _ _ _,
            rw ←h7,
            intro h_1,
            exact (six13 h8.1) (ten7 h_1),
          rw ←seven6 h1,
          exact (h9.2.2.2.2 (six17a b (S p c')) (six17a _ _)).symm,
        suffices : R (Sl A' (S p c')) (Sl A' (S q c')) (Sl A' a),
          rwa [←h7, ten5, h7] at this,
        apply (ten11d h5).1 (h8.2.2.2.2 (six17a a (S q c')) (six17b _ _)).symm,
      apply side.trans _ this,
      apply side.symm (twelve7.1 (dpar_of_par_neq _ _)).1,
        rw h6,
        apply twelve9 hA.2 (ten3a h5 _).2.symm,
        intro h_1,
        suffices : S q c' = x,
          subst x,
          exact (six13 hc.1).symm (seven18 (id_eqd hx.2.symm)),
        suffices : l a (S q c') = A',
          apply eight14d h8 _,
          rw this,
          refine eight15 _ hA.1 (or.inr (or.inl hx.1.symm)),
          simpa [h6] using hA.2.symm,
        rw ←h6 at *,
        exact unique_of_exists_unique (unique_perp a hc.1) ⟨six17a a (S q c'), S q c', h8.symm⟩ ⟨h_1, hA.2⟩,
      intro h_1,
      exact (nine11 this).2.1 (h_1.symm ▸ six17a a (Sl A' a)),
    exact eqa.refl (six26 (nine11 this).2.2).1 (six26 (nine11 this).2.2).2.1.symm,
  rw [h6, seven6 h2, seven6 h1],
  exact ⟨c, (nine16 (six14 (six26 h4).1) h4 (six17b p q)).symm, (nine16 (six14 (six26 h4).1) h4 (six17a p q)).symm⟩,
apply (ten10 h5 (S p c') (Sl A' a)).trans,
rw [←h7, ten5, ten5, seven6 h2, h7, seven6 h1],
exact (seven13 q c' c).symm.trans (seven13 p c' c)
end

theorem thirteen1a (a : point) {p q : point} : p ≠ q → par (l p q) (l (S p a) (S q a)) :=
begin
intro h,
by_cases h_1 : col p q a,
  exact or.inr ⟨(six14 h), six18 (six14 h) (seven18a a h)
  ((seven24 (six14 h) (six17a p q)).1 h_1) ((seven24 (six14 h) (six17b p q)).1 h_1)⟩,
cases exists_of_exists_unique (unique_xperp (six14 (seven18a a h)) (or.inr (or.inl (ten1 (S p a) (S q a)).1.symm))) with A ha,
have h1 := thirteen1 _ (seven5 q a) (seven5 p a) (ten1 (S p a) (S q a)) ha.symm,
  rw six17 at h1,
  exact twelve9 h1.symm ⟨mid (S p a) (S q a), ha⟩,
intro h_2,
exact h_1 (six23.2 ⟨l (S p a) (S q a), six14 (seven18a a h), six27 (six14 (seven18a a h)) h_2 (six17a _ _)
(seven5 p a).1, six27 (six14 (seven18a a h)) h_2 (six17b _ _) (seven5 q a).1, h_2⟩)
end

theorem thirteen2a {a b c d: point} {A : set point} : Bl c A d → xperp a A (l c a) → xperp b A (l d b) → ∃ p, B a p b ∧ B c p d :=
begin
intros h h1 h2,
cases h.2.2.2 with p hp,
by_cases h_1 : a = b,
  subst b,
  suffices : p = a,
    subst p,
    exact ⟨a, three1 a a, hp.2⟩,
  refine six21a h.1 (six14 (nine2 h)) _ hp.1 (or.inr (or.inl hp.2.symm)) h1.2.2.1 _,
    intro h_1,
    subst h_1,
    exact h.2.1 (six17a c d),
  suffices : l c a = l d a,
    apply (four11 _).1,
    show d ∈ l c a,
    rw this,
    simp,
  exact unique_of_exists_unique (unique_perp a h.1) ⟨h1.2.2.2.1, a, h1⟩ ⟨h2.2.2.2.1, a, h2⟩,
have h3 := six18 h.1 h_1 h1.2.2.1 h2.2.2.1,
subst h3,
refine ⟨p, _, hp.2⟩,
cases (four11 hp.1).1,
  exact h_2,
exfalso,
rw three2 at h_2,
revert c d,
wlog h3 := h_2 using a b,
  intros,
  cases exists_of_exists_unique (unique_perp p h.1) with P hP,
  suffices : side P c d,
    exact nine9 ⟨(nine11 this).1, (nine11 this).2.1, (nine11 this).2.2, p, hP.1, hp.2⟩ this,
  suffices : side P a b,
    apply side.trans _ (this.trans _),
      apply twelve6 (dpar_of_par_neq (twelve9 hP.2.symm ⟨a, h1.symm⟩) _) (six17a c a) (six17b c a),
      intro h_2,
      subst h_2,
      exact (nine11 this).2.1 (six17b c a),
    apply twelve6 (dpar_of_par_neq (twelve9 hP.2.symm ⟨b, h2.symm⟩) _) (six17b d b) (six17a d b),
    intro h_2,
    subst h_2,
    exact (nine11 this).2.2 (six17b d b),
  suffices : b ≠ p,
    apply (nine12 (eight14e hP.2).2 hP.1 (six7 h3.symm this) _).symm,
    intro h_2,
    exact (eight14a hP.2) (six21 this h.1 (eight14e hP.2).2 (six17b a b) h_2 (or.inl h3) hP.1),
  intro h_2,
  subst p,
  have h4 := six18 h2.2.1 (six26 h.2.1).2.1.symm (or.inl hp.2.symm) (six17b d b),
  rw h4 at *,
  exact h_1 (unique_of_exists_unique (eight18 h.2.1) ⟨six17a a b, a, h1⟩ ⟨six17b a b, b, h2⟩),
rw six17 b a at this,
exact this (ne.symm h_1) h.symm h2 h1 ⟨hp.1, hp.2.symm⟩
end

theorem thirteen2b {a b c d : point} : Bl c (l a b) d → R b c a → R b d a → Bl a (l c d) b :=
begin
intros h h1 h2,
cases exists_of_exists_unique (eight17 h.1 h.2.1) with x hx,
cases exists_of_exists_unique (eight17 h.1 h.2.2.1) with y hy,
have h3 := eleven47 h1.symm hx.symm,
have h4 := eleven47 h2.symm hy.symm,
cases thirteen2a h hx hy with p hp,
have h5 := five7 h3.1 h4.1 hp.1,
have h6 : is p (l a b) (l c d),
  refine ⟨h.1, six14 (nine2 h), _, or.inr (or.inl (h5).symm), or.inr (or.inl hp.2.symm)⟩,
  intro h_1,
  rw h_1 at h,
  exact h.2.1 (six17a c d),
refine ⟨h6.2.1, _, _, p, h6.2.2.2.2, h5⟩,
  intro h_1,
  apply (six21b h6 _ (six17a a b)) h_1,
  intro h_2,
  subst p,
  cases five3 h3.1 h4.1,
    exact h3.2.1 (three4 hp.1 h_2),
  exact h4.2.1 (three4 hp.1.symm h_2),
intro h_1,
apply (six21b h6 _ (six17b a b)) h_1,
intro h_2,
subst p,
cases five3 h3.1.symm h4.1.symm,
  exact h3.2.2 (three4 hp.1 h_2),
exact h4.2.2 (three4 hp.1.symm h_2)
end

theorem thirteen2c {a b c d : point} : Bl c (l a b) d → Bl a (l c d) b → ∃ p, B a p b ∧ B c p d ∧ p ≠ a ∧ p ≠ b ∧ p ≠ c ∧ p ≠ d :=
begin
intros h h1,
cases h.2.2.2 with p hp,
cases h1.2.2.2 with q hq,
have : p = q,
  apply six21a h.1 h1.1 _ hp.1 (or.inr (or.inl hp.2.symm)) (or.inr (or.inl hq.2.symm)) hq.1,
  intro h_1,
  rw h_1 at h,
  exact h.2.1 (six17a c d),
subst q,
refine ⟨p, hq.2, hp.2, _⟩,
repeat {split}; intro h_1; subst p,
      exact h1.2.1 hq.1,
    exact h1.2.2.1 hq.1,
  exact h.2.1 hp.1,
exact h.2.2.1 hp.1
end

theorem thirteen2 {a b c d e : point} : Bl c (l a b) d → R b c a → R b d a → xperp e (l a e) (l c d) →
eqa b a c d a e ∧ eqa b a d c a e ∧ B c e d :=
begin
intros h h1 h2 h3,
have h4 : side (l a c) b d,
  cases thirteen2c h (thirteen2b h h1 h2) with t ht,
  apply nine15 _ ht.1 ht.2.1,
  intro h_1,
  exact h.2.1 (six23.2 ⟨l a t, six14 ht.2.2.1.symm, six17a a t, or.inl ht.1, (four11 h_1).1⟩),
have h5 : ang_lt c a b c a d,
  cases thirteen2c h (thirteen2b h h1 h2) with t ht,
  suffices : ang_lt c a t c a d,
    exact eleven37 this (eleven9 (six5 (six26 h.2.1).2.2.symm) (six7 ht.1 ht.2.2.1).symm)
    (eqa.refl (six26 h.2.1).2.2.symm (six26 h.2.2.1).2.2.symm),
  exact eleven32d (four10 (nine11 h4).2.2).2.1 ht.2.2.2.2.2 ht.2.1,
replace h5 := eleven42b h5,
cases eleven32c (λ h_1, (four10 (nine11 h4).2.2).2.2.1 (or.inr (or.inl h_1))) h5 with e' he,
have h6 : side (l a d) e' c,
  suffices : ¬col a d e',
    exact nine12 (six14 (six26 h.2.2.1).2.2) (six17b a d) (six7 he.2.1 (six26 this).2.1.symm) this,
  intro h_1,
  exact (four10 h.2.1).2.2.2.1 (eleven21d (four11 h_1).2.1 he.2.2.symm),
have h7 : eqa b a d e' a c,
  exact eleven22b h4 h6 he.2.2.flip (eleven6 (six26 h.2.1).2.2.symm (six26 h.2.2.1).2.2.symm),
suffices : e = e',
  subst e',
  exact ⟨eleven7 he.2.2, eleven8 h7, he.2.1.symm⟩,
apply unique_of_exists_unique (eight17 h3.2.1 (four10 (nine11 h6).2.2).2.2.2.2) h3.symm _,
refine eight15 _ (or.inr (or.inl he.2.1)) (six17b a e'),
have h8 := (eqd.symm h1.symm).trans h2.symm,
apply (thirteen1 _ (seven5 c b) (seven5 d b) (ten1 (S c b) (S d b)).symm _).symm,
  intro h_1,
  exact (thirteen2b h h1 h2).2.2.1 (six23.2 ⟨l (S d b) (S c b), six14 (seven18a b (nine2 h.symm)),
  six27 (six14 (seven18a b (nine2 h.symm))) (six17b _ _) h_1 (seven5 c b).1.symm,
  six27 (six14 (seven18a b (nine2 h.symm))) (six17a _ _) h_1 (seven5 d b).1.symm, h_1⟩),
haveI ha := six14 he.2.2.2.2.2.1.symm,
rw six17 (S d b) (S c b),
suffices : Sl (l a e') (S c b) = S d b,
  rw ←this,
  refine eight15 (ten3a ha _).2 (ten3a ha _).1 (or.inr (or.inl (ten1 (S c b) (Sl (l a e') (S c b))).1.symm));
  intro h_1;
  exact (seven18a b (nine2 h)) (this ▸ (ten3b ha h_1).symm),
suffices : eqa (S c b) a e' (S d b) a e',
  cases eleven15d this.flip (six14 this.2.1),
    exact ((seven18a b (nine2 h)) (six11a h_1 h8)).elim,
  simp only [six17] at h_1,
  apply ten4.1,
  apply six11a h_1.symm,
  simpa [ten3b ha (six17a a e')] using (ten10 ha a (S d b)).symm.trans h8.symm,
suffices : eqa (S c b) a c e' a d,
  apply eleven8 (eleven22a _ _ this _),
      apply ((nine8 (nine10a (nine11 h4).1 (six17b a c) (nine11 h4).2.1)).2 _).symm,
      exact nine19a h4 (six17b a c) (six7 he.2.1.symm he.1).symm,
    apply (nine8 (nine10a (nine11 h6).1 (six17b a d) (four10 h.2.2.1).1)).2 _,
    apply (h6.trans _).symm,
    cases thirteen2c h (thirteen2b h h1 h2) with t ht,
    apply (nine15 _ ht.1 ht.2.1.symm).symm,
    intro h_1,
    exact h.2.2.1 (six23.2 ⟨l a t, six14 ht.2.2.1.symm, six17a a t, or.inl ht.1, (four11 h_1).1⟩),
  apply h7.symm.flip.trans,
  replaceI h6 := (nine11 h6).1,
  suffices : S d b = Sl (l a d) b,
    rw this,
    simpa [ten3b h6 (six17a a d), ten3b h6 (six17b a d)] using eleven12a h6 h7.2.1 h7.1,
  apply unique_of_Sl h6 (four10 h.2.2.1).1 _ (perp_of_R h7.2.1.symm (six26 h.2.2.1).2.1 h2.symm),
  simp [mid_of_S d b, six17b a d],
apply (he.2.2.symm.trans _).symm.flip,
replaceI h4 := (nine11 h4).1,
suffices : S c b = Sl (l a c) b,
  rw this,
  simpa [ten3b h4 (six17a a c), ten3b h4 (six17b a c)] using eleven12a h4 he.2.2.1 h7.1,
apply unique_of_Sl h4 (four10 h.2.1).1 _ (perp_of_R he.2.2.1.symm (six26 h.2.1).2.1 h1.symm),
simp [mid_of_S c b, six17b a c]
end

theorem thirteen7a {α : angle point} {C : dist point} (hα : acute α) (hc : ¬C = 0) (hα1 : ¬α = 0) :
∃ a b c (hab : a ≠ b) (hcb : c ≠ b), ⟦(a, b)⟧ = C ∧ R a c b ∧ α = ⟦⟨(a, b, c), hab, hcb⟩⟧ :=
begin
rcases quotient.exists_rep α with ⟨⟨⟨p, b, q⟩, hpb, hqb⟩, h2⟩,
subst α,
change ang_acute p b q at hα,
have hpbq : ¬col p b q,
  intro h_1,
  exact hα1 (zero_iff_sided.2 (sided_of_acute_col hα h_1)),
rcases thirteen3 hpbq hc with ⟨⟨a, c⟩, h3, h, h4⟩,
have h2 := h4.symm.2.2.2.2 (six17a a c) (six17a b q),
have h5 : sided b q c,
  apply eleven48 (hα.trans (eleven9 h3.symm (six5 hqb))) h4.2.2.1 _ h2,
  dsimp,
  intro h_1,
  subst b,
  apply (eleven45a hα).1 ⟨hpb, hqb, h4.symm.2.2.2.2 (four11 (six4.1 h3).1).2.2.2.2 (six17b c q)⟩,
exact ⟨a, b, c, h3.2.1, h5.2.1, eq.trans (quotient.sound (show (a, b) ≈ (b, a), from eqd_refl a b)) h,
  h2, quotient.sound (eleven9 h3.symm h5.symm)⟩
end

theorem thirteen7b {β : angle point} {a b c : point} (hab : a ≠ b) : ¬col a b c → acute β → β ≠ 0 → ∃ d (hdb : d ≠ b), β = ⟦⟨(a, b, d), hab, hdb⟩⟧ ∧ Bl c (l b a) d ∧ R a d b :=
begin
intros h h1 h2,
rcases quotient.exists_rep β with ⟨⟨⟨p, q, r⟩, h3⟩, h4⟩,
subst β,
change ang_acute p q r at h1,
replace h2 : ¬col p q r,
  intro h_1,
  apply h2 (zero_iff_sided.2 _),
  exact sided_of_acute_col h1 h_1,
cases nine10 (six14 hab) h with t ht,
cases eleven15a h2 ht.2.2.1 with s hs,
cases exists_of_exists_unique (eight17 (six14 hs.1.2.2.2.1.symm) (four10 (nine11 hs.2).2.1).2.2.1) with d hd,
have h3 : sided b s d,
  apply eleven48 (h1.trans hs.1) hd.2.2.1 _ (hd.symm.2.2.2.2 (six17a a d) (six17a b s)),
  intro h_1,
  subst d,
  exact (eleven45a (h1.trans hs.1)).1 ⟨hs.1.2.2.1, hs.1.2.2.2.1, hd.symm.2.2.2.2 (six17a a b) (six17b b s)⟩,
refine ⟨d, h3.2.1, _, _,  hd.symm.2.2.2.2 (six17a a d) (six17a b s)⟩,
  exact quotient.sound (hs.1.trans (eleven9 (six5 hab) h3.symm)),
exact six17 a b ▸ ((nine8 ht.symm).2 (nine19a hs.2.symm (six17b a b) h3)).symm
end

theorem thirteen7c {α β : angle point} {C : dist point} : acute α → acute β → cos α (cos β C) = cos β (cos α C) :=
begin
intros hα hβ,
by_cases hc : C = 0,
  subst C,
  simp [cos_times_zero],
by_cases hα1 : α = 0,
  subst α,
  rw [cos_zero, cos_zero],
by_cases hβ1 : β = 0,
  subst β,
  rw [cos_zero, cos_zero],
rcases thirteen7a hα hc hα1 with ⟨a, b, c, hab, hcb, h, h1, h2⟩,
clear hc,
subst_vars,
change ang_acute a b c at hα,
replace hα1 : ¬col a b c,
  intro h_1,
  apply hα1 (zero_iff_sided.2 _),
  exact sided_of_acute_col hα h_1,
rcases thirteen7b hab hα1 hβ hβ1 with ⟨d, hdb, h2, hd⟩,
subst β,
rw [←thirteen5b hab hcb h1, ←thirteen5b hab hdb hd.2],
have h2 := thirteen2b hd.1 h1 hd.2,
cases exists_of_exists_unique (eight17 h2.1 h2.2.1) with e he,
have h3 := thirteen2 hd.1 h1 hd.2 he.symm,
suffices : cos ⟦⟨(d, b, e), hdb, h3.1.2.2.2.1⟩⟧ ⟦(d, b)⟧ = cos ⟦⟨(c, b, e), hcb, h3.1.2.2.2.1⟩⟧ ⟦(c, b)⟧,
  have h4 : (⟦⟨(a, b, c), hab, hcb⟩⟧ : angle point) = ⟦⟨(d, b, e), hdb, h3.1.2.2.2.1⟩⟧,
    exact quotient.sound h3.1,
  have h5 : (⟦⟨(a, b, d), hab, hdb⟩⟧ : angle point) = ⟦⟨(c, b, e), hcb, h3.1.2.2.2.1⟩⟧,
    exact quotient.sound h3.2.1,
  rwa [h4, h5],
rw [←thirteen5b hdb h3.1.2.2.2.1 _, ←thirteen5b hcb h3.1.2.2.2.1 _],
  exact he.2.2.2.2 (six17a c d) (six17a b e),
exact he.2.2.2.2 (six17b c d) (six17a b e)
end

theorem thirteen7 (α β : angle point) (C : dist point) : cos α (cos β C) = cos β (cos α C) :=
begin
by_cases ha : right α,
  simp [cos_right ha, cos_right ha],
by_cases hb : right β,
  simp [cos_right hb, cos_right hb],
replace ha : acute α ∨ obtuse α,
  simpa [ha] using angle_trichotomy α,
replace hb : acute β ∨ obtuse β,
  simpa [hb] using angle_trichotomy β,
cases ha.symm,
  have h1 := supp_of_obtuse.1 h,
  rw cos_supp α,
all_goals
{ cases hb.symm,
    have h2 := supp_of_obtuse.1 h_1,
    rw cos_supp β,
  all_goals
  { apply thirteen7c;
    assumption}}
end

lemma thirteen11a {o a b a' b' : point} : ¬col o a a' → col o a b → col o a' b' → b ≠ o → b' ≠ o →
¬col o a b' ∧ ¬col o b a' :=
begin
sorry
end

lemma thirteen11b {o a b a' b' : point} : ¬col o a b' → ¬col o b a' → par (l a b') (l b a') →
∃ x x', xperp x (l o x) (l a b') ∧ xperp x' (l o x) (l b a') :=
begin
sorry
end

lemma thirteen11c {o a b a' b' x x' : point} : ¬col o a a' → col o a b → col o a' b' → b ≠ o → b' ≠ o →
par (l a b') (l b a') → xperp x (l o x) (l a b') → xperp x' (l o x) (l b a') → eqa a o x b o x' ∧ eqa a' o x' b' o x :=
begin
sorry
end

lemma thirteen11d {o a b a' b' x x' : point} (h : eqa a o x b o x') (h1 : eqa a' o x' b' o x) : ¬col o a a' →
col o a b → col o a' b' → b ≠ o → b' ≠ o → par (l a b') (l b a') → xperp x (l o x) (l a b') → xperp x' (l o x) (l b a') :=
begin
sorry
end

theorem thirteen11 {o a b c a' b' c' : point} : ¬col o a a' → col o a b → col o a c → b ≠ o → c ≠ o → col o a' b' →
col o a' c' → b' ≠ o → c' ≠ o → par (l b c') (l c b') → par (l c a') (l a c') → par (l a b') (l b a') :=
begin
intros h h1 h2 h3 h4 h5 h6 h7 h8 h9 h10,
sorry

end

end Euclidean_plane


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

/-!
# Affine maps

This file defines affine maps.

## Main definitions

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

## Notations

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

## Implementation notes

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

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

## References

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

open_locale affine

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

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

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

namespace linear_map

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

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

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

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

end linear_map

namespace affine_map

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

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

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

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

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

/-- Two affine maps are equal if they coerce to the same function. -/
@[ext] lemma ext {f g : P1 →ᵃ[k] P2} (h : ∀ p, f p = g p) : f = g :=
begin
  rcases f with ⟨f, f_linear, f_add⟩,
  rcases g with ⟨g, g_linear, g_add⟩,
  have : f = g := funext h,
  subst g,
  congr' with v,
  cases (add_torsor.nonempty : nonempty P1) with p,
  apply vadd_right_cancel (f p),
  erw [← f_add, ← g_add]
end

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

lemma coe_fn_injective : @function.injective (P1 →ᵃ[k] P2) (P1 → P2) coe_fn :=
λ f g H, ext $ congr_fun H

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

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

variables (k P1)

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

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

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

variables {k P1}

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

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

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

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

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

/-- The set of affine maps to a vector space is an additive commutative group. -/
instance : add_comm_group (P1 →ᵃ[k] V2) :=
{ zero := ⟨0, 0, λ p v, (zero_vadd _ _).symm⟩,
  add := λ f g, ⟨f + g, f.linear + g.linear, λ p v, by simp [add_add_add_comm]⟩,
  sub := λ f g, ⟨f - g, f.linear - g.linear, λ p v, by simp [sub_add_comm]⟩,
  sub_eq_add_neg := λ f g, ext $ λ p, sub_eq_add_neg _ _,
  neg := λ f, ⟨-f, -f.linear, λ p v, by simp [add_comm]⟩,
  add_assoc := λ f₁ f₂ f₃, ext $ λ p, add_assoc _ _ _,
  zero_add := λ f, ext $ λ p, zero_add (f p),
  add_zero := λ f, ext $ λ p, add_zero (f p),
  add_comm := λ f g, ext $ λ p, add_comm (f p) (g p),
  add_left_neg := λ f, ext $ λ p, add_left_neg (f p) }

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

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

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

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

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

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

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

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

variables (k P1)
omit V2

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

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

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

variable {P1}

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

variables {k P1}

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

include V2 V3

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

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

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

omit V3

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

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

include V3 V4

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

omit V2 V3 V4

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

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

include V2

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

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

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

omit V2

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

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

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

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

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

omit V1

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

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

include V1

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

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

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

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

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

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

include V2

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

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

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

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

omit V2

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

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

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

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

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

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

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

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

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

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

omit V1

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

section

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

include V

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

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

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

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

end

end affine_map

namespace affine_map

variables {k : Type*} {V1 : Type*} {P1 : Type*} {V2 : Type*} [comm_ring k]
    [add_comm_group V1] [module k V1] [affine_space V1 P1] [add_comm_group V2] [module k V2]
include V1

/-- If `k` is a commutative ring, then the set of affine maps with codomain in a `k`-module
is a `k`-module. -/
instance : module k (P1 →ᵃ[k] V2) :=
{ smul := λ c f, ⟨c • f, c • f.linear, λ p v, by simp [smul_add]⟩,
  one_smul := λ f, ext $ λ p, one_smul _ _,
  mul_smul := λ c₁ c₂ f, ext $ λ p, mul_smul _ _ _,
  smul_add := λ c f g, ext $ λ p, smul_add _ _ _,
  smul_zero := λ c, ext $ λ p, smul_zero _,
  add_smul := λ c₁ c₂ f, ext $ λ p, add_smul _ _ _,
  zero_smul := λ f, ext $ λ p, zero_smul _ _ }

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

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

/-- The space of affine maps between two modules is linearly equivalent to the product of the
domain with the space of linear maps, by taking the value of the affine map at `(0 : V1)` and the
linear part. -/
@[simps] def to_const_prod_linear_map : (V1 →ᵃ[k] V2) ≃ₗ[k] V2 × (V1 →ₗ[k] V2) :=
{ to_fun    := λ f, ⟨f 0, f.linear⟩,
  inv_fun   := λ p, p.2.to_affine_map + const k V1 p.1,
  left_inv  := λ f, by { ext, rw f.decomp, simp, },
  right_inv := by { rintros ⟨v, f⟩, ext; simp, },
  map_add'  := by simp,
  map_smul' := by simp, }

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

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

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

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

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

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

lemma homothety_mul (c : P1) (r₁ r₂ : k) :
  homothety c (r₁ * r₂) = (homothety c r₁).comp (homothety c r₂) :=
by { ext p, simp [homothety_apply, mul_smul] }

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

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

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

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

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

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

end affine_map