/-
Copyright (c) 2020 Jujian Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Jujian Zhang
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.polynomial.derivative
import Mathlib.logic.function.iterate
import Mathlib.data.finset.intervals
import Mathlib.tactic.ring
import Mathlib.tactic.linarith.default
import Mathlib.PostPort

universes u

namespace Mathlib

/-!
# Theory of iterated derivative
We define and prove some lemmas about iterated (formal) derivative for polynomials over a semiring.
-/

namespace polynomial

/-- `iterated_deriv f n` is the `n`-th formal derivative of the polynomial `f` -/
def iterated_deriv {R : Type u} [semiring R] (f : polynomial R) (n : ℕ) : polynomial R :=
  nat.iterate (⇑derivative) n f

@[simp] theorem iterated_deriv_zero_right {R : Type u} [semiring R] (f : polynomial R) :
    iterated_deriv f 0 = f :=
  rfl

theorem iterated_deriv_succ {R : Type u} [semiring R] (f : polynomial R) (n : ℕ) :
    iterated_deriv f (n + 1) = coe_fn derivative (iterated_deriv f n) :=
  sorry

@[simp] theorem iterated_deriv_zero_left {R : Type u} [semiring R] (n : ℕ) :
    iterated_deriv 0 n = 0 :=
  sorry

@[simp] theorem iterated_deriv_add {R : Type u} [semiring R] (p : polynomial R) (q : polynomial R)
    (n : ℕ) : iterated_deriv (p + q) n = iterated_deriv p n + iterated_deriv q n :=
  sorry

@[simp] theorem iterated_deriv_smul {R : Type u} [semiring R] (r : R) (p : polynomial R) (n : ℕ) :
    iterated_deriv (r • p) n = r • iterated_deriv p n :=
  sorry

@[simp] theorem iterated_deriv_X_zero {R : Type u} [semiring R] : iterated_deriv X 0 = X := sorry

@[simp] theorem iterated_deriv_X_one {R : Type u} [semiring R] : iterated_deriv X 1 = 1 := sorry

@[simp] theorem iterated_deriv_X {R : Type u} [semiring R] (n : ℕ) (h : 1 < n) :
    iterated_deriv X n = 0 :=
  sorry

@[simp] theorem iterated_deriv_C_zero {R : Type u} [semiring R] (r : R) :
    iterated_deriv (coe_fn C r) 0 = coe_fn C r :=
  sorry

@[simp] theorem iterated_deriv_C {R : Type u} [semiring R] (r : R) (n : ℕ) (h : 0 < n) :
    iterated_deriv (coe_fn C r) n = 0 :=
  sorry

@[simp] theorem iterated_deriv_one_zero {R : Type u} [semiring R] : iterated_deriv 1 0 = 1 := sorry

@[simp] theorem iterated_deriv_one {R : Type u} [semiring R] (n : ℕ) :
    0 < n → iterated_deriv 1 n = 0 :=
  sorry

@[simp] theorem iterated_deriv_neg {R : Type u} [ring R] (p : polynomial R) (n : ℕ) :
    iterated_deriv (-p) n = -iterated_deriv p n :=
  sorry

@[simp] theorem iterated_deriv_sub {R : Type u} [ring R] (p : polynomial R) (q : polynomial R)
    (n : ℕ) : iterated_deriv (p - q) n = iterated_deriv p n - iterated_deriv q n :=
  sorry

theorem coeff_iterated_deriv_as_prod_Ico {R : Type u} [comm_semiring R] (f : polynomial R) (k : ℕ)
    (m : ℕ) :
    coeff (iterated_deriv f k) m =
        (finset.prod (finset.Ico (Nat.succ m) (m + Nat.succ k)) fun (i : ℕ) => ↑i) *
          coeff f (m + k) :=
  sorry

theorem coeff_iterated_deriv_as_prod_range {R : Type u} [comm_semiring R] (f : polynomial R) (k : ℕ)
    (m : ℕ) :
    coeff (iterated_deriv f k) m =
        coeff f (m + k) * finset.prod (finset.range k) fun (i : ℕ) => ↑(m + k - i) :=
  sorry

theorem iterated_deriv_eq_zero_of_nat_degree_lt {R : Type u} [comm_semiring R] (f : polynomial R)
    (n : ℕ) (h : nat_degree f < n) : iterated_deriv f n = 0 :=
  sorry

theorem iterated_deriv_mul {R : Type u} [comm_semiring R] (p : polynomial R) (q : polynomial R)
    (n : ℕ) :
    iterated_deriv (p * q) n =
        finset.sum (finset.range (Nat.succ n))
          fun (k : ℕ) =>
            coe_fn C ↑(nat.choose n k) * iterated_deriv p (n - k) * iterated_deriv q k :=
  sorry

end Mathlib


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

Define the p-adic numbers (rationals) ℚ_p as the completion of ℚ wrt the p-adic norm.
Show that the p-adic norm extends to ℚ_p, that ℚ is embedded in ℚ_p, and that ℚ_p is complete
-/

import data.real.cau_seq_completion data.padics.padic_norm algebra.archimedean

noncomputable theory
local attribute [instance] classical.prop_decidable

open nat padic_val padic_norm cau_seq cau_seq.completion

@[reducible] def padic_seq {p : ℕ} (hp : prime p) := cau_seq _ (padic_norm hp)

namespace padic_seq

section
variables {p : ℕ} {hp : prime p}

lemma stationary {f : cau_seq ℚ (padic_norm hp)} (hf : ¬ f ≈ 0) :
      ∃ N, ∀ m n, m ≥ N → n ≥ N → padic_norm hp (f n) = padic_norm hp (f m) :=
have ∃ ε > 0, ∃ N1, ∀ j ≥ N1, ε ≤ padic_norm hp (f j),
  from cau_seq.abv_pos_of_not_lim_zero $ not_lim_zero_of_not_congr_zero hf,
let ⟨ε, hε, N1, hN1⟩ := this in
have ∃ N2, ∀ i j ≥ N2, padic_norm hp (f i - f j) < ε, from cau_seq.cauchy₂ f hε,
let ⟨N2, hN2⟩ := this in
⟨ max N1 N2,
  λ n m hn hm,
  have padic_norm hp (f n - f m) < ε, from hN2 _ _ (max_le_iff.1 hn).2 (max_le_iff.1 hm).2,
  have padic_norm hp (f n - f m) < padic_norm hp (f n),
    from lt_of_lt_of_le this $ hN1 _ (max_le_iff.1 hn).1,
  have  padic_norm hp (f n - f m) < max (padic_norm hp (f n)) (padic_norm hp (f m)),
    from lt_max_iff.2 (or.inl this),
  begin
    by_contradiction hne,
    rw ←padic_norm.neg hp (f m) at hne,
    have hnam := add_eq_max_of_ne hp hne,
    rw [padic_norm.neg, max_comm] at hnam,
    rw ←hnam at this,
    apply _root_.lt_irrefl _ (by simp at this; exact this)
  end ⟩

def stationary_point {f : padic_seq hp} (hf : ¬ f ≈ 0) : ℕ :=
classical.some $ stationary hf

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

def norm (f : padic_seq hp) : ℚ :=
if hf : f ≈ 0 then 0
else padic_norm hp (f (stationary_point hf))

lemma norm_zero_iff (f : padic_seq hp) : 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_refl _) hj,
    simpa [h, heq] },
  { intro h,
    simp [norm, h] }
end

end

section embedding
open cau_seq
variables {p : ℕ} {hp : prime p}

lemma equiv_zero_of_val_eq_of_equiv_zero {f g : padic_seq hp}
      (h : ∀ k, padic_norm hp (f k) = padic_norm hp (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 hp} (hf : ¬ f ≈ 0) :
      f.norm ≠ 0 :=
hf ∘ f.norm_zero_iff.1

lemma norm_eq_norm_app_of_nonzero {f : padic_seq hp} (hf : ¬ f ≈ 0) :
      ∃ k, f.norm = padic_norm hp k ∧ k ≠ 0 :=
have heq : f.norm = padic_norm hp (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 hp) q) :=
λ h', hq $ const_lim_zero.1 h'

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

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

lemma norm_mul (f g : padic_seq hp) :
      (f * g).norm = f.norm * g.norm :=
if hf : f ≈ 0 then
  have hg : f * g ≈ 0, from mul_equiv_zero' _ hf,
  by simp [hf, hg, norm]
else if hg : g ≈ 0 then
  have hf : f * g ≈ 0, from mul_equiv_zero _ hg,
  by simp [hf, hg, norm]
else
  have hfg : ¬ f * g ≈ 0, by apply mul_not_equiv_zero; assumption,
  let i := max (stationary_point hfg) (max (stationary_point hf) (stationary_point hg)) in
  have hpnfg : padic_norm hp ((f * g) (stationary_point hfg)) = padic_norm hp ((f * g) i),
  { apply stationary_point_spec hfg,
    apply le_max_left,
    apply le_refl },
  have hpnf : padic_norm hp (f (stationary_point hf)) = padic_norm hp (f i),
  { apply stationary_point_spec hf,
    apply ge_trans,
    apply le_max_right,
    apply le_max_left,
    apply le_refl },
  have hpng : padic_norm hp (g (stationary_point hg)) = padic_norm hp (g i),
  { apply stationary_point_spec hg,
    apply ge_trans,
    apply le_max_right,
    apply le_max_right,
    apply le_refl },
  begin
    unfold norm,
    split_ifs,
    rw [hpnfg, hpnf, hpng],
    apply padic_norm.mul hp
  end

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

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

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

lemma norm_image (a : padic_seq hp) (ha : ¬ a ≈ 0) :
      (∃ (n : ℤ), a.norm = fpow ↑p (-n)) :=
let ⟨k, hk, hk'⟩ := norm_eq_norm_app_of_nonzero ha in
by simpa [hk] using padic_norm.image hp hk'

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

private lemma norm_eq_of_equiv_aux {f g : padic_seq hp} (hf : ¬ f ≈ 0) (hg : ¬ g ≈ 0) (hfg : f ≈ g)
        (h : padic_norm hp (f (stationary_point hf)) ≠ padic_norm hp (g (stationary_point hg)))
        (hgt : padic_norm hp (f (stationary_point hf)) > padic_norm hp (g (stationary_point hg))) :
        false :=
begin
  have hpn : padic_norm hp (f (stationary_point hf)) - padic_norm hp (g (stationary_point hg)) > 0,
    from sub_pos_of_lt hgt,
  cases hfg _ hpn with N hN,
  let i := max N (max (stationary_point hf) (stationary_point hg)),
  have hfi : padic_norm hp (f (stationary_point hf)) = padic_norm hp (f i),
  { apply stationary_point_spec hf,
    { apply le_trans,
      apply le_max_left,
      tactic.rotate_left 1,
      apply le_max_right },
    { apply le_refl } },
  have hgi : padic_norm hp (g (stationary_point hg)) = padic_norm hp (g i),
  { apply stationary_point_spec hg,
    { apply le_trans,
      apply le_max_right,
      tactic.rotate_left 1,
      apply le_max_right },
    { apply le_refl } },
  have hi : i ≥ N, from le_max_left _ _,
  have hN' := hN _ hi,
  simp only [hfi, hgi] at hN',
  have hpne : padic_norm hp (f i) ≠ padic_norm hp (-(g i)),
    by rwa [hfi, hgi, ←padic_norm.neg hp (g i)] at h,
  let hpnem := add_eq_max_of_ne hp hpne,
  have hpeq : padic_norm hp ((f - g) i) = max (padic_norm hp (f i)) (padic_norm hp (g i)),
  { rwa padic_norm.neg at hpnem },
  have hfigi : padic_norm hp (g i) < padic_norm hp (f i),
  { rwa [hfi, hgi] at hgt },
  rw [hpeq, max_eq_left_of_lt hfigi] at hN',
  have : padic_norm hp (f i) < padic_norm hp (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 hp} (hf : ¬ f ≈ 0) (hg : ¬ g ≈ 0) (hfg : f ≈ g) :
      padic_norm hp (f (stationary_point hf)) = padic_norm hp (g (stationary_point hg)) :=
begin
  by_contradiction h,
  cases (decidable.em (padic_norm hp (f (stationary_point hf)) >
          padic_norm hp (g (stationary_point hg))))
      with hgt hngt,
  { exact norm_eq_of_equiv_aux hf hg hfg h hgt },
  { 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 hngt,
    apply h }
end

theorem norm_equiv {f g : padic_seq hp} (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 hp}
        (hfg : ¬ f + g ≈ 0) (hf : ¬ f ≈ 0) (hg : ¬ g ≈ 0) :
        (f + g).norm ≤ max (f.norm) (g.norm) :=
let i := max (stationary_point hfg) (max (stationary_point hf) (stationary_point hg)) in
have hpnfg : padic_norm hp ((f + g) (stationary_point hfg)) = padic_norm hp ((f + g) i),
{ apply stationary_point_spec hfg,
  apply le_max_left,
  apply le_refl },
have hpnf : padic_norm hp (f (stationary_point hf)) = padic_norm hp (f i),
{ apply stationary_point_spec hf,
  apply ge_trans,
  apply le_max_right,
  apply le_max_left,
  apply le_refl },
have hpng : padic_norm hp (g (stationary_point hg)) = padic_norm hp (g i),
{ apply stationary_point_spec hg,
  apply ge_trans,
  apply le_max_right,
  apply le_max_right,
  apply le_refl },
begin
  unfold norm, split_ifs,
  rw [hpnfg, hpnf, hpng],
  apply padic_norm.nonarchimedean
end

theorem norm_nonarchimedean (f g : padic_seq hp) :
      (f + g).norm ≤ max (f.norm) (g.norm) :=
if hfg : f + g ≈ 0 then
  have 0 ≤ max (f.norm) (g.norm), from le_max_left_of_le (norm_nonneg _),
  by simpa [hfg, norm]
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 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 [add_sub_cancel'] 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 hp} (h : ∀ k, padic_norm hp (f k) = padic_norm hp (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 [hf, hg, norm]
else
  have hg : ¬ g ≈ 0, from λ hg, hf $ equiv_zero_of_val_eq_of_equiv_zero (by simp [h]) hg,
  begin
    simp [hg, hf, norm],
    let i := max (stationary_point hf) (stationary_point hg),
    have hpf : padic_norm hp (f (stationary_point hf)) = padic_norm hp (f i),
    { apply stationary_point_spec, apply le_max_left, apply le_refl },
    have hpg : padic_norm hp (g (stationary_point hg)) = padic_norm hp (g i),
    { apply stationary_point_spec, apply le_max_right, apply le_refl },
    rw [hpf, hpg, h]
  end

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

end embedding
end padic_seq

def padic {p : ℕ} (hp : prime p) := @Cauchy _ _ _ _ (padic_norm hp) _
notation `ℚ_[` hp `]` := padic hp

namespace padic

section completion
variables {p : ℕ} {hp : prime p}

instance discrete_field : discrete_field (padic hp) :=
cau_seq.completion.discrete_field

def mk : padic_seq hp → ℚ_[hp] := quotient.mk
end completion

section completion
variables {p : ℕ} (hp : prime p)

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

def of_rat : ℚ → ℚ_[hp] := cau_seq.completion.of_rat

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

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

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

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

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

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

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

@[simp] lemma cast_eq_of_rat_of_nat (n : ℕ) : (↑n : ℚ_[hp]) = of_rat hp n :=
begin
  induction n with n ih,
  { refl },
  { simp, ring, congr, apply ih }
end

@[simp] lemma cast_eq_of_rat_of_int (n : ℤ) : (↑n : ℚ_[hp]) = of_rat hp n :=
by induction n; simp

lemma cast_eq_of_rat : ∀ (q : ℚ), (↑q : ℚ_[hp]) = of_rat hp 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]

lemma const_equiv {q r : ℚ} : const (padic_norm hp) q ≈ const (padic_norm hp) r ↔ q = r :=
⟨ λ heq : lim_zero (const (padic_norm hp) (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 hp q = of_rat hp r ↔ q = r :=
⟨(const_equiv hp).1 ∘ quotient.eq.1, λ h, by rw h⟩

instance : char_zero ℚ_[hp] :=
⟨ λ m n, suffices of_rat hp ↑m = of_rat hp ↑n ↔ m = n, by simpa,
    by simp [of_rat_eq] ⟩

end completion
end padic

def padic_norm_e {p : ℕ} {hp : prime p} : ℚ_[hp] → ℚ :=
quotient.lift padic_seq.norm $ @padic_seq.norm_equiv _ _

namespace padic_norm_e
section embedding
open padic_seq
variables {p : ℕ} {hp : prime p}

lemma defn (f : padic_seq hp) {ε : ℚ} (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_contradiction h,
  cases cauchy₂ f hε with N hN,
  have : ∀ N, ∃ i ≥ N, (f - const _ (f i)).norm ≥ ε,
    by simpa [not_forall] using h,
  rcases this N with ⟨i, hi, hge⟩,
  have hne : ¬ (f - const (padic_norm hp) (f i)) ≈ 0,
  { intro h, unfold norm at hge; split_ifs at hge, exact not_lt_of_ge hge hε },
  unfold norm at hge; split_ifs at hge,
  apply not_le_of_gt _ hge,
  cases decidable.em ((stationary_point hne) ≥ N) with hgen hngen,
  { apply hN; assumption },
  { have := stationary_point_spec hne (le_refl _) (le_of_not_le hngen),
    rw ←this,
    apply hN,
    apply le_refl, assumption }
end

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

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

lemma zero_iff (q : ℚ_[hp]) : 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 : ℚ_[hp]) = 0 :=
(zero_iff _).2 rfl

@[simp] protected lemma one : padic_norm_e (1 : ℚ_[hp]) = 1 :=
norm_one

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

theorem nonarchimedean (q r : ℚ_[hp]) :
      padic_norm_e (q + r) ≤ max (padic_norm_e q) (padic_norm_e r) :=
quotient.induction_on₂ q r $ norm_nonarchimedean

protected lemma add (q r : ℚ_[hp]) :
      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 : ℚ_[hp]) :
      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 _ hp) :=
{ abv_nonneg := padic_norm_e.nonneg,
  abv_eq_zero := zero_iff,
  abv_add := padic_norm_e.add,
  abv_mul := padic_norm_e.mul }

lemma eq_padic_norm (q : ℚ) : padic_norm_e (padic.of_rat hp q) = padic_norm hp q :=
norm_const _

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

lemma sub_rev (q r : ℚ_[hp]) : 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 : ℕ} {hp : prime p} (q : ℚ_[hp]) {ε : ℚ} (hε : ε > 0) :
        ∃ r : ℚ, padic_norm_e (q - r) < ε :=
quotient.induction_on q $ λ q',
  have ∃ N, ∀ m n ≥ N, padic_norm hp (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 hp) (q' N)) ≈ 0) with heq hne',
      { simpa only [heq, norm, dif_pos] },
      { simp only [norm, dif_neg hne'],
        change padic_norm hp (q' _ - q' _) < ε,
        have := stationary_point_spec hne',
        cases decidable.em (N ≥ stationary_point hne') with hle hle,
        { have := eq.symm (this (le_refl _) hle),
          simp at this, simpa [this] },
        { apply hN,
          apply le_of_lt, apply lt_of_not_ge, apply hle, apply le_refl }}
    end⟩

variables {p : ℕ} {hp : prime p} (f : cau_seq _ (@padic_norm_e _ hp))
open classical

private lemma cast_succ_nat_pos (n : ℕ) : (↑(n + 1) : ℚ) > 0 :=
nat.cast_pos.2 $ succ_pos _

private lemma div_nat_pos (n : ℕ) : (1 / ((n + 1): ℚ)) > 0 :=
div_pos zero_lt_one (cast_succ_nat_pos _)

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 - of_rat hp ((lim_seq f) i)) < ε :=
begin
  refine (exists_nat_gt (1/ε)).imp (λ N hN i hi, _),
  have h := classical.some_spec (rat_dense (f i) (div_nat_pos i)),
  rw ← cast_eq_of_rat,
  refine lt_of_lt_of_le h (div_le_of_le_mul (cast_succ_nat_pos _) _),
  rw right_distrib,
  apply le_add_of_le_of_nonneg,
  { exact le_mul_of_div_le hε (le_trans (le_of_lt hN) (nat.cast_le.2 hi)) },
  { apply le_of_lt, simpa }
end

lemma exi_rat_seq_conv_cauchy : is_cau_seq (padic_norm hp) (lim_seq f) :=
assume ε hε,
have hε3 : ε / 3 > 0, 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,
  rw [←padic_norm_e.eq_padic_norm, padic.of_rat_sub],
  suffices : padic_norm_e ((↑(lim_seq f j) - f (max N N2)) + (f (max N N2) - lim_seq f (max N N2))) < ε,
  { ring at this ⊢, simpa only [cast_eq_of_rat] },
  { apply lt_of_le_of_lt,
    { apply padic_norm_e.add },
    { have : (3 : ℚ) ≠ 0, by norm_num,
      have : ε = ε / 3 + ε / 3 + ε / 3,
      { apply eq_of_mul_eq_mul_left this, simp [left_distrib, mul_div_cancel' _ this ], ring },
      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,
        apply lt_of_le_of_lt,
        { apply padic_norm_e.add },
        { apply add_lt_add,
          { rw [padic_norm_e.sub_rev, cast_eq_of_rat], apply hN, apply le_of_max_le_left hj },
          { apply hN2, apply le_of_max_le_right hj, apply le_max_right } } },
      { rw cast_eq_of_rat, apply hN, apply le_max_left }}}
end

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

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

theorem complete : ∃ q : ℚ_[hp], ∀ ε > 0, ∃ N, ∀ i ≥ N, padic_norm_e (q - f i) < ε :=
⟨ lim f,
  λ ε hε,
  let ⟨N, hN⟩ := exi_rat_seq_conv f (show ε / 2 > 0, from div_pos hε (by norm_num)),
      ⟨N2, hN2⟩ := padic_norm_e.defn (lim' f) (show ε / 2 > 0, from div_pos hε (by norm_num)) in
  begin
    existsi max N N2,
    intros i hi,
    suffices : padic_norm_e ((lim f - lim' f i) + (lim' f i - f i)) < ε,
    { ring at this; exact this },
    { apply lt_of_le_of_lt,
      { apply padic_norm_e.add },
      { have : (2 : ℚ) ≠ 0, by norm_num,
        have : ε = ε / 2 + ε / 2, by rw ←(add_self_div_two ε); simp,
        rw this,
        apply add_lt_add,
        { apply hN2, apply le_of_max_le_right hi },
        { rw [padic_norm_e.sub_rev, cast_eq_of_rat], apply hN, apply le_of_max_le_left hi } } }
  end ⟩

end complete

end padic


/-
Copyright (c) 2021 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Joseph Myers
-/
import group_theory.subgroup.actions
import linear_algebra.linear_independent

/-!
# Rays in modules

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

This file defines rays in modules.

## Main definitions

* `same_ray`: two vectors belong to the same ray if they are proportional with a nonnegative
  coefficient.

* `module.ray` is a type for the equivalence class of nonzero vectors in a module with some
common positive multiple.
-/

noncomputable theory

open_locale big_operators

section strict_ordered_comm_semiring

variables (R : Type*) [strict_ordered_comm_semiring R]
variables {M : Type*} [add_comm_monoid M] [module R M]
variables {N : Type*} [add_comm_monoid N] [module R N]
variables (ι : Type*) [decidable_eq ι]

/-- Two vectors are in the same ray if either one of them is zero or some positive multiples of them
are equal (in the typical case over a field, this means one of them is a nonnegative multiple of
the other). -/
def same_ray (v₁ v₂ : M) : Prop :=
v₁ = 0 ∨ v₂ = 0 ∨ ∃ (r₁ r₂ : R), 0 < r₁ ∧ 0 < r₂ ∧ r₁ • v₁ = r₂ • v₂

variables {R}

namespace same_ray

variables {x y z : M}

@[simp] lemma zero_left (y : M) : same_ray R 0 y := or.inl rfl

@[simp] lemma zero_right (x : M) : same_ray R x 0 := or.inr $ or.inl rfl

@[nontriviality] lemma of_subsingleton [subsingleton M] (x y : M) : same_ray R x y :=
by { rw [subsingleton.elim x 0], exact zero_left _ }

@[nontriviality] lemma of_subsingleton' [subsingleton R] (x y : M) : same_ray R x y :=
by { haveI := module.subsingleton R M, exact of_subsingleton x y }

/-- `same_ray` is reflexive. -/
@[refl] lemma refl (x : M) : same_ray R x x :=
begin
  nontriviality R,
  exact or.inr (or.inr $ ⟨1, 1, zero_lt_one, zero_lt_one, rfl⟩)
end

protected lemma rfl : same_ray R x x := refl _

/-- `same_ray` is symmetric. -/
@[symm] lemma symm (h : same_ray R x y) : same_ray R y x :=
(or.left_comm.1 h).imp_right $ or.imp_right $ λ ⟨r₁, r₂, h₁, h₂, h⟩, ⟨r₂, r₁, h₂, h₁, h.symm⟩

/-- If `x` and `y` are nonzero vectors on the same ray, then there exist positive numbers `r₁ r₂`
such that `r₁ • x = r₂ • y`. -/
lemma exists_pos (h : same_ray R x y) (hx : x ≠ 0) (hy : y ≠ 0) :
  ∃ r₁ r₂ : R, 0 < r₁ ∧ 0 < r₂ ∧ r₁ • x = r₂ • y :=
(h.resolve_left hx).resolve_left hy

lemma _root_.same_ray_comm : same_ray R x y ↔ same_ray R y x :=
⟨same_ray.symm, same_ray.symm⟩

/-- `same_ray` is transitive unless the vector in the middle is zero and both other vectors are
nonzero. -/
lemma trans (hxy : same_ray R x y) (hyz : same_ray R y z) (hy : y = 0 → x = 0 ∨ z = 0) :
  same_ray R x z :=
begin
  rcases eq_or_ne x 0 with rfl|hx, { exact zero_left z },
  rcases eq_or_ne z 0 with rfl|hz, { exact zero_right x },
  rcases eq_or_ne y 0 with rfl|hy, { exact (hy rfl).elim (λ h, (hx h).elim) (λ h, (hz h).elim) },
  rcases hxy.exists_pos hx hy with ⟨r₁, r₂, hr₁, hr₂, h₁⟩,
  rcases hyz.exists_pos hy hz with ⟨r₃, r₄, hr₃, hr₄, h₂⟩,
  refine or.inr (or.inr $ ⟨r₃ * r₁, r₂ * r₄, mul_pos hr₃ hr₁, mul_pos hr₂ hr₄, _⟩),
  rw [mul_smul, mul_smul, h₁, ← h₂, smul_comm]
end

/-- A vector is in the same ray as a nonnegative multiple of itself. -/
lemma _root_.same_ray_nonneg_smul_right (v : M) {r : R} (h : 0 ≤ r) : same_ray R v (r • v) :=
or.inr $ h.eq_or_lt.imp (λ h, h ▸ zero_smul R v) $
  λ h, ⟨r, 1, h, by { nontriviality R, exact zero_lt_one }, (one_smul _ _).symm⟩

/-- A vector is in the same ray as a positive multiple of itself. -/
lemma _root_.same_ray_pos_smul_right (v : M) {r : R} (h : 0 < r) : same_ray R v (r • v) :=
same_ray_nonneg_smul_right v h.le

/-- A vector is in the same ray as a nonnegative multiple of one it is in the same ray as. -/
lemma nonneg_smul_right {r : R} (h : same_ray R x y) (hr : 0 ≤ r) : same_ray R x (r • y) :=
h.trans (same_ray_nonneg_smul_right y hr) $ λ hy, or.inr $ by rw [hy, smul_zero]

/-- A vector is in the same ray as a positive multiple of one it is in the same ray as. -/
lemma pos_smul_right {r : R} (h : same_ray R x y) (hr : 0 < r) : same_ray R x (r • y) :=
h.nonneg_smul_right hr.le

/-- A nonnegative multiple of a vector is in the same ray as that vector. -/
lemma _root_.same_ray_nonneg_smul_left (v : M) {r : R} (h : 0 ≤ r) : same_ray R (r • v) v :=
(same_ray_nonneg_smul_right v h).symm

/-- A positive multiple of a vector is in the same ray as that vector. -/
lemma _root_.same_ray_pos_smul_left (v : M) {r : R} (h : 0 < r) : same_ray R (r • v) v :=
same_ray_nonneg_smul_left v h.le

/-- A nonnegative multiple of a vector is in the same ray as one it is in the same ray as. -/
lemma nonneg_smul_left {r : R} (h : same_ray R x y) (hr : 0 ≤ r) : same_ray R (r • x) y :=
(h.symm.nonneg_smul_right hr).symm

/-- A positive multiple of a vector is in the same ray as one it is in the same ray as. -/
lemma pos_smul_left {r : R} (h : same_ray R x y) (hr : 0 < r) : same_ray R (r • x) y :=
h.nonneg_smul_left hr.le

/-- If two vectors are on the same ray then they remain so after applying a linear map. -/
lemma map (f : M →ₗ[R] N) (h : same_ray R x y) : same_ray R (f x) (f y) :=
h.imp (λ hx, by rw [hx, map_zero]) $ or.imp (λ hy, by rw [hy, map_zero]) $
  λ ⟨r₁, r₂, hr₁, hr₂, h⟩, ⟨r₁, r₂, hr₁, hr₂, by rw [←f.map_smul, ←f.map_smul, h]⟩

/-- The images of two vectors under an injective linear map are on the same ray if and only if the
original vectors are on the same ray. -/
lemma _root_.function.injective.same_ray_map_iff {F : Type*} [linear_map_class F R M N] {f : F}
  (hf : function.injective f) : same_ray R (f x) (f y) ↔ same_ray R x y :=
by simp only [same_ray, map_zero, ← hf.eq_iff, map_smul]

/-- The images of two vectors under a linear equivalence are on the same ray if and only if the
original vectors are on the same ray. -/
@[simp] lemma _root_.same_ray_map_iff (e : M ≃ₗ[R] N) : same_ray R (e x) (e y) ↔ same_ray R x y :=
function.injective.same_ray_map_iff (equiv_like.injective e)

/-- If two vectors are on the same ray then both scaled by the same action are also on the same
ray. -/
lemma smul {S : Type*} [monoid S] [distrib_mul_action S M] [smul_comm_class R S M]
  (h : same_ray R x y) (s : S) : same_ray R (s • x) (s • y) :=
h.map (s • (linear_map.id : M →ₗ[R] M))

/-- If `x` and `y` are on the same ray as `z`, then so is `x + y`. -/
lemma add_left (hx : same_ray R x z) (hy : same_ray R y z) : same_ray R (x + y) z :=
begin
  rcases eq_or_ne x 0 with rfl|hx₀, { rwa zero_add },
  rcases eq_or_ne y 0 with rfl|hy₀, { rwa add_zero },
  rcases eq_or_ne z 0 with rfl|hz₀, { apply zero_right },
  rcases hx.exists_pos hx₀ hz₀ with ⟨rx, rz₁, hrx, hrz₁, Hx⟩,
  rcases hy.exists_pos hy₀ hz₀ with ⟨ry, rz₂, hry, hrz₂, Hy⟩,
  refine or.inr (or.inr ⟨rx * ry, ry * rz₁ + rx * rz₂, mul_pos hrx hry, _, _⟩),
  { apply_rules [add_pos, mul_pos] },
  { simp only [mul_smul, smul_add, add_smul, ← Hx, ← Hy],
    rw smul_comm }
end

/-- If `y` and `z` are on the same ray as `x`, then so is `y + z`. -/
lemma add_right (hy : same_ray R x y) (hz : same_ray R x z) : same_ray R x (y + z) :=
(hy.symm.add_left hz.symm).symm

end same_ray

/-- Nonzero vectors, as used to define rays. This type depends on an unused argument `R` so that
`ray_vector.setoid` can be an instance. -/
@[nolint unused_arguments has_nonempty_instance]
def ray_vector (R M : Type*) [has_zero M] := {v : M // v ≠ 0}

instance ray_vector.has_coe {R M : Type*} [has_zero M] :
  has_coe (ray_vector R M) M := coe_subtype

instance {R M : Type*} [has_zero M] [nontrivial M] : nonempty (ray_vector R M) :=
let ⟨x, hx⟩ := exists_ne (0 : M) in ⟨⟨x, hx⟩⟩

variables (R M)

/-- The setoid of the `same_ray` relation for the subtype of nonzero vectors. -/
instance : setoid (ray_vector R M) :=
{ r := λ x y, same_ray R (x : M) y,
  iseqv := ⟨λ x, same_ray.refl _, λ x y h, h.symm,
    λ x y z hxy hyz, hxy.trans hyz $ λ hy, (y.2 hy).elim⟩ }

/-- A ray (equivalence class of nonzero vectors with common positive multiples) in a module. -/
@[nolint has_nonempty_instance]
def module.ray := quotient (ray_vector.setoid R M)

variables {R M}

/-- Equivalence of nonzero vectors, in terms of same_ray. -/
lemma equiv_iff_same_ray {v₁ v₂ : ray_vector R M} :
  v₁ ≈ v₂ ↔ same_ray R (v₁ : M) v₂ :=
iff.rfl

variables (R)

/-- The ray given by a nonzero vector. -/
protected def ray_of_ne_zero (v : M) (h : v ≠ 0) : module.ray R M := ⟦⟨v, h⟩⟧

/-- An induction principle for `module.ray`, used as `induction x using module.ray.ind`. -/
lemma module.ray.ind {C : module.ray R M → Prop}
  (h : ∀ v (hv : v ≠ 0), C (ray_of_ne_zero R v hv)) (x : module.ray R M) : C x :=
quotient.ind (subtype.rec $ by exact h) x

variable {R}

instance [nontrivial M] : nonempty (module.ray R M) :=
nonempty.map quotient.mk infer_instance

/-- The rays given by two nonzero vectors are equal if and only if those vectors
satisfy `same_ray`. -/
lemma ray_eq_iff {v₁ v₂ : M} (hv₁ : v₁ ≠ 0) (hv₂ : v₂ ≠ 0) :
  ray_of_ne_zero R _ hv₁ = ray_of_ne_zero R _ hv₂ ↔ same_ray R v₁ v₂ :=
quotient.eq

/-- The ray given by a positive multiple of a nonzero vector. -/
@[simp] lemma ray_pos_smul {v : M} (h : v ≠ 0) {r : R} (hr : 0 < r)
  (hrv : r • v ≠ 0) : ray_of_ne_zero R (r • v) hrv = ray_of_ne_zero R v h :=
(ray_eq_iff _ _).2 $ same_ray_pos_smul_left v hr

/-- An equivalence between modules implies an equivalence between ray vectors. -/
def ray_vector.map_linear_equiv (e : M ≃ₗ[R] N) : ray_vector R M ≃ ray_vector R N :=
equiv.subtype_equiv e.to_equiv $ λ _, e.map_ne_zero_iff.symm

/-- An equivalence between modules implies an equivalence between rays. -/
def module.ray.map (e : M ≃ₗ[R] N) : module.ray R M ≃ module.ray R N :=
quotient.congr (ray_vector.map_linear_equiv e) $ λ ⟨a, ha⟩ ⟨b, hb⟩, (same_ray_map_iff _).symm

@[simp] lemma module.ray.map_apply (e : M ≃ₗ[R] N) (v : M) (hv : v ≠ 0) :
  module.ray.map e (ray_of_ne_zero _ v hv) = ray_of_ne_zero _ (e v) (e.map_ne_zero_iff.2 hv) := rfl

@[simp] lemma module.ray.map_refl : (module.ray.map $ linear_equiv.refl R M) = equiv.refl _ :=
equiv.ext $ module.ray.ind R $ λ _ _, rfl

@[simp] lemma module.ray.map_symm (e : M ≃ₗ[R] N) :
  (module.ray.map e).symm = module.ray.map e.symm := rfl

section action
variables {G : Type*} [group G] [distrib_mul_action G M]

/-- Any invertible action preserves the non-zeroness of ray vectors. This is primarily of interest
when `G = Rˣ` -/
instance {R : Type*} : mul_action G (ray_vector R M) :=
{ smul := λ r, (subtype.map ((•) r) $ λ a, (smul_ne_zero_iff_ne _).2),
  mul_smul := λ a b m, subtype.ext $ mul_smul a b _,
  one_smul := λ m, subtype.ext $ one_smul _ _ }

variables [smul_comm_class R G M]

/-- Any invertible action preserves the non-zeroness of rays. This is primarily of interest when
`G = Rˣ` -/
instance : mul_action G (module.ray R M) :=
{ smul := λ r, quotient.map ((•) r) (λ a b h, h.smul _),
  mul_smul := λ a b, quotient.ind $ by exact(λ m, congr_arg quotient.mk $ mul_smul a b _),
  one_smul := quotient.ind $ by exact (λ m, congr_arg quotient.mk $ one_smul _ _), }

/-- The action via `linear_equiv.apply_distrib_mul_action` corresponds to `module.ray.map`. -/
@[simp] lemma module.ray.linear_equiv_smul_eq_map (e : M ≃ₗ[R] M) (v : module.ray R M) :
  e • v = module.ray.map e v := rfl

@[simp] lemma smul_ray_of_ne_zero (g : G) (v : M) (hv) :
  g • ray_of_ne_zero R v hv = ray_of_ne_zero R (g • v) ((smul_ne_zero_iff_ne _).2 hv) := rfl

end action

namespace module.ray

/-- Scaling by a positive unit is a no-op. -/
lemma units_smul_of_pos (u : Rˣ) (hu : 0 < (u : R)) (v : module.ray R M) :
  u • v = v :=
begin
  induction v using module.ray.ind,
  rw [smul_ray_of_ne_zero, ray_eq_iff],
  exact same_ray_pos_smul_left _ hu
end

/-- An arbitrary `ray_vector` giving a ray. -/
def some_ray_vector (x : module.ray R M) : ray_vector R M := quotient.out x

/-- The ray of `some_ray_vector`. -/
@[simp] lemma some_ray_vector_ray (x : module.ray R M) :
  (⟦x.some_ray_vector⟧ : module.ray R M) = x :=
quotient.out_eq _

/-- An arbitrary nonzero vector giving a ray. -/
def some_vector (x : module.ray R M) : M := x.some_ray_vector

/-- `some_vector` is nonzero. -/
@[simp] lemma some_vector_ne_zero (x : module.ray R M) : x.some_vector ≠ 0 :=
x.some_ray_vector.property

/-- The ray of `some_vector`. -/
@[simp] lemma some_vector_ray (x : module.ray R M) :
  ray_of_ne_zero R _ x.some_vector_ne_zero = x :=
(congr_arg _ (subtype.coe_eta _ _) : _).trans x.out_eq

end module.ray

end strict_ordered_comm_semiring

section strict_ordered_comm_ring

variables {R : Type*} [strict_ordered_comm_ring R]
variables {M N : Type*} [add_comm_group M] [add_comm_group N] [module R M] [module R N] {x y : M}

/-- `same_ray.neg` as an `iff`. -/
@[simp] lemma same_ray_neg_iff : same_ray R (-x) (-y) ↔ same_ray R x y :=
by simp only [same_ray, neg_eq_zero, smul_neg, neg_inj]

alias same_ray_neg_iff ↔ same_ray.of_neg same_ray.neg

lemma same_ray_neg_swap : same_ray R (-x) y ↔ same_ray R x (-y) :=
by rw [← same_ray_neg_iff, neg_neg]

lemma eq_zero_of_same_ray_neg_smul_right [no_zero_smul_divisors R M] {r : R} (hr : r < 0)
  (h : same_ray R x (r • x)) :
  x = 0 :=
begin
  rcases h with rfl|h₀|⟨r₁, r₂, hr₁, hr₂, h⟩,
  { refl },
  { simpa [hr.ne] using h₀ },
  { rw [← sub_eq_zero, smul_smul, ← sub_smul, smul_eq_zero] at h,
    refine h.resolve_left (ne_of_gt $ sub_pos.2 _),
    exact (mul_neg_of_pos_of_neg hr₂ hr).trans hr₁ }
end

/-- If a vector is in the same ray as its negation, that vector is zero. -/
lemma eq_zero_of_same_ray_self_neg [no_zero_smul_divisors R M] (h : same_ray R x (-x)) :
  x = 0 :=
begin
  nontriviality M, haveI : nontrivial R := module.nontrivial R M,
  refine eq_zero_of_same_ray_neg_smul_right (neg_lt_zero.2 (zero_lt_one' R)) _,
  rwa [neg_one_smul]
end

namespace ray_vector

/-- Negating a nonzero vector. -/
instance {R : Type*} : has_neg (ray_vector R M) := ⟨λ v, ⟨-v, neg_ne_zero.2 v.prop⟩⟩

/-- Negating a nonzero vector commutes with coercion to the underlying module. -/
@[simp, norm_cast] lemma coe_neg {R : Type*} (v : ray_vector R M) : ↑(-v) = -(v : M) := rfl

/-- Negating a nonzero vector twice produces the original vector. -/
instance {R : Type*} : has_involutive_neg (ray_vector R M) :=
{ neg := has_neg.neg,
  neg_neg := λ v, by rw [subtype.ext_iff, coe_neg, coe_neg, neg_neg] }

/-- If two nonzero vectors are equivalent, so are their negations. -/
@[simp] lemma equiv_neg_iff {v₁ v₂ : ray_vector R M} : -v₁ ≈ -v₂ ↔ v₁ ≈ v₂ :=
same_ray_neg_iff

end ray_vector

variables (R)

/-- Negating a ray. -/
instance : has_neg (module.ray R M) :=
⟨quotient.map (λ v, -v) (λ v₁ v₂, ray_vector.equiv_neg_iff.2)⟩

/-- The ray given by the negation of a nonzero vector. -/
@[simp] lemma neg_ray_of_ne_zero (v : M) (h : v ≠ 0) :
  -(ray_of_ne_zero R _ h) = ray_of_ne_zero R (-v) (neg_ne_zero.2 h) :=
rfl

namespace module.ray

variables {R}

/-- Negating a ray twice produces the original ray. -/
instance : has_involutive_neg (module.ray R M) :=
{ neg := has_neg.neg,
  neg_neg := λ x, quotient.ind (λ a, congr_arg quotient.mk $ neg_neg _) x }

variables {R M}

/-- A ray does not equal its own negation. -/
lemma ne_neg_self [no_zero_smul_divisors R M] (x : module.ray R M) : x ≠ -x :=
begin
  induction x using module.ray.ind with x hx,
  rw [neg_ray_of_ne_zero, ne.def, ray_eq_iff],
  exact mt eq_zero_of_same_ray_self_neg hx
end

lemma neg_units_smul (u : Rˣ) (v : module.ray R M) : (-u) • v = - (u • v) :=
begin
  induction v using module.ray.ind,
  simp only [smul_ray_of_ne_zero, units.smul_def, units.coe_neg, neg_smul, neg_ray_of_ne_zero]
end

/-- Scaling by a negative unit is negation. -/
lemma units_smul_of_neg (u : Rˣ) (hu : (u : R) < 0) (v : module.ray R M) :
  u • v = -v :=
begin
  rw [← neg_inj, neg_neg, ← neg_units_smul, units_smul_of_pos],
  rwa [units.coe_neg, right.neg_pos_iff]
end

@[simp] protected lemma map_neg (f : M ≃ₗ[R] N) (v : module.ray R M) : map f (-v) = - map f v :=
begin
  induction v using module.ray.ind with g hg,
  simp,
end

end module.ray

end strict_ordered_comm_ring

section linear_ordered_comm_ring

variables {R : Type*} [linear_ordered_comm_ring R]
variables {M : Type*} [add_comm_group M] [module R M]

/-- `same_ray` follows from membership of `mul_action.orbit` for the `units.pos_subgroup`. -/
lemma same_ray_of_mem_orbit {v₁ v₂ : M} (h : v₁ ∈ mul_action.orbit (units.pos_subgroup R) v₂) :
  same_ray R v₁ v₂ :=
begin
  rcases h with ⟨⟨r, hr : 0 < (r : R)⟩, (rfl : r • v₂ = v₁)⟩,
  exact same_ray_pos_smul_left _ hr
end

/-- Scaling by an inverse unit is the same as scaling by itself. -/
@[simp] lemma units_inv_smul (u : Rˣ) (v : module.ray R M) :
  u⁻¹ • v = u • v :=
calc u⁻¹ • v = (u * u) • u⁻¹ • v :
  eq.symm $ (u⁻¹ • v).units_smul_of_pos _ $ mul_self_pos.2 u.ne_zero
... = u • v : by rw [mul_smul, smul_inv_smul]

section
variables [no_zero_smul_divisors R M]

@[simp] lemma same_ray_smul_right_iff {v : M} {r : R} :
  same_ray R v (r • v) ↔ 0 ≤ r ∨ v = 0 :=
⟨λ hrv, or_iff_not_imp_left.2 $ λ hr, eq_zero_of_same_ray_neg_smul_right (not_le.1 hr) hrv,
  or_imp_distrib.2 ⟨same_ray_nonneg_smul_right v, λ h, h.symm ▸ same_ray.zero_left _⟩⟩

/-- A nonzero vector is in the same ray as a multiple of itself if and only if that multiple
is positive. -/
lemma same_ray_smul_right_iff_of_ne {v : M} (hv : v ≠ 0) {r : R} (hr : r ≠ 0) :
  same_ray R v (r • v) ↔ 0 < r :=
by simp only [same_ray_smul_right_iff, hv, or_false, hr.symm.le_iff_lt]

@[simp] lemma same_ray_smul_left_iff {v : M} {r : R} : same_ray R (r • v) v ↔ 0 ≤ r ∨ v = 0 :=
same_ray_comm.trans same_ray_smul_right_iff

/-- A multiple of a nonzero vector is in the same ray as that vector if and only if that multiple
is positive. -/
lemma same_ray_smul_left_iff_of_ne {v : M} (hv : v ≠ 0) {r : R} (hr : r ≠ 0) :
  same_ray R (r • v) v ↔ 0 < r :=
same_ray_comm.trans (same_ray_smul_right_iff_of_ne hv hr)

@[simp] lemma same_ray_neg_smul_right_iff {v : M} {r : R} :
  same_ray R (-v) (r • v) ↔ r ≤ 0 ∨ v = 0 :=
by rw [← same_ray_neg_iff, neg_neg, ← neg_smul, same_ray_smul_right_iff, neg_nonneg]

lemma same_ray_neg_smul_right_iff_of_ne {v : M} {r : R} (hv : v ≠ 0) (hr : r ≠ 0) :
  same_ray R (-v) (r • v) ↔ r < 0 :=
by simp only [same_ray_neg_smul_right_iff, hv, or_false, hr.le_iff_lt]

@[simp] lemma same_ray_neg_smul_left_iff {v : M} {r : R} :
  same_ray R (r • v) (-v) ↔ r ≤ 0 ∨ v = 0 :=
same_ray_comm.trans same_ray_neg_smul_right_iff

lemma same_ray_neg_smul_left_iff_of_ne {v : M} {r : R} (hv : v ≠ 0) (hr : r ≠ 0) :
  same_ray R (r • v) (-v) ↔ r < 0 :=
same_ray_comm.trans $ same_ray_neg_smul_right_iff_of_ne hv hr

@[simp] lemma units_smul_eq_self_iff {u : Rˣ} {v : module.ray R M} :
  u • v = v ↔ (0 : R) < u :=
begin
  induction v using module.ray.ind with v hv,
  simp only [smul_ray_of_ne_zero, ray_eq_iff, units.smul_def,
    same_ray_smul_left_iff_of_ne hv u.ne_zero]
end

@[simp] lemma units_smul_eq_neg_iff {u : Rˣ} {v : module.ray R M} :
  u • v = -v ↔ ↑u < (0 : R) :=
by rw [← neg_inj, neg_neg, ← module.ray.neg_units_smul, units_smul_eq_self_iff, units.coe_neg,
  neg_pos]

/-- Two vectors are in the same ray, or the first is in the same ray as the negation of the
second, if and only if they are not linearly independent. -/
lemma same_ray_or_same_ray_neg_iff_not_linear_independent {x y : M} :
  (same_ray R x y ∨ same_ray R x (-y)) ↔ ¬ linear_independent R ![x, y] :=
begin
  by_cases hx : x = 0, { simp [hx, λ h : linear_independent R ![0, y], h.ne_zero 0 rfl] },
  by_cases hy : y = 0, { simp [hy, λ h : linear_independent R ![x, 0], h.ne_zero 1 rfl] },
  simp_rw [fintype.not_linear_independent_iff, fin.sum_univ_two, fin.exists_fin_two],
  refine ⟨λ h, _, λ h, _⟩,
  { rcases h with (hx0|hy0|⟨r₁, r₂, hr₁, hr₂, h⟩)|(hx0|hy0|⟨r₁, r₂, hr₁, hr₂, h⟩),
    { exact false.elim (hx hx0) },
    { exact false.elim (hy hy0) },
    { refine ⟨![r₁, -r₂], _⟩, simp [h, hr₁.ne.symm] },
    { exact false.elim (hx hx0) },
    { exact false.elim (hy (neg_eq_zero.1 hy0)) },
    { refine ⟨![r₁, r₂], _⟩, simp [h, hr₁.ne.symm] } },
  { rcases h with ⟨m, hm, hmne⟩,
    change m 0 • x + m 1 • y = 0 at hm,
    rw add_eq_zero_iff_eq_neg at hm,
    rcases lt_trichotomy (m 0) 0 with hm0|hm0|hm0; rcases lt_trichotomy (m 1) 0 with hm1|hm1|hm1,
    { refine or.inr (or.inr (or.inr ⟨-(m 0), -(m 1), left.neg_pos_iff.2 hm0,
                                     left.neg_pos_iff.2 hm1, _⟩)),
      simp [hm] },
    { exfalso, simpa [hm1, hx, hm0.ne] using hm },
    { refine or.inl (or.inr (or.inr ⟨-(m 0), m 1, left.neg_pos_iff.2 hm0, hm1, _⟩)),
      simp [hm] },
    { exfalso, simpa [hm0, hy, hm1.ne] using hm },
    { refine false.elim (not_and_distrib.2 hmne ⟨hm0, hm1⟩) },
    { exfalso, simpa [hm0, hy, hm1.ne.symm] using hm },
    { refine or.inl (or.inr (or.inr ⟨m 0, -(m 1), hm0, left.neg_pos_iff.2 hm1, _⟩)),
      simp [hm] },
    { exfalso, simpa [hm1, hx, hm0.ne.symm] using hm },
    { refine or.inr (or.inr (or.inr ⟨m 0, m 1, hm0, hm1, _⟩)),
      simp [hm] } }
end

/-- Two vectors are in the same ray, or they are nonzero and the first is in the same ray as the
negation of the second, if and only if they are not linearly independent. -/
lemma same_ray_or_ne_zero_and_same_ray_neg_iff_not_linear_independent {x y : M} :
  (same_ray R x y ∨ x ≠ 0 ∧ y ≠ 0 ∧ same_ray R x (-y)) ↔ ¬ linear_independent R ![x, y] :=
begin
  rw ←same_ray_or_same_ray_neg_iff_not_linear_independent,
  by_cases hx : x = 0, { simp [hx] },
  by_cases hy : y = 0;
    simp [hx, hy]
end

end

end linear_ordered_comm_ring

namespace same_ray

variables {R : Type*} [linear_ordered_field R]
variables {M : Type*} [add_comm_group M] [module R M] {x y v₁ v₂ : M}

lemma exists_pos_left (h : same_ray R x y) (hx : x ≠ 0) (hy : y ≠ 0) :
  ∃ r : R, 0 < r ∧ r • x = y :=
let ⟨r₁, r₂, hr₁, hr₂, h⟩ := h.exists_pos hx hy in
  ⟨r₂⁻¹ * r₁, mul_pos (inv_pos.2 hr₂) hr₁, by rw [mul_smul, h, inv_smul_smul₀ hr₂.ne']⟩

lemma exists_pos_right (h : same_ray R x y) (hx : x ≠ 0) (hy : y ≠ 0) :
  ∃ r : R, 0 < r ∧ x = r • y :=
(h.symm.exists_pos_left hy hx).imp $ λ _, and.imp_right eq.symm

/-- If a vector `v₂` is on the same ray as a nonzero vector `v₁`, then it is equal to `c • v₁` for
some nonnegative `c`. -/
lemma exists_nonneg_left (h : same_ray R x y) (hx : x ≠ 0) : ∃ r : R, 0 ≤ r ∧ r • x = y :=
begin
  obtain rfl | hy := eq_or_ne y 0,
  { exact ⟨0, le_rfl, zero_smul _ _⟩ },
  { exact (h.exists_pos_left hx hy).imp (λ _, and.imp_left le_of_lt) }
end

/-- If a vector `v₁` is on the same ray as a nonzero vector `v₂`, then it is equal to `c • v₂` for
some nonnegative `c`. -/
lemma exists_nonneg_right (h : same_ray R x y) (hy : y ≠ 0) : ∃ r : R, 0 ≤ r ∧ x = r • y :=
(h.symm.exists_nonneg_left hy).imp $ λ _, and.imp_right eq.symm

/-- If vectors `v₁` and `v₂` are on the same ray, then for some nonnegative `a b`, `a + b = 1`, we
have `v₁ = a • (v₁ + v₂)` and `v₂ = b • (v₁ + v₂)`. -/
lemma exists_eq_smul_add (h : same_ray R v₁ v₂) :
  ∃ a b : R, 0 ≤ a ∧ 0 ≤ b ∧ a + b = 1 ∧ v₁ = a • (v₁ + v₂) ∧ v₂ = b • (v₁ + v₂) :=
begin
  rcases h with rfl|rfl|⟨r₁, r₂, h₁, h₂, H⟩,
  { use [0, 1], simp },
  { use [1, 0], simp },
  { have h₁₂ : 0 < r₁ + r₂, from add_pos h₁ h₂,
    refine ⟨r₂ / (r₁ + r₂), r₁ / (r₁ + r₂), div_nonneg h₂.le h₁₂.le, div_nonneg h₁.le h₁₂.le,
      _, _, _⟩,
    { rw [← add_div, add_comm, div_self h₁₂.ne'] },
    { rw [div_eq_inv_mul, mul_smul, smul_add, ← H, ← add_smul, add_comm r₂,
        inv_smul_smul₀ h₁₂.ne'] },
    { rw [div_eq_inv_mul, mul_smul, smul_add, H, ← add_smul, add_comm r₂,
        inv_smul_smul₀ h₁₂.ne'] } }
end

/-- If vectors `v₁` and `v₂` are on the same ray, then they are nonnegative multiples of the same
vector. Actually, this vector can be assumed to be `v₁ + v₂`, see `same_ray.exists_eq_smul_add`. -/
lemma exists_eq_smul (h : same_ray R v₁ v₂) :
  ∃ (u : M) (a b : R), 0 ≤ a ∧ 0 ≤ b ∧ a + b = 1 ∧ v₁ = a • u ∧ v₂ = b • u :=
⟨v₁ + v₂, h.exists_eq_smul_add⟩

end same_ray

section linear_ordered_field

variables {R : Type*} [linear_ordered_field R]
variables {M : Type*} [add_comm_group M] [module R M] {x y : M}

lemma exists_pos_left_iff_same_ray (hx : x ≠ 0) (hy : y ≠ 0) :
  (∃ r : R, 0 < r ∧ r • x = y) ↔ same_ray R x y :=
begin
  refine ⟨λ h, _, λ h, h.exists_pos_left hx hy⟩,
  rcases h with ⟨r, hr, rfl⟩,
  exact same_ray_pos_smul_right x hr
end

lemma exists_pos_left_iff_same_ray_and_ne_zero (hx : x ≠ 0) :
  (∃ r : R, 0 < r ∧ r • x = y) ↔ (same_ray R x y ∧ y ≠ 0) :=
begin
  split,
  { rintro ⟨r, hr, rfl⟩,
    simp [hx, hr.le, hr.ne'] },
  { rintro ⟨hxy, hy⟩,
    exact (exists_pos_left_iff_same_ray hx hy).2 hxy }
end

lemma exists_nonneg_left_iff_same_ray (hx : x ≠ 0) :
  (∃ r : R, 0 ≤ r ∧ r • x = y) ↔ same_ray R x y :=
begin
  refine ⟨λ h, _, λ h, h.exists_nonneg_left hx⟩,
  rcases h with ⟨r, hr, rfl⟩,
  exact same_ray_nonneg_smul_right x hr
end

lemma exists_pos_right_iff_same_ray (hx : x ≠ 0) (hy : y ≠ 0) :
  (∃ r : R, 0 < r ∧ x = r • y) ↔ same_ray R x y :=
by simpa only [same_ray_comm, eq_comm] using exists_pos_left_iff_same_ray hy hx

lemma exists_pos_right_iff_same_ray_and_ne_zero (hy : y ≠ 0) :
  (∃ r : R, 0 < r ∧ x = r • y) ↔ (same_ray R x y ∧ x ≠ 0) :=
by simpa only [same_ray_comm, eq_comm] using exists_pos_left_iff_same_ray_and_ne_zero hy

lemma exists_nonneg_right_iff_same_ray (hy : y ≠ 0) :
  (∃ r : R, 0 ≤ r ∧ x = r • y) ↔ same_ray R x y :=
by simpa only [same_ray_comm, eq_comm] using exists_nonneg_left_iff_same_ray hy

end linear_ordered_field


-- Pruebas de A ∈ 𝒫 (A ∪ B)
-- ========================

import data.set
open set

variable  {U : Type}
variables (A B : set U)

#reduce powerset A
#reduce B ∈ powerset A
#reduce 𝒫 A
#reduce B ∈ 𝒫 A

-- ?ª demostración
example : A ∈ 𝒫 (A ∪ B) :=
begin
  intros x h,
  simp,
  left,
  exact h,
end

-- ?ª demostración
example : A ∈ 𝒫 (A ∪ B) :=
begin
  intros x h,
  exact or.inl h,
end

-- ?ª demostración
example : A ∈ 𝒫 (A ∪ B) :=
λ x, or.inl

-- ?ª demostración
example : A ∈ 𝒫 (A ∪ B) :=
assume x,
assume : x ∈ A,
show x ∈ A ∪ B, from or.inl ‹x ∈ A›


/-
Copyright (c) 2022 Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author : Kevin Buzzard
-/

import tactic -- imports all the Lean tactics

/-!

# Logic in Lean, example sheet 2 : `true` and `false`

We learn about the `true` and `false` propositions.

## Tactics you will need

To solve the levels on this sheet you will need to know all previous
tactics, plus the following two new ones. Check out their explanations
in the course book. Or just try them out and hover over them to see
if you can understand what's going on.

* `triv`
* `exfalso`

-/

-- Throughout this sheet, `P`, `Q` and `R` will denote propositions.

variables (P Q R : Prop)

example : true :=
begin
  triv,
end

example : true → true :=
begin
  intro h,
  exact h,
end

example : false → true :=
begin
  intro h,
  triv,
end

example : false → false :=
begin
  intro h,
  exact h,
end

example : (true → false) → false :=
begin
  intro h,
  apply h,
  triv,
end

example : false → P :=
begin
  intro h,
  exfalso,
  exact h,
end

example : true → false → true → false → true → false :=
begin
  intros h1 h2 h3 h4 h5,
  exact h4,
end

example : P → ((P → false) → false) :=
begin
  intros hP h,
  apply h,
  assumption,
end

example : (P → false) → P → Q :=
begin
  intros h1 h2,
  exfalso,
  apply h1,
  exact h2,
end

example : (true → false) → P :=
begin
  intro h,
  exfalso,
  apply h,
  triv,
end


/-
Today we will see in that proofs can be understood as formal
objects in their own right.

We will start to make our way through the valid rules of
inference from our unit on propositional logic. We will
emphasize that they are rules for combining and deriving
Boolean truth values. In predicate logic, by contrast, we
will reinterpret them as rules for combining and deriving
*proofs*. In predicate logic, the existence of a proof is
our new basis for deciding whether or not a proposition
can be judged to be true.

In particular, we will look at how to (1) *construct* and
(2) *use* given or assumed proofs of two simple forms of
propositions, namely conjunctions and disjunctions.

We will see that we can view proofs as *computational*
objects.

In particular, we will see that we can view a proof of a
conjunction, P ∧ Q, as a *pair* of proofs (a proof of P
*and* a proof of Q), and thus as a value of a *product*
type. We will then view a proof of a disjunction, P ∨ Q,
as *either* an object constructed from a proof of P *or*
an object built from a proof of Q, and thus a value of a
*sum* type.

Understanding proof construction and manipulation as
computations involving logical types (propositions) and
values (proofs) will give you the precise understanding
of deductive reasoning in predicate logic that you need
to handle a very wide variety of "prove it" problems in
the years to come, whether or not (and more likely not)
you use an automated proof assistant such as Lean or its
formalized proofs.
-/

/-
To begin we will review our polymorphic product (pair)
type. We will then see that the ∧ (and) connective in
predicate logic can be understood and formalized as a
completely analogous polymorphic *logical* type. It's
one costructor implements the and introduction rule,
and its two projection functions implement the two
and elimination rules.
-/
#check and

namespace hidden

-- review -- prod abstract data type!

-- be sure you fully understand this type definition
inductive prod (α β : Type) : Type
| mk (a : α) (b : β) : prod

-- here's a named example of a value of this type
def pair1 := prod.mk 1 1

#reduce pair1

-- by the way, we can use "example" for unnamed values
example : prod nat nat := prod.mk 1 1

-- the first, or left, projection function
-- implemented by pattern matching (aka elimination!)
def fst {α β : Type} : prod α β → α
| (prod.mk a b) := a

-- the second, or right, projection function
def snd {α β : Type} : prod α β → β
| (prod.mk a b) := b

-- and a function that from one pair derives its swap
def swap  {α β : Type} : prod α β → prod β α
| (prod.mk a b) := prod.mk b a

/-
Our implementation of the and connective and its rules
of inference (introduction and elimination rules) in
exactly the same way, except that our and polymorphic
pair type now lives in "Prop," the unverse of logical
types (propositions), rather than in "Type", which as
we know is the universe of computational types.

As a reminder from propositional logic, here are three
rules of reasoning that we showed to be semantically valid.

def and_intro := P >> Q >> P ∧ Q
def and_elim_left := P ∧ Q >> P
def and_elim_right := P ∧ Q >> Q

In propositional logic, we read these rules as involving
truth values: e.g., if P "is true" and Q "is true" then
"P ∧ Q" "is true". We now reconceptualize these rules to
involve proofs. E.g., If we have (or assume we have) a
proof, p, of P, and we have (or assume we have) a proof,
q, of Q, then we can construct a proof, ⟨p, q⟩, of P ∧ Q.
That's the and introduction rule. Similarly, if we have
a proof (pair!), ⟨p, q⟩, then from it we can derive a
proof, p, of P, and a proof, q, of Q, by nothing more
complex than projection: we destructure the pair and
return one of the other other of its two components.

-/

structure and (P Q : Prop) : Prop :=    -- Prop not Type!
intro :: (left : P) (right : Q)         -- and.intro rule

-- one poassible way to write left elimination rule
def and_elim_left {P Q : Prop} : and P Q → P
| (and.intro p q) := p

-- here's another, with elim_left in the "and" namespace
-- note that we use projection function from "structure"
def and.elim_left {P Q : Prop}  (pq : and P Q) : P :=
pq.left

-- and here is the right elimination rule in two forms
def and_elim_right {P Q : Prop} : and P Q → Q
| (and.intro p q) := q

def and.elim_right {P Q : Prop}  (pq : and P Q) : Q :=
pq.right

/-
A note on notation. The Lean libraries define the and
connective exactly as we've done here. In addition, the
Lean library defined ∧ as an infix notation for "and".
We won't define that notation here, so wherever we want
to use the and connective, e.g., for P ∧ Q, we'll have
to write "and P Q". Same with or.
-/

-- tests

def pf1 : and (1=1) (eq 0 0) :=  -- 1=1 and 0=0
  and.intro (eq.refl 1) (eq.refl 0) -- proof of it!
  -- and.intro is a proof constructor

-- We now see that pf1 is basically a pair of proofs
#reduce pf1
-- proof, left element 1=1, right element 0=0

/- OR

We also formalize the logical connective, ∨, as an
inductive type with two (logical) type arguments,
P and Q (two propositions). The both ∧ and ∨ take
two propositions (logical types) as arguments and
yield a larger proposition (logical type). We then
define constructors to implement the introduction
rules for the given connective.

To build a proof of P ∧ Q, we need proofs of both
P and of Q. To build a proof of P ∨ Q it suffices
to have either a proof of P or a proof of Q.

Here are the propositional logic rules we validated
in the last section.

def or_intro_left := P >> P ∨ Q
def or_intro_right := Q >> P ∨ Q
def or_elim := P ∨ Q >> (P >> R) >> (Q >> R) >> R

We now reconceptualize these rules are rules about
how *proofs* can be built and derived.
-/

#check or

inductive or (P Q : Prop) : Prop
| inl {} (p : P) : or   -- Q is implicit
-- if I have a proof of P I can build a proof of P or Q
| inr {} (q : Q) : or   -- P is implicit
-- inl/ inr are just names of constructors (intro left/ intro right)

def pf2 : or (eq 0 0) (eq 1 0) :=
or.inl (eq.refl 0)

-- example, proof of 0=0 ∨ 1=0
example : or (eq 0 0) (eq 1 0) :=
or.inl (eq.refl 0)

#check @or.elim
-- @ turns off implicit types

example : or (eq 1 0) (eq 0 0) :=
or.inr (eq.refl 0)

/-
Prove that 1=1 and 2=2.

Q: What's the form of this proposition?
A: Conjunction. Main connective is and.

Q: What rule of reasoning apply?
A: The "and" introduction and elimination rules.

Q: What is the form of the overall proof?
A: and.intro p q, where p is a proof of P and q is a proof of Q.

Q: So what remains to be done?
A: It will now suffice to produce a proof of 1=1 and one of 2=2.

Q: How to prove 1=1?
A: By the reflexive property of equality.

Q: How to prove 2 =2.
A: Same way.
QED!
-/

-- Here it is formally

example : and (1=1) (2=2) :=
  and.intro (eq.refl 1) (eq.refl 2)

/-
The following versions of the introductions rules take two explicit
arguments each: a *proposition* for which a proof is *not* given and
a proof of the other proposition. Notice carefully the change in which
type argument is implicit in each case. Sometimes Lean can't infer
from, say, a proof, p, of P, what disjunction, P ∨ Q, is being proved
(because it can't figure out what Q is). In such cases, you need to
provide the Q type explicitly. These functions are useful in such cases.
-/
def or.intro_left {P : Prop} (Q : Prop) (p : P) : or P Q :=
or.inl p

def or.intro_right (P : Prop) {Q : Prop} (q : Q) : or P Q :=
or.inr q

/-
Prove 1=0 or 1=1.

Proof: We apply the or introduction on the right rule to a
proof of 1=1. Now all that remains is to to that 1=1. This is
by applying the reflexive property of equality (to the value,
1).
-/

-- Here is this proof formalized
example : or (1=0) (1=1) := or.inr (eq.refl 1)
example : or (1=0) (1=1) := or.intro_right (1=0) (eq.refl 1)

def x : ℕ := 1
example : ℕ := 1

/-
NEXT UP: ∀, →
-/

/-
************************************************************
Universal generalizations. Propositions starting with forall.
************************************************************
-/

/-
Introduction rule: To prove "∀ (p : P), Q" show that if you *assume*
you're given an arbitrary but specific p, you can construct a proof
of Q. This is the ∀ introduction rule of natural deduction.
-/
example : ∀ (n : ℕ), or (n = 0) (n ≠ 0) :=
  λ (n : ℕ),
    match n with
    | nat.zero := or.inl (eq.refl 0)
    | (nat.succ _) := _    -- Homework
    end

/-
Proof:
We start by assuming that we're given an arbitrary but specific
natural number, n. Now in this context, all that remains to be
proved is that n = 0 or n ≠ 0.
-/

/-
Prove that for any propositions, P and Q, P ∧ Q → P ∨ Q
-/

def aProp := ∀ (P Q : Prop), and P Q → or P Q

/-
We start by assuming that P and Q are arbitrary but specific
propositions. In this context, what remains to be proved is
the following implication: and P Q → or P Q. To prove this is
to prove an implication. We do this in the same way we prove
a ∀: by assuming that we're given a proof of the premise, P,
and showing that, in that context, we can construct a proof
of the conclusion, Q.
-/

lemma and_imp_or_1 : aProp :=
  λ (P Q : Prop),
    λ (pq : and P Q),
      or.inl (and.elim_left pq)

lemma and_imp_or_2  : aProp :=
  λ (P Q : Prop),
    λ (pq : and P Q),
      or.inr (and.elim_right pq)

example : and_imp_or_1 = and_imp_or_2 := eq.refl and_imp_or_2

example : ∀ (P Q : Prop), and P Q → and Q P :=
  λ (P Q : Prop),
    λ (pq : and P Q),
      and.intro
        (pq.right)
        (pq.left)

/-
Prove that the "and" connective is commutative.
-/

theorem and_commutes : ∀ {P Q : Prop}, and P Q → and Q P :=
λ (P Q : Prop),
  λ (pq : and P Q),
    and.intro
      (pq.right)
      (pq.left)

/-
Assume that P and Q are arbitary but specific propositions.
We are to show that P ∧ Q → Q ∧ P. Suppose we have a proof,
pq, of P ∧ Q. In this context we need to prove that we can
construct a proof of Q and P. We do this by applying the and
introduction rule to a proof of P and to a proof of Q. What
remains to be proven is that there is a proof of P and a proof
of Q. But we can get these by applying the left and right and
eliminations rules to

our proof, pq, of P ∧ Q.
-/

/-
If a proof of a ∀ or → proposition is a function in Lean,
can we apply these functions to arguments to get results?
The answer is yes, absolutely, and this idea is in fact
the *elimination* rule for ∀ and →. If you're given a
proof, pf, of either ∀ (p : P), Q, or of P → Q, which are
in fact equivalent(!), then you can apply pf to a proof or
value, p : P, to obtain a corresponding value/proof of Q.

As an example, let's apply our proof that and is commutative
-/
lemma oneeq1_and_2eq2 : and (1=1) (2=2) :=
  and.intro (eq.refl 1) (eq.refl 2)

#reduce oneeq1_and_2eq2

-- introduction rule used to build proof of bigger prop
-- elim rule is a rule for using a bigger proof to break
-- it up and give you pieces

/-
We now use the elimination rule for ∀/→ by *applying* the
*general* proof of commutative of and to a *specific* proof
of (and 1=1 2=2) to obtain a specific proof of (and 2=2 1=1)!
-/
#reduce and_commutes oneeq1_and_2eq2

/-
The *elimination* rule for ∀ all and implication is "apply!"
-/

/-
This principal is seen very clearly in the proof of the
rule of reasoning that Aristotle called "modus ponens."
It states that if, for any propositions P and Q, you know
that P → Q is true and you also know that P is true then
you can conclude that Q is true. If when it's raining the
streets are wet (P → Q) and it's raining (P) then it must
be the case that the streets are wet (Q). We now prove that
this is a valid form of reasoning.
-/

theorem arrow_elim : ∀ {P Q : Prop}, (P → Q) → P → Q :=
λ (P Q : Prop),
  λ (p2q : P → Q),
    λ (p : P),
      p2q p       ---<<< apply proof of P→Q to proof of P!

/--- TODAY ---/

/-
Propositions that use ¬
-/

/-
Suppose you want to prove ¬P. We have to show that there's no proof of P.
Key strategy: Proof by negation. Assume that P is true, and show that this
assumption leads to a contradiction. Equivalent to a proof of false. So the
idea is this: assume that there is a proof of P and show that this enables
you to construct a proof of false.

¬ P ==== P → false
-/

example : 0 ≠ 1 :=
/- the same as
 ¬ (0 = 1) -/
/- (0 = 1) → false -/
λ (h : 0 = 1),
  match h with /- NO CASES! -/ end

-- modus tollens
theorem mt : ∀ {P Q}, (P → Q) → (¬Q → ¬P) :=
λ P Q,
  λ (h : P → Q),
    λ (nq : ¬Q),
      λ (p : P),
       nq (h p)

theorem non_contradiction: ∀ (P : Prop), ¬ (P ∧ ¬ P) :=
  λ P,                        -- forall introduction
    λ (h : P ∧ ¬P),           -- proof by negation
      let p := (h.left) in    -- and.elim_left
      let np := (h.right) in  -- and.elim_right
      (np p)

theorem zornz : ∀ (n : ℕ), or (n = 0) (n ≠ 0) :=
λ (n : ℕ),
  match n with
  | nat.zero := or.inl (eq.refl 0)
  | (nat.succ n') := or.inr _         -- complete this proof
  end

/-
Propositions that use ∃
-/

example : ∃ n, n = 0 := exists.intro 0 (eq.refl 0)

example : ∃ n, n^2 = 25 := exists.intro 5 rfl -- rfl short for eq.refl 25

example : ∃ x : nat, ∃ y: nat, ∃ z : ℕ, x^2 +y^2 = z^2 :=
exists.intro 3
  (exists.intro 4
    (exists.intro 5 (rfl)))

/-
Propositions that use both ∃ and ∀
-/

/- Still to do:

def iff_intro := (P >> Q) >> (Q >> P) >> (P ↔ Q)
def iff_intro' := (P >> Q) ∧ (Q >> P) >> (P ↔ Q)
def iff_elim_left := (P ↔ Q) >> (P >> Q)
def iff_elim_right := (P ↔ Q) >> (Q >> P)
def syllogism := (P >> Q) >> (Q >> R) >> (P >> R)
def modus_tollens := (P >> Q) >> (¬ Q >> ¬ P)
def neg_elim := (¬ ¬ P) >> P         -- not a constructive rule
def excluded_middle := P ∨ (¬ P)     -- not a constructive rule
def neg_intro := (P >> pFalse) >> (¬ P)
def true_intro : pExp := pTrue
def false_elim := pFalse >> P
-/

end hidden


/-
Copyright (c) 2019 Floris van Doorn. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Floris van Doorn

! This file was ported from Lean 3 source module data.real.cardinality
! leanprover-community/mathlib commit 7e7aaccf9b0182576cabdde36cf1b5ad3585b70d
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Analysis.SpecificLimits.Basic
import Mathbin.Data.Rat.Denumerable
import Mathbin.Data.Set.Pointwise.Interval
import Mathbin.SetTheory.Cardinal.Continuum

/-!
# The cardinality of the reals

This file shows that the real numbers have cardinality continuum, i.e. `#ℝ = 𝔠`.

We show that `#ℝ ≤ 𝔠` by noting that every real number is determined by a Cauchy-sequence of the
form `ℕ → ℚ`, which has cardinality `𝔠`. To show that `#ℝ ≥ 𝔠` we define an injection from
`{0, 1} ^ ℕ` to `ℝ` with `f ↦ Σ n, f n * (1 / 3) ^ n`.

We conclude that all intervals with distinct endpoints have cardinality continuum.

## Main definitions

* `cardinal.cantor_function` is the function that sends `f` in `{0, 1} ^ ℕ` to `ℝ` by
  `f ↦ Σ' n, f n * (1 / 3) ^ n`

## Main statements

* `cardinal.mk_real : #ℝ = 𝔠`: the reals have cardinality continuum.
* `cardinal.not_countable_real`: the universal set of real numbers is not countable.
  We can use this same proof to show that all the other sets in this file are not countable.
* 8 lemmas of the form `mk_Ixy_real` for `x,y ∈ {i,o,c}` state that intervals on the reals
  have cardinality continuum.

## Notation

* `𝔠` : notation for `cardinal.continuum` in locale `cardinal`, defined in `set_theory.continuum`.

## Tags
continuum, cardinality, reals, cardinality of the reals
-/

open Nat Set

open Cardinal

noncomputable section

namespace Cardinal

variable {c : ℝ} {f g : ℕ → Bool} {n : ℕ}

/-- The body of the sum in `cantor_function`.
`cantor_function_aux c f n = c ^ n` if `f n = tt`;
`cantor_function_aux c f n = 0` if `f n = ff`. -/
def cantorFunctionAux (c : ℝ) (f : ℕ → Bool) (n : ℕ) : ℝ :=
  cond (f n) (c ^ n) 0
#align cardinal.cantor_function_aux Cardinal.cantorFunctionAux

@[simp]
theorem cantorFunctionAux_true (h : f n = true) : cantorFunctionAux c f n = c ^ n := by
  simp [cantor_function_aux, h]
#align cardinal.cantor_function_aux_tt Cardinal.cantorFunctionAux_true

@[simp]
theorem cantorFunctionAux_false (h : f n = false) : cantorFunctionAux c f n = 0 := by
  simp [cantor_function_aux, h]
#align cardinal.cantor_function_aux_ff Cardinal.cantorFunctionAux_false

theorem cantorFunctionAux_nonneg (h : 0 ≤ c) : 0 ≤ cantorFunctionAux c f n :=
  by
  cases h' : f n <;> simp [h']
  apply pow_nonneg h
#align cardinal.cantor_function_aux_nonneg Cardinal.cantorFunctionAux_nonneg

theorem cantorFunctionAux_eq (h : f n = g n) : cantorFunctionAux c f n = cantorFunctionAux c g n :=
  by simp [cantor_function_aux, h]
#align cardinal.cantor_function_aux_eq Cardinal.cantorFunctionAux_eq

theorem cantorFunctionAux_zero (f : ℕ → Bool) : cantorFunctionAux c f 0 = cond (f 0) 1 0 := by
  cases h : f 0 <;> simp [h]
#align cardinal.cantor_function_aux_zero Cardinal.cantorFunctionAux_zero

theorem cantorFunctionAux_succ (f : ℕ → Bool) :
    (fun n => cantorFunctionAux c f (n + 1)) = fun n =>
      c * cantorFunctionAux c (fun n => f (n + 1)) n :=
  by
  ext n
  cases h : f (n + 1) <;> simp [h, pow_succ]
#align cardinal.cantor_function_aux_succ Cardinal.cantorFunctionAux_succ

theorem summable_cantor_function (f : ℕ → Bool) (h1 : 0 ≤ c) (h2 : c < 1) :
    Summable (cantorFunctionAux c f) :=
  by
  apply (summable_geometric_of_lt_1 h1 h2).summable_of_eq_zero_or_self
  intro n; cases h : f n <;> simp [h]
#align cardinal.summable_cantor_function Cardinal.summable_cantor_function

/-- `cantor_function c (f : ℕ → bool)` is `Σ n, f n * c ^ n`, where `tt` is interpreted as `1` and
`ff` is interpreted as `0`. It is implemented using `cantor_function_aux`. -/
def cantorFunction (c : ℝ) (f : ℕ → Bool) : ℝ :=
  ∑' n, cantorFunctionAux c f n
#align cardinal.cantor_function Cardinal.cantorFunction

theorem cantorFunction_le (h1 : 0 ≤ c) (h2 : c < 1) (h3 : ∀ n, f n → g n) :
    cantorFunction c f ≤ cantorFunction c g :=
  by
  apply tsum_le_tsum _ (summable_cantor_function f h1 h2) (summable_cantor_function g h1 h2)
  intro n; cases h : f n; simp [h, cantor_function_aux_nonneg h1]
  replace h3 : g n = tt := h3 n h; simp [h, h3]
#align cardinal.cantor_function_le Cardinal.cantorFunction_le

theorem cantorFunction_succ (f : ℕ → Bool) (h1 : 0 ≤ c) (h2 : c < 1) :
    cantorFunction c f = cond (f 0) 1 0 + c * cantorFunction c fun n => f (n + 1) :=
  by
  rw [cantor_function, tsum_eq_zero_add (summable_cantor_function f h1 h2)]
  rw [cantor_function_aux_succ, tsum_mul_left, cantor_function_aux, pow_zero]
  rfl
#align cardinal.cantor_function_succ Cardinal.cantorFunction_succ

/-- `cantor_function c` is strictly increasing with if `0 < c < 1/2`, if we endow `ℕ → bool` with a
lexicographic order. The lexicographic order doesn't exist for these infinitary products, so we
explicitly write out what it means. -/
theorem increasing_cantorFunction (h1 : 0 < c) (h2 : c < 1 / 2) {n : ℕ} {f g : ℕ → Bool}
    (hn : ∀ k < n, f k = g k) (fn : f n = false) (gn : g n = true) :
    cantorFunction c f < cantorFunction c g :=
  by
  have h3 : c < 1 := by
    apply h2.trans
    norm_num
  induction' n with n ih generalizing f g
  · let f_max : ℕ → Bool := fun n => Nat.rec ff (fun _ _ => tt) n
    have hf_max : ∀ n, f n → f_max n := by
      intro n hn
      cases n
      rw [fn] at hn
      contradiction
      apply rfl
    let g_min : ℕ → Bool := fun n => Nat.rec tt (fun _ _ => ff) n
    have hg_min : ∀ n, g_min n → g n := by
      intro n hn
      cases n
      rw [gn]
      apply rfl
      contradiction
    apply (cantor_function_le (le_of_lt h1) h3 hf_max).trans_lt
    refine' lt_of_lt_of_le _ (cantor_function_le (le_of_lt h1) h3 hg_min)
    have : c / (1 - c) < 1 := by
      rw [div_lt_one, lt_sub_iff_add_lt]
      · convert add_lt_add h2 h2
        norm_num
      rwa [sub_pos]
    convert this
    · rw [cantor_function_succ _ (le_of_lt h1) h3, div_eq_mul_inv, ←
        tsum_geometric_of_lt_1 (le_of_lt h1) h3]
      apply zero_add
    · refine' (tsum_eq_single 0 _).trans _
      · intro n hn
        cases n
        contradiction
        rfl
      · exact cantor_function_aux_zero _
  rw [cantor_function_succ f (le_of_lt h1) h3, cantor_function_succ g (le_of_lt h1) h3]
  rw [hn 0 <| zero_lt_succ n]
  apply add_lt_add_left
  rw [mul_lt_mul_left h1]
  exact ih (fun k hk => hn _ <| Nat.succ_lt_succ hk) fn gn
#align cardinal.increasing_cantor_function Cardinal.increasing_cantorFunction

/-- `cantor_function c` is injective if `0 < c < 1/2`. -/
theorem cantorFunction_injective (h1 : 0 < c) (h2 : c < 1 / 2) :
    Function.Injective (cantorFunction c) :=
  by
  intro f g hfg
  classical
    by_contra h
    revert hfg
    have : ∃ n, f n ≠ g n := by
      rw [← not_forall]
      intro h'
      apply h
      ext
      apply h'
    let n := Nat.find this
    have hn : ∀ k : ℕ, k < n → f k = g k := by
      intro k hk
      apply of_not_not
      exact Nat.find_min this hk
    cases fn : f n
    · apply ne_of_lt
      refine' increasing_cantor_function h1 h2 hn fn _
      apply Bool.eq_true_of_not_eq_false
      rw [← fn]
      apply Ne.symm
      exact Nat.find_spec this
    · apply ne_of_gt
      refine' increasing_cantor_function h1 h2 (fun k hk => (hn k hk).symm) _ fn
      apply Bool.eq_false_of_not_eq_true
      rw [← fn]
      apply Ne.symm
      exact Nat.find_spec this
#align cardinal.cantor_function_injective Cardinal.cantorFunction_injective

/-- The cardinality of the reals, as a type. -/
theorem mk_real : (#ℝ) = 𝔠 := by
  apply le_antisymm
  · rw [real.equiv_Cauchy.cardinal_eq]
    apply mk_quotient_le.trans
    apply (mk_subtype_le _).trans_eq
    rw [← power_def, mk_nat, mk_rat, aleph_0_power_aleph_0]
  · convert mk_le_of_injective (cantor_function_injective _ _)
    rw [← power_def, mk_bool, mk_nat, two_power_aleph_0]
    exact 1 / 3
    norm_num
    norm_num
#align cardinal.mk_real Cardinal.mk_real

/-- The cardinality of the reals, as a set. -/
theorem mk_univ_real : (#(Set.univ : Set ℝ)) = 𝔠 := by rw [mk_univ, mk_real]
#align cardinal.mk_univ_real Cardinal.mk_univ_real

/-- **Non-Denumerability of the Continuum**: The reals are not countable. -/
theorem not_countable_real : ¬(Set.univ : Set ℝ).Countable :=
  by
  rw [← le_aleph_0_iff_set_countable, not_le, mk_univ_real]
  apply cantor
#align cardinal.not_countable_real Cardinal.not_countable_real

/-- The cardinality of the interval (a, ∞). -/
theorem mk_Ioi_real (a : ℝ) : (#Ioi a) = 𝔠 :=
  by
  refine' le_antisymm (mk_real ▸ mk_set_le _) _
  rw [← not_lt]
  intro h
  refine' ne_of_lt _ mk_univ_real
  have hu : Iio a ∪ {a} ∪ Ioi a = Set.univ :=
    by
    convert Iic_union_Ioi
    exact Iio_union_right
  rw [← hu]
  refine' lt_of_le_of_lt (mk_union_le _ _) _
  refine' lt_of_le_of_lt (add_le_add_right (mk_union_le _ _) _) _
  have h2 : (fun x => a + a - x) '' Ioi a = Iio a :=
    by
    convert image_const_sub_Ioi _ _
    simp
  rw [← h2]
  refine' add_lt_of_lt (cantor _).le _ h
  refine' add_lt_of_lt (cantor _).le (mk_image_le.trans_lt h) _
  rw [mk_singleton]
  exact one_lt_aleph_0.trans (cantor _)
#align cardinal.mk_Ioi_real Cardinal.mk_Ioi_real

/-- The cardinality of the interval [a, ∞). -/
theorem mk_Ici_real (a : ℝ) : (#Ici a) = 𝔠 :=
  le_antisymm (mk_real ▸ mk_set_le _) (mk_Ioi_real a ▸ mk_le_mk_of_subset Ioi_subset_Ici_self)
#align cardinal.mk_Ici_real Cardinal.mk_Ici_real

/-- The cardinality of the interval (-∞, a). -/
theorem mk_Iio_real (a : ℝ) : (#Iio a) = 𝔠 :=
  by
  refine' le_antisymm (mk_real ▸ mk_set_le _) _
  have h2 : (fun x => a + a - x) '' Iio a = Ioi a :=
    by
    convert image_const_sub_Iio _ _
    simp
  exact mk_Ioi_real a ▸ h2 ▸ mk_image_le
#align cardinal.mk_Iio_real Cardinal.mk_Iio_real

/-- The cardinality of the interval (-∞, a]. -/
theorem mk_Iic_real (a : ℝ) : (#Iic a) = 𝔠 :=
  le_antisymm (mk_real ▸ mk_set_le _) (mk_Iio_real a ▸ mk_le_mk_of_subset Iio_subset_Iic_self)
#align cardinal.mk_Iic_real Cardinal.mk_Iic_real

/-- The cardinality of the interval (a, b). -/
theorem mk_Ioo_real {a b : ℝ} (h : a < b) : (#Ioo a b) = 𝔠 :=
  by
  refine' le_antisymm (mk_real ▸ mk_set_le _) _
  have h1 : (#(fun x => x - a) '' Ioo a b) ≤ (#Ioo a b) := mk_image_le
  refine' le_trans _ h1
  rw [image_sub_const_Ioo, sub_self]
  replace h := sub_pos_of_lt h
  have h2 : (#Inv.inv '' Ioo 0 (b - a)) ≤ (#Ioo 0 (b - a)) := mk_image_le
  refine' le_trans _ h2
  rw [image_inv, inv_Ioo_0_left h, mk_Ioi_real]
#align cardinal.mk_Ioo_real Cardinal.mk_Ioo_real

/-- The cardinality of the interval [a, b). -/
theorem mk_Ico_real {a b : ℝ} (h : a < b) : (#Ico a b) = 𝔠 :=
  le_antisymm (mk_real ▸ mk_set_le _) (mk_Ioo_real h ▸ mk_le_mk_of_subset Ioo_subset_Ico_self)
#align cardinal.mk_Ico_real Cardinal.mk_Ico_real

/-- The cardinality of the interval [a, b]. -/
theorem mk_Icc_real {a b : ℝ} (h : a < b) : (#Icc a b) = 𝔠 :=
  le_antisymm (mk_real ▸ mk_set_le _) (mk_Ioo_real h ▸ mk_le_mk_of_subset Ioo_subset_Icc_self)
#align cardinal.mk_Icc_real Cardinal.mk_Icc_real

/-- The cardinality of the interval (a, b]. -/
theorem mk_Ioc_real {a b : ℝ} (h : a < b) : (#Ioc a b) = 𝔠 :=
  le_antisymm (mk_real ▸ mk_set_le _) (mk_Ioo_real h ▸ mk_le_mk_of_subset Ioo_subset_Ioc_self)
#align cardinal.mk_Ioc_real Cardinal.mk_Ioc_real

end Cardinal


import tactic
import data.set.basic
import data.real.basic
import algebra.order.floor
import algebra.order.ring
import algebra.order.field.basic

-- floor function lemmas (Joe Roberts Number Theory)

lemma floor_lemma1 {α : ℝ} : (α - 1 < (⌊α⌋ : ℝ)) ∧ ((⌊α⌋ : ℝ)  ≤ α) :=
begin
  split, {
    exact int.sub_one_lt_floor α,
  }, {
    exact int.floor_le α,
  }
end

lemma floor_lemma2 {α : ℝ} {n : ℤ} : ⌊α + (n : ℝ)⌋ = ⌊α⌋ + n  :=
begin
  exact int.floor_add_int α n,
end

lemma floor_lemma3 (m n : ℤ) (h_npos : 0 < n): (∃ r : ℝ, ((m : ℝ)  = ((⌊(m : ℝ) / (n : ℝ)⌋ * n) : ℝ)  + r ) ∧ (0 ≤ r ) ∧ (r < n)) :=
begin
 have h0 := int.floor_add_fract ((( m : ℝ)) / (n : ℝ )),
 have hfrac := int.fract_lt_one ((m : ℝ)/ (n : ℝ) ),
 have hpos := int.fract_nonneg ((m : ℝ)/ (n : ℝ) ),
 use int.fract ((( m : ℝ)) / (n : ℝ )) * (n : ℝ),
 split, {
  have h1 : ((⌊(m : ℝ)  / (n : ℝ)⌋ : ℝ)  + int.fract ((m : ℝ)  / (n : ℝ) )) * (n : ℝ) = ((m : ℝ)  / (n : ℝ)) * (n : ℝ) := congr_fun (congr_arg has_mul.mul h0) ↑n,
  rw [add_mul] at h1,
  rw div_mul at h1,
  have h_n_neq_zero : n ≠ 0 := ne_of_gt h_npos,
  have h_n_neq_zero_in_R : (n : ℝ)  ≠ 0 := int.cast_ne_zero.mpr h_n_neq_zero,
  have h2 : (n : ℝ)  / (n : ℝ)  = 1 := div_self h_n_neq_zero_in_R,
  rw h2 at h1,
  rw div_one at h1,
  linarith,
 }, {
  have h3 : (n : ℝ) > 0 := int.cast_pos.mpr h_npos,
  split, {
    exact (zero_le_mul_right h3).mpr hpos,
  }, {
    exact mul_lt_of_lt_one_left h3 hfrac,
  }
 }
end

-- lemma floor_lemma3_1 (m n : ℤ) (h_npos : 0 < n): (∃ r : ℤ, (m   = (⌊↑m   / (n : ℚ)⌋ * n)   + r ) ∧ (0 ≤ r ) ∧ (↑r  < n)) :=
-- begin
--   use (m % n) ,
--   split, {
--     have hr := nat.floor_div_eq_div
--   }, {

--   }
--   have h_n_neq_zero : n ≠ 0 := ne_of_gt h_npos,
--   have h_n_neq_zero_in_R : (n : ℝ)  ≠ 0 := int.cast_ne_zero.mpr h_n_neq_zero,
--   have h0 := int.fract_div_mul_self_add_zsmul_eq (n : ℝ) (m : ℝ)  h_n_neq_zero_in_R,
--   have hmn : ↑m / (n : ℝ)  = 1 + ((m - n) : ℝ) /(n : ℝ) := by sorry,
--   have h_int : int.fract (↑m / ↑n) * ↑n ∈ ℤ
--   sorry,
-- end

-- lemma floor_lemma4 (m n : ℤ) (h_npos : 0 < n): ((m : ℝ )  + 1)/(n : ℝ )  ≤ ⌊(m : ℝ ) /(n : ℝ )⌋ + 1 :=
-- begin

--   -- SKETCH

--   -- m/n = (k n + a) / n = k + a/n

--   -- m = ⌊m/n⌋ * n + r, 0 ≤ r < n
--   -- m/n = ⌊m/n⌋ + r/n
--   -- (m+1)/n = ⌊m/n⌋ + (r+1)/n
--   -- use that (r + 1)/n  ≤  1
--   -- ∴ (m+1)/n ≤ ⌊m/n⌋ + 1 ∎

--   have h_n_neq_zero : n ≠ 0 := ne_of_gt h_npos,
--   have h_n_neq_zero_in_R : (n : ℝ)  ≠ 0 := int.cast_ne_zero.mpr h_n_neq_zero,

--   have h0 := floor_lemma3 m n h_npos,
--   cases h0 with r h0,
--   have h1 := (div_left_inj' h_n_neq_zero_in_R).mpr h0.1,
--   rw [add_div, mul_div_assoc] at h1,
--   rw [(div_self h_n_neq_zero_in_R), mul_one] at h1,
--   have h2 : ↑m / ↑n + 1/ (n : ℝ) = ↑⌊↑m / ↑n⌋ + r / ↑n + 1/(n : ℝ) := congr_fun (congr_arg has_add.add h1) (1 / ↑n),
--   rw ← add_div at h2,
--   rw add_assoc at h2,
--   rw ← add_div at h2,
--   have h3 : (r+1)/n ≤ 1, -- true since r ∈ ℤ
--   {
--     sorry,
--   },
--   linarith,

-- end

-- lemma floor_lemma4_1 (m n : ℤ) (h_npos : 0 < n): ((m : ℝ )  + 1)/(n : ℝ )  ≤ ⌊(m : ℝ ) /(n : ℝ )⌋ + 1 :=
-- begin

--   -- SKETCH
--   -- m = ⌊m/n⌋ * n + r, 0 ≤ r < n
--   -- m/n = ⌊m/n⌋ + r/n
--   -- (m+1)/n = ⌊m/n⌋ + (r+1)/n
--   -- use that (r + 1)/n  ≤  1
--   -- ∴ (m+1)/n ≤ ⌊m/n⌋ + 1 ∎

-- end

-- lemma floor_lemma5 {n : ℤ} (h_npos : 0 < n) (α : ℝ) : ⌊(⌊α⌋ : ℝ) /(n : ℝ)⌋  = ⌊α/(n : ℝ )⌋ :=
-- begin
--   have h_npos2 : 0 < (n : ℝ) := int.cast_pos.mpr h_npos,

--   have h0 : (⌊(⌊α⌋ : ℝ) /(n : ℝ)⌋ : ℝ)  ≤  (⌊α⌋ : ℝ) /(n : ℝ ) := int.floor_le (↑⌊α⌋ / ↑n),

--   have h1 : (⌊α⌋ : ℝ)  / (n : ℝ) ≤ α / (n : ℝ) := (div_le_div_right h_npos2).mpr (int.floor_le α),

--   have h2k0 :  α - 1 < (⌊α⌋ : ℝ)  := int.sub_one_lt_floor α,
--   have h2k1 : α <  (⌊α⌋ : ℝ) + 1 := by linarith,
--   have h2 : α / (n : ℝ) <  (⌊α⌋ + 1) / (n : ℝ) := (div_lt_div_right h_npos2).mpr h2k1,
--   clear h2k0 h2k1,

--   have h3 := floor_lemma3 ⌊α⌋ n h_npos,

--   -- inequality shows floor
--   have  h4 : (⌊(⌊α⌋ : ℝ) / (n : ℝ)⌋ : ℝ ) ≤ α / (n : ℝ)  := by linarith,
--   have  h5 :  α / (n : ℝ) < (⌊(⌊α⌋ : ℝ) / (n : ℝ)⌋ : ℝ ) + 1 := by linarith,
--   exact (int.floor_eq_iff.mpr ⟨h4, h5⟩).symm,

-- end

lemma nested_ceil (m n : ℤ ) (hmpos : m > 0) (hnpos : n > 0) (x : ℝ) : ⌈x / (m * n)⌉ = ⌈(⌈x/m⌉ : ℝ) /(n : ℝ)⌉ :=
begin
  set k := ⌈x/↑m⌉,
  have h_le : ⌈x / ((m : ℝ)  * (n : ℝ)⌉  ≤ ⌈(k : ℝ) / (n : ℝ)⌉,
  {
    suffices h0 : x/(↑m * ↑n) ≤ k/↑n,
    {
      exact int.ceil_mono h0,
    },
    suffices h1 : x / ↑m ≤ ↑k,
    {
      rw ← div_div,
      have hnpos' : 0 < (n : ℝ ) := int.cast_pos.mpr hnpos,
      rwa div_le_div_right hnpos',
    },
    exact int.le_ceil (x / ↑m),

  },

  have h_ge : ⌈x / ((m : ℝ)  * (n : ℝ))⌉  ≥ ⌈(k : ℝ) / (n : ℝ)⌉,
  {
    by_contra hc, push_neg at hc,
    have h1 := int.lt.dest hc,
    cases h1 with l hl,
    rw nat.succ_eq_add_one at hl, push_cast at hl,

    have hl2 : ↑l ≥ 0 := zero_le ↑l,
    have hq1 :  ⌈x / (↑m * ↑n)⌉ ≤ ⌈x / (↑m * ↑n)⌉ + ↑l  := by linarith,
    have hq2 :  ⌈x / (↑m * ↑n)⌉ + ↑l <  ⌈(k : ℝ)  / (n : ℝ)  ⌉ := by linarith,
    set q := ⌈x / (↑m * ↑n)⌉ + ↑l,
    have hq1' : x / (↑m * ↑n) ≤ q := int.ceil_le.mp hq1,
    have hq2' : (q : ℝ)  < (k : ℝ)  / (n : ℝ)  := int.lt_ceil.mp hq2,
    have hnpos' : 0 ≤ n := le_of_lt hnpos,
    have hnpos'' : 0 ≤ (n : ℝ)  := int.cast_nonneg.mpr hnpos',
    have hq'' : (x / (↑m * ↑n)) * ↑n  ≤ q * ↑n  := mul_le_mul_of_nonneg_right hq1' hnpos'',
    rw div_mul at hq'',
    have h_n_neq_zero : n  ≠ 0 := ne_of_gt hnpos,
    have h_n_neq_zero' : ( n : ℝ )  ≠ 0 := int.cast_ne_zero.mpr h_n_neq_zero,
    rw ← mul_div at hq'',
    rw div_self h_n_neq_zero' at hq'',
    rw mul_one at hq'',
    have hqn : (q : ℝ) * (n : ℝ) = ↑(q * n) := (int.cast_mul q n).symm,
    have hk : ⌈(x / ↑m)⌉ ≤ (q * n),
    {
      refine int.ceil_le.mpr _,
      rw hqn at hq'',
      exact hq'',
    },

    have hq2'' := mul_lt_mul_of_pos_right hq2' (int.cast_pos.mpr hnpos),
    rw div_mul at hq2'',
    rw div_self h_n_neq_zero' at hq2'',
    rw div_one at hq2'',
    rw hqn at hq2'',
    have hk' : (⌈x / ↑m⌉ : ℝ)  ≤ ↑(q * n) := int.cast_le.mpr hk,
    linarith,
  },
  exact le_antisymm h_le h_ge,

end

-- define beatty sequence

def B : ℝ → set ℕ := λ r, { n | ∃ m : ℕ , ((n : ℕ) = nat.floor ((m : ℝ)  * r) ) }

lemma mem_b_iff {q : ℝ} {k : ℕ}  : (k ∈ (B q)) ↔ ∃ m : ℕ, (k : ℕ)  = nat.floor ((m : ℝ) * q ) :=
begin
  split,
  intro hk,
  rw set.mem_def at hk,
  assumption,
  intro h,
  rw set.mem_def,
  assumption,
end

lemma floor_lemma {q : ℝ} {j n : ℕ} (hq : 1 < q ) (hj : j = nat.floor (↑n * q)) : ((j : ℝ) ≤ ↑n * q)  ∧ ↑n * q < (j : ℝ) + 1 :=
begin
  have hn : 0 ≤ n  := zero_le n,
  have hn2 : 0 ≤ (n : ℝ) := nat.cast_nonneg n,
  have hq2 : 0 ≤ q := by linarith,
  have hnq : 0 ≤ ↑n * q := mul_nonneg hn2 hq2,
  exact (nat.floor_eq_iff hnq).mp (eq.symm hj),
end

-- Forward direction:
-- complementary beatty sequences partition ℕ

theorem beatty_theorem_forward ( q : ℝ ) (hq : irrational q) (h_q_gt_one : q > 1) : ∀ n : ℕ,  (((n ∈ (B q)) ∨ (n ∈ B ( q/(q-1))))) ∧ (((B q) ∩ (B (q/(q-1)))) = ∅)
:=
begin
  set p := (q/(q-1)),
  intro n,
  split, {
  -- by contradiction,
  --by_contra h, push_neg at h, rw mem_b_iff at *, push_neg at h,
  sorry,

  }, {
  -- by contradiction, "collision"
  by_contra h, change B q ∩ B p ≠ ∅ at h,
  have hs : set.nonempty (B q ∩ B p) := set.ne_empty_iff_nonempty.mp h,
  rw set.nonempty_def at hs,
  rcases hs with ⟨x, hxq, hxp⟩,
  rw mem_b_iff at *,
  cases hxq with m hm,
  cases hxp with l hl,

  have h_p_gt_one : p > 1 := by sorry,

  have hpq : p + q = 1 := by sorry,

  have hm2 := floor_lemma h_q_gt_one hm,
  have hl2 := floor_lemma h_p_gt_one hl,
  sorry,
  -- have h0: ↑x / p ≤ m := by library_search,

  }
end

-- Converse direction
-- if two beatty sequence B p, B q partition ℕ, then 1/p + 1/ q = 1