/-
Copyright (c) 2021 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Aaron Anderson
-/
import set_theory.cardinal

/-!
# Finite Cardinality Functions

## Main Definitions

* `nat.card α` is the cardinality of `α` as a natural number.
  If `α` is infinite, `nat.card α = 0`.
* `enat.card α` is the cardinality of `α` as an extended natural number.
  If `α` is infinite, `enat.card α = ⊤`.

-/

open cardinal
noncomputable theory

variable {α : Type*}

namespace nat

/-- `nat.card α` is the cardinality of `α` as a natural number.
  If `α` is infinite, `nat.card α = 0`. -/
protected def card (α : Type*) : ℕ := (mk α).to_nat

@[simp]
lemma card_eq_fintype_card [fintype α] : nat.card α = fintype.card α := mk_to_nat_eq_card

@[simp]
lemma card_eq_zero_of_infinite [infinite α] : nat.card α = 0 := mk_to_nat_of_infinite

end nat

namespace enat

/-- `enat.card α` is the cardinality of `α` as an extended natural number.
  If `α` is infinite, `enat.card α = ⊤`. -/
def card (α : Type*) : enat := (mk α).to_enat

@[simp]
lemma card_eq_coe_fintype_card [fintype α] : card α = fintype.card α := mk_to_enat_eq_coe_card

@[simp]
lemma card_eq_top_of_infinite [infinite α] : card α = ⊤ := mk_to_enat_of_infinite

end enat


-- Introducción del cuantificador universal: La función cuadrado es par
-- ====================================================================

import tactic
import data.real.basic

-- ----------------------------------------------------
-- Ejercicio 1. Demostrar que
--    ∀ x : ℝ, (-x)^2 = x^2
-- ----------------------------------------------------

-- 1ª demostración
example :
  ∀ x : ℝ, (-x)^2 = x^2 :=
begin
  intro a,
  -- by library_search,
  exact neg_square a,
end

-- 2ª demostración
example :
  ∀ x : ℝ, (-x)^2 = x^2 :=
neg_square

-- 3ª demostración
example :
  ∀ x : ℝ, (-x)^2 = x^2 :=
begin
  intro a,
  -- by hint,
  ring,
end

-- 4ª demostración
example :
  ∀ x : ℝ, (-x)^2 = x^2 :=
begin
  intro a,
  norm_num,
end

-- 5ª demostración
example :
  ∀ x : ℝ, (-x)^2 = x^2 :=
by norm_num

-- 6ª demostración
example :
  ∀ x : ℝ, (-x)^2 = x^2 :=
begin
  intro a,
  finish,
end

-- 7ª demostración
example :
  ∀ x : ℝ, (-x)^2 = x^2 :=
by finish

-- 8ª demostración
example :
  ∀ x : ℝ, (-x)^2 = x^2 :=
begin
  intro a,
  simp,
end

-- 9ª demostración
example :
  ∀ x : ℝ, (-x)^2 = x^2 :=
by simp


/-
Copyright (c) 2017 Mario Carneiro. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Mario Carneiro
-/
import data.list.basic
import data.stream
import data.lazy_list
import data.seq.computation

universes u v w

/-
coinductive seq (α : Type u) : Type u
| nil : seq α
| cons : α → seq α → seq α
-/

/--
A stream `s : option α` is a sequence if `s.nth n = none` implies `s.nth (n + 1) = none`.
-/
def stream.is_seq {α : Type u} (s : stream (option α)) : Prop :=
∀ {n : ℕ}, s n = none → s (n + 1) = none

/-- `seq α` is the type of possibly infinite lists (referred here as sequences).
  It is encoded as an infinite stream of options such that if `f n = none`, then
  `f m = none` for all `m ≥ n`. -/
def seq (α : Type u) : Type u := { f : stream (option α) // f.is_seq }

/-- `seq1 α` is the type of nonempty sequences. -/
def seq1 (α) := α × seq α

namespace seq
variables {α : Type u} {β : Type v} {γ : Type w}

/-- The empty sequence -/
def nil : seq α := ⟨stream.const none, λn h, rfl⟩

instance : inhabited (seq α) := ⟨nil⟩

/-- Prepend an element to a sequence -/
def cons (a : α) : seq α → seq α
| ⟨f, al⟩ := ⟨some a :: f, λn h, by {cases n with n, contradiction, exact al h}⟩

/-- Get the nth element of a sequence (if it exists) -/
def nth : seq α → ℕ → option α := subtype.val

/-- A sequence has terminated at position `n` if the value at position `n` equals `none`. -/
def terminated_at (s : seq α) (n : ℕ) : Prop := s.nth n = none

/-- It is decidable whether a sequence terminates at a given position. -/
instance terminated_at_decidable (s : seq α) (n : ℕ) : decidable (s.terminated_at n) :=
decidable_of_iff' (s.nth n).is_none $ by unfold terminated_at; cases s.nth n; simp

/-- A sequence terminates if there is some position `n` at which it has terminated. -/
def terminates (s : seq α) : Prop := ∃ (n : ℕ), s.terminated_at n

/-- Functorial action of the functor `option (α × _)` -/
@[simp] def omap (f : β → γ) : option (α × β) → option (α × γ)
| none          := none
| (some (a, b)) := some (a, f b)

/-- Get the first element of a sequence -/
def head (s : seq α) : option α := nth s 0

/-- Get the tail of a sequence (or `nil` if the sequence is `nil`) -/
def tail : seq α → seq α
| ⟨f, al⟩ := ⟨f.tail, λ n, al⟩

protected def mem (a : α) (s : seq α) := some a ∈ s.1

instance : has_mem α (seq α) :=
⟨seq.mem⟩

theorem le_stable (s : seq α) {m n} (h : m ≤ n) :
  s.nth m = none → s.nth n = none :=
by {cases s with f al, induction h with n h IH, exacts [id, λ h2, al (IH h2)]}

/-- If a sequence terminated at position `n`, it also terminated at `m ≥ n `. -/
lemma terminated_stable (s : seq α) {m n : ℕ} (m_le_n : m ≤ n)
(terminated_at_m : s.terminated_at m) :
  s.terminated_at n :=
le_stable s m_le_n terminated_at_m

/--
If `s.nth n = some aₙ` for some value `aₙ`, then there is also some value `aₘ` such
that `s.nth = some aₘ` for `m ≤ n`.
-/
lemma ge_stable (s : seq α) {aₙ : α} {n m : ℕ} (m_le_n : m ≤ n)
(s_nth_eq_some : s.nth n = some aₙ) :
  ∃ (aₘ : α), s.nth m = some aₘ :=
have s.nth n ≠ none, by simp [s_nth_eq_some],
have s.nth m ≠ none, from mt (s.le_stable m_le_n) this,
option.ne_none_iff_exists'.mp this

theorem not_mem_nil (a : α) : a ∉ @nil α :=
λ ⟨n, (h : some a = none)⟩, by injection h

theorem mem_cons (a : α) : ∀ (s : seq α), a ∈ cons a s
| ⟨f, al⟩ := stream.mem_cons (some a) _

theorem mem_cons_of_mem (y : α) {a : α} : ∀ {s : seq α}, a ∈ s → a ∈ cons y s
| ⟨f, al⟩ := stream.mem_cons_of_mem (some y)

theorem eq_or_mem_of_mem_cons {a b : α} : ∀ {s : seq α}, a ∈ cons b s → a = b ∨ a ∈ s
| ⟨f, al⟩ h := (stream.eq_or_mem_of_mem_cons h).imp_left (λh, by injection h)

@[simp] theorem mem_cons_iff {a b : α} {s : seq α} : a ∈ cons b s ↔ a = b ∨ a ∈ s :=
⟨eq_or_mem_of_mem_cons, λo, by cases o with e m;
  [{rw e, apply mem_cons}, exact mem_cons_of_mem _ m]⟩

/-- Destructor for a sequence, resulting in either `none` (for `nil`) or
  `some (a, s)` (for `cons a s`). -/
def destruct (s : seq α) : option (seq1 α) :=
(λa', (a', s.tail)) <$> nth s 0

theorem destruct_eq_nil {s : seq α} : destruct s = none → s = nil :=
begin
  dsimp [destruct],
  induction f0 : nth s 0; intro h,
  { apply subtype.eq,
    funext n,
    induction n with n IH, exacts [f0, s.2 IH] },
  { contradiction }
end

theorem destruct_eq_cons {s : seq α} {a s'} : destruct s = some (a, s') → s = cons a s' :=
begin
  dsimp [destruct],
  induction f0 : nth s 0 with a'; intro h,
  { contradiction },
  { cases s with f al,
    injections with _ h1 h2,
    rw ←h2, apply subtype.eq, dsimp [tail, cons],
    rw h1 at f0, rw ←f0,
    exact (stream.eta f).symm }
end

@[simp] theorem destruct_nil : destruct (nil : seq α) = none := rfl

@[simp] theorem destruct_cons (a : α) : ∀ s, destruct (cons a s) = some (a, s)
| ⟨f, al⟩ := begin
  unfold cons destruct functor.map,
  apply congr_arg (λ s, some (a, s)),
  apply subtype.eq, dsimp [tail], rw [stream.tail_cons]
end

theorem head_eq_destruct (s : seq α) : head s = prod.fst <$> destruct s :=
by unfold destruct head; cases nth s 0; refl

@[simp] theorem head_nil : head (nil : seq α) = none := rfl

@[simp] theorem head_cons (a : α) (s) : head (cons a s) = some a :=
by rw [head_eq_destruct, destruct_cons]; refl

@[simp]

@[simp] theorem tail_cons (a : α) (s) : tail (cons a s) = s :=
by cases s with f al; apply subtype.eq; dsimp [tail, cons]; rw [stream.tail_cons]

def cases_on {C : seq α → Sort v} (s : seq α)
  (h1 : C nil) (h2 : ∀ x s, C (cons x s)) : C s := begin
  induction H : destruct s with v v,
  { rw destruct_eq_nil H, apply h1 },
  { cases v with a s', rw destruct_eq_cons H, apply h2 }
end

theorem mem_rec_on {C : seq α → Prop} {a s} (M : a ∈ s)
  (h1 : ∀ b s', (a = b ∨ C s') → C (cons b s')) : C s :=
begin
  cases M with k e, unfold stream.nth at e,
  induction k with k IH generalizing s,
  { have TH : s = cons a (tail s),
    { apply destruct_eq_cons,
      unfold destruct nth functor.map, rw ←e, refl },
    rw TH, apply h1 _ _ (or.inl rfl) },
  revert e, apply s.cases_on _ (λ b s', _); intro e,
  { injection e },
  { have h_eq : (cons b s').val (nat.succ k) = s'.val k, { cases s'; refl },
    rw [h_eq] at e,
    apply h1 _ _ (or.inr (IH e)) }
end

def corec.F (f : β → option (α × β)) : option β → option α × option β
| none     := (none, none)
| (some b) := match f b with none := (none, none) | some (a, b') := (some a, some b') end

/-- Corecursor for `seq α` as a coinductive type. Iterates `f` to produce new elements
  of the sequence until `none` is obtained. -/
def corec (f : β → option (α × β)) (b : β) : seq α :=
begin
  refine ⟨stream.corec' (corec.F f) (some b), λn h, _⟩,
  rw stream.corec'_eq,
  change stream.corec' (corec.F f) (corec.F f (some b)).2 n = none,
  revert h, generalize : some b = o, revert o,
  induction n with n IH; intro o,
  { change (corec.F f o).1 = none → (corec.F f (corec.F f o).2).1 = none,
    cases o with b; intro h, { refl },
    dsimp [corec.F] at h, dsimp [corec.F],
    cases f b with s, { refl },
    { cases s with a b', contradiction } },
  { rw [stream.corec'_eq (corec.F f) (corec.F f o).2,
        stream.corec'_eq (corec.F f) o],
    exact IH (corec.F f o).2 }
end

@[simp] theorem corec_eq (f : β → option (α × β)) (b : β) :
  destruct (corec f b) = omap (corec f) (f b) :=
begin
  dsimp [corec, destruct, nth],
  change stream.corec' (corec.F f) (some b) 0 with (corec.F f (some b)).1,
  dsimp [corec.F],
  induction h : f b with s, { refl },
  cases s with a b', dsimp [corec.F],
  apply congr_arg (λ b', some (a, b')),
  apply subtype.eq,
  dsimp [corec, tail],
  rw [stream.corec'_eq, stream.tail_cons],
  dsimp [corec.F], rw h, refl
end

/-- Embed a list as a sequence -/
def of_list (l : list α) : seq α :=
⟨list.nth l, λn h, begin
  induction l with a l IH generalizing n, refl,
  dsimp [list.nth], cases n with n; dsimp [list.nth] at h,
  { contradiction },
  { apply IH _ h }
end⟩

instance coe_list : has_coe (list α) (seq α) := ⟨of_list⟩

section bisim
  variable (R : seq α → seq α → Prop)

  local infix ~ := R

  def bisim_o : option (seq1 α) → option (seq1 α) → Prop
  | none          none            := true
  | (some (a, s)) (some (a', s')) := a = a' ∧ R s s'
  | _             _               := false
  attribute [simp] bisim_o

  def is_bisimulation := ∀ ⦃s₁ s₂⦄, s₁ ~ s₂ → bisim_o R (destruct s₁) (destruct s₂)

  -- If two streams are bisimilar, then they are equal
  theorem eq_of_bisim (bisim : is_bisimulation R) {s₁ s₂} (r : s₁ ~ s₂) : s₁ = s₂ :=
  begin
    apply subtype.eq,
    apply stream.eq_of_bisim (λx y, ∃ s s' : seq α, s.1 = x ∧ s'.1 = y ∧ R s s'),
    dsimp [stream.is_bisimulation],
    intros t₁ t₂ e,
    exact match t₁, t₂, e with ._, ._, ⟨s, s', rfl, rfl, r⟩ :=
      suffices head s = head s' ∧ R (tail s) (tail s'), from
      and.imp id (λr, ⟨tail s, tail s',
        by cases s; refl, by cases s'; refl, r⟩) this,
      begin
        have := bisim r, revert r this,
        apply cases_on s _ _; intros; apply cases_on s' _ _; intros; intros r this,
        { constructor, refl, assumption },
        { rw [destruct_nil, destruct_cons] at this,
          exact false.elim this },
        { rw [destruct_nil, destruct_cons] at this,
          exact false.elim this },
        { rw [destruct_cons, destruct_cons] at this,
          rw [head_cons, head_cons, tail_cons, tail_cons],
          cases this with h1 h2,
          constructor, rw h1, exact h2 }
      end
    end,
    exact ⟨s₁, s₂, rfl, rfl, r⟩
  end
end bisim

theorem coinduction : ∀ {s₁ s₂ : seq α}, head s₁ = head s₂ →
  (∀ (β : Type u) (fr : seq α → β),
    fr s₁ = fr s₂ → fr (tail s₁) = fr (tail s₂)) → s₁ = s₂
| ⟨f₁, a₁⟩ ⟨f₂, a₂⟩ hh ht :=
  subtype.eq (stream.coinduction hh (λ β fr, ht β (λs, fr s.1)))

theorem coinduction2 (s) (f g : seq α → seq β)
  (H : ∀ s, bisim_o (λ (s1 s2 : seq β), ∃ (s : seq α), s1 = f s ∧ s2 = g s)
    (destruct (f s)) (destruct (g s)))
  : f s = g s :=
begin
  refine eq_of_bisim (λ s1 s2, ∃ s, s1 = f s ∧ s2 = g s) _ ⟨s, rfl, rfl⟩,
  intros s1 s2 h, rcases h with ⟨s, h1, h2⟩,
  rw [h1, h2], apply H
end

/-- Embed an infinite stream as a sequence -/
def of_stream (s : stream α) : seq α :=
⟨s.map some, λn h, by contradiction⟩

instance coe_stream : has_coe (stream α) (seq α) := ⟨of_stream⟩

/-- Embed a `lazy_list α` as a sequence. Note that even though this
  is non-meta, it will produce infinite sequences if used with
  cyclic `lazy_list`s created by meta constructions. -/
def of_lazy_list : lazy_list α → seq α :=
corec (λl, match l with
  | lazy_list.nil := none
  | lazy_list.cons a l' := some (a, l' ())
  end)

instance coe_lazy_list : has_coe (lazy_list α) (seq α) := ⟨of_lazy_list⟩

/-- Translate a sequence into a `lazy_list`. Since `lazy_list` and `list`
  are isomorphic as non-meta types, this function is necessarily meta. -/
meta def to_lazy_list : seq α → lazy_list α | s :=
match destruct s with
| none := lazy_list.nil
| some (a, s') := lazy_list.cons a (to_lazy_list s')
end

/-- Translate a sequence to a list. This function will run forever if
  run on an infinite sequence. -/
meta def force_to_list (s : seq α) : list α := (to_lazy_list s).to_list

/-- The sequence of natural numbers some 0, some 1, ... -/
def nats : seq ℕ := stream.nats

@[simp]
lemma nats_nth (n : ℕ) : nats.nth n = some n := rfl

/-- Append two sequences. If `s₁` is infinite, then `s₁ ++ s₂ = s₁`,
  otherwise it puts `s₂` at the location of the `nil` in `s₁`. -/
def append (s₁ s₂ : seq α) : seq α :=
@corec α (seq α × seq α) (λ⟨s₁, s₂⟩,
  match destruct s₁ with
  | none := omap (λs₂, (nil, s₂)) (destruct s₂)
  | some (a, s₁') := some (a, s₁', s₂)
  end) (s₁, s₂)

/-- Map a function over a sequence. -/
def map (f : α → β) : seq α → seq β | ⟨s, al⟩ :=
⟨s.map (option.map f),
λn, begin
  dsimp [stream.map, stream.nth],
  induction e : s n; intro,
  { rw al e, assumption }, { contradiction }
end⟩

/-- Flatten a sequence of sequences. (It is required that the
  sequences be nonempty to ensure productivity; in the case
  of an infinite sequence of `nil`, the first element is never
  generated.) -/
def join : seq (seq1 α) → seq α :=
corec (λS, match destruct S with
  | none := none
  | some ((a, s), S') := some (a, match destruct s with
    | none := S'
    | some s' := cons s' S'
    end)
  end)

/-- Remove the first `n` elements from the sequence. -/
def drop (s : seq α) : ℕ → seq α
| 0     := s
| (n+1) := tail (drop n)
attribute [simp] drop

/-- Take the first `n` elements of the sequence (producing a list) -/
def take : ℕ → seq α → list α
| 0     s := []
| (n+1) s := match destruct s with
  | none := []
  | some (x, r) := list.cons x (take n r)
  end

/-- Split a sequence at `n`, producing a finite initial segment
  and an infinite tail. -/
def split_at : ℕ → seq α → list α × seq α
| 0     s := ([], s)
| (n+1) s := match destruct s with
  | none := ([], nil)
  | some (x, s') := let (l, r) := split_at n s' in (list.cons x l, r)
  end

section zip_with

/-- Combine two sequences with a function -/
def zip_with (f : α → β → γ) : seq α → seq β → seq γ
| ⟨f₁, a₁⟩ ⟨f₂, a₂⟩ := ⟨λn,
    match f₁ n, f₂ n with
    | some a, some b := some (f a b)
    | _, _ := none
    end,
  λn, begin
    induction h1 : f₁ n,
    { intro H, simp only [(a₁ h1)], refl },
    induction h2 : f₂ n; dsimp [seq.zip_with._match_1]; intro H,
    { rw (a₂ h2), cases f₁ (n + 1); refl },
    { rw [h1, h2] at H, contradiction }
  end⟩

variables {s : seq α} {s' : seq β} {n : ℕ}

lemma zip_with_nth_some {a : α} {b : β} (s_nth_eq_some : s.nth n = some a)
(s_nth_eq_some' : s'.nth n = some b) (f : α → β → γ) :
  (zip_with f s s').nth n = some (f a b) :=
begin
  cases s with st,
  have : st n = some a, from s_nth_eq_some,
  cases s' with st',
  have : st' n = some b, from s_nth_eq_some',
  simp only [zip_with, seq.nth, *]
end

lemma zip_with_nth_none (s_nth_eq_none : s.nth n = none) (f : α → β → γ) :
  (zip_with f s s').nth n = none :=
begin
  cases s with st,
  have : st n = none, from s_nth_eq_none,
  cases s' with st',
  cases st'_nth_eq : st' n;
  simp only [zip_with, seq.nth, *]
end

lemma zip_with_nth_none' (s'_nth_eq_none : s'.nth n = none) (f : α → β → γ) :
  (zip_with f s s').nth n = none :=
begin
  cases s' with st',
  have : st' n = none, from s'_nth_eq_none,
  cases s with st,
  cases st_nth_eq : st n;
  simp only [zip_with, seq.nth, *]
end

end zip_with

/-- Pair two sequences into a sequence of pairs -/
def zip : seq α → seq β → seq (α × β) := zip_with prod.mk

/-- Separate a sequence of pairs into two sequences -/
def unzip (s : seq (α × β)) : seq α × seq β := (map prod.fst s, map prod.snd s)

/-- Convert a sequence which is known to terminate into a list -/
def to_list (s : seq α) (h : ∃ n, ¬ (nth s n).is_some) : list α :=
take (nat.find h) s

/-- Convert a sequence which is known not to terminate into a stream -/
def to_stream (s : seq α) (h : ∀ n, (nth s n).is_some) : stream α :=
λn, option.get (h n)

/-- Convert a sequence into either a list or a stream depending on whether
  it is finite or infinite. (Without decidability of the infiniteness predicate,
  this is not constructively possible.) -/
def to_list_or_stream (s : seq α) [decidable (∃ n, ¬ (nth s n).is_some)] :
  list α ⊕ stream α :=
if h : ∃ n, ¬ (nth s n).is_some
then sum.inl (to_list s h)
else sum.inr (to_stream s (λn, decidable.by_contradiction (λ hn, h ⟨n, hn⟩)))

@[simp] theorem nil_append (s : seq α) : append nil s = s :=
begin
  apply coinduction2, intro s,
  dsimp [append], rw [corec_eq],
  dsimp [append], apply cases_on s _ _,
  { trivial },
  { intros x s,
    rw [destruct_cons], dsimp,
    exact ⟨rfl, s, rfl, rfl⟩ }
end

@[simp] theorem cons_append (a : α) (s t) : append (cons a s) t = cons a (append s t) :=
destruct_eq_cons $ begin
  dsimp [append], rw [corec_eq],
  dsimp [append], rw [destruct_cons],
  dsimp [append], refl
end

@[simp] theorem append_nil (s : seq α) : append s nil = s :=
begin
  apply coinduction2 s, intro s,
  apply cases_on s _ _,
  { trivial },
  { intros x s,
    rw [cons_append, destruct_cons, destruct_cons], dsimp,
    exact ⟨rfl, s, rfl, rfl⟩ }
end

@[simp] theorem append_assoc (s t u : seq α) :
  append (append s t) u = append s (append t u) :=
begin
  apply eq_of_bisim (λs1 s2, ∃ s t u,
    s1 = append (append s t) u ∧ s2 = append s (append t u)),
  { intros s1 s2 h, exact match s1, s2, h with ._, ._, ⟨s, t, u, rfl, rfl⟩ := begin
      apply cases_on s; simp,
      { apply cases_on t; simp,
        { apply cases_on u; simp,
          { intros x u, refine ⟨nil, nil, u, _, _⟩; simp } },
        { intros x t, refine ⟨nil, t, u, _, _⟩; simp } },
      { intros x s, exact ⟨s, t, u, rfl, rfl⟩ }
    end end },
  { exact ⟨s, t, u, rfl, rfl⟩ }
end

@[simp] theorem map_nil (f : α → β) : map f nil = nil := rfl

@[simp] theorem map_cons (f : α → β) (a) : ∀ s, map f (cons a s) = cons (f a) (map f s)
| ⟨s, al⟩ := by apply subtype.eq; dsimp [cons, map]; rw stream.map_cons; refl

@[simp] theorem map_id : ∀ (s : seq α), map id s = s
| ⟨s, al⟩ := begin
  apply subtype.eq; dsimp [map],
  rw [option.map_id, stream.map_id]; refl
end

@[simp] theorem map_tail (f : α → β) : ∀ s, map f (tail s) = tail (map f s)
| ⟨s, al⟩ := by apply subtype.eq; dsimp [tail, map]; rw stream.map_tail; refl

theorem map_comp (f : α → β) (g : β → γ) : ∀ (s : seq α), map (g ∘ f) s = map g (map f s)
| ⟨s, al⟩ := begin
  apply subtype.eq; dsimp [map],
  rw stream.map_map,
  apply congr_arg (λ f : _ → option γ, stream.map f s),
  ext ⟨⟩; refl
end

@[simp] theorem map_append (f : α → β) (s t) : map f (append s t) = append (map f s) (map f t) :=
begin
  apply eq_of_bisim (λs1 s2, ∃ s t,
    s1 = map f (append s t) ∧ s2 = append (map f s) (map f t)) _ ⟨s, t, rfl, rfl⟩,
  intros s1 s2 h, exact match s1, s2, h with ._, ._, ⟨s, t, rfl, rfl⟩ := begin
    apply cases_on s; simp,
    { apply cases_on t; simp,
      { intros x t, refine ⟨nil, t, _, _⟩; simp } },
    { intros x s, refine ⟨s, t, rfl, rfl⟩ }
  end end
end

@[simp] theorem map_nth (f : α → β) : ∀ s n, nth (map f s) n = (nth s n).map f
| ⟨s, al⟩ n := rfl

instance : functor seq := {map := @map}

instance : is_lawful_functor seq :=
{ id_map := @map_id, comp_map := @map_comp }

@[simp] theorem join_nil : join nil = (nil : seq α) := destruct_eq_nil rfl

@[simp] theorem join_cons_nil (a : α) (S) :
  join (cons (a, nil) S) = cons a (join S) :=
destruct_eq_cons $ by simp [join]

@[simp] theorem join_cons_cons (a b : α) (s S) :
  join (cons (a, cons b s) S) = cons a (join (cons (b, s) S)) :=
destruct_eq_cons $ by simp [join]

@[simp, priority 990] theorem join_cons (a : α) (s S) :
  join (cons (a, s) S) = cons a (append s (join S)) :=
begin
  apply eq_of_bisim (λs1 s2, s1 = s2 ∨
    ∃ a s S, s1 = join (cons (a, s) S) ∧
      s2 = cons a (append s (join S))) _ (or.inr ⟨a, s, S, rfl, rfl⟩),
  intros s1 s2 h,
  exact match s1, s2, h with
  | _, _, (or.inl $ eq.refl s) := begin
      apply cases_on s, { trivial },
      { intros x s, rw [destruct_cons], exact ⟨rfl, or.inl rfl⟩ }
    end
  | ._, ._, (or.inr ⟨a, s, S, rfl, rfl⟩) := begin
      apply cases_on s,
      { simp },
      { intros x s, simp, refine or.inr ⟨x, s, S, rfl, rfl⟩ }
    end
  end
end

@[simp] theorem join_append (S T : seq (seq1 α)) :
  join (append S T) = append (join S) (join T) :=
begin
  apply eq_of_bisim (λs1 s2, ∃ s S T,
    s1 = append s (join (append S T)) ∧
    s2 = append s (append (join S) (join T))),
  { intros s1 s2 h, exact match s1, s2, h with ._, ._, ⟨s, S, T, rfl, rfl⟩ := begin
      apply cases_on s; simp,
      { apply cases_on S; simp,
        { apply cases_on T, { simp },
          { intros s T, cases s with a s; simp,
            refine ⟨s, nil, T, _, _⟩; simp } },
        { intros s S, cases s with a s; simp,
          exact ⟨s, S, T, rfl, rfl⟩ } },
      { intros x s, exact ⟨s, S, T, rfl, rfl⟩ }
    end end },
  { refine ⟨nil, S, T, _, _⟩; simp }
end

@[simp] theorem of_list_nil : of_list [] = (nil : seq α) := rfl

@[simp] theorem of_list_cons (a : α) (l) :
  of_list (a :: l) = cons a (of_list l) :=
begin
  apply subtype.eq, simp [of_list, cons],
  ext ⟨⟩; simp [list.nth, stream.cons]
end

@[simp] theorem of_stream_cons (a : α) (s) :
  of_stream (a :: s) = cons a (of_stream s) :=
by apply subtype.eq; simp [of_stream, cons]; rw stream.map_cons

@[simp] theorem of_list_append (l l' : list α) :
  of_list (l ++ l') = append (of_list l) (of_list l') :=
by induction l; simp [*]

@[simp] theorem of_stream_append (l : list α) (s : stream α) :
  of_stream (l ++ₛ s) = append (of_list l) (of_stream s) :=
by induction l; simp [*, stream.nil_append_stream, stream.cons_append_stream]

/-- Convert a sequence into a list, embedded in a computation to allow for
  the possibility of infinite sequences (in which case the computation
  never returns anything). -/
def to_list' {α} (s : seq α) : computation (list α) :=
@computation.corec (list α) (list α × seq α) (λ⟨l, s⟩,
  match destruct s with
  | none         := sum.inl l.reverse
  | some (a, s') := sum.inr (a::l, s')
  end) ([], s)

theorem dropn_add (s : seq α) (m) : ∀ n, drop s (m + n) = drop (drop s m) n
| 0     := rfl
| (n+1) := congr_arg tail (dropn_add n)

theorem dropn_tail (s : seq α) (n) : drop (tail s) n = drop s (n + 1) :=
by rw add_comm; symmetry; apply dropn_add

theorem nth_tail : ∀ (s : seq α) n, nth (tail s) n = nth s (n + 1)
| ⟨f, al⟩ n := rfl

@[ext]
protected lemma ext (s s': seq α) (hyp : ∀ (n : ℕ), s.nth n = s'.nth n) : s = s' :=
begin
  let ext := (λ (s s' : seq α), ∀ n, s.nth n = s'.nth n),
  apply seq.eq_of_bisim ext _ hyp,
  -- we have to show that ext is a bisimulation
  clear hyp s s',
  assume s s' (hyp : ext s s'),
  unfold seq.destruct,
  rw (hyp 0),
  cases (s'.nth 0),
  { simp [seq.bisim_o] }, -- option.none
  { -- option.some
    suffices : ext s.tail s'.tail, by simpa,
    assume n,
    simp only [seq.nth_tail _ n, (hyp $ n + 1)] }
end

@[simp] theorem head_dropn (s : seq α) (n) : head (drop s n) = nth s n :=
begin
  induction n with n IH generalizing s, { refl },
  rw [nat.succ_eq_add_one, ←nth_tail, ←dropn_tail], apply IH
end

theorem mem_map (f : α → β) {a : α} : ∀ {s : seq α}, a ∈ s → f a ∈ map f s
| ⟨g, al⟩ := stream.mem_map (option.map f)

theorem exists_of_mem_map {f} {b : β} : ∀ {s : seq α}, b ∈ map f s → ∃ a, a ∈ s ∧ f a = b
| ⟨g, al⟩ h := let ⟨o, om, oe⟩ := stream.exists_of_mem_map h in
  by cases o with a; injection oe with h'; exact ⟨a, om, h'⟩

theorem of_mem_append {s₁ s₂ : seq α} {a : α} (h : a ∈ append s₁ s₂) : a ∈ s₁ ∨ a ∈ s₂ :=
begin
  have := h, revert this,
  generalize e : append s₁ s₂ = ss, intro h, revert s₁,
  apply mem_rec_on h _,
  intros b s' o s₁,
  apply s₁.cases_on _ (λ c t₁, _); intros m e;
  have := congr_arg destruct e,
  { apply or.inr, simpa using m },
  { cases (show a = c ∨ a ∈ append t₁ s₂, by simpa using m) with e' m,
    { rw e', exact or.inl (mem_cons _ _) },
    { cases (show c = b ∧ append t₁ s₂ = s', by simpa) with i1 i2,
      cases o with e' IH,
      { simp [i1, e'] },
      { exact or.imp_left (mem_cons_of_mem _) (IH m i2) } } }
end

theorem mem_append_left {s₁ s₂ : seq α} {a : α} (h : a ∈ s₁) : a ∈ append s₁ s₂ :=
by apply mem_rec_on h; intros; simp [*]

end seq

namespace seq1
variables {α : Type u} {β : Type v} {γ : Type w}
open seq

/-- Convert a `seq1` to a sequence. -/
def to_seq : seq1 α → seq α
| (a, s) := cons a s

instance coe_seq : has_coe (seq1 α) (seq α) := ⟨to_seq⟩

/-- Map a function on a `seq1` -/
def map (f : α → β) : seq1 α → seq1 β
| (a, s) := (f a, seq.map f s)

theorem map_id : ∀ (s : seq1 α), map id s = s | ⟨a, s⟩ := by simp [map]

/-- Flatten a nonempty sequence of nonempty sequences -/
def join : seq1 (seq1 α) → seq1 α
| ((a, s), S) := match destruct s with
  | none := (a, seq.join S)
  | some s' := (a, seq.join (cons s' S))
  end

@[simp] theorem join_nil (a : α) (S) : join ((a, nil), S) = (a, seq.join S) := rfl

@[simp] theorem join_cons (a b : α) (s S) :
  join ((a, cons b s), S) = (a, seq.join (cons (b, s) S)) :=
by dsimp [join]; rw [destruct_cons]; refl

/-- The `return` operator for the `seq1` monad,
  which produces a singleton sequence. -/
def ret (a : α) : seq1 α := (a, nil)

instance [inhabited α] : inhabited (seq1 α) := ⟨ret (default _)⟩

/-- The `bind` operator for the `seq1` monad,
  which maps `f` on each element of `s` and appends the results together.
  (Not all of `s` may be evaluated, because the first few elements of `s`
  may already produce an infinite result.) -/
def bind (s : seq1 α) (f : α → seq1 β) : seq1 β :=
join (map f s)

@[simp] theorem join_map_ret (s : seq α) : seq.join (seq.map ret s) = s :=
by apply coinduction2 s; intro s; apply cases_on s; simp [ret]

@[simp] theorem bind_ret (f : α → β) : ∀ s, bind s (ret ∘ f) = map f s
| ⟨a, s⟩ := begin
  dsimp [bind, map], change (λx, ret (f x)) with (ret ∘ f),
  rw [map_comp], simp [function.comp, ret]
end

@[simp] theorem ret_bind (a : α) (f : α → seq1 β) : bind (ret a) f = f a :=
begin
  simp [ret, bind, map],
  cases f a with a s,
  apply cases_on s; intros; simp
end

@[simp] theorem map_join' (f : α → β) (S) :
  seq.map f (seq.join S) = seq.join (seq.map (map f) S) :=
begin
  apply eq_of_bisim (λs1 s2,
    ∃ s S, s1 = append s (seq.map f (seq.join S)) ∧
      s2 = append s (seq.join (seq.map (map f) S))),
  { intros s1 s2 h, exact match s1, s2, h with ._, ._, ⟨s, S, rfl, rfl⟩ := begin
      apply cases_on s; simp,
      { apply cases_on S; simp,
        { intros x S, cases x with a s; simp [map],
          exact ⟨_, _, rfl, rfl⟩ } },
      { intros x s, refine ⟨s, S, rfl, rfl⟩ }
    end end },
  { refine ⟨nil, S, _, _⟩; simp }
end

@[simp] theorem map_join (f : α → β) : ∀ S, map f (join S) = join (map (map f) S)
| ((a, s), S) := by apply cases_on s; intros; simp [map]

@[simp] theorem join_join (SS : seq (seq1 (seq1 α))) :
  seq.join (seq.join SS) = seq.join (seq.map join SS) :=
begin
  apply eq_of_bisim (λs1 s2,
    ∃ s SS, s1 = seq.append s (seq.join (seq.join SS)) ∧
      s2 = seq.append s (seq.join (seq.map join SS))),
  { intros s1 s2 h, exact match s1, s2, h with ._, ._, ⟨s, SS, rfl, rfl⟩ := begin
      apply cases_on s; simp,
      { apply cases_on SS; simp,
        { intros S SS, cases S with s S; cases s with x s; simp [map],
          apply cases_on s; simp,
          { exact ⟨_, _, rfl, rfl⟩ },
          { intros x s,
            refine ⟨cons x (append s (seq.join S)), SS, _, _⟩; simp } } },
      { intros x s, exact ⟨s, SS, rfl, rfl⟩ }
    end end },
  { refine ⟨nil, SS, _, _⟩; simp }
end

@[simp] theorem bind_assoc (s : seq1 α) (f : α → seq1 β) (g : β → seq1 γ) :
  bind (bind s f) g = bind s (λ (x : α), bind (f x) g) :=
begin
  cases s with a s,
  simp [bind, map],
  rw [←map_comp],
  change (λ x, join (map g (f x))) with (join ∘ ((map g) ∘ f)),
  rw [map_comp _ join],
  generalize : seq.map (map g ∘ f) s = SS,
  rcases map g (f a) with ⟨⟨a, s⟩, S⟩,
  apply cases_on s; intros; apply cases_on S; intros; simp,
  { cases x with x t, apply cases_on t; intros; simp },
  { cases x_1 with y t; simp }
end

instance : monad seq1 :=
{ map  := @map,
  pure := @ret,
  bind := @bind }

instance : is_lawful_monad seq1 :=
{ id_map := @map_id,
  bind_pure_comp_eq_map := @bind_ret,
  pure_bind := @ret_bind,
  bind_assoc := @bind_assoc }

end seq1


/-
Copyright (c) 2016 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura

! This file was ported from Lean 3 source module init.data.ordering.basic
! leanprover-community/mathlib commit 6e4ef51f2662e5aa53d8981e1dabf02d1785f220
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
prelude
import Leanbin.Init.Data.Repr
import Leanbin.Init.Data.Prod
import Leanbin.Init.Data.Sum.Basic

universe u v

#print Ordering /-
inductive Ordering
  | lt
  | Eq
  | GT.gt
#align ordering Ordering
-/

instance : Repr Ordering :=
  ⟨fun s =>
    match s with
    | Ordering.lt => "lt"
    | Ordering.eq => "eq"
    | Ordering.gt => "gt"⟩

namespace Ordering

#print Ordering.swap /-
def swap : Ordering → Ordering
  | lt => gt
  | Eq => eq
  | GT.gt => lt
#align ordering.swap Ordering.swap
-/

#print Ordering.orElse /-
@[inline]
def orElse : Ordering → Ordering → Ordering
  | lt, _ => lt
  | Eq, o => o
  | GT.gt, _ => gt
#align ordering.or_else Ordering.orElse
-/

#print Ordering.swap_swap /-
theorem swap_swap : ∀ o : Ordering, o.symm.symm = o
  | lt => rfl
  | Eq => rfl
  | GT.gt => rfl
#align ordering.swap_swap Ordering.swap_swap
-/

end Ordering

#print cmpUsing /-
def cmpUsing {α : Type u} (lt : α → α → Prop) [DecidableRel lt] (a b : α) : Ordering :=
  if lt a b then Ordering.lt else if lt b a then Ordering.gt else Ordering.eq
#align cmp_using cmpUsing
-/

#print cmp /-
def cmp {α : Type u} [LT α] [DecidableRel ((· < ·) : α → α → Prop)] (a b : α) : Ordering :=
  cmpUsing (· < ·) a b
#align cmp cmp
-/

instance : DecidableEq Ordering := fun a b =>
  match a with
  | Ordering.lt =>
    match b with
    | Ordering.lt => isTrue rfl
    | Ordering.eq => isFalse fun h => Ordering.noConfusion h
    | Ordering.gt => isFalse fun h => Ordering.noConfusion h
  | Ordering.eq =>
    match b with
    | Ordering.lt => isFalse fun h => Ordering.noConfusion h
    | Ordering.eq => isTrue rfl
    | Ordering.gt => isFalse fun h => Ordering.noConfusion h
  | Ordering.gt =>
    match b with
    | Ordering.lt => isFalse fun h => Ordering.noConfusion h
    | Ordering.eq => isFalse fun h => Ordering.noConfusion h
    | Ordering.gt => isTrue rfl


/-
Copyright (c) 2022 Riccardo Brasca. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Riccardo Brasca
-/
import algebra.gcd_monoid.finset
import algebra.gcd_monoid.basic
import ring_theory.int.basic
import ring_theory.polynomial.content

/-!
# Basic results about setwise gcds on normalized gcd monoid with a division.

## Main results

* `finset.nat.gcd_div_eq_one`: given a nonempty finset `s` and a function `f` from `s` to
  `ℕ`, if `d = s.gcd`, then the `gcd` of `(f i) / d` equals `1`.
* `finset.int.gcd_div_eq_one`: given a nonempty finset `s` and a function `f` from `s` to
  `ℤ`, if `d = s.gcd`, then the `gcd` of `(f i) / d` equals `1`.
* `finset.polynomial.gcd_div_eq_one`: given a nonempty finset `s` and a function `f` from
  `s` to `K[X]`, if `d = s.gcd`, then the `gcd` of `(f i) / d` equals `1`.

## TODO
Add a typeclass to state these results uniformly.

-/

namespace finset

namespace nat

/-- Given a nonempty finset `s` and a function `f` from `s` to `ℕ`, if `d = s.gcd`,
then the `gcd` of `(f i) / d` is equal to `1`. -/
theorem gcd_div_eq_one {β : Type*} {f : β → ℕ} (s : finset β) {x : β} (hx : x ∈ s)
  (hfz : f x ≠ 0) : s.gcd (λ b, f b / s.gcd f) = 1 :=
begin
  obtain ⟨g, he, hg⟩ := finset.extract_gcd f ⟨x, hx⟩,
  refine (finset.gcd_congr rfl $ λ a ha, _).trans hg,
  rw [he a ha, nat.mul_div_cancel_left],
  exact nat.pos_of_ne_zero (mt finset.gcd_eq_zero_iff.1 (λ h, hfz $ h x hx)),
end

theorem gcd_div_id_eq_one {s : finset ℕ} {x : ℕ} (hx : x ∈ s) (hnz : x ≠ 0) :
  s.gcd (λ b, b / s.gcd id) = 1 :=
gcd_div_eq_one s hx hnz

end nat

namespace int

/-- Given a nonempty finset `s` and a function `f` from `s` to `ℤ`, if `d = s.gcd`,
then the `gcd` of `(f i) / d` is equal to `1`. -/
theorem gcd_div_eq_one {β : Type*} {f : β → ℤ} (s : finset β) {x : β} (hx : x ∈ s)
  (hfz : f x ≠ 0) : s.gcd (λ b, f b / s.gcd f) = 1 :=
begin
  obtain ⟨g, he, hg⟩ := finset.extract_gcd f ⟨x, hx⟩,
  refine (finset.gcd_congr rfl $ λ a ha, _).trans hg,
  rw [he a ha, int.mul_div_cancel_left],
  exact mt finset.gcd_eq_zero_iff.1 (λ h, hfz $ h x hx),
end

theorem gcd_div_id_eq_one {s : finset ℤ} {x : ℤ} (hx : x ∈ s) (hnz : x ≠ 0) :
  s.gcd (λ b, b / s.gcd id) = 1 :=
gcd_div_eq_one s hx hnz

end int

namespace polynomial

open_locale polynomial classical

noncomputable theory

variables {K : Type*} [field K]

/-- Given a nonempty finset `s` and a function `f` from `s` to `K[X]`, if `d = s.gcd f`,
then the `gcd` of `(f i) / d` is equal to `1`. -/
theorem gcd_div_eq_one {β : Type*} {f : β → K[X]} (s : finset β) {x : β} (hx : x ∈ s)
  (hfz : f x ≠ 0) : s.gcd (λ b, f b / s.gcd f) = 1 :=
begin
  obtain ⟨g, he, hg⟩ := finset.extract_gcd f ⟨x, hx⟩,
  refine (finset.gcd_congr rfl $ λ a ha, _).trans hg,
  rw [he a ha, euclidean_domain.mul_div_cancel_left],
  exact mt finset.gcd_eq_zero_iff.1 (λ h, hfz $ h x hx),
end

theorem gcd_div_id_eq_one {s : finset K[X]} {x : K[X]} (hx : x ∈ s) (hnz : x ≠ 0) :
  s.gcd (λ b, b / s.gcd id) = 1 :=
gcd_div_eq_one s hx hnz

end polynomial

end finset


/-
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 algebra.module.pi
import ring_theory.power_series.basic
import data.finsupp.pwo

/-!
# 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 : polynomial R` 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
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

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_scalar 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_scalar 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, not_not, mem_sdiff, mem_add_antidiagonal,
      ne.def, set.mem_set_of_eq, mem_support] at hb,
  rw [(hb.2 hb.1.1 hb.1.2.1), 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, not_not, mem_sdiff, mem_add_antidiagonal,
      ne.def, set.mem_set_of_eq, mem_support] at hb,
  rw [not_not.1 (λ con, hb.1.2.2 (hb.2 hb.1.1 con)), 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_eq, 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_eq, 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 h1 rfl h2,
    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 ⟨h1, rfl, h2⟩,
      rw add_comm at h1,
      refine ⟨rfl, add_right_cancel h1⟩ },
    { rintro ⟨rfl, rfl⟩,
      refine ⟨add_comm _ _, _⟩,
      simp [hx] } },
  { 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 h1 h2 rfl,
    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 ⟨h1, h2, rfl⟩,
      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 [true_and, 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 ⟨⟨rfl, ⟨H3, nz⟩⟩, ⟨rfl, nx, ny⟩⟩ := H1,
    refine ⟨⟨(add_assoc _ _ _).symm, nx, set.add_mem_add ny nz⟩, 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],
    exact add_right_cancel (H1.1.1.trans H3.1.1.symm) },
  { 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 ⟨⟨rfl, nx, H⟩, rfl, ny, nz⟩ := H1,
    exact ⟨i + k, l, i, k, ⟨⟨add_assoc _ _ _, set.add_mem_add nx ny, nz⟩, rfl, nx, ny⟩,
      λ 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 _) },
  .. 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 [comm_semiring R] : comm_semiring (hahn_series Γ R) :=
{ mul_comm := λ x y, begin
    ext,
    simp_rw [mul_coeff, mul_comm],
    refine sum_bij (λ a ha, ⟨a.2, a.1⟩) _ (λ a ha, by simp) _ _,
    { intros a ha,
      simp only [mem_add_antidiagonal, ne.def, set.mem_set_of_eq] at ha ⊢,
      obtain ⟨h1, h2, h3⟩ := ha,
      refine ⟨_, h3, h2⟩,
      rw [add_comm, h1], },
    { rintros ⟨a1, a2⟩ ⟨b1, b2⟩ ha hb hab,
      rw prod.ext_iff at *,
      refine ⟨hab.2, hab.1⟩, },
    { intros a ha,
      refine ⟨a.swap, _, by simp⟩,
      simp only [prod.fst_swap, mem_add_antidiagonal, prod.snd_swap,
        ne.def, set.mem_set_of_eq] at ha ⊢,
      exact ⟨(add_comm _ _).trans ha.1, ha.2.2, ha.2.1⟩ }
  end,
  .. hahn_series.semiring }

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

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) :=
{ .. hahn_series.no_zero_divisors,
  .. hahn_series.nontrivial,
  .. hahn_series.ring }

@[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],
    rintros ⟨y1, y2⟩ hy,
    obtain ⟨rfl, hy1, hy2⟩ := mem_add_antidiagonal.1 hy,
    rw [eq_of_mem_support_single hy1, eq_of_mem_support_single hy2] 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, ne.def, function.embedding.coe_prod_map, mem_support,
        prod.exists] at hij,
      obtain ⟨i, j, ⟨rfl, hx, hy⟩, 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, ne.def, function.embedding.coe_prod_map, mem_support,
        prod.exists],
      simp only [mem_add_antidiagonal, emb_domain_coeff, ne.def, mem_support, ← hf] at h1,
      exact ⟨i, j, ⟨f.injective h1.1, h1.2⟩, 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, and.congr_left_iff, mem_add_antidiagonal, ne.def,
      and_iff_left_iff_imp, mem_filter, mem_support],
    intros h1 h2,
    contrapose h1,
    rw ← decidable.or_iff_not_and_not at h1,
    cases h1; simp [h1]
  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) [ordered_semiring Γ] [nontrivial Γ]
/-- Casts a power series as a Hahn series with coefficients from an `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,
  { rw 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,
  { 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, ne.def, and_iff_left_iff_imp, mem_filter,
      mem_support, finsupp.mem_antidiagonal],
    intros h1 h2,
    contrapose h1,
    rw ← decidable.or_iff_not_and_not at h1,
    cases h1; simp [h1],
  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) [ordered_semiring Γ] [nontrivial Γ]
/-- Casting a power series as a Hahn series with coefficients from an `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 : polynomial R) :
  algebra_map (polynomial R) (hahn_series Γ R) f = of_power_series Γ R f := rfl

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

end algebra

section valuation

variables [linear_ordered_add_comm_group Γ] [ring R] [is_domain R]

instance : linear_ordered_comm_group (multiplicative Γ) :=
{ .. (infer_instance : linear_order (multiplicative Γ)),
  .. (infer_instance : ordered_comm_group (multiplicative Γ)) }

instance : linear_ordered_comm_group_with_zero (with_zero (multiplicative Γ)) :=
{ zero_le_one := with_zero.zero_le 1,
  .. (with_zero.ordered_comm_monoid),
  .. (infer_instance : linear_order (with_zero (multiplicative Γ))),
  .. (infer_instance : comm_group_with_zero (with_zero (multiplicative Γ))) }

variables (Γ) (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_add_comm_group Γ] [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_scalar (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, ne.def, mem_support, is_pwo_support, prod.exists],
        refine ⟨i, j, mem_coe.2 (mem_add_antidiagonal.2 ⟨rfl, hi, set.mem_Union.2 ⟨a, hj⟩⟩), 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, hU.2.1, con⟩), 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, hU.2.1, con⟩), 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_sup (λ a, (f a).support) (λ a ha, (f a).is_pwo_support)).mono,
      intros g hg,
      obtain ⟨a, ha⟩ := set.mem_Union.1 hg,
      have haf : a ∈ f.support,
      { rw finsupp.mem_support_iff,
        contrapose! ha,
        rw [ha, support_zero],
        exact set.not_mem_empty _ },
      have h : (λ i, (f i).support) a ≤ _ := le_sup haf,
      exact h ha,
    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_add_comm_group Γ] [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.2 },
    { obtain ⟨rfl, hi, hj⟩ := 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))) _, },
    { intros n hn,
      cases n,
      { 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 [true_and, 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