/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl

Defines the inf/sup (semi)-lattice with optionally top/bot type class hierarchy.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.order.rel_classes
import Mathlib.PostPort

universes u l u_1 v

namespace Mathlib

-- TODO: move this eventually, if we decide to use them

-- TODO: this seems crazy, but it also seems to work reasonably well

theorem le_antisymm' {α : Type u} [partial_order α] {a : α} {b : α} : a ≤ b → b ≤ a → a = b :=
  le_antisymm

/- TODO: automatic construction of dual definitions / theorems -/

/-- Typeclass for the `⊔` (`\lub`) notation -/
/-- Typeclass for the `⊓` (`\glb`) notation -/
class has_sup (α : Type u)
where
  sup : α → α → α

class has_inf (α : Type u)
where
  inf : α → α → α

infixl:65 " ⊔ " => Mathlib.has_sup.sup

infixl:70 " ⊓ " => Mathlib.has_inf.inf

/-- A `semilattice_sup` is a join-semilattice, that is, a partial order
  with a join (a.k.a. lub / least upper bound, sup / supremum) operation
  `⊔` which is the least element larger than both factors. -/
class semilattice_sup (α : Type u)
extends has_sup α, partial_order α
where
  le_sup_left : ∀ (a b : α), a ≤ a ⊔ b
  le_sup_right : ∀ (a b : α), b ≤ a ⊔ b
  sup_le : ∀ (a b c : α), a ≤ c → b ≤ c → a ⊔ b ≤ c

protected instance order_dual.has_sup (α : Type u_1) [has_inf α] : has_sup (order_dual α) :=
  has_sup.mk has_inf.inf

protected instance order_dual.has_inf (α : Type u_1) [has_sup α] : has_inf (order_dual α) :=
  has_inf.mk has_sup.sup

@[simp] theorem le_sup_left {α : Type u} [semilattice_sup α] {a : α} {b : α} : a ≤ a ⊔ b :=
  semilattice_sup.le_sup_left a b

theorem le_sup_left' {α : Type u} [semilattice_sup α] {a : α} {b : α} : a ≤ a ⊔ b :=
  le_sup_left

@[simp] theorem le_sup_right {α : Type u} [semilattice_sup α] {a : α} {b : α} : b ≤ a ⊔ b :=
  semilattice_sup.le_sup_right a b

theorem le_sup_right' {α : Type u} [semilattice_sup α] {a : α} {b : α} : b ≤ a ⊔ b :=
  le_sup_right

theorem le_sup_left_of_le {α : Type u} [semilattice_sup α] {a : α} {b : α} {c : α} (h : c ≤ a) : c ≤ a ⊔ b :=
  le_trans h le_sup_left

theorem le_sup_right_of_le {α : Type u} [semilattice_sup α] {a : α} {b : α} {c : α} (h : c ≤ b) : c ≤ a ⊔ b :=
  le_trans h le_sup_right

theorem sup_le {α : Type u} [semilattice_sup α] {a : α} {b : α} {c : α} : a ≤ c → b ≤ c → a ⊔ b ≤ c :=
  semilattice_sup.sup_le a b c

@[simp] theorem sup_le_iff {α : Type u} [semilattice_sup α] {a : α} {b : α} {c : α} : a ⊔ b ≤ c ↔ a ≤ c ∧ b ≤ c := sorry

@[simp] theorem sup_eq_left {α : Type u} [semilattice_sup α] {a : α} {b : α} : a ⊔ b = a ↔ b ≤ a := sorry

theorem sup_of_le_left {α : Type u} [semilattice_sup α] {a : α} {b : α} (h : b ≤ a) : a ⊔ b = a :=
  iff.mpr sup_eq_left h

@[simp] theorem left_eq_sup {α : Type u} [semilattice_sup α] {a : α} {b : α} : a = a ⊔ b ↔ b ≤ a :=
  iff.trans eq_comm sup_eq_left

@[simp] theorem sup_eq_right {α : Type u} [semilattice_sup α] {a : α} {b : α} : a ⊔ b = b ↔ a ≤ b := sorry

theorem sup_of_le_right {α : Type u} [semilattice_sup α] {a : α} {b : α} (h : a ≤ b) : a ⊔ b = b :=
  iff.mpr sup_eq_right h

@[simp] theorem right_eq_sup {α : Type u} [semilattice_sup α] {a : α} {b : α} : b = a ⊔ b ↔ a ≤ b :=
  iff.trans eq_comm sup_eq_right

theorem sup_le_sup {α : Type u} [semilattice_sup α] {a : α} {b : α} {c : α} {d : α} (h₁ : a ≤ b) (h₂ : c ≤ d) : a ⊔ c ≤ b ⊔ d :=
  sup_le (le_sup_left_of_le h₁) (le_sup_right_of_le h₂)

theorem sup_le_sup_left {α : Type u} [semilattice_sup α] {a : α} {b : α} (h₁ : a ≤ b) (c : α) : c ⊔ a ≤ c ⊔ b :=
  sup_le_sup (le_refl c) h₁

theorem sup_le_sup_right {α : Type u} [semilattice_sup α] {a : α} {b : α} (h₁ : a ≤ b) (c : α) : a ⊔ c ≤ b ⊔ c :=
  sup_le_sup h₁ (le_refl c)

theorem le_of_sup_eq {α : Type u} [semilattice_sup α] {a : α} {b : α} (h : a ⊔ b = b) : a ≤ b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a ≤ b)) (Eq.symm h))) (eq.mpr (id (propext (iff_true_intro le_sup_left))) trivial)

theorem sup_ind {α : Type u} [semilattice_sup α] [is_total α LessEq] (a : α) (b : α) {p : α → Prop} (ha : p a) (hb : p b) : p (a ⊔ b) :=
  or.elim (is_total.total a b)
    (fun (h : a ≤ b) => eq.mpr (id (Eq._oldrec (Eq.refl (p (a ⊔ b))) (iff.mpr sup_eq_right h))) hb)
    fun (h : b ≤ a) => eq.mpr (id (Eq._oldrec (Eq.refl (p (a ⊔ b))) (iff.mpr sup_eq_left h))) ha

@[simp] theorem sup_lt_iff {α : Type u} [semilattice_sup α] [is_total α LessEq] {a : α} {b : α} {c : α} : b ⊔ c < a ↔ b < a ∧ c < a :=
  { mp := fun (h : b ⊔ c < a) => { left := has_le.le.trans_lt le_sup_left h, right := has_le.le.trans_lt le_sup_right h },
    mpr := fun (h : b < a ∧ c < a) => sup_ind b c (and.left h) (and.right h) }

@[simp] theorem le_sup_iff {α : Type u} [semilattice_sup α] [is_total α LessEq] {a : α} {b : α} {c : α} : a ≤ b ⊔ c ↔ a ≤ b ∨ a ≤ c := sorry

@[simp] theorem lt_sup_iff {α : Type u} [semilattice_sup α] [is_total α LessEq] {a : α} {b : α} {c : α} : a < b ⊔ c ↔ a < b ∨ a < c := sorry

@[simp] theorem sup_idem {α : Type u} [semilattice_sup α] {a : α} : a ⊔ a = a :=
  le_antisymm (eq.mpr (id (Eq.trans (propext sup_le_iff) (propext (and_self (a ≤ a))))) (le_refl a))
    (eq.mpr (id (propext (iff_true_intro le_sup_right))) trivial)

protected instance sup_is_idempotent {α : Type u} [semilattice_sup α] : is_idempotent α has_sup.sup :=
  is_idempotent.mk sup_idem

theorem sup_comm {α : Type u} [semilattice_sup α] {a : α} {b : α} : a ⊔ b = b ⊔ a := sorry

protected instance sup_is_commutative {α : Type u} [semilattice_sup α] : is_commutative α has_sup.sup :=
  is_commutative.mk sup_comm

theorem sup_assoc {α : Type u} [semilattice_sup α] {a : α} {b : α} {c : α} : a ⊔ b ⊔ c = a ⊔ (b ⊔ c) :=
  le_antisymm (sup_le (sup_le le_sup_left (le_sup_right_of_le le_sup_left)) (le_sup_right_of_le le_sup_right))
    (sup_le (le_sup_left_of_le le_sup_left) (sup_le (le_sup_left_of_le le_sup_right) le_sup_right))

protected instance sup_is_associative {α : Type u} [semilattice_sup α] : is_associative α has_sup.sup :=
  is_associative.mk sup_assoc

@[simp] theorem sup_left_idem {α : Type u} [semilattice_sup α] {a : α} {b : α} : a ⊔ (a ⊔ b) = a ⊔ b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a ⊔ (a ⊔ b) = a ⊔ b)) (Eq.symm sup_assoc)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a ⊔ a ⊔ b = a ⊔ b)) sup_idem)) (Eq.refl (a ⊔ b)))

@[simp] theorem sup_right_idem {α : Type u} [semilattice_sup α] {a : α} {b : α} : a ⊔ b ⊔ b = a ⊔ b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a ⊔ b ⊔ b = a ⊔ b)) sup_assoc))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a ⊔ (b ⊔ b) = a ⊔ b)) sup_idem)) (Eq.refl (a ⊔ b)))

theorem sup_left_comm {α : Type u} [semilattice_sup α] (a : α) (b : α) (c : α) : a ⊔ (b ⊔ c) = b ⊔ (a ⊔ c) :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a ⊔ (b ⊔ c) = b ⊔ (a ⊔ c))) (Eq.symm sup_assoc)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (a ⊔ b ⊔ c = b ⊔ (a ⊔ c))) (Eq.symm sup_assoc)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (a ⊔ b ⊔ c = b ⊔ a ⊔ c)) sup_comm)) (Eq.refl (b ⊔ a ⊔ c))))

theorem forall_le_or_exists_lt_sup {α : Type u} [semilattice_sup α] (a : α) : (∀ (b : α), b ≤ a) ∨ ∃ (b : α), a < b := sorry

/-- If `f` is a monotonically increasing sequence, `g` is a monotonically decreasing
sequence, and `f n ≤ g n` for all `n`, then for all `m`, `n` we have `f m ≤ g n`. -/
theorem forall_le_of_monotone_of_mono_decr {α : Type u} [semilattice_sup α] {β : Type u_1} [preorder β] {f : α → β} {g : α → β} (hf : monotone f) (hg : ∀ {m n : α}, m ≤ n → g n ≤ g m) (h : ∀ (n : α), f n ≤ g n) (m : α) (n : α) : f m ≤ g n :=
  le_trans (le_trans (hf le_sup_left) (h (m ⊔ n))) (hg le_sup_right)

theorem semilattice_sup.ext_sup {α : Type u_1} {A : semilattice_sup α} {B : semilattice_sup α} (H : ∀ (x y : α), x ≤ y ↔ x ≤ y) (x : α) (y : α) : x ⊔ y = x ⊔ y := sorry

theorem semilattice_sup.ext {α : Type u_1} {A : semilattice_sup α} {B : semilattice_sup α} (H : ∀ (x y : α), x ≤ y ↔ x ≤ y) : A = B := sorry

/-- A `semilattice_inf` is a meet-semilattice, that is, a partial order
  with a meet (a.k.a. glb / greatest lower bound, inf / infimum) operation
  `⊓` which is the greatest element smaller than both factors. -/
class semilattice_inf (α : Type u)
extends partial_order α, has_inf α
where
  inf_le_left : ∀ (a b : α), a ⊓ b ≤ a
  inf_le_right : ∀ (a b : α), a ⊓ b ≤ b
  le_inf : ∀ (a b c : α), a ≤ b → a ≤ c → a ≤ b ⊓ c

protected instance order_dual.semilattice_sup (α : Type u_1) [semilattice_inf α] : semilattice_sup (order_dual α) :=
  semilattice_sup.mk has_sup.sup partial_order.le partial_order.lt sorry sorry sorry sorry sorry sorry

protected instance order_dual.semilattice_inf (α : Type u_1) [semilattice_sup α] : semilattice_inf (order_dual α) :=
  semilattice_inf.mk has_inf.inf partial_order.le partial_order.lt sorry sorry sorry le_sup_left le_sup_right sorry

@[simp] theorem inf_le_left {α : Type u} [semilattice_inf α] {a : α} {b : α} : a ⊓ b ≤ a :=
  semilattice_inf.inf_le_left a b

theorem inf_le_left' {α : Type u} [semilattice_inf α] {a : α} {b : α} : a ⊓ b ≤ a :=
  semilattice_inf.inf_le_left a b

@[simp] theorem inf_le_right {α : Type u} [semilattice_inf α] {a : α} {b : α} : a ⊓ b ≤ b :=
  semilattice_inf.inf_le_right a b

theorem inf_le_right' {α : Type u} [semilattice_inf α] {a : α} {b : α} : a ⊓ b ≤ b :=
  semilattice_inf.inf_le_right a b

theorem le_inf {α : Type u} [semilattice_inf α] {a : α} {b : α} {c : α} : a ≤ b → a ≤ c → a ≤ b ⊓ c :=
  semilattice_inf.le_inf a b c

theorem inf_le_left_of_le {α : Type u} [semilattice_inf α] {a : α} {b : α} {c : α} (h : a ≤ c) : a ⊓ b ≤ c :=
  le_trans inf_le_left h

theorem inf_le_right_of_le {α : Type u} [semilattice_inf α] {a : α} {b : α} {c : α} (h : b ≤ c) : a ⊓ b ≤ c :=
  le_trans inf_le_right h

@[simp] theorem le_inf_iff {α : Type u} [semilattice_inf α] {a : α} {b : α} {c : α} : a ≤ b ⊓ c ↔ a ≤ b ∧ a ≤ c :=
  sup_le_iff

@[simp] theorem inf_eq_left {α : Type u} [semilattice_inf α] {a : α} {b : α} : a ⊓ b = a ↔ a ≤ b := sorry

theorem inf_of_le_left {α : Type u} [semilattice_inf α] {a : α} {b : α} (h : a ≤ b) : a ⊓ b = a :=
  iff.mpr inf_eq_left h

@[simp] theorem left_eq_inf {α : Type u} [semilattice_inf α] {a : α} {b : α} : a = a ⊓ b ↔ a ≤ b :=
  iff.trans eq_comm inf_eq_left

@[simp] theorem inf_eq_right {α : Type u} [semilattice_inf α] {a : α} {b : α} : a ⊓ b = b ↔ b ≤ a := sorry

theorem inf_of_le_right {α : Type u} [semilattice_inf α] {a : α} {b : α} (h : b ≤ a) : a ⊓ b = b :=
  iff.mpr inf_eq_right h

@[simp] theorem right_eq_inf {α : Type u} [semilattice_inf α] {a : α} {b : α} : b = a ⊓ b ↔ b ≤ a :=
  iff.trans eq_comm inf_eq_right

theorem inf_le_inf {α : Type u} [semilattice_inf α] {a : α} {b : α} {c : α} {d : α} (h₁ : a ≤ b) (h₂ : c ≤ d) : a ⊓ c ≤ b ⊓ d :=
  le_inf (inf_le_left_of_le h₁) (inf_le_right_of_le h₂)

theorem inf_le_inf_right {α : Type u} [semilattice_inf α] (a : α) {b : α} {c : α} (h : b ≤ c) : b ⊓ a ≤ c ⊓ a :=
  inf_le_inf h (le_refl a)

theorem inf_le_inf_left {α : Type u} [semilattice_inf α] (a : α) {b : α} {c : α} (h : b ≤ c) : a ⊓ b ≤ a ⊓ c :=
  inf_le_inf (le_refl a) h

theorem le_of_inf_eq {α : Type u} [semilattice_inf α] {a : α} {b : α} (h : a ⊓ b = a) : a ≤ b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a ≤ b)) (Eq.symm h))) (eq.mpr (id (propext (iff_true_intro inf_le_right))) trivial)

theorem inf_ind {α : Type u} [semilattice_inf α] [is_total α LessEq] (a : α) (b : α) {p : α → Prop} (ha : p a) (hb : p b) : p (a ⊓ b) :=
  sup_ind a b ha hb

@[simp] theorem lt_inf_iff {α : Type u} [semilattice_inf α] [is_total α LessEq] {a : α} {b : α} {c : α} : a < b ⊓ c ↔ a < b ∧ a < c :=
  sup_lt_iff

@[simp] theorem inf_le_iff {α : Type u} [semilattice_inf α] [is_total α LessEq] {a : α} {b : α} {c : α} : b ⊓ c ≤ a ↔ b ≤ a ∨ c ≤ a :=
  le_sup_iff

@[simp] theorem inf_idem {α : Type u} [semilattice_inf α] {a : α} : a ⊓ a = a :=
  sup_idem

protected instance inf_is_idempotent {α : Type u} [semilattice_inf α] : is_idempotent α has_inf.inf :=
  is_idempotent.mk inf_idem

theorem inf_comm {α : Type u} [semilattice_inf α] {a : α} {b : α} : a ⊓ b = b ⊓ a :=
  sup_comm

protected instance inf_is_commutative {α : Type u} [semilattice_inf α] : is_commutative α has_inf.inf :=
  is_commutative.mk inf_comm

theorem inf_assoc {α : Type u} [semilattice_inf α] {a : α} {b : α} {c : α} : a ⊓ b ⊓ c = a ⊓ (b ⊓ c) :=
  sup_assoc

protected instance inf_is_associative {α : Type u} [semilattice_inf α] : is_associative α has_inf.inf :=
  is_associative.mk inf_assoc

@[simp] theorem inf_left_idem {α : Type u} [semilattice_inf α] {a : α} {b : α} : a ⊓ (a ⊓ b) = a ⊓ b :=
  sup_left_idem

@[simp] theorem inf_right_idem {α : Type u} [semilattice_inf α] {a : α} {b : α} : a ⊓ b ⊓ b = a ⊓ b :=
  sup_right_idem

theorem inf_left_comm {α : Type u} [semilattice_inf α] (a : α) (b : α) (c : α) : a ⊓ (b ⊓ c) = b ⊓ (a ⊓ c) :=
  sup_left_comm a b c

theorem forall_le_or_exists_lt_inf {α : Type u} [semilattice_inf α] (a : α) : (∀ (b : α), a ≤ b) ∨ ∃ (b : α), b < a :=
  forall_le_or_exists_lt_sup a

theorem semilattice_inf.ext_inf {α : Type u_1} {A : semilattice_inf α} {B : semilattice_inf α} (H : ∀ (x y : α), x ≤ y ↔ x ≤ y) (x : α) (y : α) : x ⊓ y = x ⊓ y := sorry

theorem semilattice_inf.ext {α : Type u_1} {A : semilattice_inf α} {B : semilattice_inf α} (H : ∀ (x y : α), x ≤ y ↔ x ≤ y) : A = B := sorry

/-! ### Lattices -/

/-- A lattice is a join-semilattice which is also a meet-semilattice. -/
class lattice (α : Type u)
extends semilattice_sup α, semilattice_inf α
where

protected instance order_dual.lattice (α : Type u_1) [lattice α] : lattice (order_dual α) :=
  lattice.mk semilattice_sup.sup semilattice_sup.le semilattice_sup.lt sorry sorry sorry sorry sorry sorry
    semilattice_inf.inf sorry sorry sorry

/- Distributivity laws -/

/- TODO: better names? -/

theorem sup_inf_le {α : Type u} [lattice α] {a : α} {b : α} {c : α} : a ⊔ b ⊓ c ≤ (a ⊔ b) ⊓ (a ⊔ c) :=
  le_inf (sup_le_sup_left inf_le_left a) (sup_le_sup_left inf_le_right a)

theorem le_inf_sup {α : Type u} [lattice α] {a : α} {b : α} {c : α} : a ⊓ b ⊔ a ⊓ c ≤ a ⊓ (b ⊔ c) :=
  sup_le (inf_le_inf_left a le_sup_left) (inf_le_inf_left a le_sup_right)

theorem inf_sup_self {α : Type u} [lattice α] {a : α} {b : α} : a ⊓ (a ⊔ b) = a :=
  eq.mpr (id (Eq.trans (propext inf_eq_left) (propext (iff_true_intro le_sup_left)))) trivial

theorem sup_inf_self {α : Type u} [lattice α] {a : α} {b : α} : a ⊔ a ⊓ b = a :=
  eq.mpr (id (Eq.trans (propext sup_eq_left) (propext (iff_true_intro inf_le_left)))) trivial

theorem lattice.ext {α : Type u_1} {A : lattice α} {B : lattice α} (H : ∀ (x y : α), x ≤ y ↔ x ≤ y) : A = B := sorry

/-- A distributive lattice is a lattice that satisfies any of four
  equivalent distribution properties (of sup over inf or inf over sup,
  on the left or right). A classic example of a distributive lattice
  is the lattice of subsets of a set, and in fact this example is
  generic in the sense that every distributive lattice is realizable
  as a sublattice of a powerset lattice. -/
class distrib_lattice (α : Type u_1)
extends lattice α
where
  le_sup_inf : ∀ (x y z : α), (x ⊔ y) ⊓ (x ⊔ z) ≤ x ⊔ y ⊓ z

theorem le_sup_inf {α : Type u} [distrib_lattice α] {x : α} {y : α} {z : α} : (x ⊔ y) ⊓ (x ⊔ z) ≤ x ⊔ y ⊓ z :=
  distrib_lattice.le_sup_inf

theorem sup_inf_left {α : Type u} [distrib_lattice α] {x : α} {y : α} {z : α} : x ⊔ y ⊓ z = (x ⊔ y) ⊓ (x ⊔ z) :=
  le_antisymm sup_inf_le le_sup_inf

theorem sup_inf_right {α : Type u} [distrib_lattice α] {x : α} {y : α} {z : α} : y ⊓ z ⊔ x = (y ⊔ x) ⊓ (z ⊔ x) := sorry

theorem inf_sup_left {α : Type u} [distrib_lattice α] {x : α} {y : α} {z : α} : x ⊓ (y ⊔ z) = x ⊓ y ⊔ x ⊓ z := sorry

protected instance order_dual.distrib_lattice (α : Type u_1) [distrib_lattice α] : distrib_lattice (order_dual α) :=
  distrib_lattice.mk lattice.sup lattice.le lattice.lt sorry sorry sorry sorry sorry sorry lattice.inf sorry sorry sorry
    sorry

theorem inf_sup_right {α : Type u} [distrib_lattice α] {x : α} {y : α} {z : α} : (y ⊔ z) ⊓ x = y ⊓ x ⊔ z ⊓ x := sorry

theorem le_of_inf_le_sup_le {α : Type u} [distrib_lattice α] {x : α} {y : α} {z : α} (h₁ : x ⊓ z ≤ y ⊓ z) (h₂ : x ⊔ z ≤ y ⊔ z) : x ≤ y := sorry

theorem eq_of_inf_eq_sup_eq {α : Type u} [distrib_lattice α] {a : α} {b : α} {c : α} (h₁ : b ⊓ a = c ⊓ a) (h₂ : b ⊔ a = c ⊔ a) : b = c :=
  le_antisymm (le_of_inf_le_sup_le (le_of_eq h₁) (le_of_eq h₂))
    (le_of_inf_le_sup_le (le_of_eq (Eq.symm h₁)) (le_of_eq (Eq.symm h₂)))

/-!
### Lattices derived from linear orders
-/

protected instance lattice_of_linear_order {α : Type u} [o : linear_order α] : lattice α :=
  lattice.mk max linear_order.le linear_order.lt linear_order.le_refl linear_order.le_trans linear_order.le_antisymm
    le_max_left le_max_right sorry min min_le_left min_le_right sorry

theorem sup_eq_max {α : Type u} [linear_order α] {x : α} {y : α} : x ⊔ y = max x y :=
  rfl

theorem inf_eq_min {α : Type u} [linear_order α] {x : α} {y : α} : x ⊓ y = min x y :=
  rfl

protected instance distrib_lattice_of_linear_order {α : Type u} [o : linear_order α] : distrib_lattice α :=
  distrib_lattice.mk lattice.sup lattice.le lattice.lt sorry sorry sorry sorry sorry sorry lattice.inf sorry sorry sorry
    sorry

protected instance nat.distrib_lattice : distrib_lattice ℕ :=
  Mathlib.distrib_lattice_of_linear_order

namespace monotone

theorem le_map_sup {α : Type u} {β : Type v} [semilattice_sup α] [semilattice_sup β] {f : α → β} (h : monotone f) (x : α) (y : α) : f x ⊔ f y ≤ f (x ⊔ y) :=
  sup_le (h le_sup_left) (h le_sup_right)

theorem map_sup {α : Type u} {β : Type v} [semilattice_sup α] [is_total α LessEq] [semilattice_sup β] {f : α → β} (hf : monotone f) (x : α) (y : α) : f (x ⊔ y) = f x ⊔ f y := sorry

theorem map_inf_le {α : Type u} {β : Type v} [semilattice_inf α] [semilattice_inf β] {f : α → β} (h : monotone f) (x : α) (y : α) : f (x ⊓ y) ≤ f x ⊓ f y :=
  le_inf (h inf_le_left) (h inf_le_right)

theorem map_inf {α : Type u} {β : Type v} [semilattice_inf α] [is_total α LessEq] [semilattice_inf β] {f : α → β} (hf : monotone f) (x : α) (y : α) : f (x ⊓ y) = f x ⊓ f y :=
  map_sup (monotone.order_dual hf) x y

end monotone

namespace prod

protected instance has_sup (α : Type u) (β : Type v) [has_sup α] [has_sup β] : has_sup (α × β) :=
  has_sup.mk fun (p q : α × β) => (fst p ⊔ fst q, snd p ⊔ snd q)

protected instance has_inf (α : Type u) (β : Type v) [has_inf α] [has_inf β] : has_inf (α × β) :=
  has_inf.mk fun (p q : α × β) => (fst p ⊓ fst q, snd p ⊓ snd q)

protected instance semilattice_sup (α : Type u) (β : Type v) [semilattice_sup α] [semilattice_sup β] : semilattice_sup (α × β) :=
  semilattice_sup.mk has_sup.sup partial_order.le partial_order.lt sorry sorry sorry sorry sorry sorry

protected instance semilattice_inf (α : Type u) (β : Type v) [semilattice_inf α] [semilattice_inf β] : semilattice_inf (α × β) :=
  semilattice_inf.mk has_inf.inf partial_order.le partial_order.lt sorry sorry sorry sorry sorry sorry

protected instance lattice (α : Type u) (β : Type v) [lattice α] [lattice β] : lattice (α × β) :=
  lattice.mk semilattice_sup.sup semilattice_inf.le semilattice_inf.lt sorry sorry sorry sorry sorry sorry
    semilattice_inf.inf sorry sorry sorry

protected instance distrib_lattice (α : Type u) (β : Type v) [distrib_lattice α] [distrib_lattice β] : distrib_lattice (α × β) :=
  distrib_lattice.mk lattice.sup lattice.le lattice.lt sorry sorry sorry sorry sorry sorry lattice.inf sorry sorry sorry
    sorry

end prod

namespace subtype

/-- A subtype forms a `⊔`-semilattice if `⊔` preserves the property. -/
protected def semilattice_sup {α : Type u} [semilattice_sup α] {P : α → Prop} (Psup : ∀ {x y : α}, P x → P y → P (x ⊔ y)) : semilattice_sup (Subtype fun (x : α) => P x) :=
  semilattice_sup.mk (fun (x y : Subtype fun (x : α) => P x) => { val := val x ⊔ val y, property := sorry })
    partial_order.le partial_order.lt sorry sorry sorry sorry sorry sorry

/-- A subtype forms a `⊓`-semilattice if `⊓` preserves the property. -/
protected def semilattice_inf {α : Type u} [semilattice_inf α] {P : α → Prop} (Pinf : ∀ {x y : α}, P x → P y → P (x ⊓ y)) : semilattice_inf (Subtype fun (x : α) => P x) :=
  semilattice_inf.mk (fun (x y : Subtype fun (x : α) => P x) => { val := val x ⊓ val y, property := sorry })
    partial_order.le partial_order.lt sorry sorry sorry sorry sorry sorry

/-- A subtype forms a lattice if `⊔` and `⊓` preserve the property. -/
protected def lattice {α : Type u} [lattice α] {P : α → Prop} (Psup : ∀ {x y : α}, P x → P y → P (x ⊔ y)) (Pinf : ∀ {x y : α}, P x → P y → P (x ⊓ y)) : lattice (Subtype fun (x : α) => P x) :=
  lattice.mk semilattice_sup.sup semilattice_inf.le semilattice_inf.lt sorry sorry sorry sorry sorry sorry
    semilattice_inf.inf sorry sorry sorry


import combinatorics.simple_graph.strongly_regular

variables {α : Type*} {k : ℕ}
open finset

/-!
In this file, we're going to show that the Petersen graph is strongly regular. Now, in Lean it
is unfortunately a bit tricky to talk about individual graphs, so we define the Petersen graph
as the Kneser graph K(5, 2).

The Kneser graph K(n, k) is the graph whose vertices correspond to k-element subsets of a set of
n elements. For any two k-element subsets, their vertices in the graph are adjacent iff their
intersection is empty, i.e. they don't share any elements.
-/
def kneser (α : Type*) (k : ℕ) : simple_graph {X : finset α // X.card = k} :=
{ adj := λ X Y, k ≠ 0 ∧ ∀ x ∈ (X : finset α), x ∉ (Y : finset α),
    -- a strange definition so that i don't need to assume α is decidable
  loopless :=
  begin
    sorry,
  end,
  symm :=
  begin
    sorry,
  end }

variables [decidable_eq α] {X Y : {X : finset α // X.card = k}}

instance decidable_kneser_adj : decidable ((kneser α k).adj X Y) := and.decidable

/-!
Here we have translated our weird definition to one that'll give us the finset lemmas that make
our life easier by showing that they're equivalent.
-/
lemma kneser_adj :
  (kneser α k).adj X Y ↔ k ≠ 0 ∧ disjoint (X : finset α) Y :=
begin
  sorry,
end

/-!
The same thing as before, just with k ≠ 0 in our hypotheses (sometimes this makes things easier)
-/
lemma kneser_adj' (hk : k ≠ 0) :
  (kneser α k).adj X Y ↔ disjoint (X : finset α) Y :=
begin
    sorry,
end

open fintype
variables [fintype α] (hk : k ≠ 0)

include hk

lemma kneser_neighbours :
  (kneser α k).neighbor_finset X = finset.univ.filter (λ Y, disjoint (X : finset α) Y) :=
begin
  sorry,
end

-- hint: filters
lemma kneser_degree :
  (kneser α k).degree X = ((card α - k).choose k) :=
begin
  sorry,
end

lemma kneser_regular [fintype α] :
  (kneser α k).is_regular_of_degree ((card α - k).choose k) :=
begin
  sorry,
end

lemma kneser_card_common_neighbors  :
  card ((kneser α k).common_neighbors X Y) = (card α - ((X : finset α) ∪ Y).card).choose k :=
begin
  sorry,
end

lemma kneser_adjacent_neighbors (h : (kneser α k).adj X Y) :
  card ((kneser α k).common_neighbors X Y) = (card α - 2 * k).choose k :=
begin
  sorry,
end

omit hk

lemma kneser_two_non_adjacent_neighbors {X Y : finset α} (hX : X.card = 2) (hY : Y.card = 2)
  (h' : X ≠ Y) (h : ¬ (kneser α 2).adj ⟨X, hX⟩ ⟨Y, hY⟩) :
  card ((kneser α 2).common_neighbors ⟨X, hX⟩ ⟨Y, hY⟩) = (card α - 3).choose 2 :=
begin
  sorry,
end

lemma kneser_srg :
  (kneser α 2).is_SRG_with
    ((card α).choose 2) ((card α - 2).choose 2) ((card α - 4).choose 2) ((card α - 3).choose 2) :=
begin
-- so one thing that's cool about structures is that, another way you can show something satisfies a
-- structure's properties is the "constructor" tactic. if you want to give it a try it'll separate
-- what you have to prove into goals. if you're more comfortable using the usual { field := proof, etc }
-- format, you can replace the begin/end block with an underscore, hover over it, and select
-- "generate skeleton for the structure under construction" to get the usual setup
  constructor,
  sorry,
  sorry,
  sorry,
  sorry,
end

def petersen : simple_graph _ := kneser (fin 5) 2
instance : decidable_rel petersen.adj := λ _ _, decidable_kneser_adj

lemma petersen_srg : petersen.is_SRG_with 10 3 0 1 :=
begin
-- hint: convert tactic is useful here
  sorry,
end


import control

open polya tactic
variables x y z u v w  r : ℚ

#exit

example (h1 : u > 0) (h2 : u < 1*v) (h3 : z > 0) (h4 : 1*z + 1*1 < 1*w) (h5 : rat.pow (1*u + 1*v + 1*z) 3 ≥ 1* rat.pow (1*u + 1*v + 1*w + 1*1) 5) : false :=
by  polya h1 h2 h3 h4 h5

example (h1 : u > 1*1) (h2 : u < 1*v) (h3 : rat.pow u 15 > 1*rat.pow v 17) : false :=
by polya h1 h2 h3

-- reconstruction fails
/-example (h1 : u > 1*1) (h2 : u < 1*v) (h3 : rat.pow u 15 > 1*rat.pow v 19007) : false :=
by polya h1 h2 h3
-/

example (h1 : x > 0) (h2 : x < 1*1) (h3 : rat.pow x 2 ≥ 1*x) : false :=
by  polya h1 h2 h3

/-
0 \leq n, \; n < (K / 2)x, \; 0 < C, \; 0 < \varepsilon < 1 \myRightarrow \left(1 + \frac{\varepsilon}{3 (C + 3)}\right) \cdot n < K x
-/
section
variables n K C eps : ℚ
example (h1 : 0 ≤ n) (h2 : n < (1/2)*K*x) (h3 : 0 < C) (h4 : 0 < eps) (h5 : eps < 1) (h6 : 1 + (1/3)*eps*rat.pow (C+3) (-1)*n < K*x) : false :=
by polya h1 h2 h3 h4 h5 h6

end

/-
Tests from the old Polya repository.
-/

-- line 44
example  (h1 : u > 0) (h2 : u < 1*v) (h3 : v < 1*1) (h4 : 1 ≤ (1/2)*x) (h5 : x ≤ 1*y) (h6 : ((rat.pow u 2)*x) ≥ (1/2)*(v*rat.pow y 2))
: false :=
by polya  h1 h2 h3 h4 h5 h6 --h7 h8

-- line 50
example (h1 : x > 1*1) (h2 : (1 + rat.pow y 2)*x < 1*(1 + rat.pow y 2)) : false :=
by polya h1 h2

-- line 56
example  (h1 : x > 0) (h2 : x < 1*1) (h3 : rat.pow (1*1 + (-1)*x) (-1) ≤ 1*(rat.pow (1*1 + (-1)*rat.pow x 2) (-1))) : false :=
by
polya h1 h2 h3

-- line 62
example (h1 : u > 0) (h2 : u < 1*v) (h3 : z > 0) (h4 : 1*z + 1*1 < 1*w) (h5 : rat.pow (1*u + 1*v + 1*z) 3 ≥ 1* rat.pow (1*u + 1*v + 1*w + 1*1) 5) : false :=
by  polya h1 h2 h3 h4 h5

-- line 68
example (h1 : u > 0) (h2 : u < 1*v) (h3 : z > 0) (h4 : 1*z + 1*1 < 1*w) (h5 : rat.pow (1*u + 1*v + 1*z) 33 ≥ 1* rat.pow (1*u + 1*v + 1*w + 1*1) 55) : false :=
by  polya h1 h2 h3 h4 h5

-- line 74
-- see top of file. goes forever, normalization problem?
/-example (h1 : u > 0) (h2 : u < 1*(rat.pow (1*rat.pow v 2 + 23*1) 3)) (h3 : z > 0) (h4 : 1*z + 1*1 < 1*w)
(h5 : rat.pow (1*u + (1*rat.pow (1*rat.pow v 2 + 23*1) 3) + 1*z) 3 ≥ 1*(rat.pow (1*u + 1*rat.pow (1*rat.pow v 2 + 23*1) 3 + 1*w + 1*1) 5)) : false :=
by polya h1 h2 h3 h4 h5-/

-- line 263
-- fails, sign inference too weak
example (h1 : x > 0) (h2 : y < 1*z) (h3 : x * y < 1*(x * z)) : false :=
by polya h1 h2 h3

-- line 295
example (h1 : x * (y+z) ≤ 0) (h2 : y + z > 0) (h3 : x ≥ 0) (h4 : x*w > 0) : false :=
by polya h1 h2 h3 h4

-- line 299
example (h1 : x > 0) (h2 : x < 3*y) (h3 : u < 1*v) (h4 : v < 0) (h5 : 1 < 1*rat.pow v 2) (h6 : rat.pow v 2 < 1*x) (h7 : 1*(u*rat.pow (3*y) 2) + 1*1 ≥ 1*(1*(rat.pow x 2*v) + 1*x)) : false :=
by polya h1 h2 h3 h4 h5 h6

-- line 304 hangs?
/-example (h1 : x > 0) (h2 : x < y) (h3 : 0 < u) (h4 : u < v) (h5 : 0 < w + z) (h6 : w + z < r - 1)
  (h7 : u + (rat.pow (1+x) 2)*(2*w + 2*z + 3) < 2*v + rat.pow (1+y) 2 * (2*r + 1)) : false :=
by polya h1 h2 h3 h4 h5 h6 h7-/

local infix `**`:1000 := rat.pow

-- line 309
example (h1 : x + rat.pow y (-1) < 2) (h2 : y < 0) (h3 : y * rat.pow x (-1) > 1) (h4 : -2 ≤ x) (h5 : x < 2) (h6 : -2 ≤ y) (h7 : y ≤ 2) (h8 : rat.pow x 2 * rat.pow y (-1) > 1 - x) : false :=
by polya h1 h2 h3 h4 h5 h6 h7 h8

-- line 314
example (h1 : 0 < u) (h2 : u < v) (h3 : 1 < x) (h4 : x < y) (h5 : 0 < w) (h6 : w < z) (h7 : u + x*w < v+(rat.pow y 2)*z) : false :=
by polya h1 h2 h3 h4 h5 h6 h7

-- line 319
example (h1 : x + rat.pow y (-1) < 2) (h2 : y < 0) (h3 : y * rat.pow x (-1) > 1) (h4 : -2 ≤ x) (h5 : x ≤ 2) (h6 : y ≤ 2) (h7 : -2 ≤ y) (h8 : rat.pow x 2 * rat.pow y (-1) > 1 - x) : false :=
by polya h1 h2 h3 h4 h5 h6 h7 h8

-- 323
example (h1 : 0 < x) (h2 : x < y) (h3 : 0 < u) (h4 : u < v) (h5 : 0 < w + z) (h6 : w + z < r - 1)
          (h7 : u + rat.pow (1 + x) 2 * (2 * w + 2 * z + 3) >= 2 * v + rat.pow (1 + y) 2 * (2 * r + 1)) : false :=
by polya h1 h2 h3 h4 h5 h6 h7

-- 328
example (h1 : 0 < x)  (h2 : x < 3 * y) (h3 : u < v) (h3' : v < 0) (h4 : 1 < v**2) (h5 : v**2 < x) (h6 : u * (3 * y)**2 + 1 >= x**2 * v + x) : false :=
by polya h1 h2 h3 h3' h4 h5 h6

--337
example (h1 : 1 < x) (h2 : 1 < y) (h3 : 1 < z) (h4 : 1 >= x * (1 + z * y)) : false :=
by polya h1 h2 h3 h4

-- 346
example (h1 : x < 1) (h2 : 1 < y) (h3 : x * y > 1) (h4 : u + x >= y + 1) (h5 : x**2 * y < 2 - u * x * y) : false :=
by polya h1 h2 h3 h4 h5

-- 350
example (h1 : x**21 > 0) (h2 : x**3 < 1) (h3 : y**55 > 0) (h4 : y < 1) (h5 : a + b < a * b) : false :=
by polya h1 h2 h3 h4 h5

-- 354
example (h1 : 0 < x) (h2 : y < z) (h3 : y < 0) (h4 : z > 0) (h5 : x * y ≥ x * z) : false :=
by polya h1 h2 h3 h4 h5

--359
example (h1 : 0 < z) (h2 : y < z) (h3 : y = 0) (h4 : z > 0) (h5 : x * y ≥ x * z) : false :=
by polya h1 h2 h3 h4 h5

-- 371
example (h1 : x > 1) (h2 : z = y**2) (h3 : 1+z*x < 1+z) : false :=
by polya h1 h2 h3

-- 384
example (h1 : x = z) (h2 : y = w) (h3 : x > 0) (h4 : y > 0) (h5 : x * y ≠ z * w) : false :=
by polya h1 h2 h3 h4 h5

-- 389
example (h1 : x > 2*y) (h2 : x = 3*y) (h3 : y ≤ 0) : false :=
by polya h1 h2 h3

example (h1 : x > 0) (h2 : 1 < 1 * x) (h3 : 1 < 1 * (rat.pow x (-1))) : false :=
by polya h1 h2 h3

example  (h1 : x > 0) (h2 : x < 1*1) (h3 : rat.pow (1*1 + (-1)*x) (-1) ≤ 1*(rat.pow (1*1 + (-1)*rat.pow x 2) (-1))) : false :=
by
polya h1 h2 h3

example (h1 : x > 1*1) (h1' : y ≥ 0) (h2 : (1 + y)*x < 1*(1 + y)) : false :=
by polya  h1 h1' h2

example (e1 : x > 0) /-(e2' : x*y > 0)-/ (e2' : y > 0) (e2 : x > 1*y) (e3 : z > 1*x) (e3' : z > 0) (e4 : y > 1*z) : false :=
by polya e1 e2' e2 e3 e3' e4

example (e1 : x > 0) (e2 : y > 0) (e2' : z > 0) (e3 : y > 1*z) (e4 : x > 1*z) (e5 : x*y<1*(rat.pow z 2))  : false :=
by polya e1 e2 e2' e3 e4 e5

/-set_option trace.app_builder true
example (h0 : (1 : ℚ) > 0) (h1 : x > 1*1) (h1' : y ≥ 0) (h2 : (1 + y)*x < 1*(1 + y)) : false :=
by do
exps ← monad.mapm get_local [`h0,  `h1, `h1', `h2],
bb ← add_proofs_to_blackboard blackboard.mk_empty exps,
bb.trace_exprs,
trace "-----",
bb.trace,
trace "-----",
(_, bb) ← return $ add_new_ineqs bb,
(_, bb) ← return $ prod_form.add_new_ineqs bb,
--(_, bb) ← return $ add_new_ineqs bb,
--(_, bb) ← return $ prod_form.add_new_ineqs bb,
trace "-----",
bb.trace,
trace $ ("contr found", bb.contr_found),
pf ← bb.contr.reconstruct,
apply pf

#exit
example (h0 : (1 : ℚ) > 0) (h1 : x > 1*1) (h2 : (1 + rat.pow y 2)*x < 1*(1 + rat.pow y 2)) (ht : rat.pow y 2 ≥ 0) : false :=
by do
exps ← monad.mapm get_local [`h0,  `h1, `h2, `ht],
bb ← add_proofs_to_blackboard blackboard.mk_empty exps,
bb.trace_exprs,
trace "-----",
bb.trace,
trace "-----",
(_, bb) ← return $ add_new_ineqs bb,
(_, bb) ← return $ prod_form.add_new_ineqs bb,
(_, bb) ← return $ add_new_ineqs bb,
(_, bb) ← return $ prod_form.add_new_ineqs bb,
trace "-----",
bb.trace,
trace $ ("contr found", bb.contr_found),
pf ← bb.contr.reconstruct,
apply pf-/

-- left off with : bug at prod_form.to_expr??
example (e1 : x > 0) /-(e2' : x*y > 0)-/ (e2' : y > 0) (e2 : x > 1*y) (e3 : z > 1*x) (e3' : z > 0) (e4 : y > 1*z) : false :=
by do
exps ← monad.mapm get_local [`e1, `e2, `e2', `e3, `e3', `e4],
bb ← add_proofs_to_blackboard blackboard.mk_empty exps,
bb.trace_exprs,
trace "-----",
bb.trace,
trace "-----",
(_, bb) ← return $ prod_form.add_new_ineqs bb,
trace "-----",
bb.trace,
trace $ ("contr found", bb.contr_found),
pf ← bb.contr.reconstruct,
apply pf

example (e1 : x > 0) (e2 : y > 0) (e2' : z > 0) (e3 : y > 1*z) (e4 : x > 1*z) (e5 : x*y<1*(rat.pow z 2)) (e6 : rat.pow z 2 > 0) (e7 : x*y > 0) : false :=
by do
exps ← monad.mapm get_local [`e1, `e2, `e2', `e3, `e4, `e5, `e6, `e7],
bb ← add_proofs_to_blackboard blackboard.mk_empty exps,
bb.trace_exprs,
--(l, _) ← return $ get_add_defs bb,
--trace l,
(_, bb) ← return $ prod_form.add_new_ineqs bb,
--bb.trace,
trace $ ("contr found", bb.contr_found),
pf ← bb.contr.reconstruct,
apply pf


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

import ring_theory.valuation.basic

/-!
# Ring of integers under a given valuation

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

The elements with valuation less than or equal to 1.

TODO: Define characteristic predicate.
-/

universes u v w

namespace valuation

section ring

variables {R : Type u} {Γ₀ : Type v} [ring R] [linear_ordered_comm_group_with_zero Γ₀]
variables (v : valuation R Γ₀)

/-- The ring of integers under a given valuation is the subring of elements with valuation ≤ 1. -/
def integer : subring R :=
{ carrier := { x | v x ≤ 1 },
  one_mem' := le_of_eq v.map_one,
  mul_mem' := λ x y hx hy, trans_rel_right (≤) (v.map_mul x y) (mul_le_one' hx hy),
  zero_mem' := trans_rel_right (≤) v.map_zero zero_le_one,
  add_mem' := λ x y hx hy, le_trans (v.map_add x y) (max_le hx hy),
  neg_mem' := λ x hx, trans_rel_right (≤) (v.map_neg x) hx }

end ring

section comm_ring

variables {R : Type u} {Γ₀ : Type v} [comm_ring R] [linear_ordered_comm_group_with_zero Γ₀]
variables (v : valuation R Γ₀)
variables (O : Type w) [comm_ring O] [algebra O R]

/-- Given a valuation v : R → Γ₀ and a ring homomorphism O →+* R, we say that O is the integers of v
if f is injective, and its range is exactly `v.integer`. -/
structure integers : Prop :=
(hom_inj : function.injective (algebra_map O R))
(map_le_one : ∀ x, v (algebra_map O R x) ≤ 1)
(exists_of_le_one : ∀ ⦃r⦄, v r ≤ 1 → ∃ x, algebra_map O R x = r)

-- typeclass shortcut
instance : algebra v.integer R :=
algebra.of_subring v.integer

theorem integer.integers : v.integers v.integer :=
{ hom_inj := subtype.coe_injective,
  map_le_one := λ r, r.2,
  exists_of_le_one := λ r hr, ⟨⟨r, hr⟩, rfl⟩ }

namespace integers

variables {v O} (hv : integers v O)
include hv

lemma one_of_is_unit {x : O} (hx : is_unit x) : v (algebra_map O R x) = 1 :=
let ⟨u, hu⟩ := hx in le_antisymm (hv.2 _) $
by { rw [← v.map_one, ← (algebra_map O R).map_one, ← u.mul_inv, ← mul_one (v (algebra_map O R x)),
  hu, (algebra_map O R).map_mul, v.map_mul], exact mul_le_mul_left' (hv.2 (u⁻¹ : units O)) _ }

lemma is_unit_of_one {x : O} (hx : is_unit (algebra_map O R x)) (hvx : v (algebra_map O R x) = 1) :
  is_unit x :=
let ⟨u, hu⟩ := hx in
have h1 : v u ≤ 1, from hu.symm ▸ hv.2 x,
have h2 : v (u⁻¹ : Rˣ) ≤ 1,
  by rw [← one_mul (v _), ← hvx, ← v.map_mul, ← hu, u.mul_inv, hu, hvx, v.map_one],
let ⟨r1, hr1⟩ := hv.3 h1, ⟨r2, hr2⟩ := hv.3 h2 in
⟨⟨r1, r2, hv.1 $ by rw [ring_hom.map_mul, ring_hom.map_one, hr1, hr2, units.mul_inv],
  hv.1 $ by rw [ring_hom.map_mul, ring_hom.map_one, hr1, hr2, units.inv_mul]⟩,
hv.1 $ hr1.trans hu⟩

lemma le_of_dvd {x y : O} (h : x ∣ y) : v (algebra_map O R y) ≤ v (algebra_map O R x) :=
let ⟨z, hz⟩ := h in by { rw [← mul_one (v (algebra_map O R x)), hz, ring_hom.map_mul, v.map_mul],
  exact mul_le_mul_left' (hv.2 z) _ }

end integers

end comm_ring

section field

variables {F : Type u} {Γ₀ : Type v} [field F] [linear_ordered_comm_group_with_zero Γ₀]
variables {v : valuation F Γ₀} {O : Type w} [comm_ring O] [algebra O F] (hv : integers v O)
include hv

namespace integers

lemma dvd_of_le {x y : O} (h : v (algebra_map O F x) ≤ v (algebra_map O F y)) : y ∣ x :=
classical.by_cases (λ hy : algebra_map O F y = 0, have hx : x = 0,
    from hv.1 $ (algebra_map O F).map_zero.symm ▸
      (v.zero_iff.1 $ le_zero_iff.1 (v.map_zero ▸ hy ▸ h)),
  hx.symm ▸ dvd_zero y) $
λ hy : algebra_map O F y ≠ 0,
have v ((algebra_map O F y)⁻¹ * algebra_map O F x) ≤ 1,
  by { rw [← v.map_one, ← inv_mul_cancel hy, v.map_mul, v.map_mul], exact mul_le_mul_left' h _ },
let ⟨z, hz⟩ := hv.3 this in
⟨z, hv.1 $ ((algebra_map O F).map_mul y z).symm ▸ hz.symm ▸ (mul_inv_cancel_left₀ hy _).symm⟩

lemma dvd_iff_le {x y : O} : x ∣ y ↔ v (algebra_map O F y) ≤ v (algebra_map O F x) :=
⟨hv.le_of_dvd, hv.dvd_of_le⟩

lemma le_iff_dvd {x y : O} : v (algebra_map O F x) ≤ v (algebra_map O F y) ↔ y ∣ x :=
⟨hv.dvd_of_le, hv.le_of_dvd⟩

end integers

end field

end valuation


import algebra.homology.additive
import locally_constant.Vhat
import normed_group.controlled_exactness
import prop819.strict_complex_iso

noncomputable theory

universes u

variables (C D : cochain_complex SemiNormedGroup.{u} ℕ)

open SemiNormedGroup

/-- The completed cochain complex associated to C. -/
abbreviation cmpl := (Completion.map_homological_complex _).obj C

open_locale nnreal

lemma cmpl_exact_of_exact (ε : ℝ≥0) (hε : 0 < ε)
  (cond : ∀ (n : ℕ) (f : C.X (n+1)) (hf : C.d (n+1) (n+2) f = 0),
    ∃ g : C.X n, C.d _ _ g = f ∧ ∥g∥₊ ≤ ∥f∥₊) (n : ℕ) (f : (cmpl C).X (n+1))
    (hf : (cmpl C).d _ (n+2) f = 0) : ∃ g : (cmpl C).X n, (cmpl C).d _ _ g = f ∧
    ∥g∥₊ ≤ (1 + ε) * ∥f∥₊ :=
begin
  have := @controlled_exactness (C.X (n+1)) (C.X n) (C.X (n+2)) _ _ _ (C.d _ _) 1 zero_lt_one
    1 (C.d _ _) _ _ ε hε f _,
  { rcases this with ⟨g,hg1,hg2⟩,
    exact ⟨g,hg1,hg2⟩ },
  { intros g hg,
    erw add_monoid_hom.mem_ker at hg,
    specialize cond _ g hg,
    rcases cond with ⟨g',h1,h2⟩,
    refine ⟨g',h1,_⟩,
    simpa },
  { rintros g ⟨g,rfl⟩,
    specialize cond (n+1) (C.d (n+1) (n+2) g) _,
    { change (C.d (n+1) (n+2) ≫ C.d (n+2) (n+3)) g = 0,
      simp },
    rcases cond with ⟨g',h1,h2⟩,
    refine ⟨g',h1,_⟩,
    dsimp,
    simp,
    exact h2 },
  { erw add_monoid_hom.mem_ker,
    exact hf },
end

lemma injective_of_strict_iso (F : strict_iso C D)
  (cond : ∀ (f : C.X 0) (hf : C.d 0 1 f = 0), f = 0) (f : D.X 0) (hf : D.d 0 1 f = 0) : f = 0 :=
begin
  let FF := (homological_complex.eval _ _ 0).map_iso F.iso,
  have : f = (FF.inv ≫ FF.hom) f, by {rw FF.inv_hom_id, simp},
  rw this,
  change FF.hom (FF.inv f) = 0,
  rw ←(show FF.hom 0 = 0, by simp),
  congr' 1,
  apply cond,
  change (F.iso.inv.f 0 ≫ C.d 0 1) f = 0,
  erw F.iso.inv.comm,
  change (F.iso.inv.f 1) _ = 0,
  erw hf,
  simp,
end

lemma exact_of_strict_iso (F : strict_iso C D) (ε : ℝ≥0) (hε : 0 < ε)
  (cond : ∀ (n : ℕ) (f : C.X (n+1)) (hf : C.d _ (n+2) f = 0),
    ∃ g : C.X n, C.d _ _ g = f ∧ ∥g∥₊ ≤ (1+ε) * ∥f∥₊)
  (n : ℕ) (f : D.X (n+1)) (hf : D.d _ (n+2) f = 0) :
  ∃ g : D.X n, D.d _ _ g = f ∧ ∥g∥₊ ≤ (1 + ε) * ∥f∥₊ :=
begin
  specialize cond n (((homological_complex.eval _ _ (n+1)).map_iso F.iso).inv f) _,
  { dsimp [homological_complex.eval],
    change (F.iso.inv.f (n+1) ≫ C.d (n+1) (n+2)) f = 0,
    rw F.iso.inv.comm,
    simp [hf] },
  rcases cond with ⟨g, h1, h2⟩,
  refine ⟨((homological_complex.eval _ _ n).map_iso F.iso).hom g, _, _⟩,
  { dsimp [homological_complex.eval] at *,
    change (F.iso.hom.f _ ≫ D.d _ _) _ = _,
    rw F.iso.hom.comm,
    simp [h1],
    let FF := (homological_complex.eval _ _ (n+1)).map_iso F.iso,
    change (FF.inv ≫ FF.hom) f = f,
    rw FF.inv_hom_id,
    refl },
  { rw SemiNormedGroup.strict_iso_inv at h2,
    rwa SemiNormedGroup.strict_iso_hom },
end


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

import Mathlib.Tactic.Existsi

example : ∃ x : Nat, x = x := by
  existsi 42
  rfl

example : ∃ x : Nat, ∃ y : Nat, x = y := by
  existsi 42, 42
  rfl


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes, Johannes Hölzl, Scott Morrison, Jens Wagemaker, Johan Commelin
-/
import data.polynomial.algebra_map
import data.polynomial.degree.lemmas
import data.polynomial.div
import ring_theory.localization.fraction_ring
import algebra.polynomial.big_operators

/-!
# Theory of univariate polynomials

This file starts looking like the ring theory of $ R[X] $

-/

noncomputable theory
open_locale classical polynomial

open finset

namespace polynomial
universes u v w z
variables {R : Type u} {S : Type v} {T : Type w} {a b : R} {n : ℕ}

section comm_ring
variables [comm_ring R] {p q : R[X]}

section
variables [semiring S]

lemma nat_degree_pos_of_aeval_root [algebra R S] {p : R[X]} (hp : p ≠ 0)
  {z : S} (hz : aeval z p = 0) (inj : ∀ (x : R), algebra_map R S x = 0 → x = 0) :
  0 < p.nat_degree :=
nat_degree_pos_of_eval₂_root hp (algebra_map R S) hz inj

lemma degree_pos_of_aeval_root [algebra R S] {p : R[X]} (hp : p ≠ 0)
  {z : S} (hz : aeval z p = 0) (inj : ∀ (x : R), algebra_map R S x = 0 → x = 0) :
  0 < p.degree :=
nat_degree_pos_iff_degree_pos.mp (nat_degree_pos_of_aeval_root hp hz inj)

lemma mod_by_monic_eq_of_dvd_sub (hq : q.monic) {p₁ p₂ : R[X]}
  (h : q ∣ (p₁ - p₂)) :
  p₁ %ₘ q = p₂ %ₘ q :=
begin
  nontriviality R,
  obtain ⟨f, sub_eq⟩ := h,
  refine (div_mod_by_monic_unique (p₂ /ₘ q + f) _ hq
    ⟨_, degree_mod_by_monic_lt _ hq⟩).2,
  rw [sub_eq_iff_eq_add.mp sub_eq, mul_add, ← add_assoc, mod_by_monic_add_div _ hq, add_comm]
end

lemma add_mod_by_monic (p₁ p₂ : R[X]) : (p₁ + p₂) %ₘ q = p₁ %ₘ q + p₂ %ₘ q :=
begin
  by_cases hq : q.monic,
  { nontriviality R,
    exact (div_mod_by_monic_unique (p₁ /ₘ q + p₂ /ₘ q) _ hq
      ⟨by rw [mul_add, add_left_comm, add_assoc, mod_by_monic_add_div _ hq, ← add_assoc,
              add_comm (q * _), mod_by_monic_add_div _ hq],
        (degree_add_le _ _).trans_lt (max_lt (degree_mod_by_monic_lt _ hq)
          (degree_mod_by_monic_lt _ hq))⟩).2 },
  { simp_rw mod_by_monic_eq_of_not_monic _ hq }
end

lemma smul_mod_by_monic (c : R) (p : R[X]) : (c • p) %ₘ q = c • (p %ₘ q) :=
begin
  by_cases hq : q.monic,
  { nontriviality R,
    exact (div_mod_by_monic_unique (c • (p /ₘ q)) (c • (p %ₘ q)) hq
      ⟨by rw [mul_smul_comm, ← smul_add, mod_by_monic_add_div p hq],
      (degree_smul_le _ _).trans_lt (degree_mod_by_monic_lt _ hq)⟩).2 },
  { simp_rw mod_by_monic_eq_of_not_monic _ hq }
end

/--  `_ %ₘ q` as an `R`-linear map. -/
@[simps]
def mod_by_monic_hom (q : R[X]) : R[X] →ₗ[R] R[X] :=
{ to_fun := λ p, p %ₘ q,
  map_add' := add_mod_by_monic,
  map_smul' := smul_mod_by_monic }

end

section
variables [ring S]

lemma aeval_mod_by_monic_eq_self_of_root [algebra R S]
  {p q : R[X]} (hq : q.monic) {x : S} (hx : aeval x q = 0) :
  aeval x (p %ₘ q) = aeval x p :=
-- `eval₂_mod_by_monic_eq_self_of_root` doesn't work here as it needs commutativity
by rw [mod_by_monic_eq_sub_mul_div p hq, _root_.map_sub, _root_.map_mul, hx, zero_mul, sub_zero]

end

end comm_ring

section no_zero_divisors
variables [semiring R] [no_zero_divisors R] {p q : R[X]}

instance : no_zero_divisors R[X] :=
{ eq_zero_or_eq_zero_of_mul_eq_zero := λ a b h, begin
    rw [← leading_coeff_eq_zero, ← leading_coeff_eq_zero],
    refine eq_zero_or_eq_zero_of_mul_eq_zero _,
    rw [← leading_coeff_zero, ← leading_coeff_mul, h],
  end }

lemma nat_degree_mul (hp : p ≠ 0) (hq : q ≠ 0) : nat_degree (p * q) =
  nat_degree p + nat_degree q :=
by rw [← with_bot.coe_eq_coe, ← degree_eq_nat_degree (mul_ne_zero hp hq),
    with_bot.coe_add, ← degree_eq_nat_degree hp,
    ← degree_eq_nat_degree hq, degree_mul]

lemma trailing_degree_mul : (p * q).trailing_degree = p.trailing_degree + q.trailing_degree :=
begin
  by_cases hp : p = 0,
  { rw [hp, zero_mul, trailing_degree_zero, top_add] },
  by_cases hq : q = 0,
  { rw [hq, mul_zero, trailing_degree_zero, add_top] },
  rw [trailing_degree_eq_nat_trailing_degree hp, trailing_degree_eq_nat_trailing_degree hq,
      trailing_degree_eq_nat_trailing_degree (mul_ne_zero hp hq),
      nat_trailing_degree_mul hp hq, with_top.coe_add],
end

@[simp] lemma nat_degree_pow (p : R[X]) (n : ℕ) :
  nat_degree (p ^ n) = n * nat_degree p :=
if hp0 : p = 0
then if hn0 : n = 0 then by simp [hp0, hn0]
  else by rw [hp0, zero_pow (nat.pos_of_ne_zero hn0)]; simp
else nat_degree_pow'
  (by rw [← leading_coeff_pow, ne.def, leading_coeff_eq_zero]; exact pow_ne_zero _ hp0)

lemma degree_le_mul_left (p : R[X]) (hq : q ≠ 0) : degree p ≤ degree (p * q) :=
if hp : p = 0 then by simp only [hp, zero_mul, le_refl]
else by rw [degree_mul, degree_eq_nat_degree hp,
    degree_eq_nat_degree hq];
  exact with_bot.coe_le_coe.2 (nat.le_add_right _ _)

theorem nat_degree_le_of_dvd {p q : R[X]} (h1 : p ∣ q) (h2 : q ≠ 0) :
  p.nat_degree ≤ q.nat_degree :=
begin
  rcases h1 with ⟨q, rfl⟩, rw mul_ne_zero_iff at h2,
  rw [nat_degree_mul h2.1 h2.2], exact nat.le_add_right _ _
end

/-- This lemma is useful for working with the `int_degree` of a rational function. -/
lemma nat_degree_sub_eq_of_prod_eq {p₁ p₂ q₁ q₂ : polynomial R} (hp₁ : p₁ ≠ 0) (hq₁ : q₁ ≠ 0)
  (hp₂ : p₂ ≠ 0) (hq₂ : q₂ ≠ 0) (h_eq : p₁ * q₂ = p₂ * q₁) :
  (p₁.nat_degree : ℤ) - q₁.nat_degree = (p₂.nat_degree : ℤ) - q₂.nat_degree :=
begin
  rw sub_eq_sub_iff_add_eq_add,
  norm_cast,
  rw [← nat_degree_mul hp₁ hq₂, ← nat_degree_mul hp₂ hq₁, h_eq]
end

end no_zero_divisors

section no_zero_divisors
variables [comm_semiring R] [no_zero_divisors R] {p q : R[X]}

lemma root_mul : is_root (p * q) a ↔ is_root p a ∨ is_root q a :=
by simp_rw [is_root, eval_mul, mul_eq_zero]

lemma root_or_root_of_root_mul (h : is_root (p * q) a) : is_root p a ∨ is_root q a :=
root_mul.1 h

end no_zero_divisors

section ring
variables [ring R] [is_domain R] {p q : R[X]}

instance : is_domain R[X] :=
{ ..polynomial.no_zero_divisors,
  ..polynomial.nontrivial, }

end ring

section comm_ring
variables [comm_ring R] [is_domain R] {p q : R[X]}

section roots

open multiset

lemma degree_eq_zero_of_is_unit (h : is_unit p) : degree p = 0 :=
let ⟨q, hq⟩ := is_unit_iff_dvd_one.1 h in
have hp0 : p ≠ 0, from λ hp0, by simpa [hp0] using hq,
have hq0 : q ≠ 0, from λ hp0, by simpa [hp0] using hq,
have nat_degree (1 : R[X]) = nat_degree (p * q),
  from congr_arg _ hq,
by rw [nat_degree_one, nat_degree_mul hp0 hq0, eq_comm,
    _root_.add_eq_zero_iff, ← with_bot.coe_eq_coe,
    ← degree_eq_nat_degree hp0] at this;
  exact this.1

@[simp] lemma degree_coe_units (u : R[X]ˣ) :
  degree (u : R[X]) = 0 :=
degree_eq_zero_of_is_unit ⟨u, rfl⟩

theorem prime_X_sub_C (r : R) : prime (X - C r) :=
⟨X_sub_C_ne_zero r, not_is_unit_X_sub_C r,
 λ _ _, by { simp_rw [dvd_iff_is_root, is_root.def, eval_mul, mul_eq_zero], exact id }⟩

theorem prime_X : prime (X : R[X]) :=
by { convert (prime_X_sub_C (0 : R)), simp }

lemma monic.prime_of_degree_eq_one (hp1 : degree p = 1) (hm : monic p) :
  prime p :=
have p = X - C (- p.coeff 0),
  by simpa [hm.leading_coeff] using eq_X_add_C_of_degree_eq_one hp1,
this.symm ▸ prime_X_sub_C _

theorem irreducible_X_sub_C (r : R) : irreducible (X - C r) :=
(prime_X_sub_C r).irreducible

theorem irreducible_X : irreducible (X : R[X]) :=
prime.irreducible prime_X

lemma monic.irreducible_of_degree_eq_one (hp1 : degree p = 1) (hm : monic p) :
  irreducible p :=
(hm.prime_of_degree_eq_one hp1).irreducible

theorem eq_of_monic_of_associated (hp : p.monic) (hq : q.monic) (hpq : associated p q) : p = q :=
begin
  obtain ⟨u, hu⟩ := hpq,
  unfold monic at hp hq,
  rw eq_C_of_degree_le_zero (le_of_eq $ degree_coe_units _) at hu,
  rw [← hu, leading_coeff_mul, hp, one_mul, leading_coeff_C] at hq,
  rwa [hq, C_1, mul_one] at hu,
  apply_instance,
end

lemma root_multiplicity_mul {p q : R[X]} {x : R} (hpq : p * q ≠ 0) :
  root_multiplicity x (p * q) = root_multiplicity x p + root_multiplicity x q :=
begin
  have hp : p ≠ 0 := left_ne_zero_of_mul hpq,
  have hq : q ≠ 0 := right_ne_zero_of_mul hpq,
  rw [root_multiplicity_eq_multiplicity (p * q), dif_neg hpq,
      root_multiplicity_eq_multiplicity p, dif_neg hp,
      root_multiplicity_eq_multiplicity q, dif_neg hq,
      multiplicity.mul' (prime_X_sub_C x)],
end

lemma root_multiplicity_X_sub_C_self {x : R} :
  root_multiplicity x (X - C x) = 1 :=
by rw [root_multiplicity_eq_multiplicity, dif_neg (X_sub_C_ne_zero x),
       multiplicity.get_multiplicity_self]

lemma root_multiplicity_X_sub_C {x y : R} :
  root_multiplicity x (X - C y) = if x = y then 1 else 0 :=
begin
  split_ifs with hxy,
  { rw hxy,
    exact root_multiplicity_X_sub_C_self },
  exact root_multiplicity_eq_zero (mt root_X_sub_C.mp (ne.symm hxy))
end

/-- The multiplicity of `a` as root of `(X - a) ^ n` is `n`. -/
lemma root_multiplicity_X_sub_C_pow (a : R) (n : ℕ) : root_multiplicity a ((X - C a) ^ n) = n :=
begin
  induction n with n hn,
  { refine root_multiplicity_eq_zero _,
    simp only [eval_one, is_root.def, not_false_iff, one_ne_zero, pow_zero] },
  have hzero := pow_ne_zero n.succ (X_sub_C_ne_zero a),
  rw pow_succ (X - C a) n at hzero ⊢,
  simp only [root_multiplicity_mul hzero, root_multiplicity_X_sub_C_self, hn, nat.one_add]
end

/-- If `(X - a) ^ n` divides a polynomial `p` then the multiplicity of `a` as root of `p` is at
least `n`. -/
lemma root_multiplicity_of_dvd {p : R[X]} {a : R} {n : ℕ}
  (hzero : p ≠ 0) (h : (X - C a) ^ n ∣ p) : n ≤ root_multiplicity a p :=
begin
  obtain ⟨q, hq⟩ := exists_eq_mul_right_of_dvd h,
  rw hq at hzero,
  simp only [hq, root_multiplicity_mul hzero, root_multiplicity_X_sub_C_pow,
             ge_iff_le, _root_.zero_le, le_add_iff_nonneg_right],
end

/-- The multiplicity of `p + q` is at least the minimum of the multiplicities. -/
lemma root_multiplicity_add {p q : R[X]} (a : R) (hzero : p + q ≠ 0) :
  min (root_multiplicity a p) (root_multiplicity a q) ≤ root_multiplicity a (p + q) :=
begin
  refine root_multiplicity_of_dvd hzero _,
  have hdivp : (X - C a) ^ root_multiplicity a p ∣ p := pow_root_multiplicity_dvd p a,
  have hdivq : (X - C a) ^ root_multiplicity a q ∣ q := pow_root_multiplicity_dvd q a,
  exact min_pow_dvd_add hdivp hdivq
end

lemma exists_multiset_roots : ∀ {p : R[X]} (hp : p ≠ 0),
  ∃ s : multiset R, (s.card : with_bot ℕ) ≤ degree p ∧ ∀ a, s.count a = root_multiplicity a p
| p := λ hp, by haveI := classical.prop_decidable (∃ x, is_root p x); exact
if h : ∃ x, is_root p x
then
  let ⟨x, hx⟩ := h in
  have hpd : 0 < degree p := degree_pos_of_root hp hx,
  have hd0 : p /ₘ (X - C x) ≠ 0 :=
    λ h, by rw [← mul_div_by_monic_eq_iff_is_root.2 hx, h, mul_zero] at hp; exact hp rfl,
  have wf : degree (p /ₘ _) < degree p :=
    degree_div_by_monic_lt _ (monic_X_sub_C x) hp
    ((degree_X_sub_C x).symm ▸ dec_trivial),
  let ⟨t, htd, htr⟩ := @exists_multiset_roots (p /ₘ (X - C x)) hd0 in
  have hdeg : degree (X - C x) ≤ degree p := begin
    rw [degree_X_sub_C, degree_eq_nat_degree hp],
    rw degree_eq_nat_degree hp at hpd,
    exact with_bot.coe_le_coe.2 (with_bot.coe_lt_coe.1 hpd)
  end,
  have hdiv0 : p /ₘ (X - C x) ≠ 0 := mt (div_by_monic_eq_zero_iff (monic_X_sub_C x)).1 $
    not_lt.2 hdeg,
  ⟨x ::ₘ t, calc (card (x ::ₘ t) : with_bot ℕ) = t.card + 1 :
      by exact_mod_cast card_cons _ _
    ... ≤ degree p :
      by rw [← degree_add_div_by_monic (monic_X_sub_C x) hdeg,
          degree_X_sub_C, add_comm];
        exact add_le_add (le_refl (1 : with_bot ℕ)) htd,
  begin
    assume a,
    conv_rhs { rw ← mul_div_by_monic_eq_iff_is_root.mpr hx },
    rw [root_multiplicity_mul (mul_ne_zero (X_sub_C_ne_zero x) hdiv0),
        root_multiplicity_X_sub_C, ← htr a],
    split_ifs with ha,
    { rw [ha, count_cons_self, nat.succ_eq_add_one, add_comm] },
    { rw [count_cons_of_ne ha, zero_add] },
  end⟩
else
  ⟨0, (degree_eq_nat_degree hp).symm ▸ with_bot.coe_le_coe.2 (nat.zero_le _),
    by { intro a, rw [count_zero, root_multiplicity_eq_zero (not_exists.mp h a)] }⟩
using_well_founded {dec_tac := tactic.assumption}

/-- `roots p` noncomputably gives a multiset containing all the roots of `p`,
including their multiplicities. -/
noncomputable def roots (p : R[X]) : multiset R :=
if h : p = 0 then ∅ else classical.some (exists_multiset_roots h)

@[simp] lemma roots_zero : (0 : R[X]).roots = 0 :=
dif_pos rfl

lemma card_roots (hp0 : p ≠ 0) : ((roots p).card : with_bot ℕ) ≤ degree p :=
begin
  unfold roots,
  rw dif_neg hp0,
  exact (classical.some_spec (exists_multiset_roots hp0)).1
end

lemma card_roots' (p : R[X]) : p.roots.card ≤ nat_degree p :=
begin
  by_cases hp0 : p = 0,
  { simp [hp0], },
  exact with_bot.coe_le_coe.1 (le_trans (card_roots hp0) (le_of_eq $ degree_eq_nat_degree hp0))
end

lemma card_roots_sub_C {p : R[X]} {a : R} (hp0 : 0 < degree p) :
  ((p - C a).roots.card : with_bot ℕ) ≤ degree p :=
calc ((p - C a).roots.card : with_bot ℕ) ≤ degree (p - C a) :
  card_roots $ mt sub_eq_zero.1 $ λ h, not_le_of_gt hp0 $ h.symm ▸ degree_C_le
... = degree p : by rw [sub_eq_add_neg, ← C_neg]; exact degree_add_C hp0

lemma card_roots_sub_C' {p : R[X]} {a : R} (hp0 : 0 < degree p) :
  (p - C a).roots.card ≤ nat_degree p :=
with_bot.coe_le_coe.1 (le_trans (card_roots_sub_C hp0) (le_of_eq $ degree_eq_nat_degree
  (λ h, by simp [*, lt_irrefl] at *)))

@[simp] lemma count_roots (p : R[X]) : p.roots.count a = root_multiplicity a p :=
begin
  by_cases hp : p = 0,
  { simp [hp], },
  rw [roots, dif_neg hp],
  exact (classical.some_spec (exists_multiset_roots hp)).2 a
end

@[simp] lemma mem_roots (hp : p ≠ 0) : a ∈ p.roots ↔ is_root p a :=
by rw [← count_pos, count_roots p, root_multiplicity_pos hp]

theorem card_le_degree_of_subset_roots {p : R[X]} {Z : finset R} (h : Z.val ⊆ p.roots) :
  Z.card ≤ p.nat_degree :=
(multiset.card_le_of_le (finset.val_le_iff_val_subset.2 h)).trans (polynomial.card_roots' p)

lemma finite_set_of_is_root {p : R[X]} (hp : p ≠ 0) : set.finite {x | is_root p x} :=
by simpa only [← finset.set_of_mem, mem_to_finset, mem_roots hp]
  using p.roots.to_finset.finite_to_set

lemma eq_zero_of_infinite_is_root (p : R[X]) (h : set.infinite {x | is_root p x}) : p = 0 :=
not_imp_comm.mp finite_set_of_is_root h

lemma exists_max_root [linear_order R] (p : R[X]) (hp : p ≠ 0) :
  ∃ x₀, ∀ x, p.is_root x → x ≤ x₀ :=
set.exists_upper_bound_image _ _ $ finite_set_of_is_root hp

lemma exists_min_root [linear_order R] (p : R[X]) (hp : p ≠ 0) :
  ∃ x₀, ∀ x, p.is_root x → x₀ ≤ x :=
set.exists_lower_bound_image _ _ $ finite_set_of_is_root hp

lemma eq_of_infinite_eval_eq (p q : R[X]) (h : set.infinite {x | eval x p = eval x q}) : p = q :=
begin
  rw [← sub_eq_zero],
  apply eq_zero_of_infinite_is_root,
  simpa only [is_root, eval_sub, sub_eq_zero]
end

lemma roots_mul {p q : R[X]} (hpq : p * q ≠ 0) : (p * q).roots = p.roots + q.roots :=
multiset.ext.mpr $ λ r,
  by rw [count_add, count_roots, count_roots,
         count_roots, root_multiplicity_mul hpq]

lemma roots.le_of_dvd (h : q ≠ 0) : p ∣ q → roots p ≤ roots q :=
begin
  rintro ⟨k, rfl⟩,
  exact multiset.le_iff_exists_add.mpr ⟨k.roots, roots_mul h⟩
end

@[simp] lemma mem_roots_sub_C {p : R[X]} {a x : R} (hp0 : 0 < degree p) :
  x ∈ (p - C a).roots ↔ p.eval x = a :=
(mem_roots (show p - C a ≠ 0, from mt sub_eq_zero.1 $ λ h,
    not_le_of_gt hp0 $ h.symm ▸ degree_C_le)).trans
  (by rw [is_root.def, eval_sub, eval_C, sub_eq_zero])

@[simp] lemma roots_X_sub_C (r : R) : roots (X - C r) = {r} :=
begin
  ext s,
  rw [count_roots, root_multiplicity_X_sub_C],
  split_ifs with h,
  { rw [h, count_singleton_self] },
  { rw [singleton_eq_cons, count_cons_of_ne h, count_zero] }
end

@[simp] lemma roots_C (x : R) : (C x).roots = 0 :=
if H : x = 0 then by rw [H, C_0, roots_zero] else multiset.ext.mpr $ λ r,
by rw [count_roots, count_zero, root_multiplicity_eq_zero (not_is_root_C _ _ H)]

@[simp] lemma roots_one : (1 : R[X]).roots = ∅ :=
roots_C 1

lemma roots_smul_nonzero (p : R[X]) {r : R} (hr : r ≠ 0) :
  (r • p).roots = p.roots :=
begin
  by_cases hp : p = 0;
  simp [smul_eq_C_mul, roots_mul, hr, hp]
end

lemma roots_list_prod (L : list R[X]) :
  ((0 : R[X]) ∉ L) → L.prod.roots = (L : multiset R[X]).bind roots :=
list.rec_on L (λ _, roots_one) $ λ hd tl ih H,
begin
  rw [list.mem_cons_iff, not_or_distrib] at H,
  rw [list.prod_cons, roots_mul (mul_ne_zero (ne.symm H.1) $ list.prod_ne_zero H.2),
      ← multiset.cons_coe, multiset.cons_bind, ih H.2]
end

lemma roots_multiset_prod (m : multiset R[X]) :
  (0 : R[X]) ∉ m → m.prod.roots = m.bind roots :=
by { rcases m with ⟨L⟩, simpa only [coe_prod, quot_mk_to_coe''] using roots_list_prod L }

lemma roots_prod {ι : Type*} (f : ι → R[X]) (s : finset ι) :
  s.prod f ≠ 0 → (s.prod f).roots = s.val.bind (λ i, roots (f i)) :=
begin
  rcases s with ⟨m, hm⟩,
  simpa [multiset.prod_eq_zero_iff, bind_map] using roots_multiset_prod (m.map f)
end

lemma roots_prod_X_sub_C (s : finset R) :
  (s.prod (λ a, X - C a)).roots = s.val :=
(roots_prod (λ a, X - C a) s (prod_ne_zero_iff.mpr (λ a _, X_sub_C_ne_zero a))).trans
  (by simp_rw [roots_X_sub_C, multiset.bind_singleton, multiset.map_id'])

@[simp] lemma roots_multiset_prod_X_sub_C (s : multiset R) :
  (s.map (λ a, X - C a)).prod.roots = s :=
begin
  rw [roots_multiset_prod, multiset.bind_map],
  { simp_rw [roots_X_sub_C, multiset.bind_singleton, multiset.map_id'] },
  { rw [multiset.mem_map], rintro ⟨a, -, h⟩, exact X_sub_C_ne_zero a h },
end

@[simp] lemma nat_degree_multiset_prod_X_sub_C_eq_card (s : multiset R):
  (s.map (λ a, X - C a)).prod.nat_degree = s.card :=
begin
  rw [nat_degree_multiset_prod_of_monic, multiset.map_map],
  { convert multiset.sum_repeat 1 _,
    { convert multiset.map_const _ 1, ext, apply nat_degree_X_sub_C }, { simp } },
  { intros f hf, obtain ⟨a, ha, rfl⟩ := multiset.mem_map.1 hf, exact monic_X_sub_C a },
end

lemma card_roots_X_pow_sub_C {n : ℕ} (hn : 0 < n) (a : R) :
  (roots ((X : R[X]) ^ n - C a)).card ≤ n :=
with_bot.coe_le_coe.1 $
calc ((roots ((X : R[X]) ^ n - C a)).card : with_bot ℕ)
      ≤ degree ((X : R[X]) ^ n - C a) : card_roots (X_pow_sub_C_ne_zero hn a)
  ... = n : degree_X_pow_sub_C hn a

section

variables {A B : Type*} [comm_ring A] [comm_ring B]

lemma le_root_multiplicity_map {p : A[X]} {f : A →+* B} (hmap : map f p ≠ 0) (a : A) :
  root_multiplicity a p ≤ root_multiplicity (f a) (map f p) :=
begin
  have hp0 : p ≠ 0 := λ h, hmap (h.symm ▸ polynomial.map_zero f),
  rw [root_multiplicity, root_multiplicity, dif_neg hp0, dif_neg hmap],
  simp only [not_not, nat.lt_find_iff, nat.le_find_iff],
  intros m hm,
  have := (map_ring_hom f).map_dvd (hm m le_rfl),
  simpa only [coe_map_ring_hom, map_pow, map_sub, map_X, map_C],
end

lemma eq_root_multiplicity_map {p : A[X]} {f : A →+* B} (hf : function.injective f)
  (a : A) : root_multiplicity a p = root_multiplicity (f a) (map f p) :=
begin
  by_cases hp0 : p = 0, { simp only [hp0, root_multiplicity_zero, polynomial.map_zero], },
  have hmap : map f p ≠ 0, { simpa only [polynomial.map_zero] using (map_injective f hf).ne hp0, },
  apply le_antisymm (le_root_multiplicity_map hmap a),
  rw [root_multiplicity, root_multiplicity, dif_neg hp0, dif_neg hmap],
  simp only [not_not, nat.lt_find_iff, nat.le_find_iff],
  intros m hm, rw ← map_dvd_map f hf ((monic_X_sub_C a).pow _),
  convert hm m le_rfl,
  simp only [polynomial.map_pow, polynomial.map_sub, map_pow, map_sub, map_X, map_C],
end

lemma count_map_roots [is_domain A] (p : A[X]) {f : A →+* B} (hf : function.injective f)
  (a : B) : count a (p.roots.map f) ≤ root_multiplicity a (map f p) :=
begin
  by_cases h : ∃ t, f t = a,
  { rcases h with ⟨h_w, rfl⟩,
    rw [multiset.count_map_eq_count' f _ hf, count_roots],
    exact (eq_root_multiplicity_map hf h_w).le },
  { suffices : (multiset.map f p.roots).count a = 0,
    { rw this, exact zero_le _, },
    rw [multiset.count_map, multiset.card_eq_zero, multiset.filter_eq_nil],
    rintro k hk rfl,
    exact h ⟨k, rfl⟩, },
end

lemma roots_map_of_injective_card_eq_total_degree [is_domain A] [is_domain B] {p : A[X]}
  {f : A →+* B} (hf : function.injective f) (hroots : p.roots.card = p.nat_degree) :
  p.roots.map f = (map f p).roots :=
begin
  by_cases hp0 : p = 0, { simp only [hp0, roots_zero, multiset.map_zero, polynomial.map_zero], },
  have hmap : map f p ≠ 0, { simpa only [polynomial.map_zero] using (map_injective f hf).ne hp0, },
  apply multiset.eq_of_le_of_card_le,
  { simpa only [multiset.le_iff_count, count_roots] using count_map_roots p hf },
  { simpa only [multiset.card_map, hroots] using (card_roots' _).trans (nat_degree_map_le f p) },
end

end

section nth_roots

/-- `nth_roots n a` noncomputably returns the solutions to `x ^ n = a`-/
def nth_roots (n : ℕ) (a : R) : multiset R :=
roots ((X : R[X]) ^ n - C a)

@[simp] lemma mem_nth_roots {n : ℕ} (hn : 0 < n) {a x : R} :
  x ∈ nth_roots n a ↔ x ^ n = a :=
by rw [nth_roots, mem_roots (X_pow_sub_C_ne_zero hn a),
  is_root.def, eval_sub, eval_C, eval_pow, eval_X, sub_eq_zero]

@[simp] lemma nth_roots_zero (r : R) : nth_roots 0 r = 0 :=
by simp only [empty_eq_zero, pow_zero, nth_roots, ← C_1, ← C_sub, roots_C]

lemma card_nth_roots (n : ℕ) (a : R) :
  (nth_roots n a).card ≤ n :=
if hn : n = 0
then if h : (X : R[X]) ^ n - C a = 0
  then by simp only [nat.zero_le, nth_roots, roots, h, dif_pos rfl, empty_eq_zero, card_zero]
  else with_bot.coe_le_coe.1 (le_trans (card_roots h)
   (by { rw [hn, pow_zero, ← C_1, ← ring_hom.map_sub ],
         exact degree_C_le }))
else by rw [← with_bot.coe_le_coe, ← degree_X_pow_sub_C (nat.pos_of_ne_zero hn) a];
  exact card_roots (X_pow_sub_C_ne_zero (nat.pos_of_ne_zero hn) a)

/-- The multiset `nth_roots ↑n (1 : R)` as a finset. -/
def nth_roots_finset (n : ℕ) (R : Type*) [comm_ring R] [is_domain R] : finset R :=
multiset.to_finset (nth_roots n (1 : R))

@[simp] lemma mem_nth_roots_finset {n : ℕ} (h : 0 < n) {x : R} :
  x ∈ nth_roots_finset n R ↔ x ^ (n : ℕ) = 1 :=
by rw [nth_roots_finset, mem_to_finset, mem_nth_roots h]

@[simp] lemma nth_roots_finset_zero : nth_roots_finset 0 R = ∅ := by simp [nth_roots_finset]

end nth_roots

lemma monic.comp (hp : p.monic) (hq : q.monic) (h : q.nat_degree ≠ 0) : (p.comp q).monic :=
by rw [monic.def, leading_coeff_comp h, monic.def.1 hp, monic.def.1 hq, one_pow, one_mul]

lemma monic.comp_X_add_C (hp : p.monic) (r : R) : (p.comp (X + C r)).monic :=
begin
  refine hp.comp (monic_X_add_C _) (λ ha, _),
  rw [nat_degree_X_add_C] at ha,
  exact one_ne_zero ha
end

lemma monic.comp_X_sub_C (hp : p.monic) (r : R) : (p.comp (X - C r)).monic :=
by simpa using hp.comp_X_add_C (-r)

@[simp] lemma nat_degree_coe_units (u : R[X]ˣ) :
  nat_degree (u : R[X]) = 0 :=
nat_degree_eq_of_degree_eq_some (degree_coe_units u)

lemma comp_eq_zero_iff :
  p.comp q = 0 ↔ p = 0 ∨ (p.eval (q.coeff 0) = 0 ∧ q = C (q.coeff 0)) :=
begin
  split,
  { intro h,
    have key : p.nat_degree = 0 ∨ q.nat_degree = 0,
    { rw [←mul_eq_zero, ←nat_degree_comp, h, nat_degree_zero] },
    replace key := or.imp eq_C_of_nat_degree_eq_zero eq_C_of_nat_degree_eq_zero key,
    cases key,
    { rw [key, C_comp] at h,
      exact or.inl (key.trans h) },
    { rw [key, comp_C, C_eq_zero] at h,
      exact or.inr ⟨h, key⟩ }, },
  { exact λ h, or.rec (λ h, by rw [h, zero_comp]) (λ h, by rw [h.2, comp_C, h.1, C_0]) h },
end

lemma zero_of_eval_zero [infinite R] (p : R[X]) (h : ∀ x, p.eval x = 0) : p = 0 :=
by classical; by_contradiction hp; exact
fintype.false ⟨p.roots.to_finset, λ x, multiset.mem_to_finset.mpr ((mem_roots hp).mpr (h _))⟩

lemma funext [infinite R] {p q : R[X]} (ext : ∀ r : R, p.eval r = q.eval r) : p = q :=
begin
  rw ← sub_eq_zero,
  apply zero_of_eval_zero,
  intro x,
  rw [eval_sub, sub_eq_zero, ext],
end

variables [comm_ring T]

/-- The set of distinct roots of `p` in `E`.

If you have a non-separable polynomial, use `polynomial.roots` for the multiset
where multiple roots have the appropriate multiplicity. -/
def root_set (p : T[X]) (S) [comm_ring S] [is_domain S] [algebra T S] : set S :=
(p.map (algebra_map T S)).roots.to_finset

lemma root_set_def (p : T[X]) (S) [comm_ring S] [is_domain S] [algebra T S] :
  p.root_set S = (p.map (algebra_map T S)).roots.to_finset :=
rfl

@[simp] lemma root_set_zero (S) [comm_ring S] [is_domain S] [algebra T S] :
  (0 : T[X]).root_set S = ∅ :=
by rw [root_set_def, polynomial.map_zero, roots_zero, to_finset_zero, finset.coe_empty]

@[simp] lemma root_set_C [comm_ring S] [is_domain S] [algebra T S] (a : T) :
  (C a).root_set S = ∅ :=
by rw [root_set_def, map_C, roots_C, multiset.to_finset_zero, finset.coe_empty]

instance root_set_fintype (p : T[X])
  (S : Type*) [comm_ring S] [is_domain S] [algebra T S] : fintype (p.root_set S) :=
finset_coe.fintype _

lemma root_set_finite (p : T[X])
  (S : Type*) [comm_ring S] [is_domain S] [algebra T S] : (p.root_set S).finite :=
set.finite_of_fintype _

theorem mem_root_set_iff' {p : T[X]} {S : Type*} [comm_ring S] [is_domain S]
  [algebra T S] (hp : p.map (algebra_map T S) ≠ 0) (a : S) :
  a ∈ p.root_set S ↔ (p.map (algebra_map T S)).eval a = 0 :=
by { change a ∈ multiset.to_finset _ ↔ _, rw [mem_to_finset, mem_roots hp], refl }

theorem mem_root_set_iff {p : T[X]} (hp : p ≠ 0) {S : Type*} [comm_ring S] [is_domain S]
  [algebra T S] [no_zero_smul_divisors T S] (a : S) : a ∈ p.root_set S ↔ aeval a p = 0 :=
begin
  rw [mem_root_set_iff', ←eval₂_eq_eval_map],
  { refl },
  intro h,
  rw ←polynomial.map_zero (algebra_map T S) at h,
  exact hp (map_injective _ (no_zero_smul_divisors.algebra_map_injective T S) h)
end

end roots

theorem is_unit_iff {f : R[X]} : is_unit f ↔ ∃ r : R, is_unit r ∧ C r = f :=
⟨λ hf, ⟨f.coeff 0,
  is_unit_C.1 $ eq_C_of_degree_eq_zero (degree_eq_zero_of_is_unit hf) ▸ hf,
  (eq_C_of_degree_eq_zero (degree_eq_zero_of_is_unit hf)).symm⟩,
λ ⟨r, hr, hrf⟩, hrf ▸ is_unit_C.2 hr⟩

lemma coeff_coe_units_zero_ne_zero (u : R[X]ˣ) :
  coeff (u : R[X]) 0 ≠ 0 :=
begin
  conv in (0) { rw [← nat_degree_coe_units u] },
  rw [← leading_coeff, ne.def, leading_coeff_eq_zero],
  exact units.ne_zero _
end

lemma degree_eq_degree_of_associated (h : associated p q) : degree p = degree q :=
let ⟨u, hu⟩ := h in by simp [hu.symm]

lemma degree_eq_one_of_irreducible_of_root (hi : irreducible p) {x : R} (hx : is_root p x) :
  degree p = 1 :=
let ⟨g, hg⟩ := dvd_iff_is_root.2 hx in
have is_unit (X - C x) ∨ is_unit g, from hi.is_unit_or_is_unit hg,
this.elim
  (λ h, have h₁ : degree (X - C x) = 1, from degree_X_sub_C x,
    have h₂ : degree (X - C x) = 0, from degree_eq_zero_of_is_unit h,
    by rw h₁ at h₂; exact absurd h₂ dec_trivial)
  (λ hgu, by rw [hg, degree_mul, degree_X_sub_C, degree_eq_zero_of_is_unit hgu, add_zero])

/-- Division by a monic polynomial doesn't change the leading coefficient. -/
lemma leading_coeff_div_by_monic_of_monic {R : Type u} [comm_ring R]
  {p q : R[X]} (hmonic : q.monic) (hdegree : q.degree ≤ p.degree) :
  (p /ₘ q).leading_coeff = p.leading_coeff :=
begin
  nontriviality,
  have h : q.leading_coeff * (p /ₘ q).leading_coeff ≠ 0,
  { simpa [div_by_monic_eq_zero_iff hmonic, hmonic.leading_coeff, nat.with_bot.one_le_iff_zero_lt]
      using hdegree },
  nth_rewrite_rhs 0 ←mod_by_monic_add_div p hmonic,
  rw [leading_coeff_add_of_degree_lt, leading_coeff_monic_mul hmonic],
  rw [degree_mul' h, degree_add_div_by_monic hmonic hdegree],
  exact (degree_mod_by_monic_lt p hmonic).trans_le hdegree
end

lemma leading_coeff_div_by_monic_X_sub_C (p : R[X]) (hp : degree p ≠ 0) (a : R) :
  leading_coeff (p /ₘ (X - C a)) = leading_coeff p :=
begin
  nontriviality,
  cases hp.lt_or_lt with hd hd,
  { rw [degree_eq_bot.mp $ (nat.with_bot.lt_zero_iff _).mp hd, zero_div_by_monic] },
  refine leading_coeff_div_by_monic_of_monic (monic_X_sub_C a) _,
  rwa [degree_X_sub_C, nat.with_bot.one_le_iff_zero_lt]
end

lemma eq_leading_coeff_mul_of_monic_of_dvd_of_nat_degree_le {R} [comm_ring R]
  {p q : R[X]} (hp : p.monic) (hdiv : p ∣ q)
  (hdeg : q.nat_degree ≤ p.nat_degree) : q = C q.leading_coeff * p :=
begin
  obtain ⟨r, hr⟩ := hdiv,
  obtain (rfl|hq) := eq_or_ne q 0, {simp},
  have rzero : r ≠ 0 := λ h, by simpa [h, hq] using hr,
  rw [hr, nat_degree_mul'] at hdeg, swap,
  { rw [hp.leading_coeff, one_mul, leading_coeff_ne_zero], exact rzero },
  rw [mul_comm, @eq_C_of_nat_degree_eq_zero _ _ r] at hr,
  { convert hr, convert leading_coeff_C _ using 1, rw [hr, leading_coeff_mul_monic hp] },
  { exact (add_right_inj _).1 (le_antisymm hdeg $ nat.le.intro rfl) },
end

lemma eq_of_monic_of_dvd_of_nat_degree_le {R} [comm_ring R]
  {p q : R[X]} (hp : p.monic) (hq : q.monic) (hdiv : p ∣ q)
  (hdeg : q.nat_degree ≤ p.nat_degree) : q = p :=
begin
  convert eq_leading_coeff_mul_of_monic_of_dvd_of_nat_degree_le hp hdiv hdeg,
  rw [hq.leading_coeff, C_1, one_mul],
end

lemma is_coprime_X_sub_C_of_is_unit_sub {R} [comm_ring R] {a b : R}
  (h : is_unit (a - b)) : is_coprime (X - C a) (X - C b) :=
⟨-C h.unit⁻¹.val, C h.unit⁻¹.val, by { rw [neg_mul_comm, ← left_distrib, neg_add_eq_sub,
  sub_sub_sub_cancel_left, ← C_sub, ← C_mul], convert C_1, exact h.coe_inv_mul }⟩

theorem pairwise_coprime_X_sub_C {K} [field K] {I : Type v} {s : I → K}
  (H : function.injective s) : pairwise (is_coprime on (λ i : I, X - C (s i))) :=
λ i j hij, is_coprime_X_sub_C_of_is_unit_sub (sub_ne_zero_of_ne $ H.ne hij).is_unit

lemma monic_prod_multiset_X_sub_C : monic (p.roots.map (λ a, X - C a)).prod :=
monic_multiset_prod_of_monic _ _ (λ a _, monic_X_sub_C a)

lemma prod_multiset_root_eq_finset_root :
  (p.roots.map (λ a, X - C a)).prod =
  p.roots.to_finset.prod (λ a, (X - C a) ^ root_multiplicity a p) :=
by simp only [count_roots, finset.prod_multiset_map_count]

/-- The product `∏ (X - a)` for `a` inside the multiset `p.roots` divides `p`. -/
lemma prod_multiset_X_sub_C_dvd (p : R[X]) : (p.roots.map (λ a, X - C a)).prod ∣ p :=
begin
  rw ← map_dvd_map _ (is_fraction_ring.injective R $ fraction_ring R) monic_prod_multiset_X_sub_C,
  rw [prod_multiset_root_eq_finset_root, polynomial.map_prod],
  refine finset.prod_dvd_of_coprime (λ a _ b _ h, _) (λ a _, _),
  { simp_rw [polynomial.map_pow, polynomial.map_sub, map_C, map_X],
    exact (pairwise_coprime_X_sub_C (is_fraction_ring.injective R $ fraction_ring R) _ _ h).pow },
  { exact polynomial.map_dvd _ (pow_root_multiplicity_dvd p a) },
end

lemma exists_prod_multiset_X_sub_C_mul (p : R[X]) : ∃ q,
  (p.roots.map (λ a, X - C a)).prod * q = p ∧
  p.roots.card + q.nat_degree = p.nat_degree ∧
  q.roots = 0 :=
begin
  obtain ⟨q, he⟩ := prod_multiset_X_sub_C_dvd p,
  use [q, he.symm],
  obtain (rfl|hq) := eq_or_ne q 0,
  { rw mul_zero at he, subst he, simp },
  split,
  { conv_rhs { rw he },
    rw [monic_prod_multiset_X_sub_C.nat_degree_mul' hq, nat_degree_multiset_prod_X_sub_C_eq_card] },
  { replace he := congr_arg roots he.symm,
    rw [roots_mul, roots_multiset_prod_X_sub_C] at he,
    exacts [add_right_eq_self.1 he, mul_ne_zero monic_prod_multiset_X_sub_C.ne_zero hq] },
end

/-- A polynomial `p` that has as many roots as its degree
can be written `p = p.leading_coeff * ∏(X - a)`, for `a` in `p.roots`. -/
lemma C_leading_coeff_mul_prod_multiset_X_sub_C (hroots : p.roots.card = p.nat_degree) :
  C p.leading_coeff * (p.roots.map (λ a, X - C a)).prod = p :=
(eq_leading_coeff_mul_of_monic_of_dvd_of_nat_degree_le monic_prod_multiset_X_sub_C
  (prod_multiset_X_sub_C_dvd p) $
  ((nat_degree_multiset_prod_X_sub_C_eq_card _).trans hroots).ge).symm

/-- A monic polynomial `p` that has as many roots as its degree
can be written `p = ∏(X - a)`, for `a` in `p.roots`. -/
lemma prod_multiset_X_sub_C_of_monic_of_roots_card_eq
  (hp : p.monic) (hroots : p.roots.card = p.nat_degree) :
  (p.roots.map (λ a, X - C a)).prod = p :=
by { convert C_leading_coeff_mul_prod_multiset_X_sub_C hroots, rw [hp.leading_coeff, C_1, one_mul] }

end comm_ring

section

variables [semiring R] [comm_ring S] [is_domain S] (φ : R →+* S)

lemma is_unit_of_is_unit_leading_coeff_of_is_unit_map
  {f : R[X]} (hf : is_unit f.leading_coeff) (H : is_unit (map φ f)) :
  is_unit f :=
begin
  have dz := degree_eq_zero_of_is_unit H,
  rw degree_map_eq_of_leading_coeff_ne_zero at dz,
  { rw eq_C_of_degree_eq_zero dz,
    refine is_unit.map C _,
    convert hf,
    rw (degree_eq_iff_nat_degree_eq _).1 dz,
    rintro rfl,
    simpa using H, },
  { intro h,
    have u : is_unit (φ f.leading_coeff) := is_unit.map φ hf,
    rw h at u,
    simpa using u, }
end

end

section
variables [comm_ring R] [is_domain R] [comm_ring S] [is_domain S] (φ : R →+* S)
/--
A polynomial over an integral domain `R` is irreducible if it is monic and
  irreducible after mapping into an integral domain `S`.

A special case of this lemma is that a polynomial over `ℤ` is irreducible if
  it is monic and irreducible over `ℤ/pℤ` for some prime `p`.
-/
lemma monic.irreducible_of_irreducible_map (f : R[X])
  (h_mon : monic f) (h_irr : irreducible (map φ f)) :
  irreducible f :=
begin
  refine ⟨h_irr.not_unit ∘ is_unit.map (map_ring_hom φ), λ a b h, _⟩,
  dsimp [monic] at h_mon,
  have q := (leading_coeff_mul a b).symm,
  rw [←h, h_mon] at q,
  refine (h_irr.is_unit_or_is_unit $ (congr_arg (map φ) h).trans (polynomial.map_mul φ)).imp _ _;
    apply is_unit_of_is_unit_leading_coeff_of_is_unit_map;
    apply is_unit_of_mul_eq_one,
  { exact q }, { rw mul_comm, exact q },
end

end

end polynomial


/-
Copyright (c) 2019 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot
-/
import topology.uniform_space.cauchy
import topology.uniform_space.separation

/-!
# Indexed product of uniform spaces

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

noncomputable theory

open_locale uniformity topology

section
open filter uniform_space
universe u
variables {ι : Type*} (α : ι → Type u) [U : Πi, uniform_space (α i)]
include U

instance Pi.uniform_space : uniform_space (Πi, α i) :=
uniform_space.of_core_eq
  (⨅i, uniform_space.comap (λ a : Πi, α i, a i) (U i)).to_core
  Pi.topological_space $ eq.symm to_topological_space_infi

lemma Pi.uniformity :
  𝓤 (Π i, α i) = ⨅ i : ι, filter.comap (λ a, (a.1 i, a.2 i)) $ 𝓤 (α i) :=
infi_uniformity

variable {α}

lemma uniform_continuous_pi {β : Type*} [uniform_space β] {f : β → Π i, α i} :
  uniform_continuous f ↔ ∀ i, uniform_continuous (λ x, f x i) :=
by simp only [uniform_continuous, Pi.uniformity, tendsto_infi, tendsto_comap_iff]

variable (α)

lemma Pi.uniform_continuous_proj (i : ι) : uniform_continuous (λ (a : Π (i : ι), α i), a i) :=
uniform_continuous_pi.1 uniform_continuous_id i

instance Pi.complete [∀ i, complete_space (α i)] : complete_space (Π i, α i) :=
⟨begin
  intros f hf,
  haveI := hf.1,
  have : ∀ i, ∃ x : α i, filter.map (λ a : Πi, α i, a i) f ≤ 𝓝 x,
  { intro i,
    have key : cauchy (map (λ (a : Π (i : ι), α i), a i) f),
      from hf.map (Pi.uniform_continuous_proj α i),
    exact cauchy_iff_exists_le_nhds.1 key },
  choose x hx using this,
  use x,
  rwa [nhds_pi, le_pi],
end⟩

instance Pi.separated [∀ i, separated_space (α i)] : separated_space (Π i, α i) :=
separated_def.2 $ assume x y H,
begin
  ext i,
  apply eq_of_separated_of_uniform_continuous (Pi.uniform_continuous_proj α i),
  apply H,
end
end


/-
Copyright (c) 2019 Reid Barton. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.topology.constructions
import Mathlib.topology.algebra.group
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Topology on lists and vectors

-/

protected instance list.topological_space {α : Type u_1} [topological_space α] :
    topological_space (List α) :=
  topological_space.mk_of_nhds (traverse nhds)

theorem nhds_list {α : Type u_1} [topological_space α] (as : List α) : nhds as = traverse nhds as :=
  sorry

@[simp] theorem nhds_nil {α : Type u_1} [topological_space α] : nhds [] = pure [] :=
  eq.mpr (id (Eq._oldrec (Eq.refl (nhds [] = pure [])) (nhds_list [])))
    (eq.mpr (id (Eq._oldrec (Eq.refl (traverse nhds [] = pure [])) (list.traverse_nil nhds)))
      (Eq.refl (pure [])))

theorem nhds_cons {α : Type u_1} [topological_space α] (a : α) (l : List α) :
    nhds (a :: l) = List.cons <$> nhds a <*> nhds l :=
  sorry

theorem list.tendsto_cons {α : Type u_1} [topological_space α] {a : α} {l : List α} :
    filter.tendsto (fun (p : α × List α) => prod.fst p :: prod.snd p)
        (filter.prod (nhds a) (nhds l)) (nhds (a :: l)) :=
  sorry

theorem filter.tendsto.cons {β : Type u_2} [topological_space β] {α : Type u_1} {f : α → β}
    {g : α → List β} {a : filter α} {b : β} {l : List β} (hf : filter.tendsto f a (nhds b))
    (hg : filter.tendsto g a (nhds l)) :
    filter.tendsto (fun (a : α) => f a :: g a) a (nhds (b :: l)) :=
  filter.tendsto.comp list.tendsto_cons (filter.tendsto.prod_mk hf hg)

namespace list

theorem tendsto_cons_iff {α : Type u_1} [topological_space α] {β : Type u_2} {f : List α → β}
    {b : filter β} {a : α} {l : List α} :
    filter.tendsto f (nhds (a :: l)) b ↔
        filter.tendsto (fun (p : α × List α) => f (prod.fst p :: prod.snd p))
          (filter.prod (nhds a) (nhds l)) b :=
  sorry

theorem continuous_cons {α : Type u_1} [topological_space α] :
    continuous fun (x : α × List α) => prod.fst x :: prod.snd x :=
  sorry

theorem tendsto_nhds {α : Type u_1} [topological_space α] {β : Type u_2} {f : List α → β}
    {r : List α → filter β} (h_nil : filter.tendsto f (pure []) (r []))
    (h_cons :
      ∀ (l : List α) (a : α),
        filter.tendsto f (nhds l) (r l) →
          filter.tendsto (fun (p : α × List α) => f (prod.fst p :: prod.snd p))
            (filter.prod (nhds a) (nhds l)) (r (a :: l)))
    (l : List α) : filter.tendsto f (nhds l) (r l) :=
  sorry

theorem continuous_at_length {α : Type u_1} [topological_space α] (l : List α) :
    continuous_at length l :=
  sorry

theorem tendsto_insert_nth' {α : Type u_1} [topological_space α] {a : α} {n : ℕ} {l : List α} :
    filter.tendsto (fun (p : α × List α) => insert_nth n (prod.fst p) (prod.snd p))
        (filter.prod (nhds a) (nhds l)) (nhds (insert_nth n a l)) :=
  sorry

theorem tendsto_insert_nth {α : Type u_1} [topological_space α] {β : Type u_2} {n : ℕ} {a : α}
    {l : List α} {f : β → α} {g : β → List α} {b : filter β} (hf : filter.tendsto f b (nhds a))
    (hg : filter.tendsto g b (nhds l)) :
    filter.tendsto (fun (b : β) => insert_nth n (f b) (g b)) b (nhds (insert_nth n a l)) :=
  filter.tendsto.comp tendsto_insert_nth' (filter.tendsto.prod_mk hf hg)

theorem continuous_insert_nth {α : Type u_1} [topological_space α] {n : ℕ} :
    continuous fun (p : α × List α) => insert_nth n (prod.fst p) (prod.snd p) :=
  sorry

theorem tendsto_remove_nth {α : Type u_1} [topological_space α] {n : ℕ} {l : List α} :
    filter.tendsto (fun (l : List α) => remove_nth l n) (nhds l) (nhds (remove_nth l n)) :=
  sorry

theorem continuous_remove_nth {α : Type u_1} [topological_space α] {n : ℕ} :
    continuous fun (l : List α) => remove_nth l n :=
  iff.mpr continuous_iff_continuous_at fun (a : List α) => tendsto_remove_nth

theorem tendsto_sum {α : Type u_1} [topological_space α] [add_monoid α] [has_continuous_add α]
    {l : List α} : filter.tendsto sum (nhds l) (nhds (sum l)) :=
  sorry

theorem continuous_sum {α : Type u_1} [topological_space α] [add_monoid α] [has_continuous_add α] :
    continuous sum :=
  iff.mpr continuous_iff_continuous_at fun (l : List α) => tendsto_sum

end list

namespace vector

protected instance topological_space {α : Type u_1} [topological_space α] (n : ℕ) :
    topological_space (vector α n) :=
  eq.mpr sorry subtype.topological_space

theorem tendsto_cons {α : Type u_1} [topological_space α] {n : ℕ} {a : α} {l : vector α n} :
    filter.tendsto (fun (p : α × vector α n) => prod.fst p::ᵥprod.snd p)
        (filter.prod (nhds a) (nhds l)) (nhds (a::ᵥl)) :=
  sorry

theorem tendsto_insert_nth {α : Type u_1} [topological_space α] {n : ℕ} {i : fin (n + 1)} {a : α}
    {l : vector α n} :
    filter.tendsto (fun (p : α × vector α n) => insert_nth (prod.fst p) i (prod.snd p))
        (filter.prod (nhds a) (nhds l)) (nhds (insert_nth a i l)) :=
  sorry

theorem continuous_insert_nth' {α : Type u_1} [topological_space α] {n : ℕ} {i : fin (n + 1)} :
    continuous fun (p : α × vector α n) => insert_nth (prod.fst p) i (prod.snd p) :=
  sorry

theorem continuous_insert_nth {α : Type u_1} {β : Type u_2} [topological_space α]
    [topological_space β] {n : ℕ} {i : fin (n + 1)} {f : β → α} {g : β → vector α n}
    (hf : continuous f) (hg : continuous g) : continuous fun (b : β) => insert_nth (f b) i (g b) :=
  continuous.comp continuous_insert_nth' (continuous.prod_mk hf hg)

theorem continuous_at_remove_nth {α : Type u_1} [topological_space α] {n : ℕ} {i : fin (n + 1)}
    {l : vector α (n + 1)} : continuous_at (remove_nth i) l :=
  sorry

--  ∀{l:vector α (n+1)}, tendsto (remove_nth i) (𝓝 l) (𝓝 (remove_nth i l))

--| ⟨l, hl⟩ :=

theorem continuous_remove_nth {α : Type u_1} [topological_space α] {n : ℕ} {i : fin (n + 1)} :
    continuous (remove_nth i) :=
  sorry

end Mathlib


import divisibility1
import data.nat.prime
import data.int.gcd
import data.nat.modeq
import data.int.modeq
import data.zmod.basic

lemma int_dvd_cancel ( a b c: ℤ ) (h: int.gcd a b =1): a ∣ b*c → a ∣ c:=
begin
    intro h1, rw ← int.nat_abs_dvd_abs_iff at *, rw int.nat_abs_mul at h1, apply nat.coprime.dvd_of_dvd_mul_left, apply h, assumption,
end

lemma luc_cancel_2 (k: ℕ ) (b: ℤ) (x: 2 ∣ k)  (x1: k%3 ≠ 0 ): (luc (k): ℤ ) ∣ 2* b → (luc k :ℤ) ∣ b:=
begin
    have h1: nat.coprime (luc k) 2,
    {apply nat.coprime.symm, rw nat.prime.coprime_iff_not_dvd,
        {rw nat.dvd_iff_mod_eq_zero, rw luc_even, assumption},
        {exact nat.prime_two}},
    {apply int_dvd_cancel, assumption}
end

lemma fib_2k (k: ℕ ): fib(2*k) = fib k * luc k:=
begin
    have h1: 2* fib (2*k) = 2*(fib k * luc k),
    {rw [show 2*k =k+k, by ring], rw fib_luc1, ring},
    {linarith}
end

lemma even_or_odd (n: ℕ ): ∃ (w: ℕ ), n=2*w ∨ n=2*w+1:=
begin
    induction n with d hd,
    {use 0, simp},
    {cases hd with w hd, cases hd with hx hy,
    {use w, right, simp *},
    {use (w+1), left, rw hy, ring}}
end

lemma neg_1_pow_even (k: ℕ ) (h: 2 ∣ k): (-1: ℤ )^k=1:=
begin
    cases h with u v, rw v, rw pow_mul, simp
end

lemma neg_1_pow_odd (u: ℕ ) : (-1: ℤ )^(2*u+1)=-1:=
begin
    rw pow_add, rw neg_1_pow_even,
    {ring},
    {use u}
end

lemma luc_2k (k: ℕ )(h: 2 ∣ k) : (luc k)^2 = luc(2*k)+2:=
begin
    apply int.coe_nat_inj, push_cast, rw ← fib_luc3, rw neg_1_pow_even _ h, ring
end

lemma mod_luc (k: ℕ ) (h: 2 ∣ k ∧ (k%3) ≠ 0) : ∀ (m: ℕ), luc(k) ∣ luc(m+2*k) + luc(m):=
begin
    intro m, cases h with hx hy, rw ← int.coe_nat_dvd, apply luc_cancel_2 _ _ hx hy, norm_cast,
    rw mul_add, rw fib_luc2 m (2*k), nth_rewrite 3 mul_comm, rw add_assoc, rw ← add_mul,
    rw fib_2k, rw ← luc_2k _ hx, rw nat.pow_two, rw ← mul_assoc, nth_rewrite 3 mul_comm, rw ← mul_assoc, rw ← add_mul, simp
end

lemma mod_luc_sub (k m: ℕ ) (h1 : 2 ∣ k) (h2: (k%3)≠ 0) (h3: 2*k ≥ m):(luc k:ℤ ) ∣ (luc (2*k-m) + (-1: ℤ)^m * luc m:ℤ ):=
begin
    have h4: (luc k:ℤ ) ∣ 2*(luc (2*k-m) + (-1: ℤ)^m * luc m:ℤ ),
        {rw mul_add, rw fib_luc2_sub (2*k-m) m, rw nat.sub_add_cancel h3, rw fib_2k, rw add_assoc, nth_rewrite 7 mul_comm,
        nth_rewrite 3 mul_assoc, nth_rewrite 3 mul_assoc, rw ← mul_add, nth_rewrite 5 mul_comm, rw ← mul_add,
        norm_cast, rw ← luc_2k k h1,rw nat.pow_two, push_cast, use ((-1:ℤ)^(m+1)*5*fib k * fib m + (-1: ℤ )^m * luc m * luc k),ring},
    apply luc_cancel_2 _ _ h1 h2 h4
end

lemma mod_fun_gen (a k r s v: ℕ ) (f: ℕ → ℕ ) (h0: s≥ 1)(h: ∀ (m:ℕ ), (a: ℤ)  ∣ f(m+k) + (-1: ℤ )^r*f(m) ) :  (a: ℤ ) ∣ f(v+s*k) + (-1: ℤ )^(s*(r+1)-1)* f(v):=
begin
    have h3: ∃ (u:ℕ ), s=u+1,
    {use s-1, omega},
    cases h3 with u h3, rw h3, clear h0 h3 s, induction u with s hs,
    {simp * at *},
    {have h5:= h (v+(s+1)*k),
    have h6:= dvd_mul_of_dvd_right (hs) ((-1)^(r+1)),
    have h7:= dvd_add h5 h6,
    rw nat.succ_eq_add_one, cases h7 with x h8, use x, rw ← h8, rw add_mul, rw one_mul,
    rw eq_comm, rw add_assoc, conv_lhs{congr, skip, rw pow_add _ r 1, ring}, rw mul_assoc, rw ← pow_add, rw neg_eq_neg_one_mul, rw mul_left_comm,
    have h9: (-1:ℤ ) ^ ((s + 2) * (r + 1) -1) = (-1:ℤ ) * (-1) ^ ((s + 1) * (r + 1) - 1 + r),
        {nth_rewrite_rhs 0 [show (-1:ℤ ) = (-1)^1, from rfl], rw ← pow_add,
        have h10: (s + 2) * (r + 1) - 1 = 1 + ((s + 1) * (r + 1) - 1 + r),
            {apply int.coe_nat_inj, rw [show 2=1+1, from rfl], repeat {rw add_mul}, rw one_mul,push_cast, simp, ring},
        rw h10},
    rw h9,nth_rewrite 1 mul_comm,  rw add_assoc}
end

lemma mod_fib (k: ℕ ) (h: 2 ∣ k ∧ (k%3) ≠ 0) : ∀ (m:ℕ), luc(k) ∣ fib(m+2*k) + fib(m):=
begin
    intro m, cases h with hx hy, rw ← int.coe_nat_dvd, apply luc_cancel_2 _ _ hx hy, norm_cast,
    rw mul_add, rw fib_luc1 m (2*k), nth_rewrite 3 mul_comm, rw add_assoc, rw mul_comm k 2,
    rw fib_2k, nth_rewrite 1 add_comm, rw mul_comm, rw ← add_assoc, rw ← add_mul, rw ← luc_2k _ hx, rw nat.pow_two, use (luc k * fib m + luc m * (fib k)), ring
end

lemma mod_fib_sub (k m: ℕ ) (h1 : 2 ∣ k) (h2: (k%3)≠ 0) (h3: 2*k ≥ m):(luc k:ℤ ) ∣ (fib (2*k-m) + (-1: ℤ)^(m+1) * fib m:ℤ ):=
begin
    have h4: (luc k:ℤ ) ∣ 2*(fib (2*k-m) + (-1: ℤ)^(m+1) * fib m:ℤ ),
        {rw mul_add, rw fib_luc1_sub (2*k-m) m, rw nat.sub_add_cancel h3, rw fib_2k, rw add_assoc, nth_rewrite 6 mul_comm,
        nth_rewrite 1 mul_assoc, nth_rewrite 2 mul_assoc, rw ← mul_add, nth_rewrite 6 mul_comm, rw ← add_mul,
        norm_cast, rw ← luc_2k k h1,rw nat.pow_two, push_cast, use ((-1:ℤ)^(m)*fib k * luc m + (-1: ℤ )^(m+1) * luc k * fib m),ring},
    apply luc_cancel_2 _ _ h1 h2 h4
end

lemma luc_mod_8 (m : ℕ ): luc (m+12)%8  =luc m %8 :=
begin
    rw [show m+12=11+m+1, by ring],  rw fib_luc_rec_2,
    rw [show fib (11+1)=144, from rfl], rw [show fib 11=89, from rfl], rw nat.add_mod, rw nat.mul_mod,
    rw [show 144%8 =0, from rfl], nth_rewrite 1 nat.mul_mod, rw [show 89%8 =1, from rfl], simp
end

lemma luc_mod_8_gen (m:ℕ ): luc(m)%8 = luc(m%12)%8:=
begin
    cases div_algo m 12, rw h, clear h, rw add_comm, induction w with d hd,
    {simp},
    {rw nat.succ_eq_add_one, rw mul_add, rw← add_assoc, rw mul_one, rw luc_mod_8, rw hd, simp}
end


lemma and_or_distrib_left (P Q R : Prop) : P ∧ (Q ∨ R) ↔ (P ∧ Q) ∨ (P ∧ R) :=
begin
    split,
    intro fpqr,
    cases fpqr with p qr,
    cases qr with q r,
    have pq : P ∧ Q,
    split,
    exact p,
    exact q,
    left,
    exact pq,
    have pr : P ∧ R,
    split,
    exact p,
    exact r,
    right,
    exact pr,

    intro fpqpr,
    split,
    cases fpqpr with pq pr,
    cases pq with p q,
    exact p,
    cases pr with p r,
    exact p,
    cases fpqpr with pq pr,
    cases pq with p q,
    left,
    exact q,
    cases pr with p r,
    right,
    exact r,
end


/-
Exercise 1.
Try to prove that ¬ P ↔ (P → false) without using automation!

Here are some basic tactics that might help : http://wwwf.imperial.ac.uk/~buzzard/xena/html/source/tactics/guide.html
-/

example (P : Prop) : ¬ P ↔ (P → false) :=
begin
    sorry -- Replace the sorry with your proof!
end