/-
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 number_theory.padics.padic_norm
import analysis.normed.field.basic

/-!
# 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 p.prime]` 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 (f m) at hne,
    have hnam := add_eq_max_of_ne 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 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 (g i)] at h,
  let hpnem := add_eq_max_of_ne 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 hfgne
end

end embedding
end padic_seq

/-- The `p`-adic numbers `ℚ_[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]

instance : field (ℚ_[p]) := Cauchy.field

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

-- short circuits

instance : comm_ring (ℚ_[p]) := Cauchy.comm_ring
instance : ring (ℚ_[p]) := Cauchy.ring
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

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

variables (p)

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

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

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

@[norm_cast] lemma coe_inj {q r : ℚ} : (↑q : ℚ_[p]) = ↑r ↔ q = r :=
⟨(const_equiv p).1 ∘ quotient.eq.1, λ h, by rw h⟩

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

@[norm_cast] lemma coe_add : ∀ {x y : ℚ}, (↑(x + y) : ℚ_[p]) = ↑x + ↑y := rat.cast_add
@[norm_cast] lemma coe_neg : ∀ {x : ℚ}, (↑(-x) : ℚ_[p]) = -↑x := rat.cast_neg
@[norm_cast] lemma coe_mul : ∀ {x y : ℚ}, (↑(x * y) : ℚ_[p]) = ↑x * ↑y := rat.cast_mul
@[norm_cast] lemma coe_sub : ∀ {x y : ℚ}, (↑(x - y) : ℚ_[p]) = ↑x - ↑y := rat.cast_sub
@[norm_cast] lemma coe_div : ∀ {x y : ℚ}, (↑(x / y) : ℚ_[p]) = ↑x / ↑y := rat.cast_div
@[norm_cast] lemma coe_one : (↑1 : ℚ_[p]) = 1 := rfl
@[norm_cast] lemma coe_zero : (↑0 : ℚ_[p]) = 0 := rfl

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] : absolute_value ℚ_[p] ℚ :=
{ to_fun := quotient.lift padic_seq.norm $ @padic_seq.norm_equiv _ _,
  map_mul' := λ q r, quotient.induction_on₂ q r $ padic_seq.norm_mul,
  nonneg' := λ q, quotient.induction_on q $ padic_seq.norm_nonneg,
  eq_zero' := λ q, quotient.induction_on q $
                    by simpa only [padic.zero_def, quotient.eq] using padic_seq.norm_zero_iff,
  add_le' := λ q r, begin
    transitivity max ((quotient.lift padic_seq.norm $ @padic_seq.norm_equiv _ _) q)
                     ((quotient.lift padic_seq.norm $ @padic_seq.norm_equiv _ _) r),
    exact (quotient.induction_on₂ q r $ padic_seq.norm_nonarchimedean),
    refine max_le_add_of_nonneg (quotient.induction_on q $ padic_seq.norm_nonneg) _,
    exact (quotient.induction_on r $ padic_seq.norm_nonneg)
  end }

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
  dsimp [padic_norm_e],
  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

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

@[simp] lemma eq_padic_norm' (q : ℚ) : padic_norm_e (q : ℚ_[p]) = 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

end embedding
end padic_norm_e

namespace padic

section complete
open padic_seq padic

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

theorem rat_dense' (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
      dsimp [padic_norm_e],
      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⟩

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'],
    exact_mod_cast this },
  { apply lt_of_le_of_lt,
    { apply padic_norm_e.add_le },
    { 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_le },
        { apply add_lt_add,
          { rw [padic_norm_e.map_sub],
            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 simp [dist, ←padic_norm_e.map_neg (x - y)],
  dist_triangle := λ x y z,
  begin
    unfold dist,
    exact_mod_cast padic_norm_e.sub_le _ _ _,
  end,
  eq_of_dist_eq_zero :=
    begin
      unfold dist, intros _ _ h,
      apply eq_of_sub_eq_zero,
      apply padic_norm_e.eq_zero.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, map_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, map_mul] }

theorem rat_dense (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, map_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']
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,
  rw ← @rat.cast_coe_nat ℝ _ p,
  rw ← @rat.cast_coe_nat (ℚ_[p]) _ p,
  simp [p₀, p₁, norm, padic_norm, padic_val_rat, padic_val_int, zpow_neg, -rat.cast_coe_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_zpow (n : ℤ) : ‖(p ^ n : ℚ_[p])‖ = p ^ -n :=
by rw [norm_zpow, norm_p, zpow_neg, inv_zpow]

@[simp] lemma norm_p_pow (n : ℕ) : ‖(p ^ n : ℚ_[p])‖ = p ^ (-n : ℤ) :=
by rw [←norm_p_zpow, zpow_coe_nat]

instance : nontrivially_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 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 {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 {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 : fact p.prime]
include hp

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 [padic_norm_e.map_sub],
  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, rat.cast_coe_nat] },
  { 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,
  refine neg_injective ((zpow_strict_mono h).injective $ (norm_eq_pow_val _).symm.trans _),
  { exact_mod_cast (fact.out p.prime).ne_zero },
  { simp }
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.elim },
      rwa [norm_eq_pow_val hx, norm_eq_pow_val hy, norm_eq_pow_val hxy,
        zpow_le_max_iff_min_le hp_one] at 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.elim },
  have hp_pos : (0 : ℝ) < p,
  { rw [← nat.cast_zero, nat.cast_lt],
    exact nat.prime.pos hp.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.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.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]

lemma norm_le_one_iff_val_nonneg (x : ℚ_[p]) : ‖ x ‖ ≤ 1 ↔ 0 ≤ x.valuation :=
begin
  by_cases hx : x = 0,
  { simp only [hx, norm_zero, valuation_zero, zero_le_one, le_refl], },
  { rw [norm_eq_pow_val hx, ← zpow_zero (p : ℝ), zpow_le_iff_le, right.neg_nonpos_iff],
    exact nat.one_lt_cast.2 (nat.prime.one_lt' p).1 }
end

end norm_le_iff
end padic


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

import algebra.geom_sum
import data.rat.defs
import data.real.basic
import tactic.positivity

/-!
# IMO 2013 Q5

Let `ℚ>₀` be the positive rational numbers. Let `f : ℚ>₀ → ℝ` be a function satisfying
the conditions

1. `f(x) * f(y) ≥ f(x * y)`
2. `f(x + y) ≥ f(x) + f(y)`

for all `x, y ∈ ℚ>₀`. Given that `f(a) = a` for some rational `a > 1`, prove that `f(x) = x` for
all `x ∈ ℚ>₀`.

# Solution

We provide a direct translation of the solution found in
https://www.imo-official.org/problems/IMO2013SL.pdf
-/

open_locale big_operators

lemma le_of_all_pow_lt_succ {x y : ℝ} (hx : 1 < x) (hy : 1 < y)
  (h : ∀ n : ℕ, 0 < n → x^n - 1 < y^n) :
  x ≤ y :=
begin
  by_contra' hxy,
  have hxmy : 0 < x - y := sub_pos.mpr hxy,
  have hn : ∀ n : ℕ, 0 < n → (x - y) * (n : ℝ) ≤ x^n - y^n,
  { intros n hn,
    have hterm : ∀ i : ℕ, i ∈ finset.range n → 1 ≤ x^i * y^(n - 1 - i),
    { intros i hi,
      have hx' : 1 ≤ x ^ i := one_le_pow_of_one_le hx.le i,
      have hy' : 1 ≤ y ^ (n - 1 - i) := one_le_pow_of_one_le hy.le (n - 1 - i),
      calc 1 ≤ x^i             : hx'
         ... = x^i * 1         : (mul_one _).symm
         ... ≤ x^i * y^(n-1-i) : mul_le_mul_of_nonneg_left hy' (zero_le_one.trans hx') },

    calc (x - y) * (n : ℝ)
            = (n : ℝ) * (x - y) : mul_comm _ _
        ... = (∑ (i : ℕ) in finset.range n, (1 : ℝ)) * (x - y) :
                                  by simp only [mul_one, finset.sum_const, nsmul_eq_mul,
                                    finset.card_range]
        ... ≤ (∑ (i : ℕ) in finset.range n, x ^ i * y ^ (n - 1 - i)) * (x-y) :
                                  (mul_le_mul_right hxmy).mpr (finset.sum_le_sum hterm)
        ... = x^n - y^n         : geom_sum₂_mul x y n, },

  -- Choose n larger than 1 / (x - y).
  obtain ⟨N, hN⟩ := exists_nat_gt (1 / (x - y)),
  have hNp : 0 < N, { exact_mod_cast (one_div_pos.mpr hxmy).trans hN },

  have := calc 1 = (x - y) * (1 / (x - y)) : by field_simp [ne_of_gt hxmy]
             ... < (x - y) * N             : (mul_lt_mul_left hxmy).mpr hN
             ... ≤ x^N - y^N               : hn N hNp,
  linarith [h N hNp]
end

/--
 Like le_of_all_pow_lt_succ, but with a weaker assumption for y.
-/
lemma le_of_all_pow_lt_succ' {x y : ℝ} (hx : 1 < x) (hy : 0 < y)
  (h : ∀ n : ℕ, 0 < n → x^n - 1 < y^n) :
  x ≤ y :=
begin
  refine le_of_all_pow_lt_succ hx _ h,
  by_contra' hy'' : y ≤ 1,

  -- Then there exists y' such that 0 < y ≤ 1 < y' < x.
  let y' := (x + 1) / 2,
  have h_y'_lt_x : y' < x,
  { have hh : (x + 1)/2 < (x * 2) / 2, { linarith },
    calc y' < (x * 2) / 2 : hh
        ... = x           : by field_simp },
  have h1_lt_y' : 1 < y',
  { have hh' : 1 * 2 / 2 < (x + 1) / 2, { linarith },
    calc 1 = 1 * 2 / 2 : by field_simp
       ... < y'        : hh' },
  have h_y_lt_y' : y < y' := hy''.trans_lt h1_lt_y',
  have hh : ∀ n, 0 < n → x^n - 1 < y'^n,
  { intros n hn,
    calc x^n - 1 < y^n  : h n hn
            ...  ≤ y'^n : pow_le_pow_of_le_left hy.le h_y_lt_y'.le n },
  exact h_y'_lt_x.not_le (le_of_all_pow_lt_succ hx h1_lt_y' hh)
end

lemma f_pos_of_pos {f : ℚ → ℝ} {q : ℚ} (hq : 0 < q)
  (H1 : ∀ x y, 0 < x → 0 < y → f (x * y) ≤ f x * f y)
  (H4 : ∀ n : ℕ, 0 < n → (n : ℝ) ≤ f n) :
  0 < f q :=
begin
  have num_pos : 0 < q.num := rat.num_pos_iff_pos.mpr hq,
  have hmul_pos :=
    calc (0 : ℝ) < q.num   : int.cast_pos.mpr num_pos
      ... = ((q.num.nat_abs : ℤ) : ℝ) : congr_arg coe (int.nat_abs_of_nonneg num_pos.le).symm
      ... ≤ f q.num.nat_abs           : H4 q.num.nat_abs
                                          (int.nat_abs_pos_of_ne_zero num_pos.ne')
      ... = f q.num : by rw [nat.cast_nat_abs, abs_of_nonneg num_pos.le]
      ... = f (q * q.denom) : by rw ←rat.mul_denom_eq_num
      ... ≤ f q * f q.denom : H1 q q.denom hq (nat.cast_pos.mpr q.pos),
  have h_f_denom_pos :=
    calc (0 : ℝ) < q.denom : nat.cast_pos.mpr q.pos
      ... ≤ f q.denom : H4 q.denom q.pos,
  exact pos_of_mul_pos_left hmul_pos h_f_denom_pos.le,
end

lemma fx_gt_xm1 {f : ℚ → ℝ} {x : ℚ} (hx : 1 ≤ x)
  (H1 : ∀ x y, 0 < x → 0 < y → f (x * y) ≤ f x * f y)
  (H2 : ∀ x y, 0 < x → 0 < y → f x + f y ≤ f (x + y))
  (H4 : ∀ n : ℕ, 0 < n → (n : ℝ) ≤ f n) :
  (x - 1 : ℝ) < f x :=
begin
  have hx0 :=
    calc (x - 1 : ℝ)
          < ⌊x⌋₊   : by exact_mod_cast nat.sub_one_lt_floor x
      ... ≤ f ⌊x⌋₊ : H4 _ (nat.floor_pos.2 hx),

  obtain h_eq | h_lt := (nat.floor_le $ zero_le_one.trans hx).eq_or_lt,
  { rwa h_eq at hx0 },

  calc (x - 1 : ℝ) < f ⌊x⌋₊ : hx0
    ... < f (x - ⌊x⌋₊) + f ⌊x⌋₊ : lt_add_of_pos_left _ (f_pos_of_pos (sub_pos.mpr h_lt) H1 H4)
    ... ≤ f (x - ⌊x⌋₊ + ⌊x⌋₊)   : H2 _ _ (sub_pos.mpr h_lt) (nat.cast_pos.2 (nat.floor_pos.2 hx))
    ... = f x                   : by rw sub_add_cancel
end

lemma pow_f_le_f_pow {f : ℚ → ℝ} {n : ℕ} (hn : 0 < n) {x : ℚ} (hx : 1 < x)
  (H1 : ∀ x y, 0 < x → 0 < y → f (x * y) ≤ f x * f y)
  (H4 : ∀ n : ℕ, 0 < n → (n : ℝ) ≤ f n) :
  f (x^n) ≤ (f x)^n :=
begin
  induction n with pn hpn,
  { exfalso, exact nat.lt_asymm hn hn },
  cases pn,
  { simp only [pow_one] },
  have hpn' := hpn pn.succ_pos,
  rw [pow_succ' x (pn + 1), pow_succ' (f x) (pn + 1)],
  have hxp : 0 < x := by positivity,
  calc f ((x ^ (pn+1)) * x)
          ≤ f (x ^ (pn+1)) * f x : H1 (x ^ (pn+1)) x (pow_pos hxp (pn+1)) hxp
      ... ≤ (f x) ^ (pn+1) * f x : (mul_le_mul_right (f_pos_of_pos hxp H1 H4)).mpr hpn'
end

lemma fixed_point_of_pos_nat_pow {f : ℚ → ℝ} {n : ℕ} (hn : 0 < n)
  (H1 : ∀ x y, 0 < x → 0 < y → f (x * y) ≤ f x * f y)
  (H4 : ∀ n : ℕ, 0 < n → (n : ℝ) ≤ f n)
  (H5 : ∀ x : ℚ, 1 < x → (x : ℝ) ≤ f x)
  {a : ℚ} (ha1 : 1 < a) (hae : f a = a) :
  f (a^n) = a^n :=
begin
  have hh0 : (a : ℝ) ^ n ≤ f (a ^ n),
  { exact_mod_cast H5 (a ^ n) (one_lt_pow ha1 hn.ne') },

  have hh1 := calc f (a^n) ≤ (f a)^n   : pow_f_le_f_pow hn ha1 H1 H4
                       ... = (a : ℝ)^n : by rw ← hae,

  exact hh1.antisymm hh0
end

lemma fixed_point_of_gt_1 {f : ℚ → ℝ} {x : ℚ} (hx : 1 < x)
  (H1 : ∀ x y, 0 < x → 0 < y → f (x * y) ≤ f x * f y)
  (H2 : ∀ x y, 0 < x → 0 < y → f x + f y ≤ f (x + y))
  (H4 : ∀ n : ℕ, 0 < n → (n : ℝ) ≤ f n)
  (H5 : ∀ x : ℚ, 1 < x → (x : ℝ) ≤ f x)
  {a : ℚ} (ha1 : 1 < a) (hae : f a = a) :
  f x = x :=
begin
  -- Choose n such that 1 + x < a^n.
  obtain ⟨N, hN⟩ := pow_unbounded_of_one_lt (1 + x) ha1,
  have h_big_enough : (1:ℚ) < a^N - x := lt_sub_iff_add_lt.mpr hN,

  have h1 := calc (x : ℝ) + ((a^N - x) : ℚ)
                        ≤ f x + ((a^N - x) : ℚ) : add_le_add_right (H5 x hx) _
                    ... ≤ f x + f (a^N - x)     : add_le_add_left (H5 _ h_big_enough) _,

  have hxp : 0 < x := by positivity,

  have hNp : 0 < N,
  { by_contra' H, rw [le_zero_iff.mp H] at hN, linarith },

  have h2 := calc f x + f (a^N - x)
                        ≤ f (x + (a^N - x)) : H2 x (a^N - x) hxp (zero_lt_one.trans h_big_enough)
                    ... = f (a^N)           : by ring_nf
                    ... = a^N               : fixed_point_of_pos_nat_pow hNp H1 H4 H5 ha1 hae
                    ... = x + (a^N - x)     : by ring,

  have heq := h1.antisymm (by exact_mod_cast h2),
  linarith [H5 x hx, H5 _ h_big_enough]
end

theorem imo2013_q5
  (f : ℚ → ℝ)
  (H1 : ∀ x y, 0 < x → 0 < y → f (x * y) ≤ f x * f y)
  (H2 : ∀ x y, 0 < x → 0 < y → f x + f y ≤ f (x + y))
  (H_fixed_point : ∃ a, 1 < a ∧ f a = a) :
  ∀ x, 0 < x → f x = x :=
begin
  obtain ⟨a, ha1, hae⟩ := H_fixed_point,
  have H3 : ∀ x : ℚ, 0 < x → ∀ n : ℕ, 0 < n → ↑n * f x ≤ f (n * x),
  { intros x hx n hn,
    cases n,
    { exact (lt_irrefl 0 hn).elim },
    induction n with pn hpn,
    { simp only [one_mul, nat.cast_one] },
    calc    ↑(pn + 2) * f x
          = (↑pn + 1 + 1) * f x            : by norm_cast
      ... = ((pn : ℝ) + 1) * f x + 1 * f x : add_mul (↑pn + 1) 1 (f x)
      ... = (↑pn + 1) * f x + f x          : by rw one_mul
      ... ≤ f ((↑pn.succ) * x) + f x       : by exact_mod_cast add_le_add_right
                                                  (hpn pn.succ_pos) (f x)
      ... ≤ f ((↑pn + 1) * x + x)          : by exact_mod_cast H2 _ _
                                                  (mul_pos pn.cast_add_one_pos hx) hx
      ... = f ((↑pn + 1) * x + 1 * x)      : by rw one_mul
      ... = f ((↑pn + 1 + 1) * x)          : congr_arg f (add_mul (↑pn + 1) 1 x).symm
      ... = f (↑(pn + 2) * x)              : by norm_cast },
  have H4 : ∀ n : ℕ, 0 < n → (n : ℝ) ≤ f n,
  { intros n hn,
    have hf1 : 1 ≤ f 1,
    { have a_pos : (0 : ℝ) < a := rat.cast_pos.mpr (zero_lt_one.trans ha1),
      suffices : ↑a * 1 ≤ ↑a * f 1, from (mul_le_mul_left a_pos).mp this,
      calc ↑a * 1 = ↑a        : mul_one ↑a
              ... = f a       : hae.symm
              ... = f (a * 1) : by rw mul_one
              ... ≤ f a * f 1 : (H1 a 1) (zero_lt_one.trans ha1) zero_lt_one
              ... = ↑a * f 1  : by rw hae },

    calc (n : ℝ) = (n : ℝ) * 1   : (mul_one _).symm
             ... ≤ (n : ℝ) * f 1 : mul_le_mul_of_nonneg_left hf1 (nat.cast_nonneg _)
             ... ≤ f (n * 1)     : H3 1 zero_lt_one n hn
             ... = f n           : by rw mul_one },

  have H5 : ∀ x : ℚ, 1 < x → (x : ℝ) ≤ f x,
  { intros x hx,
    have hxnm1 : ∀ n : ℕ, 0 < n → (x : ℝ)^n - 1 < (f x)^n,
    { intros n hn,
      calc (x : ℝ)^n - 1 < f (x^n) : by exact_mod_cast fx_gt_xm1 (one_le_pow_of_one_le hx.le n)
                                          H1 H2 H4
                     ... ≤ (f x)^n : pow_f_le_f_pow hn hx H1 H4 },
    have hx' : 1 < (x : ℝ) := by exact_mod_cast hx,
    have hxp : 0 < x := by positivity,
    exact le_of_all_pow_lt_succ' hx' (f_pos_of_pos hxp H1 H4) hxnm1 },

  have h_f_commutes_with_pos_nat_mul : ∀ n : ℕ, 0 < n → ∀ x : ℚ, 0 < x → f (n * x) = n * f x,
  { intros n hn x hx,
    have h2 : f (n * x) ≤ n * f x,
    { cases n,
      { exfalso, exact nat.lt_asymm hn hn },
      cases n,
      { simp only [one_mul, nat.cast_one] },
      have hfneq : f (n.succ.succ) = n.succ.succ,
      { have := fixed_point_of_gt_1
                  (nat.one_lt_cast.mpr (nat.succ_lt_succ n.succ_pos)) H1 H2 H4 H5 ha1 hae,
        rwa (rat.cast_coe_nat n.succ.succ) at this },
      rw ← hfneq,
      exact H1 (n.succ.succ : ℚ) x (nat.cast_pos.mpr hn) hx },
    exact h2.antisymm (H3 x hx n hn) },

  -- For the final calculation, we expand x as (2*x.num) / (2*x.denom), because
  -- we need the top of the fraction to be strictly greater than 1 in order
  -- to apply fixed_point_of_gt_1.
  intros x hx,
  let x2denom := 2 * x.denom,
  let x2num := 2 * x.num,

  have hx2pos := calc 0 < x.denom           : x.pos
                    ... < x.denom + x.denom : lt_add_of_pos_left x.denom x.pos
                    ... = 2 * x.denom       : by ring,

  have hxcnez   : (x.denom : ℚ) ≠ (0 : ℚ) := ne_of_gt (nat.cast_pos.mpr x.pos),
  have hx2cnezr : (x2denom : ℝ) ≠ (0 : ℝ) := nat.cast_ne_zero.mpr (ne_of_gt hx2pos),

  have hrat_expand2 := calc x = x.num / x.denom : by exact_mod_cast rat.num_denom.symm
                          ... = x2num / x2denom : by { field_simp [-rat.num_div_denom], linarith },

  have h_denom_times_fx :=
    calc (x2denom : ℝ) * f x = f (x2denom * x)                 : (h_f_commutes_with_pos_nat_mul
                                                                    x2denom hx2pos x hx).symm
                         ... = f (x2denom * (x2num / x2denom)) : by rw hrat_expand2
                         ... = f x2num                         : by { congr, field_simp, ring },

  have h_fx2num_fixed : f x2num = x2num,
  { have hx2num_gt_one : (1 : ℚ) < (2 * x.num : ℤ),
    { norm_cast, linarith [rat.num_pos_iff_pos.mpr hx] },
    have hh := fixed_point_of_gt_1 hx2num_gt_one H1 H2 H4 H5 ha1 hae,
    rwa (rat.cast_coe_int x2num) at hh },

  calc f x = f x * 1                                 : (mul_one (f x)).symm
       ... = f x * (x2denom / x2denom)               : by rw ←(div_self hx2cnezr)
       ... = (f x * x2denom) / x2denom               : mul_div_assoc' (f x) _ _
       ... = (x2denom * f x) / x2denom               : by rw mul_comm
       ... = f x2num / x2denom                       : by rw h_denom_times_fx
       ... = x2num / x2denom                         : by rw h_fx2num_fixed
       ... = (((x2num : ℚ) / (x2denom : ℚ) : ℚ) : ℝ) : by norm_cast
       ... = x                                       : by rw ←hrat_expand2
end


universes u v
open function

class bijection {α : Sort u} {β : Sort v} (f : α → β) :=
  (inv : β → α)
  (left_inverse_of_inv : left_inverse inv f)
  (right_inverse_of_inv : right_inverse inv f)

namespace bijection
variables {α : Sort u} {β : Sort v} {f : α → β}

instance of_id : bijection (@id α) :=
  ⟨ id, take a, rfl, take a, rfl⟩

instance inverse (iso_f : bijection f) : bijection (inv f) :=
  ⟨f, right_inverse_of_inv f, left_inverse_of_inv f⟩

def injective_of_bijection (iso_f : bijection f) : injective f :=
  injective_of_left_inverse (left_inverse_of_inv f)

lemma eq_of_inv_of_bijection (iso₁ iso₂: bijection f) : iso₁.inv = iso₂.inv :=
begin
  apply funext,
  intro,
  apply injective_of_bijection,
  assumption,
  rw iso₁.right_inverse_of_inv,
  rw iso₂.right_inverse_of_inv
end

lemma bijection_of_iff {a b : Prop} (h : a ↔ b) : bijection (h.mp) :=
{
  inv := h.mpr,
  left_inverse_of_inv := take p, proof_irrel _ _,
  right_inverse_of_inv := take p, proof_irrel _ _
}

private def has_right_inverse_of_bijection (iso_f : bijection f) : has_right_inverse f := ⟨ inv f ,  right_inverse_of_inv f⟩

def surjective_of_bijection (iso_f : bijection f) : surjective f :=
  surjective_of_has_right_inverse (has_right_inverse_of_bijection iso_f)

def bijective_of_bijection (iso_f : bijection f) : bijective f := ⟨ injective_of_bijection iso_f , surjective_of_bijection iso_f⟩

universe w
variables {γ : Sort w} {g : β → γ}
instance comp (iso_f : bijection f) (iso_g : bijection g) : bijection (g ∘ f) :=
 ⟨ inv f ∘ inv g,
   begin
     intro a,
     simp [comp],
     repeat {rw [left_inverse_of_inv]}
   end,
   begin
     intro c,
     simp [comp],
     rw [right_inverse_of_inv f, right_inverse_of_inv g]
   end⟩
end bijection

def has_bijection {α : Sort u}{β : Sort v} (f : α → β) := ∃ g : β → α, left_inverse g f ∧ right_inverse g f

namespace has_bijection
variables {α : Sort u}{β : Sort v} {f : α → β}

def injective_of_has_bijection : has_bijection f → injective f :=
  λ ex, exists.elim ex (λ g h, injective_of_left_inverse (and.left h))
def surjective_of_has_bijection : has_bijection f → surjective f :=
  λ ex, exists.elim ex (λ g h, surjective_of_has_right_inverse (exists.intro g (and.right h)))

def bijective_of_has_bijection : has_bijection f → bijective f := λ h, and.intro (injective_of_has_bijection h) (surjective_of_has_bijection h)

def of_bijection [ins : bijection f] : has_bijection f := exists.intro ins.inv (and.intro ins.left_inverse_of_inv ins.right_inverse_of_inv)

universe w
variables {γ : Sort w} {g : β → γ}

def trans : has_bijection f → has_bijection g → has_bijection (g ∘ f) :=
begin
intros fH gH,
cases fH with f_inv f_inv_h,
cases gH with g_inv g_inv_h,
apply (exists.intro (f_inv ∘ g_inv)),
apply and.intro,
{
    intro x,
    simp [comp],
    rw [g_inv_h.left, f_inv_h.left]
},
{
    intro x,
    simp [comp],
    rw [f_inv_h.right, g_inv_h.right]
}
end
end has_bijection


/-
Copyright (c) 2021 Martin Zinkevich. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Martin Zinkevich, Vincent Beffara
-/
import measure_theory.integral.set_integral
import probability.independence

/-!
# Integration in Probability Theory

Integration results for independent random variables. Specifically, for two
independent random variables X and Y over the extended non-negative
reals, `E[X * Y] = E[X] * E[Y]`, and similar results.

## Implementation notes

Many lemmas in this file take two arguments of the same typeclass. It is worth remembering that lean
will always pick the later typeclass in this situation, and does not care whether the arguments are
`[]`, `{}`, or `()`. All of these use the `measurable_space` `M2` to define `μ`:

```lean
example {M1 : measurable_space α} [M2 : measurable_space α] {μ : measure α} : sorry := sorry
example [M1 : measurable_space α] {M2 : measurable_space α} {μ : measure α} : sorry := sorry
```

-/

noncomputable theory
open set measure_theory
open_locale ennreal measure_theory

variables {α : Type*} {mα : measurable_space α} {μ : measure α} {f g : α → ℝ≥0∞} {X Y : α → ℝ}

namespace probability_theory

/-- If a random variable `f` in `ℝ≥0∞` is independent of an event `T`, then if you restrict the
  random variable to `T`, then `E[f * indicator T c 0]=E[f] * E[indicator T c 0]`. It is useful for
  `lintegral_mul_eq_lintegral_mul_lintegral_of_independent_measurable_space`. -/
lemma lintegral_mul_indicator_eq_lintegral_mul_lintegral_indicator {Mf mα : measurable_space α}
  {μ : measure α} (hMf : Mf ≤ mα) (c : ℝ≥0∞) {T : set α} (h_meas_T : measurable_set T)
  (h_ind : indep_sets {s | measurable_set[Mf] s} {T} μ) (h_meas_f : measurable[Mf] f) :
  ∫⁻ a, f a * T.indicator (λ _, c) a ∂μ = ∫⁻ a, f a ∂μ * ∫⁻ a, T.indicator (λ _, c) a ∂μ :=
begin
  revert f,
  have h_mul_indicator : ∀ g, measurable g → measurable (λ a, g a * T.indicator (λ x, c) a),
    from λ g h_mg, h_mg.mul (measurable_const.indicator h_meas_T),
  apply measurable.ennreal_induction,
  { intros c' s' h_meas_s',
    simp_rw [← inter_indicator_mul],
    rw [lintegral_indicator _ (measurable_set.inter (hMf _ h_meas_s') (h_meas_T)),
      lintegral_indicator _ (hMf _ h_meas_s'), lintegral_indicator _ h_meas_T],
    simp only [measurable_const, lintegral_const, univ_inter, lintegral_const_mul,
      measurable_set.univ, measure.restrict_apply],
    ring_nf,
    congr,
    rw [mul_comm, h_ind s' T h_meas_s' (set.mem_singleton _)], },
  { intros f' g h_univ h_meas_f' h_meas_g h_ind_f' h_ind_g,
    have h_measM_f' : measurable f', from h_meas_f'.mono hMf le_rfl,
    have h_measM_g : measurable g, from h_meas_g.mono hMf le_rfl,
    simp_rw [pi.add_apply, right_distrib],
    rw [lintegral_add_left (h_mul_indicator _ h_measM_f'),
      lintegral_add_left h_measM_f', right_distrib, h_ind_f', h_ind_g] },
  { intros f h_meas_f h_mono_f h_ind_f,
    have h_measM_f : ∀ n, measurable (f n), from λ n, (h_meas_f n).mono hMf le_rfl,
    simp_rw [ennreal.supr_mul],
    rw [lintegral_supr h_measM_f h_mono_f, lintegral_supr, ennreal.supr_mul],
    { simp_rw [← h_ind_f] },
    { exact λ n, h_mul_indicator _ (h_measM_f n) },
    { exact λ m n h_le a, ennreal.mul_le_mul (h_mono_f h_le a) le_rfl, }, },
end

/-- If `f` and `g` are independent random variables with values in `ℝ≥0∞`,
   then `E[f * g] = E[f] * E[g]`. However, instead of directly using the independence
   of the random variables, it uses the independence of measurable spaces for the
   domains of `f` and `g`. This is similar to the sigma-algebra approach to
   independence. See `lintegral_mul_eq_lintegral_mul_lintegral_of_independent_fn` for
   a more common variant of the product of independent variables. -/
lemma lintegral_mul_eq_lintegral_mul_lintegral_of_independent_measurable_space
  {Mf Mg mα : measurable_space α} {μ : measure α}
  (hMf : Mf ≤ mα) (hMg : Mg ≤ mα) (h_ind : indep Mf Mg μ)
  (h_meas_f : measurable[Mf] f) (h_meas_g : measurable[Mg] g) :
  ∫⁻ a, f a * g a ∂μ = ∫⁻ a, f a ∂μ * ∫⁻ a, g a ∂μ :=
begin
  revert g,
  have h_measM_f : measurable f, from h_meas_f.mono hMf le_rfl,
  apply measurable.ennreal_induction,
  { intros c s h_s,
    apply lintegral_mul_indicator_eq_lintegral_mul_lintegral_indicator hMf _ (hMg _ h_s) _ h_meas_f,
    apply indep_sets_of_indep_sets_of_le_right h_ind,
    rwa singleton_subset_iff, },
  { intros f' g h_univ h_measMg_f' h_measMg_g h_ind_f' h_ind_g',
    have h_measM_f' : measurable f', from h_measMg_f'.mono hMg le_rfl,
    have h_measM_g : measurable g, from h_measMg_g.mono hMg le_rfl,
    simp_rw [pi.add_apply, left_distrib],
    rw [lintegral_add_left h_measM_f', lintegral_add_left (h_measM_f.mul h_measM_f'),
      left_distrib, h_ind_f', h_ind_g'] },
  { intros f' h_meas_f' h_mono_f' h_ind_f',
    have h_measM_f' : ∀ n, measurable (f' n), from λ n, (h_meas_f' n).mono hMg le_rfl,
    simp_rw [ennreal.mul_supr],
    rw [lintegral_supr, lintegral_supr h_measM_f' h_mono_f', ennreal.mul_supr],
    { simp_rw [← h_ind_f'], },
    { exact λ n, h_measM_f.mul (h_measM_f' n), },
    { exact λ n m (h_le : n ≤ m) a, ennreal.mul_le_mul le_rfl (h_mono_f' h_le a), }, }
end

/-- If `f` and `g` are independent random variables with values in `ℝ≥0∞`,
   then `E[f * g] = E[f] * E[g]`. -/
lemma lintegral_mul_eq_lintegral_mul_lintegral_of_indep_fun
  (h_meas_f : measurable f) (h_meas_g : measurable g) (h_indep_fun : indep_fun f g μ) :
  ∫⁻ a, (f * g) a ∂μ = ∫⁻ a, f a ∂μ * ∫⁻ a, g a ∂μ :=
lintegral_mul_eq_lintegral_mul_lintegral_of_independent_measurable_space
  (measurable_iff_comap_le.1 h_meas_f) (measurable_iff_comap_le.1 h_meas_g) h_indep_fun
  (measurable.of_comap_le le_rfl) (measurable.of_comap_le le_rfl)

/-- If `f` and `g` with values in `ℝ≥0∞` are independent and almost everywhere measurable,
   then `E[f * g] = E[f] * E[g]` (slightly generalizing
   `lintegral_mul_eq_lintegral_mul_lintegral_of_indep_fun`). -/
lemma lintegral_mul_eq_lintegral_mul_lintegral_of_indep_fun'
  (h_meas_f : ae_measurable f μ) (h_meas_g : ae_measurable g μ) (h_indep_fun : indep_fun f g μ) :
  ∫⁻ a, (f * g) a ∂μ = ∫⁻ a, f a ∂μ * ∫⁻ a, g a ∂μ :=
begin
  have fg_ae : f * g =ᵐ[μ] (h_meas_f.mk _) * (h_meas_g.mk _),
    from h_meas_f.ae_eq_mk.mul h_meas_g.ae_eq_mk,
  rw [lintegral_congr_ae h_meas_f.ae_eq_mk, lintegral_congr_ae h_meas_g.ae_eq_mk,
    lintegral_congr_ae fg_ae],
  apply lintegral_mul_eq_lintegral_mul_lintegral_of_indep_fun
    h_meas_f.measurable_mk h_meas_g.measurable_mk,
  exact h_indep_fun.ae_eq h_meas_f.ae_eq_mk h_meas_g.ae_eq_mk
end

/-- The product of two independent, integrable, real_valued random variables is integrable. -/
lemma indep_fun.integrable_mul {β : Type*} [measurable_space β] {X Y : α → β}
  [normed_division_ring β] [borel_space β]
  (hXY : indep_fun X Y μ) (hX : integrable X μ) (hY : integrable Y μ) :
  integrable (X * Y) μ :=
begin
  let nX : α → ennreal := λ a, ∥X a∥₊,
  let nY : α → ennreal := λ a, ∥Y a∥₊,

  have hXY' : indep_fun (λ a, ∥X a∥₊) (λ a, ∥Y a∥₊) μ :=
    hXY.comp measurable_nnnorm measurable_nnnorm,
  have hXY'' : indep_fun nX nY μ :=
    hXY'.comp measurable_coe_nnreal_ennreal measurable_coe_nnreal_ennreal,

  have hnX : ae_measurable nX μ := hX.1.ae_measurable.nnnorm.coe_nnreal_ennreal,
  have hnY : ae_measurable nY μ := hY.1.ae_measurable.nnnorm.coe_nnreal_ennreal,

  have hmul : ∫⁻ a, nX a * nY a ∂μ = ∫⁻ a, nX a ∂μ * ∫⁻ a, nY a ∂μ :=
    by convert lintegral_mul_eq_lintegral_mul_lintegral_of_indep_fun' hnX hnY hXY'',

  refine ⟨hX.1.mul hY.1, _⟩,
  simp_rw [has_finite_integral, pi.mul_apply, nnnorm_mul, ennreal.coe_mul, hmul],
  exact ennreal.mul_lt_top_iff.mpr (or.inl ⟨hX.2, hY.2⟩)
end

/-- The (Bochner) integral of the product of two independent, nonnegative random
  variables is the product of their integrals. The proof is just plumbing around
  `lintegral_mul_eq_lintegral_mul_lintegral_of_indep_fun'`. -/
lemma indep_fun.integral_mul_of_nonneg (hXY : indep_fun X Y μ) (hXp : 0 ≤ X) (hYp : 0 ≤ Y)
  (hXm : ae_measurable X μ) (hYm : ae_measurable Y μ) :
  integral μ (X * Y) = integral μ X * integral μ Y :=
begin
  have h1 : ae_measurable (λ a, ennreal.of_real (X a)) μ :=
    ennreal.measurable_of_real.comp_ae_measurable hXm,
  have h2 : ae_measurable (λ a, ennreal.of_real (Y a)) μ :=
    ennreal.measurable_of_real.comp_ae_measurable hYm,
  have h3 : ae_measurable (X * Y) μ := hXm.mul hYm,

  have h4 : 0 ≤ᵐ[μ] (X * Y) := ae_of_all _ (λ ω, mul_nonneg (hXp ω) (hYp ω)),

  rw [integral_eq_lintegral_of_nonneg_ae (ae_of_all _ hXp) hXm.ae_strongly_measurable,
    integral_eq_lintegral_of_nonneg_ae (ae_of_all _ hYp) hYm.ae_strongly_measurable,
    integral_eq_lintegral_of_nonneg_ae h4 h3.ae_strongly_measurable],
  simp_rw [←ennreal.to_real_mul, pi.mul_apply, ennreal.of_real_mul (hXp _)],
  congr,
  apply lintegral_mul_eq_lintegral_mul_lintegral_of_indep_fun' h1 h2,
  exact hXY.comp ennreal.measurable_of_real ennreal.measurable_of_real
end

/-- The (Bochner) integral of the product of two independent, integrable random
  variables is the product of their integrals. The proof is pedestrian decomposition
  into their positive and negative parts in order to apply `indep_fun.integral_mul_of_nonneg`
  four times. -/
theorem indep_fun.integral_mul_of_integrable (hXY : indep_fun X Y μ)
  (hX : integrable X μ) (hY : integrable Y μ) :
  integral μ (X * Y) = integral μ X * integral μ Y :=
begin
  let pos : ℝ → ℝ := (λ x, max x 0),
  let neg : ℝ → ℝ := (λ x, max (-x) 0),
  have posm : measurable pos := measurable_id'.max measurable_const,
  have negm : measurable neg := measurable_id'.neg.max measurable_const,

  let Xp := pos ∘ X, -- `X⁺` would look better but it makes `simp_rw` below fail
  let Xm := neg ∘ X,
  let Yp := pos ∘ Y,
  let Ym := neg ∘ Y,

  have hXpm : X = Xp - Xm := funext (λ ω, (max_zero_sub_max_neg_zero_eq_self (X ω)).symm),
  have hYpm : Y = Yp - Ym := funext (λ ω, (max_zero_sub_max_neg_zero_eq_self (Y ω)).symm),

  have hp1 : 0 ≤ Xm := λ ω, le_max_right _ _,
  have hp2 : 0 ≤ Xp := λ ω, le_max_right _ _,
  have hp3 : 0 ≤ Ym := λ ω, le_max_right _ _,
  have hp4 : 0 ≤ Yp := λ ω, le_max_right _ _,

  have hm1 : ae_measurable Xm μ := hX.1.ae_measurable.neg.max ae_measurable_const,
  have hm2 : ae_measurable Xp μ := hX.1.ae_measurable.max ae_measurable_const,
  have hm3 : ae_measurable Ym μ := hY.1.ae_measurable.neg.max ae_measurable_const,
  have hm4 : ae_measurable Yp μ := hY.1.ae_measurable.max ae_measurable_const,

  have hv1 : integrable Xm μ := hX.neg_part,
  have hv2 : integrable Xp μ := hX.pos_part,
  have hv3 : integrable Ym μ := hY.neg_part,
  have hv4 : integrable Yp μ := hY.pos_part,

  have hi1 : indep_fun Xm Ym μ := hXY.comp negm negm,
  have hi2 : indep_fun Xp Ym μ := hXY.comp posm negm,
  have hi3 : indep_fun Xm Yp μ := hXY.comp negm posm,
  have hi4 : indep_fun Xp Yp μ := hXY.comp posm posm,

  have hl1 : integrable (Xm * Ym) μ := hi1.integrable_mul hv1 hv3,
  have hl2 : integrable (Xp * Ym) μ := hi2.integrable_mul hv2 hv3,
  have hl3 : integrable (Xm * Yp) μ := hi3.integrable_mul hv1 hv4,
  have hl4 : integrable (Xp * Yp) μ := hi4.integrable_mul hv2 hv4,
  have hl5 : integrable (Xp * Yp - Xm * Yp) μ := hl4.sub hl3,
  have hl6 : integrable (Xp * Ym - Xm * Ym) μ := hl2.sub hl1,

  simp_rw [hXpm, hYpm, mul_sub, sub_mul],
  rw [integral_sub' hl5 hl6, integral_sub' hl4 hl3, integral_sub' hl2 hl1,
    integral_sub' hv2 hv1, integral_sub' hv4 hv3, hi1.integral_mul_of_nonneg hp1 hp3 hm1 hm3,
    hi2.integral_mul_of_nonneg hp2 hp3 hm2 hm3, hi3.integral_mul_of_nonneg hp1 hp4 hm1 hm4,
    hi4.integral_mul_of_nonneg hp2 hp4 hm2 hm4],
  ring
end

theorem indep_fun.integral_mul_of_integrable' (hXY : indep_fun X Y μ)
  (hX : integrable X μ) (hY : integrable Y μ) :
  integral μ (λ x, X x * Y x) = integral μ X * integral μ Y :=
hXY.integral_mul_of_integrable hX hY

/-- Independence of functions `f` and `g` into arbitrary types is characterized by the relation
  `E[(φ ∘ f) * (ψ ∘ g)] = E[φ ∘ f] * E[ψ ∘ g]` for all measurable `φ` and `ψ` with values in `ℝ`
  satisfying appropriate integrability conditions. -/
theorem indep_fun_iff_integral_comp_mul [is_finite_measure μ]
  {β β' : Type*} {mβ : measurable_space β} {mβ' : measurable_space β'}
  {f : α → β} {g : α → β'} {hfm : measurable f} {hgm : measurable g} :
  indep_fun f g μ ↔
  ∀ {φ : β → ℝ} {ψ : β' → ℝ},
    measurable φ → measurable ψ → integrable (φ ∘ f) μ → integrable (ψ ∘ g) μ →
    integral μ ((φ ∘ f) * (ψ ∘ g)) = integral μ (φ ∘ f) * integral μ (ψ ∘ g) :=
begin
  refine ⟨λ hfg _ _ hφ hψ, indep_fun.integral_mul_of_integrable (hfg.comp hφ hψ), _⟩,
  rintro h _ _ ⟨A, hA, rfl⟩ ⟨B, hB, rfl⟩,
  specialize h (measurable_one.indicator hA) (measurable_one.indicator hB)
    ((integrable_const 1).indicator (hfm.comp measurable_id hA))
    ((integrable_const 1).indicator (hgm.comp measurable_id hB)),
  rwa [← ennreal.to_real_eq_to_real (measure_ne_top μ _), ennreal.to_real_mul,
    ← integral_indicator_one ((hfm hA).inter (hgm hB)), ← integral_indicator_one (hfm hA),
    ← integral_indicator_one (hgm hB), set.inter_indicator_one],
  exact ennreal.mul_ne_top (measure_ne_top μ _) (measure_ne_top μ _)
end

end probability_theory


/-
Copyright (c) 2023 María Inés de Frutos-Fernández. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: María Inés de Frutos-Fernández
-/

import field_theory.normal
import field_theory.is_alg_closed.algebraic_closure

/-!
# Normal closures

## Main Results

- `normal_closure.is_algebraic` : If `L/K` is an algebraic field extension, then the normal closure
  of `L/K` in the algebraic closure of `L` is an algebraic extension of `K`.

## Tags

normal, normal_closure, algebraic, is_algebraic
-/

variables (K L : Type*) [field K] [field L] [algebra K L]

namespace normal_closure

/-- If `L/K` is an algebraic field extension, then the normal closure of `L/K` in the algebraic
closure of `L` is an algebraic extension of `K`. -/
lemma is_algebraic (h : algebra.is_algebraic K L) :
  algebra.is_algebraic K (normal_closure K L (algebraic_closure L)) :=
algebra.is_algebraic_trans h
  (λ x, intermediate_field.is_algebraic_iff.mpr (algebraic_closure.is_algebraic _ _))

end normal_closure


import .basic

universes u

open set

variables {α : Type u} [lattice α] [bounded_order α] {x x' y y' a b b' b₀ c : α}
  {M : supermatroid α}

def satisfies_middle_axiom (B : set α) : Prop :=
  ∀ x x' b b', x ≤ x' → x ≤ b → b' ≤ x' → b ∈ B → b' ∈ B → ∃ b₀ ∈ B, x ≤ b₀ ∧ b₀ ≤ x'

-- infinite axiom
def satisfies_extension (B : set α) : Prop :=
  ∀ x b y, b ∈ B → x ≤ b → x ≤ y → (maximals (≤) ((Icc x y) ∩ {i | ∃ b' ∈ B, i ≤ b'})).nonempty

def supermatroid_of_bases {B : set α}
  (h_nonempty : nonempty B)
  (h_antichain : is_antichain (≤) B)
  (h_mid : satisfies_middle_axiom B)
  (h_ext : satisfies_extension B):
  supermatroid α :=
{ indep         := λ x, ∃ b ∈ B, x ≤ b,
  ind_nonempty  := h_nonempty.elim (λ b, ⟨(⊥ : α), ⟨b.1, b.2,bot_le⟩ ⟩),
  ind_lower_set := λ i j hji, by {rintro ⟨b,⟨hb,hib⟩⟩, exact ⟨b,⟨hb,hji.trans hib⟩⟩},
  ind_maximize := by {rintros i ⟨b,⟨hb,hib⟩⟩ b' hib', exact h_ext i b b' hb hib hib'},
  ind_augment   :=
  begin
    rintros i ⟨b,⟨hb,hib⟩⟩ b' hi hb',
    erw h_antichain.max_lower_closure at hi hb',
    obtain ⟨b₀, ⟨hb₀, hib₀, hb₀b⟩⟩ :=
      h_mid i (i ⊔ b') b b' le_sup_left hib le_sup_right hb hb',
    exact ⟨b₀,⟨lt_of_le_of_ne hib₀ (λ h, hi (h.symm ▸ hb₀)),hb₀b⟩,b₀,hb₀,rfl.le⟩,
  end}

lemma bases_satisfy_middle (M : supermatroid α) : satisfies_middle_axiom M.basis :=
begin
  intros x x' b b' hxx' hxb hb'x' hb hb',
  obtain ⟨b₀,⟨hb₀,hxb₀,hb₀x⟩⟩ := (hb.indep_of_le hxb).le_basis_sup hb',
  exact ⟨b₀, hb₀, hxb₀, hb₀x.trans (sup_le hxx' hb'x')⟩,
end

lemma bases_satisfy_extension (M : supermatroid α) : satisfies_extension M.basis :=
begin
  intros x b y hb hxb hxy,
  obtain ⟨j, hxj, hjy⟩ := (hb.indep_of_le hxb).le_basis_of hxy,
  obtain ⟨b',⟨hjb',hb'⟩⟩ := hjy.indep.le_basis,
  refine ⟨j,⟨⟨hxj,hjy.le⟩,⟨b',hb',hjb'⟩⟩, λ a hxa hay,_ ⟩,
  obtain ⟨b'',hb'',hab''⟩ := hxa.2,
  exact hjy.eq_of_le_indep hay hxa.1.2 (hb''.indep_of_le hab''),
end


import algebra.field
import data.polynomial
import gtm106.weierstrass_equation.basic
import gtm106.weierstrass_equation.point
import tactic

noncomputable theory

namespace weierstrass_equation

/--
The regular function ring of affine part,
which is `K[x,y]/(y^2 + a1*x*y + a3*y - x^3 - a2*x^2 - a4*x - a6)`,
we define it as the free `K[x]`-module of rank 2 `K[x]⬝{1,y}`.
-/
@[ext]
structure regular_function_ring' {K : Type*} [comm_ring K]
(E : weierstrass_equation K) :=
mk :: (C1 Cy : polynomial K)

namespace regular_function_ring'

def zero {K : Type*} [comm_ring K]
{E : weierstrass_equation K} : regular_function_ring' E
:= ⟨ 0, 0 ⟩

def one {K : Type*} [comm_ring K]
{E : weierstrass_equation K} : regular_function_ring' E
:= ⟨ 1, 0 ⟩

def x {K : Type*} [comm_ring K]
{E : weierstrass_equation K} : regular_function_ring' E
:= ⟨ polynomial.X, 0 ⟩

def y {K : Type*} [comm_ring K]
{E : weierstrass_equation K} : regular_function_ring' E
:= ⟨ 0, 1 ⟩

def add {K : Type*} [comm_ring K]
{E : weierstrass_equation K} (f g : regular_function_ring' E) : regular_function_ring' E
:= ⟨ f.1 + g.1, f.2 + g.2 ⟩

def neg {K : Type*} [comm_ring K]
{E : weierstrass_equation K} (f : regular_function_ring' E) : regular_function_ring' E
:= ⟨ -(f.1), -(f.2) ⟩

def sub {K : Type*} [comm_ring K]
{E : weierstrass_equation K} (f g : regular_function_ring' E) : regular_function_ring' E
:= ⟨ f.1 - g.1, f.2 - g.2 ⟩

def smul {K : Type*} [comm_ring K]
{E : weierstrass_equation K} (a : K) (f : regular_function_ring' E) : regular_function_ring' E
:= ⟨ polynomial.C a * f.1, polynomial.C a * f.2 ⟩

def smul_poly {K : Type*} [comm_ring K]
{E : weierstrass_equation K} (a : polynomial K) (f : regular_function_ring' E) : regular_function_ring' E
:= ⟨ a * f.1, a * f.2 ⟩

-- since y^2 = -a1*x*y - a3*y + x^3 + a2*x^2 + a4*x + a6
-- therefore (f1 + f2*y)*(g1 + g2*y)
-- = f1*g1 + (f1*g2 + f2*g1)*y + f2*g2*y^2
-- = (f1*g1 + f2*g2*(x^3 + a2*x^2 + a4*x + a6)) + (f1*g2 + f2*g1 - f2*g2*(a1*x + a3))*y
def mul {K : Type*} [comm_ring K]
{E : weierstrass_equation K} (f g : regular_function_ring' E) : regular_function_ring' E
:= ⟨ f.1*g.1 + f.2*g.2*(polynomial.monomial 3 1 + polynomial.monomial 2 E.a2 + polynomial.monomial 1 E.a4 + polynomial.C E.a6),
  f.1*g.2 + f.2*g.1 - f.2*g.2*(polynomial.monomial 1 E.a1 + polynomial.C E.a3) ⟩

lemma add.add_assoc {K : Type*} [comm_ring K]
{E : weierstrass_equation K} (f g h : regular_function_ring' E)
: add (add f g) h = add f (add g h) :=
begin
  simp [add, add_assoc],
end

lemma add.zero_add {K : Type*} [comm_ring K]
{E : weierstrass_equation K} (f : regular_function_ring' E)
: add zero f = f :=
begin
  simp [add, zero, ext_iff],
end

lemma add.add_zero {K : Type*} [comm_ring K]
{E : weierstrass_equation K} (f : regular_function_ring' E)
: add f zero = f :=
begin
  simp [add, zero, ext_iff],
end

lemma add.add_left_neg {K : Type*} [comm_ring K]
{E : weierstrass_equation K} (f : regular_function_ring' E)
: add (neg f) f = zero :=
begin
  simp [add, neg, zero, ext_iff],
end

lemma add.add_right_neg {K : Type*} [comm_ring K]
{E : weierstrass_equation K} (f : regular_function_ring' E)
: add f (neg f) = zero :=
begin
  simp [add, neg, zero, ext_iff],
end

lemma add.add_comm {K : Type*} [comm_ring K]
{E : weierstrass_equation K} (f g : regular_function_ring' E)
: add f g = add g f :=
begin
  simp [add, add_comm],
end

lemma mul.mul_assoc {K : Type*} [comm_ring K]
{E : weierstrass_equation K} (f g h : regular_function_ring' E)
: mul (mul f g) h = mul f (mul g h) :=
begin
  simp [mul],
  split, { ring, },
  ring,
end

lemma mul.one_mul {K : Type*} [comm_ring K]
{E : weierstrass_equation K} (f : regular_function_ring' E)
: mul one f = f :=
begin
  simp [mul, one, ext_iff],
end

lemma mul.mul_one {K : Type*} [comm_ring K]
{E : weierstrass_equation K} (f : regular_function_ring' E)
: mul f one = f :=
begin
  simp [mul, one, ext_iff],
end

lemma mul.left_distrib {K : Type*} [comm_ring K]
{E : weierstrass_equation K} (f g h : regular_function_ring' E)
: mul f (add g h) = add (mul f g) (mul f h) :=
begin
  simp [mul, add],
  split, { ring, },
  ring,
end

lemma mul.right_distrib {K : Type*} [comm_ring K]
{E : weierstrass_equation K} (f g h : regular_function_ring' E)
: mul (add f g) h = add (mul f h) (mul g h) :=
begin
  simp [mul, add],
  split, { ring, },
  ring,
end

lemma mul.mul_comm {K : Type*} [comm_ring K]
{E : weierstrass_equation K} (f g : regular_function_ring' E)
: mul f g = mul g f :=
begin
  simp [mul],
  split, { ring, },
  ring,
end

instance to_comm_ring {K : Type*} [comm_ring K]
{E : weierstrass_equation K} : comm_ring (regular_function_ring' E)
:= ⟨ @add K _ E, add.add_assoc, zero, add.zero_add, add.add_zero, neg,
  sub, (λ f g, by {
    simp only [has_add.add, add_zero_class.add],
    simp [add, sub, neg, sub_eq_add_neg],
  }), add.add_left_neg, add.add_comm, mul, mul.mul_assoc, one,
  mul.one_mul, mul.mul_one, mul.left_distrib, mul.right_distrib, mul.mul_comm ⟩

def C.to_fun {K : Type*} [comm_ring K]
{E : weierstrass_equation K} (a : K) : regular_function_ring' E
:= ⟨ polynomial.C a, 0 ⟩

lemma C.map_one' {K : Type*} [comm_ring K]
{E : weierstrass_equation K} : @C.to_fun K _ E 1 = one :=
begin
  simp [C.to_fun, one],
end

lemma C.map_mul' {K : Type*} [comm_ring K]
{E : weierstrass_equation K} (a b : K)
: (@C.to_fun K _ E (a*b)) = mul (@C.to_fun K _ E a) (@C.to_fun K _ E b) :=
begin
  simp [C.to_fun, mul],
end

lemma C.map_zero' {K : Type*} [comm_ring K]
{E : weierstrass_equation K} : @C.to_fun K _ E 0 = zero :=
begin
  simp [C.to_fun, zero],
end

lemma C.map_add' {K : Type*} [comm_ring K]
{E : weierstrass_equation K} (a b : K)
: (@C.to_fun K _ E (a+b)) = add (@C.to_fun K _ E a) (@C.to_fun K _ E b) :=
begin
  simp [C.to_fun, add],
end

def C {K : Type*} [comm_ring K]
{E : weierstrass_equation K} : ring_hom K (regular_function_ring' E)
:= ⟨ C.to_fun, C.map_one', C.map_mul', C.map_zero', C.map_add' ⟩

lemma ker {K : Type*} [comm_ring K]
(E : weierstrass_equation K)
: (y : E.regular_function_ring') ^ 2 + C E.a1 * x * y + C E.a3 * y - x ^ 3 - C E.a2 * x ^ 2 - C E.a4 * x - C E.a6 = 0 :=
begin
  simp only [has_add.add, distrib.add, ring.add, comm_ring.add,
    has_sub.sub, sub_neg_monoid.sub, add_group.sub, add_comm_group.sub, ring.sub, comm_ring.sub,
    has_mul.mul, distrib.mul, ring.mul, comm_ring.mul,
    pow, monoid.pow, mul_one_class.mul, monoid.mul,
    has_zero.zero, mul_zero_class.zero, monoid_with_zero.zero, semiring.zero, ring.zero, comm_ring.zero,
    has_one.one, mul_one_class.one, monoid.one, ring.one, comm_ring.one,
    mul.mul_one],
  simp [C, C.to_fun, x, y, add, sub, mul, zero, polynomial.X, polynomial.monomial_mul_monomial],
  ring,
end

def eval_at_affine_point.to_fun {K : Type*} [comm_ring K]
(E : weierstrass_equation K) (P : affine_plane_point K) (f : regular_function_ring' E) : K
:= (polynomial.eval P.x f.1) + (polynomial.eval P.x f.2) * P.y

lemma eval_at_affine_point.map_one' {K : Type*} [comm_ring K]
(E : weierstrass_equation K) (P : affine_plane_point K)
: eval_at_affine_point.to_fun E P one = 1 :=
begin
  simp [eval_at_affine_point.to_fun, one],
end

lemma eval_at_affine_point.map_mul' {K : Type*} [comm_ring K]
(E : weierstrass_equation K) (P : affine_plane_point K) (h : E.affine_point_on_curve P)
(f g : regular_function_ring' E)
: eval_at_affine_point.to_fun E P (mul f g) = eval_at_affine_point.to_fun E P f * eval_at_affine_point.to_fun E P g :=
begin
  simp [eval_at_affine_point.to_fun, mul],
  simp [affine_point_on_curve, eval_at_affine_point] at h,
  transitivity polynomial.eval P.x f.C1 * polynomial.eval P.x g.C1
    + polynomial.eval P.x f.Cy * polynomial.eval P.x g.Cy *
      (P.y ^ 2 - (P.y ^ 2 + E.a1 * P.x * P.y + E.a3 * P.y - P.x ^ 3 - E.a2 * P.x ^ 2 - E.a4 * P.x - E.a6))
    + (polynomial.eval P.x f.C1 * polynomial.eval P.x g.Cy + polynomial.eval P.x f.Cy * polynomial.eval P.x g.C1) * P.y,
  { rw ← sub_eq_zero, ring, },
  rw [h, ← sub_eq_zero], ring,
end

lemma eval_at_affine_point.map_zero' {K : Type*} [comm_ring K]
(E : weierstrass_equation K) (P : affine_plane_point K)
: eval_at_affine_point.to_fun E P zero = 0 :=
begin
  simp [eval_at_affine_point.to_fun, zero],
end

lemma eval_at_affine_point.map_add' {K : Type*} [comm_ring K]
(E : weierstrass_equation K) (P : affine_plane_point K)
(f g : regular_function_ring' E)
: eval_at_affine_point.to_fun E P (add f g) = eval_at_affine_point.to_fun E P f + eval_at_affine_point.to_fun E P g :=
begin
  simp [eval_at_affine_point.to_fun, add],
  ring,
end

def eval_at_affine_point {K : Type*} [comm_ring K]
(E : weierstrass_equation K) (P : affine_plane_point K) (h : E.affine_point_on_curve P)
: ring_hom (regular_function_ring' E) K
:= ⟨ eval_at_affine_point.to_fun E P,
  eval_at_affine_point.map_one' E P,
  eval_at_affine_point.map_mul' E P h,
  eval_at_affine_point.map_zero' E P,
  eval_at_affine_point.map_add' E P ⟩

@[simp]
lemma eval_at_affine_point.C {K : Type*} [comm_ring K]
(E : weierstrass_equation K) (P : affine_plane_point K) (h : E.affine_point_on_curve P)
(a : K) : (eval_at_affine_point E P h) (C a) = a :=
begin
  simp [eval_at_affine_point, eval_at_affine_point.to_fun, C, C.to_fun],
end

@[simp]
lemma eval_at_affine_point.x {K : Type*} [comm_ring K]
(E : weierstrass_equation K) (P : affine_plane_point K) (h : E.affine_point_on_curve P)
: (eval_at_affine_point E P h) x = P.x :=
begin
  simp [eval_at_affine_point, eval_at_affine_point.to_fun, x],
end

@[simp]
lemma eval_at_affine_point.y {K : Type*} [comm_ring K]
(E : weierstrass_equation K) (P : affine_plane_point K) (h : E.affine_point_on_curve P)
: (eval_at_affine_point E P h) y = P.y :=
begin
  simp [eval_at_affine_point, eval_at_affine_point.to_fun, y],
end

def C_poly.to_fun {K : Type*} [comm_ring K]
{E : weierstrass_equation K} (a : polynomial K) : regular_function_ring' E
:= ⟨ a, 0 ⟩

lemma C_poly.map_one' {K : Type*} [comm_ring K]
{E : weierstrass_equation K} : @C_poly.to_fun K _ E 1 = one :=
begin
  simp [C_poly.to_fun, one],
end

lemma C_poly.map_mul' {K : Type*} [comm_ring K]
{E : weierstrass_equation K} (a b : polynomial K)
: (@C_poly.to_fun K _ E (a*b)) = mul (@C_poly.to_fun K _ E a) (@C_poly.to_fun K _ E b) :=
begin
  simp [C_poly.to_fun, mul],
end

lemma C_poly.map_zero' {K : Type*} [comm_ring K]
{E : weierstrass_equation K} : @C_poly.to_fun K _ E 0 = zero :=
begin
  simp [C_poly.to_fun, zero],
end

lemma C_poly.map_add' {K : Type*} [comm_ring K]
{E : weierstrass_equation K} (a b : polynomial K)
: (@C_poly.to_fun K _ E (a+b)) = add (@C_poly.to_fun K _ E a) (@C_poly.to_fun K _ E b) :=
begin
  simp [C_poly.to_fun, add],
end

def C_poly {K : Type*} [comm_ring K]
{E : weierstrass_equation K} : ring_hom (polynomial K) (regular_function_ring' E)
:= ⟨ C_poly.to_fun, C_poly.map_one', C_poly.map_mul', C_poly.map_zero', C_poly.map_add' ⟩

instance to_poly_algebra {K : Type*} [comm_ring K]
{E : weierstrass_equation K} : algebra (polynomial K) (regular_function_ring' E)
:= { to_has_scalar := ⟨ smul_poly ⟩,
  to_ring_hom := C_poly,
  commutes' := (λ f g, by {
    rw mul_comm,
  }),
  smul_def' := (λ f g, by {
    simp only [has_mul.mul, distrib.mul, semiring.mul, ring.mul, comm_ring.mul],
    simp only [smul_poly, C_poly, C_poly.to_fun],
    simp [mul],
  }),
}

instance to_algebra {K : Type*} [comm_ring K]
{E : weierstrass_equation K} : algebra K (regular_function_ring' E)
:= { to_has_scalar := ⟨ smul ⟩,
  to_ring_hom := C,
  commutes' := (λ f g, by {
    rw mul_comm,
  }),
  smul_def' := (λ f g, by {
    simp only [has_mul.mul, distrib.mul, semiring.mul, ring.mul, comm_ring.mul],
    simp only [smul, C, C.to_fun],
    simp [mul],
  }),
}

lemma no_zero_divisor {K : Type*} [field K]
{E : weierstrass_equation K} (hns : E.non_singular') (f g : regular_function_ring' E)
: f * g = 0 → f = 0 ∨ g = 0 :=
begin
  simp only [has_mul.mul, distrib.mul, ring.mul, comm_ring.mul,
    has_zero.zero, mul_zero_class.zero, monoid_with_zero.zero, semiring.zero, ring.zero, comm_ring.zero],
  simp [mul, zero, ext_iff],
  intros h1 h2,
  sorry,
end

/-
instance to_integral_domain {K : Type*} [field K]
{E : weierstrass_equation K} (h : E.non_singular') : integral_domain (regular_function_ring' E)
:= {
  exists_pair_ne := by {
    use [zero, one],
    simp [zero, one],
  },
  eq_zero_or_eq_zero_of_mul_eq_zero := no_zero_divisor h,
  .. (infer_instance : comm_ring (regular_function_ring' E))
}
-/

end regular_function_ring'

end weierstrass_equation


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

import ring_theory.algebra_tower
import linear_algebra.matrix

/-!
# Tower of field extensions

In this file we prove the tower law for arbitrary extensions and finite extensions.
Suppose `L` is a field extension of `K` and `K` is a field extension of `F`.
Then `[L:F] = [L:K] [K:F]` where `[E₁:E₂]` means the `E₂`-dimension of `E₁`.

In fact we generalize it to vector spaces, where `L` is not necessarily a field,
but just a vector space over `K`.

## Implementation notes

We prove two versions, since there are two notions of dimensions: `module.rank` which gives
the dimension of an arbitrary vector space as a cardinal, and `finite_dimensional.finrank` which
gives the dimension of a finitely-dimensional vector space as a natural number.

## Tags

tower law

-/

universes u v w u₁ v₁ w₁
open_locale classical big_operators

section field

open cardinal

variables (F : Type u) (K : Type v) (A : Type w)
variables [field F] [field K] [add_comm_group A]
variables [algebra F K] [module K A] [module F A] [is_scalar_tower F K A]

/-- Tower law: if `A` is a `K`-vector space and `K` is a field extension of `F` then
`dim_F(A) = dim_F(K) * dim_K(A)`. -/
theorem dim_mul_dim' :
  (cardinal.lift.{v w} (module.rank F K) *
      cardinal.lift.{w v} (module.rank K A) : cardinal.{max w v}) =
  cardinal.lift.{w v} (module.rank F A) :=
let ⟨b, hb⟩ := exists_is_basis F K, ⟨c, hc⟩ := exists_is_basis K A in
by rw [← (module.rank F K).lift_id, ← hb.mk_eq_dim,
    ← (module.rank K A).lift_id, ← hc.mk_eq_dim,
    ← lift_umax.{w v}, ← (hb.smul hc).mk_eq_dim, mk_prod, lift_mul,
    lift_lift, lift_lift, lift_lift, lift_lift, lift_umax]

/-- Tower law: if `A` is a `K`-vector space and `K` is a field extension of `F` then
`dim_F(A) = dim_F(K) * dim_K(A)`. -/
theorem dim_mul_dim (F : Type u) (K A : Type v) [field F] [field K] [add_comm_group A]
  [algebra F K] [module K A] [module F A] [is_scalar_tower F K A] :
  module.rank F K * module.rank K A = module.rank F A :=
by convert dim_mul_dim' F K A; rw lift_id

namespace finite_dimensional

theorem trans [finite_dimensional F K] [finite_dimensional K A] : finite_dimensional F A :=
let ⟨b, hb⟩ := exists_is_basis_finset F K in
let ⟨c, hc⟩ := exists_is_basis_finset K A in
of_fintype_basis $ hb.smul hc

lemma right [hf : finite_dimensional F A] : finite_dimensional K A :=
let ⟨b, hb⟩ := iff_fg.1 hf in
iff_fg.2 ⟨b, submodule.restrict_scalars_injective F _ _ $
by { rw [submodule.restrict_scalars_top, eq_top_iff, ← hb, submodule.span_le],
  exact submodule.subset_span }⟩

/-- Tower law: if `A` is a `K`-algebra and `K` is a field extension of `F` then
`dim_F(A) = dim_F(K) * dim_K(A)`. -/
theorem finrank_mul_finrank [finite_dimensional F K] :
  finrank F K * finrank K A = finrank F A :=
begin
  by_cases hA : finite_dimensional K A,
  { resetI,
    rcases exists_is_basis_finset F K with ⟨b, hb⟩,
    rcases exists_is_basis_finset K A with ⟨c, hc⟩,
    rw [finrank_eq_card_basis hb, finrank_eq_card_basis hc,
      finrank_eq_card_basis (hb.smul hc), fintype.card_prod] },
  { rw [finrank_of_infinite_dimensional hA, mul_zero, finrank_of_infinite_dimensional],
    exact mt (@right F K A _ _ _ _ _ _ _) hA }
end

instance linear_map (F : Type u) (V : Type v) (W : Type w)
  [field F] [add_comm_group V] [module F V] [add_comm_group W] [module F W]
  [finite_dimensional F V] [finite_dimensional F W] :
  finite_dimensional F (V →ₗ[F] W) :=
let ⟨b, hb⟩ := exists_is_basis_finset F V in
let ⟨c, hc⟩ := exists_is_basis_finset F W in
(matrix.to_lin hb hc).finite_dimensional

lemma finrank_linear_map (F : Type u) (V : Type v) (W : Type w)
  [field F] [add_comm_group V] [module F V] [add_comm_group W] [module F W]
  [finite_dimensional F V] [finite_dimensional F W] :
  finrank F (V →ₗ[F] W) = finrank F V * finrank F W :=
let ⟨b, hb⟩ := exists_is_basis_finset F V in
let ⟨c, hc⟩ := exists_is_basis_finset F W in
by rw [linear_equiv.finrank_eq (linear_map.to_matrix hb hc), matrix.finrank_matrix,
      finrank_eq_card_basis hb, finrank_eq_card_basis hc, mul_comm]

-- TODO: generalize by removing [finite_dimensional F K]
-- V = ⊕F,
-- (V →ₗ[F] K) = ((⊕F) →ₗ[F] K) = (⊕ (F →ₗ[F] K)) = ⊕K
instance linear_map' (F : Type u) (K : Type v) (V : Type w)
  [field F] [field K] [algebra F K] [finite_dimensional F K]
  [add_comm_group V] [module F V] [finite_dimensional F V] :
  finite_dimensional K (V →ₗ[F] K) :=
right F _ _

lemma finrank_linear_map' (F : Type u) (K : Type v) (V : Type w)
  [field F] [field K] [algebra F K] [finite_dimensional F K]
  [add_comm_group V] [module F V] [finite_dimensional F V] :
  finrank K (V →ₗ[F] K) = finrank F V :=
(nat.mul_right_inj $ show 0 < finrank F K, from finrank_pos).1 $
calc  finrank F K * finrank K (V →ₗ[F] K)
    = finrank F (V →ₗ[F] K) : finrank_mul_finrank _ _ _
... = finrank F V * finrank F K : finrank_linear_map F V K
... = finrank F K * finrank F V : mul_comm _ _

end finite_dimensional

end field


import main2
import combinatorics.simple_graph.adj_matrix
import combinatorics.simple_graph.strongly_regular

/-!
# Strong regular graphs

This file attempts to construct strong regular graphs from
regular symmetric Hadamard matrices with constant diagonal (RSHCD).

-/

set_option pp.beta true

variables {α I R V : Type*}
variables [fintype V] [fintype I] -- [semiring R]

open matrix simple_graph fintype finset

open_locale big_operators matrix

local notation `n` := (fintype.card V : ℚ)

namespace matrix

class adj_matrix
[mul_zero_one_class α] [nontrivial α]
(A : matrix I I α) : Prop :=
(zero_or_one [] : ∀ i j, (A i j) = 0 ∨ (A i j) = 1 . obviously)
(sym [] : A.is_sym . obviously)
(loopless [] : ∀ i, A i i = 0 . obviously)

lemma is_sym_of_adj_matrix
[semiring R] (G : simple_graph I) [decidable_rel G.adj] :
(G.adj_matrix R).is_sym := transpose_adj_matrix G

instance is_adj_matrix_of_adj_matrix
[semiring R] [nontrivial R] (G : simple_graph I) [decidable_rel G.adj] :
adj_matrix (G.adj_matrix R) :=
{ zero_or_one := λ i j, by by_cases G.adj i j; simp*,
  sym := is_sym_of_adj_matrix G,
  loopless := λ i, by simp }

#check compl_adj

def compl
[mul_zero_one_class α] [nontrivial α] [decidable_eq α] [decidable_eq V]
(A : matrix V V α) [adj_matrix A] : matrix V V α :=
λ i j, ite (i = i) 0 (ite (A i j = 0) 1 0)

@[simp]
lemma diag_ne_one_of_adj_matrix
[mul_zero_one_class α] [nontrivial α]
(A : matrix V V α) [c : adj_matrix A] (i : V) :
A i i ≠ 1 :=
by simp [c.loopless]

def to_graph
[mul_zero_one_class α] [nontrivial α] [decidable_eq α]
(A : matrix V V α) [c : adj_matrix A]:
simple_graph V :=
{ adj := λ i j, ite (A i j = 1) true false,
  sym := λ i j h, by simp only [c.sym.apply' i j]; convert h,
  loopless := λ i, by simp }

instance
[mul_zero_one_class α] [nontrivial α] [decidable_eq α]
(A : matrix V V α) [c : adj_matrix A] :
decidable_rel A.to_graph.adj :=
by {simp [to_graph], apply_instance}

#check is_regular_of_degree

lemma to_graph_is_SRG_of
[non_assoc_semiring α] [nontrivial α] [decidable_eq α] [decidable_eq V]
(A : matrix V V α) [adj_matrix A] {k l m : ℕ}
(eq₁ : A ⬝ (𝟙 : matrix V V α) = k • 𝟙)
(eq₂ : A ⬝ A = k • 1 + l • A + m • A.compl):
is_SRG_of A.to_graph (card I) k l m := sorry

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

class RSHCD (H : matrix I I ℚ) extends Hadamard_matrix H : Prop :=
(regular [] : ∀ i j, ∑ b, H i b = ∑ a, H a j)
(sym [] : H.is_sym)
(const_diag [] : ∀ i j, H i i = H i j)

namespace RSHCD

def diag [inhabited I] (H : matrix I I ℚ) [RSHCD H] : ℚ :=
H (default I) (default I)

lemma regular_row
(H : matrix I I ℚ) [RSHCD H] (a b : I) :
∑ j : I, H a j = ∑ j : I, H b j  :=
by rw [regular H a a, regular H b a]

def row_sum [inhabited I] (H : matrix I I ℚ) [RSHCD H] : ℚ :=
∑ j : I, H (default I) j

@[simp] lemma eq_row_sum
[inhabited I] (H : matrix I I ℚ) [RSHCD H] (i : I) :
∑ j : I, H i j = ∑ j : I, H (default I) j  :=
regular_row  H i (default I)

def to_adj [inhabited V] (H : matrix V V ℚ) [RSHCD H] :
matrix V V ℚ :=
((1 : ℚ) / 2) • (𝟙 - (diag H) • H)

def to_adj_eq₁
[inhabited V] (H : matrix V V ℚ) [RSHCD H] :
(to_adj H) ⬝ (𝟙 : matrix V V ℚ) =
((n - (diag H) * (row_sum H)) / 2) • 𝟙 :=
begin
  have : (n - (diag H) * (row_sum H)) / 2 =
         ((1 : ℚ) / 2) * (n - (diag H) * (row_sum H)) := by field_simp,
  rw[this], ext i j,
  simp [matrix.mul, all_one, to_adj, row_sum, ←finset.mul_sum],
  congr,
end

end RSHCD

open RSHCD

instance [inhabited V] (H : matrix V V ℚ) [RSHCD H] :
adj_matrix (to_adj H) := {..}

def to_graph_of_RSHD [inhabited V] (H : matrix V V ℚ) [RSHCD H] :
simple_graph V := (to_adj H).to_graph

instance adj.decidable_rel'
[inhabited V] (H : matrix V V ℚ) [RSHCD H] :
decidable_rel H.to_graph_of_RSHD.adj :=
by simp [to_graph_of_RSHD]; apply_instance

lemma to_graph_is_SRG_of_RSHD
[inhabited V] [decidable_eq V] (H : matrix V V ℚ) [RSHCD H] :
is_SRG_of H.to_graph_of_RSHD sorry sorry sorry sorry := sorry

end matrix

#check transpose_adj_matrix
#check simple_graph
#check adj_matrix
#check from_rel
#check is_SRG_of
#check is_regular_of_degree