/-
Copyright (c) 2019 Kevin Kappelmann. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Kevin Kappelmann, Kyle Miller, Mario Carneiro

! This file was ported from Lean 3 source module data.nat.fib
! leanprover-community/mathlib commit 92ca63f0fb391a9ca5f22d2409a6080e786d99f7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Nat.Gcd.Basic
import Mathbin.Logic.Function.Iterate
import Mathbin.Data.Finset.NatAntidiagonal
import Mathbin.Algebra.BigOperators.Basic
import Mathbin.Tactic.Ring
import Mathbin.Tactic.Zify
import Mathbin.Tactic.Wlog

/-!
# The Fibonacci Sequence

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

## Summary

Definition of the Fibonacci sequence `F₀ = 0, F₁ = 1, Fₙ₊₂ = Fₙ + Fₙ₊₁`.

## Main Definitions

- `nat.fib` returns the stream of Fibonacci numbers.

## Main Statements

- `nat.fib_add_two`: shows that `fib` indeed satisfies the Fibonacci recurrence `Fₙ₊₂ = Fₙ + Fₙ₊₁.`.
- `nat.fib_gcd`: `fib n` is a strong divisibility sequence.
- `nat.fib_succ_eq_sum_choose`: `fib` is given by the sum of `nat.choose` along an antidiagonal.
- `nat.fib_succ_eq_succ_sum`: shows that `F₀ + F₁ + ⋯ + Fₙ = Fₙ₊₂ - 1`.
- `nat.fib_two_mul` and `nat.fib_two_mul_add_one` are the basis for an efficient algorithm to
  compute `fib` (see `nat.fast_fib`). There are `bit0`/`bit1` variants of these can be used to
  simplify `fib` expressions: `simp only [nat.fib_bit0, nat.fib_bit1, nat.fib_bit0_succ,
  nat.fib_bit1_succ, nat.fib_one, nat.fib_two]`.

## Implementation Notes

For efficiency purposes, the sequence is defined using `stream.iterate`.

## Tags

fib, fibonacci
-/

open BigOperators

namespace Nat

#print Nat.fib /-
/-- Implementation of the fibonacci sequence satisfying
`fib 0 = 0, fib 1 = 1, fib (n + 2) = fib n + fib (n + 1)`.

*Note:* We use a stream iterator for better performance when compared to the naive recursive
implementation.
-/
@[pp_nodot]
def fib (n : ℕ) : ℕ :=
  (((fun p : ℕ × ℕ => (p.snd, p.fst + p.snd))^[n]) (0, 1)).fst
#align nat.fib Nat.fib
-/

#print Nat.fib_zero /-
@[simp]
theorem fib_zero : fib 0 = 0 :=
  rfl
#align nat.fib_zero Nat.fib_zero
-/

#print Nat.fib_one /-
@[simp]
theorem fib_one : fib 1 = 1 :=
  rfl
#align nat.fib_one Nat.fib_one
-/

#print Nat.fib_two /-
@[simp]
theorem fib_two : fib 2 = 1 :=
  rfl
#align nat.fib_two Nat.fib_two
-/

#print Nat.fib_add_two /-
/-- Shows that `fib` indeed satisfies the Fibonacci recurrence `Fₙ₊₂ = Fₙ + Fₙ₊₁.` -/
theorem fib_add_two {n : ℕ} : fib (n + 2) = fib n + fib (n + 1) := by
  simp only [fib, Function.iterate_succ']
#align nat.fib_add_two Nat.fib_add_two
-/

#print Nat.fib_le_fib_succ /-
theorem fib_le_fib_succ {n : ℕ} : fib n ≤ fib (n + 1) := by cases n <;> simp [fib_add_two]
#align nat.fib_le_fib_succ Nat.fib_le_fib_succ
-/

#print Nat.fib_mono /-
@[mono]
theorem fib_mono : Monotone fib :=
  monotone_nat_of_le_succ fun _ => fib_le_fib_succ
#align nat.fib_mono Nat.fib_mono
-/

#print Nat.fib_pos /-
theorem fib_pos {n : ℕ} (n_pos : 0 < n) : 0 < fib n :=
  calc
    0 < fib 1 := by decide
    _ ≤ fib n := fib_mono n_pos

#align nat.fib_pos Nat.fib_pos
-/

#print Nat.fib_add_two_sub_fib_add_one /-
theorem fib_add_two_sub_fib_add_one {n : ℕ} : fib (n + 2) - fib (n + 1) = fib n := by
  rw [fib_add_two, add_tsub_cancel_right]
#align nat.fib_add_two_sub_fib_add_one Nat.fib_add_two_sub_fib_add_one
-/

#print Nat.fib_lt_fib_succ /-
theorem fib_lt_fib_succ {n : ℕ} (hn : 2 ≤ n) : fib n < fib (n + 1) :=
  by
  rcases exists_add_of_le hn with ⟨n, rfl⟩
  rw [← tsub_pos_iff_lt, add_comm 2, fib_add_two_sub_fib_add_one]
  apply fib_pos (succ_pos n)
#align nat.fib_lt_fib_succ Nat.fib_lt_fib_succ
-/

#print Nat.fib_add_two_strictMono /-
/-- `fib (n + 2)` is strictly monotone. -/
theorem fib_add_two_strictMono : StrictMono fun n => fib (n + 2) :=
  by
  refine' strictMono_nat_of_lt_succ fun n => _
  rw [add_right_comm]
  exact fib_lt_fib_succ (self_le_add_left _ _)
#align nat.fib_add_two_strict_mono Nat.fib_add_two_strictMono
-/

#print Nat.le_fib_self /-
theorem le_fib_self {n : ℕ} (five_le_n : 5 ≤ n) : n ≤ fib n :=
  by
  induction' five_le_n with n five_le_n IH
  ·-- 5 ≤ fib 5
    rfl
  · -- n + 1 ≤ fib (n + 1) for 5 ≤ n
    rw [succ_le_iff]
    calc
      n ≤ fib n := IH
      _ < fib (n + 1) := fib_lt_fib_succ (le_trans (by decide) five_le_n)

#align nat.le_fib_self Nat.le_fib_self
-/

#print Nat.fib_coprime_fib_succ /-
/-- Subsequent Fibonacci numbers are coprime,
  see https://proofwiki.org/wiki/Consecutive_Fibonacci_Numbers_are_Coprime -/
theorem fib_coprime_fib_succ (n : ℕ) : Nat.coprime (fib n) (fib (n + 1)) :=
  by
  induction' n with n ih
  · simp
  · rw [fib_add_two, coprime_add_self_right]
    exact ih.symm
#align nat.fib_coprime_fib_succ Nat.fib_coprime_fib_succ
-/

#print Nat.fib_add /-
/-- See https://proofwiki.org/wiki/Fibonacci_Number_in_terms_of_Smaller_Fibonacci_Numbers -/
theorem fib_add (m n : ℕ) : fib (m + n + 1) = fib m * fib n + fib (m + 1) * fib (n + 1) :=
  by
  induction' n with n ih generalizing m
  · simp
  · intros
    specialize ih (m + 1)
    rw [add_assoc m 1 n, add_comm 1 n] at ih
    simp only [fib_add_two, ih]
    ring
#align nat.fib_add Nat.fib_add
-/

#print Nat.fib_two_mul /-
theorem fib_two_mul (n : ℕ) : fib (2 * n) = fib n * (2 * fib (n + 1) - fib n) :=
  by
  cases n
  · simp
  · rw [Nat.succ_eq_add_one, two_mul, ← add_assoc, fib_add, fib_add_two, two_mul]
    simp only [← add_assoc, add_tsub_cancel_right]
    ring
#align nat.fib_two_mul Nat.fib_two_mul
-/

#print Nat.fib_two_mul_add_one /-
theorem fib_two_mul_add_one (n : ℕ) : fib (2 * n + 1) = fib (n + 1) ^ 2 + fib n ^ 2 :=
  by
  rw [two_mul, fib_add]
  ring
#align nat.fib_two_mul_add_one Nat.fib_two_mul_add_one
-/

#print Nat.fib_bit0 /-
theorem fib_bit0 (n : ℕ) : fib (bit0 n) = fib n * (2 * fib (n + 1) - fib n) := by
  rw [bit0_eq_two_mul, fib_two_mul]
#align nat.fib_bit0 Nat.fib_bit0
-/

#print Nat.fib_bit1 /-
theorem fib_bit1 (n : ℕ) : fib (bit1 n) = fib (n + 1) ^ 2 + fib n ^ 2 := by
  rw [Nat.bit1_eq_succ_bit0, bit0_eq_two_mul, fib_two_mul_add_one]
#align nat.fib_bit1 Nat.fib_bit1
-/

#print Nat.fib_bit0_succ /-
theorem fib_bit0_succ (n : ℕ) : fib (bit0 n + 1) = fib (n + 1) ^ 2 + fib n ^ 2 :=
  fib_bit1 n
#align nat.fib_bit0_succ Nat.fib_bit0_succ
-/

#print Nat.fib_bit1_succ /-
theorem fib_bit1_succ (n : ℕ) : fib (bit1 n + 1) = fib (n + 1) * (2 * fib n + fib (n + 1)) :=
  by
  rw [Nat.bit1_eq_succ_bit0, fib_add_two, fib_bit0, fib_bit0_succ]
  have : fib n ≤ 2 * fib (n + 1) := by
    rw [two_mul]
    exact le_add_left fib_le_fib_succ
  zify
  ring
#align nat.fib_bit1_succ Nat.fib_bit1_succ
-/

#print Nat.fastFibAux /-
/-- Computes `(nat.fib n, nat.fib (n + 1))` using the binary representation of `n`.
Supports `nat.fast_fib`. -/
def fastFibAux : ℕ → ℕ × ℕ :=
  Nat.binaryRec (fib 0, fib 1) fun b n p =>
    if b then (p.2 ^ 2 + p.1 ^ 2, p.2 * (2 * p.1 + p.2))
    else (p.1 * (2 * p.2 - p.1), p.2 ^ 2 + p.1 ^ 2)
#align nat.fast_fib_aux Nat.fastFibAux
-/

#print Nat.fastFib /-
/-- Computes `nat.fib n` using the binary representation of `n`.
Proved to be equal to `nat.fib` in `nat.fast_fib_eq`. -/
def fastFib (n : ℕ) : ℕ :=
  (fastFibAux n).1
#align nat.fast_fib Nat.fastFib
-/

#print Nat.fast_fib_aux_bit_ff /-
theorem fast_fib_aux_bit_ff (n : ℕ) :
    fastFibAux (bit false n) =
      let p := fastFibAux n
      (p.1 * (2 * p.2 - p.1), p.2 ^ 2 + p.1 ^ 2) :=
  by
  rw [fast_fib_aux, binary_rec_eq]
  · rfl
  · simp
#align nat.fast_fib_aux_bit_ff Nat.fast_fib_aux_bit_ff
-/

#print Nat.fast_fib_aux_bit_tt /-
theorem fast_fib_aux_bit_tt (n : ℕ) :
    fastFibAux (bit true n) =
      let p := fastFibAux n
      (p.2 ^ 2 + p.1 ^ 2, p.2 * (2 * p.1 + p.2)) :=
  by
  rw [fast_fib_aux, binary_rec_eq]
  · rfl
  · simp
#align nat.fast_fib_aux_bit_tt Nat.fast_fib_aux_bit_tt
-/

#print Nat.fast_fib_aux_eq /-
theorem fast_fib_aux_eq (n : ℕ) : fastFibAux n = (fib n, fib (n + 1)) :=
  by
  apply Nat.binaryRec _ (fun b n' ih => _) n
  · simp [fast_fib_aux]
  ·
    cases b <;>
          simp only [fast_fib_aux_bit_ff, fast_fib_aux_bit_tt, congr_arg Prod.fst ih,
            congr_arg Prod.snd ih, Prod.mk.inj_iff] <;>
        constructor <;>
      simp [bit, fib_bit0, fib_bit1, fib_bit0_succ, fib_bit1_succ]
#align nat.fast_fib_aux_eq Nat.fast_fib_aux_eq
-/

#print Nat.fast_fib_eq /-
theorem fast_fib_eq (n : ℕ) : fastFib n = fib n := by rw [fast_fib, fast_fib_aux_eq]
#align nat.fast_fib_eq Nat.fast_fib_eq
-/

#print Nat.gcd_fib_add_self /-
theorem gcd_fib_add_self (m n : ℕ) : gcd (fib m) (fib (n + m)) = gcd (fib m) (fib n) :=
  by
  cases Nat.eq_zero_or_pos n
  · rw [h]
    simp
  replace h := Nat.succ_pred_eq_of_pos h; rw [← h, succ_eq_add_one]
  calc
    gcd (fib m) (fib (n.pred + 1 + m)) =
        gcd (fib m) (fib n.pred * fib m + fib (n.pred + 1) * fib (m + 1)) :=
      by
      rw [← fib_add n.pred _]
      ring_nf
    _ = gcd (fib m) (fib (n.pred + 1) * fib (m + 1)) := by
      rw [add_comm, gcd_add_mul_right_right (fib m) _ (fib n.pred)]
    _ = gcd (fib m) (fib (n.pred + 1)) :=
      coprime.gcd_mul_right_cancel_right (fib (n.pred + 1)) (coprime.symm (fib_coprime_fib_succ m))

#align nat.gcd_fib_add_self Nat.gcd_fib_add_self
-/

#print Nat.gcd_fib_add_mul_self /-
theorem gcd_fib_add_mul_self (m n : ℕ) : ∀ k, gcd (fib m) (fib (n + k * m)) = gcd (fib m) (fib n)
  | 0 => by simp
  | k + 1 => by rw [← gcd_fib_add_mul_self k, add_mul, ← add_assoc, one_mul, gcd_fib_add_self _ _]
#align nat.gcd_fib_add_mul_self Nat.gcd_fib_add_mul_self
-/

#print Nat.fib_gcd /-
/-- `fib n` is a strong divisibility sequence,
  see https://proofwiki.org/wiki/GCD_of_Fibonacci_Numbers -/
theorem fib_gcd (m n : ℕ) : fib (gcd m n) = gcd (fib m) (fib n) :=
  by
  wlog h : m ≤ n; · simpa only [gcd_comm] using this _ _ (le_of_not_le h)
  apply gcd.induction m n
  · simp
  intro m n mpos h
  rw [← gcd_rec m n] at h
  conv_rhs => rw [← mod_add_div' n m]
  rwa [gcd_fib_add_mul_self m (n % m) (n / m), gcd_comm (fib m) _]
#align nat.fib_gcd Nat.fib_gcd
-/

#print Nat.fib_dvd /-
theorem fib_dvd (m n : ℕ) (h : m ∣ n) : fib m ∣ fib n := by
  rwa [gcd_eq_left_iff_dvd, ← fib_gcd, gcd_eq_left_iff_dvd.mp]
#align nat.fib_dvd Nat.fib_dvd
-/

#print Nat.fib_succ_eq_sum_choose /-
theorem fib_succ_eq_sum_choose :
    ∀ n : ℕ, fib (n + 1) = ∑ p in Finset.Nat.antidiagonal n, choose p.1 p.2 :=
  twoStepInduction rfl rfl fun n h1 h2 =>
    by
    rw [fib_add_two, h1, h2, Finset.Nat.antidiagonal_succ_succ', Finset.Nat.antidiagonal_succ']
    simp [choose_succ_succ, Finset.sum_add_distrib, add_left_comm]
#align nat.fib_succ_eq_sum_choose Nat.fib_succ_eq_sum_choose
-/

#print Nat.fib_succ_eq_succ_sum /-
theorem fib_succ_eq_succ_sum (n : ℕ) : fib (n + 1) = (∑ k in Finset.range n, fib k) + 1 :=
  by
  induction' n with n ih
  · simp
  ·
    calc
      fib (n + 2) = fib n + fib (n + 1) := fib_add_two
      _ = (fib n + ∑ k in Finset.range n, fib k) + 1 := by rw [ih, add_assoc]
      _ = (∑ k in Finset.range (n + 1), fib k) + 1 := by simp [Finset.range_add_one]

#align nat.fib_succ_eq_succ_sum Nat.fib_succ_eq_succ_sum
-/

end Nat

namespace NormNum

open Tactic Nat

/-! ### `norm_num` plugin for `fib`

The `norm_num` plugin uses a strategy parallel to that of `nat.fast_fib`, but it instead
produces proofs of what `nat.fib` evaluates to.
-/

#print NormNum.IsFibAux /-
/-- Auxiliary definition for `prove_fib` plugin. -/
def IsFibAux (n a b : ℕ) :=
  fib n = a ∧ fib (n + 1) = b
#align norm_num.is_fib_aux NormNum.IsFibAux
-/

#print NormNum.is_fib_aux_one /-
theorem is_fib_aux_one : IsFibAux 1 1 1 :=
  ⟨fib_one, fib_two⟩
#align norm_num.is_fib_aux_one NormNum.is_fib_aux_one
-/

#print NormNum.is_fib_aux_bit0 /-
theorem is_fib_aux_bit0 {n a b c a2 b2 a' b' : ℕ} (H : IsFibAux n a b) (h1 : a + c = bit0 b)
    (h2 : a * c = a') (h3 : a * a = a2) (h4 : b * b = b2) (h5 : a2 + b2 = b') :
    IsFibAux (bit0 n) a' b' :=
  ⟨by
    rw [fib_bit0, H.1, H.2, ← bit0_eq_two_mul,
      show bit0 b - a = c by rw [← h1, Nat.add_sub_cancel_left], h2],
    by rw [fib_bit0_succ, H.1, H.2, pow_two, pow_two, h3, h4, add_comm, h5]⟩
#align norm_num.is_fib_aux_bit0 NormNum.is_fib_aux_bit0
-/

#print NormNum.is_fib_aux_bit1 /-
theorem is_fib_aux_bit1 {n a b c a2 b2 a' b' : ℕ} (H : IsFibAux n a b) (h1 : a * a = a2)
    (h2 : b * b = b2) (h3 : a2 + b2 = a') (h4 : bit0 a + b = c) (h5 : b * c = b') :
    IsFibAux (bit1 n) a' b' :=
  ⟨by rw [fib_bit1, H.1, H.2, pow_two, pow_two, h1, h2, add_comm, h3], by
    rw [fib_bit1_succ, H.1, H.2, ← bit0_eq_two_mul, h4, h5]⟩
#align norm_num.is_fib_aux_bit1 NormNum.is_fib_aux_bit1
-/

#print NormNum.is_fib_aux_bit0_done /-
theorem is_fib_aux_bit0_done {n a b c a' : ℕ} (H : IsFibAux n a b) (h1 : a + c = bit0 b)
    (h2 : a * c = a') : fib (bit0 n) = a' :=
  (is_fib_aux_bit0 H h1 h2 rfl rfl rfl).1
#align norm_num.is_fib_aux_bit0_done NormNum.is_fib_aux_bit0_done
-/

#print NormNum.is_fib_aux_bit1_done /-
theorem is_fib_aux_bit1_done {n a b a2 b2 a' : ℕ} (H : IsFibAux n a b) (h1 : a * a = a2)
    (h2 : b * b = b2) (h3 : a2 + b2 = a') : fib (bit1 n) = a' :=
  (is_fib_aux_bit1 H h1 h2 h3 rfl rfl).1
#align norm_num.is_fib_aux_bit1_done NormNum.is_fib_aux_bit1_done
-/

/-- `prove_fib_aux ic n` returns `(ic', a, b, ⊢ is_fib_aux n a b)`, where `n` is a numeral. -/
unsafe def prove_fib_aux (ic : instance_cache) : expr → tactic (instance_cache × expr × expr × expr)
  | e =>
    match match_numeral e with
    | match_numeral_result.one => pure (ic, q((1 : ℕ)), q((1 : ℕ)), q(is_fib_aux_one))
    | match_numeral_result.bit0 e => do
      let (ic, a, b, H) ← prove_fib_aux e
      let na ← a.toNat
      let nb ← b.toNat
      let (ic, c) ← ic.ofNat (2 * nb - na)
      let (ic, h1) ← prove_add_nat ic a c (q((bit0 : ℕ → ℕ)).mk_app [b])
      let (ic, a', h2) ← prove_mul_nat ic a c
      let (ic, a2, h3) ← prove_mul_nat ic a a
      let (ic, b2, h4) ← prove_mul_nat ic b b
      let (ic, b', h5) ← prove_add_nat' ic a2 b2
      pure
          (ic, a', b',
            q(@is_fib_aux_bit0).mk_app [e, a, b, c, a2, b2, a', b', H, h1, h2, h3, h4, h5])
    | match_numeral_result.bit1 e => do
      let (ic, a, b, H) ← prove_fib_aux e
      let na ← a.toNat
      let nb ← b.toNat
      let (ic, c) ← ic.ofNat (2 * na + nb)
      let (ic, a2, h1) ← prove_mul_nat ic a a
      let (ic, b2, h2) ← prove_mul_nat ic b b
      let (ic, a', h3) ← prove_add_nat' ic a2 b2
      let (ic, h4) ← prove_add_nat ic (q((bit0 : ℕ → ℕ)).mk_app [a]) b c
      let (ic, b', h5) ← prove_mul_nat ic b c
      pure
          (ic, a', b',
            q(@is_fib_aux_bit1).mk_app [e, a, b, c, a2, b2, a', b', H, h1, h2, h3, h4, h5])
    | _ => failed
#align norm_num.prove_fib_aux norm_num.prove_fib_aux

/-- A `norm_num` plugin for `fib n` when `n` is a numeral.
Uses the binary representation of `n` like `nat.fast_fib`. -/
unsafe def prove_fib (ic : instance_cache) (e : expr) : tactic (instance_cache × expr × expr) :=
  match match_numeral e with
  | match_numeral_result.zero => pure (ic, q((0 : ℕ)), q(fib_zero))
  | match_numeral_result.one => pure (ic, q((1 : ℕ)), q(fib_one))
  | match_numeral_result.bit0 e => do
    let (ic, a, b, H) ← prove_fib_aux ic e
    let na ← a.toNat
    let nb ← b.toNat
    let (ic, c) ← ic.ofNat (2 * nb - na)
    let (ic, h1) ← prove_add_nat ic a c (q((bit0 : ℕ → ℕ)).mk_app [b])
    let (ic, a', h2) ← prove_mul_nat ic a c
    pure (ic, a', q(@is_fib_aux_bit0_done).mk_app [e, a, b, c, a', H, h1, h2])
  | match_numeral_result.bit1 e => do
    let (ic, a, b, H) ← prove_fib_aux ic e
    let (ic, a2, h1) ← prove_mul_nat ic a a
    let (ic, b2, h2) ← prove_mul_nat ic b b
    let (ic, a', h3) ← prove_add_nat' ic a2 b2
    pure (ic, a', q(@is_fib_aux_bit1_done).mk_app [e, a, b, a2, b2, a', H, h1, h2, h3])
  | _ => failed
#align norm_num.prove_fib norm_num.prove_fib

/-- A `norm_num` plugin for `fib n` when `n` is a numeral.
Uses the binary representation of `n` like `nat.fast_fib`. -/
@[norm_num]
unsafe def eval_fib : expr → tactic (expr × expr)
  | q(fib $(en)) => do
    let n ← en.toNat
    match n with
      | 0 => pure (q((0 : ℕ)), q(fib_zero))
      | 1 => pure (q((1 : ℕ)), q(fib_one))
      | 2 => pure (q((1 : ℕ)), q(fib_two))
      | _ => do
        let c ← mk_instance_cache q(ℕ)
        Prod.snd <$> prove_fib c en
  | _ => failed
#align norm_num.eval_fib norm_num.eval_fib

end NormNum


/-
Copyright (c) 2021 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta, Alena Gusakov, Yaël Dillies
-/
import data.finset.slice
import logic.function.iterate

/-!
# Shadows

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

This file defines shadows of a set family. The shadow of a set family is the set family of sets we
get by removing any element from any set of the original family. If one pictures `finset α` as a big
hypercube (each dimension being membership of a given element), then taking the shadow corresponds
to projecting each finset down once in all available directions.

## Main definitions

* `finset.shadow`: The shadow of a set family. Everything we can get by removing a new element from
  some set.
* `finset.up_shadow`: The upper shadow of a set family. Everything we can get by adding an element
  to some set.

## Notation

We define notation in locale `finset_family`:
* `∂ 𝒜`: Shadow of `𝒜`.
* `∂⁺ 𝒜`: Upper shadow of `𝒜`.

We also maintain the convention that `a, b : α` are elements of the ground type, `s, t : finset α`
are finsets, and `𝒜, ℬ : finset (finset α)` are finset families.

## References

* https://github.com/b-mehta/maths-notes/blob/master/iii/mich/combinatorics.pdf
* http://discretemath.imp.fu-berlin.de/DMII-2015-16/kruskal.pdf

## Tags

shadow, set family
-/

open finset nat

variables {α : Type*}

namespace finset
section shadow
variables [decidable_eq α] {𝒜 : finset (finset α)} {s t : finset α} {a : α} {k r : ℕ}

/-- The shadow of a set family `𝒜` is all sets we can get by removing one element from any set in
`𝒜`, and the (`k` times) iterated shadow (`shadow^[k]`) is all sets we can get by removing `k`
elements from any set in `𝒜`. -/
def shadow (𝒜 : finset (finset α)) : finset (finset α) := 𝒜.sup (λ s, s.image (erase s))

localized "notation (name := finset.shadow) `∂ `:90 := finset.shadow" in finset_family

/-- The shadow of the empty set is empty. -/
@[simp] lemma shadow_empty : ∂ (∅ : finset (finset α)) = ∅ := rfl
@[simp] lemma shadow_singleton_empty : ∂ ({∅} : finset (finset α)) = ∅ := rfl

--TODO: Prove `∂ {{a}} = {∅}` quickly using `covers` and `grade_order`

/-- The shadow is monotone. -/
@[mono] lemma shadow_monotone : monotone (shadow : finset (finset α) → finset (finset α)) :=
λ 𝒜 ℬ, sup_mono

/-- `s` is in the shadow of `𝒜` iff there is an `t ∈ 𝒜` from which we can remove one element to
get `s`. -/
lemma mem_shadow_iff : s ∈ ∂ 𝒜 ↔ ∃ t ∈ 𝒜, ∃ a ∈ t, erase t a = s :=
by simp only [shadow, mem_sup, mem_image]

lemma erase_mem_shadow (hs : s ∈ 𝒜) (ha : a ∈ s) : erase s a ∈ ∂ 𝒜 :=
mem_shadow_iff.2 ⟨s, hs, a, ha, rfl⟩

/-- `t` is in the shadow of `𝒜` iff we can add an element to it so that the resulting finset is in
`𝒜`. -/
lemma mem_shadow_iff_insert_mem : s ∈ ∂ 𝒜 ↔ ∃ a ∉ s, insert a s ∈ 𝒜 :=
begin
  refine mem_shadow_iff.trans ⟨_, _⟩,
  { rintro ⟨s, hs, a, ha, rfl⟩,
    refine ⟨a, not_mem_erase a s, _⟩,
    rwa insert_erase ha },
  { rintro ⟨a, ha, hs⟩,
    exact ⟨insert a s, hs, a, mem_insert_self _ _, erase_insert ha⟩ }
end

/-- The shadow of a family of `r`-sets is a family of `r - 1`-sets. -/
protected lemma _root_.set.sized.shadow (h𝒜 : (𝒜 : set (finset α)).sized r) :
  (∂ 𝒜 : set (finset α)).sized (r - 1) :=
begin
  intros A h,
  obtain ⟨A, hA, i, hi, rfl⟩ := mem_shadow_iff.1 h,
  rw [card_erase_of_mem hi, h𝒜 hA],
end

lemma sized_shadow_iff (h : ∅ ∉ 𝒜) :
  (∂ 𝒜 : set (finset α)).sized r ↔ (𝒜 : set (finset α)).sized (r + 1) :=
begin
  refine ⟨λ h𝒜 s hs, _, set.sized.shadow⟩,
  obtain ⟨a, ha⟩ := nonempty_iff_ne_empty.2 (ne_of_mem_of_not_mem hs h),
  rw [←h𝒜 (erase_mem_shadow hs ha), card_erase_add_one ha],
end

/-- `s ∈ ∂ 𝒜` iff `s` is exactly one element less than something from `𝒜` -/
lemma mem_shadow_iff_exists_mem_card_add_one :
  s ∈ ∂ 𝒜 ↔ ∃ t ∈ 𝒜, s ⊆ t ∧ t.card = s.card + 1 :=
begin
  refine mem_shadow_iff_insert_mem.trans ⟨_, _⟩,
  { rintro ⟨a, ha, hs⟩,
    exact ⟨insert a s, hs, subset_insert _ _, card_insert_of_not_mem ha⟩ },
  { rintro ⟨t, ht, hst, h⟩,
    obtain ⟨a, ha⟩ : ∃ a, t \ s = {a} :=
      card_eq_one.1 (by rw [card_sdiff hst, h, add_tsub_cancel_left]),
    exact ⟨a, λ hat,
      not_mem_sdiff_of_mem_right hat ((ha.ge : _ ⊆ _) $ mem_singleton_self a),
      by rwa [insert_eq a s, ←ha, sdiff_union_of_subset hst]⟩ }
end

/-- Being in the shadow of `𝒜` means we have a superset in `𝒜`. -/
lemma exists_subset_of_mem_shadow (hs : s ∈ ∂ 𝒜) : ∃ t ∈ 𝒜, s ⊆ t :=
let ⟨t, ht, hst⟩ := mem_shadow_iff_exists_mem_card_add_one.1 hs in ⟨t, ht, hst.1⟩

/-- `t ∈ ∂^k 𝒜` iff `t` is exactly `k` elements less than something in `𝒜`. -/
lemma mem_shadow_iff_exists_mem_card_add :
  s ∈ (∂^[k]) 𝒜 ↔ ∃ t ∈ 𝒜, s ⊆ t ∧ t.card = s.card + k :=
begin
  induction k with k ih generalizing 𝒜 s,
  { refine ⟨λ hs, ⟨s, hs, subset.refl _, rfl⟩, _⟩,
    rintro ⟨t, ht, hst, hcard⟩,
    rwa eq_of_subset_of_card_le hst hcard.le },
  simp only [exists_prop, function.comp_app, function.iterate_succ],
  refine ih.trans _,
  clear ih,
  split,
  { rintro ⟨t, ht, hst, hcardst⟩,
    obtain ⟨u, hu, htu, hcardtu⟩ := mem_shadow_iff_exists_mem_card_add_one.1 ht,
    refine ⟨u, hu, hst.trans htu, _⟩,
    rw [hcardtu, hcardst],
    refl },
  { rintro ⟨t, ht, hst, hcard⟩,
    obtain ⟨u, hsu, hut, hu⟩ := finset.exists_intermediate_set k
      (by { rw [add_comm, hcard], exact le_succ _ }) hst,
    rw add_comm at hu,
    refine ⟨u, mem_shadow_iff_exists_mem_card_add_one.2 ⟨t, ht, hut, _⟩, hsu, hu⟩,
    rw [hcard, hu],
    refl }
end

end shadow

open_locale finset_family

section up_shadow
variables [decidable_eq α] [fintype α] {𝒜 : finset (finset α)} {s t : finset α} {a : α} {k r : ℕ}

/-- The upper shadow of a set family `𝒜` is all sets we can get by adding one element to any set in
`𝒜`, and the (`k` times) iterated upper shadow (`up_shadow^[k]`) is all sets we can get by adding
`k` elements from any set in `𝒜`. -/
def up_shadow (𝒜 : finset (finset α)) : finset (finset α) :=
𝒜.sup $ λ s, sᶜ.image $ λ a, insert a s

localized "notation (name := finset.up_shadow) `∂⁺ `:90 := finset.up_shadow" in finset_family

/-- The upper shadow of the empty set is empty. -/
@[simp] lemma up_shadow_empty : ∂⁺ (∅ : finset (finset α)) = ∅ := rfl

/-- The upper shadow is monotone. -/
@[mono] lemma up_shadow_monotone : monotone (up_shadow : finset (finset α) → finset (finset α)) :=
λ 𝒜 ℬ, sup_mono

/-- `s` is in the upper shadow of `𝒜` iff there is an `t ∈ 𝒜` from which we can remove one element
to get `s`. -/
lemma mem_up_shadow_iff : s ∈ ∂⁺ 𝒜 ↔ ∃ t ∈ 𝒜, ∃ a ∉ t, insert a t = s :=
by simp_rw [up_shadow, mem_sup, mem_image, exists_prop, mem_compl]

lemma insert_mem_up_shadow (hs : s ∈ 𝒜) (ha : a ∉ s) : insert a s ∈ ∂⁺ 𝒜 :=
mem_up_shadow_iff.2 ⟨s, hs, a, ha, rfl⟩

/-- The upper shadow of a family of `r`-sets is a family of `r + 1`-sets. -/
protected lemma _root_.set.sized.up_shadow (h𝒜 : (𝒜 : set (finset α)).sized r) :
  (∂⁺ 𝒜 : set (finset α)).sized (r + 1) :=
begin
  intros A h,
  obtain ⟨A, hA, i, hi, rfl⟩ := mem_up_shadow_iff.1 h,
  rw [card_insert_of_not_mem hi, h𝒜 hA],
end

/-- `t` is in the upper shadow of `𝒜` iff we can remove an element from it so that the resulting
finset is in `𝒜`. -/
lemma mem_up_shadow_iff_erase_mem : s ∈ ∂⁺ 𝒜 ↔ ∃ a ∈ s, s.erase a ∈ 𝒜 :=
begin
  refine mem_up_shadow_iff.trans ⟨_, _⟩,
  { rintro ⟨s, hs, a, ha, rfl⟩,
    refine ⟨a, mem_insert_self a s, _⟩,
    rwa erase_insert ha },
  { rintro ⟨a, ha, hs⟩,
    exact ⟨s.erase a, hs, a, not_mem_erase _ _, insert_erase ha⟩ }
end

/-- `s ∈ ∂⁺ 𝒜` iff `s` is exactly one element less than something from `𝒜`. -/
lemma mem_up_shadow_iff_exists_mem_card_add_one :
  s ∈ ∂⁺ 𝒜 ↔ ∃ t ∈ 𝒜, t ⊆ s ∧ t.card + 1 = s.card :=
begin
  refine mem_up_shadow_iff_erase_mem.trans ⟨_, _⟩,
  { rintro ⟨a, ha, hs⟩,
    exact ⟨s.erase a, hs, erase_subset _ _, card_erase_add_one ha⟩ },
  { rintro ⟨t, ht, hts, h⟩,
    obtain ⟨a, ha⟩ : ∃ a, s \ t = {a} :=
      card_eq_one.1 (by rw [card_sdiff hts, ←h, add_tsub_cancel_left]),
    refine ⟨a, sdiff_subset _ _ ((ha.ge : _ ⊆ _) $ mem_singleton_self a), _⟩,
    rwa [←sdiff_singleton_eq_erase, ←ha, sdiff_sdiff_eq_self hts] }
end

/-- Being in the upper shadow of `𝒜` means we have a superset in `𝒜`. -/
lemma exists_subset_of_mem_up_shadow (hs : s ∈ ∂⁺ 𝒜) : ∃ t ∈ 𝒜, t ⊆ s :=
let ⟨t, ht, hts, _⟩ := mem_up_shadow_iff_exists_mem_card_add_one.1 hs in ⟨t, ht, hts⟩

/-- `t ∈ ∂^k 𝒜` iff `t` is exactly `k` elements more than something in `𝒜`. -/
lemma mem_up_shadow_iff_exists_mem_card_add :
  s ∈ (∂⁺^[k]) 𝒜 ↔ ∃ t ∈ 𝒜, t ⊆ s ∧ t.card + k = s.card :=
begin
  induction k with k ih generalizing 𝒜 s,
  { refine ⟨λ hs, ⟨s, hs, subset.refl _, rfl⟩, _⟩,
    rintro ⟨t, ht, hst, hcard⟩,
    rwa ←eq_of_subset_of_card_le hst hcard.ge },
  simp only [exists_prop, function.comp_app, function.iterate_succ],
  refine ih.trans _,
  clear ih,
  split,
  { rintro ⟨t, ht, hts, hcardst⟩,
    obtain ⟨u, hu, hut, hcardtu⟩ := mem_up_shadow_iff_exists_mem_card_add_one.1 ht,
    refine ⟨u, hu, hut.trans hts, _⟩,
    rw [←hcardst, ←hcardtu, add_right_comm],
    refl },
  { rintro ⟨t, ht, hts, hcard⟩,
    obtain ⟨u, htu, hus, hu⟩ := finset.exists_intermediate_set 1
      (by { rw [add_comm, ←hcard], exact add_le_add_left (zero_lt_succ _) _ }) hts,
    rw add_comm at hu,
    refine ⟨u, mem_up_shadow_iff_exists_mem_card_add_one.2 ⟨t, ht, htu, hu.symm⟩, hus, _⟩,
    rw [hu, ←hcard, add_right_comm],
    refl }
end

@[simp] lemma shadow_image_compl : (∂ 𝒜).image compl = ∂⁺ (𝒜.image compl) :=
begin
  ext s,
  simp only [mem_image, exists_prop, mem_shadow_iff, mem_up_shadow_iff],
  split,
  { rintro ⟨_, ⟨s, hs, a, ha, rfl⟩, rfl⟩,
    exact ⟨sᶜ, ⟨s, hs, rfl⟩, a, not_mem_compl.2 ha, compl_erase.symm⟩ },
  { rintro ⟨_, ⟨s, hs, rfl⟩, a, ha, rfl⟩,
    exact ⟨s.erase a, ⟨s, hs, a, not_mem_compl.1 ha, rfl⟩, compl_erase⟩ }
end

@[simp] lemma up_shadow_image_compl : (∂⁺ 𝒜).image compl = ∂ (𝒜.image compl) :=
begin
  ext s,
  simp only [mem_image, exists_prop, mem_shadow_iff, mem_up_shadow_iff],
  split,
  { rintro ⟨_, ⟨s, hs, a, ha, rfl⟩, rfl⟩,
    exact ⟨sᶜ, ⟨s, hs, rfl⟩, a, mem_compl.2 ha, compl_insert.symm⟩ },
  { rintro ⟨_, ⟨s, hs, rfl⟩, a, ha, rfl⟩,
    exact ⟨insert a s, ⟨s, hs, a, mem_compl.1 ha, rfl⟩, compl_insert⟩ }
end

end up_shadow
end finset


/-
Copyright (c) 2015 Microsoft Corporation. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Leonardo de Moura, Johannes Hölzl, Mario Carneiro

An efficient binary implementation of a (sqrt n) function that
returns s s.t.
    s*s ≤ n ≤ s*s + s + s
-/
import data.nat.basic algebra.ordered_group algebra.ring tactic

namespace nat

theorem sqrt_aux_dec {b} (h : b ≠ 0) : shiftr b 2 < b :=
begin
  simp [shiftr_eq_div_pow],
  apply (nat.div_lt_iff_lt_mul _ _ (dec_trivial : 4 > 0)).2,
  have := nat.mul_lt_mul_of_pos_left
    (dec_trivial : 1 < 4) (nat.pos_of_ne_zero h),
  rwa mul_one at this
end

def sqrt_aux : ℕ → ℕ → ℕ → ℕ
| b r n := if b0 : b = 0 then r else
  let b' := shiftr b 2 in
  have b' < b, from sqrt_aux_dec b0,
  match (n - (r + b : ℕ) : ℤ) with
  | (n' : ℕ) := sqrt_aux b' (div2 r + b) n'
  | _ := sqrt_aux b' (div2 r) n
  end

/-- `sqrt n` is the square root of a natural number `n`. If `n` is not a
  perfect square, it returns the largest `k:ℕ` such that `k*k ≤ n`. -/
def sqrt (n : ℕ) : ℕ :=
match size n with
| 0      := 0
| succ s := sqrt_aux (shiftl 1 (bit0 (div2 s))) 0 n
end

theorem sqrt_aux_0 (r n) : sqrt_aux 0 r n = r :=
by rw sqrt_aux; simp
local attribute [simp] sqrt_aux_0

theorem sqrt_aux_1 {r n b} (h : b ≠ 0) {n'} (h₂ : r + b + n' = n) :
  sqrt_aux b r n = sqrt_aux (shiftr b 2) (div2 r + b) n' :=
by rw sqrt_aux; simp only [h, h₂.symm, int.coe_nat_add, if_false];
   rw [add_comm _ (n':ℤ), add_sub_cancel, sqrt_aux._match_1]

theorem sqrt_aux_2 {r n b} (h : b ≠ 0) (h₂ : n < r + b) :
  sqrt_aux b r n = sqrt_aux (shiftr b 2) (div2 r) n :=
begin
  rw sqrt_aux; simp only [h, h₂, if_false],
  cases int.eq_neg_succ_of_lt_zero
    (sub_lt_zero.2 (int.coe_nat_lt_coe_nat_of_lt h₂)) with k e,
  rw [e, sqrt_aux._match_1]
end

private def is_sqrt (n q : ℕ) : Prop := q*q ≤ n ∧ n < (q+1)*(q+1)

private lemma sqrt_aux_is_sqrt_lemma (m r n : ℕ)
  (h₁ : r*r ≤ n)
  (m') (hm : shiftr (2^m * 2^m) 2 = m')
  (H1 : n < (r + 2^m) * (r + 2^m) →
    is_sqrt n (sqrt_aux m' (r * 2^m) (n - r * r)))
  (H2 : (r + 2^m) * (r + 2^m) ≤ n →
    is_sqrt n (sqrt_aux m' ((r + 2^m) * 2^m) (n - (r + 2^m) * (r + 2^m)))) :
  is_sqrt n (sqrt_aux (2^m * 2^m) ((2*r)*2^m) (n - r*r)) :=
begin
  have b0 :=
    have b0:_, from ne_of_gt (@pos_pow_of_pos 2 m dec_trivial),
    nat.mul_ne_zero b0 b0,
  have lb : n - r * r < 2 * r * 2^m + 2^m * 2^m ↔
            n < (r+2^m)*(r+2^m), {
    rw [nat.sub_lt_right_iff_lt_add h₁],
    simp [left_distrib, right_distrib, two_mul, mul_comm, mul_assoc] },
  have re : div2 (2 * r * 2^m) = r * 2^m, {
    rw [div2_val, mul_assoc,
        nat.mul_div_cancel_left _ (dec_trivial:2>0)] },
  cases lt_or_ge n ((r+2^m)*(r+2^m)) with hl hl,
  { rw [sqrt_aux_2 b0 (lb.2 hl), hm, re], apply H1 hl },
  { cases le.dest hl with n' e,
    rw [@sqrt_aux_1 (2 * r * 2^m) (n-r*r) (2^m * 2^m) b0 (n - (r + 2^m) * (r + 2^m)),
      hm, re, ← right_distrib],
    { apply H2 hl },
    apply eq.symm, apply nat.sub_eq_of_eq_add,
    rw [← add_assoc, (_ : r*r + _ = _)],
    exact (nat.add_sub_cancel' hl).symm,
    simp [left_distrib, right_distrib, two_mul, mul_comm, mul_assoc] },
end

private lemma sqrt_aux_is_sqrt (n) : ∀ m r,
  r*r ≤ n → n < (r + 2^(m+1)) * (r + 2^(m+1)) →
  is_sqrt n (sqrt_aux (2^m * 2^m) (2*r*2^m) (n - r*r))
| 0 r h₁ h₂ := by apply sqrt_aux_is_sqrt_lemma 0 r n h₁ 0 rfl;
  intros; simp; [exact ⟨h₁, a⟩, exact ⟨a, h₂⟩]
| (m+1) r h₁ h₂ := begin
    apply sqrt_aux_is_sqrt_lemma
      (m+1) r n h₁ (2^m * 2^m)
      (by simp [shiftr, pow_succ, div2_val, mul_comm, mul_left_comm];
          repeat {rw @nat.mul_div_cancel_left _ 2 dec_trivial});
      intros,
    { have := sqrt_aux_is_sqrt m r h₁ a,
      simpa [pow_succ, mul_comm, mul_assoc] },
    { rw [pow_succ, mul_two, ← add_assoc] at h₂,
      have := sqrt_aux_is_sqrt m (r + 2^(m+1)) a h₂,
      rwa show (r + 2^(m + 1)) * 2^(m+1) = 2 * (r + 2^(m + 1)) * 2^m,
          by simp [pow_succ, mul_comm, mul_left_comm] }
  end

private lemma sqrt_is_sqrt (n : ℕ) : is_sqrt n (sqrt n) :=
begin
  generalize e : size n = s, cases s with s; simp [e, sqrt],
  { rw [size_eq_zero.1 e, is_sqrt], exact dec_trivial },
  { have := sqrt_aux_is_sqrt n (div2 s) 0 (zero_le _),
    simp [show 2^div2 s * 2^div2 s = shiftl 1 (bit0 (div2 s)), by {
      generalize: div2 s = x,
      change bit0 x with x+x,
      rw [one_shiftl, pow_add] }] at this,
    apply this,
    rw [← pow_add, ← mul_two], apply size_le.1,
    rw e, apply (@div_lt_iff_lt_mul _ _ 2 dec_trivial).1,
    rw [div2_val], apply lt_succ_self }
end

theorem sqrt_le (n : ℕ) : sqrt n * sqrt n ≤ n :=
(sqrt_is_sqrt n).left

theorem lt_succ_sqrt (n : ℕ) : n < succ (sqrt n) * succ (sqrt n) :=
(sqrt_is_sqrt n).right

theorem sqrt_le_add (n : ℕ) : n ≤ sqrt n * sqrt n + sqrt n + sqrt n :=
by rw ← succ_mul; exact le_of_lt_succ (lt_succ_sqrt n)

theorem le_sqrt {m n : ℕ} : m ≤ sqrt n ↔ m*m ≤ n :=
⟨λ h, le_trans (mul_self_le_mul_self h) (sqrt_le n),
 λ h, le_of_lt_succ $ mul_self_lt_mul_self_iff.2 $
   lt_of_le_of_lt h (lt_succ_sqrt n)⟩

theorem sqrt_lt {m n : ℕ} : sqrt m < n ↔ m < n*n :=
le_iff_le_iff_lt_iff_lt.1 le_sqrt

theorem sqrt_le_self (n : ℕ) : sqrt n ≤ n :=
le_trans (le_mul_self _) (sqrt_le n)

theorem sqrt_le_sqrt {m n : ℕ} (h : m ≤ n) : sqrt m ≤ sqrt n :=
le_sqrt.2 (le_trans (sqrt_le _) h)

theorem sqrt_eq_zero {n : ℕ} : sqrt n = 0 ↔ n = 0 :=
⟨λ h, eq_zero_of_le_zero $ le_of_lt_succ $ (@sqrt_lt n 1).1 $
  by rw [h]; exact dec_trivial,
 λ e, e.symm ▸ rfl⟩

theorem eq_sqrt {n q} : q = sqrt n ↔ q*q ≤ n ∧ n < (q+1)*(q+1) :=
⟨λ e, e.symm ▸ sqrt_is_sqrt n,
 λ ⟨h₁, h₂⟩, le_antisymm (le_sqrt.2 h₁) (le_of_lt_succ $ sqrt_lt.2 h₂)⟩

theorem le_three_of_sqrt_eq_one {n : ℕ} (h : sqrt n = 1) : n ≤ 3 :=
le_of_lt_succ $ (@sqrt_lt n 2).1 $
by rw [h]; exact dec_trivial

theorem sqrt_lt_self {n : ℕ} (h : n > 1) : sqrt n < n :=
sqrt_lt.2 $ by
  have := nat.mul_lt_mul_of_pos_left h (lt_of_succ_lt h);
  rwa [mul_one] at this

theorem sqrt_pos {n : ℕ} : sqrt n > 0 ↔ n > 0 := le_sqrt

theorem sqrt_add_eq (n : ℕ) {a : ℕ} (h : a ≤ n + n) : sqrt (n*n + a) = n :=
le_antisymm
  (le_of_lt_succ $ sqrt_lt.2 $ by rw [succ_mul, mul_succ, add_succ, add_assoc];
    exact lt_succ_of_le (nat.add_le_add_left h _))
  (le_sqrt.2 $ nat.le_add_right _ _)

theorem sqrt_eq (n : ℕ) : sqrt (n*n) = n :=
sqrt_add_eq n (zero_le _)

theorem sqrt_succ_le_succ_sqrt (n : ℕ) : sqrt n.succ ≤ n.sqrt.succ :=
le_of_lt_succ $ sqrt_lt.2 $ lt_succ_of_le $ succ_le_succ $
le_trans (sqrt_le_add n) $ add_le_add_right
  (by refine add_le_add
    (mul_le_mul_right _ _) _; exact le_add_right _ 2) _

end nat


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

Sums of finite geometric series
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.group_with_zero.power
import Mathlib.algebra.big_operators.order
import Mathlib.algebra.big_operators.ring
import Mathlib.algebra.big_operators.intervals
import Mathlib.PostPort

universes u u_1

namespace Mathlib

/-- Sum of the finite geometric series $\sum_{i=0}^{n-1} x^i$. -/
def geom_series {α : Type u} [semiring α] (x : α) (n : ℕ) : α :=
  finset.sum (finset.range n) fun (i : ℕ) => x ^ i

theorem geom_series_def {α : Type u} [semiring α] (x : α) (n : ℕ) : geom_series x n = finset.sum (finset.range n) fun (i : ℕ) => x ^ i :=
  rfl

@[simp] theorem geom_series_zero {α : Type u} [semiring α] (x : α) : geom_series x 0 = 0 :=
  rfl

@[simp] theorem geom_series_one {α : Type u} [semiring α] (x : α) : geom_series x 1 = 1 := sorry

@[simp] theorem op_geom_series {α : Type u} [ring α] (x : α) (n : ℕ) : opposite.op (geom_series x n) = geom_series (opposite.op x) n := sorry

/-- Sum of the finite geometric series $\sum_{i=0}^{n-1} x^i y^{n-1-i}$. -/
def geom_series₂ {α : Type u} [semiring α] (x : α) (y : α) (n : ℕ) : α :=
  finset.sum (finset.range n) fun (i : ℕ) => x ^ i * y ^ (n - 1 - i)

theorem geom_series₂_def {α : Type u} [semiring α] (x : α) (y : α) (n : ℕ) : geom_series₂ x y n = finset.sum (finset.range n) fun (i : ℕ) => x ^ i * y ^ (n - 1 - i) :=
  rfl

@[simp] theorem geom_series₂_zero {α : Type u} [semiring α] (x : α) (y : α) : geom_series₂ x y 0 = 0 :=
  rfl

@[simp] theorem geom_series₂_one {α : Type u} [semiring α] (x : α) (y : α) : geom_series₂ x y 1 = 1 := sorry

@[simp] theorem geom_series₂_with_one {α : Type u} [semiring α] (x : α) (n : ℕ) : geom_series₂ x 1 n = geom_series x n := sorry

/-- $x^n-y^n = (x-y) \sum x^ky^{n-1-k}$ reformulated without `-` signs. -/
protected theorem commute.geom_sum₂_mul_add {α : Type u} [semiring α] {x : α} {y : α} (h : commute x y) (n : ℕ) : geom_series₂ (x + y) y n * x + y ^ n = (x + y) ^ n := sorry

theorem geom_series₂_self {α : Type u_1} [comm_ring α] (x : α) (n : ℕ) : geom_series₂ x x n = ↑n * x ^ (n - 1) := sorry

/-- $x^n-y^n = (x-y) \sum x^ky^{n-1-k}$ reformulated without `-` signs. -/
theorem geom_sum₂_mul_add {α : Type u} [comm_semiring α] (x : α) (y : α) (n : ℕ) : geom_series₂ (x + y) y n * x + y ^ n = (x + y) ^ n :=
  commute.geom_sum₂_mul_add (commute.all x y) n

theorem geom_sum_mul_add {α : Type u} [semiring α] (x : α) (n : ℕ) : geom_series (x + 1) n * x + 1 = (x + 1) ^ n :=
  eq.mp (Eq._oldrec (Eq.refl (geom_series₂ (x + 1) 1 n * x + 1 = (x + 1) ^ n)) (geom_series₂_with_one (x + 1) n))
    (eq.mp (Eq._oldrec (Eq.refl (geom_series₂ (x + 1) 1 n * x + 1 ^ n = (x + 1) ^ n)) (one_pow n))
      (commute.geom_sum₂_mul_add (commute.one_right x) n))

theorem geom_sum₂_mul_comm {α : Type u} [ring α] {x : α} {y : α} (h : commute x y) (n : ℕ) : geom_series₂ x y n * (x - y) = x ^ n - y ^ n := sorry

theorem geom_sum₂_mul {α : Type u} [comm_ring α] (x : α) (y : α) (n : ℕ) : geom_series₂ x y n * (x - y) = x ^ n - y ^ n :=
  geom_sum₂_mul_comm (commute.all x y) n

theorem geom_sum_mul {α : Type u} [ring α] (x : α) (n : ℕ) : geom_series x n * (x - 1) = x ^ n - 1 :=
  eq.mp (Eq._oldrec (Eq.refl (geom_series₂ x 1 n * (x - 1) = x ^ n - 1)) (geom_series₂_with_one x n))
    (eq.mp (Eq._oldrec (Eq.refl (geom_series₂ x 1 n * (x - 1) = x ^ n - 1 ^ n)) (one_pow n))
      (geom_sum₂_mul_comm (commute.one_right x) n))

theorem mul_geom_sum {α : Type u} [ring α] (x : α) (n : ℕ) : (x - 1) * geom_series x n = x ^ n - 1 := sorry

theorem geom_sum_mul_neg {α : Type u} [ring α] (x : α) (n : ℕ) : geom_series x n * (1 - x) = 1 - x ^ n := sorry

theorem mul_neg_geom_sum {α : Type u} [ring α] (x : α) (n : ℕ) : (1 - x) * geom_series x n = 1 - x ^ n := sorry

theorem geom_sum {α : Type u} [division_ring α] {x : α} (h : x ≠ 1) (n : ℕ) : geom_series x n = (x ^ n - 1) / (x - 1) := sorry

theorem geom_sum_Ico_mul {α : Type u} [ring α] (x : α) {m : ℕ} {n : ℕ} (hmn : m ≤ n) : (finset.sum (finset.Ico m n) fun (i : ℕ) => x ^ i) * (x - 1) = x ^ n - x ^ m := sorry

theorem geom_sum_Ico_mul_neg {α : Type u} [ring α] (x : α) {m : ℕ} {n : ℕ} (hmn : m ≤ n) : (finset.sum (finset.Ico m n) fun (i : ℕ) => x ^ i) * (1 - x) = x ^ m - x ^ n := sorry

theorem geom_sum_Ico {α : Type u} [division_ring α] {x : α} (hx : x ≠ 1) {m : ℕ} {n : ℕ} (hmn : m ≤ n) : (finset.sum (finset.Ico m n) fun (i : ℕ) => x ^ i) = (x ^ n - x ^ m) / (x - 1) := sorry

theorem geom_sum_inv {α : Type u} [division_ring α] {x : α} (hx1 : x ≠ 1) (hx0 : x ≠ 0) (n : ℕ) : geom_series (x⁻¹) n = x - 1⁻¹ * (x - x⁻¹ ^ n * x) := sorry

theorem ring_hom.map_geom_series {α : Type u} {β : Type u_1} [semiring α] [semiring β] (x : α) (n : ℕ) (f : α →+* β) : coe_fn f (geom_series x n) = geom_series (coe_fn f x) n := sorry

theorem ring_hom.map_geom_series₂ {α : Type u} {β : Type u_1} [semiring α] [semiring β] (x : α) (y : α) (n : ℕ) (f : α →+* β) : coe_fn f (geom_series₂ x y n) = geom_series₂ (coe_fn f x) (coe_fn f y) n := sorry


/-
Copyright (c) 2021 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import algebra.hom.non_unital_alg
import algebra.lie.basic

/-!
# Lie algebras as non-unital, non-associative algebras

The definition of Lie algebras uses the `has_bracket` typeclass for multiplication whereas we have a
separate `has_mul` typeclass used for general algebras.

It is useful to have a special typeclass for Lie algebras because:
 * it enables us to use the traditional notation `⁅x, y⁆` for the Lie multiplication,
 * associative algebras carry a natural Lie algebra structure via the ring commutator and so we need
   them to carry both `has_mul` and `has_bracket` simultaneously,
 * more generally, Poisson algebras (not yet defined) need both typeclasses.

However there are times when it is convenient to be able to regard a Lie algebra as a general
algebra and we provide some basic definitions for doing so here.

## Main definitions

  * `lie_ring.to_non_unital_non_assoc_semiring`
  * `lie_hom.to_non_unital_alg_hom`

## Tags

lie algebra, non-unital, non-associative
-/

universes u v w

variables (R : Type u) (L : Type v) [comm_ring R] [lie_ring L] [lie_algebra R L]

/-- A `lie_ring` can be regarded as a `non_unital_non_assoc_semiring` by turning its
`has_bracket` (denoted `⁅, ⁆`) into a `has_mul` (denoted `*`). -/
def lie_ring.to_non_unital_non_assoc_semiring : non_unital_non_assoc_semiring L :=
{ mul           := has_bracket.bracket,
  left_distrib  := lie_add,
  right_distrib := add_lie,
  zero_mul      := zero_lie,
  mul_zero      := lie_zero,
  .. (infer_instance : add_comm_monoid L) }

local attribute [instance] lie_ring.to_non_unital_non_assoc_semiring

namespace lie_algebra

/-- Regarding the `lie_ring` of a `lie_algebra` as a `non_unital_non_assoc_semiring`, we can
reinterpret the `smul_lie` law as an `is_scalar_tower`. -/
instance is_scalar_tower : is_scalar_tower R L L := ⟨smul_lie⟩

/-- Regarding the `lie_ring` of a `lie_algebra` as a `non_unital_non_assoc_semiring`, we can
reinterpret the `lie_smul` law as an `smul_comm_class`. -/
instance smul_comm_class : smul_comm_class R L L := ⟨λ t x y, (lie_smul t x y).symm⟩

end lie_algebra

namespace lie_hom

variables {R L} {L₂ : Type w} [lie_ring L₂] [lie_algebra R L₂]

/-- Regarding the `lie_ring` of a `lie_algebra` as a `non_unital_non_assoc_semiring`, we can
regard a `lie_hom` as a `non_unital_alg_hom`. -/
@[simps]
def to_non_unital_alg_hom (f : L →ₗ⁅R⁆ L₂) : non_unital_alg_hom R L L₂ :=
{ to_fun := f,
  map_zero' := f.map_zero,
  map_mul'  := f.map_lie,
  ..f }

lemma to_non_unital_alg_hom_injective :
  function.injective (to_non_unital_alg_hom : _ → non_unital_alg_hom R L L₂) :=
λ f g h, ext $ non_unital_alg_hom.congr_fun h

end lie_hom


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

Separation properties of topological spaces.
-/

import topology.order

open set filter lattice
local attribute [instance] classical.prop_decidable

universes u v
variables {α : Type u} {β : Type v} [topological_space α]

section separation

/-- A T₀ space, also known as a Kolmogorov space, is a topological space
  where for every pair `x ≠ y`, there is an open set containing one but not the other. -/
class t0_space (α : Type u) [topological_space α] : Prop :=
(t0 : ∀ x y, x ≠ y → ∃ U:set α, is_open U ∧ (xor (x ∈ U) (y ∈ U)))

theorem exists_open_singleton_of_fintype [t0_space α]
  [f : fintype α] [decidable_eq α] [ha : nonempty α] :
  ∃ x:α, is_open ({x}:set α) :=
have H : ∀ (T : finset α), T ≠ ∅ → ∃ x ∈ T, ∃ u, is_open u ∧ {x} = {y | y ∈ T} ∩ u :=
begin
  intro T,
  apply finset.case_strong_induction_on T,
  { intro h, exact (h rfl).elim },
  { intros x S hxS ih h,
    by_cases hs : S = ∅,
    { existsi [x, finset.mem_insert_self x S, univ, is_open_univ],
      rw [hs, inter_univ], refl },
    { rcases ih S (finset.subset.refl S) hs with ⟨y, hy, V, hv1, hv2⟩,
      by_cases hxV : x ∈ V,
      { cases t0_space.t0 x y (λ hxy, hxS $ by rwa hxy) with U hu,
        rcases hu with ⟨hu1, ⟨hu2, hu3⟩ | ⟨hu2, hu3⟩⟩,
        { existsi [x, finset.mem_insert_self x S, U ∩ V, is_open_inter hu1 hv1],
          apply set.ext,
          intro z,
          split,
          { intro hzx,
            rw set.mem_singleton_iff at hzx,
            rw hzx,
            exact ⟨finset.mem_insert_self x S, ⟨hu2, hxV⟩⟩ },
          { intro hz,
            rw set.mem_singleton_iff,
            rcases hz with ⟨hz1, hz2, hz3⟩,
            cases finset.mem_insert.1 hz1 with hz4 hz4,
            { exact hz4 },
            { have h1 : z ∈ {y : α | y ∈ S} ∩ V,
              { exact ⟨hz4, hz3⟩ },
              rw ← hv2 at h1,
              rw set.mem_singleton_iff at h1,
              rw h1 at hz2,
              exact (hu3 hz2).elim } } },
        { existsi [y, finset.mem_insert_of_mem hy, U ∩ V, is_open_inter hu1 hv1],
          apply set.ext,
          intro z,
          split,
          { intro hz,
            rw set.mem_singleton_iff at hz,
            rw hz,
            refine ⟨finset.mem_insert_of_mem hy, hu2, _⟩,
            have h1 : y ∈ {y} := set.mem_singleton y,
            rw hv2 at h1,
            exact h1.2 },
          { intro hz,
            rw set.mem_singleton_iff,
            cases hz with hz1 hz2,
            cases finset.mem_insert.1 hz1 with hz3 hz3,
            { rw hz3 at hz2,
              exact (hu3 hz2.1).elim },
            { have h1 : z ∈ {y : α | y ∈ S} ∩ V := ⟨hz3, hz2.2⟩,
              rw ← hv2 at h1,
              rw set.mem_singleton_iff at h1,
              exact h1 } } } },
      { existsi [y, finset.mem_insert_of_mem hy, V, hv1],
        apply set.ext,
        intro z,
        split,
        { intro hz,
          rw set.mem_singleton_iff at hz,
          rw hz,
          split,
          { exact finset.mem_insert_of_mem hy },
          { have h1 : y ∈ {y} := set.mem_singleton y,
            rw hv2 at h1,
            exact h1.2 } },
        { intro hz,
          rw hv2,
          cases hz with hz1 hz2,
          cases finset.mem_insert.1 hz1 with hz3 hz3,
          { rw hz3 at hz2,
            exact (hxV hz2).elim },
          { exact ⟨hz3, hz2⟩ } } } } }
end,
begin
  apply nonempty.elim ha, intro x,
  specialize H finset.univ (finset.ne_empty_of_mem $ finset.mem_univ x),
  rcases H with ⟨y, hyf, U, hu1, hu2⟩,
  existsi y,
  have h1 : {y : α | y ∈ finset.univ} = (univ : set α),
  { exact set.eq_univ_of_forall (λ x : α,
      by rw mem_set_of_eq; exact finset.mem_univ x) },
  rw h1 at hu2,
  rw set.univ_inter at hu2,
  rw hu2,
  exact hu1
end

/-- A T₁ space, also known as a Fréchet space, is a topological space
  where every singleton set is closed. Equivalently, for every pair
  `x ≠ y`, there is an open set containing `x` and not `y`. -/
class t1_space (α : Type u) [topological_space α] : Prop :=
(t1 : ∀x, is_closed ({x} : set α))

lemma is_closed_singleton [t1_space α] {x : α} : is_closed ({x} : set α) :=
t1_space.t1 x

instance t1_space.t0_space [t1_space α] : t0_space α :=
⟨λ x y h, ⟨-{x}, is_open_compl_iff.2 is_closed_singleton,
  or.inr ⟨λ hyx, or.cases_on hyx h.symm id, λ hx, hx $ or.inl rfl⟩⟩⟩

lemma compl_singleton_mem_nhds [t1_space α] {x y : α} (h : y ≠ x) : - {x} ∈ nhds y :=
mem_nhds_sets is_closed_singleton $ by rwa [mem_compl_eq, mem_singleton_iff]

@[simp] lemma closure_singleton [t1_space α] {a : α} :
  closure ({a} : set α) = {a} :=
closure_eq_of_is_closed is_closed_singleton

/-- A T₂ space, also known as a Hausdorff space, is one in which for every
  `x ≠ y` there exists disjoint open sets around `x` and `y`. This is
  the most widely used of the separation axioms. -/
class t2_space (α : Type u) [topological_space α] : Prop :=
(t2 : ∀x y, x ≠ y → ∃u v : set α, is_open u ∧ is_open v ∧ x ∈ u ∧ y ∈ v ∧ u ∩ v = ∅)

lemma t2_separation [t2_space α] {x y : α} (h : x ≠ y) :
  ∃u v : set α, is_open u ∧ is_open v ∧ x ∈ u ∧ y ∈ v ∧ u ∩ v = ∅ :=
t2_space.t2 x y h

instance t2_space.t1_space [t2_space α] : t1_space α :=
⟨λ x, is_open_iff_forall_mem_open.2 $ λ y hxy,
let ⟨u, v, hu, hv, hyu, hxv, huv⟩ := t2_separation (mt mem_singleton_of_eq hxy) in
⟨u, λ z hz1 hz2, ((ext_iff _ _).1 huv x).1 ⟨mem_singleton_iff.1 hz2 ▸ hz1, hxv⟩, hu, hyu⟩⟩

lemma eq_of_nhds_neq_bot [ht : t2_space α] {x y : α} (h : nhds x ⊓ nhds y ≠ ⊥) : x = y :=
classical.by_contradiction $ assume : x ≠ y,
let ⟨u, v, hu, hv, hx, hy, huv⟩ := t2_space.t2 x y this in
have u ∩ v ∈ nhds x ⊓ nhds y,
  from inter_mem_inf_sets (mem_nhds_sets hu hx) (mem_nhds_sets hv hy),
h $ empty_in_sets_eq_bot.mp $ huv ▸ this

lemma t2_iff_nhds : t2_space α ↔ ∀ {x y : α}, nhds x ⊓ nhds y ≠ ⊥ → x = y :=
⟨assume h, by exactI λ x y, eq_of_nhds_neq_bot,
 assume h, ⟨assume x y xy,
   have nhds x ⊓ nhds y = ⊥ := classical.by_contradiction (mt h xy),
   let ⟨u', hu', v', hv', u'v'⟩ := empty_in_sets_eq_bot.mpr this,
       ⟨u, uu', uo, hu⟩ := mem_nhds_sets_iff.mp hu',
       ⟨v, vv', vo, hv⟩ := mem_nhds_sets_iff.mp hv' in
   ⟨u, v, uo, vo, hu, hv, disjoint.eq_bot $ disjoint_mono uu' vv' u'v'⟩⟩⟩

lemma t2_iff_ultrafilter :
  t2_space α ↔ ∀ f {x y : α}, is_ultrafilter f → f ≤ nhds x → f ≤ nhds y → x = y :=
t2_iff_nhds.trans
  ⟨assume h f x y u fx fy, h $ neq_bot_of_le_neq_bot u.1 (le_inf fx fy),
   assume h x y xy,
     let ⟨f, hf, uf⟩ := exists_ultrafilter xy in
     h f uf (le_trans hf lattice.inf_le_left) (le_trans hf lattice.inf_le_right)⟩

@[simp] lemma nhds_eq_nhds_iff {a b : α} [t2_space α] : nhds a = nhds b ↔ a = b :=
⟨assume h, eq_of_nhds_neq_bot $ by rw [h, inf_idem]; exact nhds_neq_bot, assume h, h ▸ rfl⟩

@[simp] lemma nhds_le_nhds_iff {a b : α} [t2_space α] : nhds a ≤ nhds b ↔ a = b :=
⟨assume h, eq_of_nhds_neq_bot $ by rw [inf_of_le_left h]; exact nhds_neq_bot, assume h, h ▸ le_refl _⟩

lemma tendsto_nhds_unique [t2_space α] {f : β → α} {l : filter β} {a b : α}
  (hl : l ≠ ⊥) (ha : tendsto f l (nhds a)) (hb : tendsto f l (nhds b)) : a = b :=
eq_of_nhds_neq_bot $ neq_bot_of_le_neq_bot (map_ne_bot hl) $ le_inf ha hb

section lim
variables [inhabited α] [t2_space α] {f : filter α}

lemma lim_eq {a : α} (hf : f ≠ ⊥) (h : f ≤ nhds a) : lim f = a :=
eq_of_nhds_neq_bot $ neq_bot_of_le_neq_bot hf $ le_inf (lim_spec ⟨_, h⟩) h

@[simp] lemma lim_nhds_eq {a : α} : lim (nhds a) = a :=
lim_eq nhds_neq_bot (le_refl _)

@[simp] lemma lim_nhds_eq_of_closure {a : α} {s : set α} (h : a ∈ closure s) :
  lim (nhds a ⊓ principal s) = a :=
lim_eq begin rw [closure_eq_nhds] at h, exact h end inf_le_left
end lim

instance t2_space_discrete [topological_space α] [discrete_topology α] : t2_space α :=
{ t2 := assume x y hxy, ⟨{x}, {y}, is_open_discrete _, is_open_discrete _, mem_insert _ _, mem_insert _ _,
  eq_empty_iff_forall_not_mem.2 $ by intros z hz;
    cases eq_of_mem_singleton hz.1; cases eq_of_mem_singleton hz.2; cc⟩ }

private lemma separated_by_f
  [tα : topological_space α] [tβ : topological_space β] [t2_space β]
  (f : α → β) (hf : tβ.induced f ≤ tα) {x y : α} (h : f x ≠ f y) :
  ∃u v : set α, is_open u ∧ is_open v ∧ x ∈ u ∧ y ∈ v ∧ u ∩ v = ∅ :=
let ⟨u, v, uo, vo, xu, yv, uv⟩ := t2_separation h in
⟨f ⁻¹' u, f ⁻¹' v, hf _ ⟨u, uo, rfl⟩, hf _ ⟨v, vo, rfl⟩, xu, yv,
  by rw [←preimage_inter, uv, preimage_empty]⟩

instance {p : α → Prop} [t : topological_space α] [t2_space α] : t2_space (subtype p) :=
⟨assume x y h,
  separated_by_f subtype.val (le_refl _) (mt subtype.eq h)⟩

instance [t₁ : topological_space α] [t2_space α] [t₂ : topological_space β] [t2_space β] :
  t2_space (α × β) :=
⟨assume ⟨x₁,x₂⟩ ⟨y₁,y₂⟩ h,
  or.elim (not_and_distrib.mp (mt prod.ext_iff.mpr h))
    (λ h₁, separated_by_f prod.fst le_sup_left h₁)
    (λ h₂, separated_by_f prod.snd le_sup_right h₂)⟩

instance Pi.t2_space {β : α → Type v} [t₂ : Πa, topological_space (β a)] [Πa, t2_space (β a)] :
  t2_space (Πa, β a) :=
⟨assume x y h,
  let ⟨i, hi⟩ := not_forall.mp (mt funext h) in
  separated_by_f (λz, z i) (le_supr _ i) hi⟩

end separation

section regularity

/-- A T₃ space, also known as a regular space (although this condition sometimes
  omits T₂), is one in which for every closed `C` and `x ∉ C`, there exist
  disjoint open sets containing `x` and `C` respectively. -/
class regular_space (α : Type u) [topological_space α] extends t1_space α : Prop :=
(regular : ∀{s:set α} {a}, is_closed s → a ∉ s → ∃t, is_open t ∧ s ⊆ t ∧ nhds a ⊓ principal t = ⊥)

lemma nhds_is_closed [regular_space α] {a : α} {s : set α} (h : s ∈ nhds a) :
  ∃t∈(nhds a), t ⊆ s ∧ is_closed t :=
let ⟨s', h₁, h₂, h₃⟩ := mem_nhds_sets_iff.mp h in
have ∃t, is_open t ∧ -s' ⊆ t ∧ nhds a ⊓ principal t = ⊥,
  from regular_space.regular (is_closed_compl_iff.mpr h₂) (not_not_intro h₃),
let ⟨t, ht₁, ht₂, ht₃⟩ := this in
⟨-t,
  mem_sets_of_neq_bot $ by rwa [lattice.neg_neg],
  subset.trans (compl_subset_comm.1 ht₂) h₁,
  is_closed_compl_iff.mpr ht₁⟩

variable (α)
instance regular_space.t2_space [regular_space α] : t2_space α :=
⟨λ x y hxy,
let ⟨s, hs, hys, hxs⟩ := regular_space.regular is_closed_singleton
    (mt mem_singleton_iff.1 hxy),
  ⟨t, hxt, u, hsu, htu⟩ := empty_in_sets_eq_bot.2 hxs,
  ⟨v, hvt, hv, hxv⟩ := mem_nhds_sets_iff.1 hxt in
⟨v, s, hv, hs, hxv, singleton_subset_iff.1 hys,
eq_empty_of_subset_empty $ λ z ⟨hzv, hzs⟩, htu ⟨hvt hzv, hsu hzs⟩⟩⟩

end regularity

section normality

/-- A T₄ space, also known as a normal space (although this condition sometimes
  omits T₂), is one in which for every pair of disjoint closed sets `C` and `D`,
  there exist disjoint open sets containing `C` and `D` respectively. -/
class normal_space (α : Type u) [topological_space α] extends t1_space α : Prop :=
(normal : ∀ s t : set α, is_closed s → is_closed t → disjoint s t →
  ∃ u v, is_open u ∧ is_open v ∧ s ⊆ u ∧ t ⊆ v ∧ disjoint u v)

theorem normal_separation [normal_space α] (s t : set α)
  (H1 : is_closed s) (H2 : is_closed t) (H3 : disjoint s t) :
  ∃ u v, is_open u ∧ is_open v ∧ s ⊆ u ∧ t ⊆ v ∧ disjoint u v :=
normal_space.normal s t H1 H2 H3

variable (α)
instance normal_space.regular_space [normal_space α] : regular_space α :=
{ regular := λ s x hs hxs, let ⟨u, v, hu, hv, hsu, hxv, huv⟩ := normal_separation s {x} hs is_closed_singleton
      (λ _ ⟨hx, hy⟩, hxs $ set.mem_of_eq_of_mem (set.eq_of_mem_singleton hy).symm hx) in
    ⟨u, hu, hsu, filter.empty_in_sets_eq_bot.1 $ filter.mem_inf_sets.2
      ⟨v, mem_nhds_sets hv (set.singleton_subset_iff.1 hxv), u, filter.mem_principal_self u, set.inter_comm u v ▸ huv⟩⟩ }

end normality


/-
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 from_mathlib.limsup
import from_mathlib.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 topology 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