/-
Copyright (c) 2022 Rémi Bottinelli. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Rémi Bottinelli

! This file was ported from Lean 3 source module category_theory.groupoid.vertex_group
! leanprover-community/mathlib commit 97eab48559068f3d6313da387714ef25768fb730
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.CategoryTheory.Groupoid
import Mathbin.CategoryTheory.PathCategory
import Mathbin.Algebra.Group.Defs
import Mathbin.Algebra.Hom.Group
import Mathbin.Algebra.Hom.Equiv.Basic
import Mathbin.Combinatorics.Quiver.Path

/-!
# Vertex group

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

This file defines the vertex group (*aka* isotropy group) of a groupoid at a vertex.

## Implementation notes

* The instance is defined "manually", instead of relying on `category_theory.Aut.group` or
  using `category_theory.inv`.
* The multiplication order therefore matches the categorical one : `x * y = x ≫ y`.
* The inverse is directly defined in terms of the groupoidal inverse : `x ⁻¹ = groupoid.inv x`.

## Tags

isotropy, vertex group, groupoid
-/

namespace CategoryTheory

namespace Groupoid

universe u v

variable {C : Type u} [Groupoid C]

#print CategoryTheory.Groupoid.vertexGroup /-
/-- The vertex group at `c`. -/
@[simps]
instance vertexGroup (c : C) : Group (c ⟶ c)
    where
  mul := fun x y : c ⟶ c => x ≫ y
  mul_assoc := Category.assoc
  one := 𝟙 c
  one_mul := Category.id_comp
  mul_one := Category.comp_id
  inv := Groupoid.inv
  mul_left_inv := inv_comp
#align category_theory.groupoid.vertex_group CategoryTheory.Groupoid.vertexGroup
-/

/- warning: category_theory.groupoid.vertex_group.inv_eq_inv -> CategoryTheory.Groupoid.vertexGroup.inv_eq_inv is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u1}} [_inst_1 : CategoryTheory.Groupoid.{u2, u1} C] (c : C) (γ : Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) c c), Eq.{succ u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) c c) (Inv.inv.{u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) c c) (DivInvMonoid.toHasInv.{u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) c c) (Group.toDivInvMonoid.{u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) c c) (CategoryTheory.Groupoid.vertexGroup.{u1, u2} C _inst_1 c))) γ) (CategoryTheory.inv.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1) c c γ (CategoryTheory.IsIso.of_groupoid.{u2, u1} C _inst_1 c c γ))
but is expected to have type
  forall {C : Type.{u2}} [_inst_1 : CategoryTheory.Groupoid.{u1, u2} C] (c : C) (γ : Quiver.Hom.{succ u1, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C (CategoryTheory.Groupoid.toCategory.{u1, u2} C _inst_1))) c c), Eq.{succ u1} (Quiver.Hom.{succ u1, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C (CategoryTheory.Groupoid.toCategory.{u1, u2} C _inst_1))) c c) (Inv.inv.{u1} (Quiver.Hom.{succ u1, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C (CategoryTheory.Groupoid.toCategory.{u1, u2} C _inst_1))) c c) (InvOneClass.toInv.{u1} (Quiver.Hom.{succ u1, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C (CategoryTheory.Groupoid.toCategory.{u1, u2} C _inst_1))) c c) (DivInvOneMonoid.toInvOneClass.{u1} (Quiver.Hom.{succ u1, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C (CategoryTheory.Groupoid.toCategory.{u1, u2} C _inst_1))) c c) (DivisionMonoid.toDivInvOneMonoid.{u1} (Quiver.Hom.{succ u1, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C (CategoryTheory.Groupoid.toCategory.{u1, u2} C _inst_1))) c c) (Group.toDivisionMonoid.{u1} (Quiver.Hom.{succ u1, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u1, u2} C (CategoryTheory.Category.toCategoryStruct.{u1, u2} C (CategoryTheory.Groupoid.toCategory.{u1, u2} C _inst_1))) c c) (CategoryTheory.Groupoid.vertexGroup.{u2, u1} C _inst_1 c))))) γ) (CategoryTheory.inv.{u1, u2} C (CategoryTheory.Groupoid.toCategory.{u1, u2} C _inst_1) c c γ (CategoryTheory.IsIso.of_groupoid.{u1, u2} C _inst_1 c c γ))
Case conversion may be inaccurate. Consider using '#align category_theory.groupoid.vertex_group.inv_eq_inv CategoryTheory.Groupoid.vertexGroup.inv_eq_invₓ'. -/
/-- The inverse in the group is equal to the inverse given by `category_theory.inv`. -/
theorem vertexGroup.inv_eq_inv (c : C) (γ : c ⟶ c) : γ⁻¹ = CategoryTheory.inv γ :=
  Groupoid.inv_eq_inv γ
#align category_theory.groupoid.vertex_group.inv_eq_inv CategoryTheory.Groupoid.vertexGroup.inv_eq_inv

/- warning: category_theory.groupoid.vertex_group_isom_of_map -> CategoryTheory.Groupoid.vertexGroupIsomOfMap is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u1}} [_inst_1 : CategoryTheory.Groupoid.{u2, u1} C] {c : C} {d : C}, (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) c d) -> (MulEquiv.{u2, u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) c c) (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) d d) (MulOneClass.toHasMul.{u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) c c) (Monoid.toMulOneClass.{u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) c c) (DivInvMonoid.toMonoid.{u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) c c) (Group.toDivInvMonoid.{u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) c c) (CategoryTheory.Groupoid.vertexGroup.{u1, u2} C _inst_1 c))))) (MulOneClass.toHasMul.{u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) d d) (Monoid.toMulOneClass.{u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) d d) (DivInvMonoid.toMonoid.{u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) d d) (Group.toDivInvMonoid.{u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) d d) (CategoryTheory.Groupoid.vertexGroup.{u1, u2} C _inst_1 d))))))
but is expected to have type
  forall {C : Type.{u1}} [_inst_1 : CategoryTheory.Groupoid.{u2, u1} C] {c : C} {d : C}, (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) c d) -> (MulEquiv.{u2, u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) c c) (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) d d) (MulOneClass.toMul.{u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) c c) (Monoid.toMulOneClass.{u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) c c) (DivInvMonoid.toMonoid.{u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) c c) (Group.toDivInvMonoid.{u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) c c) (CategoryTheory.Groupoid.vertexGroup.{u1, u2} C _inst_1 c))))) (MulOneClass.toMul.{u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) d d) (Monoid.toMulOneClass.{u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) d d) (DivInvMonoid.toMonoid.{u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) d d) (Group.toDivInvMonoid.{u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) d d) (CategoryTheory.Groupoid.vertexGroup.{u1, u2} C _inst_1 d))))))
Case conversion may be inaccurate. Consider using '#align category_theory.groupoid.vertex_group_isom_of_map CategoryTheory.Groupoid.vertexGroupIsomOfMapₓ'. -/
/-- An arrow in the groupoid defines, by conjugation, an isomorphism of groups between
its endpoints.
-/
@[simps]
def vertexGroupIsomOfMap {c d : C} (f : c ⟶ d) : (c ⟶ c) ≃* (d ⟶ d)
    where
  toFun γ := inv f ≫ γ ≫ f
  invFun δ := f ≫ δ ≫ inv f
  left_inv γ := by
    simp_rw [category.assoc, comp_inv, category.comp_id, ← category.assoc, comp_inv,
      category.id_comp]
  right_inv δ := by
    simp_rw [category.assoc, inv_comp, ← category.assoc, inv_comp, category.id_comp,
      category.comp_id]
  map_mul' γ₁ γ₂ := by
    simp only [vertex_group_mul, inv_eq_inv, category.assoc, is_iso.hom_inv_id_assoc]
#align category_theory.groupoid.vertex_group_isom_of_map CategoryTheory.Groupoid.vertexGroupIsomOfMap

/- warning: category_theory.groupoid.vertex_group_isom_of_path -> CategoryTheory.Groupoid.vertexGroupIsomOfPath is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u1}} [_inst_1 : CategoryTheory.Groupoid.{u2, u1} C] {c : C} {d : C}, (Quiver.Path.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) c d) -> (MulEquiv.{u2, u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) c c) (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) d d) (MulOneClass.toHasMul.{u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) c c) (Monoid.toMulOneClass.{u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) c c) (DivInvMonoid.toMonoid.{u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) c c) (Group.toDivInvMonoid.{u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) c c) (CategoryTheory.Groupoid.vertexGroup.{u1, u2} C _inst_1 c))))) (MulOneClass.toHasMul.{u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) d d) (Monoid.toMulOneClass.{u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) d d) (DivInvMonoid.toMonoid.{u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) d d) (Group.toDivInvMonoid.{u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) d d) (CategoryTheory.Groupoid.vertexGroup.{u1, u2} C _inst_1 d))))))
but is expected to have type
  forall {C : Type.{u1}} [_inst_1 : CategoryTheory.Groupoid.{u2, u1} C] {c : C} {d : C}, (Quiver.Path.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) c d) -> (MulEquiv.{u2, u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) c c) (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) d d) (MulOneClass.toMul.{u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) c c) (Monoid.toMulOneClass.{u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) c c) (DivInvMonoid.toMonoid.{u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) c c) (Group.toDivInvMonoid.{u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) c c) (CategoryTheory.Groupoid.vertexGroup.{u1, u2} C _inst_1 c))))) (MulOneClass.toMul.{u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) d d) (Monoid.toMulOneClass.{u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) d d) (DivInvMonoid.toMonoid.{u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) d d) (Group.toDivInvMonoid.{u2} (Quiver.Hom.{succ u2, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u2, u1} C (CategoryTheory.Category.toCategoryStruct.{u2, u1} C (CategoryTheory.Groupoid.toCategory.{u2, u1} C _inst_1))) d d) (CategoryTheory.Groupoid.vertexGroup.{u1, u2} C _inst_1 d))))))
Case conversion may be inaccurate. Consider using '#align category_theory.groupoid.vertex_group_isom_of_path CategoryTheory.Groupoid.vertexGroupIsomOfPathₓ'. -/
/-- A path in the groupoid defines an isomorphism between its endpoints.
-/
def vertexGroupIsomOfPath {c d : C} (p : Quiver.Path c d) : (c ⟶ c) ≃* (d ⟶ d) :=
  vertexGroupIsomOfMap (composePath p)
#align category_theory.groupoid.vertex_group_isom_of_path CategoryTheory.Groupoid.vertexGroupIsomOfPath

/- warning: category_theory.functor.map_vertex_group -> CategoryTheory.Groupoid.CategoryTheory.Functor.mapVertexGroup is a dubious translation:
lean 3 declaration is
  forall {C : Type.{u1}} [_inst_1 : CategoryTheory.Groupoid.{u3, u1} C] {D : Type.{u2}} [_inst_2 : CategoryTheory.Groupoid.{u4, u2} D] (φ : CategoryTheory.Functor.{u3, u4, u1, u2} C (CategoryTheory.Groupoid.toCategory.{u3, u1} C _inst_1) D (CategoryTheory.Groupoid.toCategory.{u4, u2} D _inst_2)) (c : C), MonoidHom.{u3, u4} (Quiver.Hom.{succ u3, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u3, u1} C (CategoryTheory.Category.toCategoryStruct.{u3, u1} C (CategoryTheory.Groupoid.toCategory.{u3, u1} C _inst_1))) c c) (Quiver.Hom.{succ u4, u2} D (CategoryTheory.CategoryStruct.toQuiver.{u4, u2} D (CategoryTheory.Category.toCategoryStruct.{u4, u2} D (CategoryTheory.Groupoid.toCategory.{u4, u2} D _inst_2))) (CategoryTheory.Functor.obj.{u3, u4, u1, u2} C (CategoryTheory.Groupoid.toCategory.{u3, u1} C _inst_1) D (CategoryTheory.Groupoid.toCategory.{u4, u2} D _inst_2) φ c) (CategoryTheory.Functor.obj.{u3, u4, u1, u2} C (CategoryTheory.Groupoid.toCategory.{u3, u1} C _inst_1) D (CategoryTheory.Groupoid.toCategory.{u4, u2} D _inst_2) φ c)) (Monoid.toMulOneClass.{u3} (Quiver.Hom.{succ u3, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u3, u1} C (CategoryTheory.Category.toCategoryStruct.{u3, u1} C (CategoryTheory.Groupoid.toCategory.{u3, u1} C _inst_1))) c c) (DivInvMonoid.toMonoid.{u3} (Quiver.Hom.{succ u3, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u3, u1} C (CategoryTheory.Category.toCategoryStruct.{u3, u1} C (CategoryTheory.Groupoid.toCategory.{u3, u1} C _inst_1))) c c) (Group.toDivInvMonoid.{u3} (Quiver.Hom.{succ u3, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u3, u1} C (CategoryTheory.Category.toCategoryStruct.{u3, u1} C (CategoryTheory.Groupoid.toCategory.{u3, u1} C _inst_1))) c c) (CategoryTheory.Groupoid.vertexGroup.{u1, u3} C _inst_1 c)))) (Monoid.toMulOneClass.{u4} (Quiver.Hom.{succ u4, u2} D (CategoryTheory.CategoryStruct.toQuiver.{u4, u2} D (CategoryTheory.Category.toCategoryStruct.{u4, u2} D (CategoryTheory.Groupoid.toCategory.{u4, u2} D _inst_2))) (CategoryTheory.Functor.obj.{u3, u4, u1, u2} C (CategoryTheory.Groupoid.toCategory.{u3, u1} C _inst_1) D (CategoryTheory.Groupoid.toCategory.{u4, u2} D _inst_2) φ c) (CategoryTheory.Functor.obj.{u3, u4, u1, u2} C (CategoryTheory.Groupoid.toCategory.{u3, u1} C _inst_1) D (CategoryTheory.Groupoid.toCategory.{u4, u2} D _inst_2) φ c)) (DivInvMonoid.toMonoid.{u4} (Quiver.Hom.{succ u4, u2} D (CategoryTheory.CategoryStruct.toQuiver.{u4, u2} D (CategoryTheory.Category.toCategoryStruct.{u4, u2} D (CategoryTheory.Groupoid.toCategory.{u4, u2} D _inst_2))) (CategoryTheory.Functor.obj.{u3, u4, u1, u2} C (CategoryTheory.Groupoid.toCategory.{u3, u1} C _inst_1) D (CategoryTheory.Groupoid.toCategory.{u4, u2} D _inst_2) φ c) (CategoryTheory.Functor.obj.{u3, u4, u1, u2} C (CategoryTheory.Groupoid.toCategory.{u3, u1} C _inst_1) D (CategoryTheory.Groupoid.toCategory.{u4, u2} D _inst_2) φ c)) (Group.toDivInvMonoid.{u4} (Quiver.Hom.{succ u4, u2} D (CategoryTheory.CategoryStruct.toQuiver.{u4, u2} D (CategoryTheory.Category.toCategoryStruct.{u4, u2} D (CategoryTheory.Groupoid.toCategory.{u4, u2} D _inst_2))) (CategoryTheory.Functor.obj.{u3, u4, u1, u2} C (CategoryTheory.Groupoid.toCategory.{u3, u1} C _inst_1) D (CategoryTheory.Groupoid.toCategory.{u4, u2} D _inst_2) φ c) (CategoryTheory.Functor.obj.{u3, u4, u1, u2} C (CategoryTheory.Groupoid.toCategory.{u3, u1} C _inst_1) D (CategoryTheory.Groupoid.toCategory.{u4, u2} D _inst_2) φ c)) (CategoryTheory.Groupoid.vertexGroup.{u2, u4} D _inst_2 (CategoryTheory.Functor.obj.{u3, u4, u1, u2} C (CategoryTheory.Groupoid.toCategory.{u3, u1} C _inst_1) D (CategoryTheory.Groupoid.toCategory.{u4, u2} D _inst_2) φ c)))))
but is expected to have type
  forall {C : Type.{u1}} [_inst_1 : CategoryTheory.Groupoid.{u3, u1} C] {D : Type.{u2}} [_inst_2 : CategoryTheory.Groupoid.{u4, u2} D] (φ : CategoryTheory.Functor.{u3, u4, u1, u2} C (CategoryTheory.Groupoid.toCategory.{u3, u1} C _inst_1) D (CategoryTheory.Groupoid.toCategory.{u4, u2} D _inst_2)) (c : C), MonoidHom.{u3, u4} (Quiver.Hom.{succ u3, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u3, u1} C (CategoryTheory.Category.toCategoryStruct.{u3, u1} C (CategoryTheory.Groupoid.toCategory.{u3, u1} C _inst_1))) c c) (Quiver.Hom.{succ u4, u2} D (CategoryTheory.CategoryStruct.toQuiver.{u4, u2} D (CategoryTheory.Category.toCategoryStruct.{u4, u2} D (CategoryTheory.Groupoid.toCategory.{u4, u2} D _inst_2))) (Prefunctor.obj.{succ u3, succ u4, u1, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u3, u1} C (CategoryTheory.Category.toCategoryStruct.{u3, u1} C (CategoryTheory.Groupoid.toCategory.{u3, u1} C _inst_1))) D (CategoryTheory.CategoryStruct.toQuiver.{u4, u2} D (CategoryTheory.Category.toCategoryStruct.{u4, u2} D (CategoryTheory.Groupoid.toCategory.{u4, u2} D _inst_2))) (CategoryTheory.Functor.toPrefunctor.{u3, u4, u1, u2} C (CategoryTheory.Groupoid.toCategory.{u3, u1} C _inst_1) D (CategoryTheory.Groupoid.toCategory.{u4, u2} D _inst_2) φ) c) (Prefunctor.obj.{succ u3, succ u4, u1, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u3, u1} C (CategoryTheory.Category.toCategoryStruct.{u3, u1} C (CategoryTheory.Groupoid.toCategory.{u3, u1} C _inst_1))) D (CategoryTheory.CategoryStruct.toQuiver.{u4, u2} D (CategoryTheory.Category.toCategoryStruct.{u4, u2} D (CategoryTheory.Groupoid.toCategory.{u4, u2} D _inst_2))) (CategoryTheory.Functor.toPrefunctor.{u3, u4, u1, u2} C (CategoryTheory.Groupoid.toCategory.{u3, u1} C _inst_1) D (CategoryTheory.Groupoid.toCategory.{u4, u2} D _inst_2) φ) c)) (Monoid.toMulOneClass.{u3} (Quiver.Hom.{succ u3, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u3, u1} C (CategoryTheory.Category.toCategoryStruct.{u3, u1} C (CategoryTheory.Groupoid.toCategory.{u3, u1} C _inst_1))) c c) (DivInvMonoid.toMonoid.{u3} (Quiver.Hom.{succ u3, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u3, u1} C (CategoryTheory.Category.toCategoryStruct.{u3, u1} C (CategoryTheory.Groupoid.toCategory.{u3, u1} C _inst_1))) c c) (Group.toDivInvMonoid.{u3} (Quiver.Hom.{succ u3, u1} C (CategoryTheory.CategoryStruct.toQuiver.{u3, u1} C (CategoryTheory.Category.toCategoryStruct.{u3, u1} C (CategoryTheory.Groupoid.toCategory.{u3, u1} C _inst_1))) c c) (CategoryTheory.Groupoid.vertexGroup.{u1, u3} C _inst_1 c)))) (Monoid.toMulOneClass.{u4} (Quiver.Hom.{succ u4, u2} D (CategoryTheory.CategoryStruct.toQuiver.{u4, u2} D (CategoryTheory.Category.toCategoryStruct.{u4, u2} D (CategoryTheory.Groupoid.toCategory.{u4, u2} D _inst_2))) (Prefunctor.obj.{succ u3, succ u4, u1, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u3, u1} C (CategoryTheory.Category.toCategoryStruct.{u3, u1} C (CategoryTheory.Groupoid.toCategory.{u3, u1} C _inst_1))) D (CategoryTheory.CategoryStruct.toQuiver.{u4, u2} D (CategoryTheory.Category.toCategoryStruct.{u4, u2} D (CategoryTheory.Groupoid.toCategory.{u4, u2} D _inst_2))) (CategoryTheory.Functor.toPrefunctor.{u3, u4, u1, u2} C (CategoryTheory.Groupoid.toCategory.{u3, u1} C _inst_1) D (CategoryTheory.Groupoid.toCategory.{u4, u2} D _inst_2) φ) c) (Prefunctor.obj.{succ u3, succ u4, u1, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u3, u1} C (CategoryTheory.Category.toCategoryStruct.{u3, u1} C (CategoryTheory.Groupoid.toCategory.{u3, u1} C _inst_1))) D (CategoryTheory.CategoryStruct.toQuiver.{u4, u2} D (CategoryTheory.Category.toCategoryStruct.{u4, u2} D (CategoryTheory.Groupoid.toCategory.{u4, u2} D _inst_2))) (CategoryTheory.Functor.toPrefunctor.{u3, u4, u1, u2} C (CategoryTheory.Groupoid.toCategory.{u3, u1} C _inst_1) D (CategoryTheory.Groupoid.toCategory.{u4, u2} D _inst_2) φ) c)) (DivInvMonoid.toMonoid.{u4} (Quiver.Hom.{succ u4, u2} D (CategoryTheory.CategoryStruct.toQuiver.{u4, u2} D (CategoryTheory.Category.toCategoryStruct.{u4, u2} D (CategoryTheory.Groupoid.toCategory.{u4, u2} D _inst_2))) (Prefunctor.obj.{succ u3, succ u4, u1, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u3, u1} C (CategoryTheory.Category.toCategoryStruct.{u3, u1} C (CategoryTheory.Groupoid.toCategory.{u3, u1} C _inst_1))) D (CategoryTheory.CategoryStruct.toQuiver.{u4, u2} D (CategoryTheory.Category.toCategoryStruct.{u4, u2} D (CategoryTheory.Groupoid.toCategory.{u4, u2} D _inst_2))) (CategoryTheory.Functor.toPrefunctor.{u3, u4, u1, u2} C (CategoryTheory.Groupoid.toCategory.{u3, u1} C _inst_1) D (CategoryTheory.Groupoid.toCategory.{u4, u2} D _inst_2) φ) c) (Prefunctor.obj.{succ u3, succ u4, u1, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u3, u1} C (CategoryTheory.Category.toCategoryStruct.{u3, u1} C (CategoryTheory.Groupoid.toCategory.{u3, u1} C _inst_1))) D (CategoryTheory.CategoryStruct.toQuiver.{u4, u2} D (CategoryTheory.Category.toCategoryStruct.{u4, u2} D (CategoryTheory.Groupoid.toCategory.{u4, u2} D _inst_2))) (CategoryTheory.Functor.toPrefunctor.{u3, u4, u1, u2} C (CategoryTheory.Groupoid.toCategory.{u3, u1} C _inst_1) D (CategoryTheory.Groupoid.toCategory.{u4, u2} D _inst_2) φ) c)) (Group.toDivInvMonoid.{u4} (Quiver.Hom.{succ u4, u2} D (CategoryTheory.CategoryStruct.toQuiver.{u4, u2} D (CategoryTheory.Category.toCategoryStruct.{u4, u2} D (CategoryTheory.Groupoid.toCategory.{u4, u2} D _inst_2))) (Prefunctor.obj.{succ u3, succ u4, u1, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u3, u1} C (CategoryTheory.Category.toCategoryStruct.{u3, u1} C (CategoryTheory.Groupoid.toCategory.{u3, u1} C _inst_1))) D (CategoryTheory.CategoryStruct.toQuiver.{u4, u2} D (CategoryTheory.Category.toCategoryStruct.{u4, u2} D (CategoryTheory.Groupoid.toCategory.{u4, u2} D _inst_2))) (CategoryTheory.Functor.toPrefunctor.{u3, u4, u1, u2} C (CategoryTheory.Groupoid.toCategory.{u3, u1} C _inst_1) D (CategoryTheory.Groupoid.toCategory.{u4, u2} D _inst_2) φ) c) (Prefunctor.obj.{succ u3, succ u4, u1, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u3, u1} C (CategoryTheory.Category.toCategoryStruct.{u3, u1} C (CategoryTheory.Groupoid.toCategory.{u3, u1} C _inst_1))) D (CategoryTheory.CategoryStruct.toQuiver.{u4, u2} D (CategoryTheory.Category.toCategoryStruct.{u4, u2} D (CategoryTheory.Groupoid.toCategory.{u4, u2} D _inst_2))) (CategoryTheory.Functor.toPrefunctor.{u3, u4, u1, u2} C (CategoryTheory.Groupoid.toCategory.{u3, u1} C _inst_1) D (CategoryTheory.Groupoid.toCategory.{u4, u2} D _inst_2) φ) c)) (CategoryTheory.Groupoid.vertexGroup.{u2, u4} D _inst_2 (Prefunctor.obj.{succ u3, succ u4, u1, u2} C (CategoryTheory.CategoryStruct.toQuiver.{u3, u1} C (CategoryTheory.Category.toCategoryStruct.{u3, u1} C (CategoryTheory.Groupoid.toCategory.{u3, u1} C _inst_1))) D (CategoryTheory.CategoryStruct.toQuiver.{u4, u2} D (CategoryTheory.Category.toCategoryStruct.{u4, u2} D (CategoryTheory.Groupoid.toCategory.{u4, u2} D _inst_2))) (CategoryTheory.Functor.toPrefunctor.{u3, u4, u1, u2} C (CategoryTheory.Groupoid.toCategory.{u3, u1} C _inst_1) D (CategoryTheory.Groupoid.toCategory.{u4, u2} D _inst_2) φ) c)))))
Case conversion may be inaccurate. Consider using '#align category_theory.functor.map_vertex_group CategoryTheory.Groupoid.CategoryTheory.Functor.mapVertexGroupₓ'. -/
/-- A functor defines a morphism of vertex group. -/
@[simps]
def CategoryTheory.Groupoid.CategoryTheory.Functor.mapVertexGroup {D : Type v} [Groupoid D]
    (φ : C ⥤ D) (c : C) : (c ⟶ c) →* (φ.obj c ⟶ φ.obj c)
    where
  toFun := φ.map
  map_one' := φ.map_id c
  map_mul' := φ.map_comp
#align category_theory.functor.map_vertex_group CategoryTheory.Groupoid.CategoryTheory.Functor.mapVertexGroup

end Groupoid

end CategoryTheory


/-
Copyright (c) 2020 Eric Wieser. All rights reserved.
Released under MIT license as described in the file LICENSE.
Authors: Eric Wieser
-/
import data.zmod.basic
import for_mathlib.algebra.monoid_algebra
import geometric_algebra.from_mathlib.basic

variables {R : Type*} [comm_ring R]
variables {M : Type*} [add_comm_group M] [module R M]
variables {Q : quadratic_form R M}
/-!
# Grading by ℤ / 2ℤ

This file defines the grading by `zmod 2`, as the function `clifford_algebra.grades'`.

## Main results

* `clifford_algebra.grades'_left_inverse`, `grades'` has a left-inverse, `add_monoid_algebra.sum_id`.
* `clifford_algebra.grades'.map_grades'`, `grades'` is idempotent
-/

namespace clifford_algebra

/--
Separate an element of the clifford algebra into its `zmod 2`-graded components.

This is defined as an `alg_hom` to `add_monoid_algebra` so that algebra operators can be moved
before and after the mapping.

This is _not_ the normal ℕ-graded definition that we usually use in GA. That definition is harder...
-/
noncomputable def grades' :
  (clifford_algebra Q) →ₐ[R] add_monoid_algebra (clifford_algebra Q) (zmod 2) :=
(lift Q : _) ⟨
  -- vectors are grade 1
  (add_monoid_algebra.lsingle 1).comp (ι Q),
  -- this requires 1 + 1 = 0, which is why we use `zmod 2` as our grading
  λ x, by { simp [add_monoid_algebra.single_mul_single], congr }⟩

/-- Recombining the grades recovers the original element-/
lemma sum_id_comp_grades' :
  (add_monoid_algebra.sum_id R).comp grades' = alg_hom.id R (clifford_algebra Q) :=
begin
  ext,
  simp [grades', add_monoid_algebra.sum_id_apply, finsupp.sum_single_index],
end

/-- Stated another way, `grades'` has a left-inverse and is therefore injective (via `function.left_inverse.injective`). -/
lemma grades'_left_inverse :
  function.left_inverse (add_monoid_algebra.sum_id R) ⇑(grades' : clifford_algebra Q →ₐ[R] _) :=
alg_hom.congr_fun sum_id_comp_grades'

noncomputable
instance : has_coe (add_monoid_algebra (clifford_algebra Q) (zmod 2)) (clifford_algebra Q) := ⟨
  (add_monoid_algebra.sum_id R : add_monoid_algebra (clifford_algebra Q) (zmod 2) →ₐ[R] (clifford_algebra Q))
⟩

@[simp, norm_cast]
lemma coe_def (x : add_monoid_algebra (clifford_algebra Q) (zmod 2)) : (x : clifford_algebra Q) = add_monoid_algebra.sum_id R x := rfl

/-- An element of `R` lifted with `algebra_map` has a single grade 0 element -/
lemma grades'.map_algebra_map (r : R) :
  grades' (algebra_map R (clifford_algebra Q) r) = finsupp.single 0 (algebra_map R _ r) :=
by simp

/-- An element of `X` lifted with the canonical `ι R` function has a single grade 1 element -/
lemma grades'.map_ι (x : M) :
  grades' (ι Q x) = finsupp.single 1 (ι Q x) :=
by simp [grades']

-- note this is true for any `zero_hom`, not just `grades'`. Of course, then we need to repeat this
-- for `add_monoid_hom`, `add_equiv`, `linear_map`, `ring_hom`, `ring_equiv`, `alg_hom`, ...
private lemma map_single_apply (x : clifford_algebra Q) (i j : zmod 2) :
  grades' (finsupp.single i x j) = finsupp.single i (grades' x) j :=
by rw [finsupp.single_apply, finsupp.single_apply, apply_ite grades', grades'.map_zero]

-- The grade-`i` part consists only of itself -/
@[simp]
lemma grades'.map_grades' (x : clifford_algebra Q) (i : zmod 2) :
  grades' (grades' x i) = finsupp.single i (grades' x i) :=
begin
  induction x using clifford_algebra.induction generalizing i,
  case h_grade0 : {
    rw [grades'.map_algebra_map, map_single_apply, grades'.map_algebra_map,
      finsupp.single_of_single_apply],
  },
  case h_grade1 : {
    rw [grades'.map_ι, map_single_apply, grades'.map_ι,
      finsupp.single_of_single_apply],
  },
  case h_add : x y hx hy {
    rw [grades'.map_add, finsupp.add_apply, grades'.map_add, finsupp.single_add, hx, hy],
  },
  case h_mul : f g hx hy {
    rw grades'.map_mul,
    rw add_monoid_algebra.mul_def,
    simp_rw [finsupp.sum_apply],

    -- pull the sums to the outside
    have : finsupp.single i = finsupp.single_add_hom i := rfl,
    rw this,
    simp_rw alg_hom.map_finsupp_sum,
    simp_rw add_monoid_hom.map_finsupp_sum,
    simp_rw finsupp.sum,
    congr, ext1 fi,
    congr, ext1 gi,
    rw ←this,

    -- this proof now resembles the other three
    rw [map_single_apply, grades'.map_mul,
      finsupp.single_of_single_apply],
    rw [hx, hy, add_monoid_algebra.single_mul_single],
  },
end

end clifford_algebra


/-
Copyright (c) 2022 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel
-/
import category_theory.preadditive.opposite
import algebra.category.Module.basic
import algebra.category.Group.preadditive

/-!
# The Yoneda embedding for preadditive categories

The Yoneda embedding for preadditive categories sends an object `Y` to the presheaf sending an
object `X` to the group of morphisms `X ⟶ Y`. At each point, we get an additional `End Y`-module
structure.

We also show that this presheaf is additive and that it is compatible with the normal Yoneda
embedding in the expected way.

## TODO
* The Yoneda embedding is additive itself
* The Yoneda embedding for preadditive categories relates to the Yoneda embedding for linear
  categories.

-/

universes v u

open category_theory.preadditive opposite

namespace category_theory

variables {C : Type u} [category.{v} C] [preadditive C]

/--
The Yoneda embedding for preadditive categories sends an object `Y` to the presheaf sending an
object `X` to the `End Y`-module of morphisms `X ⟶ Y`.
-/
@[simps]
def preadditive_yoneda_obj (Y : C) : Cᵒᵖ ⥤ Module.{v} (End Y) :=
{ obj := λ X, Module.of _ (X.unop ⟶ Y),
  map := λ X X' f,
  { to_fun := λ g, f.unop ≫ g,
    map_add' := λ g g', comp_add _ _ _ _ _ _,
    map_smul' := λ r g, eq.symm $ category.assoc _ _ _ } }

/--
The Yoneda embedding for preadditive categories sends an object `Y` to the presheaf sending an
object `X` to the group of morphisms `X ⟶ Y`. At each point, we get an additional `End Y`-module
structure, see `preadditive_yoneda_obj`.
-/
@[simps]
def preadditive_yoneda : C ⥤ (Cᵒᵖ ⥤ AddCommGroup.{v}) :=
{ obj := λ Y, preadditive_yoneda_obj Y ⋙ forget₂ _ _,
  map := λ Y Y' f,
  { app := λ X,
    { to_fun := λ g, g ≫ f,
      map_zero' := limits.zero_comp,
      map_add' := λ g g', add_comp _ _ _ _ _ _ },
    naturality' := λ X X' g, AddCommGroup.ext _ _ _ _ $ λ x, category.assoc _ _ _ },
  map_id' := λ X, by { ext, simp },
  map_comp' := λ X Y Z f g, by { ext, simp } }

/--
The Yoneda embedding for preadditive categories sends an object `X` to the copresheaf sending an
object `Y` to the `End X`-module of morphisms `X ⟶ Y`.
-/
@[simps]
def preadditive_coyoneda_obj (X : Cᵒᵖ) : C ⥤ Module.{v} (End X) :=
{ obj := λ Y, Module.of _ (unop X ⟶ Y),
  map := λ Y Y' f,
  { to_fun := λ g, g ≫ f,
    map_add' := λ g g', add_comp _ _ _ _ _ _,
    map_smul' := λ r g, category.assoc _ _ _ } }

/--
The Yoneda embedding for preadditive categories sends an object `X` to the copresheaf sending an
object `Y` to the group of morphisms `X ⟶ Y`. At each point, we get an additional `End X`-module
structure, see `preadditive_coyoneda_obj`.
-/
@[simps]
def preadditive_coyoneda : Cᵒᵖ ⥤ (C ⥤ AddCommGroup.{v}) :=
{ obj := λ X, preadditive_coyoneda_obj X ⋙ forget₂ _ _,
  map := λ X X' f,
  { app := λ Y,
    { to_fun := λ g, f.unop ≫ g,
      map_zero' := limits.comp_zero,
      map_add' := λ g g', comp_add _ _ _ _ _ _ },
    naturality' := λ Y Y' g, AddCommGroup.ext _ _ _ _ $ λ x, eq.symm $ category.assoc _ _ _ },
  map_id' := λ X, by { ext, simp },
  map_comp' := λ X Y Z f g, by { ext, simp } }

instance additive_yoneda_obj (X : C) : functor.additive (preadditive_yoneda_obj X) := {}
instance additive_yoneda_obj' (X : C) : functor.additive (preadditive_yoneda.obj X) := {}
instance additive_coyoneda_obj (X : Cᵒᵖ) : functor.additive (preadditive_coyoneda_obj X) := {}
instance additive_coyoneda_obj' (X : Cᵒᵖ) : functor.additive (preadditive_coyoneda.obj X) := {}

/--
Composing the preadditive yoneda embedding with the forgetful functor yields the regular
Yoneda embedding.
-/
@[simp] lemma whiskering_preadditive_yoneda : preadditive_yoneda ⋙
  (whiskering_right Cᵒᵖ AddCommGroup (Type v)).obj (forget AddCommGroup) = yoneda :=
rfl

/--
Composing the preadditive yoneda embedding with the forgetful functor yields the regular
Yoneda embedding.
-/
@[simp] lemma whiskering_preadditive_coyoneda : preadditive_coyoneda ⋙
  (whiskering_right C AddCommGroup (Type v)).obj (forget AddCommGroup) = coyoneda :=
rfl

end category_theory


/- test cases for coinductive predicates -/
import data.stream
import meta.coinductive_predicates
universe u

coinductive all_stream {α : Type u} (s : set α) : stream α → Prop
| step : ∀{a : α} {ω : stream α}, a ∈ s → all_stream ω → all_stream (a :: ω)

example : Π {α : Type u}, set α → stream α → Prop :=
@all_stream
example : ∀ {α : Type u} {s : set α} {a : α} {ω : stream α}, a ∈ s → all_stream s ω →
  all_stream s (a :: ω) :=
@all_stream.step
example : ∀ {α : Type u} (s : set α) {a : stream α}, all_stream s a →
  all_stream.functional s (all_stream s) a :=
@all_stream.destruct
example : ∀ {α : Type u} (s : set α) (C : stream α → Prop) {a : stream α},
  C a →
  (∀ (a : stream α), C a → (∃ {a_1 : α} {ω : stream α}, a_1 ∈ s ∧ C ω ∧ a_1 :: ω = a)) →
  all_stream s a :=
@all_stream.corec_on
example : ∀ {α : Type u} (s : set α) (C : stream α → Prop),
    (∀ (a : stream α), C a → all_stream.functional s C a) →
      ∀ (a : stream α), C a → all_stream s a :=
@all_stream.corec_functional

coinductive all_stream' {α : Type u} (s : set α) : stream α → Prop
| step : ∀{ω : stream α}, stream.head ω ∈ s → all_stream' (stream.tail ω) → all_stream' ω

coinductive alt_stream : stream bool → Prop
| tt_step : ∀{ω : stream bool}, alt_stream (ff :: ω) → alt_stream (tt :: ff :: ω)
| ff_step : ∀{ω : stream bool}, alt_stream (tt :: ω) → alt_stream (ff :: tt :: ω)

example : stream bool → Prop := @alt_stream
example : ∀ {ω : stream bool}, alt_stream (ff :: ω) → alt_stream (tt :: ff :: ω) :=
@alt_stream.tt_step
example : ∀ {ω : stream bool}, alt_stream (tt :: ω) → alt_stream (ff :: tt :: ω) :=
@alt_stream.ff_step
example : ∀ (C : stream bool → Prop), (∀ (a : stream bool), C a → alt_stream.functional C a) →
  ∀ (a : stream bool), C a → alt_stream a :=
@alt_stream.corec_functional

mutual coinductive tt_stream, ff_stream
with tt_stream : stream bool → Prop
| step : ∀{ω : stream bool}, ff_stream ω → tt_stream (stream.cons tt ω)
with ff_stream : stream bool → Prop
| step : ∀{ω : stream bool}, tt_stream ω → ff_stream (stream.cons ff ω)

example : stream bool → Prop := @tt_stream
example : stream bool → Prop := @ff_stream
example : ∀ (C_tt_stream C_ff_stream : stream bool → Prop),
    (∀ (a : stream bool), C_tt_stream a → tt_stream.functional C_tt_stream C_ff_stream a) →
    (∀ (a : stream bool), C_ff_stream a → ff_stream.functional C_tt_stream C_ff_stream a) →
    ∀ (a : stream bool), C_tt_stream a → tt_stream a :=
@tt_stream.corec_functional
example : ∀ (C_tt_stream C_ff_stream : stream bool → Prop),
    (∀ (a : stream bool), C_tt_stream a → tt_stream.functional C_tt_stream C_ff_stream a) →
    (∀ (a : stream bool), C_ff_stream a → ff_stream.functional C_tt_stream C_ff_stream a) →
    ∀ (a : stream bool), C_ff_stream a → ff_stream a :=
@ff_stream.corec_functional

mutual coinductive tt_ff_stream, ff_tt_stream
with tt_ff_stream : stream bool → Prop
| step : ∀{ω : stream bool}, tt_ff_stream ω ∨ ff_tt_stream ω → tt_ff_stream (stream.cons tt ω)
with ff_tt_stream : stream bool → Prop
| step : ∀{ω : stream bool}, ff_tt_stream ω ∨ tt_ff_stream ω → ff_tt_stream (stream.cons ff ω)

inductive all_list {α : Type} (p : α → Prop) : list α → Prop
| nil  : all_list []
| cons : ∀a xs, p a → all_list xs → all_list (a :: xs)

@[monotonicity]
lemma monotonicity.all_list {α : Type} {p q : α → Prop} (h : ∀a, implies (p a) (q a)) :
  ∀xs, implies (all_list p xs) (all_list q xs)
| _ (all_list.nil)              := all_list.nil
| _ (all_list.cons a xs ha hxs) := all_list.cons _ _ (h a ha) (monotonicity.all_list _ hxs)

mutual coinductive walk_a, walk_b {α β : Type} (f : α → list β) (g : β → α) (p : α → Prop)
  (t : α → Prop)
with walk_a : α → Prop
| step : ∀a, all_list walk_b (f a) → p a → walk_a a
| term : ∀a, t a → walk_a a
with walk_b : β → Prop
| step : ∀b, walk_a (g b) → walk_b b

example : ∀ {α β : Type} (f : α → list β) (g : β → α) (p t C_walk_a : α → Prop)
  (C_walk_b : β → Prop) {a : α},
    C_walk_a a →
    (∀ (a : α), C_walk_a a → all_list C_walk_b (f a) ∧ p a ∨ t a) →
    (∀ (a : β), C_walk_b a → C_walk_a (g a)) → walk_a f g p t a :=
@walk_a.corec_on

coinductive walk_list {α : Type} (f : α → list α) (p : α → Prop) : ℕ → α → Prop
| step : ∀n a, all_list (walk_list n) (f a) → p a → walk_list (n + 1) a

example {f : ℕ → list ℕ} {a' : ℕ} {n : ℕ} {a : fin n} : true :=
begin
  suffices : walk_list f (λ a'', a'' = a') (n + 1) a', {trivial},
  coinduction walk_list.corec_on generalizing a n,
  show ∃ (n : ℕ),
    all_list (λ (a : ℕ), ∃ {n_1 : ℕ} {a_1 : fin n_1}, n_1 + 1 = n ∧ a' = a) (f a') ∧
      a' = a' ∧ n + 1 = w + 1,
  admit
end

coinductive coind_foo : list ℕ → Prop
| mk : ∀ xs, (∀ k l m, coind_foo (k::l::m::xs)) → coind_foo xs

meta example : true :=
begin
   success_if_fail { let := compact_relation },
   trivial
end

import_private compact_relation from tactic.coinduction

meta example : true :=
begin
  let := compact_relation,
  trivial
end


/-
Copyright (c) 2019 Reid Barton, Johan Commelin, Jesse Han, Chris Hughes, Robert Y. Lewis,
Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Reid Barton, Johan Commelin, Jesse Han, Chris Hughes, Robert Y. Lewis, Patrick Massot
-/

import tactic.fin_cases
import tactic.apply_fun
import linear_algebra.finite_dimensional
import linear_algebra.dual
import analysis.normed_space.basic
import data.real.sqrt

/-!
# Huang's sensitivity theorem

A formalization of Hao Huang's sensitivity theorem: in the hypercube of
dimension n ≥ 1, if one colors more than half the vertices then at least one
vertex has at least √n colored neighbors.

A fun summer collaboration by
Reid Barton, Johan Commelin, Jesse Han, Chris Hughes, Robert Y. Lewis, and Patrick Massot,
based on Don Knuth's account of the story
(https://www.cs.stanford.edu/~knuth/papers/huang.pdf),
using the Lean theorem prover (https://leanprover.github.io/),
by Leonardo de Moura at Microsoft Research, and his collaborators
(https://leanprover.github.io/people/),
and using Lean's user maintained mathematics library
(https://github.com/leanprover-community/mathlib).

The project was developed at https://github.com/leanprover-community/lean-sensitivity and is now
archived at https://github.com/leanprover-community/mathlib/blob/master/archive/sensitivity.lean
-/

/-! The next two lines assert we do not want to give a constructive proof,
but rather use classical logic. -/
noncomputable theory
open_locale classical

/-! We also want to use the notation `∑` for sums. -/
open_locale big_operators

notation `√` := real.sqrt

open function bool linear_map fintype finite_dimensional module.dual_bases

/-!
### The hypercube

Notations:
- `ℕ` denotes natural numbers (including zero).
- `fin n` = {0, ⋯ , n - 1}.
- `bool` = {`tt`, `ff`}.
-/

/-- The hypercube in dimension `n`. -/
@[derive [inhabited, fintype]] def Q (n : ℕ) := fin n → bool

/-- The projection from `Q (n + 1)` to `Q n` forgetting the first value
(ie. the image of zero). -/
def π {n : ℕ} : Q (n + 1) → Q n := λ p, p ∘ fin.succ

namespace Q
/-! `n` will always denote a natural number. -/
variable (n : ℕ)

/-- `Q 0` has a unique element. -/
instance : unique (Q 0) :=
⟨⟨λ _, tt⟩, by { intro, ext x, fin_cases x }⟩

/-- `Q n` has 2^n elements. -/
lemma card : card (Q n) = 2^n :=
by simp [Q]

/-! Until the end of this namespace, `n` will be an implicit argument (still
a natural number). -/
variable {n}

lemma succ_n_eq (p q : Q (n+1)) : p = q ↔ (p 0 = q 0 ∧ π p = π q) :=
begin
  split,
  { rintro rfl, exact ⟨rfl, rfl⟩, },
  { rintros ⟨h₀, h⟩,
    ext x,
    by_cases hx : x = 0,
    { rwa hx },
    { rw ← fin.succ_pred x hx,
      convert congr_fun h (fin.pred x hx) } }
end

/-- The adjacency relation defining the graph structure on `Q n`:
`p.adjacent q` if there is an edge from `p` to `q` in `Q n`. -/
def adjacent {n : ℕ} (p : Q n) : set (Q n) := λ q, ∃! i, p i ≠ q i

/-- In `Q 0`, no two vertices are adjacent. -/
lemma not_adjacent_zero (p q : Q 0) : ¬ p.adjacent q :=
by rintros ⟨v, _⟩; apply fin_zero_elim v

/-- If `p` and `q` in `Q (n+1)` have different values at zero then they are adjacent
iff their projections to `Q n` are equal. -/
lemma adj_iff_proj_eq {p q : Q (n+1)} (h₀ : p 0 ≠ q 0) :
  p.adjacent q ↔ π p = π q :=
begin
  split,
  { rintros ⟨i, h_eq, h_uni⟩,
    ext x, by_contradiction hx,
    apply fin.succ_ne_zero x,
    rw [h_uni _ hx, h_uni _ h₀] },
  { intro heq,
    use [0, h₀],
    intros y hy,
    contrapose! hy,
    rw ←fin.succ_pred _ hy,
    apply congr_fun heq }
end

/-- If `p` and `q` in `Q (n+1)` have the same value at zero then they are adjacent
iff their projections to `Q n` are adjacent. -/
lemma adj_iff_proj_adj {p q : Q (n+1)} (h₀ : p 0 = q 0) :
  p.adjacent q ↔ (π p).adjacent (π q) :=
begin
  split,
  { rintros ⟨i, h_eq, h_uni⟩,
    have h_i : i ≠ 0, from λ h_i, absurd h₀ (by rwa h_i at h_eq),
    use [i.pred h_i,
         show p (fin.succ (fin.pred i _)) ≠ q (fin.succ (fin.pred i _)),
           by rwa fin.succ_pred],
    intros y hy,
    simp [eq.symm (h_uni _ hy)] },
  { rintros ⟨i, h_eq, h_uni⟩,
    use [i.succ, h_eq],
    intros y hy,
    rw [←fin.pred_inj, fin.pred_succ],
    { apply h_uni,
      change p (fin.pred _ _).succ ≠ q (fin.pred _ _).succ,
      simp [hy] },
    { contrapose! hy,
      rw [hy, h₀] },
    { apply fin.succ_ne_zero } }
end

@[symm] lemma adjacent.symm {p q : Q n} : p.adjacent q ↔ q.adjacent p :=
by simp only [adjacent, ne_comm]

end Q

/-! ### The vector space -/

/-- The free vector space on vertices of a hypercube, defined inductively. -/
def V : ℕ → Type
| 0 := ℝ
| (n+1) := V n × V n

namespace V
variables (n : ℕ)

/-! `V n` is a real vector space whose equality relation is computable. -/

instance : decidable_eq (V n) :=
by { induction n ; { dunfold V, resetI, apply_instance } }

instance : add_comm_group (V n) :=
by { induction n ; { dunfold V, resetI, apply_instance } }

instance : module ℝ (V n) :=
by { induction n ; { dunfold V, resetI, apply_instance } }
end V

/-- The basis of `V` indexed by the hypercube, defined inductively. -/
noncomputable def e : Π {n}, Q n → V n
| 0     := λ _, (1:ℝ)
| (n+1) := λ x, cond (x 0) (e (π x), 0) (0, e (π x))

@[simp] lemma e_zero_apply (x : Q 0) : e x = (1 : ℝ) := rfl

/-- The dual basis to `e`, defined inductively. -/
noncomputable def ε : Π {n : ℕ} (p : Q n), V n →ₗ[ℝ] ℝ
| 0 _ := linear_map.id
| (n+1) p := cond (p 0) ((ε $ π p).comp $ linear_map.fst _ _ _)
               ((ε $ π p).comp $ linear_map.snd _ _ _)

variable {n : ℕ}

lemma duality (p q : Q n) : ε p (e q) = if p = q then 1 else 0 :=
begin
  induction n with n IH,
  { rw (show p = q, from subsingleton.elim p q),
    dsimp [ε, e],
    simp },
  { dsimp [ε, e],
    cases hp : p 0 ; cases hq : q 0,
    all_goals
    { repeat {rw cond_tt},
      repeat {rw cond_ff},
      simp only [linear_map.fst_apply, linear_map.snd_apply, linear_map.comp_apply, IH],
      try { congr' 1, rw Q.succ_n_eq, finish },
      try
      { erw (ε _).map_zero,
        have : p ≠ q, { intro h, rw p.succ_n_eq q at h, finish },
        simp [this] } } }
end

/-- Any vector in `V n` annihilated by all `ε p`'s is zero. -/
lemma epsilon_total {v : V n} (h : ∀ p : Q n, (ε p) v = 0) : v = 0 :=
begin
  induction n with n ih,
  { dsimp [ε] at h, exact h (λ _, tt) },
  { cases v with v₁ v₂,
    ext ; change _ = (0 : V n) ; simp only ; apply ih ; intro p ;
    [ let q : Q (n+1) := λ i, if h : i = 0 then tt else p (i.pred h),
      let q : Q (n+1) := λ i, if h : i = 0 then ff else p (i.pred h)],
    all_goals
    { specialize h q,
      rw [ε, show q 0 = tt, from rfl, cond_tt] at h <|>
        rw [ε, show q 0 = ff, from rfl, cond_ff] at h,
      rwa show p = π q, by { ext, simp [q, fin.succ_ne_zero, π] } } }
end

open module

/-- `e` and `ε` are dual families of vectors. It implies that `e` is indeed a basis
and `ε` computes coefficients of decompositions of vectors on that basis. -/
def dual_bases_e_ε (n : ℕ) : dual_bases (@e n) (@ε n) :=
{ eval := duality,
  total := @epsilon_total _ }

/-! We will now derive the dimension of `V`, first as a cardinal in `dim_V` and,
since this cardinal is finite, as a natural number in `finrank_V` -/

lemma dim_V : module.rank ℝ (V n) = 2^n :=
have module.rank ℝ (V n) = (2^n : ℕ),
  by { rw [dim_eq_card_basis (dual_bases_e_ε _).basis, Q.card]; apply_instance },
by assumption_mod_cast

instance : finite_dimensional ℝ (V n) :=
finite_dimensional.of_fintype_basis (dual_bases_e_ε _).basis

lemma finrank_V : finrank ℝ (V n) = 2^n :=
have _ := @dim_V n,
by rw ←finrank_eq_dim at this; assumption_mod_cast

/-! ### The linear map -/

/-- The linear operator $f_n$ corresponding to Huang's matrix $A_n$,
defined inductively as a ℝ-linear map from `V n` to `V n`. -/
noncomputable def f : Π n, V n →ₗ[ℝ] V n
| 0 := 0
| (n+1) := linear_map.prod
             (linear_map.coprod (f n) linear_map.id)
             (linear_map.coprod linear_map.id (-f n))

/-! The preceding definition uses linear map constructions to automatically
get that `f` is linear, but its values are somewhat buried as a side-effect.
The next two lemmas unbury them. -/

@[simp] lemma f_zero : f 0 = 0 := rfl

lemma f_succ_apply (v : V (n+1)) :
  f (n+1) v = (f n v.1 + v.2, v.1 - f n v.2) :=
begin
  cases v,
  rw f,
  simp only [linear_map.id_apply, linear_map.prod_apply, pi.prod, prod.mk.inj_iff,
    linear_map.neg_apply, sub_eq_add_neg, linear_map.coprod_apply],
  exact ⟨rfl, rfl⟩
end

/-! In the next statement, the explicit conversion `(n : ℝ)` of `n` to a real number
is necessary since otherwise `n • v` refers to the multiplication defined
using only the addition of `V`. -/

lemma f_squared : ∀ v : V n, (f n) (f n v) = (n : ℝ) • v :=
begin
  induction n with n IH; intro,
  { simpa only [nat.cast_zero, zero_smul] },
  { cases v, simp [f_succ_apply, IH, add_smul, add_assoc], abel }
end

/-! We now compute the matrix of `f` in the `e` basis (`p` is the line index,
`q` the column index). -/

lemma f_matrix :
  ∀ p q : Q n, |ε q (f n (e p))| = if q.adjacent p then 1 else 0 :=
begin
  induction n with n IH,
  { intros p q,
    dsimp [f],
    simp [Q.not_adjacent_zero] },
  { intros p q,
    have ite_nonneg : ite (π q = π p) (1 : ℝ) 0 ≥ 0,
    { split_ifs ; norm_num },
    have f_map_zero := (show (V (n+0)) →ₗ[ℝ] (V n), from f n).map_zero,
    dsimp [e, ε, f], cases hp : p 0 ; cases hq : q 0,
    all_goals
    { repeat {rw cond_tt}, repeat {rw cond_ff},
      simp [f_map_zero, hp, hq, IH, duality, abs_of_nonneg ite_nonneg, Q.adj_iff_proj_eq,
            Q.adj_iff_proj_adj] } }
end

/-- The linear operator $g_m$ corresponding to Knuth's matrix $B_m$. -/
noncomputable def g (m : ℕ) : V m →ₗ[ℝ] V (m+1) :=
linear_map.prod (f m + √(m+1) • linear_map.id) linear_map.id

/-! In the following lemmas, `m` will denote a natural number. -/
variables {m : ℕ}

/-! Again we unpack what are the values of `g`. -/
lemma g_apply : ∀ v, g m v = (f m v + √(m+1) • v, v) :=
by delta g; simp

lemma g_injective : injective (g m) :=
begin
  rw g,
  intros x₁ x₂ h,
  simp only [linear_map.prod_apply, linear_map.id_apply, prod.mk.inj_iff, pi.prod] at h,
  exact h.right
end

lemma f_image_g (w : V (m + 1)) (hv : ∃ v, g m v = w) :
  f (m + 1) w = √(m + 1) • w :=
begin
  rcases hv with ⟨v, rfl⟩,
  have : √(m+1) * √(m+1) = m+1 :=
    real.mul_self_sqrt (by exact_mod_cast zero_le _),
  simp [this, f_succ_apply, g_apply, f_squared, smul_add, add_smul, smul_smul],
  abel
end

/-!
### The main proof

In this section, in order to enforce that `n` is positive, we write it as
`m + 1` for some natural number `m`. -/

/-! `dim X` will denote the dimension of a subspace `X` as a cardinal. -/
notation `dim ` X:70 := module.rank ℝ ↥X
/-! `fdim X` will denote the (finite) dimension of a subspace `X` as a natural number. -/
notation `fdim` := finrank ℝ

/-! `Span S` will denote the ℝ-subspace spanned by `S`. -/
notation `Span` := submodule.span ℝ

/-! `Card X` will denote the cardinal of a subset of a finite type, as a
natural number. -/
notation `Card ` X:70 := X.to_finset.card

/-! In the following, `⊓` and `⊔` will denote intersection and sums of ℝ-subspaces,
equipped with their subspace structures. The notations come from the general
theory of lattices, with inf and sup (also known as meet and join). -/

/-- If a subset `H` of `Q (m+1)` has cardinal at least `2^m + 1` then the
subspace of `V (m+1)` spanned by the corresponding basis vectors non-trivially
intersects the range of `g m`. -/
lemma exists_eigenvalue (H : set (Q (m + 1))) (hH : Card H ≥ 2^m + 1) :
  ∃ y ∈ Span (e '' H) ⊓ (g m).range, y ≠ (0 : _) :=
begin
  let W := Span (e '' H),
  let img := (g m).range,
  suffices : 0 < dim (W ⊓ img),
  { simp only [exists_prop],
    exact_mod_cast exists_mem_ne_zero_of_dim_pos this },
  have dim_le : dim (W ⊔ img) ≤ 2^(m + 1),
  { convert ← dim_submodule_le (W ⊔ img),
    apply dim_V },
  have dim_add : dim (W ⊔ img) + dim (W ⊓ img) = dim W + 2^m,
  { convert ← dim_sup_add_dim_inf_eq W img,
    rw ← dim_eq_of_injective (g m) g_injective,
    apply dim_V },
  have dimW : dim W = card H,
  { have li : linear_independent ℝ (H.restrict e),
    { convert (dual_bases_e_ε _).basis.linear_independent.comp _ subtype.val_injective,
      rw (dual_bases_e_ε _).coe_basis },
    have hdW := dim_span li,
    rw set.range_restrict at hdW,
    convert hdW,
    rw [← (dual_bases_e_ε _).coe_basis, cardinal.mk_image_eq (dual_bases_e_ε _).basis.injective,
        cardinal.mk_fintype] },
  rw ← finrank_eq_dim ℝ at ⊢ dim_le dim_add dimW,
  rw [← finrank_eq_dim ℝ, ← finrank_eq_dim ℝ] at dim_add,
  norm_cast at ⊢ dim_le dim_add dimW,
  rw pow_succ' at dim_le,
  rw set.to_finset_card at hH,
  linarith
end

/-- **Huang sensitivity theorem** also known as the **Huang degree theorem** -/
theorem huang_degree_theorem (H : set (Q (m + 1))) (hH : Card H ≥ 2^m + 1) :
  ∃ q, q ∈ H ∧ √(m + 1) ≤ Card (H ∩ q.adjacent) :=
begin
  rcases exists_eigenvalue H hH with ⟨y, ⟨⟨y_mem_H, y_mem_g⟩, y_ne⟩⟩,
  have coeffs_support : ((dual_bases_e_ε (m+1)).coeffs y).support ⊆ H.to_finset,
  { intros p p_in,
    rw finsupp.mem_support_iff at p_in,
    rw set.mem_to_finset,
    exact (dual_bases_e_ε _).mem_of_mem_span y_mem_H p p_in },
  obtain ⟨q, H_max⟩ : ∃ q : Q (m+1), ∀ q' : Q (m+1), |(ε q' : _) y| ≤ |ε q y|,
    from finite.exists_max _,
  have H_q_pos : 0 < |ε q y|,
  { contrapose! y_ne,
    exact epsilon_total (λ p, abs_nonpos_iff.mp (le_trans (H_max p) y_ne)) },
  refine ⟨q, (dual_bases_e_ε _).mem_of_mem_span y_mem_H q (abs_pos.mp H_q_pos), _⟩,
  let s := √(m+1),
  suffices : s * |ε q y| ≤ ↑(_) * |ε q y|,
    from (mul_le_mul_right H_q_pos).mp ‹_›,

  let coeffs := (dual_bases_e_ε (m+1)).coeffs,
  calc
    s * |ε q y|
        = |ε q (s • y)| :
      by rw [map_smul, smul_eq_mul, abs_mul, abs_of_nonneg (real.sqrt_nonneg _)]
    ... = |ε q (f (m+1) y)| : by rw [← f_image_g y (by simpa using y_mem_g)]
    ... = |ε q (f (m+1) (lc _ (coeffs y)))| : by rw (dual_bases_e_ε _).lc_coeffs y
    ... = |(coeffs y).sum (λ (i : Q (m + 1)) (a : ℝ), a • ((ε q) ∘ (f (m + 1)) ∘
            λ (i : Q (m + 1)), e i) i)| :
      by erw [(f $ m + 1).map_finsupp_total, (ε q).map_finsupp_total, finsupp.total_apply]
    ... ≤ ∑ p in (coeffs y).support, |(coeffs y p) * (ε q $ f (m+1) $ e p)| :
      norm_sum_le _ $ λ p, coeffs y p * _
    ... = ∑ p in (coeffs y).support, |coeffs y p| * ite (q.adjacent p) 1 0 :
      by simp only [abs_mul, f_matrix]
    ... = ∑ p in (coeffs y).support.filter (Q.adjacent q), |coeffs y p| :
      by simp [finset.sum_filter]
    ... ≤ ∑ p in (coeffs y).support.filter (Q.adjacent q), |coeffs y q| :
      finset.sum_le_sum (λ p _, H_max p)
    ... = (((coeffs y).support.filter (Q.adjacent q)).card : ℝ) * |coeffs y q| :
      by rw [finset.sum_const, nsmul_eq_mul]
    ... = (((coeffs y).support ∩ (Q.adjacent q).to_finset).card : ℝ) * |coeffs y q| :
      by { congr' with x, simp, refl }
    ... ≤ (finset.card ((H ∩ Q.adjacent q).to_finset )) * |ε q y| :
      begin
        refine (mul_le_mul_right H_q_pos).2 _,
        norm_cast,
        apply finset.card_le_of_subset,
        rw set.to_finset_inter,
        convert finset.inter_subset_inter_right coeffs_support
      end
end


/-
Copyright (c) 2020 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro, Floris van Doorn, Yury Kudryashov
-/
import topology.instances.nnreal

/-!
# Square root of a real number

In this file we define

* `nnreal.sqrt` to be the square root of a nonnegative real number.
* `real.sqrt` to be the square root of a real number, defined to be zero on negative numbers.

Then we prove some basic properties of these functions.

## Implementation notes

We define `nnreal.sqrt` as the noncomputable inverse to the function `x ↦ x * x`. We use general
theory of inverses of strictly monotone functions to prove that `nnreal.sqrt x` exists. As a side
effect, `nnreal.sqrt` is a bundled `order_iso`, so for `nnreal` numbers we get continuity as well as
theorems like `sqrt x ≤ y ↔ x * x ≤ y` for free.

Then we define `real.sqrt x` to be `nnreal.sqrt (nnreal.of_real x)`. We also define a Cauchy
sequence `real.sqrt_aux (f : cau_seq ℚ abs)` which converges to `sqrt (mk f)` but do not prove (yet)
that this sequence actually converges to `sqrt (mk f)`.

## Tags

square root
-/

open set filter
open_locale filter nnreal topological_space

namespace nnreal

variables {x y : ℝ≥0}

/-- Square root of a nonnegative real number. -/
@[pp_nodot] noncomputable def sqrt : ℝ≥0 ≃o ℝ≥0 :=
order_iso.symm $ strict_mono.order_iso_of_surjective (λ x, x * x)
  (λ x y h, mul_self_lt_mul_self x.2 h) $
  (continuous_id.mul continuous_id).surjective tendsto_mul_self_at_top $
    by simp [order_bot.at_bot_eq]

lemma sqrt_eq_iff_sq_eq : sqrt x = y ↔ y * y = x :=
sqrt.to_equiv.apply_eq_iff_eq_symm_apply.trans eq_comm

lemma sqrt_le_iff : sqrt x ≤ y ↔ x ≤ y * y :=
sqrt.to_galois_connection _ _

lemma le_sqrt_iff : x ≤ sqrt y ↔ x * x ≤ y :=
(sqrt.symm.to_galois_connection _ _).symm

@[simp] lemma sqrt_eq_zero : sqrt x = 0 ↔ x = 0 :=
sqrt_eq_iff_sq_eq.trans $ by rw [eq_comm, zero_mul]

@[simp] lemma sqrt_zero : sqrt 0 = 0 := sqrt_eq_zero.2 rfl

@[simp] lemma sqrt_one : sqrt 1 = 1 := sqrt_eq_iff_sq_eq.2 $ mul_one 1

@[simp] lemma mul_sqrt_self (x : ℝ≥0) : sqrt x * sqrt x = x :=
sqrt.symm_apply_apply x

@[simp] lemma sqrt_mul_self (x : ℝ≥0) : sqrt (x * x) = x := sqrt.apply_symm_apply x

lemma sqrt_mul (x y : ℝ≥0) : sqrt (x * y) = sqrt x * sqrt y :=
by rw [sqrt_eq_iff_sq_eq, mul_mul_mul_comm, mul_sqrt_self, mul_sqrt_self]

/-- `nnreal.sqrt` as a `monoid_with_zero_hom`. -/
noncomputable def sqrt_hom : monoid_with_zero_hom ℝ≥0 ℝ≥0 := ⟨sqrt, sqrt_zero, sqrt_one, sqrt_mul⟩

lemma sqrt_inv (x : ℝ≥0) : sqrt (x⁻¹) = (sqrt x)⁻¹ := sqrt_hom.map_inv' x

lemma sqrt_div (x y : ℝ≥0) : sqrt (x / y) = sqrt x / sqrt y := sqrt_hom.map_div x y

lemma continuous_sqrt : continuous sqrt := sqrt.continuous

end nnreal

namespace real

/-- An auxiliary sequence of rational numbers that converges to `real.sqrt (mk f)`.
Currently this sequence is not used in `mathlib`.  -/
def sqrt_aux (f : cau_seq ℚ abs) : ℕ → ℚ
| 0       := rat.mk_nat (f 0).num.to_nat.sqrt (f 0).denom.sqrt
| (n + 1) := let s := sqrt_aux n in max 0 $ (s + f (n+1) / s) / 2

theorem sqrt_aux_nonneg (f : cau_seq ℚ abs) : ∀ i : ℕ, 0 ≤ sqrt_aux f i
| 0       := by rw [sqrt_aux, rat.mk_nat_eq, rat.mk_eq_div];
  apply div_nonneg; exact int.cast_nonneg.2 (int.of_nat_nonneg _)
| (n + 1) := le_max_left _ _

/- TODO(Mario): finish the proof
theorem sqrt_aux_converges (f : cau_seq ℚ abs) : ∃ h x, 0 ≤ x ∧ x * x = max 0 (mk f) ∧
  mk ⟨sqrt_aux f, h⟩ = x :=
begin
  rcases sqrt_exists (le_max_left 0 (mk f)) with ⟨x, x0, hx⟩,
  suffices : ∃ h, mk ⟨sqrt_aux f, h⟩ = x,
  { exact this.imp (λ h e, ⟨x, x0, hx, e⟩) },
  apply of_near,

  suffices : ∃ δ > 0, ∀ i, abs (↑(sqrt_aux f i) - x) < δ / 2 ^ i,
  { rcases this with ⟨δ, δ0, hδ⟩,
    intros,
     }
end -/

/-- The square root of a real number. This returns 0 for negative inputs. -/
@[pp_nodot] noncomputable def sqrt (x : ℝ) : ℝ :=
nnreal.sqrt (nnreal.of_real x)
/-quotient.lift_on x
  (λ f, mk ⟨sqrt_aux f, (sqrt_aux_converges f).fst⟩)
  (λ f g e, begin
    rcases sqrt_aux_converges f with ⟨hf, x, x0, xf, xs⟩,
    rcases sqrt_aux_converges g with ⟨hg, y, y0, yg, ys⟩,
    refine xs.trans (eq.trans _ ys.symm),
    rw [← @mul_self_inj_of_nonneg ℝ _ x y x0 y0, xf, yg],
    congr' 1, exact quotient.sound e
  end)-/

variables {x y : ℝ}

@[continuity]
lemma continuous_sqrt : continuous sqrt :=
nnreal.continuous_coe.comp $ nnreal.sqrt.continuous.comp nnreal.continuous_of_real

theorem sqrt_eq_zero_of_nonpos (h : x ≤ 0) : sqrt x = 0 :=
by simp [sqrt, nnreal.of_real_eq_zero.2 h]

theorem sqrt_nonneg (x : ℝ) : 0 ≤ sqrt x := nnreal.coe_nonneg _

@[simp] theorem mul_self_sqrt (h : 0 ≤ x) : sqrt x * sqrt x = x :=
by simp [sqrt, ← nnreal.coe_mul, nnreal.coe_of_real _ h]

@[simp] theorem sqrt_mul_self (h : 0 ≤ x) : sqrt (x * x) = x :=
(mul_self_inj_of_nonneg (sqrt_nonneg _) h).1 (mul_self_sqrt (mul_self_nonneg _))

theorem sqrt_eq_iff_mul_self_eq (hx : 0 ≤ x) (hy : 0 ≤ y) :
  sqrt x = y ↔ y * y = x :=
⟨λ h, by rw [← h, mul_self_sqrt hx], λ h, by rw [← h, sqrt_mul_self hy]⟩

@[simp] theorem sq_sqrt (h : 0 ≤ x) : sqrt x ^ 2 = x :=
by rw [sq, mul_self_sqrt h]

@[simp] theorem sqrt_sq (h : 0 ≤ x) : sqrt (x ^ 2) = x :=
by rw [sq, sqrt_mul_self h]

theorem sqrt_eq_iff_sq_eq (hx : 0 ≤ x) (hy : 0 ≤ y) :
  sqrt x = y ↔ y ^ 2 = x :=
by rw [sq, sqrt_eq_iff_mul_self_eq hx hy]

theorem sqrt_mul_self_eq_abs (x : ℝ) : sqrt (x * x) = abs x :=
by rw [← abs_mul_abs_self x, sqrt_mul_self (abs_nonneg _)]

theorem sqrt_sq_eq_abs (x : ℝ) : sqrt (x ^ 2) = abs x :=
by rw [sq, sqrt_mul_self_eq_abs]

@[simp] theorem sqrt_zero : sqrt 0 = 0 := by simp [sqrt]

@[simp] theorem sqrt_one : sqrt 1 = 1 := by simp [sqrt]

@[simp] theorem sqrt_le (hy : 0 ≤ y) : sqrt x ≤ sqrt y ↔ x ≤ y :=
by simp [sqrt, nnreal.of_real_le_of_real_iff, *]

@[simp] theorem sqrt_lt (hx : 0 ≤ x) : sqrt x < sqrt y ↔ x < y :=
lt_iff_lt_of_le_iff_le (sqrt_le hx)

theorem sqrt_le_sqrt (h : x ≤ y) : sqrt x ≤ sqrt y :=
by simp [sqrt, nnreal.of_real_le_of_real h]

theorem sqrt_le_iff : sqrt x ≤ y ↔ 0 ≤ y ∧ x ≤ y ^ 2 :=
begin
  rw [← and_iff_right_of_imp (λ h, (sqrt_nonneg x).trans h), and.congr_right_iff],
  exact sqrt_le_left
end

/- note: if you want to conclude `x ≤ sqrt y`, then use `le_sqrt_of_sq_le`.
   if you have `x > 0`, consider using `le_sqrt'` -/
theorem le_sqrt (hx : 0 ≤ x) (hy : 0 ≤ y) : x ≤ sqrt y ↔ x ^ 2 ≤ y :=
by rw [mul_self_le_mul_self_iff hx (sqrt_nonneg _), sq, mul_self_sqrt hy]

theorem le_sqrt' (hx : 0 < x) : x ≤ sqrt y ↔ x ^ 2 ≤ y :=
by { rw [sqrt, ← nnreal.coe_mk x hx.le, nnreal.coe_le_coe, nnreal.le_sqrt_iff,
  nnreal.le_of_real_iff_coe_le', sq, nnreal.coe_mul], exact mul_pos hx hx }

theorem abs_le_sqrt (h : x^2 ≤ y) : abs x ≤ sqrt y :=
by rw ← sqrt_sq_eq_abs; exact sqrt_le_sqrt h

theorem sq_le (h : 0 ≤ y) : x^2 ≤ y ↔ -sqrt y ≤ x ∧ x ≤ sqrt y :=
begin
  split,
  { simpa only [abs_le] using abs_le_sqrt },
  { rw [← abs_le, ← sq_abs],
    exact (le_sqrt (abs_nonneg x) h).mp },
end

theorem neg_sqrt_le_of_sq_le (h : x^2 ≤ y) : -sqrt y ≤ x :=
((sq_le ((sq_nonneg x).trans h)).mp h).1

theorem le_sqrt_of_sq_le (h : x^2 ≤ y) : x ≤ sqrt y :=
((sq_le ((sq_nonneg x).trans h)).mp h).2

@[simp] theorem sqrt_inj (hx : 0 ≤ x) (hy : 0 ≤ y) : sqrt x = sqrt y ↔ x = y :=
by simp [le_antisymm_iff, hx, hy]

@[simp] theorem sqrt_eq_zero (h : 0 ≤ x) : sqrt x = 0 ↔ x = 0 :=
by simpa using sqrt_inj h (le_refl _)

theorem sqrt_eq_zero' : sqrt x = 0 ↔ x ≤ 0 :=
by rw [sqrt, nnreal.coe_eq_zero, nnreal.sqrt_eq_zero, nnreal.of_real_eq_zero]

theorem sqrt_ne_zero (h : 0 ≤ x) : sqrt x ≠ 0 ↔ x ≠ 0 :=
by rw [not_iff_not, sqrt_eq_zero h]

theorem sqrt_ne_zero' : sqrt x ≠ 0 ↔ 0 < x :=
by rw [← not_le, not_iff_not, sqrt_eq_zero']

@[simp] theorem sqrt_pos : 0 < sqrt x ↔ 0 < x :=
lt_iff_lt_of_le_iff_le (iff.trans
  (by simp [le_antisymm_iff, sqrt_nonneg]) sqrt_eq_zero')

@[simp] theorem sqrt_mul (hx : 0 ≤ x) (y : ℝ) : sqrt (x * y) = sqrt x * sqrt y :=
by simp_rw [sqrt, ← nnreal.coe_mul, nnreal.coe_eq, nnreal.of_real_mul hx, nnreal.sqrt_mul]

@[simp] theorem sqrt_mul' (x) {y : ℝ} (hy : 0 ≤ y) : sqrt (x * y) = sqrt x * sqrt y :=
by rw [mul_comm, sqrt_mul hy, mul_comm]

@[simp] theorem sqrt_inv (x : ℝ) : sqrt x⁻¹ = (sqrt x)⁻¹ :=
by rw [sqrt, nnreal.of_real_inv, nnreal.sqrt_inv, nnreal.coe_inv, sqrt]

@[simp] theorem sqrt_div (hx : 0 ≤ x) (y : ℝ) : sqrt (x / y) = sqrt x / sqrt y :=
by rw [division_def, sqrt_mul hx, sqrt_inv, division_def]

@[simp] theorem div_sqrt : x / sqrt x = sqrt x :=
begin
  cases le_or_lt x 0,
  { rw [sqrt_eq_zero'.mpr h, div_zero] },
  { rw [div_eq_iff (sqrt_ne_zero'.mpr h), mul_self_sqrt h.le] },
end

theorem lt_sqrt (hx : 0 ≤ x) (hy : 0 ≤ y) : x < sqrt y ↔ x ^ 2 < y :=
by rw [mul_self_lt_mul_self_iff hx (sqrt_nonneg y), sq, mul_self_sqrt hy]

theorem sq_lt : x^2 < y ↔ -sqrt y < x ∧ x < sqrt y :=
begin
  split,
  { simpa only [← sqrt_lt (sq_nonneg x), sqrt_sq_eq_abs] using abs_lt.mp },
  { rw [← abs_lt, ← sq_abs],
    exact λ h, (lt_sqrt (abs_nonneg x) (sqrt_pos.mp (lt_of_le_of_lt (abs_nonneg x) h)).le).mp h },
end

theorem neg_sqrt_lt_of_sq_lt (h : x^2 < y) : -sqrt y < x := (sq_lt.mp h).1

theorem lt_sqrt_of_sq_lt (h : x^2 < y) : x < sqrt y := (sq_lt.mp h).2

end real

open real

variables {α : Type*}

lemma filter.tendsto.sqrt {f : α → ℝ} {l : filter α} {x : ℝ} (h : tendsto f l (𝓝 x)) :
  tendsto (λ x, sqrt (f x)) l (𝓝 (sqrt x)) :=
(continuous_sqrt.tendsto _).comp h

variables [topological_space α] {f : α → ℝ} {s : set α} {x : α}

lemma continuous_within_at.sqrt (h : continuous_within_at f s x) :
  continuous_within_at (λ x, sqrt (f x)) s x :=
h.sqrt

lemma continuous_at.sqrt (h : continuous_at f x) : continuous_at (λ x, sqrt (f x)) x := h.sqrt

lemma continuous_on.sqrt (h : continuous_on f s) : continuous_on (λ x, sqrt (f x)) s :=
λ x hx, (h x hx).sqrt

@[continuity]
lemma continuous.sqrt (h : continuous f) : continuous (λ x, sqrt (f x)) := continuous_sqrt.comp h


import algebra.field
import data.polynomial
import data.mv_polynomial
import gtm106.weierstrass_equation.basic
import gtm106.weierstrass_equation.point
import tactic

noncomputable theory

namespace weierstrass_equation

namespace regular_function_ring

/--
The `x` in `K[x,y]`
-/
def x0 {K : Type*} [comm_ring K]
: mv_polynomial (fin 2) K
:= @mv_polynomial.X K (fin 2) _ ⟨ 0, by norm_num ⟩

/--
The `y` in `K[x,y]`
-/
def y0 {K : Type*} [comm_ring K]
: mv_polynomial (fin 2) K
:= @mv_polynomial.X K (fin 2) _ ⟨ 1, by norm_num ⟩

/--
The `y^2 + a1*x*y + a3*y - x^3 - a2*x^2 - a4*x - a6` in `K[x,y]`
-/
def f0 {K : Type*} [comm_ring K]
(E : weierstrass_equation K) : mv_polynomial (fin 2) K
:= y0^2 + (mv_polynomial.C E.a1)*x0*y0 + (mv_polynomial.C E.a3)*y0 - x0^3
  - (mv_polynomial.C E.a2)*x0^2 - (mv_polynomial.C E.a4)*x0 - (mv_polynomial.C E.a6)

def I0.gen {K : Type*} [comm_ring K]
(E : weierstrass_equation K) : set (mv_polynomial (fin 2) K)
:= {f0 E}

/--
The principal idean `(y^2 + a1*x*y + a3*y - x^3 - a2*x^2 - a4*x - a6)` in `K[x,y]`
-/
def I0 {K : Type*} [comm_ring K]
(E : weierstrass_equation K) : ideal (mv_polynomial (fin 2) K)
:= ideal.span (I0.gen E)

end regular_function_ring

/--
The regular function ring of affine part,
which is `K[x,y]/(y^2 + a1*x*y + a3*y - x^3 - a2*x^2 - a4*x - a6)`
-/
@[reducible]
def regular_function_ring {K : Type*} [comm_ring K]
(E : weierstrass_equation K) :=
(regular_function_ring.I0 E).quotient

namespace regular_function_ring

def quotient_map {K : Type*} [comm_ring K]
(E : weierstrass_equation K) : ring_hom (mv_polynomial (fin 2) K) (regular_function_ring E)
:= ideal.quotient.mk (I0 E)

def C {K : Type*} [comm_ring K]
{E : weierstrass_equation K} : ring_hom K (regular_function_ring E)
:= (quotient_map E).comp (@mv_polynomial.C K (fin 2) _)

/--
The `x` in regular function ring
-/
def x {K : Type*} [comm_ring K]
{E : weierstrass_equation K}
: E.regular_function_ring
:= (quotient_map E) x0

/--
The `y` in regular function ring
-/
def y {K : Type*} [comm_ring K]
{E : weierstrass_equation K}
: E.regular_function_ring
:= (quotient_map E) y0

lemma ker {K : Type*} [comm_ring K]
(E : weierstrass_equation K)
: (y : E.regular_function_ring) ^ 2 + C E.a1 * x * y + C E.a3 * y - x ^ 3 - C E.a2 * x ^ 2 - C E.a4 * x - C E.a6 = 0 :=
begin
  simp [x, y, x0, y0, C, quotient_map],
  repeat { rw ← ring_hom.map_mul <|>
    rw ← ring_hom.map_pow <|>
    rw ← ring_hom.map_add <|>
    rw ← ring_hom.map_sub },
  rw ideal.quotient.eq_zero_iff_mem,
  have : f0 E = mv_polynomial.X 1 ^ 2
    + mv_polynomial.C E.a1 * mv_polynomial.X 0 * mv_polynomial.X 1
    + mv_polynomial.C E.a3 * mv_polynomial.X 1
    - mv_polynomial.X 0 ^ 3
    - mv_polynomial.C E.a2 * mv_polynomial.X 0 ^ 2
    - mv_polynomial.C E.a4 * mv_polynomial.X 0
    - mv_polynomial.C E.a6 := rfl,
  rw ← this,
  simp [I0, I0.gen, ideal.mem_span_singleton],
end

def eval_at_affine_point_0 {K : Type*} [comm_ring K]
(P : affine_plane_point K) : ring_hom (mv_polynomial (fin 2) K) K
:= @mv_polynomial.eval K (fin 2) _ (λ i, if i = 0 then P.x else P.y)

@[simp]
lemma eval_at_affine_point_0.C {K : Type*} [comm_ring K]
(P : affine_plane_point K) (a : K) : (eval_at_affine_point_0 P) (mv_polynomial.C a) = a :=
begin
  simp [eval_at_affine_point_0],
end

@[simp]
lemma eval_at_affine_point_0.x0 {K : Type*} [comm_ring K]
(P : affine_plane_point K) : (eval_at_affine_point_0 P) x0 = P.x :=
begin
  simp [eval_at_affine_point_0, x0],
end

@[simp]
lemma eval_at_affine_point_0.y0 {K : Type*} [comm_ring K]
(P : affine_plane_point K) : (eval_at_affine_point_0 P) y0 = P.y :=
begin
  simp [eval_at_affine_point_0, y0],
end

lemma eval_at_affine_point_0.lift {K : Type*} [comm_ring K]
(E : weierstrass_equation K)
(P : affine_plane_point K) (h1 : E.affine_point_on_curve P)
(f : mv_polynomial (fin 2) K) (h2 : f ∈ I0 E)
: eval_at_affine_point_0 P f = 0 :=
begin
  simp [affine_point_on_curve, eval_at_affine_point] at h1,
  simp [I0, ideal.span] at h2,
  refine submodule.span_induction h2 _ _ _ _,
  {
    intros f h,
    simp [I0.gen, f0] at h,
    simp [h, h1],
  },
  {
    simp [eval_at_affine_point_0],
  },
  {
    simp [eval_at_affine_point_0],
    intros f g h1 h2,
    rw [h1, h2, add_zero],
  },
  simp [eval_at_affine_point_0],
  intros f g h,
  rw [h, mul_zero],
end

def eval_at_affine_point {K : Type*} [comm_ring K]
(E : weierstrass_equation K)
(P : affine_plane_point K) (h : E.affine_point_on_curve P)
: ring_hom E.regular_function_ring K
:= ideal.quotient.lift (I0 E) (eval_at_affine_point_0 P)
(eval_at_affine_point_0.lift E P h)

@[simp]
lemma eval_at_affine_point.C {K : Type*} [comm_ring K]
(E : weierstrass_equation K)
(P : affine_plane_point K) (h : E.affine_point_on_curve P)
(a : K) : (eval_at_affine_point E P h) (C a) = a :=
begin
  simp [eval_at_affine_point, C, quotient_map],
end

@[simp]
lemma eval_at_affine_point.x {K : Type*} [comm_ring K]
(E : weierstrass_equation K)
(P : affine_plane_point K) (h : E.affine_point_on_curve P)
: (eval_at_affine_point E P h) x = P.x :=
begin
  simp [eval_at_affine_point, x, quotient_map],
end

@[simp]
lemma eval_at_affine_point.y {K : Type*} [comm_ring K]
(E : weierstrass_equation K)
(P : affine_plane_point K) (h : E.affine_point_on_curve P)
: (eval_at_affine_point E P h) y = P.y :=
begin
  simp [eval_at_affine_point, y, quotient_map],
end

end regular_function_ring

end weierstrass_equation