/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Yaël Dillies
Ported by: Scott Morrison

! This file was ported from Lean 3 source module algebra.order.ring.defs
! leanprover-community/mathlib commit 655994e298904d7e5bbd1e18c95defd7b543eb94
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Order.Group.Defs
import Mathlib.Algebra.Order.Monoid.Cancel.Defs
import Mathlib.Algebra.Order.Monoid.Canonical.Defs
import Mathlib.Algebra.Order.Monoid.NatCast
import Mathlib.Algebra.Order.Monoid.WithZero.Defs
import Mathlib.Algebra.Order.Ring.Lemmas
import Mathlib.Algebra.Ring.Defs
import Mathlib.Order.MinMax
import Mathlib.Tactic.Nontriviality
import Mathlib.Data.Pi.Algebra
import Mathlib.Algebra.Group.Units

/-!
# Ordered rings and semirings

This file develops the basics of ordered (semi)rings.

Each typeclass here comprises
* an algebraic class (`Semiring`, `CommSemiring`, `Ring`, `CommRing`)
* an order class (`PartialOrder`, `LinearOrder`)
* assumptions on how both interact ((strict) monotonicity, canonicity)

For short,
* "`+` respects `≤`" means "monotonicity of addition"
* "`+` respects `<`" means "strict monotonicity of addition"
* "`*` respects `≤`" means "monotonicity of multiplication by a nonnegative number".
* "`*` respects `<`" means "strict monotonicity of multiplication by a positive number".

## Typeclasses

* `OrderedSemiring`: Semiring with a partial order such that `+` and `*` respect `≤`.
* `StrictOrderedSemiring`: Nontrivial semiring with a partial order such that `+` and `*` respects
  `<`.
* `OrderedCommSemiring`: Commutative semiring with a partial order such that `+` and `*` respect
  `≤`.
* `StrictOrderedCommSemiring`: Nontrivial commutative semiring with a partial order such that `+`
  and `*` respect `<`.
* `OrderedRing`: Ring with a partial order such that `+` respects `≤` and `*` respects `<`.
* `OrderedCommRing`: Commutative ring with a partial order such that `+` respects `≤` and
  `*` respects `<`.
* `LinearOrderedSemiring`: Nontrivial semiring with a linear order such that `+` respects `≤` and
  `*` respects `<`.
* `LinearOrderedCommSemiring`: Nontrivial commutative semiring with a linear order such that `+`
  respects `≤` and `*` respects `<`.
* `LinearOrderedRing`: Nontrivial ring with a linear order such that `+` respects `≤` and `*`
  respects `<`.
* `LinearOrderedCommRing`: Nontrivial commutative ring with a linear order such that `+` respects
  `≤` and `*` respects `<`.
* `CanonicallyOrderedCommSemiring`: Commutative semiring with a partial order such that `+`
  respects `≤`, `*` respects `<`, and `a ≤ b ↔ ∃ c, b = a + c`.

## Hierarchy

The hardest part of proving order lemmas might be to figure out the correct generality and its
corresponding typeclass. Here's an attempt at demystifying it. For each typeclass, we list its
immediate predecessors and what conditions are added to each of them.

* `OrderedSemiring`
  - `OrderedAddCommMonoid` & multiplication & `*` respects `≤`
  - `Semiring` & partial order structure & `+` respects `≤` & `*` respects `≤`
* `StrictOrderedSemiring`
  - `OrderedCancelAddCommMonoid` & multiplication & `*` respects `<` & nontriviality
  - `OrderedSemiring` & `+` respects `<` & `*` respects `<` & nontriviality
* `OrderedCommSemiring`
  - `OrderedSemiring` & commutativity of multiplication
  - `CommSemiring` & partial order structure & `+` respects `≤` & `*` respects `<`
* `StrictOrderedCommSemiring`
  - `StrictOrderedSemiring` & commutativity of multiplication
  - `OrderedCommSemiring` & `+` respects `<` & `*` respects `<` & nontriviality
* `OrderedRing`
  - `OrderedSemiring` & additive inverses
  - `OrderedAddCommGroup` & multiplication & `*` respects `<`
  - `Ring` & partial order structure & `+` respects `≤` & `*` respects `<`
* `StrictOrderedRing`
  - `StrictOrderedSemiring` & additive inverses
  - `OrderedSemiring` & `+` respects `<` & `*` respects `<` & nontriviality
* `OrderedCommRing`
  - `OrderedRing` & commutativity of multiplication
  - `OrderedCommSemiring` & additive inverses
  - `CommRing` & partial order structure & `+` respects `≤` & `*` respects `<`
* `StrictOrderedCommRing`
  - `StrictOrderedCommSemiring` & additive inverses
  - `StrictOrderedRing` & commutativity of multiplication
  - `OrderedCommRing` & `+` respects `<` & `*` respects `<` & nontriviality
* `LinearOrderedSemiring`
  - `StrictOrderedSemiring` & totality of the order
  - `LinearOrderedAddCommMonoid` & multiplication & nontriviality & `*` respects `<`
* `LinearOrderedCommSemiring`
  - `StrictOrderedCommSemiring` & totality of the order
  - `LinearOrderedSemiring` & commutativity of multiplication
* `LinearOrderedRing`
  - `StrictOrderedRing` & totality of the order
  - `LinearOrderedSemiring` & additive inverses
  - `LinearOrderedAddCommGroup` & multiplication & `*` respects `<`
  - `Domain` & linear order structure
* `LinearOrderedCommRing`
  - `StrictOrderedCommRing` & totality of the order
  - `LinearOrderedRing` & commutativity of multiplication
  - `LinearOrderedCommSemiring` & additive inverses
  - `IsDomain` & linear order structure

-/

open Function

universe u

variable {α : Type u} {β : Type _}

/-! Note that `OrderDual` does not satisfy any of the ordered ring typeclasses due to the
`zero_le_one` field. -/

theorem add_one_le_two_mul [LE α] [Semiring α] [CovariantClass α α (· + ·) (· ≤ ·)] {a : α}
    (a1 : 1 ≤ a) : a + 1 ≤ 2 * a :=
  calc
    a + 1 ≤ a + a := add_le_add_left a1 a
    _ = 2 * a := (two_mul _).symm

#align add_one_le_two_mul add_one_le_two_mul

/-- An `OrderedSemiring` is a semiring with a partial order such that addition is monotone and
multiplication by a nonnegative number is monotone. -/
class OrderedSemiring (α : Type u) extends Semiring α, OrderedAddCommMonoid α where
  /-- `0 ≤ 1` in any ordered semiring. -/
  protected zero_le_one : (0 : α) ≤ 1
  /-- In an ordered semiring, we can multiply an inequality `a ≤ b` on the left
  by a non-negative element `0 ≤ c` to obtain `c * a ≤ c * b`. -/
  protected mul_le_mul_of_nonneg_left : ∀ a b c : α, a ≤ b → 0 ≤ c → c * a ≤ c * b
  /-- In an ordered semiring, we can multiply an inequality `a ≤ b` on the right
  by a non-negative element `0 ≤ c` to obtain `a * c ≤ b * c`. -/
  protected mul_le_mul_of_nonneg_right : ∀ a b c : α, a ≤ b → 0 ≤ c → a * c ≤ b * c
#align ordered_semiring OrderedSemiring

/-- An `OrderedCommSemiring` is a commutative semiring with a partial order such that addition is
monotone and multiplication by a nonnegative number is monotone. -/
class OrderedCommSemiring (α : Type u) extends OrderedSemiring α, CommSemiring α
#align ordered_comm_semiring OrderedCommSemiring

/-- An `OrderedRing` is a ring with a partial order such that addition is monotone and
multiplication by a nonnegative number is monotone. -/
class OrderedRing (α : Type u) extends Ring α, OrderedAddCommGroup α where
  /-- `0 ≤ 1` in any ordered ring. -/
  protected zero_le_one : 0 ≤ (1 : α)
  /-- The product of non-negative elements is non-negative. -/
  protected mul_nonneg : ∀ a b : α, 0 ≤ a → 0 ≤ b → 0 ≤ a * b
#align ordered_ring OrderedRing

/-- An `OrderedCommRing` is a commutative ring with a partial order such that addition is monotone
and multiplication by a nonnegative number is monotone. -/
class OrderedCommRing (α : Type u) extends OrderedRing α, CommRing α
#align ordered_comm_ring OrderedCommRing

/-- A `StrictOrderedSemiring` is a nontrivial semiring with a partial order such that addition is
strictly monotone and multiplication by a positive number is strictly monotone. -/
class StrictOrderedSemiring (α : Type u) extends Semiring α, OrderedCancelAddCommMonoid α,
    Nontrivial α where
  /-- In a strict ordered semiring, `0 ≤ 1`. -/
  protected zero_le_one : (0 : α) ≤ 1
  /-- Left multiplication by a positive element is strictly monotone. -/
  protected mul_lt_mul_of_pos_left : ∀ a b c : α, a < b → 0 < c → c * a < c * b
  /-- Right multiplication by a positive element is strictly monotone. -/
  protected mul_lt_mul_of_pos_right : ∀ a b c : α, a < b → 0 < c → a * c < b * c
#align strict_ordered_semiring StrictOrderedSemiring

/-- A `StrictOrderedCommSemiring` is a commutative semiring with a partial order such that
addition is strictly monotone and multiplication by a positive number is strictly monotone. -/
class StrictOrderedCommSemiring (α : Type u) extends StrictOrderedSemiring α, CommSemiring α
#align strict_ordered_comm_semiring StrictOrderedCommSemiring

/-- A `StrictOrderedRing` is a ring with a partial order such that addition is strictly monotone
and multiplication by a positive number is strictly monotone. -/
class StrictOrderedRing (α : Type u) extends Ring α, OrderedAddCommGroup α, Nontrivial α where
  /-- In a strict ordered ring, `0 ≤ 1`. -/
  protected zero_le_one : 0 ≤ (1 : α)
  /-- The product of two positive elements is positive. -/
  protected mul_pos : ∀ a b : α, 0 < a → 0 < b → 0 < a * b
#align strict_ordered_ring StrictOrderedRing

/-- A `StrictOrderedCommRing` is a commutative ring with a partial order such that addition is
strictly monotone and multiplication by a positive number is strictly monotone. -/
class StrictOrderedCommRing (α : Type _) extends StrictOrderedRing α, CommRing α
#align strict_ordered_comm_ring StrictOrderedCommRing

/- It's not entirely clear we should assume `Nontrivial` at this point; it would be reasonable to
explore changing this, but be warned that the instances involving `Domain` may cause typeclass
search loops. -/
/-- A `LinearOrderedSemiring` is a nontrivial semiring with a linear order such that
addition is monotone and multiplication by a positive number is strictly monotone. -/
class LinearOrderedSemiring (α : Type u) extends StrictOrderedSemiring α,
  LinearOrderedAddCommMonoid α
#align linear_ordered_semiring LinearOrderedSemiring

/-- A `LinearOrderedCommSemiring` is a nontrivial commutative semiring with a linear order such
that addition is monotone and multiplication by a positive number is strictly monotone. -/
class LinearOrderedCommSemiring (α : Type _) extends StrictOrderedCommSemiring α,
  LinearOrderedSemiring α
#align linear_ordered_comm_semiring LinearOrderedCommSemiring

/-- A `LinearOrderedRing` is a ring with a linear order such that addition is monotone and
multiplication by a positive number is strictly monotone. -/
class LinearOrderedRing (α : Type u) extends StrictOrderedRing α, LinearOrder α
#align linear_ordered_ring LinearOrderedRing

/-- A `LinearOrderedCommRing` is a commutative ring with a linear order such that addition is
monotone and multiplication by a positive number is strictly monotone. -/
class LinearOrderedCommRing (α : Type u) extends LinearOrderedRing α, CommMonoid α
#align linear_ordered_comm_ring LinearOrderedCommRing

section OrderedSemiring

variable [OrderedSemiring α] {a b c d : α}

-- see Note [lower instance priority]
instance (priority := 100) OrderedSemiring.zeroLEOneClass : ZeroLEOneClass α :=
  { ‹OrderedSemiring α› with }
#align ordered_semiring.zero_le_one_class OrderedSemiring.zeroLEOneClass

-- see Note [lower instance priority]
instance (priority := 200) OrderedSemiring.toPosMulMono : PosMulMono α :=
  ⟨fun x _ _ h => OrderedSemiring.mul_le_mul_of_nonneg_left _ _ _ h x.2⟩
#align ordered_semiring.to_pos_mul_mono OrderedSemiring.toPosMulMono

-- see Note [lower instance priority]
instance (priority := 200) OrderedSemiring.toMulPosMono : MulPosMono α :=
  ⟨fun x _ _ h => OrderedSemiring.mul_le_mul_of_nonneg_right _ _ _ h x.2⟩
#align ordered_semiring.to_mul_pos_mono OrderedSemiring.toMulPosMono

set_option linter.deprecated false in
theorem bit1_mono : Monotone (bit1 : α → α) := fun _ _ h => add_le_add_right (bit0_mono h) _
#align bit1_mono bit1_mono

@[simp]
theorem pow_nonneg (H : 0 ≤ a) : ∀ n : ℕ, 0 ≤ a ^ n
  | 0 => by
    rw [pow_zero]
    exact zero_le_one
  | n + 1 => by
    rw [pow_succ]
    exact mul_nonneg H (pow_nonneg H _)
#align pow_nonneg pow_nonneg

-- Porting note: it's unfortunate we need to write `(@one_le_two α)` here.
theorem add_le_mul_two_add (a2 : 2 ≤ a) (b0 : 0 ≤ b) : a + (2 + b) ≤ a * (2 + b) :=
  calc
    a + (2 + b) ≤ a + (a + a * b) :=
      add_le_add_left (add_le_add a2 <| le_mul_of_one_le_left b0 <| (@one_le_two α).trans a2) a
    _ ≤ a * (2 + b) := by rw [mul_add, mul_two, add_assoc]

#align add_le_mul_two_add add_le_mul_two_add

theorem one_le_mul_of_one_le_of_one_le (ha : 1 ≤ a) (hb : 1 ≤ b) : (1 : α) ≤ a * b :=
  Left.one_le_mul_of_le_of_le ha hb <| zero_le_one.trans ha
#align one_le_mul_of_one_le_of_one_le one_le_mul_of_one_le_of_one_le

section Monotone

variable [Preorder β] {f g : β → α}

theorem monotone_mul_left_of_nonneg (ha : 0 ≤ a) : Monotone fun x => a * x := fun _ _ h =>
  mul_le_mul_of_nonneg_left h ha
#align monotone_mul_left_of_nonneg monotone_mul_left_of_nonneg

theorem monotone_mul_right_of_nonneg (ha : 0 ≤ a) : Monotone fun x => x * a := fun _ _ h =>
  mul_le_mul_of_nonneg_right h ha
#align monotone_mul_right_of_nonneg monotone_mul_right_of_nonneg

theorem Monotone.mul_const (hf : Monotone f) (ha : 0 ≤ a) : Monotone fun x => f x * a :=
  (monotone_mul_right_of_nonneg ha).comp hf
#align monotone.mul_const Monotone.mul_const

theorem Monotone.const_mul (hf : Monotone f) (ha : 0 ≤ a) : Monotone fun x => a * f x :=
  (monotone_mul_left_of_nonneg ha).comp hf
#align monotone.const_mul Monotone.const_mul

theorem Antitone.mul_const (hf : Antitone f) (ha : 0 ≤ a) : Antitone fun x => f x * a :=
  (monotone_mul_right_of_nonneg ha).comp_antitone hf
#align antitone.mul_const Antitone.mul_const

theorem Antitone.const_mul (hf : Antitone f) (ha : 0 ≤ a) : Antitone fun x => a * f x :=
  (monotone_mul_left_of_nonneg ha).comp_antitone hf
#align antitone.const_mul Antitone.const_mul

theorem Monotone.mul (hf : Monotone f) (hg : Monotone g) (hf₀ : ∀ x, 0 ≤ f x) (hg₀ : ∀ x, 0 ≤ g x) :
    Monotone (f * g) := fun _ _ h => mul_le_mul (hf h) (hg h) (hg₀ _) (hf₀ _)
#align monotone.mul Monotone.mul

end Monotone

section
set_option linter.deprecated false

theorem bit1_pos [Nontrivial α] (h : 0 ≤ a) : 0 < bit1 a :=
  zero_lt_one.trans_le <| bit1_zero.symm.trans_le <| bit1_mono h
#align bit1_pos bit1_pos

theorem bit1_pos' (h : 0 < a) : 0 < bit1 a := by
  nontriviality
  exact bit1_pos h.le
#align bit1_pos' bit1_pos'

end

theorem mul_le_one (ha : a ≤ 1) (hb' : 0 ≤ b) (hb : b ≤ 1) : a * b ≤ 1 :=
  one_mul (1 : α) ▸ mul_le_mul ha hb hb' zero_le_one
#align mul_le_one mul_le_one

theorem one_lt_mul_of_le_of_lt (ha : 1 ≤ a) (hb : 1 < b) : 1 < a * b :=
  hb.trans_le <| le_mul_of_one_le_left (zero_le_one.trans hb.le) ha
#align one_lt_mul_of_le_of_lt one_lt_mul_of_le_of_lt

theorem one_lt_mul_of_lt_of_le (ha : 1 < a) (hb : 1 ≤ b) : 1 < a * b :=
  ha.trans_le <| le_mul_of_one_le_right (zero_le_one.trans ha.le) hb
#align one_lt_mul_of_lt_of_le one_lt_mul_of_lt_of_le

alias one_lt_mul_of_le_of_lt ← one_lt_mul
#align one_lt_mul one_lt_mul

theorem mul_lt_one_of_nonneg_of_lt_one_left (ha₀ : 0 ≤ a) (ha : a < 1) (hb : b ≤ 1) : a * b < 1 :=
  (mul_le_of_le_one_right ha₀ hb).trans_lt ha
#align mul_lt_one_of_nonneg_of_lt_one_left mul_lt_one_of_nonneg_of_lt_one_left

theorem mul_lt_one_of_nonneg_of_lt_one_right (ha : a ≤ 1) (hb₀ : 0 ≤ b) (hb : b < 1) : a * b < 1 :=
  (mul_le_of_le_one_left hb₀ ha).trans_lt hb
#align mul_lt_one_of_nonneg_of_lt_one_right mul_lt_one_of_nonneg_of_lt_one_right

end OrderedSemiring

section OrderedRing

variable [OrderedRing α] {a b c d : α}

-- see Note [lower instance priority]
instance (priority := 100) OrderedRing.toOrderedSemiring : OrderedSemiring α :=
  { ‹OrderedRing α›, (Ring.toSemiring : Semiring α) with
    mul_le_mul_of_nonneg_left := fun a b c h hc => by
      simpa only [mul_sub, sub_nonneg] using OrderedRing.mul_nonneg _ _ hc (sub_nonneg.2 h),
    mul_le_mul_of_nonneg_right := fun a b c h hc => by
      simpa only [sub_mul, sub_nonneg] using OrderedRing.mul_nonneg _ _ (sub_nonneg.2 h) hc }
#align ordered_ring.to_ordered_semiring OrderedRing.toOrderedSemiring

theorem mul_le_mul_of_nonpos_left (h : b ≤ a) (hc : c ≤ 0) : c * a ≤ c * b := by
  simpa only [neg_mul, neg_le_neg_iff] using mul_le_mul_of_nonneg_left h (neg_nonneg.2 hc)
#align mul_le_mul_of_nonpos_left mul_le_mul_of_nonpos_left

theorem mul_le_mul_of_nonpos_right (h : b ≤ a) (hc : c ≤ 0) : a * c ≤ b * c := by
  simpa only [mul_neg, neg_le_neg_iff] using mul_le_mul_of_nonneg_right h (neg_nonneg.2 hc)
#align mul_le_mul_of_nonpos_right mul_le_mul_of_nonpos_right

theorem mul_nonneg_of_nonpos_of_nonpos (ha : a ≤ 0) (hb : b ≤ 0) : 0 ≤ a * b := by
  simpa only [zero_mul] using mul_le_mul_of_nonpos_right ha hb
#align mul_nonneg_of_nonpos_of_nonpos mul_nonneg_of_nonpos_of_nonpos

theorem mul_le_mul_of_nonneg_of_nonpos (hca : c ≤ a) (hbd : b ≤ d) (hc : 0 ≤ c) (hb : b ≤ 0) :
    a * b ≤ c * d :=
  (mul_le_mul_of_nonpos_right hca hb).trans <| mul_le_mul_of_nonneg_left hbd hc
#align mul_le_mul_of_nonneg_of_nonpos mul_le_mul_of_nonneg_of_nonpos

theorem mul_le_mul_of_nonneg_of_nonpos' (hca : c ≤ a) (hbd : b ≤ d) (ha : 0 ≤ a) (hd : d ≤ 0) :
    a * b ≤ c * d :=
  (mul_le_mul_of_nonneg_left hbd ha).trans <| mul_le_mul_of_nonpos_right hca hd
#align mul_le_mul_of_nonneg_of_nonpos' mul_le_mul_of_nonneg_of_nonpos'

theorem mul_le_mul_of_nonpos_of_nonneg (hac : a ≤ c) (hdb : d ≤ b) (hc : c ≤ 0) (hb : 0 ≤ b) :
    a * b ≤ c * d :=
  (mul_le_mul_of_nonneg_right hac hb).trans <| mul_le_mul_of_nonpos_left hdb hc
#align mul_le_mul_of_nonpos_of_nonneg mul_le_mul_of_nonpos_of_nonneg

theorem mul_le_mul_of_nonpos_of_nonneg' (hca : c ≤ a) (hbd : b ≤ d) (ha : 0 ≤ a) (hd : d ≤ 0) :
    a * b ≤ c * d :=
  (mul_le_mul_of_nonneg_left hbd ha).trans <| mul_le_mul_of_nonpos_right hca hd
#align mul_le_mul_of_nonpos_of_nonneg' mul_le_mul_of_nonpos_of_nonneg'

theorem mul_le_mul_of_nonpos_of_nonpos (hca : c ≤ a) (hdb : d ≤ b) (hc : c ≤ 0) (hb : b ≤ 0) :
    a * b ≤ c * d :=
  (mul_le_mul_of_nonpos_right hca hb).trans <| mul_le_mul_of_nonpos_left hdb hc
#align mul_le_mul_of_nonpos_of_nonpos mul_le_mul_of_nonpos_of_nonpos

theorem mul_le_mul_of_nonpos_of_nonpos' (hca : c ≤ a) (hdb : d ≤ b) (ha : a ≤ 0) (hd : d ≤ 0) :
    a * b ≤ c * d :=
  (mul_le_mul_of_nonpos_left hdb ha).trans <| mul_le_mul_of_nonpos_right hca hd
#align mul_le_mul_of_nonpos_of_nonpos' mul_le_mul_of_nonpos_of_nonpos'

section Monotone

variable [Preorder β] {f g : β → α}

theorem antitone_mul_left {a : α} (ha : a ≤ 0) : Antitone ((· * ·) a) := fun _ _ b_le_c =>
  mul_le_mul_of_nonpos_left b_le_c ha
#align antitone_mul_left antitone_mul_left

theorem antitone_mul_right {a : α} (ha : a ≤ 0) : Antitone fun x => x * a := fun _ _ b_le_c =>
  mul_le_mul_of_nonpos_right b_le_c ha
#align antitone_mul_right antitone_mul_right

theorem Monotone.const_mul_of_nonpos (hf : Monotone f) (ha : a ≤ 0) : Antitone fun x => a * f x :=
  (antitone_mul_left ha).comp_monotone hf
#align monotone.const_mul_of_nonpos Monotone.const_mul_of_nonpos

theorem Monotone.mul_const_of_nonpos (hf : Monotone f) (ha : a ≤ 0) : Antitone fun x => f x * a :=
  (antitone_mul_right ha).comp_monotone hf
#align monotone.mul_const_of_nonpos Monotone.mul_const_of_nonpos

theorem Antitone.const_mul_of_nonpos (hf : Antitone f) (ha : a ≤ 0) : Monotone fun x => a * f x :=
  (antitone_mul_left ha).comp hf
#align antitone.const_mul_of_nonpos Antitone.const_mul_of_nonpos

theorem Antitone.mul_const_of_nonpos (hf : Antitone f) (ha : a ≤ 0) : Monotone fun x => f x * a :=
  (antitone_mul_right ha).comp hf
#align antitone.mul_const_of_nonpos Antitone.mul_const_of_nonpos

theorem Antitone.mul_monotone (hf : Antitone f) (hg : Monotone g) (hf₀ : ∀ x, f x ≤ 0)
    (hg₀ : ∀ x, 0 ≤ g x) : Antitone (f * g) := fun _ _ h =>
  mul_le_mul_of_nonpos_of_nonneg (hf h) (hg h) (hf₀ _) (hg₀ _)
#align antitone.mul_monotone Antitone.mul_monotone

theorem Monotone.mul_antitone (hf : Monotone f) (hg : Antitone g) (hf₀ : ∀ x, 0 ≤ f x)
    (hg₀ : ∀ x, g x ≤ 0) : Antitone (f * g) := fun _ _ h =>
  mul_le_mul_of_nonneg_of_nonpos (hf h) (hg h) (hf₀ _) (hg₀ _)
#align monotone.mul_antitone Monotone.mul_antitone

theorem Antitone.mul (hf : Antitone f) (hg : Antitone g) (hf₀ : ∀ x, f x ≤ 0) (hg₀ : ∀ x, g x ≤ 0) :
    Monotone (f * g) := fun _ _ h => mul_le_mul_of_nonpos_of_nonpos (hf h) (hg h) (hf₀ _) (hg₀ _)
#align antitone.mul Antitone.mul

end Monotone

theorem le_iff_exists_nonneg_add (a b : α) : a ≤ b ↔ ∃ c ≥ 0, b = a + c :=
  ⟨fun h => ⟨b - a, sub_nonneg.mpr h, by simp⟩, fun ⟨c, hc, h⟩ => by
    rw [h, le_add_iff_nonneg_right]
    exact hc⟩
#align le_iff_exists_nonneg_add le_iff_exists_nonneg_add

end OrderedRing

section OrderedCommRing

variable [OrderedCommRing α]

-- See note [lower instance priority]
instance (priority := 100) OrderedCommRing.toOrderedCommSemiring : OrderedCommSemiring α :=
  { OrderedRing.toOrderedSemiring, ‹OrderedCommRing α› with }
#align ordered_comm_ring.to_ordered_comm_semiring OrderedCommRing.toOrderedCommSemiring

end OrderedCommRing

section StrictOrderedSemiring

variable [StrictOrderedSemiring α] {a b c d : α}

-- see Note [lower instance priority]
instance (priority := 200) StrictOrderedSemiring.toPosMulStrictMono : PosMulStrictMono α :=
  ⟨fun x _ _ h => StrictOrderedSemiring.mul_lt_mul_of_pos_left _ _ _ h x.prop⟩
#align strict_ordered_semiring.to_pos_mul_strict_mono StrictOrderedSemiring.toPosMulStrictMono

-- see Note [lower instance priority]
instance (priority := 200) StrictOrderedSemiring.toMulPosStrictMono : MulPosStrictMono α :=
  ⟨fun x _ _ h => StrictOrderedSemiring.mul_lt_mul_of_pos_right _ _ _ h x.prop⟩
#align strict_ordered_semiring.to_mul_pos_strict_mono StrictOrderedSemiring.toMulPosStrictMono

-- See note [reducible non-instances]
/-- A choice-free version of `StrictOrderedSemiring.toOrderedSemiring` to avoid using choice in
basic `Nat` lemmas. -/
@[reducible]
def StrictOrderedSemiring.toOrderedSemiring' [@DecidableRel α (· ≤ ·)] : OrderedSemiring α :=
  { ‹StrictOrderedSemiring α› with
    mul_le_mul_of_nonneg_left := fun a b c hab hc => by
      obtain rfl | hab := Decidable.eq_or_lt_of_le hab
      · rfl
      obtain rfl | hc := Decidable.eq_or_lt_of_le hc
      · simp
      · exact (mul_lt_mul_of_pos_left hab hc).le,
    mul_le_mul_of_nonneg_right := fun a b c hab hc => by
      obtain rfl | hab := Decidable.eq_or_lt_of_le hab
      · rfl
      obtain rfl | hc := Decidable.eq_or_lt_of_le hc
      · simp
      · exact (mul_lt_mul_of_pos_right hab hc).le }
#align strict_ordered_semiring.to_ordered_semiring' StrictOrderedSemiring.toOrderedSemiring'

-- see Note [lower instance priority]
instance (priority := 100) StrictOrderedSemiring.toOrderedSemiring : OrderedSemiring α :=
  { ‹StrictOrderedSemiring α› with
    mul_le_mul_of_nonneg_left := fun _ _ _ =>
      letI := @StrictOrderedSemiring.toOrderedSemiring' α _ (Classical.decRel _)
      mul_le_mul_of_nonneg_left,
    mul_le_mul_of_nonneg_right := fun _ _ _ =>
      letI := @StrictOrderedSemiring.toOrderedSemiring' α _ (Classical.decRel _)
      mul_le_mul_of_nonneg_right }
#align strict_ordered_semiring.to_ordered_semiring StrictOrderedSemiring.toOrderedSemiring

theorem mul_lt_mul (hac : a < c) (hbd : b ≤ d) (hb : 0 < b) (hc : 0 ≤ c) : a * b < c * d :=
  (mul_lt_mul_of_pos_right hac hb).trans_le <| mul_le_mul_of_nonneg_left hbd hc
#align mul_lt_mul mul_lt_mul

theorem mul_lt_mul' (hac : a ≤ c) (hbd : b < d) (hb : 0 ≤ b) (hc : 0 < c) : a * b < c * d :=
  (mul_le_mul_of_nonneg_right hac hb).trans_lt <| mul_lt_mul_of_pos_left hbd hc
#align mul_lt_mul' mul_lt_mul'

@[simp]
theorem pow_pos (H : 0 < a) : ∀ n : ℕ, 0 < a ^ n
  | 0 => by
    nontriviality
    rw [pow_zero]
    exact zero_lt_one
  | n + 1 => by
    rw [pow_succ]
    exact mul_pos H (pow_pos H _)
#align pow_pos pow_pos

theorem mul_self_lt_mul_self (h1 : 0 ≤ a) (h2 : a < b) : a * a < b * b :=
  mul_lt_mul' h2.le h2 h1 <| h1.trans_lt h2
#align mul_self_lt_mul_self mul_self_lt_mul_self

-- In the next lemma, we used to write `Set.Ici 0` instead of `{x | 0 ≤ x}`.
-- As this lemma is not used outside this file,
-- and the import for `Set.Ici` is not otherwise needed until later,
-- we choose not to use it here.
theorem strictMonoOn_mul_self : StrictMonoOn (fun x : α => x * x) { x | 0 ≤ x } :=
  fun _ hx _ _ hxy => mul_self_lt_mul_self hx hxy
#align strict_mono_on_mul_self strictMonoOn_mul_self

-- See Note [decidable namespace]
protected theorem Decidable.mul_lt_mul'' [@DecidableRel α (· ≤ ·)] (h1 : a < c) (h2 : b < d)
    (h3 : 0 ≤ a) (h4 : 0 ≤ b) : a * b < c * d :=
  h4.lt_or_eq_dec.elim (fun b0 => mul_lt_mul h1 h2.le b0 <| h3.trans h1.le) fun b0 => by
    rw [← b0, mul_zero]; exact mul_pos (h3.trans_lt h1) (h4.trans_lt h2)
#align decidable.mul_lt_mul'' Decidable.mul_lt_mul''

theorem mul_lt_mul'' : a < c → b < d → 0 ≤ a → 0 ≤ b → a * b < c * d := by classical
  exact Decidable.mul_lt_mul''
#align mul_lt_mul'' mul_lt_mul''

theorem lt_mul_left (hn : 0 < a) (hm : 1 < b) : a < b * a := by
  convert mul_lt_mul_of_pos_right hm hn
  rw [one_mul]
#align lt_mul_left lt_mul_left

theorem lt_mul_right (hn : 0 < a) (hm : 1 < b) : a < a * b := by
  convert mul_lt_mul_of_pos_left hm hn
  rw [mul_one]
#align lt_mul_right lt_mul_right

theorem lt_mul_self (hn : 1 < a) : a < a * a :=
  lt_mul_left (hn.trans_le' zero_le_one) hn
#align lt_mul_self lt_mul_self

section Monotone

variable [Preorder β] {f g : β → α}

theorem strictMono_mul_left_of_pos (ha : 0 < a) : StrictMono fun x => a * x := fun _ _ b_lt_c =>
  mul_lt_mul_of_pos_left b_lt_c ha
#align strict_mono_mul_left_of_pos strictMono_mul_left_of_pos

theorem strictMono_mul_right_of_pos (ha : 0 < a) : StrictMono fun x => x * a := fun _ _ b_lt_c =>
  mul_lt_mul_of_pos_right b_lt_c ha
#align strict_mono_mul_right_of_pos strictMono_mul_right_of_pos

theorem StrictMono.mul_const (hf : StrictMono f) (ha : 0 < a) : StrictMono fun x => f x * a :=
  (strictMono_mul_right_of_pos ha).comp hf
#align strict_mono.mul_const StrictMono.mul_const

theorem StrictMono.const_mul (hf : StrictMono f) (ha : 0 < a) : StrictMono fun x => a * f x :=
  (strictMono_mul_left_of_pos ha).comp hf
#align strict_mono.const_mul StrictMono.const_mul

theorem StrictAnti.mul_const (hf : StrictAnti f) (ha : 0 < a) : StrictAnti fun x => f x * a :=
  (strictMono_mul_right_of_pos ha).comp_strictAnti hf
#align strict_anti.mul_const StrictAnti.mul_const

theorem StrictAnti.const_mul (hf : StrictAnti f) (ha : 0 < a) : StrictAnti fun x => a * f x :=
  (strictMono_mul_left_of_pos ha).comp_strictAnti hf
#align strict_anti.const_mul StrictAnti.const_mul

theorem StrictMono.mul_monotone (hf : StrictMono f) (hg : Monotone g) (hf₀ : ∀ x, 0 ≤ f x)
    (hg₀ : ∀ x, 0 < g x) : StrictMono (f * g) := fun _ _ h =>
  mul_lt_mul (hf h) (hg h.le) (hg₀ _) (hf₀ _)
#align strict_mono.mul_monotone StrictMono.mul_monotone

theorem Monotone.mul_strictMono (hf : Monotone f) (hg : StrictMono g) (hf₀ : ∀ x, 0 < f x)
    (hg₀ : ∀ x, 0 ≤ g x) : StrictMono (f * g) := fun _ _ h =>
  mul_lt_mul' (hf h.le) (hg h) (hg₀ _) (hf₀ _)
#align monotone.mul_strict_mono Monotone.mul_strictMono

theorem StrictMono.mul (hf : StrictMono f) (hg : StrictMono g) (hf₀ : ∀ x, 0 ≤ f x)
    (hg₀ : ∀ x, 0 ≤ g x) : StrictMono (f * g) := fun _ _ h =>
  mul_lt_mul'' (hf h) (hg h) (hf₀ _) (hg₀ _)
#align strict_mono.mul StrictMono.mul

end Monotone

theorem lt_two_mul_self (ha : 0 < a) : a < 2 * a :=
  lt_mul_of_one_lt_left ha one_lt_two
#align lt_two_mul_self lt_two_mul_self

-- see Note [lower instance priority]
instance (priority := 100) StrictOrderedSemiring.toNoMaxOrder : NoMaxOrder α :=
  ⟨fun a => ⟨a + 1, lt_add_of_pos_right _ one_pos⟩⟩
#align strict_ordered_semiring.to_no_max_order StrictOrderedSemiring.toNoMaxOrder

end StrictOrderedSemiring

section StrictOrderedCommSemiring

variable [StrictOrderedCommSemiring α]

-- See note [reducible non-instances]
/-- A choice-free version of `StrictOrderedCommSemiring.toOrderedCommSemiring'` to avoid using
choice in basic `Nat` lemmas. -/
@[reducible]
def StrictOrderedCommSemiring.toOrderedCommSemiring' [@DecidableRel α (· ≤ ·)] :
    OrderedCommSemiring α :=
  { ‹StrictOrderedCommSemiring α›, StrictOrderedSemiring.toOrderedSemiring' with }
#align strict_ordered_comm_semiring.to_ordered_comm_semiring' StrictOrderedCommSemiring.toOrderedCommSemiring'

-- see Note [lower instance priority]
instance (priority := 100) StrictOrderedCommSemiring.toOrderedCommSemiring :
    OrderedCommSemiring α :=
  { ‹StrictOrderedCommSemiring α›, StrictOrderedSemiring.toOrderedSemiring with }
#align strict_ordered_comm_semiring.to_ordered_comm_semiring StrictOrderedCommSemiring.toOrderedCommSemiring

end StrictOrderedCommSemiring

section StrictOrderedRing

variable [StrictOrderedRing α] {a b c : α}

-- see Note [lower instance priority]
instance (priority := 100) StrictOrderedRing.toStrictOrderedSemiring : StrictOrderedSemiring α :=
  { ‹StrictOrderedRing α›, (Ring.toSemiring : Semiring α) with
    le_of_add_le_add_left := @le_of_add_le_add_left α _ _ _,
    mul_lt_mul_of_pos_left := fun a b c h hc => by
      simpa only [mul_sub, sub_pos] using StrictOrderedRing.mul_pos _ _ hc (sub_pos.2 h),
    mul_lt_mul_of_pos_right := fun a b c h hc => by
      simpa only [sub_mul, sub_pos] using StrictOrderedRing.mul_pos _ _ (sub_pos.2 h) hc }
#align strict_ordered_ring.to_strict_ordered_semiring StrictOrderedRing.toStrictOrderedSemiring

-- See note [reducible non-instances]
/-- A choice-free version of `StrictOrderedRing.toOrderedRing` to avoid using choice in basic
`Int` lemmas. -/
@[reducible]
def StrictOrderedRing.toOrderedRing' [@DecidableRel α (· ≤ ·)] : OrderedRing α :=
  { ‹StrictOrderedRing α›, (Ring.toSemiring : Semiring α) with
    mul_nonneg := fun a b ha hb => by
      obtain ha | ha := Decidable.eq_or_lt_of_le ha
      · rw [← ha, zero_mul]
      obtain hb | hb := Decidable.eq_or_lt_of_le hb
      · rw [← hb, mul_zero]
      · exact (StrictOrderedRing.mul_pos _ _ ha hb).le }
#align strict_ordered_ring.to_ordered_ring' StrictOrderedRing.toOrderedRing'

-- see Note [lower instance priority]
instance (priority := 100) StrictOrderedRing.toOrderedRing : OrderedRing α :=
  { ‹StrictOrderedRing α› with
    mul_nonneg := fun a b =>
      letI := @StrictOrderedRing.toOrderedRing' α _ (Classical.decRel _)
      mul_nonneg }
#align strict_ordered_ring.to_ordered_ring StrictOrderedRing.toOrderedRing

theorem mul_lt_mul_of_neg_left (h : b < a) (hc : c < 0) : c * a < c * b := by
  simpa only [neg_mul, neg_lt_neg_iff] using mul_lt_mul_of_pos_left h (neg_pos_of_neg hc)
#align mul_lt_mul_of_neg_left mul_lt_mul_of_neg_left

theorem mul_lt_mul_of_neg_right (h : b < a) (hc : c < 0) : a * c < b * c := by
  simpa only [mul_neg, neg_lt_neg_iff] using mul_lt_mul_of_pos_right h (neg_pos_of_neg hc)
#align mul_lt_mul_of_neg_right mul_lt_mul_of_neg_right

theorem mul_pos_of_neg_of_neg {a b : α} (ha : a < 0) (hb : b < 0) : 0 < a * b := by
  simpa only [zero_mul] using mul_lt_mul_of_neg_right ha hb
#align mul_pos_of_neg_of_neg mul_pos_of_neg_of_neg

section Monotone

variable [Preorder β] {f g : β → α}

theorem strictAnti_mul_left {a : α} (ha : a < 0) : StrictAnti ((· * ·) a) := fun _ _ b_lt_c =>
  mul_lt_mul_of_neg_left b_lt_c ha
#align strict_anti_mul_left strictAnti_mul_left

theorem strictAnti_mul_right {a : α} (ha : a < 0) : StrictAnti fun x => x * a := fun _ _ b_lt_c =>
  mul_lt_mul_of_neg_right b_lt_c ha
#align strict_anti_mul_right strictAnti_mul_right

theorem StrictMono.const_mul_of_neg (hf : StrictMono f) (ha : a < 0) :
    StrictAnti fun x => a * f x :=
  (strictAnti_mul_left ha).comp_strictMono hf
#align strict_mono.const_mul_of_neg StrictMono.const_mul_of_neg

theorem StrictMono.mul_const_of_neg (hf : StrictMono f) (ha : a < 0) :
    StrictAnti fun x => f x * a :=
  (strictAnti_mul_right ha).comp_strictMono hf
#align strict_mono.mul_const_of_neg StrictMono.mul_const_of_neg

theorem StrictAnti.const_mul_of_neg (hf : StrictAnti f) (ha : a < 0) :
    StrictMono fun x => a * f x :=
  (strictAnti_mul_left ha).comp hf
#align strict_anti.const_mul_of_neg StrictAnti.const_mul_of_neg

theorem StrictAnti.mul_const_of_neg (hf : StrictAnti f) (ha : a < 0) :
    StrictMono fun x => f x * a :=
  (strictAnti_mul_right ha).comp hf
#align strict_anti.mul_const_of_neg StrictAnti.mul_const_of_neg

end Monotone

end StrictOrderedRing

section StrictOrderedCommRing

variable [StrictOrderedCommRing α]

-- See note [reducible non-instances]
/-- A choice-free version of `StrictOrderedCommRing.toOrderedCommRing` to avoid using
choice in basic `Int` lemmas. -/
@[reducible]
def StrictOrderedCommRing.toOrderedCommRing' [@DecidableRel α (· ≤ ·)] : OrderedCommRing α :=
  { ‹StrictOrderedCommRing α›, StrictOrderedRing.toOrderedRing' with }
#align strict_ordered_comm_ring.to_ordered_comm_ring' StrictOrderedCommRing.toOrderedCommRing'

-- See note [lower instance priority]
instance (priority := 100) StrictOrderedCommRing.toStrictOrderedCommSemiring :
    StrictOrderedCommSemiring α :=
  { ‹StrictOrderedCommRing α›, StrictOrderedRing.toStrictOrderedSemiring with }
#align strict_ordered_comm_ring.to_strict_ordered_comm_semiring StrictOrderedCommRing.toStrictOrderedCommSemiring

-- See note [lower instance priority]
instance (priority := 100) StrictOrderedCommRing.toOrderedCommRing : OrderedCommRing α :=
  { ‹StrictOrderedCommRing α›, StrictOrderedRing.toOrderedRing with }
#align strict_ordered_comm_ring.to_ordered_comm_ring StrictOrderedCommRing.toOrderedCommRing

end StrictOrderedCommRing

section LinearOrderedSemiring

variable [LinearOrderedSemiring α] {a b c d : α}

-- see Note [lower instance priority]
instance (priority := 200) LinearOrderedSemiring.toPosMulReflectLT : PosMulReflectLT α :=
  ⟨fun a _ _ => (monotone_mul_left_of_nonneg a.2).reflect_lt⟩
#align linear_ordered_semiring.to_pos_mul_reflect_lt LinearOrderedSemiring.toPosMulReflectLT

-- see Note [lower instance priority]
instance (priority := 200) LinearOrderedSemiring.toMulPosReflectLT : MulPosReflectLT α :=
  ⟨fun a _ _ => (monotone_mul_right_of_nonneg a.2).reflect_lt⟩
#align linear_ordered_semiring.to_mul_pos_reflect_lt LinearOrderedSemiring.toMulPosReflectLT

attribute [local instance] LinearOrderedSemiring.decidable_le LinearOrderedSemiring.decidable_lt

theorem nonneg_and_nonneg_or_nonpos_and_nonpos_of_mul_nnonneg (hab : 0 ≤ a * b) :
    0 ≤ a ∧ 0 ≤ b ∨ a ≤ 0 ∧ b ≤ 0 := by
  refine' Decidable.or_iff_not_and_not.2 _
  simp only [not_and, not_le]; intro ab nab; apply not_lt_of_le hab _
  -- Porting note: for the middle case, we used to have `rfl`, but it is now rejected.
  -- https://github.com/leanprover/std4/issues/62
  rcases lt_trichotomy 0 a with (ha | ha | ha)
  · exact mul_neg_of_pos_of_neg ha (ab ha.le)
  · subst ha
    exact ((ab le_rfl).asymm (nab le_rfl)).elim
  · exact mul_neg_of_neg_of_pos ha (nab ha.le)
#align nonneg_and_nonneg_or_nonpos_and_nonpos_of_mul_nnonneg nonneg_and_nonneg_or_nonpos_and_nonpos_of_mul_nnonneg

theorem nonneg_of_mul_nonneg_left (h : 0 ≤ a * b) (hb : 0 < b) : 0 ≤ a :=
  le_of_not_gt fun ha => (mul_neg_of_neg_of_pos ha hb).not_le h
#align nonneg_of_mul_nonneg_left nonneg_of_mul_nonneg_left

theorem nonneg_of_mul_nonneg_right (h : 0 ≤ a * b) (ha : 0 < a) : 0 ≤ b :=
  le_of_not_gt fun hb => (mul_neg_of_pos_of_neg ha hb).not_le h
#align nonneg_of_mul_nonneg_right nonneg_of_mul_nonneg_right

theorem neg_of_mul_neg_left (h : a * b < 0) (hb : 0 ≤ b) : a < 0 :=
  lt_of_not_ge fun ha => (mul_nonneg ha hb).not_lt h
#align neg_of_mul_neg_left neg_of_mul_neg_left

theorem neg_of_mul_neg_right (h : a * b < 0) (ha : 0 ≤ a) : b < 0 :=
  lt_of_not_ge fun hb => (mul_nonneg ha hb).not_lt h
#align neg_of_mul_neg_right neg_of_mul_neg_right

theorem nonpos_of_mul_nonpos_left (h : a * b ≤ 0) (hb : 0 < b) : a ≤ 0 :=
  le_of_not_gt fun ha : a > 0 => (mul_pos ha hb).not_le h
#align nonpos_of_mul_nonpos_left nonpos_of_mul_nonpos_left

theorem nonpos_of_mul_nonpos_right (h : a * b ≤ 0) (ha : 0 < a) : b ≤ 0 :=
  le_of_not_gt fun hb : b > 0 => (mul_pos ha hb).not_le h
#align nonpos_of_mul_nonpos_right nonpos_of_mul_nonpos_right

@[simp]
theorem zero_le_mul_left (h : 0 < c) : 0 ≤ c * b ↔ 0 ≤ b := by
  -- Porting note: this used to be by:
  -- convert mul_le_mul_left h
  -- simp
  -- but the `convert` no longer works.
  simpa using (mul_le_mul_left h : c * 0 ≤ c * b ↔ 0 ≤ b)
#align zero_le_mul_left zero_le_mul_left

@[simp]
theorem zero_le_mul_right (h : 0 < c) : 0 ≤ b * c ↔ 0 ≤ b := by
  simpa using (mul_le_mul_right h : 0 * c ≤ b * c ↔ 0 ≤ b)
#align zero_le_mul_right zero_le_mul_right

-- Porting note: we used to not need the type annotation on `(0 : α)` at the start of the `calc`.
theorem add_le_mul_of_left_le_right (a2 : 2 ≤ a) (ab : a ≤ b) : a + b ≤ a * b :=
  have : 0 < b :=
    calc (0 : α)
      _ < 2 := zero_lt_two
      _ ≤ a := a2
      _ ≤ b := ab

  calc
    a + b ≤ b + b := add_le_add_right ab b
    _ = 2 * b := (two_mul b).symm
    _ ≤ a * b := (mul_le_mul_right this).mpr a2

#align add_le_mul_of_left_le_right add_le_mul_of_left_le_right

-- Porting note: we used to not need the type annotation on `(0 : α)` at the start of the `calc`.
theorem add_le_mul_of_right_le_left (b2 : 2 ≤ b) (ba : b ≤ a) : a + b ≤ a * b :=
  have : 0 < a :=
    calc (0 : α)
      _ < 2 := zero_lt_two
      _ ≤ b := b2
      _ ≤ a := ba

  calc
    a + b ≤ a + a := add_le_add_left ba a
    _ = a * 2 := (mul_two a).symm
    _ ≤ a * b := (mul_le_mul_left this).mpr b2

#align add_le_mul_of_right_le_left add_le_mul_of_right_le_left

theorem add_le_mul (a2 : 2 ≤ a) (b2 : 2 ≤ b) : a + b ≤ a * b :=
  if hab : a ≤ b then add_le_mul_of_left_le_right a2 hab
  else add_le_mul_of_right_le_left b2 (le_of_not_le hab)
#align add_le_mul add_le_mul

theorem add_le_mul' (a2 : 2 ≤ a) (b2 : 2 ≤ b) : a + b ≤ b * a :=
  (le_of_eq (add_comm _ _)).trans (add_le_mul b2 a2)
#align add_le_mul' add_le_mul'

set_option linter.deprecated false in
section

@[simp]
theorem bit0_le_bit0 : bit0 a ≤ bit0 b ↔ a ≤ b := by
  rw [bit0, bit0, ← two_mul, ← two_mul, mul_le_mul_left (zero_lt_two : 0 < (2 : α))]
#align bit0_le_bit0 bit0_le_bit0

@[simp]
theorem bit0_lt_bit0 : bit0 a < bit0 b ↔ a < b := by
  rw [bit0, bit0, ← two_mul, ← two_mul, mul_lt_mul_left (zero_lt_two : 0 < (2 : α))]
#align bit0_lt_bit0 bit0_lt_bit0

@[simp]
theorem bit1_le_bit1 : bit1 a ≤ bit1 b ↔ a ≤ b :=
  (add_le_add_iff_right 1).trans bit0_le_bit0
#align bit1_le_bit1 bit1_le_bit1

@[simp]
theorem bit1_lt_bit1 : bit1 a < bit1 b ↔ a < b :=
  (add_lt_add_iff_right 1).trans bit0_lt_bit0
#align bit1_lt_bit1 bit1_lt_bit1

@[simp]
theorem one_le_bit1 : (1 : α) ≤ bit1 a ↔ 0 ≤ a := by
  rw [bit1, le_add_iff_nonneg_left, bit0, ← two_mul, zero_le_mul_left (zero_lt_two : 0 < (2 : α))]
#align one_le_bit1 one_le_bit1

@[simp]
theorem one_lt_bit1 : (1 : α) < bit1 a ↔ 0 < a := by
  rw [bit1, lt_add_iff_pos_left, bit0, ← two_mul, zero_lt_mul_left (zero_lt_two : 0 < (2 : α))]
#align one_lt_bit1 one_lt_bit1

@[simp]
theorem zero_le_bit0 : (0 : α) ≤ bit0 a ↔ 0 ≤ a := by
  rw [bit0, ← two_mul, zero_le_mul_left (zero_lt_two : 0 < (2 : α))]
#align zero_le_bit0 zero_le_bit0

@[simp]
theorem zero_lt_bit0 : (0 : α) < bit0 a ↔ 0 < a := by
  rw [bit0, ← two_mul, zero_lt_mul_left (zero_lt_two : 0 < (2 : α))]
#align zero_lt_bit0 zero_lt_bit0

end

theorem mul_nonneg_iff_right_nonneg_of_pos (ha : 0 < a) : 0 ≤ a * b ↔ 0 ≤ b :=
  ⟨fun h => nonneg_of_mul_nonneg_right h ha, mul_nonneg ha.le⟩
#align mul_nonneg_iff_right_nonneg_of_pos mul_nonneg_iff_right_nonneg_of_pos

theorem mul_nonneg_iff_left_nonneg_of_pos (hb : 0 < b) : 0 ≤ a * b ↔ 0 ≤ a :=
  ⟨fun h => nonneg_of_mul_nonneg_left h hb, fun h => mul_nonneg h hb.le⟩
#align mul_nonneg_iff_left_nonneg_of_pos mul_nonneg_iff_left_nonneg_of_pos

theorem nonpos_of_mul_nonneg_left (h : 0 ≤ a * b) (hb : b < 0) : a ≤ 0 :=
  le_of_not_gt fun ha => absurd h (mul_neg_of_pos_of_neg ha hb).not_le
#align nonpos_of_mul_nonneg_left nonpos_of_mul_nonneg_left

theorem nonpos_of_mul_nonneg_right (h : 0 ≤ a * b) (ha : a < 0) : b ≤ 0 :=
  le_of_not_gt fun hb => absurd h (mul_neg_of_neg_of_pos ha hb).not_le
#align nonpos_of_mul_nonneg_right nonpos_of_mul_nonneg_right

@[simp]
theorem Units.inv_pos {u : αˣ} : (0 : α) < ↑u⁻¹ ↔ (0 : α) < u :=
  have : ∀ {u : αˣ}, (0 : α) < u → (0 : α) < ↑u⁻¹ := @fun u h =>
    (zero_lt_mul_left h).mp <| u.mul_inv.symm ▸ zero_lt_one
  ⟨this, this⟩
#align units.inv_pos Units.inv_pos

@[simp]
theorem Units.inv_neg {u : αˣ} : ↑u⁻¹ < (0 : α) ↔ ↑u < (0 : α) :=
  have : ∀ {u : αˣ}, ↑u < (0 : α) → ↑u⁻¹ < (0 : α) := @fun u h =>
    neg_of_mul_pos_right (u.mul_inv.symm ▸ zero_lt_one) h.le
  ⟨this, this⟩
#align units.inv_neg Units.inv_neg

theorem cmp_mul_pos_left (ha : 0 < a) (b c : α) : cmp (a * b) (a * c) = cmp b c :=
  (strictMono_mul_left_of_pos ha).cmp_map_eq b c
#align cmp_mul_pos_left cmp_mul_pos_left

theorem cmp_mul_pos_right (ha : 0 < a) (b c : α) : cmp (b * a) (c * a) = cmp b c :=
  (strictMono_mul_right_of_pos ha).cmp_map_eq b c
#align cmp_mul_pos_right cmp_mul_pos_right

theorem mul_max_of_nonneg (b c : α) (ha : 0 ≤ a) : a * max b c = max (a * b) (a * c) :=
  (monotone_mul_left_of_nonneg ha).map_max
#align mul_max_of_nonneg mul_max_of_nonneg

theorem mul_min_of_nonneg (b c : α) (ha : 0 ≤ a) : a * min b c = min (a * b) (a * c) :=
  (monotone_mul_left_of_nonneg ha).map_min
#align mul_min_of_nonneg mul_min_of_nonneg

theorem max_mul_of_nonneg (a b : α) (hc : 0 ≤ c) : max a b * c = max (a * c) (b * c) :=
  (monotone_mul_right_of_nonneg hc).map_max
#align max_mul_of_nonneg max_mul_of_nonneg

theorem min_mul_of_nonneg (a b : α) (hc : 0 ≤ c) : min a b * c = min (a * c) (b * c) :=
  (monotone_mul_right_of_nonneg hc).map_min
#align min_mul_of_nonneg min_mul_of_nonneg

theorem le_of_mul_le_of_one_le {a b c : α} (h : a * c ≤ b) (hb : 0 ≤ b) (hc : 1 ≤ c) : a ≤ b :=
  le_of_mul_le_mul_right (h.trans <| le_mul_of_one_le_right hb hc) <| zero_lt_one.trans_le hc
#align le_of_mul_le_of_one_le le_of_mul_le_of_one_le

theorem nonneg_le_nonneg_of_sq_le_sq {a b : α} (hb : 0 ≤ b) (h : a * a ≤ b * b) : a ≤ b :=
  le_of_not_gt fun hab => (mul_self_lt_mul_self hb hab).not_le h
#align nonneg_le_nonneg_of_sq_le_sq nonneg_le_nonneg_of_sq_le_sq

theorem mul_self_le_mul_self_iff {a b : α} (h1 : 0 ≤ a) (h2 : 0 ≤ b) : a ≤ b ↔ a * a ≤ b * b :=
  ⟨mul_self_le_mul_self h1, nonneg_le_nonneg_of_sq_le_sq h2⟩
#align mul_self_le_mul_self_iff mul_self_le_mul_self_iff

theorem mul_self_lt_mul_self_iff {a b : α} (h1 : 0 ≤ a) (h2 : 0 ≤ b) : a < b ↔ a * a < b * b :=
  ((@strictMonoOn_mul_self α _).lt_iff_lt h1 h2).symm
#align mul_self_lt_mul_self_iff mul_self_lt_mul_self_iff

theorem mul_self_inj {a b : α} (h1 : 0 ≤ a) (h2 : 0 ≤ b) : a * a = b * b ↔ a = b :=
  (@strictMonoOn_mul_self α _).eq_iff_eq h1 h2
#align mul_self_inj mul_self_inj

end LinearOrderedSemiring

-- See note [lower instance priority]
instance (priority := 100) LinearOrderedCommSemiring.toLinearOrderedCancelAddCommMonoid
    [LinearOrderedCommSemiring α] : LinearOrderedCancelAddCommMonoid α :=
  { ‹LinearOrderedCommSemiring α› with }
#align linear_ordered_comm_semiring.to_linear_ordered_cancel_add_comm_monoid LinearOrderedCommSemiring.toLinearOrderedCancelAddCommMonoid

section LinearOrderedRing

variable [LinearOrderedRing α] {a b c : α}

attribute [local instance] LinearOrderedRing.decidable_le LinearOrderedRing.decidable_lt

-- see Note [lower instance priority]
instance (priority := 100) LinearOrderedRing.toLinearOrderedSemiring : LinearOrderedSemiring α :=
  { ‹LinearOrderedRing α›, StrictOrderedRing.toStrictOrderedSemiring with }
#align linear_ordered_ring.to_linear_ordered_semiring LinearOrderedRing.toLinearOrderedSemiring

-- see Note [lower instance priority]
instance (priority := 100) LinearOrderedRing.toLinearOrderedAddCommGroup :
    LinearOrderedAddCommGroup α :=
  { ‹LinearOrderedRing α› with }
#align linear_ordered_ring.to_linear_ordered_add_comm_group LinearOrderedRing.toLinearOrderedAddCommGroup

-- see Note [lower instance priority]
instance (priority := 100) LinearOrderedRing.noZeroDivisors : NoZeroDivisors α :=
  { ‹LinearOrderedRing α› with
    eq_zero_or_eq_zero_of_mul_eq_zero := by
      intro a b hab
      refine' Decidable.or_iff_not_and_not.2 fun h => _; revert hab
      cases' lt_or_gt_of_ne h.1 with ha ha <;> cases' lt_or_gt_of_ne h.2 with hb hb
      exacts[(mul_pos_of_neg_of_neg ha hb).ne.symm, (mul_neg_of_neg_of_pos ha hb).ne,
        (mul_neg_of_pos_of_neg ha hb).ne, (mul_pos ha hb).ne.symm] }
#align linear_ordered_ring.no_zero_divisors LinearOrderedRing.noZeroDivisors

-- see Note [lower instance priority]
--We don't want to import `Algebra.Ring.Basic`, so we cannot use `NoZeroDivisors.to_isDomain`.
instance (priority := 100) LinearOrderedRing.isDomain : IsDomain α :=
  { (inferInstance : Nontrivial α) with
    mul_left_cancel_of_ne_zero := fun {a b c} ha h => by
      rw [← sub_eq_zero, ← mul_sub] at h
      exact sub_eq_zero.1 ((eq_zero_or_eq_zero_of_mul_eq_zero h).resolve_left ha),
    mul_right_cancel_of_ne_zero := fun {a b c} hb h => by
      rw [← sub_eq_zero, ← sub_mul] at h
      exact sub_eq_zero.1 ((eq_zero_or_eq_zero_of_mul_eq_zero h).resolve_right hb) }
#align linear_ordered_ring.is_domain LinearOrderedRing.isDomain

theorem mul_pos_iff : 0 < a * b ↔ 0 < a ∧ 0 < b ∨ a < 0 ∧ b < 0 :=
  ⟨pos_and_pos_or_neg_and_neg_of_mul_pos, fun h =>
    h.elim (and_imp.2 mul_pos) (and_imp.2 mul_pos_of_neg_of_neg)⟩
#align mul_pos_iff mul_pos_iff

theorem mul_neg_iff : a * b < 0 ↔ 0 < a ∧ b < 0 ∨ a < 0 ∧ 0 < b := by
  rw [← neg_pos, neg_mul_eq_mul_neg, mul_pos_iff, neg_pos, neg_lt_zero]
#align mul_neg_iff mul_neg_iff

theorem mul_nonneg_iff : 0 ≤ a * b ↔ 0 ≤ a ∧ 0 ≤ b ∨ a ≤ 0 ∧ b ≤ 0 :=
  ⟨nonneg_and_nonneg_or_nonpos_and_nonpos_of_mul_nnonneg, fun h =>
    h.elim (and_imp.2 mul_nonneg) (and_imp.2 mul_nonneg_of_nonpos_of_nonpos)⟩
#align mul_nonneg_iff mul_nonneg_iff

/-- Out of three elements of a `LinearOrderedRing`, two must have the same sign. -/
theorem mul_nonneg_of_three (a b c : α) : 0 ≤ a * b ∨ 0 ≤ b * c ∨ 0 ≤ c * a := by
  iterate 3 rw [mul_nonneg_iff]
  have or_a := le_total 0 a
  have or_b := le_total 0 b
  have or_c := le_total 0 c
  -- Porting note used to be by `itauto` from here
  exact Or.elim or_c
    (fun (h0 : 0 ≤ c) =>
      Or.elim or_b
        (fun (h1 : 0 ≤ b) =>
            Or.elim or_a (fun (h2 : 0 ≤ a) => Or.inl (Or.inl ⟨h2, h1⟩))
              (fun (_ : a ≤ 0) => Or.inr (Or.inl (Or.inl ⟨h1, h0⟩))))
        (fun (h1 : b ≤ 0) =>
            Or.elim or_a (fun (h3 : 0 ≤ a) => Or.inr (Or.inr (Or.inl ⟨h0, h3⟩)))
              (fun (h3 : a ≤ 0) => Or.inl (Or.inr ⟨h3, h1⟩))))
    (fun (h0 : c ≤ 0) =>
      Or.elim or_b
        (fun (h4 : 0 ≤ b) =>
            Or.elim or_a (fun (h5 : 0 ≤ a) => Or.inl (Or.inl ⟨h5, h4⟩))
              (fun (h5 : a ≤ 0) => Or.inr (Or.inr (Or.inr ⟨h0, h5⟩))))
        (fun (h4 : b ≤ 0) =>
            Or.elim or_a (fun (_ : 0 ≤ a) => Or.inr (Or.inl (Or.inr ⟨h4, h0⟩)))
              (fun (h6 : a ≤ 0) => Or.inl (Or.inr ⟨h6, h4⟩))))
#align mul_nonneg_of_three mul_nonneg_of_three

theorem mul_nonpos_iff : a * b ≤ 0 ↔ 0 ≤ a ∧ b ≤ 0 ∨ a ≤ 0 ∧ 0 ≤ b := by
  rw [← neg_nonneg, neg_mul_eq_mul_neg, mul_nonneg_iff, neg_nonneg, neg_nonpos]
#align mul_nonpos_iff mul_nonpos_iff

theorem mul_self_nonneg (a : α) : 0 ≤ a * a :=
  (le_total 0 a).elim (fun h => mul_nonneg h h) fun h => mul_nonneg_of_nonpos_of_nonpos h h
#align mul_self_nonneg mul_self_nonneg

@[simp]
theorem neg_le_self_iff : -a ≤ a ↔ 0 ≤ a := by
  simp [neg_le_iff_add_nonneg, ← two_mul, mul_nonneg_iff, zero_le_one, (zero_lt_two' α).not_le]
#align neg_le_self_iff neg_le_self_iff

@[simp]
theorem neg_lt_self_iff : -a < a ↔ 0 < a := by
  simp [neg_lt_iff_pos_add, ← two_mul, mul_pos_iff, zero_lt_one, (zero_lt_two' α).not_lt]
#align neg_lt_self_iff neg_lt_self_iff

@[simp]
theorem le_neg_self_iff : a ≤ -a ↔ a ≤ 0 :=
  calc
    a ≤ -a ↔ - -a ≤ -a := by rw [neg_neg]
    _ ↔ 0 ≤ -a := neg_le_self_iff
    _ ↔ a ≤ 0 := neg_nonneg

#align le_neg_self_iff le_neg_self_iff

@[simp]
theorem lt_neg_self_iff : a < -a ↔ a < 0 :=
  calc
    a < -a ↔ - -a < -a := by rw [neg_neg]
    _ ↔ 0 < -a := neg_lt_self_iff
    _ ↔ a < 0 := neg_pos

#align lt_neg_self_iff lt_neg_self_iff

theorem neg_one_lt_zero : -1 < (0 : α) :=
  neg_lt_zero.2 zero_lt_one
#align neg_one_lt_zero neg_one_lt_zero

@[simp]
theorem mul_le_mul_left_of_neg {a b c : α} (h : c < 0) : c * a ≤ c * b ↔ b ≤ a :=
  (strictAnti_mul_left h).le_iff_le
#align mul_le_mul_left_of_neg mul_le_mul_left_of_neg

@[simp]
theorem mul_le_mul_right_of_neg {a b c : α} (h : c < 0) : a * c ≤ b * c ↔ b ≤ a :=
  (strictAnti_mul_right h).le_iff_le
#align mul_le_mul_right_of_neg mul_le_mul_right_of_neg

@[simp]
theorem mul_lt_mul_left_of_neg {a b c : α} (h : c < 0) : c * a < c * b ↔ b < a :=
  (strictAnti_mul_left h).lt_iff_lt
#align mul_lt_mul_left_of_neg mul_lt_mul_left_of_neg

@[simp]
theorem mul_lt_mul_right_of_neg {a b c : α} (h : c < 0) : a * c < b * c ↔ b < a :=
  (strictAnti_mul_right h).lt_iff_lt
#align mul_lt_mul_right_of_neg mul_lt_mul_right_of_neg

theorem lt_of_mul_lt_mul_of_nonpos_left (h : c * a < c * b) (hc : c ≤ 0) : b < a :=
  lt_of_mul_lt_mul_left (by rwa [neg_mul, neg_mul, neg_lt_neg_iff]) <| neg_nonneg.2 hc
#align lt_of_mul_lt_mul_of_nonpos_left lt_of_mul_lt_mul_of_nonpos_left

theorem lt_of_mul_lt_mul_of_nonpos_right (h : a * c < b * c) (hc : c ≤ 0) : b < a :=
  lt_of_mul_lt_mul_right (by rwa [mul_neg, mul_neg, neg_lt_neg_iff]) <| neg_nonneg.2 hc
#align lt_of_mul_lt_mul_of_nonpos_right lt_of_mul_lt_mul_of_nonpos_right

theorem cmp_mul_neg_left {a : α} (ha : a < 0) (b c : α) : cmp (a * b) (a * c) = cmp c b :=
  (strictAnti_mul_left ha).cmp_map_eq b c
#align cmp_mul_neg_left cmp_mul_neg_left

theorem cmp_mul_neg_right {a : α} (ha : a < 0) (b c : α) : cmp (b * a) (c * a) = cmp c b :=
  (strictAnti_mul_right ha).cmp_map_eq b c
#align cmp_mul_neg_right cmp_mul_neg_right

theorem sub_one_lt (a : α) : a - 1 < a :=
  sub_lt_iff_lt_add.2 (lt_add_one a)
#align sub_one_lt sub_one_lt

@[simp]
theorem mul_self_pos {a : α} : 0 < a * a ↔ a ≠ 0 := by
  constructor
  · rintro h rfl
    rw [mul_zero] at h
    exact h.false
  · intro h
    cases' h.lt_or_lt with h h
    exacts[mul_pos_of_neg_of_neg h h, mul_pos h h]
#align mul_self_pos mul_self_pos

theorem mul_self_le_mul_self_of_le_of_neg_le {x y : α} (h₁ : x ≤ y) (h₂ : -x ≤ y) : x * x ≤ y * y :=
  (le_total 0 x).elim (fun h => mul_le_mul h₁ h₁ h (h.trans h₁)) fun h =>
    le_of_eq_of_le (neg_mul_neg x x).symm
      (mul_le_mul h₂ h₂ (neg_nonneg.mpr h) ((neg_nonneg.mpr h).trans h₂))
#align mul_self_le_mul_self_of_le_of_neg_le mul_self_le_mul_self_of_le_of_neg_le

theorem nonneg_of_mul_nonpos_left {a b : α} (h : a * b ≤ 0) (hb : b < 0) : 0 ≤ a :=
  le_of_not_gt fun ha => absurd h (mul_pos_of_neg_of_neg ha hb).not_le
#align nonneg_of_mul_nonpos_left nonneg_of_mul_nonpos_left

theorem nonneg_of_mul_nonpos_right {a b : α} (h : a * b ≤ 0) (ha : a < 0) : 0 ≤ b :=
  le_of_not_gt fun hb => absurd h (mul_pos_of_neg_of_neg ha hb).not_le
#align nonneg_of_mul_nonpos_right nonneg_of_mul_nonpos_right

theorem pos_of_mul_neg_left {a b : α} (h : a * b < 0) (hb : b ≤ 0) : 0 < a :=
  lt_of_not_ge fun ha => absurd h (mul_nonneg_of_nonpos_of_nonpos ha hb).not_lt
#align pos_of_mul_neg_left pos_of_mul_neg_left

theorem pos_of_mul_neg_right {a b : α} (h : a * b < 0) (ha : a ≤ 0) : 0 < b :=
  lt_of_not_ge fun hb => absurd h (mul_nonneg_of_nonpos_of_nonpos ha hb).not_lt
#align pos_of_mul_neg_right pos_of_mul_neg_right

theorem neg_iff_pos_of_mul_neg (hab : a * b < 0) : a < 0 ↔ 0 < b :=
  ⟨pos_of_mul_neg_right hab ∘ le_of_lt, neg_of_mul_neg_left hab ∘ le_of_lt⟩
#align neg_iff_pos_of_mul_neg neg_iff_pos_of_mul_neg

theorem pos_iff_neg_of_mul_neg (hab : a * b < 0) : 0 < a ↔ b < 0 :=
  ⟨neg_of_mul_neg_right hab ∘ le_of_lt, pos_of_mul_neg_left hab ∘ le_of_lt⟩
#align pos_iff_neg_of_mul_neg pos_iff_neg_of_mul_neg

/-- The sum of two squares is zero iff both elements are zero. -/
theorem mul_self_add_mul_self_eq_zero {x y : α} : x * x + y * y = 0 ↔ x = 0 ∧ y = 0 := by
  rw [add_eq_zero_iff', mul_self_eq_zero, mul_self_eq_zero] <;> apply mul_self_nonneg
#align mul_self_add_mul_self_eq_zero mul_self_add_mul_self_eq_zero

theorem eq_zero_of_mul_self_add_mul_self_eq_zero (h : a * a + b * b = 0) : a = 0 :=
  (mul_self_add_mul_self_eq_zero.mp h).left
#align eq_zero_of_mul_self_add_mul_self_eq_zero eq_zero_of_mul_self_add_mul_self_eq_zero

end LinearOrderedRing

-- see Note [lower instance priority]
instance (priority := 100) LinearOrderedCommRing.toStrictOrderedCommRing
    [d : LinearOrderedCommRing α] : StrictOrderedCommRing α :=
  { d with }
#align linear_ordered_comm_ring.to_strict_ordered_comm_ring LinearOrderedCommRing.toStrictOrderedCommRing

-- see Note [lower instance priority]
instance (priority := 100) LinearOrderedCommRing.toLinearOrderedCommSemiring
    [d : LinearOrderedCommRing α] : LinearOrderedCommSemiring α :=
  { d, LinearOrderedRing.toLinearOrderedSemiring with }
#align linear_ordered_comm_ring.to_linear_ordered_comm_semiring LinearOrderedCommRing.toLinearOrderedCommSemiring

section LinearOrderedCommRing

variable [LinearOrderedCommRing α] {a b c d : α}

theorem max_mul_mul_le_max_mul_max (b c : α) (ha : 0 ≤ a) (hd : 0 ≤ d) :
    max (a * b) (d * c) ≤ max a c * max d b :=
  have ba : b * a ≤ max d b * max c a :=
    mul_le_mul (le_max_right d b) (le_max_right c a) ha (le_trans hd (le_max_left d b))
  have cd : c * d ≤ max a c * max b d :=
    mul_le_mul (le_max_right a c) (le_max_right b d) hd (le_trans ha (le_max_left a c))
  max_le (by simpa [mul_comm, max_comm] using ba) (by simpa [mul_comm, max_comm] using cd)
#align max_mul_mul_le_max_mul_max max_mul_mul_le_max_mul_max

end LinearOrderedCommRing


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

import algebra.polynomial.big_operators
import data.nat.choose.cast
import data.nat.choose.vandermonde
import data.polynomial.degree.lemmas
import data.polynomial.derivative

/-!
# Hasse derivative of polynomials

The `k`th Hasse derivative of a polynomial `∑ a_i X^i` is `∑ (i.choose k) a_i X^(i-k)`.
It is a variant of the usual derivative, and satisfies `k! * (hasse_deriv k f) = derivative^[k] f`.
The main benefit is that is gives an atomic way of talking about expressions such as
`(derivative^[k] f).eval r / k!`, that occur in Taylor expansions, for example.

## Main declarations

In the following, we write `D k` for the `k`-th Hasse derivative `hasse_deriv k`.

* `polynomial.hasse_deriv`: the `k`-th Hasse derivative of a polynomial
* `polynomial.hasse_deriv_zero`: the `0`th Hasse derivative is the identity
* `polynomial.hasse_deriv_one`: the `1`st Hasse derivative is the usual derivative
* `polynomial.factorial_smul_hasse_deriv`: the identity `k! • (D k f) = derivative^[k] f`
* `polynomial.hasse_deriv_comp`: the identity `(D k).comp (D l) = (k+l).choose k • D (k+l)`
* `polynomial.hasse_deriv_mul`:
  the "Leibniz rule" `D k (f * g) = ∑ ij in antidiagonal k, D ij.1 f * D ij.2 g`

For the identity principle, see `polynomial.eq_zero_of_hasse_deriv_eq_zero`
in `data/polynomial/taylor.lean`.

## Reference

https://math.fontein.de/2009/08/12/the-hasse-derivative/

-/

noncomputable theory

namespace polynomial

open_locale nat big_operators polynomial
open function nat (hiding nsmul_eq_mul)

variables {R : Type*} [semiring R] (k : ℕ) (f : R[X])

/-- The `k`th Hasse derivative of a polynomial `∑ a_i X^i` is `∑ (i.choose k) a_i X^(i-k)`.
It satisfies `k! * (hasse_deriv k f) = derivative^[k] f`. -/
def hasse_deriv (k : ℕ) : R[X] →ₗ[R] R[X] :=
lsum (λ i, (monomial (i-k)) ∘ₗ distrib_mul_action.to_linear_map R R (i.choose k))

lemma hasse_deriv_apply :
  hasse_deriv k f = f.sum (λ i r, monomial (i - k) (↑(i.choose k) * r)) :=
by simpa only [← nsmul_eq_mul]

lemma hasse_deriv_coeff (n : ℕ) :
  (hasse_deriv k f).coeff n = (n + k).choose k * f.coeff (n + k) :=
begin
  rw [hasse_deriv_apply, coeff_sum, sum_def, finset.sum_eq_single (n + k), coeff_monomial],
  { simp only [if_true, add_tsub_cancel_right, eq_self_iff_true], },
  { intros i hi hink,
    rw [coeff_monomial],
    by_cases hik : i < k,
    { simp only [nat.choose_eq_zero_of_lt hik, if_t_t, nat.cast_zero, zero_mul], },
    { push_neg at hik, rw if_neg, contrapose! hink,
      exact (tsub_eq_iff_eq_add_of_le hik).mp hink, } },
  { intro h, simp only [not_mem_support_iff.mp h, monomial_zero_right, mul_zero, coeff_zero] }
end

lemma hasse_deriv_zero' : hasse_deriv 0 f = f :=
by simp only [hasse_deriv_apply, tsub_zero, nat.choose_zero_right,
  nat.cast_one, one_mul, sum_monomial_eq]

@[simp] lemma hasse_deriv_zero : @hasse_deriv R _ 0 = linear_map.id :=
linear_map.ext $ hasse_deriv_zero'

lemma hasse_deriv_eq_zero_of_lt_nat_degree (p : R[X]) (n : ℕ)
  (h : p.nat_degree < n) : hasse_deriv n p = 0 :=
begin
  rw [hasse_deriv_apply, sum_def],
  refine finset.sum_eq_zero (λ x hx, _),
  simp [nat.choose_eq_zero_of_lt ((le_nat_degree_of_mem_supp _ hx).trans_lt h)]
end

lemma hasse_deriv_one' : hasse_deriv 1 f = derivative f :=
by simp only [hasse_deriv_apply, derivative_apply, monomial_eq_C_mul_X, nat.choose_one_right,
    (nat.cast_commute _ _).eq]

@[simp] lemma hasse_deriv_one : @hasse_deriv R _ 1 = derivative :=
linear_map.ext $ hasse_deriv_one'

@[simp] lemma hasse_deriv_monomial (n : ℕ) (r : R) :
  hasse_deriv k (monomial n r) = monomial (n - k) (↑(n.choose k) * r) :=
begin
  ext i,
  simp only [hasse_deriv_coeff, coeff_monomial],
  by_cases hnik : n = i + k,
  { rw [if_pos hnik, if_pos, ← hnik], apply tsub_eq_of_eq_add_rev, rwa add_comm },
  { rw [if_neg hnik, mul_zero],
    by_cases hkn : k ≤ n,
    { rw [← tsub_eq_iff_eq_add_of_le hkn] at hnik, rw [if_neg hnik] },
    { push_neg at hkn, rw [nat.choose_eq_zero_of_lt hkn, nat.cast_zero, zero_mul, if_t_t] } }
end

lemma hasse_deriv_C (r : R) (hk : 0 < k) : hasse_deriv k (C r) = 0 :=
by rw [← monomial_zero_left, hasse_deriv_monomial, nat.choose_eq_zero_of_lt hk,
    nat.cast_zero, zero_mul, monomial_zero_right]

lemma hasse_deriv_apply_one (hk : 0 < k) : hasse_deriv k (1 : R[X]) = 0 :=
by rw [← C_1, hasse_deriv_C k _ hk]

lemma hasse_deriv_X (hk : 1 < k) : hasse_deriv k (X : R[X]) = 0 :=
by rw [← monomial_one_one_eq_X, hasse_deriv_monomial, nat.choose_eq_zero_of_lt hk,
    nat.cast_zero, zero_mul, monomial_zero_right]

lemma factorial_smul_hasse_deriv :
  ⇑(k! • @hasse_deriv R _ k) = ((@derivative R _)^[k]) :=
begin
  induction k with k ih,
  { rw [hasse_deriv_zero, factorial_zero, iterate_zero, one_smul, linear_map.id_coe], },
  ext f n : 2,
  rw [iterate_succ_apply', ← ih],
  simp only [linear_map.smul_apply, coeff_smul, linear_map.map_smul_of_tower, coeff_derivative,
    hasse_deriv_coeff, ← @choose_symm_add _ k],
  simp only [nsmul_eq_mul, factorial_succ, mul_assoc, succ_eq_add_one, ← add_assoc,
    add_right_comm n 1 k, ← cast_succ],
  rw ← (cast_commute (n+1) (f.coeff (n + k + 1))).eq,
  simp only [← mul_assoc], norm_cast, congr' 2,
  apply @cast_injective ℚ,
  have h1 : n + 1 ≤ n + k + 1 := succ_le_succ le_self_add,
  have h2 : k + 1 ≤ n + k + 1 := succ_le_succ le_add_self,
  have H : ∀ (n : ℕ), (n! : ℚ) ≠ 0, { exact_mod_cast factorial_ne_zero },
  -- why can't `field_simp` help me here?
  simp only [cast_mul, cast_choose ℚ, h1, h2, -one_div, -mul_eq_zero,
    succ_sub_succ_eq_sub, add_tsub_cancel_right, add_tsub_cancel_left] with field_simps,
  rw [eq_div_iff_mul_eq (mul_ne_zero (H _) (H _)), eq_comm, div_mul_eq_mul_div,
    eq_div_iff_mul_eq (mul_ne_zero (H _) (H _))],
  norm_cast,
  simp only [factorial_succ, succ_eq_add_one], ring,
end

lemma hasse_deriv_comp (k l : ℕ) :
  (@hasse_deriv R _ k).comp (hasse_deriv l) = (k+l).choose k • hasse_deriv (k+l) :=
begin
  ext i : 2,
  simp only [linear_map.smul_apply, comp_app, linear_map.coe_comp, smul_monomial,
    hasse_deriv_apply, mul_one, monomial_eq_zero_iff, sum_monomial_index, mul_zero,
    ← tsub_add_eq_tsub_tsub, add_comm l k],
  rw_mod_cast nsmul_eq_mul,
  congr' 2,
  by_cases hikl : i < k + l,
  { rw [choose_eq_zero_of_lt hikl, mul_zero],
    by_cases hil : i < l,
    { rw [choose_eq_zero_of_lt hil, mul_zero] },
    { push_neg at hil, rw [← tsub_lt_iff_right hil] at hikl,
      rw [choose_eq_zero_of_lt hikl , zero_mul], }, },
  push_neg at hikl, apply @cast_injective ℚ,
  have h1 : l ≤ i     := nat.le_of_add_le_right hikl,
  have h2 : k ≤ i - l := le_tsub_of_add_le_right hikl,
  have h3 : k ≤ k + l := le_self_add,
  have H : ∀ (n : ℕ), (n! : ℚ) ≠ 0, { exact_mod_cast factorial_ne_zero },
  -- why can't `field_simp` help me here?
  simp only [cast_mul, cast_choose ℚ, h1, h2, h3, hikl, -one_div, -mul_eq_zero,
    succ_sub_succ_eq_sub, add_tsub_cancel_right, add_tsub_cancel_left] with field_simps,
  rw [eq_div_iff_mul_eq, eq_comm, div_mul_eq_mul_div, eq_div_iff_mul_eq, ← tsub_add_eq_tsub_tsub,
    add_comm l k],
  { ring, },
  all_goals { apply_rules [mul_ne_zero, H] }
end

lemma nat_degree_hasse_deriv_le (p : R[X]) (n : ℕ) :
  nat_degree (hasse_deriv n p) ≤ nat_degree p - n :=
begin
  classical,
  rw [hasse_deriv_apply, sum_def],
  refine (nat_degree_sum_le _ _).trans _,
  simp_rw [function.comp, nat_degree_monomial],
  rw [finset.fold_ite, finset.fold_const],
  { simp only [if_t_t, max_eq_right, zero_le', finset.fold_max_le, true_and, and_imp,
               tsub_le_iff_right, mem_support_iff, ne.def, finset.mem_filter],
    intros x hx hx',
    have hxp : x ≤ p.nat_degree := le_nat_degree_of_ne_zero hx,
    have hxn : n ≤ x,
    { contrapose! hx',
      simp [nat.choose_eq_zero_of_lt hx'] },
    rwa [tsub_add_cancel_of_le (hxn.trans hxp)] },
  { simp }
end

lemma nat_degree_hasse_deriv [no_zero_smul_divisors ℕ R] (p : R[X]) (n : ℕ) :
  nat_degree (hasse_deriv n p) = nat_degree p - n :=
begin
  cases lt_or_le p.nat_degree n with hn hn,
  { simpa [hasse_deriv_eq_zero_of_lt_nat_degree, hn] using (tsub_eq_zero_of_le hn.le).symm },
  { refine map_nat_degree_eq_sub _ _,
    { exact λ h, hasse_deriv_eq_zero_of_lt_nat_degree _ _ },
    { classical,
      simp only [ite_eq_right_iff, ne.def, nat_degree_monomial, hasse_deriv_monomial],
      intros k c c0 hh,
      -- this is where we use the `smul_eq_zero` from `no_zero_smul_divisors`
      rw [←nsmul_eq_mul, smul_eq_zero, nat.choose_eq_zero_iff] at hh,
      exact (tsub_eq_zero_of_le (or.resolve_right hh c0).le).symm } }
end

section
open add_monoid_hom finset.nat

lemma hasse_deriv_mul (f g : R[X]) :
  hasse_deriv k (f * g) = ∑ ij in antidiagonal k, hasse_deriv ij.1 f * hasse_deriv ij.2 g :=
begin
  let D := λ k, (@hasse_deriv R _ k).to_add_monoid_hom,
  let Φ := @add_monoid_hom.mul R[X] _,
  show (comp_hom (D k)).comp Φ f g =
    ∑ (ij : ℕ × ℕ) in antidiagonal k, ((comp_hom.comp ((comp_hom Φ) (D ij.1))).flip (D ij.2) f) g,
  simp only [← finset_sum_apply],
  congr' 2, clear f g,
  ext m r n s : 4,
  simp only [finset_sum_apply, coe_mul_left, coe_comp, flip_apply, comp_app,
    hasse_deriv_monomial, linear_map.to_add_monoid_hom_coe, comp_hom_apply_apply, coe_mul,
    monomial_mul_monomial],
  have aux : ∀ (x : ℕ × ℕ), x ∈ antidiagonal k →
    monomial (m - x.1 + (n - x.2)) (↑(m.choose x.1) * r * (↑(n.choose x.2) * s)) =
    monomial (m + n - k) (↑(m.choose x.1) * ↑(n.choose x.2) * (r * s)),
  { intros x hx, rw [finset.nat.mem_antidiagonal] at hx, subst hx,
    by_cases hm : m < x.1,
    { simp only [nat.choose_eq_zero_of_lt hm, nat.cast_zero, zero_mul, monomial_zero_right], },
    by_cases hn : n < x.2,
    { simp only [nat.choose_eq_zero_of_lt hn, nat.cast_zero,
        zero_mul, mul_zero, monomial_zero_right], },
    push_neg at hm hn,
    rw [tsub_add_eq_add_tsub hm, ← add_tsub_assoc_of_le hn, ← tsub_add_eq_tsub_tsub,
      add_comm x.2 x.1, mul_assoc, ← mul_assoc r, ← (nat.cast_commute _ r).eq, mul_assoc,
      mul_assoc], },
  conv_rhs { apply_congr, skip, rw aux _ H, },
  rw_mod_cast [← linear_map.map_sum, ← finset.sum_mul, ← nat.add_choose_eq],
end

end

end polynomial


import definitions
import point4

theorem fib_add (m n : ℕ) : fib (m + n + 1) =
  fib m * fib n + fib (m + 1) * fib (n + 1) :=
nat.rec_on_two n (by unfold fib; rw [mul_zero, zero_add, mul_one]; refl)
  (by unfold fib; rw [zero_add, mul_one, mul_one]; refl) $ λ n ih1 ih2,
calc  fib (m + n + 1) + fib (m + nat.succ n + 1)
    = fib m * (fib n + fib (n+1)) + fib (m+1) * (fib (n+1) + (fib n + fib (n+1))) :
  by rw [ih1, ih2, fib, mul_add, mul_add, mul_add, mul_add, nat.succ_eq_add_one]; ac_refl

theorem fib_dvd_mul (m n : ℕ) : fib m ∣ fib (m * n) :=
nat.cases_on m (by rw [zero_mul]; refl) $ λ m,
nat.rec_on n (dvd_zero _) $ λ n ih,
show fib (nat.succ m) ∣ fib (nat.succ m * n + m + 1),
by rw [fib_add]; apply dvd_add;
[apply dvd_mul_of_dvd_left ih, apply dvd_mul_left]

theorem fib_gcd_mod (m n : ℕ) : nat.gcd (fib m) (fib n) = nat.gcd (fib (m%n)) (fib n) :=
nat.mod_rec n m $ λ m, show nat.gcd (fib m) (fib n) = nat.gcd (fib (m + n)) (fib n),
from nat.cases_on n rfl $ λ n,
by rw [nat.add_succ, nat.succ_eq_add_one, fib_add]; symmetry;
rw [nat.gcd_comm, nat.gcd_rec, nat.add_mul_mod_self_right, ← nat.gcd_rec];
rw [nat.gcd_comm, nat.coprime.gcd_mul_right_cancel]; symmetry; apply fib_succ_coprime

theorem fib_gcd (m : ℕ) : ∀ n, nat.gcd (fib m) (fib n) = fib (nat.gcd m n) :=
nat.strong_induction_on m $ λ m, nat.cases_on m (λ _ _, by rw [fib, nat.gcd_zero_left, nat.gcd_zero_left]) $ λ m ih n,
have H : n % nat.succ m < nat.succ m,
  from nat.mod_lt _ $ nat.zero_lt_succ m,
by rw [nat.gcd_succ, ← ih _ H, ← fib_gcd_mod, nat.gcd_comm]


-- Some basic results about the relationship of 𝕍 and 𝕀

-- Imports results about 𝕍 and 𝕀
import affine_algebraic_set.V
import affine_algebraic_set.I

import data.mv_polynomial

open mv_polynomial

variables {k : Type*} [comm_ring k]

variable {σ : Type*}

open affine_algebraic_set

/-- For S ⊆ k[X₁,X₂,…,Xₙ] we have S ⊆ 𝕀(𝕍(S))--/
lemma 𝕀_of_𝕍_is_subset {S : set(mv_polynomial σ k)} :
S ⊆ 𝕀(𝕍(S)):=
begin
    -- assume s ∈ S
    intros s HS,
    -- apply Definition of 𝕀
    rw mem_𝕀_iff,
    -- let x ∈ kⁿ be arbitrary
    intro x,
    --apply Definition of 𝕍
    rw mem_𝕍_iff,
    -- Assume Hypothesis
    intro H,
    -- Apply H to goal
    apply H,
    from HS,
end

/-- For S ⊆ k[X₁,X₂,…,Xₙ] we have 𝕍(𝕀(𝕍(S))) = 𝕍(S)
e.g. 𝕍(𝕀(U)) = U if U is an algebraic set --/
lemma 𝕀_of_𝕍 {S : set(mv_polynomial σ k)} :
𝕍(𝕀(𝕍(S))) = 𝕍(S):=
begin
    -- ⊆ Inclusion: This follows from the fact that 𝕀(𝕍(S)) ⊆ S (shown above)
    -- And the antimonomity of 𝕍
    apply set.subset.antisymm,
    apply 𝕍_antimono,
    from 𝕀_of_𝕍_is_subset,

    -- ⊇ Inclusion: I'm sorry, this is just a bunch of abstract nonsense
    -- We show that if x ∈ kⁿ vanishes for all f ∈ S (e.g. x ∈ 𝕍(S)),
    -- it also vanishes for all g ∈ k[X₁,X₂,…,Xₙ] that vanish on 𝕍(S)
    -- Which is true by definition:

    -- Suppose y ∈ 𝕍(S)
    intros y HS,

    -- Apply definitions of 𝕍 and 𝕀
    rw mem_𝕍_iff,
    intro f,
    rw mem_𝕀_iff,

    -- Rewrite Goal
    intro Q,
    apply Q y,
    -- Use y ∈ 𝕍(S)
    from HS,
end

lemma 𝕀_inj_on_𝕍 {S T : set(mv_polynomial σ k)} : 𝕀(𝕍(S)) = 𝕀(𝕍(T)) → 𝕍(S) = 𝕍(T) :=
begin
intro H,
have H1 := congr_arg 𝕍 H,
rw [𝕀_of_𝕍, 𝕀_of_𝕍] at H1,
exact H1,
end

lemma 𝕀_strantimono_on_𝕍 {S T : set(mv_polynomial σ k)} :
  𝕍 S < 𝕍 T → 𝕀(𝕍(T)) < 𝕀(𝕍(S)) :=
begin
intro lt,
have H := 𝕀_antimono (𝕍 S) (𝕍 T) (le_of_lt lt),
cases (@eq_or_lt_of_le (set (mv_polynomial σ k)) _ _ _ H),
{
    exfalso,
    have H1 := 𝕀_inj_on_𝕍 h,
    apply ne_of_lt lt,
    apply H1.symm,
},
{ exact h },
end


import  .Sup_fin data.finsupp order.lattice data.nat.cast .euclidean_domain unique_factorization_domain
import .to_finsupp .to_finset poly associated_quotient
universes u v w

noncomputable theory

open classical set function finsupp lattice

local attribute [instance] finsupp.to_comm_semiring
local attribute [instance] finsupp.to_semiring
local infix ^ := monoid.pow
local notation a `~ᵤ` b : 50 := associated a b --also present in UFD
namespace polynomial
local attribute [instance] prop_decidable
variables {α : Type u} {a a' a₁ a₂ : α} --{n m : ℕ} --do we want n and m?

open associated

section integral_domain
variable [integral_domain α]

lemma X_pow_ne_zero {n : ℕ}: (X ^ n : polynomial α) ≠ 0 :=
begin
  intro h2,
  have h3: (single n 1 : polynomial α ) n = 1,
  {
    simp,
  },
  rw X_pow_eq_single at h2,
  rw h2 at h3,
  simp * at *,
end

lemma zero_ne_one : (0:polynomial α) ≠ 1:=
begin
  intro h,
  have : (0 : polynomial α) 0 = (1 : polynomial α) 0,
  { rw [h]},
  simp * at *
end

--Do we need the arguments here? --i.e. [integral_domain α]?
instance {α : Type u} [integral_domain α] : zero_ne_one_class (polynomial α):=
{ zero_ne_one := zero_ne_one, .. polynomial.comm_ring }

/- Can we use this to reduce the lemma below?
lemma leading_coeff_mul_leading_coeff_eq_zero_of_mul_eq_zero (f g : polynomial α) (h : f * g = 0) : (leading_coeff f) * (leading_coeff g) = 0 :=
begin
  have h1 : leading_coeff f = 0 ∨  leading_coeff g = 0,
  {
    by_contradiction h2,
    rw [not_or_distrib, leading_coef_eq_zero_iff_eq_zero, leading_coef_eq_zero_iff_eq_zero] at h2,
  }
end
-/

lemma eq_zero_or_eq_zero_of_mul_eq_zero : ∀ f g : polynomial α, f * g = 0 → f = 0 ∨ g = 0 :=
begin
  intros f g h1,
  by_contradiction h2,
  rw [not_or_distrib, ←leading_coef_eq_zero_iff_eq_zero, ←leading_coef_eq_zero_iff_eq_zero] at h2,
  have h7 : (leading_coeff f) * (leading_coeff g) ≠ 0,
  {
    intro h8,
    have h9 : leading_coeff f = 0 ∨  leading_coeff g = 0,
      from eq_zero_or_eq_zero_of_mul_eq_zero h8,
    cases h9 ; simp * at *,
  },
  have h8 : (f * g) (degree f + degree g) ≠ 0,
  {
    simpa [mul_degree_add_degree_eq_leading_coeff_mul_leading_coeff],
  },
  rw [h1, zero_apply] at h8,
  contradiction
end

instance {α : Type u} [integral_domain α] : no_zero_divisors (polynomial α):=
{eq_zero_or_eq_zero_of_mul_eq_zero := eq_zero_or_eq_zero_of_mul_eq_zero
.. polynomial.comm_ring}

instance {α : Type u} [integral_domain α]: integral_domain (polynomial α) :=
{ eq_zero_or_eq_zero_of_mul_eq_zero := eq_zero_or_eq_zero_of_mul_eq_zero,
  .. polynomial.comm_ring, .. polynomial.zero_ne_one_class }

--naming?
lemma mul_eq_zero_iff_mul_leading_coef_eq_zero {f g : polynomial α} : f * g = 0 ↔ (leading_coeff f) * (leading_coeff g) = 0 :=
begin
  constructor,
  {
    intro h1,
    rw [←mul_degree_add_degree_eq_leading_coeff_mul_leading_coeff, h1],
    simp,
  },
  {
    intro h1,
    have h2 : leading_coeff f = 0 ∨ leading_coeff g = 0,
      from _root_.eq_zero_or_eq_zero_of_mul_eq_zero  h1,
    cases h2 ; {simp [leading_coef_eq_zero_iff_eq_zero, * ] at *}
  }
end

--naming?
lemma degree_mul_eq_add_of_mul_ne_zero {f g : polynomial α} : f * g ≠ 0 → degree (f * g) = degree f + degree g :=
begin
  intro h1,
  have h2 : f ≠ 0,
    from ne_zero_of_mul_ne_zero_right h1,
  have h3 : g ≠ 0,
    from ne_zero_of_mul_ne_zero_left h1,
  have h4 : (f * g) (degree f + degree g) ≠ 0,
  {
    calc (f * g) (degree f + degree g) = (leading_coeff f) * (leading_coeff g) : mul_degree_add_degree_eq_leading_coeff_mul_leading_coeff
      ... ≠ 0 : by {simp,rw [←not_iff_not_of_iff mul_eq_zero_iff_mul_leading_coef_eq_zero], exact h1},
  },
  have h5 : (degree f + degree g) ≤ degree (f * g),
    from le_degree h4,
  have h6 : degree (f * g) ≤ (degree f + degree g),
    from degree_mul,
  apply le_antisymm; simp * at *
end

--naming?
lemma degree_dvd {f g : polynomial α} (h1 : f ∣ g)(h4 : g ≠ 0) : degree f ≤ degree g :=
begin
  rcases h1 with ⟨c, h2⟩,
  subst h2,
  by_cases h : (f = 0),
  {
    simp [h, nat.zero_le],
  },
  {
    have h3 : degree (f * c) = degree f + degree c,
      from degree_mul_eq_add_of_mul_ne_zero h4,
    exact (nat.le.intro h3.symm),
  }
end

lemma prod_ne_zero_of_forall_mem_ne_zero {f : finset (polynomial α)} : (∀ x ∈ f, x ≠ (0 : polynomial α)) → f.prod id ≠ 0 :=
begin
  apply finset.induction_on f,
  {
    simp *,
  },
  {
    intros a s h1 h2 h3,
    have h4 : (∀ (x : polynomial α), x ∈ s → x ≠ 0),
    {
      intros x h4,
      simp * at *,
    },
    have h5 : finset.prod s id ≠ 0,
      from h2 h4,
    have h6 : a ≠ 0,
    {
      simp * at *,
    },
    simp [finset.prod_insert h1],
    exact mul_ne_zero h6 h5,
  }
end

--naming?
lemma degree_prod {β : Type u} {s : finset β} {f : β → polynomial α} : finset.prod s f ≠ 0 → degree (s.prod f) = s.sum (degree ∘ f) :=
begin
  fapply finset.induction_on s,
  {
    simp *,
  },
  {
    intros a s h1 h2 h3,
    have h4 : finset.prod s f ≠ 0,
    {
      rw [finset.prod_insert h1] at h3,
      exact ne_zero_of_mul_ne_zero_left h3,
    },
    have h5 : degree (finset.prod s f) = finset.sum s (degree ∘ f),
      from h2 h4,
    simp *,
    rw [degree_mul_eq_add_of_mul_ne_zero, h5],
    rw [finset.prod_insert h1] at h3,
    exact h3,
  },
end

-- naming? incliude id?
lemma degree_prod_eq_sum_degree_of_prod_ne_zero {f : finset (polynomial α)} : (f.prod id ≠ 0) → degree (f.prod id) = f.sum (degree) :=
begin
  fapply finset.induction_on f,
  {
    simp *
  },
  {
    intros a s h1 h2 h3,
    simp [finset.prod_insert h1, finset.sum_insert h1],
    have h4: finset.prod (s) id ≠ 0,
    {
      rw finset.prod_insert at h3,
      exact ne_zero_of_mul_ne_zero_left h3,
      exact h1,
    },
    have h5: degree (finset.prod s id) = finset.sum s degree,
      from h2 h4,
    have h6 : a * finset.prod s (λ (x : polynomial α), x) ≠ 0,
    {
      simp [finset.prod_insert h1, *] at *,
    },
    simp [degree_mul_eq_add_of_mul_ne_zero h6, *] at *,
  }
end

--naming
lemma degree_pow {x : polynomial α}{n : ℕ} : degree (x ^ n) = n * degree x :=
begin
  induction n with n h1,
  {
    simp *,
  },
  {
    by_cases h : (x = 0),
    {
      simp [pow_succ, *] at *,
    },
    {
      rw [pow_succ, degree_mul_eq_add_of_mul_ne_zero, h1],
      exact calc degree x + n * degree x = 1 * degree x + n * degree x : by simp
          ... = n * degree x + 1 * degree x : by rw add_comm (1 * degree x) (n * degree x)
          ... = (n + 1) * degree x : by rw [add_mul]
          ... = nat.succ n * degree x : rfl,
      have : (x ^ n ≠ 0),
        from pow_ne_zero _ h,
      exact mul_ne_zero h this,
    },
  }
end

--naming?
lemma degree_finsupp_prod {f : polynomial α →₀ ℕ} (h1 : finsupp.prod f (λ x n, x^n) ≠ 0): degree (finsupp.prod f (λ x n, x^n)) = finsupp.sum f (λ x n, n*(degree x)):=
begin
  rw [finsupp.prod, degree_prod h1, finsupp.sum],
  simp [(∘), * , degree_pow],
end

--naming?
lemma leading_coeff_mul_eq_mul_leading_coef {f g : polynomial α} : leading_coeff (f * g) = leading_coeff f * leading_coeff g :=
begin
  by_cases h1 : (f * g = 0),
  {
    simp * at *,
    cases eq_zero_or_eq_zero_of_mul_eq_zero _ _ h1 with h2 ; {simp *},
  },
  {
    have : degree (f * g) = degree f + degree g,
      from degree_mul_eq_add_of_mul_ne_zero h1,
    simp [leading_coeff, this, mul_degree_add_degree_eq_leading_coeff_mul_leading_coeff]
  }
end

lemma monic_mul_of_monic_of_monic {a b : polynomial α} (ha : monic a) (hb : monic b) : monic (a * b) :=
begin
  simp [monic, leading_coeff_mul_eq_mul_leading_coef, *] at *,
end

lemma monic_prod_of_forall_mem_monic [comm_semiring α] {s : multiset (polynomial α)} (hs: ∀x ∈ s, monic x) : monic s.prod :=
begin
  revert hs,
  apply multiset.induction_on s,
  {
    simp * at *,
  },
  {
    intros a s h1 h2,
    simp * at *,
    have ha : monic a,
    {
      simp * at *,
    },
    have hs : monic (multiset.prod s),
    {
      apply h1,
      intros x s,
      simp * at *,
    },
    exact monic_mul_of_monic_of_monic ha hs,
  }
end

lemma not_is_constant_mul_of_not_is_constant_of_ne_zero (p q : polynomial α)
(h1 : ¬ is_constant p)(h2 : q ≠ 0) : ¬ is_constant (p * q) :=
begin
  intro h,
  by_cases hc : p * q = 0,
  {
    have h6 : p = 0 ∨ q = 0,
      from eq_zero_or_eq_zero_of_mul_eq_zero _ _ hc,
    cases h6 ; simp * at *,
  },
  {
    have : degree (p*q) = degree p + degree q,
      from degree_mul_eq_add_of_mul_ne_zero hc,
    have h3 : degree (p*q) = 0,
    { rwa [←is_constant_iff_degree_eq_zero]},
    have h4 : degree p > 0,
    { rwa [nat.pos_iff_ne_zero, ne.def, ←is_constant_iff_degree_eq_zero]},
    have h6 : degree p + degree q > 0,
      from nat.add_pos_left h4 _,
    simp [*] at *,
    exact nat.not_lt_zero _ h6,
  },
end

--Should be in lib, used it on two spots already.
lemma one_le_of_ne_zero {n : ℕ} : n ≠ 0 → 1 ≤ n := --is also used in MS, hence can't make private.
begin
  intro h1,
  induction n,
  {
    contradiction,
  },
  {
    simp [nat.succ_le_succ, nat.zero_le],
  }
end

--naming?
lemma is_constant_add {a b c : polynomial α} (h1 : is_constant a) (h2 : is_constant b) (h_add : a + b = c): is_constant c :=
begin
  have h3 : degree (a + b) ≤ max (degree a) (degree b),
    from degree_add,
  rw is_constant_iff_degree_eq_zero at *,
  simp * at *,
  exact nat.eq_zero_of_le_zero h3,
end

lemma degree_eq_zero_of_is_unit {p : polynomial α}(h : is_unit p) : degree p = 0 :=
begin
  have h1 : ∃(r : polynomial α), p * r = 1,
  {
    rcases h with ⟨u, hu⟩,
    fapply exists.intro u.inv,
    subst hu,
    rw [←units.inv_coe, units.mul_inv],
  },
  let r := some h1,
  have h2 : p * r = 1,
  from some_spec h1,
  have h3 : p * r ≠ 0,
  {
    calc p * r = 1 : h2
    ... ≠ 0 : by simp
  },
  have h4 : degree (p*r) = degree p + degree r,
  simp [degree_mul_eq_add_of_mul_ne_zero h3],
  rw h2 at h4,
  simp at h4,
  exact nat.eq_zero_of_add_eq_zero_right (eq.symm h4),
end

lemma is_constant_of_is_unit {p : polynomial α}(h : is_unit p) : is_constant p :=
begin
  have h1 : degree p = 0,
  from degree_eq_zero_of_is_unit h,
  rw is_constant,
  exact is_constant_of_degree_eq_zero h1,
end

--Naming is incorrect, need C in the name here
lemma is_unit_of_is_unit {a : α}(h1 : is_unit a) : is_unit (C a) :=
begin
  simp [is_unit] at *,
  rcases h1 with ⟨u, hu⟩,
  let Cu : units (polynomial α):=
  {
    val := C u.val,
    inv := C u.inv,
    val_inv := by rw [←C_mul_C, u.val_inv, C_1],
    inv_val := by rw [←C_mul_C, u.inv_val, C_1]
  },
  exact ⟨Cu, by simp [hu, units.val_coe]⟩,
end

lemma eq_one_of_monic_unit  {f : polynomial α}(h1 : monic f) (h2 : is_unit f) : f = 1 :=
begin
  rw monic at *,
  have h3 : ∃c : α, f =  C c,
  from is_constant_of_is_unit h2,
  let c := some h3,
  have h4 : f = C c,
  from some_spec h3,
  rw [h4, leading_coeff_C] at h1,
  rw h1 at h4,
  simp at h4,
  assumption
end

--lemma monic polynomials are associated iff they are equal.
lemma associated_iff_eq_of_monic_of_monic {x y : polynomial α}(h1 : monic x)(h2 : monic y) : (x ~ᵤ y) ↔ x = y :=
begin
  constructor,
  {
     intro h3,
     rw associated at h3,
     let u:= some h3,
     have h4 : x = ↑u * y,
     from some_spec h3,
     rw monic at *,
     have h5 : leading_coeff (↑u * y) = (leading_coeff ↑u) * (leading_coeff y),
     from leading_coeff_mul_eq_mul_leading_coef,
     rw [←h4, h1, h2] at h5,
     have h6 : leading_coeff (↑u : polynomial α) = 1,
     {simp at h5, exact eq.symm h5},
     have h7 : is_unit (↑u : polynomial α ),
     {
       constructor,
       swap,
       exact u,
       exact rfl
     },
     have h8 : monic (↑u : polynomial α ),
     from h6,
     have h9 : (↑u : polynomial α ) = 1,
     from eq_one_of_monic_unit h8 h7,
     rw h9 at h4,
     simp [h4]

  },
  {
    intro h3,
    simp [h3]
  }
end

lemma eq_C_leading_coeff_of_is_unit {a : polynomial α} (h : is_unit a) : a = C (leading_coeff a) :=
begin
  have : ∃c : α, a =  C c,
    from is_constant_of_is_unit h,
  rcases this with ⟨c, hc⟩,
  subst hc,
  simp [leading_coeff_C],
end

end integral_domain
end polynomial


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Chris Hughes, Morenikeji Neri
-/

import algebra.euclidean_domain ring_theory.ideals

variables {α : Type*} [comm_ring α]

open set function is_ideal
local attribute [instance] classical.prop_decidable

class is_principal_ideal (S : set α) : Prop :=
(principal : ∃ a : α, S = {x | a ∣ x})

class principal_ideal_domain (α : Type*) extends integral_domain α :=
(principal : ∀ (S : set α) [is_ideal S], is_principal_ideal S)

namespace is_principal_ideal

noncomputable def generator (S : set α) [is_principal_ideal S] : α :=
classical.some (principal S)

lemma generator_generates (S : set α) [is_principal_ideal S] : {x | generator S ∣ x} = S :=
eq.symm (classical.some_spec (principal S))

@[simp] lemma generator_mem (S : set α) [is_principal_ideal S] : generator S ∈ S :=
by conv {to_rhs, rw ← generator_generates S}; exact dvd_refl _

lemma mem_iff_generator_dvd (S : set α) [is_principal_ideal S] {x : α} : x ∈ S ↔ generator S ∣ x :=
by conv {to_lhs, rw ← generator_generates S}; refl

lemma eq_trivial_iff_generator_eq_zero (S : set α) [is_principal_ideal S] :
  S = trivial α ↔ generator S = 0 :=
⟨λ h, by rw [← mem_trivial, ← h]; exact generator_mem S,
  λ h, set.ext $ λ x, by rw [mem_iff_generator_dvd S, h, zero_dvd_iff, mem_trivial]⟩

instance to_is_ideal (S : set α) [is_principal_ideal S] : is_ideal S :=
{ to_is_submodule :=
  { zero_ := by rw ← generator_generates S; simp,
    add_ := λ x y h, by rw ← generator_generates S at *; exact (dvd_add_iff_right h).1,
    smul := λ c x h, by rw ← generator_generates S at h ⊢; exact dvd_mul_of_dvd_right h _ } }

end is_principal_ideal

open euclidean_domain is_principal_ideal is_ideal

lemma mod_mem_iff {α : Type*} [euclidean_domain α] {S : set α} [is_ideal S] {x y : α}
  (hy : y ∈ S) : x % y ∈ S ↔ x ∈ S :=
⟨λ hxy, div_add_mod x y ▸ is_ideal.add (is_ideal.mul_right hy) hxy,
  λ hx, (mod_eq_sub_mul_div x y).symm ▸ is_ideal.sub hx (is_ideal.mul_right hy)⟩

instance euclidean_domain.to_principal_ideal_domain {α : Type*} [euclidean_domain α] :
  principal_ideal_domain α :=
{ principal := λ S h, by exactI
    ⟨if h : {x : α | x ∈ S ∧ x ≠ 0} = ∅
    then ⟨0, set.ext $ λ a, ⟨by finish [set.ext_iff],
            λ h₁, (show a = 0, by simpa using h₁).symm ▸ is_ideal.zero S⟩⟩
    else
    have wf : well_founded euclidean_domain.r := euclidean_domain.r_well_founded α,
    have hmin : well_founded.min wf {x : α | x ∈ S ∧ x ≠ 0} h ∈ S ∧
        well_founded.min wf {x : α | x ∈ S ∧ x ≠ 0} h ≠ 0,
      from well_founded.min_mem wf {x : α | x ∈ S ∧ x ≠ 0} h,
    ⟨well_founded.min wf {x : α | x ∈ S ∧ x ≠ 0} h,
      set.ext $ λ x,
      ⟨λ hx, div_add_mod x (well_founded.min wf {x : α | x ∈ S ∧ x ≠ 0} h) ▸
        dvd_add (dvd_mul_right _ _)
        (have (x % (well_founded.min wf {x : α | x ∈ S ∧ x ≠ 0} h) ∉ {x : α | x ∈ S ∧ x ≠ 0}),
          from λ h₁, well_founded.not_lt_min wf _ h h₁ (mod_lt x hmin.2),
        have x % well_founded.min wf {x : α | x ∈ S ∧ x ≠ 0} h = 0, by finish [(mod_mem_iff hmin.1).2 hx],
        by simp *),
      λ hx, let ⟨y, hy⟩ := hx in hy.symm ▸ is_ideal.mul_right hmin.1⟩⟩⟩ }

lemma is_prime_ideal.to_maximal_ideal {α : Type*} [principal_ideal_domain α] {S : set α}
  [hpi : is_prime_ideal S] (hS : S ≠ trivial α) : is_maximal_ideal S :=
is_maximal_ideal.mk _ (is_proper_ideal_iff_one_not_mem.1 (by apply_instance))
begin
  assume x T i hST hxS hxT,
  haveI := principal_ideal_domain.principal S,
  haveI := principal_ideal_domain.principal T,
  cases (mem_iff_generator_dvd _).1 (hST ((mem_iff_generator_dvd _).2 (dvd_refl _))) with z hz,
  cases is_prime_ideal.mem_or_mem_of_mul_mem (show generator T * z ∈ S,
    by rw [mem_iff_generator_dvd S, ← hz]),
  { have hST' : S = T := set.subset.antisymm hST
      (λ y hyT, (mem_iff_generator_dvd _).2
        (dvd.trans ((mem_iff_generator_dvd _).1 h) ((mem_iff_generator_dvd _).1 hyT))),
    cc },
  { cases (mem_iff_generator_dvd _).1 h with y hy,
    rw [← mul_one (generator S), hy, mul_left_comm,
      domain.mul_left_inj (mt (eq_trivial_iff_generator_eq_zero S).2 hS)] at hz,
    exact hz.symm ▸ is_ideal.mul_right (generator_mem T) }
end


import tactic

namespace paulo

class group (G : Type) extends has_mul G, has_one G, has_inv G :=
(mul_assoc : ∀ (a b c : G), a * b * c = a * (b * c))
(one_mul : ∀ (a : G), 1 * a = a)
(mul_left_inv : ∀ (a : G), a⁻¹ * a = 1)

variables {G: Type} [group G]

namespace group

def is_abelian (G : Type) [group G] :=
∀ (a b : G), a * b = b * a

structure subgroup (G : Type) [group G] :=
(carrier : set G)
(one_mem' : (1 : G) ∈ carrier)
(mul_mem' {x y} : x ∈ carrier → y ∈ carrier → x * y ∈ carrier)
(inv_mem' {x} : x ∈ carrier → x⁻¹ ∈ carrier)

variables (H : subgroup G)

instance : has_mem G (subgroup G) := ⟨λ m H, m ∈ H.carrier⟩

instance : has_coe (subgroup G) (set G) := ⟨λ H, H.carrier⟩

@[simp] lemma mem_carrier
  {g : G}
  : g ∈ H.carrier ↔ g ∈ H :=
by refl

theorem one_mem :
  (1 : G) ∈ H :=
by apply H.one_mem'

/-- A subgroup is closed under multiplication. -/
theorem mul_mem
  {x y : G}
  : x ∈ H → y ∈ H → x * y ∈ H :=
by apply H.mul_mem'

/-- A subgroup is closed under inverse -/
theorem inv_mem
  {x : G}
  : x ∈ H → x⁻¹ ∈ H :=
by apply H.inv_mem'

@[simp] lemma mem_coe
  {g : G}
  : g ∈ (↑H : set G) ↔ g ∈ H :=
by refl

namespace subgroup

def is_normal_subgroup := ∀ (g : G), ∀ (h : H), g*h*g⁻¹ ∈ H

lemma abelian_subgroups_normal
  {G₁ : Type}
  [group G₁]
  (hyp : is_abelian G₁)
  (H₁ : subgroup G₁)
  : is_normal_subgroup H₁ :=
begin
  intros g h,
  unfold is_abelian at hyp,
  rw hyp,
  rw ← mul_assoc,
  rw mul_left_inv,
  rw one_mul,
  cases h with actual_h h_proof,
  exact h_proof,
end

end subgroup

end group

end paulo