/-
Copyright (c) 2022 David Kurniadi Angdinata. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: David Kurniadi Angdinata
-/

import data.polynomial.splits

/-!
# Cubics and discriminants

This file defines cubic polynomials over a semiring and their discriminants over a splitting field.

## Main definitions

 * `cubic`: the structure representing a cubic polynomial.
 * `cubic.disc`: the discriminant of a cubic polynomial.

## Main statements

 * `cubic.disc_ne_zero_iff_roots_nodup`: the cubic discriminant is not equal to zero if and only if
    the cubic has no duplicate roots.

## References

 * https://en.wikipedia.org/wiki/Cubic_equation
 * https://en.wikipedia.org/wiki/Discriminant

## Tags

cubic, discriminant, polynomial, root
-/

noncomputable theory

/-- The structure representing a cubic polynomial. -/
@[ext] structure cubic (R : Type*) := (a b c d : R)

namespace cubic

open cubic polynomial

open_locale polynomial

variables {R S F K : Type*}

instance [inhabited R] : inhabited (cubic R) := ⟨⟨default, default, default, default⟩⟩

instance [has_zero R] : has_zero (cubic R) := ⟨⟨0, 0, 0, 0⟩⟩

section basic

variables {P Q : cubic R} {a b c d a' b' c' d' : R} [semiring R]

/-- Convert a cubic polynomial to a polynomial. -/
def to_poly (P : cubic R) : R[X] := C P.a * X ^ 3 + C P.b * X ^ 2 + C P.c * X + C P.d

theorem C_mul_prod_X_sub_C_eq [comm_ring S] {w x y z : S} :
  C w * (X - C x) * (X - C y) * (X - C z)
    = to_poly ⟨w, w * -(x + y + z), w * (x * y + x * z + y * z), w * -(x * y * z)⟩ :=
by { simp only [to_poly, C_neg, C_add, C_mul], ring1 }

theorem prod_X_sub_C_eq [comm_ring S] {x y z : S} :
  (X - C x) * (X - C y) * (X - C z)
    = to_poly ⟨1, -(x + y + z), (x * y + x * z + y * z), -(x * y * z)⟩ :=
by rw [← one_mul $ X - C x, ← C_1, C_mul_prod_X_sub_C_eq, one_mul, one_mul, one_mul]

/-! ### Coefficients -/

section coeff

private lemma coeffs :
  (∀ n > 3, P.to_poly.coeff n = 0) ∧ P.to_poly.coeff 3 = P.a ∧ P.to_poly.coeff 2 = P.b
    ∧ P.to_poly.coeff 1 = P.c ∧ P.to_poly.coeff 0 = P.d :=
begin
  simp only [to_poly, coeff_add, coeff_C, coeff_C_mul_X, coeff_C_mul_X_pow],
  norm_num,
  intros n hn,
  repeat { rw [if_neg] },
  any_goals { linarith only [hn] },
  repeat { rw [zero_add] }
end

@[simp] lemma coeff_eq_zero {n : ℕ} (hn : 3 < n) : P.to_poly.coeff n = 0 := coeffs.1 n hn

@[simp] lemma coeff_eq_a : P.to_poly.coeff 3 = P.a := coeffs.2.1

@[simp] lemma coeff_eq_b : P.to_poly.coeff 2 = P.b := coeffs.2.2.1

@[simp] lemma coeff_eq_c : P.to_poly.coeff 1 = P.c := coeffs.2.2.2.1

@[simp] lemma coeff_eq_d : P.to_poly.coeff 0 = P.d := coeffs.2.2.2.2

lemma a_of_eq (h : P.to_poly = Q.to_poly) : P.a = Q.a := by rw [← coeff_eq_a, h, coeff_eq_a]

lemma b_of_eq (h : P.to_poly = Q.to_poly) : P.b = Q.b := by rw [← coeff_eq_b, h, coeff_eq_b]

lemma c_of_eq (h : P.to_poly = Q.to_poly) : P.c = Q.c := by rw [← coeff_eq_c, h, coeff_eq_c]

lemma d_of_eq (h : P.to_poly = Q.to_poly) : P.d = Q.d := by rw [← coeff_eq_d, h, coeff_eq_d]

lemma to_poly_injective (P Q : cubic R) : P.to_poly = Q.to_poly ↔ P = Q :=
⟨λ h, ext P Q (a_of_eq h) (b_of_eq h) (c_of_eq h) (d_of_eq h), congr_arg to_poly⟩

lemma of_a_eq_zero (ha : P.a = 0) : P.to_poly = C P.b * X ^ 2 + C P.c * X + C P.d :=
by rw [to_poly, ha, C_0, zero_mul, zero_add]

lemma of_a_eq_zero' : to_poly ⟨0, b, c, d⟩ = C b * X ^ 2 + C c * X + C d := of_a_eq_zero rfl

lemma of_b_eq_zero (ha : P.a = 0) (hb : P.b = 0) : P.to_poly = C P.c * X + C P.d :=
by rw [of_a_eq_zero ha, hb, C_0, zero_mul, zero_add]

lemma of_b_eq_zero' : to_poly ⟨0, 0, c, d⟩ = C c * X + C d := of_b_eq_zero rfl rfl

lemma of_c_eq_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c = 0) : P.to_poly = C P.d :=
by rw [of_b_eq_zero ha hb, hc, C_0, zero_mul, zero_add]

lemma of_c_eq_zero' : to_poly ⟨0, 0, 0, d⟩ = C d := of_c_eq_zero rfl rfl rfl

lemma of_d_eq_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c = 0) (hd : P.d = 0) :
  P.to_poly = 0 :=
by rw [of_c_eq_zero ha hb hc, hd, C_0]

lemma of_d_eq_zero' : (⟨0, 0, 0, 0⟩ : cubic R).to_poly = 0 := of_d_eq_zero rfl rfl rfl rfl

lemma zero : (0 : cubic R).to_poly = 0 := of_d_eq_zero'

lemma to_poly_eq_zero_iff (P : cubic R) : P.to_poly = 0 ↔ P = 0 :=
by rw [← zero, to_poly_injective]

private lemma ne_zero (h0 : P.a ≠ 0 ∨ P.b ≠ 0 ∨ P.c ≠ 0 ∨ P.d ≠ 0) : P.to_poly ≠ 0 :=
by { contrapose! h0, rw [(to_poly_eq_zero_iff P).mp h0], exact ⟨rfl, rfl, rfl, rfl⟩ }

lemma ne_zero_of_a_ne_zero (ha : P.a ≠ 0) : P.to_poly ≠ 0 := (or_imp_distrib.mp ne_zero).1 ha

lemma ne_zero_of_b_ne_zero (hb : P.b ≠ 0) : P.to_poly ≠ 0 :=
(or_imp_distrib.mp (or_imp_distrib.mp ne_zero).2).1 hb

lemma ne_zero_of_c_ne_zero (hc : P.c ≠ 0) : P.to_poly ≠ 0 :=
(or_imp_distrib.mp (or_imp_distrib.mp (or_imp_distrib.mp ne_zero).2).2).1 hc

lemma ne_zero_of_d_ne_zero (hd : P.d ≠ 0) : P.to_poly ≠ 0 :=
(or_imp_distrib.mp (or_imp_distrib.mp (or_imp_distrib.mp ne_zero).2).2).2 hd

@[simp] lemma leading_coeff_of_a_ne_zero (ha : P.a ≠ 0) : P.to_poly.leading_coeff = P.a :=
leading_coeff_cubic ha

@[simp] lemma leading_coeff_of_a_ne_zero' (ha : a ≠ 0) : (to_poly ⟨a, b, c, d⟩).leading_coeff = a :=
leading_coeff_of_a_ne_zero ha

@[simp] lemma leading_coeff_of_b_ne_zero (ha : P.a = 0) (hb : P.b ≠ 0) :
  P.to_poly.leading_coeff = P.b :=
by rw [of_a_eq_zero ha, leading_coeff_quadratic hb]

@[simp] lemma leading_coeff_of_b_ne_zero' (hb : b ≠ 0) : (to_poly ⟨0, b, c, d⟩).leading_coeff = b :=
leading_coeff_of_b_ne_zero rfl hb

@[simp] lemma leading_coeff_of_c_ne_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c ≠ 0) :
  P.to_poly.leading_coeff = P.c :=
by rw [of_b_eq_zero ha hb, leading_coeff_linear hc]

@[simp] lemma leading_coeff_of_c_ne_zero' (hc : c ≠ 0) : (to_poly ⟨0, 0, c, d⟩).leading_coeff = c :=
leading_coeff_of_c_ne_zero rfl rfl hc

@[simp] lemma leading_coeff_of_c_eq_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c = 0) :
  P.to_poly.leading_coeff = P.d :=
by rw [of_c_eq_zero ha hb hc, leading_coeff_C]

@[simp] lemma leading_coeff_of_c_eq_zero' : (to_poly ⟨0, 0, 0, d⟩).leading_coeff = d :=
leading_coeff_of_c_eq_zero rfl rfl rfl

lemma monic_of_a_eq_one (ha : P.a = 1) : P.to_poly.monic :=
begin
  nontriviality,
  rw [monic, leading_coeff_of_a_ne_zero $ by { rw [ha], exact one_ne_zero }, ha]
end

lemma monic_of_a_eq_one' : (to_poly ⟨1, b, c, d⟩).monic := monic_of_a_eq_one rfl

lemma monic_of_b_eq_one' : (to_poly ⟨0, 1, c, d⟩).monic := monic_of_b_eq_one rfl rfl

lemma monic_of_c_eq_one (ha : P.a = 0) (hb : P.b = 0) (hc : P.c = 1) : P.to_poly.monic :=
begin
  nontriviality,
  rw [monic, leading_coeff_of_c_ne_zero ha hb $ by { rw [hc], exact one_ne_zero }, hc]
end

lemma monic_of_c_eq_one' : (to_poly ⟨0, 0, 1, d⟩).monic := monic_of_c_eq_one rfl rfl rfl

lemma monic_of_d_eq_one (ha : P.a = 0) (hb : P.b = 0) (hc : P.c = 0) (hd : P.d = 1) :
  P.to_poly.monic :=
by rw [monic, leading_coeff_of_c_eq_zero ha hb hc, hd]

lemma monic_of_d_eq_one' : (to_poly ⟨0, 0, 0, 1⟩).monic := monic_of_d_eq_one rfl rfl rfl rfl

end coeff

/-! ### Degrees -/

section degree

/-- The equivalence between cubic polynomials and polynomials of degree at most three. -/
@[simps] def equiv : cubic R ≃ {p : R[X] // p.degree ≤ 3} :=
{ to_fun    := λ P, ⟨P.to_poly, degree_cubic_le⟩,
  inv_fun   := λ f, ⟨coeff f 3, coeff f 2, coeff f 1, coeff f 0⟩,
  left_inv  := λ P, by ext; simp only [subtype.coe_mk, coeffs],
  right_inv := λ f,
  begin
    ext (_ | _ | _ | _ | n); simp only [subtype.coe_mk, coeffs],
    have h3 : 3 < n + 4 := by linarith only,
    rw [coeff_eq_zero h3,
        (degree_le_iff_coeff_zero (f : R[X]) 3).mp f.2 _ $ with_bot.coe_lt_coe.mpr h3]
  end }

@[simp] lemma degree_of_a_ne_zero (ha : P.a ≠ 0) : P.to_poly.degree = 3 := degree_cubic ha

@[simp] lemma degree_of_a_ne_zero' (ha : a ≠ 0) : (to_poly ⟨a, b, c, d⟩).degree = 3 :=
degree_of_a_ne_zero ha

lemma degree_of_a_eq_zero (ha : P.a = 0) : P.to_poly.degree ≤ 2 :=
by simpa only [of_a_eq_zero ha] using degree_quadratic_le

lemma degree_of_a_eq_zero' : (to_poly ⟨0, b, c, d⟩).degree ≤ 2 := degree_of_a_eq_zero rfl

@[simp] lemma degree_of_b_ne_zero (ha : P.a = 0) (hb : P.b ≠ 0) : P.to_poly.degree = 2 :=
by rw [of_a_eq_zero ha, degree_quadratic hb]

@[simp] lemma degree_of_b_ne_zero' (hb : b ≠ 0) : (to_poly ⟨0, b, c, d⟩).degree = 2 :=
degree_of_b_ne_zero rfl hb

lemma degree_of_b_eq_zero (ha : P.a = 0) (hb : P.b = 0) : P.to_poly.degree ≤ 1 :=
by simpa only [of_b_eq_zero ha hb] using degree_linear_le

lemma degree_of_b_eq_zero' : (to_poly ⟨0, 0, c, d⟩).degree ≤ 1 := degree_of_b_eq_zero rfl rfl

@[simp] lemma degree_of_c_ne_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c ≠ 0) :
  P.to_poly.degree = 1 :=
by rw [of_b_eq_zero ha hb, degree_linear hc]

@[simp] lemma degree_of_c_ne_zero' (hc : c ≠ 0) : (to_poly ⟨0, 0, c, d⟩).degree = 1 :=
degree_of_c_ne_zero rfl rfl hc

lemma degree_of_c_eq_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c = 0) : P.to_poly.degree ≤ 0 :=
by simpa only [of_c_eq_zero ha hb hc] using degree_C_le

lemma degree_of_c_eq_zero' : (to_poly ⟨0, 0, 0, d⟩).degree ≤ 0 := degree_of_c_eq_zero rfl rfl rfl

@[simp] lemma degree_of_d_ne_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c = 0) (hd : P.d ≠ 0) :
  P.to_poly.degree = 0 :=
by rw [of_c_eq_zero ha hb hc, degree_C hd]

@[simp] lemma degree_of_d_ne_zero' (hd : d ≠ 0) : (to_poly ⟨0, 0, 0, d⟩).degree = 0 :=
degree_of_d_ne_zero rfl rfl rfl hd

@[simp] lemma degree_of_d_eq_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c = 0) (hd : P.d = 0) :
  P.to_poly.degree = ⊥ :=
by rw [of_d_eq_zero ha hb hc hd, degree_zero]

@[simp] lemma degree_of_d_eq_zero' : (⟨0, 0, 0, 0⟩ : cubic R).to_poly.degree = ⊥ :=
degree_of_d_eq_zero rfl rfl rfl rfl

@[simp] lemma degree_of_zero : (0 : cubic R).to_poly.degree = ⊥ := degree_of_d_eq_zero'

@[simp] lemma nat_degree_of_a_ne_zero (ha : P.a ≠ 0) : P.to_poly.nat_degree = 3 :=
nat_degree_cubic ha

@[simp] lemma nat_degree_of_a_ne_zero' (ha : a ≠ 0) : (to_poly ⟨a, b, c, d⟩).nat_degree = 3 :=
nat_degree_of_a_ne_zero ha

lemma nat_degree_of_a_eq_zero (ha : P.a = 0) : P.to_poly.nat_degree ≤ 2 :=
by simpa only [of_a_eq_zero ha] using nat_degree_quadratic_le

lemma nat_degree_of_a_eq_zero' : (to_poly ⟨0, b, c, d⟩).nat_degree ≤ 2 :=
nat_degree_of_a_eq_zero rfl

@[simp] lemma nat_degree_of_b_ne_zero (ha : P.a = 0) (hb : P.b ≠ 0) : P.to_poly.nat_degree = 2 :=
by rw [of_a_eq_zero ha, nat_degree_quadratic hb]

@[simp] lemma nat_degree_of_b_ne_zero' (hb : b ≠ 0) : (to_poly ⟨0, b, c, d⟩).nat_degree = 2 :=
nat_degree_of_b_ne_zero rfl hb

lemma nat_degree_of_b_eq_zero (ha : P.a = 0) (hb : P.b = 0) : P.to_poly.nat_degree ≤ 1 :=
by simpa only [of_b_eq_zero ha hb] using nat_degree_linear_le

lemma nat_degree_of_b_eq_zero' : (to_poly ⟨0, 0, c, d⟩).nat_degree ≤ 1 :=
nat_degree_of_b_eq_zero rfl rfl

@[simp] lemma nat_degree_of_c_ne_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c ≠ 0) :
  P.to_poly.nat_degree = 1 :=
by rw [of_b_eq_zero ha hb, nat_degree_linear hc]

@[simp] lemma nat_degree_of_c_ne_zero' (hc : c ≠ 0) : (to_poly ⟨0, 0, c, d⟩).nat_degree = 1 :=
nat_degree_of_c_ne_zero rfl rfl hc

@[simp] lemma nat_degree_of_c_eq_zero (ha : P.a = 0) (hb : P.b = 0) (hc : P.c = 0) :
  P.to_poly.nat_degree = 0 :=
by rw [of_c_eq_zero ha hb hc, nat_degree_C]

@[simp] lemma nat_degree_of_c_eq_zero' : (to_poly ⟨0, 0, 0, d⟩).nat_degree = 0 :=
nat_degree_of_c_eq_zero rfl rfl rfl

@[simp] lemma nat_degree_of_zero : (0 : cubic R).to_poly.nat_degree = 0 := nat_degree_of_c_eq_zero'

end degree

/-! ### Map across a homomorphism -/

section map

variables [semiring S] {φ : R →+* S}

/-- Map a cubic polynomial across a semiring homomorphism. -/
def map (φ : R →+* S) (P : cubic R) : cubic S := ⟨φ P.a, φ P.b, φ P.c, φ P.d⟩

lemma map_to_poly : (map φ P).to_poly = polynomial.map φ P.to_poly :=
by simp only [map, to_poly, map_C, map_X, polynomial.map_add, polynomial.map_mul,
              polynomial.map_pow]

end map

end basic

section roots

open multiset

/-! ### Roots over an extension -/

section extension

variables {P : cubic R} [comm_ring R] [comm_ring S] {φ : R →+* S}

/-- The roots of a cubic polynomial. -/
def roots [is_domain R] (P : cubic R) : multiset R := P.to_poly.roots

lemma map_roots [is_domain S] : (map φ P).roots = (polynomial.map φ P.to_poly).roots :=
by rw [roots, map_to_poly]

theorem mem_roots_iff [is_domain R] (h0 : P.to_poly ≠ 0) (x : R) :
  x ∈ P.roots ↔ P.a * x ^ 3 + P.b * x ^ 2 + P.c * x + P.d = 0 :=
begin
  rw [roots, mem_roots h0, is_root, to_poly],
  simp only [eval_C, eval_X, eval_add, eval_mul, eval_pow]
end

theorem card_roots_le [is_domain R] [decidable_eq R] : P.roots.to_finset.card ≤ 3 :=
begin
  apply (to_finset_card_le P.to_poly.roots).trans,
  by_cases hP : P.to_poly = 0,
  { exact (card_roots' P.to_poly).trans (by { rw [hP, nat_degree_zero], exact zero_le 3 }) },
  { exact with_bot.coe_le_coe.1 ((card_roots hP).trans degree_cubic_le) }
end

end extension

variables {P : cubic F} [field F] [field K] {φ : F →+* K} {x y z : K}

/-! ### Roots over a splitting field -/

section split

theorem splits_iff_card_roots (ha : P.a ≠ 0) : splits φ P.to_poly ↔ (map φ P).roots.card = 3 :=
begin
  replace ha : (map φ P).a ≠ 0 := (_root_.map_ne_zero φ).mpr ha,
  nth_rewrite_lhs 0 [← ring_hom.id_comp φ],
  rw [roots, ← splits_map_iff, ← map_to_poly, splits_iff_card_roots,
      ← ((degree_eq_iff_nat_degree_eq $ ne_zero_of_a_ne_zero ha).mp $
          degree_of_a_ne_zero ha : _ = 3)]
end

theorem splits_iff_roots_eq_three (ha : P.a ≠ 0) :
  splits φ P.to_poly ↔ ∃ x y z : K, (map φ P).roots = {x, y, z} :=
by rw [splits_iff_card_roots ha, card_eq_three]

theorem eq_prod_three_roots (ha : P.a ≠ 0) (h3 : (map φ P).roots = {x, y, z}) :
  (map φ P).to_poly = C (φ P.a) * (X - C x) * (X - C y) * (X - C z) :=
begin
  rw [map_to_poly, eq_prod_roots_of_splits $ (splits_iff_roots_eq_three ha).mpr $ exists.intro x $
        exists.intro y $ exists.intro z h3, leading_coeff_of_a_ne_zero ha, ← map_roots, h3],
  change C (φ P.a) * ((X - C x) ::ₘ (X - C y) ::ₘ {X - C z}).prod = _,
  rw [prod_cons, prod_cons, prod_singleton, mul_assoc, mul_assoc]
end

theorem eq_sum_three_roots (ha : P.a ≠ 0) (h3 : (map φ P).roots = {x, y, z}) :
  map φ P = ⟨φ P.a, φ P.a * -(x + y + z), φ P.a * (x * y + x * z + y * z), φ P.a * -(x * y * z)⟩ :=
begin
  apply_fun to_poly,
  any_goals { exact λ P Q, (to_poly_injective P Q).mp },
  rw [eq_prod_three_roots ha h3, C_mul_prod_X_sub_C_eq]
end

theorem b_eq_three_roots (ha : P.a ≠ 0) (h3 : (map φ P).roots = {x, y, z}) :
  φ P.b = φ P.a * -(x + y + z) :=
by injection eq_sum_three_roots ha h3

theorem c_eq_three_roots (ha : P.a ≠ 0) (h3 : (map φ P).roots = {x, y, z}) :
  φ P.c = φ P.a * (x * y + x * z + y * z) :=
by injection eq_sum_three_roots ha h3

theorem d_eq_three_roots (ha : P.a ≠ 0) (h3 : (map φ P).roots = {x, y, z}) :
  φ P.d = φ P.a * -(x * y * z) :=
by injection eq_sum_three_roots ha h3

end split

/-! ### Discriminant over a splitting field -/

section discriminant

/-- The discriminant of a cubic polynomial. -/
def disc {R : Type*} [ring R] (P : cubic R) : R :=
P.b ^ 2 * P.c ^ 2 - 4 * P.a * P.c ^ 3 - 4 * P.b ^ 3 * P.d - 27 * P.a ^ 2 * P.d ^ 2
  + 18 * P.a * P.b * P.c * P.d

theorem disc_eq_prod_three_roots (ha : P.a ≠ 0) (h3 : (map φ P).roots = {x, y, z}) :
  φ P.disc = (φ P.a * φ P.a * (x - y) * (x - z) * (y - z)) ^ 2 :=
begin
  simp only [disc, ring_hom.map_add, ring_hom.map_sub, ring_hom.map_mul, map_pow],
  simp only [ring_hom.map_one, map_bit0, map_bit1],
  rw [b_eq_three_roots ha h3, c_eq_three_roots ha h3, d_eq_three_roots ha h3],
  ring1
end

theorem disc_ne_zero_iff_roots_ne (ha : P.a ≠ 0) (h3 : (map φ P).roots = {x, y, z}) :
  P.disc ≠ 0 ↔ x ≠ y ∧ x ≠ z ∧ y ≠ z :=
begin
  rw [←_root_.map_ne_zero φ, disc_eq_prod_three_roots ha h3, pow_two],
  simp_rw [mul_ne_zero_iff, sub_ne_zero, _root_.map_ne_zero, and_self, and_iff_right ha, and_assoc],
end

theorem disc_ne_zero_iff_roots_nodup (ha : P.a ≠ 0) (h3 : (map φ P).roots = {x, y, z}) :
  P.disc ≠ 0 ↔ (map φ P).roots.nodup :=
begin
  rw [disc_ne_zero_iff_roots_ne ha h3, h3],
  change _ ↔ (x ::ₘ y ::ₘ {z}).nodup,
  rw [nodup_cons, nodup_cons, mem_cons, mem_singleton, mem_singleton],
  simp only [nodup_singleton],
  tautology
end

theorem card_roots_of_disc_ne_zero [decidable_eq K] (ha : P.a ≠ 0)
  (h3 : (map φ P).roots = {x, y, z}) (hd : P.disc ≠ 0) : (map φ P).roots.to_finset.card = 3 :=
begin
  rw [to_finset_card_of_nodup $ (disc_ne_zero_iff_roots_nodup ha h3).mp hd,
      ← splits_iff_card_roots ha, splits_iff_roots_eq_three ha],
  exact ⟨x, ⟨y, ⟨z, h3⟩⟩⟩
end

end discriminant

end roots

end cubic


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

Authors: Floris van Doorn, Jeremy Avigad
Subtraction on the natural numbers, as well as min, max, and distance.
-/
import .order
universes u v w
hott_theory
namespace hott
open hott.algebra nat hott.nat

namespace nat

/- subtraction -/

@[hott] protected theorem sub_zero (n : ℕ) : n - 0 = n :=
rfl

@[hott] theorem sub_succ (n m : ℕ) : n - succ m = pred (n - m) :=
rfl

@[hott] protected theorem zero_sub (n : ℕ) : 0 - n = 0 :=
nat.rec_on n (nat.sub_zero _)
  (λk : nat,
    assume IH : 0 - k = 0,
    calc
      0 - succ k = pred (0 - k) : by rwr sub_succ
             ... = pred 0       : by rwr IH
             ... = 0            : pred_zero)

@[hott] theorem succ_sub_succ (n m : ℕ) : succ n - succ m = n - m :=
succ_sub_succ_eq_sub n m

@[hott] protected theorem sub_self (n : ℕ) : n - n = 0 :=
nat.rec_on n (nat.sub_zero _) (λk IH, succ_sub_succ _ _ ⬝ IH)

@[hott] protected theorem add_sub_add_right (n k m : ℕ) : (n + k) - (m + k) = n - m :=
nat.rec_on k
  (calc
    (n + 0) - (m + 0) = n - (m + 0) : by rwr [hott.algebra.add_zero]
                  ... = n - m       : by rwr [hott.algebra.add_zero])
  (λl : nat,
    assume IH : (n + l) - (m + l) = n - m,
    calc
      (n + succ l) - (m + succ l) = succ (n + l) - (m + succ l) : by rwr add_succ
                              ... = succ (n + l) - succ (m + l) : by rwr add_succ
                              ... = (n + l) - (m + l)           : by rwr succ_sub_succ
                              ... =  n - m                      : IH)
@[hott] protected theorem add_sub_add_left (k n m : ℕ) : (k + n) - (k + m) = n - m :=
by rwr [nat.add_comm k n, nat.add_comm k m]; exact nat.add_sub_add_right n k m

@[hott] protected theorem add_sub_cancel (n m : ℕ) : n + m - m = n :=
nat.rec_on m
  (begin rwr hott.algebra.add_zero end)
  (λk : ℕ,
    assume IH : n + k - k = n,
    calc
      n + succ k - succ k = succ (n + k) - succ k : by rwr add_succ
                      ... = n + k - k             : by rwr succ_sub_succ
                      ... = n                     : IH)

@[hott] protected theorem add_sub_cancel_left (n m : ℕ) : n + m - n = m :=
by rwr add.comm; apply nat.add_sub_cancel

@[hott] protected theorem sub_sub (n m k : ℕ) : n - m - k = n - (m + k) :=
nat.rec_on k
  (calc
    n - m - 0 = n - m        : by rwr nat.sub_zero
          ... = n - (m + 0)  : by rwr nat.add_zero)
  (λl : nat,
    assume IH : n - m - l = n - (m + l),
    calc
      n - m - succ l = pred (n - m - l)   : by rwr sub_succ
                 ... = pred (n - (m + l)) : by rwr IH
                 ... = n - succ (m + l)   : by rwr sub_succ
                 ... = n - (m + succ l)   : by rwr add_succ)

@[hott] theorem succ_sub_sub_succ (n m k : ℕ) : succ n - m - succ k = n - m - k :=
calc
  succ n - m - succ k = succ n - (m + succ k) : by rwr nat.sub_sub
                  ... = succ n - succ (m + k) : by rwr add_succ
                  ... = n - (m + k)           : by rwr succ_sub_succ
                  ... = n - m - k             : by rwr nat.sub_sub

@[hott] theorem sub_self_add (n m : ℕ) : n - (n + m) = 0 :=
calc
  n - (n + m) = n - n - m : by rwr nat.sub_sub
          ... = 0 - m     : by rwr nat.sub_self
          ... = 0         : by rwr nat.zero_sub

@[hott] protected theorem sub.right_comm (m n k : ℕ) : m - n - k = m - k - n :=
calc
  m - n - k = m - (n + k) : by rwr nat.sub_sub
        ... = m - (k + n) : by rwr add.comm
        ... = m - k - n   : by rwr nat.sub_sub

@[hott] theorem succ_sub_one (n : ℕ) : succ n - 1 = n :=
rfl

/- interaction with multiplication -/

@[hott] theorem mul_pred_left (n m : ℕ) : pred n * m = n * m - m :=
nat.rec_on n
  (calc
    pred 0 * m = 0 * m     : by rwr pred_zero
           ... = 0         : by rwr nat.zero_mul
           ... = 0 - m     : by rwr nat.zero_sub
           ... = 0 * m - m : by rwr nat.zero_mul)
  (λk : nat,
    assume IH : pred k * m = k * m - m,
    calc
      pred (succ k) * m = k * m          : by rwr pred_succ
                    ... = k * m + m - m  : by rwr nat.add_sub_cancel
                    ... = succ k * m - m : by rwr succ_mul)

@[hott] theorem mul_pred_right (n m : ℕ) : n * pred m = n * m - n :=
calc
  n * pred m = pred m * n : by rwr mul.comm
         ... = m * n - n  : by rwr mul_pred_left
         ... = n * m - n  : by rwr mul.comm

@[hott] protected theorem mul_sub_right_distrib (n m k : ℕ) : (n - m) * k = n * k - m * k :=
nat.rec_on m
  (calc
    (n - 0) * k = n * k         : by rwr nat.sub_zero
            ... = n * k - 0     : by rwr nat.sub_zero
            ... = n * k - 0 * k : by rwr nat.zero_mul)
  (λl : nat,
    assume IH : (n - l) * k = n * k - l * k,
    calc
      (n - succ l) * k = pred (n - l) * k     : by rwr sub_succ
                   ... = (n - l) * k - k      : by rwr mul_pred_left
                   ... = n * k - l * k - k    : by rwr IH
                   ... = n * k - (l * k + k)  : by rwr nat.sub_sub
                   ... = n * k - (succ l * k) : by rwr succ_mul)

@[hott] protected theorem mul_sub_left_distrib (n m k : ℕ) : n * (m - k) = n * m - n * k :=
calc
  n * (m - k) = (m - k) * n   : by rwr mul.comm
          ... = m * n - k * n : by rwr nat.mul_sub_right_distrib
          ... = n * m - k * n : by rwr mul.comm
          ... = n * m - n * k : by rwr mul.comm k n

@[hott] protected theorem mul_self_sub_mul_self_eq (a b : nat) : a * a - b * b = (a + b) * (a - b) :=
begin
  rwr [nat.mul_sub_left_distrib, nat.right_distrib, nat.right_distrib, mul.comm b a],
  rwr [nat.add_comm (a*a) (a*b)],
  rwr nat.add_sub_add_left
end

@[hott] theorem succ_mul_succ_eq (a : nat) : succ a * succ a = a*a + a + a + 1 :=
calc succ a * succ a
    = (a+1)*(a+1)     : by rwr [add_one]
... = a*a + a + a + 1 : by rwr [nat.right_distrib, nat.left_distrib, nat.one_mul, nat.mul_one]

/- interaction with inequalities -/

-- @[hott] theorem succ_sub {m n : ℕ} : m ≥ n → succ m - n  = succ (m - n) :=
-- sub_induction n m
--   (λk, assume H : 0 ≤ k, rfl)
--    (λk,
--     assume H : succ k ≤ 0,
--     absurd H (not_succ_le_zero _))
--   (λk l,
--     assume IH : k ≤ l → succ l - k = succ (l - k),
--     λH : succ k ≤ succ l,
--     calc
--       succ (succ l) - succ k = succ l - k             : by rwr succ_sub_succ
--                          ... = succ (l - k)           : IH (le_of_succ_le_succ H)
--                          ... = succ (succ l - succ k) : by rwr succ_sub_succ)

-- @[hott] theorem sub_eq_zero_of_le {n m : ℕ} (H : n ≤ m) : n - m = 0 :=
-- begin hinduction le.elim H with p k Hk, rwr Hk, apply sub_self_add end

-- @[hott] theorem add_sub_of_le {n m : ℕ} : n ≤ m → n + (m - n) = m :=
-- sub_induction n m
--   (λk,
--     assume H : 0 ≤ k,
--     calc
--       0 + (k - 0) = k - 0 : by rwr nat.zero_add
--               ... = k     : by rwr nat.sub_zero)
--   (λk, assume H : succ k ≤ 0, absurd H (not_succ_le_zero _))
--   (λk l,
--     assume IH : k ≤ l → k + (l - k) = l,
--     λH : succ k ≤ succ l,
--     calc
--       succ k + (succ l - succ k) = succ k + (l - k)   : by rwr succ_sub_succ
--                              ... = succ (k + (l - k)) : by rwr succ_add
--                              ... = succ l             : IH (le_of_succ_le_succ H))

-- @[hott] theorem add_sub_of_ge {n m : ℕ} (H : n ≥ m) : n + (m - n) = n :=
-- calc
--   n + (m - n) = n + 0 : by rwr sub_eq_zero_of_le H
--           ... = n     : by rwr nat.add_zero

-- @[hott] protected theorem sub_add_cancel {n m : ℕ} : n ≥ m → n - m + m = n :=
-- by rwr add.comm; apply add_sub_of_le

-- @[hott] theorem sub_add_of_le {n m : ℕ} : n ≤ m → n - m + m = m :=
-- by rwr add.comm; apply add_sub_of_ge

-- @[hott, elab_as_eliminator] theorem sub.cases {P : ℕ → Type _} {n m : ℕ} (H1 : n ≤ m → P 0)
--   (H2 : Πk, m + k = n -> P k) : P (n - m) :=
-- sum.elim (le.total n m)
--   (assume H3 : n ≤ m, by rwr sub_eq_zero_of_le H3; exact H1 H3)
--   (assume H3 : m ≤ n, H2 (n - m) (add_sub_of_le H3))

-- @[hott] theorem exists_sub_eq_of_le {n m : ℕ} (H : n ≤ m) : Σk, m - k = n :=
-- obtain (k : ℕ) (Hk : n + k = m), from le.elim H,
-- sigma.mk k
--   (calc
--     m - k = n + k - k : by rwr Hk
--       ... = n         : by rwr nat.add_sub_cancel)

-- @[hott] protected theorem add_sub_assoc {m k : ℕ} (H : k ≤ m) (n : ℕ) : n + m - k = n + (m - k) :=
-- have l1 : k ≤ m → n + m - k = n + (m - k), from
--   sub_induction k m
--     (λm : ℕ,
--       assume H : 0 ≤ m,
--       calc
--         n + m - 0 = n + m       : by rwr nat.sub_zero
--               ... = n + (m - 0) : by rwr nat.sub_zero)
--     (λk : ℕ, assume H : succ k ≤ 0, absurd H (not_succ_le_zero _))
--     (λk m,
--       assume IH : k ≤ m → n + m - k = n + (m - k),
--       λH : succ k ≤ succ m,
--       calc
--         n + succ m - succ k = succ (n + m) - succ k : by rwr add_succ
--                         ... = n + m - k             : by rwr succ_sub_succ
--                         ... = n + (m - k)           : IH (le_of_succ_le_succ H)
--                         ... = n + (succ m - succ k) : by rwr succ_sub_succ),
-- l1 H

-- @[hott] theorem le_of_sub_eq_zero {n m : ℕ} : n - m = 0 → n ≤ m :=
-- sub.cases
--   (assume H1 : n ≤ m, assume H2 : 0 = 0, H1)
--   (λk : ℕ,
--     assume H1 : m + k = n,
--     assume H2 : k = 0,
--     have H3 : n = m, from by rwr [←add_zero, ←H2]; exact H1⁻¹,
--     le_of_eq _)

-- @[hott] theorem sub_sub.cases {P : ℕ → ℕ → Type _} {n m : ℕ} (H1 : Πk, n = m + k -> P k 0)
--   (H2 : Πk, m = n + k → P 0 k) : P (n - m) (m - n) :=
-- sum.elim (le.total n m)
--   (assume H3 : n ≤ m,
--     (sub_eq_zero_of_le H3)⁻¹ ▸ (H2 (m - n) (add_sub_of_le H3)⁻¹))
--   (assume H3 : m ≤ n,
--     (sub_eq_zero_of_le H3)⁻¹ ▸ (H1 (n - m) (add_sub_of_le H3)⁻¹))

-- @[hott] protected theorem sub_eq_of_add_eq {n m k : ℕ} (H : n + m = k) : k - n = m :=
-- have H2 : k - n + n = m + n, from
--   calc
--     k - n + n = k     : nat.sub_add_cancel (le.intro H)
--           ... = n + m : H⁻¹
--           ... = m + n : by rwr add.comm,
-- add.right_cancel H2

-- @[hott] protected theorem eq_sub_of_add_eq {a b c : ℕ} (H : a + c = b) : a = b - c :=
-- by symmetry; apply nat.sub_eq_of_add_eq; rwra add.comm

-- @[hott] protected theorem sub_eq_of_eq_add {a b c : ℕ} (H : a = c + b) : a - b = c :=
-- by apply nat.sub_eq_of_add_eq; rwr add.comm; symmetry; exact H

-- @[hott] protected theorem sub_le_sub_right {n m : ℕ} (H : n ≤ m) (k : ℕ) : n - k ≤ m - k :=
-- obtain (l : ℕ) (Hl : n + l = m), from le.elim H,
-- sum.elim !le.total
--   (assume H2 : n ≤ k, (sub_eq_zero_of_le H2)⁻¹ ▸ !zero_le)
--   (assume H2 : k ≤ n,
--     have H3 : n - k + l = m - k, from
--       calc
--         n - k + l = l + (n - k) : add.comm
--               ... = l + n - k   : nat.add_sub_assoc H2 l
--               ... = n + l - k   : add.comm
--               ... = m - k       : by xrwr Hl,
--     le.intro H3)

-- @[hott] protected theorem sub_le_sub_left {n m : ℕ} (H : n ≤ m) (k : ℕ) : k - m ≤ k - n :=
-- by induction H; [refl, exact le.trans (pred_le _) H_ih]

-- @[hott] protected theorem sub_pos_of_lt {m n : ℕ} (H : m < n) : n - m > 0 :=
-- have H1 : n = n - m + m, from (nat.sub_add_cancel (le_of_lt H))⁻¹,
-- have   H2 : 0 + m < n - m + m, begin rwr [zero_add, -H1], exact H end,
-- !lt_of_add_lt_add_right H2

-- @[hott] protected theorem lt_of_sub_pos {m n : ℕ} (H : n - m > 0) : m < n :=
-- lt_of_not_ge
--   (λH1 : m ≥ n,
--     have H2 : n - m = 0, from sub_eq_zero_of_le H1,
--     !lt.irrefl (H2 ▸ H))

-- @[hott] protected theorem lt_of_sub_lt_sub_right {n m k : ℕ} (H : n - k < m - k) : n < m :=
-- lt_of_not_ge
--   (assume H1 : m ≤ n,
--     have H2 : m - k ≤ n - k, from nat.sub_le_sub_right H1 _,
--     not_le_of_gt H H2)

-- @[hott] protected theorem lt_of_sub_lt_sub_left {n m k : ℕ} (H : n - m < n - k) : k < m :=
-- lt_of_not_ge
--   (assume H1 : m ≤ k,
--     have H2 : n - k ≤ n - m, from nat.sub_le_sub_left H1 _,
--     not_le_of_gt H H2)

-- @[hott] protected theorem sub_lt_sub_add_sub (n m k : ℕ) : n - k ≤ (n - m) + (m - k) :=
-- sub.cases
--   (assume H : n ≤ m, (zero_add (m - k))⁻¹ ▸ nat.sub_le_sub_right H k)
--   (λmn : ℕ,
--     assume Hmn : m + mn = n,
--     sub.cases
--       (assume H : m ≤ k,
--         have   H2 : n - k ≤ n - m, from nat.sub_le_sub_left H n,
--         have H3 : n - k ≤ mn, from nat.sub_eq_of_add_eq Hmn ▸ H2,
--         show   n - k ≤ mn + 0,  begin rwr add_zero, assumption end)
--       (λkm : ℕ,
--         assume Hkm : k + km = m,
--         have H : k + (mn + km) = n, from
--           calc
--             k + (mn + km) = k + (km + mn): add.comm
--                       ... = k + km + mn  : add.assoc
--                       ... = m + mn       : Hkm
--                       ... = n            : Hmn,
--         have H2 : n - k = mn + km, from nat.sub_eq_of_add_eq H,
--         H2 ▸ !le.refl))

-- @[hott] protected theorem sub_lt_self {m n : ℕ} (H1 : m > 0) (H2 : n > 0) : m - n < m :=
-- calc
--   m - n = succ (pred m) - n             : succ_pred_of_pos H1
--     ... = succ (pred m) - succ (pred n) : succ_pred_of_pos H2
--     ... = pred m - pred n               : succ_sub_succ
--     ... ≤ pred m                        : sub_le
--     ... < succ (pred m)                 : lt_succ_self
--     ... = m                             : succ_pred_of_pos H1

-- @[hott] protected theorem le_sub_of_add_le {m n k : ℕ} (H : m + k ≤ n) : m ≤ n - k :=
-- calc
--   m = m + k - k : nat.add_sub_cancel
--     ... ≤ n - k : nat.sub_le_sub_right H k

-- @[hott] protected theorem lt_sub_of_add_lt {m n k : ℕ} (H : m + k < n) (H2 : k ≤ n) : m < n - k :=
-- lt_of_succ_le (nat.le_sub_of_add_le (calc
--     succ m + k = succ (m + k) : succ_add_eq_succ_add
--            ... ≤ n            : succ_le_of_lt H))

-- @[hott] protected theorem sub_lt_of_lt_add {v n m : nat} (h₁ : v < n + m) (h₂ : n ≤ v) : v - n < m :=
-- have succ v ≤ n + m,   from succ_le_of_lt h₁,
-- have succ (v - n) ≤ m, from
--   calc succ (v - n) = succ v - n : succ_sub h₂
--         ...     ≤ n + m - n      : nat.sub_le_sub_right this n
--         ...     = m              : nat.add_sub_cancel_left,
-- lt_of_succ_le this

-- /- distance -/

-- @[hott] def dist [reducible] (n m : ℕ) := (n - m) + (m - n)

-- @[hott] theorem dist.comm (n m : ℕ) : dist n m = dist m n :=
-- !add.comm

-- @[hott] theorem dist_self (n : ℕ) : dist n n = 0 :=
-- calc
--   (n - n) + (n - n) = 0 + (n - n) : nat.sub_self
--                 ... = 0 + 0       : nat.sub_self
--                 ... = 0           : rfl

-- @[hott] theorem eq_of_dist_eq_zero {n m : ℕ} (H : dist n m = 0) : n = m :=
-- have H2 : n - m = 0, from eq_zero_of_add_eq_zero_right H,
-- have H3 : n ≤ m, from le_of_sub_eq_zero H2,
-- have H4 : m - n = 0, from eq_zero_of_add_eq_zero_left H,
-- have H5 : m ≤ n, from le_of_sub_eq_zero H4,
-- le.antisymm H3 H5

-- @[hott] theorem dist_eq_zero {n m : ℕ} (H : n = m) : dist n m = 0 :=
-- by substvars; rwr [↑dist, *nat.sub_self, add_zero]

-- @[hott] theorem dist_eq_sub_of_le {n m : ℕ} (H : n ≤ m) : dist n m = m - n :=
-- calc
--   dist n m = 0 + (m - n) : {sub_eq_zero_of_le H}
--        ... = m - n       : zero_add

-- @[hott] theorem dist_eq_sub_of_lt {n m : ℕ} (H : n < m) : dist n m = m - n :=
-- dist_eq_sub_of_le (le_of_lt H)

-- @[hott] theorem dist_eq_sub_of_ge {n m : ℕ} (H : n ≥ m) : dist n m = n - m :=
-- !dist.comm ▸ dist_eq_sub_of_le H

-- @[hott] theorem dist_eq_sub_of_gt {n m : ℕ} (H : n > m) : dist n m = n - m :=
-- dist_eq_sub_of_ge (le_of_lt H)

-- @[hott] theorem dist_zero_right (n : ℕ) : dist n 0 = n :=
-- dist_eq_sub_of_ge !zero_le ⬝ !nat.sub_zero

-- @[hott] theorem dist_zero_left (n : ℕ) : dist 0 n = n :=
-- dist_eq_sub_of_le !zero_le ⬝ !nat.sub_zero

-- @[hott] theorem dist.intro {n m k : ℕ} (H : n + m = k) : dist k n = m :=
-- calc
--   dist k n = k - n : dist_eq_sub_of_ge (le.intro H)
--            ... = m : nat.sub_eq_of_add_eq H

-- @[hott] theorem dist_add_add_right (n k m : ℕ) : dist (n + k) (m + k) = dist n m :=
-- calc
--   dist (n + k) (m + k) = ((n+k) - (m+k)) + ((m+k)-(n+k)) : rfl
--                    ... = (n - m) + ((m + k) - (n + k))   : nat.add_sub_add_right
--                    ... = (n - m) + (m - n)               : nat.add_sub_add_right

-- @[hott] theorem dist_add_add_left (k n m : ℕ) : dist (k + n) (k + m) = dist n m :=
-- begin rwr [add.comm k n, add.comm k m]; apply dist_add_add_right end

-- @[hott] theorem dist_add_eq_of_ge {n m : ℕ} (H : n ≥ m) : dist n m + m = n :=
-- calc
--   dist n m + m = n - m + m : {dist_eq_sub_of_ge H}
--            ... = n         : nat.sub_add_cancel H

-- @[hott] theorem dist_eq_intro {n m k l : ℕ} (H : n + m = k + l) : dist n k = dist l m :=
-- calc
--   dist n k = dist (n + m) (k + m) : dist_add_add_right
--        ... = dist (k + l) (k + m) : H
--        ... = dist l m             : dist_add_add_left

-- @[hott] theorem dist_sub_eq_dist_add_left {n m : ℕ} (H : n ≥ m) (k : ℕ) :
--   dist (n - m) k = dist n (k + m) :=
-- have H2 : n - m + (k + m) = k + n, from
--   calc
--     n - m + (k + m) = n - m + (m + k) : add.comm
--                 ... = n - m + m + k   : add.assoc
--                 ... = n + k           : nat.sub_add_cancel H
--                 ... = k + n           : add.comm,
-- dist_eq_intro H2

-- @[hott] theorem dist_sub_eq_dist_add_right {k m : ℕ} (H : k ≥ m) (n : ℕ) :
--   dist n (k - m) = dist (n + m) k :=
-- dist.comm (k - m) n ▸ dist.comm k (n + m) ▸ dist_sub_eq_dist_add_left H n

-- @[hott] theorem dist.triangle_inequality (n m k : ℕ) : dist n k ≤ dist n m + dist m k :=
-- have (n - m) + (m - k) + ((k - m) + (m - n)) = (n - m) + (m - n) + ((m - k) + (k - m)),
-- begin rwr [add.comm (k - m) (m - n),
--                {n - m + _ + _}add.assoc,
--                {m - k + _}add.left_comm, -add.assoc] end,
-- this ▸ add_le_add !nat.sub_lt_sub_add_sub !nat.sub_lt_sub_add_sub

-- @[hott] theorem dist_add_add_le_add_dist_dist (n m k l : ℕ) : dist (n + m) (k + l) ≤ dist n k + dist m l :=
-- have H : dist (n + m) (k + m) + dist (k + m) (k + l) = dist n k + dist m l,
--   by rwr [dist_add_add_left, dist_add_add_right],
-- by rwr -H; apply dist.triangle_inequality

-- @[hott] theorem dist_mul_right (n k m : ℕ) : dist (n * k) (m * k) = dist n m * k :=
-- have Π n m, dist n m = n - m + (m - n), from λn m, rfl,
-- by rwr [this, this n m, right_distrib, *nat.mul_sub_right_distrib]

-- @[hott] theorem dist_mul_left (k n m : ℕ) : dist (k * n) (k * m) = k * dist n m :=
-- begin rwr [mul.comm k n, mul.comm k m, dist_mul_right, mul.comm] end

-- @[hott] theorem dist_mul_dist (n m k l : ℕ) : dist n m * dist k l = dist (n * k + m * l) (n * l + m * k) :=
-- have aux : Πk l, k ≥ l → dist n m * dist k l = dist (n * k + m * l) (n * l + m * k), from
--   λk l : ℕ,
--   assume H : k ≥ l,
--   have H2 : m * k ≥ m * l, from !mul_le_mul_left H,
--   have H3 : n * l + m * k ≥ m * l, from le.trans H2 !le_add_left,
--   calc
--     dist n m * dist k l = dist n m * (k - l)       : dist_eq_sub_of_ge H
--       ... = dist (n * (k - l)) (m * (k - l))       : dist_mul_right
--       ... = dist (n * k - n * l) (m * k - m * l)   : by rwr [*nat.mul_sub_left_distrib]
--       ... = dist (n * k) (m * k - m * l + n * l)   : dist_sub_eq_dist_add_left (!mul_le_mul_left H)
--       ... = dist (n * k) (n * l + (m * k - m * l)) : add.comm
--       ... = dist (n * k) (n * l + m * k - m * l)   : nat.add_sub_assoc H2 (n * l)
--       ... = dist (n * k + m * l) (n * l + m * k)   : dist_sub_eq_dist_add_right H3 _,
-- sum.elim !le.total
--   (assume H : k ≤ l, !dist.comm ▸ !dist.comm ▸ aux l k H)
--   (assume H : l ≤ k, aux k l H)

-- @[hott] lemma dist_eq_max_sub_min {i j : nat} : dist i j = (max i j) - min i j :=
-- sum.elim (lt_sum_ge i j)
--   (suppose i < j,
--     by rwr [max_eq_right_of_lt this, min_eq_left_of_lt this, dist_eq_sub_of_lt this])
--   (suppose i ≥ j,
--     by rwr [max_eq_left this , min_eq_right this, dist_eq_sub_of_ge this])

-- @[hott] lemma dist_succ {i j : nat} : dist (succ i) (succ j) = dist i j :=
-- by rwr [↑dist, *succ_sub_succ]

-- @[hott] lemma dist_le_max {i j : nat} : dist i j ≤ max i j :=
-- begin rwr dist_eq_max_sub_min, apply sub_le end

-- @[hott] lemma dist_pos_of_ne {i j : nat} : i ≠ j → dist i j > 0 :=
-- assume Pne, lt.by_cases
--   (suppose i < j, begin rwr [dist_eq_sub_of_lt this], apply nat.sub_pos_of_lt this end)
--   (suppose i = j, by contradiction)
--   (suppose i > j, begin rwr [dist_eq_sub_of_gt this], apply nat.sub_pos_of_lt this end)

end nat
end hott


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

import set_theory.game.basic
import tactic.nth_rewrite

/-!
# Basic definitions about impartial (pre-)games

We will define an impartial game, one in which left and right can make exactly the same moves.
Our definition differs slightly by saying that the game is always equivalent to its negative,
no matter what moves are played. This allows for games such as poker-nim to be classifed as
impartial.
-/

universe u

open_locale pgame

namespace pgame

/-- The definition for a impartial game, defined using Conway induction. -/
def impartial_aux : pgame → Prop
| G := G ≈ -G ∧ (∀ i, impartial_aux (G.move_left i)) ∧ ∀ j, impartial_aux (G.move_right j)
using_well_founded { dec_tac := pgame_wf_tac }

lemma impartial_aux_def {G : pgame} : G.impartial_aux ↔ G ≈ -G ∧
  (∀ i, impartial_aux (G.move_left i)) ∧ ∀ j, impartial_aux (G.move_right j) :=
by rw impartial_aux

/-- A typeclass on impartial games. -/
class impartial (G : pgame) : Prop := (out : impartial_aux G)

lemma impartial_iff_aux {G : pgame} : G.impartial ↔ G.impartial_aux :=
⟨λ h, h.1, λ h, ⟨h⟩⟩

lemma impartial_def {G : pgame} : G.impartial ↔ G ≈ -G ∧
  (∀ i, impartial (G.move_left i)) ∧ ∀ j, impartial (G.move_right j) :=
by simpa only [impartial_iff_aux] using impartial_aux_def

namespace impartial

instance impartial_zero : impartial 0 :=
by { rw impartial_def, dsimp, simp }

instance impartial_star : impartial star :=
by { rw impartial_def, simpa using impartial.impartial_zero }

lemma neg_equiv_self (G : pgame) [h : G.impartial] : G ≈ -G := (impartial_def.1 h).1

@[simp] lemma mk_neg_equiv_self (G : pgame) [h : G.impartial] : -⟦G⟧ = ⟦G⟧ :=
quot.sound (neg_equiv_self G).symm

instance move_left_impartial {G : pgame} [h : G.impartial] (i : G.left_moves) :
  (G.move_left i).impartial :=
(impartial_def.1 h).2.1 i

instance move_right_impartial {G : pgame} [h : G.impartial] (j : G.right_moves) :
  (G.move_right j).impartial :=
(impartial_def.1 h).2.2 j

theorem impartial_congr : ∀ {G H : pgame} (e : G ≡r H) [G.impartial], H.impartial
| G H := λ e, begin
  introI h,
  exact impartial_def.2
    ⟨e.symm.equiv.trans ((neg_equiv_self G).trans (neg_equiv_neg_iff.2 e.equiv)),
      λ i, impartial_congr (e.move_left_symm i), λ j, impartial_congr (e.move_right_symm j)⟩
end
using_well_founded { dec_tac := pgame_wf_tac }

instance impartial_add : ∀ (G H : pgame) [G.impartial] [H.impartial], (G + H).impartial
| G H :=
begin
  introsI hG hH,
  rw impartial_def,
  refine ⟨(add_congr (neg_equiv_self _) (neg_equiv_self _)).trans
    (neg_add_relabelling _ _).equiv.symm, λ k, _, λ k, _⟩,
  { apply left_moves_add_cases k,
    all_goals
    { intro i, simp only [add_move_left_inl, add_move_left_inr],
      apply impartial_add } },
  { apply right_moves_add_cases k,
    all_goals
    { intro i, simp only [add_move_right_inl, add_move_right_inr],
      apply impartial_add } }
end
using_well_founded { dec_tac := pgame_wf_tac }

instance impartial_neg : ∀ (G : pgame) [G.impartial], (-G).impartial
| G :=
begin
  introI hG,
  rw impartial_def,
  refine ⟨_, λ i, _, λ i, _⟩,
  { rw neg_neg,
    exact (neg_equiv_self G).symm },
  { rw move_left_neg',
    apply impartial_neg },
  { rw move_right_neg',
    apply impartial_neg }
end
using_well_founded { dec_tac := pgame_wf_tac }

variables (G : pgame) [impartial G]

lemma nonpos : ¬ 0 < G :=
λ h, begin
  have h' := neg_lt_neg_iff.2 h,
  rw [neg_zero, lt_congr_left (neg_equiv_self G).symm] at h',
  exact (h.trans h').false
end

lemma nonneg : ¬ G < 0 :=
λ h, begin
  have h' := neg_lt_neg_iff.2 h,
  rw [neg_zero, lt_congr_right (neg_equiv_self G).symm] at h',
  exact (h.trans h').false
end

/-- In an impartial game, either the first player always wins, or the second player always wins. -/
lemma equiv_or_fuzzy_zero : G ≈ 0 ∨ G ‖ 0 :=
begin
  rcases lt_or_equiv_or_gt_or_fuzzy G 0 with h | h | h | h,
  { exact ((nonneg G) h).elim },
  { exact or.inl h },
  { exact ((nonpos G) h).elim },
  { exact or.inr h }
end

@[simp] lemma not_equiv_zero_iff : ¬ G ≈ 0 ↔ G ‖ 0 :=
⟨(equiv_or_fuzzy_zero G).resolve_left, fuzzy.not_equiv⟩

@[simp] lemma not_fuzzy_zero_iff : ¬ G ‖ 0 ↔ G ≈ 0 :=
⟨(equiv_or_fuzzy_zero G).resolve_right, equiv.not_fuzzy⟩

lemma add_self : G + G ≈ 0 :=
(add_congr_left (neg_equiv_self G)).trans (add_left_neg_equiv G)

@[simp] lemma mk_add_self : ⟦G⟧ + ⟦G⟧ = 0 := quot.sound (add_self G)

/-- This lemma doesn't require `H` to be impartial. -/
lemma equiv_iff_add_equiv_zero (H : pgame) : H ≈ G ↔ H + G ≈ 0 :=
by { rw [equiv_iff_game_eq, equiv_iff_game_eq, ←@add_right_cancel_iff _ _ _ (-⟦G⟧)], simpa }

/-- This lemma doesn't require `H` to be impartial. -/
lemma equiv_iff_add_equiv_zero' (H : pgame) : G ≈ H ↔ G + H ≈ 0 :=
by { rw [equiv_iff_game_eq, equiv_iff_game_eq, ←@add_left_cancel_iff _ _ _ (-⟦G⟧), eq_comm], simpa }

lemma le_zero_iff {G : pgame} [G.impartial] : G ≤ 0 ↔ 0 ≤ G :=
by rw [←zero_le_neg_iff, le_congr_right (neg_equiv_self G)]

lemma equiv_zero_iff_le: G ≈ 0 ↔ G ≤ 0 := ⟨and.left, λ h, ⟨h, le_zero_iff.1 h⟩⟩
lemma fuzzy_zero_iff_lf : G ‖ 0 ↔ G ⧏ 0 := ⟨and.left, λ h, ⟨h, lf_zero_iff.1 h⟩⟩
lemma equiv_zero_iff_ge : G ≈ 0 ↔ 0 ≤ G := ⟨and.right, λ h, ⟨le_zero_iff.2 h, h⟩⟩
lemma fuzzy_zero_iff_gf : G ‖ 0 ↔ 0 ⧏ G := ⟨and.right, λ h, ⟨lf_zero_iff.2 h, h⟩⟩

lemma forall_left_moves_fuzzy_iff_equiv_zero : (∀ i, G.move_left i ‖ 0) ↔ G ≈ 0 :=
begin
  refine ⟨λ hb, _, λ hp i, _⟩,
  { rw [equiv_zero_iff_le G, le_zero_lf],
    exact λ i, (hb i).1 },
  { rw fuzzy_zero_iff_lf,
    exact hp.1.move_left_lf i }
end

lemma forall_right_moves_fuzzy_iff_equiv_zero : (∀ j, G.move_right j ‖ 0) ↔ G ≈ 0 :=
begin
  refine ⟨λ hb, _, λ hp i, _⟩,
  { rw [equiv_zero_iff_ge G, zero_le_lf],
    exact λ i, (hb i).2 },
  { rw fuzzy_zero_iff_gf,
    exact hp.2.lf_move_right i }
end

lemma exists_left_move_equiv_iff_fuzzy_zero : (∃ i, G.move_left i ≈ 0) ↔ G ‖ 0 :=
begin
  refine ⟨λ ⟨i, hi⟩, (fuzzy_zero_iff_gf G).2 (lf_of_le_move_left hi.2), λ hn, _⟩,
  rw [fuzzy_zero_iff_gf G, zero_lf_le] at hn,
  cases hn with i hi,
  exact ⟨i, (equiv_zero_iff_ge _).2 hi⟩
end

lemma exists_right_move_equiv_iff_fuzzy_zero : (∃ j, G.move_right j ≈ 0) ↔ G ‖ 0 :=
begin
  refine ⟨λ ⟨i, hi⟩, (fuzzy_zero_iff_lf G).2 (lf_of_move_right_le hi.1), λ hn, _⟩,
  rw [fuzzy_zero_iff_lf G, lf_zero_le] at hn,
  cases hn with i hi,
  exact ⟨i, (equiv_zero_iff_le _).2 hi⟩
end

end impartial
end pgame


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

! This file was ported from Lean 3 source module group_theory.free_abelian_group_finsupp
! leanprover-community/mathlib commit 47b51515e69f59bca5cf34ef456e6000fe205a69
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Hom.Equiv.TypeTags
import Mathbin.Algebra.Module.Equiv
import Mathbin.Data.Finsupp.Defs
import Mathbin.GroupTheory.FreeAbelianGroup
import Mathbin.GroupTheory.IsFreeGroup
import Mathbin.LinearAlgebra.Dimension

/-!
# Isomorphism between `free_abelian_group X` and `X →₀ ℤ`

In this file we construct the canonical isomorphism between `free_abelian_group X` and `X →₀ ℤ`.
We use this to transport the notion of `support` from `finsupp` to `free_abelian_group`.

## Main declarations

- `free_abelian_group.equiv_finsupp`: group isomorphism between `free_abelian_group X` and `X →₀ ℤ`
- `free_abelian_group.coeff`: the multiplicity of `x : X` in `a : free_abelian_group X`
- `free_abelian_group.support`: the finset of `x : X` that occur in `a : free_abelian_group X`

-/

noncomputable section

open BigOperators

variable {X : Type _}

/-- The group homomorphism `free_abelian_group X →+ (X →₀ ℤ)`. -/
def FreeAbelianGroup.toFinsupp : FreeAbelianGroup X →+ X →₀ ℤ :=
  FreeAbelianGroup.lift fun x => Finsupp.single x (1 : ℤ)
#align free_abelian_group.to_finsupp FreeAbelianGroup.toFinsupp

/-- The group homomorphism `(X →₀ ℤ) →+ free_abelian_group X`. -/
def Finsupp.toFreeAbelianGroup : (X →₀ ℤ) →+ FreeAbelianGroup X :=
  Finsupp.liftAddHom fun x => (smulAddHom ℤ (FreeAbelianGroup X)).flip (FreeAbelianGroup.of x)
#align finsupp.to_free_abelian_group Finsupp.toFreeAbelianGroup

open Finsupp FreeAbelianGroup

@[simp]
theorem Finsupp.toFreeAbelianGroup_comp_singleAddHom (x : X) :
    Finsupp.toFreeAbelianGroup.comp (Finsupp.singleAddHom x) =
      (smulAddHom ℤ (FreeAbelianGroup X)).flip (of x) :=
  by
  ext
  simp only [AddMonoidHom.coe_comp, Finsupp.singleAddHom_apply, Function.comp_apply, one_smul,
    to_free_abelian_group, Finsupp.liftAddHom_apply_single]
#align finsupp.to_free_abelian_group_comp_single_add_hom Finsupp.toFreeAbelianGroup_comp_singleAddHom

@[simp]
theorem FreeAbelianGroup.toFinsupp_comp_toFreeAbelianGroup :
    toFinsupp.comp toFreeAbelianGroup = AddMonoidHom.id (X →₀ ℤ) :=
  by
  ext (x y); simp only [AddMonoidHom.id_comp]
  rw [AddMonoidHom.comp_assoc, Finsupp.toFreeAbelianGroup_comp_singleAddHom]
  simp only [to_finsupp, AddMonoidHom.coe_comp, Finsupp.singleAddHom_apply, Function.comp_apply,
    one_smul, lift.of, AddMonoidHom.flip_apply, smulAddHom_apply, AddMonoidHom.id_apply]
#align free_abelian_group.to_finsupp_comp_to_free_abelian_group FreeAbelianGroup.toFinsupp_comp_toFreeAbelianGroup

@[simp]
theorem Finsupp.toFreeAbelianGroup_comp_toFinsupp :
    toFreeAbelianGroup.comp toFinsupp = AddMonoidHom.id (FreeAbelianGroup X) :=
  by
  ext
  rw [to_free_abelian_group, to_finsupp, AddMonoidHom.comp_apply, lift.of,
    lift_add_hom_apply_single, AddMonoidHom.flip_apply, smulAddHom_apply, one_smul,
    AddMonoidHom.id_apply]
#align finsupp.to_free_abelian_group_comp_to_finsupp Finsupp.toFreeAbelianGroup_comp_toFinsupp

@[simp]
theorem Finsupp.toFreeAbelianGroup_toFinsupp {X} (x : FreeAbelianGroup X) :
    x.toFinsupp.toFreeAbelianGroup = x := by
  rw [← AddMonoidHom.comp_apply, Finsupp.toFreeAbelianGroup_comp_toFinsupp, AddMonoidHom.id_apply]
#align finsupp.to_free_abelian_group_to_finsupp Finsupp.toFreeAbelianGroup_toFinsupp

namespace FreeAbelianGroup

open Finsupp

variable {X}

@[simp]
theorem toFinsupp_of (x : X) : toFinsupp (of x) = Finsupp.single x 1 := by
  simp only [to_finsupp, lift.of]
#align free_abelian_group.to_finsupp_of FreeAbelianGroup.toFinsupp_of

@[simp]
theorem toFinsupp_toFreeAbelianGroup (f : X →₀ ℤ) : f.toFreeAbelianGroup.toFinsupp = f := by
  rw [← AddMonoidHom.comp_apply, to_finsupp_comp_to_free_abelian_group, AddMonoidHom.id_apply]
#align free_abelian_group.to_finsupp_to_free_abelian_group FreeAbelianGroup.toFinsupp_toFreeAbelianGroup

variable (X)

/-- The additive equivalence between `free_abelian_group X` and `(X →₀ ℤ)`. -/
@[simps]
def equivFinsupp : FreeAbelianGroup X ≃+ (X →₀ ℤ)
    where
  toFun := toFinsupp
  invFun := toFreeAbelianGroup
  left_inv := toFreeAbelianGroup_toFinsupp
  right_inv := toFinsupp_toFreeAbelianGroup
  map_add' := toFinsupp.map_add
#align free_abelian_group.equiv_finsupp FreeAbelianGroup.equivFinsupp

/-- `A` is a basis of the ℤ-module `free_abelian_group A`. -/
noncomputable def basis (α : Type _) : Basis α ℤ (FreeAbelianGroup α) :=
  ⟨(FreeAbelianGroup.equivFinsupp α).toIntLinearEquiv⟩
#align free_abelian_group.basis FreeAbelianGroup.basis

/-- Isomorphic free ablian groups (as modules) have equivalent bases. -/
def Equiv.ofFreeAbelianGroupLinearEquiv {α β : Type _}
    (e : FreeAbelianGroup α ≃ₗ[ℤ] FreeAbelianGroup β) : α ≃ β :=
  let t : Basis α ℤ (FreeAbelianGroup β) := (FreeAbelianGroup.basis α).map e
  t.indexEquiv <| FreeAbelianGroup.basis _
#align free_abelian_group.equiv.of_free_abelian_group_linear_equiv FreeAbelianGroup.Equiv.ofFreeAbelianGroupLinearEquiv

/-- Isomorphic free abelian groups (as additive groups) have equivalent bases. -/
def Equiv.ofFreeAbelianGroupEquiv {α β : Type _} (e : FreeAbelianGroup α ≃+ FreeAbelianGroup β) :
    α ≃ β :=
  Equiv.ofFreeAbelianGroupLinearEquiv e.toIntLinearEquiv
#align free_abelian_group.equiv.of_free_abelian_group_equiv FreeAbelianGroup.Equiv.ofFreeAbelianGroupEquiv

/-- Isomorphic free groups have equivalent bases. -/
def Equiv.ofFreeGroupEquiv {α β : Type _} (e : FreeGroup α ≃* FreeGroup β) : α ≃ β :=
  Equiv.ofFreeAbelianGroupEquiv e.abelianizationCongr.toAdditive
#align free_abelian_group.equiv.of_free_group_equiv FreeAbelianGroup.Equiv.ofFreeGroupEquiv

open IsFreeGroup

/-- Isomorphic free groups have equivalent bases (`is_free_group` variant`). -/
def Equiv.ofIsFreeGroupEquiv {G H : Type _} [Group G] [Group H] [IsFreeGroup G] [IsFreeGroup H]
    (e : G ≃* H) : Generators G ≃ Generators H :=
  Equiv.ofFreeGroupEquiv <| MulEquiv.trans (toFreeGroup G).symm <| MulEquiv.trans e <| toFreeGroup H
#align free_abelian_group.equiv.of_is_free_group_equiv FreeAbelianGroup.Equiv.ofIsFreeGroupEquiv

variable {X}

/-- `coeff x` is the additive group homomorphism `free_abelian_group X →+ ℤ`
that sends `a` to the multiplicity of `x : X` in `a`. -/
def coeff (x : X) : FreeAbelianGroup X →+ ℤ :=
  (Finsupp.applyAddHom x).comp toFinsupp
#align free_abelian_group.coeff FreeAbelianGroup.coeff

/-- `support a` for `a : free_abelian_group X` is the finite set of `x : X`
that occur in the formal sum `a`. -/
def support (a : FreeAbelianGroup X) : Finset X :=
  a.toFinsupp.support
#align free_abelian_group.support FreeAbelianGroup.support

theorem mem_support_iff (x : X) (a : FreeAbelianGroup X) : x ∈ a.support ↔ coeff x a ≠ 0 :=
  by
  rw [support, Finsupp.mem_support_iff]
  exact Iff.rfl
#align free_abelian_group.mem_support_iff FreeAbelianGroup.mem_support_iff

theorem not_mem_support_iff (x : X) (a : FreeAbelianGroup X) : x ∉ a.support ↔ coeff x a = 0 :=
  by
  rw [support, Finsupp.not_mem_support_iff]
  exact Iff.rfl
#align free_abelian_group.not_mem_support_iff FreeAbelianGroup.not_mem_support_iff

@[simp]
theorem support_zero : support (0 : FreeAbelianGroup X) = ∅ := by
  simp only [support, Finsupp.support_zero, AddMonoidHom.map_zero]
#align free_abelian_group.support_zero FreeAbelianGroup.support_zero

@[simp]
theorem support_of (x : X) : support (of x) = {x} := by
  simp only [support, to_finsupp_of, Finsupp.support_single_ne_zero _ one_ne_zero]
#align free_abelian_group.support_of FreeAbelianGroup.support_of

@[simp]
theorem support_neg (a : FreeAbelianGroup X) : support (-a) = support a := by
  simp only [support, AddMonoidHom.map_neg, Finsupp.support_neg]
#align free_abelian_group.support_neg FreeAbelianGroup.support_neg

@[simp]
theorem support_zsmul (k : ℤ) (h : k ≠ 0) (a : FreeAbelianGroup X) : support (k • a) = support a :=
  by
  ext x
  simp only [mem_support_iff, AddMonoidHom.map_zsmul]
  simp only [h, zsmul_int_int, false_or_iff, Ne.def, mul_eq_zero]
#align free_abelian_group.support_zsmul FreeAbelianGroup.support_zsmul

@[simp]
theorem support_nsmul (k : ℕ) (h : k ≠ 0) (a : FreeAbelianGroup X) : support (k • a) = support a :=
  by
  apply support_zsmul k _ a
  exact_mod_cast h
#align free_abelian_group.support_nsmul FreeAbelianGroup.support_nsmul

open Classical

theorem support_add (a b : FreeAbelianGroup X) : support (a + b) ⊆ a.support ∪ b.support :=
  by
  simp only [support, AddMonoidHom.map_add]
  apply Finsupp.support_add
#align free_abelian_group.support_add FreeAbelianGroup.support_add

end FreeAbelianGroup


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

! This file was ported from Lean 3 source module analysis.calculus.conformal.normed_space
! leanprover-community/mathlib commit df78eae582aad2f545024bf6c7249191d2723074
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.NormedSpace.ConformalLinearMap
import Mathbin.Analysis.Calculus.Fderiv

/-!
# Conformal Maps

A continuous linear map between real normed spaces `X` and `Y` is `conformal_at` some point `x`
if it is real differentiable at that point and its differential `is_conformal_linear_map`.

## Main definitions

* `conformal_at`: the main definition of conformal maps
* `conformal`: maps that are conformal at every point
* `conformal_factor_at`: the conformal factor of a conformal map at some point

## Main results
* The conformality of the composition of two conformal maps, the identity map
  and multiplications by nonzero constants
* `conformal_at_iff_is_conformal_map_fderiv`: an equivalent definition of the conformality of a map

In `analysis.calculus.conformal.inner_product`:
* `conformal_at_iff`: an equivalent definition of the conformality of a map

In `geometry.euclidean.angle.unoriented.conformal`:
* `conformal_at.preserves_angle`: if a map is conformal at `x`, then its differential
                                  preserves all angles at `x`

## Tags

conformal

## Warning

The definition of conformality in this file does NOT require the maps to be orientation-preserving.
Maps such as the complex conjugate are considered to be conformal.
-/

noncomputable section

variable {X Y Z : Type _} [NormedAddCommGroup X] [NormedAddCommGroup Y] [NormedAddCommGroup Z]
  [NormedSpace ℝ X] [NormedSpace ℝ Y] [NormedSpace ℝ Z]

section LocConformality

open LinearIsometry ContinuousLinearMap

/-- A map `f` is said to be conformal if it has a conformal differential `f'`. -/
def ConformalAt (f : X → Y) (x : X) :=
  ∃ f' : X →L[ℝ] Y, HasFderivAt f f' x ∧ IsConformalMap f'
#align conformal_at ConformalAt

theorem conformalAt_id (x : X) : ConformalAt id x :=
  ⟨id ℝ X, hasFderivAt_id _, isConformalMap_id⟩
#align conformal_at_id conformalAt_id

theorem conformalAt_const_smul {c : ℝ} (h : c ≠ 0) (x : X) : ConformalAt (fun x' : X => c • x') x :=
  ⟨c • ContinuousLinearMap.id ℝ X, (hasFderivAt_id x).const_smul c, isConformalMap_const_smul h⟩
#align conformal_at_const_smul conformalAt_const_smul

@[nontriviality]
theorem Subsingleton.conformalAt [Subsingleton X] (f : X → Y) (x : X) : ConformalAt f x :=
  ⟨0, hasFderivAt_of_subsingleton _ _, isConformalMap_of_subsingleton _⟩
#align subsingleton.conformal_at Subsingleton.conformalAt

/-- A function is a conformal map if and only if its differential is a conformal linear map-/
theorem conformalAt_iff_isConformalMap_fderiv {f : X → Y} {x : X} :
    ConformalAt f x ↔ IsConformalMap (fderiv ℝ f x) :=
  by
  constructor
  · rintro ⟨f', hf, hf'⟩
    rwa [hf.fderiv]
  · intro H
    by_cases h : DifferentiableAt ℝ f x
    · exact ⟨fderiv ℝ f x, h.has_fderiv_at, H⟩
    · nontriviality X
      exact absurd (fderiv_zero_of_not_differentiableAt h) H.ne_zero
#align conformal_at_iff_is_conformal_map_fderiv conformalAt_iff_isConformalMap_fderiv

namespace ConformalAt

theorem differentiableAt {f : X → Y} {x : X} (h : ConformalAt f x) : DifferentiableAt ℝ f x :=
  let ⟨_, h₁, _⟩ := h
  h₁.DifferentiableAt
#align conformal_at.differentiable_at ConformalAt.differentiableAt

theorem congr {f g : X → Y} {x : X} {u : Set X} (hx : x ∈ u) (hu : IsOpen u) (hf : ConformalAt f x)
    (h : ∀ x : X, x ∈ u → g x = f x) : ConformalAt g x :=
  let ⟨f', hfderiv, hf'⟩ := hf
  ⟨f', hfderiv.congr_of_eventuallyEq ((hu.eventually_mem hx).mono h), hf'⟩
#align conformal_at.congr ConformalAt.congr

theorem comp {f : X → Y} {g : Y → Z} (x : X) (hg : ConformalAt g (f x)) (hf : ConformalAt f x) :
    ConformalAt (g ∘ f) x := by
  rcases hf with ⟨f', hf₁, cf⟩
  rcases hg with ⟨g', hg₁, cg⟩
  exact ⟨g'.comp f', hg₁.comp x hf₁, cg.comp cf⟩
#align conformal_at.comp ConformalAt.comp

theorem const_smul {f : X → Y} {x : X} {c : ℝ} (hc : c ≠ 0) (hf : ConformalAt f x) :
    ConformalAt (c • f) x :=
  (conformalAt_const_smul hc <| f x).comp x hf
#align conformal_at.const_smul ConformalAt.const_smul

end ConformalAt

end LocConformality

section GlobalConformality

/-- A map `f` is conformal if it's conformal at every point. -/
def Conformal (f : X → Y) :=
  ∀ x : X, ConformalAt f x
#align conformal Conformal

theorem conformal_id : Conformal (id : X → X) := fun x => conformalAt_id x
#align conformal_id conformal_id

theorem conformal_const_smul {c : ℝ} (h : c ≠ 0) : Conformal fun x : X => c • x := fun x =>
  conformalAt_const_smul h x
#align conformal_const_smul conformal_const_smul

namespace Conformal

theorem conformalAt {f : X → Y} (h : Conformal f) (x : X) : ConformalAt f x :=
  h x
#align conformal.conformal_at Conformal.conformalAt

theorem differentiable {f : X → Y} (h : Conformal f) : Differentiable ℝ f := fun x =>
  (h x).DifferentiableAt
#align conformal.differentiable Conformal.differentiable

theorem comp {f : X → Y} {g : Y → Z} (hf : Conformal f) (hg : Conformal g) : Conformal (g ∘ f) :=
  fun x => (hg <| f x).comp x (hf x)
#align conformal.comp Conformal.comp

theorem const_smul {f : X → Y} (hf : Conformal f) {c : ℝ} (hc : c ≠ 0) : Conformal (c • f) :=
  fun x => (hf x).const_smul hc
#align conformal.const_smul Conformal.const_smul

end Conformal

end GlobalConformality


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Johan Commelin, Mario Carneiro
-/
import algebra.big_operators.order
import data.mv_polynomial.monad
import data.set.pairwise

/-!
# Degrees and variables of polynomials

This file establishes many results about the degree and variable sets of a multivariate polynomial.

The *variable set* of a polynomial $P \in R[X]$ is a `finset` containing each $x \in X$
that appears in a monomial in $P$.

The *degree set* of a polynomial $P \in R[X]$ is a `multiset` containing, for each $x$ in the
variable set, $n$ copies of $x$, where $n$ is the maximum number of copies of $x$ appearing in a
monomial of $P$.

## Main declarations

* `mv_polynomial.degrees p` : the multiset of variables representing the union of the multisets
  corresponding to each non-zero monomial in `p`.
  For example if `7 ≠ 0` in `R` and `p = x²y+7y³` then `degrees p = {x, x, y, y, y}`

* `mv_polynomial.vars p` : the finset of variables occurring in `p`.
  For example if `p = x⁴y+yz` then `vars p = {x, y, z}`

* `mv_polynomial.degree_of n p : ℕ` : the total degree of `p` with respect to the variable `n`.
  For example if `p = x⁴y+yz` then `degree_of y p = 1`.

* `mv_polynomial.total_degree p : ℕ` :
  the max of the sizes of the multisets `s` whose monomials `X^s` occur in `p`.
  For example if `p = x⁴y+yz` then `total_degree p = 5`.

## Notation

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

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

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

+ `s : σ →₀ ℕ`, a function from `σ` to `ℕ` which is zero away from a finite set.
This will give rise to a monomial in `mv_polynomial σ R` which mathematicians might call `X^s`

+ `r : R`

+ `i : σ`, with corresponding monomial `X i`, often denoted `X_i` by mathematicians

+ `p : mv_polynomial σ R`

-/

noncomputable theory

open_locale classical big_operators

open set function finsupp add_monoid_algebra
open_locale big_operators

universes u v w
variables {R : Type u} {S : Type v}

namespace mv_polynomial
variables {σ τ : Type*} {r : R} {e : ℕ} {n m : σ} {s : σ →₀ ℕ}

section comm_semiring
variables [comm_semiring R] {p q : mv_polynomial σ R}

section degrees

/-! ### `degrees` -/

/--
The maximal degrees of each variable in a multi-variable polynomial, expressed as a multiset.

(For example, `degrees (x^2 * y + y^3)` would be `{x, x, y, y, y}`.)
-/
def degrees (p : mv_polynomial σ R) : multiset σ :=
p.support.sup (λs:σ →₀ ℕ, s.to_multiset)

lemma degrees_monomial (s : σ →₀ ℕ) (a : R) : degrees (monomial s a) ≤ s.to_multiset :=
finset.sup_le $ assume t h,
begin
  have := finsupp.support_single_subset h,
  rw [finset.mem_singleton] at this,
  rw this
end

lemma degrees_monomial_eq (s : σ →₀ ℕ) (a : R) (ha : a ≠ 0) :
  degrees (monomial s a) = s.to_multiset :=
le_antisymm (degrees_monomial s a) $ finset.le_sup $
  by rw [support_monomial, if_neg ha, finset.mem_singleton]

lemma degrees_C (a : R) : degrees (C a : mv_polynomial σ R) = 0 :=
multiset.le_zero.1 $ degrees_monomial _ _

lemma degrees_X' (n : σ) : degrees (X n : mv_polynomial σ R) ≤ {n} :=
le_trans (degrees_monomial _ _) $ le_of_eq $ to_multiset_single _ _

@[simp] lemma degrees_X [nontrivial R] (n : σ) : degrees (X n : mv_polynomial σ R) = {n} :=
(degrees_monomial_eq _ (1 : R) one_ne_zero).trans (to_multiset_single _ _)

@[simp] lemma degrees_zero : degrees (0 : mv_polynomial σ R) = 0 :=
by { rw ← C_0, exact degrees_C 0 }

@[simp] lemma degrees_one : degrees (1 : mv_polynomial σ R) = 0 := degrees_C 1

lemma degrees_add (p q : mv_polynomial σ R) : (p + q).degrees ≤ p.degrees ⊔ q.degrees :=
begin
  refine finset.sup_le (assume b hb, _),
  have := finsupp.support_add hb, rw finset.mem_union at this,
  cases this,
  { exact le_sup_of_le_left (finset.le_sup this) },
  { exact le_sup_of_le_right (finset.le_sup this) },
end

lemma degrees_sum {ι : Type*} (s : finset ι) (f : ι → mv_polynomial σ R) :
  (∑ i in s, f i).degrees ≤ s.sup (λi, (f i).degrees) :=
begin
  refine s.induction _ _,
  { simp only [finset.sum_empty, finset.sup_empty, degrees_zero], exact le_refl _ },
  { assume i s his ih,
    rw [finset.sup_insert, finset.sum_insert his],
    exact le_trans (degrees_add _ _) (sup_le_sup_left ih _) }
end

lemma degrees_mul (p q : mv_polynomial σ R) : (p * q).degrees ≤ p.degrees + q.degrees :=
begin
  refine finset.sup_le (assume b hb, _),
  have := support_mul p q hb,
  simp only [finset.mem_bUnion, finset.mem_singleton] at this,
  rcases this with ⟨a₁, h₁, a₂, h₂, rfl⟩,
  rw [finsupp.to_multiset_add],
  exact add_le_add (finset.le_sup h₁) (finset.le_sup h₂)
end

lemma degrees_prod {ι : Type*} (s : finset ι) (f : ι → mv_polynomial σ R) :
  (∏ i in s, f i).degrees ≤ ∑ i in s, (f i).degrees :=
begin
  refine s.induction _ _,
  { simp only [finset.prod_empty, finset.sum_empty, degrees_one] },
  { assume i s his ih,
    rw [finset.prod_insert his, finset.sum_insert his],
    exact le_trans (degrees_mul _ _) (add_le_add_left ih _) }
end

lemma degrees_pow (p : mv_polynomial σ R) :
  ∀(n : ℕ), (p^n).degrees ≤ n • p.degrees
| 0       := begin rw [pow_zero, degrees_one], exact multiset.zero_le _ end
| (n + 1) := by { rw [pow_succ, add_smul, add_comm, one_smul],
    exact le_trans (degrees_mul _ _) (add_le_add_left (degrees_pow n) _) }

lemma mem_degrees {p : mv_polynomial σ R} {i : σ} :
  i ∈ p.degrees ↔ ∃ d, p.coeff d ≠ 0 ∧ i ∈ d.support :=
by simp only [degrees, multiset.mem_sup, ← mem_support_iff,
    finsupp.mem_to_multiset, exists_prop]

lemma le_degrees_add {p q : mv_polynomial σ R} (h : p.degrees.disjoint q.degrees) :
  p.degrees ≤ (p + q).degrees :=
begin
  apply finset.sup_le,
  intros d hd,
  rw multiset.disjoint_iff_ne at h,
  rw multiset.le_iff_count,
  intros i,
  rw [degrees, multiset.count_sup],
  simp only [finsupp.count_to_multiset],
  by_cases h0 : d = 0,
  { simp only [h0, zero_le, finsupp.zero_apply], },
  { refine @finset.le_sup _ _ _ _ (p + q).support _ d _,
    rw [mem_support_iff, coeff_add],
    suffices : q.coeff d = 0,
    { rwa [this, add_zero, coeff, ← finsupp.mem_support_iff], },
    rw [← finsupp.support_eq_empty, ← ne.def, ← finset.nonempty_iff_ne_empty] at h0,
    obtain ⟨j, hj⟩ := h0,
    contrapose! h,
    rw mem_support_iff at hd,
    refine ⟨j, _, j, _, rfl⟩,
    all_goals { rw mem_degrees, refine ⟨d, _, hj⟩, assumption } }
end

lemma degrees_add_of_disjoint
  {p q : mv_polynomial σ R} (h : multiset.disjoint p.degrees q.degrees) :
  (p + q).degrees = p.degrees ∪ q.degrees :=
begin
  apply le_antisymm,
  { apply degrees_add },
  { apply multiset.union_le,
    { apply le_degrees_add h },
    { rw add_comm, apply le_degrees_add h.symm } }
end

lemma degrees_map [comm_semiring S] (p : mv_polynomial σ R) (f : R →+* S) :
  (map f p).degrees ⊆ p.degrees :=
begin
  dsimp only [degrees],
  apply multiset.subset_of_le,
  apply finset.sup_mono,
  apply mv_polynomial.support_map_subset
end

lemma degrees_rename (f : σ → τ) (φ : mv_polynomial σ R) :
  (rename f φ).degrees ⊆ (φ.degrees.map f) :=
begin
  intros i,
  rw [mem_degrees, multiset.mem_map],
  rintro ⟨d, hd, hi⟩,
  obtain ⟨x, rfl, hx⟩ := coeff_rename_ne_zero _ _ _ hd,
  simp only [map_domain, finsupp.mem_support_iff] at hi,
  rw [sum_apply, finsupp.sum] at hi,
  contrapose! hi,
  rw [finset.sum_eq_zero],
  intros j hj,
  simp only [exists_prop, mem_degrees] at hi,
  specialize hi j ⟨x, hx, hj⟩,
  rw [single_apply, if_neg hi],
end

lemma degrees_map_of_injective [comm_semiring S] (p : mv_polynomial σ R)
  {f : R →+* S} (hf : injective f) : (map f p).degrees = p.degrees :=
by simp only [degrees, mv_polynomial.support_map_of_injective _ hf]

end degrees

section vars

/-! ### `vars` -/

/-- `vars p` is the set of variables appearing in the polynomial `p` -/
def vars (p : mv_polynomial σ R) : finset σ := p.degrees.to_finset

@[simp] lemma vars_0 : (0 : mv_polynomial σ R).vars = ∅ :=
by rw [vars, degrees_zero, multiset.to_finset_zero]

@[simp] lemma vars_monomial (h : r ≠ 0) : (monomial s r).vars = s.support :=
by rw [vars, degrees_monomial_eq _ _ h, finsupp.to_finset_to_multiset]

@[simp] lemma vars_C : (C r : mv_polynomial σ R).vars = ∅ :=
by rw [vars, degrees_C, multiset.to_finset_zero]

@[simp] lemma vars_X [nontrivial R] : (X n : mv_polynomial σ R).vars = {n} :=
by rw [X, vars_monomial (@one_ne_zero R _ _), finsupp.support_single_ne_zero (one_ne_zero : 1 ≠ 0)]

lemma mem_vars (i : σ) :
  i ∈ p.vars ↔ ∃ (d : σ →₀ ℕ) (H : d ∈ p.support), i ∈ d.support :=
by simp only [vars, multiset.mem_to_finset, mem_degrees, mem_support_iff,
  exists_prop]

lemma mem_support_not_mem_vars_zero
  {f : mv_polynomial σ R} {x : σ →₀ ℕ} (H : x ∈ f.support) {v : σ} (h : v ∉ vars f) :
  x v = 0 :=
begin
  rw [vars, multiset.mem_to_finset] at h,
  rw ← finsupp.not_mem_support_iff,
  contrapose! h,
  unfold degrees,
  rw (show f.support = insert x f.support, from eq.symm $ finset.insert_eq_of_mem H),
  rw finset.sup_insert,
  simp only [multiset.mem_union, multiset.sup_eq_union],
  left,
  rwa [←to_finset_to_multiset, multiset.mem_to_finset] at h,
end

lemma vars_add_subset (p q : mv_polynomial σ R) :
  (p + q).vars ⊆ p.vars ∪ q.vars :=
begin
  intros x hx,
  simp only [vars, finset.mem_union, multiset.mem_to_finset] at hx ⊢,
  simpa using multiset.mem_of_le (degrees_add _ _) hx,
end

section mul

lemma vars_mul (φ ψ : mv_polynomial σ R) : (φ * ψ).vars ⊆ φ.vars ∪ ψ.vars :=
begin
  intro i,
  simp only [mem_vars, finset.mem_union],
  rintro ⟨d, hd, hi⟩,
  rw [mem_support_iff, coeff_mul] at hd,
  contrapose! hd, cases hd,
  rw finset.sum_eq_zero,
  rintro ⟨d₁, d₂⟩ H,
  rw finsupp.mem_antidiagonal at H,
  subst H,
  obtain H|H : i ∈ d₁.support ∨ i ∈ d₂.support,
  { simpa only [finset.mem_union] using finsupp.support_add hi, },
  { suffices : coeff d₁ φ = 0, by simp [this],
    rw [coeff, ← finsupp.not_mem_support_iff], intro, solve_by_elim, },
  { suffices : coeff d₂ ψ = 0, by simp [this],
    rw [coeff, ← finsupp.not_mem_support_iff], intro, solve_by_elim, },
end

@[simp] lemma vars_one : (1 : mv_polynomial σ R).vars = ∅ :=
vars_C

lemma vars_pow (φ : mv_polynomial σ R) (n : ℕ) : (φ ^ n).vars ⊆ φ.vars :=
begin
  induction n with n ih,
  { simp },
  { rw pow_succ,
    apply finset.subset.trans (vars_mul _ _),
    exact finset.union_subset (finset.subset.refl _) ih }
end

/--
The variables of the product of a family of polynomials
are a subset of the union of the sets of variables of each polynomial.
-/
lemma vars_prod {ι : Type*} {s : finset ι} (f : ι → mv_polynomial σ R) :
  (∏ i in s, f i).vars ⊆ s.bUnion (λ i, (f i).vars) :=
begin
  apply s.induction_on,
  { simp },
  { intros a s hs hsub,
    simp only [hs, finset.bUnion_insert, finset.prod_insert, not_false_iff],
    apply finset.subset.trans (vars_mul _ _),
    exact finset.union_subset_union (finset.subset.refl _) hsub }
end

section is_domain
variables {A : Type*} [comm_ring A] [is_domain A]

lemma vars_C_mul (a : A) (ha : a ≠ 0) (φ : mv_polynomial σ A) : (C a * φ).vars = φ.vars :=
begin
  ext1 i,
  simp only [mem_vars, exists_prop, mem_support_iff],
  apply exists_congr,
  intro d,
  apply and_congr _ iff.rfl,
  rw [coeff_C_mul, mul_ne_zero_iff, eq_true_intro ha, true_and],
end

end is_domain

end mul

section sum

variables {ι : Type*} (t : finset ι) (φ : ι → mv_polynomial σ R)

lemma vars_sum_subset :
  (∑ i in t, φ i).vars ⊆ finset.bUnion t (λ i, (φ i).vars) :=
begin
  apply t.induction_on,
  { simp },
  { intros a s has hsum,
    rw [finset.bUnion_insert, finset.sum_insert has],
    refine finset.subset.trans (vars_add_subset _ _)
      (finset.union_subset_union (finset.subset.refl _) _),
    assumption }
end

lemma vars_sum_of_disjoint (h : pairwise $ disjoint on (λ i, (φ i).vars)) :
  (∑ i in t, φ i).vars = finset.bUnion t (λ i, (φ i).vars) :=
begin
  apply t.induction_on,
  { simp },
  { intros a s has hsum,
    rw [finset.bUnion_insert, finset.sum_insert has, vars_add_of_disjoint, hsum],
    unfold pairwise on_fun at h,
    rw hsum,
    simp only [finset.disjoint_iff_ne] at h ⊢,
    intros v hv v2 hv2,
    rw finset.mem_bUnion at hv2,
    rcases hv2 with ⟨i, his, hi⟩,
    refine h a i _ _ hv _ hi,
    rintro rfl,
    contradiction }
end

end sum

section map

variables [comm_semiring S] (f : R →+* S)
variable (p)

lemma vars_map : (map f p).vars ⊆ p.vars :=
by simp [vars, degrees_map]

variable {f}
lemma vars_map_of_injective (hf : injective f) :
  (map f p).vars = p.vars :=
by simp [vars, degrees_map_of_injective _ hf]

lemma vars_monomial_single (i : σ) {e : ℕ} {r : R} (he : e ≠ 0) (hr : r ≠ 0) :
  (monomial (finsupp.single i e) r).vars = {i} :=
by rw [vars_monomial hr, finsupp.support_single_ne_zero he]

lemma vars_eq_support_bUnion_support : p.vars = p.support.bUnion finsupp.support :=
by { ext i, rw [mem_vars, finset.mem_bUnion] }

end map

end vars

section degree_of

/-! ### `degree_of` -/

/-- `degree_of n p` gives the highest power of X_n that appears in `p` -/
def degree_of (n : σ) (p : mv_polynomial σ R) : ℕ := p.degrees.count n

end degree_of

section total_degree

/-! ### `total_degree` -/

/-- `total_degree p` gives the maximum |s| over the monomials X^s in `p` -/
def total_degree (p : mv_polynomial σ R) : ℕ := p.support.sup (λs, s.sum $ λn e, e)

lemma total_degree_eq (p : mv_polynomial σ R) :
  p.total_degree = p.support.sup (λm, m.to_multiset.card) :=
begin
  rw [total_degree],
  congr, funext m,
  exact (finsupp.card_to_multiset _).symm
end

lemma total_degree_le_degrees_card (p : mv_polynomial σ R) :
  p.total_degree ≤ p.degrees.card :=
begin
  rw [total_degree_eq],
  exact finset.sup_le (assume s hs, multiset.card_le_of_le $ finset.le_sup hs)
end

@[simp] lemma total_degree_C (a : R) : (C a : mv_polynomial σ R).total_degree = 0 :=
nat.eq_zero_of_le_zero $ finset.sup_le $ assume n hn,
  have _ := finsupp.support_single_subset hn,
  begin
    rw [finset.mem_singleton] at this,
    subst this,
    exact le_refl _
  end

@[simp] lemma total_degree_zero : (0 : mv_polynomial σ R).total_degree = 0 :=
by rw [← C_0]; exact total_degree_C (0 : R)

@[simp] lemma total_degree_one : (1 : mv_polynomial σ R).total_degree = 0 :=
total_degree_C (1 : R)

@[simp] lemma total_degree_X {R} [comm_semiring R] [nontrivial R] (s : σ) :
  (X s : mv_polynomial σ R).total_degree = 1 :=
begin
  rw [total_degree, support_X],
  simp only [finset.sup, sum_single_index, finset.fold_singleton, sup_bot_eq],
end

lemma total_degree_add (a b : mv_polynomial σ R) :
  (a + b).total_degree ≤ max a.total_degree b.total_degree :=
finset.sup_le $ assume n hn,
  have _ := finsupp.support_add hn,
  begin
    rw finset.mem_union at this,
    cases this,
    { exact le_max_of_le_left (finset.le_sup this) },
    { exact le_max_of_le_right (finset.le_sup this) }
  end

lemma total_degree_add_eq_left_of_total_degree_lt {p q : mv_polynomial σ R}
  (h : q.total_degree < p.total_degree) : (p + q).total_degree = p.total_degree :=
begin
  classical,
  apply le_antisymm,
  { rw ← max_eq_left_of_lt h,
    exact total_degree_add p q, },
  by_cases hp : p = 0,
  { simp [hp], },
  obtain ⟨b, hb₁, hb₂⟩ := p.support.exists_mem_eq_sup (finsupp.support_nonempty_iff.mpr hp)
    (λ (m : σ →₀ ℕ), m.to_multiset.card),
  have hb : ¬ b ∈ q.support,
  { contrapose! h,
    rw [total_degree_eq p, hb₂, total_degree_eq],
    apply finset.le_sup h, },
  have hbb : b ∈ (p + q).support,
  { apply support_sdiff_support_subset_support_add,
    rw finset.mem_sdiff,
    exact ⟨hb₁, hb⟩, },
  rw [total_degree_eq, hb₂, total_degree_eq],
  exact finset.le_sup hbb,
end

lemma total_degree_add_eq_right_of_total_degree_lt {p q : mv_polynomial σ R}
  (h : q.total_degree < p.total_degree) : (q + p).total_degree = p.total_degree :=
by rw [add_comm, total_degree_add_eq_left_of_total_degree_lt h]

lemma total_degree_mul (a b : mv_polynomial σ R) :
  (a * b).total_degree ≤ a.total_degree + b.total_degree :=
finset.sup_le $ assume n hn,
  have _ := add_monoid_algebra.support_mul a b hn,
  begin
    simp only [finset.mem_bUnion, finset.mem_singleton] at this,
    rcases this with ⟨a₁, h₁, a₂, h₂, rfl⟩,
    rw [finsupp.sum_add_index],
    { exact add_le_add (finset.le_sup h₁) (finset.le_sup h₂) },
    { assume a, refl },
    { assume a b₁ b₂, refl }
  end

lemma total_degree_pow (a : mv_polynomial σ R) (n : ℕ) :
  (a ^ n).total_degree ≤ n * a.total_degree :=
begin
  induction n with n ih,
  { simp only [nat.nat_zero_eq_zero, zero_mul, pow_zero, total_degree_one] },
  rw pow_succ,
  calc total_degree (a * a ^ n) ≤ a.total_degree + (a^n).total_degree : total_degree_mul _ _
    ... ≤ a.total_degree + n * a.total_degree : add_le_add_left ih _
    ... = (n+1) * a.total_degree : by rw [add_mul, one_mul, add_comm]
end

lemma total_degree_list_prod :
  ∀(s : list (mv_polynomial σ R)), s.prod.total_degree ≤ (s.map mv_polynomial.total_degree).sum
| []        := by rw [@list.prod_nil (mv_polynomial σ R) _, total_degree_one]; refl
| (p :: ps) :=
  begin
    rw [@list.prod_cons (mv_polynomial σ R) _, list.map, list.sum_cons],
    exact le_trans (total_degree_mul _ _) (add_le_add_left (total_degree_list_prod ps) _)
  end

lemma total_degree_multiset_prod (s : multiset (mv_polynomial σ R)) :
  s.prod.total_degree ≤ (s.map mv_polynomial.total_degree).sum :=
begin
  refine quotient.induction_on s (assume l, _),
  rw [multiset.quot_mk_to_coe, multiset.coe_prod, multiset.coe_map, multiset.coe_sum],
  exact total_degree_list_prod l
end

lemma total_degree_finset_prod {ι : Type*}
  (s : finset ι) (f : ι → mv_polynomial σ R) :
  (s.prod f).total_degree ≤ ∑ i in s, (f i).total_degree :=
begin
  refine le_trans (total_degree_multiset_prod _) _,
  rw [multiset.map_map],
  refl
end

lemma exists_degree_lt [fintype σ] (f : mv_polynomial σ R) (n : ℕ)
  (h : f.total_degree < n * fintype.card σ) {d : σ →₀ ℕ} (hd : d ∈ f.support) :
  ∃ i, d i < n :=
begin
  contrapose! h,
  calc n * fintype.card σ
        = ∑ s:σ, n         : by rw [finset.sum_const, nat.nsmul_eq_mul, mul_comm, finset.card_univ]
    ... ≤ ∑ s, d s         : finset.sum_le_sum (λ s _, h s)
    ... ≤ d.sum (λ i e, e) : by { rw [finsupp.sum_fintype], intros, refl }
    ... ≤ f.total_degree   : finset.le_sup hd,
end

lemma coeff_eq_zero_of_total_degree_lt {f : mv_polynomial σ R} {d : σ →₀ ℕ}
  (h : f.total_degree < ∑ i in d.support, d i) :
  coeff d f = 0 :=
begin
  classical,
  rw [total_degree, finset.sup_lt_iff] at h,
  { specialize h d, rw mem_support_iff at h,
    refine not_not.mp (mt h _), exact lt_irrefl _, },
  { exact lt_of_le_of_lt (nat.zero_le _) h, }
end

lemma total_degree_rename_le (f : σ → τ) (p : mv_polynomial σ R) :
  (rename f p).total_degree ≤ p.total_degree :=
finset.sup_le $ assume b,
begin
  assume h,
  rw rename_eq at h,
  have h' := finsupp.map_domain_support h,
  rw finset.mem_image at h',
  rcases h' with ⟨s, hs, rfl⟩,
  rw finsupp.sum_map_domain_index,
  exact le_trans (le_refl _) (finset.le_sup hs),
  exact assume _, rfl,
  exact assume _ _ _, rfl
end

end total_degree

section eval_vars

/-! ### `vars` and `eval` -/

variables [comm_semiring S]

lemma eval₂_hom_eq_constant_coeff_of_vars (f : R →+* S) {g : σ → S}
  {p : mv_polynomial σ R} (hp : ∀ i ∈ p.vars, g i = 0) :
  eval₂_hom f g p = f (constant_coeff p) :=
begin
  conv_lhs { rw p.as_sum },
  simp only [ring_hom.map_sum, eval₂_hom_monomial],
  by_cases h0 : constant_coeff p = 0,
  work_on_goal 0
  { rw [h0, f.map_zero, finset.sum_eq_zero],
    intros d hd },
  work_on_goal 1
  { rw [finset.sum_eq_single (0 : σ →₀ ℕ)],
    { rw [finsupp.prod_zero_index, mul_one],
      refl },
    intros d hd hd0, },
  repeat
  { obtain ⟨i, hi⟩ : d.support.nonempty,
    { rw [constant_coeff_eq, coeff, ← finsupp.not_mem_support_iff] at h0,
      rw [finset.nonempty_iff_ne_empty, ne.def, finsupp.support_eq_empty],
      rintro rfl, contradiction },
    rw [finsupp.prod, finset.prod_eq_zero hi, mul_zero],
    rw [hp, zero_pow (nat.pos_of_ne_zero $ finsupp.mem_support_iff.mp hi)],
    rw [mem_vars],
    exact ⟨d, hd, hi⟩ },
  { rw [constant_coeff_eq, coeff, ← ne.def, ← finsupp.mem_support_iff] at h0,
    intro, contradiction }
end

lemma aeval_eq_constant_coeff_of_vars [algebra R S] {g : σ → S}
  {p : mv_polynomial σ R} (hp : ∀ i ∈ p.vars, g i = 0) :
  aeval g p = algebra_map _ _ (constant_coeff p) :=
eval₂_hom_eq_constant_coeff_of_vars _ hp

lemma eval₂_hom_congr' {f₁ f₂ : R →+* S} {g₁ g₂ : σ → S} {p₁ p₂ : mv_polynomial σ R} :
  f₁ = f₂ → (∀ i, i ∈ p₁.vars → i ∈ p₂.vars → g₁ i = g₂ i) → p₁ = p₂ →
   eval₂_hom f₁ g₁ p₁ = eval₂_hom f₂ g₂ p₂ :=
begin
  rintro rfl h rfl,
  rename [p₁ p, f₁ f],
  rw p.as_sum,
  simp only [ring_hom.map_sum, eval₂_hom_monomial],
  apply finset.sum_congr rfl,
  intros d hd,
  congr' 1,
  simp only [finsupp.prod],
  apply finset.prod_congr rfl,
  intros i hi,
  have : i ∈ p.vars, { rw mem_vars, exact ⟨d, hd, hi⟩ },
  rw h i this this,
end

/-- If `f₁` and `f₂` are ring homs out of the polynomial ring and `p₁` and `p₂` are polynomials,
  then `f₁ p₁ = f₂ p₂` if `p₁ = p₂` and `f₁` and `f₂` are equal on `R` and on the variables
  of `p₁`.  -/
lemma hom_congr_vars {f₁ f₂ : mv_polynomial σ R →+* S} {p₁ p₂ : mv_polynomial σ R}
  (hC : f₁.comp C = f₂.comp C) (hv : ∀ i, i ∈ p₁.vars → i ∈ p₂.vars → f₁ (X i) = f₂ (X i))
  (hp : p₁ = p₂) : f₁ p₁ = f₂ p₂ :=
calc f₁ p₁ = eval₂_hom (f₁.comp C) (f₁ ∘ X) p₁ : ring_hom.congr_fun (by ext; simp) _
... = eval₂_hom (f₂.comp C) (f₂ ∘ X) p₂ :
  eval₂_hom_congr' hC hv hp
... = f₂ p₂ : ring_hom.congr_fun (by ext; simp) _

lemma exists_rename_eq_of_vars_subset_range
  (p : mv_polynomial σ R) (f : τ → σ)
  (hfi : injective f) (hf : ↑p.vars ⊆ set.range f) :
  ∃ q : mv_polynomial τ R, rename f q = p :=
⟨bind₁ (λ i : σ, option.elim (partial_inv f i) 0 X) p,
  begin
    show (rename f).to_ring_hom.comp _ p = ring_hom.id _ p,
    refine hom_congr_vars _ _ _,
    { ext1,
      simp [algebra_map_eq] },
    { intros i hip _,
      rcases hf hip with ⟨i, rfl⟩,
      simp [partial_inv_left hfi] },
    { refl }
  end⟩

lemma vars_bind₁ (f : σ → mv_polynomial τ R) (φ : mv_polynomial σ R) :
  (bind₁ f φ).vars ⊆ φ.vars.bUnion (λ i, (f i).vars) :=
begin
  calc (bind₁ f φ).vars
      = (φ.support.sum (λ (x : σ →₀ ℕ), (bind₁ f) (monomial x (coeff x φ)))).vars :
        by { rw [← alg_hom.map_sum, ← φ.as_sum], }
  ... ≤ φ.support.bUnion (λ (i : σ →₀ ℕ), ((bind₁ f) (monomial i (coeff i φ))).vars) :
        vars_sum_subset _ _
  ... = φ.support.bUnion (λ (d : σ →₀ ℕ), (C (coeff d φ) * ∏ i in d.support, f i ^ d i).vars) :
        by simp only [bind₁_monomial]
  ... ≤ φ.support.bUnion (λ (d : σ →₀ ℕ), d.support.bUnion (λ i, (f i).vars)) : _ -- proof below
  ... ≤ φ.vars.bUnion (λ (i : σ), (f i).vars) : _, -- proof below
  { apply finset.bUnion_mono,
    intros d hd,
    calc (C (coeff d φ) * ∏ (i : σ) in d.support, f i ^ d i).vars
        ≤ (C (coeff d φ)).vars ∪ (∏ (i : σ) in d.support, f i ^ d i).vars : vars_mul _ _
    ... ≤ (∏ (i : σ) in d.support, f i ^ d i).vars :
      by simp only [finset.empty_union, vars_C, finset.le_iff_subset, finset.subset.refl]
    ... ≤ d.support.bUnion (λ (i : σ), (f i ^ d i).vars) : vars_prod _
    ... ≤ d.support.bUnion (λ (i : σ), (f i).vars) : _,
    apply finset.bUnion_mono,
    intros i hi,
    apply vars_pow, },
  { intro j,
    simp_rw finset.mem_bUnion,
    rintro ⟨d, hd, ⟨i, hi, hj⟩⟩,
    exact ⟨i, (mem_vars _).mpr ⟨d, hd, hi⟩, hj⟩ }
end

lemma mem_vars_bind₁ (f : σ → mv_polynomial τ R) (φ : mv_polynomial σ R) {j : τ}
  (h : j ∈ (bind₁ f φ).vars) :
  ∃ (i : σ), i ∈ φ.vars ∧ j ∈ (f i).vars :=
by simpa only [exists_prop, finset.mem_bUnion, mem_support_iff, ne.def] using vars_bind₁ f φ h

lemma vars_rename (f : σ → τ) (φ : mv_polynomial σ R) :
  (rename f φ).vars ⊆ (φ.vars.image f) :=
begin
  intros i hi,
  simp only [vars, exists_prop, multiset.mem_to_finset, finset.mem_image] at hi ⊢,
  simpa only [multiset.mem_map] using degrees_rename _ _ hi
end

lemma mem_vars_rename (f : σ → τ) (φ : mv_polynomial σ R) {j : τ} (h : j ∈ (rename f φ).vars) :
  ∃ (i : σ), i ∈ φ.vars ∧ f i = j :=
by simpa only [exists_prop, finset.mem_image] using vars_rename f φ h

end eval_vars

end comm_semiring

end mv_polynomial