/-
Copyright (c) 2022 Riccardo Brasca. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Alex Best, Riccardo Brasca, Eric Rodriguez

! This file was ported from Lean 3 source module number_theory.cyclotomic.primitive_roots
! leanprover-community/mathlib commit 8631e2d5ea77f6c13054d9151d82b83069680cb1
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Data.Pnat.Prime
import Mathbin.Algebra.IsPrimePow
import Mathbin.NumberTheory.Cyclotomic.Basic
import Mathbin.RingTheory.Adjoin.PowerBasis
import Mathbin.RingTheory.Polynomial.Cyclotomic.Eval
import Mathbin.RingTheory.Norm

/-!
# Primitive roots in cyclotomic fields
If `is_cyclotomic_extension {n} A B`, we define an element `zeta n A B : B` that is (under certain
assumptions) a primitive `n`-root of unity in `B` and we study its properties. We also prove related
theorems under the more general assumption of just being a primitive root, for reasons described
in the implementation details section.

## Main definitions
* `is_cyclotomic_extension.zeta n A B`: if `is_cyclotomic_extension {n} A B`, than `zeta n A B`
  is an element of `B` that plays the role of a primitive `n`-th root of unity.
* `is_primitive_root.power_basis`: if `K` and `L` are fields such that
  `is_cyclotomic_extension {n} K L`, then `is_primitive_root.power_basis`
  gives a K-power basis for L given a primitive root `ζ`.
* `is_primitive_root.embeddings_equiv_primitive_roots`: the equivalence between `L →ₐ[K] A`
  and `primitive_roots n A` given by the choice of `ζ`.

## Main results
* `is_cyclotomic_extension.zeta_spec`: `zeta n A B` is a primitive `n`-th root of unity.
* `is_cyclotomic_extension.finrank`: if `irreducible (cyclotomic n K)` (in particular for
  `K = ℚ`), then the `finrank` of a cyclotomic extension is `n.totient`.
* `is_primitive_root.norm_eq_one`: if `irreducible (cyclotomic n K)` (in particular for `K = ℚ`),
  the norm of a primitive root is `1` if `n ≠ 2`.
* `is_primitive_root.sub_one_norm_eq_eval_cyclotomic`: if `irreducible (cyclotomic n K)`
  (in particular for `K = ℚ`), then the norm of `ζ - 1` is `eval 1 (cyclotomic n ℤ)`, for a
  primitive root ζ. We also prove the analogous of this result for `zeta`.
* `is_primitive_root.pow_sub_one_norm_prime_pow_ne_two` : if
  `irreducible (cyclotomic (p ^ (k + 1)) K)` (in particular for `K = ℚ`) and `p` is a prime,
  then the norm of `ζ ^ (p ^ s) - 1` is `p ^ (p ^ s)` `p ^ (k - s + 1) ≠ 2`. See the following
  lemmas for similar results. We also prove the analogous of this result for `zeta`.
* `is_primitive_root.sub_one_norm_prime_ne_two` : if `irreducible (cyclotomic (p ^ (k + 1)) K)`
  (in particular for `K = ℚ`) and `p` is an odd prime, then the norm of `ζ - 1` is `p`. We also
  prove the analogous of this result for `zeta`.
* `is_primitive_root.embeddings_equiv_primitive_roots`: the equivalence between `L →ₐ[K] A`
  and `primitive_roots n A` given by the choice of `ζ`.

## Implementation details
`zeta n A B` is defined as any primitive root of unity in `B`, that exists by definition. It is not
true in general that it is a root of `cyclotomic n B`, but this holds if `is_domain B` and
`ne_zero (↑n : B)`.

`zeta n A B` is defined using `exists.some`, which means we cannot control it.
For example, in normal mathematics, we can demand that `(zeta p ℤ ℤ[ζₚ] : ℚ(ζₚ))` is equal to
`zeta p ℚ ℚ(ζₚ)`, as we are just choosing "an arbitrary primitive root" and we can internally
specify that our choices agree. This is not the case here, and it is indeed impossible to prove that
these two are equal. Therefore, whenever possible, we prove our results for any primitive root,
and only at the "final step", when we need to provide an "explicit" primitive root, we use `zeta`.

-/

open Polynomial Algebra Finset FiniteDimensional IsCyclotomicExtension Nat PNat Set

universe u v w z

variable {p n : ℕ+} (A : Type w) (B : Type z) (K : Type u) {L : Type v} (C : Type w)

variable [CommRing A] [CommRing B] [Algebra A B] [IsCyclotomicExtension {n} A B]

section Zeta

namespace IsCyclotomicExtension

variable (n)

/-- If `B` is a `n`-th cyclotomic extension of `A`, then `zeta n A B` is a primitive root of
unity in `B`. -/
noncomputable def zeta : B :=
  (exists_prim_root A <| Set.mem_singleton n : ∃ r : B, IsPrimitiveRoot r n).some
#align is_cyclotomic_extension.zeta IsCyclotomicExtension.zeta

/-- `zeta n A B` is a primitive `n`-th root of unity. -/
@[simp]
theorem zeta_spec : IsPrimitiveRoot (zeta n A B) n :=
  Classical.choose_spec (exists_prim_root A (Set.mem_singleton n) : ∃ r : B, IsPrimitiveRoot r n)
#align is_cyclotomic_extension.zeta_spec IsCyclotomicExtension.zeta_spec

theorem aeval_zeta [IsDomain B] [NeZero ((n : ℕ) : B)] : aeval (zeta n A B) (cyclotomic n A) = 0 :=
  by
  rw [aeval_def, ← eval_map, ← is_root.def, map_cyclotomic, is_root_cyclotomic_iff]
  exact zeta_spec n A B
#align is_cyclotomic_extension.aeval_zeta IsCyclotomicExtension.aeval_zeta

theorem zeta_isRoot [IsDomain B] [NeZero ((n : ℕ) : B)] : IsRoot (cyclotomic n B) (zeta n A B) :=
  by
  convert aeval_zeta n A B
  rw [is_root.def, aeval_def, eval₂_eq_eval_map, map_cyclotomic]
#align is_cyclotomic_extension.zeta_is_root IsCyclotomicExtension.zeta_isRoot

theorem zeta_pow : zeta n A B ^ (n : ℕ) = 1 :=
  (zeta_spec n A B).pow_eq_one
#align is_cyclotomic_extension.zeta_pow IsCyclotomicExtension.zeta_pow

end IsCyclotomicExtension

end Zeta

section NoOrder

variable [Field K] [CommRing L] [IsDomain L] [Algebra K L] [IsCyclotomicExtension {n} K L] {ζ : L}
  (hζ : IsPrimitiveRoot ζ n)

namespace IsPrimitiveRoot

variable {C}

/-- The `power_basis` given by a primitive root `η`. -/
@[simps]
protected noncomputable def powerBasis : PowerBasis K L :=
  PowerBasis.map (Algebra.adjoin.powerBasis <| integral {n} K L ζ) <|
    (Subalgebra.equivOfEq _ _ (IsCyclotomicExtension.adjoin_primitive_root_eq_top hζ)).trans
      Subalgebra.topEquiv
#align is_primitive_root.power_basis IsPrimitiveRoot.powerBasis

theorem powerBasis_gen_mem_adjoin_zeta_sub_one :
    (hζ.PowerBasis K).gen ∈ adjoin K ({ζ - 1} : Set L) :=
  by
  rw [power_basis_gen, adjoin_singleton_eq_range_aeval, AlgHom.mem_range]
  exact ⟨X + 1, by simp⟩
#align is_primitive_root.power_basis_gen_mem_adjoin_zeta_sub_one IsPrimitiveRoot.powerBasis_gen_mem_adjoin_zeta_sub_one

/-- The `power_basis` given by `η - 1`. -/
@[simps]
noncomputable def subOnePowerBasis : PowerBasis K L :=
  (hζ.PowerBasis K).ofGenMemAdjoin
    (isIntegral_sub (IsCyclotomicExtension.integral {n} K L ζ) isIntegral_one)
    (hζ.powerBasis_gen_mem_adjoin_zeta_sub_one _)
#align is_primitive_root.sub_one_power_basis IsPrimitiveRoot.subOnePowerBasis

variable {K} (C)

-- We are not using @[simps] to avoid a timeout.
/-- The equivalence between `L →ₐ[K] C` and `primitive_roots n C` given by a primitive root `ζ`. -/
noncomputable def embeddingsEquivPrimitiveRoots (C : Type _) [CommRing C] [IsDomain C] [Algebra K C]
    (hirr : Irreducible (cyclotomic n K)) : (L →ₐ[K] C) ≃ primitiveRoots n C :=
  (hζ.PowerBasis K).liftEquiv.trans
    { toFun := fun x => by
        haveI := IsCyclotomicExtension.ne_zero' n K L
        haveI hn := NeZero.of_noZeroSMulDivisors K C n
        refine' ⟨x.1, _⟩
        cases x
        rwa [mem_primitiveRoots n.pos, ← is_root_cyclotomic_iff, is_root.def, ←
          map_cyclotomic _ (algebraMap K C), hζ.minpoly_eq_cyclotomic_of_irreducible hirr, ←
          eval₂_eq_eval_map, ← aeval_def]
      invFun := fun x => by
        haveI := IsCyclotomicExtension.ne_zero' n K L
        haveI hn := NeZero.of_noZeroSMulDivisors K C n
        refine' ⟨x.1, _⟩
        cases x
        rwa [aeval_def, eval₂_eq_eval_map, hζ.power_basis_gen K, ←
          hζ.minpoly_eq_cyclotomic_of_irreducible hirr, map_cyclotomic, ← is_root.def,
          is_root_cyclotomic_iff, ← mem_primitiveRoots n.pos]
      left_inv := fun x => Subtype.ext rfl
      right_inv := fun x => Subtype.ext rfl }
#align is_primitive_root.embeddings_equiv_primitive_roots IsPrimitiveRoot.embeddingsEquivPrimitiveRoots

@[simp]
theorem embeddingsEquivPrimitiveRoots_apply_coe (C : Type _) [CommRing C] [IsDomain C] [Algebra K C]
    (hirr : Irreducible (cyclotomic n K)) (φ : L →ₐ[K] C) :
    (hζ.embeddingsEquivPrimitiveRoots C hirr φ : C) = φ ζ :=
  rfl
#align is_primitive_root.embeddings_equiv_primitive_roots_apply_coe IsPrimitiveRoot.embeddingsEquivPrimitiveRoots_apply_coe

end IsPrimitiveRoot

namespace IsCyclotomicExtension

variable {K} (L)

/-- If `irreducible (cyclotomic n K)` (in particular for `K = ℚ`), then the `finrank` of a
cyclotomic extension is `n.totient`. -/
theorem finrank (hirr : Irreducible (cyclotomic n K)) : finrank K L = (n : ℕ).totient :=
  by
  haveI := IsCyclotomicExtension.ne_zero' n K L
  rw [((zeta_spec n K L).PowerBasis K).finrank, IsPrimitiveRoot.powerBasis_dim, ←
    (zeta_spec n K L).minpoly_eq_cyclotomic_of_irreducible hirr, nat_degree_cyclotomic]
#align is_cyclotomic_extension.finrank IsCyclotomicExtension.finrank

end IsCyclotomicExtension

end NoOrder

section Norm

namespace IsPrimitiveRoot

section CommRing

variable [CommRing L] {ζ : L} (hζ : IsPrimitiveRoot ζ n)

variable {K} [Field K] [Algebra K L]

/-- This mathematically trivial result is complementary to `norm_eq_one` below. -/
theorem norm_eq_neg_one_pow (hζ : IsPrimitiveRoot ζ 2) [IsDomain L] :
    norm K ζ = (-1) ^ finrank K L := by
  rw [hζ.eq_neg_one_of_two_right, show -1 = algebraMap K L (-1) by simp, Algebra.norm_algebraMap]
#align is_primitive_root.norm_eq_neg_one_pow IsPrimitiveRoot.norm_eq_neg_one_pow

include hζ

/-- If `irreducible (cyclotomic n K)` (in particular for `K = ℚ`), the norm of a primitive root is
`1` if `n ≠ 2`. -/
theorem norm_eq_one [IsDomain L] [IsCyclotomicExtension {n} K L] (hn : n ≠ 2)
    (hirr : Irreducible (cyclotomic n K)) : norm K ζ = 1 :=
  by
  haveI := IsCyclotomicExtension.ne_zero' n K L
  by_cases h1 : n = 1
  · rw [h1, one_coe, one_right_iff] at hζ
    rw [hζ, show 1 = algebraMap K L 1 by simp, Algebra.norm_algebraMap, one_pow]
  · replace h1 : 2 ≤ n
    · by_contra' h
      exact h1 (PNat.eq_one_of_lt_two h)
    rw [← hζ.power_basis_gen K, power_basis.norm_gen_eq_coeff_zero_minpoly, hζ.power_basis_gen K, ←
      hζ.minpoly_eq_cyclotomic_of_irreducible hirr, cyclotomic_coeff_zero _ h1, mul_one,
      hζ.power_basis_dim K, ← hζ.minpoly_eq_cyclotomic_of_irreducible hirr, nat_degree_cyclotomic]
    exact (totient_even <| h1.lt_of_ne hn.symm).neg_one_pow
#align is_primitive_root.norm_eq_one IsPrimitiveRoot.norm_eq_one

/-- If `K` is linearly ordered, the norm of a primitive root is `1` if `n` is odd. -/
theorem norm_eq_one_of_linearly_ordered {K : Type _} [LinearOrderedField K] [Algebra K L]
    (hodd : Odd (n : ℕ)) : norm K ζ = 1 :=
  by
  have hz := congr_arg (norm K) ((IsPrimitiveRoot.iff_def _ n).1 hζ).1
  rw [← (algebraMap K L).map_one, Algebra.norm_algebraMap, one_pow, map_pow, ← one_pow ↑n] at hz
  exact StrictMono.injective hodd.strict_mono_pow hz
#align is_primitive_root.norm_eq_one_of_linearly_ordered IsPrimitiveRoot.norm_eq_one_of_linearly_ordered

theorem norm_of_cyclotomic_irreducible [IsDomain L] [IsCyclotomicExtension {n} K L]
    (hirr : Irreducible (cyclotomic n K)) : norm K ζ = ite (n = 2) (-1) 1 :=
  by
  split_ifs with hn
  · subst hn
    convert norm_eq_neg_one_pow hζ
    erw [IsCyclotomicExtension.finrank _ hirr, totient_two, pow_one]
    all_goals infer_instance
  · exact hζ.norm_eq_one hn hirr
#align is_primitive_root.norm_of_cyclotomic_irreducible IsPrimitiveRoot.norm_of_cyclotomic_irreducible

end CommRing

section Field

variable [Field L] {ζ : L} (hζ : IsPrimitiveRoot ζ n)

variable {K} [Field K] [Algebra K L]

include hζ

/-- If `irreducible (cyclotomic n K)` (in particular for `K = ℚ`), then the norm of
`ζ - 1` is `eval 1 (cyclotomic n ℤ)`. -/
theorem sub_one_norm_eq_eval_cyclotomic [IsCyclotomicExtension {n} K L] (h : 2 < (n : ℕ))
    (hirr : Irreducible (cyclotomic n K)) : norm K (ζ - 1) = ↑(eval 1 (cyclotomic n ℤ)) :=
  by
  haveI := IsCyclotomicExtension.ne_zero' n K L
  let E := AlgebraicClosure L
  obtain ⟨z, hz⟩ := IsAlgClosed.exists_root _ (degree_cyclotomic_pos n E n.pos).Ne.symm
  apply (algebraMap K E).Injective
  letI := FiniteDimensional {n} K L
  letI := IsGalois n K L
  rw [norm_eq_prod_embeddings]
  conv_lhs =>
    congr
    skip
    ext
    rw [← neg_sub, AlgHom.map_neg, AlgHom.map_sub, AlgHom.map_one, neg_eq_neg_one_mul]
  rw [prod_mul_distrib, prod_const, card_univ, AlgHom.card, IsCyclotomicExtension.finrank L hirr,
    (totient_even h).neg_one_pow, one_mul]
  have : (finset.univ.prod fun σ : L →ₐ[K] E => 1 - σ ζ) = eval 1 (cyclotomic' n E) :=
    by
    rw [cyclotomic', eval_prod, ← @Finset.prod_attach E E, ← univ_eq_attach]
    refine' Fintype.prod_equiv (hζ.embeddings_equiv_primitive_roots E hirr) _ _ fun σ => _
    simp
  haveI : NeZero ((n : ℕ) : E) := NeZero.of_noZeroSMulDivisors K _ (n : ℕ)
  rw [this, cyclotomic', ← cyclotomic_eq_prod_X_sub_primitive_roots (is_root_cyclotomic_iff.1 hz), ←
    map_cyclotomic_int, _root_.map_int_cast, ← Int.cast_one, eval_int_cast_map, eq_intCast,
    Int.cast_id]
#align is_primitive_root.sub_one_norm_eq_eval_cyclotomic IsPrimitiveRoot.sub_one_norm_eq_eval_cyclotomic

/-- If `is_prime_pow (n : ℕ)`, `n ≠ 2` and `irreducible (cyclotomic n K)` (in particular for
`K = ℚ`), then the norm of `ζ - 1` is `(n : ℕ).min_fac`. -/
theorem sub_one_norm_isPrimePow (hn : IsPrimePow (n : ℕ)) [IsCyclotomicExtension {n} K L]
    (hirr : Irreducible (cyclotomic (n : ℕ) K)) (h : n ≠ 2) : norm K (ζ - 1) = (n : ℕ).minFac :=
  by
  have :=
    (coe_lt_coe 2 _).1
      (lt_of_le_of_ne (succ_le_of_lt (IsPrimePow.one_lt hn))
        (Function.Injective.ne PNat.coe_injective h).symm)
  letI hprime : Fact (n : ℕ).minFac.Prime := ⟨min_fac_prime (IsPrimePow.ne_one hn)⟩
  rw [sub_one_norm_eq_eval_cyclotomic hζ this hirr]
  nth_rw 1 [← IsPrimePow.minFac_pow_factorization_eq hn]
  obtain ⟨k, hk⟩ : ∃ k, (n : ℕ).factorization (n : ℕ).minFac = k + 1 :=
    exists_eq_succ_of_ne_zero
      (((n : ℕ).factorization.mem_support_toFun (n : ℕ).minFac).1 <|
        factor_iff_mem_factorization.2 <|
          (mem_factors (IsPrimePow.ne_zero hn)).2 ⟨hprime.out, min_fac_dvd _⟩)
  simp [hk, sub_one_norm_eq_eval_cyclotomic hζ this hirr]
#align is_primitive_root.sub_one_norm_is_prime_pow IsPrimitiveRoot.sub_one_norm_isPrimePow

omit hζ

variable {A}

theorem minpoly_sub_one_eq_cyclotomic_comp [Algebra K A] [IsDomain A] {ζ : A}
    [IsCyclotomicExtension {n} K A] (hζ : IsPrimitiveRoot ζ n)
    (h : Irreducible (Polynomial.cyclotomic n K)) :
    minpoly K (ζ - 1) = (cyclotomic n K).comp (X + 1) :=
  by
  haveI := IsCyclotomicExtension.ne_zero' n K A
  rw [show ζ - 1 = ζ + algebraMap K A (-1) by simp [sub_eq_add_neg],
    minpoly.add_algebraMap (IsCyclotomicExtension.integral {n} K A ζ),
    hζ.minpoly_eq_cyclotomic_of_irreducible h]
  simp
#align is_primitive_root.minpoly_sub_one_eq_cyclotomic_comp IsPrimitiveRoot.minpoly_sub_one_eq_cyclotomic_comp

attribute [local instance] IsCyclotomicExtension.finiteDimensional

attribute [local instance] IsCyclotomicExtension.isGalois

/- ./././Mathport/Syntax/Translate/Expr.lean:192:11: unsupported (impossible) -/
/- ./././Mathport/Syntax/Translate/Expr.lean:192:11: unsupported (impossible) -/
/- ./././Mathport/Syntax/Translate/Expr.lean:192:11: unsupported (impossible) -/
/- ./././Mathport/Syntax/Translate/Expr.lean:192:11: unsupported (impossible) -/
/- ./././Mathport/Syntax/Translate/Expr.lean:192:11: unsupported (impossible) -/
/- ./././Mathport/Syntax/Translate/Expr.lean:192:11: unsupported (impossible) -/
/- ./././Mathport/Syntax/Translate/Expr.lean:192:11: unsupported (impossible) -/
/-- If `irreducible (cyclotomic (p ^ (k + 1)) K)` (in particular for `K = ℚ`) and `p` is a prime,
then the norm of `ζ ^ (p ^ s) - 1` is `p ^ (p ^ s)` if `p ^ (k - s + 1) ≠ 2`. See the next lemmas
for similar results. -/
theorem pow_sub_one_norm_prime_pow_ne_two {k s : ℕ} (hζ : IsPrimitiveRoot ζ ↑(p ^ (k + 1)))
    [hpri : Fact (p : ℕ).Prime] [IsCyclotomicExtension {p ^ (k + 1)} K L]
    (hirr : Irreducible (cyclotomic (↑(p ^ (k + 1)) : ℕ) K)) (hs : s ≤ k)
    (htwo : p ^ (k - s + 1) ≠ 2) : norm K (ζ ^ (p : ℕ) ^ s - 1) = p ^ (p : ℕ) ^ s :=
  by
  have hirr₁ : Irreducible (cyclotomic (p ^ (k - s + 1)) K) :=
    cyclotomic_irreducible_pow_of_irreducible_pow hpri.1 (by linarith) hirr
  rw [← PNat.pow_coe] at hirr₁
  let η := ζ ^ (p : ℕ) ^ s - 1
  let η₁ : K⟮⟯ := IntermediateField.AdjoinSimple.gen K η
  have hη : IsPrimitiveRoot (η + 1) (p ^ (k + 1 - s)) :=
    by
    rw [sub_add_cancel]
    refine' IsPrimitiveRoot.pow (p ^ (k + 1)).Pos hζ _
    rw [PNat.pow_coe, ← pow_add, add_comm s, Nat.sub_add_cancel (le_trans hs (Nat.le_succ k))]
  have : IsCyclotomicExtension {p ^ (k - s + 1)} K K⟮⟯ :=
    by
    suffices IsCyclotomicExtension {p ^ (k - s + 1)} K K⟮⟯.toSubalgebra
      by
      have H : K⟮⟯.toSubalgebra = K⟮⟯.toSubalgebra :=
        by
        simp only [IntermediateField.adjoin_simple_toSubalgebra_of_integral
            (IsCyclotomicExtension.integral {p ^ (k + 1)} K L _)]
        refine' Subalgebra.ext fun x => ⟨fun hx => adjoin_le _ hx, fun hx => adjoin_le _ hx⟩
        · simp only [Set.singleton_subset_iff, SetLike.mem_coe]
          exact Subalgebra.add_mem _ (subset_adjoin (mem_singleton η)) (Subalgebra.one_mem _)
        · simp only [Set.singleton_subset_iff, SetLike.mem_coe]
          nth_rw 1 [← add_sub_cancel η 1]
          refine' Subalgebra.sub_mem _ (subset_adjoin (mem_singleton _)) (Subalgebra.one_mem _)
      rw [H] at this
      exact this
    rw [IntermediateField.adjoin_simple_toSubalgebra_of_integral
        (IsCyclotomicExtension.integral {p ^ (k + 1)} K L _)]
    have hη' : IsPrimitiveRoot (η + 1) ↑(p ^ (k + 1 - s)) := by simpa using hη
    convert hη'.adjoin_is_cyclotomic_extension K
    rw [Nat.sub_add_comm hs]
  replace hη : IsPrimitiveRoot (η₁ + 1) ↑(p ^ (k - s + 1))
  · apply coe_submonoid_class_iff.1
    convert hη
    rw [Nat.sub_add_comm hs, pow_coe]
  rw [norm_eq_norm_adjoin K]
  · have H := hη.sub_one_norm_is_prime_pow _ hirr₁ htwo
    swap
    · rw [PNat.pow_coe]
      exact hpri.1.IsPrimePow.pow (Nat.succ_ne_zero _)
    rw [add_sub_cancel] at H
    rw [H, coe_coe]
    congr
    · rw [PNat.pow_coe, Nat.pow_minFac, hpri.1.minFac_eq]
      exact Nat.succ_ne_zero _
    have := FiniteDimensional.finrank_mul_finrank K K⟮⟯ L
    rw [IsCyclotomicExtension.finrank L hirr, IsCyclotomicExtension.finrank K⟮⟯ hirr₁, PNat.pow_coe,
      PNat.pow_coe, Nat.totient_prime_pow hpri.out (k - s).succ_pos,
      Nat.totient_prime_pow hpri.out k.succ_pos, mul_comm _ (↑p - 1), mul_assoc,
      mul_comm (↑p ^ (k.succ - 1))] at this
    replace this := mul_left_cancel₀ (tsub_pos_iff_lt.2 hpri.out.one_lt).ne' this
    have Hex : k.succ - 1 = (k - s).succ - 1 + s :=
      by
      simp only [Nat.succ_sub_succ_eq_sub, tsub_zero]
      exact (Nat.sub_add_cancel hs).symm
    rw [Hex, pow_add] at this
    exact mul_left_cancel₀ (pow_ne_zero _ hpri.out.ne_zero) this
  all_goals infer_instance
#align is_primitive_root.pow_sub_one_norm_prime_pow_ne_two IsPrimitiveRoot.pow_sub_one_norm_prime_pow_ne_two

/-- If `irreducible (cyclotomic (p ^ (k + 1)) K)` (in particular for `K = ℚ`) and `p` is a prime,
then the norm of `ζ ^ (p ^ s) - 1` is `p ^ (p ^ s)` if `p ≠ 2`. -/
theorem pow_sub_one_norm_prime_ne_two {k : ℕ} (hζ : IsPrimitiveRoot ζ ↑(p ^ (k + 1)))
    [hpri : Fact (p : ℕ).Prime] [IsCyclotomicExtension {p ^ (k + 1)} K L]
    (hirr : Irreducible (cyclotomic (↑(p ^ (k + 1)) : ℕ) K)) {s : ℕ} (hs : s ≤ k) (hodd : p ≠ 2) :
    norm K (ζ ^ (p : ℕ) ^ s - 1) = p ^ (p : ℕ) ^ s :=
  by
  refine' hζ.pow_sub_one_norm_prime_pow_ne_two hirr hs fun h => _
  rw [← PNat.coe_inj, PNat.coe_bit0, PNat.one_coe, PNat.pow_coe, ← pow_one 2] at h
  replace h :=
    eq_of_prime_pow_eq (prime_iff.1 hpri.out) (prime_iff.1 Nat.prime_two) (k - s).succ_pos h
  rw [← PNat.one_coe, ← PNat.coe_bit0, PNat.coe_inj] at h
  exact hodd h
#align is_primitive_root.pow_sub_one_norm_prime_ne_two IsPrimitiveRoot.pow_sub_one_norm_prime_ne_two

/-- If `irreducible (cyclotomic (p ^ (k + 1)) K)` (in particular for `K = ℚ`) and `p` is an odd
prime, then the norm of `ζ - 1` is `p`. -/
theorem sub_one_norm_prime_ne_two {k : ℕ} (hζ : IsPrimitiveRoot ζ ↑(p ^ (k + 1)))
    [hpri : Fact (p : ℕ).Prime] [IsCyclotomicExtension {p ^ (k + 1)} K L]
    (hirr : Irreducible (cyclotomic (↑(p ^ (k + 1)) : ℕ) K)) (h : p ≠ 2) : norm K (ζ - 1) = p := by
  simpa using hζ.pow_sub_one_norm_prime_ne_two hirr k.zero_le h
#align is_primitive_root.sub_one_norm_prime_ne_two IsPrimitiveRoot.sub_one_norm_prime_ne_two

/-- If `irreducible (cyclotomic p K)` (in particular for `K = ℚ`) and `p` is an odd prime,
then the norm of `ζ - 1` is `p`. -/
theorem sub_one_norm_prime [hpri : Fact (p : ℕ).Prime] [hcyc : IsCyclotomicExtension {p} K L]
    (hζ : IsPrimitiveRoot ζ p) (hirr : Irreducible (cyclotomic p K)) (h : p ≠ 2) :
    norm K (ζ - 1) = p :=
  by
  replace hirr : Irreducible (cyclotomic (↑(p ^ (0 + 1)) : ℕ) K) := by simp [hirr]
  replace hζ : IsPrimitiveRoot ζ (↑(p ^ (0 + 1)) : ℕ) := by simp [hζ]
  haveI : IsCyclotomicExtension {p ^ (0 + 1)} K L := by simp [hcyc]
  simpa using sub_one_norm_prime_ne_two hζ hirr h
#align is_primitive_root.sub_one_norm_prime IsPrimitiveRoot.sub_one_norm_prime

/-- If `irreducible (cyclotomic (2 ^ (k + 1)) K)` (in particular for `K = ℚ`), then the norm of
`ζ ^ (2 ^ k) - 1` is `(-2) ^ (2 ^ k)`. -/
theorem pow_sub_one_norm_two {k : ℕ} (hζ : IsPrimitiveRoot ζ (2 ^ (k + 1)))
    [IsCyclotomicExtension {2 ^ (k + 1)} K L] (hirr : Irreducible (cyclotomic (2 ^ (k + 1)) K)) :
    norm K (ζ ^ 2 ^ k - 1) = (-2) ^ 2 ^ k :=
  by
  have := hζ.pow_of_dvd (fun h => two_ne_zero (pow_eq_zero h)) (pow_dvd_pow 2 (le_succ k))
  rw [Nat.pow_div (le_succ k) zero_lt_two, Nat.succ_sub (le_refl k), Nat.sub_self, pow_one] at this
  have H : (-1 : L) - (1 : L) = algebraMap K L (-2) :=
    by
    simp only [_root_.map_neg, map_bit0, _root_.map_one]
    ring
  replace hirr : Irreducible (cyclotomic (2 ^ (k + 1) : ℕ+) K) := by simp [hirr]
  rw [this.eq_neg_one_of_two_right, H, Algebra.norm_algebraMap,
    IsCyclotomicExtension.finrank L hirr, pow_coe, PNat.coe_bit0, one_coe,
    totient_prime_pow Nat.prime_two (zero_lt_succ k), succ_sub_succ_eq_sub, tsub_zero, mul_one]
#align is_primitive_root.pow_sub_one_norm_two IsPrimitiveRoot.pow_sub_one_norm_two

/-- If `irreducible (cyclotomic (2 ^ k) K)` (in particular for `K = ℚ`) and `k` is at least `2`,
then the norm of `ζ - 1` is `2`. -/
theorem sub_one_norm_two {k : ℕ} (hζ : IsPrimitiveRoot ζ (2 ^ k)) (hk : 2 ≤ k)
    [H : IsCyclotomicExtension {2 ^ k} K L] (hirr : Irreducible (cyclotomic (2 ^ k) K)) :
    norm K (ζ - 1) = 2 :=
  by
  have : 2 < (2 ^ k : ℕ+) :=
    by
    simp only [← coe_lt_coe, PNat.coe_bit0, one_coe, pow_coe]
    nth_rw 1 [← pow_one 2]
    exact pow_lt_pow one_lt_two (lt_of_lt_of_le one_lt_two hk)
  replace hirr : Irreducible (cyclotomic (2 ^ k : ℕ+) K) := by simp [hirr]
  replace hζ : IsPrimitiveRoot ζ (2 ^ k : ℕ+) := by simp [hζ]
  obtain ⟨k₁, hk₁⟩ := exists_eq_succ_of_ne_zero (lt_of_lt_of_le zero_lt_two hk).Ne.symm
  simpa [hk₁] using sub_one_norm_eq_eval_cyclotomic hζ this hirr
#align is_primitive_root.sub_one_norm_two IsPrimitiveRoot.sub_one_norm_two

/-- If `irreducible (cyclotomic (p ^ (k + 1)) K)` (in particular for `K = ℚ`) and `p` is a prime,
then the norm of `ζ ^ (p ^ s) - 1` is `p ^ (p ^ s)` if `k ≠ 0` and `s ≤ k`. -/
theorem pow_sub_one_norm_prime_pow_of_ne_zero {k s : ℕ} (hζ : IsPrimitiveRoot ζ ↑(p ^ (k + 1)))
    [hpri : Fact (p : ℕ).Prime] [hcycl : IsCyclotomicExtension {p ^ (k + 1)} K L]
    (hirr : Irreducible (cyclotomic (↑(p ^ (k + 1)) : ℕ) K)) (hs : s ≤ k) (hk : k ≠ 0) :
    norm K (ζ ^ (p : ℕ) ^ s - 1) = p ^ (p : ℕ) ^ s :=
  by
  by_cases htwo : p ^ (k - s + 1) = 2
  · have hp : p = 2 :=
      by
      rw [← PNat.coe_inj, PNat.coe_bit0, PNat.one_coe, PNat.pow_coe, ← pow_one 2] at htwo
      replace htwo :=
        eq_of_prime_pow_eq (prime_iff.1 hpri.out) (prime_iff.1 Nat.prime_two) (succ_pos _) htwo
      rwa [show 2 = ((2 : ℕ+) : ℕ) by simp, PNat.coe_inj] at htwo
    replace hs : s = k
    · rw [hp, ← PNat.coe_inj, PNat.pow_coe, PNat.coe_bit0, PNat.one_coe] at htwo
      nth_rw 2 [← pow_one 2] at htwo
      replace htwo := Nat.pow_right_injective rfl.le htwo
      rw [add_left_eq_self, Nat.sub_eq_zero_iff_le] at htwo
      refine' le_antisymm hs htwo
    simp only [hs, hp, PNat.coe_bit0, one_coe, coe_coe, cast_bit0, cast_one, pow_coe] at
      hζ hirr hcycl⊢
    haveI := hcycl
    obtain ⟨k₁, hk₁⟩ := Nat.exists_eq_succ_of_ne_zero hk
    rw [hζ.pow_sub_one_norm_two hirr]
    rw [hk₁, pow_succ, pow_mul, neg_eq_neg_one_mul, mul_pow, neg_one_sq, one_mul, ← pow_mul, ←
      pow_succ]
  · exact hζ.pow_sub_one_norm_prime_pow_ne_two hirr hs htwo
#align is_primitive_root.pow_sub_one_norm_prime_pow_of_ne_zero IsPrimitiveRoot.pow_sub_one_norm_prime_pow_of_ne_zero

end Field

end IsPrimitiveRoot

namespace IsCyclotomicExtension

open IsPrimitiveRoot

variable {K} (L) [Field K] [Field L] [Algebra K L]

/-- If `irreducible (cyclotomic n K)` (in particular for `K = ℚ`), the norm of `zeta n K L` is `1`
if `n` is odd. -/
theorem norm_zeta_eq_one [IsCyclotomicExtension {n} K L] (hn : n ≠ 2)
    (hirr : Irreducible (cyclotomic n K)) : norm K (zeta n K L) = 1 :=
  (zeta_spec n K L).norm_eq_one hn hirr
#align is_cyclotomic_extension.norm_zeta_eq_one IsCyclotomicExtension.norm_zeta_eq_one

/-- If `is_prime_pow (n : ℕ)`, `n ≠ 2` and `irreducible (cyclotomic n K)` (in particular for
`K = ℚ`), then the norm of `zeta n K L - 1` is `(n : ℕ).min_fac`. -/
theorem isPrimePow_norm_zeta_sub_one (hn : IsPrimePow (n : ℕ)) [IsCyclotomicExtension {n} K L]
    (hirr : Irreducible (cyclotomic (n : ℕ) K)) (h : n ≠ 2) :
    norm K (zeta n K L - 1) = (n : ℕ).minFac :=
  (zeta_spec n K L).sub_one_norm_isPrimePow hn hirr h
#align is_cyclotomic_extension.is_prime_pow_norm_zeta_sub_one IsCyclotomicExtension.isPrimePow_norm_zeta_sub_one

/-- If `irreducible (cyclotomic (p ^ (k + 1)) K)` (in particular for `K = ℚ`) and `p` is a prime,
then the norm of `(zeta (p ^ (k + 1)) K L) ^ (p ^ s) - 1` is `p ^ (p ^ s)`
if `p ^ (k - s + 1) ≠ 2`. -/
theorem prime_ne_two_pow_norm_zeta_pow_sub_one {k : ℕ} [hpri : Fact (p : ℕ).Prime]
    [IsCyclotomicExtension {p ^ (k + 1)} K L]
    (hirr : Irreducible (cyclotomic (↑(p ^ (k + 1)) : ℕ) K)) {s : ℕ} (hs : s ≤ k)
    (htwo : p ^ (k - s + 1) ≠ 2) :
    norm K (zeta (p ^ (k + 1)) K L ^ (p : ℕ) ^ s - 1) = p ^ (p : ℕ) ^ s :=
  (zeta_spec _ K L).pow_sub_one_norm_prime_pow_ne_two hirr hs htwo
#align is_cyclotomic_extension.prime_ne_two_pow_norm_zeta_pow_sub_one IsCyclotomicExtension.prime_ne_two_pow_norm_zeta_pow_sub_one

/-- If `irreducible (cyclotomic (p ^ (k + 1)) K)` (in particular for `K = ℚ`) and `p` is an odd
prime, then the norm of `zeta (p ^ (k + 1)) K L - 1` is `p`. -/
theorem prime_ne_two_pow_norm_zeta_sub_one {k : ℕ} [hpri : Fact (p : ℕ).Prime]
    [IsCyclotomicExtension {p ^ (k + 1)} K L]
    (hirr : Irreducible (cyclotomic (↑(p ^ (k + 1)) : ℕ) K)) (h : p ≠ 2) :
    norm K (zeta (p ^ (k + 1)) K L - 1) = p :=
  (zeta_spec _ K L).sub_one_norm_prime_ne_two hirr h
#align is_cyclotomic_extension.prime_ne_two_pow_norm_zeta_sub_one IsCyclotomicExtension.prime_ne_two_pow_norm_zeta_sub_one

/-- If `irreducible (cyclotomic p K)` (in particular for `K = ℚ`) and `p` is an odd prime,
then the norm of `zeta p K L - 1` is `p`. -/
theorem prime_ne_two_norm_zeta_sub_one [hpri : Fact (p : ℕ).Prime]
    [hcyc : IsCyclotomicExtension {p} K L] (hirr : Irreducible (cyclotomic p K)) (h : p ≠ 2) :
    norm K (zeta p K L - 1) = p :=
  (zeta_spec _ K L).sub_one_norm_prime hirr h
#align is_cyclotomic_extension.prime_ne_two_norm_zeta_sub_one IsCyclotomicExtension.prime_ne_two_norm_zeta_sub_one

/-- If `irreducible (cyclotomic (2 ^ k) K)` (in particular for `K = ℚ`) and `k` is at least `2`,
then the norm of `zeta (2 ^ k) K L - 1` is `2`. -/
theorem two_pow_norm_zeta_sub_one {k : ℕ} (hk : 2 ≤ k) [IsCyclotomicExtension {2 ^ k} K L]
    (hirr : Irreducible (cyclotomic (2 ^ k) K)) : norm K (zeta (2 ^ k) K L - 1) = 2 :=
  sub_one_norm_two (zeta_spec (2 ^ k) K L) hk hirr
#align is_cyclotomic_extension.two_pow_norm_zeta_sub_one IsCyclotomicExtension.two_pow_norm_zeta_sub_one

end IsCyclotomicExtension

end Norm


import data.nat.fib
import data.fin.tuple
import data.fintype.card
import algebra.big_operators.basic
import algebra.big_operators.order
open_locale big_operators
open classical nat
local attribute [instance] prop_decidable

def is_zeckendorf_rep {k : ℕ} (kpos : k > 0) (f : fin k → ℕ) : Prop :=
  f ⟨0, kpos⟩ > 1 ∧ ∀ m n, m > n → f m > f n + 1

def has_zeckendorf_rep (n : ℕ) :=
  ∃ (k : ℕ) (kpos : k > 0) (f : fin k → ℕ),
    is_zeckendorf_rep kpos f ∧ ∑ (i : fin k), fib (f i) = n

lemma trivial_rep_is_zeckendorf (f : fin 1 → ℕ) (h : f ⟨0, by norm_num⟩ > 1) :
  is_zeckendorf_rep (by norm_num) f :=
begin
  split,
  { assumption },
  { intros m n hinductn,
    exfalso,
    have hinduct0 : m = 0 := fin.eq_zero m,
    have hn0 : n = 0 := fin.eq_zero n,
    subst hn0,
    exact (ne_of_gt hinductn) hinduct0, }
end

lemma fib_three : fib 3 = 2 := begin
  rw fib_succ_succ, ring
end

lemma eq_last_of_not_lt {k : ℕ} {m : fin k.succ} (h : ¬↑m < k) : ↑m = k :=
  le_antisymm (fin.is_le m) (le_of_not_gt h)

lemma fib_inv_strict_mono {m n : ℕ} (h : fib m < fib n) : m < n :=
begin
  by_contra h1, exact not_lt.mpr (fib_mono (not_lt.mp h1)) h,
end

theorem zeckendorf_existence (n : ℕ) : n > 0 → has_zeckendorf_rep n :=
begin
  apply nat.strong_induction_on n,
  clear n,
  intros n hinduct hn,

  -- Trivial cases
  by_cases n_eq_0 : n = 0,
  { exfalso, exact (ne_of_gt hn) n_eq_0 },

  by_cases n_eq_1 : n = 1,
  { use [1, by norm_num, (λ i, 2)], -- 1 = fib 2
    split,
    { exact trivial_rep_is_zeckendorf _ (by norm_num) },
    { rw [fintype.sum_unique, n_eq_1, fib_two] } },

  by_cases n_eq_2 : n = 2,
  { use [1, by norm_num, (λ i, 3)], -- 2 = fib 3
    split,
    { exact trivial_rep_is_zeckendorf _ (by norm_num) },
    { rw [fintype.sum_unique, n_eq_2, fib_three] } },

  -- Induction step
  have n_ge_2 : n > 2,
  { refine lt_of_le_of_ne _ (ne.symm n_eq_2),
    rw nat.succ_le_iff,
    refine lt_of_le_of_ne _ (ne.symm n_eq_1),
    rw nat.succ_le_iff,
    rwa pos_iff_ne_zero },
  clear n_eq_0 n_eq_1 n_eq_2,

  set fibs := λ i, ∃ k, i = fib k with hfibs,
  -- F = fib l is the greatest Fibonacci number ≤ n
  set F := nat.find_greatest fibs n with hF,

  have two_le_F : 2 ≤ F,
  { refine nat.le_find_greatest (le_of_lt n_ge_2) _,
    use 3, rw fib_three },
  have : ∃ m, m ≤ n ∧ ∃ k, m = fib k,
    use [1, one_le_of_lt n_ge_2, 1], rw fib_one,
  have F_fib := nat.find_greatest_spec this,
  clear this,
  cases F_fib with l hl,

  have l_gt_1 : l > 1,
  { by_contra h,
    replace h := fib_mono (not_lt.mp h),
    rw [fib_one, ←hl, ←hfibs, ←hF] at h,
    replace h := not_lt.mpr h,
    exact h (succ_le_iff.mp two_le_F) },

  have nF_lt_n : n - F < n,
  { refine nat.sub_lt _ (nat.succ_le_iff.mp (le_of_succ_le two_le_F)),
    exact pos_of_gt n_ge_2 },
  have F_le_n : F ≤ n := nat.find_greatest_le,
  have hnF := hinduct (n - F) nF_lt_n,

  cases hnF with nF0 hnF,
  -- n = F is a Fibonacci number, thus has trivial Zeckendorf representation
  { have n_eq_F : n = F :=
      nat.le_antisymm (nat.le_of_sub_eq_zero nF0) F_le_n,
    clear nF_lt_n nF0,

    use [1, by norm_num, (λ i, l)],
    split,
    { exact trivial_rep_is_zeckendorf _ l_gt_1 },
    { rw fintype.sum_unique, rw [n_eq_F, ←hl] } },

  -- Otherwise, add F to the Zeckendorf representation of n - F
  { rcases hnF with ⟨k, kpos, f, ⟨f0, frest⟩, fsum⟩,
    use [k.succ, succ_pos k,
      λ (i : fin k.succ), if h : ↑i < k then f (i.cast_lt h) else l],
    split,
    -- This is indeed a Zeckendorf representation
    { split,
      { convert f0, dsimp, rw dif_pos, refl },
      { intros m' n' hinductn',
        change n' < m' at hinductn',
        dsimp,
        split_ifs with h1 h2 h3,

        -- n < m < k → use the hypothesis
        { apply frest,
          change n'.cast_lt h2 < m'.cast_lt h1,
          rwa fin.lt_iff_coe_lt_coe at ⊢ hinductn' },

        -- m > n, m < k = n → contradiction
        { exfalso,
          rw fin.lt_iff_coe_lt_coe at hinductn',
          have : ¬↑n' < ↑m' := nat.lt_asymm (nat.lt_of_lt_of_le h1 (not_lt.mp h2)),
          exact this hinductn' },

        -- n < k = m → the interesting case
        { have ha : n-F < fib (l-1),
          { by_contra h,
            replace h := not_lt.mp h,
            rw ←nat.add_le_to_le_sub (fib (l-1)) F_le_n at h,
            rw [hF, hfibs, hl] at h,
            have l_sub_add : l-1+1 = l := nat.sub_add_cancel (le_of_lt l_gt_1),
            conv_lhs at h { congr, skip, rw ←l_sub_add },
            rw ←fib_succ_succ at h,
            change fib (l-1+1).succ ≤ n at h,
            rw (succ_inj'.mpr l_sub_add) at h,

            have contra : fib l.succ ≤ nat.find_greatest fibs n :=
              nat.le_find_greatest h (by use l.succ),
            rw [hfibs, hl, ←nat.sub_add_cancel l_gt_1] at contra,
            replace contra := not_lt_of_le contra,
            exact contra (fib_add_two_strict_mono (lt_add_one (l - 2))) },

          have hb : fib (f (n'.cast_lt h3)) < fib (l-1),
          { suffices h : fib (f (n'.cast_lt h3)) ≤ n - F,
            exact gt_of_gt_of_ge ha h,

            rw ←fsum,
            change (fib ∘ f) (n'.cast_lt h3) ≤ ∑ (i : fin k), (fib ∘ f) i,
            refine finset.single_le_sum _ _,
            { intros i hi_univ,
              change fib (f i) ≥ 0,
              exact zero_le _ },
            apply finset.mem_univ },

          replace hb := fib_inv_strict_mono hb,
          exact lt_tsub_iff_right.mp hb },

        -- m > n, m = k, n = k → contradiction
        { exfalso,
          replace h1 := eq_last_of_not_lt h1,
          replace h3 := eq_last_of_not_lt h3,
          rw fin.lt_iff_coe_lt_coe at hinductn',
          rw [h1, h3] at hinductn',
          exact nat.lt_asymm hinductn' hinductn' } } },

    -- It sums up to n
    { rw [←nat.sub_add_cancel F_le_n, ←fsum, hF, hfibs, hl],
      rw fin.sum_univ_cast_succ,
      dsimp,
      have sum_eq_of_eqs : ∀ (a b c d : ℕ), a = c → b = d → a + b = c + d,
        intros a b c d hac hbd, rw [hac, ←hbd],
      apply sum_eq_of_eqs,
      { refine fintype.sum_equiv (equiv.cast rfl) _ _ _,
        intro x, rw dif_pos, simp, apply fin.is_lt },
      { rw dif_neg, apply irrefl } } }
end


import data.finset

universe u

structure signature : Type (u + 1) :=
  (function : Type u)
  (relation : Type u)
  (farity : function → nat)
  (rarity : relation → nat)

def signature.var (σ : signature) := nat

def signature.nary (σ : signature) (n : ℕ) :=
  subtype {f : σ.function | σ.farity f = n}

def signature.rnary (σ : signature) (n : ℕ) :=
  subtype {r : σ.relation | σ.rarity r = n}

def signature.function.arity {σ : signature} (f : σ.function) :=
  σ.farity f

def signature.relation.arity {σ : signature} (r : σ.relation) :=
  σ.rarity r

----------
-- term --
----------

inductive signature.term (σ : signature)
  | var : σ.var → signature.term
  | func (f : σ.function) (ts : fin (σ.farity f) → signature.term) : signature.term

def signature.term.var_finset {σ : signature} : σ.term → finset σ.var
  | (term.var v) := {v}
  | (term.func f ts) := finset.univ.bUnion (λ i, (ts i).var_finset)

def signature.term.arity {σ : signature} : σ.term → nat
  | (term.var v) := 0
  | (term.func f ts) := f.arity

@[reducible]
def signature.function.input {σ : signature} (f : σ.function) :=
  (fin f.arity) → σ.term

inductive signature.term.position {σ : signature} (t : σ.term)
  | ε : signature.term.position
  | pos (i : fin t.arity) (p : signature.term.position) : signature.term.position

def signature.term.is_ground {σ : signature} : σ.term → Prop
  | (term.var v) := false
  | (term.func f ts) := ∀ i, (ts i).is_ground

def signature.ground_term (σ : signature) :=
  subtype {t : σ.term | t.is_ground}

def signature.term.is_subterm {σ : signature} : σ.term → σ.term → Prop
  | t (term.func f ts) := t = (term.func f ts) ∨ ∃ i, t.is_subterm (ts i)
  | t₁ t₂ := t₁ = t₂

section term_order
  variable σ : signature

inductive less_than_or_equal (a : ℕ) : ℕ → Prop
    | refl : less_than_or_equal a
    | step : Π {b}, less_than_or_equal b → less_than_or_equal (nat.succ b)

  variable f : σ.function
  variable ts : (fin f.arity) → σ.term

  lemma signature.argument_is_subterm : ∀ (i : fin f.arity), (ts i) ≤ (term.func f ts) :=
    begin
      intro i,
      unfold has_le.le,
      right,
      existsi i,
      exact σ.refl_is_subterm (ts i),
    end

end term_order

@[reducible]
def signature.term.subterm {σ : signature} (t : σ.term) :=
  subtype {t' : σ.term | t' ≤ t}

def signature.term.position.next_term {σ : signature} : Π (t : σ.term) (p : t.position), t.subterm
  | (term.func f ts) (position.pos i p') := ⟨(ts i), σ.argument_is_subterm f ts i⟩
  | t p := ⟨t, σ.refl_is_subterm t⟩

def signature.substitution (σ : signature) :=
  σ.var → σ.term

class signature.substitutable (σ : signature) (α : Type u) :=
  (substitute : α → σ.substitution → α)

infix ` ↓ `: 80 := (signature.substitutable.substitute)

-------------
-- formula --
-------------

inductive signature.formula (σ : signature)
  | tt: signature.formula
  | ff : signature.formula
  | neg : signature.formula → signature.formula
  | conj {n : nat} (ngeq : n ≥ 2) (f : (fin n) → signature.formula) : signature.formula
  | disj {n : nat} (ngeq : n ≥ 2) (f : (fin n) → signature.formula) : signature.formula
  | fall (v : nat) (f : signature.formula) : signature.formula
  | xist (v : nat) (f : signature.formula) : signature.formula
  | rel (r : σ.relation) (ts : (fin (σ.rarity r)) → σ.term) : signature.formula

def signature.formula.complement {σ : signature} : σ.formula → σ.formula
  | (formula.neg φ) := φ
  | φ := (formula.neg φ)

def signature.formula.is_subformula {σ : signature} : σ.formula → σ.formula → Prop
  | ψ (formula.neg φ) := (formula.neg φ) = ψ ∨ ψ.is_subformula φ
  | ψ (formula.conj hn Φ) := ψ = (formula.conj hn Φ) ∨ ∃ i, ψ.is_subformula (Φ i)
  | ψ (formula.disj hn Φ) := ψ = (formula.disj hn Φ) ∨ ∃ i, ψ.is_subformula (Φ i)
  | ψ (formula.fall v φ) := ψ = (formula.fall v φ) ∨ ψ.is_subformula φ
  | ψ (formula.xist v φ) := ψ = (formula.xist v φ) ∨ ψ.is_subformula φ
  | φ ψ := φ = ψ

def signature.formula.subformula {σ : signature} (φ : σ.formula) :=
  subtype {ψ : σ.formula | ψ.is_subformula φ}

def signature.literal (σ : signature) :=
  subtype {f : σ.formula | ∃ r ts, f = formula.rel r ts ∨ f = formula.neg (formula.rel r ts)}

def signature.formula.is_free {σ : signature} : σ.formula → σ.var → Prop
  | (formula.neg φ) v := φ.is_free v
  | (formula.conj hn Φ) v := ∀ i, (Φ i).is_free v
  | (formula.disj hn Φ) v := ∀ i, (Φ i).is_free v
  | (formula.fall v' φ) v := v ≠ v' ∧ φ.is_free v
  | (formula.xist v' φ) v := v ≠ v' ∧ φ.is_free v
  | f v := true


/-
Copyright (c) 2018 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel, Johannes Hölzl, Rémy Degenne
-/
import order.filter.cofinite
import order.hom.complete_lattice

/-!
# liminfs and limsups of functions and filters

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

Defines the Liminf/Limsup of a function taking values in a conditionally complete lattice, with
respect to an arbitrary filter.

We define `Limsup f` (`Liminf f`) where `f` is a filter taking values in a conditionally complete
lattice. `Limsup f` is the smallest element `a` such that, eventually, `u ≤ a` (and vice versa for
`Liminf f`). To work with the Limsup along a function `u` use `Limsup (map u f)`.

Usually, one defines the Limsup as `Inf (Sup s)` where the Inf is taken over all sets in the filter.
For instance, in ℕ along a function `u`, this is `Inf_n (Sup_{k ≥ n} u k)` (and the latter quantity
decreases with `n`, so this is in fact a limit.). There is however a difficulty: it is well possible
that `u` is not bounded on the whole space, only eventually (think of `Limsup (λx, 1/x)` on ℝ. Then
there is no guarantee that the quantity above really decreases (the value of the `Sup` beforehand is
not really well defined, as one can not use ∞), so that the Inf could be anything. So one can not
use this `Inf Sup ...` definition in conditionally complete lattices, and one has to use a less
tractable definition.

In conditionally complete lattices, the definition is only useful for filters which are eventually
bounded above (otherwise, the Limsup would morally be +∞, which does not belong to the space) and
which are frequently bounded below (otherwise, the Limsup would morally be -∞, which is not in the
space either). We start with definitions of these concepts for arbitrary filters, before turning to
the definitions of Limsup and Liminf.

In complete lattices, however, it coincides with the `Inf Sup` definition.
-/

open filter set
open_locale filter

variables {α β γ ι : Type*}
namespace filter

section relation

/-- `f.is_bounded (≺)`: the filter `f` is eventually bounded w.r.t. the relation `≺`, i.e.
eventually, it is bounded by some uniform bound.
`r` will be usually instantiated with `≤` or `≥`. -/
def is_bounded (r : α → α → Prop) (f : filter α) := ∃ b, ∀ᶠ x in f, r x b

/-- `f.is_bounded_under (≺) u`: the image of the filter `f` under `u` is eventually bounded w.r.t.
the relation `≺`, i.e. eventually, it is bounded by some uniform bound. -/
def is_bounded_under (r : α → α → Prop) (f : filter β) (u : β → α) := (map u f).is_bounded r

variables {r : α → α → Prop} {f g : filter α}

/-- `f` is eventually bounded if and only if, there exists an admissible set on which it is
bounded. -/
lemma is_bounded_iff : f.is_bounded r ↔ (∃s∈f.sets, ∃b, s ⊆ {x | r x b}) :=
iff.intro
  (assume ⟨b, hb⟩, ⟨{a | r a b}, hb, b, subset.refl _⟩)
  (assume ⟨s, hs, b, hb⟩, ⟨b, mem_of_superset hs hb⟩)

/-- A bounded function `u` is in particular eventually bounded. -/
lemma is_bounded_under_of {f : filter β} {u : β → α} :
  (∃b, ∀x, r (u x) b) → f.is_bounded_under r u
| ⟨b, hb⟩ := ⟨b, show ∀ᶠ x in f, r (u x) b, from eventually_of_forall hb⟩

lemma is_bounded_bot : is_bounded r ⊥ ↔ nonempty α :=
by simp [is_bounded, exists_true_iff_nonempty]

lemma is_bounded_top : is_bounded r ⊤ ↔ (∃t, ∀x, r x t) :=
by simp [is_bounded, eq_univ_iff_forall]

lemma is_bounded_principal (s : set α) : is_bounded r (𝓟 s) ↔ (∃t, ∀x∈s, r x t) :=
by simp [is_bounded, subset_def]

lemma is_bounded_sup [is_trans α r] (hr : ∀b₁ b₂, ∃b, r b₁ b ∧ r b₂ b) :
  is_bounded r f → is_bounded r g → is_bounded r (f ⊔ g)
| ⟨b₁, h₁⟩ ⟨b₂, h₂⟩ := let ⟨b, rb₁b, rb₂b⟩ := hr b₁ b₂ in
  ⟨b, eventually_sup.mpr ⟨h₁.mono (λ x h, trans h rb₁b), h₂.mono (λ x h, trans h rb₂b)⟩⟩

lemma is_bounded.mono (h : f ≤ g) : is_bounded r g → is_bounded r f
| ⟨b, hb⟩ := ⟨b, h hb⟩

lemma is_bounded_under.mono {f g : filter β} {u : β → α} (h : f ≤ g) :
  g.is_bounded_under r u → f.is_bounded_under r u :=
λ hg, hg.mono (map_mono h)

lemma is_bounded_under.mono_le [preorder β] {l : filter α} {u v : α → β}
  (hu : is_bounded_under (≤) l u) (hv : v ≤ᶠ[l] u) : is_bounded_under (≤) l v :=
hu.imp $ λ b hb, (eventually_map.1 hb).mp $ hv.mono $ λ x, le_trans

lemma is_bounded_under.mono_ge [preorder β] {l : filter α} {u v : α → β}
  (hu : is_bounded_under (≥) l u) (hv : u ≤ᶠ[l] v) : is_bounded_under (≥) l v :=
@is_bounded_under.mono_le α βᵒᵈ _ _ _ _ hu hv

lemma is_bounded_under_const [is_refl α r] {l : filter β} {a : α} : is_bounded_under r l (λ _, a) :=
⟨a, eventually_map.2 $ eventually_of_forall $ λ _, refl _⟩

lemma is_bounded.is_bounded_under {q : β → β → Prop} {u : α → β}
  (hf : ∀a₀ a₁, r a₀ a₁ → q (u a₀) (u a₁)) : f.is_bounded r → f.is_bounded_under q u
| ⟨b, h⟩ := ⟨u b, show ∀ᶠ x in f, q (u x) (u b), from h.mono (λ x, hf x b)⟩

lemma not_is_bounded_under_of_tendsto_at_top [preorder β] [no_max_order β] {f : α → β}
  {l : filter α} [l.ne_bot] (hf : tendsto f l at_top) :
  ¬ is_bounded_under (≤) l f :=
begin
  rintro ⟨b, hb⟩,
  rw eventually_map at hb,
  obtain ⟨b', h⟩ := exists_gt b,
  have hb' := (tendsto_at_top.mp hf) b',
  have : {x : α | f x ≤ b} ∩ {x : α | b' ≤ f x} = ∅ :=
    eq_empty_of_subset_empty (λ x hx, (not_le_of_lt h) (le_trans hx.2 hx.1)),
  exact (nonempty_of_mem (hb.and hb')).ne_empty this
end

lemma not_is_bounded_under_of_tendsto_at_bot [preorder β] [no_min_order β] {f : α → β}
  {l : filter α} [l.ne_bot](hf : tendsto f l at_bot) :
  ¬ is_bounded_under (≥) l f :=
@not_is_bounded_under_of_tendsto_at_top α βᵒᵈ _ _ _ _ _ hf

lemma is_bounded_under.bdd_above_range_of_cofinite [semilattice_sup β] {f : α → β}
  (hf : is_bounded_under (≤) cofinite f) : bdd_above (range f) :=
begin
  rcases hf with ⟨b, hb⟩,
  haveI : nonempty β := ⟨b⟩,
  rw [← image_univ, ← union_compl_self {x | f x ≤ b}, image_union, bdd_above_union],
  exact ⟨⟨b, ball_image_iff.2 $ λ x, id⟩, (hb.image f).bdd_above⟩
end

lemma is_bounded_under.bdd_below_range_of_cofinite [semilattice_inf β] {f : α → β}
  (hf : is_bounded_under (≥) cofinite f) : bdd_below (range f) :=
@is_bounded_under.bdd_above_range_of_cofinite α βᵒᵈ _ _ hf

lemma is_bounded_under.bdd_above_range [semilattice_sup β] {f : ℕ → β}
  (hf : is_bounded_under (≤) at_top f) : bdd_above (range f) :=
by { rw ← nat.cofinite_eq_at_top at hf, exact hf.bdd_above_range_of_cofinite }

lemma is_bounded_under.bdd_below_range [semilattice_inf β] {f : ℕ → β}
  (hf : is_bounded_under (≥) at_top f) : bdd_below (range f) :=
@is_bounded_under.bdd_above_range βᵒᵈ _ _ hf

/-- `is_cobounded (≺) f` states that the filter `f` does not tend to infinity w.r.t. `≺`. This is
also called frequently bounded. Will be usually instantiated with `≤` or `≥`.

There is a subtlety in this definition: we want `f.is_cobounded` to hold for any `f` in the case of
complete lattices. This will be relevant to deduce theorems on complete lattices from their
versions on conditionally complete lattices with additional assumptions. We have to be careful in
the edge case of the trivial filter containing the empty set: the other natural definition
  `¬ ∀ a, ∀ᶠ n in f, a ≤ n`
would not work as well in this case.
-/
def is_cobounded (r : α → α → Prop) (f : filter α) := ∃b, ∀a, (∀ᶠ x in f, r x a) → r b a

/-- `is_cobounded_under (≺) f u` states that the image of the filter `f` under the map `u` does not
tend to infinity w.r.t. `≺`. This is also called frequently bounded. Will be usually instantiated
with `≤` or `≥`. -/
def is_cobounded_under (r : α → α → Prop) (f : filter β) (u : β → α) := (map u f).is_cobounded r

/-- To check that a filter is frequently bounded, it suffices to have a witness
which bounds `f` at some point for every admissible set.

This is only an implication, as the other direction is wrong for the trivial filter.-/
lemma is_cobounded.mk [is_trans α r] (a : α) (h : ∀s∈f, ∃x∈s, r a x) : f.is_cobounded r :=
⟨a, assume y s, let ⟨x, h₁, h₂⟩ := h _ s in trans h₂ h₁⟩

/-- A filter which is eventually bounded is in particular frequently bounded (in the opposite
direction). At least if the filter is not trivial. -/
lemma is_bounded.is_cobounded_flip [is_trans α r] [ne_bot f] :
  f.is_bounded r → f.is_cobounded (flip r)
| ⟨a, ha⟩ := ⟨a, assume b hb,
  let ⟨x, rxa, rbx⟩ := (ha.and hb).exists in
  show r b a, from trans rbx rxa⟩

lemma is_bounded.is_cobounded_ge [preorder α] [ne_bot f] (h : f.is_bounded (≤)) :
  f.is_cobounded (≥) :=
h.is_cobounded_flip

lemma is_bounded.is_cobounded_le [preorder α] [ne_bot f] (h : f.is_bounded (≥)) :
  f.is_cobounded (≤) :=
h.is_cobounded_flip

lemma is_cobounded_bot : is_cobounded r ⊥ ↔ (∃b, ∀x, r b x) :=
by simp [is_cobounded]

lemma is_cobounded_top : is_cobounded r ⊤ ↔ nonempty α :=
by simp [is_cobounded, eq_univ_iff_forall, exists_true_iff_nonempty] {contextual := tt}

lemma is_cobounded_principal (s : set α) :
  (𝓟 s).is_cobounded r ↔ (∃b, ∀a, (∀x∈s, r x a) → r b a) :=
by simp [is_cobounded, subset_def]

lemma is_cobounded.mono (h : f ≤ g) : f.is_cobounded r → g.is_cobounded r
| ⟨b, hb⟩ := ⟨b, assume a ha, hb a (h ha)⟩

end relation

lemma is_cobounded_le_of_bot [preorder α] [order_bot α] {f : filter α} : f.is_cobounded (≤) :=
⟨⊥, assume a h, bot_le⟩

lemma is_cobounded_ge_of_top [preorder α] [order_top α] {f : filter α} : f.is_cobounded (≥) :=
⟨⊤, assume a h, le_top⟩

lemma is_bounded_le_of_top [preorder α] [order_top α] {f : filter α} : f.is_bounded (≤) :=
⟨⊤, eventually_of_forall $ λ _, le_top⟩

lemma is_bounded_ge_of_bot [preorder α] [order_bot α] {f : filter α} : f.is_bounded (≥) :=
⟨⊥, eventually_of_forall $ λ _, bot_le⟩

@[simp] lemma _root_.order_iso.is_bounded_under_le_comp [preorder α] [preorder β] (e : α ≃o β)
  {l : filter γ} {u : γ → α} :
  is_bounded_under (≤) l (λ x, e (u x)) ↔ is_bounded_under (≤) l u :=
e.surjective.exists.trans $ exists_congr $ λ a, by simp only [eventually_map, e.le_iff_le]

@[simp] lemma _root_.order_iso.is_bounded_under_ge_comp [preorder α] [preorder β] (e : α ≃o β)
  {l : filter γ} {u : γ → α} :
  is_bounded_under (≥) l (λ x, e (u x)) ↔ is_bounded_under (≥) l u :=
e.dual.is_bounded_under_le_comp

@[simp, to_additive]
lemma is_bounded_under_le_inv [ordered_comm_group α] {l : filter β} {u : β → α} :
  is_bounded_under (≤) l (λ x, (u x)⁻¹) ↔ is_bounded_under (≥) l u :=
(order_iso.inv α).is_bounded_under_ge_comp

@[simp, to_additive]
lemma is_bounded_under_ge_inv [ordered_comm_group α] {l : filter β} {u : β → α} :
  is_bounded_under (≥) l (λ x, (u x)⁻¹) ↔ is_bounded_under (≤) l u :=
(order_iso.inv α).is_bounded_under_le_comp

lemma is_bounded_under.sup [semilattice_sup α] {f : filter β} {u v : β → α} :
  f.is_bounded_under (≤) u → f.is_bounded_under (≤) v → f.is_bounded_under (≤) (λa, u a ⊔ v a)
| ⟨bu, (hu : ∀ᶠ x in f, u x ≤ bu)⟩ ⟨bv, (hv : ∀ᶠ x in f, v x ≤ bv)⟩ :=
  ⟨bu ⊔ bv, show ∀ᶠ x in f, u x ⊔ v x ≤ bu ⊔ bv,
    by filter_upwards [hu, hv] with _ using sup_le_sup⟩

@[simp] lemma is_bounded_under_le_sup [semilattice_sup α] {f : filter β} {u v : β → α} :
  f.is_bounded_under (≤) (λ a, u a ⊔ v a) ↔ f.is_bounded_under (≤) u ∧ f.is_bounded_under (≤) v :=
⟨λ h, ⟨h.mono_le $ eventually_of_forall $ λ _, le_sup_left,
  h.mono_le $ eventually_of_forall $ λ _, le_sup_right⟩, λ h, h.1.sup h.2⟩

lemma is_bounded_under.inf [semilattice_inf α] {f : filter β} {u v : β → α} :
  f.is_bounded_under (≥) u → f.is_bounded_under (≥) v → f.is_bounded_under (≥) (λa, u a ⊓ v a) :=
@is_bounded_under.sup αᵒᵈ β _ _ _ _

@[simp] lemma is_bounded_under_ge_inf [semilattice_inf α] {f : filter β} {u v : β → α} :
  f.is_bounded_under (≥) (λ a, u a ⊓ v a) ↔ f.is_bounded_under (≥) u ∧ f.is_bounded_under (≥) v :=
@is_bounded_under_le_sup αᵒᵈ _ _ _ _ _

lemma is_bounded_under_le_abs [linear_ordered_add_comm_group α] {f : filter β} {u : β → α} :
  f.is_bounded_under (≤) (λ a, |u a|) ↔ f.is_bounded_under (≤) u ∧ f.is_bounded_under (≥) u :=
is_bounded_under_le_sup.trans $ and_congr iff.rfl is_bounded_under_le_neg

/-- Filters are automatically bounded or cobounded in complete lattices. To use the same statements
in complete and conditionally complete lattices but let automation fill automatically the
boundedness proofs in complete lattices, we use the tactic `is_bounded_default` in the statements,
in the form `(hf : f.is_bounded (≥) . is_bounded_default)`. -/
meta def is_bounded_default : tactic unit :=
tactic.applyc ``is_cobounded_le_of_bot <|>
tactic.applyc ``is_cobounded_ge_of_top <|>
tactic.applyc ``is_bounded_le_of_top <|>
tactic.applyc ``is_bounded_ge_of_bot

section conditionally_complete_lattice
variables [conditionally_complete_lattice α]

/-- The `Limsup` of a filter `f` is the infimum of the `a` such that, eventually for `f`,
holds `x ≤ a`. -/
def Limsup (f : filter α) : α := Inf { a | ∀ᶠ n in f, n ≤ a }

/-- The `Liminf` of a filter `f` is the supremum of the `a` such that, eventually for `f`,
holds `x ≥ a`. -/
def Liminf (f : filter α) : α := Sup { a | ∀ᶠ n in f, a ≤ n }

/-- The `limsup` of a function `u` along a filter `f` is the infimum of the `a` such that,
eventually for `f`, holds `u x ≤ a`. -/
def limsup (u : β → α) (f : filter β) : α := Limsup (map u f)

/-- The `liminf` of a function `u` along a filter `f` is the supremum of the `a` such that,
eventually for `f`, holds `u x ≥ a`. -/
def liminf (u : β → α) (f : filter β) : α := Liminf (map u f)

/-- The `blimsup` of a function `u` along a filter `f`, bounded by a predicate `p`, is the infimum
of the `a` such that, eventually for `f`, `u x ≤ a` whenever `p x` holds. -/
def blimsup (u : β → α) (f : filter β) (p : β → Prop) :=
Inf { a | ∀ᶠ x in f, p x → u x ≤ a }

/-- The `bliminf` of a function `u` along a filter `f`, bounded by a predicate `p`, is the supremum
of the `a` such that, eventually for `f`, `a ≤ u x` whenever `p x` holds. -/
def bliminf (u : β → α) (f : filter β) (p : β → Prop) :=
Sup { a | ∀ᶠ x in f, p x → a ≤ u x }

section

variables {f : filter β} {u : β → α} {p : β → Prop}

theorem limsup_eq : limsup u f = Inf { a | ∀ᶠ n in f, u n ≤ a } := rfl

theorem liminf_eq : liminf u f = Sup { a | ∀ᶠ n in f, a ≤ u n } := rfl

theorem blimsup_eq : blimsup u f p = Inf { a | ∀ᶠ x in f, p x → u x ≤ a } := rfl

theorem bliminf_eq : bliminf u f p = Sup { a | ∀ᶠ x in f, p x → a ≤ u x } := rfl

end

@[simp] lemma blimsup_true (f : filter β) (u : β → α) :
  blimsup u f (λ x, true) = limsup u f :=
by simp [blimsup_eq, limsup_eq]

@[simp] lemma bliminf_true (f : filter β) (u : β → α) :
  bliminf u f (λ x, true) = liminf u f :=
by simp [bliminf_eq, liminf_eq]

lemma blimsup_eq_limsup_subtype {f : filter β} {u : β → α} {p : β → Prop} :
  blimsup u f p = limsup (u ∘ (coe : {x | p x} → β)) (comap coe f) :=
begin
  simp only [blimsup_eq, limsup_eq, function.comp_app, eventually_comap, set_coe.forall,
    subtype.coe_mk, mem_set_of_eq],
  congr,
  ext a,
  exact eventually_congr (eventually_of_forall
    (λ x, ⟨λ hx y hy hxy, hxy.symm ▸ (hx (hxy ▸ hy)), λ hx hx', hx x hx' rfl⟩)),
end

lemma bliminf_eq_liminf_subtype {f : filter β} {u : β → α} {p : β → Prop} :
  bliminf u f p = liminf (u ∘ (coe : {x | p x} → β)) (comap coe f) :=
@blimsup_eq_limsup_subtype αᵒᵈ β _ f u p

theorem Limsup_le_of_le {f : filter α} {a}
  (hf : f.is_cobounded (≤) . is_bounded_default) (h : ∀ᶠ n in f, n ≤ a) : Limsup f ≤ a :=
cInf_le hf h

theorem le_Liminf_of_le {f : filter α} {a}
  (hf : f.is_cobounded (≥) . is_bounded_default) (h : ∀ᶠ n in f, a ≤ n) : a ≤ Liminf f :=
le_cSup hf h

theorem limsup_le_of_le {f : filter β} {u : β → α} {a}
  (hf : f.is_cobounded_under (≤) u . is_bounded_default) (h : ∀ᶠ n in f, u n ≤ a) :
  limsup u f ≤ a :=
cInf_le hf h

theorem le_liminf_of_le {f : filter β} {u : β → α} {a}
  (hf : f.is_cobounded_under (≥) u . is_bounded_default) (h : ∀ᶠ n in f, a ≤ u n) :
    a ≤ liminf u f :=
le_cSup hf h

theorem le_Limsup_of_le {f : filter α} {a}
  (hf : f.is_bounded (≤) . is_bounded_default) (h : ∀ b, (∀ᶠ n in f, n ≤ b) → a ≤ b) :
  a ≤ Limsup f :=
le_cInf hf h

theorem Liminf_le_of_le {f : filter α} {a}
  (hf : f.is_bounded (≥) . is_bounded_default) (h : ∀ b, (∀ᶠ n in f, b ≤ n) → b ≤ a) :
  Liminf f ≤ a :=
cSup_le hf h

theorem le_limsup_of_le {f : filter β} {u : β → α} {a}
  (hf : f.is_bounded_under (≤) u . is_bounded_default) (h : ∀ b, (∀ᶠ n in f, u n ≤ b) → a ≤ b) :
  a ≤ limsup u f :=
le_cInf hf h

theorem liminf_le_of_le {f : filter β} {u : β → α} {a}
  (hf : f.is_bounded_under (≥) u . is_bounded_default) (h : ∀ b, (∀ᶠ n in f, b ≤ u n) → b ≤ a) :
  liminf u f ≤ a :=
cSup_le hf h

theorem Liminf_le_Limsup {f : filter α} [ne_bot f]
  (h₁ : f.is_bounded (≤) . is_bounded_default) (h₂ : f.is_bounded (≥) . is_bounded_default) :
  Liminf f ≤ Limsup f :=
Liminf_le_of_le h₂ $ assume a₀ ha₀, le_Limsup_of_le h₁ $ assume a₁ ha₁,
  show a₀ ≤ a₁, from let ⟨b, hb₀, hb₁⟩ := (ha₀.and ha₁).exists in le_trans hb₀ hb₁

lemma liminf_le_limsup {f : filter β} [ne_bot f] {u : β → α}
  (h : f.is_bounded_under (≤) u . is_bounded_default)
  (h' : f.is_bounded_under (≥) u . is_bounded_default) :
  liminf u f ≤ limsup u f :=
Liminf_le_Limsup h h'

lemma Limsup_le_Limsup {f g : filter α}
  (hf : f.is_cobounded (≤) . is_bounded_default) (hg : g.is_bounded (≤) . is_bounded_default)
  (h : ∀ a, (∀ᶠ n in g, n ≤ a) → ∀ᶠ n in f, n ≤ a) : Limsup f ≤ Limsup g :=
cInf_le_cInf hf hg h

lemma Liminf_le_Liminf {f g : filter α}
  (hf : f.is_bounded (≥) . is_bounded_default) (hg : g.is_cobounded (≥) . is_bounded_default)
  (h : ∀ a, (∀ᶠ n in f, a ≤ n) → ∀ᶠ n in g, a ≤ n) : Liminf f ≤ Liminf g :=
cSup_le_cSup hg hf h

lemma limsup_le_limsup {α : Type*} [conditionally_complete_lattice β] {f : filter α} {u v : α → β}
  (h : u ≤ᶠ[f] v)
  (hu : f.is_cobounded_under (≤) u . is_bounded_default)
  (hv : f.is_bounded_under (≤) v . is_bounded_default) :
  limsup u f ≤ limsup v f :=
Limsup_le_Limsup hu hv $ assume b, h.trans

lemma liminf_le_liminf {α : Type*} [conditionally_complete_lattice β] {f : filter α} {u v : α → β}
  (h : ∀ᶠ a in f, u a ≤ v a)
  (hu : f.is_bounded_under (≥) u . is_bounded_default)
  (hv : f.is_cobounded_under (≥) v . is_bounded_default) :
  liminf u f ≤ liminf v f :=
@limsup_le_limsup βᵒᵈ α _ _ _ _ h hv hu

lemma Limsup_le_Limsup_of_le {f g : filter α} (h : f ≤ g)
  (hf : f.is_cobounded (≤) . is_bounded_default) (hg : g.is_bounded (≤) . is_bounded_default) :
  Limsup f ≤ Limsup g :=
Limsup_le_Limsup hf hg (assume a ha, h ha)

lemma Liminf_le_Liminf_of_le {f g : filter α} (h : g ≤ f)
  (hf : f.is_bounded (≥) . is_bounded_default) (hg : g.is_cobounded (≥) . is_bounded_default) :
  Liminf f ≤ Liminf g :=
Liminf_le_Liminf hf hg (assume a ha, h ha)

lemma limsup_le_limsup_of_le {α β} [conditionally_complete_lattice β] {f g : filter α} (h : f ≤ g)
  {u : α → β} (hf : f.is_cobounded_under (≤) u . is_bounded_default)
  (hg : g.is_bounded_under (≤) u . is_bounded_default) :
  limsup u f ≤ limsup u g :=
Limsup_le_Limsup_of_le (map_mono h) hf hg

lemma liminf_le_liminf_of_le {α β} [conditionally_complete_lattice β] {f g : filter α} (h : g ≤ f)
  {u : α → β} (hf : f.is_bounded_under (≥) u . is_bounded_default)
  (hg : g.is_cobounded_under (≥) u . is_bounded_default) :
  liminf u f ≤ liminf u g :=
Liminf_le_Liminf_of_le (map_mono h) hf hg

theorem Limsup_principal {s : set α} (h : bdd_above s) (hs : s.nonempty) :
  Limsup (𝓟 s) = Sup s :=
by simp [Limsup]; exact cInf_upper_bounds_eq_cSup h hs

theorem Liminf_principal {s : set α} (h : bdd_below s) (hs : s.nonempty) :
  Liminf (𝓟 s) = Inf s :=
@Limsup_principal αᵒᵈ _ s h hs

lemma limsup_congr {α : Type*} [conditionally_complete_lattice β] {f : filter α} {u v : α → β}
  (h : ∀ᶠ a in f, u a = v a) : limsup u f = limsup v f :=
begin
  rw limsup_eq,
  congr' with b,
  exact eventually_congr (h.mono $ λ x hx, by simp [hx])
end

lemma blimsup_congr {f : filter β} {u v : β → α} {p : β → Prop} (h : ∀ᶠ a in f, p a → u a = v a) :
  blimsup u f p = blimsup v f p :=
begin
  rw blimsup_eq,
  congr' with b,
  refine eventually_congr (h.mono $ λ x hx, ⟨λ h₁ h₂, _, λ h₁ h₂, _⟩),
  { rw ← hx h₂, exact h₁ h₂, },
  { rw hx h₂, exact h₁ h₂, },
end

lemma bliminf_congr {f : filter β} {u v : β → α} {p : β → Prop} (h : ∀ᶠ a in f, p a → u a = v a) :
  bliminf u f p = bliminf v f p :=
@blimsup_congr αᵒᵈ _ _ _ _ _ _ h

lemma liminf_congr {α : Type*} [conditionally_complete_lattice β] {f : filter α} {u v : α → β}
  (h : ∀ᶠ a in f, u a = v a) : liminf u f = liminf v f :=
@limsup_congr βᵒᵈ _ _ _ _ _ h

lemma limsup_const {α : Type*} [conditionally_complete_lattice β] {f : filter α} [ne_bot f]
  (b : β) : limsup (λ x, b) f = b :=
by simpa only [limsup_eq, eventually_const] using cInf_Ici

lemma liminf_const {α : Type*} [conditionally_complete_lattice β] {f : filter α} [ne_bot f]
  (b : β) : liminf (λ x, b) f = b :=
@limsup_const βᵒᵈ α _ f _ b

end conditionally_complete_lattice

section complete_lattice
variables [complete_lattice α]

@[simp] theorem Limsup_bot : Limsup (⊥ : filter α) = ⊥ :=
bot_unique $ Inf_le $ by simp

@[simp] theorem Liminf_bot : Liminf (⊥ : filter α) = ⊤ :=
top_unique $ le_Sup $ by simp

@[simp] theorem Limsup_top : Limsup (⊤ : filter α) = ⊤ :=
top_unique $ le_Inf $
  by simp [eq_univ_iff_forall]; exact assume b hb, (top_unique $ hb _)

@[simp] theorem Liminf_top : Liminf (⊤ : filter α) = ⊥ :=
bot_unique $ Sup_le $
  by simp [eq_univ_iff_forall]; exact assume b hb, (bot_unique $ hb _)

@[simp] lemma blimsup_false {f : filter β} {u : β → α} :
  blimsup u f (λ x, false) = ⊥ :=
by simp [blimsup_eq]

@[simp] lemma bliminf_false {f : filter β} {u : β → α} :
  bliminf u f (λ x, false) = ⊤ :=
by simp [bliminf_eq]

/-- Same as limsup_const applied to `⊥` but without the `ne_bot f` assumption -/
lemma limsup_const_bot {f : filter β} : limsup (λ x : β, (⊥ : α)) f = (⊥ : α) :=
begin
  rw [limsup_eq, eq_bot_iff],
  exact Inf_le (eventually_of_forall (λ x, le_rfl)),
end

/-- Same as limsup_const applied to `⊤` but without the `ne_bot f` assumption -/
lemma liminf_const_top {f : filter β} : liminf (λ x : β, (⊤ : α)) f = (⊤ : α) :=
@limsup_const_bot αᵒᵈ β _ _

theorem has_basis.Limsup_eq_infi_Sup {ι} {p : ι → Prop} {s} {f : filter α} (h : f.has_basis p s) :
  Limsup f = ⨅ i (hi : p i), Sup (s i) :=
le_antisymm
  (le_infi₂ $ λ i hi, Inf_le $ h.eventually_iff.2 ⟨i, hi, λ x, le_Sup⟩)
  (le_Inf $ assume a ha, let ⟨i, hi, ha⟩ := h.eventually_iff.1 ha in
    infi₂_le_of_le _ hi $ Sup_le ha)

theorem has_basis.Liminf_eq_supr_Inf {p : ι → Prop} {s : ι → set α} {f : filter α}
  (h : f.has_basis p s) : Liminf f = ⨆ i (hi : p i), Inf (s i) :=
@has_basis.Limsup_eq_infi_Sup αᵒᵈ _ _ _ _ _ h

theorem Limsup_eq_infi_Sup {f : filter α} : Limsup f = ⨅ s ∈ f, Sup s :=
f.basis_sets.Limsup_eq_infi_Sup

theorem Liminf_eq_supr_Inf {f : filter α} : Liminf f = ⨆ s ∈ f, Inf s :=
@Limsup_eq_infi_Sup αᵒᵈ _ _

theorem limsup_le_supr {f : filter β} {u : β → α} : limsup u f ≤ ⨆ n, u n :=
limsup_le_of_le (by is_bounded_default) (eventually_of_forall (le_supr u))

theorem infi_le_liminf {f : filter β} {u : β → α} : (⨅ n, u n) ≤ liminf u f :=
le_liminf_of_le (by is_bounded_default) (eventually_of_forall (infi_le u))

/-- In a complete lattice, the limsup of a function is the infimum over sets `s` in the filter
of the supremum of the function over `s` -/
theorem limsup_eq_infi_supr {f : filter β} {u : β → α} : limsup u f = ⨅ s ∈ f, ⨆ a ∈ s, u a :=
(f.basis_sets.map u).Limsup_eq_infi_Sup.trans $
  by simp only [Sup_image, id]

lemma limsup_eq_infi_supr_of_nat {u : ℕ → α} : limsup u at_top = ⨅ n : ℕ, ⨆ i ≥ n, u i :=
(at_top_basis.map u).Limsup_eq_infi_Sup.trans $
  by simp only [Sup_image, infi_const]; refl

lemma limsup_eq_infi_supr_of_nat' {u : ℕ → α} : limsup u at_top = ⨅ n : ℕ, ⨆ i : ℕ, u (i + n) :=
by simp only [limsup_eq_infi_supr_of_nat, supr_ge_eq_supr_nat_add]

theorem has_basis.limsup_eq_infi_supr {p : ι → Prop} {s : ι → set β} {f : filter β} {u : β → α}
  (h : f.has_basis p s) : limsup u f = ⨅ i (hi : p i), ⨆ a ∈ s i, u a :=
(h.map u).Limsup_eq_infi_Sup.trans $ by simp only [Sup_image, id]

lemma blimsup_congr' {f : filter β} {p q : β → Prop} {u : β → α}
  (h : ∀ᶠ x in f, u x ≠ ⊥ → (p x ↔ q x)) :
  blimsup u f p = blimsup u f q :=
begin
  simp only [blimsup_eq],
  congr,
  ext a,
  refine eventually_congr (h.mono $ λ b hb, _),
  cases eq_or_ne (u b) ⊥ with hu hu, { simp [hu], },
  rw hb hu,
end

lemma bliminf_congr' {f : filter β} {p q : β → Prop} {u : β → α}
  (h : ∀ᶠ x in f, u x ≠ ⊤ → (p x ↔ q x)) :
  bliminf u f p = bliminf u f q :=
@blimsup_congr' αᵒᵈ β _ _ _ _ _ h

lemma blimsup_eq_infi_bsupr {f : filter β} {p : β → Prop} {u : β → α} :
  blimsup u f p = ⨅ s ∈ f, ⨆ b (hb : p b ∧ b ∈ s), u b :=
begin
  refine le_antisymm (Inf_le_Inf _) (infi_le_iff.mpr $ λ a ha, le_Inf_iff.mpr $ λ a' ha', _),
  { rintros - ⟨s, rfl⟩,
    simp only [mem_set_of_eq, le_infi_iff],
    conv { congr, funext, rw imp.swap, },
    refine eventually_imp_distrib_left.mpr (λ h, eventually_iff_exists_mem.2 ⟨s, h, λ x h₁ h₂, _⟩),
    exact @le_supr₂ α β (λ b, p b ∧ b ∈ s) _ (λ b hb, u b) x ⟨h₂, h₁⟩, },
  { obtain ⟨s, hs, hs'⟩ := eventually_iff_exists_mem.mp ha',
    simp_rw imp.swap at hs',
    exact (le_infi_iff.mp (ha s) hs).trans (by simpa only [supr₂_le_iff, and_imp]), },
end

lemma blimsup_eq_infi_bsupr_of_nat {p : ℕ → Prop} {u : ℕ → α} :
  blimsup u at_top p = ⨅ i, ⨆ j (hj : p j ∧ i ≤ j), u j :=
by simp only [blimsup_eq_limsup_subtype, mem_preimage, mem_Ici, function.comp_app, cinfi_pos,
  supr_subtype, (at_top_basis.comap (coe : {x | p x} → ℕ)).limsup_eq_infi_supr, mem_set_of_eq,
  subtype.coe_mk, supr_and]

/-- In a complete lattice, the liminf of a function is the infimum over sets `s` in the filter
of the supremum of the function over `s` -/
theorem liminf_eq_supr_infi {f : filter β} {u : β → α} : liminf u f = ⨆ s ∈ f, ⨅ a ∈ s, u a :=
@limsup_eq_infi_supr αᵒᵈ β _ _ _

lemma liminf_eq_supr_infi_of_nat {u : ℕ → α} : liminf u at_top = ⨆ n : ℕ, ⨅ i ≥ n, u i :=
@limsup_eq_infi_supr_of_nat αᵒᵈ _ u

lemma liminf_eq_supr_infi_of_nat' {u : ℕ → α} : liminf u at_top = ⨆ n : ℕ, ⨅ i : ℕ, u (i + n) :=
@limsup_eq_infi_supr_of_nat' αᵒᵈ _ _

theorem has_basis.liminf_eq_supr_infi {p : ι → Prop} {s : ι → set β} {f : filter β} {u : β → α}
  (h : f.has_basis p s) : liminf u f = ⨆ i (hi : p i), ⨅ a ∈ s i, u a :=
@has_basis.limsup_eq_infi_supr αᵒᵈ _ _ _ _ _ _ _ h

lemma bliminf_eq_supr_binfi {f : filter β} {p : β → Prop} {u : β → α} :
  bliminf u f p = ⨆ s ∈ f, ⨅ b (hb : p b ∧ b ∈ s), u b :=
@blimsup_eq_infi_bsupr αᵒᵈ β _ f p u

lemma bliminf_eq_supr_binfi_of_nat {p : ℕ → Prop} {u : ℕ → α} :
  bliminf u at_top p = ⨆ i, ⨅ j (hj : p j ∧ i ≤ j), u j :=
@blimsup_eq_infi_bsupr_of_nat αᵒᵈ _ p u

lemma limsup_eq_Inf_Sup {ι R : Type*} (F : filter ι) [complete_lattice R] (a : ι → R) :
  limsup a F = Inf ((λ I, Sup (a '' I)) '' F.sets) :=
begin
  refine le_antisymm _ _,
  { rw limsup_eq,
    refine Inf_le_Inf (λ x hx, _),
    rcases (mem_image _ F.sets x).mp hx with ⟨I, ⟨I_mem_F, hI⟩⟩,
    filter_upwards [I_mem_F] with i hi,
    exact hI ▸ le_Sup (mem_image_of_mem _ hi), },
  { refine le_Inf_iff.mpr (λ b hb, Inf_le_of_le (mem_image_of_mem _ $ filter.mem_sets.mpr hb)
      $ Sup_le _),
    rintros _ ⟨_, h, rfl⟩,
    exact h, },
end

lemma liminf_eq_Sup_Inf {ι R : Type*} (F : filter ι) [complete_lattice R] (a : ι → R) :
  liminf a F = Sup ((λ I, Inf (a '' I)) '' F.sets) :=
@filter.limsup_eq_Inf_Sup ι (order_dual R) _ _ a

@[simp] lemma liminf_nat_add (f : ℕ → α) (k : ℕ) :
  liminf (λ i, f (i + k)) at_top = liminf f at_top :=
by { simp_rw liminf_eq_supr_infi_of_nat, exact supr_infi_ge_nat_add f k }

@[simp] lemma limsup_nat_add (f : ℕ → α) (k : ℕ) :
  limsup (λ i, f (i + k)) at_top = limsup f at_top :=
@liminf_nat_add αᵒᵈ _ f k

lemma liminf_le_of_frequently_le' {α β} [complete_lattice β]
  {f : filter α} {u : α → β} {x : β} (h : ∃ᶠ a in f, u a ≤ x) :
  liminf u f ≤ x :=
begin
  rw liminf_eq,
  refine Sup_le (λ b hb, _),
  have hbx : ∃ᶠ a in f, b ≤ x,
  { revert h,
    rw [←not_imp_not, not_frequently, not_frequently],
    exact λ h, hb.mp (h.mono (λ a hbx hba hax, hbx (hba.trans hax))), },
  exact hbx.exists.some_spec,
end

lemma le_limsup_of_frequently_le' {α β} [complete_lattice β]
  {f : filter α} {u : α → β} {x : β} (h : ∃ᶠ a in f, x ≤ u a) :
  x ≤ limsup u f :=
@liminf_le_of_frequently_le' _ βᵒᵈ _ _ _ _ h

/-- If `f : α → α` is a morphism of complete lattices, then the limsup of its iterates of any
`a : α` is a fixed point. -/
@[simp] lemma complete_lattice_hom.apply_limsup_iterate (f : complete_lattice_hom α α) (a : α) :
  f (limsup (λ n, f^[n] a) at_top) = limsup (λ n, f^[n] a) at_top :=
begin
  rw [limsup_eq_infi_supr_of_nat', map_infi],
  simp_rw [_root_.map_supr, ← function.comp_apply f, ← function.iterate_succ' f, ← nat.add_succ],
  conv_rhs { rw infi_split _ ((<) (0 : ℕ)), },
  simp only [not_lt, le_zero_iff, infi_infi_eq_left, add_zero, infi_nat_gt_zero_eq, left_eq_inf],
  refine (infi_le (λ i, ⨆ j, (f^[j + (i + 1)]) a) 0).trans _,
  simp only [zero_add, function.comp_app, supr_le_iff],
  exact λ i, le_supr (λ i, (f^[i] a)) (i + 1),
end

/-- If `f : α → α` is a morphism of complete lattices, then the liminf of its iterates of any
`a : α` is a fixed point. -/
lemma complete_lattice_hom.apply_liminf_iterate (f : complete_lattice_hom α α) (a : α) :
  f (liminf (λ n, f^[n] a) at_top) = liminf (λ n, f^[n] a) at_top :=
(complete_lattice_hom.dual f).apply_limsup_iterate _
variables {f g : filter β} {p q : β → Prop} {u v : β → α}

lemma blimsup_mono (h : ∀ x, p x → q x) :
  blimsup u f p ≤ blimsup u f q :=
Inf_le_Inf $ λ a ha, ha.mono $ by tauto

lemma bliminf_antitone (h : ∀ x, p x → q x) :
  bliminf u f q ≤ bliminf u f p :=
Sup_le_Sup $ λ a ha, ha.mono $ by tauto

lemma mono_blimsup' (h : ∀ᶠ x in f, p x → u x ≤ v x) :
  blimsup u f p ≤ blimsup v f p :=
Inf_le_Inf $ λ a ha, (ha.and h).mono $ λ x hx hx', (hx.2 hx').trans (hx.1 hx')

lemma mono_blimsup (h : ∀ x, p x → u x ≤ v x) :
  blimsup u f p ≤ blimsup v f p :=
mono_blimsup' $ eventually_of_forall h

lemma mono_bliminf' (h : ∀ᶠ x in f, p x → u x ≤ v x) :
  bliminf u f p ≤ bliminf v f p :=
Sup_le_Sup $ λ a ha, (ha.and h).mono $ λ x hx hx', (hx.1 hx').trans (hx.2 hx')

lemma mono_bliminf (h : ∀ x, p x → u x ≤ v x) :
  bliminf u f p ≤ bliminf v f p :=
mono_bliminf' $ eventually_of_forall h

lemma bliminf_antitone_filter (h : f ≤ g) :
  bliminf u g p ≤ bliminf u f p :=
Sup_le_Sup $ λ a ha, ha.filter_mono h

lemma blimsup_monotone_filter (h : f ≤ g) :
  blimsup u f p ≤ blimsup u g p :=
Inf_le_Inf $ λ a ha, ha.filter_mono h

@[simp] lemma blimsup_and_le_inf :
  blimsup u f (λ x, p x ∧ q x) ≤ blimsup u f p ⊓ blimsup u f q :=
le_inf (blimsup_mono $ by tauto) (blimsup_mono $ by tauto)

@[simp] lemma bliminf_sup_le_and :
  bliminf u f p ⊔ bliminf u f q ≤ bliminf u f (λ x, p x ∧ q x) :=
@blimsup_and_le_inf αᵒᵈ β _ f p q u

/-- See also `filter.blimsup_or_eq_sup`. -/
@[simp] lemma blimsup_sup_le_or :
  blimsup u f p ⊔ blimsup u f q ≤ blimsup u f (λ x, p x ∨ q x) :=
sup_le (blimsup_mono $ by tauto) (blimsup_mono $ by tauto)

/-- See also `filter.bliminf_or_eq_inf`. -/
@[simp] lemma bliminf_or_le_inf :
  bliminf u f (λ x, p x ∨ q x) ≤ bliminf u f p ⊓ bliminf u f q :=
@blimsup_sup_le_or αᵒᵈ β _ f p q u

lemma order_iso.apply_blimsup [complete_lattice γ] (e : α ≃o γ) :
  e (blimsup u f p) = blimsup (e ∘ u) f p :=
begin
  simp only [blimsup_eq, map_Inf, function.comp_app],
  congr,
  ext c,
  obtain ⟨a, rfl⟩ := e.surjective c,
  simp,
end

lemma order_iso.apply_bliminf [complete_lattice γ] (e : α ≃o γ) :
  e (bliminf u f p) = bliminf (e ∘ u) f p :=
@order_iso.apply_blimsup αᵒᵈ β γᵒᵈ _ f p u _ e.dual

lemma Sup_hom.apply_blimsup_le [complete_lattice γ] (g : Sup_hom α γ) :
  g (blimsup u f p) ≤ blimsup (g ∘ u) f p :=
begin
  simp only [blimsup_eq_infi_bsupr],
  refine ((order_hom_class.mono g).map_infi₂_le _).trans _,
  simp only [_root_.map_supr],
end

lemma Inf_hom.le_apply_bliminf [complete_lattice γ] (g : Inf_hom α γ) :
  bliminf (g ∘ u) f p ≤ g (bliminf u f p) :=
@Sup_hom.apply_blimsup_le αᵒᵈ β γᵒᵈ _ f p u _ g.dual

end complete_lattice

section complete_distrib_lattice

variables [complete_distrib_lattice α] {f : filter β} {p q : β → Prop} {u : β → α}

@[simp] lemma blimsup_or_eq_sup :
  blimsup u f (λ x, p x ∨ q x) = blimsup u f p ⊔ blimsup u f q :=
begin
  refine le_antisymm _ blimsup_sup_le_or,
  simp only [blimsup_eq, Inf_sup_eq, sup_Inf_eq, le_infi₂_iff, mem_set_of_eq],
  refine λ a' ha' a ha, Inf_le ((ha.and ha').mono $ λ b h hb, _),
  exact or.elim hb (λ hb, le_sup_of_le_left $ h.1 hb) (λ hb, le_sup_of_le_right $ h.2 hb),
end

@[simp] lemma bliminf_or_eq_inf :
  bliminf u f (λ x, p x ∨ q x) = bliminf u f p ⊓ bliminf u f q :=
@blimsup_or_eq_sup αᵒᵈ β _ f p q u

lemma sup_limsup [ne_bot f] (a : α) :
  a ⊔ limsup u f = limsup (λ x, a ⊔ u x) f :=
begin
  simp only [limsup_eq_infi_supr, supr_sup_eq, sup_binfi_eq],
  congr, ext s, congr, ext hs, congr,
  exact (bsupr_const (nonempty_of_mem hs)).symm,
end

lemma inf_liminf [ne_bot f] (a : α) :
  a ⊓ liminf u f = liminf (λ x, a ⊓ u x) f :=
@sup_limsup αᵒᵈ β _ f _ _ _

lemma sup_liminf (a : α) :
  a ⊔ liminf u f = liminf (λ x, a ⊔ u x) f :=
begin
  simp only [liminf_eq_supr_infi],
  rw [sup_comm, bsupr_sup (⟨univ, univ_mem⟩ : ∃ (i : set β), i ∈ f)],
  simp_rw [binfi_sup_eq, @sup_comm _ _ a],
end

lemma inf_limsup (a : α) :
  a ⊓ limsup u f = limsup (λ x, a ⊓ u x) f :=
@sup_liminf αᵒᵈ β _ f _ _

end complete_distrib_lattice

section complete_boolean_algebra

variables [complete_boolean_algebra α] (f : filter β) (u : β → α)

lemma limsup_compl :
  (limsup u f)ᶜ = liminf (compl ∘ u) f :=
by simp only [limsup_eq_infi_supr, liminf_eq_supr_infi, compl_infi, compl_supr]

lemma liminf_compl :
  (liminf u f)ᶜ = limsup (compl ∘ u) f :=
by simp only [limsup_eq_infi_supr, liminf_eq_supr_infi, compl_infi, compl_supr]

lemma limsup_sdiff (a : α) :
  (limsup u f) \ a = limsup (λ b, (u b) \ a) f :=
begin
  simp only [limsup_eq_infi_supr, sdiff_eq],
  rw binfi_inf (⟨univ, univ_mem⟩ : ∃ (i : set β), i ∈ f),
  simp_rw [inf_comm, inf_bsupr_eq, inf_comm],
end

lemma liminf_sdiff [ne_bot f] (a : α) :
  (liminf u f) \ a = liminf (λ b, (u b) \ a) f :=
by simp only [sdiff_eq, @inf_comm _ _ _ aᶜ, inf_liminf]

lemma sdiff_limsup [ne_bot f] (a : α) :
  a \ limsup u f = liminf (λ b, a \ u b) f :=
begin
  rw ← compl_inj_iff,
  simp only [sdiff_eq, liminf_compl, (∘), compl_inf, compl_compl, sup_limsup],
end

lemma sdiff_liminf (a : α) :
  a \ liminf u f = limsup (λ b, a \ u b) f :=
begin
  rw ← compl_inj_iff,
  simp only [sdiff_eq, limsup_compl, (∘), compl_inf, compl_compl, sup_liminf],
end

end complete_boolean_algebra

section set_lattice

variables {p : ι → Prop} {s : ι → set α}

lemma cofinite.blimsup_set_eq :
  blimsup s cofinite p = { x | { n | p n ∧ x ∈ s n }.infinite } :=
begin
  simp only [blimsup_eq, le_eq_subset, eventually_cofinite, not_forall, Inf_eq_sInter, exists_prop],
  ext x,
  refine ⟨λ h, _, λ hx t h, _⟩;
  contrapose! h,
  { simp only [mem_sInter, mem_set_of_eq, not_forall, exists_prop],
    exact ⟨{x}ᶜ, by simpa using h, by simp⟩, },
  { exact hx.mono (λ i hi, ⟨hi.1, λ hit, h (hit hi.2)⟩), },
end

lemma cofinite.bliminf_set_eq :
  bliminf s cofinite p = { x | { n | p n ∧ x ∉ s n }.finite } :=
begin
  rw ← compl_inj_iff,
  simpa only [bliminf_eq_supr_binfi, compl_infi, compl_supr, ← blimsup_eq_infi_bsupr,
    cofinite.blimsup_set_eq],
end

/-- In other words, `limsup cofinite s` is the set of elements lying inside the family `s`
infinitely often. -/
lemma cofinite.limsup_set_eq :
  limsup s cofinite = { x | { n | x ∈ s n }.infinite } :=
by simp only [← cofinite.blimsup_true s, cofinite.blimsup_set_eq, true_and]

/-- In other words, `liminf cofinite s` is the set of elements lying outside the family `s`
finitely often. -/
lemma cofinite.liminf_set_eq :
  liminf s cofinite = { x | { n | x ∉ s n }.finite } :=
by simp only [← cofinite.bliminf_true s, cofinite.bliminf_set_eq, true_and]

lemma exists_forall_mem_of_has_basis_mem_blimsup
  {l : filter β} {b : ι → set β} {q : ι → Prop} (hl : l.has_basis q b)
  {u : β → set α} {p : β → Prop} {x : α} (hx : x ∈ blimsup u l p) :
  ∃ f : {i | q i} → β, ∀ i, x ∈ u (f i) ∧ p (f i) ∧ f i ∈ b i :=
begin
  rw blimsup_eq_infi_bsupr at hx,
  simp only [supr_eq_Union, infi_eq_Inter, mem_Inter, mem_Union, exists_prop] at hx,
  choose g hg hg' using hx,
  refine ⟨λ (i : {i | q i}), g (b i) (hl.mem_of_mem i.2), λ i, ⟨_, _⟩⟩,
  { exact hg' (b i) (hl.mem_of_mem i.2), },
  { exact hg (b i) (hl.mem_of_mem i.2), },
end

lemma exists_forall_mem_of_has_basis_mem_blimsup'
  {l : filter β} {b : ι → set β} (hl : l.has_basis (λ _, true) b)
  {u : β → set α} {p : β → Prop} {x : α} (hx : x ∈ blimsup u l p) :
  ∃ f : ι → β, ∀ i, x ∈ u (f i) ∧ p (f i) ∧ f i ∈ b i :=
begin
  obtain ⟨f, hf⟩ := exists_forall_mem_of_has_basis_mem_blimsup hl hx,
  exact ⟨λ i, f ⟨i, trivial⟩, λ i, hf ⟨i, trivial⟩⟩,
end

end set_lattice

section conditionally_complete_linear_order

lemma frequently_lt_of_lt_Limsup {f : filter α} [conditionally_complete_linear_order α] {a : α}
  (hf : f.is_cobounded (≤) . is_bounded_default) (h : a < Limsup f) : ∃ᶠ n in f, a < n :=
begin
  contrapose! h,
  simp only [not_frequently, not_lt] at h,
  exact Limsup_le_of_le hf h,
end

lemma frequently_lt_of_Liminf_lt {f : filter α} [conditionally_complete_linear_order α] {a : α}
  (hf : f.is_cobounded (≥) . is_bounded_default) (h : Liminf f < a) : ∃ᶠ n in f, n < a :=
@frequently_lt_of_lt_Limsup (order_dual α) f _ a hf h

lemma eventually_lt_of_lt_liminf {f : filter α} [conditionally_complete_linear_order β]
  {u : α → β} {b : β} (h : b < liminf u f) (hu : f.is_bounded_under (≥) u . is_bounded_default) :
  ∀ᶠ a in f, b < u a :=
begin
  obtain ⟨c, hc, hbc⟩ : ∃ (c : β) (hc : c ∈ {c : β | ∀ᶠ (n : α) in f, c ≤ u n}), b < c :=
    exists_lt_of_lt_cSup hu h,
  exact hc.mono (λ x hx, lt_of_lt_of_le hbc hx)
end

lemma eventually_lt_of_limsup_lt {f : filter α} [conditionally_complete_linear_order β]
  {u : α → β} {b : β} (h : limsup u f < b) (hu : f.is_bounded_under (≤) u . is_bounded_default) :
  ∀ᶠ a in f, u a < b :=
@eventually_lt_of_lt_liminf _ βᵒᵈ _ _ _ _ h hu

lemma liminf_le_of_frequently_le  {α β} [conditionally_complete_linear_order β] {f : filter α}
  {u : α → β}  {b : β} (hu_le : ∃ᶠ x in f, u x ≤ b)
  (hu : f.is_bounded_under (≥) u . is_bounded_default) :
  liminf u f ≤ b :=
@le_limsup_of_frequently_le _ βᵒᵈ _ f u b hu_le hu

lemma frequently_lt_of_lt_limsup {α β} [conditionally_complete_linear_order β] {f : filter α}
  {u : α → β}  {b : β}
  (hu : f.is_cobounded_under (≤) u . is_bounded_default) (h : b < limsup u f) :
  ∃ᶠ x in f, b < u x :=
begin
  contrapose! h,
  apply Limsup_le_of_le hu,
  simpa using h,
end

lemma frequently_lt_of_liminf_lt {α β} [conditionally_complete_linear_order β] {f : filter α}
  {u : α → β}  {b : β}
  (hu : f.is_cobounded_under (≥) u . is_bounded_default) (h : liminf u f < b) :
  ∃ᶠ x in f, u x < b :=
@frequently_lt_of_lt_limsup _ βᵒᵈ _ f u b hu h

end conditionally_complete_linear_order

end filter

section order
open filter

lemma monotone.is_bounded_under_le_comp [nonempty β] [linear_order β] [preorder γ]
  [no_max_order γ] {g : β → γ} {f : α → β} {l : filter α} (hg : monotone g)
  (hg' : tendsto g at_top at_top) :
  is_bounded_under (≤) l (g ∘ f) ↔ is_bounded_under (≤) l f :=
begin
  refine ⟨_, λ h, h.is_bounded_under hg⟩,
  rintro ⟨c, hc⟩, rw eventually_map at hc,
  obtain ⟨b, hb⟩ : ∃ b, ∀ a ≥ b, c < g a := eventually_at_top.1 (hg'.eventually_gt_at_top c),
  exact ⟨b, hc.mono $ λ x hx, not_lt.1 (λ h, (hb _ h.le).not_le hx)⟩
end

lemma monotone.is_bounded_under_ge_comp [nonempty β] [linear_order β] [preorder γ]
  [no_min_order γ] {g : β → γ} {f : α → β} {l : filter α} (hg : monotone g)
  (hg' : tendsto g at_bot at_bot) :
  is_bounded_under (≥) l (g ∘ f) ↔ is_bounded_under (≥) l f :=
hg.dual.is_bounded_under_le_comp hg'

lemma antitone.is_bounded_under_le_comp [nonempty β] [linear_order β] [preorder γ]
  [no_max_order γ] {g : β → γ} {f : α → β} {l : filter α} (hg : antitone g)
  (hg' : tendsto g at_bot at_top) :
  is_bounded_under (≤) l (g ∘ f) ↔ is_bounded_under (≥) l f :=
hg.dual_right.is_bounded_under_ge_comp hg'

lemma antitone.is_bounded_under_ge_comp [nonempty β] [linear_order β] [preorder γ]
  [no_min_order γ] {g : β → γ} {f : α → β} {l : filter α} (hg : antitone g)
  (hg' : tendsto g at_top at_bot) :
  is_bounded_under (≥) l (g ∘ f) ↔ is_bounded_under (≤) l f :=
hg.dual_right.is_bounded_under_le_comp hg'

lemma galois_connection.l_limsup_le [conditionally_complete_lattice β]
  [conditionally_complete_lattice γ] {f : filter α} {v : α → β}
  {l : β → γ} {u : γ → β} (gc : galois_connection l u)
  (hlv : f.is_bounded_under (≤) (λ x, l (v x)) . is_bounded_default)
  (hv_co : f.is_cobounded_under (≤) v . is_bounded_default) :
  l (limsup v f) ≤ limsup (λ x, l (v x)) f :=
begin
  refine le_Limsup_of_le hlv (λ c hc, _),
  rw filter.eventually_map at hc,
  simp_rw (gc _ _) at hc ⊢,
  exact Limsup_le_of_le hv_co hc,
end

lemma order_iso.limsup_apply {γ} [conditionally_complete_lattice β]
  [conditionally_complete_lattice γ] {f : filter α} {u : α → β} (g : β ≃o γ)
  (hu : f.is_bounded_under (≤) u . is_bounded_default)
  (hu_co : f.is_cobounded_under (≤) u . is_bounded_default)
  (hgu : f.is_bounded_under (≤) (λ x, g (u x)) . is_bounded_default)
  (hgu_co : f.is_cobounded_under (≤) (λ x, g (u x)) . is_bounded_default) :
  g (limsup u f) = limsup (λ x, g (u x)) f :=
begin
  refine le_antisymm (g.to_galois_connection.l_limsup_le hgu hu_co) _,
  rw [←(g.symm.symm_apply_apply $ limsup (λ x, g (u x)) f), g.symm_symm],
  refine g.monotone _,
  have hf : u = λ i, g.symm (g (u i)), from funext (λ i, (g.symm_apply_apply (u i)).symm),
  nth_rewrite 0 hf,
  refine g.symm.to_galois_connection.l_limsup_le _ hgu_co,
  simp_rw g.symm_apply_apply,
  exact hu,
end

lemma order_iso.liminf_apply {γ} [conditionally_complete_lattice β]
  [conditionally_complete_lattice γ] {f : filter α} {u : α → β} (g : β ≃o γ)
  (hu : f.is_bounded_under (≥) u . is_bounded_default)
  (hu_co : f.is_cobounded_under (≥) u . is_bounded_default)
  (hgu : f.is_bounded_under (≥) (λ x, g (u x)) . is_bounded_default)
  (hgu_co : f.is_cobounded_under (≥) (λ x, g (u x)) . is_bounded_default) :
  g (liminf u f) = liminf (λ x, g (u x)) f :=
@order_iso.limsup_apply α βᵒᵈ γᵒᵈ _ _ f u g.dual hu hu_co hgu hgu_co

end order


/-
Copyright (c) 2019 Sébastien Gouëzel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Sébastien Gouëzel
-/
import analysis.convex.basic
import analysis.normed_space.basic
import analysis.specific_limits.basic

/-!
# Tangent cone

In this file, we define two predicates `unique_diff_within_at 𝕜 s x` and `unique_diff_on 𝕜 s`
ensuring that, if a function has two derivatives, then they have to coincide. As a direct
definition of this fact (quantifying on all target types and all functions) would depend on
universes, we use a more intrinsic definition: if all the possible tangent directions to the set
`s` at the point `x` span a dense subset of the whole subset, it is easy to check that the
derivative has to be unique.

Therefore, we introduce the set of all tangent directions, named `tangent_cone_at`,
and express `unique_diff_within_at` and `unique_diff_on` in terms of it.
One should however think of this definition as an implementation detail: the only reason to
introduce the predicates `unique_diff_within_at` and `unique_diff_on` is to ensure the uniqueness
of the derivative. This is why their names reflect their uses, and not how they are defined.

## Implementation details

Note that this file is imported by `fderiv.lean`. Hence, derivatives are not defined yet. The
property of uniqueness of the derivative is therefore proved in `fderiv.lean`, but based on the
properties of the tangent cone we prove here.
-/

variables (𝕜 : Type*) [nondiscrete_normed_field 𝕜]

open filter set
open_locale topological_space

section tangent_cone

variables {E : Type*} [add_comm_monoid E] [module 𝕜 E] [topological_space E]

/-- The set of all tangent directions to the set `s` at the point `x`. -/
def tangent_cone_at (s : set E) (x : E) : set E :=
{y : E | ∃(c : ℕ → 𝕜) (d : ℕ → E), (∀ᶠ n in at_top, x + d n ∈ s) ∧
  (tendsto (λn, ∥c n∥) at_top at_top) ∧ (tendsto (λn, c n • d n) at_top (𝓝 y))}

/-- A property ensuring that the tangent cone to `s` at `x` spans a dense subset of the whole space.
The main role of this property is to ensure that the differential within `s` at `x` is unique,
hence this name. The uniqueness it asserts is proved in `unique_diff_within_at.eq` in `fderiv.lean`.
To avoid pathologies in dimension 0, we also require that `x` belongs to the closure of `s` (which
is automatic when `E` is not `0`-dimensional).
 -/
@[mk_iff] structure unique_diff_within_at (s : set E) (x : E) : Prop :=
(dense_tangent_cone : dense ((submodule.span 𝕜 (tangent_cone_at 𝕜 s x)) : set E))
(mem_closure : x ∈ closure s)

/-- A property ensuring that the tangent cone to `s` at any of its points spans a dense subset of
the whole space.  The main role of this property is to ensure that the differential along `s` is
unique, hence this name. The uniqueness it asserts is proved in `unique_diff_on.eq` in
`fderiv.lean`. -/
def unique_diff_on (s : set E) : Prop :=
∀x ∈ s, unique_diff_within_at 𝕜 s x

end tangent_cone

variables {E : Type*} [normed_group E] [normed_space 𝕜 E]
variables {F : Type*} [normed_group F] [normed_space 𝕜 F]
variables {G : Type*} [normed_group G] [normed_space ℝ G]
variables {𝕜} {x y : E} {s t : set E}

section tangent_cone
/- This section is devoted to the properties of the tangent cone. -/

open normed_field

lemma tangent_cone_univ : tangent_cone_at 𝕜 univ x = univ :=
begin
  refine univ_subset_iff.1 (λy hy, _),
  rcases exists_one_lt_norm 𝕜 with ⟨w, hw⟩,
  refine ⟨λn, w^n, λn, (w^n)⁻¹ • y, univ_mem' (λn, mem_univ _),  _, _⟩,
  { simp only [norm_pow],
    exact tendsto_pow_at_top_at_top_of_one_lt hw },
  { convert tendsto_const_nhds,
    ext n,
    have : w ^ n * (w ^ n)⁻¹ = 1,
    { apply mul_inv_cancel,
      apply pow_ne_zero,
      simpa [norm_eq_zero] using (ne_of_lt (lt_trans zero_lt_one hw)).symm },
    rw [smul_smul, this, one_smul] }
end

lemma tangent_cone_mono (h : s ⊆ t) :
  tangent_cone_at 𝕜 s x ⊆ tangent_cone_at 𝕜 t x :=
begin
  rintros y ⟨c, d, ds, ctop, clim⟩,
  exact ⟨c, d, mem_of_superset ds (λn hn, h hn), ctop, clim⟩
end

/-- Auxiliary lemma ensuring that, under the assumptions defining the tangent cone,
the sequence `d` tends to 0 at infinity. -/
lemma tangent_cone_at.lim_zero {α : Type*} (l : filter α) {c : α → 𝕜} {d : α → E}
  (hc : tendsto (λn, ∥c n∥) l at_top) (hd : tendsto (λn, c n • d n) l (𝓝 y)) :
  tendsto d l (𝓝 0) :=
begin
  have A : tendsto (λn, ∥c n∥⁻¹) l (𝓝 0) := tendsto_inv_at_top_zero.comp hc,
  have B : tendsto (λn, ∥c n • d n∥) l (𝓝 ∥y∥) :=
    (continuous_norm.tendsto _).comp hd,
  have C : tendsto (λn, ∥c n∥⁻¹ * ∥c n • d n∥) l (𝓝 (0 * ∥y∥)) := A.mul B,
  rw zero_mul at C,
  have : ∀ᶠ n in l, ∥c n∥⁻¹ * ∥c n • d n∥ = ∥d n∥,
  { apply (eventually_ne_of_tendsto_norm_at_top hc 0).mono (λn hn, _),
    rw [norm_smul, ← mul_assoc, inv_mul_cancel, one_mul],
    rwa [ne.def, norm_eq_zero] },
  have D : tendsto (λ n, ∥d n∥) l (𝓝 0) :=
    tendsto.congr' this C,
  rw tendsto_zero_iff_norm_tendsto_zero,
  exact D
end

lemma tangent_cone_mono_nhds (h : 𝓝[s] x ≤ 𝓝[t] x) :
  tangent_cone_at 𝕜 s x ⊆ tangent_cone_at 𝕜 t x :=
begin
  rintros y ⟨c, d, ds, ctop, clim⟩,
  refine ⟨c, d, _, ctop, clim⟩,
  suffices : tendsto (λ n, x + d n) at_top (𝓝[t] x),
    from tendsto_principal.1 (tendsto_inf.1 this).2,
  refine (tendsto_inf.2 ⟨_, tendsto_principal.2 ds⟩).mono_right h,
  simpa only [add_zero] using tendsto_const_nhds.add (tangent_cone_at.lim_zero at_top ctop clim)
end

/-- Tangent cone of `s` at `x` depends only on `𝓝[s] x`. -/
lemma tangent_cone_congr (h : 𝓝[s] x = 𝓝[t] x) :
  tangent_cone_at 𝕜 s x = tangent_cone_at 𝕜 t x :=
subset.antisymm
  (tangent_cone_mono_nhds $ le_of_eq h)
  (tangent_cone_mono_nhds $ le_of_eq h.symm)

/-- Intersecting with a neighborhood of the point does not change the tangent cone. -/
lemma tangent_cone_inter_nhds (ht : t ∈ 𝓝 x) :
  tangent_cone_at 𝕜 (s ∩ t) x = tangent_cone_at 𝕜 s x :=
tangent_cone_congr (nhds_within_restrict' _ ht).symm

/-- The tangent cone of a product contains the tangent cone of its left factor. -/
lemma subset_tangent_cone_prod_left {t : set F} {y : F} (ht : y ∈ closure t) :
  linear_map.inl 𝕜 E F '' (tangent_cone_at 𝕜 s x) ⊆ tangent_cone_at 𝕜 (s ×ˢ t) (x, y) :=
begin
  rintros _ ⟨v, ⟨c, d, hd, hc, hy⟩, rfl⟩,
  have : ∀n, ∃d', y + d' ∈ t ∧ ∥c n • d'∥ < ((1:ℝ)/2)^n,
  { assume n,
    rcases mem_closure_iff_nhds.1 ht _ (eventually_nhds_norm_smul_sub_lt (c n) y
      (pow_pos one_half_pos n)) with ⟨z, hz, hzt⟩,
    exact ⟨z - y, by simpa using hzt, by simpa using hz⟩ },
  choose d' hd' using this,
  refine ⟨c, λn, (d n, d' n), _, hc, _⟩,
  show ∀ᶠ n in at_top, (x, y) + (d n, d' n) ∈ s ×ˢ t,
  { filter_upwards [hd] with n hn,
    simp [hn, (hd' n).1] },
  { apply tendsto.prod_mk_nhds hy _,
    refine squeeze_zero_norm (λn, (hd' n).2.le) _,
    exact tendsto_pow_at_top_nhds_0_of_lt_1 one_half_pos.le one_half_lt_one }
end

/-- The tangent cone of a product contains the tangent cone of its right factor. -/
lemma subset_tangent_cone_prod_right {t : set F} {y : F}
  (hs : x ∈ closure s) :
  linear_map.inr 𝕜 E F '' (tangent_cone_at 𝕜 t y) ⊆ tangent_cone_at 𝕜 (s ×ˢ t) (x, y) :=
begin
  rintros _ ⟨w, ⟨c, d, hd, hc, hy⟩, rfl⟩,
  have : ∀n, ∃d', x + d' ∈ s ∧ ∥c n • d'∥ < ((1:ℝ)/2)^n,
  { assume n,
    rcases mem_closure_iff_nhds.1 hs _ (eventually_nhds_norm_smul_sub_lt (c n) x
      (pow_pos one_half_pos n)) with ⟨z, hz, hzs⟩,
    exact ⟨z - x, by simpa using hzs, by simpa using hz⟩ },
  choose d' hd' using this,
  refine ⟨c, λn, (d' n, d n), _, hc, _⟩,
  show ∀ᶠ n in at_top, (x, y) + (d' n, d n) ∈ s ×ˢ t,
  { filter_upwards [hd] with n hn,
    simp [hn, (hd' n).1] },
  { apply tendsto.prod_mk_nhds _ hy,
    refine squeeze_zero_norm (λn, (hd' n).2.le) _,
    exact tendsto_pow_at_top_nhds_0_of_lt_1 one_half_pos.le one_half_lt_one }
end

/-- The tangent cone of a product contains the tangent cone of each factor. -/
lemma maps_to_tangent_cone_pi {ι : Type*} [decidable_eq ι] {E : ι → Type*}
  [Π i, normed_group (E i)] [Π i, normed_space 𝕜 (E i)]
  {s : Π i, set (E i)} {x : Π i, E i} {i : ι} (hi : ∀ j ≠ i, x j ∈ closure (s j)) :
  maps_to (linear_map.single i : E i →ₗ[𝕜] Π j, E j) (tangent_cone_at 𝕜 (s i) (x i))
    (tangent_cone_at 𝕜 (set.pi univ s) x) :=
begin
  rintros w ⟨c, d, hd, hc, hy⟩,
  have : ∀ n (j ≠ i), ∃ d', x j + d' ∈ s j ∧ ∥c n • d'∥ < (1 / 2 : ℝ) ^ n,
  { assume n j hj,
    rcases mem_closure_iff_nhds.1 (hi j hj) _ (eventually_nhds_norm_smul_sub_lt (c n) (x j)
      (pow_pos one_half_pos n)) with ⟨z, hz, hzs⟩,
    exact ⟨z - x j, by simpa using hzs, by simpa using hz⟩ },
  choose! d' hd's hcd',
  refine ⟨c, λ n, function.update (d' n) i (d n), hd.mono (λ n hn j hj', _), hc,
    tendsto_pi_nhds.2 $ λ j, _⟩,
  { rcases em (j = i) with rfl|hj; simp * },
  { rcases em (j = i) with rfl|hj,
    { simp [hy] },
    { suffices : tendsto (λ n, c n • d' n j) at_top (𝓝 0), by simpa [hj],
      refine squeeze_zero_norm (λ n, (hcd' n j hj).le) _,
      exact tendsto_pow_at_top_nhds_0_of_lt_1 one_half_pos.le one_half_lt_one } }
end

/-- If a subset of a real vector space contains a segment, then the direction of this
segment belongs to the tangent cone at its endpoints. -/
lemma mem_tangent_cone_of_segment_subset {s : set G} {x y : G} (h : segment ℝ x y ⊆ s) :
  y - x ∈ tangent_cone_at ℝ s x :=
begin
  let c := λn:ℕ, (2:ℝ)^n,
  let d := λn:ℕ, (c n)⁻¹ • (y-x),
  refine ⟨c, d, filter.univ_mem' (λn, h _), _, _⟩,
  show x + d n ∈ segment ℝ x y,
  { rw segment_eq_image,
    refine ⟨(c n)⁻¹, ⟨_, _⟩, _⟩,
    { rw inv_nonneg, apply pow_nonneg, norm_num },
    { apply inv_le_one, apply one_le_pow_of_one_le, norm_num },
    { simp only [d, sub_smul, smul_sub, one_smul], abel } },
  show filter.tendsto (λ (n : ℕ), ∥c n∥) filter.at_top filter.at_top,
  { have : (λ (n : ℕ), ∥c n∥) = c,
      by { ext n, exact abs_of_nonneg (pow_nonneg (by norm_num) _) },
    rw this,
    exact tendsto_pow_at_top_at_top_of_one_lt (by norm_num) },
  show filter.tendsto (λ (n : ℕ), c n • d n) filter.at_top (𝓝 (y - x)),
  { have : (λ (n : ℕ), c n • d n) = (λn, y - x),
    { ext n,
      simp only [d, smul_smul],
      rw [mul_inv_cancel, one_smul],
      exact pow_ne_zero _ (by norm_num) },
    rw this,
    apply tendsto_const_nhds }
end

end tangent_cone

section unique_diff
/-!
### Properties of `unique_diff_within_at` and `unique_diff_on`

This section is devoted to properties of the predicates
`unique_diff_within_at` and `unique_diff_on`. -/

lemma unique_diff_on.unique_diff_within_at {s : set E} {x} (hs : unique_diff_on 𝕜 s) (h : x ∈ s) :
  unique_diff_within_at 𝕜 s x :=
hs x h

lemma unique_diff_within_at_univ : unique_diff_within_at 𝕜 univ x :=
by { rw [unique_diff_within_at_iff, tangent_cone_univ], simp }

lemma unique_diff_on_univ : unique_diff_on 𝕜 (univ : set E) :=
λx hx, unique_diff_within_at_univ

lemma unique_diff_on_empty : unique_diff_on 𝕜 (∅ : set E) :=
λ x hx, hx.elim

lemma unique_diff_within_at.mono_nhds (h : unique_diff_within_at 𝕜 s x)
  (st : 𝓝[s] x ≤ 𝓝[t] x) :
  unique_diff_within_at 𝕜 t x :=
begin
  simp only [unique_diff_within_at_iff] at *,
  rw [mem_closure_iff_nhds_within_ne_bot] at h ⊢,
  exact ⟨h.1.mono $ submodule.span_mono $ tangent_cone_mono_nhds st,
    h.2.mono st⟩
end

lemma unique_diff_within_at.mono (h : unique_diff_within_at 𝕜 s x) (st : s ⊆ t) :
  unique_diff_within_at 𝕜 t x :=
h.mono_nhds $ nhds_within_mono _ st

lemma unique_diff_within_at_congr (st : 𝓝[s] x = 𝓝[t] x) :
  unique_diff_within_at 𝕜 s x ↔ unique_diff_within_at 𝕜 t x :=
⟨λ h, h.mono_nhds $ le_of_eq st, λ h, h.mono_nhds $ le_of_eq st.symm⟩

lemma unique_diff_within_at_inter (ht : t ∈ 𝓝 x) :
  unique_diff_within_at 𝕜 (s ∩ t) x ↔ unique_diff_within_at 𝕜 s x :=
unique_diff_within_at_congr $ (nhds_within_restrict' _ ht).symm

lemma unique_diff_within_at.inter (hs : unique_diff_within_at 𝕜 s x) (ht : t ∈ 𝓝 x) :
  unique_diff_within_at 𝕜 (s ∩ t) x :=
(unique_diff_within_at_inter ht).2 hs

lemma unique_diff_within_at_inter' (ht : t ∈ 𝓝[s] x) :
  unique_diff_within_at 𝕜 (s ∩ t) x ↔ unique_diff_within_at 𝕜 s x :=
unique_diff_within_at_congr $ (nhds_within_restrict'' _ ht).symm

lemma unique_diff_within_at.inter' (hs : unique_diff_within_at 𝕜 s x) (ht : t ∈ 𝓝[s] x) :
  unique_diff_within_at 𝕜 (s ∩ t) x :=
(unique_diff_within_at_inter' ht).2 hs

lemma unique_diff_within_at_of_mem_nhds (h : s ∈ 𝓝 x) : unique_diff_within_at 𝕜 s x :=
by simpa only [univ_inter] using unique_diff_within_at_univ.inter h

lemma is_open.unique_diff_within_at (hs : is_open s) (xs : x ∈ s) : unique_diff_within_at 𝕜 s x :=
unique_diff_within_at_of_mem_nhds (is_open.mem_nhds hs xs)

lemma unique_diff_on.inter (hs : unique_diff_on 𝕜 s) (ht : is_open t) : unique_diff_on 𝕜 (s ∩ t) :=
λx hx, (hs x hx.1).inter (is_open.mem_nhds ht hx.2)

lemma is_open.unique_diff_on (hs : is_open s) : unique_diff_on 𝕜 s :=
λx hx, is_open.unique_diff_within_at hs hx

/-- The product of two sets of unique differentiability at points `x` and `y` has unique
differentiability at `(x, y)`. -/
lemma unique_diff_within_at.prod {t : set F} {y : F}
  (hs : unique_diff_within_at 𝕜 s x) (ht : unique_diff_within_at 𝕜 t y) :
  unique_diff_within_at 𝕜 (s ×ˢ t) (x, y) :=
begin
  rw [unique_diff_within_at_iff] at ⊢ hs ht,
  rw [closure_prod_eq],
  refine ⟨_, hs.2, ht.2⟩,
  have : _ ≤ submodule.span 𝕜 (tangent_cone_at 𝕜 (s ×ˢ t) (x, y)) :=
    submodule.span_mono (union_subset (subset_tangent_cone_prod_left ht.2)
      (subset_tangent_cone_prod_right hs.2)),
  rw [linear_map.span_inl_union_inr, set_like.le_def] at this,
  exact (hs.1.prod ht.1).mono this
end

lemma unique_diff_within_at.univ_pi (ι : Type*) [fintype ι] (E : ι → Type*)
  [Π i, normed_group (E i)] [Π i, normed_space 𝕜 (E i)]
  (s : Π i, set (E i)) (x : Π i, E i) (h : ∀ i, unique_diff_within_at 𝕜 (s i) (x i)) :
  unique_diff_within_at 𝕜 (set.pi univ s) x :=
begin
  classical,
  simp only [unique_diff_within_at_iff, closure_pi_set] at h ⊢,
  refine ⟨(dense_pi univ (λ i _, (h i).1)).mono _, λ i _, (h i).2⟩,
  norm_cast,
  simp only [← submodule.supr_map_single, supr_le_iff, linear_map.map_span, submodule.span_le,
    ← maps_to'],
  exact λ i, (maps_to_tangent_cone_pi $ λ j hj, (h j).2).mono subset.rfl submodule.subset_span
end

lemma unique_diff_within_at.pi (ι : Type*) [fintype ι] (E : ι → Type*)
  [Π i, normed_group (E i)] [Π i, normed_space 𝕜 (E i)]
  (s : Π i, set (E i)) (x : Π i, E i) (I : set ι)
  (h : ∀ i ∈ I, unique_diff_within_at 𝕜 (s i) (x i)) :
  unique_diff_within_at 𝕜 (set.pi I s) x :=
begin
  classical,
  rw [← set.univ_pi_piecewise],
  refine unique_diff_within_at.univ_pi _ _ _ _ (λ i, _),
  by_cases hi : i ∈ I; simp [*, unique_diff_within_at_univ],
end

/-- The product of two sets of unique differentiability is a set of unique differentiability. -/
lemma unique_diff_on.prod {t : set F} (hs : unique_diff_on 𝕜 s) (ht : unique_diff_on 𝕜 t) :
  unique_diff_on 𝕜 (s ×ˢ t) :=
λ ⟨x, y⟩ h, unique_diff_within_at.prod (hs x h.1) (ht y h.2)

/-- The finite product of a family of sets of unique differentiability is a set of unique
differentiability. -/
lemma unique_diff_on.pi (ι : Type*) [fintype ι] (E : ι → Type*)
  [Π i, normed_group (E i)] [Π i, normed_space 𝕜 (E i)]
  (s : Π i, set (E i)) (I : set ι) (h : ∀ i ∈ I, unique_diff_on 𝕜 (s i)) :
  unique_diff_on 𝕜 (set.pi I s) :=
λ x hx, unique_diff_within_at.pi _ _ _ _ _ $ λ i hi, h i hi (x i) (hx i hi)

/-- The finite product of a family of sets of unique differentiability is a set of unique
differentiability. -/
lemma unique_diff_on.univ_pi (ι : Type*) [fintype ι] (E : ι → Type*)
  [Π i, normed_group (E i)] [Π i, normed_space 𝕜 (E i)]
  (s : Π i, set (E i)) (h : ∀ i, unique_diff_on 𝕜 (s i)) :
  unique_diff_on 𝕜 (set.pi univ s) :=
unique_diff_on.pi _ _ _ _ $ λ i _, h i

/-- In a real vector space, a convex set with nonempty interior is a set of unique
differentiability. -/
theorem unique_diff_on_convex {s : set G} (conv : convex ℝ s) (hs : (interior s).nonempty) :
  unique_diff_on ℝ s :=
begin
  assume x xs,
  rcases hs with ⟨y, hy⟩,
  suffices : y - x ∈ interior (tangent_cone_at ℝ s x),
  { refine ⟨dense.of_closure _, subset_closure xs⟩,
    simp [(submodule.span ℝ (tangent_cone_at ℝ s x)).eq_top_of_nonempty_interior'
      ⟨y - x, interior_mono submodule.subset_span this⟩] },
  rw [mem_interior_iff_mem_nhds] at hy ⊢,
  apply mem_of_superset ((is_open_map_sub_right x).image_mem_nhds hy),
  rintros _ ⟨z, zs, rfl⟩,
  exact mem_tangent_cone_of_segment_subset (conv.segment_subset xs zs)
end

lemma unique_diff_on_Ici (a : ℝ) : unique_diff_on ℝ (Ici a) :=
unique_diff_on_convex (convex_Ici a) $ by simp only [interior_Ici, nonempty_Ioi]

lemma unique_diff_on_Iic (a : ℝ) : unique_diff_on ℝ (Iic a) :=
unique_diff_on_convex (convex_Iic a) $ by simp only [interior_Iic, nonempty_Iio]

lemma unique_diff_on_Ioi (a : ℝ) : unique_diff_on ℝ (Ioi a) :=
is_open_Ioi.unique_diff_on

lemma unique_diff_on_Iio (a : ℝ) : unique_diff_on ℝ (Iio a) :=
is_open_Iio.unique_diff_on

lemma unique_diff_on_Icc {a b : ℝ} (hab : a < b) : unique_diff_on ℝ (Icc a b) :=
unique_diff_on_convex (convex_Icc a b) $ by simp only [interior_Icc, nonempty_Ioo, hab]

lemma unique_diff_on_Ico (a b : ℝ) : unique_diff_on ℝ (Ico a b) :=
if hab : a < b
then unique_diff_on_convex (convex_Ico a b) $ by simp only [interior_Ico, nonempty_Ioo, hab]
else by simp only [Ico_eq_empty hab, unique_diff_on_empty]

lemma unique_diff_on_Ioc (a b : ℝ) : unique_diff_on ℝ (Ioc a b) :=
if hab : a < b
then unique_diff_on_convex (convex_Ioc a b) $ by simp only [interior_Ioc, nonempty_Ioo, hab]
else by simp only [Ioc_eq_empty hab, unique_diff_on_empty]

lemma unique_diff_on_Ioo (a b : ℝ) : unique_diff_on ℝ (Ioo a b) :=
is_open_Ioo.unique_diff_on

/-- The real interval `[0, 1]` is a set of unique differentiability. -/
lemma unique_diff_on_Icc_zero_one : unique_diff_on ℝ (Icc (0:ℝ) 1) :=
unique_diff_on_Icc zero_lt_one

end unique_diff