/-
Notes
-----
A set seems to be the lambda λα : Type → Prop
`mem` takes a set and another input and simply applies the set to the other.

    protected def mem (a : α) (s : set α) :=
    s a

∈ is defined in library/init.core.lean.

    infix ∈     := has_mem.mem

with has_mem.mem having the definition:

    class has_mem (α : out_param $ Type u) (y : Type v) := (mem : α→y→Prop)

$ usage. Quoted from "Programming in Lean":
    Note the use of the dollar-sign for function application. In general,
    an expression f $ a denotes nothing more than f a, but the binding strength
    is such that you do not need to use extra parentheses when a is a long
    expression. This provides a convenient idiom in situations exactly like
    the one in the example.

The statement:
  ∃x ∈ X
is shorthand for:
  ∃ (x : _) (h : x ∈ X)
which is shorthand for:
  ∃ (x : _), ∃ (h : x ∈ X),
-/

/-
Contents and exercises for Chapter 9 of Tao's Analysis.
-/
-- We want real numbers and their basic properties
import data.real.basic
import data.set
import logic.basic

import tao_ch5

set_option pp.implicit true
-- Make simp display the steps used.
set_option trace.simplify.rewrite true

-- We want to be able to define functions using the law of excluded middle
noncomputable theory
open_locale classical

-- Use a namespace so that we can copy some of the matlib naming.
namespace tao_analysis

-- Notation for absolute. Is this in Lean somewhere?
local notation `|`x`|` := abs x

/- Section 9.1
Many of these results can be found in matlib. For example, definitions and
properties of closures can be found here:
https://leanprover-community.github.io/mathlib_docs/topology/basic.html
-/

/- Definition 9.1.1 (Intervals)
Intervals are available in matlib.
https://leanprover-community.github.io/mathlib_docs/data/set/intervals/basic.html
-/
namespace demo
def x₁ : ℝ := 1
def x₂ : ℝ := 4
constant open_interval : set.Ioo x₁ x₂
constant closed_open_interval : set.Ico x₁ x₂
constant open_closed_interval : set.Ioc x₁ x₂
constant closed_interval : set.Icc x₁ x₂
end demo

/-
Exercises
---------
9.1.1
9.1.2 (Lemma 9.1.11)
9.1.3 TODO
9.1.1 again, this time using Lemma 9.1.11, and Exercise 9.1.6.
-/

-- Definition 9.1.7
-- I'm skipping this and going directly to 9.1.8

-- Definition 9.1.8
def is_adherent (x : ℝ) (X : set ℝ) : Prop :=
∀ ε > 0, ∃y ∈ X, |x - y| < ε

infix `is_adherent_to` :55 := is_adherent

-- Definition 9.1.10
def closure (X : set ℝ) : set ℝ :=
{x : ℝ | x is_adherent_to X }

-- Definition 9.1.15
def is_closed (X : set ℝ) :Prop :=
closure X = X

-- Definition 9.1.18 a)
def is_limit_point (x : ℝ) (X : set ℝ) : Prop :=
is_adherent x (X \ {x})

def is_isolated_point (x : ℝ) (X : set ℝ) : Prop :=
x ∈ X ∧ ∃ ε > 0, ∀y ∈ (X \ {x}), |x - y| > ε

-- Definition 9.1.22
def is_bounded (X : set ℝ) : Prop :=
∃ M > 0, X ⊆ set.Icc (-M) M

/- Exercise 9.1.1
If X ⊆ Y ⊆ closure(X), then closure(Y) = closure(X)

This attempt is a hacky δ—ε proof; it doesn't use any properties from Lemma
9.1.11. I repeat the proof again below using Lemma 9.1.11.
-/
lemma closure_squeeze
  (X Y : set ℝ)
  (h₁ : X ⊆ Y)
  (h₂ : Y ⊆ closure(X)) :
closure(X) = closure(Y) :=
begin
  apply set.eq_of_subset_of_subset,
  {
    intros x h₃ ε hε,
    have h₄ : x is_adherent_to X, from h₃,
    have h₅ : ∃x' ∈ X, |x - x'| < ε, from h₃ ε hε,
    rcases h₅ with ⟨x', h₆, h₇⟩,
    have h₈ : x' ∈ Y, from h₁ h₆,
    use x',
    exact and.intro h₈ h₇
  },
  {
    intros y h₃ ε hε,
    set δ := ε/3 with hδ,
    have h₅ : δ > 0, by linarith,
    have h₆ : ∃y' ∈ Y, |y - y'| < δ, from h₃ δ h₅,
    rcases h₆ with ⟨y', hy', h₇⟩,
    have h₈ : y' ∈ closure(X), from h₂ hy',
    have h₉ : ∃x ∈ X, |y' - x| < δ, from h₈ δ h₅,
    rcases h₉ with ⟨x, hx, h₁₀⟩,
    use x,
    have h₁₀ : |(y - y') + (y' - x)| ≤ |y - y'| + |y' - x|, from abs_add _ _,
    have h₁₁ : |y - x| < 2*δ,
      rw (show (y - x) = (y - y') + (y' - x), by ring),
      linarith,
    have h₁₂ : |y - x| < ε, by linarith,
    exact and.intro hx h₁₂
  }
end

/- Exercise 9.1.2 (Lemma 9.1.11)

There are 4 separate propositions here:

  1. X ⊆ closure(X)
  The 4th part is done next so that it can be used in 2 and 3.
  4. X ⊆ Y → closure(X) ⊆ closure(Y)
  2. closure(X ∪ Y) = closure(X) ∪ closure(Y)
  3. closure(X ∩ Y) ⊆ closure(X) ∩ closure(Y)
-/

-- 1. X ⊆ closure(X)
lemma subset_closure (X : set ℝ ) : X ⊆ closure(X) :=
begin
  intros x h₁ ε h₂,
  apply exists.intro x,
  apply exists.intro h₁,
  rw [sub_self, abs_zero],
  exact h₂,
end

-- Trying to achieve the same thing using a term-based proof.
lemma subset_closure_term (X : set ℝ ) : X ⊆ closure(X) :=
assume x,
assume h₁ : x ∈ X,
have adh: x is_adherent_to X, from
  assume ε,
  assume h₂ : ε > 0,
  have h₃ : |x - x| < ε, from
    have h₄ : x - x = 0, from sub_self x,
    sorry, -- not sure how to proceed here.
  exists.intro x (exists.intro h₁ h₃),
show x ∈ closure(X), from adh

-- 4. X ⊆ Y → closure(X) ⊆ closure(Y)
lemma closure_mono {X Y :set ℝ} (hXY : X ⊆ Y) : closure(X) ⊆ closure(Y) :=
begin
  intros x hx ε hε,
  have : ∃x' ∈ X, |x - x'| < ε, from hx ε hε,
  rcases this with ⟨x', hx', h₂⟩,
  use x',
  split,
  exact hXY hx',
  exact h₂, -- could use `assumption` here instead.
end

-- 2. closure(X ∪ Y) = closure(X) ∪ closure(Y)
lemma closure_union
  {X Y : set ℝ} :
closure (X ∪ Y) = closure (X) ∪ closure (Y) :=
begin
  apply set.subset.antisymm,
  {
    -- not sure how to do this part in Lean.
    admit
  },
  {
    intros a haXY,
    cases haXY,
    apply closure_mono (set.subset_union_left X Y) haXY,
    apply closure_mono (set.subset_union_right X Y) haXY
  }
end

/- 3. closure(X ∩ Y) ⊆ closure(X) ∩ closure(Y)

Version 1, my original ε attempt.
Below, using closure_mono, is a nicer proof.
-/
lemma closure_inter_subset_inter_closure (X Y : set ℝ) :
closure (X ∩ Y) ⊆ closure X ∩ closure Y :=
begin
  intros a ha,
  split,
  repeat {
    intros ε hε,
    rcases ha ε hε with ⟨xy, hxy, h₁⟩,
    use xy,
    cases hxy with l r,
    split; assumption
  }
end

/- 3. closure(X ∩ Y) ⊆ closure(X) ∩ closure(Y)

Version 2, by Kenny Lau.
https://leanprover.zulipchat.com/#narrow/stream/113489-new-members/topic/cleaning.20up.20this.20tactic.20proof.20%28regarding.20closures%29/near/192625784
-/
lemma closure_inter_subset_inter_closure' (X Y : set ℝ) :
closure (X ∩ Y) ⊆ closure X ∩ closure Y :=
have h₁ : closure (X ∩ Y) ⊆ closure X,
  from closure_mono (set.inter_subset_left X Y),
have h₂ : closure (X ∩ Y) ⊆ closure Y,
  from closure_mono (set.inter_subset_right X Y),
set.subset_inter h₁ h₂

-- Lemma 9.1.12
-- There are 4 parts.

-- 1. Closure of interval (a, b) is [a, b].
lemma closure_Ioo_Icc
  (a b : ℝ)
  (hab : a < b) :
closure (set.Ioo a b) = (set.Icc a b) :=
begin
apply set.subset.antisymm,
{
  intros x hx,
  by_contradiction H,
  unfold set.Icc at H,
  simp at H,
  have hxa : x < a ∨ a ≤ x, by exact @lt_or_ge ℝ real.linear_order x a,
  cases hxa with hlt hge,
  {
    have h₁ : ∃ β > 0, x + β = a, from sorry,
    --have h₆ : x = a - β, by linarith,--exact @eq_sub_of_add_eq ℝ real.add_group x a β h₂,
    rcases h₁ with ⟨β, hβ, h₂⟩,
    rcases hx β hβ with ⟨y, hy, hxy⟩,
    have h₃ : a < y, from hy.left,
    have h₄ : ∃ α > 0, a + α = y, from sorry,
    rcases h₄ with ⟨α, hα, h₅⟩,
    have h₆ : a = y - α, by linarith,
    rw h₆ at h₂,
    have h₇ := y - x = β + α, from sorry,--by linarith, -- really linarith!
  },
  {
    admit
  },
},
{
  admit
},
end

-- 2. Closure of interval (a, b] is [a, b].
-- 3. Closure of interval [a, b) is [a, b].
-- 4. Closure of interval [a, b] is [a, b].

-- [TODO: convert to lean]
-- Exercise 9.1.3
-- This needs to be improved! How to properly prove being equal to the
-- empty set?
lemma is_empty_closed : is_closed ∅ :=
begin
unfold is_closed,
unfold closure,
apply set.subset.antisymm,
{
  intros x hx,
  have h₁ : ∀ ε > 0, ∃x' ∈ ∅, |x - x'| < ε, from hx,
  set a : ℝ := 1 with h₂,
  have h₃ : a > 0, by linarith,
  rcases h₁ a h₃ with ⟨x', h0, h0a⟩,
  exact h0
},
{simp,}
end
-- Exercise 9.1.4
-- Exercise 9.1.5

/-
Exercise 9.1.6
-/
lemma closure_closure (X : set ℝ) : closure (closure X) = closure X :=
begin
apply set.subset.antisymm,
{
  intros a haX ε hε,
  set δ := ε/3 with h3δ,
  have hδ : δ > 0, by linarith,
  rcases haX δ hδ with ⟨xc, hxc, h₁⟩,
  rcases hxc δ hδ with ⟨x, hx, h₂⟩,
  use x,
  split,
  exact hx,
  calc |a - x| = |(a - xc) + (xc - x)| : by ring
  ...          ≤ |a - xc| + |xc - x|   : by apply abs_add
  ...          < 2 * δ                 : by linarith
  ...          < ε                     : by linarith
},
{
  apply subset_closure (closure X)
}
end

/- Exercise 9.1.6 (version 2)

If you decide to follow the book and prove exercise 9.1.1 first, then you can
use that result to prove 9.1.6 easily. Above, 9.1.6 is done without 9.1.1
so as to be available for earlier proofs.
-/
example {X : set ℝ} : closure (closure X) = closure X :=
begin
  -- Use closure(X) as the middle term in 9.1.1's lemma.
  let Y := closure X,
  have h₁ : X ⊆ Y, from subset_closure X,
  have h₂ : Y ⊆ closure X, from set.subset.refl Y,
  have h₃ : closure X = closure (closure X), from closure_squeeze X Y h₁ h₂,
  apply eq.symm, -- Should `simp,` work here instead?
  exact h₃,
end

/- Exercise 9.1.7
A the union of a finite number of closed sets is closed.

It seems possible to either:
  a) take a function, f: ℕ → set ℝ, as input and induce on ℕ, or
  b) take a finset ℝ as input and induce using the provided mechanism of finset.

Let's try a)

The captial 'U' refers to the union of the family of sets.
Note: should the `n` be removed?
mathlib uses 'is_closed_bUnion' to name their method. I'm not sure what
the b prefix means here.
-/
/-lemma is_closed_Union
  {ss : finset set ℝ}
  (h₁ : ∀s ∈ ss, is_closed (s)) :
is_closed (set.Union (finset.to_set ss)) :=
sorry
-/
/- TODO
Struggling to induce over finite sets, so I'll try a more general approach of
using index sets and come back later to address it. We can define f to be
a function that simply maps all i>n to n to achieve the same thing as intented,
it's just not really honoring the intent of the original statement.
-/
lemma is_closed_Union_n
  {n : ℕ}
  {f : ℕ → set ℝ}
  (h₁ : ∀i < n, is_closed (f i)) :
is_closed ⋃ i < n, f i :=
sorry

lemma not_le_of_ge (a b : ℝ) (h : ¬ a < b) : a ≥ b :=
begin
  -- ge_iff_le isn't actually needed.
  rw [@not_lt ℝ real.linear_order a b, ←ge_iff_le] at h,
  exact h
end
--@iff.mp (¬a < b) (b ≤ a) (@not_lt ℝ real.linear_order a b) h

variables P  : ℝ → Prop
example (a : ℝ) (h : ∀ y : ℝ, P y → ¬ a < y) : ∀ y : ℝ, P y → a ≥ y :=
begin
  simp_rw @not_lt ℝ real.linear_order a at h,
  exact h
end

/-- Exercise 9.1.9
I took two approaches to solving this.
1. Tao's order
I approached it in the sequence presented in the problem (starting with adherent
points being limit points xor isolated points). The first part of this turned
into a monolithic tactic proof.

2. First introduce to iff statements
In an attempt to make the above proof less of a monolith, I proved the
bijections:
  is_limit_point x X ↔ x ∈ closure (X \ {x})
  is_isolated_point x X ↔ is_adherent x X ∧ x ∉ closure (X \ {x})
However, the second of these proofs turned out to be even more involved than the
original monolith, so nothing was really gained here.
-/

-- 1. Tao's order.

/- 1.1
An adherent point to set of reals is exactly one of the following:
  * a limit point or
  * an isolated point
-/
lemma limit_xor_isolated
  (X : set ℝ)
  (x : ℝ)
  (hx : is_adherent x X) :
is_isolated_point x X ↔ ¬ is_limit_point x X :=
begin
  split,
  {
    intros hix hlx,
    rcases hix with ⟨hxX, ε, hε, hy⟩,
    rcases hlx ε hε with ⟨y, hyX, hxy⟩,
    have h₁ := hy y hyX,
    linarith,
  },
  {
    intros nhlx,
    -- unfold so that simp will be able to work.
    unfold is_limit_point is_adherent at nhlx,
    -- Push the negative all the way to the < relation.
    simp_rw [not_forall, not_exists, @not_lt ℝ real.linear_order] at nhlx,
    -- Writing it out here will nicer variables.
    have h₁ : ∃ (ε : ℝ) (hε : ε > 0), ∀ (y : ℝ), y ∈ X \ {x} → |x - y| ≥ ε, from nhlx,
    -- Q: Is there an easy way to replace all ≥ with > knowing that we can find
    -- a smaller real?
    -- I just want to replace ≥ with >. It look simple, but it takes me...
    have h₂ : ∃ (ε : ℝ) (hε : ε > 0), ∀ (y : ℝ), y ∈ X \ {x} → |x - y| > ε,
      rcases h₁ with ⟨ε, hε, hy⟩,
      use ε/2,
      split,
      {
        exact (by linarith),
      },
      {
        intros y hyX,
        have h:= hy y hyX,
        linarith,
      },
    -- ... 8 lines.
    split,
    {
      rcases h₁ with ⟨ε, hε, hy⟩,
      rcases hx ε hε with ⟨y, hyX, hxy⟩,
      by_contradiction,
      rw ←(set.diff_singleton_eq_self a) at hyX,
      have nhxy := hy y hyX,
      linarith,
    },
    {
      exact h₂
    }
  }
end

-- 1.2 a limit point is an adherent point.
lemma adherent_of_limit
  {X : set ℝ}
  {x : ℝ}
  (h : is_limit_point x X) :
is_adherent x X :=
begin
  set X_diff_x := X \ {x},
  have h₁ : is_adherent x X_diff_x, from h,
  have h₂ : X_diff_x ⊆ X, from set.diff_subset X {x},
  exact closure_mono h₂ h₁,
end

-- 1.3 a isolated point is an adherent point.
lemma adherent_of_isolated
  {X : set ℝ}
  {x : ℝ}
  (h : is_isolated_point x X) :
is_adherent x X :=
begin
  intros ε hε,
  use x,
  rw [sub_self, abs_zero],
  exact ⟨h.left, hε⟩,
end

-- 2. Custom order.
lemma limit_iff_mem_closure_minus
  {X : set ℝ}
  {x : ℝ} :
is_limit_point x X ↔ x ∈ closure (X \ {x}) :=
begin
unfold is_limit_point closure,
simp
end

lemma isolated_iff_adherent_not_mem_closure_minus
  {X : set ℝ}
  {x : ℝ} :
is_isolated_point x X ↔ is_adherent x X ∧ x ∉ closure (X \ {x}) :=
begin
split,
{
  intro h,
  split,
  {
    intros ε hε,
    use x,
    rw [sub_self, abs_zero],
    exact ⟨h.left,hε⟩,
  },
  {
    -- I wanted to push the negative to the left and produce:
    --    ∃ ε > 0, ¬∃ y ∈ X\{x}, |x - y| ≤ ε
    --    ∃ ε/2 > 0, ¬∃ y ∈ X\{x}, |x - y| < ε/2
    --    ¬ ∀ ε/2 > 0, ∃ y ∈ X\{x}, |x - y| < ε/2
    -- which is our goal.
    -- But, as seen below, it's tedius, so I'll just bounce between the ∃ and ∀.
    intros hn,
    rcases h.right with ⟨ε, hε, h₁⟩,
    simp at hn h₁,
    rcases hn ε hε with ⟨y, hy, hxy⟩,
    simp at hy,
    have h := h₁ y hy.left hy.right,
    linarith,
  }
},
{
  assume h,
  have h₁ : x ∈ closure X, from h.left,
  split,
  {
    by_contradiction,
    have h₂ : X = X \ {x}, from eq.symm (set.diff_singleton_eq_self a),
    rw h₂ at h₁,
    exact h.right h₁,
  },
  {
    have hr := h.right,
    unfold closure is_adherent at hr,
    rw set.mem_set_of_eq at hr,
    -- Push the negative all the way to the < relation.
    simp_rw [not_forall, not_exists, @not_lt ℝ real.linear_order,
             iff.symm ge_iff_le] at hr,
    -- I just want to replace ≥ with >. It look simple, but it takes me...
    have ans : ∃ (ε : ℝ) (hε : ε > 0), ∀ (y : ℝ), y ∈ X \ {x} → |x - y| > ε,
      rcases hr with ⟨ε, hε, hy⟩,
      use ε/2,
      split,
      exact (by linarith),
      intros y hyX,
      have h:= hy y hyX,
      linarith,
    -- ... 8 lines.-/
    exact ans
  }
}
end

lemma limit_xor_isolated'
  (X : set ℝ)
  (x : ℝ)
  (hx : is_adherent x X) :
is_isolated_point x X ↔ ¬ is_limit_point x X :=
begin
  split,
  {
    intros hix hlx,
    exact (iff.elim_left isolated_iff_adherent_not_mem_closure_minus hix).right hlx,
  },
  {
    intros nhlx,
    rw limit_iff_mem_closure_minus at nhlx,
    have h₁ := and.intro hx nhlx,
    exact (iff.elim_right isolated_iff_adherent_not_mem_closure_minus h₁)
  }
end

-- Exercise 9.1.10
-- This is an trivial proof on paper, but I ended up with a mess in Lean.
example (X : set ℝ) (h : X.nonempty) :
is_bounded X ↔ has_finite_sup X ∧ has_finite_inf X :=
begin
  split,
  {
    -- The forward proof isn't too bad—it's the reverse that is the main issue.
    intro hb,
    rcases hb with ⟨u, hu, h₁⟩,
    let l := -u,
    have hub : u ∈ upper_bounds X,
      intros x hx,
      exact (h₁ hx).right,
    have hlb : l ∈ lower_bounds X,
      intros x hx,
      exact (h₁ hx).left,
    have hfs : has_finite_sup X, from ⟨h, set.nonempty_of_mem hub⟩,
    have hfi : has_finite_inf X, from ⟨h, set.nonempty_of_mem hlb⟩,
    exact ⟨hfs, hfi⟩,
  },
  {
    -- This part is a mess, mainly becase:
    --   1. I don't find a simple way of going from `u l : ℝ` to `∃ m > 0, m ≥ u ∧ m ≥ l`
    --   2. I don't know of a tactic like `linarith` that will work with abs inequalities.
    intro h,
    rcases h.left.right with ⟨u, hu⟩,
    rcases h.right.right with ⟨l, hl⟩,
    -- Try create m by setting it equal to `|upper bound| + |lower bound| + 1`
    let m0 := |u| + |l|,
    have h₁ : m0 ≥ |u| ∧ m0 ≥ |l|,
      split; {norm_num, apply abs_nonneg},
    let m1 : ℝ := m0 + 1,
    have h₂ : m0 ≤ m1, by norm_num,
    have h₄ : m1 ≥ |u| ∧ m1 ≥ |l|,
      -- Short but opaque alternative for h₄ proof:
      --   split; cases h₁; apply le_trans; assumption,
      split,
      {
        apply le_trans h₁.left h₂,
      },
      {
        apply le_trans h₁.right h₂,
      },
    use m1,
    split,
    {
    -- Can't find any automation for here.
      have m0_nonneg : 0 ≤ m0, from add_nonneg (abs_nonneg u) (abs_nonneg l),
      have h₃ : 0 < m1, from add_pos_of_nonneg_of_pos m0_nonneg (by norm_num),
      exact h₃,
    },
    {
      intros x hx,
      -- Can't find any automation for here.
      have hxm : x ≤ m1, from le_trans (hu hx) (le_trans (le_abs_self u) h₄.left),
      have hml : -l ≤ m1, from le_trans (neg_le_abs_self l) h₄.right,
      rw neg_le at hml,
      have hmx := le_trans hml (hl hx),
      exact ⟨hmx, hxm⟩,
    },
  },
end

example (X : set ℝ) (h : X.nonempty) :
is_bounded X ↔ has_finite_sup X ∧ has_finite_inf X :=
begin
  split,
  { rintro ⟨M, M0, hM⟩,
    exact ⟨⟨h, M, λ x h, (hM h).2⟩, ⟨h, -M, λ x h, (hM h).1⟩⟩ },
  { rintro ⟨⟨_, u, hu⟩, ⟨_, v, hv⟩⟩,
    use max 1 (max u (-v)), split,
    { apply lt_of_lt_of_le zero_lt_one,
      apply le_max_left },
    { intros x hx, split,
      { apply neg_le.1,
        apply le_trans _ (le_max_right _ _),
        apply le_trans _ (le_max_right _ _),
        apply neg_le_neg,
        exact hv hx },
      { apply le_trans _ (le_max_right _ _),
        apply le_trans _ (le_max_left _ _),
        exact hu hx } } }
end

    /-
    intros hlx,
    --have h₁ := not_forall hlx,
    have h₁ := iff.elim_left not_forall hlx,
    -- Why can't I apply rw not_imp here? simp goes too far.
    -- rw not_imp,
    cases h₁ with ε h₂,
    have h₃ := iff.elim_left not_imp h₂,
    cases h₃,
    rw not_exists at h₃_right,
    -- Why can't I write: rw ←not_le at h₃_right,
    split,
    {
      rcases hx ε h₃_left with ⟨y, hy, hxy⟩,
      have h₄ := h₃_right y,
      rw not_exists at h₄,
      by_contradiction,
      have h₅ := and.intro hy a,
      rw [set.sub_eq_diff, set.mem_diff] at h₄,
      have h₆ : y ≠ x,
        by_contradiction,
        simp at a_1,
        have h₇ := h₄ ⟨h₅.left, _⟩,
      simp at h₄,
    },
    {
      set δ := ε/2 with h3δ,
      have hδ : δ > 0, by linarith,
      use δ,
      split,
      exact hδ,
      intros y hy,
      have h₄ := h₃_right y,
      rw not_exists at h₄,
      have h₅ := h₄ hy,
      linarith,
      }

    --rcases hx ε h₃.left with ⟨y, hy, hxy⟩,
  }
end-/
 /-have h₁ : ¬(is_isolated_point x X ∧ is_limit_point x X),
    intro h₂,
    rcases h₂.left with ⟨hxX, ε, hε, hy⟩,
    have h₃ := h₂.right ε hε,
    rcases h₃ with ⟨y, hyX, hxy⟩,
    have h₄ := hy y hyX,
  linarith,-/

  /-{
    intros hix hlx,
    rcases hix with ⟨hxX, ε, hε, hy⟩,
    rcases hlx ε hε with ⟨y, hyX, hxy⟩,
    have h₁ := hy y hyX,
    linarith,
  },
  {
    intros hlx hix,
  }
end-/

lemma limit_point_is_adherent
  (X : set ℝ)
  (x : ℝ)
  (h₁ : is_limit_point x X):
is_adherent x X :=
sorry

lemma isolated_point_is_adherent
  (X : set ℝ)
  (x : ℝ)
  (h₁ : is_isolated_point x X):
is_adherent x X :=
sorry

/-- Exercise 9.1.10
-/
lemma closure_bounded_if_bounded :
  (X :)

end tao_analysis


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

import ring_theory.valuation.basic

/-!
# Ring of integers under a given valuation

The elements with valuation less than or equal to 1.

TODO: Define characteristic predicate.
-/

universes u v w

namespace valuation

section ring

variables {R : Type u} {Γ₀ : Type v} [ring R] [linear_ordered_comm_group_with_zero Γ₀]
variables (v : valuation R Γ₀)

/-- The ring of integers under a given valuation is the subring of elements with valuation ≤ 1. -/
def integer : subring R :=
{ carrier := { x | v x ≤ 1 },
  one_mem' := le_of_eq v.map_one,
  mul_mem' := λ x y hx hy, trans_rel_right (≤) (v.map_mul x y) (mul_le_one' hx hy),
  zero_mem' := trans_rel_right (≤) v.map_zero zero_le_one',
  add_mem' := λ x y hx hy, le_trans (v.map_add x y) (max_le hx hy),
  neg_mem' := λ x hx, trans_rel_right (≤) (v.map_neg x) hx }

end ring

section comm_ring

variables {R : Type u} {Γ₀ : Type v} [comm_ring R] [linear_ordered_comm_group_with_zero Γ₀]
variables (v : valuation R Γ₀)
variables (O : Type w) [comm_ring O] [algebra O R]

/-- Given a valuation v : R → Γ₀ and a ring homomorphism O →+* R, we say that O is the integers of v
if f is injective, and its range is exactly `v.integer`. -/
structure integers : Prop :=
(hom_inj : function.injective (algebra_map O R))
(map_le_one : ∀ x, v (algebra_map O R x) ≤ 1)
(exists_of_le_one : ∀ ⦃r⦄, v r ≤ 1 → ∃ x, algebra_map O R x = r)

-- typeclass shortcut
instance : algebra v.integer R :=
algebra.of_subring v.integer

theorem integer.integers : v.integers v.integer :=
{ hom_inj := subtype.coe_injective,
  map_le_one := λ r, r.2,
  exists_of_le_one := λ r hr, ⟨⟨r, hr⟩, rfl⟩ }

namespace integers

variables {v O} (hv : integers v O)
include hv

lemma one_of_is_unit {x : O} (hx : is_unit x) : v (algebra_map O R x) = 1 :=
let ⟨u, hu⟩ := hx in le_antisymm (hv.2 _) $
by { rw [← v.map_one, ← (algebra_map O R).map_one, ← u.mul_inv, ← mul_one (v (algebra_map O R x)),
  hu, (algebra_map O R).map_mul, v.map_mul], exact mul_le_mul_left' (hv.2 (u⁻¹ : units O)) _ }

lemma is_unit_of_one {x : O} (hx : is_unit (algebra_map O R x)) (hvx : v (algebra_map O R x) = 1) :
  is_unit x :=
let ⟨u, hu⟩ := hx in
have h1 : v u ≤ 1, from hu.symm ▸ hv.2 x,
have h2 : v (u⁻¹ : units R) ≤ 1,
  by rw [← one_mul (v _), ← hvx, ← v.map_mul, ← hu, u.mul_inv, hu, hvx, v.map_one],
let ⟨r1, hr1⟩ := hv.3 h1, ⟨r2, hr2⟩ := hv.3 h2 in
⟨⟨r1, r2, hv.1 $ by rw [ring_hom.map_mul, ring_hom.map_one, hr1, hr2, units.mul_inv],
  hv.1 $ by rw [ring_hom.map_mul, ring_hom.map_one, hr1, hr2, units.inv_mul]⟩,
hv.1 $ hr1.trans hu⟩

lemma le_of_dvd {x y : O} (h : x ∣ y) : v (algebra_map O R y) ≤ v (algebra_map O R x) :=
let ⟨z, hz⟩ := h in by { rw [← mul_one (v (algebra_map O R x)), hz, ring_hom.map_mul, v.map_mul],
  exact mul_le_mul_left' (hv.2 z) _ }

end integers

end comm_ring

section field

variables {F : Type u} {Γ₀ : Type v} [field F] [linear_ordered_comm_group_with_zero Γ₀]
variables {v : valuation F Γ₀} {O : Type w} [comm_ring O] [algebra O F] (hv : integers v O)
include hv

namespace integers

lemma dvd_of_le {x y : O} (h : v (algebra_map O F x) ≤ v (algebra_map O F y)) : y ∣ x :=
classical.by_cases (λ hy : algebra_map O F y = 0, have hx : x = 0,
    from hv.1 $ (algebra_map O F).map_zero.symm ▸
      (v.zero_iff.1 $ le_zero_iff.1 (v.map_zero ▸ hy ▸ h)),
  hx.symm ▸ dvd_zero y) $
λ hy : algebra_map O F y ≠ 0,
have v ((algebra_map O F y)⁻¹ * algebra_map O F x) ≤ 1,
  by { rw [← v.map_one, ← inv_mul_cancel hy, v.map_mul, v.map_mul], exact mul_le_mul_left' h _ },
let ⟨z, hz⟩ := hv.3 this in
⟨z, hv.1 $ ((algebra_map O F).map_mul y z).symm ▸ hz.symm ▸ (mul_inv_cancel_left' hy _).symm⟩

lemma dvd_iff_le {x y : O} : x ∣ y ↔ v (algebra_map O F y) ≤ v (algebra_map O F x) :=
⟨hv.le_of_dvd, hv.dvd_of_le⟩

lemma le_iff_dvd {x y : O} : v (algebra_map O F x) ≤ v (algebra_map O F y) ↔ y ∣ x :=
⟨hv.dvd_of_le, hv.le_of_dvd⟩

end integers

end field

end valuation


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

The functor Grp → Ab which is the left adjoint
of the forgetful functor Ab → Grp.

-/

import group_theory.quotient_group

universes u v

variables (α : Type u) [group α]

def commutator : set α :=
{ x | ∃ L : list α, (∀ z ∈ L, ∃ p q, p * q * p⁻¹ * q⁻¹ = z) ∧ L.prod = x }

instance : normal_subgroup (commutator α) :=
{ one_mem := ⟨[], by simp⟩,
  mul_mem := λ x y ⟨L1, HL1, HP1⟩ ⟨L2, HL2, HP2⟩,
    ⟨L1 ++ L2, list.forall_mem_append.2 ⟨HL1, HL2⟩, by simp*⟩,
  inv_mem := λ x ⟨L, HL, HP⟩, ⟨L.reverse.map has_inv.inv,
    λ x hx, let ⟨y, h3, h4⟩ := list.exists_of_mem_map hx in
      let ⟨p, q, h5⟩ := HL y (list.mem_reverse.1 h3) in
      ⟨q, p, by rw [← h4, ← h5]; simp [mul_assoc]⟩,
    by rw ← HP; from list.rec_on L (by simp) (λ hd tl ih,
      by rw [list.reverse_cons, list.map_append, list.prod_append, ih]; simp)⟩,
  normal := λ x ⟨L, HL, HP⟩ g, ⟨L.map $ λ z, g * z * g⁻¹,
    λ x hx, let ⟨y, h3, h4⟩ := list.exists_of_mem_map hx in
      let ⟨p, q, h5⟩ := HL y h3 in
      ⟨g * p * g⁻¹, g * q * g⁻¹,
      by rw [← h4, ← h5]; simp [mul_assoc]⟩,
    by rw ← HP; from list.rec_on L (by simp) (λ hd tl ih,
      by rw [list.map_cons, list.prod_cons, ih]; simp [mul_assoc])⟩, }

def abelianization : Type u :=
quotient_group.quotient $ commutator α

namespace abelianization

local attribute [instance] quotient_group.left_rel normal_subgroup.to_is_subgroup

instance : comm_group (abelianization α) :=
{ mul_comm := λ x y, quotient.induction_on₂ x y $ λ m n,
    quotient.sound $ ⟨[n⁻¹*m⁻¹*n*m],
      by simp; refine ⟨n⁻¹, m⁻¹, _⟩; simp,
      by simp [mul_assoc]⟩,
  .. quotient_group.group _ }

variable {α}

def of (x : α) : abelianization α :=
quotient.mk x

instance of.is_group_hom : is_group_hom (@of α _) :=
⟨λ _ _, rfl⟩

section lift

variables {β : Type v} [comm_group β] (f : α → β) [is_group_hom f]

def lift : abelianization α → β :=
quotient_group.lift _ f $ λ x ⟨L, HL, hx⟩,
hx ▸ list.rec_on L (λ _, is_group_hom.one f) (λ hd tl HL ih,
  by rw [list.forall_mem_cons] at ih;
    rcases ih with ⟨⟨p, q, hpq⟩, ih⟩;
    specialize HL ih; rw [list.prod_cons, is_group_hom.mul f, ← hpq, HL];
    simp [is_group_hom.mul f, is_group_hom.inv f, mul_comm]) HL

instance lift.is_group_hom : is_group_hom (lift f) :=
quotient_group.is_group_hom_quotient_lift _ _ _

@[simp] lemma lift.of (x : α) : lift f (of x) = f x := rfl

theorem lift.unique
  (g : abelianization α → β) [is_group_hom g]
  (hg : ∀ x, g (of x) = f x) {x} :
  g x = lift f x :=
quotient.induction_on x $ λ m, hg m

end lift

end abelianization


/-
Copyright (c) 2019 Patrick Massot. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Patrick Massot
-/
import topology.uniform_space.uniform_embedding

/-!
# Abstract theory of Hausdorff completions of uniform spaces

This file characterizes Hausdorff completions of a uniform space α as complete Hausdorff spaces
equipped with a map from α which has dense image and induce the original uniform structure on α.
Assuming these properties we "extend" uniformly continuous maps from α to complete Hausdorff spaces
to the completions of α. This is the universal property expected from a completion.
It is then used to extend uniformly continuous maps from α to α' to maps between
completions of α and α'.

This file does not construct any such completion, it only study consequences of their existence.
The first advantage is that formal properties are clearly highlighted without interference from
construction details. The second advantage is that this framework can then be used to compare
different completion constructions. See `topology/uniform_space/compare_reals` for an example.
Of course the comparison comes from the universal property as usual.

A general explicit construction of completions is done in `uniform_space/completion`, leading
to a functor from uniform spaces to complete Hausdorff uniform spaces that is left adjoint to the
inclusion, see `uniform_space/UniformSpace` for the category packaging.

## Implementation notes

A tiny technical advantage of using a characteristic predicate such as the properties listed in
`abstract_completion` instead of stating the universal property is that the universal property
derived from the predicate is more universe polymorphic.

## References

We don't know any traditional text discussing this. Real world mathematics simply silently
identify the results of any two constructions that lead to something one could reasonnably
call a completion.

## Tags

uniform spaces, completion, universal property
-/

noncomputable theory
local attribute [instance, priority 10] classical.prop_decidable

open filter set function

universes u
/-- A completion of `α` is the data of a complete separated uniform space (from the same universe)
and a map from `α` with dense range and inducing the original uniform structure on `α`. -/
structure abstract_completion (α : Type u) [uniform_space α] :=
(space : Type u)
(coe : α → space)
(uniform_struct : uniform_space space)
(complete : complete_space space)
(separation : separated_space space)
(uniform_inducing : uniform_inducing coe)
(dense : dense_range coe)

local attribute [instance]
abstract_completion.uniform_struct abstract_completion.complete abstract_completion.separation

namespace abstract_completion
variables {α : Type*} [uniform_space α] (pkg : abstract_completion α)
local notation `hatα` := pkg.space
local notation `ι` := pkg.coe

lemma closure_range : closure (range ι) = univ :=
pkg.dense.closure_range

lemma dense_inducing : dense_inducing ι :=
⟨pkg.uniform_inducing.inducing, pkg.dense⟩

lemma uniform_continuous_coe : uniform_continuous ι :=
uniform_inducing.uniform_continuous pkg.uniform_inducing

lemma continuous_coe : continuous ι :=
pkg.uniform_continuous_coe.continuous

@[elab_as_eliminator]
lemma induction_on {p : hatα → Prop}
  (a : hatα) (hp : is_closed {a | p a}) (ih : ∀ a, p (ι a)) : p a :=
is_closed_property pkg.dense hp ih a

variables {β : Type*} [uniform_space β]

protected lemma funext [t2_space β] {f g : hatα → β} (hf : continuous f) (hg : continuous g)
  (h : ∀ a, f (ι a) = g (ι a)) : f = g :=
funext $ assume a, pkg.induction_on a (is_closed_eq hf hg) h

section extend
/-- Extension of maps to completions -/
protected def extend (f : α → β) : hatα → β :=
if uniform_continuous f then
  pkg.dense_inducing.extend f
else
  λ x, f (pkg.dense.some x)

variables {f : α → β}

lemma extend_def (hf : uniform_continuous f) : pkg.extend f = pkg.dense_inducing.extend f :=
if_pos hf

lemma extend_coe [t2_space β] (hf : uniform_continuous f) (a : α) :
(pkg.extend f) (ι a) = f a :=
begin
  rw pkg.extend_def hf,
  exact pkg.dense_inducing.extend_eq hf.continuous a
end

variables [complete_space β] [separated_space β]

lemma uniform_continuous_extend : uniform_continuous (pkg.extend f) :=
begin
  by_cases hf : uniform_continuous f,
  { rw pkg.extend_def hf,
    exact uniform_continuous_uniformly_extend (pkg.uniform_inducing)
      (pkg.dense) hf },
  { change uniform_continuous (ite _ _ _),
    rw if_neg hf,
    exact uniform_continuous_of_const (assume a b, by congr) }
end

lemma continuous_extend : continuous (pkg.extend f) :=
pkg.uniform_continuous_extend.continuous

lemma extend_unique (hf : uniform_continuous f) {g : hatα → β} (hg : uniform_continuous g)
  (h : ∀ a : α, f a = g (ι a)) : pkg.extend f = g :=
begin
  apply pkg.funext pkg.continuous_extend hg.continuous,
  simpa only [pkg.extend_coe hf] using h
end

@[simp] lemma extend_comp_coe {f : hatα → β} (hf : uniform_continuous f) :
  pkg.extend (f ∘ ι) = f :=
funext $ λ x, pkg.induction_on x (is_closed_eq pkg.continuous_extend hf.continuous)
    (λ y, pkg.extend_coe (hf.comp $ pkg.uniform_continuous_coe) y)

end extend

section map_sec

variables (pkg' : abstract_completion β)
local notation `hatβ` := pkg'.space
local notation `ι'` := pkg'.coe

/-- Lifting maps to completions -/
protected def map (f : α → β) : hatα → hatβ := pkg.extend (ι' ∘ f)

local notation `map` := pkg.map pkg'

variables (f : α → β)

lemma uniform_continuous_map : uniform_continuous (map f) :=
pkg.uniform_continuous_extend

lemma continuous_map : continuous (map f) := pkg.continuous_extend

variables {f}

@[simp] lemma map_coe (hf : uniform_continuous f) (a : α) : map f (ι a) = ι' (f a) :=
pkg.extend_coe (pkg'.uniform_continuous_coe.comp hf) a

lemma map_unique {f : α → β} {g : hatα → hatβ}
  (hg : uniform_continuous g) (h : ∀ a, ι' (f a) = g (ι a)) : map f = g :=
pkg.funext (pkg.continuous_map _ _) hg.continuous $
begin
  intro a,
  change pkg.extend (ι' ∘ f) _ = _,
  simp only [(∘), h],
  rw [pkg.extend_coe (hg.comp pkg.uniform_continuous_coe)]
end

@[simp] lemma map_id : pkg.map pkg id = id :=
pkg.map_unique pkg uniform_continuous_id (assume a, rfl)

variables {γ : Type*} [uniform_space γ]

lemma extend_map [complete_space γ] [separated_space γ] {f : β → γ} {g : α → β}
  (hf : uniform_continuous f) (hg : uniform_continuous g) :
  pkg'.extend f ∘ map g = pkg.extend (f ∘ g) :=
pkg.funext (pkg'.continuous_extend.comp (pkg.continuous_map pkg' _)) pkg.continuous_extend $ λ a,
  by rw [pkg.extend_coe (hf.comp hg), comp_app, pkg.map_coe pkg' hg, pkg'.extend_coe hf]

variables (pkg'' : abstract_completion γ)

lemma map_comp {g : β → γ} {f : α → β} (hg : uniform_continuous g) (hf : uniform_continuous f) :
  (pkg'.map pkg'' g) ∘ (pkg.map pkg' f) = pkg.map pkg'' (g ∘ f) :=
pkg.extend_map pkg' (pkg''.uniform_continuous_coe.comp hg) hf

end map_sec

section compare
-- We can now compare two completion packages for the same uniform space

variables (pkg' : abstract_completion α)

/-- The comparison map between two completions of the same uniform space. -/
def compare : pkg.space → pkg'.space :=
pkg.extend pkg'.coe

lemma compare_coe (a : α) : pkg.compare pkg' (pkg.coe a) = pkg'.coe a :=
pkg.extend_coe pkg'.uniform_continuous_coe a

lemma inverse_compare : (pkg.compare pkg') ∘ (pkg'.compare pkg) = id :=
begin
  have uc := pkg.uniform_continuous_compare pkg',
  have uc' := pkg'.uniform_continuous_compare pkg,
  apply pkg'.funext (uc.comp uc').continuous continuous_id,
  intro a,
  rw [comp_app, pkg'.compare_coe pkg, pkg.compare_coe pkg'],
  refl
end

/-- The bijection between two completions of the same uniform space. -/
def compare_equiv : pkg.space ≃ pkg'.space :=
{ to_fun := pkg.compare pkg',
  inv_fun := pkg'.compare pkg,
  left_inv := congr_fun (pkg'.inverse_compare pkg),
  right_inv := congr_fun (pkg.inverse_compare pkg') }

lemma uniform_continuous_compare_equiv : uniform_continuous (pkg.compare_equiv pkg') :=
pkg.uniform_continuous_compare pkg'

lemma uniform_continuous_compare_equiv_symm : uniform_continuous (pkg.compare_equiv pkg').symm :=
pkg'.uniform_continuous_compare pkg

end compare

section prod
variables (pkg' : abstract_completion β)
local notation `hatβ` := pkg'.space
local notation `ι'` := pkg'.coe

/-- Products of completions -/
protected def prod : abstract_completion (α × β) :=
{ space := hatα × hatβ,
  coe := λ p, ⟨ι p.1, ι' p.2⟩,
  uniform_struct := prod.uniform_space,
  complete := by apply_instance,
  separation := by apply_instance,
  uniform_inducing := uniform_inducing.prod pkg.uniform_inducing pkg'.uniform_inducing,
  dense := pkg.dense.prod_map pkg'.dense }
end prod

section extension₂
variables (pkg' : abstract_completion β)
local notation `hatβ` := pkg'.space
local notation `ι'` := pkg'.coe

variables {γ : Type*} [uniform_space γ]

open function

/-- Extend two variable map to completions. -/
protected def extend₂ (f : α → β → γ) : hatα → hatβ → γ :=
curry $ (pkg.prod pkg').extend (uncurry f)

variables [separated_space γ] {f : α → β → γ}

lemma extension₂_coe_coe (hf : uniform_continuous $ uncurry f) (a : α) (b : β) :
  pkg.extend₂ pkg' f (ι a) (ι' b) = f a b :=
show (pkg.prod pkg').extend (uncurry f) ((pkg.prod pkg').coe (a, b)) = uncurry f (a, b),
  from (pkg.prod pkg').extend_coe hf _

variables [complete_space γ] (f)

lemma uniform_continuous_extension₂ : uniform_continuous₂ (pkg.extend₂ pkg' f) :=
begin
  rw [uniform_continuous₂_def, abstract_completion.extend₂, uncurry_curry],
  apply uniform_continuous_extend
end

end extension₂

section map₂
variables (pkg' : abstract_completion β)
local notation `hatβ` := pkg'.space
local notation `ι'` := pkg'.coe

variables {γ : Type*} [uniform_space γ] (pkg'' : abstract_completion γ)
local notation `hatγ` := pkg''.space
local notation `ι''` := pkg''.coe

local notation f `∘₂` g := bicompr f g

/-- Lift two variable maps to completions. -/
protected def map₂ (f : α → β → γ) : hatα → hatβ → hatγ :=
pkg.extend₂ pkg' (pkg''.coe ∘₂ f)

lemma uniform_continuous_map₂ (f : α → β → γ) : uniform_continuous₂ (pkg.map₂ pkg' pkg'' f) :=
pkg.uniform_continuous_extension₂ pkg' _

lemma continuous_map₂ {δ} [topological_space δ] {f : α → β → γ}
  {a : δ → hatα} {b : δ → hatβ} (ha : continuous a) (hb : continuous b) :
  continuous (λd:δ, pkg.map₂ pkg' pkg'' f (a d) (b d)) :=
((pkg.uniform_continuous_map₂ pkg' pkg'' f).continuous.comp (continuous.prod_mk ha hb) : _)

lemma map₂_coe_coe (a : α) (b : β) (f : α → β → γ) (hf : uniform_continuous₂ f) :
  pkg.map₂ pkg' pkg'' f (ι a) (ι' b) = ι'' (f a b) :=
pkg.extension₂_coe_coe pkg' (pkg''.uniform_continuous_coe.comp hf) a b

end map₂
end abstract_completion


/-
Copyright (c) 2018 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison, Reid Barton, Simon Hudon, Kenny Lau

! This file was ported from Lean 3 source module data.opposite
! leanprover-community/mathlib commit 448144f7ae193a8990cb7473c9e9a01990f64ac7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Logic.Equiv.Defs

/-!
# Opposites

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

In this file we define a type synonym `opposite α := α`, denoted by `αᵒᵖ` and two synonyms for the
identity map, `op : α → αᵒᵖ` and `unop : αᵒᵖ → α`. If `α` is a category, then `αᵒᵖ` is the opposite
category, with all arrows reversed.
-/

universe v u

-- morphism levels before object levels. See note [category_theory universes].
variable (α : Sort u)

#print Opposite /-
/-- The type of objects of the opposite of `α`; used to define the opposite category.

  In order to avoid confusion between `α` and its opposite type, we
  set up the type of objects `opposite α` using the following pattern,
  which will be repeated later for the morphisms.

  1. Define `opposite α := α`.
  2. Define the isomorphisms `op : α → opposite α`, `unop : opposite α → α`.
  3. Make the definition `opposite` irreducible.

  This has the following consequences.

  * `opposite α` and `α` are distinct types in the elaborator, so you
    must use `op` and `unop` explicitly to convert between them.
  * Both `unop (op X) = X` and `op (unop X) = X` are definitional
    equalities. Notably, every object of the opposite category is
    definitionally of the form `op X`, which greatly simplifies the
    definition of the structure of the opposite category, for example.

  (If Lean supported definitional eta equality for records, we could
  achieve the same goals using a structure with one field.)
-/
def Opposite : Sort u :=
  α
#align opposite Opposite
-/

-- mathport name: «expr ᵒᵖ»
notation:max -- Use a high right binding power (like that of postfix ⁻¹) so that, for example,
-- `presheaf Cᵒᵖ` parses as `presheaf (Cᵒᵖ)` and not `(presheaf C)ᵒᵖ`.
α "ᵒᵖ" => Opposite α

namespace Opposite

variable {α}

#print Opposite.op /-
/-- The canonical map `α → αᵒᵖ`. -/
@[pp_nodot]
def op : α → αᵒᵖ :=
  id
#align opposite.op Opposite.op
-/

#print Opposite.unop /-
/-- The canonical map `αᵒᵖ → α`. -/
@[pp_nodot]
def unop : αᵒᵖ → α :=
  id
#align opposite.unop Opposite.unop
-/

#print Opposite.op_injective /-
theorem op_injective : Function.Injective (op : α → αᵒᵖ) := fun _ _ => id
#align opposite.op_injective Opposite.op_injective
-/

#print Opposite.unop_injective /-
theorem unop_injective : Function.Injective (unop : αᵒᵖ → α) := fun _ _ => id
#align opposite.unop_injective Opposite.unop_injective
-/

#print Opposite.op_unop /-
@[simp]
theorem op_unop (x : αᵒᵖ) : op (unop x) = x :=
  rfl
#align opposite.op_unop Opposite.op_unop
-/

#print Opposite.unop_op /-
@[simp]
theorem unop_op (x : α) : unop (op x) = x :=
  rfl
#align opposite.unop_op Opposite.unop_op
-/

#print Opposite.op_inj_iff /-
-- We could prove these by `iff.rfl`, but that would make these eligible for `dsimp`. That would be
-- a bad idea because `opposite` is irreducible.
@[simp]
theorem op_inj_iff (x y : α) : op x = op y ↔ x = y :=
  op_injective.eq_iff
#align opposite.op_inj_iff Opposite.op_inj_iff
-/

#print Opposite.unop_inj_iff /-
@[simp]
theorem unop_inj_iff (x y : αᵒᵖ) : unop x = unop y ↔ x = y :=
  unop_injective.eq_iff
#align opposite.unop_inj_iff Opposite.unop_inj_iff
-/

#print Opposite.equivToOpposite /-
/-- The type-level equivalence between a type and its opposite. -/
def equivToOpposite : α ≃ αᵒᵖ where
  toFun := op
  invFun := unop
  left_inv := unop_op
  right_inv := op_unop
#align opposite.equiv_to_opposite Opposite.equivToOpposite
-/

#print Opposite.equivToOpposite_coe /-
@[simp]
theorem equivToOpposite_coe : (equivToOpposite : α → αᵒᵖ) = op :=
  rfl
#align opposite.equiv_to_opposite_coe Opposite.equivToOpposite_coe
-/

#print Opposite.equivToOpposite_symm_coe /-
@[simp]
theorem equivToOpposite_symm_coe : (equivToOpposite.symm : αᵒᵖ → α) = unop :=
  rfl
#align opposite.equiv_to_opposite_symm_coe Opposite.equivToOpposite_symm_coe
-/

#print Opposite.op_eq_iff_eq_unop /-
theorem op_eq_iff_eq_unop {x : α} {y} : op x = y ↔ x = unop y :=
  equivToOpposite.apply_eq_iff_eq_symm_apply
#align opposite.op_eq_iff_eq_unop Opposite.op_eq_iff_eq_unop
-/

#print Opposite.unop_eq_iff_eq_op /-
theorem unop_eq_iff_eq_op {x} {y : α} : unop x = y ↔ x = op y :=
  equivToOpposite.symm.apply_eq_iff_eq_symm_apply
#align opposite.unop_eq_iff_eq_op Opposite.unop_eq_iff_eq_op
-/

instance [Inhabited α] : Inhabited αᵒᵖ :=
  ⟨op default⟩

#print Opposite.rec /-
/-- A recursor for `opposite`. Use as `induction x using opposite.rec`. -/
@[simp]
protected def rec {F : ∀ X : αᵒᵖ, Sort v} (h : ∀ X, F (op X)) : ∀ X, F X := fun X => h (unop X)
#align opposite.rec Opposite.rec
-/

end Opposite

namespace Tactic

open Opposite

namespace OpInduction

/-- Test if `e : expr` is of type `opposite α` for some `α`. -/
unsafe def is_opposite (e : expr) : tactic Bool := do
  let t ← infer_type e
  let q(Opposite _) ← whnf t |
    return false
  return tt
#align tactic.op_induction.is_opposite tactic.op_induction.is_opposite

/-- Find the first hypothesis of type `opposite _`. Fail if no such hypothesis exist in the local
context. -/
unsafe def find_opposite_hyp : tactic Name := do
  let lc ← local_context
  let h :: _ ← lc.filterM <| is_opposite |
    fail "No hypotheses of the form Xᵒᵖ"
  return h
#align tactic.op_induction.find_opposite_hyp tactic.op_induction.find_opposite_hyp

end OpInduction

open OpInduction

/-- A version of `induction x using opposite.rec` which finds the appropriate hypothesis
automatically, for use with `local attribute [tidy] op_induction'`. This is necessary because
`induction x` is not able to deduce that `opposite.rec` should be used. -/
unsafe def op_induction' : tactic Unit := do
  let h ← find_opposite_hyp
  let h' ← tactic.get_local h
  tactic.induction' h' [] `opposite.rec
#align tactic.op_induction' tactic.op_induction'

end Tactic


/-
Copyright (c) 2018 Kenny Lau. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kenny Lau, Mario Carneiro, Johan Commelin
-/
import tactic.ring data.quot data.equiv.algebra ring_theory.ideal_operations group_theory.submonoid

universes u v

namespace localization
variables (α : Type u) [comm_ring α] (S : set α) [is_submonoid S]

def r (x y : α × S) : Prop :=
∃ t ∈ S, ((x.2 : α) * y.1 - y.2 * x.1) * t = 0

local infix ≈ := r α S

section
variables {α S}
theorem r_of_eq {a₀ a₁ : α × S} (h : (a₀.2 : α) * a₁.1 = a₁.2 * a₀.1) : a₀ ≈ a₁ :=
⟨1, is_submonoid.one_mem S, by rw [h, sub_self, mul_one]⟩
end

theorem refl (x : α × S) : x ≈ x := r_of_eq rfl

theorem symm (x y : α × S) : x ≈ y → y ≈ x :=
λ ⟨t, hts, ht⟩, ⟨t, hts, by rw [← neg_sub, ← neg_mul_eq_neg_mul, ht, neg_zero]⟩

theorem trans : ∀ (x y z : α × S), x ≈ y → y ≈ z → x ≈ z :=
λ ⟨r₁, s₁, hs₁⟩ ⟨r₂, s₂, hs₂⟩ ⟨r₃, s₃, hs₃⟩ ⟨t, hts, ht⟩ ⟨t', hts', ht'⟩,
⟨s₂ * t' * t, is_submonoid.mul_mem (is_submonoid.mul_mem hs₂ hts') hts,
  calc (s₁ * r₃ - s₃ * r₁) * (s₂ * t' * t) =
    t' * s₃ * ((s₁ * r₂ - s₂ * r₁) * t) + t * s₁ * ((s₂ * r₃ - s₃ * r₂) * t') :
      by simp [mul_left_comm, mul_add, mul_comm]
    ... = 0 : by simp only [subtype.coe_mk] at ht ht'; rw [ht, ht']; simp⟩

instance : setoid (α × S) :=
⟨r α S, refl α S, symm α S, trans α S⟩

end localization

/-- The localization of a ring at a submonoid:
 the elements of the submonoid become invertible in the localization.-/
def localization (α : Type u) [comm_ring α] (S : set α) [is_submonoid S] :=
quotient $ localization.setoid α S

namespace localization
variables (α : Type u) [comm_ring α] (S : set α) [is_submonoid S]

instance : has_add (localization α S) :=
⟨quotient.lift₂
  (λ x y : α × S, (⟦⟨x.2 * y.1 + y.2 * x.1, x.2 * y.2⟩⟧ : localization α S)) $
  λ ⟨r₁, s₁, hs₁⟩ ⟨r₂, s₂, hs₂⟩ ⟨r₃, s₃, hs₃⟩ ⟨r₄, s₄, hs₄⟩ ⟨t₅, hts₅, ht₅⟩ ⟨t₆, hts₆, ht₆⟩,
  quotient.sound ⟨t₆ * t₅, is_submonoid.mul_mem hts₆ hts₅,
    calc (s₁ * s₂ * (s₃ * r₄ + s₄ * r₃) - s₃ * s₄ * (s₁ * r₂ + s₂ * r₁)) * (t₆ * t₅) =
      s₁ * s₃ * ((s₂ * r₄ - s₄ * r₂) * t₆) * t₅ + s₂ * s₄ * ((s₁ * r₃ - s₃ * r₁) * t₅) * t₆ : by ring
      ... = 0 : by simp only [subtype.coe_mk] at ht₅ ht₆; rw [ht₆, ht₅]; simp⟩⟩

instance : has_neg (localization α S) :=
⟨quotient.lift (λ x : α × S, (⟦⟨-x.1, x.2⟩⟧ : localization α S)) $
  λ ⟨r₁, s₁, hs₁⟩ ⟨r₂, s₂, hs₂⟩ ⟨t, hts, ht⟩,
  quotient.sound ⟨t, hts,
    calc (s₁ * -r₂ - s₂ * -r₁) * t = -((s₁ * r₂ - s₂ * r₁) * t) : by ring
      ... = 0 : by simp only [subtype.coe_mk] at ht; rw ht; simp⟩⟩

instance : has_mul (localization α S) :=
⟨quotient.lift₂
  (λ x y : α × S, (⟦⟨x.1 * y.1, x.2 * y.2⟩⟧ : localization α S)) $
  λ ⟨r₁, s₁, hs₁⟩ ⟨r₂, s₂, hs₂⟩ ⟨r₃, s₃, hs₃⟩ ⟨r₄, s₄, hs₄⟩ ⟨t₅, hts₅, ht₅⟩ ⟨t₆, hts₆, ht₆⟩,
  quotient.sound ⟨t₆ * t₅, is_submonoid.mul_mem hts₆ hts₅,
    calc ((s₁ * s₂) * (r₃ * r₄) - (s₃ * s₄) * (r₁ * r₂)) * (t₆ * t₅) =
      t₆ * ((s₁ * r₃ - s₃ * r₁) * t₅) * r₂ * s₄ + t₅ * ((s₂ * r₄ - s₄ * r₂) * t₆) * r₃ * s₁ :
        by simp [mul_left_comm, mul_add, mul_comm]
      ... = 0 : by simp only [subtype.coe_mk] at ht₅ ht₆; rw [ht₅, ht₆]; simp⟩⟩

variables {α S}

def mk (r : α) (s : S) : localization α S := ⟦(r, s)⟧

/-- The natural map from the ring to the localization.-/
def of (r : α) : localization α S := mk r 1

instance : comm_ring (localization α S) :=
by refine
{ add            := has_add.add,
  add_assoc      := λ m n k, quotient.induction_on₃ m n k _,
  zero           := of 0,
  zero_add       := quotient.ind _,
  add_zero       := quotient.ind _,
  neg            := has_neg.neg,
  add_left_neg   := quotient.ind _,
  add_comm       := quotient.ind₂ _,
  mul            := has_mul.mul,
  mul_assoc      := λ m n k, quotient.induction_on₃ m n k _,
  one            := of 1,
  one_mul        := quotient.ind _,
  mul_one        := quotient.ind _,
  left_distrib   := λ m n k, quotient.induction_on₃ m n k _,
  right_distrib  := λ m n k, quotient.induction_on₃ m n k _,
  mul_comm       := quotient.ind₂ _ };
{ intros,
  try {rcases a with ⟨r₁, s₁, hs₁⟩},
  try {rcases b with ⟨r₂, s₂, hs₂⟩},
  try {rcases c with ⟨r₃, s₃, hs₃⟩},
  refine (quotient.sound $ r_of_eq _),
  simp [mul_left_comm, mul_add, mul_comm] }

instance of.is_ring_hom : is_ring_hom (of : α → localization α S) :=
{ map_add := λ x y, quotient.sound $ by simp,
  map_mul := λ x y, quotient.sound $ by simp,
  map_one := rfl }

variables {S}

instance : has_coe α (localization α S) := ⟨of⟩

instance coe.is_ring_hom : is_ring_hom (coe : α → localization α S) :=
localization.of.is_ring_hom

/-- The natural map from the submonoid to the unit group of the localization.-/
def to_units (s : S) : units (localization α S) :=
{ val := s,
  inv := mk 1 s,
  val_inv := quotient.sound $ r_of_eq $ mul_assoc _ _ _,
  inv_val := quotient.sound $ r_of_eq $ show s.val * 1 * 1 = 1 * (1 * s.val), by simp }

@[simp] lemma to_units_coe (s : S) : ((to_units s) : localization α S) = s := rfl

section
variables (α S) (x y : α) (n : ℕ)
@[simp] lemma of_zero : (of 0 : localization α S) = 0 := rfl
@[simp] lemma of_one : (of 1 : localization α S) = 1 := rfl
@[simp] lemma of_add : (of (x + y) : localization α S) = of x + of y :=
by apply is_ring_hom.map_add

@[simp] lemma of_sub : (of (x - y) : localization α S) = of x - of y :=
by apply is_ring_hom.map_sub

@[simp] lemma of_mul : (of (x * y) : localization α S) = of x * of y :=
by apply is_ring_hom.map_mul

@[simp] lemma of_neg : (of (-x) : localization α S) = -of x :=
by apply is_ring_hom.map_neg

@[simp] lemma of_pow : (of (x ^ n) : localization α S) = (of x) ^ n :=
by apply is_semiring_hom.map_pow

@[simp] lemma of_is_unit (s : S) : is_unit (of s : localization α S) :=
is_unit_unit $ to_units s

@[simp] lemma of_is_unit' (s ∈ S) : is_unit (of s : localization α S) :=
is_unit_unit $ to_units ⟨s, ‹s ∈ S›⟩

@[simp] lemma coe_zero : ((0 : α) : localization α S) = 0 := rfl
@[simp] lemma coe_one : ((1 : α) : localization α S) = 1 := rfl
@[simp] lemma coe_add : (↑(x + y) : localization α S) = x + y := of_add _ _ _ _
@[simp] lemma coe_sub : (↑(x - y) : localization α S) = x - y := of_sub _ _ _ _
@[simp] lemma coe_mul : (↑(x * y) : localization α S) = x * y := of_mul _ _ _ _
@[simp] lemma coe_neg : (↑(-x) : localization α S) = -x := of_neg _ _ _
@[simp] lemma coe_pow : (↑(x ^ n) : localization α S) = x ^ n := of_pow _ _ _ _
@[simp] lemma coe_is_unit (s : S) : is_unit (s : localization α S) := of_is_unit _ _ _
@[simp] lemma coe_is_unit' (s ∈ S) : is_unit (s : localization α S) := of_is_unit' _ _ _ ‹s ∈ S›
end

@[simp] lemma mk_self {x : α} {hx : x ∈ S} :
  (mk x ⟨x, hx⟩ : localization α S) = 1 :=
quotient.sound ⟨1, is_submonoid.one_mem S,
by simp only [subtype.coe_mk, is_submonoid.coe_one, mul_one, one_mul, sub_self]⟩

@[simp] lemma mk_self' {s : S} :
  (mk s s : localization α S) = 1 :=
by cases s; exact mk_self

@[simp] lemma mk_self'' {s : S} :
  (mk s.1 s : localization α S) = 1 :=
mk_self'

@[simp] lemma coe_mul_mk (x y : α) (s : S) :
  ↑x * mk y s = mk (x * y) s :=
quotient.sound $ r_of_eq $ by rw one_mul

lemma mk_eq_mul_mk_one (r : α) (s : S) :
  mk r s = r * mk 1 s :=
by rw [coe_mul_mk, mul_one]

@[simp] lemma mk_mul_mk (x y : α) (s t : S) :
  mk x s * mk y t = mk (x * y) (s * t) := rfl

@[simp] lemma mk_mul_cancel_left (r : α) (s : S) :
  mk (↑s * r) s = r :=
by rw [mk_eq_mul_mk_one, mul_comm ↑s, coe_mul,
       mul_assoc, ← mk_eq_mul_mk_one, mk_self', mul_one]

@[simp] lemma mk_mul_cancel_right (r : α) (s : S) :
  mk (r * s) s = r :=
by rw [mul_comm, mk_mul_cancel_left]

@[simp] lemma mk_eq (r : α) (s : S) :
  mk r s = r * ((to_units s)⁻¹ : units _) :=
quotient.sound $ by simp

@[elab_as_eliminator]
protected theorem induction_on {C : localization α S → Prop} (x : localization α S)
  (ih : ∀ r s, C (mk r s : localization α S)) : C x :=
by rcases x with ⟨r, s⟩; exact ih r s

section
variables {β : Type v} [comm_ring β] {T : set β} [is_submonoid T] (f : α → β) [is_ring_hom f]

@[elab_with_expected_type]
def lift' (g : S → units β) (hg : ∀ s, (g s : β) = f s) (x : localization α S) : β :=
quotient.lift_on x (λ p, f p.1 * ((g p.2)⁻¹ : units β)) $ λ ⟨r₁, s₁⟩ ⟨r₂, s₂⟩ ⟨t, hts, ht⟩,
show f r₁ * ↑(g s₁)⁻¹ = f r₂ * ↑(g s₂)⁻¹, from
calc  f r₁ * ↑(g s₁)⁻¹
    = (f r₁ * g s₂ + ((g s₁ * f r₂ - g s₂ * f r₁) * g ⟨t, hts⟩) * ↑(g ⟨t, hts⟩)⁻¹)
      * ↑(g s₁)⁻¹ * ↑(g s₂)⁻¹ :
  by simp only [hg, subtype.coe_mk, (is_ring_hom.map_mul f).symm, (is_ring_hom.map_sub f).symm,
                ht, is_ring_hom.map_zero f, zero_mul, add_zero];
     rw [is_ring_hom.map_mul f, ← hg, mul_right_comm,
         mul_assoc (f r₁), ← units.coe_mul, mul_inv_self];
     rw [units.coe_one, mul_one]
... = f r₂ * ↑(g s₂)⁻¹ :
  by rw [mul_assoc, mul_assoc, ← units.coe_mul, mul_inv_self, units.coe_one,
         mul_one, mul_comm ↑(g s₂), add_sub_cancel'_right];
     rw [mul_comm ↑(g s₁), ← mul_assoc, mul_assoc (f r₂), ← units.coe_mul,
         mul_inv_self, units.coe_one, mul_one]

instance lift'.is_ring_hom (g : S → units β) (hg : ∀ s, (g s : β) = f s) :
  is_ring_hom (localization.lift' f g hg) :=
{ map_one := have g 1 = 1, from units.ext (by rw hg; exact is_ring_hom.map_one f),
    show f 1 * ↑(g 1)⁻¹ = 1, by rw [this, one_inv, units.coe_one, mul_one, is_ring_hom.map_one f],
  map_mul := λ x y, localization.induction_on x $ λ r₁ s₁,
    localization.induction_on y $ λ r₂ s₂,
    have g (s₁ * s₂) = g s₁ * g s₂,
      from units.ext (by simp only [hg, units.coe_mul]; exact is_ring_hom.map_mul f),
    show _ * ↑(g (_ * _))⁻¹ = (_ * _) * (_ * _),
    by simp only [subtype.coe_mk, mul_one, one_mul, subtype.coe_eta, this, mul_inv_rev];
       rw [is_ring_hom.map_mul f, units.coe_mul, ← mul_assoc, ← mul_assoc];
       simp only [mul_right_comm],
  map_add := λ x y, localization.induction_on x $ λ r₁ s₁,
    localization.induction_on y $ λ r₂ s₂,
    have g (s₁ * s₂) = g s₁ * g s₂,
      from units.ext (by simp only [hg, units.coe_mul]; exact is_ring_hom.map_mul f),
    show _ * ↑(g (_ * _))⁻¹ = _ * _ + _ * _,
    by simp only [subtype.coe_mk, mul_one, one_mul, subtype.coe_eta, this, mul_inv_rev];
       simp only [is_ring_hom.map_mul f, is_ring_hom.map_add f, add_mul, (hg _).symm];
       simp only [mul_assoc, mul_comm, mul_left_comm, (units.coe_mul _ _).symm];
       rw [mul_inv_cancel_left, mul_left_comm, ← mul_assoc, mul_inv_cancel_right, add_comm] }

noncomputable def lift (h : ∀ s ∈ S, is_unit (f s)) :
  localization α S → β :=
localization.lift' f (λ s, classical.some $ h s.1 s.2)
  (λ s, by rw [← classical.some_spec (h s.1 s.2)]; refl)

instance lift.is_ring_hom (h : ∀ s ∈ S, is_unit (f s)) :
  is_ring_hom (lift f h) :=
lift'.is_ring_hom _ _ _

@[simp] lemma lift'_mk (g : S → units β) (hg : ∀ s, (g s : β) = f s) (r : α) (s : S) :
  lift' f g hg (mk r s) = f r * ↑(g s)⁻¹ := rfl

@[simp] lemma lift'_of (g : S → units β) (hg : ∀ s, (g s : β) = f s) (a : α) :
  lift' f g hg (of a) = f a :=
have g 1 = 1, from units.ext_iff.2 $ by simp [hg, is_ring_hom.map_one f],
by simp [lift', quotient.lift_on_beta, of, mk, this]

@[simp] lemma lift'_coe (g : S → units β) (hg : ∀ s, (g s : β) = f s) (a : α) :
  lift' f g hg a = f a := lift'_of _ _ _ _

@[simp] lemma lift_of (h : ∀ s ∈ S, is_unit (f s)) (a : α) :
  lift f h (of a) = f a := lift'_of _ _ _ _

@[simp] lemma lift_coe (h : ∀ s ∈ S, is_unit (f s)) (a : α) :
  lift f h a = f a := lift'_of _ _ _ _

@[simp] lemma lift'_comp_of (g : S → units β) (hg : ∀ s, (g s : β) = f s) :
  lift' f g hg ∘ of = f := funext $ λ a, lift'_of _ _ _ a

@[simp] lemma lift_comp_of (h : ∀ s ∈ S, is_unit (f s)) :
  lift f h ∘ of = f := lift'_comp_of _ _ _

@[simp] lemma lift'_apply_coe (f : localization α S → β) [is_ring_hom f]
  (g : S → units β) (hg : ∀ s, (g s : β) = f s) :
  lift' (λ a : α, f a) g hg = f :=
have g = (λ s, units.map f (to_units s)),
  from funext $ λ x, units.ext_iff.2 $ (hg x).symm ▸ rfl,
funext $ λ x, localization.induction_on x
  (λ r s, by subst this; rw [lift'_mk, ← is_group_hom.inv (units.map f), units.coe_map];
    simp [is_ring_hom.map_mul f])

@[simp] lemma lift_apply_coe (f : localization α S → β) [is_ring_hom f] :
  lift (λ a : α, f a) (λ s hs, is_unit_unit (units.map f (to_units ⟨s, hs⟩))) = f :=
by rw [lift, lift'_apply_coe]

/-- Function extensionality for localisations:
 two functions are equal if they agree on elements that are coercions.-/
protected lemma funext (f g : localization α S → β) [is_ring_hom f] [is_ring_hom g]
  (h : ∀ a : α, f a = g a) : f = g :=
begin
  rw [← lift_apply_coe f, ← lift_apply_coe g],
  congr' 1,
  exact funext h
end

variables {α S T}

def map (hf : ∀ s ∈ S, f s ∈ T) : localization α S → localization β T :=
lift' (of ∘ f) (to_units ∘ subtype.map f hf) (λ s, rfl)

instance map.is_ring_hom (hf : ∀ s ∈ S, f s ∈ T) : is_ring_hom (map f hf) :=
lift'.is_ring_hom _ _ _

@[simp] lemma map_of (hf : ∀ s ∈ S, f s ∈ T) (a : α) :
  map f hf (of a) = of (f a) := lift'_of _ _ _ _

@[simp] lemma map_coe (hf : ∀ s ∈ S, f s ∈ T) (a : α) :
  map f hf a = (f a) := lift'_of _ _ _ _

@[simp] lemma map_comp_of (hf : ∀ s ∈ S, f s ∈ T) :
  map f hf ∘ of = of ∘ f := funext $ λ a, map_of _ _ _

@[simp] lemma map_id : map id (λ s (hs : s ∈ S), hs) = id :=
localization.funext _ _ $ map_coe _ _

lemma map_comp_map {γ : Type*} [comm_ring γ]  (hf : ∀ s ∈ S, f s ∈ T) (U : set γ)
  [is_submonoid U] (g : β → γ) [is_ring_hom g] (hg : ∀ t ∈ T, g t ∈ U) :
  map g hg ∘ map f hf = map (λ x, g (f x)) (λ s hs, hg _ (hf _ hs)) :=
localization.funext _ _ $ by simp

lemma map_map {γ : Type*} [comm_ring γ]  (hf : ∀ s ∈ S, f s ∈ T) (U : set γ)
  [is_submonoid U] (g : β → γ) [is_ring_hom g] (hg : ∀ t ∈ T, g t ∈ U) (x) :
  map g hg (map f hf x) = map (λ x, g (f x)) (λ s hs, hg _ (hf _ hs)) x :=
congr_fun (map_comp_map _ _ _ _ _) x

def equiv_of_equiv (h₁ : α ≃r β) (h₂ : h₁.to_equiv '' S = T) :
  localization α S ≃r localization β T :=
{ to_fun := map h₁.to_equiv $ λ s hs, by {rw ← h₂, simp [hs]},
  inv_fun := map h₁.symm.to_equiv $ λ t ht,
    by simp [equiv.image_eq_preimage, set.preimage, set.ext_iff, *] at *,
  left_inv := λ _, by simp only [map_map, ring_equiv.to_equiv_symm_apply,
    equiv.symm_apply_apply]; erw map_id; refl,
  right_inv := λ _, by simp only [map_map, ring_equiv.to_equiv_symm_apply,
    equiv.apply_symm_apply]; erw map_id; refl,
  hom := map.is_ring_hom _ _ }

end

section away
variables {β : Type v} [comm_ring β] (f : α → β) [is_ring_hom f]

@[reducible] def away (x : α) := localization α (powers x)

@[simp] def away.inv_self (x : α) : away x :=
mk 1 ⟨x, 1, pow_one x⟩

@[elab_with_expected_type]
noncomputable def away.lift {x : α} (hfx : is_unit (f x)) : away x → β :=
localization.lift' f (λ s, classical.some hfx ^ classical.some s.2) $ λ s,
by rw [units.coe_pow, ← classical.some_spec hfx,
       ← is_semiring_hom.map_pow f, classical.some_spec s.2]; refl

instance away.lift.is_ring_hom {x : α} (hfx : is_unit (f x)) :
  is_ring_hom (localization.away.lift f hfx) :=
lift'.is_ring_hom _ _ _

@[simp] lemma away.lift_of {x : α} (hfx : is_unit (f x)) (a : α) :
  away.lift f hfx (of a) = f a := lift'_of _ _ _ _

@[simp] lemma away.lift_coe {x : α} (hfx : is_unit (f x)) (a : α) :
  away.lift f hfx a = f a := lift'_of _ _ _ _

@[simp] lemma away.lift_comp_of {x : α} (hfx : is_unit (f x)) :
  away.lift f hfx ∘ of = f := lift'_comp_of _ _ _

noncomputable def away_to_away_right (x y : α) : away x → away (x * y) :=
localization.away.lift coe $
is_unit_of_mul_one x (y * away.inv_self (x * y)) $
by rw [away.inv_self, coe_mul_mk, coe_mul_mk, mul_one, mk_self]

instance away_to_away_right.is_ring_hom (x y : α) :
  is_ring_hom (away_to_away_right x y) :=
away.lift.is_ring_hom _ _

end away

section at_prime

variables (P : ideal α) [hp : ideal.is_prime P]
include hp

instance prime.is_submonoid :
  is_submonoid (-P : set α) :=
{ one_mem := P.ne_top_iff_one.1 hp.1,
  mul_mem := λ x y hnx hny hxy, or.cases_on (hp.2 hxy) hnx hny }

@[reducible] def at_prime := localization α (-P)

instance at_prime.local_ring : is_local_ring (at_prime P) :=
local_of_nonunits_ideal
  (λ hze,
    let ⟨t, hts, ht⟩ := quotient.exact hze in
    hts $ have htz : t = 0, by simpa using ht,
      suffices (0:α) ∈ P, by rwa htz,
      P.zero_mem)
  (begin
    rintro ⟨⟨r₁, s₁, hs₁⟩⟩ ⟨⟨r₂, s₂, hs₂⟩⟩ hx hy hu,
    rcases is_unit_iff_exists_inv.1 hu with ⟨⟨⟨r₃, s₃, hs₃⟩⟩, hz⟩,
    rcases quotient.exact hz with ⟨t, hts, ht⟩,
    simp at ht,
    have : ∀ {r s hs}, (⟦⟨r, s, hs⟩⟧ : at_prime P) ∈ nonunits (at_prime P) → r ∈ P,
    { haveI := classical.dec,
      exact λ r s hs, not_imp_comm.1 (λ nr,
        is_unit_iff_exists_inv.2 ⟨⟦⟨s, r, nr⟩⟧,
          quotient.sound $ r_of_eq $ by simp [mul_comm]⟩) },
    have hr₃ := (hp.mem_or_mem_of_mul_eq_zero ht).resolve_right hts,
    have := (ideal.add_mem_iff_left _ _).1 hr₃,
    { exact not_or (mt hp.mem_or_mem (not_or hs₁ hs₂)) hs₃ (hp.mem_or_mem this) },
    { exact P.neg_mem (P.mul_mem_right
        (P.add_mem (P.mul_mem_left (this hy)) (P.mul_mem_left (this hx)))) }
  end)

end at_prime

variable (α)

def non_zero_divisors : set α := {x | ∀ z, z * x = 0 → z = 0}

instance non_zero_divisors.is_submonoid : is_submonoid (non_zero_divisors α) :=
{ one_mem := λ z hz, by rwa mul_one at hz,
  mul_mem := λ x₁ x₂ hx₁ hx₂ z hz,
    have z * x₁ * x₂ = 0, by rwa mul_assoc,
    hx₁ z $ hx₂ (z * x₁) this }

@[simp] lemma non_zero_divisors_one_val : (1 : non_zero_divisors α).val = 1 := rfl

/-- The field of fractions of an integral domain.-/
@[reducible] def fraction_ring := localization α (non_zero_divisors α)

namespace fraction_ring
open function
variables {β : Type u} [integral_domain β] [decidable_eq β]

lemma eq_zero_of_ne_zero_of_mul_eq_zero {x y : β} :
  x ≠ 0 → y * x = 0 → y = 0 :=
λ hnx hxy, or.resolve_right (eq_zero_or_eq_zero_of_mul_eq_zero hxy) hnx

lemma mem_non_zero_divisors_iff_ne_zero {x : β} :
  x ∈ non_zero_divisors β ↔ x ≠ 0 :=
⟨λ hm hz, zero_ne_one (hm 1 $ by rw [hz, one_mul]).symm,
 λ hnx z, eq_zero_of_ne_zero_of_mul_eq_zero hnx⟩

variable (β)

def inv_aux (x : β × (non_zero_divisors β)) : fraction_ring β :=
if h : x.1 = 0 then 0 else ⟦⟨x.2, x.1, mem_non_zero_divisors_iff_ne_zero.mpr h⟩⟧

instance : has_inv (fraction_ring β) :=
⟨quotient.lift (inv_aux β) $
  λ ⟨r₁, s₁, hs₁⟩ ⟨r₂, s₂, hs₂⟩ ⟨t, hts, ht⟩,
  begin
    have hrs : s₁ * r₂ = 0 + s₂ * r₁,
      from sub_eq_iff_eq_add.1 (hts _ ht),
    by_cases hr₁ : r₁ = 0;
    by_cases hr₂ : r₂ = 0;
    simp [hr₁, hr₂] at hrs;
    simp only [inv_aux, hr₁, hr₂, dif_pos, dif_neg, not_false_iff, subtype.coe_mk, quotient.eq],
    { exfalso,
      exact mem_non_zero_divisors_iff_ne_zero.mp hs₁ hrs },
    { exfalso,
      exact mem_non_zero_divisors_iff_ne_zero.mp hs₂ hrs },
    { apply r_of_eq,
      simpa [mul_comm] using hrs.symm }
  end⟩

lemma mk_inv {r s} :
  (mk r s : fraction_ring β)⁻¹ =
  if h : r = 0 then 0 else ⟦⟨s, r, mem_non_zero_divisors_iff_ne_zero.mpr h⟩⟧ := rfl

lemma mk_inv' :
  ∀ (x : β × (non_zero_divisors β)), (⟦x⟧⁻¹ : fraction_ring β) =
  if h : x.1 = 0 then 0 else ⟦⟨x.2.val, x.1, mem_non_zero_divisors_iff_ne_zero.mpr h⟩⟧
| ⟨r,s,hs⟩ := rfl

instance : decidable_eq (fraction_ring β) :=
@quotient.decidable_eq (β × non_zero_divisors β) (localization.setoid β (non_zero_divisors β)) $
λ ⟨r₁, s₁, hs₁⟩ ⟨r₂, s₂, hs₂⟩, show decidable (∃ t ∈ non_zero_divisors β, (s₁ * r₂ - s₂ * r₁) * t = 0),
from decidable_of_iff (s₁ * r₂ - s₂ * r₁ = 0)
⟨λ H, ⟨1, λ y, (mul_one y).symm ▸ id, H.symm ▸ zero_mul _⟩,
λ ⟨t, ht1, ht2⟩, or.resolve_right (mul_eq_zero.1 ht2) $ λ ht,
  one_ne_zero (ht1 1 ((one_mul t).symm ▸ ht))⟩

instance : discrete_field (fraction_ring β) :=
by refine
{ inv            := has_inv.inv,
  zero_ne_one    := λ hzo,
    let ⟨t, hts, ht⟩ := quotient.exact hzo in
    zero_ne_one (by simpa using hts _ ht : 0 = 1),
  mul_inv_cancel := quotient.ind _,
  inv_mul_cancel := quotient.ind _,
  has_decidable_eq := fraction_ring.decidable_eq β,
  inv_zero := dif_pos rfl,
  .. localization.comm_ring };
{ intros x hnx,
  rcases x with ⟨x, z, hz⟩,
  have : x ≠ 0,
    from assume hx, hnx (quotient.sound $ r_of_eq $ by simp [hx]),
  simp only [has_inv.inv, inv_aux, quotient.lift_beta, dif_neg this],
  exact (quotient.sound $ r_of_eq $ by simp [mul_comm]) }

@[simp] lemma mk_eq_div {r s} : (mk r s : fraction_ring β) = (r / s : fraction_ring β) :=
show _ = _ * dite (s.1 = 0) _ _, by rw [dif_neg (mem_non_zero_divisors_iff_ne_zero.mp s.2)];
exact localization.mk_eq_mul_mk_one _ _

variables {β}

@[simp] lemma mk_eq_div' (x : β × (non_zero_divisors β)) :
  (⟦x⟧ : fraction_ring β) = ((x.1) / ((x.2).val) : fraction_ring β) :=
by erw ← mk_eq_div; cases x; refl

lemma eq_zero_of (x : β) (h : (of x : fraction_ring β) = 0) : x = 0 :=
begin
  rcases quotient.exact h with ⟨t, ht, ht'⟩,
  simpa [mem_non_zero_divisors_iff_ne_zero.mp ht] using ht'
end

lemma of.injective : function.injective (of : β → fraction_ring β) :=
(is_add_group_hom.injective_iff _).mpr eq_zero_of

section map
open function is_ring_hom
variables {A : Type u} [integral_domain A] [decidable_eq A]
variables {B : Type v} [integral_domain B] [decidable_eq B]
variables (f : A → B) [is_ring_hom f]

def map (hf : injective f) : fraction_ring A → fraction_ring B :=
localization.map f $ λ s h,
  by rw [mem_non_zero_divisors_iff_ne_zero, ← map_zero f, ne.def, hf.eq_iff];
    exact mem_non_zero_divisors_iff_ne_zero.1 h

@[simp] lemma map_of (hf : injective f) (a : A) : map f hf (of a) = of (f a) :=
localization.map_of _ _ _

@[simp] lemma map_coe (hf : injective f) (a : A) : map f hf a = f a :=
localization.map_coe _ _ _

@[simp] lemma map_comp_of (hf : injective f) :
  map f hf ∘ (of : A → fraction_ring A) = (of : B → fraction_ring B) ∘ f :=
localization.map_comp_of _ _

instance map.is_field_hom (hf : injective f) : is_field_hom (map f hf) :=
localization.map.is_ring_hom _ _

def equiv_of_equiv (h : A ≃r B) : fraction_ring A ≃r fraction_ring B :=
localization.equiv_of_equiv h
begin
  ext b,
  rw [equiv.image_eq_preimage, set.preimage, set.mem_set_of_eq,
    mem_non_zero_divisors_iff_ne_zero, mem_non_zero_divisors_iff_ne_zero, ne.def],
  exact ⟨mt (λ h, h.symm ▸ is_ring_hom.map_zero _),
    mt ((is_add_group_hom.injective_iff _).1 h.to_equiv.symm.injective _)⟩
end

end map

end fraction_ring

section ideals

theorem map_comap (J : ideal (localization α S)) :
  ideal.map coe (ideal.comap (coe : α → localization α S) J) = J :=
le_antisymm (ideal.map_le_iff_le_comap.2 (le_refl _)) $ λ x,
localization.induction_on x $ λ r s hJ, (submodule.mem_coe _).2 $
mul_one r ▸ coe_mul_mk r 1 s ▸ (ideal.mul_mem_right _ $ ideal.mem_map_of_mem $
have _ := @ideal.mul_mem_left (localization α S) _ _ s _ hJ,
by rwa [coe_coe, coe_mul_mk, mk_mul_cancel_left] at this)

def le_order_embedding :
  ((≤) : ideal (localization α S) → ideal (localization α S) → Prop) ≼o
  ((≤) : ideal α → ideal α → Prop) :=
{ to_fun := λ J, ideal.comap coe J,
  inj := function.injective_of_left_inverse (map_comap α),
  ord := λ J₁ J₂, ⟨ideal.comap_mono, λ hJ,
    map_comap α J₁ ▸ map_comap α J₂ ▸ ideal.map_mono hJ⟩ }

end ideals

end localization


import analysis.normed_space.basic
import data.complex.basic

noncomputable theory

variables {α : Type*} {β : Type*}

open complex

class has_ℂ_inner_product (α : Type*) := (inner_product : α → α → ℂ)

export has_ℂ_inner_product (inner_product)

class ℂ_inner_product_space (α : Type*) [add_comm_group α] [vector_space ℂ α] extends has_ℂ_inner_product α :=
(conj_symm : ∀ (x y : α), inner_product x y = conj (inner_product y x))
(linearity : ∀ (x y z : α), ∀ (a : ℂ), inner_product (a • x + y) z = a * inner_product x z + inner_product y z)
(pos_def : ∀ (x : α), x ≠ 0 → (inner_product x x).re > 0)

variables [decidable_eq α] [add_comm_group α] [vector_space ℂ α] [ℂ_inner_product_space α]

precedence `†` : 70
infix `†` := inner_product

lemma conj_symm (x y : α) : x † y = conj (y † x) :=
by apply ℂ_inner_product_space.conj_symm

lemma linearity (x y z : α) (a : ℂ) : (a • x + y) † z = a * (x † z) + y † z :=
by apply ℂ_inner_product_space.linearity

@[simp] lemma add_in_fst_coord (x y z : α) : (x + y) † z = x † z + y † z :=
begin
    have h := linearity x y z 1,
    simp only [one_mul, one_smul] at h,
    exact h,
end

lemma pos_def (x : α) : x ≠ 0 → (inner_product x x).re > 0 :=
by apply ℂ_inner_product_space.pos_def

@[simp] lemma right_orthog_to_zero (x : α) : 0 † x = 0 :=
begin
    have h := linearity 0 0 x 1,
    simp only [add_zero, one_mul, smul_zero] at h,
    have w := @add_left_cancel ℂ _ (0†x) 0 (0†x),
    simp only [add_zero] at w,
    exact (w h).symm,
end

@[simp] lemma left_orthog_to_zero (x : α) : x † 0 = 0 :=
begin
    have h := right_orthog_to_zero x,
    rw conj_symm at h,
    simp only [complex.conj_eq_zero] at h,
    exact h,
end

@[simp] lemma mul_in_fst_coord (x z : α) (a : ℂ) : (a•x)†z = a*(x†z) :=
begin
    have h := linearity x 0 z a,
    simp only [right_orthog_to_zero, add_zero] at h,
    exact h,
end

def ip_self : α → ℂ := λ x, x†x

@[simp] lemma ip_self_zero : ip_self (0 : α) = 0 :=
begin
    dsimp [ip_self],
    exact (right_orthog_to_zero 0),
end

lemma zero_of_self_ip_zero (x : α) : ip_self x = 0 → x = 0 :=
begin
    intros h,
    by_contradiction,
    have w := pos_def x a,
    dsimp [ip_self] at h,
    have k : (x†x).re = 0, by {rw [h], refl},
    have k₁ : (x†x).re ≤ 0, by rw [←k],
    have k₂ := not_lt_of_le k₁,
    contradiction,
end

lemma zero_iff_ip_self_zero (x : α) : ip_self x=0 ↔ x=0 :=
begin
    split,

    exact zero_of_self_ip_zero x,

    intros h,
    rw [h],
    exact ip_self_zero,
end

@[simp] lemma ip_self_im_zero (x : α) : (ip_self x).im = 0 :=
begin
    have h := conj_symm x x,
    dsimp [ip_self],
    have h' := h.symm,
    rw [eq_conj_iff_real (x†x)] at h',
    cases h' with r h',
    rw [ext_iff] at h',
    cases h',
    simp only [of_real_im] at h'_right,
    exact h'_right,
end

@[simp] lemma ip_self_eq_conj (x : α) : conj (x†x) = x†x :=
begin
    simp [ext_iff],
    have w := ip_self_im_zero x,
    dsimp [ip_self] at w,
    rw [w, neg_zero],
end

@[simp] lemma ip_self_comm_eq (x : α) : (((ip_self x).re) : ℂ) = ip_self x :=
by simp [ext_iff]

@[simp] lemma ip_self_nonneg (x : α) : (ip_self x).re ≥ 0 :=
begin
    dsimp [ip_self, (≥)],
    apply le_iff_eq_or_lt.2,
    by_cases (x = 0),

    left,
    rw [h],
    simp,

    right,
    have w := pos_def x h,
    exact w,
end

@[simp] lemma swap_re (x y : α) : (x†y).re = (y†x).re :=
begin
    rw [conj_symm y x],
    simp only [conj_re],
end

@[simp] lemma mul_re_in_fst (x y : α) (r : ℝ) : (((r : ℂ)•x)†y).re = r * (x†y).re :=
begin
    simp,
end

@[simp] lemma mul_re_in_snd (x y : α) (r : ℝ) : (x†((r : ℂ)•y)).re = r * (x†y).re :=
begin
    have w := conj_symm x ((r : ℂ)•y),
    rw [w],
    simp,
end

@[simp] lemma add_swap (x y : α) : x†y + y†x = 2*(x†y).re :=
begin
    rw [conj_symm y x],
    simp [ext_iff],
    ring,
end

@[simp] lemma add_in_snd_coord (x y z : α) : x†(y+z) = (x†y)+(x†z) :=
begin
    have h := linearity y z x 1,
    simp only [one_smul, one_mul] at h,
    rw [←conj_inj, conj_add, ←conj_symm, ←conj_symm x y, ←conj_symm] at h,
    exact h,
end

@[simp] lemma mul_in_snd_coord (x y : α) (a : ℂ) : x † (a • y) = (conj a) * (x†y) :=
begin
    rw [conj_symm],
    apply conj_inj.1,
    conv {to_rhs, rw [conj_symm, ←conj_mul]},
    simp only [conj_conj],
    have h := linearity y 0 x a,
    simp only [right_orthog_to_zero, add_zero] at h,
    exact h,
end

@[simp] lemma ip_self_add (x y : α) : (ip_self (x+y)).re = (ip_self x).re + 2*(x†y).re + (ip_self y).re :=
begin
    dsimp [ip_self],
    simp,
    ring,
end

@[simp] lemma ip_self_neg_eq (x : α) : ip_self (-x) = ip_self x :=
begin
    dsimp [ip_self],
    rw [←@neg_one_smul ℂ α _ _ _ x],
    simp only [mul_in_fst_coord, mul_in_snd_coord],
    have w : conj (-1) = -1 := by simp,
    rw [w],
    simp,
end