-- Mathlib/AlgebraicGeometry/EllipticCurve/Group.lean
lemma XYIdeal_mul_XYIdeal {x₁ x₂ y₁ y₂ : F} (h₁ : W.Equation x₁ y₁) (h₂ : W.Equation x₂ y₂)
    (hxy : ¬(x₁ = x₂ ∧ y₁ = W.negY x₂ y₂)) :
    XIdeal W (W.addX x₁ x₂ <| W.slope x₁ x₂ y₁ y₂) * (XYIdeal W x₁ (C y₁) * XYIdeal W x₂ (C y₂)) =
      YIdeal W (linePolynomial x₁ y₁ <| W.slope x₁ x₂ y₁ y₂) *
        XYIdeal W (W.addX x₁ x₂ <| W.slope x₁ x₂ y₁ y₂)
          (C <| W.addY x₁ x₂ y₁ <| W.slope x₁ x₂ y₁ y₂)

Proof state:
case neg
F : Type u
inst✝ : Field F
W : Affine F
x₁ x₂ y₁ y₂ : F
h₁ : W.Equation x₁ y₁
h₂ : W.Equation x₂ y₂
hxy : ¬(x₁ = x₂ ∧ y₁ = W.negY x₂ y₂)
sup_rw : ∀ (a b c d : Ideal W.CoordinateRing), a ⊔ (b ⊔ (c ⊔ d)) = a ⊔ d ⊔ b ⊔ c
hx : x₁ - x₂ ≠ 0
⊢ C (C (x₁ - x₂)) * (0 * (Y - W.negPolynomial)) =
    C (C (x₁ - x₂)) * (1 + C (C (x₁ - x₂)⁻¹) * C (X - C x₁) + C (C ((x₁ - x₂)⁻¹ * -1)) * C (X - C x₂))

Tactic:
simp only [← mul_assoc, mul_add, ← C_mul, mul_inv_cancel₀ hx]

Result:
case neg
F : Type u
inst✝ : Field F
W : Affine F
x₁ x₂ y₁ y₂ : F
h₁ : W.Equation x₁ y₁
h₂ : W.Equation x₂ y₂
hxy : ¬(x₁ = x₂ ∧ y₁ = W.negY x₂ y₂)
sup_rw : ∀ (a b c d : Ideal W.CoordinateRing), a ⊔ (b ⊔ (c ⊔ d)) = a ⊔ d ⊔ b ⊔ c
hx : x₁ - x₂ ≠ 0
⊢ C (C (x₁ - x₂)) * 0 * (Y - W.negPolynomial) = C (C (x₁ - x₂)) * 1 + C (C 1 * (X - C x₁)) + C (C (1 * -1) * (X - C x₂))

Proof state:
case neg
F : Type u
inst✝ : Field F
W : Affine F
x₁ x₂ y₁ y₂ : F
h₁ : W.Equation x₁ y₁
h₂ : W.Equation x₂ y₂
hxy : ¬(x₁ = x₂ ∧ y₁ = W.negY x₂ y₂)
sup_rw : ∀ (a b c d : Ideal W.CoordinateRing), a ⊔ (b ⊔ (c ⊔ d)) = a ⊔ d ⊔ b ⊔ c
hx : ¬x₁ = x₂
⊢ ∃ x,
    (∃ a a_1 a_2, a_2 * (Y - W.negPolynomial) = x + a * C (X - C x₁) + a_1 * C (X - C x₂)) ∧
      (AdjoinRoot.mk W.polynomial) x = 1

Tactic:
replace hx := sub_ne_zero_of_ne hx

Result:
case neg
F : Type u
inst✝ : Field F
W : Affine F
x₁ x₂ y₁ y₂ : F
h₁ : W.Equation x₁ y₁
h₂ : W.Equation x₂ y₂
hxy : ¬(x₁ = x₂ ∧ y₁ = W.negY x₂ y₂)
sup_rw : ∀ (a b c d : Ideal W.CoordinateRing), a ⊔ (b ⊔ (c ⊔ d)) = a ⊔ d ⊔ b ⊔ c
hx : x₁ - x₂ ≠ 0
⊢ ∃ x,
    (∃ a a_1 a_2, a_2 * (Y - W.negPolynomial) = x + a * C (X - C x₁) + a_1 * C (X - C x₂)) ∧
      (AdjoinRoot.mk W.polynomial) x = 1

Proof state:
case pos
F : Type u
inst✝ : Field F
W : Affine F
x₁ y₁ : F
h₁ : W.Equation x₁ y₁
sup_rw : ∀ (a b c d : Ideal W.CoordinateRing), a ⊔ (b ⊔ (c ⊔ d)) = a ⊔ d ⊔ b ⊔ c
h₂ : W.Equation x₁ y₁
hy : y₁ ≠ W.negY x₁ y₁
y : F := (y₁ - W.negY x₁ y₁) ^ 2
hxy : (y₁ - W.negY x₁ y₁) ^ 2 ≠ 0
⊢ C (C y⁻¹) * (Y - W.negPolynomial) * (Y - W.negPolynomial) =
    1 + C (C (y⁻¹ * 4)) * W.polynomial +
        C (C y⁻¹ * (C 4 * X ^ 2 + C (4 * x₁ + b₂ W) * X + C (4 * x₁ ^ 2 + b₂ W * x₁ + 2 * b₄ W))) * C (X - C x₁) +
      0 * C (X - C x₁)

Tactic:
rw [polynomial, negPolynomial, ← mul_right_inj' <| C_ne_zero.mpr <| C_ne_zero.mpr hxy]

Result:
case pos
F : Type u
inst✝ : Field F
W : Affine F
x₁ y₁ : F
h₁ : W.Equation x₁ y₁
sup_rw : ∀ (a b c d : Ideal W.CoordinateRing), a ⊔ (b ⊔ (c ⊔ d)) = a ⊔ d ⊔ b ⊔ c
h₂ : W.Equation x₁ y₁
hy : y₁ ≠ W.negY x₁ y₁
y : F := (y₁ - W.negY x₁ y₁) ^ 2
hxy : (y₁ - W.negY x₁ y₁) ^ 2 ≠ 0
⊢ C (C ((y₁ - W.negY x₁ y₁) ^ 2)) *
      (C (C y⁻¹) * (Y - (-Y - C (C W.a₁ * X + C W.a₃))) * (Y - (-Y - C (C W.a₁ * X + C W.a₃)))) =
    C (C ((y₁ - W.negY x₁ y₁) ^ 2)) *
      (1 + C (C (y⁻¹ * 4)) * (Y ^ 2 + C (C W.a₁ * X + C W.a₃) * Y - C (X ^ 3 + C W.a₂ * X ^ 2 + C W.a₄ * X + C W.a₆)) +
          C (C y⁻¹ * (C 4 * X ^ 2 + C (4 * x₁ + b₂ W) * X + C (4 * x₁ ^ 2 + b₂ W * x₁ + 2 * b₄ W))) * C (X - C x₁) +
        0 * C (X - C x₁))

Proof state:
case pos
F : Type u
inst✝ : Field F
W : Affine F
x₁ y₁ : F
h₁ : W.Equation x₁ y₁
sup_rw : ∀ (a b c d : Ideal W.CoordinateRing), a ⊔ (b ⊔ (c ⊔ d)) = a ⊔ d ⊔ b ⊔ c
h₂ : W.Equation x₁ y₁
hy : y₁ ≠ W.negY x₁ y₁
y : F := (y₁ - W.negY x₁ y₁) ^ 2
hxy : (y₁ - W.negY x₁ y₁) ^ 2 ≠ 0
⊢ ∃ x,
    (∃ a a_1 a_2, a_2 * (Y - W.negPolynomial) = x + a * C (X - C x₁) + a_1 * C (X - C x₁)) ∧
      (AdjoinRoot.mk W.polynomial) x = 1

Tactic:
refine ⟨1 + C (C <| y⁻¹ * 4) * W.polynomial,
  ⟨C <| C y⁻¹ * (C 4 * X ^ 2 + C (4 * x₁ + W.b₂) * X + C (4 * x₁ ^ 2 + W.b₂ * x₁ + 2 * W.b₄)),
    0, C (C y⁻¹) * (Y - W.negPolynomial), ?_⟩, by
  rw [map_add, map_one, _root_.map_mul <| mk W, AdjoinRoot.mk_self, mul_zero, add_zero]⟩

Result:
case pos
F : Type u
inst✝ : Field F
W : Affine F
x₁ y₁ : F
h₁ : W.Equation x₁ y₁
sup_rw : ∀ (a b c d : Ideal W.CoordinateRing), a ⊔ (b ⊔ (c ⊔ d)) = a ⊔ d ⊔ b ⊔ c
h₂ : W.Equation x₁ y₁
hy : y₁ ≠ W.negY x₁ y₁
y : F := (y₁ - W.negY x₁ y₁) ^ 2
hxy : (y₁ - W.negY x₁ y₁) ^ 2 ≠ 0
⊢ C (C y⁻¹) * (Y - W.negPolynomial) * (Y - W.negPolynomial) =
    1 + C (C (y⁻¹ * 4)) * W.polynomial +
        C (C y⁻¹ * (C 4 * X ^ 2 + C (4 * x₁ + b₂ W) * X + C (4 * x₁ ^ 2 + b₂ W * x₁ + 2 * b₄ W))) * C (X - C x₁) +
      0 * C (X - C x₁)

Proof state:
case pos
F : Type u
inst✝ : Field F
W : Affine F
x₁ y₁ : F
h₁ : W.Equation x₁ y₁
sup_rw : ∀ (a b c d : Ideal W.CoordinateRing), a ⊔ (b ⊔ (c ⊔ d)) = a ⊔ d ⊔ b ⊔ c
h₂ : W.Equation x₁ y₁
hxy : ¬(x₁ = x₁ ∧ y₁ = W.negY x₁ y₁)
hy : y₁ ≠ W.negY x₁ y₁
y : F := (y₁ - W.negY x₁ y₁) ^ 2
⊢ ∃ x,
    (∃ a a_1 a_2, a_2 * (Y - W.negPolynomial) = x + a * C (X - C x₁) + a_1 * C (X - C x₁)) ∧
      (AdjoinRoot.mk W.polynomial) x = 1

Tactic:
replace hxy := pow_ne_zero 2 <| sub_ne_zero_of_ne hy

Result:
case pos
F : Type u
inst✝ : Field F
W : Affine F
x₁ y₁ : F
h₁ : W.Equation x₁ y₁
sup_rw : ∀ (a b c d : Ideal W.CoordinateRing), a ⊔ (b ⊔ (c ⊔ d)) = a ⊔ d ⊔ b ⊔ c
h₂ : W.Equation x₁ y₁
hy : y₁ ≠ W.negY x₁ y₁
y : F := (y₁ - W.negY x₁ y₁) ^ 2
hxy : (y₁ - W.negY x₁ y₁) ^ 2 ≠ 0
⊢ ∃ x,
    (∃ a a_1 a_2, a_2 * (Y - W.negPolynomial) = x + a * C (X - C x₁) + a_1 * C (X - C x₁)) ∧
      (AdjoinRoot.mk W.polynomial) x = 1

Proof state:
case a.a
F : Type u
inst✝ : Field F
W : Affine F
x₁ y₁ : F
h₁ : W.Equation x₁ y₁
sup_rw : ∀ (a b c d : Ideal W.CoordinateRing), a ⊔ (b ⊔ (c ⊔ d)) = a ⊔ d ⊔ b ⊔ c
h₂ : W.Equation x₁ y₁
hy : y₁ ≠ W.negY x₁ y₁
y : F := (y₁ - W.negY x₁ y₁) ^ 2
hxy : (y₁ - W.negY x₁ y₁) ^ 2 ≠ 0
⊢ 1 * (Y - (-Y - (C (C W.a₁) * C X + C (C W.a₃)))) * (Y - (-Y - (C (C W.a₁) * C X + C (C W.a₃)))) +
        -4 * (C (C x₁) ^ 3 + C (C W.a₂) * C (C x₁) ^ 2 + C (C W.a₄) * C (C x₁) + C (C W.a₆)) -
      ((C (C y₁) - (-C (C y₁) - C (C W.a₁) * C (C x₁) - C (C W.a₃))) ^ 2 * 1 +
              1 * 4 *
                (Y ^ 2 + (C (C W.a₁) * C X + C (C W.a₃)) * Y -
                  (C X ^ 3 + C (C W.a₂) * C X ^ 2 + C (C W.a₄) * C X + C (C W.a₆))) +
            (1 * 4 * C X ^ 2 + (1 * 4 * C (C x₁) + 1 * (C (C W.a₁) ^ 2 + 4 * C (C W.a₂))) * C X +
                (1 * 4 * C (C x₁) ^ 2 + 1 * (C (C W.a₁) ^ 2 + 4 * C (C W.a₂)) * C (C x₁) +
                  1 * 2 * (2 * C (C W.a₄) + C (C W.a₁) * C (C W.a₃)))) *
              (C X - C (C x₁)) +
          (C (C y₁) - (-C (C y₁) - C (C W.a₁) * C (C x₁) - C (C W.a₃))) ^ 2 * 0 * (C X - C (C x₁)) +
        -4 * (C (C y₁) ^ 2 + C (C W.a₁) * C (C x₁) * C (C y₁) + C (C W.a₃) * C (C y₁))) =
    0

Tactic:
ring1

Result:
no goals

Proof state:
case h.e'_2.h.e'_5
F : Type u
inst✝ : Field F
W : Affine F
x₁ x₂ y₁ y₂ : F
h₁ : W.Equation x₁ y₁
h₂ : W.Equation x₂ y₂
hxy : ¬(x₁ = x₂ ∧ y₁ = W.negY x₂ y₂)
sup_rw : ∀ (a b c d : Ideal W.CoordinateRing), a ⊔ (b ⊔ (c ⊔ d)) = a ⊔ d ⊔ b ⊔ c
⊢ span {XClass W x₁} ⊔ (span {XClass W x₂} ⊔ span {(mk W) (Y - W.negPolynomial)}) = ⊤

Tactic:
simp_rw [XClass, ← Set.image_singleton (f := mk W), ← map_span, ← Ideal.map_sup, eq_top_iff_one,
  mem_map_iff_of_surjective _ AdjoinRoot.mk_surjective, ← span_insert, mem_span_insert',
  mem_span_singleton']

Result:
case h.e'_2.h.e'_5
F : Type u
inst✝ : Field F
W : Affine F
x₁ x₂ y₁ y₂ : F
h₁ : W.Equation x₁ y₁
h₂ : W.Equation x₂ y₂
hxy : ¬(x₁ = x₂ ∧ y₁ = W.negY x₂ y₂)
sup_rw : ∀ (a b c d : Ideal W.CoordinateRing), a ⊔ (b ⊔ (c ⊔ d)) = a ⊔ d ⊔ b ⊔ c
⊢ ∃ x,
    (∃ a a_1 a_2, a_2 * (Y - W.negPolynomial) = x + a * C (X - C x₁) + a_1 * C (X - C x₂)) ∧
      (AdjoinRoot.mk W.polynomial) x = 1