/-
Copyright (c) 2020 Jalex Stark. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jalex Stark, Scott Morrison, Eric Wieser, Oliver Nash
-/
import data.matrix.basic
import linear_algebra.matrix.trace

/-!
# Matrices with a single non-zero element.

This file provides `matrix.std_basis_matrix`. The matrix `matrix.std_basis_matrix i j c` has `c`
at position `(i, j)`, and zeroes elsewhere.
-/

variables {l m n : Type*}
variables {R α : Type*}

namespace matrix
open_locale matrix
open_locale big_operators

variables [decidable_eq l] [decidable_eq m] [decidable_eq n]

variables [semiring α]

/--
`std_basis_matrix i j a` is the matrix with `a` in the `i`-th row, `j`-th column,
and zeroes elsewhere.
-/
def std_basis_matrix (i : m) (j : n) (a : α) : matrix m n α :=
(λ i' j', if i = i' ∧ j = j' then a else 0)

@[simp] lemma smul_std_basis_matrix (i : m) (j : n) (a b : α) :
b • std_basis_matrix i j a = std_basis_matrix i j (b • a) :=
by { unfold std_basis_matrix, ext, simp }

@[simp] lemma std_basis_matrix_zero (i : m) (j : n) :
std_basis_matrix i j (0 : α) = 0 :=
by { unfold std_basis_matrix, ext, simp }

lemma std_basis_matrix_add (i : m) (j : n) (a b : α) :
std_basis_matrix i j (a + b) = std_basis_matrix i j a + std_basis_matrix i j b :=
begin
  unfold std_basis_matrix, ext,
  split_ifs with h; simp [h],
end

lemma matrix_eq_sum_std_basis (x : matrix n m α) [fintype n] [fintype m] :
  x = ∑ (i : n) (j : m), std_basis_matrix i j (x i j) :=
begin
  ext, symmetry,
  iterate 2 { rw finset.sum_apply },
  convert fintype.sum_eq_single i _,
  { simp [std_basis_matrix] },
  { intros j hj,
    simp [std_basis_matrix, hj], }
end

-- TODO: tie this up with the `basis` machinery of linear algebra
-- this is not completely trivial because we are indexing by two types, instead of one

-- TODO: add `std_basis_vec`
lemma std_basis_eq_basis_mul_basis (i : m) (j : n) :
std_basis_matrix i j 1 = vec_mul_vec (λ i', ite (i = i') 1 0) (λ j', ite (j = j') 1 0) :=
begin
  ext,
  norm_num [std_basis_matrix, vec_mul_vec],
  exact ite_and _ _ _ _,
end

-- todo: the old proof used fintypes, I don't know `finsupp` but this feels generalizable
@[elab_as_eliminator] protected lemma induction_on' [fintype m] [fintype n]
  {P : matrix m n α → Prop} (M : matrix m n α)
  (h_zero : P 0)
  (h_add : ∀ p q, P p → P q → P (p + q))
  (h_std_basis : ∀ (i : m) (j : n) (x : α), P (std_basis_matrix i j x)) :
  P M :=
begin
  rw [matrix_eq_sum_std_basis M, ← finset.sum_product'],
  apply finset.sum_induction _ _ h_add h_zero,
  { intros, apply h_std_basis, }
end

@[elab_as_eliminator] protected lemma induction_on [fintype m] [fintype n]
  [nonempty m] [nonempty n] {P : matrix m n α → Prop} (M : matrix m n α)
  (h_add : ∀ p q, P p → P q → P (p + q))
  (h_std_basis : ∀ i j x, P (std_basis_matrix i j x)) :
  P M :=
matrix.induction_on' M
begin
  inhabit m,
  inhabit n,
  simpa using h_std_basis default default 0
end
h_add h_std_basis

namespace std_basis_matrix

section

variables (i : m) (j : n) (c : α) (i' : m) (j' : n)

@[simp] lemma apply_same : std_basis_matrix i j c i j = c := if_pos (and.intro rfl rfl)

@[simp] lemma apply_of_ne (h : ¬((i = i') ∧ (j = j'))) :
  std_basis_matrix i j c i' j' = 0 :=
by { simp only [std_basis_matrix, and_imp, ite_eq_right_iff], tauto }

@[simp] lemma apply_of_row_ne {i i' : m} (hi : i ≠ i') (j j' : n) (a : α) :
  std_basis_matrix i j a i' j' = 0 :=
by simp [hi]

@[simp] lemma apply_of_col_ne (i i' : m) {j j' : n} (hj : j ≠ j') (a : α) :
  std_basis_matrix i j a i' j' = 0 :=
by simp [hj]

end

section

variables (i j : n) (c : α) (i' j' : n)

@[simp] lemma diag_zero (h : j ≠ i) : diag n α α (std_basis_matrix i j c) = 0 :=
funext $ λ k, if_neg $ λ ⟨e₁, e₂⟩, h (e₂.trans e₁.symm)

variable [fintype n]

lemma trace_zero (h : j ≠ i) : trace n α α (std_basis_matrix i j c) = 0 := by simp [h]

@[simp] lemma mul_left_apply_same (b : n) (M : matrix n n α) :
  (std_basis_matrix i j c ⬝ M) i b = c * M j b :=
by simp [mul_apply, std_basis_matrix]

@[simp] lemma mul_right_apply_same (a : n) (M : matrix n n α) :
  (M ⬝ std_basis_matrix i j c) a j = M a i * c :=
by simp [mul_apply, std_basis_matrix, mul_comm]

@[simp] lemma mul_left_apply_of_ne (a b : n) (h : a ≠ i) (M : matrix n n α) :
  (std_basis_matrix i j c ⬝ M) a b = 0 :=
by simp [mul_apply, h.symm]

@[simp] lemma mul_right_apply_of_ne (a b : n) (hbj : b ≠ j) (M : matrix n n α) :
  (M ⬝ std_basis_matrix i j c) a b = 0 :=
by simp [mul_apply, hbj.symm]

@[simp] lemma mul_same (k : n) (d : α) :
  std_basis_matrix i j c ⬝ std_basis_matrix j k d = std_basis_matrix i k (c * d) :=
begin
  ext a b,
  simp only [mul_apply, std_basis_matrix, boole_mul],
  by_cases h₁ : i = a; by_cases h₂ : k = b;
  simp [h₁, h₂],
end

@[simp] lemma mul_of_ne {k l : n} (h : j ≠ k) (d : α) :
  std_basis_matrix i j c ⬝ std_basis_matrix k l d = 0 :=
begin
  ext a b,
  simp only [mul_apply, boole_mul, std_basis_matrix],
  by_cases h₁ : i = a;
  simp [h₁, h, h.symm],
end

end

end std_basis_matrix

end matrix


/-
Copyright (c) 2018 Johan Commelin. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johan Commelin
-/
import algebra.big_operators.ring
import data.real.basic
import algebra.indicator_function
import algebra.algebra.basic
import algebra.order.nonneg

/-!
# Nonnegative real numbers

In this file we define `nnreal` (notation: `ℝ≥0`) to be the type of non-negative real numbers,
a.k.a. the interval `[0, ∞)`. We also define the following operations and structures on `ℝ≥0`:

* the order on `ℝ≥0` is the restriction of the order on `ℝ`; these relations define a conditionally
  complete linear order with a bottom element, `conditionally_complete_linear_order_bot`;

* `a + b` and `a * b` are the restrictions of addition and multiplication of real numbers to `ℝ≥0`;
  these operations together with `0 = ⟨0, _⟩` and `1 = ⟨1, _⟩` turn `ℝ≥0` into a conditionally
  complete linear ordered archimedean commutative semifield; we have no typeclass for this in
  `mathlib` yet, so we define the following instances instead:

  - `linear_ordered_semiring ℝ≥0`;
  - `ordered_comm_semiring ℝ≥0`;
  - `canonically_ordered_comm_semiring ℝ≥0`;
  - `linear_ordered_comm_group_with_zero ℝ≥0`;
  - `canonically_linear_ordered_add_monoid ℝ≥0`;
  - `archimedean ℝ≥0`;
  - `conditionally_complete_linear_order_bot ℝ≥0`.

  These instances are derived from corresponding instances about the type `{x : α // 0 ≤ x}` in an
  appropriate ordered field/ring/group/monoid `α`. See `algebra/order/nonneg`.

* `real.to_nnreal x` is defined as `⟨max x 0, _⟩`, i.e. `↑(real.to_nnreal x) = x` when `0 ≤ x` and
  `↑(real.to_nnreal x) = 0` otherwise.

We also define an instance `can_lift ℝ ℝ≥0`. This instance can be used by the `lift` tactic to
replace `x : ℝ` and `hx : 0 ≤ x` in the proof context with `x : ℝ≥0` while replacing all occurences
of `x` with `↑x`. This tactic also works for a function `f : α → ℝ` with a hypothesis
`hf : ∀ x, 0 ≤ f x`.

## Notations

This file defines `ℝ≥0` as a localized notation for `nnreal`.
-/

open_locale classical big_operators

/-- Nonnegative real numbers. -/
@[derive [
  ordered_semiring, comm_monoid_with_zero, -- to ensure these instance are computable
  semilattice_inf, densely_ordered, order_bot,
  canonically_linear_ordered_add_monoid, linear_ordered_comm_group_with_zero, archimedean,
  linear_ordered_semiring, ordered_comm_semiring, canonically_ordered_comm_semiring,
  has_sub, has_ordered_sub, has_div, inhabited]]
def nnreal := {r : ℝ // 0 ≤ r}
localized "notation ` ℝ≥0 ` := nnreal" in nnreal

namespace nnreal

instance : has_coe ℝ≥0 ℝ := ⟨subtype.val⟩

/- Simp lemma to put back `n.val` into the normal form given by the coercion. -/
@[simp] lemma val_eq_coe (n : ℝ≥0) : n.val = n := rfl

instance : can_lift ℝ ℝ≥0 :=
{ coe := coe,
  cond := λ r, 0 ≤ r,
  prf := λ x hx, ⟨⟨x, hx⟩, rfl⟩ }

protected lemma eq {n m : ℝ≥0} : (n : ℝ) = (m : ℝ) → n = m := subtype.eq

protected lemma eq_iff {n m : ℝ≥0} : (n : ℝ) = (m : ℝ) ↔ n = m :=
iff.intro nnreal.eq (congr_arg coe)

lemma ne_iff {x y : ℝ≥0} : (x : ℝ) ≠ (y : ℝ) ↔ x ≠ y :=
not_iff_not_of_iff $ nnreal.eq_iff

/-- Reinterpret a real number `r` as a non-negative real number. Returns `0` if `r < 0`. -/
noncomputable def _root_.real.to_nnreal (r : ℝ) : ℝ≥0 := ⟨max r 0, le_max_right _ _⟩

lemma _root_.real.coe_to_nnreal (r : ℝ) (hr : 0 ≤ r) : (real.to_nnreal r : ℝ) = r :=
max_eq_left hr

lemma _root_.real.le_coe_to_nnreal (r : ℝ) : r ≤ real.to_nnreal r :=
le_max_left r 0

lemma coe_nonneg (r : ℝ≥0) : (0 : ℝ) ≤ r := r.2
@[norm_cast]
theorem coe_mk (a : ℝ) (ha) : ((⟨a, ha⟩ : ℝ≥0) : ℝ) = a := rfl

example : has_zero ℝ≥0  := by apply_instance
example : has_one ℝ≥0   := by apply_instance
example : has_add ℝ≥0   := by apply_instance
noncomputable example : has_sub ℝ≥0   := by apply_instance
example : has_mul ℝ≥0   := by apply_instance
noncomputable example : has_inv ℝ≥0   := by apply_instance
noncomputable example : has_div ℝ≥0   := by apply_instance
noncomputable example : has_le ℝ≥0    := by apply_instance
example : has_bot ℝ≥0   := by apply_instance
example : inhabited ℝ≥0 := by apply_instance
example : nontrivial ℝ≥0 := by apply_instance

protected lemma coe_injective : function.injective (coe : ℝ≥0 → ℝ) := subtype.coe_injective
@[simp, norm_cast] protected lemma coe_eq {r₁ r₂ : ℝ≥0} : (r₁ : ℝ) = r₂ ↔ r₁ = r₂ :=
nnreal.coe_injective.eq_iff
protected lemma coe_zero : ((0 : ℝ≥0) : ℝ) = 0 := rfl
protected lemma coe_one  : ((1 : ℝ≥0) : ℝ) = 1 := rfl
protected lemma coe_add (r₁ r₂ : ℝ≥0) : ((r₁ + r₂ : ℝ≥0) : ℝ) = r₁ + r₂ := rfl
protected lemma coe_mul (r₁ r₂ : ℝ≥0) : ((r₁ * r₂ : ℝ≥0) : ℝ) = r₁ * r₂ := rfl
protected lemma coe_inv (r : ℝ≥0) : ((r⁻¹ : ℝ≥0) : ℝ) = r⁻¹ := rfl
protected lemma coe_div (r₁ r₂ : ℝ≥0) : ((r₁ / r₂ : ℝ≥0) : ℝ) = r₁ / r₂ := rfl
@[simp, norm_cast] protected

@[simp, norm_cast] protected lemma coe_sub {r₁ r₂ : ℝ≥0} (h : r₂ ≤ r₁) :
  ((r₁ - r₂ : ℝ≥0) : ℝ) = r₁ - r₂ :=
max_eq_left $ le_sub.2 $ by simp [show (r₂ : ℝ) ≤ r₁, from h]

-- TODO: setup semifield!
@[simp, norm_cast] protected lemma coe_eq_zero (r : ℝ≥0) : ↑r = (0 : ℝ) ↔ r = 0 :=
by rw [← nnreal.coe_zero, nnreal.coe_eq]

@[simp, norm_cast] protected lemma coe_eq_one (r : ℝ≥0) : ↑r = (1 : ℝ) ↔ r = 1 :=
by rw [← nnreal.coe_one, nnreal.coe_eq]

lemma coe_ne_zero {r : ℝ≥0} : (r : ℝ) ≠ 0 ↔ r ≠ 0 := by norm_cast

example : comm_semiring ℝ≥0 := by apply_instance

/-- Coercion `ℝ≥0 → ℝ` as a `ring_hom`. -/
def to_real_hom : ℝ≥0 →+* ℝ :=
⟨coe, nnreal.coe_one, nnreal.coe_mul, nnreal.coe_zero, nnreal.coe_add⟩

@[simp] lemma coe_to_real_hom : ⇑to_real_hom = coe := rfl

section actions

/-- A `mul_action` over `ℝ` restricts to a `mul_action` over `ℝ≥0`. -/
instance {M : Type*} [mul_action ℝ M] : mul_action ℝ≥0 M :=
mul_action.comp_hom M to_real_hom.to_monoid_hom

lemma smul_def {M : Type*} [mul_action ℝ M] (c : ℝ≥0) (x : M) :
  c • x = (c : ℝ) • x := rfl

instance {M N : Type*} [mul_action ℝ M] [mul_action ℝ N] [has_scalar M N]
  [is_scalar_tower ℝ M N] : is_scalar_tower ℝ≥0 M N :=
{ smul_assoc := λ r, (smul_assoc (r : ℝ) : _)}

instance smul_comm_class_left {M N : Type*} [mul_action ℝ N] [has_scalar M N]
  [smul_comm_class ℝ M N] : smul_comm_class ℝ≥0 M N :=
{ smul_comm := λ r, (smul_comm (r : ℝ) : _)}

instance smul_comm_class_right {M N : Type*} [mul_action ℝ N] [has_scalar M N]
  [smul_comm_class M ℝ N] : smul_comm_class M ℝ≥0 N :=
{ smul_comm := λ m r, (smul_comm m (r : ℝ) : _)}

/-- A `distrib_mul_action` over `ℝ` restricts to a `distrib_mul_action` over `ℝ≥0`. -/
instance {M : Type*} [add_monoid M] [distrib_mul_action ℝ M] : distrib_mul_action ℝ≥0 M :=
distrib_mul_action.comp_hom M to_real_hom.to_monoid_hom

/-- A `module` over `ℝ` restricts to a `module` over `ℝ≥0`. -/
instance {M : Type*} [add_comm_monoid M] [module ℝ M] : module ℝ≥0 M :=
module.comp_hom M to_real_hom

/-- An `algebra` over `ℝ` restricts to an `algebra` over `ℝ≥0`. -/
instance {A : Type*} [semiring A] [algebra ℝ A] : algebra ℝ≥0 A :=
{ smul := (•),
  commutes' := λ r x, by simp [algebra.commutes],
  smul_def' := λ r x, by simp [←algebra.smul_def (r : ℝ) x, smul_def],
  to_ring_hom := ((algebra_map ℝ A).comp (to_real_hom : ℝ≥0 →+* ℝ)) }

-- verify that the above produces instances we might care about
example : algebra ℝ≥0 ℝ := by apply_instance
example : distrib_mul_action (units ℝ≥0) ℝ := by apply_instance

end actions

example : monoid_with_zero ℝ≥0 := by apply_instance
example : comm_monoid_with_zero ℝ≥0 := by apply_instance
noncomputable example : comm_group_with_zero ℝ≥0 := by apply_instance

@[simp, norm_cast] lemma coe_indicator {α} (s : set α) (f : α → ℝ≥0) (a : α) :
  ((s.indicator f a : ℝ≥0) : ℝ) = s.indicator (λ x, f x) a :=
(to_real_hom : ℝ≥0 →+ ℝ).map_indicator _ _ _

@[simp, norm_cast] lemma coe_pow (r : ℝ≥0) (n : ℕ) : ((r^n : ℝ≥0) : ℝ) = r^n :=
to_real_hom.map_pow r n

@[simp, norm_cast] lemma coe_zpow (r : ℝ≥0) (n : ℤ) : ((r^n : ℝ≥0) : ℝ) = r^n :=
by cases n; simp

@[norm_cast] lemma coe_list_sum (l : list ℝ≥0) :
  ((l.sum : ℝ≥0) : ℝ) = (l.map coe).sum :=
to_real_hom.map_list_sum l

@[norm_cast] lemma coe_list_prod (l : list ℝ≥0) :
  ((l.prod : ℝ≥0) : ℝ) = (l.map coe).prod :=
to_real_hom.map_list_prod l

@[norm_cast] lemma coe_multiset_sum (s : multiset ℝ≥0) :
  ((s.sum : ℝ≥0) : ℝ) = (s.map coe).sum :=
to_real_hom.map_multiset_sum s

@[norm_cast] lemma coe_multiset_prod (s : multiset ℝ≥0) :
  ((s.prod : ℝ≥0) : ℝ) = (s.map coe).prod :=
to_real_hom.map_multiset_prod s

@[norm_cast] lemma coe_sum {α} {s : finset α} {f : α → ℝ≥0} :
  ↑(∑ a in s, f a) = ∑ a in s, (f a : ℝ) :=
to_real_hom.map_sum _ _

lemma _root_.real.to_nnreal_sum_of_nonneg {α} {s : finset α} {f : α → ℝ}
  (hf : ∀ a, a ∈ s → 0 ≤ f a) :
  real.to_nnreal (∑ a in s, f a) = ∑ a in s, real.to_nnreal (f a) :=
begin
  rw [←nnreal.coe_eq, nnreal.coe_sum, real.coe_to_nnreal _ (finset.sum_nonneg hf)],
  exact finset.sum_congr rfl (λ x hxs, by rw real.coe_to_nnreal _ (hf x hxs)),
end

@[norm_cast] lemma coe_prod {α} {s : finset α} {f : α → ℝ≥0} :
  ↑(∏ a in s, f a) = ∏ a in s, (f a : ℝ) :=
to_real_hom.map_prod _ _

lemma _root_.real.to_nnreal_prod_of_nonneg {α} {s : finset α} {f : α → ℝ}
  (hf : ∀ a, a ∈ s → 0 ≤ f a) :
  real.to_nnreal (∏ a in s, f a) = ∏ a in s, real.to_nnreal (f a) :=
begin
  rw [←nnreal.coe_eq, nnreal.coe_prod, real.coe_to_nnreal _ (finset.prod_nonneg hf)],
  exact finset.prod_congr rfl (λ x hxs, by rw real.coe_to_nnreal _ (hf x hxs)),
end

lemma nsmul_coe (r : ℝ≥0) (n : ℕ) : ↑(n • r) = n • (r:ℝ) :=
by norm_cast

@[simp, norm_cast] protected lemma coe_nat_cast (n : ℕ) : (↑(↑n : ℝ≥0) : ℝ) = n :=
to_real_hom.map_nat_cast n

noncomputable example : linear_order ℝ≥0 := by apply_instance

@[simp, norm_cast] protected lemma coe_le_coe {r₁ r₂ : ℝ≥0} : (r₁ : ℝ) ≤ r₂ ↔ r₁ ≤ r₂ := iff.rfl
@[simp, norm_cast] protected lemma coe_lt_coe {r₁ r₂ : ℝ≥0} : (r₁ : ℝ) < r₂ ↔ r₁ < r₂ := iff.rfl
@[simp, norm_cast] protected lemma coe_pos {r : ℝ≥0} : (0 : ℝ) < r ↔ 0 < r := iff.rfl

protected lemma coe_mono : monotone (coe : ℝ≥0 → ℝ) := λ _ _, nnreal.coe_le_coe.2

protected lemma _root_.real.to_nnreal_mono : monotone real.to_nnreal :=
λ x y h, max_le_max h (le_refl 0)

@[simp] lemma _root_.real.to_nnreal_coe {r : ℝ≥0} : real.to_nnreal r = r :=
nnreal.eq $ max_eq_left r.2

@[simp] lemma mk_coe_nat (n : ℕ) : @eq ℝ≥0 (⟨(n : ℝ), n.cast_nonneg⟩ : ℝ≥0) n :=
nnreal.eq (nnreal.coe_nat_cast n).symm

@[simp] lemma to_nnreal_coe_nat (n : ℕ) : real.to_nnreal n = n :=
nnreal.eq $ by simp [real.coe_to_nnreal]

/-- `real.to_nnreal` and `coe : ℝ≥0 → ℝ` form a Galois insertion. -/
noncomputable def gi : galois_insertion real.to_nnreal coe :=
galois_insertion.monotone_intro nnreal.coe_mono real.to_nnreal_mono
  real.le_coe_to_nnreal (λ _, real.to_nnreal_coe)

-- note that anything involving the (decidability of the) linear order, including `⊔`/`⊓` (min, max)
-- will be noncomputable, everything else should not be.
example : order_bot ℝ≥0 := by apply_instance
example : partial_order ℝ≥0 := by apply_instance
noncomputable example : canonically_linear_ordered_add_monoid ℝ≥0 := by apply_instance
noncomputable example : linear_ordered_add_comm_monoid ℝ≥0 := by apply_instance
noncomputable example : distrib_lattice ℝ≥0 := by apply_instance
noncomputable example : semilattice_inf ℝ≥0 := by apply_instance
noncomputable example : semilattice_sup ℝ≥0 := by apply_instance
noncomputable example : linear_ordered_semiring ℝ≥0 := by apply_instance
example : ordered_comm_semiring ℝ≥0 := by apply_instance
noncomputable example : linear_ordered_comm_monoid  ℝ≥0 := by apply_instance
noncomputable example : linear_ordered_comm_monoid_with_zero ℝ≥0 := by apply_instance
noncomputable example : linear_ordered_comm_group_with_zero ℝ≥0 := by apply_instance
example : canonically_ordered_comm_semiring ℝ≥0 := by apply_instance
example : densely_ordered ℝ≥0 := by apply_instance
example : no_top_order ℝ≥0 := by apply_instance

lemma bdd_above_coe {s : set ℝ≥0} : bdd_above ((coe : ℝ≥0 → ℝ) '' s) ↔ bdd_above s :=
iff.intro
  (assume ⟨b, hb⟩, ⟨real.to_nnreal b, assume ⟨y, hy⟩ hys, show y ≤ max b 0, from
    le_max_of_le_left $ hb $ set.mem_image_of_mem _ hys⟩)
  (assume ⟨b, hb⟩, ⟨b, assume y ⟨x, hx, eq⟩, eq ▸ hb hx⟩)

lemma bdd_below_coe (s : set ℝ≥0) : bdd_below ((coe : ℝ≥0 → ℝ) '' s) :=
⟨0, assume r ⟨q, _, eq⟩, eq ▸ q.2⟩

noncomputable instance : conditionally_complete_linear_order_bot ℝ≥0 :=
nonneg.conditionally_complete_linear_order_bot real.Sup_empty.le

lemma coe_Sup (s : set ℝ≥0) : (↑(Sup s) : ℝ) = Sup ((coe : ℝ≥0 → ℝ) '' s) :=
eq.symm $ @subset_Sup_of_within ℝ (set.Ici 0) _ ⟨(0 : ℝ≥0)⟩ s $
  real.Sup_nonneg _ $ λ y ⟨x, _, hy⟩, hy ▸ x.2

lemma coe_Inf (s : set ℝ≥0) : (↑(Inf s) : ℝ) = Inf ((coe : ℝ≥0 → ℝ) '' s) :=
eq.symm $ @subset_Inf_of_within ℝ (set.Ici 0) _ ⟨(0 : ℝ≥0)⟩ s $
  real.Inf_nonneg _ $ λ y ⟨x, _, hy⟩, hy ▸ x.2

example : archimedean ℝ≥0 := by apply_instance

-- TODO: why are these three instances necessary? why aren't they inferred?
instance covariant_add : covariant_class ℝ≥0 ℝ≥0 (+) (≤) :=
ordered_add_comm_monoid.to_covariant_class_left ℝ≥0

instance contravariant_add : contravariant_class ℝ≥0 ℝ≥0 (+) (<) :=
ordered_cancel_add_comm_monoid.to_contravariant_class_left ℝ≥0

instance covariant_mul : covariant_class ℝ≥0 ℝ≥0 (*) (≤) :=
ordered_comm_monoid.to_covariant_class_left ℝ≥0

lemma le_of_forall_pos_le_add {a b : ℝ≥0} (h : ∀ε, 0 < ε → a ≤ b + ε) : a ≤ b :=
le_of_forall_le_of_dense $ assume x hxb,
begin
  rcases le_iff_exists_add.1 (le_of_lt hxb) with ⟨ε, rfl⟩,
  exact h _ ((lt_add_iff_pos_right b).1 hxb)
end

-- TODO: generalize to some ordered add_monoids, based on #6145
lemma le_of_add_le_left {a b c : ℝ≥0} (h : a + b ≤ c) : a ≤ c :=
by { refine le_trans _ h, exact (le_add_iff_nonneg_right _).mpr zero_le' }

lemma le_of_add_le_right {a b c : ℝ≥0} (h : a + b ≤ c) : b ≤ c :=
by { refine le_trans _ h, exact (le_add_iff_nonneg_left _).mpr zero_le' }

lemma lt_iff_exists_rat_btwn (a b : ℝ≥0) :
  a < b ↔ (∃q:ℚ, 0 ≤ q ∧ a < real.to_nnreal q ∧ real.to_nnreal q < b) :=
iff.intro
  (assume (h : (↑a:ℝ) < (↑b:ℝ)),
    let ⟨q, haq, hqb⟩ := exists_rat_btwn h in
    have 0 ≤ (q : ℝ), from le_trans a.2 $ le_of_lt haq,
    ⟨q, rat.cast_nonneg.1 this,
      by simp [real.coe_to_nnreal _ this, nnreal.coe_lt_coe.symm, haq, hqb]⟩)
  (assume ⟨q, _, haq, hqb⟩, lt_trans haq hqb)

lemma bot_eq_zero : (⊥ : ℝ≥0) = 0 := rfl

lemma mul_sup (a b c : ℝ≥0) : a * (b ⊔ c) = (a * b) ⊔ (a * c) :=
begin
  cases le_total b c with h h,
  { simp [sup_eq_max, max_eq_right h, max_eq_right (mul_le_mul_of_nonneg_left h (zero_le a))] },
  { simp [sup_eq_max, max_eq_left h, max_eq_left (mul_le_mul_of_nonneg_left h (zero_le a))] },
end

lemma mul_finset_sup {α} {f : α → ℝ≥0} {s : finset α} (r : ℝ≥0) :
  r * s.sup f = s.sup (λa, r * f a) :=
begin
  refine s.induction_on _ _,
  { simp [bot_eq_zero] },
  { assume a s has ih, simp [has, ih, mul_sup], }
end

lemma finset_sup_div {α} {f : α → ℝ≥0} {s : finset α} (r : ℝ≥0) :
  s.sup f / r = s.sup (λ a, f a / r) :=
by simp only [div_eq_inv_mul, mul_finset_sup]

@[simp, norm_cast] lemma coe_max (x y : ℝ≥0) :
  ((max x y : ℝ≥0) : ℝ) = max (x : ℝ) (y : ℝ) :=
nnreal.coe_mono.map_max

@[simp, norm_cast] lemma coe_min (x y : ℝ≥0) :
  ((min x y : ℝ≥0) : ℝ) = min (x : ℝ) (y : ℝ) :=
nnreal.coe_mono.map_min

@[simp] lemma zero_le_coe {q : ℝ≥0} : 0 ≤ (q : ℝ) := q.2

end nnreal

namespace real

section to_nnreal

@[simp] lemma to_nnreal_zero : real.to_nnreal 0 = 0 :=
by simp [real.to_nnreal]; refl

@[simp] lemma to_nnreal_one : real.to_nnreal 1 = 1 :=
by simp [real.to_nnreal, max_eq_left (zero_le_one : (0 :ℝ) ≤ 1)]; refl

@[simp] lemma to_nnreal_pos {r : ℝ} : 0 < real.to_nnreal r ↔ 0 < r :=
by simp [real.to_nnreal, nnreal.coe_lt_coe.symm, lt_irrefl]

@[simp] lemma to_nnreal_eq_zero {r : ℝ} : real.to_nnreal r = 0 ↔ r ≤ 0 :=
by simpa [-to_nnreal_pos] using (not_iff_not.2 (@to_nnreal_pos r))

lemma to_nnreal_of_nonpos {r : ℝ} : r ≤ 0 → real.to_nnreal r = 0 :=
to_nnreal_eq_zero.2

@[simp] lemma coe_to_nnreal' (r : ℝ) : (real.to_nnreal r : ℝ) = max r 0 := rfl

@[simp] lemma to_nnreal_le_to_nnreal_iff {r p : ℝ} (hp : 0 ≤ p) :
  real.to_nnreal r ≤ real.to_nnreal p ↔ r ≤ p :=
by simp [nnreal.coe_le_coe.symm, real.to_nnreal, hp]

@[simp] lemma to_nnreal_lt_to_nnreal_iff' {r p : ℝ} :
  real.to_nnreal r < real.to_nnreal p ↔ r < p ∧ 0 < p :=
by simp [nnreal.coe_lt_coe.symm, real.to_nnreal, lt_irrefl]

lemma to_nnreal_lt_to_nnreal_iff {r p : ℝ} (h : 0 < p) :
  real.to_nnreal r < real.to_nnreal p ↔ r < p :=
to_nnreal_lt_to_nnreal_iff'.trans (and_iff_left h)

lemma to_nnreal_lt_to_nnreal_iff_of_nonneg {r p : ℝ} (hr : 0 ≤ r) :
  real.to_nnreal r < real.to_nnreal p ↔ r < p :=
to_nnreal_lt_to_nnreal_iff'.trans ⟨and.left, λ h, ⟨h, lt_of_le_of_lt hr h⟩⟩

@[simp] lemma to_nnreal_add {r p : ℝ} (hr : 0 ≤ r) (hp : 0 ≤ p) :
  real.to_nnreal (r + p) = real.to_nnreal r + real.to_nnreal p :=
nnreal.eq $ by simp [real.to_nnreal, hr, hp, add_nonneg]

lemma to_nnreal_add_to_nnreal {r p : ℝ} (hr : 0 ≤ r) (hp : 0 ≤ p) :
  real.to_nnreal r + real.to_nnreal p = real.to_nnreal (r + p) :=
(real.to_nnreal_add hr hp).symm

lemma to_nnreal_le_to_nnreal {r p : ℝ} (h : r ≤ p) :
  real.to_nnreal r ≤ real.to_nnreal p :=
real.to_nnreal_mono h

lemma to_nnreal_add_le {r p : ℝ} :
  real.to_nnreal (r + p) ≤ real.to_nnreal r + real.to_nnreal p :=
nnreal.coe_le_coe.1 $ max_le (add_le_add (le_max_left _ _) (le_max_left _ _)) nnreal.zero_le_coe

lemma to_nnreal_le_iff_le_coe {r : ℝ} {p : ℝ≥0} : real.to_nnreal r ≤ p ↔ r ≤ ↑p :=
nnreal.gi.gc r p

lemma le_to_nnreal_iff_coe_le {r : ℝ≥0} {p : ℝ} (hp : 0 ≤ p) : r ≤ real.to_nnreal p ↔ ↑r ≤ p :=
by rw [← nnreal.coe_le_coe, real.coe_to_nnreal p hp]

lemma le_to_nnreal_iff_coe_le' {r : ℝ≥0} {p : ℝ} (hr : 0 < r) : r ≤ real.to_nnreal p ↔ ↑r ≤ p :=
(le_or_lt 0 p).elim le_to_nnreal_iff_coe_le $ λ hp,
  by simp only [(hp.trans_le r.coe_nonneg).not_le, to_nnreal_eq_zero.2 hp.le, hr.not_le]

lemma to_nnreal_lt_iff_lt_coe {r : ℝ} {p : ℝ≥0} (ha : 0 ≤ r) : real.to_nnreal r < p ↔ r < ↑p :=
by rw [← nnreal.coe_lt_coe, real.coe_to_nnreal r ha]

lemma lt_to_nnreal_iff_coe_lt {r : ℝ≥0} {p : ℝ} : r < real.to_nnreal p ↔ ↑r < p :=
begin
  cases le_total 0 p,
  { rw [← nnreal.coe_lt_coe, real.coe_to_nnreal p h] },
  { rw [to_nnreal_eq_zero.2 h], split,
    { intro, have := not_lt_of_le (zero_le r), contradiction },
    { intro rp, have : ¬(p ≤ 0) := not_le_of_lt (lt_of_le_of_lt (nnreal.coe_nonneg _) rp),
      contradiction } }
end

@[simp] lemma to_nnreal_bit0 {r : ℝ} (hr : 0 ≤ r) :
  real.to_nnreal (bit0 r) = bit0 (real.to_nnreal r) :=
real.to_nnreal_add hr hr

@[simp] lemma to_nnreal_bit1 {r : ℝ} (hr : 0 ≤ r) :
  real.to_nnreal (bit1 r) = bit1 (real.to_nnreal r) :=
(real.to_nnreal_add (by simp [hr]) zero_le_one).trans (by simp [to_nnreal_one, bit1, hr])

end to_nnreal

end real

open real

namespace nnreal

section mul

lemma mul_eq_mul_left {a b c : ℝ≥0} (h : a ≠ 0) : (a * b = a * c ↔ b = c) :=
begin
  rw [← nnreal.eq_iff, ← nnreal.eq_iff, nnreal.coe_mul, nnreal.coe_mul], split,
  { exact mul_left_cancel₀ (mt (@nnreal.eq_iff a 0).1 h) },
  { assume h, rw [h] }
end

lemma _root_.real.to_nnreal_mul {p q : ℝ} (hp : 0 ≤ p) :
  real.to_nnreal (p * q) = real.to_nnreal p * real.to_nnreal q :=
begin
  cases le_total 0 q with hq hq,
  { apply nnreal.eq,
    simp [real.to_nnreal, hp, hq, max_eq_left, mul_nonneg] },
  { have hpq := mul_nonpos_of_nonneg_of_nonpos hp hq,
    rw [to_nnreal_eq_zero.2 hq, to_nnreal_eq_zero.2 hpq, mul_zero] }
end

end mul

section pow

lemma pow_antitone_exp {a : ℝ≥0} (m n : ℕ) (mn : m ≤ n) (a1 : a ≤ 1) :
  a ^ n ≤ a ^ m :=
pow_le_pow_of_le_one (zero_le a) a1 mn

lemma exists_pow_lt_of_lt_one {a b : ℝ≥0} (ha : 0 < a) (hb : b < 1) : ∃ n : ℕ, b ^ n < a :=
by simpa only [← coe_pow, nnreal.coe_lt_coe]
  using exists_pow_lt_of_lt_one (nnreal.coe_pos.2 ha) (nnreal.coe_lt_coe.2 hb)

lemma exists_mem_Ico_zpow
  {x : ℝ≥0} {y : ℝ≥0} (hx : x ≠ 0) (hy : 1 < y) :
  ∃ n : ℤ, x ∈ set.Ico (y ^ n) (y ^ (n + 1)) :=
begin
  obtain ⟨n, hn, h'n⟩ : ∃ n : ℤ, (y : ℝ) ^ n ≤ x ∧ (x : ℝ) < y ^ (n + 1) :=
    exists_mem_Ico_zpow (bot_lt_iff_ne_bot.mpr hx) hy,
  rw ← nnreal.coe_zpow at hn h'n,
  exact ⟨n, hn, h'n⟩,
end

lemma exists_mem_Ioc_zpow
  {x : ℝ≥0} {y : ℝ≥0} (hx : x ≠ 0) (hy : 1 < y) :
  ∃ n : ℤ, x ∈ set.Ioc (y ^ n) (y ^ (n + 1)) :=
begin
  obtain ⟨n, hn, h'n⟩ : ∃ n : ℤ, (y : ℝ) ^ n < x ∧ (x : ℝ) ≤ y ^ (n + 1) :=
    exists_mem_Ioc_zpow (bot_lt_iff_ne_bot.mpr hx) hy,
  rw ← nnreal.coe_zpow at hn h'n,
  exact ⟨n, hn, h'n⟩,
end

end pow

section sub
/-!
### Lemmas about subtraction

In this section we provide a few lemmas about subtraction that do not fit well into any other
typeclass. For lemmas about subtraction and addition see lemmas
about `has_ordered_sub` in the file `algebra.order.sub`. See also `mul_tsub` and `tsub_mul`. -/

lemma sub_def {r p : ℝ≥0} : r - p = real.to_nnreal (r - p) := rfl

lemma coe_sub_def {r p : ℝ≥0} : ↑(r - p) = max (r - p : ℝ) 0 := rfl

noncomputable example : has_ordered_sub ℝ≥0 := by apply_instance

lemma sub_div (a b c : ℝ≥0) : (a - b) / c = a / c - b / c :=
by simp only [div_eq_mul_inv, tsub_mul]

end sub

section inv

lemma sum_div {ι} (s : finset ι) (f : ι → ℝ≥0) (b : ℝ≥0) :
  (∑ i in s, f i) / b = ∑ i in s, (f i / b) :=
by simp only [div_eq_mul_inv, finset.sum_mul]

@[simp] lemma inv_pos {r : ℝ≥0} : 0 < r⁻¹ ↔ 0 < r :=
by simp [pos_iff_ne_zero]

lemma div_pos {r p : ℝ≥0} (hr : 0 < r) (hp : 0 < p) : 0 < r / p :=
by simpa only [div_eq_mul_inv] using mul_pos hr (inv_pos.2 hp)

protected lemma mul_inv {r p : ℝ≥0} : (r * p)⁻¹ = p⁻¹ * r⁻¹ := nnreal.eq $ mul_inv_rev₀ _ _

lemma div_self_le (r : ℝ≥0) : r / r ≤ 1 :=
if h : r = 0 then by simp [h] else by rw [div_self h]

@[simp] lemma inv_le {r p : ℝ≥0} (h : r ≠ 0) : r⁻¹ ≤ p ↔ 1 ≤ r * p :=
by rw [← mul_le_mul_left (pos_iff_ne_zero.2 h), mul_inv_cancel h]

lemma inv_le_of_le_mul {r p : ℝ≥0} (h : 1 ≤ r * p) : r⁻¹ ≤ p :=
by by_cases r = 0; simp [*, inv_le]

@[simp] lemma le_inv_iff_mul_le {r p : ℝ≥0} (h : p ≠ 0) : (r ≤ p⁻¹ ↔ r * p ≤ 1) :=
by rw [← mul_le_mul_left (pos_iff_ne_zero.2 h), mul_inv_cancel h, mul_comm]

@[simp] lemma lt_inv_iff_mul_lt {r p : ℝ≥0} (h : p ≠ 0) : (r < p⁻¹ ↔ r * p < 1) :=
by rw [← mul_lt_mul_left (pos_iff_ne_zero.2 h), mul_inv_cancel h, mul_comm]

lemma mul_le_iff_le_inv {a b r : ℝ≥0} (hr : r ≠ 0) : r * a ≤ b ↔ a ≤ r⁻¹ * b :=
have 0 < r, from lt_of_le_of_ne (zero_le r) hr.symm,
by rw [← @mul_le_mul_left _ _ a _ r this, ← mul_assoc, mul_inv_cancel hr, one_mul]

lemma le_div_iff_mul_le {a b r : ℝ≥0} (hr : r ≠ 0) : a ≤ b / r ↔ a * r ≤ b :=
by rw [div_eq_inv_mul, ← mul_le_iff_le_inv hr, mul_comm]

lemma div_le_iff {a b r : ℝ≥0} (hr : r ≠ 0) : a / r ≤ b ↔ a ≤ b * r :=
@div_le_iff ℝ _ a r b $ pos_iff_ne_zero.2 hr

lemma div_le_iff' {a b r : ℝ≥0} (hr : r ≠ 0) : a / r ≤ b ↔ a ≤ r * b :=
@div_le_iff' ℝ _ a r b $ pos_iff_ne_zero.2 hr

lemma div_le_of_le_mul {a b c : ℝ≥0} (h : a ≤ b * c) : a / c ≤ b :=
if h0 : c = 0 then by simp [h0] else (div_le_iff h0).2 h

lemma div_le_of_le_mul' {a b c : ℝ≥0} (h : a ≤ b * c) : a / b ≤ c :=
div_le_of_le_mul $ mul_comm b c ▸ h

lemma le_div_iff {a b r : ℝ≥0} (hr : r ≠ 0) : a ≤ b / r ↔ a * r ≤ b :=
@le_div_iff ℝ _ a b r $ pos_iff_ne_zero.2 hr

lemma le_div_iff' {a b r : ℝ≥0} (hr : r ≠ 0) : a ≤ b / r ↔ r * a ≤ b :=
@le_div_iff' ℝ _ a b r $ pos_iff_ne_zero.2 hr

lemma div_lt_iff {a b r : ℝ≥0} (hr : r ≠ 0) : a / r < b ↔ a < b * r :=
lt_iff_lt_of_le_iff_le (le_div_iff hr)

lemma div_lt_iff' {a b r : ℝ≥0} (hr : r ≠ 0) : a / r < b ↔ a < r * b :=
lt_iff_lt_of_le_iff_le (le_div_iff' hr)

lemma lt_div_iff {a b r : ℝ≥0} (hr : r ≠ 0) : a < b / r ↔ a * r < b :=
lt_iff_lt_of_le_iff_le (div_le_iff hr)

lemma lt_div_iff' {a b r : ℝ≥0} (hr : r ≠ 0) : a < b / r ↔ r * a < b :=
lt_iff_lt_of_le_iff_le (div_le_iff' hr)

lemma mul_lt_of_lt_div {a b r : ℝ≥0} (h : a < b / r) : a * r < b :=
begin
  refine (lt_div_iff $ λ hr, false.elim _).1 h,
  subst r,
  simpa using h
end

lemma div_le_div_left_of_le {a b c : ℝ≥0} (b0 : 0 < b) (c0 : 0 < c) (cb : c ≤ b) :
  a / b ≤ a / c :=
begin
  by_cases a0 : a = 0,
  { rw [a0, zero_div, zero_div] },
  { cases a with a ha,
    replace a0 : 0 < a := lt_of_le_of_ne ha (ne_of_lt (zero_lt_iff.mpr a0)),
    exact (div_le_div_left a0 b0 c0).mpr cb }
end

lemma div_le_div_left {a b c : ℝ≥0} (a0 : 0 < a) (b0 : 0 < b) (c0 : 0 < c) :
  a / b ≤ a / c ↔ c ≤ b :=
by rw [nnreal.div_le_iff b0.ne.symm, div_mul_eq_mul_div, nnreal.le_div_iff_mul_le c0.ne.symm,
  mul_le_mul_left a0]

lemma le_of_forall_lt_one_mul_le {x y : ℝ≥0} (h : ∀a<1, a * x ≤ y) : x ≤ y :=
le_of_forall_ge_of_dense $ assume a ha,
  have hx : x ≠ 0 := pos_iff_ne_zero.1 (lt_of_le_of_lt (zero_le _) ha),
  have hx' : x⁻¹ ≠ 0, by rwa [(≠), inv_eq_zero],
  have a * x⁻¹ < 1, by rwa [← lt_inv_iff_mul_lt hx', inv_inv₀],
  have (a * x⁻¹) * x ≤ y, from h _ this,
  by rwa [mul_assoc, inv_mul_cancel hx, mul_one] at this

lemma div_add_div_same (a b c : ℝ≥0) : a / c + b / c = (a + b) / c :=
eq.symm $ right_distrib a b (c⁻¹)

lemma half_pos {a : ℝ≥0} (h : 0 < a) : 0 < a / 2 := div_pos h zero_lt_two

lemma add_halves (a : ℝ≥0) : a / 2 + a / 2 = a := nnreal.eq (add_halves a)

lemma half_lt_self {a : ℝ≥0} (h : a ≠ 0) : a / 2 < a :=
by rw [← nnreal.coe_lt_coe, nnreal.coe_div]; exact
half_lt_self (bot_lt_iff_ne_bot.2 h)

lemma two_inv_lt_one : (2⁻¹:ℝ≥0) < 1 :=
by simpa using half_lt_self zero_ne_one.symm

lemma div_lt_one_of_lt {a b : ℝ≥0} (h : a < b) : a / b < 1 :=
begin
  rwa [div_lt_iff, one_mul],
  exact ne_of_gt (lt_of_le_of_lt (zero_le _) h)
end

@[field_simps] lemma div_add_div (a : ℝ≥0) {b : ℝ≥0} (c : ℝ≥0) {d : ℝ≥0}
  (hb : b ≠ 0) (hd : d ≠ 0) : a / b + c / d = (a * d + b * c) / (b * d) :=
begin
  rw ← nnreal.eq_iff,
  simp only [nnreal.coe_add, nnreal.coe_div, nnreal.coe_mul],
  exact div_add_div _ _ (coe_ne_zero.2 hb) (coe_ne_zero.2 hd)
end

@[field_simps] lemma add_div' (a b c : ℝ≥0) (hc : c ≠ 0) :
  b + a / c = (b * c + a) / c :=
by simpa using div_add_div b a one_ne_zero hc

@[field_simps] lemma div_add' (a b c : ℝ≥0) (hc : c ≠ 0) :
  a / c + b = (a + b * c) / c :=
by rwa [add_comm, add_div', add_comm]

lemma _root_.real.to_nnreal_inv {x : ℝ} :
  real.to_nnreal x⁻¹ = (real.to_nnreal x)⁻¹ :=
begin
  by_cases hx : 0 ≤ x,
  { nth_rewrite 0 ← real.coe_to_nnreal x hx,
    rw [←nnreal.coe_inv, real.to_nnreal_coe], },
  { have hx' := le_of_not_ge hx,
    rw [to_nnreal_eq_zero.mpr hx', inv_zero, to_nnreal_eq_zero.mpr (inv_nonpos.mpr hx')], },
end

lemma _root_.real.to_nnreal_div {x y : ℝ} (hx : 0 ≤ x) :
  real.to_nnreal (x / y) = real.to_nnreal x / real.to_nnreal y :=
by rw [div_eq_mul_inv, div_eq_mul_inv, ← real.to_nnreal_inv, ← real.to_nnreal_mul hx]

lemma _root_.real.to_nnreal_div' {x y : ℝ} (hy : 0 ≤ y) :
  real.to_nnreal (x / y) = real.to_nnreal x / real.to_nnreal y :=
by rw [div_eq_inv_mul, div_eq_inv_mul, real.to_nnreal_mul (inv_nonneg.2 hy), real.to_nnreal_inv]

lemma inv_lt_one_iff {x : ℝ≥0} (hx : x ≠ 0) : x⁻¹ < 1 ↔ 1 < x :=
by rwa [← one_div, div_lt_iff hx, one_mul]

lemma inv_lt_one {x : ℝ≥0} (hx : 1 < x) : x⁻¹ < 1 :=
(inv_lt_one_iff (zero_lt_one.trans hx).ne').2 hx

lemma zpow_pos {x : ℝ≥0} (hx : x ≠ 0) (n : ℤ) : 0 < x ^ n :=
begin
  cases n,
  { exact pow_pos hx.bot_lt _ },
  { simp [pow_pos hx.bot_lt _] }
end

end inv

@[simp] lemma abs_eq (x : ℝ≥0) : |(x : ℝ)| = x :=
abs_of_nonneg x.property

end nnreal

namespace real

/-- The absolute value on `ℝ` as a map to `ℝ≥0`. -/
@[pp_nodot] noncomputable def nnabs : monoid_with_zero_hom ℝ ℝ≥0 :=
{ to_fun := λ x, ⟨|x|, abs_nonneg x⟩,
  map_zero' := by { ext, simp },
  map_one' := by { ext, simp },
  map_mul' := λ x y, by { ext, simp [abs_mul] } }

@[norm_cast, simp] lemma coe_nnabs (x : ℝ) : (nnabs x : ℝ) = |x| :=
rfl

@[simp] lemma nnabs_of_nonneg {x : ℝ} (h : 0 ≤ x) : nnabs x = to_nnreal x :=
by { ext, simp [coe_to_nnreal x h, abs_of_nonneg h] }

lemma coe_to_nnreal_le (x : ℝ) : (to_nnreal x : ℝ) ≤ |x| :=
max_le (le_abs_self _) (abs_nonneg _)

lemma cast_nat_abs_eq_nnabs_cast (n : ℤ) :
  (n.nat_abs : ℝ≥0) = nnabs n :=
by { ext, rw [nnreal.coe_nat_cast, int.cast_nat_abs, real.coe_nnabs] }

end real


/-
Copyright (c) 2022 Dagur Tómas Ásgeirsson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Dagur Tómas Ásgeirsson, Leonardo de Moura

! This file was ported from Lean 3 source module data.set.bool_indicator
! leanprover-community/mathlib commit 448144f7ae193a8990cb7473c9e9a01990f64ac7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Set.Image

/-!
# Indicator function valued in bool

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

See also `set.indicator` and `set.piecewise`.
-/

open Bool

namespace Set

variable {α : Type _} (s : Set α)

#print Set.boolIndicator /-
/-- `bool_indicator` maps `x` to `tt` if `x ∈ s`, else to `ff` -/
noncomputable def boolIndicator (x : α) :=
  @ite _ (x ∈ s) (Classical.propDecidable _) true false
#align set.bool_indicator Set.boolIndicator
-/

#print Set.mem_iff_boolIndicator /-
theorem mem_iff_boolIndicator (x : α) : x ∈ s ↔ s.boolIndicator x = true :=
  by
  unfold bool_indicator
  split_ifs <;> tauto
#align set.mem_iff_bool_indicator Set.mem_iff_boolIndicator
-/

#print Set.not_mem_iff_boolIndicator /-
theorem not_mem_iff_boolIndicator (x : α) : x ∉ s ↔ s.boolIndicator x = false :=
  by
  unfold bool_indicator
  split_ifs <;> tauto
#align set.not_mem_iff_bool_indicator Set.not_mem_iff_boolIndicator
-/

/- warning: set.preimage_bool_indicator_tt clashes with set.preimage_bool_indicator_true -> Set.preimage_boolIndicator_true
Case conversion may be inaccurate. Consider using '#align set.preimage_bool_indicator_tt Set.preimage_boolIndicator_trueₓ'. -/
#print Set.preimage_boolIndicator_true /-
theorem preimage_boolIndicator_true : s.boolIndicator ⁻¹' {true} = s :=
  ext fun x => (s.mem_iff_boolIndicator x).symm
#align set.preimage_bool_indicator_tt Set.preimage_boolIndicator_true
-/

/- warning: set.preimage_bool_indicator_ff clashes with set.preimage_bool_indicator_false -> Set.preimage_boolIndicator_false
warning: set.preimage_bool_indicator_ff -> Set.preimage_boolIndicator_false is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (s : Set.{u1} α), Eq.{succ u1} (Set.{u1} α) (Set.preimage.{u1, 0} α Bool (Set.boolIndicator.{u1} α s) (Singleton.singleton.{0, 0} Bool (Set.{0} Bool) (Set.hasSingleton.{0} Bool) Bool.false)) (HasCompl.compl.{u1} (Set.{u1} α) (BooleanAlgebra.toHasCompl.{u1} (Set.{u1} α) (Set.booleanAlgebra.{u1} α)) s)
but is expected to have type
  forall {α : Type.{u1}} (s : Set.{u1} α), Eq.{succ u1} (Set.{u1} α) (Set.preimage.{u1, 0} α Bool (Set.boolIndicator.{u1} α s) (Singleton.singleton.{0, 0} Bool (Set.{0} Bool) (Set.instSingletonSet.{0} Bool) Bool.false)) (HasCompl.compl.{u1} (Set.{u1} α) (BooleanAlgebra.toHasCompl.{u1} (Set.{u1} α) (Set.instBooleanAlgebraSet.{u1} α)) s)
Case conversion may be inaccurate. Consider using '#align set.preimage_bool_indicator_ff Set.preimage_boolIndicator_falseₓ'. -/
theorem preimage_boolIndicator_false : s.boolIndicator ⁻¹' {false} = sᶜ :=
  ext fun x => (s.not_mem_iff_boolIndicator x).symm
#align set.preimage_bool_indicator_ff Set.preimage_boolIndicator_false

open Classical

/- warning: set.preimage_bool_indicator_eq_union -> Set.preimage_boolIndicator_eq_union is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (s : Set.{u1} α) (t : Set.{0} Bool), Eq.{succ u1} (Set.{u1} α) (Set.preimage.{u1, 0} α Bool (Set.boolIndicator.{u1} α s) t) (Union.union.{u1} (Set.{u1} α) (Set.hasUnion.{u1} α) (ite.{succ u1} (Set.{u1} α) (Membership.Mem.{0, 0} Bool (Set.{0} Bool) (Set.hasMem.{0} Bool) Bool.true t) (Classical.propDecidable (Membership.Mem.{0, 0} Bool (Set.{0} Bool) (Set.hasMem.{0} Bool) Bool.true t)) s (EmptyCollection.emptyCollection.{u1} (Set.{u1} α) (Set.hasEmptyc.{u1} α))) (ite.{succ u1} (Set.{u1} α) (Membership.Mem.{0, 0} Bool (Set.{0} Bool) (Set.hasMem.{0} Bool) Bool.false t) (Classical.propDecidable (Membership.Mem.{0, 0} Bool (Set.{0} Bool) (Set.hasMem.{0} Bool) Bool.false t)) (HasCompl.compl.{u1} (Set.{u1} α) (BooleanAlgebra.toHasCompl.{u1} (Set.{u1} α) (Set.booleanAlgebra.{u1} α)) s) (EmptyCollection.emptyCollection.{u1} (Set.{u1} α) (Set.hasEmptyc.{u1} α))))
but is expected to have type
  forall {α : Type.{u1}} (s : Set.{u1} α) (t : Set.{0} Bool), Eq.{succ u1} (Set.{u1} α) (Set.preimage.{u1, 0} α Bool (Set.boolIndicator.{u1} α s) t) (Union.union.{u1} (Set.{u1} α) (Set.instUnionSet.{u1} α) (ite.{succ u1} (Set.{u1} α) (Membership.mem.{0, 0} Bool (Set.{0} Bool) (Set.instMembershipSet.{0} Bool) Bool.true t) (Classical.propDecidable (Membership.mem.{0, 0} Bool (Set.{0} Bool) (Set.instMembershipSet.{0} Bool) Bool.true t)) s (EmptyCollection.emptyCollection.{u1} (Set.{u1} α) (Set.instEmptyCollectionSet.{u1} α))) (ite.{succ u1} (Set.{u1} α) (Membership.mem.{0, 0} Bool (Set.{0} Bool) (Set.instMembershipSet.{0} Bool) Bool.false t) (Classical.propDecidable (Membership.mem.{0, 0} Bool (Set.{0} Bool) (Set.instMembershipSet.{0} Bool) Bool.false t)) (HasCompl.compl.{u1} (Set.{u1} α) (BooleanAlgebra.toHasCompl.{u1} (Set.{u1} α) (Set.instBooleanAlgebraSet.{u1} α)) s) (EmptyCollection.emptyCollection.{u1} (Set.{u1} α) (Set.instEmptyCollectionSet.{u1} α))))
Case conversion may be inaccurate. Consider using '#align set.preimage_bool_indicator_eq_union Set.preimage_boolIndicator_eq_unionₓ'. -/
theorem preimage_boolIndicator_eq_union (t : Set Bool) :
    s.boolIndicator ⁻¹' t = (if true ∈ t then s else ∅) ∪ if false ∈ t then sᶜ else ∅ :=
  by
  ext x
  dsimp [bool_indicator]
  split_ifs <;> tauto
#align set.preimage_bool_indicator_eq_union Set.preimage_boolIndicator_eq_union

/- warning: set.preimage_bool_indicator -> Set.preimage_boolIndicator is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} (s : Set.{u1} α) (t : Set.{0} Bool), Or (Eq.{succ u1} (Set.{u1} α) (Set.preimage.{u1, 0} α Bool (Set.boolIndicator.{u1} α s) t) (Set.univ.{u1} α)) (Or (Eq.{succ u1} (Set.{u1} α) (Set.preimage.{u1, 0} α Bool (Set.boolIndicator.{u1} α s) t) s) (Or (Eq.{succ u1} (Set.{u1} α) (Set.preimage.{u1, 0} α Bool (Set.boolIndicator.{u1} α s) t) (HasCompl.compl.{u1} (Set.{u1} α) (BooleanAlgebra.toHasCompl.{u1} (Set.{u1} α) (Set.booleanAlgebra.{u1} α)) s)) (Eq.{succ u1} (Set.{u1} α) (Set.preimage.{u1, 0} α Bool (Set.boolIndicator.{u1} α s) t) (EmptyCollection.emptyCollection.{u1} (Set.{u1} α) (Set.hasEmptyc.{u1} α)))))
but is expected to have type
  forall {α : Type.{u1}} (s : Set.{u1} α) (t : Set.{0} Bool), Or (Eq.{succ u1} (Set.{u1} α) (Set.preimage.{u1, 0} α Bool (Set.boolIndicator.{u1} α s) t) (Set.univ.{u1} α)) (Or (Eq.{succ u1} (Set.{u1} α) (Set.preimage.{u1, 0} α Bool (Set.boolIndicator.{u1} α s) t) s) (Or (Eq.{succ u1} (Set.{u1} α) (Set.preimage.{u1, 0} α Bool (Set.boolIndicator.{u1} α s) t) (HasCompl.compl.{u1} (Set.{u1} α) (BooleanAlgebra.toHasCompl.{u1} (Set.{u1} α) (Set.instBooleanAlgebraSet.{u1} α)) s)) (Eq.{succ u1} (Set.{u1} α) (Set.preimage.{u1, 0} α Bool (Set.boolIndicator.{u1} α s) t) (EmptyCollection.emptyCollection.{u1} (Set.{u1} α) (Set.instEmptyCollectionSet.{u1} α)))))
Case conversion may be inaccurate. Consider using '#align set.preimage_bool_indicator Set.preimage_boolIndicatorₓ'. -/
theorem preimage_boolIndicator (t : Set Bool) :
    s.boolIndicator ⁻¹' t = univ ∨
      s.boolIndicator ⁻¹' t = s ∨ s.boolIndicator ⁻¹' t = sᶜ ∨ s.boolIndicator ⁻¹' t = ∅ :=
  by
  simp only [preimage_bool_indicator_eq_union]
  split_ifs <;> simp [s.union_compl_self]
#align set.preimage_bool_indicator Set.preimage_boolIndicator

end Set


/-
Copyright (c) 2021 Bryan Gin-ge Chen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Adam Topaz, Bryan Gin-ge Chen
-/

import order.boolean_algebra

/-!
# Symmetric difference

The symmetric difference or disjunctive union of sets `A` and `B` is the set of elements that are
in either `A` or `B` but not both. Translated into propositions, the symmetric difference is `xor`.

The symmetric difference operator (`symm_diff`) is defined in this file for any type with `⊔` and
`\` via the formula `(A \ B) ⊔ (B \ A)`, however the theorems proved about it only hold for
`generalized_boolean_algebra`s and `boolean_algebra`s.

The symmetric difference is the addition operator in the Boolean ring structure on Boolean algebras.

## Main declarations

* `symm_diff`: the symmetric difference operator, defined as `(A \ B) ⊔ (B \ A)`
* `equiv.symm_diff`: Symmetric difference by `a` as an `equiv`.

In generalized Boolean algebras, the symmetric difference operator is:

* `symm_diff_comm`: commutative, and
* `symm_diff_assoc`: associative.

## Notations

* `a ∆ b`: `symm_diff a b`

## References

The proof of associativity follows the note "Associativity of the Symmetric Difference of Sets: A
Proof from the Book" by John McCuan:

* <https://people.math.gatech.edu/~mccuan/courses/4317/symmetricdifference.pdf>

## Tags
boolean ring, generalized boolean algebra, boolean algebra, symmetric differences
-/

open function

/-- The symmetric difference operator on a type with `⊔` and `\` is `(A \ B) ⊔ (B \ A)`. -/
def symm_diff {α : Type*} [has_sup α] [has_sdiff α] (A B : α) : α := (A \ B) ⊔ (B \ A)

/- This notation might conflict with the Laplacian once we have it. Feel free to put it in locale
`order` or `symm_diff` if that happens. -/
infix ` ∆ `:100 := symm_diff

lemma symm_diff_def {α : Type*} [has_sup α] [has_sdiff α] (A B : α) :
  A ∆ B = (A \ B) ⊔ (B \ A) :=
rfl

lemma symm_diff_eq_xor (p q : Prop) : p ∆ q = xor p q := rfl

@[simp] lemma bool.symm_diff_eq_bxor : ∀ p q : bool, p ∆ q = bxor p q := dec_trivial

section generalized_boolean_algebra
variables {α : Type*} [generalized_boolean_algebra α] (a b c d : α)

lemma symm_diff_comm : a ∆ b = b ∆ a := by simp only [(∆), sup_comm]

instance symm_diff_is_comm : is_commutative α (∆) := ⟨symm_diff_comm⟩

@[simp] lemma symm_diff_self : a ∆ a = ⊥ := by rw [(∆), sup_idem, sdiff_self]
@[simp] lemma symm_diff_bot : a ∆ ⊥ = a := by rw [(∆), sdiff_bot, bot_sdiff, sup_bot_eq]
@[simp] lemma bot_symm_diff : ⊥ ∆ a = a := by rw [symm_diff_comm, symm_diff_bot]

lemma symm_diff_eq_sup_sdiff_inf : a ∆ b = (a ⊔ b) \ (a ⊓ b) :=
by simp [sup_sdiff, sdiff_inf, sup_comm, (∆)]

@[simp] lemma sup_sdiff_symm_diff : (a ⊔ b) \ (a ∆ b) = a ⊓ b :=
sdiff_eq_symm inf_le_sup (by rw symm_diff_eq_sup_sdiff_inf)

lemma disjoint_symm_diff_inf : disjoint (a ∆ b) (a ⊓ b) :=
begin
  rw [symm_diff_eq_sup_sdiff_inf],
  exact disjoint_sdiff_self_left,
end

lemma symm_diff_le_sup : a ∆ b ≤ a ⊔ b := by { rw symm_diff_eq_sup_sdiff_inf, exact sdiff_le }

lemma inf_symm_diff_distrib_left : a ⊓ (b ∆ c) = (a ⊓ b) ∆ (a ⊓ c) :=
by rw [symm_diff_eq_sup_sdiff_inf, inf_sdiff_distrib_left, inf_sup_left, inf_inf_distrib_left,
  symm_diff_eq_sup_sdiff_inf]

lemma inf_symm_diff_distrib_right : (a ∆ b) ⊓ c = (a ⊓ c) ∆ (b ⊓ c) :=
by simp_rw [@inf_comm _ _ _ c, inf_symm_diff_distrib_left]

lemma sdiff_symm_diff : c \ (a ∆ b) = (c ⊓ a ⊓ b) ⊔ ((c \ a) ⊓ (c \ b)) :=
by simp only [(∆), sdiff_sdiff_sup_sdiff']

lemma sdiff_symm_diff' : c \ (a ∆ b) = (c ⊓ a ⊓ b) ⊔ (c \ (a ⊔ b)) :=
by rw [sdiff_symm_diff, sdiff_sup, sup_comm]

lemma symm_diff_sdiff : (a ∆ b) \ c = (a \ (b ⊔ c)) ⊔ (b \ (a ⊔ c)) :=
by rw [symm_diff_def, sup_sdiff, sdiff_sdiff_left, sdiff_sdiff_left]

@[simp] lemma symm_diff_sdiff_left : (a ∆ b) \ a = b \ a :=
by rw [symm_diff_def, sup_sdiff, sdiff_idem, sdiff_sdiff_self, bot_sup_eq]

@[simp] lemma symm_diff_sdiff_right : (a ∆ b) \ b = a \ b :=
by rw [symm_diff_comm, symm_diff_sdiff_left]

@[simp] lemma sdiff_symm_diff_self : a \ (a ∆ b) = a ⊓ b := by simp [sdiff_symm_diff]

lemma symm_diff_eq_iff_sdiff_eq {a b c : α} (ha : a ≤ c) :
  a ∆ b = c ↔ c \ a = b :=
begin
  split; intro h,
  { have hba : disjoint (a ⊓ b) c := begin
      rw [←h, disjoint.comm],
      exact disjoint_symm_diff_inf _ _,
    end,
    have hca : _ := congr_arg (\ a) h,
    rw [symm_diff_sdiff_left] at hca,
    rw [←hca, sdiff_eq_self_iff_disjoint],
    exact hba.of_disjoint_inf_of_le ha },
  { have hd : disjoint a b := by { rw ←h, exact disjoint_sdiff_self_right },
    rw [symm_diff_def, hd.sdiff_eq_left, hd.sdiff_eq_right, ←h, sup_sdiff_cancel_right ha] }
end

lemma disjoint.symm_diff_eq_sup {a b : α} (h : disjoint a b) : a ∆ b = a ⊔ b :=
by rw [(∆), h.sdiff_eq_left, h.sdiff_eq_right]

lemma symm_diff_eq_sup : a ∆ b = a ⊔ b ↔ disjoint a b :=
begin
  split; intro h,
  { rw [symm_diff_eq_sup_sdiff_inf, sdiff_eq_self_iff_disjoint] at h,
    exact h.of_disjoint_inf_of_le le_sup_left, },
  { exact h.symm_diff_eq_sup, },
end

lemma symm_diff_symm_diff_left :
  a ∆ b ∆ c = (a \ (b ⊔ c)) ⊔ (b \ (a ⊔ c)) ⊔ (c \ (a ⊔ b)) ⊔ (a ⊓ b ⊓ c) :=
calc a ∆ b ∆ c = ((a ∆ b) \ c) ⊔ (c \ (a ∆ b))   : symm_diff_def _ _
           ... = (a \ (b ⊔ c)) ⊔ (b \ (a ⊔ c)) ⊔
                   ((c \ (a ⊔ b)) ⊔ (c ⊓ a ⊓ b)) :
                                by rw [sdiff_symm_diff', @sup_comm _ _ (c ⊓ a ⊓ b), symm_diff_sdiff]
           ... = (a \ (b ⊔ c)) ⊔ (b \ (a ⊔ c)) ⊔
                   (c \ (a ⊔ b)) ⊔ (a ⊓ b ⊓ c)   : by ac_refl

lemma symm_diff_symm_diff_right :
  a ∆ (b ∆ c) = (a \ (b ⊔ c)) ⊔ (b \ (a ⊔ c)) ⊔ (c \ (a ⊔ b)) ⊔ (a ⊓ b ⊓ c) :=
calc a ∆ (b ∆ c) = (a \ (b ∆ c)) ⊔ ((b ∆ c) \ a) : symm_diff_def _ _
             ... = (a \ (b ⊔ c)) ⊔ (a ⊓ b ⊓ c) ⊔
                     (b \ (c ⊔ a) ⊔ c \ (b ⊔ a))   :
                                by rw [sdiff_symm_diff', @sup_comm _ _ (a ⊓ b ⊓ c), symm_diff_sdiff]
             ... = (a \ (b ⊔ c)) ⊔ (b \ (a ⊔ c)) ⊔
                     (c \ (a ⊔ b)) ⊔ (a ⊓ b ⊓ c)   : by ac_refl

@[simp] lemma symm_diff_symm_diff_inf : a ∆ b ∆ (a ⊓ b) = a ⊔ b :=
by rw [symm_diff_eq_iff_sdiff_eq (symm_diff_le_sup _ _), sup_sdiff_symm_diff]

@[simp] lemma inf_symm_diff_symm_diff : (a ⊓ b) ∆ (a ∆ b) = a ⊔ b :=
by rw [symm_diff_comm, symm_diff_symm_diff_inf]

lemma symm_diff_assoc : a ∆ b ∆ c = a ∆ (b ∆ c) :=
by rw [symm_diff_symm_diff_left, symm_diff_symm_diff_right]

instance symm_diff_is_assoc : is_associative α (∆) := ⟨symm_diff_assoc⟩

lemma symm_diff_left_comm : a ∆ (b ∆ c) = b ∆ (a ∆ c) :=
by simp_rw [←symm_diff_assoc, symm_diff_comm]

lemma symm_diff_right_comm : a ∆ b ∆ c = a ∆ c ∆ b := by simp_rw [symm_diff_assoc, symm_diff_comm]

lemma symm_diff_symm_diff_symm_diff_comm : (a ∆ b) ∆ (c ∆ d) = (a ∆ c) ∆ (b ∆ d) :=
by simp_rw [symm_diff_assoc, symm_diff_left_comm]

@[simp] lemma symm_diff_symm_diff_cancel_left : a ∆ (a ∆ b) = b := by simp [←symm_diff_assoc]
@[simp] lemma symm_diff_symm_diff_cancel_right : b ∆ a ∆ a = b := by simp [symm_diff_assoc]

@[simp] lemma symm_diff_symm_diff_self' : a ∆ b ∆ a = b :=
by rw [symm_diff_comm,symm_diff_symm_diff_cancel_left]

lemma symm_diff_left_involutive (a : α) : involutive (∆ a) := symm_diff_symm_diff_cancel_right _
lemma symm_diff_right_involutive (a : α) : involutive ((∆) a) := symm_diff_symm_diff_cancel_left _
lemma symm_diff_left_injective (a : α) : injective (∆ a) := (symm_diff_left_involutive _).injective
lemma symm_diff_right_injective (a : α) : injective ((∆) a) :=
(symm_diff_right_involutive _).injective
lemma symm_diff_left_surjective (a : α) : surjective (∆ a) :=
(symm_diff_left_involutive _).surjective
lemma symm_diff_right_surjective (a : α) : surjective ((∆) a) :=
(symm_diff_right_involutive _).surjective

variables {a b c}

@[simp] lemma symm_diff_left_inj : a ∆ b = c ∆ b ↔ a = c := (symm_diff_left_injective _).eq_iff
@[simp] lemma symm_diff_right_inj : a ∆ b = a ∆ c ↔ b = c := (symm_diff_right_injective _).eq_iff

@[simp] lemma symm_diff_eq_left : a ∆ b = a ↔ b = ⊥ :=
calc a ∆ b = a ↔ a ∆ b = a ∆ ⊥ : by rw symm_diff_bot
           ... ↔     b = ⊥     : by rw symm_diff_right_inj

@[simp] lemma symm_diff_eq_right : a ∆ b = b ↔ a = ⊥ := by rw [symm_diff_comm, symm_diff_eq_left]

@[simp] lemma symm_diff_eq_bot : a ∆ b = ⊥ ↔ a = b :=
calc a ∆ b = ⊥ ↔ a ∆ b = a ∆ a : by rw symm_diff_self
           ... ↔     a = b     : by rw [symm_diff_right_inj, eq_comm]

protected lemma disjoint.symm_diff_left (ha : disjoint a c) (hb : disjoint b c) :
  disjoint (a ∆ b) c :=
by { rw symm_diff_eq_sup_sdiff_inf, exact (ha.sup_left hb).disjoint_sdiff_left }

protected lemma disjoint.symm_diff_right (ha : disjoint a b) (hb : disjoint a c) :
  disjoint a (b ∆ c) :=
(ha.symm.symm_diff_left hb.symm).symm

end generalized_boolean_algebra

section boolean_algebra
variables {α : Type*} [boolean_algebra α] (a b c : α)

lemma symm_diff_eq : a ∆ b = (a ⊓ bᶜ) ⊔ (b ⊓ aᶜ) := by simp only [(∆), sdiff_eq]

@[simp] lemma symm_diff_top : a ∆ ⊤ = aᶜ := by simp [symm_diff_eq]
@[simp] lemma top_symm_diff : ⊤ ∆ a = aᶜ := by rw [symm_diff_comm, symm_diff_top]

lemma compl_symm_diff : (a ∆ b)ᶜ = (a ⊓ b) ⊔ (aᶜ ⊓ bᶜ) :=
by simp only [←top_sdiff, sdiff_symm_diff, top_inf_eq]

lemma symm_diff_eq_top_iff : a ∆ b = ⊤ ↔ is_compl a b :=
by rw [symm_diff_eq_iff_sdiff_eq le_top, top_sdiff, compl_eq_iff_is_compl]

lemma is_compl.symm_diff_eq_top (h : is_compl a b) : a ∆ b = ⊤ := (symm_diff_eq_top_iff a b).2 h

@[simp] lemma compl_symm_diff_self : aᶜ ∆ a = ⊤ :=
by simp only [symm_diff_eq, compl_compl, inf_idem, compl_sup_eq_top]

@[simp] lemma symm_diff_compl_self : a ∆ aᶜ = ⊤ := by rw [symm_diff_comm, compl_symm_diff_self]

lemma symm_diff_symm_diff_right' :
  a ∆ (b ∆ c) = (a ⊓ b ⊓ c) ⊔ (a ⊓ bᶜ ⊓ cᶜ) ⊔ (aᶜ ⊓ b ⊓ cᶜ) ⊔ (aᶜ ⊓ bᶜ ⊓ c) :=
calc a ∆ (b ∆ c) = (a ⊓ ((b ⊓ c) ⊔ (bᶜ ⊓ cᶜ))) ⊔
                     (((b ⊓ cᶜ) ⊔ (c ⊓ bᶜ)) ⊓ aᶜ)  : by rw [symm_diff_eq, compl_symm_diff,
                                                            symm_diff_eq]
             ... = (a ⊓ b ⊓ c) ⊔ (a ⊓ bᶜ ⊓ cᶜ) ⊔
                     (b ⊓ cᶜ ⊓ aᶜ) ⊔ (c ⊓ bᶜ ⊓ aᶜ) : by rw [inf_sup_left, inf_sup_right,
                                                            ←sup_assoc, ←inf_assoc, ←inf_assoc]
             ... = (a ⊓ b ⊓ c) ⊔ (a ⊓ bᶜ ⊓ cᶜ) ⊔
                     (aᶜ ⊓ b ⊓ cᶜ) ⊔ (aᶜ ⊓ bᶜ ⊓ c) : begin
                                                       congr' 1,
                                                       { congr' 1,
                                                         rw [inf_comm, inf_assoc], },
                                                       { apply inf_left_right_swap }
                                                     end

end boolean_algebra


/-
Copyright (c) 2020 Aaron Anderson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Aaron Anderson
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.finset.gcd
import Mathlib.data.polynomial.default
import Mathlib.data.polynomial.erase_lead
import Mathlib.data.polynomial.cancel_leads
import Mathlib.PostPort

universes u_1

namespace Mathlib

/-!
# GCD structures on polynomials

Definitions and basic results about polynomials over GCD domains, particularly their contents
and primitive polynomials.

## Main Definitions
Let `p : polynomial R`.
 - `p.content` is the `gcd` of the coefficients of `p`.
 - `p.is_primitive` indicates that `p.content = 1`.

## Main Results
 - `polynomial.content_mul`:
  If `p q : polynomial R`, then `(p * q).content = p.content * q.content`.
 - `polynomial.gcd_monoid`:
  The polynomial ring of a GCD domain is itself a GCD domain.

-/

namespace polynomial

/-- `p.content` is the `gcd` of the coefficients of `p`. -/
def content {R : Type u_1} [integral_domain R] [gcd_monoid R] (p : polynomial R) : R :=
  finset.gcd (finsupp.support p) (coeff p)

theorem content_dvd_coeff {R : Type u_1} [integral_domain R] [gcd_monoid R] {p : polynomial R} (n : ℕ) : content p ∣ coeff p n := sorry

@[simp] theorem content_C {R : Type u_1} [integral_domain R] [gcd_monoid R] {r : R} : content (coe_fn C r) = coe_fn normalize r := sorry

@[simp] theorem content_zero {R : Type u_1} [integral_domain R] [gcd_monoid R] : content 0 = 0 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (content 0 = 0)) (Eq.symm C_0)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (content (coe_fn C 0) = 0)) content_C))
      (eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn normalize 0 = 0)) normalize_zero)) (Eq.refl 0)))

@[simp] theorem content_one {R : Type u_1} [integral_domain R] [gcd_monoid R] : content 1 = 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (content 1 = 1)) (Eq.symm C_1)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (content (coe_fn C 1) = 1)) content_C))
      (eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn normalize 1 = 1)) normalize_one)) (Eq.refl 1)))

theorem content_X_mul {R : Type u_1} [integral_domain R] [gcd_monoid R] {p : polynomial R} : content (X * p) = content p := sorry

@[simp] theorem content_X_pow {R : Type u_1} [integral_domain R] [gcd_monoid R] {k : ℕ} : content (X ^ k) = 1 := sorry

@[simp] theorem content_X {R : Type u_1} [integral_domain R] [gcd_monoid R] : content X = 1 :=
  eq.mpr (id (Eq._oldrec (Eq.refl (content X = 1)) (Eq.symm (mul_one X))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (content (X * 1) = 1)) content_X_mul))
      (eq.mpr (id (Eq._oldrec (Eq.refl (content 1 = 1)) content_one)) (Eq.refl 1)))

theorem content_C_mul {R : Type u_1} [integral_domain R] [gcd_monoid R] (r : R) (p : polynomial R) : content (coe_fn C r * p) = coe_fn normalize r * content p := sorry

@[simp] theorem content_monomial {R : Type u_1} [integral_domain R] [gcd_monoid R] {r : R} {k : ℕ} : content (coe_fn (monomial k) r) = coe_fn normalize r := sorry

theorem content_eq_zero_iff {R : Type u_1} [integral_domain R] [gcd_monoid R] {p : polynomial R} : content p = 0 ↔ p = 0 := sorry

@[simp] theorem normalize_content {R : Type u_1} [integral_domain R] [gcd_monoid R] {p : polynomial R} : coe_fn normalize (content p) = content p :=
  finset.normalize_gcd

theorem content_eq_gcd_range_of_lt {R : Type u_1} [integral_domain R] [gcd_monoid R] (p : polynomial R) (n : ℕ) (h : nat_degree p < n) : content p = finset.gcd (finset.range n) (coeff p) := sorry

theorem content_eq_gcd_range_succ {R : Type u_1} [integral_domain R] [gcd_monoid R] (p : polynomial R) : content p = finset.gcd (finset.range (Nat.succ (nat_degree p))) (coeff p) :=
  content_eq_gcd_range_of_lt p (Nat.succ (nat_degree p)) (nat.lt_succ_self (nat_degree p))

theorem content_eq_gcd_leading_coeff_content_erase_lead {R : Type u_1} [integral_domain R] [gcd_monoid R] (p : polynomial R) : content p = gcd (leading_coeff p) (content (erase_lead p)) := sorry

theorem dvd_content_iff_C_dvd {R : Type u_1} [integral_domain R] [gcd_monoid R] {p : polynomial R} {r : R} : r ∣ content p ↔ coe_fn C r ∣ p := sorry

theorem C_content_dvd {R : Type u_1} [integral_domain R] [gcd_monoid R] (p : polynomial R) : coe_fn C (content p) ∣ p :=
  iff.mp dvd_content_iff_C_dvd (dvd_refl (content p))

/-- A polynomial over a GCD domain is primitive when the `gcd` of its coefficients is 1 -/
def is_primitive {R : Type u_1} [integral_domain R] [gcd_monoid R] (p : polynomial R) :=
  content p = 1

@[simp] theorem is_primitive_one {R : Type u_1} [integral_domain R] [gcd_monoid R] : is_primitive 1 := sorry

theorem monic.is_primitive {R : Type u_1} [integral_domain R] [gcd_monoid R] {p : polynomial R} (hp : monic p) : is_primitive p := sorry

theorem is_primitive.ne_zero {R : Type u_1} [integral_domain R] [gcd_monoid R] {p : polynomial R} (hp : is_primitive p) : p ≠ 0 := sorry

theorem is_primitive.content_eq_one {R : Type u_1} [integral_domain R] [gcd_monoid R] {p : polynomial R} (hp : is_primitive p) : content p = 1 :=
  hp

theorem is_primitive_iff_is_unit_of_C_dvd {R : Type u_1} [integral_domain R] [gcd_monoid R] {p : polynomial R} : is_primitive p ↔ ∀ (r : R), coe_fn C r ∣ p → is_unit r := sorry

/-- The primitive part of a polynomial `p` is the primitive polynomial gained by dividing `p` by
  `p.content`. If `p = 0`, then `p.prim_part = 1`.  -/
def prim_part {R : Type u_1} [integral_domain R] [gcd_monoid R] (p : polynomial R) : polynomial R :=
  ite (p = 0) 1 (classical.some (C_content_dvd p))

theorem eq_C_content_mul_prim_part {R : Type u_1} [integral_domain R] [gcd_monoid R] (p : polynomial R) : p = coe_fn C (content p) * prim_part p := sorry

@[simp] theorem prim_part_zero {R : Type u_1} [integral_domain R] [gcd_monoid R] : prim_part 0 = 1 :=
  if_pos rfl

theorem is_primitive_prim_part {R : Type u_1} [integral_domain R] [gcd_monoid R] (p : polynomial R) : is_primitive (prim_part p) := sorry

theorem content_prim_part {R : Type u_1} [integral_domain R] [gcd_monoid R] (p : polynomial R) : content (prim_part p) = 1 :=
  is_primitive_prim_part p

theorem prim_part_ne_zero {R : Type u_1} [integral_domain R] [gcd_monoid R] (p : polynomial R) : prim_part p ≠ 0 :=
  is_primitive.ne_zero (is_primitive_prim_part p)

theorem nat_degree_prim_part {R : Type u_1} [integral_domain R] [gcd_monoid R] (p : polynomial R) : nat_degree (prim_part p) = nat_degree p := sorry

@[simp] theorem is_primitive.prim_part_eq {R : Type u_1} [integral_domain R] [gcd_monoid R] {p : polynomial R} (hp : is_primitive p) : prim_part p = p := sorry

theorem is_unit_prim_part_C {R : Type u_1} [integral_domain R] [gcd_monoid R] (r : R) : is_unit (prim_part (coe_fn C r)) := sorry

theorem prim_part_dvd {R : Type u_1} [integral_domain R] [gcd_monoid R] (p : polynomial R) : prim_part p ∣ p :=
  dvd.intro_left (coe_fn C (content p)) (Eq.symm (eq_C_content_mul_prim_part p))

theorem gcd_content_eq_of_dvd_sub {R : Type u_1} [integral_domain R] [gcd_monoid R] {a : R} {p : polynomial R} {q : polynomial R} (h : coe_fn C a ∣ p - q) : gcd a (content p) = gcd a (content q) := sorry

theorem content_mul_aux {R : Type u_1} [integral_domain R] [gcd_monoid R] {p : polynomial R} {q : polynomial R} : gcd (content (erase_lead (p * q))) (leading_coeff p) = gcd (content (erase_lead p * q)) (leading_coeff p) := sorry

@[simp] theorem content_mul {R : Type u_1} [integral_domain R] [gcd_monoid R] {p : polynomial R} {q : polynomial R} : content (p * q) = content p * content q := sorry

theorem is_primitive.mul {R : Type u_1} [integral_domain R] [gcd_monoid R] {p : polynomial R} {q : polynomial R} (hp : is_primitive p) (hq : is_primitive q) : is_primitive (p * q) := sorry

@[simp] theorem prim_part_mul {R : Type u_1} [integral_domain R] [gcd_monoid R] {p : polynomial R} {q : polynomial R} (h0 : p * q ≠ 0) : prim_part (p * q) = prim_part p * prim_part q := sorry

theorem is_primitive.is_primitive_of_dvd {R : Type u_1} [integral_domain R] [gcd_monoid R] {p : polynomial R} {q : polynomial R} (hp : is_primitive p) (hdvd : q ∣ p) : is_primitive q := sorry

theorem is_primitive.dvd_prim_part_iff_dvd {R : Type u_1} [integral_domain R] [gcd_monoid R] {p : polynomial R} {q : polynomial R} (hp : is_primitive p) (hq : q ≠ 0) : p ∣ prim_part q ↔ p ∣ q := sorry

theorem exists_primitive_lcm_of_is_primitive {R : Type u_1} [integral_domain R] [gcd_monoid R] {p : polynomial R} {q : polynomial R} (hp : is_primitive p) (hq : is_primitive q) : ∃ (r : polynomial R), is_primitive r ∧ ∀ (s : polynomial R), p ∣ s ∧ q ∣ s ↔ r ∣ s := sorry

theorem dvd_iff_content_dvd_content_and_prim_part_dvd_prim_part {R : Type u_1} [integral_domain R] [gcd_monoid R] {p : polynomial R} {q : polynomial R} (hq : q ≠ 0) : p ∣ q ↔ content p ∣ content q ∧ prim_part p ∣ prim_part q := sorry

protected instance gcd_monoid {R : Type u_1} [integral_domain R] [gcd_monoid R] : gcd_monoid (polynomial R) :=
  gcd_monoid_of_exists_lcm sorry


import algebra.geom_sum
import data.rat.defs
import data.real.basic

/-!
# IMO 2013 Q5

Let ℚ>₀ be the set of positive rational numbers. Let f: ℚ>₀ → ℝ be a function satisfying
the conditions

  (1) f(x) * f(y) ≥ f(x * y)
  (2) f(x + y)    ≥ f(x) + f(y)

for all x,y ∈ ℚ>₀. Given that f(a) = a for some rational a > 1, prove that f(x) = x for
all x ∈ ℚ>₀.

# Solution

We provide a direct translation of the solution found in
https://www.imo-official.org/problems/IMO2013SL.pdf
-/

open_locale big_operators

lemma le_of_all_pow_lt_succ {x y : ℝ} (hx : 1 < x) (hy : 1 < y)
  (h : ∀ n : ℕ, 0 < n → x^n - 1 < y^n) :
  x ≤ y :=
begin
  by_contra hxy,
  push_neg at hxy,
  have hxmy : 0 < x - y := sub_pos.mpr hxy,
  have hn : ∀ n : ℕ, 0 < n → (x - y) * (n : ℝ) ≤ x^n - y^n,
  { intros n hn,
    have hterm : ∀ i : ℕ, i ∈ finset.range n → 1 ≤ x^i * y^(n - 1 - i),
    { intros i hi,
      have hx' : 1 ≤ x ^ i := one_le_pow_of_one_le hx.le i,
      have hy' : 1 ≤ y ^ (n - 1 - i) := one_le_pow_of_one_le hy.le (n - 1 - i),
      calc 1 ≤ x^i             : hx'
         ... = x^i * 1         : (mul_one _).symm
         ... ≤ x^i * y^(n-1-i) : mul_le_mul_of_nonneg_left hy' (zero_le_one.trans hx') },

    calc (x - y) * (n : ℝ)
            = (n : ℝ) * (x - y) : mul_comm _ _
        ... = (∑ (i : ℕ) in finset.range n, (1 : ℝ)) * (x - y) :
                                  by simp only [mul_one, finset.sum_const, nsmul_eq_mul,
                                    finset.card_range]
        ... ≤ (∑ (i : ℕ) in finset.range n, x ^ i * y ^ (n - 1 - i)) * (x-y) :
                                  (mul_le_mul_right hxmy).mpr (finset.sum_le_sum hterm)
        ... = x^n - y^n         : geom_sum₂_mul x y n, },

  -- Choose n larger than 1 / (x - y).
  obtain ⟨N, hN⟩ := exists_nat_gt (1 / (x - y)),
  have hNp : 0 < N, { exact_mod_cast (one_div_pos.mpr hxmy).trans hN },

  have := calc 1 = (x - y) * (1 / (x - y)) : by field_simp [ne_of_gt hxmy]
             ... < (x - y) * N             : (mul_lt_mul_left hxmy).mpr hN
             ... ≤ x^N - y^N               : hn N hNp,
  linarith [h N hNp]
end

/--
 Like le_of_all_pow_lt_succ, but with a weaker assumption for y.
-/
lemma le_of_all_pow_lt_succ' {x y : ℝ} (hx : 1 < x) (hy : 0 < y)
  (h : ∀ n : ℕ, 0 < n → x^n - 1 < y^n) :
  x ≤ y :=
begin
  refine le_of_all_pow_lt_succ hx _ h,
  by_contra hy'',
  push_neg at hy'', -- hy'' : y ≤ 1.

  -- Then there exists y' such that 0 < y ≤ 1 < y' < x.
  let y' := (x + 1) / 2,
  have h_y'_lt_x : y' < x,
  { have hh : (x + 1)/2 < (x * 2) / 2, { linarith },
    calc y' < (x * 2) / 2 : hh
        ... = x           : by field_simp },
  have h1_lt_y' : 1 < y',
  { have hh' : 1 * 2 / 2 < (x + 1) / 2, { linarith },
    calc 1 = 1 * 2 / 2 : by field_simp
       ... < y'        : hh' },
  have h_y_lt_y' : y < y' := hy''.trans_lt h1_lt_y',
  have hh : ∀ n, 0 < n → x^n - 1 < y'^n,
  { intros n hn,
    calc x^n - 1 < y^n  : h n hn
            ...  ≤ y'^n : pow_le_pow_of_le_left hy.le h_y_lt_y'.le n },
  exact h_y'_lt_x.not_le (le_of_all_pow_lt_succ hx h1_lt_y' hh)
end

lemma f_pos_of_pos {f : ℚ → ℝ} {q : ℚ} (hq : 0 < q)
  (H1 : ∀ x y, 0 < x → 0 < y → f (x * y) ≤ f x * f y)
  (H4 : ∀ n : ℕ, 0 < n → (n : ℝ) ≤ f n) :
  0 < f q :=
begin
  have hfqn := calc f q.num = f (q * q.denom) : by rw ←rat.mul_denom_eq_num
                        ... ≤ f q * f q.denom : H1 q q.denom hq (nat.cast_pos.mpr q.pos),

  -- Now we just need to show that `f q.num` and `f q.denom` are positive.
  -- Then nlinarith will be able to close the goal.

  have num_pos : 0 < q.num := rat.num_pos_iff_pos.mpr hq,
  have hqna : (q.num.nat_abs : ℤ) = q.num := int.nat_abs_of_nonneg num_pos.le,
  have hqfn' := calc (q.num : ℝ)
            = ((q.num.nat_abs : ℤ) : ℝ) : congr_arg coe (eq.symm hqna)
        ... ≤ f q.num.nat_abs           : H4 q.num.nat_abs
                                            (int.nat_abs_pos_of_ne_zero (ne_of_gt num_pos))
        ... = f q.num                   : by rw [nat.cast_nat_abs, abs_of_nonneg num_pos.le],

  have f_num_pos := calc (0 : ℝ) < q.num   : int.cast_pos.mpr num_pos
                             ... ≤ f q.num : hqfn',
  have f_denom_pos := calc (0 : ℝ) < q.denom   : nat.cast_pos.mpr q.pos
                               ... ≤ f q.denom : H4 q.denom q.pos,
  nlinarith
end

lemma fx_gt_xm1 {f : ℚ → ℝ} {x : ℚ} (hx : 1 ≤ x)
  (H1 : ∀ x y, 0 < x → 0 < y → f (x * y) ≤ f x * f y)
  (H2 : ∀ x y, 0 < x → 0 < y → f x + f y ≤ f (x + y))
  (H4 : ∀ n : ℕ, 0 < n → (n : ℝ) ≤ f n) :
  (x - 1 : ℝ) < f x :=
begin
  have hx0 :=
    calc (x - 1 : ℝ)
          < ⌊x⌋₊   : by exact_mod_cast nat.sub_one_lt_floor x
      ... ≤ f ⌊x⌋₊ : H4 _ (nat.floor_pos.2 hx),

  obtain h_eq | h_lt := (nat.floor_le $ zero_le_one.trans hx).eq_or_lt,
  { rwa h_eq at hx0 },

  calc (x - 1 : ℝ) < f ⌊x⌋₊ : hx0
    ... < f (x - ⌊x⌋₊) + f ⌊x⌋₊ : lt_add_of_pos_left _ (f_pos_of_pos (sub_pos.mpr h_lt) H1 H4)
    ... ≤ f (x - ⌊x⌋₊ + ⌊x⌋₊)   : H2 _ _ (sub_pos.mpr h_lt) (nat.cast_pos.2 (nat.floor_pos.2 hx))
    ... = f x                   : by rw sub_add_cancel
end

lemma pow_f_le_f_pow {f : ℚ → ℝ} {n : ℕ} (hn : 0 < n) {x : ℚ} (hx : 1 < x)
  (H1 : ∀ x y, 0 < x → 0 < y → f (x * y) ≤ f x * f y)
  (H4 : ∀ n : ℕ, 0 < n → (n : ℝ) ≤ f n) :
  f (x^n) ≤ (f x)^n :=
begin
  induction n with pn hpn,
  { exfalso, exact nat.lt_asymm hn hn },
  cases pn,
  { simp only [pow_one] },
  have hpn' := hpn pn.succ_pos,
  rw [pow_succ' x (pn + 1), pow_succ' (f x) (pn + 1)],
  have hxp : 0 < x := zero_lt_one.trans hx,
  calc f ((x ^ (pn+1)) * x)
          ≤ f (x ^ (pn+1)) * f x : H1 (x ^ (pn+1)) x (pow_pos hxp (pn+1)) hxp
      ... ≤ (f x) ^ (pn+1) * f x : (mul_le_mul_right (f_pos_of_pos hxp H1 H4)).mpr hpn'
end

lemma fixed_point_of_pos_nat_pow {f : ℚ → ℝ} {n : ℕ} (hn : 0 < n)
  (H1 : ∀ x y, 0 < x → 0 < y → f (x * y) ≤ f x * f y)
  (H4 : ∀ n : ℕ, 0 < n → (n : ℝ) ≤ f n)
  (H5 : ∀ x : ℚ, 1 < x → (x : ℝ) ≤ f x)
  {a : ℚ} (ha1 : 1 < a) (hae : f a = a) :
  f (a^n) = a^n :=
begin
  have hh0 : (a : ℝ) ^ n ≤ f (a ^ n),
  { exact_mod_cast H5 (a ^ n) (one_lt_pow ha1 hn.ne') },

  have hh1 := calc f (a^n) ≤ (f a)^n   : pow_f_le_f_pow hn ha1 H1 H4
                       ... = (a : ℝ)^n : by rw ← hae,

  exact hh1.antisymm hh0
end

lemma fixed_point_of_gt_1 {f : ℚ → ℝ} {x : ℚ} (hx : 1 < x)
  (H1 : ∀ x y, 0 < x → 0 < y → f (x * y) ≤ f x * f y)
  (H2 : ∀ x y, 0 < x → 0 < y → f x + f y ≤ f (x + y))
  (H4 : ∀ n : ℕ, 0 < n → (n : ℝ) ≤ f n)
  (H5 : ∀ x : ℚ, 1 < x → (x : ℝ) ≤ f x)
  {a : ℚ} (ha1 : 1 < a) (hae : f a = a) :
  f x = x :=
begin
  -- Choose n such that 1 + x < a^n.
  obtain ⟨N, hN⟩ := pow_unbounded_of_one_lt (1 + x) ha1,
  have h_big_enough : (1:ℚ) < a^N - x := lt_sub_iff_add_lt.mpr hN,

  have h1 := calc (x : ℝ) + ((a^N - x) : ℚ)
                        ≤ f x + ((a^N - x) : ℚ) : add_le_add_right (H5 x hx) _
                    ... ≤ f x + f (a^N - x)     : add_le_add_left (H5 _ h_big_enough) _,

  have hxp : 0 < x := zero_lt_one.trans hx,

  have hNp : 0 < N,
  { by_contra H, push_neg at H, rw [le_zero_iff.mp H] at hN, linarith },

  have h2 := calc f x + f (a^N - x)
                        ≤ f (x + (a^N - x)) : H2 x (a^N - x) hxp (zero_lt_one.trans h_big_enough)
                    ... = f (a^N)           : by ring_nf
                    ... = a^N               : fixed_point_of_pos_nat_pow hNp H1 H4 H5 ha1 hae
                    ... = x + (a^N - x)     : by ring,

  have heq := h1.antisymm (by exact_mod_cast h2),
  linarith [H5 x hx, H5 _ h_big_enough]
end

theorem imo2013_q5
  (f : ℚ → ℝ)
  (H1 : ∀ x y, 0 < x → 0 < y → f (x * y) ≤ f x * f y)
  (H2 : ∀ x y, 0 < x → 0 < y → f x + f y ≤ f (x + y))
  (H_fixed_point : ∃ a, 1 < a ∧ f a = a) :
  ∀ x, 0 < x → f x = x :=
begin
  obtain ⟨a, ha1, hae⟩ := H_fixed_point,
  have H3 : ∀ x : ℚ, 0 < x → ∀ n : ℕ, 0 < n → ↑n * f x ≤ f (n * x),
  { intros x hx n hn,
    cases n,
    { exfalso, exact nat.lt_asymm hn hn },
    induction n with pn hpn,
    { simp only [one_mul, nat.cast_one] },
    calc    ↑(pn + 2) * f x
          = (↑pn + 1 + 1) * f x            : by norm_cast
      ... = ((pn : ℝ) + 1) * f x + 1 * f x : add_mul (↑pn + 1) 1 (f x)
      ... = (↑pn + 1) * f x + f x          : by rw one_mul
      ... ≤ f ((↑pn.succ) * x) + f x       : by exact_mod_cast add_le_add_right
                                                  (hpn pn.succ_pos) (f x)
      ... ≤ f ((↑pn + 1) * x + x)          : by exact_mod_cast H2 _ _
                                                  (mul_pos pn.cast_add_one_pos hx) hx
      ... = f ((↑pn + 1) * x + 1 * x)      : by rw one_mul
      ... = f ((↑pn + 1 + 1) * x)          : congr_arg f (add_mul (↑pn + 1) 1 x).symm
      ... = f (↑(pn + 2) * x)              : by norm_cast },
  have H4 : ∀ n : ℕ, 0 < n → (n : ℝ) ≤ f n,
  { intros n hn,
    have hf1 : 1 ≤ f 1,
    { have a_pos : (0 : ℝ) < a := rat.cast_pos.mpr (zero_lt_one.trans ha1),
      suffices : ↑a * 1 ≤ ↑a * f 1, from (mul_le_mul_left a_pos).mp this,
      calc ↑a * 1 = ↑a        : mul_one ↑a
              ... = f a       : hae.symm
              ... = f (a * 1) : by rw mul_one
              ... ≤ f a * f 1 : (H1 a 1) (zero_lt_one.trans ha1) zero_lt_one
              ... = ↑a * f 1  : by rw hae },

    calc (n : ℝ) = (n : ℝ) * 1   : (mul_one _).symm
             ... ≤ (n : ℝ) * f 1 : (mul_le_mul_left (nat.cast_pos.mpr hn)).mpr hf1
             ... ≤ f (n * 1)     : H3 1 zero_lt_one n hn
             ... = f n           : by rw mul_one },

  have H5 : ∀ x : ℚ, 1 < x → (x : ℝ) ≤ f x,
  { intros x hx,
    have hxnm1 : ∀ n : ℕ, 0 < n → (x : ℝ)^n - 1 < (f x)^n,
    { intros n hn,
      calc (x : ℝ)^n - 1 < f (x^n) : by exact_mod_cast fx_gt_xm1 (one_le_pow_of_one_le hx.le n)
                                          H1 H2 H4
                     ... ≤ (f x)^n : pow_f_le_f_pow hn hx H1 H4 },
    have hx' : 1 < (x : ℝ) := by exact_mod_cast hx,
    have hxp : 0 < x := zero_lt_one.trans hx,
    exact le_of_all_pow_lt_succ' hx' (f_pos_of_pos hxp H1 H4) hxnm1 },

  have h_f_commutes_with_pos_nat_mul : ∀ n : ℕ, 0 < n → ∀ x : ℚ, 0 < x → f (n * x) = n * f x,
  { intros n hn x hx,
    have h2 : f (n * x) ≤ n * f x,
    { cases n,
      { exfalso, exact nat.lt_asymm hn hn },
      cases n,
      { simp only [one_mul, nat.cast_one] },
      have hfneq : f (n.succ.succ) = n.succ.succ,
      { have := fixed_point_of_gt_1
                  (nat.one_lt_cast.mpr (nat.succ_lt_succ n.succ_pos)) H1 H2 H4 H5 ha1 hae,
        rwa (rat.cast_coe_nat n.succ.succ) at this },
      rw ← hfneq,
      exact H1 (n.succ.succ : ℚ) x (nat.cast_pos.mpr hn) hx },
    exact h2.antisymm (H3 x hx n hn) },

  -- For the final calculation, we expand x as (2*x.num) / (2*x.denom), because
  -- we need the top of the fraction to be strictly greater than 1 in order
  -- to apply fixed_point_of_gt_1.
  intros x hx,
  let x2denom := 2 * x.denom,
  let x2num := 2 * x.num,

  have hx2pos : 0 < 2 * x.denom := by linarith[x.pos],
  have hxcnez   : (x.denom : ℚ) ≠ (0 : ℚ) := ne_of_gt (nat.cast_pos.mpr x.pos),
  have hx2cnezr : (x2denom : ℝ) ≠ (0 : ℝ) := nat.cast_ne_zero.mpr (ne_of_gt hx2pos),

  have hrat_expand2 := calc x = x.num / x.denom : by exact_mod_cast rat.num_denom.symm
                          ... = x2num / x2denom : by { field_simp[-rat.num_div_denom], ring},

  have h_denom_times_fx :=
    calc (x2denom : ℝ) * f x = f (x2denom * x)                 : (h_f_commutes_with_pos_nat_mul
                                                                    x2denom hx2pos x hx).symm
                         ... = f (x2denom * (x2num / x2denom)) : by rw hrat_expand2
                         ... = f x2num                         : by { congr, field_simp, ring },

  have h_fx2num_fixed : f x2num = x2num,
  { have hx2num_gt_one : (1 : ℚ) < (2 * x.num : ℤ),
    { norm_cast, linarith [rat.num_pos_iff_pos.mpr hx] },
    have hh := fixed_point_of_gt_1 hx2num_gt_one H1 H2 H4 H5 ha1 hae,
    rwa (rat.cast_coe_int x2num) at hh },

  calc f x = f x * 1                                 : (mul_one (f x)).symm
       ... = f x * (x2denom / x2denom)               : by rw ←(div_self hx2cnezr)
       ... = (f x * x2denom) / x2denom               : mul_div_assoc' (f x) _ _
       ... = (x2denom * f x) / x2denom               : by rw mul_comm
       ... = f x2num / x2denom                       : by rw h_denom_times_fx
       ... = x2num / x2denom                         : by rw h_fx2num_fixed
       ... = (((x2num : ℚ) / (x2denom : ℚ) : ℚ) : ℝ) : by norm_cast
       ... = x                                       : by rw ←hrat_expand2
end


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_algebra_478
  (b h v : ℝ)
  (h₀ : 0 < b ∧ 0 < h ∧ 0 < v)
  (h₁ : v = 1 / 3 * (b * h))
  (h₂ : b = 30)
  (h₃ : h = 13 / 2) :
  v = 65 :=
begin
  rw [h₂, h₃] at h₁,
  rw h₁,
  norm_num,
end


/-
Copyright (c) 2019 Neil Strickland. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Neil Strickland
-/
import tactic.ring
import data.pnat.prime

/-!
# Euclidean algorithm for ℕ

This file sets up a version of the Euclidean algorithm that only works with natural numbers.
Given `0 < a, b`, it computes the unique `(w, x, y, z, d)` such that the following identities hold:
* `a = (w + x) d`
* `b = (y + z) d`
* `w * z = x * y + 1`
`d` is then the gcd of `a` and `b`, and `a' := a / d = w + x` and `b' := b / d = y + z` are coprime.

This story is closely related to the structure of SL₂(ℕ) (as a free monoid on two generators) and
the theory of continued fractions.

## Main declarations

* `xgcd_type`: Helper type in defining the gcd. Encapsulates `(wp, x, y, zp, ap, bp)`. where `wp`
  `zp`, `ap`, `bp` are the variables getting changed through the algorithm.
* `is_special`: States `wp * zp = x * y + 1`
* `is_reduced`: States `ap = a ∧ bp = b`

## Notes

See `nat.xgcd` for a very similar algorithm allowing values in `ℤ`.
-/

open nat

namespace pnat

/-- A term of xgcd_type is a system of six naturals.  They should
 be thought of as representing the matrix
 [[w, x], [y, z]] = [[wp + 1, x], [y, zp + 1]]
 together with the vector [a, b] = [ap + 1, bp + 1].
-/
@[derive inhabited]
structure xgcd_type :=
(wp x y zp ap bp : ℕ)

namespace xgcd_type

variable (u : xgcd_type)

instance : has_sizeof xgcd_type := ⟨λ u, u.bp⟩

/-- The has_repr instance converts terms to strings in a way that
 reflects the matrix/vector interpretation as above. -/
instance : has_repr xgcd_type :=
⟨λ u, "[[[" ++ (repr (u.wp + 1)) ++ ", " ++ (repr u.x) ++
      "], [" ++ (repr u.y) ++ ", " ++ (repr (u.zp + 1)) ++ "]], [" ++
      (repr (u.ap + 1)) ++ ", " ++ (repr (u.bp + 1)) ++ "]]"⟩

def mk' (w : ℕ+) (x : ℕ) (y : ℕ) (z : ℕ+) (a : ℕ+) (b : ℕ+) : xgcd_type :=
mk w.val.pred x y z.val.pred a.val.pred b.val.pred

def w : ℕ+ := succ_pnat u.wp
def z : ℕ+ := succ_pnat u.zp
def a : ℕ+ := succ_pnat u.ap
def b : ℕ+ := succ_pnat u.bp
def r : ℕ := (u.ap + 1) % (u.bp + 1)
def q : ℕ := (u.ap + 1) / (u.bp + 1)
def qp : ℕ := u.q - 1

/-- The map v gives the product of the matrix
 [[w, x], [y, z]] = [[wp + 1, x], [y, zp + 1]]
 and the vector [a, b] = [ap + 1, bp + 1].  The map
 vp gives [sp, tp] such that v = [sp + 1, tp + 1].
-/
def vp : ℕ × ℕ :=
⟨ u.wp + u.x + u.ap + u.wp * u.ap + u.x * u.bp,
  u.y + u.zp + u.bp + u.y * u.ap + u.zp * u.bp ⟩

def v : ℕ × ℕ := ⟨u.w * u.a + u.x * u.b, u.y * u.a + u.z * u.b⟩
def succ₂ (t : ℕ × ℕ) : ℕ × ℕ := ⟨t.1.succ, t.2.succ⟩

theorem v_eq_succ_vp : u.v = succ₂ u.vp :=
by { ext; dsimp [v, vp, w, z, a, b, succ₂];
     repeat { rw [nat.succ_eq_add_one] }; ring }

/-- is_special holds if the matrix has determinant one. -/
def is_special : Prop := u.wp + u.zp + u.wp * u.zp = u.x * u.y
def is_special' : Prop := u.w * u.z = succ_pnat (u.x * u.y)

theorem is_special_iff : u.is_special ↔ u.is_special' :=
begin
  dsimp [is_special, is_special'],
  split; intro h,
  { apply eq, dsimp [w, z, succ_pnat], rw [← h],
    repeat { rw [nat.succ_eq_add_one] }, ring },
  { apply nat.succ.inj,
    replace h := congr_arg (coe : ℕ+ → ℕ) h,
    rw [mul_coe, w, z] at h,
    repeat { rw [succ_pnat_coe, nat.succ_eq_add_one] at h },
    repeat { rw [nat.succ_eq_add_one] }, rw [← h], ring }
end

/-- is_reduced holds if the two entries in the vector are the
 same.  The reduction algorithm will produce a system with this
 property, whose product vector is the same as for the original
 system. -/
def is_reduced : Prop := u.ap = u.bp
def is_reduced' : Prop := u.a = u.b

theorem is_reduced_iff : u.is_reduced ↔ u.is_reduced' :=
⟨ congr_arg succ_pnat, succ_pnat_inj ⟩

def flip : xgcd_type :=
{ wp := u.zp, x := u.y, y := u.x, zp := u.wp, ap := u.bp, bp := u.ap }

@[simp] theorem flip_w : (flip u).w = u.z := rfl
@[simp] theorem flip_x : (flip u).x = u.y := rfl
@[simp] theorem flip_y : (flip u).y = u.x := rfl
@[simp] theorem flip_z : (flip u).z = u.w := rfl
@[simp] theorem flip_a : (flip u).a = u.b := rfl
@[simp] theorem flip_b : (flip u).b = u.a := rfl

theorem flip_is_reduced : (flip u).is_reduced ↔ u.is_reduced :=
by { dsimp [is_reduced, flip], split; intro h; exact h.symm }

theorem flip_is_special : (flip u).is_special ↔ u.is_special :=
by { dsimp [is_special, flip], rw[mul_comm u.x, mul_comm u.zp, add_comm u.zp] }

theorem flip_v : (flip u).v = (u.v).swap :=
by { dsimp [v], ext, { simp only, ring }, { simp only, ring } }

/-- Properties of division with remainder for a / b.  -/
theorem rq_eq : u.r + (u.bp + 1) * u.q = u.ap + 1 :=
nat.mod_add_div (u.ap + 1) (u.bp + 1)

theorem qp_eq (hr : u.r = 0) : u.q = u.qp + 1 :=
begin
  by_cases hq : u.q = 0,
  { let h := u.rq_eq, rw [hr, hq, mul_zero, add_zero] at h, cases h },
  { exact (nat.succ_pred_eq_of_pos (nat.pos_of_ne_zero hq)).symm }
end

/-- The following function provides the starting point for
 our algorithm.  We will apply an iterative reduction process
 to it, which will produce a system satisfying is_reduced.
 The gcd can be read off from this final system.
-/
def start (a b : ℕ+) : xgcd_type := ⟨0, 0, 0, 0, a - 1, b - 1⟩

theorem start_is_special (a b : ℕ+) : (start a b).is_special :=
by { dsimp [start, is_special], refl }

theorem start_v (a b : ℕ+) : (start a b).v = ⟨a, b⟩ :=
begin
  dsimp [start, v, xgcd_type.a, xgcd_type.b, w, z],
  rw [one_mul, one_mul, zero_mul, zero_mul, zero_add, add_zero],
  rw [← nat.pred_eq_sub_one, ← nat.pred_eq_sub_one],
  rw [nat.succ_pred_eq_of_pos a.pos, nat.succ_pred_eq_of_pos b.pos]
end

def finish : xgcd_type :=
xgcd_type.mk u.wp ((u.wp + 1) * u.qp + u.x) u.y (u.y * u.qp + u.zp) u.bp u.bp

theorem finish_is_reduced : u.finish.is_reduced :=
by { dsimp [is_reduced], refl }

theorem finish_is_special (hs : u.is_special) : u.finish.is_special :=
begin
  dsimp [is_special, finish] at hs ⊢,
  rw [add_mul _ _ u.y, add_comm _ (u.x * u.y), ← hs],
  ring
end

theorem finish_v (hr : u.r = 0) : u.finish.v = u.v :=
begin
  let ha : u.r + u.b * u.q = u.a := u.rq_eq,
  rw [hr, zero_add] at ha,
  ext,
  { change (u.wp + 1) * u.b + ((u.wp + 1) * u.qp + u.x) * u.b = u.w * u.a + u.x * u.b,
    have : u.wp + 1 = u.w := rfl, rw [this, ← ha, u.qp_eq hr], ring },
  { change u.y * u.b + (u.y * u.qp + u.z) * u.b = u.y * u.a + u.z * u.b,
    rw [← ha, u.qp_eq hr], ring }
end

/-- This is the main reduction step, which is used when u.r ≠ 0, or
 equivalently b does not divide a. -/
def step : xgcd_type :=
xgcd_type.mk (u.y * u.q + u.zp) u.y ((u.wp + 1) * u.q + u.x) u.wp u.bp (u.r - 1)

/-- We will apply the above step recursively.  The following result
 is used to ensure that the process terminates. -/
theorem step_wf (hr : u.r ≠ 0) : sizeof u.step < sizeof u :=
begin
  change u.r - 1 < u.bp,
  have h₀ : (u.r - 1) + 1 = u.r := nat.succ_pred_eq_of_pos (nat.pos_of_ne_zero hr),
  have h₁ : u.r < u.bp + 1 := nat.mod_lt (u.ap + 1) u.bp.succ_pos,
  rw[← h₀] at h₁,
  exact lt_of_succ_lt_succ h₁,
end

theorem step_is_special (hs : u.is_special) : u.step.is_special :=
begin
  dsimp [is_special, step] at hs ⊢,
  rw [mul_add, mul_comm u.y u.x, ← hs],
  ring
end

/-- The reduction step does not change the product vector. -/
theorem step_v (hr : u.r ≠ 0) : u.step.v = (u.v).swap :=
begin
  let ha : u.r + u.b * u.q = u.a := u.rq_eq,
  let hr : (u.r - 1) + 1 = u.r :=
    (add_comm _ 1).trans (add_tsub_cancel_of_le (nat.pos_of_ne_zero hr)),
  ext,
  { change ((u.y * u.q + u.z) * u.b + u.y * (u.r - 1 + 1) : ℕ) = u.y * u.a + u.z * u.b,
    rw [← ha, hr], ring },
  { change ((u.w * u.q + u.x) * u.b + u.w * (u.r - 1 + 1) : ℕ) = u.w * u.a + u.x * u.b,
    rw [← ha, hr], ring }
end

/-- We can now define the full reduction function, which applies
 step as long as possible, and then applies finish. Note that the
 "have" statement puts a fact in the local context, and the
 equation compiler uses this fact to help construct the full
 definition in terms of well-founded recursion.  The same fact
 needs to be introduced in all the inductive proofs of properties
 given below. -/
def reduce : xgcd_type → xgcd_type
| u := dite (u.r = 0)
    (λ h, u.finish)
    (λ h, have sizeof u.step < sizeof u, from u.step_wf h,
     flip (reduce u.step))

theorem reduce_a {u : xgcd_type} (h : u.r = 0) :
u.reduce = u.finish := by { rw [reduce], simp only, rw [if_pos h] }

theorem reduce_b {u : xgcd_type} (h : u.r ≠ 0) :
u.reduce = u.step.reduce.flip := by { rw [reduce], simp only, rw [if_neg h, step] }

theorem reduce_reduced : ∀ (u : xgcd_type), u.reduce.is_reduced
| u := dite (u.r = 0) (λ h, by { rw [reduce_a h], exact u.finish_is_reduced })
    (λ h,  have sizeof u.step < sizeof u, from u.step_wf h,
     by { rw [reduce_b h, flip_is_reduced], apply reduce_reduced })

theorem reduce_reduced' (u : xgcd_type) : u.reduce.is_reduced' :=
(is_reduced_iff _).mp u.reduce_reduced

theorem reduce_special : ∀ (u : xgcd_type), u.is_special → u.reduce.is_special
| u := dite (u.r = 0)
    (λ h hs, by { rw [reduce_a h], exact u.finish_is_special hs })
    (λ h hs, have sizeof u.step < sizeof u, from u.step_wf h,
     by { rw [reduce_b h],
          exact (flip_is_special _).mpr (reduce_special _ (u.step_is_special hs)) })

theorem reduce_special' (u : xgcd_type) (hs : u.is_special) : u.reduce.is_special' :=
(is_special_iff _).mp (u.reduce_special hs)

theorem reduce_v : ∀ (u : xgcd_type), u.reduce.v = u.v
| u := dite (u.r = 0)
 (λ h, by {rw[reduce_a h, finish_v u h]})
 (λ h, have sizeof u.step < sizeof u, from u.step_wf h,
       by { rw[reduce_b h, flip_v, reduce_v (step u), step_v u h, prod.swap_swap] })

end xgcd_type

section gcd

variables (a b : ℕ+)

def xgcd : xgcd_type := (xgcd_type.start a b).reduce

def gcd_d : ℕ+ := (xgcd a b).a
def gcd_w : ℕ+ := (xgcd a b).w
def gcd_x : ℕ  := (xgcd a b).x
def gcd_y : ℕ  := (xgcd a b).y
def gcd_z : ℕ+ := (xgcd a b).z

def gcd_a' : ℕ+ := succ_pnat ((xgcd a b).wp + (xgcd a b).x)
def gcd_b' : ℕ+ := succ_pnat ((xgcd a b).y + (xgcd a b).zp)

theorem gcd_a'_coe : ((gcd_a' a b) : ℕ) = (gcd_w a b) + (gcd_x a b) :=
by { dsimp [gcd_a', gcd_x, gcd_w, xgcd_type.w],
     rw [nat.succ_eq_add_one, nat.succ_eq_add_one, add_right_comm] }

theorem gcd_b'_coe : ((gcd_b' a b) : ℕ) = (gcd_y a b) + (gcd_z a b) :=
by { dsimp [gcd_b', gcd_y, gcd_z, xgcd_type.z],
     rw [nat.succ_eq_add_one, nat.succ_eq_add_one, add_assoc] }

theorem gcd_props :
 let d := gcd_d a b,
  w := gcd_w a b, x := gcd_x a b, y := gcd_y a b, z := gcd_z a b,
  a' := gcd_a' a b, b' := gcd_b' a b in
 (w * z = succ_pnat (x * y) ∧
  (a = a' * d) ∧ (b = b' * d) ∧
  z * a' = succ_pnat (x * b') ∧ w * b' = succ_pnat (y * a') ∧
  (z * a : ℕ) = x * b + d ∧ (w * b : ℕ) = y * a + d
 ) :=
begin
  intros,
  let u := (xgcd_type.start a b),
  let ur := u.reduce,
  have ha : d = ur.a := rfl,
  have hb : d = ur.b := u.reduce_reduced',
  have ha' : (a' : ℕ) = w + x := gcd_a'_coe a b,
  have hb' : (b' : ℕ) = y + z := gcd_b'_coe a b,
  have hdet : w * z = succ_pnat (x * y) := u.reduce_special' rfl,
  split, exact hdet,
  have hdet' : ((w * z) : ℕ) = x * y + 1 :=
    by { rw [← mul_coe, hdet, succ_pnat_coe] },
  have huv : u.v = ⟨a, b⟩ := (xgcd_type.start_v a b),
  let hv : prod.mk (w * d + x * ur.b : ℕ) (y * d + z * ur.b : ℕ) = ⟨a, b⟩ :=
   u.reduce_v.trans (xgcd_type.start_v a b),
  rw [← hb, ← add_mul, ← add_mul, ← ha', ← hb'] at hv,
  have ha'' : (a : ℕ) = a' * d := (congr_arg prod.fst hv).symm,
  have hb'' : (b : ℕ) = b' * d := (congr_arg prod.snd hv).symm,
  split, exact eq ha'', split, exact eq hb'',
  have hza' : (z * a' : ℕ) = x * b' + 1,
  by { rw [ha', hb', mul_add, mul_add, mul_comm (z : ℕ), hdet'], ring },
  have hwb' : (w * b' : ℕ) = y * a' + 1,
  by { rw [ha', hb', mul_add, mul_add, hdet'], ring },
  split,
  { apply eq, rw [succ_pnat_coe, nat.succ_eq_add_one, mul_coe, hza'] },
  split,
  { apply eq, rw [succ_pnat_coe, nat.succ_eq_add_one, mul_coe, hwb'] },
  rw [ha'', hb''], repeat { rw [← mul_assoc] }, rw [hza', hwb'],
  split; ring,
end

theorem gcd_eq : gcd_d a b = gcd a b :=
begin
  rcases gcd_props a b with ⟨h₀, h₁, h₂, h₃, h₄, h₅, h₆⟩,
  apply dvd_antisymm,
  { apply dvd_gcd,
    exact dvd.intro (gcd_a' a b) (h₁.trans (mul_comm _ _)).symm,
    exact dvd.intro (gcd_b' a b) (h₂.trans (mul_comm _ _)).symm},
  { have h₇ : (gcd a b : ℕ) ∣ (gcd_z a b) * a :=
      (nat.gcd_dvd_left a b).trans (dvd_mul_left _ _),
    have h₈ : (gcd a b : ℕ) ∣ (gcd_x a b) * b :=
      (nat.gcd_dvd_right a b).trans (dvd_mul_left _ _),
    rw[h₅] at h₇, rw dvd_iff,
    exact (nat.dvd_add_iff_right h₈).mpr h₇,}
end

theorem gcd_det_eq :
  (gcd_w a b) * (gcd_z a b) = succ_pnat ((gcd_x a b) * (gcd_y a b)) :=
(gcd_props a b).1

theorem gcd_b_eq : b = (gcd_b' a b) * (gcd a b) :=
(gcd_eq a b) ▸ (gcd_props a b).2.2.1

theorem gcd_rel_left' :
  (gcd_z a b) * (gcd_a' a b) = succ_pnat ((gcd_x a b) * (gcd_b' a b)) :=
(gcd_props a b).2.2.2.1

theorem gcd_rel_right' :
  (gcd_w a b) * (gcd_b' a b) = succ_pnat ((gcd_y a b) * (gcd_a' a b)) :=
(gcd_props a b).2.2.2.2.1

theorem gcd_rel_left :
  ((gcd_z a b) * a : ℕ) = (gcd_x a b) * b + (gcd a b) :=
(gcd_eq a b) ▸ (gcd_props a b).2.2.2.2.2.1

theorem gcd_rel_right :
  ((gcd_w a b) * b : ℕ) = (gcd_y a b) * a + (gcd a b) :=
(gcd_eq a b) ▸ (gcd_props a b).2.2.2.2.2.2

end gcd
end pnat