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

! This file was ported from Lean 3 source module number_theory.ADE_inequality
! leanprover-community/mathlib commit 1ead22342e1a078bd44744ace999f85756555d35
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Multiset.Sort
import Mathbin.Data.Pnat.Interval
import Mathbin.Data.Rat.Order
import Mathbin.Data.Pnat.Basic
import Mathbin.Tactic.NormNum
import Mathbin.Tactic.FieldSimp
import Mathbin.Tactic.IntervalCases

/-!
# The inequality `p⁻¹ + q⁻¹ + r⁻¹ > 1`

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

In this file we classify solutions to the inequality
`(p⁻¹ + q⁻¹ + r⁻¹ : ℚ) > 1`, for positive natural numbers `p`, `q`, and `r`.

The solutions are exactly of the form.
* `A' q r := {1,q,r}`
* `D' r := {2,2,r}`
* `E6 := {2,3,3}`, or `E7 := {2,3,4}`, or `E8 := {2,3,5}`

This inequality shows up in Lie theory,
in the classification of Dynkin diagrams, root systems, and semisimple Lie algebras.

## Main declarations

* `pqr.A' q r`, the multiset `{1,q,r}`
* `pqr.D' r`, the multiset `{2,2,r}`
* `pqr.E6`, the multiset `{2,3,3}`
* `pqr.E7`, the multiset `{2,3,4}`
* `pqr.E8`, the multiset `{2,3,5}`
* `pqr.classification`, the classification of solutions to `p⁻¹ + q⁻¹ + r⁻¹ > 1`

-/

namespace ADEInequality

open Multiset

#print ADEInequality.A' /-
/-- `A' q r := {1,q,r}` is a `multiset ℕ+`
that is a solution to the inequality
`(p⁻¹ + q⁻¹ + r⁻¹ : ℚ) > 1`. -/
def A' (q r : ℕ+) : Multiset ℕ+ :=
  {1, q, r}
#align ADE_inequality.A' ADEInequality.A'
-/

#print ADEInequality.A /-
/-- `A r := {1,1,r}` is a `multiset ℕ+`
that is a solution to the inequality
`(p⁻¹ + q⁻¹ + r⁻¹ : ℚ) > 1`.

These solutions are related to the Dynkin diagrams $A_r$. -/
def A (r : ℕ+) : Multiset ℕ+ :=
  A' 1 r
#align ADE_inequality.A ADEInequality.A
-/

#print ADEInequality.D' /-
/-- `D' r := {2,2,r}` is a `multiset ℕ+`
that is a solution to the inequality
`(p⁻¹ + q⁻¹ + r⁻¹ : ℚ) > 1`.

These solutions are related to the Dynkin diagrams $D_{r+2}$. -/
def D' (r : ℕ+) : Multiset ℕ+ :=
  {2, 2, r}
#align ADE_inequality.D' ADEInequality.D'
-/

#print ADEInequality.E' /-
/-- `E' r := {2,3,r}` is a `multiset ℕ+`.
For `r ∈ {3,4,5}` is a solution to the inequality
`(p⁻¹ + q⁻¹ + r⁻¹ : ℚ) > 1`.

These solutions are related to the Dynkin diagrams $E_{r+3}$. -/
def E' (r : ℕ+) : Multiset ℕ+ :=
  {2, 3, r}
#align ADE_inequality.E' ADEInequality.E'
-/

#print ADEInequality.E6 /-
/-- `E6 := {2,3,3}` is a `multiset ℕ+`
that is a solution to the inequality
`(p⁻¹ + q⁻¹ + r⁻¹ : ℚ) > 1`.

This solution is related to the Dynkin diagrams $E_6$. -/
def E6 : Multiset ℕ+ :=
  E' 3
#align ADE_inequality.E6 ADEInequality.E6
-/

#print ADEInequality.E7 /-
/-- `E7 := {2,3,4}` is a `multiset ℕ+`
that is a solution to the inequality
`(p⁻¹ + q⁻¹ + r⁻¹ : ℚ) > 1`.

This solution is related to the Dynkin diagrams $E_7$. -/
def E7 : Multiset ℕ+ :=
  E' 4
#align ADE_inequality.E7 ADEInequality.E7
-/

#print ADEInequality.E8 /-
/-- `E8 := {2,3,5}` is a `multiset ℕ+`
that is a solution to the inequality
`(p⁻¹ + q⁻¹ + r⁻¹ : ℚ) > 1`.

This solution is related to the Dynkin diagrams $E_8$. -/
def E8 : Multiset ℕ+ :=
  E' 5
#align ADE_inequality.E8 ADEInequality.E8
-/

#print ADEInequality.sumInv /-
/-- `sum_inv pqr` for a `pqr : multiset ℕ+` is the sum of the inverses
of the elements of `pqr`, as rational number.

The intended argument is a multiset `{p,q,r}` of cardinality `3`. -/
def sumInv (pqr : Multiset ℕ+) : ℚ :=
  Multiset.sum <| pqr.map fun x => x⁻¹
#align ADE_inequality.sum_inv ADEInequality.sumInv
-/

/- warning: ADE_inequality.sum_inv_pqr -> ADEInequality.sumInv_pqr is a dubious translation:
lean 3 declaration is
  forall (p : PNat) (q : PNat) (r : PNat), Eq.{1} Rat (ADEInequality.sumInv (Insert.insert.{0, 0} PNat (Multiset.{0} PNat) (Multiset.hasInsert.{0} PNat) p (Insert.insert.{0, 0} PNat (Multiset.{0} PNat) (Multiset.hasInsert.{0} PNat) q (Singleton.singleton.{0, 0} PNat (Multiset.{0} PNat) (Multiset.hasSingleton.{0} PNat) r)))) (HAdd.hAdd.{0, 0, 0} Rat Rat Rat (instHAdd.{0} Rat Rat.hasAdd) (HAdd.hAdd.{0, 0, 0} Rat Rat Rat (instHAdd.{0} Rat Rat.hasAdd) (Inv.inv.{0} Rat Rat.hasInv ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) PNat Rat (HasLiftT.mk.{1, 1} PNat Rat (CoeTCₓ.coe.{1, 1} PNat Rat (coeTrans.{1, 1, 1} PNat Nat Rat (Nat.castCoe.{0} Rat (AddMonoidWithOne.toNatCast.{0} Rat (AddGroupWithOne.toAddMonoidWithOne.{0} Rat (AddCommGroupWithOne.toAddGroupWithOne.{0} Rat (Ring.toAddCommGroupWithOne.{0} Rat (DivisionRing.toRing.{0} Rat Rat.divisionRing)))))) coePNatNat))) p)) (Inv.inv.{0} Rat Rat.hasInv ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) PNat Rat (HasLiftT.mk.{1, 1} PNat Rat (CoeTCₓ.coe.{1, 1} PNat Rat (coeTrans.{1, 1, 1} PNat Nat Rat (Nat.castCoe.{0} Rat (AddMonoidWithOne.toNatCast.{0} Rat (AddGroupWithOne.toAddMonoidWithOne.{0} Rat (AddCommGroupWithOne.toAddGroupWithOne.{0} Rat (Ring.toAddCommGroupWithOne.{0} Rat (DivisionRing.toRing.{0} Rat Rat.divisionRing)))))) coePNatNat))) q))) (Inv.inv.{0} Rat Rat.hasInv ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) PNat Rat (HasLiftT.mk.{1, 1} PNat Rat (CoeTCₓ.coe.{1, 1} PNat Rat (coeTrans.{1, 1, 1} PNat Nat Rat (Nat.castCoe.{0} Rat (AddMonoidWithOne.toNatCast.{0} Rat (AddGroupWithOne.toAddMonoidWithOne.{0} Rat (AddCommGroupWithOne.toAddGroupWithOne.{0} Rat (Ring.toAddCommGroupWithOne.{0} Rat (DivisionRing.toRing.{0} Rat Rat.divisionRing)))))) coePNatNat))) r)))
but is expected to have type
  forall (p : PNat) (q : PNat) (r : PNat), Eq.{1} Rat (ADEInequality.sumInv (Insert.insert.{0, 0} PNat (Multiset.{0} PNat) (Multiset.instInsertMultiset.{0} PNat) p (Insert.insert.{0, 0} PNat (Multiset.{0} PNat) (Multiset.instInsertMultiset.{0} PNat) q (Singleton.singleton.{0, 0} PNat (Multiset.{0} PNat) (Multiset.instSingletonMultiset.{0} PNat) r)))) (HAdd.hAdd.{0, 0, 0} Rat Rat Rat (instHAdd.{0} Rat Rat.instAddRat) (HAdd.hAdd.{0, 0, 0} Rat Rat Rat (instHAdd.{0} Rat Rat.instAddRat) (Inv.inv.{0} Rat Rat.instInvRat (Nat.cast.{0} Rat (NonAssocRing.toNatCast.{0} Rat (Ring.toNonAssocRing.{0} Rat (DivisionRing.toRing.{0} Rat Rat.divisionRing))) (PNat.val p))) (Inv.inv.{0} Rat Rat.instInvRat (Nat.cast.{0} Rat (NonAssocRing.toNatCast.{0} Rat (Ring.toNonAssocRing.{0} Rat (DivisionRing.toRing.{0} Rat Rat.divisionRing))) (PNat.val q)))) (Inv.inv.{0} Rat Rat.instInvRat (Nat.cast.{0} Rat (NonAssocRing.toNatCast.{0} Rat (Ring.toNonAssocRing.{0} Rat (DivisionRing.toRing.{0} Rat Rat.divisionRing))) (PNat.val r))))
Case conversion may be inaccurate. Consider using '#align ADE_inequality.sum_inv_pqr ADEInequality.sumInv_pqrₓ'. -/
theorem sumInv_pqr (p q r : ℕ+) : sumInv {p, q, r} = p⁻¹ + q⁻¹ + r⁻¹ := by
  simp only [sum_inv, coe_coe, add_zero, insert_eq_cons, add_assoc, map_cons, sum_cons,
    map_singleton, sum_singleton]
#align ADE_inequality.sum_inv_pqr ADEInequality.sumInv_pqr

#print ADEInequality.Admissible /-
/-- A multiset `pqr` of positive natural numbers is `admissible`
if it is equal to `A' q r`, or `D' r`, or one of `E6`, `E7`, or `E8`. -/
def Admissible (pqr : Multiset ℕ+) : Prop :=
  (∃ q r, A' q r = pqr) ∨ (∃ r, D' r = pqr) ∨ E' 3 = pqr ∨ E' 4 = pqr ∨ E' 5 = pqr
#align ADE_inequality.admissible ADEInequality.Admissible
-/

#print ADEInequality.admissible_A' /-
theorem admissible_A' (q r : ℕ+) : Admissible (A' q r) :=
  Or.inl ⟨q, r, rfl⟩
#align ADE_inequality.admissible_A' ADEInequality.admissible_A'
-/

#print ADEInequality.admissible_D' /-
theorem admissible_D' (n : ℕ+) : Admissible (D' n) :=
  Or.inr <| Or.inl ⟨n, rfl⟩
#align ADE_inequality.admissible_D' ADEInequality.admissible_D'
-/

/- warning: ADE_inequality.admissible_E'3 -> ADEInequality.admissible_E'3 is a dubious translation:
lean 3 declaration is
  ADEInequality.Admissible (ADEInequality.E' (OfNat.ofNat.{0} PNat 3 (OfNat.mk.{0} PNat 3 (bit1.{0} PNat PNat.hasOne PNat.hasAdd (One.one.{0} PNat PNat.hasOne)))))
but is expected to have type
  ADEInequality.Admissible (ADEInequality.E' (OfNat.ofNat.{0} PNat 3 (instOfNatPNatHAddNatInstHAddInstAddNatOfNat (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2)))))
Case conversion may be inaccurate. Consider using '#align ADE_inequality.admissible_E'3 ADEInequality.admissible_E'3ₓ'. -/
theorem admissible_E'3 : Admissible (E' 3) :=
  Or.inr <| Or.inr <| Or.inl rfl
#align ADE_inequality.admissible_E'3 ADEInequality.admissible_E'3

/- warning: ADE_inequality.admissible_E'4 -> ADEInequality.admissible_E'4 is a dubious translation:
lean 3 declaration is
  ADEInequality.Admissible (ADEInequality.E' (OfNat.ofNat.{0} PNat 4 (OfNat.mk.{0} PNat 4 (bit0.{0} PNat PNat.hasAdd (bit0.{0} PNat PNat.hasAdd (One.one.{0} PNat PNat.hasOne))))))
but is expected to have type
  ADEInequality.Admissible (ADEInequality.E' (OfNat.ofNat.{0} PNat 4 (instOfNatPNatHAddNatInstHAddInstAddNatOfNat (OfNat.ofNat.{0} Nat 3 (instOfNatNat 3)))))
Case conversion may be inaccurate. Consider using '#align ADE_inequality.admissible_E'4 ADEInequality.admissible_E'4ₓ'. -/
theorem admissible_E'4 : Admissible (E' 4) :=
  Or.inr <| Or.inr <| Or.inr <| Or.inl rfl
#align ADE_inequality.admissible_E'4 ADEInequality.admissible_E'4

/- warning: ADE_inequality.admissible_E'5 -> ADEInequality.admissible_E'5 is a dubious translation:
lean 3 declaration is
  ADEInequality.Admissible (ADEInequality.E' (OfNat.ofNat.{0} PNat 5 (OfNat.mk.{0} PNat 5 (bit1.{0} PNat PNat.hasOne PNat.hasAdd (bit0.{0} PNat PNat.hasAdd (One.one.{0} PNat PNat.hasOne))))))
but is expected to have type
  ADEInequality.Admissible (ADEInequality.E' (OfNat.ofNat.{0} PNat 5 (instOfNatPNatHAddNatInstHAddInstAddNatOfNat (OfNat.ofNat.{0} Nat 4 (instOfNatNat 4)))))
Case conversion may be inaccurate. Consider using '#align ADE_inequality.admissible_E'5 ADEInequality.admissible_E'5ₓ'. -/
theorem admissible_E'5 : Admissible (E' 5) :=
  Or.inr <| Or.inr <| Or.inr <| Or.inr rfl
#align ADE_inequality.admissible_E'5 ADEInequality.admissible_E'5

#print ADEInequality.admissible_E6 /-
theorem admissible_E6 : Admissible E6 :=
  admissible_E'3
#align ADE_inequality.admissible_E6 ADEInequality.admissible_E6
-/

#print ADEInequality.admissible_E7 /-
theorem admissible_E7 : Admissible E7 :=
  admissible_E'4
#align ADE_inequality.admissible_E7 ADEInequality.admissible_E7
-/

#print ADEInequality.admissible_E8 /-
theorem admissible_E8 : Admissible E8 :=
  admissible_E'5
#align ADE_inequality.admissible_E8 ADEInequality.admissible_E8
-/

#print ADEInequality.Admissible.one_lt_sumInv /-
theorem Admissible.one_lt_sumInv {pqr : Multiset ℕ+} : Admissible pqr → 1 < sumInv pqr :=
  by
  rw [admissible]
  rintro (⟨p', q', H⟩ | ⟨n, H⟩ | H | H | H)
  · rw [← H, A', sum_inv_pqr, add_assoc]
    simp only [lt_add_iff_pos_right, PNat.one_coe, inv_one, Nat.cast_one, coe_coe]
    apply add_pos <;> simp only [PNat.pos, Nat.cast_pos, inv_pos]
  · rw [← H, D', sum_inv_pqr]
    simp only [lt_add_iff_pos_right, PNat.one_coe, inv_one, Nat.cast_one, coe_coe, PNat.coe_bit0,
      Nat.cast_bit0]
    norm_num
  all_goals rw [← H, E', sum_inv_pqr]; norm_num
#align ADE_inequality.admissible.one_lt_sum_inv ADEInequality.Admissible.one_lt_sumInv
-/

/- warning: ADE_inequality.lt_three -> ADEInequality.lt_three is a dubious translation:
lean 3 declaration is
  forall {p : PNat} {q : PNat} {r : PNat}, (LE.le.{0} PNat (Preorder.toLE.{0} PNat (PartialOrder.toPreorder.{0} PNat (OrderedCancelCommMonoid.toPartialOrder.{0} PNat (LinearOrderedCancelCommMonoid.toOrderedCancelCommMonoid.{0} PNat PNat.linearOrderedCancelCommMonoid)))) p q) -> (LE.le.{0} PNat (Preorder.toLE.{0} PNat (PartialOrder.toPreorder.{0} PNat (OrderedCancelCommMonoid.toPartialOrder.{0} PNat (LinearOrderedCancelCommMonoid.toOrderedCancelCommMonoid.{0} PNat PNat.linearOrderedCancelCommMonoid)))) q r) -> (LT.lt.{0} Rat Rat.hasLt (OfNat.ofNat.{0} Rat 1 (OfNat.mk.{0} Rat 1 (One.one.{0} Rat Rat.hasOne))) (ADEInequality.sumInv (Insert.insert.{0, 0} PNat (Multiset.{0} PNat) (Multiset.hasInsert.{0} PNat) p (Insert.insert.{0, 0} PNat (Multiset.{0} PNat) (Multiset.hasInsert.{0} PNat) q (Singleton.singleton.{0, 0} PNat (Multiset.{0} PNat) (Multiset.hasSingleton.{0} PNat) r))))) -> (LT.lt.{0} PNat (Preorder.toLT.{0} PNat (PartialOrder.toPreorder.{0} PNat (OrderedCancelCommMonoid.toPartialOrder.{0} PNat (LinearOrderedCancelCommMonoid.toOrderedCancelCommMonoid.{0} PNat PNat.linearOrderedCancelCommMonoid)))) p (OfNat.ofNat.{0} PNat 3 (OfNat.mk.{0} PNat 3 (bit1.{0} PNat PNat.hasOne PNat.hasAdd (One.one.{0} PNat PNat.hasOne)))))
but is expected to have type
  forall {p : PNat} {q : PNat} {r : PNat}, (LE.le.{0} PNat (Preorder.toLE.{0} PNat (PartialOrder.toPreorder.{0} PNat (OrderedCancelCommMonoid.toPartialOrder.{0} PNat (LinearOrderedCancelCommMonoid.toOrderedCancelCommMonoid.{0} PNat instPNatLinearOrderedCancelCommMonoid)))) p q) -> (LE.le.{0} PNat (Preorder.toLE.{0} PNat (PartialOrder.toPreorder.{0} PNat (OrderedCancelCommMonoid.toPartialOrder.{0} PNat (LinearOrderedCancelCommMonoid.toOrderedCancelCommMonoid.{0} PNat instPNatLinearOrderedCancelCommMonoid)))) q r) -> (LT.lt.{0} Rat Rat.instLTRat_1 (OfNat.ofNat.{0} Rat 1 (Rat.instOfNatRat 1)) (ADEInequality.sumInv (Insert.insert.{0, 0} PNat (Multiset.{0} PNat) (Multiset.instInsertMultiset.{0} PNat) p (Insert.insert.{0, 0} PNat (Multiset.{0} PNat) (Multiset.instInsertMultiset.{0} PNat) q (Singleton.singleton.{0, 0} PNat (Multiset.{0} PNat) (Multiset.instSingletonMultiset.{0} PNat) r))))) -> (LT.lt.{0} PNat (Preorder.toLT.{0} PNat (PartialOrder.toPreorder.{0} PNat (OrderedCancelCommMonoid.toPartialOrder.{0} PNat (LinearOrderedCancelCommMonoid.toOrderedCancelCommMonoid.{0} PNat instPNatLinearOrderedCancelCommMonoid)))) p (OfNat.ofNat.{0} PNat 3 (instOfNatPNatHAddNatInstHAddInstAddNatOfNat (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2)))))
Case conversion may be inaccurate. Consider using '#align ADE_inequality.lt_three ADEInequality.lt_threeₓ'. -/
theorem lt_three {p q r : ℕ+} (hpq : p ≤ q) (hqr : q ≤ r) (H : 1 < sumInv {p, q, r}) : p < 3 :=
  by
  have h3 : (0 : ℚ) < 3 := by norm_num
  contrapose! H
  rw [sum_inv_pqr]
  have h3q := H.trans hpq
  have h3r := h3q.trans hqr
  calc
    (p⁻¹ + q⁻¹ + r⁻¹ : ℚ) ≤ 3⁻¹ + 3⁻¹ + 3⁻¹ := add_le_add (add_le_add _ _) _
    _ = 1 := by norm_num

  all_goals rw [inv_le_inv _ h3] <;> [assumption_mod_cast, norm_num]
#align ADE_inequality.lt_three ADEInequality.lt_three

/- warning: ADE_inequality.lt_four -> ADEInequality.lt_four is a dubious translation:
lean 3 declaration is
  forall {q : PNat} {r : PNat}, (LE.le.{0} PNat (Preorder.toLE.{0} PNat (PartialOrder.toPreorder.{0} PNat (OrderedCancelCommMonoid.toPartialOrder.{0} PNat (LinearOrderedCancelCommMonoid.toOrderedCancelCommMonoid.{0} PNat PNat.linearOrderedCancelCommMonoid)))) q r) -> (LT.lt.{0} Rat Rat.hasLt (OfNat.ofNat.{0} Rat 1 (OfNat.mk.{0} Rat 1 (One.one.{0} Rat Rat.hasOne))) (ADEInequality.sumInv (Insert.insert.{0, 0} PNat (Multiset.{0} PNat) (Multiset.hasInsert.{0} PNat) (OfNat.ofNat.{0} PNat 2 (OfNat.mk.{0} PNat 2 (bit0.{0} PNat PNat.hasAdd (One.one.{0} PNat PNat.hasOne)))) (Insert.insert.{0, 0} PNat (Multiset.{0} PNat) (Multiset.hasInsert.{0} PNat) q (Singleton.singleton.{0, 0} PNat (Multiset.{0} PNat) (Multiset.hasSingleton.{0} PNat) r))))) -> (LT.lt.{0} PNat (Preorder.toLT.{0} PNat (PartialOrder.toPreorder.{0} PNat (OrderedCancelCommMonoid.toPartialOrder.{0} PNat (LinearOrderedCancelCommMonoid.toOrderedCancelCommMonoid.{0} PNat PNat.linearOrderedCancelCommMonoid)))) q (OfNat.ofNat.{0} PNat 4 (OfNat.mk.{0} PNat 4 (bit0.{0} PNat PNat.hasAdd (bit0.{0} PNat PNat.hasAdd (One.one.{0} PNat PNat.hasOne))))))
but is expected to have type
  forall {q : PNat} {r : PNat}, (LE.le.{0} PNat (Preorder.toLE.{0} PNat (PartialOrder.toPreorder.{0} PNat (OrderedCancelCommMonoid.toPartialOrder.{0} PNat (LinearOrderedCancelCommMonoid.toOrderedCancelCommMonoid.{0} PNat instPNatLinearOrderedCancelCommMonoid)))) q r) -> (LT.lt.{0} Rat Rat.instLTRat_1 (OfNat.ofNat.{0} Rat 1 (Rat.instOfNatRat 1)) (ADEInequality.sumInv (Insert.insert.{0, 0} PNat (Multiset.{0} PNat) (Multiset.instInsertMultiset.{0} PNat) (OfNat.ofNat.{0} PNat 2 (instOfNatPNatHAddNatInstHAddInstAddNatOfNat (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (Insert.insert.{0, 0} PNat (Multiset.{0} PNat) (Multiset.instInsertMultiset.{0} PNat) q (Singleton.singleton.{0, 0} PNat (Multiset.{0} PNat) (Multiset.instSingletonMultiset.{0} PNat) r))))) -> (LT.lt.{0} PNat (Preorder.toLT.{0} PNat (PartialOrder.toPreorder.{0} PNat (OrderedCancelCommMonoid.toPartialOrder.{0} PNat (LinearOrderedCancelCommMonoid.toOrderedCancelCommMonoid.{0} PNat instPNatLinearOrderedCancelCommMonoid)))) q (OfNat.ofNat.{0} PNat 4 (instOfNatPNatHAddNatInstHAddInstAddNatOfNat (OfNat.ofNat.{0} Nat 3 (instOfNatNat 3)))))
Case conversion may be inaccurate. Consider using '#align ADE_inequality.lt_four ADEInequality.lt_fourₓ'. -/
theorem lt_four {q r : ℕ+} (hqr : q ≤ r) (H : 1 < sumInv {2, q, r}) : q < 4 :=
  by
  have h4 : (0 : ℚ) < 4 := by norm_num
  contrapose! H
  rw [sum_inv_pqr]
  have h4r := H.trans hqr
  simp only [PNat.coe_bit0, Nat.cast_bit0, PNat.one_coe, Nat.cast_one, coe_coe]
  calc
    (2⁻¹ + q⁻¹ + r⁻¹ : ℚ) ≤ 2⁻¹ + 4⁻¹ + 4⁻¹ := add_le_add (add_le_add le_rfl _) _
    _ = 1 := by norm_num

  all_goals rw [inv_le_inv _ h4] <;> [assumption_mod_cast, norm_num]
#align ADE_inequality.lt_four ADEInequality.lt_four

/- warning: ADE_inequality.lt_six -> ADEInequality.lt_six is a dubious translation:
lean 3 declaration is
  forall {r : PNat}, (LT.lt.{0} Rat Rat.hasLt (OfNat.ofNat.{0} Rat 1 (OfNat.mk.{0} Rat 1 (One.one.{0} Rat Rat.hasOne))) (ADEInequality.sumInv (Insert.insert.{0, 0} PNat (Multiset.{0} PNat) (Multiset.hasInsert.{0} PNat) (OfNat.ofNat.{0} PNat 2 (OfNat.mk.{0} PNat 2 (bit0.{0} PNat PNat.hasAdd (One.one.{0} PNat PNat.hasOne)))) (Insert.insert.{0, 0} PNat (Multiset.{0} PNat) (Multiset.hasInsert.{0} PNat) (OfNat.ofNat.{0} PNat 3 (OfNat.mk.{0} PNat 3 (bit1.{0} PNat PNat.hasOne PNat.hasAdd (One.one.{0} PNat PNat.hasOne)))) (Singleton.singleton.{0, 0} PNat (Multiset.{0} PNat) (Multiset.hasSingleton.{0} PNat) r))))) -> (LT.lt.{0} PNat (Preorder.toLT.{0} PNat (PartialOrder.toPreorder.{0} PNat (OrderedCancelCommMonoid.toPartialOrder.{0} PNat (LinearOrderedCancelCommMonoid.toOrderedCancelCommMonoid.{0} PNat PNat.linearOrderedCancelCommMonoid)))) r (OfNat.ofNat.{0} PNat 6 (OfNat.mk.{0} PNat 6 (bit0.{0} PNat PNat.hasAdd (bit1.{0} PNat PNat.hasOne PNat.hasAdd (One.one.{0} PNat PNat.hasOne))))))
but is expected to have type
  forall {r : PNat}, (LT.lt.{0} Rat Rat.instLTRat_1 (OfNat.ofNat.{0} Rat 1 (Rat.instOfNatRat 1)) (ADEInequality.sumInv (Insert.insert.{0, 0} PNat (Multiset.{0} PNat) (Multiset.instInsertMultiset.{0} PNat) (OfNat.ofNat.{0} PNat 2 (instOfNatPNatHAddNatInstHAddInstAddNatOfNat (OfNat.ofNat.{0} Nat 1 (instOfNatNat 1)))) (Insert.insert.{0, 0} PNat (Multiset.{0} PNat) (Multiset.instInsertMultiset.{0} PNat) (OfNat.ofNat.{0} PNat 3 (instOfNatPNatHAddNatInstHAddInstAddNatOfNat (OfNat.ofNat.{0} Nat 2 (instOfNatNat 2)))) (Singleton.singleton.{0, 0} PNat (Multiset.{0} PNat) (Multiset.instSingletonMultiset.{0} PNat) r))))) -> (LT.lt.{0} PNat (Preorder.toLT.{0} PNat (PartialOrder.toPreorder.{0} PNat (OrderedCancelCommMonoid.toPartialOrder.{0} PNat (LinearOrderedCancelCommMonoid.toOrderedCancelCommMonoid.{0} PNat instPNatLinearOrderedCancelCommMonoid)))) r (OfNat.ofNat.{0} PNat 6 (instOfNatPNatHAddNatInstHAddInstAddNatOfNat (OfNat.ofNat.{0} Nat 5 (instOfNatNat 5)))))
Case conversion may be inaccurate. Consider using '#align ADE_inequality.lt_six ADEInequality.lt_sixₓ'. -/
theorem lt_six {r : ℕ+} (H : 1 < sumInv {2, 3, r}) : r < 6 :=
  by
  have h6 : (0 : ℚ) < 6 := by norm_num
  contrapose! H
  rw [sum_inv_pqr]
  simp only [PNat.coe_bit0, Nat.cast_bit0, PNat.one_coe, Nat.cast_bit1, Nat.cast_one, PNat.coe_bit1,
    coe_coe]
  calc
    (2⁻¹ + 3⁻¹ + r⁻¹ : ℚ) ≤ 2⁻¹ + 3⁻¹ + 6⁻¹ := add_le_add (add_le_add le_rfl le_rfl) _
    _ = 1 := by norm_num

  rw [inv_le_inv _ h6] <;> [assumption_mod_cast, norm_num]
#align ADE_inequality.lt_six ADEInequality.lt_six

#print ADEInequality.admissible_of_one_lt_sumInv_aux' /-
theorem admissible_of_one_lt_sumInv_aux' {p q r : ℕ+} (hpq : p ≤ q) (hqr : q ≤ r)
    (H : 1 < sumInv {p, q, r}) : Admissible {p, q, r} :=
  by
  have hp3 : p < 3 := lt_three hpq hqr H
  interval_cases
  · exact admissible_A' q r
  have hq4 : q < 4 := lt_four hqr H
  interval_cases
  · exact admissible_D' r
  have hr6 : r < 6 := lt_six H
  interval_cases
  · exact admissible_E6
  · exact admissible_E7
  · exact admissible_E8
#align ADE_inequality.admissible_of_one_lt_sum_inv_aux' ADEInequality.admissible_of_one_lt_sumInv_aux'
-/

#print ADEInequality.admissible_of_one_lt_sumInv_aux /-
theorem admissible_of_one_lt_sumInv_aux :
    ∀ {pqr : List ℕ+} (hs : pqr.Sorted (· ≤ ·)) (hl : pqr.length = 3) (H : 1 < sumInv pqr),
      Admissible pqr
  | [p, q, r], hs, hl, H =>
    by
    obtain ⟨⟨hpq, -⟩, hqr⟩ : (p ≤ q ∧ p ≤ r) ∧ q ≤ r
    simpa using hs
    exact admissible_of_one_lt_sum_inv_aux' hpq hqr H
#align ADE_inequality.admissible_of_one_lt_sum_inv_aux ADEInequality.admissible_of_one_lt_sumInv_aux
-/

#print ADEInequality.admissible_of_one_lt_sumInv /-
theorem admissible_of_one_lt_sumInv {p q r : ℕ+} (H : 1 < sumInv {p, q, r}) :
    Admissible {p, q, r} := by
  simp only [admissible]
  let S := sort ((· ≤ ·) : ℕ+ → ℕ+ → Prop) {p, q, r}
  have hS : S.sorted (· ≤ ·) := sort_sorted _ _
  have hpqr : ({p, q, r} : Multiset ℕ+) = S := (sort_eq LE.le {p, q, r}).symm
  simp only [hpqr] at *
  apply admissible_of_one_lt_sum_inv_aux hS _ H
  simp only [S, length_sort]
  decide
#align ADE_inequality.admissible_of_one_lt_sum_inv ADEInequality.admissible_of_one_lt_sumInv
-/

#print ADEInequality.classification /-
/-- A multiset `{p,q,r}` of positive natural numbers
is a solution to `(p⁻¹ + q⁻¹ + r⁻¹ : ℚ) > 1` if and only if
it is `admissible` which means it is one of:

* `A' q r := {1,q,r}`
* `D' r := {2,2,r}`
* `E6 := {2,3,3}`, or `E7 := {2,3,4}`, or `E8 := {2,3,5}`
-/
theorem classification (p q r : ℕ+) : 1 < sumInv {p, q, r} ↔ Admissible {p, q, r} :=
  ⟨admissible_of_one_lt_sumInv, Admissible.one_lt_sumInv⟩
#align ADE_inequality.classification ADEInequality.classification
-/

end ADEInequality


/-
Copyright (c) 2021 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson
-/
import order.well_founded_set
import algebra.big_operators.finprod
import ring_theory.valuation.basic
import ring_theory.power_series.basic
import data.finsupp.pwo
import data.finset.mul_antidiagonal
import algebra.order.group.with_top

/-!
# Hahn Series
If `Γ` is ordered and `R` has zero, then `hahn_series Γ R` consists of formal series over `Γ` with
coefficients in `R`, whose supports are partially well-ordered. With further structure on `R` and
`Γ`, we can add further structure on `hahn_series Γ R`, with the most studied case being when `Γ` is
a linearly ordered abelian group and `R` is a field, in which case `hahn_series Γ R` is a
valued field, with value group `Γ`.

These generalize Laurent series (with value group `ℤ`), and Laurent series are implemented that way
in the file `ring_theory/laurent_series`.

## Main Definitions
  * If `Γ` is ordered and `R` has zero, then `hahn_series Γ R` consists of
  formal series over `Γ` with coefficients in `R`, whose supports are partially well-ordered.
  * If `R` is a (commutative) additive monoid or group, then so is `hahn_series Γ R`.
  * If `R` is a (comm_)(semi)ring, then so is `hahn_series Γ R`.
  * `hahn_series.add_val Γ R` defines an `add_valuation` on `hahn_series Γ R` when `Γ` is linearly
    ordered.
  * A `hahn_series.summable_family` is a family of Hahn series such that the union of their supports
  is well-founded and only finitely many are nonzero at any given coefficient. They have a formal
  sum, `hahn_series.summable_family.hsum`, which can be bundled as a `linear_map` as
  `hahn_series.summable_family.lsum`. Note that this is different from `summable` in the valuation
  topology, because there are topologically summable families that do not satisfy the axioms of
  `hahn_series.summable_family`, and formally summable families whose sums do not converge
  topologically.
  * Laurent series over `R` are implemented as `hahn_series ℤ R` in the file
    `ring_theory/laurent_series`.

## TODO
  * Build an API for the variable `X` (defined to be `single 1 1 : hahn_series Γ R`) in analogy to
    `X : R[X]` and `X : power_series R`

## References
- [J. van der Hoeven, *Operators on Generalized Power Series*][van_der_hoeven]

-/

open finset function
open_locale big_operators classical pointwise polynomial
noncomputable theory

/-- If `Γ` is linearly ordered and `R` has zero, then `hahn_series Γ R` consists of
  formal series over `Γ` with coefficients in `R`, whose supports are well-founded. -/
@[ext]
structure hahn_series (Γ : Type*) (R : Type*) [partial_order Γ] [has_zero R] :=
(coeff : Γ → R)
(is_pwo_support' : (support coeff).is_pwo)

variables {Γ : Type*} {R : Type*}

namespace hahn_series

section zero
variables [partial_order Γ] [has_zero R]

lemma coeff_injective : injective (coeff : hahn_series Γ R → (Γ → R)) := ext

@[simp] lemma coeff_inj {x y : hahn_series Γ R} : x.coeff = y.coeff ↔ x = y :=
coeff_injective.eq_iff

/-- The support of a Hahn series is just the set of indices whose coefficients are nonzero.
  Notably, it is well-founded. -/
def support (x : hahn_series Γ R) : set Γ := support x.coeff

@[simp]
lemma is_pwo_support (x : hahn_series Γ R) : x.support.is_pwo := x.is_pwo_support'

@[simp]
lemma is_wf_support (x : hahn_series Γ R) : x.support.is_wf := x.is_pwo_support.is_wf

@[simp]
lemma mem_support (x : hahn_series Γ R) (a : Γ) : a ∈ x.support ↔ x.coeff a ≠ 0 := iff.refl _

instance : has_zero (hahn_series Γ R) :=
⟨{ coeff := 0,
   is_pwo_support' := by simp }⟩

instance : inhabited (hahn_series Γ R) := ⟨0⟩

instance [subsingleton R] : subsingleton (hahn_series Γ R) :=
⟨λ a b, a.ext b (subsingleton.elim _ _)⟩

@[simp] lemma zero_coeff {a : Γ} : (0 : hahn_series Γ R).coeff a = 0 := rfl

@[simp] lemma coeff_fun_eq_zero_iff {x : hahn_series Γ R} : x.coeff = 0 ↔ x = 0 :=
coeff_injective.eq_iff' rfl

lemma ne_zero_of_coeff_ne_zero {x : hahn_series Γ R} {g : Γ} (h : x.coeff g ≠ 0) :
  x ≠ 0 :=
mt (λ x0, (x0.symm ▸ zero_coeff : x.coeff g = 0)) h

@[simp] lemma support_zero : support (0 : hahn_series Γ R) = ∅ := function.support_zero

@[simp] lemma support_nonempty_iff {x : hahn_series Γ R} : x.support.nonempty ↔ x ≠ 0 :=
by rw [support, support_nonempty_iff, ne.def, coeff_fun_eq_zero_iff]

@[simp] lemma support_eq_empty_iff {x : hahn_series Γ R} : x.support = ∅ ↔ x = 0 :=
support_eq_empty_iff.trans coeff_fun_eq_zero_iff

/-- `single a r` is the Hahn series which has coefficient `r` at `a` and zero otherwise. -/
def single (a : Γ) : zero_hom R (hahn_series Γ R) :=
{ to_fun := λ r, { coeff := pi.single a r,
    is_pwo_support' := (set.is_pwo_singleton a).mono pi.support_single_subset },
  map_zero' := ext _ _ (pi.single_zero _) }

variables {a b : Γ} {r : R}

@[simp]
theorem single_coeff_same (a : Γ) (r : R) : (single a r).coeff a = r := pi.single_eq_same a r

@[simp]
theorem single_coeff_of_ne (h : b ≠ a) : (single a r).coeff b = 0 := pi.single_eq_of_ne h r

theorem single_coeff : (single a r).coeff b = if (b = a) then r else 0 :=
by { split_ifs with h; simp [h] }

@[simp]
lemma support_single_of_ne (h : r ≠ 0) : support (single a r) = {a} :=
pi.support_single_of_ne h

lemma support_single_subset : support (single a r) ⊆ {a} :=
pi.support_single_subset

lemma eq_of_mem_support_single {b : Γ} (h : b ∈ support (single a r)) : b = a :=
support_single_subset h

@[simp]
lemma single_eq_zero : (single a (0 : R)) = 0 := (single a).map_zero

lemma single_injective (a : Γ) : function.injective (single a : R → hahn_series Γ R) :=
λ r s rs, by rw [← single_coeff_same a r, ← single_coeff_same a s, rs]

lemma single_ne_zero (h : r ≠ 0) : single a r ≠ 0 :=
λ con, h (single_injective a (con.trans single_eq_zero.symm))

@[simp] lemma single_eq_zero_iff {a : Γ} {r : R} :
  single a r = 0 ↔ r = 0 :=
begin
  split,
  { contrapose!,
    exact single_ne_zero },
  { simp {contextual := tt} }
end

instance [nonempty Γ] [nontrivial R] : nontrivial (hahn_series Γ R) :=
⟨begin
  obtain ⟨r, s, rs⟩ := exists_pair_ne R,
  inhabit Γ,
  refine ⟨single (arbitrary Γ) r, single (arbitrary Γ) s, λ con, rs _⟩,
  rw [← single_coeff_same (arbitrary Γ) r, con, single_coeff_same],
end⟩

section order
variable [has_zero Γ]

/-- The order of a nonzero Hahn series `x` is a minimal element of `Γ` where `x` has a
  nonzero coefficient, the order of 0 is 0. -/
def order (x : hahn_series Γ R) : Γ :=
if h : x = 0 then 0 else x.is_wf_support.min (support_nonempty_iff.2 h)

@[simp]
lemma order_zero : order (0 : hahn_series Γ R) = 0 := dif_pos rfl

lemma order_of_ne {x : hahn_series Γ R} (hx : x ≠ 0) :
  order x = x.is_wf_support.min (support_nonempty_iff.2 hx) := dif_neg hx

lemma coeff_order_ne_zero {x : hahn_series Γ R} (hx : x ≠ 0) :
  x.coeff x.order ≠ 0 :=
begin
  rw order_of_ne hx,
  exact x.is_wf_support.min_mem (support_nonempty_iff.2 hx)
end

lemma order_le_of_coeff_ne_zero {Γ} [linear_ordered_cancel_add_comm_monoid Γ]
  {x : hahn_series Γ R} {g : Γ} (h : x.coeff g ≠ 0) :
  x.order ≤ g :=
le_trans (le_of_eq (order_of_ne (ne_zero_of_coeff_ne_zero h)))
  (set.is_wf.min_le _ _ ((mem_support _ _).2 h))

@[simp]
lemma order_single (h : r ≠ 0) : (single a r).order = a :=
(order_of_ne (single_ne_zero h)).trans (support_single_subset ((single a r).is_wf_support.min_mem
    (support_nonempty_iff.2 (single_ne_zero h))))

lemma coeff_eq_zero_of_lt_order {x : hahn_series Γ R} {i : Γ} (hi : i < x.order) : x.coeff i = 0 :=
begin
  rcases eq_or_ne x 0 with rfl|hx,
  { simp },
  contrapose! hi,
  rw [←ne.def, ←mem_support] at hi,
  rw [order_of_ne hx],
  exact set.is_wf.not_lt_min _ _ hi
end

end order

section domain
variables {Γ' : Type*} [partial_order Γ']

/-- Extends the domain of a `hahn_series` by an `order_embedding`. -/
def emb_domain (f : Γ ↪o Γ') : hahn_series Γ R → hahn_series Γ' R :=
λ x, { coeff := λ (b : Γ'),
  if h : b ∈ f '' x.support then x.coeff (classical.some h) else 0,
  is_pwo_support' := (x.is_pwo_support.image_of_monotone f.monotone).mono (λ b hb, begin
    contrapose! hb,
    rw [function.mem_support, dif_neg hb, not_not],
  end) }

@[simp]
lemma emb_domain_coeff {f : Γ ↪o Γ'} {x : hahn_series Γ R} {a : Γ} :
  (emb_domain f x).coeff (f a) = x.coeff a :=
begin
  rw emb_domain,
  dsimp only,
  by_cases ha : a ∈ x.support,
  { rw dif_pos (set.mem_image_of_mem f ha),
    exact congr rfl (f.injective (classical.some_spec (set.mem_image_of_mem f ha)).2) },
  { rw [dif_neg, not_not.1 (λ c, ha ((mem_support _ _).2 c))],
    contrapose! ha,
    obtain ⟨b, hb1, hb2⟩ := (set.mem_image _ _ _).1 ha,
    rwa f.injective hb2 at hb1 }
end

@[simp]
lemma emb_domain_mk_coeff {f : Γ → Γ'}
  (hfi : function.injective f) (hf : ∀ g g' : Γ, f g ≤ f g' ↔ g ≤ g')
  {x : hahn_series Γ R} {a : Γ} :
  (emb_domain ⟨⟨f, hfi⟩, hf⟩ x).coeff (f a) = x.coeff a :=
emb_domain_coeff

lemma emb_domain_notin_image_support {f : Γ ↪o Γ'} {x : hahn_series Γ R} {b : Γ'}
  (hb : b ∉ f '' x.support) : (emb_domain f x).coeff b = 0 :=
dif_neg hb

lemma support_emb_domain_subset {f : Γ ↪o Γ'} {x : hahn_series Γ R} :
  support (emb_domain f x) ⊆ f '' x.support :=
begin
  intros g hg,
  contrapose! hg,
  rw [mem_support, emb_domain_notin_image_support hg, not_not],
end

lemma emb_domain_notin_range {f : Γ ↪o Γ'} {x : hahn_series Γ R} {b : Γ'}
  (hb : b ∉ set.range f) : (emb_domain f x).coeff b = 0 :=
emb_domain_notin_image_support (λ con, hb (set.image_subset_range _ _ con))

@[simp]
lemma emb_domain_zero {f : Γ ↪o Γ'} : emb_domain f (0 : hahn_series Γ R) = 0 :=
by { ext, simp [emb_domain_notin_image_support] }

@[simp]
lemma emb_domain_single {f : Γ ↪o Γ'} {g : Γ} {r : R} :
  emb_domain f (single g r) = single (f g) r :=
begin
  ext g',
  by_cases h : g' = f g,
  { simp [h] },
  rw [emb_domain_notin_image_support, single_coeff_of_ne h],
  by_cases hr : r = 0,
  { simp [hr] },
  rwa [support_single_of_ne hr, set.image_singleton, set.mem_singleton_iff],
end

lemma emb_domain_injective {f : Γ ↪o Γ'} :
  function.injective (emb_domain f : hahn_series Γ R → hahn_series Γ' R) :=
λ x y xy, begin
  ext g,
  rw [ext_iff, function.funext_iff] at xy,
  have xyg := xy (f g),
  rwa [emb_domain_coeff, emb_domain_coeff] at xyg,
end

end domain

end zero

section addition

variable [partial_order Γ]

section add_monoid
variable [add_monoid R]

instance : has_add (hahn_series Γ R) :=
{ add := λ x y, { coeff := x.coeff + y.coeff,
                  is_pwo_support' := (x.is_pwo_support.union y.is_pwo_support).mono
                    (function.support_add _ _) } }

instance : add_monoid (hahn_series Γ R) :=
{ zero := 0,
  add := (+),
  add_assoc := λ x y z, by { ext, apply add_assoc },
  zero_add := λ x, by { ext, apply zero_add },
  add_zero := λ x, by { ext, apply add_zero } }

@[simp]
lemma add_coeff' {x y : hahn_series Γ R} :
  (x + y).coeff = x.coeff + y.coeff := rfl

lemma add_coeff {x y : hahn_series Γ R} {a : Γ} :
  (x + y).coeff a = x.coeff a + y.coeff a := rfl

lemma support_add_subset {x y : hahn_series Γ R} :
  support (x + y) ⊆ support x ∪ support y :=
λ a ha, begin
  rw [mem_support, add_coeff] at ha,
  rw [set.mem_union, mem_support, mem_support],
  contrapose! ha,
  rw [ha.1, ha.2, add_zero],
end

lemma min_order_le_order_add {Γ} [linear_ordered_cancel_add_comm_monoid Γ] {x y : hahn_series Γ R}
  (hxy : x + y ≠ 0) :
  min x.order y.order ≤ (x + y).order :=
begin
  by_cases hx : x = 0, { simp [hx], },
  by_cases hy : y = 0, { simp [hy], },
  rw [order_of_ne hx, order_of_ne hy, order_of_ne hxy],
  refine le_trans _ (set.is_wf.min_le_min_of_subset support_add_subset),
  { exact x.is_wf_support.union y.is_wf_support },
  { exact set.nonempty.mono (set.subset_union_left _ _) (support_nonempty_iff.2 hx) },
  rw set.is_wf.min_union,
end

/-- `single` as an additive monoid/group homomorphism -/
@[simps] def single.add_monoid_hom (a : Γ) : R →+ (hahn_series Γ R) :=
{ map_add' := λ x y, by { ext b, by_cases h : b = a; simp [h] },
  ..single a }

/-- `coeff g` as an additive monoid/group homomorphism -/
@[simps] def coeff.add_monoid_hom (g : Γ) : (hahn_series Γ R) →+ R :=
{ to_fun := λ f, f.coeff g,
  map_zero' := zero_coeff,
  map_add' := λ x y, add_coeff }

section domain
variables {Γ' : Type*} [partial_order Γ']

lemma emb_domain_add (f : Γ ↪o Γ') (x y : hahn_series Γ R) :
  emb_domain f (x + y) = emb_domain f x + emb_domain f y :=
begin
  ext g,
  by_cases hg : g ∈ set.range f,
  { obtain ⟨a, rfl⟩ := hg,
    simp },
  { simp [emb_domain_notin_range, hg] }
end

end domain

end add_monoid

instance [add_comm_monoid R] : add_comm_monoid (hahn_series Γ R) :=
{ add_comm := λ x y, by { ext, apply add_comm }
  .. hahn_series.add_monoid }

section add_group
variable [add_group R]

instance : add_group (hahn_series Γ R) :=
{ neg := λ x, { coeff := λ a, - x.coeff a,
                is_pwo_support' := by { rw function.support_neg,
                  exact x.is_pwo_support }, },
  add_left_neg := λ x, by { ext, apply add_left_neg },
  .. hahn_series.add_monoid }

@[simp]
lemma neg_coeff' {x : hahn_series Γ R} : (- x).coeff = - x.coeff := rfl

lemma neg_coeff {x : hahn_series Γ R} {a : Γ} : (- x).coeff a = - x.coeff a := rfl

@[simp]
lemma support_neg {x : hahn_series Γ R} : (- x).support = x.support :=
by { ext, simp }

@[simp]
lemma sub_coeff' {x y : hahn_series Γ R} :
  (x - y).coeff = x.coeff - y.coeff := by { ext, simp [sub_eq_add_neg] }

lemma sub_coeff {x y : hahn_series Γ R} {a : Γ} :
  (x - y).coeff a = x.coeff a - y.coeff a := by simp

@[simp] lemma order_neg [has_zero Γ] {f : hahn_series Γ R} : (- f).order = f.order :=
by { by_cases hf : f = 0, { simp only [hf, neg_zero] },
    simp only [order, support_neg, neg_eq_zero] }

end add_group

instance [add_comm_group R] : add_comm_group (hahn_series Γ R) :=
{ .. hahn_series.add_comm_monoid,
  .. hahn_series.add_group }

end addition

section distrib_mul_action
variables [partial_order Γ] {V : Type*} [monoid R] [add_monoid V] [distrib_mul_action R V]

instance : has_smul R (hahn_series Γ V) :=
⟨λ r x, { coeff := r • x.coeff,
          is_pwo_support' := x.is_pwo_support.mono (function.support_smul_subset_right r x.coeff) }⟩

@[simp]
lemma smul_coeff {r : R} {x : hahn_series Γ V} {a : Γ} : (r • x).coeff a = r • (x.coeff a) := rfl

instance : distrib_mul_action R (hahn_series Γ V) :=
{ smul := (•),
  one_smul := λ _, by { ext, simp },
  smul_zero := λ _, by { ext, simp },
  smul_add := λ _ _ _, by { ext, simp [smul_add] },
  mul_smul := λ _ _ _, by { ext, simp [mul_smul] } }

variables {S : Type*} [monoid S] [distrib_mul_action S V]

instance [has_smul R S] [is_scalar_tower R S V] :
  is_scalar_tower R S (hahn_series Γ V) :=
⟨λ r s a, by { ext, simp }⟩

instance [smul_comm_class R S V] :
  smul_comm_class R S (hahn_series Γ V) :=
⟨λ r s a, by { ext, simp [smul_comm] }⟩

end distrib_mul_action

section module
variables [partial_order Γ] [semiring R] {V : Type*} [add_comm_monoid V] [module R V]

instance : module R (hahn_series Γ V) :=
{ zero_smul := λ _, by { ext, simp },
  add_smul := λ _ _ _, by { ext, simp [add_smul] },
  .. hahn_series.distrib_mul_action }

/-- `single` as a linear map -/
@[simps] def single.linear_map (a : Γ) : R →ₗ[R] (hahn_series Γ R) :=
{ map_smul' := λ r s, by { ext b, by_cases h : b = a; simp [h] },
  ..single.add_monoid_hom a }

/-- `coeff g` as a linear map -/
@[simps] def coeff.linear_map (g : Γ) : (hahn_series Γ R) →ₗ[R] R :=
{ map_smul' := λ r s, rfl,
  ..coeff.add_monoid_hom g }

section domain
variables {Γ' : Type*} [partial_order Γ']

lemma emb_domain_smul (f : Γ ↪o Γ') (r : R) (x : hahn_series Γ R) :
  emb_domain f (r • x) = r • emb_domain f x :=
begin
  ext g,
  by_cases hg : g ∈ set.range f,
  { obtain ⟨a, rfl⟩ := hg,
    simp },
  { simp [emb_domain_notin_range, hg] }
end

/-- Extending the domain of Hahn series is a linear map. -/
@[simps] def emb_domain_linear_map (f : Γ ↪o Γ') : hahn_series Γ R →ₗ[R] hahn_series Γ' R :=
{ to_fun := emb_domain f, map_add' := emb_domain_add f, map_smul' := emb_domain_smul f }

end domain

end module

section multiplication

variable [ordered_cancel_add_comm_monoid Γ]

instance [has_zero R] [has_one R] : has_one (hahn_series Γ R) :=
⟨single 0 1⟩

@[simp]
lemma one_coeff [has_zero R] [has_one R] {a : Γ} :
  (1 : hahn_series Γ R).coeff a = if a = 0 then 1 else 0 := single_coeff

@[simp]
lemma single_zero_one [has_zero R] [has_one R] : (single 0 (1 : R)) = 1 := rfl

@[simp]
lemma support_one [mul_zero_one_class R] [nontrivial R] :
  support (1 : hahn_series Γ R) = {0} :=
support_single_of_ne one_ne_zero

@[simp]
lemma order_one [mul_zero_one_class R] :
  order (1 : hahn_series Γ R) = 0 :=
begin
  cases subsingleton_or_nontrivial R with h h; haveI := h,
  { rw [subsingleton.elim (1 : hahn_series Γ R) 0, order_zero] },
  { exact order_single one_ne_zero }
end

instance [non_unital_non_assoc_semiring R] : has_mul (hahn_series Γ R) :=
{ mul := λ x y, { coeff := λ a,
    ∑ ij in (add_antidiagonal x.is_pwo_support y.is_pwo_support a),
    x.coeff ij.fst * y.coeff ij.snd,
    is_pwo_support' := begin
      have h : {a : Γ | ∑ (ij : Γ × Γ) in add_antidiagonal x.is_pwo_support
        y.is_pwo_support a, x.coeff ij.fst * y.coeff ij.snd ≠ 0} ⊆
        {a : Γ | (add_antidiagonal x.is_pwo_support y.is_pwo_support a).nonempty},
      { intros a ha,
        contrapose! ha,
        simp [not_nonempty_iff_eq_empty.1 ha] },
      exact is_pwo_support_add_antidiagonal.mono h,
    end, }, }

@[simp]
lemma mul_coeff [non_unital_non_assoc_semiring R] {x y : hahn_series Γ R} {a : Γ} :
  (x * y).coeff a = ∑ ij in (add_antidiagonal x.is_pwo_support y.is_pwo_support a),
    x.coeff ij.fst * y.coeff ij.snd := rfl

lemma mul_coeff_right' [non_unital_non_assoc_semiring R] {x y : hahn_series Γ R} {a : Γ} {s : set Γ}
  (hs : s.is_pwo) (hys : y.support ⊆ s) :
  (x * y).coeff a = ∑ ij in (add_antidiagonal x.is_pwo_support hs a),
    x.coeff ij.fst * y.coeff ij.snd :=
begin
  rw mul_coeff,
  apply sum_subset_zero_on_sdiff (add_antidiagonal_mono_right hys) _ (λ _ _, rfl),
  intros b hb,
  simp only [not_and, mem_sdiff, mem_add_antidiagonal, mem_support, not_imp_not] at hb,
  rw [hb.2 hb.1.1 hb.1.2.2, mul_zero],
end

lemma mul_coeff_left' [non_unital_non_assoc_semiring R] {x y : hahn_series Γ R} {a : Γ} {s : set Γ}
  (hs : s.is_pwo) (hxs : x.support ⊆ s) :
  (x * y).coeff a = ∑ ij in (add_antidiagonal hs y.is_pwo_support a),
    x.coeff ij.fst * y.coeff ij.snd :=
begin
  rw mul_coeff,
  apply sum_subset_zero_on_sdiff (add_antidiagonal_mono_left hxs) _ (λ _ _, rfl),
  intros b hb,
  simp only [not_and', mem_sdiff, mem_add_antidiagonal, mem_support, not_ne_iff] at hb,
  rw [hb.2 ⟨hb.1.2.1, hb.1.2.2⟩, zero_mul],
end

instance [non_unital_non_assoc_semiring R] : distrib (hahn_series Γ R) :=
{ left_distrib := λ x y z, begin
    ext a,
    have hwf := (y.is_pwo_support.union z.is_pwo_support),
    rw [mul_coeff_right' hwf, add_coeff, mul_coeff_right' hwf (set.subset_union_right _ _),
      mul_coeff_right' hwf (set.subset_union_left _ _)],
    { simp only [add_coeff, mul_add, sum_add_distrib] },
    { intro b,
      simp only [add_coeff, ne.def, set.mem_union, set.mem_set_of_eq, mem_support],
      contrapose!,
      intro h,
      rw [h.1, h.2, add_zero], }
  end,
  right_distrib := λ x y z, begin
    ext a,
    have hwf := (x.is_pwo_support.union y.is_pwo_support),
    rw [mul_coeff_left' hwf, add_coeff, mul_coeff_left' hwf (set.subset_union_right _ _),
      mul_coeff_left' hwf (set.subset_union_left _ _)],
    { simp only [add_coeff, add_mul, sum_add_distrib] },
    { intro b,
      simp only [add_coeff, ne.def, set.mem_union, set.mem_set_of_eq, mem_support],
      contrapose!,
      intro h,
      rw [h.1, h.2, add_zero], },
  end,
  .. hahn_series.has_mul,
  .. hahn_series.has_add }

lemma single_mul_coeff_add [non_unital_non_assoc_semiring R] {r : R} {x : hahn_series Γ R} {a : Γ}
  {b : Γ} :
  ((single b r) * x).coeff (a + b) = r * x.coeff a :=
begin
  by_cases hr : r = 0,
  { simp [hr] },
  simp only [hr, smul_coeff, mul_coeff, support_single_of_ne, ne.def, not_false_iff, smul_eq_mul],
  by_cases hx : x.coeff a = 0,
  { simp only [hx, mul_zero],
    rw [sum_congr _ (λ _ _, rfl), sum_empty],
    ext ⟨a1, a2⟩,
    simp only [not_mem_empty, not_and, set.mem_singleton_iff, not_not,
      mem_add_antidiagonal, set.mem_set_of_eq, iff_false],
    rintro rfl h2 h1,
    rw add_comm at h1,
    rw ← add_right_cancel h1 at hx,
    exact h2 hx, },
  transitivity ∑ (ij : Γ × Γ) in {(b, a)}, (single b r).coeff ij.fst * x.coeff ij.snd,
  { apply sum_congr _ (λ _ _, rfl),
    ext ⟨a1, a2⟩,
    simp only [set.mem_singleton_iff, prod.mk.inj_iff, mem_add_antidiagonal,
      mem_singleton, set.mem_set_of_eq],
    split,
    { rintro ⟨rfl, h2, h1⟩,
      rw add_comm at h1,
      refine ⟨rfl, add_right_cancel h1⟩ },
    { rintro ⟨rfl, rfl⟩,
      exact ⟨rfl, by simp [hx], add_comm _ _⟩ } },
  { simp }
end

lemma mul_single_coeff_add [non_unital_non_assoc_semiring R] {r : R} {x : hahn_series Γ R} {a : Γ}
  {b : Γ} :
  (x * (single b r)).coeff (a + b) = x.coeff a * r :=
begin
  by_cases hr : r = 0,
  { simp [hr] },
  simp only [hr, smul_coeff, mul_coeff, support_single_of_ne, ne.def, not_false_iff, smul_eq_mul],
  by_cases hx : x.coeff a = 0,
  { simp only [hx, zero_mul],
    rw [sum_congr _ (λ _ _, rfl), sum_empty],
    ext ⟨a1, a2⟩,
    simp only [not_mem_empty, not_and, set.mem_singleton_iff, not_not,
      mem_add_antidiagonal, set.mem_set_of_eq, iff_false],
    rintro h2 rfl h1,
    rw ← add_right_cancel h1 at hx,
    exact h2 hx, },
  transitivity ∑ (ij : Γ × Γ) in {(a,b)}, x.coeff ij.fst * (single b r).coeff ij.snd,
  { apply sum_congr _ (λ _ _, rfl),
    ext ⟨a1, a2⟩,
    simp only [set.mem_singleton_iff, prod.mk.inj_iff, mem_add_antidiagonal,
      mem_singleton, set.mem_set_of_eq],
    split,
    { rintro ⟨h2, rfl, h1⟩,
      refine ⟨add_right_cancel h1, rfl⟩ },
    { rintro ⟨rfl, rfl⟩,
      simp [hx] } },
  { simp }
end

@[simp]
lemma mul_single_zero_coeff [non_unital_non_assoc_semiring R] {r : R} {x : hahn_series Γ R}
  {a : Γ} :
  (x * (single 0 r)).coeff a = x.coeff a * r  :=
by rw [← add_zero a, mul_single_coeff_add, add_zero]

lemma single_zero_mul_coeff [non_unital_non_assoc_semiring R] {r : R} {x : hahn_series Γ R}
  {a : Γ} :
  ((single 0 r) * x).coeff a = r * x.coeff a :=
by rw [← add_zero a, single_mul_coeff_add, add_zero]

@[simp]
lemma single_zero_mul_eq_smul [semiring R] {r : R} {x : hahn_series Γ R} :
  (single 0 r) * x = r • x :=
by { ext, exact single_zero_mul_coeff }

theorem support_mul_subset_add_support [non_unital_non_assoc_semiring R] {x y : hahn_series Γ R} :
  support (x * y) ⊆ support x + support y :=
begin
  apply set.subset.trans (λ x hx, _) support_add_antidiagonal_subset_add,
  { exact x.is_pwo_support },
  { exact y.is_pwo_support },
  contrapose! hx,
  simp only [not_nonempty_iff_eq_empty, ne.def, set.mem_set_of_eq] at hx,
  simp [hx],
end

lemma mul_coeff_order_add_order {Γ} [linear_ordered_cancel_add_comm_monoid Γ]
  [non_unital_non_assoc_semiring R]
  (x y : hahn_series Γ R) :
  (x * y).coeff (x.order + y.order) = x.coeff x.order * y.coeff y.order :=
begin
  by_cases hx : x = 0, { simp [hx], },
  by_cases hy : y = 0, { simp [hy], },
  rw [order_of_ne hx, order_of_ne hy, mul_coeff, finset.add_antidiagonal_min_add_min,
    finset.sum_singleton],
end

private lemma mul_assoc' [non_unital_semiring R] (x y z : hahn_series Γ R) :
  x * y * z = x * (y * z) :=
begin
  ext b,
  rw [mul_coeff_left' (x.is_pwo_support.add y.is_pwo_support) support_mul_subset_add_support,
      mul_coeff_right' (y.is_pwo_support.add z.is_pwo_support) support_mul_subset_add_support],
  simp only [mul_coeff, add_coeff, sum_mul, mul_sum, sum_sigma'],
  refine sum_bij_ne_zero (λ a has ha0, ⟨⟨a.2.1, a.2.2 + a.1.2⟩, ⟨a.2.2, a.1.2⟩⟩) _ _ _ _,
  { rintros ⟨⟨i,j⟩, ⟨k,l⟩⟩ H1 H2,
    simp only [and_true, set.image2_add, eq_self_iff_true, mem_add_antidiagonal, ne.def,
      set.image_prod, mem_sigma, set.mem_set_of_eq] at H1 H2 ⊢,
    obtain ⟨⟨H3, nz, rfl⟩, nx, ny, rfl⟩ := H1,
    exact ⟨⟨nx, set.add_mem_add ny nz, (add_assoc _ _ _).symm⟩, ny, nz⟩ },
  { rintros ⟨⟨i1,j1⟩, k1,l1⟩ ⟨⟨i2,j2⟩, k2,l2⟩ H1 H2 H3 H4 H5,
    simp only [set.image2_add, prod.mk.inj_iff, mem_add_antidiagonal, ne.def,
      set.image_prod, mem_sigma, set.mem_set_of_eq, heq_iff_eq] at H1 H3 H5,
    obtain ⟨⟨rfl, H⟩, rfl, rfl⟩ := H5,
    simp only [and_true, prod.mk.inj_iff, eq_self_iff_true, heq_iff_eq, ←H1.2.2.2, ←H3.2.2.2] },
  { rintros ⟨⟨i,j⟩, ⟨k,l⟩⟩ H1 H2,
    simp only [exists_prop, set.image2_add, prod.mk.inj_iff, mem_add_antidiagonal,
      sigma.exists, ne.def, set.image_prod, mem_sigma, set.mem_set_of_eq, heq_iff_eq,
      prod.exists] at H1 H2 ⊢,
    obtain ⟨⟨nx, H, rfl⟩, ny, nz, rfl⟩ := H1,
    exact ⟨i + k, l, i, k, ⟨⟨set.add_mem_add nx ny, nz, add_assoc _ _ _⟩, nx, ny, rfl⟩,
      λ con, H2 ((mul_assoc _ _ _).symm.trans con), ⟨rfl, rfl⟩, rfl, rfl⟩ },
  { rintros ⟨⟨i,j⟩, ⟨k,l⟩⟩ H1 H2,
    simp [mul_assoc], }
end

instance [non_unital_non_assoc_semiring R] : non_unital_non_assoc_semiring (hahn_series Γ R) :=
{ zero := 0,
  add := (+),
  mul := (*),
  zero_mul := λ _, by { ext, simp },
  mul_zero := λ _, by { ext, simp },
  .. hahn_series.add_comm_monoid,
  .. hahn_series.distrib }

instance [non_unital_semiring R] : non_unital_semiring (hahn_series Γ R) :=
{ zero := 0,
  add := (+),
  mul := (*),
  mul_assoc := mul_assoc',
  .. hahn_series.non_unital_non_assoc_semiring }

instance [non_assoc_semiring R] : non_assoc_semiring (hahn_series Γ R) :=
{ zero := 0,
  one := 1,
  add := (+),
  mul := (*),
  one_mul := λ x, by { ext, exact single_zero_mul_coeff.trans (one_mul _) },
  mul_one := λ x, by { ext, exact mul_single_zero_coeff.trans (mul_one _) },
  .. add_monoid_with_one.unary,
  .. hahn_series.non_unital_non_assoc_semiring }

instance [semiring R] : semiring (hahn_series Γ R) :=
{ zero := 0,
  one := 1,
  add := (+),
  mul := (*),
  .. hahn_series.non_assoc_semiring,
  .. hahn_series.non_unital_semiring }

instance [non_unital_comm_semiring R] : non_unital_comm_semiring (hahn_series Γ R) :=
{ mul_comm := λ x y, begin
    ext,
    simp_rw [mul_coeff, mul_comm],
    refine sum_bij (λ a ha, a.swap) (λ a ha, _) (λ a ha, rfl) (λ _ _ _ _, prod.swap_inj.1)
      (λ a ha, ⟨a.swap, _, a.swap_swap.symm⟩);
    rwa swap_mem_add_antidiagonal,
  end,
  .. hahn_series.non_unital_semiring }

instance [comm_semiring R] : comm_semiring (hahn_series Γ R) :=
{ .. hahn_series.non_unital_comm_semiring,
  .. hahn_series.semiring }

instance [non_unital_non_assoc_ring R] : non_unital_non_assoc_ring (hahn_series Γ R) :=
{ .. hahn_series.non_unital_non_assoc_semiring,
  .. hahn_series.add_group }

instance [non_unital_ring R] : non_unital_ring (hahn_series Γ R) :=
{ .. hahn_series.non_unital_non_assoc_ring,
  .. hahn_series.non_unital_semiring }

instance [non_assoc_ring R] : non_assoc_ring (hahn_series Γ R) :=
{ .. hahn_series.non_unital_non_assoc_ring,
  .. hahn_series.non_assoc_semiring }

instance [ring R] : ring (hahn_series Γ R) :=
{ .. hahn_series.semiring,
  .. hahn_series.add_comm_group }

instance [non_unital_comm_ring R] : non_unital_comm_ring (hahn_series Γ R) :=
{ .. hahn_series.non_unital_comm_semiring,
  .. hahn_series.non_unital_ring }

instance [comm_ring R] : comm_ring (hahn_series Γ R) :=
{ .. hahn_series.comm_semiring,
  .. hahn_series.ring }

instance {Γ} [linear_ordered_cancel_add_comm_monoid Γ] [non_unital_non_assoc_semiring R]
  [no_zero_divisors R] : no_zero_divisors (hahn_series Γ R) :=
{ eq_zero_or_eq_zero_of_mul_eq_zero := λ x y xy, begin
    by_cases hx : x = 0,
    { left, exact hx },
    right,
    contrapose! xy,
    rw [hahn_series.ext_iff, function.funext_iff, not_forall],
    refine ⟨x.order + y.order, _⟩,
    rw [mul_coeff_order_add_order x y, zero_coeff, mul_eq_zero],
    simp [coeff_order_ne_zero, hx, xy],
  end }

instance {Γ} [linear_ordered_cancel_add_comm_monoid Γ] [ring R] [is_domain R] :
  is_domain (hahn_series Γ R) :=
no_zero_divisors.to_is_domain _

@[simp]
lemma order_mul {Γ} [linear_ordered_cancel_add_comm_monoid Γ] [non_unital_non_assoc_semiring R]
  [no_zero_divisors R] {x y : hahn_series Γ R} (hx : x ≠ 0) (hy : y ≠ 0) :
  (x * y).order = x.order + y.order :=
begin
  apply le_antisymm,
  { apply order_le_of_coeff_ne_zero,
    rw [mul_coeff_order_add_order x y],
    exact mul_ne_zero (coeff_order_ne_zero hx) (coeff_order_ne_zero hy) },
  { rw [order_of_ne hx, order_of_ne hy, order_of_ne (mul_ne_zero hx hy), ← set.is_wf.min_add],
    exact set.is_wf.min_le_min_of_subset (support_mul_subset_add_support) },
end

@[simp]
lemma order_pow {Γ} [linear_ordered_cancel_add_comm_monoid Γ] [semiring R] [no_zero_divisors R]
  (x : hahn_series Γ R) (n : ℕ) : (x ^ n).order = n • x.order :=
begin
  induction n with h IH,
  { simp },
  rcases eq_or_ne x 0 with rfl|hx,
  { simp },
  rw [pow_succ', order_mul (pow_ne_zero _ hx) hx, succ_nsmul', IH]
end

section non_unital_non_assoc_semiring
variables [non_unital_non_assoc_semiring R]

@[simp]
lemma single_mul_single {a b : Γ} {r s : R} :
  single a r * single b s = single (a + b) (r * s) :=
begin
  ext x,
  by_cases h : x = a + b,
  { rw [h, mul_single_coeff_add],
    simp },
  { rw [single_coeff_of_ne h, mul_coeff, sum_eq_zero],
    simp_rw mem_add_antidiagonal,
    rintro ⟨y, z⟩ ⟨hy, hz, rfl⟩,
    rw [eq_of_mem_support_single hy, eq_of_mem_support_single hz] at h,
    exact (h rfl).elim }
end

end non_unital_non_assoc_semiring

section non_assoc_semiring
variables [non_assoc_semiring R]

/-- `C a` is the constant Hahn Series `a`. `C` is provided as a ring homomorphism. -/
@[simps] def C : R →+* (hahn_series Γ R) :=
{ to_fun := single 0,
  map_zero' := single_eq_zero,
  map_one' := rfl,
  map_add' := λ x y, by { ext a, by_cases h : a = 0; simp [h] },
  map_mul' := λ x y, by rw [single_mul_single, zero_add] }

@[simp]
lemma C_zero : C (0 : R) = (0 : hahn_series Γ R) := C.map_zero

@[simp]
lemma C_one : C (1 : R) = (1 : hahn_series Γ R) := C.map_one

lemma C_injective : function.injective (C : R → hahn_series Γ R) :=
begin
  intros r s rs,
  rw [ext_iff, function.funext_iff] at rs,
  have h := rs 0,
  rwa [C_apply, single_coeff_same, C_apply, single_coeff_same] at h,
end

lemma C_ne_zero {r : R} (h : r ≠ 0) : (C r : hahn_series Γ R) ≠ 0 :=
begin
  contrapose! h,
  rw ← C_zero at h,
  exact C_injective h,
end

lemma order_C {r : R} : order (C r : hahn_series Γ R) = 0 :=
begin
  by_cases h : r = 0,
  { rw [h, C_zero, order_zero] },
  { exact order_single h }
end

end non_assoc_semiring

section semiring
variables [semiring R]

lemma C_mul_eq_smul {r : R} {x : hahn_series Γ R} : C r * x = r • x :=
single_zero_mul_eq_smul

end semiring

section domain
variables {Γ' : Type*} [ordered_cancel_add_comm_monoid Γ']

lemma emb_domain_mul [non_unital_non_assoc_semiring R]
  (f : Γ ↪o Γ') (hf : ∀ x y, f (x + y) = f x + f y) (x y : hahn_series Γ R) :
  emb_domain f (x * y) = emb_domain f x * emb_domain f y :=
begin
  ext g,
  by_cases hg : g ∈ set.range f,
  { obtain ⟨g, rfl⟩ := hg,
    simp only [mul_coeff, emb_domain_coeff],
    transitivity ∑ ij in (add_antidiagonal x.is_pwo_support y.is_pwo_support g).map
      (function.embedding.prod_map f.to_embedding f.to_embedding),
      (emb_domain f x).coeff (ij.1) *
      (emb_domain f y).coeff (ij.2),
    { simp },
    apply sum_subset,
    { rintro ⟨i, j⟩ hij,
      simp only [exists_prop, mem_map, prod.mk.inj_iff, mem_add_antidiagonal,
        function.embedding.coe_prod_map, mem_support, prod.exists] at hij,
      obtain ⟨i, j, ⟨hx, hy, rfl⟩, rfl, rfl⟩ := hij,
      simp [hx, hy, hf], },
    { rintro ⟨_, _⟩ h1 h2,
      contrapose! h2,
      obtain ⟨i, hi, rfl⟩ := support_emb_domain_subset (ne_zero_and_ne_zero_of_mul h2).1,
      obtain ⟨j, hj, rfl⟩ := support_emb_domain_subset (ne_zero_and_ne_zero_of_mul h2).2,
      simp only [exists_prop, mem_map, prod.mk.inj_iff, mem_add_antidiagonal,
        function.embedding.coe_prod_map, mem_support, prod.exists],
      simp only [mem_add_antidiagonal, emb_domain_coeff, mem_support, ←hf,
        order_embedding.eq_iff_eq] at h1,
      exact ⟨i, j, h1, rfl⟩ } },
  { rw [emb_domain_notin_range hg, eq_comm],
    contrapose! hg,
    obtain ⟨_, _, hi, hj, rfl⟩ := support_mul_subset_add_support ((mem_support _ _).2 hg),
    obtain ⟨i, hi, rfl⟩ := support_emb_domain_subset hi,
    obtain ⟨j, hj, rfl⟩ := support_emb_domain_subset hj,
    refine ⟨i + j, hf i j⟩, }
end

lemma emb_domain_one [non_assoc_semiring R] (f : Γ ↪o Γ') (hf : f 0 = 0):
  emb_domain f (1 : hahn_series Γ R) = (1 : hahn_series Γ' R) :=
emb_domain_single.trans $ hf.symm ▸ rfl

/-- Extending the domain of Hahn series is a ring homomorphism. -/
@[simps] def emb_domain_ring_hom [non_assoc_semiring R] (f : Γ →+ Γ') (hfi : function.injective f)
  (hf : ∀ g g' : Γ, f g ≤ f g' ↔ g ≤ g') :
  hahn_series Γ R →+* hahn_series Γ' R :=
{ to_fun := emb_domain ⟨⟨f, hfi⟩, hf⟩,
  map_one' := emb_domain_one _ f.map_zero,
  map_mul' := emb_domain_mul _ f.map_add,
  map_zero' := emb_domain_zero,
  map_add' := emb_domain_add _}

lemma emb_domain_ring_hom_C [non_assoc_semiring R] {f : Γ →+ Γ'} {hfi : function.injective f}
  {hf : ∀ g g' : Γ, f g ≤ f g' ↔ g ≤ g'} {r : R} :
  emb_domain_ring_hom f hfi hf (C r) = C r :=
emb_domain_single.trans (by simp)

end domain

section algebra
variables [comm_semiring R] {A : Type*} [semiring A] [algebra R A]

instance : algebra R (hahn_series Γ A) :=
{ to_ring_hom := C.comp (algebra_map R A),
  smul_def' := λ r x, by { ext, simp },
  commutes' := λ r x, by { ext, simp only [smul_coeff, single_zero_mul_eq_smul, ring_hom.coe_comp,
    ring_hom.to_fun_eq_coe, C_apply, function.comp_app, algebra_map_smul, mul_single_zero_coeff],
    rw [← algebra.commutes, algebra.smul_def], }, }

theorem C_eq_algebra_map : C = (algebra_map R (hahn_series Γ R)) := rfl

theorem algebra_map_apply {r : R} :
  algebra_map R (hahn_series Γ A) r = C (algebra_map R A r) := rfl

instance [nontrivial Γ] [nontrivial R] : nontrivial (subalgebra R (hahn_series Γ R)) :=
⟨⟨⊥, ⊤, begin
  rw [ne.def, set_like.ext_iff, not_forall],
  obtain ⟨a, ha⟩ := exists_ne (0 : Γ),
  refine ⟨single a 1, _⟩,
  simp only [algebra.mem_bot, not_exists, set.mem_range, iff_true, algebra.mem_top],
  intros x,
  rw [ext_iff, function.funext_iff, not_forall],
  refine ⟨a, _⟩,
  rw [single_coeff_same, algebra_map_apply, C_apply, single_coeff_of_ne ha],
  exact zero_ne_one
end⟩⟩

section domain
variables {Γ' : Type*} [ordered_cancel_add_comm_monoid Γ']

/-- Extending the domain of Hahn series is an algebra homomorphism. -/
@[simps] def emb_domain_alg_hom (f : Γ →+ Γ') (hfi : function.injective f)
  (hf : ∀ g g' : Γ, f g ≤ f g' ↔ g ≤ g') :
  hahn_series Γ A →ₐ[R] hahn_series Γ' A :=
{ commutes' := λ r, emb_domain_ring_hom_C,
  .. emb_domain_ring_hom f hfi hf }

end domain

end algebra

end multiplication

section semiring
variables [semiring R]

/-- The ring `hahn_series ℕ R` is isomorphic to `power_series R`. -/
@[simps] def to_power_series : hahn_series ℕ R ≃+* power_series R :=
{ to_fun := λ f, power_series.mk f.coeff,
  inv_fun := λ f, ⟨λ n, power_series.coeff R n f, (nat.lt_wf.is_wf _).is_pwo⟩,
  left_inv := λ f, by { ext, simp },
  right_inv := λ f, by { ext, simp },
  map_add' := λ f g, by { ext, simp },
  map_mul' := λ f g, begin
    ext n,
    simp only [power_series.coeff_mul, power_series.coeff_mk, mul_coeff, is_pwo_support],
    classical,
    refine sum_filter_ne_zero.symm.trans ((sum_congr _ $ λ _ _, rfl).trans sum_filter_ne_zero),
    ext m,
    simp only [nat.mem_antidiagonal, mem_add_antidiagonal, and.congr_left_iff, mem_filter,
      mem_support],
    rintro h,
    rw [and_iff_right (left_ne_zero_of_mul h), and_iff_right (right_ne_zero_of_mul h)],
  end }

lemma coeff_to_power_series {f : hahn_series ℕ R} {n : ℕ} :
  power_series.coeff R n f.to_power_series = f.coeff n :=
power_series.coeff_mk _ _

lemma coeff_to_power_series_symm {f : power_series R} {n : ℕ} :
  (hahn_series.to_power_series.symm f).coeff n = power_series.coeff R n f := rfl

variables (Γ R) [strict_ordered_semiring Γ]

/-- Casts a power series as a Hahn series with coefficients from an `strict_ordered_semiring`. -/
def of_power_series : (power_series R) →+* hahn_series Γ R :=
(hahn_series.emb_domain_ring_hom (nat.cast_add_monoid_hom Γ) nat.strict_mono_cast.injective
  (λ _ _, nat.cast_le)).comp
  (ring_equiv.to_ring_hom to_power_series.symm)

variables {Γ} {R}

lemma of_power_series_injective : function.injective (of_power_series Γ R) :=
emb_domain_injective.comp to_power_series.symm.injective

@[simp] lemma of_power_series_apply (x : power_series R) :
  of_power_series Γ R x = hahn_series.emb_domain
  ⟨⟨(coe : ℕ → Γ), nat.strict_mono_cast.injective⟩, λ a b, begin
    simp only [function.embedding.coe_fn_mk],
    exact nat.cast_le,
  end⟩ (to_power_series.symm x) := rfl

lemma of_power_series_apply_coeff (x : power_series R) (n : ℕ) :
  (of_power_series Γ R x).coeff n = power_series.coeff R n x :=
by simp

@[simp] lemma of_power_series_C (r : R) :
  of_power_series Γ R (power_series.C R r) = hahn_series.C r :=
begin
  ext n,
  simp only [C, single_coeff, of_power_series_apply, ring_hom.coe_mk],
  split_ifs with hn hn,
  { subst hn,
    convert @emb_domain_coeff _ _ _ _ _ _ _ _ 0; simp },
  { rw emb_domain_notin_image_support,
    simp only [not_exists, set.mem_image, to_power_series_symm_apply_coeff, mem_support,
               power_series.coeff_C],
    intro,
    simp [ne.symm hn] {contextual := tt} }
end

@[simp] lemma of_power_series_X :
  of_power_series Γ R power_series.X = single 1 1 :=
begin
  ext n,
  simp only [single_coeff, of_power_series_apply, ring_hom.coe_mk],
  split_ifs with hn hn,
  { rw hn,
    convert @emb_domain_coeff _ _ _ _ _ _ _ _ 1;
    simp },
  { rw emb_domain_notin_image_support,
    simp only [not_exists, set.mem_image, to_power_series_symm_apply_coeff, mem_support,
               power_series.coeff_X],
    intro,
    simp [ne.symm hn] {contextual := tt} }
end

@[simp] lemma of_power_series_X_pow {R} [comm_semiring R] (n : ℕ) :
  of_power_series Γ R (power_series.X ^ n) = single (n : Γ) 1 :=
begin
  rw ring_hom.map_pow,
  induction n with n ih,
  { simp, refl },
  rw [pow_succ, ih, of_power_series_X, mul_comm, single_mul_single, one_mul, nat.cast_succ]
end

-- Lemmas about converting hahn_series over fintype to and from mv_power_series

/-- The ring `hahn_series (σ →₀ ℕ) R` is isomorphic to `mv_power_series σ R` for a `fintype` `σ`.
We take the index set of the hahn series to be `finsupp` rather than `pi`,
even though we assume `fintype σ` as this is more natural for alignment with `mv_power_series`.
After importing `algebra.order.pi` the ring `hahn_series (σ → ℕ) R` could be constructed instead.
 -/
@[simps] def to_mv_power_series {σ : Type*} [fintype σ] :
  hahn_series (σ →₀ ℕ) R ≃+* mv_power_series σ R :=
{ to_fun := λ f, f.coeff,
  inv_fun := λ f, ⟨(f : (σ →₀ ℕ) → R), finsupp.is_pwo _⟩,
  left_inv := λ f, by { ext, simp },
  right_inv := λ f, by { ext, simp },
  map_add' := λ f g, by { ext, simp },
  map_mul' := λ f g, begin
    ext n,
    simp only [mv_power_series.coeff_mul],
    classical,
    change (f * g).coeff n = _,
    simp_rw [mul_coeff],
    refine sum_filter_ne_zero.symm.trans ((sum_congr _ (λ _ _, rfl)).trans sum_filter_ne_zero),
    ext m,
    simp only [and.congr_left_iff, mem_add_antidiagonal, mem_filter, mem_support,
      finsupp.mem_antidiagonal],
    rintro h,
    rw [and_iff_right (left_ne_zero_of_mul h), and_iff_right (right_ne_zero_of_mul h)],
  end }

variables {σ : Type*} [fintype σ]
lemma coeff_to_mv_power_series {f : hahn_series (σ →₀ ℕ) R} {n : σ →₀ ℕ} :
  mv_power_series.coeff R n f.to_mv_power_series = f.coeff n :=
rfl

lemma coeff_to_mv_power_series_symm {f : mv_power_series σ R} {n : σ →₀ ℕ} :
  (hahn_series.to_mv_power_series.symm f).coeff n = mv_power_series.coeff R n f := rfl

end semiring

section algebra
variables (R) [comm_semiring R] {A : Type*} [semiring A] [algebra R A]

/-- The `R`-algebra `hahn_series ℕ A` is isomorphic to `power_series A`. -/
@[simps] def to_power_series_alg : (hahn_series ℕ A) ≃ₐ[R] power_series A :=
{ commutes' := λ r, begin
    ext n,
    simp only [algebra_map_apply, power_series.algebra_map_apply, ring_equiv.to_fun_eq_coe, C_apply,
      coeff_to_power_series],
    cases n,
    { simp only [power_series.coeff_zero_eq_constant_coeff, single_coeff_same],
      refl },
    { simp only [n.succ_ne_zero, ne.def, not_false_iff, single_coeff_of_ne],
      rw [power_series.coeff_C, if_neg n.succ_ne_zero] }
  end,
  .. to_power_series }

variables (Γ R) [strict_ordered_semiring Γ]

/-- Casting a power series as a Hahn series with coefficients from an `strict_ordered_semiring`
  is an algebra homomorphism. -/
@[simps] def of_power_series_alg : (power_series A) →ₐ[R] hahn_series Γ A :=
(hahn_series.emb_domain_alg_hom (nat.cast_add_monoid_hom Γ) nat.strict_mono_cast.injective
  (λ _ _, nat.cast_le)).comp
  (alg_equiv.to_alg_hom (to_power_series_alg R).symm)

instance power_series_algebra {S : Type*} [comm_semiring S] [algebra S (power_series R)] :
  algebra S (hahn_series Γ R) :=
ring_hom.to_algebra $ (of_power_series Γ R).comp (algebra_map S (power_series R))

variables {R} {S : Type*} [comm_semiring S] [algebra S (power_series R)]

lemma algebra_map_apply' (x : S) :
  algebra_map S (hahn_series Γ R) x = of_power_series Γ R (algebra_map S (power_series R) x) := rfl

@[simp] lemma _root_.polynomial.algebra_map_hahn_series_apply (f : R[X]) :
  algebra_map R[X] (hahn_series Γ R) f = of_power_series Γ R f := rfl

lemma _root_.polynomial.algebra_map_hahn_series_injective :
  function.injective (algebra_map R[X] (hahn_series Γ R)) :=
of_power_series_injective.comp (polynomial.coe_injective R)

end algebra

section valuation

variables (Γ R) [linear_ordered_cancel_add_comm_monoid Γ] [ring R] [is_domain R]

/-- The additive valuation on `hahn_series Γ R`, returning the smallest index at which
  a Hahn Series has a nonzero coefficient, or `⊤` for the 0 series.  -/
def add_val : add_valuation (hahn_series Γ R) (with_top Γ) :=
add_valuation.of (λ x, if x = (0 : hahn_series Γ R) then (⊤ : with_top Γ) else x.order)
  (if_pos rfl)
  ((if_neg one_ne_zero).trans (by simp [order_of_ne]))
  (λ x y, begin
    by_cases hx : x = 0,
    { by_cases hy : y = 0; { simp [hx, hy] } },
    { by_cases hy : y = 0,
      { simp [hx, hy] },
      { simp only [hx, hy, support_nonempty_iff, if_neg, not_false_iff, is_wf_support],
        by_cases hxy : x + y = 0,
        { simp [hxy] },
        rw [if_neg hxy, ← with_top.coe_min, with_top.coe_le_coe],
        exact min_order_le_order_add hxy } },
  end)
  (λ x y, begin
    by_cases hx : x = 0,
    { simp [hx] },
    by_cases hy : y = 0,
    { simp [hy] },
    rw [if_neg hx, if_neg hy, if_neg (mul_ne_zero hx hy),
      ← with_top.coe_add, with_top.coe_eq_coe, order_mul hx hy],
  end)

variables {Γ} {R}

lemma add_val_apply {x : hahn_series Γ R} :
  add_val Γ R x = if x = (0 : hahn_series Γ R) then (⊤ : with_top Γ) else x.order :=
add_valuation.of_apply _

@[simp]
lemma add_val_apply_of_ne {x : hahn_series Γ R} (hx : x ≠ 0) :
  add_val Γ R x = x.order :=
if_neg hx

lemma add_val_le_of_coeff_ne_zero {x : hahn_series Γ R} {g : Γ} (h : x.coeff g ≠ 0) :
  add_val Γ R x ≤ g :=
begin
  rw [add_val_apply_of_ne (ne_zero_of_coeff_ne_zero h), with_top.coe_le_coe],
  exact order_le_of_coeff_ne_zero h
end

end valuation

lemma is_pwo_Union_support_powers
  [linear_ordered_cancel_add_comm_monoid Γ] [ring R] [is_domain R]
  {x : hahn_series Γ R} (hx : 0 < add_val Γ R x) :
  (⋃ n : ℕ, (x ^ n).support).is_pwo :=
begin
  apply (x.is_wf_support.is_pwo.add_submonoid_closure (λ g hg, _)).mono _,
  { exact with_top.coe_le_coe.1 (le_trans (le_of_lt hx) (add_val_le_of_coeff_ne_zero hg)) },
  refine set.Union_subset (λ n, _),
  induction n with n ih;
  intros g hn,
  { simp only [exists_prop, and_true, set.mem_singleton_iff, set.set_of_eq_eq_singleton,
      mem_support, ite_eq_right_iff, ne.def, not_false_iff, one_ne_zero,
      pow_zero, not_forall, one_coeff] at hn,
    rw [hn, set_like.mem_coe],
    exact add_submonoid.zero_mem _ },
  { obtain ⟨i, j, hi, hj, rfl⟩ := support_mul_subset_add_support hn,
    exact set_like.mem_coe.2 (add_submonoid.add_mem _ (add_submonoid.subset_closure hi) (ih hj)) }
end

section
variables (Γ) (R) [partial_order Γ] [add_comm_monoid R]

/-- An infinite family of Hahn series which has a formal coefficient-wise sum.
  The requirements for this are that the union of the supports of the series is well-founded,
  and that only finitely many series are nonzero at any given coefficient. -/
structure summable_family (α : Type*) :=
(to_fun : α → hahn_series Γ R)
(is_pwo_Union_support' : set.is_pwo (⋃ (a : α), (to_fun a).support))
(finite_co_support' : ∀ (g : Γ), ({a | (to_fun a).coeff g ≠ 0}).finite)

end

namespace summable_family
section add_comm_monoid

variables [partial_order Γ] [add_comm_monoid R] {α : Type*}

instance : has_coe_to_fun (summable_family Γ R α) (λ _, α → hahn_series Γ R):=
⟨to_fun⟩

lemma is_pwo_Union_support (s : summable_family Γ R α) : set.is_pwo (⋃ (a : α), (s a).support) :=
s.is_pwo_Union_support'

lemma finite_co_support (s : summable_family Γ R α) (g : Γ) :
  (function.support (λ a, (s a).coeff g)).finite :=
s.finite_co_support' g

lemma coe_injective : @function.injective (summable_family Γ R α) (α → hahn_series Γ R) coe_fn
| ⟨f1, hU1, hf1⟩ ⟨f2, hU2, hf2⟩ h :=
begin
  change f1 = f2 at h,
  subst h,
end

@[ext]
lemma ext {s t : summable_family Γ R α} (h : ∀ (a : α), s a = t a) : s = t :=
coe_injective $ funext h

instance : has_add (summable_family Γ R α) :=
⟨λ x y, { to_fun := x + y,
    is_pwo_Union_support' := (x.is_pwo_Union_support.union y.is_pwo_Union_support).mono (begin
      rw ← set.Union_union_distrib,
      exact set.Union_mono (λ a, support_add_subset)
    end),
    finite_co_support' := λ g, ((x.finite_co_support g).union (y.finite_co_support g)).subset begin
      intros a ha,
      change (x a).coeff g + (y a).coeff g ≠ 0 at ha,
      rw [set.mem_union, function.mem_support, function.mem_support],
      contrapose! ha,
      rw [ha.1, ha.2, add_zero]
    end }⟩

instance : has_zero (summable_family Γ R α) :=
⟨⟨0, by simp, by simp⟩⟩

instance : inhabited (summable_family Γ R α) := ⟨0⟩

@[simp]
lemma coe_add {s t : summable_family Γ R α} : ⇑(s + t) = s + t := rfl

lemma add_apply {s t : summable_family Γ R α} {a : α} : (s + t) a = s a + t a := rfl

@[simp]
lemma coe_zero : ((0 : summable_family Γ R α) : α → hahn_series Γ R) = 0 := rfl

lemma zero_apply {a : α} : (0 : summable_family Γ R α) a = 0 := rfl

instance : add_comm_monoid (summable_family Γ R α) :=
{ add := (+),
  zero := 0,
  zero_add := λ s, by { ext, apply zero_add },
  add_zero := λ s, by { ext, apply add_zero },
  add_comm := λ s t, by { ext, apply add_comm },
  add_assoc := λ r s t, by { ext, apply add_assoc } }

/-- The infinite sum of a `summable_family` of Hahn series. -/
def hsum (s : summable_family Γ R α) :
  hahn_series Γ R :=
{ coeff := λ g, ∑ᶠ i, (s i).coeff g,
  is_pwo_support' := s.is_pwo_Union_support.mono (λ g, begin
    contrapose,
    rw [set.mem_Union, not_exists, function.mem_support, not_not],
    simp_rw [mem_support, not_not],
    intro h,
    rw [finsum_congr h, finsum_zero],
  end) }

@[simp]
lemma hsum_coeff {s : summable_family Γ R α} {g : Γ} :
  s.hsum.coeff g = ∑ᶠ i, (s i).coeff g := rfl

lemma support_hsum_subset {s : summable_family Γ R α} :
  s.hsum.support ⊆ ⋃ (a : α), (s a).support :=
λ g hg, begin
  rw [mem_support, hsum_coeff, finsum_eq_sum _ (s.finite_co_support _)] at hg,
  obtain ⟨a, h1, h2⟩ := exists_ne_zero_of_sum_ne_zero hg,
  rw [set.mem_Union],
  exact ⟨a, h2⟩,
end

@[simp]
lemma hsum_add {s t : summable_family Γ R α} : (s + t).hsum = s.hsum + t.hsum :=
begin
  ext g,
  simp only [hsum_coeff, add_coeff, add_apply],
  exact finsum_add_distrib (s.finite_co_support _) (t.finite_co_support _)
end

end add_comm_monoid

section add_comm_group
variables [partial_order Γ] [add_comm_group R] {α : Type*} {s t : summable_family Γ R α} {a : α}

instance : add_comm_group (summable_family Γ R α) :=
{ neg := λ s, { to_fun := λ a, - s a,
    is_pwo_Union_support' := by { simp_rw [support_neg], exact s.is_pwo_Union_support' },
    finite_co_support' := λ g, by { simp only [neg_coeff', pi.neg_apply, ne.def, neg_eq_zero],
      exact s.finite_co_support g } },
  add_left_neg := λ a, by { ext, apply add_left_neg },
  .. summable_family.add_comm_monoid }

@[simp]
lemma coe_neg : ⇑(-s) = - s := rfl

lemma neg_apply : (-s) a = - (s a) := rfl

@[simp]
lemma coe_sub : ⇑(s - t) = s - t := rfl

lemma sub_apply : (s - t) a = s a - t a := rfl

end add_comm_group

section semiring

variables [ordered_cancel_add_comm_monoid Γ] [semiring R] {α : Type*}

instance : has_smul (hahn_series Γ R) (summable_family Γ R α) :=
{ smul := λ x s, { to_fun := λ a, x * (s a),
    is_pwo_Union_support' := begin
      apply (x.is_pwo_support.add s.is_pwo_Union_support).mono,
      refine set.subset.trans (set.Union_mono (λ a, support_mul_subset_add_support)) _,
      intro g,
      simp only [set.mem_Union, exists_imp_distrib],
      exact λ a ha, (set.add_subset_add (set.subset.refl _) (set.subset_Union _ a)) ha,
    end,
    finite_co_support' := λ g, begin
      refine ((add_antidiagonal x.is_pwo_support s.is_pwo_Union_support g).finite_to_set.bUnion'
        (λ ij hij, _)).subset (λ a ha, _),
      { exact λ ij hij, function.support (λ a, (s a).coeff ij.2) },
      { apply s.finite_co_support },
      { obtain ⟨i, j, hi, hj, rfl⟩ := support_mul_subset_add_support ha,
        simp only [exists_prop, set.mem_Union, mem_add_antidiagonal, mul_coeff, mem_support,
          is_pwo_support, prod.exists],
        exact ⟨i, j, mem_coe.2 (mem_add_antidiagonal.2 ⟨hi, set.mem_Union.2 ⟨a, hj⟩, rfl⟩), hj⟩ }
    end } }

@[simp]
lemma smul_apply {x : hahn_series Γ R} {s : summable_family Γ R α} {a : α} :
  (x • s) a = x * (s a) := rfl

instance : module (hahn_series Γ R) (summable_family Γ R α) :=
{ smul := (•),
  smul_zero := λ x, ext (λ a, mul_zero _),
  zero_smul := λ x, ext (λ a, zero_mul _),
  one_smul := λ x, ext (λ a, one_mul _),
  add_smul := λ x y s, ext (λ a, add_mul _ _ _),
  smul_add := λ x s t, ext (λ a, mul_add _ _ _),
  mul_smul := λ x y s, ext (λ a, mul_assoc _ _ _) }

@[simp]
lemma hsum_smul {x : hahn_series Γ R} {s : summable_family Γ R α} :
  (x • s).hsum = x * s.hsum :=
begin
  ext g,
  simp only [mul_coeff, hsum_coeff, smul_apply],
  have h : ∀ i, (s i).support ⊆ ⋃ j, (s j).support := set.subset_Union _,
  refine (eq.trans (finsum_congr (λ a, _))
    (finsum_sum_comm (add_antidiagonal x.is_pwo_support s.is_pwo_Union_support g)
    (λ i ij, x.coeff (prod.fst ij) * (s i).coeff ij.snd) _)).trans _,
  { refine sum_subset (add_antidiagonal_mono_right (set.subset_Union _ a)) _,
    rintro ⟨i, j⟩ hU ha,
    rw mem_add_antidiagonal at *,
    rw [not_not.1 (λ con, ha ⟨hU.1, con, hU.2.2⟩), mul_zero] },
  { rintro ⟨i, j⟩ hij,
    refine (s.finite_co_support j).subset _,
    simp_rw [function.support_subset_iff', function.mem_support, not_not],
    intros a ha,
    rw [ha, mul_zero] },
  { refine (sum_congr rfl _).trans (sum_subset (add_antidiagonal_mono_right _) _).symm,
    { rintro ⟨i, j⟩ hij,
      rw mul_finsum,
      apply s.finite_co_support, },
    { intros x hx,
      simp only [set.mem_Union, ne.def, mem_support],
      contrapose! hx,
      simp [hx] },
    { rintro ⟨i, j⟩ hU ha,
      rw mem_add_antidiagonal at *,
      rw [← hsum_coeff, not_not.1 (λ con, ha ⟨hU.1, con, hU.2.2⟩), mul_zero] } }
end

/-- The summation of a `summable_family` as a `linear_map`. -/
@[simps] def lsum : (summable_family Γ R α) →ₗ[hahn_series Γ R] (hahn_series Γ R) :=
{ to_fun := hsum, map_add' := λ _ _, hsum_add, map_smul' := λ _ _, hsum_smul }

@[simp]
lemma hsum_sub {R : Type*} [ring R] {s t : summable_family Γ R α} :
  (s - t).hsum = s.hsum - t.hsum :=
by rw [← lsum_apply, linear_map.map_sub, lsum_apply, lsum_apply]

end semiring

section of_finsupp
variables [partial_order Γ] [add_comm_monoid R] {α : Type*}

/-- A family with only finitely many nonzero elements is summable. -/
def of_finsupp (f : α →₀ (hahn_series Γ R)) :
  summable_family Γ R α :=
{ to_fun := f,
  is_pwo_Union_support' := begin
      apply (f.support.is_pwo_bUnion.2 $ λ a ha, (f a).is_pwo_support).mono,
      refine set.Union_subset_iff.2 (λ a g hg, _),
      have haf : a ∈ f.support,
      { rw [finsupp.mem_support_iff, ← support_nonempty_iff],
        exact ⟨g, hg⟩ },
      exact set.mem_bUnion haf hg
    end,
  finite_co_support' := λ g, begin
    refine f.support.finite_to_set.subset (λ a ha, _),
    simp only [coeff.add_monoid_hom_apply, mem_coe, finsupp.mem_support_iff,
    ne.def, function.mem_support],
    contrapose! ha,
    simp [ha]
  end }

@[simp]
lemma coe_of_finsupp {f : α →₀ (hahn_series Γ R)} : ⇑(summable_family.of_finsupp f) = f := rfl

@[simp]
lemma hsum_of_finsupp {f : α →₀ (hahn_series Γ R)} :
  (of_finsupp f).hsum = f.sum (λ a, id) :=
begin
  ext g,
  simp only [hsum_coeff, coe_of_finsupp, finsupp.sum, ne.def],
  simp_rw [← coeff.add_monoid_hom_apply, id.def],
  rw [add_monoid_hom.map_sum, finsum_eq_sum_of_support_subset],
  intros x h,
  simp only [coeff.add_monoid_hom_apply, mem_coe, finsupp.mem_support_iff, ne.def],
  contrapose! h,
  simp [h]
end

end of_finsupp

section emb_domain
variables [partial_order Γ] [add_comm_monoid R] {α β : Type*}

/-- A summable family can be reindexed by an embedding without changing its sum. -/
def emb_domain (s : summable_family Γ R α) (f : α ↪ β) : summable_family Γ R β :=
{ to_fun := λ b, if h : b ∈ set.range f then s (classical.some h) else 0,
  is_pwo_Union_support' := begin
    refine s.is_pwo_Union_support.mono (set.Union_subset (λ b g h, _)),
    by_cases hb : b ∈ set.range f,
    { rw dif_pos hb at h,
      exact set.mem_Union.2 ⟨classical.some hb, h⟩ },
    { contrapose! h,
      simp [hb] }
  end,
  finite_co_support' := λ g, ((s.finite_co_support g).image f).subset begin
    intros b h,
    by_cases hb : b ∈ set.range f,
    { simp only [ne.def, set.mem_set_of_eq, dif_pos hb] at h,
      exact ⟨classical.some hb, h, classical.some_spec hb⟩ },
    { contrapose! h,
      simp only [ne.def, set.mem_set_of_eq, dif_neg hb, not_not, zero_coeff] }
  end }

variables (s : summable_family Γ R α) (f : α ↪ β) {a : α} {b : β}

lemma emb_domain_apply :
  s.emb_domain f b = if h : b ∈ set.range f then s (classical.some h) else 0 := rfl

@[simp] lemma emb_domain_image : s.emb_domain f (f a) = s a :=
begin
  rw [emb_domain_apply, dif_pos (set.mem_range_self a)],
  exact congr rfl (f.injective (classical.some_spec (set.mem_range_self a)))
end

@[simp] lemma emb_domain_notin_range (h : b ∉ set.range f) : s.emb_domain f b = 0 :=
by rw [emb_domain_apply, dif_neg h]

@[simp] lemma hsum_emb_domain :
  (s.emb_domain f).hsum = s.hsum :=
begin
  ext g,
  simp only [hsum_coeff, emb_domain_apply, apply_dite hahn_series.coeff, dite_apply, zero_coeff],
  exact finsum_emb_domain f (λ a, (s a).coeff g)
end

end emb_domain

section powers

variables [linear_ordered_cancel_add_comm_monoid Γ] [comm_ring R] [is_domain R]

/-- The powers of an element of positive valuation form a summable family. -/
def powers (x : hahn_series Γ R) (hx : 0 < add_val Γ R x) :
  summable_family Γ R ℕ :=
{ to_fun := λ n, x ^ n,
  is_pwo_Union_support' := is_pwo_Union_support_powers hx,
  finite_co_support' := λ g, begin
    have hpwo := (is_pwo_Union_support_powers hx),
    by_cases hg : g ∈ ⋃ n : ℕ, {g | (x ^ n).coeff g ≠ 0 },
    swap, { exact set.finite_empty.subset (λ n hn, hg (set.mem_Union.2 ⟨n, hn⟩)) },
    apply hpwo.is_wf.induction hg,
    intros y ys hy,
    refine ((((add_antidiagonal x.is_pwo_support hpwo y).finite_to_set.bUnion (λ ij hij,
      hy ij.snd _ _)).image nat.succ).union (set.finite_singleton 0)).subset _,
    { exact (mem_add_antidiagonal.1 (mem_coe.1 hij)).2.1 },
    { obtain ⟨hi, hj, rfl⟩ := mem_add_antidiagonal.1 (mem_coe.1 hij),
      rw [← zero_add ij.snd, ← add_assoc, add_zero],
      exact add_lt_add_right (with_top.coe_lt_coe.1
        (lt_of_lt_of_le hx (add_val_le_of_coeff_ne_zero hi))) _, },
    { rintro (_ | n) hn,
      { exact set.mem_union_right _ (set.mem_singleton 0) },
      { obtain ⟨i, j, hi, hj, rfl⟩ := support_mul_subset_add_support hn,
        refine set.mem_union_left _ ⟨n, set.mem_Union.2 ⟨⟨i, j⟩, set.mem_Union.2 ⟨_, hj⟩⟩, rfl⟩,
        simp only [and_true, set.mem_Union, mem_add_antidiagonal, mem_coe, eq_self_iff_true,
          ne.def, mem_support, set.mem_set_of_eq],
        exact ⟨hi, n, hj⟩ } }
  end }

variables {x : hahn_series Γ R} (hx : 0 < add_val Γ R x)

@[simp] lemma coe_powers : ⇑(powers x hx) = pow x := rfl

lemma emb_domain_succ_smul_powers :
  (x • powers x hx).emb_domain ⟨nat.succ, nat.succ_injective⟩ =
    powers x hx - of_finsupp (finsupp.single 0 1) :=
begin
  apply summable_family.ext (λ n, _),
  cases n,
  { rw [emb_domain_notin_range, sub_apply, coe_powers, pow_zero, coe_of_finsupp,
      finsupp.single_eq_same, sub_self],
    rw [set.mem_range, not_exists],
    exact nat.succ_ne_zero },
  { refine eq.trans (emb_domain_image _ ⟨nat.succ, nat.succ_injective⟩) _,
    simp only [pow_succ, coe_powers, coe_sub, smul_apply, coe_of_finsupp, pi.sub_apply],
    rw [finsupp.single_eq_of_ne (n.succ_ne_zero).symm, sub_zero] }
end

lemma one_sub_self_mul_hsum_powers :
  (1 - x) * (powers x hx).hsum = 1 :=
begin
  rw [← hsum_smul, sub_smul, one_smul, hsum_sub,
    ← hsum_emb_domain (x • powers x hx) ⟨nat.succ, nat.succ_injective⟩,
    emb_domain_succ_smul_powers],
  simp,
end

end powers

end summable_family

section inversion

variables [linear_ordered_add_comm_group Γ]

section is_domain
variables [comm_ring R] [is_domain R]

lemma unit_aux (x : hahn_series Γ R) {r : R} (hr : r * x.coeff x.order = 1) :
  0 < add_val Γ R (1 - C r * (single (- x.order) 1) * x) :=
begin
  have h10 : (1 : R) ≠ 0 := one_ne_zero,
  have x0 : x ≠ 0 := ne_zero_of_coeff_ne_zero (right_ne_zero_of_mul_eq_one hr),
  refine lt_of_le_of_ne ((add_val Γ R).map_le_sub (ge_of_eq (add_val Γ R).map_one) _) _,
  { simp only [add_valuation.map_mul],
    rw [add_val_apply_of_ne x0, add_val_apply_of_ne (single_ne_zero h10),
      add_val_apply_of_ne _, order_C, order_single h10, with_top.coe_zero, zero_add,
      ← with_top.coe_add, neg_add_self, with_top.coe_zero],
    { exact le_refl 0 },
    { exact C_ne_zero (left_ne_zero_of_mul_eq_one hr) } },
  { rw [add_val_apply, ← with_top.coe_zero],
    split_ifs,
    { apply with_top.coe_ne_top },
    rw [ne.def, with_top.coe_eq_coe],
    intro con,
    apply coeff_order_ne_zero h,
    rw [← con, mul_assoc, sub_coeff, one_coeff, if_pos rfl, C_mul_eq_smul, smul_coeff, smul_eq_mul,
      ← add_neg_self x.order, single_mul_coeff_add, one_mul, hr, sub_self] }
end

end is_domain

instance [field R] : field (hahn_series Γ R) :=
{ inv := λ x, if x0 : x = 0 then 0 else (C (x.coeff x.order)⁻¹ * (single (-x.order)) 1 *
      (summable_family.powers _ (unit_aux x (inv_mul_cancel (coeff_order_ne_zero x0)))).hsum),
  inv_zero := dif_pos rfl,
  mul_inv_cancel := λ x x0, begin
    refine (congr rfl (dif_neg x0)).trans _,
    have h := summable_family.one_sub_self_mul_hsum_powers
      (unit_aux x (inv_mul_cancel (coeff_order_ne_zero x0))),
    rw [sub_sub_cancel] at h,
    rw [← mul_assoc, mul_comm x, h],
  end,
  .. hahn_series.is_domain,
  .. hahn_series.comm_ring }

end inversion

end hahn_series


/-
Copyright (c) 2020 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin

! This file was ported from Lean 3 source module algebra.group_with_zero.units.basic
! leanprover-community/mathlib commit 70d50ecfd4900dd6d328da39ab7ebd516abe4025
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.GroupWithZero.Basic
import Mathlib.Algebra.Group.Units
import Mathlib.Tactic.Nontriviality
import Mathlib.Tactic.Convert
import Mathlib.Tactic.Contrapose

/-!
# Lemmas about units in a `MonoidWithZero` or a `GroupWithZero`.

We also define `Ring.inverse`, a globally defined function on any ring
(in fact any `MonoidWithZero`), which inverts units and sends non-units to zero.
-/

variable {α M₀ G₀ M₀' G₀' F F' : Type _}

variable [MonoidWithZero M₀]

namespace Units

/-- An element of the unit group of a nonzero monoid with zero represented as an element
    of the monoid is nonzero. -/
@[simp]
theorem ne_zero [Nontrivial M₀] (u : M₀ˣ) : (u : M₀) ≠ 0 :=
  left_ne_zero_of_mul_eq_one u.mul_inv
#align units.ne_zero Units.ne_zero

-- We can't use `mul_eq_zero` + `Units.ne_zero` in the next two lemmas because we don't assume
-- `Nonzero M₀`.
@[simp]
theorem mul_left_eq_zero (u : M₀ˣ) {a : M₀} : a * u = 0 ↔ a = 0 :=
  ⟨fun h => by simpa using mul_eq_zero_of_left h ↑u⁻¹, fun h => mul_eq_zero_of_left h u⟩
#align units.mul_left_eq_zero Units.mul_left_eq_zero

@[simp]
theorem mul_right_eq_zero (u : M₀ˣ) {a : M₀} : ↑u * a = 0 ↔ a = 0 :=
  ⟨fun h => by simpa using mul_eq_zero_of_right (↑u⁻¹) h, mul_eq_zero_of_right (u : M₀)⟩
#align units.mul_right_eq_zero Units.mul_right_eq_zero

end Units

namespace IsUnit

theorem ne_zero [Nontrivial M₀] {a : M₀} (ha : IsUnit a) : a ≠ 0 :=
  let ⟨u, hu⟩ := ha
  hu ▸ u.ne_zero
#align is_unit.ne_zero IsUnit.ne_zero

theorem mul_right_eq_zero {a b : M₀} (ha : IsUnit a) : a * b = 0 ↔ b = 0 :=
  let ⟨u, hu⟩ := ha
  hu ▸ u.mul_right_eq_zero
#align is_unit.mul_right_eq_zero IsUnit.mul_right_eq_zero

theorem mul_left_eq_zero {a b : M₀} (hb : IsUnit b) : a * b = 0 ↔ a = 0 :=
  let ⟨u, hu⟩ := hb
  hu ▸ u.mul_left_eq_zero
#align is_unit.mul_left_eq_zero IsUnit.mul_left_eq_zero

end IsUnit

@[simp]
theorem isUnit_zero_iff : IsUnit (0 : M₀) ↔ (0 : M₀) = 1 :=
  ⟨fun ⟨⟨_, a, (a0 : 0 * a = 1), _⟩, rfl⟩ => by rwa [zero_mul] at a0, fun h =>
    @isUnit_of_subsingleton _ _ (subsingleton_of_zero_eq_one h) 0⟩
#align is_unit_zero_iff isUnit_zero_iff

-- porting note: removed `simp` tag because `simpNF` says it's redundant
theorem not_isUnit_zero [Nontrivial M₀] : ¬IsUnit (0 : M₀) :=
  mt isUnit_zero_iff.1 zero_ne_one
#align not_is_unit_zero not_isUnit_zero

namespace Ring

open Classical

/-- Introduce a function `inverse` on a monoid with zero `M₀`, which sends `x` to `x⁻¹` if `x` is
invertible and to `0` otherwise.  This definition is somewhat ad hoc, but one needs a fully (rather
than partially) defined inverse function for some purposes, including for calculus.

Note that while this is in the `Ring` namespace for brevity, it requires the weaker assumption
`MonoidWithZero M₀` instead of `Ring M₀`. -/
noncomputable def inverse : M₀ → M₀ := fun x => if h : IsUnit x then ((h.unit⁻¹ : M₀ˣ) : M₀) else 0
#align ring.inverse Ring.inverse

/-- By definition, if `x` is invertible then `inverse x = x⁻¹`. -/
@[simp]
theorem inverse_unit (u : M₀ˣ) : inverse (u : M₀) = (u⁻¹ : M₀ˣ) := by
  simp only [Units.isUnit, inverse, dif_pos]
  exact Units.inv_unique rfl
#align ring.inverse_unit Ring.inverse_unit

/-- By definition, if `x` is not invertible then `inverse x = 0`. -/
@[simp]
theorem inverse_non_unit (x : M₀) (h : ¬IsUnit x) : inverse x = 0 :=
  dif_neg h
#align ring.inverse_non_unit Ring.inverse_non_unit

theorem mul_inverse_cancel (x : M₀) (h : IsUnit x) : x * inverse x = 1 := by
  rcases h with ⟨u, rfl⟩
  rw [inverse_unit, Units.mul_inv]
#align ring.mul_inverse_cancel Ring.mul_inverse_cancel

theorem inverse_mul_cancel (x : M₀) (h : IsUnit x) : inverse x * x = 1 := by
  rcases h with ⟨u, rfl⟩
  rw [inverse_unit, Units.inv_mul]
#align ring.inverse_mul_cancel Ring.inverse_mul_cancel

theorem mul_inverse_cancel_right (x y : M₀) (h : IsUnit x) : y * x * inverse x = y := by
  rw [mul_assoc, mul_inverse_cancel x h, mul_one]
#align ring.mul_inverse_cancel_right Ring.mul_inverse_cancel_right

theorem inverse_mul_cancel_right (x y : M₀) (h : IsUnit x) : y * inverse x * x = y := by
  rw [mul_assoc, inverse_mul_cancel x h, mul_one]
#align ring.inverse_mul_cancel_right Ring.inverse_mul_cancel_right

theorem mul_inverse_cancel_left (x y : M₀) (h : IsUnit x) : x * (inverse x * y) = y := by
  rw [← mul_assoc, mul_inverse_cancel x h, one_mul]
#align ring.mul_inverse_cancel_left Ring.mul_inverse_cancel_left

theorem inverse_mul_eq_iff_eq_mul (x y z : M₀) (h : IsUnit x) : inverse x * y = z ↔ y = x * z :=
  ⟨fun h1 => by rw [← h1, mul_inverse_cancel_left _ _ h],
  fun h1 => by rw [h1, inverse_mul_cancel_left _ _ h]⟩
#align ring.inverse_mul_eq_iff_eq_mul Ring.inverse_mul_eq_iff_eq_mul

theorem eq_mul_inverse_iff_mul_eq (x y z : M₀) (h : IsUnit z) : x = y * inverse z ↔ x * z = y :=
  ⟨fun h1 => by rw [h1, inverse_mul_cancel_right _ _ h],
  fun h1 => by rw [← h1, mul_inverse_cancel_right _ _ h]⟩
#align ring.eq_mul_inverse_iff_mul_eq Ring.eq_mul_inverse_iff_mul_eq

variable (M₀)

@[simp]
theorem inverse_one : inverse (1 : M₀) = 1 :=
  inverse_unit 1
#align ring.inverse_one Ring.inverse_one

@[simp]
theorem inverse_zero : inverse (0 : M₀) = 0 := by
  nontriviality
  exact inverse_non_unit _ not_isUnit_zero
#align ring.inverse_zero Ring.inverse_zero

variable {M₀}

end Ring

theorem IsUnit.ring_inverse {a : M₀} : IsUnit a → IsUnit (Ring.inverse a)
  | ⟨u, hu⟩ => hu ▸ ⟨u⁻¹, (Ring.inverse_unit u).symm⟩
#align is_unit.ring_inverse IsUnit.ring_inverse

@[simp]
theorem isUnit_ring_inverse {a : M₀} : IsUnit (Ring.inverse a) ↔ IsUnit a :=
  ⟨fun h => by
    cases subsingleton_or_nontrivial M₀
    · convert h
    · contrapose h
      rw [Ring.inverse_non_unit _ h]
      exact not_isUnit_zero
      ,
    IsUnit.ring_inverse⟩
#align is_unit_ring_inverse isUnit_ring_inverse

namespace Units

variable [GroupWithZero G₀]

variable {a b : G₀}

/-- Embed a non-zero element of a `GroupWithZero` into the unit group.
  By combining this function with the operations on units,
  or the `/ₚ` operation, it is possible to write a division
  as a partial function with three arguments. -/
def mk0 (a : G₀) (ha : a ≠ 0) : G₀ˣ :=
  ⟨a, a⁻¹, mul_inv_cancel ha, inv_mul_cancel ha⟩
#align units.mk0 Units.mk0

@[simp]
theorem mk0_one (h := one_ne_zero) : mk0 (1 : G₀) h = 1 := by
  ext
  rfl
#align units.mk0_one Units.mk0_one

@[simp]
theorem val_mk0 {a : G₀} (h : a ≠ 0) : (mk0 a h : G₀) = a :=
  rfl
#align units.coe_mk0 Units.val_mk0

@[simp]
theorem mk0_val (u : G₀ˣ) (h : (u : G₀) ≠ 0) : mk0 (u : G₀) h = u :=
  Units.ext rfl
#align units.mk0_coe Units.mk0_val

-- porting note: removed `simp` tag because `simpNF` says it's redundant
theorem mul_inv' (u : G₀ˣ) : u * (u : G₀)⁻¹ = 1 :=
  mul_inv_cancel u.ne_zero
#align units.mul_inv' Units.mul_inv'

-- porting note: removed `simp` tag because `simpNF` says it's redundant
theorem inv_mul' (u : G₀ˣ) : (u⁻¹ : G₀) * u = 1 :=
  inv_mul_cancel u.ne_zero
#align units.inv_mul' Units.inv_mul'

@[simp]
theorem mk0_inj {a b : G₀} (ha : a ≠ 0) (hb : b ≠ 0) : Units.mk0 a ha = Units.mk0 b hb ↔ a = b :=
  ⟨fun h => by injection h, fun h => Units.ext h⟩
#align units.mk0_inj Units.mk0_inj

/-- In a group with zero, an existential over a unit can be rewritten in terms of `Units.mk0`. -/
theorem exists0 {p : G₀ˣ → Prop} : (∃ g : G₀ˣ, p g) ↔ ∃ (g : G₀)(hg : g ≠ 0), p (Units.mk0 g hg) :=
  ⟨fun ⟨g, pg⟩ => ⟨g, g.ne_zero, (g.mk0_val g.ne_zero).symm ▸ pg⟩,
  fun ⟨g, hg, pg⟩ => ⟨Units.mk0 g hg, pg⟩⟩
#align units.exists0 Units.exists0

/-- An alternative version of `Units.exists0`. This one is useful if Lean cannot
figure out `p` when using `Units.exists0` from right to left. -/
theorem exists0' {p : ∀ g : G₀, g ≠ 0 → Prop} :
    (∃ (g : G₀)(hg : g ≠ 0), p g hg) ↔ ∃ g : G₀ˣ, p g g.ne_zero :=
  Iff.trans (by simp_rw [val_mk0]) exists0.symm
  -- porting note: had to add the `rfl`
#align units.exists0' Units.exists0'

@[simp]
theorem exists_iff_ne_zero {x : G₀} : (∃ u : G₀ˣ, ↑u = x) ↔ x ≠ 0 := by simp [exists0]
#align units.exists_iff_ne_zero Units.exists_iff_ne_zero

theorem _root_.GroupWithZero.eq_zero_or_unit (a : G₀) : a = 0 ∨ ∃ u : G₀ˣ, a = u := by
  by_cases h : a = 0
  · left
    exact h
  · right
    simpa only [eq_comm] using Units.exists_iff_ne_zero.mpr h

#align group_with_zero.eq_zero_or_unit GroupWithZero.eq_zero_or_unit

end Units

section GroupWithZero

variable [GroupWithZero G₀] {a b c : G₀}

theorem IsUnit.mk0 (x : G₀) (hx : x ≠ 0) : IsUnit x :=
  (Units.mk0 x hx).isUnit
#align is_unit.mk0 IsUnit.mk0

theorem isUnit_iff_ne_zero : IsUnit a ↔ a ≠ 0 :=
  Units.exists_iff_ne_zero
#align is_unit_iff_ne_zero isUnit_iff_ne_zero

alias isUnit_iff_ne_zero ↔ _ Ne.isUnit
#align ne.is_unit Ne.isUnit

-- porting note: can't add this attribute?
-- https://github.com/leanprover-community/mathlib4/issues/740
-- attribute [protected] Ne.is_unit

-- see Note [lower instance priority]
instance (priority := 10) GroupWithZero.noZeroDivisors : NoZeroDivisors G₀ :=
  { (‹_› : GroupWithZero G₀) with
    eq_zero_or_eq_zero_of_mul_eq_zero := @fun a b h => by
      contrapose! h
      exact (Units.mk0 a h.1 * Units.mk0 b h.2).ne_zero }
#align group_with_zero.no_zero_divisors GroupWithZero.noZeroDivisors

-- see Note [lower instance priority]
instance (priority := 10) GroupWithZero.cancelMonoidWithZero : CancelMonoidWithZero G₀ :=
  { (‹_› : GroupWithZero G₀) with
    mul_left_cancel_of_ne_zero := @fun x y z hx h => by
      rw [← inv_mul_cancel_left₀ hx y, h, inv_mul_cancel_left₀ hx z],
    mul_right_cancel_of_ne_zero := @fun x y z hy h => by
      rw [← mul_inv_cancel_right₀ hy x, h, mul_inv_cancel_right₀ hy z] }
#align group_with_zero.cancel_monoid_with_zero GroupWithZero.cancelMonoidWithZero

-- Can't be put next to the other `mk0` lemmas because it depends on the
-- `NoZeroDivisors` instance, which depends on `mk0`.
@[simp]
theorem Units.mk0_mul (x y : G₀) (hxy) :
    Units.mk0 (x * y) hxy =
      Units.mk0 x (mul_ne_zero_iff.mp hxy).1 * Units.mk0 y (mul_ne_zero_iff.mp hxy).2 := by
  ext; rfl
#align units.mk0_mul Units.mk0_mul

theorem div_ne_zero (ha : a ≠ 0) (hb : b ≠ 0) : a / b ≠ 0 := by
  rw [div_eq_mul_inv]
  exact mul_ne_zero ha (inv_ne_zero hb)
#align div_ne_zero div_ne_zero

@[simp]
theorem div_eq_zero_iff : a / b = 0 ↔ a = 0 ∨ b = 0 := by simp [div_eq_mul_inv]
#align div_eq_zero_iff div_eq_zero_iff

theorem div_ne_zero_iff : a / b ≠ 0 ↔ a ≠ 0 ∧ b ≠ 0 :=
  div_eq_zero_iff.not.trans not_or
#align div_ne_zero_iff div_ne_zero_iff

theorem Ring.inverse_eq_inv (a : G₀) : Ring.inverse a = a⁻¹ := by
  obtain rfl | ha := eq_or_ne a 0
  · simp
  · exact Ring.inverse_unit (Units.mk0 a ha)
#align ring.inverse_eq_inv Ring.inverse_eq_inv

@[simp]
theorem Ring.inverse_eq_inv' : (Ring.inverse : G₀ → G₀) = Inv.inv :=
  funext Ring.inverse_eq_inv
#align ring.inverse_eq_inv' Ring.inverse_eq_inv'

end GroupWithZero

section CommGroupWithZero

-- comm
variable [CommGroupWithZero G₀] {a b c d : G₀}

-- see Note [lower instance priority]
instance (priority := 10) CommGroupWithZero.cancelCommMonoidWithZero :
    CancelCommMonoidWithZero G₀ :=
  { GroupWithZero.cancelMonoidWithZero,
    CommGroupWithZero.toCommMonoidWithZero with }
#align comm_group_with_zero.cancel_comm_monoid_with_zero CommGroupWithZero.cancelCommMonoidWithZero

-- See note [lower instance priority]
instance (priority := 100) CommGroupWithZero.toDivisionCommMonoid : DivisionCommMonoid G₀ :=
  { ‹CommGroupWithZero G₀›, GroupWithZero.toDivisionMonoid with }
#align comm_group_with_zero.to_division_comm_monoid CommGroupWithZero.toDivisionCommMonoid

end CommGroupWithZero

section NoncomputableDefs

open Classical

variable {M : Type _} [Nontrivial M]

/-- Constructs a `GroupWithZero` structure on a `MonoidWithZero`
  consisting only of units and 0. -/
noncomputable def groupWithZeroOfIsUnitOrEqZero [hM : MonoidWithZero M]
    (h : ∀ a : M, IsUnit a ∨ a = 0) : GroupWithZero M :=
  { hM with
    inv := fun a => if h0 : a = 0 then 0 else ↑((h a).resolve_right h0).unit⁻¹,
    inv_zero := dif_pos rfl,
    mul_inv_cancel := fun a h0 => by
      change (a * if h0 : a = 0 then 0 else ↑((h a).resolve_right h0).unit⁻¹) = 1
      rw [dif_neg h0, Units.mul_inv_eq_iff_eq_mul, one_mul, IsUnit.unit_spec],
    exists_pair_ne := Nontrivial.exists_pair_ne }
#align group_with_zero_of_is_unit_or_eq_zero groupWithZeroOfIsUnitOrEqZero

/-- Constructs a `CommGroupWithZero` structure on a `CommMonoidWithZero`
  consisting only of units and 0. -/
noncomputable def commGroupWithZeroOfIsUnitOrEqZero [hM : CommMonoidWithZero M]
    (h : ∀ a : M, IsUnit a ∨ a = 0) : CommGroupWithZero M :=
  { groupWithZeroOfIsUnitOrEqZero h, hM with }
#align comm_group_with_zero_of_is_unit_or_eq_zero commGroupWithZeroOfIsUnitOrEqZero

end NoncomputableDefs

-- Guard against import creep
-- porting note: command not ported yet (added in mathlib#17416)
-- assert_not_exists multiplicative