/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau

Tensor product of modules over commutative rings.

-/

import group_theory.free_abelian_group
import linear_algebra.linear_map_module

variables {R : Type*} [comm_ring R]
variables (M : Type*) (N : Type*) (P : Type*) (Q : Type*)
variables [module R M] [module R N] [module R P] [module R Q]
include R

structure is_bilinear_map {M N P} [module R M] [module R N] [module R P] (f : M → N → P) : Prop :=
(add_left : ∀ x y z, f (x + y) z = f x z + f y z)
(add_right : ∀ x y z, f x (y + z) = f x y + f x z)
(smul_left : ∀ r x y, f (r • x) y = r • f x y)
(smul_right : ∀ r x y, f x (r • y) = r • f x y)

namespace is_bilinear_map
variables {M N P Q}
variables {f : M → N → P} (hf : is_bilinear_map f)
include hf

theorem zero_left : ∀ y, f 0 y = 0 :=
λ y, calc f 0 y
        = f (0 + 0) y - f 0 y : by rw [hf.add_left 0 0 y]; simp
    ... = 0 : by simp

theorem zero_right : ∀ x, f x 0 = 0 :=
λ x, calc f x 0
        = f x (0 + 0) - f x 0 : by rw [hf.add_right x 0 0]; simp
    ... = 0 : by simp

theorem neg_left : ∀ x y, f (-x) y = -f x y :=
λ x y, by convert hf.smul_left (-1) x y; simp

theorem neg_right : ∀ x y, f x (-y) = -f x y :=
λ x y, by convert hf.smul_right (-1) x y; simp

theorem linear_left (y : N) : is_linear_map (λ x, f x y) :=
{ add  := λ m n, hf.add_left m n y,
  smul := λ r m, hf.smul_left r m y }

theorem linear_right (x : M) : is_linear_map (λ y, f x y) :=
{ add  := λ m n, hf.add_right x m n,
  smul := λ r m, hf.smul_right r x m }

theorem comm : is_bilinear_map (λ y x, f x y) :=
by cases hf; constructor; intros; solve_by_elim

section comp
variables {g : P → Q} (hg : is_linear_map g)
include hg

theorem comp : is_bilinear_map (λ x y, g (f x y)) :=
{ add_left  := λ x y z, by rw [hf.add_left, hg.add],
  add_right  := λ x y z, by rw [hf.add_right, hg.add],
  smul_left := λ r x y, by rw [hf.smul_left, hg.smul],
  smul_right := λ r x y, by rw [hf.smul_right, hg.smul] }
end comp

end is_bilinear_map

namespace tensor_product

def relators : set (free_abelian_group (M × N)) :=
add_group.closure { x : free_abelian_group (M × N) |
  (∃ (m₁ m₂ : M) (n : N), x = (m₁, n) + (m₂, n) - (m₁ + m₂, n)) ∨
  (∃ (m : M) (n₁ n₂ : N), x = (m, n₁) + (m, n₂) - (m, n₁ + n₂)) ∨
  (∃ (r : R) (m : M) (n : N), x = (r • m, n) - (m, r • n)) }

namespace relators

instance : normal_add_subgroup (relators M N) :=
{ normal := λ x hx g, by rwa [add_sub_cancel'],
  .. add_group.closure.is_add_subgroup _ }

end relators

end tensor_product

def tensor_product : Type* :=
quotient_add_group.quotient (tensor_product.relators M N)

local infix ` ⊗ `:100 := tensor_product

namespace tensor_product

section module

local attribute [instance] quotient_add_group.left_rel normal_add_subgroup.to_is_add_subgroup

instance : add_comm_group (M ⊗ N) := quotient_add_group.add_comm_group _

instance quotient.mk.is_add_group_hom :
  @is_add_group_hom (free_abelian_group (M × N)) (M ⊗ N) _ _
    quotient.mk :=
quotient_add_group.is_add_group_hom _

section tmul
variables {M N}

def tmul (m : M) (n : N) : M ⊗ N := quotient_add_group.mk $ free_abelian_group.of (m, n)

infix ` ⊗ₜ `:100 := tmul

lemma tmul.add_left (m₁ m₂ : M) (n : N) : (m₁ + m₂) ⊗ₜ n = m₁ ⊗ₜ n + m₂ ⊗ₜ n :=
eq.symm $ sub_eq_zero.1 $ eq.symm $ quotient.sound $
  group.in_closure.basic $ or.inl $ ⟨m₁, m₂, n, rfl⟩

lemma tmul.add_right (m : M) (n₁ n₂ : N) : m ⊗ₜ (n₁ + n₂) = m ⊗ₜ n₁ + m ⊗ₜ n₂ :=
eq.symm $ sub_eq_zero.1 $ eq.symm $ quotient.sound $
  group.in_closure.basic $ or.inr $ or.inl $ ⟨m, n₁, n₂, rfl⟩

lemma tmul.smul (r : R) (m : M) (n : N) : (r • m) ⊗ₜ n = m ⊗ₜ (r • n) :=
sub_eq_zero.1 $ eq.symm $ quotient.sound $
  group.in_closure.basic $ or.inr $ or.inr $ ⟨r, m, n, rfl⟩

end tmul

local attribute [instance] free_abelian_group.to_add_comm_group.is_add_group_hom
local attribute [instance] quotient_add_group.is_add_group_hom_quotient_lift

@[reducible] def smul.aux (r : R) (x : free_abelian_group (M × N)) : M ⊗ N :=
free_abelian_group.to_add_comm_group (λ (y : M × N), (r • y.1) ⊗ₜ (y.2)) x

@[reducible] def smul (r : R) : M ⊗ N → M ⊗ N :=
quotient_add_group.lift _ (smul.aux M N r)
begin
  assume x hx,
  induction hx with _ hx _ _ ih _ _ _ _ ih1 ih2,
  { rcases hx with ⟨m₁, m₂, n, rfl⟩ | ⟨m, n₁, n₂, rfl⟩ | ⟨q, m, n, rfl⟩;
      simp [smul.aux, -sub_eq_add_neg, sub_self, tmul.add_left, tmul.add_right, tmul.smul,
        smul_add, smul_smul, mul_comm] },
  { refl },
  { change smul.aux M N r (-_) = 0,
    rw [is_add_group_hom.neg (smul.aux M N r), ih, neg_zero] },
  { change smul.aux M N r (_ + _) = 0,
    rw [is_add_group_hom.add (smul.aux M N r), ih1, ih2, zero_add] }
end

lemma smul.is_add_group_hom (r : R) : is_add_group_hom (smul M N r) :=
by apply_instance
local attribute [instance] smul.is_add_group_hom

protected theorem smul_add (r : R) (x y : M ⊗ N) :
  smul M N r (x + y) = smul M N r x + smul M N r y :=
is_add_group_hom.add _ _ _

instance : module R (M ⊗ N) :=
{ smul := smul M N,
  smul_add := tensor_product.smul_add M N,
  add_smul := begin
      intros r s x,
      apply quotient_add_group.induction_on' x,
      intro z,
      symmetry,
      refine @free_abelian_group.to_add_comm_group.unique _ _ _ _ _ ⟨λ p q, _⟩ _ z,
      { simp [tensor_product.smul_add] },
      rintro ⟨m, n⟩,
      show (r • m) ⊗ₜ n + (s • m) ⊗ₜ n = ((r + s) • m) ⊗ₜ n,
      simp [add_smul, tmul.add_left]
    end,
  mul_smul := begin
      intros r s x,
      apply quotient_add_group.induction_on' x,
      intro z,
      symmetry,
      refine @free_abelian_group.to_add_comm_group.unique _ _ _ _ _
        ⟨λ p q, _⟩ _ z,
      { simp [tensor_product.smul_add] },
      rintro ⟨m, n⟩,
      simp [smul, smul.aux, mul_smul, tmul]
    end,
  one_smul := λ x, quotient.induction_on x $ λ _,
    eq.symm $ free_abelian_group.to_add_comm_group.unique _ _ $ λ ⟨p, q⟩,
    by rw [one_smul]; refl,
  .. tensor_product.add_comm_group M N }

theorem bilinear : is_bilinear_map (@tmul R _ M N _ _) :=
{ add_left := tmul.add_left,
  add_right := tmul.add_right,
  smul_left := λ r x y, rfl,
  smul_right := assume r m n, (tmul.smul r m n).symm }

@[simp] lemma add_tmul (m₁ m₂ : M) (n : N) : (m₁ + m₂) ⊗ₜ n = m₁ ⊗ₜ n + m₂ ⊗ₜ n :=
(bilinear M N).add_left m₁ m₂ n

@[simp] lemma tmul_add (m : M) (n₁ n₂ : N) : m ⊗ₜ (n₁ + n₂) = m ⊗ₜ n₁ + m ⊗ₜ n₂ :=
(bilinear M N).add_right m n₁ n₂

@[simp] lemma smul_tmul (r : R) (x : M) (y : N) : (r • x) ⊗ₜ y = r • (x ⊗ₜ y) :=
rfl

@[simp] lemma tmul_smul (r : R) (x : M) (y : N) : x ⊗ₜ (r • y) = r • (x ⊗ₜ y) :=
(bilinear M N).smul_right r x y

end module

local attribute [instance] quotient_add_group.left_rel normal_add_subgroup.to_is_add_subgroup

variables {M N}
@[elab_as_eliminator]
protected theorem induction_on
  {C : M ⊗ N → Prop}
  (z : M ⊗ N)
  (C0 : C 0)
  (C1 : ∀ x y, C $ x ⊗ₜ y)
  (Cp : ∀ x y, C x → C y → C (x + y)) : C z :=
quotient.induction_on z $ λ x, free_abelian_group.induction_on x
  C0 (λ ⟨p, q⟩, C1 p q)
  (λ ⟨p, q⟩ _, show C (-(p ⊗ₜ q)), by rw ← (bilinear M N).neg_left; from C1 (-p) q)
  (λ _ _, Cp _ _)

section UMP

variables {M N P Q}
variables (f : M → N → P) (hf : is_bilinear_map f)
include hf

local attribute [instance] free_abelian_group.to_add_comm_group.is_add_group_hom

def to_module : M ⊗ N → P :=
quotient_add_group.lift _
  (free_abelian_group.to_add_comm_group $ λ z, f z.1 z.2) $ λ x hx,
begin
  induction hx with _ hx _ _ ih _ _ _ _ ih1 ih2,
  { rcases hx with ⟨m₁, m₂, n, rfl⟩ | ⟨m, n₁, n₂, rfl⟩ | ⟨r, m, n, rfl⟩;
      simp [-sub_eq_add_neg, hf.add_left, hf.add_right, hf.smul_left, hf.smul_right, sub_self] },
  { refl },
  { change free_abelian_group.to_add_comm_group _ (-_) = (0:P),
    simp [ih] },
  { change free_abelian_group.to_add_comm_group _ (_ + _) = (0:P),
    simp [ih1, ih2] }
end
variable {f}

local attribute [instance] quotient_add_group.left_rel normal_add_subgroup.to_is_add_subgroup

@[simp] lemma to_module.add (x y) :
  to_module f hf (x + y)
  = to_module f hf x + to_module f hf y :=
quotient.induction_on₂ x y $ λ m n,
free_abelian_group.to_add_comm_group.add _ _ _

@[simp] lemma to_module.smul (r x) :
  to_module f hf (r • x)
  = r • to_module f hf x :=
tensor_product.induction_on x smul_zero.symm
  (λ p q, by rw [← (bilinear M N).smul_left];
    simp [to_module, tmul, hf.smul_left])
  (λ p q ih1 ih2, by simp [@smul_add _ _ _ _ r p q,
    to_module.add, ih1, ih2, smul_add])

def to_module.linear :
  is_linear_map (to_module f hf) :=
{ add := to_module.add hf,
  smul := to_module.smul hf }

@[simp] lemma to_module.tmul (x y) :
  to_module f hf (x ⊗ₜ y) = f x y :=
by simp [to_module, tmul]

theorem to_module.unique {g : M ⊗ N → P}
  (hg : is_linear_map g) (H : ∀ x y, g (x ⊗ₜ y) = f x y)
  (z : M ⊗ N) : g z = to_module f hf z :=
begin
  apply quotient_add_group.induction_on' z,
  intro z,
  refine @free_abelian_group.to_add_comm_group.unique _ _ _ _ _ ⟨λ p q, _⟩ _ z,
  { simp [hg.add] },
  exact λ ⟨m, n⟩, H m n
end

omit hf

theorem to_module.ext {g h : M ⊗ N → P}
  (hg : is_linear_map g) (hh : is_linear_map h)
  (H : ∀ x y, g (x ⊗ₜ y) = h (x ⊗ₜ y))
  (z : M ⊗ N) : g z = h z :=
begin
  apply quotient_add_group.induction_on' z,
  intro z,
  apply free_abelian_group.to_add_comm_group.ext (g ∘ _) _ _,
  { constructor,
    intros p q,
    simp [hg.add] },
  { constructor,
    intros p q,
    simp [hh.add] },
  rintro ⟨m, n⟩,
  exact H m n
end

def to_module.equiv : { f : M → N → P // is_bilinear_map f }
  ≃ linear_map (M ⊗ N) P :=
{ to_fun := λ f, ⟨to_module f.1 f.2, to_module.linear f.2⟩,
  inv_fun := λ f, ⟨λ m n, f (m ⊗ₜ n),
    is_bilinear_map.comp (bilinear M N) f.2⟩,
  left_inv := λ f, subtype.eq $ funext $ λ x, funext $ λ y,
    to_module.tmul f.2 _ _,
  right_inv := λ f, subtype.eq $ eq.symm $ funext $ λ z,
    to_module.unique _ f.2 (λ x y, rfl) _ }

end UMP

protected def id : R ⊗ M ≃ₗ M :=
{ to_fun := @to_module _ _ _ _ _ _ _ _ (λ c x, c • x) $
    by refine {..}; intros; simp [smul_add, add_smul, smul_smul, mul_comm, mul_left_comm],
  inv_fun := λ x, 1 ⊗ₜ x,
  left_inv := λ z, by refine to_module.ext
    (((bilinear R M).linear_right 1).comp $ to_module.linear _)
    is_linear_map.id (λ c x, _) z;
    simp; rw [← smul_tmul, smul_eq_mul, mul_one],
  right_inv := λ z, by simp,
  linear_fun := to_module.linear _ }

protected def comm : M ⊗ N ≃ₗ N ⊗ M :=
{ to_fun := to_module _ (bilinear N M).comm,
  inv_fun := to_module _ (bilinear M N).comm,
  left_inv := λ z, by refine to_module.ext
    ((to_module.linear _).comp (to_module.linear _))
    is_linear_map.id (λ x y, _) z; simp,
  right_inv := λ z, by refine to_module.ext
    ((to_module.linear _).comp (to_module.linear _))
    is_linear_map.id (λ x y, _) z; simp,
  linear_fun := to_module.linear _ }

protected def assoc : (M ⊗ N) ⊗ P ≃ₗ M ⊗ (N ⊗ P) :=
{ to_fun := begin
      refine to_module (λ mn p, to_module (λ m n, m ⊗ₜ (n ⊗ₜ p)) _ mn) _;
      constructor; intros; simp,
      { symmetry,
        refine to_module.unique _
          (is_linear_map.map_add (to_module.linear _) (to_module.linear _)) _ _,
        intros; simp },
      { symmetry,
        refine to_module.unique _
          (is_linear_map.map_smul_right (to_module.linear _)) _ _,
        intros; simp }
    end,
  inv_fun := begin
      refine to_module (λ m, to_module (λ n p, (m ⊗ₜ n) ⊗ₜ p) _) _;
      constructor; intros; simp,
      { symmetry,
        refine to_module.unique _
          (is_linear_map.map_add (to_module.linear _) (to_module.linear _)) _ _,
        intros; simp },
      { symmetry,
        refine to_module.unique _
          (is_linear_map.map_smul_right (to_module.linear _)) _ _,
        intros; simp }
    end,
  left_inv :=
  begin
    intro z,
    refine to_module.ext ((to_module.linear _).comp
      (to_module.linear _)) is_linear_map.id (λ mn p, _) z,
    simp,
    refine to_module.ext ((to_module.linear _).comp
      (to_module.linear _)) ((bilinear _ _).linear_left p) (λ m n, _) mn,
    simp
  end,
  right_inv :=
  begin
    intro z,
    refine to_module.ext ((to_module.linear _).comp
      (to_module.linear _)) is_linear_map.id (λ m np, _) z,
    simp,
    refine to_module.ext ((to_module.linear _).comp
      (to_module.linear _)) ((bilinear _ _).linear_right m) (λ n p, _) np,
    simp
  end,
  linear_fun := to_module.linear _ }

end tensor_product


import algebra.group
import data.set.basic
import analysis.exponential
import tactic.norm_num

set_option pp.beta true

----------------------------------------------

example (P Q R : Prop) :
  ((P ∨ Q → R) ∧ P) → R :=
begin
  rintro ⟨impl, hP⟩,
  apply impl,
  left,
  exact hP,
end

example (P Q R : Prop) :
  ((P ∨ Q → R) ∧ P) → R :=
begin
  finish,
end

example (X : Type) (A B C : set X) :
A ∩ (B ∪ C) = (A ∩ B) ∪ (A ∩ C) :=
begin
  ext x,
  split,
  { rintro ⟨x_A, x_B | x_C⟩,
    { left,
      apply and.intro,
      { assumption },
      { assumption } },
    { right,
      apply and.intro,
      { assumption },
      { assumption } } },
  { rintro (⟨x_A, x_B⟩|⟨x_A, x_C⟩),
    { apply and.intro,
      { assumption },
      { left,
        assumption } },
    { apply and.intro,
      { assumption },
      { right,
        assumption } } }
end

example (X : Type)
  (A B C : set X) :
A ∩ (B ∪ C) = (A ∩ B) ∪ (A ∩ C) :=
by ext x; split; finish

example (X : Type) (A B C : set X) :
A ∩ (B ∪ C) = (A ∩ B) ∪ (A ∩ C) :=
set.inter_distrib_left _ _ _

example (X Y : Type) (f : X → Y) :
(∀ y : Y, ∃ x : X, f(x) = y) ↔ (∃ g : Y → X, f ∘ g = id) :=
begin
  split,
  { intro hyp,
    choose g H using hyp,
    use g,
    funext y,
    apply H, },
  { rintros ⟨g, f_circ_g⟩ y,
    use g y,
    apply congr_fun f_circ_g, }
end

example (G H : Type)
  [group G] [group H]
  (f : G → H)
  (Hyp : ∀ a b : G,
    f (a*b) = f a * f b) :
f 1 = 1 :=
begin
  have key := Hyp 1 1,
  replace key := key.symm,
  simp at key,
  assumption,
end

example (u : ℕ → ℝ)
  (H : ∀ n, u (n+1) = 2*u n)
  (H0 : u 0 > 0) :
∀ n, u n > 0 :=
begin
  intro n,
  induction n with n IH,
  { exact H0, },
  { rw H,
    apply mul_pos,
    norm_num,
    exact IH, }
end


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

! This file was ported from Lean 3 source module algebra.lie.classical
! leanprover-community/mathlib commit a5b382d82275e20e2915ef73f679a47224e93409
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Invertible
import Mathbin.Data.Matrix.Basis
import Mathbin.Data.Matrix.Dmatrix
import Mathbin.Algebra.Lie.Abelian
import Mathbin.LinearAlgebra.Matrix.Trace
import Mathbin.Algebra.Lie.SkewAdjoint
import Mathbin.LinearAlgebra.SymplecticGroup

/-!
# Classical Lie algebras

This file is the place to find definitions and basic properties of the classical Lie algebras:
  * Aₗ = sl(l+1)
  * Bₗ ≃ so(l+1, l) ≃ so(2l+1)
  * Cₗ = sp(l)
  * Dₗ ≃ so(l, l) ≃ so(2l)

## Main definitions

  * `lie_algebra.special_linear.sl`
  * `lie_algebra.symplectic.sp`
  * `lie_algebra.orthogonal.so`
  * `lie_algebra.orthogonal.so'`
  * `lie_algebra.orthogonal.so_indefinite_equiv`
  * `lie_algebra.orthogonal.type_D`
  * `lie_algebra.orthogonal.type_B`
  * `lie_algebra.orthogonal.type_D_equiv_so'`
  * `lie_algebra.orthogonal.type_B_equiv_so'`

## Implementation notes

### Matrices or endomorphisms

Given a finite type and a commutative ring, the corresponding square matrices are equivalent to the
endomorphisms of the corresponding finite-rank free module as Lie algebras, see `lie_equiv_matrix'`.
We can thus define the classical Lie algebras as Lie subalgebras either of matrices or of
endomorphisms. We have opted for the former. At the time of writing (August 2020) it is unclear
which approach should be preferred so the choice should be assumed to be somewhat arbitrary.

### Diagonal quadratic form or diagonal Cartan subalgebra

For the algebras of type `B` and `D`, there are two natural definitions. For example since the
the `2l × 2l` matrix:
$$
  J = \left[\begin{array}{cc}
              0_l & 1_l\\
              1_l & 0_l
            \end{array}\right]
$$
defines a symmetric bilinear form equivalent to that defined by the identity matrix `I`, we can
define the algebras of type `D` to be the Lie subalgebra of skew-adjoint matrices either for `J` or
for `I`. Both definitions have their advantages (in particular the `J`-skew-adjoint matrices define
a Lie algebra for which the diagonal matrices form a Cartan subalgebra) and so we provide both.
We thus also provide equivalences `type_D_equiv_so'`, `so_indefinite_equiv` which show the two
definitions are equivalent. Similarly for the algebras of type `B`.

## Tags

classical lie algebra, special linear, symplectic, orthogonal
-/

universe u₁ u₂

namespace LieAlgebra

open Matrix

open Matrix

variable (n p q l : Type _) (R : Type u₂)

variable [DecidableEq n] [DecidableEq p] [DecidableEq q] [DecidableEq l]

variable [CommRing R]

@[simp]
theorem matrix_trace_commutator_zero [Fintype n] (X Y : Matrix n n R) : Matrix.trace ⁅X, Y⁆ = 0 :=
  calc
    _ = Matrix.trace (X ⬝ Y) - Matrix.trace (Y ⬝ X) := trace_sub _ _
    _ = Matrix.trace (X ⬝ Y) - Matrix.trace (X ⬝ Y) :=
      (congr_arg (fun x => _ - x) (Matrix.trace_mul_comm Y X))
    _ = 0 := sub_self _

#align lie_algebra.matrix_trace_commutator_zero LieAlgebra.matrix_trace_commutator_zero

namespace SpecialLinear

/-- The special linear Lie algebra: square matrices of trace zero. -/
def sl [Fintype n] : LieSubalgebra R (Matrix n n R) :=
  { LinearMap.ker (Matrix.traceLinearMap n R R) with
    lie_mem' := fun X Y _ _ => LinearMap.mem_ker.2 <| matrix_trace_commutator_zero _ _ _ _ }
#align lie_algebra.special_linear.sl LieAlgebra.SpecialLinear.sl

theorem sl_bracket [Fintype n] (A B : sl n R) : ⁅A, B⁆.val = A.val ⬝ B.val - B.val ⬝ A.val :=
  rfl
#align lie_algebra.special_linear.sl_bracket LieAlgebra.SpecialLinear.sl_bracket

section ElementaryBasis

variable {n} [Fintype n] (i j : n)

/-- When j ≠ i, the elementary matrices are elements of sl n R, in fact they are part of a natural
basis of sl n R. -/
def eb (h : j ≠ i) : sl n R :=
  ⟨Matrix.stdBasisMatrix i j (1 : R),
    show Matrix.stdBasisMatrix i j (1 : R) ∈ LinearMap.ker (Matrix.traceLinearMap n R R) from
      Matrix.stdBasisMatrix.trace_zero i j (1 : R) h⟩
#align lie_algebra.special_linear.Eb LieAlgebra.SpecialLinear.eb

@[simp]
theorem eb_val (h : j ≠ i) : (eb R i j h).val = Matrix.stdBasisMatrix i j 1 :=
  rfl
#align lie_algebra.special_linear.Eb_val LieAlgebra.SpecialLinear.eb_val

end ElementaryBasis

theorem sl_non_abelian [Fintype n] [Nontrivial R] (h : 1 < Fintype.card n) :
    ¬IsLieAbelian ↥(sl n R) :=
  by
  rcases Fintype.exists_pair_of_one_lt_card h with ⟨j, i, hij⟩
  let A := Eb R i j hij
  let B := Eb R j i hij.symm
  intro c
  have c' : A.val ⬝ B.val = B.val ⬝ A.val :=
    by
    rw [← sub_eq_zero, ← sl_bracket, c.trivial]
    rfl
  simpa [std_basis_matrix, Matrix.mul_apply, hij] using congr_fun (congr_fun c' i) i
#align lie_algebra.special_linear.sl_non_abelian LieAlgebra.SpecialLinear.sl_non_abelian

end SpecialLinear

namespace Symplectic

/-- The symplectic Lie algebra: skew-adjoint matrices with respect to the canonical skew-symmetric
bilinear form. -/
def sp [Fintype l] : LieSubalgebra R (Matrix (Sum l l) (Sum l l) R) :=
  skewAdjointMatricesLieSubalgebra (Matrix.j l R)
#align lie_algebra.symplectic.sp LieAlgebra.Symplectic.sp

end Symplectic

namespace Orthogonal

/-- The definite orthogonal Lie subalgebra: skew-adjoint matrices with respect to the symmetric
bilinear form defined by the identity matrix. -/
def so [Fintype n] : LieSubalgebra R (Matrix n n R) :=
  skewAdjointMatricesLieSubalgebra (1 : Matrix n n R)
#align lie_algebra.orthogonal.so LieAlgebra.Orthogonal.so

@[simp]
theorem mem_so [Fintype n] (A : Matrix n n R) : A ∈ so n R ↔ Aᵀ = -A :=
  by
  erw [mem_skewAdjointMatricesSubmodule]
  simp only [Matrix.IsSkewAdjoint, Matrix.IsAdjointPair, Matrix.mul_one, Matrix.one_mul]
#align lie_algebra.orthogonal.mem_so LieAlgebra.Orthogonal.mem_so

/-- The indefinite diagonal matrix with `p` 1s and `q` -1s. -/
def indefiniteDiagonal : Matrix (Sum p q) (Sum p q) R :=
  Matrix.diagonal <| Sum.elim (fun _ => 1) fun _ => -1
#align lie_algebra.orthogonal.indefinite_diagonal LieAlgebra.Orthogonal.indefiniteDiagonal

/-- The indefinite orthogonal Lie subalgebra: skew-adjoint matrices with respect to the symmetric
bilinear form defined by the indefinite diagonal matrix. -/
def so' [Fintype p] [Fintype q] : LieSubalgebra R (Matrix (Sum p q) (Sum p q) R) :=
  skewAdjointMatricesLieSubalgebra <| indefiniteDiagonal p q R
#align lie_algebra.orthogonal.so' LieAlgebra.Orthogonal.so'

/-- A matrix for transforming the indefinite diagonal bilinear form into the definite one, provided
the parameter `i` is a square root of -1. -/
def pso (i : R) : Matrix (Sum p q) (Sum p q) R :=
  Matrix.diagonal <| Sum.elim (fun _ => 1) fun _ => i
#align lie_algebra.orthogonal.Pso LieAlgebra.Orthogonal.pso

variable [Fintype p] [Fintype q]

theorem pso_inv {i : R} (hi : i * i = -1) : pso p q R i * pso p q R (-i) = 1 :=
  by
  ext (x y); rcases x with ⟨⟩ <;> rcases y with ⟨⟩
  ·-- x y : p
      by_cases h : x = y <;>
      simp [Pso, indefinite_diagonal, h]
  ·-- x : p, y : q
    simp [Pso, indefinite_diagonal]
  ·-- x : q, y : p
    simp [Pso, indefinite_diagonal]
  ·-- x y : q
      by_cases h : x = y <;>
      simp [Pso, indefinite_diagonal, h, hi]
#align lie_algebra.orthogonal.Pso_inv LieAlgebra.Orthogonal.pso_inv

/-- There is a constructive inverse of `Pso p q R i`. -/
def invertiblePso {i : R} (hi : i * i = -1) : Invertible (pso p q R i) :=
  invertibleOfRightInverse _ _ (pso_inv p q R hi)
#align lie_algebra.orthogonal.invertible_Pso LieAlgebra.Orthogonal.invertiblePso

theorem indefiniteDiagonal_transform {i : R} (hi : i * i = -1) :
    (pso p q R i)ᵀ ⬝ indefiniteDiagonal p q R ⬝ pso p q R i = 1 :=
  by
  ext (x y); rcases x with ⟨⟩ <;> rcases y with ⟨⟩
  ·-- x y : p
      by_cases h : x = y <;>
      simp [Pso, indefinite_diagonal, h]
  ·-- x : p, y : q
    simp [Pso, indefinite_diagonal]
  ·-- x : q, y : p
    simp [Pso, indefinite_diagonal]
  ·-- x y : q
      by_cases h : x = y <;>
      simp [Pso, indefinite_diagonal, h, hi]
#align lie_algebra.orthogonal.indefinite_diagonal_transform LieAlgebra.Orthogonal.indefiniteDiagonal_transform

/-- An equivalence between the indefinite and definite orthogonal Lie algebras, over a ring
containing a square root of -1. -/
def soIndefiniteEquiv {i : R} (hi : i * i = -1) : so' p q R ≃ₗ⁅R⁆ so (Sum p q) R :=
  by
  apply
    (skewAdjointMatricesLieSubalgebraEquiv (indefinite_diagonal p q R) (Pso p q R i)
        (invertible_Pso p q R hi)).trans
  apply LieEquiv.ofEq
  ext A; rw [indefinite_diagonal_transform p q R hi]; rfl
#align lie_algebra.orthogonal.so_indefinite_equiv LieAlgebra.Orthogonal.soIndefiniteEquiv

theorem soIndefiniteEquiv_apply {i : R} (hi : i * i = -1) (A : so' p q R) :
    (soIndefiniteEquiv p q R hi A : Matrix (Sum p q) (Sum p q) R) =
      (pso p q R i)⁻¹ ⬝ (A : Matrix (Sum p q) (Sum p q) R) ⬝ pso p q R i :=
  by erw [LieEquiv.trans_apply, LieEquiv.ofEq_apply, skewAdjointMatricesLieSubalgebraEquiv_apply]
#align lie_algebra.orthogonal.so_indefinite_equiv_apply LieAlgebra.Orthogonal.soIndefiniteEquiv_apply

/-- A matrix defining a canonical even-rank symmetric bilinear form.

It looks like this as a `2l x 2l` matrix of `l x l` blocks:

   [ 0 1 ]
   [ 1 0 ]
-/
def jD : Matrix (Sum l l) (Sum l l) R :=
  Matrix.fromBlocks 0 1 1 0
#align lie_algebra.orthogonal.JD LieAlgebra.Orthogonal.jD

/-- The classical Lie algebra of type D as a Lie subalgebra of matrices associated to the matrix
`JD`. -/
def typeD [Fintype l] :=
  skewAdjointMatricesLieSubalgebra (jD l R)
#align lie_algebra.orthogonal.type_D LieAlgebra.Orthogonal.typeD

/-- A matrix transforming the bilinear form defined by the matrix `JD` into a split-signature
diagonal matrix.

It looks like this as a `2l x 2l` matrix of `l x l` blocks:

   [ 1 -1 ]
   [ 1  1 ]
-/
def pD : Matrix (Sum l l) (Sum l l) R :=
  Matrix.fromBlocks 1 (-1) 1 1
#align lie_algebra.orthogonal.PD LieAlgebra.Orthogonal.pD

/-- The split-signature diagonal matrix. -/
def s :=
  indefiniteDiagonal l l R
#align lie_algebra.orthogonal.S LieAlgebra.Orthogonal.s

theorem s_as_blocks : s l R = Matrix.fromBlocks 1 0 0 (-1) :=
  by
  rw [← Matrix.diagonal_one, Matrix.diagonal_neg, Matrix.fromBlocks_diagonal]
  rfl
#align lie_algebra.orthogonal.S_as_blocks LieAlgebra.Orthogonal.s_as_blocks

theorem jD_transform [Fintype l] : (pD l R)ᵀ ⬝ jD l R ⬝ pD l R = (2 : R) • s l R :=
  by
  have h : (PD l R)ᵀ ⬝ JD l R = Matrix.fromBlocks 1 1 1 (-1) := by
    simp [PD, JD, Matrix.fromBlocks_transpose, Matrix.fromBlocks_multiply]
  erw [h, S_as_blocks, Matrix.fromBlocks_multiply, Matrix.fromBlocks_smul]
  congr <;> simp [two_smul]
#align lie_algebra.orthogonal.JD_transform LieAlgebra.Orthogonal.jD_transform

theorem pD_inv [Fintype l] [Invertible (2 : R)] : pD l R * ⅟ (2 : R) • (pD l R)ᵀ = 1 :=
  by
  have h : ⅟ (2 : R) • (1 : Matrix l l R) + ⅟ (2 : R) • 1 = 1 := by
    rw [← smul_add, ← two_smul R _, smul_smul, invOf_mul_self, one_smul]
  erw [Matrix.fromBlocks_transpose, Matrix.fromBlocks_smul, Matrix.mul_eq_mul,
    Matrix.fromBlocks_multiply]
  simp [h]
#align lie_algebra.orthogonal.PD_inv LieAlgebra.Orthogonal.pD_inv

instance invertiblePD [Fintype l] [Invertible (2 : R)] : Invertible (pD l R) :=
  invertibleOfRightInverse _ _ (pD_inv l R)
#align lie_algebra.orthogonal.invertible_PD LieAlgebra.Orthogonal.invertiblePD

/-- An equivalence between two possible definitions of the classical Lie algebra of type D. -/
def typeDEquivSo' [Fintype l] [Invertible (2 : R)] : typeD l R ≃ₗ⁅R⁆ so' l l R :=
  by
  apply (skewAdjointMatricesLieSubalgebraEquiv (JD l R) (PD l R) (by infer_instance)).trans
  apply LieEquiv.ofEq
  ext A
  rw [JD_transform, ← coe_unitOfInvertible (2 : R), ← Units.smul_def, LieSubalgebra.mem_coe,
    mem_skewAdjointMatricesLieSubalgebra_unit_smul]
  rfl
#align lie_algebra.orthogonal.type_D_equiv_so' LieAlgebra.Orthogonal.typeDEquivSo'

/-- A matrix defining a canonical odd-rank symmetric bilinear form.

It looks like this as a `(2l+1) x (2l+1)` matrix of blocks:

   [ 2 0 0 ]
   [ 0 0 1 ]
   [ 0 1 0 ]

where sizes of the blocks are:

   [`1 x 1` `1 x l` `1 x l`]
   [`l x 1` `l x l` `l x l`]
   [`l x 1` `l x l` `l x l`]
-/
def jB :=
  Matrix.fromBlocks ((2 : R) • 1 : Matrix Unit Unit R) 0 0 (jD l R)
#align lie_algebra.orthogonal.JB LieAlgebra.Orthogonal.jB

/-- The classical Lie algebra of type B as a Lie subalgebra of matrices associated to the matrix
`JB`. -/
def typeB [Fintype l] :=
  skewAdjointMatricesLieSubalgebra (jB l R)
#align lie_algebra.orthogonal.type_B LieAlgebra.Orthogonal.typeB

/-- A matrix transforming the bilinear form defined by the matrix `JB` into an
almost-split-signature diagonal matrix.

It looks like this as a `(2l+1) x (2l+1)` matrix of blocks:

   [ 1 0  0 ]
   [ 0 1 -1 ]
   [ 0 1  1 ]

where sizes of the blocks are:

   [`1 x 1` `1 x l` `1 x l`]
   [`l x 1` `l x l` `l x l`]
   [`l x 1` `l x l` `l x l`]
-/
def pB :=
  Matrix.fromBlocks (1 : Matrix Unit Unit R) 0 0 (pD l R)
#align lie_algebra.orthogonal.PB LieAlgebra.Orthogonal.pB

variable [Fintype l]

theorem pB_inv [Invertible (2 : R)] : pB l R * Matrix.fromBlocks 1 0 0 (⅟ (pD l R)) = 1 :=
  by
  rw [PB, Matrix.mul_eq_mul, Matrix.fromBlocks_multiply, Matrix.mul_invOf_self]
  simp only [Matrix.mul_zero, Matrix.mul_one, Matrix.zero_mul, zero_add, add_zero,
    Matrix.fromBlocks_one]
#align lie_algebra.orthogonal.PB_inv LieAlgebra.Orthogonal.pB_inv

instance invertiblePB [Invertible (2 : R)] : Invertible (pB l R) :=
  invertibleOfRightInverse _ _ (pB_inv l R)
#align lie_algebra.orthogonal.invertible_PB LieAlgebra.Orthogonal.invertiblePB

theorem jB_transform : (pB l R)ᵀ ⬝ jB l R ⬝ pB l R = (2 : R) • Matrix.fromBlocks 1 0 0 (s l R) := by
  simp [PB, JB, JD_transform, Matrix.fromBlocks_transpose, Matrix.fromBlocks_multiply,
    Matrix.fromBlocks_smul]
#align lie_algebra.orthogonal.JB_transform LieAlgebra.Orthogonal.jB_transform

theorem indefiniteDiagonal_assoc :
    indefiniteDiagonal (Sum Unit l) l R =
      Matrix.reindexLieEquiv (Equiv.sumAssoc Unit l l).symm
        (Matrix.fromBlocks 1 0 0 (indefiniteDiagonal l l R)) :=
  by
  ext (i j)
  rcases i with ⟨⟨i₁ | i₂⟩ | i₃⟩ <;> rcases j with ⟨⟨j₁ | j₂⟩ | j₃⟩ <;>
      simp only [indefinite_diagonal, Matrix.diagonal, Equiv.sumAssoc_apply_inl_inl,
        Matrix.reindexLieEquiv_apply, Matrix.submatrix_apply, Equiv.symm_symm, Matrix.reindex_apply,
        Sum.elim_inl, if_true, eq_self_iff_true, Matrix.one_apply_eq, Matrix.fromBlocks_apply₁₁,
        DMatrix.zero_apply, Equiv.sumAssoc_apply_inl_inr, if_false, Matrix.fromBlocks_apply₁₂,
        Matrix.fromBlocks_apply₂₁, Matrix.fromBlocks_apply₂₂, Equiv.sumAssoc_apply_inr,
        Sum.elim_inr] <;>
    congr
#align lie_algebra.orthogonal.indefinite_diagonal_assoc LieAlgebra.Orthogonal.indefiniteDiagonal_assoc

/-- An equivalence between two possible definitions of the classical Lie algebra of type B. -/
def typeBEquivSo' [Invertible (2 : R)] : typeB l R ≃ₗ⁅R⁆ so' (Sum Unit l) l R :=
  by
  apply (skewAdjointMatricesLieSubalgebraEquiv (JB l R) (PB l R) (by infer_instance)).trans
  symm
  apply
    (skewAdjointMatricesLieSubalgebraEquivTranspose (indefinite_diagonal (Sum Unit l) l R)
        (Matrix.reindexAlgEquiv _ (Equiv.sumAssoc PUnit l l)) (Matrix.transpose_reindex _ _)).trans
  apply LieEquiv.ofEq
  ext A
  rw [JB_transform, ← coe_unitOfInvertible (2 : R), ← Units.smul_def, LieSubalgebra.mem_coe,
    LieSubalgebra.mem_coe, mem_skewAdjointMatricesLieSubalgebra_unit_smul]
  simpa [indefinite_diagonal_assoc]
#align lie_algebra.orthogonal.type_B_equiv_so' LieAlgebra.Orthogonal.typeBEquivSo'

end Orthogonal

end LieAlgebra


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

Theory of ordered topology.
-/
import order.liminf_limsup
import algebra.big_operators algebra.group algebra.pi_instances
import data.set.intervals data.equiv.algebra
import topology.algebra.group
import topology.constructions topology.uniform_space.uniform_embedding topology.uniform_space.separation

open classical set lattice filter topological_space
local attribute [instance] classical.prop_decidable

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

/-- (Partially) ordered topology
Also called: partially ordered spaces (pospaces).

Usually ordered topology is used for a topology on linear ordered spaces, where the open intervals
are open sets. This is a generalization as for each linear order where open interals are open sets,
the order relation is closed. -/
class ordered_topology (α : Type*) [t : topological_space α] [preorder α] : Prop :=
(is_closed_le' : is_closed (λp:α×α, p.1 ≤ p.2))

instance {α : Type*} : Π [topological_space α], topological_space (order_dual α) := id

section ordered_topology

section preorder
variables [topological_space α] [preorder α] [t : ordered_topology α]
include t

lemma is_closed_le [topological_space β] {f g : β → α} (hf : continuous f) (hg : continuous g) :
  is_closed {b | f b ≤ g b} :=
continuous_iff_is_closed.mp (hf.prod_mk hg) _ t.is_closed_le'

lemma is_closed_le' (a : α) : is_closed {b | b ≤ a} :=
is_closed_le continuous_id continuous_const

lemma is_closed_ge' (a : α) : is_closed {b | a ≤ b} :=
is_closed_le continuous_const continuous_id

instance : ordered_topology (order_dual α) :=
⟨continuous_swap _ (@ordered_topology.is_closed_le' α _ _ _)⟩

lemma is_closed_Icc {a b : α} : is_closed (Icc a b) :=
is_closed_inter (is_closed_ge' a) (is_closed_le' b)

lemma le_of_tendsto_of_tendsto {f g : β → α} {b : filter β} {a₁ a₂ : α} (hb : b ≠ ⊥)
  (hf : tendsto f b (nhds a₁)) (hg : tendsto g b (nhds a₂)) (h : {b | f b ≤ g b} ∈ b) :
  a₁ ≤ a₂ :=
have tendsto (λb, (f b, g b)) b (nhds (a₁, a₂)),
  by rw [nhds_prod_eq]; exact hf.prod_mk hg,
show (a₁, a₂) ∈ {p:α×α | p.1 ≤ p.2},
  from mem_of_closed_of_tendsto hb this t.is_closed_le' h

lemma le_of_tendsto {f : β → α} {a b : α} {x : filter β}
  (nt : x ≠ ⊥) (lim : tendsto f x (nhds a)) (h : f ⁻¹' {c | c ≤ b} ∈ x) : a ≤ b :=
le_of_tendsto_of_tendsto nt lim tendsto_const_nhds h

lemma ge_of_tendsto {f : β → α} {a b : α} {x : filter β}
  (nt : x ≠ ⊥) (lim : tendsto f x (nhds a)) (h : f ⁻¹' {c | b ≤ c} ∈ x) : b ≤ a :=
le_of_tendsto_of_tendsto nt tendsto_const_nhds lim h

@[simp] lemma closure_le_eq [topological_space β] {f g : β → α} (hf : continuous f) (hg : continuous g) :
  closure {b | f b ≤ g b} = {b | f b ≤ g b} :=
closure_eq_iff_is_closed.mpr $ is_closed_le hf hg
end preorder

section partial_order
variables [topological_space α] [partial_order α] [t : ordered_topology α]
include t

private lemma is_closed_eq : is_closed {p : α × α | p.1 = p.2} :=
by simp [le_antisymm_iff];
   exact is_closed_inter t.is_closed_le' (is_closed_le continuous_snd continuous_fst)

instance ordered_topology.to_t2_space : t2_space α :=
{ t2 :=
  have is_open {p : α × α | p.1 ≠ p.2}, from is_closed_eq,
  assume a b h,
  let ⟨u, v, hu, hv, ha, hb, h⟩ := is_open_prod_iff.mp this a b h in
  ⟨u, v, hu, hv, ha, hb,
    set.eq_empty_iff_forall_not_mem.2 $ assume a ⟨h₁, h₂⟩,
    have a ≠ a, from @h (a, a) ⟨h₁, h₂⟩,
    this rfl⟩ }

end partial_order

section linear_order
variables [topological_space α] [linear_order α] [t : ordered_topology α]
include t

lemma is_open_lt [topological_space β] {f g : β → α} (hf : continuous f) (hg : continuous g) :
  is_open {b | f b < g b} :=
by simp [lt_iff_not_ge, -not_le]; exact is_closed_le hg hf

lemma is_open_Ioo {a b : α} : is_open (Ioo a b) :=
is_open_and (is_open_lt continuous_const continuous_id) (is_open_lt continuous_id continuous_const)

lemma is_open_Iio {a : α} : is_open (Iio a) :=
is_open_lt continuous_id continuous_const

end linear_order

section decidable_linear_order
variables [topological_space α] [decidable_linear_order α] [t : ordered_topology α]
  [topological_space β] {f g : β → α}
include t

section
variables (hf : continuous f) (hg : continuous g)
include hf hg

lemma frontier_le_subset_eq : frontier {b | f b ≤ g b} ⊆ {b | f b = g b} :=
assume b ⟨hb₁, hb₂⟩,
le_antisymm
  (by simpa [closure_le_eq hf hg] using hb₁)
  (not_lt.1 $ assume hb : f b < g b,
    have {b | f b < g b} ⊆ interior {b | f b ≤ g b},
      from (subset_interior_iff_subset_of_open $ is_open_lt hf hg).mpr $ assume x, le_of_lt,
    have b ∈ interior {b | f b ≤ g b}, from this hb,
    by exact hb₂ this)

lemma frontier_lt_subset_eq : frontier {b | f b < g b} ⊆ {b | f b = g b} :=
by rw ← frontier_compl;
   convert frontier_le_subset_eq hg hf; simp [ext_iff, eq_comm]

lemma continuous_max : continuous (λb, max (f b) (g b)) :=
have ∀b∈frontier {b | f b ≤ g b}, g b = f b, from assume b hb, (frontier_le_subset_eq hf hg hb).symm,
continuous_if this hg hf

lemma continuous_min : continuous (λb, min (f b) (g b)) :=
have ∀b∈frontier {b | f b ≤ g b}, f b = g b, from assume b hb, frontier_le_subset_eq hf hg hb,
continuous_if this hf hg

end

lemma tendsto_max {b : filter β} {a₁ a₂ : α} (hf : tendsto f b (nhds a₁)) (hg : tendsto g b (nhds a₂)) :
  tendsto (λb, max (f b) (g b)) b (nhds (max a₁ a₂)) :=
show tendsto ((λp:α×α, max p.1 p.2) ∘ (λb, (f b, g b))) b (nhds (max a₁ a₂)),
  from (hf.prod_mk hg).comp
    begin
      rw [←nhds_prod_eq],
      from continuous_iff_continuous_at.mp (continuous_max continuous_fst continuous_snd) _
    end

lemma tendsto_min {b : filter β} {a₁ a₂ : α} (hf : tendsto f b (nhds a₁)) (hg : tendsto g b (nhds a₂)) :
  tendsto (λb, min (f b) (g b)) b (nhds (min a₁ a₂)) :=
show tendsto ((λp:α×α, min p.1 p.2) ∘ (λb, (f b, g b))) b (nhds (min a₁ a₂)),
  from (hf.prod_mk hg).comp
    begin
      rw [←nhds_prod_eq],
      from continuous_iff_continuous_at.mp (continuous_min continuous_fst continuous_snd) _
    end

end decidable_linear_order

end ordered_topology

/-- Topologies generated by the open intervals.

  This is restricted to linear orders. Only then it is guaranteed that they are also a ordered
  topology. -/
class orderable_topology (α : Type*) [t : topological_space α] [partial_order α] : Prop :=
(topology_eq_generate_intervals :
  t = generate_from {s | ∃a, s = {b : α | a < b} ∨ s = {b : α | b < a}})

section orderable_topology

instance {α : Type*} [topological_space α] [partial_order α] [orderable_topology α] :
  orderable_topology (order_dual α) :=
⟨by convert @orderable_topology.topology_eq_generate_intervals α _ _ _;
  conv in (_ ∨ _) { rw or.comm }; refl⟩

section partial_order
variables [topological_space α] [partial_order α] [t : orderable_topology α]
include t

lemma is_open_iff_generate_intervals {s : set α} :
  is_open s ↔ generate_open {s | ∃a, s = {b : α | a < b} ∨ s = {b : α | b < a}} s :=
by rw [t.topology_eq_generate_intervals]; refl

lemma is_open_lt' (a : α) : is_open {b:α | a < b} :=
by rw [@is_open_iff_generate_intervals α _ _ t]; exact generate_open.basic _ ⟨a, or.inl rfl⟩

lemma is_open_gt' (a : α) : is_open {b:α | b < a} :=
by rw [@is_open_iff_generate_intervals α _ _ t]; exact generate_open.basic _ ⟨a, or.inr rfl⟩

lemma lt_mem_nhds {a b : α} (h : a < b) : {b | a < b} ∈ nhds b :=
mem_nhds_sets (is_open_lt' _) h

lemma le_mem_nhds {a b : α} (h : a < b) : {b | a ≤ b} ∈ nhds b :=
(nhds b).sets_of_superset (lt_mem_nhds h) $ assume b hb, le_of_lt hb

lemma gt_mem_nhds {a b : α} (h : a < b) : {a | a < b} ∈ nhds a :=
mem_nhds_sets (is_open_gt' _) h

lemma ge_mem_nhds {a b : α} (h : a < b) : {a | a ≤ b} ∈ nhds a :=
(nhds a).sets_of_superset (gt_mem_nhds h) $ assume b hb, le_of_lt hb

lemma nhds_eq_orderable {a : α} :
  nhds a = (⨅b<a, principal {c | b < c}) ⊓ (⨅b>a, principal {c | c < b}) :=
by rw [t.topology_eq_generate_intervals, nhds_generate_from];
from le_antisymm
  (le_inf
    (le_infi $ assume b, le_infi $ assume hb,
      infi_le_of_le {c : α | b < c} $ infi_le _ ⟨hb, b, or.inl rfl⟩)
    (le_infi $ assume b, le_infi $ assume hb,
      infi_le_of_le {c : α | c < b} $ infi_le _ ⟨hb, b, or.inr rfl⟩))
  (le_infi $ assume s, le_infi $ assume ⟨ha, b, hs⟩,
    match s, ha, hs with
    | _, h, (or.inl rfl) := inf_le_left_of_le $ infi_le_of_le b $ infi_le _ h
    | _, h, (or.inr rfl) := inf_le_right_of_le $ infi_le_of_le b $ infi_le _ h
    end)

lemma tendsto_orderable {f : β → α} {a : α} {x : filter β} :
  tendsto f x (nhds a) ↔ (∀a'<a, {b | a' < f b} ∈ x) ∧ (∀a'>a, {b | a' > f b} ∈ x) :=
by simp [@nhds_eq_orderable α _ _, tendsto_inf, tendsto_infi, tendsto_principal]

/-- Also known as squeeze or sandwich theorem. -/
lemma tendsto_of_tendsto_of_tendsto_of_le_of_le {f g h : β → α} {b : filter β} {a : α}
  (hg : tendsto g b (nhds a)) (hh : tendsto h b (nhds a))
  (hgf : {b | g b ≤ f b} ∈ b) (hfh : {b | f b ≤ h b} ∈ b) :
  tendsto f b (nhds a) :=
tendsto_orderable.2
  ⟨assume a' h',
    have {b : β | a' < g b} ∈ b, from (tendsto_orderable.1 hg).left a' h',
    by filter_upwards [this, hgf] assume a, lt_of_lt_of_le,
    assume a' h',
    have {b : β | h b < a'} ∈ b, from (tendsto_orderable.1 hh).right a' h',
    by filter_upwards [this, hfh] assume a h₁ h₂, lt_of_le_of_lt h₂ h₁⟩

lemma nhds_orderable_unbounded {a : α} (hu : ∃u, a < u) (hl : ∃l, l < a) :
  nhds a = (⨅l (h₂ : l < a) u (h₂ : a < u), principal {x | l < x ∧ x < u }) :=
let ⟨u, hu⟩ := hu, ⟨l, hl⟩ := hl in
calc nhds a = (⨅b<a, principal {c | b < c}) ⊓ (⨅b>a, principal {c | c < b}) : nhds_eq_orderable
  ... = (⨅b<a, principal {c | b < c} ⊓ (⨅b>a, principal {c | c < b})) :
    binfi_inf hl
  ... = (⨅l<a, (⨅u>a, principal {c | c < u} ⊓ principal {c | l < c})) :
    begin
      congr, funext x,
      congr, funext hx,
      rw [inf_comm],
      apply binfi_inf hu
    end
  ... = _ : by simp [inter_comm]; refl

lemma tendsto_orderable_unbounded {f : β → α} {a : α} {x : filter β}
  (hu : ∃u, a < u) (hl : ∃l, l < a) (h : ∀l u, l < a → a < u → {b | l < f b ∧ f b < u } ∈ x) :
  tendsto f x (nhds a) :=
by rw [nhds_orderable_unbounded hu hl];
from (tendsto_infi.2 $ assume l, tendsto_infi.2 $ assume hl,
  tendsto_infi.2 $ assume u, tendsto_infi.2 $ assume hu, tendsto_principal.2 $ h l u hl hu)

end partial_order

theorem induced_orderable_topology' {α : Type u} {β : Type v}
  [partial_order α] [ta : topological_space β] [partial_order β] [orderable_topology β]
  (f : α → β) (hf : ∀ {x y}, f x < f y ↔ x < y)
  (H₁ : ∀ {a x}, x < f a → ∃ b < a, x ≤ f b)
  (H₂ : ∀ {a x}, f a < x → ∃ b > a, f b ≤ x) :
  @orderable_topology _ (induced f ta) _ :=
begin
  letI := induced f ta,
  refine ⟨eq_of_nhds_eq_nhds (λ a, _)⟩,
  rw [nhds_induced_eq_comap, nhds_generate_from, @nhds_eq_orderable β _ _], apply le_antisymm,
  { rw [← map_le_iff_le_comap],
    refine le_inf _ _; refine le_infi (λ x, le_infi $ λ h, le_principal_iff.2 _); simp,
    { rcases H₁ h with ⟨b, ab, xb⟩,
      refine mem_infi_sets _ (mem_infi_sets ⟨ab, b, or.inl rfl⟩ (mem_principal_sets.2 _)),
      exact λ c hc, lt_of_le_of_lt xb (hf.2 hc) },
    { rcases H₂ h with ⟨b, ab, xb⟩,
      refine mem_infi_sets _ (mem_infi_sets ⟨ab, b, or.inr rfl⟩ (mem_principal_sets.2 _)),
      exact λ c hc, lt_of_lt_of_le (hf.2 hc) xb } },
  refine le_infi (λ s, le_infi $ λ hs, le_principal_iff.2 _),
  rcases hs with ⟨ab, b, rfl|rfl⟩,
  { exact mem_comap_sets.2 ⟨{x | f b < x},
      mem_inf_sets_of_left $ mem_infi_sets _ $ mem_infi_sets (hf.2 ab) $ mem_principal_self _,
      λ x, hf.1⟩ },
  { exact mem_comap_sets.2 ⟨{x | x < f b},
      mem_inf_sets_of_right $ mem_infi_sets _ $ mem_infi_sets (hf.2 ab) $ mem_principal_self _,
      λ x, hf.1⟩ }
end

theorem induced_orderable_topology {α : Type u} {β : Type v}
  [partial_order α] [ta : topological_space β] [partial_order β] [orderable_topology β]
  (f : α → β) (hf : ∀ {x y}, f x < f y ↔ x < y)
  (H : ∀ {x y}, x < y → ∃ a, x < f a ∧ f a < y) :
  @orderable_topology _ (induced f ta) _ :=
induced_orderable_topology' f @hf
  (λ a x xa, let ⟨b, xb, ba⟩ := H xa in ⟨b, hf.1 ba, le_of_lt xb⟩)
  (λ a x ax, let ⟨b, ab, bx⟩ := H ax in ⟨b, hf.1 ab, le_of_lt bx⟩)

lemma nhds_top_orderable [topological_space α] [order_top α] [orderable_topology α] :
  nhds (⊤:α) = (⨅l (h₂ : l < ⊤), principal {x | l < x}) :=
by rw [@nhds_eq_orderable α _ _]; simp [(>)]

lemma nhds_bot_orderable [topological_space α] [order_bot α] [orderable_topology α] :
  nhds (⊥:α) = (⨅l (h₂ : ⊥ < l), principal {x | x < l}) :=
by rw [@nhds_eq_orderable α _ _]; simp

section linear_order

variables [topological_space α] [linear_order α] [t : orderable_topology α]
include t

lemma mem_nhds_orderable_dest {a : α} {s : set α} (hs : s ∈ nhds a) :
  ((∃u, u>a) → ∃u, a < u ∧ ∀b, a ≤ b → b < u → b ∈ s) ∧
  ((∃l, l<a) → ∃l, l < a ∧ ∀b, l < b → b ≤ a → b ∈ s) :=
let ⟨t₁, ht₁, t₂, ht₂, hts⟩ :=
  mem_inf_sets.mp $ by rw [@nhds_eq_orderable α _ _ _] at hs; exact hs in
have ht₁ : ((∃l, l<a) → ∃l, l < a ∧ ∀b, l < b → b ∈ t₁) ∧ (∀b, a ≤ b → b ∈ t₁),
  from infi_sets_induct ht₁
    (by simp {contextual := tt})
    (assume a' s₁ s₂ hs₁ ⟨hs₂, hs₃⟩,
      begin
        by_cases a' < a,
        { simp [h] at hs₁,
          letI := classical.DLO α,
          exact ⟨assume hx, let ⟨u, hu₁, hu₂⟩ := hs₂ hx in
            ⟨max u a', max_lt hu₁ h, assume b hb,
              ⟨hs₁ $ lt_of_le_of_lt (le_max_right _ _) hb,
                hu₂ _ $ lt_of_le_of_lt (le_max_left _ _) hb⟩⟩,
            assume b hb, ⟨hs₁ $ lt_of_lt_of_le h hb, hs₃ _ hb⟩⟩ },
        { simp [h] at hs₁, simp [hs₁],
          exact ⟨by simpa using hs₂, hs₃⟩ }
      end)
    (assume s₁ s₂ h ih, and.intro
      (assume hx, let ⟨u, hu₁, hu₂⟩ := ih.left hx in ⟨u, hu₁, assume b hb, h $ hu₂ _ hb⟩)
      (assume b hb, h $ ih.right _ hb)),
have ht₂ : ((∃u, u>a) → ∃u, a < u ∧ ∀b, b < u → b ∈ t₂) ∧ (∀b, b ≤ a → b ∈ t₂),
  from infi_sets_induct ht₂
    (by simp {contextual := tt})
    (assume a' s₁ s₂ hs₁ ⟨hs₂, hs₃⟩,
      begin
        by_cases a' > a,
        { simp [h] at hs₁,
          letI := classical.DLO α,
          exact ⟨assume hx, let ⟨u, hu₁, hu₂⟩ := hs₂ hx in
            ⟨min u a', lt_min hu₁ h, assume b hb,
              ⟨hs₁ $ lt_of_lt_of_le hb (min_le_right _ _),
                hu₂ _ $ lt_of_lt_of_le hb (min_le_left _ _)⟩⟩,
            assume b hb, ⟨hs₁ $ lt_of_le_of_lt hb h, hs₃ _ hb⟩⟩ },
        { simp [h] at hs₁, simp [hs₁],
          exact ⟨by simpa using hs₂, hs₃⟩ }
      end)
    (assume s₁ s₂ h ih, and.intro
      (assume hx, let ⟨u, hu₁, hu₂⟩ := ih.left hx in ⟨u, hu₁, assume b hb, h $ hu₂ _ hb⟩)
      (assume b hb, h $ ih.right _ hb)),
and.intro
  (assume hx, let ⟨u, hu, h⟩ := ht₂.left hx in ⟨u, hu, assume b hb hbu, hts ⟨ht₁.right b hb, h _ hbu⟩⟩)
  (assume hx, let ⟨l, hl, h⟩ := ht₁.left hx in ⟨l, hl, assume b hbl hb, hts ⟨h _ hbl, ht₂.right b hb⟩⟩)

lemma mem_nhds_unbounded {a : α} {s : set α} (hu : ∃u, a < u) (hl : ∃l, l < a) :
  s ∈ nhds a ↔ (∃l u, l < a ∧ a < u ∧ ∀b, l < b → b < u → b ∈ s) :=
let ⟨l, hl'⟩ := hl, ⟨u, hu'⟩ := hu in
have nhds a = (⨅p : {l // l < a} × {u // a < u}, principal {x | p.1.val < x ∧ x < p.2.val }),
  by simp [nhds_orderable_unbounded hu hl, infi_subtype, infi_prod],
iff.intro
  (assume hs, by rw [this] at hs; from infi_sets_induct hs
    ⟨l, u, hl', hu', by simp⟩
    begin
      intro p, rcases p with ⟨⟨l, hl⟩, ⟨u, hu⟩⟩,
      simp [set.subset_def],
      intros s₁ s₂ hs₁ l' hl' u' hu' hs₂,
      letI := classical.DLO α,
      refine ⟨max l l', _, min u u', _⟩;
      simp [*, lt_min_iff, max_lt_iff] {contextual := tt}
    end
    (assume s₁ s₂ h ⟨l, u, h₁, h₂, h₃⟩, ⟨l, u, h₁, h₂, assume b hu hl, h $ h₃ _ hu hl⟩))
  (assume ⟨l, u, hl, hu, h⟩,
    by rw [this]; exact mem_infi_sets ⟨⟨l, hl⟩, ⟨u, hu⟩⟩ (assume b ⟨h₁, h₂⟩, h b h₁ h₂))

lemma order_separated {a₁ a₂ : α} (h : a₁ < a₂) :
  ∃u v : set α, is_open u ∧ is_open v ∧ a₁ ∈ u ∧ a₂ ∈ v ∧ (∀b₁∈u, ∀b₂∈v, b₁ < b₂) :=
match dense_or_discrete h with
| or.inl ⟨a, ha₁, ha₂⟩ := ⟨{a' | a' < a}, {a' | a < a'}, is_open_gt' a, is_open_lt' a, ha₁, ha₂,
    assume b₁ h₁ b₂ h₂, lt_trans h₁ h₂⟩
| or.inr ⟨h₁, h₂⟩ := ⟨{a | a < a₂}, {a | a₁ < a}, is_open_gt' a₂, is_open_lt' a₁, h, h,
    assume b₁ hb₁ b₂ hb₂,
    calc b₁ ≤ a₁ : h₂ _ hb₁
      ... < a₂ : h
      ... ≤ b₂ : h₁ _ hb₂⟩
end

instance orderable_topology.to_ordered_topology : ordered_topology α :=
{ is_closed_le' :=
    is_open_prod_iff.mpr $ assume a₁ a₂ (h : ¬ a₁ ≤ a₂),
      have h : a₂ < a₁, from lt_of_not_ge h,
      let ⟨u, v, hu, hv, ha₁, ha₂, h⟩ := order_separated h in
      ⟨v, u, hv, hu, ha₂, ha₁, assume ⟨b₁, b₂⟩ ⟨h₁, h₂⟩, not_le_of_gt $ h b₂ h₂ b₁ h₁⟩ }

instance orderable_topology.t2_space : t2_space α := by apply_instance

instance orderable_topology.regular_space : regular_space α :=
{ regular := assume s a hs ha,
    have -s ∈ nhds a, from mem_nhds_sets hs ha,
    let ⟨h₁, h₂⟩ := mem_nhds_orderable_dest this in
    have ∃t:set α, is_open t ∧ (∀l∈ s, l < a → l ∈ t) ∧ nhds a ⊓ principal t = ⊥,
      from by_cases
        (assume h : ∃l, l < a,
          let ⟨l, hl, h⟩ := h₂ h in
          match dense_or_discrete hl with
          | or.inl ⟨b, hb₁, hb₂⟩ := ⟨{a | a < b}, is_open_gt' _,
              assume c hcs hca, show c < b,
                from lt_of_not_ge $ assume hbc, h c (lt_of_lt_of_le hb₁ hbc) (le_of_lt hca) hcs,
              inf_principal_eq_bot $ (nhds a).sets_of_superset (mem_nhds_sets (is_open_lt' _) hb₂) $
                assume x (hx : b < x), show ¬ x < b, from not_lt.2 $ le_of_lt hx⟩
          | or.inr ⟨h₁, h₂⟩ := ⟨{a' | a' < a}, is_open_gt' _, assume b hbs hba, hba,
              inf_principal_eq_bot $ (nhds a).sets_of_superset (mem_nhds_sets (is_open_lt' _) hl) $
                assume x (hx : l < x), show ¬ x < a, from not_lt.2 $ h₁ _ hx⟩
          end)
        (assume : ¬ ∃l, l < a, ⟨∅, is_open_empty, assume l _ hl, (this ⟨l, hl⟩).elim,
          by rw [principal_empty, inf_bot_eq]⟩),
    let ⟨t₁, ht₁o, ht₁s, ht₁a⟩ := this in
    have ∃t:set α, is_open t ∧ (∀u∈ s, u>a → u ∈ t) ∧ nhds a ⊓ principal t = ⊥,
      from by_cases
        (assume h : ∃u, u > a,
          let ⟨u, hu, h⟩ := h₁ h in
          match dense_or_discrete hu with
          | or.inl ⟨b, hb₁, hb₂⟩ := ⟨{a | b < a}, is_open_lt' _,
              assume c hcs hca, show c > b,
                from lt_of_not_ge $ assume hbc, h c (le_of_lt hca) (lt_of_le_of_lt hbc hb₂) hcs,
              inf_principal_eq_bot $ (nhds a).sets_of_superset (mem_nhds_sets (is_open_gt' _) hb₁) $
                assume x (hx : b > x), show ¬ x > b, from not_lt.2 $ le_of_lt hx⟩
          | or.inr ⟨h₁, h₂⟩ := ⟨{a' | a' > a}, is_open_lt' _, assume b hbs hba, hba,
              inf_principal_eq_bot $ (nhds a).sets_of_superset (mem_nhds_sets (is_open_gt' _) hu) $
                assume x (hx : u > x), show ¬ x > a, from not_lt.2 $ h₂ _ hx⟩
          end)
        (assume : ¬ ∃u, u > a, ⟨∅, is_open_empty, assume l _ hl, (this ⟨l, hl⟩).elim,
          by rw [principal_empty, inf_bot_eq]⟩),
    let ⟨t₂, ht₂o, ht₂s, ht₂a⟩ := this in
    ⟨t₁ ∪ t₂, is_open_union ht₁o ht₂o,
      assume x hx,
      have x ≠ a, from assume eq, ha $ eq ▸ hx,
      (ne_iff_lt_or_gt.mp this).imp (ht₁s _ hx) (ht₂s _ hx),
      by rw [←sup_principal, inf_sup_left, ht₁a, ht₂a, bot_sup_eq]⟩,
  ..orderable_topology.t2_space }

end linear_order

lemma preimage_neg [add_group α] : preimage (has_neg.neg : α → α) = image (has_neg.neg : α → α) :=
(image_eq_preimage_of_inverse neg_neg neg_neg).symm

lemma filter.map_neg [add_group α] : map (has_neg.neg : α → α) = comap (has_neg.neg : α → α) :=
funext $ assume f, map_eq_comap_of_inverse (funext neg_neg) (funext neg_neg)

section topological_add_group

variables [topological_space α] [ordered_comm_group α] [orderable_topology α] [topological_add_group α]

lemma neg_preimage_closure {s : set α} : (λr:α, -r) ⁻¹' closure s = closure ((λr:α, -r) '' s) :=
have (λr:α, -r) ∘ (λr:α, -r) = id, from funext neg_neg,
by rw [preimage_neg]; exact
  (subset.antisymm (image_closure_subset_closure_image continuous_neg') $
    calc closure ((λ (r : α), -r) '' s) = (λr, -r) '' ((λr, -r) '' closure ((λ (r : α), -r) '' s)) :
        by rw [←image_comp, this, image_id]
      ... ⊆ (λr, -r) '' closure ((λr, -r) '' ((λ (r : α), -r) '' s)) :
        mono_image $ image_closure_subset_closure_image continuous_neg'
      ... = _ : by rw [←image_comp, this, image_id])

end topological_add_group

section order_topology

variables [topological_space α] [topological_space β]
  [linear_order α] [linear_order β] [orderable_topology α] [orderable_topology β]

lemma nhds_principal_ne_bot_of_is_lub {a : α} {s : set α} (ha : is_lub s a) (hs : s ≠ ∅) :
  nhds a ⊓ principal s ≠ ⊥ :=
let ⟨a', ha'⟩ := exists_mem_of_ne_empty hs in
forall_sets_neq_empty_iff_neq_bot.mp $ assume t ht,
  let ⟨t₁, ht₁, t₂, ht₂, ht⟩ := mem_inf_sets.mp ht in
  let ⟨hu, hl⟩ := mem_nhds_orderable_dest ht₁ in
  by_cases
    (assume h : a = a',
      have a ∈ t₁, from mem_of_nhds ht₁,
      have a ∈ t₂, from ht₂ $ by rwa [h],
      ne_empty_iff_exists_mem.mpr ⟨a, ht ⟨‹a ∈ t₁›, ‹a ∈ t₂›⟩⟩)
    (assume : a ≠ a',
      have a' < a, from lt_of_le_of_ne (ha.left _ ‹a' ∈ s›) this.symm,
      let ⟨l, hl, hlt₁⟩ := hl ⟨a', this⟩ in
      have ∃a'∈s, l < a',
        from classical.by_contradiction $ assume : ¬ ∃a'∈s, l < a',
          have ∀a'∈s, a' ≤ l, from assume a ha, not_lt.1 $ assume ha', this ⟨a, ha, ha'⟩,
          have ¬ l < a, from not_lt.2 $ ha.right _ this,
          this ‹l < a›,
      let ⟨a', ha', ha'l⟩ := this in
      have a' ∈ t₁, from hlt₁ _ ‹l < a'›  $ ha.left _ ha',
      ne_empty_iff_exists_mem.mpr ⟨a', ht ⟨‹a' ∈ t₁›, ht₂ ‹a' ∈ s›⟩⟩)

lemma nhds_principal_ne_bot_of_is_glb : ∀ {a : α} {s : set α}, is_glb s a → s ≠ ∅ →
  nhds a ⊓ principal s ≠ ⊥ :=
@nhds_principal_ne_bot_of_is_lub (order_dual α) _ _ _

lemma is_lub_of_mem_nhds {s : set α} {a : α} {f : filter α}
  (hsa : a ∈ upper_bounds s) (hsf : s ∈ f) (hfa : f ⊓ nhds a ≠ ⊥) : is_lub s a :=
⟨hsa, assume b hb,
  not_lt.1 $ assume hba,
  have s ∩ {a | b < a} ∈ f ⊓ nhds a,
    from inter_mem_inf_sets hsf (mem_nhds_sets (is_open_lt' _) hba),
  let ⟨x, ⟨hxs, hxb⟩⟩ := inhabited_of_mem_sets hfa this in
  have b < b, from lt_of_lt_of_le hxb $ hb _ hxs,
  lt_irrefl b this⟩

lemma is_glb_of_mem_nhds : ∀ {s : set α} {a : α} {f : filter α},
  a ∈ lower_bounds s → s ∈ f → f ⊓ nhds a ≠ ⊥ → is_glb s a :=
@is_lub_of_mem_nhds (order_dual α) _ _ _

lemma is_lub_of_is_lub_of_tendsto {f : α → β} {s : set α} {a : α} {b : β}
  (hf : ∀x∈s, ∀y∈s, x ≤ y → f x ≤ f y) (ha : is_lub s a) (hs : s ≠ ∅)
  (hb : tendsto f (nhds a ⊓ principal s) (nhds b)) : is_lub (f '' s) b :=
have hnbot : (nhds a ⊓ principal s) ≠ ⊥, from nhds_principal_ne_bot_of_is_lub ha hs,
have ∀a'∈s, ¬ b < f a',
  from assume a' ha' h,
  have {x | x < f a'} ∈ nhds b, from mem_nhds_sets (is_open_gt' _) h,
  let ⟨t₁, ht₁, t₂, ht₂, hs⟩ := mem_inf_sets.mp (hb this) in
  by_cases
    (assume h : a = a',
      have a ∈ t₁ ∩ t₂, from ⟨mem_of_nhds ht₁, ht₂ $ by rwa [h]⟩,
      have f a < f a', from hs this,
      lt_irrefl (f a') $ by rwa [h] at this)
    (assume h : a ≠ a',
      have a' < a, from lt_of_le_of_ne (ha.left _ ha') h.symm,
      have {x | a' < x} ∈ nhds a, from mem_nhds_sets (is_open_lt' _) this,
      have {x | a' < x} ∩ t₁ ∈ nhds a, from inter_mem_sets this ht₁,
      have ({x | a' < x} ∩ t₁) ∩ s ∈ nhds a ⊓ principal s,
        from inter_mem_inf_sets this (subset.refl s),
      let ⟨x, ⟨hx₁, hx₂⟩, hx₃⟩ := inhabited_of_mem_sets hnbot this in
      have hxa' : f x < f a', from hs ⟨hx₂, ht₂ hx₃⟩,
      have ha'x : f a' ≤ f x, from hf _ ha' _ hx₃ $ le_of_lt hx₁,
      lt_irrefl _ (lt_of_le_of_lt ha'x hxa')),
and.intro
  (assume b' ⟨a', ha', h_eq⟩, h_eq ▸ not_lt.1 $ this _ ha')
  (assume b' hb', le_of_tendsto hnbot hb $
      mem_inf_sets_of_right $ assume x hx, hb' _ $ mem_image_of_mem _ hx)

lemma is_glb_of_is_glb_of_tendsto {f : α → β} {s : set α} {a : α} {b : β}
  (hf : ∀x∈s, ∀y∈s, x ≤ y → f x ≤ f y) : is_glb s a → s ≠ ∅ →
  tendsto f (nhds a ⊓ principal s) (nhds b) → is_glb (f '' s) b :=
@is_lub_of_is_lub_of_tendsto (order_dual α) (order_dual β) _ _ _ _ _ _ f s a b
  (λ x hx y hy, hf y hy x hx)

lemma is_glb_of_is_lub_of_tendsto : ∀ {f : α → β} {s : set α} {a : α} {b : β},
  (∀x∈s, ∀y∈s, x ≤ y → f y ≤ f x) → is_lub s a → s ≠ ∅ →
  tendsto f (nhds a ⊓ principal s) (nhds b) → is_glb (f '' s) b :=
@is_lub_of_is_lub_of_tendsto α (order_dual β) _ _ _ _ _ _

lemma is_lub_of_is_glb_of_tendsto : ∀ {f : α → β} {s : set α} {a : α} {b : β},
  (∀x∈s, ∀y∈s, x ≤ y → f y ≤ f x) → is_glb s a → s ≠ ∅ →
  tendsto f (nhds a ⊓ principal s) (nhds b) → is_lub (f '' s) b :=
@is_glb_of_is_glb_of_tendsto α (order_dual β) _ _ _ _ _ _

lemma mem_closure_of_is_lub {a : α} {s : set α} (ha : is_lub s a) (hs : s ≠ ∅) : a ∈ closure s :=
by rw closure_eq_nhds; exact nhds_principal_ne_bot_of_is_lub ha hs

lemma mem_of_is_lub_of_is_closed {a : α} {s : set α} (ha : is_lub s a) (hs : s ≠ ∅) (sc : is_closed s): a ∈ s :=
by rw ←closure_eq_of_is_closed sc; exact mem_closure_of_is_lub ha hs

lemma mem_closure_of_is_glb {a : α} {s : set α} (ha : is_glb s a) (hs : s ≠ ∅) : a ∈ closure s :=
by rw closure_eq_nhds; exact nhds_principal_ne_bot_of_is_glb ha hs

lemma mem_of_is_glb_of_is_closed {a : α} {s : set α} (ha : is_glb s a) (hs : s ≠ ∅) (sc : is_closed s): a ∈ s :=
by rw ←closure_eq_of_is_closed sc; exact mem_closure_of_is_glb ha hs

/-- A compact set is bounded below -/
lemma bdd_below_of_compact {α : Type u} [topological_space α] [linear_order α]
  [ordered_topology α] [nonempty α] {s : set α} (hs : compact s) : bdd_below s :=
begin
  by_contra H,
  letI := classical.DLO α,
  rcases @compact_elim_finite_subcover_image α _ _ _ s (λ x, {b | x < b}) hs
    (λ x _, is_open_lt continuous_const continuous_id) _ with ⟨t, st, ft, ht⟩,
  { refine H ((bdd_below_finite ft).imp $ λ C hC y hy, _),
    rcases mem_bUnion_iff.1 (ht hy) with ⟨x, hx, xy⟩,
    exact le_trans (hC _ hx) (le_of_lt xy) },
  { refine λ x hx, mem_bUnion_iff.2 (not_imp_comm.1 _ H),
    exact λ h, ⟨x, λ y hy, le_of_not_lt (h.imp $ λ ys, ⟨_, hy, ys⟩)⟩ }
end

/-- A compact set is bounded above -/
lemma bdd_above_of_compact {α : Type u} [topological_space α] [linear_order α]
  [orderable_topology α] : Π [nonempty α] {s : set α}, compact s → bdd_above s :=
@bdd_below_of_compact (order_dual α) _ _ _

end order_topology

section complete_linear_order

variables [complete_linear_order α] [topological_space α] [orderable_topology α]
  [complete_linear_order β] [topological_space β] [orderable_topology β] [nonempty γ]

lemma Sup_mem_closure {α : Type u} [topological_space α] [complete_linear_order α] [orderable_topology α]
  {s : set α} (hs : s ≠ ∅) : Sup s ∈ closure s :=
mem_closure_of_is_lub is_lub_Sup hs

lemma Inf_mem_closure {α : Type u} [topological_space α] [complete_linear_order α] [orderable_topology α]
  {s : set α} (hs : s ≠ ∅) : Inf s ∈ closure s :=
mem_closure_of_is_glb is_glb_Inf hs

lemma Sup_mem_of_is_closed {α : Type u} [topological_space α] [complete_linear_order α] [orderable_topology α]
  {s : set α} (hs : s ≠ ∅) (hc : is_closed s) : Sup s ∈ s :=
mem_of_is_lub_of_is_closed  is_lub_Sup hs hc

lemma Inf_mem_of_is_closed {α : Type u} [topological_space α] [complete_linear_order α] [orderable_topology α]
  {s : set α} (hs : s ≠ ∅) (hc : is_closed s) : Inf s ∈ s :=
mem_of_is_glb_of_is_closed  is_glb_Inf hs hc

/-- A continuous monotone function sends supremum to supremum for nonempty sets. -/
lemma Sup_of_continuous' {f : α → β} (Mf : continuous f) (Cf : monotone f)
  {s : set α} (hs : s ≠ ∅) : f (Sup s) = Sup (f '' s) :=
--This is a particular case of the more general is_lub_of_is_lub_of_tendsto
(is_lub_iff_Sup_eq.1
  (is_lub_of_is_lub_of_tendsto (λ x hx y hy xy, Cf xy) is_lub_Sup hs $
    tendsto_le_left inf_le_left (continuous.tendsto Mf _))).symm

/-- A continuous monotone function sending bot to bot sends supremum to supremum. -/
lemma Sup_of_continuous {f : α → β} (Mf : continuous f) (Cf : monotone f)
  (fbot : f ⊥ = ⊥) {s : set α} : f (Sup s) = Sup (f '' s) :=
begin
  by_cases (s = ∅),
  { simpa [h] },
  { exact Sup_of_continuous' Mf Cf h }
end

/-- A continuous monotone function sends indexed supremum to indexed supremum. -/
lemma supr_of_continuous {f : α → β} {g : γ → α}
  (Mf : continuous f) (Cf : monotone f) : f (supr g) = supr (f ∘ g) :=
by rw [supr, Sup_of_continuous' Mf Cf
  (λ h, range_eq_empty.1 h ‹_›), ← range_comp]; refl

/-- A continuous monotone function sends infimum to infimum for nonempty sets. -/
lemma Inf_of_continuous' {f : α → β} (Mf : continuous f) (Cf : monotone f)
  {s : set α} (hs : s ≠ ∅) : f (Inf s) = Inf (f '' s) :=
(is_glb_iff_Inf_eq.1
  (is_glb_of_is_glb_of_tendsto (λ x hx y hy xy, Cf xy) is_glb_Inf hs $
    tendsto_le_left inf_le_left (continuous.tendsto Mf _))).symm

/-- A continuous monotone function sending top to top sends infimum to infimum. -/
lemma Inf_of_continuous {f : α → β} (Mf : continuous f) (Cf : monotone f)
  (ftop : f ⊤ = ⊤) {s : set α} : f (Inf s) = Inf (f '' s) :=
begin
  by_cases (s = ∅),
  { simpa [h] },
  { exact Inf_of_continuous' Mf Cf h }
end

/-- A continuous monotone function sends indexed infimum to indexed infimum. -/
lemma infi_of_continuous {f : α → β} {g : γ → α}
  (Mf : continuous f) (Cf : monotone f) : f (infi g) = infi (f ∘ g) :=
by rw [infi, Inf_of_continuous' Mf Cf
  (λ h, range_eq_empty.1 h ‹_›), ← range_comp]; refl

end complete_linear_order

section conditionally_complete_linear_order

variables [conditionally_complete_linear_order α] [topological_space α] [orderable_topology α]
  [conditionally_complete_linear_order β] [topological_space β] [orderable_topology β] [nonempty γ]

lemma cSup_mem_closure {α : Type u} [topological_space α] [conditionally_complete_linear_order α] [orderable_topology α]
  {s : set α} (hs : s ≠ ∅) (B : bdd_above s) : Sup s ∈ closure s :=
mem_closure_of_is_lub (is_lub_cSup hs B) hs

lemma cInf_mem_closure {α : Type u} [topological_space α] [conditionally_complete_linear_order α] [orderable_topology α]
  {s : set α} (hs : s ≠ ∅) (B : bdd_below s) : Inf s ∈ closure s :=
mem_closure_of_is_glb (is_glb_cInf hs B) hs

lemma cSup_mem_of_is_closed {α : Type u} [topological_space α] [conditionally_complete_linear_order α] [orderable_topology α]
  {s : set α} (hs : s ≠ ∅) (hc : is_closed s) (B : bdd_above s) : Sup s ∈ s :=
mem_of_is_lub_of_is_closed (is_lub_cSup hs B) hs hc

lemma cInf_mem_of_is_closed {α : Type u} [topological_space α] [conditionally_complete_linear_order α] [orderable_topology α]
  {s : set α} (hs : s ≠ ∅) (hc : is_closed s) (B : bdd_below s) : Inf s ∈ s :=
mem_of_is_glb_of_is_closed (is_glb_cInf hs B) hs hc

/-- A continuous monotone function sends supremum to supremum in conditionally complete
lattices, under a boundedness assumption. -/
lemma cSup_of_cSup_of_monotone_of_continuous {f : α → β} (Mf : continuous f) (Cf : monotone f)
  {s : set α} (ne : s ≠ ∅) (H : bdd_above s) : f (Sup s) = Sup (f '' s) :=
begin
  refine (is_lub_iff_eq_of_is_lub _).1
    (is_lub_cSup (mt image_eq_empty.1 ne) (bdd_above_of_bdd_above_of_monotone Cf H)),
  refine is_lub_of_is_lub_of_tendsto (λx hx y hy xy, Cf xy) (is_lub_cSup ne H) ne _,
  exact tendsto_le_left inf_le_left (continuous.tendsto Mf _)
end

/-- A continuous monotone function sends indexed supremum to indexed supremum in conditionally complete
lattices, under a boundedness assumption. -/
lemma csupr_of_csupr_of_monotone_of_continuous {f : α → β} {g : γ → α}
  (Mf : continuous f) (Cf : monotone f) (H : bdd_above (range g)) : f (supr g) = supr (f ∘ g) :=
by rw [supr, cSup_of_cSup_of_monotone_of_continuous Mf Cf
  (λ h, range_eq_empty.1 h ‹_›) H, ← range_comp]; refl

/-- A continuous monotone function sends infimum to infimum in conditionally complete
lattices, under a boundedness assumption. -/
lemma cInf_of_cInf_of_monotone_of_continuous {f : α → β} (Mf : continuous f) (Cf : monotone f)
  {s : set α} (ne : s ≠ ∅) (H : bdd_below s) : f (Inf s) = Inf (f '' s) :=
begin
  refine (is_glb_iff_eq_of_is_glb _).1
    (is_glb_cInf (mt image_eq_empty.1 ne) (bdd_below_of_bdd_below_of_monotone Cf H)),
  refine is_glb_of_is_glb_of_tendsto (λx hx y hy xy, Cf xy) (is_glb_cInf ne H) ne _,
  exact tendsto_le_left inf_le_left (continuous.tendsto Mf _)
end

/-- A continuous monotone function sends indexed infimum to indexed infimum in conditionally complete
lattices, under a boundedness assumption. -/
lemma cinfi_of_cinfi_of_monotone_of_continuous {f : α → β} {g : γ → α}
  (Mf : continuous f) (Cf : monotone f) (H : bdd_below (range g)): f (infi g) = infi (f ∘ g) :=
by rw [infi, cInf_of_cInf_of_monotone_of_continuous Mf Cf
  (λ h, range_eq_empty.1 h ‹_›) H, ← range_comp]; refl

/-- The extreme value theorem: a continuous function realizes its minimum on a compact set -/
lemma exists_forall_le_of_compact_of_continuous {α : Type u} [topological_space α]
  (f : α → β) (hf : continuous f) (s : set α) (hs : compact s) (ne_s : s ≠ ∅) :
  ∃x∈s, ∀y∈s, f x ≤ f y :=
begin
  have C : compact (f '' s) := compact_image hs hf,
  haveI := has_Inf_to_nonempty β,
  have B : bdd_below (f '' s) := bdd_below_of_compact C,
  have : Inf (f '' s) ∈ f '' s :=
    cInf_mem_of_is_closed (mt image_eq_empty.1 ne_s) (closed_of_compact _ C) B,
  rcases (mem_image _ _ _).1 this with ⟨x, xs, hx⟩,
  exact ⟨x, xs, λ y hy, hx.symm ▸ cInf_le B ⟨_, hy, rfl⟩⟩
end

/-- The extreme value theorem: a continuous function realizes its maximum on a compact set -/
lemma exists_forall_ge_of_compact_of_continuous {α : Type u} [topological_space α] :
  ∀ f : α → β, continuous f → ∀ s : set α, compact s → s ≠ ∅ →
  ∃x∈s, ∀y∈s, f y ≤ f x :=
@exists_forall_le_of_compact_of_continuous (order_dual β) _ _ _ _ _

end conditionally_complete_linear_order

section liminf_limsup

section ordered_topology
variables [semilattice_sup α] [topological_space α] [orderable_topology α]

lemma is_bounded_le_nhds (a : α) : (nhds a).is_bounded (≤) :=
match forall_le_or_exists_lt_sup a with
| or.inl h := ⟨a, show {x : α | x ≤ a} ∈ nhds a, from univ_mem_sets' h⟩
| or.inr ⟨b, hb⟩ := ⟨b, ge_mem_nhds hb⟩
end

lemma is_bounded_under_le_of_tendsto {f : filter β} {u : β → α} {a : α}
  (h : tendsto u f (nhds a)) : f.is_bounded_under (≤) u :=
is_bounded_of_le h (is_bounded_le_nhds a)

lemma is_cobounded_ge_nhds (a : α) : (nhds a).is_cobounded (≥) :=
is_cobounded_of_is_bounded nhds_neq_bot (is_bounded_le_nhds a)

lemma is_cobounded_under_ge_of_tendsto {f : filter β} {u : β → α} {a : α}
  (hf : f ≠ ⊥) (h : tendsto u f (nhds a)) : f.is_cobounded_under (≥) u :=
is_cobounded_of_is_bounded (map_ne_bot hf) (is_bounded_under_le_of_tendsto h)

end ordered_topology

section ordered_topology
variables [semilattice_inf α] [topological_space α] [orderable_topology α]

lemma is_bounded_ge_nhds (a : α) : (nhds a).is_bounded (≥) :=
match forall_le_or_exists_lt_inf a with
| or.inl h := ⟨a, show {x : α | a ≤ x} ∈ nhds a, from univ_mem_sets' h⟩
| or.inr ⟨b, hb⟩ := ⟨b, le_mem_nhds hb⟩
end

lemma is_bounded_under_ge_of_tendsto {f : filter β} {u : β → α} {a : α}
  (h : tendsto u f (nhds a)) : f.is_bounded_under (≥) u :=
is_bounded_of_le h (is_bounded_ge_nhds a)

lemma is_cobounded_le_nhds (a : α) : (nhds a).is_cobounded (≤) :=
is_cobounded_of_is_bounded nhds_neq_bot (is_bounded_ge_nhds a)

lemma is_cobounded_under_le_of_tendsto {f : filter β} {u : β → α} {a : α}
  (hf : f ≠ ⊥) (h : tendsto u f (nhds a)) : f.is_cobounded_under (≤) u :=
is_cobounded_of_is_bounded (map_ne_bot hf) (is_bounded_under_ge_of_tendsto h)

end ordered_topology

section conditionally_complete_linear_order
variables [conditionally_complete_linear_order α] [topological_space α] [orderable_topology α]

theorem lt_mem_sets_of_Limsup_lt {f : filter α} {b} (h : f.is_bounded (≤)) (l : f.Limsup < b) :
  {a | a < b} ∈ f :=
let ⟨c, (h : {a : α | a ≤ c} ∈ f), hcb⟩ :=
  exists_lt_of_cInf_lt (ne_empty_iff_exists_mem.2 h) l in
mem_sets_of_superset h $ assume a hac, lt_of_le_of_lt hac hcb

theorem gt_mem_sets_of_Liminf_gt : ∀ {f : filter α} {b}, f.is_bounded (≥) → f.Liminf > b →
  {a | a > b} ∈ f :=
@lt_mem_sets_of_Limsup_lt (order_dual α) _ _ _

/-- If the liminf and the limsup of a filter coincide, then this filter converges to
their common value, at least if the filter is eventually bounded above and below. -/
theorem le_nhds_of_Limsup_eq_Liminf {f : filter α} {a : α}
  (hl : f.is_bounded (≤)) (hg : f.is_bounded (≥)) (hs : f.Limsup = a) (hi : f.Liminf = a) :
  f ≤ nhds a :=
tendsto_orderable.2 $ and.intro
  (assume b hb, gt_mem_sets_of_Liminf_gt hg $ hi.symm ▸ hb)
  (assume b hb, lt_mem_sets_of_Limsup_lt hl $ hs.symm ▸ hb)

theorem Limsup_nhds (a : α) : Limsup (nhds a) = a :=
cInf_intro (ne_empty_iff_exists_mem.2 $ is_bounded_le_nhds a)
  (assume a' (h : {n : α | n ≤ a'} ∈ nhds a), show a ≤ a', from @mem_of_nhds α _ a _ h)
  (assume b (hba : a < b), show ∃c (h : {n : α | n ≤ c} ∈ nhds a), c < b, from
    match dense_or_discrete hba with
    | or.inl ⟨c, hac, hcb⟩ := ⟨c, ge_mem_nhds hac, hcb⟩
    | or.inr ⟨_, h⟩        := ⟨a, (nhds a).sets_of_superset (gt_mem_nhds hba) h, hba⟩
    end)

theorem Liminf_nhds : ∀ (a : α), Liminf (nhds a) = a :=
@Limsup_nhds (order_dual α) _ _ _

/-- If a filter is converging, its limsup coincides with its limit. -/
theorem Liminf_eq_of_le_nhds {f : filter α} {a : α} (hf : f ≠ ⊥) (h : f ≤ nhds a) : f.Liminf = a :=
have hb_ge : is_bounded (≥) f, from is_bounded_of_le h (is_bounded_ge_nhds a),
have hb_le : is_bounded (≤) f, from is_bounded_of_le h (is_bounded_le_nhds a),
le_antisymm
  (calc f.Liminf ≤ f.Limsup : Liminf_le_Limsup hf hb_le hb_ge
    ... ≤ (nhds a).Limsup :
      Limsup_le_Limsup_of_le h (is_cobounded_of_is_bounded hf hb_ge) (is_bounded_le_nhds a)
    ... = a : Limsup_nhds a)
  (calc a = (nhds a).Liminf : (Liminf_nhds a).symm
    ... ≤ f.Liminf :
      Liminf_le_Liminf_of_le h (is_bounded_ge_nhds a) (is_cobounded_of_is_bounded hf hb_le))

/-- If a filter is converging, its liminf coincides with its limit. -/
theorem Limsup_eq_of_le_nhds : ∀ {f : filter α} {a : α}, f ≠ ⊥ → f ≤ nhds a → f.Limsup = a :=
@Liminf_eq_of_le_nhds (order_dual α) _ _ _

end conditionally_complete_linear_order

end liminf_limsup

end orderable_topology

lemma orderable_topology_of_nhds_abs
  {α : Type*} [decidable_linear_ordered_comm_group α] [topological_space α]
  (h_nhds : ∀a:α, nhds a = (⨅r>0, principal {b | abs (a - b) < r})) : orderable_topology α :=
orderable_topology.mk $ eq_of_nhds_eq_nhds $ assume a:α, le_antisymm_iff.mpr
begin
  simp [infi_and, topological_space.nhds_generate_from,
        h_nhds, le_infi_iff, -le_principal_iff, and_comm],
  refine ⟨λ s ha b hs, _, λ r hr, _⟩,
  { rcases hs with rfl | rfl,
    { refine infi_le_of_le (a - b)
        (infi_le_of_le (lt_sub_left_of_add_lt $ by simpa using ha) $
          principal_mono.mpr $ assume c (hc : abs (a - c) < a - b), _),
      have : a - c < a - b := lt_of_le_of_lt (le_abs_self _) hc,
      exact lt_of_neg_lt_neg (lt_of_add_lt_add_left this) },
    { refine infi_le_of_le (b - a)
        (infi_le_of_le (lt_sub_left_of_add_lt $ by simpa using ha) $
          principal_mono.mpr $ assume c (hc : abs (a - c) < b - a), _),
      have : abs (c - a) < b - a, {rw abs_sub; simpa using hc},
      have : c - a < b - a := lt_of_le_of_lt (le_abs_self _) this,
      exact lt_of_add_lt_add_right this } },
  { have h : {b | abs (a + -b) < r} = {b | a - r < b} ∩ {b | b < a + r},
      from set.ext (assume b,
        by simp [abs_lt, -sub_eq_add_neg, (sub_eq_add_neg _ _).symm,
          sub_lt, lt_sub_iff_add_lt, and_comm, sub_lt_iff_lt_add']),
    rw [h, ← inf_principal],
    apply le_inf _ _,
    { exact infi_le_of_le {b : α | a - r < b} (infi_le_of_le (sub_lt_self a hr) $
        infi_le_of_le (a - r) $ infi_le _ (or.inl rfl)) },
    { exact infi_le_of_le {b : α | b < a + r} (infi_le_of_le (lt_add_of_pos_right _ hr) $
        infi_le_of_le (a + r) $ infi_le _ (or.inr rfl)) } }
end

lemma tendsto_at_top_supr_nat [topological_space α] [complete_linear_order α] [orderable_topology α]
  (f : ℕ → α) (hf : monotone f) : tendsto f at_top (nhds (⨆i, f i)) :=
tendsto_orderable.2 $ and.intro
  (assume a ha, let ⟨n, hn⟩ := lt_supr_iff.1 ha in
    mem_at_top_sets.2 ⟨n, assume i hi, lt_of_lt_of_le hn (hf hi)⟩)
  (assume a ha, univ_mem_sets' (assume n, lt_of_le_of_lt (le_supr _ n) ha))

lemma tendsto_at_top_infi_nat [topological_space α] [complete_linear_order α] [orderable_topology α]
  (f : ℕ → α) (hf : ∀{n m}, n ≤ m → f m ≤ f n) : tendsto f at_top (nhds (⨅i, f i)) :=
@tendsto_at_top_supr_nat (order_dual α) _ _ _ _ @hf

lemma supr_eq_of_tendsto {α} [topological_space α] [complete_linear_order α] [orderable_topology α]
  {f : ℕ → α} {a : α} (hf : monotone f) : tendsto f at_top (nhds a) → supr f = a :=
tendsto_nhds_unique at_top_ne_bot (tendsto_at_top_supr_nat f hf)

lemma infi_eq_of_tendsto {α} [topological_space α] [complete_linear_order α] [orderable_topology α]
  {f : ℕ → α} {a : α} (hf : ∀n m, n ≤ m → f m ≤ f n) : tendsto f at_top (nhds a) → infi f = a :=
tendsto_nhds_unique at_top_ne_bot (tendsto_at_top_infi_nat f hf)


/- ------------------------------------------------------------------------- -|
| @project: riemann_hypothesis                                                |
| @file:    riemann_zeta.lean                                                 |
| @authors: Brandon H. Gomes, Alex Kontorovich                                |
| @affil:   Rutgers University                                                |
|- ------------------------------------------------------------------------- -/

import .cauchy

/-!
-/

namespace riemann_hypothesis --——————————————————————————————————————————————————————————--
namespace riemann_zeta --————————————————————————————————————————————————————————————————--
variables {ℝ : Type*}
          [has_lift_t nat ℝ] [preorder ℝ] [has_zero ℝ] [has_one ℝ]
          [has_neg ℝ] [has_add ℝ] [has_sub ℝ] [has_mul ℝ] [has_inv ℝ]

open algebra

/--
-/
def term {α β γ}
    [has_zero α]
    [has_lt α]
    [has_lift_t nat α]
    [has_lift_zero_same nat α]
    [has_lift_lt_comm nat α]
    [has_neg β]
    (pow : Π a : α, 0 < a → β → γ)
    (s n)
    := pow ↑(nat.succ n) (nat.lift.succ_pos α _) (-s)

namespace term --——————————————————————————————————————————————————————————————————————————--

/--
`ζ` Series Term for Real Inputs

`ζₙ(σ) := (n+1) ^ -σ`
-/
def on_reals
    [has_lift_zero_same nat ℝ]
    [has_lift_lt_comm nat ℝ]
    (ℯ : ExpLog ℝ ℝ)
    (σ n)
    := term ℯ.pow σ n

/--
-/
def on_reals.nonneg
    [has_lift_zero_same nat ℝ]
    [has_lift_lt_comm nat ℝ]
    (ℯ : ExpLog ℝ ℝ)
    (σ n)
    : 0 ≤ on_reals ℯ σ n
    := le_of_lt (ExpLog.exp_positive _ _)

/--
-/
def on_reals.non_increasing
    [has_left_unit ℝ]
    [has_mul_zero_is_zero ℝ]
    [has_left_sub_distributivity ℝ]
    [has_inv_reverses_lt ℝ]
    [has_lt_pos_mul_preserves_right ℝ]
    [has_zero_sub_is_neg ℝ]
    [has_lift_lt_comm nat ℝ]
    [has_lift_zero_same nat ℝ]
    (ℯ : ExpLog ℝ ℝ)
    (σ σpos)
    : non_increasing (on_reals ℯ σ) :=
    begin
        intros _,

        rw [on_reals, on_reals, term, term],
        rw ← has_zero_sub_is_neg.eq,
        rw [ExpLog.pow_neg_exponent_inverts, ExpLog.pow_neg_exponent_inverts],

        refine le_of_lt
            (has_inv_reverses_lt.lt
                (ExpLog.pow_monotonic _ _ _ σpos
                    (has_lift_lt_comm.lt (nat.lt_succ_self _)))),
    end

/--
-/
def on_reals.rewrite.pow_reduction
    [has_left_add_distributivity ℝ]
    [has_right_add_distributivity ℝ]
    [has_left_sub_distributivity ℝ]

    [has_left_unit ℝ]
    [has_right_unit ℝ]

    [has_zero_mul_is_zero ℝ]
    [has_mul_zero_is_zero ℝ]

    [has_zero_sub_is_neg ℝ]

    [has_mul_pos ℝ]

    [has_lift_one_same nat ℝ]
    [has_lift_zero_same nat ℝ]
    [has_lift_add_comm nat ℝ]
    [has_lift_mul_comm nat ℝ]
    [has_lift_lt_comm nat ℝ]
    [has_lift_le_comm nat ℝ]

    (ℯ : ExpLog ℝ ℝ)

    (σ) (n : nat)

    : ↑(2 ^ n) * on_reals ℯ σ (2 ^ n - 1)
    = ℯ.pow (ℯ.pow ↑2 _ (1 - σ)) (ℯ.pow_positivity _ (nat.lift.succ_pos ℝ _) _) ↑n :=

    begin
        have lifted_pow2_pos : Π k : nat, 0 < (↑(2 ^ k) : ℝ),
            intros k,
            refine (lt_of_lt_of_le (nat.lift.zero_lt_one ℝ) _),
            rw one_is_lifted_one_lemma nat ℝ,
            refine has_lift_le_comm.le (nat.pow_two_ge_one _),

        rw [on_reals, term],
        rw ← ℯ.pow_id_at_one ↑(_) (lifted_pow2_pos _),

        rw ExpLog.pow_domain_irrel _
            ↑(nat.succ (2 ^ n - 1)) _ _ (lifted_pow2_pos _) _
            (by rw [nat.succ_eq_add_one, nat.sub_add_cancel (nat.pow_two_ge_one _)]),

        rw ℯ.pow_homomorphism_inv_from_neg,

        induction n with n hn,
            rw has_lift_zero_same.eq,
            rw ExpLog.pow_homomorphism_zero,

            rw ExpLog.pow_domain_irrel _ ↑(2 ^ 0) _ (1 : ℝ) _ _
                (by rw [nat.pow_zero, has_lift_one_same.eq]),

            rw ExpLog.pow_homomorphism_one,

            rw ℯ.pow_succ_reduce _
                (ℯ.pow_positivity _ (nat.lift.succ_pos ℝ _) _),

            have scaled_pow_ineq : 0 < (↑(2 ^ n) * ↑2 : ℝ),
                rw zero_is_lifted_zero_lemma nat ℝ,
                rw ← has_lift_mul_comm.eq,
                rw ← nat.pow_succ,
                refine has_lift_lt_comm.lt
                    (lt_of_lt_of_le (nat.zero_lt_one) (nat.pow_two_ge_one _)),

            rw ExpLog.pow_domain_irrel _ ↑(2 ^ n.succ) _ _ scaled_pow_ineq _
                (by rw [nat.pow_succ, has_lift_mul_comm.eq]),

            rw ℯ.pow_homomorphism_mul _
                (lifted_pow2_pos _) _ (nat.lift.succ_pos ℝ _) _,

            rw hn,
    end

end term --——————————————————————————————————————————————————————————————————————————————--

/--
`ζ` Series Partial Sum for Real Inputs
-/
def partial.on_reals
    [has_lift_zero_same nat ℝ]
    [has_lift_lt_comm nat ℝ]
    (ℯ : ExpLog ℝ ℝ)
    := partial_sum ∘ (term.on_reals ℯ)

/--
-/
def partial.on_reals.is_cauchy
    [has_add_le_add ℝ]
    [has_add_lt_add ℝ]

    [has_add_nonneg ℝ]
    [has_add_sub_assoc ℝ]
    [has_le_add_of_nonneg_of_le ℝ]
    [has_left_add_distributivity ℝ]
    [has_left_sub_distributivity ℝ]
    [has_lt_sub_neg ℝ]
    [has_mul_assoc ℝ]
    [has_pos_mul_neg_is_neg ℝ]
    [has_zero_right_add_cancel ℝ]
    [has_right_add_distributivity ℝ]

    [has_left_unit ℝ]
    [has_right_unit ℝ]

    [has_lift_one_same nat ℝ]
    [has_lift_zero_same nat ℝ]
    [has_lift_mul_comm nat ℝ]
    [has_lift_add_comm nat ℝ]
    [has_lift_lt_comm nat ℝ]
    [has_lift_le_comm nat ℝ]

    [has_sub_add_sub_cancel ℝ]
    [has_sub_self_is_zero ℝ]
    [has_sub_sub ℝ]
    [has_sub_ne_zero_of_ne ℝ]
    [has_zero_left_add_cancel ℝ]
    [has_zero_mul_is_zero ℝ]
    [has_mul_zero_is_zero ℝ]
    [has_inv_mul_right_cancel_self ℝ]
    [has_right_sub_distributivity ℝ]
    [has_add_sub_exchange ℝ]
    [has_inv_right_mul_lt_pos ℝ]
    [has_left_mul_inv_lt_neg ℝ]
    [has_zero_sub_is_neg ℝ]
    [has_inv_reverses_lt ℝ]
    [has_lt_pos_mul_preserves_right ℝ]
    [has_mul_pos ℝ]
    [has_sub_pos ℝ]

    (ℯ : ExpLog ℝ ℝ)

    (abs)
        (abs_zero abs_one abs_add abs_sub abs_mul abs_inv abs_ge_zero ge_zero_to_abs)

    (half ceil)

    (σ σ_gt_1)

    : is_cauchy abs (partial.on_reals ℯ σ) :=

    begin
        refine condensation.cauchy_test _ abs_zero abs_ge_zero abs_add ge_zero_to_abs _
            (term.on_reals.nonneg _ _)
            (term.on_reals.non_increasing _ _
                (lt_trans (nat.lift.zero_lt_one _) σ_gt_1)) _,

        rw funext (term.on_reals.rewrite.pow_reduction ℯ _),

        refine geometric.series.is_cauchy _
            abs_one abs_inv abs_sub abs_add abs_mul ge_zero_to_abs _ half ceil _ _
            (ExpLog.exp_lt_zero_is_lt_one _
                (has_pos_mul_neg_is_neg.lt
                    (ExpLog.log_gt_one_is_gt_zero _ (nat.lift.succ_pos ℝ _) _)
                    (has_lt_sub_neg.lt σ_gt_1))),

        rw one_is_lifted_one_lemma nat ℝ,

        refine has_lift_lt_comm.lt (nat.lt_succ_self _),
    end

end riemann_zeta --——————————————————————————————————————————————————————————————————————--
end riemann_hypothesis --————————————————————————————————————————————————————————————————--


/-
  Second localization test. If e^2 = e then R[1/e] ≅ R[1/(1-e)].
-/

import to_mathlib.localization.localization_alt

-- By Kenny.

example {R : Type*} [comm_ring R] (e : R) (he : e * e = e) : localization_alt.is_localization (powers e) (ideal.quotient.mk (ideal.span {1-e})) :=
begin
  have H1 : ideal.quotient.mk (ideal.span {1 - e}) e = 1,
  { exact eq.symm (ideal.quotient.eq.2 $ ideal.subset_span $ or.inl rfl) },
  have H2 : (1 - e) * e = 0,
  { rw [sub_mul, he, one_mul, sub_self] },
  refine ⟨_, _, _⟩,
  { rintros ⟨_, n, rfl⟩, use 1,
    change ideal.quotient.mk _ (e^n * 1) = _,
    rw [mul_one, is_semiring_hom.map_pow (ideal.quotient.mk (ideal.span {1-e})) e n, H1, one_pow] },
  { rintro ⟨x⟩, use (1,x), exact one_mul _ },
  { ext x, split; intro hx,
    { replace hx := ideal.quotient.eq_zero_iff_mem.1 hx,
      replace hx := ideal.mem_span_singleton'.1 hx,
      refine ⟨⟨(x, ⟨e, 1, pow_one e⟩), _⟩, rfl⟩,
      cases hx with y hx, change x * e = 0, rw [← hx, mul_assoc, H2, mul_zero] },
    { rcases hx with ⟨⟨⟨x, ⟨_, n, rfl⟩⟩, hx⟩, rfl⟩, change x * e^n = 0 at hx,
      apply ideal.quotient.eq_zero_iff_mem.2,
      apply ideal.mem_span_singleton'.2,
      change ∃ a, a * (1-e) = x, induction n with n ih generalizing x,
      { rw [pow_zero, mul_one] at hx, subst hx, use 0, rw zero_mul },
      rw [pow_succ, ← mul_assoc] at hx, cases ih _ hx with y hy,
      use x + y, rw [add_mul, hy, ← mul_add, sub_add_cancel, mul_one] } },
end


import .nnf .qfree_sqe .wf_sqe .eval_sqe

def qe : formula → formula
| (p ∧' q) := and_o (qe p) (qe q)
| (p ∨' q) := or_o  (qe p) (qe q)
| (¬' p) := not_o (qe p)
| (∃' p) := sqe (nnf (qe p))
| p := p

lemma qfree_qe :
  ∀ {f : formula}, qfree (qe f) :=
λ f, formula.rec_on f trivial trivial
  (λ a, trivial)
  (λ f1 f2 h1 h2, qfree_and_o h1 h2)
  (λ f1 f2 h1 h2, qfree_or_o  h1 h2)
  (λ f1 h, qfree_not_o h)
  (λ f1 h, begin simp [qe], apply qfree_sqe (nqfree_nnf h) end)

lemma wf_qe :
  ∀ {φ : formula}, formula.wf φ → formula.wf (qe φ)
| ⊤' h := by trivial
| ⊥' h := by trivial
| (A' a) h := by apply h
| (p ∧' q) h :=
  begin
    cases h with hp hq, simp [qe],
    apply wf_and_o; apply wf_qe; assumption
  end
| (p ∨' q) h :=
  begin
    cases h with hp hq, simp [qe],
    apply wf_or_o; apply wf_qe; assumption
  end
| (¬' p) h :=
  begin
    simp [qe], apply cases_not_o;
    try {trivial}, simp [formula.wf], apply @wf_qe p h
  end
| (∃' p) h :=
  begin
    simp [qe], apply wf_sqe,
    apply wf_nnf qfree_qe (wf_qe _), apply h,
  end

lemma eval_qe :
  ∀ {φ : formula}, φ.wf → ∀ {xs}, (qe φ).eval xs ↔ φ.eval xs
| ⊤' _ xs := begin simp [formula.eval] end
| ⊥' _ xs := begin simp [formula.eval], intro hc, cases hc end
| (A' a) _ xs := begin simp [formula.eval, qe] end
| (¬' φ) h xs :=
  begin simp [qe, eval_not_o, eval_not, @eval_qe φ h] end
| (φ ∨' ψ) h xs :=
  by simp [qe, eval_or_o, eval_or,
           @eval_qe φ h.left, @eval_qe ψ h.right]
| (φ ∧' ψ) h xs :=
  by simp [qe, eval_and_o, eval_and,
           @eval_qe φ h.left, @eval_qe ψ h.right]
| (∃' p) h xs :=
  begin
    simp [qe, eval_ex],
    apply iff.trans (eval_sqe _ _),
    { apply exists_iff_exists, intro x,
      apply iff.trans (eval_nnf _),
      apply @eval_qe p h, apply qfree_qe },
    { apply nqfree_nnf, apply qfree_qe },
    { apply wf_nnf qfree_qe (wf_qe _), apply h}
  end

def dec_eval_of_qfree :
  ∀ (φ : formula), qfree φ → ∀ (ds), decidable (φ.eval ds)
| ⊤' h _ := decidable.true
| ⊥' h _ := decidable.false
| (A' a) h _ := begin simp [formula.eval], apply_instance end
| (¬' p) h _ :=
  begin apply @not.decidable _ (dec_eval_of_qfree _ _ _), apply h end
| (p ∧' q) h _ :=
  @and.decidable _ _
  (dec_eval_of_qfree _ h.left _)
  (dec_eval_of_qfree _ h.right _)
| (p ∨' q) h _ :=
  @or.decidable _ _
  (dec_eval_of_qfree _ h.left _)
  (dec_eval_of_qfree _ h.right _)
| (∃' p) h _ := by cases h

instance dec_eval_qe (φ : formula) (zs : list znum) : decidable ((qe φ).eval zs) :=
dec_eval_of_qfree _ qfree_qe _

meta def quant_elim : tactic unit :=
pexact ``((eval_qe _).elim_left _)


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

! This file was ported from Lean 3 source module combinatorics.simple_graph.partition
! leanprover-community/mathlib commit ee05e9ce1322178f0c12004eb93c00d2c8c00ed2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Combinatorics.SimpleGraph.Coloring

/-!
# Graph partitions

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

This module provides an interface for dealing with partitions on simple graphs. A partition of
a graph `G`, with vertices `V`, is a set `P` of disjoint nonempty subsets of `V` such that:

* The union of the subsets in `P` is `V`.

* Each element of `P` is an independent set. (Each subset contains no pair of adjacent vertices.)

Graph partitions are graph colorings that do not name their colors.  They are adjoint in the
following sense. Given a graph coloring, there is an associated partition from the set of color
classes, and given a partition, there is an associated graph coloring from using the partition's
subsets as colors.  Going from graph colorings to partitions and back makes a coloring "canonical":
all colors are given a canonical name and unused colors are removed.  Going from partitions to
graph colorings and back is the identity.

## Main definitions

* `simple_graph.partition` is a structure to represent a partition of a simple graph

* `simple_graph.partition.parts_card_le` is whether a given partition is an `n`-partition.
  (a partition with at most `n` parts).

* `simple_graph.partitionable n` is whether a given graph is `n`-partite

* `simple_graph.partition.to_coloring` creates colorings from partitions

* `simple_graph.coloring.to_partition` creates partitions from colorings

## Main statements

* `simple_graph.partitionable_iff_colorable` is that `n`-partitionability and
  `n`-colorability are equivalent.

-/

universe u v

namespace SimpleGraph

variable {V : Type u} (G : SimpleGraph V)

#print SimpleGraph.Partition /-
/-- A `partition` of a simple graph `G` is a structure constituted by
* `parts`: a set of subsets of the vertices `V` of `G`
* `is_partition`: a proof that `parts` is a proper partition of `V`
* `independent`: a proof that each element of `parts` doesn't have a pair of adjacent vertices
-/
structure Partition where
  parts : Set (Set V)
  IsPartition : Setoid.IsPartition parts
  Independent : ∀ s ∈ parts, IsAntichain G.Adj s
#align simple_graph.partition SimpleGraph.Partition
-/

#print SimpleGraph.Partition.PartsCardLe /-
/-- Whether a partition `P` has at most `n` parts. A graph with a partition
satisfying this predicate called `n`-partite. (See `simple_graph.partitionable`.) -/
def Partition.PartsCardLe {G : SimpleGraph V} (P : G.partitionₓ) (n : ℕ) : Prop :=
  ∃ h : P.parts.Finite, h.toFinset.card ≤ n
#align simple_graph.partition.parts_card_le SimpleGraph.Partition.PartsCardLe
-/

#print SimpleGraph.Partitionable /-
/-- Whether a graph is `n`-partite, which is whether its vertex set
can be partitioned in at most `n` independent sets. -/
def Partitionable (n : ℕ) : Prop :=
  ∃ P : G.partitionₓ, P.PartsCardLe n
#align simple_graph.partitionable SimpleGraph.Partitionable
-/

namespace Partition

variable {G} (P : G.partitionₓ)

#print SimpleGraph.Partition.partOfVertex /-
/-- The part in the partition that `v` belongs to -/
def partOfVertex (v : V) : Set V :=
  Classical.choose (P.IsPartition.2 v)
#align simple_graph.partition.part_of_vertex SimpleGraph.Partition.partOfVertex
-/

#print SimpleGraph.Partition.partOfVertex_mem /-
theorem partOfVertex_mem (v : V) : P.partOfVertex v ∈ P.parts :=
  by
  obtain ⟨h, -⟩ := (P.is_partition.2 v).choose_spec.1
  exact h
#align simple_graph.partition.part_of_vertex_mem SimpleGraph.Partition.partOfVertex_mem
-/

#print SimpleGraph.Partition.mem_partOfVertex /-
theorem mem_partOfVertex (v : V) : v ∈ P.partOfVertex v :=
  by
  obtain ⟨⟨h1, h2⟩, h3⟩ := (P.is_partition.2 v).choose_spec
  exact h2.1
#align simple_graph.partition.mem_part_of_vertex SimpleGraph.Partition.mem_partOfVertex
-/

#print SimpleGraph.Partition.partOfVertex_ne_of_adj /-
theorem partOfVertex_ne_of_adj {v w : V} (h : G.Adj v w) : P.partOfVertex v ≠ P.partOfVertex w :=
  by
  intro hn
  have hw := P.mem_part_of_vertex w
  rw [← hn] at hw
  exact P.independent _ (P.part_of_vertex_mem v) (P.mem_part_of_vertex v) hw (G.ne_of_adj h) h
#align simple_graph.partition.part_of_vertex_ne_of_adj SimpleGraph.Partition.partOfVertex_ne_of_adj
-/

#print SimpleGraph.Partition.toColoring /-
/-- Create a coloring using the parts themselves as the colors.
Each vertex is colored by the part it's contained in. -/
def toColoring : G.Coloring P.parts :=
  Coloring.mk (fun v => ⟨P.partOfVertex v, P.partOfVertex_mem v⟩) fun _ _ hvw =>
    by
    rw [Ne.def, Subtype.mk_eq_mk]
    exact P.part_of_vertex_ne_of_adj hvw
#align simple_graph.partition.to_coloring SimpleGraph.Partition.toColoring
-/

#print SimpleGraph.Partition.toColoring' /-
/-- Like `simple_graph.partition.to_coloring` but uses `set V` as the coloring type. -/
def toColoring' : G.Coloring (Set V) :=
  Coloring.mk P.partOfVertex fun _ _ hvw => P.partOfVertex_ne_of_adj hvw
#align simple_graph.partition.to_coloring' SimpleGraph.Partition.toColoring'
-/

#print SimpleGraph.Partition.to_colorable /-
theorem to_colorable [Fintype P.parts] : G.Colorable (Fintype.card P.parts) :=
  P.toColoring.to_colorable
#align simple_graph.partition.to_colorable SimpleGraph.Partition.to_colorable
-/

end Partition

variable {G}

#print SimpleGraph.Coloring.toPartition /-
/-- Creates a partition from a coloring. -/
@[simps]
def Coloring.toPartition {α : Type v} (C : G.Coloring α) : G.partitionₓ
    where
  parts := C.colorClasses
  IsPartition := C.colorClasses_isPartition
  Independent := by
    rintro s ⟨c, rfl⟩
    apply C.color_classes_independent
#align simple_graph.coloring.to_partition SimpleGraph.Coloring.toPartition
-/

/-- The partition where every vertex is in its own part. -/
@[simps]
instance : Inhabited (Partition G) :=
  ⟨G.selfColoring.toPartition⟩

#print SimpleGraph.partitionable_iff_colorable /-
theorem partitionable_iff_colorable {n : ℕ} : G.Partitionable n ↔ G.Colorable n :=
  by
  constructor
  · rintro ⟨P, hf, h⟩
    haveI : Fintype P.parts := hf.fintype
    rw [Set.Finite.card_toFinset] at h
    apply P.to_colorable.mono h
  · rintro ⟨C⟩
    refine' ⟨C.to_partition, C.color_classes_finite, le_trans _ (Fintype.card_fin n).le⟩
    generalize_proofs h
    haveI : Fintype C.color_classes := C.color_classes_finite.fintype
    rw [h.card_to_finset]
    exact C.card_color_classes_le
#align simple_graph.partitionable_iff_colorable SimpleGraph.partitionable_iff_colorable
-/

end SimpleGraph


/-
The goal of this file is to prove that every positive, self-adjoint linear operator
on ℂ^n has a positive, self-adjoint square root.
-/

-- Checked over by:
-- Dan
-- Hans

import .self_adjoint

open_locale big_operators complex_conjugate matrix
namespace inner_product_space

local notation `is_sa` := is_self_adjoint

/-
Throughout, T is a positive, self-adjoint linear operator on ℂ^n.
-/

variables {n : ℕ} {T : Lℂ^n} (T_sa : is_self_adjoint T)

def is_positive (T : Lℂ^n) :=
  (∀ x : ℂ^n, (⟪T x, x⟫_ℂ.re ≥ 0) ∧ (⟪T x, x⟫_ℂ.im = 0))

variable (hpos : is_positive T)

/-
The spectral theorem allows us to define √T
-/

lemma hn : finite_dimensional.finrank ℂ (ℂ^n) = n := finrank_euclidean_space_fin

local notation `ev` := T_sa.eigenvalues hn
local notation `ew` := T_sa.eigenvector_basis hn

local notation `sqrt_ew` := λ (i : (fin n)), (real.sqrt(((ev) i)) : ℂ) • ((ew) i)

noncomputable def is_self_adjoint.sqrt : Lℂ^n :=
  @basis.constr (fin n) ℂ (ℂ^n) (ℂ^n) _ _ _ _ _ (ew) ℂ _ _ _ (sqrt_ew)

local notation `R` := T_sa.sqrt

/-
T is positive, and so its eigenvalues are nonnegative.
-/

theorem eig_nonneg_of_pos (hpos : is_positive T):
  (∀ i : (fin n), 0 ≤ ((T_sa.eigenvalues hn) i)) :=
  begin
    intro i,
    calc 0 ≤ ⟪ T ((ew) i), (ew i) ⟫_ℂ.re : (hpos (ew i)).1
      ... = ⟪ ↑((ev) i) • ((ew) i), ((ew) i) ⟫_ℂ.re : by {rw is_self_adjoint.apply_eigenvector_basis T_sa hn i}
      ... = ((ev) i • ⟪ ((ew) i), ((ew) i) ⟫_ℂ).re : by {rw @inner_smul_real_left ℂ _ _ _ ((ew) i) ((ew) i) ( ((ev) i))}
      ... = (ev) i : by {rw inner_self_eq_norm_sq_to_K, rw (T_sa.eigenvector_basis_orthonormal hn).1, simp only [one_pow, mul_one, complex.real_smul, complex.of_real_one, complex.of_real_re, eq_self_iff_true]},
  end

/-
By definition, √T has the same eigenvectors as T, with sqrt eigenvalues.
-/

lemma sqrt_apply (i : fin n):
  (T_sa.sqrt) ((ew) i) = (real.sqrt ((ev) i) : ℂ) • ((ew) i) :=
begin
  simp?,
  sorry,
end

/-
We have √T^2 = T.
-/

lemma sqrt_sq (hpos : is_positive T):
  ((T_sa.sqrt) * (T_sa.sqrt)) = T :=
  begin
    apply basis.ext ew,
    intro i,
    calc ((T_sa.sqrt) * (T_sa.sqrt)) (ew i) = (T_sa.sqrt) (T_sa.sqrt (ew i)) : by {rw linear_map.mul_apply}
    ...                 = R (↑(real.sqrt(ev i)) • (ew i)) : by {rw sqrt_apply}
    ...                 = real.sqrt(ev i) • R ((ew i)) : by {rw linear_map.map_smul, norm_cast}
    ...                 = (ev i) • (ew i) : by {rw sqrt_apply, norm_cast, rw smul_smul, rw real.mul_self_sqrt, exact eig_nonneg_of_pos T_sa hpos i}
    ...                 = T (ew i) : by {rw inner_product_space.is_self_adjoint.apply_eigenvector_basis, norm_cast}
  end

/-
√T is self-adjoint.
-/

lemma sqrt_is_sa (hpos : is_positive T) :
  is_sa R :=
  begin
    rw [is_self_adjoint_iff_eq_adjoint, linear_map.eq_adjoint_iff_basis (ew) (ew)],
    intros i j,
    by_cases h : (i = j),
    iterate {rw ← h},
    calc ⟪ R ((ew) i), (ew) i ⟫_ℂ = real.sqrt((ev) i) • ⟪ (ew) i, (ew) i ⟫_ℂ : by {rw sqrt_apply, rw [inner_smul_left, complex.conj_of_real, complex.real_smul]}
      ...                         = ⟪ (ew) i, R ((ew) i) ⟫_ℂ : by {rw sqrt_apply, rw [inner_smul_right, complex.real_smul]},

    calc ⟪ R ((ew) i), (ew) j ⟫_ℂ = real.sqrt((ev) i) • ⟪ (ew) i, (ew) j ⟫_ℂ : by {rw sqrt_apply, rw [inner_smul_left, complex.conj_of_real, complex.real_smul]}
      ...                         = ⟪ (ew) i, R ((ew) j) ⟫_ℂ : by {rw sqrt_apply, rw [inner_smul_right, complex.real_smul, (T_sa.eigenvector_basis_orthonormal hn).2 h, mul_zero, mul_zero]},
  end

/-
√T scales basis coordinates by sqrt eigenvalues.
-/

lemma sqrt_repr (x : ℂ^n) (i : fin n) (hpos : is_positive T):
  (ew).repr (R x) i = (real.sqrt((ev) i)) • ((ew).repr x i) :=
begin
  sorry,
  -- calc (ew).repr(R x) i = ⟪ (ew) i, R x ⟫_ℂ : onb_coords_eq_inner _ _ _ (inner_product_space.is_self_adjoint.eigenvector_basis_orthonormal hsa hn)
  --   ...                 = ⟪ R ((ew) i) , x ⟫_ℂ : (sqrt_is_sa T hsa hpos ((ew) i) x).symm
  --   ...                 = (real.sqrt((ev) i)) • ⟪ (ew) i , x ⟫_ℂ : by {rw [sqrt_apply, inner_smul_left, is_R_or_C.conj_of_real, complex.real_smul]}
  --   ...                 = (real.sqrt((ev) i)) • ((ew).repr x i) : by {rw ← onb_coords_eq_inner (ew) _ _ (inner_product_space.is_self_adjoint.eigenvector_basis_orthonormal hsa hn)},
end

/-
√T is positive, real part.
-/

lemma sqrt_is_positive' (hpos : is_positive T) (x : ℂ^n) :
  ⟪ (T_sa.sqrt) x, x ⟫_ℂ.re ≥ 0 :=
  begin
    sorry,
    -- rw [← basis.sum_repr (ew) (R x), sum_inner, ← complex.coe_re_add_group_hom, add_monoid_hom.map_sum complex.re_add_group_hom],
    -- apply finset.sum_nonneg,
    -- intros i hi,
    -- calc 0 ≤ real.sqrt ((ev) i) * complex.norm_sq(((ew).repr x) i ) : mul_nonneg (real.sqrt_nonneg ((ev) i)) (complex.norm_sq_nonneg _)
    -- ...    = (conj (real.sqrt ((ev) i) • ((ew).repr x) i) * ((ew).repr x) i ).re : by {rw [is_R_or_C.conj_smul, smul_mul_assoc, complex.smul_re, ← complex.norm_sq_eq_conj_mul_self], norm_cast}
    -- ...    = complex.re_add_group_hom (⟪ ((ew).repr (R x) i) • ((ew) i), x ⟫_ℂ) : by {rw [@sqrt_repr _ _ T_sa x i _, inner_smul_left, onb_coords_eq_inner (ew) x i (inner_product_space.is_self_adjoint.eigenvector_basis_orthonormal hsa hn), complex.coe_re_add_group_hom], exact hpos},
  end

/-
√T is positive.
-/

lemma sqrt_is_positive (hpos : is_positive T) :
  is_positive (T_sa.sqrt) :=
begin
  intro x,
  exact ⟨sqrt_is_positive' T_sa hpos x, complex.eq_conj_iff_im.1 ((is_self_adjoint_iff_real_inner_map R).1 (sqrt_is_sa T_sa hpos) x)⟩,
end

/-
A positive, self-adjoint linear operator T : ℂ^n → ℂ^n has a positive, self-adjoint square root.
-/
theorem sqrt_exists (hpos : is_positive T):
  ∃ (R' : Lℂ^n), ((R' * R') = T) ∧ (is_sa R') ∧ (is_positive R') :=
    Exists.intro (T_sa.sqrt) (id ⟨sqrt_sq T_sa hpos, ⟨sqrt_is_sa T_sa hpos, sqrt_is_positive T_sa hpos⟩⟩)

end inner_product_space