/- El segundo módulo de este minicurso trata de los
números naturales. Es decir, ahora vamos a tratar con
objetos matemáticos más concretos, no sólo con proposiciones
lógicas -/

/- Empezamos definiendo a los números naturales. Existen varias
formas de definir los números naturales, en Lean y en este
minicurso usaremos los axiomas de Peano. -/

/- En esta hoja vamos a importar unas definiciones de Mathlib.
Estas no las vamos a ocupar hasta al final, pero las incluímos
al principio porque Lean requiere que todas las importaciones
ocurran al principio de la hoja. -/
import algebra.big_operators.intervals

/- Definimos nuestro propio espacio de nombres para trabajar
con nuestras propias definiciones: -/
namespace smf22

/- Ahora definimos un número natural según los axiomas de Peano: -/
inductive natural
| cero : natural -- El número cero (`0`) en un número natural
| suc (n : natural) : natural -- Si `n` es un número natural,
                              -- su sucesor también.

/- Hemos definido la estructura de forma inductiva: tenemos un caso base,
cero, que dice que `cero` es un numero natural, y luego tenemos el caso
inductivo, `suc` (de sucesor), que dice que si `n` es un número natural,
también su sucesor es un número natural.  El sucesor de un número
natural `n` es `n + 1`.

Lean tiene una forma generalizada de inducción ya incluída. Al decir
`inductive` para definir un objecto matemático, Lean entiende dos cosas:
 - La definición no es circular, es inductiva
 - Lean genera un principio de inducción para estos objetos.

Peano originalmente tenía mucho otros axiomas, como
que todo natural es igual a sí mismo, ` ∀ x : natural, x = x`.
Estos axiomas ya los tenemos por la base lógica en Lean y no hace
falta repetirlos para definir los números naturales.
 -/

 /- Podemos definir el número 1, por ejemplo: -/
def uno := natural.suc natural.cero

/- Lean ocupa un punto `.` para acceder a los nombres definidos.
Cómo vamos a estar trabajando con los números naturales, es muy
tedioso tener que escribir `natural.suc` cada vez; en vez,
le decimos a Lean que "abra las definiciones, para que no tengamos
que escribir `natural` cada vez.  "-/
open natural

/- y podemos definir dos -/
def dos := suc (suc cero)

/- Demostramos que 1 + 1 = 2. -/
example : suc uno = dos :=
begin
  refl -- por definición
end

/- Por el momento no hemos definido la suma, interpretamos al
sucesor como `+ 1`, pero no está realmente definido. Es más,
es al revez: definimos la suma usando al sucesor. -/

def suma : natural → natural → natural
| a  cero     := a
| a  (suc b) := suc (suma a b)

#check suma uno uno

/- Con esta definición, para escribir la suma de dos números
`a` y `b`, tendríamos que escribir `suma a b`. Esto se puede
volver tedioso rápidamente. Afortunadamente, Lean nos permite definir
nuestra propia notación para evitar esta confusion y tedio.
-/

infix ` + `:60 := suma

/- Lean dice `infix` porque el símbolo `+` va entre sus argumentos,
no como sufijo o prefixo. El 60 es la "precedencia" del operador,
sirve para desambiguar expresiones como 2 ⬝ 3 + 5, que podrían
significar (2 ⬝ 3) + 5 ó 2 ⬝ (3 + 5). Por convención, lo
interpretamos como la primera opción, pero a Lean hay que
enseñarle esta convención también! -/

#check uno + uno -- ahora podemos escribirlo así

/- Regresamos a nuestro "teorema": 1 + 1 = 2 -/
theorem uno_mas_uno : uno + uno = dos :=
begin
  unfold uno, -- cual es la definición de uno?
  unfold dos, -- cual es la definición de dos?
  unfold suma, -- cual es la definición de la suma?
end

theorem uno_mas_uno' : uno + uno = dos :=
begin
  refl, -- Sigue siendo verdadero por definición
end

-- Vamos a trabajar con un par de variables (numeros naturales)
variables (l m n : natural)

/- Igual, por definición, n + 0 = n.
Cuando es un solo paso, podemos decir `by` en vez de
usar `begin` y `end`.  -/
theorem suma_cero : n + cero = n := by refl

/- Ahora que pasa con lo opuesto (`cero + n = n`)?
Esto no funciona por definición.  Cual es la diferencia entre estos dos?
De hecho, la única forma de demostrarlo es por inducción!
-/
theorem cero_suma : cero + n = n :=
begin
 induction n with n hi,
 -- caso base (cero)
 {
   refl,
 },
 {
   unfold suma, --definición de suma
   rw hi, --hipótesis de inducción
 }
end

/- Muy similar al caso con cero, como hemos visto,
 `suc n` es `n + 1`, por definición. Que pasa con `1 + n`? -/
theorem n_mas_uno : suc n = n + uno := by refl

/- Un pequeño ejercicio: -/
theorem uno_mas_n : uno + n = suc n :=
begin
  sorry,
end

/- un ejericico un poco más interesante: -/
theorem suma_asociativa : (l + m) + n = l + (m + n)  :=
begin
 sorry,
end

/- Que tal si hacemos el caso más general, n + m = m + n? -/
theorem suma_conmutativa : n + m = m + n :=
begin
  induction n with n hi,
  {
    rw cero_suma,
    rw suma_cero,
  },
  {
    rw ← uno_mas_n,
    rw ← (suma_asociativa m uno n),
    rw ← n_mas_uno,
    rw ← uno_mas_n,
    rw suma_asociativa,
    rw suma_asociativa,
    rw hi,
  }
end

/- Este lemma claramente es consecuencia de la distributividad
y asociatividad de la suma, sin embargo resulta ser útil tenerlo
 aparte. -/
lemma suma_izq_conm : n + (m + l) = m + (n + l) :=
begin
  induction n with n hi,
  {
    rw cero_suma,
    rw cero_suma,
  },
  {
    rw ← suma_asociativa,
    rw suma_asociativa,
    rw suma_conmutativa,
    rw suma_asociativa,
    rw (suma_conmutativa (suc n) l),
  }
end
/- En este último caso tuvimos que decirle a Lean que
numeros usar para aplicar la conmutatividad, lo cual podemos hacer
dandole los argumentos explicitamente y poniendo todo en parentesis,
 como hicimos aquí. -/

/- Vemos como podemos empezar a construir la teoría de los números
naturales en base a los axiomas de Peano. Vamos al siguiente paso:
como definiríamos la multiplicación? -/

def mul : natural → natural → natural
| m cero := cero
| m (suc n) := mul m n + m

/- definimos la multipliciación. Podemos usar ambos, `⬝` ó `*`. -/
infix ` * `:70 := mul
infix ` ⬝ `:70 := mul

-- a la derecha otra vez es por definición
theorem mul_cero : n * cero = cero := by refl

/- para la demostración por la izquierda necesitamos
ahora saber algo de la suma también! -/
theorem cero_mul : cero * n = cero :=
begin
 induction n,
 refl,
 unfold mul,
 rw suma_cero,
 exact n_ih,
end

/- El siguiente objetivo aquí será demostrar la asociatividad y
 comutatividad de la muliplicación, así como la ley distributiva.
 Esto lleva mucho tiempo.  -/

lemma suc_mul : (suc n) * m = (n * m) + m :=
begin
  induction m with m hi,
  refl,
  unfold mul,
  rw hi,
  rw n_mas_uno,
  rw suma_asociativa,
  rw (suma_conmutativa (n + uno) m),
  rw suma_asociativa,
  rw (uno_mas_n m),
  rw suma_asociativa,
end

-- La otra dirección es trivial por definición!
lemma mul_suc : n * suc m = n * m + n := by refl

/- Con esto podemos demostrar las leyes distributivas
   para relacional la suma y la multiplicación:
-/
theorem distrib_izq : n * (m + l) = n * m + n * l :=
begin
induction n with n hi,
{
  simp [cero_mul], -- que pasa si en vez hacemos rw cero_mul?
  refl,
},
{
  simp [suc_mul],
  rw hi,
  simp [suma_asociativa, suma_conmutativa, suma_izq_conm],
}
end

theorem distrib_der : (n + m) * l = n * l + m * l :=
begin
  induction l with l hi,
  refl,
  {
  simp [mul_suc, hi],
  simp [suma_asociativa, suma_conmutativa, suma_izq_conm],
  }
end

theorem mul_asociativa  : (n * m) * l = n * (m * l) :=
begin
  induction l with l hi,
  refl,
  simp [mul_suc, distrib_izq, hi],
end

/- La tarea: demuestre que la multiplicaicón es conmutativa! -/
theorem mul_conmutativa : n * m = m * n :=
begin
  sorry,
end

/- Hasta aquí hemos ido construyendo la teoría de los números naturales
paso a paso. Sin embargo, Lean ya la conoce, por supuesto! Vamos a cerrar
nuestro espacio de nombres extra y ver como funciona esto -/
end smf22

infix ` + `:60 := nat.add

#check nat
/- Para demostrar un poco como Lean puede ser mas poderoso,
demostraremos una propiedad de los numeros pares usando
un poco mas de automatización -/
theorem producto_par : ∀ m n : ℕ, even n → even (m * n) :=
begin
  intros m n hpar,
  unfold even at hpar, -- cual es la definición de par?
  /- En la hoja de lógica no vimos cuantificadores, pero no es muy
  complejo. Si tenemos la existencia de un objeto con una propiedad,
  podemos separarla igual que en los otros casos usando `cases`: -/
  cases hpar with k hk,
  use (m * k), -- demostramos la existencia explicitamente
  rw hk,
  ring, -- lean tiene tacticas mas poderosas, como `ring`
end


import algebra.group.basic

namespace group.basic

theorem mul_mul_mul_eq_one_iff {G : Type*} [group G]: ∀ {x y z : G}, x*y*z = 1 ↔ y*z*x = 1 :=
begin
  intros x y z,
  conv_lhs
  { rw [← mul_right_inj (x⁻¹), ← mul_assoc,
    ← mul_assoc, inv_mul_self, one_mul,
    mul_one, ← mul_left_inj x, inv_mul_self] }
end

theorem mul_mul_mul_eq_one_iff' {G : Type*} [group G]: ∀ (x y z : G), x*y*z = 1 ↔ z*x*y = 1 :=
begin
  intros x y z,
  conv_lhs
  { rw [mul_mul_mul_eq_one_iff,
    ← mul_right_inj (y⁻¹), ← mul_assoc,
    ← mul_assoc, inv_mul_self, one_mul,
    mul_one, ← mul_left_inj y, inv_mul_self] },
end

end group.basic


import tactic
import binary
import hamming

/-!
# Binary Codes

This file contains the definition of a binary code
and several theorems relating to properties of binary codes.

## Main Results

- `s_error_detecting_iff_min_distance_gt_s` :
  A code C is s-error-detecting if and only if d(C) > s.
- `t_error_correcting_iff_min_distance_gte` :
  A code C is t-error-correcting if and only if d(C) ≥ 2t + 1.
- `hamming_bound` :
  Establishes a bound on the number of codewords in an error-correcting code.

## Notation

- `|C|` for the number of codewords in a code `C`.
- `d(C)` for the minimum distance of a codeword `C`.
-/

open B BW

def min_distance {n : ℕ} (C : finset (BW n)) (h : C.card ≥ 2) : ℕ :=
finset.min' (finset.image (λ (x : BW n × BW n), d(x.fst, x.snd)) C.off_diag)
begin
  have : ∃ (x y : BW n), x ∈ C ∧ y ∈ C ∧ x ≠ y,
  from finset.one_lt_card_iff.mp h,
  simp, rw finset.nonempty, simp,
  rcases this with ⟨x, y, ⟨hx, hy, hxy⟩⟩,
  existsi [x, hx, y, hy],
  exact hxy,
end

structure binary_code (n M d : ℕ) :=
  (cws : finset (BW n))
  (has_card_M : cws.card = M)
  (card_gte : cws.card ≥ 2)
  (has_min_distance_d : min_distance cws card_gte = d)

namespace binary_code

instance : Π {n m d : ℕ}, has_mem (BW n) (binary_code n m d) :=
λ n m d, ⟨λ (x : BW n), λ (C : binary_code n m d), x ∈ C.cws⟩

notation `|` C `|` := C.cws.card

notation `d(` C `)` := min_distance C.cws C.card_gte

variables {n M d : ℕ} {C : binary_code n M d}

lemma dist_neq_codewords_gte_min_distance:
  ∀ (c₁ c₂ ∈ C), c₁ ≠ c₂ → d(C) ≤ d(c₁,c₂):=
begin
  intros c₁ c₂ hc₁ hc₂ hneq,
  unfold min_distance,
  apply finset.min'_le,
  simp,
  existsi [c₁, c₂],
  exact ⟨⟨hc₁, hc₂, hneq⟩, rfl⟩,
end

lemma min_distance_pair : ∃ (c₁ c₂ ∈ C), c₁ ≠ c₂ ∧ d(c₁,c₂) = d(C) :=
begin
  have h_mem : d(C) ∈ (finset.image (λ (x : BW n × BW n), d(x.fst, x.snd)) C.cws.off_diag),
  by {rw min_distance, apply finset.min'_mem},
  simp at h_mem,
  rcases h_mem with ⟨x, y, ⟨hx, hy, hneq⟩, h_dist⟩,
  existsi [x, y, hx, hy],
  exact ⟨hneq, h_dist⟩,
end

/--
A code C is s-error-detecting if,
whenever a codeword has incurred at least one but at most s errors,
the resulting word is not a codeword.
-/
def error_detecting (C : binary_code n M d) (s : ℕ) : Prop :=
∀ (x : BW n) (c ∈ C), (d(x,c) ≥ 1 ∧ d(x,c) ≤ s) → x ∉ C

theorem s_error_detecting_iff_min_distance_gt_s (s : ℕ) :
  C.error_detecting s ↔ d(C) > s :=
begin
  unfold error_detecting,
  split,
  -- Proof that d(C) ≤ s ⇒ not s-error-detecting.
    {contrapose,
    simp,
    intro h_min_dist,
    have : ∃ (c₁ c₂ ∈ C), c₁ ≠ c₂ ∧ d(c₁,c₂) = d(C), from min_distance_pair,
    rcases this with ⟨x, y, hx, hy, ⟨hneq, h_dist_eq_min⟩⟩,
    have h_lte_s : d(x,y) ≤ s, by linarith,
    have h_gte_1 : d(x,y) ≥ 1, from (hamming.distance_neq_between_one_n x y hneq).left,
    existsi [x, y],
    exact ⟨hy, h_gte_1, h_lte_s, hx⟩,
    },
  -- Proof that d(C) > s ⇒ s-error-detecting
    {intros h x c hc hdist,
    intro hx,
    by_cases heq : x = c,
      {have h_dxc_eq_zero : d(x,c) = 0, from hamming.eq_distance_zero x c heq,
      linarith},
      {have : d(x,c) ≥ d(C),
      from dist_neq_codewords_gte_min_distance x c hx hc heq,
      linarith,}
    },
end

/--
A code C is t-error-correcting if the minimum distance
decoding rule can be used to correct t or fewer errors.
The minimum distance decoding rule will decode x to c ∈ C
if the distance between x and c is smaller than the distance
between x and any other codeword in C.
-/
def error_correcting (C : binary_code n M d) (t : ℕ) : Prop :=
∀ (c ∈ C) (x : BW n), d(x,c) ≤ t → (∀ (c' ∈ C), c ≠ c' → d(x,c) < d(x,c'))

/--
Given two words x and y, constructs a new word z
by flipping the first t bits of x that disagree with y.
-/
def change_t_disagreements : Π {n : ℕ}, ℕ → BW n → BW n → BW n
| _ _     nil         nil       := nil
| _ 0     (xhd::ᴮxtl) (_::ᴮytl) := xhd::ᴮxtl
| _ t     (O::ᴮxtl)   (O::ᴮytl) :=   O::ᴮ(change_t_disagreements t xtl ytl)
| _ t     (I::ᴮxtl)   (I::ᴮytl) :=   I::ᴮ(change_t_disagreements t xtl ytl)
| _ (t+1) (O::ᴮxtl)   (I::ᴮytl) :=   I::ᴮ(change_t_disagreements t xtl ytl)
| _ (t+1) (I::ᴮxtl)   (O::ᴮytl) :=   O::ᴮ(change_t_disagreements t xtl ytl)

lemma dist_change_t_disagreements_first_arg :
  Π {n : ℕ} (t : ℕ) (h₁ : 0 < t) (x y : BW n) (h₂ : t < d(x,y)),
  d(x, change_t_disagreements t x y) = t
| n t     h₁ nil         nil         h₂ := by {exfalso, simp at h₂, contradiction}
| n 0     h₁ (xhd::ᴮxtl) (yhd::ᴮytl) h₂ := by {exfalso, simp at h₁, contradiction}
| n (t+1) h₁ (xhd::ᴮxtl) (yhd::ᴮytl) h₂ := begin
  cases xhd; cases yhd;
    begin
    rw change_t_disagreements, simp, simp at h₂,
    apply dist_change_t_disagreements_first_arg (t+1) h₁ xtl ytl h₂,
    end
    <|>
    begin
    rw change_t_disagreements, simp,
    rw ← nat.add_one, simp,
    simp at h₂, have h₃ : t < d(xtl,ytl), from nat.lt_of_succ_lt_succ h₂,
    cases t,
      {simp, cases xtl with _ xhd xtl,
        {rw nil_unique ytl, rw change_t_disagreements},
      cases ytl with _ yhd ytl, cases xhd; cases yhd; rw change_t_disagreements,
      },
    have h₅ : 0 < t.succ, from nat.zero_lt_succ t,
    apply dist_change_t_disagreements_first_arg (t+1) h₅ xtl ytl h₃,
    end
end

lemma dist_change_t_disagreements_second_arg :
  Π {n : ℕ} (t : ℕ) (x y : BW n), d(y, change_t_disagreements t x y) = d(x,y) - t
| n t     nil         nil         := by {simp, cases t; rw change_t_disagreements}
| n 0     (xhd::ᴮxtl) (yhd::ᴮytl) := begin
  cases xhd; cases yhd;
    {rw change_t_disagreements, simp, apply hamming.distance_symmetric}
end
| n (t+1) (xhd::ᴮxtl) (yhd::ᴮytl) := begin
  cases xhd; cases yhd;
    {rw change_t_disagreements, simp, apply dist_change_t_disagreements_second_arg}
end

/--
Forward direction of t-error-correting ⇔ d(C) ≥ 2t + 1.
Proof closely follows the structure of the proof given in accompanying report.
-/
lemma t_error_correcting_min_distance_gte (t : ℕ) :
  C.error_correcting t → d(C) ≥ 2 * t + 1 :=
begin
  -- Suppose that C is t-error-correcting.
  intro h₁,
  -- For the sake of contradiction, assume that d(C) < 2t + 1
  by_contradiction h₂,
  simp at h₂,
  -- Then there exist distinct codewords c, c' ∈ C such that d(c, c') = d(C)
  have h₃ : ∃ (c₁ c₂ ∈ C), c₁ ≠ c₂ ∧ d(c₁,c₂) = d(C),
  from min_distance_pair,
  rcases h₃ with ⟨c, c', hc, hc', ⟨hneq, h_dist_eq_min⟩⟩,
  have h₄ : d(c,c') ≤ 2 * t, by linarith,
  -- First, we establish via contradiction that t < d(c,c') < 2t.
  have h₅ : d(c, c') ≥ t + 1,
  by {
    specialize h₁ c hc c',
    by_contradiction h',
    simp at h',
    have h'' : d(c,c') ≤ t, from nat.le_of_lt_succ h',
    rw hamming.distance_symmetric at h'',
    specialize h₁ h'' c' hc' hneq,
    have : d(c',c') = 0, from hamming.eq_distance_zero c' c' rfl,
    rw this at h₁,
    simp at h₁,
    exact h₁,
  },
  -- Now, we construct a new word x by
  -- flipping the first t bits of c that disagree with c'.
  have h₆ : ∃ (x : BW n), 1 ≤ d(x,c') ∧ d(x,c') ≤ d(x,c) ∧ d(x,c) = t,
  by {
    use change_t_disagreements t c c',
    have h_d₀ : 1 ≤ d(c,c') ∧ d(c,c') ≤ n, from hamming.distance_neq_between_one_n c c' hneq,
    have h_d₁ : d(c, change_t_disagreements t c c') = t,
    by {apply dist_change_t_disagreements_first_arg; linarith},
    have h_d₂ : d(c', change_t_disagreements t c c') = d(c,c') - t,
    by {apply dist_change_t_disagreements_second_arg},
    rw [hamming.distance_symmetric _ c, hamming.distance_symmetric _ c'],
    split,
      {calc d(c',change_t_disagreements t c c') ≥ d(c,c') - t : by linarith
      ...                                       ≥ t + 1 - t   : by exact nat.sub_le_sub_right h₅ t
      ...                                       = 1           : by simp,},
      split,
      {rw [h_d₁, h_d₂],
      apply nat.sub_le_left_iff_le_add.mpr,
      conv {congr, skip, ring},
      exact h₄,},
      {linarith}
  },
  -- But the properties of this word contradict C being t-error-correcting.
  -- Hence, d(C) ≥ 2t + 1.
  rcases h₆ with ⟨x, ⟨h_dxgt1, h_dxc'_le_dxc, h_dxc_eq_t⟩⟩,
  have h_dxc_le_t : d(x,c) ≤ t, by linarith,
  specialize h₁ c hc x h_dxc_le_t c' hc' hneq,
  linarith,
end

/--
We now present two proofs for
the backward direction of t-error-correting ⇔ d(C) ≥ 2t + 1.
In the second proof, we prove the contraposative and
the resulting proof is slightly simpler.
-/
lemma min_distance_gte_t_error_correcting' (t : ℕ) :
  d(C) ≥ 2 * t + 1 → C.error_correcting t :=
begin
  intro h,
  intros c hc x h_dist_le_t c' hc' h_c_neq_c',
  have h₁ : d(c,c') ≥ d(C),
  from dist_neq_codewords_gte_min_distance c c' hc hc' h_c_neq_c',
  have h₂ : d(c,c') ≥ 2 * t + 1, by linarith,
  have h₃ : d(c,c') ≤ d(c,x) + d(x,c'), from hamming.distance_triangle_ineq c c' x,
  calc d(x,c') ≥ d(c,c') - d(c,x)     : by {simp, exact nat.sub_le_left_of_le_add h₃}
  ...          ≥ (2 * t + 1) - d(c,x) : by {simp, exact nat.sub_le_sub_right h₂ d(c,x)}
  ...          ≥ (2 * t + 1) - t      : by {simp, rw hamming.distance_symmetric,
                                            exact (2 * t + 1).sub_le_sub_left h_dist_le_t}
  ...          = (t + t + 1) - t      : by ring
  ...          = t + 1                : by {rw nat.add_assoc, simp}
  ...          > d(x,c)               : by linarith,
end

lemma min_distance_gte_t_error_correcting (t : ℕ) :
  d(C) ≥ 2 * t + 1 → C.error_correcting t :=
begin
  contrapose, unfold error_correcting, simp,
  intros c hc x hx c' hc' hneq hdist,
  have h_x_c'_dist : d(x,c') ≤ t, by linarith,
  calc d(C) ≤ d(c,c')          : dist_neq_codewords_gte_min_distance _ _ hc hc' hneq
  ...       ≤ d(c,x) + d(x,c') : hamming.distance_triangle_ineq c c' x
  ...       ≤ t + d(x,c')      : by {simp, rw hamming.distance_symmetric, exact hx,}
  ...       ≤ t + t            : by {simp, exact h_x_c'_dist,}
  ...       = 2 * t            : by ring
  ...       < 2 * t + 1        : by simp,
end

theorem t_error_correcting_iff_min_distance_gte (t : ℕ) :
  C.error_correcting t ↔ d(C) ≥ 2 * t + 1 :=
iff.intro
  (t_error_correcting_min_distance_gte t)
  (min_distance_gte_t_error_correcting t)

open_locale big_operators

/-!
In the remainder of this file, we build up a proof of the Hamming bound.
When reading this code, it may actually be easier to start at the end and
work backwards, because the order of presentation goes from low-level
details to high-level proofs.

Note: Indices are numbered from 1.
-/

/-- The set {1,…,n} -/
def indices (n : ℕ) : finset ℕ := finset.erase (finset.range (n + 1)) 0

@[simp]
lemma indices_card_eq_word_size (n : ℕ) : (indices n).card = n :=
by {rw [indices, finset.card_erase_of_mem], simp, simp}

/-- Map a binary word x to a set of indices at which xᵢ ≠ 0 -/
def bw_to_nonzero_indices : Π {n : ℕ}, BW n → finset ℕ
| 0 nil      := finset.empty
| n (O::ᴮtl) := bw_to_nonzero_indices tl
| n (I::ᴮtl) := insert n (bw_to_nonzero_indices tl)

lemma mem_nonzero_indices_le_bw_size (x : BW n) (i : ℕ) :
  i ∈ (bw_to_nonzero_indices x) → 1 ≤ i → i ≤ n :=
begin
  intros h_mem h_gte_one,
  induction x with k xhd xtl ih,
    {rw bw_to_nonzero_indices at h_mem,
    have : i ∉ finset.empty, from finset.not_mem_empty i,
    contradiction},
  cases xhd,
    {rw bw_to_nonzero_indices at h_mem, specialize ih h_mem, linarith},
    {rw bw_to_nonzero_indices at h_mem,
    rw finset.mem_insert at h_mem, cases h_mem,
      {rw h_mem},
      {specialize ih h_mem, linarith},
    }
end

lemma succ_not_mem_nonzero_indices (x : BW n) :
  n.succ ∉ bw_to_nonzero_indices x :=
begin
  by_contradiction h',
  have h₀ : 1 ≤ n.succ, by {rw ← nat.add_one, linarith},
  have h₁ : n.succ ≤ n, from mem_nonzero_indices_le_bw_size x n.succ h' h₀,
  have h₂ : ¬ n.succ ≤ n, from nat.not_succ_le_self n,
  contradiction
end

/--
The weight of a word x is the same as
the cardinality of the set of indices at which xᵢ ≠ 0.
-/
lemma weight_eq_card_nonzero_indices (x : BW n) :
  wt(x) = (bw_to_nonzero_indices x).card :=
begin
  induction n with k ih,
    {rw nil_unique x, rw bw_to_nonzero_indices, rw hamming.weight, refl},
  cases x with _ xhd xtl,
  cases xhd,
    {rw [hamming.weight, bw_to_nonzero_indices], apply ih},
    {rw [hamming.weight, bw_to_nonzero_indices],
    rw finset.card_insert_of_not_mem,
      {rw nat.add_one, simp, apply ih},
      {by_contradiction h,
      have h₀ : 1 ≤ k.succ, by {rw ← nat.add_one, linarith},
      have h₁ : k.succ ≤ k, from mem_nonzero_indices_le_bw_size xtl k.succ h h₀,
      have h₂ : ¬ k.succ ≤ k, from nat.not_succ_le_self k,
      contradiction,
      }
    }
end

lemma indices_subset_indices_succ (k : ℕ) : indices k ⊆ indices k.succ :=
begin
  repeat {rw indices},
  have h : finset.range (k + 1) ⊆ finset.range (k.succ + 1), by simp,
  exact finset.erase_subset_erase 0 h,
end

/--
Given a word x
the set of indices at which xᵢ ≠ 0 is a subset of
all indices of the word, i.e. the set {1,…,n}.
-/
lemma nonzero_indices_subset_indices (x : BW n) :
 (bw_to_nonzero_indices x) ⊆ (indices n) :=
begin
  induction x with k xhd xtl ih,
    {rw [bw_to_nonzero_indices, indices], refl},
  cases xhd,
    {rw bw_to_nonzero_indices,
    have h : indices k ⊆ indices k.succ, from indices_subset_indices_succ k,
    exact finset.subset.trans ih h},
    {rw [bw_to_nonzero_indices, finset.insert_subset], split,
      {rw indices, simp},
    have h : indices k ⊆ indices k.succ, from indices_subset_indices_succ k,
    exact finset.subset.trans ih h},
end

/--
Given a set representing some nonzero indices in a binary word,
construct the unique binary word that produced this set of nonzero indices.
-/
def nonzero_indices_to_bw : Π (n : ℕ), finset ℕ → BW n
| 0     s := nil
| (n+1) s :=
  if (n + 1) ∈ s then
    (I::ᴮnonzero_indices_to_bw n (s.erase (n + 1)))
  else
    (O::ᴮnonzero_indices_to_bw n s)

lemma erase_last_index_subset {s : finset ℕ} :
  s ⊆ indices (n + 1) → s.erase (n + 1) ⊆ indices n :=
begin
  unfold indices,
  intros h i hi,
  specialize h (finset.mem_of_mem_erase hi),
  rw finset.mem_erase at *,
  split,
    {exact h.left},
    {rw finset.mem_range,
    refine lt_of_le_of_ne _ hi.left,
    rw ← finset.mem_range_succ_iff,
    exact h.right}
end

lemma last_index_not_mem_subset {s : finset ℕ} :
  s ⊆ indices (n + 1) → n + 1 ∉ s → s ⊆ indices n :=
begin
  unfold indices,
  intros h h' i hi,
  specialize h hi,
  rw finset.mem_erase at *,
  split,
    {exact h.left},
    {rw finset.mem_range,
    apply lt_of_le_of_ne,
      {rw ← finset.mem_range_succ_iff, exact h.right},
      {intro h, rw h at hi, exact h' hi}
    }
end

lemma bw_to_nonzero_indices_inv_nonzero_indices_to_bw
  (n : ℕ) (s : finset ℕ) (h : s ⊆ indices n) :
  bw_to_nonzero_indices (nonzero_indices_to_bw n s) = s :=
begin
  revert s,
  induction n with n ih,
    {intros s h, change ∅ = s, symmetry, rwa ← finset.subset_empty},
  intros t h,
  unfold nonzero_indices_to_bw,
  split_ifs with h',
    {specialize ih (t.erase (n + 1)) (erase_last_index_subset h),
    unfold bw_to_nonzero_indices,
    conv_rhs {rw [← finset.insert_erase h', ← ih]}},
    {exact ih t (last_index_not_mem_subset h h')},
end

lemma all_nonzero_indices_eq_powerset_indices :
  finset.image (λ v : BW n, bw_to_nonzero_indices v) finset.univ =
  (indices n).powerset :=
begin
  simp, ext,
  split,
    {simp, intros x h, rw ← h, exact nonzero_indices_subset_indices x},
    {simp, intro h, use nonzero_indices_to_bw n a,
    exact bw_to_nonzero_indices_inv_nonzero_indices_to_bw n a h},
end

lemma nonzero_indices_eq_powerset_len (w : ℕ) (h : w ≤ n) :
  finset.filter (λ s : finset ℕ, s.card = w)
    (finset.image (λ v : BW n, bw_to_nonzero_indices v) finset.univ)
  = finset.powerset_len w (indices n) :=
begin
  simp,
  rw [finset.powerset_len_eq_filter, all_nonzero_indices_eq_powerset_indices],
end

/--
If the sets of nonzero indices of two binary words are equal,
then the binary words are equal.
-/
lemma eq_nonzero_indices_eq_words (a b : BW n) :
  bw_to_nonzero_indices a = bw_to_nonzero_indices b → a = b :=
begin
  intro h,
  induction a with k ahd atl ih,
    {rw nil_unique b},
  cases b with _ bhd btl,
  cases ahd,
    {cases bhd,
      {simp, exact ih btl h},
      {simp, repeat {rw bw_to_nonzero_indices at h},
      have h : k.succ ∉ bw_to_nonzero_indices atl, from succ_not_mem_nonzero_indices atl,
      have h' : bw_to_nonzero_indices atl ≠ insert k.succ (bw_to_nonzero_indices btl),
      from finset.ne_insert_of_not_mem _ _ h,
      contradiction},
    },
    {cases bhd,
      {simp, repeat {rw bw_to_nonzero_indices at h},
      have h : k.succ ∉ bw_to_nonzero_indices btl, from succ_not_mem_nonzero_indices btl,
      have h' : insert k.succ (bw_to_nonzero_indices atl) ≠ bw_to_nonzero_indices btl,
      from (finset.ne_insert_of_not_mem _ _ h).symm,
      contradiction},
      {simp, repeat {rw [bw_to_nonzero_indices, finset.insert_eq] at h},
      have h₁ : k.succ ∉ bw_to_nonzero_indices atl, from succ_not_mem_nonzero_indices atl,
      have h₂ : k.succ ∉ bw_to_nonzero_indices btl, from succ_not_mem_nonzero_indices btl,
      have h₃ : bw_to_nonzero_indices atl ⊆ bw_to_nonzero_indices btl,
        begin
          rw finset.subset_iff, intros i hi,
          have h' : i ∈ {k.succ} ∪ bw_to_nonzero_indices atl, from finset.mem_union_right _ hi,
          rw h at h', simp at h', cases h',
            {rw h' at hi, rw nat.add_one at hi, contradiction},
            {exact h'},
        end,
      have h₄ : bw_to_nonzero_indices btl ⊆ bw_to_nonzero_indices atl,
        begin
          rw finset.subset_iff, intros i hi,
          have h' : i ∈ {k.succ} ∪ bw_to_nonzero_indices btl, from finset.mem_union_right _ hi,
          rw ← h at h', simp at h', cases h',
            {rw h' at hi, rw nat.add_one at hi, contradiction},
            {exact h'},
        end,
      have h₅ : bw_to_nonzero_indices atl = bw_to_nonzero_indices btl,
      from finset.subset.antisymm h₃ h₄,
      exact ih btl h₅,
      },
    }
end

lemma filter_size_same_as_size_filter (w : ℕ):
  (finset.filter (λ v : BW n, (bw_to_nonzero_indices v).card = w) finset.univ).card =
  (finset.filter (λ s : finset ℕ, s.card = w)
    (finset.image (λ v : BW n, bw_to_nonzero_indices v) finset.univ)).card :=
begin
  rw finset.card_congr (λ (v : BW n) h, bw_to_nonzero_indices v),
    {simp},
    {simp, intros a b ha hb hab, exact eq_nonzero_indices_eq_words _ _ hab},
    {simp, intros b hb, use b, split, exact hb, refl},
end

lemma card_nonzero_indices (w : ℕ) (h : w ≤ n) :
  (finset.filter
    (λ v : BW n, (bw_to_nonzero_indices v).card = w) finset.univ).card =
  n.choose w :=
begin
  rw [filter_size_same_as_size_filter, nonzero_indices_eq_powerset_len],
  simp, exact h,
end

/--
This is the key lemma for the proof of sphere size.
-/
lemma num_words_with_weight (w : ℕ) (h : w ≤ n):
  (finset.filter (λ v : BW n, wt(v) = w) finset.univ).card = n.choose w :=
begin
  conv {to_lhs, congr, congr, funext, rw weight_eq_card_nonzero_indices},
  simp,
  exact card_nonzero_indices w h,
end

/--
Given a word c and radius r,
this is set {x ∈ ℬⁿ | d(c,x) = r}
-/
def words_at_dist (c : BW n) (r : ℕ) : finset (BW n) :=
finset.filter (λ v, d(c, v) = r) finset.univ

/--
Given a word c and radius r,
this is set {x ∈ ℬⁿ | d(c,x) ≤ r}
-/
def sphere (c : BW n) (r : ℕ) : finset (BW n) :=
finset.filter (λ v, d(c, v) ≤ r) finset.univ

lemma words_at_dist_mem (c : BW n) (r : ℕ) :
  ∀ (bw : BW n), bw ∈ words_at_dist c r ↔ d(c, bw) = r :=
by {unfold words_at_dist, simp}

lemma sphere_mem (c : BW n) (r : ℕ) : ∀ (bw : BW n), bw ∈ sphere c r ↔ d(c, bw) ≤ r :=
by {unfold sphere, simp}

lemma words_unique (c : BW n) : (finset.filter (eq c) finset.univ).card = 1 :=
by {rw finset.filter_eq finset.univ c, simp}

lemma words_at_ne_dists_disjoint (c : BW n) (r₁ r₂ : ℕ) (h : r₁ ≠ r₂) :
  disjoint (words_at_dist c r₁) (words_at_dist c r₂) :=
begin
  rw finset.disjoint_right,
  by_contradiction h₁,
  push_neg at h₁,
  cases h₁ with a h_a,
  repeat {rw words_at_dist_mem at h_a},
  have : r₁ = r₂, from hamming.distance_unique c a r₁ r₂ h_a.symm,
  contradiction,
end

lemma words_at_dist_eq_words_with_sum_weight (c : BW n) (r : ℕ) :
  (finset.filter (λ (v : BW n), wt(c + v) = r) finset.univ).card =
    (finset.filter (λ (v : BW n), wt(v) = r) finset.univ).card :=
begin
  rw finset.card_congr (λ (v : BW n) h, c + v),
    {intros a ha, simp, simp at ha, exact ha},
    {intros a b ha hb, simp},
    {intros b hb, simp, simp at hb,
    use b - c, split,
      {simp, exact hb},
      {simp}
    },
end

lemma words_at_dist_size (c : BW n) (r : ℕ) (h : r ≤ n) :
  (words_at_dist c r).card = n.choose r :=
begin
  rw words_at_dist,
  conv {to_lhs, congr, congr, funext, rw hamming.distance_eq_weight_of_sum},
  simp,
  rw [words_at_dist_eq_words_with_sum_weight, num_words_with_weight r h],
end

lemma sphere_eq_union_words_at_dist (c : BW n) (r : ℕ) (h : r ≤ n) :
  sphere c r = finset.bUnion (finset.range (r + 1)) (words_at_dist c) :=
begin
  unfold sphere,
  ext,
  split,
    {simp,
    intro h,
    use d(c,a),
    split,
      {linarith},
      {rw words_at_dist, simp}},
    {simp,
    intros x hx,
    rw words_at_dist,
    simp,
    intro h_dist,
    rw h_dist,
    linarith,
    }
end

lemma sphere_size_eq_sum_words_at_dist_size (c : BW n) (r : ℕ) (h : r ≤ n) :
  (sphere c r).card = ∑ i in (finset.range (r + 1)), (words_at_dist c i).card :=
begin
  rw sphere_eq_union_words_at_dist,
  rw finset.card_bUnion,
    {intros x hx y hy h_ne,
    exact words_at_ne_dists_disjoint c x y h_ne},
    {exact h},
end

/--
Let c ∈ ℬⁿ be a binary word of length n and let r ∈ ℕ be such that r ≤ n.
Then,
|{x ∈ ℬⁿ | d(c,x) ≤ r}| = n.choose 0 + n.choose 1 + … + n.choose r
-/
lemma sphere_size (c : BW n) (r : ℕ) (h : r ≤ n) :
  (sphere c r).card = ∑ i in (finset.range (r + 1)), n.choose i :=
begin
  rw sphere_size_eq_sum_words_at_dist_size c r h,
  apply finset.sum_congr,
    {refl},
  intros h hx,
  rw words_at_dist_size,
  simp at hx,
  linarith,
end

/--
Let C be a t-error-correcting code.
Then, the spheres for any distinct codewords are disjoint.
-/
lemma t_error_correcting_spheres_disjoint (t : ℕ)
  (t_error_correcting : C.error_correcting t) :
  ∀ (c₁ c₂ ∈ C), c₁ ≠ c₂ → disjoint (sphere c₁ t) (sphere c₂ t) :=
begin
  rw t_error_correcting_iff_min_distance_gte at t_error_correcting,
  intros c₁ c₂ hc₁ hc₂ hne,
  rw finset.disjoint_left,
  repeat {rw sphere}, simp,
  intros x hc₁x,
  by_contradiction hc₂x, push_neg at hc₂x,
  have h₁ : d(c₁,c₂) ≤ d(c₁,x) + d(x,c₂), from hamming.distance_triangle_ineq c₁ c₂ x,
  have h₂ : d(c₁,c₂) ≤ 2 * t,
  from calc d(c₁,c₂) ≤ t + d(x,c₂) : le_add_of_le_add_right h₁ hc₁x
  ...                ≤ t + t       : by {simp, rw hamming.distance_symmetric, exact hc₂x}
  ...                = 2 * t       : by ring,
  have h₃ : d(C) ≤ d(c₁,c₂), from dist_neq_codewords_gte_min_distance c₁ c₂ hc₁ hc₂ hne,
  linarith,
end

/-! We combine the next two lemmas to prove the Hamming bound. -/

lemma codeword_sphere_union_card (t : ℕ) (ht : t ≤ n)
  (t_error_correcting : C.error_correcting t) :
  (finset.bUnion C.cws (λ c, sphere c t)).card =
  |C| * ∑ i in (finset.range (t + 1)), n.choose i :=
begin
  rw finset.card_bUnion,
    {
      have h : ∑ (u : BW n) in C.cws, (sphere u t).card =
               ∑ (u : BW n) in C.cws, ∑ i in (finset.range (t + 1)), n.choose i,
      begin
        rw finset.sum_congr,
          {refl},
        intros x hx,
        exact sphere_size x t ht,
      end,
      rw h, simp,
    },
    {intros x hx y hy hne,
    exact (t_error_correcting_spheres_disjoint t t_error_correcting) x y hx hy hne}
end

lemma codeword_sphere_union_card_le_univ_card (t : ℕ) (ht : t ≤ n)
  (t_error_correcting : C.error_correcting t) :
  (finset.bUnion C.cws (λ c, sphere c t)).card ≤ 2 ^ n :=
begin
  have h : (@finset.univ (BW n) BW.fintype).card = 2 ^ n,
  by {rw finset.card_univ, simp},
  rw ← h, apply finset.card_le_of_subset, rw finset.subset_iff, simp,
end

/--
The Hamming bound (Sphere-Packing bound) for a t-error-correcting code.
|C| ≤ 2ⁿ / (n.choose 0 + n.choose 1 + … + n.choose t)
-/
theorem hamming_bound (t : ℕ) (ht : t ≤ n)
  (t_error_correcting : C.error_correcting t) :
  |C| ≤ 2 ^ n / ∑ i in (finset.range (t + 1)), n.choose i :=
begin
  have h : |C| * ∑ i in (finset.range (t + 1)), n.choose i ≤ 2 ^ n,
  by {rw ← codeword_sphere_union_card t ht t_error_correcting,
     exact codeword_sphere_union_card_le_univ_card t ht t_error_correcting},
  have h₁ : ∑ (i : ℕ) in finset.range (t + 1), n.choose i > 0,
  begin
    by_contradiction h', push_neg at h', simp at h',
    rw finset.sum_range_succ' at h',
    simp at h', exact h',
  end,
  exact (nat.le_div_iff_mul_le (|C|) (2 ^ n) h₁).mpr h,
end

/--
A code is perfect if it attains the Hamming bound.
-/
def perfect (C : binary_code n M d) : Prop :=
|C| = 2 ^ n / ∑ i in (finset.range ((d - 1)/2 + 1)), n.choose i

end binary_code


import algebra.ring

namespace my_ring

variables {R : Type*} [ring R]
variables a b c : R

#check add_right_neg
#check sub_eq_add_neg
#check sub_eq_add_neg c

-- BEGIN
theorem self_sub (a : R) : a - a = 0 :=
begin
  rw sub_eq_add_neg a,
  rw add_right_neg,
end
-- END

#check self_sub

end my_ring


import Mathlib.Data.Real.Basic

def log (x : ℝ) := x - 1

-- #check

theorem log_mul_eq_add : log (a * b) = log a + log b := sorry
theorem log_add_eq_mul : log a + log b = log (a * b) := Iff.mp eq_comm log_mul_eq_add

-- theorem log_pm (a n : ℝ) : log (a ^ n) = n * log a := sorry

theorem log_le_zero_iff : log a ≤ 0 ↔ a ≤ 1 := sorry

lemma log_linear (x : ℝ) : log x ≤ x - 1 := by rfl

theorem log_ineq_iff (a b : ℝ) (hb : b > 0) : log (a / b) ≤ 0 ↔ b ≥ a :=
  calc
    _ ↔ a / b ≤ 1 := log_le_zero_iff
    _ ↔ _ := div_le_one hb

-- theorem log_

lemma sqrt_self (a : ℝ) : a = a^(1/2) * a^(1/2) := sorry
lemma sqrt_decompose (a b : ℝ) : (a*b)^(1/2) = a^(1/2) * b^(1/2) := sorry

lemma log_sqrt (a : ℝ) : log (a^(1/2)) = (1/2) * log a := sorry
lemma add_map (a b : ℝ) (f : ℝ -> ℝ) : a + b = f a + f b := sorry

lemma log_add_sqrt (a b : ℝ): log (a^(1/2)) + log (b^(1/2)) = (1/2) * log a + (1/2) * log b
  := sorry

theorem log_bi_arith_geom_ineq (a b : ℝ) (ha : a > 0) (hb : b > 0) :
  log ( (a*b)^(1/2) / ((a+b)/2) ) ≤ 0 :=
  have hale : _ := log_linear (2 * a/(a+b))
  have hble : _ := log_linear (2 * b/(a+b))
  have hline : log (2 * a/(a+b)) + log (2 * b/(a+b)) ≤ (2 * a/(a+b) - 1) + (2 * b/(a+b) - 1)
    := add_le_add hale hble
  have hsum : a + b ≠ 0 := sorry
  have hp : _ := sorry
  have hp' : _ := sorry
  calc
      _ = _ := sorry
      _ = log ((2 * a/(a+b))^(1/2)) + log ((2*b/(a+b))^(1/2)) := log_mul_eq_add
      _ = (1/2) * log (2 * a/(a+b)) + (1/2) * log (2*b/(a+b)) := log_add_sqrt _ _
      _ = (1/2) * ( log (2 * a/(a+b)) + log (2 * b/(a+b)) ) := by ring
      _ ≤ (1/2) * (2 * a/(a+b) - 1 + (2 * b/(a+b) - 1)) := mul_le_mul le_rfl hline hp hp'
      _ = (a + b) / (a + b) - 1 := by ring
      _ = 1 - 1 := by rw [div_self hsum]
      _ = 0 := by simp

theorem bi_arith_geom_ineq (a b : ℝ)
  (ha : a > 0) (hb : b > 0) : (a + b) / 2 ≥ (a*b)^(1/2) :=
  have hsum : a + b > 0 := add_pos ha hb
  have h2 : 2 > 0 := by simp
  have hbot : (a + b) / 2 > 0 := Iff.mp gt_iff_lt (div_pos hsum h2)
  have hlog : _ := log_bi_arith_geom_ineq a b ha hb
  show _ from Iff.mp (log_ineq_iff _ _ hbot) hlog

  -- calc

  -- have heq1 : _ := sqrt_decompose a b
--   have heq2 : (a * b)^(1/2) / ((a+b)/2) = a^(1/2)*b^(1/2) / ((a+b)/2) := sorry
--   have heq3 : a^(1/2) * b^(1/2) / ((a+b)/2) = ((2 * a/(a+b))^(1/2)) * ((2*b/(a+b))^(1/2)) := sorry

--   have hle1 _ := log_linear (2*a/(a+b))
--   -- have hle2 : (1/2) * log (2*a/(a+b)) ≤ (1/2) * (2 * a / (a + b) - 1) := mul_le_mul (le_refl _) hle1
--   calc
--     _ = log _ := congrArg log heq3
--     _ = log ((2 * a/(a+b))^(1/2)) + log ((2*a/(a+b))^(1/2)) := log_mul_eq_add
--     _ = (1/2) * log (2 * a/(a+b)) + (1/2) * log (2*b/(a+b)) := sorry
--     _ ≤ 0 := sorry


-- ---------------------------------------------------------------------
-- Ejercicio. Realizar las siguientes acciones:
-- 1. Importar la teoría data.set.function
-- 2. Declarar u y v como universos.
-- 3. Declarar α como variable sobre tipo de u habitados.
-- 4. Declarar β como variable sobre tipo de v.
-- 5. Declarar la teoría como no computable.
-- 6. Usar la lógica clásica.
-- ----------------------------------------------------------------------

import data.set.function               -- 1
universes u v                          -- 2
variables {α : Type u} [inhabited α]   -- 3
variables {β : Type v}                 -- 4
noncomputable theory                   -- 5
open_locale classical                  -- 6

-- ---------------------------------------------------------------------
-- Ejercicio. Definir la inversa de una función
-- ----------------------------------------------------------------------

def inverse (f : α → β) : β → α :=
λ y : β, if h : ∃ x, f x = y
         then classical.some h
         else default α

-- ---------------------------------------------------------------------
-- Ejercicio. Sea d una función de α en β e y un elemento de
-- β. Demostrar que si
--    ∃ x, f x = y
-- entonces
--    f (inverse f y) = y :=
-- ----------------------------------------------------------------------

theorem inverse_spec
  {f : α → β}
  (y : β)
  (h : ∃ x, f x = y) :
  f (inverse f y) = y :=
begin
  rw inverse, dsimp, rw dif_pos h,
  exact classical.some_spec h
end

-- Prueba
-- ======

/-
α : Type u,
_inst_1 : inhabited α,
β : Type v,
f : α → β,
y : β,
h : ∃ (x : α), f x = y
⊢ f (inverse f y) = y
  >> rw inverse, dsimp, rw dif_pos h,
⊢ f (classical.some h) = y
  >> exact classical.some_spec h,
no goals
-/

-- Comentarios:
-- 1. La identidad (dif_pos h), cuando (h : e), reescribe la expresión
--    (if h : e then x else y) a x.
-- 2. La identidad (dif_neg h), cuando (h : ¬ e), reescribe la expresión
--    (if h : e then x else y) a y.


import data.matrix.notation
import linear_algebra.matrix
import tactic.norm_fin
import tactic.noncomm_ring
import tactic.field_simp
import data.nat.parity

open_locale big_operators

-- 1.1.7
-- Find a formula for `![![1, 1, 1], ![0, 1, 1], ![0, 0, 1]]^n` and prove it by induction
example (n : ℕ) :
  (![![1, 1, 1], ![0, 1, 1], ![0, 0, 1]] ^ n : matrix _ _ ℕ) =
  ![![1, n, (n * (n + 1)) / 2], ![0, 1, n], ![0, 0, 1]] :=
begin
  induction n with n hn,
  { simp only [pow_two, nat.nat_zero_eq_zero, mul_zero, pow_zero],
    norm_num,
    ext i j,
    fin_cases i;
    fin_cases j;
    norm_num [matrix.one_apply, -matrix.cons_val'] },
  { suffices : n * (n + 1) / 2 + (n + 1) = (n + 1) * ((n + 1) + 1) / 2,
      { rw [pow_succ, hn],
        ext i j,
        fin_cases i;
        fin_cases j;
        norm_num [this] },
     apply nat.mul_left_injective (show 0 < 2, by norm_num),
     dsimp,
     rw [nat.div_mul_cancel (nat.even_mul_succ_self _), add_mul,
         nat.div_mul_cancel (nat.even_mul_succ_self _)],
     ring }
end

-- 1.1.16
-- A square matrix `A` is called nilpotent if `A^k = 0` for some `k > 0`.
-- Prove that if `A` is nilpotent, then `I + A` is invertible
example {R n : Type*} [comm_ring R] [fintype n] [decidable_eq n] (A : matrix n n R)
  (k : ℕ) (hk : 0 < k) (nilpotent : A ^ k = 0) : is_unit (1 + A) :=
begin
  have hr : ∀ m (x : matrix n n R), 1 - x ^ m = (1 - x) * ∑ i in finset.range m, x ^ i,
    { intros m x,
      induction m with m hm,
      { simp },
      { rw [finset.sum_range_succ, mul_add, ←hm, pow_succ],
        noncomm_ring } },
  have hl : ∀ m (x : matrix n n R), 1 - x ^ m = (∑ i in finset.range m, x ^ i) * (1 - x),
    { intros m x,
      induction m with m hm,
      { simp },
      { rw [finset.sum_range_succ, add_mul, ←hm, mul_sub, ←pow_succ', pow_succ],
        noncomm_ring } },
  specialize hr k (-A),
  specialize hl k (-A),
  rw [sub_neg_eq_add] at hr hl,
  refine ⟨⟨1 + A, ∑ i in finset.range k, (-A) ^ i, _, _⟩, rfl⟩,
  { simp [-matrix.mul_eq_mul, ←hr, neg_pow A k, nilpotent] },
  { simp [-matrix.mul_eq_mul, ←hl, neg_pow A k, nilpotent] }
end

-- 1.1.17
-- (a) Find infinitely many matrices `B` such that `BA = I₂` when
-- `A = ![![2, 3], ![1, 2], ![2, 5]]`
-- (b) Prove that there is no matrix `C` such that `AC = I₃`
example (A : matrix (fin 3) (fin 2) ℚ) (hA : A = ![![2, 3], ![1, 2], ![2, 5]]) :
  (∃ (B : matrix (fin 2) (fin 3) ℚ) , B.mul A = 1) ∧
  ∀ (C : matrix (fin 2) (fin 3) ℚ), A.mul C ≠ 1 :=
begin
  split,
  { have c : ℚ := arbitrary _,
    set b : ℚ := - 4 * c - 3 with hb,
    set a : ℚ := - (2 * b + 5 * c) / 3 with ha,
    have d : ℚ := arbitrary _,
    set f : ℚ := d + 1 with hf,
    set e : ℚ := - 2 * (d + f) with he,
    set B : matrix (fin 2) (fin 3) ℚ := ![![a, b, c], ![d, e, f]] with hB,
    use B,
    rw [hA],
    ext i j,
    fin_cases i;
    fin_cases j;
    simp [ha, hb, he, hf];
    ring },
  { intros C H,
    set a : ℚ := C 0 0 with ha,
    set b : ℚ := C 0 1 with hb,
    set c : ℚ := C 0 2 with hc,
    set d : ℚ := C 1 0 with hd,
    set e : ℚ := C 1 1 with he,
    set f : ℚ := C 1 2 with hf,
    have : C = ![![a, b, c], ![d, e, f]],
      { rw [ha, hb, hc, hd, he, hf],
        ext i j,
        fin_cases i;
        fin_cases j;
        refl },
    rw [hA, this] at H,
    have h22 := congr_fun (congr_fun H 2) 2,
    replace h22 : 2 * c + 5 * f = 1,
      { norm_num at h22, exact h22 },
    have h02 := congr_fun (congr_fun H 0) 2,
    have h12 := congr_fun (congr_fun H 1) 2,
    norm_num [matrix.one_apply] at h02 h12,
    replace h12 : c = - (2 * f) := add_eq_zero_iff_eq_neg.mp h12,
    replace h02 : f = 0,
      { rw h12 at h02,
        norm_num at h02,
        ring_nf at h02,
        simpa using h02 },
    replace h12 : c = 0 := by simpa [h02] using h12,
    norm_num [h02, h12] at h22 }
end


/-
  Some basic results about ranges over finite sets that I found useful.

  TODO : Check how much of this isn't actually somehwere in the mathlib.
-/

import data.finset
import data.finsupp
import data.nat.choose

universes u v w

open finset

section basics

-- range(f) = f '' {γ1, ..., γn}.

lemma finset.coe_image_univ {α : Type u} {β : Type v} [fintype α] [decidable_eq β] {f : α → β}
: set.range f = ↑(finset.image f finset.univ) :=
by rw [finset.coe_image, finset.coe_univ, ←set.image_univ]

-- f (Σi=1..n ai) = Σi=1..n f (ai).

lemma is_ring_hom.map_finset_sum
{A : Type u} {B : Type v} [comm_ring A] [comm_ring B] (f : A → B) [is_ring_hom f]
{C : Type w} [decidable_eq C] (s : C → A) (X : finset C)
: f (finset.sum X s) = finset.sum X (f ∘ s) :=
begin
  apply finset.induction_on X,
  { iterate 2 { rw finset.sum_empty, },
    exact is_ring_hom.map_zero f, },
  { intros a T HanT IH,
    iterate 2 { rw finset.sum_insert HanT, },
    rw is_ring_hom.map_add f,
    rw IH, }
end

-- Obvious: n ∉ {0, ..., n-1}.

@[simp] lemma finset.range_not_mem : ∀ n : ℕ, n ∉ range n :=
λ n Hn, (lt_irrefl n) (finset.mem_range.1 Hn)

-- If f(i) = g(i) for i=0..n then Σi=0..n f(i) = Σi=0..n g(i).

lemma finset.sum_range_eq {α : Type u} [comm_ring α] {f g : ℕ → α}
: ∀ n, (∀ m, m < n → f m = g m) → sum (range n) f = sum (range n) g :=
begin
  intros n Hn,
  induction n with n IH,
  { simp, },
  { repeat { rw finset.range_succ, },
    repeat { rw finset.sum_insert; try { apply finset.range_not_mem _, } },
    rw Hn n (nat.lt_succ_self n),
    rw IH,
    intros m Hm,
    exact Hn m (nat.lt_succ_of_lt Hm), }
end

-- Σi=0..(n+m) f(i) = (Σi=0..n f(i)) + (Σi=0..m f(i+n)).

lemma finset.sum_range_add {α : Type u} [comm_ring α] (f : ℕ → α)
: ∀ n m : ℕ, sum (range (n + m)) f = sum (range n) f + sum (range m) (λ i, f (i + n)) :=
begin
  intros n m,
  revert n,
  induction m with m IH,
  { simp, },
  { intros n,
    rw nat.add_succ,
    repeat { rw finset.range_succ, },
    repeat { rw finset.sum_insert; try { apply finset.range_not_mem _, } },
    rw IH n,
    simp, }
end

end basics

-- (a + b)^(n + m) = x * b ^ m + y * a ^ n
--  where x = Σi=0..(n-1) ((n+m), i) * a^i * b^(n-i),
--        y = Σi=0..m ((n+m), (i+n)) * a^i * b^(m-i).

-- Note: This might be way too specific.

lemma add_pow_sum
{α : Type u} [comm_ring α]
: ∀ (a b : α), ∀ (n m : ℕ), ∃ (x y : α),
  (a + b) ^ (n + m) = x * (b ^ m) + y * (a ^ n) :=
begin
  intros a b n m,
  rw add_pow,
  let cnmi : ℕ → α := λ i, ((nat.choose (n+m) i):α),
  use [finset.sum (range n) (λ i, a ^ i * b ^ (n - i) * (nat.choose (n + m) i))],
  use [sum (range (nat.succ m)) (λ i, a ^ i * b ^ (m - i) * (nat.choose (n + m) (i + n)))],
  rw add_comm (_ * _),
  repeat { rw finset.sum_mul, },
  repeat { rw finset.range_succ, },
  repeat { rw finset.sum_insert; try { apply finset.range_not_mem, }, },
  rw add_assoc,
  congr' 1,
  { rw [mul_assoc _ _ (a ^ n), mul_comm _ (a ^ n), ←mul_assoc _ (a ^ n) _],
    rw [mul_assoc _ _ (a ^ n), mul_comm _ (a ^ n), ←mul_assoc _ (a ^ n) _],
    rw [←pow_add, add_comm m],
    simp, },
  rw finset.sum_range_add,
  rw add_comm,
  congr' 1,
  { apply finset.sum_range_eq,
    intros z Hz,
    rw [mul_assoc _ _ (a ^ n), mul_comm _ (a ^ n), ←mul_assoc _ (a ^ n) _],
    rw [mul_assoc _ _ (a ^ n), mul_comm _ (a ^ n), ←mul_assoc _ (a ^ n) _],
    rw [←pow_add, add_comm n, nat.add_sub_add_right, add_comm z], },
  { apply finset.sum_range_eq,
    intros z Hz,
    rw [mul_assoc _ _ (b ^ m), mul_comm _ (b ^ m), ←mul_assoc _ (b ^ m) _],
    rw [mul_assoc _ _ (b ^ m), ←pow_add, add_comm n _, add_comm (n - z) _],
    rw [←nat.add_sub_assoc],
    exact nat.le_of_lt Hz, },
end


import data.list.basic
open list
universe u
variables {α : Type} (x y z : α) (xs ys zs : list α)

def mk_symm (xs : list α) := xs ++ reverse xs

theorem reverse_mk_symm (xs : list α) :
  reverse (mk_symm xs) = mk_symm xs :=
  by simp [mk_symm]

attribute [simp] reverse_mk_symm

example (xs ys : list ℕ) (p : list ℕ → Prop) (h : p (reverse (xs ++ (mk_symm ys)))) :
  p (mk_symm ys ++ reverse xs) :=
  by { simp at h; assumption }

-- example (xs ys : list ℕ) (p : list ℕ → Prop) (h : p (reverse (xs ++ (mk_symm ys)))) :
--   p (mk_symm ys ++ reverse xs) :=
--   by { simp [-reverse_mk_symm] at h; assumption }

-- example (xs ys : list ℕ) (p : list ℕ → Prop) (h : p (reverse (xs ++ (mk_symm ys)))) :
--   p (mk_symm ys ++ reverse xs) :=
--   by { simp only [reverse_append] at h; assumption }


/-
Copyright (c) 2014 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jeremy Avigad, Leonardo de Moura, Simon Hudon, Mario Carneiro
-/

import algebra.group.defs
import logic.function.basic

/-!
# Basic lemmas about semigroups, monoids, and groups

This file lists various basic lemmas about semigroups, monoids, and groups. Most proofs are
one-liners from the corresponding axioms. For the definitions of semigroups, monoids and groups, see
`algebra/group/defs.lean`.
-/

universe u

section associative
variables {α : Type u} (f : α → α → α) [is_associative α f] (x y : α)

/--
Composing two associative operations of `f : α → α → α` on the left
is equal to an associative operation on the left.
-/
lemma comp_assoc_left : (f x) ∘ (f y) = (f (f x y)) :=
by { ext z, rw [function.comp_apply, @is_associative.assoc _ f] }

/--
Composing two associative operations of `f : α → α → α` on the right
is equal to an associative operation on the right.
-/
lemma comp_assoc_right : (λ z, f z x) ∘ (λ z, f z y) = (λ z, f z (f y x)) :=
by { ext z, rw [function.comp_apply, @is_associative.assoc _ f] }

end associative

section semigroup
variables {α : Type*}

/--
Composing two multiplications on the left by `y` then `x`
is equal to a multiplication on the left by `x * y`.
-/
@[simp, to_additive
"Composing two additions on the left by `y` then `x`
is equal to a addition on the left by `x + y`."]
lemma comp_mul_left [semigroup α] (x y : α) :
  ((*) x) ∘ ((*) y) = ((*) (x * y)) :=
comp_assoc_left _ _ _

/--
Composing two multiplications on the right by `y` and `x`
is equal to a multiplication on the right by `y * x`.
-/
@[simp, to_additive
"Composing two additions on the right by `y` and `x`
is equal to a addition on the right by `y + x`."]
lemma comp_mul_right [semigroup α] (x y : α) :
  (* x) ∘ (* y) = (* (y * x)) :=
comp_assoc_right _ _ _

end semigroup

section mul_one_class
variables {M : Type u} [mul_one_class M]

@[to_additive]
lemma ite_mul_one {P : Prop} [decidable P] {a b : M} :
  ite P (a * b) 1 = ite P a 1 * ite P b 1 :=
by { by_cases h : P; simp [h], }

@[to_additive]
lemma eq_one_iff_eq_one_of_mul_eq_one {a b : M} (h : a * b = 1) : a = 1 ↔ b = 1 :=
by split; { rintro rfl, simpa using h }

@[to_additive]
lemma one_mul_eq_id : ((*) (1 : M)) = id := funext one_mul

@[to_additive]
lemma mul_one_eq_id : (* (1 : M)) = id := funext mul_one

end mul_one_class

section comm_semigroup
variables {G : Type u} [comm_semigroup G]

@[no_rsimp, to_additive]
lemma mul_left_comm : ∀ a b c : G, a * (b * c) = b * (a * c) :=
left_comm has_mul.mul mul_comm mul_assoc
attribute [no_rsimp] add_left_comm

@[to_additive]
lemma mul_right_comm : ∀ a b c : G, a * b * c = a * c * b :=
right_comm has_mul.mul mul_comm mul_assoc

@[to_additive]
theorem mul_mul_mul_comm (a b c d : G) : (a * b) * (c * d) = (a * c) * (b * d) :=
by simp only [mul_left_comm, mul_assoc]

end comm_semigroup

local attribute [simp] mul_assoc sub_eq_add_neg

section add_monoid
variables {M : Type u} [add_monoid M] {a b c : M}

@[simp] lemma bit0_zero : bit0 (0 : M) = 0 := add_zero _
@[simp] lemma bit1_zero [has_one M] : bit1 (0 : M) = 1 :=
by rw [bit1, bit0_zero, zero_add]

end add_monoid

section comm_monoid
variables {M : Type u} [comm_monoid M] {x y z : M}

@[to_additive] lemma inv_unique (hy : x * y = 1) (hz : x * z = 1) : y = z :=
left_inv_eq_right_inv (trans (mul_comm _ _) hy) hz

end comm_monoid

section left_cancel_monoid

variables {M : Type u} [left_cancel_monoid M] {a b : M}

@[simp, to_additive] lemma mul_right_eq_self : a * b = a ↔ b = 1 :=
calc a * b = a ↔ a * b = a * 1 : by rw mul_one
           ... ↔ b = 1         : mul_left_cancel_iff

@[simp, to_additive] lemma self_eq_mul_right : a = a * b ↔ b = 1 :=
eq_comm.trans mul_right_eq_self

end left_cancel_monoid

section right_cancel_monoid

variables {M : Type u} [right_cancel_monoid M] {a b : M}

@[simp, to_additive] lemma mul_left_eq_self : a * b = b ↔ a = 1 :=
calc a * b = b ↔ a * b = 1 * b : by rw one_mul
           ... ↔ a = 1         : mul_right_cancel_iff

@[simp, to_additive] lemma self_eq_mul_left : b = a * b ↔ a = 1 :=
eq_comm.trans mul_left_eq_self

end right_cancel_monoid

section div_inv_monoid

variables {G : Type u} [div_inv_monoid G]

@[to_additive]
lemma inv_eq_one_div (x : G) :
  x⁻¹ = 1 / x :=
by rw [div_eq_mul_inv, one_mul]

@[to_additive]
lemma mul_one_div (x y : G) :
  x * (1 / y) = x / y :=
by rw [div_eq_mul_inv, one_mul, div_eq_mul_inv]

lemma mul_div_assoc {a b c : G} : a * b / c = a * (b / c) :=
by rw [div_eq_mul_inv, div_eq_mul_inv, mul_assoc _ _ _]

lemma mul_div_assoc' (a b c : G) : a * (b / c) = (a * b) / c :=
mul_div_assoc.symm

@[simp, to_additive] lemma one_div (a : G) : 1 / a = a⁻¹ :=
(inv_eq_one_div a).symm

end div_inv_monoid

section group
variables {G : Type u} [group G] {a b c : G}

@[simp, to_additive]
lemma inv_mul_cancel_right (a b : G) : a * b⁻¹ * b = a :=
by simp [mul_assoc]

@[simp, to_additive neg_zero]
lemma one_inv : 1⁻¹ = (1 : G) :=
inv_eq_of_mul_eq_one (one_mul 1)

@[to_additive]
theorem left_inverse_inv (G) [group G] :
  function.left_inverse (λ a : G, a⁻¹) (λ a, a⁻¹) :=
inv_inv

@[simp, to_additive]
lemma inv_involutive : function.involutive (has_inv.inv : G → G) := inv_inv

@[to_additive]
lemma inv_injective : function.injective (has_inv.inv : G → G) :=
inv_involutive.injective

@[simp, to_additive] theorem inv_inj : a⁻¹ = b⁻¹ ↔ a = b := inv_injective.eq_iff

@[simp, to_additive]
lemma mul_inv_cancel_left (a b : G) : a * (a⁻¹ * b) = b :=
by rw [← mul_assoc, mul_right_inv, one_mul]

@[to_additive]
theorem mul_left_surjective (a : G) : function.surjective ((*) a) :=
λ x, ⟨a⁻¹ * x, mul_inv_cancel_left a x⟩

@[to_additive]
theorem mul_right_surjective (a : G) : function.surjective (λ x, x * a) :=
λ x, ⟨x * a⁻¹, inv_mul_cancel_right x a⟩

@[simp, to_additive neg_add_rev]
lemma mul_inv_rev (a b : G) : (a * b)⁻¹ = b⁻¹ * a⁻¹ :=
inv_eq_of_mul_eq_one $ by simp

@[to_additive]
lemma eq_inv_of_eq_inv (h : a = b⁻¹) : b = a⁻¹ :=
by simp [h]

@[to_additive]
lemma eq_inv_of_mul_eq_one (h : a * b = 1) : a = b⁻¹ :=
have a⁻¹ = b, from inv_eq_of_mul_eq_one h,
by simp [this.symm]

@[to_additive]
lemma eq_mul_inv_of_mul_eq (h : a * c = b) : a = b * c⁻¹ :=
by simp [h.symm]

@[to_additive]
lemma eq_inv_mul_of_mul_eq (h : b * a = c) : a = b⁻¹ * c :=
by simp [h.symm]

@[to_additive]
lemma inv_mul_eq_of_eq_mul (h : b = a * c) : a⁻¹ * b = c :=
by simp [h]

@[to_additive]
lemma mul_inv_eq_of_eq_mul (h : a = c * b) : a * b⁻¹ = c :=
by simp [h]

@[to_additive]
lemma eq_mul_of_mul_inv_eq (h : a * c⁻¹ = b) : a = b * c :=
by simp [h.symm]

@[to_additive]
lemma eq_mul_of_inv_mul_eq (h : b⁻¹ * a = c) : a = b * c :=
by simp [h.symm, mul_inv_cancel_left]

@[to_additive]
lemma mul_eq_of_eq_inv_mul (h : b = a⁻¹ * c) : a * b = c :=
by rw [h, mul_inv_cancel_left]

@[to_additive]
lemma mul_eq_of_eq_mul_inv (h : a = c * b⁻¹) : a * b = c :=
by simp [h]

@[simp, to_additive]
theorem inv_eq_one : a⁻¹ = 1 ↔ a = 1 :=
by rw [← @inv_inj _ _ a 1, one_inv]

@[simp, to_additive]
theorem one_eq_inv : 1 = a⁻¹ ↔ a = 1 :=
by rw [eq_comm, inv_eq_one]

@[to_additive]
theorem inv_ne_one : a⁻¹ ≠ 1 ↔ a ≠ 1 :=
not_congr inv_eq_one

@[to_additive]
theorem eq_inv_iff_eq_inv : a = b⁻¹ ↔ b = a⁻¹ :=
⟨eq_inv_of_eq_inv, eq_inv_of_eq_inv⟩

@[to_additive]
theorem inv_eq_iff_inv_eq : a⁻¹ = b ↔ b⁻¹ = a :=
eq_comm.trans $ eq_inv_iff_eq_inv.trans eq_comm

@[to_additive]
theorem mul_eq_one_iff_eq_inv : a * b = 1 ↔ a = b⁻¹ :=
⟨eq_inv_of_mul_eq_one, λ h, by rw [h, mul_left_inv]⟩

@[to_additive]
theorem mul_eq_one_iff_inv_eq : a * b = 1 ↔ a⁻¹ = b :=
by rw [mul_eq_one_iff_eq_inv, eq_inv_iff_eq_inv, eq_comm]

@[to_additive]
theorem eq_inv_iff_mul_eq_one : a = b⁻¹ ↔ a * b = 1 :=
mul_eq_one_iff_eq_inv.symm

@[to_additive]
theorem inv_eq_iff_mul_eq_one : a⁻¹ = b ↔ a * b = 1 :=
mul_eq_one_iff_inv_eq.symm

@[to_additive]
theorem eq_mul_inv_iff_mul_eq : a = b * c⁻¹ ↔ a * c = b :=
⟨λ h, by rw [h, inv_mul_cancel_right], λ h, by rw [← h, mul_inv_cancel_right]⟩

@[to_additive]
theorem eq_inv_mul_iff_mul_eq : a = b⁻¹ * c ↔ b * a = c :=
⟨λ h, by rw [h, mul_inv_cancel_left], λ h, by rw [← h, inv_mul_cancel_left]⟩

@[to_additive]
theorem inv_mul_eq_iff_eq_mul : a⁻¹ * b = c ↔ b = a * c :=
⟨λ h, by rw [← h, mul_inv_cancel_left], λ h, by rw [h, inv_mul_cancel_left]⟩

@[to_additive]
theorem mul_inv_eq_iff_eq_mul : a * b⁻¹ = c ↔ a = c * b :=
⟨λ h, by rw [← h, inv_mul_cancel_right], λ h, by rw [h, mul_inv_cancel_right]⟩

@[to_additive]
theorem mul_inv_eq_one : a * b⁻¹ = 1 ↔ a = b :=
by rw [mul_eq_one_iff_eq_inv, inv_inv]

@[to_additive]
theorem inv_mul_eq_one : a⁻¹ * b = 1 ↔ a = b :=
by rw [mul_eq_one_iff_eq_inv, inv_inj]

@[to_additive]
lemma div_left_injective : function.injective (λ a, a / b) :=
by simpa only [div_eq_mul_inv] using λ a a' h, mul_left_injective (b⁻¹) h

@[to_additive]
lemma div_right_injective : function.injective (λ a, b / a) :=
by simpa only [div_eq_mul_inv] using λ a a' h, inv_injective (mul_right_injective b h)

end group

section add_group
variables {G : Type u} [add_group G] {a b c d : G}

@[simp] lemma sub_self (a : G) : a - a = 0 :=
by rw [sub_eq_add_neg, add_right_neg a]

@[simp] lemma sub_add_cancel (a b : G) : a - b + b = a :=
by rw [sub_eq_add_neg, neg_add_cancel_right a b]

@[simp] lemma add_sub_cancel (a b : G) : a + b - b = a :=
by rw [sub_eq_add_neg, add_neg_cancel_right a b]

lemma add_sub_assoc (a b c : G) : a + b - c = a + (b - c) :=
by rw [sub_eq_add_neg, add_assoc, ←sub_eq_add_neg]

lemma eq_of_sub_eq_zero (h : a - b = 0) : a = b :=
calc a = a - b + b : (sub_add_cancel a b).symm
   ... = b         : by rw [h, zero_add]

@[simp] lemma sub_zero (a : G) : a - 0 = a :=
by rw [sub_eq_add_neg, neg_zero, add_zero]

lemma sub_ne_zero_of_ne (h : a ≠ b) : a - b ≠ 0 :=
mt eq_of_sub_eq_zero h

@[simp] lemma sub_neg_eq_add (a b : G) : a - (-b) = a + b :=
by rw [sub_eq_add_neg, neg_neg]

@[simp] lemma neg_sub (a b : G) : -(a - b) = b - a :=
neg_eq_of_add_eq_zero (by rw [sub_eq_add_neg, sub_eq_add_neg, add_assoc, neg_add_cancel_left,
  add_right_neg])

local attribute [simp] add_assoc

lemma add_sub (a b c : G) : a + (b - c) = a + b - c :=
by simp

lemma sub_add_eq_sub_sub_swap (a b c : G) : a - (b + c) = a - c - b :=
by simp

@[simp] lemma add_sub_add_right_eq_sub (a b c : G) : (a + c) - (b + c) = a - b :=
by rw [sub_add_eq_sub_sub_swap]; simp

lemma eq_sub_of_add_eq (h : a + c = b) : a = b - c :=
by simp [← h]

lemma sub_eq_of_eq_add (h : a = c + b) : a - b = c :=
by simp [h]

lemma eq_add_of_sub_eq (h : a - c = b) : a = b + c :=
by simp [← h]

lemma add_eq_of_eq_sub (h : a = c - b) : a + b = c :=
by simp [h]

@[simp] lemma sub_right_inj : a - b = a - c ↔ b = c :=
sub_right_injective.eq_iff

@[simp] lemma sub_left_inj : b - a = c - a ↔ b = c :=
by { rw [sub_eq_add_neg, sub_eq_add_neg], exact add_left_inj _ }

lemma sub_add_sub_cancel (a b c : G) : (a - b) + (b - c) = a - c :=
by rw [← add_sub_assoc, sub_add_cancel]

lemma sub_sub_sub_cancel_right (a b c : G) : (a - c) - (b - c) = a - b :=
by rw [← neg_sub c b, sub_neg_eq_add, sub_add_sub_cancel]

theorem sub_sub_assoc_swap : a - (b - c) = a + c - b :=
by simp

theorem sub_eq_zero : a - b = 0 ↔ a = b :=
⟨eq_of_sub_eq_zero, λ h, by rw [h, sub_self]⟩

alias sub_eq_zero ↔ _ sub_eq_zero_of_eq

theorem sub_ne_zero : a - b ≠ 0 ↔ a ≠ b :=
not_congr sub_eq_zero

@[simp] theorem sub_eq_self : a - b = a ↔ b = 0 :=
by rw [sub_eq_add_neg, add_right_eq_self, neg_eq_zero]

theorem eq_sub_iff_add_eq : a = b - c ↔ a + c = b :=
by rw [sub_eq_add_neg, eq_add_neg_iff_add_eq]

theorem sub_eq_iff_eq_add : a - b = c ↔ a = c + b :=
by rw [sub_eq_add_neg, add_neg_eq_iff_eq_add]

theorem eq_iff_eq_of_sub_eq_sub (H : a - b = c - d) : a = b ↔ c = d :=
by rw [← sub_eq_zero, H, sub_eq_zero]

theorem left_inverse_sub_add_left (c : G) : function.left_inverse (λ x, x - c) (λ x, x + c) :=
assume x, add_sub_cancel x c

theorem left_inverse_add_left_sub (c : G) : function.left_inverse (λ x, x + c) (λ x, x - c) :=
assume x, sub_add_cancel x c

theorem left_inverse_add_right_neg_add (c : G) :
  function.left_inverse (λ x, c + x) (λ x, - c + x) :=
assume x, add_neg_cancel_left c x

theorem left_inverse_neg_add_add_right (c : G) :
  function.left_inverse (λ x, - c + x) (λ x, c + x) :=
assume x, neg_add_cancel_left c x

end add_group

section comm_group
variables {G : Type u} [comm_group G]

@[to_additive neg_add]
lemma mul_inv (a b : G) : (a * b)⁻¹ = a⁻¹ * b⁻¹ :=
by rw [mul_inv_rev, mul_comm]

end comm_group

section add_comm_group
variables {G : Type u} [add_comm_group G] {a b c d : G}

local attribute [simp] add_assoc add_comm add_left_comm sub_eq_add_neg

lemma sub_add_eq_sub_sub (a b c : G) : a - (b + c) = a - b - c :=
by simp

lemma neg_add_eq_sub (a b : G) : -a + b = b - a :=
by simp

lemma sub_add_eq_add_sub (a b c : G) : a - b + c = a + c - b :=
by simp

lemma sub_sub (a b c : G) : a - b - c = a - (b + c) :=
by simp

lemma sub_add (a b c : G) : a - b + c = a - (b - c) :=
by simp

@[simp] lemma add_sub_add_left_eq_sub (a b c : G) : (c + a) - (c + b) = a - b :=
by simp

lemma eq_sub_of_add_eq' (h : c + a = b) : a = b - c :=
by simp [h.symm]

lemma sub_eq_of_eq_add' (h : a = b + c) : a - b = c :=
begin simp [h], rw [add_left_comm], simp end

lemma eq_add_of_sub_eq' (h : a - b = c) : a = b + c :=
by simp [h.symm]

lemma add_eq_of_eq_sub' (h : b = c - a) : a + b = c :=
begin simp [h], rw [add_comm c, add_neg_cancel_left] end

lemma sub_sub_self (a b : G) : a - (a - b) = b :=
begin simp, rw [add_comm b, add_neg_cancel_left] end

lemma add_sub_comm (a b c d : G) : a + b - (c + d) = (a - c) + (b - d) :=
by simp

lemma sub_eq_sub_add_sub (a b c : G) : a - b = c - b + (a - c) :=
begin simp, rw [add_left_comm c], simp end

lemma neg_neg_sub_neg (a b : G) : - (-a - -b) = a - b :=
by simp

@[simp] lemma sub_sub_cancel (a b : G) : a - (a - b) = b := sub_sub_self a b

lemma sub_eq_neg_add (a b : G) : a - b = -b + a :=
by rw [sub_eq_add_neg, add_comm _ _]

theorem neg_add' (a b : G) : -(a + b) = -a - b :=
by rw [sub_eq_add_neg, neg_add a b]

@[simp]
lemma neg_sub_neg (a b : G) : -a - -b = b - a :=
by simp [sub_eq_neg_add, add_comm]

lemma eq_sub_iff_add_eq' : a = b - c ↔ c + a = b :=
by rw [eq_sub_iff_add_eq, add_comm]

lemma sub_eq_iff_eq_add' : a - b = c ↔ a = b + c :=
by rw [sub_eq_iff_eq_add, add_comm]

@[simp]
lemma add_sub_cancel' (a b : G) : a + b - a = b :=
by rw [sub_eq_neg_add, neg_add_cancel_left]

@[simp]
lemma add_sub_cancel'_right (a b : G) : a + (b - a) = b :=
by rw [← add_sub_assoc, add_sub_cancel']

-- This lemma is in the `simp` set under the name `add_neg_cancel_comm_assoc`,
-- defined  in `algebra/group/commute`
lemma add_add_neg_cancel'_right (a b : G) : a + (b + -a) = b :=
by rw [← sub_eq_add_neg, add_sub_cancel'_right a b]

lemma sub_right_comm (a b c : G) : a - b - c = a - c - b :=
by { repeat { rw sub_eq_add_neg }, exact add_right_comm _ _ _ }

@[simp] lemma add_add_sub_cancel (a b c : G) : (a + c) + (b - c) = a + b :=
by rw [add_assoc, add_sub_cancel'_right]

@[simp] lemma sub_add_add_cancel (a b c : G) : (a - c) + (b + c) = a + b :=
by rw [add_left_comm, sub_add_cancel, add_comm]

@[simp] lemma sub_add_sub_cancel' (a b c : G) : (a - b) + (c - a) = c - b :=
by rw add_comm; apply sub_add_sub_cancel

@[simp] lemma add_sub_sub_cancel (a b c : G) : (a + b) - (a - c) = b + c :=
by rw [← sub_add, add_sub_cancel']

@[simp] lemma sub_sub_sub_cancel_left (a b c : G) : (c - a) - (c - b) = b - a :=
by rw [← neg_sub b c, sub_neg_eq_add, add_comm, sub_add_sub_cancel]

lemma sub_eq_sub_iff_add_eq_add : a - b = c - d ↔ a + d = c + b :=
begin
  rw [sub_eq_iff_eq_add, sub_add_eq_add_sub, eq_comm, sub_eq_iff_eq_add'],
  simp only [add_comm, eq_comm]
end

lemma sub_eq_sub_iff_sub_eq_sub : a - b = c - d ↔ a - c = b - d :=
by rw [sub_eq_iff_eq_add, sub_add_eq_add_sub, sub_eq_iff_eq_add', add_sub_assoc]

end add_comm_group


/-
Copyright (c) 2022 Rishikesh Vaishnav. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Rishikesh Vaishnav
-/
import probability.independence

/-!
# Conditional Probability

This file defines conditional probability and includes basic results relating to it.

Given some measure `μ` defined on a measure space on some type `α` and some `s : set α`,
we define the measure of `μ` conditioned on `s` as the restricted measure scaled by
the inverse of the measure of `s`: `cond μ s = (μ s)⁻¹ • μ.restrict s`. The scaling
ensures that this is a probability measure (when `μ` is a finite measure).

From this definition, we derive the "axiomatic" definition of conditional probability
based on application: for any `s t : set α`, we have `μ[t|s] = (μ s)⁻¹ * μ (s ∩ t)`.

## Main Statements

* `cond_cond_eq_cond_inter`: conditioning on one set and then another is equivalent
  to conditioning on their intersection.
* `cond_eq_inv_mul_cond_mul`: Bayes' Theorem, `μ[t|s] = (μ s)⁻¹ * μ[s|t] * (μ t)`.

## Notations

This file uses the local notation `μ[|s]` the measure of `μ` conditioned on `s`,
and `μ[t|s]` for the probability of `t` given `s` under `μ` (equivalent to the
application `μ[|s] t`).

## Implementation notes

Because we have the alternative measure restriction application principles
`measure.restrict_apply` and `measure.restrict_apply'`, which require
measurability of the restricted and restricting sets, respectively,
many of the theorems here will have corresponding alternatives as well.
For the sake of brevity, we've chosen to only go with `measure.restrict_apply'`
for now, but the alternative theorems can be added if needed.

Use of `@[simp]` generally follows the rule of removing conditions on a measure
when possible.

Hypotheses that are used to "define" a conditional distribution by requiring that
the conditioning set has non-zero measure should be named using the abbreviation
"c" (which stands for "conditionable") rather than "nz". For example `(hci : μ (s ∩ t) ≠ 0)`
(rather than `hnzi`) should be used for a hypothesis ensuring that `μ[|s ∩ t]` is defined.

## Tags
conditional, conditioned, bayes
-/

noncomputable theory

open measure_theory measurable_space

variables {α : Type*} {m : measurable_space α} (μ : measure α) {s t : set α}

namespace probability_theory

section definitions

/-- The conditional probability measure of measure `μ` on set `s` is `μ` restricted to `s`
and scaled by the inverse of `μ s` (to make it a probability measure):
`(μ s)⁻¹ • μ.restrict s`. -/
def cond (s : set α) : measure α :=
  (μ s)⁻¹ • μ.restrict s

end definitions

local notation  μ `[` s `|` t `]` := cond μ t s
local notation  μ `[|`:60 t`]` := cond μ t

/-- The conditional probability measure of any finite measure on any set of positive measure
is a probability measure. -/
lemma cond_is_probability_measure [is_finite_measure μ] (hcs : μ s ≠ 0) :
  is_probability_measure $ μ[|s] :=
⟨by { rw [cond, measure.smul_apply, measure.restrict_apply measurable_set.univ,
  set.univ_inter], exact ennreal.inv_mul_cancel hcs (measure_ne_top _ s) }⟩

section bayes

@[simp] lemma cond_univ [is_probability_measure μ] :
  μ[|set.univ] = μ :=
by simp [cond, measure_univ, measure.restrict_univ]

/-- The axiomatic definition of conditional probability derived from a measure-theoretic one. -/
@[simp] lemma cond_apply (hms : measurable_set s) (t : set α) :
  μ[t|s] = (μ s)⁻¹ * μ (s ∩ t) :=
by { rw [cond, measure.smul_apply, measure.restrict_apply' hms, set.inter_comm], refl }

lemma inter_pos_of_cond_ne_zero (hms : measurable_set s) (hcst : μ[t|s] ≠ 0) :
  0 < μ (s ∩ t) :=
begin
  refine pos_iff_ne_zero.mpr (right_ne_zero_of_mul _),
  { exact (μ s)⁻¹ },
  convert hcst,
  simp [hms, set.inter_comm]
end

variable [is_finite_measure μ]

lemma cond_pos_of_inter_ne_zero (hms : measurable_set s) (hci : μ (s ∩ t) ≠ 0) :
  0 < μ[|s] t :=
begin
  rw cond_apply _ hms,
  refine ennreal.mul_pos _ hci,
  exact ennreal.inv_ne_zero.mpr (measure_ne_top _ _),
end

/-- Conditioning first on `s` and then on `t` results in the same measure as conditioning
on `s ∩ t`. -/
@[simp] lemma cond_cond_eq_cond_inter
  (hms : measurable_set s) (hmt : measurable_set t) (hci : μ (s ∩ t) ≠ 0) :
  μ[|s][|t] = μ[|s ∩ t] :=
begin
  have := hms.inter hmt,
  have := measure_ne_top μ s,
  have hcs : μ s ≠ 0 := (μ.to_outer_measure.pos_of_subset_ne_zero
    (set.inter_subset_left _ _) hci).ne',
  ext1,
  haveI := cond_is_probability_measure μ hcs,
  simp only [*, cond_apply, ←mul_assoc, ←set.inter_assoc],
  congr,
  simp [*, ennreal.mul_inv, mul_comm, ←mul_assoc, ennreal.inv_mul_cancel]
end

@[simp] lemma cond_mul_eq_inter (hms : measurable_set s) (hcs : μ s ≠ 0) (t : set α) :
  μ[t|s] * μ s = μ (s ∩ t) :=
by rw [cond_apply μ hms t, mul_comm, ←mul_assoc,
  ennreal.mul_inv_cancel hcs (measure_ne_top _ s), one_mul]

/-- **Bayes' Theorem** -/
theorem cond_eq_inv_mul_cond_mul (hms : measurable_set s) (hmt : measurable_set t) (ht : μ t ≠ 0) :
  μ[t|s] = (μ s)⁻¹ * μ[s|t] * (μ t) :=
by rw [mul_assoc, cond_mul_eq_inter μ hmt ht s, set.inter_comm, cond_apply _ hms]

end bayes

end probability_theory


/-
Copyright (c) 2022 Alexander Bentkamp. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alexander Bentkamp
-/
import missing.linear_algebra.matrix.block

/-
# Triangular Matrices
This file defines upper and lower triangular matrices. The definitions are based on
`matrix.block_triangular`. All properties should ideally be proved for `matrix.block_triangular` in
general and then specialized to (nonblock)-triangular matrices here.
-/

namespace matrix
open_locale big_operators
open_locale matrix
variables {α m n : Type*}
variables {R : Type*} [comm_ring R] {M N : matrix m m R}

/-- An upper triangular matrix is a matrix whose entries are zero below the diagonal. -/
def upper_triangular [has_lt m] (M : matrix m m R) :=
  M.block_triangular id

/-- A lower triangular matrix is a matrix whose entries are zero above the diagonal. -/
def lower_triangular [has_lt m] (M : matrix m m R) :=
  M.block_triangular order_dual.to_dual

/-- The inverse of an upper triangular matrix is upper triangular -/
lemma upper_triangular_inv_of_upper_triangular [fintype m] [linear_order m] [invertible M]
  (hM : upper_triangular M) : upper_triangular M⁻¹ :=
block_triangular_inv_of_block_triangular hM

/-- The inverse of a lower triangular matrix is lower triangular -/
lemma lower_triangular_inv_of_lower_triangular [fintype m] [linear_order m] [invertible M]
  (hM : lower_triangular M) : lower_triangular M⁻¹ :=
block_triangular_inv_of_block_triangular hM

/-- Multiplication of upper triangular matrices is upper triangular -/
lemma upper_triangular.mul [fintype m] [linear_order m]
  (hM : upper_triangular M) (hN : upper_triangular N) : upper_triangular (M ⬝ N) :=
block_triangular.mul hM hN

/-- Multiplication of lower triangular matrices is lower triangular -/
lemma lower_triangular.mul [fintype m] [linear_order m]
  (hM : lower_triangular M) (hN : lower_triangular N) : lower_triangular (M ⬝ N) :=
block_triangular.mul hM hN

/-- Transpose of lower triangular matrix is upper triangular -/
lemma lower_triangular.transpose [fintype m] [linear_order m]
  (hM : lower_triangular M) : upper_triangular Mᵀ :=
hM.transpose

/-- Transpose of upper triangular matrix is lower triangular -/
lemma upper_triangular.transpose [fintype m] [linear_order m]
  (hM : upper_triangular M) : lower_triangular Mᵀ :=
hM.transpose

lemma diag_inv_mul_diag_eq_one_of_upper_triangular [fintype m] [linear_order m] [invertible M]
  (hM : upper_triangular M) (k : m) : M⁻¹ k k * M k k = 1 :=
begin
  letI : unique {a // id a = k} := ⟨⟨⟨k, rfl⟩⟩, λ j, subtype.ext j.property⟩,
  simpa [matrix.mul, dot_product, fintype.sum_unique] using
    congr_fun (congr_fun (to_square_block_inv_mul_to_square_block_eq_one hM k) ⟨k, rfl⟩) ⟨k, rfl⟩,
end

lemma diag_inv_mul_diag_eq_one_of_lower_triangular [fintype m] [linear_order m] [invertible M]
  (hM : lower_triangular M) (k : m) : M⁻¹ k k * M k k = 1 :=
begin
  letI : unique {a // order_dual.to_dual a = k} := ⟨⟨⟨k, rfl⟩⟩, λ j, subtype.ext j.property⟩,
  simpa [matrix.mul, dot_product, fintype.sum_unique] using
    congr_fun (congr_fun (to_square_block_inv_mul_to_square_block_eq_one hM k) ⟨k, rfl⟩) ⟨k, rfl⟩,
end

end matrix


/-
Copyright (c) 2020 Anatole Dedecker. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Anatole Dedecker, Devon Tuma
-/
import analysis.asymptotics.asymptotic_equivalent
import analysis.asymptotics.specific_asymptotics
import data.polynomial.ring_division

/-!
# Limits related to polynomial and rational functions

This file proves basic facts about limits of polynomial and rationals functions.
The main result is `eval_is_equivalent_at_top_eval_lead`, which states that for
any polynomial `P` of degree `n` with leading coefficient `a`, the corresponding
polynomial function is equivalent to `a * x^n` as `x` goes to +∞.

We can then use this result to prove various limits for polynomial and rational
functions, depending on the degrees and leading coefficients of the considered
polynomials.
-/

open filter finset asymptotics
open_locale asymptotics topological_space

namespace polynomial

variables {𝕜 : Type*} [normed_linear_ordered_field 𝕜] (P Q : polynomial 𝕜)

lemma eventually_no_roots (hP : P ≠ 0) : ∀ᶠ x in filter.at_top, ¬ P.is_root x :=
begin
  obtain ⟨x₀, hx₀⟩ := exists_max_root P hP,
  refine filter.eventually_at_top.mpr (⟨x₀ + 1, λ x hx h, _⟩),
  exact absurd (hx₀ x h) (not_le.mpr (lt_of_lt_of_le (lt_add_one x₀) hx)),
end

variables [order_topology 𝕜]

section polynomial_at_top

lemma is_equivalent_at_top_lead :
  (λ x, eval x P) ~[at_top] (λ x, P.leading_coeff * x ^ P.nat_degree) :=
begin
  by_cases h : P = 0,
  { simp [h] },
  { conv_lhs
    { funext,
      rw [polynomial.eval_eq_finset_sum, sum_range_succ] },
    exact is_equivalent.refl.add_is_o (is_o.sum $ λ i hi, is_o.const_mul_left
      (is_o.const_mul_right (λ hz, h $ leading_coeff_eq_zero.mp hz) $
        is_o_pow_pow_at_top_of_lt (mem_range.mp hi)) _) }
end

lemma tendsto_at_top_of_leading_coeff_nonneg (hdeg : 1 ≤ P.degree) (hnng : 0 ≤ P.leading_coeff) :
  tendsto (λ x, eval x P) at_top at_top :=
P.is_equivalent_at_top_lead.symm.tendsto_at_top
  (tendsto_const_mul_pow_at_top (le_nat_degree_of_coe_le_degree hdeg)
    (lt_of_le_of_ne hnng $ ne.symm $ mt leading_coeff_eq_zero.mp $ ne_zero_of_coe_le_degree hdeg))

lemma tendsto_at_top_iff_leading_coeff_nonneg :
  tendsto (λ x, eval x P) at_top at_top ↔ 1 ≤ P.degree ∧ 0 ≤ P.leading_coeff :=
begin
  refine ⟨λ h, _, λ h, tendsto_at_top_of_leading_coeff_nonneg P h.1 h.2⟩,
  have : tendsto (λ x, P.leading_coeff * x ^ P.nat_degree) at_top at_top :=
    is_equivalent.tendsto_at_top (is_equivalent_at_top_lead P) h,
  rw tendsto_const_mul_pow_at_top_iff P.leading_coeff P.nat_degree at this,
  rw [degree_eq_nat_degree (leading_coeff_ne_zero.mp (ne_of_lt this.2).symm), ← nat.cast_one],
  refine ⟨with_bot.coe_le_coe.mpr this.1, le_of_lt this.2⟩,
end

lemma tendsto_at_bot_of_leading_coeff_nonpos (hdeg : 1 ≤ P.degree) (hnps : P.leading_coeff ≤ 0) :
  tendsto (λ x, eval x P) at_top at_bot :=
P.is_equivalent_at_top_lead.symm.tendsto_at_bot
  (tendsto_neg_const_mul_pow_at_top (le_nat_degree_of_coe_le_degree hdeg)
    (lt_of_le_of_ne hnps $ mt leading_coeff_eq_zero.mp $ ne_zero_of_coe_le_degree hdeg))

lemma tendsto_at_bot_iff_leading_coeff_nonpos :
  tendsto (λ x, eval x P) at_top at_bot ↔ 1 ≤ P.degree ∧ P.leading_coeff ≤ 0 :=
begin
  refine ⟨λ h, _, λ h, tendsto_at_bot_of_leading_coeff_nonpos P h.1 h.2⟩,
  have : tendsto (λ x, P.leading_coeff * x ^ P.nat_degree) at_top at_bot :=
    (is_equivalent.tendsto_at_bot (is_equivalent_at_top_lead P) h),
  rw tendsto_neg_const_mul_pow_at_top_iff P.leading_coeff P.nat_degree at this,
  rw [degree_eq_nat_degree (leading_coeff_ne_zero.mp (ne_of_lt this.2)), ← nat.cast_one],
  refine ⟨with_bot.coe_le_coe.mpr this.1, le_of_lt this.2⟩,
end

lemma abs_tendsto_at_top (hdeg : 1 ≤ P.degree) :
  tendsto (λ x, abs $ eval x P) at_top at_top :=
begin
  by_cases hP : 0 ≤ P.leading_coeff,
  { exact tendsto_abs_at_top_at_top.comp (P.tendsto_at_top_of_leading_coeff_nonneg hdeg hP)},
  { push_neg at hP,
    exact tendsto_abs_at_bot_at_top.comp (P.tendsto_at_bot_of_leading_coeff_nonpos hdeg hP.le)}
end

lemma abs_is_bounded_under_iff :
  is_bounded_under (≤) at_top (λ x, |eval x P|) ↔ P.degree ≤ 0 :=
begin
  refine ⟨λ h, _, λ h, ⟨|P.coeff 0|, eventually_map.mpr (eventually_of_forall
    (forall_imp (λ _, le_of_eq) (λ x, congr_arg abs $ trans (congr_arg (eval x)
    (eq_C_of_degree_le_zero h)) (eval_C))))⟩⟩,
  contrapose! h,
  exact not_is_bounded_under_of_tendsto_at_top
    (abs_tendsto_at_top P (nat.with_bot.one_le_iff_zero_lt.2 h))
end

lemma abs_tendsto_at_top_iff :
  tendsto (λ x, abs $ eval x P) at_top at_top ↔ 1 ≤ P.degree :=
⟨λ h, nat.with_bot.one_le_iff_zero_lt.2 (not_le.mp ((mt (abs_is_bounded_under_iff P).mpr)
  (not_is_bounded_under_of_tendsto_at_top h))), abs_tendsto_at_top P⟩

lemma tendsto_nhds_iff {c : 𝕜} :
  tendsto (λ x, eval x P) at_top (𝓝 c) ↔ P.leading_coeff = c ∧ P.degree ≤ 0 :=
begin
  refine ⟨λ h, _, λ h, _⟩,
  { have := P.is_equivalent_at_top_lead.tendsto_nhds h,
    by_cases hP : P.leading_coeff = 0,
    { simp only [hP, zero_mul, tendsto_const_nhds_iff] at this,
      refine ⟨trans hP this, by simp [leading_coeff_eq_zero.1 hP]⟩ },
    { rw [tendsto_const_mul_pow_nhds_iff hP, nat_degree_eq_zero_iff_degree_le_zero] at this,
      exact this.symm } },
  { refine P.is_equivalent_at_top_lead.symm.tendsto_nhds _,
    have : P.nat_degree = 0 := nat_degree_eq_zero_iff_degree_le_zero.2 h.2,
    simp only [h.1, this, pow_zero, mul_one],
    exact tendsto_const_nhds }
end

end polynomial_at_top

section polynomial_div_at_top

lemma is_equivalent_at_top_div :
  (λ x, (eval x P)/(eval x Q)) ~[at_top]
    λ x, P.leading_coeff/Q.leading_coeff * x^(P.nat_degree - Q.nat_degree : ℤ) :=
begin
  by_cases hP : P = 0,
  { simp [hP] },
  by_cases hQ : Q = 0,
  { simp [hQ] },
  refine (P.is_equivalent_at_top_lead.symm.div
          Q.is_equivalent_at_top_lead.symm).symm.trans
         (eventually_eq.is_equivalent ((eventually_gt_at_top 0).mono $ λ x hx, _)),
  simp [← div_mul_div, hP, hQ, zpow_sub₀ hx.ne.symm]
end

lemma div_tendsto_zero_of_degree_lt (hdeg : P.degree < Q.degree) :
  tendsto (λ x, (eval x P)/(eval x Q)) at_top (𝓝 0) :=
begin
  by_cases hP : P = 0,
  { simp [hP, tendsto_const_nhds] },
  rw ←  nat_degree_lt_nat_degree_iff hP at hdeg,
  refine (is_equivalent_at_top_div P Q).symm.tendsto_nhds _,
  rw ← mul_zero,
  refine (tendsto_zpow_at_top_zero _).const_mul _,
  linarith
end

lemma div_tendsto_zero_iff_degree_lt (hQ : Q ≠ 0) :
  tendsto (λ x, (eval x P)/(eval x Q)) at_top (𝓝 0) ↔ P.degree < Q.degree :=
begin
  refine ⟨λ h, _, div_tendsto_zero_of_degree_lt P Q⟩,
  by_cases hPQ : P.leading_coeff / Q.leading_coeff = 0,
  { simp only [div_eq_mul_inv, inv_eq_zero, mul_eq_zero] at hPQ,
    cases hPQ with hP0 hQ0,
    { rw [leading_coeff_eq_zero.1 hP0, degree_zero],
      exact bot_lt_iff_ne_bot.2 (λ hQ', hQ (degree_eq_bot.1 hQ')) },
    { exact absurd (leading_coeff_eq_zero.1 hQ0) hQ } },
  { have := (is_equivalent_at_top_div P Q).tendsto_nhds h,
    rw tendsto_const_mul_zpow_at_top_zero_iff hPQ at this,
    cases this with h h,
    { exact absurd h.2 hPQ },
    { rw [sub_lt_iff_lt_add, zero_add, int.coe_nat_lt] at h,
      exact degree_lt_degree h.1 } }
end

lemma div_tendsto_leading_coeff_div_of_degree_eq (hdeg : P.degree = Q.degree) :
  tendsto (λ x, (eval x P)/(eval x Q)) at_top (𝓝 $ P.leading_coeff / Q.leading_coeff) :=
begin
  refine (is_equivalent_at_top_div P Q).symm.tendsto_nhds _,
  rw show (P.nat_degree : ℤ) = Q.nat_degree, by simp [hdeg, nat_degree],
  simp [tendsto_const_nhds]
end

lemma div_tendsto_at_top_of_degree_gt' (hdeg : Q.degree < P.degree)
  (hpos : 0 < P.leading_coeff/Q.leading_coeff) :
  tendsto (λ x, (eval x P)/(eval x Q)) at_top at_top :=
begin
  have hQ : Q ≠ 0 := λ h, by {simp only [h, div_zero, leading_coeff_zero] at hpos, linarith},
  rw ← nat_degree_lt_nat_degree_iff hQ at hdeg,
  refine (is_equivalent_at_top_div P Q).symm.tendsto_at_top _,
  apply tendsto.const_mul_at_top hpos,
  apply tendsto_zpow_at_top_at_top,
  linarith
end

lemma div_tendsto_at_top_of_degree_gt (hdeg : Q.degree < P.degree)
  (hQ : Q ≠ 0) (hnng : 0 ≤ P.leading_coeff/Q.leading_coeff) :
  tendsto (λ x, (eval x P)/(eval x Q)) at_top at_top :=
have ratio_pos : 0 < P.leading_coeff/Q.leading_coeff,
  from lt_of_le_of_ne hnng
    (div_ne_zero (λ h, ne_zero_of_degree_gt hdeg $ leading_coeff_eq_zero.mp h)
      (λ h, hQ $ leading_coeff_eq_zero.mp h)).symm,
div_tendsto_at_top_of_degree_gt' P Q hdeg ratio_pos

lemma div_tendsto_at_bot_of_degree_gt' (hdeg : Q.degree < P.degree)
  (hneg : P.leading_coeff/Q.leading_coeff < 0) :
  tendsto (λ x, (eval x P)/(eval x Q)) at_top at_bot :=
begin
  have hQ : Q ≠ 0 := λ h, by {simp only [h, div_zero, leading_coeff_zero] at hneg, linarith},
  rw ← nat_degree_lt_nat_degree_iff hQ at hdeg,
  refine (is_equivalent_at_top_div P Q).symm.tendsto_at_bot _,
  apply tendsto.neg_const_mul_at_top hneg,
  apply tendsto_zpow_at_top_at_top,
  linarith
end

lemma div_tendsto_at_bot_of_degree_gt (hdeg : Q.degree < P.degree)
  (hQ : Q ≠ 0) (hnps : P.leading_coeff/Q.leading_coeff ≤ 0) :
  tendsto (λ x, (eval x P)/(eval x Q)) at_top at_bot :=
have ratio_neg : P.leading_coeff/Q.leading_coeff < 0,
  from lt_of_le_of_ne hnps
    (div_ne_zero (λ h, ne_zero_of_degree_gt hdeg $ leading_coeff_eq_zero.mp h)
      (λ h, hQ $ leading_coeff_eq_zero.mp h)),
div_tendsto_at_bot_of_degree_gt' P Q hdeg ratio_neg

lemma abs_div_tendsto_at_top_of_degree_gt (hdeg : Q.degree < P.degree)
  (hQ : Q ≠ 0) :
  tendsto (λ x, |(eval x P)/(eval x Q)|) at_top at_top :=
begin
  by_cases h : 0 ≤ P.leading_coeff/Q.leading_coeff,
  { exact tendsto_abs_at_top_at_top.comp (P.div_tendsto_at_top_of_degree_gt Q hdeg hQ h) },
  { push_neg at h,
    exact tendsto_abs_at_bot_at_top.comp (P.div_tendsto_at_bot_of_degree_gt Q hdeg hQ h.le) }
end

end polynomial_div_at_top

theorem is_O_of_degree_le (h : P.degree ≤ Q.degree) :
  is_O (λ x, eval x P) (λ x, eval x Q) filter.at_top :=
begin
  by_cases hp : P = 0,
  { simpa [hp] using is_O_zero (λ x, eval x Q) filter.at_top },
  { have hq : Q ≠ 0 := ne_zero_of_degree_ge_degree h hp,
    have hPQ : ∀ᶠ (x : 𝕜) in at_top, eval x Q = 0 → eval x P = 0 :=
      filter.mem_of_superset (polynomial.eventually_no_roots Q hq) (λ x h h', absurd h' h),
    cases le_iff_lt_or_eq.mp h with h h,
    { exact is_O_of_div_tendsto_nhds hPQ 0 (div_tendsto_zero_of_degree_lt P Q h) },
    { exact is_O_of_div_tendsto_nhds hPQ _ (div_tendsto_leading_coeff_div_of_degree_eq P Q h) } }
end

end polynomial


-- Limite_de_sucesiones_constantes.lean
-- Límite de sucesiones constantes.
-- José A. Alonso Jiménez
-- Sevilla, 11 de julio de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- En Lean, una sucesión u₀, u₁, u₂, ... se puede representar mediante
-- una función (u : ℕ → ℝ) de forma que u(n) es uₙ.
--
-- Se define que a es el límite de la sucesión u, por
--    def limite : (ℕ → ℝ) → ℝ → Prop :=
--    λ u a, ∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - a| < ε
-- donde se usa la notación |x| para el valor absoluto de x
--    notation `|`x`|` := abs x
--
-- Demostrar que el límite de la sucesión constante c es c.
-- ---------------------------------------------------------------------

import data.real.basic

variable (u : ℕ → ℝ)
variable (c : ℝ)

notation `|`x`|` := abs x

def limite : (ℕ → ℝ) → ℝ → Prop :=
λ u a, ∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - a| < ε

-- 1ª demostración
-- ===============

example :
  limite (λ n, c) c :=
begin
  unfold limite,
  intros ε hε,
  use 0,
  intros n hn,
  dsimp,
  simp,
  exact hε,
end

-- 2ª demostración
-- ===============

example :
  limite (λ n, c) c :=
begin
  intros ε hε,
  use 0,
  rintro n -,
  norm_num,
  assumption,
end

-- 3ª demostración
-- ===============

example :
  limite (λ n, c) c :=
begin
  intros ε hε,
  use 0,
  intros n hn,
  calc |(λ n, c) n - c|
       = |c - c|  : rfl
   ... = 0        : by simp
   ... < ε        : hε
end

-- 4ª demostración
-- ===============

example :
  limite (λ n, c) c :=
begin
  intros ε hε,
  by finish,
end

-- 5ª demostración
-- ===============

example :
  limite (λ n, c) c :=
λ ε hε, by finish

-- 6ª demostración
-- ===============

example :
  limite (λ n, c) c :=
assume ε,
assume hε : ε > 0,
exists.intro 0
  ( assume n,
    assume hn : n ≥ 0,
    show |(λ n, c) n - c| < ε, from
      calc |(λ n, c) n - c|
           = |c - c|  : rfl
       ... = 0        : by simp
       ... < ε        : hε)


/-
Copyright (c) 2018 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Isometries of emetric and metric spaces
Authors: Sébastien Gouëzel
-/
import topology.metric_space.antilipschitz

/-!
# Isometries

We define isometries, i.e., maps between emetric spaces that preserve
the edistance (on metric spaces, these are exactly the maps that preserve distances),
and prove their basic properties. We also introduce isometric bijections.

Since a lot of elementary properties don't require `eq_of_dist_eq_zero` we start setting up the
theory for `pseudo_metric_space` and we specialize to `metric_space` when needed.
-/

noncomputable theory

universes u v w
variables {α : Type u} {β : Type v} {γ : Type w}

open function set
open_locale topological_space

/-- An isometry (also known as isometric embedding) is a map preserving the edistance
between pseudoemetric spaces, or equivalently the distance between pseudometric space.  -/
def isometry [pseudo_emetric_space α] [pseudo_emetric_space β] (f : α → β) : Prop :=
∀x1 x2 : α, edist (f x1) (f x2) = edist x1 x2

/-- On pseudometric spaces, a map is an isometry if and only if it preserves distances. -/
lemma isometry_emetric_iff_metric [pseudo_metric_space α] [pseudo_metric_space β] {f : α → β} :
  isometry f ↔ (∀x y, dist (f x) (f y) = dist x y) :=
⟨assume H x y, by simp [dist_edist, H x y],
assume H x y, by simp [edist_dist, H x y]⟩

/-- An isometry preserves edistances. -/
theorem isometry.edist_eq [pseudo_emetric_space α] [pseudo_emetric_space β] {f : α → β}
  (hf : isometry f) (x y : α) : edist (f x) (f y) = edist x y :=
hf x y

/-- An isometry preserves distances. -/
theorem isometry.dist_eq [pseudo_metric_space α] [pseudo_metric_space β] {f : α → β}
  (hf : isometry f) (x y : α) : dist (f x) (f y) = dist x y :=
by rw [dist_edist, dist_edist, hf]

section pseudo_emetric_isometry

variables [pseudo_emetric_space α] [pseudo_emetric_space β] [pseudo_emetric_space γ]
variables {f : α → β} {x y z : α}  {s : set α}

lemma isometry.lipschitz (h : isometry f) : lipschitz_with 1 f :=
lipschitz_with.of_edist_le $ λ x y, le_of_eq (h x y)

lemma isometry.antilipschitz (h : isometry f) : antilipschitz_with 1 f :=
λ x y, by simp only [h x y, ennreal.coe_one, one_mul, le_refl]

/-- An isometry from an emetric space is injective -/
lemma isometry.injective {α : Type u} [emetric_space α] {f : α → β} (h : isometry f) :
  injective f := h.antilipschitz.injective

/-- Any map on a subsingleton is an isometry -/
theorem isometry_subsingleton [subsingleton α] : isometry f :=
λx y, by rw subsingleton.elim x y; simp

/-- The identity is an isometry -/
lemma isometry_id : isometry (id : α → α) :=
λx y, rfl

/-- The composition of isometries is an isometry -/
theorem isometry.comp {g : β → γ} {f : α → β} (hg : isometry g) (hf : isometry f) :
  isometry (g ∘ f) :=
assume x y, calc
  edist ((g ∘ f) x) ((g ∘ f) y) = edist (f x) (f y) : hg _ _
                            ... = edist x y : hf _ _

/-- An isometry from a metric space is a uniform inducing map -/
theorem isometry.uniform_inducing (hf : isometry f) :
  uniform_inducing f :=
hf.antilipschitz.uniform_inducing hf.lipschitz.uniform_continuous

/-- An isometry is continuous. -/
lemma isometry.continuous (hf : isometry f) : continuous f :=
hf.lipschitz.continuous

/-- The right inverse of an isometry is an isometry. -/
lemma isometry.right_inv {f : α → β} {g : β → α} (h : isometry f) (hg : right_inverse g f) :
  isometry g :=
λ x y, by rw [← h, hg _, hg _]

/-- Isometries preserve the diameter in pseudoemetric spaces. -/
lemma isometry.ediam_image (hf : isometry f) (s : set α) :
  emetric.diam (f '' s) = emetric.diam s :=
eq_of_forall_ge_iff $ λ d,
by simp only [emetric.diam_le_iff, ball_image_iff, hf.edist_eq]

lemma isometry.ediam_range (hf : isometry f) :
  emetric.diam (range f) = emetric.diam (univ : set α) :=
by { rw ← image_univ, exact hf.ediam_image univ }

/-- The injection from a subtype is an isometry -/
lemma isometry_subtype_coe {s : set α} : isometry (coe : s → α) :=
λx y, rfl

lemma isometry.comp_continuous_on_iff {γ} [topological_space γ] (hf : isometry f) {g : γ → α}
  {s : set γ} :
  continuous_on (f ∘ g) s ↔ continuous_on g s :=
hf.uniform_inducing.inducing.continuous_on_iff.symm

lemma isometry.comp_continuous_iff {γ} [topological_space γ] (hf : isometry f) {g : γ → α} :
  continuous (f ∘ g) ↔ continuous g :=
hf.uniform_inducing.inducing.continuous_iff.symm

end pseudo_emetric_isometry --section

section emetric_isometry
variables [emetric_space α]

/-- An isometry from a metric space is a uniform embedding -/
theorem isometry.uniform_embedding [pseudo_emetric_space β] {f : α → β} (hf : isometry f) :
  uniform_embedding f :=
hf.antilipschitz.uniform_embedding hf.lipschitz.uniform_continuous

/-- An isometry from a metric space is an embedding -/
theorem isometry.embedding [pseudo_emetric_space β] {f : α → β} (hf : isometry f) :
  embedding f :=
hf.uniform_embedding.embedding

/-- An isometry from a complete emetric space is a closed embedding -/
theorem isometry.closed_embedding [complete_space α] [emetric_space β]
  {f : α → β} (hf : isometry f) : closed_embedding f :=
hf.antilipschitz.closed_embedding hf.lipschitz.uniform_continuous

lemma isometry.tendsto_nhds_iff [emetric_space β] {ι : Type*} {f : α → β}
  {g : ι → α} {a : filter ι} {b : α} (hf : isometry f) :
  filter.tendsto g a (𝓝 b) ↔ filter.tendsto (f ∘ g) a (𝓝 (f b)) :=
hf.embedding.tendsto_nhds_iff

end emetric_isometry --section

/-- An isometry preserves the diameter in pseudometric spaces. -/
lemma isometry.diam_image [pseudo_metric_space α] [pseudo_metric_space β]
  {f : α → β} (hf : isometry f) (s : set α) : metric.diam (f '' s) = metric.diam s :=
by rw [metric.diam, metric.diam, hf.ediam_image]

lemma isometry.diam_range [pseudo_metric_space α] [pseudo_metric_space β] {f : α → β}
  (hf : isometry f) : metric.diam (range f) = metric.diam (univ : set α) :=
by { rw ← image_univ, exact hf.diam_image univ }

/-- `α` and `β` are isometric if there is an isometric bijection between them. -/
@[nolint has_inhabited_instance] -- such a bijection need not exist
structure isometric (α : Type*) (β : Type*) [pseudo_emetric_space α] [pseudo_emetric_space β]
  extends α ≃ β :=
(isometry_to_fun  : isometry to_fun)

infix ` ≃ᵢ `:25 := isometric

namespace isometric

section pseudo_emetric_space
variables [pseudo_emetric_space α] [pseudo_emetric_space β] [pseudo_emetric_space γ]

instance : has_coe_to_fun (α ≃ᵢ β) (λ _, α → β) := ⟨λe, e.to_equiv⟩

lemma coe_eq_to_equiv (h : α ≃ᵢ β) (a : α) : h a = h.to_equiv a := rfl

@[simp] lemma coe_to_equiv (h : α ≃ᵢ β) : ⇑h.to_equiv = h := rfl

protected lemma isometry (h : α ≃ᵢ β) : isometry h := h.isometry_to_fun

protected lemma bijective (h : α ≃ᵢ β) : bijective h := h.to_equiv.bijective
protected lemma injective (h : α ≃ᵢ β) : injective h := h.to_equiv.injective
protected lemma surjective (h : α ≃ᵢ β) : surjective h := h.to_equiv.surjective

protected lemma edist_eq (h : α ≃ᵢ β) (x y : α) : edist (h x) (h y) = edist x y :=
h.isometry.edist_eq x y

protected lemma dist_eq {α β : Type*} [pseudo_metric_space α] [pseudo_metric_space β] (h : α ≃ᵢ β)
  (x y : α) : dist (h x) (h y) = dist x y :=
h.isometry.dist_eq x y

protected lemma continuous (h : α ≃ᵢ β) : continuous h := h.isometry.continuous

@[simp] lemma ediam_image (h : α ≃ᵢ β) (s : set α) : emetric.diam (h '' s) = emetric.diam s :=
h.isometry.ediam_image s

lemma to_equiv_inj : ∀ ⦃h₁ h₂ : α ≃ᵢ β⦄, (h₁.to_equiv = h₂.to_equiv) → h₁ = h₂
| ⟨e₁, h₁⟩ ⟨e₂, h₂⟩ H := by { dsimp at H, subst e₁ }

@[ext] lemma ext ⦃h₁ h₂ : α ≃ᵢ β⦄ (H : ∀ x, h₁ x = h₂ x) : h₁ = h₂ :=
to_equiv_inj $ equiv.ext H

/-- Alternative constructor for isometric bijections,
taking as input an isometry, and a right inverse. -/
def mk' {α : Type u} [emetric_space α] (f : α → β) (g : β → α) (hfg : ∀ x, f (g x) = x)
  (hf : isometry f) : α ≃ᵢ β :=
{ to_fun := f,
  inv_fun := g,
  left_inv := λ x, hf.injective $ hfg _,
  right_inv := hfg,
  isometry_to_fun := hf }

/-- The identity isometry of a space. -/
protected def refl (α : Type*) [pseudo_emetric_space α] : α ≃ᵢ α :=
{ isometry_to_fun := isometry_id, .. equiv.refl α }

/-- The composition of two isometric isomorphisms, as an isometric isomorphism. -/
protected def trans (h₁ : α ≃ᵢ β) (h₂ : β ≃ᵢ γ) : α ≃ᵢ γ :=
{ isometry_to_fun  := h₂.isometry_to_fun.comp h₁.isometry_to_fun,
  .. equiv.trans h₁.to_equiv h₂.to_equiv }

@[simp] lemma trans_apply (h₁ : α ≃ᵢ β) (h₂ : β ≃ᵢ γ) (x : α) : h₁.trans h₂ x = h₂ (h₁ x) := rfl

/-- The inverse of an isometric isomorphism, as an isometric isomorphism. -/
protected def symm (h : α ≃ᵢ β) : β ≃ᵢ α :=
{ isometry_to_fun  := h.isometry.right_inv h.right_inv,
  to_equiv := h.to_equiv.symm }

/-- See Note [custom simps projection]. We need to specify this projection explicitly in this case,
  because it is a composition of multiple projections. -/
def simps.apply (h : α ≃ᵢ β) : α → β := h
/-- See Note [custom simps projection] -/
def simps.symm_apply (h : α ≃ᵢ β) : β → α := h.symm

initialize_simps_projections isometric
  (to_equiv_to_fun → apply, to_equiv_inv_fun → symm_apply)

@[simp] lemma symm_symm (h : α ≃ᵢ β) : h.symm.symm = h := to_equiv_inj h.to_equiv.symm_symm

@[simp] lemma apply_symm_apply (h : α ≃ᵢ β) (y : β) : h (h.symm y) = y :=
h.to_equiv.apply_symm_apply y

@[simp] lemma symm_apply_apply (h : α ≃ᵢ β) (x : α) : h.symm (h x) = x :=
h.to_equiv.symm_apply_apply x

lemma symm_apply_eq (h : α ≃ᵢ β) {x : α} {y : β} :
  h.symm y = x ↔ y = h x :=
h.to_equiv.symm_apply_eq

lemma eq_symm_apply (h : α ≃ᵢ β) {x : α} {y : β} :
  x = h.symm y ↔ h x = y :=
h.to_equiv.eq_symm_apply

lemma symm_comp_self (h : α ≃ᵢ β) : ⇑h.symm ∘ ⇑h = id :=
funext $ assume a, h.to_equiv.left_inv a

lemma self_comp_symm (h : α ≃ᵢ β) : ⇑h ∘ ⇑h.symm = id :=
funext $ assume a, h.to_equiv.right_inv a

@[simp] lemma range_eq_univ (h : α ≃ᵢ β) : range h = univ :=
h.to_equiv.range_eq_univ

lemma image_symm (h : α ≃ᵢ β) : image h.symm = preimage h :=
image_eq_preimage_of_inverse h.symm.to_equiv.left_inv h.symm.to_equiv.right_inv

lemma preimage_symm (h : α ≃ᵢ β) : preimage h.symm = image h :=
(image_eq_preimage_of_inverse h.to_equiv.left_inv h.to_equiv.right_inv).symm

@[simp] lemma symm_trans_apply (h₁ : α ≃ᵢ β) (h₂ : β ≃ᵢ γ) (x : γ) :
  (h₁.trans h₂).symm x = h₁.symm (h₂.symm x) := rfl

lemma ediam_univ (h : α ≃ᵢ β) : emetric.diam (univ : set α) = emetric.diam (univ : set β) :=
by rw [← h.range_eq_univ, h.isometry.ediam_range]

@[simp] lemma ediam_preimage (h : α ≃ᵢ β) (s : set β) : emetric.diam (h ⁻¹' s) = emetric.diam s :=
by rw [← image_symm, ediam_image]

/-- The (bundled) homeomorphism associated to an isometric isomorphism. -/
@[simps to_equiv] protected def to_homeomorph (h : α ≃ᵢ β) : α ≃ₜ β :=
{ continuous_to_fun  := h.continuous,
  continuous_inv_fun := h.symm.continuous,
  to_equiv := h.to_equiv }

@[simp] lemma coe_to_homeomorph (h : α ≃ᵢ β) : ⇑(h.to_homeomorph) = h := rfl

@[simp] lemma coe_to_homeomorph_symm (h : α ≃ᵢ β) : ⇑(h.to_homeomorph.symm) = h.symm := rfl

@[simp] lemma comp_continuous_on_iff {γ} [topological_space γ] (h : α ≃ᵢ β)
  {f : γ → α} {s : set γ} :
  continuous_on (h ∘ f) s ↔ continuous_on f s :=
h.to_homeomorph.comp_continuous_on_iff _ _

@[simp] lemma comp_continuous_iff {γ} [topological_space γ] (h : α ≃ᵢ β) {f : γ → α} :
  continuous (h ∘ f) ↔ continuous f :=
h.to_homeomorph.comp_continuous_iff

@[simp] lemma comp_continuous_iff' {γ} [topological_space γ] (h : α ≃ᵢ β) {f : β → γ} :
  continuous (f ∘ h) ↔ continuous f :=
h.to_homeomorph.comp_continuous_iff'

/-- The group of isometries. -/
instance : group (α ≃ᵢ α) :=
  { one := isometric.refl _,
    mul := λ e₁ e₂, e₂.trans e₁,
    inv := isometric.symm,
    mul_assoc := λ e₁ e₂ e₃, rfl,
    one_mul := λ e, ext $ λ _, rfl,
    mul_one := λ e, ext $ λ _, rfl,
    mul_left_inv := λ e, ext e.symm_apply_apply }

@[simp] lemma coe_one : ⇑(1 : α ≃ᵢ α) = id := rfl

@[simp] lemma coe_mul (e₁ e₂ : α ≃ᵢ α) : ⇑(e₁ * e₂) = e₁ ∘ e₂ := rfl

lemma mul_apply (e₁ e₂ : α ≃ᵢ α) (x : α) : (e₁ * e₂) x = e₁ (e₂ x) := rfl

@[simp] lemma inv_apply_self (e : α ≃ᵢ α) (x: α) : e⁻¹ (e x) = x := e.symm_apply_apply x

@[simp] lemma apply_inv_self (e : α ≃ᵢ α) (x: α) : e (e⁻¹ x) = x := e.apply_symm_apply x

protected lemma complete_space [complete_space β] (e : α ≃ᵢ β) : complete_space α :=
complete_space_of_is_complete_univ $ is_complete_of_complete_image e.isometry.uniform_inducing $
  by rwa [set.image_univ, isometric.range_eq_univ, ← complete_space_iff_is_complete_univ]

lemma complete_space_iff (e : α ≃ᵢ β) : complete_space α ↔ complete_space β :=
by { split; introI H, exacts [e.symm.complete_space, e.complete_space] }

end pseudo_emetric_space

section pseudo_metric_space

variables [pseudo_metric_space α] [pseudo_metric_space β] (h : α ≃ᵢ β)

@[simp] lemma diam_image (s : set α) : metric.diam (h '' s) = metric.diam s :=
h.isometry.diam_image s

@[simp] lemma diam_preimage (s : set β) : metric.diam (h ⁻¹' s) = metric.diam s :=
by rw [← image_symm, diam_image]

lemma diam_univ : metric.diam (univ : set α) = metric.diam (univ : set β) :=
congr_arg ennreal.to_real h.ediam_univ

end pseudo_metric_space

end isometric

/-- An isometry induces an isometric isomorphism between the source space and the
range of the isometry. -/
@[simps to_equiv apply { simp_rhs := tt }]
def isometry.isometric_on_range [emetric_space α] [pseudo_emetric_space β] {f : α → β}
  (h : isometry f) : α ≃ᵢ range f :=
{ isometry_to_fun := λx y, by simpa [subtype.edist_eq] using h x y,
  to_equiv := equiv.of_injective f h.injective }