/-
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 Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.ordered_group
import Mathlib.data.set.intervals.basic
import Mathlib.PostPort

universes u l u_1

namespace Mathlib

/-- An `ordered_semiring α` is a semiring `α` with a partial order such that
multiplication with a positive number and addition are monotone. -/
class ordered_semiring (α : Type u)
extends ordered_cancel_add_comm_monoid α, semiring α
where
  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

theorem zero_le_one {α : Type u} [ordered_semiring α] : 0 ≤ 1 :=
  ordered_semiring.zero_le_one

theorem zero_le_two {α : Type u} [ordered_semiring α] : 0 ≤ bit0 1 :=
  add_nonneg zero_le_one zero_le_one

theorem zero_lt_one {α : Type u} [ordered_semiring α] [nontrivial α] : 0 < 1 :=
  lt_of_le_of_ne zero_le_one zero_ne_one

theorem zero_lt_two {α : Type u} [ordered_semiring α] [nontrivial α] : 0 < bit0 1 :=
  add_pos zero_lt_one zero_lt_one

theorem two_ne_zero {α : Type u} [ordered_semiring α] [nontrivial α] : bit0 1 ≠ 0 :=
  ne.symm (ne_of_lt zero_lt_two)

theorem one_lt_two {α : Type u} [ordered_semiring α] [nontrivial α] : 1 < bit0 1 :=
  trans_rel_left gt (trans_rel_right gt one_add_one_eq_two (add_lt_add_left zero_lt_one 1)) (add_zero 1)

theorem one_le_two {α : Type u} [ordered_semiring α] [nontrivial α] : 1 ≤ bit0 1 :=
  has_lt.lt.le one_lt_two

theorem zero_lt_three {α : Type u} [ordered_semiring α] [nontrivial α] : 0 < bit1 1 :=
  add_pos zero_lt_two zero_lt_one

theorem zero_lt_four {α : Type u} [ordered_semiring α] [nontrivial α] : 0 < bit0 (bit0 1) :=
  add_pos zero_lt_two zero_lt_two

theorem mul_lt_mul_of_pos_left {α : Type u} [ordered_semiring α] {a : α} {b : α} {c : α} (h₁ : a < b) (h₂ : 0 < c) : c * a < c * b :=
  ordered_semiring.mul_lt_mul_of_pos_left a b c h₁ h₂

theorem mul_lt_mul_of_pos_right {α : Type u} [ordered_semiring α] {a : α} {b : α} {c : α} (h₁ : a < b) (h₂ : 0 < c) : a * c < b * c :=
  ordered_semiring.mul_lt_mul_of_pos_right a b c h₁ h₂

theorem mul_le_mul_of_nonneg_left {α : Type u} [ordered_semiring α] {a : α} {b : α} {c : α} (h₁ : a ≤ b) (h₂ : 0 ≤ c) : c * a ≤ c * b := sorry

theorem mul_le_mul_of_nonneg_right {α : Type u} [ordered_semiring α] {a : α} {b : α} {c : α} (h₁ : a ≤ b) (h₂ : 0 ≤ c) : a * c ≤ b * c := sorry

-- TODO: there are four variations, depending on which variables we assume to be nonneg

theorem mul_le_mul {α : Type u} [ordered_semiring α] {a : α} {b : α} {c : α} {d : α} (hac : a ≤ c) (hbd : b ≤ d) (nn_b : 0 ≤ b) (nn_c : 0 ≤ c) : a * b ≤ c * d :=
  le_trans (mul_le_mul_of_nonneg_right hac nn_b) (mul_le_mul_of_nonneg_left hbd nn_c)

theorem mul_nonneg {α : Type u} [ordered_semiring α] {a : α} {b : α} (ha : 0 ≤ a) (hb : 0 ≤ b) : 0 ≤ a * b :=
  (fun (h : 0 * b ≤ a * b) => eq.mp (Eq._oldrec (Eq.refl (0 * b ≤ a * b)) (zero_mul b)) h)
    (mul_le_mul_of_nonneg_right ha hb)

theorem mul_nonpos_of_nonneg_of_nonpos {α : Type u} [ordered_semiring α] {a : α} {b : α} (ha : 0 ≤ a) (hb : b ≤ 0) : a * b ≤ 0 :=
  (fun (h : a * b ≤ a * 0) => eq.mp (Eq._oldrec (Eq.refl (a * b ≤ a * 0)) (mul_zero a)) h)
    (mul_le_mul_of_nonneg_left hb ha)

theorem mul_nonpos_of_nonpos_of_nonneg {α : Type u} [ordered_semiring α] {a : α} {b : α} (ha : a ≤ 0) (hb : 0 ≤ b) : a * b ≤ 0 :=
  (fun (h : a * b ≤ 0 * b) => eq.mp (Eq._oldrec (Eq.refl (a * b ≤ 0 * b)) (zero_mul b)) h)
    (mul_le_mul_of_nonneg_right ha hb)

theorem mul_lt_mul {α : Type u} [ordered_semiring α] {a : α} {b : α} {c : α} {d : α} (hac : a < c) (hbd : b ≤ d) (pos_b : 0 < b) (nn_c : 0 ≤ c) : a * b < c * d :=
  lt_of_lt_of_le (mul_lt_mul_of_pos_right hac pos_b) (mul_le_mul_of_nonneg_left hbd nn_c)

theorem mul_lt_mul' {α : Type u} [ordered_semiring α] {a : α} {b : α} {c : α} {d : α} (h1 : a ≤ c) (h2 : b < d) (h3 : 0 ≤ b) (h4 : 0 < c) : a * b < c * d :=
  lt_of_le_of_lt (mul_le_mul_of_nonneg_right h1 h3) (mul_lt_mul_of_pos_left h2 h4)

theorem mul_pos {α : Type u} [ordered_semiring α] {a : α} {b : α} (ha : 0 < a) (hb : 0 < b) : 0 < a * b :=
  (fun (h : 0 * b < a * b) => eq.mp (Eq._oldrec (Eq.refl (0 * b < a * b)) (zero_mul b)) h) (mul_lt_mul_of_pos_right ha hb)

theorem mul_neg_of_pos_of_neg {α : Type u} [ordered_semiring α] {a : α} {b : α} (ha : 0 < a) (hb : b < 0) : a * b < 0 :=
  (fun (h : a * b < a * 0) => eq.mp (Eq._oldrec (Eq.refl (a * b < a * 0)) (mul_zero a)) h) (mul_lt_mul_of_pos_left hb ha)

theorem mul_neg_of_neg_of_pos {α : Type u} [ordered_semiring α] {a : α} {b : α} (ha : a < 0) (hb : 0 < b) : a * b < 0 :=
  (fun (h : a * b < 0 * b) => eq.mp (Eq._oldrec (Eq.refl (a * b < 0 * b)) (zero_mul b)) h) (mul_lt_mul_of_pos_right ha hb)

theorem mul_self_lt_mul_self {α : Type u} [ordered_semiring α] {a : α} {b : α} (h1 : 0 ≤ a) (h2 : a < b) : a * a < b * b :=
  mul_lt_mul' (has_lt.lt.le h2) h2 h1 (has_le.le.trans_lt h1 h2)

theorem strict_mono_incr_on_mul_self {α : Type u} [ordered_semiring α] : strict_mono_incr_on (fun (x : α) => x * x) (set.Ici 0) :=
  fun (x : α) (hx : x ∈ set.Ici 0) (y : α) (hy : y ∈ set.Ici 0) (hxy : x < y) => mul_self_lt_mul_self hx hxy

theorem mul_self_le_mul_self {α : Type u} [ordered_semiring α] {a : α} {b : α} (h1 : 0 ≤ a) (h2 : a ≤ b) : a * a ≤ b * b :=
  mul_le_mul h2 h2 h1 (has_le.le.trans h1 h2)

theorem mul_lt_mul'' {α : Type u} [ordered_semiring α] {a : α} {b : α} {c : α} {d : α} (h1 : a < c) (h2 : b < d) (h3 : 0 ≤ a) (h4 : 0 ≤ b) : a * b < c * d := sorry

theorem le_mul_of_one_le_right {α : Type u} [ordered_semiring α] {a : α} {b : α} (hb : 0 ≤ b) (h : 1 ≤ a) : b ≤ b * a :=
  (fun (this : b * 1 ≤ b * a) => eq.mp (Eq._oldrec (Eq.refl (b * 1 ≤ b * a)) (mul_one b)) this)
    (mul_le_mul_of_nonneg_left h hb)

theorem le_mul_of_one_le_left {α : Type u} [ordered_semiring α] {a : α} {b : α} (hb : 0 ≤ b) (h : 1 ≤ a) : b ≤ a * b :=
  (fun (this : 1 * b ≤ a * b) => eq.mp (Eq._oldrec (Eq.refl (1 * b ≤ a * b)) (one_mul b)) this)
    (mul_le_mul_of_nonneg_right h hb)

theorem bit1_pos {α : Type u} [ordered_semiring α] {a : α} [nontrivial α] (h : 0 ≤ a) : 0 < bit1 a :=
  lt_add_of_le_of_pos (add_nonneg h h) zero_lt_one

theorem lt_add_one {α : Type u} [ordered_semiring α] [nontrivial α] (a : α) : a < a + 1 :=
  lt_add_of_le_of_pos le_rfl zero_lt_one

theorem lt_one_add {α : Type u} [ordered_semiring α] [nontrivial α] (a : α) : a < 1 + a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a < 1 + a)) (add_comm 1 a))) (lt_add_one a)

theorem bit1_pos' {α : Type u} [ordered_semiring α] {a : α} (h : 0 < a) : 0 < bit1 a :=
  bit1_pos (has_lt.lt.le h)

theorem one_lt_mul {α : Type u} [ordered_semiring α] {a : α} {b : α} (ha : 1 ≤ a) (hb : 1 < b) : 1 < a * b :=
  one_mul 1 ▸ mul_lt_mul' ha hb zero_le_one (has_lt.lt.trans_le zero_lt_one ha)

theorem mul_le_one {α : Type u} [ordered_semiring α] {a : α} {b : α} (ha : a ≤ 1) (hb' : 0 ≤ b) (hb : b ≤ 1) : a * b ≤ 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a * b ≤ 1)) (Eq.symm (one_mul 1)))) (mul_le_mul ha hb hb' zero_le_one)

theorem one_lt_mul_of_le_of_lt {α : Type u} [ordered_semiring α] {a : α} {b : α} (ha : 1 ≤ a) (hb : 1 < b) : 1 < a * b :=
  trans_rel_right Less (eq.mpr (id (Eq._oldrec (Eq.refl (1 = 1 * 1)) (one_mul 1))) (Eq.refl 1))
    (mul_lt_mul' ha hb zero_le_one (has_lt.lt.trans_le zero_lt_one ha))

theorem one_lt_mul_of_lt_of_le {α : Type u} [ordered_semiring α] {a : α} {b : α} (ha : 1 < a) (hb : 1 ≤ b) : 1 < a * b :=
  trans_rel_right Less (eq.mpr (id (Eq._oldrec (Eq.refl (1 = 1 * 1)) (one_mul 1))) (Eq.refl 1))
    (mul_lt_mul ha hb zero_lt_one (has_le.le.trans zero_le_one (has_lt.lt.le ha)))

theorem mul_le_of_le_one_right {α : Type u} [ordered_semiring α] {a : α} {b : α} (ha : 0 ≤ a) (hb1 : b ≤ 1) : a * b ≤ a :=
  trans_rel_left LessEq (mul_le_mul_of_nonneg_left hb1 ha) (mul_one a)

theorem mul_le_of_le_one_left {α : Type u} [ordered_semiring α] {a : α} {b : α} (hb : 0 ≤ b) (ha1 : a ≤ 1) : a * b ≤ b :=
  trans_rel_left LessEq (mul_le_mul ha1 le_rfl hb zero_le_one) (one_mul b)

theorem mul_lt_one_of_nonneg_of_lt_one_left {α : Type u} [ordered_semiring α] {a : α} {b : α} (ha0 : 0 ≤ a) (ha : a < 1) (hb : b ≤ 1) : a * b < 1 :=
  lt_of_le_of_lt (mul_le_of_le_one_right ha0 hb) ha

theorem mul_lt_one_of_nonneg_of_lt_one_right {α : Type u} [ordered_semiring α] {a : α} {b : α} (ha : a ≤ 1) (hb0 : 0 ≤ b) (hb : b < 1) : a * b < 1 :=
  lt_of_le_of_lt (mul_le_of_le_one_left hb0 ha) hb

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

/--
A `linear_ordered_semiring α` is a nontrivial semiring `α` with a linear order
such that multiplication with a positive number and addition are 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.

class linear_ordered_semiring (α : Type u)
extends ordered_semiring α, nontrivial α, linear_order α
where

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

theorem zero_lt_one' {α : Type u} [linear_ordered_semiring α] : 0 < 1 :=
  zero_lt_one

theorem lt_of_mul_lt_mul_left {α : Type u} [linear_ordered_semiring α] {a : α} {b : α} {c : α} (h : c * a < c * b) (hc : 0 ≤ c) : a < b :=
  lt_of_not_ge fun (h1 : b ≤ a) => (fun (h2 : c * b ≤ c * a) => has_le.le.not_lt h2 h) (mul_le_mul_of_nonneg_left h1 hc)

theorem lt_of_mul_lt_mul_right {α : Type u} [linear_ordered_semiring α] {a : α} {b : α} {c : α} (h : a * c < b * c) (hc : 0 ≤ c) : a < b :=
  lt_of_not_ge fun (h1 : b ≤ a) => (fun (h2 : b * c ≤ a * c) => has_le.le.not_lt h2 h) (mul_le_mul_of_nonneg_right h1 hc)

theorem le_of_mul_le_mul_left {α : Type u} [linear_ordered_semiring α] {a : α} {b : α} {c : α} (h : c * a ≤ c * b) (hc : 0 < c) : a ≤ b :=
  le_of_not_gt fun (h1 : b < a) => (fun (h2 : c * b < c * a) => has_lt.lt.not_le h2 h) (mul_lt_mul_of_pos_left h1 hc)

theorem le_of_mul_le_mul_right {α : Type u} [linear_ordered_semiring α] {a : α} {b : α} {c : α} (h : a * c ≤ b * c) (hc : 0 < c) : a ≤ b :=
  le_of_not_gt fun (h1 : b < a) => (fun (h2 : b * c < a * c) => has_lt.lt.not_le h2 h) (mul_lt_mul_of_pos_right h1 hc)

theorem pos_and_pos_or_neg_and_neg_of_mul_pos {α : Type u} [linear_ordered_semiring α] {a : α} {b : α} (hab : 0 < a * b) : 0 < a ∧ 0 < b ∨ a < 0 ∧ b < 0 := sorry

theorem nonneg_and_nonneg_or_nonpos_and_nonpos_of_mul_nnonneg {α : Type u} [linear_ordered_semiring α] {a : α} {b : α} (hab : 0 ≤ a * b) : 0 ≤ a ∧ 0 ≤ b ∨ a ≤ 0 ∧ b ≤ 0 := sorry

theorem pos_of_mul_pos_left {α : Type u} [linear_ordered_semiring α] {a : α} {b : α} (h : 0 < a * b) (ha : 0 ≤ a) : 0 < b :=
  and.right
    (or.resolve_right (pos_and_pos_or_neg_and_neg_of_mul_pos h)
      fun (h : a < 0 ∧ b < 0) => has_lt.lt.not_le (and.left h) ha)

theorem pos_of_mul_pos_right {α : Type u} [linear_ordered_semiring α] {a : α} {b : α} (h : 0 < a * b) (hb : 0 ≤ b) : 0 < a :=
  and.left
    (or.resolve_right (pos_and_pos_or_neg_and_neg_of_mul_pos h)
      fun (h : a < 0 ∧ b < 0) => has_lt.lt.not_le (and.right h) hb)

theorem nonneg_of_mul_nonneg_left {α : Type u} [linear_ordered_semiring α] {a : α} {b : α} (h : 0 ≤ a * b) (h1 : 0 < a) : 0 ≤ b :=
  le_of_not_gt fun (h2 : b < 0) => has_lt.lt.not_le (mul_neg_of_pos_of_neg h1 h2) h

theorem nonneg_of_mul_nonneg_right {α : Type u} [linear_ordered_semiring α] {a : α} {b : α} (h : 0 ≤ a * b) (h1 : 0 < b) : 0 ≤ a :=
  le_of_not_gt fun (h2 : a < 0) => has_lt.lt.not_le (mul_neg_of_neg_of_pos h2 h1) h

theorem neg_of_mul_neg_left {α : Type u} [linear_ordered_semiring α] {a : α} {b : α} (h : a * b < 0) (h1 : 0 ≤ a) : b < 0 :=
  lt_of_not_ge fun (h2 : b ≥ 0) => has_le.le.not_lt (mul_nonneg h1 h2) h

theorem neg_of_mul_neg_right {α : Type u} [linear_ordered_semiring α] {a : α} {b : α} (h : a * b < 0) (h1 : 0 ≤ b) : a < 0 :=
  lt_of_not_ge fun (h2 : a ≥ 0) => has_le.le.not_lt (mul_nonneg h2 h1) h

theorem nonpos_of_mul_nonpos_left {α : Type u} [linear_ordered_semiring α] {a : α} {b : α} (h : a * b ≤ 0) (h1 : 0 < a) : b ≤ 0 :=
  le_of_not_gt fun (h2 : b > 0) => has_lt.lt.not_le (mul_pos h1 h2) h

theorem nonpos_of_mul_nonpos_right {α : Type u} [linear_ordered_semiring α] {a : α} {b : α} (h : a * b ≤ 0) (h1 : 0 < b) : a ≤ 0 :=
  le_of_not_gt fun (h2 : a > 0) => has_lt.lt.not_le (mul_pos h2 h1) h

@[simp] theorem mul_le_mul_left {α : Type u} [linear_ordered_semiring α] {a : α} {b : α} {c : α} (h : 0 < c) : c * a ≤ c * b ↔ a ≤ b :=
  { mp := fun (h' : c * a ≤ c * b) => le_of_mul_le_mul_left h' h,
    mpr := fun (h' : a ≤ b) => mul_le_mul_of_nonneg_left h' (has_lt.lt.le h) }

@[simp] theorem mul_le_mul_right {α : Type u} [linear_ordered_semiring α] {a : α} {b : α} {c : α} (h : 0 < c) : a * c ≤ b * c ↔ a ≤ b :=
  { mp := fun (h' : a * c ≤ b * c) => le_of_mul_le_mul_right h' h,
    mpr := fun (h' : a ≤ b) => mul_le_mul_of_nonneg_right h' (has_lt.lt.le h) }

@[simp] theorem mul_lt_mul_left {α : Type u} [linear_ordered_semiring α] {a : α} {b : α} {c : α} (h : 0 < c) : c * a < c * b ↔ a < b :=
  { mp := lt_imp_lt_of_le_imp_le fun (h' : b ≤ a) => mul_le_mul_of_nonneg_left h' (has_lt.lt.le h),
    mpr := fun (h' : a < b) => mul_lt_mul_of_pos_left h' h }

@[simp] theorem mul_lt_mul_right {α : Type u} [linear_ordered_semiring α] {a : α} {b : α} {c : α} (h : 0 < c) : a * c < b * c ↔ a < b :=
  { mp := lt_imp_lt_of_le_imp_le fun (h' : b ≤ a) => mul_le_mul_of_nonneg_right h' (has_lt.lt.le h),
    mpr := fun (h' : a < b) => mul_lt_mul_of_pos_right h' h }

@[simp] theorem zero_le_mul_left {α : Type u} [linear_ordered_semiring α] {b : α} {c : α} (h : 0 < c) : 0 ≤ c * b ↔ 0 ≤ b := sorry

@[simp] theorem zero_le_mul_right {α : Type u} [linear_ordered_semiring α] {b : α} {c : α} (h : 0 < c) : 0 ≤ b * c ↔ 0 ≤ b := sorry

@[simp] theorem zero_lt_mul_left {α : Type u} [linear_ordered_semiring α] {b : α} {c : α} (h : 0 < c) : 0 < c * b ↔ 0 < b := sorry

@[simp] theorem zero_lt_mul_right {α : Type u} [linear_ordered_semiring α] {b : α} {c : α} (h : 0 < c) : 0 < b * c ↔ 0 < b := sorry

@[simp] theorem bit0_le_bit0 {α : Type u} [linear_ordered_semiring α] {a : α} {b : α} [nontrivial α] : bit0 a ≤ bit0 b ↔ a ≤ b := sorry

@[simp] theorem bit0_lt_bit0 {α : Type u} [linear_ordered_semiring α] {a : α} {b : α} [nontrivial α] : bit0 a < bit0 b ↔ a < b := sorry

@[simp] theorem bit1_le_bit1 {α : Type u} [linear_ordered_semiring α] {a : α} {b : α} [nontrivial α] : bit1 a ≤ bit1 b ↔ a ≤ b :=
  iff.trans (add_le_add_iff_right 1) bit0_le_bit0

@[simp] theorem bit1_lt_bit1 {α : Type u} [linear_ordered_semiring α] {a : α} {b : α} [nontrivial α] : bit1 a < bit1 b ↔ a < b :=
  iff.trans (add_lt_add_iff_right 1) bit0_lt_bit0

@[simp] theorem one_le_bit1 {α : Type u} [linear_ordered_semiring α] {a : α} [nontrivial α] : 1 ≤ bit1 a ↔ 0 ≤ a := sorry

@[simp] theorem one_lt_bit1 {α : Type u} [linear_ordered_semiring α] {a : α} [nontrivial α] : 1 < bit1 a ↔ 0 < a := sorry

@[simp] theorem zero_le_bit0 {α : Type u} [linear_ordered_semiring α] {a : α} [nontrivial α] : 0 ≤ bit0 a ↔ 0 ≤ a := sorry

@[simp] theorem zero_lt_bit0 {α : Type u} [linear_ordered_semiring α] {a : α} [nontrivial α] : 0 < bit0 a ↔ 0 < a := sorry

theorem le_mul_iff_one_le_left {α : Type u} [linear_ordered_semiring α] {a : α} {b : α} (hb : 0 < b) : b ≤ a * b ↔ 1 ≤ a :=
  (fun (this : 1 * b ≤ a * b ↔ 1 ≤ a) => eq.mp (Eq._oldrec (Eq.refl (1 * b ≤ a * b ↔ 1 ≤ a)) (one_mul b)) this)
    (mul_le_mul_right hb)

theorem lt_mul_iff_one_lt_left {α : Type u} [linear_ordered_semiring α] {a : α} {b : α} (hb : 0 < b) : b < a * b ↔ 1 < a :=
  (fun (this : 1 * b < a * b ↔ 1 < a) => eq.mp (Eq._oldrec (Eq.refl (1 * b < a * b ↔ 1 < a)) (one_mul b)) this)
    (mul_lt_mul_right hb)

theorem le_mul_iff_one_le_right {α : Type u} [linear_ordered_semiring α] {a : α} {b : α} (hb : 0 < b) : b ≤ b * a ↔ 1 ≤ a :=
  (fun (this : b * 1 ≤ b * a ↔ 1 ≤ a) => eq.mp (Eq._oldrec (Eq.refl (b * 1 ≤ b * a ↔ 1 ≤ a)) (mul_one b)) this)
    (mul_le_mul_left hb)

theorem lt_mul_iff_one_lt_right {α : Type u} [linear_ordered_semiring α] {a : α} {b : α} (hb : 0 < b) : b < b * a ↔ 1 < a :=
  (fun (this : b * 1 < b * a ↔ 1 < a) => eq.mp (Eq._oldrec (Eq.refl (b * 1 < b * a ↔ 1 < a)) (mul_one b)) this)
    (mul_lt_mul_left hb)

theorem lt_mul_of_one_lt_right {α : Type u} [linear_ordered_semiring α] {a : α} {b : α} (hb : 0 < b) : 1 < a → b < b * a :=
  iff.mpr (lt_mul_iff_one_lt_right hb)

theorem mul_nonneg_iff_right_nonneg_of_pos {α : Type u} [linear_ordered_semiring α] {a : α} {b : α} (h : 0 < a) : 0 ≤ b * a ↔ 0 ≤ b :=
  { mp := fun (this : 0 ≤ b * a) => nonneg_of_mul_nonneg_right this h,
    mpr := fun (this : 0 ≤ b) => mul_nonneg this (has_lt.lt.le h) }

theorem mul_le_iff_le_one_left {α : Type u} [linear_ordered_semiring α] {a : α} {b : α} (hb : 0 < b) : a * b ≤ b ↔ a ≤ 1 :=
  { mp := fun (h : a * b ≤ b) => le_of_not_lt (mt (iff.mpr (lt_mul_iff_one_lt_left hb)) (has_le.le.not_lt h)),
    mpr := fun (h : a ≤ 1) => le_of_not_lt (mt (iff.mp (lt_mul_iff_one_lt_left hb)) (has_le.le.not_lt h)) }

theorem mul_lt_iff_lt_one_left {α : Type u} [linear_ordered_semiring α] {a : α} {b : α} (hb : 0 < b) : a * b < b ↔ a < 1 :=
  { mp := fun (h : a * b < b) => lt_of_not_ge (mt (iff.mpr (le_mul_iff_one_le_left hb)) (has_lt.lt.not_le h)),
    mpr := fun (h : a < 1) => lt_of_not_ge (mt (iff.mp (le_mul_iff_one_le_left hb)) (has_lt.lt.not_le h)) }

theorem mul_le_iff_le_one_right {α : Type u} [linear_ordered_semiring α] {a : α} {b : α} (hb : 0 < b) : b * a ≤ b ↔ a ≤ 1 :=
  { mp := fun (h : b * a ≤ b) => le_of_not_lt (mt (iff.mpr (lt_mul_iff_one_lt_right hb)) (has_le.le.not_lt h)),
    mpr := fun (h : a ≤ 1) => le_of_not_lt (mt (iff.mp (lt_mul_iff_one_lt_right hb)) (has_le.le.not_lt h)) }

theorem mul_lt_iff_lt_one_right {α : Type u} [linear_ordered_semiring α] {a : α} {b : α} (hb : 0 < b) : b * a < b ↔ a < 1 :=
  { mp := fun (h : b * a < b) => lt_of_not_ge (mt (iff.mpr (le_mul_iff_one_le_right hb)) (has_lt.lt.not_le h)),
    mpr := fun (h : a < 1) => lt_of_not_ge (mt (iff.mp (le_mul_iff_one_le_right hb)) (has_lt.lt.not_le h)) }

theorem nonpos_of_mul_nonneg_left {α : Type u} [linear_ordered_semiring α] {a : α} {b : α} (h : 0 ≤ a * b) (hb : b < 0) : a ≤ 0 :=
  le_of_not_gt fun (ha : a > 0) => absurd h (has_lt.lt.not_le (mul_neg_of_pos_of_neg ha hb))

theorem nonpos_of_mul_nonneg_right {α : Type u} [linear_ordered_semiring α] {a : α} {b : α} (h : 0 ≤ a * b) (ha : a < 0) : b ≤ 0 :=
  le_of_not_gt fun (hb : b > 0) => absurd h (has_lt.lt.not_le (mul_neg_of_neg_of_pos ha hb))

theorem neg_of_mul_pos_left {α : Type u} [linear_ordered_semiring α] {a : α} {b : α} (h : 0 < a * b) (hb : b ≤ 0) : a < 0 :=
  lt_of_not_ge fun (ha : a ≥ 0) => absurd h (has_le.le.not_lt (mul_nonpos_of_nonneg_of_nonpos ha hb))

theorem neg_of_mul_pos_right {α : Type u} [linear_ordered_semiring α] {a : α} {b : α} (h : 0 < a * b) (ha : a ≤ 0) : b < 0 :=
  lt_of_not_ge fun (hb : b ≥ 0) => absurd h (has_le.le.not_lt (mul_nonpos_of_nonpos_of_nonneg ha hb))

protected instance linear_ordered_semiring.to_no_top_order {α : Type u_1} [linear_ordered_semiring α] : no_top_order α :=
  no_top_order.mk fun (a : α) => Exists.intro (a + 1) (lt_add_of_pos_right a zero_lt_one)

theorem monotone_mul_left_of_nonneg {α : Type u} [linear_ordered_semiring α] {a : α} (ha : 0 ≤ a) : monotone fun (x : α) => a * x :=
  fun (b c : α) (b_le_c : b ≤ c) => mul_le_mul_of_nonneg_left b_le_c ha

theorem monotone_mul_right_of_nonneg {α : Type u} [linear_ordered_semiring α] {a : α} (ha : 0 ≤ a) : monotone fun (x : α) => x * a :=
  fun (b c : α) (b_le_c : b ≤ c) => mul_le_mul_of_nonneg_right b_le_c ha

theorem monotone.mul_const {α : Type u} {β : Type u_1} [linear_ordered_semiring α] [preorder β] {f : β → α} {a : α} (hf : monotone f) (ha : 0 ≤ a) : monotone fun (x : β) => f x * a :=
  monotone.comp (monotone_mul_right_of_nonneg ha) hf

theorem monotone.const_mul {α : Type u} {β : Type u_1} [linear_ordered_semiring α] [preorder β] {f : β → α} {a : α} (hf : monotone f) (ha : 0 ≤ a) : monotone fun (x : β) => a * f x :=
  monotone.comp (monotone_mul_left_of_nonneg ha) hf

theorem monotone.mul {α : Type u} {β : Type u_1} [linear_ordered_semiring α] [preorder β] {f : β → α} {g : β → α} (hf : monotone f) (hg : monotone g) (hf0 : ∀ (x : β), 0 ≤ f x) (hg0 : ∀ (x : β), 0 ≤ g x) : monotone fun (x : β) => f x * g x :=
  fun (x y : β) (h : x ≤ y) => mul_le_mul (hf h) (hg h) (hg0 x) (hf0 y)

theorem strict_mono_mul_left_of_pos {α : Type u} [linear_ordered_semiring α] {a : α} (ha : 0 < a) : strict_mono fun (x : α) => a * x :=
  fun (b c : α) (b_lt_c : b < c) => iff.mpr (mul_lt_mul_left ha) b_lt_c

theorem strict_mono_mul_right_of_pos {α : Type u} [linear_ordered_semiring α] {a : α} (ha : 0 < a) : strict_mono fun (x : α) => x * a :=
  fun (b c : α) (b_lt_c : b < c) => iff.mpr (mul_lt_mul_right ha) b_lt_c

theorem strict_mono.mul_const {α : Type u} {β : Type u_1} [linear_ordered_semiring α] [preorder β] {f : β → α} {a : α} (hf : strict_mono f) (ha : 0 < a) : strict_mono fun (x : β) => f x * a :=
  strict_mono.comp (strict_mono_mul_right_of_pos ha) hf

theorem strict_mono.const_mul {α : Type u} {β : Type u_1} [linear_ordered_semiring α] [preorder β] {f : β → α} {a : α} (hf : strict_mono f) (ha : 0 < a) : strict_mono fun (x : β) => a * f x :=
  strict_mono.comp (strict_mono_mul_left_of_pos ha) hf

theorem strict_mono.mul_monotone {α : Type u} {β : Type u_1} [linear_ordered_semiring α] [preorder β] {f : β → α} {g : β → α} (hf : strict_mono f) (hg : monotone g) (hf0 : ∀ (x : β), 0 ≤ f x) (hg0 : ∀ (x : β), 0 < g x) : strict_mono fun (x : β) => f x * g x :=
  fun (x y : β) (h : x < y) => mul_lt_mul (hf h) (hg (has_lt.lt.le h)) (hg0 x) (hf0 y)

theorem monotone.mul_strict_mono {α : Type u} {β : Type u_1} [linear_ordered_semiring α] [preorder β] {f : β → α} {g : β → α} (hf : monotone f) (hg : strict_mono g) (hf0 : ∀ (x : β), 0 < f x) (hg0 : ∀ (x : β), 0 ≤ g x) : strict_mono fun (x : β) => f x * g x :=
  fun (x y : β) (h : x < y) => mul_lt_mul' (hf (has_lt.lt.le h)) (hg h) (hg0 x) (hf0 y)

theorem strict_mono.mul {α : Type u} {β : Type u_1} [linear_ordered_semiring α] [preorder β] {f : β → α} {g : β → α} (hf : strict_mono f) (hg : strict_mono g) (hf0 : ∀ (x : β), 0 ≤ f x) (hg0 : ∀ (x : β), 0 ≤ g x) : strict_mono fun (x : β) => f x * g x :=
  fun (x y : β) (h : x < y) => mul_lt_mul'' (hf h) (hg h) (hf0 x) (hg0 x)

@[simp] theorem decidable.mul_le_mul_left {α : Type u} [linear_ordered_semiring α] {a : α} {b : α} {c : α} (h : 0 < c) : c * a ≤ c * b ↔ a ≤ b :=
  iff.mpr decidable.le_iff_le_iff_lt_iff_lt (mul_lt_mul_left h)

@[simp] theorem decidable.mul_le_mul_right {α : Type u} [linear_ordered_semiring α] {a : α} {b : α} {c : α} (h : 0 < c) : a * c ≤ b * c ↔ a ≤ b :=
  iff.mpr decidable.le_iff_le_iff_lt_iff_lt (mul_lt_mul_right h)

theorem mul_max_of_nonneg {α : Type u} [linear_ordered_semiring α] {a : α} (b : α) (c : α) (ha : 0 ≤ a) : a * max b c = max (a * b) (a * c) :=
  monotone.map_max (monotone_mul_left_of_nonneg ha)

theorem mul_min_of_nonneg {α : Type u} [linear_ordered_semiring α] {a : α} (b : α) (c : α) (ha : 0 ≤ a) : a * min b c = min (a * b) (a * c) :=
  monotone.map_min (monotone_mul_left_of_nonneg ha)

theorem max_mul_of_nonneg {α : Type u} [linear_ordered_semiring α] {c : α} (a : α) (b : α) (hc : 0 ≤ c) : max a b * c = max (a * c) (b * c) :=
  monotone.map_max (monotone_mul_right_of_nonneg hc)

theorem min_mul_of_nonneg {α : Type u} [linear_ordered_semiring α] {c : α} (a : α) (b : α) (hc : 0 ≤ c) : min a b * c = min (a * c) (b * c) :=
  monotone.map_min (monotone_mul_right_of_nonneg hc)

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

theorem ordered_ring.mul_nonneg {α : Type u} [ordered_ring α] (a : α) (b : α) (h₁ : 0 ≤ a) (h₂ : 0 ≤ b) : 0 ≤ a * b := sorry

theorem ordered_ring.mul_le_mul_of_nonneg_left {α : Type u} [ordered_ring α] {a : α} {b : α} {c : α} (h₁ : a ≤ b) (h₂ : 0 ≤ c) : c * a ≤ c * b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (c * a ≤ c * b)) (Eq.symm (propext sub_nonneg))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (0 ≤ c * b - c * a)) (Eq.symm (mul_sub c b a))))
      (ordered_ring.mul_nonneg c (b - a) h₂ (iff.mpr sub_nonneg h₁)))

theorem ordered_ring.mul_le_mul_of_nonneg_right {α : Type u} [ordered_ring α] {a : α} {b : α} {c : α} (h₁ : a ≤ b) (h₂ : 0 ≤ c) : a * c ≤ b * c :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a * c ≤ b * c)) (Eq.symm (propext sub_nonneg))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (0 ≤ b * c - a * c)) (Eq.symm (sub_mul b a c))))
      (ordered_ring.mul_nonneg (b - a) c (iff.mpr sub_nonneg h₁) h₂))

theorem ordered_ring.mul_lt_mul_of_pos_left {α : Type u} [ordered_ring α] {a : α} {b : α} {c : α} (h₁ : a < b) (h₂ : 0 < c) : c * a < c * b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (c * a < c * b)) (Eq.symm (propext sub_pos))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (0 < c * b - c * a)) (Eq.symm (mul_sub c b a))))
      (ordered_ring.mul_pos c (b - a) h₂ (iff.mpr sub_pos h₁)))

theorem ordered_ring.mul_lt_mul_of_pos_right {α : Type u} [ordered_ring α] {a : α} {b : α} {c : α} (h₁ : a < b) (h₂ : 0 < c) : a * c < b * c :=
  eq.mpr (id (Eq._oldrec (Eq.refl (a * c < b * c)) (Eq.symm (propext sub_pos))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (0 < b * c - a * c)) (Eq.symm (sub_mul b a c))))
      (ordered_ring.mul_pos (b - a) c (iff.mpr sub_pos h₁) h₂))

protected instance ordered_ring.to_ordered_semiring {α : Type u} [ordered_ring α] : ordered_semiring α :=
  ordered_semiring.mk ordered_ring.add ordered_ring.add_assoc ordered_ring.zero ordered_ring.zero_add
    ordered_ring.add_zero ordered_ring.add_comm ordered_ring.mul ordered_ring.mul_assoc ordered_ring.one
    ordered_ring.one_mul ordered_ring.mul_one sorry sorry ordered_ring.left_distrib ordered_ring.right_distrib sorry sorry
    ordered_ring.le ordered_ring.lt ordered_ring.le_refl ordered_ring.le_trans ordered_ring.le_antisymm
    ordered_ring.add_le_add_left sorry ordered_ring.zero_le_one ordered_ring.mul_lt_mul_of_pos_left
    ordered_ring.mul_lt_mul_of_pos_right

theorem mul_le_mul_of_nonpos_left {α : Type u} [ordered_ring α] {a : α} {b : α} {c : α} (h : b ≤ a) (hc : c ≤ 0) : c * a ≤ c * b := sorry

theorem mul_le_mul_of_nonpos_right {α : Type u} [ordered_ring α] {a : α} {b : α} {c : α} (h : b ≤ a) (hc : c ≤ 0) : a * c ≤ b * c := sorry

theorem mul_nonneg_of_nonpos_of_nonpos {α : Type u} [ordered_ring α] {a : α} {b : α} (ha : a ≤ 0) (hb : b ≤ 0) : 0 ≤ a * b :=
  (fun (this : 0 * b ≤ a * b) => eq.mp (Eq._oldrec (Eq.refl (0 * b ≤ a * b)) (zero_mul b)) this)
    (mul_le_mul_of_nonpos_right ha hb)

theorem mul_lt_mul_of_neg_left {α : Type u} [ordered_ring α] {a : α} {b : α} {c : α} (h : b < a) (hc : c < 0) : c * a < c * b := sorry

theorem mul_lt_mul_of_neg_right {α : Type u} [ordered_ring α] {a : α} {b : α} {c : α} (h : b < a) (hc : c < 0) : a * c < b * c := sorry

theorem mul_pos_of_neg_of_neg {α : Type u} [ordered_ring α] {a : α} {b : α} (ha : a < 0) (hb : b < 0) : 0 < a * b :=
  (fun (this : 0 * b < a * b) => eq.mp (Eq._oldrec (Eq.refl (0 * b < a * b)) (zero_mul b)) this)
    (mul_lt_mul_of_neg_right ha hb)

/-- An `ordered_comm_ring α` is a commutative ring `α` with a partial order such that
multiplication with a positive number and addition are monotone. -/
class ordered_comm_ring (α : Type u)
extends ordered_ring α, comm_ring α, ordered_comm_semiring α
where

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

protected instance linear_ordered_ring.to_linear_ordered_add_comm_group {α : Type u} [s : linear_ordered_ring α] : linear_ordered_add_comm_group α :=
  linear_ordered_add_comm_group.mk linear_ordered_ring.add linear_ordered_ring.add_assoc linear_ordered_ring.zero
    linear_ordered_ring.zero_add linear_ordered_ring.add_zero linear_ordered_ring.neg linear_ordered_ring.sub
    linear_ordered_ring.add_left_neg linear_ordered_ring.add_comm linear_ordered_ring.le linear_ordered_ring.lt
    linear_ordered_ring.le_refl linear_ordered_ring.le_trans linear_ordered_ring.le_antisymm linear_ordered_ring.le_total
    linear_ordered_ring.decidable_le linear_ordered_ring.decidable_eq linear_ordered_ring.decidable_lt
    linear_ordered_ring.add_le_add_left

protected instance linear_ordered_ring.to_linear_ordered_semiring {α : Type u} [linear_ordered_ring α] : linear_ordered_semiring α :=
  linear_ordered_semiring.mk linear_ordered_ring.add linear_ordered_ring.add_assoc linear_ordered_ring.zero
    linear_ordered_ring.zero_add linear_ordered_ring.add_zero linear_ordered_ring.add_comm linear_ordered_ring.mul
    linear_ordered_ring.mul_assoc linear_ordered_ring.one linear_ordered_ring.one_mul linear_ordered_ring.mul_one sorry
    sorry linear_ordered_ring.left_distrib linear_ordered_ring.right_distrib sorry sorry linear_ordered_ring.le
    linear_ordered_ring.lt linear_ordered_ring.le_refl linear_ordered_ring.le_trans linear_ordered_ring.le_antisymm
    linear_ordered_ring.add_le_add_left sorry linear_ordered_ring.zero_le_one sorry sorry linear_ordered_ring.le_total
    linear_ordered_ring.decidable_le linear_ordered_ring.decidable_eq linear_ordered_ring.decidable_lt
    linear_ordered_ring.exists_pair_ne

protected instance linear_ordered_ring.to_domain {α : Type u} [linear_ordered_ring α] : domain α :=
  domain.mk linear_ordered_ring.add linear_ordered_ring.add_assoc linear_ordered_ring.zero linear_ordered_ring.zero_add
    linear_ordered_ring.add_zero linear_ordered_ring.neg linear_ordered_ring.sub linear_ordered_ring.add_left_neg
    linear_ordered_ring.add_comm linear_ordered_ring.mul linear_ordered_ring.mul_assoc linear_ordered_ring.one
    linear_ordered_ring.one_mul linear_ordered_ring.mul_one linear_ordered_ring.left_distrib
    linear_ordered_ring.right_distrib linear_ordered_ring.exists_pair_ne sorry

@[simp] theorem abs_one {α : Type u} [linear_ordered_ring α] : abs 1 = 1 :=
  abs_of_pos zero_lt_one

@[simp] theorem abs_two {α : Type u} [linear_ordered_ring α] : abs (bit0 1) = bit0 1 :=
  abs_of_pos zero_lt_two

theorem abs_mul {α : Type u} [linear_ordered_ring α] (a : α) (b : α) : abs (a * b) = abs a * abs b := sorry

/-- `abs` as a `monoid_with_zero_hom`. -/
def abs_hom {α : Type u} [linear_ordered_ring α] : monoid_with_zero_hom α α :=
  monoid_with_zero_hom.mk abs sorry abs_one abs_mul

@[simp] theorem abs_mul_abs_self {α : Type u} [linear_ordered_ring α] (a : α) : abs a * abs a = a * a :=
  abs_by_cases (fun (x : α) => x * x = a * a) rfl (neg_mul_neg a a)

@[simp] theorem abs_mul_self {α : Type u} [linear_ordered_ring α] (a : α) : abs (a * a) = a * a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (abs (a * a) = a * a)) (abs_mul a a)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (abs a * abs a = a * a)) (abs_mul_abs_self a))) (Eq.refl (a * a)))

theorem mul_pos_iff {α : Type u} [linear_ordered_ring α] {a : α} {b : α} : 0 < a * b ↔ 0 < a ∧ 0 < b ∨ a < 0 ∧ b < 0 := sorry

theorem mul_neg_iff {α : Type u} [linear_ordered_ring α] {a : α} {b : α} : a * b < 0 ↔ 0 < a ∧ b < 0 ∨ a < 0 ∧ 0 < b := sorry

theorem mul_nonneg_iff {α : Type u} [linear_ordered_ring α] {a : α} {b : α} : 0 ≤ a * b ↔ 0 ≤ a ∧ 0 ≤ b ∨ a ≤ 0 ∧ b ≤ 0 := sorry

theorem mul_nonpos_iff {α : Type u} [linear_ordered_ring α] {a : α} {b : α} : a * b ≤ 0 ↔ 0 ≤ a ∧ b ≤ 0 ∨ a ≤ 0 ∧ 0 ≤ b := sorry

theorem mul_self_nonneg {α : Type u} [linear_ordered_ring α] (a : α) : 0 ≤ a * a :=
  abs_mul_self a ▸ abs_nonneg (a * a)

@[simp] theorem neg_le_self_iff {α : Type u} [linear_ordered_ring α] {a : α} : -a ≤ a ↔ 0 ≤ a := sorry

@[simp] theorem neg_lt_self_iff {α : Type u} [linear_ordered_ring α] {a : α} : -a < a ↔ 0 < a := sorry

@[simp] theorem le_neg_self_iff {α : Type u} [linear_ordered_ring α] {a : α} : a ≤ -a ↔ a ≤ 0 :=
  iff.trans
    (iff.trans (eq.mpr (id (Eq._oldrec (Eq.refl (a ≤ -a ↔ --a ≤ -a)) (neg_neg a))) (iff.refl (a ≤ -a))) neg_le_self_iff)
    neg_nonneg

@[simp] theorem lt_neg_self_iff {α : Type u} [linear_ordered_ring α] {a : α} : a < -a ↔ a < 0 :=
  iff.trans
    (iff.trans (eq.mpr (id (Eq._oldrec (Eq.refl (a < -a ↔ --a < -a)) (neg_neg a))) (iff.refl (a < -a))) neg_lt_self_iff)
    neg_pos

@[simp] theorem abs_eq_self {α : Type u} [linear_ordered_ring α] {a : α} : abs a = a ↔ 0 ≤ a := sorry

@[simp] theorem abs_eq_neg_self {α : Type u} [linear_ordered_ring α] {a : α} : abs a = -a ↔ a ≤ 0 := sorry

theorem gt_of_mul_lt_mul_neg_left {α : Type u} [linear_ordered_ring α] {a : α} {b : α} {c : α} (h : c * a < c * b) (hc : c ≤ 0) : b < a := sorry

theorem neg_one_lt_zero {α : Type u} [linear_ordered_ring α] : -1 < 0 :=
  iff.mpr neg_lt_zero zero_lt_one

theorem le_of_mul_le_of_one_le {α : Type u} [linear_ordered_ring α] {a : α} {b : α} {c : α} (h : a * c ≤ b) (hb : 0 ≤ b) (hc : 1 ≤ c) : a ≤ b :=
  (fun (h' : a * c ≤ b * c) => le_of_mul_le_mul_right h' (has_lt.lt.trans_le zero_lt_one hc))
    (le_trans (trans_rel_left LessEq h (eq.mpr (id (Eq._oldrec (Eq.refl (b = b * 1)) (mul_one b))) (Eq.refl b)))
      (mul_le_mul_of_nonneg_left hc hb))

theorem nonneg_le_nonneg_of_squares_le {α : Type u} [linear_ordered_ring α] {a : α} {b : α} (hb : 0 ≤ b) (h : a * a ≤ b * b) : a ≤ b :=
  le_of_not_gt fun (hab : a > b) => has_lt.lt.not_le (mul_self_lt_mul_self hb hab) h

theorem mul_self_le_mul_self_iff {α : Type u} [linear_ordered_ring α] {a : α} {b : α} (h1 : 0 ≤ a) (h2 : 0 ≤ b) : a ≤ b ↔ a * a ≤ b * b :=
  { mp := mul_self_le_mul_self h1, mpr := nonneg_le_nonneg_of_squares_le h2 }

theorem mul_self_lt_mul_self_iff {α : Type u} [linear_ordered_ring α] {a : α} {b : α} (h1 : 0 ≤ a) (h2 : 0 ≤ b) : a < b ↔ a * a < b * b :=
  iff.symm (strict_mono_incr_on.lt_iff_lt strict_mono_incr_on_mul_self h1 h2)

theorem mul_self_inj {α : Type u} [linear_ordered_ring α] {a : α} {b : α} (h1 : 0 ≤ a) (h2 : 0 ≤ b) : a * a = b * b ↔ a = b :=
  set.inj_on.eq_iff (strict_mono_incr_on.inj_on strict_mono_incr_on_mul_self) h1 h2

@[simp] theorem mul_le_mul_left_of_neg {α : Type u} [linear_ordered_ring α] {a : α} {b : α} {c : α} (h : c < 0) : c * a ≤ c * b ↔ b ≤ a :=
  { mp := le_imp_le_of_lt_imp_lt fun (h' : a < b) => mul_lt_mul_of_neg_left h' h,
    mpr := fun (h' : b ≤ a) => mul_le_mul_of_nonpos_left h' (has_lt.lt.le h) }

@[simp] theorem mul_le_mul_right_of_neg {α : Type u} [linear_ordered_ring α] {a : α} {b : α} {c : α} (h : c < 0) : a * c ≤ b * c ↔ b ≤ a :=
  { mp := le_imp_le_of_lt_imp_lt fun (h' : a < b) => mul_lt_mul_of_neg_right h' h,
    mpr := fun (h' : b ≤ a) => mul_le_mul_of_nonpos_right h' (has_lt.lt.le h) }

@[simp] theorem mul_lt_mul_left_of_neg {α : Type u} [linear_ordered_ring α] {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] theorem mul_lt_mul_right_of_neg {α : Type u} [linear_ordered_ring α] {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)

theorem sub_one_lt {α : Type u} [linear_ordered_ring α] (a : α) : a - 1 < a :=
  iff.mpr sub_lt_iff_lt_add (lt_add_one a)

theorem mul_self_pos {α : Type u} [linear_ordered_ring α] {a : α} (ha : a ≠ 0) : 0 < a * a :=
  or.dcases_on (lt_trichotomy a 0) (fun (h : a < 0) => mul_pos_of_neg_of_neg h h)
    fun (h : a = 0 ∨ 0 < a) => or.dcases_on h (fun (h : a = 0) => false.elim (ha h)) fun (h : 0 < a) => mul_pos h h

theorem mul_self_le_mul_self_of_le_of_neg_le {α : Type u} [linear_ordered_ring α] {x : α} {y : α} (h₁ : x ≤ y) (h₂ : -x ≤ y) : x * x ≤ y * y :=
  eq.mpr (id (Eq._oldrec (Eq.refl (x * x ≤ y * y)) (Eq.symm (abs_mul_abs_self x))))
    (mul_self_le_mul_self (abs_nonneg x) (iff.mpr abs_le { left := iff.mpr neg_le h₂, right := h₁ }))

theorem nonneg_of_mul_nonpos_left {α : Type u} [linear_ordered_ring α] {a : α} {b : α} (h : a * b ≤ 0) (hb : b < 0) : 0 ≤ a :=
  le_of_not_gt fun (ha : 0 > a) => absurd h (has_lt.lt.not_le (mul_pos_of_neg_of_neg ha hb))

theorem nonneg_of_mul_nonpos_right {α : Type u} [linear_ordered_ring α] {a : α} {b : α} (h : a * b ≤ 0) (ha : a < 0) : 0 ≤ b :=
  le_of_not_gt fun (hb : 0 > b) => absurd h (has_lt.lt.not_le (mul_pos_of_neg_of_neg ha hb))

theorem pos_of_mul_neg_left {α : Type u} [linear_ordered_ring α] {a : α} {b : α} (h : a * b < 0) (hb : b ≤ 0) : 0 < a :=
  lt_of_not_ge fun (ha : 0 ≥ a) => absurd h (has_le.le.not_lt (mul_nonneg_of_nonpos_of_nonpos ha hb))

theorem pos_of_mul_neg_right {α : Type u} [linear_ordered_ring α] {a : α} {b : α} (h : a * b < 0) (ha : a ≤ 0) : 0 < b :=
  lt_of_not_ge fun (hb : 0 ≥ b) => absurd h (has_le.le.not_lt (mul_nonneg_of_nonpos_of_nonpos ha hb))

/-- The sum of two squares is zero iff both elements are zero. -/
theorem mul_self_add_mul_self_eq_zero {α : Type u} [linear_ordered_ring α] {x : α} {y : α} : x * x + y * y = 0 ↔ x = 0 ∧ y = 0 := sorry

theorem eq_zero_of_mul_self_add_mul_self_eq_zero {α : Type u} [linear_ordered_ring α] {a : α} {b : α} (h : a * a + b * b = 0) : a = 0 :=
  and.left (iff.mp mul_self_add_mul_self_eq_zero h)

theorem abs_eq_iff_mul_self_eq {α : Type u} [linear_ordered_ring α] {a : α} {b : α} : abs a = abs b ↔ a * a = b * b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (abs a = abs b ↔ a * a = b * b)) (Eq.symm (abs_mul_abs_self a))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (abs a = abs b ↔ abs a * abs a = b * b)) (Eq.symm (abs_mul_abs_self b))))
      (iff.symm (mul_self_inj (abs_nonneg a) (abs_nonneg b))))

theorem abs_lt_iff_mul_self_lt {α : Type u} [linear_ordered_ring α] {a : α} {b : α} : abs a < abs b ↔ a * a < b * b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (abs a < abs b ↔ a * a < b * b)) (Eq.symm (abs_mul_abs_self a))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (abs a < abs b ↔ abs a * abs a < b * b)) (Eq.symm (abs_mul_abs_self b))))
      (mul_self_lt_mul_self_iff (abs_nonneg a) (abs_nonneg b)))

theorem abs_le_iff_mul_self_le {α : Type u} [linear_ordered_ring α] {a : α} {b : α} : abs a ≤ abs b ↔ a * a ≤ b * b :=
  eq.mpr (id (Eq._oldrec (Eq.refl (abs a ≤ abs b ↔ a * a ≤ b * b)) (Eq.symm (abs_mul_abs_self a))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (abs a ≤ abs b ↔ abs a * abs a ≤ b * b)) (Eq.symm (abs_mul_abs_self b))))
      (mul_self_le_mul_self_iff (abs_nonneg a) (abs_nonneg b)))

theorem abs_le_one_iff_mul_self_le_one {α : Type u} [linear_ordered_ring α] {a : α} : abs a ≤ 1 ↔ a * a ≤ 1 := sorry

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

protected instance linear_ordered_comm_ring.to_ordered_comm_ring {α : Type u} [d : linear_ordered_comm_ring α] : ordered_comm_ring α := sorry

-- One might hope that `{ ..linear_ordered_ring.to_linear_ordered_semiring, ..d }`

-- achieved the same result here.

-- Unfortunately with that definition we see mismatched instances in `algebra.star.chsh`.

protected instance linear_ordered_comm_ring.to_integral_domain {α : Type u} [s : linear_ordered_comm_ring α] : integral_domain α :=
  integral_domain.mk domain.add sorry domain.zero sorry sorry domain.neg domain.sub sorry sorry domain.mul sorry
    domain.one sorry sorry sorry sorry linear_ordered_comm_ring.mul_comm sorry sorry

protected instance linear_ordered_comm_ring.to_linear_ordered_semiring {α : Type u} [d : linear_ordered_comm_ring α] : linear_ordered_semiring α := sorry

theorem max_mul_mul_le_max_mul_max {α : Type u} [linear_ordered_comm_ring α] {a : α} {d : α} (b : α) (c : α) (ha : 0 ≤ a) (hd : 0 ≤ d) : max (a * b) (d * c) ≤ max a c * max d b := sorry

theorem abs_sub_square {α : Type u} [linear_ordered_comm_ring α] (a : α) (b : α) : abs (a - b) * abs (a - b) = a * a + b * b - (1 + 1) * a * b := sorry

/-- Extend `nonneg_add_comm_group` to support ordered rings
  specified by their nonnegative elements -/
class nonneg_ring (α : Type u_1)
extends nonneg_add_comm_group α, ring α
where
  one_nonneg : nonneg 1
  mul_nonneg : ∀ {a b : α}, nonneg a → nonneg b → nonneg (a * b)
  mul_pos : ∀ {a b : α}, pos a → pos b → pos (a * b)

/-- Extend `nonneg_add_comm_group` to support linearly ordered rings
  specified by their nonnegative elements -/
class linear_nonneg_ring (α : Type u_1)
extends nonneg_add_comm_group α, domain α
where
  one_pos : pos 1
  mul_nonneg : ∀ {a b : α}, nonneg a → nonneg b → nonneg (a * b)
  nonneg_total : ∀ (a : α), nonneg a ∨ nonneg (-a)

namespace nonneg_ring

/-- `to_linear_nonneg_ring` shows that a `nonneg_ring` with a total order is a `domain`,
hence a `linear_nonneg_ring`. -/
def to_linear_nonneg_ring {α : Type u} [nonneg_ring α] [nontrivial α] (nonneg_total : ∀ (a : α), nonneg a ∨ nonneg (-a)) : linear_nonneg_ring α :=
  linear_nonneg_ring.mk add add_assoc zero zero_add add_zero neg sub add_left_neg add_comm mul mul_assoc one one_mul
    mul_one left_distrib right_distrib nontrivial.exists_pair_ne sorry nonneg pos zero_nonneg add_nonneg nonneg_antisymm
    sorry mul_nonneg nonneg_total

end nonneg_ring

namespace linear_nonneg_ring

protected instance to_nonneg_ring {α : Type u} [linear_nonneg_ring α] : nonneg_ring α :=
  nonneg_ring.mk add add_assoc zero zero_add add_zero neg sub add_left_neg add_comm mul mul_assoc one one_mul mul_one
    left_distrib right_distrib nonneg pos zero_nonneg add_nonneg nonneg_antisymm sorry mul_nonneg sorry

/-- Construct `linear_order` from `linear_nonneg_ring`. This is not an instance
because we don't use it in `mathlib`. -/
def to_linear_order {α : Type u} [linear_nonneg_ring α] [decidable_pred nonneg] : linear_order α :=
  linear_order.mk ordered_add_comm_group.le ordered_add_comm_group.lt sorry sorry sorry sorry
    (fun (a b : α) => _inst_2 (b - a)) Mathlib.decidable_eq_of_decidable_le
    fun (a b : α) => Mathlib.decidable_lt_of_decidable_le a b

/-- Construct `linear_ordered_ring` from `linear_nonneg_ring`.
This is not an instance because we don't use it in `mathlib`. -/
def to_linear_ordered_ring {α : Type u} [linear_nonneg_ring α] [decidable_pred nonneg] : linear_ordered_ring α :=
  linear_ordered_ring.mk add add_assoc zero zero_add add_zero neg sub add_left_neg add_comm mul mul_assoc one one_mul
    mul_one left_distrib right_distrib ordered_add_comm_group.le ordered_add_comm_group.lt sorry sorry sorry sorry sorry
    sorry sorry linear_order.decidable_le linear_order.decidable_eq linear_order.decidable_lt exists_pair_ne

/-- Convert a `linear_nonneg_ring` with a commutative multiplication and
decidable non-negativity into a `linear_ordered_comm_ring` -/
def to_linear_ordered_comm_ring {α : Type u} [linear_nonneg_ring α] [decidable_pred nonneg] [comm : is_commutative α Mul.mul] : linear_ordered_comm_ring α :=
  linear_ordered_comm_ring.mk linear_ordered_ring.add sorry linear_ordered_ring.zero sorry sorry linear_ordered_ring.neg
    linear_ordered_ring.sub sorry sorry linear_ordered_ring.mul sorry linear_ordered_ring.one sorry sorry sorry sorry
    linear_ordered_ring.le linear_ordered_ring.lt sorry sorry sorry sorry sorry sorry sorry
    linear_ordered_ring.decidable_le linear_ordered_ring.decidable_eq linear_ordered_ring.decidable_lt sorry sorry

end linear_nonneg_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. -/
class canonically_ordered_comm_semiring (α : Type u_1)
extends comm_semiring α, canonically_ordered_add_monoid α
where
  eq_zero_or_eq_zero_of_mul_eq_zero : ∀ (a b : α), a * b = 0 → a = 0 ∨ b = 0

namespace canonically_ordered_semiring

protected instance canonically_ordered_comm_semiring.to_no_zero_divisors {α : Type u} [canonically_ordered_comm_semiring α] : no_zero_divisors α :=
  no_zero_divisors.mk canonically_ordered_comm_semiring.eq_zero_or_eq_zero_of_mul_eq_zero

theorem mul_le_mul {α : Type u} [canonically_ordered_comm_semiring α] {a : α} {b : α} {c : α} {d : α} (hab : a ≤ b) (hcd : c ≤ d) : a * c ≤ b * d := sorry

theorem mul_le_mul_left' {α : Type u} [canonically_ordered_comm_semiring α] {b : α} {c : α} (h : b ≤ c) (a : α) : a * b ≤ a * c :=
  mul_le_mul le_rfl h

theorem mul_le_mul_right' {α : Type u} [canonically_ordered_comm_semiring α] {b : α} {c : α} (h : b ≤ c) (a : α) : b * a ≤ c * a :=
  mul_le_mul h le_rfl

/-- A version of `zero_lt_one : 0 < 1` for a `canonically_ordered_comm_semiring`. -/
theorem zero_lt_one {α : Type u} [canonically_ordered_comm_semiring α] [nontrivial α] : 0 < 1 :=
  has_le.le.lt_of_ne (zero_le 1) zero_ne_one

theorem mul_pos {α : Type u} [canonically_ordered_comm_semiring α] {a : α} {b : α} : 0 < a * b ↔ 0 < a ∧ 0 < b := sorry

end canonically_ordered_semiring

namespace with_top

protected instance nontrivial {α : Type u} [Nonempty α] : nontrivial (with_top α) :=
  option.nontrivial

protected instance mul_zero_class {α : Type u} [DecidableEq α] [HasZero α] [Mul α] : mul_zero_class (with_top α) :=
  mul_zero_class.mk
    (fun (m n : with_top α) => ite (m = 0 ∨ n = 0) 0 (option.bind m fun (a : α) => option.bind n fun (b : α) => ↑(a * b)))
    0 sorry sorry

theorem mul_def {α : Type u} [DecidableEq α] [HasZero α] [Mul α] {a : with_top α} {b : with_top α} : a * b = ite (a = 0 ∨ b = 0) 0 (option.bind a fun (a : α) => option.bind b fun (b : α) => ↑(a * b)) :=
  rfl

@[simp] theorem mul_top {α : Type u} [DecidableEq α] [HasZero α] [Mul α] {a : with_top α} (h : a ≠ 0) : a * ⊤ = ⊤ := sorry

@[simp] theorem top_mul {α : Type u} [DecidableEq α] [HasZero α] [Mul α] {a : with_top α} (h : a ≠ 0) : ⊤ * a = ⊤ := sorry

@[simp] theorem top_mul_top {α : Type u} [DecidableEq α] [HasZero α] [Mul α] : ⊤ * ⊤ = ⊤ :=
  top_mul top_ne_zero

theorem coe_mul {α : Type u} [DecidableEq α] [mul_zero_class α] {a : α} {b : α} : ↑(a * b) = ↑a * ↑b := sorry

theorem mul_coe {α : Type u} [DecidableEq α] [mul_zero_class α] {b : α} (hb : b ≠ 0) {a : with_top α} : a * ↑b = option.bind a fun (a : α) => ↑(a * b) := sorry

@[simp] theorem mul_eq_top_iff {α : Type u} [DecidableEq α] [mul_zero_class α] {a : with_top α} {b : with_top α} : a * b = ⊤ ↔ a ≠ 0 ∧ b = ⊤ ∨ a = ⊤ ∧ b ≠ 0 := sorry

protected instance no_zero_divisors {α : Type u} [DecidableEq α] [mul_zero_class α] [no_zero_divisors α] : no_zero_divisors (with_top α) := sorry

-- `nontrivial α` is needed here as otherwise

-- we have `1 * ⊤ = ⊤` but also `= 0 * ⊤ = 0`.

protected instance canonically_ordered_comm_semiring {α : Type u} [DecidableEq α] [canonically_ordered_comm_semiring α] [nontrivial α] : canonically_ordered_comm_semiring (with_top α) :=
  canonically_ordered_comm_semiring.mk add_comm_monoid.add sorry add_comm_monoid.zero sorry sorry sorry
    canonically_ordered_add_monoid.le canonically_ordered_add_monoid.lt sorry sorry sorry sorry sorry
    canonically_ordered_add_monoid.bot sorry sorry mul_zero_class.mul sorry ↑1 sorry sorry sorry sorry sorry sorry sorry
    sorry

theorem mul_lt_top {α : Type u} [DecidableEq α] [canonically_ordered_comm_semiring α] [nontrivial α] {a : with_top α} {b : with_top α} (ha : a < ⊤) (hb : b < ⊤) : a * b < ⊤ := sorry


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Sébastien Gouëzel
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.analysis.calculus.mean_value
import Mathlib.data.nat.parity
import Mathlib.analysis.special_functions.pow
import Mathlib.PostPort

universes u_1 u_2

namespace Mathlib

/-!
# Collection of convex functions

In this file we prove that the following functions are convex:

* `convex_on_exp` : the exponential function is convex on $(-∞, +∞)$;
* `convex_on_pow_of_even` : given an even natural number $n$, the function $f(x)=x^n$
  is convex on $(-∞, +∞)$;
* `convex_on_pow` : for a natural $n$, the function $f(x)=x^n$ is convex on $[0, +∞)$;
* `convex_on_fpow` : for an integer $m$, the function $f(x)=x^m$ is convex on $(0, +∞)$.
* `convex_on_rpow : ∀ p : ℝ, 1 ≤ p → convex_on (Ici 0) (λ x, x ^ p)`
* `concave_on_log_Ioi` and `concave_on_log_Iio`: log is concave on `Ioi 0` and `Iio 0` respectively.
-/

/-- `exp` is convex on the whole real line -/
theorem convex_on_exp : convex_on set.univ real.exp := sorry

/-- `x^n`, `n : ℕ` is convex on the whole real line whenever `n` is even -/
theorem convex_on_pow_of_even {n : ℕ} (hn : even n) : convex_on set.univ fun (x : ℝ) => x ^ n :=
  sorry

/-- `x^n`, `n : ℕ` is convex on `[0, +∞)` for all `n` -/
theorem convex_on_pow (n : ℕ) : convex_on (set.Ici 0) fun (x : ℝ) => x ^ n := sorry

theorem finset.prod_nonneg_of_card_nonpos_even {α : Type u_1} {β : Type u_2}
    [linear_ordered_comm_ring β] {f : α → β} [decidable_pred fun (x : α) => f x ≤ 0] {s : finset α}
    (h0 : even (finset.card (finset.filter (fun (x : α) => f x ≤ 0) s))) :
    0 ≤ finset.prod s fun (x : α) => f x :=
  sorry

theorem int_prod_range_nonneg (m : ℤ) (n : ℕ) (hn : even n) :
    0 ≤ finset.prod (finset.range n) fun (k : ℕ) => m - ↑k :=
  sorry

/-- `x^m`, `m : ℤ` is convex on `(0, +∞)` for all `m` -/
theorem convex_on_fpow (m : ℤ) : convex_on (set.Ioi 0) fun (x : ℝ) => x ^ m := sorry

theorem convex_on_rpow {p : ℝ} (hp : 1 ≤ p) : convex_on (set.Ici 0) fun (x : ℝ) => x ^ p := sorry

theorem concave_on_log_Ioi : concave_on (set.Ioi 0) real.log := sorry

theorem concave_on_log_Iio : concave_on (set.Iio 0) real.log := sorry

end Mathlib


/-
Copyright (c) 2020 Yury Kudryashov All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Heather Macbeth
-/
import analysis.convex.cone
import analysis.normed_space.is_R_or_C
import analysis.normed_space.extend

/-!
# Hahn-Banach theorem

In this file we prove a version of Hahn-Banach theorem for continuous linear
functions on normed spaces over `ℝ` and `ℂ`.

In order to state and prove its corollaries uniformly, we prove the statements for a field `𝕜`
satisfying `is_R_or_C 𝕜`.

In this setting, `exists_dual_vector` states that, for any nonzero `x`, there exists a continuous
linear form `g` of norm `1` with `g x = ∥x∥` (where the norm has to be interpreted as an element
of `𝕜`).

-/

universes u v

namespace real
variables {E : Type*} [semi_normed_group E] [semi_normed_space ℝ E]

/-- Hahn-Banach theorem for continuous linear functions over `ℝ`. -/
theorem exists_extension_norm_eq (p : subspace ℝ E) (f : p →L[ℝ] ℝ) :
  ∃ g : E →L[ℝ] ℝ, (∀ x : p, g x = f x) ∧ ∥g∥ = ∥f∥ :=
begin
  rcases exists_extension_of_le_sublinear ⟨p, f⟩ (λ x, ∥f∥ * ∥x∥)
    (λ c hc x, by simp only [norm_smul c x, real.norm_eq_abs, abs_of_pos hc, mul_left_comm])
    (λ x y, _) (λ x, le_trans (le_abs_self _) (f.le_op_norm _))
    with ⟨g, g_eq, g_le⟩,
  set g' := g.mk_continuous (∥f∥)
    (λ x, abs_le.2 ⟨neg_le.1 $ g.map_neg x ▸ norm_neg x ▸ g_le (-x), g_le x⟩),
  { refine ⟨g', g_eq, _⟩,
    { apply le_antisymm (g.mk_continuous_norm_le (norm_nonneg f) _),
      refine f.op_norm_le_bound (norm_nonneg _) (λ x, _),
      dsimp at g_eq,
      rw ← g_eq,
      apply g'.le_op_norm } },
  { simp only [← mul_add],
    exact mul_le_mul_of_nonneg_left (norm_add_le x y) (norm_nonneg f) }
end

end real

section is_R_or_C
open is_R_or_C

variables {𝕜 : Type*} [is_R_or_C 𝕜] {F : Type*} [semi_normed_group F] [semi_normed_space 𝕜 F]

/-- Hahn-Banach theorem for continuous linear functions over `𝕜` satisyfing `is_R_or_C 𝕜`. -/
theorem exists_extension_norm_eq (p : subspace 𝕜 F) (f : p →L[𝕜] 𝕜) :
  ∃ g : F →L[𝕜] 𝕜, (∀ x : p, g x = f x) ∧ ∥g∥ = ∥f∥ :=
begin
  letI : module ℝ F := restrict_scalars.module ℝ 𝕜 F,
  letI : is_scalar_tower ℝ 𝕜 F := restrict_scalars.is_scalar_tower _ _ _,
  letI : semi_normed_space ℝ F := semi_normed_space.restrict_scalars _ 𝕜 _,
  -- Let `fr: p →L[ℝ] ℝ` be the real part of `f`.
  let fr := re_clm.comp (f.restrict_scalars ℝ),
  have fr_apply : ∀ x, fr x = re (f x), by { assume x, refl },
  -- Use the real version to get a norm-preserving extension of `fr`, which
  -- we'll call `g : F →L[ℝ] ℝ`.
  rcases real.exists_extension_norm_eq (p.restrict_scalars ℝ) fr with ⟨g, ⟨hextends, hnormeq⟩⟩,
  -- Now `g` can be extended to the `F →L[𝕜] 𝕜` we need.
  refine ⟨g.extend_to_𝕜, _⟩,
  -- It is an extension of `f`.
  have h : ∀ x : p, g.extend_to_𝕜 x = f x,
  { assume x,
    rw [continuous_linear_map.extend_to_𝕜_apply, ←submodule.coe_smul, hextends, hextends],
    have : (fr x : 𝕜) - I * ↑(fr (I • x)) = (re (f x) : 𝕜) - (I : 𝕜) * (re (f ((I : 𝕜) • x))),
      by refl,
    rw this,
    apply ext,
    { simp only [add_zero, algebra.id.smul_eq_mul, I_re, of_real_im, add_monoid_hom.map_add,
        zero_sub, I_im', zero_mul, of_real_re, eq_self_iff_true, sub_zero, mul_neg_eq_neg_mul_symm,
        of_real_neg, mul_re, mul_zero, sub_neg_eq_add, continuous_linear_map.map_smul] },
    { simp only [algebra.id.smul_eq_mul, I_re, of_real_im, add_monoid_hom.map_add, zero_sub, I_im',
        zero_mul, of_real_re, mul_neg_eq_neg_mul_symm, mul_im, zero_add, of_real_neg, mul_re,
        sub_neg_eq_add, continuous_linear_map.map_smul] } },
  -- And we derive the equality of the norms by bounding on both sides.
  refine ⟨h, le_antisymm _ _⟩,
  { calc ∥g.extend_to_𝕜∥
        ≤ ∥g∥ : g.extend_to_𝕜.op_norm_le_bound g.op_norm_nonneg (norm_bound _)
    ... = ∥fr∥ : hnormeq
    ... ≤ ∥re_clm∥ * ∥f∥ : continuous_linear_map.op_norm_comp_le _ _
    ... = ∥f∥ : by rw [re_clm_norm, one_mul] },
  { exact f.op_norm_le_bound g.extend_to_𝕜.op_norm_nonneg (λ x, h x ▸ g.extend_to_𝕜.le_op_norm x) }
end

end is_R_or_C

section dual_vector
variables (𝕜 : Type v) [is_R_or_C 𝕜]
variables {E : Type u} [normed_group E] [normed_space 𝕜 E]

open continuous_linear_equiv submodule
open_locale classical

lemma coord_norm' {x : E} (h : x ≠ 0) : ∥(∥x∥ : 𝕜) • coord 𝕜 x h∥ = 1 :=
by rw [norm_smul, is_R_or_C.norm_coe_norm, coord_norm, mul_inv_cancel (mt norm_eq_zero.mp h)]

/-- Corollary of Hahn-Banach.  Given a nonzero element `x` of a normed space, there exists an
    element of the dual space, of norm `1`, whose value on `x` is `∥x∥`. -/
theorem exists_dual_vector (x : E) (h : x ≠ 0) : ∃ g : E →L[𝕜] 𝕜, ∥g∥ = 1 ∧ g x = ∥x∥ :=
begin
  let p : submodule 𝕜 E := 𝕜 ∙ x,
  let f := (∥x∥ : 𝕜) • coord 𝕜 x h,
  obtain ⟨g, hg⟩ := exists_extension_norm_eq p f,
  refine ⟨g, _, _⟩,
  { rw [hg.2, coord_norm'] },
  { calc g x = g (⟨x, mem_span_singleton_self x⟩ : 𝕜 ∙ x) : by rw coe_mk
    ... = ((∥x∥ : 𝕜) • coord 𝕜 x h) (⟨x, mem_span_singleton_self x⟩ : 𝕜 ∙ x) : by rw ← hg.1
    ... = ∥x∥ : by simp }
end

/-- Variant of Hahn-Banach, eliminating the hypothesis that `x` be nonzero, and choosing
    the dual element arbitrarily when `x = 0`. -/
theorem exists_dual_vector' [nontrivial E] (x : E) :
  ∃ g : E →L[𝕜] 𝕜, ∥g∥ = 1 ∧ g x = ∥x∥ :=
begin
  by_cases hx : x = 0,
  { obtain ⟨y, hy⟩ := exists_ne (0 : E),
    obtain ⟨g, hg⟩ : ∃ g : E →L[𝕜] 𝕜, ∥g∥ = 1 ∧ g y = ∥y∥ := exists_dual_vector 𝕜 y hy,
    refine ⟨g, hg.left, _⟩,
    simp [hx] },
  { exact exists_dual_vector 𝕜 x hx }
end

/-- Variant of Hahn-Banach, eliminating the hypothesis that `x` be nonzero, but only ensuring that
    the dual element has norm at most `1` (this can not be improved for the trivial
    vector space). -/
theorem exists_dual_vector'' (x : E) :
  ∃ g : E →L[𝕜] 𝕜, ∥g∥ ≤ 1 ∧ g x = ∥x∥ :=
begin
  by_cases hx : x = 0,
  { refine ⟨0, by simp, _⟩,
    symmetry,
    simp [hx], },
  { rcases exists_dual_vector 𝕜 x hx with ⟨g, g_norm, g_eq⟩,
    exact ⟨g, g_norm.le, g_eq⟩ }
end

end dual_vector


/-
Copyright (c) 2020 Thomas Browning, Patrick Lutz. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Thomas Browning, Patrick Lutz
-/

import group_theory.perm.cycle_type
import analysis.complex.polynomial
import field_theory.galois

/-!
# Galois Groups of Polynomials

In this file, we introduce the Galois group of a polynomial `p` over a field `F`,
defined as the automorphism group of its splitting field. We also provide
some results about some extension `E` above `p.splitting_field`, and some specific
results about the Galois groups of ℚ-polynomials with specific numbers of non-real roots.

## Main definitions

- `polynomial.gal p`: the Galois group of a polynomial p.
- `polynomial.gal.restrict p E`: the restriction homomorphism `(E ≃ₐ[F] E) → gal p`.
- `polynomial.gal.gal_action p E`: the action of `gal p` on the roots of `p` in `E`.

## Main results

- `polynomial.gal.restrict_smul`: `restrict p E` is compatible with `gal_action p E`.
- `polynomial.gal.gal_action_hom_injective`: `gal p` acting on the roots of `p` in `E` is faithful.
- `polynomial.gal.restrict_prod_injective`: `gal (p * q)` embeds as a subgroup of `gal p × gal q`.
- `polynomial.gal.card_of_separable`: For a separable polynomial, its Galois group has cardinality
equal to the dimension of its splitting field over `F`.
- `polynomial.gal.gal_action_hom_bijective_of_prime_degree`:
An irreducible polynomial of prime degree with two non-real roots has full Galois group.

## Other results
- `polynomial.gal.card_complex_roots_eq_card_real_add_card_not_gal_inv`: The number of complex roots
equals the number of real roots plus the number of roots not fixed by complex conjugation
(i.e. with some imaginary component).

-/

noncomputable theory
open_locale classical polynomial

open finite_dimensional

namespace polynomial

variables {F : Type*} [field F] (p q : F[X]) (E : Type*) [field E] [algebra F E]

/-- The Galois group of a polynomial. -/
@[derive [group, fintype]]
def gal := p.splitting_field ≃ₐ[F] p.splitting_field

namespace gal

instance : has_coe_to_fun p.gal (λ _, p.splitting_field → p.splitting_field) :=
alg_equiv.has_coe_to_fun

@[ext] lemma ext {σ τ : p.gal} (h : ∀ x ∈ p.root_set p.splitting_field, σ x = τ x) : σ = τ :=
begin
  refine alg_equiv.ext (λ x, (alg_hom.mem_equalizer σ.to_alg_hom τ.to_alg_hom x).mp
      ((set_like.ext_iff.mp _ x).mpr algebra.mem_top)),
  rwa [eq_top_iff, ←splitting_field.adjoin_roots, algebra.adjoin_le_iff],
end

/-- If `p` splits in `F` then the `p.gal` is trivial. -/
def unique_gal_of_splits (h : p.splits (ring_hom.id F)) : unique p.gal :=
{ default := 1,
  uniq := λ f, alg_equiv.ext (λ x, by { obtain ⟨y, rfl⟩ := algebra.mem_bot.mp
    ((set_like.ext_iff.mp ((is_splitting_field.splits_iff _ p).mp h) x).mp algebra.mem_top),
    rw [alg_equiv.commutes, alg_equiv.commutes] }) }

instance [h : fact (p.splits (ring_hom.id F))] : unique p.gal :=
unique_gal_of_splits _ (h.1)

instance unique_gal_zero : unique (0 : F[X]).gal :=
unique_gal_of_splits _ (splits_zero _)

instance unique_gal_one : unique (1 : F[X]).gal :=
unique_gal_of_splits _ (splits_one _)

instance unique_gal_C (x : F) : unique (C x).gal :=
unique_gal_of_splits _ (splits_C _ _)

instance unique_gal_X : unique (X : F[X]).gal :=
unique_gal_of_splits _ (splits_X _)

instance unique_gal_X_sub_C (x : F) : unique (X - C x).gal :=
unique_gal_of_splits _ (splits_X_sub_C _)

instance unique_gal_X_pow (n : ℕ) : unique (X ^ n : F[X]).gal :=
unique_gal_of_splits _ (splits_X_pow _ _)

instance [h : fact (p.splits (algebra_map F E))] : algebra p.splitting_field E :=
(is_splitting_field.lift p.splitting_field p h.1).to_ring_hom.to_algebra

instance [h : fact (p.splits (algebra_map F E))] : is_scalar_tower F p.splitting_field E :=
is_scalar_tower.of_algebra_map_eq
  (λ x, ((is_splitting_field.lift p.splitting_field p h.1).commutes x).symm)

-- The `algebra p.splitting_field E` instance above behaves badly when
-- `E := p.splitting_field`, since it may result in a unification problem
-- `is_splitting_field.lift.to_ring_hom.to_algebra =?= algebra.id`,
-- which takes an extremely long time to resolve, causing timeouts.
-- Since we don't really care about this definition, marking it as irreducible
-- causes that unification to error out early.
attribute [irreducible] gal.algebra

/-- Restrict from a superfield automorphism into a member of `gal p`. -/
def restrict [fact (p.splits (algebra_map F E))] : (E ≃ₐ[F] E) →* p.gal :=
alg_equiv.restrict_normal_hom p.splitting_field

lemma restrict_surjective [fact (p.splits (algebra_map F E))] [normal F E] :
  function.surjective (restrict p E) :=
alg_equiv.restrict_normal_hom_surjective E

section roots_action

/-- The function taking `roots p p.splitting_field` to `roots p E`. This is actually a bijection,
see `polynomial.gal.map_roots_bijective`. -/
def map_roots [fact (p.splits (algebra_map F E))] :
  root_set p p.splitting_field → root_set p E :=
λ x, ⟨is_scalar_tower.to_alg_hom F p.splitting_field E x, begin
  have key := subtype.mem x,
  by_cases p = 0,
  { simp only [h, root_set_zero] at key,
    exact false.rec _ key },
  { rw [mem_root_set h, aeval_alg_hom_apply, (mem_root_set h).mp key, alg_hom.map_zero] } end⟩

lemma map_roots_bijective [h : fact (p.splits (algebra_map F E))] :
  function.bijective (map_roots p E) :=
begin
  split,
  { exact λ _ _ h, subtype.ext (ring_hom.injective _ (subtype.ext_iff.mp h)) },
  { intro y,
    -- this is just an equality of two different ways to write the roots of `p` as an `E`-polynomial
    have key := roots_map
      (is_scalar_tower.to_alg_hom F p.splitting_field E : p.splitting_field →+* E)
      ((splits_id_iff_splits _).mpr (is_splitting_field.splits p.splitting_field p)),
    rw [map_map, alg_hom.comp_algebra_map] at key,
    have hy := subtype.mem y,
    simp only [root_set, finset.mem_coe, multiset.mem_to_finset, key, multiset.mem_map] at hy,
    rcases hy with ⟨x, hx1, hx2⟩,
    exact ⟨⟨x, multiset.mem_to_finset.mpr hx1⟩, subtype.ext hx2⟩ }
end

/-- The bijection between `root_set p p.splitting_field` and `root_set p E`. -/
def roots_equiv_roots [fact (p.splits (algebra_map F E))] :
  (root_set p p.splitting_field) ≃ (root_set p E) :=
equiv.of_bijective (map_roots p E) (map_roots_bijective p E)

instance gal_action_aux : mul_action p.gal (root_set p p.splitting_field) :=
{ smul := λ ϕ x, ⟨ϕ x, begin
    have key := subtype.mem x,
    --simp only [root_set, finset.mem_coe, multiset.mem_to_finset] at *,
    by_cases p = 0,
    { simp only [h, root_set_zero] at key,
      exact false.rec _ key },
    { rw mem_root_set h,
      change aeval (ϕ.to_alg_hom x) p = 0,
      rw [aeval_alg_hom_apply, (mem_root_set h).mp key, alg_hom.map_zero] } end⟩,
  one_smul := λ _, by { ext, refl },
  mul_smul := λ _ _ _, by { ext, refl } }

/-- The action of `gal p` on the roots of `p` in `E`. -/
instance gal_action [fact (p.splits (algebra_map F E))] : mul_action p.gal (root_set p E) :=
{ smul := λ ϕ x, roots_equiv_roots p E (ϕ • ((roots_equiv_roots p E).symm x)),
  one_smul := λ _, by simp only [equiv.apply_symm_apply, one_smul],
  mul_smul := λ _ _ _, by simp only [equiv.apply_symm_apply, equiv.symm_apply_apply, mul_smul] }

variables {p E}

/-- `polynomial.gal.restrict p E` is compatible with `polynomial.gal.gal_action p E`. -/
@[simp] lemma restrict_smul [fact (p.splits (algebra_map F E))]
  (ϕ : E ≃ₐ[F] E) (x : root_set p E) : ↑((restrict p E ϕ) • x) = ϕ x :=
begin
  let ψ := alg_equiv.of_injective_field (is_scalar_tower.to_alg_hom F p.splitting_field E),
  change ↑(ψ (ψ.symm _)) = ϕ x,
  rw alg_equiv.apply_symm_apply ψ,
  change ϕ (roots_equiv_roots p E ((roots_equiv_roots p E).symm x)) = ϕ x,
  rw equiv.apply_symm_apply (roots_equiv_roots p E),
end

variables (p E)

/-- `polynomial.gal.gal_action` as a permutation representation -/
def gal_action_hom [fact (p.splits (algebra_map F E))] : p.gal →* equiv.perm (root_set p E) :=
{ to_fun := λ ϕ, equiv.mk (λ x, ϕ • x) (λ x, ϕ⁻¹ • x)
  (λ x, inv_smul_smul ϕ x) (λ x, smul_inv_smul ϕ x),
  map_one' := by { ext1 x, exact mul_action.one_smul x },
  map_mul' := λ x y, by { ext1 z, exact mul_action.mul_smul x y z } }

lemma gal_action_hom_restrict [fact (p.splits (algebra_map F E))]
  (ϕ : E ≃ₐ[F] E) (x : root_set p E) : ↑(gal_action_hom p E (restrict p E ϕ) x) = ϕ x :=
restrict_smul ϕ x

/-- `gal p` embeds as a subgroup of permutations of the roots of `p` in `E`. -/
lemma gal_action_hom_injective [fact (p.splits (algebra_map F E))] :
  function.injective (gal_action_hom p E) :=
begin
  rw monoid_hom.injective_iff,
  intros ϕ hϕ,
  ext x hx,
  have key := equiv.perm.ext_iff.mp hϕ (roots_equiv_roots p E ⟨x, hx⟩),
  change roots_equiv_roots p E (ϕ • (roots_equiv_roots p E).symm
    (roots_equiv_roots p E ⟨x, hx⟩)) = roots_equiv_roots p E ⟨x, hx⟩ at key,
  rw equiv.symm_apply_apply at key,
  exact subtype.ext_iff.mp (equiv.injective (roots_equiv_roots p E) key),
end

end roots_action

variables {p q}

/-- `polynomial.gal.restrict`, when both fields are splitting fields of polynomials. -/
def restrict_dvd (hpq : p ∣ q) : q.gal →* p.gal :=
if hq : q = 0 then 1 else @restrict F _ p _ _ _
  ⟨splits_of_splits_of_dvd (algebra_map F q.splitting_field) hq (splitting_field.splits q) hpq⟩

lemma restrict_dvd_surjective (hpq : p ∣ q) (hq : q ≠ 0) :
  function.surjective (restrict_dvd hpq) :=
by simp only [restrict_dvd, dif_neg hq, restrict_surjective]

variables (p q)

/-- The Galois group of a product maps into the product of the Galois groups.  -/
def restrict_prod : (p * q).gal →* p.gal × q.gal :=
monoid_hom.prod (restrict_dvd (dvd_mul_right p q)) (restrict_dvd (dvd_mul_left q p))

/-- `polynomial.gal.restrict_prod` is actually a subgroup embedding. -/
lemma restrict_prod_injective : function.injective (restrict_prod p q) :=
begin
  by_cases hpq : (p * q) = 0,
  { haveI : unique (p * q).gal, { rw hpq, apply_instance },
    exact λ f g h, eq.trans (unique.eq_default f) (unique.eq_default g).symm },
  intros f g hfg,
  dsimp only [restrict_prod, restrict_dvd] at hfg,
  simp only [dif_neg hpq, monoid_hom.prod_apply, prod.mk.inj_iff] at hfg,
  ext x hx,
  rw [root_set, map_mul, polynomial.roots_mul] at hx,
  cases multiset.mem_add.mp (multiset.mem_to_finset.mp hx) with h h,
  { haveI : fact (p.splits (algebra_map F (p * q).splitting_field)) :=
      ⟨splits_of_splits_of_dvd _ hpq (splitting_field.splits (p * q)) (dvd_mul_right p q)⟩,
    have key : x = algebra_map (p.splitting_field) (p * q).splitting_field
      ((roots_equiv_roots p _).inv_fun ⟨x, multiset.mem_to_finset.mpr h⟩) :=
      subtype.ext_iff.mp (equiv.apply_symm_apply (roots_equiv_roots p _) ⟨x, _⟩).symm,
    rw [key, ←alg_equiv.restrict_normal_commutes, ←alg_equiv.restrict_normal_commutes],
    exact congr_arg _ (alg_equiv.ext_iff.mp hfg.1 _) },
  { haveI : fact (q.splits (algebra_map F (p * q).splitting_field)) :=
      ⟨splits_of_splits_of_dvd _ hpq (splitting_field.splits (p * q)) (dvd_mul_left q p)⟩,
    have key : x = algebra_map (q.splitting_field) (p * q).splitting_field
      ((roots_equiv_roots q _).inv_fun ⟨x, multiset.mem_to_finset.mpr h⟩) :=
      subtype.ext_iff.mp (equiv.apply_symm_apply (roots_equiv_roots q _) ⟨x, _⟩).symm,
    rw [key, ←alg_equiv.restrict_normal_commutes, ←alg_equiv.restrict_normal_commutes],
    exact congr_arg _ (alg_equiv.ext_iff.mp hfg.2 _) },
  { rwa [ne.def, mul_eq_zero, map_eq_zero, map_eq_zero, ←mul_eq_zero] }
end

/-- `p` splits in the splitting field of `p ∘ q`, for `q` non-constant. -/
lemma splits_in_splitting_field_of_comp (hq : q.nat_degree ≠ 0) :
  p.splits (algebra_map F (p.comp q).splitting_field) :=
begin
  let P : F[X] → Prop := λ r, r.splits (algebra_map F (r.comp q).splitting_field),
  have key1 : ∀ {r : F[X]}, irreducible r → P r,
  { intros r hr,
    by_cases hr' : nat_degree r = 0,
    { exact splits_of_nat_degree_le_one _ (le_trans (le_of_eq hr') zero_le_one) },
    obtain ⟨x, hx⟩ := exists_root_of_splits _ (splitting_field.splits (r.comp q))
      (λ h, hr' ((mul_eq_zero.mp (nat_degree_comp.symm.trans
        (nat_degree_eq_of_degree_eq_some h))).resolve_right hq)),
    rw [←aeval_def, aeval_comp] at hx,
    have h_normal : normal F (r.comp q).splitting_field := splitting_field.normal (r.comp q),
    have qx_int := normal.is_integral h_normal (aeval x q),
    exact splits_of_splits_of_dvd _
      (minpoly.ne_zero qx_int)
      (normal.splits h_normal _)
      ((minpoly.irreducible qx_int).dvd_symm hr (minpoly.dvd F _ hx)) },
  have key2 : ∀ {p₁ p₂ : F[X]}, P p₁ → P p₂ → P (p₁ * p₂),
  { intros p₁ p₂ hp₁ hp₂,
    by_cases h₁ : p₁.comp q = 0,
    { cases comp_eq_zero_iff.mp h₁ with h h,
      { rw [h, zero_mul],
        exact splits_zero _ },
      { exact false.rec _ (hq (by rw [h.2, nat_degree_C])) } },
    by_cases h₂ : p₂.comp q = 0,
    { cases comp_eq_zero_iff.mp h₂ with h h,
      { rw [h, mul_zero],
        exact splits_zero _ },
      { exact false.rec _ (hq (by rw [h.2, nat_degree_C])) } },
    have key := mul_splits_in_splitting_field_of_mul h₁ h₂ hp₁ hp₂,
    rwa ← mul_comp at key },
  exact wf_dvd_monoid.induction_on_irreducible p (splits_zero _)
    (λ _, splits_of_is_unit _) (λ _ _ _ h, key2 (key1 h)),
end

/-- `polynomial.gal.restrict` for the composition of polynomials. -/
def restrict_comp (hq : q.nat_degree ≠ 0) : (p.comp q).gal →* p.gal :=
@restrict F _ p _ _ _ ⟨splits_in_splitting_field_of_comp p q hq⟩

lemma restrict_comp_surjective (hq : q.nat_degree ≠ 0) :
  function.surjective (restrict_comp p q hq) :=
by simp only [restrict_comp, restrict_surjective]

variables {p q}

/-- For a separable polynomial, its Galois group has cardinality
equal to the dimension of its splitting field over `F`. -/
lemma card_of_separable (hp : p.separable) :
  fintype.card p.gal = finrank F p.splitting_field :=
begin
  haveI : is_galois F p.splitting_field := is_galois.of_separable_splitting_field hp,
  exact is_galois.card_aut_eq_finrank F p.splitting_field,
end

lemma prime_degree_dvd_card [char_zero F] (p_irr : irreducible p) (p_deg : p.nat_degree.prime) :
  p.nat_degree ∣ fintype.card p.gal :=
begin
  rw gal.card_of_separable p_irr.separable,
  have hp : p.degree ≠ 0 :=
    λ h, nat.prime.ne_zero p_deg (nat_degree_eq_zero_iff_degree_le_zero.mpr (le_of_eq h)),
  let α : p.splitting_field := root_of_splits (algebra_map F p.splitting_field)
    (splitting_field.splits p) hp,
  have hα : is_integral F α := algebra.is_integral_of_finite _ _ α,
  use finite_dimensional.finrank F⟮α⟯ p.splitting_field,
  suffices : (minpoly F α).nat_degree = p.nat_degree,
  { rw [←finite_dimensional.finrank_mul_finrank F F⟮α⟯ p.splitting_field,
        intermediate_field.adjoin.finrank hα, this] },
  suffices : minpoly F α ∣ p,
  { have key := (minpoly.irreducible hα).dvd_symm p_irr this,
    apply le_antisymm,
    { exact nat_degree_le_of_dvd this p_irr.ne_zero },
    { exact nat_degree_le_of_dvd key (minpoly.ne_zero hα) } },
  apply minpoly.dvd F α,
  rw [aeval_def, map_root_of_splits _ (splitting_field.splits p) hp],
end

section rationals

lemma splits_ℚ_ℂ {p : ℚ[X]} : fact (p.splits (algebra_map ℚ ℂ)) :=
⟨is_alg_closed.splits_codomain p⟩

local attribute [instance] splits_ℚ_ℂ

/-- The number of complex roots equals the number of real roots plus
    the number of roots not fixed by complex conjugation (i.e. with some imaginary component). -/
lemma card_complex_roots_eq_card_real_add_card_not_gal_inv (p : ℚ[X]) :
  (p.root_set ℂ).to_finset.card = (p.root_set ℝ).to_finset.card +
  (gal_action_hom p ℂ (restrict p ℂ (complex.conj_ae.restrict_scalars ℚ))).support.card :=
begin
  by_cases hp : p = 0,
  { simp_rw [hp, root_set_zero, set.to_finset_eq_empty_iff.mpr rfl, finset.card_empty, zero_add],
    refine eq.symm (nat.le_zero_iff.mp ((finset.card_le_univ _).trans (le_of_eq _))),
    simp_rw [hp, root_set_zero, fintype.card_eq_zero_iff],
    apply_instance },
  have inj : function.injective (is_scalar_tower.to_alg_hom ℚ ℝ ℂ) := (algebra_map ℝ ℂ).injective,
  rw [←finset.card_image_of_injective _ subtype.coe_injective,
      ←finset.card_image_of_injective _ inj],
  let a : finset ℂ := _,
  let b : finset ℂ := _,
  let c : finset ℂ := _,
  change a.card = b.card + c.card,
  have ha : ∀ z : ℂ, z ∈ a ↔ aeval z p = 0 :=
  λ z, by rw [set.mem_to_finset, mem_root_set hp],
  have hb : ∀ z : ℂ, z ∈ b ↔ aeval z p = 0 ∧ z.im = 0,
  { intro z,
    simp_rw [finset.mem_image, exists_prop, set.mem_to_finset, mem_root_set hp],
    split,
    { rintros ⟨w, hw, rfl⟩,
      exact ⟨by rw [aeval_alg_hom_apply, hw, alg_hom.map_zero], rfl⟩ },
    { rintros ⟨hz1, hz2⟩,
      have key : is_scalar_tower.to_alg_hom ℚ ℝ ℂ z.re = z := by { ext, refl, rw hz2, refl },
      exact ⟨z.re, inj (by rwa [←aeval_alg_hom_apply, key, alg_hom.map_zero]), key⟩ } },
  have hc0 : ∀ w : p.root_set ℂ, gal_action_hom p ℂ
    (restrict p ℂ (complex.conj_ae.restrict_scalars ℚ)) w = w ↔ w.val.im = 0,
  { intro w,
    rw [subtype.ext_iff, gal_action_hom_restrict],
    exact complex.eq_conj_iff_im },
  have hc : ∀ z : ℂ, z ∈ c ↔ aeval z p = 0 ∧ z.im ≠ 0,
  { intro z,
    simp_rw [finset.mem_image, exists_prop],
    split,
    { rintros ⟨w, hw, rfl⟩,
      exact ⟨(mem_root_set hp).mp w.2, mt (hc0 w).mpr (equiv.perm.mem_support.mp hw)⟩ },
    { rintros ⟨hz1, hz2⟩,
      exact ⟨⟨z, (mem_root_set hp).mpr hz1⟩,
        equiv.perm.mem_support.mpr (mt (hc0 _).mp hz2), rfl⟩ } },
  rw ← finset.card_disjoint_union,
  { apply congr_arg finset.card,
    simp_rw [finset.ext_iff, finset.mem_union, ha, hb, hc],
    tauto },
  { intro z,
    rw [finset.inf_eq_inter, finset.mem_inter, hb, hc],
    tauto },
  { apply_instance },
end

/-- An irreducible polynomial of prime degree with two non-real roots has full Galois group. -/
lemma gal_action_hom_bijective_of_prime_degree
  {p : ℚ[X]} (p_irr : irreducible p) (p_deg : p.nat_degree.prime)
  (p_roots : fintype.card (p.root_set ℂ) = fintype.card (p.root_set ℝ) + 2) :
  function.bijective (gal_action_hom p ℂ) :=
begin
  have h1 : fintype.card (p.root_set ℂ) = p.nat_degree,
  { simp_rw [root_set_def, finset.coe_sort_coe, fintype.card_coe],
    rw [multiset.to_finset_card_of_nodup, ←nat_degree_eq_card_roots],
    { exact is_alg_closed.splits_codomain p },
    { exact nodup_roots ((separable_map (algebra_map ℚ ℂ)).mpr p_irr.separable) } },
  have h2 : fintype.card p.gal = fintype.card (gal_action_hom p ℂ).range :=
  fintype.card_congr (monoid_hom.of_injective (gal_action_hom_injective p ℂ)).to_equiv,
  let conj := restrict p ℂ (complex.conj_ae.restrict_scalars ℚ),
  refine ⟨gal_action_hom_injective p ℂ, λ x, (congr_arg (has_mem.mem x)
    (show (gal_action_hom p ℂ).range = ⊤, from _)).mpr (subgroup.mem_top x)⟩,
  apply equiv.perm.subgroup_eq_top_of_swap_mem,
  { rwa h1 },
  { rw h1,
    convert prime_degree_dvd_card p_irr p_deg using 1,
    convert h2.symm },
  { exact ⟨conj, rfl⟩ },
  { rw ← equiv.perm.card_support_eq_two,
    apply nat.add_left_cancel,
    rw [←p_roots, ←set.to_finset_card (root_set p ℝ), ←set.to_finset_card (root_set p ℂ)],
    exact (card_complex_roots_eq_card_real_add_card_not_gal_inv p).symm },
end

/-- An irreducible polynomial of prime degree with 1-3 non-real roots has full Galois group. -/
lemma gal_action_hom_bijective_of_prime_degree'
  {p : ℚ[X]} (p_irr : irreducible p) (p_deg : p.nat_degree.prime)
  (p_roots1 : fintype.card (p.root_set ℝ) + 1 ≤ fintype.card (p.root_set ℂ))
  (p_roots2 : fintype.card (p.root_set ℂ) ≤ fintype.card (p.root_set ℝ) + 3) :
  function.bijective (gal_action_hom p ℂ) :=
begin
  apply gal_action_hom_bijective_of_prime_degree p_irr p_deg,
  let n := (gal_action_hom p ℂ (restrict p ℂ
    (complex.conj_ae.restrict_scalars ℚ))).support.card,
  have hn : 2 ∣ n :=
  equiv.perm.two_dvd_card_support (by rw [←monoid_hom.map_pow, ←monoid_hom.map_pow,
    show alg_equiv.restrict_scalars ℚ complex.conj_ae ^ 2 = 1,
    from alg_equiv.ext complex.conj_conj, monoid_hom.map_one, monoid_hom.map_one]),
  have key := card_complex_roots_eq_card_real_add_card_not_gal_inv p,
  simp_rw [set.to_finset_card] at key,
  rw [key, add_le_add_iff_left] at p_roots1 p_roots2,
  rw [key, add_right_inj],
  suffices : ∀ m : ℕ, 2 ∣ m → 1 ≤ m → m ≤ 3 → m = 2,
  { exact this n hn p_roots1 p_roots2 },
  rintros m ⟨k, rfl⟩ h2 h3,
  exact le_antisymm (nat.lt_succ_iff.mp (lt_of_le_of_ne h3 (show 2 * k ≠ 2 * 1 + 1,
    from nat.two_mul_ne_two_mul_add_one))) (nat.succ_le_iff.mpr (lt_of_le_of_ne h2
    (show 2 * 0 + 1 ≠ 2 * k, from nat.two_mul_ne_two_mul_add_one.symm))),
end

end rationals

end gal

end polynomial


/-
COMP2009-ACE

Exercise 03 (Bool)

    This exercise has 2 parts.

    The first part is "logic chess" which has slightly different rules
    than logic poker but see below. The 2nd part ass you to define
    operations on booleans correspoding to implication and universal
    quantification and prove it correct.

    Don't worry, if you can't do the universal quantification part.
    This is intended as a challenge and only counts for 20% of the
    exercise.
-/

namespace ex03

def bnot : bool → bool
| tt := ff
| ff := tt

def band : bool → bool → bool
| tt b := b
| ff b := ff

def bor : bool → bool → bool
| tt b := tt
| ff b := b

def is_tt : bool → Prop
| tt := true
| ff := false
local notation x && y := band x y
local notation x || y := bor x y

/-
If you get an error update your lean or use:
local notation x && y := band x y
local notation x || y := bor x y
-/

prefix `!`:90 := bnot

/-
PART I (60%)
============
Logic chess

Unlike logic poker in logic chess there is no guessing. You either
prove the proposition or you prove its negation, for example if the
proposition is true, e.g.

chx0) ∀ x : bool, x=x

then you just go ahead and prove it -/

theorem chx0 : ∀ x : bool, x=x :=
begin
  assume x,
  reflexivity
end

/- However, if the proposition is false, e.g.

chx1) ∀ x : bool, x ≠ x

then  you prove its negation -/

theorem chx1 : ¬ (∀ x : bool, x ≠ x) :=
begin
  assume h,
  have g : tt ≠ tt,
  apply h,
  apply g,
  reflexivity,
end

/-
For each of the following proposition either prove them or their negation.

ch01) ∀ x : bool, ! (! x) = x
ch02) ∀ x:bool,∃ y:bool, x ≠ y
ch03) ∃ x:bool,∀ y:bool, x ≠ y
ch04) ∀ x y : bool, x=y ∨ x ≠ y
ch05) ∃ x:bool, x=bnot x
ch06) ∀ x y z : bool, x=y ∨ x=z ∨ y=z
ch07) ∀ y:bool, ∃ x:bool, y = bnot x
ch08) ∀ x y : bool, ! x = ! y → x=y
ch09) ∃ b : bool, ∀ y:bool, b && y = y
ch10) ∃ b : bool, ∀ y:bool, b && y = b
-/
theorem ch01 : ∀ x : bool, ! (! x) = x :=
begin
    assume x,
    /-
        x : bool
        ⊢ ! (! x) = x
    -/
    cases x,
    /-
        (Case tt)
        ⊢ ! (! tt) = tt

        (Case ff)
        ⊢ ! (! ff) = ff
    -/
    refl,
    /-
        Gets rid of Case tt
    -/
    refl,
    /-
        No goals (Gets rid of Case ff)
    -/
end

theorem ch02 : ∀ x : bool, ∃ y : bool, x ≠ y :=
begin
    assume f,
    /-
        f : bool
        ⊢ ∃ y : bool, x ≠ y
    -/
    cases f,
    /-
        (Case ff)
        ⊢ ∃ y : bool, ff ≠ y

        (Case tt)
        ⊢ ∃ y : bool, tt ≠ y
    -/
    existsi tt,
     /-
        (Case ff)
        ⊢ ff ≠ tt

        (Case tt)
        ⊢ ∃ y : bool, ff ≠ y
    -/
    assume g,
    /-
        (Case ff)
        g : ff = tt
        ⊢ false

        (Case tt)
        ⊢ ∃ y : bool, tt ≠ y
    -/
    contradiction,
    /-
        Gets rid of Case ff
    -/
    existsi ff,
    /-
        (Case ff)
        ⊢ ∃ y : bool, tt ≠ ff
    -/
    assume h,
    /-
        (Case ff)
        h : tt = ff
        ⊢ false
    -/
    contradiction,
    /-
        No goals (Gets rid of Case tt)
end

theorem ch03: ¬(∃ x:bool,∀ y:bool, x ≠ y) :=
begin
    assume x,
    /-
        x : ∃ x:bool,∀ y:bool, x ≠ y
        ⊢ false
    -/
    cases x with a b,
    /-
        a : bool
        b : ∀ y:bool, x ≠ y
        ⊢ false
    -/
    apply b,
    /-
        a : bool
        b : ∀ y:bool, x ≠ y
        ⊢ x = ?m_1
    -/
    refl,
    /-
        No goals
    -/
end

theorem ch04: ∀ x y : bool, x=y ∨ x ≠ y :=
begin
    assume x y,
    /-
        x : bool
        y : bool
        ⊢ x=y ∨ x ≠ y
    -/
    cases x,
    /-
        (Case ff)
        y : bool
        ⊢ ff =y ∨ ff ≠ y

        (Case tt)
         y : bool
        ⊢ tt =y ∨ tt ≠ y
    -/
    cases y,
    /-
        (Case ff, ff)
        ⊢ ff = ff ∨ ff ≠ ff

        (Case ff, tt)
        ⊢ ff = tt ∨ ff ≠ tt

        (Case tt)
         y : bool
        ⊢ tt =y ∨ tt ≠ y
    -/
    left,
    /-
        (Case ff, ff)
        ⊢ ff = ff

        (Case ff, tt)
        ⊢ ff = tt ∨ ff ≠ tt

        (Case tt)
         y : bool
        ⊢ tt =y ∨ tt ≠ y
    -/
    refl,
    /-
        Gets rid of Case ff, ff
    -/
    right,
    /-
        (Case ff, tt)
        ⊢ ff ≠ tt

        (Case tt)
        y : bool
        ⊢ tt =y ∨ tt ≠ y
    -/
    assume a,
    /-
        (Case ff, tt)
        a : ff = tt
        ⊢ false

        (Case tt)
        y : bool
        ⊢ tt =y ∨ tt ≠ y
    -/
    contradiction,
    /-
        Gets rid of Case ff, tt
    -/
    cases y,
    /-
        (Case tt, ff)
        ⊢ tt = ff ∨ tt ≠ ff

        (Case tt, tt)
        ⊢ tt = tt ∨ tt ≠ tt
    -/
    right,
    /-
        (Case tt, ff)
        ⊢ tt ≠ ff

        (Case tt, tt)
        ⊢ tt = tt ∨ tt ≠ tt
    -/
    assume a,
    /-
        (Case tt, ff)
        a : tt = ff
        ⊢ false

        (Case tt, tt)
        ⊢ tt = tt ∨ tt ≠ tt
    -/
    contradiction,
    /-
        Gets rid of Case tt, ff
    -/
    left,
    /-
        (Case tt, tt)
        ⊢ tt = tt
    -/
    refl,
    /-
        No goals (Gets rid of Case tt, tt)
    -/
end

theorem ch05: ¬ (∃ x:bool, x=bnot x) :=
begin
    assume x,
    /-
        ∃ x:bool, x=bnot x
        ⊢ false
    -/
    cases x with a b,
    /-
        a : bool
        b : a = !a
        ⊢ false
    -/
    cases a,
    /-
        (Case ff)
        b : ff = !ff
        ⊢ false

        (Case tt)
        b : tt = !tt
        ⊢ false
    -/
    contradiction,
    /-
        Gets rid of Case ff
    -/
    contradiction,
    /-
        No goals (Gets rid of Case tt)
    -/
end
theorem ch06: ∀ x y z : bool, x=y ∨ x=z ∨ y=z :=
begin
    assume x y z,
    /-
        x y z : bool
        ⊢ x=y ∨ x=z ∨ y=z
    -/
    cases x,
    /-
        (Case ff)
        y z : bool
        ⊢ ff = y ∨ ff = z ∨ y = z

        (Case tt)
        y z : bool
        ⊢ tt = y ∨ tt = z ∨ y = z
    -/
    cases y,
    /-
        (Case ff, ff)
        z : bool
        ⊢ ff = ff ∨ ff = z ∨ ff = z

        (Case ff, tt)
        z : bool
        ⊢ ff = tt ∨ ff = z ∨ tt = z

        (Case tt)
        y z : bool
        ⊢ tt = y ∨ tt = z ∨ y = z
    -/
    left,
    /-
        (Case ff, ff)
        z : bool
        ⊢ ff = ff

        (Case ff, tt)
        z : bool
        ⊢ ff = tt ∨ ff = z ∨ tt = z

        (Case tt)
        y z : bool
        ⊢ tt = y ∨ tt = z ∨ y = z
    -/
    refl,
    /-
        Gets rid of Case ff, ff
    -/
    cases z,
    /-
        (Case ff, tt, ff)
        ⊢ ff = tt ∨ ff = ff ∨ tt = ff

        (Case ff, tt, tt)
        ⊢ ff = tt ∨ ff = tt ∨ tt = tt

        (Case tt)
        y z : bool
        ⊢ tt = y ∨ tt = z ∨ y = z
    -/
    right,
    /-
        (Case ff, tt, ff)
        ⊢ ff = ff ∨ tt = ff

        (Case ff, tt, tt)
        ⊢ ff = tt ∨ ff = tt ∨ tt = tt

        (Case tt)
        y z : bool
        ⊢ tt = y ∨ tt = z ∨ y = z
    -/
    left,
    /-
        (Case ff, tt, ff)
        ⊢ ff = ff

        (Case ff, tt, tt)
        ⊢ ff = tt ∨ ff = tt ∨ tt = tt

        (Case tt)
        y z : bool
        ⊢ tt = y ∨ tt = z ∨ y = z
    -/
    refl,
    /-
        Gets rid of Case ff, tt, ff
    -/
    right,
    /-
        (Case ff, tt, tt)
        ⊢ ff = tt ∨ tt = tt

        (Case tt)
        y z : bool
        ⊢ tt = y ∨ tt = z ∨ y = z
    -/
    right,
    /-
        (Case ff, tt, tt)
        ⊢ tt = tt

        (Case tt)
        y z : bool
        ⊢ tt = y ∨ tt = z ∨ y = z
    -/
    refl,
    /-
        Gets rid of Case ff, tt, tt
    -/
    cases y,
    /-
        (Case tt, ff)
        z : bool
        ⊢ tt = ff ∨ tt = z ∨ ff = z

        (Case tt, tt)
        z : bool
        ⊢ tt = tt ∨ tt = z ∨ tt = z

    -/
    cases z,
    /-
        (Case tt, ff, ff)
        ⊢ tt = ff ∨ tt = ff ∨ ff = ff

        (Case tt, ff, tt)
        ⊢ tt = ff ∨ tt = tt ∨ ff = tt

        (Case tt, tt)
        z : bool
        ⊢ tt = tt ∨ tt = z ∨ tt = z

    -/
    right,
    /-
        (Case tt, ff, ff)
        ⊢ tt = ff ∨ ff = ff

        (Case tt, ff, tt)
        ⊢ tt = ff ∨ tt = tt ∨ ff = tt

        (Case tt, tt)
        z : bool
        ⊢ tt = tt ∨ tt = z ∨ tt = z

    -/
    right,
    /-
        (Case tt, ff, ff)
        ⊢ ff = ff

        (Case tt, ff, tt)
        ⊢ tt = ff ∨ tt = tt ∨ ff = tt

        (Case tt, tt)
        z : bool
        ⊢ tt = tt ∨ tt = z ∨ tt = z

    -/
    refl,
    /-
        Gets rid of Case tt, ff, ff
    -/
    right,
    /-
        (Case tt, ff, tt)
        ⊢ tt = tt ∨ ff = tt

        (Case tt, tt)
        z : bool
        ⊢ tt = tt ∨ tt = z ∨ tt = z

    -/
    left,
    /-
        (Case tt, ff, tt)
        ⊢ tt = tt

        (Case tt, tt)
        z : bool
        ⊢ tt = tt ∨ tt = z ∨ tt = z
    -/
    refl,
    /-
        Gets rid of Case tt, ff, tt
    -/
    left,
    /-
        (Case tt, tt)
        z : bool
        ⊢ tt = tt
    -/
    refl,
    /-
        No goals (Case tt, tt)
    -/
end

theorem ch07 : ∀ y:bool, ∃ x:bool, y = ! x :=
begin
    assume y,
    /-
        y : bool
        ⊢ ∃ x:bool, y = ! x
    -/
    cases y,
    /-
        (Case ff)
        ⊢ ∃ x:bool, ff = ! x

        (Case tt)
        ⊢ ∃ x:bool, tt = ! x
    -/
    existsi tt,
    /-
        (Case ff)
        ff = !tt

        (Case tt)
        ⊢ ∃ x:bool, tt = ! x
    -/
    refl,
    /-
        Gets rid of Case ff
    -/
    existsi ff,
    /-
        (Case tt)
        ⊢ tt = !ff
    -/
    refl,
    /-
        No goals (gets rid of Case tt)
    -/
end

theorem ch09 : ∃ b : bool, ∀ y:bool, b && y = y :=
begin
    existsi tt,
    /-
        ∀ y:bool, tt && y = y
    -/
    assume a,
    /-
        a : bool,
        ⊢ tt && a = a
    -/
    refl,
    /-
        No goals
    -/
end

theorem ch10: ∃ b : bool, ∀ y:bool, b && y = b :=
begin
    existsi ff,
    /-
        ∀ y:bool, ff && y = ff
    -/
    assume y,
    /-
        y = bool
        ⊢ ff && y = ff
    -/
    refl,
    /-
        No goals
    -/
end
⊢
/-
PART II (40%)
=============

Define operations

implb :   bool → bool → bool
allb  :   (bool → bool) → bool

show that it corresponds to implication on Prop, i.e. prove

theorem implb_ok : ∀ x y : bool , is_tt (implb x y) ↔ is_tt x → is_tt y
theorem allb_ok : ∀ f : bool → bool, is_tt (allb f) ↔ ∀ x : bool, is_tt (f x)

Remark: you can define implb by pattern matching or using previous
boolean operations. In the latter case you need to write

def implb (x y : bool) := ...

allb can only be defined this way (since there is no pattern matching on
functions), i.e.

def allb (f : bool → bool) := ...

(*) the allb part is difficult, you only loose 20% if you don't do it.
-/

end ex03


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

import analysis.special_functions.pow

/-!
# IMO 2001 Q2

Let $a$, $b$, $c$ be positive reals. Prove that
$$
\frac{a}{\sqrt{a^2 + 8bc}} +
\frac{b}{\sqrt{b^2 + 8ca}} +
\frac{c}{\sqrt{c^2 + 8ab}} ≥ 1.
$$

## Solution

This proof is based on the bound
$$
\frac{a}{\sqrt{a^2 + 8bc}} ≥
\frac{a^{\frac43}}{a^{\frac43} + b^{\frac43} + c^{\frac43}}.
$$

-/

open real

variables {a b c : ℝ}

lemma denom_pos (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) :
  0 < a ^ 4 + b ^ 4 + c ^ 4 :=
add_pos (add_pos (pow_pos ha 4) (pow_pos hb 4)) (pow_pos hc 4)

lemma bound (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) :
  a ^ 4 / (a ^ 4 + b ^ 4 + c ^ 4) ≤
  a ^ 3 / sqrt ((a ^ 3) ^ 2 + 8 * b ^ 3 * c ^ 3) :=
begin
  have hsqrt := add_pos_of_nonneg_of_pos (sq_nonneg (a ^ 3))
    (mul_pos (mul_pos (bit0_pos zero_lt_four) (pow_pos hb 3)) (pow_pos hc 3)),
  have hdenom := denom_pos ha hb hc,
  rw div_le_div_iff hdenom (sqrt_pos.mpr hsqrt),
  conv_lhs { rw [pow_succ', mul_assoc] },
  apply mul_le_mul_of_nonneg_left _ (pow_pos ha 3).le,
  apply le_of_pow_le_pow _ hdenom.le zero_lt_two,
  rw [mul_pow, sq_sqrt hsqrt.le, ← sub_nonneg],
  calc  (a ^ 4 + b ^ 4 + c ^ 4) ^ 2 - a ^ 2 * ((a ^ 3) ^ 2 + 8 * b ^ 3 * c ^ 3)
      = 2 * (a ^ 2 * (b ^ 2 - c ^ 2)) ^ 2 + (b ^ 4 - c ^ 4) ^ 2 +
        (2 * (a ^ 2 * b * c - b ^ 2 * c ^ 2)) ^ 2 : by ring
  ... ≥ 0 : add_nonneg (add_nonneg (mul_nonneg zero_le_two (sq_nonneg _))
              (sq_nonneg _)) (sq_nonneg _)
end

theorem imo2001_q2' (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) :
  1 ≤ a ^ 3 / sqrt ((a ^ 3) ^ 2 + 8 * b ^ 3 * c ^ 3) +
      b ^ 3 / sqrt ((b ^ 3) ^ 2 + 8 * c ^ 3 * a ^ 3) +
      c ^ 3 / sqrt ((c ^ 3) ^ 2 + 8 * a ^ 3 * b ^ 3) :=
have h₁ : b ^ 4 + c ^ 4 + a ^ 4 = a ^ 4 + b ^ 4 + c ^ 4,
  by rw [add_comm, ← add_assoc],
have h₂ : c ^ 4 + a ^ 4 + b ^ 4 = a ^ 4 + b ^ 4 + c ^ 4,
  by rw [add_assoc, add_comm],
calc _ ≥ _ : add_le_add (add_le_add (bound ha hb hc) (bound hb hc ha)) (bound hc ha hb)
   ... = 1 : by rw [h₁, h₂, ← add_div, ← add_div, div_self $ ne_of_gt $ denom_pos ha hb hc]

theorem imo2001_q2 (ha : 0 < a) (hb : 0 < b) (hc : 0 < c) :
  1 ≤ a / sqrt (a ^ 2 + 8 * b * c) +
      b / sqrt (b ^ 2 + 8 * c * a) +
      c / sqrt (c ^ 2 + 8 * a * b) :=
have h3 : ∀ {x : ℝ}, 0 < x → (x ^ (3 : ℝ)⁻¹) ^ 3 = x :=
  λ x hx, show ↑3 = (3 : ℝ), by norm_num ▸ rpow_nat_inv_pow_nat hx.le three_ne_zero,
calc 1 ≤ _ : imo2001_q2' (rpow_pos_of_pos ha _) (rpow_pos_of_pos hb _) (rpow_pos_of_pos hc _)
   ... = _ : by rw [h3 ha, h3 hb, h3 hc]


def dm1 : Prop := ∀ (A B : Prop), ¬ (A ∧ B) ↔ ¬A ∨ ¬B

example : dm1 :=
begin
unfold dm1,                 -- unfold definition of dm1
assume A B,                 -- assume A, B are arbitrary props
apply iff.intro _ _,        -- by iff.intro it will suffice to prove → in both directions
/-
It's super-important to realize that the proof is *done*
except for the need to provide the two smaller proofs to
fill those "holes" marked by underscores above. You have
thus reduced the task of proving the overall theorem to
the task of proving these two "lemmas." So now we turn to
the lemmas.
-/

-- Lemma 1: The forward implication is valid.

assume h,     -- assume the hypothesis, now show conclusion

-- Prove the conclusion by case analysis on classical
-- truth/falsity of each of A, B
cases (classical.em A) with a na,   -- case analysis on truth of A
cases (classical.em B) with b nb,   -- "nested" case analysis on B

/-
Two cases for B, assuming A is true
-/

-- Case A true, B true
/-
At this point you really *have to see*
that there is a contradiction in what we
have assumed, i.e., in our context. We've
got a proof that neither A or B is true, but
we also have proofs that each of A and B is
true. To finish this part of the proof, just
not that a and b, we can construct a proof
of A ∧ B (by and.intro), yielding a direct
contradiction with h.
-/
let ab := and.intro a b,  -- ab proves A ∧ B
/-
The let construct is just another way to bind
a name to a value in the local context. Note
that ab gets added to your context.
-/

/-
Whenever you have a direct contradiction, in
the form of a proof of ¬X and a proof of X in
your assumptions/context, you can combine them
to derive a proof of false, by "applying" the
proof of ¬X (i.e., X → false) to the proof of
X, to derive a proof of false. A proof of false
is an impossibility, which means that the case
in question can't actually ever happen, so you
are done with having to think about it. That is
what false elimination does for you: you can
now ignore the current goal and be done.
-/
let f := (h ab),
apply false.elim f,
/-
Lean can automate the previous two steps in
cases where you have a contradiction in your
context. To see that work, comment out the
previous two lines and uncomment the next one.
-/
-- contradiction,

-- Now we turn to the second case: A true, B false
/-
Look at the goal: a proof of a disjunction.
Now look at your context. You have a proof
(assumed in this case) of the right hand
side. A simple application of or intro on
the right finishes the proof of this case
(lemma).
-/
apply or.inr nb,

/-
Now we address the two cases with
A false, and B either true or false.
Before you read the next sentence look
hard to make sure you see how to to
prove it! A simple or introduction
again does the trick.
-/
apply or.inl na,

/-
We have now proven the major lemma,
that the implication is true in the
forward direction. That fills in the
first hole in our proof. Now we have
to construct a proof to fill the second
hole.
-/

-- REVERSE (You should add the comments here!)

-- B true
assume h,
cases h with na nb,
assume ab,
let a := and.elim_left ab,
contradiction,
-- apply na (and.elim_left ab),

assume ab,
let b := and.elim_right ab,
contradiction,
end

/-
From the comments we've give and the
ones you added to explain the proof of
the implication in the reverse direction,
you should be able to write a precise and
complete English language proof.
-/

/-
We now state and partially prove the second
DeMorgan law. We prove it in one direction,
leaving the proof in the reverse direction as
an exercise. You should also comment the whole
formal proof as a step towards having a full
English language proof.
-/

example : ∀ (P Q : Prop), ¬(P ∨ Q) ↔ ¬P ∧ ¬Q :=
begin
assume P Q,
apply iff.intro _ _,

-- FORWARD

assume h,
apply or.elim (classical.em P),

-- Case P true
assume p,
let porq : P ∨ Q := or.inl p, -- new
contradiction,

-- Case P false
assume np,

apply or.elim (classical.em Q),

assume q,
let porq : P ∨ Q := or.inr q,
contradiction,

/-
You should be able to finish
this proof by yourself without
much difficulty at all.
-/

end