/-
Copyright (c) 2019 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov, Sébastien Gouëzel, Rémy Degenne
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.analysis.convex.specific_functions
import Mathlib.analysis.special_functions.pow
import Mathlib.data.real.conjugate_exponents
import Mathlib.tactic.nth_rewrite.default
import Mathlib.measure_theory.integration
import Mathlib.PostPort

universes u u_1

namespace Mathlib

/-!
# Mean value inequalities

In this file we prove several inequalities, including AM-GM inequality, Young's inequality,
Hölder inequality, and Minkowski inequality.

## Main theorems

### AM-GM inequality:

The inequality says that the geometric mean of a tuple of non-negative numbers is less than or equal
to their arithmetic mean. We prove the weighted version of this inequality: if $w$ and $z$
are two non-negative vectors and $\sum_{i\in s} w_i=1$, then
$$
\prod_{i\in s} z_i^{w_i} ≤ \sum_{i\in s} w_iz_i.
$$
The classical version is a special case of this inequality for $w_i=\frac{1}{n}$.

We prove a few versions of this inequality. Each of the following lemmas comes in two versions:
a version for real-valued non-negative functions is in the `real` namespace, and a version for
`nnreal`-valued functions is in the `nnreal` namespace.

- `geom_mean_le_arith_mean_weighted` : weighted version for functions on `finset`s;
- `geom_mean_le_arith_mean2_weighted` : weighted version for two numbers;
- `geom_mean_le_arith_mean3_weighted` : weighted version for three numbers;
- `geom_mean_le_arith_mean4_weighted` : weighted version for four numbers.

### Generalized mean inequality

The inequality says that for two non-negative vectors $w$ and $z$ with $\sum_{i\in s} w_i=1$
and $p ≤ q$ we have
$$
\sqrt[p]{\sum_{i\in s} w_i z_i^p} ≤ \sqrt[q]{\sum_{i\in s} w_i z_i^q}.
$$

Currently we only prove this inequality for $p=1$. As in the rest of `mathlib`, we provide
different theorems for natural exponents (`pow_arith_mean_le_arith_mean_pow`), integer exponents
(`fpow_arith_mean_le_arith_mean_fpow`), and real exponents (`rpow_arith_mean_le_arith_mean_rpow` and
`arith_mean_le_rpow_mean`). In the first two cases we prove
$$
\left(\sum_{i\in s} w_i z_i\right)^n ≤ \sum_{i\in s} w_i z_i^n
$$
in order to avoid using real exponents. For real exponents we prove both this and standard versions.

### Young's inequality

Young's inequality says that for non-negative numbers `a`, `b`, `p`, `q` such that
$\frac{1}{p}+\frac{1}{q}=1$ we have
$$
ab ≤ \frac{a^p}{p} + \frac{b^q}{q}.
$$

This inequality is a special case of the AM-GM inequality. It can be used to prove Hölder's
inequality (see below) but we use a different proof.

### Hölder's inequality

The inequality says that for two conjugate exponents `p` and `q` (i.e., for two positive numbers
such that $\frac{1}{p}+\frac{1}{q}=1$) and any two non-negative vectors their inner product is
less than or equal to the product of the $L_p$ norm of the first vector and the $L_q$ norm of the
second vector:
$$
\sum_{i\in s} a_ib_i ≤ \sqrt[p]{\sum_{i\in s} a_i^p}\sqrt[q]{\sum_{i\in s} b_i^q}.
$$

We give versions of this result in `real`, `nnreal` and `ennreal`.

There are at least two short proofs of this inequality. In one proof we prenormalize both vectors,
then apply Young's inequality to each $a_ib_i$. We use a different proof deducing this inequality
from the generalized mean inequality for well-chosen vectors and weights.

Hölder's inequality for the Lebesgue integral of ennreal and nnreal functions: we prove
`∫ (f * g) ∂μ ≤ (∫ f^p ∂μ) ^ (1/p) * (∫ g^q ∂μ) ^ (1/q)` for `p`, `q` conjugate real exponents
and `α→(e)nnreal` functions in two cases,
* `ennreal.lintegral_mul_le_Lp_mul_Lq` : ennreal functions,
* `nnreal.lintegral_mul_le_Lp_mul_Lq`  : nnreal functions.

### Minkowski's inequality

The inequality says that for `p ≥ 1` the function
$$
\|a\|_p=\sqrt[p]{\sum_{i\in s} a_i^p}
$$
satisfies the triangle inequality $\|a+b\|_p\le \|a\|_p+\|b\|_p$.

We give versions of this result in `real`, `nnreal` and `ennreal`.

We deduce this inequality from Hölder's inequality. Namely, Hölder inequality implies that $\|a\|_p$
is the maximum of the inner product $\sum_{i\in s}a_ib_i$ over `b` such that $\|b\|_q\le 1$. Now
Minkowski's inequality follows from the fact that the maximum value of the sum of two functions is
less than or equal to the sum of the maximum values of the summands.

Minkowski's inequality for the Lebesgue integral of measurable functions with `ennreal` values:
we prove `(∫ (f + g)^p ∂μ) ^ (1/p) ≤ (∫ f^p ∂μ) ^ (1/p) + (∫ g^p ∂μ) ^ (1/p)` for `1 ≤ p`.

## TODO

- each inequality `A ≤ B` should come with a theorem `A = B ↔ _`; one of the ways to prove them
  is to define `strict_convex_on` functions.
- generalized mean inequality with any `p ≤ q`, including negative numbers;
- prove that the power mean tends to the geometric mean as the exponent tends to zero.
- prove integral versions of these inequalities.

-/

namespace real

/-- AM-GM inequality: the geometric mean is less than or equal to the arithmetic mean, weighted
version for real-valued nonnegative functions. -/
theorem geom_mean_le_arith_mean_weighted {ι : Type u} (s : finset ι) (w : ι → ℝ) (z : ι → ℝ) (hw : ∀ (i : ι), i ∈ s → 0 ≤ w i) (hw' : (finset.sum s fun (i : ι) => w i) = 1) (hz : ∀ (i : ι), i ∈ s → 0 ≤ z i) : (finset.prod s fun (i : ι) => z i ^ w i) ≤ finset.sum s fun (i : ι) => w i * z i := sorry

theorem pow_arith_mean_le_arith_mean_pow {ι : Type u} (s : finset ι) (w : ι → ℝ) (z : ι → ℝ) (hw : ∀ (i : ι), i ∈ s → 0 ≤ w i) (hw' : (finset.sum s fun (i : ι) => w i) = 1) (hz : ∀ (i : ι), i ∈ s → 0 ≤ z i) (n : ℕ) : (finset.sum s fun (i : ι) => w i * z i) ^ n ≤ finset.sum s fun (i : ι) => w i * z i ^ n :=
  convex_on.map_sum_le (convex_on_pow n) hw hw' hz

theorem pow_arith_mean_le_arith_mean_pow_of_even {ι : Type u} (s : finset ι) (w : ι → ℝ) (z : ι → ℝ) (hw : ∀ (i : ι), i ∈ s → 0 ≤ w i) (hw' : (finset.sum s fun (i : ι) => w i) = 1) {n : ℕ} (hn : even n) : (finset.sum s fun (i : ι) => w i * z i) ^ n ≤ finset.sum s fun (i : ι) => w i * z i ^ n :=
  convex_on.map_sum_le (convex_on_pow_of_even hn) hw hw' fun (_x : ι) (_x : _x ∈ s) => trivial

theorem fpow_arith_mean_le_arith_mean_fpow {ι : Type u} (s : finset ι) (w : ι → ℝ) (z : ι → ℝ) (hw : ∀ (i : ι), i ∈ s → 0 ≤ w i) (hw' : (finset.sum s fun (i : ι) => w i) = 1) (hz : ∀ (i : ι), i ∈ s → 0 < z i) (m : ℤ) : (finset.sum s fun (i : ι) => w i * z i) ^ m ≤ finset.sum s fun (i : ι) => w i * z i ^ m :=
  convex_on.map_sum_le (convex_on_fpow m) hw hw' hz

theorem rpow_arith_mean_le_arith_mean_rpow {ι : Type u} (s : finset ι) (w : ι → ℝ) (z : ι → ℝ) (hw : ∀ (i : ι), i ∈ s → 0 ≤ w i) (hw' : (finset.sum s fun (i : ι) => w i) = 1) (hz : ∀ (i : ι), i ∈ s → 0 ≤ z i) {p : ℝ} (hp : 1 ≤ p) : (finset.sum s fun (i : ι) => w i * z i) ^ p ≤ finset.sum s fun (i : ι) => w i * z i ^ p :=
  convex_on.map_sum_le (convex_on_rpow hp) hw hw' hz

theorem arith_mean_le_rpow_mean {ι : Type u} (s : finset ι) (w : ι → ℝ) (z : ι → ℝ) (hw : ∀ (i : ι), i ∈ s → 0 ≤ w i) (hw' : (finset.sum s fun (i : ι) => w i) = 1) (hz : ∀ (i : ι), i ∈ s → 0 ≤ z i) {p : ℝ} (hp : 1 ≤ p) : (finset.sum s fun (i : ι) => w i * z i) ≤ (finset.sum s fun (i : ι) => w i * z i ^ p) ^ (1 / p) := sorry

end real

namespace nnreal

/-- The geometric mean is less than or equal to the arithmetic mean, weighted version
for `nnreal`-valued functions. -/
theorem geom_mean_le_arith_mean_weighted {ι : Type u} (s : finset ι) (w : ι → nnreal) (z : ι → nnreal) (hw' : (finset.sum s fun (i : ι) => w i) = 1) : (finset.prod s fun (i : ι) => z i ^ ↑(w i)) ≤ finset.sum s fun (i : ι) => w i * z i := sorry

/-- The geometric mean is less than or equal to the arithmetic mean, weighted version
for two `nnreal` numbers. -/
theorem geom_mean_le_arith_mean2_weighted (w₁ : nnreal) (w₂ : nnreal) (p₁ : nnreal) (p₂ : nnreal) : w₁ + w₂ = 1 → p₁ ^ ↑w₁ * p₂ ^ ↑w₂ ≤ w₁ * p₁ + w₂ * p₂ := sorry

theorem geom_mean_le_arith_mean3_weighted (w₁ : nnreal) (w₂ : nnreal) (w₃ : nnreal) (p₁ : nnreal) (p₂ : nnreal) (p₃ : nnreal) : w₁ + w₂ + w₃ = 1 → p₁ ^ ↑w₁ * p₂ ^ ↑w₂ * p₃ ^ ↑w₃ ≤ w₁ * p₁ + w₂ * p₂ + w₃ * p₃ := sorry

theorem geom_mean_le_arith_mean4_weighted (w₁ : nnreal) (w₂ : nnreal) (w₃ : nnreal) (w₄ : nnreal) (p₁ : nnreal) (p₂ : nnreal) (p₃ : nnreal) (p₄ : nnreal) : w₁ + w₂ + w₃ + w₄ = 1 → p₁ ^ ↑w₁ * p₂ ^ ↑w₂ * p₃ ^ ↑w₃ * p₄ ^ ↑w₄ ≤ w₁ * p₁ + w₂ * p₂ + w₃ * p₃ + w₄ * p₄ := sorry

/-- Weighted generalized mean inequality, version sums over finite sets, with `ℝ≥0`-valued
functions and natural exponent. -/
theorem pow_arith_mean_le_arith_mean_pow {ι : Type u} (s : finset ι) (w : ι → nnreal) (z : ι → nnreal) (hw' : (finset.sum s fun (i : ι) => w i) = 1) (n : ℕ) : (finset.sum s fun (i : ι) => w i * z i) ^ n ≤ finset.sum s fun (i : ι) => w i * z i ^ n := sorry

/-- Weighted generalized mean inequality, version for sums over finite sets, with `ℝ≥0`-valued
functions and real exponents. -/
theorem rpow_arith_mean_le_arith_mean_rpow {ι : Type u} (s : finset ι) (w : ι → nnreal) (z : ι → nnreal) (hw' : (finset.sum s fun (i : ι) => w i) = 1) {p : ℝ} (hp : 1 ≤ p) : (finset.sum s fun (i : ι) => w i * z i) ^ p ≤ finset.sum s fun (i : ι) => w i * z i ^ p := sorry

/-- Weighted generalized mean inequality, version for two elements of `ℝ≥0` and real exponents. -/
theorem rpow_arith_mean_le_arith_mean2_rpow (w₁ : nnreal) (w₂ : nnreal) (z₁ : nnreal) (z₂ : nnreal) (hw' : w₁ + w₂ = 1) {p : ℝ} (hp : 1 ≤ p) : (w₁ * z₁ + w₂ * z₂) ^ p ≤ w₁ * z₁ ^ p + w₂ * z₂ ^ p := sorry

/-- Weighted generalized mean inequality, version for sums over finite sets, with `ℝ≥0`-valued
functions and real exponents. -/
theorem arith_mean_le_rpow_mean {ι : Type u} (s : finset ι) (w : ι → nnreal) (z : ι → nnreal) (hw' : (finset.sum s fun (i : ι) => w i) = 1) {p : ℝ} (hp : 1 ≤ p) : (finset.sum s fun (i : ι) => w i * z i) ≤ (finset.sum s fun (i : ι) => w i * z i ^ p) ^ (1 / p) := sorry

end nnreal

namespace ennreal

/-- Weighted generalized mean inequality, version for sums over finite sets, with `ennreal`-valued
functions and real exponents. -/
theorem rpow_arith_mean_le_arith_mean_rpow {ι : Type u} (s : finset ι) (w : ι → ennreal) (z : ι → ennreal) (hw' : (finset.sum s fun (i : ι) => w i) = 1) {p : ℝ} (hp : 1 ≤ p) : (finset.sum s fun (i : ι) => w i * z i) ^ p ≤ finset.sum s fun (i : ι) => w i * z i ^ p := sorry

/-- Weighted generalized mean inequality, version for two elements of `ennreal` and real
exponents. -/
theorem rpow_arith_mean_le_arith_mean2_rpow (w₁ : ennreal) (w₂ : ennreal) (z₁ : ennreal) (z₂ : ennreal) (hw' : w₁ + w₂ = 1) {p : ℝ} (hp : 1 ≤ p) : (w₁ * z₁ + w₂ * z₂) ^ p ≤ w₁ * z₁ ^ p + w₂ * z₂ ^ p := sorry

end ennreal

namespace real

theorem geom_mean_le_arith_mean2_weighted {w₁ : ℝ} {w₂ : ℝ} {p₁ : ℝ} {p₂ : ℝ} (hw₁ : 0 ≤ w₁) (hw₂ : 0 ≤ w₂) (hp₁ : 0 ≤ p₁) (hp₂ : 0 ≤ p₂) (hw : w₁ + w₂ = 1) : p₁ ^ w₁ * p₂ ^ w₂ ≤ w₁ * p₁ + w₂ * p₂ :=
  nnreal.geom_mean_le_arith_mean2_weighted { val := w₁, property := hw₁ } { val := w₂, property := hw₂ }
    { val := p₁, property := hp₁ } { val := p₂, property := hp₂ } (iff.mp nnreal.coe_eq hw)

theorem geom_mean_le_arith_mean3_weighted {w₁ : ℝ} {w₂ : ℝ} {w₃ : ℝ} {p₁ : ℝ} {p₂ : ℝ} {p₃ : ℝ} (hw₁ : 0 ≤ w₁) (hw₂ : 0 ≤ w₂) (hw₃ : 0 ≤ w₃) (hp₁ : 0 ≤ p₁) (hp₂ : 0 ≤ p₂) (hp₃ : 0 ≤ p₃) (hw : w₁ + w₂ + w₃ = 1) : p₁ ^ w₁ * p₂ ^ w₂ * p₃ ^ w₃ ≤ w₁ * p₁ + w₂ * p₂ + w₃ * p₃ :=
  nnreal.geom_mean_le_arith_mean3_weighted { val := w₁, property := hw₁ } { val := w₂, property := hw₂ }
    { val := w₃, property := hw₃ } { val := p₁, property := hp₁ } { val := p₂, property := hp₂ }
    { val := p₃, property := hp₃ } (iff.mp nnreal.coe_eq hw)

theorem geom_mean_le_arith_mean4_weighted {w₁ : ℝ} {w₂ : ℝ} {w₃ : ℝ} {w₄ : ℝ} {p₁ : ℝ} {p₂ : ℝ} {p₃ : ℝ} {p₄ : ℝ} (hw₁ : 0 ≤ w₁) (hw₂ : 0 ≤ w₂) (hw₃ : 0 ≤ w₃) (hw₄ : 0 ≤ w₄) (hp₁ : 0 ≤ p₁) (hp₂ : 0 ≤ p₂) (hp₃ : 0 ≤ p₃) (hp₄ : 0 ≤ p₄) (hw : w₁ + w₂ + w₃ + w₄ = 1) : p₁ ^ w₁ * p₂ ^ w₂ * p₃ ^ w₃ * p₄ ^ w₄ ≤ w₁ * p₁ + w₂ * p₂ + w₃ * p₃ + w₄ * p₄ :=
  nnreal.geom_mean_le_arith_mean4_weighted { val := w₁, property := hw₁ } { val := w₂, property := hw₂ }
    { val := w₃, property := hw₃ } { val := w₄, property := hw₄ } { val := p₁, property := hp₁ }
    { val := p₂, property := hp₂ } { val := p₃, property := hp₃ } { val := p₄, property := hp₄ } (iff.mp nnreal.coe_eq hw)

/-- Young's inequality, a version for nonnegative real numbers. -/
theorem young_inequality_of_nonneg {a : ℝ} {b : ℝ} {p : ℝ} {q : ℝ} (ha : 0 ≤ a) (hb : 0 ≤ b) (hpq : is_conjugate_exponent p q) : a * b ≤ a ^ p / p + b ^ q / q := sorry

/-- Young's inequality, a version for arbitrary real numbers. -/
theorem young_inequality (a : ℝ) (b : ℝ) {p : ℝ} {q : ℝ} (hpq : is_conjugate_exponent p q) : a * b ≤ abs a ^ p / p + abs b ^ q / q :=
  le_trans (trans_rel_left LessEq (le_abs_self (a * b)) (abs_mul a b))
    (young_inequality_of_nonneg (abs_nonneg a) (abs_nonneg b) hpq)

end real

namespace nnreal

/-- Young's inequality, `ℝ≥0` version. We use `{p q : ℝ≥0}` in order to avoid constructing
witnesses of `0 ≤ p` and `0 ≤ q` for the denominators.  -/
theorem young_inequality (a : nnreal) (b : nnreal) {p : nnreal} {q : nnreal} (hp : 1 < p) (hpq : 1 / p + 1 / q = 1) : a * b ≤ a ^ ↑p / p + b ^ ↑q / q :=
  real.young_inequality_of_nonneg (coe_nonneg a) (coe_nonneg b)
    (real.is_conjugate_exponent.mk hp (iff.mpr nnreal.coe_eq hpq))

/-- Young's inequality, `ℝ≥0` version with real conjugate exponents. -/
theorem young_inequality_real (a : nnreal) (b : nnreal) {p : ℝ} {q : ℝ} (hpq : real.is_conjugate_exponent p q) : a * b ≤ a ^ p / nnreal.of_real p + b ^ q / nnreal.of_real q := sorry

/-- Hölder inequality: the scalar product of two functions is bounded by the product of their
`L^p` and `L^q` norms when `p` and `q` are conjugate exponents. Version for sums over finite sets,
with `ℝ≥0`-valued functions. -/
theorem inner_le_Lp_mul_Lq {ι : Type u} (s : finset ι) (f : ι → nnreal) (g : ι → nnreal) {p : ℝ} {q : ℝ} (hpq : real.is_conjugate_exponent p q) : (finset.sum s fun (i : ι) => f i * g i) ≤
  (finset.sum s fun (i : ι) => f i ^ p) ^ (1 / p) * (finset.sum s fun (i : ι) => g i ^ q) ^ (1 / q) := sorry

/-- The `L_p` seminorm of a vector `f` is the greatest value of the inner product
`∑ i in s, f i * g i` over functions `g` of `L_q` seminorm less than or equal to one. -/
theorem is_greatest_Lp {ι : Type u} (s : finset ι) (f : ι → nnreal) {p : ℝ} {q : ℝ} (hpq : real.is_conjugate_exponent p q) : is_greatest
  ((fun (g : ι → nnreal) => finset.sum s fun (i : ι) => f i * g i) ''
    set_of fun (g : ι → nnreal) => (finset.sum s fun (i : ι) => g i ^ q) ≤ 1)
  ((finset.sum s fun (i : ι) => f i ^ p) ^ (1 / p)) := sorry

/-- Minkowski inequality: the `L_p` seminorm of the sum of two vectors is less than or equal
to the sum of the `L_p`-seminorms of the summands. A version for `nnreal`-valued functions. -/
theorem Lp_add_le {ι : Type u} (s : finset ι) (f : ι → nnreal) (g : ι → nnreal) {p : ℝ} (hp : 1 ≤ p) : (finset.sum s fun (i : ι) => (f i + g i) ^ p) ^ (1 / p) ≤
  (finset.sum s fun (i : ι) => f i ^ p) ^ (1 / p) + (finset.sum s fun (i : ι) => g i ^ p) ^ (1 / p) := sorry

end nnreal

namespace real

/-- Hölder inequality: the scalar product of two functions is bounded by the product of their
`L^p` and `L^q` norms when `p` and `q` are conjugate exponents. Version for sums over finite sets,
with real-valued functions. -/
theorem inner_le_Lp_mul_Lq {ι : Type u} (s : finset ι) (f : ι → ℝ) (g : ι → ℝ) {p : ℝ} {q : ℝ} (hpq : is_conjugate_exponent p q) : (finset.sum s fun (i : ι) => f i * g i) ≤
  (finset.sum s fun (i : ι) => abs (f i) ^ p) ^ (1 / p) * (finset.sum s fun (i : ι) => abs (g i) ^ q) ^ (1 / q) := sorry

/-- Minkowski inequality: the `L_p` seminorm of the sum of two vectors is less than or equal
to the sum of the `L_p`-seminorms of the summands. A version for `real`-valued functions. -/
theorem Lp_add_le {ι : Type u} (s : finset ι) (f : ι → ℝ) (g : ι → ℝ) {p : ℝ} (hp : 1 ≤ p) : (finset.sum s fun (i : ι) => abs (f i + g i) ^ p) ^ (1 / p) ≤
  (finset.sum s fun (i : ι) => abs (f i) ^ p) ^ (1 / p) + (finset.sum s fun (i : ι) => abs (g i) ^ p) ^ (1 / p) := sorry

/-- Hölder inequality: the scalar product of two functions is bounded by the product of their
`L^p` and `L^q` norms when `p` and `q` are conjugate exponents. Version for sums over finite sets,
with real-valued nonnegative functions. -/
theorem inner_le_Lp_mul_Lq_of_nonneg {ι : Type u} (s : finset ι) {f : ι → ℝ} {g : ι → ℝ} {p : ℝ} {q : ℝ} (hpq : is_conjugate_exponent p q) (hf : ∀ (i : ι), i ∈ s → 0 ≤ f i) (hg : ∀ (i : ι), i ∈ s → 0 ≤ g i) : (finset.sum s fun (i : ι) => f i * g i) ≤
  (finset.sum s fun (i : ι) => f i ^ p) ^ (1 / p) * (finset.sum s fun (i : ι) => g i ^ q) ^ (1 / q) := sorry

/-- Minkowski inequality: the `L_p` seminorm of the sum of two vectors is less than or equal
to the sum of the `L_p`-seminorms of the summands. A version for `real`-valued nonnegative
functions. -/
theorem Lp_add_le_of_nonneg {ι : Type u} (s : finset ι) {f : ι → ℝ} {g : ι → ℝ} {p : ℝ} (hp : 1 ≤ p) (hf : ∀ (i : ι), i ∈ s → 0 ≤ f i) (hg : ∀ (i : ι), i ∈ s → 0 ≤ g i) : (finset.sum s fun (i : ι) => (f i + g i) ^ p) ^ (1 / p) ≤
  (finset.sum s fun (i : ι) => f i ^ p) ^ (1 / p) + (finset.sum s fun (i : ι) => g i ^ p) ^ (1 / p) := sorry

end real

namespace ennreal

/-- Young's inequality, `ennreal` version with real conjugate exponents. -/
theorem young_inequality (a : ennreal) (b : ennreal) {p : ℝ} {q : ℝ} (hpq : real.is_conjugate_exponent p q) : a * b ≤ a ^ p / ennreal.of_real p + b ^ q / ennreal.of_real q := sorry

/-- Hölder inequality: the scalar product of two functions is bounded by the product of their
`L^p` and `L^q` norms when `p` and `q` are conjugate exponents. Version for sums over finite sets,
with `ennreal`-valued functions. -/
theorem inner_le_Lp_mul_Lq {ι : Type u} (s : finset ι) (f : ι → ennreal) (g : ι → ennreal) {p : ℝ} {q : ℝ} (hpq : real.is_conjugate_exponent p q) : (finset.sum s fun (i : ι) => f i * g i) ≤
  (finset.sum s fun (i : ι) => f i ^ p) ^ (1 / p) * (finset.sum s fun (i : ι) => g i ^ q) ^ (1 / q) := sorry

/-- Minkowski inequality: the `L_p` seminorm of the sum of two vectors is less than or equal
to the sum of the `L_p`-seminorms of the summands. A version for `ennreal` valued nonnegative
functions. -/
theorem Lp_add_le {ι : Type u} (s : finset ι) (f : ι → ennreal) (g : ι → ennreal) {p : ℝ} (hp : 1 ≤ p) : (finset.sum s fun (i : ι) => (f i + g i) ^ p) ^ (1 / p) ≤
  (finset.sum s fun (i : ι) => f i ^ p) ^ (1 / p) + (finset.sum s fun (i : ι) => g i ^ p) ^ (1 / p) := sorry

theorem add_rpow_le_rpow_add {p : ℝ} (a : ennreal) (b : ennreal) (hp1 : 1 ≤ p) : a ^ p + b ^ p ≤ (a + b) ^ p := sorry

theorem rpow_add_rpow_le_add {p : ℝ} (a : ennreal) (b : ennreal) (hp1 : 1 ≤ p) : (a ^ p + b ^ p) ^ (1 / p) ≤ a + b := sorry

theorem rpow_add_rpow_le {p : ℝ} {q : ℝ} (a : ennreal) (b : ennreal) (hp_pos : 0 < p) (hpq : p ≤ q) : (a ^ q + b ^ q) ^ (1 / q) ≤ (a ^ p + b ^ p) ^ (1 / p) := sorry

theorem rpow_add_le_add_rpow {p : ℝ} (a : ennreal) (b : ennreal) (hp_pos : 0 < p) (hp1 : p ≤ 1) : (a + b) ^ p ≤ a ^ p + b ^ p := sorry

end ennreal

/-!
### Hölder's inequality for the Lebesgue integral of ennreal and nnreal functions

We prove `∫ (f * g) ∂μ ≤ (∫ f^p ∂μ) ^ (1/p) * (∫ g^q ∂μ) ^ (1/q)` for `p`, `q`
conjugate real exponents and `α→(e)nnreal` functions in several cases, the first two being useful
only to prove the more general results:
* `ennreal.lintegral_mul_le_one_of_lintegral_rpow_eq_one` : ennreal functions for which the
    integrals on the right are equal to 1,
* `ennreal.lintegral_mul_le_Lp_mul_Lq_of_ne_zero_of_ne_top` : ennreal functions for which the
    integrals on the right are neither ⊤ nor 0,
* `ennreal.lintegral_mul_le_Lp_mul_Lq` : ennreal functions,
* `nnreal.lintegral_mul_le_Lp_mul_Lq`  : nnreal functions.
-/

namespace ennreal

theorem lintegral_mul_le_one_of_lintegral_rpow_eq_one {α : Type u_1} [measurable_space α] {μ : measure_theory.measure α} {p : ℝ} {q : ℝ} (hpq : real.is_conjugate_exponent p q) {f : α → ennreal} {g : α → ennreal} (hf : ae_measurable f) (hg : ae_measurable g) (hf_norm : (measure_theory.lintegral μ fun (a : α) => f a ^ p) = 1) (hg_norm : (measure_theory.lintegral μ fun (a : α) => g a ^ q) = 1) : (measure_theory.lintegral μ fun (a : α) => Mul.mul f g a) ≤ 1 := sorry

/-- Function multiplied by the inverse of its p-seminorm `(∫⁻ f^p ∂μ) ^ 1/p`-/
def fun_mul_inv_snorm {α : Type u_1} [measurable_space α] (f : α → ennreal) (p : ℝ) (μ : measure_theory.measure α) : α → ennreal :=
  fun (a : α) => f a * ((measure_theory.lintegral μ fun (c : α) => f c ^ p) ^ (1 / p)⁻¹)

theorem fun_eq_fun_mul_inv_snorm_mul_snorm {α : Type u_1} [measurable_space α] {μ : measure_theory.measure α} {p : ℝ} (f : α → ennreal) (hf_nonzero : (measure_theory.lintegral μ fun (a : α) => f a ^ p) ≠ 0) (hf_top : (measure_theory.lintegral μ fun (a : α) => f a ^ p) ≠ ⊤) {a : α} : f a = fun_mul_inv_snorm f p μ a * (measure_theory.lintegral μ fun (a : α) => f a ^ p) ^ (1 / p) := sorry

theorem fun_mul_inv_snorm_rpow {α : Type u_1} [measurable_space α] {μ : measure_theory.measure α} {p : ℝ} (hp0 : 0 < p) {f : α → ennreal} {a : α} : fun_mul_inv_snorm f p μ a ^ p = f a ^ p * ((measure_theory.lintegral μ fun (c : α) => f c ^ p)⁻¹) := sorry

theorem lintegral_rpow_fun_mul_inv_snorm_eq_one {α : Type u_1} [measurable_space α] {μ : measure_theory.measure α} {p : ℝ} (hp0_lt : 0 < p) {f : α → ennreal} (hf : ae_measurable f) (hf_nonzero : (measure_theory.lintegral μ fun (a : α) => f a ^ p) ≠ 0) (hf_top : (measure_theory.lintegral μ fun (a : α) => f a ^ p) ≠ ⊤) : (measure_theory.lintegral μ fun (c : α) => fun_mul_inv_snorm f p μ c ^ p) = 1 := sorry

/-- Hölder's inequality in case of finite non-zero integrals -/
theorem lintegral_mul_le_Lp_mul_Lq_of_ne_zero_of_ne_top {α : Type u_1} [measurable_space α] {μ : measure_theory.measure α} {p : ℝ} {q : ℝ} (hpq : real.is_conjugate_exponent p q) {f : α → ennreal} {g : α → ennreal} (hf : ae_measurable f) (hg : ae_measurable g) (hf_nontop : (measure_theory.lintegral μ fun (a : α) => f a ^ p) ≠ ⊤) (hg_nontop : (measure_theory.lintegral μ fun (a : α) => g a ^ q) ≠ ⊤) (hf_nonzero : (measure_theory.lintegral μ fun (a : α) => f a ^ p) ≠ 0) (hg_nonzero : (measure_theory.lintegral μ fun (a : α) => g a ^ q) ≠ 0) : (measure_theory.lintegral μ fun (a : α) => Mul.mul f g a) ≤
  (measure_theory.lintegral μ fun (a : α) => f a ^ p) ^ (1 / p) *
    (measure_theory.lintegral μ fun (a : α) => g a ^ q) ^ (1 / q) := sorry

theorem ae_eq_zero_of_lintegral_rpow_eq_zero {α : Type u_1} [measurable_space α] {μ : measure_theory.measure α} {p : ℝ} (hp0_lt : 0 < p) {f : α → ennreal} (hf : ae_measurable f) (hf_zero : (measure_theory.lintegral μ fun (a : α) => f a ^ p) = 0) : filter.eventually_eq (measure_theory.measure.ae μ) f 0 := sorry

theorem lintegral_mul_eq_zero_of_lintegral_rpow_eq_zero {α : Type u_1} [measurable_space α] {μ : measure_theory.measure α} {p : ℝ} (hp0_lt : 0 < p) {f : α → ennreal} {g : α → ennreal} (hf : ae_measurable f) (hf_zero : (measure_theory.lintegral μ fun (a : α) => f a ^ p) = 0) : (measure_theory.lintegral μ fun (a : α) => Mul.mul f g a) = 0 := sorry

theorem lintegral_mul_le_Lp_mul_Lq_of_ne_zero_of_eq_top {α : Type u_1} [measurable_space α] {μ : measure_theory.measure α} {p : ℝ} {q : ℝ} (hp0_lt : 0 < p) (hq0 : 0 ≤ q) {f : α → ennreal} {g : α → ennreal} (hf_top : (measure_theory.lintegral μ fun (a : α) => f a ^ p) = ⊤) (hg_nonzero : (measure_theory.lintegral μ fun (a : α) => g a ^ q) ≠ 0) : (measure_theory.lintegral μ fun (a : α) => Mul.mul f g a) ≤
  (measure_theory.lintegral μ fun (a : α) => f a ^ p) ^ (1 / p) *
    (measure_theory.lintegral μ fun (a : α) => g a ^ q) ^ (1 / q) := sorry

/-- Hölder's inequality for functions `α → ennreal`. The integral of the product of two functions
is bounded by the product of their `ℒp` and `ℒq` seminorms when `p` and `q` are conjugate
exponents. -/
theorem lintegral_mul_le_Lp_mul_Lq {α : Type u_1} [measurable_space α] (μ : measure_theory.measure α) {p : ℝ} {q : ℝ} (hpq : real.is_conjugate_exponent p q) {f : α → ennreal} {g : α → ennreal} (hf : ae_measurable f) (hg : ae_measurable g) : (measure_theory.lintegral μ fun (a : α) => Mul.mul f g a) ≤
  (measure_theory.lintegral μ fun (a : α) => f a ^ p) ^ (1 / p) *
    (measure_theory.lintegral μ fun (a : α) => g a ^ q) ^ (1 / q) := sorry

theorem lintegral_rpow_add_lt_top_of_lintegral_rpow_lt_top {α : Type u_1} [measurable_space α] {μ : measure_theory.measure α} {p : ℝ} {f : α → ennreal} {g : α → ennreal} (hf : ae_measurable f) (hf_top : (measure_theory.lintegral μ fun (a : α) => f a ^ p) < ⊤) (hg : ae_measurable g) (hg_top : (measure_theory.lintegral μ fun (a : α) => g a ^ p) < ⊤) (hp1 : 1 ≤ p) : (measure_theory.lintegral μ fun (a : α) => Add.add f g a ^ p) < ⊤ := sorry

theorem lintegral_Lp_mul_le_Lq_mul_Lr {α : Type u_1} [measurable_space α] {p : ℝ} {q : ℝ} {r : ℝ} (hp0_lt : 0 < p) (hpq : p < q) (hpqr : 1 / p = 1 / q + 1 / r) (μ : measure_theory.measure α) {f : α → ennreal} {g : α → ennreal} (hf : ae_measurable f) (hg : ae_measurable g) : (measure_theory.lintegral μ fun (a : α) => Mul.mul f g a ^ p) ^ (1 / p) ≤
  (measure_theory.lintegral μ fun (a : α) => f a ^ q) ^ (1 / q) *
    (measure_theory.lintegral μ fun (a : α) => g a ^ r) ^ (1 / r) := sorry

theorem lintegral_mul_rpow_le_lintegral_rpow_mul_lintegral_rpow {α : Type u_1} [measurable_space α] {μ : measure_theory.measure α} {p : ℝ} {q : ℝ} (hpq : real.is_conjugate_exponent p q) {f : α → ennreal} {g : α → ennreal} (hf : ae_measurable f) (hg : ae_measurable g) (hf_top : (measure_theory.lintegral μ fun (a : α) => f a ^ p) ≠ ⊤) : (measure_theory.lintegral μ fun (a : α) => f a * g a ^ (p - 1)) ≤
  (measure_theory.lintegral μ fun (a : α) => f a ^ p) ^ (1 / p) *
    (measure_theory.lintegral μ fun (a : α) => g a ^ p) ^ (1 / q) := sorry

theorem lintegral_rpow_add_le_add_snorm_mul_lintegral_rpow_add {α : Type u_1} [measurable_space α] {μ : measure_theory.measure α} {p : ℝ} {q : ℝ} (hpq : real.is_conjugate_exponent p q) {f : α → ennreal} {g : α → ennreal} (hf : ae_measurable f) (hf_top : (measure_theory.lintegral μ fun (a : α) => f a ^ p) ≠ ⊤) (hg : ae_measurable g) (hg_top : (measure_theory.lintegral μ fun (a : α) => g a ^ p) ≠ ⊤) : (measure_theory.lintegral μ fun (a : α) => Add.add f g a ^ p) ≤
  ((measure_theory.lintegral μ fun (a : α) => f a ^ p) ^ (1 / p) +
      (measure_theory.lintegral μ fun (a : α) => g a ^ p) ^ (1 / p)) *
    (measure_theory.lintegral μ fun (a : α) => (f a + g a) ^ p) ^ (1 / q) := sorry

/-- Minkowski's inequality for functions `α → ennreal`: the `ℒp` seminorm of the sum of two
functions is bounded by the sum of their `ℒp` seminorms. -/
theorem lintegral_Lp_add_le {α : Type u_1} [measurable_space α] {μ : measure_theory.measure α} {p : ℝ} {f : α → ennreal} {g : α → ennreal} (hf : ae_measurable f) (hg : ae_measurable g) (hp1 : 1 ≤ p) : (measure_theory.lintegral μ fun (a : α) => Add.add f g a ^ p) ^ (1 / p) ≤
  (measure_theory.lintegral μ fun (a : α) => f a ^ p) ^ (1 / p) +
    (measure_theory.lintegral μ fun (a : α) => g a ^ p) ^ (1 / p) := sorry

end ennreal

/-- Hölder's inequality for functions `α → ℝ≥0`. The integral of the product of two functions
is bounded by the product of their `ℒp` and `ℒq` seminorms when `p` and `q` are conjugate
exponents. -/
theorem nnreal.lintegral_mul_le_Lp_mul_Lq {α : Type u_1} [measurable_space α] {μ : measure_theory.measure α} {p : ℝ} {q : ℝ} (hpq : real.is_conjugate_exponent p q) {f : α → nnreal} {g : α → nnreal} (hf : ae_measurable f) (hg : ae_measurable g) : (measure_theory.lintegral μ fun (a : α) => ↑(Mul.mul f g a)) ≤
  (measure_theory.lintegral μ fun (a : α) => ↑(f a) ^ p) ^ (1 / p) *
    (measure_theory.lintegral μ fun (a : α) => ↑(g a) ^ q) ^ (1 / q) := sorry


/-
Copyright (c) 2020 Gihan Marasingha. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Gihan Marasingha
-/
import .decision_nec
import tactic.linarith

/-!
# Decision procedure - sufficient condition and decidability

We give a sufficient condition for a string to be derivable in the MIU language. Together with the
necessary condition, we use this to prove that `derivable` is an instance of `decidable_pred`.

Let `count I st` and `count U st` denote the number of `I`s (respectively `U`s) in `st : miustr`.

We'll show that `st` is derivable if it has the form `M::x` where `x` is a string of `I`s and `U`s
for which `count I x` is congruent to 1 or 2 modulo 3.

To prove this, it suffices to show `derivable M::y` where `y` is any `miustr` consisting only of
`I`s such that the number of `I`s in `y` is `a+3b`, where `a = count I x` and `b = count U x`.
This suffices because Rule 3 permits us to change any string of three consecutive `I`s into a `U`.

As `count I y = (count I x) + 3*(count U x) ≡ (count I x) [MOD 3]`, it suffices to show
`derivable M::z` where `z` is an `miustr` of `I`s such that `count I z` is congruent to
1 or 2 modulo 3.

Let `z` be such an `miustr` and let `c` denote `count I z`, so `c ≡ 1 or 2 [MOD 3]`.
To derive such an `miustr`, it suffices to derive an `miustr` `M::w`, where again w is an
`miustr` of only `I`s with the additional conditions that `count I w` is a power of 2, that
`count I w ≥ c` and that `count I w ≡ c [MOD 3]`.

To see that this suffices, note that we can remove triples of `I`s from the end of `M::w`,
creating `U`s as we go along. Once the number of `I`s equals `m`, we remove `U`s two at a time
until we have no `U`s. The only issue is that we may begin the removal process with an odd number
of `U`s.

Writing `d = count I w`, we see that this happens if and only if `(d-c)/3` is odd.
In this case, we must apply Rule 1 to `z`, prior to removing triples of `I`s. We thereby
introduce an additional `U` and ensure that the final number of `U`s will be even.

## Tags

miu, decision procedure, decidability, decidable_pred, decidable
-/

namespace miu

open miu_atom list nat

/--
We start by showing that an `miustr` `M::w` can be derived, where `w` consists only of `I`s and
where `count I w` is a power of 2.
-/
private lemma der_cons_replicate (n : ℕ) : derivable (M::(replicate (2^n) I)) :=
begin
  induction n with k hk,
  { constructor, }, -- base case
  { rw [succ_eq_add_one, pow_add, pow_one 2, mul_two,replicate_add], -- inductive step
    exact derivable.r2 hk, },
end

/-!
## Converting `I`s to `U`s

For any given natural number `c ≡ 1 or 2 [MOD 3]`, we need to show that can derive an `miustr`
`M::w` where `w` consists only of `I`s,  where `d = count I w` is a power of 2, where `d ≥ c` and
where `d ≡ c [MOD 3]`.

Given the above lemmas, the desired result reduces to an arithmetic result, given in the file
`arithmetic.lean`.

We'll use this result to show we can derive an `miustr` of the form `M::z` where `z` is an string
consisting only of `I`s such that `count I z ≡ 1 or 2 [MOD 3]`.

As an intermediate step, we show that derive `z` from `zt`, where `t` is aN `miustr` consisting of
an even number of `U`s and `z` is any `miustr`.
-/

/--
Any number of successive occurrences of `"UU"` can be removed from the end of a `derivable` `miustr`
to produce another `derivable` `miustr`.
-/
lemma der_of_der_append_replicate_U_even {z : miustr} {m : ℕ}
  (h : derivable (z ++ replicate (m*2) U)) : derivable z :=
begin
  induction m with k hk,
  { revert h,
    simp only [list.replicate, zero_mul, append_nil, imp_self], },
  { apply hk,
    simp only [succ_mul, replicate_add] at h,
    change replicate 2 U with [U,U] at h,
    rw ←(append_nil (z ++ replicate (k*2) U)),
    apply derivable.r4,
    simp only [append_nil, append_assoc,h], },
end

/-!
In fine-tuning my application of `simp`, I issued the following commend to determine which lemmas
`simp` uses.

`set_option trace.simplify.rewrite true`
-/

/--
We may replace several consecutive occurrences of  `"III"` with the same number of `"U"`s.
In application of the following lemma, `xs` will either be `[]` or `[U]`.
-/
lemma der_cons_replicate_I_replicate_U_append_of_der_cons_replicate_I_append (c k : ℕ)
  (hc : c % 3 = 1 ∨ c % 3 = 2) (xs : miustr) (hder : derivable (M ::(replicate (c+3*k) I) ++ xs)) :
    derivable (M::(replicate c I ++ replicate k U) ++ xs) :=
begin
  revert xs,
  induction k with a ha,
  { simp only [list.replicate, mul_zero, add_zero, append_nil, forall_true_iff, imp_self],},
  { intro xs,
    specialize ha (U::xs),
    intro h₂,
    simp only [succ_eq_add_one, replicate_add], -- We massage the goal
    rw [←append_assoc, ←cons_append],        -- into a form amenable
    change replicate 1 U with [U],             -- to the application of
    rw [append_assoc, singleton_append],     -- ha.
    apply ha,
    apply derivable.r3,
    change [I,I,I] with replicate 3 I,
    simp only [cons_append, ←replicate_add],
    convert h₂, },
end

/-!
### Arithmetic

We collect purely arithmetic lemmas: `add_mod2` is used to ensure we have an even number of `U`s
while `le_pow2_and_pow2_eq_mod3` treats the congruence condition modulo 3.
-/
section arithmetic

/--
For every `a`, the number `a + a % 2` is even.
-/
lemma add_mod2 (a : ℕ) : ∃ t, a + a % 2 = t*2 :=
begin
  simp only [mul_comm _ 2], -- write `t*2` as `2*t`
  apply dvd_of_mod_eq_zero, -- it suffices to prove `(a + a % 2) % 2 = 0`
  rw [add_mod, mod_mod, ←two_mul, mul_mod_right],
end

private lemma le_pow2_and_pow2_eq_mod3' (c : ℕ) (x : ℕ) (h : c = 1 ∨ c = 2) :
  ∃ m : ℕ, c + 3*x ≤ 2^m ∧ 2^m % 3 = c % 3 :=
begin
  induction x with k hk,
  { use (c+1),
    cases h with hc hc;
    { rw hc, norm_num }, },
  rcases hk with ⟨g, hkg, hgmod⟩,
  by_cases hp : (c + 3*(k+1) ≤ 2 ^g),
  { use g, exact ⟨hp, hgmod⟩ },
  refine ⟨g + 2, _, _⟩,
  { rw [mul_succ, ←add_assoc, pow_add],
    change 2^2 with (1+3), rw [mul_add (2^g) 1 3, mul_one],
    linarith [hkg, one_le_two_pow g], },
  { rw [pow_add, ←mul_one c],
    exact modeq.mul hgmod rfl }
end

/--
If `a` is 1 or 2 modulo 3, then exists `k` a power of 2 for which `a ≤ k` and `a ≡ k [MOD 3]`.
-/
lemma le_pow2_and_pow2_eq_mod3 (a : ℕ) (h : a % 3 = 1 ∨ a % 3 = 2) :
  ∃ m : ℕ, a ≤ 2^m ∧ 2^m % 3 = a % 3:=
begin
  cases le_pow2_and_pow2_eq_mod3' (a%3) (a/3) h with m hm,
  use m,
  split,
  { convert hm.1, exact (mod_add_div a 3).symm, },
  { rw [hm.2, mod_mod _ 3], },
end

end arithmetic

lemma replicate_pow_minus_append  {m : ℕ} :
  M :: replicate (2^m - 1) I ++ [I] = M::(replicate (2^m) I) :=
begin
  change [I] with replicate 1 I,
  rw [cons_append, ←replicate_add, tsub_add_cancel_of_le (one_le_pow' m 1)],
end

/--
`der_replicate_I_of_mod3` states that `M::y` is `derivable` if `y` is any `miustr` consisiting just
of `I`s, where `count I y` is 1 or 2 modulo 3.
-/
lemma der_replicate_I_of_mod3 (c : ℕ) (h : c % 3 = 1 ∨ c % 3 = 2):
  derivable (M::(replicate c I)) :=
begin
  -- From `der_cons_replicate`, we can derive the `miustr` `M::w` described in the introduction.
  cases (le_pow2_and_pow2_eq_mod3 c h) with m hm, -- `2^m` will be  the number of `I`s in `M::w`
  have hw₂ : derivable (M::(replicate (2^m) I) ++ replicate ((2^m -c)/3 % 2) U),
  { cases mod_two_eq_zero_or_one ((2^m -c)/3) with h_zero h_one,
    { -- `(2^m - c)/3 ≡ 0 [MOD 2]`
      simp only [der_cons_replicate m, append_nil,list.replicate, h_zero], },
    { rw [h_one, ←replicate_pow_minus_append, append_assoc], -- case `(2^m - c)/3 ≡ 1 [MOD 2]`
      apply derivable.r1,
      rw replicate_pow_minus_append,
      exact (der_cons_replicate m), }, },
  have hw₃ :
    derivable (M::(replicate c I) ++ replicate ((2^m-c)/3) U ++ replicate ((2^m-c)/3 % 2) U),
  { apply der_cons_replicate_I_replicate_U_append_of_der_cons_replicate_I_append c ((2^m-c)/3) h,
    convert hw₂, -- now we must show `c + 3 * ((2 ^ m - c) / 3) = 2 ^ m`
    rw nat.mul_div_cancel',
    { exact add_tsub_cancel_of_le hm.1 },
    { exact (modeq_iff_dvd' hm.1).mp hm.2.symm } },
  rw [append_assoc, ←replicate_add _ _] at hw₃,
  cases add_mod2 ((2^m-c)/3) with t ht,
  rw ht at hw₃,
  exact der_of_der_append_replicate_U_even hw₃,
end

example (c : ℕ) (h : c % 3 = 1 ∨ c % 3 = 2):
  derivable (M::(replicate c I)) :=
begin
  -- From `der_cons_replicate`, we can derive the `miustr` `M::w` described in the introduction.
  cases (le_pow2_and_pow2_eq_mod3 c h) with m hm, -- `2^m` will be  the number of `I`s in `M::w`
  have hw₂ : derivable (M::(replicate (2^m) I) ++ replicate ((2^m -c)/3 % 2) U),
  { cases mod_two_eq_zero_or_one ((2^m -c)/3) with h_zero h_one,
    { -- `(2^m - c)/3 ≡ 0 [MOD 2]`
      simp only [der_cons_replicate m, append_nil, list.replicate, h_zero] },
    { rw [h_one, ←replicate_pow_minus_append, append_assoc], -- case `(2^m - c)/3 ≡ 1 [MOD 2]`
      apply derivable.r1,
      rw replicate_pow_minus_append,
      exact (der_cons_replicate m), }, },
  have hw₃ :
    derivable (M::(replicate c I) ++ replicate ((2^m-c)/3) U ++ replicate ((2^m-c)/3 % 2) U),
  { apply der_cons_replicate_I_replicate_U_append_of_der_cons_replicate_I_append c ((2^m-c)/3) h,
    convert hw₂, -- now we must show `c + 3 * ((2 ^ m - c) / 3) = 2 ^ m`
    rw nat.mul_div_cancel',
    { exact add_tsub_cancel_of_le hm.1 },
    { exact (modeq_iff_dvd' hm.1).mp hm.2.symm } },
  rw [append_assoc, ←replicate_add _ _] at hw₃,
  cases add_mod2 ((2^m-c)/3) with t ht,
  rw ht at hw₃,
  exact der_of_der_append_replicate_U_even hw₃,
end

/-!
### `decstr` is a sufficient condition

The remainder of this file sets up the proof that `dectstr en` is sufficent to ensure
`derivable en`. Decidability of `derivable en` is an easy consequence.

The proof proceeds by induction on the `count U` of `en`.

We tackle first the base case of the induction. This requires auxiliary results giving
conditions under which  `count I ys = length ys`.
-/

/--
If an `miustr` has a zero `count U` and contains no `M`, then its `count I` is its length.
-/
lemma count_I_eq_length_of_count_U_zero_and_neg_mem {ys : miustr} (hu : count U ys = 0)
  (hm : M ∉ ys) : count I ys = length ys :=
begin
  induction ys with x xs hxs,
  { refl, },
  { cases x,
    { exfalso, exact hm (mem_cons_self M xs), }, -- case `x = M` gives a contradiction.
    { rw [count_cons, if_pos (rfl), length, succ_eq_add_one, succ_inj'], -- case `x = I`
      apply hxs,
      { simpa only [count], },
      { simp only [mem_cons_iff,false_or] at hm, exact hm, }, },
    { exfalso, simp only [count, countp_cons_of_pos] at hu,  -- case `x = U` gives a contradiction.
      exact succ_ne_zero _ hu, }, },
end

/--
`base_case_suf` is the base case of the sufficiency result.
-/
lemma base_case_suf (en : miustr) (h : decstr en) (hu : count U en = 0) : derivable en :=
begin
  rcases h with ⟨⟨mhead, nmtail⟩, hi ⟩,
  have : en ≠ nil,
  { intro k, simp only [k, count, countp, if_false, zero_mod, zero_ne_one, false_or] at hi,
    contradiction, },
  rcases (exists_cons_of_ne_nil this) with ⟨y,ys,rfl⟩,
  rw head at mhead,
  rw mhead at *,
  rsuffices ⟨c, rfl, hc⟩ : ∃ c, replicate c I = ys ∧ (c % 3 = 1 ∨ c % 3 = 2),
  { exact der_replicate_I_of_mod3 c hc, },
  { simp only [count] at *,
    use (count I ys),
    refine and.intro _ hi,
    apply replicate_count_eq_of_count_eq_length,
    exact count_I_eq_length_of_count_U_zero_and_neg_mem hu nmtail, },
end

/-!
Before continuing to the proof of the induction step, we need other auxiliary results that
relate to `count U`.
-/
lemma mem_of_count_U_eq_succ {xs : miustr} {k : ℕ} (h : count U xs = succ k) : U ∈ xs :=
begin
  induction xs with z zs hzs,
  { exfalso, rw count at h, contradiction, },
  { simp only [mem_cons_iff],
    cases z,
    repeat -- cases `z = M` and `z=I`
    { right, apply hzs, simp only [count, countp, if_false] at h, rw ←h, refl, },
    { left, refl, }, }, -- case `z = U`
end

lemma eq_append_cons_U_of_count_U_pos {k : ℕ} {zs : miustr} (h : count U zs = succ k) :
∃ (as bs : miustr), (zs = as ++ U :: bs) :=
mem_split (mem_of_count_U_eq_succ h)

/--
`ind_hyp_suf` is the inductive step of the sufficiency result.
 -/
lemma ind_hyp_suf (k : ℕ) (ys : miustr) (hu : count U ys = succ k) (hdec : decstr ys) :
∃ (as bs : miustr), (ys = M::as ++ U:: bs) ∧ (count U (M::as ++ [I,I,I] ++ bs) = k) ∧
  decstr (M::as ++ [I,I,I] ++ bs) :=
begin
  rcases hdec with ⟨⟨mhead,nmtail⟩, hic⟩,
  have : ys ≠ nil,
  { intro k, simp only [k ,count, countp, zero_mod, false_or, zero_ne_one] at hic, contradiction, },
  rcases (exists_cons_of_ne_nil this) with ⟨z,zs,rfl⟩,
  rw head at mhead,
  rw mhead at *,
  simp only [count, countp, cons_append, if_false, countp_append] at *,
  rcases (eq_append_cons_U_of_count_U_pos hu) with ⟨as,bs,hab⟩,
  rw hab at *,
  simp only [countp, cons_append, if_pos, if_false, countp_append] at *,
  use [as,bs],
  apply and.intro rfl (and.intro (succ.inj hu) _),
  split,
  { apply and.intro rfl,
    simp only [tail, mem_append, mem_cons_iff, false_or, not_mem_nil, or_false] at *,
    exact nmtail, },
  { simp only [count, countp, cons_append, if_false, countp_append, if_pos],
    rw [add_right_comm, add_mod_right], exact hic, },
end

/--
`der_of_decstr` states that `derivable en` follows from `decstr en`.
-/
theorem der_of_decstr {en : miustr} (h : decstr en) : derivable en :=
begin
/- The next three lines have the effect of introducing `count U en` as a variable that can be used
 for induction -/
  have hu : ∃ n, count U en = n := exists_eq',
  cases hu with n hu,
  revert en, /- Crucially, we need the induction hypothesis to quantify over `en` -/
  induction n with k hk,
  { exact base_case_suf, },
  { intros ys hdec hus,
    rcases ind_hyp_suf k ys hus hdec with ⟨as, bs, hyab, habuc, hdecab⟩,
    have h₂ : derivable (M::as ++ [I,I,I] ++ bs) := hk hdecab habuc,
    rw hyab,
    exact derivable.r3 h₂, },
end

/-!
### Decidability of `derivable`
-/

/--
Finally, we have the main result, namely that `derivable` is a decidable predicate.
-/
instance : decidable_pred derivable :=
λ en, decidable_of_iff _ ⟨der_of_decstr, decstr_of_der⟩

/-!
By decidability, we can automatically determine whether any given `miustr` is `derivable`.
-/

example : ¬(derivable "MU") :=
dec_trivial

example : derivable "MUIUIUIIIIIUUUIUII" :=
dec_trivial

end miu


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

import data.fin.basic
import data.finset.sort
import order.lexicographic

/-!

# Sorting tuples by their values

Given an `n`-tuple `f : fin n → α` where `α` is ordered,
we may want to turn it into a sorted `n`-tuple.
This file provides an API for doing so, with the sorted `n`-tuple given by
`f ∘ tuple.sort f`.

## Main declarations

* `tuple.sort`: given `f : fin n → α`, produces a permutation on `fin n`
* `tuple.monotone_sort`: `f ∘ tuple.sort f` is `monotone`

-/

namespace tuple

variables {n : ℕ}
variables {α : Type*} [linear_order α]

/--
`graph f` produces the finset of pairs `(f i, i)`
equipped with the lexicographic order.
-/
def graph (f : fin n → α) : finset (α ×ₗ (fin n)) :=
finset.univ.image (λ i, (f i, i))

/--
Given `p : α ×ₗ (fin n) := (f i, i)` with `p ∈ graph f`,
`graph.proj p` is defined to be `f i`.
-/
def graph.proj {f : fin n → α} : graph f → α := λ p, p.1.1

@[simp] lemma graph.card (f : fin n → α) : (graph f).card = n :=
begin
  rw [graph, finset.card_image_of_injective],
  { exact finset.card_fin _ },
  { intros _ _,
    simp }
end

/--
`graph_equiv₁ f` is the natural equivalence between `fin n` and `graph f`,
mapping `i` to `(f i, i)`. -/
def graph_equiv₁ (f : fin n → α) : fin n ≃ graph f :=
{ to_fun := λ i, ⟨(f i, i), by simp [graph]⟩,
  inv_fun := λ p, p.1.2,
  left_inv := λ i, by simp,
  right_inv := λ ⟨⟨x, i⟩, h⟩, by simpa [graph] using h }

@[simp] lemma proj_equiv₁' (f : fin n → α) : graph.proj ∘ graph_equiv₁ f = f :=
rfl

/--
`graph_equiv₂ f` is an equivalence between `fin n` and `graph f` that respects the order.
-/
def graph_equiv₂ (f : fin n → α) : fin n ≃o graph f :=
finset.order_iso_of_fin _ (by simp)

/-- `sort f` is the permutation that orders `fin n` according to the order of the outputs of `f`. -/
def sort (f : fin n → α) : equiv.perm (fin n) :=
(graph_equiv₂ f).to_equiv.trans (graph_equiv₁ f).symm

lemma self_comp_sort (f : fin n → α) : f ∘ sort f = graph.proj ∘ graph_equiv₂ f :=
show graph.proj ∘ ((graph_equiv₁ f) ∘ (graph_equiv₁ f).symm) ∘ (graph_equiv₂ f).to_equiv = _,
  by simp

lemma monotone_proj (f : fin n → α) : monotone (graph.proj : graph f → α) :=
begin
  rintro ⟨⟨x, i⟩, hx⟩ ⟨⟨y, j⟩, hy⟩ (h|h),
  { exact le_of_lt ‹_› },
  { simp [graph.proj] },
end

lemma monotone_sort (f : fin n → α) : monotone (f ∘ sort f) :=
begin
  rw [self_comp_sort],
  exact (monotone_proj f).comp (graph_equiv₂ f).monotone,
end

end tuple


/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import analysis.box_integral.box.subbox_induction
import analysis.box_integral.partition.tagged

/-!
# Induction on subboxes

In this file we prove (see
`box_integral.tagged_partition.exists_is_Henstock_is_subordinate_homothetic`) that for every box `I`
in `ℝⁿ` and a function `r : ℝⁿ → ℝ` positive on `I` there exists a tagged partition `π` of `I` such
that

* `π` is a Henstock partition;
* `π` is subordinate to `r`;
* each box in `π` is homothetic to `I` with coefficient of the form `1 / 2 ^ n`.

Later we will use this lemma to prove that the Henstock filter is nontrivial, hence the Henstock
integral is well-defined.

## Tags

partition, tagged partition, Henstock integral
-/

namespace box_integral

open set metric
open_locale classical topological_space
noncomputable theory

variables {ι : Type*} [fintype ι] {I J : box ι}

namespace prepartition

/-- Split a box in `ℝⁿ` into `2 ^ n` boxes by hyperplanes passing through its center. -/
def split_center (I : box ι) : prepartition I :=
{ boxes := finset.univ.map (box.split_center_box_emb I),
  le_of_mem' := by simp [I.split_center_box_le],
  pairwise_disjoint :=
    begin
      rw [finset.coe_map, finset.coe_univ, image_univ],
      rintro _ ⟨s, rfl⟩ _ ⟨t, rfl⟩ Hne,
      exact I.disjoint_split_center_box (mt (congr_arg _) Hne)
    end }

@[simp] lemma mem_split_center : J ∈ split_center I ↔ ∃ s, I.split_center_box s = J :=
by simp [split_center]

lemma is_partition_split_center (I : box ι) : is_partition (split_center I) :=
λ x hx, by simp [hx]

lemma upper_sub_lower_of_mem_split_center (h : J ∈ split_center I) (i : ι) :
  J.upper i - J.lower i = (I.upper i - I.lower i) / 2 :=
let ⟨s, hs⟩ := mem_split_center.1 h in hs ▸ I.upper_sub_lower_split_center_box s i

end prepartition

namespace box

open prepartition tagged_prepartition

/-- Let `p` be a predicate on `box ι`, let `I` be a box. Suppose that the following two properties
hold true.

* Consider a smaller box `J ≤ I`. The hyperplanes passing through the center of `J` split it into
  `2 ^ n` boxes. If `p` holds true on each of these boxes, then it true on `J`.
* For each `z` in the closed box `I.Icc` there exists a neighborhood `U` of `z` within `I.Icc` such
  that for every box `J ≤ I` such that `z ∈ J.Icc ⊆ U`, if `J` is homothetic to `I` with a
  coefficient of the form `1 / 2 ^ m`, then `p` is true on `J`.

Then `p I` is true. See also `box_integral.box.subbox_induction_on'` for a version using
`box_integral.box.split_center_box` instead of `box_integral.prepartition.split_center`. -/
@[elab_as_eliminator]
lemma subbox_induction_on {p : box ι → Prop} (I : box ι)
  (H_ind : ∀ J ≤ I, (∀ J' ∈ split_center J, p J') → p J)
  (H_nhds : ∀ z ∈ I.Icc, ∃ (U ∈ 𝓝[I.Icc] z), ∀ (J ≤ I) (m : ℕ), z ∈ J.Icc → J.Icc ⊆ U →
    (∀ i, J.upper i - J.lower i = (I.upper i - I.lower i) / 2 ^ m) → p J) :
  p I :=
begin
  refine subbox_induction_on' I (λ J hle hs, H_ind J hle $ λ J' h', _) H_nhds,
  rcases mem_split_center.1 h' with ⟨s, rfl⟩,
  exact hs s
end

/-- Given a box `I` in `ℝⁿ` and a function `r : ℝⁿ → (0, ∞)`, there exists a tagged partition `π` of
`I` such that

* `π` is a Henstock partition;
* `π` is subordinate to `r`;
* each box in `π` is homothetic to `I` with coefficient of the form `1 / 2 ^ m`.

This lemma implies that the Henstock filter is nontrivial, hence the Henstock integral is
well-defined. -/
lemma exists_tagged_partition_is_Henstock_is_subordinate_homothetic (I : box ι)
  (r : (ι → ℝ) → Ioi (0 : ℝ)) :
  ∃ π : tagged_prepartition I, π.is_partition ∧ π.is_Henstock ∧ π.is_subordinate r ∧
    (∀ J ∈ π, ∃ m : ℕ, ∀ i, (J : _).upper i - J.lower i = (I.upper i - I.lower i) / 2 ^ m) ∧
    π.distortion = I.distortion :=
begin
  refine subbox_induction_on I (λ J hle hJ, _) (λ z hz, _),
  { choose! πi hP hHen hr Hn Hd using hJ, choose! n hn using Hn,
    have hP : ((split_center J).bUnion_tagged πi).is_partition,
      from (is_partition_split_center _).bUnion_tagged hP,
    have hsub : ∀ (J' ∈ (split_center J).bUnion_tagged πi), ∃ n : ℕ, ∀ i,
      (J' : _).upper i - J'.lower i = (J.upper i - J.lower i) / 2 ^ n,
    { intros J' hJ',
      rcases (split_center J).mem_bUnion_tagged.1 hJ' with ⟨J₁, h₁, h₂⟩,
      refine ⟨n J₁ J' + 1, λ i, _⟩,
      simp only [hn J₁ h₁ J' h₂, upper_sub_lower_of_mem_split_center h₁, pow_succ,
        div_div_eq_div_mul] },
    refine ⟨_, hP, is_Henstock_bUnion_tagged.2 hHen, is_subordinate_bUnion_tagged.2 hr, hsub, _⟩,
    refine tagged_prepartition.distortion_of_const _ hP.nonempty_boxes (λ J' h', _),
    rcases hsub J' h' with ⟨n, hn⟩,
    exact box.distortion_eq_of_sub_eq_div hn },
  { refine ⟨I.Icc ∩ closed_ball z (r z),
      inter_mem_nhds_within _ (closed_ball_mem_nhds _ (r z).coe_prop), _⟩,
    intros J Hle n Hmem HIcc Hsub,
    rw set.subset_inter_iff at HIcc,
    refine ⟨single _ _ le_rfl _ Hmem, is_partition_single _, is_Henstock_single _,
      (is_subordinate_single _ _).2 HIcc.2, _, distortion_single _ _⟩,
    simp only [tagged_prepartition.mem_single, forall_eq],
    refine ⟨0, λ i, _⟩, simp }
end

end box

namespace prepartition

open tagged_prepartition finset function

/-- Given a box `I` in `ℝⁿ`, a function `r : ℝⁿ → (0, ∞)`, and a prepartition `π` of `I`, there
exists a tagged prepartition `π'` of `I` such that

* each box of `π'` is included in some box of `π`;
* `π'` is a Henstock partition;
* `π'` is subordinate to `r`;
* `π'` covers exactly the same part of `I` as `π`;
* the distortion of `π'` is equal to the distortion of `π`.
-/
lemma exists_tagged_le_is_Henstock_is_subordinate_Union_eq {I : box ι} (r : (ι → ℝ) → Ioi (0 : ℝ))
  (π : prepartition I) :
  ∃ π' : tagged_prepartition I, π'.to_prepartition ≤ π ∧
    π'.is_Henstock ∧ π'.is_subordinate r ∧ π'.distortion = π.distortion ∧
    π'.Union = π.Union :=
begin
  have := λ J, box.exists_tagged_partition_is_Henstock_is_subordinate_homothetic J r,
  choose! πi πip πiH πir hsub πid, clear hsub,
  refine ⟨π.bUnion_tagged πi, bUnion_le _ _, is_Henstock_bUnion_tagged.2 (λ J _, πiH J),
    is_subordinate_bUnion_tagged.2 (λ J _, πir J), _, π.Union_bUnion_partition (λ J _, πip J)⟩,
  rw [distortion_bUnion_tagged],
  exact sup_congr rfl (λ J _, πid J)
end

/-- Given a prepartition `π` of a box `I` and a function `r : ℝⁿ → (0, ∞)`, `π.to_subordinate r`
is a tagged partition `π'` such that

* each box of `π'` is included in some box of `π`;
* `π'` is a Henstock partition;
* `π'` is subordinate to `r`;
* `π'` covers exactly the same part of `I` as `π`;
* the distortion of `π'` is equal to the distortion of `π`.
-/
def to_subordinate (π : prepartition I) (r : (ι → ℝ) → Ioi (0 : ℝ)) : tagged_prepartition I :=
(π.exists_tagged_le_is_Henstock_is_subordinate_Union_eq r).some

lemma is_Henstock_to_subordinate (π : prepartition I) (r : (ι → ℝ) → Ioi (0 : ℝ)) :
  (π.to_subordinate r).is_Henstock :=
(π.exists_tagged_le_is_Henstock_is_subordinate_Union_eq r).some_spec.2.1

lemma is_subordinate_to_subordinate (π : prepartition I) (r : (ι → ℝ) → Ioi (0 : ℝ)) :
  (π.to_subordinate r).is_subordinate r :=
(π.exists_tagged_le_is_Henstock_is_subordinate_Union_eq r).some_spec.2.2.1

@[simp] lemma distortion_to_subordinate (π : prepartition I) (r : (ι → ℝ) → Ioi (0 : ℝ)) :
  (π.to_subordinate r).distortion = π.distortion :=
(π.exists_tagged_le_is_Henstock_is_subordinate_Union_eq r).some_spec.2.2.2.1

@[simp] lemma Union_to_subordinate (π : prepartition I) (r : (ι → ℝ) → Ioi (0 : ℝ)) :
  (π.to_subordinate r).Union = π.Union :=
(π.exists_tagged_le_is_Henstock_is_subordinate_Union_eq r).some_spec.2.2.2.2

end prepartition

namespace tagged_prepartition

/-- Given a tagged prepartition `π₁`, a prepartition `π₂` that covers exactly `I \ π₁.Union`, and
a function `r : ℝⁿ → (0, ∞)`, returns the union of `π₁` and `π₂.to_subordinate r`. This partition
`π` has the following properties:

* `π` is a partition, i.e. it covers the whole `I`;
* `π₁.boxes ⊆ π.boxes`;
* `π.tag J = π₁.tag J` whenever `J ∈ π₁`;
* `π` is Henstock outside of `π₁`: `π.tag J ∈ J.Icc` whenever `J ∈ π`, `J ∉ π₁`;
* `π` is subordinate to `r` outside of `π₁`;
* the distortion of `π` is equal to the maximum of the distortions of `π₁` and `π₂`.
-/
def union_compl_to_subordinate (π₁ : tagged_prepartition I) (π₂ : prepartition I)
  (hU : π₂.Union = I \ π₁.Union) (r : (ι → ℝ) → Ioi (0 : ℝ)) :
  tagged_prepartition I :=
π₁.disj_union (π₂.to_subordinate r)
  (((π₂.Union_to_subordinate r).trans hU).symm ▸ disjoint_diff)

lemma is_partition_union_compl_to_subordinate (π₁ : tagged_prepartition I) (π₂ : prepartition I)
  (hU : π₂.Union = I \ π₁.Union) (r : (ι → ℝ) → Ioi (0 : ℝ)) :
  is_partition (π₁.union_compl_to_subordinate π₂ hU r) :=
prepartition.is_partition_disj_union_of_eq_diff ((π₂.Union_to_subordinate r).trans hU)

@[simp] lemma union_compl_to_subordinate_boxes (π₁ : tagged_prepartition I) (π₂ : prepartition I)
  (hU : π₂.Union = I \ π₁.Union) (r : (ι → ℝ) → Ioi (0 : ℝ)) :
  (π₁.union_compl_to_subordinate π₂ hU r).boxes = π₁.boxes ∪ (π₂.to_subordinate r).boxes :=
rfl

@[simp] lemma Union_union_compl_to_subordinate_boxes (π₁ : tagged_prepartition I)
  (π₂ : prepartition I) (hU : π₂.Union = I \ π₁.Union) (r : (ι → ℝ) → Ioi (0 : ℝ)) :
  (π₁.union_compl_to_subordinate π₂ hU r).Union = I :=
(is_partition_union_compl_to_subordinate _ _ _ _).Union_eq

@[simp] lemma distortion_union_compl_to_subordinate (π₁ : tagged_prepartition I)
  (π₂ : prepartition I) (hU : π₂.Union = I \ π₁.Union) (r : (ι → ℝ) → Ioi (0 : ℝ)) :
  (π₁.union_compl_to_subordinate π₂ hU r).distortion = max π₁.distortion π₂.distortion :=
by simp [union_compl_to_subordinate]

end tagged_prepartition

end box_integral


import data.real.basic
import data.real.sqrt

open set real

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que la función cuadrado es inyectiva sobre los
-- números no negativos.
-- ----------------------------------------------------------------------

example : inj_on sqrt { x | x ≥ 0 } :=
begin
  intros x hx y hy,
  intro e,
  calc
    x   = (sqrt x)^2 : by finish
    ... = (sqrt y)^2 : congr_arg (λ x, x^2) e
    ... = y          : by finish
end

-- Prueba
-- ======

/-
⊢ inj_on sqrt {x : ℝ | x ≥ 0}
  >> intros x y xnonneg ynonneg,
⊢ inj_on sqrt {x : ℝ | x ≥ 0}
  >> intro e,
e : x.sqrt = y.sqrt
⊢ x = y
  >> calc
  >>   x   = (sqrt x)^2 : by rw sqr_sqrt xnonneg
  >>   ... = (sqrt y)^2 : by rw e
  >>   ... = y          : by rw sqr_sqrt ynonneg,
no goals
-/

-- Comentario: Se ha usado el lema
-- + sqr_sqrt : 0 ≤ x → (sqrt x) ^ 2 = x

-- Comprobación:
variable (x : ℝ)
-- #check @sqr_sqrt x

example : inj_on (λ (x : ℝ), x^2) { x | x ≥ 0 } :=
begin
  intros x xnonneg y ynonneg,
  simp,
  intro e,
  calc
    x   = sqrt (x ^ 2) : by finish
    ... = sqrt (y ^ 2) : by rw e
    ... = y            : by finish
end

-- Prueba
-- ======

/-
⊢ inj_on (λ (x : ℝ), x ^ 2) {x : ℝ | x ≥ 0}
  >> intros x y xnonneg ynonneg,
x y : ℝ,
xnonneg : x ∈ {x : ℝ | x ≥ 0},
ynonneg : y ∈ {x : ℝ | x ≥ 0}
⊢ (λ (x : ℝ), x ^ 2) x = (λ (x : ℝ), x ^ 2) y → x = y
  >> simp,
⊢ x ^ 2 = y ^ 2 → x = y
  >> intro e,
e : x ^ 2 = y ^ 2
⊢ x = y
  >> calc
  >>   x   = sqrt (x ^ 2) : by rw sqrt_sqr xnonneg
  >>   ... = sqrt (y ^ 2) : by rw e
  >>   ... = y            : by rw sqrt_sqr ynonneg,
no goals
-/

-- Comentario: Se ha usado el lema
-- + sqrt_sqr : 0 ≤ x → (x ^ 2).sqrt = x

-- #check @sqrt_sqr x


import mynat.definition -- hide
import mynat.add -- hide
import game.world2.level1 -- hide
namespace mynat -- hide

/-
# Addition world

Don't forget to use the drop down boxes on the left to see your tactics and
what you have proved so far.

## Level 2: `add_assoc` -- associativity of addition.

It's well-known that (1 + 2) + 3 = 1 + (2 + 3) -- if we have three numbers
to add up, it doesn't matter which of the additions we do first. This fact
is called *associativity of addition* by mathematicians, and it is *not*
obvious. For example, subtraction really is not associative: $(6 - 2) - 1$
is really not equal to $6 - (2 - 1)$. We are going to have to prove
that addition, as defined the way we've defined it, is associative.

See if you can prove associativity of addition. Hint: because addition was defined
by recursion on the right-most variable, use induction on the right-most
variable (try other variables at your peril!). Note that when Lean writes `a + b + c`,
it means `(a + b) + c`. If it wants to talk about `a + (b + c)` it will put the brackets
in explictly.

Reminder: you are done when you see "Proof complete!" in the top right, and an empty
box (no errors) in the bottom right. You can move between levels and worlds (i.e. you
can go back and review old stuff) without losing anything.

Once you're done with associativity (sub-boss), we can move on to commutativity (boss).
-/

/- Lemma
On the set of natural numbers, addition is associative.
In other words, for all natural numbers $a, b$ and $c$, we have
$$ (a + b) + c = a + (b + c). $$
-/
lemma add_assoc (a b c : mynat) : (a + b) + c = a + (b + c) :=
begin [nat_num_game]
  induction c with d hd,
  { -- ⊢ a + b + 0 = a + (b + 0)
    rw add_zero,
    rw add_zero,
    refl
  },
  { -- ⊢ (a + b) + succ d = a + (b + succ d)
    rw add_succ,
    rw add_succ,
    rw add_succ,
    rw hd,
    refl,
  }
end

end mynat -- hide


/-
Copyright (c) 2017 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Buzzard, Mario Carneiro
-/
import data.real.sqrt

/-!
# The complex numbers

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

The complex numbers are modelled as ℝ^2 in the obvious way and it is shown that they form a field
of characteristic zero. The result that the complex numbers are algebraically closed, see
`field_theory.algebraic_closure`.
-/

open_locale big_operators
open set function

/-! ### Definition and basic arithmmetic -/

/-- Complex numbers consist of two `real`s: a real part `re` and an imaginary part `im`. -/
structure complex : Type :=
(re : ℝ) (im : ℝ)

notation `ℂ` := complex

namespace complex

open_locale complex_conjugate

noncomputable instance : decidable_eq ℂ := classical.dec_eq _

/-- The equivalence between the complex numbers and `ℝ × ℝ`. -/
@[simps apply]
def equiv_real_prod : ℂ ≃ (ℝ × ℝ) :=
{ to_fun := λ z, ⟨z.re, z.im⟩,
  inv_fun := λ p, ⟨p.1, p.2⟩,
  left_inv := λ ⟨x, y⟩, rfl,
  right_inv := λ ⟨x, y⟩, rfl }

@[simp] theorem eta : ∀ z : ℂ, complex.mk z.re z.im = z
| ⟨a, b⟩ := rfl

@[ext]
theorem ext : ∀ {z w : ℂ}, z.re = w.re → z.im = w.im → z = w
| ⟨zr, zi⟩ ⟨_, _⟩ rfl rfl := rfl

theorem ext_iff {z w : ℂ} : z = w ↔ z.re = w.re ∧ z.im = w.im :=
⟨λ H, by simp [H], λ h, ext h.1 h.2⟩

theorem re_surjective : surjective re := λ x, ⟨⟨x, 0⟩, rfl⟩
theorem im_surjective : surjective im := λ y, ⟨⟨0, y⟩, rfl⟩

@[simp] theorem range_re : range re = univ := re_surjective.range_eq
@[simp] theorem range_im : range im = univ := im_surjective.range_eq

instance : has_coe ℝ ℂ := ⟨λ r, ⟨r, 0⟩⟩

@[simp, norm_cast] lemma of_real_re (r : ℝ) : (r : ℂ).re = r := rfl
@[simp, norm_cast] lemma of_real_im (r : ℝ) : (r : ℂ).im = 0 := rfl
lemma of_real_def (r : ℝ) : (r : ℂ) = ⟨r, 0⟩ := rfl

@[simp, norm_cast] theorem of_real_inj {z w : ℝ} : (z : ℂ) = w ↔ z = w :=
⟨congr_arg re, congr_arg _⟩

theorem of_real_injective : function.injective (coe : ℝ → ℂ) :=
λ z w, congr_arg re

instance can_lift : can_lift ℂ ℝ coe (λ z, z.im = 0) :=
{ prf := λ z hz, ⟨z.re, ext rfl hz.symm⟩ }

/-- The product of a set on the real axis and a set on the imaginary axis of the complex plane,
denoted by `s ×ℂ t`. -/
def _root_.set.re_prod_im (s t : set ℝ) : set ℂ := re ⁻¹' s ∩ im ⁻¹' t

infix ` ×ℂ `:72 := set.re_prod_im

lemma mem_re_prod_im {z : ℂ} {s t : set ℝ} : z ∈ s ×ℂ t ↔ z.re ∈ s ∧ z.im ∈ t := iff.rfl

instance : has_zero ℂ := ⟨(0 : ℝ)⟩
instance : inhabited ℂ := ⟨0⟩

@[simp] lemma zero_re : (0 : ℂ).re = 0 := rfl
@[simp] lemma zero_im : (0 : ℂ).im = 0 := rfl
@[simp, norm_cast] lemma of_real_zero : ((0 : ℝ) : ℂ) = 0 := rfl

@[simp] theorem of_real_eq_zero {z : ℝ} : (z : ℂ) = 0 ↔ z = 0 := of_real_inj
theorem of_real_ne_zero {z : ℝ} : (z : ℂ) ≠ 0 ↔ z ≠ 0 := not_congr of_real_eq_zero

instance : has_one ℂ := ⟨(1 : ℝ)⟩

@[simp] lemma one_re : (1 : ℂ).re = 1 := rfl
@[simp] lemma one_im : (1 : ℂ).im = 0 := rfl
@[simp, norm_cast] lemma of_real_one : ((1 : ℝ) : ℂ) = 1 := rfl

@[simp] theorem of_real_eq_one {z : ℝ} : (z : ℂ) = 1 ↔ z = 1 := of_real_inj
theorem of_real_ne_one {z : ℝ} : (z : ℂ) ≠ 1 ↔ z ≠ 1 := not_congr of_real_eq_one

instance : has_add ℂ := ⟨λ z w, ⟨z.re + w.re, z.im + w.im⟩⟩

@[simp] lemma add_re (z w : ℂ) : (z + w).re = z.re + w.re := rfl
@[simp] lemma add_im (z w : ℂ) : (z + w).im = z.im + w.im := rfl

@[simp] lemma bit0_re (z : ℂ) : (bit0 z).re = bit0 z.re := rfl
@[simp] lemma bit1_re (z : ℂ) : (bit1 z).re = bit1 z.re := rfl
@[simp] lemma bit0_im (z : ℂ) : (bit0 z).im = bit0 z.im := eq.refl _
@[simp] lemma bit1_im (z : ℂ) : (bit1 z).im = bit0 z.im := add_zero _

@[simp, norm_cast] lemma of_real_add (r s : ℝ) : ((r + s : ℝ) : ℂ) = r + s :=
ext_iff.2 $ by simp

@[simp, norm_cast] lemma of_real_bit0 (r : ℝ) : ((bit0 r : ℝ) : ℂ) = bit0 r :=
ext_iff.2 $ by simp [bit0]

@[simp, norm_cast] lemma of_real_bit1 (r : ℝ) : ((bit1 r : ℝ) : ℂ) = bit1 r :=
ext_iff.2 $ by simp [bit1]

instance : has_neg ℂ := ⟨λ z, ⟨-z.re, -z.im⟩⟩

@[simp] lemma neg_re (z : ℂ) : (-z).re = -z.re := rfl
@[simp] lemma neg_im (z : ℂ) : (-z).im = -z.im := rfl
@[simp, norm_cast] lemma of_real_neg (r : ℝ) : ((-r : ℝ) : ℂ) = -r := ext_iff.2 $ by simp

instance : has_sub ℂ := ⟨λ z w, ⟨z.re - w.re, z.im - w.im⟩⟩

instance : has_mul ℂ := ⟨λ z w, ⟨z.re * w.re - z.im * w.im, z.re * w.im + z.im * w.re⟩⟩

@[simp] lemma mul_re (z w : ℂ) : (z * w).re = z.re * w.re - z.im * w.im := rfl
@[simp] lemma mul_im (z w : ℂ) : (z * w).im = z.re * w.im + z.im * w.re := rfl
@[simp, norm_cast] lemma of_real_mul (r s : ℝ) : ((r * s : ℝ) : ℂ) = r * s := ext_iff.2 $ by simp

lemma of_real_mul_re (r : ℝ) (z : ℂ) : (↑r * z).re = r * z.re := by simp
lemma of_real_mul_im (r : ℝ) (z : ℂ) : (↑r * z).im = r * z.im := by simp
lemma of_real_mul' (r : ℝ) (z : ℂ) : (↑r * z) = ⟨r * z.re, r * z.im⟩ :=
ext (of_real_mul_re _ _) (of_real_mul_im _ _)

/-! ### The imaginary unit, `I` -/

/-- The imaginary unit. -/
def I : ℂ := ⟨0, 1⟩

@[simp] lemma I_re : I.re = 0 := rfl
@[simp] lemma I_im : I.im = 1 := rfl

@[simp] lemma I_mul_I : I * I = -1 := ext_iff.2 $ by simp
lemma I_mul (z : ℂ) : I * z = ⟨-z.im, z.re⟩ :=
ext_iff.2 $ by simp

lemma I_ne_zero : (I : ℂ) ≠ 0 := mt (congr_arg im) zero_ne_one.symm

lemma mk_eq_add_mul_I (a b : ℝ) : complex.mk a b = a + b * I :=
ext_iff.2 $ by simp

@[simp] lemma re_add_im (z : ℂ) : (z.re : ℂ) + z.im * I = z :=
ext_iff.2 $ by simp

lemma mul_I_re (z : ℂ) : (z * I).re = -z.im := by simp
lemma mul_I_im (z : ℂ) : (z * I).im = z.re := by simp
lemma I_mul_re (z : ℂ) : (I * z).re = -z.im := by simp
lemma I_mul_im (z : ℂ) : (I * z).im = z.re := by simp

@[simp] lemma equiv_real_prod_symm_apply (p : ℝ × ℝ) :
  equiv_real_prod.symm p = p.1 + p.2 * I :=
by { ext; simp [equiv_real_prod] }

/-! ### Commutative ring instance and lemmas -/

/- We use a nonstandard formula for the `ℕ` and `ℤ` actions to make sure there is no
diamond from the other actions they inherit through the `ℝ`-action on `ℂ` and action transitivity
defined in `data.complex.module.lean`. -/

instance : nontrivial ℂ := pullback_nonzero re rfl rfl

instance : add_comm_group ℂ :=
by refine_struct
  { zero := (0 : ℂ),
    add := (+),
    neg := has_neg.neg,
    sub := has_sub.sub,
    nsmul := λ n z, ⟨n • z.re - 0 * z.im, n • z.im + 0 * z.re⟩,
    zsmul := λ n z, ⟨n • z.re - 0 * z.im, n • z.im + 0 * z.re⟩ };
intros; try { refl }; apply ext_iff.2; split; simp; {ring1 <|> ring_nf}

instance : add_group_with_one ℂ :=
{ nat_cast := λ n, ⟨n, 0⟩,
  nat_cast_zero := by ext; simp [nat.cast],
  nat_cast_succ := λ _, by ext; simp [nat.cast],
  int_cast := λ n, ⟨n, 0⟩,
  int_cast_of_nat := λ _, by ext; simp [λ n, show @coe ℕ ℂ ⟨_⟩ n = ⟨n, 0⟩, from rfl],
  int_cast_neg_succ_of_nat := λ _, by ext; simp [λ n, show @coe ℕ ℂ ⟨_⟩ n = ⟨n, 0⟩, from rfl],
  one := 1,
  .. complex.add_comm_group }

instance : comm_ring ℂ :=
by refine_struct
  { zero := (0 : ℂ),
    add := (+),
    one := 1,
    mul := (*),
    npow := @npow_rec _ ⟨(1 : ℂ)⟩ ⟨(*)⟩,
    .. complex.add_group_with_one };
intros; try { refl }; apply ext_iff.2; split; simp; {ring1 <|> ring_nf}

/-- This shortcut instance ensures we do not find `ring` via the noncomputable `complex.field`
instance. -/
instance : ring ℂ := by apply_instance

/-- This shortcut instance ensures we do not find `comm_semiring` via the noncomputable
`complex.field` instance. -/
instance : comm_semiring ℂ := infer_instance

/-- The "real part" map, considered as an additive group homomorphism. -/
def re_add_group_hom : ℂ →+ ℝ :=
{ to_fun := re,
  map_zero' := zero_re,
  map_add' := add_re }

@[simp] lemma coe_re_add_group_hom : (re_add_group_hom : ℂ → ℝ) = re := rfl

/-- The "imaginary part" map, considered as an additive group homomorphism. -/
def im_add_group_hom : ℂ →+ ℝ :=
{ to_fun := im,
  map_zero' := zero_im,
  map_add' := add_im }

@[simp] lemma coe_im_add_group_hom : (im_add_group_hom : ℂ → ℝ) = im := rfl

@[simp] lemma I_pow_bit0 (n : ℕ) : I ^ (bit0 n) = (-1) ^ n :=
by rw [pow_bit0', I_mul_I]

@[simp] lemma I_pow_bit1 (n : ℕ) : I ^ (bit1 n) = (-1) ^ n * I :=
by rw [pow_bit1', I_mul_I]

/-! ### Complex conjugation -/

/-- This defines the complex conjugate as the `star` operation of the `star_ring ℂ`. It
is recommended to use the ring endomorphism version `star_ring_end`, available under the
notation `conj` in the locale `complex_conjugate`. -/
instance : star_ring ℂ :=
{ star := λ z, ⟨z.re, -z.im⟩,
  star_involutive := λ x, by simp only [eta, neg_neg],
  star_mul := λ a b, by ext; simp [add_comm]; ring,
  star_add := λ a b, by ext; simp [add_comm] }

@[simp] lemma conj_re (z : ℂ) : (conj z).re = z.re := rfl
@[simp] lemma conj_im (z : ℂ) : (conj z).im = -z.im := rfl

lemma conj_of_real (r : ℝ) : conj (r : ℂ) = r := ext_iff.2 $ by simp [conj]

@[simp] lemma conj_I : conj I = -I := ext_iff.2 $ by simp

lemma conj_bit0 (z : ℂ) : conj (bit0 z) = bit0 (conj z) := ext_iff.2 $ by simp [bit0]
lemma conj_bit1 (z : ℂ) : conj (bit1 z) = bit1 (conj z) := ext_iff.2 $ by simp [bit0]

@[simp] lemma conj_neg_I : conj (-I) = I := ext_iff.2 $ by simp

lemma eq_conj_iff_real {z : ℂ} : conj z = z ↔ ∃ r : ℝ, z = r :=
⟨λ h, ⟨z.re, ext rfl $ eq_zero_of_neg_eq (congr_arg im h)⟩,
 λ ⟨h, e⟩, by rw [e, conj_of_real]⟩

lemma eq_conj_iff_re {z : ℂ} : conj z = z ↔ (z.re : ℂ) = z :=
eq_conj_iff_real.trans ⟨by rintro ⟨r, rfl⟩; simp, λ h, ⟨_, h.symm⟩⟩

lemma eq_conj_iff_im {z : ℂ} : conj z = z ↔ z.im = 0 :=
⟨λ h, add_self_eq_zero.mp (neg_eq_iff_add_eq_zero.mp (congr_arg im h)),
  λ h, ext rfl (neg_eq_iff_add_eq_zero.mpr (add_self_eq_zero.mpr h))⟩

-- `simp_nf` complains about this being provable by `is_R_or_C.star_def` even
-- though it's not imported by this file.
@[simp, nolint simp_nf] lemma star_def : (has_star.star : ℂ → ℂ) = conj := rfl

/-! ### Norm squared -/

/-- The norm squared function. -/
@[pp_nodot] def norm_sq : ℂ →*₀ ℝ :=
{ to_fun := λ z, z.re * z.re + z.im * z.im,
  map_zero' := by simp,
  map_one' := by simp,
  map_mul' := λ z w, by { dsimp, ring } }

lemma norm_sq_apply (z : ℂ) : norm_sq z = z.re * z.re + z.im * z.im := rfl

@[simp] lemma norm_sq_of_real (r : ℝ) : norm_sq r = r * r :=
by simp [norm_sq]

@[simp] lemma norm_sq_mk (x y : ℝ) : norm_sq ⟨x, y⟩ = x * x + y * y := rfl

lemma norm_sq_add_mul_I (x y : ℝ) : norm_sq (x + y * I) = x ^ 2 + y ^ 2 :=
by rw [← mk_eq_add_mul_I, norm_sq_mk, sq, sq]

lemma norm_sq_eq_conj_mul_self {z : ℂ} : (norm_sq z : ℂ) = conj z * z :=
by { ext; simp [norm_sq, mul_comm], }

@[simp] lemma norm_sq_zero : norm_sq 0 = 0 := norm_sq.map_zero
@[simp] lemma norm_sq_one : norm_sq 1 = 1 := norm_sq.map_one
@[simp] lemma norm_sq_I : norm_sq I = 1 := by simp [norm_sq]

lemma norm_sq_nonneg (z : ℂ) : 0 ≤ norm_sq z :=
add_nonneg (mul_self_nonneg _) (mul_self_nonneg _)

@[simp] lemma range_norm_sq : range norm_sq = Ici 0 :=
subset.antisymm (range_subset_iff.2 norm_sq_nonneg) $ λ x hx,
  ⟨real.sqrt x, by rw [norm_sq_of_real, real.mul_self_sqrt hx]⟩

lemma norm_sq_eq_zero {z : ℂ} : norm_sq z = 0 ↔ z = 0 :=
⟨λ h, ext
  (eq_zero_of_mul_self_add_mul_self_eq_zero h)
  (eq_zero_of_mul_self_add_mul_self_eq_zero $ (add_comm _ _).trans h),
 λ h, h.symm ▸ norm_sq_zero⟩

@[simp] lemma norm_sq_pos {z : ℂ} : 0 < norm_sq z ↔ z ≠ 0 :=
(norm_sq_nonneg z).lt_iff_ne.trans $ not_congr (eq_comm.trans norm_sq_eq_zero)

@[simp] lemma norm_sq_neg (z : ℂ) : norm_sq (-z) = norm_sq z :=
by simp [norm_sq]

@[simp] lemma norm_sq_conj (z : ℂ) : norm_sq (conj z) = norm_sq z :=
by simp [norm_sq]

lemma norm_sq_mul (z w : ℂ) : norm_sq (z * w) = norm_sq z * norm_sq w :=
norm_sq.map_mul z w

lemma norm_sq_add (z w : ℂ) : norm_sq (z + w) =
  norm_sq z + norm_sq w + 2 * (z * conj w).re :=
by dsimp [norm_sq]; ring

lemma re_sq_le_norm_sq (z : ℂ) : z.re * z.re ≤ norm_sq z :=
le_add_of_nonneg_right (mul_self_nonneg _)

lemma im_sq_le_norm_sq (z : ℂ) : z.im * z.im ≤ norm_sq z :=
le_add_of_nonneg_left (mul_self_nonneg _)

theorem mul_conj (z : ℂ) : z * conj z = norm_sq z :=
ext_iff.2 $ by simp [norm_sq, mul_comm, sub_eq_neg_add, add_comm]

theorem add_conj (z : ℂ) : z + conj z = (2 * z.re : ℝ) :=
ext_iff.2 $ by simp [two_mul]

/-- The coercion `ℝ → ℂ` as a `ring_hom`. -/
def of_real : ℝ →+* ℂ := ⟨coe, of_real_one, of_real_mul, of_real_zero, of_real_add⟩

@[simp] lemma of_real_eq_coe (r : ℝ) : of_real r = r := rfl

@[simp] lemma I_sq : I ^ 2 = -1 := by rw [sq, I_mul_I]

@[simp] lemma sub_re (z w : ℂ) : (z - w).re = z.re - w.re := rfl
@[simp] lemma sub_im (z w : ℂ) : (z - w).im = z.im - w.im := rfl
@[simp, norm_cast] lemma of_real_sub (r s : ℝ) : ((r - s : ℝ) : ℂ) = r - s := ext_iff.2 $ by simp
@[simp, norm_cast] lemma of_real_pow (r : ℝ) (n : ℕ) : ((r ^ n : ℝ) : ℂ) = r ^ n :=
by induction n; simp [*, of_real_mul, pow_succ]

theorem sub_conj (z : ℂ) : z - conj z = (2 * z.im : ℝ) * I :=
ext_iff.2 $ by simp [two_mul, sub_eq_add_neg]

lemma norm_sq_sub (z w : ℂ) : norm_sq (z - w) =
  norm_sq z + norm_sq w - 2 * (z * conj w).re :=
by { rw [sub_eq_add_neg, norm_sq_add],
     simp only [ring_hom.map_neg, mul_neg, neg_re,
                tactic.ring.add_neg_eq_sub, norm_sq_neg] }

/-! ### Inversion -/

noncomputable instance : has_inv ℂ := ⟨λ z, conj z * ((norm_sq z)⁻¹:ℝ)⟩

theorem inv_def (z : ℂ) : z⁻¹ = conj z * ((norm_sq z)⁻¹:ℝ) := rfl
@[simp] lemma inv_re (z : ℂ) : (z⁻¹).re = z.re / norm_sq z := by simp [inv_def, division_def]
@[simp] lemma inv_im (z : ℂ) : (z⁻¹).im = -z.im / norm_sq z := by simp [inv_def, division_def]

@[simp, norm_cast] lemma of_real_inv (r : ℝ) : ((r⁻¹ : ℝ) : ℂ) = r⁻¹ :=
ext_iff.2 $ by simp

protected

protected theorem mul_inv_cancel {z : ℂ} (h : z ≠ 0) : z * z⁻¹ = 1 :=
by rw [inv_def, ← mul_assoc, mul_conj, ← of_real_mul,
  mul_inv_cancel (mt norm_sq_eq_zero.1 h), of_real_one]

/-! ### Field instance and lemmas -/

noncomputable instance : field ℂ :=
{ inv := has_inv.inv,
  mul_inv_cancel := @complex.mul_inv_cancel,
  inv_zero := complex.inv_zero,
  ..complex.comm_ring, ..complex.nontrivial }

@[simp] lemma I_zpow_bit0 (n : ℤ) : I ^ (bit0 n) = (-1) ^ n :=
by rw [zpow_bit0', I_mul_I]

@[simp] lemma I_zpow_bit1 (n : ℤ) : I ^ (bit1 n) = (-1) ^ n * I :=
by rw [zpow_bit1', I_mul_I]

lemma div_re (z w : ℂ) : (z / w).re = z.re * w.re / norm_sq w + z.im * w.im / norm_sq w :=
by simp [div_eq_mul_inv, mul_assoc, sub_eq_add_neg]
lemma div_im (z w : ℂ) : (z / w).im = z.im * w.re / norm_sq w - z.re * w.im / norm_sq w :=
by simp [div_eq_mul_inv, mul_assoc, sub_eq_add_neg, add_comm]

lemma conj_inv (x : ℂ) : conj (x⁻¹) = (conj x)⁻¹ := star_inv' _

@[simp, norm_cast] lemma of_real_div (r s : ℝ) : ((r / s : ℝ) : ℂ) = r / s :=
map_div₀ of_real r s

@[simp, norm_cast] lemma of_real_zpow (r : ℝ) (n : ℤ) : ((r ^ n : ℝ) : ℂ) = (r : ℂ) ^ n :=
map_zpow₀ of_real r n

@[simp] lemma div_I (z : ℂ) : z / I = -(z * I) :=
(div_eq_iff_mul_eq I_ne_zero).2 $ by simp [mul_assoc]

@[simp] lemma inv_I : I⁻¹ = -I :=
by simp [inv_eq_one_div]

@[simp] lemma norm_sq_inv (z : ℂ) : norm_sq z⁻¹ = (norm_sq z)⁻¹ :=
map_inv₀ norm_sq z

@[simp] lemma norm_sq_div (z w : ℂ) : norm_sq (z / w) = norm_sq z / norm_sq w :=
map_div₀ norm_sq z w

/-! ### Cast lemmas -/

@[simp, norm_cast] theorem of_real_nat_cast (n : ℕ) : ((n : ℝ) : ℂ) = n :=
map_nat_cast of_real n

@[simp, norm_cast] lemma nat_cast_re (n : ℕ) : (n : ℂ).re = n :=
by rw [← of_real_nat_cast, of_real_re]

@[simp, norm_cast] lemma nat_cast_im (n : ℕ) : (n : ℂ).im = 0 :=
by rw [← of_real_nat_cast, of_real_im]

@[simp, norm_cast] theorem of_real_int_cast (n : ℤ) : ((n : ℝ) : ℂ) = n := map_int_cast of_real n

@[simp, norm_cast] lemma int_cast_re (n : ℤ) : (n : ℂ).re = n :=
by rw [← of_real_int_cast, of_real_re]

@[simp, norm_cast] lemma int_cast_im (n : ℤ) : (n : ℂ).im = 0 :=
by rw [← of_real_int_cast, of_real_im]

@[simp, norm_cast] theorem of_real_rat_cast (n : ℚ) : ((n : ℝ) : ℂ) = n := map_rat_cast of_real n

@[simp, norm_cast] lemma rat_cast_re (q : ℚ) : (q : ℂ).re = q :=
by rw [← of_real_rat_cast, of_real_re]

@[simp, norm_cast] lemma rat_cast_im (q : ℚ) : (q : ℂ).im = 0 :=
by rw [← of_real_rat_cast, of_real_im]

/-! ### Characteristic zero -/

instance char_zero_complex : char_zero ℂ :=
char_zero_of_inj_zero $ λ n h,
by rwa [← of_real_nat_cast, of_real_eq_zero, nat.cast_eq_zero] at h

/-- A complex number `z` plus its conjugate `conj z` is `2` times its real part. -/
theorem re_eq_add_conj (z : ℂ) : (z.re : ℂ) = (z + conj z) / 2 :=
by simp only [add_conj, of_real_mul, of_real_one, of_real_bit0,
     mul_div_cancel_left (z.re:ℂ) two_ne_zero]

/-- A complex number `z` minus its conjugate `conj z` is `2i` times its imaginary part. -/
theorem im_eq_sub_conj (z : ℂ) : (z.im : ℂ) = (z - conj(z))/(2 * I) :=
by simp only [sub_conj, of_real_mul, of_real_one, of_real_bit0, mul_right_comm,
     mul_div_cancel_left _ (mul_ne_zero two_ne_zero I_ne_zero : 2 * I ≠ 0)]

/-! ### Absolute value -/

namespace abs_theory
-- We develop enough theory to bundle `abs` into an `absolute_value` before making things public;
-- this is so there's not two versions of it hanging around.

local notation (name := abs) `abs` z := ((norm_sq z).sqrt)

private lemma mul_self_abs (z : ℂ) : (abs z) * (abs z) = norm_sq z :=
real.mul_self_sqrt (norm_sq_nonneg _)

private lemma abs_nonneg' (z : ℂ) : 0 ≤ abs z :=
real.sqrt_nonneg _

lemma abs_conj (z : ℂ) : (abs (conj z)) = abs z :=
by simp

private lemma abs_re_le_abs (z : ℂ) : |z.re| ≤ abs z :=
begin
  rw [mul_self_le_mul_self_iff (abs_nonneg z.re) (abs_nonneg' _),
       abs_mul_abs_self, mul_self_abs],
  apply re_sq_le_norm_sq
end

private lemma re_le_abs (z : ℂ) : z.re ≤ abs z :=
(abs_le.1 (abs_re_le_abs _)).2

private lemma abs_mul (z w : ℂ) : (abs (z * w)) = (abs z) * abs w :=
by rw [norm_sq_mul, real.sqrt_mul (norm_sq_nonneg _)]

private lemma abs_add (z w : ℂ) : (abs (z + w)) ≤ (abs z) + abs w :=
(mul_self_le_mul_self_iff (abs_nonneg' (z + w))
  (add_nonneg (abs_nonneg' z) (abs_nonneg' w))).2 $
begin
  rw [mul_self_abs, add_mul_self_eq, mul_self_abs, mul_self_abs, add_right_comm, norm_sq_add,
      add_le_add_iff_left, mul_assoc, mul_le_mul_left (zero_lt_two' ℝ),
      ←real.sqrt_mul $ norm_sq_nonneg z, ←norm_sq_conj w, ←map_mul],
  exact re_le_abs (z * conj w)
end

/-- The complex absolute value function, defined as the square root of the norm squared. -/
noncomputable def _root_.complex.abs : absolute_value ℂ ℝ :=
{ to_fun := λ x, abs x,
  map_mul' := abs_mul,
  nonneg' := abs_nonneg',
  eq_zero' := λ _, (real.sqrt_eq_zero $ norm_sq_nonneg _).trans norm_sq_eq_zero,
  add_le' := abs_add }

end abs_theory

lemma abs_def : (abs : ℂ → ℝ) = λ z, (norm_sq z).sqrt := rfl
lemma abs_apply {z : ℂ} : abs z = (norm_sq z).sqrt := rfl

@[simp, norm_cast] lemma abs_of_real (r : ℝ) : abs r = |r| :=
by simp [abs, norm_sq_of_real, real.sqrt_mul_self_eq_abs]

lemma abs_of_nonneg {r : ℝ} (h : 0 ≤ r) : abs r = r :=
(abs_of_real _).trans (abs_of_nonneg h)

lemma abs_of_nat (n : ℕ) : complex.abs n = n :=
calc complex.abs n = complex.abs (n:ℝ) : by rw [of_real_nat_cast]
  ... = _ : abs_of_nonneg (nat.cast_nonneg n)

lemma mul_self_abs (z : ℂ) : abs z * abs z = norm_sq z :=
real.mul_self_sqrt (norm_sq_nonneg _)

lemma sq_abs (z : ℂ) : abs z ^ 2 = norm_sq z :=
real.sq_sqrt (norm_sq_nonneg _)

@[simp] lemma sq_abs_sub_sq_re (z : ℂ) : abs z ^ 2 - z.re ^ 2 = z.im ^ 2 :=
by rw [sq_abs, norm_sq_apply, ← sq, ← sq, add_sub_cancel']

@[simp] lemma sq_abs_sub_sq_im (z : ℂ) : abs z ^ 2 - z.im ^ 2 = z.re ^ 2 :=
by rw [← sq_abs_sub_sq_re, sub_sub_cancel]

@[simp] lemma abs_I : abs I = 1 := by simp [abs]

@[simp] lemma abs_two : abs 2 = 2 :=
calc abs 2 = abs (2 : ℝ) : by rw [of_real_bit0, of_real_one]
... = (2 : ℝ) : abs_of_nonneg (by norm_num)

@[simp] lemma range_abs : range abs = Ici 0 :=
subset.antisymm (range_subset_iff.2 abs.nonneg) $ λ x hx, ⟨x, abs_of_nonneg hx⟩

@[simp] lemma abs_conj (z : ℂ) : abs (conj z) = abs z := abs_theory.abs_conj z

@[simp] lemma abs_prod {ι : Type*} (s : finset ι) (f : ι → ℂ) :
  abs (s.prod f) = s.prod (λ i, abs (f i)) :=
map_prod abs _ _

@[simp] lemma abs_pow (z : ℂ) (n : ℕ) : abs (z ^ n) = abs z ^ n :=
map_pow abs z n

@[simp] lemma abs_zpow (z : ℂ) (n : ℤ) : abs (z ^ n) = abs z ^ n :=
map_zpow₀ abs z n

lemma abs_re_le_abs (z : ℂ) : |z.re| ≤ abs z :=
real.abs_le_sqrt $ by { rw [norm_sq_apply, ← sq], exact le_add_of_nonneg_right (mul_self_nonneg _) }

lemma abs_im_le_abs (z : ℂ) : |z.im| ≤ abs z :=
real.abs_le_sqrt $ by { rw [norm_sq_apply, ← sq, ← sq], exact le_add_of_nonneg_left (sq_nonneg _) }

lemma re_le_abs (z : ℂ) : z.re ≤ abs z :=
(abs_le.1 (abs_re_le_abs _)).2

lemma im_le_abs (z : ℂ) : z.im ≤ abs z :=
(abs_le.1 (abs_im_le_abs _)).2

@[simp] lemma abs_re_lt_abs {z : ℂ} : |z.re| < abs z ↔ z.im ≠ 0 :=
by rw [abs, absolute_value.coe_mk, mul_hom.coe_mk, real.lt_sqrt (abs_nonneg _), norm_sq_apply,
       _root_.sq_abs, ← sq, lt_add_iff_pos_right, mul_self_pos]

@[simp] lemma abs_im_lt_abs {z : ℂ} : |z.im| < abs z ↔ z.re ≠ 0 :=
by simpa using @abs_re_lt_abs (z * I)

@[simp] lemma abs_abs (z : ℂ) : |(abs z)| = abs z :=
_root_.abs_of_nonneg (abs.nonneg _)

lemma abs_le_abs_re_add_abs_im (z : ℂ) : abs z ≤ |z.re| + |z.im| :=
by simpa [re_add_im] using abs.add_le z.re (z.im * I)

lemma abs_le_sqrt_two_mul_max (z : ℂ) : abs z ≤ real.sqrt 2 * max (|z.re|) (|z.im|) :=
begin
  cases z with x y,
  simp only [abs_apply, norm_sq_mk, ← sq],
  wlog hle : |x| ≤ |y|,
  { rw [add_comm, max_comm], exact this _ _ (le_of_not_le hle), },
  calc real.sqrt (x ^ 2 + y ^ 2) ≤ real.sqrt (y ^ 2 + y ^ 2) :
    real.sqrt_le_sqrt (add_le_add_right (sq_le_sq.2 hle) _)
  ... = real.sqrt 2 * max (|x|) (|y|) :
    by rw [max_eq_right hle, ← two_mul, real.sqrt_mul two_pos.le, real.sqrt_sq_eq_abs],
end

lemma abs_re_div_abs_le_one (z : ℂ) : |z.re / z.abs| ≤ 1 :=
if hz : z = 0 then by simp [hz, zero_le_one]
else by { simp_rw [_root_.abs_div, abs_abs, div_le_iff (abs.pos hz), one_mul, abs_re_le_abs] }

lemma abs_im_div_abs_le_one (z : ℂ) : |z.im / z.abs| ≤ 1 :=
if hz : z = 0 then by simp [hz, zero_le_one]
else by { simp_rw [_root_.abs_div, abs_abs, div_le_iff (abs.pos hz), one_mul, abs_im_le_abs] }

@[simp, norm_cast] lemma abs_cast_nat (n : ℕ) : abs (n : ℂ) = n :=
by rw [← of_real_nat_cast, abs_of_nonneg (nat.cast_nonneg n)]

@[simp, norm_cast] lemma int_cast_abs (n : ℤ) : ↑|n| = abs n :=
by rw [← of_real_int_cast, abs_of_real, int.cast_abs]

lemma norm_sq_eq_abs (x : ℂ) : norm_sq x = abs x ^ 2 :=
by simp [abs, sq, real.mul_self_sqrt (norm_sq_nonneg _)]

/--
We put a partial order on ℂ so that `z ≤ w` exactly if `w - z` is real and nonnegative.
Complex numbers with different imaginary parts are incomparable.
-/
protected def partial_order : partial_order ℂ :=
{ le := λ z w, z.re ≤ w.re ∧ z.im = w.im,
  lt := λ z w, z.re < w.re ∧ z.im = w.im,
  lt_iff_le_not_le := λ z w, by { dsimp, rw lt_iff_le_not_le, tauto },
  le_refl := λ x, ⟨le_rfl, rfl⟩,
  le_trans := λ x y z h₁ h₂, ⟨h₁.1.trans h₂.1, h₁.2.trans h₂.2⟩,
  le_antisymm := λ z w h₁ h₂, ext (h₁.1.antisymm h₂.1) h₁.2 }

section complex_order

localized "attribute [instance] complex.partial_order" in complex_order

lemma le_def {z w : ℂ} : z ≤ w ↔ z.re ≤ w.re ∧ z.im = w.im := iff.rfl
lemma lt_def {z w : ℂ} : z < w ↔ z.re < w.re ∧ z.im = w.im := iff.rfl

@[simp, norm_cast] lemma real_le_real {x y : ℝ} : (x : ℂ) ≤ (y : ℂ) ↔ x ≤ y := by simp [le_def]

@[simp, norm_cast] lemma real_lt_real {x y : ℝ} : (x : ℂ) < (y : ℂ) ↔ x < y := by simp [lt_def]

@[simp, norm_cast] lemma zero_le_real {x : ℝ} : (0 : ℂ) ≤ (x : ℂ) ↔ 0 ≤ x := real_le_real
@[simp, norm_cast] lemma zero_lt_real {x : ℝ} : (0 : ℂ) < (x : ℂ) ↔ 0 < x := real_lt_real

lemma not_le_iff {z w : ℂ} : ¬(z ≤ w) ↔ w.re < z.re ∨ z.im ≠ w.im :=
by rw [le_def, not_and_distrib, not_le]

lemma not_lt_iff {z w : ℂ} : ¬(z < w) ↔ w.re ≤ z.re ∨ z.im ≠ w.im :=
by rw [lt_def, not_and_distrib, not_lt]

lemma not_le_zero_iff {z : ℂ} : ¬z ≤ 0 ↔ 0 < z.re ∨ z.im ≠ 0 := not_le_iff
lemma not_lt_zero_iff {z : ℂ} : ¬z < 0 ↔ 0 ≤ z.re ∨ z.im ≠ 0 := not_lt_iff

lemma eq_re_of_real_le {r : ℝ} {z : ℂ} (hz : (r : ℂ) ≤ z) : z = z.re :=
by { ext, refl, simp only [←(complex.le_def.1 hz).2, complex.zero_im, complex.of_real_im] }

/--
With `z ≤ w` iff `w - z` is real and nonnegative, `ℂ` is a strictly ordered ring.
-/
protected def strict_ordered_comm_ring : strict_ordered_comm_ring ℂ :=
{ zero_le_one := ⟨zero_le_one, rfl⟩,
  add_le_add_left := λ w z h y, ⟨add_le_add_left h.1 _, congr_arg2 (+) rfl h.2⟩,
  mul_pos := λ z w hz hw,
    by simp [lt_def, mul_re, mul_im, ← hz.2, ← hw.2, mul_pos hz.1 hw.1],
  ..complex.partial_order, ..complex.comm_ring, ..complex.nontrivial }

localized "attribute [instance] complex.strict_ordered_comm_ring" in complex_order

/--
With `z ≤ w` iff `w - z` is real and nonnegative, `ℂ` is a star ordered ring.
(That is, a star ring in which the nonnegative elements are those of the form `star z * z`.)
-/
protected def star_ordered_ring : star_ordered_ring ℂ :=
{ nonneg_iff := λ r, by
  { refine ⟨λ hr, ⟨real.sqrt r.re, _⟩, λ h, _⟩,
    { have h₁ : 0 ≤ r.re := by { rw [le_def] at hr, exact hr.1 },
      have h₂ : r.im = 0 := by { rw [le_def] at hr, exact hr.2.symm },
      ext,
      { simp only [of_real_im, star_def, of_real_re, sub_zero, conj_re, mul_re, mul_zero,
                   ←real.sqrt_mul h₁ r.re, real.sqrt_mul_self h₁] },
      { simp only [h₂, add_zero, of_real_im, star_def, zero_mul, conj_im,
                   mul_im, mul_zero, neg_zero] } },
    { obtain ⟨s, rfl⟩ := h,
      simp only [←norm_sq_eq_conj_mul_self, norm_sq_nonneg, zero_le_real, star_def] } },
  ..complex.strict_ordered_comm_ring }

localized "attribute [instance] complex.star_ordered_ring" in complex_order

end complex_order

/-! ### Cauchy sequences -/

local notation `abs'` := has_abs.abs

theorem is_cau_seq_re (f : cau_seq ℂ abs) : is_cau_seq abs' (λ n, (f n).re) :=
λ ε ε0, (f.cauchy ε0).imp $ λ i H j ij,
lt_of_le_of_lt (by simpa using abs_re_le_abs (f j - f i)) (H _ ij)

theorem is_cau_seq_im (f : cau_seq ℂ abs) : is_cau_seq abs' (λ n, (f n).im) :=
λ ε ε0, (f.cauchy ε0).imp $ λ i H j ij,
lt_of_le_of_lt (by simpa using abs_im_le_abs (f j - f i)) (H _ ij)

/-- The real part of a complex Cauchy sequence, as a real Cauchy sequence. -/
noncomputable def cau_seq_re (f : cau_seq ℂ abs) : cau_seq ℝ abs' :=
⟨_, is_cau_seq_re f⟩

/-- The imaginary part of a complex Cauchy sequence, as a real Cauchy sequence. -/
noncomputable def cau_seq_im (f : cau_seq ℂ abs) : cau_seq ℝ abs' :=
⟨_, is_cau_seq_im f⟩

lemma is_cau_seq_abs {f : ℕ → ℂ} (hf : is_cau_seq abs f) :
  is_cau_seq abs' (abs ∘ f) :=
λ ε ε0, let ⟨i, hi⟩ := hf ε ε0 in
⟨i, λ j hj, lt_of_le_of_lt (abs.abs_abv_sub_le_abv_sub _ _) (hi j hj)⟩

/-- The limit of a Cauchy sequence of complex numbers. -/
noncomputable def lim_aux (f : cau_seq ℂ abs) : ℂ :=
⟨cau_seq.lim (cau_seq_re f), cau_seq.lim (cau_seq_im f)⟩

theorem equiv_lim_aux (f : cau_seq ℂ abs) : f ≈ cau_seq.const abs (lim_aux f) :=
λ ε ε0, (exists_forall_ge_and
  (cau_seq.equiv_lim ⟨_, is_cau_seq_re f⟩ _ (half_pos ε0))
  (cau_seq.equiv_lim ⟨_, is_cau_seq_im f⟩ _ (half_pos ε0))).imp $
λ i H j ij, begin
  cases H _ ij with H₁ H₂,
  apply lt_of_le_of_lt (abs_le_abs_re_add_abs_im _),
  dsimp [lim_aux] at *,
  have := add_lt_add H₁ H₂,
  rwa add_halves at this,
end

instance : cau_seq.is_complete ℂ abs :=
⟨λ f, ⟨lim_aux f, equiv_lim_aux f⟩⟩

open cau_seq

lemma lim_eq_lim_im_add_lim_re (f : cau_seq ℂ abs) : lim f =
  ↑(lim (cau_seq_re f)) + ↑(lim (cau_seq_im f)) * I :=
lim_eq_of_equiv_const $
calc f ≈ _ : equiv_lim_aux f
... = cau_seq.const abs (↑(lim (cau_seq_re f)) + ↑(lim (cau_seq_im f)) * I) :
  cau_seq.ext (λ _, complex.ext (by simp [lim_aux, cau_seq_re]) (by simp [lim_aux, cau_seq_im]))

lemma lim_re (f : cau_seq ℂ abs) : lim (cau_seq_re f) = (lim f).re :=
by rw [lim_eq_lim_im_add_lim_re]; simp

lemma lim_im (f : cau_seq ℂ abs) : lim (cau_seq_im f) = (lim f).im :=
by rw [lim_eq_lim_im_add_lim_re]; simp

lemma is_cau_seq_conj (f : cau_seq ℂ abs) : is_cau_seq abs (λ n, conj (f n)) :=
λ ε ε0, let ⟨i, hi⟩ := f.2 ε ε0 in
⟨i, λ j hj, by rw [← ring_hom.map_sub, abs_conj]; exact hi j hj⟩

/-- The complex conjugate of a complex Cauchy sequence, as a complex Cauchy sequence. -/
noncomputable def cau_seq_conj (f : cau_seq ℂ abs) : cau_seq ℂ abs :=
⟨_, is_cau_seq_conj f⟩

lemma lim_conj (f : cau_seq ℂ abs) : lim (cau_seq_conj f) = conj (lim f) :=
complex.ext (by simp [cau_seq_conj, (lim_re _).symm, cau_seq_re])
  (by simp [cau_seq_conj, (lim_im _).symm, cau_seq_im, (lim_neg _).symm]; refl)

/-- The absolute value of a complex Cauchy sequence, as a real Cauchy sequence. -/
noncomputable def cau_seq_abs (f : cau_seq ℂ abs) : cau_seq ℝ abs' :=
⟨_, is_cau_seq_abs f.2⟩

lemma lim_abs (f : cau_seq ℂ abs) : lim (cau_seq_abs f) = abs (lim f) :=
lim_eq_of_equiv_const (λ ε ε0,
let ⟨i, hi⟩ := equiv_lim f ε ε0 in
⟨i, λ j hj, lt_of_le_of_lt (abs.abs_abv_sub_le_abv_sub _ _) (hi j hj)⟩)

variables {α : Type*} (s : finset α)

@[simp, norm_cast] lemma of_real_prod (f : α → ℝ) :
  ((∏ i in s, f i : ℝ) : ℂ) = ∏ i in s, (f i : ℂ) :=
ring_hom.map_prod of_real _ _

@[simp, norm_cast] lemma of_real_sum (f : α → ℝ) :
  ((∑ i in s, f i : ℝ) : ℂ) = ∑ i in s, (f i : ℂ) :=
ring_hom.map_sum of_real _ _

@[simp] lemma re_sum (f : α → ℂ) : (∑ i in s, f i).re = ∑ i in s, (f i).re :=
re_add_group_hom.map_sum f s

@[simp] lemma im_sum (f : α → ℂ) : (∑ i in s, f i).im = ∑ i in s, (f i).im :=
im_add_group_hom.map_sum f s

end complex


-- Отношения

universe u
variables α β : Type u                              -- Рассмотрим некоторый произвольный тип α
variable r : α → α → Prop                           -- Введем на нем бинарное отноешние r

variable trans_r : ∀ {x y z : α},                   -- мы можем объявить его транзитивным, указав следующий факт
                     r x y → r y z → r x z

variables a b c : α                                 -- тогда имея набор переменных типа α
variables (hab : r a b) (hbc : r b c)               -- и утверждений о связи их отношениями
#check trans_r hab hbc -- r a c                     -- мы можем вывести новое отношение r a c

variable refl_r : ∀ {x : α}, r x x                  -- рефлексивность r
variable symm_r : ∀ {x y : α}, r x y → r y x        -- симметричность r
                                                    -- теперь r — отношение эквивалентности

example (a b c d : α) (hab : r a b)                 -- данными утверждениями можно воспользоваться, чтоб
        (hcb : r c b) (hcd : r c d) : r a d :=      -- доказать наличие r-отношения между a и d
  trans_r (trans_r hab (symm_r hcb)) hcd

-- Эквивалентность

#check @eq.refl  -- ∀ {α : Type u}, α = α           -- эквивалентность, конечно, есть в стандартной библиотеке
#check @eq.symm  -- ∀ {α : Type u} {a b : α},
                 --   a = b → b = a
#check @eq.trans -- ∀ {α : Type u} {a b c : α},
                 --   a = b → b = c → a = c

example (a b c d : α) (hab : a = b)                 -- тот же пример можно вывести из стандартной библиотеки
        (hcb : c = b) (hcd : c = d) : a = d :=
  eq.trans (eq.trans hab (eq.symm hcb)) hcd

example (a b c d : α) (hab : a = b)                 -- тот же пример в projection notation (нечитаемо)
        (hcb : c = b) (hcd : c = d) : a = d :=
  (hab.trans hcb.symm).trans hcd

example (f : α → β) (a : α) : (λ x, f x) a = f a := -- благодаря выполнению редукции такая штука может быть доказана автоматом
  eq.refl _
example (a : α) (b : β) : (a, b).1 = a :=           -- и такая тоже
  eq.refl _
example : 39 + 3 = 42 := eq.refl _                  -- и даже такая

#check @rfl -- ∀ {α : Type u}, {a : α}, a = a       -- для этого даже вводят специальную функцию rfl == eq.refl _
                                                    -- все примеры выше можно переписать через нее

example (a : α) (b : β) : (a, b).1 = a := rfl

#check @eq.subst -- ∀ {a : Type u} {a b : α} {p : α → Prop},
                 --   a = b → p a = p b             -- важное утверждение, что мы можем менять равные элементы
                                                    -- внутри любого предиката

variable p : α → Prop
example (h₁ : a = b) (h₂ : p a) : p b :=            -- пример использования eq.subst
  eq.subst h₁ h₂

example (h₁ : a = b) (h₂ : p a) : p b := h₁ ▸ h₂    -- альтернативный синтаксис для eq.subst (▸ получается через \t)

#check @congr_arg -- ∀ {α : Type u} {β : Type v}    -- аналогично предикатам, замена аргумента может производиться и
                  --   {a₁ a₂ : α} (f : α → β),     -- внутри функции над элементами произвольных вселенных
                  --   a₁ = a₂ → f a₁ = f a₂        -- это называется конгруэнтностью по аргументу

#check @congr_fun -- ∀ {α : Type u} {β : α → Type v}-- при этом заменяться может и сама функцию
                  --   {f g : Π (x : α), β x},
                  --   f = g → ∀ x : α, f a = g a

#check @congr     -- ∀ {α : Type u} {β : Type v}    -- или даже функцию и аргумент одновременно
                  --   {f₁ f₂ : α → β}
                  --   {a₁ a₂ : α},
                  --   f₁ = f₂ → a₁ = a₂ → f₁ a₁ = f₂ a₂

example (h : a = b) (f : α → β) : f a = f b :=      -- примеры использования функций
  congr_arg f h

example (f g : α → β) (h : f = g) : f a = g a :=
  congr_fun h a

example (f g : α → β)
        (h₁ : f = g)
        (h₂ : a = b) : f a = g b :=
  congr h₁ h₂

-- Доказательства равенства

example (a b c d e : ℕ)                                   -- рассмотрим пример, когда имея несколько утверждений о равенстве
        (h₁ : a = b) (h₂ : b = c + 1)                     -- требуется установить новое равенство
        (h₃ : c = d) (h₄ : e = 1 + d) : a = e :=
  have h₅ : a = c + 1,     from eq.trans h₁ h₂,           -- a = b = c + 1 можно получить из транзитивности равенства
  have h₆ : c + 1 = d + 1, from congr_arg _ h₃,           -- чтоб перейти из a = c + 1 в a = d + 1 путем замены c на d,
                                                          -- докажем из c = d равенство c + 1 = d + 1 через рассмотренный выше congr_arg
  have h₇ : a = d + 1,     from eq.trans h₅ h₆,           -- теперь можем показать a = c + 1 = d + 1 из транзитивности
  have h₈ : 1 + d = d + 1, from nat.add_comm 1 d,         -- чтоб перейти из a = d + 1 в a = e путем замены e на d + 1,
                                                          -- докажем из коммунтативности сложения (nat.add_comm) 1 + d = d + 1
  have h₉ : e = d + 1,     from eq.trans h₄ h₈,           -- теперь можем показать e = 1 + d = d + 1 из транзитивности
  show a = e,              from eq.trans h₇ (eq.symm h₉)  -- так как цифры кончились, склеим два пункта в один :)
                                                          -- из симметрии заменим e = d + 1 на d + 1 = e, а далее
                                                          -- можем показать a = d + 1 = e из транзитивности

example (a b c d e : ℕ)                                   -- можем доказать то же через удобную и наглядную конструкцию calc,
        (h₁ : a = b) (h₂ : b = c + 1)                     -- придуманную специально для этих случаев; она заменяет обычные
        (h₃ : c = d) (h₄ : e = 1 + d) : a = e :=          -- в таких доказательствах цепочки транзитивности
  calc
    a   = b     : h₁                                      -- утверждение о равенстве : доказательство (тут тривиально)
    ... = c + 1 : h₂                                      -- три точки говорят, что мы пользуемся транзитивностью равенства
    ... = d + 1 : congr_arg _ h₃                          -- как и раньше равенство достигается из конгруэнтности аргументов функции λ x, x + 1
    ... = 1 + d : nat.add_comm d (1 : ℕ)                  -- аналогично получаем из коммутативности сложения
    ... = e     : eq.symm h₄                              -- результат

-- обощенный синтаксис calc:
-- calc
--   expr₀ op₁ expr₁ : proof₁
--   ...   op₂ expr₂ : proof₂
--   {еще много строк}
--   ...   opn exprn : proofn

example (a b c d e : ℕ)                                   -- еще раз то же можно доказать с помощью тактики rw
        (h₁ : a = b) (h₂ : b = c + 1)                     -- подробнее тактики мы рассмотрим далее, здесь же ограничимся тем, что
        (h₃ : c = d) (h₄ : e = 1 + d) : a = e :=          -- такая тактика позволяет переписать кусок выражения с правой стороны
  calc                                                    -- от равества, что избавляет нас от необходимости пользоваться конгруэнтностью
    a   = b     : by rw h₁
    ... = c + 1 : by rw h₂                                -- применение тактики: by {tactic} {argumets}
    ... = d + 1 : by rw h₃                                -- в данном случае: by rw {равенство, на основании которого переписывается правая часть}
    ... = 1 + d : by rw nat.add_comm
    ... = e     : by rw h₄

example (a b c d e : ℕ)                                   -- несколько последовательных переписываний можно схлопнуть
        (h₁ : a = b) (h₂ : b = c + 1)                     -- передав тактике rw в качестве аргумента список равенств
        (h₃ : c = d) (h₄ : e = 1 + d) : a = e :=
  calc
    a   = d + 1 : by rw [h₁, h₂, h₃]
    ... = 1 + d : by rw nat.add_comm
    ... = e     : by rw h₄

example (a b c d e : ℕ)                                   -- или даже вот так
        (h₁ : a = b) (h₂ : b = c + 1)
        (h₃ : c = d) (h₄ : e = 1 + d) : a = e :=
  by rw [h₁, h₂, h₃, nat.add_comm, h₄]

example (a b c d e : ℕ)                                   -- для самых ленивых существует тактика simp
        (h₁ : a = b) (h₂ : b = c + 1)                     -- она перебирает все переданные ей в качестве аргумента
        (h₃ : c = d) (h₄ : e = 1 + d) : a = e :=          -- равенства, а также пробует пользоваться ассоциативностью
  by simp [h₁, h₂, h₃, h₄]                                -- пока что-нибудь не выведет

theorem T1 (a b c d e : ℕ)                                -- прелесть в том, что построив такое доказательство,
           (h₁ : a = b) (h₂ : b = c + 1)                  -- мы даже сможем его распечатать и понять, как оно было осуществлено
           (h₃ : c = d) (h₄ : e = 1 + d) : a = e :=
  by simp [h₄, h₂, h₁, h₃]

#print T1

example (x y : ℕ) :                                       -- напоследок докажем формулу квадрата суммы
          (x + y) * (x + y) = x * x + y * x + x * y + y * y :=
  calc
    (x + y) * (x + y) = (x + y) * x + (x + y) * y       : by rw mul_add
    ...               = x * x + y * x + (x + y) * y     : by rw add_mul
    ...               = x * x + y * x + (x * y + y * y) : by rw add_mul
    ...               = x * x + y * x + x * y + y * y   : by rw ←add_assoc -- стрелочка ← (\l) показывает, что
                                                                           -- применяемое равенство требуется
                                                                           -- переписать в обратную сторону

#check @add_assoc -- ∀ {α : Type u} (a b c : α) [_ : add_semigroup α] (a b c : α), a + b + c = a + (b + c)
                  -- во-первых, пока опустим add_semigroup α, на это посмотрим позже, но вообще это просто typeclass
                  -- во-вторых, утверждение гласит, что a + b + c = a + (b + c), а нам нужно переписать наоборот:
                  -- формулу со скобками представить без скобок, потому и нужна стрелка ←

lemma T2 (x y : ℕ) :                                      -- и так тоже сработает (ассоциативность применится сама)
          (x + y) * (x + y) = x * x + y * x +
                              x * y + y * y :=
  by simp [mul_add, add_mul]

#print T2

example (f : ℕ → ℕ)                                       -- теми же способами можно доказывать неравества
        (h : ∀ x : ℕ, f x ≤ f (x + 1)) : f 0 ≤ f 3 :=
  calc
    f 0 ≤ f 1 : h 0
    ... ≤ f 2 : h 1
    ... ≤ f 3 : h 2


/-
Copyright (c) 2017 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Mario Carneiro
-/
import tactic.basic

/-- `ℕ+` is the type of positive natural numbers. It is defined as a subtype,
  and the VM representation of `ℕ+` is the same as `ℕ` because the proof
  is not stored. -/
def pnat := {n : ℕ // n > 0}
notation `ℕ+` := pnat

instance coe_pnat_nat : has_coe ℕ+ ℕ := ⟨subtype.val⟩

namespace nat

/-- Convert a natural number to a positive natural number. The
  positivity assumption is inferred by `dec_trivial`. -/
def to_pnat (n : ℕ) (h : n > 0 . tactic.exact_dec_trivial) : ℕ+ := ⟨n, h⟩

/-- Write a successor as an element of `ℕ+`. -/
def succ_pnat (n : ℕ) : ℕ+ := ⟨succ n, succ_pos n⟩

@[simp] theorem succ_pnat_coe (n : ℕ) : (succ_pnat n : ℕ) = succ n := rfl

/-- Convert a natural number to a pnat. `n+1` is mapped to itself,
  and `0` becomes `1`. -/
def to_pnat' (n : ℕ) : ℕ+ := succ_pnat (pred n)

end nat

namespace pnat

open nat
@[simp] theorem pos (n : ℕ+) : (n : ℕ) > 0 := n.2

theorem eq {m n : ℕ+} : (m : ℕ) = n → m = n := subtype.eq

@[simp] theorem mk_coe (n h) : ((⟨n, h⟩ : ℕ+) : ℕ) = n := rfl

instance : has_add ℕ+ := ⟨λ m n, ⟨m + n, add_pos m.2 n.2⟩⟩

@[simp] theorem add_coe (m n : ℕ+) : ((m + n : ℕ+) : ℕ) = m + n := rfl

@[simp] theorem ne_zero (n : ℕ+) : (n : ℕ) ≠ 0 := ne_of_gt n.2

@[simp] theorem to_pnat'_coe {n : ℕ} : n > 0 → (n.to_pnat' : ℕ) = n := succ_pred_eq_of_pos

@[simp] theorem coe_to_pnat' (n : ℕ+) : (n : ℕ).to_pnat' = n := eq (to_pnat'_coe n.pos)

instance : comm_monoid ℕ+ :=
{ mul       := λ m n, ⟨m.1 * n.1, mul_pos m.2 n.2⟩,
  mul_assoc := λ a b c, subtype.eq (mul_assoc _ _ _),
  one       := succ_pnat 0,
  one_mul   := λ a, subtype.eq (one_mul _),
  mul_one   := λ a, subtype.eq (mul_one _),
  mul_comm  := λ a b, subtype.eq (mul_comm _ _) }

@[simp] theorem one_coe : ((1 : ℕ+) : ℕ) = 1 := rfl

@[simp] theorem mul_coe (m n : ℕ+) : ((m * n : ℕ+) : ℕ) = m * n := rfl

/-- The power of a pnat and a nat is a pnat. -/
def pow (m : ℕ+) (n : ℕ) : ℕ+ :=
⟨m ^ n, nat.pos_pow_of_pos _ m.pos⟩

instance : has_pow ℕ+ ℕ := ⟨pow⟩

@[simp] theorem pow_coe (m : ℕ+) (n : ℕ) : (↑(m ^ n) : ℕ) = m ^ n := rfl

instance : has_repr ℕ+ := ⟨λ n, repr n.1⟩

end pnat