/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.mv_polynomial.rename
import Mathlib.PostPort

universes u_1 u_2 u_4 u_3

namespace Mathlib

/-!
# `comap` operation on `mv_polynomial`

This file defines the `comap` function on `mv_polynomial`.

`mv_polynomial.comap` is a low-tech example of a map of "algebraic varieties," modulo the fact that
`mathlib` does not yet define varieties.

## Notation

As in other polynomial files, we typically use the notation:

+ `σ : Type*` (indexing the variables)

+ `R : Type*` `[comm_semiring R]` (the coefficients)

-/

namespace mv_polynomial

/--
Given an algebra hom `f : mv_polynomial σ R →ₐ[R] mv_polynomial τ R`
and a variable evaluation `v : τ → R`,
`comap f v` produces a variable evaluation `σ → R`.
-/
def comap {σ : Type u_1} {τ : Type u_2} {R : Type u_4} [comm_semiring R] (f : alg_hom R (mv_polynomial σ R) (mv_polynomial τ R)) : (τ → R) → σ → R :=
  fun (x : τ → R) (i : σ) => coe_fn (aeval x) (coe_fn f (X i))

@[simp] theorem comap_apply {σ : Type u_1} {τ : Type u_2} {R : Type u_4} [comm_semiring R] (f : alg_hom R (mv_polynomial σ R) (mv_polynomial τ R)) (x : τ → R) (i : σ) : comap f x i = coe_fn (aeval x) (coe_fn f (X i)) :=
  rfl

@[simp] theorem comap_id_apply {σ : Type u_1} {R : Type u_4} [comm_semiring R] (x : σ → R) : comap (alg_hom.id R (mv_polynomial σ R)) x = x := sorry

theorem comap_id (σ : Type u_1) (R : Type u_4) [comm_semiring R] : comap (alg_hom.id R (mv_polynomial σ R)) = id :=
  funext fun (x : σ → R) => comap_id_apply x

theorem comap_comp_apply {σ : Type u_1} {τ : Type u_2} {υ : Type u_3} {R : Type u_4} [comm_semiring R] (f : alg_hom R (mv_polynomial σ R) (mv_polynomial τ R)) (g : alg_hom R (mv_polynomial τ R) (mv_polynomial υ R)) (x : υ → R) : comap (alg_hom.comp g f) x = comap f (comap g x) := sorry

theorem comap_comp {σ : Type u_1} {τ : Type u_2} {υ : Type u_3} {R : Type u_4} [comm_semiring R] (f : alg_hom R (mv_polynomial σ R) (mv_polynomial τ R)) (g : alg_hom R (mv_polynomial τ R) (mv_polynomial υ R)) : comap (alg_hom.comp g f) = comap f ∘ comap g :=
  funext fun (x : υ → R) => comap_comp_apply f g x

theorem comap_eq_id_of_eq_id {σ : Type u_1} {R : Type u_4} [comm_semiring R] (f : alg_hom R (mv_polynomial σ R) (mv_polynomial σ R)) (hf : ∀ (φ : mv_polynomial σ R), coe_fn f φ = φ) (x : σ → R) : comap f x = x := sorry

theorem comap_rename {σ : Type u_1} {τ : Type u_2} {R : Type u_4} [comm_semiring R] (f : σ → τ) (x : τ → R) : comap (rename f) x = x ∘ f := sorry

/--
If two polynomial types over the same coefficient ring `R` are equivalent,
there is a bijection between the types of functions from their variable types to `R`.
-/
def comap_equiv {σ : Type u_1} {τ : Type u_2} {R : Type u_4} [comm_semiring R] (f : alg_equiv R (mv_polynomial σ R) (mv_polynomial τ R)) : (τ → R) ≃ (σ → R) :=
  equiv.mk (comap ↑f) (comap ↑(alg_equiv.symm f)) sorry sorry

@[simp] theorem comap_equiv_coe {σ : Type u_1} {τ : Type u_2} {R : Type u_4} [comm_semiring R] (f : alg_equiv R (mv_polynomial σ R) (mv_polynomial τ R)) : ⇑(comap_equiv f) = comap ↑f :=
  rfl

@[simp] theorem comap_equiv_symm_coe {σ : Type u_1} {τ : Type u_2} {R : Type u_4} [comm_semiring R] (f : alg_equiv R (mv_polynomial σ R) (mv_polynomial τ R)) : ⇑(equiv.symm (comap_equiv f)) = comap ↑(alg_equiv.symm f) :=
  rfl


/-
Copyright (c) 2021 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn

! This file was ported from Lean 3 source module algebra.order.sub.basic
! leanprover-community/mathlib commit 448144f7ae193a8990cb7473c9e9a01990f64ac7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Order.Hom.Basic
import Mathbin.Algebra.Hom.Equiv.Basic
import Mathbin.Algebra.Ring.Basic
import Mathbin.Algebra.Order.Sub.Defs

/-!
# Additional results about ordered Subtraction

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

-/

variable {α β : Type _}

section Add

variable [Preorder α] [Add α] [Sub α] [OrderedSub α] {a b c d : α}

#print AddHom.le_map_tsub /-
theorem AddHom.le_map_tsub [Preorder β] [Add β] [Sub β] [OrderedSub β] (f : AddHom α β)
    (hf : Monotone f) (a b : α) : f a - f b ≤ f (a - b) :=
  by
  rw [tsub_le_iff_right, ← f.map_add]
  exact hf le_tsub_add
#align add_hom.le_map_tsub AddHom.le_map_tsub
-/

/- warning: le_mul_tsub -> le_mul_tsub is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_5 : Distrib.{u1} R] [_inst_6 : Preorder.{u1} R] [_inst_7 : Sub.{u1} R] [_inst_8 : OrderedSub.{u1} R (Preorder.toLE.{u1} R _inst_6) (Distrib.toHasAdd.{u1} R _inst_5) _inst_7] [_inst_9 : CovariantClass.{u1, u1} R R (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R _inst_5))) (LE.le.{u1} R (Preorder.toLE.{u1} R _inst_6))] {a : R} {b : R} {c : R}, LE.le.{u1} R (Preorder.toLE.{u1} R _inst_6) (HSub.hSub.{u1, u1, u1} R R R (instHSub.{u1} R _inst_7) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R _inst_5)) a b) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R _inst_5)) a c)) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R _inst_5)) a (HSub.hSub.{u1, u1, u1} R R R (instHSub.{u1} R _inst_7) b c))
but is expected to have type
  forall {R : Type.{u1}} [_inst_5 : Distrib.{u1} R] [_inst_6 : Preorder.{u1} R] [_inst_7 : Sub.{u1} R] [_inst_8 : OrderedSub.{u1} R (Preorder.toLE.{u1} R _inst_6) (Distrib.toAdd.{u1} R _inst_5) _inst_7] [_inst_9 : CovariantClass.{u1, u1} R R (fun (x._@.Mathlib.Algebra.Order.Sub.Basic._hyg.174 : R) (x._@.Mathlib.Algebra.Order.Sub.Basic._hyg.176 : R) => HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toMul.{u1} R _inst_5)) x._@.Mathlib.Algebra.Order.Sub.Basic._hyg.174 x._@.Mathlib.Algebra.Order.Sub.Basic._hyg.176) (fun (x._@.Mathlib.Algebra.Order.Sub.Basic._hyg.189 : R) (x._@.Mathlib.Algebra.Order.Sub.Basic._hyg.191 : R) => LE.le.{u1} R (Preorder.toLE.{u1} R _inst_6) x._@.Mathlib.Algebra.Order.Sub.Basic._hyg.189 x._@.Mathlib.Algebra.Order.Sub.Basic._hyg.191)] {a : R} {b : R} {c : R}, LE.le.{u1} R (Preorder.toLE.{u1} R _inst_6) (HSub.hSub.{u1, u1, u1} R R R (instHSub.{u1} R _inst_7) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toMul.{u1} R _inst_5)) a b) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toMul.{u1} R _inst_5)) a c)) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toMul.{u1} R _inst_5)) a (HSub.hSub.{u1, u1, u1} R R R (instHSub.{u1} R _inst_7) b c))
Case conversion may be inaccurate. Consider using '#align le_mul_tsub le_mul_tsubₓ'. -/
theorem le_mul_tsub {R : Type _} [Distrib R] [Preorder R] [Sub R] [OrderedSub R]
    [CovariantClass R R (· * ·) (· ≤ ·)] {a b c : R} : a * b - a * c ≤ a * (b - c) :=
  (AddHom.mulLeft a).le_map_tsub (monotone_id.const_mul' a) _ _
#align le_mul_tsub le_mul_tsub

/- warning: le_tsub_mul -> le_tsub_mul is a dubious translation:
lean 3 declaration is
  forall {R : Type.{u1}} [_inst_5 : CommSemiring.{u1} R] [_inst_6 : Preorder.{u1} R] [_inst_7 : Sub.{u1} R] [_inst_8 : OrderedSub.{u1} R (Preorder.toLE.{u1} R _inst_6) (Distrib.toHasAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R _inst_5))))) _inst_7] [_inst_9 : CovariantClass.{u1, u1} R R (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R _inst_5))))))) (LE.le.{u1} R (Preorder.toLE.{u1} R _inst_6))] {a : R} {b : R} {c : R}, LE.le.{u1} R (Preorder.toLE.{u1} R _inst_6) (HSub.hSub.{u1, u1, u1} R R R (instHSub.{u1} R _inst_7) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R _inst_5)))))) a c) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R _inst_5)))))) b c)) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (Distrib.toHasMul.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R _inst_5)))))) (HSub.hSub.{u1, u1, u1} R R R (instHSub.{u1} R _inst_7) a b) c)
but is expected to have type
  forall {R : Type.{u1}} [_inst_5 : CommSemiring.{u1} R] [_inst_6 : Preorder.{u1} R] [_inst_7 : Sub.{u1} R] [_inst_8 : OrderedSub.{u1} R (Preorder.toLE.{u1} R _inst_6) (Distrib.toAdd.{u1} R (NonUnitalNonAssocSemiring.toDistrib.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R _inst_5))))) _inst_7] [_inst_9 : CovariantClass.{u1, u1} R R (fun (x._@.Mathlib.Algebra.Order.Sub.Basic._hyg.270 : R) (x._@.Mathlib.Algebra.Order.Sub.Basic._hyg.272 : R) => HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (NonUnitalNonAssocSemiring.toMul.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R _inst_5))))) x._@.Mathlib.Algebra.Order.Sub.Basic._hyg.270 x._@.Mathlib.Algebra.Order.Sub.Basic._hyg.272) (fun (x._@.Mathlib.Algebra.Order.Sub.Basic._hyg.285 : R) (x._@.Mathlib.Algebra.Order.Sub.Basic._hyg.287 : R) => LE.le.{u1} R (Preorder.toLE.{u1} R _inst_6) x._@.Mathlib.Algebra.Order.Sub.Basic._hyg.285 x._@.Mathlib.Algebra.Order.Sub.Basic._hyg.287)] {a : R} {b : R} {c : R}, LE.le.{u1} R (Preorder.toLE.{u1} R _inst_6) (HSub.hSub.{u1, u1, u1} R R R (instHSub.{u1} R _inst_7) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (NonUnitalNonAssocSemiring.toMul.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R _inst_5))))) a c) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (NonUnitalNonAssocSemiring.toMul.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R _inst_5))))) b c)) (HMul.hMul.{u1, u1, u1} R R R (instHMul.{u1} R (NonUnitalNonAssocSemiring.toMul.{u1} R (NonAssocSemiring.toNonUnitalNonAssocSemiring.{u1} R (Semiring.toNonAssocSemiring.{u1} R (CommSemiring.toSemiring.{u1} R _inst_5))))) (HSub.hSub.{u1, u1, u1} R R R (instHSub.{u1} R _inst_7) a b) c)
Case conversion may be inaccurate. Consider using '#align le_tsub_mul le_tsub_mulₓ'. -/
theorem le_tsub_mul {R : Type _} [CommSemiring R] [Preorder R] [Sub R] [OrderedSub R]
    [CovariantClass R R (· * ·) (· ≤ ·)] {a b c : R} : a * c - b * c ≤ (a - b) * c := by
  simpa only [mul_comm _ c] using le_mul_tsub
#align le_tsub_mul le_tsub_mul

end Add

/- warning: order_iso.map_tsub -> OrderIso.map_tsub is a dubious translation:
lean 3 declaration is
  forall {M : Type.{u1}} {N : Type.{u2}} [_inst_1 : Preorder.{u1} M] [_inst_2 : Add.{u1} M] [_inst_3 : Sub.{u1} M] [_inst_4 : OrderedSub.{u1} M (Preorder.toLE.{u1} M _inst_1) _inst_2 _inst_3] [_inst_5 : PartialOrder.{u2} N] [_inst_6 : Add.{u2} N] [_inst_7 : Sub.{u2} N] [_inst_8 : OrderedSub.{u2} N (Preorder.toLE.{u2} N (PartialOrder.toPreorder.{u2} N _inst_5)) _inst_6 _inst_7] (e : OrderIso.{u1, u2} M N (Preorder.toLE.{u1} M _inst_1) (Preorder.toLE.{u2} N (PartialOrder.toPreorder.{u2} N _inst_5))), (forall (a : M) (b : M), Eq.{succ u2} N (coeFn.{max (succ u1) (succ u2), max (succ u1) (succ u2)} (OrderIso.{u1, u2} M N (Preorder.toLE.{u1} M _inst_1) (Preorder.toLE.{u2} N (PartialOrder.toPreorder.{u2} N _inst_5))) (fun (_x : RelIso.{u1, u2} M N (LE.le.{u1} M (Preorder.toLE.{u1} M _inst_1)) (LE.le.{u2} N (Preorder.toLE.{u2} N (PartialOrder.toPreorder.{u2} N _inst_5)))) => M -> N) (RelIso.hasCoeToFun.{u1, u2} M N (LE.le.{u1} M (Preorder.toLE.{u1} M _inst_1)) (LE.le.{u2} N (Preorder.toLE.{u2} N (PartialOrder.toPreorder.{u2} N _inst_5)))) e (HAdd.hAdd.{u1, u1, u1} M M M (instHAdd.{u1} M _inst_2) a b)) (HAdd.hAdd.{u2, u2, u2} N N N (instHAdd.{u2} N _inst_6) (coeFn.{max (succ u1) (succ u2), max (succ u1) (succ u2)} (OrderIso.{u1, u2} M N (Preorder.toLE.{u1} M _inst_1) (Preorder.toLE.{u2} N (PartialOrder.toPreorder.{u2} N _inst_5))) (fun (_x : RelIso.{u1, u2} M N (LE.le.{u1} M (Preorder.toLE.{u1} M _inst_1)) (LE.le.{u2} N (Preorder.toLE.{u2} N (PartialOrder.toPreorder.{u2} N _inst_5)))) => M -> N) (RelIso.hasCoeToFun.{u1, u2} M N (LE.le.{u1} M (Preorder.toLE.{u1} M _inst_1)) (LE.le.{u2} N (Preorder.toLE.{u2} N (PartialOrder.toPreorder.{u2} N _inst_5)))) e a) (coeFn.{max (succ u1) (succ u2), max (succ u1) (succ u2)} (OrderIso.{u1, u2} M N (Preorder.toLE.{u1} M _inst_1) (Preorder.toLE.{u2} N (PartialOrder.toPreorder.{u2} N _inst_5))) (fun (_x : RelIso.{u1, u2} M N (LE.le.{u1} M (Preorder.toLE.{u1} M _inst_1)) (LE.le.{u2} N (Preorder.toLE.{u2} N (PartialOrder.toPreorder.{u2} N _inst_5)))) => M -> N) (RelIso.hasCoeToFun.{u1, u2} M N (LE.le.{u1} M (Preorder.toLE.{u1} M _inst_1)) (LE.le.{u2} N (Preorder.toLE.{u2} N (PartialOrder.toPreorder.{u2} N _inst_5)))) e b))) -> (forall (a : M) (b : M), Eq.{succ u2} N (coeFn.{max (succ u1) (succ u2), max (succ u1) (succ u2)} (OrderIso.{u1, u2} M N (Preorder.toLE.{u1} M _inst_1) (Preorder.toLE.{u2} N (PartialOrder.toPreorder.{u2} N _inst_5))) (fun (_x : RelIso.{u1, u2} M N (LE.le.{u1} M (Preorder.toLE.{u1} M _inst_1)) (LE.le.{u2} N (Preorder.toLE.{u2} N (PartialOrder.toPreorder.{u2} N _inst_5)))) => M -> N) (RelIso.hasCoeToFun.{u1, u2} M N (LE.le.{u1} M (Preorder.toLE.{u1} M _inst_1)) (LE.le.{u2} N (Preorder.toLE.{u2} N (PartialOrder.toPreorder.{u2} N _inst_5)))) e (HSub.hSub.{u1, u1, u1} M M M (instHSub.{u1} M _inst_3) a b)) (HSub.hSub.{u2, u2, u2} N N N (instHSub.{u2} N _inst_7) (coeFn.{max (succ u1) (succ u2), max (succ u1) (succ u2)} (OrderIso.{u1, u2} M N (Preorder.toLE.{u1} M _inst_1) (Preorder.toLE.{u2} N (PartialOrder.toPreorder.{u2} N _inst_5))) (fun (_x : RelIso.{u1, u2} M N (LE.le.{u1} M (Preorder.toLE.{u1} M _inst_1)) (LE.le.{u2} N (Preorder.toLE.{u2} N (PartialOrder.toPreorder.{u2} N _inst_5)))) => M -> N) (RelIso.hasCoeToFun.{u1, u2} M N (LE.le.{u1} M (Preorder.toLE.{u1} M _inst_1)) (LE.le.{u2} N (Preorder.toLE.{u2} N (PartialOrder.toPreorder.{u2} N _inst_5)))) e a) (coeFn.{max (succ u1) (succ u2), max (succ u1) (succ u2)} (OrderIso.{u1, u2} M N (Preorder.toLE.{u1} M _inst_1) (Preorder.toLE.{u2} N (PartialOrder.toPreorder.{u2} N _inst_5))) (fun (_x : RelIso.{u1, u2} M N (LE.le.{u1} M (Preorder.toLE.{u1} M _inst_1)) (LE.le.{u2} N (Preorder.toLE.{u2} N (PartialOrder.toPreorder.{u2} N _inst_5)))) => M -> N) (RelIso.hasCoeToFun.{u1, u2} M N (LE.le.{u1} M (Preorder.toLE.{u1} M _inst_1)) (LE.le.{u2} N (Preorder.toLE.{u2} N (PartialOrder.toPreorder.{u2} N _inst_5)))) e b)))
but is expected to have type
  forall {M : Type.{u2}} {N : Type.{u1}} [_inst_1 : Preorder.{u2} M] [_inst_2 : Add.{u2} M] [_inst_3 : Sub.{u2} M] [_inst_4 : OrderedSub.{u2} M (Preorder.toLE.{u2} M _inst_1) _inst_2 _inst_3] [_inst_5 : PartialOrder.{u1} N] [_inst_6 : Add.{u1} N] [_inst_7 : Sub.{u1} N] [_inst_8 : OrderedSub.{u1} N (Preorder.toLE.{u1} N (PartialOrder.toPreorder.{u1} N _inst_5)) _inst_6 _inst_7] (e : OrderIso.{u2, u1} M N (Preorder.toLE.{u2} M _inst_1) (Preorder.toLE.{u1} N (PartialOrder.toPreorder.{u1} N _inst_5))), (forall (a : M) (b : M), Eq.{succ u1} ((fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : M) => N) (HAdd.hAdd.{u2, u2, u2} M M M (instHAdd.{u2} M _inst_2) a b)) (FunLike.coe.{max (succ u2) (succ u1), succ u2, succ u1} (Function.Embedding.{succ u2, succ u1} M N) M (fun (_x : M) => (fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : M) => N) _x) (EmbeddingLike.toFunLike.{max (succ u2) (succ u1), succ u2, succ u1} (Function.Embedding.{succ u2, succ u1} M N) M N (Function.instEmbeddingLikeEmbedding.{succ u2, succ u1} M N)) (RelEmbedding.toEmbedding.{u2, u1} M N (fun (x._@.Mathlib.Order.Hom.Basic._hyg.1281 : M) (x._@.Mathlib.Order.Hom.Basic._hyg.1283 : M) => LE.le.{u2} M (Preorder.toLE.{u2} M _inst_1) x._@.Mathlib.Order.Hom.Basic._hyg.1281 x._@.Mathlib.Order.Hom.Basic._hyg.1283) (fun (x._@.Mathlib.Order.Hom.Basic._hyg.1296 : N) (x._@.Mathlib.Order.Hom.Basic._hyg.1298 : N) => LE.le.{u1} N (Preorder.toLE.{u1} N (PartialOrder.toPreorder.{u1} N _inst_5)) x._@.Mathlib.Order.Hom.Basic._hyg.1296 x._@.Mathlib.Order.Hom.Basic._hyg.1298) (RelIso.toRelEmbedding.{u2, u1} M N (fun (x._@.Mathlib.Order.Hom.Basic._hyg.1281 : M) (x._@.Mathlib.Order.Hom.Basic._hyg.1283 : M) => LE.le.{u2} M (Preorder.toLE.{u2} M _inst_1) x._@.Mathlib.Order.Hom.Basic._hyg.1281 x._@.Mathlib.Order.Hom.Basic._hyg.1283) (fun (x._@.Mathlib.Order.Hom.Basic._hyg.1296 : N) (x._@.Mathlib.Order.Hom.Basic._hyg.1298 : N) => LE.le.{u1} N (Preorder.toLE.{u1} N (PartialOrder.toPreorder.{u1} N _inst_5)) x._@.Mathlib.Order.Hom.Basic._hyg.1296 x._@.Mathlib.Order.Hom.Basic._hyg.1298) e)) (HAdd.hAdd.{u2, u2, u2} M M M (instHAdd.{u2} M _inst_2) a b)) (HAdd.hAdd.{u1, u1, u1} ((fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : M) => N) a) ((fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : M) => N) b) ((fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : M) => N) a) (instHAdd.{u1} ((fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : M) => N) a) _inst_6) (FunLike.coe.{max (succ u2) (succ u1), succ u2, succ u1} (Function.Embedding.{succ u2, succ u1} M N) M (fun (_x : M) => (fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : M) => N) _x) (EmbeddingLike.toFunLike.{max (succ u2) (succ u1), succ u2, succ u1} (Function.Embedding.{succ u2, succ u1} M N) M N (Function.instEmbeddingLikeEmbedding.{succ u2, succ u1} M N)) (RelEmbedding.toEmbedding.{u2, u1} M N (fun (x._@.Mathlib.Order.Hom.Basic._hyg.1281 : M) (x._@.Mathlib.Order.Hom.Basic._hyg.1283 : M) => LE.le.{u2} M (Preorder.toLE.{u2} M _inst_1) x._@.Mathlib.Order.Hom.Basic._hyg.1281 x._@.Mathlib.Order.Hom.Basic._hyg.1283) (fun (x._@.Mathlib.Order.Hom.Basic._hyg.1296 : N) (x._@.Mathlib.Order.Hom.Basic._hyg.1298 : N) => LE.le.{u1} N (Preorder.toLE.{u1} N (PartialOrder.toPreorder.{u1} N _inst_5)) x._@.Mathlib.Order.Hom.Basic._hyg.1296 x._@.Mathlib.Order.Hom.Basic._hyg.1298) (RelIso.toRelEmbedding.{u2, u1} M N (fun (x._@.Mathlib.Order.Hom.Basic._hyg.1281 : M) (x._@.Mathlib.Order.Hom.Basic._hyg.1283 : M) => LE.le.{u2} M (Preorder.toLE.{u2} M _inst_1) x._@.Mathlib.Order.Hom.Basic._hyg.1281 x._@.Mathlib.Order.Hom.Basic._hyg.1283) (fun (x._@.Mathlib.Order.Hom.Basic._hyg.1296 : N) (x._@.Mathlib.Order.Hom.Basic._hyg.1298 : N) => LE.le.{u1} N (Preorder.toLE.{u1} N (PartialOrder.toPreorder.{u1} N _inst_5)) x._@.Mathlib.Order.Hom.Basic._hyg.1296 x._@.Mathlib.Order.Hom.Basic._hyg.1298) e)) a) (FunLike.coe.{max (succ u2) (succ u1), succ u2, succ u1} (Function.Embedding.{succ u2, succ u1} M N) M (fun (_x : M) => (fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : M) => N) _x) (EmbeddingLike.toFunLike.{max (succ u2) (succ u1), succ u2, succ u1} (Function.Embedding.{succ u2, succ u1} M N) M N (Function.instEmbeddingLikeEmbedding.{succ u2, succ u1} M N)) (RelEmbedding.toEmbedding.{u2, u1} M N (fun (x._@.Mathlib.Order.Hom.Basic._hyg.1281 : M) (x._@.Mathlib.Order.Hom.Basic._hyg.1283 : M) => LE.le.{u2} M (Preorder.toLE.{u2} M _inst_1) x._@.Mathlib.Order.Hom.Basic._hyg.1281 x._@.Mathlib.Order.Hom.Basic._hyg.1283) (fun (x._@.Mathlib.Order.Hom.Basic._hyg.1296 : N) (x._@.Mathlib.Order.Hom.Basic._hyg.1298 : N) => LE.le.{u1} N (Preorder.toLE.{u1} N (PartialOrder.toPreorder.{u1} N _inst_5)) x._@.Mathlib.Order.Hom.Basic._hyg.1296 x._@.Mathlib.Order.Hom.Basic._hyg.1298) (RelIso.toRelEmbedding.{u2, u1} M N (fun (x._@.Mathlib.Order.Hom.Basic._hyg.1281 : M) (x._@.Mathlib.Order.Hom.Basic._hyg.1283 : M) => LE.le.{u2} M (Preorder.toLE.{u2} M _inst_1) x._@.Mathlib.Order.Hom.Basic._hyg.1281 x._@.Mathlib.Order.Hom.Basic._hyg.1283) (fun (x._@.Mathlib.Order.Hom.Basic._hyg.1296 : N) (x._@.Mathlib.Order.Hom.Basic._hyg.1298 : N) => LE.le.{u1} N (Preorder.toLE.{u1} N (PartialOrder.toPreorder.{u1} N _inst_5)) x._@.Mathlib.Order.Hom.Basic._hyg.1296 x._@.Mathlib.Order.Hom.Basic._hyg.1298) e)) b))) -> (forall (a : M) (b : M), Eq.{succ u1} ((fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : M) => N) (HSub.hSub.{u2, u2, u2} M M M (instHSub.{u2} M _inst_3) a b)) (FunLike.coe.{max (succ u2) (succ u1), succ u2, succ u1} (Function.Embedding.{succ u2, succ u1} M N) M (fun (_x : M) => (fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : M) => N) _x) (EmbeddingLike.toFunLike.{max (succ u2) (succ u1), succ u2, succ u1} (Function.Embedding.{succ u2, succ u1} M N) M N (Function.instEmbeddingLikeEmbedding.{succ u2, succ u1} M N)) (RelEmbedding.toEmbedding.{u2, u1} M N (fun (x._@.Mathlib.Order.Hom.Basic._hyg.1281 : M) (x._@.Mathlib.Order.Hom.Basic._hyg.1283 : M) => LE.le.{u2} M (Preorder.toLE.{u2} M _inst_1) x._@.Mathlib.Order.Hom.Basic._hyg.1281 x._@.Mathlib.Order.Hom.Basic._hyg.1283) (fun (x._@.Mathlib.Order.Hom.Basic._hyg.1296 : N) (x._@.Mathlib.Order.Hom.Basic._hyg.1298 : N) => LE.le.{u1} N (Preorder.toLE.{u1} N (PartialOrder.toPreorder.{u1} N _inst_5)) x._@.Mathlib.Order.Hom.Basic._hyg.1296 x._@.Mathlib.Order.Hom.Basic._hyg.1298) (RelIso.toRelEmbedding.{u2, u1} M N (fun (x._@.Mathlib.Order.Hom.Basic._hyg.1281 : M) (x._@.Mathlib.Order.Hom.Basic._hyg.1283 : M) => LE.le.{u2} M (Preorder.toLE.{u2} M _inst_1) x._@.Mathlib.Order.Hom.Basic._hyg.1281 x._@.Mathlib.Order.Hom.Basic._hyg.1283) (fun (x._@.Mathlib.Order.Hom.Basic._hyg.1296 : N) (x._@.Mathlib.Order.Hom.Basic._hyg.1298 : N) => LE.le.{u1} N (Preorder.toLE.{u1} N (PartialOrder.toPreorder.{u1} N _inst_5)) x._@.Mathlib.Order.Hom.Basic._hyg.1296 x._@.Mathlib.Order.Hom.Basic._hyg.1298) e)) (HSub.hSub.{u2, u2, u2} M M M (instHSub.{u2} M _inst_3) a b)) (HSub.hSub.{u1, u1, u1} ((fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : M) => N) a) ((fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : M) => N) b) ((fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : M) => N) a) (instHSub.{u1} ((fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : M) => N) a) _inst_7) (FunLike.coe.{max (succ u2) (succ u1), succ u2, succ u1} (Function.Embedding.{succ u2, succ u1} M N) M (fun (_x : M) => (fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : M) => N) _x) (EmbeddingLike.toFunLike.{max (succ u2) (succ u1), succ u2, succ u1} (Function.Embedding.{succ u2, succ u1} M N) M N (Function.instEmbeddingLikeEmbedding.{succ u2, succ u1} M N)) (RelEmbedding.toEmbedding.{u2, u1} M N (fun (x._@.Mathlib.Order.Hom.Basic._hyg.1281 : M) (x._@.Mathlib.Order.Hom.Basic._hyg.1283 : M) => LE.le.{u2} M (Preorder.toLE.{u2} M _inst_1) x._@.Mathlib.Order.Hom.Basic._hyg.1281 x._@.Mathlib.Order.Hom.Basic._hyg.1283) (fun (x._@.Mathlib.Order.Hom.Basic._hyg.1296 : N) (x._@.Mathlib.Order.Hom.Basic._hyg.1298 : N) => LE.le.{u1} N (Preorder.toLE.{u1} N (PartialOrder.toPreorder.{u1} N _inst_5)) x._@.Mathlib.Order.Hom.Basic._hyg.1296 x._@.Mathlib.Order.Hom.Basic._hyg.1298) (RelIso.toRelEmbedding.{u2, u1} M N (fun (x._@.Mathlib.Order.Hom.Basic._hyg.1281 : M) (x._@.Mathlib.Order.Hom.Basic._hyg.1283 : M) => LE.le.{u2} M (Preorder.toLE.{u2} M _inst_1) x._@.Mathlib.Order.Hom.Basic._hyg.1281 x._@.Mathlib.Order.Hom.Basic._hyg.1283) (fun (x._@.Mathlib.Order.Hom.Basic._hyg.1296 : N) (x._@.Mathlib.Order.Hom.Basic._hyg.1298 : N) => LE.le.{u1} N (Preorder.toLE.{u1} N (PartialOrder.toPreorder.{u1} N _inst_5)) x._@.Mathlib.Order.Hom.Basic._hyg.1296 x._@.Mathlib.Order.Hom.Basic._hyg.1298) e)) a) (FunLike.coe.{max (succ u2) (succ u1), succ u2, succ u1} (Function.Embedding.{succ u2, succ u1} M N) M (fun (_x : M) => (fun (x._@.Mathlib.Data.FunLike.Embedding._hyg.19 : M) => N) _x) (EmbeddingLike.toFunLike.{max (succ u2) (succ u1), succ u2, succ u1} (Function.Embedding.{succ u2, succ u1} M N) M N (Function.instEmbeddingLikeEmbedding.{succ u2, succ u1} M N)) (RelEmbedding.toEmbedding.{u2, u1} M N (fun (x._@.Mathlib.Order.Hom.Basic._hyg.1281 : M) (x._@.Mathlib.Order.Hom.Basic._hyg.1283 : M) => LE.le.{u2} M (Preorder.toLE.{u2} M _inst_1) x._@.Mathlib.Order.Hom.Basic._hyg.1281 x._@.Mathlib.Order.Hom.Basic._hyg.1283) (fun (x._@.Mathlib.Order.Hom.Basic._hyg.1296 : N) (x._@.Mathlib.Order.Hom.Basic._hyg.1298 : N) => LE.le.{u1} N (Preorder.toLE.{u1} N (PartialOrder.toPreorder.{u1} N _inst_5)) x._@.Mathlib.Order.Hom.Basic._hyg.1296 x._@.Mathlib.Order.Hom.Basic._hyg.1298) (RelIso.toRelEmbedding.{u2, u1} M N (fun (x._@.Mathlib.Order.Hom.Basic._hyg.1281 : M) (x._@.Mathlib.Order.Hom.Basic._hyg.1283 : M) => LE.le.{u2} M (Preorder.toLE.{u2} M _inst_1) x._@.Mathlib.Order.Hom.Basic._hyg.1281 x._@.Mathlib.Order.Hom.Basic._hyg.1283) (fun (x._@.Mathlib.Order.Hom.Basic._hyg.1296 : N) (x._@.Mathlib.Order.Hom.Basic._hyg.1298 : N) => LE.le.{u1} N (Preorder.toLE.{u1} N (PartialOrder.toPreorder.{u1} N _inst_5)) x._@.Mathlib.Order.Hom.Basic._hyg.1296 x._@.Mathlib.Order.Hom.Basic._hyg.1298) e)) b)))
Case conversion may be inaccurate. Consider using '#align order_iso.map_tsub OrderIso.map_tsubₓ'. -/
/-- An order isomorphism between types with ordered subtraction preserves subtraction provided that
it preserves addition. -/
theorem OrderIso.map_tsub {M N : Type _} [Preorder M] [Add M] [Sub M] [OrderedSub M]
    [PartialOrder N] [Add N] [Sub N] [OrderedSub N] (e : M ≃o N)
    (h_add : ∀ a b, e (a + b) = e a + e b) (a b : M) : e (a - b) = e a - e b :=
  by
  set e_add : M ≃+ N := { e with map_add' := h_add }
  refine' le_antisymm _ (e_add.to_add_hom.le_map_tsub e.monotone a b)
  suffices e (e.symm (e a) - e.symm (e b)) ≤ e (e.symm (e a - e b)) by simpa
  exact e.monotone (e_add.symm.to_add_hom.le_map_tsub e.symm.monotone _ _)
#align order_iso.map_tsub OrderIso.map_tsub

/-! ### Preorder -/

section Preorder

variable [Preorder α]

variable [AddCommMonoid α] [Sub α] [OrderedSub α] {a b c d : α}

/- warning: add_monoid_hom.le_map_tsub -> AddMonoidHom.le_map_tsub is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : Preorder.{u1} α] [_inst_2 : AddCommMonoid.{u1} α] [_inst_3 : Sub.{u1} α] [_inst_4 : OrderedSub.{u1} α (Preorder.toLE.{u1} α _inst_1) (AddZeroClass.toHasAdd.{u1} α (AddMonoid.toAddZeroClass.{u1} α (AddCommMonoid.toAddMonoid.{u1} α _inst_2))) _inst_3] [_inst_5 : Preorder.{u2} β] [_inst_6 : AddCommMonoid.{u2} β] [_inst_7 : Sub.{u2} β] [_inst_8 : OrderedSub.{u2} β (Preorder.toLE.{u2} β _inst_5) (AddZeroClass.toHasAdd.{u2} β (AddMonoid.toAddZeroClass.{u2} β (AddCommMonoid.toAddMonoid.{u2} β _inst_6))) _inst_7] (f : AddMonoidHom.{u1, u2} α β (AddMonoid.toAddZeroClass.{u1} α (AddCommMonoid.toAddMonoid.{u1} α _inst_2)) (AddMonoid.toAddZeroClass.{u2} β (AddCommMonoid.toAddMonoid.{u2} β _inst_6))), (Monotone.{u1, u2} α β _inst_1 _inst_5 (coeFn.{max (succ u2) (succ u1), max (succ u1) (succ u2)} (AddMonoidHom.{u1, u2} α β (AddMonoid.toAddZeroClass.{u1} α (AddCommMonoid.toAddMonoid.{u1} α _inst_2)) (AddMonoid.toAddZeroClass.{u2} β (AddCommMonoid.toAddMonoid.{u2} β _inst_6))) (fun (_x : AddMonoidHom.{u1, u2} α β (AddMonoid.toAddZeroClass.{u1} α (AddCommMonoid.toAddMonoid.{u1} α _inst_2)) (AddMonoid.toAddZeroClass.{u2} β (AddCommMonoid.toAddMonoid.{u2} β _inst_6))) => α -> β) (AddMonoidHom.hasCoeToFun.{u1, u2} α β (AddMonoid.toAddZeroClass.{u1} α (AddCommMonoid.toAddMonoid.{u1} α _inst_2)) (AddMonoid.toAddZeroClass.{u2} β (AddCommMonoid.toAddMonoid.{u2} β _inst_6))) f)) -> (forall (a : α) (b : α), LE.le.{u2} β (Preorder.toLE.{u2} β _inst_5) (HSub.hSub.{u2, u2, u2} β β β (instHSub.{u2} β _inst_7) (coeFn.{max (succ u2) (succ u1), max (succ u1) (succ u2)} (AddMonoidHom.{u1, u2} α β (AddMonoid.toAddZeroClass.{u1} α (AddCommMonoid.toAddMonoid.{u1} α _inst_2)) (AddMonoid.toAddZeroClass.{u2} β (AddCommMonoid.toAddMonoid.{u2} β _inst_6))) (fun (_x : AddMonoidHom.{u1, u2} α β (AddMonoid.toAddZeroClass.{u1} α (AddCommMonoid.toAddMonoid.{u1} α _inst_2)) (AddMonoid.toAddZeroClass.{u2} β (AddCommMonoid.toAddMonoid.{u2} β _inst_6))) => α -> β) (AddMonoidHom.hasCoeToFun.{u1, u2} α β (AddMonoid.toAddZeroClass.{u1} α (AddCommMonoid.toAddMonoid.{u1} α _inst_2)) (AddMonoid.toAddZeroClass.{u2} β (AddCommMonoid.toAddMonoid.{u2} β _inst_6))) f a) (coeFn.{max (succ u2) (succ u1), max (succ u1) (succ u2)} (AddMonoidHom.{u1, u2} α β (AddMonoid.toAddZeroClass.{u1} α (AddCommMonoid.toAddMonoid.{u1} α _inst_2)) (AddMonoid.toAddZeroClass.{u2} β (AddCommMonoid.toAddMonoid.{u2} β _inst_6))) (fun (_x : AddMonoidHom.{u1, u2} α β (AddMonoid.toAddZeroClass.{u1} α (AddCommMonoid.toAddMonoid.{u1} α _inst_2)) (AddMonoid.toAddZeroClass.{u2} β (AddCommMonoid.toAddMonoid.{u2} β _inst_6))) => α -> β) (AddMonoidHom.hasCoeToFun.{u1, u2} α β (AddMonoid.toAddZeroClass.{u1} α (AddCommMonoid.toAddMonoid.{u1} α _inst_2)) (AddMonoid.toAddZeroClass.{u2} β (AddCommMonoid.toAddMonoid.{u2} β _inst_6))) f b)) (coeFn.{max (succ u2) (succ u1), max (succ u1) (succ u2)} (AddMonoidHom.{u1, u2} α β (AddMonoid.toAddZeroClass.{u1} α (AddCommMonoid.toAddMonoid.{u1} α _inst_2)) (AddMonoid.toAddZeroClass.{u2} β (AddCommMonoid.toAddMonoid.{u2} β _inst_6))) (fun (_x : AddMonoidHom.{u1, u2} α β (AddMonoid.toAddZeroClass.{u1} α (AddCommMonoid.toAddMonoid.{u1} α _inst_2)) (AddMonoid.toAddZeroClass.{u2} β (AddCommMonoid.toAddMonoid.{u2} β _inst_6))) => α -> β) (AddMonoidHom.hasCoeToFun.{u1, u2} α β (AddMonoid.toAddZeroClass.{u1} α (AddCommMonoid.toAddMonoid.{u1} α _inst_2)) (AddMonoid.toAddZeroClass.{u2} β (AddCommMonoid.toAddMonoid.{u2} β _inst_6))) f (HSub.hSub.{u1, u1, u1} α α α (instHSub.{u1} α _inst_3) a b)))
but is expected to have type
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : Preorder.{u1} α] [_inst_2 : AddCommMonoid.{u1} α] [_inst_3 : Sub.{u1} α] [_inst_4 : OrderedSub.{u1} α (Preorder.toLE.{u1} α _inst_1) (AddZeroClass.toAdd.{u1} α (AddMonoid.toAddZeroClass.{u1} α (AddCommMonoid.toAddMonoid.{u1} α _inst_2))) _inst_3] [_inst_5 : Preorder.{u2} β] [_inst_6 : AddCommMonoid.{u2} β] [_inst_7 : Sub.{u2} β] [_inst_8 : OrderedSub.{u2} β (Preorder.toLE.{u2} β _inst_5) (AddZeroClass.toAdd.{u2} β (AddMonoid.toAddZeroClass.{u2} β (AddCommMonoid.toAddMonoid.{u2} β _inst_6))) _inst_7] (f : AddMonoidHom.{u1, u2} α β (AddMonoid.toAddZeroClass.{u1} α (AddCommMonoid.toAddMonoid.{u1} α _inst_2)) (AddMonoid.toAddZeroClass.{u2} β (AddCommMonoid.toAddMonoid.{u2} β _inst_6))), (Monotone.{u1, u2} α β _inst_1 _inst_5 (FunLike.coe.{max (succ u1) (succ u2), succ u1, succ u2} (AddMonoidHom.{u1, u2} α β (AddMonoid.toAddZeroClass.{u1} α (AddCommMonoid.toAddMonoid.{u1} α _inst_2)) (AddMonoid.toAddZeroClass.{u2} β (AddCommMonoid.toAddMonoid.{u2} β _inst_6))) α (fun (_x : α) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.403 : α) => β) _x) (AddHomClass.toFunLike.{max u1 u2, u1, u2} (AddMonoidHom.{u1, u2} α β (AddMonoid.toAddZeroClass.{u1} α (AddCommMonoid.toAddMonoid.{u1} α _inst_2)) (AddMonoid.toAddZeroClass.{u2} β (AddCommMonoid.toAddMonoid.{u2} β _inst_6))) α β (AddZeroClass.toAdd.{u1} α (AddMonoid.toAddZeroClass.{u1} α (AddCommMonoid.toAddMonoid.{u1} α _inst_2))) (AddZeroClass.toAdd.{u2} β (AddMonoid.toAddZeroClass.{u2} β (AddCommMonoid.toAddMonoid.{u2} β _inst_6))) (AddMonoidHomClass.toAddHomClass.{max u1 u2, u1, u2} (AddMonoidHom.{u1, u2} α β (AddMonoid.toAddZeroClass.{u1} α (AddCommMonoid.toAddMonoid.{u1} α _inst_2)) (AddMonoid.toAddZeroClass.{u2} β (AddCommMonoid.toAddMonoid.{u2} β _inst_6))) α β (AddMonoid.toAddZeroClass.{u1} α (AddCommMonoid.toAddMonoid.{u1} α _inst_2)) (AddMonoid.toAddZeroClass.{u2} β (AddCommMonoid.toAddMonoid.{u2} β _inst_6)) (AddMonoidHom.addMonoidHomClass.{u1, u2} α β (AddMonoid.toAddZeroClass.{u1} α (AddCommMonoid.toAddMonoid.{u1} α _inst_2)) (AddMonoid.toAddZeroClass.{u2} β (AddCommMonoid.toAddMonoid.{u2} β _inst_6))))) f)) -> (forall (a : α) (b : α), LE.le.{u2} ((fun (x._@.Mathlib.Algebra.Hom.Group._hyg.403 : α) => β) a) (Preorder.toLE.{u2} ((fun (x._@.Mathlib.Algebra.Hom.Group._hyg.403 : α) => β) a) _inst_5) (HSub.hSub.{u2, u2, u2} ((fun (x._@.Mathlib.Algebra.Hom.Group._hyg.403 : α) => β) a) ((fun (x._@.Mathlib.Algebra.Hom.Group._hyg.403 : α) => β) b) ((fun (x._@.Mathlib.Algebra.Hom.Group._hyg.403 : α) => β) a) (instHSub.{u2} ((fun (x._@.Mathlib.Algebra.Hom.Group._hyg.403 : α) => β) a) _inst_7) (FunLike.coe.{max (succ u1) (succ u2), succ u1, succ u2} (AddMonoidHom.{u1, u2} α β (AddMonoid.toAddZeroClass.{u1} α (AddCommMonoid.toAddMonoid.{u1} α _inst_2)) (AddMonoid.toAddZeroClass.{u2} β (AddCommMonoid.toAddMonoid.{u2} β _inst_6))) α (fun (_x : α) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.403 : α) => β) _x) (AddHomClass.toFunLike.{max u1 u2, u1, u2} (AddMonoidHom.{u1, u2} α β (AddMonoid.toAddZeroClass.{u1} α (AddCommMonoid.toAddMonoid.{u1} α _inst_2)) (AddMonoid.toAddZeroClass.{u2} β (AddCommMonoid.toAddMonoid.{u2} β _inst_6))) α β (AddZeroClass.toAdd.{u1} α (AddMonoid.toAddZeroClass.{u1} α (AddCommMonoid.toAddMonoid.{u1} α _inst_2))) (AddZeroClass.toAdd.{u2} β (AddMonoid.toAddZeroClass.{u2} β (AddCommMonoid.toAddMonoid.{u2} β _inst_6))) (AddMonoidHomClass.toAddHomClass.{max u1 u2, u1, u2} (AddMonoidHom.{u1, u2} α β (AddMonoid.toAddZeroClass.{u1} α (AddCommMonoid.toAddMonoid.{u1} α _inst_2)) (AddMonoid.toAddZeroClass.{u2} β (AddCommMonoid.toAddMonoid.{u2} β _inst_6))) α β (AddMonoid.toAddZeroClass.{u1} α (AddCommMonoid.toAddMonoid.{u1} α _inst_2)) (AddMonoid.toAddZeroClass.{u2} β (AddCommMonoid.toAddMonoid.{u2} β _inst_6)) (AddMonoidHom.addMonoidHomClass.{u1, u2} α β (AddMonoid.toAddZeroClass.{u1} α (AddCommMonoid.toAddMonoid.{u1} α _inst_2)) (AddMonoid.toAddZeroClass.{u2} β (AddCommMonoid.toAddMonoid.{u2} β _inst_6))))) f a) (FunLike.coe.{max (succ u1) (succ u2), succ u1, succ u2} (AddMonoidHom.{u1, u2} α β (AddMonoid.toAddZeroClass.{u1} α (AddCommMonoid.toAddMonoid.{u1} α _inst_2)) (AddMonoid.toAddZeroClass.{u2} β (AddCommMonoid.toAddMonoid.{u2} β _inst_6))) α (fun (_x : α) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.403 : α) => β) _x) (AddHomClass.toFunLike.{max u1 u2, u1, u2} (AddMonoidHom.{u1, u2} α β (AddMonoid.toAddZeroClass.{u1} α (AddCommMonoid.toAddMonoid.{u1} α _inst_2)) (AddMonoid.toAddZeroClass.{u2} β (AddCommMonoid.toAddMonoid.{u2} β _inst_6))) α β (AddZeroClass.toAdd.{u1} α (AddMonoid.toAddZeroClass.{u1} α (AddCommMonoid.toAddMonoid.{u1} α _inst_2))) (AddZeroClass.toAdd.{u2} β (AddMonoid.toAddZeroClass.{u2} β (AddCommMonoid.toAddMonoid.{u2} β _inst_6))) (AddMonoidHomClass.toAddHomClass.{max u1 u2, u1, u2} (AddMonoidHom.{u1, u2} α β (AddMonoid.toAddZeroClass.{u1} α (AddCommMonoid.toAddMonoid.{u1} α _inst_2)) (AddMonoid.toAddZeroClass.{u2} β (AddCommMonoid.toAddMonoid.{u2} β _inst_6))) α β (AddMonoid.toAddZeroClass.{u1} α (AddCommMonoid.toAddMonoid.{u1} α _inst_2)) (AddMonoid.toAddZeroClass.{u2} β (AddCommMonoid.toAddMonoid.{u2} β _inst_6)) (AddMonoidHom.addMonoidHomClass.{u1, u2} α β (AddMonoid.toAddZeroClass.{u1} α (AddCommMonoid.toAddMonoid.{u1} α _inst_2)) (AddMonoid.toAddZeroClass.{u2} β (AddCommMonoid.toAddMonoid.{u2} β _inst_6))))) f b)) (FunLike.coe.{max (succ u1) (succ u2), succ u1, succ u2} (AddMonoidHom.{u1, u2} α β (AddMonoid.toAddZeroClass.{u1} α (AddCommMonoid.toAddMonoid.{u1} α _inst_2)) (AddMonoid.toAddZeroClass.{u2} β (AddCommMonoid.toAddMonoid.{u2} β _inst_6))) α (fun (_x : α) => (fun (x._@.Mathlib.Algebra.Hom.Group._hyg.403 : α) => β) _x) (AddHomClass.toFunLike.{max u1 u2, u1, u2} (AddMonoidHom.{u1, u2} α β (AddMonoid.toAddZeroClass.{u1} α (AddCommMonoid.toAddMonoid.{u1} α _inst_2)) (AddMonoid.toAddZeroClass.{u2} β (AddCommMonoid.toAddMonoid.{u2} β _inst_6))) α β (AddZeroClass.toAdd.{u1} α (AddMonoid.toAddZeroClass.{u1} α (AddCommMonoid.toAddMonoid.{u1} α _inst_2))) (AddZeroClass.toAdd.{u2} β (AddMonoid.toAddZeroClass.{u2} β (AddCommMonoid.toAddMonoid.{u2} β _inst_6))) (AddMonoidHomClass.toAddHomClass.{max u1 u2, u1, u2} (AddMonoidHom.{u1, u2} α β (AddMonoid.toAddZeroClass.{u1} α (AddCommMonoid.toAddMonoid.{u1} α _inst_2)) (AddMonoid.toAddZeroClass.{u2} β (AddCommMonoid.toAddMonoid.{u2} β _inst_6))) α β (AddMonoid.toAddZeroClass.{u1} α (AddCommMonoid.toAddMonoid.{u1} α _inst_2)) (AddMonoid.toAddZeroClass.{u2} β (AddCommMonoid.toAddMonoid.{u2} β _inst_6)) (AddMonoidHom.addMonoidHomClass.{u1, u2} α β (AddMonoid.toAddZeroClass.{u1} α (AddCommMonoid.toAddMonoid.{u1} α _inst_2)) (AddMonoid.toAddZeroClass.{u2} β (AddCommMonoid.toAddMonoid.{u2} β _inst_6))))) f (HSub.hSub.{u1, u1, u1} α α α (instHSub.{u1} α _inst_3) a b)))
Case conversion may be inaccurate. Consider using '#align add_monoid_hom.le_map_tsub AddMonoidHom.le_map_tsubₓ'. -/
theorem AddMonoidHom.le_map_tsub [Preorder β] [AddCommMonoid β] [Sub β] [OrderedSub β] (f : α →+ β)
    (hf : Monotone f) (a b : α) : f a - f b ≤ f (a - b) :=
  f.toAddHom.le_map_tsub hf a b
#align add_monoid_hom.le_map_tsub AddMonoidHom.le_map_tsub

end Preorder


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

Hahn decomposition theorem

TODO:
* introduce finite measures (into nnreal)
* show general for signed measures (into ℝ)
-/
import measure_theory.measure_space

local attribute [instance, priority 0] classical.prop_decidable

namespace measure_theory
open set lattice filter

variables {α : Type*} [measurable_space α] {μ ν : measure α}

-- suddenly this is necessary?!
private lemma aux {m : ℕ} {γ d : ℝ} (h : γ - (1 / 2) ^ m < d) :
  γ - 2 * (1 / 2) ^ m + (1 / 2) ^ m ≤ d :=
by linarith

lemma hahn_decomposition (hμ : μ univ < ⊤) (hν : ν univ < ⊤) :
  ∃s, is_measurable s ∧
    (∀t, is_measurable t → t ⊆ s → ν t ≤ μ t) ∧
    (∀t, is_measurable t → t ⊆ - s → μ t ≤ ν t) :=
begin
  let d : set α → ℝ := λs, ((μ s).to_nnreal : ℝ) - (ν s).to_nnreal,
  let c : set ℝ := d '' {s | is_measurable s },
  let γ : ℝ := Sup c,

  have hμ : ∀s, μ s < ⊤ := assume s, lt_of_le_of_lt (measure_mono $ subset_univ _) hμ,
  have hν : ∀s, ν s < ⊤ := assume s, lt_of_le_of_lt (measure_mono $ subset_univ _) hν,
  have to_nnreal_μ : ∀s, ((μ s).to_nnreal : ennreal) = μ s :=
    (assume s, ennreal.coe_to_nnreal $ ne_top_of_lt $ hμ _),
  have to_nnreal_ν : ∀s, ((ν s).to_nnreal : ennreal) = ν s :=
    (assume s, ennreal.coe_to_nnreal $ ne_top_of_lt $ hν _),

  have d_empty : d ∅ = 0, { simp [d], rw [measure_empty, measure_empty], simp },

  have d_split : ∀s t, is_measurable s → is_measurable t →
    d s = d (s \ t) + d (s ∩ t),
  { assume s t hs ht,
    simp only [d],
    rw [measure_eq_inter_diff hs ht, measure_eq_inter_diff hs ht,
      ennreal.to_nnreal_add (hμ _) (hμ _), ennreal.to_nnreal_add (hν _) (hν _),
      nnreal.coe_add, nnreal.coe_add],
    simp only [sub_eq_add_neg, neg_add],
    ac_refl },

  have d_Union : ∀(s : ℕ → set α), (∀n, is_measurable (s n)) → monotone s →
    tendsto (λn, d (s n)) at_top (nhds (d (⋃n, s n))),
  { assume s hs hm,
    refine tendsto_sub _ _;
      refine (nnreal.tendsto_coe.2 $
        (tendsto_measure_Union hs hm).comp $ ennreal.tendsto_to_nnreal $ @ne_top_of_lt _ _ _ ⊤ _),
    exact hμ _,
    exact hν _ },

  have d_Inter : ∀(s : ℕ → set α), (∀n, is_measurable (s n)) → (∀n m, n ≤ m → s m ⊆ s n) →
    tendsto (λn, d (s n)) at_top (nhds (d (⋂n, s n))),
  { assume s hs hm,
    refine tendsto_sub _ _;
      refine (nnreal.tendsto_coe.2 $
        (tendsto_measure_Inter hs hm _).comp $ ennreal.tendsto_to_nnreal $ @ne_top_of_lt _ _ _ ⊤ _),
    exact ⟨0, hμ _⟩,
    exact hμ _,
    exact ⟨0, hν _⟩,
    exact hν _ },

  have bdd_c : bdd_above c,
  { use (μ univ).to_nnreal,
    rintros r ⟨s, hs, rfl⟩,
    refine le_trans (sub_le_self _ $ nnreal.coe_nonneg _) _,
    rw [← nnreal.coe_le, ← ennreal.coe_le_coe, to_nnreal_μ, to_nnreal_μ],
    exact measure_mono (subset_univ _) },

  have c_nonempty : c ≠ ∅ := ne_empty_of_mem (mem_image_of_mem _ is_measurable.empty),

  have d_le_γ : ∀s, is_measurable s → d s ≤ γ := assume s hs, le_cSup bdd_c ⟨s, hs, rfl⟩,

  have : ∀n:ℕ, ∃s : set α, is_measurable s ∧ γ - (1/2)^n < d s,
  { assume n,
    have : γ - (1/2)^n < γ := sub_lt_self γ (pow_pos (half_pos zero_lt_one) n),
    rcases exists_lt_of_lt_cSup c_nonempty this with ⟨r, ⟨s, hs, rfl⟩, hlt⟩,
    exact ⟨s, hs, hlt⟩ },
  rcases classical.axiom_of_choice this with ⟨e, he⟩,
  change ℕ → set α at e,
  have he₁ : ∀n, is_measurable (e n) := assume n, (he n).1,
  have he₂ : ∀n, γ - (1/2)^n < d (e n) := assume n, (he n).2,

  let f : ℕ → ℕ → set α := λn m, (finset.Ico n (m + 1)).inf e,

  have hf : ∀n m, is_measurable (f n m),
  { assume n m,
    simp only [f, finset.inf_eq_infi],
    exact is_measurable.bInter (countable_encodable _) (assume i _, he₁ _) },

  have f_subset_f : ∀{a b c d}, a ≤ b → c ≤ d → f a d ⊆ f b c,
  { assume a b c d hab hcd,
    dsimp only [f],
    rw [finset.inf_eq_infi, finset.inf_eq_infi],
    refine bInter_subset_bInter_left _,
    simp,
    rintros j ⟨hbj, hjc⟩,
    exact ⟨le_trans hab hbj, lt_of_lt_of_le hjc $ add_le_add_right hcd 1⟩ },

  have f_succ : ∀n m, n ≤ m → f n (m + 1) = f n m ∩ e (m + 1),
  { assume n m hnm,
    have : n ≤ m + 1 := le_of_lt (nat.succ_le_succ hnm),
    simp only [f],
    rw [finset.Ico.succ_top this, finset.inf_insert, set.inter_comm],
    refl },

  have le_d_f : ∀n m, m ≤ n → γ - 2 * ((1 / 2) ^ m) + (1 / 2) ^ n ≤ d (f m n),
  { assume n m h,
    refine nat.le_induction _ _ n h,
    { have := he₂ m,
      simp only [f],
      rw [finset.Ico.succ_singleton, finset.inf_singleton],
      exact aux this },
    { assume n (hmn : m ≤ n) ih,
      have : γ + (γ - 2 * (1 / 2)^m + (1 / 2) ^ (n + 1)) ≤ γ + d (f m (n + 1)),
      { calc γ + (γ - 2 * (1 / 2)^m + (1 / 2) ^ (n+1)) ≤
            γ + (γ - 2 * (1 / 2)^m + ((1 / 2) ^ n - (1/2)^(n+1))) :
          begin
            refine add_le_add_left (add_le_add_left _ _) γ,
            simp only [pow_add, pow_one, le_sub_iff_add_le],
            linarith
          end
          ... = (γ - (1 / 2)^(n+1)) + (γ - 2 * (1 / 2)^m + (1 / 2)^n) :
            by simp only [sub_eq_add_neg]; ac_refl
          ... ≤ d (e (n + 1)) + d (f m n) : add_le_add (le_of_lt $ he₂ _) ih
          ... ≤ d (e (n + 1)) + d (f m n \ e (n + 1)) + d (f m (n + 1)) :
            by rw [f_succ _ _ hmn, d_split (f m n) (e (n + 1)) (hf _ _) (he₁ _), add_assoc]
          ... = d (e (n + 1) ∪ f m n) + d (f m (n + 1)) :
            begin
              rw [d_split (e (n + 1) ∪ f m n) (e (n + 1)),
                union_diff_left, union_inter_cancel_left],
              ac_refl,
              exact (he₁ _).union (hf _ _),
              exact (he₁ _)
            end
          ... ≤ γ + d (f m (n + 1)) :
            add_le_add_right (d_le_γ _ $ (he₁ _).union (hf _ _)) _ },
      exact (add_le_add_iff_left γ).1 this } },

  let s := ⋃ m, ⋂n, f m n,
  have γ_le_d_s : γ ≤ d s,
  { have hγ : tendsto (λm:ℕ, γ - 2 * (1/2)^m) at_top (nhds γ),
    { suffices : tendsto (λm:ℕ, γ - 2 * (1/2)^m) at_top (nhds (γ - 2 * 0)), { simpa },
      exact (tendsto_sub tendsto_const_nhds $ tendsto_mul tendsto_const_nhds $
        tendsto_pow_at_top_nhds_0_of_lt_1
          (le_of_lt $ half_pos $ zero_lt_one) (half_lt_self zero_lt_one)) },
    have hd : tendsto (λm, d (⋂n, f m n)) at_top (nhds (d (⋃ m, ⋂ n, f m n))),
    { refine d_Union _ _ _,
      { assume n, exact is_measurable.Inter (assume m, hf _ _) },
      { exact assume n m hnm, subset_Inter
          (assume i, subset.trans (Inter_subset (f n) i) $ f_subset_f hnm $ le_refl _) } },
    refine le_of_tendsto_of_tendsto (@at_top_ne_bot ℕ _ _) hγ hd (univ_mem_sets' $ assume m, _),
    change γ - 2 * (1 / 2) ^ m ≤ d (⋂ (n : ℕ), f m n),
    have : tendsto (λn, d (f m n)) at_top (nhds (d (⋂ n, f m n))),
    { refine d_Inter _ _ _,
      { assume n, exact hf _ _ },
      { assume n m hnm, exact f_subset_f (le_refl _) hnm } },
    refine ge_of_tendsto (@at_top_ne_bot ℕ _ _) this (mem_at_top_sets.2 ⟨m, assume n hmn, _⟩),
    change γ - 2 * (1 / 2) ^ m ≤ d (f m n),
    refine le_trans _ (le_d_f _ _ hmn),
    exact le_add_of_le_of_nonneg (le_refl _) (pow_nonneg (le_of_lt $ half_pos $ zero_lt_one) _) },

  have hs : is_measurable s :=
    is_measurable.Union (assume n, is_measurable.Inter (assume m, hf _ _)),
  refine ⟨s, hs, _, _⟩,
  { assume t ht hts,
    have : 0 ≤ d t := ((add_le_add_iff_left γ).1 $
      calc γ + 0 ≤ d s : by rw [add_zero]; exact γ_le_d_s
        ... = d (s \ t) + d t : by rw [d_split _ _ hs ht, inter_eq_self_of_subset_right hts]
        ... ≤ γ + d t : add_le_add (d_le_γ _ (hs.diff ht)) (le_refl _)),
    rw [← to_nnreal_μ, ← to_nnreal_ν, ennreal.coe_le_coe, nnreal.coe_le],
    simpa only [d, le_sub_iff_add_le, zero_add] using this },
  { assume t ht hts,
    have : d t ≤ 0,
    exact ((add_le_add_iff_left γ).1 $
      calc γ + d t ≤ d s + d t : add_le_add γ_le_d_s (le_refl _)
        ... = d (s ∪ t) :
        begin
          rw [d_split _ _ (hs.union ht) ht, union_diff_right, union_inter_cancel_right,
            diff_eq_self.2],
          exact assume a ⟨hat, has⟩, hts hat has
        end
        ... ≤ γ + 0 : by rw [add_zero]; exact d_le_γ _ (hs.union ht)),
    rw [← to_nnreal_μ, ← to_nnreal_ν, ennreal.coe_le_coe, nnreal.coe_le],
    simpa only [d, sub_le_iff_le_add, zero_add] using this }
end

end measure_theory


/-
Copyright (c) 2018 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Scott Morrison
-/
import Mathlib.Tactic.NormNum
import Mathlib.Util.AtomM
import Mathlib.Data.Int.Basic

/-!
# The `abel` tactic

Evaluate expressions in the language of additive, commutative monoids and groups.

-/

namespace Mathlib.Tactic.Abel
open Lean Elab Meta Tactic Qq

initialize registerTraceClass `abel
initialize registerTraceClass `abel.detail

/-- The `Context` for a call to `abel`.

Stores a few options for this call, and caches some common subexpressions
such as typeclass instances and `0 : α`.
-/
structure Context where
  /-- The type of the ambient additive commutative group or monoid. -/
  α       : Expr
  /-- The universe level for `α`. -/
  univ    : Level
  /-- The expression representing `0 : α`. -/
  α0      : Expr
  /-- Specify whether we are in an additive commutative group or an additive commutative monoid. -/
  isGroup : Bool
  /-- The `AddCommGroup α` or `AddCommMonoid α` expression. -/
  inst    : Expr

/-- Populate a `context` object for evaluating `e`. -/
def mkContext (e : Expr) : MetaM Context := do
  let α ← inferType e
  let c ← synthInstance (← mkAppM ``AddCommMonoid #[α])
  let cg ← synthInstance? (← mkAppM ``AddCommGroup #[α])
  let u ← mkFreshLevelMVar
  _ ← isDefEq (.sort (.succ u)) (← inferType α)
  let α0 ← Expr.ofNat α 0
  match cg with
  | some cg => return ⟨α, u, α0, true, cg⟩
  | _ => return ⟨α, u, α0, false, c⟩

/-- The monad for `Abel` contains, in addition to the `AtomM` state,
some information about the current type we are working over, so that we can consistently
use group lemmas or monoid lemmas as appropriate. -/
abbrev M := ReaderT Context AtomM

/-- Apply the function `n : ∀ {α} [inst : AddWhatever α], _` to the
implicit parameters in the context, and the given list of arguments. -/
def Context.app (c : Context) (n : Name) (inst : Expr) : Array Expr → Expr :=
  mkAppN (((@Expr.const n [c.univ]).app c.α).app inst)

/-- Apply the function `n : ∀ {α} [inst α], _` to the implicit parameters in the
context, and the given list of arguments.

Compared to `context.app`, this takes the name of the typeclass, rather than an
inferred typeclass instance.
-/
def Context.mkApp (c : Context) (n inst : Name) (l : Array Expr) : MetaM Expr := do
  return c.app n (← synthInstance ((Expr.const inst [c.univ]).app c.α)) l

/-- Add the letter "g" to the end of the name, e.g. turning `term` into `termg`.

This is used to choose between declarations taking `AddCommMonoid` and those
taking `AddCommGroup` instances.
-/
def addG : Name → Name
  | .str p s => .str p (s ++ "g")
  | n => n

/-- Apply the function `n : ∀ {α} [AddComm{Monoid,Group} α]` to the given list of arguments.

Will use the `AddComm{Monoid,Group}` instance that has been cached in the context.
-/
def iapp (n : Name) (xs : Array Expr) : M Expr := do
  let c ← read
  return c.app (if c.isGroup then addG n else n) c.inst xs

/-- A type synonym used by `abel` to represent `n • x + a` in an additive commutative monoid. -/
def term {α} [AddCommMonoid α] (n : ℕ) (x a : α) : α := n • x + a
/-- A type synonym used by `abel` to represent `n • x + a` in an additive commutative group. -/
def termg {α} [AddCommGroup α] (n : ℤ) (x a : α) : α := n • x + a

/-- Evaluate a term with coefficient `n`, atom `x` and successor terms `a`. -/
def mkTerm (n x a : Expr) : M Expr := iapp ``term #[n, x, a]

/-- Interpret an integer as a coefficient to a term. -/
def intToExpr (n : ℤ) : M Expr := do
  Expr.ofInt (mkConst (if (← read).isGroup then ``Int else ``Nat) []) n

/-- A normal form for `abel`.
Expressions are represented as a list of terms of the form `e = n • x`,
where `n : ℤ` and `x` is an arbitrary element of the additive commutative monoid or group.
We explicitly track the `Expr` forms of `e` and `n`, even though they could be reconstructed,
for efficiency. -/
inductive NormalExpr : Type
  | zero (e : Expr) : NormalExpr
  | nterm (e : Expr) (n : Expr × ℤ) (x : ℕ × Expr) (a : NormalExpr) : NormalExpr
  deriving Inhabited

/-- Extract the expression from a normal form. -/
def NormalExpr.e : NormalExpr → Expr
  | .zero e => e
  | .nterm e .. => e

instance : Coe NormalExpr Expr where coe := NormalExpr.e

/-- Construct the normal form representing a single term. -/
def NormalExpr.term' (n : Expr × ℤ) (x : ℕ × Expr) (a : NormalExpr) : M NormalExpr :=
  return .nterm (← mkTerm n.1 x.2 a) n x a

/-- Construct the normal form representing zero. -/
def NormalExpr.zero' : M NormalExpr := return NormalExpr.zero (← read).α0

open NormalExpr

theorem const_add_term {α} [AddCommMonoid α] (k n x a a') (h : k + a = a') :
    k + @term α _ n x a = term n x a' := by
  simp [h.symm, term, add_comm, add_assoc]

theorem const_add_termg {α} [AddCommGroup α] (k n x a a') (h : k + a = a') :
    k + @termg α _ n x a = termg n x a' := by
  simp [h.symm, termg, add_comm, add_assoc]

theorem term_add_const {α} [AddCommMonoid α] (n x a k a') (h : a + k = a') :
    @term α _ n x a + k = term n x a' := by
  simp [h.symm, term, add_assoc]

theorem term_add_constg {α} [AddCommGroup α] (n x a k a') (h : a + k = a') :
    @termg α _ n x a + k = termg n x a' := by
  simp [h.symm, termg, add_assoc]

theorem term_add_term {α} [AddCommMonoid α] (n₁ x a₁ n₂ a₂ n' a') (h₁ : n₁ + n₂ = n')
    (h₂ : a₁ + a₂ = a') : @term α _ n₁ x a₁ + @term α _ n₂ x a₂ = term n' x a' := by
  simp [h₁.symm, h₂.symm, term, add_nsmul, add_assoc, add_left_comm]

theorem term_add_termg {α} [AddCommGroup α] (n₁ x a₁ n₂ a₂ n' a')
    (h₁ : n₁ + n₂ = n') (h₂ : a₁ + a₂ = a') :
    @termg α _ n₁ x a₁ + @termg α _ n₂ x a₂ = termg n' x a' := by
  simp [h₁.symm, h₂.symm, termg, add_zsmul]
  exact add_add_add_comm (n₁ • x) a₁ (n₂ • x) a₂

theorem zero_term {α} [AddCommMonoid α] (x a) : @term α _ 0 x a = a := by
  simp [term, zero_nsmul, one_nsmul]

theorem zero_termg {α} [AddCommGroup α] (x a) : @termg α _ 0 x a = a := by
  simp [termg, zero_zsmul]

/--
Intepret the sum of two expressions in `abel`'s normal form.
-/
partial def evalAdd : NormalExpr → NormalExpr → M (NormalExpr × Expr)
  | zero _, e₂ => do
    let p ← mkAppM ``zero_add #[e₂]
    return (e₂, p)
  | e₁, zero _ => do
    let p ← mkAppM ``add_zero #[e₁]
    return (e₁, p)
  | he₁@(nterm e₁ n₁ x₁ a₁), he₂@(nterm e₂ n₂ x₂ a₂) => do
    if x₁.1 = x₂.1 then
      let n' ← Mathlib.Meta.NormNum.eval (← mkAppM ``HAdd.hAdd #[n₁.1, n₂.1])
      let (a', h₂) ← evalAdd a₁ a₂
      let k := n₁.2 + n₂.2
      let p₁ ← iapp ``term_add_term
        #[n₁.1, x₁.2, a₁, n₂.1, a₂, n'.expr, a', ← n'.getProof, h₂]
      if k = 0 then do
        let p ← mkEqTrans p₁ (← iapp ``zero_term #[x₁.2, a'])
        return (a', p)
      else return (← term' (n'.expr, k) x₁ a', p₁)
    else if x₁.1 < x₂.1 then do
      let (a', h) ← evalAdd a₁ he₂
      return (← term' n₁ x₁ a', ← iapp ``term_add_const #[n₁.1, x₁.2, a₁, e₂, a', h])
    else do
      let (a', h) ← evalAdd he₁ a₂
      return (← term' n₂ x₂ a', ← iapp ``const_add_term #[e₁, n₂.1, x₂.2, a₂, a', h])

theorem term_neg {α} [AddCommGroup α] (n x a n' a')
    (h₁ : -n = n') (h₂ : -a = a') : -@termg α _ n x a = termg n' x a' := by
  simp [h₂.symm, h₁.symm, termg]; exact add_comm _ _

/--
Interpret a negated expression in `abel`'s normal form.
-/
def evalNeg : NormalExpr → M (NormalExpr × Expr)
  | (zero _) => do
    let p ← (← read).mkApp ``neg_zero ``NegZeroClass #[]
    return (← zero', p)
  | (nterm _ n x a) => do
    let n' ← Mathlib.Meta.NormNum.eval (← mkAppM ``Neg.neg #[n.1])
    let (a', h₂) ← evalNeg a
    return (← term' (n'.expr, -n.2) x a',
      (← read).app ``term_neg (← read).inst #[n.1, x.2, a, n'.expr, a', ← n'.getProof, h₂])

/-- A synonym for `•`, used internally in `abel`. -/
def smul {α} [AddCommMonoid α] (n : ℕ) (x : α) : α := n • x
/-- A synonym for `•`, used internally in `abel`. -/
def smulg {α} [AddCommGroup α] (n : ℤ) (x : α) : α := n • x

theorem zero_smul {α} [AddCommMonoid α] (c) : smul c (0 : α) = 0 := by
  simp [smul, nsmul_zero]

theorem zero_smulg {α} [AddCommGroup α] (c) : smulg c (0 : α) = 0 := by
  simp [smulg, zsmul_zero]

theorem term_smul {α} [AddCommMonoid α] (c n x a n' a')
  (h₁ : c * n = n') (h₂ : smul c a = a') :
  smul c (@term α _ n x a) = term n' x a' := by
  simp [h₂.symm, h₁.symm, term, smul, nsmul_add, mul_nsmul']

theorem term_smulg {α} [AddCommGroup α] (c n x a n' a')
  (h₁ : c * n = n') (h₂ : smulg c a = a') :
  smulg c (@termg α _ n x a) = termg n' x a' := by
  simp [h₂.symm, h₁.symm, termg, smulg, zsmul_add, mul_zsmul]

/--
Auxiliary function for `evalSMul'`.
-/
def evalSMul (k : Expr × ℤ) : NormalExpr → M (NormalExpr × Expr)
  | zero _ => return (← zero', ← iapp ``zero_smul #[k.1])
  | nterm _ n x a => do
    let n' ← Mathlib.Meta.NormNum.eval (← mkAppM ``HMul.hMul #[k.1, n.1])
    let (a', h₂) ← evalSMul k a
    return (← term' (n'.expr, k.2 * n.2) x a',
      ← iapp ``term_smul #[k.1, n.1, x.2, a, n'.expr, a', ← n'.getProof, h₂])

theorem term_atom {α} [AddCommMonoid α] (x : α) : x = term 1 x 0 := by simp [term]
theorem term_atomg {α} [AddCommGroup α] (x : α) : x = termg 1 x 0 := by simp [termg]
theorem term_atom_pf {α} [AddCommMonoid α] (x x' : α) (h : x = x') : x = term 1 x' 0 := by
  simp [term, h]
theorem term_atom_pfg {α} [AddCommGroup α] (x x' : α) (h : x = x') : x = termg 1 x' 0 := by
  simp [termg, h]

/-- Interpret an expression as an atom for `abel`'s normal form. -/
def evalAtom (e : Expr) : M (NormalExpr × Expr) := do
  let { expr := e', proof?, .. } ← (← readThe AtomM.Context).evalAtom e
  let i ← AtomM.addAtom e'
  let p ← match proof? with
  | none => iapp ``term_atom #[e]
  | some p => iapp ``term_atom_pf #[e, e', p]
  return (← term' (← intToExpr 1, 1) (i, e') (← zero'), p)

theorem unfold_sub {α} [SubtractionMonoid α] (a b c : α) (h : a + -b = c) : a - b = c := by
  rw [sub_eq_add_neg, h]

theorem unfold_smul {α} [AddCommMonoid α] (n) (x y : α)
    (h : smul n x = y) : n • x = y := h

theorem unfold_smulg {α} [AddCommGroup α] (n : ℕ) (x y : α)
    (h : smulg (Int.ofNat n) x = y) : (n : ℤ) • x = y := h

theorem unfold_zsmul {α} [AddCommGroup α] (n : ℤ) (x y : α)
    (h : smulg n x = y) : n • x = y := h

lemma subst_into_smul {α} [AddCommMonoid α]
    (l r tl tr t) (prl : l = tl) (prr : r = tr)
    (prt : @smul α _ tl tr = t) : smul l r = t := by simp [prl, prr, prt]

lemma subst_into_smulg {α} [AddCommGroup α]
    (l r tl tr t) (prl : l = tl) (prr : r = tr)
    (prt : @smulg α _ tl tr = t) : smulg l r = t := by simp [prl, prr, prt]

lemma subst_into_smul_upcast {α} [AddCommGroup α]
    (l r tl zl tr t) (prl₁ : l = tl) (prl₂ : ↑tl = zl) (prr : r = tr)
    (prt : @smulg α _ zl tr = t) : smul l r = t := by
  simp [← prt, prl₁, ← prl₂, prr, smul, smulg, coe_nat_zsmul]

lemma subst_into_add {α} [AddCommMonoid α] (l r tl tr t)
    (prl : (l : α) = tl) (prr : r = tr) (prt : tl + tr = t) : l + r = t := by
  rw [prl, prr, prt]

lemma subst_into_addg {α} [AddCommGroup α] (l r tl tr t)
    (prl : (l : α) = tl) (prr : r = tr) (prt : tl + tr = t) : l + r = t := by
  rw [prl, prr, prt]

lemma subst_into_negg {α} [AddCommGroup α] (a ta t : α)
    (pra : a = ta) (prt : -ta = t) : -a = t := by
  simp [pra, prt]

/-- Normalize a term `orig` of the form `smul e₁ e₂` or `smulg e₁ e₂`.
  Normalized terms use `smul` for monoids and `smulg` for groups,
  so there are actually four cases to handle:
  * Using `smul` in a monoid just simplifies the pieces using `subst_into_smul`
  * Using `smulg` in a group just simplifies the pieces using `subst_into_smulg`
  * Using `smul a b` in a group requires converting `a` from a nat to an int and
    then simplifying `smulg ↑a b` using `subst_into_smul_upcast`
  * Using `smulg` in a monoid is impossible (or at least out of scope),
    because you need a group argument to write a `smulg` term -/
def evalSMul' (eval : Expr → M (NormalExpr × Expr))
    (is_smulg : Bool) (orig e₁ e₂ : Expr) : M (NormalExpr × Expr) := do
  trace[abel] "Calling NormNum on {e₁}"
  let ⟨e₁', p₁, _⟩ ← try Meta.NormNum.eval e₁ catch _ => pure { expr := e₁ }
  let p₁ ← p₁.getDM (mkEqRefl e₁')
  match Meta.NormNum.isIntLit e₁' with
  | some n => do
    let c ← read
    let (e₂', p₂) ← eval e₂
    if c.isGroup = is_smulg then do
      let (e', p) ← evalSMul (e₁', n) e₂'
      return (e', ← iapp ``subst_into_smul #[e₁, e₂, e₁', e₂', e', p₁, p₂, p])
    else do
      if ¬ c.isGroup then throwError "Doesn't make sense to us `smulg` in a monoid. "
      -- We are multiplying by a natural number in an additive group.
      let zl ← Expr.ofInt q(ℤ) n
      let p₁' ← mkEqRefl zl
      let (e', p) ← evalSMul (zl, n) e₂'
      return (e', c.app ``subst_into_smul_upcast c.inst #[e₁, e₂, e₁', zl, e₂', e', p₁, p₁', p₂, p])
  | none => evalAtom orig

/-- Evaluate an expression into its `abel` normal form, by recursing into subexpressions. -/
partial def eval (e : Expr) : M (NormalExpr × Expr) := do
  trace[abel.detail] "running eval on {e}"
  trace[abel.detail] "getAppFnArgs: {e.getAppFnArgs}"
  match e.getAppFnArgs with
  | (``HAdd.hAdd, #[_, _, _, _, e₁, e₂]) => do
    let (e₁', p₁) ← eval e₁
    let (e₂', p₂) ← eval e₂
    let (e', p') ← evalAdd e₁' e₂'
    return (e', ← iapp ``subst_into_add #[e₁, e₂, e₁', e₂', e', p₁, p₂, p'])
  | (``HSub.hSub, #[_, _, _ ,_, e₁, e₂]) => do
    let e₂' ← mkAppM ``Neg.neg #[e₂]
    let e ← mkAppM ``HAdd.hAdd #[e₁, e₂']
    let (e', p) ← eval e
    let p' ← (← read).mkApp ``unfold_sub ``SubtractionMonoid #[e₁, e₂, e', p]
    return (e', p')
  | (``Neg.neg, #[_, _, e]) => do
    let (e₁, p₁) ← eval e
    let (e₂, p₂) ← evalNeg e₁
    return (e₂, ← iapp `Mathlib.Tactic.Abel.subst_into_neg #[e, e₁, e₂, p₁, p₂])
  | (`AddMonoid.nsmul, #[_, _, e₁, e₂]) => do
    let n ← if (← read).isGroup then mkAppM ``Int.ofNat #[e₁] else pure e₁
    let (e', p) ← eval <| ← iapp ``smul #[n, e₂]
    return (e', ← iapp ``unfold_smul #[e₁, e₂, e', p])
  | (``SubNegMonoid.zsmul, #[_, _, e₁, e₂]) => do
      if ¬ (← read).isGroup then failure
      let (e', p) ← eval <| ← iapp ``smul #[e₁, e₂]
      return (e', (← read).app ``unfold_zsmul (← read).inst #[e₁, e₂, e', p])
  | (``SMul.smul, #[.const ``Int _, _, _, e₁, e₂]) =>
    evalSMul' eval true e e₁ e₂
  | (``SMul.smul, #[.const ``Nat _, _, _, e₁, e₂]) =>
    evalSMul' eval false e e₁ e₂
  | (``HSMul.hSMul, #[.const ``Int _, _, _, _, e₁, e₂]) =>
    evalSMul' eval true e e₁ e₂
  | (``HSMul.hSMul, #[.const ``Nat _, _, _, _, e₁, e₂]) =>
    evalSMul' eval false e e₁ e₂
  | (``smul, #[_, _, e₁, e₂]) => evalSMul' eval false e e₁ e₂
  | (``smulg, #[_, _, e₁, e₂]) => evalSMul' eval true e e₁ e₂
  | (``OfNat.ofNat, #[_, .lit (.natVal 0), _])
  | (``Zero.zero, #[_, _]) =>
    if ← isDefEq e (← read).α0 then
      pure (← zero', ← mkEqRefl (← read).α0)
    else
      evalAtom e
  | _ => evalAtom e

/-- Tactic for solving equations in the language of
*additive*, commutative monoids and groups.
This version of `abel` fails if the target is not an equality
that is provable by the axioms of commutative monoids/groups.

`abel1!` will use a more aggressive reducibility setting to identify atoms.
This can prove goals that `abel` cannot, but is more expensive.
-/
syntax (name := abel1) "abel1" "!"? : tactic

open Lean Elab Meta Tactic

/-- The `abel1` tactic, which solves equations in the language of commutative additive groups
(or monoids). -/
elab_rules : tactic | `(tactic| abel1 $[!%$tk]?) => withMainContext do
  let tm := if tk.isSome then .default else .reducible
  let some (_, e₁, e₂) := (← whnfR <| ← getMainTarget).eq?
    | throwError "abel1 requires an equality goal"
  trace[abel] "running on an equality `{e₁} = {e₂}`."
  let c ← mkContext e₁
  closeMainGoal <| ← AtomM.run tm <| ReaderT.run (r := c) do
    let (e₁', p₁) ← eval e₁
    trace[abel] "found `{p₁}`, a proof that `{e₁} = {e₁'.e}`"
    let (e₂', p₂) ← eval e₂
    trace[abel] "found `{p₂}`, a proof that `{e₂} = {e₂'.e}`"
    unless ← isDefEq e₁' e₂' do
      throwError "abel1 found that the two sides were not equal"
    trace[abel] "verified that the simplified forms are identical"
    mkEqTrans p₁ (← mkEqSymm p₂)

@[inherit_doc abel1] macro (name := abel1!) "abel1!" : tactic => `(tactic| abel1 !)

/-- True if this represents an atomic expression. -/
def NormalExpr.isAtom : NormalExpr → Bool
  | .nterm _ (_, 1) _ (.zero _) => true
  | _ => false

/-- The normalization style for `abel_nf`. -/
inductive AbelMode where
  /-- The default form -/
  | term
  /-- Raw form: the representation `abel` uses internally. -/
  | raw

/-- Configuration for `abel_nf`. -/
structure AbelNF.Config where
  /-- the reducibility setting to use when comparing atoms for defeq -/
  red := TransparencyMode.reducible
  /-- if true, atoms inside ring expressions will be reduced recursively -/
  recursive := true
  /-- The normalization style. -/
  mode := AbelMode.term

/-- Function elaborating `AbelNF.Config`. -/
declare_config_elab elabAbelNFConfig AbelNF.Config

/--
The core of `abel_nf`, which rewrites the expression `e` into `abel` normal form.

* `cfg`: the configuration options
* `e`: the expression to rewrite
-/
partial def abelNFCore (cfg : AbelNF.Config) (e : Expr) : MetaM Simp.Result := do
  let ctx := {
    simpTheorems := #[← Elab.Tactic.simpOnlyBuiltins.foldlM (·.addConst ·) {}]
    congrTheorems := ← getSimpCongrTheorems }
  let simp ← match cfg.mode with
  | .raw => pure pure
  | .term =>
    let thms := [``term_eq, ``termg_eq, ``add_zero, ``one_nsmul, ``one_zsmul, ``zsmul_zero]
    let ctx' := { ctx with simpTheorems := #[← thms.foldlM (·.addConst ·) {:_}] }
    pure fun r' : Simp.Result ↦ do
      Simp.mkEqTrans r' (← Simp.main r'.expr ctx' (methods := Simp.DefaultMethods.methods)).1
  let rec
    /-- The recursive case of `abelNF`.
    * `root`: true when the function is called directly from `abelNFCore`
      and false when called by `evalAtom` in recursive mode.
    * `parent`: The input expression to simplify. In `pre` we make use of both `parent` and `e`
      to determine if we are at the top level in order to prevent a loop
      `go -> eval -> evalAtom -> go` which makes no progress.
    -/
    go root parent :=
      let pre e :=
        try
          guard <| root || parent != e -- recursion guard
          let e ← withReducible <| whnf e
          guard e.isApp -- all interesting group expressions are applications
          let (a, pa) ← eval e |>.run (← mkContext e) |>.run cfg.red (evalAtom := evalAtom)
          guard !a.isAtom
          let r ← simp { expr := a, proof? := pa }
          if ← withReducible <| isDefEq r.expr e then return .done { expr := r.expr }
          pure (.done r)
        catch _ => pure <| .visit { expr := e }
      let post := (Simp.postDefault · fun _ ↦ none)
      (·.1) <$> Simp.main parent ctx (methods := { pre, post }),
    /-- The `evalAtom` implementation passed to `eval` calls `go` if `cfg.recursive` is true,
    and does nothing otherwise. -/
    evalAtom := if cfg.recursive then go false else fun e ↦ pure { expr := e }
  go true e

open Elab.Tactic Parser.Tactic
/-- Use `abel_nf` to rewrite the main goal. -/
def abelNFTarget (cfg : AbelNF.Config) : TacticM Unit := withMainContext do
  let goal ← getMainGoal
  let tgt ← instantiateMVars (← goal.getType)
  let r ← abelNFCore cfg tgt
  if r.expr.isConstOf ``True then
    goal.assign (← mkOfEqTrue (← r.getProof))
    replaceMainGoal []
  else
    replaceMainGoal [← applySimpResultToTarget goal tgt r]

/-- Use `abel_nf` to rewrite hypothesis `h`. -/
def abelNFLocalDecl (cfg : AbelNF.Config) (fvarId : FVarId) :
    TacticM Unit := withMainContext do
  let tgt ← instantiateMVars (← fvarId.getType)
  let goal ← getMainGoal
  let myres ← abelNFCore cfg tgt
  match ← applySimpResultToLocalDecl goal fvarId myres false with
  | none => replaceMainGoal []
  | some (_, newGoal) => replaceMainGoal [newGoal]

/-- Unsupported legacy syntax from mathlib3, which allowed passing additional terms to `abel`. -/
syntax (name := abel_term) "abel" (ppSpace (&"raw" <|> &"term"))? (ppSpace location)? : tactic
/-- Unsupported legacy syntax from mathlib3, which allowed passing additional terms to `abel!`. -/
syntax (name := abel!_term) "abel!" (ppSpace (&"raw" <|> &"term"))? (ppSpace location)? : tactic

/--
Simplification tactic for expressions in the language of abelian groups,
which rewrites all group expressions into a normal form.
* `abel_nf!` will use a more aggressive reducibility setting to identify atoms.
* `abel_nf (config := cfg)` allows for additional configuration:
  * `red`: the reducibility setting (overridden by `!`)
  * `recursive`: if true, `abel_nf` will also recurse into atoms
* `abel_nf` works as both a tactic and a conv tactic.
  In tactic mode, `abel_nf at h` can be used to rewrite in a hypothesis.
-/
elab (name := abelNF) "abel_nf" tk:"!"? cfg:(config ?) loc:(ppSpace location)? : tactic => do
  let mut cfg ← elabAbelNFConfig cfg
  if tk.isSome then cfg := { cfg with red := .default }
  let loc := (loc.map expandLocation).getD (.targets #[] true)
  withLocation loc (abelNFLocalDecl cfg) (abelNFTarget cfg)
    fun _ ↦ throwError "abel_nf failed"

@[inherit_doc abelNF] macro "abel_nf!" cfg:(config)? loc:(ppSpace location)? : tactic =>
  `(tactic| abel_nf ! $(cfg)? $(loc)?)

@[inherit_doc abelNF] syntax (name := abelNFConv) "abel_nf" "!"? (config)? : conv

/-- Elaborator for the `abel_nf` tactic. -/
@[tactic abelNFConv] def elabAbelNFConv : Tactic := fun stx ↦ match stx with
  | `(conv| abel_nf $[!%$tk]? $(_cfg)?) => withMainContext do
    let mut cfg ← elabAbelNFConfig stx[2]
    if tk.isSome then cfg := { cfg with red := .default }
    Conv.applySimpResult (← abelNFCore cfg (← instantiateMVars (← Conv.getLhs)))
  | _ => Elab.throwUnsupportedSyntax

@[inherit_doc abelNF] macro "abel_nf!" cfg:(config)? : conv => `(conv| abel_nf ! $(cfg)?)

/--
Tactic for evaluating expressions in abelian groups.

* `abel!` will use a more aggressive reducibility setting to determine equality of atoms.
* `abel1` fails if the target is not an equality.

For example:
```
example [AddCommMonoid α] (a b : α) : a + (b + a) = a + a + b := by abel
example [AddCommGroup α] (a : α) : (3 : ℤ) • a = a + (2 : ℤ) • a := by abel
```
-/
macro (name := abel) "abel" : tactic =>
  `(tactic| first | abel1 | abel_nf; trace "Try this: abel_nf")
@[inherit_doc abel] macro "abel!" : tactic =>
  `(tactic| first | abel1! | abel_nf!; trace "Try this: abel_nf!")

/--
The tactic `abel` evaluates expressions in abelian groups.
This is the conv tactic version, which rewrites a target which is a abel equality to `True`.

See also the `abel` tactic.
-/
macro (name := abelConv) "abel" : conv =>
  `(conv| first | discharge => abel1 | abel_nf; tactic => trace "Try this: abel_nf")
@[inherit_doc abelConv] macro "abel!" : conv =>
  `(conv| first | discharge => abel1! | abel_nf!; tactic => trace "Try this: abel_nf!")


/-
Copyright (c) 2017 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot, Scott Morrison, Mario Carneiro
-/
import category_theory.concrete_category.bundled_hom
import topology.continuous_function.basic

/-!
# Category instance for topological spaces

We introduce the bundled category `Top` of topological spaces together with the functors `discrete`
and `trivial` from the category of types to `Top` which equip a type with the corresponding
discrete, resp. trivial, topology. For a proof that these functors are left, resp. right adjoint
to the forgetful functor, see `topology.category.Top.adjunctions`.
-/

open category_theory
open topological_space

universe u

/-- The category of topological spaces and continuous maps. -/
def Top : Type (u+1) := bundled topological_space

namespace Top

instance bundled_hom : bundled_hom @continuous_map :=
⟨@continuous_map.to_fun, @continuous_map.id, @continuous_map.comp, @continuous_map.coe_injective⟩

attribute [derive [large_category, concrete_category]] Top

instance : has_coe_to_sort Top Type* := bundled.has_coe_to_sort

instance topological_space_unbundled (x : Top) : topological_space x := x.str

@[simp] lemma id_app (X : Top.{u}) (x : X) :
  (𝟙 X : X → X) x = x := rfl

@[simp] lemma comp_app {X Y Z : Top.{u}} (f : X ⟶ Y) (g : Y ⟶ Z) (x : X) :
  (f ≫ g : X → Z) x = g (f x) := rfl

/-- Construct a bundled `Top` from the underlying type and the typeclass. -/
def of (X : Type u) [topological_space X] : Top := ⟨X⟩

instance (X : Top) : topological_space X := X.str

@[simp] lemma coe_of (X : Type u) [topological_space X] : (of X : Type u) = X := rfl

instance : inhabited Top := ⟨Top.of empty⟩

/-- The discrete topology on any type. -/
def discrete : Type u ⥤ Top.{u} :=
{ obj := λ X, ⟨X, ⊥⟩,
  map := λ X Y f, { to_fun := f, continuous_to_fun := continuous_bot } }

/-- The trivial topology on any type. -/
def trivial : Type u ⥤ Top.{u} :=
{ obj := λ X, ⟨X, ⊤⟩,
  map := λ X Y f, { to_fun := f, continuous_to_fun := continuous_top } }

/-- Any homeomorphisms induces an isomorphism in `Top`. -/
@[simps] def iso_of_homeo {X Y : Top.{u}} (f : X ≃ₜ Y) : X ≅ Y :=
{ hom := ⟨f⟩,
  inv := ⟨f.symm⟩ }

/-- Any isomorphism in `Top` induces a homeomorphism. -/
@[simps] def homeo_of_iso {X Y : Top.{u}} (f : X ≅ Y) : X ≃ₜ Y :=
{ to_fun := f.hom,
  inv_fun := f.inv,
  left_inv := λ x, by simp,
  right_inv := λ x, by simp,
  continuous_to_fun := f.hom.continuous,
  continuous_inv_fun := f.inv.continuous }

@[simp] lemma of_iso_of_homeo {X Y : Top.{u}} (f : X ≃ₜ Y) : homeo_of_iso (iso_of_homeo f) = f :=
by { ext, refl }

@[simp] lemma of_homeo_of_iso {X Y : Top.{u}} (f : X ≅ Y) : iso_of_homeo (homeo_of_iso f) = f :=
by { ext, refl }

@[simp]
lemma open_embedding_iff_comp_is_iso {X Y Z : Top} (f : X ⟶ Y) (g : Y ⟶ Z) [is_iso g] :
  open_embedding (f ≫ g) ↔ open_embedding f :=
open_embedding_iff_open_embedding_compose f (Top.homeo_of_iso (as_iso g)).open_embedding

@[simp]
lemma open_embedding_iff_is_iso_comp {X Y Z : Top} (f : X ⟶ Y) (g : Y ⟶ Z) [is_iso f] :
  open_embedding (f ≫ g) ↔ open_embedding g :=
begin
  split,
  { intro h,
    convert h.comp (Top.homeo_of_iso (as_iso f).symm).open_embedding,
    exact congr_arg _ (is_iso.inv_hom_id_assoc f g).symm },
  { exact λ h, h.comp (Top.homeo_of_iso (as_iso f)).open_embedding }
end

end Top


variables (f : ℕ → ℕ) (k : ℕ)

example (h₁ : f 0 = 0) (h₂ : k = 0) : f k = 0 :=
by simp [h₁, h₂]

example (h₁ : f 0 = 0) (h₂ : k = 0) : f k = 0 :=
by simp *


-- https://www.codewars.com/kata/5eb80c83eccaf80032feae69/train/lean

/-
def gcd : nat → nat → nat
| 0        y := y
| (succ x) y := have y % succ x < succ x, from mod_lt _ $ succ_pos _,
                gcd (y % succ x) (succ x)
-/

import data.nat.basic

open nat
open classical
attribute [instance] prop_decidable

def gcd_steps : ℕ → ℕ → ℕ
| 0        y := 0
| (succ x) y := have y % succ x < succ x, from mod_lt _ $ succ_pos _,
                1 + gcd_steps (y % succ x) (succ x)

def fib : ℕ → ℕ
| 0 := 0
| 1 := 1
| (n + 2) := (fib n) + (fib (n + 1))

theorem euclid_not_constant : ∀ n, ∃ a b, gcd_steps a b = n :=
begin
  intro n,
  use (fib n),
  use (fib (n+1)),
  induction n with n hyp,
  unfold fib, refl,

  repeat {sorry,}
end

example (n:ℕ) : n.succ = n + 1 := rfl


/-
Copyright (c) 2021 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen
-/
import number_theory.class_number.admissible_absolute_value
import analysis.special_functions.pow
import ring_theory.ideal.local_ring
import data.polynomial.degree.card_pow_degree

/-!
# Admissible absolute values on polynomials
This file defines an admissible absolute value
`polynomial.card_pow_degree_is_admissible` which we use to show the class number
of the ring of integers of a function field is finite.

## Main results

* `polynomial.card_pow_degree_is_admissible` shows `card_pow_degree`,
  mapping `p : polynomial 𝔽_q` to `q ^ degree p`, is admissible
-/

namespace polynomial
open_locale polynomial
open absolute_value real

variables {Fq : Type*} [fintype Fq]

/-- If `A` is a family of enough low-degree polynomials over a finite semiring, there is a
pair of equal elements in `A`. -/
lemma exists_eq_polynomial [semiring Fq] {d : ℕ} {m : ℕ} (hm : fintype.card Fq ^ d ≤ m) (b : Fq[X])
  (hb : nat_degree b ≤ d) (A : fin m.succ → Fq[X]) (hA : ∀ i, degree (A i) < degree b) :
  ∃ i₀ i₁, i₀ ≠ i₁ ∧ A i₁ = A i₀ :=
begin
  -- Since there are > q^d elements of A, and only q^d choices for the highest `d` coefficients,
  -- there must be two elements of A with the same coefficients at
  -- `0`, ... `degree b - 1` ≤ `d - 1`.
  -- In other words, the following map is not injective:
  set f : fin m.succ → (fin d → Fq) := λ i j, (A i).coeff j,
  have : fintype.card (fin d → Fq) < fintype.card (fin m.succ),
  { simpa using lt_of_le_of_lt hm (nat.lt_succ_self m) },
  -- Therefore, the differences have all coefficients higher than `deg b - d` equal.
  obtain ⟨i₀, i₁, i_ne, i_eq⟩ := fintype.exists_ne_map_eq_of_card_lt f this,
  use [i₀, i₁, i_ne],
  ext j,
  -- The coefficients higher than `deg b` are the same because they are equal to 0.
  by_cases hbj : degree b ≤ j,
  { rw [coeff_eq_zero_of_degree_lt (lt_of_lt_of_le (hA _) hbj),
        coeff_eq_zero_of_degree_lt (lt_of_lt_of_le (hA _) hbj)] },
  -- So we only need to look for the coefficients between `0` and `deg b`.
  rw not_le at hbj,
  apply congr_fun i_eq.symm ⟨j, _⟩,
  exact lt_of_lt_of_le (coe_lt_degree.mp hbj) hb
end

/-- If `A` is a family of enough low-degree polynomials over a finite ring,
there is a pair of elements in `A` (with different indices but not necessarily
distinct), such that their difference has small degree. -/
lemma exists_approx_polynomial_aux [ring Fq] {d : ℕ} {m : ℕ} (hm : fintype.card Fq ^ d ≤ m)
  (b : Fq[X]) (A : fin m.succ → Fq[X]) (hA : ∀ i, degree (A i) < degree b) :
  ∃ i₀ i₁, i₀ ≠ i₁ ∧ degree (A i₁ - A i₀) < ↑(nat_degree b - d) :=
begin
  have hb : b ≠ 0,
  { rintro rfl,
    specialize hA 0,
    rw degree_zero at hA,
    exact not_lt_of_le bot_le hA },
  -- Since there are > q^d elements of A, and only q^d choices for the highest `d` coefficients,
  -- there must be two elements of A with the same coefficients at
  -- `degree b - 1`, ... `degree b - d`.
  -- In other words, the following map is not injective:
  set f : fin m.succ → (fin d → Fq) := λ i j, (A i).coeff (nat_degree b - j.succ),
  have : fintype.card (fin d → Fq) < fintype.card (fin m.succ),
  { simpa using lt_of_le_of_lt hm (nat.lt_succ_self m) },
  -- Therefore, the differences have all coefficients higher than `deg b - d` equal.
  obtain ⟨i₀, i₁, i_ne, i_eq⟩ := fintype.exists_ne_map_eq_of_card_lt f this,
  use [i₀, i₁, i_ne],
  refine (degree_lt_iff_coeff_zero _ _).mpr (λ j hj, _),
  -- The coefficients higher than `deg b` are the same because they are equal to 0.
  by_cases hbj : degree b ≤ j,
  { refine coeff_eq_zero_of_degree_lt (lt_of_lt_of_le _ hbj),
    exact lt_of_le_of_lt (degree_sub_le _ _) (max_lt (hA _) (hA _)) },
  -- So we only need to look for the coefficients between `deg b - d` and `deg b`.
  rw [coeff_sub, sub_eq_zero],
  rw [not_le, degree_eq_nat_degree hb, with_bot.coe_lt_coe] at hbj,
  have hj : nat_degree b - j.succ < d,
  { by_cases hd : nat_degree b < d,
    { exact lt_of_le_of_lt tsub_le_self hd },
    { rw not_lt at hd,
      have := lt_of_le_of_lt hj (nat.lt_succ_self j),
      rwa [tsub_lt_iff_tsub_lt hd hbj] at this } },
  have : j = b.nat_degree - (nat_degree b - j.succ).succ,
  { rw [← nat.succ_sub hbj, nat.succ_sub_succ, tsub_tsub_cancel_of_le hbj.le] },
  convert congr_fun i_eq.symm ⟨nat_degree b - j.succ, hj⟩
end

variables [field Fq]

/-- If `A` is a family of enough low-degree polynomials over a finite field,
there is a pair of elements in `A` (with different indices but not necessarily
distinct), such that the difference of their remainders is close together. -/
lemma exists_approx_polynomial {b : Fq[X]} (hb : b ≠ 0)
  {ε : ℝ} (hε : 0 < ε)
  (A : fin (fintype.card Fq ^ ⌈- log ε / log (fintype.card Fq)⌉₊).succ → Fq[X]) :
  ∃ i₀ i₁, i₀ ≠ i₁ ∧ (card_pow_degree (A i₁ % b - A i₀ % b) : ℝ) < card_pow_degree b • ε :=
begin
  have hbε : 0 < card_pow_degree b • ε,
  { rw [algebra.smul_def, eq_int_cast],
    exact mul_pos (int.cast_pos.mpr (absolute_value.pos _ hb)) hε },
  have one_lt_q : 1 < fintype.card Fq := fintype.one_lt_card,
  have one_lt_q' : (1 : ℝ) < fintype.card Fq, { assumption_mod_cast },
  have q_pos : 0 < fintype.card Fq, { linarith },
  have q_pos' : (0 : ℝ) < fintype.card Fq, { assumption_mod_cast },
  -- If `b` is already small enough, then the remainders are equal and we are done.
  by_cases le_b : b.nat_degree ≤ ⌈- log ε / log (fintype.card Fq)⌉₊,
  { obtain ⟨i₀, i₁, i_ne, mod_eq⟩ := exists_eq_polynomial le_rfl b le_b (λ i, A i % b)
      (λ i, euclidean_domain.mod_lt (A i) hb),
    refine ⟨i₀, i₁, i_ne, _⟩,
    simp only at mod_eq,
    rwa [mod_eq, sub_self, absolute_value.map_zero, int.cast_zero] },
  -- Otherwise, it suffices to choose two elements whose difference is of small enough degree.
  rw not_le at le_b,
  obtain ⟨i₀, i₁, i_ne, deg_lt⟩ := exists_approx_polynomial_aux le_rfl b (λ i, A i % b)
    (λ i, euclidean_domain.mod_lt (A i) hb),
  simp only at deg_lt,
  use [i₀, i₁, i_ne],
  -- Again, if the remainders are equal we are done.
  by_cases h : A i₁ % b = A i₀ % b,
  { rwa [h, sub_self, absolute_value.map_zero, int.cast_zero] },
  have h' : A i₁ % b - A i₀ % b ≠ 0 := mt sub_eq_zero.mp h,
  -- If the remainders are not equal, we'll show their difference is of small degree.
  -- In particular, we'll show the degree is less than the following:
  suffices : (nat_degree (A i₁ % b - A i₀ % b) : ℝ) <
    b.nat_degree + log ε / log (fintype.card Fq),
  { rwa [← real.log_lt_log_iff (int.cast_pos.mpr (card_pow_degree.pos h')) hbε,
        card_pow_degree_nonzero _ h', card_pow_degree_nonzero _ hb,
        algebra.smul_def, eq_int_cast,
        int.cast_pow, int.cast_coe_nat, int.cast_pow, int.cast_coe_nat,
        log_mul (pow_ne_zero _ q_pos'.ne') hε.ne',
        ← rpow_nat_cast, ← rpow_nat_cast, log_rpow q_pos', log_rpow q_pos',
        ← lt_div_iff (log_pos one_lt_q'), add_div, mul_div_cancel _ (log_pos one_lt_q').ne'] },
  -- And that result follows from manipulating the result from `exists_approx_polynomial_aux`
  -- to turn the `-⌈-stuff⌉₊` into `+ stuff`.
  refine lt_of_lt_of_le (nat.cast_lt.mpr (with_bot.coe_lt_coe.mp _)) _,
  swap, { convert deg_lt, rw degree_eq_nat_degree h' },
  rw [← sub_neg_eq_add, neg_div],
  refine le_trans _ (sub_le_sub_left (nat.le_ceil _) (b.nat_degree : ℝ)),
  rw ← neg_div,
  exact le_of_eq (nat.cast_sub le_b.le)
end

/-- If `x` is close to `y` and `y` is close to `z`, then `x` and `z` are at least as close. -/
lemma card_pow_degree_anti_archimedean {x y z : Fq[X]} {a : ℤ}
  (hxy : card_pow_degree (x - y) < a) (hyz : card_pow_degree (y - z) < a) :
  card_pow_degree (x - z) < a :=
begin
  have ha : 0 < a := lt_of_le_of_lt (absolute_value.nonneg _ _) hxy,
  by_cases hxy' : x = y,
  { rwa hxy' },
  by_cases hyz' : y = z,
  { rwa ← hyz' },
  by_cases hxz' : x = z,
  { rwa [hxz', sub_self, absolute_value.map_zero] },
  rw [← ne.def, ← sub_ne_zero] at hxy' hyz' hxz',
  refine lt_of_le_of_lt _ (max_lt hxy hyz),
  rw [card_pow_degree_nonzero _ hxz', card_pow_degree_nonzero _ hxy',
      card_pow_degree_nonzero _ hyz'],
  have : (1 : ℤ) ≤ fintype.card Fq, { exact_mod_cast (@fintype.one_lt_card Fq _ _).le },
  simp only [int.cast_pow, int.cast_coe_nat, le_max_iff],
  refine or.imp (pow_le_pow this) (pow_le_pow this) _,
  rw [nat_degree_le_iff_degree_le, nat_degree_le_iff_degree_le, ← le_max_iff,
      ← degree_eq_nat_degree hxy', ← degree_eq_nat_degree hyz'],
  convert degree_add_le (x - y) (y - z) using 2,
  exact (sub_add_sub_cancel _ _ _).symm
end

/-- A slightly stronger version of `exists_partition` on which we perform induction on `n`:
for all `ε > 0`, we can partition the remainders of any family of polynomials `A`
into equivalence classes, where the equivalence(!) relation is "closer than `ε`". -/
lemma exists_partition_polynomial_aux (n : ℕ) {ε : ℝ} (hε : 0 < ε)
  {b : Fq[X]} (hb : b ≠ 0) (A : fin n → Fq[X]) :
  ∃ (t : fin n → fin (fintype.card Fq ^ ⌈- log ε / log (fintype.card Fq)⌉₊)),
  ∀ (i₀ i₁ : fin n),
  t i₀ = t i₁ ↔ (card_pow_degree (A i₁ % b - A i₀ % b) : ℝ) < card_pow_degree b • ε :=
begin
  have hbε : 0 < card_pow_degree b • ε,
  { rw [algebra.smul_def, eq_int_cast],
    exact mul_pos (int.cast_pos.mpr (absolute_value.pos _ hb)) hε },
  -- We go by induction on the size `A`.
  induction n with n ih,
  { refine ⟨fin_zero_elim, fin_zero_elim⟩ },

  -- Show `anti_archimedean` also holds for real distances.
  have anti_archim' : ∀ {i j k} {ε : ℝ}, (card_pow_degree (A i % b - A j % b) : ℝ) < ε →
    (card_pow_degree (A j % b - A k % b) : ℝ) < ε → (card_pow_degree (A i % b - A k % b) : ℝ) < ε,
  { intros i j k ε,
    simp_rw [← int.lt_ceil],
    exact card_pow_degree_anti_archimedean },

  obtain ⟨t', ht'⟩ := ih (fin.tail A),
  -- We got rid of `A 0`, so determine the index `j` of the partition we'll re-add it to.
  rsuffices ⟨j, hj⟩ : ∃ j,
    ∀ i, t' i = j ↔ (card_pow_degree (A 0 % b - A i.succ % b) : ℝ) < card_pow_degree b • ε,
  { refine ⟨fin.cons j t', λ i₀ i₁, _⟩,
    refine fin.cases _ (λ i₀, _) i₀; refine fin.cases _ (λ i₁, _) i₁,
    { simpa using hbε },
    { rw [fin.cons_succ, fin.cons_zero, eq_comm, absolute_value.map_sub],
      exact hj i₁ },
    { rw [fin.cons_succ, fin.cons_zero],
      exact hj i₀ },
    { rw [fin.cons_succ, fin.cons_succ],
      exact ht' i₀ i₁ } },
  -- `exists_approx_polynomial` guarantees that we can insert `A 0` into some partition `j`,
  -- but not that `j` is uniquely defined (which is needed to keep the induction going).
  obtain ⟨j, hj⟩ : ∃ j, ∀ (i : fin n), t' i = j →
    (card_pow_degree (A 0 % b - A i.succ % b) : ℝ) < card_pow_degree b • ε,
  { by_contra this, push_neg at this,
    obtain ⟨j₀, j₁, j_ne, approx⟩ := exists_approx_polynomial hb hε
      (fin.cons (A 0) (λ j, A (fin.succ (classical.some (this j))))),
    revert j_ne approx,
    refine fin.cases _ (λ j₀, _) j₀; refine fin.cases (λ j_ne approx, _) (λ j₁ j_ne approx, _) j₁,
    { exact absurd rfl j_ne },
    { rw [fin.cons_succ, fin.cons_zero, ← not_le, absolute_value.map_sub] at approx,
      have := (classical.some_spec (this j₁)).2,
      contradiction },
    { rw [fin.cons_succ, fin.cons_zero, ← not_le] at approx,
      have := (classical.some_spec (this j₀)).2,
      contradiction },
    { rw [fin.cons_succ, fin.cons_succ] at approx,
      rw [ne.def, fin.succ_inj] at j_ne,
      have : j₀ = j₁ :=
        (classical.some_spec (this j₀)).1.symm.trans
        (((ht' (classical.some (this j₀)) (classical.some (this j₁))).mpr approx).trans
        (classical.some_spec (this j₁)).1),
      contradiction } },
  -- However, if one of those partitions `j` is inhabited by some `i`, then this `j` works.
  by_cases exists_nonempty_j : ∃ j, (∃ i, t' i = j) ∧
    ∀ i, t' i = j → (card_pow_degree (A 0 % b - A i.succ % b) : ℝ) < card_pow_degree b • ε,
  { obtain ⟨j, ⟨i, hi⟩, hj⟩ := exists_nonempty_j,
    refine ⟨j, λ i', ⟨hj i', λ hi', trans ((ht' _ _).mpr _) hi⟩⟩,
    apply anti_archim' _ hi',
    rw absolute_value.map_sub,
    exact hj _ hi },
  -- And otherwise, we can just take any `j`, since those are empty.
  refine ⟨j, λ i, ⟨hj i, λ hi, _⟩⟩,
  have := exists_nonempty_j ⟨t' i, ⟨i, rfl⟩, λ i' hi', anti_archim' hi ((ht' _ _).mp hi')⟩,
  contradiction
end

/-- For all `ε > 0`, we can partition the remainders of any family of polynomials `A`
into classes, where all remainders in a class are close together. -/
lemma exists_partition_polynomial (n : ℕ) {ε : ℝ} (hε : 0 < ε)
  {b : Fq[X]} (hb : b ≠ 0) (A : fin n → Fq[X]) :
  ∃ (t : fin n → fin (fintype.card Fq ^ ⌈- log ε / log (fintype.card Fq)⌉₊)),
    ∀ (i₀ i₁ : fin n), t i₀ = t i₁ →
      (card_pow_degree (A i₁ % b - A i₀ % b) : ℝ) < card_pow_degree b • ε :=
begin
  obtain ⟨t, ht⟩ := exists_partition_polynomial_aux n hε hb A,
  exact ⟨t, λ i₀ i₁ hi, (ht i₀ i₁).mp hi⟩
end

/-- `λ p, fintype.card Fq ^ degree p` is an admissible absolute value.
We set `q ^ degree 0 = 0`. -/
noncomputable def card_pow_degree_is_admissible :
  is_admissible (card_pow_degree : absolute_value Fq[X] ℤ) :=
{ card := λ ε, fintype.card Fq ^ ⌈- log ε / log (fintype.card Fq)⌉₊,
  exists_partition' := λ n ε hε b hb, exists_partition_polynomial n hε hb,
  .. @card_pow_degree_is_euclidean Fq _ _ }

end polynomial


/-
Copyright © 2019 François G. Dorais. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
-/

import .basic

namespace groupoid
universes u v
variables {α : Type u} (γ : α → α → Sort v)

inductive expr : α → α → Sort (max (u+1) v)
| id {} (x : α) : expr x x
| inv {x y : α} : expr x y → expr y x
| comp {x y z : α} : expr x y → expr y z → expr x z
| intro {x y : α} : γ x y → expr x y

inductive word : α → α → Sort (max (u+1) v)
| id {} (x : α) : word x x
| gapp {x y z : α} : γ x y → word y z → word x z
| iapp {x y z : α} : γ y x → word y z → word x z

namespace word
variable {γ}

definition to_expr : Π {x y : α}, word γ x y → expr γ x y
| _ _ (word.id _) := expr.id _
| _ _ (word.gapp g p) := expr.comp (expr.intro g) p.to_expr
| _ _ (word.iapp g p) := expr.comp (expr.inv (expr.intro g)) p.to_expr

definition comp : Π {x y z : α}, word γ x y → word γ y z → word γ x z
| _ _ _ (word.id _) q := q
| _ _ _ (word.gapp g p) q := word.gapp g (comp p q)
| _ _ _ (word.iapp g p) q := word.iapp g (comp p q)

definition inv : Π {x y : α}, word γ x y → word γ y x
| _ _ (word.id _) := word.id _
| _ _ (word.gapp g p) := word.comp (inv p) (word.iapp g (word.id _))
| _ _ (word.iapp g p) := word.comp (inv p) (word.gapp g (word.id _))

definition eval (Γ : groupoid γ) : Π {x y : α}, word γ x y → γ x y
| _ _ (word.id _) := Γ.id _
| _ _ (word.gapp g p) := Γ.comp g (eval p)
| _ _ (word.iapp g p) := Γ.comp (Γ.inv g) (eval p)

lemma eval_comp {Γ : groupoid γ} [is_lawful Γ] : ∀ {x y z} (p : word γ x y) (q : word γ y z), word.eval Γ (word.comp p q) = Γ.comp (p.eval Γ) (q.eval Γ)
| _ _ _ (word.id _) q :=
  begin
  dunfold word.comp,
  dunfold word.eval,
  rw [is_lawful.id_comp],
  end
| x y z (word.gapp g p) q :=
  begin
  dunfold word.comp,
  dunfold word.eval,
  rw [eval_comp],
  rw [comp_assoc],
  end
| _ _ _ (word.iapp g p) q :=
  begin
  dunfold word.comp,
  dunfold word.eval,
  rw [eval_comp],
  rw [comp_assoc],
  end

lemma eval_inv {Γ : groupoid γ} [is_lawful Γ] : ∀ {x y} (p : word γ x y), word.eval Γ p.inv = Γ.inv (p.eval Γ)
| _ _ (word.id _) :=
  begin
  dunfold word.inv,
  dunfold word.eval,
  rw [inv_of_id],
  end
| _ _ (word.gapp g p) :=
  begin
  dunfold word.inv,
  rw [eval_comp],
  dunfold word.eval,
  rw [eval_inv],
  rw [inv_of_comp],
  rw [comp_id],
  end
| _ _ (word.iapp g p) :=
  begin
  dunfold word.inv,
  rw [eval_comp],
  dunfold word.eval,
  rw [eval_inv],
  rw [inv_of_comp],
  rw [comp_id],
  rw [inv_of_inv],
  end

inductive equiv : Π {x y : α}, word γ x y → word γ x y → Sort (max (u+1) v)
| id (x : α) : equiv (word.id x) (word.id x)
| gapp {x y z : α} (g : γ x y) {p q : word γ y z} : equiv p q → equiv (word.gapp g p) (word.gapp g q)
| iapp {x y z : α} (g : γ y x) {p q : word γ y z} : equiv p q → equiv (word.iapp g p) (word.iapp g q)
| inv_app {x y z : α} (g : γ x y) {p q : word γ y z} : equiv p q → equiv (word.iapp g (word.gapp g p)) q
| app_inv {x y z : α} (g : γ y x) {p q : word γ y z} : equiv p q → equiv (word.gapp g (word.iapp g p)) q
| euclid {x y : α} (p q r : word γ x y) : equiv p q → equiv p r → equiv q r

namespace equiv

lemma refl : Π {x y : α} (p : word γ x y), equiv p p
| _ _ (word.id _) := equiv.id _
| _ _ (word.gapp _ p) := equiv.gapp _ (refl p)
| _ _ (word.iapp _ p) := equiv.iapp _ (refl p)

lemma symm {x y : α} (p q : word γ x y) : equiv p q → equiv q p :=
λ H, equiv.euclid p q p H (equiv.refl p)

lemma trans {x y : α} (p q r : word γ x y) : equiv p q → equiv q r → equiv p r :=
λ H₁ H₂, equiv.euclid q p r (equiv.symm p q H₁) H₂

variable (γ)

instance to_setoid (x y : α) : setoid (word γ x y) :=
{ r := λ p q, nonempty (equiv p q)
, iseqv := mk_equivalence _
  (λ p, nonempty.intro (equiv.refl p))
  (λ p q H, nonempty.elim H (λ H, nonempty.intro (equiv.symm p q H)))
  (λ p q r H₁ H₂, nonempty.elim H₁ (λ H₁, nonempty.elim H₂ (λ H₂, nonempty.intro (equiv.trans p q r H₁ H₂))))
}

definition quotient (x y : α) : Sort (max (u+1) v) := quotient (equiv.to_setoid γ x y)

end equiv

end word

namespace expr
variables {γ}

definition to_word : Π {x y : α}, expr γ x y → word γ x y
| _ _ (expr.id _) := word.id _
| _ _ (expr.inv e) := word.inv e.to_word
| _ _ (expr.comp e f) := word.comp e.to_word f.to_word
| _ _ (expr.intro g) := word.gapp g (word.id _)

definition eval (Γ : groupoid γ) : Π {x y : α}, expr γ x y → γ x y
| _ _ (expr.id x) := Γ.id x
| _ _ (expr.inv g) := Γ.inv (eval g)
| _ _ (expr.comp g h) := Γ.comp (eval g) (eval h)
| _ _ (expr.intro g) := g

end expr

section eval
variables {γ} {Γ : groupoid γ}

lemma word_eval_eq_expr_eval : ∀ {x y} (p : word γ x y), p.eval Γ = p.to_expr.eval Γ
| _ _ (word.id _) := rfl
| _ _ (word.gapp _ _) :=
  begin
  dunfold word.eval,
  dunfold word.to_expr,
  dunfold expr.eval,
  rw [word_eval_eq_expr_eval],
  end
| _ _ (word.iapp _ _) :=
  begin
  dunfold word.eval,
  dunfold word.to_expr,
  dunfold expr.eval,
  rw [word_eval_eq_expr_eval],
  end

lemma eval_expr_eq_eval_word [is_lawful Γ] : ∀ {x y} (e : expr γ x y), e.eval Γ = e.to_word.eval Γ
| _ _ (expr.id _) := rfl
| _ _ (expr.inv e) :=
  begin
  dunfold expr.eval,
  dunfold expr.to_word,
  rw [word.eval_inv],
  rw [eval_expr_eq_eval_word],
  end
| _ _ (expr.comp e f) :=
  begin
  dunfold expr.eval,
  dunfold expr.to_word,
  rw [word.eval_comp],
  rw [eval_expr_eq_eval_word],
  rw [eval_expr_eq_eval_word],
  end
| _ _ (expr.intro g) :=
  begin
  dunfold expr.eval,
  dunfold expr.to_word,
  dunfold word.eval,
  rw [comp_id],
  end

end eval

namespace expr

inductive equiv : Π {x y : α}, expr γ x y → expr γ x y → Sort (max (u+1) v)
| eucl {x y : α} (f g h : expr γ x y) : equiv f g → equiv f h → equiv g h
| id {} (x : α) : equiv (expr.id x) (expr.id x)
| inv {x y : α} {g h : expr γ x y} : equiv g h → equiv (expr.inv g) (expr.inv h)
| comp {x y z : α} {g₁ h₁ : expr γ x y} {g₂ h₂ : expr γ y z} : equiv g₁ h₁ → equiv g₂ h₂ → equiv (expr.comp g₁ g₂) (expr.comp h₁ h₂)
| intro {x y : α} {g h : γ x y} : g = h → equiv (expr.intro g) (expr.intro h)

namespace equiv
variable {γ}

definition refl : Π {x y : α} (g : expr γ x y), equiv γ g g
| _ _ (expr.id _) := equiv.id _
| _ _ (expr.inv g) := equiv.inv (refl g)
| _ _ (expr.comp g h) := equiv.comp (refl g) (refl h)
| _ _ (expr.intro g) := equiv.intro rfl

definition symm {x y : α} {g h : expr γ x y} : equiv γ g h → equiv γ h g :=
λ H, equiv.eucl g h g H (equiv.refl g)

definition trans {x y : α} {f g h : expr γ x y} : equiv γ f g → equiv γ g h → equiv γ f h :=
λ H₁ H₂, equiv.eucl g f h (equiv.symm H₁) H₂

lemma eval (Γ : groupoid γ) : Π {x y : α} {g h : expr γ x y}, equiv γ g h → g.eval Γ = h.eval Γ
| _ _ (expr.intro _) (expr.intro _) (equiv.intro H) := eq.rec_on H rfl
| _ _ _ _ (equiv.id _) := rfl
| _ _ (expr.inv _) (expr.inv _) (equiv.inv H) :=
  begin
  dunfold expr.eval,
  apply congr_arg,
  exact eval H,
  end
| _ _ (expr.comp _ _) (expr.comp _ _) (equiv.comp H₁ H₂) :=
  begin
  dunfold expr.eval,
  apply congr,
  apply congr_arg,
  exact eval H₁,
  exact eval H₂,
  end
| _ _ _ _ (equiv.eucl f _ _ H₁ H₂) :=
  begin
  transitivity (f.eval Γ),
  symmetry,
  exact eval H₁,
  exact eval H₂,
  end

end equiv

end expr

end groupoid