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

/-!
# seminorm_from_bounded
In this file, we prove [BGR, Proposition 1.2.1/2] : given a nonzero additive group seminorm on a
commutative ring `R` such that for some positive `c : ℝ`,and every `x y : R`, the inequality
`f (x * y) ≤ c * f x * f y)` is satisfied, we create a ring seminorm on `R`.

In the file comments, we will use the expression `f is multiplicatively bounded` to indicate that
`∃ (c : ℝ) (hc : 0 < c), ∀ (x y : R), f (x * y) ≤ c * f x * f y`.

## Main Definitions

* `seminorm_from_bounded'` : the real-valued function sending `x ∈ R` to the supremum of
  `f(x*y)/f(y)`, where `y` runs over the elements of `R`.
* `seminorm_from_bounded` : the function `seminorm_from_bounded'` is a `ring_seminorm` on `R`.
* `norm_from_bounded` :`seminorm_from_bounded' f` is a ring_norm on `R`, provided that `f` is
  nonnegative, multiplicatively bounded and subadditive, that it preserves `0` and negation, and
  that `f` has trivial kernel.

## Main Results

* `seminorm_from_bounded_is_nonarchimedean` : if `f : R → ℝ` is a nonnegative, multiplicatively
  bounded, nonarchimedean function, then `seminorm_from_bounded' f` is nonarchimedean.
* `seminorm_from_bounded_of_mul_is_mul` : if `f : R → ℝ` is a nonnegative, multiplicatively bounded
  function and `x : R` is multiplicative for `f`, then `x` is multiplicative for
  `seminorm_from_bounded' f`.

## References
* [S. Bosch, U. Güntzer, R. Remmert, *Non-Archimedean Analysis*][bosch-guntzer-remmert]

## Tags

seminorm_from_const, seminorm, nonarchimedean
-/

noncomputable theory

open function

open_locale topology nnreal

namespace normed_group_hom

/-- The inverse of `f : normed_add_group_hom V W` as a `normed_add_group_hom W V`. The map `f` must
  be bijective and bounded in the sense that `∃ (C : ℝ), ∀ v, ‖v‖ ≤ C * ‖f v‖`. -/
def normed_group_hom_inv_of_bijective_bounded {V : Type*} {W : Type*} [seminormed_add_comm_group V]
  [seminormed_add_comm_group W] (f : normed_add_group_hom V W) (h_bij : bijective f)
  (h_bdd : ∃ (C : ℝ), ∀ v, ‖v‖ ≤ C * ‖f v‖) : normed_add_group_hom W V :=
{ to_fun   := inv_fun f,
  map_add' := (add_monoid_hom.inverse f.to_add_monoid_hom (inv_fun f)
    (left_inverse_inv_fun h_bij.injective) (right_inverse_inv_fun h_bij.surjective)).map_add,
  bound'   := begin
    obtain ⟨C, hC⟩ := h_bdd,
    use C,
    intro w,
    set v := inv_fun f w with hv,
    rw ← right_inverse_inv_fun h_bij.surjective w,
    exact hC v,
  end }

/-- The inverse of `f : normed_add_group_hom V W` is bijective and there exists a real `C` such that
 `∀ v : W, ‖v‖ ≤ C * ‖f v‖`, then the inverse of `f` is continuous. -/
lemma continuous_inv_of_bijective_bounded {V : Type*} {W : Type*} [seminormed_add_comm_group V]
  [seminormed_add_comm_group W] {f : normed_add_group_hom V W} (h_bij : bijective f)
  (h_bdd : ∃ (C : ℝ), ∀ v, ‖v‖ ≤ C * ‖f v‖) : continuous (inv_fun f) :=
begin
  set g : normed_add_group_hom W V :=
  { to_fun   := inv_fun f,
    map_add' := λ x y, begin
      rw [← (classical.some_spec (((bijective_iff_exists_unique _).mp h_bij) x)).1,
        ← (classical.some_spec (((bijective_iff_exists_unique _).mp h_bij) y)).1],
      simp only [← (inv_fun f).comp_app f, inv_fun_comp h_bij.injective, id.def, ← map_add],
    end,
    bound'   := begin
      use classical.some h_bdd,
      intro w,
      rw ← (classical.some_spec (((bijective_iff_exists_unique _).mp h_bij) w)).1,
      simp only [← (inv_fun f).comp_app  f, inv_fun_comp h_bij.injective, id.def],
      exact classical.some_spec h_bdd _,
    end } with hg,
  change continuous g,
  apply normed_add_group_hom.continuous,
end

/-- We regard a bijective `f : normed_add_group_hom V W` such that
  `∃ (C : ℝ), ∀ v, ‖v‖ ≤ C * ‖f v‖` as a homeomorphism. -/
def homeo_of_bijective_bounded {V : Type*} {W : Type*} [seminormed_add_comm_group V]
  [seminormed_add_comm_group W] {f : normed_add_group_hom V W} (h_bij : bijective f)
  (h_bdd : ∃ (C : ℝ), ∀ v, ‖v‖ ≤ C * ‖f v‖) : homeomorph V W :=
{ to_fun             := f.to_fun,
  inv_fun            := inv_fun f.to_fun,
  left_inv           := left_inverse_inv_fun h_bij.injective,
  right_inv          := right_inverse_inv_fun h_bij.surjective,
  continuous_to_fun  := f.continuous,
  continuous_inv_fun := normed_group_hom.continuous_inv_of_bijective_bounded h_bij h_bdd }

end normed_group_hom

variables {R : Type*} [comm_ring R] (f : R → ℝ)

section seminorm_from_bounded

/-- The real-valued function sending `x ∈ R` to the supremum of  `f(x*y)/f(y)`, where `y` runs over
  the elements of `R`.-/
def seminorm_from_bounded' : R → ℝ := λ x, supr (λ (y : R), f(x*y)/f(y))

variables {f}

/-- If `f : R → ℝ` is a nonzero, nonnegative, multiplicatively bounded function, then `f 1 ≠ 0`. -/
lemma f_one_ne_zero (f_ne_zero : ∃ (x : R), f x ≠ 0) (f_nonneg : ∀ (x : R), 0 ≤ f x)
  (f_mul : ∃ (c : ℝ) (hc : 0 < c), ∀ (x y : R), f (x * y) ≤ c * f x * f y) : f 1 ≠ 0 :=
begin
  intro h1,
  obtain ⟨c, hc, hxy⟩ := f_mul,
  specialize hxy 1,
  simp_rw [h1, one_mul, mul_zero, zero_mul] at hxy,
  obtain ⟨z, hz⟩ := f_ne_zero,
  exact hz (le_antisymm (hxy z) (f_nonneg z)),
end

/-- If `f : R → ℝ` is a nonnegative multiplicatively bounded function and `x : R` is a unit with
  `f x ≠ 0`, then for every `n : ℕ`, we have `f (x ^ n) ≠ 0`. -/
lemma f_pow_ne_zero (f_nonneg : ∀ (x : R), 0 ≤ f x) {x : R} (hx : is_unit x) (hfx : f x ≠ 0) (n : ℕ)
  (f_mul : ∃ (c : ℝ) (hc : 0 < c), ∀ (x y : R), f (x * y) ≤ c * f x * f y) : f (x ^ n) ≠ 0 :=
begin
  have h1 : f 1 ≠ 0 := f_one_ne_zero (exists.intro x hfx) f_nonneg f_mul,
  intro hxn,
  obtain ⟨c, hc, hxy⟩ := f_mul,
  obtain ⟨u, hu⟩ := hx,
  specialize hxy (x^n) (u.inv^n),
  rw [hxn, mul_zero, zero_mul, ← mul_pow, ← hu, units.inv_eq_coe_inv, units.mul_inv,
    one_pow] at hxy,
  exact h1 (le_antisymm  hxy (f_nonneg 1)),
end

/-- `seminorm_from_bounded' f` preserves `0`. -/
lemma seminorm_from_bounded_zero (f_zero : f 0 = 0) :
  seminorm_from_bounded' f (0 : R) = 0 :=
by simp_rw [seminorm_from_bounded', zero_mul, f_zero, zero_div, csupr_const]

/-- If `f : R → ℝ` is a nonnegative, multiplicatively bounded function, then for every `x : R`,
  the image of `y ↦ f (x * y) / f y` is bounded above. -/
lemma seminorm_from_bounded_bdd_range (f_nonneg : ∀ (x : R), 0 ≤ f x)
  (f_mul : ∃ (c : ℝ) (hc : 0 < c), ∀ (x y : R), f (x * y) ≤ c * f x * f y) (x : R) :
  bdd_above (set.range (λ y, f (x * y) / f y)) :=
begin
  obtain ⟨c, hc_pos, hxy⟩ := f_mul,
  use c * f x,
  rintros r ⟨y, hy⟩,
  simp only [← hy],
  by_cases hy0 : f y = 0,
  { rw [← hy0.symm, div_zero],
    apply mul_nonneg (le_of_lt hc_pos) (f_nonneg x), },
  { simpa [div_le_iff (lt_of_le_of_ne (f_nonneg y) (ne.symm hy0))] using hxy x y, },
end

/-- If `f : R → ℝ` is a nonnegative, multiplicatively bounded function, then for every `x : R`,
  `seminorm_from_bounded' f x` is bounded above by some multiple of `f x`. -/
lemma seminorm_from_bounded_le (f_nonneg : ∀ (x : R), 0 ≤ f x)
  (f_mul : ∃ (c : ℝ) (hc : 0 < c), ∀ (x y : R), f (x * y) ≤ c * f x * f y) (x : R) :
  seminorm_from_bounded' f x ≤ (classical.some f_mul) * f x :=
begin
  have h := classical.some_spec(classical.some_spec f_mul),
  apply csupr_le,
  intro y,
  by_cases hy : 0 = f y,
  { rw [← hy, div_zero],
    exact mul_nonneg (le_of_lt (classical.some (classical.some_spec f_mul))) (f_nonneg _), },
  { rw div_le_iff (lt_of_le_of_ne (f_nonneg _) hy),
    exact (classical.some_spec (classical.some_spec f_mul)) x y  }
end

/-- If `f : R → ℝ` is a nonnegative, multiplicatively bounded function, then for every `x : R`,
  `f x ≤ f 1 * seminorm_from_bounded' f x`. -/
lemma seminorm_from_bounded_ge (f_nonneg : ∀ (x : R), 0 ≤ f x)
  (f_mul : ∃ (c : ℝ) (hc : 0 < c), ∀ (x y : R), f (x * y) ≤ c * f x * f y) (x : R) :
  f x ≤ f 1 * seminorm_from_bounded' f x :=
begin
  by_cases h1 : f 1 = 0,
  { obtain ⟨c, hc_pos, hxy⟩ := f_mul,
    specialize hxy x 1,
    rw [mul_one, h1, mul_zero] at hxy,
    have hx0 : f x = 0 := le_antisymm hxy (f_nonneg _),
    rw [hx0, h1, zero_mul] },
  { rw [mul_comm,  ← div_le_iff (lt_of_le_of_ne' (f_nonneg _) h1)],
    have h_bdd : bdd_above (set.range (λ y, f (x * y) / f y)),
    { exact seminorm_from_bounded_bdd_range f_nonneg f_mul x},
    convert le_csupr h_bdd (1 : R),
    rw mul_one,  } ,
end

/-- If `f : R → ℝ` is a nonnegative, multiplicatively bounded function, then
  `seminorm_from_bounded' f` is nonnegative. -/
lemma seminorm_from_bounded_nonneg (f_nonneg : ∀ (x : R), 0 ≤ f x)
  (f_mul : ∃ (c : ℝ) (hc : 0 < c), ∀ (x y : R), f (x * y) ≤ c * f x * f y) (x : R) :
  0 ≤ seminorm_from_bounded' f x :=
le_cSup_of_le (seminorm_from_bounded_bdd_range f_nonneg f_mul x) ⟨1, rfl⟩
  (div_nonneg (f_nonneg _) (f_nonneg _))

/-- If `f : R → ℝ` is a nonnegative, multiplicatively bounded function, then given `x y : R` with
  `f x = 0`, we have `f (x * y) = 0`. -/
lemma f_mul_zero_of_f_zero (f_nonneg : ∀ (x : R), 0 ≤ f x)
  (f_mul : ∃ (c : ℝ) (hc : 0 < c), ∀ (x y : R), f (x * y) ≤ c * f x * f y)
  {x : R} (hx : f x = 0) (y : R) : f (x * y) = 0 :=
begin
  obtain ⟨c, hc, hxy⟩ := f_mul,
  specialize hxy x y,
  rw [hx, mul_zero, zero_mul] at hxy,
  exact le_antisymm hxy (f_nonneg _),
end

/-- If `f : R → ℝ` is a nonnegative, multiplicatively bounded function, then
  `seminorm_from_bounded' f x = 0` if and only if `f x = 0`. -/
lemma seminorm_from_bounded_eq_zero_iff (f_nonneg : ∀ (x : R), 0 ≤ f x)
(f_mul : ∃ (c : ℝ) (hc : 0 < c), ∀ (x y : R), f (x * y) ≤ c * f x * f y) (x : R) :
  seminorm_from_bounded' f x = 0 ↔ f x = 0 :=
begin
  refine ⟨λ h, _, λ h, _⟩,
  { have hf := seminorm_from_bounded_ge f_nonneg f_mul x,
    rw [h, mul_zero] at hf,
    exact le_antisymm hf (f_nonneg _) },
  { have hf : seminorm_from_bounded' f x ≤ classical.some f_mul * f x :=
    seminorm_from_bounded_le f_nonneg f_mul x,
    rw [h, mul_zero] at hf,
    exact le_antisymm hf (seminorm_from_bounded_nonneg f_nonneg f_mul x), }
end

/-- If `f` is invariant under negation of `x`, then so is `seminorm_from_bounded'`.-/
lemma seminorm_from_bounded_neg (f_neg : ∀ (x : R), f (-x) = f x) (x : R) :
  seminorm_from_bounded' f (-x) = seminorm_from_bounded' f x :=
begin
  simp only [seminorm_from_bounded'],
  congr, ext y,
  rw [neg_mul, f_neg],
end

/-- If `f : R → ℝ` is a nonnegative, multiplicatively bounded function, then
  `seminorm_from_bounded' f` is submultiplicative. -/
lemma seminorm_from_bounded_mul (f_nonneg : ∀ (x : R), 0 ≤ f x)
  (f_mul : ∃ (c : ℝ) (hc : 0 < c), ∀ (x y : R), f (x * y) ≤ c * f x * f y) (x y : R) :
  seminorm_from_bounded' f (x * y) ≤ seminorm_from_bounded' f x * seminorm_from_bounded' f y :=
begin
  apply csupr_le,
  by_cases hy : seminorm_from_bounded' f y = 0,
  { rw seminorm_from_bounded_eq_zero_iff f_nonneg f_mul at hy,
    intro z,
    have hz : f (y * (x * z)) = 0 := f_mul_zero_of_f_zero f_nonneg f_mul hy (x*z),
    rw [mul_comm x y, mul_assoc, hz, zero_div],
    exact mul_nonneg (seminorm_from_bounded_nonneg f_nonneg f_mul x)
      (seminorm_from_bounded_nonneg f_nonneg f_mul y),  },
  { intro z,
    rw ← div_le_iff (lt_of_le_of_ne' (seminorm_from_bounded_nonneg f_nonneg f_mul _) hy),
    apply le_csupr_of_le (seminorm_from_bounded_bdd_range f_nonneg f_mul x) z,
    rw [div_le_iff (lt_of_le_of_ne' (seminorm_from_bounded_nonneg f_nonneg f_mul _) hy),
      div_mul_eq_mul_div],
    by_cases hz : f z = 0,
    { have hxyz : f (z * (x * y)) = 0 := f_mul_zero_of_f_zero f_nonneg f_mul hz _,
      simp_rw [mul_comm, hxyz, zero_div],
      exact div_nonneg (mul_nonneg (seminorm_from_bounded_nonneg f_nonneg f_mul y) (f_nonneg _))
        (f_nonneg _), },
    { rw [div_le_div_right (lt_of_le_of_ne' (f_nonneg _) hz), mul_comm (f (x * z))],
      by_cases hxz : f (x * z) = 0,
      { have hxyz : f (x * z * y) = 0 := f_mul_zero_of_f_zero f_nonneg f_mul hxz y,
        rw [mul_comm x y, mul_assoc, mul_comm y, hxyz],
        exact mul_nonneg (seminorm_from_bounded_nonneg f_nonneg f_mul y) (f_nonneg _) },
      { rw ← div_le_iff (lt_of_le_of_ne' (f_nonneg _) hxz),
        apply le_csupr_of_le (seminorm_from_bounded_bdd_range f_nonneg f_mul y) (x * z),
        rw [div_le_div_right (lt_of_le_of_ne' (f_nonneg _) hxz), mul_comm x y, mul_assoc], }}},
end

/-- If `f : R → ℝ` is a nonzero, nonnegative, multiplicatively bounded function, then
  `seminorm_from_bounded' f 1 = 1`. -/
lemma seminorm_from_bounded_one_eq (f_ne_zero : ∃ (x : R), f x ≠ 0) (f_nonneg : ∀ (x : R), 0 ≤ f x)
  (f_mul : ∃ (c : ℝ) (hc : 0 < c), ∀ (x y : R), f (x * y) ≤ c * f x * f y) :
  seminorm_from_bounded' f 1 = 1 :=
begin
  simp_rw [seminorm_from_bounded', one_mul],
  have h_le : (⨆ (y : R), f y / f y) ≤ 1,
  { apply csupr_le,
    intro x, by_cases hx : f x = 0,
    { rw hx, rw div_zero, exact zero_le_one },
    { rw div_self hx }},
  have h_ge : 1 ≤ (⨆ (y : R), f y / f y),
  { rw ← div_self (f_one_ne_zero f_ne_zero f_nonneg f_mul),
    have h_bdd : bdd_above (set.range (λ y, f y / f y)),
    { use (1 : ℝ),
      rw mem_upper_bounds,
      rintros r ⟨y, hy⟩,
      simp_rw [← hy],
      by_cases hy : f y = 0,
    { rw [hy, div_zero], exact zero_le_one },
    { rw div_self hy }},
    exact le_csupr h_bdd (1 : R), },
  exact le_antisymm h_le h_ge,
end

/-- If `f : R → ℝ` is a nonnegative, multiplicatively bounded function, then
  `seminorm_from_bounded' f 1 ≤ 1`. -/
lemma seminorm_from_bounded_is_norm_le_one_class (f_nonneg : ∀ (x : R), 0 ≤ f x)
  (f_mul : ∃ (c : ℝ) (hc : 0 < c), ∀ (x y : R), f (x * y) ≤ c * f x * f y) :
  seminorm_from_bounded' f 1 ≤ 1 :=
begin
  by_cases f_ne_zero : ∃ (x : R), f x ≠ 0,
  { exact le_of_eq (seminorm_from_bounded_one_eq f_ne_zero f_nonneg f_mul)},
  { simp_rw [seminorm_from_bounded', one_mul],
    apply csupr_le,
    intro x,
    push_neg at f_ne_zero,
    { rw (f_ne_zero x), rw div_zero, exact zero_le_one }}
end

/-- If `f : R → ℝ` is a nonnegative, multiplicatively bounded, subadditive function, then
  `seminorm_from_bounded' f` is subadditive. -/
lemma seminorm_from_bounded_add (f_nonneg : ∀ (x : R), 0 ≤ f x)
  (f_mul : ∃ (c : ℝ) (hc : 0 < c), ∀ (x y : R), f (x * y) ≤ c * f x * f y)
  (f_add : ∀ a b, f (a + b) ≤ f a + f b) (x y : R) :
  seminorm_from_bounded' f (x + y) ≤ seminorm_from_bounded' f x + seminorm_from_bounded' f y :=
begin
  apply csupr_le,
  intro z,
  suffices hf : f ((x + y) * z) / f z ≤ f (x * z) / f z + f (y * z) / f z,
  { exact le_trans hf (add_le_add
      (le_csupr_of_le (seminorm_from_bounded_bdd_range f_nonneg f_mul x) z (le_refl _))
      (le_csupr_of_le (seminorm_from_bounded_bdd_range f_nonneg f_mul y) z (le_refl _))), },
  { by_cases hz : f z = 0,
    { simp only [hz, div_zero, zero_add, le_refl, or_self], },
    { rw [div_add_div_same, div_le_div_right (lt_of_le_of_ne' (f_nonneg _) hz), add_mul],
      exact f_add _ _ }}
end

/-- `seminorm_from_bounded'` is a ring seminorm on `R`. -/
def seminorm_from_bounded (f_zero : f 0 = 0) (f_nonneg : ∀ (x : R), 0 ≤ f x)
  (f_mul : ∃ (c : ℝ) (hc : 0 < c), ∀ (x y : R), f (x * y) ≤ c * f x * f y)
  (f_add : ∀ a b, f (a + b) ≤ f a + f b) (f_neg : ∀ (x : R), f (-x) = f x) : ring_seminorm R :=
{ to_fun    := seminorm_from_bounded' f,
  map_zero' := seminorm_from_bounded_zero f_zero,
  add_le'   := seminorm_from_bounded_add f_nonneg f_mul f_add,
  mul_le'   := seminorm_from_bounded_mul f_nonneg f_mul,
  neg'      := seminorm_from_bounded_neg f_neg }

/-- If `f : R → ℝ` is a nonnegative, multiplicatively bounded, nonarchimedean function, then
  `seminorm_from_bounded' f` is nonarchimedean. -/
lemma seminorm_from_bounded_is_nonarchimedean (f_nonneg : ∀ (x : R), 0 ≤ f x)
  (f_mul : ∃ (c : ℝ) (hc : 0 < c), ∀ (x y : R), f (x * y) ≤ c * f x * f y)
  (hna : is_nonarchimedean f) : is_nonarchimedean (seminorm_from_bounded' f) :=
begin
  intros x y,
  apply csupr_le,
  intro z,
  rw le_max_iff,
  suffices hf : f ((x + y) * z) / f z ≤ f (x * z) / f z ∨
    f ((x + y) * z) / f z ≤ f (y * z) / f z,
  cases hf with hfx hfy; [left, right],
  { exact le_csupr_of_le (seminorm_from_bounded_bdd_range f_nonneg f_mul x) z hfx },
  { exact le_csupr_of_le (seminorm_from_bounded_bdd_range f_nonneg f_mul y) z hfy },
  { by_cases hz : f z = 0,
    { simp only [hz, div_zero, le_refl, or_self], },
    { rw [div_le_div_right (lt_of_le_of_ne' (f_nonneg _) hz), div_le_div_right
        (lt_of_le_of_ne' (f_nonneg _) hz), add_mul, ← le_max_iff],
      exact hna _ _, }},
end

/-- If `f : R → ℝ` is a nonnegative, multiplicatively bounded function and `x : R` is
  multiplicative for `f`, then `seminorm_from_bounded' f x = f x`. -/
lemma seminorm_from_bounded_of_mul_apply (f_nonneg : ∀ (x : R), 0 ≤ f x)
  (f_mul : ∃ (c : ℝ) (hc : 0 < c), ∀ (x y : R), f (x * y) ≤ c * f x * f y) {x : R}
  (hx : ∀ (y : R), f (x * y) = f x * f y) : seminorm_from_bounded' f x = f x :=
begin
  simp_rw [seminorm_from_bounded', hx, ← mul_div_assoc'],
  have h_le : (⨆ (y : R), f x * (f y / f y)) ≤ f x,
  { apply csupr_le,
    intro x, by_cases hx : f x = 0,
    { rw [hx, div_zero, mul_zero], exact f_nonneg _, },
    { rw [div_self hx, mul_one] }},
  have h_ge : f x ≤ (⨆ (y : R), f x * (f y / f y)),
  { by_cases f_ne_zero : ∃ (x : R), f x ≠ 0,
    { conv_lhs { rw ← mul_one (f x) },
      rw ← div_self (f_one_ne_zero f_ne_zero f_nonneg f_mul),
      have h_bdd : bdd_above (set.range (λ y, f x * (f y / f y))),
      { use f x,
        rw mem_upper_bounds,
        rintros r ⟨y, hy⟩,
        simp_rw [← hy],
        by_cases hy0 : f y = 0,
      { rw [hy0, div_zero, mul_zero], exact f_nonneg _ },
      { rw [div_self hy0, mul_one] }},
      exact le_csupr h_bdd (1 : R), },
      { push_neg at f_ne_zero,
        simp_rw [f_ne_zero, zero_div, zero_mul, csupr_const], } },
  exact le_antisymm h_le h_ge,
end

/-- If `f : R → ℝ` is a nonnegative function and `x : R` is submultiplicative for `f`, then
  `seminorm_from_bounded' f x = f x`. -/
lemma seminorm_from_bounded_of_mul_le (f_nonneg : ∀ (x : R), 0 ≤ f x) {x : R}
  (hx : ∀ (y : R), f (x * y) ≤ f x * f y) (h_one : f 1 ≤ 1)  : seminorm_from_bounded' f x = f x :=
begin
  simp_rw [seminorm_from_bounded'],
  have h_le : (⨆ (y : R), f (x * y) / f y) ≤ f x,
  { apply csupr_le,
    intro y, by_cases hy : f y = 0,
    { rw [hy, div_zero], exact f_nonneg _, },
    {rw div_le_iff (lt_of_le_of_ne' (f_nonneg _) hy), exact hx _,  }},
  have h_ge : f x ≤ (⨆ (y : R), f (x * y) / f y),
  { have h_bdd : bdd_above (set.range (λ y, f (x * y) / f y)),
    { use (f x),
      rw mem_upper_bounds,
      rintros r ⟨y, hy⟩,
      simp only [← hy],
      by_cases hy0 : f y = 0,
      { rw [hy0, div_zero],
       exact f_nonneg _ },
      { rw [← mul_one (f x), ← div_self hy0, ← mul_div_assoc, div_le_iff
          (lt_of_le_of_ne' (f_nonneg _) hy0), mul_div_assoc, div_self hy0, mul_one],
          exact hx y,  }},
    convert le_csupr h_bdd (1 : R),
    by_cases h0 : f x = 0,
    { rw [mul_one, h0, zero_div],},
    { have heq : f 1 = 1,
      { apply le_antisymm h_one,
        specialize hx 1,
        rw [mul_one, le_mul_iff_one_le_right (lt_of_le_of_ne (f_nonneg _) (ne.symm h0))] at hx,
        exact hx, },
      rw [heq, mul_one, div_one], } },
  exact le_antisymm h_le h_ge,
end

/-- If `f : R → ℝ` is a nonzero, nonnegative, multiplicatively bounded function, then
  `seminorm_from_bounded' f` is nonzero. -/
lemma seminorm_from_bounded_ne_zero (f_ne_zero : ∃ x : R, f x ≠ 0) (f_nonneg : ∀ (x : R), 0 ≤ f x)
  (f_mul : ∃ (c : ℝ) (hc : 0 < c), ∀ (x y : R), f (x * y) ≤ c * f x * f y) :
  ∃ x : R, seminorm_from_bounded' f x ≠ 0 :=
begin
  obtain ⟨x, hx⟩ := f_ne_zero,
  use x,
  rw [ne.def, seminorm_from_bounded_eq_zero_iff f_nonneg f_mul x],
  exact hx,
end

/-- If `f : R → ℝ` is a nonnegative, multiplicatively bounded function, then the kernel of
  `seminorm_from_bounded' f` equals the kernel of `f`. -/
lemma seminorm_from_bounded_ker (f_nonneg : ∀ (x : R), 0 ≤ f x)
  (f_mul : ∃ (c : ℝ) (hc : 0 < c), ∀ (x y : R), f (x * y) ≤ c * f x * f y) :
  (seminorm_from_bounded' f)⁻¹' {0} = f⁻¹' {0} :=
begin
  ext x,
  simp only [set.mem_preimage, set.mem_singleton_iff],
  exact seminorm_from_bounded_eq_zero_iff f_nonneg f_mul x,
end

/-- If `f : R → ℝ` is a nonnegative, multiplicatively bounded, subadditive function that preserves
  zero and negation, then `seminorm_from_bounded' f` is a norm if and only if `f⁻¹' {0} = {0}`. -/
lemma seminorm_from_bounded_is_norm_iff (f_zero : f 0 = 0) (f_nonneg : ∀ (x : R), 0 ≤ f x)
  (f_mul : ∃ (c : ℝ) (hc : 0 < c), ∀ (x y : R), f (x * y) ≤ c * f x * f y)
  (f_add : ∀ a b, f (a + b) ≤ f a + f b) (f_neg : ∀ (x : R), f (-x) = f x) :
  (∀ (x : R), (seminorm_from_bounded f_zero f_nonneg f_mul f_add f_neg).to_fun x = 0 → x = 0) ↔
    f⁻¹' {0} = {0} :=
begin
  refine ⟨λ h0, _, λ h_ker, _⟩,
  { rw ← seminorm_from_bounded_ker f_nonneg f_mul,
    ext x,
    simp only [set.mem_preimage, set.mem_singleton_iff],
    exact ⟨λ h, h0 x h, λ h, by {rw h, exact seminorm_from_bounded_zero f_zero}⟩ },
  { intros x hx,
    rw [← set.mem_singleton_iff, ← h_ker, set.mem_preimage, set.mem_singleton_iff,
      ← seminorm_from_bounded_eq_zero_iff f_nonneg f_mul x],
    exact hx }
end

/-- `seminorm_from_bounded' f` is a ring_norm on `R`, provided that `f` is nonnegative,
  multiplicatively bounded and subadditive, that it preserves `0` and negation, and that `f` has
  trivial kernel. -/
def norm_from_bounded (f_zero : f 0 = 0) (f_nonneg : ∀ (x : R), 0 ≤ f x)
  (f_mul : ∃ (c : ℝ) (hc : 0 < c), ∀ (x y : R), f (x * y) ≤ c * f x * f y)
  (f_add : ∀ a b, f (a + b) ≤ f a + f b) (f_neg : ∀ (x : R), f (-x) = f x)
  (f_ker : f⁻¹' {0} = {0}) : ring_norm R :=
{ eq_zero_of_map_eq_zero' :=
  (seminorm_from_bounded_is_norm_iff f_zero f_nonneg f_mul f_add f_neg).mpr f_ker,
  ..(seminorm_from_bounded f_zero f_nonneg f_mul f_add f_neg) }

/-- If `f : R → ℝ` is a nonnegative, multiplicatively bounded function and `x : R` is
  multiplicative for `f`, then `x` is multiplicative for `seminorm_from_bounded' f`. -/
lemma seminorm_from_bounded_of_mul_is_mul (f_nonneg : ∀ (x : R), 0 ≤ f x)
  (f_mul : ∃ (c : ℝ) (hc : 0 < c), ∀ (x y : R), f (x * y) ≤ c * f x * f y) {x : R}
  (hx : ∀ (y : R), f (x * y) = f x * f y) (y : R) :
  seminorm_from_bounded' f (x * y) = (seminorm_from_bounded' f x) * (seminorm_from_bounded' f y) :=
begin
  rw [seminorm_from_bounded_of_mul_apply f_nonneg f_mul hx],
  simp only [seminorm_from_bounded', mul_assoc, hx, mul_div_assoc,
    real.mul_supr_of_nonneg (f_nonneg _)],
end

end seminorm_from_bounded


/-
Copyright (c) 2020 Gihan Marasingha. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Gihan Marasingha
-/
import .basic
import data.list.count
import data.nat.modeq
import tactic.ring

/-!
# Decision procedure: necessary condition

We introduce a condition `decstr` and show that if a string `en` is `derivable`, then `decstr en`
holds.

Using this, we give a negative answer to the question: is `"MU"` derivable?

## Tags

miu, decision procedure
-/

namespace miu

open miu_atom nat list

/-!
### Numerical condition on the `I` count

Suppose `st : miustr`. Then `count I st` is the number of `I`s in `st`. We'll show, if
`derivable st`, then `count I st` must be 1 or 2 modulo 3. To do this, it suffices to show that if
the `en : miustr` is derived from `st`, then `count I en` moudulo 3 is either equal to or is twice
`count I st`, modulo 3.
-/

/--
Given `st en : miustr`, the relation `count_equiv_or_equiv_two_mul_mod3 st en` holds if `st` and
`en` either have equal `count I`, modulo 3, or `count I en` is twice `count I st`, modulo 3.
 -/
def count_equiv_or_equiv_two_mul_mod3 (st en : miustr) : Prop :=
let a := (count I st) in
let b := (count I en) in
b ≡ a [MOD 3] ∨ b ≡ 2*a [MOD 3]

example : count_equiv_or_equiv_two_mul_mod3 "II" "MIUI" :=
or.inl rfl

example : count_equiv_or_equiv_two_mul_mod3 "IUIM" "MI" :=
or.inr rfl

/--
If `a` is 1 or 2 mod 3 and if `b` is `a` or twice `a` mod 3, then `b` is 1 or 2 mod 3.
-/
lemma mod3_eq_1_or_mod3_eq_2 {a b : ℕ} (h1 : a % 3 = 1 ∨ a % 3 = 2)
  (h2 : b % 3 = a % 3 ∨  b % 3 = (2 * a % 3)) : b % 3 = 1 ∨ b % 3 = 2 :=
begin
  cases h2,
  { rw h2, exact h1, },
  { cases h1,
    { right, simp [h2,mul_mod,h1, nat.succ_lt_succ] },
    { left, simpa [h2,mul_mod,h1], }, },
end

/--
`count_equiv_one_or_two_mod3_of_derivable` shows any derivable string must have a `count I` that
is 1 or 2 modulo 3.
-/
theorem count_equiv_one_or_two_mod3_of_derivable (en : miustr): derivable en →
  (count I en) % 3 = 1 ∨ (count I en) % 3 = 2:=
begin
  intro h,
  induction h,
  { left, apply mod_def, },
  any_goals {apply mod3_eq_1_or_mod3_eq_2 h_ih},
  { left, simp only [count_append], refl, },
  { right, simp only [count, countp, count_append, if_false,two_mul], },
  { left, simp only [count, count_append, countp, if_false, if_pos],
    rw [add_right_comm, add_mod_right], },
  { left, simp only [count ,countp, countp_append, if_false, add_zero], },
end

/--
Using the above theorem, we solve the MU puzzle, showing that `"MU"` is not derivable.
Once we have proved that `derivable` is an instance of `decidable_pred`, this will follow
immediately from `dec_trivial`.
-/
theorem not_derivable_mu : ¬(derivable "MU") :=
begin
  intro h,
  cases (count_equiv_one_or_two_mod3_of_derivable _ h);
    contradiction,
end

/-!
### Condition on `M`

That solves the MU puzzle, but we'll proceed by demonstrating the other necessary condition for a
string to be derivable, namely that the string must start with an M and contain no M in its tail.
-/

/--
`goodm xs` holds if `xs : miustr` begins with `M` and has no `M` in its tail.
-/
@[derive decidable_pred]
def goodm (xs : miustr) : Prop :=
list.head xs = M ∧ ¬(M ∈ list.tail xs)

/--
Demonstration that `"MI"` starts with `M` and has no `M` in its tail.
-/
lemma goodmi : goodm [M,I] :=
begin
  split,
  { refl },
  { rw [tail ,mem_singleton], trivial },
end

/-!
We'll show, for each `i` from 1 to 4, that if `en` follows by Rule `i` from `st` and if
`goodm st` holds, then so does `goodm en`.
-/

lemma goodm_of_rule1 (xs : miustr) (h₁ : derivable (xs ++ [I])) (h₂ : goodm (xs ++ [I]))
  : goodm (xs ++ [I,U]) :=
begin
  cases h₂ with mhead nmtail,
  have : xs ≠ nil,
  { intro h, rw h at *, rw [nil_append, head] at mhead, contradiction, },
  split,
  { rwa [head_append] at *; exact this, },
  { change [I,U] with [I] ++ [U],
    rw [←append_assoc, tail_append_singleton_of_ne_nil],
    { simp only [mem_append, nmtail, false_or, mem_singleton, not_false_iff], },
    { exact append_ne_nil_of_ne_nil_left _ _ this, }, },
end

lemma goodm_of_rule2 (xs : miustr) (h₁ : derivable (M :: xs))
  (h₂ : goodm (M :: xs)) : goodm (M :: xs ++ xs) :=
begin
  split,
  { refl, },
  { cases h₂ with mhead mtail,
    contrapose! mtail,
    rw cons_append at mtail,
    rw tail at *,
    exact (or_self _).mp (mem_append.mp mtail), },
end

lemma goodm_of_rule3  (as bs : miustr) (h₁ : derivable (as ++ [I,I,I] ++ bs))
  (h₂ : goodm (as ++ [I,I,I] ++ bs)) : goodm (as ++ U :: bs) :=
begin
  cases h₂ with mhead nmtail,
  have k : as ≠ nil ,
  { intro h, rw h at mhead, rw [nil_append] at mhead, contradiction, },
  split,
  { revert mhead, simp only [append_assoc,head_append _ k], exact id, },
  { contrapose! nmtail,
    rcases (exists_cons_of_ne_nil k) with ⟨x,xs,rfl⟩,
    simp only [cons_append, tail, mem_append, mem_cons_iff, false_or, mem_nil_iff, or_false] at *,
    exact nmtail, },
end

/-!
 The proof of the next lemma is identical, on the tactic level, to the previous proof.
-/

lemma goodm_of_rule4  (as bs : miustr) (h₁ : derivable (as ++ [U,U] ++ bs))
  (h₂ : goodm (as ++ [U,U] ++ bs)) : goodm (as ++ bs) :=
begin
  cases h₂ with mhead nmtail,
  have k : as ≠ nil ,
  { intro h, rw h at mhead, rw [nil_append] at mhead, contradiction, },
  split,
  { revert mhead, simp only [append_assoc,head_append _ k], exact id, },
  { contrapose! nmtail,
    rcases (exists_cons_of_ne_nil k) with ⟨x,xs,rfl⟩,
    simp only [cons_append, tail, mem_append, mem_cons_iff, false_or, mem_nil_iff, or_false] at *,
    exact nmtail, },
end

/--
Any derivable string must begin with `M` and have no `M` in its tail.
-/
theorem goodm_of_derivable (en : miustr): derivable en →
  goodm en:=
begin
  intro h,
  induction h,
  { exact goodmi, },
  { apply goodm_of_rule1; assumption, },
  { apply goodm_of_rule2; assumption, },
  { apply goodm_of_rule3; assumption, },
  { apply goodm_of_rule4; assumption, },
end

/-!
We put togther our two conditions to give one necessary condition `decstr` for an `miustr` to be
derivable.
-/

/--
`decstr en` is the condition that `count I en` is 1 or 2 modulo 3, that `en` starts with `M`, and
that `en` has no `M` in its tail. We automatically derive that this is a decidable predicate.
-/
@[derive decidable_pred]
def decstr (en : miustr) :=
goodm en ∧ ((count I en) % 3 = 1 ∨ (count I en) % 3 = 2)

/--
Suppose `en : miustr`. If `en` is `derivable`, then the condition `decstr en` holds.
-/
theorem decstr_of_der {en : miustr} : derivable en → decstr en :=
begin
  intro h,
  split,
  { exact goodm_of_derivable en h, },
  { exact count_equiv_one_or_two_mod3_of_derivable en h, },
end

end miu


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

! This file was ported from Lean 3 source module number_theory.sum_two_squares
! leanprover-community/mathlib commit 9101c48bb8cbb6a683d0afd58f8d521a16bd6eea
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.NumberTheory.Zsqrtd.GaussianInt

/-!
# Sums of two squares

Proof of Fermat's theorem on the sum of two squares. Every prime congruent to 1 mod 4 is the sum
of two squares.

# Todo

Fully characterize the natural numbers that are the sum of two squares: those such that for every
prime p congruent to 3 mod 4, the largest power of p dividing them is even.
-/

open GaussianInt

/-- **Fermat's theorem on the sum of two squares**. Every prime congruent to 1 mod 4 is the sum
of two squares. Also known as **Fermat's Christmas theorem**. -/
theorem Nat.Prime.sq_add_sq {p : ℕ} [Fact p.Prime] (hp : p % 4 = 1) :
    ∃ a b : ℕ, a ^ 2 + b ^ 2 = p :=
  by
  apply sq_add_sq_of_nat_prime_of_not_irreducible p
  rw [PrincipalIdealRing.irreducible_iff_prime, prime_iff_mod_four_eq_three_of_nat_prime p, hp]
  norm_num
#align nat.prime.sq_add_sq Nat.Prime.sq_add_sq


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

/-!
# Measure theory in the product of groups

In this file we show properties about measure theory in products of topological groups
and properties of iterated integrals in topological groups.

These lemmas show the uniqueness of left invariant measures on locally compact groups, up to
scaling. In this file we follow the proof and refer to the book *Measure Theory* by Paul Halmos.

The idea of the proof is to use the translation invariance of measures to prove `μ(F) = c * μ(E)`
for two sets `E` and `F`, where `c` is a constant that does not depend on `μ`. Let `e` and `f` be
the characteristic functions of `E` and `F`.
Assume that `μ` and `ν` are left-invariant measures. Then the map `(x, y) ↦ (y * x, x⁻¹)`
preserves the measure `μ.prod ν`, which means that
```
  ∫ x, ∫ y, h x y ∂ν ∂μ = ∫ x, ∫ y, h (y * x) x⁻¹ ∂ν ∂μ
```
If we apply this to `h x y := e x * f y⁻¹ / ν ((λ h, h * y⁻¹) ⁻¹' E)`, we can rewrite the RHS to
`μ(F)`, and the LHS to `c * μ(E)`, where `c = c(ν)` does not depend on `μ`.
Applying this to `μ` and to `ν` gives `μ (F) / μ (E) = ν (F) / ν (E)`, which is the uniqueness up to
scalar multiplication.

The proof in [Halmos] seems to contain an omission in §60 Th. A, see
`measure_theory.measure_lintegral_div_measure` and
https://math.stackexchange.com/questions/3974485/does-right-translation-preserve-finiteness-for-a-left-invariant-measure

## Todo

Much of the results in this file work in a group with measurable multiplication instead of a
topological group
-/

noncomputable theory
open topological_space set (hiding prod_eq) function
open_locale classical ennreal pointwise

namespace measure_theory

open measure

variables {G : Type*} [topological_space G] [measurable_space G] [second_countable_topology G]
variables [borel_space G] [group G] [topological_group G]
variables (μ ν : measure G) [sigma_finite ν] [sigma_finite μ]

/-- This condition is part of the definition of a measurable group in [Halmos, §59].
  There, the map in this lemma is called `S`. -/
@[to_additive map_prod_sum_eq]
lemma map_prod_mul_eq [is_mul_left_invariant ν] :
  map (λ z : G × G, (z.1, z.1 * z.2)) (μ.prod ν) = μ.prod ν :=
begin
  refine (prod_eq _).symm, intros s t hs ht,
  simp_rw [map_apply (measurable_fst.prod_mk (measurable_fst.mul measurable_snd)) (hs.prod ht),
    prod_apply ((measurable_fst.prod_mk (measurable_fst.mul measurable_snd)) (hs.prod ht)),
    preimage_preimage],
  conv_lhs { congr, skip, funext, rw [mk_preimage_prod_right_fn_eq_if ((*) x), measure_if] },
  simp_rw [measure_preimage_mul, lintegral_indicator _ hs, set_lintegral_const, mul_comm]
end

/-- The function we are mapping along is `SR` in [Halmos, §59],
  where `S` is the map in `map_prod_mul_eq` and `R` is `prod.swap`. -/
@[to_additive map_prod_add_eq_swap]
lemma map_prod_mul_eq_swap [is_mul_left_invariant μ] :
  map (λ z : G × G, (z.2, z.2 * z.1)) (μ.prod ν) = ν.prod μ :=
begin
  rw [← prod_swap],
  simp_rw [map_map (measurable_snd.prod_mk (measurable_snd.mul measurable_fst)) measurable_swap],
  exact map_prod_mul_eq ν μ
end

/-- The function we are mapping along is `S⁻¹` in [Halmos, §59],
  where `S` is the map in `map_prod_mul_eq`. -/
@[to_additive map_prod_neg_add_eq]
lemma map_prod_inv_mul_eq [is_mul_left_invariant ν] :
  map (λ z : G × G, (z.1, z.1⁻¹ * z.2)) (μ.prod ν) = μ.prod ν :=
(homeomorph.shear_mul_right G).to_measurable_equiv.map_apply_eq_iff_map_symm_apply_eq.mp $
  map_prod_mul_eq μ ν

/-- The function we are mapping along is `S⁻¹R` in [Halmos, §59],
  where `S` is the map in `map_prod_mul_eq` and `R` is `prod.swap`. -/
@[to_additive map_prod_neg_add_eq_swap]
lemma map_prod_inv_mul_eq_swap [is_mul_left_invariant μ] :
  map (λ z : G × G, (z.2, z.2⁻¹ * z.1)) (μ.prod ν) = ν.prod μ :=
begin
  rw [← prod_swap],
  simp_rw
    [map_map (measurable_snd.prod_mk $ measurable_snd.inv.mul measurable_fst) measurable_swap],
  exact map_prod_inv_mul_eq ν μ
end

/-- The function we are mapping along is `S⁻¹RSR` in [Halmos, §59],
  where `S` is the map in `map_prod_mul_eq` and `R` is `prod.swap`. -/
@[to_additive map_prod_add_neg_eq]
lemma map_prod_mul_inv_eq [is_mul_left_invariant μ] [is_mul_left_invariant ν] :
  map (λ z : G × G, (z.2 * z.1, z.1⁻¹)) (μ.prod ν) = μ.prod ν :=
begin
  let S := (homeomorph.shear_mul_right G).to_measurable_equiv,
  suffices : map ((λ z : G × G, (z.2, z.2⁻¹ * z.1)) ∘ (λ z : G × G, (z.2, z.2 * z.1))) (μ.prod ν) =
    μ.prod ν,
  { convert this, ext1 ⟨x, y⟩, simp },
  simp_rw [← map_map (measurable_snd.prod_mk (measurable_snd.inv.mul measurable_fst))
    (measurable_snd.prod_mk (measurable_snd.mul measurable_fst)), map_prod_mul_eq_swap μ ν,
    map_prod_inv_mul_eq_swap ν μ]
end

@[to_additive] lemma quasi_measure_preserving_inv [is_mul_left_invariant μ] :
  quasi_measure_preserving (has_inv.inv : G → G) μ μ :=
begin
  refine ⟨measurable_inv, absolutely_continuous.mk $ λ s hsm hμs, _⟩,
  rw [map_apply measurable_inv hsm, inv_preimage],
  have hf : measurable (λ z : G × G, (z.2 * z.1, z.1⁻¹)) :=
    (measurable_snd.mul measurable_fst).prod_mk measurable_fst.inv,
  suffices : map (λ z : G × G, (z.2 * z.1, z.1⁻¹)) (μ.prod μ) (s⁻¹ ×ˢ s⁻¹) = 0,
  { simpa only [map_prod_mul_inv_eq μ μ, prod_prod, mul_eq_zero, or_self] using this },
  have hsm' : measurable_set (s⁻¹ ×ˢ s⁻¹) := hsm.inv.prod hsm.inv,
  simp_rw [map_apply hf hsm', prod_apply_symm (hf hsm'), preimage_preimage, mk_preimage_prod,
    inv_preimage, set.inv_inv, measure_mono_null (inter_subset_right _ _) hμs, lintegral_zero]
end

@[to_additive]
lemma measure_inv_null [is_mul_left_invariant μ] {E : set G} :
  μ ((λ x, x⁻¹) ⁻¹' E) = 0 ↔ μ E = 0 :=
begin
  refine ⟨λ hE, _, (quasi_measure_preserving_inv μ).preimage_null⟩,
  convert (quasi_measure_preserving_inv μ).preimage_null hE,
  exact set.inv_inv.symm
end

@[to_additive]
lemma measurable_measure_mul_right {E : set G} (hE : measurable_set E) :
  measurable (λ x, μ ((λ y, y * x) ⁻¹' E)) :=
begin
  suffices : measurable (λ y,
    μ ((λ x, (x, y)) ⁻¹' ((λ z : G × G, ((1 : G), z.1 * z.2)) ⁻¹' ((univ : set G) ×ˢ E)))),
  { convert this, ext1 x, congr' 1 with y : 1, simp },
  apply measurable_measure_prod_mk_right,
  exact measurable_const.prod_mk (measurable_fst.mul measurable_snd) (measurable_set.univ.prod hE)
end

@[to_additive]
lemma lintegral_lintegral_mul_inv [is_mul_left_invariant μ] [is_mul_left_invariant ν]
  (f : G → G → ℝ≥0∞) (hf : ae_measurable (uncurry f) (μ.prod ν)) :
  ∫⁻ x, ∫⁻ y, f (y * x) x⁻¹ ∂ν ∂μ = ∫⁻ x, ∫⁻ y, f x y ∂ν ∂μ :=
begin
  have h : measurable (λ z : G × G, (z.2 * z.1, z.1⁻¹)) :=
  (measurable_snd.mul measurable_fst).prod_mk measurable_fst.inv,
  have h2f : ae_measurable (uncurry $ λ x y, f (y * x) x⁻¹) (μ.prod ν),
  { apply hf.comp_measurable' h (map_prod_mul_inv_eq μ ν).absolutely_continuous },
  simp_rw [lintegral_lintegral h2f, lintegral_lintegral hf],
  conv_rhs { rw [← map_prod_mul_inv_eq μ ν] },
  symmetry,
  exact lintegral_map' (hf.mono' (map_prod_mul_inv_eq μ ν).absolutely_continuous) h,
end

@[to_additive]
lemma measure_mul_right_null [is_mul_left_invariant μ] {E : set G} (y : G) :
  μ ((λ x, x * y) ⁻¹' E) = 0 ↔ μ E = 0 :=
calc μ ((λ x, x * y) ⁻¹' E) = 0 ↔ μ (has_inv.inv ⁻¹' ((λ x, y⁻¹ * x) ⁻¹' (has_inv.inv ⁻¹' E))) = 0 :
  by simp only [preimage_preimage, mul_inv_rev, inv_inv]
... ↔ μ E = 0 : by simp only [measure_inv_null μ, measure_preimage_mul]

@[to_additive]
lemma measure_mul_right_ne_zero [is_mul_left_invariant μ] {E : set G}
  (h2E : μ E ≠ 0) (y : G) : μ ((λ x, x * y) ⁻¹' E) ≠ 0 :=
(not_iff_not_of_iff (measure_mul_right_null μ y)).mpr h2E

/-- A technical lemma relating two different measures. This is basically [Halmos, §60 Th. A].
  Note that if `f` is the characteristic function of a measurable set `F` this states that
  `μ F = c * μ E` for a constant `c` that does not depend on `μ`.
  There seems to be a gap in the last step of the proof in [Halmos].
  In the last line, the equality `g(x⁻¹)ν(Ex⁻¹) = f(x)` holds if we can prove that
  `0 < ν(Ex⁻¹) < ∞`. The first inequality follows from §59, Th. D, but I couldn't find the second
  inequality. For this reason, we use a compact `E` instead of a measurable `E` as in [Halmos], and
  additionally assume that `ν` is a regular measure (we only need that it is finite on compact
  sets). -/
@[to_additive]
lemma measure_lintegral_div_measure [t2_space G] [is_mul_left_invariant μ]
  [is_mul_left_invariant ν] [regular ν] {E : set G} (hE : is_compact E) (h2E : ν E ≠ 0)
  (f : G → ℝ≥0∞) (hf : measurable f) :
  μ E * ∫⁻ y, f y⁻¹ / ν ((λ h, h * y⁻¹) ⁻¹' E) ∂ν = ∫⁻ x, f x ∂μ :=
begin
  have Em := hE.measurable_set,
  symmetry,
  set g := λ y, f y⁻¹ / ν ((λ h, h * y⁻¹) ⁻¹' E),
  have hg : measurable g := (hf.comp measurable_inv).div
    ((measurable_measure_mul_right ν Em).comp measurable_inv),
  rw [← set_lintegral_one, ← lintegral_indicator _ Em,
    ← lintegral_lintegral_mul (measurable_const.indicator Em).ae_measurable hg.ae_measurable,
    ← lintegral_lintegral_mul_inv μ ν],
  swap, { exact (((measurable_const.indicator Em).comp measurable_fst).mul
      (hg.comp measurable_snd)).ae_measurable },
  have mE : ∀ x : G, measurable (λ y, ((λ z, z * x) ⁻¹' E).indicator (λ z, (1 : ℝ≥0∞)) y) :=
  λ x, measurable_const.indicator (measurable_mul_const _ Em),
  have : ∀ x y, E.indicator (λ (z : G), (1 : ℝ≥0∞)) (y * x) =
    ((λ z, z * x) ⁻¹' E).indicator (λ (b : G), 1) y,
  { intros x y, symmetry, convert indicator_comp_right (λ y, y * x), ext1 z, refl },
  have h3E : ∀ y, ν ((λ x, x * y) ⁻¹' E) ≠ ∞ :=
    λ y, (is_compact.measure_lt_top $ (homeomorph.mul_right _).compact_preimage.mpr hE).ne,
  simp_rw [this, lintegral_mul_const _ (mE _), lintegral_indicator _ (measurable_mul_const _ Em),
    set_lintegral_one, g, inv_inv,
    ennreal.mul_div_cancel' (measure_mul_right_ne_zero ν h2E _) (h3E _)]
end

/-- This is roughly the uniqueness (up to a scalar) of left invariant Borel measures on a second
  countable locally compact group. The uniqueness of Haar measure is proven from this in
  `measure_theory.measure.haar_measure_unique` -/
@[to_additive]
lemma measure_mul_measure_eq [t2_space G] [is_mul_left_invariant μ]
  [is_mul_left_invariant ν] [regular ν] {E F : set G}
  (hE : is_compact E) (hF : measurable_set F) (h2E : ν E ≠ 0) : μ E * ν F = ν E * μ F :=
begin
  have h1 := measure_lintegral_div_measure ν ν hE h2E (F.indicator (λ x, 1))
    (measurable_const.indicator hF),
  have h2 := measure_lintegral_div_measure μ ν hE h2E (F.indicator (λ x, 1))
    (measurable_const.indicator hF),
  rw [lintegral_indicator _ hF, set_lintegral_one] at h1 h2,
  rw [← h1, mul_left_comm, h2],
end

end measure_theory


variables (men : Type) (barber : men)
variable  (shaves : men → men → Prop)

example (h : ∀ x : men, shaves barber x ↔ ¬ shaves x x) : false :=
have hc: shaves barber barber ↔ ¬ shaves barber barber, from h barber,
have h1: shaves barber barber -> false, from λ l, hc.mp l l,
have h2: shaves barber barber, from hc.mpr h1,
h1 h2


import mynat.mul

namespace mynat

def pow : mynat → mynat → mynat
| m zero := one
| m (succ n) := pow m n * m

instance : has_pow mynat mynat := ⟨pow⟩
-- notation a ^ b := pow a b

example : (1 : mynat) ^ (1 : mynat) = 1 :=
begin
refl
end

lemma pow_zero (m : mynat) : m ^ (0 : mynat) = 1 := rfl

lemma pow_succ (m n : mynat) : m ^ (succ n) = m ^ n * m := rfl

end mynat


/-
Copyright (c) 2021 OpenAI. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kunhao Zheng, Stanislas Polu, David Renshaw, OpenAI GPT-f
-/
import mathzoo.imports.miniF2F

open_locale nat rat real big_operators topological_space

theorem mathd_algebra_513
  (a b : ℝ)
  (h₀ : 3 * a + 2 * b = 5)
  (h₁ : a + b = 2) :
  a = 1 ∧ b = 1 :=
begin
  split; linarith,
end


import lib.m154 analysis.specific_limits topology.sequences
open m154

def majorant (A : set ℝ) (x : ℝ) := ∀ a ∈ A, a ≤ x
def borne_sup (A : set ℝ) (x : ℝ) := majorant A x ∧ ∀ y, majorant A y → x ≤ y

lemma lt_sup {A : set ℝ} {x : ℝ} (hx : borne_sup A x) :
∀ y, y < x → ∃ a ∈ A, y < a :=
begin
  intro y,
  contrapose!,
  exact hx.right y,
end

lemma inferieur_si_inferieur_plus_eps {x y : ℝ} :
  (∀ ε > 0, y ≤ x + ε) →  y ≤ x :=
begin
  contrapose!,
  intro h,
  use (y-x)/2,
  split,
    linarith,
  linarith,
end

-- Si u tend vers x et u_n ≤ y pour tout n alors x ≤ y.
lemma lim_le {x y : ℝ} {u : ℕ → ℝ} (hu : limite_suite u x)
  (ineg : ∀ n, u n ≤ y) : x ≤ y :=
begin
  apply inferieur_si_inferieur_plus_eps,
  intros ε ε_pos,
  cases hu ε ε_pos with N hN,
  specialize hN N (by linarith),
  specialize ineg N,
  rw abs_inferieur_ssi at hN,
  linarith,
end

def limite_infinie_suite (u : ℕ → ℝ) := ∀ A, ∃ N, ∀ n ≥ N, u n ≥ A

lemma limite_infinie_pas_finie {u : ℕ → ℝ} :
  limite_infinie_suite u → ∀ x, ¬ limite_suite u x :=
begin
  intros lim_infinie x lim_x,
  cases lim_x 1 (by linarith) with N hN,
  cases lim_infinie (x+2) with N' hN',
  let N₀ := max N N',
  specialize hN N₀ (inferieur_max_gauche _ _),
  specialize hN' N₀ (inferieur_max_droite _ _),
  rw abs_inferieur_ssi at hN,
  linarith,
end

lemma inv_succ_pos : ∀ n : ℕ, 1/(n + 1 : ℝ) > 0 :=
by apply nat.one_div_pos_of_nat

lemma limite_inv_succ :  ∀ ε > 0, ∃ N : ℕ, ∀ n ≥ N, 1/(n + 1 : ℝ) ≤ ε :=
begin
  convert metric.tendsto_at_top.mp (tendsto_one_div_add_at_top_nhds_0_nat),
  apply propext,
  simp only [real.dist_eq, sub_zero],
  split,
    intros h ε ε_pos,
    cases h (ε/2) (by linarith) with N hN,
    use N,
    intros n hn,
    rw abs_of_pos (inv_succ_pos n),
    specialize hN n hn,
    linarith,
  intros h ε ε_pos,
  cases h ε (by linarith) with N hN,
  use N,
  intros n hn,
  specialize hN n hn,
  rw abs_of_pos (inv_succ_pos n) at hN,
  linarith,
end

lemma lim_constante (x : ℝ) : limite_suite (λ n, x) x :=
λ ε ε_pos, ⟨0, λ _ _, by simp [le_of_lt ε_pos]⟩

lemma limite_si_inferieur_un_sur {u : ℕ → ℝ} {x : ℝ} (h : ∀ n, |u n - x| ≤ 1/(n+1)) :
limite_suite u x :=
begin
  intros ε ε_pos,
  rcases limite_inv_succ ε ε_pos with ⟨N, hN⟩,
  use N,
  intros n hn,
  specialize h n,
  specialize hN n hn,
  linarith,
end

lemma lim_plus_un_sur (x : ℝ) : limite_suite (λ n, x + 1/(n+1)) x :=
limite_si_inferieur_un_sur (λ n, by rw abs_of_pos ; linarith [inv_succ_pos n])

lemma lim_moins_un_sur (x : ℝ) : limite_suite (λ n, x - 1/(n+1)) x :=
begin
  refine limite_si_inferieur_un_sur (λ n, _),
  rw [show x - 1 / (n + 1) - x = -(1/(n+1)), by ring, abs_neg,  abs_of_pos],
  linarith [inv_succ_pos n]
end

lemma gendarmes {u v w : ℕ → ℝ} {l : ℝ}
(lim_u : limite_suite u l) (lim_w : limite_suite w l)
(hu : ∀ n, u n ≤ v n) (hw : ∀ n, v n ≤ w n)  : limite_suite v l :=
begin
  intros ε ε_pos,
  cases lim_u ε ε_pos with N hN,
  cases lim_w ε ε_pos with N' hN',
  use max N N',
  intros n hn,
  rw superieur_max_ssi at hn,
  cases hn with hn hn',
  specialize hN n (by linarith),
  specialize hN' n (by linarith),
  specialize hu n,
  specialize hw n,
  rw abs_inferieur_ssi at *,
  cases hN with hNl hNd,
  cases hN' with hN'l hN'd,
  split,
  -- Ici linarith peut finir, mais sur papier on écrirait
  calc -ε ≤ u n - l : by linarith
      ... ≤ v n - l : by linarith,
  calc v n - l ≤ w n - l : by linarith
      ... ≤ ε : by linarith,
end

-- Dans la suite, φ désignera toujours une fonction de ℕ dans ℕ
variable { φ : ℕ → ℕ}
variables {u : ℕ → ℝ} {l : ℝ}
open filter

/-- Si `u` tend vers `l` alors toutes ses suites extraites tendent vers `l`. -/
lemma limite_extraction_si_limite (h : limite_suite u l) (hφ : extraction φ) :
limite_suite (u ∘ φ) l :=
begin
  intros ε ε_pos,
  cases h ε ε_pos with N hN,
  use N,
  intros n hn,
  apply hN,
  calc N ≤ n   : hn -- on peut écrire « by exact hn » si on a un clavier solide
     ... ≤ φ n : extraction_superieur_id hφ n, -- idem
end

def segment (a b : ℝ) := {x | a ≤ x ∧ x ≤ b}

notation `[`a `, ` b `]` := segment a b

lemma bolzano_weierstrass {a b : ℝ} {u : ℕ → ℝ} (h : ∀ n, u n ∈ [a, b]) :
∃ c ∈ [a, b], valeur_adherence u c :=
begin
  rcases (is_compact_Icc : is_compact ([a, b])).tendsto_subseq h with ⟨c, c_in, φ, hφ, lim⟩,
  use [c, c_in, φ, hφ],
  simp_rw [metric.tendsto_nhds, eventually_at_top, real.dist_eq] at lim,
  intros ε ε_pos,
  rcases lim ε ε_pos with ⟨N, hN⟩,
  use N,
  intros n hn,
  exact le_of_lt (hN n hn)
end

lemma limite_suite_id : ∀ A : ℝ, ∃ N : ℕ, ∀ n ≥ N, (n : ℝ) ≥ A:=
begin
  intro A,
  cases exists_nat_gt A with N hN,
  use N,
  intros n hn,
  have : (n : ℝ) ≥ N, exact_mod_cast hn,  --- pfff
  linarith,
end

open real

lemma sup_segment {a b : ℝ} {A : set ℝ} (hnonvide : ∃ x, x ∈ A) (h : A ⊆ [a, b]) :
  ∃ x ∈ [a, b], borne_sup A x :=
begin
  have b_maj :  ∀ (y : ℝ), y ∈ A → y ≤ b,
    from λ y y_in, (h y_in).2,
  have Sup_maj : majorant A (Sup A),
    from (cSup_le_iff ⟨b, b_maj⟩ hnonvide).mp le_rfl,
  refine ⟨Sup A, _, _⟩,
  { split,
    { cases hnonvide with x x_in,
      exact le_trans (h x_in).1 (Sup_maj _ x_in) },
    { exact cSup_le hnonvide b_maj } },
  { use Sup_maj,
    intros y y_in,
    exact cSup_le hnonvide y_in },
end


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

! This file was ported from Lean 3 source module algebra.star.prod
! leanprover-community/mathlib commit 9abfa6f0727d5adc99067e325e15d1a9de17fd8e
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.Star.Basic
import Mathlib.Algebra.Ring.Prod
import Mathlib.Algebra.Module.Prod

/-!
# `Star` on product types

We put a `Star` structure on product types that operates elementwise.
-/

universe u v w

variable {R : Type u} {S : Type v}

namespace Prod

instance [Star R] [Star S] : Star (R × S) where star x := (star x.1, star x.2)

@[simp]
theorem fst_star [Star R] [Star S] (x : R × S) : (star x).1 = star x.1 :=
  rfl
#align prod.fst_star Prod.fst_star

@[simp]
theorem snd_star [Star R] [Star S] (x : R × S) : (star x).2 = star x.2 :=
  rfl
#align prod.snd_star Prod.snd_star

theorem star_def [Star R] [Star S] (x : R × S) : star x = (star x.1, star x.2) :=
  rfl
#align prod.star_def Prod.star_def

instance [Star R] [Star S] [TrivialStar R] [TrivialStar S] : TrivialStar (R × S)
    where star_trivial _ := Prod.ext (star_trivial _) (star_trivial _)

instance [InvolutiveStar R] [InvolutiveStar S] : InvolutiveStar (R × S)
    where star_involutive _ := Prod.ext (star_star _) (star_star _)

instance [Semigroup R] [Semigroup S] [StarSemigroup R] [StarSemigroup S] : StarSemigroup (R × S)
    where star_mul _ _ := Prod.ext (star_mul _ _) (star_mul _ _)

instance [AddMonoid R] [AddMonoid S] [StarAddMonoid R] [StarAddMonoid S] : StarAddMonoid (R × S)
    where star_add _ _ := Prod.ext (star_add _ _) (star_add _ _)

instance [NonUnitalSemiring R] [NonUnitalSemiring S] [StarRing R] [StarRing S] : StarRing (R × S) :=
  { inferInstanceAs (StarAddMonoid (R × S)),
    inferInstanceAs (StarSemigroup (R × S)) with }

instance {α : Type w} [SMul α R] [SMul α S] [Star α] [Star R] [Star S]
    [StarModule α R] [StarModule α S] : StarModule α (R × S)
    where star_smul _ _ := Prod.ext (star_smul _ _) (star_smul _ _)

end Prod

--Porting note: removing @[simp], `simp` simplifies LHS
theorem Units.embed_product_star [Monoid R] [StarSemigroup R] (u : Rˣ) :
    Units.embedProduct R (star u) = star (Units.embedProduct R u) :=
  rfl
#align units.embed_product_star Units.embed_product_star


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

/-!
# seminorm_from_bounded
In this file, we prove [BGR, Proposition 1.2.1/2] : given a nonzero additive group seminorm on a
commutative ring `R` such that for some positive `c : ℝ`,and every `x y : R`, the inequality
`f (x * y) ≤ c * f x * f y)` is satisfied, we create a ring seminorm on `R`.

In the file comments, we will use the expression `f is multiplicatively bounded` to indicate that
`∃ (c : ℝ) (hc : 0 < c), ∀ (x y : R), f (x * y) ≤ c * f x * f y`.

## Main Definitions

* `seminorm_from_bounded'` : the real-valued function sending `x ∈ R` to the supremum of
  `f(x*y)/f(y)`, where `y` runs over the elements of `R`.
* `seminorm_from_bounded` : the function `seminorm_from_bounded'` is a `ring_seminorm` on `R`.
* `norm_from_bounded` :`seminorm_from_bounded' f` is a ring_norm on `R`, provided that `f` is
  nonnegative, multiplicatively bounded and subadditive, that it preserves `0` and negation, and
  that `f` has trivial kernel.

## Main Results

* `seminorm_from_bounded_is_nonarchimedean` : if `f : R → ℝ` is a nonnegative, multiplicatively
  bounded, nonarchimedean function, then `seminorm_from_bounded' f` is nonarchimedean.
* `seminorm_from_bounded_of_mul_is_mul` : if `f : R → ℝ` is a nonnegative, multiplicatively bounded
  function and `x : R` is multiplicative for `f`, then `x` is multiplicative for
  `seminorm_from_bounded' f`.

## References
* [S. Bosch, U. Güntzer, R. Remmert, *Non-Archimedean Analysis*][bosch-guntzer-remmert]

## Tags

seminorm_from_const, seminorm, nonarchimedean
-/

noncomputable theory

open function

open_locale topological_space nnreal

namespace normed_group_hom

/-- The inverse of `f : normed_add_group_hom V W` as a `normed_add_group_hom W V`. The map `f` must
  be bijective and bounded in the sense that `∃ (C : ℝ), ∀ v, ‖v‖ ≤ C * ‖f v‖`. -/
def normed_group_hom_inv_of_bijective_bounded {V : Type*} {W : Type*} [seminormed_add_comm_group V]
  [seminormed_add_comm_group W] (f : normed_add_group_hom V W) (h_bij : bijective f)
  (h_bdd : ∃ (C : ℝ), ∀ v, ‖v‖ ≤ C * ‖f v‖) : normed_add_group_hom W V :=
{ to_fun   := inv_fun f,
  map_add' := (add_monoid_hom.inverse f.to_add_monoid_hom (inv_fun f)
    (left_inverse_inv_fun h_bij.injective) (right_inverse_inv_fun h_bij.surjective)).map_add,
  bound'   := begin
    obtain ⟨C, hC⟩ := h_bdd,
    use C,
    intro w,
    set v := inv_fun f w with hv,
    rw ← right_inverse_inv_fun h_bij.surjective w,
    exact hC v,
  end }

/-- The inverse of `f : normed_add_group_hom V W` is bijective and there exists a real `C` such that
 `∀ v : W, ‖v‖ ≤ C * ‖f v‖`, then the inverse of `f` is continuous. -/
lemma continuous_inv_of_bijective_bounded {V : Type*} {W : Type*} [seminormed_add_comm_group V]
  [seminormed_add_comm_group W] {f : normed_add_group_hom V W} (h_bij : bijective f)
  (h_bdd : ∃ (C : ℝ), ∀ v, ‖v‖ ≤ C * ‖f v‖) : continuous (inv_fun f) :=
begin
  set g : normed_add_group_hom W V :=
  { to_fun   := inv_fun f,
    map_add' := λ x y, begin
      rw [← (classical.some_spec (((bijective_iff_exists_unique _).mp h_bij) x)).1,
        ← (classical.some_spec (((bijective_iff_exists_unique _).mp h_bij) y)).1],
      simp only [← (inv_fun f).comp_app f, inv_fun_comp h_bij.injective, id.def, ← map_add],
    end,
    bound'   := begin
      use classical.some h_bdd,
      intro w,
      rw ← (classical.some_spec (((bijective_iff_exists_unique _).mp h_bij) w)).1,
      simp only [← (inv_fun f).comp_app  f, inv_fun_comp h_bij.injective, id.def],
      exact classical.some_spec h_bdd _,
    end } with hg,
  change continuous g,
  apply normed_add_group_hom.continuous,
end

/-- We regard a bijective `f : normed_add_group_hom V W` such that
  `∃ (C : ℝ), ∀ v, ‖v‖ ≤ C * ‖f v‖` as a homeomorphism. -/
def homeo_of_bijective_bounded {V : Type*} {W : Type*} [seminormed_add_comm_group V]
  [seminormed_add_comm_group W] {f : normed_add_group_hom V W} (h_bij : bijective f)
  (h_bdd : ∃ (C : ℝ), ∀ v, ‖v‖ ≤ C * ‖f v‖) : homeomorph V W :=
{ to_fun             := f.to_fun,
  inv_fun            := inv_fun f.to_fun,
  left_inv           := left_inverse_inv_fun h_bij.injective,
  right_inv          := right_inverse_inv_fun h_bij.surjective,
  continuous_to_fun  := f.continuous,
  continuous_inv_fun := normed_group_hom.continuous_inv_of_bijective_bounded h_bij h_bdd }

end normed_group_hom

variables {R : Type*} [comm_ring R] (f : R → ℝ)

section seminorm_from_bounded

/-- The real-valued function sending `x ∈ R` to the supremum of  `f(x*y)/f(y)`, where `y` runs over
  the elements of `R`.-/
def seminorm_from_bounded' : R → ℝ := λ x, supr (λ (y : R), f(x*y)/f(y))

variables {f}

/-- If `f : R → ℝ` is a nonzero, nonnegative, multiplicatively bounded function, then `f 1 ≠ 0`. -/
lemma f_one_ne_zero (f_ne_zero : ∃ (x : R), f x ≠ 0) (f_nonneg : ∀ (x : R), 0 ≤ f x)
  (f_mul : ∃ (c : ℝ) (hc : 0 < c), ∀ (x y : R), f (x * y) ≤ c * f x * f y) : f 1 ≠ 0 :=
begin
  intro h1,
  obtain ⟨c, hc, hxy⟩ := f_mul,
  specialize hxy 1,
  simp_rw [h1, one_mul, mul_zero, zero_mul] at hxy,
  obtain ⟨z, hz⟩ := f_ne_zero,
  exact hz (le_antisymm (hxy z) (f_nonneg z)),
end

/-- If `f : R → ℝ` is a nonnegative multiplicatively bounded function and `x : R` is a unit with
  `f x ≠ 0`, then for every `n : ℕ`, we have `f (x ^ n) ≠ 0`. -/
lemma f_pow_ne_zero (f_nonneg : ∀ (x : R), 0 ≤ f x) {x : R} (hx : is_unit x) (hfx : f x ≠ 0) (n : ℕ)
  (f_mul : ∃ (c : ℝ) (hc : 0 < c), ∀ (x y : R), f (x * y) ≤ c * f x * f y) : f (x ^ n) ≠ 0 :=
begin
  have h1 : f 1 ≠ 0 := f_one_ne_zero (exists.intro x hfx) f_nonneg f_mul,
  intro hxn,
  obtain ⟨c, hc, hxy⟩ := f_mul,
  obtain ⟨u, hu⟩ := hx,
  specialize hxy (x^n) (u.inv^n),
  rw [hxn, mul_zero, zero_mul, ← mul_pow, ← hu, units.inv_eq_coe_inv, units.mul_inv,
    one_pow] at hxy,
  exact h1 (le_antisymm  hxy (f_nonneg 1)),
end

/-- `seminorm_from_bounded' f` preserves `0`. -/
lemma seminorm_from_bounded_zero (f_zero : f 0 = 0) :
  seminorm_from_bounded' f (0 : R) = 0 :=
by simp_rw [seminorm_from_bounded', zero_mul, f_zero, zero_div, csupr_const]

/-- If `f : R → ℝ` is a nonnegative, multiplicatively bounded function, then for every `x : R`,
  the image of `y ↦ f (x * y) / f y` is bounded above. -/
lemma seminorm_from_bounded_bdd_range (f_nonneg : ∀ (x : R), 0 ≤ f x)
  (f_mul : ∃ (c : ℝ) (hc : 0 < c), ∀ (x y : R), f (x * y) ≤ c * f x * f y) (x : R) :
  bdd_above (set.range (λ y, f (x * y) / f y)) :=
begin
  obtain ⟨c, hc_pos, hxy⟩ := f_mul,
  use c * f x,
  rintros r ⟨y, hy⟩,
  simp only [← hy],
  by_cases hy0 : f y = 0,
  { rw [← hy0.symm, div_zero],
    apply mul_nonneg (le_of_lt hc_pos) (f_nonneg x), },
  { simpa [div_le_iff (lt_of_le_of_ne (f_nonneg y) (ne.symm hy0))] using hxy x y, },
end

/-- If `f : R → ℝ` is a nonnegative, multiplicatively bounded function, then for every `x : R`,
  `seminorm_from_bounded' f x` is bounded above by some multiple of `f x`. -/
lemma seminorm_from_bounded_le (f_nonneg : ∀ (x : R), 0 ≤ f x)
  (f_mul : ∃ (c : ℝ) (hc : 0 < c), ∀ (x y : R), f (x * y) ≤ c * f x * f y) (x : R) :
  seminorm_from_bounded' f x ≤ (classical.some f_mul) * f x :=
begin
  have h := classical.some_spec(classical.some_spec f_mul),
  apply csupr_le,
  intro y,
  by_cases hy : 0 = f y,
  { rw [← hy, div_zero],
    exact mul_nonneg (le_of_lt (classical.some (classical.some_spec f_mul))) (f_nonneg _), },
  { rw div_le_iff (lt_of_le_of_ne (f_nonneg _) hy),
    exact (classical.some_spec (classical.some_spec f_mul)) x y  }
end

/-- If `f : R → ℝ` is a nonnegative, multiplicatively bounded function, then for every `x : R`,
  `f x ≤ f 1 * seminorm_from_bounded' f x`. -/
lemma seminorm_from_bounded_ge (f_nonneg : ∀ (x : R), 0 ≤ f x)
  (f_mul : ∃ (c : ℝ) (hc : 0 < c), ∀ (x y : R), f (x * y) ≤ c * f x * f y) (x : R) :
  f x ≤ f 1 * seminorm_from_bounded' f x :=
begin
  by_cases h1 : f 1 = 0,
  { obtain ⟨c, hc_pos, hxy⟩ := f_mul,
    specialize hxy x 1,
    rw [mul_one, h1, mul_zero] at hxy,
    have hx0 : f x = 0 := le_antisymm hxy (f_nonneg _),
    rw [hx0, h1, zero_mul] },
  { rw [mul_comm,  ← div_le_iff (lt_of_le_of_ne' (f_nonneg _) h1)],
    have h_bdd : bdd_above (set.range (λ y, f (x * y) / f y)),
    { exact seminorm_from_bounded_bdd_range f_nonneg f_mul x},
    convert le_csupr h_bdd (1 : R),
    rw mul_one,  } ,
end

/-- If `f : R → ℝ` is a nonnegative, multiplicatively bounded function, then
  `seminorm_from_bounded' f` is nonnegative. -/
lemma seminorm_from_bounded_nonneg (f_nonneg : ∀ (x : R), 0 ≤ f x)
  (f_mul : ∃ (c : ℝ) (hc : 0 < c), ∀ (x y : R), f (x * y) ≤ c * f x * f y) (x : R) :
  0 ≤ seminorm_from_bounded' f x :=
le_cSup_of_le (seminorm_from_bounded_bdd_range f_nonneg f_mul x) ⟨1, rfl⟩
  (div_nonneg (f_nonneg _) (f_nonneg _))

/-- If `f : R → ℝ` is a nonnegative, multiplicatively bounded function, then given `x y : R` with
  `f x = 0`, we have `f (x * y) = 0`. -/
lemma f_mul_zero_of_f_zero (f_nonneg : ∀ (x : R), 0 ≤ f x)
  (f_mul : ∃ (c : ℝ) (hc : 0 < c), ∀ (x y : R), f (x * y) ≤ c * f x * f y)
  {x : R} (hx : f x = 0) (y : R) : f (x * y) = 0 :=
begin
  obtain ⟨c, hc, hxy⟩ := f_mul,
  specialize hxy x y,
  rw [hx, mul_zero, zero_mul] at hxy,
  exact le_antisymm hxy (f_nonneg _),
end

/-- If `f : R → ℝ` is a nonnegative, multiplicatively bounded function, then
  `seminorm_from_bounded' f x = 0` if and only if `f x = 0`. -/
lemma seminorm_from_bounded_eq_zero_iff (f_nonneg : ∀ (x : R), 0 ≤ f x)
(f_mul : ∃ (c : ℝ) (hc : 0 < c), ∀ (x y : R), f (x * y) ≤ c * f x * f y) (x : R) :
  seminorm_from_bounded' f x = 0 ↔ f x = 0 :=
begin
  refine ⟨λ h, _, λ h, _⟩,
  { have hf := seminorm_from_bounded_ge f_nonneg f_mul x,
    rw [h, mul_zero] at hf,
    exact le_antisymm hf (f_nonneg _) },
  { have hf : seminorm_from_bounded' f x ≤ classical.some f_mul * f x :=
    seminorm_from_bounded_le f_nonneg f_mul x,
    rw [h, mul_zero] at hf,
    exact le_antisymm hf (seminorm_from_bounded_nonneg f_nonneg f_mul x), }
end

/-- If `f` is invariant under negation of `x`, then so is `seminorm_from_bounded'`.-/
lemma seminorm_from_bounded_neg (f_neg : ∀ (x : R), f (-x) = f x) (x : R) :
  seminorm_from_bounded' f (-x) = seminorm_from_bounded' f x :=
begin
  simp only [seminorm_from_bounded'],
  congr, ext y,
  rw [neg_mul, f_neg],
end

/-- If `f : R → ℝ` is a nonnegative, multiplicatively bounded function, then
  `seminorm_from_bounded' f` is submultiplicative. -/
lemma seminorm_from_bounded_mul (f_nonneg : ∀ (x : R), 0 ≤ f x)
  (f_mul : ∃ (c : ℝ) (hc : 0 < c), ∀ (x y : R), f (x * y) ≤ c * f x * f y) (x y : R) :
  seminorm_from_bounded' f (x * y) ≤ seminorm_from_bounded' f x * seminorm_from_bounded' f y :=
begin
  apply csupr_le,
  by_cases hy : seminorm_from_bounded' f y = 0,
  { rw seminorm_from_bounded_eq_zero_iff f_nonneg f_mul at hy,
    intro z,
    have hz : f (y * (x * z)) = 0 := f_mul_zero_of_f_zero f_nonneg f_mul hy (x*z),
    rw [mul_comm x y, mul_assoc, hz, zero_div],
    exact mul_nonneg (seminorm_from_bounded_nonneg f_nonneg f_mul x)
      (seminorm_from_bounded_nonneg f_nonneg f_mul y),  },
  { intro z,
    rw ← div_le_iff (lt_of_le_of_ne' (seminorm_from_bounded_nonneg f_nonneg f_mul _) hy),
    apply le_csupr_of_le (seminorm_from_bounded_bdd_range f_nonneg f_mul x) z,
    rw [div_le_iff (lt_of_le_of_ne' (seminorm_from_bounded_nonneg f_nonneg f_mul _) hy),
      div_mul_eq_mul_div],
    by_cases hz : f z = 0,
    { have hxyz : f (z * (x * y)) = 0 := f_mul_zero_of_f_zero f_nonneg f_mul hz _,
      simp_rw [mul_comm, hxyz, zero_div],
      exact div_nonneg (mul_nonneg (seminorm_from_bounded_nonneg f_nonneg f_mul y) (f_nonneg _))
        (f_nonneg _), },
    { rw [div_le_div_right (lt_of_le_of_ne' (f_nonneg _) hz), mul_comm (f (x * z))],
      by_cases hxz : f (x * z) = 0,
      { have hxyz : f (x * z * y) = 0 := f_mul_zero_of_f_zero f_nonneg f_mul hxz y,
        rw [mul_comm x y, mul_assoc, mul_comm y, hxyz],
        exact mul_nonneg (seminorm_from_bounded_nonneg f_nonneg f_mul y) (f_nonneg _) },
      { rw ← div_le_iff (lt_of_le_of_ne' (f_nonneg _) hxz),
        apply le_csupr_of_le (seminorm_from_bounded_bdd_range f_nonneg f_mul y) (x * z),
        rw [div_le_div_right (lt_of_le_of_ne' (f_nonneg _) hxz), mul_comm x y, mul_assoc], }}},
end

/-- If `f : R → ℝ` is a nonzero, nonnegative, multiplicatively bounded function, then
  `seminorm_from_bounded' f 1 = 1`. -/
lemma seminorm_from_bounded_one_eq (f_ne_zero : ∃ (x : R), f x ≠ 0) (f_nonneg : ∀ (x : R), 0 ≤ f x)
  (f_mul : ∃ (c : ℝ) (hc : 0 < c), ∀ (x y : R), f (x * y) ≤ c * f x * f y) :
  seminorm_from_bounded' f 1 = 1 :=
begin
  simp_rw [seminorm_from_bounded', one_mul],
  have h_le : (⨆ (y : R), f y / f y) ≤ 1,
  { apply csupr_le,
    intro x, by_cases hx : f x = 0,
    { rw hx, rw div_zero, exact zero_le_one },
    { rw div_self hx }},
  have h_ge : 1 ≤ (⨆ (y : R), f y / f y),
  { rw ← div_self (f_one_ne_zero f_ne_zero f_nonneg f_mul),
    have h_bdd : bdd_above (set.range (λ y, f y / f y)),
    { use (1 : ℝ),
      rw mem_upper_bounds,
      rintros r ⟨y, hy⟩,
      simp_rw [← hy],
      by_cases hy : f y = 0,
    { rw [hy, div_zero], exact zero_le_one },
    { rw div_self hy }},
    exact le_csupr h_bdd (1 : R), },
  exact le_antisymm h_le h_ge,
end

/-- If `f : R → ℝ` is a nonnegative, multiplicatively bounded function, then
  `seminorm_from_bounded' f 1 ≤ 1`. -/
lemma seminorm_from_bounded_is_norm_le_one_class (f_nonneg : ∀ (x : R), 0 ≤ f x)
  (f_mul : ∃ (c : ℝ) (hc : 0 < c), ∀ (x y : R), f (x * y) ≤ c * f x * f y) :
  seminorm_from_bounded' f 1 ≤ 1 :=
begin
  by_cases f_ne_zero : ∃ (x : R), f x ≠ 0,
  { exact le_of_eq (seminorm_from_bounded_one_eq f_ne_zero f_nonneg f_mul)},
  { simp_rw [seminorm_from_bounded', one_mul],
    apply csupr_le,
    intro x,
    push_neg at f_ne_zero,
    { rw (f_ne_zero x), rw div_zero, exact zero_le_one }}
end

/-- If `f : R → ℝ` is a nonnegative, multiplicatively bounded, subadditive function, then
  `seminorm_from_bounded' f` is subadditive. -/
lemma seminorm_from_bounded_add (f_nonneg : ∀ (x : R), 0 ≤ f x)
  (f_mul : ∃ (c : ℝ) (hc : 0 < c), ∀ (x y : R), f (x * y) ≤ c * f x * f y)
  (f_add : ∀ a b, f (a + b) ≤ f a + f b) (x y : R) :
  seminorm_from_bounded' f (x + y) ≤ seminorm_from_bounded' f x + seminorm_from_bounded' f y :=
begin
  apply csupr_le,
  intro z,
  suffices hf : f ((x + y) * z) / f z ≤ f (x * z) / f z + f (y * z) / f z,
  { exact le_trans hf (add_le_add
      (le_csupr_of_le (seminorm_from_bounded_bdd_range f_nonneg f_mul x) z (le_refl _))
      (le_csupr_of_le (seminorm_from_bounded_bdd_range f_nonneg f_mul y) z (le_refl _))), },
  { by_cases hz : f z = 0,
    { simp only [hz, div_zero, zero_add, le_refl, or_self], },
    { rw [div_add_div_same, div_le_div_right (lt_of_le_of_ne' (f_nonneg _) hz), add_mul],
      exact f_add _ _ }}
end

/-- `seminorm_from_bounded'` is a ring seminorm on `R`. -/
def seminorm_from_bounded (f_zero : f 0 = 0) (f_nonneg : ∀ (x : R), 0 ≤ f x)
  (f_mul : ∃ (c : ℝ) (hc : 0 < c), ∀ (x y : R), f (x * y) ≤ c * f x * f y)
  (f_add : ∀ a b, f (a + b) ≤ f a + f b) (f_neg : ∀ (x : R), f (-x) = f x) : ring_seminorm R :=
{ to_fun    := seminorm_from_bounded' f,
  map_zero' := seminorm_from_bounded_zero f_zero,
  add_le'   := seminorm_from_bounded_add f_nonneg f_mul f_add,
  mul_le'   := seminorm_from_bounded_mul f_nonneg f_mul,
  neg'      := seminorm_from_bounded_neg f_neg }

/-- If `f : R → ℝ` is a nonnegative, multiplicatively bounded, nonarchimedean function, then
  `seminorm_from_bounded' f` is nonarchimedean. -/
lemma seminorm_from_bounded_is_nonarchimedean (f_nonneg : ∀ (x : R), 0 ≤ f x)
  (f_mul : ∃ (c : ℝ) (hc : 0 < c), ∀ (x y : R), f (x * y) ≤ c * f x * f y)
  (hna : is_nonarchimedean f) : is_nonarchimedean (seminorm_from_bounded' f) :=
begin
  intros x y,
  apply csupr_le,
  intro z,
  rw le_max_iff,
  suffices hf : f ((x + y) * z) / f z ≤ f (x * z) / f z ∨
    f ((x + y) * z) / f z ≤ f (y * z) / f z,
  cases hf with hfx hfy; [left, right],
  { exact le_csupr_of_le (seminorm_from_bounded_bdd_range f_nonneg f_mul x) z hfx },
  { exact le_csupr_of_le (seminorm_from_bounded_bdd_range f_nonneg f_mul y) z hfy },
  { by_cases hz : f z = 0,
    { simp only [hz, div_zero, le_refl, or_self], },
    { rw [div_le_div_right (lt_of_le_of_ne' (f_nonneg _) hz), div_le_div_right
        (lt_of_le_of_ne' (f_nonneg _) hz), add_mul, ← le_max_iff],
      exact hna _ _, }},
end

/-- If `f : R → ℝ` is a nonnegative, multiplicatively bounded function and `x : R` is
  multiplicative for `f`, then `seminorm_from_bounded' f x = f x`. -/
lemma seminorm_from_bounded_of_mul_apply (f_nonneg : ∀ (x : R), 0 ≤ f x)
  (f_mul : ∃ (c : ℝ) (hc : 0 < c), ∀ (x y : R), f (x * y) ≤ c * f x * f y) {x : R}
  (hx : ∀ (y : R), f (x * y) = f x * f y) : seminorm_from_bounded' f x = f x :=
begin
  simp_rw [seminorm_from_bounded', hx, ← mul_div_assoc'],
  have h_le : (⨆ (y : R), f x * (f y / f y)) ≤ f x,
  { apply csupr_le,
    intro x, by_cases hx : f x = 0,
    { rw [hx, div_zero, mul_zero], exact f_nonneg _, },
    { rw [div_self hx, mul_one] }},
  have h_ge : f x ≤ (⨆ (y : R), f x * (f y / f y)),
  { by_cases f_ne_zero : ∃ (x : R), f x ≠ 0,
    { conv_lhs { rw ← mul_one (f x) },
      rw ← div_self (f_one_ne_zero f_ne_zero f_nonneg f_mul),
      have h_bdd : bdd_above (set.range (λ y, f x * (f y / f y))),
      { use f x,
        rw mem_upper_bounds,
        rintros r ⟨y, hy⟩,
        simp_rw [← hy],
        by_cases hy0 : f y = 0,
      { rw [hy0, div_zero, mul_zero], exact f_nonneg _ },
      { rw [div_self hy0, mul_one] }},
      exact le_csupr h_bdd (1 : R), },
      { push_neg at f_ne_zero,
        simp_rw [f_ne_zero, zero_div, zero_mul, csupr_const], } },
  exact le_antisymm h_le h_ge,
end

/-- If `f : R → ℝ` is a nonnegative function and `x : R` is submultiplicative for `f`, then
  `seminorm_from_bounded' f x = f x`. -/
lemma seminorm_from_bounded_of_mul_le (f_nonneg : ∀ (x : R), 0 ≤ f x) {x : R}
  (hx : ∀ (y : R), f (x * y) ≤ f x * f y) (h_one : f 1 ≤ 1)  : seminorm_from_bounded' f x = f x :=
begin
  simp_rw [seminorm_from_bounded'],
  have h_le : (⨆ (y : R), f (x * y) / f y) ≤ f x,
  { apply csupr_le,
    intro y, by_cases hy : f y = 0,
    { rw [hy, div_zero], exact f_nonneg _, },
    {rw div_le_iff (lt_of_le_of_ne' (f_nonneg _) hy), exact hx _,  }},
  have h_ge : f x ≤ (⨆ (y : R), f (x * y) / f y),
  { have h_bdd : bdd_above (set.range (λ y, f (x * y) / f y)),
    { use (f x),
      rw mem_upper_bounds,
      rintros r ⟨y, hy⟩,
      simp only [← hy],
      by_cases hy0 : f y = 0,
      { rw [hy0, div_zero],
       exact f_nonneg _ },
      { rw [← mul_one (f x), ← div_self hy0, ← mul_div_assoc, div_le_iff
          (lt_of_le_of_ne' (f_nonneg _) hy0), mul_div_assoc, div_self hy0, mul_one],
          exact hx y,  }},
    convert le_csupr h_bdd (1 : R),
    by_cases h0 : f x = 0,
    { rw [mul_one, h0, zero_div],},
    { have heq : f 1 = 1,
      { apply le_antisymm h_one,
        specialize hx 1,
        rw [mul_one, le_mul_iff_one_le_right (lt_of_le_of_ne (f_nonneg _) (ne.symm h0))] at hx,
        exact hx, },
      rw [heq, mul_one, div_one], } },
  exact le_antisymm h_le h_ge,
end

/-- If `f : R → ℝ` is a nonzero, nonnegative, multiplicatively bounded function, then
  `seminorm_from_bounded' f` is nonzero. -/
lemma seminorm_from_bounded_ne_zero (f_ne_zero : ∃ x : R, f x ≠ 0) (f_nonneg : ∀ (x : R), 0 ≤ f x)
  (f_mul : ∃ (c : ℝ) (hc : 0 < c), ∀ (x y : R), f (x * y) ≤ c * f x * f y) :
  ∃ x : R, seminorm_from_bounded' f x ≠ 0 :=
begin
  obtain ⟨x, hx⟩ := f_ne_zero,
  use x,
  rw [ne.def, seminorm_from_bounded_eq_zero_iff f_nonneg f_mul x],
  exact hx,
end

/-- If `f : R → ℝ` is a nonnegative, multiplicatively bounded function, then the kernel of
  `seminorm_from_bounded' f` equals the kernel of `f`. -/
lemma seminorm_from_bounded_ker (f_nonneg : ∀ (x : R), 0 ≤ f x)
  (f_mul : ∃ (c : ℝ) (hc : 0 < c), ∀ (x y : R), f (x * y) ≤ c * f x * f y) :
  (seminorm_from_bounded' f)⁻¹' {0} = f⁻¹' {0} :=
begin
  ext x,
  simp only [set.mem_preimage, set.mem_singleton_iff],
  exact seminorm_from_bounded_eq_zero_iff f_nonneg f_mul x,
end

/-- If `f : R → ℝ` is a nonnegative, multiplicatively bounded, subadditive function that preserves
  zero and negation, then `seminorm_from_bounded' f` is a norm if and only if `f⁻¹' {0} = {0}`. -/
lemma seminorm_from_bounded_is_norm_iff (f_zero : f 0 = 0) (f_nonneg : ∀ (x : R), 0 ≤ f x)
  (f_mul : ∃ (c : ℝ) (hc : 0 < c), ∀ (x y : R), f (x * y) ≤ c * f x * f y)
  (f_add : ∀ a b, f (a + b) ≤ f a + f b) (f_neg : ∀ (x : R), f (-x) = f x) :
  (∀ (x : R), (seminorm_from_bounded f_zero f_nonneg f_mul f_add f_neg).to_fun x = 0 → x = 0) ↔
    f⁻¹' {0} = {0} :=
begin
  refine ⟨λ h0, _, λ h_ker, _⟩,
  { rw ← seminorm_from_bounded_ker f_nonneg f_mul,
    ext x,
    simp only [set.mem_preimage, set.mem_singleton_iff],
    exact ⟨λ h, h0 x h, λ h, by {rw h, exact seminorm_from_bounded_zero f_zero}⟩ },
  { intros x hx,
    rw [← set.mem_singleton_iff, ← h_ker, set.mem_preimage, set.mem_singleton_iff,
      ← seminorm_from_bounded_eq_zero_iff f_nonneg f_mul x],
    exact hx }
end

/-- `seminorm_from_bounded' f` is a ring_norm on `R`, provided that `f` is nonnegative,
  multiplicatively bounded and subadditive, that it preserves `0` and negation, and that `f` has
  trivial kernel. -/
def norm_from_bounded (f_zero : f 0 = 0) (f_nonneg : ∀ (x : R), 0 ≤ f x)
  (f_mul : ∃ (c : ℝ) (hc : 0 < c), ∀ (x y : R), f (x * y) ≤ c * f x * f y)
  (f_add : ∀ a b, f (a + b) ≤ f a + f b) (f_neg : ∀ (x : R), f (-x) = f x)
  (f_ker : f⁻¹' {0} = {0}) : ring_norm R :=
{ eq_zero_of_map_eq_zero' :=
  (seminorm_from_bounded_is_norm_iff f_zero f_nonneg f_mul f_add f_neg).mpr f_ker,
  ..(seminorm_from_bounded f_zero f_nonneg f_mul f_add f_neg) }

/-- If `f : R → ℝ` is a nonnegative, multiplicatively bounded function and `x : R` is
  multiplicative for `f`, then `x` is multiplicative for `seminorm_from_bounded' f`. -/
lemma seminorm_from_bounded_of_mul_is_mul (f_nonneg : ∀ (x : R), 0 ≤ f x)
  (f_mul : ∃ (c : ℝ) (hc : 0 < c), ∀ (x y : R), f (x * y) ≤ c * f x * f y) {x : R}
  (hx : ∀ (y : R), f (x * y) = f x * f y) (y : R) :
  seminorm_from_bounded' f (x * y) = (seminorm_from_bounded' f x) * (seminorm_from_bounded' f y) :=
begin
  rw [seminorm_from_bounded_of_mul_apply f_nonneg f_mul hx],
  simp only [seminorm_from_bounded', mul_assoc, hx, mul_div_assoc,
    real.mul_supr_of_nonneg (f_nonneg _)],
end

end seminorm_from_bounded


/-
Copyright (c) 2021 Manuel Candales. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Manuel Candales
-/
import topology.instances.ennreal
import data.nat.squarefree

/-!
# Divergence of the Prime Reciprocal Series

This file proves Theorem 81 from the [100 Theorems List](https://www.cs.ru.nl/~freek/100/).
The theorem states that the sum of the reciprocals of all prime numbers diverges.
The formalization follows Erdős's proof by upper and lower estimates.

## Proof outline

1. Assume that the sum of the reciprocals of the primes converges.
2. Then there exists a `k : ℕ` such that, for any `x : ℕ`, the sum of the reciprocals of the primes
   between `k` and `x + 1` is less than 1/2 (`sum_lt_half_of_not_tendsto`).
3. For any `x : ℕ`, we can partition `range x` into two subsets (`range_sdiff_eq_bUnion`):
    * `M x k`, the subset of those `e` for which `e + 1` is a product of powers of primes smaller
      than or equal to `k`;
    * `U x k`, the subset of those `e` for which there is a prime `p > k` that divides `e + 1`.
4. Then `|U x k|` is bounded by the sum over the primes `p > k` of the number of multiples of `p`
   in `(k, x]`, which is at most `x / p`. It follows that `|U x k|` is at most `x` times the sum of
  the reciprocals of the primes between `k` and `x + 1`, which is less than 1/2 as noted in (2), so
  `|U x k| < x / 2` (`card_le_mul_sum`).
5. By factoring `e + 1 = (m + 1)² * (r + 1)`, `r + 1` squarefree and `m + 1 ≤ √x`, and noting that
   squarefree numbers correspond to subsets of `[1, k]`, we find that `|M x k| ≤ 2 ^ k * √x`
   (`card_le_two_pow_mul_sqrt`).
6. Finally, setting `x := (2 ^ (k + 1))²` (`√x = 2 ^ (k + 1)`), we find that
   `|M x k| ≤ 2 ^ k * 2 ^ (k + 1) = x / 2`. Combined with the strict bound for `|U k x|` from (4),
   `x = |M x k| + |U x k| < x / 2 + x / 2 = x`.

## References

https://en.wikipedia.org/wiki/Divergence_of_the_sum_of_the_reciprocals_of_the_primes
-/

open_locale big_operators
open_locale classical
open filter finset

/--
The primes in `(k, x]`.
-/
noncomputable def P (x k : ℕ) := {p ∈ range (x + 1) | k < p ∧ nat.prime p}

/--
The union over those primes `p ∈ (k, x]` of the sets of `e < x` for which `e + 1` is a multiple
of `p`, i.e., those `e < x` for which there is a prime `p ∈ (k, x]` that divides `e + 1`.
-/
noncomputable def U (x k : ℕ) := finset.bUnion (P x k) (λ p, {e ∈ range x | p ∣ e + 1})

/--
Those `e < x` for which `e + 1` is a product of powers of primes smaller than or equal to `k`.
-/
noncomputable def M (x k : ℕ) := {e ∈ range x | ∀ p : ℕ, (nat.prime p ∧ p ∣ e + 1) → p ≤ k}

/--
If the sum of the reciprocals of the primes converges, there exists a `k : ℕ` such that the sum of
the reciprocals of the primes greater than `k` is less than 1/2.

More precisely, for any `x : ℕ`, the sum of the reciprocals of the primes between `k` and `x + 1`
is less than 1/2.
-/
lemma sum_lt_half_of_not_tendsto
  (h : ¬ tendsto (λ n, ∑ p in {p ∈ range n | nat.prime p}, (1 / (p : ℝ))) at_top at_top) :
  ∃ k, ∀ x, ∑ p in P x k, 1 / (p : ℝ) < 1 / 2 :=
begin
  have h0 : (λ n, ∑ p in {p ∈ range n | nat.prime p}, (1 / (p : ℝ)))
          = λ n, ∑ p in range n, ite (nat.prime p) (1 / (p : ℝ)) 0,
  { simp only [sum_filter, filter_congr_decidable, sep_def] },

  have hf : ∀ n : ℕ, 0 ≤ ite (nat.prime n) (1 / (n : ℝ)) 0,
  { intro n, split_ifs,
    { simp only [one_div, inv_nonneg, nat.cast_nonneg] },
    { exact le_rfl } },

  rw [h0, ← summable_iff_not_tendsto_nat_at_top_of_nonneg hf, summable_iff_vanishing] at h,
  obtain ⟨s, h⟩ := h (set.Ioo (-1) (1/2)) (is_open_Ioo.mem_nhds (by norm_num)),
  obtain ⟨k, hk⟩ := exists_nat_subset_range s,
  use k,
  intro x,

  rw [P, sep_def, filter_congr_decidable, ←filter_filter, sum_filter],
  refine (h _ _).2,
  rw disjoint_iff_ne,
  simp_intros a ha b hb only [mem_filter],
  exact ((mem_range.mp (hk hb)).trans ha.2).ne',
end

/--
Removing from {0, ..., x - 1} those elements `e` for which `e + 1` is a product of powers of primes
smaller than or equal to `k` leaves those `e` for which there is a prime `p > k` that divides
`e + 1`, or the union over those primes `p > k` of the sets of `e`s for which `e + 1` is a multiple
of `p`.
-/
lemma range_sdiff_eq_bUnion {x k : ℕ} : range x \ M x k = U x k :=
begin
  ext e,
  simp only [mem_bUnion, not_and, mem_sdiff, sep_def, mem_filter, mem_range, U, M, P],
  push_neg,
  split,
  { rintros ⟨hex, hexh⟩,
    obtain ⟨p, ⟨hpp, hpe1⟩, hpk⟩ := hexh hex,
    refine ⟨p, _, ⟨hex, hpe1⟩⟩,
    exact ⟨(nat.le_of_dvd e.succ_pos hpe1).trans_lt (nat.succ_lt_succ hex), hpk, hpp⟩ },
  { rintros ⟨p, hpfilter, ⟨hex, hpe1⟩⟩,
    rw imp_iff_right hex,
    exact ⟨hex, ⟨p, ⟨hpfilter.2.2, hpe1⟩, hpfilter.2.1⟩⟩ },
end

/--
The number of `e < x` for which `e + 1` has a prime factor `p > k` is bounded by `x` times the sum
of reciprocals of primes in `(k, x]`.
-/
lemma card_le_mul_sum {x k : ℕ} : (card (U x k) : ℝ) ≤ x * ∑ p in P x k, 1 / p :=
begin
  let P := {p ∈ range (x + 1) | k < p ∧ nat.prime p},
  let N := λ p, {e ∈ range x | p ∣ e + 1},
  have h : card (finset.bUnion P N) ≤ ∑ p in P, card (N p) := card_bUnion_le,

  calc  (card (finset.bUnion P N) : ℝ)
      ≤ ∑ p in P, card (N p)  : by assumption_mod_cast
  ... ≤ ∑ p in P, x * (1 / p) : sum_le_sum (λ p hp, _)
  ... = x * ∑ p in P, 1 / p   : mul_sum.symm,
  simp only [mul_one_div, N, sep_def, filter_congr_decidable, nat.card_multiples, nat.cast_div_le],
end

/--
The number of `e < x` for which `e + 1` is a squarefree product of primes smaller than or equal to
`k` is bounded by `2 ^ k`, the number of subsets of `[1, k]`.
-/
lemma card_le_two_pow {x k : ℕ} : card {e ∈ M x k | squarefree (e + 1)} ≤ 2 ^ k :=
begin
  let M₁ := {e ∈ M x k | squarefree (e + 1)},
  let f := λ s, finset.prod s (λ a, a) - 1,
  let K := powerset (image nat.succ (range k)),

  -- Take `e` in `M x k`. If `e + 1` is squarefree, then it is the product of a subset of `[1, k]`.
  -- It follows that `e` is one less than such a product.
  have h : M₁ ⊆ image f K,
  { intros m hm,
    simp only [M₁, M, sep_def, mem_filter, mem_range, mem_powerset, mem_image, exists_prop] at hm ⊢,
    obtain ⟨⟨-, hmp⟩, hms⟩ := hm,
    use (m + 1).factors,
    { rwa [multiset.coe_nodup, ← nat.squarefree_iff_nodup_factors m.succ_ne_zero] },
    refine ⟨λ p, _, _⟩,
    { suffices : p ∈ (m + 1).factors → ∃ a : ℕ, a < k ∧ a.succ = p, { simpa },
      simp_intros hp only [nat.mem_factors m.succ_ne_zero],
      exact ⟨p.pred, (nat.pred_lt (nat.prime.ne_zero hp.1)).trans_le ((hmp p) hp),
            nat.succ_pred_eq_of_pos (nat.prime.pos hp.1)⟩ },
    { simp_rw f, simp [nat.prod_factors m.succ_ne_zero, m.succ_sub_one] } },

  -- The number of elements of `M x k` with `e + 1` squarefree is bounded by the number of subsets
  -- of `[1, k]`.
  calc card M₁ ≤ card (image f K)                    : card_le_of_subset h
  ...          ≤ card K                              : card_image_le
  ...          ≤ 2 ^ card (image nat.succ (range k)) : by simp only [K, card_powerset]
  ...          ≤ 2 ^ card (range k)                  : pow_le_pow one_le_two card_image_le
  ...          = 2 ^ k                               : by rw card_range k,
end

/--
The number of `e < x` for which `e + 1` is a product of powers of primes smaller than or equal to
`k` is bounded by `2 ^ k * nat.sqrt x`.
-/
lemma card_le_two_pow_mul_sqrt {x k : ℕ} : card (M x k) ≤ 2 ^ k * nat.sqrt x :=
begin
  let M₁ := {e ∈ M x k | squarefree (e + 1)},
  let M₂ := M (nat.sqrt x) k,
  let K := M₁ ×ˢ M₂,
  let f : ℕ × ℕ → ℕ := λ mn, (mn.2 + 1) ^ 2 * (mn.1 + 1) - 1,

  -- Every element of `M x k` is one less than the product `(m + 1)² * (r + 1)` with `r + 1`
  -- squarefree and `m + 1 ≤ √x`, and both `m + 1` and `r + 1` still only have prime powers
  -- smaller than or equal to `k`.
  have h1 : M x k ⊆ image f K,
  { intros m hm,
    simp only [M, M₁, M₂, mem_image, exists_prop, prod.exists, mem_product, sep_def, mem_filter,
               mem_range] at hm ⊢,
    have hm' := m.zero_lt_succ,
    obtain ⟨a, b, hab₁, hab₂⟩ := nat.sq_mul_squarefree_of_pos' hm',
    obtain ⟨ham, hbm⟩ := ⟨dvd.intro_left _ hab₁, dvd.intro _ hab₁⟩,
    refine ⟨a, b, ⟨⟨⟨_, λ p hp, _⟩, hab₂⟩, ⟨_, λ p hp, _⟩⟩, by simp_rw [f, hab₁, m.succ_sub_one]⟩,
    { exact (nat.succ_le_succ_iff.mp (nat.le_of_dvd hm' ham)).trans_lt hm.1 },
    { exact hm.2 p ⟨hp.1, hp.2.trans ham⟩ },
    { calc b < b + 1        : lt_add_one b
      ...    ≤ (m + 1).sqrt : by simpa only [nat.le_sqrt, pow_two] using nat.le_of_dvd hm' hbm
      ...    ≤ x.sqrt       : nat.sqrt_le_sqrt (nat.succ_le_iff.mpr hm.1) },
    { exact hm.2 p ⟨hp.1, hp.2.trans (nat.dvd_of_pow_dvd one_le_two hbm)⟩ } },

  have h2 : card M₂ ≤ nat.sqrt x,
  { rw ← card_range (nat.sqrt x), apply card_le_of_subset, simp [M₂, M] },

  calc card (M x k) ≤ card (image f K)   : card_le_of_subset h1
  ...               ≤ card K             : card_image_le
  ...               = card M₁ * card M₂  : card_product M₁ M₂
  ...               ≤ 2 ^ k * x.sqrt     : mul_le_mul' card_le_two_pow h2,
end

theorem real.tendsto_sum_one_div_prime_at_top :
  tendsto (λ n, ∑ p in {p ∈ range n | nat.prime p}, (1 / (p : ℝ))) at_top at_top :=
begin
  -- Assume that the sum of the reciprocals of the primes converges.
  by_contradiction h,

  -- Then there is a natural number `k` such that for all `x`, the sum of the reciprocals of primes
  -- between `k` and `x` is less than 1/2.
  obtain ⟨k, h1⟩ := sum_lt_half_of_not_tendsto h,

  -- Choose `x` sufficiently large for the argument below to work, and use a perfect square so we
  -- can easily take the square root.
  let x := 2 ^ (k + 1) * 2 ^ (k + 1),

  -- We will partition `range x` into two subsets:
  -- * `M`, the subset of those `e` for which `e + 1` is a product of powers of primes smaller
  --   than or equal to `k`;
  set M := M x k with hM,

  -- * `U`, the subset of those `e` for which there is a prime `p > k` that divides `e + 1`.
  let P := {p ∈ range (x + 1) | k < p ∧ nat.prime p},
  set U := U x k with hU,

  -- This is indeed a partition, so `|U| + |M| = |range x| = x`.
  have h2 : x = card U + card M,
  { rw [← card_range x, hU, hM, ← range_sdiff_eq_bUnion],
    exact (card_sdiff_add_card_eq_card (finset.filter_subset _ _)).symm },

  -- But for the `x` we have chosen above, both `|U|` and `|M|` are less than or equal to `x / 2`,
  -- and for U, the inequality is strict.
  have h3 :=
    calc (card U : ℝ) ≤ x * ∑ p in P, 1 / p : card_le_mul_sum
    ...               < x * (1 / 2)         : mul_lt_mul_of_pos_left (h1 x) (by norm_num)
    ...               = x / 2               : mul_one_div x 2,

  have h4 :=
    calc (card M : ℝ) ≤ 2 ^ k * x.sqrt      : by exact_mod_cast card_le_two_pow_mul_sqrt
    ...               = 2 ^ k * ↑(2 ^ (k + 1)) : by rw nat.sqrt_eq
    ...               = x / 2               : by field_simp [x, mul_right_comm, ← pow_succ'],

  refine lt_irrefl (x : ℝ) _,
  calc (x : ℝ) = (card U : ℝ) + (card M : ℝ) : by assumption_mod_cast
  ...          < x / 2 + x / 2               : add_lt_add_of_lt_of_le h3 h4
  ...          = x                           : add_halves ↑x,
end


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

Authors: Floris van Doorn, Jeremy Avigad
Distance function on the natural numbers.
-/
import data.nat.basic

namespace nat

/- distance -/

/-- Distance (absolute value of difference) between natural numbers. -/
def dist (n m : ℕ) := (n - m) + (m - n)

theorem dist.def (n m : ℕ) : dist n m = (n - m) + (m - n) := rfl

theorem dist_comm (n m : ℕ) : dist n m = dist m n :=
by simp [dist.def, add_comm]

@[simp] theorem dist_self (n : ℕ) : dist n n = 0 :=
by simp [dist.def, nat.sub_self]

theorem eq_of_dist_eq_zero {n m : ℕ} (h : dist n m = 0) : n = m :=
have n - m = 0, from eq_zero_of_add_eq_zero_right h,
have n ≤ m, from nat.le_of_sub_eq_zero this,
have m - n = 0, from eq_zero_of_add_eq_zero_left h,
have m ≤ n, from nat.le_of_sub_eq_zero this,
le_antisymm ‹n ≤ m› ‹m ≤ n›

theorem dist_eq_zero {n m : ℕ} (h : n = m) : dist n m = 0 :=
begin rw [h, dist_self] end

theorem dist_eq_sub_of_le_right {n m : ℕ} (h : m ≤ n) : dist n m = n - m :=
begin rw [dist_comm], apply dist_eq_sub_of_le h end

theorem dist_tri_left (n m : ℕ) : m ≤ dist n m + n :=
le_trans (nat.le_sub_add _ _) (add_le_add_right (le_add_left _ _) _)

theorem dist_tri_right (n m : ℕ) : m ≤ n + dist n m :=
by rw add_comm; apply dist_tri_left

theorem dist_tri_left' (n m : ℕ) : n ≤ dist n m + m :=
by rw dist_comm; apply dist_tri_left

theorem dist_tri_right' (n m : ℕ) : n ≤ m + dist n m :=
by rw dist_comm; apply dist_tri_right

theorem dist_zero_right (n : ℕ) : dist n 0 = n :=
eq.trans (dist_eq_sub_of_le_right (zero_le n)) (nat.sub_zero n)

theorem dist_zero_left (n : ℕ) : dist 0 n = n :=
eq.trans (dist_eq_sub_of_le (zero_le n)) (nat.sub_zero n)

theorem dist_add_add_right (n k m : ℕ) : dist (n + k) (m + k) = dist n m :=
calc
  dist (n + k) (m + k) = ((n + k) - (m + k)) + ((m + k)-(n + k)) : rfl
                   ... = (n - m) + ((m + k) - (n + k))   : by rw nat.add_sub_add_right
                   ... = (n - m) + (m - n)               : by rw nat.add_sub_add_right

theorem dist_add_add_left (k n m : ℕ) : dist (k + n) (k + m) = dist n m :=
begin rw [add_comm k n, add_comm k m], apply dist_add_add_right end

theorem dist_eq_intro {n m k l : ℕ} (h : n + m = k + l) : dist n k = dist l m :=
calc
  dist n k = dist (n + m) (k + m) : by rw dist_add_add_right
       ... = dist (k + l) (k + m) : by rw h
       ... = dist l m             : by rw dist_add_add_left

protected theorem sub_lt_sub_add_sub (n m k : ℕ) : n - k ≤ (n - m) + (m - k) :=
or.elim (le_total k m)
  (assume : k ≤ m,
    begin rw ←nat.add_sub_assoc this, apply nat.sub_le_sub_right, apply nat.le_sub_add end)
  (assume : k ≥ m,
    begin rw [sub_eq_zero_of_le this, add_zero], apply nat.sub_le_sub_left, exact this end)

theorem dist.triangle_inequality (n m k : ℕ) : dist n k ≤ dist n m + dist m k :=
have dist n m + dist m k = (n - m) + (m - k) + ((k - m) + (m - n)),
  by simp [dist.def, add_comm, add_left_comm],
begin
  rw [this, dist.def], apply add_le_add, repeat { apply nat.sub_lt_sub_add_sub }
end

theorem dist_mul_right (n k m : ℕ) : dist (n * k) (m * k) = dist n m * k :=
by rw [dist.def, dist.def, right_distrib, nat.mul_sub_right_distrib, nat.mul_sub_right_distrib]

theorem dist_mul_left (k n m : ℕ) : dist (k * n) (k * m) = k * dist n m :=
by rw [mul_comm k n, mul_comm k m, dist_mul_right, mul_comm]

-- TODO(Jeremy): do when we have max and minx
--theorem dist_eq_max_sub_min {i j : nat} : dist i j = (max i j) - min i j :=
--sorry
/-
or.elim (lt_or_ge i j)
  (assume : i < j,
    by rw [max_eq_right_of_lt this, min_eq_left_of_lt this, dist_eq_sub_of_lt this])
  (assume : i ≥ j,
    by rw [max_eq_left this , min_eq_right this, dist_eq_sub_of_le_right this])
-/

theorem dist_succ_succ {i j : nat} : dist (succ i) (succ j) = dist i j :=
by simp [dist.def, succ_sub_succ]

theorem dist_pos_of_ne {i j : nat} : i ≠ j → 0 < dist i j :=
assume hne, nat.lt_by_cases
  (assume : i < j,
     begin rw [dist_eq_sub_of_le (le_of_lt this)], apply nat.sub_pos_of_lt this end)
  (assume : i = j, by contradiction)
  (assume : i > j,
     begin rw [dist_eq_sub_of_le_right (le_of_lt this)], apply nat.sub_pos_of_lt this end)

end nat


import tactic
import formally_smooth
import formally_unramified

/-!

# Formally etale morphisms

A ring morphism `A →+* B` between commutative rings `A` and `B` is
*formally étale* if for every surjective square-zero extension of
A-algebras `R' →+* R`(meaning that the kernel I satisties I² = 0),
the natural map Hom_A(B,R') → Hom_A(B,R) is bijective.

In other words, being formally etale is equivalent to being both
formally smooth and formally unramified.  That is how we define it.

-/

-- Let A and B be commutative rings
variables {A B : Type} [comm_ring A] [comm_ring B]

def is_formally_etale (f : A →+* B) : Prop := is_formally_smooth f ∧ is_formally_unramified f

lemma is_formally_etale_id : is_formally_etale (ring_hom.id A : A →+* A) :=
begin
  split,
  apply is_formally_smooth_id,
  apply is_formally_unramified_id,
end

variables {C : Type} [comm_ring C]

lemma is_formally_etale.comp {φ : A →+* B} (hφ : is_formally_etale φ)
  {ψ : B →+* C} (hψ : is_formally_etale ψ) : is_formally_etale (ψ.comp φ) :=
begin
  cases hφ with hφsm hφur,
  cases hψ with hψsm hψur,
  split,
  { exact is_formally_smooth_comp hφsm hψsm, },
  { exact is_formally_unramified.comp hφur hψur, },
end

-- composition of formally etale is formally etale


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.quaternion
import Mathlib.analysis.normed_space.inner_product
import Mathlib.PostPort

namespace Mathlib

/-!
# Quaternions as a normed algebra

In this file we define the following structures on the space `ℍ := ℍ[ℝ]` of quaternions:

* inner product space;
* normed ring;
* normed space over `ℝ`.

## Notation

The following notation is available with `open_locale quaternion`:

* `ℍ` : quaternions

## Tags

quaternion, normed ring, normed space, normed algebra
-/

namespace quaternion

protected instance has_inner : has_inner ℝ (quaternion ℝ) :=
  has_inner.mk fun (a b : quaternion ℝ) => re (a * coe_fn conj b)

theorem inner_self (a : quaternion ℝ) : inner a a = coe_fn norm_sq a :=
  rfl

theorem inner_def (a : quaternion ℝ) (b : quaternion ℝ) : inner a b = re (a * coe_fn conj b) :=
  rfl

protected instance inner_product_space : inner_product_space ℝ (quaternion ℝ) :=
  inner_product_space.of_core (inner_product_space.core.mk inner sorry sorry sorry sorry sorry sorry)

theorem norm_sq_eq_norm_square (a : quaternion ℝ) : coe_fn norm_sq a = norm a * norm a :=
  eq.mpr (id (Eq._oldrec (Eq.refl (coe_fn norm_sq a = norm a * norm a)) (Eq.symm (inner_self a))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (inner a a = norm a * norm a)) (real_inner_self_eq_norm_square a)))
      (Eq.refl (norm a * norm a)))

protected instance norm_one_class : norm_one_class (quaternion ℝ) :=
  norm_one_class.mk
    (eq.mpr (id (Eq._oldrec (Eq.refl (norm 1 = 1)) (norm_eq_sqrt_real_inner 1)))
      (eq.mpr (id (Eq._oldrec (Eq.refl (real.sqrt (inner 1 1) = 1)) (inner_self 1)))
        (eq.mpr (id (Eq._oldrec (Eq.refl (real.sqrt (coe_fn norm_sq 1) = 1)) (monoid_with_zero_hom.map_one norm_sq)))
          (eq.mpr (id (Eq._oldrec (Eq.refl (real.sqrt 1 = 1)) real.sqrt_one)) (Eq.refl 1)))))

@[simp] theorem norm_mul (a : quaternion ℝ) (b : quaternion ℝ) : norm (a * b) = norm a * norm b := sorry

@[simp] theorem norm_coe (a : ℝ) : norm ↑a = norm a := sorry

protected instance normed_ring : normed_ring (quaternion ℝ) :=
  normed_ring.mk sorry sorry

protected instance normed_algebra : normed_algebra ℝ (quaternion ℝ) :=
  normed_algebra.mk norm_coe

protected instance has_coe : has_coe ℂ (quaternion ℝ) :=
  has_coe.mk fun (z : ℂ) => quaternion_algebra.mk (complex.re z) (complex.im z) 0 0

@[simp] theorem coe_complex_re (z : ℂ) : re ↑z = complex.re z :=
  rfl

@[simp] theorem coe_complex_im_i (z : ℂ) : im_i ↑z = complex.im z :=
  rfl

@[simp] theorem coe_complex_im_j (z : ℂ) : im_j ↑z = 0 :=
  rfl

@[simp] theorem coe_complex_im_k (z : ℂ) : im_k ↑z = 0 :=
  rfl

@[simp] theorem coe_complex_add (z : ℂ) (w : ℂ) : ↑(z + w) = ↑z + ↑w := sorry

@[simp] theorem coe_complex_mul (z : ℂ) (w : ℂ) : ↑(z * w) = ↑z * ↑w := sorry

@[simp] theorem coe_complex_zero : ↑0 = 0 :=
  rfl

@[simp] theorem coe_complex_one : ↑1 = 1 :=
  rfl

@[simp] theorem coe_complex_smul (r : ℝ) (z : ℂ) : ↑(r • z) = r • ↑z := sorry

@[simp] theorem coe_complex_coe (r : ℝ) : ↑↑r = ↑r :=
  rfl

/-- Coercion `ℂ →ₐ[ℝ] ℍ` as an algebra homomorphism. -/
def of_complex : alg_hom ℝ ℂ (quaternion ℝ) :=
  alg_hom.mk coe sorry coe_complex_mul sorry coe_complex_add sorry

@[simp] theorem coe_of_complex : ⇑of_complex = coe :=
  rfl


import data.set.basic semantics.semantics
import semantics.definability syntax.syntaxlemmas
local attribute [instance] classical.prop_decidable

/-

In this file, we prove soundness for the K modal logic.
In other words, we show that whenever there exists a proof of a formula,
that formula is logically entailed (and valid)

The classic way to prove this in modal logic is through induction on
formulas, and that is mirrored in this proof.

-/

theorem soundness (Γ : ctx) (A : form) :  Kproof Γ A → entails Γ A :=
begin
intro h,
induction h,
{intros f v h x,
exact h h_A x h_h},
{intros f v x h2 h3 h4,
exact h3},
{intros f v x h2 h3 h4 h5,
apply h3,
exact h5,
apply h4,
exact h5},
{intros f x v h1 h2 h3,
by_contradiction h4,
exact (h2 h4) (h3 h4)},
{intros f v x h1 h2 h3,
exact and.intro h2 h3},
{intros f v x h1 h2,
exact h2.left},
{intros f v x h1 h2,
exact h2.right},
{intros f v x h1 h2 h3,
repeat {rw true_at_world at h2},
repeat {rw imp_false at h2},
rw not_imp_not at h2,
exact h2 h3},
{intros f v x h1 h2 h3 x' h4,
exact h2 x' h4 (h3 x' h4)},
{intros f v x h,
exact (h_ih_hpq f v x h) (h_ih_hp f v x h)},
{intros f v h1 x y h2,
exact h_ih f v h1 y},
end

lemma soundnesshelper {Γ : ctx} {A : form} {C : set (frame)} :
   Kproof Γ A → (∀ B ∈ Γ, valid_in_frame_class B C) → valid_in_frame_class A C :=
begin
intros h1 h2 f h3 v, induction h1,
{intro x,
exact h2 h1_A h1_h f h3 v x},
{intros x h4 h5,
exact h4},
{intros x h4 h5 h6,
exact (h4 h6) (h5 h6)},
{intros x h3 h4,
by_contradiction h5,
specialize h3 h5,
rw ←not_forces_imp at h3,
exact h3 (h4 h5)},
{intros x h4 h5,
exact and.intro h4 h5},
{intros x h4,
exact h4.left},
{intros x h4,
exact h4.right},
{intros x h4 h5,
repeat {rw true_at_world at h4},
repeat {rw imp_false at h4},
rw not_imp_not at h4,
exact h4 h5},
{intros x h3 h4,
intros x' h5,
exact (h3 x' h5) (h4 x' h5)},
{intro x,
exact h1_ih_hpq h2 x (h1_ih_hp h2 x)},
{intros x y h3,
apply h1_ih,
exact h2}
end