import analysis.topology.continuity
import analysis.topology.topological_space
import analysis.topology.infinite_sum
import analysis.topology.topological_structures
import analysis.topology.uniform_space

import data.equiv.basic

local attribute [instance] classical.prop_decidable

universes u v w

open set filter lattice classical

definition is_open_sets {α : Type u} (is_open : set α → Prop) :=
  is_open univ ∧ (∀s t, is_open s → is_open t → is_open (s ∩ t)) ∧ (∀s, (∀t∈s, is_open t) → is_open (⋃₀ s))

definition is_to_top {α : Type u} (is_open : set α → Prop) (H : is_open_sets (is_open)) : topological_space α :=
{ is_open := is_open,
  is_open_univ := H.left,
  is_open_inter := H.right.left,
  is_open_sUnion := H.right.right
}

definition top_to_is {α : Type u} (T : topological_space α) : is_open_sets (T.is_open) :=
⟨T.is_open_univ,T.is_open_inter,T.is_open_sUnion⟩

structure homeomorphism {α : Type*} {β : Type*} (X : topological_space α) (Y : topological_space β) extends equiv α β :=
(to_is_continuous : continuous to_fun)
(from_is_continuous : continuous inv_fun)

definition is_homeomorphic_to {α : Type u} {β : Type v} (X :topological_space α) (Y : topological_space β) : Prop := nonempty (homeomorphism X Y)

--Proposition 8.6a
lemma id_map_continuous {α : Type u} {X : topological_space α} : continuous (@id α) :=
begin
  intros s H1,
  exact H1,
end

--Proposition 8.6b
lemma constant_map_is_continuous {α : Type u} {β : Type v} {X : topological_space α} {Y : topological_space β} {f : α → β} (H : (∃ (b : β), f = function.const α b)) : continuous f :=
begin
  unfold continuous,
  cases H with b Hb,
    rw Hb,
    intros s Hs,
    by_cases (b ∈ s),
    unfold set.preimage,
    unfold function.const,
    have H : {x : α | b ∈ s} = univ,
      apply set.ext,
      simp,
      intro,
      assumption,
    rw H,
    exact X.is_open_univ,
  unfold set.preimage,
  unfold function.const,
  have H : {x : α | b ∈ s} = ∅,
    apply set.ext,
    simp,
    intro,
    assumption,
  rw H,
  simp,
end

def indiscrete_topology (α : Type u) : topological_space α := {
  is_open := λ y, y = ∅ ∨ y = univ,
  is_open_univ := or.inr rfl,
  is_open_inter := begin
    intros s t Hs Ht,
    cases Hs with Hsempty Hsuniv;
      cases Ht with Htempty Htuniv,
          rw Hsempty,
          simp,
        rw Hsempty,
        simp,
      rw Htempty,
      simp,
    rw [Hsuniv, Htuniv],
    simp,
  end,
  is_open_sUnion := begin
    intros I HI,
    by_cases ∃ t ∈ I, t = univ,
      cases h with U HU,
      cases HU with U_in_I U_is_univ,
      apply or.inr,
      rw U_is_univ at U_in_I,
      exact set.eq_of_subset_of_subset (set.subset_univ ⋃₀ I) (set.subset_sUnion_of_mem U_in_I),
      simp at h,
      apply or.inl,
      have HI2 : ∀ (t : set α), t ∈ I → t = ∅,
      intros t Ht,
      cases (HI t Ht),
        assumption,
      rw h_1 at Ht,
      cc,
    rw set.sUnion_eq_Union,
    apply set.ext,
    intro x,
    simp,
    intros t Ht,
    rw (HI2 t Ht),
    simp,
  end
}

def discrete_topology (α : Type u) : topological_space α := {
  is_open := λ y, true,
  is_open_univ := trivial,
  is_open_inter := λ _ _ _ _, trivial,
  is_open_sUnion := λ _ _, trivial,
}

--Proposition 8.6c
lemma maps_from_discrete_are_continuous {α : Type u} {β : Type v} [X : topological_space α] [Y : topological_space β]
(H : X = discrete_topology α)(f : α → β) : continuous f :=
begin
  unfold continuous,
  unfold is_open,
  intros s Hs,
  rw H,
  trivial,
end

--Proposition 8.6d
lemma maps_to_indiscrete_are_continuous {α : Type u} {β : Type v} [X : topological_space α] [Y : topological_space β]
(H : Y = indiscrete_topology β)(f : α → β) : continuous f :=
begin
  unfold continuous,
  unfold is_open,
  intros s Hs,
  rw H at Hs,
  cases Hs,
    rw Hs,
    simp,
    rw ←set.sUnion_empty,
  exact X.is_open_sUnion ∅ (λ t Ht, false.elim Ht),
  rw Hs,
  simp,
  exact X.is_open_univ,
end

definition id_is_homeomorphism {α : Type u} {X : topological_space α} : homeomorphism X X := {
  to_fun := id,
  inv_fun := id,
  left_inv :=
    begin
      unfold function.left_inverse,
      intro x,
      simp,
    end,
  right_inv :=
    begin
      unfold function.right_inverse,
      intro x,
      simp,
    end,
  to_is_continuous :=
    begin
      unfold continuous,
      unfold set.preimage,
      intros s H1,
      exact H1,
    end,
  from_is_continuous :=
    begin
      unfold continuous,
      unfold set.preimage,
      intros s H1,
      exact H1,
    end,
}
theorem homeomorphism_is_reflexive : reflexive (λ X Y : Σ α, topological_space α, is_homeomorphic_to X.2 Y.2) :=
begin
  unfold reflexive,
  intro x,
  unfold is_homeomorphic_to,
  have hom : homeomorphism (x.snd) (x.snd),
    exact id_is_homeomorphism,
  exact ⟨hom⟩,
end

theorem homeomorphism_is_symmetric : symmetric (λ X Y : Σ α, topological_space α, is_homeomorphic_to X.2 Y.2) :=
begin
  unfold symmetric,
  intros x y Hxy,
  unfold is_homeomorphic_to, unfold is_homeomorphic_to at Hxy,
  have homto : homeomorphism x.snd y.snd,
    exact classical.choice Hxy,
  have homfrom : homeomorphism y.snd x.snd,
    exact {to_fun := homto.inv_fun, inv_fun := homto.to_fun, left_inv := homto.right_inv, right_inv := homto.left_inv, to_is_continuous := homto.from_is_continuous, from_is_continuous := homto.to_is_continuous},
  exact nonempty.intro homfrom,
end

theorem homeomorphism_is_transitive : transitive (λ X Y : Σ α, topological_space α, is_homeomorphic_to X.2 Y.2) :=
begin
  unfold transitive,
  intros x y z Hxy Hyz,
  unfold is_homeomorphic_to at *,
  have homxy : homeomorphism x.snd y.snd, by exact classical.choice Hxy,
  have homyz : homeomorphism y.snd z.snd, by exact classical.choice Hyz,
  have homxz : homeomorphism x.snd z.snd,
    exact {to_fun := homyz.to_fun ∘ homxy.to_fun,
    inv_fun := homxy.inv_fun ∘ homyz.inv_fun,
    left_inv := begin
      unfold function.left_inverse,
      simp,
      intro a,
      have H1 : (homyz.to_equiv).inv_fun ∘ (homyz.to_equiv).to_fun = id,
        exact function.id_of_left_inverse homyz.left_inv,
      rw function.funext_iff at H1,
      simp at H1,
      rw H1,
      have H2 : (homxy.to_equiv).inv_fun ∘ (homxy.to_equiv).to_fun = id,
        exact function.id_of_left_inverse homxy.left_inv,
      rw function.funext_iff at H2,
      simp at H2,
      rw H2,
    end,
    right_inv := begin
      unfold function.right_inverse,
      unfold function.left_inverse,
      simp,
      intro a,
      have H1: (homxy.to_equiv).to_fun ∘ (homxy.to_equiv).inv_fun = id,
        exact function.id_of_right_inverse homxy.right_inv,
      rw function.funext_iff at H1,
      simp at H1,
      rw H1,
      have H2 : (homyz.to_equiv).to_fun ∘ (homyz.to_equiv).inv_fun = id,
        exact function.id_of_right_inverse homyz.right_inv,
      rw function.funext_iff at H2,
      simp at H2,
      rw H2,
    end,
    to_is_continuous := begin
      exact @continuous.comp _ _ _ x.2 y.2 z.2 _ _ homxy.to_is_continuous homyz.to_is_continuous,
    end,
    from_is_continuous := begin
      exact @continuous.comp _ _ _ z.2 y.2 x.2 _ _ homyz.from_is_continuous homxy.from_is_continuous,
    end},
  exact nonempty.intro homxz,
end

--Exercise 8.4
theorem homeomorphism_is_equivalence : equivalence (λ X Y : Σ α, topological_space α, is_homeomorphic_to X.2 Y.2) := ⟨homeomorphism_is_reflexive, homeomorphism_is_symmetric, homeomorphism_is_transitive⟩

--Proposition 8.12
theorem continuous_basis_to_continuous {α : Type*} {β : Type*} [X : topological_space α] [Y : topological_space β] : ∀ f : α → β, (∀ B : set (set β), topological_space.is_topological_basis B → (∀ b : B, is_open (f ⁻¹' b)) → continuous f) :=
begin
  intros f Basis HBasis HBasisInverses U HU,
  have HU_union_basis : ∃ S ⊆ Basis, U = ⋃₀ S, by exact topological_space.sUnion_basis_of_is_open HBasis HU,
  cases HU_union_basis with S HS,
  cases HS with HS1 HS2,
  rw HS2,
  rw set.preimage_sUnion,
  have f_inv_t_open : ∀ t : set β, t ∈ S → topological_space.is_open X (f ⁻¹' t),
    intros t HtS,
    have t_is_open : topological_space.is_open Y t,
      exact topological_space.is_open_of_is_topological_basis HBasis (set.mem_of_subset_of_mem HS1 HtS),
    simp at HBasisInverses,
    exact HBasisInverses t (set.mem_of_subset_of_mem HS1 HtS),
  let set_of_preimages : set (set α) := {x | ∃ t ∈ S, x = f ⁻¹' t},
  have preimages_are_open : topological_space.is_open X (⋃₀ set_of_preimages),
    have H3 : ∀ (t : set α), t ∈ set_of_preimages → topological_space.is_open X t,
      intros tinv Htinv,
      simp at Htinv,
      cases Htinv with t Ht,
      rw Ht.2,
      exact f_inv_t_open t Ht.1,
    exact X.is_open_sUnion set_of_preimages H3,
  unfold is_open,
  have equal : (⋃₀ set_of_preimages) = (⋃ (t : set β) (H : t ∈ S), f ⁻¹' t),
    rw set.sUnion_eq_Union,
    apply set.ext,
    intro x,
    split,
      intro Hx,
      simp,
      simp at Hx,
      cases Hx with f_inv_t Hf_inv_t,
      cases Hf_inv_t.1 with t Ht,
      existsi t,
      split,
        exact Ht.1,
      rw ← set.mem_preimage_eq,
      rw ← Ht.2,
      exact Hf_inv_t.2,
    intro Hx,
    simp,
    rw set.mem_Union_eq at Hx,
    cases Hx with i Hi,
    simp at Hi,
    existsi (f ⁻¹' i),
    split,
      existsi i,
      exact ⟨Hi.1, eq.refl (f ⁻¹' i)⟩,
    simp,
    exact Hi.2,
  rw ← equal,
  assumption,
end


variables (a b c d e : ℕ)
variable h1 : a = b
variable h2 : b = c + 1
variable h3 : c = d
variable h4 : e = 1 + d

include h1 h2 h3 h4
theorem T : a = e :=
  calc
    a     = b     : by rw h1
      ... = c + 1 : by rw h2
      ... = d + 1 : by rw h3
      ... = 1 + d : by rw add_comm
      ... = e     : by rw h4


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

! This file was ported from Lean 3 source module algebra.direct_sum.finsupp
! leanprover-community/mathlib commit aca0874a9ce95510752f4075f80f273172e9b177
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Algebra.DirectSum.Module
import Mathlib.Data.Finsupp.ToDfinsupp

/-!
# Results on direct sums and finitely supported functions.

1. The linear equivalence between finitely supported functions `ι →₀ M` and
the direct sum of copies of `M` indexed by `ι`.
-/

universe u v w

noncomputable section

open DirectSum

open LinearMap Submodule

variable {R : Type u} {M : Type v} [Ring R] [AddCommGroup M] [Module R M]

section finsuppLequivDirectSum

variable (R M) (ι : Type _) [DecidableEq ι]

-- Porting note: with etaExperiment no changes required, the statement can be:
-- `(ι →₀ M) ≃ₗ[R] ⨁ i : ι, M`
/-- The finitely supported functions `ι →₀ M` are in linear equivalence with the direct sum of
copies of M indexed by ι. -/
def finsuppLEquivDirectSum :
    @LinearEquiv R R _ _ (RingHom.id _) (RingHom.id _) (RingHomInvPair.ids)
    (RingHomInvPair.ids) (ι →₀ M) (⨁ _i : ι, M) _ _ _ _ :=
  haveI : ∀ m : M, Decidable (m ≠ 0) := Classical.decPred _
  finsuppLequivDfinsupp R
#align finsupp_lequiv_direct_sum finsuppLEquivDirectSum

@[simp]
theorem finsuppLEquivDirectSum_single (i : ι) (m : M) :
    finsuppLEquivDirectSum R M ι (Finsupp.single i m) = DirectSum.lof R ι _ i m :=
  Finsupp.toDfinsupp_single i m
#align finsupp_lequiv_direct_sum_single finsuppLEquivDirectSum_single

@[simp]
theorem finsuppLEquivDirectSum_symm_lof (i : ι) (m : M) :
    (finsuppLEquivDirectSum R M ι).symm (DirectSum.lof R ι _ i m) = Finsupp.single i m :=
  letI : ∀ m : M, Decidable (m ≠ 0) := Classical.decPred _
  Dfinsupp.toFinsupp_single i m
#align finsupp_lequiv_direct_sum_symm_lof finsuppLEquivDirectSum_symm_lof

end finsuppLequivDirectSum


/-
Copyright (c) 2021 Lu-Ming Zhang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Lu-Ming Zhang
-/
import linear_algebra.matrix.trace

/-!
# Hadamard product of matrices

This file defines the Hadamard product `matrix.hadamard`
and contains basic properties about them.

## Main definition

- `matrix.hadamard`: defines the Hadamard product,
  which is the pointwise product of two matrices of the same size.

## Notation

* `⊙`: the Hadamard product `matrix.hadamard`;

## References

*  <https://en.wikipedia.org/wiki/hadamard_product_(matrices)>

## Tags

hadamard product, hadamard
-/

variables {α β γ m n : Type*}
variables {R : Type*}

namespace matrix
open_locale matrix big_operators

/-- `matrix.hadamard` defines the Hadamard product,
    which is the pointwise product of two matrices of the same size.-/
def hadamard [has_mul α] (A : matrix m n α) (B : matrix m n α) : matrix m n α :=
of $ λ i j, A i j * B i j

-- TODO: set as an equation lemma for `hadamard`, see mathlib4#3024
@[simp]
lemma hadamard_apply [has_mul α] (A : matrix m n α) (B : matrix m n α) (i j) :
  hadamard A B i j = A i j * B i j := rfl
localized "infix (name := matrix.hadamard) ` ⊙ `:100 := matrix.hadamard" in matrix

section basic_properties

variables (A : matrix m n α) (B : matrix m n α) (C : matrix m n α)

/- commutativity -/
lemma hadamard_comm [comm_semigroup α] : A ⊙ B = B ⊙ A :=
ext $ λ _ _, mul_comm _ _

/- associativity -/
lemma hadamard_assoc [semigroup α] : A ⊙ B ⊙ C = A ⊙ (B ⊙ C) :=
ext $ λ _ _, mul_assoc _ _ _

/- distributivity -/
lemma hadamard_add [distrib α] : A ⊙ (B + C) = A ⊙ B + A ⊙ C :=
ext $ λ _ _, left_distrib _ _ _

lemma add_hadamard [distrib α] : (B + C) ⊙ A = B ⊙ A + C ⊙ A :=
ext $ λ _ _, right_distrib _ _ _

/- scalar multiplication -/
section scalar

@[simp] lemma smul_hadamard [has_mul α] [has_smul R α] [is_scalar_tower R α α] (k : R) :
  (k • A) ⊙ B = k • A ⊙ B :=
ext $ λ _ _, smul_mul_assoc _ _ _

@[simp] lemma hadamard_smul [has_mul α] [has_smul R α] [smul_comm_class R α α] (k : R):
  A ⊙ (k • B) = k • A ⊙ B :=
ext $ λ _ _, mul_smul_comm _ _ _

end scalar

section zero

variables [mul_zero_class α]

@[simp] lemma hadamard_zero : A ⊙ (0 : matrix m n α) = 0 :=
ext $ λ _ _, mul_zero _

@[simp] lemma zero_hadamard : (0 : matrix m n α) ⊙ A = 0 :=
ext $ λ _ _, zero_mul _

end zero

section one

variables [decidable_eq n] [mul_zero_one_class α]
variables (M : matrix n n α)

lemma hadamard_one : M ⊙ (1 : matrix n n α) = diagonal (λ i, M i i) :=
by { ext, by_cases h : i = j; simp [h] }

lemma one_hadamard : (1 : matrix n n α) ⊙ M = diagonal (λ i, M i i) :=
by { ext, by_cases h : i = j; simp [h] }

end one

section diagonal

variables [decidable_eq n] [mul_zero_class α]

lemma diagonal_hadamard_diagonal (v : n → α) (w : n → α) :
  diagonal v ⊙ diagonal w = diagonal (v * w) :=
ext $ λ _ _, (apply_ite2 _ _ _ _ _ _).trans (congr_arg _ $ zero_mul 0)

end diagonal

section trace

variables [fintype m] [fintype n]
variables (R) [semiring α] [semiring R] [module R α]

lemma sum_hadamard_eq : ∑ (i : m) (j : n), (A ⊙ B) i j = trace (A ⬝ Bᵀ) :=
rfl

lemma dot_product_vec_mul_hadamard [decidable_eq m] [decidable_eq n] (v : m → α) (w : n → α) :
  dot_product (vec_mul v (A ⊙ B)) w = trace (diagonal v ⬝ A ⬝ (B ⬝ diagonal w)ᵀ) :=
begin
  rw [←sum_hadamard_eq, finset.sum_comm],
  simp [dot_product, vec_mul, finset.sum_mul, mul_assoc],
end

end trace

end basic_properties

end matrix


/-
Copyright (c) 2021 Andrew Yang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Andrew Yang
-/
import topology.separation
import topology.continuous_function.basic

/-!
# Sober spaces

A quasi-sober space is a topological space where every
irreducible closed subset has a generic point.
A sober space is a quasi-sober space where every irreducible closed subset
has a *unique* generic point. This is if and only if the space is T0, and thus sober spaces can be
stated via `[quasi_sober α] [t0_space α]`.

## Main definition

* `specialization_order` : specialization gives a partial order on a T0 space.
* `is_generic_point` : `x` is the generic point of `S` if `S` is the closure of `x`.
* `quasi_sober` : A space is quasi-sober if every irreducible closed subset has a generic point.

-/

variables {α β : Type*} [topological_space α] [topological_space β]

section generic_point

/-- `x` is a generic point of `S` if `S` is the closure of `x`. -/
def is_generic_point (x : α) (S : set α) : Prop := closure ({x} : set α) = S

lemma is_generic_point_def {x : α} {S : set α} : is_generic_point x S ↔ closure ({x} : set α) = S :=
iff.rfl

lemma is_generic_point.def {x : α} {S : set α} (h : is_generic_point x S) :
  closure ({x} : set α) = S := h

lemma is_generic_point_closure {x : α} : is_generic_point x (closure ({x} : set α)) := refl _

variables {x : α} {S : set α} (h : is_generic_point x S)

include h

lemma is_generic_point.specializes {y : α} (h' : y ∈ S) :
  x ⤳ y := by rwa ← h.def at h'

lemma is_generic_point.mem : x ∈ S :=
h.def ▸ subset_closure (set.mem_singleton x)

lemma is_generic_point.is_closed : is_closed S :=
h.def ▸ is_closed_closure

lemma is_generic_point.is_irreducible : is_irreducible S :=
h.def ▸ is_irreducible_singleton.closure

lemma is_generic_point.eq [t0_space α] {y : α} (h' : is_generic_point y S) : x = y :=
specializes_antisymm _ _ (h.specializes h'.mem) (h'.specializes h.mem)

lemma is_generic_point.mem_open_set_iff
  {U : set α} (hU : is_open U) : x ∈ U ↔ (S ∩ U).nonempty :=
⟨λ h', ⟨x, h.mem, h'⟩,
    λ h', specializes_iff_forall_open.mp (h.specializes h'.some_spec.1) U hU h'.some_spec.2⟩

lemma is_generic_point.disjoint_iff
  {U : set α} (hU : is_open U) : disjoint S U ↔ x ∉ U :=
by rw [h.mem_open_set_iff hU, ← set.ne_empty_iff_nonempty, not_not, set.disjoint_iff_inter_eq_empty]

lemma is_generic_point.mem_closed_set_iff
  {Z : set α} (hZ : is_closed Z) : x ∈ Z ↔ S ⊆ Z :=
by rw [← is_generic_point_def.mp h, hZ.closure_subset_iff, set.singleton_subset_iff]

lemma is_generic_point.image {f : α → β} (hf : continuous f) :
  is_generic_point (f x) (closure (f '' S)) :=
begin
  rw [is_generic_point_def, ← is_generic_point_def.mp h],
  apply le_antisymm,
  { exact closure_mono
      (set.singleton_subset_iff.mpr ⟨_, subset_closure $ set.mem_singleton x, rfl⟩) },
  { convert is_closed_closure.closure_subset_iff.mpr (image_closure_subset_closure_image hf),
    rw set.image_singleton }
end

omit h

lemma is_generic_point_iff_forall_closed {x : α} {S : set α} (hS : is_closed S) (hxS : x ∈ S) :
  is_generic_point x S ↔ ∀ (Z : set α) (hZ : is_closed Z) (hxZ : x ∈ Z), S ⊆ Z :=
begin
  split,
  { intros h Z hZ hxZ, exact (h.mem_closed_set_iff hZ).mp hxZ },
  { intro h,
    apply le_antisymm,
    { rwa [set.le_eq_subset, hS.closure_subset_iff, set.singleton_subset_iff] },
    { exact h _ is_closed_closure (subset_closure $ set.mem_singleton x) } }
end

end generic_point

section sober

/-- A space is sober if every irreducible closed subset has a generic point. -/
@[mk_iff]
class quasi_sober (α : Type*) [topological_space α] : Prop :=
(sober : ∀ {S : set α} (hS₁ : is_irreducible S) (hS₂ : is_closed S), ∃ x, is_generic_point x S)

/-- A generic point of the closure of an irreducible space. -/
noncomputable
def is_irreducible.generic_point [quasi_sober α] {S : set α} (hS : is_irreducible S) : α :=
(quasi_sober.sober hS.closure is_closed_closure).some

lemma is_irreducible.generic_point_spec [quasi_sober α] {S : set α} (hS : is_irreducible S) :
  is_generic_point hS.generic_point (closure S) :=
(quasi_sober.sober hS.closure is_closed_closure).some_spec

@[simp] lemma is_irreducible.generic_point_closure_eq [quasi_sober α] {S : set α}
  (hS : is_irreducible S) : closure ({hS.generic_point} : set α) = closure S :=
hS.generic_point_spec

variable (α)

/-- A generic point of a sober irreducible space. -/
noncomputable
def generic_point [quasi_sober α] [irreducible_space α] : α :=
(irreducible_space.is_irreducible_univ α).generic_point

lemma generic_point_spec [quasi_sober α] [irreducible_space α] :
  is_generic_point (generic_point α) ⊤ :=
by simpa using (irreducible_space.is_irreducible_univ α).generic_point_spec

@[simp]
lemma generic_point_closure [quasi_sober α] [irreducible_space α] :
  closure ({generic_point α} : set α) = ⊤ := generic_point_spec α

variable {α}

lemma generic_point_specializes [quasi_sober α] [irreducible_space α] (x : α) :
  generic_point α ⤳ x := (is_irreducible.generic_point_spec _).specializes (by simp)

local attribute [instance, priority 10] specialization_order

/-- The closed irreducible subsets of a sober space bijects with the points of the space. -/
noncomputable
def irreducible_set_equiv_points [quasi_sober α] [t0_space α] :
  { s : set α | is_irreducible s ∧ is_closed s } ≃o α :=
{ to_fun := λ s, s.prop.1.generic_point,
  inv_fun := λ x, ⟨closure ({x} : set α), is_irreducible_singleton.closure, is_closed_closure⟩,
  left_inv := λ s,
    subtype.eq $ eq.trans (s.prop.1.generic_point_spec) $ closure_eq_iff_is_closed.mpr s.2.2,
  right_inv := λ x, is_irreducible_singleton.closure.generic_point_spec.eq
      (by { convert is_generic_point_closure using 1, rw closure_closure }),
  map_rel_iff' := λ s t, by { change _ ⤳ _ ↔ _, rw specializes_iff_closure_subset,
    simp [s.prop.2.closure_eq, t.prop.2.closure_eq, ← subtype.coe_le_coe] } }

lemma closed_embedding.quasi_sober {f : α → β} (hf : closed_embedding f) [quasi_sober β] :
  quasi_sober α :=
begin
  constructor,
  intros S hS hS',
  have hS'' := hS.image f hf.continuous.continuous_on,
  obtain ⟨x, hx⟩ := quasi_sober.sober hS'' (hf.is_closed_map _ hS'),
  obtain ⟨y, hy, rfl⟩ := hx.mem,
  use y,
  change _ = _ at hx,
  apply set.image_injective.mpr hf.inj,
  rw [← hx, ← hf.closure_image_eq, set.image_singleton]
end

lemma open_embedding.quasi_sober {f : α → β} (hf : open_embedding f) [quasi_sober β] :
  quasi_sober α :=
begin
  constructor,
  intros S hS hS',
  have hS'' := hS.image f hf.continuous.continuous_on,
  obtain ⟨x, hx⟩ := quasi_sober.sober hS''.closure is_closed_closure,
  obtain ⟨T, hT, rfl⟩ := hf.to_inducing.is_closed_iff.mp hS',
  rw set.image_preimage_eq_inter_range at hx hS'',
  have hxT : x ∈ T,
  { rw ← hT.closure_eq, exact closure_mono (set.inter_subset_left _ _) hx.mem },
  have hxU : x ∈ set.range f,
  { rw hx.mem_open_set_iff hf.open_range,
    refine set.nonempty.mono _ hS''.1,
    simpa using subset_closure },
  rcases hxU with ⟨y, rfl⟩,
  use y,
  change _ = _,
  rw [hf.to_embedding.closure_eq_preimage_closure_image,
    set.image_singleton, (show _ = _, from hx)],
  apply set.image_injective.mpr hf.inj,
  ext z,
  simp only [set.image_preimage_eq_inter_range, set.mem_inter_eq, and.congr_left_iff],
  exact λ hy, ⟨λ h, hT.closure_eq ▸ closure_mono (set.inter_subset_left _ _) h,
    λ h, subset_closure ⟨h, hy⟩⟩
end

/-- A space is quasi sober if it can be covered by open quasi sober subsets. -/
lemma quasi_sober_of_open_cover (S : set (set α)) (hS : ∀ s : S, is_open (s : set α))
  [hS' : ∀ s : S, quasi_sober s] (hS'' : ⋃₀ S = ⊤) : quasi_sober α :=
begin
  rw quasi_sober_iff,
  intros t h h',
  obtain ⟨x, hx⟩ := h.1,
  obtain ⟨U, hU, hU'⟩ : x ∈ ⋃₀S := by { rw hS'', trivial },
  haveI : quasi_sober U := hS' ⟨U, hU⟩,
  have H : is_preirreducible (coe ⁻¹' t : set U) :=
    h.2.preimage (hS ⟨U, hU⟩).open_embedding_subtype_coe,
  replace H : is_irreducible (coe ⁻¹' t : set U) := ⟨⟨⟨x, hU'⟩, by simpa using hx⟩, H⟩,
  use H.generic_point,
  have := continuous_subtype_coe.closure_preimage_subset _ H.generic_point_spec.mem,
  rw h'.closure_eq at this,
  apply le_antisymm,
  { apply h'.closure_subset_iff.mpr, simpa using this },
  rw [← set.image_singleton, ← closure_closure],
  have := closure_mono (image_closure_subset_closure_image (@continuous_subtype_coe α _ U)),
  refine set.subset.trans _ this,
  rw H.generic_point_spec.def,
  refine (subset_closure_inter_of_is_preirreducible_of_is_open
    h.2 (hS ⟨U, hU⟩) ⟨x, hx, hU'⟩).trans (closure_mono _),
  rw ← subtype.image_preimage_coe,
  exact set.image_subset _ subset_closure,
end

@[priority 100]
instance t2_space.quasi_sober [t2_space α] : quasi_sober α :=
begin
  constructor,
  rintro S h -,
  obtain ⟨x, rfl⟩ := (is_irreducible_iff_singleton S).mp h,
  exact ⟨x, closure_singleton⟩
end

end sober


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

import easy_mode.sheet09
import tactic.ring

/-

# Induced functions on quotients

The quotient comes with what one would call a universal property in advanced courses: Given a type `X`, an
equivalence relation `≈` on `X`, then for every other type `Y` and every function `h : X → Y` such that
`x ≈ x' → f x = f x'` there is a unique function `h : X/≈  → Y` such that `f = h ∘ q`. In standard maths courses
the existence of such `h` in examples is often justified as follows: For each equivalence class `⟦x⟧` of
the quotient, choose a representative `x : X` and define `h(⟦x⟧) := f(x)`. One has to then prove that this
is well-defined by invoking the assumption `x ≈ x' → f x = f x'`. In Lean, the function `h` can be produced
automatically using `quotient.lift` applied to the assumption `x ≈ x' → f x = f x'`, one doesn't have to go
through the steps.

On this sheet we will see how this works, first starting with the example of negation, which is easier than
addition as it only has one input, not two.
-/

lemma neg_well_defined (x y : ℕ × ℕ) (h : x ≈ y) : ⟦(x.2,x.1)⟧ = ⟦(y.2, y.1)⟧ :=
begin
  sorry
end

def neg : myint → myint := quotient.lift (λ (x : ℕ × ℕ), ⟦(x.2, x.1)⟧) (neg_well_defined)

instance : has_neg myint :=
{ neg := neg }

/-

There is an alternative way, which is in fact a special case of the first. Suppose `Y = Z/≈₂` and we are given
a function `g : X → Z`. Consider the function `f = q₂ ∘ g` where `q₂ : Z → Z/≈₂` is the surjection.
Then `x ≈ x' → f x = f x'` can be checked on `Z` instead, i.e. it can be checked that `x ≈ x' → g x ≈₂ g x'`
in order to reach the conclusion for `f`. Since this is a common situation, there is a special name for it:
`quotient.map`, which takes the assumption `x ≈ x' → g x ≈₂ g x'` and defines a function `X/≈ → Z/≈₂`.

-/

def neg2 : myint → myint := quotient.map (λ x, (x.2, x.1))
begin
  sorry
end

/- Why do the two definitions just defined agree? -/
lemma defn_neg_agree : neg = neg2 :=
begin
  sorry
end

/-

Our next step will be to provide an addition and a multiplication on `myint` and prove that `myint`
with these operations forms a commutative ring. To recall, a commutative ring is a set `R`
together with operations `+: R×R → R` and `*: R×R → R` such that the following axioms hold:
(R1) `(x+y)+z=x+(y+z)` for all `x y z : R`
(R2) `x+y=y+x` for all `x y : R`
(R3) `∃ 0 : x+0=x=0+x` for all `x : R`
(R4) `∀ x ∃ -x : x + (-x) = (-x) + x = 0`
(R5) `(x * y) * z = x * (y * z)`
(R6) `∃ 1 : 1 * x = x`
(R7) `x * y = y * x` for all `x y : R`
(R8) `x * (y + z) = x * y + x * z` for all `x y z : R`

In fact, for lean addition is not a function `R×R → R`, but rather a function `R → (R → R)`, or
`R → R → R` as in contrast to addition and multiplication, `→` is right associative in Lean.
The function `R → (R → R)` takes a ring element `x : R` and sends it to the function `R → R`
which sends `y : R` to `x + y`, in λ-notation `λ y, x+y`. In computer science, the correspondence
between functions `R×R → R` and `R → (R → R)` is called currying after Haskell Curry. For
mathematicians (using category theory), it is just a special case of the concept of an adjunction,
i.e. the functors of taking cartesian product  `- × R` and taking Hom in the category of sets
`Hom(R,-)` are adjoint to each other.

We want to define addition `myint × myint → myint` or equivalently `myint → myint → myint`.
If we think about the first incarnation, we could do that as follows: First we prove that
given an equivalence relation on `X` and an equivalence relation on `Y` we prove that there
is an equivalence relation on `X × Y` given by `(x,y) ≈ (x',y')` iff `x ≈ x'` and `y ≈ y'`.
Then we do the same steps as before. Applying currying, in the other way of thinking,
we would have to do a two-step process of constructing a function from the quotient `myint` to
the set of functions from the quotient `myint` to `myint`. Luckily, we don't have to think in
detail about what this entails - binary operations are a common enough thing that Lean has a
special construction that does all in one step, namely `quotient.map₂`.

-/

def add : myint → myint → myint := quotient.map₂ (λ r s, (r.1+s.1, r.2+s.2))
begin
  sorry
end

instance : has_add myint :=
{ add := add }

def mul : myint → myint → myint := quotient.map₂ (λ r s, (r.1*s.1+r.2*s.2, r.1*s.2+r.2*s.1))
begin
  sorry
end

instance : has_mul myint :=
{ mul := mul }

/- Now we have to prove the ring axioms. For this, we have to prove something for all equivalence
classes `r s t : myint`. We would rather like to check this on representatives. Then it becomes
easy. To do this (depending on the number of inputs) you can apply the lemmas
`quotient.induction_on r`, `quotient.induction_on₂ r s`, `quotient.induction_on₃ r s t`. To
simplify the goal view, after that you can put `clear r s t` but that is not strictly necessary. -/

instance : comm_ring myint :=
{ add := has_add.add,
  add_assoc := begin sorry end,
  zero := ⟦(0,0)⟧,
  zero_add := begin sorry end,
  add_comm := begin sorry end,
  add_zero := begin sorry end,
  neg := has_neg.neg,
  add_left_neg := begin sorry end,
  mul := has_mul.mul,
  mul_assoc := begin sorry end,
  one := ⟦(1,0)⟧,
  one_mul := begin sorry end,
  mul_one := begin sorry end,
  left_distrib := begin sorry end,
  right_distrib := begin sorry end,
  mul_comm := begin sorry end, }


/-
Copyright (c) 2020 Kexing Ying and Kevin Buzzard. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kexing Ying, Kevin Buzzard, Yury Kudryashov
-/

import data.set.finite
import data.set.disjointed
import algebra.big_operators
import data.indicator_function

/-!
# Finite products and sums over types and sets

We define products and sums over types and subsets of types, with no finiteness hypotheses.
All infinite products and sums are defined to be junk values (i.e. one or zero).
This approach is sometimes easier to use than `finset.sum`,
when issues arise with `finset` and `fintype` being data.

## Main definitions

We use the following variables:

* `α`, `β` - types with no structure;
* `s`, `t` - sets
* `M`, `N` - additive or multiplicative commutative monoids
* `f`, `g` - functions

Definitions in this file:

* `finsum f : M` : the sum of `f x` as `x` ranges over the support of `f`, if it's finite.
   Zero otherwise.

* `finprod f : M` : the product of `f x` as `x` ranges over the multiplicative support of `f`, if
   it's finite. One otherwise.

## Notation

* `∑ᶠ i, f i` and `∑ᶠ i : α, f i` for `finsum f`

* `∏ᶠ i, f i` and `∏ᶠ i : α, f i` for `finprod f`

This notation works for functions `f : p → M`, where `p : Prop`, so the following works:

* `∑ᶠ i ∈ s, f i`, where `f : α → M`, `s : set α` : sum over the set `s`;
* `∑ᶠ n < 5, f n`, where `f : ℕ → M` : same as `f 0 + f 1 + f 2 + f 3 + f 4`;
* `∏ᶠ (n >= -2) (hn : n < 3), f n`, where `f : ℤ → M` : same as `f (-2) * f (-1) * f 0 * f 1 * f 2`.

## Implementation notes

`finsum` and `finprod` is "yet another way of doing finite sums and products in Lean". However
experiments in the wild (e.g. with matroids) indicate that it is a helpful approach in settings
where the user is not interested in computability and wants to do reasoning without running into
typeclass diamonds caused by the constructive finiteness used in definitions such as `finset` and
`fintype`. By sticking solely to `set.finite` we avoid these problems. We are aware that there are
other solutions but for beginner mathematicians this approach is easier in practice.

Another application is the construction of a partition of unity from a collection of “bump”
function. In this case the finite set depends on the point and it's convenient to have a definition
that does not mention the set explicitly.

## Todo

We did not add `is_finite (X : Type) : Prop`, because it is simply `nonempty (fintype X)`.
There is work on `fincard` in the pipeline, which returns the cardinality of `X` if it
is finite, and 0 otherwise.

## Tags

finsum, finprod, finite sum, finite product
-/

open function set

/-!
### Definition and relation to `finset.sum` and `finset.prod`
-/

section sort
variables {α β ι : Sort*} {M N : Type*} [comm_monoid M] [comm_monoid N]

open_locale big_operators

section

/- Note: we use classical logic only for these definitions, to ensure that we do not write lemmas
with `classical.dec` in their statement. -/
open_locale classical

/-- Sum of `f x` as `x` ranges over the elements of the support of `f`, if it's finite. Zero
otherwise. -/
@[irreducible] noncomputable def finsum {M} [add_comm_monoid M] (f : α → M) : M :=
if h : finite (support (f ∘ plift.down)) then ∑ i in h.to_finset, f i.down else 0

/-- Product of `f x` as `x` ranges over the elements of the multiplicative support of `f`, if it's
finite. One otherwise. -/
@[irreducible, to_additive]
noncomputable def finprod (f : α → M) : M :=
if h : finite (mul_support (f ∘ plift.down)) then ∏ i in h.to_finset, f i.down else 1

end

localized "notation `∑ᶠ` binders `, ` r:(scoped:67 f, finsum f) := r" in big_operators

localized "notation `∏ᶠ` binders `, ` r:(scoped:67 f, finprod f) := r" in big_operators

@[to_additive] lemma finprod_eq_prod_plift_of_mul_support_to_finset_subset
  {f : α → M} (hf : finite (mul_support (f ∘ plift.down))) {s : finset (plift α)}
  (hs : hf.to_finset ⊆ s) :
  ∏ᶠ i, f i = ∏ i in s, f i.down :=
begin
  rw [finprod, dif_pos],
  refine finset.prod_subset hs (λ x hx hxf, _),
  rwa [hf.mem_to_finset, nmem_mul_support] at hxf
end

@[to_additive] lemma finprod_eq_prod_plift_of_mul_support_subset
  {f : α → M} {s : finset (plift α)} (hs : mul_support (f ∘ plift.down) ⊆ s) :
  ∏ᶠ i, f i = ∏ i in s, f i.down :=
finprod_eq_prod_plift_of_mul_support_to_finset_subset
  (s.finite_to_set.subset hs) $ λ x hx, by { rw finite.mem_to_finset at hx, exact hs hx }

@[simp, to_additive] lemma finprod_one : ∏ᶠ i : α, (1 : M) = 1 :=
begin
  have : mul_support (λ x : plift α, (λ _, 1 : α → M) x.down) ⊆ (∅ : finset (plift α)),
    from λ x h, h rfl,
  rw [finprod_eq_prod_plift_of_mul_support_subset this, finset.prod_empty]
end

@[to_additive] lemma finprod_of_empty (ha : α → false) (f : α → M) : ∏ᶠ i, f i = 1 :=
by { rw ← finprod_one, congr' with x, exact (ha x).elim }

@[simp, to_additive] lemma finprod_false (f : false → M) : ∏ᶠ i, f i = 1 :=
finprod_of_empty id _

@[to_additive] lemma finprod_unique [unique α] (f : α → M) : ∏ᶠ i, f i = f (default α) :=
begin
  have : mul_support (f ∘ plift.down) ⊆ (finset.univ : finset (plift α)),
    from λ x _, finset.mem_univ x,
  rw [finprod_eq_prod_plift_of_mul_support_subset this, univ_unique,
    finset.prod_singleton],
  exact congr_arg f (plift.down_up _)
end

@[simp, to_additive] lemma finprod_true (f : true → M) : ∏ᶠ i, f i = f trivial :=
@finprod_unique true M _ ⟨⟨trivial⟩, λ _, rfl⟩ f

@[to_additive] lemma finprod_eq_dif {p : Prop} [decidable p] (f : p → M) :
  ∏ᶠ i, f i = if h : p then f h else 1 :=
begin
  split_ifs,
  { haveI : unique p := ⟨⟨h⟩, λ _, rfl⟩,
    exact finprod_unique f },
  { exact finprod_of_empty h f }
end

@[to_additive] lemma finprod_eq_if {p : Prop} [decidable p] {x : M} :
  ∏ᶠ i : p, x = if p then x else 1 :=
finprod_eq_dif (λ _, x)

@[to_additive] lemma finprod_congr {f g : α → M} (h : ∀ x, f x = g x) :
  finprod f = finprod g :=
congr_arg _ $ funext h

@[congr, to_additive] lemma finprod_congr_Prop {p q : Prop} {f : p → M} {g : q → M} (hpq : p = q)
  (hfg : ∀ h : q, f (hpq.mpr h) = g h) :
  finprod f = finprod g :=
by { subst q, exact finprod_congr hfg }

attribute [congr] finsum_congr_Prop

lemma finprod_nonneg {R : Type*} [ordered_comm_semiring R] {f : α → R} (hf : ∀ x, 0 ≤ f x) :
  0 ≤ ∏ᶠ x, f x :=
begin
  rw finprod,
  split_ifs,
  { exact finset.prod_nonneg (λ x _, hf _) },
  { exact zero_le_one }
end

@[to_additive] lemma monoid_hom.map_finprod_plift (f : M →* N) (g : α → M)
  (h : finite (mul_support $ g ∘ plift.down)) :
  f (∏ᶠ x, g x) = ∏ᶠ x, f (g x) :=
begin
  rw [finprod_eq_prod_plift_of_mul_support_subset h.coe_to_finset.ge,
    finprod_eq_prod_plift_of_mul_support_subset, f.map_prod],
  rw [h.coe_to_finset],
  exact mul_support_comp_subset f.map_one (g ∘ plift.down)
end

@[to_additive] lemma monoid_hom.map_finprod_Prop {p : Prop} (f : M →* N) (g : p → M) :
  f (∏ᶠ x, g x) = ∏ᶠ x, f (g x) :=
f.map_finprod_plift g (finite.of_fintype _)

end sort

section type

variables {α β ι M N : Type*} [comm_monoid M] [comm_monoid N]

open_locale big_operators

@[to_additive] lemma finprod_eq_mul_indicator_apply (s : set α)
  (f : α → M) (a : α) :
  ∏ᶠ (h : a ∈ s), f a = mul_indicator s f a :=
by convert finprod_eq_if

@[to_additive] lemma finprod_mem_def (s : set α) (f : α → M) :
  ∏ᶠ a ∈ s, f a = ∏ᶠ a, mul_indicator s f a :=
finprod_congr $ finprod_eq_mul_indicator_apply s f

@[to_additive] lemma finprod_eq_prod_of_mul_support_subset (f : α → M) {s : finset α}
  (h : mul_support f ⊆ s) :
  ∏ᶠ i, f i = ∏ i in s, f i :=
begin
  have A : mul_support (f ∘ plift.down) = equiv.plift.symm '' mul_support f,
  { rw mul_support_comp_eq_preimage,
    exact (equiv.plift.symm.image_eq_preimage _).symm },
  have : mul_support (f ∘ plift.down) ⊆ s.map equiv.plift.symm.to_embedding,
  { rw [A, finset.coe_map], exact image_subset _ h },
  rw [finprod_eq_prod_plift_of_mul_support_subset this],
  simp
end

@[to_additive] lemma finprod_eq_prod_of_mul_support_to_finset_subset (f : α → M)
  (hf : finite (mul_support f)) {s : finset α} (h : hf.to_finset ⊆ s) :
  ∏ᶠ i, f i = ∏ i in s, f i :=
finprod_eq_prod_of_mul_support_subset _ $ λ x hx, h $ hf.mem_to_finset.2 hx

@[to_additive] lemma finprod_def (f : α → M) [decidable (mul_support f).finite] :
  ∏ᶠ i : α, f i = if h : (mul_support f).finite then ∏ i in h.to_finset, f i else 1 :=
begin
  split_ifs,
  { exact finprod_eq_prod_of_mul_support_to_finset_subset _ h (finset.subset.refl _) },
  { rw [finprod, dif_neg],
    rw [mul_support_comp_eq_preimage],
    exact mt (λ hf, hf.of_preimage equiv.plift.surjective) h}
end

@[to_additive] lemma finprod_of_infinite_mul_support {f : α → M} (hf : (mul_support f).infinite) :
  ∏ᶠ i, f i = 1 :=
by { classical, rw [finprod_def, dif_neg hf] }

@[to_additive] lemma finprod_eq_prod (f : α → M) (hf : (mul_support f).finite) :
  ∏ᶠ i : α, f i = ∏ i in hf.to_finset, f i :=
by { classical, rw [finprod_def, dif_pos hf] }

@[to_additive] lemma finprod_eq_prod_of_fintype [fintype α] (f : α → M) :
  ∏ᶠ i : α, f i = ∏ i, f i :=
finprod_eq_prod_of_mul_support_to_finset_subset _ (finite.of_fintype _) $ finset.subset_univ _

@[to_additive] lemma finprod_cond_eq_prod_of_cond_iff (f : α → M) {p : α → Prop} {t : finset α}
  (h : ∀ {x}, f x ≠ 1 → (p x ↔ x ∈ t)) :
  ∏ᶠ i (hi : p i), f i = ∏ i in t, f i :=
begin
  set s := {x | p x},
  have : mul_support (s.mul_indicator f) ⊆ t,
  { rw [set.mul_support_mul_indicator], intros x hx, exact (h hx.2).1 hx.1 },
  erw [finprod_mem_def, finprod_eq_prod_of_mul_support_subset _ this],
  refine finset.prod_congr rfl (λ x hx, mul_indicator_apply_eq_self.2 $ λ hxs, _),
  contrapose! hxs,
  exact (h hxs).2 hx
end

@[to_additive] lemma finprod_mem_eq_prod_of_inter_mul_support_eq (f : α → M) {s : set α}
  {t : finset α} (h : s ∩ mul_support f = t ∩ mul_support f) :
  ∏ᶠ i ∈ s, f i = ∏ i in t, f i :=
finprod_cond_eq_prod_of_cond_iff _ $ by simpa [set.ext_iff] using h

@[to_additive] lemma finprod_mem_eq_prod_of_subset (f : α → M) {s : set α} {t : finset α}
  (h₁ : s ∩ mul_support f ⊆ t) (h₂ : ↑t ⊆ s) :
  ∏ᶠ i ∈ s, f i = ∏ i in t, f i :=
finprod_cond_eq_prod_of_cond_iff _ $ λ x hx, ⟨λ h, h₁ ⟨h, hx⟩, λ h, h₂ h⟩

@[to_additive] lemma finprod_mem_eq_prod (f : α → M) {s : set α}
  (hf : (s ∩ mul_support f).finite) :
  ∏ᶠ i ∈ s, f i = ∏ i in hf.to_finset, f i :=
finprod_mem_eq_prod_of_inter_mul_support_eq _ $ by simp [inter_assoc]

@[to_additive] lemma finprod_mem_eq_prod_filter (f : α → M) (s : set α) [decidable_pred (∈ s)]
  (hf : (mul_support f).finite) :
  ∏ᶠ i ∈ s, f i = ∏ i in finset.filter (∈ s) hf.to_finset, f i :=
finprod_mem_eq_prod_of_inter_mul_support_eq _ $ by simp [inter_comm, inter_left_comm]

@[to_additive] lemma finprod_mem_eq_to_finset_prod (f : α → M) (s : set α) [fintype s] :
  ∏ᶠ i ∈ s, f i = ∏ i in s.to_finset, f i :=
finprod_mem_eq_prod_of_inter_mul_support_eq _ $ by rw [coe_to_finset]

@[to_additive] lemma finprod_mem_eq_finite_to_finset_prod (f : α → M) {s : set α} (hs : s.finite) :
  ∏ᶠ i ∈ s, f i = ∏ i in hs.to_finset, f i :=
finprod_mem_eq_prod_of_inter_mul_support_eq _ $ by rw [hs.coe_to_finset]

@[to_additive] lemma finprod_mem_finset_eq_prod (f : α → M) (s : finset α) :
  ∏ᶠ i ∈ s, f i = ∏ i in s, f i :=
finprod_mem_eq_prod_of_inter_mul_support_eq _ rfl

@[to_additive] lemma finprod_mem_coe_finset (f : α → M) (s : finset α) :
  ∏ᶠ i ∈ (s : set α), f i = ∏ i in s, f i :=
finprod_mem_eq_prod_of_inter_mul_support_eq _ rfl

@[to_additive] lemma finprod_mem_eq_one_of_infinite {f : α → M} {s : set α}
  (hs : (s ∩ mul_support f).infinite) : ∏ᶠ i ∈ s, f i = 1 :=
begin
  rw finprod_mem_def,
  apply finprod_of_infinite_mul_support,
  rwa [← mul_support_mul_indicator] at hs
end

@[to_additive] lemma finprod_mem_inter_mul_support (f : α → M) (s : set α) :
  ∏ᶠ i ∈ (s ∩ mul_support f), f i = ∏ᶠ i ∈ s, f i :=
by rw [finprod_mem_def, finprod_mem_def, mul_indicator_inter_mul_support]

@[to_additive] lemma finprod_mem_inter_mul_support_eq (f : α → M) (s t : set α)
  (h : s ∩ mul_support f = t ∩ mul_support f) :
  ∏ᶠ i ∈ s, f i = ∏ᶠ i ∈ t, f i :=
by rw [← finprod_mem_inter_mul_support, h, finprod_mem_inter_mul_support]

@[to_additive] lemma finprod_mem_inter_mul_support_eq' (f : α → M) (s t : set α)
  (h : ∀ x ∈ mul_support f, x ∈ s ↔ x ∈ t) :
  ∏ᶠ i ∈ s, f i = ∏ᶠ i ∈ t, f i :=
begin
  apply finprod_mem_inter_mul_support_eq,
  ext x,
  exact and_congr_left (h x)
end

@[to_additive] lemma finprod_mem_univ (f : α → M) : ∏ᶠ i ∈ @set.univ α, f i = ∏ᶠ i : α, f i :=
finprod_congr $ λ i, finprod_true _

variables {f g : α → M} {a b : α} {s t : set α}

@[to_additive] lemma finprod_mem_congr (h₀ : s = t) (h₁ : ∀ x ∈ t, f x = g x) :
  ∏ᶠ i ∈ s, f i = ∏ᶠ i ∈ t, g i :=
h₀.symm ▸ (finprod_congr $ λ i, finprod_congr_Prop rfl (h₁ i))

/-!
### Distributivity w.r.t. addition, subtraction, and (scalar) multiplication
-/

/-- If the multiplicative supports of `f` and `g` are finite, then the product of `f i * g i` equals
the product of `f i` multiplied by the product over `g i`. -/
@[to_additive] lemma finprod_mul_distrib (hf : (mul_support f).finite)
  (hg : (mul_support g).finite) :
  ∏ᶠ i, (f i * g i) = (∏ᶠ i, f i) * ∏ᶠ i, g i :=
begin
  classical,
  rw [finprod_eq_prod_of_mul_support_to_finset_subset _ hf (finset.subset_union_left _ _),
    finprod_eq_prod_of_mul_support_to_finset_subset _ hg (finset.subset_union_right _ _),
    ← finset.prod_mul_distrib],
  refine finprod_eq_prod_of_mul_support_subset _ _,
  simp [mul_support_mul]
end

/-- A more general version of `finprod_mem_mul_distrib` that requires `s ∩ mul_support f` and
`s ∩ mul_support g` instead of `s` to be finite. -/
@[to_additive] lemma finprod_mem_mul_distrib' (hf : (s ∩ mul_support f).finite)
  (hg : (s ∩ mul_support g).finite) :
  ∏ᶠ i ∈ s, (f i * g i) = (∏ᶠ i ∈ s, f i) * ∏ᶠ i ∈ s, g i :=
begin
  rw [← mul_support_mul_indicator] at hf hg,
  simp only [finprod_mem_def, mul_indicator_mul, finprod_mul_distrib hf hg]
end

/-- The product of constant one over any set equals one. -/
@[to_additive] lemma finprod_mem_one (s : set α) : ∏ᶠ i ∈ s, (1 : M) = 1 := by simp

/-- If a function `f` equals one on a set `s`, then the product of `f i` over `i ∈ s` equals one. -/
@[to_additive] lemma finprod_mem_of_eq_on_one (hf : eq_on f 1 s) : ∏ᶠ i ∈ s, f i = 1 :=
by { rw ← finprod_mem_one s, exact finprod_mem_congr rfl hf }

/-- If the product of `f i` over `i ∈ s` is not equal to one, then there is some `x ∈ s`
such that `f x ≠ 1`. -/
@[to_additive] lemma exists_ne_one_of_finprod_mem_ne_one (h : ∏ᶠ i ∈ s, f i ≠ 1) :
  ∃ x ∈ s, f x ≠ 1 :=
begin
  by_contra h', push_neg at h',
  exact h (finprod_mem_of_eq_on_one h')
end

/-- Given a finite set `s`, the product of `f i * g i` over `i ∈ s` equals the product of `f i`
over `i ∈ s` times the product of `g i` over `i ∈ s`. -/
@[to_additive] lemma finprod_mem_mul_distrib (hs : s.finite) :
  ∏ᶠ i ∈ s, (f i * g i) = (∏ᶠ i ∈ s, f i) * ∏ᶠ i ∈ s, g i :=
finprod_mem_mul_distrib' (hs.inter_of_left _) (hs.inter_of_left _)

@[to_additive] lemma monoid_hom.map_finprod {f : α → M} (g : M →* N) (hf : (mul_support f).finite) :
  g (∏ᶠ i, f i) = ∏ᶠ i, g (f i) :=
g.map_finprod_plift f $ hf.preimage $ equiv.plift.injective.inj_on _

/-- A more general version of `monoid_hom.map_finprod_mem` that requires `s ∩ mul_support f` and
  instead of `s` to be finite. -/
@[to_additive] lemma monoid_hom.map_finprod_mem' {f : α → M} (g : M →* N)
  (h₀ : (s ∩ mul_support f).finite) :
  g (∏ᶠ j ∈ s, f j) = ∏ᶠ i ∈ s, (g (f i)) :=
begin
  rw [g.map_finprod],
  { simp only [g.map_finprod_Prop] },
  { simpa only [finprod_eq_mul_indicator_apply, mul_support_mul_indicator] }
end

/-- Given a monoid homomorphism `g : M →* N`, and a function `f : α → M`, the value of `g` at the
product of `f i` over `i ∈ s` equals the product of `(g ∘ f) i` over `s`. -/
@[to_additive] lemma monoid_hom.map_finprod_mem (f : α → M) (g : M →* N) (hs : s.finite) :
  g (∏ᶠ j ∈ s, f j) = ∏ᶠ i ∈ s, g (f i) :=
g.map_finprod_mem' (hs.inter_of_left _)

/-!
### `∏ᶠ x ∈ s, f x` and set operations
-/

/-- The product of any function over an empty set is one. -/
@[to_additive] lemma finprod_mem_empty : ∏ᶠ i ∈ (∅ : set α), f i = 1 := by simp

/-- A set `s` is not empty if the product of some function over `s` is not equal to one. -/
@[to_additive] lemma nonempty_of_finprod_mem_ne_one (h : ∏ᶠ i ∈ s, f i ≠ 1) : s.nonempty :=
ne_empty_iff_nonempty.1 $ λ h', h $ h'.symm ▸ finprod_mem_empty

/-- Given finite sets `s` and `t`, the product of `f i` over `i ∈ s ∪ t` times the product of
`f i` over `i ∈ s ∩ t` equals the product of `f i` over `i ∈ s` times the product of `f i`
over `i ∈ t`. -/
@[to_additive] lemma finprod_mem_union_inter (hs : s.finite) (ht : t.finite) :
  (∏ᶠ i ∈ s ∪ t, f i) * ∏ᶠ i ∈ s ∩ t, f i = (∏ᶠ i ∈ s, f i) * ∏ᶠ i ∈ t, f i :=
begin
  unfreezingI { lift s to finset α using hs, lift t to finset α using ht },
  classical,
  rw [← finset.coe_union, ← finset.coe_inter],
  simp only [finprod_mem_coe_finset, finset.prod_union_inter]
end

/-- A more general version of `finprod_mem_union_inter` that requires `s ∩ mul_support f` and
`t ∩ mul_support f` instead of `s` and `t` to be finite. -/
@[to_additive] lemma finprod_mem_union_inter'
  (hs : (s ∩ mul_support f).finite) (ht : (t ∩ mul_support f).finite) :
  (∏ᶠ i ∈ s ∪ t, f i) * ∏ᶠ i ∈ s ∩ t, f i = (∏ᶠ i ∈ s, f i) * ∏ᶠ i ∈ t, f i :=
begin
  rw [← finprod_mem_inter_mul_support f s, ← finprod_mem_inter_mul_support f t,
    ← finprod_mem_union_inter hs ht, ← union_inter_distrib_right, finprod_mem_inter_mul_support,
    ← finprod_mem_inter_mul_support f (s ∩ t)],
  congr' 2,
  rw [inter_left_comm, inter_assoc, inter_assoc, inter_self, inter_left_comm]
end

/-- A more general version of `finprod_mem_union` that requires `s ∩ mul_support f` and
`t ∩ mul_support f` instead of `s` and `t` to be finite. -/
@[to_additive] lemma finprod_mem_union' (hst : disjoint s t) (hs : (s ∩ mul_support f).finite)
  (ht : (t ∩ mul_support f).finite) :
  ∏ᶠ i ∈ s ∪ t, f i = (∏ᶠ i ∈ s, f i) * ∏ᶠ i ∈ t, f i :=
by rw [← finprod_mem_union_inter' hs ht, disjoint_iff_inter_eq_empty.1 hst, finprod_mem_empty,
  mul_one]

/-- Given two finite disjoint sets `s` and `t`, the product of `f i` over `i ∈ s ∪ t` equals the
product of `f i` over `i ∈ s` times the product of `f i` over `i ∈ t`. -/
@[to_additive] lemma finprod_mem_union (hst : disjoint s t) (hs : s.finite) (ht : t.finite) :
  ∏ᶠ i ∈ s ∪ t, f i = (∏ᶠ i ∈ s, f i) * ∏ᶠ i ∈ t, f i :=
finprod_mem_union' hst (hs.inter_of_left _) (ht.inter_of_left _)

/-- A more general version of `finprod_mem_union'` that requires `s ∩ mul_support f` and
`t ∩ mul_support f` instead of `s` and `t` to be disjoint -/
@[to_additive] lemma finprod_mem_union'' (hst : disjoint (s ∩ mul_support f) (t ∩ mul_support f))
  (hs : (s ∩ mul_support f).finite) (ht : (t ∩ mul_support f).finite) :
  ∏ᶠ i ∈ s ∪ t, f i = (∏ᶠ i ∈ s, f i) * ∏ᶠ i ∈ t, f i :=
by rw [← finprod_mem_inter_mul_support f s, ← finprod_mem_inter_mul_support f t,
  ← finprod_mem_union hst hs ht, ← union_inter_distrib_right, finprod_mem_inter_mul_support]

/-- The product of `f i` over `i ∈ {a}` equals `f a`. -/
@[to_additive] lemma finprod_mem_singleton : ∏ᶠ i ∈ ({a} : set α), f i = f a :=
by rw [← finset.coe_singleton, finprod_mem_coe_finset, finset.prod_singleton]

@[simp, to_additive] lemma finprod_cond_eq_left : ∏ᶠ i = a, f i = f a :=
finprod_mem_singleton

@[simp, to_additive] lemma finprod_cond_eq_right : ∏ᶠ i (hi : a = i), f i = f a :=
by simp [@eq_comm _ a]

/-- A more general version of `finprod_mem_insert` that requires `s ∩ mul_support f` instead of
`s` to be finite. -/
@[to_additive] lemma finprod_mem_insert' (f : α → M) (h : a ∉ s)
  (hs : (s ∩ mul_support f).finite) :
  ∏ᶠ i ∈ insert a s, f i = f a * ∏ᶠ i ∈ s, f i :=
begin
  rw [insert_eq, finprod_mem_union' _ _ hs, finprod_mem_singleton],
  { rwa disjoint_singleton_left },
  { exact (finite_singleton a).inter_of_left _ }
end

/-- Given a finite set `s` and an element `a ∉ s`, the product of `f i` over `i ∈ insert a s` equals
`f a` times the product of `f i` over `i ∈ s`. -/
@[to_additive] lemma finprod_mem_insert (f : α → M) (h : a ∉ s) (hs : s.finite) :
  ∏ᶠ i ∈ insert a s, f i = f a * ∏ᶠ i ∈ s, f i :=
finprod_mem_insert' f h $ hs.inter_of_left _

/-- If `f a = 1` for all `a ∉ s`, then the product of `f i` over `i ∈ insert a s` equals the
product of `f i` over `i ∈ s`. -/
@[to_additive] lemma finprod_mem_insert_of_eq_one_if_not_mem (h : a ∉ s → f a = 1) :
  ∏ᶠ i ∈ (insert a s), f i = ∏ᶠ i ∈ s, f i :=
begin
  refine finprod_mem_inter_mul_support_eq' _ _ _ (λ x hx, ⟨_, or.inr⟩),
  rintro (rfl|hxs),
  exacts [not_imp_comm.1 h hx, hxs]
end

/-- If `f a = 1`, then the product of `f i` over `i ∈ insert a s` equals the product of `f i` over
`i ∈ s`. -/
@[to_additive] lemma finprod_mem_insert_one (h : f a = 1) :
  ∏ᶠ i ∈ (insert a s), f i = ∏ᶠ i ∈ s, f i :=
finprod_mem_insert_of_eq_one_if_not_mem (λ _, h)

/-- The product of `f i` over `i ∈ {a, b}`, `a ≠ b`, is equal to `f a * f b`. -/
@[to_additive] lemma finprod_mem_pair (h : a ≠ b) : ∏ᶠ i ∈ ({a, b} : set α), f i = f a * f b :=
by { rw [finprod_mem_insert, finprod_mem_singleton], exacts [h, finite_singleton b] }

/-- The product of `f y` over `y ∈ g '' s` equals the product of `f (g i)` over `s`
provided that `g` is injective on `s ∩ mul_support (f ∘ g)`. -/
@[to_additive] lemma finprod_mem_image' {s : set β} {g : β → α}
  (hg : set.inj_on g (s ∩ mul_support (f ∘ g))) :
  ∏ᶠ i ∈ (g '' s), f i = ∏ᶠ j ∈ s, f (g j) :=
begin
  classical,
  by_cases hs : finite (s ∩ mul_support (f ∘ g)),
  { have hg : ∀ (x ∈ hs.to_finset) (y ∈ hs.to_finset), g x = g y → x = y,
      by simpa only [hs.mem_to_finset],
    rw [finprod_mem_eq_prod _ hs, ← finset.prod_image hg],
    refine finprod_mem_eq_prod_of_inter_mul_support_eq f _,
    rw [finset.coe_image, hs.coe_to_finset, ← image_inter_mul_support_eq, inter_assoc,
      inter_self] },
  { rw [finprod_mem_eq_one_of_infinite hs, finprod_mem_eq_one_of_infinite],
    rwa [image_inter_mul_support_eq, infinite_image_iff hg] }
end

/-- The product of `f y` over `y ∈ g '' s` equals the product of `f (g i)` over `s`
provided that `g` is injective on `s`. -/
@[to_additive] lemma finprod_mem_image {β} {s : set β} {g : β → α} (hg : set.inj_on g s) :
  ∏ᶠ i ∈ (g '' s), f i = ∏ᶠ j ∈ s, f (g j) :=
finprod_mem_image' $ hg.mono $ inter_subset_left _ _

/-- The product of `f y` over `y ∈ set.range g` equals the product of `f (g i)` over all `i`
provided that `g` is injective on `mul_support (f ∘ g)`. -/
@[to_additive] lemma finprod_mem_range' {g : β → α} (hg : set.inj_on g (mul_support (f ∘ g))) :
  ∏ᶠ i ∈ range g, f i = ∏ᶠ j, f (g j) :=
begin
  rw [← image_univ, finprod_mem_image', finprod_mem_univ],
  rwa univ_inter
end

/-- The product of `f y` over `y ∈ set.range g` equals the product of `f (g i)` over all `i`
provided that `g` is injective. -/
@[to_additive] lemma finprod_mem_range {g : β → α} (hg : injective g) :
  ∏ᶠ i ∈ range g, f i = ∏ᶠ j, f (g j) :=
finprod_mem_range' (hg.inj_on _)

/-- The product of `f i` over `s : set α` is equal to the product of `g j` over `t : set β`
if there exists a function `e : α → β` such that `e` is bijective from `s` to `t` and for all
`x` in `s` we have `f x = g (e x)`. -/
@[to_additive] lemma finprod_mem_eq_of_bij_on {s : set α} {t : set β} {f : α → M} {g : β → M}
  (e : α → β) (he₀ : set.bij_on e s t) (he₁ : ∀ x ∈ s, f x = g (e x)) :
  ∏ᶠ i ∈ s, f i = ∏ᶠ j ∈ t, g j :=
begin
  rw [← set.bij_on.image_eq he₀, finprod_mem_image he₀.2.1],
  exact finprod_mem_congr rfl he₁
end

@[to_additive] lemma finprod_set_coe_eq_finprod_mem (s : set α) : ∏ᶠ j : s, f j = ∏ᶠ i ∈ s, f i :=
begin
  rw [← finprod_mem_range, subtype.range_coe],
  exact subtype.coe_injective
end

@[to_additive] lemma finprod_subtype_eq_finprod_cond (p : α → Prop) :
  ∏ᶠ j : subtype p, f j = ∏ᶠ i (hi : p i), f i :=
finprod_set_coe_eq_finprod_mem {i | p i}

@[to_additive] lemma finprod_mem_inter_mul_diff' (t : set α) (h : (s ∩ mul_support f).finite) :
  (∏ᶠ i ∈ s ∩ t, f i) * ∏ᶠ i ∈ s \ t, f i = ∏ᶠ i ∈ s, f i :=
begin
  rw [← finprod_mem_union', inter_union_diff],
  exacts [λ x hx, hx.2.2 hx.1.2, h.subset (λ x hx, ⟨hx.1.1, hx.2⟩),
    h.subset (λ x hx, ⟨hx.1.1, hx.2⟩)],
end

@[to_additive] lemma finprod_mem_inter_mul_diff (t : set α) (h : s.finite) :
  (∏ᶠ i ∈ s ∩ t, f i) * ∏ᶠ i ∈ s \ t, f i = ∏ᶠ i ∈ s, f i :=
finprod_mem_inter_mul_diff' _ $ h.inter_of_left _

/-- A more general version of `finprod_mem_mul_diff` that requires `t ∩ mul_support f` instead of
  `t` to be finite. -/
@[to_additive] lemma finprod_mem_mul_diff' (hst : s ⊆ t) (ht : (t ∩ mul_support f).finite) :
  (∏ᶠ i ∈ s, f i) * ∏ᶠ i ∈ t \ s, f i = ∏ᶠ i ∈ t, f i :=
by rw [← finprod_mem_inter_mul_diff' _ ht, inter_eq_self_of_subset_right hst]

/-- Given a finite set `t` and a subset `s` of `t`, the product of `f i` over `i ∈ s`
times the product of `f i` over `t \ s` equals the product of `f i` over `i ∈ t`. -/
@[to_additive] lemma finprod_mem_mul_diff (hst : s ⊆ t) (ht : t.finite) :
  (∏ᶠ i ∈ s, f i) * ∏ᶠ i ∈ t \ s, f i = ∏ᶠ i ∈ t, f i :=
finprod_mem_mul_diff' hst (ht.inter_of_left _)

/-- Given a family of pairwise disjoint finite sets `t i` indexed by a finite type,
the product of `f a` over the union `⋃ i, t i` is equal to the product over all indexes `i`
of the products of `f a` over `a ∈ t i`. -/
@[to_additive] lemma finprod_mem_Union [fintype ι] {t : ι → set α}
  (h : pairwise (disjoint on t)) (ht : ∀ i, (t i).finite) :
  ∏ᶠ a ∈ (⋃ i : ι, t i), f a = ∏ᶠ i, (∏ᶠ a ∈ t i, f a) :=
begin
  unfreezingI { lift t to ι → finset α using ht },
  classical,
  rw [← bUnion_univ, ← finset.coe_univ, ← finset.coe_bUnion,
    finprod_mem_coe_finset, finset.prod_bUnion],
  { simp only [finprod_mem_coe_finset, finprod_eq_prod_of_fintype] },
  { exact λ x _ y _ hxy, finset.disjoint_iff_disjoint_coe.2 (h x y hxy) }
end

/-- Given a family of sets `t : ι → set α`, a finite set `I` in the index type such that all
sets `t i`, `i ∈ I`, are finite, if all `t i`, `i ∈ I`, are pairwise disjoint, then
the product of `f a` over `a ∈ ⋃ i ∈ I, t i` is equal to the product over `i ∈ I`
of the products of `f a` over `a ∈ t i`. -/
@[to_additive] lemma finprod_mem_bUnion {I : set ι} {t : ι → set α}
  (h : pairwise_on I (disjoint on t)) (hI : I.finite) (ht : ∀ i ∈ I, (t i).finite) :
  ∏ᶠ a ∈ ⋃ x ∈ I, t x, f a = ∏ᶠ i ∈ I, ∏ᶠ j ∈ t i, f j :=
begin
  haveI := hI.fintype,
  rw [← Union_subtype, finprod_mem_Union, ← finprod_set_coe_eq_finprod_mem],
  exacts [λ x y hxy, h x x.2 y y.2 (subtype.coe_injective.ne hxy), λ b, ht b b.2]
end

/-- If `t` is a finite set of pairwise disjoint finite sets, then the product of `f a`
over `a ∈ ⋃₀ t` is the product over `s ∈ t` of the products of `f a` over `a ∈ s`. -/
@[to_additive] lemma finprod_mem_sUnion {t : set (set α)} (h : pairwise_on t disjoint)
  (ht₀ : t.finite) (ht₁ : ∀ x ∈ t, set.finite x):
  ∏ᶠ a ∈ ⋃₀ t, f a = ∏ᶠ s ∈ t, ∏ᶠ a ∈ s, f a :=
by rw [set.sUnion_eq_bUnion, finprod_mem_bUnion h ht₀ ht₁]

/-- If `s : set α` and `t : set β` are finite sets, then the product over `s` commutes
with the product over `t`. -/
@[to_additive] lemma finprod_mem_comm {s : set α} {t : set β}
  (f : α → β → M) (hs : s.finite) (ht : t.finite) :
  ∏ᶠ i ∈ s, ∏ᶠ j ∈ t, f i j = ∏ᶠ j ∈ t, ∏ᶠ i ∈ s, f i j :=
begin
  unfreezingI { lift s to finset α using hs, lift t to finset β using ht },
  simp only [finprod_mem_coe_finset],
  exact finset.prod_comm
end

/-- To prove a property of a finite product, it suffices to prove that the property is
multiplicative and holds on multipliers. -/
@[to_additive] lemma finprod_mem_induction (p : M → Prop) (hp₀ : p 1)
  (hp₁ : ∀ x y, p x → p y → p (x * y)) (hp₂ : ∀ x ∈ s, p $ f x) :
  p (∏ᶠ i ∈ s, f i) :=
begin
  by_cases hs : (s ∩ mul_support f).finite,
  { rw [finprod_mem_eq_prod _ hs],
    refine finset.prod_induction _ p hp₁ hp₀ (λ x hx, hp₂ x _),
    rw hs.mem_to_finset at hx, exact hx.1 },
  { exact (finprod_mem_eq_one_of_infinite hs).symm ▸ hp₀ }
end

lemma finprod_cond_nonneg {R : Type*} [ordered_comm_semiring R] {p : α → Prop} {f : α → R}
  (hf : ∀ x, p x → 0 ≤ f x) :
  0 ≤ ∏ᶠ x (h : p x), f x :=
finprod_nonneg $ λ x, finprod_nonneg $ hf x

lemma finprod_eq_zero {M₀ : Type*} [comm_monoid_with_zero M₀] (f : α → M₀) (x : α)
  (hx : f x = 0) (hf : finite (mul_support f)) :
  ∏ᶠ x, f x = 0 :=
begin
  nontriviality,
  rw [finprod_eq_prod f hf],
  refine finset.prod_eq_zero (hf.mem_to_finset.2 _) hx,
  simp [hx]
end

@[to_additive] lemma finprod_prod_comm (s : finset β) (f : α → β → M)
  (h : ∀ b ∈ s, (mul_support (λ a, f a b)).finite) :
  ∏ᶠ a : α, ∏ b in s, f a b = ∏ b in s, ∏ᶠ a : α, f a b :=
begin
  have hU : mul_support (λ a, ∏ b in s, f a b) ⊆
    (s.finite_to_set.bUnion (λ b hb, h b (finset.mem_coe.1 hb))).to_finset,
  { rw finite.coe_to_finset,
    intros x hx,
    simp only [exists_prop, mem_Union, ne.def, mem_mul_support, finset.mem_coe],
    contrapose! hx,
    rw [mem_mul_support, not_not, finset.prod_congr rfl hx, finset.prod_const_one] },
  rw [finprod_eq_prod_of_mul_support_subset _ hU, finset.prod_comm],
  refine finset.prod_congr rfl (λ b hb, (finprod_eq_prod_of_mul_support_subset _ _).symm),
  intros a ha,
  simp only [finite.coe_to_finset, mem_Union],
  exact ⟨b, hb, ha⟩
end

@[to_additive] lemma prod_finprod_comm (s : finset α) (f : α → β → M)
  (h : ∀ a ∈ s, (mul_support (f a)).finite) :
  ∏ a in s, ∏ᶠ b : β, f a b = ∏ᶠ b : β, ∏ a in s, f a b :=
(finprod_prod_comm s (λ b a, f a b) h).symm

lemma mul_finsum {R : Type*} [semiring R] (f : α → R) (r : R)
  (h : (function.support f).finite) :
  r * ∑ᶠ a : α, f a = ∑ᶠ a : α, r * f a :=
(add_monoid_hom.mul_left r).map_finsum h

lemma finsum_mul {R : Type*} [semiring R] (f : α → R) (r : R)
  (h : (function.support f).finite) :
  (∑ᶠ a : α, f a) * r = ∑ᶠ a : α, f a * r :=
(add_monoid_hom.mul_right r).map_finsum h

end type


/-
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 analysis.special_functions.pow
import limsup
import ring_seminorm

/-!
# smoothing_seminorm
In this file, we prove [BGR, Proposition 1.3.2/1] : if `f` is a nonarchimedean seminorm on `R`,
then `infi (λ (n : pnat), (f(x^(n : ℕ)))^(1/(n : ℝ)))` is a power-multiplicative nonarchimedean
seminorm on `R`.

## Main Definitions

* `smoothing_seminorm_seq` : the `ℝ`-valued sequence sending `n` to `(f (x ^ n))^(1/n : ℝ)`.
* `smoothing_seminorm_def` : The infi of the sequence `f(x^(n : ℕ)))^(1/(n : ℝ)`.
* `smoothing_seminorm` : iIf `f 1 ≤ 1` and `f` is nonarchimedean, then `smoothing_seminorm_def`
  is a ring seminorm.

## Main Results

* `smoothing_seminorm_def_is_limit` :if `f 1 ≤ 1`, then `smoothing_seminorm_def f x` is the limit
  of `smoothing_seminorm_seq f x` as `n` tends to infinity.
* `smoothing_seminorm_is_nonarchimedean` : if `f 1 ≤ 1` and `f` is nonarchimedean, then
  `smoothing_seminorm_def` is nonarchimedean.
* `smoothing_seminorm_is_pow_mul` : if `f 1 ≤ 1` and `f` is nonarchimedean, then
  `smoothing_seminorm_def f` is power-multiplicative.

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

## Tags

smoothing_seminorm, seminorm, nonarchimedean
-/

noncomputable theory

open real

open_locale topological_space nnreal

-- In this section we prove auxiliary lemmas, which will be PR'd to the appropriate mathlib files.
section aux_lemmas

/-- If `a` belongs to the interval `[0, b]`, then so does `b - a`. -/
lemma sub_mem_closure {a b : ℝ} (h : a ∈ set.Icc (0 : ℝ) b) :
  b - a ∈ set.Icc (0 : ℝ) b :=
begin
  rw [set.mem_Icc] at h ⊢,
  rw [sub_le_self_iff],
  exact ⟨sub_nonneg_of_le h.2, h.1⟩
end

/-- If `x` is multiplicative with respect to `f`, then so is any `x^n`. -/
lemma is_mul_pow_of_is_mul {R : Type*} [comm_ring R] (f : R → ℝ) {x : R}
  (hx : ∀ y : R, f (x * y) = f x * f y) :
  ∀ (n : ℕ) (y : R), f (x ^ n * y) = f x ^ n * f y :=
begin
  { intros n,
    induction n with n hn,
    { intro y, rw [pow_zero, pow_zero, one_mul, one_mul]},
    { intro y, rw [pow_succ', pow_succ', mul_assoc, mul_assoc, ← hx y], exact hn _, }},
end

/-- For any `r : ℝ≥0` and any positive `n : ℕ`,  `(r ^ n)^(1/n : ℝ) = r`. -/
lemma nnreal.pow_n_n_inv (r : ℝ≥0) {n : ℕ} (hn : 0 < n) : (r ^ n)^(1/n : ℝ) = r :=
begin
  have hn1 : (n : ℝ) * (1/n) = 1,
  { apply mul_one_div_cancel,
    exact (nat.cast_ne_zero.mpr (nat.one_le_iff_ne_zero.mp hn)) },
  conv_rhs { rw [← nnreal.rpow_one r, ← hn1] },
  rw [nnreal.rpow_mul, nnreal.rpow_nat_cast],
end

/-- For any nonnegative `r : ℝ` and any positive `n : ℕ`,  `(r ^ n)^(1/n : ℝ) = r`. -/
lemma real.pow_n_n_inv {r : ℝ} (hr : 0 ≤ r) {n : ℕ} (hn : 0 < n) : (r ^ n)^(1/n : ℝ) = r :=
begin
  have hn1 : (n : ℝ) * (1/n) = 1,
  { apply mul_one_div_cancel,
    exact (nat.cast_ne_zero.mpr (nat.one_le_iff_ne_zero.mp hn)) },
  conv_rhs { rw [← rpow_one r, ← hn1] },
  rw [real.rpow_mul hr, rpow_nat_cast],
end

namespace filter

/-- If there exists real constants `b`and `B` such that for `n` big enough, `b ≤ f n ≤ B`, then
  `f n / (n : ℝ)` tends to `0` as `n` tends to infinity. -/
lemma tendsto_bdd_div_at_top_nhds_0_nat (f : ℕ → ℝ) (hfb : ∃ b : ℝ, ∀ᶠ (n : ℕ) in at_top, b ≤ f n)
  (hfB : ∃ B : ℝ, ∀ᶠ (n : ℕ) in at_top, f n ≤ B) :
  tendsto (λ (n: ℕ), ((f n / (n : ℝ)))) at_top (𝓝 0) :=
begin
  obtain ⟨b, hb⟩ := hfb,
  obtain ⟨B, hB⟩ := hfB,
  refine tendsto_of_tendsto_of_tendsto_of_le_of_le' (tendsto_const_div_at_top_nhds_0_nat b)
    (tendsto_const_div_at_top_nhds_0_nat B) _ _,
  { simp only [eventually_at_top, ge_iff_le] at hb ⊢,
    obtain ⟨N, hN⟩ := hb,
    use N, intros n hn,
    exact div_le_div_of_le (nat.cast_nonneg _) (hN n hn) },
  { simp only [eventually_at_top, ge_iff_le] at hB ⊢,
    obtain ⟨N, hN⟩ := hB,
    use N, intros n hn,
    exact div_le_div_of_le (nat.cast_nonneg _) (hN n hn) },
end

/-- For any positive `m : ℕ`, `((n % m : ℕ) : ℝ) / (n : ℝ)` tends to `0` as `n` tends to `∞`. -/
lemma tendsto_mod_div_at_top_nhds_0_nat {m : ℕ} (hm : 0 < m) :
  tendsto (λ (n: ℕ), (((n % m : ℕ) : ℝ) / (n : ℝ))) at_top (𝓝 0) :=
begin
  apply tendsto_bdd_div_at_top_nhds_0_nat (λ (n: ℕ), ((n % m : ℕ) : ℝ)),
  { use 0,
    apply eventually_of_forall,
    intros n,
    simp only [nat.cast_nonneg], },
  { use m,
    apply eventually_of_forall,
    intros n,
    simp only [nat.cast_le,le_of_lt (nat.mod_lt n hm)] }
end

/-- If `u` tends to `∞` as `n` tends to `∞`, then for `n` big enough
`((s n : ℝ) / (u n : ℝ)) * (u n : ℝ) = (s n : ℝ)` holds. -/
lemma div_mul_eventually_cancel (s : ℕ → ℕ) {u : ℕ → ℕ} (hu : tendsto u at_top at_top) :
  (λ n, ((s n : ℝ) / (u n : ℝ)) * (u n : ℝ)) =ᶠ[at_top] (λ n, (s n : ℝ)) :=
begin
  simp only [eventually_eq, eventually_at_top, ge_iff_le],
  simp only [tendsto_at_top, eventually_at_top, ge_iff_le] at hu,
  obtain ⟨n, hn⟩ := hu 1,
  use n,
  intros m hm,
  rw div_mul_cancel (s m : ℝ) (nat.cast_ne_zero.mpr (nat.one_le_iff_ne_zero.mp (hn m hm))),
end

/-- If when `n` tends to `∞`, `u` tends to `∞` and `(s n : ℝ) / (u n : ℝ))` tends to a nonzero
  constant, then `s` tends to `∞`. -/
lemma tendsto.num {s u : ℕ → ℕ} (hu : tendsto u at_top at_top) {a : ℝ} (ha : 0 < a)
  (hlim : tendsto (λ (n : ℕ), (s n : ℝ) / (u n : ℝ)) at_top (𝓝 a)) : tendsto s at_top at_top :=
tendsto_coe_nat_at_top_iff.mp (tendsto.congr' (div_mul_eventually_cancel s hu)
  (tendsto.mul_at_top ha hlim (tendsto_coe_nat_at_top_iff.mpr hu)))

/-- If `f` is a ring seminorm on `R` with `f 1 ≤ 1` and `s : ℕ → ℕ` is bounded by `n`, then
  `f (x ^ s (φ n)) ^ (1 / (φ n : ℝ))` is eventually bounded. -/
lemma is_bdd_under {R : Type*} [comm_ring R] (f : ring_seminorm R) (hf1 : f 1 ≤ 1)
  {s : ℕ → ℕ} (hs_le : ∀ n : ℕ, s n ≤ n) {x : R} (φ : ℕ → ℕ) :
  is_bounded_under has_le.le at_top (λ (n : ℕ), f (x ^ s (φ n)) ^ (1 / (φ n : ℝ))) :=
begin
  have h_le : ∀ m : ℕ, f (x ^ s (φ m)) ^ (1 / (φ m : ℝ)) ≤ (f x) ^ ((s (φ m) : ℝ) / (φ m : ℝ)),
    { intro m,
      rw [← mul_one_div (s (φ m) : ℝ), rpow_mul (map_nonneg f x), rpow_nat_cast],
      exact rpow_le_rpow (map_nonneg _ _) (map_pow_le_pow' hf1 x _)
        (one_div_nonneg.mpr (nat.cast_nonneg _)) },
  apply is_bounded_under_of,
  by_cases hfx : f x ≤ 1,
  { use [1, λ m, le_trans (h_le m) (real.rpow_le_one (map_nonneg _ _) hfx
      (div_nonneg (nat.cast_nonneg _) (nat.cast_nonneg _)))] },
  { use (f x),
    intro m,
    apply le_trans (h_le m),
    conv_rhs{ rw ← rpow_one (f x) },
    exact rpow_le_rpow_of_exponent_le (le_of_lt (not_le.mp hfx))
      (div_le_one_of_le (nat.cast_le.mpr (hs_le _)) (nat.cast_nonneg _)), }
end

end filter

end aux_lemmas

open filter

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

section smoothing_seminorm

/-- The `ℝ`-valued sequence sending `n` to `(f (x ^ n))^(1/n : ℝ)`. -/
def smoothing_seminorm_seq (x : R) : ℕ → ℝ := λ n, (f (x ^ n))^(1/n : ℝ)

/-- For any positive `ε`, there exists a positive natural number `m` such that
  `infi (λ (n : pnat), (f(x ^(n : ℕ)))^(1/(n : ℝ))) + ε/2`. -/
lemma smoothing_seminorm_seq_has_limit_m (x : R) {ε : ℝ} (hε : 0 < ε) :
  ∃ (m : pnat), (f (x ^(m : ℕ)))^(1/m : ℝ) <
    infi (λ (n : pnat), (f(x ^(n : ℕ)))^(1/(n : ℝ))) + ε/2 :=
exists_lt_of_cinfi_lt (lt_add_of_le_of_pos (le_refl _) (half_pos hε))

lemma smoothing_seminorm_seq_has_limit_aux {L : ℝ} (hL : 0 ≤ L) {ε : ℝ} (hε : 0 < ε)
  {m1 : ℕ} (hm1 : 0 < m1) {x : R} (hx : f x ≠ 0) :
  tendsto (λ (n : ℕ), (L + ε)^
    (-(((n % m1 : ℕ) : ℝ)/(n : ℝ)))*((f x) ^(n % m1)) ^ (1 / (n : ℝ))) at_top (𝓝 1) :=
begin
  rw ← mul_one (1 : ℝ),
  have h_exp : tendsto (λ (n: ℕ), (((n % m1 : ℕ) : ℝ) / (n : ℝ))) at_top (𝓝 0) :=
  tendsto_mod_div_at_top_nhds_0_nat hm1,
  apply tendsto.mul,
  { have h0 : tendsto (λ (t : ℕ), -(((t % m1 : ℕ) : ℝ) / (t : ℝ))) at_top (𝓝 0),
    { rw ← neg_zero, exact tendsto.neg h_exp, },
    rw [← rpow_zero (L + ε)],
    apply tendsto.rpow tendsto_const_nhds h0,
    rw [ne.def, add_eq_zero_iff' hL (le_of_lt hε)],
    exact or.inl (not_and_of_not_right _ (ne_of_gt hε)) },
  { simp_rw [mul_one, ← rpow_nat_cast, ← rpow_mul (map_nonneg f x), ← mul_div_assoc,
      mul_one, ← rpow_zero (f x)],
    exact tendsto.rpow tendsto_const_nhds h_exp (or.inl hx), },
end

/-- `smoothing_seminorm_seq` is bounded below by zero. -/
lemma smoothing_seminorm_seq_bdd (x : R) :
  bdd_below (set.range (λ (n : ℕ+), f (x ^(n : ℕ)) ^ (1 / (n : ℝ)))) :=
begin
  use 0,
  rintros y ⟨n, rfl⟩,
  exact rpow_nonneg_of_nonneg (map_nonneg f _) _,
end

/-- The infi of the sequence `f(x^(n : ℕ)))^(1/(n : ℝ)`. -/
def smoothing_seminorm_def (x : R) : ℝ := infi (λ (n : pnat), (f(x^(n : ℕ)))^(1/(n : ℝ)))

/-- If `f x = 0`, then `smoothing_seminorm_def f x` is the limit of `smoothing_seminorm_seq f x`. -/
lemma smoothing_seminorm_def_is_limit_zero {x : R} (hx : f x = 0) :
  tendsto ((smoothing_seminorm_seq f x)) at_top (𝓝 (smoothing_seminorm_def f x)) :=
begin
  have h0 : ∀ (n : ℕ) (hn : 1 ≤ n), (f (x ^ n))^(1/(n : ℝ)) = 0,
  { intros n hn,
    have hfn : f (x ^ n) = 0,
    { apply le_antisymm _ (map_nonneg f _),
      rw [← zero_pow hn, ← hx],
      exact map_pow_le_pow _ x (nat.one_le_iff_ne_zero.mp hn) },
    rw [hfn, zero_rpow (nat.one_div_cast_ne_zero (nat.one_le_iff_ne_zero.mp hn))], },
  have hL0 : infi (λ (n : pnat), (f(x^(n : ℕ)))^(1/(n : ℝ))) = 0 :=
  le_antisymm (cinfi_le_of_le (smoothing_seminorm_seq_bdd f x) (1 : pnat)
    (le_of_eq (h0 1 (le_refl _)))) (le_cinfi (λ n, rpow_nonneg_of_nonneg (map_nonneg f _) _)),
  simp only [hL0, smoothing_seminorm_seq, smoothing_seminorm_def],
  exact tendsto_at_top_of_eventually_const h0,
end

/-- If `f 1 ≤ 1` and `f x ≠  0`, then `smoothing_seminorm_def f x` is the limit of
`smoothing_seminorm_seq f x`. -/
lemma smoothing_seminorm_def_is_limit_ne_zero (hf1 : f 1 ≤ 1) {x : R} (hx : f x ≠ 0) :
  tendsto ((smoothing_seminorm_seq f x)) at_top (𝓝 (smoothing_seminorm_def f x)) :=
begin
  simp only [smoothing_seminorm_def],
  set L := infi (λ (n : pnat), (f(x^(n : ℕ)))^(1/(n : ℝ))) with hL,
  have hL0 : 0 ≤ L := le_cinfi (λ x, rpow_nonneg_of_nonneg (map_nonneg _ _) _),
  rw metric.tendsto_at_top,
  intros ε hε,
  obtain ⟨m1, hm1⟩ := smoothing_seminorm_seq_has_limit_m f x hε,
  obtain ⟨m2, hm2⟩ : ∃ m : ℕ, ∀ (n ≥ m), (L + ε/2)^
    (-(((n % m1 : ℕ) : ℝ)/(n : ℝ)))*((f x) ^(n % m1)) ^ (1 / (n : ℝ)) - 1 ≤
    ε/(2 * (L + ε/2)),
  { have hε2 : 0 < ε/2 := half_pos hε,
    have hL2  := smoothing_seminorm_seq_has_limit_aux f hL0 hε2 (pnat.pos m1) hx,
    rw metric.tendsto_at_top at hL2,
    set δ : ℝ := ε/(2 * (L + ε/2)) with hδ_def,
    have hδ : 0 < δ,
    { rw [hδ_def, div_mul_eq_div_mul_one_div],
      exact mul_pos hε2
        ((one_div (L + ε/2)).symm ▸ inv_pos_of_pos (add_pos_of_nonneg_of_pos hL0 hε2)), },
    obtain ⟨N, hN⟩ := hL2 δ hδ,
    use N,
    intros n hn,
    specialize hN n hn,
    rw [real.dist_eq, abs_lt] at hN,
    exact le_of_lt hN.right },
  use max (m1 : ℕ) m2,
  intros n hn,
  have hn0 : 0 < n := lt_of_lt_of_le (lt_of_lt_of_le (pnat.pos m1) (le_max_left m1 m2)) hn,
  rw [real.dist_eq, abs_lt],
  have hL_le : L ≤ smoothing_seminorm_seq f x n,
  { simp only [smoothing_seminorm_seq],
    rw ← pnat.mk_coe n hn0,
    apply cinfi_le (smoothing_seminorm_seq_bdd f x), },
  refine ⟨lt_of_lt_of_le (neg_lt_zero.mpr hε) (sub_nonneg.mpr hL_le), _⟩,
  { suffices h : smoothing_seminorm_seq f x n < L + ε,
    { rw tsub_lt_iff_left hL_le, exact h },
    by_cases hxn : f (x ^(n % m1)) = 0,
    { simp only [smoothing_seminorm_seq],
      nth_rewrite 0 ← nat.div_add_mod n m1,
      have hLε : 0 < L + ε := add_pos_of_nonneg_of_pos hL0 hε,
      apply lt_of_le_of_lt _ hLε,
      rw [pow_add, ← mul_zero ((f (x ^ ((m1 : ℕ) * (n / (m1 : ℕ))))) ^ (1/(n : ℝ))),
        ← zero_rpow (nat.one_div_cast_ne_zero (pos_iff_ne_zero.mp hn0)), ← hxn,
          ← mul_rpow (map_nonneg f _) (map_nonneg f _)],
      exact rpow_le_rpow (map_nonneg f _) (map_mul_le_mul f _ _)
        (nat.one_div_cast_nonneg _) },
    { have hxn' : 0 < f (x ^ (n % ↑m1)) := lt_of_le_of_ne (map_nonneg _ _) (ne.symm hxn),
      simp only [smoothing_seminorm_seq],
      nth_rewrite 0 ← nat.div_add_mod n m1,
      have h : f (x ^ ((m1 : ℕ) * (n / (m1 : ℕ)))) ^ (1 / (n : ℝ))  ≤
        (f (x ^ (m1 : ℕ)) ^ (n / (m1 : ℕ))) ^ (1 / (n : ℝ)),
      { apply rpow_le_rpow (map_nonneg f _) _ (nat.one_div_cast_nonneg _),
        rw pow_mul,
        exact  map_pow_le_pow f (x^(m1 : ℕ))
          (pos_iff_ne_zero.mp (nat.div_pos (le_trans (le_max_left m1 m2) hn) (pnat.pos m1))) },
       have hL0' : 0 < L + ε / 2,
        { exact (add_pos_of_nonneg_of_pos hL0 (half_pos hε)), },
      have h1 : (f (x ^ (m1 : ℕ)) ^ (n / (m1 : ℕ))) ^ (1 / (n : ℝ))  <
        (L + ε/2) * ((L + ε/2) ^ -(((n % m1 : ℕ) : ℝ)/(n : ℝ))),
      { have hm10 : (m1 : ℝ) ≠ 0 := nat.cast_ne_zero.mpr (ne_of_gt (pnat.pos m1)),
        rw [← rpow_lt_rpow_iff (real.rpow_nonneg_of_nonneg (map_nonneg f _) _) (le_of_lt hL0')
          (nat.cast_pos.mpr (pnat.pos m1)), ← rpow_mul (map_nonneg f _), ← coe_coe,
          one_div_mul_cancel hm10, rpow_one] at hm1,
        nth_rewrite 0 ← rpow_one (L + ε/2),
        have : (n : ℝ)/n = 1 := div_self (nat.cast_ne_zero.mpr (ne_of_gt hn0)),
        nth_rewrite 2 ← this, clear this,
        nth_rewrite 2 ← nat.div_add_mod n m1,
        have h_lt : 0 < ((n / m1 : ℕ) : ℝ) / (n : ℝ),
        { apply div_pos,
          { exact nat.cast_pos.mpr (nat.div_pos (le_trans (le_max_left _ _) hn) (pnat.pos m1)) },
          { exact nat.cast_pos.mpr hn0 }},
        rw [← rpow_nat_cast, ← rpow_add hL0', ← neg_div, div_add_div_same, nat.cast_add,
          add_neg_cancel_right, nat.cast_mul, ← rpow_mul (map_nonneg f _), mul_one_div,
          mul_div_assoc, rpow_mul (le_of_lt hL0')],
        exact rpow_lt_rpow (map_nonneg f _) hm1 h_lt },
      have h2 : f (x ^(n % m1)) ^ (1 / (n : ℝ)) ≤ (f x ^(n % m1)) ^ (1 / (n : ℝ)),
      { by_cases hnm1 : n % m1 = 0,
        { simpa[hnm1, pow_zero] using
            rpow_le_rpow (map_nonneg f _) hf1 (nat.one_div_cast_nonneg _) },
        { exact rpow_le_rpow (map_nonneg f _) (map_pow_le_pow f _ hnm1)
            (nat.one_div_cast_nonneg _), }},
      have h3 : (L + ε/2) * ((L + ε/2) ^
        -(((n%m1 : ℕ) : ℝ)/(n : ℝ))) * (f x ^(n % m1)) ^ (1 / (n : ℝ)) ≤ L + ε,
      { have heq :  L + ε = L + ε/2 + ε/2,
        { rw [add_assoc, add_halves']},
        have hL0' : 0 < L + ε / 2 ,
        { exact (add_pos_of_nonneg_of_pos hL0 (half_pos hε)), },
        rw [heq, ← tsub_le_iff_left],
        nth_rewrite 2 ← mul_one (L + ε / 2),
        rw [mul_assoc, ← mul_sub, mul_comm, ← le_div_iff hL0', div_div],
        exact hm2 n (le_trans (le_max_right m1 m2) hn) },
      have h4 : 0 < f (x ^ (n % ↑m1)) ^ (1 / (n : ℝ)) := rpow_pos_of_pos hxn' _,
      have h5 : 0 < (L + ε / 2) * (L + ε / 2) ^ -(↑(n % ↑m1) / (n : ℝ)) :=
      mul_pos hL0' (real.rpow_pos_of_pos hL0' _),
    calc f (x ^ ((m1 : ℕ) * (n / (m1 : ℕ)) + n % m1)) ^ (1 / (n : ℝ)) =
            f (x ^ ((m1 : ℕ) * (n /(m1 : ℕ))) * x ^(n % m1)) ^ (1 / (n : ℝ)) : by rw pow_add
      ... ≤ (f (x ^ ((m1 : ℕ) * (n / (m1 : ℕ)))) * f (x ^(n % m1))) ^ (1 / (n : ℝ)) :
            rpow_le_rpow (map_nonneg f _) (map_mul_le_mul f _ _) (nat.one_div_cast_nonneg _)
      ... = f (x ^ ((m1 : ℕ) * (n /(m1 : ℕ)))) ^ (1 / (n : ℝ)) * f (x ^(n % m1)) ^ (1 / (n : ℝ)) :
            mul_rpow (map_nonneg f _) (map_nonneg f _)
      ... ≤ (f (x ^ (m1 : ℕ)) ^ (n /(m1 : ℕ))) ^ (1 / (n : ℝ)) * f (x ^(n % m1)) ^ (1 / (n : ℝ)) :
            (mul_le_mul_right h4).mpr h
      ... < (L + ε/2) * ((L + ε/2) ^
            -(((n%m1 : ℕ) : ℝ)/(n : ℝ))) * f (x ^(n % m1)) ^ (1 / (n : ℝ)) : mul_lt_mul h1
              (le_refl _) h4 (le_of_lt h5)
      ... ≤ (L + ε/2) * ((L + ε/2) ^
            -(((n%m1 : ℕ) : ℝ)/(n : ℝ))) * (f x ^(n % m1)) ^ (1 / (n : ℝ)) :
            (mul_le_mul_left h5).mpr h2
      ... ≤  L + ε : h3  }}
end

/-- If `f 1 ≤ 1`, then `smoothing_seminorm_def f x` is the limit of `smoothing_seminorm_seq f x`
  as `n` tends to infinity. -/
lemma smoothing_seminorm_def_is_limit (hf1 : f 1 ≤ 1) (x : R) :
  tendsto ((smoothing_seminorm_seq f x)) at_top (𝓝 (smoothing_seminorm_def f x)) :=
begin
  by_cases hx : f x = 0,
  { exact smoothing_seminorm_def_is_limit_zero f hx },
  { exact smoothing_seminorm_def_is_limit_ne_zero f hf1 hx }
end

/-- If `f 1 ≤ 1`, then `smoothing_seminorm_def f x` is nonnegative. -/
lemma smoothing_seminorm_nonneg (hf1 : f 1 ≤ 1) (x : R) : 0 ≤ smoothing_seminorm_def f x :=
begin
  apply ge_of_tendsto (smoothing_seminorm_def_is_limit f hf1 x),
  simp only [eventually_at_top, ge_iff_le],
  use 1,
  rintros n hn,
  simp only [smoothing_seminorm_seq],
  exact rpow_nonneg_of_nonneg (map_nonneg f _) _,
end

/-- If `f 1 ≤ 1`, then `smoothing_seminorm_def f 0 = 0`. -/
lemma smoothing_seminorm_zero (hf1 : f 1 ≤ 1) : smoothing_seminorm_def f 0 = 0 :=
begin
  apply tendsto_nhds_unique_of_eventually_eq (smoothing_seminorm_def_is_limit f hf1 0)
    tendsto_const_nhds,
  simp only [eventually_eq, eventually_at_top, ge_iff_le],
  use 1,
  intros n hn,
  simp only [smoothing_seminorm_seq],
  rw [zero_pow (nat.succ_le_iff.mp hn), map_zero, zero_rpow],
  apply one_div_ne_zero,
  exact nat.cast_ne_zero.mpr (nat.one_le_iff_ne_zero.mp hn),
end

/-- If `f (-x) = f x`, the same holds for `smoothing_seminorm_def f`. -/
lemma smoothing_seminorm_neg (f_neg : ∀ x : R, f (-x) = f x) (x : R) :
  smoothing_seminorm_def f (-x) = smoothing_seminorm_def f x :=
begin
  simp only [smoothing_seminorm_def, smoothing_seminorm_def],
  congr, ext n,
  rw neg_pow,
  cases neg_one_pow_eq_or R n with hpos hneg,
  { rw [hpos, one_mul] },
  { rw [hneg, neg_one_mul, f_neg], },
end

/-- If `f 1 ≤ 1`, then `smoothing_seminorm_def f` is submultiplicative. -/
lemma smoothing_seminorm_mul (hf1 : f 1 ≤ 1) (x y : R) : smoothing_seminorm_def f (x * y) ≤
  smoothing_seminorm_def f x * smoothing_seminorm_def f y :=
begin
  apply le_of_tendsto_of_tendsto' (smoothing_seminorm_def_is_limit f hf1 (x *y))
    (tendsto.mul (smoothing_seminorm_def_is_limit f hf1 x)
      (smoothing_seminorm_def_is_limit f hf1 y)),
  intro n,
  have hn : 0 ≤ 1 / (n : ℝ),
  { simp only [one_div, inv_nonneg, nat.cast_nonneg] },
  simp only [smoothing_seminorm_seq],
  rw [← mul_rpow (map_nonneg f _) (map_nonneg f _), mul_pow],
  exact rpow_le_rpow (map_nonneg f _) (map_mul_le_mul f _ _) hn,
end

/-- If `f 1 ≤ 1`, then `smoothing_seminorm_def f 1 ≤ 1`. -/
lemma smoothing_seminorm_one (hf1 : f 1 ≤ 1) : smoothing_seminorm_def f 1 ≤ 1 :=
begin
  apply le_of_tendsto (smoothing_seminorm_def_is_limit f hf1 (1 : R) ),
  simp only [eventually_at_top, ge_iff_le],
  use 1,
  rintros n hn,
  simp only [smoothing_seminorm_seq],
  rw [one_pow],
  conv_rhs{rw ← one_rpow (1/n : ℝ)},
  have hn1 : 0 < (1/n : ℝ),
  { have h01 : (0 : ℝ) < 1 := zero_lt_one,
    apply div_pos h01,
    rw [← nat.cast_zero, nat.cast_lt],
    exact (nat.succ_le_iff.mp hn) },
    exact (real.rpow_le_rpow_iff (map_nonneg f _) zero_le_one hn1).mpr hf1,
end

/-- For any `x` and any positive `n`, `smoothing_seminorm_def f x  ≤ f (x^(n : ℕ))^(1/n : ℝ)`. -/
lemma smoothing_seminorm_le_term (x : R) (n : pnat) :
  smoothing_seminorm_def f x  ≤ f (x^(n : ℕ))^(1/n : ℝ) :=
cinfi_le (smoothing_seminorm_seq_bdd f x) _

/-- For all `x : R`, `smoothing_seminorm_def f x ≤ f x`. -/
lemma smoothing_seminorm_le (x : R) : smoothing_seminorm_def f x ≤ f x :=
begin
  convert smoothing_seminorm_le_term f x 1,
  simp only [positive.coe_one, algebra_map.coe_one, coe_coe, div_one, pow_one, rpow_one],
end

/- In this section, we prove that if `f` is nonarchimedean, then `smoothing_seminorm_def f` is
  nonarchimedean. -/
 section is_nonarchimedean

lemma exists_index_le (hna : is_nonarchimedean f) (x y : R) (n : ℕ) :
  ∃ (m : ℕ) (hm : m ∈ finset.range (n + 1)),
    (f ((x + y)^(n : ℕ))) ^(1/(n : ℝ)) ≤ (f (x ^ m) * f (y ^ (n - m : ℕ)))^(1/(n : ℝ)) :=
begin
  obtain ⟨m, hm_lt, hm⟩ := is_nonarchimedean_add_pow hna n x y,
  exact ⟨m, hm_lt, rpow_le_rpow (map_nonneg f _) hm (nat.one_div_cast_nonneg (n : ℕ))⟩,
end

/-- Auxiliary sequence for the proof that `smoothing_seminorm_def` is nonarchimedean. -/
def mu {x y : R} (hn : ∀ (n : ℕ), ∃ (m : ℕ) (hm : m ∈ finset.range (n + 1)),
    (f ((x + y)^(n : ℕ))) ^(1/(n : ℝ)) ≤ (f (x ^ m) * f (y ^ (n - m : ℕ)))^(1/(n : ℝ))) :
  ℕ → ℕ :=
λ n, classical.some (hn n)

lemma mu_property {x y : R} (hn : ∀ (n : ℕ), ∃ (m : ℕ) (hm : m ∈ finset.range (n + 1)),
    (f ((x + y)^(n : ℕ))) ^(1/(n : ℝ)) ≤ (f (x ^ m) * f (y ^ (n - m : ℕ)))^(1/(n : ℝ))) (n : ℕ) :
  f ((x + y)^(n : ℕ)) ^(1/(n : ℝ)) ≤
    (f (x ^ (mu f hn n)) * f (y ^ (n - (mu f hn n) : ℕ)))^(1/(n : ℝ)) :=
classical.some_spec (classical.some_spec (hn n))

lemma mu_le {x y : R} (hn : ∀ (n : ℕ), ∃ (m : ℕ) (hm : m ∈ finset.range (n + 1)),
    (f ((x + y)^(n : ℕ))) ^(1/(n : ℝ)) ≤ (f (x ^ m) * f (y ^ (n - m : ℕ)))^(1/(n : ℝ))) (n : ℕ) :
  mu f hn n ≤ n :=
begin
  simp only [mu, ← nat.lt_succ_iff, ← finset.mem_range],
  exact classical.some (classical.some_spec (hn n)),
end

lemma mu_bdd {x y : R} (hn : ∀ (n : ℕ), ∃ (m : ℕ) (hm : m ∈ finset.range (n + 1)),
    (f ((x + y)^(n : ℕ))) ^(1/(n : ℝ)) ≤ (f (x ^ m) * f (y ^ (n - m : ℕ)))^(1/(n : ℝ))) (n : ℕ) :
  (mu f hn n : ℝ)/n ∈ set.Icc (0 : ℝ) 1 :=
begin
  refine set.mem_Icc.mpr ⟨_, _⟩,
  { exact div_nonneg (nat.cast_nonneg (mu f hn n)) (nat.cast_nonneg n), },
  {by_cases hn0 : n = 0,
    { rw [hn0, nat.cast_zero, div_zero], exact zero_le_one, },
    { have hn' : 0 < (n : ℝ) := nat.cast_pos.mpr (nat.pos_of_ne_zero hn0),
      rw [div_le_one hn', nat.cast_le],
      exact mu_le _ _ _, }}
end

private lemma f_bdd_below (s : ℕ → ℕ) {x y : R} (hn : ∀ (n : ℕ), ∃ (m : ℕ)
    (hm : m ∈ finset.range (n + 1)), (f ((x + y)^(n : ℕ))) ^(1/(n : ℝ)) ≤
    (f (x ^ m) * f (y ^ (n - m : ℕ)))^(1/(n : ℝ))) (a : ℝ) (φ: ℕ → ℕ) :
  bdd_below {a : ℝ | ∀ᶠ (n : ℝ) in map
    (λ (n : ℕ), f x ^ (↑(s (φ n)) * (1 / (φ n : ℝ)))) at_top, n ≤ a} :=
begin
  use (0 : ℝ),
  simp only [mem_lower_bounds, eventually_map, eventually_at_top, ge_iff_le,
    set.mem_set_of_eq, forall_exists_index],
  intros r m hm,
  exact le_trans (real.rpow_nonneg_of_nonneg (map_nonneg f _) _) (hm m (le_refl _)),
end

private lemma f_bdd_above (hf1 : f 1 ≤ 1) {s : ℕ → ℕ} (hs : ∀ n : ℕ, s n ≤ n) (x : R) (φ : ℕ → ℕ) :
  bdd_above (set.range (λ (n : ℕ), f (x ^ s (φ n)) ^ (1 / (φ n : ℝ)))) :=
begin
  have hφ : ∀ n : ℕ, 0 ≤ 1 / (φ n : ℝ),
  { intro n,
    simp only [one_div, inv_nonneg, nat.cast_nonneg], },
  by_cases hx : f x ≤ 1,
  { use 1,
    simp only [mem_upper_bounds, set.mem_range, forall_exists_index,
      forall_apply_eq_imp_iff'],
    intros n,
    apply le_trans (real.rpow_le_rpow (map_nonneg _ _) (map_pow_le_pow' hf1 _ _) (hφ n)),
    rw [← rpow_nat_cast, ← rpow_mul (map_nonneg _ _), mul_one_div],
    exact rpow_le_one (map_nonneg _ _) hx
      (div_nonneg (nat.cast_nonneg _) (nat.cast_nonneg _)) },
  { use f x,
    simp only [mem_upper_bounds, set.mem_range, forall_exists_index,
      forall_apply_eq_imp_iff'],
    intros n,
    apply le_trans (real.rpow_le_rpow (map_nonneg _ _) (map_pow_le_pow' hf1 _ _) (hφ n)),
    rw [← rpow_nat_cast, ← rpow_mul (map_nonneg _ _), mul_one_div],
    conv_rhs {rw ← rpow_one (f x)},
    rw rpow_le_rpow_left_iff (not_le.mp hx),
    exact div_le_one_of_le (nat.cast_le.mpr (hs (φ n))) (nat.cast_nonneg _) }
end

private lemma f_nonempty {s : ℕ → ℕ} (hs_le : ∀ n : ℕ, s n ≤ n) {x y : R} (hn : ∀ (n : ℕ),
    ∃ (m : ℕ) (hm : m ∈ finset.range (n + 1)), (f ((x + y)^(n : ℕ))) ^(1/(n : ℝ)) ≤
    (f (x ^ m) * f (y ^ (n - m : ℕ)))^(1/(n : ℝ))) (φ : ℕ → ℕ) :
  {a : ℝ | ∀ᶠ (n : ℝ) in map
    (λ (n : ℕ), f x ^ (↑(s (φ n)) * (1 / (φ n : ℝ)))) at_top, n ≤ a}.nonempty :=
begin
  by_cases hfx : f x < 1,
  { use 1,
    simp only [eventually_map, eventually_at_top, ge_iff_le, set.mem_set_of_eq],
    use 0,
    intros b hb,
    exact rpow_le_one (map_nonneg _ _) (le_of_lt hfx)
        (mul_nonneg (nat.cast_nonneg _)  (one_div_nonneg.mpr (nat.cast_nonneg _))) },
  { use f x,
    simp only [eventually_map, eventually_at_top, ge_iff_le, set.mem_set_of_eq],
    use 0,
    intros b hb,
    nth_rewrite 1 ← rpow_one (f x),
    apply rpow_le_rpow_of_exponent_le (not_lt.mp hfx),
    rw [mul_one_div],
    exact div_le_one_of_le (nat.cast_le.mpr (hs_le (φ b))) (nat.cast_nonneg _) }
end

private lemma f_limsup_le_one {s : ℕ → ℕ} (hs_le : ∀ n : ℕ, s n ≤ n) {x y : R} (hn : ∀ (n : ℕ),
    ∃ (m : ℕ) (hm : m ∈ finset.range (n + 1)), (f ((x + y)^(n : ℕ))) ^(1/(n : ℝ)) ≤
    (f (x ^ m) * f (y ^ (n - m : ℕ)))^(1/(n : ℝ))) {φ : ℕ → ℕ}
  (hφ_lim: tendsto ((λ (n : ℕ), ↑(s n) / (n : ℝ)) ∘ φ) at_top (𝓝 0)) :
  limsup (λ (n : ℕ), f x ^ ((s (φ n) : ℝ) * (1 / (φ n : ℝ)))) at_top ≤ 1 :=
begin
  simp only [limsup, Limsup],
  rw cInf_le_iff,
  { intros c hc_bd,
    simp only [mem_lower_bounds, eventually_map, eventually_at_top, ge_iff_le,
      set.mem_set_of_eq, forall_exists_index] at hc_bd,
    by_cases hfx : f x < 1,
    { apply hc_bd (1 : ℝ) 0,
      rintros b -,
      exact rpow_le_one (map_nonneg _ _) (le_of_lt hfx)
        (mul_nonneg (nat.cast_nonneg _)  (one_div_nonneg.mpr (nat.cast_nonneg _))), },
    { have hf_lim : tendsto (λ (n : ℕ), f x ^ (↑(s(φ n)) * (1 / (φ n : ℝ))))
          at_top (𝓝 1),
        { nth_rewrite 0 ← rpow_zero (f x),
          refine tendsto.rpow tendsto_const_nhds _
            (or.inl (ne_of_gt (lt_of_lt_of_le zero_lt_one (not_lt.mp hfx)))),
          { convert hφ_lim,
            simp only [function.comp_app, mul_one_div] }},
        rw tendsto_at_top_nhds at hf_lim,
      apply le_of_forall_pos_le_add,
      intros ε hε,
      have h1 : (1 : ℝ) ∈ set.Ioo 0 (1 + ε),
      { simp only [set.mem_Ioo, zero_lt_one, lt_add_iff_pos_right, true_and, hε], },
      obtain ⟨k, hk⟩ := hf_lim (set.Ioo (0 : ℝ) (1 + ε)) h1 is_open_Ioo,
      exact hc_bd (1 + ε) k (λ b hb, le_of_lt (set.mem_Ioo.mp (hk b hb)).2), }},
  { exact f_bdd_below f s hn (0 : ℝ) φ },
  { exact f_nonempty f hs_le hn φ  }
end

lemma smoothing_seminorm_def_is_limit_comp (hf1 : f 1 ≤ 1) (x : R) {φ : ℕ → ℕ}
  (hφ_mono : strict_mono φ) :
  tendsto (λ (n : ℕ), (f (x ^ (φ n)))^(1/(φ n) : ℝ)) at_top (𝓝 (smoothing_seminorm_def f x)) :=
begin
  have hφ_lim' : tendsto φ at_top at_top,
  { exact strict_mono.tendsto_at_top hφ_mono },
  exact (smoothing_seminorm_def_is_limit f  hf1 x).comp hφ_lim',
end

lemma limsup_mu_le (hf1 : f 1 ≤ 1) {s : ℕ → ℕ} (hs_le : ∀ n : ℕ, s n ≤ n) {x y : R}
  (hn : ∀ (n : ℕ), ∃ (m : ℕ) (hm : m ∈ finset.range (n + 1)),
    (f ((x + y)^(n : ℕ))) ^(1/(n : ℝ)) ≤ (f (x ^ m) * f (y ^ (n - m : ℕ)))^(1/(n : ℝ))) {a : ℝ}
  (a_in: a ∈ set.Icc (0 : ℝ) 1) {φ: ℕ → ℕ} (hφ_mono: strict_mono φ)
  (hφ_lim: tendsto ((λ (n : ℕ), ↑(s n) / ↑n) ∘ φ) at_top (𝓝 a)) :
  limsup (λ (n : ℕ), (f (x ^ (s (φ n))))^(1/(φ n : ℝ))) at_top ≤
    (smoothing_seminorm_def f x)^a :=
begin
  by_cases ha : a = 0,
  { rw ha at hφ_lim,
    calc limsup (λ (n : ℕ), f (x ^ s (φ n)) ^ (1 / (φ n : ℝ))) at_top ≤
      limsup (λ (n : ℕ), f x ^ ((s (φ n) : ℝ) * (1 / (φ n : ℝ)))) at_top :
      begin
        apply cInf_le_cInf,
        { use (0 : ℝ),
          simp only [mem_lower_bounds, eventually_map, eventually_at_top, ge_iff_le,
            set.mem_set_of_eq, forall_exists_index],
          intros r m hm,
          exact le_trans (real.rpow_nonneg_of_nonneg (map_nonneg f _) _) (hm m (le_refl _)) },
        { exact f_nonempty f hs_le hn φ, },
        { intros b hb,
          simp only [eventually_map, eventually_at_top, ge_iff_le,
            set.mem_set_of_eq] at hb ⊢,
          obtain ⟨m, hm⟩ := hb,
          use m,
          intros k hkm,
          apply le_trans _ (hm k hkm),
          rw [real.rpow_mul (map_nonneg f x), rpow_nat_cast],
          exact rpow_le_rpow (map_nonneg f _) (map_pow_le_pow' hf1 x _)
            (one_div_nonneg.mpr (nat.cast_nonneg _)), }
      end
    ... ≤ 1 : f_limsup_le_one f hs_le hn hφ_lim
    ... = smoothing_seminorm_def f x ^ a : by rw [ha, rpow_zero] },
  { have ha_pos : 0 < a := lt_of_le_of_ne a_in.1 (ne.symm ha),
    have h_eq : (λ (n : ℕ), (f (x ^ s (φ n))^ (1 / (s (φ n) : ℝ))) ^ ((s (φ n) : ℝ)/(φ n : ℝ)))
      =ᶠ[at_top] (λ (n : ℕ), f (x ^ s (φ n)) ^ (1 / (φ n : ℝ))),
    { have h : (λ (n : ℕ),  (1 : ℝ) / (s (φ n) : ℝ) * (s (φ n) : ℝ)) =ᶠ[at_top] 1,
      { convert div_mul_eventually_cancel 1
          (tendsto.num hφ_mono.tendsto_at_top ha_pos hφ_lim);
        { ext n, simp only [pi.one_apply, algebra_map.coe_one], }},
      simp_rw [← rpow_mul (map_nonneg f _), mul_div],
      exact (eventually_eq.comp₂ eventually_eq.rfl pow (h.div eventually_eq.rfl)) },
    exact le_of_eq (tendsto.limsup_eq (tendsto.congr' h_eq
      (tendsto.rpow ((smoothing_seminorm_def_is_limit f hf1 x).comp
      (tendsto.num hφ_mono.tendsto_at_top ha_pos hφ_lim)) hφ_lim (or.inr ha_pos)))) }
end

/-- If `f 1 ≤ 1` and `f` is nonarchimedean, then `smoothing_seminorm_def` is nonarchimedean. -/
lemma smoothing_seminorm_is_nonarchimedean (hf1 : f 1 ≤ 1) (hna : is_nonarchimedean f) :
  is_nonarchimedean (smoothing_seminorm_def f) :=
begin
  intros x y,
  have hn : ∀ (n : ℕ), ∃ (m : ℕ) (hm : m ∈ finset.range (n + 1)),
    (f ((x + y)^(n : ℕ))) ^(1/(n : ℝ)) ≤ (f (x ^ m) * f (y ^ (n - m : ℕ)))^(1/(n : ℝ)) :=
  λ n, exists_index_le f hna x y n,
  set mu : ℕ → ℕ := λ n, mu f hn n with hmu,
  set nu : ℕ → ℕ := λ n, n - (mu n) with hnu,
  have hmu_le : ∀ n : ℕ, mu n ≤ n := λ n, mu_le f hn n,
  have hmu_bdd : ∀ n : ℕ, (mu n : ℝ)/n ∈ set.Icc (0 : ℝ) 1 := λ n, mu_bdd f hn n,
  have hs : metric.bounded (set.Icc (0 : ℝ) 1) := metric.bounded_Icc 0 1,
  obtain ⟨a, a_in, φ, hφ_mono, hφ_lim⟩ := tendsto_subseq_of_bounded hs hmu_bdd,
  rw closure_Icc at a_in,
  set b := 1 - a with hb,
  have hb_lim : tendsto ((λ (n : ℕ), ↑(nu n) / ↑n) ∘ φ) at_top (𝓝 b),
  { apply tendsto.congr' _ (tendsto.const_sub 1 hφ_lim),
    simp only [eventually_eq, function.comp_app, eventually_at_top, ge_iff_le],
    use 1,
    intros m hm,
    have h0 : (φ m : ℝ ) ≠ 0 := nat.cast_ne_zero.mpr (ne_of_gt (lt_of_le_of_lt (zero_le _)
      (hφ_mono (nat.pos_of_ne_zero (nat.one_le_iff_ne_zero.mp hm))))),
    rw [← div_self h0, ← sub_div],
    simp only [hnu],
    rw nat.cast_sub (hmu_le _) },

  have b_in : b ∈ set.Icc (0 : ℝ) 1 := sub_mem_closure a_in,
  have hnu_le : ∀ n : ℕ, nu n ≤ n := λ n, by simp only [hnu, tsub_le_self],

  have hx : limsup (λ (n : ℕ), (f (x ^ (mu (φ n))))^(1/(φ n : ℝ))) at_top ≤
    (smoothing_seminorm_def f x)^a,
  { exact limsup_mu_le f hf1 hmu_le hn a_in hφ_mono hφ_lim },
  have hy : limsup (λ (n : ℕ), (f (y ^ (nu (φ n))))^(1/(φ n : ℝ))) at_top ≤
    (smoothing_seminorm_def f y)^b,
  { exact limsup_mu_le f hf1 hnu_le (exists_index_le f hna y x) b_in hφ_mono hb_lim },

  have hxy : limsup (λ (n : ℕ),
    ((f (x ^ (mu (φ n))))^(1/(φ n : ℝ)) * (f (y ^ (nu (φ n))))^(1/(φ n : ℝ)))) at_top ≤
    (smoothing_seminorm_def f x)^a * (smoothing_seminorm_def f y)^b ,
  { have hxy' : limsup (λ (n : ℕ),
    ((f (x ^ (mu (φ n))))^(1/(φ n : ℝ)) * (f (y ^ (nu (φ n))))^(1/(φ n : ℝ)))) at_top ≤
      (limsup (λ (n : ℕ), (f (x ^ (mu (φ n))))^(1/(φ n : ℝ))) at_top) *
      (limsup (λ (n : ℕ), (f (y ^ (nu (φ n))))^(1/(φ n : ℝ))) at_top),
    { exact limsup_mul_le (f_bdd_above f hf1 hmu_le x φ)
        (λ n, rpow_nonneg_of_nonneg (map_nonneg _ _) _) (f_bdd_above f hf1 hnu_le y φ)
        (λ n, rpow_nonneg_of_nonneg (map_nonneg _ _) _) },
    have h_bdd : is_bounded_under has_le.le at_top
      (λ (n : ℕ), f (y ^ nu (φ n)) ^ (1 / (φ n : ℝ))),
    { exact is_bdd_under f hf1 hnu_le φ },
    exact le_trans hxy' (mul_le_mul hx hy
      (limsup_nonneg_of_nonneg h_bdd (λ m, rpow_nonneg_of_nonneg (map_nonneg _ _) _))
      (real.rpow_nonneg_of_nonneg (smoothing_seminorm_nonneg f hf1 x) _)) },

  conv_lhs { simp only [smoothing_seminorm_def], },
  apply le_of_forall_sub_le,
  intros ε hε,
  rw sub_le_iff_le_add,
  have h_mul : (smoothing_seminorm_def f x)^a * (smoothing_seminorm_def f y)^b + ε ≤
    max (smoothing_seminorm_def f x) (smoothing_seminorm_def f y) + ε,
  { rw max_def,
    split_ifs with h,
    { rw [add_le_add_iff_right],
      apply le_trans (mul_le_mul_of_nonneg_right (real.rpow_le_rpow
        (smoothing_seminorm_nonneg f hf1 _) h a_in.1)
        (real.rpow_nonneg_of_nonneg (smoothing_seminorm_nonneg f hf1 _) _)),
      rw [hb, ← rpow_add_of_nonneg (smoothing_seminorm_nonneg f hf1 _) a_in.1
        (sub_nonneg.mpr a_in.2), add_sub, add_sub_cancel', rpow_one], },
    { rw [add_le_add_iff_right],
      apply le_trans (mul_le_mul_of_nonneg_left (real.rpow_le_rpow
        (smoothing_seminorm_nonneg f hf1 _) (le_of_lt (not_le.mp h)) b_in.1)
        (real.rpow_nonneg_of_nonneg (smoothing_seminorm_nonneg f hf1 _) _)),
      rw [hb, ← rpow_add_of_nonneg (smoothing_seminorm_nonneg f hf1 _) a_in.1
        (sub_nonneg.mpr a_in.2), add_sub, add_sub_cancel', rpow_one] }},
  apply le_trans _ h_mul,
  have hex : ∃ n : pnat,
    (f (x ^ (mu (φ n))))^(1/(φ n : ℝ)) * f (y ^ (nu (φ n)))^(1/(φ n : ℝ)) <
    (smoothing_seminorm_def f x)^a * (smoothing_seminorm_def f y)^b + ε,
  { exact exists_lt_of_limsup_le (real.range_bdd_above_mul (f_bdd_above f hf1 hmu_le _ _)
      (λ n, rpow_nonneg_of_nonneg (map_nonneg _ _) _) (f_bdd_above f hf1 hnu_le _ _)
      (λ n, rpow_nonneg_of_nonneg (map_nonneg _ _) _)).is_bounded_under hxy hε, },
  obtain ⟨N, hN⟩ := hex,
  apply le_trans (cinfi_le (smoothing_seminorm_seq_bdd f _)
    ⟨φ N, lt_of_le_of_lt (zero_le (φ 0)) (hφ_mono.lt_iff_lt.mpr N.pos)⟩),
  apply le_trans _ hN.le,
  simp only [pnat.mk_coe, coe_coe, hnu, ← mul_rpow (map_nonneg f _) (map_nonneg f _)],
  exact mu_property f hn (φ N),
end

end is_nonarchimedean

/-- If `f 1 ≤ 1` and `f` is nonarchimedean, then `smoothing_seminorm_def` is a ring seminorm. -/
def smoothing_seminorm (hf1 : f 1 ≤ 1) (hna : is_nonarchimedean f) : ring_seminorm R :=
{ to_fun    := smoothing_seminorm_def f,
  map_zero' := smoothing_seminorm_zero f hf1,
  add_le'   := add_le_of_is_nonarchimedean (smoothing_seminorm_nonneg f hf1)
    (smoothing_seminorm_is_nonarchimedean f hf1 hna),
  neg'      := smoothing_seminorm_neg f (map_neg_eq_map f),
  mul_le'   := smoothing_seminorm_mul f hf1 }

/-- If `f 1 ≤ 1` and `f` is nonarchimedean, then `smoothing_seminorm f hf1 hna 1 ≤ 1`. -/
lemma smoothing_seminorm_is_seminorm_is_norm_le_one_class (hf1 : f 1 ≤ 1)
  (hna : is_nonarchimedean f) : smoothing_seminorm f hf1 hna 1 ≤ 1 :=
smoothing_seminorm_one f hf1

/-- If `f 1 ≤ 1` and `f` is nonarchimedean, then `smoothing_seminorm_def f` is
  power-multiplicative. -/
lemma smoothing_seminorm_is_pow_mul (hf1 : f 1 ≤ 1) : is_pow_mul (smoothing_seminorm_def f) :=
begin
  intros x m hm,
  simp only [smoothing_seminorm_def],
  have hlim : tendsto (λ n, smoothing_seminorm_seq  f x (m*n)) at_top
    (𝓝 (smoothing_seminorm_def f  x )),
  { refine tendsto.comp (smoothing_seminorm_def_is_limit f hf1 x) _,
    apply tendsto_at_top_at_top_of_monotone,
    { intros n k hnk, exact mul_le_mul_left' hnk m, },
    { rintro n, use n, exact le_mul_of_one_le_left' hm, }},
  apply tendsto_nhds_unique _ (tendsto.pow hlim m),
  have h_eq : ∀ (n : ℕ), smoothing_seminorm_seq f x (m * n) ^ m =
    smoothing_seminorm_seq f (x^m) n,
  { have hm' : (m : ℝ) ≠ 0 := nat.cast_ne_zero.mpr (ne_of_gt (lt_of_lt_of_le zero_lt_one hm)),
    intro n,
    simp only [smoothing_seminorm_seq],
    rw [pow_mul, ← rpow_nat_cast, ← rpow_mul (map_nonneg f _), nat.cast_mul,
      ← one_div_mul_one_div, mul_comm (1 / (m : ℝ)), mul_assoc, one_div_mul_cancel hm', mul_one] },
  simp_rw h_eq,
  exact smoothing_seminorm_def_is_limit f hf1 _
end

/-- If `f 1 ≤ 1` and `∀ (1 ≤ n), f (x ^ n) = f x ^ n`, then `smoothing_seminorm_def f x = f x`. -/
lemma smoothing_seminorm_of_pow_mult (hf1 : f 1 ≤ 1) {x : R}
  (hx : ∀ (n : ℕ) (hn : 1 ≤ n), f (x ^ n) = f x ^ n) : smoothing_seminorm_def f x = f x :=
begin
  apply tendsto_nhds_unique_of_eventually_eq (smoothing_seminorm_def_is_limit f hf1 x)
    tendsto_const_nhds,
  simp only [eventually_eq, eventually_at_top, ge_iff_le],
  use 1,
  intros n hn,
  simp only [smoothing_seminorm_seq],
  have hn0 : (n : ℝ) ≠ 0 := nat.cast_ne_zero.mpr (nat.one_le_iff_ne_zero.mp hn),
  rw [hx n hn, ← rpow_nat_cast, ← rpow_mul (map_nonneg f _), mul_one_div_cancel hn0,
    rpow_one],
end

/-- If `f 1 ≤ 1` and `∀ y : R, f (x * y) = f x * f y`, then `smoothing_seminorm_def f x = f x`. -/
lemma smoothing_seminorm_apply_of_is_mul' (hf1 : f 1 ≤ 1) {x : R}
  (hx : ∀ y : R, f (x * y) = f x * f y) : smoothing_seminorm_def f x = f x :=
begin
  apply tendsto_nhds_unique_of_eventually_eq (smoothing_seminorm_def_is_limit f hf1 x)
    tendsto_const_nhds,
  simp only [eventually_eq, eventually_at_top, ge_iff_le],
  use 1,
  intros n hn,
  simp only [smoothing_seminorm_seq],
  by_cases hx0 : f x = 0,
  { have hxn : f (x ^ n) = 0,
    { apply le_antisymm _ (map_nonneg f _),
      apply le_trans (map_pow_le_pow f x (nat.one_le_iff_ne_zero.mp hn)),
      rw [hx0, zero_pow (lt_of_lt_of_le zero_lt_one hn)], },
    rw [hx0, hxn, zero_rpow (nat.one_div_cast_ne_zero (nat.one_le_iff_ne_zero.mp hn))] },
  { have h1 : f 1 = 1,
    { rw [← mul_right_inj' hx0, ← hx 1, mul_one, mul_one] },
    have hn0 : (n : ℝ) ≠ 0 := nat.cast_ne_zero.mpr (ne_of_gt (lt_of_lt_of_le zero_lt_one hn)),
    rw [← mul_one (x ^ n), is_mul_pow_of_is_mul f hx, ← rpow_nat_cast, h1, mul_one,
      ← rpow_mul (map_nonneg f _), mul_one_div_cancel hn0, rpow_one] },
end

/-- If `f 1 ≤ 1`, `f` is nonarchimedean, and `∀ y : R, f (x * y) = f x * f y`, then
  `smoothing_seminorm f hf1 hna x = f x`. -/
lemma smoothing_seminorm_apply_of_is_mul (hf1 : f 1 ≤ 1) (hna : is_nonarchimedean f)  {x : R}
  (hx : ∀ y : R, f (x * y) = f x * f y) :
  smoothing_seminorm f hf1 hna x = f x :=
smoothing_seminorm_apply_of_is_mul' f hf1 hx

/-- If `f 1 ≤ 1`, and `x` is multiplicative for `f`, then it is multiplicative for
  `smoothing_seminorm_def`. -/
lemma smoothing_seminorm_of_mul' (hf1 : f 1 ≤ 1) {x : R} (hx : ∀ (y : R), f (x * y) = f x * f y)
  (y : R) : smoothing_seminorm_def f (x * y) =
    smoothing_seminorm_def f x * smoothing_seminorm_def f y :=
begin
  have hlim : tendsto (λ n, f x * smoothing_seminorm_seq f y n) at_top
    (𝓝 (smoothing_seminorm_def f x * smoothing_seminorm_def f y)),
  { rw [smoothing_seminorm_apply_of_is_mul' f hf1 hx],
    exact tendsto.const_mul _ (smoothing_seminorm_def_is_limit f hf1 y), },
  apply tendsto_nhds_unique_of_eventually_eq (smoothing_seminorm_def_is_limit f hf1 (x * y))
    hlim,
  simp only [eventually_eq, eventually_at_top, ge_iff_le],
  use 1,
  intros n hn1,
  have hn0 : (n : ℝ) ≠ 0 := nat.cast_ne_zero.mpr (ne_of_gt (lt_of_lt_of_le zero_lt_one hn1)),
  simp only [smoothing_seminorm_seq],
  rw [mul_pow, is_mul_pow_of_is_mul  f hx, mul_rpow (pow_nonneg (map_nonneg f _) _)
    (map_nonneg f _), ← rpow_nat_cast, ← rpow_mul (map_nonneg f _),
    mul_one_div_cancel hn0, rpow_one]
end

/-- If `f 1 ≤ 1`, `f` is nonarchimedean, and `x` is multiplicative for `f`, then `x` is
  multiplicative for `smoothing_seminorm`. -/
lemma smoothing_seminorm_of_mul (hf1 : f 1 ≤ 1) (hna : is_nonarchimedean f) {x : R}
  (hx : ∀ (y : R), f (x * y) = f x * f y) (y : R) : smoothing_seminorm f hf1 hna (x * y) =
    smoothing_seminorm f hf1 hna x * smoothing_seminorm f hf1 hna y :=
smoothing_seminorm_of_mul' f hf1 hx y

end smoothing_seminorm