/-
Copyright (c) 2020 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Joseph Myers.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.geometry.euclidean.circumcenter
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Monge point and orthocenter

This file defines the orthocenter of a triangle, via its n-dimensional
generalization, the Monge point of a simplex.

## Main definitions

* `monge_point` is the Monge point of a simplex, defined in terms of
  its position on the Euler line and then shown to be the point of
  concurrence of the Monge planes.

* `monge_plane` is a Monge plane of an (n+2)-simplex, which is the
  (n+1)-dimensional affine subspace of the subspace spanned by the
  simplex that passes through the centroid of an n-dimensional face
  and is orthogonal to the opposite edge (in 2 dimensions, this is the
  same as an altitude).

* `altitude` is the line that passes through a vertex of a simplex and
  is orthogonal to the opposite face.

* `orthocenter` is defined, for the case of a triangle, to be the same
  as its Monge point, then shown to be the point of concurrence of the
  altitudes.

* `orthocentric_system` is a predicate on sets of points that says
  whether they are four points, one of which is the orthocenter of the
  other three (in which case various other properties hold, including
  that each is the orthocenter of the other three).

## References

* https://en.wikipedia.org/wiki/Altitude_(triangle)
* https://en.wikipedia.org/wiki/Monge_point
* https://en.wikipedia.org/wiki/Orthocentric_system
* Małgorzata Buba-Brzozowa, [The Monge Point and the 3(n+1) Point
  Sphere of an
  n-Simplex](https://pdfs.semanticscholar.org/6f8b/0f623459c76dac2e49255737f8f0f4725d16.pdf)

-/

namespace affine

namespace simplex

/-- The Monge point of a simplex (in 2 or more dimensions) is a
generalization of the orthocenter of a triangle.  It is defined to be
the intersection of the Monge planes, where a Monge plane is the
(n-1)-dimensional affine subspace of the subspace spanned by the
simplex that passes through the centroid of an (n-2)-dimensional face
and is orthogonal to the opposite edge (in 2 dimensions, this is the
same as an altitude).  The circumcenter O, centroid G and Monge point
M are collinear in that order on the Euler line, with OG : GM = (n-1)
: 2.  Here, we use that ratio to define the Monge point (so resulting
in a point that equals the centroid in 0 or 1 dimensions), and then
show in subsequent lemmas that the point so defined lies in the Monge
planes and is their unique point of intersection. -/
def monge_point {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] {n : ℕ} (s : simplex ℝ P n) : P :=
  (↑(n + 1) / ↑(n - 1)) • (finset.centroid ℝ finset.univ (points s) -ᵥ circumcenter s) +ᵥ circumcenter s

/-- The position of the Monge point in relation to the circumcenter
and centroid. -/
theorem monge_point_eq_smul_vsub_vadd_circumcenter {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] {n : ℕ} (s : simplex ℝ P n) : monge_point s = (↑(n + 1) / ↑(n - 1)) • (finset.centroid ℝ finset.univ (points s) -ᵥ circumcenter s) +ᵥ circumcenter s :=
  rfl

/-- The Monge point lies in the affine span. -/
theorem monge_point_mem_affine_span {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] {n : ℕ} (s : simplex ℝ P n) : monge_point s ∈ affine_span ℝ (set.range (points s)) :=
  affine_subspace.smul_vsub_vadd_mem (affine_span ℝ (set.range (points s))) (↑(n + 1) / ↑(n - 1))
    (centroid_mem_affine_span_of_card_eq_add_one ℝ (points s) (finset.card_fin (n + 1))) (circumcenter_mem_affine_span s)
    (circumcenter_mem_affine_span s)

/-- Two simplices with the same points have the same Monge point. -/
theorem monge_point_eq_of_range_eq {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] {n : ℕ} {s₁ : simplex ℝ P n} {s₂ : simplex ℝ P n} (h : set.range (points s₁) = set.range (points s₂)) : monge_point s₁ = monge_point s₂ := sorry

/-- The weights for the Monge point of an (n+2)-simplex, in terms of
`points_with_circumcenter`. -/
def monge_point_weights_with_circumcenter (n : ℕ) : points_with_circumcenter_index (n + bit0 1) → ℝ :=
  sorry

/-- `monge_point_weights_with_circumcenter` sums to 1. -/
@[simp] theorem sum_monge_point_weights_with_circumcenter (n : ℕ) : (finset.sum finset.univ
    fun (i : points_with_circumcenter_index (n + bit0 1)) => monge_point_weights_with_circumcenter n i) =
  1 := sorry

/-- The Monge point of an (n+2)-simplex, in terms of
`points_with_circumcenter`. -/
theorem monge_point_eq_affine_combination_of_points_with_circumcenter {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] {n : ℕ} (s : simplex ℝ P (n + bit0 1)) : monge_point s =
  coe_fn (finset.affine_combination finset.univ (points_with_circumcenter s)) (monge_point_weights_with_circumcenter n) := sorry

/-- The weights for the Monge point of an (n+2)-simplex, minus the
centroid of an n-dimensional face, in terms of
`points_with_circumcenter`.  This definition is only valid when `i₁ ≠ i₂`. -/
def monge_point_vsub_face_centroid_weights_with_circumcenter {n : ℕ} (i₁ : fin (n + bit1 1)) (i₂ : fin (n + bit1 1)) : points_with_circumcenter_index (n + bit0 1) → ℝ :=
  sorry

/-- `monge_point_vsub_face_centroid_weights_with_circumcenter` is the
result of subtracting `centroid_weights_with_circumcenter` from
`monge_point_weights_with_circumcenter`. -/
theorem monge_point_vsub_face_centroid_weights_with_circumcenter_eq_sub {n : ℕ} {i₁ : fin (n + bit1 1)} {i₂ : fin (n + bit1 1)} (h : i₁ ≠ i₂) : monge_point_vsub_face_centroid_weights_with_circumcenter i₁ i₂ =
  monge_point_weights_with_circumcenter n - centroid_weights_with_circumcenter (insert i₁ (singleton i₂)ᶜ) := sorry

/-- `monge_point_vsub_face_centroid_weights_with_circumcenter` sums to 0. -/
@[simp] theorem sum_monge_point_vsub_face_centroid_weights_with_circumcenter {n : ℕ} {i₁ : fin (n + bit1 1)} {i₂ : fin (n + bit1 1)} (h : i₁ ≠ i₂) : (finset.sum finset.univ
    fun (i : points_with_circumcenter_index (n + bit0 1)) =>
      monge_point_vsub_face_centroid_weights_with_circumcenter i₁ i₂ i) =
  0 := sorry

/-- The Monge point of an (n+2)-simplex, minus the centroid of an
n-dimensional face, in terms of `points_with_circumcenter`. -/
theorem monge_point_vsub_face_centroid_eq_weighted_vsub_of_points_with_circumcenter {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] {n : ℕ} (s : simplex ℝ P (n + bit0 1)) {i₁ : fin (n + bit1 1)} {i₂ : fin (n + bit1 1)} (h : i₁ ≠ i₂) : monge_point s -ᵥ finset.centroid ℝ (insert i₁ (singleton i₂)ᶜ) (points s) =
  coe_fn (finset.weighted_vsub finset.univ (points_with_circumcenter s))
    (monge_point_vsub_face_centroid_weights_with_circumcenter i₁ i₂) := sorry

/-- The Monge point of an (n+2)-simplex, minus the centroid of an
n-dimensional face, is orthogonal to the difference of the two
vertices not in that face. -/
theorem inner_monge_point_vsub_face_centroid_vsub {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] {n : ℕ} (s : simplex ℝ P (n + bit0 1)) {i₁ : fin (n + bit1 1)} {i₂ : fin (n + bit1 1)} (h : i₁ ≠ i₂) : inner (monge_point s -ᵥ finset.centroid ℝ (insert i₁ (singleton i₂)ᶜ) (points s)) (points s i₁ -ᵥ points s i₂) = 0 := sorry

/-- A Monge plane of an (n+2)-simplex is the (n+1)-dimensional affine
subspace of the subspace spanned by the simplex that passes through
the centroid of an n-dimensional face and is orthogonal to the
opposite edge (in 2 dimensions, this is the same as an altitude).
This definition is only intended to be used when `i₁ ≠ i₂`. -/
def monge_plane {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] {n : ℕ} (s : simplex ℝ P (n + bit0 1)) (i₁ : fin (n + bit1 1)) (i₂ : fin (n + bit1 1)) : affine_subspace ℝ P :=
  affine_subspace.mk' (finset.centroid ℝ (insert i₁ (singleton i₂)ᶜ) (points s))
      (submodule.span ℝ (singleton (points s i₁ -ᵥ points s i₂))ᗮ) ⊓
    affine_span ℝ (set.range (points s))

/-- The definition of a Monge plane. -/
theorem monge_plane_def {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] {n : ℕ} (s : simplex ℝ P (n + bit0 1)) (i₁ : fin (n + bit1 1)) (i₂ : fin (n + bit1 1)) : monge_plane s i₁ i₂ =
  affine_subspace.mk' (finset.centroid ℝ (insert i₁ (singleton i₂)ᶜ) (points s))
      (submodule.span ℝ (singleton (points s i₁ -ᵥ points s i₂))ᗮ) ⊓
    affine_span ℝ (set.range (points s)) :=
  rfl

/-- The Monge plane associated with vertices `i₁` and `i₂` equals that
associated with `i₂` and `i₁`. -/
theorem monge_plane_comm {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] {n : ℕ} (s : simplex ℝ P (n + bit0 1)) (i₁ : fin (n + bit1 1)) (i₂ : fin (n + bit1 1)) : monge_plane s i₁ i₂ = monge_plane s i₂ i₁ := sorry

/-- The Monge point lies in the Monge planes. -/
theorem monge_point_mem_monge_plane {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] {n : ℕ} (s : simplex ℝ P (n + bit0 1)) {i₁ : fin (n + bit1 1)} {i₂ : fin (n + bit1 1)} (h : i₁ ≠ i₂) : monge_point s ∈ monge_plane s i₁ i₂ := sorry

-- This doesn't actually need the `i₁ ≠ i₂` hypothesis, but it's

-- convenient for the proof and `monge_plane` isn't intended to be

-- useful without that hypothesis.

/-- The direction of a Monge plane. -/
theorem direction_monge_plane {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] {n : ℕ} (s : simplex ℝ P (n + bit0 1)) {i₁ : fin (n + bit1 1)} {i₂ : fin (n + bit1 1)} (h : i₁ ≠ i₂) : affine_subspace.direction (monge_plane s i₁ i₂) =
  submodule.span ℝ (singleton (points s i₁ -ᵥ points s i₂))ᗮ ⊓ vector_span ℝ (set.range (points s)) := sorry

/-- The Monge point is the only point in all the Monge planes from any
one vertex. -/
theorem eq_monge_point_of_forall_mem_monge_plane {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] {n : ℕ} {s : simplex ℝ P (n + bit0 1)} {i₁ : fin (n + bit1 1)} {p : P} (h : ∀ (i₂ : fin (n + bit1 1)), i₁ ≠ i₂ → p ∈ monge_plane s i₁ i₂) : p = monge_point s := sorry

/-- An altitude of a simplex is the line that passes through a vertex
and is orthogonal to the opposite face. -/
def altitude {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] {n : ℕ} (s : simplex ℝ P (n + 1)) (i : fin (n + bit0 1)) : affine_subspace ℝ P :=
  affine_subspace.mk' (points s i)
      (affine_subspace.direction (affine_span ℝ (points s '' ↑(finset.erase finset.univ i)))ᗮ) ⊓
    affine_span ℝ (set.range (points s))

/-- The definition of an altitude. -/
theorem altitude_def {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] {n : ℕ} (s : simplex ℝ P (n + 1)) (i : fin (n + bit0 1)) : altitude s i =
  affine_subspace.mk' (points s i)
      (affine_subspace.direction (affine_span ℝ (points s '' ↑(finset.erase finset.univ i)))ᗮ) ⊓
    affine_span ℝ (set.range (points s)) :=
  rfl

/-- A vertex lies in the corresponding altitude. -/
theorem mem_altitude {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] {n : ℕ} (s : simplex ℝ P (n + 1)) (i : fin (n + bit0 1)) : points s i ∈ altitude s i := sorry

/-- The direction of an altitude. -/
theorem direction_altitude {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] {n : ℕ} (s : simplex ℝ P (n + 1)) (i : fin (n + bit0 1)) : affine_subspace.direction (altitude s i) =
  vector_span ℝ (points s '' ↑(finset.erase finset.univ i))ᗮ ⊓ vector_span ℝ (set.range (points s)) := sorry

/-- The vector span of the opposite face lies in the direction
orthogonal to an altitude. -/
theorem vector_span_le_altitude_direction_orthogonal {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] {n : ℕ} (s : simplex ℝ P (n + 1)) (i : fin (n + bit0 1)) : vector_span ℝ (points s '' ↑(finset.erase finset.univ i)) ≤ (affine_subspace.direction (altitude s i)ᗮ) := sorry

/-- An altitude is finite-dimensional. -/
protected instance finite_dimensional_direction_altitude {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] {n : ℕ} (s : simplex ℝ P (n + 1)) (i : fin (n + bit0 1)) : finite_dimensional ℝ ↥(affine_subspace.direction (altitude s i)) :=
  eq.mpr
    (id
      (Eq._oldrec (Eq.refl (finite_dimensional ℝ ↥(affine_subspace.direction (altitude s i)))) (direction_altitude s i)))
    (submodule.finite_dimensional_inf_right (vector_span ℝ (points s '' ↑(finset.erase finset.univ i))ᗮ)
      (vector_span ℝ (set.range (points s))))

/-- An altitude is one-dimensional (i.e., a line). -/
@[simp] theorem findim_direction_altitude {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] {n : ℕ} (s : simplex ℝ P (n + 1)) (i : fin (n + bit0 1)) : finite_dimensional.findim ℝ ↥(affine_subspace.direction (altitude s i)) = 1 := sorry

/-- A line through a vertex is the altitude through that vertex if and
only if it is orthogonal to the opposite face. -/
theorem affine_span_insert_singleton_eq_altitude_iff {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] {n : ℕ} (s : simplex ℝ P (n + 1)) (i : fin (n + bit0 1)) (p : P) : affine_span ℝ (insert p (singleton (points s i))) = altitude s i ↔
  p ≠ points s i ∧
    p ∈ affine_span ℝ (set.range (points s)) ∧
      p -ᵥ points s i ∈ (affine_subspace.direction (affine_span ℝ (points s '' ↑(finset.erase finset.univ i)))ᗮ) := sorry

end simplex

namespace triangle

/-- The orthocenter of a triangle is the intersection of its
altitudes.  It is defined here as the 2-dimensional case of the
Monge point. -/
def orthocenter {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] (t : triangle ℝ P) : P :=
  simplex.monge_point t

/-- The orthocenter equals the Monge point. -/
theorem orthocenter_eq_monge_point {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] (t : triangle ℝ P) : orthocenter t = simplex.monge_point t :=
  rfl

/-- The position of the orthocenter in relation to the circumcenter
and centroid. -/
theorem orthocenter_eq_smul_vsub_vadd_circumcenter {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] (t : triangle ℝ P) : orthocenter t =
  bit1 1 • (finset.centroid ℝ finset.univ (simplex.points t) -ᵥ simplex.circumcenter t) +ᵥ simplex.circumcenter t := sorry

/-- The orthocenter lies in the affine span. -/
theorem orthocenter_mem_affine_span {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] (t : triangle ℝ P) : orthocenter t ∈ affine_span ℝ (set.range (simplex.points t)) :=
  simplex.monge_point_mem_affine_span t

/-- Two triangles with the same points have the same orthocenter. -/
theorem orthocenter_eq_of_range_eq {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] {t₁ : triangle ℝ P} {t₂ : triangle ℝ P} (h : set.range (simplex.points t₁) = set.range (simplex.points t₂)) : orthocenter t₁ = orthocenter t₂ :=
  simplex.monge_point_eq_of_range_eq h

/-- In the case of a triangle, altitudes are the same thing as Monge
planes. -/
theorem altitude_eq_monge_plane {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] (t : triangle ℝ P) {i₁ : fin (bit1 1)} {i₂ : fin (bit1 1)} {i₃ : fin (bit1 1)} (h₁₂ : i₁ ≠ i₂) (h₁₃ : i₁ ≠ i₃) (h₂₃ : i₂ ≠ i₃) : simplex.altitude t i₁ = simplex.monge_plane t i₂ i₃ := sorry

/-- The orthocenter lies in the altitudes. -/
theorem orthocenter_mem_altitude {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] (t : triangle ℝ P) {i₁ : fin (bit1 1)} : orthocenter t ∈ simplex.altitude t i₁ := sorry

/-- The orthocenter is the only point lying in any two of the
altitudes. -/
theorem eq_orthocenter_of_forall_mem_altitude {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] {t : triangle ℝ P} {i₁ : fin (bit1 1)} {i₂ : fin (bit1 1)} {p : P} (h₁₂ : i₁ ≠ i₂) (h₁ : p ∈ simplex.altitude t i₁) (h₂ : p ∈ simplex.altitude t i₂) : p = orthocenter t := sorry

/-- The distance from the orthocenter to the reflection of the
circumcenter in a side equals the circumradius. -/
theorem dist_orthocenter_reflection_circumcenter {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] (t : triangle ℝ P) {i₁ : fin (bit1 1)} {i₂ : fin (bit1 1)} (h : i₁ ≠ i₂) : dist (orthocenter t)
    (coe_fn (euclidean_geometry.reflection (affine_span ℝ (simplex.points t '' insert i₁ (singleton i₂))))
      (simplex.circumcenter t)) =
  simplex.circumradius t := sorry

/-- The distance from the orthocenter to the reflection of the
circumcenter in a side equals the circumradius, variant using a
`finset`. -/
theorem dist_orthocenter_reflection_circumcenter_finset {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] (t : triangle ℝ P) {i₁ : fin (bit1 1)} {i₂ : fin (bit1 1)} (h : i₁ ≠ i₂) : dist (orthocenter t)
    (coe_fn (euclidean_geometry.reflection (affine_span ℝ (simplex.points t '' ↑(insert i₁ (singleton i₂)))))
      (simplex.circumcenter t)) =
  simplex.circumradius t := sorry

/-- The affine span of the orthocenter and a vertex is contained in
the altitude. -/
theorem affine_span_orthocenter_point_le_altitude {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] (t : triangle ℝ P) (i : fin (bit1 1)) : affine_span ℝ (insert (orthocenter t) (singleton (simplex.points t i))) ≤ simplex.altitude t i := sorry

/-- Suppose we are given a triangle `t₁`, and replace one of its
vertices by its orthocenter, yielding triangle `t₂` (with vertices not
necessarily listed in the same order).  Then an altitude of `t₂` from
a vertex that was not replaced is the corresponding side of `t₁`. -/
theorem altitude_replace_orthocenter_eq_affine_span {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] {t₁ : triangle ℝ P} {t₂ : triangle ℝ P} {i₁ : fin (bit1 1)} {i₂ : fin (bit1 1)} {i₃ : fin (bit1 1)} {j₁ : fin (bit1 1)} {j₂ : fin (bit1 1)} {j₃ : fin (bit1 1)} (hi₁₂ : i₁ ≠ i₂) (hi₁₃ : i₁ ≠ i₃) (hi₂₃ : i₂ ≠ i₃) (hj₁₂ : j₁ ≠ j₂) (hj₁₃ : j₁ ≠ j₃) (hj₂₃ : j₂ ≠ j₃) (h₁ : simplex.points t₂ j₁ = orthocenter t₁) (h₂ : simplex.points t₂ j₂ = simplex.points t₁ i₂) (h₃ : simplex.points t₂ j₃ = simplex.points t₁ i₃) : simplex.altitude t₂ j₂ = affine_span ℝ (insert (simplex.points t₁ i₁) (singleton (simplex.points t₁ i₂))) := sorry

/-- Suppose we are given a triangle `t₁`, and replace one of its
vertices by its orthocenter, yielding triangle `t₂` (with vertices not
necessarily listed in the same order).  Then the orthocenter of `t₂`
is the vertex of `t₁` that was replaced. -/
theorem orthocenter_replace_orthocenter_eq_point {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] {t₁ : triangle ℝ P} {t₂ : triangle ℝ P} {i₁ : fin (bit1 1)} {i₂ : fin (bit1 1)} {i₃ : fin (bit1 1)} {j₁ : fin (bit1 1)} {j₂ : fin (bit1 1)} {j₃ : fin (bit1 1)} (hi₁₂ : i₁ ≠ i₂) (hi₁₃ : i₁ ≠ i₃) (hi₂₃ : i₂ ≠ i₃) (hj₁₂ : j₁ ≠ j₂) (hj₁₃ : j₁ ≠ j₃) (hj₂₃ : j₂ ≠ j₃) (h₁ : simplex.points t₂ j₁ = orthocenter t₁) (h₂ : simplex.points t₂ j₂ = simplex.points t₁ i₂) (h₃ : simplex.points t₂ j₃ = simplex.points t₁ i₃) : orthocenter t₂ = simplex.points t₁ i₁ := sorry

end triangle

end affine

namespace euclidean_geometry

/-- Four points form an orthocentric system if they consist of the
vertices of a triangle and its orthocenter. -/
def orthocentric_system {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] (s : set P) :=
  ∃ (t : affine.triangle ℝ P),
    ¬affine.triangle.orthocenter t ∈ set.range (affine.simplex.points t) ∧
      s = insert (affine.triangle.orthocenter t) (set.range (affine.simplex.points t))

/-- This is an auxiliary lemma giving information about the relation
of two triangles in an orthocentric system; it abstracts some
reasoning, with no geometric content, that is common to some other
lemmas.  Suppose the orthocentric system is generated by triangle `t`,
and we are given three points `p` in the orthocentric system.  Then
either we can find indices `i₁`, `i₂` and `i₃` for `p` such that `p
i₁` is the orthocenter of `t` and `p i₂` and `p i₃` are points `j₂`
and `j₃` of `t`, or `p` has the same points as `t`. -/
theorem exists_of_range_subset_orthocentric_system {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] {t : affine.triangle ℝ P} (ho : ¬affine.triangle.orthocenter t ∈ set.range (affine.simplex.points t)) {p : fin (bit1 1) → P} (hps : set.range p ⊆ insert (affine.triangle.orthocenter t) (set.range (affine.simplex.points t))) (hpi : function.injective p) : (∃ (i₁ : fin (bit1 1)),
    ∃ (i₂ : fin (bit1 1)),
      ∃ (i₃ : fin (bit1 1)),
        ∃ (j₂ : fin (bit1 1)),
          ∃ (j₃ : fin (bit1 1)),
            i₁ ≠ i₂ ∧
              i₁ ≠ i₃ ∧
                i₂ ≠ i₃ ∧
                  (∀ (i : fin (bit1 1)), i = i₁ ∨ i = i₂ ∨ i = i₃) ∧
                    p i₁ = affine.triangle.orthocenter t ∧
                      j₂ ≠ j₃ ∧ affine.simplex.points t j₂ = p i₂ ∧ affine.simplex.points t j₃ = p i₃) ∨
  set.range p = set.range (affine.simplex.points t) := sorry

/-- For any three points in an orthocentric system generated by
triangle `t`, there is a point in the subspace spanned by the triangle
from which the distance of all those three points equals the circumradius. -/
theorem exists_dist_eq_circumradius_of_subset_insert_orthocenter {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] {t : affine.triangle ℝ P} (ho : ¬affine.triangle.orthocenter t ∈ set.range (affine.simplex.points t)) {p : fin (bit1 1) → P} (hps : set.range p ⊆ insert (affine.triangle.orthocenter t) (set.range (affine.simplex.points t))) (hpi : function.injective p) : ∃ (c : P),
  ∃ (H : c ∈ affine_span ℝ (set.range (affine.simplex.points t))),
    ∀ (p₁ : P), p₁ ∈ set.range p → dist p₁ c = affine.simplex.circumradius t := sorry

/-- Any three points in an orthocentric system are affinely independent. -/
theorem orthocentric_system.affine_independent {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] {s : set P} (ho : orthocentric_system s) {p : fin (bit1 1) → P} (hps : set.range p ⊆ s) (hpi : function.injective p) : affine_independent ℝ p := sorry

/-- Any three points in an orthocentric system span the same subspace
as the whole orthocentric system. -/
theorem affine_span_of_orthocentric_system {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] {s : set P} (ho : orthocentric_system s) {p : fin (bit1 1) → P} (hps : set.range p ⊆ s) (hpi : function.injective p) : affine_span ℝ (set.range p) = affine_span ℝ s := sorry

/-- All triangles in an orthocentric system have the same circumradius. -/
theorem orthocentric_system.exists_circumradius_eq {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] {s : set P} (ho : orthocentric_system s) : ∃ (r : ℝ), ∀ (t : affine.triangle ℝ P), set.range (affine.simplex.points t) ⊆ s → affine.simplex.circumradius t = r := sorry

/-- Given any triangle in an orthocentric system, the fourth point is
its orthocenter. -/
theorem orthocentric_system.eq_insert_orthocenter {V : Type u_1} {P : Type u_2} [inner_product_space ℝ V] [metric_space P] [normed_add_torsor V P] {s : set P} (ho : orthocentric_system s) {t : affine.triangle ℝ P} (ht : set.range (affine.simplex.points t) ⊆ s) : s = insert (affine.triangle.orthocenter t) (set.range (affine.simplex.points t)) := sorry


universes u v

open function

theorem option.map_inj
  {α : Type u} {β : Type v} {f : α → β} (Hf : injective f) :
injective (option.map f) := λ a₁ a₂ H,
begin
  cases h₁ : a₁;cases h₂ : a₂;rw [h₁,h₂] at H; try {exact option.no_confusion H},
  congr,apply Hf,apply option.some.inj,exact H
end


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Stephen Morgan, Scott Morrison, Johannes Hölzl, Reid Barton

! This file was ported from Lean 3 source module category_theory.category.galois_connection
! leanprover-community/mathlib commit 3dadefa3f544b1db6214777fe47910739b54c66a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Category.Preorder
import Mathbin.CategoryTheory.Adjunction.Basic
import Mathbin.Order.GaloisConnection

/-!

# Galois connections between preorders are adjunctions.

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

* `galois_connection.adjunction` is the adjunction associated to a galois connection.

-/

universe u v

section

variable {X : Type u} {Y : Type v} [Preorder X] [Preorder Y]

#print GaloisConnection.adjunction /-
/-- A galois connection between preorders induces an adjunction between the associated categories.
-/
def GaloisConnection.adjunction {l : X → Y} {u : Y → X} (gc : GaloisConnection l u) :
    gc.monotone_l.Functor ⊣ gc.monotone_u.Functor :=
  CategoryTheory.Adjunction.mkOfHomEquiv
    {
      homEquiv := fun X Y =>
        ⟨fun f => (gc.le_u f.le).Hom, fun f => (gc.l_le f.le).Hom, by tidy, by tidy⟩ }
#align galois_connection.adjunction GaloisConnection.adjunction
-/

end

namespace CategoryTheory

variable {X : Type u} {Y : Type v} [Preorder X] [Preorder Y]

/- warning: category_theory.adjunction.gc -> CategoryTheory.Adjunction.gc is a dubious translation:
lean 3 declaration is
  forall {X : Type.{u1}} {Y : Type.{u2}} [_inst_1 : Preorder.{u1} X] [_inst_2 : Preorder.{u2} Y] {L : CategoryTheory.Functor.{u1, u2, u1, u2} X (Preorder.smallCategory.{u1} X _inst_1) Y (Preorder.smallCategory.{u2} Y _inst_2)} {R : CategoryTheory.Functor.{u2, u1, u2, u1} Y (Preorder.smallCategory.{u2} Y _inst_2) X (Preorder.smallCategory.{u1} X _inst_1)}, (CategoryTheory.Adjunction.{u1, u2, u1, u2} X (Preorder.smallCategory.{u1} X _inst_1) Y (Preorder.smallCategory.{u2} Y _inst_2) L R) -> (GaloisConnection.{u1, u2} X Y _inst_1 _inst_2 (CategoryTheory.Functor.obj.{u1, u2, u1, u2} X (Preorder.smallCategory.{u1} X _inst_1) Y (Preorder.smallCategory.{u2} Y _inst_2) L) (CategoryTheory.Functor.obj.{u2, u1, u2, u1} Y (Preorder.smallCategory.{u2} Y _inst_2) X (Preorder.smallCategory.{u1} X _inst_1) R))
but is expected to have type
  forall {X : Type.{u1}} {Y : Type.{u2}} [_inst_1 : Preorder.{u1} X] [_inst_2 : Preorder.{u2} Y] {L : CategoryTheory.Functor.{u1, u2, u1, u2} X (Preorder.smallCategory.{u1} X _inst_1) Y (Preorder.smallCategory.{u2} Y _inst_2)} {R : CategoryTheory.Functor.{u2, u1, u2, u1} Y (Preorder.smallCategory.{u2} Y _inst_2) X (Preorder.smallCategory.{u1} X _inst_1)}, (CategoryTheory.Adjunction.{u1, u2, u1, u2} X (Preorder.smallCategory.{u1} X _inst_1) Y (Preorder.smallCategory.{u2} Y _inst_2) L R) -> (GaloisConnection.{u1, u2} X Y _inst_1 _inst_2 (Prefunctor.obj.{succ u1, succ u2, u1, u2} X (CategoryTheory.CategoryStruct.toQuiver.{u1, u1} X (CategoryTheory.Category.toCategoryStruct.{u1, u1} X (Preorder.smallCategory.{u1} X _inst_1))) Y (CategoryTheory.CategoryStruct.toQuiver.{u2, u2} Y (CategoryTheory.Category.toCategoryStruct.{u2, u2} Y (Preorder.smallCategory.{u2} Y _inst_2))) (CategoryTheory.Functor.toPrefunctor.{u1, u2, u1, u2} X (Preorder.smallCategory.{u1} X _inst_1) Y (Preorder.smallCategory.{u2} Y _inst_2) L)) (Prefunctor.obj.{succ u2, succ u1, u2, u1} Y (CategoryTheory.CategoryStruct.toQuiver.{u2, u2} Y (CategoryTheory.Category.toCategoryStruct.{u2, u2} Y (Preorder.smallCategory.{u2} Y _inst_2))) X (CategoryTheory.CategoryStruct.toQuiver.{u1, u1} X (CategoryTheory.Category.toCategoryStruct.{u1, u1} X (Preorder.smallCategory.{u1} X _inst_1))) (CategoryTheory.Functor.toPrefunctor.{u2, u1, u2, u1} Y (Preorder.smallCategory.{u2} Y _inst_2) X (Preorder.smallCategory.{u1} X _inst_1) R)))
Case conversion may be inaccurate. Consider using '#align category_theory.adjunction.gc CategoryTheory.Adjunction.gcₓ'. -/
/-- An adjunction between preorder categories induces a galois connection.
-/
theorem Adjunction.gc {L : X ⥤ Y} {R : Y ⥤ X} (adj : L ⊣ R) : GaloisConnection L.obj R.obj :=
  fun x y =>
  ⟨fun h => ((adj.homEquiv x y).toFun h.Hom).le, fun h => ((adj.homEquiv x y).invFun h.Hom).le⟩
#align category_theory.adjunction.gc CategoryTheory.Adjunction.gc

end CategoryTheory


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

! This file was ported from Lean 3 source module topology.category.Top.open_nhds
! leanprover-community/mathlib commit 1ec4876214bf9f1ddfbf97ae4b0d777ebd5d6938
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.Category.Top.Opens

/-!
# The category of open neighborhoods of a point

Given an object `X` of the category `Top` of topological spaces and a point `x : X`, this file
builds the type `open_nhds x` of open neighborhoods of `x` in `X` and endows it with the partial
order given by inclusion and the corresponding category structure (as a full subcategory of the
poset category `set X`). This is used in `topology.sheaves.stalks` to build the stalk of a sheaf
at `x` as a limit over `open_nhds x`.

## Main declarations

Besides `open_nhds`, the main constructions here are:

* `inclusion (x : X)`: the obvious functor `open_nhds x ⥤ opens X`
* `functor_nhds`: An open map `f : X ⟶ Y` induces a functor `open_nhds x ⥤ open_nhds (f x)`
* `adjunction_nhds`: An open map `f : X ⟶ Y` induces an adjunction between `open_nhds x` and
                     `open_nhds (f x)`.
-/

open CategoryTheory

open TopologicalSpace

open Opposite

universe u

variable {X Y : TopCat.{u}} (f : X ⟶ Y)

namespace TopologicalSpace

/-- The type of open neighbourhoods of a point `x` in a (bundled) topological space. -/
def OpenNhds (x : X) :=
  FullSubcategory fun U : Opens X => x ∈ U
#align topological_space.open_nhds TopologicalSpace.OpenNhds

namespace OpenNhds

instance (x : X) : PartialOrder (OpenNhds x)
    where
  le U V := U.1 ≤ V.1
  le_refl _ := le_rfl
  le_trans _ _ _ := le_trans
  le_antisymm _ _ i j := FullSubcategory.ext _ _ <| le_antisymm i j

instance (x : X) : Lattice (OpenNhds x) :=
  { OpenNhds.partialOrder x with
    inf := fun U V => ⟨U.1 ⊓ V.1, ⟨U.2, V.2⟩⟩
    le_inf := fun U V W => @le_inf _ _ U.1.1 V.1.1 W.1.1
    inf_le_left := fun U V => @inf_le_left _ _ U.1.1 V.1.1
    inf_le_right := fun U V => @inf_le_right _ _ U.1.1 V.1.1
    sup := fun U V => ⟨U.1 ⊔ V.1, V.1.1.mem_union_left U.2⟩
    sup_le := fun U V W => @sup_le _ _ U.1.1 V.1.1 W.1.1
    le_sup_left := fun U V => @le_sup_left _ _ U.1.1 V.1.1
    le_sup_right := fun U V => @le_sup_right _ _ U.1.1 V.1.1 }

instance (x : X) : OrderTop (OpenNhds x)
    where
  top := ⟨⊤, trivial⟩
  le_top _ := le_top

instance (x : X) : Inhabited (OpenNhds x) :=
  ⟨⊤⟩

instance openNhdsCategory (x : X) : Category.{u} (OpenNhds x) :=
  by
  unfold open_nhds
  infer_instance
#align topological_space.open_nhds.open_nhds_category TopologicalSpace.OpenNhds.openNhdsCategory

instance opensNhdsHomHasCoeToFun {x : X} {U V : OpenNhds x} : CoeFun (U ⟶ V) fun _ => U.1 → V.1 :=
  ⟨fun f x => ⟨x, f.le x.2⟩⟩
#align topological_space.open_nhds.opens_nhds_hom_has_coe_to_fun TopologicalSpace.OpenNhds.opensNhdsHomHasCoeToFun

/-- The inclusion `U ⊓ V ⟶ U` as a morphism in the category of open sets.
-/
def infLeLeft {x : X} (U V : OpenNhds x) : U ⊓ V ⟶ U :=
  homOfLE inf_le_left
#align topological_space.open_nhds.inf_le_left TopologicalSpace.OpenNhds.infLeLeft

/-- The inclusion `U ⊓ V ⟶ V` as a morphism in the category of open sets.
-/
def infLeRight {x : X} (U V : OpenNhds x) : U ⊓ V ⟶ V :=
  homOfLE inf_le_right
#align topological_space.open_nhds.inf_le_right TopologicalSpace.OpenNhds.infLeRight

/-- The inclusion functor from open neighbourhoods of `x`
to open sets in the ambient topological space. -/
def inclusion (x : X) : OpenNhds x ⥤ Opens X :=
  fullSubcategoryInclusion _
#align topological_space.open_nhds.inclusion TopologicalSpace.OpenNhds.inclusion

@[simp]
theorem inclusion_obj (x : X) (U) (p) : (inclusion x).obj ⟨U, p⟩ = U :=
  rfl
#align topological_space.open_nhds.inclusion_obj TopologicalSpace.OpenNhds.inclusion_obj

theorem openEmbedding {x : X} (U : OpenNhds x) : OpenEmbedding U.1.inclusion :=
  U.1.OpenEmbedding
#align topological_space.open_nhds.open_embedding TopologicalSpace.OpenNhds.openEmbedding

/-- The preimage functor from neighborhoods of `f x` to neighborhoods of `x`. -/
def map (x : X) : OpenNhds (f x) ⥤ OpenNhds x
    where
  obj U := ⟨(Opens.map f).obj U.1, U.2⟩
  map U V i := (Opens.map f).map i
#align topological_space.open_nhds.map TopologicalSpace.OpenNhds.map

@[simp]
theorem map_obj (x : X) (U) (q) : (map f x).obj ⟨U, q⟩ = ⟨(Opens.map f).obj U, by tidy⟩ :=
  rfl
#align topological_space.open_nhds.map_obj TopologicalSpace.OpenNhds.map_obj

@[simp]
theorem map_id_obj (x : X) (U) : (map (𝟙 X) x).obj U = U := by tidy
#align topological_space.open_nhds.map_id_obj TopologicalSpace.OpenNhds.map_id_obj

@[simp]
theorem map_id_obj' (x : X) (U) (p) (q) : (map (𝟙 X) x).obj ⟨⟨U, p⟩, q⟩ = ⟨⟨U, p⟩, q⟩ :=
  rfl
#align topological_space.open_nhds.map_id_obj' TopologicalSpace.OpenNhds.map_id_obj'

@[simp]
theorem map_id_obj_unop (x : X) (U : (OpenNhds x)ᵒᵖ) : (map (𝟙 X) x).obj (unop U) = unop U := by
  simp
#align topological_space.open_nhds.map_id_obj_unop TopologicalSpace.OpenNhds.map_id_obj_unop

@[simp]
theorem op_map_id_obj (x : X) (U : (OpenNhds x)ᵒᵖ) : (map (𝟙 X) x).op.obj U = U := by simp
#align topological_space.open_nhds.op_map_id_obj TopologicalSpace.OpenNhds.op_map_id_obj

/-- `opens.map f` and `open_nhds.map f` form a commuting square (up to natural isomorphism)
with the inclusion functors into `opens X`. -/
def inclusionMapIso (x : X) : inclusion (f x) ⋙ Opens.map f ≅ map f x ⋙ inclusion x :=
  NatIso.ofComponents (fun U => by constructor; exact 𝟙 _; exact 𝟙 _) (by tidy)
#align topological_space.open_nhds.inclusion_map_iso TopologicalSpace.OpenNhds.inclusionMapIso

@[simp]
theorem inclusionMapIso_hom (x : X) : (inclusionMapIso f x).Hom = 𝟙 _ :=
  rfl
#align topological_space.open_nhds.inclusion_map_iso_hom TopologicalSpace.OpenNhds.inclusionMapIso_hom

@[simp]
theorem inclusionMapIso_inv (x : X) : (inclusionMapIso f x).inv = 𝟙 _ :=
  rfl
#align topological_space.open_nhds.inclusion_map_iso_inv TopologicalSpace.OpenNhds.inclusionMapIso_inv

end OpenNhds

end TopologicalSpace

namespace IsOpenMap

open TopologicalSpace

variable {f}

/-- An open map `f : X ⟶ Y` induces a functor `open_nhds x ⥤ open_nhds (f x)`.
-/
@[simps]
def functorNhds (h : IsOpenMap f) (x : X) : OpenNhds x ⥤ OpenNhds (f x)
    where
  obj U := ⟨h.Functor.obj U.1, ⟨x, U.2, rfl⟩⟩
  map U V i := h.Functor.map i
#align is_open_map.functor_nhds IsOpenMap.functorNhds

/-- An open map `f : X ⟶ Y` induces an adjunction between `open_nhds x` and `open_nhds (f x)`.
-/
def adjunctionNhds (h : IsOpenMap f) (x : X) : IsOpenMap.functorNhds h x ⊣ OpenNhds.map f x :=
  Adjunction.mkOfUnitCounit
    { Unit := { app := fun U => homOfLE fun x hxU => ⟨x, hxU, rfl⟩ }
      counit := { app := fun V => homOfLE fun y ⟨x, hfxV, hxy⟩ => hxy ▸ hfxV } }
#align is_open_map.adjunction_nhds IsOpenMap.adjunctionNhds

end IsOpenMap


/-
Copyright (c) 2022 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import algebra.hom.group
import algebra.order.with_zero
import order.hom.basic

/-!
# Ordered monoid and group homomorphisms

This file defines morphisms between (additive) ordered monoids.

## Types of morphisms

* `order_add_monoid_hom`: Ordered additive monoid homomorphisms.
* `order_monoid_hom`: Ordered monoid homomorphisms.
* `order_monoid_with_zero_hom`: Ordered monoid with zero homomorphisms.

## Typeclasses

* `order_add_monoid_hom_class`
* `order_monoid_hom_class`
* `order_monoid_with_zero_hom_class`

## Notation

* `→+o`: Bundled ordered additive monoid homs. Also use for additive groups homs.
* `→*o`: Bundled ordered monoid homs. Also use for groups homs.
* `→*₀o`: Bundled ordered monoid with zero homs. Also use for groups with zero homs.

## Implementation notes

There's a coercion from bundled homs to fun, and the canonical notation is to use the bundled hom as
a function via this coercion.

There is no `order_group_hom` -- the idea is that `order_monoid_hom` is used.
The constructor for `order_monoid_hom` needs a proof of `map_one` as well as `map_mul`; a separate
constructor `order_monoid_hom.mk'` will construct ordered group homs (i.e. ordered monoid homs
between ordered groups) given only a proof that multiplication is preserved,

Implicit `{}` brackets are often used instead of type class `[]` brackets. This is done when the
instances can be inferred because they are implicit arguments to the type `order_monoid_hom`. When
they can be inferred from the type it is faster to use this method than to use type class inference.

## Tags

ordered monoid, ordered group, monoid with zero
-/

open function

variables {F α β γ δ : Type*}

section add_monoid

/-- `α →+o β` is the type of monotone functions `α → β` that preserve the `ordered_add_comm_monoid`
structure.

`order_add_monoid_hom` is also used for ordered group homomorphisms.

When possible, instead of parametrizing results over `(f : α →+o β)`,
you should parametrize over `(F : Type*) [order_add_monoid_hom_class F α β] (f : F)`.

When you extend this structure, make sure to extend `order_add_monoid_hom_class`. -/
structure order_add_monoid_hom (α β : Type*) [preorder α] [preorder β] [add_zero_class α]
  [add_zero_class β] extends α →+ β :=
(monotone' : monotone to_fun)

infixr ` →+o `:25 := order_add_monoid_hom

/-- `order_add_monoid_hom_class F α β` states that `F` is a type of ordered monoid homomorphisms.

You should also extend this typeclass when you extend `order_add_monoid_hom`. -/
class order_add_monoid_hom_class (F : Type*) (α β : out_param $ Type*) [preorder α] [preorder β]
  [add_zero_class α] [add_zero_class β]
  extends add_monoid_hom_class F α β :=
(monotone (f : F) : monotone f)

-- Instances and lemmas are defined below through `@[to_additive]`.

end add_monoid

section monoid
variables [preorder α] [preorder β] [mul_one_class α] [mul_one_class β]

/-- `α →*o β` is the type of functions `α → β` that preserve the `ordered_comm_monoid` structure.

`order_monoid_hom` is also used for ordered group homomorphisms.

When possible, instead of parametrizing results over `(f : α →*o β)`,
you should parametrize over `(F : Type*) [order_monoid_hom_class F α β] (f : F)`.

When you extend this structure, make sure to extend `order_monoid_hom_class`. -/
@[to_additive]
structure order_monoid_hom (α β : Type*) [preorder α] [preorder β] [mul_one_class α]
  [mul_one_class β]
  extends α →* β :=
(monotone' : monotone to_fun)

infixr ` →*o `:25 := order_monoid_hom

/-- `order_monoid_hom_class F α β` states that `F` is a type of ordered monoid homomorphisms.

You should also extend this typeclass when you extend `order_monoid_hom`. -/
@[to_additive]
class order_monoid_hom_class (F : Type*) (α β : out_param $ Type*)
  [preorder α] [preorder β] [mul_one_class α] [mul_one_class β]
  extends monoid_hom_class F α β :=
(monotone (f : F) : monotone f)

@[priority 100, to_additive] -- See note [lower instance priority]
instance order_monoid_hom_class.to_order_hom_class [order_monoid_hom_class F α β] :
  order_hom_class F α β :=
{ map_rel := order_monoid_hom_class.monotone }

@[to_additive]
instance [order_monoid_hom_class F α β] : has_coe_t F (α →*o β) :=
⟨λ f, { to_fun := f, map_one' := map_one f, map_mul' := map_mul f,
  monotone' := order_monoid_hom_class.monotone _ }⟩

end monoid

section monoid_with_zero
variables [preorder α] [preorder β] [mul_zero_one_class α] [mul_zero_one_class β]

/-- `order_monoid_with_zero_hom α β` is the type of functions `α → β` that preserve
the `monoid_with_zero` structure.

`order_monoid_with_zero_hom` is also used for group homomorphisms.

When possible, instead of parametrizing results over `(f : α →+ β)`,
you should parametrize over `(F : Type*) [order_monoid_with_zero_hom_class F α β] (f : F)`.

When you extend this structure, make sure to extend `order_monoid_with_zero_hom_class`. -/
structure order_monoid_with_zero_hom (α β : Type*) [preorder α] [preorder β]
  [mul_zero_one_class α] [mul_zero_one_class β]
  extends α →*₀ β :=
(monotone' : monotone to_fun)

infixr ` →*₀o `:25 := order_monoid_with_zero_hom

/-- `order_monoid_with_zero_hom_class F α β` states that `F` is a type of
ordered monoid with zero homomorphisms.

You should also extend this typeclass when you extend `order_monoid_with_zero_hom`. -/
class order_monoid_with_zero_hom_class (F : Type*) (α β : out_param $ Type*)
  [preorder α] [preorder β] [mul_zero_one_class α] [mul_zero_one_class β]
  extends monoid_with_zero_hom_class F α β :=
(monotone (f : F) : monotone f)

@[priority 100] -- See note [lower instance priority]
instance order_monoid_with_zero_hom_class.to_order_monoid_hom_class
  [order_monoid_with_zero_hom_class F α β] : order_monoid_hom_class F α β :=
{ .. ‹order_monoid_with_zero_hom_class F α β› }

instance [order_monoid_with_zero_hom_class F α β] : has_coe_t F (α →*₀o β) :=
⟨λ f, { to_fun := f, map_one' := map_one f, map_zero' := map_zero f, map_mul' := map_mul f,
  monotone' := order_monoid_with_zero_hom_class.monotone _ }⟩

end monoid_with_zero

namespace order_monoid_hom
section preorder
variables [preorder α] [preorder β] [preorder γ] [preorder δ] [mul_one_class α]
  [mul_one_class β] [mul_one_class γ] [mul_one_class δ] {f g : α →*o β}

@[to_additive]
instance : order_monoid_hom_class (α →*o β) α β :=
{ coe := λ f, f.to_fun,
  coe_injective' := λ f g h, by { obtain ⟨⟨_, _⟩, _⟩ := f, obtain ⟨⟨_, _⟩, _⟩ := g, congr' },
  map_mul := λ f, f.map_mul',
  map_one := λ f, f.map_one',
  monotone := λ f, f.monotone' }

/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
directly. -/
@[to_additive "Helper instance for when there's too many metavariables to apply
`fun_like.has_coe_to_fun` directly."]
instance : has_coe_to_fun (α →*o β) (λ _, α → β) := fun_like.has_coe_to_fun

-- Other lemmas should be accessed through the `fun_like` API
@[ext, to_additive] lemma ext (h : ∀ a, f a = g a) : f = g := fun_like.ext f g h
@[to_additive] lemma to_fun_eq_coe (f : α →*o β) : f.to_fun = (f : α → β) := rfl
@[simp, to_additive] lemma coe_mk (f : α →* β) (h) : (order_monoid_hom.mk f h : α → β) = f := rfl
@[simp, to_additive] lemma mk_coe (f : α →*o β) (h) : order_monoid_hom.mk (f :  α →* β) h = f :=
by { ext, refl }

/-- Reinterpret an ordered monoid homomorphism as an order homomorphism. -/
@[to_additive "Reinterpret an ordered additive monoid homomorphism as an order homomorphism."]
def to_order_hom (f : α →*o β) : α →o β := { ..f }

@[simp, to_additive] lemma coe_monoid_hom (f : α →*o β) : ((f : α →* β) : α → β) = f := rfl
@[simp, to_additive] lemma coe_order_hom (f : α →*o β) : ((f : α →o β) : α → β) = f := rfl

@[to_additive] lemma to_monoid_hom_injective : injective (to_monoid_hom : _ → α →* β) :=
λ f g h, ext $ by convert fun_like.ext_iff.1 h

@[to_additive] lemma to_order_hom_injective : injective (to_order_hom : _ → α →o β) :=
λ f g h, ext $ by convert fun_like.ext_iff.1 h

/-- Copy of an `order_monoid_hom` with a new `to_fun` equal to the old one. Useful to fix
definitional equalities. -/
@[to_additive "Copy of an `order_monoid_hom` with a new `to_fun` equal to the old one. Useful to fix
definitional equalities."]
protected def copy (f : α →*o β) (f' : α → β) (h : f' = f) : α →*o β :=
{ to_fun := f',
  monotone' := h.symm.subst f.monotone',
  ..f.to_monoid_hom.copy f' $ by exact h }

variables (α)

/-- The identity map as an ordered monoid homomorphism. -/
@[to_additive "The identity map as an ordered additive monoid homomorphism."]
protected def id : α →*o α := { ..monoid_hom.id α, ..order_hom.id }

@[simp, to_additive] lemma coe_id : ⇑(order_monoid_hom.id α) = id := rfl

@[to_additive] instance : inhabited (α →*o α) := ⟨order_monoid_hom.id α⟩

variables {α}

/-- Composition of `order_monoid_hom`s as an `order_monoid_hom`. -/
@[to_additive "Composition of `order_add_monoid_hom`s as an `order_add_monoid_hom`"]
def comp (f : β →*o γ) (g : α →*o β) : α →*o γ :=
{ ..f.to_monoid_hom.comp (g : α →* β), ..f.to_order_hom.comp (g : α →o β) }

@[simp, to_additive] lemma coe_comp (f : β →*o γ) (g : α →*o β) : (f.comp g : α → γ) = f ∘ g := rfl
@[simp, to_additive] lemma comp_apply (f : β →*o γ) (g : α →*o β) (a : α) :
  (f.comp g) a = f (g a) := rfl
@[simp, to_additive] lemma coe_comp_monoid_hom (f : β →*o γ) (g : α →*o β) :
  (f.comp g : α →* γ) = (f : β →* γ).comp g := rfl
@[simp, to_additive] lemma coe_comp_order_hom (f : β →*o γ) (g : α →*o β) :
  (f.comp g : α →o γ) = (f : β →o γ).comp g := rfl
@[simp, to_additive] lemma comp_assoc (f : γ →*o δ) (g : β →*o γ) (h : α →*o β) :
  (f.comp g).comp h = f.comp (g.comp h) := rfl
@[simp, to_additive] lemma comp_id (f : α →*o β) : f.comp (order_monoid_hom.id α) = f :=
ext $ λ a, rfl
@[simp, to_additive] lemma id_comp (f : α →*o β) : (order_monoid_hom.id β).comp f = f :=
ext $ λ a, rfl

@[to_additive]
lemma cancel_right {g₁ g₂ : β →*o γ} {f : α →*o β} (hf : function.surjective f) :
  g₁.comp f = g₂.comp f ↔ g₁ = g₂ :=
⟨λ h, ext $ hf.forall.2 $ fun_like.ext_iff.1 h, congr_arg _⟩

@[to_additive]
lemma cancel_left {g : β →*o γ} {f₁ f₂ : α →*o β} (hg : function.injective g) :
  g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ :=
⟨λ h, ext $ λ a, hg $ by rw [←comp_apply, h, comp_apply], congr_arg _⟩

/-- `1` is the homomorphism sending all elements to `1`. -/
@[to_additive "`1` is the homomorphism sending all elements to `1`."]
instance : has_one (α →*o β) := ⟨{ monotone' := monotone_const, ..(1 : α →* β) }⟩

@[simp, to_additive]

@[simp, to_additive] lemma one_comp (f : α →*o β) : (1 : β →*o γ).comp f = 1 := rfl
@[simp, to_additive] lemma comp_one (f : β →*o γ) : f.comp (1 : α →*o β) = 1 :=
by { ext, exact map_one f }

end preorder

section mul
variables [ordered_comm_monoid α] [ordered_comm_monoid β] [ordered_comm_monoid γ]

/-- For two ordered monoid morphisms `f` and `g`, their product is the ordered monoid morphism
sending `a` to `f a * g a`. -/
@[to_additive "For two ordered additive monoid morphisms `f` and `g`, their product is the ordered
additive monoid morphism sending `a` to `f a + g a`."]
instance : has_mul (α →*o β) :=
⟨λ f g, { monotone' := f.monotone'.mul' g.monotone', ..(f * g : α →* β) }⟩

@[simp, to_additive] lemma coe_mul (f g : α →*o β) : ⇑(f * g) = f * g := rfl
@[simp, to_additive] lemma mul_apply (f g : α →*o β) (a : α) : (f * g) a = f a * g a := rfl

@[to_additive] lemma mul_comp (g₁ g₂ : β →*o γ) (f : α →*o β) :
  (g₁ * g₂).comp f = g₁.comp f * g₂.comp f := rfl
@[to_additive] lemma comp_mul (g : β →*o γ) (f₁ f₂ : α →*o β) :
  g.comp (f₁ * f₂) = g.comp f₁ * g.comp f₂ := by { ext, exact map_mul g _ _ }

end mul

section ordered_comm_monoid
variables {hα : ordered_comm_monoid α} {hβ : ordered_comm_monoid β}
include hα hβ

@[simp, to_additive] lemma to_monoid_hom_eq_coe (f : α →*o β) : f.to_monoid_hom = f :=
by { ext, refl }
@[simp, to_additive] lemma to_order_hom_eq_coe (f : α →*o β) : f.to_order_hom = f := rfl

end ordered_comm_monoid

section ordered_comm_group
variables {hα : ordered_comm_group α} {hβ : ordered_comm_group β}
include hα hβ

/-- Makes an ordered group homomorphism from a proof that the map preserves multiplication. -/
@[to_additive "Makes an ordered additive group homomorphism from a proof that the map preserves
addition.",
  simps {fully_applied := ff}]
def mk' (f : α → β) (hf : monotone f) (map_mul : ∀ a b : α, f (a * b) = f a * f b) : α →*o β :=
{ monotone' := hf,
  ..monoid_hom.mk' f map_mul }

end ordered_comm_group
end order_monoid_hom

namespace order_monoid_with_zero_hom
section preorder
variables [preorder α] [preorder β] [preorder γ] [preorder δ] [mul_zero_one_class α]
  [mul_zero_one_class β] [mul_zero_one_class γ] [mul_zero_one_class δ] {f g : α →*₀o β}

instance : order_monoid_with_zero_hom_class (α →*₀o β) α β :=
{ coe := λ f, f.to_fun,
  coe_injective' := λ f g h, by { obtain ⟨⟨_, _⟩, _⟩ := f, obtain ⟨⟨_, _⟩, _⟩ := g, congr' },
  map_mul := λ f, f.map_mul',
  map_one := λ f, f.map_one',
  map_zero := λ f, f.map_zero',
  monotone := λ f, f.monotone' }

/-- Helper instance for when there's too many metavariables to apply `fun_like.has_coe_to_fun`
directly. -/
instance : has_coe_to_fun (α →*₀o β) (λ _, α → β) := fun_like.has_coe_to_fun

-- Other lemmas should be accessed through the `fun_like` API
@[ext] lemma ext (h : ∀ a, f a = g a) : f = g := fun_like.ext f g h
lemma to_fun_eq_coe (f : α →*₀o β) : f.to_fun = (f : α → β) := rfl
@[simp] lemma coe_mk (f : α →*₀ β) (h) : (order_monoid_with_zero_hom.mk f h : α → β) = f := rfl
@[simp] lemma mk_coe (f : α →*₀o β) (h) : order_monoid_with_zero_hom.mk (f :  α →*₀ β) h = f :=
by { ext, refl }

/-- Reinterpret an ordered monoid with zero homomorphism as an order monoid homomorphism. -/
def to_order_monoid_hom (f : α →*₀o β) : α →*o β := { ..f }

@[simp] lemma coe_monoid_with_zero_hom (f : α →*₀o β) : ⇑(f : α →*₀ β) = f := rfl
@[simp] lemma coe_order_monoid_hom (f : α →*₀o β) : ⇑(f : α →*o β) = f := rfl

lemma to_order_monoid_hom_injective : injective (to_order_monoid_hom : _ → α →*o β) :=
λ f g h, ext $ by convert fun_like.ext_iff.1 h

lemma to_monoid_with_zero_hom_injective : injective (to_monoid_with_zero_hom : _ → α →*₀ β) :=
λ f g h, ext $ by convert fun_like.ext_iff.1 h

/-- Copy of an `order_monoid_hom` with a new `to_fun` equal to the old one. Useful to fix
definitional equalities. -/
protected def copy (f : α →*o β) (f' : α → β) (h : f' = f) : α →*o β :=
{ to_fun := f',
  monotone' := h.symm.subst f.monotone',
  ..f.to_monoid_hom.copy f' (by exact h) }

variables (α)

/-- The identity map as an ordered monoid with zero homomorphism. -/
protected def id : α →*₀o α := { ..monoid_with_zero_hom.id α, ..order_hom.id }

@[simp] lemma coe_id : ⇑(order_monoid_with_zero_hom.id α) = id := rfl

instance : inhabited (α →*₀o α) := ⟨order_monoid_with_zero_hom.id α⟩

variables {α}

/-- Composition of `order_monoid_with_zero_hom`s as an `order_monoid_with_zero_hom`. -/
def comp (f : β →*₀o γ) (g : α →*₀o β) : α →*₀o γ :=
{ ..f.to_monoid_with_zero_hom.comp (g : α →*₀ β), ..f.to_order_monoid_hom.comp (g : α →*o β) }

@[simp] lemma coe_comp (f : β →*₀o γ) (g : α →*₀o β) : (f.comp g : α → γ) = f ∘ g := rfl
@[simp] lemma comp_apply (f : β →*₀o γ) (g : α →*₀o β) (a : α) : (f.comp g) a = f (g a) := rfl
@[simp] lemma coe_comp_monoid_with_zero_hom (f : β →*₀o γ) (g : α →*₀o β) :
  (f.comp g : α →*₀ γ) = (f : β →*₀ γ).comp g := rfl
@[simp] lemma coe_comp_order_monoid_hom (f : β →*₀o γ) (g : α →*₀o β) :
  (f.comp g : α →*o γ) = (f : β →*o γ).comp g := rfl
@[simp] lemma comp_assoc (f : γ →*₀o δ) (g : β →*₀o γ) (h : α →*₀o β) :
  (f.comp g).comp h = f.comp (g.comp h) := rfl
@[simp] lemma comp_id (f : α →*₀o β) : f.comp (order_monoid_with_zero_hom.id α) = f :=
ext $ λ a, rfl
@[simp] lemma id_comp (f : α →*₀o β) : (order_monoid_with_zero_hom.id β).comp f = f :=
ext $ λ a, rfl

lemma cancel_right {g₁ g₂ : β →*₀o γ} {f : α →*₀o β} (hf : function.surjective f) :
  g₁.comp f = g₂.comp f ↔ g₁ = g₂ :=
⟨λ h, ext $ hf.forall.2 $ fun_like.ext_iff.1 h, congr_arg _⟩

lemma cancel_left {g : β →*₀o γ} {f₁ f₂ : α →*₀o β} (hg : function.injective g) :
  g.comp f₁ = g.comp f₂ ↔ f₁ = f₂ :=
⟨λ h, ext $ λ a, hg $ by rw [←comp_apply, h, comp_apply], congr_arg _⟩

end preorder

section mul
variables [linear_ordered_comm_monoid_with_zero α] [linear_ordered_comm_monoid_with_zero β]
  [linear_ordered_comm_monoid_with_zero γ]

/-- For two ordered monoid morphisms `f` and `g`, their product is the ordered monoid morphism
sending `a` to `f a * g a`. -/
instance : has_mul (α →*₀o β) :=
⟨λ f g, { monotone' := f.monotone'.mul' g.monotone', ..(f * g : α →*₀ β) }⟩

@[simp] lemma coe_mul (f g : α →*₀o β) : ⇑(f * g) = f * g := rfl
@[simp] lemma mul_apply (f g : α →*₀o β) (a : α) : (f * g) a = f a * g a := rfl

lemma mul_comp (g₁ g₂ : β →*₀o γ) (f : α →*₀o β) : (g₁ * g₂).comp f = g₁.comp f * g₂.comp f := rfl
lemma comp_mul (g : β →*₀o γ) (f₁ f₂ : α →*₀o β) : g.comp (f₁ * f₂) = g.comp f₁ * g.comp f₂ :=
ext $ λ _, map_mul g _ _

end mul

section linear_ordered_comm_monoid_with_zero
variables {hα : preorder α} {hα' : mul_zero_one_class α} {hβ : preorder β}
  {hβ' : mul_zero_one_class β}
include hα hα' hβ hβ'

@[simp] lemma to_monoid_with_zero_hom_eq_coe (f : α →*₀o β) : f.to_monoid_with_zero_hom = f :=
by { ext, refl }
@[simp] lemma to_order_monoid_hom_eq_coe (f : α →*₀o β) : f.to_order_monoid_hom = f := rfl

end linear_ordered_comm_monoid_with_zero
end order_monoid_with_zero_hom