/-
Copyright (c) 2021 Andrew Yang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Andrew Yang
-/
import category_theory.adjunction.comma
import category_theory.limits.preserves.shapes.terminal
import category_theory.structured_arrow
import category_theory.limits.shapes.equivalence

/-!
# Limits and the category of (co)cones

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

This files contains results that stem from the limit API. For the definition and the category
instance of `cone`, please refer to `category_theory/limits/cones.lean`.

## Main results
* The category of cones on `F : J ⥤ C` is equivalent to the category
  `costructured_arrow (const J) F`.
* A cone is limiting iff it is terminal in the category of cones. As a corollary, an equivalence of
  categories of cones preserves limiting properties.

-/

namespace category_theory.limits

open category_theory category_theory.functor

universes v₁ v₂ v₃ v₄ u₁ u₂ u₃ u₄

variables {J : Type u₁} [category.{v₁} J] {K : Type u₂} [category.{v₂} K]
variables {C : Type u₃} [category.{v₃} C] {D : Type u₄} [category.{v₄} D]

/-- Construct an object of the category `(Δ ↓ F)` from a cone on `F`. This is part of an
    equivalence, see `cone.equiv_costructured_arrow`. -/
@[simps]
def cone.to_costructured_arrow (F : J ⥤ C) : cone F ⥤ costructured_arrow (const J) F :=
{ obj := λ c, costructured_arrow.mk c.π,
  map := λ c d f, costructured_arrow.hom_mk f.hom $ by { ext, simp } }

/-- Construct a cone on `F` from an object of the category `(Δ ↓ F)`. This is part of an
    equivalence, see `cone.equiv_costructured_arrow`. -/
@[simps]
def cone.from_costructured_arrow (F : J ⥤ C) : costructured_arrow (const J) F ⥤ cone F :=
{ obj := λ c, ⟨c.left, c.hom⟩,
  map := λ c d f,
  { hom := f.left,
    w' := λ j, by { convert (congr_fun (congr_arg nat_trans.app f.w) j), dsimp, simp } } }

/-- The category of cones on `F` is just the comma category `(Δ ↓ F)`, where `Δ` is the constant
    functor. -/
@[simps]
def cone.equiv_costructured_arrow (F : J ⥤ C) : cone F ≌ costructured_arrow (const J) F :=
equivalence.mk (cone.to_costructured_arrow F) (cone.from_costructured_arrow F)
  (nat_iso.of_components cones.eta (by tidy))
  (nat_iso.of_components (λ c, (costructured_arrow.eta _).symm) (by tidy))

/-- A cone is a limit cone iff it is terminal. -/
def cone.is_limit_equiv_is_terminal {F : J ⥤ C} (c : cone F) : is_limit c ≃ is_terminal c :=
is_limit.iso_unique_cone_morphism.to_equiv.trans
{ to_fun := λ h, by exactI is_terminal.of_unique _,
  inv_fun := λ h s, ⟨⟨is_terminal.from h s⟩, λ a, is_terminal.hom_ext h a _⟩,
  left_inv := by tidy,
  right_inv := by tidy }

lemma has_limit_iff_has_terminal_cone (F : J ⥤ C) : has_limit F ↔ has_terminal (cone F) :=
⟨λ h, by exactI (cone.is_limit_equiv_is_terminal _ (limit.is_limit F)).has_terminal,
 λ h, ⟨⟨by exactI ⟨⊤_ _, (cone.is_limit_equiv_is_terminal _).symm terminal_is_terminal⟩⟩⟩⟩

lemma has_limits_of_shape_iff_is_left_adjoint_const :
  has_limits_of_shape J C ↔ nonempty (is_left_adjoint (const J : C ⥤ _)) :=
calc has_limits_of_shape J C
      ↔ ∀ F : J ⥤ C, has_limit F : ⟨λ h, h.has_limit, λ h, by exactI has_limits_of_shape.mk⟩
  ... ↔ ∀ F : J ⥤ C, has_terminal (cone F) : forall_congr has_limit_iff_has_terminal_cone
  ... ↔ ∀ F : J ⥤ C, has_terminal (costructured_arrow (const J) F) :
    forall_congr $ λ F, (cone.equiv_costructured_arrow F).has_terminal_iff
  ... ↔ nonempty (is_left_adjoint (const J : C ⥤ _)) :
    nonempty_is_left_adjoint_iff_has_terminal_costructured_arrow.symm

lemma is_limit.lift_cone_morphism_eq_is_terminal_from {F : J ⥤ C} {c : cone F} (hc : is_limit c)
  (s : cone F) : hc.lift_cone_morphism s =
    is_terminal.from (cone.is_limit_equiv_is_terminal _ hc) _ := rfl

lemma is_terminal.from_eq_lift_cone_morphism {F : J ⥤ C} {c : cone F} (hc : is_terminal c)
  (s : cone F) : is_terminal.from hc s =
    ((cone.is_limit_equiv_is_terminal _).symm hc).lift_cone_morphism s :=
by convert (is_limit.lift_cone_morphism_eq_is_terminal_from _ s).symm

/-- If `G : cone F ⥤ cone F'` preserves terminal objects, it preserves limit cones. -/
def is_limit.of_preserves_cone_terminal {F : J ⥤ C} {F' : K ⥤ D} (G : cone F ⥤ cone F')
  [preserves_limit (functor.empty.{0} _) G] {c : cone F} (hc : is_limit c) :
  is_limit (G.obj c) :=
(cone.is_limit_equiv_is_terminal _).symm $
  (cone.is_limit_equiv_is_terminal _ hc).is_terminal_obj _ _

/-- If `G : cone F ⥤ cone F'` reflects terminal objects, it reflects limit cones. -/
def is_limit.of_reflects_cone_terminal {F : J ⥤ C} {F' : K ⥤ D} (G : cone F ⥤ cone F')
  [reflects_limit (functor.empty.{0} _) G] {c : cone F} (hc : is_limit (G.obj c)) :
  is_limit c :=
(cone.is_limit_equiv_is_terminal _).symm $
  (cone.is_limit_equiv_is_terminal _ hc).is_terminal_of_obj _ _

/-- Construct an object of the category `(F ↓ Δ)` from a cocone on `F`. This is part of an
    equivalence, see `cocone.equiv_structured_arrow`. -/
@[simps]
def cocone.to_structured_arrow (F : J ⥤ C) : cocone F ⥤ structured_arrow F (const J) :=
{ obj := λ c, structured_arrow.mk c.ι,
  map := λ c d f, structured_arrow.hom_mk f.hom $ by { ext, simp } }

/-- Construct a cocone on `F` from an object of the category `(F ↓ Δ)`. This is part of an
    equivalence, see `cocone.equiv_structured_arrow`. -/
@[simps]
def cocone.from_structured_arrow (F : J ⥤ C) : structured_arrow F (const J) ⥤ cocone F :=
{ obj := λ c, ⟨c.right, c.hom⟩,
  map := λ c d f,
  { hom := f.right,
    w' := λ j, by { convert (congr_fun (congr_arg nat_trans.app f.w) j).symm, dsimp, simp } } }

/-- The category of cocones on `F` is just the comma category `(F ↓ Δ)`, where `Δ` is the constant
    functor. -/
@[simps]
def cocone.equiv_structured_arrow (F : J ⥤ C) : cocone F ≌ structured_arrow F (const J) :=
equivalence.mk (cocone.to_structured_arrow F) (cocone.from_structured_arrow F)
  (nat_iso.of_components cocones.eta (by tidy))
  (nat_iso.of_components (λ c, (structured_arrow.eta _).symm) (by tidy))

/-- A cocone is a colimit cocone iff it is initial. -/
def cocone.is_colimit_equiv_is_initial {F : J ⥤ C} (c : cocone F) : is_colimit c ≃ is_initial c :=
is_colimit.iso_unique_cocone_morphism.to_equiv.trans
{ to_fun := λ h, by exactI is_initial.of_unique _,
  inv_fun := λ h s, ⟨⟨is_initial.to h s⟩, λ a, is_initial.hom_ext h a _⟩,
  left_inv := by tidy,
  right_inv := by tidy }

lemma has_colimit_iff_has_initial_cocone (F : J ⥤ C) : has_colimit F ↔ has_initial (cocone F) :=
⟨λ h, by exactI (cocone.is_colimit_equiv_is_initial _ (colimit.is_colimit F)).has_initial,
 λ h, ⟨⟨by exactI ⟨⊥_ _, (cocone.is_colimit_equiv_is_initial _).symm initial_is_initial⟩⟩⟩⟩

lemma has_colimits_of_shape_iff_is_right_adjoint_const :
  has_colimits_of_shape J C ↔ nonempty (is_right_adjoint (const J : C ⥤ _)) :=
calc has_colimits_of_shape J C
      ↔ ∀ F : J ⥤ C, has_colimit F : ⟨λ h, h.has_colimit, λ h, by exactI has_colimits_of_shape.mk⟩
  ... ↔ ∀ F : J ⥤ C, has_initial (cocone F) : forall_congr has_colimit_iff_has_initial_cocone
  ... ↔ ∀ F : J ⥤ C, has_initial (structured_arrow F (const J)) :
    forall_congr $ λ F, (cocone.equiv_structured_arrow F).has_initial_iff
  ... ↔ nonempty (is_right_adjoint (const J : C ⥤ _)) :
    nonempty_is_right_adjoint_iff_has_initial_structured_arrow.symm

lemma is_colimit.desc_cocone_morphism_eq_is_initial_to {F : J ⥤ C} {c : cocone F}
  (hc : is_colimit c) (s : cocone F) :
  hc.desc_cocone_morphism s =
    is_initial.to (cocone.is_colimit_equiv_is_initial _ hc) _ := rfl

lemma is_initial.to_eq_desc_cocone_morphism {F : J ⥤ C} {c : cocone F}
  (hc : is_initial c) (s : cocone F) :
  is_initial.to hc s = ((cocone.is_colimit_equiv_is_initial _).symm hc).desc_cocone_morphism s :=
by convert (is_colimit.desc_cocone_morphism_eq_is_initial_to _ s).symm

/-- If `G : cocone F ⥤ cocone F'` preserves initial objects, it preserves colimit cocones. -/
def is_colimit.of_preserves_cocone_initial {F : J ⥤ C} {F' : K ⥤ D} (G : cocone F ⥤ cocone F')
  [preserves_colimit (functor.empty.{0} _) G] {c : cocone F} (hc : is_colimit c) :
  is_colimit (G.obj c) :=
(cocone.is_colimit_equiv_is_initial _).symm $
  (cocone.is_colimit_equiv_is_initial _ hc).is_initial_obj _ _

/-- If `G : cocone F ⥤ cocone F'` reflects initial objects, it reflects colimit cocones. -/
def is_colimit.of_reflects_cocone_initial {F : J ⥤ C} {F' : K ⥤ D} (G : cocone F ⥤ cocone F')
  [reflects_colimit (functor.empty.{0} _) G] {c : cocone F} (hc : is_colimit (G.obj c)) :
  is_colimit c :=
(cocone.is_colimit_equiv_is_initial _).symm $
  (cocone.is_colimit_equiv_is_initial _ hc).is_initial_of_obj _ _

end category_theory.limits


/-
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.linear_algebra.affine_space.affine_map
import Mathlib.algebra.invertible
import Mathlib.PostPort

universes u_1 u_2 u_3 u_4 u_5 l u_6 u_7 u_8 u_9 u_10

namespace Mathlib

/-!
# Affine equivalences

In this file we define `affine_equiv k P₁ P₂` (notation: `P₁ ≃ᵃ[k] P₂`) to be the type of affine
equivalences between `P₁` and `P₂, i.e., equivalences such that both forward and inverse maps are
affine maps.

We define the following equivalences:

* `affine_equiv.refl k P`: the identity map as an `affine_equiv`;

* `e.symm`: the inverse map of an `affine_equiv` as an `affine_equiv`;

* `e.trans e'`: composition of two `affine_equiv`s; note that the order follows `mathlib`'s
  `category_theory` convention (apply `e`, then `e'`), not the convention used in function
  composition and compositions of bundled morphisms.

## Tags

affine space, affine equivalence
-/

/-- An affine equivalence is an equivalence between affine spaces such that both forward
and inverse maps are affine.

We define it using an `equiv` for the map and a `linear_equiv` for the linear part in order
to allow affine equivalences with good definitional equalities. -/
structure affine_equiv (k : Type u_1) (P₁ : Type u_2) (P₂ : Type u_3) {V₁ : Type u_4}
    {V₂ : Type u_5} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂]
    extends P₁ ≃ P₂ where
  linear : linear_equiv k V₁ V₂
  map_vadd' : ∀ (p : P₁) (v : V₁), coe_fn _to_equiv (v +ᵥ p) = coe_fn linear v +ᵥ coe_fn _to_equiv p

protected instance affine_equiv.has_coe_to_fun (k : Type u_1) {V1 : Type u_2} (P1 : Type u_3)
    {V2 : Type u_4} (P2 : Type u_5) [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1]
    [add_comm_group V2] [module k V2] [add_torsor V2 P2] : has_coe_to_fun (affine_equiv k P1 P2) :=
  has_coe_to_fun.mk (fun (e : affine_equiv k P1 P2) => P1 → P2)
    fun (e : affine_equiv k P1 P2) => equiv.to_fun (affine_equiv.to_equiv e)

namespace linear_equiv

/-- Interpret a linear equivalence between modules as an affine equivalence. -/
def to_affine_equiv {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} [ring k] [add_comm_group V₁]
    [semimodule k V₁] [add_comm_group V₂] [semimodule k V₂] (e : linear_equiv k V₁ V₂) :
    affine_equiv k V₁ V₂ :=
  affine_equiv.mk (to_equiv e) e sorry

@[simp] theorem coe_to_affine_equiv {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} [ring k]
    [add_comm_group V₁] [semimodule k V₁] [add_comm_group V₂] [semimodule k V₂]
    (e : linear_equiv k V₁ V₂) : ⇑(to_affine_equiv e) = ⇑e :=
  rfl

end linear_equiv

namespace affine_equiv

/-- Identity map as an `affine_equiv`. -/
def refl (k : Type u_1) {V₁ : Type u_2} (P₁ : Type u_6) [ring k] [add_comm_group V₁]
    [semimodule k V₁] [add_torsor V₁ P₁] : affine_equiv k P₁ P₁ :=
  mk (equiv.refl P₁) (linear_equiv.refl k V₁) sorry

@[simp] theorem coe_refl (k : Type u_1) {V₁ : Type u_2} (P₁ : Type u_6) [ring k] [add_comm_group V₁]
    [semimodule k V₁] [add_torsor V₁ P₁] : ⇑(refl k P₁) = id :=
  rfl

theorem refl_apply (k : Type u_1) {V₁ : Type u_2} (P₁ : Type u_6) [ring k] [add_comm_group V₁]
    [semimodule k V₁] [add_torsor V₁ P₁] (x : P₁) : coe_fn (refl k P₁) x = x :=
  rfl

@[simp] theorem to_equiv_refl (k : Type u_1) {V₁ : Type u_2} (P₁ : Type u_6) [ring k]
    [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] :
    to_equiv (refl k P₁) = equiv.refl P₁ :=
  rfl

@[simp] theorem linear_refl (k : Type u_1) {V₁ : Type u_2} (P₁ : Type u_6) [ring k]
    [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] :
    linear (refl k P₁) = linear_equiv.refl k V₁ :=
  rfl

@[simp] theorem map_vadd {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) (p : P₁)
    (v : V₁) : coe_fn e (v +ᵥ p) = coe_fn (linear e) v +ᵥ coe_fn e p :=
  map_vadd' e p v

@[simp] theorem coe_to_equiv {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) :
    ⇑(to_equiv e) = ⇑e :=
  rfl

/-- Reinterpret an `affine_equiv` as an `affine_map`. -/
def to_affine_map {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6} {P₂ : Type u_7}
    [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂]
    [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) : affine_map k P₁ P₂ :=
  affine_map.mk (⇑e) (↑(linear e)) (map_vadd' e)

@[simp] theorem coe_to_affine_map {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) :
    ⇑(to_affine_map e) = ⇑e :=
  rfl

@[simp] theorem to_affine_map_mk {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (f : P₁ ≃ P₂)
    (f' : linear_equiv k V₁ V₂)
    (h : ∀ (p : P₁) (v : V₁), coe_fn f (v +ᵥ p) = coe_fn f' v +ᵥ coe_fn f p) :
    to_affine_map (mk f f' h) = affine_map.mk (⇑f) (↑f') h :=
  rfl

@[simp] theorem linear_to_affine_map {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) :
    affine_map.linear (to_affine_map e) = ↑(linear e) :=
  rfl

theorem injective_to_affine_map {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] : function.injective to_affine_map :=
  sorry

@[simp] theorem to_affine_map_inj {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] {e : affine_equiv k P₁ P₂}
    {e' : affine_equiv k P₁ P₂} : to_affine_map e = to_affine_map e' ↔ e = e' :=
  function.injective.eq_iff injective_to_affine_map

theorem ext {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6} {P₂ : Type u_7} [ring k]
    [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂]
    [add_torsor V₂ P₂] {e : affine_equiv k P₁ P₂} {e' : affine_equiv k P₁ P₂}
    (h : ∀ (x : P₁), coe_fn e x = coe_fn e' x) : e = e' :=
  injective_to_affine_map (affine_map.ext h)

theorem injective_coe_fn {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] :
    function.injective fun (e : affine_equiv k P₁ P₂) (x : P₁) => coe_fn e x :=
  sorry

@[simp] theorem coe_fn_inj {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] {e : affine_equiv k P₁ P₂}
    {e' : affine_equiv k P₁ P₂} : ⇑e = ⇑e' ↔ e = e' :=
  function.injective.eq_iff injective_coe_fn

theorem injective_to_equiv {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] : function.injective to_equiv :=
  fun (e e' : affine_equiv k P₁ P₂) (H : to_equiv e = to_equiv e') => ext (iff.mp equiv.ext_iff H)

@[simp] theorem to_equiv_inj {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] {e : affine_equiv k P₁ P₂}
    {e' : affine_equiv k P₁ P₂} : to_equiv e = to_equiv e' ↔ e = e' :=
  function.injective.eq_iff injective_to_equiv

/-- Construct an affine equivalence by verifying the relation between the map and its linear part at
one base point. Namely, this function takes an equivalence `e : P₁ ≃ P₂`, a linear equivalece
`e' : V₁ ≃ₗ[k] V₂`, and a point `p` such that for any other point `p'` we have
`e p' = e' (p' -ᵥ p) +ᵥ e p`. -/
def mk' {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6} {P₂ : Type u_7} [ring k]
    [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂]
    [add_torsor V₂ P₂] (e : P₁ ≃ P₂) (e' : linear_equiv k V₁ V₂) (p : P₁)
    (h : ∀ (p' : P₁), coe_fn e p' = coe_fn e' (p' -ᵥ p) +ᵥ coe_fn e p) : affine_equiv k P₁ P₂ :=
  mk e e' sorry

@[simp] theorem coe_mk' {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : P₁ ≃ P₂)
    (e' : linear_equiv k V₁ V₂) (p : P₁)
    (h : ∀ (p' : P₁), coe_fn e p' = coe_fn e' (p' -ᵥ p) +ᵥ coe_fn e p) : ⇑(mk' e e' p h) = ⇑e :=
  rfl

@[simp] theorem to_equiv_mk' {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : P₁ ≃ P₂)
    (e' : linear_equiv k V₁ V₂) (p : P₁)
    (h : ∀ (p' : P₁), coe_fn e p' = coe_fn e' (p' -ᵥ p) +ᵥ coe_fn e p) :
    to_equiv (mk' e e' p h) = e :=
  rfl

@[simp] theorem linear_mk' {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : P₁ ≃ P₂)
    (e' : linear_equiv k V₁ V₂) (p : P₁)
    (h : ∀ (p' : P₁), coe_fn e p' = coe_fn e' (p' -ᵥ p) +ᵥ coe_fn e p) :
    linear (mk' e e' p h) = e' :=
  rfl

/-- Inverse of an affine equivalence as an affine equivalence. -/
def symm {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6} {P₂ : Type u_7} [ring k]
    [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂]
    [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) : affine_equiv k P₂ P₁ :=
  mk (equiv.symm (to_equiv e)) (linear_equiv.symm (linear e)) sorry

@[simp] theorem symm_to_equiv {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) :
    equiv.symm (to_equiv e) = to_equiv (symm e) :=
  rfl

@[simp] theorem symm_linear {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) :
    linear_equiv.symm (linear e) = linear (symm e) :=
  rfl

protected theorem bijective {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) :
    function.bijective ⇑e :=
  equiv.bijective (to_equiv e)

protected theorem surjective {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) :
    function.surjective ⇑e :=
  equiv.surjective (to_equiv e)

protected theorem injective {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) :
    function.injective ⇑e :=
  equiv.injective (to_equiv e)

@[simp] theorem range_eq {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) :
    set.range ⇑e = set.univ :=
  function.surjective.range_eq (affine_equiv.surjective e)

@[simp] theorem apply_symm_apply {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) (p : P₂) :
    coe_fn e (coe_fn (symm e) p) = p :=
  equiv.apply_symm_apply (to_equiv e) p

@[simp] theorem symm_apply_apply {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) (p : P₁) :
    coe_fn (symm e) (coe_fn e p) = p :=
  equiv.symm_apply_apply (to_equiv e) p

theorem apply_eq_iff_eq_symm_apply {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) {p₁ : P₁}
    {p₂ : P₂} : coe_fn e p₁ = p₂ ↔ p₁ = coe_fn (symm e) p₂ :=
  equiv.apply_eq_iff_eq_symm_apply (to_equiv e)

@[simp] theorem apply_eq_iff_eq {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) {p₁ : P₁}
    {p₂ : P₁} : coe_fn e p₁ = coe_fn e p₂ ↔ p₁ = p₂ :=
  equiv.apply_eq_iff_eq (to_equiv e)

@[simp] theorem symm_refl {k : Type u_1} {V₁ : Type u_2} {P₁ : Type u_6} [ring k]
    [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] : symm (refl k P₁) = refl k P₁ :=
  rfl

/-- Composition of two `affine_equiv`alences, applied left to right. -/
def trans {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {V₃ : Type u_4} {P₁ : Type u_6}
    {P₂ : Type u_7} {P₃ : Type u_8} [ring k] [add_comm_group V₁] [semimodule k V₁]
    [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] [add_comm_group V₃]
    [semimodule k V₃] [add_torsor V₃ P₃] (e : affine_equiv k P₁ P₂) (e' : affine_equiv k P₂ P₃) :
    affine_equiv k P₁ P₃ :=
  mk (equiv.trans (to_equiv e) (to_equiv e')) (linear_equiv.trans (linear e) (linear e')) sorry

@[simp] theorem coe_trans {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {V₃ : Type u_4}
    {P₁ : Type u_6} {P₂ : Type u_7} {P₃ : Type u_8} [ring k] [add_comm_group V₁] [semimodule k V₁]
    [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] [add_comm_group V₃]
    [semimodule k V₃] [add_torsor V₃ P₃] (e : affine_equiv k P₁ P₂) (e' : affine_equiv k P₂ P₃) :
    ⇑(trans e e') = ⇑e' ∘ ⇑e :=
  rfl

theorem trans_apply {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {V₃ : Type u_4} {P₁ : Type u_6}
    {P₂ : Type u_7} {P₃ : Type u_8} [ring k] [add_comm_group V₁] [semimodule k V₁]
    [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] [add_comm_group V₃]
    [semimodule k V₃] [add_torsor V₃ P₃] (e : affine_equiv k P₁ P₂) (e' : affine_equiv k P₂ P₃)
    (p : P₁) : coe_fn (trans e e') p = coe_fn e' (coe_fn e p) :=
  rfl

theorem trans_assoc {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {V₃ : Type u_4} {V₄ : Type u_5}
    {P₁ : Type u_6} {P₂ : Type u_7} {P₃ : Type u_8} {P₄ : Type u_9} [ring k] [add_comm_group V₁]
    [semimodule k V₁] [add_torsor V₁ P₁] [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂]
    [add_comm_group V₃] [semimodule k V₃] [add_torsor V₃ P₃] [add_comm_group V₄] [semimodule k V₄]
    [add_torsor V₄ P₄] (e₁ : affine_equiv k P₁ P₂) (e₂ : affine_equiv k P₂ P₃)
    (e₃ : affine_equiv k P₃ P₄) : trans (trans e₁ e₂) e₃ = trans e₁ (trans e₂ e₃) :=
  ext fun (_x : P₁) => rfl

@[simp] theorem trans_refl {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) :
    trans e (refl k P₂) = e :=
  ext fun (_x : P₁) => rfl

@[simp] theorem refl_trans {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) :
    trans (refl k P₁) e = e :=
  ext fun (_x : P₁) => rfl

@[simp] theorem trans_symm {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) :
    trans e (symm e) = refl k P₁ :=
  ext (symm_apply_apply e)

@[simp] theorem symm_trans {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) :
    trans (symm e) e = refl k P₂ :=
  ext (apply_symm_apply e)

@[simp] theorem apply_line_map {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} {P₁ : Type u_6}
    {P₂ : Type u_7} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    [add_comm_group V₂] [semimodule k V₂] [add_torsor V₂ P₂] (e : affine_equiv k P₁ P₂) (a : P₁)
    (b : P₁) (c : k) :
    coe_fn e (coe_fn (affine_map.line_map a b) c) =
        coe_fn (affine_map.line_map (coe_fn e a) (coe_fn e b)) c :=
  affine_map.apply_line_map (to_affine_map e) a b c

protected instance group {k : Type u_1} {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁]
    [semimodule k V₁] [add_torsor V₁ P₁] : group (affine_equiv k P₁ P₁) :=
  group.mk (fun (e e' : affine_equiv k P₁ P₁) => trans e' e) sorry (refl k P₁) trans_refl refl_trans
    symm
    (div_inv_monoid.div._default (fun (e e' : affine_equiv k P₁ P₁) => trans e' e) sorry (refl k P₁)
      trans_refl refl_trans symm)
    trans_symm

theorem one_def {k : Type u_1} {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁]
    [semimodule k V₁] [add_torsor V₁ P₁] : 1 = refl k P₁ :=
  rfl

@[simp] theorem coe_one {k : Type u_1} {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁]
    [semimodule k V₁] [add_torsor V₁ P₁] : ⇑1 = id :=
  rfl

theorem mul_def {k : Type u_1} {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁]
    [semimodule k V₁] [add_torsor V₁ P₁] (e : affine_equiv k P₁ P₁) (e' : affine_equiv k P₁ P₁) :
    e * e' = trans e' e :=
  rfl

@[simp] theorem coe_mul {k : Type u_1} {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁]
    [semimodule k V₁] [add_torsor V₁ P₁] (e : affine_equiv k P₁ P₁) (e' : affine_equiv k P₁ P₁) :
    ⇑(e * e') = ⇑e ∘ ⇑e' :=
  rfl

theorem inv_def {k : Type u_1} {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁]
    [semimodule k V₁] [add_torsor V₁ P₁] (e : affine_equiv k P₁ P₁) : e⁻¹ = symm e :=
  rfl

/-- The map `v ↦ v +ᵥ b` as an affine equivalence between a module `V` and an affine space `P` with
tangent space `V`. -/
def vadd_const (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁]
    [semimodule k V₁] [add_torsor V₁ P₁] (b : P₁) : affine_equiv k V₁ P₁ :=
  mk (equiv.vadd_const b) (linear_equiv.refl k V₁) sorry

@[simp] theorem linear_vadd_const (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k]
    [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (b : P₁) :
    linear (vadd_const k b) = linear_equiv.refl k V₁ :=
  rfl

@[simp] theorem vadd_const_apply (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k]
    [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (b : P₁) (v : V₁) :
    coe_fn (vadd_const k b) v = v +ᵥ b :=
  rfl

@[simp] theorem vadd_const_symm_apply (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k]
    [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (b : P₁) (p : P₁) :
    coe_fn (symm (vadd_const k b)) p = p -ᵥ b :=
  rfl

/-- `p' ↦ p -ᵥ p'` as an equivalence. -/
def const_vsub (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁]
    [semimodule k V₁] [add_torsor V₁ P₁] (p : P₁) : affine_equiv k P₁ V₁ :=
  mk (equiv.const_vsub p) (linear_equiv.neg k) sorry

@[simp] theorem coe_const_vsub (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k]
    [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (p : P₁) :
    ⇑(const_vsub k p) = has_vsub.vsub p :=
  rfl

@[simp] theorem coe_const_vsub_symm (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k]
    [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (p : P₁) :
    ⇑(symm (const_vsub k p)) = fun (v : V₁) => -v +ᵥ p :=
  rfl

/-- The map `p ↦ v +ᵥ p` as an affine automorphism of an affine space. -/
def const_vadd (k : Type u_1) {V₁ : Type u_2} (P₁ : Type u_6) [ring k] [add_comm_group V₁]
    [semimodule k V₁] [add_torsor V₁ P₁] (v : V₁) : affine_equiv k P₁ P₁ :=
  mk (equiv.const_vadd P₁ v) (linear_equiv.refl k V₁) sorry

@[simp] theorem linear_const_vadd (k : Type u_1) {V₁ : Type u_2} (P₁ : Type u_6) [ring k]
    [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (v : V₁) :
    linear (const_vadd k P₁ v) = linear_equiv.refl k V₁ :=
  rfl

@[simp] theorem const_vadd_apply (k : Type u_1) {V₁ : Type u_2} (P₁ : Type u_6) [ring k]
    [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (v : V₁) (p : P₁) :
    coe_fn (const_vadd k P₁ v) p = v +ᵥ p :=
  rfl

@[simp] theorem const_vadd_symm_apply (k : Type u_1) {V₁ : Type u_2} (P₁ : Type u_6) [ring k]
    [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (v : V₁) (p : P₁) :
    coe_fn (symm (const_vadd k P₁ v)) p = -v +ᵥ p :=
  rfl

/-- Point reflection in `x` as a permutation. -/
def point_reflection (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁]
    [semimodule k V₁] [add_torsor V₁ P₁] (x : P₁) : affine_equiv k P₁ P₁ :=
  trans (const_vsub k x) (vadd_const k x)

theorem point_reflection_apply (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k]
    [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (x : P₁) (y : P₁) :
    coe_fn (point_reflection k x) y = x -ᵥ y +ᵥ x :=
  rfl

@[simp] theorem point_reflection_symm (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k]
    [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (x : P₁) :
    symm (point_reflection k x) = point_reflection k x :=
  injective_to_equiv (equiv.point_reflection_symm x)

@[simp] theorem to_equiv_point_reflection (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k]
    [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (x : P₁) :
    to_equiv (point_reflection k x) = equiv.point_reflection x :=
  rfl

@[simp] theorem point_reflection_self (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k]
    [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (x : P₁) :
    coe_fn (point_reflection k x) x = x :=
  vsub_vadd x x

theorem point_reflection_involutive (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k]
    [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] (x : P₁) :
    function.involutive ⇑(point_reflection k x) :=
  equiv.point_reflection_involutive x

/-- `x` is the only fixed point of `point_reflection x`. This lemma requires
`x + x = y + y ↔ x = y`. There is no typeclass to use here, so we add it as an explicit argument. -/
theorem point_reflection_fixed_iff_of_injective_bit0 (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6}
    [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] {x : P₁} {y : P₁}
    (h : function.injective bit0) : coe_fn (point_reflection k x) y = y ↔ y = x :=
  equiv.point_reflection_fixed_iff_of_injective_bit0 h

theorem injective_point_reflection_left_of_injective_bit0 (k : Type u_1) {V₁ : Type u_2}
    {P₁ : Type u_6} [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁]
    (h : function.injective bit0) (y : P₁) :
    function.injective fun (x : P₁) => coe_fn (point_reflection k x) y :=
  equiv.injective_point_reflection_left_of_injective_bit0 h y

theorem injective_point_reflection_left_of_module (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6}
    [ring k] [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [invertible (bit0 1)]
    (y : P₁) : function.injective fun (x : P₁) => coe_fn (point_reflection k x) y :=
  sorry

theorem point_reflection_fixed_iff_of_module (k : Type u_1) {V₁ : Type u_2} {P₁ : Type u_6} [ring k]
    [add_comm_group V₁] [semimodule k V₁] [add_torsor V₁ P₁] [invertible (bit0 1)] {x : P₁}
    {y : P₁} : coe_fn (point_reflection k x) y = y ↔ y = x :=
  iff.trans
    (function.injective.eq_iff' (injective_point_reflection_left_of_module k y)
      (point_reflection_self k y))
    eq_comm

end affine_equiv

namespace affine_map

theorem line_map_vadd {k : Type u_1} {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁]
    [semimodule k V₁] [add_torsor V₁ P₁] (v : V₁) (v' : V₁) (p : P₁) (c : k) :
    coe_fn (line_map v v') c +ᵥ p = coe_fn (line_map (v +ᵥ p) (v' +ᵥ p)) c :=
  affine_equiv.apply_line_map (affine_equiv.vadd_const k p) v v' c

theorem line_map_vsub {k : Type u_1} {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁]
    [semimodule k V₁] [add_torsor V₁ P₁] (p₁ : P₁) (p₂ : P₁) (p₃ : P₁) (c : k) :
    coe_fn (line_map p₁ p₂) c -ᵥ p₃ = coe_fn (line_map (p₁ -ᵥ p₃) (p₂ -ᵥ p₃)) c :=
  affine_equiv.apply_line_map (affine_equiv.symm (affine_equiv.vadd_const k p₃)) p₁ p₂ c

theorem vsub_line_map {k : Type u_1} {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁]
    [semimodule k V₁] [add_torsor V₁ P₁] (p₁ : P₁) (p₂ : P₁) (p₃ : P₁) (c : k) :
    p₁ -ᵥ coe_fn (line_map p₂ p₃) c = coe_fn (line_map (p₁ -ᵥ p₂) (p₁ -ᵥ p₃)) c :=
  affine_equiv.apply_line_map (affine_equiv.const_vsub k p₁) p₂ p₃ c

theorem vadd_line_map {k : Type u_1} {V₁ : Type u_2} {P₁ : Type u_6} [ring k] [add_comm_group V₁]
    [semimodule k V₁] [add_torsor V₁ P₁] (v : V₁) (p₁ : P₁) (p₂ : P₁) (c : k) :
    v +ᵥ coe_fn (line_map p₁ p₂) c = coe_fn (line_map (v +ᵥ p₁) (v +ᵥ p₂)) c :=
  affine_equiv.apply_line_map (affine_equiv.const_vadd k P₁ v) p₁ p₂ c

theorem homothety_neg_one_apply {V₁ : Type u_2} {P₁ : Type u_6} [add_comm_group V₁]
    [add_torsor V₁ P₁] {R' : Type u_10} [comm_ring R'] [semimodule R' V₁] (c : P₁) (p : P₁) :
    coe_fn (homothety c (-1)) p = coe_fn (affine_equiv.point_reflection R' c) p :=
  sorry

end Mathlib


syntax "foo" : tactic

macro_rules | `(tactic| foo) => `(tactic| assumption)
macro_rules | `(tactic| foo) => `(tactic| apply Nat.pred_lt; assumption)
macro_rules | `(tactic| foo) => `(tactic| contradiction)

example (i : Nat) (h : i - 1 < i) : i - 1 < i := by
  foo

example (i : Nat) (h : i ≠ 0) : i - 1 < i := by
  foo

example (i : Nat) (h : False) : i - 1 < i := by
  foo


/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Adam Topaz, Scott Morrison
-/
import category_theory.comma
import category_theory.punit
import category_theory.limits.shapes.terminal

/-!
# The category of "structured arrows"

For `T : C ⥤ D`, a `T`-structured arrow with source `S : D`
is just a morphism `S ⟶ T.obj Y`, for some `Y : D`.

These form a category with morphisms `g : Y ⟶ Y'` making the obvious diagram commute.

We prove that `𝟙 (T.obj Y)` is the initial object in `T`-structured objects with source `T.obj Y`.
-/

namespace category_theory

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

/--
The category of `T`-structured arrows with domain `S : D` (here `T : C ⥤ D`),
has as its objects `D`-morphisms of the form `S ⟶ T Y`, for some `Y : C`,
and morphisms `C`-morphisms `Y ⟶ Y'` making the obvious triangle commute.
-/
@[derive category, nolint has_inhabited_instance]
def structured_arrow (S : D) (T : C ⥤ D) := comma (functor.from_punit S) T

namespace structured_arrow

variables {S S' S'' : D} {Y Y' : C} {T : C ⥤ D}

/-- The obvious projection functor from structured arrows. -/
def proj : structured_arrow S T ⥤ C := comma.snd _ _

/-- Construct a structured arrow from a morphism. -/
def mk (f : S ⟶ T.obj Y) : structured_arrow S T := ⟨⟨⟩, Y, f⟩

@[simp] lemma mk_left (f : S ⟶ T.obj Y) : (mk f).left = punit.star := rfl
@[simp] lemma mk_right (f : S ⟶ T.obj Y) : (mk f).right = Y := rfl
@[simp] lemma mk_hom_eq_self (f : S ⟶ T.obj Y) : (mk f).hom = f := rfl

lemma eq_mk (f : structured_arrow S T) : f = mk f.hom :=
by { cases f, congr, ext, }

/--
To construct a morphism of structured arrows,
we need a morphism of the objects underlying the target,
and to check that the triangle commutes.
-/
@[simps]
def hom_mk {f f' : structured_arrow S T} (g : f.right ⟶ f'.right) (w : f.hom ≫ T.map g = f'.hom) :
  f ⟶ f' :=
{ left := eq_to_hom (by ext),
  right := g,
  w' := by { dsimp, simpa using w.symm, }, }

/--
To construct an isomorphism of structured arrows,
we need an isomorphism of the objects underlying the target,
and to check that the triangle commutes.
-/
@[simps]
def iso_mk {f f' : structured_arrow S T} (g : f.right ≅ f'.right)
  (w : f.hom ≫ T.map g.hom = f'.hom) : f ≅ f' :=
comma.iso_mk (eq_to_iso (by ext)) g (by simpa using w.symm)

/--
A morphism between source objects `S ⟶ S'`
contravariantly induces a functor between structured arrows,
`structured_arrow S' T ⥤ structured_arrow S T`.

Ideally this would be described as a 2-functor from `D`
(promoted to a 2-category with equations as 2-morphisms)
to `Cat`.
-/
@[simps]
def map (f : S ⟶ S') : structured_arrow S' T ⥤ structured_arrow S T :=
comma.map_left _ ((functor.const _).map f)

@[simp]

@[simp] lemma map_id {f : structured_arrow S T} : (map (𝟙 S)).obj f = f :=
by { rw eq_mk f, simp, }

@[simp] lemma map_comp {f : S ⟶ S'} {f' : S' ⟶ S''} {h : structured_arrow S'' T} :
  (map (f ≫ f')).obj h = (map f).obj ((map f').obj h) :=
by { rw eq_mk h, simp, }

open category_theory.limits

/-- The identity structured arrow is initial. -/
def mk_id_initial [full T] [faithful T] : is_initial (mk (𝟙 (T.obj Y))) :=
{ desc := λ c, hom_mk (T.preimage c.X.hom) (by { dsimp, simp, }),
  uniq' := begin
    rintros c m -,
    ext,
    apply T.map_injective,
    have := m.w.symm,
    dsimp at this,
    simpa using this,
  end }

end structured_arrow

/--
The category of `S`-costructured arrows with target `T : D` (here `S : C ⥤ D`),
has as its objects `D`-morphisms of the form `S Y ⟶ T`, for some `Y : C`,
and morphisms `C`-morphisms `Y ⟶ Y'` making the obvious triangle commute.
-/
@[derive category, nolint has_inhabited_instance]
def costructured_arrow (S : C ⥤ D) (T : D) := comma S (functor.from_punit T)

namespace costructured_arrow

variables {T T' T'' : D} {Y Y' : C} {S : C ⥤ D}

/-- The obviuous projection functor from costructured arrows. -/
def proj : costructured_arrow S T ⥤ C := comma.fst _ _

/-- Construct a costructured arrow from a morphism. -/
def mk (f : S.obj Y ⟶ T) : costructured_arrow S T := ⟨Y, ⟨⟩, f⟩

@[simp] lemma mk_left (f : S.obj Y ⟶ T) : (mk f).left = Y := rfl
@[simp] lemma mk_right (f : S.obj Y ⟶ T) : (mk f).right = punit.star := rfl
@[simp] lemma mk_hom_eq_self (f : S.obj Y ⟶ T) : (mk f).hom = f := rfl

lemma eq_mk (f : costructured_arrow S T) : f = mk (f.hom) :=
by { cases f, congr, ext, }

/--
To construct a morphism of costructured arrows,
we need a morphism of the objects underlying the source,
and to check that the triangle commutes.
-/
@[simps]
def hom_mk {f f' : costructured_arrow S T} (g : f.left ⟶ f'.left) (w : S.map g ≫ f'.hom = f.hom) :
  f ⟶ f' :=
{ left := g,
  right := eq_to_hom (by ext),
  w' := by simpa using w, }

/--
To construct an isomorphism of costructured arrows,
we need an isomorphism of the objects underlying the source,
and to check that the triangle commutes.
-/
@[simps]
def iso_mk {f f' : costructured_arrow S T} (g : f.left ≅ f'.left)
  (w : S.map g.hom ≫ f'.hom = f.hom) : f ≅ f' :=
comma.iso_mk g (eq_to_iso (by ext)) (by simpa using w)

/--
A morphism between target objects `T ⟶ T'`
covariantly induces a functor between costructured arrows,
`costructured_arrow S T ⥤ costructured_arrow S T'`.

Ideally this would be described as a 2-functor from `D`
(promoted to a 2-category with equations as 2-morphisms)
to `Cat`.
-/
@[simps]
def map (f : T ⟶ T') : costructured_arrow S T ⥤ costructured_arrow S T' :=
comma.map_right _ ((functor.const _).map f)

@[simp] lemma map_mk {f : S.obj Y ⟶ T} (g : T ⟶ T') :
  (map g).obj (mk f) = mk (f ≫ g) := rfl

@[simp] lemma map_id {f : costructured_arrow S T} : (map (𝟙 T)).obj f = f :=
by { rw eq_mk f, simp, }

@[simp] lemma map_comp {f : T ⟶ T'} {f' : T' ⟶ T''} {h : costructured_arrow S T} :
  (map (f ≫ f')).obj h = (map f').obj ((map f).obj h) :=
by { rw eq_mk h, simp, }

open category_theory.limits

/-- The identity costructured arrow is terminal. -/
def mk_id_terminal [full S] [faithful S] : is_terminal (mk (𝟙 (S.obj Y))) :=
{ lift := λ c, hom_mk (S.preimage c.X.hom) (by { dsimp, simp, }),
  uniq' := begin
    rintros c m -,
    ext,
    apply S.map_injective,
    have := m.w,
    dsimp at this,
    simpa using this,
  end }

end costructured_arrow

end category_theory


/-
Copyright (c) 2017 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon
-/
import algebra.group.defs
import control.functor

/-!
# `applicative` instances

This file provides `applicative` instances for concrete functors:
* `id`
* `functor.comp`
* `functor.const`
* `functor.add_const`
-/

universes u v w

section lemmas

open function

variables {F : Type u → Type v}
variables [applicative F] [is_lawful_applicative F]
variables {α β γ σ : Type u}

lemma applicative.map_seq_map (f : α → β → γ) (g : σ → β) (x : F α) (y : F σ) :
  (f <$> x) <*> (g <$> y) = (flip (∘) g ∘ f) <$> x <*> y :=
by simp [flip] with functor_norm

lemma applicative.pure_seq_eq_map' (f : α → β) : (<*>) (pure f : F (α → β)) = (<$>) f :=
by ext; simp with functor_norm

theorem applicative.ext {F} : ∀ {A1 : applicative F} {A2 : applicative F}
  [@is_lawful_applicative F A1] [@is_lawful_applicative F A2]
  (H1 : ∀ {α : Type u} (x : α),
    @has_pure.pure _ A1.to_has_pure _ x = @has_pure.pure _ A2.to_has_pure _ x)
  (H2 : ∀ {α β : Type u} (f : F (α → β)) (x : F α),
    @has_seq.seq _ A1.to_has_seq _ _ f x = @has_seq.seq _ A2.to_has_seq _ _ f x),
  A1 = A2
| {to_functor := F1, seq := s1, pure := p1, seq_left := sl1, seq_right := sr1}
  {to_functor := F2, seq := s2, pure := p2, seq_left := sl2, seq_right := sr2} L1 L2 H1 H2 :=
begin
  have : @p1 = @p2, {funext α x, apply H1}, subst this,
  have : @s1 = @s2, {funext α β f x, apply H2}, subst this,
  cases L1, cases L2,
  have : F1 = F2,
  { resetI, apply functor.ext, intros,
    exact (L1_pure_seq_eq_map _ _).symm.trans (L2_pure_seq_eq_map _ _) },
  subst this,
  congr; funext α β x y,
  { exact (L1_seq_left_eq _ _).trans (L2_seq_left_eq _ _).symm },
  { exact (L1_seq_right_eq _ _).trans (L2_seq_right_eq _ _).symm }
end

end lemmas

instance : is_comm_applicative id :=
by refine { .. }; intros; refl

namespace functor
namespace comp

open function (hiding comp)
open functor

variables {F : Type u → Type w} {G : Type v → Type u}

variables [applicative F] [applicative G]

variables [is_lawful_applicative F] [is_lawful_applicative G]
variables {α β γ : Type v}

lemma map_pure (f : α → β) (x : α) : (f <$> pure x : comp F G β) = pure (f x) :=
comp.ext $ by simp

lemma seq_pure (f : comp F G (α → β)) (x : α) :
  f <*> pure x = (λ g : α → β, g x) <$> f :=
comp.ext $ by simp [(∘)] with functor_norm

lemma pure_seq_eq_map (f : α → β) (x : comp F G α) :
  pure f <*> x = f <$> x :=
comp.ext $ by simp [applicative.pure_seq_eq_map'] with functor_norm

instance : is_lawful_applicative (comp F G) :=
{ pure_seq_eq_map := @comp.pure_seq_eq_map F G _ _ _ _,
  map_pure := @comp.map_pure F G _ _ _ _,
  seq_pure := @comp.seq_pure F G _ _ _ _,
  seq_assoc := @comp.seq_assoc F G _ _ _ _ }

theorem applicative_id_comp {F} [AF : applicative F] [LF : is_lawful_applicative F] :
  @comp.applicative id F _ _ = AF :=
@applicative.ext F _ _ (@comp.is_lawful_applicative id F _ _ _ _) _
  (λ α x, rfl) (λ α β f x, rfl)

theorem applicative_comp_id {F} [AF : applicative F] [LF : is_lawful_applicative F] :
  @comp.applicative F id _ _ = AF :=
@applicative.ext F _ _ (@comp.is_lawful_applicative F id _ _ _ _) _
  (λ α x, rfl) (λ α β f x, show id <$> f <*> x = f <*> x, by rw id_map)

open is_comm_applicative

instance {f : Type u → Type w} {g : Type v → Type u}
  [applicative f] [applicative g]
  [is_comm_applicative f] [is_comm_applicative g] :
  is_comm_applicative (comp f g) :=
by { refine { .. @comp.is_lawful_applicative f g _ _ _ _, .. },
     intros, casesm* comp _ _ _, simp! [map,has_seq.seq] with functor_norm,
     rw [commutative_map],
     simp [comp.mk,flip,(∘)] with functor_norm,
     congr, funext, rw [commutative_map], congr }

end comp
end functor

open functor

@[functor_norm]
lemma comp.seq_mk {α β : Type w}
  {f : Type u → Type v} {g : Type w → Type u}
  [applicative f] [applicative g]
  (h : f (g (α → β))) (x : f (g α)) :
  comp.mk h <*> comp.mk x = comp.mk (has_seq.seq <$> h <*> x) := rfl

instance {α} [has_one α] [has_mul α] : applicative (const α) :=
{ pure := λ β x, (1 : α),
  seq := λ β γ f x, (f * x : α) }

instance {α} [monoid α] : is_lawful_applicative (const α) :=
by refine { .. }; intros; simp [mul_assoc, (<$>), (<*>), pure]

instance {α} [has_zero α] [has_add α] : applicative (add_const α) :=
{ pure := λ β x, (0 : α),
  seq := λ β γ f x, (f + x : α) }

instance {α} [add_monoid α] : is_lawful_applicative (add_const α) :=
by refine { .. }; intros; simp [add_assoc, (<$>), (<*>), pure]


import Lean
import Lean.Data.Json.Basic
import Lean.Data.Json.FromToJson
import LeanCodePrompts.ParseJson
import LeanCodePrompts.Utils
import LeanCodePrompts.TeXPrompts

open Lean

initialize texCommandCache : IO.Ref (HashMap String String) ← do
  -- IO.println "Initialising TeX Command cache..."
  -- let js ← Json.parseFile <| ← reroutePath "data/texcmds.json"
  -- let l := js.map $ fun j => (j[0]!.getStr!, j[1]!.getStr!)
  let .obj js ← IO.ofExcept $ Json.parse $ ← IO.FS.readFile (← reroutePath "data/full-tex.json") | panic! "Invalid JSON format"
  let l : List (String × String) := js.fold (λ as s j => (s, j.getStr!) :: as) []
  IO.mkRef $ HashMap.ofList l

/-- Replaces the TeX sequences in a string with their
  corresponding Unicode characters using the `texcmds` list. -/
def teXToUnicode (s : String) : IO String := do
  match s.splitOn "\\" with
  | [] => return s
  | h :: ls =>
    -- filtering instances of `\\\\`
    let ls' := ls.filter (· != "")
    let us ← ls'.mapM $ fun l => do
      let cmd := l.takeWhile (· ∉ teXDelimiters)
      let s ← findUnicodeReplacement cmd
      pure $ s ++ l.dropWhile (· ∉ teXDelimiters)

    return .join (h :: us)

  where
    findUnicodeReplacement (cmd : String) : IO String := do
      if let .some u :=
          (← texCommandCache.get).find? cmd then
        pure u else
        pure <| "\\" ++ cmd

    teXDelimiters := [' ', '_', '^', '{', '}', '[', ']', '(', ')']

namespace List

def alternate : List α → List α × List α
  | [] => ([], [])
  | a :: as =>
    match alternate as with
      | (odds, evens) => (a :: evens, odds)

def interleave : List α → List α → List α
  | [], bs => bs
  | as, [] => as
  | a :: as, b :: bs =>
    a :: b :: interleave as bs

theorem alternate_interleave : (l : List α) →
  let (odds, evens) := l.alternate
  .interleave odds evens = l
  | [] => rfl
  | [a] => rfl
  | a :: a' :: as => by
    dsimp only [alternate, interleave]
    congr
    apply alternate_interleave

#eval [1, 2, 3, 4, 5, 6].alternate

end List

def openAIKey : IO (Option String) := IO.getEnv "OPENAI_API_KEY"

/-- Query open-ai with given prompt and parameters -/
-- this is delibrately different from the one in `Translate.lean`
-- this is to keep everything at the `IO` level without disturbing the rest of the code
def openAIQuery (prompt : String)
  (n : Nat := 1)
  (temp : JsonNumber := ⟨2, 1⟩)
  (stopTokens : Array String :=  #[":=", "-/"]) : IO Json := do

  let .some key ← openAIKey | panic! "OPENAI_API_KEY not set"

  let data := Json.mkObj [
    ("model", "code-davinci-002"),
    ("prompt", prompt),
    ("temperature", Json.num temp),
    ("n", n),
    ("max_tokens", 150),
    ("stop", Json.arr <| stopTokens |>.map Json.str)
    ] |>.pretty

  let out ←  IO.Process.output {
        cmd:= "curl",
        args:= #["https://api.openai.com/v1/completions",
        "-X", "POST",
        "-H", "Authorization: Bearer " ++ key,
        "-H", "Content-Type: application/json",
        "--data", data]}

  IO.ofExcept $ Json.parse out.stdout

def makePrompt (formula : String) : IO String := do

  let teXPromptsProcessed ← teXPrompts.mapM $ λ (teXFormula, leanFormula) => do
        return s!"TeX: ${← teXToUnicode teXFormula}$\nLean: `{leanFormula}`\n\n"

  let promptPrefix := String.join teXPromptsProcessed.toList

  return s!"{promptPrefix}TeX: ${formula}$\nLean: `"

/-- Translates a string representing a TeX formula to the corresponding Lean code. -/
def teXToLean (s : String) : IO String := do
  let t ← teXToUnicode s
  -- needs a better heuristic for triggering Codex-based translation
  if t.contains '\\' then
    IO.println s!"Translating with Codex: {t}"
    let prompt ← makePrompt s
    let codexOutput ← openAIQuery prompt (stopTokens := #["$", "$$", "\\[", "\n"])
    let translation := codexOutput["choices"]![0]!["text"]!.getStr!
    return s!"`{translation}`"
  else
    IO.println s!"Translated via Unicode mapping: {t}"
    return s!"`{t}`"

/-- Extracts the TeX formulas within `$` or `$$` in the given string,
  translates them individually to Lean code, and then
  replaces them back with `\`` (backticks). -/
def translateTeX : String → IO String :=
  translateTeXAux "$$"
    (translateTeXAux "$"
      (translateTeXAux "`"
          pure
          pure)
      teXToLean)
    teXToLean
  where
    /-- Splits a string according to the delimiter.
        The substrings in the odd positions are processed as text,
        while those in the even positions are processed as formulas. -/
    translateTeXAux (teXDelimiter : String)
      (modText : String → IO String)
      (modFormula : String → IO String) :
          String → IO String := fun s => do
        let (text, formulas) := s.splitOn teXDelimiter |>.alternate
        let text' ← text.mapM modText
        let formulas' ← formulas.mapM modFormula
        let s' := .interleave text' formulas'
        return .join s'


/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Mario Carneiro
-/
import tactic.ext

open interactive

namespace tactic

/-
This file defines a `chain` tactic, which takes a list of tactics,
and exhaustively tries to apply them to the goals, until no tactic succeeds on any goal.

Along the way, it generates auxiliary declarations, in order to speed up elaboration time
of the resulting (sometimes long!) proofs.

This tactic is used by the `tidy` tactic.
-/

-- α is the return type of our tactics. When `chain` is called by `tidy`, this is string,
-- describing what that tactic did as an interactive tactic.
variable {α : Type}

inductive tactic_script (α : Type) : Type
| base : α → tactic_script
| work (index : ℕ) (first : α) (later : list tactic_script) (closed : bool) : tactic_script

meta def tactic_script.to_string : tactic_script string → string
| (tactic_script.base a) := a
| (tactic_script.work n a l c) :=  "work_on_goal " ++ (to_string (n+1)) ++
    " { " ++ (", ".intercalate (a :: l.map tactic_script.to_string)) ++ " }"

meta instance : has_to_string (tactic_script string) :=
{ to_string := λ s, s.to_string }

meta instance tactic_script_unit_has_to_string : has_to_string (tactic_script unit) :=
{ to_string := λ s, "[chain tactic]" }

meta def abstract_if_success (tac : expr → tactic α) (g : expr) : tactic α :=
do
  type ← infer_type g,
  is_lemma ← is_prop type,
  if is_lemma then -- there's no point making the abstraction, and indeed it's slower
    tac g
  else do
    m ← mk_meta_var type,
    a ← tac m,
    do
    { val ← instantiate_mvars m,
      guard (val.list_meta_vars = []),
      c  ← new_aux_decl_name,
      gs ← get_goals,
      set_goals [g],
      add_aux_decl c type val ff >>= unify g,
      set_goals gs }
    <|> unify m g,
    return a

/--
`chain_many tac` recursively tries `tac` on all goals, working depth-first on generated subgoals,
until it no longer succeeds on any goal. `chain_many` automatically makes auxiliary definitions.
-/
meta mutual def chain_single, chain_many, chain_iter {α} (tac : tactic α)
with chain_single : expr → tactic (α × list (tactic_script α)) | g :=
do set_goals [g],
  a ← tac,
  l ← get_goals >>= chain_many,
  return (a, l)
with chain_many : list expr → tactic (list (tactic_script α))
| [] := return []
| [g] := do
{ (a, l) ← chain_single g,
  return (tactic_script.base a :: l) } <|> return []
| gs := chain_iter gs []
with chain_iter : list expr → list expr → tactic (list (tactic_script α))
| [] _ := return []
| (g :: later_goals) stuck_goals := do
{ (a, l) ← abstract_if_success chain_single g,
  new_goals ← get_goals,
  let w := tactic_script.work stuck_goals.length a l (new_goals = []),
  let current_goals := stuck_goals.reverse ++ new_goals ++ later_goals,
  set_goals current_goals, -- we keep the goals up to date, so they are correct at the end
  l' ← chain_many current_goals,
  return (w :: l') } <|> chain_iter later_goals (g :: stuck_goals)

meta def chain_core {α : Type} [has_to_string (tactic_script α)] (tactics : list (tactic α)) :
  tactic (list string) :=
do results ← (get_goals >>= chain_many (first tactics)),
   when results.empty (fail "`chain` tactic made no progress"),
   return (results.map to_string)

variables [has_to_string (tactic_script α)] [has_to_format α]

declare_trace chain

meta def trace_output (t : tactic α) : tactic α :=
do tgt ← target,
   r ← t,
   name ← decl_name,
   trace format!"`chain` successfully applied a tactic during elaboration of {name}:",
   tgt ← pp tgt,
   trace format!"previous target: {tgt}",
   trace format!"tactic result: {r}",
   tgt ← try_core target,
   tgt ← match tgt with
          | (some tgt) := pp tgt
          | none       := return "no goals"
          end,
   trace format!"new target: {tgt}",
   pure r

meta def chain (tactics : list (tactic α)) : tactic (list string) :=
chain_core
  (if is_trace_enabled_for `chain then (tactics.map trace_output) else tactics)

end tactic


/-
Copyright (c) 2019 Minchao Wu. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Minchao Wu, Mario Carneiro
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.computability.halting
import Mathlib.PostPort

universes u_1 u_2 u_3 u v

namespace Mathlib

/-!
# Strong reducibility and degrees.

This file defines the notions of computable many-one reduction and one-one
reduction between sets, and shows that the corresponding degrees form a
semilattice.

## Notations

This file uses the local notation `⊕'` for `sum.elim` to denote the disjoint union of two degrees.

## References

* [Robert Soare, *Recursively enumerable sets and degrees*][soare1987]

## Tags

computability, reducibility, reduction
-/

/--
`p` is many-one reducible to `q` if there is a computable function translating questions about `p`
to questions about `q`.
-/
def many_one_reducible {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] (p : α → Prop) (q : β → Prop) :=
  ∃ (f : α → β), computable f ∧ ∀ (a : α), p a ↔ q (f a)

infixl:1000 " ≤₀ " => Mathlib.many_one_reducible

theorem many_one_reducible.mk {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] {f : α → β} (q : β → Prop) (h : computable f) : (fun (a : α) => q (f a)) ≤₀ q :=
  Exists.intro f { left := h, right := fun (a : α) => iff.rfl }

theorem many_one_reducible_refl {α : Type u_1} [primcodable α] (p : α → Prop) : p ≤₀ p := sorry

theorem many_one_reducible.trans {α : Type u_1} {β : Type u_2} {γ : Type u_3} [primcodable α] [primcodable β] [primcodable γ] {p : α → Prop} {q : β → Prop} {r : γ → Prop} : p ≤₀ q → q ≤₀ r → p ≤₀ r := sorry

theorem reflexive_many_one_reducible {α : Type u_1} [primcodable α] : reflexive many_one_reducible :=
  many_one_reducible_refl

theorem transitive_many_one_reducible {α : Type u_1} [primcodable α] : transitive many_one_reducible :=
  fun (p q r : α → Prop) => many_one_reducible.trans

/--
`p` is one-one reducible to `q` if there is an injective computable function translating questions
about `p` to questions about `q`.
-/
def one_one_reducible {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] (p : α → Prop) (q : β → Prop) :=
  ∃ (f : α → β), computable f ∧ function.injective f ∧ ∀ (a : α), p a ↔ q (f a)

infixl:1000 " ≤₁ " => Mathlib.one_one_reducible

theorem one_one_reducible.mk {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] {f : α → β} (q : β → Prop) (h : computable f) (i : function.injective f) : (fun (a : α) => q (f a)) ≤₁ q :=
  Exists.intro f { left := h, right := { left := i, right := fun (a : α) => iff.rfl } }

theorem one_one_reducible_refl {α : Type u_1} [primcodable α] (p : α → Prop) : p ≤₁ p := sorry

theorem one_one_reducible.trans {α : Type u_1} {β : Type u_2} {γ : Type u_3} [primcodable α] [primcodable β] [primcodable γ] {p : α → Prop} {q : β → Prop} {r : γ → Prop} : p ≤₁ q → q ≤₁ r → p ≤₁ r := sorry

theorem one_one_reducible.to_many_one {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] {p : α → Prop} {q : β → Prop} : p ≤₁ q → p ≤₀ q := sorry

theorem one_one_reducible.of_equiv {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] {e : α ≃ β} (q : β → Prop) (h : computable ⇑e) : (q ∘ ⇑e) ≤₁ q :=
  one_one_reducible.mk q h (equiv.injective e)

theorem one_one_reducible.of_equiv_symm {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] {e : α ≃ β} (q : β → Prop) (h : computable ⇑(equiv.symm e)) : q ≤₁ (q ∘ ⇑e) := sorry

theorem reflexive_one_one_reducible {α : Type u_1} [primcodable α] : reflexive one_one_reducible :=
  one_one_reducible_refl

theorem transitive_one_one_reducible {α : Type u_1} [primcodable α] : transitive one_one_reducible :=
  fun (p q r : α → Prop) => one_one_reducible.trans

namespace computable_pred

theorem computable_of_many_one_reducible {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] {p : α → Prop} {q : β → Prop} (h₁ : p ≤₀ q) (h₂ : computable_pred q) : computable_pred p := sorry

theorem computable_of_one_one_reducible {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] {p : α → Prop} {q : β → Prop} (h : p ≤₁ q) : computable_pred q → computable_pred p :=
  computable_of_many_one_reducible (one_one_reducible.to_many_one h)

end computable_pred

/-- `p` and `q` are many-one equivalent if each one is many-one reducible to the other. -/
def many_one_equiv {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] (p : α → Prop) (q : β → Prop) :=
  p ≤₀ q ∧ q ≤₀ p

/-- `p` and `q` are one-one equivalent if each one is one-one reducible to the other. -/
def one_one_equiv {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] (p : α → Prop) (q : β → Prop) :=
  p ≤₁ q ∧ q ≤₁ p

theorem many_one_equiv_refl {α : Type u_1} [primcodable α] (p : α → Prop) : many_one_equiv p p :=
  { left := many_one_reducible_refl p, right := many_one_reducible_refl p }

theorem many_one_equiv.symm {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] {p : α → Prop} {q : β → Prop} : many_one_equiv p q → many_one_equiv q p :=
  and.swap

theorem many_one_equiv.trans {α : Type u_1} {β : Type u_2} {γ : Type u_3} [primcodable α] [primcodable β] [primcodable γ] {p : α → Prop} {q : β → Prop} {r : γ → Prop} : many_one_equiv p q → many_one_equiv q r → many_one_equiv p r := sorry

theorem equivalence_of_many_one_equiv {α : Type u_1} [primcodable α] : equivalence many_one_equiv :=
  { left := many_one_equiv_refl,
    right :=
      { left := fun (x y : α → Prop) => many_one_equiv.symm, right := fun (x y z : α → Prop) => many_one_equiv.trans } }

theorem one_one_equiv_refl {α : Type u_1} [primcodable α] (p : α → Prop) : one_one_equiv p p :=
  { left := one_one_reducible_refl p, right := one_one_reducible_refl p }

theorem one_one_equiv.symm {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] {p : α → Prop} {q : β → Prop} : one_one_equiv p q → one_one_equiv q p :=
  and.swap

theorem one_one_equiv.trans {α : Type u_1} {β : Type u_2} {γ : Type u_3} [primcodable α] [primcodable β] [primcodable γ] {p : α → Prop} {q : β → Prop} {r : γ → Prop} : one_one_equiv p q → one_one_equiv q r → one_one_equiv p r := sorry

theorem equivalence_of_one_one_equiv {α : Type u_1} [primcodable α] : equivalence one_one_equiv :=
  { left := one_one_equiv_refl,
    right :=
      { left := fun (x y : α → Prop) => one_one_equiv.symm, right := fun (x y z : α → Prop) => one_one_equiv.trans } }

theorem one_one_equiv.to_many_one {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] {p : α → Prop} {q : β → Prop} : one_one_equiv p q → many_one_equiv p q := sorry

/-- a computable bijection -/
def equiv.computable {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] (e : α ≃ β) :=
  computable ⇑e ∧ computable ⇑(equiv.symm e)

theorem equiv.computable.symm {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] {e : α ≃ β} : equiv.computable e → equiv.computable (equiv.symm e) :=
  and.swap

theorem equiv.computable.trans {α : Type u_1} {β : Type u_2} {γ : Type u_3} [primcodable α] [primcodable β] [primcodable γ] {e₁ : α ≃ β} {e₂ : β ≃ γ} : equiv.computable e₁ → equiv.computable e₂ → equiv.computable (equiv.trans e₁ e₂) := sorry

theorem computable.eqv (α : Type u_1) [denumerable α] : equiv.computable (denumerable.eqv α) :=
  { left := computable.encode, right := computable.of_nat α }

theorem computable.equiv₂ (α : Type u_1) (β : Type u_2) [denumerable α] [denumerable β] : equiv.computable (denumerable.equiv₂ α β) :=
  equiv.computable.trans (computable.eqv α) (equiv.computable.symm (computable.eqv β))

theorem one_one_equiv.of_equiv {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] {e : α ≃ β} (h : equiv.computable e) {p : β → Prop} : one_one_equiv (p ∘ ⇑e) p :=
  { left := one_one_reducible.of_equiv p (and.left h), right := one_one_reducible.of_equiv_symm p (and.right h) }

theorem many_one_equiv.of_equiv {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] {e : α ≃ β} (h : equiv.computable e) {p : β → Prop} : many_one_equiv (p ∘ ⇑e) p :=
  one_one_equiv.to_many_one (one_one_equiv.of_equiv h)

theorem many_one_equiv.le_congr_left {α : Type u_1} {β : Type u_2} {γ : Type u_3} [primcodable α] [primcodable β] [primcodable γ] {p : α → Prop} {q : β → Prop} {r : γ → Prop} (h : many_one_equiv p q) : p ≤₀ r ↔ q ≤₀ r :=
  { mp := many_one_reducible.trans (and.right h), mpr := many_one_reducible.trans (and.left h) }

theorem many_one_equiv.le_congr_right {α : Type u_1} {β : Type u_2} {γ : Type u_3} [primcodable α] [primcodable β] [primcodable γ] {p : α → Prop} {q : β → Prop} {r : γ → Prop} (h : many_one_equiv q r) : p ≤₀ q ↔ p ≤₀ r :=
  { mp := fun (h' : p ≤₀ q) => many_one_reducible.trans h' (and.left h),
    mpr := fun (h' : p ≤₀ r) => many_one_reducible.trans h' (and.right h) }

theorem one_one_equiv.le_congr_left {α : Type u_1} {β : Type u_2} {γ : Type u_3} [primcodable α] [primcodable β] [primcodable γ] {p : α → Prop} {q : β → Prop} {r : γ → Prop} (h : one_one_equiv p q) : p ≤₁ r ↔ q ≤₁ r :=
  { mp := one_one_reducible.trans (and.right h), mpr := one_one_reducible.trans (and.left h) }

theorem one_one_equiv.le_congr_right {α : Type u_1} {β : Type u_2} {γ : Type u_3} [primcodable α] [primcodable β] [primcodable γ] {p : α → Prop} {q : β → Prop} {r : γ → Prop} (h : one_one_equiv q r) : p ≤₁ q ↔ p ≤₁ r :=
  { mp := fun (h' : p ≤₁ q) => one_one_reducible.trans h' (and.left h),
    mpr := fun (h' : p ≤₁ r) => one_one_reducible.trans h' (and.right h) }

theorem many_one_equiv.congr_left {α : Type u_1} {β : Type u_2} {γ : Type u_3} [primcodable α] [primcodable β] [primcodable γ] {p : α → Prop} {q : β → Prop} {r : γ → Prop} (h : many_one_equiv p q) : many_one_equiv p r ↔ many_one_equiv q r :=
  and_congr (many_one_equiv.le_congr_left h) (many_one_equiv.le_congr_right h)

theorem many_one_equiv.congr_right {α : Type u_1} {β : Type u_2} {γ : Type u_3} [primcodable α] [primcodable β] [primcodable γ] {p : α → Prop} {q : β → Prop} {r : γ → Prop} (h : many_one_equiv q r) : many_one_equiv p q ↔ many_one_equiv p r :=
  and_congr (many_one_equiv.le_congr_right h) (many_one_equiv.le_congr_left h)

theorem one_one_equiv.congr_left {α : Type u_1} {β : Type u_2} {γ : Type u_3} [primcodable α] [primcodable β] [primcodable γ] {p : α → Prop} {q : β → Prop} {r : γ → Prop} (h : one_one_equiv p q) : one_one_equiv p r ↔ one_one_equiv q r :=
  and_congr (one_one_equiv.le_congr_left h) (one_one_equiv.le_congr_right h)

theorem one_one_equiv.congr_right {α : Type u_1} {β : Type u_2} {γ : Type u_3} [primcodable α] [primcodable β] [primcodable γ] {p : α → Prop} {q : β → Prop} {r : γ → Prop} (h : one_one_equiv q r) : one_one_equiv p q ↔ one_one_equiv p r :=
  and_congr (one_one_equiv.le_congr_right h) (one_one_equiv.le_congr_left h)

@[simp] theorem ulower.down_computable {α : Type u_1} [primcodable α] : equiv.computable (ulower.equiv α) :=
  { left := primrec.to_comp primrec.ulower_down, right := primrec.to_comp primrec.ulower_up }

theorem many_one_equiv_up {α : Type u_1} [primcodable α] {p : α → Prop} : many_one_equiv (p ∘ ulower.up) p :=
  many_one_equiv.of_equiv (equiv.computable.symm ulower.down_computable)

theorem one_one_reducible.disjoin_left {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] {p : α → Prop} {q : β → Prop} : p ≤₁ sum.elim p q :=
  Exists.intro sum.inl
    { left := computable.sum_inl,
      right := { left := fun (x y : α) => iff.mp sum.inl.inj_iff, right := fun (a : α) => iff.rfl } }

theorem one_one_reducible.disjoin_right {α : Type u_1} {β : Type u_2} [primcodable α] [primcodable β] {p : α → Prop} {q : β → Prop} : q ≤₁ sum.elim p q :=
  Exists.intro sum.inr
    { left := computable.sum_inr,
      right := { left := fun (x y : β) => iff.mp sum.inr.inj_iff, right := fun (a : β) => iff.rfl } }

theorem disjoin_many_one_reducible {α : Type u_1} {β : Type u_2} {γ : Type u_3} [primcodable α] [primcodable β] [primcodable γ] {p : α → Prop} {q : β → Prop} {r : γ → Prop} : p ≤₀ r → q ≤₀ r → sum.elim p q ≤₀ r := sorry

theorem disjoin_le {α : Type u_1} {β : Type u_2} {γ : Type u_3} [primcodable α] [primcodable β] [primcodable γ] {p : α → Prop} {q : β → Prop} {r : γ → Prop} : sum.elim p q ≤₀ r ↔ p ≤₀ r ∧ q ≤₀ r := sorry

/--
Computable and injective mapping of predicates to sets of natural numbers.
-/
def to_nat {α : Type u} [primcodable α] [Inhabited α] (p : set α) : set ℕ :=
  set_of fun (n : ℕ) => p (option.get_or_else (encodable.decode α n) Inhabited.default)

@[simp] theorem to_nat_many_one_reducible {α : Type u} [primcodable α] [Inhabited α] {p : set α} : to_nat p ≤₀ p :=
  Exists.intro (fun (n : ℕ) => option.get_or_else (encodable.decode α n) Inhabited.default)
    { left := computable.option_get_or_else computable.decode (computable.const Inhabited.default),
      right := fun (_x : ℕ) => iff.rfl }

@[simp] theorem many_one_reducible_to_nat {α : Type u} [primcodable α] [Inhabited α] {p : set α} : p ≤₀ to_nat p := sorry

@[simp] theorem many_one_reducible_to_nat_to_nat {α : Type u} [primcodable α] [Inhabited α] {β : Type v} [primcodable β] [Inhabited β] {p : set α} {q : set β} : to_nat p ≤₀ to_nat q ↔ p ≤₀ q := sorry

@[simp] theorem to_nat_many_one_equiv {α : Type u} [primcodable α] [Inhabited α] {p : set α} : many_one_equiv (to_nat p) p := sorry

@[simp] theorem many_one_equiv_to_nat {α : Type u} [primcodable α] [Inhabited α] {β : Type v} [primcodable β] [Inhabited β] (p : set α) (q : set β) : many_one_equiv (to_nat p) (to_nat q) ↔ many_one_equiv p q := sorry

/-- A many-one degree is an equivalence class of sets up to many-one equivalence. -/
def many_one_degree :=
  quotient (setoid.mk many_one_equiv sorry)

namespace many_one_degree

/-- The many-one degree of a set on a primcodable type. -/
def of {α : Type u} [primcodable α] [Inhabited α] (p : α → Prop) : many_one_degree :=
  quotient.mk' (to_nat p)

protected theorem ind_on {C : many_one_degree → Prop} (d : many_one_degree) (h : ∀ (p : set ℕ), C (of p)) : C d :=
  quotient.induction_on' d h

/--
Lifts a function on sets of natural numbers to many-one degrees.
-/
protected def lift_on {φ : Sort u_1} (d : many_one_degree) (f : set ℕ → φ) (h : ∀ (p q : ℕ → Prop), many_one_equiv p q → f p = f q) : φ :=
  quotient.lift_on' d f h

@[simp] protected theorem lift_on_eq {φ : Sort u_1} (p : set ℕ) (f : set ℕ → φ) (h : ∀ (p q : ℕ → Prop), many_one_equiv p q → f p = f q) : many_one_degree.lift_on (of p) f h = f p :=
  rfl

/--
Lifts a binary function on sets of natural numbers to many-one degrees.
-/
@[simp] protected def lift_on₂ {φ : Sort u_1} (d₁ : many_one_degree) (d₂ : many_one_degree) (f : set ℕ → set ℕ → φ) (h : ∀ (p₁ p₂ q₁ q₂ : ℕ → Prop), many_one_equiv p₁ p₂ → many_one_equiv q₁ q₂ → f p₁ q₁ = f p₂ q₂) : φ :=
  many_one_degree.lift_on d₁ (fun (p : set ℕ) => many_one_degree.lift_on d₂ (f p) sorry) sorry

@[simp] protected theorem lift_on₂_eq {φ : Sort u_1} (p : set ℕ) (q : set ℕ) (f : set ℕ → set ℕ → φ) (h : ∀ (p₁ p₂ q₁ q₂ : ℕ → Prop), many_one_equiv p₁ p₂ → many_one_equiv q₁ q₂ → f p₁ q₁ = f p₂ q₂) : many_one_degree.lift_on₂ (of p) (of q) f h = f p q :=
  rfl

@[simp] theorem of_eq_of {α : Type u} [primcodable α] [Inhabited α] {β : Type v} [primcodable β] [Inhabited β] {p : α → Prop} {q : β → Prop} : of p = of q ↔ many_one_equiv p q := sorry

protected instance inhabited : Inhabited many_one_degree :=
  { default := of ∅ }

/--
For many-one degrees `d₁` and `d₂`, `d₁ ≤ d₂` if the sets in `d₁` are many-one reducible to the
sets in `d₂`.
-/
protected instance has_le : HasLessEq many_one_degree :=
  { LessEq := fun (d₁ d₂ : many_one_degree) => many_one_degree.lift_on₂ d₁ d₂ many_one_reducible sorry }

@[simp] theorem of_le_of {α : Type u} [primcodable α] [Inhabited α] {β : Type v} [primcodable β] [Inhabited β] {p : α → Prop} {q : β → Prop} : of p ≤ of q ↔ p ≤₀ q :=
  many_one_reducible_to_nat_to_nat

protected instance partial_order : partial_order many_one_degree :=
  partial_order.mk LessEq (preorder.lt._default LessEq) le_refl sorry sorry

/-- The join of two degrees, induced by the disjoint union of two underlying sets. -/
protected instance has_add : Add many_one_degree :=
  { add :=
      fun (d₁ d₂ : many_one_degree) => many_one_degree.lift_on₂ d₁ d₂ (fun (a b : set ℕ) => of (sum.elim a b)) sorry }

@[simp] theorem add_of {α : Type u} [primcodable α] [Inhabited α] {β : Type v} [primcodable β] [Inhabited β] (p : set α) (q : set β) : of (sum.elim p q) = of p + of q := sorry

@[simp] protected theorem add_le {d₁ : many_one_degree} {d₂ : many_one_degree} {d₃ : many_one_degree} : d₁ + d₂ ≤ d₃ ↔ d₁ ≤ d₃ ∧ d₂ ≤ d₃ := sorry

@[simp] protected theorem le_add_left (d₁ : many_one_degree) (d₂ : many_one_degree) : d₁ ≤ d₁ + d₂ :=
  and.left (iff.mp many_one_degree.add_le (le_refl (d₁ + d₂)))

@[simp] protected theorem le_add_right (d₁ : many_one_degree) (d₂ : many_one_degree) : d₂ ≤ d₁ + d₂ :=
  and.right (iff.mp many_one_degree.add_le (le_refl (d₁ + d₂)))

protected instance semilattice_sup : semilattice_sup many_one_degree :=
  semilattice_sup.mk Add.add partial_order.le partial_order.lt partial_order.le_refl partial_order.le_trans
    partial_order.le_antisymm many_one_degree.le_add_left many_one_degree.le_add_right sorry


/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, David Renshaw
-/
import Lean.Meta.Tactic.Apply
import Lean.Elab.Tactic.Basic
import Mathlib.Tactic.Core
import Mathlib.Lean.LocalContext
import Mathlib.Tactic.Relation.Symm
import Mathlib.Control.Basic
import Mathlib.Data.Sum.Basic
import Mathlib.Tactic.LabelAttr

/-!
A work-in-progress replacement for Lean3's `solve_by_elim` tactic.
We'll gradually bring it up to feature parity.
-/

open Lean Meta Elab Tactic

/-- Visualize an `Except` using a checkmark or a cross. -/
def exceptEmoji : Except ε α → String
  | .error _ => crossEmoji
  | .ok _ => checkEmoji

namespace Lean.MVarId

/--
`applyFirst lemmas cont goal` will try to apply one of the `lemmas` to the goal `goal`,
and then call `cont` on the resulting `List MVarId` of subgoals.

It returns the result from `cont` for the first such lemma for which
both the `apply` and the call to `cont` succeed.

``applyFirst (trace := `name)`` will construct trace nodes for ``name` indicating which
calls to `apply` succeeded or failed.
-/
-- Because the operation of this function via a continuation is fairly specific to `solve_by_elim`,
-- we keep it here rather than moving it into `Mathlib/Lean/`.
def applyFirst (cfg : ApplyConfig := {}) (transparency : TransparencyMode := .default)
    (trace : Name := .anonymous) (lemmas : List Expr) (cont : List MVarId → MetaM α)
    (g : MVarId) : MetaM α :=
  lemmas.firstM fun e =>
    withTraceNode trace (return m!"{exceptEmoji ·} trying to apply: {e}") do
      let goals ← withTransparency transparency (g.apply e cfg)
      -- When we call `apply` interactively, `Lean.Elab.Tactic.evalApplyLikeTactic`
      -- deals with closing new typeclass goals by calling
      -- `Lean.Elab.Term.synthesizeSyntheticMVarsNoPostponing`.
      -- It seems we can't reuse that machinery down here in `MetaM`,
      -- so we just settle for trying to close each subgoal using `inferInstance`.
      cont (← goals.filterM fun g => try g.inferInstance; pure false catch _ => pure true)

end Lean.MVarId

initialize registerTraceClass `Meta.Tactic.solveByElim

namespace Mathlib.Tactic.SolveByElim

/--
Configuration structure to control the behaviour of `solve_by_elim`:
* control the maximum depth and behaviour (fail or return subgoals) at the maximum depth,
* whether to use `symm` on hypotheses and `exfalso` on the goal as needed,
* and hooks allowing
  * modifying intermediate goals,
  * returning goals as subgoals, and
  * discharging subgoals.
-/
structure Config extends ApplyConfig where
  /-- Maximum recursion depth. -/
  maxDepth : Nat := 6
  /-- If `failAtDepth`, then `solve_by_elim` will fail (and backtrack) upon reaching the max depth.
  Otherwise, upon reaching the max depth, all remaining goals will be returned.
  (defaults to `true`) -/
  failAtMaxDepth : Bool := true
  /-- Transparency mode for calls to `apply`. -/
  transparency : TransparencyMode := .default
  /-- Also use symmetric versions (via `@[symm]`) of local hypotheses. -/
  symm : Bool := true
  /-- Try proving the goal via `exfalso` if `solve_by_elim` otherwise fails.
  This is only used when operating on a single goal. -/
  exfalso : Bool := true
  /-- An arbitrary procedure which can be used to modify the list of goals
  before each attempt to apply a lemma.
  Called as `proc goals curr`, where `goals` are the original goals for `solve_by_elim`,
  and `curr` are the current goals.
  Returning `some l` will replace the current goals with `l` and recurse
  (consuming one step of maximum depth).
  Returning `none` will proceed to applying lemmas without changing goals.
  Failure will cause backtracking.
  (defaults to `none`) -/
  proc : List MVarId → List MVarId → MetaM (Option (List MVarId)) := fun _ _ => pure none
  /-- If `suspend g`, then we do not attempt to apply any further lemmas,
  but return `g` as a new subgoal. (defaults to `false`) -/
  suspend : MVarId → MetaM Bool := fun _ => pure false
  /-- `discharge g` is called on goals for which no lemmas apply.
  If `none` we return `g` as a new subgoal.
  If `some l`, we replace `g` by `l` in the list of active goals, and recurse.
  If failure, we backtrack. (defaults to failure) -/
  discharge : MVarId → MetaM (Option (List MVarId)) := fun _ => failure

/-- The default `maxDepth` for `apply_rules` is higher. -/
structure ApplyRulesConfig extends Config where
  maxDepth := 50

/--
Allow elaboration of `Config` arguments to tactics.
-/
declare_config_elab elabConfig Config

/--
Allow elaboration of `ApplyRulesConfig` arguments to tactics.
-/
declare_config_elab elabApplyRulesConfig ApplyRulesConfig

namespace Config

/-- Create or modify a `Config` which allows a class of goals to be returned as subgoals. -/
def accept (cfg : Config := {}) (test : MVarId → MetaM Bool) : Config :=
{ cfg with
  discharge := fun g => do
    if (← test g) then
      pure none
    else
      cfg.discharge g }

/-- Create or modify a `Config` which does no backtracking. -/
def noBackTracking (cfg : Config := {}) : Config := cfg.accept fun _ => pure true

/--
Create or modify a `Config` which runs a tactic on the main goal.
If that tactic fails, fall back to the `proc` behaviour of `cfg`.
-/
def mainGoalProc (cfg : Config := {}) (proc : MVarId → MetaM (List MVarId)) : Config :=
{ cfg with
  proc := fun orig goals => match goals with
  | [] => pure none
  | g :: gs => try
      return (← proc g) ++ gs
    catch _ => cfg.proc orig goals }

/-- Create or modify a `Config` which calls `intro` on each goal before applying lemmas. -/
def intros (cfg : Config := {}) : Config :=
  mainGoalProc cfg fun g => do pure [(← g.intro1P).2]

/--
Create or modify a `Config` which rejects branches for which `test`,
applied to the instantiations of the original goals, fails or returns `false`.
-/
def testPartialSolutions (cfg : Config := {}) (test : List Expr → MetaM Bool) : Config :=
{ cfg with
  proc := fun orig goals => do
    let .true ← test (← orig.mapM fun m => m.withContext do instantiateMVars (.mvar m)) | failure
    cfg.proc orig goals }

/--
Create or modify a `Config` which rejects complete solutions for which `test`,
applied to the instantiations of the original goals, fails or returns `false`.
-/
def testSolutions (cfg : Config := {}) (test : List Expr → MetaM Bool) : Config :=
  cfg.testPartialSolutions fun sols => do
    if sols.any Expr.hasMVar then
      pure true
    else
      test sols

/--
Create or modify a `Config` which only accept solutions
for which every expression in `use` appears as a subexpression.
-/
def requireUsingAll (cfg : Config := {}) (use : List Expr) : Config :=
  cfg.testSolutions fun sols => do
    pure <| use.all fun e => sols.any fun s => e.occurs s

end Config

/--
Elaborate a list of lemmas and local context.
See `mkAssumptionSet` for an explanation of why this is needed.
-/
def elabContextLemmas (g : MVarId) (lemmas : List (TermElabM Expr)) (ctx : TermElabM (List Expr)) :
    MetaM (List Expr) := do
  g.withContext (Elab.Term.TermElabM.run' do pure ((← lemmas.mapM id) ++ (← ctx)))

/--
Solve a collection of goals by repeatedly applying lemmas, backtracking as necessary.

Arguments:
* `cfg : Config` additional configuration options
  (options for `apply`, maximum depth, and custom flow control)
* `lemmas : List (TermElabM Expr)` lemmas to apply.
  These are thunks in `TermElabM` to avoid stuck metavariables.
* `ctx : TermElabM (List Expr)` monadic function returning the local hypotheses to use.
* `goals : List MVarId` the initial list of goals for `solveByElim`

Returns a list of suspended goals, if it succeeded on all other subgoals.
By default `cfg.suspend` is `false,` `cfg.discharge` fails, and `cfg.failAtMaxDepth` is `true`,
and so the returned list is always empty.
Custom wrappers (e.g. `apply_assumption` and `apply_rules`) may modify this behaviour.
-/
def solveByElim (cfg : Config) (lemmas : List (TermElabM Expr)) (ctx : TermElabM (List Expr))
    (goals : List MVarId) : MetaM (List MVarId) := do
  -- We handle `cfg.symm` by saturating hypotheses of all goals using `symm`.
  -- Implementation note:
  -- (We used to apply `symm` all throughout the `solve_by_elim` stage.)
  -- I initially reproduced the mathlib3 approach, but it had bad performance so switched to this.
  let goals ← if cfg.symm then
    goals.mapM fun g => g.symmSaturate
  else
    pure goals

  -- Implementation note: as with `cfg.symm`, this is different from the mathlib3 approach,
  -- for (not as bad) performance reasons.
  match cfg.exfalso, goals with
    | true, [g] => try
        run cfg.maxDepth [g] []
      catch _ => do
        withTraceNode `Meta.Tactic.solveByElim
            (fun _ => return m!"⏮ starting over using `exfalso`") do
          let g ← g.exfalso
          run cfg.maxDepth [g] []
    | _, _ =>
      run cfg.maxDepth goals []
  where
  /--
  * `n : Nat` steps remaining.
  * `curr : List MVarId` the current list of unsolved goals.
  * `acc : List MVarId` a list of "suspended" goals, which will be returned as subgoals.
  -/
  run (n : Nat) (curr acc : List MVarId) : MetaM (List MVarId) := do
  match n with
  | 0 => do
    -- We're out of fuel.
    if cfg.failAtMaxDepth then
      throwError "solve_by_elim exceeded the recursion limit"
    else
      -- Before returning the goals, we run `cfg.proc` one last time.
      let curr := acc.reverse ++ curr
      return (← cfg.proc goals curr).getD curr
  | n + 1 => do
  -- First, run `cfg.proc`, to see if it wants to modify the goals.
  match ← cfg.proc goals curr with
  | some curr' => run n curr' acc
  | none =>
  match curr with
  -- If there are no active goals, return the accumulated goals.
  | [] => return acc.reverse
  | g :: gs =>
  -- Discard any goals which have already been assigned.
  if ← g.isAssigned then
    run (n+1) gs acc
  else
  withTraceNode `Meta.Tactic.solveByElim
    -- Note: the `addMessageContextFull` ensures we show the goal using the mvar context before
    -- the `do` block below runs, potentially unifying mvars in the goal.
    (return m!"{exceptEmoji ·} working on: {← addMessageContextFull g}")
    do
      -- Check if we should suspend the search here:
      if (← cfg.suspend g) then
        withTraceNode `Meta.Tactic.solveByElim
          (fun _ => return m!"⏸ suspending search and returning as subgoal") do
        run (n+1) gs (g :: acc)
      else
        let es ← elabContextLemmas g lemmas ctx
        try
          -- We attempt to find an expression which can be applied,
          -- and for which all resulting sub-goals can be discharged using `solveByElim n`.
          g.applyFirst cfg.toApplyConfig cfg.transparency `Meta.Tactic.solveByElim es fun res =>
            run n (res ++ gs) acc
        catch _ =>
          -- No lemmas could be applied:
          match (← cfg.discharge g) with
          | none => (withTraceNode `Meta.Tactic.solveByElim
              (fun _ => return m!"⏭ deemed acceptable, returning as subgoal") do
            run (n+1) gs (g :: acc))
          | some l => (withTraceNode `Meta.Tactic.solveByElim
              (fun _ => return m!"⏬ discharger generated new subgoals") do
            run n (l ++ gs) acc)
  termination_by run n curr acc => (n, curr)

/--
A `MetaM` analogue of the `apply_rules` user tactic.

Since `apply_rules` does not backtrack, we don't need to worry about stuck metavariables
and can pass the lemmas as a `List Expr`.

By default it uses all local hypotheses, but you can disable this with `only := true`.
If you need to remove particular local hypotheses, call `solveByElim` directly.
-/
def _root_.Lean.MVarId.applyRules (cfg : Config) (lemmas : List Expr) (only : Bool := false)
    (g : MVarId) : MetaM (List MVarId) := do
  let lemmas := lemmas.map pure
  let ctx : TermElabM (List Expr) := if only then pure [] else do pure (← getLocalHyps).toList
  solveByElim { cfg.noBackTracking with failAtMaxDepth := false } lemmas ctx [g]

open Lean.Parser.Tactic
open Mathlib.Tactic.LabelAttr

/--
`mkAssumptionSet` builds a collection of lemmas for use in
the backtracking search in `solve_by_elim`.

* By default, it includes all local hypotheses, along with `rfl`, `trivial`, `congrFun`
  and `congrArg`.
* The flag `noDefaults` removes these.
* The flag `star` includes all local hypotheses, but not `rfl`, `trivial`, `congrFun`,
  or `congrArg`. (It doesn't make sense to use `star` without `noDefaults`.)
* The argument `add` is the list of terms inside the square brackets that did not have `-`
  and can be used to add expressions or local hypotheses
* The argument `remove` is the list of terms inside the square brackets that had a `-`,
  and can be used to remove local hypotheses.
  (It doesn't make sense to remove expressions which are not local hypotheses,
  to remove local hypotheses unless `!noDefaults || star`,
  and it does not make sense to use `star` unless you remove at least one local hypothesis.)

`mkAssumptionSet` returns not a `List expr`, but a `List (TermElabM Expr) × TermElabM (List Expr)`.
There are two separate problems that need to be solved.

### Stuck metavariables

Lemmas with implicit arguments would be filled in with metavariables if we created the
`Expr` objects immediately, so instead we return thunks that generate the expressions
on demand. This is the first component, with type `List (TermElabM expr)`.

As an example, we have `def rfl : ∀ {α : Sort u} {a : α}, a = a`, which on elaboration will become
`@rfl ?m_1 ?m_2`.

Because `solve_by_elim` works by repeated application of lemmas against subgoals,
the first time such a lemma is successfully applied,
those metavariables will be unified, and thereafter have fixed values.
This would make it impossible to apply the lemma
a second time with different values of the metavariables.

See https://github.com/leanprover-community/mathlib/issues/2269

### Relevant local hypotheses

`solve_by_elim*` works with multiple goals,
and we need to use separate sets of local hypotheses for each goal.
The second component of the returned value provides these local hypotheses.
(Essentially using `local_context`, along with some filtering to remove hypotheses
that have been explicitly removed via `only` or `[-h]`.)

-/
-- These `TermElabM`s must be run inside a suitable `g.withContext`,
-- usually using `elabContextLemmas`.
def mkAssumptionSet (noDefaults star : Bool) (add remove : List Term) (use : Array Ident) :
    MetaM (List (TermElabM Expr) × TermElabM (List Expr)) := do
  if star && !noDefaults then
    throwError "It doesn't make sense to use `*` without `only`."

  let defaults : List (TermElabM Expr) :=
    [← `(rfl), ← `(trivial), ← `(congrFun), ← `(congrArg)].map elab'
  let labelledLemmas := (← use.mapM (labelled ·.raw.getId)).flatten.toList
    |>.map (liftM <| mkConstWithFreshMVarLevels ·)
  let lemmas := if noDefaults then
    add.map elab' ++ labelledLemmas
  else
    add.map elab' ++ labelledLemmas ++ defaults

  if !remove.isEmpty && noDefaults && !star then
    throwError "It doesn't make sense to remove local hypotheses when using `only` without `*`."
  let locals : TermElabM (List Expr) := if noDefaults && !star then do
    pure []
  else do
    pure <| (← getLocalHyps).toList.removeAll (← remove.mapM elab')

  return (lemmas, locals)
  where
  /-- Run `elabTerm`. -/
  elab' (t : Term) : TermElabM Expr := Elab.Term.elabTerm t.raw none

/-- Syntax for omitting a local hypothesis in `solve_by_elim`. -/
syntax erase := "-" term:max
/-- Syntax for including all local hypotheses in `solve_by_elim`. -/
syntax star := "*"
/-- Syntax for adding or removing a term, or `*`, in `solve_by_elim`. -/
syntax arg := star <|> erase <|> term
/-- Syntax for adding and removing terms in `solve_by_elim`. -/
syntax args := " [" SolveByElim.arg,* "] "
/-- Syntax for using all lemmas labelled with an attribute in `solve_by_elim`. -/
syntax using_ := " using " ident,*

open Syntax

/--
Parse the lemma argument of a call to `solve_by_elim`.
The first component should be true if `*` appears at least once.
The second component should contain each term `t`in the arguments.
The third component should contain `t` for each `-t` in the arguments.
-/
def parseArgs (s : Option (TSyntax ``args)) :
    Bool × List Term × List Term :=
  let args : Array (TSyntax ``arg) := match s with
  | some s => match s with
    | `(args| [$args,*]) => args.getElems
    | _ => #[]
  | none => #[]
  let args : Array (Option (Term ⊕ Term)) := args.map fun t => match t with
    | `(arg| $_:star) => none
    | `(arg| - $t:term) => some (Sum.inr t)
    | `(arg| $t:term) => some (Sum.inl t)
    | _ => panic! "Unreachable parse of solve_by_elim arguments."
  let args := args.toList
  (args.contains none,
    args.filterMap fun o => o.bind Sum.getLeft,
    args.filterMap fun o => o.bind Sum.getRight)

/-- Parse the `using ...` argument for `solve_by_elim`. -/
def parseUsing (s : Option (TSyntax ``using_)) : Array Ident :=
  match s with
  | some s => match s with
    | `(using_ | using $ids,*) => ids.getElems
    | _ => #[]
  | none => #[]

/--
`solve_by_elim` calls `apply` on the main goal to find an assumption whose head matches
and then repeatedly calls `apply` on the generated subgoals until no subgoals remain,
performing at most `maxDepth` (defaults to 6) recursive steps.

`solve_by_elim` discharges the current goal or fails.

`solve_by_elim` performs backtracking if subgoals can not be solved.

By default, the assumptions passed to `apply` are the local context, `rfl`, `trivial`,
`congrFun` and `congrArg`.

The assumptions can be modified with similar syntax as for `simp`:
* `solve_by_elim [h₁, h₂, ..., hᵣ]` also applies the given expressions.
* `solve_by_elim only [h₁, h₂, ..., hᵣ]` does not include the local context,
  `rfl`, `trivial`, `congrFun`, or `congrArg` unless they are explicitly included.
* `solve_by_elim [-h₁, ... -hₙ]` removes the given local hypotheses.
* `solve_by_elim using [a₁, ...]` uses all lemmas which have been labelled
  with the attributes `aᵢ` (these attributes must be created using `register_label_attr`).

`solve_by_elim*` tries to solve all goals together, using backtracking if a solution for one goal
makes other goals impossible.
(Adding or removing local hypotheses may not be well-behaved when starting with multiple goals.)

Optional arguments passed via a configuration argument as `solve_by_elim (config := { ... })`
- `maxDepth`: number of attempts at discharging generated subgoals
- `symm`: adds all hypotheses derived by `symm` (defaults to `true`).
- `exfalso`: allow calling `exfalso` and trying again if `solve_by_elim` fails
  (defaults to `true`).
- `transparency`: change the transparency mode when calling `apply`. Defaults to `.default`,
  but it is often useful to change to `.reducible`,
  so semireducible definitions will not be unfolded when trying to apply a lemma.

See also the doc-comment for `Mathlib.Tactic.SolveByElim.Config` for the options
`proc`, `suspend`, and `discharge` which allow further customization of `solve_by_elim`.
Both `apply_assumption` and `apply_rules` are implemented via these hooks.
-/
syntax (name := solveByElimSyntax)
  "solve_by_elim" "*"? (config)? (&" only")? (args)? (using_)? : tactic

/-- Wrapper for `solveByElim` that processes a list of `Term`s
that specify the lemmas to use. -/
def solveByElim.processSyntax (cfg : Config := {}) (only star : Bool) (add remove : List Term)
    (use : Array Ident) (goals : List MVarId) : MetaM (List MVarId) := do
  if !remove.isEmpty && goals.length > 1 then
    throwError "Removing local hypotheses is not supported when operating on multiple goals."
  let ⟨lemmas, ctx⟩ ← mkAssumptionSet only star add remove use
  solveByElim cfg lemmas ctx goals

elab_rules : tactic |
    `(tactic| solve_by_elim $[*%$s]? $[$cfg]? $[only%$o]? $[$t:args]? $[$use:using_]?) => do
  let (star, add, remove) := parseArgs t
  let use := parseUsing use
  let goals ← if s.isSome then
    getGoals
  else
    pure [← getMainGoal]
  let cfg ← elabConfig (mkOptionalNode cfg)
  let [] ← solveByElim.processSyntax cfg o.isSome star add remove use goals |
    throwError "solve_by_elim unexpectedly returned subgoals"
  pure ()

/--
`apply_assumption` looks for an assumption of the form `... → ∀ _, ... → head`
where `head` matches the current goal.

You can specify additional rules to apply using `apply_assumption [...]`.
By default `apply_assumption` will also try `rfl`, `trivial`, `congrFun`, and `congrArg`.
If you don't want these, or don't want to use all hypotheses, use `apply_assumption only [...]`.
You can use `apply_assumption [-h]` to omit a local hypothesis.
You can use `apply_assumption using [a₁, ...]` to use all lemmas which have been labelled
with the attributes `aᵢ` (these attributes must be created using `register_label_attr`).

`apply_assumption` will use consequences of local hypotheses obtained via `symm`.

If `apply_assumption` fails, it will call `exfalso` and try again.
Thus if there is an assumption of the form `P → ¬ Q`, the new tactic state
will have two goals, `P` and `Q`.

You can pass a further configuration via the syntax `apply_rules (config := {...}) lemmas`.
The options supported are the same as for `solve_by_elim` (and include all the options for `apply`).
-/
syntax (name := applyAssumptionSyntax)
  "apply_assumption" (config)? (&" only")? (args)? (using_)? : tactic

elab_rules : tactic |
    `(tactic| apply_assumption $[$cfg]? $[only%$o]? $[$t:args]? $[$use:using_]?) => do
  let (star, add, remove) := parseArgs t
  let use := parseUsing use
  let cfg ← elabConfig (mkOptionalNode cfg)
  let cfg := { cfg with
    maxDepth := 1
    failAtMaxDepth := false }
  replaceMainGoal (← solveByElim.processSyntax cfg o.isSome star add remove use [← getMainGoal])

/--
`apply_rules [l₁, l₂, ...]` tries to solve the main goal by iteratively
applying the list of lemmas `[l₁, l₂, ...]` or by applying a local hypothesis.
If `apply` generates new goals, `apply_rules` iteratively tries to solve those goals.
You can use `apply_rules [-h]` to omit a local hypothesis.

`apply_rules` will also use `rfl`, `trivial`, `congrFun` and `congrArg`.
These can be disabled, as can local hypotheses, by using `apply_rules only [...]`.

You can use `apply_rules using [a₁, ...]` to use all lemmas which have been labelled
with the attributes `aᵢ` (these attributes must be created using `register_label_attr`).

You can pass a further configuration via the syntax `apply_rules (config := {...})`.
The options supported are the same as for `solve_by_elim` (and include all the options for `apply`).

`apply_rules` will try calling `symm` on hypotheses and `exfalso` on the goal as needed.
This can be disabled with `apply_rules (config := {symm := false, exfalso := false})`.

You can bound the iteration depth using the syntax `apply_rules (config := {maxDepth := n})`.

Unlike `solve_by_elim`, `apply_rules` does not perform backtracking, and greedily applies
a lemma from the list until it gets stuck.
-/
syntax (name := applyRulesSyntax) "apply_rules" (config)? (&" only")? (args)? (using_)? : tactic

-- See also `Lean.MVarId.applyRules` for a `MetaM` level analogue of this tactic.
elab_rules : tactic |
    `(tactic| apply_rules $[$cfg]? $[only%$o]? $[$t:args]? $[$use:using_]?)  => do
  let (star, add, remove) := parseArgs t
  let use := parseUsing use
  let cfg ← elabApplyRulesConfig (mkOptionalNode cfg)
  let cfg := { cfg.noBackTracking with
    failAtMaxDepth := false }
  liftMetaTactic fun g => solveByElim.processSyntax cfg o.isSome star add remove use [g]