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

import solutions.sheet02

/-! Real vector spaces

This file defines the concept of a real vector space (as is discussed in the first lecture of Linear Algebra II
and proves that ℝ² and Mat₂ are instances of it.)

One further ingredient could be useful:

calc expr_1 = expr_2 : begin sorry end
       ...  = expr_3 : begin sorry end
       ...  = expr_4 : begin sorry end

Fun fact: If you only work with calc, you don't have to switch to tactic mode, i.e. you can leave out the
begin ... end

rw : rewrite one expression by another using a lemma.

apply : Apply a statement to reduce the goal. In ordinary mathematics you would read this as. By this theorem,
        it suffices to prove the following ...

exact : The goal that is to show is exactly the following lemma/theorem.

nth_rewrite i _ : If you use rw, it will change the every occurrence of the term. Sometimes you only want to
                  do that on a certain occurrence, that you can use nth_rewrite i to change it on the ith
                  occurrence (starting counting with 0).

conv_lhs begin ... end
conv_rhs begin ... end : Solve a similar problem to the one before, they allow you to only rewrite the left or
                         the right hand side of an equation.

norm_num : Similar to ring, but only calculates explicit expressions (with actual numbers.)
-/

/-- `real_vector_space V` is the type of real vector space structures on the type `V`. -/
class real_vector_space (V : Type)
  extends has_zero V, has_add V, has_neg V, has_scalar ℝ V : Type :=
(add_assoc : ∀ u v w : V, (u + v) + w = u + (v + w))
(add_comm : ∀ u v : V, u + v = v + u)
(add_zero : ∀ v : V, v + 0 = v)
(zero_add : ∀ v : V, 0 + v = v)
(add_neg : ∀ v : V, v + (-v) = 0)
(neg_add : ∀ v : V, (-v) + v = 0)
(smul_assoc : ∀ (a b : ℝ) (v : V), (a * b) • v = a • (b • v))
(one_smul : ∀ v : V, (1 : ℝ) • v = v)
(add_smul : ∀ (a b : ℝ) (v : V), (a + b) • v = a • v + b • v)
(smul_add : ∀ (a : ℝ) (v w : V), a • (v + w) = a • v + a • w)

namespace real_vector_space

/- We can also add the simp attribute to statements later. -/
attribute [simp] add_assoc add_zero zero_add add_neg neg_add smul_assoc one_smul add_smul smul_add

variables {V : Type} [real_vector_space V] {u v w : V} {a b : ℝ}

/-
Let's first let Lean know that the plane and the 2x2-matrices are real vector spaces. We have proved
everything on the previous two sheets, we just have to package it nicely.
-/

instance : real_vector_space ℝ² :=
{ zero := has_zero.zero,
  add := has_add.add,
  neg := has_neg.neg,
  smul := has_scalar.smul,
  add_assoc := plane.add_assoc,
  add_comm := plane.add_comm,
  add_zero := plane.add_zero,
  zero_add := plane.zero_add,
  add_neg := by tidy,
  neg_add := by tidy,
  smul_assoc := plane.smul_assoc,
  one_smul := plane.one_smul,
  add_smul := plane.add_smul,
  smul_add := plane.smul_add, }

instance : real_vector_space Mat₂ :=
{ zero := has_zero.zero,
  add := has_add.add,
  neg := has_neg.neg,
  smul := has_scalar.smul,
  add_assoc := two_matrix.add_assoc,
  add_comm := two_matrix.add_comm,
  add_zero := two_matrix.add_zero,
  zero_add := two_matrix.zero_add,
  add_neg := by tidy,
  neg_add := by tidy,
  smul_assoc := two_matrix.smul_assoc,
  one_smul := two_matrix.one_smul,
  add_smul := two_matrix.add_smul,
  smul_add := two_matrix.smul_add, }

/-
We continue by proving some well-known properties which hold in (real) vector spaces.
-/

lemma zero_unique_right_neutral (h : v + w = v)  :  w = 0 :=
calc w = 0 + w : (zero_add w).symm
  ...  = (-v + v) + w : by rw neg_add
  ...  = -v + (v + w) : by rw add_assoc
  ...  = -v + v : by rw h
  ...  = 0 : neg_add v

lemma zero_unique_left_neutral (h : w + v = v) : w = 0 :=
begin
  rw add_comm at h,
  exact zero_unique_right_neutral h,
end

lemma zero_smul_eq_zero_vector (v : V) : (0 : ℝ) • v = 0 :=
begin
  apply zero_unique_right_neutral,
  calc (0 : ℝ) • v + (0 : ℝ) • v  = (0 + 0 : ℝ) • v : (add_smul _ _ _).symm
    ...                           = (0 : ℝ) • v : by norm_num
end

lemma neg_unique_right_add_inv (h : v + w = 0) :  w = -v :=
calc w = 0 + w : (zero_add w).symm
      ...  = (-v + v) + w : by rw neg_add
      ...  = -v + (v + w) : by rw add_assoc
      ...  = -v + 0 : by rw h
      ...  = -v : add_zero (-v)

lemma neg_unique_left_add_inv (h : w + v = 0) : w = -v :=
begin
  rw add_comm at h,
  exact neg_unique_right_add_inv h,
end

lemma minus_one_smul_eq_neg : (-1 : ℝ) • v = -v :=
begin
  apply neg_unique_right_add_inv,
  nth_rewrite 0 (one_smul v).symm,
  rw ← add_smul,
  norm_num,
  rw zero_smul_eq_zero_vector
end

end real_vector_space

/- It has been realised that the vector space axioms are not minimal, you can remove some of them and still
  get the same structure. Here is a minimal list that has been found (which is quite similar to the standard
  list, only the second axiom seems kind of weird.)-/
class minimal_vector_space_axioms (V : Type)
  extends has_add V, has_scalar ℝ V : Type :=
(add_assoc : ∀ u v w : V, (u + v) + w = u + (v + w))
(zero_smul_eq : ∀ v w : V, (0 : ℝ) • v = (0 : ℝ) • w)
(one_smul : ∀ v : V, (1 : ℝ) • v = v)
(smul_assoc : ∀ (a b : ℝ) (v : V), (a * b) • v = a • (b • v))
(add_smul : ∀ (a b : ℝ) (v : V), (a + b) • v = a • v + b • v)
(smul_add : ∀ (a : ℝ) (v w : V), a • (v + w) = a • v + a • w)

/- Note that in contrast to the vector space axioms, the axiom about the zero vector is omitted from these
  minimal vector space axioms. However this means that there is no reason for any vector at all to exist
  in `V`. So let's prove that the empty set satisfies these axioms. -/
instance : minimal_vector_space_axioms empty :=
{ add := begin intro v, cases v end,
  smul := begin intros a v, cases v end,
  add_assoc := begin intros u v w, cases u end,
  zero_smul_eq := begin intros u v, cases u end,
  one_smul := begin intro v, cases v end,
  smul_assoc := begin intros a b v, cases v end,
  add_smul := begin intros a b v, cases v end,
  smul_add := begin intros a v w, cases v end, }

/- Let's prove that any real_vector_space satisfies the minimal vector space axioms, which is not too difficult, '
  there is only one axiom which is already included in the axioms and that is immediately true. -/
def to_minimal_vector_space_axioms (V : Type) [real_vector_space V] : minimal_vector_space_axioms V :=
{ add_assoc := real_vector_space.add_assoc,
  zero_smul_eq := begin intros v w, rw [real_vector_space.zero_smul_eq_zero_vector, real_vector_space.zero_smul_eq_zero_vector] end,
  one_smul := real_vector_space.one_smul,
  smul_assoc := real_vector_space.smul_assoc,
  add_smul := real_vector_space.add_smul,
  smul_add := real_vector_space.smul_add }

/- In the other direction, the difference seems larger, so let's try to prove some of the axioms which are missing. -/

lemma minimal_vector_space_axioms.add_zero (V : Type) [minimal_vector_space_axioms V] (v w : V) : v + (0 : ℝ) • w = v :=
begin
  conv_lhs begin rw ←minimal_vector_space_axioms.one_smul v end,
  rw [minimal_vector_space_axioms.zero_smul_eq w v, ← minimal_vector_space_axioms.add_smul,
      add_zero, minimal_vector_space_axioms.one_smul],
end

lemma minimal_vector_space_axioms.zero_add (V : Type) [minimal_vector_space_axioms V] (v w : V) : (0 : ℝ) • w + v = v :=
begin
  conv_lhs begin rw ←minimal_vector_space_axioms.one_smul v end,
  rw [minimal_vector_space_axioms.zero_smul_eq w v, ← minimal_vector_space_axioms.add_smul,
      zero_add, minimal_vector_space_axioms.one_smul],
end

lemma minimal_vector_space_axioms.add_neg (V : Type) [minimal_vector_space_axioms V] (v : V) : v + (-1 : ℝ) • v = (0 : ℝ) • v :=
begin
  nth_rewrite 0 ← minimal_vector_space_axioms.one_smul v,
  rw [← minimal_vector_space_axioms.add_smul, add_right_neg],
end

lemma minimal_vector_space_axioms.neg_add (V : Type) [minimal_vector_space_axioms V] (v : V) : (-1 : ℝ) • v + v = (0 : ℝ) • v :=
begin
  nth_rewrite 1 ← minimal_vector_space_axioms.one_smul v,
  rw [← minimal_vector_space_axioms.add_smul, add_left_neg],
end

/- The following is probably the most challenging one. Consider trying to prove it on paper first. -/
lemma minimal_vector_space_axioms.add_comm (V : Type) [minimal_vector_space_axioms V] (v w : V) : v + w = w + v :=
calc v + w = (0 : ℝ) • v + (v + w) : by rw minimal_vector_space_axioms.zero_add _ _ _
       ... = ((-1 : ℝ) • v + v) + (v + w) : by rw minimal_vector_space_axioms.neg_add
       ... = (((-1 : ℝ) • v + v) + (v + w)) + (0 : ℝ) • w : by rw minimal_vector_space_axioms.add_zero _ _ _
       ... = (((-1 : ℝ) • v + v) + (v + w)) + (w + (-1 : ℝ) • w) : by rw minimal_vector_space_axioms.add_neg
       ... = ((-1 : ℝ) • v + ((v + v) + (w + w))) + (-1 : ℝ) • w : begin simp [minimal_vector_space_axioms.add_assoc], end
       ... = (-1 : ℝ) • v + (((1 + 1 : ℝ)• v) + ((1 + 1 : ℝ) • w)) + (-1 : ℝ) • w : begin simp [minimal_vector_space_axioms.add_smul, minimal_vector_space_axioms.one_smul] end
       ... = ((-1 : ℝ) • v + ((1 + 1 : ℝ) • (v + w))) + (-1 : ℝ) • w : by rw minimal_vector_space_axioms.smul_add
       ... = ((-1 : ℝ) • v + ((v + w) + (v + w))) + (-1 : ℝ) • w : by rw [minimal_vector_space_axioms.add_smul, minimal_vector_space_axioms.one_smul]
       ... = ((-1 : ℝ) • v + v) + (w + v) + (w + (-1 : ℝ) • w) : by simp [minimal_vector_space_axioms.add_assoc]
       ... = w + v : begin rw [minimal_vector_space_axioms.neg_add, minimal_vector_space_axioms.add_neg, minimal_vector_space_axioms.zero_add, minimal_vector_space_axioms.add_zero] end

/- However if we demand that the set V is nonempty, the axioms are in fact equivalent as we show with the
  following two results. These are `definitions` as they transport data. Often in a maths lecture we would
  instead say `proposition` for this, or if one is very careful `definition-proposition`. The definition is
  marked as `noncomputable` as it relies on choosing an arbitrary element `v` from the nonempty type `V`,
  for which there might not be an algorithm. -/
noncomputable def to_real_vector_space (V : Type) [minimal_vector_space_axioms V] (h : nonempty V) : real_vector_space V :=
{ zero := begin let v := h.some, exact ((0 : ℝ) • v) end,
  neg := begin intro v, exact ((-1 : ℝ) • v) end,
  add_assoc := minimal_vector_space_axioms.add_assoc,
  add_comm := begin intros u v, exact minimal_vector_space_axioms.add_comm _ _ _, end,
  add_zero := begin intro v, change v + (0 : ℝ) • h.some = v, exact minimal_vector_space_axioms.add_zero _ _ _, end,
  zero_add := begin intro v, change (0 : ℝ) • h.some + v = v, exact minimal_vector_space_axioms.zero_add _ _ _, end,
  add_neg := begin intro v, change v + (-1 : ℝ) • v = (0 : ℝ) • h.some, rw minimal_vector_space_axioms.add_neg, exact minimal_vector_space_axioms.zero_smul_eq _ _ end,
  neg_add := begin intro v, change (-1 : ℝ) • v + v = (0 : ℝ) • h.some, rw minimal_vector_space_axioms.neg_add, exact minimal_vector_space_axioms.zero_smul_eq _ _ end,
  smul_assoc := minimal_vector_space_axioms.smul_assoc,
  one_smul := minimal_vector_space_axioms.one_smul,
  add_smul := minimal_vector_space_axioms.add_smul,
  smul_add := minimal_vector_space_axioms.smul_add }


/-
Copyright (c) 2018 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Jens Wagemaker, Aaron Anderson
-/
import ring_theory.coprime.basic
import ring_theory.principal_ideal_domain

/-!
# Divisibility over ℕ and ℤ

This file collects results for the integers and natural numbers that use abstract algebra in
their proofs or cases of ℕ and ℤ being examples of structures in abstract algebra.

## Main statements

* `nat.factors_eq`: the multiset of elements of `nat.factors` is equal to the factors
   given by the `unique_factorization_monoid` instance
* ℤ is a `normalization_monoid`
* ℤ is a `gcd_monoid`

## Tags

prime, irreducible, natural numbers, integers, normalization monoid, gcd monoid,
greatest common divisor, prime factorization, prime factors, unique factorization,
unique factors
-/

namespace nat

instance : wf_dvd_monoid ℕ :=
⟨begin
  refine rel_hom_class.well_founded
    (⟨λ (x : ℕ), if x = 0 then (⊤ : with_top ℕ) else x, _⟩ : dvd_not_unit →r (<))
    (with_top.well_founded_lt nat.lt_wf),
  intros a b h,
  cases a,
  { exfalso, revert h, simp [dvd_not_unit] },
  cases b,
  { simpa [succ_ne_zero] using with_top.coe_lt_top (a + 1) },
  cases dvd_and_not_dvd_iff.2 h with h1 h2,
  simp only [succ_ne_zero, with_top.coe_lt_coe, if_false],
  apply lt_of_le_of_ne (nat.le_of_dvd (nat.succ_pos _) h1) (λ con, h2 _),
  rw con,
end⟩

instance : unique_factorization_monoid ℕ :=
⟨λ _, nat.irreducible_iff_prime⟩

end nat

/-- `ℕ` is a gcd_monoid. -/
instance : gcd_monoid ℕ :=
{ gcd := nat.gcd,
  lcm := nat.lcm,
  gcd_dvd_left := nat.gcd_dvd_left ,
  gcd_dvd_right := nat.gcd_dvd_right,
  dvd_gcd := λ a b c, nat.dvd_gcd,
  gcd_mul_lcm := λ a b, by rw [nat.gcd_mul_lcm],
  lcm_zero_left := nat.lcm_zero_left,
  lcm_zero_right := nat.lcm_zero_right }

instance : normalized_gcd_monoid ℕ :=
{ normalize_gcd := λ a b, normalize_eq _,
  normalize_lcm := λ a b, normalize_eq _,
  .. (infer_instance : gcd_monoid ℕ),
  .. (infer_instance : normalization_monoid ℕ) }

lemma gcd_eq_nat_gcd (m n : ℕ) : gcd m n = nat.gcd m n := rfl

lemma lcm_eq_nat_lcm (m n : ℕ) : lcm m n = nat.lcm m n := rfl

namespace int

section normalization_monoid

instance : normalization_monoid ℤ :=
{ norm_unit      := λa:ℤ, if 0 ≤ a then 1 else -1,
  norm_unit_zero := if_pos le_rfl,
  norm_unit_mul  := assume a b hna hnb,
  begin
    cases hna.lt_or_lt with ha ha; cases hnb.lt_or_lt with hb hb;
      simp [mul_nonneg_iff, ha.le, ha.not_le, hb.le, hb.not_le]
  end,
  norm_unit_coe_units := assume u, (units_eq_one_or u).elim
    (assume eq, eq.symm ▸ if_pos zero_le_one)
    (assume eq, eq.symm ▸ if_neg (not_le_of_gt $ show (-1:ℤ) < 0, by dec_trivial)), }

lemma normalize_of_nonneg {z : ℤ} (h : 0 ≤ z) : normalize z = z :=
show z * ↑(ite _ _ _) = z, by rw [if_pos h, units.coe_one, mul_one]

lemma normalize_of_neg {z : ℤ} (h : z < 0) : normalize z = -z :=
show z * ↑(ite _ _ _) = -z,
by rw [if_neg (not_le_of_gt h), units.coe_neg, units.coe_one, mul_neg_one]

lemma normalize_coe_nat (n : ℕ) : normalize (n : ℤ) = n :=
normalize_of_nonneg (coe_nat_le_coe_nat_of_le $ nat.zero_le n)

theorem coe_nat_abs_eq_normalize (z : ℤ) : (z.nat_abs : ℤ) = normalize z :=
begin
  by_cases 0 ≤ z,
  { simp [nat_abs_of_nonneg h, normalize_of_nonneg h] },
  { simp [of_nat_nat_abs_of_nonpos (le_of_not_ge h), normalize_of_neg (lt_of_not_ge h)] }
end

lemma nonneg_of_normalize_eq_self {z : ℤ} (hz : normalize z = z) : 0 ≤ z :=
calc 0 ≤ (z.nat_abs : ℤ) : coe_zero_le _
... = normalize z : coe_nat_abs_eq_normalize _
... = z : hz

lemma nonneg_iff_normalize_eq_self (z : ℤ) : normalize z = z ↔ 0 ≤ z :=
⟨nonneg_of_normalize_eq_self, normalize_of_nonneg⟩

lemma eq_of_associated_of_nonneg {a b : ℤ} (h : associated a b) (ha : 0 ≤ a) (hb : 0 ≤ b) : a = b :=
dvd_antisymm_of_normalize_eq (normalize_of_nonneg ha) (normalize_of_nonneg hb) h.dvd h.symm.dvd

end normalization_monoid

section gcd_monoid

instance : gcd_monoid ℤ :=
{ gcd            := λa b, int.gcd a b,
  lcm            := λa b, int.lcm a b,
  gcd_dvd_left   := assume a b, int.gcd_dvd_left _ _,
  gcd_dvd_right  := assume a b, int.gcd_dvd_right _ _,
  dvd_gcd        := assume a b c, dvd_gcd,
  gcd_mul_lcm    := λ a b, by
  { rw [← int.coe_nat_mul, gcd_mul_lcm, coe_nat_abs_eq_normalize],
    exact normalize_associated (a * b) },
  lcm_zero_left  := assume a, coe_nat_eq_zero.2 $ nat.lcm_zero_left _,
  lcm_zero_right := assume a, coe_nat_eq_zero.2 $ nat.lcm_zero_right _}

instance : normalized_gcd_monoid ℤ :=
{ normalize_gcd  := λ a b, normalize_coe_nat _,
  normalize_lcm  := λ a b, normalize_coe_nat _,
  .. int.normalization_monoid,
  .. (infer_instance : gcd_monoid ℤ) }

lemma coe_gcd (i j : ℤ) : ↑(int.gcd i j) = gcd_monoid.gcd i j := rfl
lemma coe_lcm (i j : ℤ) : ↑(int.lcm i j) = gcd_monoid.lcm i j := rfl

lemma nat_abs_gcd (i j : ℤ) : nat_abs (gcd_monoid.gcd i j) = int.gcd i j := rfl
lemma nat_abs_lcm (i j : ℤ) : nat_abs (gcd_monoid.lcm i j) = int.lcm i j := rfl

end gcd_monoid

lemma exists_unit_of_abs (a : ℤ) : ∃ (u : ℤ) (h : is_unit u), (int.nat_abs a : ℤ) = u * a :=
begin
  cases (nat_abs_eq a) with h,
  { use [1, is_unit_one], rw [← h, one_mul], },
  { use [-1, is_unit_one.neg], rw [ ← neg_eq_iff_neg_eq.mp (eq.symm h)],
    simp only [neg_mul, one_mul] }
end

lemma gcd_eq_nat_abs {a b : ℤ} : int.gcd a b = nat.gcd a.nat_abs b.nat_abs := rfl

lemma gcd_eq_one_iff_coprime {a b : ℤ} : int.gcd a b = 1 ↔ is_coprime a b :=
begin
  split,
  { intro hg,
    obtain ⟨ua, hua, ha⟩ := exists_unit_of_abs a,
    obtain ⟨ub, hub, hb⟩ := exists_unit_of_abs b,
    use [(nat.gcd_a (int.nat_abs a) (int.nat_abs b)) * ua,
        (nat.gcd_b (int.nat_abs a) (int.nat_abs b)) * ub],
    rw [mul_assoc, ← ha, mul_assoc, ← hb, mul_comm, mul_comm _ (int.nat_abs b : ℤ),
      ← nat.gcd_eq_gcd_ab, ←gcd_eq_nat_abs, hg, int.coe_nat_one] },
  { rintro ⟨r, s, h⟩,
    by_contradiction hg,
    obtain ⟨p, ⟨hp, ha, hb⟩⟩ := nat.prime.not_coprime_iff_dvd.mp hg,
    apply nat.prime.not_dvd_one hp,
    rw [←coe_nat_dvd, int.coe_nat_one, ← h],
    exact dvd_add ((coe_nat_dvd_left.mpr ha).mul_left _)
      ((coe_nat_dvd_left.mpr hb).mul_left _) }
end

lemma coprime_iff_nat_coprime {a b : ℤ} : is_coprime a b ↔ nat.coprime a.nat_abs b.nat_abs :=
by rw [←gcd_eq_one_iff_coprime, nat.coprime_iff_gcd_eq_one, gcd_eq_nat_abs]

lemma sq_of_gcd_eq_one {a b c : ℤ} (h : int.gcd a b = 1) (heq : a * b = c ^ 2) :
  ∃ (a0 : ℤ), a = a0 ^ 2 ∨ a = - (a0 ^ 2) :=
begin
  have h' : is_unit (gcd_monoid.gcd a b), { rw [← coe_gcd, h, int.coe_nat_one], exact is_unit_one },
  obtain ⟨d, ⟨u, hu⟩⟩ := exists_associated_pow_of_mul_eq_pow h' heq,
  use d,
  rw ← hu,
  cases int.units_eq_one_or u with hu' hu'; { rw hu', simp }
end

lemma sq_of_coprime {a b c : ℤ} (h : is_coprime a b) (heq : a * b = c ^ 2) :
  ∃ (a0 : ℤ), a = a0 ^ 2 ∨ a = - (a0 ^ 2) := sq_of_gcd_eq_one (gcd_eq_one_iff_coprime.mpr h) heq

lemma nat_abs_euclidean_domain_gcd (a b : ℤ) :
  int.nat_abs (euclidean_domain.gcd a b) = int.gcd a b :=
begin
  apply nat.dvd_antisymm; rw ← int.coe_nat_dvd,
  { rw int.nat_abs_dvd,
    exact int.dvd_gcd (euclidean_domain.gcd_dvd_left _ _) (euclidean_domain.gcd_dvd_right _ _) },
  { rw int.dvd_nat_abs,
    exact euclidean_domain.dvd_gcd (int.gcd_dvd_left _ _) (int.gcd_dvd_right _ _) }
end

end int

/-- Maps an associate class of integers consisting of `-n, n` to `n : ℕ` -/
def associates_int_equiv_nat : associates ℤ ≃ ℕ :=
begin
  refine ⟨λz, z.out.nat_abs, λn, associates.mk n, _, _⟩,
  { refine (assume a, quotient.induction_on' a $ assume a,
      associates.mk_eq_mk_iff_associated.2 $ associated.symm $ ⟨norm_unit a, _⟩),
    show normalize a = int.nat_abs (normalize a),
    rw [int.coe_nat_abs_eq_normalize, normalize_idem] },
  { intro n,
    dsimp,
    rw [←normalize_apply, ← int.coe_nat_abs_eq_normalize, int.nat_abs_of_nat, int.nat_abs_of_nat] }
end

lemma int.prime.dvd_mul {m n : ℤ} {p : ℕ}
  (hp : nat.prime p) (h : (p : ℤ) ∣ m * n) : p ∣ m.nat_abs ∨ p ∣ n.nat_abs :=
begin
  apply (nat.prime.dvd_mul hp).mp,
  rw ← int.nat_abs_mul,
  exact int.coe_nat_dvd_left.mp h
end

lemma int.prime.dvd_mul' {m n : ℤ} {p : ℕ}
  (hp : nat.prime p) (h : (p : ℤ) ∣ m * n) : (p : ℤ) ∣ m ∨ (p : ℤ) ∣ n :=
begin
  rw [int.coe_nat_dvd_left, int.coe_nat_dvd_left],
  exact int.prime.dvd_mul hp h
end

lemma int.prime.dvd_pow {n : ℤ} {k p : ℕ}
  (hp : nat.prime p) (h : (p : ℤ) ∣ n ^ k) : p  ∣ n.nat_abs :=
begin
  apply @nat.prime.dvd_of_dvd_pow _ _ k hp,
  rw ← int.nat_abs_pow,
  exact int.coe_nat_dvd_left.mp h
end

lemma int.prime.dvd_pow' {n : ℤ} {k p : ℕ}
  (hp : nat.prime p) (h : (p : ℤ) ∣ n ^ k) : (p : ℤ)  ∣ n :=
begin
  rw int.coe_nat_dvd_left,
  exact int.prime.dvd_pow hp h
end

lemma prime_two_or_dvd_of_dvd_two_mul_pow_self_two {m : ℤ} {p : ℕ}
  (hp : nat.prime p) (h : (p : ℤ) ∣ 2 * m ^ 2) : p = 2 ∨ p ∣ int.nat_abs m :=
begin
  cases int.prime.dvd_mul hp h with hp2 hpp,
  { apply or.intro_left,
    exact le_antisymm (nat.le_of_dvd zero_lt_two hp2) (nat.prime.two_le hp) },
  { apply or.intro_right,
    rw [sq, int.nat_abs_mul] at hpp,
    exact (or_self _).mp ((nat.prime.dvd_mul hp).mp hpp)}
end

lemma int.exists_prime_and_dvd {n : ℤ} (hn : n.nat_abs ≠ 1) : ∃ p, prime p ∧ p ∣ n :=
begin
  obtain ⟨p, pp, pd⟩ := nat.exists_prime_and_dvd hn,
  exact ⟨p, nat.prime_iff_prime_int.mp pp, int.coe_nat_dvd_left.mpr pd⟩,
end

open unique_factorization_monoid

theorem nat.factors_eq {n : ℕ} : normalized_factors n = n.factors :=
begin
  cases n, { simp },
  rw [← multiset.rel_eq, ← associated_eq_eq],
  apply factors_unique (irreducible_of_normalized_factor) _,
  { rw [multiset.coe_prod, nat.prod_factors n.succ_ne_zero],
    apply normalized_factors_prod (nat.succ_ne_zero _) },
  { apply_instance },
  { intros x hx,
    rw [nat.irreducible_iff_prime, ← nat.prime_iff],
    exact nat.prime_of_mem_factors hx }
end

lemma nat.factors_multiset_prod_of_irreducible
  {s : multiset ℕ} (h : ∀ (x : ℕ), x ∈ s → irreducible x) :
  normalized_factors (s.prod) = s :=
begin
  rw [← multiset.rel_eq, ← associated_eq_eq],
  apply unique_factorization_monoid.factors_unique irreducible_of_normalized_factor h
    (normalized_factors_prod _),
  rw [ne.def, multiset.prod_eq_zero_iff],
  intro con,
  exact not_irreducible_zero (h 0 con),
end

namespace multiplicity

lemma finite_int_iff_nat_abs_finite {a b : ℤ} : finite a b ↔ finite a.nat_abs b.nat_abs :=
by simp only [finite_def, ← int.nat_abs_dvd_iff_dvd, int.nat_abs_pow]

lemma finite_int_iff {a b : ℤ} : finite a b ↔ (a.nat_abs ≠ 1 ∧ b ≠ 0) :=
by rw [finite_int_iff_nat_abs_finite, finite_nat_iff, pos_iff_ne_zero, int.nat_abs_ne_zero]

instance decidable_nat : decidable_rel (λ a b : ℕ, (multiplicity a b).dom) :=
λ a b, decidable_of_iff _ finite_nat_iff.symm

instance decidable_int : decidable_rel (λ a b : ℤ, (multiplicity a b).dom) :=
λ a b, decidable_of_iff _ finite_int_iff.symm

end multiplicity

lemma induction_on_primes {P : ℕ → Prop} (h₀ : P 0) (h₁ : P 1)
  (h : ∀ p a : ℕ, p.prime → P a → P (p * a)) (n : ℕ) : P n :=
begin
  apply unique_factorization_monoid.induction_on_prime,
  exact h₀,
  { intros n h,
    rw nat.is_unit_iff.1 h,
    exact h₁, },
  { intros a p _ hp ha,
    exact h p a (nat.prime_iff.2 hp) ha, },
end

lemma int.associated_nat_abs (k : ℤ) : associated k k.nat_abs :=
associated_of_dvd_dvd (int.coe_nat_dvd_right.mpr dvd_rfl) (int.nat_abs_dvd.mpr dvd_rfl)

lemma int.prime_iff_nat_abs_prime {k : ℤ} : prime k ↔ nat.prime k.nat_abs :=
(int.associated_nat_abs k).prime_iff.trans nat.prime_iff_prime_int.symm

theorem int.associated_iff_nat_abs {a b : ℤ} : associated a b ↔ a.nat_abs = b.nat_abs :=
begin
  rw [←dvd_dvd_iff_associated, ←int.nat_abs_dvd_iff_dvd,
      ←int.nat_abs_dvd_iff_dvd, dvd_dvd_iff_associated],
  exact associated_iff_eq,
end

lemma int.associated_iff {a b : ℤ} : associated a b ↔ (a = b ∨ a = -b) :=
begin
  rw int.associated_iff_nat_abs,
  exact int.nat_abs_eq_nat_abs_iff,
end

namespace int

lemma zmultiples_nat_abs (a : ℤ) :
  add_subgroup.zmultiples (a.nat_abs : ℤ) = add_subgroup.zmultiples a :=
le_antisymm
  (add_subgroup.zmultiples_subset (mem_zmultiples_iff.mpr (dvd_nat_abs.mpr (dvd_refl a))))
  (add_subgroup.zmultiples_subset (mem_zmultiples_iff.mpr (nat_abs_dvd.mpr (dvd_refl a))))

lemma span_nat_abs (a : ℤ) : ideal.span ({a.nat_abs} : set ℤ) = ideal.span {a} :=
by { rw ideal.span_singleton_eq_span_singleton, exact (associated_nat_abs _).symm }

theorem eq_pow_of_mul_eq_pow_bit1_left {a b c : ℤ}
  (hab : is_coprime a b) {k : ℕ} (h : a * b = c ^ (bit1 k)) : ∃ d, a = d ^ (bit1 k) :=
begin
  obtain ⟨d, hd⟩ := exists_associated_pow_of_mul_eq_pow' hab h,
  replace hd := hd.symm,
  rw [associated_iff_nat_abs, nat_abs_eq_nat_abs_iff, ←neg_pow_bit1] at hd,
  obtain rfl|rfl := hd; exact ⟨_, rfl⟩,
end

theorem eq_pow_of_mul_eq_pow_bit1_right {a b c : ℤ}
  (hab : is_coprime a b) {k : ℕ} (h : a * b = c ^ (bit1 k)) : ∃ d, b = d ^ (bit1 k) :=
eq_pow_of_mul_eq_pow_bit1_left hab.symm (by rwa mul_comm at h)

theorem eq_pow_of_mul_eq_pow_bit1 {a b c : ℤ}
  (hab : is_coprime a b) {k : ℕ} (h : a * b = c ^ (bit1 k)) :
  (∃ d, a = d ^ (bit1 k)) ∧ (∃ e, b = e ^ (bit1 k)) :=
⟨eq_pow_of_mul_eq_pow_bit1_left hab h, eq_pow_of_mul_eq_pow_bit1_right hab h⟩

end int


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

! This file was ported from Lean 3 source module linear_algebra.multilinear.finite_dimensional
! leanprover-community/mathlib commit ce11c3c2a285bbe6937e26d9792fda4e51f3fe1a
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.LinearAlgebra.Multilinear.Basic
import Mathbin.LinearAlgebra.FreeModule.Finite.Matrix

/-! # Multilinear maps over finite dimensional spaces

The main results are that multilinear maps over finitely-generated, free modules are
finitely-generated and free.

* `module.finite.multilinear_map`
* `module.free.multilinear_map`

We do not put this in `linear_algebra/multilinear_map/basic` to avoid making the imports too large
there.
-/

namespace MultilinearMap

variable {ι R M₂ : Type _} {M₁ : ι → Type _}

variable [Finite ι]

variable [CommRing R] [AddCommGroup M₂] [Module R M₂]

variable [∀ i, AddCommGroup (M₁ i)] [∀ i, Module R (M₁ i)]

variable [Module.Finite R M₂] [Module.Free R M₂]

variable [∀ i, Module.Finite R (M₁ i)] [∀ i, Module.Free R (M₁ i)]

-- the induction requires us to show both at once
private theorem free_and_finite :
    Module.Free R (MultilinearMap R M₁ M₂) ∧ Module.Finite R (MultilinearMap R M₁ M₂) :=
  by
  -- the `fin n` case is sufficient
  suffices
    ∀ (n) (N : Fin n → Type _) [∀ i, AddCommGroup (N i)],
      ∀ [∀ i, Module R (N i)],
        ∀ [∀ i, Module.Finite R (N i)] [∀ i, Module.Free R (N i)],
          Module.Free R (MultilinearMap R N M₂) ∧ Module.Finite R (MultilinearMap R N M₂)
    by
    cases nonempty_fintype ι
    cases this _ (M₁ ∘ (Fintype.equivFin ι).symm)
    have e := dom_dom_congr_linear_equiv' R M₁ M₂ (Fintype.equivFin ι)
    exact ⟨Module.Free.of_equiv e.symm, Module.Finite.equiv e.symm⟩
  intro n N _ _ _ _
  induction' n with n ih
  ·
    exact
      ⟨Module.Free.of_equiv (const_linear_equiv_of_is_empty R N M₂),
        Module.Finite.equiv (const_linear_equiv_of_is_empty R N M₂)⟩
  · suffices
      Module.Free R (N 0 →ₗ[R] MultilinearMap R (fun i : Fin n => N i.succ) M₂) ∧
        Module.Finite R (N 0 →ₗ[R] MultilinearMap R (fun i : Fin n => N i.succ) M₂)
      by
      cases this
      exact
        ⟨Module.Free.of_equiv (multilinearCurryLeftEquiv R N M₂),
          Module.Finite.equiv (multilinearCurryLeftEquiv R N M₂)⟩
    cases ih fun i => N i.succ
    exact ⟨Module.Free.linearMap _ _ _, Module.Finite.linearMap _ _⟩
#align multilinear_map.free_and_finite multilinear_map.free_and_finite

instance Module.Finite.multilinearMap : Module.Finite R (MultilinearMap R M₁ M₂) :=
  free_and_finite.2
#align module.finite.multilinear_map Module.Finite.multilinearMap

instance Module.Free.multilinearMap : Module.Free R (MultilinearMap R M₁ M₂) :=
  free_and_finite.1
#align module.free.multilinear_map Module.Free.multilinearMap

end MultilinearMap


/-
Copyright (c) 2020 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov, Patrick Massot
-/
import data.set.intervals.basic
import data.set.function
import algebra.order.monoid.cancel.defs
import algebra.order.monoid.canonical.defs
import algebra.group.basic

/-!
# Images of intervals under `(+ d)`

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

The lemmas in this file state that addition maps intervals bijectively. The typeclass
`has_exists_add_of_le` is defined specifically to make them work when combined with
`ordered_cancel_add_comm_monoid`; the lemmas below therefore apply to all
`ordered_add_comm_group`, but also to `ℕ` and `ℝ≥0`, which are not groups.
-/

namespace set

variables {M : Type*} [ordered_cancel_add_comm_monoid M] [has_exists_add_of_le M] (a b c d : M)

lemma Ici_add_bij : bij_on (+d) (Ici a) (Ici (a + d)) :=
begin
  refine ⟨λ x h, add_le_add_right (mem_Ici.mp h) _, (add_left_injective d).inj_on _, λ _ h, _⟩,
  obtain ⟨c, rfl⟩ := exists_add_of_le (mem_Ici.mp h),
  rw [mem_Ici, add_right_comm, add_le_add_iff_right] at h,
  exact ⟨a + c, h, by rw add_right_comm⟩,
end

lemma Ioi_add_bij : bij_on (+d) (Ioi a) (Ioi (a + d)) :=
begin
  refine ⟨λ x h, add_lt_add_right (mem_Ioi.mp h) _, λ _ _ _ _ h, add_right_cancel h, λ _ h, _⟩,
  obtain ⟨c, rfl⟩ := exists_add_of_le (mem_Ioi.mp h).le,
  rw [mem_Ioi, add_right_comm, add_lt_add_iff_right] at h,
  exact ⟨a + c, h, by rw add_right_comm⟩,
end

lemma Icc_add_bij : bij_on (+d) (Icc a b) (Icc (a + d) (b + d)) :=
begin
  rw [← Ici_inter_Iic, ← Ici_inter_Iic],
  exact (Ici_add_bij a d).inter_maps_to (λ x hx, add_le_add_right hx _)
    (λ x hx, le_of_add_le_add_right hx.2)
end

lemma Ioo_add_bij : bij_on (+d) (Ioo a b) (Ioo (a + d) (b + d)) :=
begin
  rw [← Ioi_inter_Iio, ← Ioi_inter_Iio],
  exact (Ioi_add_bij a d).inter_maps_to (λ x hx, add_lt_add_right hx _)
    (λ x hx, lt_of_add_lt_add_right hx.2)
end

lemma Ioc_add_bij : bij_on (+d) (Ioc a b) (Ioc (a + d) (b + d)) :=
begin
  rw [← Ioi_inter_Iic, ← Ioi_inter_Iic],
  exact (Ioi_add_bij a d).inter_maps_to (λ x hx, add_le_add_right hx _)
    (λ x hx, le_of_add_le_add_right hx.2)
end

lemma Ico_add_bij : bij_on (+d) (Ico a b) (Ico (a + d) (b + d)) :=
begin
  rw [← Ici_inter_Iio, ← Ici_inter_Iio],
  exact (Ici_add_bij a d).inter_maps_to (λ x hx, add_lt_add_right hx _)
    (λ x hx, lt_of_add_lt_add_right hx.2)
end

/-!
### Images under `x ↦ x + a`
-/

@[simp] lemma image_add_const_Ici : (λ x, x + a) '' Ici b = Ici (b + a) :=
(Ici_add_bij _ _).image_eq

@[simp] lemma image_add_const_Ioi : (λ x, x + a) '' Ioi b = Ioi (b + a) :=
(Ioi_add_bij _ _).image_eq

@[simp] lemma image_add_const_Icc : (λ x, x + a) '' Icc b c = Icc (b + a) (c + a) :=
(Icc_add_bij _ _ _).image_eq

@[simp] lemma image_add_const_Ico : (λ x, x + a) '' Ico b c = Ico (b + a) (c + a) :=
(Ico_add_bij _ _ _).image_eq

@[simp] lemma image_add_const_Ioc : (λ x, x + a) '' Ioc b c = Ioc (b + a) (c + a) :=
(Ioc_add_bij _ _ _).image_eq

@[simp] lemma image_add_const_Ioo : (λ x, x + a) '' Ioo b c = Ioo (b + a) (c + a) :=
(Ioo_add_bij _ _ _).image_eq

/-!
### Images under `x ↦ a + x`
-/

@[simp] lemma image_const_add_Ici : (λ x, a + x) '' Ici b = Ici (a + b) :=
by simp only [add_comm a, image_add_const_Ici]

@[simp] lemma image_const_add_Ioi : (λ x, a + x) '' Ioi b = Ioi (a + b) :=
by simp only [add_comm a, image_add_const_Ioi]

@[simp] lemma image_const_add_Icc : (λ x, a + x) '' Icc b c = Icc (a + b) (a + c) :=
by simp only [add_comm a, image_add_const_Icc]

@[simp] lemma image_const_add_Ico : (λ x, a + x) '' Ico b c = Ico (a + b) (a + c) :=
by simp only [add_comm a, image_add_const_Ico]

@[simp] lemma image_const_add_Ioc : (λ x, a + x) '' Ioc b c = Ioc (a + b) (a + c) :=
by simp only [add_comm a, image_add_const_Ioc]

@[simp] lemma image_const_add_Ioo : (λ x, a + x) '' Ioo b c = Ioo (a + b) (a + c) :=
by simp only [add_comm a, image_add_const_Ioo]

end set


/-
Copyright (c) 2021 Yury G. Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury G. Kudryashov
-/
import analysis.special_functions.pow
import number_theory.liouville.basic
import topology.instances.irrational

/-!
# Liouville numbers with a given exponent

We say that a real number `x` is a Liouville number with exponent `p : ℝ` if there exists a real
number `C` such that for infinitely many denominators `n` there exists a numerator `m` such that
`x ≠ m / n` and `|x - m / n| < C / n ^ p`. A number is a Liouville number in the sense of
`liouville` if it is `liouville_with` any real exponent, see `forall_liouville_with_iff`.

* If `p ≤ 1`, then this condition is trivial.

* If `1 < p ≤ 2`, then this condition is equivalent to `irrational x`. The forward implication
  does not require `p ≤ 2` and is formalized as `liouville_with.irrational`; the other implication
  follows from approximations by continued fractions and is not formalized yet.

* If `p > 2`, then this is a non-trivial condition on irrational numbers. In particular,
  [Thue–Siegel–Roth theorem](https://en.wikipedia.org/wiki/Roth's_theorem) states that such numbers
  must be transcendental.

In this file we define the predicate `liouville_with` and prove some basic facts about this
predicate.

## Tags

Liouville number, irrational, irrationality exponent
-/

open filter metric real set
open_locale filter topological_space

/-- We say that a real number `x` is a Liouville number with exponent `p : ℝ` if there exists a real
number `C` such that for infinitely many denominators `n` there exists a numerator `m` such that
`x ≠ m / n` and `|x - m / n| < C / n ^ p`.

A number is a Liouville number in the sense of `liouville` if it is `liouville_with` any real
exponent. -/
def liouville_with (p x : ℝ) : Prop :=
∃ C, ∃ᶠ n : ℕ in at_top, ∃ m : ℤ, x ≠ m / n ∧ |x - m / n| < C / n ^ p

/-- For `p = 1` (hence, for any `p ≤ 1`), the condition `liouville_with p x` is trivial. -/
lemma liouville_with_one (x : ℝ) : liouville_with 1 x :=
begin
  use 2,
  refine ((eventually_gt_at_top 0).mono $ λ n hn, _).frequently,
  have hn' : (0 : ℝ) < n, by simpa,
  have : x < ↑(⌊x * ↑n⌋ + 1) / ↑n,
  { rw [lt_div_iff hn', int.cast_add, int.cast_one], exact int.lt_floor_add_one _ },
  refine ⟨⌊x * n⌋ + 1, this.ne, _⟩,
  rw [abs_sub_comm, abs_of_pos (sub_pos.2 this), rpow_one, sub_lt_iff_lt_add',
    add_div_eq_mul_add_div _ _ hn'.ne', div_lt_div_right hn'],
  simpa [bit0, ← add_assoc] using (int.floor_le (x * n)).trans_lt (lt_add_one _)
end

namespace liouville_with

variables {p q x y : ℝ} {r : ℚ} {m : ℤ} {n : ℕ}

/-- The constant `C` provided by the definition of `liouville_with` can be made positive.
We also add `1 ≤ n` to the list of assumptions about the denominator. While it is equivalent to
the original statement, the case `n = 0` breaks many arguments. -/
lemma exists_pos (h : liouville_with p x) :
  ∃ (C : ℝ) (h₀ : 0 < C),
    ∃ᶠ n : ℕ in at_top, 1 ≤ n ∧ ∃ m : ℤ, x ≠ m / n ∧ |x - m / n| < C / n ^ p :=
begin
  rcases h with ⟨C, hC⟩,
  refine ⟨max C 1, zero_lt_one.trans_le $ le_max_right _ _, _⟩,
  refine ((eventually_ge_at_top 1).and_frequently hC).mono _,
  rintro n ⟨hle, m, hne, hlt⟩,
  refine ⟨hle, m, hne, hlt.trans_le _⟩,
  exact div_le_div_of_le (rpow_nonneg_of_nonneg n.cast_nonneg _) (le_max_left _ _)
end

/-- If a number is Liouville with exponent `p`, then it is Liouville with any smaller exponent. -/
lemma mono (h : liouville_with p x) (hle : q ≤ p) : liouville_with q x :=
begin
  rcases h.exists_pos with ⟨C, hC₀, hC⟩,
  refine ⟨C, hC.mono _⟩, rintro n ⟨hn, m, hne, hlt⟩,
  refine ⟨m, hne, hlt.trans_le $ div_le_div_of_le_left hC₀.le _ _⟩,
  exacts [rpow_pos_of_pos (nat.cast_pos.2 hn) _,
    rpow_le_rpow_of_exponent_le (nat.one_le_cast.2 hn) hle]
end

/-- If `x` satisfies Liouville condition with exponent `p` and `q < p`, then `x`
satisfies Liouville condition with exponent `q` and constant `1`. -/
lemma frequently_lt_rpow_neg (h : liouville_with p x) (hlt : q < p) :
  ∃ᶠ n : ℕ in at_top, ∃ m : ℤ, x ≠ m / n ∧ |x - m / n| < n ^ (-q) :=
begin
  rcases h.exists_pos with ⟨C, hC₀, hC⟩,
  have : ∀ᶠ n : ℕ in at_top, C < n ^ (p - q),
    by simpa only [(∘), neg_sub, one_div] using ((tendsto_rpow_at_top (sub_pos.2 hlt)).comp
      tendsto_coe_nat_at_top_at_top).eventually (eventually_gt_at_top C),
  refine (this.and_frequently hC).mono _,
  rintro n ⟨hnC, hn, m, hne, hlt⟩,
  replace hn : (0 : ℝ) < n := nat.cast_pos.2 hn,
  refine ⟨m, hne, hlt.trans $ (div_lt_iff $ rpow_pos_of_pos hn _).2 _⟩,
  rwa [mul_comm, ← rpow_add hn, ← sub_eq_add_neg]
end

/-- The product of a Liouville number and a nonzero rational number is again a Liouville number.  -/
lemma mul_rat (h : liouville_with p x) (hr : r ≠ 0) : liouville_with p (x * r) :=
begin
  rcases h.exists_pos with ⟨C, hC₀, hC⟩,
  refine ⟨r.denom ^ p * (|r| * C), (tendsto_id.nsmul_at_top r.pos).frequently (hC.mono _)⟩,
  rintro n ⟨hn, m, hne, hlt⟩,
  have A : (↑(r.num * m) : ℝ) / ↑(r.denom • id n) = (m / n) * r,
    by simp [← div_mul_div, ← r.cast_def, mul_comm],
  refine ⟨r.num * m, _, _⟩,
  { rw A, simp [hne, hr] },
  { rw [A, ← sub_mul, abs_mul],
    simp only [smul_eq_mul, id.def, nat.cast_mul],
    refine (mul_lt_mul_of_pos_right hlt $ abs_pos.2 $ rat.cast_ne_zero.2 hr).trans_le _,
    rw [mul_rpow, mul_div_mul_left, mul_comm, mul_div_assoc],
    exacts [(rpow_pos_of_pos (nat.cast_pos.2 r.pos) _).ne', nat.cast_nonneg _, nat.cast_nonneg _] }
end

/-- The product `x * r`, `r : ℚ`, `r ≠ 0`, is a Liouville number with exponent `p` if and only if
`x` satisfies the same condition. -/
lemma mul_rat_iff (hr : r ≠ 0) : liouville_with p (x * r) ↔ liouville_with p x :=
⟨λ h, by simpa only [mul_assoc, ← rat.cast_mul, mul_inv_cancel hr, rat.cast_one, mul_one]
  using h.mul_rat (inv_ne_zero hr), λ h, h.mul_rat hr⟩

/-- The product `r * x`, `r : ℚ`, `r ≠ 0`, is a Liouville number with exponent `p` if and only if
`x` satisfies the same condition. -/
lemma rat_mul_iff (hr : r ≠ 0) : liouville_with p (r * x) ↔ liouville_with p x :=
by rw [mul_comm, mul_rat_iff hr]

lemma rat_mul (h : liouville_with p x) (hr : r ≠ 0) : liouville_with p (r * x) :=
(rat_mul_iff hr).2 h

lemma mul_int_iff (hm : m ≠ 0) : liouville_with p (x * m) ↔ liouville_with p x :=
by rw [← rat.cast_coe_int, mul_rat_iff (int.cast_ne_zero.2 hm)]

lemma mul_int (h : liouville_with p x) (hm : m ≠ 0) : liouville_with p (x * m) :=
(mul_int_iff hm).2 h

lemma int_mul_iff (hm : m ≠ 0) : liouville_with p (m * x) ↔ liouville_with p x :=
by rw [mul_comm, mul_int_iff hm]

lemma int_mul (h : liouville_with p x) (hm : m ≠ 0) : liouville_with p (m * x) :=
(int_mul_iff hm).2 h

lemma mul_nat_iff (hn : n ≠ 0) : liouville_with p (x * n) ↔ liouville_with p x :=
by rw [← rat.cast_coe_nat, mul_rat_iff (nat.cast_ne_zero.2 hn)]

lemma mul_nat (h : liouville_with p x) (hn : n ≠ 0) : liouville_with p (x * n) :=
(mul_nat_iff hn).2 h

lemma nat_mul_iff (hn : n ≠ 0) : liouville_with p (n * x) ↔  liouville_with p x:=
by rw [mul_comm, mul_nat_iff hn]

lemma nat_mul (h : liouville_with p x) (hn : n ≠ 0) : liouville_with p (n * x) :=
by { rw mul_comm, exact h.mul_nat hn }

lemma add_rat (h : liouville_with p x) (r : ℚ) : liouville_with p (x + r) :=
begin
  rcases h.exists_pos with ⟨C, hC₀, hC⟩,
  refine ⟨r.denom ^ p * C, (tendsto_id.nsmul_at_top r.pos).frequently (hC.mono _)⟩,
  rintro n ⟨hn, m, hne, hlt⟩,
  have hr : (0 : ℝ) < r.denom, from nat.cast_pos.2 r.pos,
  have hn' : (n : ℝ) ≠ 0, from nat.cast_ne_zero.2 (zero_lt_one.trans_le hn).ne',
  have : (↑(r.denom * m + r.num * n : ℤ) / ↑(r.denom • id n) : ℝ) = m / n + r,
    by simp [add_div, hr.ne', mul_div_mul_left, mul_div_mul_right, hn', ← rat.cast_def],
  refine ⟨r.denom * m + r.num * n, _⟩, rw [this, add_sub_add_right_eq_sub],
  refine ⟨by simpa, hlt.trans_le (le_of_eq _)⟩,
  have : (r.denom ^ p : ℝ) ≠ 0, from (rpow_pos_of_pos hr _).ne',
  simp [mul_rpow, nat.cast_nonneg, mul_div_mul_left, this]
end

@[simp] lemma add_rat_iff : liouville_with p (x + r) ↔ liouville_with p x :=
⟨λ h, by simpa using h.add_rat (-r), λ h, h.add_rat r⟩

@[simp] lemma rat_add_iff : liouville_with p (r + x) ↔ liouville_with p x :=
by rw [add_comm, add_rat_iff]

lemma rat_add (h : liouville_with p x) (r : ℚ) : liouville_with p (r + x) :=
add_comm x r ▸ h.add_rat r

@[simp]

@[simp] lemma int_add_iff : liouville_with p (m + x) ↔ liouville_with p x :=
by rw [add_comm, add_int_iff]

@[simp] lemma add_nat_iff : liouville_with p (x + n) ↔ liouville_with p x :=
by rw [← rat.cast_coe_nat n, add_rat_iff]

@[simp] lemma nat_add_iff : liouville_with p (n + x) ↔ liouville_with p x :=
by rw [add_comm, add_nat_iff]

lemma add_int (h : liouville_with p x) (m : ℤ) : liouville_with p (x + m) := add_int_iff.2 h

lemma int_add (h : liouville_with p x) (m : ℤ) : liouville_with p (m + x) := int_add_iff.2 h

lemma add_nat (h : liouville_with p x) (n : ℕ) : liouville_with p (x + n) := h.add_int n

lemma nat_add (h : liouville_with p x) (n : ℕ) : liouville_with p (n + x) := h.int_add n

protected lemma neg (h : liouville_with p x) : liouville_with p (-x) :=
begin
  rcases h with ⟨C, hC⟩,
  refine ⟨C, hC.mono _⟩,
  rintro n ⟨m, hne, hlt⟩,
  use (-m), simp [neg_div, abs_sub_comm _ x, *]
end

@[simp] lemma neg_iff : liouville_with p (-x) ↔ liouville_with p x :=
⟨λ h, neg_neg x ▸ h.neg, liouville_with.neg⟩

@[simp] lemma sub_rat_iff : liouville_with p (x - r) ↔ liouville_with p x :=
by rw [sub_eq_add_neg, ← rat.cast_neg, add_rat_iff]

lemma sub_rat (h : liouville_with p x) (r : ℚ) : liouville_with p (x - r) :=
sub_rat_iff.2 h

@[simp] lemma sub_int_iff : liouville_with p (x - m) ↔ liouville_with p x :=
by rw [← rat.cast_coe_int, sub_rat_iff]

lemma sub_int (h : liouville_with p x) (m : ℤ) : liouville_with p (x - m) := sub_int_iff.2 h

@[simp] lemma sub_nat_iff : liouville_with p (x - n) ↔ liouville_with p x :=
by rw [← rat.cast_coe_nat, sub_rat_iff]

lemma sub_nat (h : liouville_with p x) (n : ℕ) : liouville_with p (x - n) := sub_nat_iff.2 h

@[simp] lemma rat_sub_iff : liouville_with p (r - x) ↔ liouville_with p x :=
by simp [sub_eq_add_neg]

lemma rat_sub (h : liouville_with p x) (r : ℚ) : liouville_with p (r - x) := rat_sub_iff.2 h

@[simp] lemma int_sub_iff : liouville_with p (m - x) ↔ liouville_with p x :=
by simp [sub_eq_add_neg]

lemma int_sub (h : liouville_with p x) (m : ℤ) : liouville_with p (m - x) := int_sub_iff.2 h

@[simp] lemma nat_sub_iff : liouville_with p (n - x) ↔ liouville_with p x :=
by simp [sub_eq_add_neg]

lemma nat_sub (h : liouville_with p x) (n : ℕ) : liouville_with p (n - x) := nat_sub_iff.2 h

lemma ne_cast_int (h : liouville_with p x) (hp : 1 < p) (m : ℤ) : x ≠ m :=
begin
  rintro rfl, rename m M,
  rcases ((eventually_gt_at_top 0).and_frequently (h.frequently_lt_rpow_neg hp)).exists
    with ⟨n : ℕ, hn : 0 < n, m : ℤ, hne : (M : ℝ) ≠ m / n, hlt : |(M - m / n : ℝ)| < n ^ (-1 : ℝ)⟩,
  refine hlt.not_le _,
  have hn' : (0 : ℝ) < n, by simpa,
  rw [rpow_neg_one, ← one_div, sub_div' _ _ _ hn'.ne', abs_div, nat.abs_cast, div_le_div_right hn'],
  norm_cast,
  rw [← zero_add (1 : ℤ), int.add_one_le_iff, abs_pos, sub_ne_zero],
  rw [ne.def, eq_div_iff hn'.ne'] at hne,
  exact_mod_cast hne
end

/-- A number satisfying the Liouville condition with exponent `p > 1` is an irrational number. -/
protected lemma irrational (h : liouville_with p x) (hp : 1 < p) : irrational x :=
begin
  rintro ⟨r, rfl⟩,
  rcases eq_or_ne r 0 with (rfl|h0),
  { refine h.ne_cast_int hp 0 _, rw [rat.cast_zero, int.cast_zero] },
  { refine (h.mul_rat (inv_ne_zero h0)).ne_cast_int hp 1 _,
    simp [rat.cast_ne_zero.2 h0] }
end

end liouville_with

namespace liouville

variables {x : ℝ}

/-- If `x` is a Liouville number, then for any `n`, for infinitely many denominators `b` there
exists a numerator `a` such that `x ≠ a / b` and `|x - a / b| < 1 / b ^ n`. -/
lemma frequently_exists_num (hx : liouville x) (n : ℕ) :
  ∃ᶠ b : ℕ in at_top, ∃ a : ℤ, x ≠ a / b ∧ |x - a / b| < 1 / b ^ n :=
begin
  refine not_not.1 (λ H, _),
  simp only [liouville, not_forall, not_exists, not_frequently, not_and, not_lt,
    eventually_at_top] at H,
  rcases H with ⟨N, hN⟩,
  have : ∀ b > (1 : ℕ), ∀ᶠ m : ℕ in at_top, ∀ a : ℤ, (1 / b ^ m : ℝ) ≤ |x - a / b|,
  { intros b hb,
    have hb0' : (b : ℚ) ≠ 0 := (zero_lt_one.trans (nat.one_lt_cast.2 hb)).ne',
    replace hb : (1 : ℝ) < b := nat.one_lt_cast.2 hb,
    have hb0 : (0 : ℝ) < b := zero_lt_one.trans hb,
    have H : tendsto (λ m, 1 / b ^ m : ℕ → ℝ) at_top (𝓝 0),
    { simp only [one_div],
      exact tendsto_inv_at_top_zero.comp (tendsto_pow_at_top_at_top_of_one_lt hb) },
    refine (H.eventually (hx.irrational.eventually_forall_le_dist_cast_div b)).mono _,
    exact λ m hm a, hm a },
  have : ∀ᶠ m : ℕ in at_top, ∀ b < N, 1 < b → ∀ a : ℤ, (1 / b ^ m : ℝ) ≤ |x - a / b|,
    from (finite_lt_nat N).eventually_all.2 (λ b hb, eventually_imp_distrib_left.2 (this b)),
  rcases (this.and (eventually_ge_at_top n)).exists with ⟨m, hm, hnm⟩,
  rcases hx m with ⟨a, b, hb, hne, hlt⟩,
  lift b to ℕ using zero_le_one.trans hb.le, norm_cast at hb, push_cast at hne hlt,
  cases le_or_lt N b,
  { refine (hN b h a hne).not_lt (hlt.trans_le _),
    replace hb : (1 : ℝ) < b := nat.one_lt_cast.2 hb,
    have hb0 : (0 : ℝ) < b := zero_lt_one.trans hb,
    exact one_div_le_one_div_of_le (pow_pos hb0 _) (pow_le_pow hb.le hnm) },
  { exact (hm b h hb _).not_lt hlt }
end

/-- A Liouville number is a Liouville number with any real exponent. -/
protected lemma liouville_with (hx : liouville x) (p : ℝ) : liouville_with p x :=
begin
  suffices : liouville_with ⌈p⌉₊ x, from this.mono (nat.le_ceil p),
  refine ⟨1, ((eventually_gt_at_top 1).and_frequently (hx.frequently_exists_num ⌈p⌉₊)).mono _⟩,
  rintro b ⟨hb, a, hne, hlt⟩,
  refine ⟨a, hne, _⟩,
  rwa rpow_nat_cast
end

end liouville

/-- A number satisfies the Liouville condition with any exponent if and only if it is a Liouville
number. -/
lemma forall_liouville_with_iff {x : ℝ} : (∀ p, liouville_with p x) ↔ liouville x :=
begin
  refine ⟨λ H n, _, liouville.liouville_with⟩,
  rcases ((eventually_gt_at_top 1).and_frequently
    ((H (n + 1)).frequently_lt_rpow_neg (lt_add_one n))).exists with ⟨b, hb, a, hne, hlt⟩,
  exact ⟨a, b, by exact_mod_cast hb, hne, by simpa [rpow_neg] using hlt⟩,
end


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

import easy_mode.sheet02

/-! Real vector spaces

This file defines the concept of a real vector space (as is discussed in the first lecture of Linear Algebra II
and proves that ℝ² and Mat₂ are instances of it.)

One further ingredient could be useful:

calc expr_1 = expr_2 : begin sorry end
       ...  = expr_3 : begin sorry end
       ...  = expr_4 : begin sorry end

Fun fact: If you only work with calc, you don't have to switch to tactic mode, i.e. you can leave out the
begin ... end

rw : rewrite one expression by another using a lemma.

apply : Apply a statement to reduce the goal. In ordinary mathematics you would read this as. By this theorem,
        it suffices to prove the following ...

exact : The goal that is to show is exactly the following lemma/theorem.

nth_rewrite i _ : If you use rw, it will change the every occurrence of the term. Sometimes you only want to
                  do that on a certain occurrence, that you can use nth_rewrite i to change it on the ith
                  occurrence (starting counting with 0).

conv_lhs begin ... end
conv_rhs begin ... end : Solve a similar problem to the one before, they allow you to only rewrite the left or
                         the right hand side of an equation.

norm_num : Similar to ring, but only calculates explicit expressions (with actual numbers.)
-/

/-- `real_vector_space V` is the type of real vector space structures on the type `V`. -/
class real_vector_space (V : Type)
  extends has_zero V, has_add V, has_neg V, has_scalar ℝ V : Type :=
(add_assoc : ∀ u v w : V, (u + v) + w = u + (v + w))
(add_comm : ∀ u v : V, u + v = v + u)
(add_zero : ∀ v : V, v + 0 = v)
(zero_add : ∀ v : V, 0 + v = v)
(add_neg : ∀ v : V, v + (-v) = 0)
(neg_add : ∀ v : V, (-v) + v = 0)
(smul_assoc : ∀ (a b : ℝ) (v : V), (a * b) • v = a • (b • v))
(one_smul : ∀ v : V, (1 : ℝ) • v = v)
(add_smul : ∀ (a b : ℝ) (v : V), (a + b) • v = a • v + b • v)
(smul_add : ∀ (a : ℝ) (v w : V), a • (v + w) = a • v + a • w)

namespace real_vector_space

/- We can also add the simp attribute to statements later. -/
attribute [simp] add_assoc add_zero zero_add add_neg neg_add smul_assoc one_smul add_smul smul_add

variables {V : Type} [real_vector_space V] {u v w : V} {a b : ℝ}

/-
Let's first let Lean know that the plane and the 2x2-matrices are real vector spaces. We have proved
everything on the previous two sheets, we just have to package it nicely.
-/

instance : real_vector_space ℝ² :=
_

instance : real_vector_space Mat₂ :=
_

/-
We continue by proving some well-known properties which hold in (real) vector spaces.
-/

lemma zero_unique_right_neutral (h : v + w = v)  :  w = 0 :=
begin
  sorry
end

lemma zero_unique_left_neutral (h : w + v = v) : w = 0 :=
begin
  sorry
end

@[simp] lemma zero_smul_eq_zero_vector (v : V) : (0 : ℝ) • v = 0 :=
begin
  sorry
end

lemma neg_unique_right_add_inv (h : v + w = 0) :  w = -v :=
begin
  sorry
end

lemma neg_unique_left_add_inv (h : w + v = 0) : w = -v :=
begin
  sorry
end

lemma minus_one_smul_eq_neg : (-1 : ℝ) • v = -v :=
begin
  sorry
end

end real_vector_space

/- It has been realised that the vector space axioms are not minimal, you can remove some of them and still
  get the same structure. Here is a minimal list that has been found (which is quite similar to the standard
  list, only the second axiom seems kind of weird.)-/
class minimal_vector_space_axioms (V : Type)
  extends has_add V, has_scalar ℝ V : Type :=
(add_assoc : ∀ u v w : V, (u + v) + w = u + (v + w))
(zero_smul_eq : ∀ v w : V, (0 : ℝ) • v = (0 : ℝ) • w)
(one_smul : ∀ v : V, (1 : ℝ) • v = v)
(smul_assoc : ∀ (a b : ℝ) (v : V), (a * b) • v = a • (b • v))
(add_smul : ∀ (a b : ℝ) (v : V), (a + b) • v = a • v + b • v)
(smul_add : ∀ (a : ℝ) (v w : V), a • (v + w) = a • v + a • w)

/- Note that in contrast to the vector space axioms, the axiom about the zero vector is omitted from these
  minimal vector space axioms. However this means that there is no reason for any vector at all to exist
  in `V`. So let's prove that the empty set satisfies these axioms. -/
instance : minimal_vector_space_axioms empty :=
_

/- Let's prove that any real_vector_space satisfies the minimal vector space axioms, which is not too difficult, '
  there is only one axiom which is already included in the axioms and that is immediately true. -/
def to_minimal_vector_space_axioms (V : Type) [real_vector_space V] : minimal_vector_space_axioms V :=
{ add := λ v w, v+w,
  smul := λ a v, a • v,
  add_assoc := sorry,
  zero_smul_eq := sorry,
  one_smul := sorry,
  smul_assoc := sorry,
  add_smul := sorry,
  smul_add := sorry }

/- In the other direction, the difference seems larger, so let's try to prove some of the axioms which are missing. -/

lemma minimal_vector_space_axioms.add_zero (V : Type) [minimal_vector_space_axioms V] (v w : V) : v + (0 : ℝ) • w = v :=
begin
  sorry
end

lemma minimal_vector_space_axioms.zero_add (V : Type) [minimal_vector_space_axioms V] (v w : V) : (0 : ℝ) • w + v = v :=
begin
  sorry
end

lemma minimal_vector_space_axioms.add_neg (V : Type) [minimal_vector_space_axioms V] (v : V) : v + (-1 : ℝ) • v = (0 : ℝ) • v :=
begin
  sorry
end

lemma minimal_vector_space_axioms.neg_add (V : Type) [minimal_vector_space_axioms V] (v : V) : (-1 : ℝ) • v + v = (0 : ℝ) • v :=
begin
  sorry
end

/- The following is probably the most challenging one. Consider trying to prove it on paper first. -/
lemma minimal_vector_space_axioms.add_comm (V : Type) [minimal_vector_space_axioms V] (v w : V) : v + w = w + v :=
begin
  sorry
end

/- However if we demand that the set V is nonempty, the axioms are in fact equivalent as we show with the
  following two results. These are `definitions` as they transport data. Often in a maths lecture we would
  instead say `proposition` for this, or if one is very careful `definition-proposition`. The definition is
  marked as `noncomputable` as it relies on choosing an arbitrary element `v` from the nonempty type `V`,
  for which there might not be an algorithm. -/
noncomputable def to_real_vector_space (V : Type) [minimal_vector_space_axioms V] (h : nonempty V) : real_vector_space V :=
{ zero := begin let v := h.some, exact ((0 : ℝ) • v) end,
  neg := begin intro v, exact ((-1 : ℝ) • v) end,
  add_assoc := sorry,
  add_comm := sorry,
  add_zero := sorry,
  zero_add := sorry,
  add_neg := sorry,
  neg_add := sorry,
  smul_assoc := sorry,
  one_smul := sorry,
  add_smul := sorry,
  smul_add := sorry }


constant f : Nat → Nat
constant q : Nat → Prop
constant r : Nat → Prop

@[simp] axiom ax1 (p : Prop) : (p ∧ True) ↔ p
@[simp] axiom ax2 (x : Nat) : q (f x)
@[simp] axiom ax3 (x : Nat) : ¬ r (f x)
@[simp] axiom ax4 (p : Prop) : (p ∨ False) ↔ p

theorem ex1 (x : Nat) (h : q x) : q x ∧ q (f x) := by
  simp [h]

theorem ex2 (x : Nat) : q (f x) ∨ r (f x) := by
  simp

@[simp] axiom ax5 (x : Nat) : 0 + x = x

theorem ex3 (h : 0 + x = y) : f x = f y := by
  simp at h
  simp [h]

theorem ex4 (x y z : Nat) (h : (x, z).1 = y) : f x = f y := by
  simp at h
  simp [h]

theorem ex5
    (f  : Nat → Nat → Nat)
    (g  : Nat → Nat)
    (h₁ : ∀ x, f x x = x)
    (h₂ : ∀ x, g (g x) = x)
    : f (g (g x)) (f x x) = x :=
  by simp [h₁, h₂]

@[simp] axiom ax6 (x : Nat) : x + 0 = x

theorem ex6
  (f : Nat → Nat)
  (x y : Nat)
  : (fun (h : y = 0) => y + x) = (fun _ => x + 0) := by
 simp (config := { contextual := true })

theorem ex7 (x : Nat) : (let y := x + 0; y + y) = x + x := by
  simp

@[simp] theorem impTrue (p : Sort u) : (p → True) = True :=
  propext <| Iff.intro (fun _ => trivial) (fun _ _ => trivial)

theorem ex8 (y x : Nat) : y = 0 → x + y = 0 → x = 0 := by
  simp (config := { contextual := true })

theorem ex9 (y x : Nat) : y = 0 → x + y = 0 → x = 0 := by
  simp
  intro h₁ h₂
  simp [h₁] at h₂
  simp [h₂]

theorem ex10 (y x : Nat) : y = 0 → x + 0 = 0 → x = 0 := by
  simp
  intro h₁ h₂
  simp [h₂]

theorem ex11 : ∀ x : Nat, 0 + x + 0 = x := by
  simp


/-
Copyright © 2021 Nicolò Cavalleri. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Nicolò Cavalleri
-/

import tactic.basic
import algebra.module.basic

/-!
# Bundle
Basic data structure to implement fiber bundles, vector bundles (maybe fibrations?), etc. This file
should contain all possible results that do not involve any topology.
We provide a type synonym of `Σ x, E x` as `bundle.total_space E`, to be able to endow it with
a topology which is not the disjoint union topology `sigma.topological_space`. In general, the
constructions of fiber bundles we will make will be of this form.

## References
- https://en.wikipedia.org/wiki/Bundle_(mathematics)
-/

namespace bundle

variables {B : Type*} (E : B → Type*)

/--
`total_space E` is the total space of the bundle `Σ x, E x`. This type synonym is used to avoid
conflicts with general sigma types.
-/
def total_space := Σ x, E x

instance [inhabited B] [inhabited (E default)] :
  inhabited (total_space E) := ⟨⟨default, default⟩⟩

/-- `bundle.proj E` is the canonical projection `total_space E → B` on the base space. -/
@[simp, reducible] def proj : total_space E → B := sigma.fst

/-- Constructor for the total space of a `topological_fiber_bundle_core`. -/
@[simp, reducible] def total_space_mk (E : B → Type*) (b : B) (a : E b) :
  bundle.total_space E := ⟨b, a⟩

instance {x : B} : has_coe_t (E x) (total_space E) := ⟨sigma.mk x⟩

@[simp] lemma coe_fst (x : B) (v : E x) : (v : total_space E).fst = x := rfl

lemma to_total_space_coe {x : B} (v : E x) : (v : total_space E) = ⟨x, v⟩ := rfl

-- notation for the direct sum of two bundles over the same base
notation E₁ `×ᵇ`:100 E₂ := λ x, E₁ x × E₂ x

/-- `bundle.trivial B F` is the trivial bundle over `B` of fiber `F`. -/
def trivial (B : Type*) (F : Type*) : B → Type* := function.const B F

instance {F : Type*} [inhabited F] {b : B} : inhabited (bundle.trivial B F b) := ⟨(default : F)⟩

/-- The trivial bundle, unlike other bundles, has a canonical projection on the fiber. -/
def trivial.proj_snd (B : Type*) (F : Type*) : (total_space (bundle.trivial B F)) → F := sigma.snd

section fiber_structures

variable [∀ x, add_comm_monoid (E x)]

@[simp] lemma coe_snd_map_apply (x : B) (v w : E x) :
  (↑(v + w) : total_space E).snd = (v : total_space E).snd + (w : total_space E).snd := rfl

variables (R : Type*) [semiring R] [∀ x, module R (E x)]

@[simp]

end fiber_structures

section trivial_instances
local attribute [reducible] bundle.trivial

variables {F : Type*} {R : Type*} [semiring R] (b : B)

instance [add_comm_monoid F] : add_comm_monoid (bundle.trivial B F b) := ‹add_comm_monoid F›
instance [add_comm_group F] : add_comm_group (bundle.trivial B F b) := ‹add_comm_group F›
instance [add_comm_monoid F] [module R F] : module R (bundle.trivial B F b) := ‹module R F›

end trivial_instances

end bundle