/-
Copyright (c) 2020 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Myers, Yury Kudryashov.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.linear_algebra.affine_space.midpoint
import Mathlib.topology.metric_space.isometry
import Mathlib.topology.instances.real_vector_space
import Mathlib.PostPort

universes u_1 u_2 l u_3 u_4 u_5 u_6

namespace Mathlib

/-!
# Torsors of additive normed group actions.

This file defines torsors of additive normed group actions, with a
metric space structure.  The motivating case is Euclidean affine
spaces.

-/

/-- A `normed_add_torsor V P` is a torsor of an additive normed group
action by a `normed_group V` on points `P`. We bundle the metric space
structure and require the distance to be the same as results from the
norm (which in fact implies the distance yields a metric space, but
bundling just the distance and using an instance for the metric space
results in type class problems). -/
class normed_add_torsor (V : outParam (Type u_1)) (P : Type u_2) [outParam (normed_group V)] [metric_space P]
extends add_torsor V P
where
  dist_eq_norm' : ∀ (x y : P), dist x y = norm (x -ᵥ y)

/-- The distance equals the norm of subtracting two points. In this
lemma, it is necessary to have `V` as an explicit argument; otherwise
`rw dist_eq_norm_vsub` sometimes doesn't work. -/
theorem dist_eq_norm_vsub (V : Type u_2) {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] (x : P) (y : P) : dist x y = norm (x -ᵥ y) :=
  normed_add_torsor.dist_eq_norm' x y

/-- A `normed_group` is a `normed_add_torsor` over itself. -/
protected instance normed_group.normed_add_torsor (V : Type u_2) [normed_group V] : normed_add_torsor V V :=
  normed_add_torsor.mk dist_eq_norm

@[simp] theorem dist_vadd_cancel_left {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] (v : V) (x : P) (y : P) : dist (v +ᵥ x) (v +ᵥ y) = dist x y := sorry

@[simp] theorem dist_vadd_cancel_right {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] (v₁ : V) (v₂ : V) (x : P) : dist (v₁ +ᵥ x) (v₂ +ᵥ x) = dist v₁ v₂ := sorry

@[simp] theorem dist_vadd_left {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] (v : V) (x : P) : dist (v +ᵥ x) x = norm v := sorry

@[simp] theorem dist_vadd_right {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] (v : V) (x : P) : dist x (v +ᵥ x) = norm v :=
  eq.mpr (id (Eq._oldrec (Eq.refl (dist x (v +ᵥ x) = norm v)) (dist_comm x (v +ᵥ x))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (dist (v +ᵥ x) x = norm v)) (dist_vadd_left v x))) (Eq.refl (norm v)))

@[simp] theorem dist_vsub_cancel_left {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] (x : P) (y : P) (z : P) : dist (x -ᵥ y) (x -ᵥ z) = dist y z := sorry

@[simp] theorem dist_vsub_cancel_right {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] (x : P) (y : P) (z : P) : dist (x -ᵥ z) (y -ᵥ z) = dist x y :=
  eq.mpr (id (Eq._oldrec (Eq.refl (dist (x -ᵥ z) (y -ᵥ z) = dist x y)) (dist_eq_norm (x -ᵥ z) (y -ᵥ z))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (norm (x -ᵥ z - (y -ᵥ z)) = dist x y)) (vsub_sub_vsub_cancel_right x y z)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (norm (x -ᵥ y) = dist x y)) (dist_eq_norm_vsub V x y))) (Eq.refl (norm (x -ᵥ y)))))

theorem dist_vadd_vadd_le {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] (v : V) (v' : V) (p : P) (p' : P) : dist (v +ᵥ p) (v' +ᵥ p') ≤ dist v v' + dist p p' := sorry

theorem dist_vsub_vsub_le {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] (p₁ : P) (p₂ : P) (p₃ : P) (p₄ : P) : dist (p₁ -ᵥ p₂) (p₃ -ᵥ p₄) ≤ dist p₁ p₃ + dist p₂ p₄ := sorry

theorem nndist_vadd_vadd_le {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] (v : V) (v' : V) (p : P) (p' : P) : nndist (v +ᵥ p) (v' +ᵥ p') ≤ nndist v v' + nndist p p' := sorry

theorem nndist_vsub_vsub_le {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] (p₁ : P) (p₂ : P) (p₃ : P) (p₄ : P) : nndist (p₁ -ᵥ p₂) (p₃ -ᵥ p₄) ≤ nndist p₁ p₃ + nndist p₂ p₄ := sorry

theorem edist_vadd_vadd_le {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] (v : V) (v' : V) (p : P) (p' : P) : edist (v +ᵥ p) (v' +ᵥ p') ≤ edist v v' + edist p p' := sorry

theorem edist_vsub_vsub_le {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] (p₁ : P) (p₂ : P) (p₃ : P) (p₄ : P) : edist (p₁ -ᵥ p₂) (p₃ -ᵥ p₄) ≤ edist p₁ p₃ + edist p₂ p₄ := sorry

/-- The distance defines a metric space structure on the torsor. This
is not an instance because it depends on `V` to define a `metric_space
P`. -/
def metric_space_of_normed_group_of_add_torsor (V : Type u_1) (P : Type u_2) [normed_group V] [add_torsor V P] : metric_space P :=
  metric_space.mk sorry sorry sorry sorry (fun (x y : P) => ennreal.of_real ((fun (x y : P) => norm (x -ᵥ y)) x y))
    (uniform_space_of_dist (fun (x y : P) => norm (x -ᵥ y)) sorry sorry sorry)

namespace isometric

/-- The map `v ↦ v +ᵥ p` as an isometric equivalence between `V` and `P`. -/
def vadd_const {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] (p : P) : V ≃ᵢ P :=
  mk (equiv.vadd_const p) sorry

@[simp] theorem coe_vadd_const {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] (p : P) : ⇑(vadd_const p) = fun (v : V) => v +ᵥ p :=
  rfl

@[simp] theorem coe_vadd_const_symm {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] (p : P) : ⇑(isometric.symm (vadd_const p)) = fun (p' : P) => p' -ᵥ p :=
  rfl

@[simp] theorem vadd_const_to_equiv {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] (p : P) : to_equiv (vadd_const p) = equiv.vadd_const p :=
  rfl

/-- `p' ↦ p -ᵥ p'` as an equivalence. -/
def const_vsub {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] (p : P) : P ≃ᵢ V :=
  mk (equiv.const_vsub p) sorry

@[simp] theorem coe_const_vsub {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] (p : P) : ⇑(const_vsub p) = has_vsub.vsub p :=
  rfl

@[simp] theorem coe_const_vsub_symm {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] (p : P) : ⇑(isometric.symm (const_vsub p)) = fun (v : V) => -v +ᵥ p :=
  rfl

/-- The map `p ↦ v +ᵥ p` as an isometric automorphism of `P`. -/
def const_vadd {V : Type u_2} (P : Type u_3) [normed_group V] [metric_space P] [normed_add_torsor V P] (v : V) : P ≃ᵢ P :=
  mk (equiv.const_vadd P v) sorry

@[simp] theorem coe_const_vadd {V : Type u_2} (P : Type u_3) [normed_group V] [metric_space P] [normed_add_torsor V P] (v : V) : ⇑(const_vadd P v) = has_vadd.vadd v :=
  rfl

@[simp] theorem const_vadd_zero (V : Type u_2) (P : Type u_3) [normed_group V] [metric_space P] [normed_add_torsor V P] : const_vadd P 0 = isometric.refl P :=
  to_equiv_inj (equiv.const_vadd_zero V P)

/-- Point reflection in `x` as an `isometric` homeomorphism. -/
def point_reflection {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] (x : P) : P ≃ᵢ P :=
  isometric.trans (const_vsub x) (vadd_const x)

theorem point_reflection_apply {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] (x : P) (y : P) : coe_fn (point_reflection x) y = x -ᵥ y +ᵥ x :=
  rfl

@[simp] theorem point_reflection_to_equiv {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] (x : P) : to_equiv (point_reflection x) = equiv.point_reflection x :=
  rfl

@[simp] theorem point_reflection_self {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] (x : P) : coe_fn (point_reflection x) x = x :=
  equiv.point_reflection_self x

theorem point_reflection_involutive {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] (x : P) : function.involutive ⇑(point_reflection x) :=
  equiv.point_reflection_involutive x

@[simp] theorem point_reflection_symm {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] (x : P) : isometric.symm (point_reflection x) = point_reflection x :=
  to_equiv_inj (equiv.point_reflection_symm x)

@[simp] theorem dist_point_reflection_fixed {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] (x : P) (y : P) : dist (coe_fn (point_reflection x) y) x = dist y x := sorry

theorem dist_point_reflection_self' {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] (x : P) (y : P) : dist (coe_fn (point_reflection x) y) y = norm (bit0 (x -ᵥ y)) := sorry

theorem dist_point_reflection_self {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] (𝕜 : Type u_1) [normed_field 𝕜] [normed_space 𝕜 V] (x : P) (y : P) : dist (coe_fn (point_reflection x) y) y = norm (bit0 1) * dist x y := sorry

theorem point_reflection_fixed_iff {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] (𝕜 : Type u_1) [normed_field 𝕜] [normed_space 𝕜 V] [invertible (bit0 1)] {x : P} {y : P} : coe_fn (point_reflection x) y = y ↔ y = x :=
  affine_equiv.point_reflection_fixed_iff_of_module 𝕜

theorem dist_point_reflection_self_real {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] [normed_space ℝ V] (x : P) (y : P) : dist (coe_fn (point_reflection x) y) y = bit0 1 * dist x y := sorry

@[simp] theorem point_reflection_midpoint_left {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] [normed_space ℝ V] (x : P) (y : P) : coe_fn (point_reflection (midpoint ℝ x y)) x = y :=
  affine_equiv.point_reflection_midpoint_left x y

@[simp] theorem point_reflection_midpoint_right {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] [normed_space ℝ V] (x : P) (y : P) : coe_fn (point_reflection (midpoint ℝ x y)) y = x :=
  affine_equiv.point_reflection_midpoint_right x y

end isometric

theorem lipschitz_with.vadd {α : Type u_1} {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] [emetric_space α] {f : α → V} {g : α → P} {Kf : nnreal} {Kg : nnreal} (hf : lipschitz_with Kf f) (hg : lipschitz_with Kg g) : lipschitz_with (Kf + Kg) (f +ᵥ g) :=
  fun (x y : α) =>
    trans_rel_left LessEq (le_trans (edist_vadd_vadd_le (f x) (f y) (g x) (g y)) (add_le_add (hf x y) (hg x y)))
      (Eq.symm (add_mul (↑Kf) (↑Kg) (edist x y)))

theorem lipschitz_with.vsub {α : Type u_1} {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] [emetric_space α] {f : α → P} {g : α → P} {Kf : nnreal} {Kg : nnreal} (hf : lipschitz_with Kf f) (hg : lipschitz_with Kg g) : lipschitz_with (Kf + Kg) (f -ᵥ g) :=
  fun (x y : α) =>
    trans_rel_left LessEq (le_trans (edist_vsub_vsub_le (f x) (g x) (f y) (g y)) (add_le_add (hf x y) (hg x y)))
      (Eq.symm (add_mul (↑Kf) (↑Kg) (edist x y)))

theorem uniform_continuous_vadd {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] : uniform_continuous fun (x : V × P) => prod.fst x +ᵥ prod.snd x :=
  lipschitz_with.uniform_continuous (lipschitz_with.vadd lipschitz_with.prod_fst lipschitz_with.prod_snd)

theorem uniform_continuous_vsub {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] : uniform_continuous fun (x : P × P) => prod.fst x -ᵥ prod.snd x :=
  lipschitz_with.uniform_continuous (lipschitz_with.vsub lipschitz_with.prod_fst lipschitz_with.prod_snd)

theorem continuous_vadd {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] : continuous fun (x : V × P) => prod.fst x +ᵥ prod.snd x :=
  uniform_continuous.continuous uniform_continuous_vadd

theorem continuous_vsub {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] : continuous fun (x : P × P) => prod.fst x -ᵥ prod.snd x :=
  uniform_continuous.continuous uniform_continuous_vsub

theorem filter.tendsto.vadd {α : Type u_1} {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] {l : filter α} {f : α → V} {g : α → P} {v : V} {p : P} (hf : filter.tendsto f l (nhds v)) (hg : filter.tendsto g l (nhds p)) : filter.tendsto (f +ᵥ g) l (nhds (v +ᵥ p)) :=
  filter.tendsto.comp (continuous.tendsto continuous_vadd (v, p)) (filter.tendsto.prod_mk_nhds hf hg)

theorem filter.tendsto.vsub {α : Type u_1} {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] {l : filter α} {f : α → P} {g : α → P} {x : P} {y : P} (hf : filter.tendsto f l (nhds x)) (hg : filter.tendsto g l (nhds y)) : filter.tendsto (f -ᵥ g) l (nhds (x -ᵥ y)) :=
  filter.tendsto.comp (continuous.tendsto continuous_vsub (x, y)) (filter.tendsto.prod_mk_nhds hf hg)

theorem continuous.vadd {α : Type u_1} {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] [topological_space α] {f : α → V} {g : α → P} (hf : continuous f) (hg : continuous g) : continuous (f +ᵥ g) :=
  continuous.comp continuous_vadd (continuous.prod_mk hf hg)

theorem continuous.vsub {α : Type u_1} {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] [topological_space α] {f : α → P} {g : α → P} (hf : continuous f) (hg : continuous g) : continuous (f -ᵥ g) :=
  continuous.comp continuous_vsub (continuous.prod_mk hf hg)

theorem continuous_at.vadd {α : Type u_1} {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] [topological_space α] {f : α → V} {g : α → P} {x : α} (hf : continuous_at f x) (hg : continuous_at g x) : continuous_at (f +ᵥ g) x :=
  filter.tendsto.vadd hf hg

theorem continuous_at.vsub {α : Type u_1} {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] [topological_space α] {f : α → P} {g : α → P} {x : α} (hf : continuous_at f x) (hg : continuous_at g x) : continuous_at (f -ᵥ g) x :=
  filter.tendsto.vsub hf hg

theorem continuous_within_at.vadd {α : Type u_1} {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] [topological_space α] {f : α → V} {g : α → P} {x : α} {s : set α} (hf : continuous_within_at f s x) (hg : continuous_within_at g s x) : continuous_within_at (f +ᵥ g) s x :=
  filter.tendsto.vadd hf hg

theorem continuous_within_at.vsub {α : Type u_1} {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] [topological_space α] {f : α → P} {g : α → P} {x : α} {s : set α} (hf : continuous_within_at f s x) (hg : continuous_within_at g s x) : continuous_within_at (f -ᵥ g) s x :=
  filter.tendsto.vsub hf hg

/-- The map `g` from `V1` to `V2` corresponding to a map `f` from `P1`
to `P2`, at a base point `p`, is an isometry if `f` is one. -/
theorem isometry.vadd_vsub {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] {V' : Type u_4} {P' : Type u_5} [normed_group V'] [metric_space P'] [normed_add_torsor V' P'] {f : P → P'} (hf : isometry f) {p : P} {g : V → V'} (hg : ∀ (v : V), g v = f (v +ᵥ p) -ᵥ f p) : isometry g := sorry

/-- If `f` is an affine map, then its linear part is continuous iff `f` is continuous. -/
theorem affine_map.continuous_linear_iff {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] {V' : Type u_4} {P' : Type u_5} [normed_group V'] [metric_space P'] [normed_add_torsor V' P'] {𝕜 : Type u_6} [normed_field 𝕜] [normed_space 𝕜 V] [normed_space 𝕜 V'] {f : affine_map 𝕜 P P'} : continuous ⇑(affine_map.linear f) ↔ continuous ⇑f := sorry

@[simp] theorem dist_center_homothety {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] {𝕜 : Type u_6} [normed_field 𝕜] [normed_space 𝕜 V] (p₁ : P) (p₂ : P) (c : 𝕜) : dist p₁ (coe_fn (affine_map.homothety p₁ c) p₂) = norm c * dist p₁ p₂ := sorry

@[simp] theorem dist_homothety_center {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] {𝕜 : Type u_6} [normed_field 𝕜] [normed_space 𝕜 V] (p₁ : P) (p₂ : P) (c : 𝕜) : dist (coe_fn (affine_map.homothety p₁ c) p₂) p₁ = norm c * dist p₁ p₂ := sorry

@[simp] theorem dist_homothety_self {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] {𝕜 : Type u_6} [normed_field 𝕜] [normed_space 𝕜 V] (p₁ : P) (p₂ : P) (c : 𝕜) : dist (coe_fn (affine_map.homothety p₁ c) p₂) p₂ = norm (1 - c) * dist p₁ p₂ := sorry

@[simp] theorem dist_self_homothety {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] {𝕜 : Type u_6} [normed_field 𝕜] [normed_space 𝕜 V] (p₁ : P) (p₂ : P) (c : 𝕜) : dist p₂ (coe_fn (affine_map.homothety p₁ c) p₂) = norm (1 - c) * dist p₁ p₂ := sorry

@[simp] theorem dist_left_midpoint {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] {𝕜 : Type u_6} [normed_field 𝕜] [normed_space 𝕜 V] [invertible (bit0 1)] (p₁ : P) (p₂ : P) : dist p₁ (midpoint 𝕜 p₁ p₂) = norm (bit0 1)⁻¹ * dist p₁ p₂ := sorry

@[simp] theorem dist_midpoint_left {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] {𝕜 : Type u_6} [normed_field 𝕜] [normed_space 𝕜 V] [invertible (bit0 1)] (p₁ : P) (p₂ : P) : dist (midpoint 𝕜 p₁ p₂) p₁ = norm (bit0 1)⁻¹ * dist p₁ p₂ := sorry

@[simp] theorem dist_midpoint_right {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] {𝕜 : Type u_6} [normed_field 𝕜] [normed_space 𝕜 V] [invertible (bit0 1)] (p₁ : P) (p₂ : P) : dist (midpoint 𝕜 p₁ p₂) p₂ = norm (bit0 1)⁻¹ * dist p₁ p₂ := sorry

@[simp] theorem dist_right_midpoint {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] {𝕜 : Type u_6} [normed_field 𝕜] [normed_space 𝕜 V] [invertible (bit0 1)] (p₁ : P) (p₂ : P) : dist p₂ (midpoint 𝕜 p₁ p₂) = norm (bit0 1)⁻¹ * dist p₁ p₂ := sorry

/-- A continuous map between two normed affine spaces is an affine map provided that
it sends midpoints to midpoints. -/
def affine_map.of_map_midpoint {V : Type u_2} {P : Type u_3} [normed_group V] [metric_space P] [normed_add_torsor V P] {V' : Type u_4} {P' : Type u_5} [normed_group V'] [metric_space P'] [normed_add_torsor V' P'] [normed_space ℝ V] [normed_space ℝ V'] (f : P → P') (h : ∀ (x y : P), f (midpoint ℝ x y) = midpoint ℝ (f x) (f y)) (hfc : continuous f) : affine_map ℝ P P' :=
  affine_map.mk' f
    (↑(add_monoid_hom.to_real_linear_map
        (add_monoid_hom.of_map_midpoint ℝ ℝ
          (⇑(affine_equiv.symm (affine_equiv.vadd_const ℝ (f (classical.arbitrary P)))) ∘
            f ∘ ⇑(affine_equiv.vadd_const ℝ (classical.arbitrary P)))
          sorry sorry)
        sorry))
    (classical.arbitrary P) sorry


import condensed.adjunctions
import category_theory.adjunction.evaluation
import for_mathlib.sheafification_mono

open category_theory
open category_theory.grothendieck_topology
open opposite

universe u

variables (F : Profinite.{u}ᵒᵖ ⥤ Ab.{u+1}) (G : Condensed.{u} Ab.{u+1})
variables (η : F ⟶ G.val)

theorem Condensed_Ab_sheafify_lift_mono_of_exists :
  (∀ (B : Profinite.{u}) (t : F.obj (op B)), η.app (op B) t = 0 →
    (∃ (α : Type u) [fintype α] (X : α → Profinite.{u}) (π : Π a : α, X a ⟶ B)
      (surj : ∀ b : B, ∃ (a : α) (x : X a), π a x = b),
      ∀ a : α, F.map (π a).op t = 0)) → mono (proetale_topology.sheafify_lift η G.cond) :=
begin
  intros h,
  apply sheafify_lift_mono_of_exists_cover,
  intros B t ht,
  specialize h B t ht,
  obtain ⟨α, hα, X, π, surj, h⟩ := h,
  resetI,
  let W : proetale_topology.cover B := ⟨sieve.generate (presieve.of_arrows X π), _⟩,
  use W,
  rintros ⟨Z,f,⟨A,g,hg,⟨a⟩,rfl⟩⟩,
  dsimp, simp [h a],
  use [presieve.of_arrows X π, α, hα, X, π, surj],
  apply sieve.le_generate,
end

theorem presheaf_to_Condensed_Ab_map_mono_of_exists
  (h : ∀ (B : Profinite.{u}) (t : F.obj (op B)), η.app (op B) t = 0 →
    (∃ (α : Type u) [fintype α] (X : α → Profinite.{u}) (π : Π a : α, X a ⟶ B)
      (surj : ∀ b : B, ∃ (a : α) (x : X a), π a x = b),
      ∀ a : α, F.map (π a).op t = 0)):
  mono (((sheafification_adjunction
    proetale_topology Ab.{u+1}).hom_equiv _ G).symm η) :=
begin
  apply (Sheaf_to_presheaf proetale_topology Ab.{u+1}).mono_of_mono_map,
  dsimp [sheafification_adjunction],
  apply Condensed_Ab_sheafify_lift_mono_of_exists,
  exact h
end


/-
Copyright (c) 2019 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin, Bhavik Mehta
-/
import category_theory.structured_arrow
import category_theory.punit
import category_theory.functor.reflects_isomorphisms
import category_theory.functor.epi_mono

/-!
# Over and under categories

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

Over (and under) categories are special cases of comma categories.
* If `L` is the identity functor and `R` is a constant functor, then `comma L R` is the "slice" or
  "over" category over the object `R` maps to.
* Conversely, if `L` is a constant functor and `R` is the identity functor, then `comma L R` is the
  "coslice" or "under" category under the object `L` maps to.

## Tags

comma, slice, coslice, over, under
-/

namespace category_theory

universes v₁ v₂ u₁ u₂ -- morphism levels before object levels. See note [category_theory universes].
variables {T : Type u₁} [category.{v₁} T]

/--
The over category has as objects arrows in `T` with codomain `X` and as morphisms commutative
triangles.

See <https://stacks.math.columbia.edu/tag/001G>.
-/
@[derive category]
def over (X : T) := costructured_arrow (𝟭 T) X

-- Satisfying the inhabited linter
instance over.inhabited [inhabited T] : inhabited (over (default : T)) :=
{ default :=
  { left := default,
    right := default,
    hom := 𝟙 _ } }

namespace over

variables {X : T}

@[ext] lemma over_morphism.ext {X : T} {U V : over X} {f g : U ⟶ V}
  (h : f.left = g.left) : f = g :=
by tidy

@[simp] lemma over_right (U : over X) : U.right = ⟨⟨⟩⟩ := by tidy

@[simp] lemma id_left (U : over X) : comma_morphism.left (𝟙 U) = 𝟙 U.left := rfl
@[simp] lemma comp_left (a b c : over X) (f : a ⟶ b) (g : b ⟶ c) :
  (f ≫ g).left = f.left ≫ g.left := rfl

@[simp, reassoc] lemma w {A B : over X} (f : A ⟶ B) : f.left ≫ B.hom = A.hom :=
by have := f.w; tidy

/-- To give an object in the over category, it suffices to give a morphism with codomain `X`. -/
@[simps left hom]
def mk {X Y : T} (f : Y ⟶ X) : over X :=
costructured_arrow.mk f

/-- We can set up a coercion from arrows with codomain `X` to `over X`. This most likely should not
    be a global instance, but it is sometimes useful. -/
def coe_from_hom {X Y : T} : has_coe (Y ⟶ X) (over X) :=
{ coe := mk }

section
local attribute [instance] coe_from_hom

@[simp] lemma coe_hom {X Y : T} (f : Y ⟶ X) : (f : over X).hom = f := rfl
end

/-- To give a morphism in the over category, it suffices to give an arrow fitting in a commutative
    triangle. -/
@[simps]
def hom_mk {U V : over X} (f : U.left ⟶ V.left) (w : f ≫ V.hom = U.hom . obviously) :
  U ⟶ V :=
costructured_arrow.hom_mk f w

/--
Construct an isomorphism in the over category given isomorphisms of the objects whose forward
direction gives a commutative triangle.
-/
@[simps]
def iso_mk {f g : over X} (hl : f.left ≅ g.left) (hw : hl.hom ≫ g.hom = f.hom . obviously) :
  f ≅ g :=
costructured_arrow.iso_mk hl hw

section
variable (X)
/--
The forgetful functor mapping an arrow to its domain.

See <https://stacks.math.columbia.edu/tag/001G>.
-/
def forget : over X ⥤ T := comma.fst _ _

end

@[simp] lemma forget_obj {U : over X} : (forget X).obj U = U.left := rfl
@[simp] lemma forget_map {U V : over X} {f : U ⟶ V} : (forget X).map f = f.left := rfl

/-- The natural cocone over the forgetful functor `over X ⥤ T` with cocone point `X`. -/
@[simps] def forget_cocone (X : T) : limits.cocone (forget X) :=
{ X := X, ι := { app := comma.hom } }

/--
A morphism `f : X ⟶ Y` induces a functor `over X ⥤ over Y` in the obvious way.

See <https://stacks.math.columbia.edu/tag/001G>.
-/
def map {Y : T} (f : X ⟶ Y) : over X ⥤ over Y := comma.map_right _ $ discrete.nat_trans (λ _, f)

section
variables {Y : T} {f : X ⟶ Y} {U V : over X} {g : U ⟶ V}
@[simp] lemma map_obj_left : ((map f).obj U).left = U.left := rfl
@[simp] lemma map_obj_hom  : ((map f).obj U).hom  = U.hom ≫ f := rfl
@[simp] lemma map_map_left : ((map f).map g).left = g.left := rfl

/-- Mapping by the identity morphism is just the identity functor. -/
def map_id : map (𝟙 Y) ≅ 𝟭 _ :=
nat_iso.of_components (λ X, iso_mk (iso.refl _) (by tidy)) (by tidy)

/-- Mapping by the composite morphism `f ≫ g` is the same as mapping by `f` then by `g`. -/
def map_comp {Y Z : T} (f : X ⟶ Y) (g : Y ⟶ Z) : map (f ≫ g) ≅ map f ⋙ map g :=
nat_iso.of_components (λ X, iso_mk (iso.refl _) (by tidy)) (by tidy)

end

instance forget_reflects_iso : reflects_isomorphisms (forget X) :=
{ reflects := λ Y Z f t, by exactI
  ⟨⟨over.hom_mk (inv ((forget X).map f))
      ((as_iso ((forget X).map f)).inv_comp_eq.2 (over.w f).symm),
    by tidy⟩⟩ }

instance forget_faithful : faithful (forget X) := {}.

/--
If `k.left` is an epimorphism, then `k` is an epimorphism. In other words, `over.forget X` reflects
epimorphisms.
The converse does not hold without additional assumptions on the underlying category, see
`category_theory.over.epi_left_of_epi`.
-/
-- TODO: Show the converse holds if `T` has binary products.
lemma epi_of_epi_left {f g : over X} (k : f ⟶ g) [hk : epi k.left] : epi k :=
(forget X).epi_of_epi_map hk

/--
If `k.left` is a monomorphism, then `k` is a monomorphism. In other words, `over.forget X` reflects
monomorphisms.
The converse of `category_theory.over.mono_left_of_mono`.

This lemma is not an instance, to avoid loops in type class inference.
-/
lemma mono_of_mono_left {f g : over X} (k : f ⟶ g) [hk : mono k.left] : mono k :=
(forget X).mono_of_mono_map hk

/--
If `k` is a monomorphism, then `k.left` is a monomorphism. In other words, `over.forget X` preserves
monomorphisms.
The converse of `category_theory.over.mono_of_mono_left`.
-/
instance mono_left_of_mono {f g : over X} (k : f ⟶ g) [mono k] : mono k.left :=
begin
  refine ⟨λ (Y : T) l m a, _⟩,
  let l' : mk (m ≫ f.hom) ⟶ f := hom_mk l (by { dsimp, rw [←over.w k, reassoc_of a] }),
  suffices : l' = hom_mk m,
  { apply congr_arg comma_morphism.left this },
  rw ← cancel_mono k,
  ext,
  apply a,
end

section iterated_slice
variables (f : over X)

/-- Given f : Y ⟶ X, this is the obvious functor from (T/X)/f to T/Y -/
@[simps]
def iterated_slice_forward : over f ⥤ over f.left :=
{ obj := λ α, over.mk α.hom.left,
  map := λ α β κ, over.hom_mk κ.left.left (by { rw auto_param_eq, rw ← over.w κ, refl }) }

/-- Given f : Y ⟶ X, this is the obvious functor from T/Y to (T/X)/f -/
@[simps]
def iterated_slice_backward : over f.left ⥤ over f :=
{ obj := λ g, mk (hom_mk g.hom : mk (g.hom ≫ f.hom) ⟶ f),
  map := λ g h α, hom_mk (hom_mk α.left (w_assoc α f.hom)) (over_morphism.ext (w α)) }

/-- Given f : Y ⟶ X, we have an equivalence between (T/X)/f and T/Y -/
@[simps]
def iterated_slice_equiv : over f ≌ over f.left :=
{ functor := iterated_slice_forward f,
  inverse := iterated_slice_backward f,
  unit_iso :=
    nat_iso.of_components
    (λ g, over.iso_mk (over.iso_mk (iso.refl _) (by tidy)) (by tidy))
    (λ X Y g, by { ext, dsimp, simp }),
  counit_iso :=
    nat_iso.of_components
    (λ g, over.iso_mk (iso.refl _) (by tidy))
    (λ X Y g, by { ext, dsimp, simp }) }

lemma iterated_slice_forward_forget :
  iterated_slice_forward f ⋙ forget f.left = forget f ⋙ forget X :=
rfl

lemma iterated_slice_backward_forget_forget :
  iterated_slice_backward f ⋙ forget f ⋙ forget X = forget f.left :=
rfl

end iterated_slice

section
variables {D : Type u₂} [category.{v₂} D]

/-- A functor `F : T ⥤ D` induces a functor `over X ⥤ over (F.obj X)` in the obvious way. -/
@[simps]
def post (F : T ⥤ D) : over X ⥤ over (F.obj X) :=
{ obj := λ Y, mk $ F.map Y.hom,
  map := λ Y₁ Y₂ f, over.hom_mk (F.map f.left) (by tidy; erw [← F.map_comp, w]) }

end

end over

/-- The under category has as objects arrows with domain `X` and as morphisms commutative
    triangles. -/
@[derive category]
def under (X : T) := structured_arrow X (𝟭 T)

-- Satisfying the inhabited linter
instance under.inhabited [inhabited T] : inhabited (under (default : T)) :=
{ default :=
  { left := default,
    right := default,
    hom := 𝟙 _ } }

namespace under

variables {X : T}

@[ext] lemma under_morphism.ext {X : T} {U V : under X} {f g : U ⟶ V}
  (h : f.right = g.right) : f = g :=
by tidy

@[simp] lemma under_left (U : under X) : U.left = ⟨⟨⟩⟩ := by tidy

@[simp] lemma id_right (U : under X) : comma_morphism.right (𝟙 U) = 𝟙 U.right := rfl
@[simp] lemma comp_right (a b c : under X) (f : a ⟶ b) (g : b ⟶ c) :
  (f ≫ g).right = f.right ≫ g.right := rfl

@[simp, reassoc] lemma w {A B : under X} (f : A ⟶ B) : A.hom ≫ f.right = B.hom :=
by have := f.w; tidy

/-- To give an object in the under category, it suffices to give an arrow with domain `X`. -/
@[simps right hom]
def mk {X Y : T} (f : X ⟶ Y) : under X :=
structured_arrow.mk f

/-- To give a morphism in the under category, it suffices to give a morphism fitting in a
    commutative triangle. -/
@[simps]
def hom_mk {U V : under X} (f : U.right ⟶ V.right) (w : U.hom ≫ f = V.hom . obviously) :
  U ⟶ V :=
structured_arrow.hom_mk f w

/--
Construct an isomorphism in the over category given isomorphisms of the objects whose forward
direction gives a commutative triangle.
-/
def iso_mk {f g : under X} (hr : f.right ≅ g.right) (hw : f.hom ≫ hr.hom = g.hom) : f ≅ g :=
structured_arrow.iso_mk hr hw

@[simp]
lemma iso_mk_hom_right {f g : under X} (hr : f.right ≅ g.right) (hw : f.hom ≫ hr.hom = g.hom) :
  (iso_mk hr hw).hom.right = hr.hom := rfl

@[simp]
lemma iso_mk_inv_right {f g : under X} (hr : f.right ≅ g.right) (hw : f.hom ≫ hr.hom = g.hom) :
  (iso_mk hr hw).inv.right = hr.inv := rfl

section
variables (X)
/-- The forgetful functor mapping an arrow to its domain. -/
def forget : under X ⥤ T := comma.snd _ _

end

@[simp] lemma forget_obj {U : under X} : (forget X).obj U = U.right := rfl
@[simp] lemma forget_map {U V : under X} {f : U ⟶ V} : (forget X).map f = f.right := rfl

/-- The natural cone over the forgetful functor `under X ⥤ T` with cone point `X`. -/
@[simps] def forget_cone (X : T) : limits.cone (forget X) :=
{ X := X, π := { app := comma.hom } }

/-- A morphism `X ⟶ Y` induces a functor `under Y ⥤ under X` in the obvious way. -/
def map {Y : T} (f : X ⟶ Y) : under Y ⥤ under X := comma.map_left _ $ discrete.nat_trans (λ _, f)

section
variables {Y : T} {f : X ⟶ Y} {U V : under Y} {g : U ⟶ V}
@[simp] lemma map_obj_right : ((map f).obj U).right = U.right := rfl
@[simp] lemma map_obj_hom   : ((map f).obj U).hom   = f ≫ U.hom := rfl
@[simp] lemma map_map_right : ((map f).map g).right = g.right := rfl

/-- Mapping by the identity morphism is just the identity functor. -/
def map_id : map (𝟙 Y) ≅ 𝟭 _ :=
nat_iso.of_components (λ X, iso_mk (iso.refl _) (by tidy)) (by tidy)

/-- Mapping by the composite morphism `f ≫ g` is the same as mapping by `f` then by `g`. -/
def map_comp {Y Z : T} (f : X ⟶ Y) (g : Y ⟶ Z) : map (f ≫ g) ≅ map g ⋙ map f :=
nat_iso.of_components (λ X, iso_mk (iso.refl _) (by tidy)) (by tidy)

end

instance forget_reflects_iso : reflects_isomorphisms (forget X) :=
{ reflects := λ Y Z f t, by exactI
  ⟨⟨under.hom_mk (inv ((under.forget X).map f)) ((is_iso.comp_inv_eq _).2 (under.w f).symm),
    by tidy⟩⟩ }

instance forget_faithful : faithful (forget X) := {}.

/--
If `k.right` is a monomorphism, then `k` is a monomorphism. In other words, `under.forget X`
reflects epimorphisms.
The converse does not hold without additional assumptions on the underlying category, see
`category_theory.under.mono_right_of_mono`.
-/
-- TODO: Show the converse holds if `T` has binary coproducts.
lemma mono_of_mono_right {f g : under X} (k : f ⟶ g) [hk : mono k.right] : mono k :=
(forget X).mono_of_mono_map hk

/--
If `k.right` is a epimorphism, then `k` is a epimorphism. In other words, `under.forget X` reflects
epimorphisms.
The converse of `category_theory.under.epi_right_of_epi`.

This lemma is not an instance, to avoid loops in type class inference.
-/
lemma epi_of_epi_right {f g : under X} (k : f ⟶ g) [hk : epi k.right] : epi k :=
(forget X).epi_of_epi_map hk

/--
If `k` is a epimorphism, then `k.right` is a epimorphism. In other words, `under.forget X` preserves
epimorphisms.
The converse of `category_theory.under.epi_of_epi_right`.
-/
instance epi_right_of_epi {f g : under X} (k : f ⟶ g) [epi k] : epi k.right :=
begin
  refine ⟨λ (Y : T) l m a, _⟩,
  let l' : g ⟶ mk (g.hom ≫ m) := hom_mk l
    (by { dsimp, rw [←under.w k, category.assoc, a, category.assoc] }),
  suffices : l' = hom_mk m,
  { apply congr_arg comma_morphism.right this },
  rw ← cancel_epi k,
  ext,
  apply a,
end

section
variables {D : Type u₂} [category.{v₂} D]

/-- A functor `F : T ⥤ D` induces a functor `under X ⥤ under (F.obj X)` in the obvious way. -/
@[simps]
def post {X : T} (F : T ⥤ D) : under X ⥤ under (F.obj X) :=
{ obj := λ Y, mk $ F.map Y.hom,
  map := λ Y₁ Y₂ f, under.hom_mk (F.map f.right) (by tidy; erw [← F.map_comp, w]), }

end

end under

end category_theory


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Tim Baumann, Stephen Morgan, Scott Morrison, Floris van Doorn
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.fully_faithful
import Mathlib.category_theory.whiskering
import Mathlib.category_theory.essential_image
import Mathlib.tactic.slice
import Mathlib.PostPort

universes v₁ v₂ u₁ u₂ l u₃ v₃

namespace Mathlib

/-!
# Equivalence of categories

An equivalence of categories `C` and `D` is a pair of functors `F : C ⥤ D` and `G : D ⥤ C` such
that `η : 𝟭 C ≅ F ⋙ G` and `ε : G ⋙ F ≅ 𝟭 D`. In many situations, equivalences are a better
notion of "sameness" of categories than the stricter isomorphims of categories.

Recall that one way to express that two functors `F : C ⥤ D` and `G : D ⥤ C` are adjoint is using
two natural transformations `η : 𝟭 C ⟶ F ⋙ G` and `ε : G ⋙ F ⟶ 𝟭 D`, called the unit and the
counit, such that the compositions `F ⟶ FGF ⟶ F` and `G ⟶ GFG ⟶ G` are the identity. Unfortunately,
it is not the case that the natural isomorphisms `η` and `ε` in the definition of an equivalence
automatically give an adjunction. However, it is true that
* if one of the two compositions is the identity, then so is the other, and
* given an equivalence of categories, it is always possible to refine `η` in such a way that the
  identities are satisfied.

For this reason, in mathlib we define an equivalence to be a "half-adjoint equivalence", which is
a tuple `(F, G, η, ε)` as in the first paragraph such that the composite `F ⟶ FGF ⟶ F` is the
identity. By the remark above, this already implies that the tuple is an "adjoint equivalence",
i.e., that the composite `G ⟶ GFG ⟶ G` is also the identity.

We also define essentially surjective functors and show that a functor is an equivalence if and only
if it is full, faithful and essentially surjective.

## Main definitions

* `equivalence`: bundled (half-)adjoint equivalences of categories
* `is_equivalence`: type class on a functor `F` containing the data of the inverse `G` as well as
  the natural isomorphisms `η` and `ε`.
* `ess_surj`: type class on a functor `F` containing the data of the preimages and the isomorphisms
  `F.obj (preimage d) ≅ d`.

## Main results

* `equivalence.mk`: upgrade an equivalence to a (half-)adjoint equivalence
* `equivalence_of_fully_faithfully_ess_surj`: a fully faithful essentially surjective functor is an
  equivalence.

## Notations

We write `C ≌ D` (`\backcong`, not to be confused with `≅`/`\cong`) for a bundled equivalence.

-/

namespace category_theory

/-- We define an equivalence as a (half)-adjoint equivalence, a pair of functors with
  a unit and counit which are natural isomorphisms and the triangle law `Fη ≫ εF = 1`, or in other
  words the composite `F ⟶ FGF ⟶ F` is the identity.

  In `unit_inverse_comp`, we show that this is actually an adjoint equivalence, i.e., that the
  composite `G ⟶ GFG ⟶ G` is also the identity.

  The triangle equation is written as a family of equalities between morphisms, it is more
  complicated if we write it as an equality of natural transformations, because then we would have
  to insert natural transformations like `F ⟶ F1`.

See https://stacks.math.columbia.edu/tag/001J
-/
structure equivalence (C : Type u₁) [category C] (D : Type u₂) [category D] where
  mk' ::
    (functor : C ⥤ D)
    (inverse : D ⥤ C)
    (unit_iso : 𝟭 ≅ functor ⋙ inverse)
    (counit_iso : inverse ⋙ functor ≅ 𝟭)
    (functor_unit_iso_comp' :
      autoParam
        (∀ (X : C),
          functor.map functor (nat_trans.app (iso.hom unit_iso) X) ≫
              nat_trans.app (iso.hom counit_iso) (functor.obj functor X) =
            𝟙)
        (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
          (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") []))

theorem equivalence.functor_unit_iso_comp {C : Type u₁} [category C] {D : Type u₂} [category D]
    (c : equivalence C D) (X : C) :
    functor.map (equivalence.functor c) (nat_trans.app (iso.hom (equivalence.unit_iso c)) X) ≫
          nat_trans.app (iso.hom (equivalence.counit_iso c))
            (functor.obj (equivalence.functor c) X) =
        𝟙 :=
  sorry

infixr:10 " ≌ " => Mathlib.category_theory.equivalence

namespace equivalence

/-- The unit of an equivalence of categories. -/
/-- The counit of an equivalence of categories. -/
def unit {C : Type u₁} [category C] {D : Type u₂} [category D] (e : C ≌ D) :
    𝟭 ⟶ functor e ⋙ inverse e :=
  iso.hom (unit_iso e)

/-- The inverse of the unit of an equivalence of categories. -/
def counit {C : Type u₁} [category C] {D : Type u₂} [category D] (e : C ≌ D) :
    inverse e ⋙ functor e ⟶ 𝟭 :=
  iso.hom (counit_iso e)

/-- The inverse of the counit of an equivalence of categories. -/
def unit_inv {C : Type u₁} [category C] {D : Type u₂} [category D] (e : C ≌ D) :
    functor e ⋙ inverse e ⟶ 𝟭 :=
  iso.inv (unit_iso e)

def counit_inv {C : Type u₁} [category C] {D : Type u₂} [category D] (e : C ≌ D) :
    𝟭 ⟶ inverse e ⋙ functor e :=
  iso.inv (counit_iso e)

/- While these abbreviations are convenient, they also cause some trouble,
preventing structure projections from unfolding. -/

@[simp] theorem equivalence_mk'_unit {C : Type u₁} [category C] {D : Type u₂} [category D]
    (functor : C ⥤ D) (inverse : D ⥤ C) (unit_iso : 𝟭 ≅ functor ⋙ inverse)
    (counit_iso : inverse ⋙ functor ≅ 𝟭)
    (f :
      autoParam
        (∀ (X : C),
          functor.map functor (nat_trans.app (iso.hom unit_iso) X) ≫
              nat_trans.app (iso.hom counit_iso) (functor.obj functor X) =
            𝟙)
        (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
          (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])) :
    unit (mk' functor inverse unit_iso counit_iso) = iso.hom unit_iso :=
  rfl

@[simp] theorem equivalence_mk'_counit {C : Type u₁} [category C] {D : Type u₂} [category D]
    (functor : C ⥤ D) (inverse : D ⥤ C) (unit_iso : 𝟭 ≅ functor ⋙ inverse)
    (counit_iso : inverse ⋙ functor ≅ 𝟭)
    (f :
      autoParam
        (∀ (X : C),
          functor.map functor (nat_trans.app (iso.hom unit_iso) X) ≫
              nat_trans.app (iso.hom counit_iso) (functor.obj functor X) =
            𝟙)
        (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
          (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])) :
    counit (mk' functor inverse unit_iso counit_iso) = iso.hom counit_iso :=
  rfl

@[simp] theorem equivalence_mk'_unit_inv {C : Type u₁} [category C] {D : Type u₂} [category D]
    (functor : C ⥤ D) (inverse : D ⥤ C) (unit_iso : 𝟭 ≅ functor ⋙ inverse)
    (counit_iso : inverse ⋙ functor ≅ 𝟭)
    (f :
      autoParam
        (∀ (X : C),
          functor.map functor (nat_trans.app (iso.hom unit_iso) X) ≫
              nat_trans.app (iso.hom counit_iso) (functor.obj functor X) =
            𝟙)
        (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
          (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])) :
    unit_inv (mk' functor inverse unit_iso counit_iso) = iso.inv unit_iso :=
  rfl

@[simp] theorem equivalence_mk'_counit_inv {C : Type u₁} [category C] {D : Type u₂} [category D]
    (functor : C ⥤ D) (inverse : D ⥤ C) (unit_iso : 𝟭 ≅ functor ⋙ inverse)
    (counit_iso : inverse ⋙ functor ≅ 𝟭)
    (f :
      autoParam
        (∀ (X : C),
          functor.map functor (nat_trans.app (iso.hom unit_iso) X) ≫
              nat_trans.app (iso.hom counit_iso) (functor.obj functor X) =
            𝟙)
        (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
          (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") [])) :
    counit_inv (mk' functor inverse unit_iso counit_iso) = iso.inv counit_iso :=
  rfl

@[simp] theorem functor_unit_comp {C : Type u₁} [category C] {D : Type u₂} [category D] (e : C ≌ D)
    (X : C) :
    functor.map (functor e) (nat_trans.app (unit e) X) ≫
          nat_trans.app (counit e) (functor.obj (functor e) X) =
        𝟙 :=
  functor_unit_iso_comp e X

@[simp] theorem counit_inv_functor_comp {C : Type u₁} [category C] {D : Type u₂} [category D]
    (e : C ≌ D) (X : C) :
    nat_trans.app (counit_inv e) (functor.obj (functor e) X) ≫
          functor.map (functor e) (nat_trans.app (unit_inv e) X) =
        𝟙 :=
  sorry

theorem counit_inv_app_functor {C : Type u₁} [category C] {D : Type u₂} [category D] (e : C ≌ D)
    (X : C) :
    nat_trans.app (counit_inv e) (functor.obj (functor e) X) =
        functor.map (functor e) (nat_trans.app (unit e) X) :=
  sorry

theorem counit_app_functor {C : Type u₁} [category C] {D : Type u₂} [category D] (e : C ≌ D)
    (X : C) :
    nat_trans.app (counit e) (functor.obj (functor e) X) =
        functor.map (functor e) (nat_trans.app (unit_inv e) X) :=
  sorry

/-- The other triangle equality. The proof follows the following proof in Globular:
  http://globular.science/1905.001 -/
@[simp] theorem unit_inverse_comp {C : Type u₁} [category C] {D : Type u₂} [category D] (e : C ≌ D)
    (Y : D) :
    nat_trans.app (unit e) (functor.obj (inverse e) Y) ≫
          functor.map (inverse e) (nat_trans.app (counit e) Y) =
        𝟙 :=
  sorry

@[simp] theorem inverse_counit_inv_comp {C : Type u₁} [category C] {D : Type u₂} [category D]
    (e : C ≌ D) (Y : D) :
    functor.map (inverse e) (nat_trans.app (counit_inv e) Y) ≫
          nat_trans.app (unit_inv e) (functor.obj (inverse e) Y) =
        𝟙 :=
  sorry

theorem unit_app_inverse {C : Type u₁} [category C] {D : Type u₂} [category D] (e : C ≌ D) (Y : D) :
    nat_trans.app (unit e) (functor.obj (inverse e) Y) =
        functor.map (inverse e) (nat_trans.app (counit_inv e) Y) :=
  sorry

theorem unit_inv_app_inverse {C : Type u₁} [category C] {D : Type u₂} [category D] (e : C ≌ D)
    (Y : D) :
    nat_trans.app (unit_inv e) (functor.obj (inverse e) Y) =
        functor.map (inverse e) (nat_trans.app (counit e) Y) :=
  sorry

@[simp] theorem fun_inv_map {C : Type u₁} [category C] {D : Type u₂} [category D] (e : C ≌ D)
    (X : D) (Y : D) (f : X ⟶ Y) :
    functor.map (functor e) (functor.map (inverse e) f) =
        nat_trans.app (counit e) X ≫ f ≫ nat_trans.app (counit_inv e) Y :=
  Eq.symm (nat_iso.naturality_2 (counit_iso e) f)

@[simp] theorem inv_fun_map {C : Type u₁} [category C] {D : Type u₂} [category D] (e : C ≌ D)
    (X : C) (Y : C) (f : X ⟶ Y) :
    functor.map (inverse e) (functor.map (functor e) f) =
        nat_trans.app (unit_inv e) X ≫ f ≫ nat_trans.app (unit e) Y :=
  Eq.symm (nat_iso.naturality_1 (unit_iso e) f)

-- In this section we convert an arbitrary equivalence to a half-adjoint equivalence.

/-- If `η : 𝟭 C ≅ F ⋙ G` is part of a (not necessarily half-adjoint) equivalence, we can upgrade it
to a refined natural isomorphism `adjointify_η η : 𝟭 C ≅ F ⋙ G` which exhibits the properties
required for a half-adjoint equivalence. See `equivalence.mk`. -/
def adjointify_η {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : D ⥤ C}
    (η : 𝟭 ≅ F ⋙ G) (ε : G ⋙ F ≅ 𝟭) : 𝟭 ≅ F ⋙ G :=
  (((((η ≪≫ iso_whisker_left F (iso.symm (functor.left_unitor G))) ≪≫
            iso_whisker_left F (iso_whisker_right (iso.symm ε) G)) ≪≫
          iso_whisker_left F (functor.associator G F G)) ≪≫
        iso.symm (functor.associator F G (F ⋙ G))) ≪≫
      iso_whisker_right (iso.symm η) (F ⋙ G)) ≪≫
    functor.left_unitor (F ⋙ G)

theorem adjointify_η_ε {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} {G : D ⥤ C}
    (η : 𝟭 ≅ F ⋙ G) (ε : G ⋙ F ≅ 𝟭) (X : C) :
    functor.map F (nat_trans.app (iso.hom (adjointify_η η ε)) X) ≫
          nat_trans.app (iso.hom ε) (functor.obj F X) =
        𝟙 :=
  sorry

/-- Every equivalence of categories consisting of functors `F` and `G` such that `F ⋙ G` and
    `G ⋙ F` are naturally isomorphic to identity functors can be transformed into a half-adjoint
    equivalence without changing `F` or `G`. -/
protected def mk {C : Type u₁} [category C] {D : Type u₂} [category D] (F : C ⥤ D) (G : D ⥤ C)
    (η : 𝟭 ≅ F ⋙ G) (ε : G ⋙ F ≅ 𝟭) : C ≌ D :=
  mk' F G (adjointify_η η ε) ε

/-- Equivalence of categories is reflexive. -/
@[simp] theorem refl_functor {C : Type u₁} [category C] : functor refl = 𝟭 := Eq.refl (functor refl)

protected instance inhabited {C : Type u₁} [category C] : Inhabited (C ≌ C) := { default := refl }

/-- Equivalence of categories is symmetric. -/
@[simp] theorem symm_counit_iso {C : Type u₁} [category C] {D : Type u₂} [category D] (e : C ≌ D) :
    counit_iso (symm e) = iso.symm (unit_iso e) :=
  Eq.refl (counit_iso (symm e))

/-- Equivalence of categories is transitive. -/
@[simp] theorem trans_unit_iso {C : Type u₁} [category C] {D : Type u₂} [category D] {E : Type u₃}
    [category E] (e : C ≌ D) (f : D ≌ E) :
    unit_iso (trans e f) =
        unit_iso e ≪≫ iso_whisker_left (functor e) (iso_whisker_right (unit_iso f) (inverse e)) :=
  Eq.refl (unit_iso (trans e f))

/-- Composing a functor with both functors of an equivalence yields a naturally isomorphic functor. -/
def fun_inv_id_assoc {C : Type u₁} [category C] {D : Type u₂} [category D] {E : Type u₃}
    [category E] (e : C ≌ D) (F : C ⥤ E) : functor e ⋙ inverse e ⋙ F ≅ F :=
  iso.symm (functor.associator (functor e) (inverse e) F) ≪≫
    iso_whisker_right (iso.symm (unit_iso e)) F ≪≫ functor.left_unitor F

@[simp] theorem fun_inv_id_assoc_hom_app {C : Type u₁} [category C] {D : Type u₂} [category D]
    {E : Type u₃} [category E] (e : C ≌ D) (F : C ⥤ E) (X : C) :
    nat_trans.app (iso.hom (fun_inv_id_assoc e F)) X =
        functor.map F (nat_trans.app (unit_inv e) X) :=
  sorry

@[simp] theorem fun_inv_id_assoc_inv_app {C : Type u₁} [category C] {D : Type u₂} [category D]
    {E : Type u₃} [category E] (e : C ≌ D) (F : C ⥤ E) (X : C) :
    nat_trans.app (iso.inv (fun_inv_id_assoc e F)) X = functor.map F (nat_trans.app (unit e) X) :=
  sorry

/-- Composing a functor with both functors of an equivalence yields a naturally isomorphic functor. -/
def inv_fun_id_assoc {C : Type u₁} [category C] {D : Type u₂} [category D] {E : Type u₃}
    [category E] (e : C ≌ D) (F : D ⥤ E) : inverse e ⋙ functor e ⋙ F ≅ F :=
  iso.symm (functor.associator (inverse e) (functor e) F) ≪≫
    iso_whisker_right (counit_iso e) F ≪≫ functor.left_unitor F

@[simp] theorem inv_fun_id_assoc_hom_app {C : Type u₁} [category C] {D : Type u₂} [category D]
    {E : Type u₃} [category E] (e : C ≌ D) (F : D ⥤ E) (X : D) :
    nat_trans.app (iso.hom (inv_fun_id_assoc e F)) X = functor.map F (nat_trans.app (counit e) X) :=
  sorry

@[simp] theorem inv_fun_id_assoc_inv_app {C : Type u₁} [category C] {D : Type u₂} [category D]
    {E : Type u₃} [category E] (e : C ≌ D) (F : D ⥤ E) (X : D) :
    nat_trans.app (iso.inv (inv_fun_id_assoc e F)) X =
        functor.map F (nat_trans.app (counit_inv e) X) :=
  sorry

/-- If `C` is equivalent to `D`, then `C ⥤ E` is equivalent to `D ⥤ E`. -/
@[simp] theorem congr_left_unit_iso {C : Type u₁} [category C] {D : Type u₂} [category D]
    {E : Type u₃} [category E] (e : C ≌ D) :
    unit_iso (congr_left e) =
        adjointify_η
          (nat_iso.of_components (fun (F : C ⥤ E) => iso.symm (fun_inv_id_assoc e F))
            (congr_left._proof_1 e))
          (nat_iso.of_components (inv_fun_id_assoc e) (congr_left._proof_2 e)) :=
  Eq.refl
    (adjointify_η
      (nat_iso.of_components (fun (F : C ⥤ E) => iso.symm (fun_inv_id_assoc e F))
        (congr_left._proof_1 e))
      (nat_iso.of_components (inv_fun_id_assoc e) (congr_left._proof_2 e)))

/-- If `C` is equivalent to `D`, then `E ⥤ C` is equivalent to `E ⥤ D`. -/
@[simp] theorem congr_right_functor {C : Type u₁} [category C] {D : Type u₂} [category D]
    {E : Type u₃} [category E] (e : C ≌ D) :
    functor (congr_right e) = functor.obj (whiskering_right E C D) (functor e) :=
  Eq.refl (functor.obj (whiskering_right E C D) (functor e))

-- We need special forms of `cancel_nat_iso_hom_right(_assoc)` and `cancel_nat_iso_inv_right(_assoc)`

-- for units and counits, because neither `simp` or `rw` will apply those lemmas in this

-- setting without providing `e.unit_iso` (or similar) as an explicit argument.

-- We also provide the lemmas for length four compositions, since they're occasionally useful.

-- (e.g. in proving that equivalences take monos to monos)

@[simp] theorem cancel_unit_right {C : Type u₁} [category C] {D : Type u₂} [category D] (e : C ≌ D)
    {X : C} {Y : C} (f : X ⟶ Y) (f' : X ⟶ Y) :
    f ≫ nat_trans.app (unit e) Y = f' ≫ nat_trans.app (unit e) Y ↔ f = f' :=
  sorry

@[simp] theorem cancel_unit_inv_right {C : Type u₁} [category C] {D : Type u₂} [category D]
    (e : C ≌ D) {X : C} {Y : C} (f : X ⟶ functor.obj (inverse e) (functor.obj (functor e) Y))
    (f' : X ⟶ functor.obj (inverse e) (functor.obj (functor e) Y)) :
    f ≫ nat_trans.app (unit_inv e) Y = f' ≫ nat_trans.app (unit_inv e) Y ↔ f = f' :=
  sorry

@[simp] theorem cancel_counit_right {C : Type u₁} [category C] {D : Type u₂} [category D]
    (e : C ≌ D) {X : D} {Y : D} (f : X ⟶ functor.obj (functor e) (functor.obj (inverse e) Y))
    (f' : X ⟶ functor.obj (functor e) (functor.obj (inverse e) Y)) :
    f ≫ nat_trans.app (counit e) Y = f' ≫ nat_trans.app (counit e) Y ↔ f = f' :=
  sorry

@[simp] theorem cancel_counit_inv_right {C : Type u₁} [category C] {D : Type u₂} [category D]
    (e : C ≌ D) {X : D} {Y : D} (f : X ⟶ Y) (f' : X ⟶ Y) :
    f ≫ nat_trans.app (counit_inv e) Y = f' ≫ nat_trans.app (counit_inv e) Y ↔ f = f' :=
  sorry

@[simp] theorem cancel_unit_right_assoc {C : Type u₁} [category C] {D : Type u₂} [category D]
    (e : C ≌ D) {W : C} {X : C} {X' : C} {Y : C} (f : W ⟶ X) (g : X ⟶ Y) (f' : W ⟶ X')
    (g' : X' ⟶ Y) :
    f ≫ g ≫ nat_trans.app (unit e) Y = f' ≫ g' ≫ nat_trans.app (unit e) Y ↔ f ≫ g = f' ≫ g' :=
  sorry

@[simp] theorem cancel_counit_inv_right_assoc {C : Type u₁} [category C] {D : Type u₂} [category D]
    (e : C ≌ D) {W : D} {X : D} {X' : D} {Y : D} (f : W ⟶ X) (g : X ⟶ Y) (f' : W ⟶ X')
    (g' : X' ⟶ Y) :
    f ≫ g ≫ nat_trans.app (counit_inv e) Y = f' ≫ g' ≫ nat_trans.app (counit_inv e) Y ↔
        f ≫ g = f' ≫ g' :=
  sorry

@[simp] theorem cancel_unit_right_assoc' {C : Type u₁} [category C] {D : Type u₂} [category D]
    (e : C ≌ D) {W : C} {X : C} {X' : C} {Y : C} {Y' : C} {Z : C} (f : W ⟶ X) (g : X ⟶ Y)
    (h : Y ⟶ Z) (f' : W ⟶ X') (g' : X' ⟶ Y') (h' : Y' ⟶ Z) :
    f ≫ g ≫ h ≫ nat_trans.app (unit e) Z = f' ≫ g' ≫ h' ≫ nat_trans.app (unit e) Z ↔
        f ≫ g ≫ h = f' ≫ g' ≫ h' :=
  sorry

@[simp] theorem cancel_counit_inv_right_assoc' {C : Type u₁} [category C] {D : Type u₂} [category D]
    (e : C ≌ D) {W : D} {X : D} {X' : D} {Y : D} {Y' : D} {Z : D} (f : W ⟶ X) (g : X ⟶ Y)
    (h : Y ⟶ Z) (f' : W ⟶ X') (g' : X' ⟶ Y') (h' : Y' ⟶ Z) :
    f ≫ g ≫ h ≫ nat_trans.app (counit_inv e) Z = f' ≫ g' ≫ h' ≫ nat_trans.app (counit_inv e) Z ↔
        f ≫ g ≫ h = f' ≫ g' ≫ h' :=
  sorry

-- There's of course a monoid structure on `C ≌ C`,

-- but let's not encourage using it.

-- The power structure is nevertheless useful.

/-- Powers of an auto-equivalence. -/
def pow {C : Type u₁} [category C] (e : C ≌ C) : ℤ → (C ≌ C) := sorry

protected instance int.has_pow {C : Type u₁} [category C] : has_pow (C ≌ C) ℤ := has_pow.mk pow

@[simp] theorem pow_zero {C : Type u₁} [category C] (e : C ≌ C) : e ^ 0 = refl := rfl

@[simp] theorem pow_one {C : Type u₁} [category C] (e : C ≌ C) : e ^ 1 = e := rfl

@[simp] theorem pow_minus_one {C : Type u₁} [category C] (e : C ≌ C) : e ^ (-1) = symm e := rfl

-- TODO as necessary, add the natural isomorphisms `(e^a).trans e^b ≅ e^(a+b)`.

-- At this point, we haven't even defined the category of equivalences.

end equivalence

/-- A functor that is part of a (half) adjoint equivalence -/
class is_equivalence {C : Type u₁} [category C] {D : Type u₂} [category D] (F : C ⥤ D) where
  mk' ::
    (inverse : D ⥤ C)
    (unit_iso : 𝟭 ≅ F ⋙ inverse)
    (counit_iso : inverse ⋙ F ≅ 𝟭)
    (functor_unit_iso_comp' :
      autoParam
        (∀ (X : C),
          functor.map F (nat_trans.app (iso.hom unit_iso) X) ≫
              nat_trans.app (iso.hom counit_iso) (functor.obj F X) =
            𝟙)
        (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.obviously")
          (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "obviously") []))

theorem is_equivalence.functor_unit_iso_comp {C : Type u₁} [category C] {D : Type u₂} [category D]
    {F : C ⥤ D} [c : is_equivalence F] (X : C) :
    functor.map F (nat_trans.app (iso.hom is_equivalence.unit_iso) X) ≫
          nat_trans.app (iso.hom is_equivalence.counit_iso) (functor.obj F X) =
        𝟙 :=
  sorry

namespace is_equivalence

protected instance of_equivalence {C : Type u₁} [category C] {D : Type u₂} [category D]
    (F : C ≌ D) : is_equivalence (equivalence.functor F) :=
  mk' (equivalence.inverse F) (equivalence.unit_iso F) (equivalence.counit_iso F)

protected instance of_equivalence_inverse {C : Type u₁} [category C] {D : Type u₂} [category D]
    (F : C ≌ D) : is_equivalence (equivalence.inverse F) :=
  is_equivalence.of_equivalence (equivalence.symm F)

/-- To see that a functor is an equivalence, it suffices to provide an inverse functor `G` such that
    `F ⋙ G` and `G ⋙ F` are naturally isomorphic to identity functors. -/
protected def mk {C : Type u₁} [category C] {D : Type u₂} [category D] {F : C ⥤ D} (G : D ⥤ C)
    (η : 𝟭 ≅ F ⋙ G) (ε : G ⋙ F ≅ 𝟭) : is_equivalence F :=
  mk' G (equivalence.adjointify_η η ε) ε

end is_equivalence

namespace functor

/-- Interpret a functor that is an equivalence as an equivalence. -/
def as_equivalence {C : Type u₁} [category C] {D : Type u₂} [category D] (F : C ⥤ D)
    [is_equivalence F] : C ≌ D :=
  equivalence.mk' F (is_equivalence.inverse F) is_equivalence.unit_iso is_equivalence.counit_iso

protected instance is_equivalence_refl {C : Type u₁} [category C] : is_equivalence 𝟭 :=
  is_equivalence.of_equivalence equivalence.refl

/-- The inverse functor of a functor that is an equivalence. -/
def inv {C : Type u₁} [category C] {D : Type u₂} [category D] (F : C ⥤ D) [is_equivalence F] :
    D ⥤ C :=
  is_equivalence.inverse F

protected instance is_equivalence_inv {C : Type u₁} [category C] {D : Type u₂} [category D]
    (F : C ⥤ D) [is_equivalence F] : is_equivalence (inv F) :=
  is_equivalence.of_equivalence (equivalence.symm (as_equivalence F))

@[simp] theorem as_equivalence_functor {C : Type u₁} [category C] {D : Type u₂} [category D]
    (F : C ⥤ D) [is_equivalence F] : equivalence.functor (as_equivalence F) = F :=
  rfl

@[simp] theorem as_equivalence_inverse {C : Type u₁} [category C] {D : Type u₂} [category D]
    (F : C ⥤ D) [is_equivalence F] : equivalence.inverse (as_equivalence F) = inv F :=
  rfl

@[simp] theorem inv_inv {C : Type u₁} [category C] {D : Type u₂} [category D] (F : C ⥤ D)
    [is_equivalence F] : inv (inv F) = F :=
  rfl

/-- The composition of functor that is an equivalence with its inverse is naturally isomorphic to
    the identity functor. -/
def fun_inv_id {C : Type u₁} [category C] {D : Type u₂} [category D] (F : C ⥤ D)
    [is_equivalence F] : F ⋙ inv F ≅ 𝟭 :=
  iso.symm is_equivalence.unit_iso

/-- The composition of functor that is an equivalence with its inverse is naturally isomorphic to
    the identity functor. -/
def inv_fun_id {C : Type u₁} [category C] {D : Type u₂} [category D] (F : C ⥤ D)
    [is_equivalence F] : inv F ⋙ F ≅ 𝟭 :=
  is_equivalence.counit_iso

protected instance is_equivalence_trans {C : Type u₁} [category C] {D : Type u₂} [category D]
    {E : Type u₃} [category E] (F : C ⥤ D) (G : D ⥤ E) [is_equivalence F] [is_equivalence G] :
    is_equivalence (F ⋙ G) :=
  is_equivalence.of_equivalence (equivalence.trans (as_equivalence F) (as_equivalence G))

end functor

namespace equivalence

@[simp] theorem functor_inv {C : Type u₁} [category C] {D : Type u₂} [category D] (E : C ≌ D) :
    functor.inv (functor E) = inverse E :=
  rfl

@[simp] theorem inverse_inv {C : Type u₁} [category C] {D : Type u₂} [category D] (E : C ≌ D) :
    functor.inv (inverse E) = functor E :=
  rfl

@[simp] theorem functor_as_equivalence {C : Type u₁} [category C] {D : Type u₂} [category D]
    (E : C ≌ D) : functor.as_equivalence (functor E) = E :=
  sorry

@[simp] theorem inverse_as_equivalence {C : Type u₁} [category C] {D : Type u₂} [category D]
    (E : C ≌ D) : functor.as_equivalence (inverse E) = symm E :=
  sorry

end equivalence

namespace is_equivalence

@[simp] theorem fun_inv_map {C : Type u₁} [category C] {D : Type u₂} [category D] (F : C ⥤ D)
    [is_equivalence F] (X : D) (Y : D) (f : X ⟶ Y) :
    functor.map F (functor.map (functor.inv F) f) =
        nat_trans.app (iso.hom (functor.inv_fun_id F)) X ≫
          f ≫ nat_trans.app (iso.inv (functor.inv_fun_id F)) Y :=
  sorry

@[simp] theorem inv_fun_map {C : Type u₁} [category C] {D : Type u₂} [category D] (F : C ⥤ D)
    [is_equivalence F] (X : C) (Y : C) (f : X ⟶ Y) :
    functor.map (functor.inv F) (functor.map F f) =
        nat_trans.app (iso.hom (functor.fun_inv_id F)) X ≫
          f ≫ nat_trans.app (iso.inv (functor.fun_inv_id F)) Y :=
  sorry

-- We should probably restate many of the lemmas about `equivalence` for `is_equivalence`,

-- but these are the only ones I need for now.

@[simp] theorem functor_unit_comp {C : Type u₁} [category C] {D : Type u₂} [category D] (E : C ⥤ D)
    [is_equivalence E] (Y : C) :
    functor.map E (nat_trans.app (iso.inv (functor.fun_inv_id E)) Y) ≫
          nat_trans.app (iso.hom (functor.inv_fun_id E)) (functor.obj E Y) =
        𝟙 :=
  equivalence.functor_unit_comp (functor.as_equivalence E) Y

@[simp] theorem inv_fun_id_inv_comp {C : Type u₁} [category C] {D : Type u₂} [category D]
    (E : C ⥤ D) [is_equivalence E] (Y : C) :
    nat_trans.app (iso.inv (functor.inv_fun_id E)) (functor.obj E Y) ≫
          functor.map E (nat_trans.app (iso.hom (functor.fun_inv_id E)) Y) =
        𝟙 :=
  eq_of_inv_eq_inv (functor_unit_comp E Y)

end is_equivalence

namespace equivalence

/--
An equivalence is essentially surjective.

See https://stacks.math.columbia.edu/tag/02C3.
-/
theorem ess_surj_of_equivalence {C : Type u₁} [category C] {D : Type u₂} [category D] (F : C ⥤ D)
    [is_equivalence F] : ess_surj F :=
  ess_surj.mk
    fun (Y : D) =>
      Exists.intro (functor.obj (functor.inv F) Y)
        (Nonempty.intro (iso.app (functor.inv_fun_id F) Y))

/--
An equivalence is faithful.

See https://stacks.math.columbia.edu/tag/02C3.
-/
protected instance faithful_of_equivalence {C : Type u₁} [category C] {D : Type u₂} [category D]
    (F : C ⥤ D) [is_equivalence F] : faithful F :=
  faithful.mk

/--
An equivalence is full.

See https://stacks.math.columbia.edu/tag/02C3.
-/
protected instance full_of_equivalence {C : Type u₁} [category C] {D : Type u₂} [category D]
    (F : C ⥤ D) [is_equivalence F] : full F :=
  full.mk
    fun (X Y : C) (f : functor.obj F X ⟶ functor.obj F Y) =>
      nat_trans.app (iso.inv (functor.fun_inv_id F)) X ≫
        functor.map (functor.inv F) f ≫ nat_trans.app (iso.hom (functor.fun_inv_id F)) Y

/--
A functor which is full, faithful, and essentially surjective is an equivalence.

See https://stacks.math.columbia.edu/tag/02C3.
-/
def equivalence_of_fully_faithfully_ess_surj {C : Type u₁} [category C] {D : Type u₂} [category D]
    (F : C ⥤ D) [full F] [faithful F] [ess_surj F] : is_equivalence F :=
  is_equivalence.mk (equivalence_inverse F)
    (nat_iso.of_components
      (fun (X : C) => iso.symm (preimage_iso (functor.obj_obj_preimage_iso F (functor.obj F X))))
      sorry)
    (nat_iso.of_components (functor.obj_obj_preimage_iso F) sorry)

@[simp] theorem functor_map_inj_iff {C : Type u₁} [category C] {D : Type u₂} [category D]
    (e : C ≌ D) {X : C} {Y : C} (f : X ⟶ Y) (g : X ⟶ Y) :
    functor.map (functor e) f = functor.map (functor e) g ↔ f = g :=
  { mp :=
      fun (h : functor.map (functor e) f = functor.map (functor e) g) =>
        functor.map_injective (functor e) h,
    mpr := fun (h : f = g) => h ▸ rfl }

@[simp] theorem inverse_map_inj_iff {C : Type u₁} [category C] {D : Type u₂} [category D]
    (e : C ≌ D) {X : D} {Y : D} (f : X ⟶ Y) (g : X ⟶ Y) :
    functor.map (inverse e) f = functor.map (inverse e) g ↔ f = g :=
  functor_map_inj_iff (symm e) f g

end Mathlib


/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Yury G. Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.order.conditionally_complete_lattice
import Mathlib.logic.function.conjugate
import Mathlib.order.ord_continuous
import Mathlib.data.equiv.mul_add
import Mathlib.PostPort

universes u_1 u_2 u_3

namespace Mathlib

/-!
# Semiconjugate by `Sup`

In this file we prove two facts about semiconjugate (families of) functions.

First, if an order isomorphism `fa : α → α` is semiconjugate to an order embedding `fb : β → β` by
`g : α → β`, then `fb` is semiconjugate to `fa` by `y ↦ Sup {x | g x ≤ y}`, see
`semiconj.symm_adjoint`.

Second, consider two actions `f₁ f₂ : G → α → α` of a group on a complete lattice by order
isomorphisms. Then the map `x ↦ ⨆ g : G, (f₁ g)⁻¹ (f₂ g x)` semiconjugates each `f₁ g'` to `f₂ g'`,
see `function.Sup_div_semiconj`.  In the case of a conditionally complete lattice, a similar
statement holds true under an additional assumption that each set `{(f₁ g)⁻¹ (f₂ g x) | g : G}` is
bounded above, see `function.cSup_div_semiconj`.

The lemmas come from [Étienne Ghys, Groupes d'homeomorphismes du cercle et cohomologie
bornee][ghys87:groupes], Proposition 2.1 and 5.4 respectively. In the paper they are formulated for
homeomorphisms of the circle, so in order to apply results from this file one has to lift these
homeomorphisms to the real line first.
-/

/-- We say that `g : β → α` is an order right adjoint function for `f : α → β` if it sends each `y`
to a least upper bound for `{x | f x ≤ y}`. If `α` is a partial order, and `f : α → β` has
a right adjoint, then this right adjoint is unique. -/
def is_order_right_adjoint {α : Type u_1} {β : Type u_2} [preorder α] [preorder β] (f : α → β)
    (g : β → α) :=
  ∀ (y : β), is_lub (set_of fun (x : α) => f x ≤ y) (g y)

theorem is_order_right_adjoint_Sup {α : Type u_1} {β : Type u_2} [complete_lattice α] [preorder β]
    (f : α → β) : is_order_right_adjoint f fun (y : β) => Sup (set_of fun (x : α) => f x ≤ y) :=
  fun (y : β) => is_lub_Sup (set_of fun (x : α) => f x ≤ y)

theorem is_order_right_adjoint_cSup {α : Type u_1} {β : Type u_2} [conditionally_complete_lattice α]
    [preorder β] (f : α → β) (hne : ∀ (y : β), ∃ (x : α), f x ≤ y)
    (hbdd : ∀ (y : β), ∃ (b : α), ∀ (x : α), f x ≤ y → x ≤ b) :
    is_order_right_adjoint f fun (y : β) => Sup (set_of fun (x : α) => f x ≤ y) :=
  fun (y : β) => is_lub_cSup (hne y) (hbdd y)

theorem is_order_right_adjoint.unique {α : Type u_1} {β : Type u_2} [partial_order α] [preorder β]
    {f : α → β} {g₁ : β → α} {g₂ : β → α} (h₁ : is_order_right_adjoint f g₁)
    (h₂ : is_order_right_adjoint f g₂) : g₁ = g₂ :=
  funext fun (y : β) => is_lub.unique (h₁ y) (h₂ y)

theorem is_order_right_adjoint.right_mono {α : Type u_1} {β : Type u_2} [preorder α] [preorder β]
    {f : α → β} {g : β → α} (h : is_order_right_adjoint f g) : monotone g :=
  fun (y₁ y₂ : β) (hy : y₁ ≤ y₂) =>
    is_lub.mono (h y₁) (h y₂)
      fun (x : α) (hx : x ∈ set_of fun (x : α) => f x ≤ y₁) => le_trans hx hy

namespace function

/-- If an order automorphism `fa` is semiconjugate to an order embedding `fb` by a function `g`
and `g'` is an order right adjoint of `g` (i.e. `g' y = Sup {x | f x ≤ y}`), then `fb` is
semiconjugate to `fa` by `g'`.

This is a version of Proposition 2.1 from [Étienne Ghys, Groupes d'homeomorphismes du cercle et
cohomologie bornee][ghys87:groupes]. -/
theorem semiconj.symm_adjoint {α : Type u_1} {β : Type u_2} [partial_order α] [preorder β]
    {fa : α ≃o α} {fb : β ↪o β} {g : α → β} (h : semiconj g ⇑fa ⇑fb) {g' : β → α}
    (hg' : is_order_right_adjoint g g') : semiconj g' ⇑fb ⇑fa :=
  sorry

theorem semiconj_of_is_lub {α : Type u_1} {G : Type u_3} [partial_order α] [group G]
    (f₁ : G →* α ≃o α) (f₂ : G →* α ≃o α) {h : α → α}
    (H :
      ∀ (x : α),
        is_lub (set.range fun (g' : G) => coe_fn (coe_fn f₁ g'⁻¹) (coe_fn (coe_fn f₂ g') x)) (h x))
    (g : G) : semiconj h ⇑(coe_fn f₂ g) ⇑(coe_fn f₁ g) :=
  sorry

/-- Consider two actions `f₁ f₂ : G → α → α` of a group on a complete lattice by order
isomorphisms. Then the map `x ↦ ⨆ g : G, (f₁ g)⁻¹ (f₂ g x)` semiconjugates each `f₁ g'` to `f₂ g'`.

This is a version of Proposition 5.4 from [Étienne Ghys, Groupes d'homeomorphismes du cercle et
cohomologie bornee][ghys87:groupes]. -/
theorem Sup_div_semiconj {α : Type u_1} {G : Type u_3} [complete_lattice α] [group G]
    (f₁ : G →* α ≃o α) (f₂ : G →* α ≃o α) (g : G) :
    semiconj (fun (x : α) => supr fun (g' : G) => coe_fn (coe_fn f₁ g'⁻¹) (coe_fn (coe_fn f₂ g') x))
        ⇑(coe_fn f₂ g) ⇑(coe_fn f₁ g) :=
  semiconj_of_is_lub f₁ f₂ (fun (x : α) => is_lub_supr) g

/-- Consider two actions `f₁ f₂ : G → α → α` of a group on a conditionally complete lattice by order
isomorphisms. Suppose that each set $s(x)=\{f_1(g)^{-1} (f_2(g)(x)) | g \in G\}$ is bounded above.
Then the map `x ↦ Sup s(x)` semiconjugates each `f₁ g'` to `f₂ g'`.

This is a version of Proposition 5.4 from [Étienne Ghys, Groupes d'homeomorphismes du cercle et
cohomologie bornee][ghys87:groupes]. -/
theorem cSup_div_semiconj {α : Type u_1} {G : Type u_3} [conditionally_complete_lattice α] [group G]
    (f₁ : G →* α ≃o α) (f₂ : G →* α ≃o α)
    (hbdd :
      ∀ (x : α),
        bdd_above (set.range fun (g : G) => coe_fn (coe_fn f₁ g⁻¹) (coe_fn (coe_fn f₂ g) x)))
    (g : G) :
    semiconj (fun (x : α) => supr fun (g' : G) => coe_fn (coe_fn f₁ g'⁻¹) (coe_fn (coe_fn f₂ g') x))
        ⇑(coe_fn f₂ g) ⇑(coe_fn f₁ g) :=
  sorry

end Mathlib


-- You can even write it as a function!

theorem contrapositive (P Q : Prop) :
 (P → Q) →  (¬ Q → ¬ P) :=
  λ HPQ HnQ HP, HnQ (HPQ HP)


import data.real.basic
import tactic
import real_definitions
-- import utils

-- #print linarith.make_comp_with_zero

import tactic.linarith.datatypes

import structures2

/-
- add an optional list of hypos in parameters, then compute is restricted to the given list.

- essayer le simple : assumption, tautology

- tags :
    - `target_strict`: but est une inégalité stricte ?
    - `target_abs`, `target_max`: but contient une valeur absolue / un max ?
    - `hypo_abs`, `hypo_max`: hypos contiennent des valeurs absolues / max, min ?

    - `target_strict`:
            - `get_pos_from_pos_eq`, ou bien splitter les non-égalités
            - `%%a ≠ 0` -->  `abs a >0` si target_abs (`abs_pos_of_ne_zero`)
            - `%%abs a ≠ 0` --> a ≠ 0   si pas target_abs (`ne_zero_of_abs_ne_zero`)
            - idem, utiliser |a| < b ==> -b < a < b, ...

- abs pre_processor:
    - abs ≥ 0. Comment l'utiliser au milieu d'une expression ?
    - simplifier |a| < b, |a| ≤ b, (idem minoration)

- min_max_preprocessor:
    max a b ≥ a, max a b ≥ b, ... à appliquer sur `%%a = max %%b %%c`

- pre-processing n°1:
    - from linarith: `[filter_comparisons, remove_negations, make_comp_with_zero]`
    ou même tout ? `[filter_comparisons, remove_negations, nat_to_int, strengthen_strict_int, make_comp_with_zero, cancel_denoms]`
    - Si `but = inégalité stricte`, y ajouter `get_pos_from_pos_eq` ?
    - pour la suite, il faut récupérer la liste des preuves résultantes
- puis appliquer `linarith` à cette liste (sans preprocessing!)

- target pre-processing:
    - `[apply mul_pos, inv_pos.mpr, mul_ne_zero]` avant de recommencer ?
    Attention, ces énoncés jouent sur le target, pas sur les hypos
    (donc ça ne rentre pas dans la classe preprocessors)
    Deux de ces tactiques dédouble le but (ab >0 remplacé par a>0 et b>0).

    Et ré-essayer `linarith`?
- pre-processor ifs:
    - dans la liste d'égalités / inégalité, unfold abs max (ou éventuellement ré-écrire abs ?)
    - split_ifs, cases_type or and,
-/

/-
(1) Splittings bourrins :
    - si target strict, splitter les a≠b
    [- si target non abs, essayer de se déparrasser des abs (|a| < b ==> -b < a < b)]
    - si target abs, splitter les abs : unfold abs max, split_ifs

    - si ça ne marche, pas, `apply mul_pos, inv_pos.mpr, mul_ne_zero` et recommencer linarith

-/

open native tactic expr
namespace linarith

/-! ### Preprocessing -/

-- New preprocessors for linarith:
-- `filter_comparisons'`, remove_negations, nat_to_int, strengthen_strict_int,
--  `make_comp_with_zero'`, (`get_strict_ineq`, `filter_noneq`) / `split_noneq`,
-- cancel_denoms
-- make_comp_with_zero' must take into account non-equalities a≠b.
-- After having added strict inequalities we have to filter nonremove non-equalities.

--------------------------------------------------------------------------
-- filter_comparisons': Filter inequalities, equalities, non-equalities --
--------------------------------------------------------------------------
/-
Based on linarith.filter_comparisons, but keep non-equalities a≠b -/
private meta def filter_comparisons_aux' : expr → bool
| `(¬ %%p) := p.app_symbol_in [`has_lt.lt, `has_le.le, `gt, `ge, `eq]
| tp := tp.app_symbol_in [`has_lt.lt, `has_le.le, `gt, `ge, `eq, `ne]

/--
Removes any expressions that are not proofs of inequalities, equalities, or negations thereof.
-/
meta def filter_comparisons' : linarith.preprocessor :=
{ name := "filter terms that are not proofs of comparisons",
  transform := λ h,
(do tp ← infer_type h,
   is_prop tp >>= guardb,
   guardb (filter_comparisons_aux' tp),
   return [h])
<|> return [] }

--------------------------------
-- make comparisons with zero --
--------------------------------

set_option eqn_compiler.max_steps 50000
private meta def rearr_comp_aux' : expr → expr → tactic expr
| prf `(%%a ≠ 0) := return prf
| prf `(%%a ≠ %%b) := mk_app ``sub_ne_zero_of_ne [prf]
| prf `(%%a ≤ 0) := return prf
| prf  `(%%a < 0) := return prf
| prf  `(%%a = 0) := return prf
| prf  `(%%a ≥ 0) := mk_app ``neg_nonpos_of_nonneg [prf]
| prf  `(%%a > 0) := mk_app `neg_neg_of_pos [prf]
| prf  `(0 ≥ %%a) := to_expr ``(id_rhs (%%a ≤ 0) %%prf)
| prf  `(0 > %%a) := to_expr ``(id_rhs (%%a < 0) %%prf)
| prf  `(0 = %%a) := mk_app `eq.symm [prf]
| prf  `(0 ≤ %%a) := mk_app ``neg_nonpos_of_nonneg [prf]
| prf  `(0 < %%a) := mk_app `neg_neg_of_pos [prf]
| prf  `(%%a ≤ %%b) := mk_app ``sub_nonpos_of_le [prf]
| prf  `(%%a < %%b) := mk_app `sub_neg_of_lt [prf]
| prf  `(%%a = %%b) := mk_app `sub_eq_zero_of_eq [prf]
| prf  `(%%a > %%b) := mk_app `sub_neg_of_lt [prf]
| prf  `(%%a ≥ %%b) := mk_app ``sub_nonpos_of_le [prf]
| prf  `(¬ %%t) := do nprf ← rem_neg prf t, tp ← infer_type nprf, rearr_comp_aux' nprf tp
| prf  a := trace a >> fail "couldn't rearrange comp"

/--
`rearr_comp e` takes a proof `e` of an equality, inequality, or negation thereof,
and turns it into a proof of a comparison `_ R 0`, where `R ∈ {=, ≤, <}`.
 -/
private meta def rearr_comp' (e : expr) : tactic expr :=
infer_type e >>= rearr_comp_aux' e

/--
`mk_comp_with_zero h` takes a proof `h` of an equality, inequality, or negation thereof,
and turns it into a proof of a comparison `_ R 0`, where `R ∈ {=, ≤, <, ≠}`.
 -/
meta def make_comp_with_zero' : preprocessor :=
{ name := "make comparisons with zero",
  transform := λ e, singleton <$> rearr_comp' e <|> return [] }

-----------------------------
-- Get strict inequalities --
-----------------------------
/-
This will be a global preprocessor. It takes a list of comparisons with 0,
and replace each a≤0 by a<0 if the list also contains a≠0 or -a≠0.
We need auxiliary tactic make_lt.
-/

/-  Take proofs of "a ≤ 0" and of "a' ≠ 0'", and if a=a'
    then add a proof of "a < 0" -/
private meta def make_lt_aux : expr × expr → expr × expr → tactic expr
| (prf, a) (prf', a') := tactic.unify a a' >> to_expr ``(lt_of_le_of_ne %%prf %%prf')
                        <|> do linarith_trace "(strengthening failed)", fail ""

lemma neg_non_zero_of_non_zero {G: Type} [add_group G] (a:G) (ha: a ≠ 0) : -a ≠0 :=
begin
    contrapose! ha,-- neg_eq_zero.mpr
    apply neg_eq_zero.mp ha,
end

lemma neg_non_zero_of_non_zero' (a:ℝ) (ha: a ≠ 0) : -a ≠0 :=
begin
    contrapose! ha,-- neg_eq_zero.mpr
    apply neg_eq_zero.mp ha,
end

/- The same, with the possibility that a=-a' -/
private meta def make_lt_aux' : expr × expr → expr × expr → tactic expr
| (prf, a) (prf', a') := do linarith_trace ("trying with..." ++ to_string a'),
    prf'' ← mk_app ``neg_non_zero_of_non_zero' [prf'],
    linarith_trace "...hard",
    t ← infer_type prf'',
    match t with
    | `(%%a'' ≠ 0) := do linarith_trace ("(-->" ++ to_string a'' ++ "≠0"),
                        (make_lt_aux (prf, a) (prf'', a''))
    | _ := do linarith_trace ("failed trying " ++ to_string t), fail "Unexpected failure"
    end

/-  Take a proof of some inequality ineq and a proof of `a' ≠ 0`,
and if ineq is `a ≤ 0` with a=a' or a = -a'
then return a proof of `a < 0` ; else return the original proof of ineq. -/
private meta def make_lt : expr × expr → expr × expr → tactic expr
| (prf, a) (prf', a') := make_lt_aux (prf, a) (prf', a')
                        <|> make_lt_aux' (prf, a) (prf', a')
                        <|> return prf

private meta def make_lt_from_prf : expr → expr → tactic expr
| prf prf' :=  (do `(%%a ≤ 0) ← infer_type prf,
                 `(%%a' ≠ 0) ← infer_type prf',
                 linarith_trace_proofs "trying with " [prf, prf'],
                 (make_lt (prf, a) (prf', a'))) <|> return prf

/- Given a list of proofs and a proof of a≠0, replace each proof of a≤0 in the list
 by a proof of a<0. -/
private meta def replace_le : list expr → expr → tactic (list expr)
| ls prf' := ls.mmap (λ prf, (make_lt_from_prf prf prf'))

/- Globalize the previous tactic to a list of proofs of `a≠0`. -/
private meta def replace_le_glob : list expr → list expr → tactic (list expr)
| ls ls' := match ls' with
            | [] := return ls
            | head :: tail := do ls_new ← replace_le ls head,
                                 (replace_le_glob ls_new tail)
            end

private meta def filter_neg (prf: expr) : tactic bool :=
do t ← infer_type prf, match t with
                        | `(%%a ≠ 0) := return tt
                        | `(¬ %%p)   := return tt
                        | _          := return ff
                        end

private meta def filter_noneq_aux (prf: expr) : tactic bool :=
do t ← infer_type prf, match t with
                        | `(%%a ≠ 0) := return ff
                        | _        := return tt
                        end
-- private meta def filter_le : expr → tactic bool
-- | `(%%a ≤ 0) := return tt
-- | _        := return ff

/- In a list of comparisons with 0, replace each a≤0 by a<0 if the list
also contains a≠0 or -a≠0.-/
meta def get_strict_ineq : global_preprocessor :=
{ name := "try to replace large inequalities by strict ones",
  transform := λ ls, do
    ls_neq ← ls.mfilter filter_neg, linarith_trace_proofs "Non-equalities: " ls_neq,
    -- ls_le ← ls.mfilter filter_le,
    ls ← replace_le_glob ls ls_neq,
    return ls
}

meta def filter_noneq : preprocessor :=
{ name := "Remove non equalities a≠0",
  transform := λ l, do t ← infer_type l, match t with
                    | `(%%a ≠ 0) := return []
                    | _        := return [l]
                    end
}

--------------------------
-- Split non equalities --
--------------------------
lemma lt_or_gt_of_non_zero {α: Type} [linear_order α] {a b: α} (ha: a ≠ b) : a < b ∨ b < a :=
begin
    exact lt_or_gt_of_ne ha,
end

example (a b c d: ℝ ) (H0: b=a) (H1: a ≤ 0) (H2: -a ≠ 0): a +1 < 1 :=
begin
    have H2' := lt_or_gt_of_non_zero H2,
    cases H2' with H2l H2g,
    linarith, linarith,
end

meta def deaduction_preprocessors : list global_preprocessor :=
[filter_comparisons', remove_negations, nat_to_int, strengthen_strict_int,
make_comp_with_zero', get_strict_ineq, filter_noneq,  cancel_denoms]

end linarith

-- meta def deaduction_cfg : linarith_config := {preprocessors := deaduction_preprocessors}

open linarith
open interactive.types
open interactive (parse loc.ns loc.wildcard)
open lean.parser (tk ident many) interactive.loc
local postfix `?`:9001 := optional

meta def tactic.interactive.linarith' (red : parse ((tk "!")?))
  (restr : parse ((tk "only")?)) (hyps : parse pexpr_list?)
  (cfg : linarith_config := {}) : tactic unit :=
tactic.linarith red.is_some restr.is_some (hyps.get_or_else [])
  { cfg with preprocessors := deaduction_preprocessors }

open tactic.interactive
set_option trace.linarith true

-- meta def filter_noneq_aux : expr → tactic string
-- | `(¬ %%p)  := return "¬"
-- | `(%%a ≠ 0) := return "≠"
-- | _        := return "_"

-- meta def tactic.interactive.essai : tactic unit :=
-- do ls ← local_context, ls.mmap' (λ l, do t ← infer_type l, tactic.trace (filter_noneq_aux t))

example (a b c d: ℝ ) (H0: b=a) (H1: a ≤ 0) (H2: -a ≠ 0): a +1 < 1 :=
begin
    -- essai,
    -- hypo_analysis,
    linarith',
end


/-
Copyright (c) 2021 Yaël Dillies, Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies, Bhavik Mehta
-/
import combinatorics.simplicial_complex.basic
import combinatorics.simplicial_complex.closure

namespace affine
open set
variables {m n : ℕ} {E : Type*} [normed_group E] [normed_space ℝ E] {S : simplicial_complex E}
  {X Y : finset E} {A B : set (finset E)}

/--
The open star of a set of faces is the union of their surfaces. Note that the star is all of the
original complex as soon as A contains the empty set.
-/
def simplicial_complex.star (S : simplicial_complex E) :
  set (finset E) → set (finset E) :=
λ A, {X | X ∈ S.faces ∧ ∃ {Y}, Y ∈ A ∧ Y ⊆ X}

lemma star_empty :
  S.star ∅ = ∅ :=
begin
  unfold simplicial_complex.star,
  simp,
end

lemma star_singleton_empty :
  S.star {∅} = S.faces :=
begin
  unfold simplicial_complex.star,
  simp,
end

lemma mem_star_singleton_iff :
  Y ∈ S.star {X} ↔ Y ∈ S.faces ∧ X ⊆ Y :=
begin
  unfold simplicial_complex.star,
  simp,
end

lemma mem_star_iff :
  X ∈ S.star A ↔ X ∈ S.faces ∩ ⋃ (Y ∈ A), {Z | Y ⊆ Z} :=
begin
  unfold simplicial_complex.star,
  simp,
end

lemma star_subset : S.star A ⊆ S.faces :=
  λ X hX, hX.1

lemma subset_star :
  S.faces ∩ A ⊆ S.star A :=
λ X hX, ⟨hX.1, X, hX.2, subset.refl X⟩

lemma star_mono (hAB : A ⊆ B) :
  S.star A ⊆ S.star B :=
λ X ⟨hX, Y, hY, hYX⟩, ⟨hX, Y, hAB hY, hYX⟩

lemma star_up_closed :
  X ∈ S.faces → Y ∈ S.star A → Y ⊆ X → X ∈ S.star A :=
λ hX ⟨hY, Z, hZ, hZY⟩ hYX, ⟨hX, Z, hZ, subset.trans hZY hYX⟩

lemma Union_star_eq_star :
  (⋃ (X ∈ A), S.star {X}) = S.star A :=
begin
  ext X,
  rw mem_bUnion_iff,
  split,
  {
    rintro ⟨Y', hY, hX, Y, (hYY' : Y = Y'), hYX⟩,
    subst hYY',
    exact ⟨hX, Y, hY, hYX⟩,
  },
  {
    rintro ⟨hX, Y, hY, hYX⟩,
    exact ⟨Y, hY, hX, Y, mem_singleton Y, hYX⟩,
  }
end

--Can maybe get rid of hX?
lemma star_singleton_eq_Inter_star_singleton (hX : X ∈ S.faces) :
  S.star {X} = ⋂ x ∈ X, S.star {{x}} :=
begin
  ext Y,
  split,
  { rintro ⟨hY, Z, (hZ : Z = X), hXY⟩,
    rw hZ at hXY,
    exact mem_bInter (λ x (hx : x ∈ X), ⟨hY, {x}, mem_singleton {x},
      finset.singleton_subset_iff.2 (hXY hx)⟩) },
  { rintro h,
    rw mem_star_singleton_iff,
    split,
    { simp only [mem_Inter] at h,
      sorry
    },
    rintro x hx,
    obtain ⟨hY, Z, (hZ : Z = {x}), hxY⟩ := mem_bInter_iff.1 h x hx,
    rw hZ at hxY,
    exact finset.singleton_subset_iff.1 hxY }
end

/--
The closed star of a complex S and a set A is the complex whose faces are in S and share a surface
with some face in A
-/
def simplicial_complex.Star (S : simplicial_complex E) (A : set (finset E)) :
  simplicial_complex E :=
simplicial_complex.of_surcomplex {X | ∃ {Y Z}, Y ∈ A ∧ Z ∈ S.faces ∧ X ⊆ Z ∧ Y ⊆ Z}
  (λ X ⟨_, Z, _, hZ, hXZ, _⟩, S.down_closed hZ hXZ)
  (λ X W ⟨Y, Z, hY, hZ, hXZ, hYZ⟩ hWX, ⟨Y, Z, hY, hZ, subset.trans hWX hXZ, hYZ⟩)

lemma Star_empty :
  (S.Star ∅).faces = ∅ :=
begin
  unfold simplicial_complex.Star,
  simp,
end

lemma Star_singleton_empty :
  S.Star {∅} = S :=
begin
  ext X,
  split,
  {
    rintro ⟨Y, Z, (hY : Y = ∅), hZ, hXZ, hYZ⟩,
    exact S.down_closed hZ hXZ,
  },
  {
    rintro hX,
    exact ⟨∅, X, rfl, hX, subset.refl _, empty_subset X⟩,
  }
end

lemma mem_Star_singleton_iff :
  Y ∈ (S.Star {X}).faces ↔ ∃ {Z}, Z ∈ S.faces ∧ Y ⊆ Z ∧ X ⊆ Z :=
begin
  unfold simplicial_complex.Star,
  simp,
end

/--
The closed star of a set is the closure of its open star.
-/
lemma Star_eq_closure_star :
  S.Star A = S.closure (S.star A) :=
begin
  ext X,
  split,
  {
    rintro ⟨Y, Z, hY, hZ, hXZ, hYZ⟩,
    exact ⟨S.down_closed hZ hXZ, Z, ⟨hZ, Y, hY, hYZ⟩, hXZ⟩,
  },
  {
    rintro ⟨hX, Z, ⟨hZ, Y, hY, hYZ⟩, hXZ⟩,
    exact ⟨Y, Z, hY, hZ, hXZ, hYZ⟩,
  }
end

lemma Star_subset :
  (S.Star A).faces ⊆ S.faces :=
λ X ⟨_, Z, _, hZ, hXZ, _⟩, S.down_closed hZ hXZ

lemma subset_Star :
  S.faces ∩ A ⊆ (S.Star A).faces :=
λ X ⟨hXS, hXA⟩, ⟨X, X, hXA, hXS, subset.refl X, subset.refl X⟩

lemma star_subset_Star :
  S.star A ⊆ (S.Star A).faces :=
λ X ⟨hX, Y, hY, hYX⟩, ⟨Y, X, hY, hX, subset.refl X, hYX⟩

lemma Star_mono (hAB : A ⊆ B) :
  (S.Star A).faces ⊆ (S.Star B).faces :=
begin
  rw [Star_eq_closure_star, Star_eq_closure_star],
  exact closure_faces_subset_of_subset (star_mono hAB),
end

lemma Star_facet_iff :
  X ∈ (S.Star A).facets ↔ X ∈ S.facets ∧ ∃ {Y}, Y ∈ A ∧ Y ⊆ X :=
begin
  split,
  {
    rintro ⟨⟨Y, Z, hY, hZ, hXZ, hYZ⟩, hXmax⟩,
    have := hXmax ⟨Y, Z, hY, hZ, subset.refl Z, hYZ⟩ hXZ,
    subst this,
    split,
    {
      use hZ,
      rintro W hW hXW,
      exact hXmax (star_subset_Star ⟨hW, Y, hY, subset.trans hYZ hXW⟩) hXW,
    },
    { exact ⟨Y, hY, hYZ⟩, }
  },
  {
    rintro ⟨hX, Y, hY, hYX⟩,
    split,
    exact ⟨Y, X, hY, hX.1, subset.refl X, hYX⟩,
    rintro Z hZ,
    exact hX.2 (Star_subset hZ),
  }
end

lemma pure_Star_of_pure (hS : S.pure_of n) :
  (S.Star A).pure_of n :=
λ X hX, hS (Star_facet_iff.1 hX).1

lemma Star_pureness_eq_pureness [finite_dimensional ℝ E] (hS : S.pure)
  (hSA : (S.Star A).faces.nonempty) :
  (S.Star A).pureness = S.pureness :=
begin
  obtain ⟨n, hS⟩ := hS,
  obtain ⟨X, hX⟩ := id hSA,
  rw [pureness_def' hSA (pure_Star_of_pure hS), pureness_def' (hSA.mono Star_subset) hS],
end

end affine


theorem test (p q : Prop) (hp : p) (hq : q) : p ∧ q ∧ p := by
  apply And.intro
  exact hp
  apply And.intro
  exact hq
  exact hp


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.limits.shapes.kernels
import Mathlib.category_theory.concrete_category.basic
import Mathlib.PostPort

universes u u_1

namespace Mathlib

/-!
# Facts about limits of functors into concrete categories

This file doesn't yet attempt to be exhaustive;
it just contains lemmas that are useful
while comparing categorical limits with existing constructions in concrete categories.
-/

namespace category_theory.limits

@[simp] theorem kernel_condition_apply {C : Type (u + 1)} [large_category C] [concrete_category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) [has_kernel f] (x : ↥(kernel f)) : coe_fn f (coe_fn (kernel.ι f) x) = coe_fn 0 x := sorry

@[simp] theorem cokernel_condition_apply {C : Type (u + 1)} [large_category C] [concrete_category C] [has_zero_morphisms C] {X : C} {Y : C} (f : X ⟶ Y) [has_cokernel f] (x : ↥X) : coe_fn (cokernel.π f) (coe_fn f x) = coe_fn 0 x := sorry


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.finset.basic
import Mathlib.data.multiset.fold
import Mathlib.PostPort

universes u_1 u_2 u_3

namespace Mathlib

/-!
# The fold operation for a commutative associative operation over a finset.
-/

namespace finset

/-! ### fold -/

/-- `fold op b f s` folds the commutative associative operation `op` over the
  `f`-image of `s`, i.e. `fold (+) b f {1,2,3} = `f 1 + f 2 + f 3 + b`. -/
def fold {α : Type u_1} {β : Type u_2} (op : β → β → β) [hc : is_commutative β op]
    [ha : is_associative β op] (b : β) (f : α → β) (s : finset α) : β :=
  multiset.fold op b (multiset.map f (val s))

@[simp] theorem fold_empty {α : Type u_1} {β : Type u_2} {op : β → β → β} [hc : is_commutative β op]
    [ha : is_associative β op] {f : α → β} {b : β} : fold op b f ∅ = b :=
  rfl

@[simp] theorem fold_insert {α : Type u_1} {β : Type u_2} {op : β → β → β}
    [hc : is_commutative β op] [ha : is_associative β op] {f : α → β} {b : β} {s : finset α} {a : α}
    [DecidableEq α] (h : ¬a ∈ s) : fold op b f (insert a s) = op (f a) (fold op b f s) :=
  sorry

@[simp] theorem fold_singleton {α : Type u_1} {β : Type u_2} {op : β → β → β}
    [hc : is_commutative β op] [ha : is_associative β op] {f : α → β} {b : β} {a : α} :
    fold op b f (singleton a) = op (f a) b :=
  rfl

@[simp] theorem fold_map {α : Type u_1} {β : Type u_2} {γ : Type u_3} {op : β → β → β}
    [hc : is_commutative β op] [ha : is_associative β op] {f : α → β} {b : β} {g : γ ↪ α}
    {s : finset γ} : fold op b f (map g s) = fold op b (f ∘ ⇑g) s :=
  sorry

@[simp] theorem fold_image {α : Type u_1} {β : Type u_2} {γ : Type u_3} {op : β → β → β}
    [hc : is_commutative β op] [ha : is_associative β op] {f : α → β} {b : β} [DecidableEq α]
    {g : γ → α} {s : finset γ} (H : ∀ (x : γ), x ∈ s → ∀ (y : γ), y ∈ s → g x = g y → x = y) :
    fold op b f (image g s) = fold op b (f ∘ g) s :=
  sorry

theorem fold_congr {α : Type u_1} {β : Type u_2} {op : β → β → β} [hc : is_commutative β op]
    [ha : is_associative β op] {f : α → β} {b : β} {s : finset α} {g : α → β}
    (H : ∀ (x : α), x ∈ s → f x = g x) : fold op b f s = fold op b g s :=
  sorry

theorem fold_op_distrib {α : Type u_1} {β : Type u_2} {op : β → β → β} [hc : is_commutative β op]
    [ha : is_associative β op] {s : finset α} {f : α → β} {g : α → β} {b₁ : β} {b₂ : β} :
    fold op (op b₁ b₂) (fun (x : α) => op (f x) (g x)) s = op (fold op b₁ f s) (fold op b₂ g s) :=
  sorry

theorem fold_hom {α : Type u_1} {β : Type u_2} {γ : Type u_3} {op : β → β → β}
    [hc : is_commutative β op] [ha : is_associative β op] {f : α → β} {b : β} {s : finset α}
    {op' : γ → γ → γ} [is_commutative γ op'] [is_associative γ op'] {m : β → γ}
    (hm : ∀ (x y : β), m (op x y) = op' (m x) (m y)) :
    fold op' (m b) (fun (x : α) => m (f x)) s = m (fold op b f s) :=
  sorry

theorem fold_union_inter {α : Type u_1} {β : Type u_2} {op : β → β → β} [hc : is_commutative β op]
    [ha : is_associative β op] {f : α → β} [DecidableEq α] {s₁ : finset α} {s₂ : finset α} {b₁ : β}
    {b₂ : β} :
    op (fold op b₁ f (s₁ ∪ s₂)) (fold op b₂ f (s₁ ∩ s₂)) = op (fold op b₂ f s₁) (fold op b₁ f s₂) :=
  sorry

@[simp] theorem fold_insert_idem {α : Type u_1} {β : Type u_2} {op : β → β → β}
    [hc : is_commutative β op] [ha : is_associative β op] {f : α → β} {b : β} {s : finset α} {a : α}
    [DecidableEq α] [hi : is_idempotent β op] :
    fold op b f (insert a s) = op (f a) (fold op b f s) :=
  sorry

theorem fold_op_rel_iff_and {α : Type u_1} {β : Type u_2} {op : β → β → β}
    [hc : is_commutative β op] [ha : is_associative β op] {f : α → β} {b : β} {s : finset α}
    {r : β → β → Prop} (hr : ∀ {x y z : β}, r x (op y z) ↔ r x y ∧ r x z) {c : β} :
    r c (fold op b f s) ↔ r c b ∧ ∀ (x : α), x ∈ s → r c (f x) :=
  sorry

theorem fold_op_rel_iff_or {α : Type u_1} {β : Type u_2} {op : β → β → β} [hc : is_commutative β op]
    [ha : is_associative β op] {f : α → β} {b : β} {s : finset α} {r : β → β → Prop}
    (hr : ∀ {x y z : β}, r x (op y z) ↔ r x y ∨ r x z) {c : β} :
    r c (fold op b f s) ↔ r c b ∨ ∃ (x : α), ∃ (H : x ∈ s), r c (f x) :=
  sorry

@[simp] theorem fold_union_empty_singleton {α : Type u_1} [DecidableEq α] (s : finset α) :
    fold has_union.union ∅ singleton s = s :=
  sorry

@[simp] theorem fold_sup_bot_singleton {α : Type u_1} [DecidableEq α] (s : finset α) :
    fold has_sup.sup ⊥ singleton s = s :=
  fold_union_empty_singleton s

theorem le_fold_min {α : Type u_1} {β : Type u_2} {f : α → β} {b : β} {s : finset α}
    [linear_order β] (c : β) : c ≤ fold min b f s ↔ c ≤ b ∧ ∀ (x : α), x ∈ s → c ≤ f x :=
  fold_op_rel_iff_and fun (x y z : β) => le_min_iff

theorem fold_min_le {α : Type u_1} {β : Type u_2} {f : α → β} {b : β} {s : finset α}
    [linear_order β] (c : β) : fold min b f s ≤ c ↔ b ≤ c ∨ ∃ (x : α), ∃ (H : x ∈ s), f x ≤ c :=
  id (fold_op_rel_iff_or fun (x y z : β) => id min_le_iff)

theorem lt_fold_min {α : Type u_1} {β : Type u_2} {f : α → β} {b : β} {s : finset α}
    [linear_order β] (c : β) : c < fold min b f s ↔ c < b ∧ ∀ (x : α), x ∈ s → c < f x :=
  fold_op_rel_iff_and fun (x y z : β) => lt_min_iff

theorem fold_min_lt {α : Type u_1} {β : Type u_2} {f : α → β} {b : β} {s : finset α}
    [linear_order β] (c : β) : fold min b f s < c ↔ b < c ∨ ∃ (x : α), ∃ (H : x ∈ s), f x < c :=
  id (fold_op_rel_iff_or fun (x y z : β) => id min_lt_iff)

theorem fold_max_le {α : Type u_1} {β : Type u_2} {f : α → β} {b : β} {s : finset α}
    [linear_order β] (c : β) : fold max b f s ≤ c ↔ b ≤ c ∧ ∀ (x : α), x ∈ s → f x ≤ c :=
  id (fold_op_rel_iff_and fun (x y z : β) => id max_le_iff)

theorem le_fold_max {α : Type u_1} {β : Type u_2} {f : α → β} {b : β} {s : finset α}
    [linear_order β] (c : β) : c ≤ fold max b f s ↔ c ≤ b ∨ ∃ (x : α), ∃ (H : x ∈ s), c ≤ f x :=
  fold_op_rel_iff_or fun (x y z : β) => le_max_iff

theorem fold_max_lt {α : Type u_1} {β : Type u_2} {f : α → β} {b : β} {s : finset α}
    [linear_order β] (c : β) : fold max b f s < c ↔ b < c ∧ ∀ (x : α), x ∈ s → f x < c :=
  id (fold_op_rel_iff_and fun (x y z : β) => id max_lt_iff)

theorem lt_fold_max {α : Type u_1} {β : Type u_2} {f : α → β} {b : β} {s : finset α}
    [linear_order β] (c : β) : c < fold max b f s ↔ c < b ∨ ∃ (x : α), ∃ (H : x ∈ s), c < f x :=
  fold_op_rel_iff_or fun (x y z : β) => lt_max_iff

end Mathlib


import Mt.Reservation
import Mt.Task
import Mt.Thread

namespace SampleMutex

structure Data where
  x : Nat
  y : Nat

def Data.valid : Data -> Prop
| ⟨x, y⟩ => x = y

abbrev Reservation :=Mt.Lock Data

structure State where
  data : Data
  locked : Bool

inductive validate : Reservation -> State -> Prop where
| unlocked {data : Data} : data.valid → validate Mt.Lock.Unlocked ⟨data, false⟩
| locked (data : Data) : validate (Mt.Lock.Locked data) ⟨data, true⟩

def spec : Mt.Spec :={
  State
  Reservation
  validate
}

open Mt
open Mt.TaskM

def thread1 : Thread spec :=mk_thread do
  -- lock mutex
  atomic_blocking_rmr (λ ⟨_, locked⟩ => locked = false) λ (s : State) => ⟨⟨⟩, {s with locked :=true}⟩

  -- two atomic modifications, one after the other
  atomic_read_modify λ s => {s with data :={s.data with x :=s.data.x + 1}}
  atomic_read_modify λ s => {s with data :={s.data with y :=s.data.y + 1}}

  -- release mutex
  atomic_read_modify λ s => {s with locked :=false}

def thread2 : Thread spec :=mk_thread do
  -- lock mutex
  atomic_blocking_rmr (λ ⟨_, locked⟩ => locked = false) λ (s : State) => ⟨⟨⟩, {s with locked :=true}⟩

  -- two atomic reads, one after the other
  let px <- atomic_read λ s => s.data.x
  let py <- atomic_read λ s => s.data.y

  atomic_assert λ _ => px = py

  -- release mutex
  atomic_read_modify λ s => {s with locked :=false}

theorem validate.elim_unlocked {r s} :
  validate r s → s.locked = false → r = Lock.Unlocked ∧ s.data.valid :=by
  intro is_valid is_unlocked
  cases is_valid
  . constructor
    . rfl
    . assumption
  . contradiction

theorem validate.elim_locked {env_r : Reservation} {d s'} :
  validate (env_r + Lock.Locked d) s' →
  env_r = Lock.Unlocked ∧ d = s'.data ∧ s'.locked = true :=by
  intro initial_valid
  cases env_r <;> cases initial_valid
  constructor
  . rfl
  constructor <;> rfl

theorem valid_bind_mutex_lock {T : Type} {cont : TaskM spec T} {assuming motive}
  (cont_valid : ∀ x : Nat, cont.valid
    (Lock.Locked ⟨x, x⟩)
    (λ _ => true)
    (motive))
  : TaskM.valid (spec :=spec) (T :=T)
    (do
      atomic_blocking_rmr
        (λ ⟨_, locked⟩ => locked = false)
        λ (s : State) => ⟨⟨⟩, {s with locked :=true}⟩
      cont
    ) Lock.Unlocked assuming motive :=by
  apply valid_bind (spec :=spec) λ ⟨⟩ r => r.is_locked_and_valid Data.valid
  . -- verify mutex lock
    apply valid_blocking_rmr
    simp only [spec, Lock.add_unlocked]
    intro env_r s is_unlocked initial_valid
    exists Lock.Locked s.data

    have is_unlocked :=of_decide_eq_true is_unlocked
    have :=initial_valid.elim_unlocked is_unlocked

    simp only [spec, this, Lock.is_locked_and_valid, and_true]
    exact validate.locked ..

  intro r ⟨⟩ is_locked_and_valid
  cases r <;> try contradiction
  rename_i data0
  let ⟨x0, _⟩ :=data0 ; clear data0
  cases is_locked_and_valid
  exact cont_valid x0

theorem valid_mutex_release {assuming data}
  (data_valid : data.valid)
  : TaskM.valid (spec :=spec) (T :=Unit)
    (atomic_read_modify λ s => {s with locked :=false})
    (Lock.Locked data)
    assuming
    (λ _ r => r = Lock.Unlocked) :=by
  apply valid_rm
  simp only [spec, Lock.add_unlocked]
  intro env_r ⟨data', locked ⟩ _ initial_valid
  exists Lock.Unlocked
  have : data = data' :=initial_valid.elim_locked.right.left

  simp only [initial_valid.elim_locked, and_true]

  apply validate.unlocked
  rw [<- this]
  exact data_valid

theorem thread1_valid : thread1.valid :=by
  rw [Thread.valid]
  apply valid_bind_mutex_lock

  intro x0
  apply valid_bind (spec :=spec) λ ⟨⟩ r' => r' = Lock.Locked ⟨x0 + 1, x0⟩
  . -- validate ++x
    apply valid_rm
    simp only [spec]
    intro env_r ⟨⟨x, y⟩, locked⟩ ⟨⟩ initial_valid
    exists Lock.Locked ⟨x0 + 1, x0⟩

    simp only [initial_valid.elim_locked, Lock.unlocked_add]
    injection initial_valid.elim_locked.right.left
    rename_i x0_def y0_def
    simp only [<- x0_def, <- y0_def]
    exact ⟨validate.locked _, ⟨⟩⟩

  intro r ⟨⟩ r_def
  rw [r_def] ; clear r_def r
  apply valid_bind (spec :=spec) λ ⟨⟩ r' => r' = Lock.Locked ⟨x0 + 1, x0 + 1⟩
  . -- validate ++y
    apply valid_rm
    simp only [spec]
    intro env_r ⟨⟨x, y⟩, locked⟩ ⟨⟩ initial_valid
    exists Lock.Locked ⟨x0 + 1, x0 + 1⟩
    simp only [initial_valid.elim_locked, Lock.unlocked_add]
    injection initial_valid.elim_locked.right.left
    rename_i x0_def y0_def
    simp only [<- x0_def, <- y0_def]
    exact ⟨validate.locked _, ⟨⟩⟩

  intro r ⟨⟩ r_def
  rw [r_def]; clear r_def r
  . -- validate mutex release
    apply valid_mutex_release
    rfl

theorem thread2_valid : thread2.valid :=by
  rw [Thread.valid]
  apply valid_bind_mutex_lock

  intro x0
  apply valid_bind (spec :=spec) λ px r' => r' = Lock.Locked ⟨x0, x0⟩ ∧ px = x0
  . -- verify read of x; we should get x0
    apply valid_read
    simp only [spec]
    intro env_r ⟨⟨x, y⟩, locked⟩ ⟨⟩ initial_valid
    exists Lock.Locked ⟨x0, x0⟩
    simp only [initial_valid.elim_locked, Lock.unlocked_add]
    injection initial_valid.elim_locked.right.left
    rename_i x0_def y0_def
    simp only [<- x0_def, <- y0_def, and_true]
    exact validate.locked _

  intro r px is_locked_and_valid
  cases is_locked_and_valid ; rename_i r_def px_def
  cases r <;> try contradiction
  rename_i data0
  let ⟨x0, y0⟩ :=data0 ; clear data0
  cases r_def
  apply valid_bind (spec :=spec) λ py r' => r' = Lock.Locked ⟨x0, x0⟩ ∧ py = x0
  . -- verify read of x; we should get x0
    apply valid_read
    simp only [spec]
    intro env_r ⟨⟨x, y⟩, locked⟩ ⟨⟩ initial_valid
    exists Lock.Locked ⟨x0, x0⟩
    simp only [initial_valid.elim_locked, Lock.unlocked_add]
    injection initial_valid.elim_locked.right.left
    rename_i x0_def y0_def
    simp only [<- x0_def, <- y0_def, and_true]
    exact validate.locked _

  intro r py is_locked_and_valid
  cases is_locked_and_valid ; rename_i r_def py_def
  cases r <;> try contradiction
  rename_i data0
  let ⟨x0, y0⟩ :=data0 ; clear data0
  cases r_def
  apply valid_bind (spec :=spec) λ ⟨⟩ r' => r' = Lock.Locked ⟨x0, x0⟩
  . -- verify assertion
    apply valid_assert rfl
    intros
    rw [px_def, py_def]
    exact decide_eq_true rfl

  intro r ⟨⟩ r_def
  rw [r_def]; clear r_def r
  . -- validate mutex release
    apply valid_mutex_release
    rfl

end SampleMutex