/-
Copyright (c) 2022 Yaël Dillies. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yaël Dillies
-/
import algebra.big_operators.multiset
import data.fun_like.basic

/-!
# Freiman homomorphisms

In this file, we define Freiman homomorphisms. A `n`-Freiman homomorphism on `A` is a function
`f : α → β` such that `f (x₁) * ... * f (xₙ) = f (y₁) * ... * f (yₙ)` for all
`x₁, ..., xₙ, y₁, ..., yₙ ∈ A` such that `x₁ * ... * xₙ = y₁ * ... * yₙ`. In particular, any
`mul_hom` is a Freiman homomorphism.

They are of interest in additive combinatorics.

## Main declaration

* `freiman_hom`: Freiman homomorphism.
* `add_freiman_hom`: Additive Freiman homomorphism.

## Notation

* `A →*[n] β`: Multiplicative `n`-Freiman homomorphism on `A`
* `A →+[n] β`: Additive `n`-Freiman homomorphism on `A`

## Implementation notes

In the context of combinatorics, we are interested in Freiman homomorphisms over sets which are not
necessarily closed under addition/multiplication. This means we must parametrize them with a set in
an `add_monoid`/`monoid` instead of the `add_monoid`/`monoid` itself.

## References

[Yufei Zhao, *18.225: Graph Theory and Additive Combinatorics*](https://yufeizhao.com/gtac/)

## TODO

`monoid_hom.to_freiman_hom` could be relaxed to `mul_hom.to_freiman_hom` by proving
`(s.map f).prod = (t.map f).prod` directly by induction instead of going through `f s.prod`.

Define `n`-Freiman isomorphisms.

Affine maps induce Freiman homs. Concretely, provide the `add_freiman_hom_class (α →ₐ[𝕜] β) A β n`
instance.
-/

open multiset

variables {F α β γ δ G : Type*}

/-- An additive `n`-Freiman homomorphism is a map which preserves sums of `n` elements. -/
structure add_freiman_hom (A : set α) (β : Type*) [add_comm_monoid α] [add_comm_monoid β] (n : ℕ) :=
(to_fun : α → β)
(map_sum_eq_map_sum' {s t : multiset α} (hsA : ∀ ⦃x⦄, x ∈ s → x ∈ A) (htA : ∀ ⦃x⦄, x ∈ t → x ∈ A)
  (hs : s.card = n) (ht : t.card = n) (h : s.sum = t.sum) :
  (s.map to_fun).sum = (t.map to_fun).sum)

/-- A `n`-Freiman homomorphism on a set `A` is a map which preserves products of `n` elements. -/
@[to_additive add_freiman_hom]
structure freiman_hom (A : set α) (β : Type*) [comm_monoid α] [comm_monoid β] (n : ℕ) :=
(to_fun : α → β)
(map_prod_eq_map_prod' {s t : multiset α} (hsA : ∀ ⦃x⦄, x ∈ s → x ∈ A) (htA : ∀ ⦃x⦄, x ∈ t → x ∈ A)
  (hs : s.card = n) (ht : t.card = n) (h : s.prod = t.prod) :
  (s.map to_fun).prod = (t.map to_fun).prod)

notation A ` →+[`:25 n:25 `] `:0 β:0 := add_freiman_hom A β n
notation A ` →*[`:25 n:25 `] `:0 β:0 := freiman_hom A β n

/-- `add_freiman_hom_class F s β n` states that `F` is a type of `n`-ary sums-preserving morphisms.
You should extend this class when you extend `add_freiman_hom`. -/
class add_freiman_hom_class (F : Type*) (A : out_param $ set α) (β : out_param $ Type*)
  [add_comm_monoid α] [add_comm_monoid β] (n : ℕ) [fun_like F α (λ _, β)] :=
(map_sum_eq_map_sum' (f : F) {s t : multiset α} (hsA : ∀ ⦃x⦄, x ∈ s → x ∈ A)
  (htA : ∀ ⦃x⦄, x ∈ t → x ∈ A) (hs : s.card = n) (ht : t.card = n) (h : s.sum = t.sum) :
  (s.map f).sum = (t.map f).sum)

/-- `freiman_hom_class F A β n` states that `F` is a type of `n`-ary products-preserving morphisms.
You should extend this class when you extend `freiman_hom`. -/
@[to_additive add_freiman_hom_class
"`add_freiman_hom_class F A β n` states that `F` is a type of `n`-ary sums-preserving morphisms.
You should extend this class when you extend `add_freiman_hom`."]
class freiman_hom_class (F : Type*) (A : out_param $ set α) (β : out_param $ Type*) [comm_monoid α]
  [comm_monoid β] (n : ℕ) [fun_like F α (λ _, β)] :=
(map_prod_eq_map_prod' (f : F) {s t : multiset α} (hsA : ∀ ⦃x⦄, x ∈ s → x ∈ A)
  (htA : ∀ ⦃x⦄, x ∈ t → x ∈ A) (hs : s.card = n) (ht : t.card = n) (h : s.prod = t.prod) :
  (s.map f).prod = (t.map f).prod)

variables [fun_like F α (λ _, β)]

section comm_monoid
variables [comm_monoid α] [comm_monoid β] [comm_monoid γ] [comm_monoid δ] [comm_group G] {A : set α}
  {B : set β} {C : set γ} {n : ℕ}

@[to_additive]
lemma map_prod_eq_map_prod [freiman_hom_class F A β n] (f : F) {s t : multiset α}
  (hsA : ∀ ⦃x⦄, x ∈ s → x ∈ A) (htA : ∀ ⦃x⦄, x ∈ t → x ∈ A) (hs : s.card = n) (ht : t.card = n)
  (h : s.prod = t.prod) :
  (s.map f).prod = (t.map f).prod :=
freiman_hom_class.map_prod_eq_map_prod' f hsA htA hs ht h

namespace freiman_hom

@[to_additive]
instance fun_like : fun_like (A →*[n] β) α (λ _, β) :=
{ coe := to_fun,
  coe_injective' := λ f g h, by cases f; cases g; congr' }

@[to_additive]
instance freiman_hom_class : freiman_hom_class (A →*[n] β) A β n :=
{ map_prod_eq_map_prod' := map_prod_eq_map_prod' }

/-- Helper instance for when there's too many metavariables to apply
`fun_like.has_coe_to_fun` directly. -/
@[to_additive]
instance : has_coe_to_fun (A →*[n] β) (λ _, α → β) := ⟨to_fun⟩

initialize_simps_projections freiman_hom (to_fun → apply)

@[simp, to_additive]
lemma to_fun_eq_coe (f : A →*[n] β) : f.to_fun = f := rfl

@[ext, to_additive]
lemma ext ⦃f g : A →*[n] β⦄ (h : ∀ x, f x = g x) : f = g := fun_like.ext f g h

@[simp, to_additive]
lemma coe_mk (f : α → β) (h : ∀ s t : multiset α, (∀ ⦃x⦄, x ∈ s → x ∈ A) → (∀ ⦃x⦄, x ∈ t → x ∈ A) →
  s.card = n → t.card = n → s.prod = t.prod → (s.map f).prod = (t.map f).prod) :
  ⇑(mk f h) = f := rfl

@[simp, to_additive] lemma mk_coe (f : A →*[n] β) (h) : mk f h = f := ext $ λ _, rfl

/-- The identity map from a commutative monoid to itself. -/
@[to_additive "The identity map from an additive commutative monoid to itself.", simps]
protected def id (A : set α) (n : ℕ) : A →*[n] α  :=
{ to_fun := λ x, x, map_prod_eq_map_prod' := λ s t _ _ _ _ h, by rw [map_id', map_id', h] }

/-- Composition of Freiman homomorphisms as a Freiman homomorphism. -/
@[to_additive "Composition of additive Freiman homomorphisms as an additive Freiman homomorphism."]
protected def comp (f : B →*[n] γ) (g : A →*[n] β) (hAB : A.maps_to g B) : A →*[n] γ :=
{ to_fun := f ∘ g,
  map_prod_eq_map_prod' := λ s t hsA htA hs ht h, begin
    rw [←map_map,
    map_prod_eq_map_prod f _ _ ((s.card_map _).trans hs) ((t.card_map _).trans ht)
      (map_prod_eq_map_prod g hsA htA hs ht h), map_map],
    { simpa using (λ a h, hAB (hsA h)) },
    { simpa using (λ a h, hAB (htA h)) }
  end }

@[simp, to_additive]
lemma coe_comp (f : B →*[n] γ) (g : A →*[n] β) {hfg} : ⇑(f.comp g hfg) = f ∘ g := rfl

@[to_additive]
lemma comp_apply (f : B →*[n] γ) (g : A →*[n] β) {hfg} (x : α) : f.comp g hfg x = f (g x) := rfl

@[to_additive]
lemma comp_assoc (f : A →*[n] β) (g : B →*[n] γ) (h : C →*[n] δ) {hf hhg hgf}
  {hh : A.maps_to (g.comp f hgf) C} :
  (h.comp g hhg).comp f hf = h.comp (g.comp f hgf) hh := rfl

@[to_additive]
lemma cancel_right {g₁ g₂ : B →*[n] γ} {f : A →*[n] β} (hf : function.surjective f) {hg₁ hg₂} :
  g₁.comp f hg₁ = g₂.comp f hg₂ ↔ g₁ = g₂ :=
⟨λ h, ext $ hf.forall.2 $ fun_like.ext_iff.1 h, λ h, h ▸ rfl⟩

@[to_additive]
lemma cancel_right_on {g₁ g₂ : B →*[n] γ} {f : A →*[n] β} (hf : A.surj_on f B) {hf'} :
  A.eq_on (g₁.comp f hf') (g₂.comp f hf') ↔ B.eq_on g₁ g₂ :=
hf.cancel_right hf'

@[to_additive]
lemma cancel_left_on {g : B →*[n] γ} {f₁ f₂ : A →*[n] β} (hg : B.inj_on g) {hf₁ hf₂} :
  A.eq_on (g.comp f₁ hf₁) (g.comp f₂ hf₂) ↔ A.eq_on f₁ f₂ :=
hg.cancel_left hf₁ hf₂

@[simp, to_additive] lemma comp_id (f : A →*[n] β) {hf} : f.comp (freiman_hom.id A n) hf = f :=
ext $ λ x, rfl

@[simp, to_additive] lemma id_comp (f : A →*[n] β) {hf} : (freiman_hom.id B n).comp f hf = f :=
ext $ λ x, rfl

/-- `freiman_hom.const A n b` is the Freiman homomorphism sending everything to `b`. -/
@[to_additive "`add_freiman_hom.const n b` is the Freiman homomorphism sending everything to `b`."]
def const (A : set α) (n : ℕ) (b : β) : A →*[n] β :=
{ to_fun := λ _, b,
  map_prod_eq_map_prod' := λ s t _ _ hs ht _,
    by rw [multiset.map_const, multiset.map_const, prod_repeat, prod_repeat, hs, ht] }

@[simp, to_additive] lemma const_apply (n : ℕ) (b : β) (x : α) : const A n b x = b := rfl

@[simp, to_additive]
lemma const_comp (n : ℕ) (c : γ) (f : A →*[n] β) {hf} : (const B n c).comp f hf = const A n c := rfl

/-- `1` is the Freiman homomorphism sending everything to `1`. -/
@[to_additive "`0` is the Freiman homomorphism sending everything to `0`."]
instance : has_one (A →*[n] β) := ⟨const A n 1⟩

@[simp, to_additive] lemma one_apply (x : α) : (1 : A →*[n] β) x = 1 := rfl

@[simp, to_additive] lemma one_comp (f : A →*[n] β) {hf} : (1 : B →*[n] γ).comp f hf = 1 := rfl

@[to_additive] instance : inhabited (A →*[n] β) := ⟨1⟩

/-- `f * g` is the Freiman homomorphism  sends `x` to `f x * g x`. -/
@[to_additive "`f + g` is the Freiman homomorphism sending `x` to `f x + g x`."]
instance : has_mul (A →*[n] β) :=
⟨λ f g, { to_fun := λ x, f x * g x,
  map_prod_eq_map_prod' := λ s t hsA htA hs ht h,
    by rw [prod_map_mul, prod_map_mul, map_prod_eq_map_prod f hsA htA hs ht h,
           map_prod_eq_map_prod g hsA htA hs ht h] }⟩

@[simp, to_additive] lemma mul_apply (f g : A →*[n] β) (x : α) : (f * g) x = f x * g x := rfl

@[to_additive] lemma mul_comp (g₁ g₂ : B →*[n] γ) (f : A →*[n] β) {hg hg₁ hg₂} :
  (g₁ * g₂).comp f hg = g₁.comp f hg₁ * g₂.comp f hg₂ := rfl

/-- If `f` is a Freiman homomorphism to a commutative group, then `f⁻¹` is the Freiman homomorphism
sending `x` to `(f x)⁻¹`. -/
@[to_additive "If `f` is a Freiman homomorphism to an additive commutative group, then `-f` is the
Freiman homomorphism sending `x` to `-f x`."]
instance : has_inv (A →*[n] G) :=
⟨λ f, { to_fun := λ x, (f x)⁻¹,
  map_prod_eq_map_prod' := λ s t hsA htA hs ht h,
    by rw [prod_map_inv', prod_map_inv', map_prod_eq_map_prod f hsA htA hs ht h] }⟩

@[simp, to_additive] lemma inv_apply (f : A →*[n] G) (x : α) : f⁻¹ x = (f x)⁻¹ := rfl

@[simp, to_additive] lemma inv_comp (f : B →*[n] G) (g : A →*[n] β) {hf hf'} :
  f⁻¹.comp g hf = (f.comp g hf')⁻¹ :=
ext $ λ x, rfl

/-- If `f` and `g` are Freiman homomorphisms to a commutative group, then `f / g` is the Freiman
homomorphism sending `x` to `f x / g x`. -/
@[to_additive "If `f` and `g` are additive Freiman homomorphisms to an additive commutative group,
then `f - g` is the additive Freiman homomorphism sending `x` to `f x - g x`"]
instance : has_div (A →*[n] G) :=
⟨λ f g, { to_fun := λ x, f x / g x,
  map_prod_eq_map_prod' := λ s t hsA htA hs ht h,
    by rw [prod_map_div, prod_map_div, map_prod_eq_map_prod f hsA htA hs ht h,
           map_prod_eq_map_prod g hsA htA hs ht h] }⟩

@[simp, to_additive] lemma div_apply (f g : A →*[n] G) (x : α) : (f / g) x = f x / g x := rfl

@[simp, to_additive] lemma div_comp (f₁ f₂ : B →*[n] G) (g : A →*[n] β) {hf hf₁ hf₂} :
  (f₁ / f₂).comp g hf = f₁.comp g hf₁ / f₂.comp g hf₂ :=
ext $ λ x, rfl

/-! ### Instances -/

/-- `A →*[n] β` is a `comm_monoid`. -/
@[to_additive "`α →+[n] β` is an `add_comm_monoid`."]
instance : comm_monoid (A →*[n] β) :=
{ mul := (*),
  mul_assoc := λ a b c, by { ext, apply mul_assoc },
  one := 1,
  one_mul := λ a, by { ext, apply one_mul },
  mul_one := λ a, by { ext, apply mul_one },
  mul_comm :=  λ a b, by { ext, apply mul_comm },
  npow := λ m f,
  { to_fun := λ x, f x ^ m,
    map_prod_eq_map_prod' := λ s t hsA htA hs ht h,
      by rw [prod_map_pow, prod_map_pow, map_prod_eq_map_prod f hsA htA hs ht h] },
  npow_zero' := λ f, by { ext x, exact pow_zero _ },
  npow_succ' := λ n f, by { ext x, exact pow_succ _ _ } }

/-- If `β` is a commutative group, then `A →*[n] β` is a commutative group too. -/
@[to_additive "If `β` is an additive commutative group, then `A →*[n] β` is an additive commutative
group too."]
instance {β} [comm_group β] : comm_group (A →*[n] β) :=
{ inv := has_inv.inv,
  div := has_div.div,
  div_eq_mul_inv := by { intros, ext, apply div_eq_mul_inv },
  mul_left_inv := by { intros, ext, apply mul_left_inv },
  zpow := λ n f, { to_fun := λ x, (f x) ^ n,
    map_prod_eq_map_prod' := λ s t hsA htA hs ht h,
      by rw [prod_map_zpow, prod_map_zpow, map_prod_eq_map_prod f hsA htA hs ht h] },
  zpow_zero' := λ f, by { ext x, exact zpow_zero _ },
  zpow_succ' := λ n f, by { ext x, simp_rw [zpow_of_nat, pow_succ, mul_apply, coe_mk] },
  zpow_neg'  := λ n f, by { ext x, simp_rw [zpow_neg_succ_of_nat, zpow_coe_nat], refl },
  ..freiman_hom.comm_monoid }

end freiman_hom

/-! ### Hom hierarchy -/

--TODO: change to `monoid_hom_class F A β → freiman_hom_class F A β n` once `map_multiset_prod` is
-- generalized
/-- A monoid homomorphism is naturally a `freiman_hom` on its entire domain.

We can't leave the domain `A : set α` of the `freiman_hom` a free variable, since it wouldn't be
inferrable. -/
@[to_additive " An additive monoid homomorphism is naturally an `add_freiman_hom` on its entire
domain.

We can't leave the domain `A : set α` of the `freiman_hom` a free variable, since it wouldn't be
inferrable."]
instance monoid_hom.freiman_hom_class : freiman_hom_class (α →* β) set.univ β n :=
{ map_prod_eq_map_prod' := λ f s t _ _ _ _ h, by rw [←f.map_multiset_prod, h, f.map_multiset_prod] }

/-- A `monoid_hom` is naturally a `freiman_hom`. -/
@[to_additive add_monoid_hom.to_add_freiman_hom "An `add_monoid_hom` is naturally an
`add_freiman_hom`"]
def monoid_hom.to_freiman_hom (A : set α) (n : ℕ) (f : α →* β) : A →*[n] β :=
{ to_fun := f,
  map_prod_eq_map_prod' := λ s t hsA htA, map_prod_eq_map_prod f
    (λ _ _, set.mem_univ _) (λ _ _, set.mem_univ _) }

@[simp, to_additive]
lemma monoid_hom.to_freiman_hom_coe (f : α →* β) : (f.to_freiman_hom A n : α → β) = f := rfl

@[to_additive]
lemma monoid_hom.to_freiman_hom_injective :
  function.injective (monoid_hom.to_freiman_hom A n : (α →* β) → A →*[n] β) :=
λ f g h, monoid_hom.ext $ show _, from fun_like.ext_iff.mp h

end comm_monoid

section cancel_comm_monoid
variables [comm_monoid α] [cancel_comm_monoid β] {A : set α} {m n : ℕ}

@[to_additive]
lemma map_prod_eq_map_prod_of_le [freiman_hom_class F A β n] (f : F) {s t : multiset α}
  (hsA : ∀ x ∈ s, x ∈ A) (htA : ∀ x ∈ t, x ∈ A) (hs : s.card = m)
  (ht : t.card = m) (hst : s.prod = t.prod) (h : m ≤ n) :
  (s.map f).prod = (t.map f).prod :=
begin
  obtain rfl | hm := m.eq_zero_or_pos,
  { rw card_eq_zero at hs ht,
    rw [hs, ht] },
  rw [←hs, card_pos_iff_exists_mem] at hm,
  obtain ⟨a, ha⟩ := hm,
  suffices : ((s + repeat a (n - m)).map f).prod = ((t + repeat a (n - m)).map f).prod,
  { simp_rw [multiset.map_add, prod_add] at this,
    exact mul_right_cancel this },
  replace ha := hsA _ ha,
  refine map_prod_eq_map_prod f (λ x hx, _) (λ x hx, _) _ _ _,
  rotate 2, assumption, -- Can't infer `A` and `n` from the context, so do it manually.
  { rw mem_add at hx,
    refine hx.elim (hsA _) (λ h, _),
    rwa eq_of_mem_repeat h },
  { rw mem_add at hx,
    refine hx.elim (htA _) (λ h, _),
    rwa eq_of_mem_repeat h },
  { rw [card_add, hs, card_repeat, add_tsub_cancel_of_le h] },
  { rw [card_add, ht, card_repeat, add_tsub_cancel_of_le h] },
  { rw [prod_add, prod_add, hst] }
end

/-- `α →*[n] β` is naturally included in  `A →*[m] β` for any `m ≤ n`. -/
@[to_additive add_freiman_hom.to_add_freiman_hom "`α →+[n] β` is naturally included in  `α →+[m] β`
for any `m ≤ n`"]
def freiman_hom.to_freiman_hom (h : m ≤ n) (f : A →*[n] β) : A →*[m] β :=
{ to_fun := f,
  map_prod_eq_map_prod' := λ s t hsA htA hs ht hst,
    map_prod_eq_map_prod_of_le f hsA htA hs ht hst h }

/-- A `n`-Freiman homomorphism is also a `m`-Freiman homomorphism for any `m ≤ n`. -/
@[to_additive add_freiman_hom.add_freiman_hom_class_of_le "An additive `n`-Freiman homomorphism is
also an additive `m`-Freiman homomorphism for any `m ≤ n`."]
def freiman_hom.freiman_hom_class_of_le [freiman_hom_class F A β n] (h : m ≤ n) :
  freiman_hom_class F A β m :=
{ map_prod_eq_map_prod' := λ f s t hsA htA hs ht hst,
    map_prod_eq_map_prod_of_le f hsA htA hs ht hst h }

@[simp, to_additive add_freiman_hom.to_add_freiman_hom_coe]
lemma freiman_hom.to_freiman_hom_coe (h : m ≤ n) (f : A →*[n] β) :
  (f.to_freiman_hom h : α → β) = f := rfl

@[to_additive]
lemma freiman_hom.to_freiman_hom_injective (h : m ≤ n) :
  function.injective (freiman_hom.to_freiman_hom h : (A →*[n] β) → A →*[m] β) :=
λ f g hfg, freiman_hom.ext $ by convert fun_like.ext_iff.1 hfg

end cancel_comm_monoid


import ground_zero.HITs.suspension ground_zero.theorems.ua
import ground_zero.types.integers
open ground_zero.types.equiv (subst transport)
open ground_zero.types.eq (renaming refl -> idp)
open ground_zero.structures (hset)
open ground_zero.types

/-
  Circle S¹ as Higher Inductive Type.
  * HoTT 6.4

  π₁(S¹) = ℤ proof.
  * HoTT 8.1
-/

hott theory

namespace ground_zero
namespace HITs

universes u v

notation [parsing_only] `S⁻¹` := empty
notation [parsing_only] `S⁰` := bool

theorem up_dim : ∑S⁻¹ ≃ S⁰ :=
let f : ∑S⁻¹ → S⁰ :=
suspension.rec ff tt (λ e, by induction e) in
let g : S⁰ → ∑S⁻¹ :=
λ b, match b with
  ff := suspension.north
| tt := suspension.south
end in begin
  existsi f, split; existsi g,
  { intro x, simp,
    refine @suspension.ind _
      (λ x, g (f x) = x)
      (by reflexivity)
      (by reflexivity)
      _ x,
    intro u, induction u },
  { intro x, simp, induction x,
    repeat { trivial } }
end

def circle := ∑S⁰
notation `S¹` := circle

namespace circle
  -- https://github.com/leanprover/lean2/blob/master/hott/homotopy/circle.hlean
  def base₁ : S¹ := suspension.north
  def base₂ : S¹ := suspension.south

  def seg₁ : base₁ = base₂ := suspension.merid ff
  def seg₂ : base₁ = base₂ := suspension.merid tt

  def ind₂ {β : S¹ → Type u} (b₁ : β base₁) (b₂ : β base₂)
    (ℓ₁ : b₁ =[seg₁] b₂)
    (ℓ₂ : b₁ =[seg₂] b₂) : Π (x : S¹), β x :=
  suspension.ind b₁ b₂ (begin
    intro x, induction x,
    exact ℓ₁, exact ℓ₂
  end)

  def base : S¹ := base₁
  def loop : base = base := seg₂ ⬝ seg₁⁻¹

  def rec {β : Type u} (b : β) (ℓ : b = b) : S¹ → β :=
  suspension.rec b b (λ _, ℓ)

  def recβrule₁ {β : Type u} (b : β) (ℓ : b = b) :
    rec b ℓ base = b := types.eq.rfl

  def map_functoriality {α : Type u} {β : Type v}
    {a b c : α} (f : α → β) {p : a = b} {q : b = c} :
    f # (p ⬝ q) = (f # p) ⬝ (f # q) :=
  begin induction p, trivial end

  def map_symm {α : Type u} {β : Type v}
    {a b : α} (f : α → β) {p : a = b} :
    f # p⁻¹ = (f # p)⁻¹ :=
  begin induction p, reflexivity end

  def recβrule₂ {β : Type u} (b : β) (ℓ : b = b) :
    (rec b ℓ # loop) = ℓ := begin
    transitivity,
    apply map_functoriality (rec b ℓ),
    transitivity, apply types.eq.map, apply map_symm,
    admit
  end

  def ind {β : S¹ → Type u} (b : β base)
    (ℓ : b =[loop] b) : Π (x : S¹), β x :=
  ind₂ b (types.equiv.subst seg₁ b)
    (types.equiv.path_over_subst types.eq.rfl)
    (begin
      apply types.equiv.path_over_subst,
      have p := types.equiv.subst_comp seg₂ seg₁⁻¹ b,
      have q := (λ p, subst p (subst seg₂ b)) #
                (types.eq.inv_comp seg₁),
      have r := types.equiv.subst_from_pathover ℓ,
      transitivity, exact q⁻¹, transitivity,
      exact types.equiv.subst_comp seg₁⁻¹ seg₁ (subst seg₂ b),
      symmetry, exact subst seg₁ # (r⁻¹ ⬝ p)
    end)

  instance pointed_circle : types.eq.dotted S¹ := ⟨base⟩

  theorem natural_equivalence {α : Sort u} :
    (S¹ → α) ≃ (Σ' (x : α), x = x) := begin
    let f : (S¹ → α) → (Σ' (x : α), x = x) :=
    λ g, ⟨g base, g # loop⟩,
    let g : (Σ' (x : α), x = x) → (S¹ → α) :=
    λ p x, p.fst,
    existsi f, split; existsi g,
    { intro v, apply HITs.interval.funext,
      intro x, simp,
      admit },
    { intro v, induction v with p q,
      admit }
  end

  namespace going
    def trivial : S¹ → S¹ :=
    rec base (types.eq.refl base)

    def nontrivial : S¹ → S¹ :=
    rec base loop
  end going

  def succ (l : Ω¹(S¹)) : Ω¹(S¹) := l ⬝ loop
  def pred (l : Ω¹(S¹)) : Ω¹(S¹) := l ⬝ loop⁻¹

  def zero := idp base
  def one := succ zero
  def two := succ one
  def three := succ two
  def fourth := succ three

  def helix : S¹ → Type :=
  rec integers (ua integers.succ_equiv)

  def pos : ℕ → Ω¹(S¹)
  | 0 := types.eq.refl base
  | (n + 1) := pos n ⬝ loop

  def neg : ℕ → Ω¹(S¹)
  | 0 := loop⁻¹
  | (n + 1) := neg n ⬝ loop⁻¹

  def power : integers → Ω¹(S¹)
  | (integers.pos n) := pos n
  | (integers.neg n) := neg n

  def encode (x : S¹) (p : base = x) : helix x :=
  types.equiv.transport helix p (integers.pos 0)

  example : power (integers.pos 2) = loop ⬝ loop :=
  by reflexivity

  abbreviation bicycle : helix base → integers := id

  def winding (x : base = base) : integers :=
  bicycle (transport helix x $ integers.pos 0)

  def transport_characterization
    {α : Sort u} {β γ : α → Sort v} {a b : α}
    (f : β a → γ a) (p : a = b) :
    subst p f = transport γ p ∘ f ∘ transport β p⁻¹ :=
  begin induction p, reflexivity end

  def transport_to_comp
    {α : Sort u} {a b c : α}
    (p : a = b) (q : b = c) :
    transport (types.eq a) q p = p ⬝ q :=
  begin induction p, induction q, trivial end

  noncomputable def transport_there (x : integers) :
    transport helix loop x = integers.succ x := begin
    transitivity,
    apply types.equiv.transport_comp id helix loop,
    transitivity, apply types.equiv.homotopy.eq,
    apply types.eq.map subst, apply recβrule₂,
    apply ua.transport_rule
  end

  def transport_back (x : integers) :
    transport helix loop⁻¹ x = integers.pred x :=
  sorry

  def decode : Π (x : S¹), helix x → base = x :=
  @ind (λ x, helix x → base = x) power (begin
    apply types.equiv.path_over_subst,
    apply HITs.interval.funext, intro x,
    apply types.equiv.homotopy.eq, transitivity,
    exact transport_characterization power loop,
    apply HITs.interval.funext, intro n,
    simp, transitivity,
    apply transport_to_comp, transitivity,
    apply types.eq.map (λ p, power p ⬝ loop),
    apply transport_back, induction n,
    -- :-(
    { induction n with n ih,
      { apply types.eq.inv_comp },
      { trivial } },
    { induction n with n ih,
      { symmetry, transitivity, symmetry,
        apply types.eq.refl_right, symmetry,
        transitivity, apply (types.eq.assoc loop⁻¹ loop⁻¹ loop)⁻¹,
        apply types.eq.map, apply types.eq.inv_comp },
      { transitivity,
        apply (types.eq.assoc (neg n ⬝ loop⁻¹) loop⁻¹ loop)⁻¹,
        transitivity, apply types.eq.map,
        apply types.eq.inv_comp, apply types.eq.refl_right } }
  end)

  noncomputable example : winding loop = integers.pos 1 :=
  transport_there (integers.pos 0)
end circle

namespace ncircle
  def S : ℕ → Type
  | 0 := S⁰
  | (n + 1) := ∑(S n)

  def lift : Π n, S n → S (n + 1)
  | 0 ff := suspension.north
  | 0 tt := suspension.south
  | (n + 1) x := suspension.rec suspension.north suspension.south
                               (λ _, suspension.merid x) x
end ncircle

namespace sphere
  notation `S²` := ncircle.S 2

  abbreviation base₁ : S² := suspension.north
  abbreviation base₂ : S² := suspension.south

  def loop : base₁ = base₂ := suspension.merid circle.base

  def surf_trans :=
  (λ p, suspension.merid p ⬝ loop⁻¹) # circle.loop

  abbreviation base : S² := suspension.north
  def surf : idp base = idp base :=
  (types.eq.comp_inv loop)⁻¹ ⬝ surf_trans ⬝ (types.eq.comp_inv loop)

  def rec {β : Type u} (b : β) (s : idp b = idp b) : S² → β :=
  suspension.rec b b (circle.rec (idp b) s)
end sphere

namespace glome
  notation `S³` := ncircle.S 3

  abbreviation base₁ : S³ := suspension.north
  abbreviation base₂ : S³ := suspension.south

  def loop : base₁ = base₂ := suspension.merid sphere.base

  abbreviation base : S³ := suspension.north
end glome

def torus := S¹ × S¹
notation `T²` := torus

namespace torus
  open types.product
  def b : T² := ⟨circle.base, circle.base⟩

  def inj₁ : S¹ → T² := types.product.intro circle.base
  def inj₂ : S¹ → T² := function.swap types.product.intro circle.base

  -- poloidal and toroidal directions
  def p : b = b :> T² := prod (idp circle.base) circle.loop
  def q : b = b :> T² := prod circle.loop (idp circle.base)

  def Φ {π : Type u} {x x' y y' : π}
    (α : x = x') (β : y = y') :
    prod (idp x) β ⬝ prod α (idp y') =
    prod α (idp y) ⬝ prod (idp x') β :=
  begin induction α, induction β, trivial end

  def t : p ⬝ q = q ⬝ p :> b = b :> T² :=
  Φ circle.loop circle.loop
end torus

end HITs
end ground_zero


import logic.nontrivial
import algebra.order.ring.defs
import data.nat.basic
import data.set.basic

/-! ### Test `nontriviality` with inequality hypotheses -/

example {R : Type} [ordered_ring R] {a : R} (h : 0 < a) : 0 < a :=
begin
  nontriviality,
  guard_hyp _inst : nontrivial R,
  assumption,
end

/-! ### Test `nontriviality` with equality or non-strict inequality goals -/

example {R : Type} [comm_ring R] {r s : R} : r * s = s * r :=
begin
  nontriviality,
  guard_hyp _inst : nontrivial R,
  apply mul_comm,
end

/-! ### Test deducing `nontriviality` by instance search -/

example {R : Type} [ordered_ring R] : 0 ≤ (1 : R) :=
begin
  nontriviality R,
  guard_hyp _inst : nontrivial R,
  exact zero_le_one,
end

example {R : Type} [ordered_ring R] : 0 ≤ (1 : R) :=
begin
  nontriviality ℕ,
  guard_hyp _inst : nontrivial ℕ,
  exact zero_le_one,
end

example {R : Type} [ordered_ring R] : 0 ≤ (2 : R) :=
begin
  success_if_fail { nontriviality punit },
  exact zero_le_two,
end

example {R : Type} [ordered_ring R] {a : R} (h : 0 < a) : 2 ∣ 4 :=
begin
  nontriviality R,
  guard_hyp _inst : nontrivial R,
  dec_trivial
end

/-! Test using `@[nontriviality]` lemmas in `nontriviality and custom `simp` lemmas -/

def empty_or_univ {α : Type*} (s : set α) : Prop := s = ∅ ∨ s = set.univ

lemma subsingleton.set_empty_or_univ {α} [subsingleton α] (s : set α) :
  s = ∅ ∨ s = set.univ :=
subsingleton.set_cases (or.inl rfl) (or.inr rfl) s

lemma subsingleton.set_empty_or_univ' {α} [subsingleton α] (s : set α) :
  empty_or_univ s :=
subsingleton.set_empty_or_univ s

example {α : Type*} (s : set α) (hs : s = ∅ ∪ set.univ) : empty_or_univ s :=
begin
  success_if_fail { nontriviality α },
  rw [set.empty_union] at hs,
  exact or.inr hs
end

section

local attribute [nontriviality] subsingleton.set_empty_or_univ

example {α : Type*} (s : set α) (hs : s = ∅ ∪ set.univ) : empty_or_univ s :=
begin
  success_if_fail { nontriviality α },
  nontriviality α using [subsingleton.set_empty_or_univ'],
  rw [set.empty_union] at hs,
  exact or.inr hs
end

end

local attribute [nontriviality] subsingleton.set_empty_or_univ'

example {α : Type*} (s : set α) (hs : s = ∅ ∪ set.univ) : empty_or_univ s :=
begin
  nontriviality α,
  rw [set.empty_union] at hs,
  exact or.inr hs
end

/-! Test with nonatomic type argument -/

example (α : ℕ → Type) (a b : α 0) (h : a = b) : a = b :=
begin
  nontriviality α 0 using [nat.zero_lt_one],
  guard_hyp _inst : nontrivial (α 0),
  exact h
end


import ScholzeLog.logLemmas.ScholzeHelpLemmas
import ScholzeLog.logLemmas.tactics

import tactic

/- In this file we prove Schloze Lemma 5.3 from https://www.math.uni-bonn.de/people/scholze/Analytic.pdf -/

notation `|`x`|` := abs x

open real set

lemma part1 (s t l : ℝ) (hl : 0 < l) : |l*s*log (|l * s|) + l*t*log(|l*t|) - (l*s + l*t)*log(|l*s + l*t|)|
    = l * |s*log(|s|) + t*log(|t|) - (s + t)*log(|s + t|)| :=
begin
  conv_rhs { rw [← abs_of_pos hl, ← abs_mul]},
  congr',
  simp only [log_mul', ← mul_add, mul_assoc, log_mul' hl, log_abs],
  ring,
end

lemma part2_1 (s : ℝ) (hs : s ∈ Icc (-1 : ℝ) 1) (s_pos : 0 < s): |s*log(|s|) - (s + 1) * log(|s + 1|)| ≤ 2 * log 2 :=
begin
  have hS_pos : 0 < (s ^ s / (s + 1) ^ (s + 1)), -- true
  { rw [lt_div_iff, zero_mul];
    {apply rpow_pos_of_pos,
      linarith},
  },
  have hS_nonneg : 0 ≤ (s + 1)^s,
  { apply le_of_lt,
    apply rpow_pos_of_pos,
    linarith,},
    have hS_le_one : (s ^ s / (s + 1) ^ (s + 1)) < 1, -- true. I think.
  { rw div_lt_one,
    have hs_lt : s^s < (s+1)^s := rpow_lt_rpow (le_of_lt s_pos)
      (show s < s+1, by linarith) s_pos,
    rw rpow_add (show 0 < s + 1, by linarith),
    rw rpow_one,
    have one_lt_s_add_one : 1 < s + 1 := by linarith,
    have := mul_lt_mul hs_lt (le_of_lt one_lt_s_add_one) (by norm_num)
      (hS_nonneg),
    rwa mul_one at this,
    { apply rpow_pos_of_pos,
    linarith,}
  },
  { simp only [log_abs, ← log_rpow s_pos, ← log_rpow (show 0 < s + 1, by linarith)],
    rw ← log_div _ _, -- (*) (**)
    { have h_num : 2 * log 2 = log 4,
      { rw ← log_rpow,
        congr,
        rw [show (2 : ℝ) ^ (2 : ℝ) = 2 ^ ((2 : ℕ) : ℝ), by norm_cast, rpow_nat_cast];
        norm_num,
        norm_num,
      },
      rw [← Icc_def, mem_set_of_eq] at hs,
      have log_stuff_neg := log_neg (hS_pos) (hS_le_one),
      -- -log (s ^ s / (s + 1) ^ (s + 1)) ≤ 2 * log 2
      rw [abs_of_neg (log_stuff_neg), ← log_inv, inv_div, h_num, log_le_log _ _],
      {
        { rw div_le_iff,
          { have pow_to_exp1 : 4*s^s = exp(log 4 + s*log s),
            { rw [exp_add, exp_log (show 0 < (4 : ℝ), by norm_num), ← log_rpow s_pos, exp_log],
              apply rpow_pos_of_pos,
              linarith},
            have pow_to_exp2 : (s+1)^(s+1) = exp((s+1) * log(s+1)),
            { rw [← log_rpow (show 0 < s+1, by linarith), exp_log],
              apply rpow_pos_of_pos,
              linarith},
            have H := s_pow_le_s_pow s s_pos hs.2,
            rw div_le_iff at H,
            apply H,
            { apply rpow_pos_of_pos,
              linarith,},
            },
          { apply rpow_pos_of_pos s_pos},
        },
      }, -- (s + 1) ^ (s + 1) / s ^ s ≤ 4
      { apply div_pos;
        { apply rpow_pos_of_pos,
          linarith},
      },
      { norm_num},
      },
      { intros Hss, -- (*)
        rw rpow_eq_zero_iff_of_nonneg (le_of_lt s_pos) at Hss,
        tauto,
      }, -- s ^ s ≠ 0
      { intros Hss, -- (**)
        rw rpow_eq_zero_iff_of_nonneg (show 0 ≤ s + 1, by linarith) at Hss,
        tauto,
      }, -- (s + 1)^(s + 1) ≠ 0
  },
end

lemma part2_2 (s : ℝ) (s_min : -1 ≤ s) (s_max : s ≤ 0): |s*log(|s|) - (s + 1) * log(|s + 1|)| ≤ 2 * log 2 :=
begin
  have H1 := x_log_x_le_log_two s_min s_max,
  have H2 := x_one_log_x_one_le_log_two s_min s_max,
  calc
    |s * log(|s|) - (s + 1) * log(|s + 1|)| = |s * log(|s|) + -((s + 1) * log(|s + 1|))| : by rw sub_eq_add_neg
    ... ≤  |s * log(|s|) | + | -((s + 1) * log (|s + 1|)) | : by apply abs_add
    ... = |s * log(|s|) | + | (s + 1) * log (|s + 1|) | : by rw abs_neg
    ... ≤ log 2 + log 2 : by apply add_le_add H1 H2
    ... = 2*log 2 : by linarith
end


import algebra.group.basic
import tactic
import group_theory.subgroup.basic
import data.set_like.basic
import chapter2.set_theory_cosets

variables {A:Type} [monoid A]

lemma one_lcoset (S:set A) : lcoset (A) (1) (S) = S :=
begin
unfold lcoset,
ext x,
simp, --that is too funny. But I know why this works so we will keep it :)
end

lemma rcoset_one (S:set A) : rcoset (A) (S) (1) = S :=
begin
unfold rcoset,
ext x,
simp,
end


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

! This file was ported from Lean 3 source module topology.algebra.order.filter
! leanprover-community/mathlib commit ad0089aca372256fe53dde13ca0dfea569bf5ac7
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Topology.Order.Basic
import Mathbin.Topology.Filter

/-!
# Topology on filters of a space with order topology

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

In this file we prove that `𝓝 (f x)` tends to `𝓝 filter.at_top` provided that `f` tends to
`filter.at_top`, and similarly for `filter.at_bot`.
-/

open Topology

namespace Filter

variable {α X : Type _} [TopologicalSpace X] [PartialOrder X] [OrderTopology X]

/- warning: filter.tendsto_nhds_at_top -> Filter.tendsto_nhds_atTop is a dubious translation:
lean 3 declaration is
  forall {X : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} X] [_inst_2 : PartialOrder.{u1} X] [_inst_3 : OrderTopology.{u1} X _inst_1 (PartialOrder.toPreorder.{u1} X _inst_2)] [_inst_4 : NoMaxOrder.{u1} X (Preorder.toLT.{u1} X (PartialOrder.toPreorder.{u1} X _inst_2))], Filter.Tendsto.{u1, u1} X (Filter.{u1} X) (nhds.{u1} X _inst_1) (Filter.atTop.{u1} X (PartialOrder.toPreorder.{u1} X _inst_2)) (nhds.{u1} (Filter.{u1} X) (Filter.topologicalSpace.{u1} X) (Filter.atTop.{u1} X (PartialOrder.toPreorder.{u1} X _inst_2)))
but is expected to have type
  forall {X : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} X] [_inst_2 : PartialOrder.{u1} X] [_inst_3 : OrderTopology.{u1} X _inst_1 (PartialOrder.toPreorder.{u1} X _inst_2)] [_inst_4 : NoMaxOrder.{u1} X (Preorder.toLT.{u1} X (PartialOrder.toPreorder.{u1} X _inst_2))], Filter.Tendsto.{u1, u1} X (Filter.{u1} X) (nhds.{u1} X _inst_1) (Filter.atTop.{u1} X (PartialOrder.toPreorder.{u1} X _inst_2)) (nhds.{u1} (Filter.{u1} X) (Filter.instTopologicalSpaceFilter.{u1} X) (Filter.atTop.{u1} X (PartialOrder.toPreorder.{u1} X _inst_2)))
Case conversion may be inaccurate. Consider using '#align filter.tendsto_nhds_at_top Filter.tendsto_nhds_atTopₓ'. -/
protected theorem tendsto_nhds_atTop [NoMaxOrder X] : Tendsto 𝓝 (atTop : Filter X) (𝓝 atTop) :=
  Filter.tendsto_nhds_atTop_iff.2 fun x => (eventually_gt_atTop x).mono fun y => le_mem_nhds
#align filter.tendsto_nhds_at_top Filter.tendsto_nhds_atTop

/- warning: filter.tendsto_nhds_at_bot -> Filter.tendsto_nhds_atBot is a dubious translation:
lean 3 declaration is
  forall {X : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} X] [_inst_2 : PartialOrder.{u1} X] [_inst_3 : OrderTopology.{u1} X _inst_1 (PartialOrder.toPreorder.{u1} X _inst_2)] [_inst_4 : NoMinOrder.{u1} X (Preorder.toLT.{u1} X (PartialOrder.toPreorder.{u1} X _inst_2))], Filter.Tendsto.{u1, u1} X (Filter.{u1} X) (nhds.{u1} X _inst_1) (Filter.atBot.{u1} X (PartialOrder.toPreorder.{u1} X _inst_2)) (nhds.{u1} (Filter.{u1} X) (Filter.topologicalSpace.{u1} X) (Filter.atBot.{u1} X (PartialOrder.toPreorder.{u1} X _inst_2)))
but is expected to have type
  forall {X : Type.{u1}} [_inst_1 : TopologicalSpace.{u1} X] [_inst_2 : PartialOrder.{u1} X] [_inst_3 : OrderTopology.{u1} X _inst_1 (PartialOrder.toPreorder.{u1} X _inst_2)] [_inst_4 : NoMinOrder.{u1} X (Preorder.toLT.{u1} X (PartialOrder.toPreorder.{u1} X _inst_2))], Filter.Tendsto.{u1, u1} X (Filter.{u1} X) (nhds.{u1} X _inst_1) (Filter.atBot.{u1} X (PartialOrder.toPreorder.{u1} X _inst_2)) (nhds.{u1} (Filter.{u1} X) (Filter.instTopologicalSpaceFilter.{u1} X) (Filter.atBot.{u1} X (PartialOrder.toPreorder.{u1} X _inst_2)))
Case conversion may be inaccurate. Consider using '#align filter.tendsto_nhds_at_bot Filter.tendsto_nhds_atBotₓ'. -/
protected theorem tendsto_nhds_atBot [NoMinOrder X] : Tendsto 𝓝 (atBot : Filter X) (𝓝 atBot) :=
  @Filter.tendsto_nhds_atTop Xᵒᵈ _ _ _ _
#align filter.tendsto_nhds_at_bot Filter.tendsto_nhds_atBot

/- warning: filter.tendsto.nhds_at_top -> Filter.Tendsto.nhds_atTop is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {X : Type.{u2}} [_inst_1 : TopologicalSpace.{u2} X] [_inst_2 : PartialOrder.{u2} X] [_inst_3 : OrderTopology.{u2} X _inst_1 (PartialOrder.toPreorder.{u2} X _inst_2)] [_inst_4 : NoMaxOrder.{u2} X (Preorder.toLT.{u2} X (PartialOrder.toPreorder.{u2} X _inst_2))] {f : α -> X} {l : Filter.{u1} α}, (Filter.Tendsto.{u1, u2} α X f l (Filter.atTop.{u2} X (PartialOrder.toPreorder.{u2} X _inst_2))) -> (Filter.Tendsto.{u1, u2} α (Filter.{u2} X) (Function.comp.{succ u1, succ u2, succ u2} α X (Filter.{u2} X) (nhds.{u2} X _inst_1) f) l (nhds.{u2} (Filter.{u2} X) (Filter.topologicalSpace.{u2} X) (Filter.atTop.{u2} X (PartialOrder.toPreorder.{u2} X _inst_2))))
but is expected to have type
  forall {α : Type.{u1}} {X : Type.{u2}} [_inst_1 : TopologicalSpace.{u2} X] [_inst_2 : PartialOrder.{u2} X] [_inst_3 : OrderTopology.{u2} X _inst_1 (PartialOrder.toPreorder.{u2} X _inst_2)] [_inst_4 : NoMaxOrder.{u2} X (Preorder.toLT.{u2} X (PartialOrder.toPreorder.{u2} X _inst_2))] {f : α -> X} {l : Filter.{u1} α}, (Filter.Tendsto.{u1, u2} α X f l (Filter.atTop.{u2} X (PartialOrder.toPreorder.{u2} X _inst_2))) -> (Filter.Tendsto.{u1, u2} α (Filter.{u2} X) (Function.comp.{succ u1, succ u2, succ u2} α X (Filter.{u2} X) (nhds.{u2} X _inst_1) f) l (nhds.{u2} (Filter.{u2} X) (Filter.instTopologicalSpaceFilter.{u2} X) (Filter.atTop.{u2} X (PartialOrder.toPreorder.{u2} X _inst_2))))
Case conversion may be inaccurate. Consider using '#align filter.tendsto.nhds_at_top Filter.Tendsto.nhds_atTopₓ'. -/
theorem Tendsto.nhds_atTop [NoMaxOrder X] {f : α → X} {l : Filter α} (h : Tendsto f l atTop) :
    Tendsto (𝓝 ∘ f) l (𝓝 atTop) :=
  Filter.tendsto_nhds_atTop.comp h
#align filter.tendsto.nhds_at_top Filter.Tendsto.nhds_atTop

/- warning: filter.tendsto.nhds_at_bot -> Filter.Tendsto.nhds_atBot is a dubious translation:
lean 3 declaration is
  forall {α : Type.{u1}} {X : Type.{u2}} [_inst_1 : TopologicalSpace.{u2} X] [_inst_2 : PartialOrder.{u2} X] [_inst_3 : OrderTopology.{u2} X _inst_1 (PartialOrder.toPreorder.{u2} X _inst_2)] [_inst_4 : NoMinOrder.{u2} X (Preorder.toLT.{u2} X (PartialOrder.toPreorder.{u2} X _inst_2))] {f : α -> X} {l : Filter.{u1} α}, (Filter.Tendsto.{u1, u2} α X f l (Filter.atBot.{u2} X (PartialOrder.toPreorder.{u2} X _inst_2))) -> (Filter.Tendsto.{u1, u2} α (Filter.{u2} X) (Function.comp.{succ u1, succ u2, succ u2} α X (Filter.{u2} X) (nhds.{u2} X _inst_1) f) l (nhds.{u2} (Filter.{u2} X) (Filter.topologicalSpace.{u2} X) (Filter.atBot.{u2} X (PartialOrder.toPreorder.{u2} X _inst_2))))
but is expected to have type
  forall {α : Type.{u1}} {X : Type.{u2}} [_inst_1 : TopologicalSpace.{u2} X] [_inst_2 : PartialOrder.{u2} X] [_inst_3 : OrderTopology.{u2} X _inst_1 (PartialOrder.toPreorder.{u2} X _inst_2)] [_inst_4 : NoMinOrder.{u2} X (Preorder.toLT.{u2} X (PartialOrder.toPreorder.{u2} X _inst_2))] {f : α -> X} {l : Filter.{u1} α}, (Filter.Tendsto.{u1, u2} α X f l (Filter.atBot.{u2} X (PartialOrder.toPreorder.{u2} X _inst_2))) -> (Filter.Tendsto.{u1, u2} α (Filter.{u2} X) (Function.comp.{succ u1, succ u2, succ u2} α X (Filter.{u2} X) (nhds.{u2} X _inst_1) f) l (nhds.{u2} (Filter.{u2} X) (Filter.instTopologicalSpaceFilter.{u2} X) (Filter.atBot.{u2} X (PartialOrder.toPreorder.{u2} X _inst_2))))
Case conversion may be inaccurate. Consider using '#align filter.tendsto.nhds_at_bot Filter.Tendsto.nhds_atBotₓ'. -/
theorem Tendsto.nhds_atBot [NoMinOrder X] {f : α → X} {l : Filter α} (h : Tendsto f l atBot) :
    Tendsto (𝓝 ∘ f) l (𝓝 atBot) :=
  @Tendsto.nhds_atTop α Xᵒᵈ _ _ _ _ _ _ h
#align filter.tendsto.nhds_at_bot Filter.Tendsto.nhds_atBot

end Filter


/-
Copyright (c) 2020 Oliver Nash. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Oliver Nash
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.algebra.lie.basic
import Mathlib.linear_algebra.bilinear_form
import Mathlib.PostPort

universes u v w

namespace Mathlib

/-!
# Lie algebras of skew-adjoint endomorphisms of a bilinear form

## Tags

lie algebra, skew-adjoint, bilinear form
-/

theorem bilin_form.is_skew_adjoint_bracket {R : Type u} {M : Type v} [comm_ring R] [add_comm_group M] [module R M] (B : bilin_form R M) (f : module.End R M) (g : module.End R M) (hf : f ∈ bilin_form.skew_adjoint_submodule B) (hg : g ∈ bilin_form.skew_adjoint_submodule B) : has_bracket.bracket f g ∈ bilin_form.skew_adjoint_submodule B := sorry

/-- Given an `R`-module `M`, equipped with a bilinear form, the skew-adjoint endomorphisms form a
Lie subalgebra of the Lie algebra of endomorphisms. -/
def skew_adjoint_lie_subalgebra {R : Type u} {M : Type v} [comm_ring R] [add_comm_group M] [module R M] (B : bilin_form R M) : lie_subalgebra R (module.End R M) :=
  lie_subalgebra.mk (submodule.carrier (bilin_form.skew_adjoint_submodule B)) sorry sorry sorry
    (bilin_form.is_skew_adjoint_bracket B)

/-- An equivalence of modules with bilinear forms gives equivalence of Lie algebras of skew-adjoint
endomorphisms. -/
def skew_adjoint_lie_subalgebra_equiv {R : Type u} {M : Type v} [comm_ring R] [add_comm_group M] [module R M] (B : bilin_form R M) {N : Type w} [add_comm_group N] [module R N] (e : linear_equiv R N M) : lie_algebra.equiv R ↥(skew_adjoint_lie_subalgebra (bilin_form.comp B ↑e ↑e)) ↥(skew_adjoint_lie_subalgebra B) :=
  lie_algebra.equiv.of_subalgebras (skew_adjoint_lie_subalgebra (bilin_form.comp B ↑e ↑e)) (skew_adjoint_lie_subalgebra B)
    (linear_equiv.lie_conj e) sorry

@[simp] theorem skew_adjoint_lie_subalgebra_equiv_apply {R : Type u} {M : Type v} [comm_ring R] [add_comm_group M] [module R M] (B : bilin_form R M) {N : Type w} [add_comm_group N] [module R N] (e : linear_equiv R N M) (f : ↥(skew_adjoint_lie_subalgebra (bilin_form.comp B ↑e ↑e))) : ↑(coe_fn (skew_adjoint_lie_subalgebra_equiv B e) f) = coe_fn (linear_equiv.lie_conj e) ↑f := sorry

@[simp] theorem skew_adjoint_lie_subalgebra_equiv_symm_apply {R : Type u} {M : Type v} [comm_ring R] [add_comm_group M] [module R M] (B : bilin_form R M) {N : Type w} [add_comm_group N] [module R N] (e : linear_equiv R N M) (f : ↥(skew_adjoint_lie_subalgebra B)) : ↑(coe_fn (lie_algebra.equiv.symm (skew_adjoint_lie_subalgebra_equiv B e)) f) =
  coe_fn (linear_equiv.lie_conj (linear_equiv.symm e)) ↑f := sorry

theorem matrix.lie_transpose {R : Type u} {n : Type w} [comm_ring R] [DecidableEq n] [fintype n] (A : matrix n n R) (B : matrix n n R) : matrix.transpose (has_bracket.bracket A B) = has_bracket.bracket (matrix.transpose B) (matrix.transpose A) := sorry

theorem matrix.is_skew_adjoint_bracket {R : Type u} {n : Type w} [comm_ring R] [DecidableEq n] [fintype n] (J : matrix n n R) (A : matrix n n R) (B : matrix n n R) (hA : A ∈ skew_adjoint_matrices_submodule J) (hB : B ∈ skew_adjoint_matrices_submodule J) : has_bracket.bracket A B ∈ skew_adjoint_matrices_submodule J := sorry

/-- The Lie subalgebra of skew-adjoint square matrices corresponding to a square matrix `J`. -/
def skew_adjoint_matrices_lie_subalgebra {R : Type u} {n : Type w} [comm_ring R] [DecidableEq n] [fintype n] (J : matrix n n R) : lie_subalgebra R (matrix n n R) :=
  lie_subalgebra.mk (submodule.carrier (skew_adjoint_matrices_submodule J)) sorry sorry sorry sorry

@[simp] theorem mem_skew_adjoint_matrices_lie_subalgebra {R : Type u} {n : Type w} [comm_ring R] [DecidableEq n] [fintype n] (J : matrix n n R) (A : matrix n n R) : A ∈ skew_adjoint_matrices_lie_subalgebra J ↔ A ∈ skew_adjoint_matrices_submodule J :=
  iff.rfl

/-- An invertible matrix `P` gives a Lie algebra equivalence between those endomorphisms that are
skew-adjoint with respect to a square matrix `J` and those with respect to `PᵀJP`. -/
def skew_adjoint_matrices_lie_subalgebra_equiv {R : Type u} {n : Type w} [comm_ring R] [DecidableEq n] [fintype n] (J : matrix n n R) (P : matrix n n R) (h : is_unit P) : lie_algebra.equiv R ↥(skew_adjoint_matrices_lie_subalgebra J)
  ↥(skew_adjoint_matrices_lie_subalgebra (matrix.mul (matrix.mul (matrix.transpose P) J) P)) :=
  lie_algebra.equiv.of_subalgebras (skew_adjoint_matrices_lie_subalgebra J)
    (skew_adjoint_matrices_lie_subalgebra (matrix.mul (matrix.mul (matrix.transpose P) J) P))
    (lie_algebra.equiv.symm (matrix.lie_conj P h)) sorry

theorem skew_adjoint_matrices_lie_subalgebra_equiv_apply {R : Type u} {n : Type w} [comm_ring R] [DecidableEq n] [fintype n] (J : matrix n n R) (P : matrix n n R) (h : is_unit P) (A : ↥(skew_adjoint_matrices_lie_subalgebra J)) : ↑(coe_fn (skew_adjoint_matrices_lie_subalgebra_equiv J P h) A) = matrix.mul (matrix.mul (P⁻¹) ↑A) P := sorry

/-- An equivalence of matrix algebras commuting with the transpose endomorphisms restricts to an
equivalence of Lie algebras of skew-adjoint matrices. -/
def skew_adjoint_matrices_lie_subalgebra_equiv_transpose {R : Type u} {n : Type w} [comm_ring R] [DecidableEq n] [fintype n] (J : matrix n n R) {m : Type w} [DecidableEq m] [fintype m] (e : alg_equiv R (matrix n n R) (matrix m m R)) (h : ∀ (A : matrix n n R), matrix.transpose (coe_fn e A) = coe_fn e (matrix.transpose A)) : lie_algebra.equiv R ↥(skew_adjoint_matrices_lie_subalgebra J) ↥(skew_adjoint_matrices_lie_subalgebra (coe_fn e J)) :=
  lie_algebra.equiv.of_subalgebras (skew_adjoint_matrices_lie_subalgebra J)
    (skew_adjoint_matrices_lie_subalgebra (coe_fn e J)) (alg_equiv.to_lie_equiv e) sorry

@[simp] theorem skew_adjoint_matrices_lie_subalgebra_equiv_transpose_apply {R : Type u} {n : Type w} [comm_ring R] [DecidableEq n] [fintype n] (J : matrix n n R) {m : Type w} [DecidableEq m] [fintype m] (e : alg_equiv R (matrix n n R) (matrix m m R)) (h : ∀ (A : matrix n n R), matrix.transpose (coe_fn e A) = coe_fn e (matrix.transpose A)) (A : ↥(skew_adjoint_matrices_lie_subalgebra J)) : ↑(coe_fn (skew_adjoint_matrices_lie_subalgebra_equiv_transpose J e h) A) = coe_fn e ↑A :=
  rfl

theorem mem_skew_adjoint_matrices_lie_subalgebra_unit_smul {R : Type u} {n : Type w} [comm_ring R] [DecidableEq n] [fintype n] (u : units R) (J : matrix n n R) (A : matrix n n R) : A ∈ skew_adjoint_matrices_lie_subalgebra (↑u • J) ↔ A ∈ skew_adjoint_matrices_lie_subalgebra J := sorry


import Mathbin.Data.Nat.Basic

lemma Nat.le_eq_LessThanOrEqual : Nat.le = Nat.LessThanOrEqual := by
  ext m n
  constructor
  · intro h
    induction h with
    | refl => apply Nat.LessThanOrEqual.refl
    | step _ h => apply Nat.LessThanOrEqual.step h
  · intro h
    induction h with
    | refl => apply Nat.le.refl
    | step _ h => apply Nat.le.step h

lemma Nat.hasLt_eq_instLTNat : Nat.hasLt = instLTNat := by
  simp only [Nat.le_eq_LessThanOrEqual, Nat.hasLt, instLTNat, Nat.lt]


-- prelude

inductive Bool' : Type where
  | true' : Bool'
  | false' : Bool'

open Bool'

def inv (x : Bool') : Bool' :=
  match x with
  | true' => false'
  | false' => true'

-----------------------------------------
-- Logic

inductive Bot

inductive Top
  | tt : Top

inductive Product (A : Type u) (B : Type v) where
  | pair : A → B → Product A B

open Product

infixl:80 " ⊗ " => Product
infixl:80 " , " => pair

def π₁ (x : A ⊗ B) : A :=
  match x with
  | a , _ => a

def π₂ : A ⊗ B -> B
  | (_ , b) => b

inductive Coproduct (A : Type u) (B : Type v) where
  | left : A -> Coproduct A B
  | right : B -> Coproduct A B

-- infixl:60 " ⊕⊕ " => Coproduct

open Coproduct

instance : Add (Type u) where
  add := Coproduct

instance : Mul (Type u) where
  mul := Product

def Biimplication (A : Type) (B : Type) : Type :=
  Product (A → B) (B → A)

infixl:50 " ↔ " => Biimplication

theorem Product_is_commutative : A ⊗ B ↔ B ⊗ A := by
  have P1 : A ⊗ B → B ⊗ A := λ (a , b) ↦ (b , a)
  have P2 : B ⊗ A → A ⊗ B := λ (b , a) ↦ (a , b)
  exact (P1 , P2)

def neg A := A -> Bot

-- prefix:100 "¬" => Negation

def Negation_triple : neg (neg (neg A)) -> neg A
  | f => λ a ↦ f (λ x ↦ x a)

def Distributive : (A ⊗ (B + C)) -> ((A ⊗ B) + (A ⊗ C))
  | a , left b  => left (a , b)
  | a , right c => right (a , c)


/- General proofs not specific to ASP -/

import order.complete_lattice

lemma Inf_insert_top {α : Type} [complete_lattice α] (S : set α) : Inf S = Inf (insert ⊤ S) := by {
  rw Inf_insert, exact le_antisymm (le_inf le_top rfl.le) inf_le_right
}

lemma Sup_insert_bot {α : Type} [complete_lattice α] (S : set α) : Sup S = Sup (insert ⊥ S) := by {
  rw Sup_insert, exact le_antisymm le_sup_right (sup_le bot_le rfl.le),
}

lemma bin_eq_bin_split {α : Type} {β : Type} {f : α -> α -> β} {a b c d : α} : a = c ∧ b = d -> f a b = f c d := λ a, by { rw [a.left, a.right] }

lemma inf_eq_inf_split {α : Type} [hi : has_inf α] {a b c d : α} : a = c ∧ b = d -> a ⊓ b = c ⊓ d := @bin_eq_bin_split α α hi.inf a b c d
lemma sup_eq_sup_split {α : Type} [hs : has_sup α] {a b c d : α} : a = c ∧ b = d -> a ⊔ b = c ⊔ d := @bin_eq_bin_split α α hs.sup a b c d


import Lake
import Init
import Mathlib.Data.Real.Basic

#eval 1

set_option autoImplicit false

-- All of Incidence Geometry
structure IncidenceGeometry where
  Point : Type
  Line : Type

  lies_on : Point → Line → Prop
  in_between : Point → Point → Point → Prop -- is this supposed to be here?
  -- properties of in_between
  between_refl_left (a b : Point) : in_between a a b
  between_refl_right (a b : Point) : in_between a b b

--def segme (geom : IncidenceGeometry) : Type := geom.Point × geom.Point

--#check segme

--def somseg (geom : IncidenceGeometry) (A B : geom.Point) : segme geom := (segme geom).mk A B

structure EuclidGeometry extends IncidenceGeometry where
  --Segment : Type := Point × Point
  --contain_end_points (seg : Segment) : --says the end points of the segment lies on the resulting line
    --lies_on (seg.1) (line_from_seg seg) ∧ lies_on (seg.2) (line_from_seg seg)

  --som (a b : Point) : Segment := (a,b)

  -- defining distance
  distance (Apt Bpt : Point) : ℝ
  --distance definition
  dist_is_not_neg (A B : Point): distance A B ≥ 0
  dist_same_point (A : Point) : distance A A = 0
  dist_geq_0 (A B : Point) : A ≠ B ↔ distance A B >  0
  dist_is_symm (A B : Point) : distance A B = distance B A
  dist_tri_ineq (A B C : Point) : distance A B + distance B C ≥ distance A C
  -- distance axioms when a point is in between other two
  dist_in_between (a b c : Point) (h : in_between a b c) :
    distance a b + distance b c = distance a c

  -- Postulate 1
  -- Between two points there is an unique line passing through them

  Line_of_two_points (A B : Point) (h : A ≠ B): Line -- from two points we get a line (it may not be unique)
  point_contain (A B : Point) (h : A ≠ B) : --says such a line contain both the points
    have l : Line := Line_of_two_points A B h
    lies_on A l ∧ lies_on B l

  line_unique (A B: Point) (h : A ≠ B) (l1 l2 : Line): --says such a line is unique
  (lies_on A l1 ∧ lies_on B l1) ∧ (lies_on A l2 ∧ lies_on B l2) → l1 = l2

  Collinear_point (A B C : Point) (h : A ≠ B):
    in_between A B C ∨ in_between A C B ∨ in_between C A B
    → lies_on C (Line_of_two_points A B h)

  -- end of Postulate 1

  -- Postulate 2
  -- A line segment can be extended to get a line

  --line_from_seg (seg : Segment) : Line --says a you get a line from a segment

structure Segment (geom : IncidenceGeometry) where
  p1 : geom.Point
  p2 : geom.Point

instance : Coe EuclidGeometry IncidenceGeometry where
  coe geom := { Point := geom.Point, Line := geom.Line, lies_on := geom.lies_on, in_between := geom.in_between, between_refl_left := geom.between_refl_left, between_refl_right := geom.between_refl_right }

def EuclidGeometry.length (geom : EuclidGeometry) (s : Segment geom) : ℝ :=
  geom.distance s.p1 s.p2

-- def EuclidGeometry.point_on_segment (geom : EuclidGeometry) (s : Segment geom) (p : geom.Point) : Prop :=
--   geom.in_between s.p1 p s.p2

variable (geom : EuclidGeometry)

-- this says that there is

-- points in between the segment endpoints lie on the segment
def EuclidGeometry.lies_on_segment (p : geom.Point) (seg : Segment geom) : Prop :=
  geom.in_between seg.p1 p seg.p2

-- this defines when a segment lies on a line (use with CAUTION)
def EuclidGeometry.segment_in_line (geom: EuclidGeometry)
  (s: Segment geom)(l: geom.Line) : Prop :=
  ∀ p: geom.Point, geom.in_between s.p1 p s.p2 → geom.lies_on p l

-- this says that every segment lies on a line
def EuclidGeometry.Post2 (geom : EuclidGeometry) : Prop :=
  ∀ s : Segment geom, ∃ l: geom.Line, geom.segment_in_line s l

-- Line obtained from a segment
variable (Line_from_segment : Segment geom → geom.Line)

-- property of Line_from_segment
def EuclidGeometry.Line_from_segment_contains_segment (seg : Segment geom) : Prop :=
  geom.segment_in_line seg (Line_from_segment seg)

-- this theorem says that the line is unique when the length of the segment is non-zero
theorem EuclidGeometry.Unique_line_from_segment
  (seg : Segment geom) (h : ¬ seg.p1 = seg.p2) (l1 l2 : geom.Line) :
  geom.segment_in_line seg l1 ∧ geom.segment_in_line seg l2
  → l1 = l2
  := by
    intro h1
    let ⟨h2, h3⟩ := h1
    apply geom.line_unique seg.p1 seg.p2 h l1 l2
    apply And.intro
    case left =>
      apply And.intro
      case left =>
        have lem : geom.in_between seg.p1 seg.p1 seg.p2 :=
          geom.between_refl_left seg.p1 seg.p2
        simp [segment_in_line] at h2
        have lem' : geom.in_between seg.p1 seg.p1 seg.p2 →
          geom.lies_on seg.p1 l1 := by
            simp [h2, lem]
        apply lem'
        assumption
      case right =>
        have lem : geom.in_between seg.p1 seg.p2 seg.p2 :=
          geom.between_refl_right seg.p1 seg.p2
        simp [segment_in_line] at h2
        have lem' : geom.in_between seg.p1 seg.p2 seg.p2 →
          geom.lies_on seg.p2 l1 := by
            simp [h2, lem]
        apply lem'
        assumption
    case right =>
      apply And.intro
      case left =>
        have lem : geom.in_between seg.p1 seg.p1 seg.p2 :=
          geom.between_refl_left seg.p1 seg.p2
        simp [segment_in_line] at h3
        have lem' : geom.in_between seg.p1 seg.p1 seg.p2 →
          geom.lies_on seg.p1 l2 := by
            simp [h3, lem]
        apply lem'
        assumption
      case right =>
        have lem : geom.in_between seg.p1 seg.p2 seg.p2 :=
          geom.between_refl_right seg.p1 seg.p2
        simp [segment_in_line] at h3
        have lem' : geom.in_between seg.p1 seg.p2 seg.p2 →
          geom.lies_on seg.p2 l2 := by
            simp [h3, lem]
        apply lem'
        assumption

-- defining parallel lines
def EuclidGeometry.IsParallel (l1 l2 : geom.Line) : Prop :=
  (l1 = l2) ∨ (∀ a : geom.Point, geom.lies_on a l1 → ¬ geom.lies_on a l2)

-- IsParallel is an equivalence relation on Lines
theorem EuclidGeometry.Parallel_refl (l : geom.Line) :
  IsParallel geom l l
  := by
    simp [IsParallel]

theorem EuclidGeometry.Parallel_symm (l1 l2 : geom.Line) :
  IsParallel geom l1 l2 → IsParallel geom l2 l1
  := by
    intro h
    simp [IsParallel]
    simp [IsParallel] at h
    apply Or.elim h
    case left =>
      intro h1
      apply Or.inl
      rw [h1]
    case right =>
      intro h2
      apply Or.inr
      intro p hp
      have lem : geom.lies_on p l1 → ¬ geom.lies_on p l2 := by
        apply of_eq_true
        apply eq_true (h2 p)
      by_contra h3
      simp [h3] at lem
      contradiction

theorem EuclidGeometry.Parallel_trans (l1 l2 l3: geom.Line) :
  IsParallel geom l1 l2 → IsParallel geom l2 l3 → IsParallel geom l1 l3
  := by
    intro h1 h2
    have h1' : IsParallel geom l1 l2 := h1
    have h2' : IsParallel geom l2 l3 := h2

    simp [IsParallel]
    simp [IsParallel] at h1
    simp [IsParallel] at h2
    apply Or.elim h1
    case left =>
      intro h12eq
      apply Or.elim h2
      case left =>
        intro h23eq
        apply Or.inl
        rw [<- h23eq, h12eq]
      case right =>
        intro hk
        rw [<-h12eq] at h2'
        simp [IsParallel] at h2'
        assumption
    case right =>
      intro hk
      apply Or.elim h2
      case left =>
        intro h23eq
        rw [h23eq] at h1'
        simp [IsParallel] at h1'
        assumption
      case right =>
        intro hk1
        by_cases l1 = l3
        case pos =>
          apply Or.inl
          assumption
        case neg =>
          apply Or.inr
          intro p hp
          by_contra hk'
          sorry               -- need to use Playfair's axiom here for this case.

-- defining intersection of lines (not segments)
def EuclidGeometry.Lines_Intersect (l1 l2 : geom.Line) : Prop
  := ¬ IsParallel geom l1 l2

-- unique/existence(?) intersection point for two intersecting lines
theorem EuclidGeometry.Lines_Intersect_Point_Exist
  (l1 l2 : geom.Line) (h : Lines_Intersect geom l1 l2) :
  ∃ c : geom.Point, geom.lies_on c l1 ∧ geom.lies_on c l2
  := by
    simp [Lines_Intersect, IsParallel] at h
    rw [not_or] at h
    let ⟨_, h2⟩ := h
    simp at h2
    assumption

-- "extracting" point of intersection (use with CAUTION. point p can be any point whatsoever)
def EuclidGeometry.Lines_Intersect2
  (l1 l2 : geom.Line) (p : geom.Point) :
  Prop
  := geom.lies_on p l1 ∧ geom.lies_on p l2

-- lines, when they intersect, they do so at a unique point
theorem EuclidGeometry.Lines_Intersect_Point_Unique
  (l1 l2 : geom.Line) (h : Lines_Intersect geom l1 l2) (A B : geom.Point) :
  Lines_Intersect2 geom l1 l2 A →
  Lines_Intersect2 geom l1 l2 B →
  A = B
  := by
    intro h1 h2
    by_contra hab
    simp [Lines_Intersect2] at h1
    let ⟨h1l, h1r⟩ := h1
    simp [Lines_Intersect2] at h2
    let ⟨h2l, h2r⟩ := h2
    have lem1 : l1 = l2 := by
      apply geom.line_unique A B hab
      simp [h1l, h1r, h2l, h2r]
    simp [Lines_Intersect, IsParallel] at h
    rw [not_or] at h
    let ⟨hk, _⟩ := h
    contradiction

/-
variable (Point_from_lines_intersection :
  (l1 : geom.Line) →  (l2 : geom.Line) →  (geom.Lines_Intersect l1 l2) →  geom.Point)

#check Point_from_lines_intersection

-- property of Point_from_lines_intersection
def
-/

-- intersection of a line and a segment
def EuclidGeometry.Line_Intersect_Segment
  (seg : Segment geom) (l : geom.Line) : Prop :=
  ∃ p : geom.Point, geom.lies_on p l ∧ geom.lies_on_segment p seg

-- intersection of a line and a segment at point p
def EuclidGeometry.Line_Intersect_Segment2
  (seg : Segment geom) (l : geom.Line) (p : geom.Point): Prop :=
  geom.lies_on p l ∧ geom.lies_on_segment p seg

--variable (post2: Post2 geom)

-- postulate 3
structure Circle (geom : EuclidGeometry) where
  centre : geom.Point
  radius : ℝ

-- points on circle
def EuclidGeometry.On_Circle (P : geom.Point) (circ : Circle geom) : Prop
  := geom.distance P circ.centre = circ.radius

-- postulate 4
structure Angle (geom : EuclidGeometry) where
  p1 : geom.Point
  Pivot : geom.Point
  p2 : geom.Point

variable (reflexAngle : Angle geom → Angle geom)

-- measure of angle
variable (mAngle : Angle geom → ℝ)

-- statement that a point is inside an angle
def EuclidGeometry.IntPointAngle (a : geom.Point) (A : Angle geom) : Prop :=
  let A1 : Angle geom := Angle.mk a A.Pivot A.p1
  have A2 : Angle geom := Angle.mk a A.Pivot A.p2
  (mAngle (A1) < mAngle  A) ∧ (mAngle (A2) < mAngle A) -- strict inequality because of 120

-- we need to write that intpointangle for angles AOB and BOA are the same

-- properties of mAngle
def EuclidGeometry.mAngle_non_neg (a b c : geom.Point) : Prop :=
  mAngle (Angle.mk a b c) ≥ 0
def EuclidGeometry.ZeroAngle (a b c : geom.Point) (_ : geom.in_between a c b): Prop :=
  mAngle (Angle.mk a b c) = 0
def EuclidGeometry.mAngle_postive (a b c : geom.Point) : Prop :=
  ¬ geom.in_between a c b →
  ¬ geom.in_between c a b →
  mAngle (Angle.mk a b c) > 0

def EuclidGeometry.mReflexAngle (A : Angle geom) : Prop :=
  mAngle (reflexAngle A) = 360 - mAngle A

-- Angle A as Sum of its constituents
def EuclidGeometry.mAngleAdd (a : geom.Point) (A : Angle geom)
  (_ : EuclidGeometry.IntPointAngle geom mAngle a A) :
  have A1 : Angle geom := Angle.mk a A.Pivot A.p1
  have A2 : Angle geom := Angle.mk a A.Pivot A.p2
  mAngle A = mAngle A1 + mAngle A2
  := sorry

-- Postulate 4 says all right angles are equal.
-- We are assigning it a value of 90
def EuclidGeometry.isRightAngle (A : Angle geom): Prop := mAngle A = 90
-- straight line is two right angles

def EuclidGeometry.StraightAngle (a b c : geom.Point) (_ : geom.in_between a b c) :
  mAngle (Angle.mk a b c) = 180 := sorry

--variable (StraightAngle) --(a b c : geom.Point) (_ : geom.in_between a b c) :
  --mAngle (Angle.mk a b c) = 180

-- Postulate 5

-- defining when two points are on opposite sides of a line
def EuclidGeometry.OppSidedPoints (p1 p2 : geom.Point) (l : geom.Line) : Prop :=
  geom.Line_Intersect_Segment (Segment.mk p1 p2) l

-- defining same sided points
def EuclidGeometry.SameSidedPoints (p1 p2 : geom.Point) (l : geom.Line) : Prop :=
  ¬ geom.OppSidedPoints p1 p2 l

-- Statement of Postulate 5:
-- Let line segment AB and CD be intersected by
-- line l at points p1 and p2 respectively.
-- Let A and C be same-sided wrt l.
-- Let mAngle(A p1 p2) + mAngle(C p2 p1) < 180.
-- Then there exists a point p such that
-- line from AB and CD intersect at p
-- and p is same-sided as A wrt to line l.

def EuclidGeometry.Post5 (A B C D p1 p2 : geom.Point) (l : geom.Line)
  (hab : ¬ A = B) (hcd : ¬ C = D) : Prop :=
  geom.Line_Intersect_Segment2 (Segment.mk A B) l p1
  →
  geom.Line_Intersect_Segment2 (Segment.mk C D) l p2
  →
  geom.SameSidedPoints A C l
  →
  mAngle (Angle.mk A p1 p2) + mAngle (Angle.mk C p2 p1) < 180
  →
  ∃ p : geom.Point,
  geom.Lines_Intersect2
  (geom.Line_of_two_points A B hab) (geom.Line_of_two_points C D hcd) p
  ∧
  geom.SameSidedPoints p A l

-- vertically opposite angles are equal

-- equality of measure of "symmetric" angles
def EuclidGeometry.SymmAngles (a o b : geom.Point):
  mAngle (Angle.mk a o b) = mAngle (Angle.mk b o a)
  := sorry

theorem VOAequal (a b c d o : geom.Point)
(h1 : ¬a = b)
(h2 : ¬c = d)
(h3 : geom.in_between a o b ∧ geom.in_between c o d)
(h4 : ¬geom.IsParallel
  (geom.Line_of_two_points a b h1)
  (geom.Line_of_two_points c d h2))
(h5: geom.IntPointAngle mAngle c (Angle.mk a o b))
(h6: geom.IntPointAngle mAngle a (Angle.mk c o d)):
let COB := Angle.mk c o b
let AOD := Angle.mk a o d
mAngle (COB) = mAngle (AOD)
:= by
  let COA := Angle.mk c o a
  let AOC := Angle.mk a o c
  let AOD := Angle.mk a o d
  let AOB := Angle.mk a o b
  let COD := Angle.mk c o d
  let COB := Angle.mk c o b
  have lem1 : mAngle (AOB) = 180 := geom.StraightAngle mAngle a o b (And.left h3)
  have lem2 : mAngle (COD) = 180 := geom.StraightAngle mAngle c o d (And.right h3)
  have lem3 : mAngle (AOB) = mAngle (COA) + mAngle (COB) :=
    geom.mAngleAdd mAngle c AOB h5
  have lem4 : mAngle (COD) = mAngle (AOC) + mAngle (AOD) :=
    geom.mAngleAdd mAngle a COD h6
  have lem5 : mAngle COA = mAngle AOC := by
    simp [geom.SymmAngles]
  have lem6 : mAngle (COA) + mAngle (COB) = mAngle (AOC) + mAngle (AOD) := by
    rw [<-lem3, <-lem4, lem1, lem2]
  rw [lem5] at lem6
  simp [add_left_cancel] at lem6
  assumption

--def reflexAngle (a : Angle geom) : Angle geom
  --:= (Angle geom).mk

structure Postulates (geom: EuclidGeometry) where
  post2 : ∀ s : Segment geom, ∃ l: geom.Line, geom.segment_in_line s l

--we would need to call these postulates to prove theorems within EuclidGeometry. Some other smaller definitions
-- and theorems require these postulates as "inputs".


import algebra.group
import data.list.basic

namespace group_rel
namespace free_group
open native

@[reducible] def free_group := list (ℕ × bool)

def ap : free_group → free_group → free_group := (++)
def cons (i : ℕ) (b : bool) (a : free_group) : free_group :=
⟨i, b⟩ :: a

instance : has_one (free_group) := ⟨[]⟩

lemma one_def : (1 : free_group) = [] := rfl

meta def to_expr : free_group → expr
| []          := `((1 : free_group))
| (⟨i, b⟩::l) := `(cons %%(reflect i) %%(reflect b) %%(to_expr l))

-- inv_core a b is a⁻¹ * b
def inv_core : free_group → free_group → free_group
| []            l  := l
| (⟨i, n⟩::l₁)  l₂ := inv_core l₁ (⟨i, bnot n⟩::l₂)

instance : has_inv free_group := ⟨λ a, inv_core a []⟩

def inv (a : free_group) : free_group := a⁻¹

lemma inv_def (w : free_group) : w⁻¹ = inv_core w [] := rfl

def mul_aux : Π (l₁ l₂ : free_group), free_group
| []      l₂      := l₂
| (i::l₁) []      := (i :: l₁).reverse_core []
| a@(i::l₁) b@(j::l₂) :=
  if i.1 = j.1 ∧ i.2 ≠ j.2
    then mul_aux l₁ l₂
    else a.reverse_core b

instance : has_mul free_group := ⟨λ l₁ l₂, mul_aux l₁.reverse l₂⟩

lemma mul_def (w₁ w₂ : free_group) : w₁ * w₂ = mul_aux (w₁.reverse_core []) w₂ := rfl

lemma zero_eq_succ_eq (n : ℕ) : 0 = n.succ = false :=
eq_false_intro $ λ h, nat.no_confusion h

lemma succ_eq_zero_eq (n : ℕ) : n.succ = 0 = false :=
eq_false_intro $ λ h, nat.no_confusion h

example : ([⟨1, tt⟩, ⟨0, tt⟩] : free_group)⁻¹ * [⟨1, tt⟩] * [⟨2, tt⟩] *
  [⟨3, tt⟩] = [⟨0, ff⟩, ⟨2, tt⟩, ⟨3, tt⟩]  :=
begin
  simp only [inv_core, inv_def, bool.bnot_true, bool.bnot_false, eq_self_iff_true,
    true_and, and_true, one_def, mul_def, list.reverse_core, mul_aux, ne.def,
    not_false_iff, if_true, if_false, false_and, and_false,
    nat.succ.inj_eq, zero_eq_succ_eq, succ_eq_zero_eq],
end

def length (w : free_group) : ℕ := list.length w

def cost (no_atoms : ℕ) (w : free_group) : ℕ :=
w.foldl (λ cost i, cost * no_atoms + i.1.succ) 0

def subst (x : ℕ) (r : free_group) : Π (w : free_group), free_group
| [] := []
| (⟨a, b⟩::w) :=
  if a = x
    then cond b
      (r⁻¹ * subst w)
      (r * subst w)
    else [⟨a, b⟩] * subst w

section

variables {G : Type*} [group G]

def nth : list G → ℕ → G
| []     _     := 1
| (g::l) 0     := g
| (g::l) (i+1) := nth l i

def eval (l : list G) : free_group → G
| []           := 1
| (⟨i, tt⟩::w) := (nth l i)⁻¹ * eval w
| (⟨i, ff⟩::w) := (nth l i)   * eval w

lemma eval_one (l : list G) : eval l 1 = 1 := rfl

lemma eval_append (l : list G) : Π (w₁ w₂ : free_group),
  eval l (w₁ ++ w₂) = eval l w₁ * eval l w₂
| []           w₂ := by simp [eval]
| (⟨i, tt⟩::w) w₂ := by simp [*, eval, mul_assoc]
| (⟨i, ff⟩::w) w₂ := by simp [*, eval, mul_assoc]

lemma eval_cons (l : list G) (i : ℕ) (o : bool) (w : free_group) :
  eval l (cons i o w) = nth l i ^ cond o (-1 : int) (1 : int) * eval l w :=
by cases o; simp [cons, eval]

lemma eval_ap (l : list G) (w₁ w₂ : free_group) :
  eval l (ap w₁ w₂) = eval l w₁ * eval l w₂ :=
eval_append l w₁ w₂

lemma eval_mul_aux (l : list G) : ∀ w₁ w₂ : free_group,
  eval l (mul_aux w₁ w₂) = eval l (w₁.reverse_core w₂)
| []      l₂      := by simp [mul_aux, eval, list.reverse_core_eq]
| (i::l₁) []      := by simp [mul_aux, eval, list.reverse_core_eq]
| (⟨i₁, b₁⟩::w₁) (⟨i₂, b₂⟩::w₂) :=
begin
  rw [mul_aux, list.reverse_core, list.reverse_core_eq, eval_append],
  split_ifs,
  { dsimp at h,
    cases h with hi hb,
    subst hi,
    cases b₂,
    { simp [bool.eq_tt_of_ne_ff hb, eval, eval_mul_aux, list.reverse_core_eq,
        eval_append] },
    { simp [bool.eq_ff_of_ne_tt hb, eval, eval_mul_aux, list.reverse_core_eq,
        eval_append] } },
  { simp [eval_append, eval] }
end

lemma eval_mul (l : list G) (w₁ w₂ : free_group) :
  eval l (w₁ * w₂) = eval l w₁ * eval l w₂ :=
by simp [mul_def, eval_mul_aux, list.reverse_core_eq, eval_append]

lemma eval_inv_core (l : list G) : ∀ (w₁ w₂ : free_group),
  eval l (inv_core w₁ w₂) = (eval l w₁)⁻¹ * eval l w₂
| [] w             := by simp [inv_core, eval]
| (⟨i, ff⟩::w₁) w₂ :=
  by rw [inv_core, bool.bnot_false, eval_inv_core, eval,
    eval, mul_inv_rev, mul_assoc]
| (⟨i, tt⟩::w₁) w₂ :=
   by rw [inv_core, bool.bnot_true, eval_inv_core, eval,
    eval, mul_inv_rev, mul_assoc, inv_inv]

lemma eval_inv (l : list G) (w : free_group) : eval l w⁻¹ = (eval l w)⁻¹ :=
by rw [inv_def, eval_inv_core, eval, mul_one]

lemma eval_subst (l : list G) (x : ℕ) (r w : free_group)
  (h : eval l [⟨x, ff⟩] = eval l r) :
  eval l (subst x r w) = eval l w :=
begin
  induction w with i w ih,
  { refl },
  { cases i,
    rw [subst],
    split_ifs,
    { subst h_1,
      cases i_snd;
      simp [eval_mul, eval, *, eval_inv] at * },
    { cases i_snd;
      simp [eval_mul, eval, ih] } }
end

lemma subst_eq_one_of_eq_one
  (l : list G) (x : ℕ)
  (r₁ r₂ r rhs word new_word : free_group)
  (hnew_r : rhs = r₁⁻¹ * r₂⁻¹)
  (hr : r = r₁ ++ [⟨x, ff⟩] ++ r₂)
  (hr : eval l r = 1)
  (hw : eval l word = 1)
  (hs : new_word = subst x rhs word) :
  eval l new_word = 1 :=
begin
  substs rhs r new_word,
  rw [eval_subst _ _ _ _ _, hw],
  simpa [eval_mul, eval_append, eval, mul_assoc, eval_inv,
    eq_inv_mul_iff_mul_eq, eq_inv_iff_mul_eq_one] using hr
end

lemma eq_one_of_subst_eq_one
  (l : list G) (x : ℕ)
  (r₁ r₂ r rhs word new_word : free_group)
  (hnew_r : rhs = r₁⁻¹ * r₂⁻¹)
  (hr : r = r₁ ++ [⟨x, ff⟩] ++ r₂)
  (hr : eval l r = 1)
  (hs : new_word = subst x rhs word)
  (hw : eval l new_word = 1) :
  eval l word = 1 :=
begin
  substs rhs r new_word,
  rw [eval_subst] at hw, rw hw,
  { simp only [eval_append, eval_mul, eval_inv] at *,
    rwa [eq_inv_mul_iff_mul_eq, eq_inv_iff_mul_eq_one] }
end

meta def is_subst_aux : free_group → free_group →
  rb_set ℕ →
  rb_map ℕ (ℕ × bool × free_group × free_group) →
  rb_set ℕ × rb_map ℕ (ℕ × bool × free_group × free_group)
| []     []          rbs rbm := (rbs, rbm)
| (a::l) []          rbs rbm := is_subst_aux l [a] (rbs.insert a.1) (rbm.insert a.1 (a.1, a.2, [], l))
| (a::l₁) w₂@(b::l₂) rbs rbm :=
  match rbs.contains a.1 with
  | ff := is_subst_aux l₁ (a::b::l₂) (rbs.insert a.1) (rbm.insert a.1 (a.1, a.2, w₂.reverse, l₁))
  | tt := is_subst_aux l₁ (a::b::l₂) rbs (rbm.erase a.1)
  end
| [] l₂ rbs rbm := (rbs, rbm)
end

/-- is_subst `w` returns `(i, b, w₁, w₂)` such that `w = w₁ ++ [⟨i, b⟩] ++ w₂`,
  and neither `w₁` nor `w₂` contain `i` -/
meta def is_subst (w : free_group) : option (ℕ × bool × free_group × free_group) :=
(is_subst_aux w [] mk_rb_map mk_rb_map).2.min

meta def cyclically_reduce_aux : Π (w wr : free_group), free_group
| [] wr := []
| w []  := []
| w@(⟨i₁, b₁⟩::l₁) (⟨i₂, b₂⟩::l₂) :=
  if i₁ = i₂ ∧ b₁ = bnot b₂
    then cyclically_reduce_aux l₁.init l₂.init
    else w

meta def cyclically_reduce (w : free_group) : free_group :=
cyclically_reduce_aux w w.reverse

meta def cyclically_reduce_conj_aux : Π (w wr : free_group), free_group
| [] wr := []
| w []  := []
| w@(⟨i₁, b₁⟩::l₁) (⟨i₂, b₂⟩::l₂) :=
  if i₁ = i₂ ∧ b₁ = bnot b₂
    then [⟨i₁, b₁⟩] ++ cyclically_reduce_conj_aux l₁.init l₂.init
    else 1

meta def cyclically_reduce_conj (w : free_group) : free_group :=
cyclically_reduce_conj_aux w w.reverse

def of : ℕ → free_group := λ n, [(n, ff)]

def lt : Π (a b : free_group), bool
| _       []     := ff
| []      (a::l) := tt
| (a::l₁) (b::l₂) :=
  if a < b
    then tt
    else lt l₁ l₂

instance : has_pow free_group ℕ := ⟨λ a n, nat.rec_on n 1 (λ _, (* a))⟩
instance : has_pow free_group ℤ := ⟨λ a n, int.cases_on n
  ((^) a)
  (λ n, a⁻¹ ^ (n + 1))⟩

-- @[instance, priority 100000] def free_group.has_lt :
--   has_lt (free_group) := ⟨λ a b, lt a b⟩

-- instance : decidable_rel ((<) : free_group → free_group → Prop) :=
-- λ _ _, show decidable ((_ : bool) : Prop), by apply_instance

section eqv

inductive eqv : free_group → free_group → Prop
| refl : ∀ a, eqv a a
| symm : ∀ {a b}, eqv a b → eqv b a
| trans : ∀ {a b c}, eqv a b → eqv b c → eqv a c
| cons : ∀ {a b i o}, eqv a b → eqv (cons i o a) (cons i o b)
| ap : ∀ {a b c d}, eqv a b → eqv c d → eqv (ap a c) (ap b d)
| inv_core :  ∀ {a b c d}, eqv a b → eqv c d → eqv (inv_core a c) (inv_core b d)
| mul_inv_cancel : ∀ i a, eqv (cons i ff (cons i tt a)) a
| inv_mul_cancel : ∀ i a, eqv (cons i tt (cons i ff a)) a

attribute [refl] eqv.refl
attribute [symm] eqv.symm
attribute [trans] eqv.trans

attribute [congr] eqv.cons eqv.ap

variables {G : Type*} [group G]

lemma inv_core_eq (a b : free_group) : inv_core a b = a⁻¹ ++ b :=
begin
  induction a with i a ih generalizing b,
  { simp [inv_def, inv_core] },
  { rw [inv_def] at *,
    rcases i with ⟨_,_|_⟩,
    { rw [inv_core, ih, inv_core, ih [_]],
      simp },
    { rw [inv_core, ih, inv_core, ih [_]],
      simp } }
end

lemma inv_core_cons_ff_eqv (i : ℕ) (a b : free_group) :
  eqv (inv_core (cons i ff a) b) (inv_core a (cons i tt b)) :=
by refl

lemma inv_core_cons_tt_eqv (i : ℕ) (a b : free_group) :
  eqv (inv_core (cons i tt a) b) (inv_core a (cons i ff b)) :=
by refl

lemma inv_core_one_eqv (b : free_group) :
  eqv (inv_core 1 b) b := by refl

lemma ap_one_eqv (a : free_group) : eqv (ap a 1) a := by simp [ap, one_def]

lemma one_ap_eqv (a : free_group) : eqv (ap 1 a) a := by simp [ap, one_def]

lemma one_inv_eqv : eqv (inv 1) 1 := eqv.refl _

lemma ap_cons_eqv {i : ℕ} {o : bool} {a b : free_group} :
  eqv (ap (cons i o a) b) (cons i o (ap a b)) :=
by simp [cons, ap]

lemma eval_eq_of_eqv (atoms : list G) {a b : free_group} (hab : eqv a b) :
  eval atoms a = eval atoms b :=
by induction hab; simp [eval, eval_append, *, ap, eval_cons, eval_inv, inv_core_eq] at *

meta def mk_free_group_simp_lemmas : tactic simp_lemmas :=
do sl : simp_lemmas ←
  ([``eqv.mul_inv_cancel, ``eqv.inv_mul_cancel,
    ``ap_one_eqv, ``one_ap_eqv, ``ap_cons_eqv,
    ``inv_core_cons_ff_eqv, ``inv_core_cons_tt_eqv,
    ``inv_core_one_eqv] : list name).mfoldl
  (λ (sl : simp_lemmas) n, sl.add_simp n)
  simp_lemmas.mk,
[``eqv.cons, ``eqv.inv_core, ``eqv.ap].mfoldl
  (λ (sl : simp_lemmas) n, sl.add_congr n)
  sl

run_cmd mk_free_group_simp_lemmas

open tactic expr

meta def free_group_simp (lhs : expr) (sl : simp_lemmas) : tactic expr :=
do
(lhs', prl) ← (simplify sl [] lhs (default _) ``eqv <|> return (lhs, `(eqv.refl %%lhs))),
return prl

end eqv

end free_group
end group_rel


/-
Copyright (c) 2020 Heather Macbeth. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Heather Macbeth
-/
import analysis.normed_space.hahn_banach.extension
import analysis.normed_space.is_R_or_C
import analysis.locally_convex.polar

/-!
# The topological dual of a normed space

In this file we define the topological dual `normed_space.dual` of a normed space, and the
continuous linear map `normed_space.inclusion_in_double_dual` from a normed space into its double
dual.

For base field `𝕜 = ℝ` or `𝕜 = ℂ`, this map is actually an isometric embedding; we provide a
version `normed_space.inclusion_in_double_dual_li` of the map which is of type a bundled linear
isometric embedding, `E →ₗᵢ[𝕜] (dual 𝕜 (dual 𝕜 E))`.

Since a lot of elementary properties don't require `eq_of_dist_eq_zero` we start setting up the
theory for `seminormed_add_comm_group` and we specialize to `normed_add_comm_group` when needed.

## Main definitions

* `inclusion_in_double_dual` and `inclusion_in_double_dual_li` are the inclusion of a normed space
  in its double dual, considered as a bounded linear map and as a linear isometry, respectively.
* `polar 𝕜 s` is the subset of `dual 𝕜 E` consisting of those functionals `x'` for which
  `‖x' z‖ ≤ 1` for every `z ∈ s`.

## Tags

dual
-/

noncomputable theory
open_locale classical topology
universes u v

namespace normed_space

section general
variables (𝕜 : Type*) [nontrivially_normed_field 𝕜]
variables (E : Type*) [seminormed_add_comm_group E] [normed_space 𝕜 E]
variables (F : Type*) [normed_add_comm_group F] [normed_space 𝕜 F]

/-- The topological dual of a seminormed space `E`. -/
@[derive [inhabited, seminormed_add_comm_group, normed_space 𝕜]] def dual := E →L[𝕜] 𝕜

instance : continuous_linear_map_class (dual 𝕜 E) 𝕜 E 𝕜 :=
continuous_linear_map.continuous_semilinear_map_class

instance : has_coe_to_fun (dual 𝕜 E) (λ _, E → 𝕜) := continuous_linear_map.to_fun

instance : normed_add_comm_group (dual 𝕜 F) := continuous_linear_map.to_normed_add_comm_group

instance [finite_dimensional 𝕜 E] : finite_dimensional 𝕜 (dual 𝕜 E) :=
continuous_linear_map.finite_dimensional

/-- The inclusion of a normed space in its double (topological) dual, considered
   as a bounded linear map. -/
def inclusion_in_double_dual : E →L[𝕜] (dual 𝕜 (dual 𝕜 E)) :=
continuous_linear_map.apply 𝕜 𝕜

@[simp] lemma dual_def (x : E) (f : dual 𝕜 E) : inclusion_in_double_dual 𝕜 E x f = f x := rfl

lemma inclusion_in_double_dual_norm_eq :
  ‖inclusion_in_double_dual 𝕜 E‖ = ‖(continuous_linear_map.id 𝕜 (dual 𝕜 E))‖ :=
continuous_linear_map.op_norm_flip _

lemma inclusion_in_double_dual_norm_le : ‖inclusion_in_double_dual 𝕜 E‖ ≤ 1 :=
by { rw inclusion_in_double_dual_norm_eq, exact continuous_linear_map.norm_id_le }

lemma double_dual_bound (x : E) : ‖(inclusion_in_double_dual 𝕜 E) x‖ ≤ ‖x‖ :=
by simpa using continuous_linear_map.le_of_op_norm_le _ (inclusion_in_double_dual_norm_le 𝕜 E) x

/-- The dual pairing as a bilinear form. -/
def dual_pairing : (dual 𝕜 E) →ₗ[𝕜] E →ₗ[𝕜] 𝕜 := continuous_linear_map.coe_lm 𝕜

@[simp] lemma dual_pairing_apply {v : dual 𝕜 E} {x : E} : dual_pairing 𝕜 E v x = v x := rfl

lemma dual_pairing_separating_left : (dual_pairing 𝕜 E).separating_left :=
begin
  rw [linear_map.separating_left_iff_ker_eq_bot, linear_map.ker_eq_bot],
  exact continuous_linear_map.coe_injective,
end

end general

section bidual_isometry

variables (𝕜 : Type v) [is_R_or_C 𝕜]
  {E : Type u} [normed_add_comm_group E] [normed_space 𝕜 E]

/-- If one controls the norm of every `f x`, then one controls the norm of `x`.
    Compare `continuous_linear_map.op_norm_le_bound`. -/
lemma norm_le_dual_bound (x : E) {M : ℝ} (hMp: 0 ≤ M) (hM : ∀ (f : dual 𝕜 E), ‖f x‖ ≤ M * ‖f‖) :
  ‖x‖ ≤ M :=
begin
  classical,
  by_cases h : x = 0,
  { simp only [h, hMp, norm_zero] },
  { obtain ⟨f, hf₁, hfx⟩ : ∃ f : E →L[𝕜] 𝕜, ‖f‖ = 1 ∧ f x = ‖x‖ := exists_dual_vector 𝕜 x h,
    calc ‖x‖ = ‖(‖x‖ : 𝕜)‖ : is_R_or_C.norm_coe_norm.symm
    ... = ‖f x‖ : by rw hfx
    ... ≤ M * ‖f‖ : hM f
    ... = M : by rw [hf₁, mul_one] }
end

lemma eq_zero_of_forall_dual_eq_zero {x : E} (h : ∀ f : dual 𝕜 E, f x = (0 : 𝕜)) : x = 0 :=
norm_le_zero_iff.mp (norm_le_dual_bound 𝕜 x le_rfl (λ f, by simp [h f]))

lemma eq_zero_iff_forall_dual_eq_zero (x : E) : x = 0 ↔ ∀ g : dual 𝕜 E, g x = 0 :=
⟨λ hx, by simp [hx], λ h, eq_zero_of_forall_dual_eq_zero 𝕜 h⟩

/-- See also `geometric_hahn_banach_point_point`. -/
lemma eq_iff_forall_dual_eq {x y : E} :
  x = y ↔ ∀ g : dual 𝕜 E, g x = g y :=
begin
  rw [← sub_eq_zero, eq_zero_iff_forall_dual_eq_zero 𝕜 (x - y)],
  simp [sub_eq_zero],
end

/-- The inclusion of a normed space in its double dual is an isometry onto its image.-/
def inclusion_in_double_dual_li : E →ₗᵢ[𝕜] (dual 𝕜 (dual 𝕜 E)) :=
{ norm_map' := begin
    intros x,
    apply le_antisymm,
    { exact double_dual_bound 𝕜 E x },
    rw continuous_linear_map.norm_def,
    refine le_cInf continuous_linear_map.bounds_nonempty _,
    rintros c ⟨hc1, hc2⟩,
    exact norm_le_dual_bound 𝕜 x hc1 hc2
  end,
  .. inclusion_in_double_dual 𝕜 E }

end bidual_isometry

section polar_sets

open metric set normed_space

/-- Given a subset `s` in a normed space `E` (over a field `𝕜`), the polar
`polar 𝕜 s` is the subset of `dual 𝕜 E` consisting of those functionals which
evaluate to something of norm at most one at all points `z ∈ s`. -/
def polar (𝕜 : Type*) [nontrivially_normed_field 𝕜]
  {E : Type*} [seminormed_add_comm_group E] [normed_space 𝕜 E] : set E → set (dual 𝕜 E) :=
(dual_pairing 𝕜 E).flip.polar

variables (𝕜 : Type*) [nontrivially_normed_field 𝕜]
variables {E : Type*} [seminormed_add_comm_group E] [normed_space 𝕜 E]

lemma mem_polar_iff {x' : dual 𝕜 E} (s : set E) : x' ∈ polar 𝕜 s ↔ ∀ z ∈ s, ‖x' z‖ ≤ 1 := iff.rfl

@[simp] lemma polar_univ : polar 𝕜 (univ : set E) = {(0 : dual 𝕜 E)} :=
(dual_pairing 𝕜 E).flip.polar_univ
  (linear_map.flip_separating_right.mpr (dual_pairing_separating_left 𝕜 E))

lemma is_closed_polar (s : set E) : is_closed (polar 𝕜 s) :=
begin
  dunfold normed_space.polar,
  simp only [linear_map.polar_eq_Inter, linear_map.flip_apply],
  refine is_closed_bInter (λ z hz, _),
  exact is_closed_Iic.preimage (continuous_linear_map.apply 𝕜 𝕜 z).continuous.norm
end

@[simp] lemma polar_closure (s : set E) : polar 𝕜 (closure s) = polar 𝕜 s :=
((dual_pairing 𝕜 E).flip.polar_antitone subset_closure).antisymm $
  (dual_pairing 𝕜 E).flip.polar_gc.l_le $
  closure_minimal ((dual_pairing 𝕜 E).flip.polar_gc.le_u_l s) $
  by simpa [linear_map.flip_flip]
    using (is_closed_polar _ _).preimage (inclusion_in_double_dual 𝕜 E).continuous

variables {𝕜}

/-- If `x'` is a dual element such that the norms `‖x' z‖` are bounded for `z ∈ s`, then a
small scalar multiple of `x'` is in `polar 𝕜 s`. -/
lemma smul_mem_polar {s : set E} {x' : dual 𝕜 E} {c : 𝕜}
  (hc : ∀ z, z ∈ s → ‖ x' z ‖ ≤ ‖c‖) : c⁻¹ • x' ∈ polar 𝕜 s :=
begin
  by_cases c_zero : c = 0, { simp only [c_zero, inv_zero, zero_smul],
    exact (dual_pairing 𝕜 E).flip.zero_mem_polar _ },
  have eq : ∀ z, ‖ c⁻¹ • (x' z) ‖ = ‖ c⁻¹ ‖ * ‖ x' z ‖ := λ z, norm_smul c⁻¹ _,
  have le : ∀ z, z ∈ s → ‖ c⁻¹ • (x' z) ‖ ≤ ‖ c⁻¹ ‖ * ‖ c ‖,
  { intros z hzs,
    rw eq z,
    apply mul_le_mul (le_of_eq rfl) (hc z hzs) (norm_nonneg _) (norm_nonneg _), },
  have cancel : ‖ c⁻¹ ‖ * ‖ c ‖ = 1,
  by simp only [c_zero, norm_eq_zero, ne.def, not_false_iff,
                inv_mul_cancel, norm_inv],
  rwa cancel at le,
end

lemma polar_ball_subset_closed_ball_div {c : 𝕜} (hc : 1 < ‖c‖) {r : ℝ} (hr : 0 < r) :
  polar 𝕜 (ball (0 : E) r) ⊆ closed_ball (0 : dual 𝕜 E) (‖c‖ / r) :=
begin
  intros x' hx',
  rw mem_polar_iff at hx',
  simp only [polar, mem_set_of_eq, mem_closed_ball_zero_iff, mem_ball_zero_iff] at *,
  have hcr : 0 < ‖c‖ / r, from div_pos (zero_lt_one.trans hc) hr,
  refine continuous_linear_map.op_norm_le_of_shell hr hcr.le hc (λ x h₁ h₂, _),
  calc ‖x' x‖ ≤ 1 : hx' _ h₂
  ... ≤ (‖c‖ / r) * ‖x‖ : (inv_pos_le_iff_one_le_mul' hcr).1 (by rwa inv_div)
end

variables (𝕜)

lemma closed_ball_inv_subset_polar_closed_ball {r : ℝ} :
  closed_ball (0 : dual 𝕜 E) r⁻¹ ⊆ polar 𝕜 (closed_ball (0 : E) r) :=
λ x' hx' x hx,
calc ‖x' x‖ ≤ ‖x'‖ * ‖x‖ : x'.le_op_norm x
... ≤ r⁻¹ * r :
  mul_le_mul (mem_closed_ball_zero_iff.1 hx') (mem_closed_ball_zero_iff.1 hx)
    (norm_nonneg _) (dist_nonneg.trans hx')
... = r / r : inv_mul_eq_div _ _
... ≤ 1 : div_self_le_one r

/-- The `polar` of closed ball in a normed space `E` is the closed ball of the dual with
inverse radius. -/
lemma polar_closed_ball {𝕜 E : Type*} [is_R_or_C 𝕜] [normed_add_comm_group E] [normed_space 𝕜 E]
  {r : ℝ} (hr : 0 < r) :
  polar 𝕜 (closed_ball (0 : E) r) = closed_ball (0 : dual 𝕜 E) r⁻¹ :=
begin
  refine subset.antisymm _ (closed_ball_inv_subset_polar_closed_ball _),
  intros x' h,
  simp only [mem_closed_ball_zero_iff],
  refine continuous_linear_map.op_norm_le_of_ball hr (inv_nonneg.mpr hr.le) (λ z hz, _),
  simpa only [one_div] using linear_map.bound_of_ball_bound' hr 1 x'.to_linear_map h z
end

/-- Given a neighborhood `s` of the origin in a normed space `E`, the dual norms
of all elements of the polar `polar 𝕜 s` are bounded by a constant. -/
lemma bounded_polar_of_mem_nhds_zero {s : set E} (s_nhd : s ∈ 𝓝 (0 : E)) :
  bounded (polar 𝕜 s) :=
begin
  obtain ⟨a, ha⟩ : ∃ a : 𝕜, 1 < ‖a‖ := normed_field.exists_one_lt_norm 𝕜,
  obtain ⟨r, r_pos, r_ball⟩ : ∃ (r : ℝ) (hr : 0 < r), ball 0 r ⊆ s :=
    metric.mem_nhds_iff.1 s_nhd,
  exact bounded_closed_ball.mono (((dual_pairing 𝕜 E).flip.polar_antitone r_ball).trans $
    polar_ball_subset_closed_ball_div ha r_pos)
end

end polar_sets

end normed_space