-- Unicidad del límite de las sucesiones convergentes
-- ==================================================

import data.real.basic

variables (u : ℕ → ℝ)
variables (a b x y : ℝ)

-- ----------------------------------------------------
-- Nota. Se usarán las siguientes notaciones,
-- definiciones y lemas estudiados anteriormente:
-- + |x| = abs x
-- + limite u c :
--      ∀ ε > 0, ∃ N, ∀ n ≥ N, |u n - c| ≤ ε
-- + cero_de_abs_mn_todos:
--      (∀ ε > 0, |x| ≤ ε) → x = 0
-- + ig_de_abs_sub_mne_todos:
--      (∀ ε > 0, |x - y| ≤ ε) → x = y
-- ----------------------------------------------------

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

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

lemma cero_de_abs_mn_todos
  (h : ∀ ε > 0, |x| ≤ ε)
  : x = 0 :=
abs_eq_zero.mp
  (eq_of_le_of_forall_le_of_dense (abs_nonneg x) h)

lemma ig_de_abs_sub_mne_todos
  (h : ∀ ε > 0, |x - y| ≤ ε)
  : x = y :=
sub_eq_zero.mp (cero_de_abs_mn_todos (x - y) h)

-- ----------------------------------------------------
-- Ejercicio. Demostrar que cada sucesión tiene como
-- máximo un límite.
-- ----------------------------------------------------

-- 1ª demostración
example
  (ha : limite u a)
  (hb : limite u b)
  : a = b :=
begin
  apply ig_de_abs_sub_mne_todos,
  intros ε hε,
  cases ha (ε/2) (half_pos hε) with Na hNa,
  cases hb (ε/2) (half_pos hε) with Nb hNb,
  let N := max Na Nb,
  clear ha hb,
  specialize hNa N (le_max_left  _ _),
  specialize hNb N (le_max_right  _ _),
  calc |a - b|
       = |(a - u N) + (u N - b)| : by ring
   ... ≤ |a - u N| + |u N - b|   : by apply abs_add
   ... = |u N - a| + |u N - b|   : by rw abs_sub
   ... ≤ ε/2 + ε/2               : add_le_add hNa hNb
   ... = ε                       : add_halves ε
end

-- 2ª demostración
lemma unicidad_limite
  (ha : limite u a)
  (hb : limite u b)
  : a = b :=
begin
  apply ig_de_abs_sub_mne_todos,
  intros ε hε,
  cases ha (ε/2) (by linarith) with Na hNa,
  cases hb (ε/2) (by linarith) with Nb hNb,
  let N := max Na Nb,
  specialize hNa N (by finish),
  specialize hNb N (by finish),
  calc |a - b|
       = |(a - u N) + (u N - b)| : by ring
   ... ≤ |a - u N| + |u N - b|   : by apply abs_add
   ... = |u N - a| + |u N - b|   : by rw abs_sub
   ... ≤ ε                       : by linarith [hNa, hNb]
end

-- 3ª demostración
example
  (ha : limite u a)
  (hb : limite u b)
  : a = b :=
begin
  by_contradiction H,
  change a ≠ b at H,
  have h1 : |a - b| > 0,
    exact abs_pos.mpr (sub_ne_zero_of_ne H),
  cases ha (|a - b|/4) (by linarith) with N hN,
  cases hb (|a - b|/4) (by linarith) with N' hN',
  let N₀ := max N N',
  specialize hN N₀ (le_max_left _ _),
  specialize hN' N₀ (le_max_right _ _),
  have h2 : |a - b| < |a - b |,
    calc  |a - b| = |(a - u N₀) + (u N₀ - b)| : by ring
    ... ≤ |a - u N₀| + |u N₀ - b|             : by apply abs_add
    ... = |u N₀ - a| + |u N₀ - b|             : by rw abs_sub
    ... < |a - b|                             : by linarith,
  linarith,
end


def Nat.bit (b : Bool) (n : Nat) : Nat :=
  cond b (2*n+1) (2*n)

theorem Nat.bit_div_even (h : n % 2 = 0) : bit false (n / 2) = n := by
  simp [bit]
  have := Nat.div_add_mod n 2
  simp [h] at this
  assumption

theorem Nat.bit_div_odd (h : n % 2 ≠ 0) : bit true (n / 2) = n := by
  have h : n % 2 = 1 := by
    have := mod_lt n (by decide : 2 > 0)
    revert h this
    generalize n%2 = k
    match k with
    | 0   => decide
    | 1   => decide
    | n+2 => intros; contradiction
  simp [bit]
  have := Nat.div_add_mod n 2
  simp [h] at this
  assumption

theorem Nat.div2_lt (h : n ≠ 0) : n / 2 < n := by
  match n with
  | 1   => decide
  | 2   => decide
  | 3   => decide
  | n+4 =>
    rw [div_eq, if_pos]
    refine succ_lt_succ (Nat.lt_trans ?_ (lt_succ_self _))
    exact @div2_lt (n+2) (by simp_arith)
    simp_arith

@[specialize]
def Nat.binrec
    (motive : Nat → Sort u)
    (base : Unit → motive 0)
    (ind  : (b : Bool) → (n : Nat) → (Unit → motive n) → motive (bit b n))
    (n : Nat) : motive n :=
  if h₁ : n = 0 then
    h₁ ▸ base ()
  else if h₂ : n % 2 = 0 then
    bit_div_even h₂ ▸ ind false (n / 2) (fun _ => binrec motive base ind (n / 2))
  else
    bit_div_odd h₂ ▸ ind true  (n / 2) (fun _ => binrec motive base ind (n / 2))
termination_by _ n => n
decreasing_by exact Nat.div2_lt h₁

theorem Nat.binind
    (motive : Nat → Prop)
    (base : motive 0)
    (ind  : (b : Bool) → (n : Nat) → motive n → motive (bit b n))
    (n : Nat) : motive n :=
 binrec motive (fun _ => base) (fun b n ih => ind b n (ih ())) n

set_option trace.compiler.ir.result true in
def Nat.toBit (n : Nat) : List Bool :=
  binrec (fun _ => List Bool)
    (fun _ => [])
    (fun b n ih => b :: ih ())
    n

#eval Nat.toBit 18


-- Pruebas de desarrollo de producto de sumas
-- ==========================================

-- ------------------------------------------------------
-- Ej. 1. Sean a, b, c y d números enteros. Demostrar que
--    (a + b) * (c + d) = a * c + b * c + a * d + b * d
-- ------------------------------------------------------

import tactic
import data.int.basic

variables a b c d : ℤ

-- 1ª demostración
example : (a + b) * (c + d) = a * c + b * c + a * d + b * d :=
calc
  (a + b) * (c + d)
      = (a + b) * c + (a + b) * d         : by rw left_distrib
  ... = (a * c + b * c) + (a + b) * d     : by rw right_distrib
  ... = (a * c + b * c) + (a * d + b * d) : by rw right_distrib
  ... = a * c + b * c + a * d + b * d     : by rw ←add_assoc

-- 2ª demostración
example : (a + b) * (c + d) = a * c + b * c + a * d + b * d :=
by rw [left_distrib, right_distrib, right_distrib, ←add_assoc]

-- 3ª demostración
example : (a + b) * (c + d) = a * c + b * c + a * d + b * d :=
begin
  rw left_distrib,
  rw right_distrib,
  rw right_distrib,
  rw ←add_assoc,
end

-- 4ª demostración
example : (a + b) * (c + d) = a * c + b * c + a * d + b * d :=
calc
  (a + b) * (c + d)
      = (a + b) * c + (a + b) * d         : by rw mul_add
  ... = (a * c + b * c) + (a + b) * d     : by rw add_mul
  ... = (a * c + b * c) + (a * d + b * d) : by rw add_mul
  ... = a * c + b * c + a * d + b * d     : by rw ←add_assoc

-- 5ª demostración
example : (a + b) * (c + d) = a * c + b * c + a * d + b * d :=
-- by hint
by linarith

-- 6ª demostración
example : (a + b) * (c + d) = a * c + b * c + a * d + b * d :=
by nlinarith

-- 7ª demostración
example : (a + b) * (c + d) = a * c + b * c + a * d + b * d :=
by ring


-- ---------------------------------------------------------------------
-- Ejercicio. Importar la teoría de las propiedades de los subconjuntos
-- de espacios topológicos.
-- ---------------------------------------------------------------------

import topology.subset_properties

-- ---------------------------------------------------------------------
-- Ejercicio. Declarar
-- + X e Y como variables sobre espacios topológicos
-- + f como variable de funciones de X en Y.
-- ---------------------------------------------------------------------

variables (X Y : Type) [topological_space X] [topological_space Y]
variable  (f : X → Y)

-- ---------------------------------------------------------------------
-- Ejercicio. Abrir las teorías filter y set.
-- ---------------------------------------------------------------------

open filter set

-- ---------------------------------------------------------------------
-- Ejercicio. Abrir localmente las teorías filter (para 𝓟) y
-- topological_space (para 𝓝).
-- ---------------------------------------------------------------------

open_locale filter
open_locale topological_space

-- =====================================================================
-- § Filtros de entornos                                              --
-- =====================================================================

-- Si `α` es un espacio topológico y `a : α` entonces `𝓝 a` es el
-- siguiente filtro sobre `α`: `X ∈ 𝓝 a` si y sólo si `X` contiene un
-- entorno abierto de `a` o, equivalentemente, si `a` está en el
-- interior de `X`. Hay que pensar en `𝓝 a` como el "subconjunto
-- generalizado" de `X` correspondiente a un entorno abierto
-- infinitesimal `a`.
--
-- Utilizaremos la API de interior y clausura, y comprobaremos que `𝓝 a`
-- es un filtro.
--
-- Los siguientes lemas de los espacios topológicos serán utiles:
-- + interior_univ {α : Type u} [topological_space α] :
--      interior univ = univ
-- + mem_univ {α : Type u} (x : α) :
--      x ∈ univ
-- + interior_mono {α : Type u} [topological_space α] {s t : set α} (h : s ⊆ t) :
--     interior s ⊆ interior t
-- + interior_inter {α : Type u} [topological_space α] {s t : set α} :
--     interior (s ∩ t) = interior s ∩ interior t

-- ---------------------------------------------------------------------
-- Ejercicio. Declarar α como una variable sobre espacios topológicos.
-- ---------------------------------------------------------------------

variables {α : Type*} [topological_space α]

-- ---------------------------------------------------------------------
-- Ejercicio. Abrir el espacio de nombre de conjuntos.
-- ---------------------------------------------------------------------

open set

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que el conjunto de los entornos abiertos de un
-- punto a (en mathlib se denota por `𝓝 a`) es un filtro.
-- ---------------------------------------------------------------------

-- Demostración. Sea a un punto. El conjunto de los entornos abiertos de
-- a es
--    F = {X : set α | a ∈ interior X}.
-- Veamos que F cumple los axiomas de filtro.
--
-- (1º axioma) univ ∈ F, ya que a ∈ univ = interior(univ).
--
-- (2º axioma): Sean X ∈ F y X ⊆ Y. Entonces,
--    a ∈ interior(X) ⊆ interior(Y)
-- Luego, a ∈ interior(Y) y Y ∈ F.
--
-- (3º axioma): Sean X, Y ∈ F. Entonces,
--    a ∈ interior(X) y a ∈ interior(Y)
--    ⟹ a ∈ interior(X) ∩ interior(Y) = interior(X ∩ Y)
-- Por tanto, X ∩ Y ∈ F.

example (a : α): filter α :=
{ sets := {X : set α | a ∈ interior X},
  univ_sets :=
  begin
    rw mem_set_of_eq,
    rw interior_univ,
    exact mem_univ a,
  end,
  sets_of_superset :=
  begin
    intros X Y haX hXY,
    rw mem_set_of_eq at *,
    exact interior_mono hXY haX,
  end,
  inter_sets :=
  begin
    intros X Y hX hY,
    rw mem_set_of_eq at *,
    rw interior_inter,
    exact ⟨hX, hY⟩
  end }

-- =====================================================================
-- § Puntos de acumulación                                            --
-- =====================================================================

-- Un punto de acumulación `a : α` de un filtro `F : filter α` en un
-- espacio topológico debe pensarse como un punto en la clausura del
-- "conjunto generalizado" correspondiente a `F`. Esta es la definición
-- formal.
--
-- Un punto de acumulación de un filtro `F : filter α` (también conocido
-- como punto límite) es `x : α` tal que `𝓝 x ⊓ F ≠ ⊥`. La imagen es que
-- la intersección del conjunto generalizado `F` y el entorno abierto
-- `𝓝 x` de `x` tienen intersección no vacía. Sin embargo, repasemos la
-- notación con más cuidado. Recordemos que el orden de los filtros es
-- al revés, por lo que `𝓝 x ⊓ F` significa el filtro generado por `F` y
-- los entornos de `x`, y `⊥` es el filtro que contiene cada
-- subconjunto. Así que esto se reduce a decir que no existen conjuntos
-- `A ∈ 𝓝 x` y `B ∈ F` tales que `A ∩ B = ∅`, o, en otras palabras, cada
-- elemento del filtro intersecta todos los entornos de `x`. Por
-- ejemplo, si `S` es un subconjunto cualquiera de `α`, entonces los
-- puntos de acumulación de `𝓟 S` son los puntos `x` tales que cualquier
-- conjunto abierto que contiene a `x` se encuentra con `S`, o lo que es
-- lo mismo, que `x` está en la cierre de `S`.
--
-- El siguiente lema (que se llama `cluster_pt.mono` en mathlib) afirma
-- que si `F` y `G` son subconjuntos generalizados de un espacio
-- topológico y `F ⊆ G`, entonces `clausura(F) ⊆ clausura(G)`.

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si x es un punto de acumulación del filtro F
-- y F ≤ G, entonces x es un punto de acumulación del filtro G.
-- ---------------------------------------------------------------------

-- 1ª demostración. Sea `U ∈ 𝓝 x` y `V ∈ G`. Entonces, `V ∈ F` (porque
-- `F ≤ G`) y `U ∩ V ≠ ∅` (porque `x` es un punto de acumulación de
-- `F`). Por tanto, `x` es un punto de acumulación de `G`.

example
  {x : α}
  {F G : filter α}
  (hxF : cluster_pt x F)
  (hFG : F ≤ G)
  : cluster_pt x G :=
begin
  rw cluster_pt_iff at *,
  intros,
  apply hxF hU,
  rw filter.le_def at hFG,
  apply hFG _ hV,
end

-- 2ª demostración. Se tiene
--    𝓝 x ⊓ F ≠ ⊥          [porque x es un punto de acumulación de F]
--    𝓝 x ⊓ F ≤ 𝓝 x ⊓ G    [porque F ≤ G]
--    𝓝 x ⊓ G ≠ ⊥          [por los dos anteriores]
-- Por tanto, x es un punto de acumulación de G.

example
  {x : α}
  {F G : filter α}
  (hxF : cluster_pt x F)
  (hFG : F ≤ G)
  : cluster_pt x G :=
begin
  unfold cluster_pt,
  apply ne_bot_of_le_ne_bot hxF,
  exact inf_le_inf_left _ hFG,
end

-- 3ª demostración
example
  {x : α}
  {F G : filter α}
  (hxF : cluster_pt x F)
  (hFG : F ≤ G)
  : cluster_pt x G :=
-- by library_search
cluster_pt.mono hxF hFG

-- =====================================================================
-- § Compacidad                                                       --
-- =====================================================================

-- La definición actual de `is_compact` en mathlib dice que un
-- subconjunto `S` de un espacio topológico espacio `α` es *compacto` si
-- para cada filtro `F ≠ ⊥` tal que `S ∈ F` existe `a : α` tal que cada
-- conjunto de `F` comparte elementos con cada entorno de `a`. En otras
-- palabras, `S` es compacto si el cierre de cada subconjunto
-- generalizado no vacío `F ⊆ S` contiene algún elemento de `S`. De
-- alguna manera, la no compacidad da lugar a subconjuntos generalizados
-- que están "en el límite de `S`" pero que no intersectan un entorno de
-- elementos de "S". Tal vez sea mejor no preocuparse por esta exótica
-- definición. Por supuesto es equivalente a la definición habitual de
-- compacidad, pero no vamos a demostrarlo.
--
-- Vamos a volver a probar que un subconjunto cerrado de un espacio
-- compacto es compacto. Como antes, demostramos la afirmación más
-- general de que si `α` es cualquier espacio topológico, la
-- intersección de un subconjunto compacto de `α` y un subconjunto
-- cerrado de `α` es un subconjunto compacto de `α`.
--
-- Esta es la definición en mathlib:
--    def is_compact (s : set α) := ∀ ⦃f⦄ [ne_bot f], f ≤ 𝓟 s → ∃a∈s, cluster_pt a f
--
-- Nótese que `ne_bot f` está entre corchetes, lo que significa que el
-- sistema de inferencia de tipos lo deduce.
--
-- Una sugerencia para una prueba es primero mostrar que por la
-- compacidad de `S`, podemos encontrar un punto de acumulación `a` para
-- `f` en `s` y después demostrar que este punto de acumulación está en
-- `t` también, porque "t" es cerrado.

-- Algunos lemas útiles son:
-- + is_closed.closure_eq
--     {α : Type u} [topological_space α]
--     {s : set α}
--     (h : is_closed s)
--     : closure s = s
-- + mem_closure_iff_cluster_pt
--     {α : Type u} [topological_space α]
--     {s : set α}
--     {a : α}
--     : a ∈ closure s ↔ cluster_pt a (𝓟 s)

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que la intersección de un compacto s con un
-- cerrado (t) es un compacto (s ∩ t).
-- ---------------------------------------------------------------------

-- Demostración. Sea `f` un filtro tal que `f ≠ ⊥` y `f ≤ 𝓟 (s ∩ t)`.
-- Tenemos que demostrar que existe `a ∈ s ∩ t` que es un punto de
-- acumulación de `f`.
--
-- De `f ≤ 𝓟 (s ∩ t)` se sigue que `f ≤ 𝓟 s` y, por ser `s`  compacto,
-- existe `a ∈ s` que es un punto de acumulación de `f`. Pra concluir la
-- demostración, basta demostrar que `a ∈ t` (ya que entonces
-- `a ∈ s ∩ t`). Su demostración es
--    s ∩ t ⊆ s
--    ⟹ 𝓟 (s ∩ t) ≤ 𝓟 t
--           [por principal_mono]
--    ⟹ f ≤ 𝓟 t
--           [porque f ≤ 𝓟 (s ∩ t)]
--    ⟹ a es un punto de acumulación de 𝓟 t
--           [por cluster_pt.mono y serlo de f]
--    ⟹ a ∈ clausura(t)
--           [por mem_closure_iff_cluster_pt]
--    ⟹ a ∈ t
--           [por closure_eq_iff_is_closed.mpr y ser t cerrado]
--

lemma closed_of_compact
  (s : set X)
  (hs : is_compact s)
  (t : set X)
  (ht : is_closed t)
  : is_compact (s ∩ t) :=
begin
  unfold is_compact,
  intros f hnf hstf,
  haveI := hnf,
  obtain ⟨a, has, ha⟩ : ∃ a ∈ s, cluster_pt a f,
  { unfold is_compact at hs,
    apply hs,
    apply le_trans hstf,
    rw principal_mono,
    apply inter_subset_left },
  have hat : a ∈ t,
  { rw ← closure_eq_iff_is_closed.mpr ht,
    rw mem_closure_iff_cluster_pt,
    apply cluster_pt.mono ha,
    refine le_trans hstf _,
    rw principal_mono,
    apply inter_subset_right },
  exact ⟨a, ⟨has, hat⟩, ha⟩
end


/-
Copyright (c) 2021 Heather Macbeth. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Heather Macbeth
-/
import analysis.complex.circle
import analysis.inner_product_space.l2_space
import measure_theory.function.continuous_map_dense
import measure_theory.function.l2_space
import measure_theory.measure.haar
import measure_theory.group.integration
import topology.metric_space.emetric_paracompact
import topology.continuous_function.stone_weierstrass

/-!

# Fourier analysis on the circle

This file contains basic results on Fourier series.

## Main definitions

* `haar_circle`, Haar measure on the circle, normalized to have total measure `1`
* instances `measure_space`, `is_probability_measure` for the circle with respect to this measure
* for `n : ℤ`, `fourier n` is the monomial `λ z, z ^ n`, bundled as a continuous map from `circle`
  to `ℂ`
* for `n : ℤ` and `p : ℝ≥0∞`, `fourier_Lp p n` is an abbreviation for the monomial `fourier n`
  considered as an element of the Lᵖ-space `Lp ℂ p haar_circle`, via the embedding
  `continuous_map.to_Lp`
* `fourier_series` is the canonical isometric isomorphism from `Lp ℂ 2 haar_circle` to `ℓ²(ℤ, ℂ)`
  induced by taking Fourier series

## Main statements

The theorem `span_fourier_closure_eq_top` states that the span of the monomials `fourier n` is
dense in `C(circle, ℂ)`, i.e. that its `submodule.topological_closure` is `⊤`.  This follows from
the Stone-Weierstrass theorem after checking that it is a subalgebra, closed under conjugation, and
separates points.

The theorem `span_fourier_Lp_closure_eq_top` states that for `1 ≤ p < ∞` the span of the monomials
`fourier_Lp` is dense in `Lp ℂ p haar_circle`, i.e. that its `submodule.topological_closure` is
`⊤`.  This follows from the previous theorem using general theory on approximation of Lᵖ functions
by continuous functions.

The theorem `orthonormal_fourier` states that the monomials `fourier_Lp 2 n` form an orthonormal
set (in the L² space of the circle).

The last two results together provide that the functions `fourier_Lp 2 n` form a Hilbert basis for
L²; this is named as `fourier_series`.

Parseval's identity, `tsum_sq_fourier_series_repr`, is a direct consequence of the construction of
this Hilbert basis.
-/

noncomputable theory
open_locale ennreal complex_conjugate classical
open topological_space continuous_map measure_theory measure_theory.measure algebra submodule set

/-! ### Choice of measure on the circle -/

section haar_circle
/-! We make the circle into a measure space, using the Haar measure normalized to have total
measure 1. -/

instance : measurable_space circle := borel circle
instance : borel_space circle := ⟨rfl⟩

/-- Haar measure on the circle, normalized to have total measure 1. -/
@[derive is_haar_measure]
def haar_circle : measure circle := haar_measure ⊤

instance : is_probability_measure haar_circle := ⟨haar_measure_self⟩

instance : measure_space circle :=
{ volume := haar_circle,
  .. circle.measurable_space }

end haar_circle

/-! ### Monomials on the circle -/

section monomials

/-- The family of monomials `λ z, z ^ n`, parametrized by `n : ℤ` and considered as bundled
continuous maps from `circle` to `ℂ`. -/
@[simps] def fourier (n : ℤ) : C(circle, ℂ) :=
{ to_fun := λ z, z ^ n,
  continuous_to_fun := continuous_subtype_coe.zpow₀ n $ λ z, or.inl (ne_zero_of_mem_circle z) }

@[simp] lemma fourier_zero {z : circle} : fourier 0 z = 1 := rfl

@[simp] lemma fourier_neg {n : ℤ} {z : circle} : fourier (-n) z = conj (fourier n z) :=
by simp [← coe_inv_circle_eq_conj z]

@[simp] lemma fourier_add {m n : ℤ} {z : circle} :
  fourier (m + n) z = (fourier m z) * (fourier n z) :=
by simp [zpow_add₀ (ne_zero_of_mem_circle z)]

/-- The subalgebra of `C(circle, ℂ)` generated by `z ^ n` for `n ∈ ℤ`; equivalently, polynomials in
`z` and `conj z`. -/
def fourier_subalgebra : subalgebra ℂ C(circle, ℂ) := algebra.adjoin ℂ (range fourier)

/-- The subalgebra of `C(circle, ℂ)` generated by `z ^ n` for `n ∈ ℤ` is in fact the linear span of
these functions. -/
lemma fourier_subalgebra_coe : fourier_subalgebra.to_submodule = span ℂ (range fourier) :=
begin
  apply adjoin_eq_span_of_subset,
  refine subset.trans _ submodule.subset_span,
  intros x hx,
  apply submonoid.closure_induction hx (λ _, id) ⟨0, rfl⟩,
  rintros _ _ ⟨m, rfl⟩ ⟨n, rfl⟩,
  refine ⟨m + n, _⟩,
  ext1 z,
  exact fourier_add,
end

/-- The subalgebra of `C(circle, ℂ)` generated by `z ^ n` for `n ∈ ℤ` separates points. -/
lemma fourier_subalgebra_separates_points : fourier_subalgebra.separates_points :=
begin
  intros x y hxy,
  refine ⟨_, ⟨fourier 1, _, rfl⟩, _⟩,
  { exact subset_adjoin ⟨1, rfl⟩ },
  { simp [hxy] }
end

/-- The subalgebra of `C(circle, ℂ)` generated by `z ^ n` for `n ∈ ℤ` is invariant under complex
conjugation. -/
lemma fourier_subalgebra_conj_invariant :
  conj_invariant_subalgebra (fourier_subalgebra.restrict_scalars ℝ) :=
begin
  rintros _ ⟨f, hf, rfl⟩,
  change _ ∈ fourier_subalgebra,
  change _ ∈ fourier_subalgebra at hf,
  apply adjoin_induction hf,
  { rintros _ ⟨n, rfl⟩,
    suffices : fourier (-n) ∈ fourier_subalgebra,
    { convert this,
      ext1,
      simp },
    exact subset_adjoin ⟨-n, rfl⟩ },
  { intros c,
    exact fourier_subalgebra.algebra_map_mem (conj c) },
  { intros f g hf hg,
    convert fourier_subalgebra.add_mem hf hg,
    exact alg_hom.map_add _ f g, },
  { intros f g hf hg,
    convert fourier_subalgebra.mul_mem hf hg,
    exact alg_hom.map_mul _ f g, }
end

/-- The subalgebra of `C(circle, ℂ)` generated by `z ^ n` for `n ∈ ℤ` is dense. -/
lemma fourier_subalgebra_closure_eq_top : fourier_subalgebra.topological_closure = ⊤ :=
continuous_map.subalgebra_complex_topological_closure_eq_top_of_separates_points
  fourier_subalgebra
  fourier_subalgebra_separates_points
  fourier_subalgebra_conj_invariant

/-- The linear span of the monomials `z ^ n` is dense in `C(circle, ℂ)`. -/
lemma span_fourier_closure_eq_top : (span ℂ (range fourier)).topological_closure = ⊤ :=
begin
  rw ← fourier_subalgebra_coe,
  exact congr_arg subalgebra.to_submodule fourier_subalgebra_closure_eq_top,
end

/-- The family of monomials `λ z, z ^ n`, parametrized by `n : ℤ` and considered as elements of
the `Lp` space of functions on `circle` taking values in `ℂ`. -/
abbreviation fourier_Lp (p : ℝ≥0∞) [fact (1 ≤ p)] (n : ℤ) : Lp ℂ p haar_circle :=
to_Lp p haar_circle ℂ (fourier n)

lemma coe_fn_fourier_Lp (p : ℝ≥0∞) [fact (1 ≤ p)] (n : ℤ) :
  ⇑(fourier_Lp p n) =ᵐ[haar_circle] fourier n :=
coe_fn_to_Lp haar_circle (fourier n)

/-- For each `1 ≤ p < ∞`, the linear span of the monomials `z ^ n` is dense in
`Lp ℂ p haar_circle`. -/
lemma span_fourier_Lp_closure_eq_top {p : ℝ≥0∞} [fact (1 ≤ p)] (hp : p ≠ ∞) :
  (span ℂ (range (fourier_Lp p))).topological_closure = ⊤ :=
begin
  convert (continuous_map.to_Lp_dense_range ℂ hp haar_circle ℂ).topological_closure_map_submodule
    span_fourier_closure_eq_top,
  rw [map_span, range_comp],
  simp
end

/-- For `n ≠ 0`, a rotation by `n⁻¹ * real.pi` negates the monomial `z ^ n`. -/
lemma fourier_add_half_inv_index {n : ℤ} (hn : n ≠ 0) (z : circle) :
  fourier n ((exp_map_circle (n⁻¹ * real.pi) * z)) = - fourier n z :=
begin
  have : ↑n * ((↑n)⁻¹ * ↑real.pi * complex.I) = ↑real.pi * complex.I,
  { have : (n:ℂ) ≠ 0 := by exact_mod_cast hn,
    field_simp,
    ring },
  simp [mul_zpow₀, ← complex.exp_int_mul, complex.exp_pi_mul_I, this]
end

/-- The monomials `z ^ n` are an orthonormal set with respect to Haar measure on the circle. -/
lemma orthonormal_fourier : orthonormal ℂ (fourier_Lp 2) :=
begin
  rw orthonormal_iff_ite,
  intros i j,
  rw continuous_map.inner_to_Lp haar_circle (fourier i) (fourier j),
  split_ifs,
  { simp [h, is_probability_measure.measure_univ, ← fourier_neg, ← fourier_add, -fourier_to_fun] },
  simp only [← fourier_add, ← fourier_neg],
  have hij : -i + j ≠ 0,
  { rw add_comm,
    exact sub_ne_zero.mpr (ne.symm h) },
  exact integral_eq_zero_of_mul_left_eq_neg (fourier_add_half_inv_index hij)
end

end monomials

section fourier

/-- We define `fourier_series` to be a `ℤ`-indexed Hilbert basis for `Lp ℂ 2 haar_circle`, which by
definition is an isometric isomorphism from `Lp ℂ 2 haar_circle` to `ℓ²(ℤ, ℂ)`. -/
def fourier_series : hilbert_basis ℤ ℂ (Lp ℂ 2 haar_circle) :=
hilbert_basis.mk orthonormal_fourier (span_fourier_Lp_closure_eq_top (by norm_num))

/-- The elements of the Hilbert basis `fourier_series` for `Lp ℂ 2 haar_circle` are the functions
`fourier_Lp 2`, the monomials `λ z, z ^ n` on the circle considered as elements of `L2`. -/
@[simp] lemma coe_fourier_series : ⇑fourier_series = fourier_Lp 2 := hilbert_basis.coe_mk _ _

/-- Under the isometric isomorphism `fourier_series` from `Lp ℂ 2 haar_circle` to `ℓ²(ℤ, ℂ)`, the
`i`-th coefficient is the integral over the circle of `λ t, t ^ (-i) * f t`. -/
lemma fourier_series_repr (f : Lp ℂ 2 haar_circle) (i : ℤ) :
  fourier_series.repr f i = ∫ t : circle, t ^ (-i) * f t ∂ haar_circle :=
begin
  transitivity ∫ t : circle, conj ((fourier_Lp 2 i : circle → ℂ) t) * f t ∂ haar_circle,
  { simp [fourier_series.repr_apply_apply f i, measure_theory.L2.inner_def] },
  apply integral_congr_ae,
  filter_upwards [coe_fn_fourier_Lp 2 i] with _ ht,
  rw [ht, ← fourier_neg],
  simp [-fourier_neg]
end

/-- The Fourier series of an `L2` function `f` sums to `f`, in the `L2` topology on the circle. -/
lemma has_sum_fourier_series (f : Lp ℂ 2 haar_circle) :
  has_sum (λ i, fourier_series.repr f i • fourier_Lp 2 i) f :=
by simpa using hilbert_basis.has_sum_repr fourier_series f

/-- **Parseval's identity**: the sum of the squared norms of the Fourier coefficients equals the
`L2` norm of the function. -/
lemma tsum_sq_fourier_series_repr (f : Lp ℂ 2 haar_circle) :
  ∑' i : ℤ, ∥fourier_series.repr f i∥ ^ 2 = ∫ t : circle, ∥f t∥ ^ 2 ∂ haar_circle :=
begin
  have H₁ : ∥fourier_series.repr f∥ ^ 2 = ∑' i, ∥fourier_series.repr f i∥ ^ 2,
  { exact_mod_cast lp.norm_rpow_eq_tsum _ (fourier_series.repr f),
    norm_num },
  have H₂ : ∥fourier_series.repr f∥ ^ 2 = ∥f∥ ^2 := by simp,
  have H₃ := congr_arg is_R_or_C.re (@L2.inner_def circle ℂ ℂ _ _ _ _ f f),
  rw ← integral_re at H₃,
  { simp only [← norm_sq_eq_inner] at H₃,
    rw [← H₁, H₂],
    exact H₃ },
  { exact L2.integrable_inner f f },
end

end fourier


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

/-! # Spectral theory of hermitian matrices

This file proves the spectral theorem for matrices. The proof of the spectral theorem is based on
the spectral theorem for linear maps (`diagonalization_basis_apply_self_apply`).

## Tags

spectral theorem, diagonalization theorem

-/

namespace matrix

variables {𝕜 : Type*} [is_R_or_C 𝕜] [decidable_eq 𝕜] {n : Type*} [fintype n] [decidable_eq n]
variables {A : matrix n n 𝕜}

open_locale matrix
open_locale big_operators

namespace is_hermitian

variables (hA : A.is_hermitian)

/-- The eigenvalues of a hermitian matrix, indexed by `fin (fintype.card n)` where `n` is the index
type of the matrix. -/
noncomputable def eigenvalues₀ : fin (fintype.card n) → ℝ :=
(is_hermitian_iff_is_symmetric.1 hA).eigenvalues finrank_euclidean_space

/-- The eigenvalues of a hermitian matrix, reusing the index `n` of the matrix entries. -/
noncomputable def eigenvalues : n → ℝ :=
λ i, hA.eigenvalues₀ $ (fintype.equiv_of_card_eq (fintype.card_fin _)).symm i

/-- A choice of an orthonormal basis of eigenvectors of a hermitian matrix. -/
noncomputable def eigenvector_basis : orthonormal_basis n 𝕜 (euclidean_space 𝕜 n) :=
((is_hermitian_iff_is_symmetric.1 hA).eigenvector_basis finrank_euclidean_space).reindex
  (fintype.equiv_of_card_eq (fintype.card_fin _))

/-- A matrix whose columns are an orthonormal basis of eigenvectors of a hermitian matrix. -/
noncomputable def eigenvector_matrix : matrix n n 𝕜 :=
(pi_Lp.basis_fun _ 𝕜 n).to_matrix (eigenvector_basis hA).to_basis

/-- The inverse of `eigenvector_matrix` -/
noncomputable def eigenvector_matrix_inv : matrix n n 𝕜 :=
(eigenvector_basis hA).to_basis.to_matrix (pi_Lp.basis_fun _ 𝕜 n)

lemma eigenvector_matrix_mul_inv :
  hA.eigenvector_matrix ⬝ hA.eigenvector_matrix_inv = 1 :=
by apply basis.to_matrix_mul_to_matrix_flip

noncomputable instance : invertible hA.eigenvector_matrix_inv :=
invertible_of_left_inverse _ _ hA.eigenvector_matrix_mul_inv

noncomputable instance : invertible hA.eigenvector_matrix :=
invertible_of_right_inverse _ _ hA.eigenvector_matrix_mul_inv

lemma eigenvector_matrix_apply (i j : n) : hA.eigenvector_matrix i j = hA.eigenvector_basis j i :=
by simp_rw [eigenvector_matrix, basis.to_matrix_apply, orthonormal_basis.coe_to_basis,
    pi_Lp.basis_fun_repr]

lemma eigenvector_matrix_inv_apply (i j : n) :
  hA.eigenvector_matrix_inv i j = star (hA.eigenvector_basis i j) :=
begin
  rw [eigenvector_matrix_inv, basis.to_matrix_apply, orthonormal_basis.coe_to_basis_repr_apply,
    orthonormal_basis.repr_apply_apply, pi_Lp.basis_fun_apply, pi_Lp.equiv_symm_single,
    euclidean_space.inner_single_right, one_mul, is_R_or_C.star_def],
end

lemma conj_transpose_eigenvector_matrix_inv : hA.eigenvector_matrix_invᴴ = hA.eigenvector_matrix :=
by { ext i j,
  rw [conj_transpose_apply, eigenvector_matrix_inv_apply, eigenvector_matrix_apply, star_star] }

lemma conj_transpose_eigenvector_matrix : hA.eigenvector_matrixᴴ = hA.eigenvector_matrix_inv :=
by rw [← conj_transpose_eigenvector_matrix_inv, conj_transpose_conj_transpose]

/-- *Diagonalization theorem*, *spectral theorem* for matrices; A hermitian matrix can be
diagonalized by a change of basis.

For the spectral theorem on linear maps, see `diagonalization_basis_apply_self_apply`. -/
theorem spectral_theorem :
  hA.eigenvector_matrix_inv ⬝ A =
    diagonal (coe ∘ hA.eigenvalues) ⬝ hA.eigenvector_matrix_inv :=
begin
  rw [eigenvector_matrix_inv, pi_Lp.basis_to_matrix_basis_fun_mul],
  ext i j,
  have := is_hermitian_iff_is_symmetric.1 hA,
  convert this.diagonalization_basis_apply_self_apply finrank_euclidean_space
    (euclidean_space.single j 1)
    ((fintype.equiv_of_card_eq (fintype.card_fin _)).symm i) using 1,
  { dsimp only [euclidean_space.single, to_euclidean_lin_pi_Lp_equiv_symm, to_lin'_apply,
      matrix.of_apply, is_hermitian.eigenvector_basis],
    simp_rw [mul_vec_single, mul_one, orthonormal_basis.coe_to_basis_repr_apply,
      orthonormal_basis.repr_reindex],
    refl },
  { simp only [diagonal_mul, (∘), eigenvalues],
    rw [eigenvector_basis, basis.to_matrix_apply,
      orthonormal_basis.coe_to_basis_repr_apply, orthonormal_basis.repr_reindex,
      eigenvalues₀, pi_Lp.basis_fun_apply, pi_Lp.equiv_symm_single] }
end

lemma eigenvalues_eq (i : n) :
  hA.eigenvalues i =
    is_R_or_C.re ((star (hA.eigenvector_matrixᵀ i) ⬝ᵥ (A.mul_vec (hA.eigenvector_matrixᵀ i)))) :=
begin
  have := hA.spectral_theorem,
  rw [←matrix.mul_inv_eq_iff_eq_mul_of_invertible] at this,
  have := congr_arg is_R_or_C.re (congr_fun (congr_fun this i) i),
  rw [diagonal_apply_eq, is_R_or_C.of_real_re, inv_eq_left_inv hA.eigenvector_matrix_mul_inv,
    ← conj_transpose_eigenvector_matrix, mul_mul_apply] at this,
  exact this.symm,
end

/-- The determinant of a hermitian matrix is the product of its eigenvalues. -/
lemma det_eq_prod_eigenvalues : det A = ∏ i, hA.eigenvalues i :=
begin
  apply mul_left_cancel₀ (det_ne_zero_of_left_inverse (eigenvector_matrix_mul_inv hA)),
  rw [←det_mul, spectral_theorem, det_mul, mul_comm, det_diagonal]
end

end is_hermitian

end matrix


-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que el rango de la función exponencial es el
-- conjunto de los números positivos,
-- ----------------------------------------------------------------------

import analysis.special_functions.exp_log

open set real

example : range exp = { y | y > 0 } :=
begin
  ext y,
  split,
  { rintros ⟨x, rfl⟩,
    apply exp_pos },
  { intro ypos,
    use log y,
    rw exp_log ypos },
end

-- Prueba
-- ======

/-
⊢ range exp = {y : ℝ | y > 0}
  >> ext y,
y : ℝ
⊢ y ∈ range exp ↔ y ∈ {y : ℝ | y > 0}
  >> split,
| y : ℝ
| ⊢ y ∈ range exp ↔ y ∈ {y : ℝ | y > 0}
|   >> { rintros ⟨x, rfl⟩
| x : ℝ
| ⊢ x.exp ∈ {y : ℝ | y > 0},
|   >>   apply exp_pos },
y : ℝ
⊢ y ∈ {y : ℝ | y > 0} → y ∈ range exp
  >> { intro ypos,
ypos : y ∈ {y : ℝ | y > 0}
⊢ y ∈ range exp
  >>   use log y,
⊢ y.log.exp = y
  >>   rw exp_log ypos },
⊢ y.log.exp = y
-/

-- Comentario: Se ha usado el lema
-- + exp_log : 0 < x → log (exp x) = x

variable (x : ℝ)
-- #check @exp_log x


import MyNat.Definition
import MyNat.Inequality -- le_iff_exists_add
import Mathlib.Tactic.Use -- use tactic
import AdditionWorld.Level2 -- add_assoc
import InequalityWorld.Level2 -- le_refl_mynat
import Mathlib.Init.Algebra.Order
namespace MyNat
open MyNat
/-!

# Inequality world.

## Level 5: `le_trans`

Another straightforward one.

## Lemma : le_trans
≤ is transitive. In other words, if `a ≤ b` and `b ≤ c` then `a ≤ c`.
-/
theorem le_trans (a b c : MyNat) (hab : a ≤ b) (hbc : b ≤ c) : a ≤ c := by
  cases hab with
  | _ d hd =>
    cases hbc with
    | _ e he =>
      use (d + e)
      rw [←add_assoc]
      rw [←hd]
      assumption

/-!
This proved that the natural numbers are a preorder.
-/

instance : Preorder MyNat :=
  ⟨le_refl_mynat, le_trans, lt⟩

/-!
Next up [Level 6](./Level6.lean.md)
-/


--import mynat.lt -- definition of <
import game.world10.level14 -- hide
namespace mynat -- hide
/-

# Inequality world.

## Level 15: introducing `<`

To get the remaining collectibles in this world, we need to
give a definition of `<`. By default, the definition of `a < b`
in Lean, once `≤` is defined, is this:

`a < b := a ≤ b ∧ ¬ (b ≤ a)`

. But a much more usable definition would be this:

`a < b := succ(a) ≤ b`

. Let's prove that these two definitions are the same
-/

/- Lemma :
For all naturals $a$ and $b$,
$$a\le b\land\lnot(b\le a)\implies\operatorname{succ}(a)\le b.$$
-/
lemma lt_aux_one (a b : mynat) : a ≤ b ∧ ¬ (b ≤ a) → succ a ≤ b :=
begin [nat_num_game]
  intro h,
  cases h with h1 h2,
  cases h1 with c hc,
  cases c with d,
    exfalso,
    rw add_zero at hc,
    apply h2,
    rw hc,
    refl,
  use d,
  rw hc,
  rw add_succ,
  rw succ_add,
  refl,

end

end mynat -- hide


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

import linear_algebra.free_module.finite.basic
import linear_algebra.matrix.charpoly.coeff
import field_theory.minpoly

/-!

# Characteristic polynomial

We define the characteristic polynomial of `f : M →ₗ[R] M`, where `M` is a finite and
free `R`-module. The proof that `f.charpoly` is the characteristic polynomial of the matrix of `f`
in any basis is in `linear_algebra/charpoly/to_matrix`.

## Main definition

* `linear_map.charpoly f` : the characteristic polynomial of `f : M →ₗ[R] M`.

-/

universes u v w

variables {R : Type u} {M : Type v} [comm_ring R] [nontrivial R]
variables [add_comm_group M] [module R M] [module.free R M] [module.finite R M] (f : M →ₗ[R] M)

open_locale classical matrix polynomial

noncomputable theory

open module.free polynomial matrix

namespace linear_map

section basic

/-- The characteristic polynomial of `f : M →ₗ[R] M`. -/
def charpoly : R[X] :=
(to_matrix (choose_basis R M) (choose_basis R M) f).charpoly

lemma charpoly_def :
  f.charpoly = (to_matrix (choose_basis R M) (choose_basis R M) f).charpoly := rfl

end basic

section coeff

lemma charpoly_monic : f.charpoly.monic := charpoly_monic _

end coeff

section cayley_hamilton

/-- The **Cayley-Hamilton Theorem**, that the characteristic polynomial of a linear map, applied
to the linear map itself, is zero.

See `matrix.aeval_self_charpoly` for the equivalent statement about matrices. -/
lemma aeval_self_charpoly : aeval f f.charpoly = 0 :=
begin
  apply (linear_equiv.map_eq_zero_iff (alg_equiv_matrix _).to_linear_equiv).1,
  rw [alg_equiv.to_linear_equiv_apply, ← alg_equiv.coe_alg_hom,
    ← polynomial.aeval_alg_hom_apply _ _ _, charpoly_def],
  exact aeval_self_charpoly _,
end

lemma is_integral : is_integral R f := ⟨f.charpoly, ⟨charpoly_monic f, aeval_self_charpoly f⟩⟩

lemma minpoly_dvd_charpoly {K : Type u} {M : Type v} [field K] [add_comm_group M] [module K M]
  [finite_dimensional K M] (f : M →ₗ[K] M) : minpoly K f ∣ f.charpoly :=
minpoly.dvd _ _ (aeval_self_charpoly f)

/-- Any endomorphism polynomial `p` is equivalent under evaluation to `p %ₘ f.charpoly`; that is,
`p` is equivalent to a polynomial with degree less than the dimension of the module. -/
lemma aeval_eq_aeval_mod_charpoly (p : R[X]) : aeval f p = aeval f (p %ₘ f.charpoly) :=
(aeval_mod_by_monic_eq_self_of_root f.charpoly_monic f.aeval_self_charpoly).symm

/-- Any endomorphism power can be computed as the sum of endomorphism powers less than the
dimension of the module. -/
lemma pow_eq_aeval_mod_charpoly (k : ℕ) : f^k = aeval f (X^k %ₘ f.charpoly) :=
by rw [←aeval_eq_aeval_mod_charpoly, map_pow, aeval_X]

variable {f}

lemma minpoly_coeff_zero_of_injective (hf : function.injective f) : (minpoly R f).coeff 0 ≠ 0 :=
begin
  intro h,
  obtain ⟨P, hP⟩ := X_dvd_iff.2 h,
  have hdegP : P.degree < (minpoly R f).degree,
  { rw [hP, mul_comm],
    refine degree_lt_degree_mul_X (λ h, _),
    rw [h, mul_zero] at hP,
    exact minpoly.ne_zero (is_integral f) hP },
  have hPmonic : P.monic,
  { suffices : (minpoly R f).monic,
    { rwa [monic.def, hP, mul_comm, leading_coeff_mul_X, ← monic.def] at this },
    exact minpoly.monic (is_integral f) },
  have hzero : aeval f (minpoly R f) = 0 := minpoly.aeval _ _,
  simp only [hP, mul_eq_comp, ext_iff, hf, aeval_X, map_eq_zero_iff, coe_comp, alg_hom.map_mul,
    zero_apply] at hzero,
  exact not_le.2 hdegP (minpoly.min _ _ hPmonic (ext hzero)),
end

end cayley_hamilton

end linear_map


/-
Copyright (c) 2020 Fox Thomson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Fox Thomson
-/

import computability.DFA

/-!
# Nondeterministic Finite Automata
This file contains the definition of a Nondeterministic Finite Automaton (NFA), a state machine
which determines whether a string (implemented as a list over an arbitrary alphabet) is in a regular
set by evaluating the string over every possible path.
We show that DFA's are equivalent to NFA's however the construction from NFA to DFA uses an
exponential number of states.
Note that this definition allows for Automaton with infinite states, a `fintype` instance must be
supplied for true NFA's.
-/

universes u v

/-- An NFA is a set of states (`σ`), a transition function from state to state labelled by the
  alphabet (`step`), a starting state (`start`) and a set of acceptance states (`accept`).
  Note the transition function sends a state to a `set` of states. These are the states that it
  may be sent to. -/
structure NFA (α : Type u) (σ : Type v) :=
(step : σ → α → set σ)
(start : set σ)
(accept : set σ)

variables {α : Type u} {σ σ' : Type v} (M : NFA α σ)

namespace NFA

instance : inhabited (NFA α σ) := ⟨ NFA.mk (λ _ _, ∅) ∅ ∅ ⟩

/-- `M.step_set S a` is the union of `M.step s a` for all `s ∈ S`. -/
def step_set : set σ → α → set σ :=
λ Ss a, Ss >>= (λ S, (M.step S a))

/-- `M.eval_from S x` computes all possible paths though `M` with input `x` starting at an element
  of `S`. -/
def eval_from (start : set σ) : list α → set σ :=
list.foldl M.step_set start

/-- `M.eval x` computes all possible paths though `M` with input `x` starting at an element of
  `M.start`. -/
def eval := M.eval_from M.start

/-- `M.accepts` is the language of `x` such that there is an accept state in `M.eval x`. -/
def accepts : language α :=
λ x, ∃ S ∈ M.accept, S ∈ M.eval x

/-- `M.to_DFA` is an `DFA` constructed from a `NFA` `M` using the subset construction. The
  states is the type of `set`s of `M.state` and the step function is `M.step_set`. -/
def to_DFA : DFA α (set σ) :=
{ step := M.step_set,
  start := M.start,
  accept := {S | ∃ s ∈ S, s ∈ M.accept} }

@[simp] lemma to_DFA_correct :
  M.to_DFA.accepts = M.accepts :=
begin
  ext x,
  rw [accepts, DFA.accepts, eval, DFA.eval],
  change list.foldl _ _ _ ∈ {S | _} ↔ _,
  finish
end

lemma pumping_lemma [fintype σ] {x : list α} (hx : x ∈ M.accepts)
  (hlen : fintype.card (set σ) + 1 ≤ list.length x) :
  ∃ a b c, x = a ++ b ++ c ∧ a.length + b.length ≤ fintype.card (set σ) + 1 ∧ b ≠ [] ∧
  {a} * language.star {b} * {c} ≤ M.accepts :=
begin
  rw ←to_DFA_correct at hx ⊢,
  exact M.to_DFA.pumping_lemma hx hlen
end

end NFA

namespace DFA

/-- `M.to_NFA` is an `NFA` constructed from a `DFA` `M` by using the same start and accept
  states and a transition function which sends `s` with input `a` to the singleton `M.step s a`. -/
def to_NFA (M : DFA α σ') : NFA α σ' :=
{ step := λ s a, {M.step s a},
  start := {M.start},
  accept := M.accept }

@[simp] lemma to_NFA_eval_from_match (M : DFA α σ) (start : σ) (s : list α) :
  M.to_NFA.eval_from {start} s = {M.eval_from start s} :=
begin
  change list.foldl M.to_NFA.step_set {start} s = {list.foldl M.step start s},
  induction s with a s ih generalizing start,
  { tauto },
  { rw [list.foldl, list.foldl],
    have h : M.to_NFA.step_set {start} a = {M.step start a},
    { rw NFA.step_set,
      finish },
    rw h,
    tauto }
end

@[simp] lemma to_NFA_correct (M : DFA α σ) :
  M.to_NFA.accepts = M.accepts :=
begin
  ext x,
  change (∃ S H, S ∈ M.to_NFA.eval_from {M.start} x) ↔ _,
  rw to_NFA_eval_from_match,
  split,
  { rintro ⟨ S, hS₁, hS₂ ⟩,
    rw set.mem_singleton_iff at hS₂,
    rw hS₂ at hS₁,
    assumption },
  { intro h,
    use M.eval x,
    finish }
end

end DFA


/-
Copyright (c) 2021 Jon Eugster. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jon Eugster, Eric Wieser
-/
import algebra.char_p.basic
import ring_theory.localization.fraction_ring
import algebra.free_algebra

/-!
# Characteristics of algebras

In this file we describe the characteristic of `R`-algebras.

In particular we are interested in the characteristic of free algebras over `R`
and the fraction field `fraction_ring R`.

## Main results

- `char_p_of_injective_algebra_map` If `R →+* A` is an injective algebra map
  then `A` has the same characteristic as `R`.

Instances constructed from this result:
- Any `free_algebra R X` has the same characteristic as `R`.
- The `fraction_ring R` of an integral domain `R` has the same characteristic as `R`.

-/

/-- If the algebra map `R →+* A` is injective then `A` has the same characteristic as `R`. -/
lemma char_p_of_injective_algebra_map {R A : Type*} [comm_semiring R] [semiring A] [algebra R A]
  (h : function.injective (algebra_map R A)) (p : ℕ) [char_p R p] : char_p A p :=
{ cast_eq_zero_iff := λx,
  begin
    rw ←char_p.cast_eq_zero_iff R p x,
    change algebra_map ℕ A x = 0 ↔ algebra_map ℕ R x = 0,
    rw is_scalar_tower.algebra_map_apply ℕ R A x,
    refine iff.trans _ h.eq_iff,
    rw ring_hom.map_zero,
  end }

lemma char_p_of_injective_algebra_map' (R A : Type*) [field R] [semiring A] [algebra R A]
  [nontrivial A] (p : ℕ) [char_p R p] : char_p A p :=
char_p_of_injective_algebra_map (algebra_map R A).injective p

/-- If the algebra map `R →+* A` is injective and `R` has characteristic zero then so does `A`. -/
lemma char_zero_of_injective_algebra_map {R A : Type*} [comm_semiring R] [semiring A] [algebra R A]
  (h : function.injective (algebra_map R A)) [char_zero R] : char_zero A :=
{ cast_injective := λ x y hxy,
  begin
    change algebra_map ℕ A x = algebra_map ℕ A y at hxy,
    rw is_scalar_tower.algebra_map_apply ℕ R A x at hxy,
    rw is_scalar_tower.algebra_map_apply ℕ R A y at hxy,
    exact char_zero.cast_injective (h hxy),
  end }
-- `char_p.char_p_to_char_zero A _ (char_p_of_injective_algebra_map h 0)` does not work
-- here as it would require `ring A`.

section

variables (K L : Type*) [field K] [comm_semiring L] [nontrivial L] [algebra K L]

lemma algebra.char_p_iff (p : ℕ) : char_p K p ↔ char_p L p :=
(algebra_map K L).char_p_iff_char_p p

end

namespace free_algebra

variables {R X : Type*} [comm_semiring R] (p : ℕ)

/-- If `R` has characteristic `p`, then so does `free_algebra R X`. -/
instance char_p [char_p R p] : char_p (free_algebra R X) p :=
char_p_of_injective_algebra_map free_algebra.algebra_map_left_inverse.injective p

/-- If `R` has characteristic `0`, then so does `free_algebra R X`. -/
instance char_zero [char_zero R] : char_zero (free_algebra R X) :=
char_zero_of_injective_algebra_map free_algebra.algebra_map_left_inverse.injective

end free_algebra

namespace is_fraction_ring

variables (R : Type*) {K : Type*} [comm_ring R]
  [field K] [algebra R K] [is_fraction_ring R K]
variables (p : ℕ)

/-- If `R` has characteristic `p`, then so does Frac(R). -/

/-- If `R` has characteristic `0`, then so does Frac(R). -/
lemma char_zero_of_is_fraction_ring [char_zero R] : char_zero K :=
@char_p.char_p_to_char_zero K _ (char_p_of_is_fraction_ring R 0)

variables [is_domain R]

/-- If `R` has characteristic `p`, then so does `fraction_ring R`. -/
instance char_p [char_p R p] : char_p (fraction_ring R) p :=
char_p_of_is_fraction_ring R p

/-- If `R` has characteristic `0`, then so does `fraction_ring R`. -/
instance char_zero [char_zero R] : char_zero (fraction_ring R) :=
char_zero_of_is_fraction_ring R

end is_fraction_ring


/- LoVe Exercise 3: Structured Proofs and Proof Terms -/

import .lovelib

namespace LoVe

/- Question 1: Chain of Equalities -/

/- 1.1. Write the following proof using `calc`.

    (a + b) * (a + b)
    = a * (a + b) + b * (a + b)
    = a * a + a * b + b * a + b * b
    = a * a + a * b + a * b + b * b
    = a * a + 2 * a * b + b * b

Hint: You might need `rw`, `simp`, `ac_refl`, and the lemmas `mul_add`,
`add_mul`, and `two_mul`. -/

lemma binomial_square (a b : ℕ) :
  (a + b) * (a + b) = a * a + 2 * a * b + b * b :=
sorry

/- 1.2. Prove the same argument again, this time as a structured proof. Try to
reuse as much of the above proof idea as possible. -/

lemma binomial_square₂ (a b : ℕ) :
  (a + b) * (a + b) = a * a + 2 * a * b + b * b :=
sorry

/- 1.3 (**optional**). Prove the same lemma again, this time using tactics. -/

lemma binomial_square₃ (a b : ℕ) :
  (a + b) * (a + b) = a * a + 2 * a * b + b * b :=
begin
  sorry
end

/- Question 2: Connectives and Quantifiers -/

/- 2.1. Supply structured proofs of the following lemmas. -/

lemma I (a : Prop) :
  a → a :=
sorry

lemma K (a b : Prop) :
  a → b → b :=
sorry

lemma C (a b c : Prop) :
  (a → b → c) → b → a → c :=
sorry

lemma proj_1st (a : Prop) :
  a → a → a :=
sorry

-- please give a different answer than for `proj_1st`
lemma proj_2nd (a : Prop) :
  a → a → a :=
sorry

lemma some_nonsense (a b c : Prop) :
  (a → b → c) → a → (a → c) → b → c :=
sorry

/- 2.2. Supply a structured proof of the contraposition rule. -/

lemma contrapositive (a b : Prop) :
  (a → b) → ¬ b → ¬ a :=
sorry

end LoVe


/-
Given propositions P and Q, to prove P ↔ Q
requires a proof of P → Q and a proof of
Q → P. The introduction rule is iff.intro :
(P → Q) → (Q → P) → P ↔ Q.
-/

#check iff
#check @iff.intro

/-
structure iff (a b : Prop) : Prop :=
intro :: (mp : a → b) (mpr : b → a)
-/

/-
It's a special case of and. The elimination
rules are analogous, too. Remember reading
the next types that → is right associative.
-/

#check @iff.elim_left
#check @iff.elim_right

/-
Example. 1 = 1 ↔ 0 = 0.
-/

example : 1 = 1 ↔ 0 = 0 :=
iff.intro
  (λ _, rfl)   -- ⊢ 1 = 1 → 0 = 0
  (λ _, rfl)   -- ⊢ 0 = 0 → 1 = 1

/-
And so for the eliminators.
-/

#check @iff.elim_left
#check @iff.elim_right

/-
Show: ∀ (P Q : Prop), (P ↔ Q) → Q → P.
-/

example : ∀ (P Q : Prop), (P ↔ Q) → Q → P :=
λ P Q h q,
  -- use what you have to make what you need
  _

/-
General requirement to prove P ↔ Q is to
give proofs of P → Q and Q → P to ↔-intro.
That is, apply ↔-intro to a proof of P → Q
and a proof of Q → P. Thus:

iff.intro : (P → Q) → (Q → P) → (P ↔ Q)
iff.elim_left : (P ↔ Q) → (P → Q)
iff.elim_right : (P ↔ Q) → (Q → P)
-/

-- Exercise: Try it to test yourself.


-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que lo función logarítmica es inyectiva sobre
-- los números positivos.
-- ----------------------------------------------------------------------

import analysis.special_functions.exp_log

open set real

example : inj_on log { x | x > 0 } :=
begin
  intros x xpos y ypos,
  intro h,
  calc
    x   = exp (log x) : by rw exp_log xpos
    ... = exp (log y) : by rw h
    ... = y           : by rw exp_log ypos,
end

-- Prueba
-- ======

/-
⊢ inj_on log {x : ℝ | x > 0}
  >> intros x y xpos ypos,
x y : ℝ,
xpos : x ∈ {x : ℝ | x > 0},
ypos : y ∈ {x : ℝ | x > 0}
⊢ x.log = y.log → x = y
  >> intro h,
h : x.log = y.log
⊢ x = y
  >> calc
  >>   x   = exp (log x) : by rw exp_log xpos
  >>   ... = exp (log y) : by rw h
  >>   ... = y           : by rw exp_log ypos,
-/

-- Comentario: Se ha usado el lema
-- + exp_log : 0 < x → exp (log x) = x

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


-- this is a proof that ∀ vectors a, b ∈ ℤ³,
-- (a × b) ⬝ a = 0 ∧ (a × b) ⬝ b = 0

def dot: ℤ × ℤ × ℤ → ℤ × ℤ × ℤ → ℤ := λ ⟨a, b, c⟩ ⟨d, e, f⟩, a*d + b*e + c*f
def cross: ℤ × ℤ × ℤ → ℤ × ℤ × ℤ → ℤ × ℤ × ℤ := λ ⟨a, b, c⟩ ⟨d, e, f⟩, ⟨b*f - c*e, c*d - a*f, a*e - b*d⟩

variables m n p j k l : ℤ
#eval cross (124, 1294, 123) (156, 949, 29238499)
#reduce dot (cross (8, 1, 5) (2, 8, 9)) (2, 8, 9)
#reduce dot (cross (m, n, p) (j, k, l)) (j, k, l)

theorem cross' (a b c d e f: ℤ) : cross (a, b, c) (d, e, f) = (b*f - c*e, c*d - a*f, a*e - b*d) := rfl
theorem dot' (a b c d e f: ℤ) : dot (a, b, c) (d, e, f) = a*d + b*e + c*f := rfl

local attribute [simp] mul_comm mul_assoc mul_right_comm

theorem proof1 : ∀ {a b c d e f: ℤ}, dot (cross (a, b, c) (d, e, f)) (a, b, c) = 0 :=
assume a b c d e f,
calc
    dot (cross (a, b, c) (d, e, f)) (a, b, c) = dot (b*f - c*e, c*d - a*f, a*e - b*d) (a, b, c) : by rw cross'
    ... = (b*f - c*e)*a + (c*d - a*f)*b + (a*e - b*d)*c : by rw dot'
    ... = b*f*a - c*e*a + (c*d*b - a*f*b) + (a*e*c - b*d*c) : by repeat {rw sub_mul}
    ... = 0 : by simp
#check proof1

theorem proof2 : ∀ {a b c d e f: ℤ}, dot (cross (a, b, c) (d, e, f)) (d, e, f) = 0 :=
assume a b c d e f,
calc
    dot (cross (a, b, c) (d, e, f)) (d, e, f) = dot (b*f - c*e, c*d - a*f, a*e - b*d) (d, e, f) : by rw cross'
    ... = (b*f - c*e)*d + (c*d - a*f)*e + (a*e - b*d)*f : by rw dot'
    ... = b*f*d - c*e*d + (c*d*e - a*f*e) + (a*e*f - b*d*f) : by repeat {rw sub_mul}
    ... = a * (e * f) + (c * (d * e) + (-(a * (e * f)) + -(c * (d * e)))) : by simp
    ... = a * (e * f) + (c * (d * e) + -(a * (e * f)) + -(c * (d * e))) : by rw add_assoc
    ... = 0 : by simp

#check proof2

example (a b c d e f: ℤ) :
     dot (cross (a, b, c) (d, e, f)) (a, b, c) = 0 ∧ dot (cross (a, b, c) (d, e, f)) (d, e, f) = 0 :=
    and.intro proof1 proof2


-- ---------------------------------------------------------------------
-- Ejercicio. Sea x un número real tal que para todo número positivo ε,
-- x ≤ ε Demostrar que x ≤ 0.
-- ----------------------------------------------------------------------

import data.real.basic

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

example
  (x : ℝ)
  (h : ∀ ε > 0, x ≤ ε)
  : x ≤ 0 :=
begin
  apply le_of_not_gt,
  intro hx0,
  specialize h (x/2),
  have h1 : x ≤ x / 2,
    { apply h,
      apply half_pos hx0},
  have : x / 2 < x,
    { apply half_lt_self hx0 },
  linarith,
end

-- Prueba
-- ======

-- x : ℝ,
-- h : ∀ (ε : ℝ), ε > 0 → x ≤ ε
-- ⊢ x ≤ 0
--    >> apply le_of_not_gt,
-- ⊢ ¬x > 0
--    >> intro hx0,
-- hx0 : x > 0
-- ⊢ false
--    >> specialize h (x/2),
-- h : x / 2 > 0 → x ≤ x / 2
-- ⊢ false
--    >> have h1 : x ≤ x / 2,
--    >>   { apply h,
-- ⊢ x / 2 > 0
--    >>     apply half_pos hx0},
-- h1 : x ≤ x / 2
-- ⊢ false
--    >> have : x / 2 < x,
--    >>   { apply half_lt_self hx0 },
-- this : x / 2 < x
-- ⊢ false
--    >> linarith,
-- no goals

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

example
  (x : ℝ)
  (h : ∀ ε > 0, x ≤ ε)
  : x ≤ 0 :=
begin
  contrapose! h,
  use x / 2,
  split; linarith,
end

-- Prueba
-- ======

-- x : ℝ,
-- h : ∀ (ε : ℝ), ε > 0 → x ≤ ε
-- ⊢ x ≤ 0
--    >> contrapose! h,
-- h : 0 < x
-- ⊢ ∃ (ε : ℝ), ε > 0 ∧ ε < x
--    >> use x / 2,
-- ⊢ x / 2 > 0 ∧ x / 2 < x
--    >> split; linarith
-- no goals


-- Monotonia_de_la_multiplicacion_por_no_negativo.lean
-- Monotonía de la multiplicación por no negativo.
-- José A. Alonso Jiménez
-- Sevilla, 22 de agosto de 2020
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Ejercicio. Demostrar que si a, b y c son números reales tales que
-- 0 ≤ c y a ≤ b, entonces a*c ≤ b*c.
-- ----------------------------------------------------------------------

import data.real.basic

variables {a b c : ℝ}

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

example
  (hc : 0 ≤ c)
  (hab : a ≤ b)
  : a * c ≤ b * c :=
begin
  rw ← sub_nonneg,
  have h : b * c - a * c = (b - a) * c,
  { ring },
  { rw h,
    apply mul_nonneg,
    { rw sub_nonneg,
      exact hab },
    { exact hc }},
end

-- Comentario: Se ha usado el lema
-- + mul_nonneg : 0 ≤ a → 0 ≤ b → 0 ≤ a * b

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

example
  (hc : 0 ≤ c)
  (hab : a ≤ b)
  : a * c ≤ b * c :=
begin
  have hab' : 0 ≤ b - a,
  { rw ← sub_nonneg at hab,
    exact hab, },
  have h1 : 0 ≤ (b - a) * c,
  { exact mul_nonneg hab' hc, },
  have h2 : (b - a) * c = b * c - a * c,
  { ring, },
  have h3 : 0 ≤ b * c - a * c,
  { rw h2 at h1,
    exact h1, },
  rw sub_nonneg at h3,
  exact h3,
end

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

example
  (hc : 0 ≤ c)
  (hab : a ≤ b)
  : a * c ≤ b * c :=
begin
  have hab' : 0 ≤ b - a,
  { rwa ← sub_nonneg at hab, },
  have h1 : 0 ≤ (b - a) * c,
  { exact mul_nonneg hab' hc },
  have h2 : (b - a) * c = b * c - a * c,
  { ring, },
  have h3 : 0 ≤ b * c - a * c,
  { rwa h2 at h1, },
  rwa sub_nonneg at h3,
end

-- Comentario:
-- + La táctica (rwa h at h'), cuando h es una igualdad. sustituye en la
--   hipótesis h' el término izquierdo de h por el derecho y, a
--   continuación, aplica assumption.
-- + La táctica (rwa ← h at h'), cuando h es una igualdad, sustituye en
--   la hipótesis h' el término derecho de h por el izquierdo y, a
--   continuación, aplica assumption.

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

example
  (hc : 0 ≤ c)
  (hab : a ≤ b)
  : a * c ≤ b * c :=
begin
  rw ← sub_nonneg,
  calc 0 ≤ (b - a)*c  : mul_nonneg (by rwa sub_nonneg) hc
     ... =  b*c - a*c : by ring,
end

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

example
  (hc : 0 ≤ c)
  (hab : a ≤ b)
  : a * c ≤ b * c :=
mul_mono_nonneg hc hab

-- Comentario: Se usa el lema
-- + mul_mono_nonneg : 0 ≤ c → a ≤ b → a * c ≤ b * c

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

example
  (hc : 0 ≤ c)
  (hab : a ≤ b)
  : a * c ≤ b * c :=
by nlinarith

-- Comentario:
-- + La táctica nlinarith es una extensión de linarith con un
--   preprocesamiento que permite resolver problemas aritméticos no
--   lineales.


/- LoVe Homework 6: Monads -/

import .lovelib

namespace LoVe

/- Question 1: `map` for Monads

Define `map` for monads. This is the generalization of `map` on lists. Use the
monad operations to define `map`. The functorial properties (`map_id` and
`map_map`) are derived from the monad laws.

This time, we use Lean's monad definition. In combination, `monad` and
`is_lawful_monad` include the same constants, laws, and syntactic sugar as the
`lawful_monad` type class from the lecture. -/

section map

/- We fix a lawful monad `m`: -/

variables {m : Type → Type} [monad m] [is_lawful_monad m]

/- 1.1. Define `map` on `m`.

**Hint:** The challenge is to find a way to create `m β`. Follow the types.
One way to proceed is to list all the arguments and operations
available (e.g., `pure`, `>>=`) with their types and see if you can plug
them together like Lego blocks. -/

def map {α β} (f : α → β) (ma : m α) : m β :=
:= sorry

/- 1.2. Prove the identity law for `map`.

**Hint**: You will need the `bind_pure` property of monads. -/

lemma map_id {α} (ma : m α) : map id ma = ma :=
sorry

/- 1.3. Prove the composition law for `map`. -/

lemma map_map {α β γ} (f : α → β) (g : β → γ) (ma : m α) :
  map g (map f ma) = map (g ∘ f) ma :=
sorry

end map

/- Question 2 **optional**: Monadic Structure on Lists -/

/- `list` can be seen as a monad, similar to `option` but with several possible
outcomes. It is also similar to `set`, but the results are ordered and finite.
The code below sets `list` up as a monad. -/

namespace list

protected def bind {α β : Type} : list α → (α → list β) → list β
| []        f := []
| (a :: as) f := f a ++ bind as f

protected def pure {α : Type} (a : α) : list α :=
[a]

lemma pure_eq_singleton {α : Type} (a : α) :
  pure a = [a] :=
by refl

instance : monad list :=
{ pure := @list.pure,
  bind := @list.bind }

/- 2.1 **optional**. Prove the following properties of `bind` under the empty
list (`[]`), the list constructor (`::`), and `++`. -/

@[simp] lemma bind_nil {α β : Type} (f : α → list β) :
  [] >>= f = [] :=
sorry

@[simp] lemma bind_cons {α β : Type} (f : α → list β) (a : α) (as : list α) :
  list.cons a as >>= f = f a ++ (as >>= f) :=
sorry

@[simp] lemma bind_append {α β : Type} (f : α → list β) :
  ∀as as' : list α, (as ++ as') >>= f = (as >>= f) ++ (as' >>= f)
:= sorry

/- 2.2. Prove the monadic laws for `list`.

**Hint:** The simplifier cannot see through the type class definition of `pure`.
You can use `pure_eq_singleton` to unfold the definition or `show` to state the
lemma statement using `bind` and `[…]`. -/

lemma pure_bind {α β : Type} (a : α) (f : α → list β) :
  (pure a >>= f) = f a :=
sorry

lemma bind_pure {α : Type} :
  ∀as : list α, as >>= pure = as
:= sorry

lemma bind_assoc {α β γ : Type} (f : α → list β) (g : β → list γ) :
  ∀as : list α, (as >>= f) >>= g = as >>= (λa, f a >>= g)
:= sorry

lemma bind_pure_comp_eq_map {α β : Type} {f : α → β} :
  ∀as : list α, as >>= (pure ∘ f) = list.map f as
:= sorry

end list

end LoVe


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

! This file was ported from Lean 3 source module data.int.dvd.basic
! leanprover-community/mathlib commit e1bccd6e40ae78370f01659715d3c948716e3b7e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Data.Int.Order.Basic
import Mathlib.Data.Nat.Cast.Basic

/-!
# Basic lemmas about the divisibility relation in `ℤ`.
-/

open Nat

namespace Int

@[norm_cast]
theorem coe_nat_dvd {m n : ℕ} : (↑m : ℤ) ∣ ↑n ↔ m ∣ n :=
  ⟨fun ⟨a, ae⟩ =>
    m.eq_zero_or_pos.elim (fun m0 => by simp [m0] at ae; simp [ae, m0]) fun m0l => by
      cases'
        eq_ofNat_of_zero_le
          (@nonneg_of_mul_nonneg_right ℤ _ m a (by simp [ae.symm]) (by simpa using m0l)) with
        k e
      subst a
      exact ⟨k, Int.ofNat.inj ae⟩,
    fun ⟨k, e⟩ => Dvd.intro k <| by rw [e, Int.ofNat_mul]⟩
#align int.coe_nat_dvd Int.coe_nat_dvd

theorem coe_nat_dvd_left {n : ℕ} {z : ℤ} : (↑n : ℤ) ∣ z ↔ n ∣ z.natAbs := by
  rcases natAbs_eq z with (eq | eq) <;> rw [eq] <;> simp [←coe_nat_dvd]
#align int.coe_nat_dvd_left Int.coe_nat_dvd_left

theorem coe_nat_dvd_right {n : ℕ} {z : ℤ} : z ∣ (↑n : ℤ) ↔ z.natAbs ∣ n := by
  rcases natAbs_eq z with (eq | eq) <;> rw [eq] <;> simp [←coe_nat_dvd]
#align int.coe_nat_dvd_right Int.coe_nat_dvd_right

#align int.le_of_dvd Int.le_of_dvd

#align int.eq_one_of_dvd_one Int.eq_one_of_dvd_one

#align int.eq_one_of_mul_eq_one_right Int.eq_one_of_mul_eq_one_right

#align int.eq_one_of_mul_eq_one_left Int.eq_one_of_mul_eq_one_left

theorem ofNat_dvd_of_dvd_natAbs {a : ℕ} : ∀ {z : ℤ} (_ : a ∣ z.natAbs), ↑a ∣ z
  | Int.ofNat _, haz => Int.coe_nat_dvd.2 haz
  | -[k+1], haz => by
    change ↑a ∣ -(k + 1 : ℤ)
    apply dvd_neg_of_dvd
    apply Int.coe_nat_dvd.2
    exact haz
#align int.of_nat_dvd_of_dvd_nat_abs Int.ofNat_dvd_of_dvd_natAbs

theorem dvd_natAbs_of_ofNat_dvd {a : ℕ} : ∀ {z : ℤ} (_ : ↑a ∣ z), a ∣ z.natAbs
  | Int.ofNat _, haz => Int.coe_nat_dvd.1 (Int.dvd_natAbs.2 haz)
  | -[k+1], haz =>
    have haz' : (↑a : ℤ) ∣ (↑(k + 1) : ℤ) := dvd_of_dvd_neg haz
    Int.coe_nat_dvd.1 haz'
#align int.dvd_nat_abs_of_of_nat_dvd Int.dvd_natAbs_of_ofNat_dvd

#align int.dvd_antisymm Int.dvd_antisymm

end Int


import tactic

-- References: Schmidt, G. (2010) Relational Mathematics. Cambridge: Cambridge University Press (Encyclopedia of Mathematics and its Applications). doi: 10.1017/CBO9780511778810.

namespace myrelation
variables {α β γ A B C: Type*}

def union (r : α → β → Prop) (s : α → β → Prop) (a : α) (b : β) : Prop := r a b ∨ s a b
def intersect (r : α → β → Prop) (s : α → β → Prop) (a : α) (b : β) : Prop := r a b ∧ s a b
def transpose (r : α → β → Prop) (b : β) (a : α) : Prop := r a b
def complement (r : α → β → Prop) (a : α) (b : β) : Prop := ¬(r a b)
def comp (r : α → β → Prop) (p : β → γ → Prop) (a : α) (c : γ) : Prop := ∃ (b : β), r a b ∧ p b c

def reflexive (R : A → A → Prop) : Prop := ∀ x, R x x
def irreflexive (R : A → A → Prop) : Prop := ∀ x, ¬ R x x
def symmetric (R : A → A → Prop) : Prop := ∀ x y, R x y → R y x
def asymmetric (R : A → A → Prop) : Prop := ∀ (a b : A), R a b → ¬(R b a)
def transitive (R : A → A → Prop) : Prop := ∀ x y z, R x y → R y z → R x z
def anti_symmetric (R : A → A → Prop) : Prop := ∀ x y, R x y → R y x → x = y

def preorder (R : A → A → Prop) : Prop := reflexive R ∧ transitive R
def total (R : A → A → Prop) : Prop := ∀ x y, R x y ∨ R y x
def partial_order (R : A → A → Prop) : Prop := preorder R ∧ anti_symmetric R
def total_order (R : A → A → Prop) : Prop := partial_order R ∧ total R
def strict_order (R : A → A → Prop) : Prop := transitive R ∧ asymmetric R

-- Miscellaneous problems related to composition

-- For relations (R S : A → A → Prop),
-- (1)  if R and S are reflexive, is R ∘ S reflexive?
-- (2)  if R and S are symmetric, is R ∘ S symmetric?
-- (3)  if R and S are transitive, is R ∘ S transitive?
-- (4)  if R and S are anti-symmetric, is R ∘ S anti-symmetric?
-- (5)  if R and S are asymmetric, is R ∘ S asymmetric?
-- (6)  if R and S are irreflexive, is R ∘ S irreflexive?
-- (7)  if R and S are total, is R ∘ S total?

-- (1) Reflexivity: Preserved under composition
example (R S : A → A → Prop) (reflR : reflexive R) (reflS : reflexive S) : reflexive (comp R S) :=
begin
  intro x,
  use x, -- x is the required intermediate element
  split,
  { apply reflR x}, -- show R x x true, followed from reflexivity of R
  { apply reflS x}, -- show S x x true, followed from reflexivity of S
end

-- (2) Symmetry: Not preserved under composition
-- Counterexample: R, S are relations that
                -- R(a,b), R(b,a) true, else false
                -- S(a,a) true, else false

namespace symmetry

inductive X : Type
| a : X
| b : X

namespace X

-- Define binary relation R such that
-- R(a,b), R(b,a) true, else false
def R : X → X → Prop
| a a := false
| a b := true
| b a := true
| b b := false

-- Define binary relation S such that
-- S(a,a) true, else false
def S : X → X → Prop
| a a := true
| a b := false
| b a := false
| b b := false

def U : X → X → Prop := comp R S

-- R is symmetric
lemma R_symm : symmetric R :=
begin
  intros x y hxy,
  rcases x,
    -- x = a
    rcases y,
      exact hxy, -- the case y = a
      triv, -- the case y = b; `R b a` is true
    -- x = b
    rcases y,
      triv, -- the case y = a; `R a b` is true
      exact hxy, -- the case y = b
end

-- S is symmetric
lemma S_symm : symmetric S :=
begin
  intros x y hxy,
  rcases x,
    -- x = a
    rcases y,
      exact hxy, -- the case y = a
      exfalso, exact hxy, -- the case y = b
    -- x = b
    rcases y,
      exfalso, exact hxy, -- the case y = a
      exact hxy, -- the case y = b
end

-- U is NOT symmetric
example : ¬(∀ A : Type, ∀ (R: A → A → Prop) (S: A → A → Prop), symmetric R → symmetric S → symmetric U) :=
begin
  intro h, -- change to `hypothesis → false`
  specialize h X R S _, -- focus on the specific example we construct
  { exact R_symm}, -- Prove R is symmetric
  { have h1 : symmetric U, {apply h, exact S_symm},
    have h2 : U b a, -- show hypothesis that U b a is true
      {use a, split, triv, triv},
    have h3 : ¬(U a b), -- show hypothesis that U a b is false
      {intro hUab, cases hUab with x hx, rcases x, apply hx.2, apply hx.2},
    specialize h1 b a h2, -- focus on the specific case with h1, h2
    apply h3, exact h1,
  },
end

end X
end symmetry

-- (3) Transitivity: Not preserved under composition
-- Counterexample: R, S are relations that
                -- R(a,b), R(b,c), R(c,a) true, else false
                -- S(a,a) true, else false

namespace transitivity

inductive X : Type
| a : X
| b : X
| c : X

namespace X

-- Define binary relation R such that
-- R(a,b), R(b,c), R(c,a) true, else false
def R : X → X → Prop
| a b := true
| b c := true
| a c := true
| a a := false
| b a := false
| b b := false
| c a := false
| c b := false
| c c := false

-- Define binary relation S such that
-- S(b,c), S(c,a), S(b,a) true, else false
def S : X → X → Prop
| b c := true
| c a := true
| b a := true
| a a := false
| a b := false
| a c := false
| b b := false
| c b := false
| c c := false

def U : X → X → Prop := comp R S

-- R is transitive
lemma R_trans : transitive R :=
begin
  intros x y z hxy hyz,
  rcases x,
    -- x = a
    rcases y,
      -- y = a
      rcases z,
        exact hxy, -- the case z = a
        exact hyz, -- the case z = b
        exact hyz, -- the case z = c
      -- y = b
      rcases z,
        exact hyz, -- the case z = a; `R b a` is false
        exact hxy, -- the case z = b
        triv,      -- the case z = c; `R a c` is true
      -- y = c
      rcases z,
        exact hyz, -- the case z = a; `R c a` is false
        triv,      -- the case z = b; `R a b` is true
        exact hxy, -- the case z = c
    -- x = b
    rcases y,
      -- y = a
      rcases z,
        exact hxy, -- the case z = a
        exact hxy, -- the case z = b; `R b a` is false
        triv,      -- the case z = c; `R b c` is true
      -- y = b
      rcases z,
        exact hyz, -- the case z = a
        exact hxy, -- the case z = b
        exact hyz, -- the case z = c
      -- y = c
      rcases z,
        exact hyz, -- the case z = a; `R c a` is false
        exact hyz, -- the case z = b; `R c b` is false
        exact hxy, -- the case z = c
    -- x = c
    rcases y,
      -- y = a
      rcases z,
        exact hxy, -- the case z = a
        exact hxy, -- the case z = b; `R c a` is false
        exact hxy, -- the case z = c; `R c a` is false
      -- y = b
      rcases z,
        exact hyz, -- the case z = a; `R b a` is false
        exact hxy, -- the case z = b
        exact hxy, -- the case z = c; `R c b` is false
      -- y = c
      rcases z,
        exact hyz, -- the case z = a
        exact hyz, -- the case z = b
        exact hxy, -- the case z = c
end

-- S is transitive
lemma S_trans : transitive S :=
begin
  intros x y z hxy hyz,
  rcases x,
    -- x = a
    rcases y,
      -- y = a
      rcases z,
        exact hxy, -- the case z = a
        exact hyz, -- the case z = b
        exact hyz, -- the case z = c
      -- y = b
      rcases z,
        exact hxy, -- the case z = a; `S a b` is false
        exact hxy, -- the case z = b
        exact hxy, -- the case z = c; `S a b` is false
      -- y = c
      rcases z,
        exact hxy, -- the case z = a; `S a c` is false
        exact hxy, -- the case z = b; `S a c` is false
        exact hxy, -- the case z = c
    -- x = b
    rcases y,
      -- y = a
      rcases z,
        exact hxy, -- the case z = a
        exact hyz, -- the case z = b; `S a b` is false
        triv,      -- the case z = c; `S b c` is true
      -- y = b
      rcases z,
        exact hyz, -- the case z = a
        exact hxy, -- the case z = b
        exact hyz, -- the case z = c
      -- y = c
      rcases z,
        triv,      -- the case z = a; `S b a` is true
        exact hyz, -- the case z = b; `S c b` is false
        exact hxy, -- the case z = c
    -- x = c
    rcases y,
      -- y = a
      rcases z,
        exact hxy, -- the case z = a
        exact hyz, -- the case z = b; `S a b` is false
        exact hyz, -- the case z = c; `S a c` is false
      -- y = b
      rcases z,
        triv,      -- the case z = a; `S c a` is true
        exact hxy, -- the case z = b
        exact hxy, -- the case z = c; `S c b` is false
      -- y = c
      rcases z,
        exact hyz, -- the case z = a
        exact hyz, -- the case z = b
        exact hyz, -- the case z = c
end

-- U is NOT transitive
example : ¬(∀ A : Type, ∀ (R: A → A → Prop) (S: A → A → Prop), transitive R → transitive S → transitive U) :=
begin
  intro h, -- change to `hypothesis → false`
  specialize h X R S _, -- focus on the specific example we construct
  { exact R_trans}, -- Prove R is transitive
  { have h1 : transitive U, {apply h, exact S_trans},
    have h2 : U b a, -- show hypothesis that U b a is true
      {use c, split, triv, triv},
    have h3 : U a c, -- show hypothesis that U a c is true
      {use b, split, triv, triv},
    specialize h1 b a c h2 h3, -- focus on the specific case with h1, h2
    { cases h1 with x hx,
      rcases x,
      exact hx.1, exact hx.1, exact hx.2}, -- check `U b c` is false
  },
end

end X
end transitivity

-- (4) Antisymmetry: Not preserved under composition
-- Counterexample: R, S are relations on X = {a,b} that
                -- R(a,b), R(b,b) true, else false
                -- S(b,a), S(b,b) true, else false
namespace antisymmetry

inductive X : Type
| a : X
| b : X

namespace X

-- Define binary relation R such that
-- R(a,b), R(b,b) true, else false
def R : X → X → Prop
| a a := false
| a b := true
| b a := false
| b b := true

-- Define binary relation S such that
-- S(b,a), S(b,b) true, else false
def S : X → X → Prop
| a a := false
| a b := false
| b a := true
| b b := true

def U : X → X → Prop := comp R S

-- R is anti-symmetric
lemma R_antisymm : anti_symmetric R :=
begin
  intros x y hxy hyx,
  rcases x,
    -- x = a
    rcases y,
      refl,               -- y = a
      exfalso, apply hyx, -- y = b
    -- x = b
    rcases y,
      exfalso, apply hxy, -- y = a
      refl,               -- y = b
end

-- S is anti-symmetric
lemma S_antisymm : anti_symmetric S :=
begin
  intros x y hxy hyx,
  rcases x,
    -- x = a
    rcases y,
      refl,               -- y = a
      exfalso, apply hxy, -- y = b
    -- x = b
    rcases y,
      exfalso, apply hyx, -- y = a
      refl,               -- y = b
end

-- U is NOT anti-symmetric
example : ¬(∀ A : Type, ∀ (R: A → A → Prop) (S: A → A → Prop), anti_symmetric R → anti_symmetric S → anti_symmetric U) :=
begin
  intro h, -- change to `hypothesis → false`
  specialize h X R S _, -- focus on the specific example we construct
  { exact R_antisymm}, -- Prove R is antisymmetric
  { have h1 : anti_symmetric U, {apply h, exact S_antisymm},
    have h2 : U a b, -- show hypothesis that U b a is true
      {use b, split, triv, triv},
    have h3 : U b a, -- show hypothesis that U a b is true
      {use b, split, triv, triv},
    specialize h1 a b h2 h3, -- focus on the specific case with h1, h2
    rcases h1, -- check that h1 is false
  },
end

end X
end antisymmetry

-- (5) Asymmetry: Not preserved under composition
-- Counterexample: R, S are relations on X = {a,b} that
                -- R(a,b) true, else false
                -- S(b,a) true, else false
namespace asymmetry

inductive X : Type
| a : X
| b : X

namespace X

-- Define binary relation R such that
-- R(a,b) true, else false
def R : X → X → Prop
| a a := false
| a b := true
| b a := false
| b b := false

-- Define binary relation S such that
-- S(b,a) true, else false
def S : X → X → Prop
| a a := false
| a b := false
| b a := true
| b b := false

def U : X → X → Prop := comp R S

-- R is asymmetric
lemma R_asymm : asymmetric R :=
begin
  intros x y hxy hyx,
  rcases x,
    -- x = a
    rcases y,
      exact hxy, -- y = a; `R a a` is false
      exact hyx, -- y = b; `R b a` is false
    -- x = b
    rcases y,
      exact hxy, -- y = a; `R b a` is false
      exact hyx, -- y = b; `R b b` is false
end

-- S is asymmetric
lemma S_asymm : asymmetric S :=
begin
  intros x y hxy hyx,
  rcases x,
    -- x = a
    rcases y,
      exact hxy, -- y = a; `S a a` is false
      exact hxy, -- y = b; `S a b` is false
    -- x = b
    rcases y,
      exact hyx, -- y = a; `S a b` is false
      exact hyx, -- y = b; `R b b` is false
end

-- U is NOT asymmetric
example : ¬(∀ A : Type, ∀ (R: A → A → Prop) (S: A → A → Prop), asymmetric R → asymmetric S → asymmetric U) :=
begin
  intro h, -- change to `hypothesis → false`
  specialize h X R S _, -- focus on the specific example we construct
  { exact R_asymm}, -- Prove R is antisymmetric
  { have h1 : asymmetric U, {apply h, exact S_asymm},
    have h2 : U a a, {use b, split, triv, triv}, -- show hypothesis that U a a is true
    specialize h1 a a, -- focus on the specific case with h1, h2
    apply h1, exact h2, exact h2, -- check that h1 is false
  },
end

end X
end asymmetry

-- (6) Irreflexivity: Not preserved under composition
-- Counterexample: R, S are relations on X = {a,b} that
                -- R(a,b) true, else false
                -- S(b,a) true, else false
namespace irreflexivity

inductive X : Type
| a : X
| b : X

namespace X

-- Define binary relation R such that
-- R(a,b) true, else false
def R : X → X → Prop
| a a := false
| a b := true
| b a := false
| b b := false

-- Define binary relation S such that
-- S(b,a) true, else false
def S : X → X → Prop
| a a := false
| a b := false
| b a := true
| b b := false

def U : X → X → Prop := comp R S

-- R is irreflexive
lemma R_irrfl : irreflexive R :=
begin
  intro x,
  rcases x,
    repeat { intro h, exact h},
end

-- S is irreflexive
lemma S_irrfl : irreflexive S :=
begin
  intro x,
  rcases x,
    repeat { intro h, exact h},
end

-- U is NOT irreflexive
example : ¬(∀ A : Type, ∀ (R: A → A → Prop) (S: A → A → Prop), irreflexive R → irreflexive S → irreflexive U) :=
begin
  intro h, -- change to `hypothesis → false`
  specialize h X R S _, -- focus on the specific example we construct
  { exact R_irrfl}, -- Prove R is antisymmetric
  { have h1 : irreflexive U, {apply h, exact S_irrfl},
    have h2 : U a a, {use b, split, triv, triv}, -- show hypothesis that U a a is true
    specialize h1 a, -- focus on the specific case with h1, h2
    apply h1, exact h2, -- check that h1 is false
  },
end

end X
end irreflexivity

-- (7) Totality: Preserved under composition
example (R S : A → A → Prop) (totalR : total R) (totalS : total S) : total (comp R S) :=
begin
  intros x y,
  have h1 : R x x ∨ R x x, apply totalR x x,
  have h2 : R y y ∨ R y y, apply totalR y y,
  specialize totalS x y,
  cases totalS with hSxy hSyx,
    {left, use x, split, rcases h1, exact h1, exact h1, exact hSxy},
    {right, use y, split, rcases h2, exact h2, exact h2, exact hSyx},
end

end myrelation


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

! This file was ported from Lean 3 source module measure_theory.integral.interval_average
! leanprover-community/mathlib commit 9003f28797c0664a49e4179487267c494477d853
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.MeasureTheory.Integral.IntervalIntegral
import Mathbin.MeasureTheory.Integral.Average

/-!
# Integral average over an interval

In this file we introduce notation `⨍ x in a..b, f x` for the average `⨍ x in Ι a b, f x` of `f`
over the interval `Ι a b = set.Ioc (min a b) (max a b)` w.r.t. the Lebesgue measure, then prove
formulas for this average:

* `interval_average_eq`: `⨍ x in a..b, f x = (b - a)⁻¹ • ∫ x in a..b, f x`;
* `interval_average_eq_div`: `⨍ x in a..b, f x = (∫ x in a..b, f x) / (b - a)`.

We also prove that `⨍ x in a..b, f x = ⨍ x in b..a, f x`, see `interval_average_symm`.

## Notation

`⨍ x in a..b, f x`: average of `f` over the interval `Ι a b` w.r.t. the Lebesgue measure.

-/

open MeasureTheory Set TopologicalSpace

open Interval

variable {E : Type _} [NormedAddCommGroup E] [NormedSpace ℝ E] [CompleteSpace E]

-- mathport name: «expr⨍ in .. , »
notation3"⨍ "(...)" in "a".."b", "r:(scoped f => average Measure.restrict volume Ι a b f) => r

theorem interval_average_symm (f : ℝ → E) (a b : ℝ) : (⨍ x in a..b, f x) = ⨍ x in b..a, f x := by
  rw [set_average_eq, set_average_eq, uIoc_swap]
#align interval_average_symm interval_average_symm

theorem interval_average_eq (f : ℝ → E) (a b : ℝ) :
    (⨍ x in a..b, f x) = (b - a)⁻¹ • ∫ x in a..b, f x :=
  by
  cases' le_or_lt a b with h h
  ·
    rw [set_average_eq, uIoc_of_le h, Real.volume_Ioc, intervalIntegral.integral_of_le h,
      ENNReal.toReal_ofReal (sub_nonneg.2 h)]
  ·
    rw [set_average_eq, uIoc_of_lt h, Real.volume_Ioc, intervalIntegral.integral_of_ge h.le,
      ENNReal.toReal_ofReal (sub_nonneg.2 h.le), smul_neg, ← neg_smul, ← inv_neg, neg_sub]
#align interval_average_eq interval_average_eq

theorem interval_average_eq_div (f : ℝ → ℝ) (a b : ℝ) :
    (⨍ x in a..b, f x) = (∫ x in a..b, f x) / (b - a) := by
  rw [interval_average_eq, smul_eq_mul, div_eq_inv_mul]
#align interval_average_eq_div interval_average_eq_div