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

! This file was ported from Lean 3 source module data.polynomial.taylor
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Polynomial.AlgebraMap
import Mathlib.Data.Polynomial.HasseDeriv
import Mathlib.Data.Polynomial.Degree.Lemmas

/-!
# Taylor expansions of polynomials

## Main declarations

* `Polynomial.taylor`: the Taylor expansion of the polynomial `f` at `r`
* `Polynomial.taylor_coeff`: the `k`th coefficient of `taylor r f` is
  `(Polynomial.hasseDeriv k f).eval r`
* `Polynomial.eq_zero_of_hasseDeriv_eq_zero`:
  the identity principle: a polynomial is 0 iff all its Hasse derivatives are zero

-/

noncomputable section

namespace Polynomial

open Polynomial

variable {R : Type _} [Semiring R] (r : R) (f : R[X])

/-- The Taylor expansion of a polynomial `f` at `r`. -/
def taylor (r : R) : R[X] →ₗ[R] R[X] where
  toFun f := f.comp (X + C r)
  map_add' f g := add_comp
  map_smul' c f := by simp only [smul_eq_C_mul, C_mul_comp, RingHom.id_apply]
#align polynomial.taylor Polynomial.taylor

theorem taylor_apply : taylor r f = f.comp (X + C r) :=
  rfl
#align polynomial.taylor_apply Polynomial.taylor_apply

@[simp]
theorem taylor_X : taylor r X = X + C r := by simp only [taylor_apply, X_comp]
set_option linter.uppercaseLean3 false in
#align polynomial.taylor_X Polynomial.taylor_X

@[simp]
theorem taylor_C (x : R) : taylor r (C x) = C x := by simp only [taylor_apply, C_comp]
set_option linter.uppercaseLean3 false in
#align polynomial.taylor_C Polynomial.taylor_C

@[simp]
theorem taylor_zero' : taylor (0 : R) = LinearMap.id := by
  ext
  simp only [taylor_apply, add_zero, comp_X, _root_.map_zero, LinearMap.id_comp,
    Function.comp_apply, LinearMap.coe_comp]
#align polynomial.taylor_zero' Polynomial.taylor_zero'

theorem taylor_zero (f : R[X]) : taylor 0 f = f := by rw [taylor_zero', LinearMap.id_apply]
#align polynomial.taylor_zero Polynomial.taylor_zero

@[simp]
theorem taylor_one : taylor r (1 : R[X]) = C 1 := by rw [← C_1, taylor_C]
#align polynomial.taylor_one Polynomial.taylor_one

@[simp]
theorem taylor_monomial (i : ℕ) (k : R) : taylor r (monomial i k) = C k * (X + C r) ^ i := by
  simp [taylor_apply]
#align polynomial.taylor_monomial Polynomial.taylor_monomial

/-- The `k`th coefficient of `Polynomial.taylor r f` is `(Polynomial.hasseDeriv k f).eval r`. -/
theorem taylor_coeff (n : ℕ) : (taylor r f).coeff n = (hasseDeriv n f).eval r :=
  show (lcoeff R n).comp (taylor r) f = (leval r).comp (hasseDeriv n) f by
    congr 1; clear! f; ext i
    simp only [leval_apply, mul_one, one_mul, eval_monomial, LinearMap.comp_apply, coeff_C_mul,
      hasseDeriv_monomial, taylor_apply, monomial_comp, C_1, (commute_X (C r)).add_pow i,
      LinearMap.map_sum]
    simp only [lcoeff_apply, ← C_eq_nat_cast, mul_assoc, ← C_pow, ← C_mul, coeff_mul_C,
      (Nat.cast_commute _ _).eq, coeff_X_pow, boole_mul, Finset.sum_ite_eq, Finset.mem_range]
    split_ifs with h; · rfl
    push_neg at h; rw [Nat.choose_eq_zero_of_lt h, Nat.cast_zero, MulZeroClass.mul_zero]
#align polynomial.taylor_coeff Polynomial.taylor_coeff

@[simp]
theorem taylor_coeff_zero : (taylor r f).coeff 0 = f.eval r := by
  rw [taylor_coeff, hasseDeriv_zero, LinearMap.id_apply]
#align polynomial.taylor_coeff_zero Polynomial.taylor_coeff_zero

@[simp]
theorem taylor_coeff_one : (taylor r f).coeff 1 = f.derivative.eval r := by
  rw [taylor_coeff, hasseDeriv_one]
#align polynomial.taylor_coeff_one Polynomial.taylor_coeff_one

@[simp]
theorem natDegree_taylor (p : R[X]) (r : R) : natDegree (taylor r p) = natDegree p := by
  refine' map_natDegree_eq_natDegree _ _
  nontriviality R
  intro n c c0
  simp [taylor_monomial, natDegree_c_mul_eq_of_mul_ne_zero, natDegree_pow_X_add_c, c0]
#align polynomial.nat_degree_taylor Polynomial.natDegree_taylor

@[simp]
theorem taylor_mul {R} [CommSemiring R] (r : R) (p q : R[X]) :
    taylor r (p * q) = taylor r p * taylor r q := by simp only [taylor_apply, mul_comp]
#align polynomial.taylor_mul Polynomial.taylor_mul

/-- `Polynomial.taylor` as an `AlgHom` for commutative semirings -/
@[simps!]
def taylorAlgHom {R} [CommSemiring R] (r : R) : R[X] →ₐ[R] R[X] :=
  AlgHom.ofLinearMap (taylor r) (taylor_one r) (taylor_mul r)
#align polynomial.taylor_alg_hom Polynomial.taylorAlgHom

theorem taylor_taylor {R} [CommSemiring R] (f : R[X]) (r s : R) :
    taylor r (taylor s f) = taylor (r + s) f := by
  simp only [taylor_apply, comp_assoc, map_add, add_comp, X_comp, C_comp, C_add, add_assoc]
#align polynomial.taylor_taylor Polynomial.taylor_taylor

theorem taylor_eval {R} [CommSemiring R] (r : R) (f : R[X]) (s : R) :
    (taylor r f).eval s = f.eval (s + r) := by
  simp only [taylor_apply, eval_comp, eval_C, eval_X, eval_add]
#align polynomial.taylor_eval Polynomial.taylor_eval

theorem taylor_eval_sub {R} [CommRing R] (r : R) (f : R[X]) (s : R) :
    (taylor r f).eval (s - r) = f.eval s := by rw [taylor_eval, sub_add_cancel]
#align polynomial.taylor_eval_sub Polynomial.taylor_eval_sub

theorem taylor_injective {R} [CommRing R] (r : R) : Function.Injective (taylor r) := by
  intro f g h
  apply_fun taylor (-r) at h
  simpa only [taylor_apply, comp_assoc, add_comp, X_comp, C_comp, C_neg, neg_add_cancel_right,
    comp_X] using h
#align polynomial.taylor_injective Polynomial.taylor_injective

theorem eq_zero_of_hasseDeriv_eq_zero {R} [CommRing R] (f : R[X]) (r : R)
    (h : ∀ k, (hasseDeriv k f).eval r = 0) : f = 0 := by
  apply taylor_injective r
  rw [LinearMap.map_zero]
  ext k
  simp only [taylor_coeff, h, coeff_zero]
#align polynomial.eq_zero_of_hasse_deriv_eq_zero Polynomial.eq_zero_of_hasseDeriv_eq_zero

/-- Taylor's formula. -/
theorem sum_taylor_eq {R} [CommRing R] (f : R[X]) (r : R) :
    ((taylor r f).sum fun i a => C a * (X - C r) ^ i) = f := by
  rw [← comp_eq_sum_left, sub_eq_add_neg, ← C_neg, ← taylor_apply, taylor_taylor, neg_add_self,
    taylor_zero]
#align polynomial.sum_taylor_eq Polynomial.sum_taylor_eq

end Polynomial


/-
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
-/
import algebra.order.group
import algebra.order.sub
import data.set.intervals.basic

/-!
# Ordered rings and semirings

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

Each typeclass here comprises
* an algebraic class (`semiring`, `comm_semiring`, `ring`, `comm_ring`)
* an order class (`partial_order`, `linear_order`)
* assumptions on how both interact ((strict) monotonicity, canonicity)

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

## Typeclasses

* `ordered_semiring`: Semiring with a partial order such that `+` respects `≤` and `*` respects `<`.
* `ordered_comm_semiring`: Commutative semiring with a partial order such that `+` respects `≤` and
  `*` respects `<`.
* `ordered_ring`: Ring with a partial order such that `+` respects `≤` and `*` respects `<`.
* `ordered_comm_ring`: Commutative ring with a partial order such that `+` respects `≤` and
  `*` respects `<`.
* `linear_ordered_semiring`: Semiring with a linear order such that `+` respects `≤` and
  `*` respects `<`.
* `linear_ordered_ring`: Ring with a linear order such that `+` respects `≤` and `*` respects `<`.
* `linear_ordered_comm_ring`: Commutative ring with a linear order such that `+` respects `≤` and
  `*` respects `<`.
* `canonically_ordered_comm_semiring`: Commutative semiring with a partial order such that `+`
  respects `≤`, `*` respects `<`, and `a ≤ b ↔ ∃ c, b = a + c`.

and some typeclasses to define ordered rings by specifying their nonegative elements:
* `nonneg_ring`: To define `ordered_ring`s.
* `linear_nonneg_ring`: To define `linear_ordered_ring`s.

## 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.

* `ordered_semiring`
  - `ordered_cancel_add_comm_monoid` & multiplication & `*` respects `<`
  - `semiring` & partial order structure & `+` respects `≤` & `*` respects `<`
* `ordered_comm_semiring`
  - `ordered_semiring` & commutativity of multiplication
  - `comm_semiring` & partial order structure & `+` respects `≤` & `*` respects `<`
* `ordered_ring`
  - `ordered_semiring` & additive inverses
  - `ordered_add_comm_group` & multiplication & `*` respects `<`
  - `ring` & partial order structure & `+` respects `≤` & `*` respects `<`
* `ordered_comm_ring`
  - `ordered_ring` & commutativity of multiplication
  - `ordered_comm_semiring` & additive inverses
  - `comm_ring` & partial order structure & `+` respects `≤` & `*` respects `<`
* `linear_ordered_semiring`
  - `ordered_semiring` & totality of the order & nontriviality
  - `linear_ordered_add_comm_monoid` & multiplication & nontriviality & `*` respects `<`
* `linear_ordered_ring`
  - `ordered_ring` & totality of the order & nontriviality
  - `linear_ordered_semiring` & additive inverses
  - `linear_ordered_add_comm_group` & multiplication & `*` respects `<`
  - `domain` & linear order structure
* `linear_ordered_comm_ring`
  - `ordered_comm_ring` & totality of the order & nontriviality
  - `linear_ordered_ring` & commutativity of multiplication
  - `is_domain` & linear order structure
* `canonically_ordered_comm_semiring`
  - `canonically_ordered_add_monoid` & multiplication & `*` respects `<` & no zero divisors
  - `comm_semiring` & `a ≤ b ↔ ∃ c, b = a + c` & no zero divisors

## TODO

We're still missing some typeclasses, like
* `linear_ordered_comm_semiring`
* `canonically_ordered_semiring`
They have yet to come up in practice.
-/

set_option old_structure_cmd true

universe u
variable {α : Type u}

lemma add_one_le_two_mul [preorder α] [semiring α] [covariant_class α α (+) (≤)]
  {a : α} (a1 : 1 ≤ a) :
  a + 1 ≤ 2 * a :=
calc  a + 1 ≤ a + a : add_le_add_left a1 a
        ... = 2 * a : (two_mul _).symm

/-- An `ordered_semiring α` is a semiring `α` with a partial order such that
addition is monotone and multiplication by a positive number is strictly monotone. -/
@[protect_proj]
class ordered_semiring (α : Type u) extends semiring α, ordered_cancel_add_comm_monoid α :=
(zero_le_one : 0 ≤ (1 : α))
(mul_lt_mul_of_pos_left :  ∀ a b c : α, a < b → 0 < c → c * a < c * b)
(mul_lt_mul_of_pos_right : ∀ a b c : α, a < b → 0 < c → a * c < b * c)

section ordered_semiring
variables [ordered_semiring α] {a b c d : α}

@[simp] lemma zero_le_one : 0 ≤ (1:α) :=
ordered_semiring.zero_le_one

lemma zero_le_two : 0 ≤ (2:α) :=
add_nonneg zero_le_one zero_le_one

lemma one_le_two : 1 ≤ (2:α) :=
calc (1:α) = 0 + 1 : (zero_add _).symm
       ... ≤ 1 + 1 : add_le_add_right zero_le_one _

section nontrivial

variables [nontrivial α]

@[simp] lemma zero_lt_one : 0 < (1 : α) :=
lt_of_le_of_ne zero_le_one zero_ne_one

lemma zero_lt_two : 0 < (2:α) := add_pos zero_lt_one zero_lt_one

@[field_simps] lemma two_ne_zero : (2:α) ≠ 0 :=
ne.symm (ne_of_lt zero_lt_two)

lemma one_lt_two : 1 < (2:α) :=
calc (2:α) = 1+1 : one_add_one_eq_two
     ...   > 1+0 : add_lt_add_left zero_lt_one _
     ...   = 1   : add_zero 1

lemma zero_lt_three : 0 < (3:α) := add_pos zero_lt_two zero_lt_one

lemma zero_lt_four : 0 < (4:α) := add_pos zero_lt_two zero_lt_two

end nontrivial

lemma mul_lt_mul_of_pos_left (h₁ : a < b) (h₂ : 0 < c) : c * a < c * b :=
ordered_semiring.mul_lt_mul_of_pos_left a b c h₁ h₂

lemma mul_lt_mul_of_pos_right (h₁ : a < b) (h₂ : 0 < c) : a * c < b * c :=
ordered_semiring.mul_lt_mul_of_pos_right a b c h₁ h₂

-- See Note [decidable namespace]
protected lemma decidable.mul_le_mul_of_nonneg_left [@decidable_rel α (≤)]
  (h₁ : a ≤ b) (h₂ : 0 ≤ c) : c * a ≤ c * b :=
begin
  by_cases ba : b ≤ a, { simp [ba.antisymm h₁] },
  by_cases c0 : c ≤ 0, { simp [c0.antisymm h₂] },
  exact (mul_lt_mul_of_pos_left (h₁.lt_of_not_le ba) (h₂.lt_of_not_le c0)).le,
end

lemma mul_le_mul_of_nonneg_left : a ≤ b → 0 ≤ c → c * a ≤ c * b :=
by classical; exact decidable.mul_le_mul_of_nonneg_left

-- See Note [decidable namespace]
protected lemma decidable.mul_le_mul_of_nonneg_right [@decidable_rel α (≤)]
  (h₁ : a ≤ b) (h₂ : 0 ≤ c) : a * c ≤ b * c :=
begin
  by_cases ba : b ≤ a, { simp [ba.antisymm h₁] },
  by_cases c0 : c ≤ 0, { simp [c0.antisymm h₂] },
  exact (mul_lt_mul_of_pos_right (h₁.lt_of_not_le ba) (h₂.lt_of_not_le c0)).le,
end

lemma mul_le_mul_of_nonneg_right : a ≤ b → 0 ≤ c → a * c ≤ b * c :=
by classical; exact decidable.mul_le_mul_of_nonneg_right

-- TODO: there are four variations, depending on which variables we assume to be nonneg
-- See Note [decidable namespace]
protected lemma decidable.mul_le_mul [@decidable_rel α (≤)]
  (hac : a ≤ c) (hbd : b ≤ d) (nn_b : 0 ≤ b) (nn_c : 0 ≤ c) : a * b ≤ c * d :=
calc
  a * b ≤ c * b : decidable.mul_le_mul_of_nonneg_right hac nn_b
    ... ≤ c * d : decidable.mul_le_mul_of_nonneg_left hbd nn_c

lemma mul_le_mul : a ≤ c → b ≤ d → 0 ≤ b → 0 ≤ c → a * b ≤ c * d :=
by classical; exact decidable.mul_le_mul

-- See Note [decidable namespace]
protected lemma decidable.mul_nonneg_le_one_le {α : Type*} [ordered_semiring α]
  [@decidable_rel α (≤)] {a b c : α}
  (h₁ : 0 ≤ c) (h₂ : a ≤ c) (h₃ : 0 ≤ b) (h₄ : b ≤ 1) : a * b ≤ c :=
by simpa only [mul_one] using decidable.mul_le_mul h₂ h₄ h₃ h₁

lemma mul_nonneg_le_one_le {α : Type*} [ordered_semiring α] {a b c : α} :
  0 ≤ c → a ≤ c → 0 ≤ b → b ≤ 1 → a * b ≤ c :=
by classical; exact decidable.mul_nonneg_le_one_le

-- See Note [decidable namespace]
protected lemma decidable.mul_nonneg [@decidable_rel α (≤)]
  (ha : 0 ≤ a) (hb : 0 ≤ b) : 0 ≤ a * b :=
have h : 0 * b ≤ a * b, from decidable.mul_le_mul_of_nonneg_right ha hb,
by rwa [zero_mul] at h

lemma mul_nonneg : 0 ≤ a → 0 ≤ b → 0 ≤ a * b := by classical; exact decidable.mul_nonneg

-- See Note [decidable namespace]
protected lemma decidable.mul_nonpos_of_nonneg_of_nonpos [@decidable_rel α (≤)]
  (ha : 0 ≤ a) (hb : b ≤ 0) : a * b ≤ 0 :=
have h : a * b ≤ a * 0, from decidable.mul_le_mul_of_nonneg_left hb ha,
by rwa mul_zero at h

lemma mul_nonpos_of_nonneg_of_nonpos : 0 ≤ a → b ≤ 0 → a * b ≤ 0 :=
 by classical; exact decidable.mul_nonpos_of_nonneg_of_nonpos

-- See Note [decidable namespace]
protected lemma decidable.mul_nonpos_of_nonpos_of_nonneg [@decidable_rel α (≤)]
  (ha : a ≤ 0) (hb : 0 ≤ b) : a * b ≤ 0 :=
have h : a * b ≤ 0 * b, from decidable.mul_le_mul_of_nonneg_right ha hb,
by rwa zero_mul at h

lemma mul_nonpos_of_nonpos_of_nonneg : a ≤ 0 → 0 ≤ b → a * b ≤ 0 :=
by classical; exact decidable.mul_nonpos_of_nonpos_of_nonneg

-- See Note [decidable namespace]
protected lemma decidable.mul_lt_mul [@decidable_rel α (≤)]
  (hac : a < c) (hbd : b ≤ d) (pos_b : 0 < b) (nn_c : 0 ≤ c) : a * b < c * d :=
calc
  a * b < c * b : mul_lt_mul_of_pos_right hac pos_b
    ... ≤ c * d : decidable.mul_le_mul_of_nonneg_left hbd nn_c

lemma mul_lt_mul : a < c → b ≤ d → 0 < b → 0 ≤ c → a * b < c * d :=
by classical; exact decidable.mul_lt_mul

-- See Note [decidable namespace]
protected lemma decidable.mul_lt_mul' [@decidable_rel α (≤)]
  (h1 : a ≤ c) (h2 : b < d) (h3 : 0 ≤ b) (h4 : 0 < c) : a * b < c * d :=
calc
   a * b ≤ c * b : decidable.mul_le_mul_of_nonneg_right h1 h3
     ... < c * d : mul_lt_mul_of_pos_left h2 h4

lemma mul_lt_mul' : a ≤ c → b < d → 0 ≤ b → 0 < c → a * b < c * d :=
by classical; exact decidable.mul_lt_mul'

lemma mul_pos (ha : 0 < a) (hb : 0 < b) : 0 < a * b :=
have h : 0 * b < a * b, from mul_lt_mul_of_pos_right ha hb,
by rwa zero_mul at h

lemma mul_neg_of_pos_of_neg (ha : 0 < a) (hb : b < 0) : a * b < 0 :=
have h : a * b < a * 0, from mul_lt_mul_of_pos_left hb ha,
by rwa mul_zero at h

lemma mul_neg_of_neg_of_pos (ha : a < 0) (hb : 0 < b) : a * b < 0 :=
have h : a * b < 0 * b, from mul_lt_mul_of_pos_right ha hb,
by rwa zero_mul at  h

-- See Note [decidable namespace]
protected lemma decidable.mul_self_lt_mul_self [@decidable_rel α (≤)]
  (h1 : 0 ≤ a) (h2 : a < b) : a * a < b * b :=
decidable.mul_lt_mul' h2.le h2 h1 $ h1.trans_lt h2

lemma 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

-- See Note [decidable namespace]
protected lemma decidable.strict_mono_on_mul_self [@decidable_rel α (≤)] :
  strict_mono_on (λ x : α, x * x) (set.Ici 0) :=
λ x hx y hy hxy, decidable.mul_self_lt_mul_self hx hxy

lemma strict_mono_on_mul_self : strict_mono_on (λ x : α, x * x) (set.Ici 0) :=
λ x hx y hy hxy, mul_self_lt_mul_self hx hxy

-- See Note [decidable namespace]
protected lemma decidable.mul_self_le_mul_self [@decidable_rel α (≤)]
  (h1 : 0 ≤ a) (h2 : a ≤ b) : a * a ≤ b * b :=
decidable.mul_le_mul h2 h2 h1 $ h1.trans h2

lemma mul_self_le_mul_self (h1 : 0 ≤ a) (h2 : a ≤ b) : a * a ≤ b * b :=
mul_le_mul h2 h2 h1 $ h1.trans h2

-- See Note [decidable namespace]
protected lemma decidable.mul_lt_mul'' [@decidable_rel α (≤)]
  (h1 : a < c) (h2 : b < d) (h3 : 0 ≤ a) (h4 : 0 ≤ b) : a * b < c * d :=
h4.lt_or_eq_dec.elim
  (λ b0, decidable.mul_lt_mul h1 h2.le b0 $ h3.trans h1.le)
  (λ b0, by rw [← b0, mul_zero]; exact
    mul_pos (h3.trans_lt h1) (h4.trans_lt h2))

lemma mul_lt_mul'' : a < c → b < d → 0 ≤ a → 0 ≤ b → a * b < c * d :=
by classical; exact decidable.mul_lt_mul''

-- See Note [decidable namespace]
protected lemma decidable.le_mul_of_one_le_right [@decidable_rel α (≤)]
  (hb : 0 ≤ b) (h : 1 ≤ a) : b ≤ b * a :=
suffices b * 1 ≤ b * a, by rwa mul_one at this,
decidable.mul_le_mul_of_nonneg_left h hb

lemma le_mul_of_one_le_right : 0 ≤ b → 1 ≤ a → b ≤ b * a :=
by classical; exact decidable.le_mul_of_one_le_right

-- See Note [decidable namespace]
protected lemma decidable.le_mul_of_one_le_left [@decidable_rel α (≤)]
  (hb : 0 ≤ b) (h : 1 ≤ a) : b ≤ a * b :=
suffices 1 * b ≤ a * b, by rwa one_mul at this,
decidable.mul_le_mul_of_nonneg_right h hb

lemma le_mul_of_one_le_left : 0 ≤ b → 1 ≤ a → b ≤ a * b :=
by classical; exact decidable.le_mul_of_one_le_left

-- See Note [decidable namespace]
protected lemma decidable.lt_mul_of_one_lt_right [@decidable_rel α (≤)]
  (hb : 0 < b) (h : 1 < a) : b < b * a :=
suffices b * 1 < b * a, by rwa mul_one at this,
decidable.mul_lt_mul' le_rfl h zero_le_one hb

lemma lt_mul_of_one_lt_right : 0 < b → 1 < a → b < b * a :=
by classical; exact decidable.lt_mul_of_one_lt_right

-- See Note [decidable namespace]
protected lemma decidable.lt_mul_of_one_lt_left [@decidable_rel α (≤)]
  (hb : 0 < b) (h : 1 < a) : b < a * b :=
suffices 1 * b < a * b, by rwa one_mul at this,
decidable.mul_lt_mul h le_rfl hb (zero_le_one.trans h.le)

lemma lt_mul_of_one_lt_left : 0 < b → 1 < a → b < a * b :=
by classical; exact decidable.lt_mul_of_one_lt_left

-- See Note [decidable namespace]
protected lemma decidable.add_le_mul_two_add [@decidable_rel α (≤)] {a b : α}
  (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 (decidable.le_mul_of_one_le_left b0 (one_le_two.trans a2))) a
             ... ≤ a * (2 + b) : by rw [mul_add, mul_two, add_assoc]

lemma add_le_mul_two_add {a b : α} : 2 ≤ a → 0 ≤ b → a + (2 + b) ≤ a * (2 + b) :=
by classical; exact decidable.add_le_mul_two_add

-- See Note [decidable namespace]
protected lemma decidable.one_le_mul_of_one_le_of_one_le [@decidable_rel α (≤)]
  {a b : α} (a1 : 1 ≤ a) (b1 : 1 ≤ b) : (1 : α) ≤ a * b :=
(mul_one (1 : α)).symm.le.trans (decidable.mul_le_mul a1 b1 zero_le_one (zero_le_one.trans a1))

lemma one_le_mul_of_one_le_of_one_le {a b : α} : 1 ≤ a → 1 ≤ b → (1 : α) ≤ a * b :=
by classical; exact decidable.one_le_mul_of_one_le_of_one_le

/-- Pullback an `ordered_semiring` under an injective map.
See note [reducible non-instances]. -/
@[reducible]
def function.injective.ordered_semiring {β : Type*}
  [has_zero β] [has_one β] [has_add β] [has_mul β]
  (f : β → α) (hf : function.injective f) (zero : f 0 = 0) (one : f 1 = 1)
  (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) :
  ordered_semiring β :=
{ zero_le_one := show f 0 ≤ f 1, by simp only [zero, one, zero_le_one],
  mul_lt_mul_of_pos_left := λ  a b c ab c0, show f (c * a) < f (c * b),
    begin
      rw [mul, mul],
      refine mul_lt_mul_of_pos_left ab _,
      rwa ← zero,
    end,
  mul_lt_mul_of_pos_right := λ a b c ab c0, show f (a * c) < f (b * c),
    begin
      rw [mul, mul],
      refine mul_lt_mul_of_pos_right ab _,
      rwa ← zero,
    end,
  ..hf.ordered_cancel_add_comm_monoid f zero add,
  ..hf.semiring f zero one add mul }

section
variable [nontrivial α]

lemma bit1_pos (h : 0 ≤ a) : 0 < bit1 a :=
lt_add_of_le_of_pos (add_nonneg h h) zero_lt_one

lemma lt_add_one (a : α) : a < a + 1 :=
lt_add_of_le_of_pos le_rfl zero_lt_one

lemma lt_one_add (a : α) : a < 1 + a :=
by { rw [add_comm], apply lt_add_one }

end

lemma bit1_pos' (h : 0 < a) : 0 < bit1 a :=
begin
  nontriviality,
  exact bit1_pos h.le,
end

-- See Note [decidable namespace]
protected lemma decidable.one_lt_mul [@decidable_rel α (≤)]
  (ha : 1 ≤ a) (hb : 1 < b) : 1 < a * b :=
begin
  nontriviality,
  exact (one_mul (1 : α)) ▸ decidable.mul_lt_mul' ha hb zero_le_one (zero_lt_one.trans_le ha)
end

lemma one_lt_mul : 1 ≤ a → 1 < b → 1 < a * b :=
by classical; exact decidable.one_lt_mul

-- See Note [decidable namespace]
protected lemma decidable.mul_le_one [@decidable_rel α (≤)]
  (ha : a ≤ 1) (hb' : 0 ≤ b) (hb : b ≤ 1) : a * b ≤ 1 :=
begin rw ← one_mul (1 : α), apply decidable.mul_le_mul; {assumption <|> apply zero_le_one} end

lemma mul_le_one : a ≤ 1 → 0 ≤ b → b ≤ 1 → a * b ≤ 1 :=
by classical; exact decidable.mul_le_one

-- See Note [decidable namespace]
protected lemma decidable.one_lt_mul_of_le_of_lt [@decidable_rel α (≤)]
  (ha : 1 ≤ a) (hb : 1 < b) : 1 < a * b :=
begin
  nontriviality,
  calc 1 = 1 * 1 : by rw one_mul
     ... < a * b : decidable.mul_lt_mul' ha hb zero_le_one (zero_lt_one.trans_le ha)
end

lemma one_lt_mul_of_le_of_lt : 1 ≤ a → 1 < b → 1 < a * b :=
by classical; exact decidable.one_lt_mul_of_le_of_lt

-- See Note [decidable namespace]
protected lemma decidable.one_lt_mul_of_lt_of_le [@decidable_rel α (≤)]
  (ha : 1 < a) (hb : 1 ≤ b) : 1 < a * b :=
begin
  nontriviality,
  calc 1 = 1 * 1 : by rw one_mul
    ... < a * b : decidable.mul_lt_mul ha hb zero_lt_one $ zero_le_one.trans ha.le
end

lemma one_lt_mul_of_lt_of_le : 1 < a → 1 ≤ b → 1 < a * b :=
by classical; exact decidable.one_lt_mul_of_lt_of_le

-- See Note [decidable namespace]
protected lemma decidable.mul_le_of_le_one_right [@decidable_rel α (≤)]
  (ha : 0 ≤ a) (hb1 : b ≤ 1) : a * b ≤ a :=
calc a * b ≤ a * 1 : decidable.mul_le_mul_of_nonneg_left hb1 ha
... = a : mul_one a

lemma mul_le_of_le_one_right : 0 ≤ a → b ≤ 1 → a * b ≤ a :=
by classical; exact decidable.mul_le_of_le_one_right

-- See Note [decidable namespace]
protected lemma decidable.mul_le_of_le_one_left [@decidable_rel α (≤)]
  (hb : 0 ≤ b) (ha1 : a ≤ 1) : a * b ≤ b :=
calc a * b ≤ 1 * b : decidable.mul_le_mul ha1 le_rfl hb zero_le_one
... = b : one_mul b

lemma mul_le_of_le_one_left : 0 ≤ b → a ≤ 1 → a * b ≤ b :=
by classical; exact decidable.mul_le_of_le_one_left

-- See Note [decidable namespace]
protected lemma decidable.mul_lt_one_of_nonneg_of_lt_one_left [@decidable_rel α (≤)]
  (ha0 : 0 ≤ a) (ha : a < 1) (hb : b ≤ 1) : a * b < 1 :=
calc a * b ≤ a : decidable.mul_le_of_le_one_right ha0 hb
... < 1 : ha

lemma mul_lt_one_of_nonneg_of_lt_one_left : 0 ≤ a → a < 1 → b ≤ 1 → a * b < 1 :=
by classical; exact decidable.mul_lt_one_of_nonneg_of_lt_one_left

-- See Note [decidable namespace]
protected lemma decidable.mul_lt_one_of_nonneg_of_lt_one_right [@decidable_rel α (≤)]
  (ha : a ≤ 1) (hb0 : 0 ≤ b) (hb : b < 1) : a * b < 1 :=
calc a * b ≤ b : decidable.mul_le_of_le_one_left hb0 ha
... < 1 : hb

lemma mul_lt_one_of_nonneg_of_lt_one_right : a ≤ 1 → 0 ≤ b → b < 1 → a * b < 1 :=
by classical; exact decidable.mul_lt_one_of_nonneg_of_lt_one_right

end ordered_semiring

section ordered_comm_semiring

/-- An `ordered_comm_semiring α` is a commutative semiring `α` with a partial order such that
addition is monotone and multiplication by a positive number is strictly monotone. -/
@[protect_proj]
class ordered_comm_semiring (α : Type u) extends ordered_semiring α, comm_semiring α

/-- Pullback an `ordered_comm_semiring` under an injective map.
See note [reducible non-instances]. -/
@[reducible]
def function.injective.ordered_comm_semiring [ordered_comm_semiring α] {β : Type*}
  [has_zero β] [has_one β] [has_add β] [has_mul β]
  (f : β → α) (hf : function.injective f) (zero : f 0 = 0) (one : f 1 = 1)
  (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) :
  ordered_comm_semiring β :=
{ ..hf.comm_semiring f zero one add mul,
  ..hf.ordered_semiring f zero one add mul }

end ordered_comm_semiring

/--
A `linear_ordered_semiring α` is a nontrivial semiring `α` with a linear order
such that addition is monotone and multiplication by a positive number is strictly monotone.
-/
-- 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.
@[protect_proj]
class linear_ordered_semiring (α : Type u)
  extends ordered_semiring α, linear_ordered_add_comm_monoid α, nontrivial α

section linear_ordered_semiring
variables [linear_ordered_semiring α] {a b c d : α}

-- `norm_num` expects the lemma stating `0 < 1` to have a single typeclass argument
-- (see `norm_num.prove_pos_nat`).
-- Rather than working out how to relax that assumption,
-- we provide a synonym for `zero_lt_one` (which needs both `ordered_semiring α` and `nontrivial α`)
-- with only a `linear_ordered_semiring` typeclass argument.
lemma zero_lt_one' : 0 < (1 : α) := zero_lt_one

lemma lt_of_mul_lt_mul_left (h : c * a < c * b) (hc : 0 ≤ c) : a < b :=
by haveI := @linear_order.decidable_le α _; exact lt_of_not_ge
  (assume h1 : b ≤ a,
   have h2 : c * b ≤ c * a, from decidable.mul_le_mul_of_nonneg_left h1 hc,
   h2.not_lt h)

lemma lt_of_mul_lt_mul_right (h : a * c < b * c) (hc : 0 ≤ c) : a < b :=
by haveI := @linear_order.decidable_le α _; exact lt_of_not_ge
  (assume h1 : b ≤ a,
   have h2 : b * c ≤ a * c, from decidable.mul_le_mul_of_nonneg_right h1 hc,
   h2.not_lt h)

lemma le_of_mul_le_mul_left (h : c * a ≤ c * b) (hc : 0 < c) : a ≤ b :=
le_of_not_gt
  (assume h1 : b < a,
   have h2 : c * b < c * a, from mul_lt_mul_of_pos_left h1 hc,
   h2.not_le h)

lemma le_of_mul_le_mul_right (h : a * c ≤ b * c) (hc : 0 < c) : a ≤ b :=
le_of_not_gt
  (assume h1 : b < a,
   have h2 : b * c < a * c, from mul_lt_mul_of_pos_right h1 hc,
   h2.not_le h)

lemma pos_and_pos_or_neg_and_neg_of_mul_pos (hab : 0 < a * b) :
  (0 < a ∧ 0 < b) ∨ (a < 0 ∧ b < 0) :=
begin
  haveI := @linear_order.decidable_le α _,
  rcases lt_trichotomy 0 a with (ha|rfl|ha),
  { refine or.inl ⟨ha, lt_imp_lt_of_le_imp_le (λ hb, _) hab⟩,
    exact decidable.mul_nonpos_of_nonneg_of_nonpos ha.le hb },
  { rw [zero_mul] at hab, exact hab.false.elim },
  { refine or.inr ⟨ha, lt_imp_lt_of_le_imp_le (λ hb, _) hab⟩,
    exact decidable.mul_nonpos_of_nonpos_of_nonneg ha.le hb }
end

lemma nonneg_and_nonneg_or_nonpos_and_nonpos_of_mul_nnonneg (hab : 0 ≤ a * b) :
    (0 ≤ a ∧ 0 ≤ b) ∨ (a ≤ 0 ∧ b ≤ 0) :=
begin
  haveI := @linear_order.decidable_le α _,
  refine decidable.or_iff_not_and_not.2 _,
  simp only [not_and, not_le], intros ab nab, apply not_lt_of_le hab _,
  rcases lt_trichotomy 0 a with (ha|rfl|ha),
  exacts [mul_neg_of_pos_of_neg ha (ab ha.le), ((ab le_rfl).asymm (nab le_rfl)).elim,
    mul_neg_of_neg_of_pos ha (nab ha.le)]
end

lemma pos_of_mul_pos_left (h : 0 < a * b) (ha : 0 ≤ a) : 0 < b :=
((pos_and_pos_or_neg_and_neg_of_mul_pos h).resolve_right $ λ h, h.1.not_le ha).2

lemma pos_of_mul_pos_right (h : 0 < a * b) (hb : 0 ≤ b) : 0 < a :=
((pos_and_pos_or_neg_and_neg_of_mul_pos h).resolve_right $ λ h, h.2.not_le hb).1

lemma pos_iff_pos_of_mul_pos (hab : 0 < a * b) : 0 < a ↔ 0 < b :=
⟨pos_of_mul_pos_left hab ∘ le_of_lt, pos_of_mul_pos_right hab ∘ le_of_lt⟩

lemma neg_of_mul_pos_left (h : 0 < a * b) (ha : a ≤ 0) : b < 0 :=
((pos_and_pos_or_neg_and_neg_of_mul_pos h).resolve_left $ λ h, h.1.not_le ha).2

lemma neg_of_mul_pos_right (h : 0 < a * b) (ha : b ≤ 0) : a < 0 :=
((pos_and_pos_or_neg_and_neg_of_mul_pos h).resolve_left $ λ h, h.2.not_le ha).1

lemma neg_iff_neg_of_mul_pos (hab : 0 < a * b) : a < 0 ↔ b < 0 :=
⟨neg_of_mul_pos_left hab ∘ le_of_lt, neg_of_mul_pos_right hab ∘ le_of_lt⟩

lemma nonneg_of_mul_nonneg_left (h : 0 ≤ a * b) (h1 : 0 < a) : 0 ≤ b :=
le_of_not_gt (assume h2 : b < 0, (mul_neg_of_pos_of_neg h1 h2).not_le h)

lemma nonneg_of_mul_nonneg_right (h : 0 ≤ a * b) (h1 : 0 < b) : 0 ≤ a :=
le_of_not_gt (assume h2 : a < 0, (mul_neg_of_neg_of_pos h2 h1).not_le h)

lemma neg_of_mul_neg_left (h : a * b < 0) (h1 : 0 ≤ a) : b < 0 :=
by haveI := @linear_order.decidable_le α _; exact
lt_of_not_ge (assume h2 : b ≥ 0, (decidable.mul_nonneg h1 h2).not_lt h)

lemma neg_of_mul_neg_right (h : a * b < 0) (h1 : 0 ≤ b) : a < 0 :=
by haveI := @linear_order.decidable_le α _; exact
lt_of_not_ge (assume h2 : a ≥ 0, (decidable.mul_nonneg h2 h1).not_lt h)

lemma nonpos_of_mul_nonpos_left (h : a * b ≤ 0) (h1 : 0 < a) : b ≤ 0 :=
le_of_not_gt (assume h2 : b > 0, (mul_pos h1 h2).not_le h)

lemma nonpos_of_mul_nonpos_right (h : a * b ≤ 0) (h1 : 0 < b) : a ≤ 0 :=
le_of_not_gt (assume h2 : a > 0, (mul_pos h2 h1).not_le h)

@[simp] lemma mul_le_mul_left (h : 0 < c) : c * a ≤ c * b ↔ a ≤ b :=
by haveI := @linear_order.decidable_le α _; exact
⟨λ h', le_of_mul_le_mul_left h' h, λ h', decidable.mul_le_mul_of_nonneg_left h' h.le⟩

@[simp] lemma mul_le_mul_right (h : 0 < c) : a * c ≤ b * c ↔ a ≤ b :=
by haveI := @linear_order.decidable_le α _; exact
⟨λ h', le_of_mul_le_mul_right h' h, λ h', decidable.mul_le_mul_of_nonneg_right h' h.le⟩

@[simp] lemma mul_lt_mul_left (h : 0 < c) : c * a < c * b ↔ a < b :=
by haveI := @linear_order.decidable_le α _; exact
⟨lt_imp_lt_of_le_imp_le $ λ h', decidable.mul_le_mul_of_nonneg_left h' h.le,
 λ h', mul_lt_mul_of_pos_left h' h⟩

@[simp] lemma mul_lt_mul_right (h : 0 < c) : a * c < b * c ↔ a < b :=
by haveI := @linear_order.decidable_le α _; exact
⟨lt_imp_lt_of_le_imp_le $ λ h', decidable.mul_le_mul_of_nonneg_right h' h.le,
 λ h', mul_lt_mul_of_pos_right h' h⟩

@[simp] lemma zero_le_mul_left (h : 0 < c) : 0 ≤ c * b ↔ 0 ≤ b :=
by { convert mul_le_mul_left h, simp }

@[simp] lemma zero_le_mul_right (h : 0 < c) : 0 ≤ b * c ↔ 0 ≤ b :=
by { convert mul_le_mul_right h, simp }

@[simp] lemma zero_lt_mul_left (h : 0 < c) : 0 < c * b ↔ 0 < b :=
by { convert mul_lt_mul_left h, simp }

@[simp] lemma zero_lt_mul_right (h : 0 < c) : 0 < b * c ↔ 0 < b :=
by { convert mul_lt_mul_right h, simp }

lemma add_le_mul_of_left_le_right (a2 : 2 ≤ a) (ab : a ≤ b) : a + b ≤ a * b :=
have 0 < b, from
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

lemma add_le_mul_of_right_le_left (b2 : 2 ≤ b) (ba : b ≤ a) : a + b ≤ a * b :=
have 0 < a, from
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

lemma 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)

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

section
variables [nontrivial α]

@[simp] lemma 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:α))]

@[simp] lemma 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:α))]

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

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

@[simp] lemma 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:α))]

@[simp] lemma 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:α))]

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

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

end

lemma le_mul_iff_one_le_left (hb : 0 < b) : b ≤ a * b ↔ 1 ≤ a :=
suffices 1 * b ≤ a * b ↔ 1 ≤ a, by rwa one_mul at this,
mul_le_mul_right hb

lemma lt_mul_iff_one_lt_left (hb : 0 < b) : b < a * b ↔ 1 < a :=
suffices 1 * b < a * b ↔ 1 < a, by rwa one_mul at this,
mul_lt_mul_right hb

lemma le_mul_iff_one_le_right (hb : 0 < b) : b ≤ b * a ↔ 1 ≤ a :=
suffices b * 1 ≤ b * a ↔ 1 ≤ a, by rwa mul_one at this,
mul_le_mul_left hb

lemma lt_mul_iff_one_lt_right (hb : 0 < b) : b < b * a ↔ 1 < a :=
suffices b * 1 < b * a ↔ 1 < a, by rwa mul_one at this,
mul_lt_mul_left hb

theorem mul_nonneg_iff_right_nonneg_of_pos (ha : 0 < a) : 0 ≤ a * b ↔ 0 ≤ b :=
by haveI := @linear_order.decidable_le α _; exact
⟨λ h, nonneg_of_mul_nonneg_left h ha, λ h, decidable.mul_nonneg ha.le h⟩

theorem mul_nonneg_iff_left_nonneg_of_pos (hb : 0 < b) : 0 ≤ a * b ↔ 0 ≤ a :=
by haveI := @linear_order.decidable_le α _; exact
⟨λ h, nonneg_of_mul_nonneg_right h hb, λ h, decidable.mul_nonneg h hb.le⟩

lemma mul_le_iff_le_one_left (hb : 0 < b) : a * b ≤ b ↔ a ≤ 1 :=
⟨ λ h, le_of_not_lt (mt (lt_mul_iff_one_lt_left hb).2 h.not_lt),
  λ h, le_of_not_lt (mt (lt_mul_iff_one_lt_left hb).1 h.not_lt) ⟩

lemma mul_lt_iff_lt_one_left (hb : 0 < b) : a * b < b ↔ a < 1 :=
lt_iff_lt_of_le_iff_le $ le_mul_iff_one_le_left hb

lemma mul_le_iff_le_one_right (hb : 0 < b) : b * a ≤ b ↔ a ≤ 1 :=
⟨ λ h, le_of_not_lt (mt (lt_mul_iff_one_lt_right hb).2 h.not_lt),
  λ h, le_of_not_lt (mt (lt_mul_iff_one_lt_right hb).1 h.not_lt) ⟩

lemma mul_lt_iff_lt_one_right (hb : 0 < b) : b * a < b ↔ a < 1 :=
lt_iff_lt_of_le_iff_le $ le_mul_iff_one_le_right hb

-- TODO: `left` and `right` for these two lemmas are backwards compared to `neg_of_mul_pos`
-- lemmas.
lemma nonpos_of_mul_nonneg_left (h : 0 ≤ a * b) (hb : b < 0) : a ≤ 0 :=
le_of_not_gt (λ ha, absurd h (mul_neg_of_pos_of_neg ha hb).not_le)

lemma nonpos_of_mul_nonneg_right (h : 0 ≤ a * b) (ha : a < 0) : b ≤ 0 :=
le_of_not_gt (λ hb, absurd h (mul_neg_of_neg_of_pos ha hb).not_le)

@[priority 100] -- see Note [lower instance priority]
instance linear_ordered_semiring.to_no_max_order {α : Type*} [linear_ordered_semiring α] :
  no_max_order α :=
⟨assume a, ⟨a + 1, lt_add_of_pos_right _ zero_lt_one⟩⟩

/-- Pullback a `linear_ordered_semiring` under an injective map.
See note [reducible non-instances]. -/
@[reducible]
def function.injective.linear_ordered_semiring {β : Type*}
  [has_zero β] [has_one β] [has_add β] [has_mul β]
  (f : β → α) (hf : function.injective f) (zero : f 0 = 0) (one : f 1 = 1)
  (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y) :
  linear_ordered_semiring β :=
{ .. linear_order.lift f hf,
  .. pullback_nonzero f zero one,
  .. hf.ordered_semiring f zero one add mul }

@[simp] lemma units.inv_pos {u : αˣ} : (0 : α) < ↑u⁻¹ ↔ (0 : α) < u :=
have ∀ {u : αˣ}, (0 : α) < u → (0 : α) < ↑u⁻¹ := λ u h,
  (zero_lt_mul_left h).mp $ u.mul_inv.symm ▸ zero_lt_one,
⟨this, this⟩

@[simp] lemma units.inv_neg {u : αˣ} : ↑u⁻¹ < (0 : α) ↔ ↑u < (0 : α) :=
have ∀ {u : αˣ}, ↑u < (0 : α) → ↑u⁻¹ < (0 : α) := λ u h,
  neg_of_mul_pos_left (by exact (u.mul_inv.symm ▸ zero_lt_one)) h.le,
⟨this, this⟩

end linear_ordered_semiring

section mono
variables {β : Type*} [linear_ordered_semiring α] [preorder β] {f g : β → α} {a : α}

lemma monotone_mul_left_of_nonneg (ha : 0 ≤ a) : monotone (λ x, a*x) :=
by haveI := @linear_order.decidable_le α _; exact
assume b c b_le_c, decidable.mul_le_mul_of_nonneg_left b_le_c ha

lemma monotone_mul_right_of_nonneg (ha : 0 ≤ a) : monotone (λ x, x*a) :=
by haveI := @linear_order.decidable_le α _; exact
assume b c b_le_c, decidable.mul_le_mul_of_nonneg_right b_le_c ha

lemma monotone.mul_const (hf : monotone f) (ha : 0 ≤ a) :
  monotone (λ x, (f x) * a) :=
(monotone_mul_right_of_nonneg ha).comp hf

lemma monotone.const_mul (hf : monotone f) (ha : 0 ≤ a) :
  monotone (λ x, a * (f x)) :=
(monotone_mul_left_of_nonneg ha).comp hf

lemma monotone.mul (hf : monotone f) (hg : monotone g) (hf0 : ∀ x, 0 ≤ f x) (hg0 : ∀ x, 0 ≤ g x) :
  monotone (λ x, f x * g x) :=
by haveI := @linear_order.decidable_le α _; exact
λ x y h, decidable.mul_le_mul (hf h) (hg h) (hg0 x) (hf0 y)

lemma strict_mono_mul_left_of_pos (ha : 0 < a) : strict_mono (λ x, a * x) :=
assume b c b_lt_c, (mul_lt_mul_left ha).2 b_lt_c

lemma strict_mono_mul_right_of_pos (ha : 0 < a) : strict_mono (λ x, x * a) :=
assume b c b_lt_c, (mul_lt_mul_right ha).2 b_lt_c

lemma strict_mono.mul_const (hf : strict_mono f) (ha : 0 < a) :
  strict_mono (λ x, (f x) * a) :=
(strict_mono_mul_right_of_pos ha).comp hf

lemma strict_mono.const_mul (hf : strict_mono f) (ha : 0 < a) :
  strict_mono (λ x, a * (f x)) :=
(strict_mono_mul_left_of_pos ha).comp hf

lemma strict_mono.mul_monotone (hf : strict_mono f) (hg : monotone g) (hf0 : ∀ x, 0 ≤ f x)
  (hg0 : ∀ x, 0 < g x) :
  strict_mono (λ x, f x * g x) :=
by haveI := @linear_order.decidable_le α _; exact
λ x y h, decidable.mul_lt_mul (hf h) (hg h.le) (hg0 x) (hf0 y)

lemma monotone.mul_strict_mono (hf : monotone f) (hg : strict_mono g) (hf0 : ∀ x, 0 < f x)
  (hg0 : ∀ x, 0 ≤ g x) :
  strict_mono (λ x, f x * g x) :=
by haveI := @linear_order.decidable_le α _; exact
λ x y h, decidable.mul_lt_mul' (hf h.le) (hg h) (hg0 x) (hf0 y)

lemma strict_mono.mul (hf : strict_mono f) (hg : strict_mono g) (hf0 : ∀ x, 0 ≤ f x)
  (hg0 : ∀ x, 0 ≤ g x) :
  strict_mono (λ x, f x * g x) :=
by haveI := @linear_order.decidable_le α _; exact
λ x y h, decidable.mul_lt_mul'' (hf h) (hg h) (hf0 x) (hg0 x)

end mono

section linear_ordered_semiring
variables [linear_ordered_semiring α] {a b c : α}

lemma 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

lemma 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

lemma 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

lemma 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

end linear_ordered_semiring

/-- An `ordered_ring α` is a ring `α` with a partial order such that
addition is monotone and multiplication by a positive number is strictly monotone. -/
@[protect_proj]
class ordered_ring (α : Type u) extends ring α, ordered_add_comm_group α :=
(zero_le_one : 0 ≤ (1 : α))
(mul_pos     : ∀ a b : α, 0 < a → 0 < b → 0 < a * b)

section ordered_ring
variables [ordered_ring α] {a b c : α}

-- See Note [decidable namespace]
protected lemma decidable.ordered_ring.mul_nonneg [@decidable_rel α (≤)]
  {a b : α} (h₁ : 0 ≤ a) (h₂ : 0 ≤ b) : 0 ≤ a * b :=
begin
  by_cases ha : a ≤ 0, { simp [le_antisymm ha h₁] },
  by_cases hb : b ≤ 0, { simp [le_antisymm hb h₂] },
  exact (le_not_le_of_lt (ordered_ring.mul_pos a b (h₁.lt_of_not_le ha) (h₂.lt_of_not_le hb))).1,
end

lemma ordered_ring.mul_nonneg : 0 ≤ a → 0 ≤ b → 0 ≤ a * b :=
by classical; exact decidable.ordered_ring.mul_nonneg

-- See Note [decidable namespace]
protected lemma decidable.ordered_ring.mul_le_mul_of_nonneg_left
  [@decidable_rel α (≤)] (h₁ : a ≤ b) (h₂ : 0 ≤ c) : c * a ≤ c * b :=
begin
  rw [← sub_nonneg, ← mul_sub],
  exact decidable.ordered_ring.mul_nonneg h₂ (sub_nonneg.2 h₁),
end

lemma ordered_ring.mul_le_mul_of_nonneg_left : a ≤ b → 0 ≤ c → c * a ≤ c * b :=
by classical; exact decidable.ordered_ring.mul_le_mul_of_nonneg_left

-- See Note [decidable namespace]
protected lemma decidable.ordered_ring.mul_le_mul_of_nonneg_right
  [@decidable_rel α (≤)] (h₁ : a ≤ b) (h₂ : 0 ≤ c) : a * c ≤ b * c :=
begin
  rw [← sub_nonneg, ← sub_mul],
  exact decidable.ordered_ring.mul_nonneg (sub_nonneg.2 h₁) h₂,
end

lemma ordered_ring.mul_le_mul_of_nonneg_right : a ≤ b → 0 ≤ c → a * c ≤ b * c :=
by classical; exact decidable.ordered_ring.mul_le_mul_of_nonneg_right

lemma ordered_ring.mul_lt_mul_of_pos_left (h₁ : a < b) (h₂ : 0 < c) : c * a < c * b :=
begin
  rw [← sub_pos, ← mul_sub],
  exact ordered_ring.mul_pos _ _ h₂ (sub_pos.2 h₁),
end

lemma ordered_ring.mul_lt_mul_of_pos_right (h₁ : a < b) (h₂ : 0 < c) : a * c < b * c :=
begin
  rw [← sub_pos, ← sub_mul],
  exact ordered_ring.mul_pos _ _ (sub_pos.2 h₁) h₂,
end

@[priority 100] -- see Note [lower instance priority]
instance ordered_ring.to_ordered_semiring : ordered_semiring α :=
{ mul_zero                   := mul_zero,
  zero_mul                   := zero_mul,
  add_left_cancel            := @add_left_cancel α _,
  le_of_add_le_add_left      := @le_of_add_le_add_left α _ _ _,
  mul_lt_mul_of_pos_left     := @ordered_ring.mul_lt_mul_of_pos_left α _,
  mul_lt_mul_of_pos_right    := @ordered_ring.mul_lt_mul_of_pos_right α _,
  ..‹ordered_ring α› }

-- See Note [decidable namespace]
protected lemma decidable.mul_le_mul_of_nonpos_left [@decidable_rel α (≤)]
  {a b c : α} (h : b ≤ a) (hc : c ≤ 0) : c * a ≤ c * b :=
have -c ≥ 0,              from neg_nonneg_of_nonpos hc,
have -c * b ≤ -c * a,     from decidable.mul_le_mul_of_nonneg_left h this,
have -(c * b) ≤ -(c * a), by rwa [← neg_mul_eq_neg_mul, ← neg_mul_eq_neg_mul] at this,
le_of_neg_le_neg this

lemma mul_le_mul_of_nonpos_left {a b c : α} : b ≤ a → c ≤ 0 → c * a ≤ c * b :=
by classical; exact decidable.mul_le_mul_of_nonpos_left

-- See Note [decidable namespace]
protected lemma decidable.mul_le_mul_of_nonpos_right [@decidable_rel α (≤)]
  {a b c : α} (h : b ≤ a) (hc : c ≤ 0) : a * c ≤ b * c :=
have -c ≥ 0,              from neg_nonneg_of_nonpos hc,
have b * -c ≤ a * -c,     from decidable.mul_le_mul_of_nonneg_right h this,
have -(b * c) ≤ -(a * c), by rwa [← neg_mul_eq_mul_neg, ← neg_mul_eq_mul_neg] at this,
le_of_neg_le_neg this

lemma mul_le_mul_of_nonpos_right {a b c : α} : b ≤ a → c ≤ 0 → a * c ≤ b * c :=
by classical; exact decidable.mul_le_mul_of_nonpos_right

-- See Note [decidable namespace]
protected lemma decidable.mul_nonneg_of_nonpos_of_nonpos [@decidable_rel α (≤)]
  {a b : α} (ha : a ≤ 0) (hb : b ≤ 0) : 0 ≤ a * b :=
have 0 * b ≤ a * b, from decidable.mul_le_mul_of_nonpos_right ha hb,
by rwa zero_mul at this

lemma mul_nonneg_of_nonpos_of_nonpos {a b : α} : a ≤ 0 → b ≤ 0 → 0 ≤ a * b :=
by classical; exact decidable.mul_nonneg_of_nonpos_of_nonpos

lemma mul_lt_mul_of_neg_left {a b c : α} (h : b < a) (hc : c < 0) : c * a < c * b :=
have -c > 0,              from neg_pos_of_neg hc,
have -c * b < -c * a,     from mul_lt_mul_of_pos_left h this,
have -(c * b) < -(c * a), by rwa [← neg_mul_eq_neg_mul, ← neg_mul_eq_neg_mul] at this,
lt_of_neg_lt_neg this

lemma mul_lt_mul_of_neg_right {a b c : α} (h : b < a) (hc : c < 0) : a * c < b * c :=
have -c > 0,              from neg_pos_of_neg hc,
have b * -c < a * -c,     from mul_lt_mul_of_pos_right h this,
have -(b * c) < -(a * c), by rwa [← neg_mul_eq_mul_neg, ← neg_mul_eq_mul_neg] at this,
lt_of_neg_lt_neg this

lemma mul_pos_of_neg_of_neg {a b : α} (ha : a < 0) (hb : b < 0) : 0 < a * b :=
have 0 * b < a * b, from mul_lt_mul_of_neg_right ha hb,
by rwa zero_mul at this

/-- Pullback an `ordered_ring` under an injective map.
See note [reducible non-instances]. -/
@[reducible]
def function.injective.ordered_ring {β : Type*}
  [has_zero β] [has_one β] [has_add β] [has_mul β] [has_neg β] [has_sub β]
  (f : β → α) (hf : function.injective f) (zero : f 0 = 0) (one : f 1 = 1)
  (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y)
  (neg : ∀ x, f (- x) = - f x) (sub : ∀ x y, f (x - y) = f x - f y) :
  ordered_ring β :=
{ mul_pos := λ a b a0 b0, show f 0 < f (a * b), by { rw [zero, mul], apply mul_pos; rwa ← zero },
  ..hf.ordered_semiring f zero one add mul,
  ..hf.ring f zero one add mul neg sub }

lemma le_iff_exists_nonneg_add (a b : α) : a ≤ b ↔ ∃ c ≥ 0, b = a + c :=
⟨λ h, ⟨b - a, sub_nonneg.mpr h, by simp⟩,
  λ ⟨c, hc, h⟩, by { rw [h, le_add_iff_nonneg_right], exact hc }⟩

end ordered_ring

section ordered_comm_ring

/-- An `ordered_comm_ring α` is a commutative ring `α` with a partial order such that
addition is monotone and multiplication by a positive number is strictly monotone. -/
@[protect_proj]
class ordered_comm_ring (α : Type u) extends ordered_ring α, comm_ring α

@[priority 100] -- See note [lower instance priority]
instance ordered_comm_ring.to_ordered_comm_semiring {α : Type u} [ordered_comm_ring α] :
  ordered_comm_semiring α :=
{ .. (by apply_instance : ordered_semiring α),
  .. ‹ordered_comm_ring α› }

/-- Pullback an `ordered_comm_ring` under an injective map.
See note [reducible non-instances]. -/
@[reducible]
def function.injective.ordered_comm_ring [ordered_comm_ring α] {β : Type*}
  [has_zero β] [has_one β] [has_add β] [has_mul β] [has_neg β] [has_sub β]
  (f : β → α) (hf : function.injective f) (zero : f 0 = 0) (one : f 1 = 1)
  (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y)
  (neg : ∀ x, f (- x) = - f x) (sub : ∀ x y, f (x - y) = f x - f y) :
  ordered_comm_ring β :=
{ ..hf.ordered_ring f zero one add mul neg sub,
  ..hf.comm_ring f zero one add mul neg sub }

end ordered_comm_ring

/-- A `linear_ordered_ring α` is a ring `α` with a linear order such that
addition is monotone and multiplication by a positive number is strictly monotone. -/
@[protect_proj] class linear_ordered_ring (α : Type u)
  extends ordered_ring α, linear_order α, nontrivial α

@[priority 100] -- see Note [lower instance priority]
instance linear_ordered_ring.to_linear_ordered_add_comm_group [s : linear_ordered_ring α] :
  linear_ordered_add_comm_group α :=
{ .. s }

section linear_ordered_ring
variables [linear_ordered_ring α] {a b c : α}

@[priority 100] -- see Note [lower instance priority]
instance linear_ordered_ring.to_linear_ordered_semiring : linear_ordered_semiring α :=
{ mul_zero                   := mul_zero,
  zero_mul                   := zero_mul,
  add_left_cancel            := @add_left_cancel α _,
  le_of_add_le_add_left      := @le_of_add_le_add_left α _ _ _,
  mul_lt_mul_of_pos_left     := @mul_lt_mul_of_pos_left α _,
  mul_lt_mul_of_pos_right    := @mul_lt_mul_of_pos_right α _,
  le_total                   := linear_ordered_ring.le_total,
  ..‹linear_ordered_ring α› }

@[priority 100] -- see Note [lower instance priority]
instance linear_ordered_ring.is_domain : is_domain α :=
{ eq_zero_or_eq_zero_of_mul_eq_zero :=
    begin
      intros a b hab,
      refine decidable.or_iff_not_and_not.2 (λ 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]
    end,
  .. ‹linear_ordered_ring α› }

@[simp] lemma abs_one : |(1 : α)| = 1 := abs_of_pos zero_lt_one
@[simp] lemma abs_two : |(2 : α)| = 2 := abs_of_pos zero_lt_two

lemma abs_mul (a b : α) : |a * b| = |a| * |b| :=
begin
  haveI := @linear_order.decidable_le α _,
  rw [abs_eq (decidable.mul_nonneg (abs_nonneg a) (abs_nonneg b))],
  cases le_total a 0 with ha ha; cases le_total b 0 with hb hb;
    simp only [abs_of_nonpos, abs_of_nonneg, true_or, or_true, eq_self_iff_true,
      neg_mul_eq_neg_mul_symm, mul_neg_eq_neg_mul_symm, neg_neg, *]
end

/-- `abs` as a `monoid_with_zero_hom`. -/
def abs_hom : α →*₀ α := ⟨abs, abs_zero, abs_one, abs_mul⟩

@[simp] lemma abs_mul_abs_self (a : α) : |a| * |a| = a * a :=
abs_by_cases (λ x, x * x = a * a) rfl (neg_mul_neg a a)

@[simp] lemma abs_mul_self (a : α) : |a * a| = a * a :=
by rw [abs_mul, abs_mul_abs_self]

lemma mul_pos_iff : 0 < a * b ↔ 0 < a ∧ 0 < b ∨ a < 0 ∧ b < 0 :=
⟨pos_and_pos_or_neg_and_neg_of_mul_pos,
  λ h, h.elim (and_imp.2 mul_pos) (and_imp.2 mul_pos_of_neg_of_neg)⟩

lemma 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]

lemma mul_nonneg_iff : 0 ≤ a * b ↔ 0 ≤ a ∧ 0 ≤ b ∨ a ≤ 0 ∧ b ≤ 0 :=
by haveI := @linear_order.decidable_le α _; exact
⟨nonneg_and_nonneg_or_nonpos_and_nonpos_of_mul_nnonneg,
  λ h, h.elim (and_imp.2 decidable.mul_nonneg) (and_imp.2 decidable.mul_nonneg_of_nonpos_of_nonpos)⟩

/-- Out of three elements of a `linear_ordered_ring`, two must have the same sign. -/
lemma mul_nonneg_of_three (a b c : α) :
  0 ≤ a * b ∨ 0 ≤ b * c ∨ 0 ≤ c * a :=
by iterate 3 { rw mul_nonneg_iff };
  have := le_total 0 a; have := le_total 0 b; have := le_total 0 c; itauto

lemma 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]

lemma mul_self_nonneg (a : α) : 0 ≤ a * a :=
abs_mul_self a ▸ abs_nonneg _

@[simp] lemma 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]

@[simp] lemma 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]

@[simp] lemma 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

@[simp] lemma 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

@[simp] lemma abs_eq_self : |a| = a ↔ 0 ≤ a := by simp [abs_eq_max_neg]

@[simp] lemma abs_eq_neg_self : |a| = -a ↔ a ≤ 0 := by simp [abs_eq_max_neg]

/-- For an element `a` of a linear ordered ring, either `abs a = a` and `0 ≤ a`,
    or `abs a = -a` and `a < 0`.
    Use cases on this lemma to automate linarith in inequalities -/
lemma abs_cases (a : α) : (|a| = a ∧ 0 ≤ a) ∨ (|a| = -a ∧ a < 0) :=
begin
  by_cases 0 ≤ a,
  { left,
    exact ⟨abs_eq_self.mpr h, h⟩ },
  { right,
    push_neg at h,
    exact ⟨abs_eq_neg_self.mpr (le_of_lt h), h⟩ }
end

lemma gt_of_mul_lt_mul_neg_left (h : c * a < c * b) (hc : c ≤ 0) : b < a :=
have nhc : 0 ≤ -c, from neg_nonneg_of_nonpos hc,
have h2 : -(c * b) < -(c * a), from neg_lt_neg h,
have h3 : (-c) * b < (-c) * a, from calc
     (-c) * b = - (c * b)    : by rewrite neg_mul_eq_neg_mul
          ... < -(c * a)     : h2
          ... = (-c) * a     : by rewrite neg_mul_eq_neg_mul,
lt_of_mul_lt_mul_left h3 nhc

lemma neg_one_lt_zero : -1 < (0:α) := neg_lt_zero.2 zero_lt_one

lemma le_of_mul_le_of_one_le {a b c : α} (h : a * c ≤ b) (hb : 0 ≤ b) (hc : 1 ≤ c) : a ≤ b :=
by haveI := @linear_order.decidable_le α _; exact
have h' : a * c ≤ b * c, from calc
     a * c ≤ b : h
       ... = b * 1 : by rewrite mul_one
       ... ≤ b * c : decidable.mul_le_mul_of_nonneg_left hc hb,
le_of_mul_le_mul_right h' (zero_lt_one.trans_le hc)

lemma nonneg_le_nonneg_of_sq_le_sq {a b : α} (hb : 0 ≤ b) (h : a * a ≤ b * b) : a ≤ b :=
by haveI := @linear_order.decidable_le α _; exact
le_of_not_gt (λhab, (decidable.mul_self_lt_mul_self hb hab).not_le h)

lemma mul_self_le_mul_self_iff {a b : α} (h1 : 0 ≤ a) (h2 : 0 ≤ b) : a ≤ b ↔ a * a ≤ b * b :=
by haveI := @linear_order.decidable_le α _; exact
⟨decidable.mul_self_le_mul_self h1, nonneg_le_nonneg_of_sq_le_sq h2⟩

lemma mul_self_lt_mul_self_iff {a b : α} (h1 : 0 ≤ a) (h2 : 0 ≤ b) : a < b ↔ a * a < b * b :=
by haveI := @linear_order.decidable_le α _; exact
((@decidable.strict_mono_on_mul_self α _ _).lt_iff_lt h1 h2).symm

lemma mul_self_inj {a b : α} (h1 : 0 ≤ a) (h2 : 0 ≤ b) : a * a = b * b ↔ a = b :=
by haveI := @linear_order.decidable_le α _; exact
(@decidable.strict_mono_on_mul_self α _ _).inj_on.eq_iff h1 h2

@[simp] lemma mul_le_mul_left_of_neg {a b c : α} (h : c < 0) : c * a ≤ c * b ↔ b ≤ a :=
by haveI := @linear_order.decidable_le α _; exact
⟨le_imp_le_of_lt_imp_lt $ λ h', mul_lt_mul_of_neg_left h' h,
  λ h', decidable.mul_le_mul_of_nonpos_left h' h.le⟩

@[simp] lemma mul_le_mul_right_of_neg {a b c : α} (h : c < 0) : a * c ≤ b * c ↔ b ≤ a :=
by haveI := @linear_order.decidable_le α _; exact
⟨le_imp_le_of_lt_imp_lt $ λ h', mul_lt_mul_of_neg_right h' h,
  λ h', decidable.mul_le_mul_of_nonpos_right h' h.le⟩

@[simp] lemma mul_lt_mul_left_of_neg {a b c : α} (h : c < 0) : c * a < c * b ↔ b < a :=
lt_iff_lt_of_le_iff_le (mul_le_mul_left_of_neg h)

@[simp] lemma mul_lt_mul_right_of_neg {a b c : α} (h : c < 0) : a * c < b * c ↔ b < a :=
lt_iff_lt_of_le_iff_le (mul_le_mul_right_of_neg h)

lemma sub_one_lt (a : α) : a - 1 < a :=
sub_lt_iff_lt_add.2 (lt_add_one a)

@[simp] lemma mul_self_pos {a : α} : 0 < a * a ↔ a ≠ 0 :=
begin
  split,
  { 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] }
end

lemma mul_self_le_mul_self_of_le_of_neg_le {x y : α} (h₁ : x ≤ y) (h₂ : -x ≤ y) : x * x ≤ y * y :=
begin
  haveI := @linear_order.decidable_le α _,
  rw [← abs_mul_abs_self x],
  exact decidable.mul_self_le_mul_self (abs_nonneg x) (abs_le.2 ⟨neg_le.2 h₂, h₁⟩)
end

lemma nonneg_of_mul_nonpos_left {a b : α} (h : a * b ≤ 0) (hb : b < 0) : 0 ≤ a :=
le_of_not_gt (λ ha, absurd h (mul_pos_of_neg_of_neg ha hb).not_le)

lemma nonneg_of_mul_nonpos_right {a b : α} (h : a * b ≤ 0) (ha : a < 0) : 0 ≤ b :=
le_of_not_gt (λ hb, absurd h (mul_pos_of_neg_of_neg ha hb).not_le)

lemma pos_of_mul_neg_left {a b : α} (h : a * b < 0) (hb : b ≤ 0) : 0 < a :=
by haveI := @linear_order.decidable_le α _; exact
lt_of_not_ge (λ ha, absurd h (decidable.mul_nonneg_of_nonpos_of_nonpos ha hb).not_lt)

lemma pos_of_mul_neg_right {a b : α} (h : a * b < 0) (ha : a ≤ 0) : 0 < b :=
by haveI := @linear_order.decidable_le α _; exact
lt_of_not_ge (λ hb, absurd h (decidable.mul_nonneg_of_nonpos_of_nonpos ha hb).not_lt)

lemma 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_right hab ∘ le_of_lt⟩

lemma pos_iff_neg_of_mul_neg (hab : a * b < 0) : 0 < a ↔ b < 0 :=
⟨neg_of_mul_neg_left hab ∘ le_of_lt, pos_of_mul_neg_left hab ∘ le_of_lt⟩

/-- The sum of two squares is zero iff both elements are zero. -/
lemma 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

lemma 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

lemma abs_eq_iff_mul_self_eq : |a| = |b| ↔ a * a = b * b :=
begin
  rw [← abs_mul_abs_self, ← abs_mul_abs_self b],
  exact (mul_self_inj (abs_nonneg a) (abs_nonneg b)).symm,
end

lemma abs_lt_iff_mul_self_lt : |a| < |b| ↔ a * a < b * b :=
begin
  rw [← abs_mul_abs_self, ← abs_mul_abs_self b],
  exact mul_self_lt_mul_self_iff (abs_nonneg a) (abs_nonneg b)
end

lemma abs_le_iff_mul_self_le : |a| ≤ |b| ↔ a * a ≤ b * b :=
begin
  rw [← abs_mul_abs_self, ← abs_mul_abs_self b],
  exact mul_self_le_mul_self_iff (abs_nonneg a) (abs_nonneg b)
end

lemma abs_le_one_iff_mul_self_le_one : |a| ≤ 1 ↔ a * a ≤ 1 :=
by simpa only [abs_one, one_mul] using @abs_le_iff_mul_self_le α _ a 1

/-- Pullback a `linear_ordered_ring` under an injective map.
See note [reducible non-instances]. -/
@[reducible]
def function.injective.linear_ordered_ring {β : Type*}
  [has_zero β] [has_one β] [has_add β] [has_mul β] [has_neg β] [has_sub β]
  (f : β → α) (hf : function.injective f) (zero : f 0 = 0) (one : f 1 = 1)
  (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y)
  (neg : ∀ x, f (-x) = -f x) (sub : ∀ x y, f (x - y) = f x - f y) :
  linear_ordered_ring β :=
{ .. linear_order.lift f hf,
  .. pullback_nonzero f zero one,
  .. hf.ordered_ring f zero one add mul neg sub }

end linear_ordered_ring

/-- A `linear_ordered_comm_ring α` is a commutative ring `α` with a linear order
such that addition is monotone and multiplication by a positive number is strictly monotone. -/
@[protect_proj]
class linear_ordered_comm_ring (α : Type u) extends linear_ordered_ring α, comm_monoid α

@[priority 100] -- see Note [lower instance priority]
instance linear_ordered_comm_ring.to_ordered_comm_ring [d : linear_ordered_comm_ring α] :
  ordered_comm_ring α :=
{ ..d }

@[priority 100] -- see Note [lower instance priority]
instance linear_ordered_comm_ring.to_linear_ordered_semiring [d : linear_ordered_comm_ring α] :
   linear_ordered_semiring α :=
{ .. d, ..linear_ordered_ring.to_linear_ordered_semiring }

section linear_ordered_comm_ring

variables [linear_ordered_comm_ring α] {a b c d : α}

lemma 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 :=
by haveI := @linear_order.decidable_le α _; exact
have ba : b * a ≤ max d b * max c a, from
  decidable.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, from
  decidable.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)

lemma abs_sub_sq (a b : α) : |a - b| * |a - b| = a * a + b * b - (1 + 1) * a * b :=
begin
  rw abs_mul_abs_self,
  simp only [mul_add, add_comm, add_left_comm, mul_comm, sub_eq_add_neg,
    mul_one, mul_neg_eq_neg_mul_symm, neg_add_rev, neg_neg],
end

end linear_ordered_comm_ring
section
variables [ring α] [linear_order α] {a b : α}

@[simp] lemma abs_dvd (a b : α) : |a| ∣ b ↔ a ∣ b :=
by { cases abs_choice a with h h; simp only [h, neg_dvd] }

lemma abs_dvd_self (a : α) : |a| ∣ a :=
(abs_dvd a a).mpr (dvd_refl a)

@[simp] lemma dvd_abs (a b : α) : a ∣ |b| ↔ a ∣ b :=
by { cases abs_choice b with h h; simp only [h, dvd_neg] }

lemma self_dvd_abs (a : α) : a ∣ |a| :=
(dvd_abs a a).mpr (dvd_refl a)

lemma abs_dvd_abs (a b : α) : |a| ∣ |b| ↔ a ∣ b :=
(abs_dvd _ _).trans (dvd_abs _ _)

lemma even_abs {a : α} : even (|a|) ↔ even a :=
dvd_abs _ _

lemma odd_abs {a : α} : odd (abs a) ↔ odd a :=
by { cases abs_choice a with h h; simp only [h, odd_neg] }

end

section linear_ordered_comm_ring

variables [linear_ordered_comm_ring α]

/-- Pullback a `linear_ordered_comm_ring` under an injective map.
See note [reducible non-instances]. -/
@[reducible]
def function.injective.linear_ordered_comm_ring {β : Type*}
  [has_zero β] [has_one β] [has_add β] [has_mul β] [has_neg β] [has_sub β]
  (f : β → α) (hf : function.injective f) (zero : f 0 = 0) (one : f 1 = 1)
  (add : ∀ x y, f (x + y) = f x + f y) (mul : ∀ x y, f (x * y) = f x * f y)
  (neg : ∀ x, f (-x) = -f x) (sub : ∀ x y, f (x - y) = f x - f y) :
  linear_ordered_comm_ring β :=
{ .. linear_order.lift f hf,
  .. pullback_nonzero f zero one,
  .. hf.ordered_comm_ring f zero one add mul neg sub }

end linear_ordered_comm_ring

namespace ring

/-- A positive cone in a ring consists of a positive cone in underlying `add_comm_group`,
which contains `1` and such that the positive elements are closed under multiplication. -/
@[nolint has_inhabited_instance]
structure positive_cone (α : Type*) [ring α] extends add_comm_group.positive_cone α :=
(one_nonneg : nonneg 1)
(mul_pos : ∀ (a b), pos a → pos b → pos (a * b))

/-- Forget that a positive cone in a ring respects the multiplicative structure. -/
add_decl_doc positive_cone.to_positive_cone

/-- A positive cone in a ring induces a linear order if `1` is a positive element. -/
@[nolint has_inhabited_instance]
structure total_positive_cone (α : Type*) [ring α]
  extends positive_cone α, add_comm_group.total_positive_cone α :=
(one_pos : pos 1)

/-- Forget that a `total_positive_cone` in a ring is total. -/
add_decl_doc total_positive_cone.to_positive_cone

/-- Forget that a `total_positive_cone` in a ring respects the multiplicative structure. -/
add_decl_doc total_positive_cone.to_total_positive_cone

end ring

namespace ordered_ring

open ring

/-- Construct an `ordered_ring` by
designating a positive cone in an existing `ring`. -/
def mk_of_positive_cone {α : Type*} [ring α] (C : positive_cone α) :
  ordered_ring α :=
{ zero_le_one := by { change C.nonneg (1 - 0), convert C.one_nonneg, simp, },
  mul_pos := λ x y xp yp, begin
    change C.pos (x*y - 0),
    convert C.mul_pos x y (by { convert xp, simp, }) (by { convert yp, simp, }),
    simp,
  end,
  ..‹ring α›,
  ..ordered_add_comm_group.mk_of_positive_cone C.to_positive_cone }

end ordered_ring

namespace linear_ordered_ring

open ring

/-- Construct a `linear_ordered_ring` by
designating a positive cone in an existing `ring`. -/
def mk_of_positive_cone {α : Type*} [ring α] (C : total_positive_cone α) :
  linear_ordered_ring α :=
{ exists_pair_ne := ⟨0, 1, begin
    intro h,
    have one_pos := C.one_pos,
    rw [←h, C.pos_iff] at one_pos,
    simpa using one_pos,
  end⟩,
  ..ordered_ring.mk_of_positive_cone C.to_positive_cone,
  ..linear_ordered_add_comm_group.mk_of_positive_cone C.to_total_positive_cone, }

end linear_ordered_ring

/-- A canonically ordered commutative semiring is an ordered, commutative semiring
in which `a ≤ b` iff there exists `c` with `b = a + c`. This is satisfied by the
natural numbers, for example, but not the integers or other ordered groups. -/
@[protect_proj]
class canonically_ordered_comm_semiring (α : Type*) extends
  canonically_ordered_add_monoid α, comm_semiring α :=
(eq_zero_or_eq_zero_of_mul_eq_zero : ∀ a b : α, a * b = 0 → a = 0 ∨ b = 0)

namespace canonically_ordered_comm_semiring
variables [canonically_ordered_comm_semiring α] {a b : α}

@[priority 100] -- see Note [lower instance priority]
instance to_no_zero_divisors : no_zero_divisors α :=
⟨canonically_ordered_comm_semiring.eq_zero_or_eq_zero_of_mul_eq_zero⟩

@[priority 100] -- see Note [lower instance priority]
instance to_covariant_mul_le : covariant_class α α (*) (≤) :=
begin
  refine ⟨λ a b c h, _⟩,
  rcases le_iff_exists_add.1 h with ⟨c, rfl⟩,
  rw mul_add,
  apply self_le_add_right
end

/-- A version of `zero_lt_one : 0 < 1` for a `canonically_ordered_comm_semiring`. -/
lemma zero_lt_one [nontrivial α] : (0:α) < 1 := (zero_le 1).lt_of_ne zero_ne_one

@[simp] lemma mul_pos : 0 < a * b ↔ (0 < a) ∧ (0 < b) :=
by simp only [pos_iff_ne_zero, ne.def, mul_eq_zero, not_or_distrib]

end canonically_ordered_comm_semiring

section sub

variables [canonically_ordered_comm_semiring α] {a b c : α}
variables [has_sub α] [has_ordered_sub α]

variables [is_total α (≤)]

namespace add_le_cancellable
protected lemma mul_tsub (h : add_le_cancellable (a * c)) :
  a * (b - c) = a * b - a * c :=
begin
  cases total_of (≤) b c with hbc hcb,
  { rw [tsub_eq_zero_iff_le.2 hbc, mul_zero, tsub_eq_zero_iff_le.2 (mul_le_mul_left' hbc a)] },
  { apply h.eq_tsub_of_add_eq, rw [← mul_add, tsub_add_cancel_of_le hcb] }
end

protected lemma tsub_mul (h : add_le_cancellable (b * c)) : (a - b) * c = a * c - b * c :=
by { simp only [mul_comm _ c] at *, exact h.mul_tsub }

end add_le_cancellable

variables [contravariant_class α α (+) (≤)]

lemma mul_tsub (a b c : α) : a * (b - c) = a * b - a * c :=
contravariant.add_le_cancellable.mul_tsub

lemma tsub_mul (a b c : α) : (a - b) * c = a * c - b * c :=
contravariant.add_le_cancellable.tsub_mul

end sub

/-! ### Structures involving `*` and `0` on `with_top` and `with_bot`

The main results of this section are `with_top.canonically_ordered_comm_semiring` and
`with_bot.comm_monoid_with_zero`.
-/

namespace with_top

instance [nonempty α] : nontrivial (with_top α) :=
option.nontrivial

variable [decidable_eq α]

section has_mul

variables [has_zero α] [has_mul α]

instance : mul_zero_class (with_top α) :=
{ zero := 0,
  mul := λm n, if m = 0 ∨ n = 0 then 0 else m.bind (λa, n.bind $ λb, ↑(a * b)),
  zero_mul := assume a, if_pos $ or.inl rfl,
  mul_zero := assume a, if_pos $ or.inr rfl }

lemma mul_def {a b : with_top α} :
  a * b = if a = 0 ∨ b = 0 then 0 else a.bind (λa, b.bind $ λb, ↑(a * b)) := rfl

@[simp] lemma mul_top {a : with_top α} (h : a ≠ 0) : a * ⊤ = ⊤ :=
by cases a; simp [mul_def, h]; refl

@[simp] lemma top_mul {a : with_top α} (h : a ≠ 0) : ⊤ * a = ⊤ :=
by cases a; simp [mul_def, h]; refl

@[simp] lemma top_mul_top : (⊤ * ⊤ : with_top α) = ⊤ :=
top_mul top_ne_zero

end has_mul

section mul_zero_class

variables [mul_zero_class α]

@[norm_cast] lemma coe_mul {a b : α} : (↑(a * b) : with_top α) = a * b :=
decidable.by_cases (assume : a = 0, by simp [this]) $ assume ha,
decidable.by_cases (assume : b = 0, by simp [this]) $ assume hb,
by { simp [*, mul_def], refl }

lemma mul_coe {b : α} (hb : b ≠ 0) : ∀{a : with_top α}, a * b = a.bind (λa:α, ↑(a * b))
| none     := show (if (⊤:with_top α) = 0 ∨ (b:with_top α) = 0 then 0 else ⊤ : with_top α) = ⊤,
    by simp [hb]
| (some a) := show ↑a * ↑b = ↑(a * b), from coe_mul.symm

@[simp] lemma mul_eq_top_iff {a b : with_top α} : a * b = ⊤ ↔ (a ≠ 0 ∧ b = ⊤) ∨ (a = ⊤ ∧ b ≠ 0) :=
begin
  cases a; cases b; simp only [none_eq_top, some_eq_coe],
  { simp [← coe_mul] },
  { suffices : ⊤ * (b : with_top α) = ⊤ ↔ b ≠ 0, by simpa,
    by_cases hb : b = 0; simp [hb] },
  { suffices : (a : with_top α) * ⊤ = ⊤ ↔ a ≠ 0, by simpa,
    by_cases ha : a = 0; simp [ha] },
  { simp [← coe_mul] }
end

lemma mul_lt_top [partial_order α] {a b : with_top α} (ha : a ≠ ⊤) (hb : b ≠ ⊤) : a * b < ⊤ :=
begin
  lift a to α using ha,
  lift b to α using hb,
  simp only [← coe_mul, coe_lt_top]
end

end mul_zero_class

/-- `nontrivial α` is needed here as otherwise we have `1 * ⊤ = ⊤` but also `= 0 * ⊤ = 0`. -/
instance [mul_zero_one_class α] [nontrivial α] : mul_zero_one_class (with_top α) :=
{ mul := (*),
  one := 1,
  zero := 0,
  one_mul := λ a, match a with
  | none     := show ((1:α) : with_top α) * ⊤ = ⊤, by simp [-with_top.coe_one]
  | (some a) := show ((1:α) : with_top α) * a = a, by simp [coe_mul.symm, -with_top.coe_one]
  end,
  mul_one := λ a, match a with
  | none     := show ⊤ * ((1:α) : with_top α) = ⊤, by simp [-with_top.coe_one]
  | (some a) := show ↑a * ((1:α) : with_top α) = a, by simp [coe_mul.symm, -with_top.coe_one]
  end,
  .. with_top.mul_zero_class }

instance [mul_zero_class α] [no_zero_divisors α] : no_zero_divisors (with_top α) :=
⟨λ a b, by cases a; cases b; dsimp [mul_def]; split_ifs;
  simp [*, none_eq_top, some_eq_coe, mul_eq_zero] at *⟩

instance [semigroup_with_zero α] [no_zero_divisors α] : semigroup_with_zero (with_top α) :=
{ mul := (*),
  zero := 0,
  mul_assoc := λ a b c, begin
    cases a,
    { by_cases hb : b = 0; by_cases hc : c = 0;
        simp [*, none_eq_top] },
    cases b,
    { by_cases ha : a = 0; by_cases hc : c = 0;
        simp [*, none_eq_top, some_eq_coe] },
    cases c,
    { by_cases ha : a = 0; by_cases hb : b = 0;
        simp [*, none_eq_top, some_eq_coe] },
    simp [some_eq_coe, coe_mul.symm, mul_assoc]
  end,
  .. with_top.mul_zero_class }

instance [monoid_with_zero α] [no_zero_divisors α] [nontrivial α] : monoid_with_zero (with_top α) :=
{ .. with_top.mul_zero_one_class, .. with_top.semigroup_with_zero }

instance [comm_monoid_with_zero α] [no_zero_divisors α] [nontrivial α] :
  comm_monoid_with_zero (with_top α) :=
{ mul := (*),
  zero := 0,
  mul_comm := λ a b, begin
    by_cases ha : a = 0, { simp [ha] },
    by_cases hb : b = 0, { simp [hb] },
    simp [ha, hb, mul_def, option.bind_comm a b, mul_comm]
  end,
  .. with_top.monoid_with_zero }

variables [canonically_ordered_comm_semiring α]

private lemma distrib' (a b c : with_top α) : (a + b) * c = a * c + b * c :=
begin
  cases c,
  { show (a + b) * ⊤ = a * ⊤ + b * ⊤,
    by_cases ha : a = 0; simp [ha] },
  { show (a + b) * c = a * c + b * c,
    by_cases hc : c = 0, { simp [hc] },
    simp [mul_coe hc], cases a; cases b,
    repeat { refl <|> exact congr_arg some (add_mul _ _ _) } }
end

/-- This instance requires `canonically_ordered_comm_semiring` as it is the smallest class
that derives from both `non_assoc_non_unital_semiring` and `canonically_ordered_add_monoid`, both
of which are required for distributivity. -/
instance [nontrivial α] : comm_semiring (with_top α) :=
{ right_distrib   := distrib',
  left_distrib    := assume a b c, by rw [mul_comm, distrib', mul_comm b, mul_comm c]; refl,
  .. with_top.add_comm_monoid, .. with_top.comm_monoid_with_zero,}

instance [nontrivial α] : canonically_ordered_comm_semiring (with_top α) :=
{ .. with_top.comm_semiring,
  .. with_top.canonically_ordered_add_monoid,
  .. with_top.no_zero_divisors, }

end with_top

namespace with_bot

instance [nonempty α] : nontrivial (with_bot α) :=
option.nontrivial

variable [decidable_eq α]

section has_mul

variables [has_zero α] [has_mul α]

instance : mul_zero_class (with_bot α) :=
with_top.mul_zero_class

lemma mul_def {a b : with_bot α} :
  a * b = if a = 0 ∨ b = 0 then 0 else a.bind (λa, b.bind $ λb, ↑(a * b)) := rfl

@[simp] lemma mul_bot {a : with_bot α} (h : a ≠ 0) : a * ⊥ = ⊥ :=
with_top.mul_top h

@[simp] lemma bot_mul {a : with_bot α} (h : a ≠ 0) : ⊥ * a = ⊥ :=
with_top.top_mul h

@[simp] lemma bot_mul_bot : (⊥ * ⊥ : with_bot α) = ⊥ :=
with_top.top_mul_top

end has_mul

section mul_zero_class

variables [mul_zero_class α]

@[norm_cast] lemma coe_mul {a b : α} : (↑(a * b) : with_bot α) = a * b :=
decidable.by_cases (assume : a = 0, by simp [this]) $ assume ha,
decidable.by_cases (assume : b = 0, by simp [this]) $ assume hb,
by { simp [*, mul_def], refl }

lemma mul_coe {b : α} (hb : b ≠ 0) {a : with_bot α} : a * b = a.bind (λa:α, ↑(a * b)) :=
with_top.mul_coe hb

@[simp] lemma mul_eq_bot_iff {a b : with_bot α} : a * b = ⊥ ↔ (a ≠ 0 ∧ b = ⊥) ∨ (a = ⊥ ∧ b ≠ 0) :=
with_top.mul_eq_top_iff

lemma bot_lt_mul [partial_order α] {a b : with_bot α} (ha : ⊥ < a) (hb : ⊥ < b) : ⊥ < a * b :=
begin
  lift a to α using ne_bot_of_gt ha,
  lift b to α using ne_bot_of_gt hb,
  simp only [← coe_mul, bot_lt_coe],
end

end mul_zero_class

/-- `nontrivial α` is needed here as otherwise we have `1 * ⊥ = ⊥` but also `= 0 * ⊥ = 0`. -/
instance [mul_zero_one_class α] [nontrivial α] : mul_zero_one_class (with_bot α) :=
with_top.mul_zero_one_class

instance [mul_zero_class α] [no_zero_divisors α] : no_zero_divisors (with_bot α) :=
with_top.no_zero_divisors

instance [semigroup_with_zero α] [no_zero_divisors α] : semigroup_with_zero (with_bot α) :=
with_top.semigroup_with_zero

instance [monoid_with_zero α] [no_zero_divisors α] [nontrivial α] : monoid_with_zero (with_bot α) :=
with_top.monoid_with_zero

instance [comm_monoid_with_zero α] [no_zero_divisors α] [nontrivial α] :
  comm_monoid_with_zero (with_bot α) :=
with_top.comm_monoid_with_zero

instance [canonically_ordered_comm_semiring α] [nontrivial α] : comm_semiring (with_bot α) :=
with_top.comm_semiring

end with_bot


import Mathlib.Data.Real.Basic

/-
We have seen structures already. For example,
-/

namespace Notes

structure PartialOrder {α : Type} (R : α → α → Prop) where
  refl : ∀ {a b}, R a b → R b a → a = b
  antisym : ∀ {a b}, R a b → R b a → a = b
  trans : ∀ {a b c}, R a b → R b c → R a c

/-
Structures, also often called records, are useful for
combining different types into a single type. Another example
-/

structure Point3D (α : Type) where
  xCoord : α
  yCoord : α
  zCoord : α

structure HPoint3D (α β γ : Type) : Type where
  xCoord : α
  yCoord : β
  zCoord : γ

#check HPoint3D Bool ℝ String

/-
You tell Lean you are making a new type which is a structure by
using the `structure` keyword.

Next comes the identifier `PartialOrder` and `Point3D` in the examples.

After the identifier comes the _parameters_. These are things on which
the structure depends. So `PartialOrder` needs a relation `R` which
in turn needs the type `α` of values it is relating. `Point3D`
depends on a type `α` which is the type of the coordinates.

After the parameters, you can the `where` keyword (or a `:=`) to
tell Lean that the _fields_ of the structure are coming.

In `PartialOrder`, we have three fields and their types. Same
with `Point3d`.
-/

/- Suppose we want to tell Lean about the point (1,1,1) in `ℝ³`.
One way looks as follows
-/

def myPoint : Point3D ℝ :=
  { xCoord := 1
    yCoord := 1
    zCoord := 1 }

/- Printing `myPoint` shows the alternate syntax for declaring
instances of structures -/
#print myPoint

/- One more way to get an instance is to use the built-in
constructor. The default name `mk`. -/

#check Point3D.mk

example : Point3D ℝ := Point3D.mk 1 1 1
example : HPoint3D ℕ ℚ ℝ := HPoint3D.mk 1 1 1

/- We can change the name of the default constructor if
we wish. This is why we can write `And.intro` and `Exists.intro`
in place of `And.mk` and `Exists.mk` -/

#check And

structure Point3D' (α : Type) where
build::
  xCoord : α
  yCoord : α
  zCoord : α

example : Point3D ℝ := .mk 1 1 1

-- example : Point3D' ℝ := .mk 1 1 1

/- One more way to build a structure is using the _anonymous
constructor_ notation -/

example : Point3D ℝ := ⟨1,1,1⟩

-- This doesn't work because `ℕ` is a not a structure
-- example : ℕ := ⟨0⟩

/- Here the brackets are typed \< and \>. Lean knows from the
context that you need to put a term of type `Point3D ℝ` so
understands what structure you are building from just the `1`'s.
-/

/- We can extend structures -/

structure Point4D (α : Type) extends Point3D α where
  time : α

example {α : Type} (p : Point3D α) (t : α) : Point4D α := ⟨p,t⟩

example {α : Type} (p : Point4D α) : α := p.toPoint3D.xCoord

/- There is syntax for updating fields -/

example {α : Type} (p : Point3D α) (x : α) : Point3D α := {p with xCoord := x}

def myNewPt : Point3D ℝ := {myPoint with xCoord := 0}

#print myNewPt

/- Often is it useful to provide default values -/

structure UserData where
  name : String  := "Andres Galarraga"
  uid : ℕ  := 0
  email : String

def andres : UserData := {email := "ag@email.sc.edu"}

#print andres

/- Lean allows us the flexibility for fields in a structure
to depend on other fields -/

structure LawlessGroup where
  Carrier : Type
  unit : Carrier
  mul : Carrier → Carrier → Carrier
  inv : Carrier → Carrier

#print LawlessGroup.unit

-- `ℝ` is actually a group under addition
example : LawlessGroup where
  Carrier := ℝ
  unit := 0
  mul := fun x y => x + y
  inv := fun x => -x

-- This is not a real group which is why called it lawless.
example : LawlessGroup := ⟨ℕ, 37, fun _ _ => 0, (·+1) ⟩

namespace Better

structure LawlessGroup (G : Type) where
  unit : G
  mul : G → G → G
  inv : G → G

structure Group (G : Type) extends LawlessGroup G where
  mul_unit : ∀ g, mul g unit = g
  unit_mul : ∀ g, mul unit g = g
  mul_inv : ∀ g, mul g (inv g) = unit
  inv_mul : ∀ g, mul (inv g) g = unit

end Better

/- Under the hood, a `structure` is essentially a inductive type
with a single constructor which is why the following works. -/

namespace Inductive

inductive Inhabited (α : Type) where
 | default (a : α) : Inhabited α

example : Inhabited ℝ := ⟨-1⟩

/- So `LawlessGroup` similar to -/

inductive LawlessGroup
  | mk : ∀ (Carrier :Type), Carrier → (Carrier → Carrier → Carrier) → (Carrier → Carrier) → LawlessGroup

def LawlessGroup.Carrier : LawlessGroup → Type
  | .mk Carrier _ _ _ => Carrier

def LawlessGroup.unit : (self : LawlessGroup) → self.Carrier
  | .mk _ unit _ _ => unit

def LawlessGroup.mul : (self : LawlessGroup) → self.Carrier → self.Carrier → self.Carrier
  | .mk _ _ mul _ => mul

def LawlessGroup.inv : (self : LawlessGroup) → self.Carrier → self.Carrier
  | .mk _ _ _ inv => inv

def ok : LawlessGroup := .mk ℝ 0 (·+·) (-·)

#check ok.Carrier

#check ok.unit

#check ok.mul

#check ok.inv

end Inductive

/- In general, structures can be more _bundled_ where parameters
are pushed into the fields or more _unbundled_ where fields are
pushed into the parameters -/

structure LawlessGroup' (Carrier : Type) where
  unit : Carrier
  mul : Carrier → Carrier → Carrier
  inv : Carrier → Carrier


/-
Copyright (c) 2021 Anne Baanen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anne Baanen
-/
import algebra.order.euclidean_absolute_value
import data.polynomial.field_division

/-!
# Absolute value on polynomials over a finite field.

Let `Fq` be a finite field of cardinality `q`, then the map sending a polynomial `p`
to `q ^ degree p` (where `q ^ degree 0 = 0`) is an absolute value.

## Main definitions

 * `polynomial.card_pow_degree` is an absolute value on `𝔽_q[t]`, the ring of
   polynomials over a finite field of cardinality `q`, mapping a polynomial `p`
   to `q ^ degree p` (where `q ^ degree 0 = 0`)

## Main results
 * `polynomial.card_pow_degree_is_euclidean`: `card_pow_degree` respects the
   Euclidean domain structure on the ring of polynomials

-/

namespace polynomial

variables {Fq : Type*} [field Fq] [fintype Fq]

open absolute_value

open_locale classical polynomial

/-- `card_pow_degree` is the absolute value on `𝔽_q[t]` sending `f` to `q ^ degree f`.

`card_pow_degree 0` is defined to be `0`. -/
noncomputable def card_pow_degree :
  absolute_value Fq[X] ℤ :=
have card_pos : 0 < fintype.card Fq := fintype.card_pos_iff.mpr infer_instance,
have pow_pos : ∀ n, 0 < (fintype.card Fq : ℤ) ^ n := λ n, pow_pos (int.coe_nat_pos.mpr card_pos) n,
{ to_fun := λ p, if p = 0 then 0 else fintype.card Fq ^ p.nat_degree,
  nonneg' := λ p, by { dsimp, split_ifs, { refl }, exact pow_nonneg (int.coe_zero_le _) _ },
  eq_zero' := λ p, ite_eq_left_iff.trans $ ⟨λ h, by { contrapose! h, exact ⟨h, (pow_pos _).ne'⟩ },
    absurd⟩,
  add_le' := λ p q, begin
    by_cases hp : p = 0, { simp [hp] },
    by_cases hq : q = 0, { simp [hq] },
    by_cases hpq : p + q = 0,
    { simp only [hpq, hp, hq, eq_self_iff_true, if_true, if_false],
      exact add_nonneg (pow_pos _).le (pow_pos _).le },
    simp only [hpq, hp, hq, if_false],
    refine le_trans (pow_le_pow (by linarith) (polynomial.nat_degree_add_le _ _)) _,
    refine le_trans (le_max_iff.mpr _)
      (max_le_add_of_nonneg (pow_nonneg (by linarith) _) (pow_nonneg (by linarith) _)),
    exact (max_choice p.nat_degree q.nat_degree).imp (λ h, by rw [h]) (λ h, by rw [h])
  end,
  map_mul' := λ p q, begin
    by_cases hp : p = 0, { simp [hp] },
    by_cases hq : q = 0, { simp [hq] },
    have hpq : p * q ≠ 0 := mul_ne_zero hp hq,
    simp only [hpq, hp, hq, eq_self_iff_true, if_true, if_false,
      polynomial.nat_degree_mul hp hq, pow_add],
  end }

lemma card_pow_degree_apply (p : Fq[X]) :
  card_pow_degree p = if p = 0 then 0 else fintype.card Fq ^ nat_degree p := rfl

@[simp] lemma card_pow_degree_zero : card_pow_degree (0 : Fq[X]) = 0 := if_pos rfl

@[simp] lemma card_pow_degree_nonzero (p : Fq[X]) (hp : p ≠ 0) :
  card_pow_degree p = fintype.card Fq ^ p.nat_degree :=
if_neg hp

lemma card_pow_degree_is_euclidean :
  is_euclidean (card_pow_degree : absolute_value Fq[X] ℤ) :=
have card_pos : 0 < fintype.card Fq := fintype.card_pos_iff.mpr infer_instance,
have pow_pos : ∀ n, 0 < (fintype.card Fq : ℤ) ^ n := λ n, pow_pos (int.coe_nat_pos.mpr card_pos) n,
{ map_lt_map_iff' := λ p q, begin
    simp only [euclidean_domain.r, card_pow_degree_apply],
    split_ifs with hp hq hq,
    { simp only [hp, hq, lt_self_iff_false] },
    { simp only [hp, hq, degree_zero, ne.def, bot_lt_iff_ne_bot,
        degree_eq_bot, pow_pos, not_false_iff] },
    { simp only [hp, hq, degree_zero, not_lt_bot, (pow_pos _).not_lt] },
    { rw [degree_eq_nat_degree hp, degree_eq_nat_degree hq, with_bot.coe_lt_coe, pow_lt_pow_iff],
      exact_mod_cast @fintype.one_lt_card Fq _ _ },
  end }

end polynomial


/-

lemma divides_p_times (r : ℕ) (n : ℕ) : p^r ∣ n ↔ p^(r+1) ∣ (p * n) :=
calc p^r ∣ n ↔ (p * p^r) ∣ (p * n)  : (nat.mul_dvd_mul_iff_left (gt_zero hp)).symm
     ...     = (p^r * p ∣ p * n)     : by rw mul_comm

lemma exactly_divides_p_times (r : ℕ) (n : ℕ) : p^r ∣∣ n ↔ p^(r+1) ∣∣ (p * n) :=
have eq : (p * n) / p^(r+1) = n / p^r, from
calc (p * n) / p^(r+1) = (p * n) / (p^r * p)  : rfl
     ...               = (p * n) / (p * p^r)  : by rw mul_comm (p^r) p
     ...               = (p * n) / p / p^r    : by rw nat.div_div_eq_div_mul
     ...               = n / p^r    : by rw (nat.mul_div_cancel_left n (gt_zero hp)),
--      : congr_arg (λ m, m / p^r) (nat.mul_div_cancel_left n gt_zero),
and_congr (divides_p_times hp r n) (by rw eq)

lemma exactly_divides' {r : ℕ} {n : ℕ} : p^r ∣∣ n → (∀ i, p^i ∣ n ↔ i ≤ r) :=
begin
  intros prn i, apply iff.intro,
  { intro pin,
    apply (le_or_gt _ _).resolve_right, intro i_gt_r,
    have :=
    calc p^r * p = p^(r+1)  : rfl
         ...     ∣ p^i      : pow_dvd_pow p i_gt_r
         ...     ∣ n        : pin,
    exact absurd (dvd_div_of_mul_dvd (pos_pow_of_pos r (gt_zero hp)) this) prn.right,
  },
  { intro i_le_r,
    exact dvd.trans (pow_dvd_pow p i_le_r) (and.left prn) }
end

-/

/-

lemma exactly_divides_mul (r s a b : ℕ) : p^r ∣∣ a → p^s ∣∣ b → p^(r+s) ∣∣ a*b :=
begin
  intros pra psb, split,
  { rw nat.pow_add, exact mul_dvd_mul pra.left psb.left },
  let a' := a / p^r,
  have ha : p^r * a' = a := nat.mul_div_cancel' pra.left,
  let b' := b / p^s,
  have hb : p^s * b' = b := nat.mul_div_cancel' psb.left,
  have : (a * b) / (p^(r+s)) = (a / p^r) * (b / p^s) :=
  calc (a * b) / (p^(r+s)) = ((p^r * a') * (p^s * b')) / (p^r * p^s)
    : by rw [ha, hb, pow_add]
       ...                 = ((p^r * p^s) * (a' * b')) / (p^r * p^s)
    : by ac_refl
       ...                 = a' * b'
    : by rw nat.mul_div_cancel_left _
            (mul_pos (pos_pow_of_pos r (gt_zero hp)) (pos_pow_of_pos s (gt_zero hp)))
       ...                 = (a / p^r) * (b / p^s)  : rfl,
  rw this,
  exact prime.not_dvd_mul hp pra.right psb.right
end

-/


import order.complete_lattice order.order_iso order.fixed_points

open lattice

universe u

variables {α : Type u} [complete_lattice α]
variables (f : α → α) (M : monotone f)

def fixed_points : set α := { x | f x = x }

namespace fixed_points

def previous (x : α) : α :=
gfp (λ z, x ⊓ f z)

variable {f}

theorem previous.le {x : α} : previous f x ≤ x :=
gfp_le $ λ z hz, le_trans hz inf_le_left

theorem previous.le_apply {x : α} : previous f x ≤ f (previous f x) :=
gfp_le $ λ z hz, le_trans (le_trans hz inf_le_right) $ M $ le_gfp hz

theorem previous.fixed {x : α} (H : f x ≤ x) : f (previous f x) = previous f x :=
le_antisymm
  (le_gfp $ le_inf (le_trans (M previous.le) H) (M $ previous.le_apply M))
  (previous.le_apply M)

variable f

def next (x : α) : α :=
lfp (λ z, x ⊔ f z)

variable {f}

theorem next.le {x : α} : x ≤ next f x :=
le_lfp $ λ z hz, le_trans le_sup_left hz

theorem next.apply_le {x : α} : f (next f x) ≤ next f x :=
le_lfp $ λ z hz, le_trans (le_trans (M $ show next f x ≤ z, from lfp_le hz) le_sup_right) hz

theorem next.fixed {x : α} (H : x ≤ f x) : f (next f x) = next f x :=
le_antisymm
  (next.apply_le M)
  (lfp_le $ sup_le (le_trans H (M next.le)) (M $ next.apply_le M))

variable f

theorem sup_le_f_of_fixed_points (x y : fixed_points f) : x.1 ⊔ y.1 ≤ f (x.1 ⊔ y.1) :=
sup_le
  (x.2 ▸ (M $ show x.1 ≤ f x.1 ⊔ y.1, from x.2.symm ▸ le_sup_left))
  (y.2 ▸ (M $ show y.1 ≤ x.1 ⊔ f y.1, from y.2.symm ▸ le_sup_right))

theorem f_le_inf_of_fixed_points (x y : fixed_points f) : f (x.1 ⊓ y.1) ≤ x.1 ⊓ y.1 :=
le_inf
  (x.2 ▸ (M $ show f (x.1) ⊓ y.1 ≤ x.1, from x.2.symm ▸ inf_le_left))
  (y.2 ▸ (M $ show x.1 ⊓ f (y.1) ≤ y.1, from y.2.symm ▸ inf_le_right))

theorem Sup_le_f_of_fixed_points (A : set α) (HA : A ⊆ fixed_points f) : Sup A ≤ f (Sup A) :=
Sup_le $ λ x hxA, (HA hxA) ▸ (M $ le_Sup hxA)

theorem f_le_Inf_of_fixed_points (A : set α) (HA : A ⊆ fixed_points f) : f (Inf A) ≤ Inf A :=
le_Inf $ λ x hxA, (HA hxA) ▸ (M $ Inf_le hxA)

instance : complete_lattice (fixed_points f) :=
{ le           := subrel (≤) _,
  le_refl      := λ x, le_refl x,
  le_trans     := λ x y z, le_trans,
  le_antisymm  := λ x y hx hy, subtype.eq $ le_antisymm hx hy,

  sup          := λ x y, ⟨next f (x.1 ⊔ y.1), next.fixed M (sup_le_f_of_fixed_points f M x y)⟩,
  le_sup_left  := λ x y, show x.1 ≤ _, from le_trans le_sup_left next.le,
  le_sup_right := λ x y, show y.1 ≤ _, from le_trans le_sup_right next.le,
  sup_le       := λ x y z hxz hyz, lfp_le $ sup_le (sup_le hxz hyz) (z.2.symm ▸ le_refl z.1),

  inf          := λ x y, ⟨previous f (x.1 ⊓ y.1), previous.fixed M (f_le_inf_of_fixed_points f M x y)⟩,
  inf_le_left  := λ x y, show _ ≤ x.1, from le_trans previous.le inf_le_left,
  inf_le_right := λ x y, show _ ≤ y.1, from le_trans previous.le inf_le_right,
  le_inf       := λ x y z hxy hxz, le_gfp $ le_inf (le_inf hxy hxz) (x.2.symm ▸ le_refl x),

  top          := ⟨previous f ⊤, previous.fixed M le_top⟩,
  le_top       := λ ⟨x, H⟩, le_gfp $ le_inf le_top (H.symm ▸ le_refl x),

  bot          := ⟨next f ⊥, next.fixed M bot_le⟩,
  bot_le       := λ ⟨x, H⟩, lfp_le $ sup_le bot_le (H.symm ▸ le_refl x),

  Sup          := λ A, ⟨next f (Sup $ subtype.val '' A), next.fixed M (Sup_le_f_of_fixed_points f M (subtype.val '' A) (λ z ⟨x, hx⟩, hx.2 ▸ x.2))⟩,
  le_Sup       := λ A x hxA, show x.1 ≤ _, from le_trans
                    (le_Sup $ show x.1 ∈ subtype.val '' A, from ⟨x, hxA, rfl⟩)
                    next.le,
  Sup_le       := λ A x Hx, lfp_le $ sup_le (Sup_le $ λ z ⟨y, hyA, hyz⟩, hyz ▸ Hx y hyA) (x.2.symm ▸ le_refl x),

  Inf          := λ A, ⟨previous f (Inf $ subtype.val '' A), previous.fixed M (f_le_Inf_of_fixed_points f M (subtype.val '' A) (λ z ⟨x, hx⟩, hx.2 ▸ x.2))⟩,
  le_Inf       := λ A x Hx, le_gfp $ le_inf (le_Inf $ λ z ⟨y, hyA, hyz⟩, hyz ▸ Hx y hyA) (x.2.symm ▸ le_refl x.1),
  Inf_le       := λ A x hxA, show _ ≤ x.1, from le_trans
                    previous.le
                    (Inf_le $ show x.1 ∈ subtype.val '' A, from ⟨x, hxA, rfl⟩) }

end fixed_points


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

import data.mv_polynomial.rename

/-!
# `comap` operation on `mv_polynomial`

This file defines the `comap` function on `mv_polynomial`.

`mv_polynomial.comap` is a low-tech example of a map of "algebraic varieties," modulo the fact that
`mathlib` does not yet define varieties.

## Notation

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

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

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

-/

namespace mv_polynomial
variables {σ : Type*} {τ : Type*} {υ : Type*} {R : Type*} [comm_semiring R]

/--
Given an algebra hom `f : mv_polynomial σ R →ₐ[R] mv_polynomial τ R`
and a variable evaluation `v : τ → R`,
`comap f v` produces a variable evaluation `σ → R`.
-/
noncomputable def comap (f : mv_polynomial σ R →ₐ[R] mv_polynomial τ R) :
  (τ → R) → (σ → R) :=
λ x i, aeval x (f (X i))

@[simp] lemma comap_apply (f : mv_polynomial σ R →ₐ[R] mv_polynomial τ R) (x : τ → R) (i : σ) :
  comap f x i = aeval x (f (X i)) := rfl

@[simp] lemma comap_id_apply (x : σ → R) : comap (alg_hom.id R (mv_polynomial σ R)) x = x :=
by { funext i, simp only [comap, alg_hom.id_apply, id.def, aeval_X], }

variables (σ R)

lemma comap_id : comap (alg_hom.id R (mv_polynomial σ R)) = id :=
by { funext x, exact comap_id_apply x }

variables {σ R}

lemma comap_comp_apply (f : mv_polynomial σ R →ₐ[R] mv_polynomial τ R)
  (g : mv_polynomial τ R →ₐ[R] mv_polynomial υ R) (x : υ → R) :
  comap (g.comp f) x = comap f (comap g x) :=
begin
  funext i,
  transitivity (aeval x (aeval (λ i, g (X i)) (f (X i)))),
  { apply eval₂_hom_congr rfl rfl,
    rw alg_hom.comp_apply,
    suffices : g = aeval (λ i, g (X i)), { rw ← this, },
    exact aeval_unique g },
  { simp only [comap, aeval_eq_eval₂_hom, map_eval₂_hom, alg_hom.comp_apply],
    refine eval₂_hom_congr _ rfl rfl,
    ext r, apply aeval_C },
end

lemma comap_comp (f : mv_polynomial σ R →ₐ[R] mv_polynomial τ R)
  (g : mv_polynomial τ R →ₐ[R] mv_polynomial υ R) :
  comap (g.comp f) = comap f ∘ comap g :=
by { funext x, exact comap_comp_apply _ _ _ }

lemma comap_eq_id_of_eq_id (f : mv_polynomial σ R →ₐ[R] mv_polynomial σ R)
  (hf : ∀ φ, f φ = φ) (x : σ → R) :
  comap f x = x :=
by { convert comap_id_apply x, ext1 φ, rw [hf, alg_hom.id_apply] }

lemma comap_rename (f : σ → τ) (x : τ → R) : comap (rename f) x = x ∘ f :=
by { ext i, simp only [rename_X, comap_apply, aeval_X] }

/--
If two polynomial types over the same coefficient ring `R` are equivalent,
there is a bijection between the types of functions from their variable types to `R`.
-/
noncomputable def comap_equiv (f : mv_polynomial σ R ≃ₐ[R] mv_polynomial τ R) :
  (τ → R) ≃ (σ → R) :=
{ to_fun    := comap f,
  inv_fun   := comap f.symm,
  left_inv  := by { intro x, rw [← comap_comp_apply], apply comap_eq_id_of_eq_id, intro,
    simp only [alg_hom.id_apply, alg_equiv.comp_symm], },
  right_inv := by { intro x, rw [← comap_comp_apply], apply comap_eq_id_of_eq_id, intro,
  simp only [alg_hom.id_apply, alg_equiv.symm_comp] }, }

@[simp] lemma comap_equiv_coe (f : mv_polynomial σ R ≃ₐ[R] mv_polynomial τ R) :
  (comap_equiv f : (τ → R) → (σ → R)) = comap f := rfl

@[simp] lemma comap_equiv_symm_coe (f : mv_polynomial σ R ≃ₐ[R] mv_polynomial τ R) :
  ((comap_equiv f).symm : (σ → R) → (τ → R)) = comap f.symm := rfl

end mv_polynomial


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

! This file was ported from Lean 3 source module algebra.category.Module.products
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.LinearAlgebra.Pi
import Mathbin.Algebra.Category.Module.Basic

/-!
# The concrete products in the category of modules are products in the categorical sense.
-/

open CategoryTheory

open CategoryTheory.Limits

universe u v w

namespace ModuleCat

variable {R : Type u} [Ring R]

variable {ι : Type v} (Z : ι → ModuleCat.{max v w} R)

/-- The product cone induced by the concrete product. -/
def productCone : Fan Z :=
  Fan.mk (ModuleCat.of R (∀ i : ι, Z i)) fun i => (LinearMap.proj i : (∀ i : ι, Z i) →ₗ[R] Z i)
#align Module.product_cone ModuleCat.productCone

/-- The concrete product cone is limiting. -/
def productConeIsLimit : IsLimit (productCone Z)
    where
  lift s := (LinearMap.pi fun j => s.π.app ⟨j⟩ : s.pt →ₗ[R] ∀ i : ι, Z i)
  fac s j := by
    cases j
    tidy
  uniq s m w := by
    ext (x i)
    exact LinearMap.congr_fun (w ⟨i⟩) x
#align Module.product_cone_is_limit ModuleCat.productConeIsLimit

-- While we could use this to construct a `has_products (Module R)` instance,
-- we already have `has_limits (Module R)` in `algebra.category.Module.limits`.
variable [HasProduct Z]

/-- The categorical product of a family of objects in `Module`
agrees with the usual module-theoretical product.
-/
noncomputable def piIsoPi : ∏ Z ≅ ModuleCat.of R (∀ i, Z i) :=
  limit.isoLimitCone ⟨_, productConeIsLimit Z⟩
#align Module.pi_iso_pi ModuleCat.piIsoPi

-- We now show this isomorphism commutes with the inclusion of the kernel into the source.
@[simp, elementwise]
theorem piIsoPi_inv_kernel_ι (i : ι) :
    (piIsoPi Z).inv ≫ Pi.π Z i = (LinearMap.proj i : (∀ i : ι, Z i) →ₗ[R] Z i) :=
  limit.isoLimitCone_inv_π _ _
#align Module.pi_iso_pi_inv_kernel_ι ModuleCat.piIsoPi_inv_kernel_ι

@[simp, elementwise]
theorem piIsoPi_hom_ker_subtype (i : ι) :
    (piIsoPi Z).hom ≫ (LinearMap.proj i : (∀ i : ι, Z i) →ₗ[R] Z i) = Pi.π Z i :=
  IsLimit.conePointUniqueUpToIso_inv_comp _ (limit.isLimit _) (Discrete.mk i)
#align Module.pi_iso_pi_hom_ker_subtype ModuleCat.piIsoPi_hom_ker_subtype

end ModuleCat


  import utilities

open list
open multiset
open set
open nat

set_option trace.simplify.rewrite true

variables {α : Type*} {κ : Type*}
variable r: κ → κ → Prop
variables (x: α) (k: κ ) (xs: list α)
variables (f: α → κ) (P: α → Prop)

/-
# Insertion Sort w.r.t. Keys and Stability
-/

def insort_key [decidable_rel r] [is_linear_order κ r] : list α → list α
| []       := [x]
| (y :: ys) := if r (f x) (f y) then x :: y :: ys else y :: insort_key ys

def isort_key [decidable_rel r] [is_linear_order κ r]: list α → list α
| []       := []
| (x :: xs) := insort_key r x f (isort_key xs)

/-
## Functional Correctness
 -/

lemma mset_insort_key [decidable_rel r] [is_linear_order κ r]:
  ((insort_key r x f xs): multiset α) = {x} + ↑ xs :=
begin
  induction' xs,
  { refl},
  simp [insort_key],
  split_ifs,
  { refl},
  simp [← multiset.cons_coe, ih],
end

lemma mset_isort_key [decidable_rel r] [is_linear_order κ r]: (↑ (isort_key r f xs): multiset α) = ↑ xs :=
begin
  induction' xs,
  { refl},
  simp [mset_insort_key, isort_key, ih],
  refl,
end

lemma set_insort_key [decidable_rel r] [is_linear_order κ r]: (insort_key r x f xs).to_set = {x} ∪ xs.to_set:=
begin
  simp [← set_mset_mset, mset_insort_key, multiset.to_set],
  refl
end

lemma set_isort_key [decidable_rel r] [is_linear_order κ r]: (isort_key r f xs).to_set = xs.to_set :=
begin
  simp [← set_mset_mset, mset_isort_key],
end

lemma sorted_insort_key [decidable_rel r] [is_linear_order κ r]:
  sorted' r ((insort_key r x f xs).map f) = sorted' r (xs.map f) :=
begin
  induction' xs fixing *,
  { simp [insort_key, sorted'],
    intros,
    exact false.elim H},
  simp [insort_key],
  split_ifs,
  { simp [sorted', list.to_set],
    intros h1 h2,
    apply and.intro h,
    intros k h3,
    exact trans h (h1 k h3) },
  simp [sorted', ih],
  intros h1,
  simp [← set_mset_mset, ← multiset.coe_map, mset_insort_key, multiset.to_set],
  intros h2,
  exact or.resolve_left (total_of r (f x) (f hd)) h
end

lemma sorted_isort_key [decidable_rel r] [is_linear_order κ r] :
  sorted' r (map f (isort_key r f xs)) :=
begin
  induction' xs,
  repeat { simp [isort_key, sorted_insort_key, *] },
end

/-
## Stability
-/

lemma insort_is_Cons [decidable_rel r] [is_linear_order κ r]:
  (∀ a ∈ xs.to_set, r (f x) (f a)) → insort_key r x f xs = (x:: xs):=
begin
  cases xs,
  repeat { simp [insort_key, list.to_set] },
  intros h h1 h2,
  cc,
end

lemma filter_insort_key_neg [decidable_rel r] [is_linear_order κ r] [decidable_pred P]:
  ¬ P x → (insort_key r x f xs).filter P = xs.filter P :=
begin
  induction xs,
  { intro h,
    simp [insort_key, *] },
  simp [insort_key],
  split_ifs,
  { intro h1,
    simp * },
  intro h1,
  simp [list.filter, xs_ih h1],
end

lemma filter_insort_key_pos [decidable_rel r] [is_linear_order κ r] [decidable_pred P]:
  sorted' r (xs.map f) ∧ P x → (insort_key r x f xs).filter P = insort_key r x f (xs.filter P) :=
begin
  induction xs,
  { intro,
    simp [insort_key, *] },
  simp [sorted', list.filter, insort_key],
  split_ifs,
  { intros,
    simp [insort_key, *] },
  { have h5: (∀ a ∈ (list.filter P xs_tl).to_set, r (f x) (f a)) → insort_key r x f (filter P     xs_tl) = (x:: (filter P xs_tl)), from insort_is_Cons r x (filter P xs_tl) f,
    simp [ ← member_list_set] at h5 |-,
    intros h2 h3 h4,
    have h6: ∀ (a : α), a ∈ xs_tl → P a → r (f x) (f a), from begin
      intros a h7 h8,
      exact trans_of r h (h2 a h7),
    end,
    simp [*, h5 h6] },
  { intros,
    simp [list.filter, *, insort_key] },
  intros,
  simp [list.filter, *],
end

/-
Lemma 2.9 from __Functional Algorithms Verified!__
-/
lemma sort_key_stable [decidable_rel r] [is_linear_order κ r] [decidable_pred (λ y, f y = k)]:
  (isort_key r f xs).filter (λ y, f y = k) = xs.filter (λ y, f y = k):=
begin
  induction xs,
  repeat { simp [isort_key, list.filter] },
  split_ifs,
  { simp [isort_key, *, filter_insort_key_pos, sorted_isort_key, ← member_list_set],
    have h1: (∀ a ∈ (list.filter (λ (y : α), f y = k) xs_tl).to_set, r (f _) (f a)) → insort_key r _ f _ = (_:: _) , from insort_is_Cons r xs_hd (filter (λ (y : α), f y = k) xs_tl) f,
    have h3: ∀ (a : α), a ∈ (list.filter (λ (y : α), f y = k) xs_tl).to_set → r (f xs_hd) (f a), from begin
      intros,
      simp [← member_list_set, *] at *,
      exact refl_of r k,
    end,
    exact h1 h3 },
  simp [isort_key, filter_insort_key_neg, *],
end


import data.set.basic
open function set

theorem question5 (X Y Z : Type) (f : X → Z) (g : Y → Z) (hf : injective f) (hg : injective g) :
  (∃ h : X → Y, bijective h ∧ f = g ∘ h) ↔ (set.range f = set.range g) :=
begin
  split,
  { rintro ⟨h, h1, h2⟩,
    ext z,
    split,
      rintro ⟨x, hx⟩,
      use (h x),
      convert hx,
      rw h2,
    rintro ⟨y, hy⟩,
    cases h1 with hinj hsurj,
    cases hsurj y with x hx,
    use x,
    rw ←hy,
    rw ←hx,
    rw h2
  },
  { intro hfg,
    have hx : ∀ x : X, ∃ y : Y, g y = f x,
      intro x,
      have hx : f x ∈ range f, use x,
      rw hfg at hx,
      exact hx,
    choose h hh using hx,
    use h,
    split,
      split,
        intros x1 x2 h12,
        apply hf,
        rw ←hh,
        rw h12,
        exact hh x2,
      intro y,
      have hy : g y ∈ range g, use y,
      rw ←hfg at hy,
      cases hy with x hx,
      use x,
      apply hg,
      convert hx,
      exact hh x,
    ext x,
    exact (hh x).symm
  }
end

#check eq.trans