/-
Copyright (c) 2018 Robert Y. Lewis. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Robert Y. Lewis
-/
import analysis.normed_space.basic
import number_theory.padics.padic_norm

/-!
# p-adic numbers

This file defines the p-adic numbers (rationals) `ℚ_p` as
the completion of `ℚ` with respect to the p-adic norm.
We show that the p-adic norm on ℚ extends to `ℚ_p`, that `ℚ` is embedded in `ℚ_p`,
and that `ℚ_p` is Cauchy complete.

## Important definitions

* `padic` : the type of p-adic numbers
* `padic_norm_e` : the rational valued p-adic norm on `ℚ_p`
* `padic.add_valuation` : the additive `p`-adic valuation on `ℚ_p`, with values in `with_top ℤ`.

## Notation

We introduce the notation `ℚ_[p]` for the p-adic numbers.

## Implementation notes

Much, but not all, of this file assumes that `p` is prime. This assumption is inferred automatically
by taking `[fact (prime p)]` as a type class argument.

We use the same concrete Cauchy sequence construction that is used to construct ℝ.
`ℚ_p` inherits a field structure from this construction.
The extension of the norm on ℚ to `ℚ_p` is *not* analogous to extending the absolute value to ℝ,
and hence the proof that `ℚ_p` is complete is different from the proof that ℝ is complete.

A small special-purpose simplification tactic, `padic_index_simp`, is used to manipulate sequence
indices in the proof that the norm extends.

`padic_norm_e` is the rational-valued p-adic norm on `ℚ_p`.
To instantiate `ℚ_p` as a normed field, we must cast this into a ℝ-valued norm.
The `ℝ`-valued norm, using notation `∥ ∥` from normed spaces,
is the canonical representation of this norm.

`simp` prefers `padic_norm` to `padic_norm_e` when possible.
Since `padic_norm_e` and `∥ ∥` have different types, `simp` does not rewrite one to the other.

Coercions from `ℚ` to `ℚ_p` are set up to work with the `norm_cast` tactic.

## References

* [F. Q. Gouvêa, *p-adic numbers*][gouvea1997]
* [R. Y. Lewis, *A formal proof of Hensel's lemma over the p-adic integers*][lewis2019]
* <https://en.wikipedia.org/wiki/P-adic_number>

## Tags

p-adic, p adic, padic, norm, valuation, cauchy, completion, p-adic completion
-/

noncomputable theory
open_locale classical

open nat multiplicity padic_norm cau_seq cau_seq.completion metric

/-- The type of Cauchy sequences of rationals with respect to the p-adic norm. -/
@[reducible] def padic_seq (p : ℕ) := cau_seq _ (padic_norm p)

namespace padic_seq

section
variables {p : ℕ} [fact p.prime]

/-- The p-adic norm of the entries of a nonzero Cauchy sequence of rationals is eventually
constant. -/
lemma stationary {f : cau_seq ℚ (padic_norm p)} (hf : ¬ f ≈ 0) :
  ∃ N, ∀ m n, N ≤ m → N ≤ n → padic_norm p (f n) = padic_norm p (f m) :=
have ∃ ε > 0, ∃ N1, ∀ j ≥ N1, ε ≤ padic_norm p (f j),
  from cau_seq.abv_pos_of_not_lim_zero $ not_lim_zero_of_not_congr_zero hf,
let ⟨ε, hε, N1, hN1⟩ := this,
    ⟨N2, hN2⟩ := cau_seq.cauchy₂ f hε in
⟨ max N1 N2,
  λ n m hn hm,
  have padic_norm p (f n - f m) < ε, from hN2 _ (max_le_iff.1 hn).2 _ (max_le_iff.1 hm).2,
  have padic_norm p (f n - f m) < padic_norm p (f n),
    from lt_of_lt_of_le this $ hN1 _ (max_le_iff.1 hn).1,
  have  padic_norm p (f n - f m) < max (padic_norm p (f n)) (padic_norm p (f m)),
    from lt_max_iff.2 (or.inl this),
  begin
    by_contradiction hne,
    rw ←padic_norm.neg p (f m) at hne,
    have hnam := add_eq_max_of_ne p hne,
    rw [padic_norm.neg, max_comm] at hnam,
    rw [←hnam, sub_eq_add_neg, add_comm] at this,
    apply _root_.lt_irrefl _ this
  end ⟩

/-- For all n ≥ stationary_point f hf, the p-adic norm of f n is the same. -/
def stationary_point {f : padic_seq p} (hf : ¬ f ≈ 0) : ℕ :=
classical.some $ stationary hf

lemma stationary_point_spec {f : padic_seq p} (hf : ¬ f ≈ 0) :
  ∀ {m n}, stationary_point hf ≤ m → stationary_point hf ≤ n →
    padic_norm p (f n) = padic_norm p (f m) :=
classical.some_spec $ stationary hf

/-- Since the norm of the entries of a Cauchy sequence is eventually stationary,
we can lift the norm to sequences. -/
def norm (f : padic_seq p) : ℚ :=
if hf : f ≈ 0 then 0 else padic_norm p (f (stationary_point hf))

lemma norm_zero_iff (f : padic_seq p) : f.norm = 0 ↔ f ≈ 0 :=
begin
  constructor,
  { intro h,
    by_contradiction hf,
    unfold norm at h, split_ifs at h,
    apply hf,
    intros ε hε,
    existsi stationary_point hf,
    intros j hj,
    have heq := stationary_point_spec hf le_rfl hj,
    simpa [h, heq] },
  { intro h,
    simp [norm, h] }
end

end

section embedding
open cau_seq
variables {p : ℕ} [fact p.prime]

lemma equiv_zero_of_val_eq_of_equiv_zero {f g : padic_seq p}
  (h : ∀ k, padic_norm p (f k) = padic_norm p (g k)) (hf : f ≈ 0) : g ≈ 0 :=
λ ε hε, let ⟨i, hi⟩ := hf _ hε in
⟨i, λ j hj, by simpa [h] using hi _ hj⟩

lemma norm_nonzero_of_not_equiv_zero {f : padic_seq p} (hf : ¬ f ≈ 0) :
  f.norm ≠ 0 :=
hf ∘ f.norm_zero_iff.1

lemma norm_eq_norm_app_of_nonzero {f : padic_seq p} (hf : ¬ f ≈ 0) :
  ∃ k, f.norm = padic_norm p k ∧ k ≠ 0 :=
have heq : f.norm = padic_norm p (f $ stationary_point hf), by simp [norm, hf],
⟨f $ stationary_point hf, heq,
  λ h, norm_nonzero_of_not_equiv_zero hf (by simpa [h] using heq)⟩

lemma not_lim_zero_const_of_nonzero {q : ℚ} (hq : q ≠ 0) : ¬ lim_zero (const (padic_norm p) q) :=
λ h', hq $ const_lim_zero.1 h'

lemma not_equiv_zero_const_of_nonzero {q : ℚ} (hq : q ≠ 0) : ¬ (const (padic_norm p) q) ≈ 0 :=
λ h : lim_zero (const (padic_norm p) q - 0), not_lim_zero_const_of_nonzero hq $ by simpa using h

lemma norm_nonneg (f : padic_seq p) : 0 ≤ f.norm :=
if hf : f ≈ 0 then by simp [hf, norm]
else by simp [norm, hf, padic_norm.nonneg]

/-- An auxiliary lemma for manipulating sequence indices. -/
lemma lift_index_left_left {f : padic_seq p} (hf : ¬ f ≈ 0) (v2 v3 : ℕ) :
  padic_norm p (f (stationary_point hf)) =
    padic_norm p (f (max (stationary_point hf) (max v2 v3))) :=
begin
  apply stationary_point_spec hf,
  { apply le_max_left },
  { exact le_rfl }
end

/-- An auxiliary lemma for manipulating sequence indices. -/
lemma lift_index_left {f : padic_seq p} (hf : ¬ f ≈ 0) (v1 v3 : ℕ) :
  padic_norm p (f (stationary_point hf)) =
    padic_norm p (f (max v1 (max (stationary_point hf) v3))) :=
begin
  apply stationary_point_spec hf,
  { apply le_trans,
    { apply le_max_left _ v3 },
    { apply le_max_right } },
  { exact le_rfl }
end

/-- An auxiliary lemma for manipulating sequence indices. -/
lemma lift_index_right {f : padic_seq p} (hf : ¬ f ≈ 0) (v1 v2 : ℕ) :
  padic_norm p (f (stationary_point hf)) =
    padic_norm p (f (max v1 (max v2 (stationary_point hf)))) :=
begin
  apply stationary_point_spec hf,
  { apply le_trans,
    { apply le_max_right v2 },
    { apply le_max_right } },
  { exact le_rfl }
end

end embedding

section valuation
open cau_seq
variables {p : ℕ} [fact p.prime]

/-! ### Valuation on `padic_seq` -/

/--
The `p`-adic valuation on `ℚ` lifts to `padic_seq p`.
`valuation f` is defined to be the valuation of the (`ℚ`-valued) stationary point of `f`.
-/
def valuation (f : padic_seq p) : ℤ :=
if hf : f ≈ 0 then 0 else padic_val_rat p (f (stationary_point hf))

lemma norm_eq_pow_val {f : padic_seq p} (hf : ¬ f ≈ 0) :
  f.norm = p^(-f.valuation : ℤ) :=
begin
  rw [norm, valuation, dif_neg hf, dif_neg hf, padic_norm, if_neg],
  intro H,
  apply cau_seq.not_lim_zero_of_not_congr_zero hf,
  intros ε hε,
  use (stationary_point hf),
  intros n hn,
  rw stationary_point_spec hf le_rfl hn,
  simpa [H] using hε,
end

lemma val_eq_iff_norm_eq {f g : padic_seq p} (hf : ¬ f ≈ 0) (hg : ¬ g ≈ 0) :
  f.valuation = g.valuation ↔ f.norm = g.norm :=
begin
  rw [norm_eq_pow_val hf, norm_eq_pow_val hg, ← neg_inj, zpow_inj],
  { exact_mod_cast (fact.out p.prime).pos },
  { exact_mod_cast (fact.out p.prime).ne_one },
end

end valuation

end padic_seq

section
open padic_seq

private meta def index_simp_core (hh hf hg : expr)
  (at_ : interactive.loc := interactive.loc.ns [none]) : tactic unit :=
do [v1, v2, v3] ← [hh, hf, hg].mmap
     (λ n, tactic.mk_app ``stationary_point [n] <|> return n),
   e1 ← tactic.mk_app ``lift_index_left_left [hh, v2, v3] <|> return `(true),
   e2 ← tactic.mk_app ``lift_index_left [hf, v1, v3] <|> return `(true),
   e3 ← tactic.mk_app ``lift_index_right [hg, v1, v2] <|> return `(true),
   sl ← [e1, e2, e3].mfoldl (λ s e, simp_lemmas.add s e) simp_lemmas.mk,
   when at_.include_goal (tactic.simp_target sl >> tactic.skip),
   hs ← at_.get_locals, hs.mmap' (tactic.simp_hyp sl [])

/--
  This is a special-purpose tactic that lifts padic_norm (f (stationary_point f)) to
  padic_norm (f (max _ _ _)).
-/
meta def tactic.interactive.padic_index_simp (l : interactive.parse interactive.types.pexpr_list)
  (at_ : interactive.parse interactive.types.location) : tactic unit :=
do [h, f, g] ← l.mmap tactic.i_to_expr,
   index_simp_core h f g at_
end

namespace padic_seq
section embedding

open cau_seq
variables {p : ℕ} [hp : fact p.prime]
include hp

lemma norm_mul (f g : padic_seq p) : (f * g).norm = f.norm * g.norm :=
if hf : f ≈ 0 then
  have hg : f * g ≈ 0, from mul_equiv_zero' _ hf,
  by simp only [hf, hg, norm, dif_pos, zero_mul]
else if hg : g ≈ 0 then
  have hf : f * g ≈ 0, from mul_equiv_zero _ hg,
  by simp only [hf, hg, norm, dif_pos, mul_zero]
else
  have hfg : ¬ f * g ≈ 0, by apply mul_not_equiv_zero; assumption,
  begin
    unfold norm,
    split_ifs,
    padic_index_simp [hfg, hf, hg],
    apply padic_norm.mul
  end

lemma eq_zero_iff_equiv_zero (f : padic_seq p) : mk f = 0 ↔ f ≈ 0 :=
mk_eq

lemma ne_zero_iff_nequiv_zero (f : padic_seq p) : mk f ≠ 0 ↔ ¬ f ≈ 0 :=
not_iff_not.2 (eq_zero_iff_equiv_zero _)

lemma norm_const (q : ℚ) : norm (const (padic_norm p) q) = padic_norm p q :=
if hq : q = 0 then
  have (const (padic_norm p) q) ≈ 0,
    by simp [hq]; apply setoid.refl (const (padic_norm p) 0),
  by subst hq; simp [norm, this]
else
  have ¬ (const (padic_norm p) q) ≈ 0, from not_equiv_zero_const_of_nonzero hq,
  by simp [norm, this]

lemma norm_values_discrete (a : padic_seq p) (ha : ¬ a ≈ 0) :
  (∃ (z : ℤ), a.norm = ↑p ^ (-z)) :=
let ⟨k, hk, hk'⟩ := norm_eq_norm_app_of_nonzero ha in
by simpa [hk] using padic_norm.values_discrete p hk'

lemma norm_one : norm (1 : padic_seq p) = 1 :=
have h1 : ¬ (1 : padic_seq p) ≈ 0, from one_not_equiv_zero _,
by simp [h1, norm, hp.1.one_lt]

private lemma norm_eq_of_equiv_aux {f g : padic_seq p} (hf : ¬ f ≈ 0) (hg : ¬ g ≈ 0) (hfg : f ≈ g)
  (h : padic_norm p (f (stationary_point hf)) ≠ padic_norm p (g (stationary_point hg)))
  (hlt : padic_norm p (g (stationary_point hg)) < padic_norm p (f (stationary_point hf))) :
  false :=
begin
  have hpn : 0 < padic_norm p (f (stationary_point hf)) - padic_norm p (g (stationary_point hg)),
    from sub_pos_of_lt hlt,
  cases hfg _ hpn with N hN,
  let i := max N (max (stationary_point hf) (stationary_point hg)),
  have hi : N ≤ i, from le_max_left _ _,
  have hN' := hN _ hi,
  padic_index_simp [N, hf, hg] at hN' h hlt,
  have hpne : padic_norm p (f i) ≠ padic_norm p (-(g i)),
    by rwa [ ←padic_norm.neg p (g i)] at h,
  let hpnem := add_eq_max_of_ne p hpne,
  have hpeq : padic_norm p ((f - g) i) = max (padic_norm p (f i)) (padic_norm p (g i)),
  { rwa padic_norm.neg at hpnem },
  rw [hpeq, max_eq_left_of_lt hlt] at hN',
  have : padic_norm p (f i) < padic_norm p (f i),
  { apply lt_of_lt_of_le hN', apply sub_le_self, apply padic_norm.nonneg },
  exact lt_irrefl _ this
end

private lemma norm_eq_of_equiv {f g : padic_seq p} (hf : ¬ f ≈ 0) (hg : ¬ g ≈ 0) (hfg : f ≈ g) :
  padic_norm p (f (stationary_point hf)) = padic_norm p (g (stationary_point hg)) :=
begin
  by_contradiction h,
  cases (decidable.em (padic_norm p (g (stationary_point hg)) <
          padic_norm p (f (stationary_point hf))))
      with hlt hnlt,
  { exact norm_eq_of_equiv_aux hf hg hfg h hlt },
  { apply norm_eq_of_equiv_aux hg hf (setoid.symm hfg) (ne.symm h),
    apply lt_of_le_of_ne,
    apply le_of_not_gt hnlt,
    apply h }
end

theorem norm_equiv {f g : padic_seq p} (hfg : f ≈ g) : f.norm = g.norm :=
if hf : f ≈ 0 then
  have hg : g ≈ 0, from setoid.trans (setoid.symm hfg) hf,
  by simp [norm, hf, hg]
else have hg : ¬ g ≈ 0, from hf ∘ setoid.trans hfg,
by unfold norm; split_ifs; exact norm_eq_of_equiv hf hg hfg

private lemma norm_nonarchimedean_aux {f g : padic_seq p}
  (hfg : ¬ f + g ≈ 0) (hf : ¬ f ≈ 0) (hg : ¬ g ≈ 0) : (f + g).norm ≤ max (f.norm) (g.norm) :=
begin
  unfold norm, split_ifs,
  padic_index_simp [hfg, hf, hg],
  apply padic_norm.nonarchimedean
end

theorem norm_nonarchimedean (f g : padic_seq p) : (f + g).norm ≤ max (f.norm) (g.norm) :=
if hfg : f + g ≈ 0 then
  have 0 ≤ max (f.norm) (g.norm), from le_max_of_le_left (norm_nonneg _),
  by simpa only [hfg, norm, ne.def, le_max_iff, cau_seq.add_apply, not_true, dif_pos]
else if hf : f ≈ 0 then
  have hfg' : f + g ≈ g,
  { change lim_zero (f - 0) at hf,
    show lim_zero (f + g - g), by simpa only [sub_zero, add_sub_cancel] using hf },
  have hcfg : (f + g).norm = g.norm, from norm_equiv hfg',
  have hcl : f.norm = 0, from (norm_zero_iff f).2 hf,
  have max (f.norm) (g.norm) = g.norm,
    by rw hcl; exact max_eq_right (norm_nonneg _),
  by rw [this, hcfg]
else if hg : g ≈ 0 then
  have hfg' : f + g ≈ f,
  { change lim_zero (g - 0) at hg,
    show lim_zero (f + g - f), by simpa only [add_sub_cancel', sub_zero] using hg },
  have hcfg : (f + g).norm = f.norm, from norm_equiv hfg',
  have hcl : g.norm = 0, from (norm_zero_iff g).2 hg,
  have max (f.norm) (g.norm) = f.norm,
    by rw hcl; exact max_eq_left (norm_nonneg _),
  by rw [this, hcfg]
else norm_nonarchimedean_aux hfg hf hg

lemma norm_eq {f g : padic_seq p} (h : ∀ k, padic_norm p (f k) = padic_norm p (g k)) :
  f.norm = g.norm :=
if hf : f ≈ 0 then
  have hg : g ≈ 0, from equiv_zero_of_val_eq_of_equiv_zero h hf,
  by simp only [hf, hg, norm, dif_pos]
else
  have hg : ¬ g ≈ 0, from λ hg, hf $ equiv_zero_of_val_eq_of_equiv_zero
    (by simp only [h, forall_const, eq_self_iff_true]) hg,
  begin
    simp only [hg, hf, norm, dif_neg, not_false_iff],
    let i := max (stationary_point hf) (stationary_point hg),
    have hpf : padic_norm p (f (stationary_point hf)) = padic_norm p (f i),
    { apply stationary_point_spec, apply le_max_left, exact le_rfl },
    have hpg : padic_norm p (g (stationary_point hg)) = padic_norm p (g i),
    { apply stationary_point_spec, apply le_max_right, exact le_rfl },
    rw [hpf, hpg, h]
  end

lemma norm_neg (a : padic_seq p) : (-a).norm = a.norm :=
norm_eq $ by simp

lemma norm_eq_of_add_equiv_zero {f g : padic_seq p} (h : f + g ≈ 0) : f.norm = g.norm :=
have lim_zero (f + g - 0), from h,
have f ≈ -g, from show lim_zero (f - (-g)), by simpa only [sub_zero, sub_neg_eq_add],
have f.norm = (-g).norm, from norm_equiv this,
by simpa only [norm_neg] using this

lemma add_eq_max_of_ne {f g : padic_seq p} (hfgne : f.norm ≠ g.norm) :
  (f + g).norm = max f.norm g.norm :=
have hfg : ¬f + g ≈ 0, from mt norm_eq_of_add_equiv_zero hfgne,
if hf : f ≈ 0 then
  have lim_zero (f - 0), from hf,
  have f + g ≈ g, from show lim_zero ((f + g) - g), by simpa only [sub_zero, add_sub_cancel],
  have h1 : (f+g).norm = g.norm, from norm_equiv this,
  have h2 : f.norm = 0, from (norm_zero_iff _).2 hf,
  by rw [h1, h2]; rw max_eq_right (norm_nonneg _)
else if hg : g ≈ 0 then
  have lim_zero (g - 0), from hg,
  have f + g ≈ f, from show lim_zero ((f + g) - f), by rw [add_sub_cancel']; simpa only [sub_zero],
  have h1 : (f+g).norm = f.norm, from norm_equiv this,
  have h2 : g.norm = 0, from (norm_zero_iff _).2 hg,
  by rw [h1, h2]; rw max_eq_left (norm_nonneg _)
else
begin
  unfold norm at ⊢ hfgne, split_ifs at ⊢ hfgne,
  padic_index_simp [hfg, hf, hg] at ⊢ hfgne,
  exact padic_norm.add_eq_max_of_ne p hfgne
end

end embedding
end padic_seq

/-- The p-adic numbers `Q_[p]` are the Cauchy completion of `ℚ` with respect to the p-adic norm. -/
def padic (p : ℕ) [fact p.prime] := @cau_seq.completion.Cauchy _ _ _ _ (padic_norm p) _
notation `ℚ_[` p `]` := padic p

namespace padic

section completion
variables {p : ℕ} [fact p.prime]

/-- The discrete field structure on `ℚ_p` is inherited from the Cauchy completion construction. -/
instance field : field (ℚ_[p]) :=
cau_seq.completion.field

instance : inhabited ℚ_[p] := ⟨0⟩

-- short circuits

instance : has_zero ℚ_[p] := by apply_instance
instance : has_one ℚ_[p] := by apply_instance
instance : has_add ℚ_[p] := by apply_instance
instance : has_mul ℚ_[p] := by apply_instance
instance : has_sub ℚ_[p] := by apply_instance
instance : has_neg ℚ_[p] := by apply_instance
instance : has_div ℚ_[p] := by apply_instance
instance : add_comm_group ℚ_[p] := by apply_instance
instance : comm_ring ℚ_[p] := by apply_instance

/-- Builds the equivalence class of a Cauchy sequence of rationals. -/
def mk : padic_seq p → ℚ_[p] := quotient.mk
end completion

section completion
variables (p : ℕ) [fact p.prime]

lemma mk_eq {f g : padic_seq p} : mk f = mk g ↔ f ≈ g := quotient.eq

/-- Embeds the rational numbers in the p-adic numbers. -/
def of_rat : ℚ → ℚ_[p] := cau_seq.completion.of_rat

@[simp] lemma of_rat_add : ∀ (x y : ℚ), of_rat p (x + y) = of_rat p x + of_rat p y :=
cau_seq.completion.of_rat_add

@[simp] lemma of_rat_neg : ∀ (x : ℚ), of_rat p (-x) = -of_rat p x :=
cau_seq.completion.of_rat_neg

@[simp] lemma of_rat_mul : ∀ (x y : ℚ), of_rat p (x * y) = of_rat p x * of_rat p y :=
cau_seq.completion.of_rat_mul

@[simp] lemma of_rat_sub : ∀ (x y : ℚ), of_rat p (x - y) = of_rat p x - of_rat p y :=
cau_seq.completion.of_rat_sub

@[simp] lemma of_rat_div : ∀ (x y : ℚ), of_rat p (x / y) = of_rat p x / of_rat p y :=
cau_seq.completion.of_rat_div

@[simp] lemma of_rat_one : of_rat p 1 = 1 := rfl

@[simp] lemma of_rat_zero : of_rat p 0 = 0 := rfl

lemma cast_eq_of_rat_of_nat (n : ℕ) : (↑n : ℚ_[p]) = of_rat p n :=
begin
  induction n with n ih,
  { refl },
  { simpa using ih }
end

lemma cast_eq_of_rat_of_int (n : ℤ) : ↑n = of_rat p n :=
by induction n; simp [cast_eq_of_rat_of_nat]

lemma cast_eq_of_rat : ∀ (q : ℚ), (↑q : ℚ_[p]) = of_rat p q
| ⟨n, d, h1, h2⟩ :=
  show ↑n / ↑d = _, from
    have (⟨n, d, h1, h2⟩ : ℚ) = rat.mk n d, from rat.num_denom',
    by simp [this, rat.mk_eq_div, of_rat_div, cast_eq_of_rat_of_int, cast_eq_of_rat_of_nat]

@[norm_cast] lemma coe_add : ∀ {x y : ℚ}, (↑(x + y) : ℚ_[p]) = ↑x + ↑y := by simp [cast_eq_of_rat]
@[norm_cast] lemma coe_neg : ∀ {x : ℚ}, (↑(-x) : ℚ_[p]) = -↑x := by simp [cast_eq_of_rat]
@[norm_cast] lemma coe_mul : ∀ {x y : ℚ}, (↑(x * y) : ℚ_[p]) = ↑x * ↑y := by simp [cast_eq_of_rat]
@[norm_cast] lemma coe_sub : ∀ {x y : ℚ}, (↑(x - y) : ℚ_[p]) = ↑x - ↑y := by simp [cast_eq_of_rat]
@[norm_cast] lemma coe_div : ∀ {x y : ℚ}, (↑(x / y) : ℚ_[p]) = ↑x / ↑y := by simp [cast_eq_of_rat]

@[norm_cast] lemma coe_one : (↑1 : ℚ_[p]) = 1 := by simp [cast_eq_of_rat]
@[norm_cast] lemma coe_zero : (↑0 : ℚ_[p]) = 0 := rfl

lemma const_equiv {q r : ℚ} : const (padic_norm p) q ≈ const (padic_norm p) r ↔ q = r :=
⟨ λ heq : lim_zero (const (padic_norm p) (q - r)),
    eq_of_sub_eq_zero $ const_lim_zero.1 heq,
  λ heq, by rw heq; apply setoid.refl _ ⟩

lemma of_rat_eq {q r : ℚ} : of_rat p q = of_rat p r ↔ q = r :=
⟨(const_equiv p).1 ∘ quotient.eq.1, λ h, by rw h⟩

@[norm_cast] lemma coe_inj {q r : ℚ} : (↑q : ℚ_[p]) = ↑r ↔ q = r :=
by simp [cast_eq_of_rat, of_rat_eq]

instance : char_zero ℚ_[p] :=
⟨λ m n, by { rw ← rat.cast_coe_nat, norm_cast, exact id }⟩

end completion
end padic

/-- The rational-valued p-adic norm on `ℚ_p` is lifted from the norm on Cauchy sequences. The
canonical form of this function is the normed space instance, with notation `∥ ∥`. -/
def padic_norm_e {p : ℕ} [hp : fact p.prime] : ℚ_[p] → ℚ :=
quotient.lift padic_seq.norm $ @padic_seq.norm_equiv _ _

namespace padic_norm_e
section embedding
open padic_seq
variables {p : ℕ} [fact p.prime]

lemma defn (f : padic_seq p) {ε : ℚ} (hε : 0 < ε) : ∃ N, ∀ i ≥ N, padic_norm_e (⟦f⟧ - f i) < ε :=
begin
  simp only [padic.cast_eq_of_rat],
  change ∃ N, ∀ i ≥ N, (f - const _ (f i)).norm < ε,
  by_contra' h,
  cases cauchy₂ f hε with N hN,
  rcases h N with ⟨i, hi, hge⟩,
  have hne : ¬ (f - const (padic_norm p) (f i)) ≈ 0,
  { intro h, unfold padic_seq.norm at hge; split_ifs at hge, exact not_lt_of_ge hge hε },
  unfold padic_seq.norm at hge; split_ifs at hge,
  apply not_le_of_gt _ hge,
  cases em (N ≤ stationary_point hne) with hgen hngen,
  { apply hN _ hgen _ hi },
  { have := stationary_point_spec hne le_rfl (le_of_not_le hngen),
    rw ←this,
    exact hN _ le_rfl _ hi },
end

protected lemma nonneg (q : ℚ_[p]) : 0 ≤ padic_norm_e q :=
quotient.induction_on q $ norm_nonneg

lemma zero_def : (0 : ℚ_[p]) = ⟦0⟧ := rfl

lemma zero_iff (q : ℚ_[p]) : padic_norm_e q = 0 ↔ q = 0 :=
quotient.induction_on q $
  by simpa only [zero_def, quotient.eq] using norm_zero_iff

@[simp] protected lemma zero : padic_norm_e (0 : ℚ_[p]) = 0 :=
(zero_iff _).2 rfl

/-- Theorems about `padic_norm_e` are named with a `'` so the names do not conflict with the
equivalent theorems about `norm` (`∥ ∥`). -/
@[simp] protected lemma one' : padic_norm_e (1 : ℚ_[p]) = 1 :=
norm_one

@[simp] protected lemma neg (q : ℚ_[p]) : padic_norm_e (-q) = padic_norm_e q :=
quotient.induction_on q $ norm_neg

/-- Theorems about `padic_norm_e` are named with a `'` so the names do not conflict with the
equivalent theorems about `norm` (`∥ ∥`). -/
theorem nonarchimedean' (q r : ℚ_[p]) :
  padic_norm_e (q + r) ≤ max (padic_norm_e q) (padic_norm_e r) :=
quotient.induction_on₂ q r $ norm_nonarchimedean

/-- Theorems about `padic_norm_e` are named with a `'` so the names do not conflict with the
equivalent theorems about `norm` (`∥ ∥`). -/
theorem add_eq_max_of_ne' {q r : ℚ_[p]} :
  padic_norm_e q ≠ padic_norm_e r → padic_norm_e (q + r) = max (padic_norm_e q) (padic_norm_e r) :=
quotient.induction_on₂ q r $ λ _ _, padic_seq.add_eq_max_of_ne

lemma triangle_ineq (x y z : ℚ_[p]) :
  padic_norm_e (x - z) ≤ padic_norm_e (x - y) + padic_norm_e (y - z) :=
calc padic_norm_e (x - z) = padic_norm_e ((x - y) + (y - z)) : by rw sub_add_sub_cancel
  ... ≤ max (padic_norm_e (x - y)) (padic_norm_e (y - z)) : padic_norm_e.nonarchimedean' _ _
  ... ≤ padic_norm_e (x - y) + padic_norm_e (y - z) :
    max_le_add_of_nonneg (padic_norm_e.nonneg _) (padic_norm_e.nonneg _)

protected lemma add (q r : ℚ_[p]) : padic_norm_e (q + r) ≤ (padic_norm_e q) + (padic_norm_e r) :=
calc
  padic_norm_e (q + r) ≤ max (padic_norm_e q) (padic_norm_e r) : nonarchimedean' _ _
                      ... ≤ (padic_norm_e q) + (padic_norm_e r) :
                              max_le_add_of_nonneg (padic_norm_e.nonneg _) (padic_norm_e.nonneg _)

protected lemma mul' (q r : ℚ_[p]) : padic_norm_e (q * r) = (padic_norm_e q) * (padic_norm_e r) :=
quotient.induction_on₂ q r $ norm_mul

instance : is_absolute_value (@padic_norm_e p _) :=
{ abv_nonneg := padic_norm_e.nonneg,
  abv_eq_zero := zero_iff,
  abv_add := padic_norm_e.add,
  abv_mul := padic_norm_e.mul' }

@[simp] lemma eq_padic_norm' (q : ℚ) : padic_norm_e (padic.of_rat p q) = padic_norm p q :=
norm_const _

protected theorem image' {q : ℚ_[p]} : q ≠ 0 → ∃ n : ℤ, padic_norm_e q = p ^ (-n) :=
quotient.induction_on q $ λ f hf,
  have ¬ f ≈ 0, from (ne_zero_iff_nequiv_zero f).1 hf,
  norm_values_discrete f this

lemma sub_rev (q r : ℚ_[p]) : padic_norm_e (q - r) = padic_norm_e (r - q) :=
by rw ←(padic_norm_e.neg); simp

end embedding
end padic_norm_e

namespace padic

section complete
open padic_seq padic

theorem rat_dense' {p : ℕ} [fact p.prime] (q : ℚ_[p]) {ε : ℚ} (hε : 0 < ε) :
  ∃ r : ℚ, padic_norm_e (q - r) < ε :=
quotient.induction_on q $ λ q',
  have ∃ N, ∀ m n ≥ N, padic_norm p (q' m - q' n) < ε, from cauchy₂ _ hε,
  let ⟨N, hN⟩ := this in
  ⟨q' N,
    begin
      simp only [padic.cast_eq_of_rat],
      change padic_seq.norm (q' - const _ (q' N)) < ε,
      cases decidable.em ((q' - const (padic_norm p) (q' N)) ≈ 0) with heq hne',
      { simpa only [heq, padic_seq.norm, dif_pos] },
      { simp only [padic_seq.norm, dif_neg hne'],
        change padic_norm p (q' _ - q' _) < ε,
        have := stationary_point_spec hne',
        cases decidable.em (stationary_point hne' ≤ N) with hle hle,
        { have := eq.symm (this le_rfl hle),
          simp only [const_apply, sub_apply, padic_norm.zero, sub_self] at this,
          simpa only [this] },
        { exact hN _ (lt_of_not_ge hle).le _ le_rfl } }
    end⟩

variables {p : ℕ} [fact p.prime] (f : cau_seq _ (@padic_norm_e p _))
open classical

private lemma div_nat_pos (n : ℕ) : 0 < (1 / ((n + 1): ℚ)) :=
div_pos zero_lt_one (by exact_mod_cast succ_pos _)

/-- `lim_seq f`, for `f` a Cauchy sequence of `p`-adic numbers,
is a sequence of rationals with the same limit point as `f`. -/
def lim_seq : ℕ → ℚ := λ n, classical.some (rat_dense' (f n) (div_nat_pos n))

lemma exi_rat_seq_conv {ε : ℚ} (hε : 0 < ε) :
  ∃ N, ∀ i ≥ N, padic_norm_e (f i - ((lim_seq f) i : ℚ_[p])) < ε :=
begin
  refine (exists_nat_gt (1/ε)).imp (λ N hN i hi, _),
  have h := classical.some_spec (rat_dense' (f i) (div_nat_pos i)),
  refine lt_of_lt_of_le h ((div_le_iff' $ by exact_mod_cast succ_pos _).mpr _),
  rw right_distrib,
  apply le_add_of_le_of_nonneg,
  { exact (div_le_iff hε).mp (le_trans (le_of_lt hN) (by exact_mod_cast hi)) },
  { apply le_of_lt, simpa }
end

lemma exi_rat_seq_conv_cauchy : is_cau_seq (padic_norm p) (lim_seq f) :=
assume ε hε,
have hε3 : 0 < ε / 3, from div_pos hε (by norm_num),
let ⟨N, hN⟩ := exi_rat_seq_conv f hε3,
    ⟨N2, hN2⟩ := f.cauchy₂ hε3 in
begin
  existsi max N N2,
  intros j hj,
  suffices :
    padic_norm_e ((↑(lim_seq f j) - f (max N N2)) + (f (max N N2) - lim_seq f (max N N2))) < ε,
  { ring_nf at this ⊢,
    rw [← padic_norm_e.eq_padic_norm', ← padic.cast_eq_of_rat],
    exact_mod_cast this },
  { apply lt_of_le_of_lt,
    { apply padic_norm_e.add },
    { have : (3 : ℚ) ≠ 0, by norm_num,
      have : ε = ε / 3 + ε / 3 + ε / 3,
      { field_simp [this], simp only [bit0, bit1, mul_add, mul_one] },
      rw this,
      apply add_lt_add,
      { suffices : padic_norm_e ((↑(lim_seq f j) - f j) + (f j - f (max N N2))) < ε / 3 + ε / 3,
          by simpa only [sub_add_sub_cancel],
        apply lt_of_le_of_lt,
        { apply padic_norm_e.add },
        { apply add_lt_add,
          { rw [padic_norm_e.sub_rev],
            apply_mod_cast hN,
            exact le_of_max_le_left hj },
          { exact hN2 _ (le_of_max_le_right hj) _ (le_max_right _ _) } } },
      { apply_mod_cast hN,
        apply le_max_left }}}
end

private def lim' : padic_seq p := ⟨_, exi_rat_seq_conv_cauchy f⟩

private def lim : ℚ_[p] := ⟦lim' f⟧

end complete

section normed_space
variables (p : ℕ) [fact p.prime]

instance : has_dist ℚ_[p] := ⟨λ x y, padic_norm_e (x - y)⟩

instance : metric_space ℚ_[p] :=
{ dist_self := by simp [dist],
  dist := dist,
  dist_comm := λ x y, by unfold dist; rw ←padic_norm_e.neg (x - y); simp,
  dist_triangle :=
    begin
      intros, unfold dist,
      exact_mod_cast padic_norm_e.triangle_ineq _ _ _,
    end,
  eq_of_dist_eq_zero :=
    begin
      unfold dist, intros _ _ h,
      apply eq_of_sub_eq_zero,
      apply (padic_norm_e.zero_iff _).1,
      exact_mod_cast h
    end }

instance : has_norm ℚ_[p] := ⟨λ x, padic_norm_e x⟩

instance : normed_field ℚ_[p] :=
{ dist_eq := λ _ _, rfl,
  norm_mul' := by simp [has_norm.norm, padic_norm_e.mul'],
  norm := norm, .. padic.field, .. padic.metric_space p }

instance is_absolute_value : is_absolute_value (λ a : ℚ_[p], ∥a∥) :=
{ abv_nonneg := norm_nonneg,
  abv_eq_zero := λ _, norm_eq_zero,
  abv_add := norm_add_le,
  abv_mul := by simp [has_norm.norm, padic_norm_e.mul'] }

theorem rat_dense {p : ℕ} {hp : fact p.prime} (q : ℚ_[p]) {ε : ℝ} (hε : 0 < ε) :
        ∃ r : ℚ, ∥q - r∥ < ε :=
let ⟨ε', hε'l, hε'r⟩ := exists_rat_btwn hε,
    ⟨r, hr⟩ := rat_dense' q (by simpa using hε'l)  in
⟨r, lt_trans (by simpa [has_norm.norm] using hr) hε'r⟩

end normed_space
end padic

namespace padic_norm_e
section normed_space
variables {p : ℕ} [hp : fact p.prime]
include hp

@[simp] protected lemma mul (q r : ℚ_[p]) : ∥q * r∥ = ∥q∥ * ∥r∥ :=
by simp [has_norm.norm, padic_norm_e.mul']

protected lemma is_norm (q : ℚ_[p]) : ↑(padic_norm_e q) = ∥q∥ := rfl

theorem nonarchimedean (q r : ℚ_[p]) : ∥q + r∥ ≤ max (∥q∥) (∥r∥) :=
begin
  unfold has_norm.norm,
  exact_mod_cast nonarchimedean' _ _
end

theorem add_eq_max_of_ne {q r : ℚ_[p]} (h : ∥q∥ ≠ ∥r∥) : ∥q+r∥ = max (∥q∥) (∥r∥) :=
begin
  unfold has_norm.norm,
  apply_mod_cast add_eq_max_of_ne',
  intro h',
  apply h,
  unfold has_norm.norm,
  exact_mod_cast h'
end

@[simp] lemma eq_padic_norm (q : ℚ) : ∥(↑q : ℚ_[p])∥ = padic_norm p q :=
begin
  unfold has_norm.norm,
  rw [← padic_norm_e.eq_padic_norm', ← padic.cast_eq_of_rat]
end

@[simp] lemma norm_p : ∥(p : ℚ_[p])∥ = p⁻¹ :=
begin
  have p₀ : p ≠ 0 := hp.1.ne_zero,
  have p₁ : p ≠ 1 := hp.1.ne_one,
  simp [p₀, p₁, norm, padic_norm, padic_val_rat, padic_val_int, zpow_neg,
    padic.cast_eq_of_rat_of_nat],
end

lemma norm_p_lt_one : ∥(p : ℚ_[p])∥ < 1 :=
begin
  rw norm_p,
  apply inv_lt_one,
  exact_mod_cast hp.1.one_lt
end

@[simp] lemma norm_p_pow (n : ℤ) : ∥(p^n : ℚ_[p])∥ = p^-n :=
by rw [norm_zpow, norm_p]; field_simp

instance : nondiscrete_normed_field ℚ_[p] :=
{ non_trivial := ⟨p⁻¹, begin
    rw [norm_inv, norm_p, inv_inv],
    exact_mod_cast hp.1.one_lt
  end⟩,
  .. padic.normed_field p }

protected theorem image {q : ℚ_[p]} : q ≠ 0 → ∃ n : ℤ, ∥q∥ = ↑((↑p : ℚ) ^ (-n)) :=
quotient.induction_on q $ λ f hf,
  have ¬ f ≈ 0, from (padic_seq.ne_zero_iff_nequiv_zero f).1 hf,
  let ⟨n, hn⟩ := padic_seq.norm_values_discrete f this in
  ⟨n, congr_arg coe hn⟩

protected lemma is_rat (q : ℚ_[p]) : ∃ q' : ℚ, ∥q∥ = ↑q' :=
if h : q = 0 then ⟨0, by simp [h]⟩
else let ⟨n, hn⟩ := padic_norm_e.image h in ⟨_, hn⟩

/--`rat_norm q`, for a `p`-adic number `q` is the `p`-adic norm of `q`, as rational number.

The lemma `padic_norm_e.eq_rat_norm` asserts `∥q∥ = rat_norm q`. -/
def rat_norm (q : ℚ_[p]) : ℚ := classical.some (padic_norm_e.is_rat q)

lemma eq_rat_norm (q : ℚ_[p]) : ∥q∥ = rat_norm q := classical.some_spec (padic_norm_e.is_rat q)

theorem norm_rat_le_one : ∀ {q : ℚ} (hq : ¬ p ∣ q.denom), ∥(q : ℚ_[p])∥ ≤ 1
| ⟨n, d, hn, hd⟩ := λ hq : ¬ p ∣ d,
  if hnz : n = 0 then
    have (⟨n, d, hn, hd⟩ : ℚ) = 0,
    from rat.zero_iff_num_zero.mpr hnz,
    by norm_num [this]
  else
    begin
      have hnz' : { rat . num := n, denom := d, pos := hn, cop := hd } ≠ 0,
        from mt rat.zero_iff_num_zero.1 hnz,
      rw [padic_norm_e.eq_padic_norm],
      norm_cast,
      rw [padic_norm.eq_zpow_of_nonzero p hnz', padic_val_rat, neg_sub,
        padic_val_nat.eq_zero_of_not_dvd hq],
      norm_cast,
      rw [zero_sub, zpow_neg, zpow_coe_nat],
      apply inv_le_one,
      { norm_cast,
        apply one_le_pow,
        exact hp.1.pos, },
    end

theorem norm_int_le_one (z : ℤ) : ∥(z : ℚ_[p])∥ ≤ 1 :=
suffices ∥((z : ℚ) : ℚ_[p])∥ ≤ 1, by simpa,
norm_rat_le_one $ by simp [hp.1.ne_one]

lemma norm_int_lt_one_iff_dvd (k : ℤ) : ∥(k : ℚ_[p])∥ < 1 ↔ ↑p ∣ k :=
begin
  split,
  { intro h,
    contrapose! h,
    apply le_of_eq,
    rw eq_comm,
    calc ∥(k : ℚ_[p])∥ = ∥((k : ℚ) : ℚ_[p])∥ : by { norm_cast }
    ... = padic_norm p k : padic_norm_e.eq_padic_norm _
    ... = 1 : _,
    rw padic_norm,
    split_ifs with H,
    { exfalso,
      apply h,
      norm_cast at H,
      rw H,
      apply dvd_zero },
    { norm_cast at H ⊢,
      convert zpow_zero _,
      rw [neg_eq_zero, padic_val_rat.of_int],
      norm_cast,
      apply padic_val_int.eq_zero_of_not_dvd h, } },
  { rintro ⟨x, rfl⟩,
    push_cast,
    rw padic_norm_e.mul,
    calc _ ≤ ∥(p : ℚ_[p])∥ * 1 : mul_le_mul le_rfl (by simpa using norm_int_le_one _)
                                            (norm_nonneg _) (norm_nonneg _)
    ... < 1 : _,
    { rw [mul_one, padic_norm_e.norm_p],
      apply inv_lt_one,
      exact_mod_cast hp.1.one_lt }, },
end

lemma norm_int_le_pow_iff_dvd (k : ℤ) (n : ℕ) : ∥(k : ℚ_[p])∥ ≤ ((↑p)^(-n : ℤ)) ↔ ↑(p^n) ∣ k :=
begin
  have : (p : ℝ) ^ (-n : ℤ) = ↑((p ^ (-n : ℤ) : ℚ)), {simp},
  rw [show (k : ℚ_[p]) = ((k : ℚ) : ℚ_[p]), by norm_cast, eq_padic_norm, this],
  norm_cast,
  rw padic_norm.dvd_iff_norm_le,
end

lemma eq_of_norm_add_lt_right {p : ℕ} {hp : fact p.prime} {z1 z2 : ℚ_[p]}
  (h : ∥z1 + z2∥ < ∥z2∥) : ∥z1∥ = ∥z2∥ :=
by_contradiction $ λ hne,
  not_lt_of_ge (by rw padic_norm_e.add_eq_max_of_ne hne; apply le_max_right) h

lemma eq_of_norm_add_lt_left {p : ℕ} {hp : fact p.prime} {z1 z2 : ℚ_[p]}
  (h : ∥z1 + z2∥ < ∥z1∥) : ∥z1∥ = ∥z2∥ :=
by_contradiction $ λ hne,
  not_lt_of_ge (by rw padic_norm_e.add_eq_max_of_ne hne; apply le_max_left) h

end normed_space
end padic_norm_e

namespace padic
variables {p : ℕ} [hp_prime : fact p.prime]
include hp_prime

set_option eqn_compiler.zeta true
instance complete : cau_seq.is_complete ℚ_[p] norm :=
begin
  split, intro f,
  have cau_seq_norm_e : is_cau_seq padic_norm_e f,
  { intros ε hε,
    let h := is_cau f ε (by exact_mod_cast hε),
    unfold norm at h,
    apply_mod_cast h },
  cases padic.complete' ⟨f, cau_seq_norm_e⟩ with q hq,
  existsi q,
  intros ε hε,
  cases exists_rat_btwn hε with ε' hε',
  norm_cast at hε',
  cases hq ε' hε'.1 with N hN, existsi N,
  intros i hi, let h := hN i hi,
  unfold norm,
  rw_mod_cast [cau_seq.sub_apply, padic_norm_e.sub_rev],
  refine lt_trans _ hε'.2,
  exact_mod_cast hN i hi
end

lemma padic_norm_e_lim_le {f : cau_seq ℚ_[p] norm} {a : ℝ} (ha : 0 < a)
      (hf : ∀ i, ∥f i∥ ≤ a) : ∥f.lim∥ ≤ a :=
let ⟨N, hN⟩ := setoid.symm (cau_seq.equiv_lim f) _ ha in
calc ∥f.lim∥ = ∥f.lim - f N + f N∥ : by simp
                ... ≤ max (∥f.lim - f N∥) (∥f N∥) : padic_norm_e.nonarchimedean _ _
                ... ≤ a : max_le (le_of_lt (hN _ le_rfl)) (hf _)

open filter set

instance : complete_space ℚ_[p] :=
begin
  apply complete_of_cauchy_seq_tendsto,
  intros u hu,
  let c : cau_seq ℚ_[p] norm := ⟨u, metric.cauchy_seq_iff'.mp hu⟩,
  refine ⟨c.lim, λ s h, _⟩,
  rcases metric.mem_nhds_iff.1 h with ⟨ε, ε0, hε⟩,
  have := c.equiv_lim ε ε0,
  simp only [mem_map, mem_at_top_sets, mem_set_of_eq],
  exact this.imp (λ N hN n hn, hε (hN n hn))
end

/-!
### Valuation on `ℚ_[p]`
-/

/--
`padic.valuation` lifts the p-adic valuation on rationals to `ℚ_[p]`.
-/
def valuation : ℚ_[p] → ℤ :=
quotient.lift (@padic_seq.valuation p _) (λ f g h,
begin
  by_cases hf : f ≈ 0,
  { have hg : g ≈ 0, from setoid.trans (setoid.symm h) hf,
    simp [hf, hg, padic_seq.valuation] },
  { have hg : ¬ g ≈ 0, from (λ hg, hf (setoid.trans h hg)),
    rw padic_seq.val_eq_iff_norm_eq hf hg,
    exact padic_seq.norm_equiv h },
end)

@[simp] lemma valuation_zero : valuation (0 : ℚ_[p]) = 0 :=
dif_pos ((const_equiv p).2 rfl)

@[simp] lemma valuation_one : valuation (1 : ℚ_[p]) = 0 :=
begin
  change dite (cau_seq.const (padic_norm p) 1 ≈ _) _ _ = _,
  have h : ¬ cau_seq.const (padic_norm p) 1 ≈ 0,
  { assume H, erw const_equiv p at H, exact one_ne_zero H },
  rw dif_neg h,
  simp,
end

lemma norm_eq_pow_val {x : ℚ_[p]} : x ≠ 0 → ∥x∥ = p^(-x.valuation) :=
begin
  apply quotient.induction_on' x, clear x,
  intros f hf,
  change (padic_seq.norm _ : ℝ) = (p : ℝ) ^ -padic_seq.valuation _,
  rw padic_seq.norm_eq_pow_val,
  change ↑((p : ℚ) ^ -padic_seq.valuation f) = (p : ℝ) ^ -padic_seq.valuation f,
  { rw rat.cast_zpow,
    congr' 1,
    norm_cast },
  { apply cau_seq.not_lim_zero_of_not_congr_zero,
    contrapose! hf,
    apply quotient.sound,
    simpa using hf, }
end

@[simp] lemma valuation_p : valuation (p : ℚ_[p]) = 1 :=
begin
  have h : (1 : ℝ) < p := by exact_mod_cast (fact.out p.prime).one_lt,
  rw ← neg_inj,
  apply (zpow_strict_mono h).injective,
  dsimp only,
  rw ← norm_eq_pow_val,
  { simp },
  { exact_mod_cast (fact.out p.prime).ne_zero }
end

lemma valuation_map_add {x y : ℚ_[p]} (hxy : x + y ≠ 0) :
  min (valuation x) (valuation y) ≤ valuation (x + y) :=
begin
  by_cases hx : x = 0,
  { rw [hx, zero_add],
    exact min_le_right _ _ },
  { by_cases hy : y = 0,
    { rw [hy, add_zero],
      exact min_le_left _ _ },
    { have h_norm : ∥x + y∥ ≤ (max ∥x∥ ∥y∥) := padic_norm_e.nonarchimedean x y,
      have hp_one : (1 : ℝ) < p,
      { rw [← nat.cast_one, nat.cast_lt],
        exact nat.prime.one_lt hp_prime.elim, },
      rw [norm_eq_pow_val hx, norm_eq_pow_val hy, norm_eq_pow_val hxy] at h_norm,
      exact min_le_of_zpow_le_max hp_one h_norm }}
end

@[simp] lemma valuation_map_mul {x y : ℚ_[p]} (hx : x ≠ 0) (hy : y ≠ 0) :
  valuation (x * y) = valuation x + valuation y :=
begin
  have h_norm : ∥x * y∥ = ∥x∥ * ∥y∥ := norm_mul x y,
  have hp_ne_one : (p : ℝ) ≠ 1,
  { rw [← nat.cast_one, ne.def, nat.cast_inj],
    exact nat.prime.ne_one hp_prime.elim, },
  have hp_pos : (0 : ℝ) < p,
  { rw [← nat.cast_zero, nat.cast_lt],
    exact nat.prime.pos hp_prime.elim },
  rw [norm_eq_pow_val hx, norm_eq_pow_val hy, norm_eq_pow_val (mul_ne_zero hx hy),
    ← zpow_add₀ (ne_of_gt hp_pos), zpow_inj hp_pos hp_ne_one, ← neg_add, neg_inj] at h_norm,
  exact h_norm,
end

/-- The additive p-adic valuation on `ℚ_p`, with values in `with_top ℤ`. -/
def add_valuation_def : ℚ_[p] → (with_top ℤ) :=
λ x, if x = 0 then ⊤ else x.valuation

@[simp] lemma add_valuation.map_zero : add_valuation_def (0 : ℚ_[p]) = ⊤ :=
by simp only [add_valuation_def, if_pos (eq.refl _)]

@[simp] lemma add_valuation.map_one : add_valuation_def (1 : ℚ_[p]) = 0 :=
by simp only [add_valuation_def, if_neg (one_ne_zero), valuation_one,
  with_top.coe_zero]

lemma add_valuation.map_mul (x y : ℚ_[p]) :
  add_valuation_def (x * y) = add_valuation_def x + add_valuation_def y :=
begin
  simp only [add_valuation_def],
  by_cases hx : x = 0,
  { rw [hx, if_pos (eq.refl _), zero_mul, if_pos (eq.refl _), with_top.top_add] },
  { by_cases hy : y = 0,
    { rw [hy, if_pos (eq.refl _), mul_zero, if_pos (eq.refl _), with_top.add_top] },
    { rw [if_neg hx, if_neg hy, if_neg (mul_ne_zero hx hy), ← with_top.coe_add,
        with_top.coe_eq_coe, valuation_map_mul hx hy] }}
end

lemma add_valuation.map_add (x y : ℚ_[p]) :
  min (add_valuation_def x) (add_valuation_def y) ≤ add_valuation_def (x + y) :=
begin
  simp only [add_valuation_def],
  by_cases hxy : x + y = 0,
  { rw [hxy, if_pos (eq.refl _)],
    exact le_top, },
  { by_cases hx : x = 0,
    { simp only [hx, if_pos (eq.refl _), min_eq_right, le_top, zero_add, le_refl] },
    { by_cases hy : y = 0,
      { simp only [hy, if_pos (eq.refl _), min_eq_left, le_top, add_zero, le_refl], },
      { rw [if_neg hx, if_neg hy, if_neg hxy, ← with_top.coe_min, with_top.coe_le_coe],
        exact valuation_map_add hxy }}}
end

/-- The additive `p`-adic valuation on `ℚ_p`, as an `add_valuation`. -/
def add_valuation : add_valuation ℚ_[p] (with_top ℤ) :=
add_valuation.of add_valuation_def add_valuation.map_zero add_valuation.map_one
  add_valuation.map_add add_valuation.map_mul

@[simp] lemma add_valuation.apply {x : ℚ_[p]} (hx : x ≠ 0) :
  x.add_valuation = x.valuation :=
by simp only [add_valuation, add_valuation.of_apply, add_valuation_def, if_neg hx]

section norm_le_iff
/-! ### Various characterizations of open unit balls -/
lemma norm_le_pow_iff_norm_lt_pow_add_one (x : ℚ_[p]) (n : ℤ) :
  ∥x∥ ≤ p ^ n ↔ ∥x∥ < p ^ (n + 1) :=
begin
  have aux : ∀ n : ℤ, 0 < (p ^ n : ℝ),
  { apply nat.zpow_pos_of_pos, exact hp_prime.1.pos },
  by_cases hx0 : x = 0, { simp [hx0, norm_zero, aux, le_of_lt (aux _)], },
  rw norm_eq_pow_val hx0,
  have h1p : 1 < (p : ℝ), { exact_mod_cast hp_prime.1.one_lt },
  have H := zpow_strict_mono h1p,
  rw [H.le_iff_le, H.lt_iff_lt, int.lt_add_one_iff],
end

lemma norm_lt_pow_iff_norm_le_pow_sub_one (x : ℚ_[p]) (n : ℤ) :
  ∥x∥ < p ^ n ↔ ∥x∥ ≤ p ^ (n - 1) :=
by rw [norm_le_pow_iff_norm_lt_pow_add_one, sub_add_cancel]

end norm_le_iff
end padic


import data.real.basic

/-!

# Q3

Take bounded, nonempty `S, T ⊆ ℝ`.
Define `S + T := { s + t : s ∈ S, t ∈ T}`.
Prove `sup(S+T)  =  sup(S)+ sup(T)`

-/

theorem is_lub_def {S : set ℝ} {a : ℝ} :
  is_lub S a ↔ a ∈ upper_bounds S ∧ ∀ x, x ∈ upper_bounds S → a ≤ x :=
begin
  refl
end

#check mem_upper_bounds -- a ∈ upper_bounds S ↔ ∀ x, x ∈ S → x ≤ a

example (P Q : Prop) : P → Q ↔ ¬ Q → ¬ P :=
by library_search

theorem useful_lemma {S : set ℝ} {a : ℝ} (haS : is_lub S a) (t : ℝ)
  (ht : t < a) : ∃ s, s ∈ S ∧ t < s :=
begin
  rw is_lub_def at haS,
  cases haS with haS1 haS2,
  specialize haS2 t,
  replace haS2 := mt haS2,
  push_neg at haS2,
  specialize haS2 ht,
  rw mem_upper_bounds at haS2,
  push_neg at haS2,
  exact haS2,
end

example (S T : set ℝ) (a b : ℝ) :
  is_lub S a → is_lub T b → is_lub (S + T) (a + b) :=
begin
  intros hSa hTb,
  rw is_lub_def,
  split,
  { rw mem_upper_bounds,
    intro x,
    intro hx,
    rcases hx with ⟨s, t, hsS, htT, rfl⟩,
    rw is_lub_def at hSa hTb,
    rcases hSa with ⟨ha1, ha2⟩,
    rcases hTb with ⟨hb1, hb2⟩,
    rw mem_upper_bounds at ha1 hb1,
    specialize ha1 s hsS,
    specialize hb1 t htT,
    linarith,
  },
  { intro x,
    intro hx,
    rw mem_upper_bounds at hx,
    by_contra,
    push_neg at h,
    set ε := a + b - x with hε,
    have hε2 : 0 < ε,
      linarith,
    set a' := a - ε/2 with ha',
    set b' := b - ε/2 with hb',
    rcases useful_lemma hSa a' (by linarith) with ⟨s', hs', hs'2⟩,
    rcases useful_lemma hTb b' (by linarith) with ⟨t', ht', ht'2⟩,
    specialize hx (s' + t') ⟨s', t', hs', ht', rfl⟩,
    linarith,
  }
end

/-!

# Q6

-/

-- We introduce the usual mathematical notation for absolute value
local notation `|` x `|` := abs x

theorem Q6a (x y : ℝ) : | x + y | ≤ | x | + | y | :=
begin
  -- Lean's definition of abs is abs x = max (x, -x)
  -- [or max x (-x), as the computer scientists would write it]
  unfold abs,
  -- lean's definition of max a b is "if a<=b then b else a"
  unfold max,
  -- We now have a complicated statement with three "if"s in.
  split_ifs,
  -- We now have 2^3=8 goals corresponding to all the possibilities
  -- x>=0 or x<0, y>=0 or y<0, (x+y)>=0 or (x+y)<0.
  repeat {linarith},
  -- all of them are easily solvable using the linarith tactic.
end

-- We can solve the remaining parts using part (a).
theorem Q6b (x y : ℝ) : |x + y| ≥ |x| - |y| :=
begin
  -- Apply Q6a to x+y and -y, then follow your nose.
  have h := Q6a (x + y) (-y),
  simp at h,
  linarith,
end

theorem Q6c (x y : ℝ) : |x + y| ≥ |y| - |x| :=
begin
  -- Apply Q6a to x+y and -x, then follow your nose.
  have h := Q6a (x + y) (-x),
  simp at h,
  linarith,
end

theorem Q6d (x y : ℝ) : |x - y| ≥ | |x| - |y| | :=
begin
  -- Lean prefers ≤ to ≥
  show _ ≤ _,
  -- for this one we need to apply the result that |X| ≤ B ↔ -B ≤ X and X ≤ B
  rw abs_le,
  -- Now we have two goals:
  -- first -|x - y| ≤ |x| - |y|
  -- and second |x| - |y| ≤ |x - y|.
  -- So we need to split.
  split,
  { -- -|x - y| ≤ |x| - |y|
    have h := Q6a (x - y) (-x),
    simp [sub_eq_add_neg] at *,
    linarith },
  { -- |x| - |y| ≤ |x - y|
    have h := Q6a (x - y) y,
    simp at *,
    linarith}
end

theorem Q6e (x y : ℝ) : |x| ≤ |y| + |x - y| :=
begin
  have h := Q6a y (x - y),
  simp * at *,
end

theorem Q6f (x y : ℝ) : |x| ≥ |y| - |x - y| :=
begin
  have h := Q6a (x - y) (-x),
  simp [*, sub_eq_add_neg] at *,
end

theorem Q1g (x y z : ℝ) : |x - y| ≤ |x - z| + |y - z| :=
begin
  have h := Q6a (x - z) (z - y),
  -- Lean needs more hints with this one.
  -- First let's change that y - z into z - y,
  rw ←abs_neg (y - z),
  -- now use automation
  simp * at *,
  convert h,
  ring,
end

/-!

# Q4

Fix `a ∈ (0,∞)` and `n : ℕ`. We will prove
`∃ x : ℝ, x^n = a`.

-/

section Q4

noncomputable theory

parameters {a : ℝ} (ha : 0 < a) {n : ℕ} (hn : 0 < n)

/-
1) Set `Sₐ := {s ∈ [0,∞) : s^n < a}` and show `Sₐ` is nonempty and
bounded above, so we may define `x := sup Sₐ`.
-/

def S := {s : ℝ | 0 ≤ s ∧ s ^ n < a}

include ha hn

theorem part1 : (∃ s : ℝ, s ∈ S) ∧ (∃ B : ℝ, ∀ s ∈ S, s ≤ B ) :=
sorry

def x := Sup S

theorem is_lub_x : is_lub S x :=
begin
  cases part1 with nonempty bdd,
  cases nonempty with x hx,
  cases bdd with y hy,
  exact real.is_lub_Sup hx hy,
end

/-
2) For `ε ∈ (0,1)` show `(x+ε)ⁿ ≤ x^n + ε[(x + 1)ⁿ − xⁿ].`
(Hint: multiply out.)
-/

lemma x_nonneg : 0 ≤ x :=
begin
  rcases is_lub_x with ⟨h, -⟩,
  apply h,
  split, refl,
  convert ha,
  simp [hn],
end

theorem part2 (ε : ℝ) (hε0 : 0 < ε) (hε1 : ε < 1) : (x + ε)^n ≤ x^n + ε*((x+1)^n - x^n) :=
begin
  sorry
end

/-
3) Hence show that if `xⁿ < a` then
`∃ ε ∈ (0,1)` such that `(x+ε)ⁿ < a.` (*)
-/

theorem part3 (h : x ^ n < a) : ∃ ε : ℝ, 0 < ε ∧ ε < 1 ∧ (x+ε)^n < a :=
begin
  sorry
end

/-
4) If `xⁿ > a`, deduce from (∗) that
`∃ ε ∈ (0,1)` such that `(1/x+ε)ⁿ < 1/a`. (∗∗)
-/

-- part 4 doesn't quite make sense because we didn't show x ≠ 0 yet

lemma easy (h : a < x^n) : x ≠ 0 :=
begin
  intro hx,
  rw hx at h,
  suffices : a < 0,
    linarith,
  convert h,
  symmetry, -- ??
  simp [hn],
end

theorem part4 (h : a < x^n) : ∃ ε : ℝ, 0 < ε ∧ ε < 1 ∧ (1/x + ε)^n < 1/a :=
begin
  sorry
end

/-
5) Deduce contradictions from (∗) and (∗∗) to show that `xⁿ = a`.
-/

theorem part5 : x^n = a :=
begin
  sorry
end

end Q4


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

! This file was ported from Lean 3 source module probability.conditional_expectation
! leanprover-community/mathlib commit 70fd9563a21e7b963887c9360bd29b2393e6225a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Probability.Notation
import Mathbin.Probability.Independence
import Mathbin.MeasureTheory.Function.ConditionalExpectation.Basic

/-!

# Probabilistic properties of the conditional expectation

This file contains some properties about the conditional expectation which does not belong in
the main conditional expectation file.

## Main result

* `measure_theory.condexp_indep_eq`: If `m₁, m₂` are independent σ-algebras and `f` is a
  `m₁`-measurable function, then `𝔼[f | m₂] = 𝔼[f]` almost everywhere.

-/

open TopologicalSpace Filter

open NNReal ENNReal MeasureTheory ProbabilityTheory BigOperators

namespace MeasureTheory

open ProbabilityTheory

variable {Ω E : Type _} [NormedAddCommGroup E] [NormedSpace ℝ E] [CompleteSpace E]
  {m₁ m₂ m : MeasurableSpace Ω} {μ : Measure Ω} {f : Ω → E}

/-- If `m₁, m₂` are independent σ-algebras and `f` is `m₁`-measurable, then `𝔼[f | m₂] = 𝔼[f]`
almost everywhere. -/
theorem condexp_indepCat_eq (hle₁ : m₁ ≤ m) (hle₂ : m₂ ≤ m) [SigmaFinite (μ.trim hle₂)]
    (hf : strongly_measurable[m₁] f) (hindp : IndepCat m₁ m₂ μ) : μ[f|m₂] =ᵐ[μ] fun x => μ[f] :=
  by
  by_cases hfint : integrable f μ
  swap;
  · rw [condexp_undef hfint, integral_undef hfint]
    rfl
  have hfint₁ := hfint.trim hle₁ hf
  refine'
    (ae_eq_condexp_of_forall_set_integral_eq hle₂ hfint
        (fun s _ hs => integrable_on_const.2 (Or.inr hs)) (fun s hms hs => _)
        strongly_measurable_const.ae_strongly_measurable').symm
  rw [set_integral_const]
  rw [← mem_ℒp_one_iff_integrable] at hfint
  refine' hfint.induction_strongly_measurable hle₁ ENNReal.one_ne_top _ _ _ _ _ _
  · intro c t hmt ht
    rw [integral_indicator (hle₁ _ hmt), set_integral_const, smul_smul, ← ENNReal.toReal_mul,
      mul_comm, ← hindp _ _ hmt hms, set_integral_indicator (hle₁ _ hmt), set_integral_const,
      Set.inter_comm]
  · intro u v hdisj huint hvint hu hv hu_eq hv_eq
    rw [mem_ℒp_one_iff_integrable] at huint hvint
    rw [integral_add' huint hvint, smul_add, hu_eq, hv_eq,
      integral_add' huint.integrable_on hvint.integrable_on]
  · have heq₁ :
      (fun f : Lp_meas E ℝ m₁ 1 μ => ∫ x, f x ∂μ) =
        (fun f : Lp E 1 μ => ∫ x, f x ∂μ) ∘ Submodule.subtypeL _ :=
      by
      refine' funext fun f => integral_congr_ae _
      simp_rw [Submodule.coe_subtypeL', Submodule.coeSubtype, ← coeFn_coeBase]
    have heq₂ :
      (fun f : Lp_meas E ℝ m₁ 1 μ => ∫ x in s, f x ∂μ) =
        (fun f : Lp E 1 μ => ∫ x in s, f x ∂μ) ∘ Submodule.subtypeL _ :=
      by
      refine' funext fun f => integral_congr_ae (ae_restrict_of_ae _)
      simp_rw [Submodule.coe_subtypeL', Submodule.coeSubtype, ← coeFn_coeBase]
      exact eventually_of_forall fun _ => rfl
    refine' isClosed_eq (Continuous.const_smul _ _) _
    · rw [heq₁]
      exact continuous_integral.comp (ContinuousLinearMap.continuous _)
    · rw [heq₂]
      exact (continuous_set_integral _).comp (ContinuousLinearMap.continuous _)
  · intro u v huv huint hueq
    rwa [← integral_congr_ae huv, ←
      (set_integral_congr_ae (hle₂ _ hms) _ : (∫ x in s, u x ∂μ) = ∫ x in s, v x ∂μ)]
    filter_upwards [huv]with x hx _ using hx
  · exact ⟨f, hf, eventually_eq.rfl⟩
#align measure_theory.condexp_indep_eq MeasureTheory.condexp_indepCat_eq

end MeasureTheory


/-
Copyright (c) 2020 David Wärn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: David Wärn
-/
import logic.encodable.basic
import order.atoms

/-!
# Order ideals, cofinal sets, and the Rasiowa–Sikorski lemma

## Main definitions

Throughout this file, `P` is at least a preorder, but some sections require more
structure, such as a bottom element, a top element, or a join-semilattice structure.
- `order.ideal P`: the type of nonempty, upward directed, and downward closed subsets of `P`.
  Dual to the notion of a filter on a preorder.
- `order.is_ideal P`: a predicate for when a `set P` is an ideal.
- `order.ideal.principal p`: the principal ideal generated by `p : P`.
- `order.ideal.is_proper P`: a predicate for proper ideals.
  Dual to the notion of a proper filter.
- `order.ideal.is_maximal`: a predicate for maximal ideals.
  Dual to the notion of an ultrafilter.
- `ideal_Inter_nonempty P`: a predicate for when the intersection of all ideals of
  `P` is nonempty.
- `order.cofinal P`: the type of subsets of `P` containing arbitrarily large elements.
  Dual to the notion of 'dense set' used in forcing.
- `order.ideal_of_cofinals p 𝒟`, where `p : P`, and `𝒟` is a countable family of cofinal
  subsets of P: an ideal in `P` which contains `p` and intersects every set in `𝒟`. (This a form
  of the Rasiowa–Sikorski lemma.)

## References

- <https://en.wikipedia.org/wiki/Ideal_(order_theory)>
- <https://en.wikipedia.org/wiki/Cofinal_(mathematics)>
- <https://en.wikipedia.org/wiki/Rasiowa%E2%80%93Sikorski_lemma>

Note that for the Rasiowa–Sikorski lemma, Wikipedia uses the opposite ordering on `P`,
in line with most presentations of forcing.

## TODO

`order.ideal.ideal_Inter_nonempty` is a complicated way to say that `P` has a bottom element. It
should be replaced by this clearer condition, which could be called strong directedness and which
is a Prop version of `order_bot`.

## Tags

ideal, cofinal, dense, countable, generic

-/

open function

namespace order

variables {P : Type*}

/-- An ideal on an order `P` is a subset of `P` that is
  - nonempty
  - upward directed (any pair of elements in the ideal has an upper bound in the ideal)
  - downward closed (any element less than an element of the ideal is in the ideal). -/
structure ideal (P) [has_le P] :=
(carrier   : set P)
(nonempty  : carrier.nonempty)
(directed  : directed_on (≤) carrier)
(mem_of_le : ∀ {x y : P}, x ≤ y → y ∈ carrier → x ∈ carrier)

/-- A subset of a preorder `P` is an ideal if it is
  - nonempty
  - upward directed (any pair of elements in the ideal has an upper bound in the ideal)
  - downward closed (any element less than an element of the ideal is in the ideal). -/
@[mk_iff] structure is_ideal {P} [has_le P] (I : set P) : Prop :=
(nonempty : I.nonempty)
(directed : directed_on (≤) I)
(mem_of_le : ∀ {x y : P}, x ≤ y → y ∈ I → x ∈ I)

attribute [protected] ideal.nonempty ideal.directed is_ideal.nonempty is_ideal.directed

/-- Create an element of type `order.ideal` from a set satisfying the predicate
`order.is_ideal`. -/
def is_ideal.to_ideal [has_le P] {I : set P} (h : is_ideal I) : ideal P :=
⟨I, h.1, h.2, h.3⟩

namespace ideal
section has_le
variables [has_le P] {I J : ideal P} {x y : P}

/-- An ideal of `P` can be viewed as a subset of `P`. -/
instance : has_coe (ideal P) (set P) := ⟨carrier⟩

/-- For the notation `x ∈ I`. -/
instance : has_mem P (ideal P) := ⟨λ x I, x ∈ (I : set P)⟩

@[simp] lemma mem_coe : x ∈ (I : set P) ↔ x ∈ I := iff_of_eq rfl

/-- Two ideals are equal when their underlying sets are equal. -/
@[ext] lemma ext : ∀ {I J : ideal P}, (I : set P) = J → I = J
| ⟨_, _, _, _⟩ ⟨_, _, _, _⟩ rfl := rfl

lemma coe_injective : injective (coe : ideal P → set P) := λ _ _, ext

@[simp, norm_cast] lemma coe_inj : (I : set P) = J ↔ I = J := ⟨by ext, congr_arg _⟩

lemma ext_iff : I = J ↔ (I : set P) = J := coe_inj.symm

protected lemma is_ideal (I : ideal P) : is_ideal (I : set P) := ⟨I.2, I.3, I.4⟩

/-- The partial ordering by subset inclusion, inherited from `set P`. -/
instance : partial_order (ideal P) := partial_order.lift coe coe_injective

@[trans] lemma mem_of_mem_of_le : x ∈ I → I ≤ J → x ∈ J :=
@set.mem_of_mem_of_subset P x I J

/-- A proper ideal is one that is not the whole set.
    Note that the whole set might not be an ideal. -/
@[mk_iff] class is_proper (I : ideal P) : Prop := (ne_univ : (I : set P) ≠ set.univ)

lemma is_proper_of_not_mem {I : ideal P} {p : P} (nmem : p ∉ I) : is_proper I :=
⟨λ hp, begin
  change p ∉ ↑I at nmem,
  rw hp at nmem,
  exact nmem (set.mem_univ p),
end⟩

/-- An ideal is maximal if it is maximal in the collection of proper ideals.

Note that `is_coatom` is less general because ideals only have a top element when `P` is directed
and nonempty. -/
@[mk_iff] class is_maximal (I : ideal P) extends is_proper I : Prop :=
(maximal_proper : ∀ ⦃J : ideal P⦄, I < J → (J : set P) = set.univ)

variable (P)

/-- An order `P` has the `ideal_Inter_nonempty` property if the intersection of all ideals is
nonempty. Most importantly, the ideals of a `semilattice_sup` with this property form a complete
lattice.

TODO: This is equivalent to the existence of a bottom element and shouldn't be specialized to
ideals. -/
class ideal_Inter_nonempty : Prop :=
(Inter_nonempty : (⋂ (I : ideal P), (I : set P)).nonempty)

variable {P}

lemma Inter_nonempty [ideal_Inter_nonempty P] :
  (⋂ (I : ideal P), (I : set P)).nonempty :=
ideal_Inter_nonempty.Inter_nonempty

lemma ideal_Inter_nonempty.exists_all_mem [ideal_Inter_nonempty P] :
  ∃ a : P, ∀ I : ideal P, a ∈ I :=
begin
  change ∃ (a : P), ∀ (I : ideal P), a ∈ (I : set P),
  rw ← set.nonempty_Inter,
  exact Inter_nonempty,
end

lemma ideal_Inter_nonempty_of_exists_all_mem (h : ∃ a : P, ∀ I : ideal P, a ∈ I) :
  ideal_Inter_nonempty P :=
{ Inter_nonempty := by rwa set.nonempty_Inter }

lemma ideal_Inter_nonempty_iff :
  ideal_Inter_nonempty P ↔ ∃ a : P, ∀ I : ideal P, a ∈ I :=
⟨λ _, by exactI ideal_Inter_nonempty.exists_all_mem, ideal_Inter_nonempty_of_exists_all_mem⟩

lemma inter_nonempty [is_directed P (swap (≤))] (I J : ideal P) : (I ∩ J : set P).nonempty :=
begin
  obtain ⟨a, ha⟩ := I.nonempty,
  obtain ⟨b, hb⟩ := J.nonempty,
  obtain ⟨c, hac, hbc⟩ := directed_of (swap (≤)) a b,
  exact ⟨c, I.mem_of_le hac ha, J.mem_of_le hbc hb⟩,
end

end has_le

section preorder
variables [preorder P] {I J : ideal P} {x y : P}

/-- The smallest ideal containing a given element. -/
def principal (p : P) : ideal P :=
{ carrier   := { x | x ≤ p },
  nonempty  := ⟨p, le_rfl⟩,
  directed  := λ x hx y hy, ⟨p, le_rfl, hx, hy⟩,
  mem_of_le := λ x y hxy hy, le_trans hxy hy, }

instance [inhabited P] : inhabited (ideal P) := ⟨ideal.principal default⟩

@[simp] lemma principal_le_iff : principal x ≤ I ↔ x ∈ I :=
⟨λ (h : ∀ {y}, y ≤ x → y ∈ I), h (le_refl x),
 λ h_mem y (h_le : y ≤ x), I.mem_of_le h_le h_mem⟩

@[simp] lemma mem_principal : x ∈ principal y ↔ x ≤ y := iff.rfl

lemma mem_compl_of_ge {x y : P} : x ≤ y → x ∈ (I : set P)ᶜ → y ∈ (I : set P)ᶜ :=
λ h, mt (I.mem_of_le h)

end preorder

section order_bot

/-- A specific witness of `I.nonempty` when `P` has a bottom element. -/
@[simp] lemma bot_mem [has_le P] [order_bot P] {I : ideal P} : ⊥ ∈ I :=
I.mem_of_le bot_le I.nonempty.some_mem

variables [preorder P] [order_bot P] {I : ideal P}

/-- There is a bottom ideal when `P` has a bottom element. -/
instance : order_bot (ideal P) :=
{ bot := principal ⊥,
  bot_le := by simp }

@[priority 100]
instance order_bot.ideal_Inter_nonempty : ideal_Inter_nonempty P :=
by { rw ideal_Inter_nonempty_iff, exact ⟨⊥, λ I, bot_mem⟩ }

end order_bot

section directed
variables [has_le P] [is_directed P (≤)] [nonempty P] {I : ideal P}

/-- In a directed and nonempty order, the top ideal of a is `set.univ`. -/
instance : order_top (ideal P) :=
{ top := { carrier := set.univ,
           nonempty := set.univ_nonempty,
           directed := directed_on_univ,
           mem_of_le := λ _ _ _ _, trivial },
  le_top := λ I, le_top }

@[simp] lemma coe_top : ((⊤ : ideal P) : set P) = set.univ := rfl

lemma is_proper_of_ne_top (ne_top : I ≠ ⊤) : is_proper I := ⟨λ h, ne_top $ ext h⟩

lemma is_proper.ne_top (hI : is_proper I) : I ≠ ⊤ :=
begin
  intro h,
  rw [ext_iff, coe_top] at h,
  apply hI.ne_univ,
  assumption,
end

lemma _root_.is_coatom.is_proper (hI : is_coatom I) : is_proper I := is_proper_of_ne_top hI.1

lemma is_proper_iff_ne_top : is_proper I ↔ I ≠ ⊤ := ⟨λ h, h.ne_top, λ h, is_proper_of_ne_top h⟩

lemma is_maximal.is_coatom (h : is_maximal I) : is_coatom I :=
⟨is_maximal.to_is_proper.ne_top,
  λ _ _, by { rw [ext_iff, coe_top], exact is_maximal.maximal_proper ‹_› }⟩

lemma is_maximal.is_coatom' [is_maximal I] : is_coatom I := is_maximal.is_coatom ‹_›

lemma _root_.is_coatom.is_maximal (hI : is_coatom I) : is_maximal I :=
{ maximal_proper := λ _ _, by simp [hI.2 _ ‹_›],
  ..is_coatom.is_proper ‹_› }

lemma is_maximal_iff_is_coatom : is_maximal I ↔ is_coatom I := ⟨λ h, h.is_coatom, λ h, h.is_maximal⟩

end directed

section order_top
variables [has_le P] [order_top P] {I : ideal P}

lemma top_of_top_mem (hI : ⊤ ∈ I) : I = ⊤ :=
by { ext, exact iff_of_true (I.mem_of_le le_top hI) trivial }

lemma is_proper.top_not_mem (hI : is_proper I) : ⊤ ∉ I := λ h, hI.ne_top $ top_of_top_mem h

end order_top

section semilattice_sup
variables [semilattice_sup P] {x y : P} {I : ideal P}

/-- A specific witness of `I.directed` when `P` has joins. -/
lemma sup_mem (x y ∈ I) : x ⊔ y ∈ I :=
let ⟨z, h_mem, hx, hy⟩ := I.directed x ‹_› y ‹_› in
I.mem_of_le (sup_le hx hy) h_mem

@[simp] lemma sup_mem_iff : x ⊔ y ∈ I ↔ x ∈ I ∧ y ∈ I :=
⟨λ h, ⟨I.mem_of_le le_sup_left h, I.mem_of_le le_sup_right h⟩,
 λ h, sup_mem x h.left y h.right⟩

end semilattice_sup

section semilattice_sup_directed
variables [semilattice_sup P] [is_directed P (swap (≤))] {x : P} {I J K : ideal P}

/-- The infimum of two ideals of a co-directed order is their intersection. -/
instance : has_inf (ideal P) :=
⟨λ I J, { carrier   := I ∩ J,
  nonempty  := inter_nonempty I J,
  directed  := λ x ⟨_, _⟩ y ⟨_, _⟩, ⟨x ⊔ y, ⟨sup_mem x ‹_› y ‹_›, sup_mem x ‹_› y ‹_›⟩, by simp⟩,
  mem_of_le := λ x y h ⟨_, _⟩, ⟨mem_of_le I h ‹_›, mem_of_le J h ‹_›⟩ }⟩

/-- The supremum of two ideals of a co-directed order is the union of the down sets of the pointwise
supremum of `I` and `J`. -/
instance : has_sup (ideal P) :=
⟨λ I J, { carrier   := {x | ∃ (i ∈ I) (j ∈ J), x ≤ i ⊔ j},
  nonempty  := by { cases inter_nonempty I J, exact ⟨w, w, h.1, w, h.2, le_sup_left⟩ },
  directed  := λ x ⟨xi, _, xj, _, _⟩ y ⟨yi, _, yj, _, _⟩,
    ⟨x ⊔ y,
     ⟨xi ⊔ yi, sup_mem xi ‹_› yi ‹_›,
      xj ⊔ yj, sup_mem xj ‹_› yj ‹_›,
      sup_le
        (calc x ≤ xi ⊔ xj               : ‹_›
         ...    ≤ (xi ⊔ yi) ⊔ (xj ⊔ yj) : sup_le_sup le_sup_left le_sup_left)
        (calc y ≤ yi ⊔ yj               : ‹_›
         ...    ≤ (xi ⊔ yi) ⊔ (xj ⊔ yj) : sup_le_sup le_sup_right le_sup_right)⟩,
     le_sup_left, le_sup_right⟩,
  mem_of_le := λ x y _ ⟨yi, _, yj, _, _⟩, ⟨yi, ‹_›, yj, ‹_›, le_trans ‹x ≤ y› ‹_›⟩ }⟩

instance : lattice (ideal P) :=
{ sup          := (⊔),
  le_sup_left  := λ I J (i ∈ I), by { cases J.nonempty, exact ⟨i, ‹_›, w, ‹_›, le_sup_left⟩ },
  le_sup_right := λ I J (j ∈ J), by { cases I.nonempty, exact ⟨w, ‹_›, j, ‹_›, le_sup_right⟩ },
  sup_le       := λ I J K hIK hJK a ⟨i, hi, j, hj, ha⟩,
    K.mem_of_le ha $ sup_mem i (mem_of_mem_of_le hi hIK) j (mem_of_mem_of_le hj hJK),
  inf          := (⊓),
  inf_le_left  := λ I J, set.inter_subset_left I J,
  inf_le_right := λ I J, set.inter_subset_right I J,
  le_inf       := λ I J K, set.subset_inter,
  .. ideal.partial_order }

@[simp] lemma mem_inf : x ∈ I ⊓ J ↔ x ∈ I ∧ x ∈ J := iff.rfl
@[simp] lemma mem_sup : x ∈ I ⊔ J ↔ ∃ (i ∈ I) (j ∈ J), x ≤ i ⊔ j := iff.rfl

lemma lt_sup_principal_of_not_mem (hx : x ∉ I) : I < I ⊔ principal x :=
le_sup_left.lt_of_ne $ λ h, hx $ by simpa only [left_eq_sup, principal_le_iff] using h

end semilattice_sup_directed

section ideal_Inter_nonempty

variables [preorder P] [ideal_Inter_nonempty P]

@[priority 100]
instance ideal_Inter_nonempty.to_directed_ge : is_directed P (swap (≤)) :=
⟨λ a b, begin
    obtain ⟨c, hc⟩ : ∃ a, ∀ I : ideal P, a ∈ I := ideal_Inter_nonempty.exists_all_mem,
    exact ⟨c, hc (principal a), hc (principal b)⟩,
  end⟩

variables {α β γ : Type*} {ι : Sort*}

lemma ideal_Inter_nonempty.all_Inter_nonempty {f : ι → ideal P} :
  (⋂ x, (f x : set P)).nonempty :=
begin
  obtain ⟨a, ha⟩ : ∃ a : P, ∀ I : ideal P, a ∈ I := ideal_Inter_nonempty.exists_all_mem,
  exact ⟨a, by simp [ha]⟩
end

lemma ideal_Inter_nonempty.all_bInter_nonempty {f : α → ideal P} {s : set α} :
  (⋂ x ∈ s, (f x : set P)).nonempty :=
begin
  obtain ⟨a, ha⟩ : ∃ a : P, ∀ I : ideal P, a ∈ I := ideal_Inter_nonempty.exists_all_mem,
  exact ⟨a, by simp [ha]⟩
end

end ideal_Inter_nonempty

section semilattice_sup_ideal_Inter_nonempty

variables [semilattice_sup P] [ideal_Inter_nonempty P] {x : P} {I J K : ideal P}

instance : has_Inf (ideal P) :=
{ Inf := λ s, { carrier := ⋂ (I ∈ s), (I : set P),
  nonempty := ideal_Inter_nonempty.all_bInter_nonempty,
  directed := λ x hx y hy, ⟨x ⊔ y, ⟨λ S ⟨I, hS⟩,
    begin
      simp only [←hS, sup_mem_iff, mem_coe, set.mem_Inter],
      intro hI,
      rw set.mem_Inter₂ at *,
      exact ⟨hx _ hI, hy _ hI⟩
    end,
    le_sup_left, le_sup_right⟩⟩,
  mem_of_le := λ x y hxy hy,
    begin
      rw set.mem_Inter₂ at *,
      exact λ I hI, mem_of_le I ‹_› (hy I hI)
    end } }

variables {s : set (ideal P)}

@[simp] lemma mem_Inf : x ∈ Inf s ↔ ∀ I ∈ s, x ∈ I :=
by { change x ∈ (⋂ (I ∈ s), (I : set P)) ↔ ∀ I ∈ s, x ∈ I, simp }

@[simp] lemma coe_Inf : ↑(Inf s) = ⋂ (I ∈ s), (I : set P) := rfl

lemma Inf_le (hI : I ∈ s) : Inf s ≤ I :=
λ _ hx, hx I ⟨I, by simp [hI]⟩

lemma le_Inf (h : ∀ J ∈ s, I ≤ J) : I ≤ Inf s :=
λ _ _, by { simp only [mem_coe, coe_Inf, set.mem_Inter], tauto }

lemma is_glb_Inf : is_glb s (Inf s) := ⟨λ _, Inf_le, λ _, le_Inf⟩

instance : complete_lattice (ideal P) :=
{ ..ideal.lattice,
  ..complete_lattice_of_Inf (ideal P) (λ _, @is_glb_Inf _ _ _ _) }

end semilattice_sup_ideal_Inter_nonempty

section distrib_lattice

variables [distrib_lattice P]
variables {I J : ideal P}

lemma eq_sup_of_le_sup {x i j: P} (hi : i ∈ I) (hj : j ∈ J) (hx : x ≤ i ⊔ j) :
  ∃ (i' ∈ I) (j' ∈ J), x = i' ⊔ j' :=
begin
  refine ⟨x ⊓ i, I.mem_of_le inf_le_right hi, x ⊓ j, J.mem_of_le inf_le_right hj, _⟩,
  calc
  x    = x ⊓ (i ⊔ j)       : left_eq_inf.mpr hx
  ...  = (x ⊓ i) ⊔ (x ⊓ j) : inf_sup_left,
end

lemma coe_sup_eq : ↑(I ⊔ J) = {x | ∃ i ∈ I, ∃ j ∈ J, x = i ⊔ j} :=
begin
  ext,
  rw [mem_coe, mem_sup],
  exact ⟨λ ⟨_, _, _, _, _⟩, eq_sup_of_le_sup ‹_› ‹_› ‹_›,
  λ ⟨i, _, j, _, _⟩, ⟨i, ‹_›, j, ‹_›, le_of_eq ‹_›⟩⟩
end

end distrib_lattice

section boolean_algebra

variables [boolean_algebra P] {x : P} {I : ideal P}

lemma is_proper.not_mem_of_compl_mem (hI : is_proper I) (hxc : xᶜ ∈ I) : x ∉ I :=
begin
  intro hx,
  apply hI.top_not_mem,
  have ht : x ⊔ xᶜ ∈ I := sup_mem _ ‹_› _ ‹_›,
  rwa sup_compl_eq_top at ht,
end

lemma is_proper.not_mem_or_compl_not_mem (hI : is_proper I) : x ∉ I ∨ xᶜ ∉ I :=
have h : xᶜ ∈ I → x ∉ I := hI.not_mem_of_compl_mem, by tauto

end boolean_algebra

end ideal

/-- For a preorder `P`, `cofinal P` is the type of subsets of `P`
  containing arbitrarily large elements. They are the dense sets in
  the topology whose open sets are terminal segments. -/
structure cofinal (P) [preorder P] :=
(carrier : set P)
(mem_gt  : ∀ x : P, ∃ y ∈ carrier, x ≤ y)

namespace cofinal

variables [preorder P]

instance : inhabited (cofinal P) :=
⟨{ carrier := set.univ, mem_gt := λ x, ⟨x, trivial, le_rfl⟩ }⟩

instance : has_mem P (cofinal P) := ⟨λ x D, x ∈ D.carrier⟩

variables (D : cofinal P) (x : P)
/-- A (noncomputable) element of a cofinal set lying above a given element. -/
noncomputable def above : P := classical.some $ D.mem_gt x

lemma above_mem : D.above x ∈ D :=
exists.elim (classical.some_spec $ D.mem_gt x) $ λ a _, a

lemma le_above : x ≤ D.above x :=
exists.elim (classical.some_spec $ D.mem_gt x) $ λ _ b, b

end cofinal

section ideal_of_cofinals

variables [preorder P] (p : P) {ι : Type*} [encodable ι] (𝒟 : ι → cofinal P)

/-- Given a starting point, and a countable family of cofinal sets,
  this is an increasing sequence that intersects each cofinal set. -/
noncomputable def sequence_of_cofinals : ℕ → P
| 0 := p
| (n+1) := match encodable.decode ι n with
           | none   := sequence_of_cofinals n
           | some i := (𝒟 i).above (sequence_of_cofinals n)
           end

lemma sequence_of_cofinals.monotone : monotone (sequence_of_cofinals p 𝒟) :=
by { apply monotone_nat_of_le_succ, intros n, dunfold sequence_of_cofinals,
  cases encodable.decode ι n, { refl }, { apply cofinal.le_above }, }

lemma sequence_of_cofinals.encode_mem (i : ι) :
  sequence_of_cofinals p 𝒟 (encodable.encode i + 1) ∈ 𝒟 i :=
by { dunfold sequence_of_cofinals, rw encodable.encodek, apply cofinal.above_mem, }

/-- Given an element `p : P` and a family `𝒟` of cofinal subsets of a preorder `P`,
  indexed by a countable type, `ideal_of_cofinals p 𝒟` is an ideal in `P` which
  - contains `p`, according to `mem_ideal_of_cofinals p 𝒟`, and
  - intersects every set in `𝒟`, according to `cofinal_meets_ideal_of_cofinals p 𝒟`.

  This proves the Rasiowa–Sikorski lemma. -/
def ideal_of_cofinals : ideal P :=
{ carrier   := { x : P | ∃ n, x ≤ sequence_of_cofinals p 𝒟 n },
  nonempty  := ⟨p, 0, le_rfl⟩,
  directed  := λ x ⟨n, hn⟩ y ⟨m, hm⟩,
               ⟨_, ⟨max n m, le_rfl⟩,
               le_trans hn $ sequence_of_cofinals.monotone p 𝒟 (le_max_left _ _),
               le_trans hm $ sequence_of_cofinals.monotone p 𝒟 (le_max_right _ _) ⟩,
  mem_of_le := λ x y hxy ⟨n, hn⟩, ⟨n, le_trans hxy hn⟩, }

lemma mem_ideal_of_cofinals : p ∈ ideal_of_cofinals p 𝒟 := ⟨0, le_rfl⟩

/-- `ideal_of_cofinals p 𝒟` is `𝒟`-generic. -/
lemma cofinal_meets_ideal_of_cofinals (i : ι) : ∃ x : P, x ∈ 𝒟 i ∧ x ∈ ideal_of_cofinals p 𝒟 :=
⟨_, sequence_of_cofinals.encode_mem p 𝒟 i, _, le_rfl⟩

end ideal_of_cofinals

end order


-- Las_clases_de_equivalencia_son_no_vacias.lean
-- Las clases de equivalencia son no vacías
-- José A. Alonso Jiménez
-- Sevilla, 5 de octubre de 2021
-- ---------------------------------------------------------------------

-- ---------------------------------------------------------------------
-- Este ejercicio es el 6º de una serie, que comenzó con el [ejercicio
-- del 30 de septiembre](https://bit.ly/2YfsvBZ), cuyo objetivo es
-- demostrar que el tipo de las particiones de un conjunto `X` es
-- isomorfo al tipo de las relaciones de equivalencia sobre `X`.
--
-- El conjuntos de las clases correspondientes a una relación R se
-- define en Lean por
 --    def clases : (A → A → Prop) → set (set A) :=
 --      λ R, {B : set A | ∃ x : A, B = clase R x}
--
-- El ejercicio consiste en demostrar que si C es una clase de
-- equivalencia de R, entonces C es no vacía.
-- ---------------------------------------------------------------------

import tactic

variable {A : Type}
variable (R : A → A → Prop)

def clase (a : A) :=
  {b : A | R b a}

def clases : (A → A → Prop) → set (set A) :=
  λ R, {B : set A | ∃ x : A, B = clase R x}

-- Se usará el siguientes lema auxiliar
lemma pertenece_clase_syss
  {a b : A}
  : b ∈ clase R a ↔ R b a :=
by refl

-- 1ª demostración
example
  (hR: equivalence R)
  : ∀ (X : set A), X ∈ clases R → X.nonempty :=
begin
  intros X hX,
  unfold clases at hX,
  dsimp at hX,
  cases hX with a ha,
  rw ha,
  rw set.nonempty_def,
  use a,
  rw pertenece_clase_syss,
  rcases hR with ⟨hrefl, -, -⟩,
  exact hrefl a,
end

-- 2ª demostración
example
  (hR: equivalence R)
  : ∀ (X : set A), X ∈ clases R → X.nonempty :=
begin
  rintros _ ⟨a, rfl⟩,
  use a,
  rw pertenece_clase_syss,
  exact hR.1 a,
end

-- 3ª demostración
example
  (hR: equivalence R)
  : ∀ (X : set A), X ∈ clases R → X.nonempty :=
begin
  rintros _ ⟨a, rfl⟩,
  use a,
  rw pertenece_clase_syss,
  apply hR.1,
end

-- 4ª demostración
lemma clases_no_vacias
  (hR: equivalence R)
  : ∀ (X : set A), X ∈ clases R → X.nonempty :=
begin
  rintros _ ⟨a, rfl⟩,
  use a,
  exact (pertenece_clase_syss R).mpr (hR.1 a),
end


import data.real.basic

theorem BMO_Problem_2_2007.lean (f : ℝ -> ℝ) : (∀ x y : ℝ, f(f(x)+y) = f(f(x) -y) + 4*f(x)*y)
→ (f = 0 ∨ (∃ c : ℝ, ∀ x : ℝ, f(x) = x^2 +c)) := sorry


import data.real.basic

def fn_lb (f : ℝ → ℝ) (a : ℝ) : Prop := ∀ x, a ≤ f x
def fn_has_lb (f : ℝ → ℝ) := ∃ a, fn_lb f a

variable f : ℝ → ℝ

-- BEGIN
example (h : ∀ a, ∃ x, f x < a) : ¬ fn_has_lb f :=
begin
  intro fnlb,
  cases fnlb with a fnlba,
  cases h a with x hx,
  have : f x ≥ a,
    from fnlba x,
  linarith,
end
-- END


import data.real.basic tactic.norm_num data.nat.basic data.complex algebra.big_operators data.set.finite tactic.ring
open real nat
noncomputable theory
local attribute [instance, priority 0] classical.prop_decidable
universe u

lemma pow_inv' {α : Type u} [discrete_field α] (a : α) (n : ℕ) : (monoid.pow a n)⁻¹ = monoid.pow a⁻¹ n := begin
  induction n with n' hi,
  simp[monoid.pow],
  simp[monoid.pow],rw [mul_inv',mul_comm,hi],
end

lemma pow_abs {α : Type u} [decidable_linear_ordered_comm_ring α] (a : α) (n : ℕ) : monoid.pow (abs a) n = abs (monoid.pow a n) := begin
  induction n with n' hi,
  simp!, simp!,rw [hi,abs_mul],
end

lemma pow_incrs_of_gt_one {α : Type u}  [linear_ordered_semiring α] {x : α} {n m : ℕ} : 1 < x → n < m → monoid.pow x n < monoid.pow x m := begin
  assume x1 nm,revert n,
  induction m with m' hi,assume n nm,
  exact absurd nm (not_lt_of_ge (zero_le n)),assume n nm,
  cases m' with m'',
  rw eq_zero_of_le_zero (le_of_lt_succ nm),simpa!,
  cases n with n',
  simp!, simp! at hi,
  rw ←one_mul (1 : α),
  refine mul_lt_mul x1 (le_of_lt (@hi 0 dec_trivial)) (by norm_num) (le_of_lt(lt_trans (by norm_num) x1)),
  have hi' := @hi n' (lt_of_succ_lt_succ nm),
  suffices : x * monoid.pow x n' < x * monoid.pow x (succ m''),
    simpa [monoid.pow],
  refine mul_lt_mul' (le_refl x) hi' _ (lt_trans (by norm_num) x1),
  clear hi hi' nm m'',
  induction n' with n'' hi,
  simp!,norm_num,
  simp!,refine mul_nonneg (le_of_lt (lt_trans (by norm_num) x1)) hi,
end

lemma pow_dcrs_of_lt_one_of_pos {α : Type u}  [discrete_linear_ordered_field α] {x : α} {n m : ℕ} : x < 1 → 0 < x → n < m → monoid.pow x m < monoid.pow x n := begin
  assume x1 x0 nm,rw [←inv_lt_inv,pow_inv',pow_inv'],
  have x11 : 1 < x⁻¹ ,rw lt_inv,simpa,{norm_num},exact x0,
  refine pow_incrs_of_gt_one x11 nm,
  refine pow_pos x0 _,refine pow_pos x0 _,
end

lemma pow_unbounded_of_gt_one {x : ℝ} (y : ℝ) : 1 < x → ∃ n : ℕ, y < monoid.pow x n := begin
  assume x1,
  have : ∀ m : ℕ, (x - 1) * m < monoid.pow x m ∧ 1 ≤ monoid.pow x m,
    assume m, induction m with m' hi,
    simp,{norm_num},
    rw [←add_one,nat.cast_add,nat.cast_one], simp only [mul_add,monoid.pow],rw mul_one,
    have : x * monoid.pow x m' = monoid.pow x m' + (x - 1) * monoid.pow x m',
      rw add_comm,simp[mul_add,add_mul],
    rw this,split,
    refine add_lt_add_of_lt_of_le hi.left _,rw ←sub_pos at x1,
    have :=mul_le_mul (le_refl (x - 1)) hi.right (by norm_num) (le_of_lt x1),rwa mul_one at this,
    rw [←this, ←one_mul (1 : ℝ)],
    exact mul_le_mul (le_of_lt x1) hi.right (by norm_num) (le_of_lt (lt_trans (by norm_num) x1)),
  cases exists_nat_gt (y / (x - 1)) with n hn,
  existsi n,rw [div_lt_iff,mul_comm] at hn,
  exact lt_trans hn (this n).left,rwa sub_pos,
end

def sum_lt_nat {α : Type u} [has_add α] [has_zero α] (f : ℕ → α) : ℕ → α
| 0        := 0
| (succ n) := sum_lt_nat n + f n

lemma sum_nonneg {α : Type u} [linear_ordered_semiring α] {f : ℕ → α} (n : ℕ) : (∀ m : ℕ, 0 ≤ f m) → 0 ≤ sum_lt_nat f n := begin
  assume h,induction n with n' hi,
  simp!,simp!,exact add_nonneg (h n') hi,
end
#print mul_zero
lemma sum_lt_nat_mul {α : Type u} [semiring α] (f : ℕ → α) (a : α) (n : ℕ) : a * sum_lt_nat f n = sum_lt_nat (λ m, a * f m) n := begin
  induction n with n' hi,
  simp!,simp!,rw [mul_add,hi],
end

lemma sum_incrs_of_nonneg {α : Type u} [linear_ordered_semiring α] {f : ℕ → α} (i j : ℕ) : (∀ m ≥ i, 0 ≤ f m) → i ≤ j → sum_lt_nat f i ≤ sum_lt_nat f j := begin
  assume h ij,
  generalize hk : j - i = k,revert i j,
  induction k with k' hi,
  assume i j h ij hk,
  rw nat.sub_eq_zero_iff_le at hk, replace ij := le_antisymm hk ij,rw ij,
  assume i j h ij hk,have ik : i ≤ k' + i,rw ←zero_add i,refine add_le_add _ _,exact zero_le _,simp,
  have := hi i (k' + i) h ik (by rw nat.add_sub_cancel),
  rw [nat.sub_eq_iff_eq_add ij,succ_add] at hk,rw hk,simp!,
  refine le_trans this _,
  rw ←zero_add (sum_lt_nat f (k' + i)),refine add_le_add _ _,refine h _ ik,simp,
end

lemma geometric_series_l (n : ℕ) (x : ℝ) : x ≠ 1 → sum_lt_nat (monoid.pow x) n = (1 - monoid.pow x n) / (1 - x) := begin
  assume x1,have x1' : 1 + -x ≠ 0,assume h,rw [eq_comm, ←sub_eq_iff_eq_add] at h,simp at h,trivial,
  induction n with n' hi,
  simp!,rw eq_div_iff_mul_eq,simpa,
  simp!,rw hi,simp, rw [add_mul,div_mul_cancel _ x1',mul_add],ring,simp [x1'],
end

lemma geometric_series_cauchy (x : ℝ) : abs x < 1 → is_cau_seq abs (sum_lt_nat (monoid.pow x)):= begin
  assume x1, have : sum_lt_nat (monoid.pow x) = λ n,(1 - monoid.pow x n) / (1 - x),
    apply funext,assume n,refine geometric_series_l n x _ ,assume h, rw h at x1,exact absurd x1 (by norm_num),rw this,
  have absx : 0 < abs (1 - x),refine abs_pos_of_ne_zero _,assume h,rw sub_eq_zero_iff_eq at h,rw ←h at x1,
  have : ¬abs (1 : ℝ) < 1,norm_num,trivial,simp at absx,
  cases classical.em (x = 0),rw h,simp[monoid.pow],assume ε ε0,existsi 1,assume j j1,simpa!,
  cases j,exact absurd j1 dec_trivial,simpa!,
  have x2: 1 < (abs x)⁻¹,rw lt_inv,simpa,{norm_num},exact abs_pos_of_ne_zero h,
  assume ε ε0,cases pow_unbounded_of_gt_one (2 / (ε * abs (1 - x))) x2 with i hi,
  rw [←pow_inv',lt_inv] at hi,
  existsi i,assume j ji,rw [inv_eq_one_div,div_div_eq_mul_div,one_mul,lt_div_iff (by norm_num : (0 : ℝ) < 2)] at hi,
  rw [div_sub_div_same,abs_div,div_lt_iff],
  refine lt_of_le_of_lt _ hi,
  simp,
  refine le_trans (abs_add _ _) _,
  have : monoid.pow (abs x) i * 2 = monoid.pow (abs x) i + monoid.pow (abs x) i,ring,
  rw this,
  refine add_le_add _ _,rw ←pow_abs,
  rw [abs_neg,←pow_abs],
  cases lt_or_eq_of_le ji,
  refine le_of_lt (pow_dcrs_of_lt_one_of_pos x1 (abs_pos_of_ne_zero h) h_1),
  rw h_1,assumption,
  refine div_pos _ _,{norm_num},
  refine mul_pos ε0 _,simpa,
  refine pow_pos (abs_pos_of_ne_zero h) _,
end
lemma geometric_series_const (a x : ℝ) : abs x < 1 → is_cau_seq abs (sum_lt_nat (λ n, a * monoid.pow x n)) := begin
  assume x1 ε ε0,
  cases classical.em (a = 0),
  existsi 0,intros,rw [←sum_lt_nat_mul],induction j,simp!,assumption,rw h,simpa!,
  cases geometric_series_cauchy x x1 (ε / abs a) (div_pos ε0 (abs_pos_of_ne_zero h)) with i hi,
  existsi i,assume j ji,rw [←sum_lt_nat_mul,←sum_lt_nat_mul,←mul_sub,abs_mul,mul_comm,←lt_div_iff],exact hi j ji,exact abs_pos_of_ne_zero h,
end
lemma le_test (f g : ℕ → ℝ) (n : ℕ) : (∀ m ≥ n, abs (f m) ≤ g m) → is_cau_seq abs (sum_lt_nat g) → is_cau_seq abs (sum_lt_nat f) := begin
  assume hm hg ε ε0,cases hg (ε / 2) (div_pos ε0 (by norm_num)) with i hi,
  existsi max n i,
  assume j ji,
  have hi₁ := hi j (le_trans (le_max_right n i) ji),
  have hi₂ := hi (max n i) (le_max_right n i),
  have sub_le := abs_sub_le (sum_lt_nat g j) (sum_lt_nat g i) (sum_lt_nat g (max n i)),
  have := add_lt_add hi₁ hi₂,rw abs_sub (sum_lt_nat g (max n i)) at this,
  have ε2 : ε / 2 + ε / 2 = ε,rw [←add_div,(by ring : ε + ε = ε * 2),mul_div_cancel],{norm_num},
  rw ε2 at this,
  refine lt_of_le_of_lt _ this,
  refine le_trans _ sub_le,
  refine le_trans _ (le_abs_self _),
  have hmi : ∀ m : ℕ, m ≥ max n i → f m ≤ abs (f m),assume m h, exact le_abs_self _,
  have := sum_le_of_terms_le₂ (max n i) j ji hmi,
  refine abs_sub_le_iff.mpr _,split,
  refine le_trans this _,
  refine sum_le_of_terms_le₂ _ _ _ _,exact ji,
  assume m h,exact hm m (le_trans (le_max_left n i) h),
  have : sum_lt_nat f (max n i) - sum_lt_nat f j = -1 * sum_lt_nat f j - -1 * sum_lt_nat f (max n i),ring,
  rw [this,sum_lt_nat_mul,sum_lt_nat_mul],
  refine sum_le_of_terms_le₂ _ _ _ _,exact ji,
  assume m h,
  have := hm m (le_trans (le_max_left n i) h),
  refine le_trans _ this,simp,rw ←abs_neg, exact le_abs_self _,
end

lemma exp_series_cau (x : ℝ) : is_cau_seq abs (sum_lt_nat (λ m, monoid.pow x m / fact m)) := begin
  have nat_nonneg : ∀ n : ℕ, 0 ≤ (n : ℝ),assume n,rw [←nat.cast_zero,nat.cast_le],exact zero_le _,
  cases exists_nat_gt (abs x) with n nx,
  have xn : abs (x / n) < 1,rw [abs_div,div_lt_iff,@abs_of_nonneg _ _ (n : ℝ)],simpa,
  rw [←nat.cast_zero,(λ x y, by simp : ∀ x y : ℝ, x ≥ y ↔ y ≤ x ),nat.cast_le],exact zero_le _,
  refine abs_pos_of_ne_zero _,assume hn,rw hn at nx,exact not_lt_of_ge (abs_nonneg _) nx,
  refine le_test _ _ n _ (geometric_series_const (monoid.pow n n) (abs (x / ↑n)) _),
  assume m mn,
  generalize hk : m - n = k,
  have :  monoid.pow (abs (x / ↑n)) m = monoid.pow (abs x) m * (monoid.pow (n : ℝ) m)⁻¹,
    clear mn hk nx xn k,induction m with m hi,
    simp!,unfold monoid.pow,rw mul_inv',
    have : abs x * monoid.pow (abs x) m * ((monoid.pow ↑n m)⁻¹ * (↑n)⁻¹) = (abs x * (n : ℝ)⁻¹) * ((monoid.pow n m)⁻¹ * monoid.pow (abs x) m),ring,
    rw this,rw [←div_eq_mul_inv,hi,abs_div],have : abs (n : ℝ) = n,rw abs_of_nonneg,rw[← nat.cast_zero,(λ x y, by simp : Π x y : ℝ, x ≥ y ↔ y ≤ x),nat.cast_le],exact zero_le _,
    rw this,ring,
  rw [this,mul_left_comm,abs_div,div_eq_mul_inv,←pow_abs],
  refine mul_le_mul _ _ _ _,trivial,clear this,
  rw nat.sub_eq_iff_eq_add at hk,rw hk,simp,clear xn,revert m n,
  induction k with k' hi,
  assume m n nx mn hk,
  simp,rw [mul_inv_cancel,inv_le],simp,
  clear hk mn nx m x,
  induction n with n hi,simp,
  unfold fact,rw[nat.cast_mul,abs_mul,←one_mul (1 : ℝ)],refine mul_le_mul _ _ _ _,
  rw [←nat.cast_one],refine le_trans _ (le_abs_self _),
  rw nat.cast_le,exact dec_trivial,exact hi,{norm_num},exact abs_nonneg _,
  refine lt_of_lt_of_le _ (le_abs_self _),rw [←nat.cast_zero,nat.cast_lt],exact fact_pos _,
  {norm_num},
  refine (ne_of_lt _).symm,
  refine pow_pos _ _,refine lt_of_le_of_lt _ nx,exact abs_nonneg _,
  assume m n nx mn hk,
  have : k' + n ≥ n,rw ←zero_add n,refine add_le_add _ _,exact zero_le _,rw zero_add,
  replace hi := hi (k' + n) n nx this rfl,
  rw add_succ,unfold fact monoid.pow,
  rw [mul_inv',nat.cast_mul,abs_mul,mul_inv',←mul_assoc],
  refine mul_le_mul _ _ _ _,assumption,
  rw inv_le_inv,refine le_trans _ (le_abs_self _),
  rw [nat.cast_le,←add_succ,←add_zero n],refine add_le_add _ _,
  simp,exact zero_le _,
  refine abs_pos_of_ne_zero _,
  rw [←nat.cast_zero,ne.def,nat.cast_inj],exact dec_trivial,
  refine lt_of_le_of_lt _ nx,exact abs_nonneg _,
  rw ←abs_inv,exact abs_nonneg _,
  refine mul_nonneg _ _,
  refine pow_nonneg _ _,rw [← nat.cast_zero,(λ x y,by simp : Π x y : ℝ, x ≥ y ↔ y ≤ x), nat.cast_le],exact zero_le _,
  rw [(λ x y,by simp : Π x y : ℝ, x ≥ y ↔ y ≤ x),inv_nonneg],
  refine pow_nonneg _ _,exact nat_nonneg _,
  exact mn,rw inv_nonneg,exact abs_nonneg _,rw pow_abs,exact abs_nonneg _,
  rwa abs_abs,
end

def exp (x : ℝ) : ℝ := lim ⟨(sum_lt_nat (λ m, monoid.pow x m / fact m)), exp_series_cau x⟩


/-
COMP2009-ACE

Exercise 02 (Predicate logic) (20)

    This exercise has 2 parts. In the 1st part you are supposed to
    formally define what certain relation bewteen humans are (like
    Father, brother-in-law etc). Here we use Lean only as a syntax
    and type checker.
    In the 2nd part we play logic poker again :-) but this time for
    predicate logic.

-/

-- part 1 (10)
namespace family

-- Given the following type, predicates and relations:

constant People : Type
constants Male Female : People → Prop
-- Male x means x is male
-- Female x means x is fmeale
constant Parent : People → People → Prop
-- Parent x y means x is a parent of y
constant Married : People → People → Prop
-- Married x y means x is married to y

/-
Define the following relations (People → People → Prop)
using the predicates and relations above:

- Father x y = x is the father of y
- Brother x y = x is the brother of y
- Grandmother x y = x is the grandmother of y
- FatherInLaw x y = x is the father-in-law of y
- SisterInLaw x y = x is the sister in law of y
- Uncle x y = x is the uncle of y

If you are not sure about the definition of these terms, check them
in wikipedia. If there is more than one option choose one.
-/

/- As an example: here is the definition of Father: -/

def Father (x y : People) : Prop
  := Parent x y ∧ Male x

-- add your definitions here!

end family

-- part 2 (10)
namespace poker
/-
   We play the game of logic poker - but this time with predicate logic :-)

    You have to classify the propositions into
    a) provable intuitionistically (i.e. in plain lean)
    b) provable classically (using em : P ∨ ¬ P or raa : ¬¬ P → P).
    c) not provable classically.
    and then you have to prove the propositions in a) and b) accordingly.

    Here is how you score:
    We start with 10 points :-)
    For any proposition which you didn't classify correctly (or not at all)
    you loose 1 point. :-(
    For any proposition which is provable but you didn't prove you loose
    1 point. :-(
    We stop subtracting points at 0. :-)

    Write the classification as a comment using -- after the proposition.

    You are only allowed to use the tactics introduced in the lecture
    (i.e. assume, exact, apply, constructor, cases, left, right, have,
    trivial, existsi, reflexivity, rewrite)

    Please only use the tactics in the way indicated in the script,
    otherwise you may lose upto 2 style points.

    For propositions classified into c) just keep "sorry," as the proof.
-/

variable A : Type
variables PP QQ : A → Prop
variables RR : A → A → Prop
variables P Q R : Prop

open classical

theorem raa : ¬ ¬ P → P :=
begin
  assume nnp,
  cases (em P) with p np,
    exact p,
    have f : false,
      apply nnp,
      exact np,
    cases f,
end

theorem ex01 : (∀ x:A, ∃ y : A , RR x y) → (∃ y : A, ∀ x : A, RR x y) :=
begin
    -- Not provable (c)
    sorry,
end

theorem ex02 :  (∃ y : A, ∀ x : A, RR x y) → (∀ x:A, ∃ y : A , RR x y) :=
begin
    assume a b,
    /-
        a : ∃ y : A, ∀ x : A, RR x y
        b : A
        ⊢  ∃ y : A , RR x y
    -/
    cases a with c d,
    /-
        b c : A
        d : ∀ x : A, RR x y
        ⊢  ∃ y : A , RR x y
    -/
    existsi c,
    /-
        b c : A
        d : ∀ x : A, RR x y
        ⊢  RR x c
    -/
    apply d,
    /-
        No goals
    -/
end

theorem ex03 : ∀ x y : A, x = y → RR x y → RR x x :=
begin
    assume x y a,
    /-
        x y : A
        a : x = y
        ⊢ RR x y → RR x x
    -/
    rewrite a,
    /-
        x y : A
        a : x = y
        ⊢ RR y y → RR y y
    -/
    assume b,
    /-
        x y : A
        a : x = y
        b : RR y y
        ⊢ RR y y
    -/
    exact b,
    /-
        No goals
    -/
end

theorem ex04 : ∀ x y z : A, x ≠ y → x ≠ z → y ≠ z :=
begin
    sorry
    -- Not provable
end

theorem ex05 : ∀ x y z : A, x = y → x ≠ z → y ≠ z :=
begin
    assume x y z xy xz yz,
    /-
        x y z : A
        xy : x = y
        xz : x ≠ z
        yz : y = z
        ⊢ false
    -/
    apply xz,
    /-
        x y z : A
        xy : x = y
        xz : x ≠ z
        yz : y = z
        ⊢ x = z
    -/
    rewrite xy,
    /-
        x y z : A
        xy : x = y
        xz : x ≠ z
        yz : y = z
        ⊢ y = z
    -/
    exact yz,
    /-
        No goals
    -/
end

theorem ex06 : ∀ x y z : A, x ≠ y → (x ≠ z ∨ y ≠ z) :=
begin
    assume x y z xy,
    /-
        x y z : A
        xy : x ≠ y
        ⊢  x ≠ z ∨ y ≠ z
    -/
    cases em (y = z) with h nh,
    /-
        (Case 1)
        x y z : A
        xy : x ≠ y
        h : y = z
        ⊢  x ≠ z ∨ y ≠ z

        (Case 2)
        x y z : A
        xy : x ≠ y
        h : y ≠ z
        ⊢  x ≠ z ∨ y ≠ z
    -/
    left,
    /-
        (Case 1)
        x y z : A
        xy : x ≠ y
        h : y = z
        ⊢  x ≠ z

        (Case 2)
        x y z : A
        xy : x ≠ y
        h : y ≠ z
        ⊢  x ≠ z ∨ y ≠ z
    -/
    rewrite← h,
    /-
        (Case 1)
        x y z : A
        xy : x ≠ y
        h : y = z
        ⊢  x ≠ y

        (Case 2)
        x y z : A
        xy : x ≠ y
        h : y ≠ z
        ⊢  x ≠ z ∨ y ≠ z
    -/
    exact xy,
    /-
        Gets rid of Case 1
    -/
    right,
    /-
         (Case 2)
        x y z : A
        xy : x ≠ y
        h : y ≠ z
        ⊢ y ≠ z
    -/
    exact nh,
    /-
        No goals (Gets rid of Case 2)
    -/
end

theorem ex07 : ¬ ¬ (∀ x : A, PP x) → ∀ x : A, ¬ ¬ PP x :=
begin
    assume x y z,
    /-
        x : ¬ ¬ ∀ x : A, PP x
        y : A
        z : ¬PP x
        ⊢   false
    -/
    apply x,
    /-
        x : ¬ ¬ ∀ x : A, PP x
        y : A
        z : ¬PP x
        ⊢  ¬ ∀ x : A, PP x
    -/
    assume a,
    /-
        x : ¬ ¬ ∀ x : A, PP x
        y : A
        z : ¬PP x
        a : ∀ x : A, PP x
        ⊢  false
    -/
    apply z,
    /-
        x : ¬ ¬ ∀ x : A, PP x
        y : A
        z : ¬PP x
        a : ∀ x : A, PP x
        ⊢  PP x
    -/
    apply a,
    /-
        No goals
    -/
end

theorem ex08 : (∀ x : A, ¬ ¬ PP x) → ¬ ¬ ∀ x : A, PP x :=
begin
    assume x y,
    /-
        x : ∀ x : A, ¬ ¬ PP x
        y : ¬ ∀ x : A, PP x
        ⊢ false
    -/
    apply y
    /-
        x : ∀ x : A, ¬ ¬ PP x
        y : ¬ ∀ x : A, PP x
        ⊢ ∀ x : A, PP x
    -/
    assume z,
    /-
        x : ∀ x : A, ¬ ¬ PP x
        y : ¬ ∀ x : A, PP x
        z : A
        ⊢ PP x
    -/
    apply raa,
    /-
        x : ∀ x : A, ¬ ¬ PP x
        y : ¬ ∀ x : A, PP x
        z : A
        ⊢ ¬¬ PP x
    -/
    apply x,
    /-
        No goals
    -/
end

theorem ex09 : (∃ x : A, true) → (∃ x:A, PP x) → ∀ x : A,PP x :=
begin
    sorry,
end

theorem ex10 : (∃ x : A, true) → (∃ x:A, PP x → ∀ x : A,PP x) :=
begin
  sorry
end

end poker


/-
Copyright (c) 2020 Heather Macbeth. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Heather Macbeth
-/
import topology.algebra.ring.ideal
import analysis.specific_limits.normed

/-!
# The group of units of a complete normed ring

This file contains the basic theory for the group of units (invertible elements) of a complete
normed ring (Banach algebras being a notable special case).

## Main results

The constructions `one_sub`, `add` and `unit_of_nearby` state, in varying forms, that perturbations
of a unit are units.  The latter two are not stated in their optimal form; more precise versions
would use the spectral radius.

The first main result is `is_open`:  the group of units of a complete normed ring is an open subset
of the ring.

The function `inverse` (defined in `algebra.ring`), for a ring `R`, sends `a : R` to `a⁻¹` if `a` is
a unit and 0 if not.  The other major results of this file (notably `inverse_add`,
`inverse_add_norm` and `inverse_add_norm_diff_nth_order`) cover the asymptotic properties of
`inverse (x + t)` as `t → 0`.

-/

noncomputable theory
open_locale topology
variables {R : Type*} [normed_ring R] [complete_space R]

namespace units

/-- In a complete normed ring, a perturbation of `1` by an element `t` of distance less than `1`
from `1` is a unit.  Here we construct its `units` structure.  -/
@[simps coe]
def one_sub (t : R) (h : ‖t‖ < 1) : Rˣ :=
{ val := 1 - t,
  inv := ∑' n : ℕ, t ^ n,
  val_inv := mul_neg_geom_series t h,
  inv_val := geom_series_mul_neg t h }

/-- In a complete normed ring, a perturbation of a unit `x` by an element `t` of distance less than
`‖x⁻¹‖⁻¹` from `x` is a unit.  Here we construct its `units` structure. -/
@[simps coe]
def add (x : Rˣ) (t : R) (h : ‖t‖ < ‖(↑x⁻¹ : R)‖⁻¹) : Rˣ :=
units.copy  -- to make `coe_add` true definitionally, for convenience
  (x * (units.one_sub (-(↑x⁻¹ * t)) begin
      nontriviality R using [zero_lt_one],
      have hpos : 0 < ‖(↑x⁻¹ : R)‖ := units.norm_pos x⁻¹,
      calc ‖-(↑x⁻¹ * t)‖
          = ‖↑x⁻¹ * t‖                    : by { rw norm_neg }
      ... ≤ ‖(↑x⁻¹ : R)‖ * ‖t‖            : norm_mul_le ↑x⁻¹ _
      ... < ‖(↑x⁻¹ : R)‖ * ‖(↑x⁻¹ : R)‖⁻¹ : by nlinarith only [h, hpos]
      ... = 1                             : mul_inv_cancel (ne_of_gt hpos)
    end))
  (x + t) (by simp [mul_add]) _ rfl

/-- In a complete normed ring, an element `y` of distance less than `‖x⁻¹‖⁻¹` from `x` is a unit.
Here we construct its `units` structure. -/
@[simps coe]
def unit_of_nearby (x : Rˣ) (y : R) (h : ‖y - x‖ < ‖(↑x⁻¹ : R)‖⁻¹) : Rˣ :=
units.copy (x.add (y - x : R) h) y (by simp) _ rfl

/-- The group of units of a complete normed ring is an open subset of the ring. -/
protected lemma is_open : is_open {x : R | is_unit x} :=
begin
  nontriviality R,
  apply metric.is_open_iff.mpr,
  rintros x' ⟨x, rfl⟩,
  refine ⟨‖(↑x⁻¹ : R)‖⁻¹, _root_.inv_pos.mpr (units.norm_pos x⁻¹), _⟩,
  intros y hy,
  rw [metric.mem_ball, dist_eq_norm] at hy,
  exact (x.unit_of_nearby y hy).is_unit
end

protected lemma nhds (x : Rˣ) : {x : R | is_unit x} ∈ 𝓝 (x : R) :=
is_open.mem_nhds units.is_open x.is_unit

end units

namespace nonunits

/-- The `nonunits` in a complete normed ring are contained in the complement of the ball of radius
`1` centered at `1 : R`. -/
lemma subset_compl_ball : nonunits R ⊆ (metric.ball (1 : R) 1)ᶜ :=
set.subset_compl_comm.mp $ λ x hx, by simpa [sub_sub_self, units.coe_one_sub] using
  (units.one_sub (1 - x) (by rwa [metric.mem_ball, dist_eq_norm, norm_sub_rev] at hx)).is_unit

/- The `nonunits` in a complete normed ring are a closed set -/
protected lemma is_closed : is_closed (nonunits R) := units.is_open.is_closed_compl

end nonunits

namespace normed_ring
open_locale classical big_operators
open asymptotics filter metric finset ring

lemma inverse_one_sub (t : R) (h : ‖t‖ < 1) : inverse (1 - t) = ↑(units.one_sub t h)⁻¹ :=
by rw [← inverse_unit (units.one_sub t h), units.coe_one_sub]

/-- The formula `inverse (x + t) = inverse (1 + x⁻¹ * t) * x⁻¹` holds for `t` sufficiently small. -/
lemma inverse_add (x : Rˣ) :
  ∀ᶠ t in (𝓝 0), inverse ((x : R) + t) = inverse (1 + ↑x⁻¹ * t) * ↑x⁻¹ :=
begin
  nontriviality R,
  rw [eventually_iff, metric.mem_nhds_iff],
  have hinv : 0 < ‖(↑x⁻¹ : R)‖⁻¹, by cancel_denoms,
  use [‖(↑x⁻¹ : R)‖⁻¹, hinv],
  intros t ht,
  simp only [mem_ball, dist_zero_right] at ht,
  have ht' : ‖-↑x⁻¹ * t‖ < 1,
  { refine lt_of_le_of_lt (norm_mul_le _ _) _,
    rw norm_neg,
    refine lt_of_lt_of_le (mul_lt_mul_of_pos_left ht x⁻¹.norm_pos) _,
    cancel_denoms },
  have hright := inverse_one_sub (-↑x⁻¹ * t) ht',
  have hleft := inverse_unit (x.add t ht),
  simp only [neg_mul, sub_neg_eq_add] at hright,
  simp only [units.coe_add] at hleft,
  simp [hleft, hright, units.add]
end

lemma inverse_one_sub_nth_order (n : ℕ) :
  ∀ᶠ t in (𝓝 0), inverse ((1:R) - t) = (∑ i in range n, t ^ i) + (t ^ n) * inverse (1 - t) :=
begin
  simp only [eventually_iff, metric.mem_nhds_iff],
  use [1, by norm_num],
  intros t ht,
  simp only [mem_ball, dist_zero_right] at ht,
  simp only [inverse_one_sub t ht, set.mem_set_of_eq],
  have h : 1 = ((range n).sum (λ i, t ^ i)) * (units.one_sub t ht) + t ^ n,
  { simp only [units.coe_one_sub],
    rw [geom_sum_mul_neg],
    simp },
  rw [← one_mul ↑(units.one_sub t ht)⁻¹, h, add_mul],
  congr,
  { rw [mul_assoc, (units.one_sub t ht).mul_inv],
    simp },
  { simp only [units.coe_one_sub],
    rw [← add_mul, geom_sum_mul_neg],
    simp }
end

/-- The formula
`inverse (x + t) = (∑ i in range n, (- x⁻¹ * t) ^ i) * x⁻¹ + (- x⁻¹ * t) ^ n * inverse (x + t)`
holds for `t` sufficiently small. -/
lemma inverse_add_nth_order (x : Rˣ) (n : ℕ) :
  ∀ᶠ t in (𝓝 0), inverse ((x : R) + t)
  = (∑ i in range n, (- ↑x⁻¹ * t) ^ i) * ↑x⁻¹ + (- ↑x⁻¹ * t) ^ n * inverse (x + t) :=
begin
  refine (inverse_add x).mp _,
  have hzero : tendsto (λ (t : R), - ↑x⁻¹ * t) (𝓝 0) (𝓝 0),
  { convert ((mul_left_continuous (- (↑x⁻¹ : R))).tendsto 0).comp tendsto_id,
    simp },
  refine (hzero.eventually (inverse_one_sub_nth_order n)).mp (eventually_of_forall _),
  simp only [neg_mul, sub_neg_eq_add],
  intros t h1 h2,
  have h := congr_arg (λ (a : R), a * ↑x⁻¹) h1,
  dsimp at h,
  convert h,
  rw [add_mul, mul_assoc],
  simp [h2.symm]
end

lemma inverse_one_sub_norm : (λ t : R, inverse (1 - t)) =O[𝓝 0] (λ t, 1 : R → ℝ) :=
begin
  simp only [is_O, is_O_with, eventually_iff, metric.mem_nhds_iff],
  refine ⟨‖(1:R)‖ + 1, (2:ℝ)⁻¹, by norm_num, _⟩,
  intros t ht,
  simp only [ball, dist_zero_right, set.mem_set_of_eq] at ht,
  have ht' : ‖t‖ < 1,
  { have : (2:ℝ)⁻¹ < 1 := by cancel_denoms,
    linarith },
  simp only [inverse_one_sub t ht', norm_one, mul_one, set.mem_set_of_eq],
  change ‖∑' n : ℕ, t ^ n‖ ≤ _,
  have := normed_ring.tsum_geometric_of_norm_lt_1 t ht',
  have : (1 - ‖t‖)⁻¹ ≤ 2,
  { rw ← inv_inv (2:ℝ),
    refine inv_le_inv_of_le (by norm_num) _,
    have : (2:ℝ)⁻¹ + (2:ℝ)⁻¹ = 1 := by ring,
    linarith },
  linarith
end

/-- The function `λ t, inverse (x + t)` is O(1) as `t → 0`. -/
lemma inverse_add_norm (x : Rˣ) : (λ t : R, inverse (↑x + t)) =O[𝓝 0] (λ t, (1:ℝ)) :=
begin
  simp only [is_O_iff, norm_one, mul_one],
  cases is_O_iff.mp (@inverse_one_sub_norm R _ _) with C hC,
  use C * ‖((x⁻¹:Rˣ):R)‖,
  have hzero : tendsto (λ t, - (↑x⁻¹ : R) * t) (𝓝 0) (𝓝 0),
  { convert ((mul_left_continuous (-↑x⁻¹ : R)).tendsto 0).comp tendsto_id,
    simp },
  refine (inverse_add x).mp ((hzero.eventually hC).mp (eventually_of_forall _)),
  intros t bound iden,
  rw iden,
  simp at bound,
  have hmul := norm_mul_le (inverse (1 + ↑x⁻¹ * t)) ↑x⁻¹,
  nlinarith [norm_nonneg (↑x⁻¹ : R)]
end

/-- The function
`λ t, inverse (x + t) - (∑ i in range n, (- x⁻¹ * t) ^ i) * x⁻¹`
is `O(t ^ n)` as `t → 0`. -/
lemma inverse_add_norm_diff_nth_order (x : Rˣ) (n : ℕ) :
  (λ t : R, inverse (↑x + t) - (∑ i in range n, (- ↑x⁻¹ * t) ^ i) * ↑x⁻¹) =O[𝓝 (0:R)]
  (λ t, ‖t‖ ^ n) :=
begin
  by_cases h : n = 0,
  { simpa [h] using inverse_add_norm x },
  have hn : 0 < n := nat.pos_of_ne_zero h,
  simp [is_O_iff],
  cases (is_O_iff.mp (inverse_add_norm x)) with C hC,
  use C * ‖(1:ℝ)‖ * ‖(↑x⁻¹ : R)‖ ^ n,
  have h : eventually_eq (𝓝 (0:R))
    (λ t, inverse (↑x + t) - (∑ i in range n, (- ↑x⁻¹ * t) ^ i) * ↑x⁻¹)
    (λ t, ((- ↑x⁻¹ * t) ^ n) * inverse (x + t)),
  { refine (inverse_add_nth_order x n).mp (eventually_of_forall _),
    intros t ht,
    convert congr_arg (λ a, a - (range n).sum (pow (-↑x⁻¹ * t)) * ↑x⁻¹) ht,
    simp },
  refine h.mp (hC.mp (eventually_of_forall _)),
  intros t _ hLHS,
  simp only [neg_mul] at hLHS,
  rw hLHS,
  refine le_trans (norm_mul_le _ _ ) _,
  have h' : ‖(-(↑x⁻¹ * t)) ^ n‖ ≤ ‖(↑x⁻¹ : R)‖ ^ n * ‖t‖ ^ n,
  { calc ‖(-(↑x⁻¹ * t)) ^ n‖ ≤ ‖(-(↑x⁻¹ * t))‖ ^ n : norm_pow_le' _ hn
    ... = ‖↑x⁻¹ * t‖ ^ n : by rw norm_neg
    ... ≤ (‖(↑x⁻¹ : R)‖ * ‖t‖) ^ n : _
    ... =  ‖(↑x⁻¹ : R)‖ ^ n * ‖t‖ ^ n : mul_pow _ _ n,
    exact pow_le_pow_of_le_left (norm_nonneg _) (norm_mul_le ↑x⁻¹ t) n },
  have h'' : 0 ≤ ‖(↑x⁻¹ : R)‖ ^ n * ‖t‖ ^ n,
  { refine mul_nonneg _ _;
    exact pow_nonneg (norm_nonneg _) n },
  nlinarith [norm_nonneg (inverse (↑x + t))],
end

/-- The function `λ t, inverse (x + t) - x⁻¹` is `O(t)` as `t → 0`. -/
lemma inverse_add_norm_diff_first_order (x : Rˣ) :
  (λ t : R, inverse (↑x + t) - ↑x⁻¹) =O[𝓝 0] (λ t, ‖t‖) :=
by simpa using inverse_add_norm_diff_nth_order x 1

/-- The function
`λ t, inverse (x + t) - x⁻¹ + x⁻¹ * t * x⁻¹`
is `O(t ^ 2)` as `t → 0`. -/
lemma inverse_add_norm_diff_second_order (x : Rˣ) :
  (λ t : R, inverse (↑x + t) - ↑x⁻¹ + ↑x⁻¹ * t * ↑x⁻¹) =O[𝓝 0] (λ t, ‖t‖ ^ 2) :=
begin
  convert inverse_add_norm_diff_nth_order x 2,
  ext t,
  simp only [range_succ, range_one, sum_insert, mem_singleton, sum_singleton, not_false_iff,
    one_ne_zero, pow_zero, add_mul, pow_one, one_mul, neg_mul,
    sub_add_eq_sub_sub_swap, sub_neg_eq_add],
end

/-- The function `inverse` is continuous at each unit of `R`. -/
lemma inverse_continuous_at (x : Rˣ) : continuous_at inverse (x : R) :=
begin
  have h_is_o : (λ t : R, inverse (↑x + t) - ↑x⁻¹) =o[𝓝 0] (λ _, 1 : R → ℝ) :=
    (inverse_add_norm_diff_first_order x).trans_is_o (is_o.norm_left $ is_o_id_const one_ne_zero),
  have h_lim : tendsto (λ (y:R), y - x) (𝓝 x) (𝓝 0),
  { refine tendsto_zero_iff_norm_tendsto_zero.mpr _,
    exact tendsto_iff_norm_tendsto_zero.mp tendsto_id },
  rw [continuous_at, tendsto_iff_norm_tendsto_zero, inverse_unit],
  simpa [(∘)] using h_is_o.norm_left.tendsto_div_nhds_zero.comp h_lim
end

end normed_ring

namespace units
open mul_opposite filter normed_ring

/-- In a normed ring, the coercion from `Rˣ` (equipped with the induced topology from the
embedding in `R × R`) to `R` is an open map. -/
lemma is_open_map_coe : is_open_map (coe : Rˣ → R) :=
begin
  rw is_open_map_iff_nhds_le,
  intros x s,
  rw [mem_map, mem_nhds_induced],
  rintros ⟨t, ht, hts⟩,
  obtain ⟨u, hu, v, hv, huvt⟩ :
    ∃ (u : set R), u ∈ 𝓝 ↑x ∧ ∃ (v : set Rᵐᵒᵖ), v ∈ 𝓝 (op ↑x⁻¹) ∧ u ×ˢ v ⊆ t,
  { simpa [embed_product, mem_nhds_prod_iff] using ht },
  have : u ∩ (op ∘ ring.inverse) ⁻¹' v ∩ (set.range (coe : Rˣ → R)) ∈ 𝓝 ↑x,
  { refine inter_mem (inter_mem hu _) (units.nhds x),
    refine (continuous_op.continuous_at.comp (inverse_continuous_at x)).preimage_mem_nhds _,
    simpa using hv },
  refine mem_of_superset this _,
  rintros _ ⟨⟨huy, hvy⟩, ⟨y, rfl⟩⟩,
  have : embed_product R y ∈ u ×ˢ v := ⟨huy, by simpa using hvy⟩,
  simpa using hts (huvt this)
end

/-- In a normed ring, the coercion from `Rˣ` (equipped with the induced topology from the
embedding in `R × R`) to `R` is an open embedding. -/
lemma open_embedding_coe : open_embedding (coe : Rˣ → R) :=
open_embedding_of_continuous_injective_open continuous_coe ext is_open_map_coe

end units

namespace ideal

/-- An ideal which contains an element within `1` of `1 : R` is the unit ideal. -/
lemma eq_top_of_norm_lt_one (I : ideal R) {x : R} (hxI : x ∈ I) (hx : ‖1 - x‖ < 1) : I = ⊤ :=
let u := units.one_sub (1 - x) hx in (I.eq_top_iff_one.mpr $
  by simpa only [show u.inv * x = 1, by simp] using I.mul_mem_left u.inv hxI)

/-- The `ideal.closure` of a proper ideal in a complete normed ring is proper. -/
lemma closure_ne_top (I : ideal R) (hI : I ≠ ⊤) : I.closure ≠ ⊤ :=
have h : _ := closure_minimal (coe_subset_nonunits hI) nonunits.is_closed,
  by simpa only [I.closure.eq_top_iff_one, ne.def] using mt (@h 1) one_not_mem_nonunits

/-- The `ideal.closure` of a maximal ideal in a complete normed ring is the ideal itself. -/
lemma is_maximal.closure_eq {I : ideal R} (hI : I.is_maximal) : I.closure = I :=
(hI.eq_of_le (I.closure_ne_top hI.ne_top) subset_closure).symm

/-- Maximal ideals in complete normed rings are closed. -/
instance is_maximal.is_closed {I : ideal R} [hI : I.is_maximal] : is_closed (I : set R) :=
is_closed_of_closure_subset $ eq.subset $ congr_arg (coe : ideal R → set R) hI.closure_eq

end ideal