import game.sets.L01defs -- hide

namespace xena -- hide

variable X : Type -- hide

/-
# Chapter 1 : Sets

## Level 2
-/

/-
Working with sets is very similar to working with propositions.
Let's now prove that any set $A$ is included in its union with
any other set $B$, or $A ⊆ A ∪ B$.

Our goal is definitionally equivalent to `∀ x ∈ A, x ∈ (A ∪ B)`.
The definition of `x ∈ (A ∪ B)` is `x ∈ A ∨ x ∈ B`.

You should already know the tactics needed to prove this goal, so give
it a try before checking the hints.
-/

/- Hint : Hint : The proof steps may become clearer if you change the goal.
Use the `change` tactic and the definitions give above:

`change ∀ x ∈ A, x ∈ A ∨ x ∈ B,`

This will change your goal to the definitionally equivalent

`∀ x : X, x ∈ A ⇾ x ∈ A ∨ x ∈ B`

Start your proof of `∀ (x : X) ...` in the way you learned in the previous level.

You will then have a statement of propositional form `α → β ∨ γ`. See if you can use your knowledge of propositions to solve this!
-/

/- Hint : Hint : After introducing your terms, you'll need to prove the `left` side of a disjunction.
With or without the `change` lines, you can introduce the
hypotheses we need by using

`intros x hx,`

Now the equivalence with the world of propositions will become apparent.

To prove that the union of two sets is inhabited is to prove the disjunction
$P ∨ Q$ of two propositions. In this case, $P$ is our statement $x ∈ A$.

Choosing `left,` will change our goal to the first disjunct.

You should now be able to easily finish the proof.
-/

/- Lemma
If $A$ and $B$ are sets of any type $X$, then
$$ A \subseteq A\cup B.$$
-/
theorem subset_union_left (A B : set X) : A ⊆ A ∪ B :=
begin
    --change ∀ (x : α), x ∈ A → x ∈ A ∪ B,  --they may want to do this
    intros x hx,
    left, exact hx, done

end

end xena --hide


inductive Expr : Type
  | const (n : Nat)
  | plus (e₁ e₂ : Expr)
  | mul (e₁ e₂ : Expr)
  deriving BEq, Inhabited, Repr, DecidableEq

def Expr.eval : Expr → Nat
  | const n    => n
  | plus e₁ e₂ => eval e₁ + eval e₂
  | mul e₁ e₂  => eval e₁ * eval e₂

def Expr.times : Nat → Expr → Expr
  | k, const n    => const (k*n)
  | k, plus e₁ e₂ => plus (times k e₁) (times k e₂)
  | k, mul e₁ e₂  => mul (times k e₁) e₂

theorem eval_times (k : Nat) (e : Expr) : (e.times k |>.eval) = k * e.eval := by
  induction e with simp [Expr.times, Expr.eval]
  | plus e₁ e₂ ih₁ ih₂ => simp [ih₁, ih₂, Nat.left_distrib]
  | mul  _ _ ih₁ ih₂   => simp [ih₁, Nat.mul_assoc]

def Expr.reassoc : Expr → Expr
  | const n    => const n
  | plus e₁ e₂ =>
    let e₁' := e₁.reassoc
    let e₂' := e₂.reassoc
    match e₂' with
    | plus e₂₁ e₂₂ => plus (plus e₁' e₂₁) e₂₂
    | _            => plus e₁' e₂'
  | mul e₁ e₂ =>
    let e₁' := e₁.reassoc
    let e₂' := e₂.reassoc
    match e₂' with
    | mul e₂₁ e₂₂ => mul (mul e₁' e₂₁) e₂₂
    | _           => mul e₁' e₂'

theorem eval_reassoc (e : Expr) : e.reassoc.eval = e.eval := by
  induction e with simp [Expr.reassoc]
  | plus e₁ e₂ ih₁ ih₂ =>
    generalize h : Expr.reassoc e₂ = e₂'
    cases e₂' <;> rw [h] at ih₂ <;> simp [Expr.eval] at * <;> rw [← ih₂, ih₁]; rw [Nat.add_assoc]
  | mul e₁ e₂ ih₁ ih₂ =>
    generalize h : Expr.reassoc e₂ = e₂'
    cases e₂' <;> rw [h] at ih₂ <;> simp [Expr.eval] at * <;> rw [← ih₂, ih₁]; rw [Nat.mul_assoc]


-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar la unicidad de los límites de las sucesiones
-- convergentes.
-- ----------------------------------------------------------------------

import .Definicion_de_convergencia

open_locale classical

theorem converges_to_unique
  {s : ℕ → ℝ}
  {a b : ℝ}
  (sa : converges_to s a)
  (sb : converges_to s b)
  : a = b :=
begin
  by_contradiction abne,
  have : abs (a - b) > 0,
  { apply abs_pos.mpr,
    exact sub_ne_zero_of_ne abne,
    exact ordered_add_comm_monoid.to_covariant_class_left ℝ, },
  let ε := abs (a - b) / 2,
  have εpos : ε > 0,
  { change abs (a - b) / 2 > 0,
    linarith },
  cases sa ε εpos with Na hNa,
  cases sb ε εpos with Nb hNb,
  let N := max Na Nb,
  have absa : abs (s N - a) < ε,
  { specialize hNa N,
    apply hNa,
    exact le_max_left Na Nb },
  have absb : abs (s N - b) < ε,
  { specialize hNb N,
    apply hNb,
    exact le_max_right Na Nb },
  have : abs (a - b) < abs (a - b),
    calc abs (a - b)
         = abs ((a - s N) + (s N - b))      : by {congr, ring_nf}
     ... ≤ abs (a - s N) + abs (s N - b)    : abs_add (a - s N) (s N - b)
     ... = abs (s N - a) + abs (s N - b)    : by rw abs_sub_comm
     ... < ε + ε                            : by exact add_lt_add absa absb
     ... = abs (a - b)                      : by exact add_halves (abs (a - b)),
  exact lt_irrefl _ this,
end

-- Prueba
-- ======

/-
s : ℕ → ℝ,
a b : ℝ,
sa : converges_to s a,
sb : converges_to s b
⊢ a = b
  >> by_contradiction abne,
abne : ¬a = b
⊢ false
  >> have : abs (a - b) > 0,
| ⊢ abs (a - b) > 0
|   >> { apply abs_pos_of_ne_zero,
| ⊢ a - b ≠ 0
|   >>   exact sub_ne_zero_of_ne abne },
this : abs (a - b) > 0
⊢ false
  >> let ε := abs (a - b) / 2,
ε : ℝ := abs (a - b) / 2
⊢ false
  >> have εpos : ε > 0,
| ⊢ ε > 0
|   >> { change abs (a - b) / 2 > 0,
| ⊢ abs (a - b) / 2 > 0
|   >>   linarith },
εpos : ε > 0
⊢ false
  >> cases sa ε εpos with Na hNa,
Na : ℕ,
hNa : ∀ (n : ℕ), n ≥ Na → abs (s n - a) < ε
⊢ false
  >> cases sb ε εpos with Nb hNb,
Nb : ℕ,
hNb : ∀ (n : ℕ), n ≥ Nb → abs (s n - b) < ε
⊢ false
  >> let N := max Na Nb,
N : ℕ := max Na Nb
⊢ false
  >> have absa : abs (s N - a) < ε,
| ⊢ abs (s N - a) < ε
|   >> { specialize hNa N,
| hNa : N ≥ Na → abs (s N - a) < ε
| ⊢ abs (s N - a) < ε
|   >>   apply hNa,
| ⊢ N ≥ Na
|   >>   exact le_max_left Na Nb },
absa : abs (s N - a) < ε
⊢ false
  >> have absb : abs (s N - b) < ε,
| ⊢ abs (s N - b) < ε
|   >> { specialize hNb N,
| hNb : N ≥ Nb → abs (s N - b) < ε
| ⊢ abs (s N - b) < ε
|   >>   apply hNb,
| hNb : N ≥ Nb → abs (s N - b) < ε
|   >>   exact le_max_right Na Nb },
absb : abs (s N - b) < ε
⊢ false
  >> have : abs (a - b) < abs (a - b),
  >>   calc abs (a - b)
  >>        = abs ((a - s N) + (s N - b))   : by {congr, ring_nf}
  >>    ... ≤ abs (a - s N) + abs (s N - b) : by apply abs_add_le_abs_add_abs
  >>    ... = abs (s N - a) + abs (s N - b) : by rw abs_sub
  >>    ... < ε + ε                         : by exact add_lt_add absa absb
  >>    ... = abs (a - b)                   : by exact add_halves (abs (a - b)),
this : abs (a - b) < abs (a - b)
⊢ false
  >> exact lt_irrefl _ this,
no goals
-/

-- Comentario: Se han usado los lemas
-- + abs_add_le_abs_add_abs a b : abs (a + b) ≤ abs a + abs b
-- + abs_pos_of_ne_zero : a ≠ 0 → 0 < abs a
-- + abs_sub a b : abs (a - b) = abs (b - a)
-- + add_halves a : a / 2 + a / 2 = a
-- + add_lt_add : a < b → c < d → a + c < b + d
-- + le_max_left a b : a ≤ max a b
-- + le_max_right a b : b ≤ max a b
-- + sub_ne_zero_of_ne : a ≠ b → a - b ≠ 0

-- Comprobación:
-- variables (a b c d : ℝ)
-- #check @abs_pos_of_ne_zero _ _ a
-- #check @sub_ne_zero_of_ne _ _ a b
-- #check @le_max_left _ _ a b
-- #check @le_max_right _ _ a b
-- #check @abs_add_le_abs_add_abs _ _ a b
-- #check @abs_sub _ _ a b
-- #check @add_lt_add _ _ a b c d
-- #check @add_halves _ _ a


/-
Copyright (c) 2021 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Myers
-/
import linear_algebra.basic

/-!
# Rays in modules

This file defines rays in modules.

## Main definitions

* `same_ray`: two vectors belong to the same ray if they are proportional with a nonnegative
  coefficient.

* `module.ray` is a type for the equivalence class of nonzero vectors in a module with some
common positive multiple.
-/

noncomputable theory

open_locale big_operators

section ordered_comm_semiring

variables (R : Type*) [ordered_comm_semiring R]
variables {M : Type*} [add_comm_monoid M] [module R M]
variables {N : Type*} [add_comm_monoid N] [module R N]
variables (ι : Type*) [decidable_eq ι]

/-- Two vectors are in the same ray if either one of them is zero or some positive multiples of them
are equal (in the typical case over a field, this means one of them is a nonnegative multiple of
the other). -/
def same_ray (v₁ v₂ : M) : Prop :=
v₁ = 0 ∨ v₂ = 0 ∨ ∃ (r₁ r₂ : R), 0 < r₁ ∧ 0 < r₂ ∧ r₁ • v₁ = r₂ • v₂

variables {R}

namespace same_ray

variables {x y z : M}

@[simp] lemma zero_left (y : M) : same_ray R 0 y := or.inl rfl

@[simp] lemma zero_right (x : M) : same_ray R x 0 := or.inr $ or.inl rfl

@[nontriviality] lemma of_subsingleton [subsingleton M] (x y : M) : same_ray R x y :=
by { rw [subsingleton.elim x 0], exact zero_left _ }

@[nontriviality] lemma of_subsingleton' [subsingleton R] (x y : M) : same_ray R x y :=
by { haveI := module.subsingleton R M, exact of_subsingleton x y }

/-- `same_ray` is reflexive. -/
@[refl] lemma refl (x : M) : same_ray R x x :=
begin
  nontriviality R,
  exact or.inr (or.inr $ ⟨1, 1, zero_lt_one, zero_lt_one, rfl⟩)
end

protected lemma rfl : same_ray R x x := refl _

/-- `same_ray` is symmetric. -/
@[symm] lemma symm (h : same_ray R x y) : same_ray R y x :=
(or.left_comm.1 h).imp_right $ or.imp_right $ λ ⟨r₁, r₂, h₁, h₂, h⟩, ⟨r₂, r₁, h₂, h₁, h.symm⟩

/-- If `x` and `y` are nonzero vectors on the same ray, then there exist positive numbers `r₁ r₂`
such that `r₁ • x = r₂ • y`. -/
lemma exists_pos (h : same_ray R x y) (hx : x ≠ 0) (hy : y ≠ 0) :
  ∃ r₁ r₂ : R, 0 < r₁ ∧ 0 < r₂ ∧ r₁ • x = r₂ • y :=
(h.resolve_left hx).resolve_left hy

lemma _root_.same_ray_comm : same_ray R x y ↔ same_ray R y x :=
⟨same_ray.symm, same_ray.symm⟩

/-- `same_ray` is transitive unless the vector in the middle is zero and both other vectors are
nonzero. -/
lemma trans (hxy : same_ray R x y) (hyz : same_ray R y z) (hy : y = 0 → x = 0 ∨ z = 0) :
  same_ray R x z :=
begin
  rcases eq_or_ne x 0 with rfl|hx, { exact zero_left z },
  rcases eq_or_ne z 0 with rfl|hz, { exact zero_right x },
  rcases eq_or_ne y 0 with rfl|hy, { exact (hy rfl).elim (λ h, (hx h).elim) (λ h, (hz h).elim) },
  rcases hxy.exists_pos hx hy with ⟨r₁, r₂, hr₁, hr₂, h₁⟩,
  rcases hyz.exists_pos hy hz with ⟨r₃, r₄, hr₃, hr₄, h₂⟩,
  refine or.inr (or.inr $ ⟨r₃ * r₁, r₂ * r₄, mul_pos hr₃ hr₁, mul_pos hr₂ hr₄, _⟩),
  rw [mul_smul, mul_smul, h₁, ← h₂, smul_comm]
end

/-- A vector is in the same ray as a nonnegative multiple of itself. -/
lemma _root_.same_ray_nonneg_smul_right (v : M) {r : R} (h : 0 ≤ r) : same_ray R v (r • v) :=
or.inr $ h.eq_or_lt.imp (λ h, h ▸ zero_smul R v) $
  λ h, ⟨r, 1, h, by { nontriviality R, exact zero_lt_one }, (one_smul _ _).symm⟩

/-- A vector is in the same ray as a positive multiple of itself. -/
lemma _root_.same_ray_pos_smul_right (v : M) {r : R} (h : 0 < r) : same_ray R v (r • v) :=
same_ray_nonneg_smul_right v h.le

/-- A vector is in the same ray as a nonnegative multiple of one it is in the same ray as. -/
lemma nonneg_smul_right {r : R} (h : same_ray R x y) (hr : 0 ≤ r) : same_ray R x (r • y) :=
h.trans (same_ray_nonneg_smul_right y hr) $ λ hy, or.inr $ by rw [hy, smul_zero]

/-- A vector is in the same ray as a positive multiple of one it is in the same ray as. -/
lemma pos_smul_right {r : R} (h : same_ray R x y) (hr : 0 < r) : same_ray R x (r • y) :=
h.nonneg_smul_right hr.le

/-- A nonnegative multiple of a vector is in the same ray as that vector. -/
lemma _root_.same_ray_nonneg_smul_left (v : M) {r : R} (h : 0 ≤ r) : same_ray R (r • v) v :=
(same_ray_nonneg_smul_right v h).symm

/-- A positive multiple of a vector is in the same ray as that vector. -/
lemma _root_.same_ray_pos_smul_left (v : M) {r : R} (h : 0 < r) : same_ray R (r • v) v :=
same_ray_nonneg_smul_left v h.le

/-- A nonnegative multiple of a vector is in the same ray as one it is in the same ray as. -/
lemma nonneg_smul_left {r : R} (h : same_ray R x y) (hr : 0 ≤ r) : same_ray R (r • x) y :=
(h.symm.nonneg_smul_right hr).symm

/-- A positive multiple of a vector is in the same ray as one it is in the same ray as. -/
lemma pos_smul_left {r : R} (h : same_ray R x y) (hr : 0 < r) : same_ray R (r • x) y :=
h.nonneg_smul_left hr.le

/-- If two vectors are on the same ray then they remain so after applying a linear map. -/
lemma map (f : M →ₗ[R] N) (h : same_ray R x y) : same_ray R (f x) (f y) :=
h.imp (λ hx, by rw [hx, map_zero]) $ or.imp (λ hy, by rw [hy, map_zero]) $
  λ ⟨r₁, r₂, hr₁, hr₂, h⟩, ⟨r₁, r₂, hr₁, hr₂, by rw [←f.map_smul, ←f.map_smul, h]⟩

/-- The images of two vectors under a linear equivalence are on the same ray if and only if the
original vectors are on the same ray. -/
@[simp] lemma _root_.same_ray_map_iff (e : M ≃ₗ[R] N) : same_ray R (e x) (e y) ↔ same_ray R x y :=
⟨λ h, by simpa using same_ray.map e.symm.to_linear_map h, same_ray.map e.to_linear_map⟩

/-- If two vectors are on the same ray then both scaled by the same action are also on the same
ray. -/
lemma smul {S : Type*} [monoid S] [distrib_mul_action S M] [smul_comm_class R S M]
  (h : same_ray R x y) (s : S) : same_ray R (s • x) (s • y) :=
h.map (s • (linear_map.id : M →ₗ[R] M))

/-- If `x` and `y` are on the same ray as `z`, then so is `x + y`. -/
lemma add_left (hx : same_ray R x z) (hy : same_ray R y z) : same_ray R (x + y) z :=
begin
  rcases eq_or_ne x 0 with rfl|hx₀, { rwa zero_add },
  rcases eq_or_ne y 0 with rfl|hy₀, { rwa add_zero },
  rcases eq_or_ne z 0 with rfl|hz₀, { apply zero_right },
  rcases hx.exists_pos hx₀ hz₀ with ⟨rx, rz₁, hrx, hrz₁, Hx⟩,
  rcases hy.exists_pos hy₀ hz₀ with ⟨ry, rz₂, hry, hrz₂, Hy⟩,
  refine or.inr (or.inr ⟨rx * ry, ry * rz₁ + rx * rz₂, mul_pos hrx hry, _, _⟩),
  { apply_rules [add_pos, mul_pos] },
  { simp only [mul_smul, smul_add, add_smul, ← Hx, ← Hy],
    rw smul_comm }
end

/-- If `y` and `z` are on the same ray as `x`, then so is `y + z`. -/
lemma add_right (hy : same_ray R x y) (hz : same_ray R x z) : same_ray R x (y + z) :=
(hy.symm.add_left hz.symm).symm

end same_ray

/-- Nonzero vectors, as used to define rays. This type depends on an unused argument `R` so that
`ray_vector.setoid` can be an instance. -/
@[nolint unused_arguments has_inhabited_instance]
def ray_vector (R M : Type*) [has_zero M] := {v : M // v ≠ 0}

instance ray_vector.has_coe {R M : Type*} [has_zero M] :
  has_coe (ray_vector R M) M := coe_subtype

instance {R M : Type*} [has_zero M] [nontrivial M] : nonempty (ray_vector R M) :=
let ⟨x, hx⟩ := exists_ne (0 : M) in ⟨⟨x, hx⟩⟩

variables (R M)

/-- The setoid of the `same_ray` relation for the subtype of nonzero vectors. -/
instance : setoid (ray_vector R M) :=
{ r := λ x y, same_ray R (x : M) y,
  iseqv := ⟨λ x, same_ray.refl _, λ x y h, h.symm,
    λ x y z hxy hyz, hxy.trans hyz $ λ hy, (y.2 hy).elim⟩ }

/-- A ray (equivalence class of nonzero vectors with common positive multiples) in a module. -/
@[nolint has_inhabited_instance]
def module.ray := quotient (ray_vector.setoid R M)

variables {R M}

/-- Equivalence of nonzero vectors, in terms of same_ray. -/
lemma equiv_iff_same_ray {v₁ v₂ : ray_vector R M} :
  v₁ ≈ v₂ ↔ same_ray R (v₁ : M) v₂ :=
iff.rfl

variables (R)

/-- The ray given by a nonzero vector. -/
protected def ray_of_ne_zero (v : M) (h : v ≠ 0) : module.ray R M := ⟦⟨v, h⟩⟧

/-- An induction principle for `module.ray`, used as `induction x using module.ray.ind`. -/
lemma module.ray.ind {C : module.ray R M → Prop}
  (h : ∀ v (hv : v ≠ 0), C (ray_of_ne_zero R v hv)) (x : module.ray R M) : C x :=
quotient.ind (subtype.rec $ by exact h) x

variable {R}

instance [nontrivial M] : nonempty (module.ray R M) :=
nonempty.map quotient.mk infer_instance

/-- The rays given by two nonzero vectors are equal if and only if those vectors
satisfy `same_ray`. -/
lemma ray_eq_iff {v₁ v₂ : M} (hv₁ : v₁ ≠ 0) (hv₂ : v₂ ≠ 0) :
  ray_of_ne_zero R _ hv₁ = ray_of_ne_zero R _ hv₂ ↔ same_ray R v₁ v₂ :=
quotient.eq

/-- The ray given by a positive multiple of a nonzero vector. -/
@[simp] lemma ray_pos_smul {v : M} (h : v ≠ 0) {r : R} (hr : 0 < r)
  (hrv : r • v ≠ 0) : ray_of_ne_zero R (r • v) hrv = ray_of_ne_zero R v h :=
(ray_eq_iff _ _).2 $ same_ray_pos_smul_left v hr

/-- An equivalence between modules implies an equivalence between ray vectors. -/
def ray_vector.map_linear_equiv (e : M ≃ₗ[R] N) : ray_vector R M ≃ ray_vector R N :=
equiv.subtype_equiv e.to_equiv $ λ _, e.map_ne_zero_iff.symm

/-- An equivalence between modules implies an equivalence between rays. -/
def module.ray.map (e : M ≃ₗ[R] N) : module.ray R M ≃ module.ray R N :=
quotient.congr (ray_vector.map_linear_equiv e) $ λ ⟨a, ha⟩ ⟨b, hb⟩, (same_ray_map_iff _).symm

@[simp] lemma module.ray.map_apply (e : M ≃ₗ[R] N) (v : M) (hv : v ≠ 0) :
  module.ray.map e (ray_of_ne_zero _ v hv) = ray_of_ne_zero _ (e v) (e.map_ne_zero_iff.2 hv) := rfl

@[simp] lemma module.ray.map_refl : (module.ray.map $ linear_equiv.refl R M) = equiv.refl _ :=
equiv.ext $ module.ray.ind R $ λ _ _, rfl

@[simp] lemma module.ray.map_symm (e : M ≃ₗ[R] N) :
  (module.ray.map e).symm = module.ray.map e.symm := rfl

section action
variables {G : Type*} [group G] [distrib_mul_action G M]

/-- Any invertible action preserves the non-zeroness of ray vectors. This is primarily of interest
when `G = Rˣ` -/
instance {R : Type*} : mul_action G (ray_vector R M) :=
{ smul := λ r, (subtype.map ((•) r) $ λ a, (smul_ne_zero_iff_ne _).2),
  mul_smul := λ a b m, subtype.ext $ mul_smul a b _,
  one_smul := λ m, subtype.ext $ one_smul _ _ }

variables [smul_comm_class R G M]

/-- Any invertible action preserves the non-zeroness of rays. This is primarily of interest when
`G = Rˣ` -/
instance : mul_action G (module.ray R M) :=
{ smul := λ r, quotient.map ((•) r) (λ a b h, h.smul _),
  mul_smul := λ a b, quotient.ind $ by exact(λ m, congr_arg quotient.mk $ mul_smul a b _),
  one_smul := quotient.ind $ by exact (λ m, congr_arg quotient.mk $ one_smul _ _), }

/-- The action via `linear_equiv.apply_distrib_mul_action` corresponds to `module.ray.map`. -/
@[simp] lemma module.ray.linear_equiv_smul_eq_map (e : M ≃ₗ[R] M) (v : module.ray R M) :
  e • v = module.ray.map e v := rfl

@[simp] lemma smul_ray_of_ne_zero (g : G) (v : M) (hv) :
  g • ray_of_ne_zero R v hv = ray_of_ne_zero R (g • v) ((smul_ne_zero_iff_ne _).2 hv) := rfl

end action

namespace module.ray

/-- Scaling by a positive unit is a no-op. -/
lemma units_smul_of_pos (u : Rˣ) (hu : 0 < (u : R)) (v : module.ray R M) :
  u • v = v :=
begin
  induction v using module.ray.ind,
  rw [smul_ray_of_ne_zero, ray_eq_iff],
  exact same_ray_pos_smul_left _ hu
end

/-- An arbitrary `ray_vector` giving a ray. -/
def some_ray_vector (x : module.ray R M) : ray_vector R M := quotient.out x

/-- The ray of `some_ray_vector`. -/
@[simp] lemma some_ray_vector_ray (x : module.ray R M) :
  (⟦x.some_ray_vector⟧ : module.ray R M) = x :=
quotient.out_eq _

/-- An arbitrary nonzero vector giving a ray. -/
def some_vector (x : module.ray R M) : M := x.some_ray_vector

/-- `some_vector` is nonzero. -/
@[simp] lemma some_vector_ne_zero (x : module.ray R M) : x.some_vector ≠ 0 :=
x.some_ray_vector.property

/-- The ray of `some_vector`. -/
@[simp] lemma some_vector_ray (x : module.ray R M) :
  ray_of_ne_zero R _ x.some_vector_ne_zero = x :=
(congr_arg _ (subtype.coe_eta _ _) : _).trans x.out_eq

end module.ray

end ordered_comm_semiring

section ordered_comm_ring

variables {R : Type*} [ordered_comm_ring R]
variables {M N : Type*} [add_comm_group M] [add_comm_group N] [module R M] [module R N] {x y : M}

/-- `same_ray.neg` as an `iff`. -/
@[simp] lemma same_ray_neg_iff : same_ray R (-x) (-y) ↔ same_ray R x y :=
by simp only [same_ray, neg_eq_zero, smul_neg, neg_inj]

alias same_ray_neg_iff ↔ same_ray.of_neg same_ray.neg

lemma same_ray_neg_swap : same_ray R (-x) y ↔ same_ray R x (-y) :=
by rw [← same_ray_neg_iff, neg_neg]

lemma eq_zero_of_same_ray_neg_smul_right [no_zero_smul_divisors R M] {r : R} (hr : r < 0)
  (h : same_ray R x (r • x)) :
  x = 0 :=
begin
  rcases h with rfl|h₀|⟨r₁, r₂, hr₁, hr₂, h⟩,
  { refl },
  { simpa [hr.ne] using h₀ },
  { rw [← sub_eq_zero, smul_smul, ← sub_smul, smul_eq_zero] at h,
    refine h.resolve_left (ne_of_gt $ sub_pos.2 _),
    exact (mul_neg_of_pos_of_neg hr₂ hr).trans hr₁ }
end

/-- If a vector is in the same ray as its negation, that vector is zero. -/
lemma eq_zero_of_same_ray_self_neg [no_zero_smul_divisors R M] (h : same_ray R x (-x)) :
  x = 0 :=
begin
  nontriviality M, haveI : nontrivial R := module.nontrivial R M,
  refine eq_zero_of_same_ray_neg_smul_right (neg_lt_zero.2 (@one_pos R _ _)) _,
  rwa [neg_one_smul]
end

namespace ray_vector

/-- Negating a nonzero vector. -/
instance {R : Type*} : has_neg (ray_vector R M) := ⟨λ v, ⟨-v, neg_ne_zero.2 v.prop⟩⟩

/-- Negating a nonzero vector commutes with coercion to the underlying module. -/
@[simp, norm_cast] lemma coe_neg {R : Type*} (v : ray_vector R M) : ↑(-v) = -(v : M) := rfl

/-- Negating a nonzero vector twice produces the original vector. -/
instance {R : Type*} : has_involutive_neg (ray_vector R M) :=
{ neg := has_neg.neg,
  neg_neg := λ v, by rw [subtype.ext_iff, coe_neg, coe_neg, neg_neg] }

/-- If two nonzero vectors are equivalent, so are their negations. -/
@[simp] lemma equiv_neg_iff {v₁ v₂ : ray_vector R M} : -v₁ ≈ -v₂ ↔ v₁ ≈ v₂ :=
same_ray_neg_iff

end ray_vector

variables (R)

/-- Negating a ray. -/
instance : has_neg (module.ray R M) :=
⟨quotient.map (λ v, -v) (λ v₁ v₂, ray_vector.equiv_neg_iff.2)⟩

/-- The ray given by the negation of a nonzero vector. -/
@[simp] lemma neg_ray_of_ne_zero (v : M) (h : v ≠ 0) :
  -(ray_of_ne_zero R _ h) = ray_of_ne_zero R (-v) (neg_ne_zero.2 h) :=
rfl

namespace module.ray

variables {R}

/-- Negating a ray twice produces the original ray. -/
instance : has_involutive_neg (module.ray R M) :=
{ neg := has_neg.neg,
  neg_neg := λ x, quotient.ind (λ a, congr_arg quotient.mk $ neg_neg _) x }

variables {R M}

/-- A ray does not equal its own negation. -/
lemma ne_neg_self [no_zero_smul_divisors R M] (x : module.ray R M) : x ≠ -x :=
begin
  induction x using module.ray.ind with x hx,
  rw [neg_ray_of_ne_zero, ne.def, ray_eq_iff],
  exact mt eq_zero_of_same_ray_self_neg hx
end

lemma neg_units_smul (u : Rˣ) (v : module.ray R M) : (-u) • v = - (u • v) :=
begin
  induction v using module.ray.ind,
  simp only [smul_ray_of_ne_zero, units.smul_def, units.coe_neg, neg_smul, neg_ray_of_ne_zero]
end

/-- Scaling by a negative unit is negation. -/
lemma units_smul_of_neg (u : Rˣ) (hu : (u : R) < 0) (v : module.ray R M) :
  u • v = -v :=
begin
  rw [← neg_inj, neg_neg, ← neg_units_smul, units_smul_of_pos],
  rwa [units.coe_neg, right.neg_pos_iff]
end

end module.ray

end ordered_comm_ring

section linear_ordered_comm_ring

variables {R : Type*} [linear_ordered_comm_ring R]
variables {M : Type*} [add_comm_group M] [module R M]

/-- `same_ray` follows from membership of `mul_action.orbit` for the `units.pos_subgroup`. -/
lemma same_ray_of_mem_orbit {v₁ v₂ : M} (h : v₁ ∈ mul_action.orbit (units.pos_subgroup R) v₂) :
  same_ray R v₁ v₂ :=
begin
  rcases h with ⟨⟨r, hr : 0 < (r : R)⟩, (rfl : r • v₂ = v₁)⟩,
  exact same_ray_pos_smul_left _ hr
end

/-- Scaling by an inverse unit is the same as scaling by itself. -/
@[simp] lemma units_inv_smul (u : Rˣ) (v : module.ray R M) :
  u⁻¹ • v = u • v :=
calc u⁻¹ • v = (u * u) • u⁻¹ • v :
  eq.symm $ (u⁻¹ • v).units_smul_of_pos _ $ mul_self_pos.2 u.ne_zero
... = u • v : by rw [mul_smul, smul_inv_smul]

section
variables [no_zero_smul_divisors R M]

@[simp] lemma same_ray_smul_right_iff {v : M} {r : R} :
  same_ray R v (r • v) ↔ 0 ≤ r ∨ v = 0 :=
⟨λ hrv, or_iff_not_imp_left.2 $ λ hr, eq_zero_of_same_ray_neg_smul_right (not_le.1 hr) hrv,
  or_imp_distrib.2 ⟨same_ray_nonneg_smul_right v, λ h, h.symm ▸ same_ray.zero_left _⟩⟩

/-- A nonzero vector is in the same ray as a multiple of itself if and only if that multiple
is positive. -/
lemma same_ray_smul_right_iff_of_ne {v : M} (hv : v ≠ 0) {r : R} (hr : r ≠ 0) :
  same_ray R v (r • v) ↔ 0 < r :=
by simp only [same_ray_smul_right_iff, hv, or_false, hr.symm.le_iff_lt]

@[simp] lemma same_ray_smul_left_iff {v : M} {r : R} : same_ray R (r • v) v ↔ 0 ≤ r ∨ v = 0 :=
same_ray_comm.trans same_ray_smul_right_iff

/-- A multiple of a nonzero vector is in the same ray as that vector if and only if that multiple
is positive. -/
lemma same_ray_smul_left_iff_of_ne {v : M} (hv : v ≠ 0) {r : R} (hr : r ≠ 0) :
  same_ray R (r • v) v ↔ 0 < r :=
same_ray_comm.trans (same_ray_smul_right_iff_of_ne hv hr)

@[simp] lemma same_ray_neg_smul_right_iff {v : M} {r : R} :
  same_ray R (-v) (r • v) ↔ r ≤ 0 ∨ v = 0 :=
by rw [← same_ray_neg_iff, neg_neg, ← neg_smul, same_ray_smul_right_iff, neg_nonneg]

lemma same_ray_neg_smul_right_iff_of_ne {v : M} {r : R} (hv : v ≠ 0) (hr : r ≠ 0) :
  same_ray R (-v) (r • v) ↔ r < 0 :=
by simp only [same_ray_neg_smul_right_iff, hv, or_false, hr.le_iff_lt]

@[simp] lemma same_ray_neg_smul_left_iff {v : M} {r : R} :
  same_ray R (r • v) (-v) ↔ r ≤ 0 ∨ v = 0 :=
same_ray_comm.trans same_ray_neg_smul_right_iff

lemma same_ray_neg_smul_left_iff_of_ne {v : M} {r : R} (hv : v ≠ 0) (hr : r ≠ 0) :
  same_ray R (r • v) (-v) ↔ r < 0 :=
same_ray_comm.trans $ same_ray_neg_smul_right_iff_of_ne hv hr

@[simp] lemma units_smul_eq_self_iff {u : Rˣ} {v : module.ray R M} :
  u • v = v ↔ (0 : R) < u :=
begin
  induction v using module.ray.ind with v hv,
  simp only [smul_ray_of_ne_zero, ray_eq_iff, units.smul_def,
    same_ray_smul_left_iff_of_ne hv u.ne_zero]
end

@[simp] lemma units_smul_eq_neg_iff {u : Rˣ} {v : module.ray R M} :
  u • v = -v ↔ ↑u < (0 : R) :=
by rw [← neg_inj, neg_neg, ← module.ray.neg_units_smul, units_smul_eq_self_iff, units.coe_neg,
  neg_pos]

end

end linear_ordered_comm_ring

namespace same_ray

variables {R : Type*} [linear_ordered_field R]
variables {M : Type*} [add_comm_group M] [module R M] {x y v₁ v₂ : M}

lemma exists_pos_left (h : same_ray R x y) (hx : x ≠ 0) (hy : y ≠ 0) :
  ∃ r : R, 0 < r ∧ r • x = y :=
let ⟨r₁, r₂, hr₁, hr₂, h⟩ := h.exists_pos hx hy in
  ⟨r₂⁻¹ * r₁, mul_pos (inv_pos.2 hr₂) hr₁, by rw [mul_smul, h, inv_smul_smul₀ hr₂.ne']⟩

lemma exists_pos_right (h : same_ray R x y) (hx : x ≠ 0) (hy : y ≠ 0) :
  ∃ r : R, 0 < r ∧ x = r • y :=
(h.symm.exists_pos_left hy hx).imp $ λ _, and.imp_right eq.symm

/-- If a vector `v₂` is on the same ray as a nonzero vector `v₁`, then it is equal to `c • v₁` for
some nonnegative `c`. -/
lemma exists_nonneg_left (h : same_ray R x y) (hx : x ≠ 0) : ∃ r : R, 0 ≤ r ∧ r • x = y :=
begin
  obtain rfl | hy := eq_or_ne y 0,
  { exact ⟨0, le_rfl, zero_smul _ _⟩ },
  { exact (h.exists_pos_left hx hy).imp (λ _, and.imp_left le_of_lt) }
end

/-- If a vector `v₁` is on the same ray as a nonzero vector `v₂`, then it is equal to `c • v₂` for
some nonnegative `c`. -/
lemma exists_nonneg_right (h : same_ray R x y) (hy : y ≠ 0) : ∃ r : R, 0 ≤ r ∧ x = r • y :=
(h.symm.exists_nonneg_left hy).imp $ λ _, and.imp_right eq.symm

/-- If vectors `v₁` and `v₂` are on the same ray, then for some nonnegative `a b`, `a + b = 1`, we
have `v₁ = a • (v₁ + v₂)` and `v₂ = b • (v₁ + v₂)`. -/
lemma exists_eq_smul_add (h : same_ray R v₁ v₂) :
  ∃ a b : R, 0 ≤ a ∧ 0 ≤ b ∧ a + b = 1 ∧ v₁ = a • (v₁ + v₂) ∧ v₂ = b • (v₁ + v₂) :=
begin
  rcases h with rfl|rfl|⟨r₁, r₂, h₁, h₂, H⟩,
  { use [0, 1], simp },
  { use [1, 0], simp },
  { have h₁₂ : 0 < r₁ + r₂, from add_pos h₁ h₂,
    refine ⟨r₂ / (r₁ + r₂), r₁ / (r₁ + r₂), div_nonneg h₂.le h₁₂.le, div_nonneg h₁.le h₁₂.le,
      _, _, _⟩,
    { rw [← add_div, add_comm, div_self h₁₂.ne'] },
    { rw [div_eq_inv_mul, mul_smul, smul_add, ← H, ← add_smul, add_comm r₂,
        inv_smul_smul₀ h₁₂.ne'] },
    { rw [div_eq_inv_mul, mul_smul, smul_add, H, ← add_smul, add_comm r₂,
        inv_smul_smul₀ h₁₂.ne'] } }
end

/-- If vectors `v₁` and `v₂` are on the same ray, then they are nonnegative multiples of the same
vector. Actually, this vector can be assumed to be `v₁ + v₂`, see `same_ray.exists_eq_smul_add`. -/
lemma exists_eq_smul (h : same_ray R v₁ v₂) :
  ∃ (u : M) (a b : R), 0 ≤ a ∧ 0 ≤ b ∧ a + b = 1 ∧ v₁ = a • u ∧ v₂ = b • u :=
⟨v₁ + v₂, h.exists_eq_smul_add⟩

end same_ray


def mul : ℕ→ℕ→ℕ := λ x y, x*y

--- Dependent Types
namespace hidden

universe u

constant list   : Type u → Type u

constant cons   : Π α : Type u, α → list α → list α
constant nil    : Π α : Type u, list α
constant head   : Π α : Type u, list α → α
constant tail   : Π α : Type u, list α → list α
constant append : Π α : Type u, list α → list α → list α

end hidden

--------------------
--------------------
--------------------
-- Ex 1

def Do_Twice : ((ℕ→ℕ)→ (ℕ→ℕ)) → (ℕ→ℕ) → ℕ → ℕ := λ F f, F (F f)
def do_twice : (ℕ→ℕ) → ℕ → ℕ := λ f x, f (f x)

#reduce Do_Twice do_twice (mul 2)

-- Ex 2

def curry (α β γ : Type) (f : α × β → γ) : α → β → γ := λ a b, f(a,b)

def uncurry (α β γ : Type) (f : α → β → γ) : α × β → γ := λ x, f x.1 x.2

def curry_mul := uncurry ℕ ℕ ℕ mul
#reduce curry_mul (2,3)
def mul' := curry ℕ ℕ ℕ curry_mul

lemma lem : ∀ a b : ℕ, mul a b = mul' a b :=
begin
    intros a b,
    refl,
end

-- Ex 3

universe u
constant vec : Type u → ℕ → Type u

namespace vec
  constant empty : Π α : Type u, vec α 0
  constant cons :
    Π (α : Type u) (n : ℕ), α → vec α n → vec α (n + 1)
  constant append :
    Π (α : Type u) (n m : ℕ),  vec α m → vec α n → vec α (n + m)
  constant vec_add : Π {α : Type u} {n : ℕ}, vec α n → vec α n → vec α n
  constant vec_reverse : Π {α : Type u} {n : ℕ}, vec α n → vec α n
end vec

constant α : Type
constant a : α
constants m n r : ℕ
constants v w : vec α n

#check vec.vec_add v w
#check vec.vec_reverse v

-- Ex 4
constant matrix : Type u → ℕ → ℕ → Type u

namespace matrix
  constant mat_mult : Π {α : Type u} {m n r : ℕ}, matrix α m n → matrix α n r → matrix α m r
  constant mat_add : Π {α : Type u} {m n :ℕ}, matrix α m n → matrix α m n → matrix α m n
end matrix

/-
    The question says to define matrices and then multiplication of vec and a
    matrix. But a vec is just a (let's say column) matrix...
-/

def vec' := λ β x, matrix β 1 x
#check vec'
#check vec


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

! This file was ported from Lean 3 source module algebra.category.Module.biproducts
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Group.Pi
import Mathbin.CategoryTheory.Limits.Shapes.Biproducts
import Mathbin.Algebra.Category.Module.Limits
import Mathbin.Algebra.Category.Module.Abelian
import Mathbin.Algebra.Homology.ShortExact.Abelian

/-!
# The category of `R`-modules has finite biproducts
-/

open CategoryTheory

open CategoryTheory.Limits

open BigOperators

universe w v u

namespace ModuleCat

variable {R : Type u} [Ring R]

-- As `Module R` is preadditive, and has all limits, it automatically has biproducts.
instance : HasBinaryBiproducts (ModuleCat.{v} R) :=
  HasBinaryBiproducts.of_hasBinaryProducts

instance : HasFiniteBiproducts (ModuleCat.{v} R) :=
  HasFiniteBiproducts.of_hasFiniteProducts

-- We now construct explicit limit data,
-- so we can compare the biproducts to the usual unbundled constructions.
/-- Construct limit data for a binary product in `Module R`, using `Module.of R (M × N)`.
-/
@[simps cone_x isLimit_lift]
def binaryProductLimitCone (M N : ModuleCat.{v} R) : Limits.LimitCone (pair M N)
    where
  Cone :=
    { pt := ModuleCat.of R (M × N)
      π :=
        { app := fun j =>
            Discrete.casesOn j fun j =>
              WalkingPair.casesOn j (LinearMap.fst R M N) (LinearMap.snd R M N)
          naturality' := by rintro ⟨⟨⟩⟩ ⟨⟨⟩⟩ ⟨⟨⟨⟩⟩⟩ <;> rfl } }
  IsLimit :=
    { lift := fun s => LinearMap.prod (s.π.app ⟨WalkingPair.left⟩) (s.π.app ⟨WalkingPair.right⟩)
      fac := by
        rintro s (⟨⟩ | ⟨⟩) <;>
          · ext x
            simp only [binary_fan.π_app_right, binary_fan.π_app_left, ModuleCat.coe_comp,
              Function.comp_apply, LinearMap.fst_apply, LinearMap.snd_apply, LinearMap.prod_apply,
              Pi.prod]
      uniq := fun s m w => by
        ext <;> [rw [← w ⟨walking_pair.left⟩], rw [← w ⟨walking_pair.right⟩]] <;> rfl }
#align Module.binary_product_limit_cone ModuleCat.binaryProductLimitCone

@[simp]
theorem binaryProductLimitCone_cone_π_app_left (M N : ModuleCat.{v} R) :
    (binaryProductLimitCone M N).Cone.π.app ⟨WalkingPair.left⟩ = LinearMap.fst R M N :=
  rfl
#align Module.binary_product_limit_cone_cone_π_app_left ModuleCat.binaryProductLimitCone_cone_π_app_left

@[simp]
theorem binaryProductLimitCone_cone_π_app_right (M N : ModuleCat.{v} R) :
    (binaryProductLimitCone M N).Cone.π.app ⟨WalkingPair.right⟩ = LinearMap.snd R M N :=
  rfl
#align Module.binary_product_limit_cone_cone_π_app_right ModuleCat.binaryProductLimitCone_cone_π_app_right

/-- We verify that the biproduct in `Module R` is isomorphic to
the cartesian product of the underlying types:
-/
@[simps hom_apply]
noncomputable def biprodIsoProd (M N : ModuleCat.{v} R) :
    (M ⊞ N : ModuleCat.{v} R) ≅ ModuleCat.of R (M × N) :=
  IsLimit.conePointUniqueUpToIso (BinaryBiproduct.isLimit M N) (binaryProductLimitCone M N).IsLimit
#align Module.biprod_iso_prod ModuleCat.biprodIsoProd

@[simp, elementwise]
theorem biprodIsoProd_inv_comp_fst (M N : ModuleCat.{v} R) :
    (biprodIsoProd M N).inv ≫ biprod.fst = LinearMap.fst R M N :=
  IsLimit.conePointUniqueUpToIso_inv_comp _ _ (Discrete.mk WalkingPair.left)
#align Module.biprod_iso_prod_inv_comp_fst ModuleCat.biprodIsoProd_inv_comp_fst

@[simp, elementwise]
theorem biprodIsoProd_inv_comp_snd (M N : ModuleCat.{v} R) :
    (biprodIsoProd M N).inv ≫ biprod.snd = LinearMap.snd R M N :=
  IsLimit.conePointUniqueUpToIso_inv_comp _ _ (Discrete.mk WalkingPair.right)
#align Module.biprod_iso_prod_inv_comp_snd ModuleCat.biprodIsoProd_inv_comp_snd

namespace HasLimit

variable {J : Type w} (f : J → ModuleCat.{max w v} R)

/-- The map from an arbitrary cone over a indexed family of abelian groups
to the cartesian product of those groups.
-/
@[simps]
def lift (s : Fan f) : s.pt ⟶ ModuleCat.of R (∀ j, f j)
    where
  toFun x j := s.π.app ⟨j⟩ x
  map_add' x y := by
    ext
    simp
  map_smul' r x := by
    ext
    simp
#align Module.has_limit.lift ModuleCat.HasLimit.lift

/-- Construct limit data for a product in `Module R`, using `Module.of R (Π j, F.obj j)`.
-/
@[simps]
def productLimitCone : Limits.LimitCone (Discrete.functor f)
    where
  Cone :=
    { pt := ModuleCat.of R (∀ j, f j)
      π := Discrete.natTrans fun j => (LinearMap.proj j.as : (∀ j, f j) →ₗ[R] f j.as) }
  IsLimit :=
    { lift := lift f
      fac := fun s j => by
        cases j
        ext
        simp
      uniq := fun s m w => by
        ext (x j)
        dsimp only [has_limit.lift]
        simp only [LinearMap.coe_mk]
        exact congr_arg (fun g : s.X ⟶ f j => (g : s.X → f j) x) (w ⟨j⟩) }
#align Module.has_limit.product_limit_cone ModuleCat.HasLimit.productLimitCone

end HasLimit

open HasLimit

variable {J : Type} (f : J → ModuleCat.{v} R)

/-- We verify that the biproduct we've just defined is isomorphic to the `Module R` structure
on the dependent function type
-/
@[simps hom_apply]
noncomputable def biproductIsoPi [Fintype J] (f : J → ModuleCat.{v} R) :
    (⨁ f : ModuleCat.{v} R) ≅ ModuleCat.of R (∀ j, f j) :=
  IsLimit.conePointUniqueUpToIso (biproduct.isLimit f) (productLimitCone f).IsLimit
#align Module.biproduct_iso_pi ModuleCat.biproductIsoPi

@[simp, elementwise]
theorem biproductIsoPi_inv_comp_π [Fintype J] (f : J → ModuleCat.{v} R) (j : J) :
    (biproductIsoPi f).inv ≫ biproduct.π f j = (LinearMap.proj j : (∀ j, f j) →ₗ[R] f j) :=
  IsLimit.conePointUniqueUpToIso_inv_comp _ _ (Discrete.mk j)
#align Module.biproduct_iso_pi_inv_comp_π ModuleCat.biproductIsoPi_inv_comp_π

end ModuleCat

section SplitExact

variable {R : Type u} {A M B : Type v} [Ring R] [AddCommGroup A] [Module R A] [AddCommGroup B]
  [Module R B] [AddCommGroup M] [Module R M]

variable {j : A →ₗ[R] M} {g : M →ₗ[R] B}

open ModuleCat

/-- The isomorphism `A × B ≃ₗ[R] M` coming from a right split exact sequence `0 ⟶ A ⟶ M ⟶ B ⟶ 0`
of modules.-/
noncomputable def lequivProdOfRightSplitExact {f : B →ₗ[R] M} (hj : Function.Injective j)
    (exac : j.range = g.ker) (h : g.comp f = LinearMap.id) : (A × B) ≃ₗ[R] M :=
  (({             RightSplit := ⟨asHom f, h⟩
                  mono := (ModuleCat.mono_iff_injective <| asHom j).mpr hj
                  exact := (exact_iff _ _).mpr exac } : RightSplit _ _).Splitting.Iso.trans <|
        biprodIsoProd _ _).toLinearEquiv.symm
#align lequiv_prod_of_right_split_exact lequivProdOfRightSplitExact

/-- The isomorphism `A × B ≃ₗ[R] M` coming from a left split exact sequence `0 ⟶ A ⟶ M ⟶ B ⟶ 0`
of modules.-/
noncomputable def lequivProdOfLeftSplitExact {f : M →ₗ[R] A} (hg : Function.Surjective g)
    (exac : j.range = g.ker) (h : f.comp j = LinearMap.id) : (A × B) ≃ₗ[R] M :=
  (({             LeftSplit := ⟨asHom f, h⟩
                  Epi := (ModuleCat.epi_iff_surjective <| asHom g).mpr hg
                  exact := (exact_iff _ _).mpr exac } : LeftSplit _ _).Splitting.Iso.trans <|
        biprodIsoProd _ _).toLinearEquiv.symm
#align lequiv_prod_of_left_split_exact lequivProdOfLeftSplitExact

end SplitExact


/-
Copyright (c) 2023 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov

! This file was ported from Lean 3 source module data.set.list
! leanprover-community/mathlib commit 2ec920d35348cb2d13ac0e1a2ad9df0fdf1a76b4
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Set.Image
import Mathlib.Data.List.Basic
import Mathlib.Data.Fin.Basic

/-!
# Lemmas about `List`s and `Set.range`

In this file we prove lemmas about range of some operations on lists.
-/

open List

variable {α β : Type _} (l : List α)

namespace Set

theorem range_list_map (f : α → β) : range (map f) = { l | ∀ x ∈ l, x ∈ range f } := by
  refine'
    antisymm (range_subset_iff.2 fun l => forall_mem_map_iff.2 fun y _ => mem_range_self _)
      fun l hl => _
  induction' l with a l ihl; · exact ⟨[], rfl⟩
  rcases ihl fun x hx => hl x <| subset_cons _ _ hx with ⟨l, rfl⟩
  rcases hl a (mem_cons_self _ _) with ⟨a, rfl⟩
  exact ⟨a :: l, map_cons _ _ _⟩
#align set.range_list_map Set.range_list_map

theorem range_list_map_coe (s : Set α) : range (map ((↑) : s → α)) = { l | ∀ x ∈ l, x ∈ s } := by
  rw [range_list_map, Subtype.range_coe]
#align set.range_list_map_coe Set.range_list_map_coe

@[simp]
theorem range_list_nthLe : (range fun k : Fin l.length => l.nthLe k k.2) = { x | x ∈ l } := by
  ext x
  rw [mem_setOf_eq, mem_iff_get]
  exact ⟨fun ⟨⟨n, h₁⟩, h₂⟩ => ⟨⟨n, h₁⟩, h₂⟩, fun ⟨⟨n, h₁⟩, h₂⟩ => ⟨⟨n, h₁⟩, h₂⟩⟩
#align set.range_list_nth_le Set.range_list_nthLe

theorem range_list_get? : range l.get? = insert none (some '' { x | x ∈ l }) := by
  rw [← range_list_nthLe, ← range_comp]
  refine' (range_subset_iff.2 fun n => _).antisymm (insert_subset.2 ⟨_, _⟩)
  exacts [(le_or_lt l.length n).imp get?_eq_none.2 (fun hlt => ⟨⟨_, hlt⟩, (get?_eq_get hlt).symm⟩),
    ⟨_, get?_eq_none.2 le_rfl⟩, range_subset_iff.2 <| fun k => ⟨_, get?_eq_get _⟩]
#align set.range_list_nth Set.range_list_get?

@[simp]
theorem range_list_getD (d : α) : (range fun n => l.getD n d) = insert d { x | x ∈ l } :=
  calc
    (range fun n => l.getD n d) = (fun o : Option α => o.getD d) '' range l.get? := by
      simp only [← range_comp, (· ∘ ·), getD_eq_getD_get?]
    _ = insert d { x | x ∈ l } := by
      simp only [range_list_get?, image_insert_eq, Option.getD, image_image, image_id']
#align set.range_list_nthd Set.range_list_getD

@[simp]
theorem range_list_getI [Inhabited α] (l : List α) : range l.getI = insert default { x | x ∈ l } :=
  range_list_getD l default
#align set.range_list_inth Set.range_list_getI

end Set

/-- If each element of a list can be lifted to some type, then the whole list can be
lifted to this type. -/
instance List.canLift (c) (p) [CanLift α β c p] :
    CanLift (List α) (List β) (List.map c) fun l => ∀ x ∈ l, p x where
  prf l H := by
    rw [← Set.mem_range, Set.range_list_map]
    exact fun a ha => CanLift.prf a (H a ha)
#align list.can_lift List.canLift


/-
Copyright (c) 2019 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Buzzard
-/
import data.real.basic
import data.real.ennreal
import data.sign

/-!
# The extended reals [-∞, ∞].

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

This file defines `ereal`, the real numbers together with a top and bottom element,
referred to as ⊤ and ⊥. It is implemented as `with_bot (with_top ℝ)`

Addition and multiplication are problematic in the presence of ±∞, but
negation has a natural definition and satisfies the usual properties.

An ad hoc addition is defined, for which `ereal` is an `add_comm_monoid`, and even an ordered one
(if `a ≤ a'` and `b ≤ b'` then `a + b ≤ a' + b'`).
Note however that addition is badly behaved at `(⊥, ⊤)` and `(⊤, ⊥)` so this can not be upgraded
to a group structure. Our choice is that `⊥ + ⊤ = ⊤ + ⊥ = ⊥`, to make sure that the exponential
and the logarithm between `ereal` and `ℝ≥0∞` respect the operations (notice that the
convention `0 * ∞ = 0` on `ℝ≥0∞` is enforced by measure theory).

An ad hoc subtraction is then defined by `x - y = x + (-y)`. It does not have nice properties,
but it is sometimes convenient to have.

An ad hoc multiplication is defined, for which `ereal` is a `comm_monoid_with_zero`. We make the
choice that `0 * x = x * 0 = 0` for any `x` (while the other cases are defined non-ambiguously).
This does not distribute with addition, as `⊥ = ⊥ + ⊤ = 1*⊥ + (-1)*⊥ ≠ (1 - 1) * ⊥ = 0 * ⊥ = 0`.

`ereal` is a `complete_linear_order`; this is deduced by type class inference from
the fact that `with_bot (with_top L)` is a complete linear order if `L` is
a conditionally complete linear order.

Coercions from `ℝ` and from `ℝ≥0∞` are registered, and their basic properties are proved. The main
one is the real coercion, and is usually referred to just as `coe` (lemmas such as
`ereal.coe_add` deal with this coercion). The one from `ennreal` is usually called `coe_ennreal`
in the `ereal` namespace.

We define an absolute value `ereal.abs` from `ereal` to `ℝ≥0∞`. Two elements of `ereal` coincide
if and only if they have the same absolute value and the same sign.

## Tags

real, ereal, complete lattice
-/

open function
open_locale ennreal nnreal

noncomputable theory

/-- ereal : The type `[-∞, ∞]` -/
@[derive [has_bot, has_zero, has_one, nontrivial, add_monoid,
  has_Sup, has_Inf, complete_linear_order, linear_ordered_add_comm_monoid, zero_le_one_class]]
def ereal := with_bot (with_top ℝ)

/-- The canonical inclusion froms reals to ereals. Do not use directly: as this is registered as
a coercion, use the coercion instead. -/
def real.to_ereal : ℝ → ereal := some ∘ some

namespace ereal

-- things unify with `with_bot.decidable_lt` later if we we don't provide this explicitly.
instance decidable_lt : decidable_rel ((<) : ereal → ereal → Prop) :=
with_bot.decidable_lt

-- TODO: Provide explicitly, otherwise it is inferred noncomputably from `complete_linear_order`
instance : has_top ereal := ⟨some ⊤⟩

instance : has_coe ℝ ereal := ⟨real.to_ereal⟩

lemma coe_strict_mono : strict_mono (coe : ℝ → ereal) :=
with_bot.coe_strict_mono.comp with_top.coe_strict_mono

lemma coe_injective : injective (coe : ℝ → ereal) := coe_strict_mono.injective

@[simp, norm_cast] protected lemma coe_le_coe_iff {x y : ℝ} : (x : ereal) ≤ (y : ereal) ↔ x ≤ y :=
coe_strict_mono.le_iff_le
@[simp, norm_cast] protected lemma coe_lt_coe_iff {x y : ℝ} : (x : ereal) < (y : ereal) ↔ x < y :=
coe_strict_mono.lt_iff_lt
@[simp, norm_cast] protected lemma coe_eq_coe_iff {x y : ℝ} : (x : ereal) = (y : ereal) ↔ x = y :=
coe_injective.eq_iff
protected lemma coe_ne_coe_iff {x y : ℝ} : (x : ereal) ≠ (y : ereal) ↔ x ≠ y := coe_injective.ne_iff

/-- The canonical map from nonnegative extended reals to extended reals -/
def _root_.ennreal.to_ereal : ℝ≥0∞ → ereal
| ⊤ := ⊤
| (some x) := x.1

instance has_coe_ennreal : has_coe ℝ≥0∞ ereal := ⟨ennreal.to_ereal⟩

instance : inhabited ereal := ⟨0⟩

@[simp, norm_cast] lemma coe_zero : ((0 : ℝ) : ereal) = 0 := rfl
@[simp, norm_cast] lemma coe_one : ((1 : ℝ) : ereal) = 1 := rfl

/-- A recursor for `ereal` in terms of the coercion.

A typical invocation looks like `induction x using ereal.rec`. Note that using `induction`
directly will unfold `ereal` to `option` which is undesirable.

When working in term mode, note that pattern matching can be used directly. -/
@[elab_as_eliminator]
protected def rec {C : ereal → Sort*} (h_bot : C ⊥) (h_real : Π a : ℝ, C a) (h_top : C ⊤) :
  ∀ a : ereal, C a
| ⊥ := h_bot
| (a : ℝ) := h_real a
| ⊤ := h_top

/-- The multiplication on `ereal`. Our definition satisfies `0 * x = x * 0 = 0` for any `x`, and
picks the only sensible value elsewhere. -/
protected def mul : ereal → ereal → ereal
| ⊥ ⊥ := ⊤
| ⊥ ⊤ := ⊥
| ⊥ (y : ℝ) := if 0 < y then ⊥ else if y = 0 then 0 else ⊤
| ⊤ ⊥ := ⊥
| ⊤ ⊤ := ⊤
| ⊤ (y : ℝ) := if 0 < y then ⊤ else if y = 0 then 0 else ⊥
| (x : ℝ) ⊤ := if 0 < x then ⊤ else if x = 0 then 0 else ⊥
| (x : ℝ) ⊥ := if 0 < x then ⊥ else if x = 0 then 0 else ⊤
| (x : ℝ) (y : ℝ) := (x * y : ℝ)

instance : has_mul ereal := ⟨ereal.mul⟩

/-- Induct on two ereals by performing case splits on the sign of one whenever the other is
infinite. -/
@[elab_as_eliminator]
lemma induction₂ {P : ereal → ereal → Prop}
  (top_top : P ⊤ ⊤)
  (top_pos : ∀ x : ℝ, 0 < x → P ⊤ x)
  (top_zero : P ⊤ 0)
  (top_neg : ∀ x : ℝ, x < 0 → P ⊤ x)
  (top_bot : P ⊤ ⊥)
  (pos_top : ∀ x : ℝ, 0 < x → P x ⊤)
  (pos_bot : ∀ x : ℝ, 0 < x → P x ⊥)
  (zero_top : P 0 ⊤)
  (coe_coe : ∀ x y : ℝ, P x y)
  (zero_bot : P 0 ⊥)
  (neg_top : ∀ x : ℝ, x < 0 → P x ⊤)
  (neg_bot : ∀ x : ℝ, x < 0 → P x ⊥)
  (bot_top : P ⊥ ⊤)
  (bot_pos : ∀ x : ℝ, 0 < x → P ⊥ x)
  (bot_zero : P ⊥ 0)
  (bot_neg : ∀ x : ℝ, x < 0 → P ⊥ x)
  (bot_bot : P ⊥ ⊥) :
  ∀ x y, P x y
| ⊥ ⊥ := bot_bot
| ⊥ (y : ℝ) :=
  by { rcases lt_trichotomy 0 y with hy|rfl|hy, exacts [bot_pos y hy, bot_zero, bot_neg y hy] }
| ⊥ ⊤ := bot_top
| (x : ℝ) ⊥ :=
  by { rcases lt_trichotomy 0 x with hx|rfl|hx, exacts [pos_bot x hx, zero_bot, neg_bot x hx] }
| (x : ℝ) (y : ℝ) := coe_coe _ _
| (x : ℝ) ⊤ :=
  by { rcases lt_trichotomy 0 x with hx|rfl|hx, exacts [pos_top x hx, zero_top, neg_top x hx] }
| ⊤ ⊥ := top_bot
| ⊤ (y : ℝ) :=
  by { rcases lt_trichotomy 0 y with hy|rfl|hy, exacts [top_pos y hy, top_zero, top_neg y hy] }
| ⊤ ⊤ := top_top

/-! `ereal` with its multiplication is a `comm_monoid_with_zero`. However, the proof of
associativity by hand is extremely painful (with 125 cases...). Instead, we will deduce it later
on from the facts that the absolute value and the sign are multiplicative functions taking value
in associative objects, and that they characterize an extended real number. For now, we only
record more basic properties of multiplication.
-/
instance : mul_zero_one_class ereal :=
{ one_mul := λ x, begin
    induction x using ereal.rec;
    { dsimp only [(*)], simp only [ereal.mul, ← ereal.coe_one, zero_lt_one, if_true, one_mul] },
  end,
  mul_one := λ x, begin
    induction x using ereal.rec;
    { dsimp only [(*)], simp only [ereal.mul, ← ereal.coe_one, zero_lt_one, if_true, mul_one] },
  end,
  zero_mul := λ x, begin
    induction x using ereal.rec;
    { simp only [(*)], simp only [ereal.mul, ← ereal.coe_zero, zero_lt_one, if_true, if_false,
        lt_irrefl (0 : ℝ), eq_self_iff_true, zero_mul] },
  end,
  mul_zero := λ x, begin
    induction x using ereal.rec;
    { simp only [(*)], simp only [ereal.mul, ← ereal.coe_zero, zero_lt_one, if_true, if_false,
        lt_irrefl (0 : ℝ), eq_self_iff_true, mul_zero] },
  end,
  ..ereal.has_mul, ..ereal.has_one, ..ereal.has_zero }

/-! ### Real coercion -/

instance can_lift : can_lift ereal ℝ coe (λ r, r ≠ ⊤ ∧ r ≠ ⊥) :=
{ prf := λ x hx,
  begin
    induction x using ereal.rec,
    { simpa using hx },
    { simp },
    { simpa using hx }
  end }

/-- The map from extended reals to reals sending infinities to zero. -/
def to_real : ereal → ℝ
| ⊥       := 0
| ⊤       := 0
| (x : ℝ) := x

@[simp] lemma to_real_top : to_real ⊤ = 0 := rfl

@[simp] lemma to_real_bot : to_real ⊥ = 0 := rfl

@[simp] lemma to_real_zero : to_real 0 = 0 := rfl

@[simp] lemma to_real_one : to_real 1 = 1 := rfl

@[simp] lemma to_real_coe (x : ℝ) : to_real (x : ereal) = x := rfl

@[simp] lemma bot_lt_coe (x : ℝ) : (⊥ : ereal) < x := with_bot.bot_lt_coe _

@[simp] lemma coe_ne_bot (x : ℝ) : (x : ereal) ≠ ⊥  := (bot_lt_coe x).ne'

@[simp] lemma bot_ne_coe (x : ℝ) : (⊥ : ereal) ≠ x := (bot_lt_coe x).ne

@[simp] lemma coe_lt_top (x : ℝ) : (x : ereal) < ⊤ :=
by { apply with_bot.coe_lt_coe.2, exact with_top.coe_lt_top _ }

@[simp] lemma coe_ne_top (x : ℝ) : (x : ereal) ≠ ⊤ := (coe_lt_top x).ne

@[simp] lemma top_ne_coe (x : ℝ) : (⊤ : ereal) ≠ x := (coe_lt_top x).ne'

@[simp] lemma bot_lt_zero : (⊥ : ereal) < 0 := bot_lt_coe 0

@[simp] lemma bot_ne_zero : (⊥ : ereal) ≠ 0 := (coe_ne_bot 0).symm

@[simp] lemma zero_ne_bot : (0 : ereal) ≠ ⊥ := coe_ne_bot 0

@[simp] lemma zero_lt_top : (0 : ereal) < ⊤ := coe_lt_top 0

@[simp] lemma zero_ne_top : (0 : ereal) ≠ ⊤ := coe_ne_top 0

@[simp] lemma top_ne_zero : (⊤ : ereal) ≠ 0 := (coe_ne_top 0).symm

@[simp, norm_cast] lemma coe_add (x y : ℝ) : (↑(x + y) : ereal) = x + y := rfl
@[simp, norm_cast] lemma coe_mul (x y : ℝ) : (↑(x * y) : ereal) = x * y := rfl
@[norm_cast] lemma coe_nsmul (n : ℕ) (x : ℝ) : (↑(n • x) : ereal) = n • x :=
map_nsmul (⟨coe, coe_zero, coe_add⟩ : ℝ →+ ereal) _ _

@[simp, norm_cast] lemma coe_bit0 (x : ℝ) : (↑(bit0 x) : ereal) = bit0 x := rfl
@[simp, norm_cast] lemma coe_bit1 (x : ℝ) : (↑(bit1 x) : ereal) = bit1 x := rfl

@[simp, norm_cast] lemma coe_eq_zero {x : ℝ} : (x : ereal) = 0 ↔ x = 0 := ereal.coe_eq_coe_iff
@[simp, norm_cast] lemma coe_eq_one {x : ℝ} : (x : ereal) = 1 ↔ x = 1 := ereal.coe_eq_coe_iff
lemma coe_ne_zero {x : ℝ} : (x : ereal) ≠ 0 ↔ x ≠ 0 := ereal.coe_ne_coe_iff
lemma coe_ne_one {x : ℝ} : (x : ereal) ≠ 1 ↔ x ≠ 1 := ereal.coe_ne_coe_iff

@[simp, norm_cast] protected lemma coe_nonneg {x : ℝ} : (0 : ereal) ≤ x ↔ 0 ≤ x :=
ereal.coe_le_coe_iff

@[simp, norm_cast] protected lemma coe_nonpos {x : ℝ} : (x : ereal) ≤ 0 ↔ x ≤ 0 :=
ereal.coe_le_coe_iff

@[simp, norm_cast] protected lemma coe_pos {x : ℝ} : (0 : ereal) < x ↔ 0 < x :=
ereal.coe_lt_coe_iff

@[simp, norm_cast] protected lemma coe_neg' {x : ℝ} : (x : ereal) < 0 ↔ x < 0 :=
ereal.coe_lt_coe_iff

lemma to_real_le_to_real {x y : ereal} (h : x ≤ y) (hx : x ≠ ⊥) (hy : y ≠ ⊤) :
  x.to_real ≤ y.to_real :=
begin
  lift x to ℝ,
  { simp [hx, (h.trans_lt (lt_top_iff_ne_top.2 hy)).ne], },
  lift y to ℝ,
  { simp [hy, ((bot_lt_iff_ne_bot.2 hx).trans_le h).ne'] },
  simpa using h
end

lemma coe_to_real {x : ereal} (hx : x ≠ ⊤) (h'x : x ≠ ⊥) : (x.to_real : ereal) = x :=
begin
  induction x using ereal.rec,
  { simpa using h'x },
  { refl },
  { simpa using hx },
end

lemma le_coe_to_real {x : ereal} (h : x ≠ ⊤) : x ≤ x.to_real :=
begin
  by_cases h' : x = ⊥,
  { simp only [h', bot_le] },
  { simp only [le_refl, coe_to_real h h'] },
end

lemma coe_to_real_le {x : ereal} (h : x ≠ ⊥) : ↑x.to_real ≤ x :=
begin
  by_cases h' : x = ⊤,
  { simp only [h', le_top] },
  { simp only [le_refl, coe_to_real h' h] },
end

lemma eq_top_iff_forall_lt (x : ereal) : x = ⊤ ↔ ∀ (y : ℝ), (y : ereal) < x :=
begin
  split,
  { rintro rfl, exact ereal.coe_lt_top },
  { contrapose!,
    intro h,
    exact ⟨x.to_real, le_coe_to_real h⟩, },
end

lemma eq_bot_iff_forall_lt (x : ereal) : x = ⊥ ↔ ∀ (y : ℝ), x < (y : ereal) :=
begin
  split,
  { rintro rfl, exact bot_lt_coe },
  { contrapose!,
    intro h,
    exact ⟨x.to_real, coe_to_real_le h⟩, },
end

/-! ### ennreal coercion -/

@[simp] lemma to_real_coe_ennreal : ∀ {x : ℝ≥0∞}, to_real (x : ereal) = ennreal.to_real x
| ⊤ := rfl
| (some x) := rfl

@[simp] lemma coe_ennreal_of_real {x : ℝ} :
  (ennreal.of_real x : ereal) = max x 0 :=
rfl

lemma coe_nnreal_eq_coe_real (x : ℝ≥0) : ((x : ℝ≥0∞) : ereal) = (x : ℝ) := rfl

@[simp, norm_cast] lemma coe_ennreal_zero : ((0 : ℝ≥0∞) : ereal) = 0 := rfl
@[simp, norm_cast] lemma coe_ennreal_one : ((1 : ℝ≥0∞) : ereal) = 1 := rfl
@[simp, norm_cast] lemma coe_ennreal_top : ((⊤ : ℝ≥0∞) : ereal) = ⊤ := rfl

@[simp] lemma coe_ennreal_eq_top_iff : ∀ {x : ℝ≥0∞}, (x : ereal) = ⊤ ↔ x = ⊤
| ⊤ := by simp
| (some x) := by { simp only [ennreal.coe_ne_top, iff_false, ennreal.some_eq_coe], dec_trivial }

lemma coe_nnreal_ne_top (x : ℝ≥0) : ((x : ℝ≥0∞) : ereal) ≠ ⊤ := dec_trivial

@[simp] lemma coe_nnreal_lt_top (x : ℝ≥0) : ((x : ℝ≥0∞) : ereal) < ⊤ := dec_trivial

lemma coe_ennreal_strict_mono : strict_mono (coe : ℝ≥0∞ → ereal)
| ⊤ ⊤ := by simp
| (some x) ⊤ := by simp
| ⊤ (some y) := by simp
| (some x) (some y) := by simp [coe_nnreal_eq_coe_real]

lemma coe_ennreal_injective : injective (coe : ℝ≥0∞ → ereal) := coe_ennreal_strict_mono.injective

@[simp, norm_cast] lemma coe_ennreal_le_coe_ennreal_iff {x y : ℝ≥0∞} :
  (x : ereal) ≤ (y : ereal) ↔ x ≤ y :=
coe_ennreal_strict_mono.le_iff_le

@[simp, norm_cast] lemma coe_ennreal_lt_coe_ennreal_iff {x y : ℝ≥0∞} :
  (x : ereal) < (y : ereal) ↔ x < y :=
coe_ennreal_strict_mono.lt_iff_lt

@[simp, norm_cast] lemma coe_ennreal_eq_coe_ennreal_iff {x y : ℝ≥0∞} :
  (x : ereal) = (y : ereal) ↔ x = y :=
coe_ennreal_injective.eq_iff

lemma coe_ennreal_ne_coe_ennreal_iff {x y : ℝ≥0∞} : (x : ereal) ≠ (y : ereal) ↔ x ≠ y :=
coe_ennreal_injective.ne_iff

@[simp, norm_cast] lemma coe_ennreal_eq_zero {x : ℝ≥0∞} : (x : ereal) = 0 ↔ x = 0 :=
by rw [←coe_ennreal_eq_coe_ennreal_iff, coe_ennreal_zero]

@[simp, norm_cast] lemma coe_ennreal_eq_one {x : ℝ≥0∞} : (x : ereal) = 1 ↔ x = 1 :=
by rw [←coe_ennreal_eq_coe_ennreal_iff, coe_ennreal_one]

@[norm_cast] lemma coe_ennreal_ne_zero {x : ℝ≥0∞} : (x : ereal) ≠ 0 ↔ x ≠ 0 :=
coe_ennreal_eq_zero.not

@[norm_cast] lemma coe_ennreal_ne_one {x : ℝ≥0∞} : (x : ereal) ≠ 1 ↔ x ≠ 1 := coe_ennreal_eq_one.not

lemma coe_ennreal_nonneg (x : ℝ≥0∞) : (0 : ereal) ≤ x :=
coe_ennreal_le_coe_ennreal_iff.2 (zero_le x)

@[simp, norm_cast] lemma coe_ennreal_pos {x : ℝ≥0∞} : (0 : ereal) < x ↔ 0 < x :=
by rw [←coe_ennreal_zero, coe_ennreal_lt_coe_ennreal_iff]

@[simp] lemma bot_lt_coe_ennreal (x : ℝ≥0∞) : (⊥ : ereal) < x :=
(bot_lt_coe 0).trans_le (coe_ennreal_nonneg _)

@[simp] lemma coe_ennreal_ne_bot (x : ℝ≥0∞) : (x : ereal) ≠ ⊥ := (bot_lt_coe_ennreal x).ne'

@[simp, norm_cast] lemma coe_ennreal_add (x y : ennreal) : ((x + y : ℝ≥0∞) : ereal) = x + y :=
by cases x; cases y; refl

@[simp, norm_cast] lemma coe_ennreal_mul : ∀ (x y : ℝ≥0∞), ((x * y : ℝ≥0∞) : ereal) = x * y
| ⊤ ⊤ := rfl
| ⊤ (y : ℝ≥0) := begin
    rw ennreal.top_mul, split_ifs,
    { simp only [h, coe_ennreal_zero, mul_zero] },
    { have A : (0 : ℝ) < y,
      { simp only [ennreal.coe_eq_zero] at h,
        exact nnreal.coe_pos.2 (bot_lt_iff_ne_bot.2 h) },
      simp only [coe_nnreal_eq_coe_real, coe_ennreal_top, (*), ereal.mul, A, if_true], }
  end
| (x : ℝ≥0) ⊤ := begin
    rw ennreal.mul_top, split_ifs,
    { simp only [h, coe_ennreal_zero, zero_mul] },
    { have A : (0 : ℝ) < x,
      { simp only [ennreal.coe_eq_zero] at h,
        exact nnreal.coe_pos.2 (bot_lt_iff_ne_bot.2 h) },
      simp only [coe_nnreal_eq_coe_real, coe_ennreal_top, (*), ereal.mul, A, if_true] }
  end
| (x : ℝ≥0) (y : ℝ≥0) := by simp only [← ennreal.coe_mul, coe_nnreal_eq_coe_real,
    nnreal.coe_mul, ereal.coe_mul]

@[norm_cast] lemma coe_ennreal_nsmul (n : ℕ) (x : ℝ≥0∞) : (↑(n • x) : ereal) = n • x :=
map_nsmul (⟨coe, coe_ennreal_zero, coe_ennreal_add⟩ : ℝ≥0∞ →+ ereal) _ _

@[simp, norm_cast] lemma coe_ennreal_bit0 (x : ℝ≥0∞) : (↑(bit0 x) : ereal) = bit0 x :=
coe_ennreal_add _ _
@[simp, norm_cast] lemma coe_ennreal_bit1 (x : ℝ≥0∞) : (↑(bit1 x) : ereal) = bit1 x :=
by simp_rw [bit1, coe_ennreal_add, coe_ennreal_bit0, coe_ennreal_one]

/-! ### Order -/

lemma exists_rat_btwn_of_lt : Π {a b : ereal} (hab : a < b),
  ∃ (x : ℚ), a < (x : ℝ) ∧ ((x : ℝ) : ereal) < b
| ⊤ b h := (not_top_lt h).elim
| (a : ℝ) ⊥ h := (lt_irrefl _ ((bot_lt_coe a).trans h)).elim
| (a : ℝ) (b : ℝ) h := by simp [exists_rat_btwn (ereal.coe_lt_coe_iff.1 h)]
| (a : ℝ) ⊤ h := let ⟨b, hab⟩ := exists_rat_gt a in ⟨b, by simpa using hab, coe_lt_top _⟩
| ⊥ ⊥ h := (lt_irrefl _ h).elim
| ⊥ (a : ℝ) h := let ⟨b, hab⟩ := exists_rat_lt a in ⟨b, bot_lt_coe _, by simpa using hab⟩
| ⊥ ⊤ h := ⟨0, bot_lt_coe _, coe_lt_top _⟩

lemma lt_iff_exists_rat_btwn {a b : ereal} :
  a < b ↔ ∃ (x : ℚ), a < (x : ℝ) ∧ ((x : ℝ) : ereal) < b :=
⟨λ hab, exists_rat_btwn_of_lt hab, λ ⟨x, ax, xb⟩, ax.trans xb⟩

lemma lt_iff_exists_real_btwn {a b : ereal} :
  a < b ↔ ∃ (x : ℝ), a < x ∧ (x : ereal) < b :=
⟨λ hab, let ⟨x, ax, xb⟩ := exists_rat_btwn_of_lt hab in ⟨(x : ℝ), ax, xb⟩,
 λ ⟨x, ax, xb⟩, ax.trans xb⟩

/-- The set of numbers in `ereal` that are not equal to `±∞` is equivalent to `ℝ`. -/
def ne_top_bot_equiv_real : ({⊥, ⊤}ᶜ : set ereal) ≃ ℝ :=
{ to_fun := λ x, ereal.to_real x,
  inv_fun := λ x, ⟨x, by simp⟩,
  left_inv := λ ⟨x, hx⟩, subtype.eq $ begin
    lift x to ℝ,
    { simpa [not_or_distrib, and_comm] using hx },
    { simp },
  end,
  right_inv := λ x, by simp }

/-! ### Addition -/

@[simp] lemma add_bot (x : ereal) : x + ⊥ = ⊥ := with_bot.add_bot _
@[simp] lemma bot_add (x : ereal) : ⊥ + x = ⊥ := with_bot.bot_add _

@[simp] lemma top_add_top : (⊤ : ereal) + ⊤ = ⊤ := rfl
@[simp] lemma top_add_coe (x : ℝ) : (⊤ : ereal) + x = ⊤ := rfl
@[simp] lemma coe_add_top (x : ℝ) : (x : ereal) + ⊤ = ⊤ := rfl

lemma to_real_add : ∀ {x y : ereal} (hx : x ≠ ⊤) (h'x : x ≠ ⊥) (hy : y ≠ ⊤) (h'y : y ≠ ⊥),
  to_real (x + y) = to_real x + to_real y
| ⊥ y hx h'x hy h'y := (h'x rfl).elim
| ⊤ y hx h'x hy h'y := (hx rfl).elim
| x ⊤ hx h'x hy h'y := (hy rfl).elim
| x ⊥ hx h'x hy h'y := (h'y rfl).elim
| (x : ℝ) (y : ℝ) hx h'x hy h'y := by simp [← ereal.coe_add]

lemma add_lt_add_right_coe {x y : ereal} (h : x < y) (z : ℝ) : x + z < y + z :=
begin
  induction x using ereal.rec; induction y using ereal.rec,
  { exact (lt_irrefl _ h).elim },
  { simp only [← coe_add, bot_add, bot_lt_coe] },
  { simp },
  { exact (lt_irrefl _ (h.trans (bot_lt_coe x))).elim },
  { norm_cast at h ⊢, exact add_lt_add_right h _ },
  { simp only [← coe_add, top_add_coe, coe_lt_top] },
  { exact (lt_irrefl _ (h.trans_le le_top)).elim },
  { exact (lt_irrefl _ (h.trans_le le_top)).elim },
  { exact (lt_irrefl _ (h.trans_le le_top)).elim },
end

lemma add_lt_add_of_lt_of_le {x y z t : ereal} (h : x < y) (h' : z ≤ t) (hz : z ≠ ⊥) (ht : t ≠ ⊤) :
  x + z < y + t :=
begin
  induction z using ereal.rec,
  { simpa only using hz },
  { calc x + z < y + z : add_lt_add_right_coe h _
           ... ≤ y + t : add_le_add le_rfl h' },
  { exact (ht (top_le_iff.1 h')).elim }
end

lemma add_lt_add_left_coe {x y : ereal} (h : x < y) (z : ℝ) : (z : ereal) + x < z + y :=
by simpa [add_comm] using add_lt_add_right_coe h z

lemma add_lt_add {x y z t : ereal} (h1 : x < y) (h2 : z < t) : x + z < y + t :=
begin
  induction x using ereal.rec,
  { simp [bot_lt_iff_ne_bot, h1.ne', (bot_le.trans_lt h2).ne'] },
  { calc (x : ereal) + z < x + t : add_lt_add_left_coe h2 _
    ... ≤ y + t : add_le_add h1.le le_rfl },
  { exact (lt_irrefl _ (h1.trans_le le_top)).elim }
end

@[simp] lemma add_eq_bot_iff {x y : ereal} : x + y = ⊥ ↔ x = ⊥ ∨ y = ⊥ :=
begin
  induction x using ereal.rec; induction y using ereal.rec;
  simp [← ereal.coe_add],
end

@[simp] lemma bot_lt_add_iff {x y : ereal} : ⊥ < x + y ↔ ⊥ < x ∧ ⊥ < y :=
by simp [bot_lt_iff_ne_bot, not_or_distrib]

lemma add_lt_top {x y : ereal} (hx : x ≠ ⊤) (hy : y ≠ ⊤) : x + y < ⊤ :=
by { rw ← ereal.top_add_top, exact ereal.add_lt_add hx.lt_top hy.lt_top }

/-! ### Negation -/

/-- negation on `ereal` -/
protected def neg : ereal → ereal
| ⊥       := ⊤
| ⊤       := ⊥
| (x : ℝ) := (-x : ℝ)

instance : has_neg ereal := ⟨ereal.neg⟩

instance : sub_neg_zero_monoid ereal :=
{ neg_zero := by { change ((-0 : ℝ) : ereal) = 0, simp },
  ..ereal.add_monoid, ..ereal.has_neg }

@[norm_cast] protected lemma neg_def (x : ℝ) : ((-x : ℝ) : ereal) = -x := rfl

@[simp] lemma neg_top : - (⊤ : ereal) = ⊥ := rfl
@[simp] lemma neg_bot : - (⊥ : ereal) = ⊤ := rfl

@[simp, norm_cast] lemma coe_neg (x : ℝ) : (↑(-x) : ereal) = -x := rfl
@[simp, norm_cast] lemma coe_sub (x y : ℝ) : (↑(x - y) : ereal) = x - y := rfl
@[norm_cast] lemma coe_zsmul (n : ℤ) (x : ℝ) : (↑(n • x) : ereal) = n • x :=
map_zsmul' (⟨coe, coe_zero, coe_add⟩ : ℝ →+ ereal) coe_neg _ _

instance : has_involutive_neg ereal :=
{ neg := has_neg.neg,
  neg_neg := λ a, match a with
    | ⊥ := rfl
    | ⊤ := rfl
    | (a : ℝ) := by { norm_cast, simp [neg_neg a] }
    end }

@[simp] lemma to_real_neg : ∀ {a : ereal}, to_real (-a) = - to_real a
| ⊤ := by simp
| ⊥ := by simp
| (x : ℝ) := rfl

@[simp] lemma neg_eq_top_iff {x : ereal} : - x = ⊤ ↔ x = ⊥ :=
neg_eq_iff_eq_neg

@[simp] lemma neg_eq_bot_iff {x : ereal} : - x = ⊥ ↔ x = ⊤ :=
neg_eq_iff_eq_neg

@[simp] lemma neg_eq_zero_iff {x : ereal} : - x = 0 ↔ x = 0 :=
by rw [neg_eq_iff_eq_neg, neg_zero]

/-- if `-a ≤ b` then `-b ≤ a` on `ereal`. -/
protected theorem neg_le_of_neg_le {a b : ereal} (h : -a ≤ b) : -b ≤ a :=
begin
  induction a using ereal.rec; induction b using ereal.rec,
  { exact h },
  { simpa only [coe_ne_top, neg_bot, top_le_iff] using h },
  { exact bot_le },
  { simpa only [coe_ne_top, le_bot_iff] using h },
  { norm_cast at h ⊢, exact neg_le.1 h },
  { exact bot_le },
  { exact le_top },
  { exact le_top },
  { exact le_top },
end

/-- `-a ≤ b ↔ -b ≤ a` on `ereal`. -/
protected theorem neg_le {a b : ereal} : -a ≤ b ↔ -b ≤ a :=
⟨ereal.neg_le_of_neg_le, ereal.neg_le_of_neg_le⟩

/-- `a ≤ -b → b ≤ -a` on ereal -/
theorem le_neg_of_le_neg {a b : ereal} (h : a ≤ -b) : b ≤ -a :=
by rwa [←neg_neg b, ereal.neg_le, neg_neg]

@[simp] lemma neg_le_neg_iff {a b : ereal} : - a ≤ - b ↔ b ≤ a :=
by conv_lhs { rw [ereal.neg_le, neg_neg] }

/-- Negation as an order reversing isomorphism on `ereal`. -/
def neg_order_iso : ereal ≃o erealᵒᵈ :=
{ to_fun := λ x, order_dual.to_dual (-x),
  inv_fun := λ x, -x.of_dual,
  map_rel_iff' := λ x y, neg_le_neg_iff,
  ..equiv.neg ereal }

lemma neg_lt_of_neg_lt {a b : ereal} (h : -a < b) : -b < a :=
begin
  apply lt_of_le_of_ne (ereal.neg_le_of_neg_le h.le),
  assume H,
  rw [← H, neg_neg] at h,
  exact lt_irrefl _ h
end

lemma neg_lt_iff_neg_lt {a b : ereal} : -a < b ↔ -b < a :=
⟨λ h, ereal.neg_lt_of_neg_lt h, λ h, ereal.neg_lt_of_neg_lt h⟩

/-!
### Subtraction

Subtraction on `ereal` is defined by `x - y = x + (-y)`. Since addition is badly behaved at some
points, so is subtraction. There is no standard algebraic typeclass involving subtraction that is
registered on `ereal`, beyond `sub_neg_zero_monoid`, because of this bad behavior.
-/

@[simp] lemma bot_sub (x : ereal) : ⊥ - x = ⊥ := bot_add x
@[simp] lemma sub_top (x : ereal) : x - ⊤ = ⊥ := add_bot x

@[simp] lemma top_sub_bot : (⊤ : ereal) - ⊥ = ⊤ := rfl
@[simp] lemma top_sub_coe (x : ℝ) : (⊤ : ereal) - x = ⊤ := rfl
@[simp] lemma coe_sub_bot (x : ℝ) : (x : ereal) - ⊥ = ⊤ := rfl

lemma sub_le_sub {x y z t : ereal} (h : x ≤ y) (h' : t ≤ z) : x - z ≤ y - t :=
add_le_add h (neg_le_neg_iff.2 h')

lemma sub_lt_sub_of_lt_of_le {x y z t : ereal} (h : x < y) (h' : z ≤ t) (hz : z ≠ ⊥) (ht : t ≠ ⊤) :
  x - t < y - z :=
add_lt_add_of_lt_of_le h (neg_le_neg_iff.2 h') (by simp [ht]) (by simp [hz])

lemma coe_real_ereal_eq_coe_to_nnreal_sub_coe_to_nnreal (x : ℝ) :
  (x : ereal) = real.to_nnreal x - real.to_nnreal (-x) :=
begin
  rcases le_or_lt 0 x with h|h,
  { have : real.to_nnreal x = ⟨x, h⟩, by { ext, simp [h] },
    simp only [real.to_nnreal_of_nonpos (neg_nonpos.mpr h), this, sub_zero, ennreal.coe_zero,
      coe_ennreal_zero, coe_coe],
    refl },
  { have : (x : ereal) = - (- x : ℝ), by simp,
    conv_lhs { rw this },
    have : real.to_nnreal (-x) = ⟨-x, neg_nonneg.mpr h.le⟩, by { ext, simp [neg_nonneg.mpr h.le], },
    simp only [real.to_nnreal_of_nonpos h.le, this, zero_sub, neg_inj, coe_neg,
      ennreal.coe_zero, coe_ennreal_zero, coe_coe],
    refl }
end

lemma to_real_sub {x y : ereal} (hx : x ≠ ⊤) (h'x : x ≠ ⊥) (hy : y ≠ ⊤) (h'y : y ≠ ⊥) :
  to_real (x - y) = to_real x - to_real y :=
begin
  rw [sub_eq_add_neg, to_real_add hx h'x, to_real_neg],
  { refl },
  { simpa using hy },
  { simpa using h'y }
end

/-! ### Multiplication -/

protected lemma mul_comm (x y : ereal) : x * y = y * x :=
begin
  induction x using ereal.rec; induction y using ereal.rec; try { refl },
  dsimp only [(*)],
  simp only [ereal.mul, mul_comm],
end

@[simp] lemma top_mul_top : (⊤ : ereal) * ⊤ = ⊤ := rfl
@[simp] lemma top_mul_bot : (⊤ : ereal) * ⊥ = ⊥ := rfl
@[simp] lemma bot_mul_top : (⊥ : ereal) * ⊤ = ⊥ := rfl
@[simp] lemma bot_mul_bot : (⊥ : ereal) * ⊥ = ⊤ := rfl

lemma mul_top_of_pos {x : ereal} (h : 0 < x) : x * ⊤ = ⊤ :=
begin
  induction x using ereal.rec,
  { simpa only [not_lt_bot] using h },
  { simp only [has_mul.mul, ereal.mul, ereal.coe_pos.1 h, if_true] },
  { refl }
end

lemma mul_top_of_neg {x : ereal} (h : x < 0) : x * ⊤ = ⊥ :=
begin
  induction x using ereal.rec,
  { refl },
  { simp only [ereal.coe_neg'] at h,
    simp only [has_mul.mul, ereal.mul, not_lt.2 h.le, h.ne, if_false] },
  { simpa only [not_top_lt] using h }
end

lemma top_mul_of_pos {x : ereal} (h : 0 < x) : ⊤ * x = ⊤ :=
by { rw ereal.mul_comm, exact mul_top_of_pos h }

lemma top_mul_of_neg {x : ereal} (h : x < 0) : ⊤ * x = ⊥ :=
by { rw ereal.mul_comm, exact mul_top_of_neg h }

lemma coe_mul_top_of_pos {x : ℝ} (h : 0 < x) : (x : ereal) * ⊤ = ⊤ :=
mul_top_of_pos (ereal.coe_pos.2 h)

lemma coe_mul_top_of_neg {x : ℝ} (h : x < 0) : (x : ereal) * ⊤ = ⊥ :=
mul_top_of_neg (ereal.coe_neg'.2 h)

lemma top_mul_coe_of_pos {x : ℝ} (h : 0 < x) : (⊤ : ereal) * x = ⊤ :=
top_mul_of_pos (ereal.coe_pos.2 h)

lemma top_mul_coe_of_neg {x : ℝ} (h : x < 0) : (⊤ : ereal) * x = ⊥ :=
top_mul_of_neg (ereal.coe_neg'.2 h)

lemma mul_bot_of_pos {x : ereal} (h : 0 < x) : x * ⊥ = ⊥ :=
begin
  induction x using ereal.rec,
  { simpa only [not_lt_bot] using h },
  { simp only [has_mul.mul, ereal.mul, ereal.coe_pos.1 h, if_true] },
  { refl }
end

lemma mul_bot_of_neg {x : ereal} (h : x < 0) : x * ⊥ = ⊤ :=
begin
  induction x using ereal.rec,
  { refl },
  { simp only [ereal.coe_neg'] at h,
    simp only [has_mul.mul, ereal.mul, not_lt.2 h.le, h.ne, if_false] },
  { simpa only [not_top_lt] using h }
end

lemma bot_mul_of_pos {x : ereal} (h : 0 < x) : ⊥ * x = ⊥ :=
by { rw ereal.mul_comm, exact mul_bot_of_pos h }

lemma bot_mul_of_neg {x : ereal} (h : x < 0) : ⊥ * x = ⊤ :=
by { rw ereal.mul_comm, exact mul_bot_of_neg h }

lemma coe_mul_bot_of_pos {x : ℝ} (h : 0 < x) : (x : ereal) * ⊥ = ⊥ :=
mul_bot_of_pos (ereal.coe_pos.2 h)

lemma coe_mul_bot_of_neg {x : ℝ} (h : x < 0) : (x : ereal) * ⊥ = ⊤ :=
mul_bot_of_neg (ereal.coe_neg'.2 h)

lemma bot_mul_coe_of_pos {x : ℝ} (h : 0 < x) : (⊥ : ereal) * x = ⊥ :=
bot_mul_of_pos (ereal.coe_pos.2 h)

lemma to_real_mul {x y : ereal} : to_real (x * y) = to_real x * to_real y :=
begin
  -- TODO: replace with `induction using` in Lean 4, which supports multiple premises
  with_cases
  { apply @induction₂ (λ x y, to_real (x * y) = to_real x * to_real y) };
    propagate_tags { try { dsimp only} },
  case [top_zero, bot_zero, zero_top, zero_bot] { all_goals { simp only [zero_mul, mul_zero,
                                                                         to_real_zero] } },
  case coe_coe : x y { norm_cast },
  case top_top { rw [top_mul_top, to_real_top, mul_zero] },
  case top_bot { rw [top_mul_bot, to_real_top, to_real_bot, zero_mul] },
  case bot_top { rw [bot_mul_top, to_real_bot, zero_mul] },
  case bot_bot { rw [bot_mul_bot, to_real_top, to_real_bot, zero_mul] },
  case pos_bot : x hx
  { rw [to_real_bot, to_real_coe, coe_mul_bot_of_pos hx, to_real_bot, mul_zero] },
  case neg_bot : x hx
  { rw [to_real_bot, to_real_coe, coe_mul_bot_of_neg hx, to_real_top, mul_zero] },
  case pos_top : x hx
  { rw [to_real_top, to_real_coe, coe_mul_top_of_pos hx, to_real_top, mul_zero] },
  case neg_top : x hx
  { rw [to_real_top, to_real_coe, coe_mul_top_of_neg hx, to_real_bot, mul_zero] },
  case top_pos : y hy
  { rw [to_real_top, to_real_coe, top_mul_coe_of_pos hy, to_real_top, zero_mul] },
  case top_neg : y hy
  { rw [to_real_top, to_real_coe, top_mul_coe_of_neg hy, to_real_bot, zero_mul] },
  case bot_pos : y hy
  { rw [to_real_bot, to_real_coe, bot_mul_coe_of_pos hy, to_real_bot, zero_mul] },
  case bot_neg : y hy
  { rw [to_real_bot, to_real_coe, bot_mul_coe_of_neg hy, to_real_top, zero_mul] },
end

protected lemma neg_mul (x y : ereal) : -x * y = -(x * y) :=
begin
  -- TODO: replace with `induction using` in Lean 4, which supports multiple premises
  with_cases
  { apply @induction₂ (λ x y, -x * y = -(x * y)) };
    propagate_tags { try { dsimp only} },
  case [top_top, bot_top, top_bot, bot_bot] { all_goals { refl } },
  case [top_zero, bot_zero, zero_top, zero_bot]
  { all_goals { simp only [zero_mul, mul_zero, neg_zero] } },
  case coe_coe : x y { norm_cast, exact neg_mul _ _, },
  case pos_bot : x hx
  { rw [coe_mul_bot_of_pos hx, neg_bot, ← coe_neg, coe_mul_bot_of_neg (neg_neg_of_pos hx)] },
  case neg_bot : x hx
  { rw [coe_mul_bot_of_neg hx, neg_top, ← coe_neg, coe_mul_bot_of_pos (neg_pos_of_neg hx)] },
  case pos_top : x hx
  { rw [coe_mul_top_of_pos hx, neg_top, ← coe_neg, coe_mul_top_of_neg (neg_neg_of_pos hx)] },
  case neg_top : x hx
  { rw [coe_mul_top_of_neg hx, neg_bot, ← coe_neg, coe_mul_top_of_pos (neg_pos_of_neg hx)] },
  case top_pos : y hy { rw [top_mul_coe_of_pos hy, neg_top, bot_mul_coe_of_pos hy] },
  case top_neg : y hy { rw [top_mul_coe_of_neg hy, neg_top, neg_bot, bot_mul_coe_of_neg hy] },
  case bot_pos : y hy { rw [bot_mul_coe_of_pos hy, neg_bot, top_mul_coe_of_pos hy] },
  case bot_neg : y hy { rw [bot_mul_coe_of_neg hy, neg_bot, neg_top, top_mul_coe_of_neg hy] },
end

instance : has_distrib_neg ereal :=
{ neg_mul := ereal.neg_mul,
  mul_neg := λ x y, by { rw [x.mul_comm, x.mul_comm], exact y.neg_mul x, },
  ..ereal.has_involutive_neg }

/-! ### Absolute value -/

/-- The absolute value from `ereal` to `ℝ≥0∞`, mapping `⊥` and `⊤` to `⊤` and
a real `x` to `|x|`. -/
protected def abs : ereal → ℝ≥0∞
| ⊥ := ⊤
| ⊤ := ⊤
| (x : ℝ) := ennreal.of_real (|x|)

@[simp] lemma abs_top : (⊤ : ereal).abs = ⊤ := rfl
@[simp] lemma abs_bot : (⊥ : ereal).abs = ⊤ := rfl

lemma abs_def (x : ℝ) : (x : ereal).abs = ennreal.of_real (|x|) := rfl

lemma abs_coe_lt_top (x : ℝ) : (x : ereal).abs < ⊤ :=
ennreal.of_real_lt_top

@[simp] lemma abs_eq_zero_iff {x : ereal} : x.abs = 0 ↔ x = 0 :=
begin
  induction x using ereal.rec,
  { simp only [abs_bot, ennreal.top_ne_zero, bot_ne_zero] },
  { simp only [ereal.abs, coe_eq_zero, ennreal.of_real_eq_zero, abs_nonpos_iff] },
  { simp only [abs_top, ennreal.top_ne_zero, top_ne_zero] }
end

@[simp] lemma abs_zero : (0 : ereal).abs = 0 :=
by rw [abs_eq_zero_iff]

@[simp] lemma coe_abs (x : ℝ) : ((x : ereal).abs : ereal) = (|x| : ℝ) :=
by rcases lt_trichotomy 0 x with hx | rfl | hx; simp [abs_def]

@[simp] lemma abs_mul (x y : ereal) : (x * y).abs = x.abs * y.abs :=
begin
   -- TODO: replace with `induction using` in Lean 4, which supports multiple premises
  with_cases
  { apply @induction₂ (λ x y, (x * y).abs = x.abs * y.abs) };
    propagate_tags { try { dsimp only} },
  case [top_top, bot_top, top_bot, bot_bot] { all_goals { refl } },
  case [top_zero, bot_zero, zero_top, zero_bot] { all_goals { simp only [zero_mul, mul_zero,
                                                                         abs_zero] } },
  case coe_coe : x y { simp only [← coe_mul, ereal.abs, abs_mul,
                                  ennreal.of_real_mul (abs_nonneg _)], },
  case pos_bot : x hx { simp only [coe_mul_bot_of_pos hx, hx.ne', abs_bot, with_top.mul_top, ne.def,
                                   abs_eq_zero_iff, coe_eq_zero, not_false_iff] },
  case neg_bot : x hx { simp only [coe_mul_bot_of_neg hx, hx.ne, abs_bot, with_top.mul_top, ne.def,
                                   abs_eq_zero_iff, coe_eq_zero, not_false_iff, abs_top] },
  case pos_top : x hx { simp only [coe_mul_top_of_pos hx, hx.ne', with_top.mul_top, ne.def,
                                   abs_eq_zero_iff, coe_eq_zero, not_false_iff, abs_top] },
  case neg_top : x hx { simp only [coe_mul_top_of_neg hx, hx.ne, abs_bot, with_top.mul_top, ne.def,
                                   abs_eq_zero_iff, coe_eq_zero, not_false_iff, abs_top] },
  case top_pos : y hy { simp only [top_mul_coe_of_pos hy, hy.ne', with_top.top_mul, ne.def,
                                   abs_eq_zero_iff, coe_eq_zero, not_false_iff, abs_top] },
  case top_neg : y hy { simp only [top_mul_coe_of_neg hy, hy.ne, abs_bot, with_top.top_mul, ne.def,
                                   abs_eq_zero_iff, coe_eq_zero, not_false_iff, abs_top] },
  case bot_pos : y hy { simp only [bot_mul_coe_of_pos hy, hy.ne', abs_bot, with_top.top_mul, ne.def,
                                   abs_eq_zero_iff, coe_eq_zero, not_false_iff] },
  case bot_neg : y hy { simp only [bot_mul_coe_of_neg hy, hy.ne, abs_bot, with_top.top_mul, ne.def,
                                   abs_eq_zero_iff, coe_eq_zero, not_false_iff, abs_top] },
end

/-! ### Sign -/

@[simp] lemma sign_top : sign (⊤ : ereal) = 1 := rfl
@[simp] lemma sign_bot : sign (⊥ : ereal) = -1 := rfl
@[simp] lemma sign_coe (x : ℝ) : sign (x : ereal) = sign x :=
by simp only [sign, order_hom.coe_fun_mk, ereal.coe_pos, ereal.coe_neg']

@[simp] lemma sign_mul (x y : ereal) : sign (x * y) = sign x * sign y :=
begin
   -- TODO: replace with `induction using` in Lean 4, which supports multiple premises
  with_cases
  { apply @induction₂ (λ x y, sign (x * y) = sign x * sign y) };
    propagate_tags { try { dsimp only} },
  case [top_top, bot_top, top_bot, bot_bot] { all_goals { refl } },
  case [top_zero, bot_zero, zero_top, zero_bot] { all_goals { simp only [zero_mul, mul_zero,
                                                                         sign_zero] } },
  case coe_coe : x y { simp only [← coe_mul, sign_coe, sign_mul], },
  case pos_bot : x hx { simp_rw [coe_mul_bot_of_pos hx, sign_coe, sign_pos hx, one_mul] },
  case neg_bot : x hx { simp_rw [coe_mul_bot_of_neg hx, sign_coe, sign_neg hx, sign_top, sign_bot,
                                 neg_one_mul, neg_neg] },
  case pos_top : x hx { simp_rw [coe_mul_top_of_pos hx, sign_coe, sign_pos hx, one_mul] },
  case neg_top : x hx { simp_rw [coe_mul_top_of_neg hx, sign_coe, sign_neg hx, sign_top, sign_bot,
                                 mul_one] },
  case top_pos : y hy { simp_rw [top_mul_coe_of_pos hy, sign_coe, sign_pos hy, mul_one] },
  case top_neg : y hy { simp_rw [top_mul_coe_of_neg hy, sign_coe, sign_neg hy, sign_top, sign_bot,
                                 one_mul] },
  case bot_pos : y hy { simp_rw [bot_mul_coe_of_pos hy, sign_coe, sign_pos hy, mul_one] },
  case bot_neg : y hy { simp_rw [bot_mul_coe_of_neg hy, sign_coe, sign_neg hy, sign_top, sign_bot,
                                 neg_one_mul, neg_neg] },
end

lemma sign_mul_abs (x : ereal) :
  (sign x * x.abs : ereal) = x :=
begin
  induction x using ereal.rec,
  { simp },
  { rcases lt_trichotomy 0 x with hx | rfl | hx,
    { simp [sign_pos hx, abs_of_pos hx] },
    { simp },
    { simp [sign_neg hx, abs_of_neg hx] } },
  { simp }
end

lemma sign_eq_and_abs_eq_iff_eq {x y : ereal} :
  (x.abs = y.abs ∧ sign x = sign y) ↔ x = y :=
begin
  split,
  { rintros ⟨habs, hsign⟩, rw [← x.sign_mul_abs, ← y.sign_mul_abs, habs, hsign] },
  { rintros rfl, simp only [eq_self_iff_true, and_self] }
end

lemma le_iff_sign {x y : ereal} :
  x ≤ y ↔ sign x < sign y ∨
    sign x = sign_type.neg ∧ sign y = sign_type.neg ∧ y.abs ≤ x.abs ∨
    sign x = sign_type.zero ∧ sign y = sign_type.zero ∨
    sign x = sign_type.pos ∧ sign y = sign_type.pos ∧ x.abs ≤ y.abs :=
begin
  split,
  { intro h,
    rcases (sign.monotone h).lt_or_eq with hs | hs,
    { exact or.inl hs },
    { rw [← x.sign_mul_abs, ← y.sign_mul_abs] at h,
      cases sign y; rw [hs] at *,
      { simp },
      { simp at ⊢ h, exact or.inl h },
      { simpa using h, }, }, },
  { rintros (h | h | h | h), { exact (sign.monotone.reflect_lt h).le, },
    all_goals { rw [← x.sign_mul_abs, ← y.sign_mul_abs], simp [h] } }
end

instance : comm_monoid_with_zero ereal :=
{ mul_assoc := λ x y z, begin
    rw [← sign_eq_and_abs_eq_iff_eq],
    simp only [mul_assoc, abs_mul, eq_self_iff_true, sign_mul, and_self],
  end,
  mul_comm := ereal.mul_comm,
  ..ereal.has_mul, ..ereal.has_one, ..ereal.has_zero, ..ereal.mul_zero_one_class }

instance : pos_mul_mono ereal :=
pos_mul_mono_iff_covariant_pos.2 ⟨begin
  rintros ⟨x, x0⟩ a b h, dsimp,
  rcases le_iff_sign.mp h with h | h | h | h,
  { rw [le_iff_sign], left, simp [sign_pos x0, h] },
  all_goals { rw [← x.sign_mul_abs, ← a.sign_mul_abs, ← b.sign_mul_abs, sign_pos x0],
    simp only [h], dsimp,
    simp only [neg_mul, mul_neg, ereal.neg_le_neg_iff, one_mul, le_refl, zero_mul, mul_zero] },
  all_goals { norm_cast, exact mul_le_mul_left' h.2.2 _, },
end⟩
instance : mul_pos_mono ereal := pos_mul_mono_iff_mul_pos_mono.1 ereal.pos_mul_mono
instance : pos_mul_reflect_lt ereal := pos_mul_mono.to_pos_mul_reflect_lt
instance : mul_pos_reflect_lt ereal := mul_pos_mono.to_mul_pos_reflect_lt

@[simp, norm_cast] lemma coe_pow (x : ℝ) (n : ℕ) : (↑(x ^ n) : ereal) = x ^ n :=
map_pow (⟨coe, coe_one, coe_mul⟩ : ℝ →* ereal) _ _

@[simp, norm_cast] lemma coe_ennreal_pow (x : ℝ≥0∞) (n : ℕ) : (↑(x ^ n) : ereal) = x ^ n :=
map_pow (⟨coe, coe_ennreal_one, coe_ennreal_mul⟩ : ℝ≥0∞ →* ereal) _ _

end ereal

namespace tactic
open positivity

private lemma ereal_coe_ne_zero {r : ℝ} : r ≠ 0 → (r : ereal) ≠ 0 := ereal.coe_ne_zero.2
private lemma ereal_coe_nonneg {r : ℝ} : 0 ≤ r → 0 ≤ (r : ereal) := ereal.coe_nonneg.2
private lemma ereal_coe_pos {r : ℝ} : 0 < r → 0 < (r : ereal) := ereal.coe_pos.2
private lemma ereal_coe_ennreal_pos {r : ℝ≥0∞} : 0 < r → 0 < (r : ereal) := ereal.coe_ennreal_pos.2

/-- Extension for the `positivity` tactic: cast from `ℝ` to `ereal`. -/
@[positivity]
meta def positivity_coe_real_ereal : expr → tactic strictness
| `(@coe _ _ %%inst %%a) := do
  unify inst `(@coe_to_lift _ _ $ @coe_base _ _ ereal.has_coe),
  strictness_a ← core a,
  match strictness_a with
  | positive p := positive <$> mk_app ``ereal_coe_pos [p]
  | nonnegative p := nonnegative <$> mk_mapp ``ereal_coe_nonneg [a, p]
  | nonzero p := nonzero <$> mk_mapp ``ereal_coe_ne_zero [a, p]
  end
| e := pp e >>= fail ∘ format.bracket "The expression "
         " is not of the form `(r : ereal)` for `r : ℝ`"

/-- Extension for the `positivity` tactic: cast from `ℝ≥0∞` to `ereal`. -/
@[positivity]
meta def positivity_coe_ennreal_ereal : expr → tactic strictness
| `(@coe _ _ %%inst %%a) := do
  unify inst `(@coe_to_lift _ _ $ @coe_base _ _ ereal.has_coe_ennreal),
  strictness_a ← core a,
  match strictness_a with
  | positive p := positive <$> mk_app ``ereal_coe_ennreal_pos [p]
  | _ := nonnegative <$> mk_mapp `ereal.coe_ennreal_nonneg [a]
  end
| e := pp e >>= fail ∘ format.bracket "The expression "
         " is not of the form `(r : ereal)` for `r : ℝ≥0∞`"

end tactic


/-
Copyright (c) 2016 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Mario Carneiro, Johannes Hölzl

! This file was ported from Lean 3 source module algebra.order.monoid.units
! leanprover-community/mathlib commit f1a2caaf51ef593799107fe9a8d5e411599f3996
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Order.Hom.Basic
import Mathlib.Order.MinMax
import Mathlib.Algebra.Group.Units

/-!
# Units in ordered monoids
-/

namespace Units

@[to_additive]
instance [Monoid α] [Preorder α] : Preorder αˣ :=
  Preorder.lift val

@[to_additive (attr := simp, norm_cast)]
theorem val_le_val [Monoid α] [Preorder α] {a b : αˣ} : (a : α) ≤ b ↔ a ≤ b :=
  Iff.rfl
#align units.coe_le_coe Units.val_le_val
#align add_units.coe_le_coe AddUnits.val_le_val

@[to_additive (attr := simp, norm_cast)]
theorem val_lt_val [Monoid α] [Preorder α] {a b : αˣ} : (a : α) < b ↔ a < b :=
  Iff.rfl
#align units.coe_lt_coe Units.val_lt_val
#align add_units.coe_lt_coe AddUnits.val_lt_val

@[to_additive]
instance [Monoid α] [PartialOrder α] : PartialOrder αˣ :=
  PartialOrder.lift val Units.ext
#align units.partial_order Units.instPartialOrderUnits
#align add_units.partial_order AddUnits.instPartialOrderAddUnits

@[to_additive]
instance [Monoid α] [LinearOrder α] : LinearOrder αˣ :=
  LinearOrder.lift' val Units.ext

/-- `val : αˣ → α` as an order embedding. -/
@[to_additive (attr := simps (config := { fullyApplied := false }))
  "`val : add_units α → α` as an order embedding."]
def orderEmbeddingVal [Monoid α] [LinearOrder α] : αˣ ↪o α :=
  ⟨⟨val, ext⟩, Iff.rfl⟩
#align units.order_embedding_coe Units.orderEmbeddingVal
#align add_units.order_embedding_coe AddUnits.orderEmbeddingVal

@[to_additive (attr := simp, norm_cast)]
theorem max_val [Monoid α] [LinearOrder α] {a b : αˣ} : (max a b).val = max a.val b.val :=
  Monotone.map_max orderEmbeddingVal.monotone
#align units.max_coe Units.max_val
#align add_units.max_coe AddUnits.max_val

@[to_additive (attr := simp, norm_cast)]
theorem min_val [Monoid α] [LinearOrder α] {a b : αˣ} : (min a b).val = min a.val b.val :=
  Monotone.map_min orderEmbeddingVal.monotone
#align units.min_coe Units.min_val
#align add_units.min_coe AddUnits.min_val

end Units


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

From: https://github.com/leanprover-community/mathlib/blob/71b1be63560d43c689b2c1338ed1366619ce2940/src/linear_algebra/tensor_algebra/grading.lean
-/
import linear_algebra.tensor_algebra.basic

import cicm2022.internal.graded_ring

/-!
# Results about the grading structure of the tensor algebra

The main result is `tensor_algebra.graded_algebra`, which says that the tensor algebra is a
ℕ-graded algebra.
-/

namespace tensor_algebra
variables {R M : Type*} [comm_semiring R] [add_comm_monoid M] [module R M]

open_locale direct_sum

variables (R M)

/-- A version of `tensor_algebra.ι` that maps directly into the graded structure. This is
primarily an auxiliary construction used to provide `tensor_algebra.graded_algebra`. -/
def graded_algebra.ι : M →ₗ[R] ⨁ i : ℕ, ↥((ι R : M →ₗ[_] _).range ^ i) :=
direct_sum.lof R ℕ (λ i, ↥((ι R : M →ₗ[_] _).range ^ i)) 1
  ∘ₗ (ι R).cod_restrict _ (λ m, by simpa only [pow_one] using linear_map.mem_range_self _ m)

lemma graded_algebra.ι_apply (m : M) :
  graded_algebra.ι R M m =
    direct_sum.of (λ i, ↥((ι R : M →ₗ[_] _).range ^ i)) 1
      (⟨ι R m, by simpa only [pow_one] using linear_map.mem_range_self _ m⟩) := rfl

variables {R M}

/-- The tensor algebra is graded by the powers of the submodule `(tensor_algebra.ι R).range`. -/
instance graded_algebra :
  graded_algebra ((^) (ι R : M →ₗ[R] tensor_algebra R M).range : ℕ → submodule R _) :=
graded_algebra.of_alg_hom _
  (lift _ $ graded_algebra.ι R M)
  (begin
    ext m,
    dsimp only [linear_map.comp_apply, alg_hom.to_linear_map_apply, alg_hom.comp_apply,
      alg_hom.id_apply],
    rw [lift_ι_apply, graded_algebra.ι_apply, direct_sum.coe_alg_hom_of, subtype.coe_mk],
  end)
  (λ i x, begin
    cases x with x hx,
    dsimp only [subtype.coe_mk, direct_sum.lof_eq_of],
    refine submodule.pow_induction_on_left' _
      (λ r, _) (λ x y i hx hy ihx ihy, _) (λ m hm i x hx ih, _) hx,
    { rw [alg_hom.commutes, direct_sum.algebra_map_apply], refl },
    { rw [alg_hom.map_add, ihx, ihy, ←map_add], refl },
    { obtain ⟨_, rfl⟩ := hm,
      rw [alg_hom.map_mul, ih, lift_ι_apply, graded_algebra.ι_apply, direct_sum.of_mul_of],
      exact direct_sum.of_eq_of_graded_monoid_eq (sigma.subtype_ext (add_comm _ _) rfl) }
  end)

end tensor_algebra


/-
Copyright (c) 2020 Bryan Gin-ge Chen. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Lacker, Bryan Gin-ge Chen
-/
import data.nat.prime
import data.int.basic
/-!
# Lemmas about nat.prime using `int`s
-/

open nat

namespace int

lemma not_prime_of_int_mul {a b : ℤ} {c : ℕ}
  (ha : 1 < a.nat_abs) (hb : 1 < b.nat_abs) (hc : a*b = (c : ℤ)) : ¬ prime c :=
not_prime_mul' (nat_abs_mul_nat_abs_eq hc) ha hb

end int


import linear_algebra.free_module

section pid_module

variables {ι : Type*} {R : Type*} [integral_domain R] [is_principal_ideal_ring R]
variables {M  : Type*} [add_comm_group M] [module R M] {b : ι → M}

-- Theorem 2.10 from Conrad (page 5)
theorem theorem_2_10
  (n m : ℕ)
  (bM : fin m → M)
  (freeM : is_basis R bM) -- M is a free R-module of rank m
  (N : submodule R M)
  (bN : fin n → N)
  (freeN : is_basis R bN) -- N is a submodule of M of rank n
  (rank_le : n ≤ m)       -- of smaller rank (that is always true)
  (nonzero : 0 < n)       -- N is nonzero
   : ∃ (bM' : fin m → M)  -- there exists a basis of M
       (bN' : fin n → N)  -- there exists a basis of N
       (a : fin n → R),   -- and a list of coefficients
      is_basis R bN' ∧    -- bN' is a basis of N
      ∀ i : fin n, ↑(bN' i) = a i • bM' (fin.cast_le rank_le i) ∧ -- s.t. (bN' i) is a scalar multiple of (bN i)
      ∀ i : fin n.pred, a (fin.cast_le (nat.pred_le n) i) ∣
                       a (fin.cast (nat.succ_pred_eq_of_pos nonzero) i.succ) -- a i divides a (i+1) for all i < n
        :=
begin
  sorry,
end

end pid_module


variable U : Type
variable A : U -> Prop
section
example : (¬ ∃ x, A x) → ∀ x, ¬ A x :=
assume h1: ¬ ∃ x, A x,
show ∀ x, ¬ A x,from
assume t,
assume h2: A t,
show false, from h1 (exists.intro t h2)
end
section
example : (∀ x, ¬ A x) → ¬ ∃ x, A x :=
assume h1: ∀ x, ¬ A x,
assume h2: ∃ x, A x,
exists.elim h2 $
assume t (h3: A t),
show false, from (h1 t) h3
end


import data.nat.basic
import data.real.basic
import order.basic

/- IMO 2007 Problem 1

Given a sequence a₁, a₂, ... aₙ of real numbers. For each i (1≤i≤n) define

                 dᵢ = max { aⱼ : 1≤j≤i } - min { aⱼ : i≤j≤n }

and let

                 d = max { dᵢ : 1≤i≤n }.

(a) Prove that for arbitrary real numbers x₁ ≤ x₂ ≤ ... ≤ xₙ,

                 max { |xᵢ - aᵢ| : 1≤i≤n } ≥ d/2.       (1)

(b) Show that there exists a sequence x₁ ≤ x₂ ≤ ... ≤ xₙ of real numbers
such that we have equality in (1).

-/

lemma lemma_1 {x y z: ℝ} (h: z ≤ x + y) : z / 2 ≤ x ∨ z / 2 ≤ y :=
begin
  by_contra H,
  push_neg at H,
  obtain ⟨h1, h2⟩ := H,
  linarith,
end

noncomputable def xx_seq (a: ℕ → ℝ) : ℕ → ℝ
 | 0 := a 0
 | m@(nat.succ k) := max (xx_seq k) (a m)

lemma xx_seq_monotone (a: ℕ → ℝ) : monotone (xx_seq a) :=
begin
  have h: ∀ n, xx_seq a n ≤ xx_seq a (nat.succ n),
  {
    intro n,
    unfold xx_seq,
    exact le_max_left (xx_seq a n) (a (nat.succ n)),
  },
  exact monotone_nat_of_le_succ h,
end

lemma monotone_fin_of_nat {n : ℕ} (f: ℕ → ℝ) (h : monotone f) : monotone (λ m: fin n, f m.val) :=
begin
  intros m1 m2 hm,
  exact h hm,
end

noncomputable def x_seq' {n : ℕ} (d: ℝ) (a: fin n → ℝ) : ℕ → ℝ :=
xx_seq (λm, if h: m < n then (a ⟨m, h⟩ - d/2) else 0)

noncomputable def x_seq {n : ℕ} (d : ℝ) (a: fin n → ℝ) : fin n → ℝ :=
λ m, x_seq' d a m.val

lemma x_seq_monotone {n : ℕ} (d : ℝ) (a : fin n → ℝ) : monotone (x_seq d a) :=
begin
  exact monotone_fin_of_nat (x_seq' d a) (xx_seq_monotone _),
end

theorem imo2007_q1
  (n : ℕ)
  (a b c d: fin n → ℝ)
  (hb : ∀i: fin n, is_greatest {x : ℝ | ∃ j : fin n, j ≤ i ∧ x = a j } (b i))
  (hc : ∀i: fin n, is_least {x : ℝ | ∃ j : fin n, i ≤ j ∧ x = a j } (c i))
  (hd : ∀i: fin n, d i = b i - c i )
  (dm : ℝ)
  (hdm : is_greatest {x : ℝ | ∃ i : fin n, x = d i} dm)
  : (∀ x: fin n → ℝ, monotone x → ∃ i : fin n, dm / 2 ≤ abs (x i - a i) )
    ∧ (∃ x: fin n → ℝ, monotone x ∧
         (∃ i : fin n, dm / 2 = abs (x i - a i))
        ∧ ∀ i : fin n, abs (x i - a i) ≤ dm / 2) :=
begin
  obtain ⟨⟨q, hq⟩, hqq⟩ := hdm,
  obtain ⟨⟨p, hp, hp1⟩, hpp⟩ := hb q,
  obtain ⟨⟨r, hr, hr1⟩, hrr⟩ := hc q,
  have hpr := le_trans hp hr,
  have hdi := hd q,
  split,
  { intros x x_mono,

    have h0 : 0 ≤ x r - x p := sub_nonneg.mpr (x_mono hpr),

    have h1 := calc dm
         = a p - a r : by {sorry}
     ... ≤ (a p - a r) + (x r - x p) : le_add_of_nonneg_right h0
     ... = (a p - x p) + (x r - a r) : by ring,

    obtain hpm | hrm := lemma_1 h1,
    { use p,
      calc dm / 2 ≤ a p - x p : hpm
              ... ≤ abs (a p - x p) : le_abs_self _
              ... = abs (x p - a p) : abs_sub_comm _ _ },
    { use r,
      calc dm / 2 ≤ x r - a r : hrm
              ... ≤ abs (x r - a r) : le_abs_self _ }
  },
  {
    use x_seq dm a,
    split,
    { exact x_seq_monotone dm a, },
    { split,
      { sorry },
      { sorry },
    },
  },
end


/-
Copyright (c) Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.analysis.calculus.times_cont_diff
import Mathlib.analysis.complex.basic
import Mathlib.PostPort

namespace Mathlib

/-! # Real differentiability of complex-differentiable functions

`has_deriv_at.real_of_complex` expresses that, if a function on `ℂ` is differentiable (over `ℂ`),
then its restriction to `ℝ` is differentiable over `ℝ`, with derivative the real part of the
complex derivative.
-/

/-! ### Differentiability of the restriction to `ℝ` of complex functions -/

/-- If a complex function is differentiable at a real point, then the induced real function is also
differentiable at this point, with a derivative equal to the real part of the complex derivative. -/
theorem has_deriv_at.real_of_complex {e : ℂ → ℂ} {e' : ℂ} {z : ℝ} (h : has_deriv_at e e' ↑z) : has_deriv_at (fun (x : ℝ) => complex.re (e ↑x)) (complex.re e') z := sorry

theorem times_cont_diff_at.real_of_complex {e : ℂ → ℂ} {z : ℝ} {n : with_top ℕ} (h : times_cont_diff_at ℂ n e ↑z) : times_cont_diff_at ℝ n (fun (x : ℝ) => complex.re (e ↑x)) z := sorry

theorem times_cont_diff.real_of_complex {e : ℂ → ℂ} {n : with_top ℕ} (h : times_cont_diff ℂ n e) : times_cont_diff ℝ n fun (x : ℝ) => complex.re (e ↑x) :=
  iff.mpr times_cont_diff_iff_times_cont_diff_at
    fun (x : ℝ) => times_cont_diff_at.real_of_complex (times_cont_diff.times_cont_diff_at h)


/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Bhavik Mehta
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.order.basic
import Mathlib.order.preorder_hom
import Mathlib.order.galois_connection
import Mathlib.tactic.monotonicity.default
import Mathlib.PostPort

universes u l

namespace Mathlib

/-!
# Closure operators on a partial order

We define (bundled) closure operators on a partial order as an monotone (increasing), extensive
(inflationary) and idempotent function.
We define closed elements for the operator as elements which are fixed by it.

Note that there is close connection to Galois connections and Galois insertions: every closure
operator induces a Galois insertion (from the set of closed elements to the underlying type), and
every Galois connection induces a closure operator (namely the composition). In particular,
a Galois insertion can be seen as a general case of a closure operator, where the inclusion is given
by coercion, see `closure_operator.gi`.

## References

* https://en.wikipedia.org/wiki/Closure_operator#Closure_operators_on_partially_ordered_sets

-/

/--
A closure operator on the partial order `α` is a monotone function which is extensive (every `x`
is less than its closure) and idempotent.
-/
structure closure_operator (α : Type u) [partial_order α]
extends α →ₘ α
where
  le_closure' : ∀ (x : α), x ≤ preorder_hom.to_fun _to_preorder_hom x
  idempotent' : ∀ (x : α),
  preorder_hom.to_fun _to_preorder_hom (preorder_hom.to_fun _to_preorder_hom x) = preorder_hom.to_fun _to_preorder_hom x

protected instance closure_operator.has_coe_to_fun (α : Type u) [partial_order α] : has_coe_to_fun (closure_operator α) :=
  has_coe_to_fun.mk (fun (c : closure_operator α) => α → α)
    fun (c : closure_operator α) => preorder_hom.to_fun (closure_operator.to_preorder_hom c)

namespace closure_operator

/-- The identity function as a closure operator. -/
@[simp] theorem id_to_preorder_hom_to_fun (α : Type u) [partial_order α] (x : α) : coe_fn (to_preorder_hom (id α)) x = x :=
  Eq.refl (coe_fn (to_preorder_hom (id α)) x)

protected instance inhabited (α : Type u) [partial_order α] : Inhabited (closure_operator α) :=
  { default := id α }

theorem ext {α : Type u} [partial_order α] (c₁ : closure_operator α) (c₂ : closure_operator α) : ⇑c₁ = ⇑c₂ → c₁ = c₂ := sorry

/-- Constructor for a closure operator using the weaker idempotency axiom: `f (f x) ≤ f x`. -/
def mk' {α : Type u} [partial_order α] (f : α → α) (hf₁ : monotone f) (hf₂ : ∀ (x : α), x ≤ f x) (hf₃ : ∀ (x : α), f (f x) ≤ f x) : closure_operator α :=
  mk (preorder_hom.mk f hf₁) hf₂ sorry

/--
theorem monotone {α : Type u} [partial_order α] (c : closure_operator α) : monotone ⇑c :=
  preorder_hom.monotone' (to_preorder_hom c)

Every element is less than its closure. This property is sometimes referred to as extensivity or
inflationary.
-/
theorem le_closure {α : Type u} [partial_order α] (c : closure_operator α) (x : α) : x ≤ coe_fn c x :=
  le_closure' c x

@[simp] theorem idempotent {α : Type u} [partial_order α] (c : closure_operator α) (x : α) : coe_fn c (coe_fn c x) = coe_fn c x :=
  idempotent' c x

theorem le_closure_iff {α : Type u} [partial_order α] (c : closure_operator α) (x : α) (y : α) : x ≤ coe_fn c y ↔ coe_fn c x ≤ coe_fn c y :=
  { mp := fun (h : x ≤ coe_fn c y) => idempotent c y ▸ monotone c h,
    mpr := fun (h : coe_fn c x ≤ coe_fn c y) => le_trans (le_closure c x) h }

theorem closure_top {α : Type u} [order_top α] (c : closure_operator α) : coe_fn c ⊤ = ⊤ :=
  le_antisymm le_top (le_closure c ⊤)

theorem closure_inter_le {α : Type u} [semilattice_inf α] (c : closure_operator α) (x : α) (y : α) : coe_fn c (x ⊓ y) ≤ coe_fn c x ⊓ coe_fn c y :=
  le_inf (monotone c inf_le_left) (monotone c inf_le_right)

theorem closure_union_closure_le {α : Type u} [semilattice_sup α] (c : closure_operator α) (x : α) (y : α) : coe_fn c x ⊔ coe_fn c y ≤ coe_fn c (x ⊔ y) :=
  sup_le (monotone c le_sup_left) (monotone c le_sup_right)

/-- An element `x` is closed for the closure operator `c` if it is a fixed point for it. -/
def closed {α : Type u} [partial_order α] (c : closure_operator α) : set α :=
  fun (x : α) => coe_fn c x = x

theorem mem_closed_iff {α : Type u} [partial_order α] (c : closure_operator α) (x : α) : x ∈ closed c ↔ coe_fn c x = x :=
  iff.rfl

theorem mem_closed_iff_closure_le {α : Type u} [partial_order α] (c : closure_operator α) (x : α) : x ∈ closed c ↔ coe_fn c x ≤ x :=
  { mp := le_of_eq, mpr := fun (h : coe_fn c x ≤ x) => le_antisymm h (le_closure c x) }

theorem closure_eq_self_of_mem_closed {α : Type u} [partial_order α] (c : closure_operator α) {x : α} (h : x ∈ closed c) : coe_fn c x = x :=
  h

@[simp] theorem closure_is_closed {α : Type u} [partial_order α] (c : closure_operator α) (x : α) : coe_fn c x ∈ closed c :=
  idempotent c x

/-- The set of closed elements for `c` is exactly its range. -/
theorem closed_eq_range_close {α : Type u} [partial_order α] (c : closure_operator α) : closed c = set.range ⇑c := sorry

/-- Send an `x` to an element of the set of closed elements (by taking the closure). -/
def to_closed {α : Type u} [partial_order α] (c : closure_operator α) (x : α) : ↥(closed c) :=
  { val := coe_fn c x, property := closure_is_closed c x }

theorem top_mem_closed {α : Type u} [order_top α] (c : closure_operator α) : ⊤ ∈ closed c :=
  closure_top c

theorem closure_le_closed_iff_le {α : Type u} [partial_order α] (c : closure_operator α) {x : α} {y : α} (hy : closed c y) : x ≤ y ↔ coe_fn c x ≤ y :=
  eq.mpr (id (Eq._oldrec (Eq.refl (x ≤ y ↔ coe_fn c x ≤ y)) (Eq.symm (closure_eq_self_of_mem_closed c hy))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (x ≤ coe_fn c y ↔ coe_fn c x ≤ coe_fn c y)) (propext (le_closure_iff c x y))))
      (iff.refl (coe_fn c x ≤ coe_fn c y)))

/-- The set of closed elements has a Galois insertion to the underlying type. -/
def gi {α : Type u} [partial_order α] (c : closure_operator α) : galois_insertion (to_closed c) coe :=
  galois_insertion.mk (fun (x : α) (hx : ↑(to_closed c x) ≤ x) => { val := x, property := sorry }) sorry sorry sorry

end closure_operator

/--
Every Galois connection induces a closure operator given by the composition. This is the partial
order version of the statement that every adjunction induces a monad.
-/
@[simp] theorem galois_connection.closure_operator_to_preorder_hom_to_fun {α : Type u} [partial_order α] {β : Type u} [preorder β] {l : α → β} {u : β → α} (gc : galois_connection l u) (x : α) : coe_fn (closure_operator.to_preorder_hom (galois_connection.closure_operator gc)) x = u (l x) :=
  Eq.refl (coe_fn (closure_operator.to_preorder_hom (galois_connection.closure_operator gc)) x)

/--
The Galois insertion associated to a closure operator can be used to reconstruct the closure
operator.

Note that the inverse in the opposite direction does not hold in general.
-/
@[simp] theorem closure_operator_gi_self {α : Type u} [partial_order α] (c : closure_operator α) : galois_connection.closure_operator (galois_insertion.gc (closure_operator.gi c)) = c := sorry