/-
Copyright (c) 2015 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Robert Y. Lewis
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.group_power.basic
import Mathlib.algebra.opposites
import Mathlib.data.list.basic
import Mathlib.data.int.cast
import Mathlib.data.equiv.basic
import Mathlib.data.equiv.mul_add
import Mathlib.deprecated.group
import Mathlib.PostPort

universes y u w x z u₁ u_1

namespace Mathlib

/-!
# Lemmas about power operations on monoids and groups

This file contains lemmas about `monoid.pow`, `group.pow`, `nsmul`, `gsmul`
which require additional imports besides those available in `.basic`.
-/

/-!
### (Additive) monoid
-/

@[simp] theorem nsmul_one {A : Type y} [add_monoid A] [HasOne A] (n : ℕ) : n •ℕ 1 = ↑n :=
  add_monoid_hom.eq_nat_cast
    (add_monoid_hom.mk (fun (n : ℕ) => n •ℕ 1) (zero_nsmul 1)
      fun (_x _x_1 : ℕ) => add_nsmul 1 _x _x_1)
    (one_nsmul 1)

@[simp] theorem list.prod_repeat {M : Type u} [monoid M] (a : M) (n : ℕ) :
    list.prod (list.repeat a n) = a ^ n :=
  sorry

@[simp] theorem list.sum_repeat {A : Type y} [add_monoid A] (a : A) (n : ℕ) :
    list.sum (list.repeat a n) = n •ℕ a :=
  list.prod_repeat

@[simp] theorem units.coe_pow {M : Type u} [monoid M] (u : units M) (n : ℕ) : ↑(u ^ n) = ↑u ^ n :=
  monoid_hom.map_pow (units.coe_hom M) u n

theorem is_unit_of_pow_eq_one {M : Type u} [monoid M] (x : M) (n : ℕ) (hx : x ^ n = 1)
    (hn : 0 < n) : is_unit x :=
  sorry

theorem nat.nsmul_eq_mul (m : ℕ) (n : ℕ) : m •ℕ n = m * n := sorry

theorem gsmul_one {A : Type y} [add_group A] [HasOne A] (n : ℤ) : n •ℤ 1 = ↑n := sorry

theorem gpow_add_one {G : Type w} [group G] (a : G) (n : ℤ) : a ^ (n + 1) = a ^ n * a := sorry

theorem add_one_gsmul {A : Type y} [add_group A] (a : A) (i : ℤ) : (i + 1) •ℤ a = i •ℤ a + a :=
  gpow_add_one

theorem gpow_sub_one {G : Type w} [group G] (a : G) (n : ℤ) : a ^ (n - 1) = a ^ n * (a⁻¹) := sorry

theorem gpow_add {G : Type w} [group G] (a : G) (m : ℤ) (n : ℤ) : a ^ (m + n) = a ^ m * a ^ n :=
  sorry

theorem mul_self_gpow {G : Type w} [group G] (b : G) (m : ℤ) : b * b ^ m = b ^ (m + 1) := sorry

theorem mul_gpow_self {G : Type w} [group G] (b : G) (m : ℤ) : b ^ m * b = b ^ (m + 1) := sorry

theorem add_gsmul {A : Type y} [add_group A] (a : A) (i : ℤ) (j : ℤ) :
    (i + j) •ℤ a = i •ℤ a + j •ℤ a :=
  gpow_add

theorem gpow_sub {G : Type w} [group G] (a : G) (m : ℤ) (n : ℤ) : a ^ (m - n) = a ^ m * (a ^ n⁻¹) :=
  sorry

theorem sub_gsmul {A : Type y} [add_group A] (m : ℤ) (n : ℤ) (a : A) :
    (m - n) •ℤ a = m •ℤ a - n •ℤ a :=
  sorry

theorem gpow_one_add {G : Type w} [group G] (a : G) (i : ℤ) : a ^ (1 + i) = a * a ^ i :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a ^ (1 + i) = a * a ^ i)) (gpow_add a 1 i)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a ^ 1 * a ^ i = a * a ^ i)) (gpow_one a)))
      (Eq.refl (a * a ^ i)))

theorem one_add_gsmul {A : Type y} [add_group A] (a : A) (i : ℤ) : (1 + i) •ℤ a = a + i •ℤ a :=
  gpow_one_add

theorem gpow_mul_comm {G : Type w} [group G] (a : G) (i : ℤ) (j : ℤ) :
    a ^ i * a ^ j = a ^ j * a ^ i :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a ^ i * a ^ j = a ^ j * a ^ i)) (Eq.symm (gpow_add a i j))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a ^ (i + j) = a ^ j * a ^ i)) (Eq.symm (gpow_add a j i))))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a ^ (i + j) = a ^ (j + i))) (add_comm i j)))
        (Eq.refl (a ^ (j + i)))))

theorem gsmul_add_comm {A : Type y} [add_group A] (a : A) (i : ℤ) (j : ℤ) :
    i •ℤ a + j •ℤ a = j •ℤ a + i •ℤ a :=
  gpow_mul_comm

theorem gpow_mul {G : Type w} [group G] (a : G) (m : ℤ) (n : ℤ) : a ^ (m * n) = (a ^ m) ^ n := sorry

theorem gsmul_mul' {A : Type y} [add_group A] (a : A) (m : ℤ) (n : ℤ) :
    m * n •ℤ a = n •ℤ (m •ℤ a) :=
  gpow_mul

theorem gpow_mul' {G : Type w} [group G] (a : G) (m : ℤ) (n : ℤ) : a ^ (m * n) = (a ^ n) ^ m :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a ^ (m * n) = (a ^ n) ^ m)) (mul_comm m n)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a ^ (n * m) = (a ^ n) ^ m)) (gpow_mul a n m)))
      (Eq.refl ((a ^ n) ^ m)))

theorem gsmul_mul {A : Type y} [add_group A] (a : A) (m : ℤ) (n : ℤ) : m * n •ℤ a = m •ℤ (n •ℤ a) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (m * n •ℤ a = m •ℤ (n •ℤ a))) (mul_comm m n)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (n * m •ℤ a = m •ℤ (n •ℤ a))) (gsmul_mul' a n m)))
      (Eq.refl (m •ℤ (n •ℤ a))))

theorem gpow_bit0 {G : Type w} [group G] (a : G) (n : ℤ) : a ^ bit0 n = a ^ n * a ^ n :=
  gpow_add a n n

theorem bit0_gsmul {A : Type y} [add_group A] (a : A) (n : ℤ) : bit0 n •ℤ a = n •ℤ a + n •ℤ a :=
  gpow_add a n n

theorem gpow_bit1 {G : Type w} [group G] (a : G) (n : ℤ) : a ^ bit1 n = a ^ n * a ^ n * a := sorry

theorem bit1_gsmul {A : Type y} [add_group A] (a : A) (n : ℤ) : bit1 n •ℤ a = n •ℤ a + n •ℤ a + a :=
  gpow_bit1

@[simp] theorem monoid_hom.map_gpow {G : Type w} {H : Type x} [group G] [group H] (f : G →* H)
    (a : G) (n : ℤ) : coe_fn f (a ^ n) = coe_fn f a ^ n :=
  int.cases_on n (fun (n : ℕ) => monoid_hom.map_pow f a n)
    fun (n : ℕ) =>
      Eq.trans (monoid_hom.map_inv f (a ^ Nat.succ n))
        (congr_arg has_inv.inv (monoid_hom.map_pow f a (Nat.succ n)))

@[simp] theorem add_monoid_hom.map_gsmul {A : Type y} {B : Type z} [add_group A] [add_group B]
    (f : A →+ B) (a : A) (n : ℤ) : coe_fn f (n •ℤ a) = n •ℤ coe_fn f a :=
  monoid_hom.map_gpow (coe_fn add_monoid_hom.to_multiplicative f) a n

@[simp] theorem units.coe_gpow {G : Type w} [group G] (u : units G) (n : ℤ) : ↑(u ^ n) = ↑u ^ n :=
  monoid_hom.map_gpow (units.coe_hom G) u n

/-! Lemmas about `gsmul` under ordering,  placed here (rather than in `algebra.group_power.basic`
with their friends) because they require facts from `data.int.basic`-/

theorem gsmul_pos {A : Type y} [ordered_add_comm_group A] {a : A} (ha : 0 < a) {k : ℤ}
    (hk : 0 < k) : 0 < k •ℤ a :=
  sorry

theorem gsmul_le_gsmul {A : Type y} [ordered_add_comm_group A] {a : A} {n : ℤ} {m : ℤ} (ha : 0 ≤ a)
    (h : n ≤ m) : n •ℤ a ≤ m •ℤ a :=
  sorry

theorem gsmul_lt_gsmul {A : Type y} [ordered_add_comm_group A] {a : A} {n : ℤ} {m : ℤ} (ha : 0 < a)
    (h : n < m) : n •ℤ a < m •ℤ a :=
  sorry

theorem gsmul_le_gsmul_iff {A : Type y} [linear_ordered_add_comm_group A] {a : A} {n : ℤ} {m : ℤ}
    (ha : 0 < a) : n •ℤ a ≤ m •ℤ a ↔ n ≤ m :=
  sorry

theorem gsmul_lt_gsmul_iff {A : Type y} [linear_ordered_add_comm_group A] {a : A} {n : ℤ} {m : ℤ}
    (ha : 0 < a) : n •ℤ a < m •ℤ a ↔ n < m :=
  sorry

theorem nsmul_le_nsmul_iff {A : Type y} [linear_ordered_add_comm_group A] {a : A} {n : ℕ} {m : ℕ}
    (ha : 0 < a) : n •ℕ a ≤ m •ℕ a ↔ n ≤ m :=
  sorry

theorem nsmul_lt_nsmul_iff {A : Type y} [linear_ordered_add_comm_group A] {a : A} {n : ℕ} {m : ℕ}
    (ha : 0 < a) : n •ℕ a < m •ℕ a ↔ n < m :=
  sorry

@[simp] theorem with_bot.coe_nsmul {A : Type y} [add_monoid A] (a : A) (n : ℕ) :
    ↑(n •ℕ a) = n •ℕ ↑a :=
  add_monoid_hom.map_nsmul (add_monoid_hom.mk coe with_bot.coe_zero with_bot.coe_add) a n

theorem nsmul_eq_mul' {R : Type u₁} [semiring R] (a : R) (n : ℕ) : n •ℕ a = a * ↑n := sorry

@[simp] theorem nsmul_eq_mul {R : Type u₁} [semiring R] (n : ℕ) (a : R) : n •ℕ a = ↑n * a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (n •ℕ a = ↑n * a)) (nsmul_eq_mul' a n)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * ↑n = ↑n * a)) (commute.eq (nat.cast_commute n a))))
      (Eq.refl (a * ↑n)))

theorem mul_nsmul_left {R : Type u₁} [semiring R] (a : R) (b : R) (n : ℕ) :
    n •ℕ (a * b) = a * (n •ℕ b) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (n •ℕ (a * b) = a * (n •ℕ b))) (nsmul_eq_mul' (a * b) n)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * b * ↑n = a * (n •ℕ b))) (nsmul_eq_mul' b n)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a * b * ↑n = a * (b * ↑n))) (mul_assoc a b ↑n)))
        (Eq.refl (a * (b * ↑n)))))

theorem mul_nsmul_assoc {R : Type u₁} [semiring R] (a : R) (b : R) (n : ℕ) :
    n •ℕ (a * b) = n •ℕ a * b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (n •ℕ (a * b) = n •ℕ a * b)) (nsmul_eq_mul n (a * b))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑n * (a * b) = n •ℕ a * b)) (nsmul_eq_mul n a)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (↑n * (a * b) = ↑n * a * b)) (mul_assoc (↑n) a b)))
        (Eq.refl (↑n * (a * b)))))

@[simp] theorem nat.cast_pow {R : Type u₁} [semiring R] (n : ℕ) (m : ℕ) : ↑(n ^ m) = ↑n ^ m := sorry

@[simp] theorem int.coe_nat_pow (n : ℕ) (m : ℕ) : ↑(n ^ m) = ↑n ^ m := sorry

theorem int.nat_abs_pow (n : ℤ) (k : ℕ) : int.nat_abs (n ^ k) = int.nat_abs n ^ k := sorry

-- The next four lemmas allow us to replace multiplication by a numeral with a `gsmul` expression.

-- They are used by the `noncomm_ring` tactic, to normalise expressions before passing to `abel`.

theorem bit0_mul {R : Type u₁} [ring R] {n : R} {r : R} : bit0 n * r = bit0 1 •ℤ (n * r) := sorry

theorem mul_bit0 {R : Type u₁} [ring R] {n : R} {r : R} : r * bit0 n = bit0 1 •ℤ (r * n) := sorry

theorem bit1_mul {R : Type u₁} [ring R] {n : R} {r : R} : bit1 n * r = bit0 1 •ℤ (n * r) + r :=
  sorry

theorem mul_bit1 {R : Type u₁} [ring R] {n : R} {r : R} : r * bit1 n = bit0 1 •ℤ (r * n) + r :=
  sorry

@[simp] theorem gsmul_eq_mul {R : Type u₁} [ring R] (a : R) (n : ℤ) : n •ℤ a = ↑n * a := sorry

theorem gsmul_eq_mul' {R : Type u₁} [ring R] (a : R) (n : ℤ) : n •ℤ a = a * ↑n :=
  eq.mpr (id (Eq._oldrec (Eq.refl (n •ℤ a = a * ↑n)) (gsmul_eq_mul a n)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑n * a = a * ↑n)) (commute.eq (int.cast_commute n a))))
      (Eq.refl (a * ↑n)))

theorem mul_gsmul_left {R : Type u₁} [ring R] (a : R) (b : R) (n : ℤ) :
    n •ℤ (a * b) = a * (n •ℤ b) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (n •ℤ (a * b) = a * (n •ℤ b))) (gsmul_eq_mul' (a * b) n)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a * b * ↑n = a * (n •ℤ b))) (gsmul_eq_mul' b n)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a * b * ↑n = a * (b * ↑n))) (mul_assoc a b ↑n)))
        (Eq.refl (a * (b * ↑n)))))

theorem mul_gsmul_assoc {R : Type u₁} [ring R] (a : R) (b : R) (n : ℤ) :
    n •ℤ (a * b) = n •ℤ a * b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (n •ℤ (a * b) = n •ℤ a * b)) (gsmul_eq_mul (a * b) n)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (↑n * (a * b) = n •ℤ a * b)) (gsmul_eq_mul a n)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (↑n * (a * b) = ↑n * a * b)) (mul_assoc (↑n) a b)))
        (Eq.refl (↑n * (a * b)))))

@[simp] theorem gsmul_int_int (a : ℤ) (b : ℤ) : a •ℤ b = a * b := sorry

theorem gsmul_int_one (n : ℤ) : n •ℤ 1 = n := sorry

@[simp] theorem int.cast_pow {R : Type u₁} [ring R] (n : ℤ) (m : ℕ) : ↑(n ^ m) = ↑n ^ m := sorry

theorem neg_one_pow_eq_pow_mod_two {R : Type u₁} [ring R] {n : ℕ} :
    (-1) ^ n = (-1) ^ (n % bit0 1) :=
  sorry

/-- Bernoulli's inequality. This version works for semirings but requires
additional hypotheses `0 ≤ a * a` and `0 ≤ (1 + a) * (1 + a)`. -/
theorem one_add_mul_le_pow' {R : Type u₁} [ordered_semiring R] {a : R} (Hsqr : 0 ≤ a * a)
    (Hsqr' : 0 ≤ (1 + a) * (1 + a)) (H : 0 ≤ bit0 1 + a) (n : ℕ) : 1 + ↑n * a ≤ (1 + a) ^ n :=
  sorry

theorem pow_lt_pow_of_lt_one {R : Type u₁} [ordered_semiring R] {a : R} (h : 0 < a) (ha : a < 1)
    {i : ℕ} {j : ℕ} (hij : i < j) : a ^ j < a ^ i :=
  sorry

theorem pow_lt_pow_iff_of_lt_one {R : Type u₁} [ordered_semiring R] {a : R} {n : ℕ} {m : ℕ}
    (hpos : 0 < a) (h : a < 1) : a ^ m < a ^ n ↔ n < m :=
  strict_mono.lt_iff_lt fun (m n : order_dual ℕ) => pow_lt_pow_of_lt_one hpos h

theorem pow_le_pow_of_le_one {R : Type u₁} [ordered_semiring R] {a : R} (h : 0 ≤ a) (ha : a ≤ 1)
    {i : ℕ} {j : ℕ} (hij : i ≤ j) : a ^ j ≤ a ^ i :=
  sorry

theorem pow_le_one {R : Type u₁} [ordered_semiring R] {x : R} (n : ℕ) (h0 : 0 ≤ x) (h1 : x ≤ 1) :
    x ^ n ≤ 1 :=
  sorry

theorem sign_cases_of_C_mul_pow_nonneg {R : Type u₁} [linear_ordered_semiring R] {C : R} {r : R}
    (h : ∀ (n : ℕ), 0 ≤ C * r ^ n) : C = 0 ∨ 0 < C ∧ 0 ≤ r :=
  sorry

@[simp] theorem abs_pow {R : Type u₁} [linear_ordered_ring R] (a : R) (n : ℕ) :
    abs (a ^ n) = abs a ^ n :=
  monoid_hom.map_pow (monoid_with_zero_hom.to_monoid_hom abs_hom) a n

@[simp] theorem pow_bit1_neg_iff {R : Type u₁} [linear_ordered_ring R] {a : R} {n : ℕ} :
    a ^ bit1 n < 0 ↔ a < 0 :=
  { mp :=
      fun (h : a ^ bit1 n < 0) =>
        iff.mp not_le fun (h' : 0 ≤ a) => iff.mpr not_le h (pow_nonneg h' (bit1 n)),
    mpr := fun (h : a < 0) => mul_neg_of_neg_of_pos h (pow_bit0_pos (has_lt.lt.ne h) n) }

@[simp] theorem pow_bit1_nonneg_iff {R : Type u₁} [linear_ordered_ring R] {a : R} {n : ℕ} :
    0 ≤ a ^ bit1 n ↔ 0 ≤ a :=
  iff.mpr le_iff_le_iff_lt_iff_lt pow_bit1_neg_iff

@[simp] theorem pow_bit1_nonpos_iff {R : Type u₁} [linear_ordered_ring R] {a : R} {n : ℕ} :
    a ^ bit1 n ≤ 0 ↔ a ≤ 0 :=
  sorry

@[simp] theorem pow_bit1_pos_iff {R : Type u₁} [linear_ordered_ring R] {a : R} {n : ℕ} :
    0 < a ^ bit1 n ↔ 0 < a :=
  lt_iff_lt_of_le_iff_le pow_bit1_nonpos_iff

theorem strict_mono_pow_bit1 {R : Type u₁} [linear_ordered_ring R] (n : ℕ) :
    strict_mono fun (a : R) => a ^ bit1 n :=
  sorry

/-- Bernoulli's inequality for `n : ℕ`, `-2 ≤ a`. -/
theorem one_add_mul_le_pow {R : Type u₁} [linear_ordered_ring R] {a : R} (H : -bit0 1 ≤ a) (n : ℕ) :
    1 + ↑n * a ≤ (1 + a) ^ n :=
  one_add_mul_le_pow' (mul_self_nonneg a) (mul_self_nonneg (1 + a))
    (iff.mp neg_le_iff_add_nonneg' H) n

/-- Bernoulli's inequality reformulated to estimate `a^n`. -/
theorem one_add_mul_sub_le_pow {R : Type u₁} [linear_ordered_ring R] {a : R} (H : -1 ≤ a) (n : ℕ) :
    1 + ↑n * (a - 1) ≤ a ^ n :=
  sorry

/-- Bernoulli's inequality reformulated to estimate `(n : K)`. -/
theorem nat.cast_le_pow_sub_div_sub {K : Type u_1} [linear_ordered_field K] {a : K} (H : 1 < a)
    (n : ℕ) : ↑n ≤ (a ^ n - 1) / (a - 1) :=
  iff.mpr (le_div_iff (iff.mpr sub_pos H))
    (le_sub_left_of_add_le
      (one_add_mul_sub_le_pow (has_le.le.trans (neg_le_self zero_le_one) (has_lt.lt.le H)) n))

/-- For any `a > 1` and a natural `n` we have `n ≤ a ^ n / (a - 1)`. See also
`nat.cast_le_pow_sub_div_sub` for a stronger inequality with `a ^ n - 1` in the numerator. -/
theorem nat.cast_le_pow_div_sub {K : Type u_1} [linear_ordered_field K] {a : K} (H : 1 < a)
    (n : ℕ) : ↑n ≤ a ^ n / (a - 1) :=
  has_le.le.trans (nat.cast_le_pow_sub_div_sub H n)
    (div_le_div_of_le (iff.mpr sub_nonneg (has_lt.lt.le H)) (sub_le_self (a ^ n) zero_le_one))

namespace int

theorem units_pow_two (u : units ℤ) : u ^ bit0 1 = 1 := Eq.symm (pow_two u) ▸ units_mul_self u

theorem units_pow_eq_pow_mod_two (u : units ℤ) (n : ℕ) : u ^ n = u ^ (n % bit0 1) := sorry

@[simp] theorem nat_abs_pow_two (x : ℤ) : ↑(nat_abs x) ^ bit0 1 = x ^ bit0 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (↑(nat_abs x) ^ bit0 1 = x ^ bit0 1)) (pow_two ↑(nat_abs x))))
    (eq.mpr
      (id (Eq._oldrec (Eq.refl (↑(nat_abs x) * ↑(nat_abs x) = x ^ bit0 1)) (nat_abs_mul_self' x)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (x * x = x ^ bit0 1)) (pow_two x))) (Eq.refl (x * x))))

theorem abs_le_self_pow_two (a : ℤ) : ↑(nat_abs a) ≤ a ^ bit0 1 := sorry

theorem le_self_pow_two (b : ℤ) : b ≤ b ^ bit0 1 := le_trans le_nat_abs (abs_le_self_pow_two b)

end int

/-- Monoid homomorphisms from `multiplicative ℕ` are defined by the image
of `multiplicative.of_add 1`. -/
def powers_hom (M : Type u) [monoid M] : M ≃ (multiplicative ℕ →* M) :=
  equiv.mk
    (fun (x : M) =>
      monoid_hom.mk (fun (n : multiplicative ℕ) => x ^ coe_fn multiplicative.to_add n) (pow_zero x)
        sorry)
    (fun (f : multiplicative ℕ →* M) => coe_fn f (coe_fn multiplicative.of_add 1)) pow_one sorry

/-- Monoid homomorphisms from `multiplicative ℤ` are defined by the image
of `multiplicative.of_add 1`. -/
def gpowers_hom (G : Type w) [group G] : G ≃ (multiplicative ℤ →* G) :=
  equiv.mk
    (fun (x : G) =>
      monoid_hom.mk (fun (n : multiplicative ℤ) => x ^ coe_fn multiplicative.to_add n) (gpow_zero x)
        sorry)
    (fun (f : multiplicative ℤ →* G) => coe_fn f (coe_fn multiplicative.of_add 1)) gpow_one sorry

/-- Additive homomorphisms from `ℕ` are defined by the image of `1`. -/
def multiples_hom (A : Type y) [add_monoid A] : A ≃ (ℕ →+ A) :=
  equiv.mk (fun (x : A) => add_monoid_hom.mk (fun (n : ℕ) => n •ℕ x) (zero_nsmul x) sorry)
    (fun (f : ℕ →+ A) => coe_fn f 1) one_nsmul sorry

/-- Additive homomorphisms from `ℤ` are defined by the image of `1`. -/
def gmultiples_hom (A : Type y) [add_group A] : A ≃ (ℤ →+ A) :=
  equiv.mk (fun (x : A) => add_monoid_hom.mk (fun (n : ℤ) => n •ℤ x) (zero_gsmul x) sorry)
    (fun (f : ℤ →+ A) => coe_fn f 1) one_gsmul sorry

@[simp] theorem powers_hom_apply {M : Type u} [monoid M] (x : M) (n : multiplicative ℕ) :
    coe_fn (coe_fn (powers_hom M) x) n = x ^ coe_fn multiplicative.to_add n :=
  rfl

@[simp] theorem powers_hom_symm_apply {M : Type u} [monoid M] (f : multiplicative ℕ →* M) :
    coe_fn (equiv.symm (powers_hom M)) f = coe_fn f (coe_fn multiplicative.of_add 1) :=
  rfl

@[simp] theorem gpowers_hom_apply {G : Type w} [group G] (x : G) (n : multiplicative ℤ) :
    coe_fn (coe_fn (gpowers_hom G) x) n = x ^ coe_fn multiplicative.to_add n :=
  rfl

@[simp] theorem gpowers_hom_symm_apply {G : Type w} [group G] (f : multiplicative ℤ →* G) :
    coe_fn (equiv.symm (gpowers_hom G)) f = coe_fn f (coe_fn multiplicative.of_add 1) :=
  rfl

@[simp] theorem multiples_hom_apply {A : Type y} [add_monoid A] (x : A) (n : ℕ) :
    coe_fn (coe_fn (multiples_hom A) x) n = n •ℕ x :=
  rfl

@[simp] theorem multiples_hom_symm_apply {A : Type y} [add_monoid A] (f : ℕ →+ A) :
    coe_fn (equiv.symm (multiples_hom A)) f = coe_fn f 1 :=
  rfl

@[simp] theorem gmultiples_hom_apply {A : Type y} [add_group A] (x : A) (n : ℤ) :
    coe_fn (coe_fn (gmultiples_hom A) x) n = n •ℤ x :=
  rfl

@[simp] theorem gmultiples_hom_symm_apply {A : Type y} [add_group A] (f : ℤ →+ A) :
    coe_fn (equiv.symm (gmultiples_hom A)) f = coe_fn f 1 :=
  rfl

theorem monoid_hom.apply_mnat {M : Type u} [monoid M] (f : multiplicative ℕ →* M)
    (n : multiplicative ℕ) :
    coe_fn f n = coe_fn f (coe_fn multiplicative.of_add 1) ^ coe_fn multiplicative.to_add n :=
  sorry

theorem monoid_hom.ext_mnat {M : Type u} [monoid M] {f : multiplicative ℕ →* M}
    {g : multiplicative ℕ →* M}
    (h : coe_fn f (coe_fn multiplicative.of_add 1) = coe_fn g (coe_fn multiplicative.of_add 1)) :
    f = g :=
  sorry

theorem monoid_hom.apply_mint {M : Type u} [group M] (f : multiplicative ℤ →* M)
    (n : multiplicative ℤ) :
    coe_fn f n = coe_fn f (coe_fn multiplicative.of_add 1) ^ coe_fn multiplicative.to_add n :=
  sorry

theorem monoid_hom.ext_mint {M : Type u} [group M] {f : multiplicative ℤ →* M}
    {g : multiplicative ℤ →* M}
    (h : coe_fn f (coe_fn multiplicative.of_add 1) = coe_fn g (coe_fn multiplicative.of_add 1)) :
    f = g :=
  sorry

theorem add_monoid_hom.apply_nat {M : Type u} [add_monoid M] (f : ℕ →+ M) (n : ℕ) :
    coe_fn f n = n •ℕ coe_fn f 1 :=
  sorry

/-! `add_monoid_hom.ext_nat` is defined in `data.nat.cast` -/

theorem add_monoid_hom.apply_int {M : Type u} [add_group M] (f : ℤ →+ M) (n : ℤ) :
    coe_fn f n = n •ℤ coe_fn f 1 :=
  sorry

/-! `add_monoid_hom.ext_int` is defined in `data.int.cast` -/

/-- If `M` is commutative, `powers_hom` is a multiplicative equivalence. -/
def powers_mul_hom (M : Type u) [comm_monoid M] : M ≃* (multiplicative ℕ →* M) :=
  mul_equiv.mk (equiv.to_fun (powers_hom M)) (equiv.inv_fun (powers_hom M)) sorry sorry sorry

/-- If `M` is commutative, `gpowers_hom` is a multiplicative equivalence. -/
def gpowers_mul_hom (G : Type w) [comm_group G] : G ≃* (multiplicative ℤ →* G) :=
  mul_equiv.mk (equiv.to_fun (gpowers_hom G)) (equiv.inv_fun (gpowers_hom G)) sorry sorry sorry

/-- If `M` is commutative, `multiples_hom` is an additive equivalence. -/
def multiples_add_hom (A : Type y) [add_comm_monoid A] : A ≃+ (ℕ →+ A) :=
  add_equiv.mk (equiv.to_fun (multiples_hom A)) (equiv.inv_fun (multiples_hom A)) sorry sorry sorry

/-- If `M` is commutative, `gmultiples_hom` is an additive equivalence. -/
def gmultiples_add_hom (A : Type y) [add_comm_group A] : A ≃+ (ℤ →+ A) :=
  add_equiv.mk (equiv.to_fun (gmultiples_hom A)) (equiv.inv_fun (gmultiples_hom A)) sorry sorry
    sorry

@[simp] theorem powers_mul_hom_apply {M : Type u} [comm_monoid M] (x : M) (n : multiplicative ℕ) :
    coe_fn (coe_fn (powers_mul_hom M) x) n = x ^ coe_fn multiplicative.to_add n :=
  rfl

@[simp] theorem powers_mul_hom_symm_apply {M : Type u} [comm_monoid M] (f : multiplicative ℕ →* M) :
    coe_fn (mul_equiv.symm (powers_mul_hom M)) f = coe_fn f (coe_fn multiplicative.of_add 1) :=
  rfl

@[simp] theorem gpowers_mul_hom_apply {G : Type w} [comm_group G] (x : G) (n : multiplicative ℤ) :
    coe_fn (coe_fn (gpowers_mul_hom G) x) n = x ^ coe_fn multiplicative.to_add n :=
  rfl

@[simp] theorem gpowers_mul_hom_symm_apply {G : Type w} [comm_group G] (f : multiplicative ℤ →* G) :
    coe_fn (mul_equiv.symm (gpowers_mul_hom G)) f = coe_fn f (coe_fn multiplicative.of_add 1) :=
  rfl

@[simp] theorem multiples_add_hom_apply {A : Type y} [add_comm_monoid A] (x : A) (n : ℕ) :
    coe_fn (coe_fn (multiples_add_hom A) x) n = n •ℕ x :=
  rfl

@[simp] theorem multiples_add_hom_symm_apply {A : Type y} [add_comm_monoid A] (f : ℕ →+ A) :
    coe_fn (add_equiv.symm (multiples_add_hom A)) f = coe_fn f 1 :=
  rfl

@[simp] theorem gmultiples_add_hom_apply {A : Type y} [add_comm_group A] (x : A) (n : ℤ) :
    coe_fn (coe_fn (gmultiples_add_hom A) x) n = n •ℤ x :=
  rfl

@[simp] theorem gmultiples_add_hom_symm_apply {A : Type y} [add_comm_group A] (f : ℤ →+ A) :
    coe_fn (add_equiv.symm (gmultiples_add_hom A)) f = coe_fn f 1 :=
  rfl

/-!
### Commutativity (again)

Facts about `semiconj_by` and `commute` that require `gpow` or `gsmul`, or the fact that integer
multiplication equals semiring multiplication.
-/

namespace semiconj_by

@[simp] theorem cast_nat_mul_right {R : Type u₁} [semiring R] {a : R} {x : R} {y : R}
    (h : semiconj_by a x y) (n : ℕ) : semiconj_by a (↑n * x) (↑n * y) :=
  mul_right (nat.commute_cast a n) h

@[simp] theorem cast_nat_mul_left {R : Type u₁} [semiring R] {a : R} {x : R} {y : R}
    (h : semiconj_by a x y) (n : ℕ) : semiconj_by (↑n * a) x y :=
  mul_left (nat.cast_commute n y) h

@[simp] theorem cast_nat_mul_cast_nat_mul {R : Type u₁} [semiring R] {a : R} {x : R} {y : R}
    (h : semiconj_by a x y) (m : ℕ) (n : ℕ) : semiconj_by (↑m * a) (↑n * x) (↑n * y) :=
  cast_nat_mul_right (cast_nat_mul_left h m) n

@[simp] theorem units_gpow_right {M : Type u} [monoid M] {a : M} {x : units M} {y : units M}
    (h : semiconj_by a ↑x ↑y) (m : ℤ) : semiconj_by a ↑(x ^ m) ↑(y ^ m) :=
  sorry

@[simp] theorem cast_int_mul_right {R : Type u₁} [ring R] {a : R} {x : R} {y : R}
    (h : semiconj_by a x y) (m : ℤ) : semiconj_by a (↑m * x) (↑m * y) :=
  mul_right (int.commute_cast a m) h

@[simp] theorem cast_int_mul_left {R : Type u₁} [ring R] {a : R} {x : R} {y : R}
    (h : semiconj_by a x y) (m : ℤ) : semiconj_by (↑m * a) x y :=
  mul_left (int.cast_commute m y) h

@[simp] theorem cast_int_mul_cast_int_mul {R : Type u₁} [ring R] {a : R} {x : R} {y : R}
    (h : semiconj_by a x y) (m : ℤ) (n : ℤ) : semiconj_by (↑m * a) (↑n * x) (↑n * y) :=
  cast_int_mul_right (cast_int_mul_left h m) n

end semiconj_by

namespace commute

@[simp] theorem cast_nat_mul_right {R : Type u₁} [semiring R] {a : R} {b : R} (h : commute a b)
    (n : ℕ) : commute a (↑n * b) :=
  semiconj_by.cast_nat_mul_right h n

@[simp] theorem cast_nat_mul_left {R : Type u₁} [semiring R] {a : R} {b : R} (h : commute a b)
    (n : ℕ) : commute (↑n * a) b :=
  semiconj_by.cast_nat_mul_left h n

@[simp] theorem cast_nat_mul_cast_nat_mul {R : Type u₁} [semiring R] {a : R} {b : R}
    (h : commute a b) (m : ℕ) (n : ℕ) : commute (↑m * a) (↑n * b) :=
  semiconj_by.cast_nat_mul_cast_nat_mul h m n

@[simp] theorem self_cast_nat_mul {R : Type u₁} [semiring R] {a : R} (n : ℕ) : commute a (↑n * a) :=
  cast_nat_mul_right (commute.refl a) n

@[simp] theorem cast_nat_mul_self {R : Type u₁} [semiring R] {a : R} (n : ℕ) : commute (↑n * a) a :=
  cast_nat_mul_left (commute.refl a) n

@[simp] theorem self_cast_nat_mul_cast_nat_mul {R : Type u₁} [semiring R] {a : R} (m : ℕ) (n : ℕ) :
    commute (↑m * a) (↑n * a) :=
  cast_nat_mul_cast_nat_mul (commute.refl a) m n

@[simp] theorem units_gpow_right {M : Type u} [monoid M] {a : M} {u : units M} (h : commute a ↑u)
    (m : ℤ) : commute a ↑(u ^ m) :=
  semiconj_by.units_gpow_right h m

@[simp] theorem units_gpow_left {M : Type u} [monoid M] {u : units M} {a : M} (h : commute (↑u) a)
    (m : ℤ) : commute (↑(u ^ m)) a :=
  commute.symm (units_gpow_right (commute.symm h) m)

@[simp] theorem cast_int_mul_right {R : Type u₁} [ring R] {a : R} {b : R} (h : commute a b)
    (m : ℤ) : commute a (↑m * b) :=
  semiconj_by.cast_int_mul_right h m

@[simp] theorem cast_int_mul_left {R : Type u₁} [ring R] {a : R} {b : R} (h : commute a b) (m : ℤ) :
    commute (↑m * a) b :=
  semiconj_by.cast_int_mul_left h m

theorem cast_int_mul_cast_int_mul {R : Type u₁} [ring R] {a : R} {b : R} (h : commute a b) (m : ℤ)
    (n : ℤ) : commute (↑m * a) (↑n * b) :=
  semiconj_by.cast_int_mul_cast_int_mul h m n

@[simp] theorem self_cast_int_mul {R : Type u₁} [ring R] (a : R) (n : ℤ) : commute a (↑n * a) :=
  cast_int_mul_right (commute.refl a) n

@[simp] theorem cast_int_mul_self {R : Type u₁} [ring R] (a : R) (n : ℤ) : commute (↑n * a) a :=
  cast_int_mul_left (commute.refl a) n

theorem self_cast_int_mul_cast_int_mul {R : Type u₁} [ring R] (a : R) (m : ℤ) (n : ℤ) :
    commute (↑m * a) (↑n * a) :=
  cast_int_mul_cast_int_mul (commute.refl a) m n

end commute

@[simp] theorem nat.to_add_pow (a : multiplicative ℕ) (b : ℕ) :
    coe_fn multiplicative.to_add (a ^ b) = coe_fn multiplicative.to_add a * b :=
  sorry

@[simp] theorem nat.of_add_mul (a : ℕ) (b : ℕ) :
    coe_fn multiplicative.of_add (a * b) = coe_fn multiplicative.of_add a ^ b :=
  Eq.symm (nat.to_add_pow a b)

@[simp] theorem int.to_add_pow (a : multiplicative ℤ) (b : ℕ) :
    coe_fn multiplicative.to_add (a ^ b) = coe_fn multiplicative.to_add a * ↑b :=
  sorry

@[simp] theorem int.to_add_gpow (a : multiplicative ℤ) (b : ℤ) :
    coe_fn multiplicative.to_add (a ^ b) = coe_fn multiplicative.to_add a * b :=
  sorry

@[simp] theorem int.of_add_mul (a : ℤ) (b : ℤ) :
    coe_fn multiplicative.of_add (a * b) = coe_fn multiplicative.of_add a ^ b :=
  Eq.symm (int.to_add_gpow a b)

namespace units

theorem conj_pow {M : Type u} [monoid M] (u : units M) (x : M) (n : ℕ) :
    (↑u * x * ↑(u⁻¹)) ^ n = ↑u * x ^ n * ↑(u⁻¹) :=
  Eq.symm
    (iff.mpr divp_eq_iff_mul_eq
      (Eq.symm (semiconj_by.eq (semiconj_by.pow_right (mk_semiconj_by u x) n))))

theorem conj_pow' {M : Type u} [monoid M] (u : units M) (x : M) (n : ℕ) :
    (↑(u⁻¹) * x * ↑u) ^ n = ↑(u⁻¹) * x ^ n * ↑u :=
  conj_pow (u⁻¹) x n

/-- Moving to the opposite monoid commutes with taking powers. -/
@[simp] theorem op_pow {M : Type u} [monoid M] (x : M) (n : ℕ) :
    opposite.op (x ^ n) = opposite.op x ^ n :=
  sorry

@[simp] theorem unop_pow {M : Type u} [monoid M] (x : Mᵒᵖ) (n : ℕ) :
    opposite.unop (x ^ n) = opposite.unop x ^ n :=
  sorry

end Mathlib


import group_theory.group_action
import tactic

universes u v w
variables {G : Type u} {α : Type v} {β : Type w} [group G]

open_locale coset

abbreviation left_cosets (L : subgroup G) : Type* :=
{ S : set G // ∃ g : G, g *l L = S }

namespace left_cosets

variables {L : subgroup G}

@[simps] def smul (g : G) (s : left_cosets L) : left_cosets L :=
⟨g *l s.1, begin
  rcases s with ⟨_, g', rfl⟩,
  simp [left_coset_assoc],
end⟩

/-- Use notation • for smul -/
instance : has_scalar G (left_cosets L) := ⟨smul⟩

/-- Use notation ∈ for is an element of -/
instance : set_like (left_cosets L) G :=
{ coe := subtype.val,
  coe_injective' := subtype.coe_injective }

@[ext] theorem ext {p q : left_cosets L} (h : ∀ x, x ∈ p ↔ x ∈ q) : p = q :=
set_like.ext h

lemma mem_smul (g h : G) (s : left_cosets L) : h ∈ g • s ↔ g⁻¹ * h ∈ s :=
by simp [(•), ← set_like.mem_coe, left_coset]

def aux_action : mul_action G (left_cosets L) :=
{ smul := (•),
  one_smul := begin
    intro t,
    ext,
    rw mem_smul,
    simp,
  end,
  mul_smul := begin
    intros t u v,
    ext,
    simp only [mem_smul],
    congr' 2,
    group,
end }

end left_cosets


-- the to be Mason-Stother formalization
-- Authors Johannes & Jens

--Defining the gcd
import poly
--import euclidean_domain
--Need to fix an admit in UFD, for the ...multiset lemma
import unique_factorization_domain
import data.finsupp
import algebraically_closed_field
import poly_over_UFD
import poly_over_field
import poly_derivative

noncomputable theory
local infix ^ := monoid.pow
local notation `d[`a`]` := polynomial.derivative a
local notation Σ := finset.sume
local notation Π := finset.prod
local notation `Π₀` := finsupp.prod
local notation `~`a:=polynomial a
local notation a `~ᵤ` b : 50 := associated a b

open polynomial
open associated
open classical
local attribute [instance] prop_decidable

-- TODO: there is some problem with the module instances for module.to_add_comm_group ...
-- force ring.to_add_comm_group to be stronger
attribute [instance] ring.to_add_comm_group

universe u

attribute [instance] field.to_unique_factorization_domain --correct?

variable {β : Type u}
variables [field β]

open classical multiset
section mason_stothers

--It might be good to remove the attribute to domain of integral domain?
def rad (p : polynomial β) : polynomial β :=
p.factors.erase_dup.prod

lemma rad_ne_zero {p : polynomial β} : rad p ≠ 0 :=
begin
  rw [rad],
  apply multiset.prod_ne_zero_of_forall_mem_ne_zero,
  intros x h1,
  have h2 : irreducible x,
  {
    rw mem_erase_dup at h1,
    exact p.factors_irred x h1,
  },
  exact h2.1,
end

--naming --Where do we use this?
lemma degree_rad_eq_sum_support_degree {f : polynomial β} :
  degree (rad f) = sum (map degree f.factors.erase_dup) :=
begin
  rw rad,
  have h1 : finset.prod (to_finset (polynomial.factors f)) id ≠ 0,
    {
      apply polynomial.prod_ne_zero_of_forall_mem_ne_zero,
      intros x h1,
      have : irreducible x,
        {
          rw mem_to_finset at h1,
          exact f.factors_irred x h1,
        },
      exact and.elim_left this,
    },
  rw ←to_finset_val f.factors,
  exact calc degree (prod ((to_finset (polynomial.factors f)).val)) =
    degree (prod (map id (to_finset (polynomial.factors f)).val)) : by rw map_id_eq
    ... = sum (map degree ((to_finset (polynomial.factors f)).val)) : degree_prod_eq_sum_degree_of_prod_ne_zero h1,
end

private lemma mem_factors_of_mem_factors_sub_factors_erase_dup (f : polynomial β) (x : polynomial β) (h : x ∈ (f.factors)-(f.factors.erase_dup)) :   x ∈ f.factors :=
begin
  have : ((f.factors)-(f.factors.erase_dup)) ≤ f.factors,
    from multiset.sub_le_self _ _,
  exact mem_of_le this h,
end

--naming
lemma prod_pow_min_on_ne_zero {f : polynomial β} :
  ((f.factors)-(f.factors.erase_dup)).prod ≠ 0 :=
begin
  apply multiset.prod_ne_zero_of_forall_mem_ne_zero,
  intros x h,
  have h1 : x ∈ f.factors,
    from mem_factors_of_mem_factors_sub_factors_erase_dup f x h,
  have : irreducible x,
    from f.factors_irred x h1,
  exact this.1,
end

lemma degree_factors_prod_eq_degree_factors_sub_erase_dup_add_degree_rad {f : polynomial β} :
  degree (f.factors.prod) = degree ((f.factors)-(f.factors.erase_dup)).prod + degree (rad f) :=
begin
  rw [← sub_erase_dup_add_erase_dup_eq f.factors] {occs := occurrences.pos [1]},
  rw [←prod_mul_prod_eq_add_prod],
  apply degree_mul_eq_add_of_mul_ne_zero,
  exact mul_ne_zero prod_pow_min_on_ne_zero rad_ne_zero,
end

lemma ne_zero_of_dvd_ne_zero {γ : Type u}{a b : γ} [comm_semiring γ] (h1 : a ∣ b) (h2 : b ≠ 0) : a ≠ 0 :=
begin
  simp only [has_dvd.dvd] at h1,
  let c := some h1,
  have h3: b = a * c,
  from some_spec h1,
  by_contradiction h4,
  rw not_not at h4,
  rw h4 at h3,
  simp at h3,
  contradiction
end

open polynomial --Why here?

private lemma Mason_Stothers_lemma_aux_1 (f : polynomial β):
  ∀x ∈ f.factors, x^(count x f.factors - 1) ∣ d[f.factors.prod] :=
begin
  rw [derivative_prod_multiset],
  intros x h,
  apply multiset.dvd_sum,
  intros y hy,
  rw multiset.mem_map at hy,
  rcases hy with ⟨z, hz⟩,
  have : y = d[z] * prod (erase (factors f) z),
    from hz.2.symm,
  subst this,
  apply dvd_mul_of_dvd_right,
  rcases (exists_cons_of_mem hz.1) with ⟨t, ht⟩,
  rw ht,
  by_cases h1 : x = z,
  {
    subst h1,
    simp,
    apply forall_pow_count_dvd_prod,
  },
  {
    simp [count_cons_of_ne h1],
    refine dvd_trans _ (forall_pow_count_dvd_prod t x),
    apply pow_count_sub_one_dvd_pow_count,
  },
end

private lemma count_factors_sub_one (f x : polynomial β) :  (count x f.factors - 1) = count x (factors f - erase_dup (factors f))  :=
begin
  rw count_sub,
  by_cases h1 : x ∈ f.factors,
  {
    have : count x (erase_dup (factors f)) = 1,
    {
      have h2: 0 < count x (erase_dup (factors f)),
      {
        rw [count_pos, mem_erase_dup],
        exact h1
      },
      have h3: count x (erase_dup (factors f)) ≤ 1,
      {
        have : nodup (erase_dup (factors f)),
          from nodup_erase_dup _,
        rw nodup_iff_count_le_one at this,
        exact this x,
      },
      have : 1 ≤ count x (erase_dup (factors f)),
        from h2,
      exact nat.le_antisymm h3 this,
    },
    rw this,
  },
  {
    rw ←count_eq_zero at h1,
    simp *,
  }
end

private lemma Mason_Stothers_lemma_aux_2 (f : polynomial β) (h_dvd : ∀x ∈ f.factors, x^(count x f.factors - 1) ∣ gcd f d[f]):
  (f.factors - f.factors.erase_dup).prod ∣ gcd f d[f] :=
begin
  apply facs_to_pow_prod_dvd_multiset,
  intros x h,
  have h1 : x ∈ f.factors,
    from mem_factors_of_mem_factors_sub_factors_erase_dup f x h,
  split,
  {
    exact f.factors_irred x h1,
  },
  split,
  {
    rw ←count_factors_sub_one,
    exact h_dvd x h1,
  },
  {
    intros y hy h2,
    have : y ∈ f.factors,
      from mem_factors_of_mem_factors_sub_factors_erase_dup f y hy,
    have h3: monic x,
      from f.factors_monic x h1,
    have h4: monic y,
      from f.factors_monic y this,
    rw associated_iff_eq_of_monic_of_monic h3 h4,
    exact h2,
  }
end

private lemma degree_factors_prod (f : polynomial β) (h : f ≠ 0): degree (f.factors.prod) = degree f :=
begin
  rw [f.factors_eq] {occs := occurrences.pos [2]},
  rw [degree_mul_eq_add_of_mul_ne_zero, degree_C],
  simp,
  rw ←f.factors_eq,
  exact h,
end

--make private?
--in theses as degree_le
lemma Mason_Stothers_lemma (f : polynomial β) :
  degree f ≤ degree (gcd f (derivative f )) + degree (rad f) := --I made degree radical from this one
begin
  by_cases hf : (f = 0),
  { simp [hf, nat.zero_le]},
  {
    have h_dvd_der : ∀x ∈ f.factors, x^(count x f.factors - 1) ∣ d[f],
    {
      rw [f.factors_eq] {occs := occurrences.pos [3]},
      rw [derivative_C_mul],
      intros x h,
      exact dvd_mul_of_dvd_right (Mason_Stothers_lemma_aux_1 f x h) _,
    },
    have h_dvd_f : ∀x ∈ f.factors, x^(count x f.factors - 1) ∣ f,
    {
      rw [f.factors_eq] {occs := occurrences.pos [3]},
      intros x hx, --We have intros x hx a lot here, duplicate?
      apply dvd_mul_of_dvd_right,
      exact dvd_trans (pow_count_sub_one_dvd_pow_count _ _) (forall_pow_count_dvd_prod _ x), --Duplicate 2 lines with Mason_Stothers_lemma_aux_1
    },
    have h_dvd_gcd_f_der : ∀x ∈ f.factors, x^(count x f.factors - 1) ∣ gcd f d[f],
    {
      intros x hx,
      exact gcd_min (h_dvd_f x hx) (h_dvd_der x hx),
    },
    have h_prod_dvd_gcd_f_der : (f.factors - f.factors.erase_dup).prod ∣ gcd f d[f],
      from Mason_Stothers_lemma_aux_2 _ h_dvd_gcd_f_der,
    have h_gcd : gcd f d[f] ≠ 0,
    {
      rw [ne.def, gcd_eq_zero_iff_eq_zero_and_eq_zero],
      simp [hf]
    },
    have h1 : degree ((f.factors - f.factors.erase_dup).prod) ≤ degree (gcd f d[f]),
      from degree_dvd h_prod_dvd_gcd_f_der h_gcd,
    have h2 : degree f = degree ((f.factors)-(f.factors.erase_dup)).prod + degree (rad f),
    {
      rw ←degree_factors_prod,
      exact degree_factors_prod_eq_degree_factors_sub_erase_dup_add_degree_rad,
      exact hf,
    },
    rw h2,
    apply add_le_add_right,
    exact h1,
  }
end

lemma Mason_Stothers_lemma'
(f : polynomial β) : degree f - degree (gcd f (derivative f )) ≤  degree (rad f) :=
begin
  have h1 : degree f - degree (gcd f (derivative f )) ≤ degree (gcd f (derivative f )) + degree (rad f) - degree (gcd f (derivative f )),
  {
    apply nat.sub_le_sub_right,
    apply Mason_Stothers_lemma,
  },
  have h2 : degree (gcd f d[f]) + degree (rad f) - degree (gcd f d[f]) =  degree (rad f),
  {
    rw [add_comm _ (degree (rad f)), nat.add_sub_assoc, nat.sub_self, nat.add_zero],
    exact nat.le_refl _,
  },
  rw h2 at h1,
  exact h1,
end

lemma eq_zero_of_le_pred {n : ℕ} (h : n ≤ nat.pred n) : n = 0 :=
begin
  cases n,
    simp,
    simp at h,
    have h1 : nat.succ n = n,
    from le_antisymm h (nat.le_succ n),
    have h2 : nat.succ n ≠ n,
    from nat.succ_ne_self n,
    contradiction,
end

lemma derivative_eq_zero_of_dvd_derivative_self {a : polynomial β} (h : a ∣ d[a]) : d[a] = 0 :=
begin
  by_contradiction hc,
  have h1 : degree d[a] ≤ degree a - 1,
  from degree_derivative_le,
  have h2 : degree a ≤ degree d[a],
  from degree_dvd h hc,
  have h3 : degree a = 0,
  {
    have h3 : degree a ≤ degree a - 1,
    from le_trans h2 h1,
    exact eq_zero_of_le_pred h3,
  },
  rw ←is_constant_iff_degree_eq_zero at h3,
  have h5 : d[a] = 0,
  from derivative_eq_zero_of_is_constant h3,
  contradiction,
end

--In MS detailed I call this zero wronskian
lemma derivative_eq_zero_and_derivative_eq_zero_of_coprime_of_wron_eq_zero
{a b : polynomial β}
(h1 : coprime a b)
(h2 : d[a] * b - a * d[b] = 0)
: d[a] = 0 ∧  d[b] = 0 :=
begin
  have h3 : d[a] * b = a * d[b],
  {
    exact calc d[a] * b = d[a] * b + (-a * d[b] + a * d[b]) : by simp
    ... = d[a] * b - (a * d[b]) + a * d[b] : by simp [add_assoc]
    ... = 0 + a * d[b] : by rw [h2]
    ... = _ : by simp
  },
  have h4 : a ∣ d[a] * b,
  from dvd.intro _ h3.symm,
  rw mul_comm at h4,
  have h5 : a ∣ d[a],
  exact dvd_of_dvd_mul_of_coprime h4 h1,
  have h6 : d[a] = 0,
  from derivative_eq_zero_of_dvd_derivative_self h5,

  --duplication
  rw mul_comm at h3,
  have h7 : b ∣ a * d[b],
  from dvd.intro _ h3,
  have h8 : b ∣ d[b],
  exact dvd_of_dvd_mul_of_coprime h7 (h1.symm),
  have h9 : d[b] = 0,
  from derivative_eq_zero_of_dvd_derivative_self h8,
  exact ⟨h6, h9⟩,
end

--Lemma coprime_gcd in MS_detailed
lemma coprime_gcd_derivative_gcd_derivative_of_coprime {a b : polynomial β} (h : coprime a b) (c d : polynomial β) : coprime (gcd a c) (gcd b d) :=
begin
  rw coprime,
  by_contradiction h1,
  let e := (gcd (gcd a c) (gcd b d)),
  have ha : e ∣ a,
  {
    have h2a: e ∣ (gcd a c),
      from gcd_left,
    have h2b : (gcd a c) ∣ a,
      from gcd_left,
    exact dvd_trans h2a h2b,
  },
  have hb : e ∣ b,
  {
    have h2a: e ∣ (gcd b d),
      from gcd_right,
    have h2b : (gcd b d) ∣ b,
      from gcd_left,
    exact dvd_trans h2a h2b,
  },
  have he: e ∣ (gcd a b),
    from gcd_min ha hb,
  have h2 : ¬is_unit (gcd a b),
    from not_is_unit_of_not_is_unit_dvd h1 he,
  rw coprime at h,
  exact h2 h,
end

lemma degree_gcd_derivative_le_degree {a : polynomial β}: degree (gcd a d[a]) ≤ degree a :=
begin
  by_cases h : (a = 0),
  {
    simp * at *,
  },
  {
    apply degree_gcd_le_left,
    exact h,
  }
end

lemma degree_gcd_derivative_lt_degree_of_degree_ne_zero {a : polynomial β} (h : degree a ≠ 0) (h_char : characteristic_zero β) : degree (gcd a d[a]) < degree a :=
begin
  have h1 : degree (gcd a d[a]) ≤ degree d[a],
  {
    apply degree_dvd,
    apply gcd_right,
    rw [ne.def, derivative_eq_zero_iff_is_constant, is_constant_iff_degree_eq_zero],
    exact h,
    exact h_char,
  },
  have h2 : ∃ n, degree a = nat.succ n,
  from nat.exists_eq_succ_of_ne_zero h,
  let n := some h2,
  have h3 : degree a = nat.succ n,
  from some_spec h2,
  exact calc degree (gcd a d[a]) ≤ degree d[a] : h1
  ... ≤ degree a - 1 : degree_derivative_le
  ... ≤ nat.succ n - 1 : by rw h3
  ... = n : rfl
  ... < nat.succ n : nat.lt_succ_self _
  ... = degree a : eq.symm h3,

end

open associated

lemma not_zero_mem_factors {a : polynomial β} : (0 : polynomial β) ∉ a.factors :=
begin
  by_contradiction h1,
  have : irreducible (0 : polynomial β),
    from a.factors_irred 0 h1,
  have : ¬ irreducible (0 : polynomial β),
  {  simp},
  contradiction,
end

lemma c_fac_eq_zero_iff_eq_zero {a : polynomial β} : a.c_fac = 0 ↔ a = 0 :=
begin
  split,
  {
    intro h,
    rw a.factors_eq,
    simp *,
  },
  {
    intro h,
    rw [a.factors_eq, mul_eq_zero_iff_eq_zero_or_eq_zero] at h,
    cases h,
    {
      rw C_eq_zero_iff_eq_zero at h,
      exact h,
    },
    {
      rw prod_eq_zero_iff_zero_mem' at h,
      have : (0 : polynomial β) ∉ a.factors,
        from not_zero_mem_factors,
      contradiction,
    }
  }
end

--Not used
private lemma mk_C_c_fac_eq_one_of_ne_zero {a : polynomial β} (h : a ≠ 0) : mk (C a.c_fac) = 1 :=
begin
  rw [ne.def, ←c_fac_eq_zero_iff_eq_zero] at h,
  have h1 : is_unit a.c_fac,
    from for_all_is_unit_of_not_zero h,
  have h2 : is_unit (C a.c_fac),
    from is_unit_of_is_unit h1,
  rw mk_eq_one_iff_is_unit,
  exact h2,
end

--a and b can be implicit
lemma factors_inter_factors_eq_zero_of_coprime (a b : polynomial β) (h : coprime a b) : a.factors ∩ b.factors = 0 :=
begin
  by_cases ha: a = 0, { subst ha, simp, },
  by_cases hb: b = 0, { subst hb, simp, },
  --I already have a similar lemma for coprime
  rw [coprime_iff_mk_inf_mk_eq_one, a.factors_eq, b.factors_eq, mul_mk, mul_mk] at h, --we go to the quotient structure with respect to units.
  rw inf_mul_eq_one_iff_inf_eq_one_and_inf_eq_one at h, --We probably can do without going to the quotient, because we have the lemmas for coprime
  let h1 := h.2,
  rw mul_inf_eq_one_iff_inf_eq_one_and_inf_eq_one at h1,
  let h2 := h1.2,
  rw [mk_def, mk_def, ←prod_mk, ←prod_mk] at h2,
  rw prod_inf_prod_eq_one_iff_forall_forall_inf_eq_one at h2,

  rw [inter_eq_zero_iff_disjoint, disjoint_iff_ne],
  {
    intros x hx y hy,
    have h3 : mk x ⊓ mk y = 1,
    {
      apply h2,
      {
        rw mem_map,
        exact ⟨x, hx, rfl⟩,
      },
      {
        rw mem_map,
        exact ⟨y, hy, rfl⟩,
      },
    },
    rw [←coprime_iff_mk_inf_mk_eq_one, coprime_iff_not_associated_of_irreducible_of_irreducible] at h3,
    rw [associated_iff_eq_of_monic_of_monic] at h3,
    exact h3,
    exact a.factors_monic x hx,
    exact b.factors_monic y hy,
    exact a.factors_irred x hx,
    exact b.factors_irred y hy, }
end

open associated

private lemma monic_prod_factors (a : polynomial β) : monic a.factors.prod :=
  monic_prod_of_forall_mem_monic a.factors_monic

lemma c_fac_eq_leading_coeff (a : polynomial β) : a.c_fac = leading_coeff a :=
begin
  by_cases ha : a = 0,
  {
    simp * at *,
  },
  {
    have h1 : a = (C a.c_fac) * a.factors.prod,
      from a.factors_eq,
    rw [h1] {occs := occurrences.pos[2]},
    rw leading_coeff_mul_eq_mul_leading_coef,
    let h3 := monic_prod_factors a,
      rw monic at h3,
    simp [h3],
  }
end

private lemma C_inv_c_fac_mul_eq_prod_factors {a : polynomial β} (ha : a ≠ 0): (C a.c_fac⁻¹) * a = a.factors.prod :=
begin
  have h1 : a = (C a.c_fac) * a.factors.prod,
    from a.factors_eq,
  rw [ne.def, ←c_fac_eq_zero_iff_eq_zero] at ha,
  exact calc (C a.c_fac⁻¹) * a = (C a.c_fac⁻¹) * (C (c_fac a) * prod (factors a)) : by rw [←h1]
      ... = _ : by rw [←mul_assoc, ←C_mul_C, inv_mul_cancel ha, C_1, one_mul],
end

lemma factors_eq_map_monic_out_to_multiset_mk (a : polynomial β) : a.factors = map monic_out (associated.to_multiset (associated.mk a)) :=
begin
  by_cases ha : a = 0,
  {
    simp * at *,
  },
  {
    have h1 : a = C (a.c_fac) * a.factors.prod,
      from a.factors_eq,
    have h2 : C (a.c_fac⁻¹) * a = a.factors.prod,
      from C_inv_c_fac_mul_eq_prod_factors ha,
    have h3: a.factors.prod = (map monic_out (to_multiset (mk a))).prod,
    {
      rw prod_map_monic_out_eq_monic_out_prod,
      rw ←h2,
      rw ←associated_iff_eq_of_monic_of_monic,
      rw to_multiset_prod_eq,
      have h4 : (a ~ᵤ (monic_out (mk a))),
        from (monic_out_mk_associated a).symm, --It can no longer elaborate it?? After I refactored all the files

      have h5 : (C (c_fac a)⁻¹ * a ~ᵤ a),
      {
        have h5a : (c_fac a)⁻¹ ≠ 0,
        {
          rw ←c_fac_eq_zero_iff_eq_zero at ha,
          apply inv_ne_zero,
          exact ha,
        },
        have h5b : (C (c_fac a)⁻¹) ≠ 0, --Is this used?
        {
          rw [ne.def, C_eq_zero_iff_eq_zero],
          exact h5a,
        },
        have h5c: is_unit (C (c_fac a)⁻¹),
          from is_unit_C_of_ne_zero h5a,
        rcases h5c with ⟨u, hu⟩,
        exact ⟨u, by simp *⟩,
      },
      exact associated.trans h5 h4,
      rwa [ne.def, mk_eq_zero_iff_eq_zero],
      {
        rw c_fac_eq_leading_coeff,
        exact leading_coeff_inv_mul_monic_of_ne_zero ha,
      },
      {
        apply monic_monic_out_of_ne_zero,
        rw [to_multiset_prod_eq],--Wrong naminG!!
        rw ←mk_eq_zero_iff_eq_zero at ha, --Duplicate
        exact ha,
        rw ←mk_eq_zero_iff_eq_zero at ha,
        exact ha,
      }
    },
    have h4a: ∀ (x : ~β), x ∈ map monic_out (to_multiset (mk a)) → irreducible x,
    {
      intros x h,
      rw mem_map at h,
      rcases h with ⟨y, hy⟩,
      rw hy.2.symm,
      apply irreducible_monic_out_of_irred,
      apply to_multiset_irred _ y hy.1,
    },
    have h4 : rel_multiset associated a.factors (map monic_out (to_multiset (mk a))),
      from unique_factorization_domain.unique a.factors_irred h4a h3,
    apply eq_of_rel_multiset_associated_of_forall_mem_monic_of_forall_mem_monic,
    exact h4,
    exact a.factors_monic,
    {
      intros x h,
      rw mem_map at h,
      rcases h with ⟨y, hy⟩,
      rw hy.2.symm,
      apply monic_monic_out_of_ne_zero,
      {
        have : irred y,
          from to_multiset_irred _ y hy.1,
        exact ne_zero_of_irred this,
      }
    }
  }
end

--aux
--I already have to_multiset_mul, how can I reuse that here?? How to make the connection between monic and associated??
lemma factors_mul_eq_factors_add_factors {a b : polynomial β} (ha : a ≠ 0) (hb : b ≠ 0) : factors (a * b) = a.factors + b.factors :=
begin
  rw [factors_eq_map_monic_out_to_multiset_mk, factors_eq_map_monic_out_to_multiset_mk, factors_eq_map_monic_out_to_multiset_mk],
  rw [mul_mk, to_multiset_mul],
  simp,
  simp [mk_eq_zero_iff_eq_zero, *],
  simp [mk_eq_zero_iff_eq_zero, *],
end

@[simp] lemma rad_zero : rad (0 : polynomial β ) = 1 :=
begin
  simp [rad],
end

lemma rad_mul_eq_rad_mul_rad_of_coprime {a b : polynomial β} (ha : a ≠ 0) (hb : b ≠ 0) (h : coprime a b) : rad (a * b) = (rad a) * (rad b) :=
begin
  simp only [rad],
  rw prod_mul_prod_eq_add_prod,
  apply congr_arg,

  rw factors_mul_eq_factors_add_factors ha hb, --Might be good to go to nodup
  rw multiset.ext,
  intros x,
  by_cases h1 : x ∈ (a.factors + b.factors),
  {
    have h2 : count x (erase_dup (factors a + factors b)) = 1,
    {
      apply count_eq_one_of_mem,
      exact nodup_erase_dup _,
      rwa mem_erase_dup,
    },
    rw mem_add at h1,
    have h3 : x ∈ a.factors ∩ b.factors ↔ x ∈ a.factors ∧ x ∈ b.factors,
      from mem_inter,
    have h4: a.factors ∩ b.factors = 0,
      from factors_inter_factors_eq_zero_of_coprime _ _ h,
    cases h1,
    {
      have : x ∉ b.factors,
      {
          simp * at *,
      },
      rw ←mem_erase_dup at h1,
      have h1a : count x (erase_dup (factors a)) = 1,
        from count_eq_one_of_mem (nodup_erase_dup _) h1,
      rw ←mem_erase_dup at this,
      have h1b : count x (erase_dup (factors b)) = 0,
      {
        rwa count_eq_zero,
      },
      rw count_add,
      simp * at *,
    },
    { --Strong duplication
      have : x ∉ a.factors,
      {
          simp * at *,
      },
      rw ←mem_erase_dup at h1,
      have h1a : count x (erase_dup (factors b)) = 1,
        from count_eq_one_of_mem (nodup_erase_dup _) h1,
      rw ←mem_erase_dup at this,
      have h1b : count x (erase_dup (factors a)) = 0,
      {
        rwa count_eq_zero,
      },
      rw count_add,
      simp * at *,
    }
  },
  {
    have h2 : count x (erase_dup (factors a + factors b)) = 0,
    {
      rwa [count_eq_zero, mem_erase_dup],
    },
    rw [mem_add, not_or_distrib] at h1,
    have h3 : count x (erase_dup (factors a)) = 0,
    {
      rw [count_eq_zero, mem_erase_dup],
      exact h1.1,
    },
    have h4 : count x (erase_dup (factors b)) = 0,
    {
      rw [count_eq_zero, mem_erase_dup],
      exact h1.2,
    },
    simp * at *,
  },
end

--We will need extra conditions here
--We only need this one
lemma degree_rad_add {a b: polynomial β} (ha : a ≠ 0) (hb : b ≠ 0) (hab : coprime a b): degree (rad a) + degree (rad b) ≤ degree (rad (a * b)) :=
begin
  rw rad_mul_eq_rad_mul_rad_of_coprime ha hb hab,
  rw degree_mul_eq_add_of_mul_ne_zero,
  apply _root_.mul_ne_zero,
  {
    apply multiset.prod_ne_zero_of_forall_mem_ne_zero,
    intros x h,
    rw mem_erase_dup at h,
    exact (a.factors_irred _ h).1 --Anoying setup for factors_irred
  },
  {
    apply multiset.prod_ne_zero_of_forall_mem_ne_zero,
    intros x h,
    rw mem_erase_dup at h,
    exact (b.factors_irred _ h).1 --Anoying setup for factors_irred
  },
end

private lemma h_rad_add {a b c: polynomial β} (ha : a ≠ 0) (hb : b ≠ 0) (hc : c ≠ 0) (hab : coprime a b) (h_coprime_bc : coprime b c)
  (h_coprime_ca : coprime c a)
:  degree(rad(a))+degree(rad(b))+degree(rad(c)) ≤ degree(rad(a*b*c)) :=
begin
  have habc : coprime (a*b) c,
    {
      have h1: ((gcd (a * b) c) ~ᵤ (gcd b c)),
        from gcd_mul_cancel h_coprime_ca.symm,
      exact is_unit_of_associated h_coprime_bc h1.symm,
    },
  have h1 : a * b ≠ 0,
    from mul_ne_zero ha hb,
  have h3 : degree (rad a) + degree (rad b) ≤ degree (rad (a * b)),
    from degree_rad_add ha hb hab,
  exact calc degree(rad(a))+degree(rad(b))+degree(rad(c)) ≤ degree (rad (a * b)) + degree (rad c) : add_le_add_right h3 _
  ... ≤ _ : degree_rad_add h1 hc habc
end

lemma gt_zero_of_ne_zero {n : ℕ} (h : n ≠ 0) : n > 0 :=
begin
  have h1 : ∃ m : ℕ, n = nat.succ m,
  from nat.exists_eq_succ_of_ne_zero h,
  let m := some h1,
  have h2 : n = nat.succ m,
  from some_spec h1,
  rw h2,
  exact nat.zero_lt_succ _,
end

lemma MS_aux_1a {c : polynomial β} (h3 : ¬degree c = 0)(h_char : characteristic_zero β) : 1 ≤ (degree c - degree (gcd c d[c])) :=
begin
  have h4 : degree c - degree (gcd c d[c]) > 0,
  {
    rw [nat.pos_iff_ne_zero, ne.def, nat.sub_eq_zero_iff_le],
    simp,
    exact degree_gcd_derivative_lt_degree_of_degree_ne_zero h3 h_char,
  },
  exact h4,

end

--should be in poly
lemma MS_aux_1b {a b c : polynomial β} (h_char : characteristic_zero β) (h_add : a + b = c)
  (h_constant : ¬(is_constant a ∧ is_constant b ∧ is_constant c)) (h1 : is_constant b)
(h2 : ¬is_constant a) : ¬ is_constant c :=
begin
  rw [is_constant_iff_degree_eq_zero] at *,
  have h3 : c (degree a) ≠ 0,
  {
    rw ← h_add,
    simp,
    have h3 : b (degree a) = 0,
    {
      apply eq_zero_of_gt_degree,
      rw h1,
      exact gt_zero_of_ne_zero h2,
    },
    rw h3,
    simp,
    have h4 : leading_coeff a = 0 ↔ a = 0,
    from leading_coef_eq_zero_iff_eq_zero,
    rw leading_coeff at h4,
    rw h4,
    by_contradiction h5,
    rw h5 at h2,
    simp at h2,
    exact h2,
  },
  have h4 : degree a ≤ degree c,
  from le_degree h3,
  by_contradiction h5,
  rw h5 at h4,
  have : degree a = 0,
  from nat.eq_zero_of_le_zero h4,
  contradiction,
end

lemma MS_aux_1 {a b c : polynomial β} (h_char : characteristic_zero β) (h_add : a + b = c)
  (h_constant : ¬(is_constant a ∧ is_constant b ∧ is_constant c)) :
  1 ≤ degree b - degree (gcd b d[b]) + (degree c - degree (gcd c d[c])) :=
begin
  by_cases h1 : (is_constant b),
  {
    by_cases h2 : (is_constant a),
    {
      have h3 : is_constant c,
      from is_constant_add h2 h1 h_add,
      simp * at *,
    },
    {
      have h3 : ¬ is_constant c,
      {
        exact MS_aux_1b h_char h_add h_constant h1 h2,
      },
      rw [is_constant_iff_degree_eq_zero] at h3,
      have h4 : 1 ≤ (degree c - degree (gcd c d[c])),
      from MS_aux_1a h3 h_char,
      apply nat.le_trans h4,
      simp,
      exact nat.zero_le _,
    }
  },
  {
    rw [is_constant_iff_degree_eq_zero] at h1,
    have h2 : 1 ≤ degree b - degree (gcd b d[b]),
    from MS_aux_1a h1 h_char,
    apply nat.le_trans h2,
    simp,
    exact nat.zero_le _,
  }

end

---Very likely that the lemmas on rad are overcomplicated, they should use erase_dup_more

lemma dvd_of_mem_factors (f : polynomial β) (x : polynomial β) (h : x ∈ f.factors) : x ∣ f :=
begin
  rw f.factors_eq,
  have : x ∣ f.factors.prod,
    from dvd_prod_of_mem f.factors h,
  exact dvd_mul_of_dvd_right this _,
end

lemma not_is_unit_prod_factors_of_factors_ne_zero (a : polynomial β) (h : a.factors ≠ 0) : ¬ is_unit (a.factors.prod) :=
begin
  exact not_is_unit_prod_of_ne_zero_of_forall_mem_irreducible h a.factors_irred,
end

@[simp] lemma factors_C (c : β) : (C c).factors = 0 :=
begin
  by_cases h1 : C c = 0,
  {
    simp *,
  },
  {
    by_contradiction h2,
    rcases (exists_mem_of_ne_zero h2) with ⟨x, hx⟩,
    have h2 : x ∣ C c, --The part below could be a separate lemma
    {
      exact dvd_of_mem_factors (C c) x hx,
    },
    have h3: irreducible x,
      from (C c).factors_irred x hx,
    have h4: ¬is_unit x,
      from not_is_unit_of_irreducible h3,
    have h5: ¬is_unit (C c),
      from not_is_unit_of_not_is_unit_dvd h4 h2,
    have h6 : is_constant (C c),
      {simp},
    rw is_constant_iff_eq_zero_or_is_unit at h6,
    simp * at *,
  }
end

lemma is_constant_iff_factors_eq_zero (a : polynomial β) : is_constant a ↔ a.factors = 0 :=
begin
  split,
  {
    intro h,
    rcases h with ⟨c, hc⟩,
    subst hc,
    simp,
  },
  {
    intro h,
    rw a.factors_eq,
    simp * at *,
  }
end

--lemma factors_eq_zero_iff_rad_eq_zero (a : polynomial β)

lemma rad_dvd_prod_factors (a : polynomial β) : (rad a) ∣ a.factors.prod :=
begin
  rw rad,
  apply prod_dvd_prod_of_le,
  exact erase_dup_le _,
end

lemma rad_dvd (a : polynomial β) : (rad a) ∣ a :=
begin
  rw [a.factors_eq] {occs := occurrences.pos [2]},
  apply dvd_mul_of_dvd_right,
  exact rad_dvd_prod_factors _,
end

lemma degree_rad_le (a : polynomial β) : degree (rad a) ≤ degree a :=
begin
  by_cases h1 : a = 0,
  {
    subst h1,
    simp,
  },
  {
    apply degree_dvd,
    exact rad_dvd _,
    exact h1,
  }
end

lemma is_unit_rad_iff_factors_eq_zero (a : polynomial β) : is_unit (rad a) ↔ a.factors = 0 :=
begin
  split,
  {
    intro h,
    rw ←erase_dup_eq_zero_iff_eq_zero,
    by_contradiction h1,
    have : ¬is_unit (rad a),
      {
        apply not_is_unit_prod_of_ne_zero_of_forall_mem_irreducible h1,
        intros x h,
        rw mem_erase_dup at h,
        exact a.factors_irred x h,
      },
    simp * at *,
  },
  {
    intro h,
    rw ←erase_dup_eq_zero_iff_eq_zero at h,
    rw rad,
    simp *,
  }
end

lemma degree_rad_eq_zero_iff_is_constant (a : polynomial β) : degree (rad a) = 0 ↔ is_constant a :=
begin
  split,
  {
    intro h,
    rw is_constant_iff_factors_eq_zero,
    rw [←is_constant_iff_degree_eq_zero, is_constant_iff_eq_zero_or_is_unit] at h,
    cases h,
    {
      have : rad a ≠ 0,
        from rad_ne_zero,
      contradiction,
    },
    {
      rw ←is_unit_rad_iff_factors_eq_zero,
      exact h,
    },
  },
  {
    intro h,
    rw is_constant_iff_factors_eq_zero at h,
    apply degree_eq_zero_of_is_unit,
    rw is_unit_rad_iff_factors_eq_zero,
    exact h,
  }
end

--Strong duplication with MS_aux_1
lemma MS_aux_2 {a b c : polynomial β} (h_char : characteristic_zero β) (h_add : a + b = c)
  (h_constant : ¬(is_constant a ∧ is_constant b ∧ is_constant c)) :
   1 ≤ degree (rad a) + (degree c - degree (gcd c d[c])) :=
begin
  by_cases h1 : is_constant b,
  {
    by_cases h2 : is_constant a,
    {
      have h3 : is_constant c,
      from is_constant_add h2 h1 h_add,
      simp * at *,
    },
    {
      have h3 : ¬ is_constant c,
      {
        rw [is_constant_iff_degree_eq_zero] at *,
        have h3 : c (degree a) ≠ 0,
        {
          rw ← h_add,
          simp,
          have h3 : b (degree a) = 0,
          {
            apply eq_zero_of_gt_degree,
            rw h1,
            exact gt_zero_of_ne_zero h2,
          },
          rw h3,
          simp,
          have h4 : leading_coeff a = 0 ↔ a = 0,
          from leading_coef_eq_zero_iff_eq_zero,
          rw leading_coeff at h4,
          rw h4,
          by_contradiction h5,
          rw h5 at h2,
          simp at h2,
          exact h2,
        },
        have h4 : degree a ≤ degree c,
        from le_degree h3,
        by_contradiction h5,
        rw h5 at h4,
        have : degree a = 0,
        from nat.eq_zero_of_le_zero h4,
        contradiction,
      },
      rw [is_constant_iff_degree_eq_zero] at h3,
      have h4 : 1 ≤ (degree c - degree (gcd c d[c])),
      from MS_aux_1a h3 h_char,
      apply nat.le_trans h4,
      simp,
      exact nat.zero_le _,
    }
  },
  {
    by_cases h2 : (is_constant a),
    {
      rw add_comm at h_add,
      have h_constant' : ¬(is_constant b ∧ is_constant a ∧ is_constant c),
      {simp [*, and_comm]},
      have h3 : ¬is_constant c,
      from MS_aux_1b h_char h_add h_constant' h2 h1,
      rw [is_constant_iff_degree_eq_zero] at h3,
      have h4 : 1 ≤ (degree c - degree (gcd c d[c])),
      from MS_aux_1a h3 h_char,
      apply nat.le_trans h4,
      simp,
      exact nat.zero_le _,
    },
    {
      have : degree a ≠ 0,
      {
        rw [ne.def, ←is_constant_iff_degree_eq_zero],
        exact h2,
      },
      rw [ne.def, ←is_constant_iff_degree_eq_zero, ←degree_rad_eq_zero_iff_is_constant] at this,
      have h3: 1 ≤ degree (rad a),
      {
        rcases (nat.exists_eq_succ_of_ne_zero this) with ⟨n, hn⟩,
        simp * at *,
        rw nat.succ_le_succ_iff,
        exact nat.zero_le _,
      },
      apply nat.le_trans h3,
      exact nat.le_add_right _ _,
    }
  }
end

private lemma rw_aux_1a [field β]
  (a b c : polynomial β)
  (h_add : a + b = c)
  (h_constant : ¬(is_constant a ∧ is_constant b ∧ is_constant c)) :
  degree a ≠ 0 ∨ degree b ≠ 0 :=
begin
  rw [not_and_distrib, not_and_distrib] at h_constant,
  cases h_constant,
  {
    rw is_constant_iff_degree_eq_zero at h_constant,
    simp *,
  },
  {
    cases h_constant,
    {
      rw is_constant_iff_degree_eq_zero at h_constant,
      simp *,
    },
    {
      rw is_constant_iff_degree_eq_zero at h_constant,
      have : degree (a + b) ≤ max (degree a) (degree b),
        from degree_add,
      simp * at *,
      rw le_max_iff at this,
      rcases (nat.exists_eq_succ_of_ne_zero h_constant) with ⟨n, hn⟩,
      simp * at *,
      cases this with h,
      {
        have : ¬degree a = 0,
        {
          by_contradiction h1,
          simp * at *,
          exact nat.not_succ_le_zero _ h,
        },
        simp *,
      },
      {
        have : ¬degree b = 0,
        {
          by_contradiction h1,
          simp * at *,
          exact nat.not_succ_le_zero _ this,
        },
        simp *,
      }
    }
  }
end

private lemma rw_aux_1b [field β]
  (a b c : polynomial β)
  (h_add : a + b = c)
  (h_constant : ¬(is_constant a ∧ is_constant b ∧ is_constant c)) :
  1 ≤ degree a + degree b :=
begin
  have : degree a ≠ 0 ∨ degree b ≠ 0,
    from rw_aux_1a a b c h_add h_constant,
  cases this with h h ;
  {
    rcases (nat.exists_eq_succ_of_ne_zero h) with ⟨n, hn⟩,
    simp * at *,
    have : 1 ≤ nat.succ n,
    {
      rw nat.succ_le_succ_iff,
      exact nat.zero_le _,
    },
    apply nat.le_trans this,
    apply nat.le_add_right,
  },
end

--h_deg_c_le_1
lemma rw_aux_1 [field β]
  --(h_char : characteristic_zero β)
  (a b c : polynomial β)
  --(h_coprime_ab : coprime a b)
  --(h_coprime_bc : coprime b c)
  --(h_coprime_ca : coprime c a)
  (h_add : a + b = c)
  (h_constant : ¬(is_constant a ∧ is_constant b ∧ is_constant c))
  (h_deg_add_le : degree (gcd a d[a]) + degree (gcd b d[b]) + degree (gcd c d[c]) ≤ degree a + degree b - 1) :
  degree c ≤
    (degree a - degree (gcd a d[a])) +
    (degree b - degree (gcd b d[b])) +
    (degree c - degree (gcd c d[c])) - 1 :=
have 1 ≤ degree a + degree b, from rw_aux_1b a b c h_add h_constant,
have h : ∀p:polynomial β, degree (gcd p d[p]) ≤ degree p, from (λ p, @degree_gcd_derivative_le_degree _ _ p),
have (degree (gcd a d[a]) : ℤ) + (degree (gcd b d[b]) : ℤ) + (degree (gcd c d[c]) : ℤ) ≤
    (degree a : ℤ) + (degree b : ℤ) - 1,
  by rwa [← int.coe_nat_add, ← int.coe_nat_add, ← int.coe_nat_add, ← int.coe_nat_one,
    ← int.coe_nat_sub this, int.coe_nat_le],
have (degree c : ℤ) ≤
    ((degree a : ℤ) - (degree (gcd a d[a]) : ℤ)) +
    ((degree b : ℤ) - (degree (gcd b d[b]) : ℤ)) +
    ((degree c : ℤ) - (degree (gcd c d[c]) : ℤ)) - 1,
  from calc (degree c : ℤ) ≤
    ((degree c : ℤ) + ((degree a : ℤ) + (degree b : ℤ) - 1)) -
      ((degree (gcd a d[a]) : ℤ) + (degree (gcd b d[b]) : ℤ) + (degree (gcd c d[c]) : ℤ)) :
      le_sub_iff_add_le.mpr $ add_le_add_left this _
    ... = _ : by simp,
have 1 + (degree c : ℤ) ≤
    ((degree a : ℤ) - (degree (gcd a d[a]) : ℤ)) +
    ((degree b : ℤ) - (degree (gcd b d[b]) : ℤ)) +
    ((degree c : ℤ) - (degree (gcd c d[c]) : ℤ)),
  from add_le_of_le_sub_left this,
nat.le_sub_left_of_add_le $
  by rwa [← int.coe_nat_sub (h _), ← int.coe_nat_sub (h _), ← int.coe_nat_sub (h _),
      ← int.coe_nat_add, ← int.coe_nat_add, ← int.coe_nat_one, ← int.coe_nat_add, int.coe_nat_le] at this

/-
lemma Mason_Stothers_lemma
(f : polynomial β) : degree f ≤ degree (gcd f (derivative f )) + degree (rad f) -/
/-
lemma Mason_Stothers_lemma'
(f : polynomial β) : degree f - degree (gcd f (derivative f )) ≤  degree (rad f) :=
 -/
 /-
--We will need extra conditions here
lemma degree_rad_add {a b c : polynomial β}: degree (rad a) + degree (rad b) + degree (rad c) ≤ degree (rad (a * b * c)) :=
begin
  admit,
end-/

lemma nat.add_mono{a b c d : ℕ} (hab : a ≤ b) (hcd : c ≤ d) : a + c ≤ b + d :=
begin
  exact calc a + c ≤ a + d : nat.add_le_add_left hcd _
  ... ≤ b + d : nat.add_le_add_right hab _
end

--h_le_rad
lemma rw_aux_2 [field β] --We want to use the Mason Stothers lemmas here
  {a b c : polynomial β}
  (ha : a ≠ 0)
  (hb : b ≠ 0)
  (hc : c ≠ 0)
  (h_coprime_ab : coprime a b)
  (h_coprime_bc : coprime b c)
  (h_coprime_ca : coprime c a)
   : degree a - degree (gcd a d[a]) + (degree b - degree (gcd b d[b])) + (degree c - degree (gcd c d[c])) - 1 ≤
  degree (rad (a * b * c)) - 1:=
begin
  apply nat.sub_le_sub_right,
  have h_rad:  degree(rad(a))+degree(rad(b))+degree(rad(c)) ≤ degree(rad(a*b*c)),
    from h_rad_add ha hb hc h_coprime_ab h_coprime_bc h_coprime_ca,
  refine nat.le_trans _ h_rad,
  apply nat.add_mono _ (Mason_Stothers_lemma' c),
  apply nat.add_mono (Mason_Stothers_lemma' a) (Mason_Stothers_lemma' b),
end

private lemma h_dvd_wron_a
(a b c : polynomial β): gcd a d[a] ∣ d[a] * b - a * d[b] :=
 begin
  have h1 : gcd a d[a] ∣ d[a] * b,
  {
    apply dvd_trans gcd_right,
    apply dvd_mul_of_dvd_left,
    simp
  },
  have h2 : gcd a d[a] ∣ a * d[b],
  {
    apply dvd_trans gcd_left,
    apply dvd_mul_of_dvd_left,
    simp
  },
  exact dvd_sub h1 h2,
end

private lemma h_dvd_wron_b
(a b c : polynomial β): gcd b d[b] ∣ d[a] * b - a * d[b] :=
begin
  have h1 : gcd b d[b] ∣ d[a] * b,
  {
    apply dvd_trans gcd_left,
    apply dvd_mul_of_dvd_right,
    simp
  },
  have h2 : gcd b d[b] ∣ a * d[b],
  {
    apply dvd_trans gcd_right,
    apply dvd_mul_of_dvd_right,
    simp
  },
  exact dvd_sub h1 h2,
end

private lemma h_dvd_wron_c
(a b c : polynomial β)
(h_wron : d[a] * b - a * d[b] = d[a] * c - a * d[c])
: gcd c d[c] ∣ d[a] * b - a * d[b] :=
begin
  rw h_wron,
  have h1 : gcd c d[c] ∣ a * d[c],
  {
    apply dvd_trans gcd_right,
    apply dvd_mul_of_dvd_right,
    simp
  },
  have h2 : gcd c d[c] ∣ d[a] * c,
  {
    apply dvd_trans gcd_left,
    apply dvd_mul_of_dvd_right,
    simp
  },
  exact dvd_sub h2 h1,
end

private lemma one_le_of_ne_zero {n : ℕ } (h : n ≠ 0) : 1 ≤ n :=
begin
  let m := some (nat.exists_eq_succ_of_ne_zero h),
  have h1 : n = nat.succ m,
  from some_spec (nat.exists_eq_succ_of_ne_zero h),
  rw [h1, nat.succ_le_succ_iff],
  exact nat.zero_le _,
end
/-
Todo can we remove the a = 0, b = 0 cases?
lemma degree_wron_le {a b : polynomial β} : degree (d[a] * b - a * d[b]) ≤ degree a + degree b - 1 :=
begin
  by_cases h1 : (a = 0),
  {
    simp *,
    exact nat.zero_le _,
  },
  {
    by_cases h2 : (degree a = 0),
    {

      by_cases h3 : (b = 0),
      {
        rw h3,
        simp,
        exact nat.zero_le _,
      },
      {
        simp [*],
        by_cases h4 : (degree b = 0),
        {
          simp *,
          rw [←is_constant_iff_degree_eq_zero] at *,
          have h5 : derivative a = 0,
          from derivative_eq_zero_of_is_constant h2,
          have h6 : derivative b = 0,
          from derivative_eq_zero_of_is_constant h4,
          simp *,
        },
        {
          have h2a : degree a = 0,
          from h2,
          rw [←is_constant_iff_degree_eq_zero] at h2,
          have h5 : derivative a = 0,
          from derivative_eq_zero_of_is_constant h2,
          simp *,
          by_cases h6 : (derivative b = 0),
          {
            simp *,
            exact nat.zero_le _,
          },
          {
            --rw [degree_neg],
            apply nat.le_trans degree_mul,
            simp *,
            exact degree_derivative_le,
          }
        },

      }
    },
    {
      by_cases h3 : (b = 0),
      {
        simp *,
        exact nat.zero_le _,
      },
      {
        by_cases h4 : (degree b = 0),
        {
          simp *,
          rw [←is_constant_iff_degree_eq_zero] at h4,
          have h5 : derivative b = 0,
          from derivative_eq_zero_of_is_constant h4,
          simp *,
          apply nat.le_trans degree_mul,
          rw [is_constant_iff_degree_eq_zero] at h4,
          simp *,
          exact degree_derivative_le,
        },
        {
          apply nat.le_trans degree_sub,
          have h5 : degree (d[a] * b) ≤ degree a + degree b - 1,
          {
            apply nat.le_trans degree_mul,
            rw [add_comm _ (degree b), add_comm _ (degree b), nat.add_sub_assoc],
            apply add_le_add_left,
            exact degree_derivative_le,
            exact polynomial.one_le_of_ne_zero h2, --Can I remove this from polynomial??
          },
          have h6 : (degree (a * d[b])) ≤ degree a + degree b - 1,
          {
            apply nat.le_trans degree_mul,
            rw [nat.add_sub_assoc],
            apply add_le_add_left,
            exact degree_derivative_le,
            exact polynomial.one_le_of_ne_zero h4,
          },
          exact max_le h5 h6,
        }
      }
    }
  }
end-/

lemma degree_wron_le {a b : polynomial β} : degree (d[a] * b - a * d[b]) ≤ degree a + degree b - 1 :=
begin
  by_cases h2 : (degree a = 0),
  {
    simp [is_constant_iff_degree_eq_zero, derivative_eq_zero_of_is_constant, *] at *,
    by_cases h6 : (derivative b = 0),
    { simp [nat.zero_le, *]},
    {
      apply nat.le_trans degree_mul,
      simp [degree_derivative_le, *],
    }
  },
  {
    by_cases h4 : (degree b = 0), --This case distinction shouldnn't be needed
    {
      simp [is_constant_iff_degree_eq_zero, derivative_eq_zero_of_is_constant, *] at *,
      apply nat.le_trans degree_mul,
      simp [degree_derivative_le, *],
    },
    {
      apply nat.le_trans degree_sub,
      have h5 : degree (d[a] * b) ≤ degree a + degree b - 1,
      {
        apply nat.le_trans degree_mul,
        rw [add_comm _ (degree b), add_comm _ (degree b), nat.add_sub_assoc (polynomial.one_le_of_ne_zero h2)],
        apply add_le_add_left degree_derivative_le,
      },
      have h6 : (degree (a * d[b])) ≤ degree a + degree b - 1,
      {
        apply nat.le_trans degree_mul,
        rw [nat.add_sub_assoc (polynomial.one_le_of_ne_zero h4)],
        apply add_le_add_left degree_derivative_le,
      },
      exact max_le h5 h6,
    }
  }
end

private lemma h_wron_ne_zero
  (a b c : polynomial β)
  (h_coprime_ab : coprime a b)
  (h_coprime_ca : coprime c a)
  (h_der_not_all_zero : ¬(d[a] = 0 ∧ d[b] = 0 ∧ d[c] = 0))
  (h_wron : d[a] * b - a * d[b] = d[a] * c - a * d[c]):
  d[a] * b - a * d[b] ≠ 0 :=
begin
  by_contradiction h1,
  rw not_not at h1,
  have h_a_b : d[a] = 0 ∧ d[b] = 0,
  from derivative_eq_zero_and_derivative_eq_zero_of_coprime_of_wron_eq_zero h_coprime_ab h1,
  have h2 : d[a] * c - a * d[c] = 0,
  {rw [←h_wron, h1]},
  have h_a_c : d[a] = 0 ∧ d[c] = 0,
  from derivative_eq_zero_and_derivative_eq_zero_of_coprime_of_wron_eq_zero (h_coprime_ca.symm) h2,
  have h3 : (d[a] = 0 ∧ d[b] = 0 ∧ d[c] = 0),
  exact ⟨and.elim_left h_a_b, and.elim_right h_a_b, and.elim_right h_a_c⟩,
  contradiction
end

private lemma h_deg_add
  (a b c : polynomial β)
  (h_wron_ne_zero : d[a] * b - a * d[b] ≠ 0)
  (h_gcds_dvd : (gcd a d[a]) * (gcd b d[b]) * (gcd c d[c]) ∣ d[a] * b - a * d[b]):
  degree (gcd a d[a] * gcd b d[b] * gcd c d[c]) = degree (gcd a d[a]) + degree (gcd b d[b]) + degree (gcd c d[c]) :=
begin
  have h1 : gcd a d[a] * gcd b d[b] * gcd c d[c] ≠ 0,
    from ne_zero_of_dvd_ne_zero h_gcds_dvd h_wron_ne_zero,
  have h2 : degree (gcd a d[a] * gcd b d[b] * gcd c d[c]) = degree (gcd a d[a] * gcd b d[b]) + degree (gcd c d[c]),
    from degree_mul_eq_add_of_mul_ne_zero h1,
  have h3 : gcd a d[a] * gcd b d[b] ≠ 0,
    from ne_zero_of_mul_ne_zero_right h1,
  have h4 : degree (gcd a d[a] * gcd b d[b]) = degree (gcd a d[a]) + degree (gcd b d[b]),
    from degree_mul_eq_add_of_mul_ne_zero h3,
  rw [h2, h4],
end

private lemma h_wron
(a b c : polynomial β)
(h_add : a + b = c)
(h_der : d[a] + d[b] = d[c])
: d[a] * b - a * d[b] = d[a] * c - a * d[c] :=
begin
  have h1 : d[a] * a + d[a] * b = d[a] * c,
    exact calc d[a] * a + d[a] * b = d[a] * (a + b) : by rw [mul_add]
    ... = _ : by rw h_add,
  have h2 : a * d[a] + a * d[b] = a * d[c],
    exact calc a * d[a] + a * d[b] = a * (d[a] + d[b]) : by rw [mul_add]
    ... = _ : by rw h_der,
  have h3 : d[a] * b - a * d[b] = d[a] * c - a * d[c],
    exact calc d[a] * b - a * d[b] = d[a] * b + (d[a] * a - d[a] * a) - a * d[b] : by simp
    ... = d[a] * b + d[a] * a - d[a] * a - a * d[b] : by simp
    ... = d[a] * c - (d[a] * a +  a * d[b]) : by simp [h1]
    ... = d[a] * c - (a * d[a] +  a * d[b]) : by rw [mul_comm _ a]
    ... = _ : by rw h2,
  exact h3
end

private lemma h_gcds_dvd
(a b c : polynomial β)
(h_coprime_ab : coprime a b)
(h_coprime_bc : coprime b c)
(h_coprime_ca : coprime c a)
(h_dvd_wron_a : gcd a d[a] ∣ d[a] * b - a * d[b])
(h_dvd_wron_b : gcd b d[b] ∣ d[a] * b - a * d[b])
(h_dvd_wron_c : gcd c d[c] ∣ d[a] * b - a * d[b]):
  (gcd a d[a]) * (gcd b d[b]) * (gcd c d[c]) ∣ d[a] * b - a * d[b] :=
begin
  apply mul_dvd_of_dvd_of_dvd_of_coprime,
  apply coprime_mul_of_coprime_of_coprime_of_coprime,
  exact coprime_gcd_derivative_gcd_derivative_of_coprime (h_coprime_ca.symm) _ _,
  exact coprime_gcd_derivative_gcd_derivative_of_coprime h_coprime_bc _ _,
  apply mul_dvd_of_dvd_of_dvd_of_coprime,
  exact coprime_gcd_derivative_gcd_derivative_of_coprime h_coprime_ab _ _,
  exact h_dvd_wron_a,
  exact h_dvd_wron_b,
  exact h_dvd_wron_c
end

private lemma degree_rad_pos
(a b c : polynomial β)
(ha : a ≠ 0)
(hb : b ≠ 0)
(hc : c ≠ 0)
(h_constant : ¬(is_constant a ∧ is_constant b ∧ is_constant c)) :
degree (rad (a*b*c)) > 0 :=
begin
  apply gt_zero_of_ne_zero,
  rw [ne.def, degree_rad_eq_zero_iff_is_constant],
  simp only [not_and_distrib] at *,
  have : a * b ≠ 0,
    from mul_ne_zero ha hb,
  cases h_constant,
  { simp [not_is_constant_mul_of_not_is_constant_of_ne_zero, *]},
  cases h_constant,
  { simp [mul_comm a, not_is_constant_mul_of_not_is_constant_of_ne_zero, *]},
  { simp [mul_comm _ c, not_is_constant_mul_of_not_is_constant_of_ne_zero, *]}
end

theorem Mason_Stothers_special [field β]
  (h_char : characteristic_zero β)
  (a b c : polynomial β)
  (ha : a ≠ 0)
  (hb : b ≠ 0)
  (hc : c ≠ 0)
  (h_coprime_ab : coprime a b)
  (h_coprime_bc : coprime b c)
  (h_coprime_ca : coprime c a)
  (h_add : a + b = c)
  (h_constant : ¬(is_constant a ∧ is_constant b ∧ is_constant c)) :
  degree c < degree ( rad (a*b*c)) :=

begin
  have h_der_not_all_zero : ¬(d[a] = 0 ∧ d[b] = 0 ∧ d[c] = 0),
  {
    rw [derivative_eq_zero_iff_is_constant h_char, derivative_eq_zero_iff_is_constant h_char, derivative_eq_zero_iff_is_constant h_char],
    exact h_constant,
  },
  have h_der : d[a] + d[b] = d[c],
  {
    rw [←h_add, derivative_add],
  },
  have h_wron : d[a] * b - a * d[b] = d[a] * c - a * d[c],
    from  h_wron a b c h_add h_der,
  have h_dvd_wron_a : gcd a d[a] ∣ d[a] * b - a * d[b],
    from h_dvd_wron_a a b c,
  have h_dvd_wron_b : gcd b d[b] ∣ d[a] * b - a * d[b],
    from h_dvd_wron_b a b c,
  have h_dvd_wron_c : gcd c d[c] ∣ d[a] * b - a * d[b],
    from h_dvd_wron_c a b c h_wron,
  have h_gcds_dvd : (gcd a d[a]) * (gcd b d[b]) * (gcd c d[c]) ∣ d[a] * b - a * d[b],
    from h_gcds_dvd a b c h_coprime_ab h_coprime_bc h_coprime_ca h_dvd_wron_a h_dvd_wron_b h_dvd_wron_c,
  have h_wron_ne_zero : d[a] * b - a * d[b] ≠ 0,
    from h_wron_ne_zero a b c h_coprime_ab h_coprime_ca h_der_not_all_zero h_wron,
  have h_deg_add : degree (gcd a d[a] * gcd b d[b] * gcd c d[c]) = degree (gcd a d[a]) + degree (gcd b d[b]) + degree (gcd c d[c]),
    from h_deg_add a b c h_wron_ne_zero h_gcds_dvd,
  have h_deg_add_le : degree (gcd a d[a]) + degree (gcd b d[b]) + degree (gcd c d[c]) ≤ degree a + degree b - 1,
  {
    rw [←h_deg_add],
    have h1 : degree (gcd a d[a] * gcd b d[b] * gcd c d[c]) ≤ degree (d[a] * b - a * d[b]),
      from degree_dvd h_gcds_dvd h_wron_ne_zero,
    exact nat.le_trans h1 (degree_wron_le),
  },
  have h_deg_c_le_1 : degree c ≤ (degree a - degree (gcd a d[a])) + (degree b - degree (gcd b d[b])) + (degree c - degree (gcd c d[c])) - 1,
    from rw_aux_1 a b c h_add h_constant h_deg_add_le,
  have h_le_rad : degree a - degree (gcd a d[a]) + (degree b - degree (gcd b d[b])) + (degree c - degree (gcd c d[c])) - 1 ≤
  degree (rad (a * b * c)) - 1,
    from rw_aux_2 ha hb hc h_coprime_ab h_coprime_bc h_coprime_ca,
  have h_ms : degree c ≤ degree ( rad (a*b*c)) - 1,
    from nat.le_trans h_deg_c_le_1 h_le_rad,
  have h_eq : degree ( rad (a*b*c)) - 1 + 1 = degree ( rad (a*b*c)),
  {
    have h_pos : degree ( rad (a*b*c)) > 0,
      from degree_rad_pos a b c ha hb hc h_constant,
    apply nat.succ_pred_eq_of_pos h_pos,
  },
  exact show degree c < degree ( rad (a*b*c)), from calc degree c + 1 ≤ degree ( rad (a*b*c) ) - 1 + 1 : by simp [h_ms]
    ... = degree ( rad (a*b*c)) : h_eq
end

--place in to_multiset
private lemma cons_ne_zero {γ : Type u}(a : γ)(s : multiset γ): a :: s ≠ 0 :=
begin
  intro h,
  have : a ∈ a :: s,
  {
    simp,
  },
  simp * at *,
end

--place in to_multiset
--private?
private lemma map_eq_zero_iff_eq_zero {γ ζ : Type u} (s : multiset γ)(f: γ → ζ): map f s = 0 ↔ s = 0 :=
begin
  apply multiset.induction_on s,
  {
    simp * at *,
  },
  {
    intros a s h,
    split,
    {
      intro h1,
      simp * at *,
      have h2 : false,
        from cons_ne_zero _ _ h1,
      contradiction,
    },
    {
      intro h1,
      simp * at *,
    },
  }
end

--structure?
lemma factors_eq_factors_of_associated {a b : polynomial β} (h : (a ~ᵤ b)): a.factors = b.factors :=
begin
  rw [factors_eq_map_monic_out_to_multiset_mk, factors_eq_map_monic_out_to_multiset_mk],
  rw [associated_iff_mk_eq_mk] at *,
  simp * at *,
end

@[simp] lemma rad_neg_eq_rad [field β] (p : polynomial β) : rad (-p) = rad p :=
begin
  have hp : (p ~ᵤ (-p)),
    from associated_neg _,
  have h1 : p.factors = (-p).factors,
    from factors_eq_factors_of_associated hp,
  rw [rad, rad, h1],
end

@[simp] lemma coprime_neg_iff_coprime_left {a b : polynomial β} : coprime (-a) b ↔ coprime a b :=
begin
  split,
  {
    intro h,
    apply coprime_of_coprime_of_associated_left h (associated_neg _),
  },
  {
    intro h,
    apply coprime_of_coprime_of_associated_left h (associated_neg a).symm, --again elaborator does no longer find placeholder
  }
end

@[simp] lemma coprime_neg_iff_coprime_right {a b : polynomial β} : coprime a (-b) ↔ coprime a b :=
begin
  split,
  {
    intro h,
    apply coprime_of_coprime_of_associated_right h (associated_neg _),
  },
  {
    intro h,
    apply coprime_of_coprime_of_associated_right h (associated_neg b).symm,
  }
end

private lemma neg_eq_zero_iff_eq_zero {a : polynomial β} : -a = 0 ↔ a = 0 :=
begin
  split,
  {
    intro h,
    exact calc a = -(-a) : by simp
      ... = - (0) : by rw h
      ... = _ : by simp
  },
  {
    intro h,
    simp *,
  }
end

private lemma neg_ne_zero_iff_ne_zero {a : polynomial β} : -a ≠ 0 ↔ a ≠ 0 :=
  not_iff_not_of_iff neg_eq_zero_iff_eq_zero

local attribute [simp] is_constant_neg_iff_is_constant

theorem Mason_Stothers_case_c [field β]
  (h_char : characteristic_zero β)
  (a b c : polynomial β)
  (ha : a ≠ 0)
  (hb : b ≠ 0)
  (hc : c ≠ 0)
  (h_coprime_ab : coprime a b)
  (h_coprime_bc : coprime b c)
  (h_coprime_ca : coprime c a)
  (h_add : a + b + c = 0)
  (h_constant : ¬(is_constant a ∧ is_constant b ∧ is_constant c)): --You can do this one by cc? simpa [and.comm, and.left_comm, and.assoc] using h_constant
  degree c < degree ( rad (a*b*c)) :=
  begin
    have h_c : degree (-c) < degree ( rad (a*b*(-c))),
    {
      have h_add : a + b = - c,
      {
        exact calc a + b = a + b + (c - c) : by simp
          ... = a + b + c - c : by simp
          ... = 0 - c : by rw [h_add]
          ... = _ : by simp,
      },
      rw ←(is_constant_neg_iff_is_constant c) at h_constant, --The argument should not have been implicit
      apply Mason_Stothers_special h_char _ _ _ ha hb _ h_coprime_ab _ _ h_add h_constant,--We need relPrime.symm in general
      {
        simp [neg_ne_zero_iff_ne_zero, *],
      },
      have : coprime b (-c),--Rather as rw, rather as simp rule, coprime a -c = coprime a c
        from coprime_neg_iff_coprime_right.2 h_coprime_bc,
      exact this,
      have : coprime (-c) a,
        from coprime_neg_iff_coprime_left.2 h_coprime_ca,
      exact this,
    },
    have h_neg_abc: a * b * -c = - (a * b * c),
    {
      simp,
    },
    rw [degree_neg, h_neg_abc, rad_neg_eq_rad] at h_c,
    exact h_c,
  end

theorem Mason_Stothers_case_a [field β]
  (h_char : characteristic_zero β)
  (a b c : polynomial β)
  (ha : a ≠ 0)
  (hb : b ≠ 0)
  (hc : c ≠ 0)
  (h_coprime_ab : coprime a b)
  (h_coprime_bc : coprime b c)
  (h_coprime_ca : coprime c a)
  (h_add : a + b + c = 0)
  (h_constant : ¬(is_constant a ∧ is_constant b ∧ is_constant c)):
  degree a < degree (rad (a*b*c)) :=
/-
suffices degree a < degree (rad (c*b*a)),
  from Mason_Stothers_case_c h_char c b a hc hb ha _ _ _ _ _,
_
-/

  begin
    have h_a : degree (-a) < degree ( rad (b*c*(-a))),
    {
      have h_add_1 : b + c + a = 0,
      {
        simpa [add_comm, add_assoc] using h_add,
      },
      have h_add_2 : b + c = - a,
      {
        exact calc b + c = b + c + (a - a) : by simp
          ... = b + c + a - a : by simp
          ... = 0 - a : by rw [h_add_1]
          ... = _ : by simp,
      },
      have h_constant_2 : ¬(is_constant b ∧ is_constant c ∧ is_constant (-a)),
      {
        simpa [(is_constant_neg_iff_is_constant a), and_comm, and_assoc] using h_constant,
        intros h1 h2,
        simp *,
      },
      apply Mason_Stothers_special h_char b c (-a) hb hc (neg_ne_zero_iff_ne_zero.2 ha) h_coprime_bc _ _ h_add_2 h_constant_2,
      {
        simp *,
      },
      {
        simp *,
      },
    },
    have h_neg_abc: b * c * -a = - (a * b * c),
    {
      simp,
      exact calc b * c * a = b * (a * c) : by rw [mul_assoc, mul_comm c a]
        ... = _ : by rw [←mul_assoc, mul_comm b a],
    },
    rw [degree_neg, h_neg_abc, rad_neg_eq_rad] at h_a,
    exact h_a,
  end

theorem Mason_Stothers_case_b [field β]
  (h_char : characteristic_zero β)
  (a b c : polynomial β)
  (ha : a ≠ 0)
  (hb : b ≠ 0)
  (hc : c ≠ 0)
  (h_coprime_ab : coprime a b)
  (h_coprime_bc : coprime b c)
  (h_coprime_ca : coprime c a)
  (h_add : a + b + c = 0)
  (h_constant : ¬(is_constant a ∧ is_constant b ∧ is_constant c)):
  degree b < degree ( rad (a*b*c)) :=
  begin
    have h_b : degree (-b) < degree ( rad (a*c*(-b))),
    {
      have h_add_1 : a + c + b = 0,
      {
        simpa [add_comm, add_assoc] using h_add,
      },
      have h_add_2 : a + c = - b,
      {
        exact calc a + c = a + c + (b - b) : by simp
          ... = a + c + b - b : by simp
          ... = 0 - b : by rw [h_add_1]
          ... = _ : by simp,
      },
      have h_constant_2 : ¬(is_constant a ∧ is_constant c ∧ is_constant (-b)),
      {
        simpa [(is_constant_neg_iff_is_constant b), and_comm, and_assoc] using h_constant,
      },
      apply Mason_Stothers_special h_char a c (-b) ha hc (neg_ne_zero_iff_ne_zero.2 hb) h_coprime_ca.symm _ _ h_add_2 h_constant_2,
      {
        simp [h_coprime_bc.symm, *],
      },
      {
        simp [h_coprime_ab.symm, *],
      }
    },
    have h_neg_abc: a * c * -b = - (a * b * c),
    {
      simp,
      exact calc a * c * b = a * (b * c) : by rw [mul_assoc, mul_comm c b]
        ... = _ : by rw [←mul_assoc],
    },
    rw [degree_neg, h_neg_abc, rad_neg_eq_rad] at h_b,
    exact h_b,
  end

theorem Mason_Stothers [field β]
  (h_char : characteristic_zero β)
  (a b c : polynomial β)
  (ha : a ≠ 0)
  (hb : b ≠ 0)
  (hc : c ≠ 0)
  (h_coprime_ab : coprime a b)
  (h_coprime_bc : coprime b c)
  (h_coprime_ca : coprime c a)
  (h_add : a + b + c = 0)
  (h_constant : ¬(is_constant a ∧ is_constant b ∧ is_constant c)):
  max (degree a) (max (degree b) (degree c)) < degree ( rad (a*b*c)) :=
begin
  have h_a: degree a < degree ( rad (a*b*c)),
    from Mason_Stothers_case_a h_char a b c ha hb hc h_coprime_ab h_coprime_bc h_coprime_ca h_add h_constant,
  have h_b: degree b < degree ( rad (a*b*c)),
    from Mason_Stothers_case_b h_char a b c ha hb hc h_coprime_ab h_coprime_bc h_coprime_ca h_add h_constant,
  have h_c: degree c < degree ( rad (a*b*c)),
    from Mason_Stothers_case_c h_char a b c ha hb hc h_coprime_ab h_coprime_bc h_coprime_ca h_add h_constant,
  apply max_lt h_a,
  apply max_lt h_b h_c,
end

end mason_stothers


import graphtheory
import tactic
import data.set
import data.nat.basic
import data.nat.modeq
import data.nat.parity
import data.nat.lattice
import logic.basic
import set_theory.zfc

open finset
open classical
open nat
open function

variables {V: Type} [fintype V] [inhabited V] [decidable_eq V]

def neighbor_set (G: refl_graph V) (v : V) : set V := set_of (G.adj v)
def neighbor_set' (G: refl_graph V) (v : V) : set V := { w | G.adj v w }

lemma not_subset_iff_exists_mem_not_mem {α : Type*} {s t : set α} :
  ¬ s ⊆ t ↔ ∃ x, x ∈ s ∧ x ∉ t :=
begin
  split,
  contrapose, push_neg, intro v, exact v,
  contrapose, push_neg, intro v, exact v,
end

/-
Corner vertices, an important concept in Cops and Robbers
A vtx w is a corner iff there exists some vertex v such that the neighbors of w is a subset of the neighbors of v
-/
noncomputable theory

def corner_vtx (G: refl_graph V) (w: V)  : Prop :=
  (∃ (v: V) (h: v ≠ w), (neighbor_set' G w) ⊆ (neighbor_set' G v))

def cornering_vtx (G: refl_graph V) (w: V) (h: corner_vtx G w) : V := some h

def has_corner (G: refl_graph V) : Prop :=
  fintype.card V=1 ∨ (∃ w , corner_vtx G w)

def corner_cmp (G: refl_graph V) (v w: V)  : Prop :=
  v ≠ w ∧ (neighbor_set' G w) ⊆ (neighbor_set' G v)

open_locale classical
noncomputable theory

lemma odd_succ {n : ℕ} : odd n.succ ↔ ¬ odd n :=
by rw [succ_eq_add_one, odd_add]; simp [not_even_one]

lemma mod2_zero_or_one : ∀ n : ℕ, n%2=1 ∨ n%2=0 :=
begin
  intro n,
  rw nat.even_iff.symm, rw nat.odd_iff.symm,
  exact (nat.even_or_odd n).symm,
end

lemma even_succ_succ : ∀ n : ℕ, even n.succ.succ ↔ even n :=
begin
  intro n,
  rw [nat.even_succ, nat.odd_iff_not_even.symm, odd_succ, nat.even_iff_not_odd.symm],
end

lemma odd_succ_succ : ∀ n : ℕ, odd n.succ.succ ↔ odd n :=
begin
  intro n,
  rw [odd_succ, nat.even_iff_not_odd.symm, nat.even_succ, nat.odd_iff_not_even.symm],
end

def rob_strat_fn (G: refl_graph V) : vector V 1 × V → V :=
  λ x , if h : ∃ w, G.adj x.2 w ∧ ¬ G.adj x.1.head w then some h else x.2

theorem rsfn_works {G: refl_graph V}
    (P : vector V 1 × V)  (h : ∃ w, G.adj P.2 w ∧ ¬ G.adj P.1.head w) :
  G.adj P.2 (rob_strat_fn G P) ∧ ¬ G.adj P.1.head (rob_strat_fn G P) :=
begin
  rewrite rob_strat_fn,
  simp,
  rw dif_pos h,
  apply some_spec h,
end

theorem rsfn_works' {G: refl_graph V}
     (P : vector V 1 × V) (h : ¬ ∃ w, G.adj P.2 w ∧ ¬ G.adj P.1.head w) :
  rob_strat_fn G P = P.2 :=
begin
  rw rob_strat_fn, simp, by_contradiction K, simp at K, cases K with x K,cases K with h' K,
  push_neg at h, specialize h x, specialize h h'.1, have h'' : ¬G.adj P.fst.head x, exact h'.2,
  contradiction,
end

lemma adj (G: refl_graph V) (P : vector V 1 × V) :
  G.adj P.2 (rob_strat_fn G P) :=
begin
  by_cases h : ∃ w, G.adj P.2 w ∧ ¬ G.adj P.1.head w,
  { exact (rsfn_works P h).1 },
  rw rsfn_works' P h,
  apply G.selfloop,
end

def rob_init_fn  (G: refl_graph V) : vector V 1 → V :=
 λ x, if h : ∃ w, w ≠ x.head then
 (if g: ∃ w, ¬ G.adj x.head w then some g else some h)
 else x.head

def pre_smart_robber (G: refl_graph V) : pre_rob_strat G 1 :=
{ init := rob_init_fn G, strat := rob_strat_fn G }

def smart_robber (G: refl_graph V) : rob_strat G 1
:=
{ strat := pre_smart_robber G,
  nocheat:=
  begin
    intros CS i cap, conv {congr, congr, rw pre_smart_robber}, simp,
    set K := (pre_round CS (pre_smart_robber G) i),
    have hyp' : ¬∃ w, G.adj K.2 w ∧ ¬ G.adj K.1.head w,
    { by_contradiction sps,
      cases cap with w hw, have this: w=0, simp, rw this at hw, simp at hw,
      rw hw at sps, cases sps with y hy, exact (and_not_self (G.adj K.snd y)).mp hy, },
    rw rob_strat_fn, simp,
    by_contradiction K', push_neg at K', cases K' with x K', cases K' with h' K',
    push_neg at hyp', specialize hyp' x, specialize hyp' h'.1, have h'' : ¬G.adj K.fst.head x, exact h'.2,
    contradiction,
  end,
  legal:= begin intros v P, exact adj G (P, v), end,
}

--If the cop strategy is winning, the minimum round of capture is always achieved
theorem wcs_min_rounds {G: refl_graph V} {k :ℕ }
  (CS: cop_strat G k) :
  winning_strat_cop CS → ∀ RS: rob_strat G k, ∃ n:ℕ , n = Inf{n:ℕ | capture (round CS RS n)} :=
begin
  intro h, intro RS, rw winning_strat_cop at h, specialize h RS, simp,
end

--If the cop captures at some round n, then he captures for all m >= n
theorem capt_upwards_closed {G: refl_graph V} {n: ℕ} {CS: cop_strat G n} {RS: rob_strat G n} : ∀ k1 k2 : ℕ , k1 ≤ k2 → k1 ∈ {n:ℕ | capture (round CS RS n)} → k2 ∈ {n:ℕ | capture (round CS RS n)} :=
begin
  intros k1 k2 le inc,
  suffices : ∀ k1, k1 ∈ {n:ℕ | capture (round CS RS n)} → k1.succ ∈ {n:ℕ | capture (round CS RS n)}, { exact nat.le_rec_on le this inc,}, clear inc le k1 k2,
  intros k1 hyp, simp at hyp, simp,
  cases k1, rw [capture, round], simp,
  let nocheat := CS.nocheat RS.strat 0 hyp,
  rw round at hyp, rw capture at hyp, cases hyp with m hyp', rw pre_round at hyp', simp at hyp',
  use m, rw [pre_round, hyp'.symm] at nocheat, rw pre_round, simp, rw pre_round, simp, rw hyp'.symm, rw nocheat,
  cases (nat.even_or_odd k1.succ),
  rw [nat.even_iff_not_odd, odd_succ.symm, nat.odd_iff_not_even] at h,
  let nocheat := CS.nocheat RS.strat k1.succ hyp,
  cases hyp with m hyp, use m, rw [round, pre_round, if_neg h, nocheat], simp, rw round at hyp, exact hyp,
  rw [nat.odd_iff_not_even, nat.even_succ.symm] at h,
  let nocheat := RS.nocheat CS.strat k1.succ hyp,
  cases hyp with m hyp, use m, rw [round, pre_round, if_pos h, nocheat], rw round at hyp, exact hyp,
end

--Simple lemma for reasoning
lemma cop_catch_nonempty {G: refl_graph V} {n: ℕ} {CS: cop_strat G n} {RS: rob_strat G n} {win : winning_strat_cop CS} {k : ℕ } : k = Inf{n:ℕ | capture (round CS RS n)} ↔ capture (round CS RS k) ∧ ∀ i < k, ¬ capture (round CS RS i) :=
begin
  split, intro cap, split,
  suffices this : {n_1 : ℕ | capture (round CS RS n_1)}.nonempty,
    let x := nat.Inf_mem this, rw cap.symm at x, exact x,
  specialize win RS, cases win with w win, exact set.nonempty_of_mem win,
  intros i h, rw cap at h, exact nat.not_mem_of_lt_Inf h,
  intro h, cases k, symmetry, rw nat.Inf_eq_zero, exact or.inl h.1,
  symmetry, rw nat.Inf_upward_closed_eq_succ_iff, split, exact h.1,
  simp, exact h.2 k (nat.lt_succ_self k), exact capt_upwards_closed,
end

--A smart robber will stay in place before cop captures.
theorem smart_rob_in_place {G: refl_graph V} {CS: cop_strat G 1} {n : ℕ} (p: winning_strat_cop CS) (cap : n = Inf{n:ℕ | capture (round CS (smart_robber G) n)}) (gt: n > 1) : (round CS (smart_robber G) n.pred.pred).2  = (round CS (smart_robber G) n.pred).2 :=
begin
 cases n, let x := nat.not_lt_zero 1, contradiction,
 cases n, let x := nat.lt_irrefl 1, contradiction,
 rw [nat.pred_succ (n.succ), nat.pred_succ n],
 rw cop_catch_nonempty at cap,
 cases (nat.even_or_odd n.succ.succ),
 -- if n+2 is even
 rw nat.even_succ at h,
 conv { to_rhs, rw round, rw pre_round}, rw if_neg h, rw round,
-- if n+2 is odd
 rw [odd_succ, nat.odd_iff_not_even, nat.succ_eq_add_one] at h, push_neg at h,
 conv { to_rhs, rw round, rw pre_round}, rw if_pos h, simp,
 conv { to_rhs, congr,rw smart_robber, }, simp,
 suffices this : ¬ ∃ (w : V), G.adj (round CS (smart_robber G) n).snd w ∧ ¬G.adj (round CS (smart_robber G) n).fst.head w,
  rw pre_smart_robber, simp, rw rob_strat_fn, simp, rw round at this, rw dif_neg this, refl,
 by_contradiction K,
 have this: ¬ capture (round CS (smart_robber G) n.succ.succ),
  rw capture, push_neg, intro i, have this: i=0, simp, rw this, clear this i, simp,
  rw round, have this : ¬ even (n.succ +1), simp with parity_simps, exact nat.even_succ.1 h,
  rw [pre_round, if_neg this, pre_round, if_pos h], simp, conv { congr, to_rhs, congr, rw smart_robber,}, simp, rw [pre_smart_robber, rob_strat_fn], simp, rw round at K, rw dif_pos K,
  have nadj1 : ¬ G.adj (round CS (smart_robber G) n).fst.head (some K), by exact (some_spec K).2,
  have nadj2: G.adj ((round CS (smart_robber G) n).1.head) ((CS.strat.strat (round CS (smart_robber G) n.succ)).head),
    conv{ congr, skip, skip, rw [round, pre_round]}, rw if_pos h,
    let x := CS.legal 0 ((smart_robber G).strat.strat (round CS (smart_robber G) n)) (round CS (smart_robber G) n).1,
    simp at x, exact x,
  let x := (rgraph_adj_cmp nadj1 nadj2).symm, rw [round, pre_round, if_pos h] at x, exact x,
 exact this (cap.1), exact p,
end

-- A smart robber will never get caught on their own turn
theorem smart_capture_cop_move {G: refl_graph V} {CS: cop_strat G 1} {n : ℕ} (p: winning_strat_cop CS) (cap : n = Inf{n:ℕ | capture (round CS (smart_robber G) n)}) (gt: n > 0) : odd n :=
begin
  rw cop_catch_nonempty at cap,
  have : n ≠ 0, linarith,
  let pred_no_cap := cap.2 n.pred (nat.pred_lt this),
  by_contradiction,
  suffices goal : (round CS (smart_robber G) n).1.head ≠ (round CS (smart_robber G) n).2,
    have nocap_atn : ¬ capture (round CS (smart_robber G) n),
      rw capture, push_neg, intro i, have this: i=0, simp, rw this, simp, exact goal,
    exact nocap_atn cap.1,
  have rob_in_place: (smart_robber G).strat.strat (round CS (smart_robber G) n.pred) = (round CS (smart_robber G) n.pred).2,
    cases n, contradiction, rw (nat.pred_succ n),
    suffices this: ¬ (∃ (w : V), G.adj (round CS (smart_robber G) n).snd w ∧ ¬G.adj (round CS (smart_robber G) n).fst.head w),
      conv {
        to_lhs, congr, rw smart_robber,
      }, simp, by_contradiction K', rw [pre_smart_robber, rob_strat_fn] at K', simp at K', cases K' with x K', cases K' with h' K',
      push_neg at this, specialize this x, specialize this h'.1, have h'' : ¬G.adj (round CS (smart_robber G) n).fst.head x, exact h'.2,
      contradiction,
    by_contradiction K',
    have contradiction: ¬ capture (round CS (smart_robber G) n.succ),
      have this : (smart_robber G).strat.strat (round CS (smart_robber G) n) = some K',
        conv {
          to_lhs, congr, rw smart_robber,
        }, simp, rw [pre_smart_robber, rob_strat_fn], simp, rw dif_pos K',
      rw capture, push_neg, intro i, have this: i=0, simp, rw this, clear this, clear i, simp,
      unfold round, simp at h, rw (nat.add_one n).symm at h, rw [pre_round, if_pos h], simp,
      change (smart_robber G).strat.strat (pre_round CS.strat (smart_robber G).strat n) = _ at this,
      rw this_1, clear this_1,
      suffices this: ¬G.adj (round CS (smart_robber G) n).fst.head (some K'),
        exact rgraph_nadj_imp_neq this,
      exact and.elim_right (classical.some_spec K'),
    exact contradiction cap.1,
  rw capture at pred_no_cap, push_neg at pred_no_cap, specialize pred_no_cap 0,
  cases cap.1 with i cap', have this: i=0, simp, rw this at cap', clear this, clear i,
  cases n, contradiction,
  rw round, rw (nat.add_one n).symm at h, simp at h, rw [pre_round, if_pos h], simp,
  rw (nat.pred_succ n) at rob_in_place, rw (nat.pred_succ n) at pred_no_cap,
  rw rob_in_place.symm at pred_no_cap,  simp at pred_no_cap, exact pred_no_cap, exact p,
end

lemma cwg_1_cop_win (G: refl_graph V): cop_win_graph G ↔ k_cop_win G 1 :=
begin
 split, intro cwg, let non := lots_of_cops G,
 let E:= nat.Inf_mem non, rw [cop_win_graph,cop_number] at cwg, rw cwg at E, exact E,
 intro kcw, rw [cop_win_graph,cop_number],
 rw nat.Inf_upward_closed_eq_succ_iff copnumber_upwards_closed 0,
 split, exact kcw,
 let x := zero_cops_cant_win G, rw cop_number at x, exact nat.not_mem_of_lt_Inf x,
 repeat {apply_instance},
end

lemma sm_rob_turn0_catch_imp_K1 {G: refl_graph V} {CS: cop_strat G 1} (p: winning_strat_cop CS) : capture (round CS (smart_robber G) 0) → fintype.card V = 1 :=
begin
  intro cap, rw [capture, round, pre_round] at cap, simp at cap,
  cases cap with i cap, have this: i=0, simp, rw this at cap, clear this i,
  have: ∀ w, w= CS.strat.init.head,
  { by_contradiction K, push_neg at K,
    rw [smart_robber] at cap, simp at cap, rw [pre_smart_robber, rob_init_fn] at cap, simp at cap, rw dif_pos K at cap,
    split_ifs at cap,
    exact (rgraph_nadj_imp_neq (some_spec h)) cap,
    exact (some_spec K).symm cap },
  exact fintype.card_eq_one_of_forall_eq this,
end

theorem cwg_has_corner  (G: refl_graph V): cop_win_graph G → has_corner G :=
begin
  intro CW,
  rw cwg_1_cop_win at CW,
  cases CW with CS h,
  rw has_corner,
  let RS := smart_robber G,
  have min : ∃ n:ℕ , n = Inf{n:ℕ | capture (round CS RS n)},
    apply wcs_min_rounds CS h,
  cases min with w hw,
  cases w with w wsucc,
  { apply or.inl, simp at hw,
    have : {n : ℕ | capture (round CS RS n)}.nonempty,
      rw winning_strat_cop at h, specialize h RS, exact h,
    let x := nat.Inf_mem this, simp at x, rw hw.symm at x,
    exact sm_rob_turn0_catch_imp_K1 h x,},
  apply or.inr,
  have cap : capture (round CS RS w.succ),
  { have ne: {n : ℕ | capture (round CS RS n)}.nonempty,
    { unfold winning_strat_cop at h, specialize h RS,
      rwa set.nonempty_def,},
    have w_in: w.succ ∈ {n : ℕ | capture (round CS RS n)},
    { have this: Inf{n : ℕ | capture (round CS RS n)} ∈ {n : ℕ | capture (round CS RS n)},
        exact nat.Inf_mem ne, rw hw.symm at this,
      exact this, },
    exact w_in, },
  have w_succ_odd: odd w.succ,
    have this: w.succ>0,
      exact nat.succ_pos',
    exact smart_capture_cop_move h hw this,
  rw [capture, round] at cap, cases cap with i cap,
  have this: i=0, simp, rw this at cap, clear this, clear i, simp at cap,
  rw [pre_round, if_neg (nat.odd_iff_not_even.1 w_succ_odd)] at cap, simp at cap,
  unfold corner_vtx, clear w_succ_odd,
  use (round CS RS w).snd, use (round CS RS w).1.head, split,
  by_contradiction,
  have contra: capture (round CS RS w), unfold capture, use 0, simp, exact h,
  rw nat.succ_eq_add_one at hw, have hw' :Inf {n : ℕ | capture (round CS RS n)} = w+1, exact hw.symm, clear hw,
  have hw := (nat.Inf_upward_closed_eq_succ_iff (capt_upwards_closed) w).mp hw', rename hw' hw,
  cases hw with hw1 hw2, simp at hw2, contradiction,
  repeat {apply_instance},
  by_contradiction K, rw set.not_subset at K, cases K with a K, cases K with H K,
  rw neighbor_set' at H, simp at H, rw neighbor_set' at K, simp at K,
  cases w,
  have nocap: ¬ (CS.strat.strat (round CS RS 0)).head = (round CS RS 0).snd,
    suffices this : ¬ G.adj ((round CS RS 0).1.head) (round CS RS 0).snd,
      let x := CS.legal 0 (RS.strat.init CS.strat.init) CS.strat.init, simp at x,
      rw [round, pre_round] at this, simp at this, let y := (rgraph_adj_cmp this x),
      rw [round, pre_round], simp, exact y.symm,
    rw [round, pre_round], simp, change ¬G.adj CS.strat.init.head ((smart_robber G).strat.init CS.strat.init),
    rw [smart_robber], simp, rw [pre_smart_robber, rob_init_fn], simp,
    unfold round at K, simp at K,
    have this: (∃ (a : V), ¬a = CS.strat.init.head), use a, exact (rgraph_nadj_imp_neq K).symm,
    rw dif_pos this,
    have that : (∃ (w : V), ¬G.adj CS.strat.init.head w), use a, rw dif_pos that, exact some_spec that,
  contradiction,
  have gt1 : w.succ.succ >1, exact nat.succ_lt_succ (nat.zero_lt_succ w),
  let sameplace_rob := smart_rob_in_place h hw gt1, simp at sameplace_rob, rw sameplace_rob.symm at H,
  have mod : even w.succ,
    let x := smart_capture_cop_move h hw nat.succ_pos',
    rw odd_succ at x, exact nat.even_iff_not_odd.2 x,
  have sameplace_cop : (round CS RS w.succ).fst.head = (round CS RS w).fst.head,
    rw [round, pre_round, if_pos mod], rw sameplace_cop at K,
  rw [pre_round, if_pos mod] at cap, simp at cap,
  have nocap: ¬ (CS.strat.strat ((round CS RS w).fst, RS.strat.strat (round CS RS w))).head = RS.strat.strat (round CS RS w),
    change ¬ _ = (smart_robber G).strat.strat _ , unfold smart_robber, simp,
  have this : (∃ (w_1 : V), G.adj (round CS RS w).snd w_1 ∧ ¬G.adj (round CS RS w).fst.head w_1),
    use a, split, exact H, exact K,
  rw [pre_smart_robber, rob_strat_fn], simp, rw dif_pos this,
  suffices cond: ¬G.adj (round CS RS w).fst.head (some this),
    let x := CS.legal 0 (some this) (round CS RS w).fst, simp at x,
    let y := (rgraph_adj_cmp cond x),
    change ¬(CS.strat.strat ((round CS RS w).fst, (smart_robber G).strat.strat (round CS RS w))).head = _, rw smart_robber, simp, rw [pre_smart_robber, rob_strat_fn], simp,rw dif_pos this, exact y.symm,
  exact and.elim_right (some_spec this),
  contradiction,
end