/-
Copyright (c) 2015 Joseph Hua. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Hua
-/
import data.W.basic

/-!
# Examples of W-types

We take the view of W types as inductive types.
Given `α : Type` and `β : α → Type`, the W type determined by this data, `W_type β`, is the
inductively with constructors from `α` and arities of each constructor `a : α` given by `β a`.

This file contains `nat` and `list` as examples of W types.

## Main results
* `W_type.equiv_nat`: the construction of the naturals as a W-type is equivalent
  to `nat`
* `W_type.equiv_list`: the construction of lists on a type `γ` as a W-type is equivalent to
  `list γ`
-/

universes u v

namespace W_type

section nat

/-- The constructors for the naturals -/
inductive nat_α : Type
| zero : nat_α
| succ : nat_α

instance : inhabited nat_α := ⟨ nat_α.zero ⟩

/-- The arity of the constructors for the naturals, `zero` takes no arguments, `succ` takes one -/
def nat_β : nat_α → Type
| nat_α.zero := empty
| nat_α.succ := unit

instance : inhabited (nat_β nat_α.succ) := ⟨ () ⟩

/-- The isomorphism from the naturals to its corresponding `W_type` -/
@[simp] def of_nat : ℕ → W_type nat_β
| nat.zero := ⟨ nat_α.zero , empty.elim ⟩
| (nat.succ n) := ⟨ nat_α.succ , λ _ , of_nat n ⟩

/-- The isomorphism from the `W_type` of the naturals to the naturals -/
@[simp] def to_nat : W_type nat_β → ℕ
| (W_type.mk nat_α.zero f) := 0
| (W_type.mk nat_α.succ f) := (to_nat (f ())).succ

lemma left_inv_nat : function.left_inverse of_nat to_nat
| (W_type.mk nat_α.zero f) := by { simp, tidy }
| (W_type.mk nat_α.succ f) := by { simp, tidy }

lemma right_inv_nat : function.right_inverse of_nat to_nat
| nat.zero := rfl
| (nat.succ n) := by rw [of_nat, to_nat, right_inv_nat n]

/-- The naturals are equivalent to their associated `W_type` -/
def equiv_nat : W_type nat_β ≃ ℕ :=
{ to_fun := to_nat,
  inv_fun := of_nat,
  left_inv := left_inv_nat,
  right_inv := right_inv_nat }

open sum punit

/--
`W_type.nat_α` is equivalent to `punit ⊕ punit`.
This is useful when considering the associated polynomial endofunctor.
-/
@[simps] def nat_α_equiv_punit_sum_punit : nat_α ≃ punit.{u + 1} ⊕ punit :=
{ to_fun := λ c, match c with | nat_α.zero := inl star | nat_α.succ := inr star end,
  inv_fun := λ b, match b with | inl x := nat_α.zero | inr x := nat_α.succ end,
  left_inv := λ c, match c with | nat_α.zero := rfl | nat_α.succ := rfl end,
  right_inv := λ b, match b with | inl star := rfl | inr star := rfl end }

end nat

section list

variable (γ : Type u)

/--
The constructors for lists.
There is "one constructor `cons x` for each `x : γ`",
since we view `list γ` as
```
| nil : list γ
| cons x₀ : list γ → list γ
| cons x₁ : list γ → list γ
|   ⋮      γ many times
```
-/
inductive list_α : Type u
| nil : list_α
| cons : γ → list_α

instance : inhabited (list_α γ) := ⟨ list_α.nil ⟩

/-- The arities of each constructor for lists, `nil` takes no arguments, `cons hd` takes one -/
def list_β : list_α γ → Type u
| list_α.nil := pempty
| (list_α.cons hd) := punit

instance (hd : γ) : inhabited (list_β γ (list_α.cons hd)) := ⟨ punit.star ⟩

/-- The isomorphism from lists to the `W_type` construction of lists -/
@[simp] def of_list : list γ → W_type (list_β γ)
| list.nil := ⟨ list_α.nil, pempty.elim ⟩
| (list.cons hd tl) := ⟨ list_α.cons hd, λ _ , of_list tl ⟩

/-- The isomorphism from the `W_type` construction of lists to lists -/
@[simp] def to_list : W_type (list_β γ) → list γ
| (W_type.mk list_α.nil f) := []
| (W_type.mk (list_α.cons hd) f) := hd :: to_list (f punit.star)

lemma left_inv_list : function.left_inverse (of_list γ) (to_list _)
| (W_type.mk list_α.nil f) := by { simp, tidy }
| (W_type.mk (list_α.cons x) f) := by { simp, tidy }

lemma right_inv_list : function.right_inverse (of_list γ) (to_list _)
| list.nil := rfl
| (list.cons hd tl) := by simp [right_inv_list tl]

/-- Lists are equivalent to their associated `W_type` -/
def equiv_list : W_type (list_β γ) ≃ list γ :=
{ to_fun := to_list _,
  inv_fun := of_list _,
  left_inv := left_inv_list _,
  right_inv := right_inv_list _ }

/--
`W_type.list_α` is equivalent to `γ` with an extra point.
This is useful when considering the associated polynomial endofunctor
-/
def list_α_equiv_punit_sum : list_α γ ≃ punit.{v + 1} ⊕ γ :=
{ to_fun := λ c, match c with | list_α.nil := sum.inl punit.star | list_α.cons x := sum.inr x end,
  inv_fun := sum.elim (λ _, list_α.nil) (λ x, list_α.cons x),
  left_inv := λ c, match c with | list_α.nil := rfl | list_α.cons x := rfl end,
  right_inv := λ x, match x with | sum.inl punit.star := rfl | sum.inr x := rfl end, }

end list

end W_type


import algebra.pi_instances
set_option old_structure_cmd true

universe variables u
#print ring

class rng (α : Type u) extends add_comm_group α, semigroup α, distrib α

instance ring.to_rng {α} [h : ring α] : rng α :=
{..h}

variables {α : Type u} [rng α] {a b c x y z w : α} {n m : ℤ}

example : (x + y) * (z + w) = x * z + x * w + y * z + y * w :=
begin
  rw [right_distrib, left_distrib, left_distrib, ←add_assoc]
end

lemma rng.mul_zero [rng α] (a : α) : a * 0 = 0 :=
have a * 0 + 0 = a * 0 + a * 0, from calc
     a * 0 + 0 = a * (0 + 0)   : by simp
           ... = a * 0 + a * 0 : by rw left_distrib,
show a * 0 = 0, from (add_left_cancel this).symm

lemma rng.zero_mul [rng α] (a : α) : 0 * a = 0 :=
have 0 * a + 0 = 0 * a + 0 * a, from calc
  0 * a + 0 = (0 + 0) * a   : by simp
        ... = 0 * a + 0 * a : by rewrite right_distrib,
show 0 * a = 0, from  (add_left_cancel this).symm

instance rng.mul_zero_class : mul_zero_class α :=
{ zero_mul := rng.zero_mul,
  mul_zero := rng.mul_zero,
  .._inst_1 }

lemma rng.neg_mul_eq_mul_neg [s : rng α] (a b : α) : -(a * b) = a * -b :=
neg_eq_of_add_eq_zero begin rw [← left_distrib, add_right_neg, mul_zero] end

lemma rng.neg_mul_eq_neg_mul [s : rng α] (a b : α) : -(a * b) = -a * b :=
neg_eq_of_add_eq_zero begin rw [← right_distrib, add_right_neg, zero_mul] end

@[simp] lemma sub_neg : a * (b - c) = a * b - a * c :=
calc
   a * (b - c) = a * b + a * -c : left_distrib a b (-c)
           ... = a * b - a * c  : by simp [rng.neg_mul_eq_mul_neg]

@[simp] lemma rng.nat_smul_mul_left : ∀{n : ℕ}, n • a * b = n • (a * b)
| 0     := by simp
| (n+1) := by { simp [*, add_smul, right_distrib] }

@[simp] lemma rng.nat_smul_mul_right : ∀{n : ℕ}, a * n • b = n • (a * b)
| 0     := by simp
| (n+1) := by { simp [*, add_smul, left_distrib] }

@[simp] lemma rng.smul_mul_left : ∀{n : ℤ}, n • a * b = n • (a * b)
| (n : ℕ) := rng.nat_smul_mul_left
| -[1+n]  := show (-↑(n+1) : ℤ) • a * b  = (-↑(n+1) : ℤ) • (a * b),
  by { rw [neg_smul, neg_smul, ←rng.neg_mul_eq_neg_mul], congr' 1,
       apply rng.nat_smul_mul_left }

@[simp] lemma rng.smul_mul_right : ∀{n : ℤ}, a * n • b = n • (a * b)
| (n : ℕ) := rng.nat_smul_mul_right
| -[1+n]  := show a * (-↑(n+1) : ℤ) • b  = (-↑(n+1) : ℤ) • (a * b),
  by { rw [neg_smul, neg_smul, ←rng.neg_mul_eq_mul_neg], congr' 1,
       apply rng.nat_smul_mul_right }

@[simp] lemma smul_smul_comm : n • (m • a) = m • (n • a) :=
by simp [smul_smul, mul_comm]

def unitisation (α : Type u) : Type u := ℤ × α

namespace unitisation

instance : add_comm_group (unitisation α) :=
by { dsimp [unitisation], apply_instance }

instance : has_mul (unitisation α) :=
⟨λ ⟨(n : ℤ), a⟩ ⟨(m : ℤ), b⟩, ⟨n * m, n • b + m • a + a * b⟩⟩

@[simp] lemma mk_mul_mk : (⟨n, a⟩ * ⟨m, b⟩ : unitisation α) = ⟨n * m, n • b + m • a + a * b⟩ :=
rfl

@[simp] lemma mul_fst {x y : unitisation α} : (x * y).fst = x.fst * y.fst :=
by { cases x, cases y, refl }

@[simp] lemma mul_snd {x y : unitisation α} :
  (x * y).snd = x.fst • y.snd + y.fst • x.snd + x.snd * y.snd :=
by { cases x, cases y, refl }

instance : ring (unitisation α) :=
{ mul_assoc := λ ⟨n, a⟩ ⟨m, b⟩ ⟨k, c⟩,
  by { simp [mul_assoc], simp [mul_assoc, smul_smul, smul_add, mul_comm, right_distrib,  left_distrib] },
  one := ⟨1, 0⟩,
  one_mul := λ ⟨n, a⟩, by { simp },
  mul_one := λ ⟨n, a⟩, by { simp },
  left_distrib := λ ⟨n, a⟩ ⟨m, b⟩ ⟨k, c⟩,
  by { simp only, show _ * (_ + _) = _ + _, simp [left_distrib, add_smul, smul_add] },
  right_distrib := λ ⟨n, a⟩ ⟨m, b⟩ ⟨k, c⟩,
  by { simp only, show (_ + _) * _ = _ + _, simp [right_distrib, add_smul, smul_add] },
  ..prod.add_comm_group, ..unitisation.has_mul }

end unitisation

#print gpow


/-
Copyright (c) 2021 Eric Wieser. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Eric Wieser
-/
import group_theory.perm.sign
import logic.equiv.option

/-!
# Permutations of `option α`
-/
open equiv

@[simp] lemma equiv.option_congr_one {α : Type*} : (1 : perm α).option_congr = 1 :=
equiv.option_congr_refl

@[simp] lemma equiv.option_congr_swap {α : Type*} [decidable_eq α] (x y : α) :
  option_congr (swap x y) = swap (some x) (some y) :=
begin
  ext (_ | i),
  { simp [swap_apply_of_ne_of_ne] },
  { by_cases hx : i = x,
    simp [hx, swap_apply_of_ne_of_ne],
    by_cases hy : i = y;
    simp [hx, hy, swap_apply_of_ne_of_ne], }
end

@[simp] lemma equiv.option_congr_sign {α : Type*} [decidable_eq α] [fintype α] (e : perm α) :
  perm.sign e.option_congr = perm.sign e :=
begin
  apply perm.swap_induction_on e,
  { simp [perm.one_def] },
  { intros f x y hne h,
    simp [h, hne, perm.mul_def, ←equiv.option_congr_trans] }
end

@[simp] lemma map_equiv_remove_none {α : Type*} [decidable_eq α] (σ : perm (option α)) :
  (remove_none σ).option_congr = swap none (σ none) * σ :=
begin
  ext1 x,
  have : option.map ⇑(remove_none σ) x = (swap none (σ none)) (σ x),
  { cases x,
    { simp },
    { cases h : σ (some x),
      { simp [remove_none_none _ h], },
      { have hn : σ (some x) ≠ none := by simp [h],
        have hσn : σ (some x) ≠ σ none := σ.injective.ne (by simp),
        simp [remove_none_some _ ⟨_, h⟩, ←h, swap_apply_of_ne_of_ne hn hσn] } } },
  simpa using this,
end

/-- Permutations of `option α` are equivalent to fixing an
`option α` and permuting the remaining with a `perm α`.
The fixed `option α` is swapped with `none`. -/
@[simps] def equiv.perm.decompose_option {α : Type*} [decidable_eq α] :
  perm (option α) ≃ option α × perm α :=
{ to_fun := λ σ, (σ none, remove_none σ),
  inv_fun := λ i, swap none i.1 * i.2.option_congr,
  left_inv := λ σ, by simp,
  right_inv := λ ⟨x, σ⟩, begin
    have : remove_none (swap none x * σ.option_congr) = σ :=
      equiv.option_congr_injective (by simp [←mul_assoc]),
    simp [←perm.eq_inv_iff_eq, this],
  end }

lemma equiv.perm.decompose_option_symm_of_none_apply {α : Type*} [decidable_eq α]
  (e : perm α) (i : option α) :
  equiv.perm.decompose_option.symm (none, e) i = i.map e :=
by simp

lemma equiv.perm.decompose_option_symm_sign {α : Type*} [decidable_eq α] [fintype α] (e : perm α) :
  perm.sign (equiv.perm.decompose_option.symm (none, e)) = perm.sign e :=
by simp

/-- The set of all permutations of `option α` can be constructed by augmenting the set of
permutations of `α` by each element of `option α` in turn. -/
lemma finset.univ_perm_option {α : Type*} [decidable_eq α] [fintype α] :
  @finset.univ (perm $ option α) _ =
    (finset.univ : finset $ option α × perm α).map equiv.perm.decompose_option.symm.to_embedding :=
(finset.univ_map_equiv_to_embedding _).symm


import data.list.basic data.list.perm init.data.int.order
import tactic.omega tactic.basic tactic.tidy

notation `ℙ` := nat.primes

meta def by_eval (typ: Type*) [reflected typ]: tactic unit := do
e <- tactic.target,
match expr.is_eq e with
| (some (e1, e2)) := tactic.eval_expr' typ e1 >> tactic.reflexivity
| none := tactic.failed
end

-- 1-based
def fib: nat -> nat
| 0 := 0 -- sentinel
| 1 := 1
| 2 := 1
| (n+2) := (fib (n)) + (fib (n+1))

@[simp]
def nat.sum (n: ℕ) := ((n+1)*n)/2

-- seg a b = [a, ..., b)
@[simp, reducible]
def seg (a b: ℕ) := (list.range (b-a)).map(λ x, x+a)
-- #eval seg 3 5

@[simp, reducible]
def find {α: Type} (p: α -> Prop) [decidable_pred p] [inhabited α] : list α -> α
| [] := arbitrary α
| (h::t) := cond (p h) h (find t)

@[simp]
def nonneg_to_nat (i: ℤ) (h: i ≥ 0): ℕ := begin
cases i,
  exact i,
  exact false.elim h,
end

theorem nonneg_to_nat_eq {i: ℤ} {h: i ≥ 0}: i = (nonneg_to_nat i h) := begin
simp, induction i,
  reflexivity,
  exfalso, tidy,
end

theorem sum_nonneg {l: list ℤ} (h: ∀ i: ℤ, i ∈ l -> i ≥ 0): l.sum ≥ 0 := begin
induction l,
  simp,
  simp, apply add_nonneg, tidy,
end


import GMLInit.Data.Basic
import GMLInit.Data.Index.Basic
import GMLInit.Data.Index.Map
import GMLInit.Data.Nat

namespace Fin
variable {n : Nat}

protected theorem eq : {i j : Fin n} → i.val = j.val → i = j
| ⟨_,_⟩, ⟨_,_⟩, rfl => rfl

protected theorem eta (i : Fin n) : i = ⟨i.val, i.isLt⟩ := Fin.eq rfl

protected abbrev modulus (_ : Fin n) := n

theorem val_eq_val_of_heq : {m n : Nat} → m = n → (x : Fin m) → (y : Fin n) → HEq x y → x.val = y.val
| _, _, rfl, ⟨_,_⟩, ⟨_,_⟩, HEq.rfl => rfl

theorem val_ndrec (i : Fin n) (h : n = m) : (h ▸ i : Fin m).val = i.val := by cases h; rfl

instance (i : Fin n) : Nat.IsPos i.modulus where
  is_pos := Nat.lt_of_le_of_lt (Nat.zero_le i.val) i.isLt

protected def zero (is_pos : n > 0 := by nat_is_pos) : Fin n := ⟨0, is_pos⟩

protected def last (is_pos : n > 0 := by nat_is_pos) : Fin n := ⟨n.pred, Nat.pred_lt_self n is_pos⟩

protected def lift : Fin n → Fin (n+1)
| ⟨i, hi⟩ => ⟨i, Nat.lt_succ_of_le (Nat.le_of_lt hi)⟩

protected def next : Fin n → Option (Fin n)
| ⟨i, _⟩ => if h : i+1 < n then some ⟨i+1, h⟩ else none

protected def pred : Fin n → Option (Fin n)
| ⟨i, h⟩ => if i ≠ 0 then some ⟨i-1, Nat.lt_of_le_of_lt (Nat.pred_le i) h⟩ else none

theorem lift_inj : {i j : Fin n} → i.lift = j.lift → i = j
| ⟨_, _⟩, ⟨_, _⟩, rfl => rfl

theorem succ_inj : {i j : Fin n} → i.succ = j.succ → i = j
| ⟨_, _⟩, ⟨_, _⟩, rfl => rfl

protected inductive IndView : Nat → Type
| zero {n : Nat} : Fin.IndView (n+1)
| succ {n : Nat} : Fin.IndView n → Fin.IndView (n+1)

@[inline] protected def IndView.toFin : {n : Nat} → Fin.IndView n → Fin n
| _+1, IndView.zero => Fin.zero
| _+1, IndView.succ i => Fin.succ (IndView.toFin i)

@[inline] protected def toIndView : {n : Nat} → Fin n → Fin.IndView n
| _+1, ⟨0, _⟩ => IndView.zero
| _+1, ⟨i+1, hi⟩ => IndView.succ (Fin.toIndView ⟨i, Nat.lt_of_succ_lt_succ hi⟩)

theorem toIndView_eq_iff_toFin_eq {n : Nat} {i : Fin n} {j : Fin.IndView n} : i.toIndView = j ↔ j.toFin = i := by
  match n, i, j with
  | n+1, ⟨0, _⟩, IndView.zero =>
    constr
    · intro; reflexivity
    · intro; reflexivity
  | n+1, ⟨0, _⟩, IndView.succ j =>
    constr
    · intro; contradiction
    · intro h; cases h
  | n+1, ⟨i+1, hi⟩, IndView.zero =>
    constr
    · intro; contradiction
    · intro h; cases h
  | n+1, ⟨i+1, hi⟩, IndView.succ j =>
    have hsucc : ⟨i+1, hi⟩ = Fin.succ ⟨i, Nat.lt_of_succ_lt_succ hi⟩ := rfl
    constr
    · intro h
      rw [IndView.toFin, hsucc]
      congr
      apply toIndView_eq_iff_toFin_eq.mp
      exact IndView.succ.inj h
    · intro h
      rw [IndView.toFin, hsucc] at h
      rw [Fin.toIndView]
      congr
      apply toIndView_eq_iff_toFin_eq.mpr
      exact succ_inj h

theorem toIndView_toFin {n : Nat} (i : Fin.IndView n) : i.toFin.toIndView = i :=
  toIndView_eq_iff_toFin_eq.mpr rfl

theorem toFin_toIndView {n : Nat} (i : Fin n) : i.toIndView.toFin = i :=
  toIndView_eq_iff_toFin_eq.mp rfl

def equivIndView (n : Nat) : Equiv (Fin n) (Fin.IndView n) where
  fwd := Fin.toIndView
  rev := IndView.toFin
  spec := toIndView_eq_iff_toFin_eq

protected def recInd.{u} {motive : (n : Nat) → Fin n → Sort u}
  (zero : {n : Nat} → motive (n+1) Fin.zero)
  (succ : {n : Nat} → (i : Fin n) → motive n i → motive (n + 1) (Fin.succ i)) :
  {n : Nat} → (i : Fin n) → motive n i
| Nat.succ _, i => match hi : i.toIndView with
  | IndView.zero => toIndView_eq_iff_toFin_eq.mp hi ▸ zero
  | IndView.succ _ => toIndView_eq_iff_toFin_eq.mp hi ▸ succ _ (Fin.recInd zero succ _)

protected abbrev recIndOn.{u} {motive : (n : Nat) → Fin n → Sort u} {n : Nat} (i : Fin n)
  (zero : {n : Nat} → motive (n+1) Fin.zero)
  (succ : {n : Nat} → (i : Fin n) → motive n i → motive (n + 1) (Fin.succ i)) :
  motive n i := Fin.recInd zero succ i

protected abbrev casesIndOn.{u} {motive : (n : Nat) → Fin n → Sort u} {n : Nat} (i : Fin n)
  (zero : {n : Nat} → motive (n+1) Fin.zero)
  (succ : {n : Nat} → (i : Fin n) → motive (n + 1) (Fin.succ i)) :
  motive n i := Fin.recInd zero (fun i _ => succ i) i

protected def iota : (n : Nat) → List (Fin n)
| 0 => []
| n+1 => Fin.zero :: (Fin.iota n).map Fin.succ

def iotaFind : {n : Nat} → Fin n → Index (Fin.iota n)
| _+1, ⟨0,_⟩ => Index.head
| _+1, ⟨i+1,hi⟩ => Index.tail ((iotaFind ⟨i, Nat.lt_of_succ_lt_succ hi⟩).map Fin.succ)

theorem iotaFind_zero {n : Nat} : iotaFind (Fin.zero : Fin (n+1)) = Index.head := by rfl

theorem iotaFind_succ {n : Nat} (i : Fin n) : iotaFind (Fin.succ i) = Index.tail (Index.map Fin.succ (iotaFind i)) := by cases i; rfl

theorem iotaFind_val {n : Nat} (i : Index (Fin.iota n)) : i.val.iotaFind = i := by
  induction n with
  | zero => contradiction
  | succ n H =>
    match i with
    | .head => rfl
    | .tail (i : Index ((Fin.iota n).map Fin.succ)) =>
      calc
      _ = iotaFind (Index.val (Index.tail i : Index (Fin.iota (n+1)))) := rfl
      _ = iotaFind (Index.val i) := by rw [Index.val_tail]
      _ = iotaFind (Index.val (Index.map Fin.succ (Index.unmap Fin.succ i))) := by rw [Index.map_unmap]
      _ = iotaFind (Fin.succ (Index.val (Index.unmap Fin.succ i))) := by rw [Index.val_map]
      _ = Index.tail (Index.map Fin.succ (iotaFind (Index.val (Index.unmap Fin.succ i)))) := by rw [iotaFind_succ]
      _ = Index.tail (Index.map Fin.succ (Index.unmap Fin.succ i)) := by rw [H]
      _ = Index.tail i := by rw [Index.map_unmap]

theorem val_iotaFind {n : Nat} (i : Fin n) : i.iotaFind.val = i := by
  induction n with
  | zero => cases i; contradiction
  | succ n H =>
    match i with
    | ⟨0,_⟩ => rfl
    | ⟨i+1,hi⟩ =>
      apply Fin.eq
      open Index in rw [iotaFind, val_tail, val_map, H, Fin.succ]

protected def find? (p : Fin n → Bool) : Option (Fin n) :=
  let rec loop (i : Nat) (hi : i ≤ n) : Option (Fin n) :=
    if h : i = n then
      none
    else
      have hi : i < n := Nat.lt_of_le_of_ne hi h
      if p ⟨i, hi⟩ then
        some ⟨i, hi⟩
      else
        loop (i+1) (Nat.succ_le_of_lt hi)
  loop 0 (Nat.zero_le n)
termination_by loop i _ => n - i

theorem find?.loop_some {p : Fin n → Bool} (i hi) (k : Fin n) : Fin.find?.loop p i hi = some k → p k = true := by
  intro h
  unfold loop at h
  split at h
  next => contradiction
  next hne =>
    have hi : i < n := Nat.lt_of_le_of_ne hi hne
    simp only at h
    split at h
    next hp =>
      cases h
      exact hp
    next =>
      exact loop_some (i+1) (Nat.succ_le_of_lt hi) k h
termination_by loop_some i _ _ _ => n - i

private theorem find?.loop_none {p : Fin n → Bool} (i hi) (k : Fin n) : i ≤ k.val → Fin.find?.loop p i hi = none → p k = false := by
  intro hik h
  unfold loop at h
  split at h
  next heq =>
    absurd hik
    rw [heq]
    apply Nat.not_le_of_gt
    exact k.isLt
  next hne =>
    have hi : i < n := Nat.lt_of_le_of_ne hi hne
    simp only at h
    split at h
    next hp =>
      contradiction
    next hp =>
      by_cases i = k.val with
      | isTrue heq =>
        rw [Bool.eq_false_iff]
        intro hk
        apply hp
        rw [←hk]
        congr
      | isFalse hik' =>
        have hik : i < k.val := Nat.lt_of_le_of_ne hik hik'
        exact loop_none (i+1) (Nat.succ_le_of_lt hi) k (Nat.succ_le_of_lt hik) h
termination_by loop_none i _ _ _ _ => n - i

theorem find?_some {p : Fin n → Bool} (k : Fin n) : Fin.find? p = some k → p k = true :=
  find?.loop_some 0 (Nat.zero_le n) k

theorem find?_none {p : Fin n → Bool} (k : Fin n) : Fin.find? p = none → p k = false :=
  find?.loop_none 0 (Nat.zero_le n) k (Nat.zero_le k.val)

@[specialize]
protected def foldl : {n : Nat} → (α → Fin n → α) → α → α
| 0, _, i => i
| n+1, f, i => Fin.foldl (fun x i => f x i.succ) (f i ⟨0, Nat.zero_lt_succ n⟩)

theorem foldl_zero (f : α → Fin 0 → α) (i : α) : Fin.foldl f i = i := rfl

theorem foldl_succ {n} (f : α → Fin (n+1) → α) (i : α) : Fin.foldl f i = f (Fin.foldl (fun x i => f x i.lift) i) ⟨n, Nat.lt_succ_self n⟩ := by
  induction n generalizing i with
  | zero => rfl
  | succ n ih => conv => lhs; unfold Fin.foldl; rw [ih]

@[specialize]
protected def foldr : {n : Nat} → (Fin n → α → α) → α → α
| 0, _, i => i
| n+1, f, i => Fin.foldr (fun i => f i.lift) (f ⟨n, Nat.lt_succ_self n⟩ i)

theorem foldr_zero (f : Fin 0 → α → α) (i : α) : Fin.foldr f i = i := rfl

theorem foldr_succ {n} (f : Fin (n+1) → α → α) (i : α) : Fin.foldr f i = f ⟨0, Nat.zero_lt_succ n⟩ (Fin.foldr (fun i => f i.succ) i) := by
  induction n generalizing i with
  | zero => rfl
  | succ n ih => conv => lhs; unfold Fin.foldr; rw [ih]

protected abbrev all {n} (p : Fin n → Bool) : Bool :=
  Fin.foldr (fun i v => p i && v) true

theorem forall_eq_true_of_all_eq_true : {n : Nat} → {p : Fin n → Bool} → Fin.all p = true → ∀ i, p i = true
| n+1, p, h, ⟨0, _⟩ => by
  rw [Fin.all, Fin.foldr_succ, Bool.and_eq_true] at h
  exact h.left
| n+1, p, h, ⟨i+1, hi⟩ => by
  rw [Fin.all, Fin.foldr_succ, Bool.and_eq_true] at h
  exact forall_eq_true_of_all_eq_true h.right ⟨i, Nat.lt_of_succ_lt_succ hi⟩

theorem exists_eq_false_of_all_eq_false : {n : Nat} → {p : Fin n → Bool} → Fin.all p = false → ∃ i, p i = false
| 0, _, h => Bool.noConfusion h
| n+1, p, h => by
  rw [Fin.all, Fin.foldr_succ, Bool.and_eq_false_iff] at h
  match h with
  | .inl h => exists ⟨0, Nat.zero_lt_succ n⟩
  | .inr h => match exists_eq_false_of_all_eq_false h with
    | ⟨⟨i,hi⟩,hp⟩ => exists ⟨i+1, Nat.succ_lt_succ hi⟩

instance (p : Fin n → Prop) [DecidablePred p] : Decidable (∀ i, p i) :=
  match hall : Fin.all fun i => decide (p i) with
  | true => isTrue $ by
    intro i
    apply of_decide_eq_true
    exact forall_eq_true_of_all_eq_true hall i
  | false => isFalse $ by
    intro h
    match exists_eq_false_of_all_eq_false hall with
    | ⟨i, hi⟩ => absurd h i; exact of_decide_eq_false hi

protected abbrev any {n} (p : Fin n → Bool) : Bool :=
  Fin.foldr (fun i v => p i || v) false

theorem exists_eq_true_of_any_eq_true : {n : Nat} → {p : Fin n → Bool} → Fin.any p = true → ∃ i, p i = true
| 0, _, h => Bool.noConfusion h
| n+1, p, h => by
  rw [Fin.any, Fin.foldr_succ, Bool.or_eq_true] at h
  match h with
  | .inl h => exists ⟨0, Nat.zero_lt_succ n⟩
  | .inr h => match exists_eq_true_of_any_eq_true h with
    | ⟨⟨i,hi⟩,hp⟩ => exists ⟨i+1, Nat.succ_lt_succ hi⟩

theorem forall_eq_false_of_any_eq_false : {n : Nat} → {p : Fin n → Bool} → Fin.any p = false → ∀ i, p i = false
| n+1, p, h, ⟨0, _⟩ => by
  rw [Fin.any, Fin.foldr_succ, Bool.or_eq_false_iff] at h
  exact h.left
| n+1, p, h, ⟨i+1, hi⟩ => by
  rw [Fin.any, Fin.foldr_succ, Bool.or_eq_false_iff] at h
  exact forall_eq_false_of_any_eq_false h.right ⟨i, Nat.lt_of_succ_lt_succ hi⟩

instance (p : Fin n → Prop) [DecidablePred p] : Decidable (∃ i, p i) :=
  match hany : Fin.any fun i => decide (p i) with
  | true => isTrue $ by
    match exists_eq_true_of_any_eq_true hany with
    | ⟨i, h⟩ => exists i; exact of_decide_eq_true h
  | false => isFalse $ by
    intro ⟨i, h⟩
    absurd h
    apply of_decide_eq_false
    exact forall_eq_false_of_any_eq_false hany i

end Fin


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

! This file was ported from Lean 3 source module topology.sober
! leanprover-community/mathlib commit 3e32bc908f617039c74c06ea9a897e30c30803c2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.Separation

/-!
# Sober spaces

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

A quasi-sober space is a topological space where every
irreducible closed subset has a generic point.
A sober space is a quasi-sober space where every irreducible closed subset
has a *unique* generic point. This is if and only if the space is T0, and thus sober spaces can be
stated via `[quasi_sober α] [t0_space α]`.

## Main definition

* `is_generic_point` : `x` is the generic point of `S` if `S` is the closure of `x`.
* `quasi_sober` : A space is quasi-sober if every irreducible closed subset has a generic point.

-/

open Set

variable {α β : Type _} [TopologicalSpace α] [TopologicalSpace β]

section genericPoint

#print IsGenericPoint /-
/-- `x` is a generic point of `S` if `S` is the closure of `x`. -/
def IsGenericPoint (x : α) (S : Set α) : Prop :=
  closure ({x} : Set α) = S
#align is_generic_point IsGenericPoint
-/

#print isGenericPoint_def /-
theorem isGenericPoint_def {x : α} {S : Set α} : IsGenericPoint x S ↔ closure ({x} : Set α) = S :=
  Iff.rfl
#align is_generic_point_def isGenericPoint_def
-/

#print IsGenericPoint.def /-
theorem IsGenericPoint.def {x : α} {S : Set α} (h : IsGenericPoint x S) :
    closure ({x} : Set α) = S :=
  h
#align is_generic_point.def IsGenericPoint.def
-/

#print isGenericPoint_closure /-
theorem isGenericPoint_closure {x : α} : IsGenericPoint x (closure ({x} : Set α)) :=
  refl _
#align is_generic_point_closure isGenericPoint_closure
-/

variable {x y : α} {S U Z : Set α}

#print isGenericPoint_iff_specializes /-
theorem isGenericPoint_iff_specializes : IsGenericPoint x S ↔ ∀ y, x ⤳ y ↔ y ∈ S := by
  simp only [specializes_iff_mem_closure, IsGenericPoint, Set.ext_iff]
#align is_generic_point_iff_specializes isGenericPoint_iff_specializes
-/

namespace IsGenericPoint

#print IsGenericPoint.specializes_iff_mem /-
theorem specializes_iff_mem (h : IsGenericPoint x S) : x ⤳ y ↔ y ∈ S :=
  isGenericPoint_iff_specializes.1 h y
#align is_generic_point.specializes_iff_mem IsGenericPoint.specializes_iff_mem
-/

#print IsGenericPoint.specializes /-
theorem specializes (h : IsGenericPoint x S) (h' : y ∈ S) : x ⤳ y :=
  h.specializes_iff_mem.2 h'
#align is_generic_point.specializes IsGenericPoint.specializes
-/

#print IsGenericPoint.mem /-
theorem mem (h : IsGenericPoint x S) : x ∈ S :=
  h.specializes_iff_mem.1 specializes_rfl
#align is_generic_point.mem IsGenericPoint.mem
-/

#print IsGenericPoint.isClosed /-
protected theorem isClosed (h : IsGenericPoint x S) : IsClosed S :=
  h.def ▸ isClosed_closure
#align is_generic_point.is_closed IsGenericPoint.isClosed
-/

#print IsGenericPoint.isIrreducible /-
protected theorem isIrreducible (h : IsGenericPoint x S) : IsIrreducible S :=
  h.def ▸ isIrreducible_singleton.closure
#align is_generic_point.is_irreducible IsGenericPoint.isIrreducible
-/

#print IsGenericPoint.eq /-
/-- In a T₀ space, each set has at most one generic point. -/
protected theorem eq [T0Space α] (h : IsGenericPoint x S) (h' : IsGenericPoint y S) : x = y :=
  ((h.Specializes h'.Mem).antisymm (h'.Specializes h.Mem)).Eq
#align is_generic_point.eq IsGenericPoint.eq
-/

/- warning: is_generic_point.mem_open_set_iff -> IsGenericPoint.mem_open_set_iff is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} α] {x : α} {S : Set.{u1} α} {U : Set.{u1} α}, (IsGenericPoint.{u1} α _inst_1 x S) -> (IsOpen.{u1} α _inst_1 U) -> (Iff (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x U) (Set.Nonempty.{u1} α (Inter.inter.{u1} (Set.{u1} α) (Set.hasInter.{u1} α) S U)))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} α] {x : α} {S : Set.{u1} α} {U : Set.{u1} α}, (IsGenericPoint.{u1} α _inst_1 x S) -> (IsOpen.{u1} α _inst_1 U) -> (Iff (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) x U) (Set.Nonempty.{u1} α (Inter.inter.{u1} (Set.{u1} α) (Set.instInterSet.{u1} α) S U)))
Case conversion may be inaccurate. Consider using '#align is_generic_point.mem_open_set_iff IsGenericPoint.mem_open_set_iffₓ'. -/
theorem mem_open_set_iff (h : IsGenericPoint x S) (hU : IsOpen U) : x ∈ U ↔ (S ∩ U).Nonempty :=
  ⟨fun h' => ⟨x, h.Mem, h'⟩, fun ⟨y, hyS, hyU⟩ => (h.Specializes hyS).mem_open hU hyU⟩
#align is_generic_point.mem_open_set_iff IsGenericPoint.mem_open_set_iff

/- warning: is_generic_point.disjoint_iff -> IsGenericPoint.disjoint_iff is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} α] {x : α} {S : Set.{u1} α} {U : Set.{u1} α}, (IsGenericPoint.{u1} α _inst_1 x S) -> (IsOpen.{u1} α _inst_1 U) -> (Iff (Disjoint.{u1} (Set.{u1} α) (CompleteSemilatticeInf.toPartialOrder.{u1} (Set.{u1} α) (CompleteLattice.toCompleteSemilatticeInf.{u1} (Set.{u1} α) (Order.Coframe.toCompleteLattice.{u1} (Set.{u1} α) (CompleteDistribLattice.toCoframe.{u1} (Set.{u1} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u1} (Set.{u1} α) (Set.completeBooleanAlgebra.{u1} α)))))) (GeneralizedBooleanAlgebra.toOrderBot.{u1} (Set.{u1} α) (BooleanAlgebra.toGeneralizedBooleanAlgebra.{u1} (Set.{u1} α) (Set.booleanAlgebra.{u1} α))) S U) (Not (Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x U)))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} α] {x : α} {S : Set.{u1} α} {U : Set.{u1} α}, (IsGenericPoint.{u1} α _inst_1 x S) -> (IsOpen.{u1} α _inst_1 U) -> (Iff (Disjoint.{u1} (Set.{u1} α) (CompleteSemilatticeInf.toPartialOrder.{u1} (Set.{u1} α) (CompleteLattice.toCompleteSemilatticeInf.{u1} (Set.{u1} α) (Order.Coframe.toCompleteLattice.{u1} (Set.{u1} α) (CompleteDistribLattice.toCoframe.{u1} (Set.{u1} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u1} (Set.{u1} α) (Set.instCompleteBooleanAlgebraSet.{u1} α)))))) (BoundedOrder.toOrderBot.{u1} (Set.{u1} α) (Preorder.toLE.{u1} (Set.{u1} α) (PartialOrder.toPreorder.{u1} (Set.{u1} α) (CompleteSemilatticeInf.toPartialOrder.{u1} (Set.{u1} α) (CompleteLattice.toCompleteSemilatticeInf.{u1} (Set.{u1} α) (Order.Coframe.toCompleteLattice.{u1} (Set.{u1} α) (CompleteDistribLattice.toCoframe.{u1} (Set.{u1} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u1} (Set.{u1} α) (Set.instCompleteBooleanAlgebraSet.{u1} α)))))))) (CompleteLattice.toBoundedOrder.{u1} (Set.{u1} α) (Order.Coframe.toCompleteLattice.{u1} (Set.{u1} α) (CompleteDistribLattice.toCoframe.{u1} (Set.{u1} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u1} (Set.{u1} α) (Set.instCompleteBooleanAlgebraSet.{u1} α)))))) S U) (Not (Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) x U)))
Case conversion may be inaccurate. Consider using '#align is_generic_point.disjoint_iff IsGenericPoint.disjoint_iffₓ'. -/
theorem disjoint_iff (h : IsGenericPoint x S) (hU : IsOpen U) : Disjoint S U ↔ x ∉ U := by
  rw [h.mem_open_set_iff hU, ← not_disjoint_iff_nonempty_inter, Classical.not_not]
#align is_generic_point.disjoint_iff IsGenericPoint.disjoint_iff

#print IsGenericPoint.mem_closed_set_iff /-
theorem mem_closed_set_iff (h : IsGenericPoint x S) (hZ : IsClosed Z) : x ∈ Z ↔ S ⊆ Z := by
  rw [← h.def, hZ.closure_subset_iff, singleton_subset_iff]
#align is_generic_point.mem_closed_set_iff IsGenericPoint.mem_closed_set_iff
-/

/- warning: is_generic_point.image -> IsGenericPoint.image is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : TopologicalSpace.{u1} α] [_inst_2 : TopologicalSpace.{u2} β] {x : α} {S : Set.{u1} α}, (IsGenericPoint.{u1} α _inst_1 x S) -> (forall {f : α -> β}, (Continuous.{u1, u2} α β _inst_1 _inst_2 f) -> (IsGenericPoint.{u2} β _inst_2 (f x) (closure.{u2} β _inst_2 (Set.image.{u1, u2} α β f S))))
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} [_inst_1 : TopologicalSpace.{u2} α] [_inst_2 : TopologicalSpace.{u1} β] {x : α} {S : Set.{u2} α}, (IsGenericPoint.{u2} α _inst_1 x S) -> (forall {f : α -> β}, (Continuous.{u2, u1} α β _inst_1 _inst_2 f) -> (IsGenericPoint.{u1} β _inst_2 (f x) (closure.{u1} β _inst_2 (Set.image.{u2, u1} α β f S))))
Case conversion may be inaccurate. Consider using '#align is_generic_point.image IsGenericPoint.imageₓ'. -/
protected theorem image (h : IsGenericPoint x S) {f : α → β} (hf : Continuous f) :
    IsGenericPoint (f x) (closure (f '' S)) :=
  by
  rw [isGenericPoint_def, ← h.def, ← image_singleton]
  exact
    subset.antisymm (closure_mono (image_subset _ subset_closure))
      (closure_minimal (image_closure_subset_closure_image hf) isClosed_closure)
#align is_generic_point.image IsGenericPoint.image

end IsGenericPoint

#print isGenericPoint_iff_forall_closed /-
theorem isGenericPoint_iff_forall_closed (hS : IsClosed S) (hxS : x ∈ S) :
    IsGenericPoint x S ↔ ∀ Z : Set α, IsClosed Z → x ∈ Z → S ⊆ Z :=
  by
  have : closure {x} ⊆ S := closure_minimal (singleton_subset_iff.2 hxS) hS
  simp_rw [IsGenericPoint, subset_antisymm_iff, this, true_and_iff, closure, subset_sInter_iff,
    mem_set_of_eq, and_imp, singleton_subset_iff]
#align is_generic_point_iff_forall_closed isGenericPoint_iff_forall_closed
-/

end genericPoint

section Sober

#print QuasiSober /-
/-- A space is sober if every irreducible closed subset has a generic point. -/
@[mk_iff]
class QuasiSober (α : Type _) [TopologicalSpace α] : Prop where
  sober : ∀ {S : Set α} (hS₁ : IsIrreducible S) (hS₂ : IsClosed S), ∃ x, IsGenericPoint x S
#align quasi_sober QuasiSober
-/

#print IsIrreducible.genericPoint /-
/-- A generic point of the closure of an irreducible space. -/
noncomputable def IsIrreducible.genericPoint [QuasiSober α] {S : Set α} (hS : IsIrreducible S) :
    α :=
  (QuasiSober.sober hS.closure isClosed_closure).some
#align is_irreducible.generic_point IsIrreducible.genericPoint
-/

#print IsIrreducible.genericPoint_spec /-
theorem IsIrreducible.genericPoint_spec [QuasiSober α] {S : Set α} (hS : IsIrreducible S) :
    IsGenericPoint hS.genericPoint (closure S) :=
  (QuasiSober.sober hS.closure isClosed_closure).choose_spec
#align is_irreducible.generic_point_spec IsIrreducible.genericPoint_spec
-/

#print IsIrreducible.genericPoint_closure_eq /-
@[simp]
theorem IsIrreducible.genericPoint_closure_eq [QuasiSober α] {S : Set α} (hS : IsIrreducible S) :
    closure ({hS.genericPoint} : Set α) = closure S :=
  hS.genericPoint_spec
#align is_irreducible.generic_point_closure_eq IsIrreducible.genericPoint_closure_eq
-/

variable (α)

#print genericPoint /-
/-- A generic point of a sober irreducible space. -/
noncomputable def genericPoint [QuasiSober α] [IrreducibleSpace α] : α :=
  (IrreducibleSpace.isIrreducible_univ α).genericPoint
#align generic_point genericPoint
-/

/- warning: generic_point_spec -> genericPoint_spec is a dubious translation:
lean 3 declaration is
  forall (α : Type.{u1}) [_inst_1 : TopologicalSpace.{u1} α] [_inst_3 : QuasiSober.{u1} α _inst_1] [_inst_4 : IrreducibleSpace.{u1} α _inst_1], IsGenericPoint.{u1} α _inst_1 (genericPoint.{u1} α _inst_1 _inst_3 _inst_4) (Top.top.{u1} (Set.{u1} α) (CompleteLattice.toHasTop.{u1} (Set.{u1} α) (Order.Coframe.toCompleteLattice.{u1} (Set.{u1} α) (CompleteDistribLattice.toCoframe.{u1} (Set.{u1} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u1} (Set.{u1} α) (Set.completeBooleanAlgebra.{u1} α))))))
but is expected to have type
  forall (α : Type.{u1}) [_inst_1 : TopologicalSpace.{u1} α] [_inst_3 : QuasiSober.{u1} α _inst_1] [_inst_4 : IrreducibleSpace.{u1} α _inst_1], IsGenericPoint.{u1} α _inst_1 (genericPoint.{u1} α _inst_1 _inst_3 _inst_4) (Top.top.{u1} (Set.{u1} α) (CompleteLattice.toTop.{u1} (Set.{u1} α) (Order.Coframe.toCompleteLattice.{u1} (Set.{u1} α) (CompleteDistribLattice.toCoframe.{u1} (Set.{u1} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u1} (Set.{u1} α) (Set.instCompleteBooleanAlgebraSet.{u1} α))))))
Case conversion may be inaccurate. Consider using '#align generic_point_spec genericPoint_specₓ'. -/
theorem genericPoint_spec [QuasiSober α] [IrreducibleSpace α] : IsGenericPoint (genericPoint α) ⊤ :=
  by simpa using (IrreducibleSpace.isIrreducible_univ α).genericPoint_spec
#align generic_point_spec genericPoint_spec

/- warning: generic_point_closure -> genericPoint_closure is a dubious translation:
lean 3 declaration is
  forall (α : Type.{u1}) [_inst_1 : TopologicalSpace.{u1} α] [_inst_3 : QuasiSober.{u1} α _inst_1] [_inst_4 : IrreducibleSpace.{u1} α _inst_1], Eq.{succ u1} (Set.{u1} α) (closure.{u1} α _inst_1 (Singleton.singleton.{u1, u1} α (Set.{u1} α) (Set.hasSingleton.{u1} α) (genericPoint.{u1} α _inst_1 _inst_3 _inst_4))) (Top.top.{u1} (Set.{u1} α) (CompleteLattice.toHasTop.{u1} (Set.{u1} α) (Order.Coframe.toCompleteLattice.{u1} (Set.{u1} α) (CompleteDistribLattice.toCoframe.{u1} (Set.{u1} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u1} (Set.{u1} α) (Set.completeBooleanAlgebra.{u1} α))))))
but is expected to have type
  forall (α : Type.{u1}) [_inst_1 : TopologicalSpace.{u1} α] [_inst_3 : QuasiSober.{u1} α _inst_1] [_inst_4 : IrreducibleSpace.{u1} α _inst_1], Eq.{succ u1} (Set.{u1} α) (closure.{u1} α _inst_1 (Singleton.singleton.{u1, u1} α (Set.{u1} α) (Set.instSingletonSet.{u1} α) (genericPoint.{u1} α _inst_1 _inst_3 _inst_4))) (Top.top.{u1} (Set.{u1} α) (CompleteLattice.toTop.{u1} (Set.{u1} α) (Order.Coframe.toCompleteLattice.{u1} (Set.{u1} α) (CompleteDistribLattice.toCoframe.{u1} (Set.{u1} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u1} (Set.{u1} α) (Set.instCompleteBooleanAlgebraSet.{u1} α))))))
Case conversion may be inaccurate. Consider using '#align generic_point_closure genericPoint_closureₓ'. -/
@[simp]
theorem genericPoint_closure [QuasiSober α] [IrreducibleSpace α] :
    closure ({genericPoint α} : Set α) = ⊤ :=
  genericPoint_spec α
#align generic_point_closure genericPoint_closure

variable {α}

#print genericPoint_specializes /-
theorem genericPoint_specializes [QuasiSober α] [IrreducibleSpace α] (x : α) : genericPoint α ⤳ x :=
  (IsIrreducible.genericPoint_spec _).Specializes (by simp)
#align generic_point_specializes genericPoint_specializes
-/

attribute [local instance] specializationOrder

#print irreducibleSetEquivPoints /-
/-- The closed irreducible subsets of a sober space bijects with the points of the space. -/
noncomputable def irreducibleSetEquivPoints [QuasiSober α] [T0Space α] :
    { s : Set α | IsIrreducible s ∧ IsClosed s } ≃o α
    where
  toFun s := s.Prop.1.genericPoint
  invFun x := ⟨closure ({x} : Set α), isIrreducible_singleton.closure, isClosed_closure⟩
  left_inv s :=
    Subtype.eq <| Eq.trans s.Prop.1.genericPoint_spec <| closure_eq_iff_isClosed.mpr s.2.2
  right_inv x :=
    isIrreducible_singleton.closure.genericPoint_spec.Eq
      (by
        convert isGenericPoint_closure using 1
        rw [closure_closure])
  map_rel_iff' s t := by
    change _ ⤳ _ ↔ _
    rw [specializes_iff_closure_subset]
    simp [s.prop.2.closure_eq, t.prop.2.closure_eq, ← Subtype.coe_le_coe]
#align irreducible_set_equiv_points irreducibleSetEquivPoints
-/

/- warning: closed_embedding.quasi_sober -> ClosedEmbedding.quasiSober is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : TopologicalSpace.{u1} α] [_inst_2 : TopologicalSpace.{u2} β] {f : α -> β}, (ClosedEmbedding.{u1, u2} α β _inst_1 _inst_2 f) -> (forall [_inst_3 : QuasiSober.{u2} β _inst_2], QuasiSober.{u1} α _inst_1)
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} [_inst_1 : TopologicalSpace.{u2} α] [_inst_2 : TopologicalSpace.{u1} β] {f : α -> β}, (ClosedEmbedding.{u2, u1} α β _inst_1 _inst_2 f) -> (forall [_inst_3 : QuasiSober.{u1} β _inst_2], QuasiSober.{u2} α _inst_1)
Case conversion may be inaccurate. Consider using '#align closed_embedding.quasi_sober ClosedEmbedding.quasiSoberₓ'. -/
theorem ClosedEmbedding.quasiSober {f : α → β} (hf : ClosedEmbedding f) [QuasiSober β] :
    QuasiSober α := by
  constructor
  intro S hS hS'
  have hS'' := hS.image f hf.continuous.continuous_on
  obtain ⟨x, hx⟩ := QuasiSober.sober hS'' (hf.is_closed_map _ hS')
  obtain ⟨y, hy, rfl⟩ := hx.mem
  use y
  change _ = _ at hx
  apply set.image_injective.mpr hf.inj
  rw [← hx, ← hf.closure_image_eq, Set.image_singleton]
#align closed_embedding.quasi_sober ClosedEmbedding.quasiSober

/- warning: open_embedding.quasi_sober -> OpenEmbedding.quasiSober is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {β : Type.{u2}} [_inst_1 : TopologicalSpace.{u1} α] [_inst_2 : TopologicalSpace.{u2} β] {f : α -> β}, (OpenEmbedding.{u1, u2} α β _inst_1 _inst_2 f) -> (forall [_inst_3 : QuasiSober.{u2} β _inst_2], QuasiSober.{u1} α _inst_1)
but is expected to have type
  forall {α : Type.{u2}} {β : Type.{u1}} [_inst_1 : TopologicalSpace.{u2} α] [_inst_2 : TopologicalSpace.{u1} β] {f : α -> β}, (OpenEmbedding.{u2, u1} α β _inst_1 _inst_2 f) -> (forall [_inst_3 : QuasiSober.{u1} β _inst_2], QuasiSober.{u2} α _inst_1)
Case conversion may be inaccurate. Consider using '#align open_embedding.quasi_sober OpenEmbedding.quasiSoberₓ'. -/
theorem OpenEmbedding.quasiSober {f : α → β} (hf : OpenEmbedding f) [QuasiSober β] : QuasiSober α :=
  by
  constructor
  intro S hS hS'
  have hS'' := hS.image f hf.continuous.continuous_on
  obtain ⟨x, hx⟩ := QuasiSober.sober hS''.closure isClosed_closure
  obtain ⟨T, hT, rfl⟩ := hf.to_inducing.is_closed_iff.mp hS'
  rw [Set.image_preimage_eq_inter_range] at hx hS''
  have hxT : x ∈ T := by
    rw [← hT.closure_eq]
    exact closure_mono (Set.inter_subset_left _ _) hx.mem
  have hxU : x ∈ Set.range f :=
    by
    rw [hx.mem_open_set_iff hf.open_range]
    refine' Set.Nonempty.mono _ hS''.1
    simpa using subset_closure
  rcases hxU with ⟨y, rfl⟩
  use y
  change _ = _
  rw [hf.to_embedding.closure_eq_preimage_closure_image, Set.image_singleton, show _ = _ from hx]
  apply set.image_injective.mpr hf.inj
  ext z
  simp only [Set.image_preimage_eq_inter_range, Set.mem_inter_iff, and_congr_left_iff]
  exact fun hy =>
    ⟨fun h => hT.closure_eq ▸ closure_mono (Set.inter_subset_left _ _) h, fun h =>
      subset_closure ⟨h, hy⟩⟩
#align open_embedding.quasi_sober OpenEmbedding.quasiSober

/- warning: quasi_sober_of_open_cover -> quasiSober_of_open_cover is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} α] (S : Set.{u1} (Set.{u1} α)), (forall (s : coeSort.{succ u1, succ (succ u1)} (Set.{u1} (Set.{u1} α)) Type.{u1} (Set.hasCoeToSort.{u1} (Set.{u1} α)) S), IsOpen.{u1} α _inst_1 ((fun (a : Type.{u1}) (b : Type.{u1}) [self : HasLiftT.{succ u1, succ u1} a b] => self.0) (coeSort.{succ u1, succ (succ u1)} (Set.{u1} (Set.{u1} α)) Type.{u1} (Set.hasCoeToSort.{u1} (Set.{u1} α)) S) (Set.{u1} α) (HasLiftT.mk.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} (Set.{u1} α)) Type.{u1} (Set.hasCoeToSort.{u1} (Set.{u1} α)) S) (Set.{u1} α) (CoeTCₓ.coe.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} (Set.{u1} α)) Type.{u1} (Set.hasCoeToSort.{u1} (Set.{u1} α)) S) (Set.{u1} α) (coeBase.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} (Set.{u1} α)) Type.{u1} (Set.hasCoeToSort.{u1} (Set.{u1} α)) S) (Set.{u1} α) (coeSubtype.{succ u1} (Set.{u1} α) (fun (x : Set.{u1} α) => Membership.Mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.hasMem.{u1} (Set.{u1} α)) x S))))) s)) -> (forall [hS' : forall (s : coeSort.{succ u1, succ (succ u1)} (Set.{u1} (Set.{u1} α)) Type.{u1} (Set.hasCoeToSort.{u1} (Set.{u1} α)) S), QuasiSober.{u1} (coeSort.{succ u1, succ (succ u1)} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} (Set.{u1} α)) Type.{u1} (Set.hasCoeToSort.{u1} (Set.{u1} α)) S) Type.{u1} (coeSortTrans.{succ (succ u1), succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} (Set.{u1} α)) Type.{u1} (Set.hasCoeToSort.{u1} (Set.{u1} α)) S) (Set.{u1} α) Type.{u1} (Set.hasCoeToSort.{u1} α) (coeBaseAux.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} (Set.{u1} α)) Type.{u1} (Set.hasCoeToSort.{u1} (Set.{u1} α)) S) (Set.{u1} α) (coeSubtype.{succ u1} (Set.{u1} α) (fun (x : Set.{u1} α) => Membership.Mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.hasMem.{u1} (Set.{u1} α)) x S)))) s) (Subtype.topologicalSpace.{u1} α (fun (x : α) => Membership.Mem.{u1, u1} α (Set.{u1} α) (Set.hasMem.{u1} α) x (HasCoeTAux.coe.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} (Set.{u1} α)) Type.{u1} (Set.hasCoeToSort.{u1} (Set.{u1} α)) S) (Set.{u1} α) (coeBaseAux.{succ u1, succ u1} (coeSort.{succ u1, succ (succ u1)} (Set.{u1} (Set.{u1} α)) Type.{u1} (Set.hasCoeToSort.{u1} (Set.{u1} α)) S) (Set.{u1} α) (coeSubtype.{succ u1} (Set.{u1} α) (fun (x : Set.{u1} α) => Membership.Mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.hasMem.{u1} (Set.{u1} α)) x S))) s)) _inst_1)], (Eq.{succ u1} (Set.{u1} α) (Set.unionₛ.{u1} α S) (Top.top.{u1} (Set.{u1} α) (CompleteLattice.toHasTop.{u1} (Set.{u1} α) (Order.Coframe.toCompleteLattice.{u1} (Set.{u1} α) (CompleteDistribLattice.toCoframe.{u1} (Set.{u1} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u1} (Set.{u1} α) (Set.completeBooleanAlgebra.{u1} α))))))) -> (QuasiSober.{u1} α _inst_1))
but is expected to have type
  forall {α : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} α] (S : Set.{u1} (Set.{u1} α)), (forall (s : Set.Elem.{u1} (Set.{u1} α) S), IsOpen.{u1} α _inst_1 (Subtype.val.{succ u1} (Set.{u1} α) (fun (x : Set.{u1} α) => Membership.mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.instMembershipSet.{u1} (Set.{u1} α)) x S) s)) -> (forall [hS' : forall (s : Set.Elem.{u1} (Set.{u1} α) S), QuasiSober.{u1} (Set.Elem.{u1} α (Subtype.val.{succ u1} (Set.{u1} α) (fun (x : Set.{u1} α) => Membership.mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.instMembershipSet.{u1} (Set.{u1} α)) x S) s)) (instTopologicalSpaceSubtype.{u1} α (fun (x : α) => Membership.mem.{u1, u1} α (Set.{u1} α) (Set.instMembershipSet.{u1} α) x (Subtype.val.{succ u1} (Set.{u1} α) (fun (x : Set.{u1} α) => Membership.mem.{u1, u1} (Set.{u1} α) (Set.{u1} (Set.{u1} α)) (Set.instMembershipSet.{u1} (Set.{u1} α)) x S) s)) _inst_1)], (Eq.{succ u1} (Set.{u1} α) (Set.unionₛ.{u1} α S) (Top.top.{u1} (Set.{u1} α) (CompleteLattice.toTop.{u1} (Set.{u1} α) (Order.Coframe.toCompleteLattice.{u1} (Set.{u1} α) (CompleteDistribLattice.toCoframe.{u1} (Set.{u1} α) (CompleteBooleanAlgebra.toCompleteDistribLattice.{u1} (Set.{u1} α) (Set.instCompleteBooleanAlgebraSet.{u1} α))))))) -> (QuasiSober.{u1} α _inst_1))
Case conversion may be inaccurate. Consider using '#align quasi_sober_of_open_cover quasiSober_of_open_coverₓ'. -/
/-- A space is quasi sober if it can be covered by open quasi sober subsets. -/
theorem quasiSober_of_open_cover (S : Set (Set α)) (hS : ∀ s : S, IsOpen (s : Set α))
    [hS' : ∀ s : S, QuasiSober s] (hS'' : ⋃₀ S = ⊤) : QuasiSober α :=
  by
  rw [quasiSober_iff]
  intro t h h'
  obtain ⟨x, hx⟩ := h.1
  obtain ⟨U, hU, hU'⟩ : x ∈ ⋃₀ S := by
    rw [hS'']
    trivial
  haveI : QuasiSober U := hS' ⟨U, hU⟩
  have H : IsPreirreducible (coe ⁻¹' t : Set U) :=
    h.2.Preimage (hS ⟨U, hU⟩).openEmbedding_subtype_val
  replace H : IsIrreducible (coe ⁻¹' t : Set U) := ⟨⟨⟨x, hU'⟩, by simpa using hx⟩, H⟩
  use H.generic_point
  have := continuous_subtype_coe.closure_preimage_subset _ H.generic_point_spec.mem
  rw [h'.closure_eq] at this
  apply le_antisymm
  · apply h'.closure_subset_iff.mpr
    simpa using this
  rw [← Set.image_singleton, ← closure_closure]
  have := closure_mono (image_closure_subset_closure_image (@continuous_subtype_val α _ U))
  refine' Set.Subset.trans _ this
  rw [H.generic_point_spec.def]
  refine'
    (subset_closure_inter_of_isPreirreducible_of_isOpen h.2 (hS ⟨U, hU⟩) ⟨x, hx, hU'⟩).trans
      (closure_mono _)
  rw [← Subtype.image_preimage_coe]
  exact Set.image_subset _ subset_closure
#align quasi_sober_of_open_cover quasiSober_of_open_cover

#print T2Space.quasiSober /-
instance (priority := 100) T2Space.quasiSober [T2Space α] : QuasiSober α :=
  by
  constructor
  rintro S h -
  obtain ⟨x, rfl⟩ := is_irreducible_iff_singleton.mp h
  exact ⟨x, closure_singleton⟩
#align t2_space.quasi_sober T2Space.quasiSober
-/

end Sober


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

/-!
# Minimum and maximum w.r.t. a filter and on a aet

## Main Definitions

This file defines six predicates of the form `is_A_B`, where `A` is `min`, `max`, or `extr`,
and `B` is `filter` or `on`.

* `is_min_filter f l a` means that `f a ≤ f x` in some `l`-neighborhood of `a`;
* `is_max_filter f l a` means that `f x ≤ f a` in some `l`-neighborhood of `a`;
* `is_extr_filter f l a` means `is_min_filter f l a` or `is_max_filter f l a`.

Similar predicates with `_on` suffix are particular cases for `l = 𝓟 s`.

## Main statements

### Change of the filter (set) argument

* `is_*_filter.filter_mono` : replace the filter with a smaller one;
* `is_*_filter.filter_inf` : replace a filter `l` with `l ⊓ l'`;
* `is_*_on.on_subset` : restrict to a smaller set;
* `is_*_on.inter` : replace a set `s` wtih `s ∩ t`.

### Composition

* `is_*_*.comp_mono` : if `x` is an extremum for `f` and `g` is a monotone function,
  then `x` is an extremum for `g ∘ f`;
* `is_*_*.comp_antitone` : similarly for the case of antitone `g`;
* `is_*_*.bicomp_mono` : if `x` is an extremum of the same type for `f` and `g`
  and a binary operation `op` is monotone in both arguments, then `x` is an extremum
  of the same type for `λ x, op (f x) (g x)`.
* `is_*_filter.comp_tendsto` : if `g x` is an extremum for `f` w.r.t. `l'` and `tendsto g l l'`,
  then `x` is an extremum for `f ∘ g` w.r.t. `l`.
* `is_*_on.on_preimage` : if `g x` is an extremum for `f` on `s`, then `x` is an extremum
  for `f ∘ g` on `g ⁻¹' s`.

### Algebraic operations

* `is_*_*.add` : if `x` is an extremum of the same type for two functions,
  then it is an extremum of the same type for their sum;
* `is_*_*.neg` : if `x` is an extremum for `f`, then it is an extremum
  of the opposite type for `-f`;
* `is_*_*.sub` : if `x` is an a minimum for `f` and a maximum for `g`,
  then it is a minimum for `f - g` and a maximum for `g - f`;
* `is_*_*.max`, `is_*_*.min`, `is_*_*.sup`, `is_*_*.inf` : similarly for `is_*_*.add`
  for pointwise `max`, `min`, `sup`, `inf`, respectively.

### Miscellaneous definitions

* `is_*_*_const` : any point is both a minimum and maximum for a constant function;
* `is_min/max_*.is_ext` : any minimum/maximum point is an extremum;
* `is_*_*.dual`, `is_*_*.undual`: conversion between codomains `α` and `dual α`;

## Missing features (TODO)

* Multiplication and division;
* `is_*_*.bicompl` : if `x` is a minimum for `f`, `y` is a minimum for `g`, and `op` is a monotone
  binary operation, then `(x, y)` is a minimum for `uncurry (bicompl op f g)`. From this point
  of view, `is_*_*.bicomp` is a composition
* It would be nice to have a tactic that specializes `comp_(anti)mono` or `bicomp_mono`
  based on a proof of monotonicity of a given (binary) function. The tactic should maintain a `meta`
  list of known (anti)monotone (binary) functions with their names, as well as a list of special
  types of filters, and define the missing lemmas once one of these two lists grows.
-/

universes u v w x

variables {α : Type u} {β : Type v} {γ : Type w} {δ : Type x}

open set filter
open_locale filter

section preorder

variables [preorder β] [preorder γ]

variables (f : α → β) (s : set α) (l : filter α) (a : α)

/-! ### Definitions -/

/-- `is_min_filter f l a` means that `f a ≤ f x` in some `l`-neighborhood of `a` -/
def is_min_filter : Prop := ∀ᶠ x in l, f a ≤ f x

/-- `is_max_filter f l a` means that `f x ≤ f a` in some `l`-neighborhood of `a` -/
def is_max_filter : Prop := ∀ᶠ x in l, f x ≤ f a

/-- `is_extr_filter f l a` means `is_min_filter f l a` or `is_max_filter f l a` -/
def is_extr_filter : Prop := is_min_filter f l a ∨ is_max_filter f l a

/-- `is_min_on f s a` means that `f a ≤ f x` for all `x ∈ a`. Note that we do not assume `a ∈ s`. -/
def is_min_on := is_min_filter f (𝓟 s) a

/-- `is_max_on f s a` means that `f x ≤ f a` for all `x ∈ a`. Note that we do not assume `a ∈ s`. -/
def is_max_on := is_max_filter f (𝓟 s) a

/-- `is_extr_on f s a` means `is_min_on f s a` or `is_max_on f s a` -/
def is_extr_on : Prop := is_extr_filter f (𝓟 s) a

variables {f s a l} {t : set α} {l' : filter α}

lemma is_extr_on.elim {p : Prop} :
  is_extr_on f s a → (is_min_on f s a → p) → (is_max_on f s a → p) → p :=
or.elim

lemma is_min_on_iff : is_min_on f s a ↔ ∀ x ∈ s, f a ≤ f x := iff.rfl

lemma is_max_on_iff : is_max_on f s a ↔ ∀ x ∈ s, f x ≤ f a := iff.rfl

lemma is_min_on_univ_iff : is_min_on f univ a ↔ ∀ x, f a ≤ f x :=
univ_subset_iff.trans eq_univ_iff_forall

lemma is_max_on_univ_iff : is_max_on f univ a ↔ ∀ x, f x ≤ f a :=
univ_subset_iff.trans eq_univ_iff_forall

lemma is_min_filter.tendsto_principal_Ici (h : is_min_filter f l a) :
  tendsto f l (𝓟 $ Ici (f a)) :=
tendsto_principal.2 h

lemma is_max_filter.tendsto_principal_Iic (h : is_max_filter f l a) :
  tendsto f l (𝓟 $ Iic (f a)) :=
tendsto_principal.2 h

/-! ### Conversion to `is_extr_*` -/

lemma is_min_filter.is_extr : is_min_filter f l a → is_extr_filter f l a := or.inl

lemma is_max_filter.is_extr : is_max_filter f l a → is_extr_filter f l a := or.inr

lemma is_min_on.is_extr (h : is_min_on f s a) : is_extr_on f s a := h.is_extr

lemma is_max_on.is_extr (h : is_max_on f s a) : is_extr_on f s a := h.is_extr

/-! ### Constant function -/

lemma is_min_filter_const {b : β} : is_min_filter (λ _, b) l a :=
univ_mem' $ λ _, le_refl _

lemma is_max_filter_const {b : β} : is_max_filter (λ _, b) l a :=
univ_mem' $ λ _, le_refl _

lemma is_extr_filter_const {b : β} : is_extr_filter (λ _, b) l a := is_min_filter_const.is_extr

lemma is_min_on_const {b : β} : is_min_on (λ _, b) s a := is_min_filter_const

lemma is_max_on_const {b : β} : is_max_on (λ _, b) s a := is_max_filter_const

lemma is_extr_on_const {b : β} : is_extr_on (λ _, b) s a := is_extr_filter_const

/-! ### Order dual -/

open order_dual (to_dual)

lemma is_min_filter_dual_iff : is_min_filter (to_dual ∘ f) l a ↔ is_max_filter f l a :=
iff.rfl

lemma is_max_filter_dual_iff : is_max_filter (to_dual ∘ f) l a ↔ is_min_filter f l a :=
iff.rfl

lemma is_extr_filter_dual_iff : is_extr_filter (to_dual ∘ f) l a ↔ is_extr_filter f l a :=
or_comm _ _

alias is_min_filter_dual_iff ↔ is_min_filter.undual is_max_filter.dual
alias is_max_filter_dual_iff ↔ is_max_filter.undual is_min_filter.dual
alias is_extr_filter_dual_iff ↔ is_extr_filter.undual is_extr_filter.dual

lemma is_min_on_dual_iff : is_min_on (to_dual ∘ f) s a ↔ is_max_on f s a := iff.rfl
lemma is_max_on_dual_iff : is_max_on (to_dual ∘ f) s a ↔ is_min_on f s a := iff.rfl
lemma is_extr_on_dual_iff : is_extr_on (to_dual ∘ f) s a ↔ is_extr_on f s a := or_comm _ _

alias is_min_on_dual_iff ↔ is_min_on.undual is_max_on.dual
alias is_max_on_dual_iff ↔ is_max_on.undual is_min_on.dual
alias is_extr_on_dual_iff ↔ is_extr_on.undual is_extr_on.dual

/-! ### Operations on the filter/set -/

lemma is_min_filter.filter_mono (h : is_min_filter f l a) (hl : l' ≤ l) :
  is_min_filter f l' a := hl h

lemma is_max_filter.filter_mono (h : is_max_filter f l a) (hl : l' ≤ l) :
  is_max_filter f l' a := hl h

lemma is_extr_filter.filter_mono (h : is_extr_filter f l a) (hl : l' ≤ l) :
  is_extr_filter f l' a :=
h.elim (λ h, (h.filter_mono hl).is_extr) (λ h, (h.filter_mono hl).is_extr)

lemma is_min_filter.filter_inf (h : is_min_filter f l a) (l') : is_min_filter f (l ⊓ l') a :=
h.filter_mono inf_le_left

lemma is_max_filter.filter_inf (h : is_max_filter f l a) (l') : is_max_filter f (l ⊓ l') a :=
h.filter_mono inf_le_left

lemma is_extr_filter.filter_inf (h : is_extr_filter f l a) (l') : is_extr_filter f (l ⊓ l') a :=
h.filter_mono inf_le_left

lemma is_min_on.on_subset (hf : is_min_on f t a) (h : s ⊆ t) : is_min_on f s a :=
hf.filter_mono $ principal_mono.2 h

lemma is_max_on.on_subset (hf : is_max_on f t a) (h : s ⊆ t) : is_max_on f s a :=
hf.filter_mono $ principal_mono.2 h

lemma is_extr_on.on_subset (hf : is_extr_on f t a) (h : s ⊆ t) : is_extr_on f s a :=
hf.filter_mono $ principal_mono.2 h

lemma is_min_on.inter (hf : is_min_on f s a) (t) : is_min_on f (s ∩ t) a :=
hf.on_subset (inter_subset_left s t)

lemma is_max_on.inter (hf : is_max_on f s a) (t) : is_max_on f (s ∩ t) a :=
hf.on_subset (inter_subset_left s t)

lemma is_extr_on.inter (hf : is_extr_on f s a) (t) : is_extr_on f (s ∩ t) a :=
hf.on_subset (inter_subset_left s t)

/-! ### Composition with (anti)monotone functions -/

lemma is_min_filter.comp_mono (hf : is_min_filter f l a) {g : β → γ} (hg : monotone g) :
  is_min_filter (g ∘ f) l a :=
mem_of_superset hf $ λ x hx, hg hx

lemma is_max_filter.comp_mono (hf : is_max_filter f l a) {g : β → γ} (hg : monotone g) :
  is_max_filter (g ∘ f) l a :=
mem_of_superset hf $ λ x hx, hg hx

lemma is_extr_filter.comp_mono (hf : is_extr_filter f l a) {g : β → γ} (hg : monotone g) :
  is_extr_filter (g ∘ f) l a :=
hf.elim (λ hf, (hf.comp_mono hg).is_extr)  (λ hf, (hf.comp_mono hg).is_extr)

lemma is_min_filter.comp_antitone (hf : is_min_filter f l a) {g : β → γ}
  (hg : antitone g) :
  is_max_filter (g ∘ f) l a :=
hf.dual.comp_mono (λ x y h, hg h)

lemma is_max_filter.comp_antitone (hf : is_max_filter f l a) {g : β → γ}
  (hg : antitone g) :
  is_min_filter (g ∘ f) l a :=
hf.dual.comp_mono (λ x y h, hg h)

lemma is_extr_filter.comp_antitone (hf : is_extr_filter f l a) {g : β → γ}
  (hg : antitone g) :
  is_extr_filter (g ∘ f) l a :=
hf.dual.comp_mono (λ x y h, hg h)

lemma is_min_on.comp_mono (hf : is_min_on f s a) {g : β → γ} (hg : monotone g) :
  is_min_on (g ∘ f) s a :=
hf.comp_mono hg

lemma is_max_on.comp_mono (hf : is_max_on f s a) {g : β → γ} (hg : monotone g) :
  is_max_on (g ∘ f) s a :=
hf.comp_mono hg

lemma is_extr_on.comp_mono (hf : is_extr_on f s a) {g : β → γ} (hg : monotone g) :
  is_extr_on (g ∘ f) s a :=
hf.comp_mono hg

lemma is_min_on.comp_antitone (hf : is_min_on f s a) {g : β → γ}
  (hg : antitone g) :
  is_max_on (g ∘ f) s a :=
hf.comp_antitone hg

lemma is_max_on.comp_antitone (hf : is_max_on f s a) {g : β → γ}
  (hg : antitone g) :
  is_min_on (g ∘ f) s a :=
hf.comp_antitone hg

lemma is_extr_on.comp_antitone (hf : is_extr_on f s a) {g : β → γ}
  (hg : antitone g) :
  is_extr_on (g ∘ f) s a :=
hf.comp_antitone hg

lemma is_min_filter.bicomp_mono [preorder δ] {op : β → γ → δ} (hop : ((≤) ⇒ (≤) ⇒ (≤)) op op)
  (hf : is_min_filter f l a) {g : α → γ} (hg : is_min_filter g l a) :
  is_min_filter (λ x, op (f x) (g x)) l a :=
mem_of_superset (inter_mem hf hg) $ λ x ⟨hfx, hgx⟩, hop hfx hgx

lemma is_max_filter.bicomp_mono [preorder δ] {op : β → γ → δ} (hop : ((≤) ⇒ (≤) ⇒ (≤)) op op)
  (hf : is_max_filter f l a) {g : α → γ} (hg : is_max_filter g l a) :
  is_max_filter (λ x, op (f x) (g x)) l a :=
mem_of_superset (inter_mem hf hg) $ λ x ⟨hfx, hgx⟩, hop hfx hgx

-- No `extr` version because we need `hf` and `hg` to be of the same kind

lemma is_min_on.bicomp_mono [preorder δ] {op : β → γ → δ} (hop : ((≤) ⇒ (≤) ⇒ (≤)) op op)
  (hf : is_min_on f s a) {g : α → γ} (hg : is_min_on g s a) :
  is_min_on (λ x, op (f x) (g x)) s a :=
hf.bicomp_mono hop hg

lemma is_max_on.bicomp_mono [preorder δ] {op : β → γ → δ} (hop : ((≤) ⇒ (≤) ⇒ (≤)) op op)
  (hf : is_max_on f s a) {g : α → γ} (hg : is_max_on g s a) :
  is_max_on (λ x, op (f x) (g x)) s a :=
hf.bicomp_mono hop hg

/-! ### Composition with `tendsto` -/

lemma is_min_filter.comp_tendsto {g : δ → α} {l' : filter δ} {b : δ} (hf : is_min_filter f l (g b))
  (hg : tendsto g l' l) :
  is_min_filter (f ∘ g) l' b :=
hg hf

lemma is_max_filter.comp_tendsto {g : δ → α} {l' : filter δ} {b : δ} (hf : is_max_filter f l (g b))
  (hg : tendsto g l' l) :
  is_max_filter (f ∘ g) l' b :=
hg hf

lemma is_extr_filter.comp_tendsto {g : δ → α} {l' : filter δ} {b : δ}
  (hf : is_extr_filter f l (g b)) (hg : tendsto g l' l) :
  is_extr_filter (f ∘ g) l' b :=
hf.elim (λ hf, (hf.comp_tendsto hg).is_extr) (λ hf, (hf.comp_tendsto hg).is_extr)

lemma is_min_on.on_preimage (g : δ → α) {b : δ} (hf : is_min_on f s (g b)) :
  is_min_on (f ∘ g) (g ⁻¹' s) b :=
hf.comp_tendsto (tendsto_principal_principal.mpr $ subset.refl _)

lemma is_max_on.on_preimage (g : δ → α) {b : δ} (hf : is_max_on f s (g b)) :
  is_max_on (f ∘ g) (g ⁻¹' s) b :=
hf.comp_tendsto (tendsto_principal_principal.mpr $ subset.refl _)

lemma is_extr_on.on_preimage (g : δ → α) {b : δ} (hf : is_extr_on f s (g b)) :
  is_extr_on (f ∘ g) (g ⁻¹' s) b :=
hf.elim (λ hf, (hf.on_preimage g).is_extr) (λ hf, (hf.on_preimage g).is_extr)

end preorder

/-! ### Pointwise addition -/
section ordered_add_comm_monoid

variables [ordered_add_comm_monoid β] {f g : α → β} {a : α} {s : set α} {l : filter α}

lemma is_min_filter.add (hf : is_min_filter f l a) (hg : is_min_filter g l a) :
  is_min_filter (λ x, f x + g x) l a :=
show is_min_filter (λ x, f x + g x) l a,
from hf.bicomp_mono (λ x x' hx y y' hy, add_le_add hx hy) hg

lemma is_max_filter.add (hf : is_max_filter f l a) (hg : is_max_filter g l a) :
  is_max_filter (λ x, f x + g x) l a :=
show is_max_filter (λ x, f x + g x) l a,
from hf.bicomp_mono (λ x x' hx y y' hy, add_le_add hx hy) hg

lemma is_min_on.add (hf : is_min_on f s a) (hg : is_min_on g s a) :
  is_min_on (λ x, f x + g x) s a :=
hf.add hg

lemma is_max_on.add (hf : is_max_on f s a) (hg : is_max_on g s a) :
  is_max_on (λ x, f x + g x) s a :=
hf.add hg

end ordered_add_comm_monoid

/-! ### Pointwise negation and subtraction -/

section ordered_add_comm_group

variables [ordered_add_comm_group β] {f g : α → β} {a : α} {s : set α} {l : filter α}

lemma is_min_filter.neg (hf : is_min_filter f l a) : is_max_filter (λ x, -f x) l a :=
hf.comp_antitone (λ x y hx, neg_le_neg hx)

lemma is_max_filter.neg (hf : is_max_filter f l a) : is_min_filter (λ x, -f x) l a :=
hf.comp_antitone (λ x y hx, neg_le_neg hx)

lemma is_extr_filter.neg (hf : is_extr_filter f l a) : is_extr_filter (λ x, -f x) l a :=
hf.elim (λ hf, hf.neg.is_extr) (λ hf, hf.neg.is_extr)

lemma is_min_on.neg (hf : is_min_on f s a) : is_max_on (λ x, -f x) s a :=
hf.comp_antitone (λ x y hx, neg_le_neg hx)

lemma is_max_on.neg (hf : is_max_on f s a) : is_min_on (λ x, -f x) s a :=
hf.comp_antitone (λ x y hx, neg_le_neg hx)

lemma is_extr_on.neg (hf : is_extr_on f s a) : is_extr_on (λ x, -f x) s a :=
hf.elim (λ hf, hf.neg.is_extr) (λ hf, hf.neg.is_extr)

lemma is_min_filter.sub (hf : is_min_filter f l a) (hg : is_max_filter g l a) :
  is_min_filter (λ x, f x - g x) l a :=
by simpa only [sub_eq_add_neg] using hf.add hg.neg

lemma is_max_filter.sub (hf : is_max_filter f l a) (hg : is_min_filter g l a) :
  is_max_filter (λ x, f x - g x) l a :=
by simpa only [sub_eq_add_neg] using hf.add hg.neg

lemma is_min_on.sub (hf : is_min_on f s a) (hg : is_max_on g s a) :
  is_min_on (λ x, f x - g x) s a :=
by simpa only [sub_eq_add_neg] using hf.add hg.neg

lemma is_max_on.sub (hf : is_max_on f s a) (hg : is_min_on g s a) :
  is_max_on (λ x, f x - g x) s a :=
by simpa only [sub_eq_add_neg] using hf.add hg.neg

end ordered_add_comm_group

/-! ### Pointwise `sup`/`inf` -/

section semilattice_sup

variables [semilattice_sup β] {f g : α → β} {a : α} {s : set α} {l : filter α}

lemma is_min_filter.sup (hf : is_min_filter f l a) (hg : is_min_filter g l a) :
  is_min_filter (λ x, f x ⊔ g x) l a :=
show is_min_filter (λ x, f x ⊔ g x) l a,
from hf.bicomp_mono (λ x x' hx y y' hy, sup_le_sup hx hy) hg

lemma is_max_filter.sup (hf : is_max_filter f l a) (hg : is_max_filter g l a) :
  is_max_filter (λ x, f x ⊔ g x) l a :=
show is_max_filter (λ x, f x ⊔ g x) l a,
from hf.bicomp_mono (λ x x' hx y y' hy, sup_le_sup hx hy) hg

lemma is_min_on.sup (hf : is_min_on f s a) (hg : is_min_on g s a) :
  is_min_on (λ x, f x ⊔ g x) s a :=
hf.sup hg

lemma is_max_on.sup (hf : is_max_on f s a) (hg : is_max_on g s a) :
  is_max_on (λ x, f x ⊔ g x) s a :=
hf.sup hg

end semilattice_sup

section semilattice_inf

variables [semilattice_inf β] {f g : α → β} {a : α} {s : set α} {l : filter α}

lemma is_min_filter.inf (hf : is_min_filter f l a) (hg : is_min_filter g l a) :
  is_min_filter (λ x, f x ⊓ g x) l a :=
show is_min_filter (λ x, f x ⊓ g x) l a,
from hf.bicomp_mono (λ x x' hx y y' hy, inf_le_inf hx hy) hg

lemma is_max_filter.inf (hf : is_max_filter f l a) (hg : is_max_filter g l a) :
  is_max_filter (λ x, f x ⊓ g x) l a :=
show is_max_filter (λ x, f x ⊓ g x) l a,
from hf.bicomp_mono (λ x x' hx y y' hy, inf_le_inf hx hy) hg

lemma is_min_on.inf (hf : is_min_on f s a) (hg : is_min_on g s a) :
  is_min_on (λ x, f x ⊓ g x) s a :=
hf.inf hg

lemma is_max_on.inf (hf : is_max_on f s a) (hg : is_max_on g s a) :
  is_max_on (λ x, f x ⊓ g x) s a :=
hf.inf hg

end semilattice_inf

/-! ### Pointwise `min`/`max` -/

section linear_order

variables [linear_order β] {f g : α → β} {a : α} {s : set α} {l : filter α}

lemma is_min_filter.min (hf : is_min_filter f l a) (hg : is_min_filter g l a) :
  is_min_filter (λ x, min (f x) (g x)) l a :=
show is_min_filter (λ x, min (f x) (g x)) l a,
from hf.bicomp_mono (λ x x' hx y y' hy, min_le_min hx hy) hg

lemma is_max_filter.min (hf : is_max_filter f l a) (hg : is_max_filter g l a) :
  is_max_filter (λ x, min (f x) (g x)) l a :=
show is_max_filter (λ x, min (f x) (g x)) l a,
from hf.bicomp_mono (λ x x' hx y y' hy, min_le_min hx hy) hg

lemma is_min_on.min (hf : is_min_on f s a) (hg : is_min_on g s a) :
  is_min_on (λ x, min (f x) (g x)) s a :=
hf.min hg

lemma is_max_on.min (hf : is_max_on f s a) (hg : is_max_on g s a) :
  is_max_on (λ x, min (f x) (g x)) s a :=
hf.min hg

lemma is_min_filter.max (hf : is_min_filter f l a) (hg : is_min_filter g l a) :
  is_min_filter (λ x, max (f x) (g x)) l a :=
show is_min_filter (λ x, max (f x) (g x)) l a,
from hf.bicomp_mono (λ x x' hx y y' hy, max_le_max hx hy) hg

lemma is_max_filter.max (hf : is_max_filter f l a) (hg : is_max_filter g l a) :
  is_max_filter (λ x, max (f x) (g x)) l a :=
show is_max_filter (λ x, max (f x) (g x)) l a,
from hf.bicomp_mono (λ x x' hx y y' hy, max_le_max hx hy) hg

lemma is_min_on.max (hf : is_min_on f s a) (hg : is_min_on g s a) :
  is_min_on (λ x, max (f x) (g x)) s a :=
hf.max hg

lemma is_max_on.max (hf : is_max_on f s a) (hg : is_max_on g s a) :
  is_max_on (λ x, max (f x) (g x)) s a :=
hf.max hg

end linear_order

section eventually

/-! ### Relation with `eventually` comparisons of two functions -/

lemma filter.eventually_le.is_max_filter {α β : Type*} [preorder β] {f g : α → β} {a : α}
  {l : filter α} (hle : g ≤ᶠ[l] f) (hfga : f a = g a) (h : is_max_filter f l a) :
  is_max_filter g l a :=
begin
  refine hle.mp (h.mono $ λ x hf hgf, _),
  rw ← hfga,
  exact le_trans hgf hf
end

lemma is_max_filter.congr {α β : Type*} [preorder β] {f g : α → β} {a : α} {l : filter α}
  (h : is_max_filter f l a) (heq : f =ᶠ[l] g) (hfga : f a = g a) :
  is_max_filter g l a :=
heq.symm.le.is_max_filter hfga h

lemma filter.eventually_eq.is_max_filter_iff {α β : Type*} [preorder β] {f g : α → β} {a : α}
  {l : filter α} (heq : f =ᶠ[l] g) (hfga : f a = g a) :
  is_max_filter f l a ↔ is_max_filter g l a :=
⟨λ h, h.congr heq hfga, λ h, h.congr heq.symm hfga.symm⟩

lemma filter.eventually_le.is_min_filter {α β : Type*} [preorder β] {f g : α → β} {a : α}
  {l : filter α} (hle : f ≤ᶠ[l] g) (hfga : f a = g a) (h : is_min_filter f l a) :
  is_min_filter g l a :=
@filter.eventually_le.is_max_filter _ (order_dual β) _ _ _ _ _ hle hfga h

lemma is_min_filter.congr {α β : Type*} [preorder β] {f g : α → β} {a : α} {l : filter α}
  (h : is_min_filter f l a) (heq : f =ᶠ[l] g) (hfga : f a = g a) :
  is_min_filter g l a :=
heq.le.is_min_filter hfga h

lemma filter.eventually_eq.is_min_filter_iff {α β : Type*} [preorder β] {f g : α → β} {a : α}
  {l : filter α} (heq : f =ᶠ[l] g) (hfga : f a = g a) :
  is_min_filter f l a ↔ is_min_filter g l a :=
⟨λ h, h.congr heq hfga, λ h, h.congr heq.symm hfga.symm⟩

lemma is_extr_filter.congr {α β : Type*} [preorder β] {f g : α → β} {a : α} {l : filter α}
  (h : is_extr_filter f l a) (heq : f =ᶠ[l] g) (hfga : f a = g a) :
  is_extr_filter g l a :=
begin
  rw is_extr_filter at *,
  rwa [← heq.is_max_filter_iff hfga, ← heq.is_min_filter_iff hfga],
end

lemma filter.eventually_eq.is_extr_filter_iff {α β : Type*} [preorder β] {f g : α → β} {a : α}
  {l : filter α} (heq : f =ᶠ[l] g) (hfga : f a = g a) :
  is_extr_filter f l a ↔ is_extr_filter g l a :=
⟨λ h, h.congr heq hfga, λ h, h.congr heq.symm hfga.symm⟩

end eventually

/-! ### `is_max_on`/`is_min_on` imply `csupr`/`cinfi` -/

section conditionally_complete_linear_order
variables [conditionally_complete_linear_order α] {f : β → α} {s : set β} {x₀ : β}

lemma is_max_on.supr_eq (hx₀ : x₀ ∈ s) (h : is_max_on f s x₀) :
  (⨆ x : s, f x) = f x₀ :=
begin
  haveI : nonempty s := ⟨⟨x₀, hx₀⟩⟩,
  exact csupr_eq_of_forall_le_of_forall_lt_exists_gt (λ x, h x.prop) (λ w hw, ⟨⟨x₀, hx₀⟩, hw⟩),
end

lemma is_min_on.infi_eq (hx₀ : x₀ ∈ s) (h : is_min_on f s x₀) :
  (⨅ x : s, f x) = f x₀ :=
@is_max_on.supr_eq (order_dual α) β _ _ _ _ hx₀ h

end conditionally_complete_linear_order


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

/-!
# Cartan subalgebras

Cartan subalgebras are one of the most important concepts in Lie theory. We define them here.
The standard example is the set of diagonal matrices in the Lie algebra of matrices.

## Main definitions

  * `lie_subalgebra.normalizer`
  * `lie_subalgebra.le_normalizer_of_ideal`
  * `lie_subalgebra.is_cartan_subalgebra`

## Tags

lie subalgebra, normalizer, idealizer, cartan subalgebra
-/

universes u v w w₁ w₂

variables {R : Type u} {L : Type v}
variables [comm_ring R] [lie_ring L] [lie_algebra R L] (H : lie_subalgebra R L)

namespace lie_subalgebra

/-- The normalizer of a Lie subalgebra `H` is the set of elements of the Lie algebra whose bracket
with any element of `H` lies in `H`. It is the Lie algebra equivalent of the group-theoretic
normalizer (see `subgroup.normalizer`) and is an idealizer in the sense of abstract algebra. -/
def normalizer : lie_subalgebra R L :=
{ carrier   := { x : L | ∀ (y : L), (y ∈ H) → ⁅x, y⁆ ∈ H },
  zero_mem' := λ y hy, by { rw zero_lie y, exact H.zero_mem, },
  add_mem'  := λ z₁ z₂ h₁ h₂ y hy, by { rw add_lie, exact H.add_mem (h₁ y hy) (h₂ y hy), },
  smul_mem' := λ t y hy z hz, by { rw smul_lie, exact H.smul_mem t (hy z hz), },
  lie_mem'  := λ z₁ z₂ h₁ h₂ y hy, by
    { rw lie_lie, exact H.sub_mem (h₁ _ (h₂ y hy)) (h₂ _ (h₁ y hy)), }, }

lemma mem_normalizer_iff (x : L) : x ∈ H.normalizer ↔ ∀ (y : L), (y ∈ H) → ⁅x, y⁆ ∈ H := iff.rfl

lemma le_normalizer : H ≤ H.normalizer :=
λ x hx, show ∀ (y : L), y ∈ H → ⁅x,y⁆ ∈ H, from λ y, H.lie_mem hx

/-- A Lie subalgebra is an ideal of its normalizer. -/
lemma ideal_in_normalizer : ∀ (x y : L), x ∈ H.normalizer → y ∈ H → ⁅x,y⁆ ∈ H :=
λ x y h, h y

/-- The normalizer of a Lie subalgebra `H` is the maximal Lie subalgebra in which `H` is a Lie
ideal. -/
lemma le_normalizer_of_ideal {N : lie_subalgebra R L}
  (h : ∀ (x y : L), x ∈ N → y ∈ H → ⁅x,y⁆ ∈ H) : N ≤ H.normalizer :=
λ x hx y, h x y hx

/-- A Cartan subalgebra is a nilpotent, self-normalizing subalgebra. -/
class is_cartan_subalgebra : Prop :=
(nilpotent        : lie_algebra.is_nilpotent R H)
(self_normalizing : H.normalizer = H)

end lie_subalgebra

@[simp] lemma lie_ideal.normalizer_eq_top {R : Type u} {L : Type v}
  [comm_ring R] [lie_ring L] [lie_algebra R L] (I : lie_ideal R L) :
  (I : lie_subalgebra R L).normalizer = ⊤ :=
begin
  ext x,
  simpa only [lie_subalgebra.mem_normalizer_iff, lie_subalgebra.mem_top, iff_true]
    using λ y hy, I.lie_mem hy
end

open lie_ideal

/-- A nilpotent Lie algebra is its own Cartan subalgebra. -/
instance lie_algebra.top_is_cartan_subalgebra_of_nilpotent [lie_algebra.is_nilpotent R L] :
  lie_subalgebra.is_cartan_subalgebra (⊤ : lie_subalgebra R L) :=
{ nilpotent        := infer_instance,
  self_normalizing :=
    by { rw [← top_coe_lie_subalgebra, normalizer_eq_top, top_coe_lie_subalgebra], }, }


/-
Copyright (c) 2017 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Buzzard, Mario Carneiro
-/
import data.real.sqrt

/-!
# The complex numbers

The complex numbers are modelled as ℝ^2 in the obvious way and it is shown that they form a field
of characteristic zero. The result that the complex numbers are algebraically closed, see
`field_theory.algebraic_closure`.
-/

open_locale big_operators

/-! ### Definition and basic arithmmetic -/

/-- Complex numbers consist of two `real`s: a real part `re` and an imaginary part `im`. -/
structure complex : Type :=
(re : ℝ) (im : ℝ)

notation `ℂ` := complex

namespace complex

open_locale complex_conjugate

noncomputable instance : decidable_eq ℂ := classical.dec_eq _

/-- The equivalence between the complex numbers and `ℝ × ℝ`. -/
@[simps] def equiv_real_prod : ℂ ≃ (ℝ × ℝ) :=
{ to_fun := λ z, ⟨z.re, z.im⟩,
  inv_fun := λ p, ⟨p.1, p.2⟩,
  left_inv := λ ⟨x, y⟩, rfl,
  right_inv := λ ⟨x, y⟩, rfl }

@[simp] theorem eta : ∀ z : ℂ, complex.mk z.re z.im = z
| ⟨a, b⟩ := rfl

@[ext]
theorem ext : ∀ {z w : ℂ}, z.re = w.re → z.im = w.im → z = w
| ⟨zr, zi⟩ ⟨_, _⟩ rfl rfl := rfl

theorem ext_iff {z w : ℂ} : z = w ↔ z.re = w.re ∧ z.im = w.im :=
⟨λ H, by simp [H], and.rec ext⟩

instance : has_coe ℝ ℂ := ⟨λ r, ⟨r, 0⟩⟩

@[simp, norm_cast] lemma of_real_re (r : ℝ) : (r : ℂ).re = r := rfl
@[simp, norm_cast] lemma of_real_im (r : ℝ) : (r : ℂ).im = 0 := rfl
lemma of_real_def (r : ℝ) : (r : ℂ) = ⟨r, 0⟩ := rfl

@[simp, norm_cast] theorem of_real_inj {z w : ℝ} : (z : ℂ) = w ↔ z = w :=
⟨congr_arg re, congr_arg _⟩

theorem of_real_injective : function.injective (coe : ℝ → ℂ) :=
λ z w, congr_arg re

instance : can_lift ℂ ℝ :=
{ cond := λ z, z.im = 0,
  coe := coe,
  prf := λ z hz, ⟨z.re, ext rfl hz.symm⟩ }

instance : has_zero ℂ := ⟨(0 : ℝ)⟩
instance : inhabited ℂ := ⟨0⟩

@[simp] lemma zero_re : (0 : ℂ).re = 0 := rfl
@[simp] lemma zero_im : (0 : ℂ).im = 0 := rfl
@[simp, norm_cast] lemma of_real_zero : ((0 : ℝ) : ℂ) = 0 := rfl

@[simp] theorem of_real_eq_zero {z : ℝ} : (z : ℂ) = 0 ↔ z = 0 := of_real_inj
theorem of_real_ne_zero {z : ℝ} : (z : ℂ) ≠ 0 ↔ z ≠ 0 := not_congr of_real_eq_zero

instance : has_one ℂ := ⟨(1 : ℝ)⟩

@[simp] lemma one_re : (1 : ℂ).re = 1 := rfl
@[simp] lemma one_im : (1 : ℂ).im = 0 := rfl
@[simp, norm_cast] lemma of_real_one : ((1 : ℝ) : ℂ) = 1 := rfl

@[simp] theorem of_real_eq_one {z : ℝ} : (z : ℂ) = 1 ↔ z = 1 := of_real_inj
theorem of_real_ne_one {z : ℝ} : (z : ℂ) ≠ 1 ↔ z ≠ 1 := not_congr of_real_eq_one

instance : has_add ℂ := ⟨λ z w, ⟨z.re + w.re, z.im + w.im⟩⟩

@[simp] lemma add_re (z w : ℂ) : (z + w).re = z.re + w.re := rfl
@[simp] lemma add_im (z w : ℂ) : (z + w).im = z.im + w.im := rfl

@[simp] lemma bit0_re (z : ℂ) : (bit0 z).re = bit0 z.re := rfl
@[simp] lemma bit1_re (z : ℂ) : (bit1 z).re = bit1 z.re := rfl
@[simp] lemma bit0_im (z : ℂ) : (bit0 z).im = bit0 z.im := eq.refl _
@[simp] lemma bit1_im (z : ℂ) : (bit1 z).im = bit0 z.im := add_zero _

@[simp, norm_cast] lemma of_real_add (r s : ℝ) : ((r + s : ℝ) : ℂ) = r + s :=
ext_iff.2 $ by simp

@[simp, norm_cast] lemma of_real_bit0 (r : ℝ) : ((bit0 r : ℝ) : ℂ) = bit0 r :=
ext_iff.2 $ by simp [bit0]

@[simp, norm_cast] lemma of_real_bit1 (r : ℝ) : ((bit1 r : ℝ) : ℂ) = bit1 r :=
ext_iff.2 $ by simp [bit1]

instance : has_neg ℂ := ⟨λ z, ⟨-z.re, -z.im⟩⟩

@[simp] lemma neg_re (z : ℂ) : (-z).re = -z.re := rfl
@[simp] lemma neg_im (z : ℂ) : (-z).im = -z.im := rfl
@[simp, norm_cast] lemma of_real_neg (r : ℝ) : ((-r : ℝ) : ℂ) = -r := ext_iff.2 $ by simp

instance : has_sub ℂ := ⟨λ z w, ⟨z.re - w.re, z.im - w.im⟩⟩

instance : has_mul ℂ := ⟨λ z w, ⟨z.re * w.re - z.im * w.im, z.re * w.im + z.im * w.re⟩⟩

@[simp] lemma mul_re (z w : ℂ) : (z * w).re = z.re * w.re - z.im * w.im := rfl
@[simp] lemma mul_im (z w : ℂ) : (z * w).im = z.re * w.im + z.im * w.re := rfl
@[simp, norm_cast] lemma of_real_mul (r s : ℝ) : ((r * s : ℝ) : ℂ) = r * s := ext_iff.2 $ by simp

lemma of_real_mul_re (r : ℝ) (z : ℂ) : (↑r * z).re = r * z.re := by simp
lemma of_real_mul_im (r : ℝ) (z : ℂ) : (↑r * z).im = r * z.im := by simp
lemma of_real_mul' (r : ℝ) (z : ℂ) : (↑r * z) = ⟨r * z.re, r * z.im⟩ :=
ext (of_real_mul_re _ _) (of_real_mul_im _ _)

/-! ### The imaginary unit, `I` -/

/-- The imaginary unit. -/
def I : ℂ := ⟨0, 1⟩

@[simp] lemma I_re : I.re = 0 := rfl
@[simp] lemma I_im : I.im = 1 := rfl

@[simp] lemma I_mul_I : I * I = -1 := ext_iff.2 $ by simp
lemma I_mul (z : ℂ) : I * z = ⟨-z.im, z.re⟩ :=
ext_iff.2 $ by simp

lemma I_ne_zero : (I : ℂ) ≠ 0 := mt (congr_arg im) zero_ne_one.symm

lemma mk_eq_add_mul_I (a b : ℝ) : complex.mk a b = a + b * I :=
ext_iff.2 $ by simp

@[simp] lemma re_add_im (z : ℂ) : (z.re : ℂ) + z.im * I = z :=
ext_iff.2 $ by simp

/-! ### Commutative ring instance and lemmas -/

/- We use a nonstandard formula for the `ℕ` and `ℤ` actions to make sure there is no
diamond from the other actions they inherit through the `ℝ`-action on `ℂ` and action transitivity
defined in `data.complex.module.lean`. -/
instance : comm_ring ℂ :=
by refine_struct
  { zero := (0 : ℂ),
    add := (+),
    neg := has_neg.neg,
    sub := has_sub.sub,
    one := 1,
    mul := (*),
    zero_add := λ z, by { apply ext_iff.2, simp },
    add_zero := λ z, by { apply ext_iff.2, simp },
    nsmul := λ n z, ⟨n • z.re - 0 * z.im, n • z.im + 0 * z.re⟩,
    npow := @npow_rec _ ⟨(1 : ℂ)⟩ ⟨(*)⟩,
    zsmul := λ n z, ⟨n • z.re - 0 * z.im, n • z.im + 0 * z.re⟩ };
intros; try { refl }; apply ext_iff.2; split; simp; {ring1 <|> ring_nf}

/-- This shortcut instance ensures we do not find `ring` via the noncomputable `complex.field`
instance. -/
instance : ring ℂ := by apply_instance

/-- The "real part" map, considered as an additive group homomorphism. -/
def re_add_group_hom : ℂ →+ ℝ :=
{ to_fun := re,
  map_zero' := zero_re,
  map_add' := add_re }

@[simp] lemma coe_re_add_group_hom : (re_add_group_hom : ℂ → ℝ) = re := rfl

/-- The "imaginary part" map, considered as an additive group homomorphism. -/
def im_add_group_hom : ℂ →+ ℝ :=
{ to_fun := im,
  map_zero' := zero_im,
  map_add' := add_im }

@[simp] lemma coe_im_add_group_hom : (im_add_group_hom : ℂ → ℝ) = im := rfl

@[simp] lemma I_pow_bit0 (n : ℕ) : I ^ (bit0 n) = (-1) ^ n :=
by rw [pow_bit0', I_mul_I]

@[simp] lemma I_pow_bit1 (n : ℕ) : I ^ (bit1 n) = (-1) ^ n * I :=
by rw [pow_bit1', I_mul_I]

/-! ### Complex conjugation -/

/-- This defines the complex conjugate as the `star` operation of the `star_ring ℂ`. It
is recommended to use the ring endomorphism version `star_ring_end`, available under the
notation `conj` in the locale `complex_conjugate`. -/
instance : star_ring ℂ :=
{ star := λ z, ⟨z.re, -z.im⟩,
  star_involutive := λ x, by simp only [eta, neg_neg],
  star_mul := λ a b, by ext; simp [add_comm]; ring,
  star_add := λ a b, by ext; simp [add_comm] }

@[simp] lemma conj_re (z : ℂ) : (conj z).re = z.re := rfl
@[simp] lemma conj_im (z : ℂ) : (conj z).im = -z.im := rfl

lemma conj_of_real (r : ℝ) : conj (r : ℂ) = r := ext_iff.2 $ by simp [conj]

@[simp] lemma conj_I : conj I = -I := ext_iff.2 $ by simp

lemma conj_bit0 (z : ℂ) : conj (bit0 z) = bit0 (conj z) := ext_iff.2 $ by simp [bit0]
lemma conj_bit1 (z : ℂ) : conj (bit1 z) = bit1 (conj z) := ext_iff.2 $ by simp [bit0]

@[simp] lemma conj_neg_I : conj (-I) = I := ext_iff.2 $ by simp

lemma eq_conj_iff_real {z : ℂ} : conj z = z ↔ ∃ r : ℝ, z = r :=
⟨λ h, ⟨z.re, ext rfl $ eq_zero_of_neg_eq (congr_arg im h)⟩,
 λ ⟨h, e⟩, by rw [e, conj_of_real]⟩

lemma eq_conj_iff_re {z : ℂ} : conj z = z ↔ (z.re : ℂ) = z :=
eq_conj_iff_real.trans ⟨by rintro ⟨r, rfl⟩; simp, λ h, ⟨_, h.symm⟩⟩

lemma eq_conj_iff_im {z : ℂ} : conj z = z ↔ z.im = 0 :=
⟨λ h, add_self_eq_zero.mp (neg_eq_iff_add_eq_zero.mp (congr_arg im h)),
  λ h, ext rfl (neg_eq_iff_add_eq_zero.mpr (add_self_eq_zero.mpr h))⟩

@[simp] lemma star_def : (has_star.star : ℂ → ℂ) = conj := rfl

/-! ### Norm squared -/

/-- The norm squared function. -/
@[pp_nodot] def norm_sq : ℂ →*₀ ℝ :=
{ to_fun := λ z, z.re * z.re + z.im * z.im,
  map_zero' := by simp,
  map_one' := by simp,
  map_mul' := λ z w, by { dsimp, ring } }

lemma norm_sq_apply (z : ℂ) : norm_sq z = z.re * z.re + z.im * z.im := rfl

@[simp] lemma norm_sq_of_real (r : ℝ) : norm_sq r = r * r :=
by simp [norm_sq]

@[simp] lemma norm_sq_mk (x y : ℝ) : norm_sq ⟨x, y⟩ = x * x + y * y := rfl

lemma norm_sq_add_mul_I (x y : ℝ) : norm_sq (x + y * I) = x ^ 2 + y ^ 2 :=
by rw [← mk_eq_add_mul_I, norm_sq_mk, sq, sq]

lemma norm_sq_eq_conj_mul_self {z : ℂ} : (norm_sq z : ℂ) = conj z * z :=
by { ext; simp [norm_sq, mul_comm], }

@[simp] lemma norm_sq_zero : norm_sq 0 = 0 := norm_sq.map_zero
@[simp] lemma norm_sq_one : norm_sq 1 = 1 := norm_sq.map_one
@[simp] lemma norm_sq_I : norm_sq I = 1 := by simp [norm_sq]

lemma norm_sq_nonneg (z : ℂ) : 0 ≤ norm_sq z :=
add_nonneg (mul_self_nonneg _) (mul_self_nonneg _)

lemma norm_sq_eq_zero {z : ℂ} : norm_sq z = 0 ↔ z = 0 :=
⟨λ h, ext
  (eq_zero_of_mul_self_add_mul_self_eq_zero h)
  (eq_zero_of_mul_self_add_mul_self_eq_zero $ (add_comm _ _).trans h),
 λ h, h.symm ▸ norm_sq_zero⟩

@[simp] lemma norm_sq_pos {z : ℂ} : 0 < norm_sq z ↔ z ≠ 0 :=
(norm_sq_nonneg z).lt_iff_ne.trans $ not_congr (eq_comm.trans norm_sq_eq_zero)

@[simp] lemma norm_sq_neg (z : ℂ) : norm_sq (-z) = norm_sq z :=
by simp [norm_sq]

@[simp] lemma norm_sq_conj (z : ℂ) : norm_sq (conj z) = norm_sq z :=
by simp [norm_sq]

lemma norm_sq_mul (z w : ℂ) : norm_sq (z * w) = norm_sq z * norm_sq w :=
norm_sq.map_mul z w

lemma norm_sq_add (z w : ℂ) : norm_sq (z + w) =
  norm_sq z + norm_sq w + 2 * (z * conj w).re :=
by dsimp [norm_sq]; ring

lemma re_sq_le_norm_sq (z : ℂ) : z.re * z.re ≤ norm_sq z :=
le_add_of_nonneg_right (mul_self_nonneg _)

lemma im_sq_le_norm_sq (z : ℂ) : z.im * z.im ≤ norm_sq z :=
le_add_of_nonneg_left (mul_self_nonneg _)

theorem mul_conj (z : ℂ) : z * conj z = norm_sq z :=
ext_iff.2 $ by simp [norm_sq, mul_comm, sub_eq_neg_add, add_comm]

theorem add_conj (z : ℂ) : z + conj z = (2 * z.re : ℝ) :=
ext_iff.2 $ by simp [two_mul]

/-- The coercion `ℝ → ℂ` as a `ring_hom`. -/
def of_real : ℝ →+* ℂ := ⟨coe, of_real_one, of_real_mul, of_real_zero, of_real_add⟩

@[simp] lemma of_real_eq_coe (r : ℝ) : of_real r = r := rfl

@[simp] lemma I_sq : I ^ 2 = -1 := by rw [sq, I_mul_I]

@[simp] lemma sub_re (z w : ℂ) : (z - w).re = z.re - w.re := rfl
@[simp] lemma sub_im (z w : ℂ) : (z - w).im = z.im - w.im := rfl
@[simp, norm_cast] lemma of_real_sub (r s : ℝ) : ((r - s : ℝ) : ℂ) = r - s := ext_iff.2 $ by simp
@[simp, norm_cast] lemma of_real_pow (r : ℝ) (n : ℕ) : ((r ^ n : ℝ) : ℂ) = r ^ n :=
by induction n; simp [*, of_real_mul, pow_succ]

theorem sub_conj (z : ℂ) : z - conj z = (2 * z.im : ℝ) * I :=
ext_iff.2 $ by simp [two_mul, sub_eq_add_neg]

lemma norm_sq_sub (z w : ℂ) : norm_sq (z - w) =
  norm_sq z + norm_sq w - 2 * (z * conj w).re :=
by { rw [sub_eq_add_neg, norm_sq_add],
     simp only [ring_hom.map_neg, mul_neg_eq_neg_mul_symm, neg_re,
                tactic.ring.add_neg_eq_sub, norm_sq_neg] }

/-! ### Inversion -/

noncomputable instance : has_inv ℂ := ⟨λ z, conj z * ((norm_sq z)⁻¹:ℝ)⟩

theorem inv_def (z : ℂ) : z⁻¹ = conj z * ((norm_sq z)⁻¹:ℝ) := rfl
@[simp] lemma inv_re (z : ℂ) : (z⁻¹).re = z.re / norm_sq z := by simp [inv_def, division_def]
@[simp] lemma inv_im (z : ℂ) : (z⁻¹).im = -z.im / norm_sq z := by simp [inv_def, division_def]

@[simp, norm_cast] lemma of_real_inv (r : ℝ) : ((r⁻¹ : ℝ) : ℂ) = r⁻¹ :=
ext_iff.2 $ by simp

protected

protected theorem mul_inv_cancel {z : ℂ} (h : z ≠ 0) : z * z⁻¹ = 1 :=
by rw [inv_def, ← mul_assoc, mul_conj, ← of_real_mul,
  mul_inv_cancel (mt norm_sq_eq_zero.1 h), of_real_one]

/-! ### Field instance and lemmas -/

noncomputable instance : field ℂ :=
{ inv := has_inv.inv,
  exists_pair_ne := ⟨0, 1, mt (congr_arg re) zero_ne_one⟩,
  mul_inv_cancel := @complex.mul_inv_cancel,
  inv_zero := complex.inv_zero,
  ..complex.comm_ring }

@[simp] lemma I_zpow_bit0 (n : ℤ) : I ^ (bit0 n) = (-1) ^ n :=
by rw [zpow_bit0', I_mul_I]

@[simp] lemma I_zpow_bit1 (n : ℤ) : I ^ (bit1 n) = (-1) ^ n * I :=
by rw [zpow_bit1', I_mul_I]

lemma div_re (z w : ℂ) : (z / w).re = z.re * w.re / norm_sq w + z.im * w.im / norm_sq w :=
by simp [div_eq_mul_inv, mul_assoc, sub_eq_add_neg]
lemma div_im (z w : ℂ) : (z / w).im = z.im * w.re / norm_sq w - z.re * w.im / norm_sq w :=
by simp [div_eq_mul_inv, mul_assoc, sub_eq_add_neg, add_comm]

@[simp, norm_cast] lemma of_real_div (r s : ℝ) : ((r / s : ℝ) : ℂ) = r / s :=
of_real.map_div r s

@[simp, norm_cast] lemma of_real_zpow (r : ℝ) (n : ℤ) : ((r ^ n : ℝ) : ℂ) = (r : ℂ) ^ n :=
of_real.map_zpow r n

@[simp] lemma div_I (z : ℂ) : z / I = -(z * I) :=
(div_eq_iff_mul_eq I_ne_zero).2 $ by simp [mul_assoc]

@[simp] lemma inv_I : I⁻¹ = -I :=
by simp [inv_eq_one_div]

@[simp] lemma norm_sq_inv (z : ℂ) : norm_sq z⁻¹ = (norm_sq z)⁻¹ :=
norm_sq.map_inv z

@[simp] lemma norm_sq_div (z w : ℂ) : norm_sq (z / w) = norm_sq z / norm_sq w :=
norm_sq.map_div z w

/-! ### Cast lemmas -/

@[simp, norm_cast] theorem of_real_nat_cast (n : ℕ) : ((n : ℝ) : ℂ) = n :=
map_nat_cast of_real n

@[simp, norm_cast] lemma nat_cast_re (n : ℕ) : (n : ℂ).re = n :=
by rw [← of_real_nat_cast, of_real_re]

@[simp, norm_cast] lemma nat_cast_im (n : ℕ) : (n : ℂ).im = 0 :=
by rw [← of_real_nat_cast, of_real_im]

@[simp, norm_cast] theorem of_real_int_cast (n : ℤ) : ((n : ℝ) : ℂ) = n :=
of_real.map_int_cast n

@[simp, norm_cast] lemma int_cast_re (n : ℤ) : (n : ℂ).re = n :=
by rw [← of_real_int_cast, of_real_re]

@[simp, norm_cast] lemma int_cast_im (n : ℤ) : (n : ℂ).im = 0 :=
by rw [← of_real_int_cast, of_real_im]

@[simp, norm_cast] theorem of_real_rat_cast (n : ℚ) : ((n : ℝ) : ℂ) = n :=
of_real.map_rat_cast n

@[simp, norm_cast] lemma rat_cast_re (q : ℚ) : (q : ℂ).re = q :=
by rw [← of_real_rat_cast, of_real_re]

@[simp, norm_cast] lemma rat_cast_im (q : ℚ) : (q : ℂ).im = 0 :=
by rw [← of_real_rat_cast, of_real_im]

/-! ### Characteristic zero -/

instance char_zero_complex : char_zero ℂ :=
char_zero_of_inj_zero $ λ n h,
by rwa [← of_real_nat_cast, of_real_eq_zero, nat.cast_eq_zero] at h

/-- A complex number `z` plus its conjugate `conj z` is `2` times its real part. -/
theorem re_eq_add_conj (z : ℂ) : (z.re : ℂ) = (z + conj z) / 2 :=
by simp only [add_conj, of_real_mul, of_real_one, of_real_bit0,
     mul_div_cancel_left (z.re:ℂ) two_ne_zero']

/-- A complex number `z` minus its conjugate `conj z` is `2i` times its imaginary part. -/
theorem im_eq_sub_conj (z : ℂ) : (z.im : ℂ) = (z - conj(z))/(2 * I) :=
by simp only [sub_conj, of_real_mul, of_real_one, of_real_bit0, mul_right_comm,
     mul_div_cancel_left _ (mul_ne_zero two_ne_zero' I_ne_zero : 2 * I ≠ 0)]

/-! ### Absolute value -/

/-- The complex absolute value function, defined as the square root of the norm squared. -/
@[pp_nodot] noncomputable def abs (z : ℂ) : ℝ := (norm_sq z).sqrt

local notation `abs'` := has_abs.abs

@[simp, norm_cast] lemma abs_of_real (r : ℝ) : abs r = |r| :=
by simp [abs, norm_sq_of_real, real.sqrt_mul_self_eq_abs]

lemma abs_of_nonneg {r : ℝ} (h : 0 ≤ r) : abs r = r :=
(abs_of_real _).trans (abs_of_nonneg h)

lemma abs_of_nat (n : ℕ) : complex.abs n = n :=
calc complex.abs n = complex.abs (n:ℝ) : by rw [of_real_nat_cast]
  ... = _ : abs_of_nonneg (nat.cast_nonneg n)

lemma mul_self_abs (z : ℂ) : abs z * abs z = norm_sq z :=
real.mul_self_sqrt (norm_sq_nonneg _)

lemma sq_abs (z : ℂ) : abs z ^ 2 = norm_sq z :=
real.sq_sqrt (norm_sq_nonneg _)

@[simp] lemma sq_abs_sub_sq_re (z : ℂ) : abs z ^ 2 - z.re ^ 2 = z.im ^ 2 :=
by rw [sq_abs, norm_sq_apply, ← sq, ← sq, add_sub_cancel']

@[simp] lemma sq_abs_sub_sq_im (z : ℂ) : abs z ^ 2 - z.im ^ 2 = z.re ^ 2 :=
by rw [← sq_abs_sub_sq_re, sub_sub_cancel]

@[simp] lemma abs_zero : abs 0 = 0 := by simp [abs]
@[simp] lemma abs_one : abs 1 = 1 := by simp [abs]
@[simp] lemma abs_I : abs I = 1 := by simp [abs]

@[simp] lemma abs_two : abs 2 = 2 :=
calc abs 2 = abs (2 : ℝ) : by rw [of_real_bit0, of_real_one]
... = (2 : ℝ) : abs_of_nonneg (by norm_num)

lemma abs_nonneg (z : ℂ) : 0 ≤ abs z :=
real.sqrt_nonneg _

@[simp] lemma abs_eq_zero {z : ℂ} : abs z = 0 ↔ z = 0 :=
(real.sqrt_eq_zero $ norm_sq_nonneg _).trans norm_sq_eq_zero

lemma abs_ne_zero {z : ℂ} : abs z ≠ 0 ↔ z ≠ 0 :=
not_congr abs_eq_zero

@[simp] lemma abs_conj (z : ℂ) : abs (conj z) = abs z :=
by simp [abs]

@[simp] lemma abs_mul (z w : ℂ) : abs (z * w) = abs z * abs w :=
by rw [abs, norm_sq_mul, real.sqrt_mul (norm_sq_nonneg _)]; refl

@[simp] lemma abs_pow (z : ℂ) (n : ℕ) : abs (z ^ n) = abs z ^ n :=
monoid_hom.map_pow ⟨abs, abs_one, abs_mul⟩ z n

@[simp] lemma abs_zpow (z : ℂ) (n : ℤ) : abs (z ^ n) = abs z ^ n :=
monoid_with_zero_hom.map_zpow ⟨abs, abs_zero, abs_one, abs_mul⟩ z n

lemma abs_re_le_abs (z : ℂ) : |z.re| ≤ abs z :=
by rw [mul_self_le_mul_self_iff (_root_.abs_nonneg z.re) (abs_nonneg _),
       abs_mul_abs_self, mul_self_abs];
   apply re_sq_le_norm_sq

lemma abs_im_le_abs (z : ℂ) : |z.im| ≤ abs z :=
by rw [mul_self_le_mul_self_iff (_root_.abs_nonneg z.im) (abs_nonneg _),
       abs_mul_abs_self, mul_self_abs];
   apply im_sq_le_norm_sq

lemma re_le_abs (z : ℂ) : z.re ≤ abs z :=
(abs_le.1 (abs_re_le_abs _)).2

lemma im_le_abs (z : ℂ) : z.im ≤ abs z :=
(abs_le.1 (abs_im_le_abs _)).2

/--
The **triangle inequality** for complex numbers.
-/
lemma abs_add (z w : ℂ) : abs (z + w) ≤ abs z + abs w :=
(mul_self_le_mul_self_iff (abs_nonneg _)
  (add_nonneg (abs_nonneg _) (abs_nonneg _))).2 $
begin
  rw [mul_self_abs, add_mul_self_eq, mul_self_abs, mul_self_abs,
      add_right_comm, norm_sq_add, add_le_add_iff_left,
      mul_assoc, mul_le_mul_left (@zero_lt_two ℝ _ _)],
  simpa [-mul_re] using re_le_abs (z * conj w)
end

instance : is_absolute_value abs :=
{ abv_nonneg  := abs_nonneg,
  abv_eq_zero := λ _, abs_eq_zero,
  abv_add     := abs_add,
  abv_mul     := abs_mul }
open is_absolute_value

@[simp] lemma abs_abs (z : ℂ) : |(abs z)| = abs z :=
_root_.abs_of_nonneg (abs_nonneg _)

@[simp] lemma abs_pos {z : ℂ} : 0 < abs z ↔ z ≠ 0 := abv_pos abs
@[simp] lemma abs_neg : ∀ z, abs (-z) = abs z := abv_neg abs
lemma abs_sub_comm : ∀ z w, abs (z - w) = abs (w - z) := abv_sub abs
lemma abs_sub_le : ∀ a b c, abs (a - c) ≤ abs (a - b) + abs (b - c) := abv_sub_le abs
@[simp] theorem abs_inv : ∀ z, abs z⁻¹ = (abs z)⁻¹ := abv_inv abs
@[simp] theorem abs_div : ∀ z w, abs (z / w) = abs z / abs w := abv_div abs

lemma abs_abs_sub_le_abs_sub : ∀ z w, |abs z - abs w| ≤ abs (z - w) :=
abs_abv_sub_le_abv_sub abs

lemma abs_le_abs_re_add_abs_im (z : ℂ) : abs z ≤ |z.re| + |z.im| :=
by simpa [re_add_im] using abs_add z.re (z.im * I)

lemma abs_re_div_abs_le_one (z : ℂ) : |z.re / z.abs| ≤ 1 :=
if hz : z = 0 then by simp [hz, zero_le_one]
else by { simp_rw [_root_.abs_div, abs_abs, div_le_iff (abs_pos.2 hz), one_mul, abs_re_le_abs] }

lemma abs_im_div_abs_le_one (z : ℂ) : |z.im / z.abs| ≤ 1 :=
if hz : z = 0 then by simp [hz, zero_le_one]
else by { simp_rw [_root_.abs_div, abs_abs, div_le_iff (abs_pos.2 hz), one_mul, abs_im_le_abs] }

@[simp, norm_cast] lemma abs_cast_nat (n : ℕ) : abs (n : ℂ) = n :=
by rw [← of_real_nat_cast, abs_of_nonneg (nat.cast_nonneg n)]

@[simp, norm_cast] lemma int_cast_abs (n : ℤ) : ↑|n| = abs n :=
by rw [← of_real_int_cast, abs_of_real, int.cast_abs]

lemma norm_sq_eq_abs (x : ℂ) : norm_sq x = abs x ^ 2 :=
by rw [abs, sq, real.mul_self_sqrt (norm_sq_nonneg _)]

/--
We put a partial order on ℂ so that `z ≤ w` exactly if `w - z` is real and nonnegative.
Complex numbers with different imaginary parts are incomparable.
-/
protected def partial_order : partial_order ℂ :=
{ le := λ z w, z.re ≤ w.re ∧ z.im = w.im,
  lt := λ z w, z.re < w.re ∧ z.im = w.im,
  lt_iff_le_not_le := λ z w, by { dsimp, rw lt_iff_le_not_le, tauto },
  le_refl := λ x, ⟨le_rfl, rfl⟩,
  le_trans := λ x y z h₁ h₂, ⟨h₁.1.trans h₂.1, h₁.2.trans h₂.2⟩,
  le_antisymm := λ z w h₁ h₂, ext (h₁.1.antisymm h₂.1) h₁.2 }

section complex_order

localized "attribute [instance] complex.partial_order" in complex_order

lemma le_def {z w : ℂ} : z ≤ w ↔ z.re ≤ w.re ∧ z.im = w.im := iff.rfl
lemma lt_def {z w : ℂ} : z < w ↔ z.re < w.re ∧ z.im = w.im := iff.rfl

@[simp, norm_cast] lemma real_le_real {x y : ℝ} : (x : ℂ) ≤ (y : ℂ) ↔ x ≤ y := by simp [le_def]

@[simp, norm_cast] lemma real_lt_real {x y : ℝ} : (x : ℂ) < (y : ℂ) ↔ x < y := by simp [lt_def]

@[simp, norm_cast] lemma zero_le_real {x : ℝ} : (0 : ℂ) ≤ (x : ℂ) ↔ 0 ≤ x := real_le_real
@[simp, norm_cast] lemma zero_lt_real {x : ℝ} : (0 : ℂ) < (x : ℂ) ↔ 0 < x := real_lt_real

lemma not_le_iff {z w : ℂ} : ¬(z ≤ w) ↔ w.re < z.re ∨ z.im ≠ w.im :=
by rw [le_def, not_and_distrib, not_le]

lemma not_le_zero_iff {z : ℂ} : ¬z ≤ 0 ↔ 0 < z.re ∨ z.im ≠ 0 := not_le_iff

/--
With `z ≤ w` iff `w - z` is real and nonnegative, `ℂ` is an ordered ring.
-/
protected def ordered_comm_ring : ordered_comm_ring ℂ :=
{ zero_le_one := ⟨zero_le_one, rfl⟩,
  add_le_add_left := λ w z h y, ⟨add_le_add_left h.1 _, congr_arg2 (+) rfl h.2⟩,
  mul_pos := λ z w hz hw,
    by simp [lt_def, mul_re, mul_im, ← hz.2, ← hw.2, mul_pos hz.1 hw.1],
  .. complex.partial_order,
  .. complex.comm_ring }

localized "attribute [instance] complex.ordered_comm_ring" in complex_order

/--
With `z ≤ w` iff `w - z` is real and nonnegative, `ℂ` is a star ordered ring.
(That is, a star ring in which the nonnegative elements are those of the form `star z * z`.)
-/
protected def star_ordered_ring : star_ordered_ring ℂ :=
{ nonneg_iff := λ r, by
  { refine ⟨λ hr, ⟨real.sqrt r.re, _⟩, λ h, _⟩,
    { have h₁ : 0 ≤ r.re := by { rw [le_def] at hr, exact hr.1 },
      have h₂ : r.im = 0 := by { rw [le_def] at hr, exact hr.2.symm },
      ext,
      { simp only [of_real_im, star_def, of_real_re, sub_zero, conj_re, mul_re, mul_zero,
                   ←real.sqrt_mul h₁ r.re, real.sqrt_mul_self h₁] },
      { simp only [h₂, add_zero, of_real_im, star_def, zero_mul, conj_im,
                   mul_im, mul_zero, neg_zero] } },
    { obtain ⟨s, rfl⟩ := h,
      simp only [←norm_sq_eq_conj_mul_self, norm_sq_nonneg, zero_le_real, star_def] } },
  ..complex.ordered_comm_ring }

localized "attribute [instance] complex.star_ordered_ring" in complex_order

end complex_order

/-! ### Cauchy sequences -/

theorem is_cau_seq_re (f : cau_seq ℂ abs) : is_cau_seq abs' (λ n, (f n).re) :=
λ ε ε0, (f.cauchy ε0).imp $ λ i H j ij,
lt_of_le_of_lt (by simpa using abs_re_le_abs (f j - f i)) (H _ ij)

theorem is_cau_seq_im (f : cau_seq ℂ abs) : is_cau_seq abs' (λ n, (f n).im) :=
λ ε ε0, (f.cauchy ε0).imp $ λ i H j ij,
lt_of_le_of_lt (by simpa using abs_im_le_abs (f j - f i)) (H _ ij)

/-- The real part of a complex Cauchy sequence, as a real Cauchy sequence. -/
noncomputable def cau_seq_re (f : cau_seq ℂ abs) : cau_seq ℝ abs' :=
⟨_, is_cau_seq_re f⟩

/-- The imaginary part of a complex Cauchy sequence, as a real Cauchy sequence. -/
noncomputable def cau_seq_im (f : cau_seq ℂ abs) : cau_seq ℝ abs' :=
⟨_, is_cau_seq_im f⟩

lemma is_cau_seq_abs {f : ℕ → ℂ} (hf : is_cau_seq abs f) :
  is_cau_seq abs' (abs ∘ f) :=
λ ε ε0, let ⟨i, hi⟩ := hf ε ε0 in
⟨i, λ j hj, lt_of_le_of_lt (abs_abs_sub_le_abs_sub _ _) (hi j hj)⟩

/-- The limit of a Cauchy sequence of complex numbers. -/
noncomputable def lim_aux (f : cau_seq ℂ abs) : ℂ :=
⟨cau_seq.lim (cau_seq_re f), cau_seq.lim (cau_seq_im f)⟩

theorem equiv_lim_aux (f : cau_seq ℂ abs) : f ≈ cau_seq.const abs (lim_aux f) :=
λ ε ε0, (exists_forall_ge_and
  (cau_seq.equiv_lim ⟨_, is_cau_seq_re f⟩ _ (half_pos ε0))
  (cau_seq.equiv_lim ⟨_, is_cau_seq_im f⟩ _ (half_pos ε0))).imp $
λ i H j ij, begin
  cases H _ ij with H₁ H₂,
  apply lt_of_le_of_lt (abs_le_abs_re_add_abs_im _),
  dsimp [lim_aux] at *,
  have := add_lt_add H₁ H₂,
  rwa add_halves at this,
end

noncomputable instance : cau_seq.is_complete ℂ abs :=
⟨λ f, ⟨lim_aux f, equiv_lim_aux f⟩⟩

open cau_seq

lemma lim_eq_lim_im_add_lim_re (f : cau_seq ℂ abs) : lim f =
  ↑(lim (cau_seq_re f)) + ↑(lim (cau_seq_im f)) * I :=
lim_eq_of_equiv_const $
calc f ≈ _ : equiv_lim_aux f
... = cau_seq.const abs (↑(lim (cau_seq_re f)) + ↑(lim (cau_seq_im f)) * I) :
  cau_seq.ext (λ _, complex.ext (by simp [lim_aux, cau_seq_re]) (by simp [lim_aux, cau_seq_im]))

lemma lim_re (f : cau_seq ℂ abs) : lim (cau_seq_re f) = (lim f).re :=
by rw [lim_eq_lim_im_add_lim_re]; simp

lemma lim_im (f : cau_seq ℂ abs) : lim (cau_seq_im f) = (lim f).im :=
by rw [lim_eq_lim_im_add_lim_re]; simp

lemma is_cau_seq_conj (f : cau_seq ℂ abs) : is_cau_seq abs (λ n, conj (f n)) :=
λ ε ε0, let ⟨i, hi⟩ := f.2 ε ε0 in
⟨i, λ j hj, by rw [← ring_hom.map_sub, abs_conj]; exact hi j hj⟩

/-- The complex conjugate of a complex Cauchy sequence, as a complex Cauchy sequence. -/
noncomputable def cau_seq_conj (f : cau_seq ℂ abs) : cau_seq ℂ abs :=
⟨_, is_cau_seq_conj f⟩

lemma lim_conj (f : cau_seq ℂ abs) : lim (cau_seq_conj f) = conj (lim f) :=
complex.ext (by simp [cau_seq_conj, (lim_re _).symm, cau_seq_re])
  (by simp [cau_seq_conj, (lim_im _).symm, cau_seq_im, (lim_neg _).symm]; refl)

/-- The absolute value of a complex Cauchy sequence, as a real Cauchy sequence. -/
noncomputable def cau_seq_abs (f : cau_seq ℂ abs) : cau_seq ℝ abs' :=
⟨_, is_cau_seq_abs f.2⟩

lemma lim_abs (f : cau_seq ℂ abs) : lim (cau_seq_abs f) = abs (lim f) :=
lim_eq_of_equiv_const (λ ε ε0,
let ⟨i, hi⟩ := equiv_lim f ε ε0 in
⟨i, λ j hj, lt_of_le_of_lt (abs_abs_sub_le_abs_sub _ _) (hi j hj)⟩)

@[simp, norm_cast] lemma of_real_prod {α : Type*} (s : finset α) (f : α → ℝ) :
  ((∏ i in s, f i : ℝ) : ℂ) = ∏ i in s, (f i : ℂ) :=
ring_hom.map_prod of_real _ _

@[simp, norm_cast] lemma of_real_sum {α : Type*} (s : finset α) (f : α → ℝ) :
  ((∑ i in s, f i : ℝ) : ℂ) = ∑ i in s, (f i : ℂ) :=
ring_hom.map_sum of_real _ _

end complex