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

/-!
# Zorn lemma for (co)atoms

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

In this file we use Zorn's lemma to prove that a partial order is atomic if every nonempty chain
`c`, `⊥ ∉ c`, has a lower bound not equal to `⊥`. We also prove the order dual version of this
statement.
-/

open set

/-- **Zorn's lemma**: A partial order is coatomic if every nonempty chain `c`, `⊤ ∉ c`, has an upper
bound not equal to `⊤`. -/
lemma is_coatomic.of_is_chain_bounded {α : Type*} [partial_order α] [order_top α]
  (h : ∀ c : set α, is_chain (≤) c → c.nonempty → ⊤ ∉ c → ∃ x ≠ ⊤, x ∈ upper_bounds c) :
  is_coatomic α :=
begin
  refine ⟨λ x, le_top.eq_or_lt.imp_right $ λ hx, _⟩,
  rcases zorn_nonempty_partial_order₀ (Ico x ⊤) (λ c hxc hc y hy, _) x (left_mem_Ico.2 hx)
    with ⟨y, ⟨hxy, hy⟩, -, hy'⟩,
  { refine ⟨y, ⟨hy.ne, λ z hyz, le_top.eq_or_lt.resolve_right $ λ hz, _⟩, hxy⟩,
    exact hyz.ne' (hy' z ⟨hxy.trans hyz.le, hz⟩ hyz.le) },
  { rcases h c hc ⟨y, hy⟩ (λ h, (hxc h).2.ne rfl) with ⟨z, hz, hcz⟩,
    exact ⟨z, ⟨le_trans (hxc hy).1 (hcz hy), hz.lt_top⟩, hcz⟩ }
end

/-- **Zorn's lemma**: A partial order is atomic if every nonempty chain `c`, `⊥ ∉ c`, has an lower
bound not equal to `⊥`. -/
lemma is_atomic.of_is_chain_bounded {α : Type*} [partial_order α] [order_bot α]
  (h : ∀ c : set α, is_chain (≤) c → c.nonempty → ⊥ ∉ c → ∃ x ≠ ⊥, x ∈ lower_bounds c) :
  is_atomic α :=
is_coatomic_dual_iff_is_atomic.mp $ is_coatomic.of_is_chain_bounded $ λ c hc, h c hc.symm


theorem impNot {p q : Prop} : p → ¬ q ↔ ¬ (p ∧ q) :=
  ⟨ λ hpq h => hpq h.1 h.2, λ h hp hq => h <| And.intro hp hq ⟩

theorem Exists.impNot {p q : α → Prop} : (∃ x, p x → ¬ q x) ↔ ∃ x, ¬ (p x ∧ q x) := by
  apply Iff.intro
  intro h
  cases h with | intro x hx =>
  { exact ⟨ x, λ hs => hx hs.1 hs.2 ⟩ }
  intro h
  cases h with | intro x hx =>
  { exact ⟨ x, λ hpx hqx => hx <| And.intro hpx hqx ⟩ }

namespace Classical

theorem contrapositive {p q : Prop} : (¬ q → ¬ p) → p → q :=
  λ hqp hp => match em q with
    | Or.inl h => h
    | Or.inr h => False.elim <| hqp h hp

theorem notNot {p : Prop} : ¬ ¬ p ↔ p := by
  apply Iff.intro
  { intro hp; cases em p with
    | inl   => assumption
    | inr h => exact False.elim <| hp h }
  { exact λ hp hnp => False.elim <| hnp hp }

theorem notForall {p : α → Prop} : (¬ ∀ x, p x) → ∃ x, ¬ p x := by
  { apply contrapositive; intro hx; rw notNot; intro x;
    cases em (p x); { assumption }
      { apply False.elim <| hx <| Exists.intro x _; assumption } }

theorem notAnd {p q : Prop} : p ∧ ¬ q ↔ ¬ (p → q) := by
  apply Iff.intro
  { exact λ h himp => h.2 <| himp h.1 }
  { intro h; apply And.intro;
    { revert h; apply contrapositive; rw notNot;
      exact λ hnp hp => False.elim <| hnp hp }
    { exact λ hq => h <| λ _ => hq } }

theorem Exists.notAnd {p q : α → Prop} :
  (∃ x, p x ∧ ¬ q x) ↔ ∃ x, ¬ (p x → q x) := by
  apply Iff.intro
  { intro h;
    let ⟨ x, ⟨ hp, hnq ⟩ ⟩ := h;
    exact Exists.intro x λ h => hnq <| h hp }
  { intro h;
    let ⟨ x, hx ⟩ := h;
    apply Exists.intro x;
    apply And.intro;
    { revert hx; apply contrapositive;
      exact λ hpx hpq => hpq λ hp => False.elim <| hpx hp }
    { intro foo;
      apply hx;
      intro bar;
      assumption; } }

end Classical

def Set (α : Type u) := α → Prop

def setOf (p : α → Prop) : Set α := p

namespace Set

instance : EmptyCollection (Set α) := ⟨ λ x => False ⟩

variable {zzz : Type u}

variable {α : Type u}
variable {s : Set α}

def mem (a : α) (s : Set α) := s a

infix:55 "∈" => Set.mem
notation:55 x "∉" s => ¬ x ∈ s

instance : CoeSort (Set α) (Type u) where
  coe s := Subtype s

theorem ext {s t : Set α} (h : ∀ x, x ∈ s ↔ x ∈ t) : s = t :=
  funext <| λ x => propext <| h x

-- Declaring the index category
declare_syntax_cat index
syntax ident : index
syntax ident ":" term : index
syntax ident "∈" term : index

-- Notation for sets
syntax "{" index "|" term "}" : term

macro_rules
| `({ $x:ident : $t | $p }) => `(setOf (λ ($x:ident : $t) => $p))
| `({ $x:ident | $p }) => `(setOf (λ ($x:ident) => $p))
| `({ $x:ident ∈ $s | $p }) => `(setOf (λ $x => $x ∈ $s → $p))

def union (s t : Set α) : Set α := { x : α | x ∈ s ∨ x ∈ t }

def inter (s t : Set α) : Set α := { x : α | x ∈ s ∧ x ∈ t }

theorem unionDef (s t : Set α) : union s t = λ x => s x ∨ t x := rfl

theorem interDef (s t : Set α) : inter s t = λ x => s x ∧ t x := rfl

infix:60 "∪" => Set.union
infix:60 "∩" => Set.inter

def Union (s : Set (Set α)) : Set α := { x : α | ∃ t : Set α, t ∈ s → t x }

def Inter (s : Set (Set α)) : Set α := { x : α | ∀ t : Set α, t ∈ s → t x }

def UnionDef (s : Set (Set α)) : Union s = λ x => ∃ t : Set α, t ∈ s → t x := rfl

def InterDef (s : Set (Set α)) : Inter s = λ x => ∀ t : Set α, t ∈ s → t x := rfl

syntax "⋃" index "," term : term
syntax "⋂" index "," term : term

macro_rules
| `(⋃ $s:ident ∈ $c, $s) => `(Union $c)
| `(⋂ $s:ident ∈ $c, $s) => `(Inter $c)

-- variables {s : Set (Set α)}

-- #check ⋂ t ∈ s, t

-- Notation for ∀ x ∈ s, p and ∃ x ∈ s, p
syntax "∀" index "," term : term
syntax "∃" index "," term : term

macro_rules
| `(∀ $x:ident ∈ $s, $p) => `(∀ $x:ident, $x ∈ $s → $p)
| `(∃ $x:ident ∈ $s, $p) => `(∃ $x:ident, $x ∈ $s ∧ $p)

def Subset (s t : Set α) := ∀ x ∈ s, x ∈ t

infix:50 "⊆" => Subset

theorem Subset.def {s t : Set α} : s ⊆ t ↔ ∀ x ∈ s, x ∈ t := Iff.rfl

namespace Subset

theorem refl {s : Set α} : s ⊆ s := λ _ hx => hx

theorem trans {s t v : Set α} (hst : s ⊆ t) (htv : t ⊆ v) : s ⊆ t :=
  λ x hx => hst x hx

theorem antisymm {s t : Set α} (hst : s ⊆ t) (hts : t ⊆ s) : s = t :=
  Set.ext λ x => ⟨ λ hx => hst x hx, λ hx => hts x hx ⟩

theorem antisymmIff {s t : Set α} : s = t ↔ s ⊆ t ∧ t ⊆ s :=
  ⟨ by { intro hst; subst hst; exact ⟨ refl, refl ⟩ },
    λ ⟨ hst, hts ⟩ => antisymm hst hts ⟩

-- ↓ Uses classical logic
theorem notSubset : ¬ s ⊆ t ↔ ∃ x ∈ s, x ∉ t := by
  apply Iff.intro;
  { intro hst;
    rw Classical.Exists.notAnd;
    apply Classical.notForall;
    exact λ h => hst λ x hx => h x hx }
  { intro h hst;
    let ⟨ x, ⟨ hxs, hxt ⟩ ⟩ := h;
    exact hxt <| hst x hxs }

end Subset

theorem memEmptySet {x : α} (h : x ∈ ∅) : False := h

@[simp] theorem memEmptySetIff : (∃ (x : α), x ∈ ∅) ↔ False :=
  Iff.intro (λ h => h.2) False.elim

@[simp] theorem setOfFalse : { a : α | False } = ∅ := rfl

def univ : Set α := { x | True }

@[simp] theorem memUniv (x : α) : x ∈ univ := True.intro

theorem Subset.subsetUniv {s : Set α} : s ⊆ univ := λ x _ => memUniv x

theorem Subset.univSubsetIff {s : Set α} : univ ⊆ s ↔ univ = s := by
  apply Iff.intro λ hs => Subset.antisymm hs Subset.subsetUniv
  { intro h; subst h; exact Subset.refl }

theorem eqUnivIff {s : Set α} : s = univ ↔ ∀ x, x ∈ s := by
  apply Iff.intro
  { intro h x; subst h; exact memUniv x }
  { exact λ h => ext λ x => Iff.intro (λ _ => memUniv _) λ _ => h x }

/-! ### Unions and Intersections -/

macro "extia" x:term : tactic => `(tactic| apply ext; intro $x; apply Iff.intro)

theorem unionSelf {s : Set α} : s ∪ s = s := by
  extia x
  { intro hx; cases hx; assumption; assumption }
  { exact Or.inl }

theorem unionEmpty {s : Set α} : s ∪ ∅ = s := by
  extia x
  { intro hx; cases hx with
    | inl   => assumption
    | inr h => exact False.elim <| memEmptySet h }
  { exact Or.inl }

theorem unionSymm {s t : Set α} : s ∪ t = t ∪ s := by
  extia x
  allGoals { intro hx; cases hx with
             | inl hx => exact Or.inr hx
             | inr hx => exact Or.inl hx }

theorem emptyUnion {s : Set α} : ∅ ∪ s = s := by
  rw unionSymm; exact unionEmpty

theorem unionAssoc {s t w : Set α} : s ∪ t ∪ w = s ∪ (t ∪ w) := by
  extia x
  { intro hx; cases hx with
    | inr hx   => exact Or.inr <| Or.inr hx
    | inl hx   => cases hx with
      | inr hx => exact Or.inr <| Or.inl hx
      | inl hx => exact Or.inl hx }
  { intro hx; cases hx with
    | inl hx   => exact Or.inl <| Or.inl hx
    | inr hx   => cases hx with
      | inr hx => exact Or.inr hx
      | inl hx => exact Or.inl <| Or.inr hx }

end Set


import linear_algebra.finsupp

open linear_map

variables {R : Type*} {M : Type*} {M₂ : Type*} {M₃ : Type*}
variables [ring R] [add_comm_group M] [add_comm_group M₂] [add_comm_group M₃]
variables [module R M] [module R M₂] [module R M₃]
variables {α : Type*} (v : α → M)

/-- Given 2 surjective R-module homs `f : M →ₗ[R] M₂, g : M₂ →ₗ[R] M₃`, `g ∘ f` is surjective.  -/
theorem range_eq_top_comp {f : M →ₗ[R] M₂} {g : M₂ →ₗ[R] M₃} (hf : range f = ⊤)
  (hg : range g = ⊤) : range (g.comp f) = ⊤ :=
by rw [range_comp, hf, ←hg]; refl

/-- Given 2 injective R-module homs `f : M →ₗ[R] M₂, g : M₂ →ₗ[R] M₃`, `g ∘ f` is injective.-/
theorem ker_eq_bot_comp {f : M →ₗ[R] M₂} {g : M₂ →ₗ[R] M₃} (hf : f.ker = ⊥) (hg : g.ker = ⊥) :
  ker (g.comp f) = ⊥ :=
by rw [ker_comp, hg, ←hf]; refl


/-
Copyright (c) 2021 Gabriel Moise. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Gabriel Moise.
-/

import data.complex.basic
import data.complex.module
import data.fintype.basic
import data.real.basic
import linear_algebra.matrix

/-!
# Symmetric Matrices
This module defines symmetric matrices, together with key properties about their eigenvalues & eigenvectors.
It uses a more restrictive definition of eigenvalues & eigenvectors, together with helping lemmas for vector-matrix
operations and tools for complex numbers/vectors.
TODO : make the eigen-definitions consistent with the ones already defined in linear_algebra.eigenspace
## Main definitions
* `vec_conj x` - the complex conjugate of a complex vector `x`
* `vec_re x` - the vector containing the real parts of elements from x
* `vec_im x` - the vector containing the imaginary parts of elements from x
* `has_eigenpair M μ x` - matrix `M` has non-zero eigenvector `x` with corresponding eigenvalue `μ`
* `has_eigenvector M x` - matrix `M` has non-zero eigenvector `x`
* `has_eigenvalue M μ`  - matrix `M` has eigenvalue `μ`
* `symm_matrix M` - `M` is a symmetric matrix
## Main statements
1. If x is an eigenvector of matrix M, then a • x is an eigenvector of M, for any non-zero a : ℂ.
2. If there are two eigenvectors of M that have the same correspoding eigenvalue, then any linear combination of them
is also an eigenvector of M with the same eigenvalue μ.
3. All eigenvalues of a symmetric real matrix M are real.
4. For every real eigenvalue of a symmetric matrix M, there exists a corresponding real-valued eigenvector.
5. If v and w are eigenvectors of a symmetric matrix M with different eigenvalues, then v and w are orthogonal.
## References
<https://www.doc.ic.ac.uk/~ae/papers/lecture05.pdf>
<https://sharmaeklavya2.github.io/theoremdep/nodes/linear-algebra/eigenvectors/real-matrix-with-real-eigenvalue-has-real-eigenvectors.html>
-/

open_locale matrix big_operators
open_locale complex_conjugate
open fintype finset matrix complex

universes u
variables {α : Type u}
variables {m n : Type*} [fintype m] [fintype n]

lemma vec_eq_unfold (x y : n → α) : (λ i : n, x i) = (λ i : n, y i) ↔ ∀ i : n, x i = y i :=
begin
  split,
  { intros hyp i, exact congr_fun hyp i },
  { intro hyp, ext, apply hyp }
end

-- ## Coercions
instance : has_coe (n → ℝ) (n → ℂ) := ⟨λ x, (λ i, ⟨x i, 0⟩)⟩
instance : has_coe (matrix m n ℝ) (matrix m n ℂ) := ⟨λ M, (λ i j, ⟨M i j, 0⟩)⟩

-- ## Lemmas on ℂ

lemma conj_of_zero_im {μ : ℂ} (H_im : μ.im = 0) : conj μ = μ :=
by { ext; simp only [conj_re, conj_im, H_im, neg_zero] }

lemma sum_complex_re {x : n → ℂ} : (∑ i : n, x i).re = ∑ i : n, (x i).re := by exact complex.re_lm.map_sum

lemma sum_complex_im {x : n → ℂ} : (∑ i : n, x i).im = ∑ i : n, (x i).im := by exact complex.im_lm.map_sum

-- The real and complex parts of a complex vector
def vec_re (x : n → ℂ) : n → ℝ := λ i : n, (x i).re
def vec_im (x : n → ℂ) : n → ℝ := λ i : n, (x i).im

-- Defining the complex conjugate of a complex vector
section vec_conj

def vec_conj (x : n → ℂ) : n → ℂ := λ i : n, conj (x i)

-- (μ • x)* = μ* • x*
lemma vec_conj_smul (μ : ℂ) (x : n → ℂ) :
  vec_conj (μ • x) = (conj μ) • (vec_conj x) :=
by { ext ; simp only [vec_conj, algebra.id.smul_eq_mul, pi.smul_apply, ring_hom.map_mul] }

-- ↑A i j = ↑(A i j)
lemma coe_matrix_coe_elem (i : m) (j : n) (A : matrix m n ℝ) : (A : matrix m n ℂ) i j = ↑(A i j) := by exact rfl

-- (A ⬝ x)* = A ⬝ x*
lemma vec_conj_mul_vec [decidable_eq n] [nonempty n] (A : matrix m n ℝ) (x : n → ℂ) :
  vec_conj ((A : matrix m n ℂ).mul_vec x) = (A : matrix m n ℂ).mul_vec (vec_conj x) :=
begin
  ext,
  simp only [vec_conj, mul_vec, dot_product, conj_re, coe_matrix_coe_elem, sum_complex_re, mul_re, of_real_im, zero_mul],
  simp only [vec_conj, mul_vec, dot_product, conj_im, coe_matrix_coe_elem, sum_complex_im, mul_im, add_zero, of_real_im,
    zero_mul, sum_neg_distrib],
end

lemma vec_norm_sq_zero {x : n → ℂ} (H_dot : dot_product (vec_conj x) x = 0) : x = 0 :=
begin
  unfold dot_product at H_dot,
  simp only [vec_conj, mul_comm, mul_conj, complex.ext_iff, sum_complex_re, zero_re, of_real_re] at H_dot,
  cases H_dot with H_re H_im,
  have key : ∑ i in (univ : finset n), norm_sq (x i) = 0 ↔ ∀ i ∈ (univ : finset n), norm_sq(x i) = 0,
  { apply sum_eq_zero_iff_of_nonneg, intros i h_univ, exact norm_sq_nonneg (x i) },
  simp only [forall_prop_of_true, mem_univ, monoid_with_zero_hom.map_eq_zero] at key,
  rw key at H_re,
  ext i;
  { specialize H_re i, simp only [H_re, pi.zero_apply] }
end

lemma coe_vec_re (x : n → ℂ) {i : n} : (vec_re x : n → ℂ) i = ((x i).re : ℂ) :=
by simpa only [vec_re]

lemma vec_add_conj_eq_two_re (x : n → ℂ) : x + vec_conj x = (2 : ℂ) • (vec_re x : n → ℂ) :=
begin
  ext,
  { simp [vec_conj, coe_vec_re x], linarith },
  { simp [vec_conj, coe_vec_re x] }
end

lemma vec_conj_add_zero {x : n → ℂ} (H : x + vec_conj x = 0) : vec_re x = 0 :=
begin
  rw [vec_add_conj_eq_two_re, smul_eq_zero] at H,
  cases H with H_20 H_x,
  { exfalso, simp at H_20, assumption }, -- 2 = 0
  { rw function.funext_iff at H_x,
    ext i,
    specialize H_x i,
    rw coe_vec_re at H_x,
    simp only [of_real_eq_zero, pi.zero_apply] at H_x,
    simp only [vec_re, H_x, pi.zero_apply] }
end

end vec_conj

namespace matrix

variables (M : matrix n n ℂ)

def Coe (M : matrix m n ℝ) := (M : matrix m n ℂ)

-- Defining the complex conjugate of a complex matrix
section mat_conj

def mat_conj (x : matrix m n ℂ) : matrix m n ℂ := λ i: m, (λ j : n, conj (x i j))

-- (M*)* = M
lemma mat_conj_conj_eq_mat (x : matrix m n ℂ) :
  mat_conj (mat_conj x) = x :=
by { ext, unfold mat_conj, simp, unfold mat_conj, simp, }

-- (μ • M)* = μ* • M*
lemma mat_conj_smul (μ : ℂ) (x : matrix n n ℂ) :
  mat_conj (μ • x) = (conj μ) • (mat_conj x) :=
by { ext ; simp only [mat_conj, algebra.id.smul_eq_mul, pi.smul_apply, ring_hom.map_mul] }

-- (A ⬝ x)* = A* ⬝ x*
lemma vec_conj_mul_vec [decidable_eq n] [nonempty n] (A : matrix m n ℂ) (x : n → ℂ) :
  vec_conj ((A : matrix m n ℂ).mul_vec x) = (mat_conj A : matrix m n ℂ).mul_vec (vec_conj x) :=
begin
  ext,
  simp only [mat_conj, vec_conj, mul_vec, dot_product, conj_re, coe_matrix_coe_elem, sum_complex_re, mul_re, of_real_im, zero_mul],
  simp only [mat_conj, vec_conj, mul_vec, dot_product, conj_im, coe_matrix_coe_elem, sum_complex_im, mul_im, add_zero, of_real_im,
    zero_mul, sum_neg_distrib, mul_neg_eq_neg_mul_symm],
    sorry
end

lemma vec_norm_sq_zero {x : n → ℂ} (H_dot : dot_product (vec_conj x) x = 0) : x = 0 :=
begin
  unfold dot_product at H_dot,
  simp only [vec_conj, mul_comm, mul_conj, complex.ext_iff, sum_complex_re, zero_re, of_real_re] at H_dot,
  cases H_dot with H_re H_im,
  have key : ∑ i in (univ : finset n), norm_sq (x i) = 0 ↔ ∀ i ∈ (univ : finset n), norm_sq(x i) = 0,
  { apply sum_eq_zero_iff_of_nonneg, intros i h_univ, exact norm_sq_nonneg (x i) },
  simp only [forall_prop_of_true, mem_univ, monoid_with_zero_hom.map_eq_zero] at key,
  rw key at H_re,
  ext i;
  { specialize H_re i, simp only [H_re, pi.zero_apply] }
end

lemma coe_vec_re (x : n → ℂ) {i : n} : (vec_re x : n → ℂ) i = ((x i).re : ℂ) :=
by simpa only [vec_re]

lemma vec_add_conj_eq_two_re (x : n → ℂ) : x + vec_conj x = (2 : ℂ) • (vec_re x : n → ℂ) :=
begin
  ext,
  { simp [vec_conj, coe_vec_re x], linarith },
  { simp [vec_conj, coe_vec_re x] }
end

lemma vec_conj_add_zero {x : n → ℂ} (H : x + vec_conj x = 0) : vec_re x = 0 :=
begin
  rw [vec_add_conj_eq_two_re, smul_eq_zero] at H,
  cases H with H_20 H_x,
  { exfalso, simp at H_20, assumption }, -- 2 = 0
  { rw function.funext_iff at H_x,
    ext i,
    specialize H_x i,
    rw coe_vec_re at H_x,
    simp only [of_real_eq_zero, pi.zero_apply] at H_x,
    simp only [vec_re, H_x, pi.zero_apply] }
end

end mat_conj

/--
## Matrix definitions
Let `M` be a square real matrix. An `eigenvector` of `M` is a complex vector `x` with `M ⬝ x = μ • x`
for some `μ ∈ ℂ`, which is called the `eigenvalue` of `M` corresponding to the `eigenvector x`.
-/
def has_eigenpair (μ : ℂ) (x : n → ℂ) : Prop :=
  x ≠ 0 ∧ (mul_vec M x = μ • x)

def has_eigenvector (x : n → ℂ) : Prop :=
  ∃ μ : ℂ, M.has_eigenpair μ x

def has_eigenvalue (μ : ℂ) : Prop :=
  ∃ x : n → ℂ, M.has_eigenpair μ x

def herm_matrix : Prop := M = mat_conj Mᵀ

-- ## Matrix : Helping lemmas

-- (↑M)ᵀ = ↑Mᵀ
lemma coe_transpose_matrix : (M.Coe)ᵀ = (Mᵀ).Coe := by { unfold Coe,}

-- -M i j = -(M i j)
lemma neg_matrix_neg_elem (i j : n) : (-M) i j = -(M i j) := by exact rfl

-- ↑M i j = ↑(M i j)
lemma coe_matrix_coe_elem (i j : n) : (M) i j = (M i j) := by exact rfl

-- (M x)* = M* x*
lemma vec_conj_mul_vec (x : n → ℂ) :
  vec_conj (mul_vec M x) = mul_vec (mat_conj M) (vec_conj x) :=
begin
  ext ;
  simp only [vec_conj, mat_conj, mul_vec, dot_product],
  {simp  [sum_complex_re, of_real_im, zero_mul, conj_re, mul_re]},
  simp [sum_complex_im, add_zero, of_real_im, zero_mul,
      conj_im, mul_im,conj_re, mul_re,sum_neg_distrib, mul_neg_eq_neg_mul_symm, neg_matrix_neg_elem],
end

-- (⇑conj (∑ (i : n), ↑(M x_1 i) * x i)).im = (∑ (i : n), ↑(M x_1 i) * ⇑conj (x i)).im

lemma herm_matrix_coe (H_herm : herm_matrix M) : (M) = mat_conj (M)ᵀ :=
begin
  unfold herm_matrix at H_herm,
  exact H_herm,
end

-- vᵀ (M w) = (vᵀ M)ᵀ w
lemma dot_product_mul_vec_vec_mul (v w : n → ℂ) :
  dot_product v (mul_vec M.Coe w) = dot_product (vec_mul v M.Coe) w :=
begin
  have key : vec_mul v M.Coe = λ j, dot_product v (λ i, M.Coe i j),
  { ext ; unfold vec_mul },
  rw [key, dot_product_assoc v w M.Coe],
  ext ; simp only [dot_product, mul_vec],
end

-- 1. If x is an eigenvector of M, then a • x is an eigenvector of M, for any non-zero a : ℂ.
theorem has_eigenvector_smul (a : ℂ) (x : n → ℂ) (H_na : a ≠ 0) (H_eigenvector : has_eigenvector M x) :
  has_eigenvector M (a • x) :=
begin
  rcases H_eigenvector with ⟨μ, ⟨H_nx, H_mul⟩⟩,
  use μ, -- corresponding eigenvalue μ
  split,
  { intro hyp, rw smul_eq_zero at hyp, tauto }, -- a • x ≠ 0
  calc (M).mul_vec (a • x)
      = a • M.mul_vec x : -- M ⬝ (a • x) = a • (M ⬝ x)
  by { rw mul_vec_smul_assoc }
  ... = a • (μ • x) :                 -- ... = a • (μ • x)
  by { rw H_mul }
  ... = μ • (a • x) :                 -- ... = μ • (a • x)
  by { simp only [smul_smul, mul_comm] }
end

-- 2. If there are two eigenvectors that have the same correspoding eigenvalue μ,
-- then any non-zero linear combination of them is also an eigenvector with the same eigenvalue μ.
theorem has_eigenpair_linear (a b : ℂ) (v w : n → ℂ) (μ : ℂ) (H_ne : a • v + b • w ≠ 0)
(H₁ : has_eigenpair M μ v) (H₂ : has_eigenpair M μ w) : has_eigenpair M μ (a • v + b • w) :=
begin
  rcases H₁ with ⟨H₁₁, H₁₂⟩,
  rcases H₂ with ⟨H₂₁, H₂₂⟩,
  use H_ne, -- a • v + b • w ≠ 0
  calc M.mul_vec (a • v + b • w) -- M ⬝ (a • v + b • w) = M ⬝ (a • v) + M ⬝ (b • w)
      = M.mul_vec(a • v) + M.mul_vec(b • w) :
  by { ext ; simp only [mul_vec, pi.add_apply, dot_product_add] }
  ... = a • M.mul_vec v + b • M.mul_vec w :  -- ... = a • (M ⬝ v) + b • (M ⬝ w)
  by { ext ; simp only [mul_vec, algebra.id.smul_eq_mul,
                        dot_product_smul, pi.add_apply, pi.smul_apply] }
  ... = a • (μ • v) + b • (μ • w) :                  -- ... = a • (μ • v) + b • (μ • w)
  by { rw [H₁₂, H₂₂] }
  ... = μ • (a • v + b • w) :                        -- ... = μ • (a • v + b • w)
  by { simp only [smul_smul, mul_comm, smul_add] }
end

-- 3. All eigenvalues of a symmetric real matrix M are real.
theorem herm_matrix_real_eigenvalues (H_herm : herm_matrix M) :
  ∀ (μ : ℂ), has_eigenvalue M μ → μ.im = 0 :=
begin
  -- (1) M ⬝ x = μ • x
  rintro μ ⟨x, ⟨H_x, H_eq₁⟩⟩,
  -- (2) M ⬝ x* = μ* • x*
  have H_eq₂ : mul_vec (mat_conj M) (vec_conj x) = (conj μ) • (vec_conj x),
  {
    rw ← vec_conj_smul μ x,
    -- vec_conj (mul_vec M x) = mul_vec (mat_conj M) (vec_conj x)
    have hyp : mat_conj (mat_conj M) = M := mat_conj_conj_eq_mat M,
    -- rw ← hyp,
    rw ← M.vec_conj_mul_vec x,
    rw ← H_eq₁,
    -- rw [← vec_conj_smul μ x, ← M.vec_conj_mul_vec x, H_eq₁]
   },
  -- (3) μ ((x)ᵀ x*) = μ* ((x)ᵀ x*)
  have H_eq₃ : μ * (dot_product x (vec_conj x)) = conj μ * dot_product x (vec_conj x),

  calc μ * dot_product  x (vec_conj x)
      = dot_product  (μ • x) (vec_conj x):    -- μ ((x)ᵀ x*) = (μ x)ᵀ (x*)
      by {
        refine eq.symm _,
        rw smul_dot_product μ  x (vec_conj x),
        simp [dot_product, vec_conj, ← mul_assoc, mul_comm],
      }
  -- by {
  --   -- sorry
  -- rw ← smul_dot_product μ (vec_conj x) x,
  --     --  simp [dot_product, vec_conj, ← mul_assoc, mul_comm]
  --     sorry
  -- }
  ... = dot_product (M.mul_vec x) (vec_conj x)  :  -- ... = (Mx)ᵀ (x*)
  by { rw ← H_eq₁ }
  ... = dot_product (M.Coe.mul_vec x) (vec_conj x)  :  -- ... = (Mx)ᵀ (x*)
  by { unfold Coe, }
  ... = dot_product  x (M.Coeᵀ.vec_mul (vec_conj x)) :  -- ... = (xᵀ Mᵀ)x*)
  by { exact (dot_product_assoc x (vec_conj x) M.Coe).symm }
  ... = dot_product (M.Coeᵀ.mul_vec (vec_conj x)) x : -- ... = (Mᵀ x*)ᵀ x
  by { rw ← mul_vec_transpose M.Coe (vec_conj x) }
  ... = dot_product (M.Coe.mul_vec (vec_conj x)) x :  -- ... = (M x*)ᵀ x
  by { sorry
    -- have H : M.Coe = M.Coeᵀ, {
    -- unfold Coe, tidy }, rw ← H
    }
  ... = dot_product (conj μ • vec_conj x) x :         -- ... = (μ* x*)ᵀ x
  by { rw H_eq₂ }
  ... = conj μ * dot_product (vec_conj x) x :         -- ... = μ* ((x*)ᵀ x)
  by {
    sorry
    -- rw ← smul_dot_product (conj μ) (vec_conj x) x
    },

  -- (4) (μ - μ*) ((x*)ᵀ x) = 0
  have H_eq₄ : (μ - conj μ) * dot_product (vec_conj x) x = 0,
  { rw sub_mul, simp only [H_eq₃, sub_self] },
  -- μ - μ* = 0 ∨ (x*)ᵀ x = 0
  rw mul_eq_zero at H_eq₄,
  cases H_eq₄ with H_μ H_prod,
  { rw [sub_eq_zero, eq_comm, eq_conj_iff_real] at H_μ,
    cases H_μ with r H_r,
    rw [H_r, of_real_im] }, -- μ - μ* = 0
  { exfalso,
    exact H_x (vec_norm_sq_zero H_prod) }, -- (x*)ᵀ x = 0
end

-- 4. For every real eigenvalue of a symmetric matrix M, there exists a corresponding real-valued eigenvector.
theorem symm_matrix_real_eigenvectors (H_symm : symm_matrix M) (μ : ℂ) (H_eigenvalue : has_eigenvalue M μ) :
  ∃ x : n → ℂ, has_eigenpair M μ x ∧ vec_im x = 0 :=
begin
  -- We know that μ ∈ ℝ from before.
  have H_μ : μ.im = 0,
  { apply M.symm_matrix_real_eigenvalues H_symm μ H_eigenvalue },
  rcases H_eigenvalue with ⟨x, ⟨H_nx, H_mul⟩⟩,
  by_cases H_re : vec_re x = 0,
  -- 1) I • x will be used
  { use (I • x),
    split,
    -- 1.1) I • x is an eigenvector
    { split,
      -- 1.1.1) I • x ≠ 0
      { intro hyp, rw smul_eq_zero at hyp,
        have H_nI : I ≠ 0, { exact I_ne_zero },
        tauto },
      -- 1.1.2) M (I • x) = μ • (I • x)
      { simp only [mul_vec_smul_assoc, H_mul, smul_smul, mul_comm] } },
    -- 1.2) I • x ∈ ℝⁿ
    { ext i,
      simp only [vec_re, vec_eq_unfold] at H_re,
      simp only [vec_im, algebra.id.smul_eq_mul, I_re, one_mul,
                 I_im, zero_mul, mul_im, zero_add, pi.smul_apply],
      exact H_re i } },
  -- 2) x + x* will be used
  { use (x + vec_conj x),
    split,
    -- 2.1) x + x* is an eigenvector
    { split,
      -- 2.1.1) x + x* ≠ 0
      { intro hyp, exact H_re (vec_conj_add_zero hyp) },
      -- 2.1.2) M (x + x*) = μ • (x + x*)
      { calc M.Coe.mul_vec (x + vec_conj x)
            = M.Coe.mul_vec x + M.Coe.mul_vec (vec_conj x) :
        by { apply mul_vec_add } -- M (x + x*) = M x + M x*
        ... = M.Coe.mul_vec x + vec_conj (M.Coe.mul_vec x) :
        by { rw ← M.vec_conj_mul_vec_re x }     -- ... = M x + (M x)*
        ... = μ • x + vec_conj (μ • x) :
        by { rw H_mul }                         -- ... = μ • x + (μ • x)*
        ... = μ • x + (conj μ) • (vec_conj x) :
        by { rw vec_conj_smul }                 -- ... = μ • x + μ* • x*
        ... = μ • x + μ • (vec_conj x) :
        by { rw conj_of_zero_im H_μ }           -- ... = μ • x + μ • x*
        ... = μ • (x + vec_conj x) :
        by { simp only [smul_add] } } },        -- ... = μ • (x + x*)
    -- 2.2) x + x* ∈ ℝⁿ
    { ext, simp [vec_add_conj_eq_two_re, vec_im, coe_vec_re] } }
end

-- 5. If v and w are eigenvectors of a symmetric matrix M with different eigenvalues, then v and w are orthogonal.
theorem dot_product_neq_eigenvalue_zero (H_symm : symm_matrix M) (v w : n → ℂ) (μ μ' : ℂ)
(H_ne : μ ≠ μ') (H₁ : has_eigenpair M μ v) (H₂ : has_eigenpair M μ' w) : dot_product v w = 0 :=
begin
  have key : (μ - μ') * dot_product v w = 0,
  calc (μ - μ') * dot_product v w
      = μ * dot_product v w - μ' * dot_product v w :
  by { apply mul_sub_right_distrib }-- (μ - μ')vᵀ w = μ(vᵀ w) - μ'(vᵀ w)
  ... = dot_product (μ • v) w - dot_product v (μ' • w) :
  by { sorry
    -- simp only [dot_product_smul,
  --      smul_dot_product]
  }                   -- ... = (μ • v)ᵀw - vᵀ(μ' • w)
  ... = dot_product (M.Coe.mul_vec v) w - dot_product v (M.Coe.mul_vec w) :
  by { rw [H₁.2, H₂.2] }                     -- ... = (M v)ᵀw - vᵀ(M w)
  ... = dot_product (M.Coe.mul_vec v) w - dot_product (vec_mul v M.Coe) w :
  by { rw M.dot_product_mul_vec_vec_mul v w }-- ... = (M v)ᵀw - (vᵀ M)ᵀw
  ... = dot_product (M.Coe.mul_vec v) w - dot_product (vec_mul v M.Coeᵀ) w:
  by { rw ← symm_matrix_coe M H_symm }  -- ... = (M v)ᵀw - (vᵀ Mᵀ)ᵀw
  ... = dot_product (M.Coe.mul_vec v) w - dot_product (mul_vec M.Coe v) w :
  by { rw ← vec_mul_transpose M.Coe v }       -- ... = (M v)ᵀw - (M v)ᵀw
  ... = 0 :
  by { simp only [sub_self] },               -- ... = 0
  rw mul_eq_zero at key,
  cases key with H_μ H_dot,
  { exfalso, rw sub_eq_zero at H_μ, exact H_ne H_μ }, -- μ - μ' = 0
  { exact H_dot } -- vᵀ w = 0
end

-- TODOs :
-- 1. positive semidefinite matrices
-- 2. eigenvalues = roots of characteristic polynomial (char_poly)
-- 3. eigendecomposition of a diagonalizable matrix

end matrix


import data.nat.basic
import data.nat.modeq
import data.nat.prime
import data.nat.totient
import field_theory.finite.basic

variables (a b c d n : ℕ)

-- Helpers for proof
lemma mod_pow_mod : ((a % n) ^ b) % n = (a ^ b) % n :=
begin
  -- Use either change here or write MOD form directly as goal
  change (a % n) ^ b ≡ (a ^ b) [MOD n],
  apply nat.modeq.pow,
  exact nat.mod_modeq _ _,
end

lemma mul_mod_right_distrib : (a * b) % n = ((a % n) * (b % n)) % n :=
begin
  change (a * b) ≡ a % n * (b % n) [MOD n],
  apply nat.modeq.mul,
  repeat {apply nat.modeq.symm, exact nat.mod_modeq _ _},
end

variables (msg pub_e p q priv : ℕ)

-- Encryption
def enc : ℕ := (msg ^ pub_e) % (p * q)

-- Decryption
def dec (enc : ℕ) : ℕ := (enc ^ priv) % (p * q)

lemma mul_coprime_or_coprime_and
  (prime_p : p.prime)
  (prime_q : q.prime)
  (diff_pq : p ≠ q)
  : (p.coprime msg ∧ q.coprime msg) ∨ (¬p.coprime msg ∨ ¬q.coprime msg) :=
begin
  by_cases h : (p * q).coprime msg,
  { left,
    exact ⟨nat.coprime.coprime_mul_right h, nat.coprime.coprime_mul_left h⟩,
  },
  {
    right,
    rw nat.prime.not_coprime_iff_dvd at h,
    cases h with k ncp,
    cases ncp with prime_k ncp,
    cases ncp with k_dvd_pq k_dvd_msg,
    rw nat.prime.dvd_mul prime_k at k_dvd_pq,
    cases k_dvd_pq with k_dvd_p k_dvd_q,
    -- TODO use meta tactics to combine these two similar parts
    { rw nat.dvd_prime prime_p at k_dvd_p,
      cases k_dvd_p with k_one k_p,
      { have k_ne_one : k ≠ 1 := nat.prime.ne_one prime_k,
        exact absurd k_one k_ne_one,
      },
      { rw k_p at k_dvd_msg,
        left,
        rw ←nat.prime.dvd_iff_not_coprime prime_p,
        assumption,
      },
    },
    { rw nat.dvd_prime prime_q at k_dvd_q,
      cases k_dvd_q with k_one k_q,
      { have k_ne_one : k ≠ 1 := nat.prime.ne_one prime_k,
        exact absurd k_one k_ne_one,
      },
      { rw k_q at k_dvd_msg,
        right,
        rw ←nat.prime.dvd_iff_not_coprime prime_q,
        assumption,
      },
    },
  },
end

theorem dec_undoes_enc
-- These are the picking requirements
  (prime_p : p.prime)
  (prime_q : q.prime)
  (diff_pq : p ≠ q)
  (one_lt_pub_e : 1 < pub_e)
  (msg_lt_pq : msg < (p * q))
  (pub_e_lt_totient : pub_e < (p * q).totient)
  (pub_e_coprime_totient : pub_e * priv ≡ 1 [MOD (p * q).totient])
  (h : (p * q).coprime msg ∨ ¬(p * q).coprime msg)
  : msg = dec p q priv (enc msg pub_e p q) :=
begin
  have msg_coprime_or_not := mul_coprime_or_coprime_and msg _ _ prime_p prime_q diff_pq,
  rw [enc, dec, mod_pow_mod, ←pow_mul],
  have msg_zero_or_gt : 0 = msg ∨ 0 < msg
    := nat.eq_or_lt_of_le (nat.zero_le msg),
  rw nat.modeq.comm at pub_e_coprime_totient,
  have one_le_mul_pub_e_priv : 1 ≤ pub_e * priv
    := begin
       apply nat.modeq.le_of_lt_add pub_e_coprime_totient _,
       apply nat.lt_add_left,
       exact nat.lt_trans one_lt_pub_e pub_e_lt_totient,
    end,
  cases msg_zero_or_gt with eq_zero gt_zero,
  { rw [←eq_zero, zero_pow one_le_mul_pub_e_priv],
    simp },
  { conv
    begin
      to_lhs,
      rw ←nat.mod_eq_of_lt msg_lt_pq,
    end,
    have p_coprime_q : p.coprime q
      := (nat.coprime_primes prime_p prime_q).mpr diff_pq,
    rw [←nat.modeq, ←nat.modeq_and_modeq_iff_modeq_mul p_coprime_q],
    split,
    all_goals { rw nat.modeq_iff_dvd' one_le_mul_pub_e_priv at pub_e_coprime_totient,
      cases pub_e_coprime_totient with k h₁,
      have h₂ : (pub_e * priv - 1).succ = ((p * q).totient * k).succ
        := congr_arg nat.succ h₁,
      rw [nat.sub_one,
         nat.succ_pred_eq_of_pos (nat.lt_of_succ_le one_le_mul_pub_e_priv)]
         at h₂,
      rw h₂,
      rw [pow_succ,
        pow_mul,
        nat.modeq, mul_mod_right_distrib,
        ←mod_pow_mod],
    },
    show msg % q = msg % q * ((msg ^ (p * q).totient % q) ^ k % q) % q,
    rw mul_comm p,
    show msg % p = msg % p * ((msg ^ (p * q).totient % p) ^ k % p) % p,
    all_goals {
      cases msg_coprime_or_not with coprime ncoprime,
      { rw [nat.totient_mul p_coprime_q,
           pow_mul,
           ←mod_pow_mod _ q.totient]
        <|> rw [nat.totient_mul (nat.coprime.symm p_coprime_q),
               pow_mul,
               ←mod_pow_mod _ p.totient],
        have h₃ := nat.modeq.pow_totient,
        rw nat.modeq at h₃,
        rw h₃ (nat.coprime.symm coprime.1)
        <|> rw h₃ (nat.coprime.symm coprime.2),
        repeat {rw nat.mod_eq_of_lt (nat.prime.one_lt prime_p)
                <|> rw nat.mod_eq_of_lt (nat.prime.one_lt prime_q)
                <|> rw one_pow},
        simp,
      },
    },
    -- TODO use meta tactics to combine these two similar parts
    { cases ncoprime with np nq,
      { rw [nat.totient_mul p_coprime_q,
           pow_mul,
           ←mod_pow_mod _ q.totient],
        rw ←nat.prime.dvd_iff_not_coprime prime_p at np,
        rw [←nat.modeq_zero_iff_dvd, nat.modeq] at np,
        rw [mul_mod_right_distrib, np],
        simp,
      },
      { have msg_coprime_p : msg.coprime p := begin
          rw [nat.coprime_comm, nat.prime.coprime_iff_not_dvd prime_p],
          rw ←nat.prime.dvd_iff_not_coprime prime_q at nq,
          exact begin
            intro p_dvd_msg,
            have pq_dvd_msg
              := nat.prime.dvd_mul_of_dvd_ne
                 diff_pq prime_p prime_q p_dvd_msg nq,
            have pq_not_dvd_msg
              := nat.not_dvd_of_pos_of_lt gt_zero msg_lt_pq,
            exact absurd pq_dvd_msg pq_not_dvd_msg,
          end,
        end,
        rw [nat.totient_mul p_coprime_q,
          pow_mul,
          ←mod_pow_mod _ q.totient],
        have h₃ := nat.modeq.pow_totient,
        rw nat.modeq at h₃,
        rw h₃ msg_coprime_p,
        repeat {rw nat.mod_eq_of_lt (nat.prime.one_lt prime_p)
          <|> rw one_pow},
        simp,
      },
    },
    { cases ncoprime with np nq,
      { have msg_coprime_q : msg.coprime q := begin
          rw [nat.coprime_comm, nat.prime.coprime_iff_not_dvd prime_q],
          rw ←nat.prime.dvd_iff_not_coprime prime_p at np,
          exact begin
            intro q_dvd_msg,
            have pq_dvd_msg
              := nat.prime.dvd_mul_of_dvd_ne
                 diff_pq prime_p prime_q np q_dvd_msg,
            have pq_not_dvd_msg
              := nat.not_dvd_of_pos_of_lt gt_zero msg_lt_pq,
            exact absurd pq_dvd_msg pq_not_dvd_msg,
          end,
        end,
        rw [nat.totient_mul (nat.coprime.symm p_coprime_q),
          pow_mul,
          ←mod_pow_mod _ p.totient],
        have h₃ := nat.modeq.pow_totient,
        rw nat.modeq at h₃,
        rw h₃ msg_coprime_q,
        repeat {rw nat.mod_eq_of_lt (nat.prime.one_lt prime_q)
          <|> rw one_pow},
        simp,
      },
      { rw [nat.totient_mul (nat.coprime.symm p_coprime_q),
           pow_mul,
           ←mod_pow_mod _ p.totient],
        rw ←nat.prime.dvd_iff_not_coprime prime_q at nq,
        rw [←nat.modeq_zero_iff_dvd, nat.modeq] at nq,
        rw [mul_mod_right_distrib, nq],
        simp,
      },
    },
  },
end


/-
Copyright (c) 2021 Jireh Loreaux. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jireh Loreaux
-/
import algebra.algebra.spectrum
import analysis.calculus.deriv
/-!
# The spectrum of elements in a complete normed algebra

This file contains the basic theory for the resolvent and spectrum of a Banach algebra.

## Main definitions

* `spectral_radius : ℝ≥0∞`: supremum of `∥k∥₊` for all `k ∈ spectrum 𝕜 a`

## Main statements

* `spectrum.is_open_resolvent_set`: the resolvent set is open.
* `spectrum.is_closed`: the spectrum is closed.
* `spectrum.subset_closed_ball_norm`: the spectrum is a subset of closed disk of radius
  equal to the norm.
* `spectrum.is_compact`: the spectrum is compact.
* `spectrum.spectral_radius_le_nnnorm`: the spectral radius is bounded above by the norm.
* `spectrum.has_deriv_at_resolvent`: the resolvent function is differentiable on the resolvent set.

## TODO

* after we have Liouville's theorem, prove that the spectrum is nonempty when the
  scalar field is ℂ.
* compute all derivatives of `resolvent a`.

-/

open_locale ennreal

/-- The *spectral radius* is the supremum of the `nnnorm` (`∥⬝∥₊`) of elements in the spectrum,
    coerced into an element of `ℝ≥0∞`. Note that it is possible for `spectrum 𝕜 a = ∅`. In this
    case, `spectral_radius a = 0`.  It is also possible that `spectrum 𝕜 a` be unbounded (though
    not for Banach algebras, see `spectrum.is_bounded`, below).  In this case,
    `spectral_radius a = ∞`. -/
noncomputable def spectral_radius (𝕜 : Type*) {A : Type*} [normed_field 𝕜] [ring A]
  [algebra 𝕜 A] (a : A) : ℝ≥0∞ :=
⨆ k ∈ spectrum 𝕜 a, ∥k∥₊

namespace spectrum

section spectrum_compact

variables {𝕜 : Type*} {A : Type*}
variables [normed_field 𝕜] [normed_ring A] [normed_algebra 𝕜 A] [complete_space A]

local notation `σ` := spectrum 𝕜
local notation `ρ` := resolvent_set 𝕜
local notation `↑ₐ` := algebra_map 𝕜 A

lemma is_open_resolvent_set (a : A) : is_open (ρ a) :=
units.is_open.preimage ((algebra_map_isometry 𝕜 A).continuous.sub continuous_const)

lemma is_closed (a : A) : is_closed (σ a) :=
(is_open_resolvent_set a).is_closed_compl

lemma mem_resolvent_of_norm_lt {a : A} {k : 𝕜} (h : ∥a∥ < ∥k∥) :
  k ∈ ρ a :=
begin
  rw [resolvent_set, set.mem_set_of_eq, algebra.algebra_map_eq_smul_one],
  have hk : k ≠ 0 := ne_zero_of_norm_pos (by linarith [norm_nonneg a]),
  let ku := units.map (↑ₐ).to_monoid_hom (units.mk0 k hk),
  have hku : ∥-a∥ < ∥(↑ku⁻¹:A)∥⁻¹ := by simpa [ku, algebra_map_isometry] using h,
  simpa [ku, sub_eq_add_neg, algebra.algebra_map_eq_smul_one] using (ku.add (-a) hku).is_unit,
end

lemma norm_le_norm_of_mem {a : A} {k : 𝕜} (hk : k ∈ σ a) :
  ∥k∥ ≤ ∥a∥ :=
le_of_not_lt $ mt mem_resolvent_of_norm_lt hk

lemma subset_closed_ball_norm (a : A) :
  σ a ⊆ metric.closed_ball (0 : 𝕜) (∥a∥) :=
λ k hk, by simp [norm_le_norm_of_mem hk]

lemma is_bounded (a : A) : metric.bounded (σ a) :=
(metric.bounded_iff_subset_ball 0).mpr ⟨∥a∥, subset_closed_ball_norm a⟩

theorem is_compact [proper_space 𝕜] (a : A) : is_compact (σ a) :=
metric.is_compact_of_is_closed_bounded (is_closed a) (is_bounded a)

theorem spectral_radius_le_nnnorm (a : A) :
  spectral_radius 𝕜 a ≤ ∥a∥₊ :=
begin
  suffices h : ∀ k ∈ σ a, (∥k∥₊ : ℝ≥0∞) ≤ ∥a∥₊,
  { exact bsupr_le h, },
  { by_cases ha : (σ a).nonempty,
    { intros _ hk,
      exact_mod_cast norm_le_norm_of_mem hk },
    { rw set.not_nonempty_iff_eq_empty at ha,
      simp [ha, set.ball_empty_iff] } }
end

end spectrum_compact

section resolvent_deriv

variables {𝕜 : Type*} {A : Type*}
variables [nondiscrete_normed_field 𝕜] [normed_ring A] [normed_algebra 𝕜 A] [complete_space A]

local notation `ρ` := resolvent_set 𝕜
local notation `↑ₐ` := algebra_map 𝕜 A

theorem has_deriv_at_resolvent {a : A} {k : 𝕜} (hk : k ∈ ρ a) :
  has_deriv_at (resolvent a) (-(resolvent a k) ^ 2) k :=
begin
  have H₁ : has_fderiv_at ring.inverse _ (↑ₐk - a) := has_fderiv_at_ring_inverse hk.unit,
  have H₂ : has_deriv_at (λ k, ↑ₐk - a) 1 k,
  { simpa using (algebra.linear_map 𝕜 A).has_deriv_at.sub_const a },
  simpa [resolvent, sq, hk.unit_spec, ← ring.inverse_unit hk.unit] using H₁.comp_has_deriv_at k H₂,
end

end resolvent_deriv

end spectrum


import data.real.basic
import data.matrix.basic
import linear_algebra.basic
import linear_algebra.linear_independent
import linear_algebra.matrix.to_lin
import linear_algebra.unitary_group
import analysis.normed_space.basic
import analysis.inner_product_space.euclidean_dist

variables {n d : ℕ} (U : matrix (fin d) (fin n) ℝ)

open_locale big_operators matrix

def outer (v : fin d → ℝ) (u : fin d → ℝ) : matrix (fin d) (fin d) ℝ :=
λ i j, (v i) * (u j)

def outers (U : matrix (fin d) (fin n) ℝ) : matrix (fin d) (fin d) ℝ :=
  ∑ i : fin n, outer (Uᵀ i) (Uᵀ i)

@[simp]
lemma outer_smul_outer (v : fin d → ℝ) (u : fin d → ℝ) (c : ℝ) : outer (c • u) v = c • outer u v := sorry

@[simp]
lemma outer_outer_smul (v : fin d → ℝ) (u : fin d → ℝ) (c : ℝ) : outer u (c • v) = c • outer u v := sorry

@[simp]
lemma outers_smul (U : matrix (fin d) (fin n) ℝ) (c : ℝ) : outers (c • U) = c^2 • outers U := sorry

def norm_columns (U : matrix (fin d) (fin n) ℝ) : matrix (fin d) (fin n) ℝ := sorry

lemma norm_columns_apply_sq (U : matrix (fin d) (fin n) ℝ) : ∀ j : (fin n), ∥ to_euclidean ((norm_columns U)ᵀ j) ∥^2 = 1  := sorry

lemma norm_columns_apply (U : matrix (fin d) (fin n) ℝ) : ∀ j : (fin n), ∥ to_euclidean ((norm_columns U)ᵀ j) ∥ = 1  := sorry

def radial_isotropic (U : matrix (fin d) (fin n) ℝ) : Prop := outers (norm_columns U) = (n / d  : ℝ) • 1

lemma orthogonal_radial_isotropic_radial_isotropic (U : matrix (fin d) (fin n) ℝ)
  (O : matrix (fin d) (fin d) ℝ) (hO : O ∈ @matrix.orthogonal_group (fin d) _ _ ℝ _) :
  radial_isotropic (O ⬝ U) :=
begin
  sorry,
end

def make_radial_isotropic (U : matrix (fin d) (fin n) ℝ)
  (hU : ∀ f : (fin d) → (fin n), function.injective f →
  linear_independent ℝ (λ i : fin d, Uᵀ (f i))) :
    matrix (fin d) (fin d) ℝ :=
begin
  sorry
end

theorem make_radial_isotropic_apply (U : matrix (fin d) (fin n) ℝ)
  (hU : ∀ f : (fin d) → (fin n), function.injective f →
  linear_independent ℝ (λ i : fin d, Uᵀ (f i))) :
    radial_isotropic (make_radial_isotropic U hU ⬝ U) :=
begin
  sorry
end


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

/-!
# Girard's paradox

Girard's paradox is a proof that `Type : Type` entails a contradiction. We can't say this directly
in Lean because `Type : Type 1` and it's not possible to give `Type` a different type via an axiom,
so instead we axiomatize the behavior of the Pi type and application if the typing rule for Pi was
`(Type → Type) → Type` instead of `(Type → Type) → Type 1`.

Furthermore, we don't actually want false axioms in mathlib, so rather than introducing the axioms
using `axiom` or `constant` declarations, we take them as assumptions to the `girard` theorem.

Based on Watkins' LF implementation of Hurkens' simplification of Girard's paradox:
<http://www.cs.cmu.edu/~kw/research/hurkens95tlca.elf>.

## Main statements

* `girard`: there are no Girard universes.
-/

/-- Girard's paradox: there are no universes `u` such that `Type u : Type u`.
Since we can't actually change the type of Lean's `Π` operator, we assume the existence of
`pi`, `lam`, `app` and the `beta` rule equivalent to the `Π` and `app` constructors of type theory.
-/
theorem {u} girard
  (pi : (Type u → Type u) → Type u)
  (lam : ∀ {A : Type u → Type u}, (∀ x, A x) → pi A)
  (app : ∀ {A}, pi A → ∀ x, A x)
  (beta : ∀ {A : Type u → Type u} (f : ∀ x, A x) (x), app (lam f) x = f x) : false :=
let F (X) := (set (set X) → X) → set (set X), U := pi F in
let G (T : set (set U)) (X) : F X := λ f, {p | {x : U | f (app x X f) ∈ p} ∈ T} in
let τ (T : set (set U)) : U := lam (G T) in
let σ (S : U) : set (set U) := app S U τ in
have στ : ∀ {s S}, s ∈ σ (τ S) ↔ {x | τ (σ x) ∈ s} ∈ S := λ s S,
  iff_of_eq (congr_arg (λ f : F U, s ∈ f τ) (beta (G S) U) : _),
let ω : set (set U) := {p | ∀ x, p ∈ σ x → x ∈ p} in
let δ (S : set (set U)) := ∀ p, p ∈ S → τ S ∈ p in
have δ ω := λ p d, d (τ ω) $ στ.2 $ λ x h, d (τ (σ x)) (στ.2 h),
this {y | ¬ δ (σ y)} (λ x e f, f _ e (λ p h, f _ (στ.1 h))) (λ p h, this _ (στ.1 h))


import topology.instances.real
import analysis.normed_space.banach_steinhaus

open set filter
open_locale topological_space filter

/- TEXT:
.. index:: topological space

.. _topological_spaces:

Topological spaces
------------------

Fundamentals
^^^^^^^^^^^^

We now go up in generality and introduce topological spaces. We will review the two main ways to define
topological spaces and then explain how the category of topological spaces is much better behaved than
the category of metric spaces. Note that we won't be using mathlib category theory here, only having
a somewhat categorical point of view.

The first way to think about the transition from metric spaces to topological spaces is that we only
remember the notion of open sets (or equivalently the notion of closed sets). From this point of view,
a topological space is a type equipped with a collection of sets that are called open sets. This collection
has to satisfy a number of axioms presented below (this collection is slighly redundant but we will ignore that).

BOTH: -/

-- QUOTE:
section

variables {X : Type*} [topological_space X]

example : is_open (univ : set X) := is_open_univ

example : is_open (∅ : set X) := is_open_empty

example {ι : Type*} {s : ι → set X} (hs : ∀ i, is_open $ s i) :
  is_open (⋃ i, s i) :=
is_open_Union hs

example {ι : Type*} [fintype ι] {s : ι → set X} (hs : ∀ i, is_open $ s i) :
  is_open (⋂ i, s i) :=
is_open_Inter hs

-- QUOTE.

/- TEXT:

Closed sets are then defined as sets whose complement  is open. A function between topological spaces
is (globally) continuous if all preimages of open sets are open.
BOTH: -/

-- QUOTE:
variables {Y : Type*} [topological_space Y]

example {f : X → Y} : continuous f ↔ ∀ s, is_open s → is_open (f ⁻¹' s) :=
continuous_def

-- QUOTE.

/- TEXT:
With this definition we already see that, compared to metric spaces, topological spaces only remember
enough information to talk about continuous functions: two topological structures on a type are
the same if and only if they have the same continuous functions (indeed the identity function will
be continuous in both direction if and only if the two structures have the same open sets).

However as soon as we move on to continuity at a point we see the limitations of the approach based
on open sets. In mathlib it is much more frequent to think of topological spaces as types equipped
with a neighborhood filter ``𝓝 x`` attached to each point ``x`` (the corresponding function
``X → filter X`` satisfies certain conditions explained further down). Remember from the filters section that
these gadget play two related roles. First ``𝓝 x`` is seen as the generalized set of points of ``X``
that are close to ``x``. And then it is seen as giving a way to say, for any predicate ``P : X → Prop``,
that this predicates holds for points that are close enough to ``x``. Let us state
that ``f : X → Y`` is continuous at ``x``. The purely filtery way is to say that the direct image under
``f`` of the generalized set of points that are close to ``x`` is contained in the generalized set of
points that are close to ``f x``. Recall this spelled either ``map f (𝓝 x) ≤ 𝓝 (f x)``
or ``tendsto f (𝓝 x) (𝓝 (f x))``.

BOTH: -/

-- QUOTE:

example {f : X → Y} {x : X} : continuous_at f x ↔ map f (𝓝 x) ≤ 𝓝 (f x) :=
iff.rfl

-- QUOTE.

/- TEXT:
One can also spell it using both neighborhoods seen as ordinary sets and a neighborhood filter
seen as a generalized set: "for any neighborhood ``U`` of ``f x``, all points close to ``x``
are sent to ``U``". Note that the proof is again ``iff.rfl``, this point of view is definitionally
equivalent to the previous one.

BOTH: -/

-- QUOTE:
example {f : X → Y} {x : X} : continuous_at f x ↔ ∀ U ∈ 𝓝 (f x), ∀ᶠ x in 𝓝 x, f x ∈ U :=
iff.rfl
-- QUOTE.

/- TEXT:
We now explain how to go from one point of view to the other. In terms of open sets, we can
simply define members of ``𝓝 x`` as sets that contain an open set containing ``x``.

BOTH: -/

-- QUOTE:
example {x : X} {s : set X} : s ∈ 𝓝 x ↔ ∃ t ⊆ s, is_open t ∧ x ∈ t :=
mem_nhds_iff
-- QUOTE.

/- TEXT:
To go in the other direction we need to discuss the condition that ``𝓝 : X → filter X`` must satisfy
in order to be the neighborhood function of a topology.

The first constraint is that ``𝓝 x``, seen as a generalized set, contains the set ``{x}`` seen as the generalized set
``pure x`` (explaining this weird name would be too much of a digression, so we simply accept it for now).
Another way to say it is that if a predicate holds for points close to ``x`` then it holds at ``x``.

BOTH: -/

-- QUOTE:
example (x : X) : pure x ≤ 𝓝 x := pure_le_nhds x

example (x : X) (P : X → Prop) (h : ∀ᶠ y in 𝓝 x, P y) : P x :=
pure_le_nhds x h
-- QUOTE.

/- TEXT:
Then a more subtle requirement is that, for any predicate ``P : X → Prop`` and any ``x``, if ``P y`` holds for ``y`` close
to ``x`` then for ``y`` close to ``x`` and ``z`` close to ``y``, ``P z`` holds. More precisely we have:
BOTH: -/

-- QUOTE:

example {P : X → Prop} {x : X} (h : ∀ᶠ y in 𝓝 x, P y) : ∀ᶠ y in 𝓝 x, ∀ᶠ z in 𝓝 y, P z :=
eventually_eventually_nhds.mpr h

-- QUOTE.

/- TEXT:
Those two results characterize the functions ``X → filter X`` that are neighborhood functions for a topological space
structure on ``X``. There is a still a function ``topological_space.mk_of_nhds : (X → filter X) → topological_space X``
but it will give back its input as a neighborhood function only if it satistfy the above two constraints.
More precisely we have a lemma ``topological_space.nhds_mk_of_nhds`` saying that in a different way and our
next exercise deduces this different way from how we stated it above.
BOTH: -/

#check topological_space.mk_of_nhds
#check topological_space.nhds_mk_of_nhds.

-- QUOTE:

example {α : Type*} (n : α → filter α) (H₀ : ∀ a, pure a ≤ n a)
  (H : ∀ a : α, ∀ p : α → Prop, (∀ᶠ x in n a, p x) → (∀ᶠ y in n a, ∀ᶠ x in n y, p x)) :
  ∀ a, ∀ s ∈ n a, ∃ t ∈ n a, t ⊆ s ∧ ∀ a' ∈ t, s ∈ n a' :=
sorry

-- QUOTE.

-- SOLUTIONS:
example {α : Type*} (n : α → filter α) (H₀ : ∀ a, pure a ≤ n a)
  (H : ∀ a : α, ∀ p : α → Prop, (∀ᶠ x in n a, p x) → (∀ᶠ y in n a, ∀ᶠ x in n y, p x)) :
  ∀ a, ∀ s ∈ n a, ∃ t ∈ n a, t ⊆ s ∧ ∀ a' ∈ t, s ∈ n a' :=
begin
  intros a s s_in,
  refine ⟨{y | s ∈ n y}, H a (λ x, x ∈ s) s_in, _, by tauto⟩,
  rintros y (hy : s ∈ n y),
  exact H₀ y hy
end
-- BOTH:
end
-- BOTH.
/- TEXT:
Note that ``topological_space.mk_of_nhds`` is not so frequently used, but it still good to know in what
precise sense the neighborhood filters is all there is in a topological space structure.

The next thing to know in order to efficiently use topological spaces in mathlib is that we use a lot
of formal properties of ``topological_space : Type u → Type u``. From a purely mathematical point of view,
those formal properties are a very clean way to explain how topological spaces solve issues that metric spaces
have. From this point of view, the issues solved by topological spaces is that metric spaces enjoy very
little fonctoriality, and have very bad categorical properties in general. This comes on top of the fact
already discussed that metric spaces contain a lot of geometrical information that is not topologically relevant.

Let us focus on fonctoriality first. A metric space structure can be induced on a subset or,
equivalently, it can be pulled back by an injective map. But that's pretty much everything.
They cannot be pulled back by general map or pushed forward, even by surjective maps.

In particular there is no sensible distance to put on a quotient of a metric space or on an uncountable
products of metric spaces. Consider for instance the type ``ℝ → ℝ``, seen as
a product of copies of ``ℝ`` indexed by ``ℝ``. We would like to say that pointwise convergence of
sequences of functions is a respectable notion of convergence. But there is no distance on
``ℝ → ℝ`` that gives this notion of convergence. Relatedly, there is no distance ensuring that
a map ``f : X → (ℝ → ℝ)`` is continuous if and only ``λ x, f x t`` is continuous for every ``t : ℝ``.

We now review the data used to solve all those issues. First we can use any map ``f : X → Y`` to
push or pull topologies from one side to the other. Those two operations form a Galois connection.

BOTH: -/

-- QUOTE:
variables {X Y : Type*}

example (f : X → Y) : topological_space X → topological_space Y :=
topological_space.coinduced f

example (f : X → Y) : topological_space Y → topological_space X :=
topological_space.induced f

example (f : X → Y) (T_X : topological_space X) (T_Y : topological_space Y) :
  topological_space.coinduced f T_X ≤ T_Y ↔ T_X ≤ topological_space.induced f T_Y :=
coinduced_le_iff_le_induced

-- QUOTE.

/- TEXT:
Those operations are compactible with composition of functions.
As usual, pushing forward is covariant and pulling back is contravariant, see ``coinduced_compose`` and ``induced_compose``.
On paper we will use notations :math:`f_*T` for ``topological_space.coinduced f T`` and
:math:`f^*T` for ``topological_space.induced f T``.
BOTH: -/

#check coinduced_compose
#check induced_compose.

/- TEXT:

Then the next big piece is a complete lattice structure on ``topological_structure X``
for any given structure. If you think of topologies are being primarily the data of open sets then you expect
the order relation on ``topological_structure X`` to come from ``set (set X)``, ie you expect ``t ≤ t'``
if a set ``u`` is open for ``t'`` as soon as it is open for ``t``. However we already know that mathlib focuses
on neighborhoods more than open sets so, for any ``x : X`` we want ``λ T : topological_space X, @nhds X T x``
to be order preserving. And we know the order relation on ``filter X`` is designed to ensure an order
preserving ``principal : set X → filter X``, allowing to see filters as generalized sets.
So the order relation we do use on  ``topological_structure X`` is opposite to the one coming from ``set (set X)``.

BOTH: -/

-- QUOTE:
example {T T' : topological_space X} :
  T ≤ T' ↔ ∀ s, T'.is_open s → T.is_open s  :=
iff.rfl

-- QUOTE.

/- TEXT:

Now we can recover continuity by combining the push-foward (or pull-back) operation with the order relation.

BOTH: -/

-- QUOTE:
example (T_X : topological_space X) (T_Y : topological_space Y) (f : X → Y) :
  continuous f ↔ topological_space.coinduced f T_X ≤ T_Y :=
continuous_iff_coinduced_le

-- QUOTE.

/- TEXT:
With this definition and the compatibility of push-forward and composition, we
get for free the universal property that, for any topological space :math:`Z`,
a function :math:`g : Y → Z` is continuous for the topology :math:`f_*T_X` if and only if
:math:`g ∘ f` is continuous.

.. math::
  g \text{ continuous } &⇔ g_*(f_*T_X) ≤ T_Z \\
  &⇔ (g ∘ f)_* T_X ≤ T_Z \\
  &⇔ g ∘ f \text{ continuous}

BOTH: -/

-- QUOTE:

example {Z : Type*} (f : X → Y)
  (T_X : topological_space X) (T_Z : topological_space Z) (g : Y → Z) :
  @continuous Y Z (topological_space.coinduced f T_X) T_Z g ↔ @continuous X Z T_X T_Z (g ∘ f) :=
by rw [continuous_iff_coinduced_le, coinduced_compose, continuous_iff_coinduced_le]

-- QUOTE.

/- TEXT:

So we already get quotient topologies (using the projection map as ``f``). This wasn't using that
``topological_space X`` is a complete lattice for all ``X``. Let's now see how all this structure
proves the existence of the product topology by abstract non-sense.
We considered the case of ``ℝ → ℝ`` above, but let's now consider the general case of ``Π i, X i`` for
some ``ι : Type*`` and ``X : ι → Type*``. We want, for any topological space ``Z`` and any function
``f : Z → Π i, X i``, that ``f`` is continuous if and only if ``(λ x, x i) ∘ f`` is continuous.
Let us explore that constraint "on papar" using notation :math:`p_i` for the projection
``(λ (x : Π i, X i), x i)``:

.. math::
  (∀ i, p_i ∘ f \text{ continuous}) &⇔ ∀ i, (p_i ∘ f)_* T_Z ≤ T_{X_i} \\
  &⇔ ∀ i, (p_i)_* f_* T_Z ≤ T_{X_i}\\
  &⇔ ∀ i, f_* T_Z ≤ (p_i)^*T_{X_i}\\
  &⇔  f_* T_Z ≤ \inf \left[(p_i)^*T_{X_i}\right]

So we see that what is the topology we want on ``Π i, X i``:
BOTH: -/

-- QUOTE:
example (ι : Type*) (X : ι → Type*) (T_X : Π i, topological_space $ X i) :
  (Pi.topological_space : topological_space (Π i, X i)) = ⨅ i, topological_space.induced (λ x, x i) (T_X i) :=
rfl

-- QUOTE.

/- TEXT:

This ends our tour of how mathlib thinks that topological spaces fix defects of the theory of metric spaces
by being a more functorial theory and having a complete lattice structure for any fixed type.

Separation and countability
^^^^^^^^^^^^^^^^^^^^^^^^^^^

We saw that the category of topological spaces have very nice properties. The price to pay for
this is existence of rather pathological topological spaces.
There are a number of assumptions you can make on a topological space to ensure its behavior
is closer to what metric spaces do. The most important is ``t2_space``, also called "Hausdorff",
that will ensure that limits are unique.
A stronger separation property is regularity that ensure that each point has a basis of closed
neighborhood.

BOTH: -/

-- QUOTE:

example [topological_space X] [t2_space X] {u : ℕ → X} {a b : X}
  (ha : tendsto u at_top (𝓝 a)) (hb : tendsto u at_top (𝓝 b)) : a = b :=
tendsto_nhds_unique ha hb

example [topological_space X] [regular_space X] (a : X) :
    (𝓝 a).has_basis (λ (s : set X), s ∈ 𝓝 a ∧ is_closed s) id :=
closed_nhds_basis a
-- QUOTE.

/- TEXT:
Note that, in every topological space, each point has a basis of open neighborhood, by definition.

BOTH: -/

-- QUOTE:
example [topological_space X] {x : X} : (𝓝 x).has_basis (λ t : set X, t ∈ 𝓝 x ∧ is_open t) id :=
nhds_basis_opens' x
-- QUOTE.

/- TEXT:
Our main goal is now to prove the basic theorem which allows extension by continuity.
From Bourbaki's general topology book, I.8.5, Theorem 1 (taking only the non-trivial implication):

Let :math:`X` be a topological space, :math:`A` a dense subset of :math:`X`, :math:`f : A → Y`
a continuous mapping of :math:`A` into a regular space :math:`Y`. If, for each :math:`x` in :math:`X`,
:math:`f(y)` tends to a limit in :math:`Y` when :math:`y` tends to :math:`x`
while remaining in :math:`A` then there exists a continuous extension :math:`φ` of :math:`f` to
:math:`X`.

Actually ``mathlib`` contains a more general version of the above lemma, ``dense_inducing.continuous_at_extend``,
but we'll stick to Bourbaki's version here.

Remember that, given ``A : set X``, ``↥A`` is the subtype associated to ``A``, and Lean will automatically
insert that funny up arrow when needed. And the (inclusion) coercion map is ``coe : A → X``.
The assumption "tends to :math:`x` while remaining in :math:`A`" corresponds to the pull-back filter
``comap coe (𝓝 x)``.

Let's prove first an auxilliary lemma, extracted to simplify the context
(in particular we don't need Y to be a topological space here).

BOTH: -/

-- QUOTE:
lemma aux {X Y A : Type*} [topological_space X] {c : A → X} {f : A → Y} {x : X} {F : filter Y}
  (h : tendsto f (comap c (𝓝 x)) F) {V' : set Y} (V'_in : V' ∈ F) :
  ∃ V ∈ 𝓝 x, is_open V ∧ c ⁻¹' V ⊆ f ⁻¹' V' :=
sorry

-- QUOTE.

-- SOLUTIONS:
example {X Y A : Type*} [topological_space X] {c : A → X} {f : A → Y} {x : X} {F : filter Y}
  (h : tendsto f (comap c (𝓝 x)) F) {V' : set Y} (V'_in : V' ∈ F) :
  ∃ V ∈ 𝓝 x, is_open V ∧ c ⁻¹' V ⊆ f ⁻¹' V' :=
begin
  simpa [and_assoc] using ((nhds_basis_opens' x).comap c).tendsto_left_iff.mp h V' V'_in
end

/- TEXT:
Let's now turn to the main proof of the extension by continuity theorem.

When Lean needs a topology on ``↥A`` it will use the induced topology, thanks to the instance
``subtype.topological_space``.
This all happens automatically. The only relevant lemma is
``nhds_induced coe : ∀ a : ↥A, 𝓝 a = comap coe (𝓝 ↑a)``
(this is actually a general lemma about induced topologies).

The proof outline is:

The main assumption and the axiom of choice give a function ``φ`` such that
``∀ x, tendsto f (comap coe $ 𝓝 x) (𝓝 (φ x))``
(because ``Y`` is Hausdorff, ``φ`` is entirely determined, but we won't need that until we try to
prove that ``φ`` indeed extends ``f``).

Let's first prove ``φ`` is continuous. Fix any ``x : X``.
Since ``Y`` is regular, it suffices to check that for every *closed* neighborhood
``V'`` of ``φ x``, ``φ ⁻¹' V' ∈ 𝓝 x``.
The limit assumption gives (through the auxilliary lemma above)
some ``V ∈ 𝓝 x`` such ``is_open V ∧ coe ⁻¹' V ⊆ f ⁻¹' V'``.
Since ``V ∈ 𝓝 x``, it suffices to prove ``V ⊆ φ ⁻¹' V'``, ie  ``∀ y ∈ V, φ y ∈ V'``.
Let's fix ``y`` in ``V``. Because ``V`` is *open*, it is a neighborhood of ``y``.
In particular ``coe ⁻¹' V ∈ comap coe (𝓝 y)`` and a fortiori ``f ⁻¹' V' ∈ comap coe (𝓝 y)``.
In addition ``comap coe $ 𝓝 y ≠ ⊥`` because ``A`` is dense.
Because we know ``tendsto f (comap coe $ 𝓝 y) (𝓝 (φ y))`` this implies
``φ y ∈ closure V'`` and, since ``V'`` is closed, we have proved ``φ y ∈ V'``.

It remains to prove that ``φ`` extends ``f``. This is were continuity of ``f`` enters the discussion,
together with the fact that ``Y`` is Hausdorff.
BOTH: -/

-- QUOTE:

example [topological_space X] [topological_space Y] [regular_space Y]
  {A : set X} (hA : ∀ x, x ∈ closure A)
  {f : A → Y} (f_cont : continuous f)
  (hf : ∀ x : X, ∃ c : Y, tendsto f (comap coe $ 𝓝 x) $ 𝓝 c) :
  ∃ φ : X → Y, continuous φ ∧ ∀ a : A, φ a = f a :=
sorry
-- QUOTE.

-- SOLUTIONS:

example [topological_space X] [topological_space Y] [regular_space Y] {A : set X} (hA : ∀ x, x ∈ closure A)
  {f : A → Y} (f_cont : continuous f)
  (hf : ∀ x : X, ∃ c : Y, tendsto f (comap coe $ 𝓝 x) $ 𝓝 c) :
  ∃ φ : X → Y, continuous φ ∧ ∀ a : A, φ a = f a :=
begin
  choose φ hφ using hf,
  use φ,
  split,
  { rw continuous_iff_continuous_at,
    intros x,
    suffices : ∀ V' ∈ 𝓝 (φ x), is_closed V' → φ ⁻¹' V' ∈ 𝓝 x,
      by simpa [continuous_at, (closed_nhds_basis _).tendsto_right_iff],
    intros V' V'_in V'_closed,
    obtain ⟨V, V_in, V_op, hV⟩ : ∃ V ∈ 𝓝 x, is_open V ∧ coe ⁻¹' V ⊆ f ⁻¹' V',
    { exact aux (hφ x) V'_in },
    suffices : ∀ y ∈ V, φ y ∈ V',
      from mem_of_superset V_in this,
    intros y y_in,
    have hVx : V ∈ 𝓝 y := V_op.mem_nhds y_in,
    haveI : (comap (coe : A → X) (𝓝 y)).ne_bot := by simpa [mem_closure_iff_comap_ne_bot] using hA y,
    apply V'_closed.mem_of_tendsto (hφ y),
    exact mem_of_superset (preimage_mem_comap hVx) hV },
  { intros a,
    have lim : tendsto f (𝓝 a) (𝓝 $ φ a),
      by simpa [nhds_induced] using hφ a,
    exact tendsto_nhds_unique lim f_cont.continuous_at },
end

/- TEXT:
In addition to separation property, the main kind of assumption you can make on a topological
space to bring it closer to metric spaces is countability assumption. The main one is first countability
asking that every point has a countable neighborhood basic. In particular this ensures that closure
of sets can be understood using sequences.

BOTH: -/

-- QUOTE:

example [topological_space X] [topological_space.first_countable_topology X] {s : set X} {a : X} :
  a ∈ closure s ↔ ∃ (u : ℕ → X), (∀ n, u n ∈ s) ∧ tendsto u at_top (𝓝 a) :=
mem_closure_iff_seq_limit

-- QUOTE.

/- TEXT:
Compactness
^^^^^^^^^^^

Let us now discuss how compactness is defined for topological spaces. As usual there are several ways
to think about it and mathlib goes for the filter version.

We first need to define cluster points of filters. Given a filter ``F`` on a topological space ``X``,
a point ``x : X`` is a cluster point of ``F`` if ``F``, seen as a generalized set, has non-empty intersection
with the generalized set of points that are close to ``x``.

Then we can say that a set ``s`` is compact if every nonempty generalized set ``F`` contained in ``s``,
ie such that ``F ≤ 𝓟 s``, has a cluster point in ``s``.

BOTH: -/

-- QUOTE:
variables [topological_space X]

example {F : filter X} {x : X} : cluster_pt x F ↔ ne_bot (𝓝 x ⊓ F) :=
iff.rfl

example {s : set X} :
  is_compact s ↔ ∀ (F : filter X) [ne_bot F], F ≤ 𝓟 s → ∃ a ∈ s, cluster_pt a F :=
iff.rfl
-- QUOTE.

/- TEXT:
For instance if ``F`` is ``map u at_top``, the image under ``u : ℕ → X`` of ``at_top``, the generalized set
of very large natural numbers, then the assumption ``F ≤ 𝓟 s`` means that ``u n`` belongs to ``s`` for ``n``
large enough. Saying that ``x`` is a cluster point of ``map u at_top`` says the image of very large numbers
intersects the set of points that are close to ``x``. In case ``𝓝 x`` has a countable basis, we can
interpret this as saying that ``u`` has a subsequence converging to ``x``, and we get back what compactness
looks like in metric spaces.
BOTH: -/

-- QUOTE:
example [topological_space.first_countable_topology X]
  {s : set X} {u : ℕ → X} (hs : is_compact s) (hu : ∀ n, u n ∈ s) :
  ∃ (a ∈ s) (φ : ℕ → ℕ), strict_mono φ ∧ tendsto (u ∘ φ) at_top (𝓝 a) :=
hs.tendsto_subseq hu
-- QUOTE.

/- TEXT:
Cluster points behave nicely with continuous functions.

BOTH: -/

-- QUOTE:

variables [topological_space Y]

example {x : X} {F : filter X} {G : filter Y} (H : cluster_pt x F)
  {f : X → Y} (hfx : continuous_at f x) (hf : tendsto f F G) :
  cluster_pt (f x) G :=
cluster_pt.map H hfx hf
-- QUOTE.

/- TEXT:
As an exercise, we will prove that the image of a compact set under a continuous map is
compact. In addition to what we saw already, you should use ``filter.push_pull`` and
``ne_bot.of_map``.
BOTH: -/

-- QUOTE:
example [topological_space Y] {f : X  → Y} (hf : continuous f)
  {s : set X} (hs : is_compact s) : is_compact (f '' s) :=
begin
  intros F F_ne F_le,
  have map_eq : map f (𝓟 s ⊓ comap f F) = 𝓟 (f '' s) ⊓ F,
  { sorry },
  haveI Hne : (𝓟 s ⊓ comap f F).ne_bot,
  { sorry },
  have Hle : 𝓟 s ⊓ comap f F ≤ 𝓟 s, from inf_le_left,
  sorry
end
-- QUOTE.

-- SOLUTIONS:
example [topological_space Y] {f : X  → Y} (hf : continuous f)
  {s : set X} (hs : is_compact s) : is_compact (f '' s) :=
begin
  intros F F_ne F_le,
  have map_eq : map f (𝓟 s ⊓ comap f F) = 𝓟 (f '' s) ⊓ F,
  { rw [filter.push_pull, map_principal] },
  haveI Hne : (𝓟 s ⊓ comap f F).ne_bot,
  { apply ne_bot.of_map,
    rwa [map_eq, inf_of_le_right F_le] },
  have Hle : 𝓟 s ⊓ comap f F ≤ 𝓟 s, from inf_le_left,
  rcases hs Hle with ⟨x, x_in, hx⟩,
  refine ⟨f x, mem_image_of_mem f x_in, _⟩,
  apply hx.map hf.continuous_at,
  rw [tendsto, map_eq],
  exact inf_le_right
end

/- TEXT:

One can also express compactness in terms of open covers: ``s`` is compact if every family of open sets that
cover ``s`` has a finite covering sub-family.

BOTH: -/

-- QUOTE:
example {ι : Type*} {s : set X} (hs : is_compact s)
  (U : ι → set X) (hUo : ∀ i, is_open (U i)) (hsU : s ⊆ ⋃ i, U i) :
  ∃ t : finset ι, s ⊆ ⋃ i ∈ t, U i :=
hs.elim_finite_subcover U hUo hsU

-- QUOTE.

/- TEXT:
A topological space ``X`` is compact if ``(univ : set X)`` is compact.
BOTH: -/

-- QUOTE:
example [compact_space X] : is_compact (univ : set X) :=
compact_univ
-- QUOTE.


/-
Copyright (c) 2019 Abhimanyu Pallavi Sudhir. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Abhimanyu Pallavi Sudhir, Yury Kudryashov
-/
import order.filter.ultrafilter
import order.filter.germ

/-!
# Ultraproducts

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

If `φ` is an ultrafilter, then the space of germs of functions `f : α → β` at `φ` is called
the *ultraproduct*. In this file we prove properties of ultraproducts that rely on `φ` being an
ultrafilter. Definitions and properties that work for any filter should go to `order.filter.germ`.

## Tags

ultrafilter, ultraproduct
-/

universes u v
variables {α : Type u} {β : Type v} {φ : ultrafilter α}
open_locale classical

namespace filter

local notation `∀*` binders `, ` r:(scoped p, filter.eventually p φ) := r

namespace germ

open ultrafilter

local notation `β*` := germ (φ : filter α) β

instance [division_semiring β] : division_semiring β* :=
{ mul_inv_cancel := λ f, induction_on f $ λ f hf, coe_eq.2 $ (φ.em (λ y, f y = 0)).elim
    (λ H, (hf $ coe_eq.2 H).elim) (λ H, H.mono $ λ x, mul_inv_cancel),
  inv_zero := coe_eq.2 $ by simp only [(∘), inv_zero],
  ..germ.semiring, ..germ.div_inv_monoid, ..germ.nontrivial }

instance [division_ring β] : division_ring β* := { ..germ.ring, ..germ.division_semiring }
instance [semifield β] : semifield β* := { ..germ.comm_semiring, ..germ.division_semiring }
instance [field β] : field β* := { ..germ.comm_ring, ..germ.division_ring }

lemma coe_lt [preorder β] {f g : α → β} : (f : β*) < g ↔ ∀* x, f x < g x :=
by simp only [lt_iff_le_not_le, eventually_and, coe_le, eventually_not, eventually_le]

lemma coe_pos [preorder β] [has_zero β] {f : α → β} : 0 < (f : β*) ↔ ∀* x, 0 < f x := coe_lt

lemma const_lt [preorder β] {x y : β} : x < y → (↑x : β*) < ↑y := coe_lt.mpr ∘ lift_rel_const

@[simp, norm_cast]
lemma const_lt_iff [preorder β] {x y : β} : (↑x : β*) < ↑y ↔ x < y :=
coe_lt.trans lift_rel_const_iff

lemma lt_def [preorder β] : ((<) : β* → β* → Prop) = lift_rel (<) :=
by { ext ⟨f⟩ ⟨g⟩, exact coe_lt }

instance [has_sup β] : has_sup β* := ⟨map₂ (⊔)⟩
instance [has_inf β] : has_inf β* := ⟨map₂ (⊓)⟩

@[simp, norm_cast] lemma const_sup [has_sup β] (a b : β) : ↑(a ⊔ b) = (↑a ⊔ ↑b : β*) := rfl
@[simp, norm_cast] lemma const_inf [has_inf β] (a b : β) : ↑(a ⊓ b) = (↑a ⊓ ↑b : β*) := rfl

instance [semilattice_sup β] : semilattice_sup β* :=
{ sup := (⊔),
  le_sup_left := λ f g, induction_on₂ f g $ λ f g,
    eventually_of_forall $ λ x, le_sup_left,
  le_sup_right := λ f g, induction_on₂ f g $ λ f g,
    eventually_of_forall $ λ x, le_sup_right,
  sup_le := λ f₁ f₂ g, induction_on₃ f₁ f₂ g $ λ f₁ f₂ g h₁ h₂,
    h₂.mp $ h₁.mono $ λ x, sup_le,
  .. germ.partial_order }

instance [semilattice_inf β] : semilattice_inf β* :=
{ inf := (⊓),
  inf_le_left := λ f g, induction_on₂ f g $ λ f g,
    eventually_of_forall $ λ x, inf_le_left,
  inf_le_right := λ f g, induction_on₂ f g $ λ f g,
    eventually_of_forall $ λ x, inf_le_right,
  le_inf := λ f₁ f₂ g, induction_on₃ f₁ f₂ g $ λ f₁ f₂ g h₁ h₂,
    h₂.mp $ h₁.mono $ λ x, le_inf,
  .. germ.partial_order }

instance [lattice β] : lattice β* :=
{ .. germ.semilattice_sup, .. germ.semilattice_inf }

instance [distrib_lattice β] : distrib_lattice β* :=
{ le_sup_inf := λ f g h, induction_on₃ f g h $ λ f g h, eventually_of_forall $ λ _, le_sup_inf,
  .. germ.semilattice_sup, .. germ.semilattice_inf }

instance [has_le β] [is_total β (≤)] : is_total β* (≤) :=
⟨λ f g, induction_on₂ f g $ λ f g, eventually_or.1 $ eventually_of_forall $ λ x, total_of _ _ _⟩

/-- If `φ` is an ultrafilter then the ultraproduct is a linear order. -/
noncomputable instance [linear_order β] : linear_order β* := lattice.to_linear_order _

@[to_additive]
instance [ordered_comm_monoid β] : ordered_comm_monoid β* :=
{ mul_le_mul_left := λ f g, induction_on₂ f g $ λ f g H h, induction_on h $ λ h,
    H.mono $ λ x H, mul_le_mul_left' H _,
  .. germ.partial_order, .. germ.comm_monoid }

@[to_additive]
instance [ordered_cancel_comm_monoid β] : ordered_cancel_comm_monoid β* :=
{ le_of_mul_le_mul_left := λ f g h, induction_on₃ f g h $ λ f g h H,
    H.mono $ λ x, le_of_mul_le_mul_left',
  .. germ.partial_order, .. germ.ordered_comm_monoid }

@[to_additive]
instance [ordered_comm_group β] : ordered_comm_group β* :=
{ .. germ.ordered_cancel_comm_monoid, .. germ.comm_group }

@[to_additive]
noncomputable instance [linear_ordered_comm_group β] : linear_ordered_comm_group β* :=
{ .. germ.ordered_comm_group, .. germ.linear_order }

instance [ordered_semiring β] : ordered_semiring β* :=
{ zero_le_one := const_le zero_le_one,
  mul_le_mul_of_nonneg_left := λ x y z, induction_on₃ x y z $ λ f g h hfg hh, hh.mp $
    hfg.mono $ λ a, mul_le_mul_of_nonneg_left,
  mul_le_mul_of_nonneg_right := λ x y z, induction_on₃ x y z $ λ f g h hfg hh, hh.mp $
    hfg.mono $ λ a, mul_le_mul_of_nonneg_right,
  ..germ.semiring, ..germ.ordered_add_comm_monoid }

instance [ordered_comm_semiring β] : ordered_comm_semiring β* :=
{ ..germ.ordered_semiring, ..germ.comm_semiring }

instance [ordered_ring β] : ordered_ring β* :=
{ zero_le_one := const_le zero_le_one,
  mul_nonneg := λ x y, induction_on₂ x y $ λ f g hf hg, hg.mp $ hf.mono $ λ a, mul_nonneg,
  ..germ.ring, ..germ.ordered_add_comm_group }

instance [ordered_comm_ring β] : ordered_comm_ring β* :=
{ ..germ.ordered_ring, ..germ.ordered_comm_semiring }

instance [strict_ordered_semiring β] : strict_ordered_semiring β* :=
{ mul_lt_mul_of_pos_left := λ x y z, induction_on₃ x y z $ λ f g h hfg hh, coe_lt.2 $
   (coe_lt.1 hh).mp $ (coe_lt.1 hfg).mono $ λ a, mul_lt_mul_of_pos_left,
  mul_lt_mul_of_pos_right := λ x y z, induction_on₃ x y z $ λ f g h hfg hh, coe_lt.2 $
   (coe_lt.1 hh).mp $ (coe_lt.1 hfg).mono $ λ a, mul_lt_mul_of_pos_right,
  ..germ.ordered_semiring, ..germ.ordered_cancel_add_comm_monoid, ..germ.nontrivial }

instance [strict_ordered_comm_semiring β] : strict_ordered_comm_semiring β* :=
{ .. germ.strict_ordered_semiring, ..germ.ordered_comm_semiring }

instance [strict_ordered_ring β] : strict_ordered_ring β* :=
{ zero_le_one := const_le zero_le_one,
  mul_pos := λ x y, induction_on₂ x y $ λ f g hf hg, coe_pos.2 $
    (coe_pos.1 hg).mp $ (coe_pos.1 hf).mono $ λ x, mul_pos,
  ..germ.ring, ..germ.strict_ordered_semiring }

instance [strict_ordered_comm_ring β] : strict_ordered_comm_ring β* :=
{ .. germ.strict_ordered_ring, ..germ.ordered_comm_ring }

noncomputable instance [linear_ordered_ring β] : linear_ordered_ring β* :=
{ ..germ.strict_ordered_ring, ..germ.linear_order }

noncomputable instance [linear_ordered_field β] : linear_ordered_field β* :=
{ .. germ.linear_ordered_ring, .. germ.field }

noncomputable instance [linear_ordered_comm_ring β] : linear_ordered_comm_ring β* :=
{ .. germ.linear_ordered_ring, .. germ.comm_monoid }

lemma min_def [K : linear_order β] (x y : β*) : min x y = map₂ min x y :=
induction_on₂ x y $ λ a b,
begin
  cases le_total (a : β*) b,
  { rw [min_eq_left h, map₂_coe, coe_eq], exact h.mono (λ i hi, (min_eq_left hi).symm) },
  { rw [min_eq_right h, map₂_coe, coe_eq], exact h.mono (λ i hi, (min_eq_right hi).symm) }
end

lemma abs_def [linear_ordered_add_comm_group β] (x : β*) : |x| = map abs x :=
induction_on x $ λ a, by exact rfl

@[simp] lemma const_max [linear_order β] (x y : β) : (↑(max x y : β) : β*) = max ↑x ↑y :=
by rw [max_def, map₂_const]

@[simp] lemma const_min [linear_order β] (x y : β) : (↑(min x y : β) : β*) = min ↑x ↑y :=
by rw [min_def, map₂_const]

@[simp] lemma const_abs [linear_ordered_add_comm_group β] (x : β) :
  (↑(|x|) : β*) = |↑x| :=
by rw [abs_def, map_const]

end germ

end filter


-- ----------------------------------------------------
-- Ejercicio. Demostrar
--    ⊢ (p → q) ∨ (q → p)
-- ----------------------------------------------------

import tactic
variables (p q : Prop)

open_locale classical

-- 1ª demostración
example :
  (p → q) ∨ (q → p) :=
begin
  by_cases H1 : p,
  { right,
    intro,
    exact H1, },
  { left,
    intro H2,
    exfalso,
    exact H1 H2, },
end

-- 2ª demostración
example :
  (p → q) ∨ (q → p) :=
begin
  cases (em p) with Hp Hnp,
  { exact or.inr (λ Hq, Hp), },
  { exact or.inl (λ Hp, not.elim Hnp Hp), },
end

-- 3ª demostración
example :
  (p → q) ∨ (q → p) :=
or.elim (em p)
  (λ Hp, or.inr (λ Hq, Hp))
  (λ Hnp, or.inl (λ Hp, not.elim Hnp Hp))

-- 4ª demostración
example :
  (p → q) ∨ (q → p) :=
if Hp : p
   then or.inr (λ _, Hp)
   else or.inl (λ H, not.elim Hp H)

-- 5ª demostración
example :
  (p → q) ∨ (q → p) :=
-- by hint
by tauto

-- 6ª demostración
example :
  (p → q) ∨ (q → p) :=
by finish


/-
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
import data.fintype.powerset

/-!
# Nondeterministic Finite Automata

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.
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.
-/

open set
open_locale computability

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 (S : set σ) (a : α) : set σ := ⋃ s ∈ S, M.step s a

@[simp] lemma step_set_empty (a : α) : M.step_set ∅ a = ∅ :=
by simp_rw [step_set, Union_false, Union_empty]

/-- `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

@[simp] lemma eval_from_nil (S : set σ) : M.eval_from S [] = S := rfl
@[simp] lemma eval_from_singleton (S : set σ) (a : α) : M.eval_from S [a] = M.step_set S a := rfl
@[simp] lemma eval_from_append_singleton (S : set σ) (x : list α) (a : α) :
  M.eval_from S (x ++ [a]) = M.step_set (M.eval_from S x) a :=
by simp only [eval_from, list.foldl_append, list.foldl_cons, list.foldl_nil]

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

@[simp] lemma eval_nil : M.eval [] = M.start := rfl
@[simp] lemma eval_singleton (a : α) : M.eval [a] = M.step_set M.start a := rfl
@[simp] lemma eval_append_singleton (x : list α) (a : α) :
  M.eval (x ++ [a]) = M.step_set (M.eval x) a :=
eval_from_append_singleton _ _ _ _

/-- `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 | _} ↔ _,
  split; { exact λ ⟨w, h2, h3⟩, ⟨w, h3, h2⟩ },
end

lemma pumping_lemma [fintype σ] {x : list α} (hx : x ∈ M.accepts)
  (hlen : fintype.card (set σ) ≤ list.length x) :
  ∃ a b c, x = a ++ b ++ c ∧ a.length + b.length ≤ fintype.card (set σ) ∧ b ≠ [] ∧
    {a} * {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,
        show M.to_NFA.step_set {start} a = {M.step start a}, by simpa [NFA.step_set]],
    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₂ ⟩,
    rwa set.mem_singleton_iff.mp hS₂ at hS₁ },
  { exact λ h, ⟨M.eval x, h, rfl⟩ }
end

end DFA


universe u
constant α : Type u
#check α

def foo : (ℕ → ℕ) → ℕ := λ f, f 0

#check foo
#print foo

def double (x : ℕ) : ℕ := x + x
#print double
#check double 3
#reduce double 3

def square (x : ℕ) : ℕ := x * x
#check square
#reduce square 3

constants p q : Prop
theorem t1 : p → q → p := λ hp : p, λ hq : q, hp
#print t1

#check ¬p → p ↔ false

#reduce true ∧ false

theorem test (p q : Prop) (hp : p) (hq : q) : p ∧ q ∧ p :=
begin
  apply and.intro,
  exact hp,
  apply and.intro,
  exact hq,
  exact hp
end

example : ∀ a b c : ℕ, a = b → a = c → c = b :=
begin
intros,
transitivity a,
symmetry,
assumption,
assumption
end


/-
Copyright (c) 2020 Zhouhang Zhou. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Zhouhang Zhou
-/
import algebra.group.pi
import group_theory.group_action
import data.support
import data.finset.lattice

/-!
# Indicator function

- `indicator (s : set α) (f : α → β) (a : α)` is `f a` if `a ∈ s` and is `0` otherwise.
- `mul_indicator (s : set α) (f : α → β) (a : α)` is `f a` if `a ∈ s` and is `1` otherwise.

## Implementation note

In mathematics, an indicator function or a characteristic function is a function
used to indicate membership of an element in a set `s`,
having the value `1` for all elements of `s` and the value `0` otherwise.
But since it is usually used to restrict a function to a certain set `s`,
we let the indicator function take the value `f x` for some function `f`, instead of `1`.
If the usual indicator function is needed, just set `f` to be the constant function `λx, 1`.

## Tags
indicator, characteristic
-/

noncomputable theory
open_locale classical big_operators
open function

variables {α β ι M N : Type*}

namespace set

section has_one
variables [has_one M] [has_one N] {s t : set α} {f g : α → M} {a : α}

/-- `indicator s f a` is `f a` if `a ∈ s`, `0` otherwise.  -/
def indicator {M} [has_zero M] (s : set α) (f : α → M) : α → M := λ x, if x ∈ s then f x else 0

/-- `mul_indicator s f a` is `f a` if `a ∈ s`, `1` otherwise.  -/
@[to_additive]
def mul_indicator (s : set α) (f : α → M) : α → M := λ x, if x ∈ s then f x else 1

@[simp, to_additive] lemma piecewise_eq_mul_indicator : s.piecewise f 1 = s.mul_indicator f := rfl

@[to_additive] lemma mul_indicator_apply (s : set α) (f : α → M) (a : α) :
  mul_indicator s f a = if a ∈ s then f a else 1 := rfl

@[simp, to_additive] lemma mul_indicator_of_mem (h : a ∈ s) (f : α → M) :
  mul_indicator s f a = f a := if_pos h

@[simp, to_additive] lemma mul_indicator_of_not_mem (h : a ∉ s) (f : α → M) :
  mul_indicator s f a = 1 := if_neg h

@[to_additive] lemma mul_indicator_eq_one_or_self (s : set α) (f : α → M) (a : α) :
  mul_indicator s f a = 1 ∨ mul_indicator s f a = f a :=
if h : a ∈ s then or.inr (mul_indicator_of_mem h f) else or.inl (mul_indicator_of_not_mem h f)

@[simp, to_additive] lemma mul_indicator_apply_eq_self :
  s.mul_indicator f a = f a ↔ (a ∉ s → f a = 1) :=
ite_eq_left_iff.trans $ by rw [@eq_comm _ (f a)]

@[simp, to_additive] lemma mul_indicator_eq_self : s.mul_indicator f = f ↔ mul_support f ⊆ s :=
by simp only [funext_iff, subset_def, mem_mul_support, mul_indicator_apply_eq_self, not_imp_comm]

@[to_additive] lemma mul_indicator_eq_self_of_superset (h1 : s.mul_indicator f = f) (h2 : s ⊆ t) :
  t.mul_indicator f = f :=
by { rw mul_indicator_eq_self at h1 ⊢, exact subset.trans h1 h2 }

@[simp, to_additive] lemma mul_indicator_apply_eq_one :
  mul_indicator s f a = 1 ↔ (a ∈ s → f a = 1) :=
ite_eq_right_iff

@[simp, to_additive] lemma mul_indicator_eq_one :
  mul_indicator s f = (λ x, 1) ↔ disjoint (mul_support f) s :=
by simp only [funext_iff, mul_indicator_apply_eq_one, set.disjoint_left, mem_mul_support,
  not_imp_not]

@[simp, to_additive] lemma mul_indicator_eq_one' :
  mul_indicator s f = 1 ↔ disjoint (mul_support f) s :=
mul_indicator_eq_one

@[simp, to_additive] lemma mul_support_mul_indicator :
  function.mul_support (s.mul_indicator f) = s ∩ function.mul_support f :=
ext $ λ x, by simp [function.mem_mul_support, mul_indicator_apply_eq_one]

/-- If a multiplicative indicator function is not equal to one at a point, then that
point is in the set. -/
@[to_additive] lemma mem_of_mul_indicator_ne_one (h : mul_indicator s f a ≠ 1) : a ∈ s :=
not_imp_comm.1 (λ hn, mul_indicator_of_not_mem hn f) h

@[to_additive] lemma eq_on_mul_indicator : eq_on (mul_indicator s f) f s :=
λ x hx, mul_indicator_of_mem hx f

@[to_additive] lemma mul_support_mul_indicator_subset : mul_support (s.mul_indicator f) ⊆ s :=
λ x hx, hx.imp_symm (λ h, mul_indicator_of_not_mem h f)

@[simp, to_additive] lemma mul_indicator_mul_support : mul_indicator (mul_support f) f = f :=
mul_indicator_eq_self.2 subset.rfl

@[simp, to_additive] lemma mul_indicator_range_comp {ι : Sort*} (f : ι → α) (g : α → M) :
  mul_indicator (range f) g ∘ f = g ∘ f :=
piecewise_range_comp _ _ _

@[to_additive] lemma mul_indicator_congr (h : eq_on f g s) :
  mul_indicator s f = mul_indicator s g :=
funext $ λx, by { simp only [mul_indicator], split_ifs, { exact h h_1 }, refl }

@[simp, to_additive] lemma mul_indicator_univ (f : α → M) : mul_indicator (univ : set α) f = f :=
mul_indicator_eq_self.2 $ subset_univ _

@[simp, to_additive] lemma mul_indicator_empty (f : α → M) : mul_indicator (∅ : set α) f = λa, 1 :=
mul_indicator_eq_one.2 $ disjoint_empty _

variable (M)

@[simp, to_additive] lemma mul_indicator_one (s : set α) :
  mul_indicator s (λx, (1:M)) = λx, (1:M) :=
mul_indicator_eq_one.2 $ by simp only [mul_support_one, empty_disjoint]

@[simp, to_additive] lemma mul_indicator_one' {s : set α} : s.mul_indicator (1 : α → M) = 1 :=
mul_indicator_one M s

variable {M}

@[to_additive] lemma mul_indicator_mul_indicator (s t : set α) (f : α → M) :
  mul_indicator s (mul_indicator t f) = mul_indicator (s ∩ t) f :=
funext $ λx, by { simp only [mul_indicator], split_ifs, repeat {simp * at * {contextual := tt}} }

@[simp, to_additive] lemma mul_indicator_inter_mul_support (s : set α) (f : α → M) :
  mul_indicator (s ∩ mul_support f) f = mul_indicator s f :=
by rw [← mul_indicator_mul_indicator, mul_indicator_mul_support]

@[to_additive] lemma comp_mul_indicator (h : M → β) (f : α → M) {s : set α} {x : α} :
  h (s.mul_indicator f x) = s.piecewise (h ∘ f) (const α (h 1)) x :=
s.apply_piecewise _ _ (λ _, h)

@[to_additive] lemma mul_indicator_comp_right {s : set α} (f : β → α) {g : α → M} {x : β} :
  mul_indicator (f ⁻¹' s) (g ∘ f) x = mul_indicator s g (f x) :=
by { simp only [mul_indicator], split_ifs; refl }

@[to_additive] lemma mul_indicator_comp_of_one {g : M → N} (hg : g 1 = 1) :
  mul_indicator s (g ∘ f) = g ∘ (mul_indicator s f) :=
begin
  funext,
  simp only [mul_indicator],
  split_ifs; simp [*]
end

@[to_additive] lemma mul_indicator_preimage (s : set α) (f : α → M) (B : set M) :
  (mul_indicator s f)⁻¹' B = s.ite (f ⁻¹' B) (1 ⁻¹' B) :=
piecewise_preimage s f 1 B

@[to_additive] lemma mul_indicator_preimage_of_not_mem (s : set α) (f : α → M)
  {t : set M} (ht : (1:M) ∉ t) :
  (mul_indicator s f)⁻¹' t = f ⁻¹' t ∩ s :=
by simp [mul_indicator_preimage, pi.one_def, set.preimage_const_of_not_mem ht]

@[to_additive] lemma mem_range_mul_indicator {r : M} {s : set α} {f : α → M} :
  r ∈ range (mul_indicator s f) ↔ (r = 1 ∧ s ≠ univ) ∨ (r ∈ f '' s) :=
by simp [mul_indicator, ite_eq_iff, exists_or_distrib, eq_univ_iff_forall, and_comm, or_comm,
  @eq_comm _ r 1]

@[to_additive] lemma mul_indicator_rel_mul_indicator {r : M → M → Prop} (h1 : r 1 1)
  (ha : a ∈ s → r (f a) (g a)) :
  r (mul_indicator s f a) (mul_indicator s g a) :=
by { simp only [mul_indicator], split_ifs with has has, exacts [ha has, h1] }

end has_one

section monoid
variables [mul_one_class M] {s t : set α} {f g : α → M} {a : α}

@[to_additive] lemma mul_indicator_union_mul_inter_apply (f : α → M) (s t : set α) (a : α) :
  mul_indicator (s ∪ t) f a * mul_indicator (s ∩ t) f a =
    mul_indicator s f a * mul_indicator t f a :=
by by_cases hs : a ∈ s; by_cases ht : a ∈ t; simp *

@[to_additive] lemma mul_indicator_union_mul_inter (f : α → M) (s t : set α) :
  mul_indicator (s ∪ t) f * mul_indicator (s ∩ t) f = mul_indicator s f * mul_indicator t f :=
funext $ mul_indicator_union_mul_inter_apply f s t

@[to_additive] lemma mul_indicator_union_of_not_mem_inter (h : a ∉ s ∩ t) (f : α → M) :
  mul_indicator (s ∪ t) f a = mul_indicator s f a * mul_indicator t f a :=
by rw [← mul_indicator_union_mul_inter_apply f s t, mul_indicator_of_not_mem h, mul_one]

@[to_additive] lemma mul_indicator_union_of_disjoint (h : disjoint s t) (f : α → M) :
  mul_indicator (s ∪ t) f = λa, mul_indicator s f a * mul_indicator t f a :=
funext $ λa, mul_indicator_union_of_not_mem_inter (λ ha, h ha) _

@[to_additive] lemma mul_indicator_mul (s : set α) (f g : α → M) :
  mul_indicator s (λa, f a * g a) = λa, mul_indicator s f a * mul_indicator s g a :=
by { funext, simp only [mul_indicator], split_ifs, { refl }, rw mul_one }

@[simp, to_additive] lemma mul_indicator_compl_mul_self_apply (s : set α) (f : α → M) (a : α) :
  mul_indicator sᶜ f a * mul_indicator s f a = f a :=
classical.by_cases (λ ha : a ∈ s, by simp [ha]) (λ ha, by simp [ha])

@[simp, to_additive] lemma mul_indicator_compl_mul_self (s : set α) (f : α → M) :
  mul_indicator sᶜ f * mul_indicator s f = f :=
funext $ mul_indicator_compl_mul_self_apply s f

@[simp, to_additive] lemma mul_indicator_self_mul_compl_apply (s : set α) (f : α → M) (a : α) :
  mul_indicator s f a * mul_indicator sᶜ f a = f a :=
classical.by_cases (λ ha : a ∈ s, by simp [ha]) (λ ha, by simp [ha])

@[simp, to_additive] lemma mul_indicator_self_mul_compl (s : set α) (f : α → M) :
  mul_indicator s f * mul_indicator sᶜ f = f :=
funext $ mul_indicator_self_mul_compl_apply s f

@[to_additive] lemma mul_indicator_mul_eq_left {f g : α → M}
  (h : disjoint (mul_support f) (mul_support g)) :
  (mul_support f).mul_indicator (f * g) = f :=
begin
  refine (mul_indicator_congr $ λ x hx, _).trans mul_indicator_mul_support,
  have : g x = 1, from nmem_mul_support.1 (disjoint_left.1 h hx),
  rw [pi.mul_apply, this, mul_one]
end

@[to_additive] lemma mul_indicator_mul_eq_right {f g : α → M}
  (h : disjoint (mul_support f) (mul_support g)) :
  (mul_support g).mul_indicator (f * g) = g :=
begin
  refine (mul_indicator_congr $ λ x hx, _).trans mul_indicator_mul_support,
  have : f x = 1, from nmem_mul_support.1 (disjoint_right.1 h hx),
  rw [pi.mul_apply, this, one_mul]
end

/-- `set.mul_indicator` as a `monoid_hom`. -/
@[to_additive "`set.indicator` as an `add_monoid_hom`."]
def mul_indicator_hom {α} (M) [mul_one_class M] (s : set α) : (α → M) →* (α → M) :=
{ to_fun := mul_indicator s,
  map_one' := mul_indicator_one M s,
  map_mul' := mul_indicator_mul s }

end monoid

section distrib_mul_action

variables {A : Type*} [add_monoid A] [monoid M] [distrib_mul_action M A]

lemma indicator_smul (s : set α) (r : M) (f : α → A) :
  indicator s (λ (x : α), r • f x) = λ (x : α), r • indicator s f x :=
by { simp only [indicator], funext, split_ifs, refl, exact (smul_zero r).symm }

end distrib_mul_action

section group
variables {G : Type*} [group G] {s t : set α} {f g : α → G} {a : α}

@[to_additive] lemma mul_indicator_inv' (s : set α) (f : α → G) :
  mul_indicator s (f⁻¹) = (mul_indicator s f)⁻¹ :=
(mul_indicator_hom G s).map_inv f

@[to_additive] lemma mul_indicator_inv (s : set α) (f : α → G) :
  mul_indicator s (λa, (f a)⁻¹) = λa, (mul_indicator s f a)⁻¹ :=
mul_indicator_inv' s f

lemma indicator_sub {G} [add_group G] (s : set α) (f g : α → G) :
  indicator s (λa, f a - g a) = λa, indicator s f a - indicator s g a :=
(indicator_hom G s).map_sub f g

@[to_additive indicator_compl'] lemma mul_indicator_compl (s : set α) (f : α → G) :
  mul_indicator sᶜ f = f * (mul_indicator s f)⁻¹ :=
eq_mul_inv_of_mul_eq $ s.mul_indicator_compl_mul_self f

lemma indicator_compl {G} [add_group G] (s : set α) (f : α → G) :
  indicator sᶜ f = f - indicator s f :=
by rw [sub_eq_add_neg, indicator_compl']

@[to_additive indicator_diff'] lemma mul_indicator_diff (h : s ⊆ t) (f : α → G) :
  mul_indicator (t \ s) f = mul_indicator t f * (mul_indicator s f)⁻¹ :=
eq_mul_inv_of_mul_eq $ by rw [pi.mul_def, ← mul_indicator_union_of_disjoint disjoint_diff.symm f,
  diff_union_self, union_eq_self_of_subset_right h]

lemma indicator_diff {G : Type*} [add_group G] {s t : set α} (h : s ⊆ t) (f : α → G) :
  indicator (t \ s) f = indicator t f - indicator s f :=
by rw [indicator_diff' h, sub_eq_add_neg]

end group

section comm_monoid

variables [comm_monoid M]

/-- Consider a product of `g i (f i)` over a `finset`.  Suppose `g` is a
function such as `pow`, which maps a second argument of `1` to
`1`. Then if `f` is replaced by the corresponding multiplicative indicator
function, the `finset` may be replaced by a possibly larger `finset`
without changing the value of the sum. -/
@[to_additive] lemma prod_mul_indicator_subset_of_eq_one [has_one N] (f : α → N)
  (g : α → N → M) {s t : finset α} (h : s ⊆ t) (hg : ∀ a, g a 1 = 1) :
  ∏ i in s, g i (f i) = ∏ i in t, g i (mul_indicator ↑s f i) :=
begin
  rw ← finset.prod_subset h _,
  { apply finset.prod_congr rfl,
    intros i hi,
    congr,
    symmetry,
    exact mul_indicator_of_mem hi _ },
  { refine λ i hi hn, _,
    convert hg i,
    exact mul_indicator_of_not_mem hn _ }
end

/-- Consider a sum of `g i (f i)` over a `finset`.  Suppose `g` is a
function such as multiplication, which maps a second argument of 0 to
0.  (A typical use case would be a weighted sum of `f i * h i` or `f i
• h i`, where `f` gives the weights that are multiplied by some other
function `h`.)  Then if `f` is replaced by the corresponding indicator
function, the `finset` may be replaced by a possibly larger `finset`
without changing the value of the sum. -/
add_decl_doc set.sum_indicator_subset_of_eq_zero

@[to_additive] lemma prod_mul_indicator_subset (f : α → M) {s t : finset α} (h : s ⊆ t) :
  ∏ i in s, f i = ∏ i in t, mul_indicator ↑s f i :=
prod_mul_indicator_subset_of_eq_one _ (λ a b, b) h (λ _, rfl)

/-- Summing an indicator function over a possibly larger `finset` is
the same as summing the original function over the original
`finset`. -/
add_decl_doc sum_indicator_subset

@[to_additive] lemma mul_indicator_finset_prod (I : finset ι) (s : set α) (f : ι → α → M) :
  mul_indicator s (∏ i in I, f i) = ∏ i in I, mul_indicator s (f i) :=
(mul_indicator_hom M s).map_prod _ _

@[to_additive] lemma mul_indicator_finset_bUnion {ι} (I : finset ι)
  (s : ι → set α) {f : α → M} : (∀ (i ∈ I) (j ∈ I), i ≠ j → disjoint (s i) (s j)) →
  mul_indicator (⋃ i ∈ I, s i) f = λ a, ∏ i in I, mul_indicator (s i) f a :=
begin
  refine finset.induction_on I _ _,
  { intro h, funext, simp },
  assume a I haI ih hI,
  funext,
  rw [finset.prod_insert haI, finset.set_bUnion_insert, mul_indicator_union_of_not_mem_inter, ih _],
  { assume i hi j hj hij,
    exact hI i (finset.mem_insert_of_mem hi) j (finset.mem_insert_of_mem hj) hij },
  simp only [not_exists, exists_prop, mem_Union, mem_inter_eq, not_and],
  assume hx a' ha',
  refine disjoint_left.1 (hI a (finset.mem_insert_self _ _) a' (finset.mem_insert_of_mem ha') _) hx,
  exact (ne_of_mem_of_not_mem ha' haI).symm
end

end comm_monoid

section mul_zero_class

variables [mul_zero_class M] {s t : set α} {f g : α → M} {a : α}

lemma indicator_mul (s : set α) (f g : α → M) :
  indicator s (λa, f a * g a) = λa, indicator s f a * indicator s g a :=
by { funext, simp only [indicator], split_ifs, { refl }, rw mul_zero }

lemma indicator_mul_left (s : set α) (f g : α → M) :
  indicator s (λa, f a * g a) a = indicator s f a * g a :=
by { simp only [indicator], split_ifs, { refl }, rw [zero_mul] }

lemma indicator_mul_right (s : set α) (f g : α → M) :
  indicator s (λa, f a * g a) a = f a * indicator s g a :=
by { simp only [indicator], split_ifs, { refl }, rw [mul_zero] }

lemma inter_indicator_mul {t1 t2 : set α} (f g : α → M) (x : α) :
  (t1 ∩ t2).indicator (λ x, f x * g x) x = t1.indicator f x * t2.indicator g x :=
by { rw [← set.indicator_indicator], simp [indicator] }

end mul_zero_class

section monoid_with_zero

variables [monoid_with_zero M]

lemma indicator_prod_one {s : set α} {t : set β} {x : α} {y : β} :
  (s.prod t).indicator (1 : _ → M) (x, y) = s.indicator 1 x * t.indicator 1 y :=
by simp [indicator, ← ite_and]

end monoid_with_zero

section order
variables [has_one M] [preorder M] {s t : set α} {f g : α → M} {a : α} {y : M}

@[to_additive] lemma mul_indicator_apply_le' (hfg : a ∈ s → f a ≤ y) (hg : a ∉ s → 1 ≤ y) :
  mul_indicator s f a ≤ y :=
if ha : a ∈ s then by simpa [ha] using hfg ha else by simpa [ha] using hg ha

@[to_additive] lemma mul_indicator_le' (hfg : ∀ a ∈ s, f a ≤ g a) (hg : ∀ a ∉ s, 1 ≤ g a) :
  mul_indicator s f ≤ g :=
λ a, mul_indicator_apply_le' (hfg _) (hg _)

@[to_additive] lemma le_mul_indicator_apply {y} (hfg : a ∈ s → y ≤ g a) (hf : a ∉ s → y ≤ 1) :
  y ≤ mul_indicator s g a :=
@mul_indicator_apply_le' α (order_dual M) ‹_› _ _ _ _ _ hfg hf

@[to_additive] lemma le_mul_indicator (hfg : ∀ a ∈ s, f a ≤ g a) (hf : ∀ a ∉ s, f a ≤ 1) :
  f ≤ mul_indicator s g :=
λ a, le_mul_indicator_apply (hfg _) (hf _)

@[to_additive indicator_apply_nonneg]
lemma one_le_mul_indicator_apply (h : a ∈ s → 1 ≤ f a) : 1 ≤ mul_indicator s f a :=
le_mul_indicator_apply h (λ _, le_rfl)

@[to_additive indicator_nonneg]
lemma one_le_mul_indicator (h : ∀ a ∈ s, 1 ≤ f a) (a : α) : 1 ≤ mul_indicator s f a :=
one_le_mul_indicator_apply (h a)

@[to_additive] lemma mul_indicator_apply_le_one (h : a ∈ s → f a ≤ 1) : mul_indicator s f a ≤ 1 :=
mul_indicator_apply_le' h (λ _, le_rfl)

@[to_additive] lemma mul_indicator_le_one (h : ∀ a ∈ s, f a ≤ 1) (a : α) :
  mul_indicator s f a ≤ 1 :=
mul_indicator_apply_le_one (h a)

@[to_additive] lemma mul_indicator_le_mul_indicator (h : f a ≤ g a) :
  mul_indicator s f a ≤ mul_indicator s g a :=
mul_indicator_rel_mul_indicator (le_refl _) (λ _, h)

attribute [mono] mul_indicator_le_mul_indicator indicator_le_indicator

@[to_additive] lemma mul_indicator_le_mul_indicator_of_subset (h : s ⊆ t) (hf : ∀ a, 1 ≤ f a)
  (a : α) :
  mul_indicator s f a ≤ mul_indicator t f a :=
mul_indicator_apply_le' (λ ha, le_mul_indicator_apply (λ _, le_rfl) (λ hat, (hat $ h ha).elim))
  (λ ha, one_le_mul_indicator_apply (λ _, hf _))

@[to_additive] lemma mul_indicator_le_self' (hf : ∀ x ∉ s, 1 ≤ f x) : mul_indicator s f ≤ f :=
mul_indicator_le' (λ _ _, le_refl _) hf

@[to_additive] lemma mul_indicator_Union_apply {ι M} [complete_lattice M] [has_one M]
  (h1 : (⊥:M) = 1) (s : ι → set α) (f : α → M) (x : α) :
  mul_indicator (⋃ i, s i) f x = ⨆ i, mul_indicator (s i) f x :=
begin
  by_cases hx : x ∈ ⋃ i, s i,
  { rw [mul_indicator_of_mem hx],
    rw [mem_Union] at hx,
    refine le_antisymm _ (supr_le $ λ i, mul_indicator_le_self' (λ x hx, h1 ▸ bot_le) x),
    rcases hx with ⟨i, hi⟩,
    exact le_supr_of_le i (ge_of_eq $ mul_indicator_of_mem hi _) },
  { rw [mul_indicator_of_not_mem hx],
    simp only [mem_Union, not_exists] at hx,
    simp [hx, ← h1] }
end

end order

section canonically_ordered_monoid

variables [canonically_ordered_monoid M]

@[to_additive] lemma mul_indicator_le_self (s : set α) (f : α → M) :
  mul_indicator s f ≤ f :=
mul_indicator_le_self' $ λ _ _, one_le _

@[to_additive] lemma mul_indicator_apply_le {a : α} {s : set α} {f g : α → M}
  (hfg : a ∈ s → f a ≤ g a) :
  mul_indicator s f a ≤ g a :=
mul_indicator_apply_le' hfg $ λ _, one_le _

@[to_additive] lemma mul_indicator_le {s : set α} {f g : α → M} (hfg : ∀ a ∈ s, f a ≤ g a) :
  mul_indicator s f ≤ g :=
mul_indicator_le' hfg $ λ _ _, one_le _

end canonically_ordered_monoid

end set

@[to_additive] lemma monoid_hom.map_mul_indicator {M N : Type*} [monoid M] [monoid N] (f : M →* N)
  (s : set α) (g : α → M) (x : α) :
  f (s.mul_indicator g x) = s.mul_indicator (f ∘ g) x :=
congr_fun (set.mul_indicator_comp_of_one f.map_one).symm x


-- Subtraccion_en_anillos.lean
-- Si R es un anillo y a, b ∈ R, entonces a - b = a + -b
-- José A. Alonso Jiménez <https://jaalonso.github.io>
-- Sevilla, 12-septiembre-2022
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Demostrar que si R es un anillo y a, b ∈ R entonces
--    a - b = a + -b
-- ----------------------------------------------------------------------

import algebra.ring

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

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

example : a - b = a + -b :=
begin
  apply sub_eq_iff_eq_add.mpr,
  calc a
       = a + 0        : (add_zero a).symm
   ... = a + (-b + b) : congr_arg (λ x, a + x) (neg_add_self b).symm
   ... = a + -b + b   : (add_assoc a (-b) b).symm
end

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

example : a - b = a + -b :=
begin
  apply sub_eq_iff_eq_add.mpr,
  calc a
       = a + 0        : by rw add_zero
   ... = a + (-b + b) : by {congr; rw neg_add_self}
   ... = a + -b + b   : by rw add_assoc
end

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

example : a - b = a + -b :=
begin
  rw sub_eq_iff_eq_add,
  rw add_assoc,
  rw neg_add_self,
  rw add_zero,
end

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

example : a - b = a + -b :=
by rw [sub_eq_iff_eq_add, add_assoc, neg_add_self, add_zero]

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

example : a - b = a + -b :=
by simp [sub_eq_iff_eq_add]

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

example : a - b = a + -b :=
-- by library_search
sub_eq_add_neg a b