/-
Copyright (c) 2021 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Yury Kudryashov
-/
import data.fintype.lattice
import data.finset.sigma

/-!
# Induction principles for `Π i, finset (α i)`

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

In this file we prove a few induction principles for functions `Π i : ι, finset (α i)` defined on a
finite type.

* `finset.induction_on_pi` is a generic lemma that requires only `[finite ι]`, `[decidable_eq ι]`,
  and `[Π i, decidable_eq (α i)]`; this version can be seen as a direct generalization of
  `finset.induction_on`.

* `finset.induction_on_pi_max` and `finset.induction_on_pi_min`: generalizations of
  `finset.induction_on_max`; these versions require `Π i, linear_order (α i)` but assume
  `∀ y ∈ g i, y < x` and `∀ y ∈ g i, x < y` respectively in the induction step.

## Tags
finite set, finite type, induction, function
-/

open function

variables {ι : Type*} {α : ι → Type*} [finite ι] [decidable_eq ι] [Π i, decidable_eq (α i)]

namespace finset

/-- General theorem for `finset.induction_on_pi`-style induction principles. -/
lemma induction_on_pi_of_choice (r : Π i, α i → finset (α i) → Prop)
  (H_ex : ∀ i (s : finset (α i)) (hs : s.nonempty), ∃ x ∈ s, r i x (s.erase x))
  {p : (Π i, finset (α i)) → Prop} (f : Π i, finset (α i)) (h0 : p (λ _, ∅))
  (step : ∀ (g : Π i, finset (α i)) (i : ι) (x : α i),
    r i x (g i) → p g → p (update g i (insert x (g i)))) :
  p f :=
begin
  casesI nonempty_fintype ι,
  induction hs : univ.sigma f using finset.strong_induction_on with s ihs generalizing f, subst s,
  cases eq_empty_or_nonempty (univ.sigma f) with he hne,
  { convert h0, simpa [funext_iff] using he },
  { rcases sigma_nonempty.1 hne with ⟨i, -, hi⟩,
    rcases H_ex i (f i) hi with ⟨x, x_mem, hr⟩,
    set g := update f i ((f i).erase x) with hg, clear_value g,
    have hx' : x ∉ g i, by { rw [hg, update_same], apply not_mem_erase },
    obtain rfl : f = update g i (insert x (g i)),
      by rw [hg, update_idem, update_same, insert_erase x_mem, update_eq_self],
    clear hg, rw [update_same, erase_insert hx'] at hr,
    refine step _ _ _ hr (ihs (univ.sigma g) _ _ rfl),
    rw ssubset_iff_of_subset (sigma_mono (subset.refl _) _),
    exacts [⟨⟨i, x⟩, mem_sigma.2 ⟨mem_univ _, by simp⟩, by simp [hx']⟩,
      (@le_update_iff _ _ _ _ g g i _).2 ⟨subset_insert _ _, λ _ _, le_rfl⟩] }
end

/-- Given a predicate on functions `Π i, finset (α i)` defined on a finite type, it is true on all
maps provided that it is true on `λ _, ∅` and for any function `g : Π i, finset (α i)`, an index
`i : ι`, and `x ∉ g i`, `p g` implies `p (update g i (insert x (g i)))`.

See also `finset.induction_on_pi_max` and `finset.induction_on_pi_min` for specialized versions
that require `Π i, linear_order (α i)`.  -/
lemma induction_on_pi {p : (Π i, finset (α i)) → Prop} (f : Π i, finset (α i)) (h0 : p (λ _, ∅))
  (step : ∀ (g : Π i, finset (α i)) (i : ι) (x : α i) (hx : x ∉ g i),
    p g → p (update g i (insert x (g i)))) :
  p f :=
induction_on_pi_of_choice (λ i x s, x ∉ s) (λ i s ⟨x, hx⟩, ⟨x, hx, not_mem_erase x s⟩) f h0 step

/-- Given a predicate on functions `Π i, finset (α i)` defined on a finite type, it is true on all
maps provided that it is true on `λ _, ∅` and for any function `g : Π i, finset (α i)`, an index
`i : ι`, and an element`x : α i` that is strictly greater than all elements of `g i`, `p g` implies
`p (update g i (insert x (g i)))`.

This lemma requires `linear_order` instances on all `α i`. See also `finset.induction_on_pi` for a
version that `x ∉ g i` instead of ` does not need `Π i, linear_order (α i)`. -/
lemma induction_on_pi_max [Π i, linear_order (α i)] {p : (Π i, finset (α i)) → Prop}
  (f : Π i, finset (α i)) (h0 : p (λ _, ∅))
  (step : ∀ (g : Π i, finset (α i)) (i : ι) (x : α i),
    (∀ y ∈ g i, y < x) → p g → p (update g i (insert x (g i)))) :
  p f :=
induction_on_pi_of_choice (λ i x s, ∀ y ∈ s, y < x)
  (λ i s hs, ⟨s.max' hs, s.max'_mem hs, λ y, s.lt_max'_of_mem_erase_max' _⟩) f h0 step

/-- Given a predicate on functions `Π i, finset (α i)` defined on a finite type, it is true on all
maps provided that it is true on `λ _, ∅` and for any function `g : Π i, finset (α i)`, an index
`i : ι`, and an element`x : α i` that is strictly less than all elements of `g i`, `p g` implies
`p (update g i (insert x (g i)))`.

This lemma requires `linear_order` instances on all `α i`. See also `finset.induction_on_pi` for a
version that `x ∉ g i` instead of ` does not need `Π i, linear_order (α i)`. -/
lemma induction_on_pi_min [Π i, linear_order (α i)] {p : (Π i, finset (α i)) → Prop}
  (f : Π i, finset (α i)) (h0 : p (λ _, ∅))
  (step : ∀ (g : Π i, finset (α i)) (i : ι) (x : α i),
    (∀ y ∈ g i, x < y) → p g → p (update g i (insert x (g i)))) :
  p f :=
@induction_on_pi_max ι (λ i, (α i)ᵒᵈ) _ _ _ _ _ _ h0 step

end finset


/-
Copyright (c) 2020 Yury Kudryashov. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon, Patrick Massot, Yury Kudryashov
-/
import algebra.group.hom
import data.equiv.mul_add
import data.prod
import algebra.opposites

/-!
# Monoid, group etc structures on `M × N`

In this file we define one-binop (`monoid`, `group` etc) structures on `M × N`. We also prove
trivial `simp` lemmas, and define the following operations on `monoid_hom`s:

* `fst M N : M × N →* M`, `snd M N : M × N →* N`: projections `prod.fst` and `prod.snd`
  as `monoid_hom`s;
* `inl M N : M →* M × N`, `inr M N : N →* M × N`: inclusions of first/second monoid
  into the product;
* `f.prod g : `M →* N × P`: sends `x` to `(f x, g x)`;
* `f.coprod g : M × N →* P`: sends `(x, y)` to `f x * g y`;
* `f.prod_map g : M × N → M' × N'`: `prod.map f g` as a `monoid_hom`,
  sends `(x, y)` to `(f x, g y)`.
-/

variables {A : Type*} {B : Type*} {G : Type*} {H : Type*} {M : Type*} {N : Type*} {P : Type*}

namespace prod

@[to_additive]
instance [has_mul M] [has_mul N] : has_mul (M × N) := ⟨λ p q, ⟨p.1 * q.1, p.2 * q.2⟩⟩

@[simp, to_additive]
lemma fst_mul [has_mul M] [has_mul N] (p q : M × N) : (p * q).1 = p.1 * q.1 := rfl
@[simp, to_additive]
lemma snd_mul [has_mul M] [has_mul N] (p q : M × N) : (p * q).2 = p.2 * q.2 := rfl
@[simp, to_additive]
lemma mk_mul_mk [has_mul M] [has_mul N] (a₁ a₂ : M) (b₁ b₂ : N) :
  (a₁, b₁) * (a₂, b₂) = (a₁ * a₂, b₁ * b₂) := rfl

@[to_additive]
instance [has_one M] [has_one N] : has_one (M × N) := ⟨(1, 1)⟩

@[simp, to_additive]
lemma fst_one [has_one M] [has_one N] : (1 : M × N).1 = 1 := rfl
@[simp, to_additive]
lemma snd_one [has_one M] [has_one N] : (1 : M × N).2 = 1 := rfl
@[to_additive]
lemma one_eq_mk [has_one M] [has_one N] : (1 : M × N) = (1, 1) := rfl
@[simp, to_additive]
lemma mk_eq_one [has_one M] [has_one N] {x : M} {y : N} : (x, y) = 1 ↔ x = 1 ∧ y = 1 :=
mk.inj_iff

@[to_additive]
lemma fst_mul_snd [mul_one_class M] [mul_one_class N] (p : M × N) :
  (p.fst, 1) * (1, p.snd) = p :=
ext (mul_one p.1) (one_mul p.2)

@[to_additive]
instance [has_inv M] [has_inv N] : has_inv (M × N) := ⟨λp, (p.1⁻¹, p.2⁻¹)⟩

@[simp, to_additive]
lemma fst_inv [has_inv G] [has_inv H] (p : G × H) : (p⁻¹).1 = (p.1)⁻¹ := rfl
@[simp, to_additive]
lemma snd_inv [has_inv G] [has_inv H] (p : G × H) : (p⁻¹).2 = (p.2)⁻¹ := rfl
@[simp, to_additive]
lemma inv_mk [has_inv G] [has_inv H] (a : G) (b : H) : (a, b)⁻¹ = (a⁻¹, b⁻¹) := rfl

@[to_additive]
instance [has_div M] [has_div N] : has_div (M × N) := ⟨λ p q, ⟨p.1 / q.1, p.2 / q.2⟩⟩

@[simp] lemma fst_sub [add_group A] [add_group B] (a b : A × B) : (a - b).1 = a.1 - b.1 := rfl
@[simp] lemma snd_sub [add_group A] [add_group B] (a b : A × B) : (a - b).2 = a.2 - b.2 := rfl
@[simp] lemma mk_sub_mk [add_group A] [add_group B] (x₁ x₂ : A) (y₁ y₂ : B) :
(x₁, y₁) - (x₂, y₂) = (x₁ - x₂, y₁ - y₂) := rfl

instance [mul_zero_class M] [mul_zero_class N] : mul_zero_class (M × N) :=
{ zero_mul := assume a, prod.rec_on a $ λa b, mk.inj_iff.mpr ⟨zero_mul _, zero_mul _⟩,
  mul_zero := assume a, prod.rec_on a $ λa b, mk.inj_iff.mpr ⟨mul_zero _, mul_zero _⟩,
  .. prod.has_zero, .. prod.has_mul }

@[to_additive]
instance [semigroup M] [semigroup N] : semigroup (M × N) :=
{ mul_assoc := assume a b c, mk.inj_iff.mpr ⟨mul_assoc _ _ _, mul_assoc _ _ _⟩,
  .. prod.has_mul }

instance [semigroup_with_zero M] [semigroup_with_zero N] : semigroup_with_zero (M × N) :=
{ .. prod.mul_zero_class, .. prod.semigroup }

@[to_additive]
instance [mul_one_class M] [mul_one_class N] : mul_one_class (M × N) :=
{ one_mul := assume a, prod.rec_on a $ λa b, mk.inj_iff.mpr ⟨one_mul _, one_mul _⟩,
  mul_one := assume a, prod.rec_on a $ λa b, mk.inj_iff.mpr ⟨mul_one _, mul_one _⟩,
  .. prod.has_mul, .. prod.has_one }

@[to_additive]
instance [monoid M] [monoid N] : monoid (M × N) :=
{ .. prod.semigroup, .. prod.mul_one_class }

@[to_additive]
instance [group G] [group H] : group (G × H) :=
{ mul_left_inv := assume a, mk.inj_iff.mpr ⟨mul_left_inv _, mul_left_inv _⟩,
  div_eq_mul_inv := λ a b, mk.inj_iff.mpr ⟨div_eq_mul_inv _ _, div_eq_mul_inv _ _⟩,
  .. prod.monoid, .. prod.has_inv, .. prod.has_div }

@[to_additive]
instance [comm_semigroup G] [comm_semigroup H] : comm_semigroup (G × H) :=
{ mul_comm := assume a b, mk.inj_iff.mpr ⟨mul_comm _ _, mul_comm _ _⟩,
  .. prod.semigroup }

@[to_additive]
instance [left_cancel_semigroup G] [left_cancel_semigroup H] :
  left_cancel_semigroup (G × H) :=
{ mul_left_cancel := λ a b c h, prod.ext (mul_left_cancel (prod.ext_iff.1 h).1)
    (mul_left_cancel (prod.ext_iff.1 h).2),
  .. prod.semigroup }

@[to_additive]
instance [right_cancel_semigroup G] [right_cancel_semigroup H] :
  right_cancel_semigroup (G × H) :=
{ mul_right_cancel := λ a b c h, prod.ext (mul_right_cancel (prod.ext_iff.1 h).1)
    (mul_right_cancel (prod.ext_iff.1 h).2),
  .. prod.semigroup }

@[to_additive]
instance [left_cancel_monoid M] [left_cancel_monoid N] : left_cancel_monoid (M × N) :=
{ .. prod.left_cancel_semigroup, .. prod.monoid }

@[to_additive]
instance [right_cancel_monoid M] [right_cancel_monoid N] : right_cancel_monoid (M × N) :=
{ .. prod.right_cancel_semigroup, .. prod.monoid }

@[to_additive]
instance [cancel_monoid M] [cancel_monoid N] : cancel_monoid (M × N) :=
{ .. prod.right_cancel_monoid, .. prod.left_cancel_monoid }

@[to_additive]
instance [comm_monoid M] [comm_monoid N] : comm_monoid (M × N) :=
{ .. prod.comm_semigroup, .. prod.monoid }

@[to_additive]
instance [cancel_comm_monoid M] [cancel_comm_monoid N] : cancel_comm_monoid (M × N) :=
{ .. prod.left_cancel_monoid, .. prod.comm_monoid }

instance [mul_zero_one_class M] [mul_zero_one_class N] : mul_zero_one_class (M × N) :=
{ .. prod.mul_zero_class, .. prod.mul_one_class }

instance [monoid_with_zero M] [monoid_with_zero N] : monoid_with_zero (M × N) :=
{ .. prod.monoid, .. prod.mul_zero_one_class }

instance [comm_monoid_with_zero M] [comm_monoid_with_zero N] : comm_monoid_with_zero (M × N) :=
{ .. prod.comm_monoid, .. prod.monoid_with_zero }

@[to_additive]
instance [comm_group G] [comm_group H] : comm_group (G × H) :=
{ .. prod.comm_semigroup, .. prod.group }

end prod

namespace monoid_hom

variables (M N) [mul_one_class M] [mul_one_class N]

/-- Given monoids `M`, `N`, the natural projection homomorphism from `M × N` to `M`.-/
@[to_additive "Given additive monoids `A`, `B`, the natural projection homomorphism
from `A × B` to `A`"]
def fst : M × N →* M := ⟨prod.fst, rfl, λ _ _, rfl⟩

/-- Given monoids `M`, `N`, the natural projection homomorphism from `M × N` to `N`.-/
@[to_additive "Given additive monoids `A`, `B`, the natural projection homomorphism
from `A × B` to `B`"]
def snd : M × N →* N := ⟨prod.snd, rfl, λ _ _, rfl⟩

/-- Given monoids `M`, `N`, the natural inclusion homomorphism from `M` to `M × N`. -/
@[to_additive "Given additive monoids `A`, `B`, the natural inclusion homomorphism
from `A` to `A × B`."]
def inl : M →* M × N :=
⟨λ x, (x, 1), rfl, λ _ _, prod.ext rfl (one_mul 1).symm⟩

/-- Given monoids `M`, `N`, the natural inclusion homomorphism from `N` to `M × N`. -/
@[to_additive "Given additive monoids `A`, `B`, the natural inclusion homomorphism
from `B` to `A × B`."]
def inr : N →* M × N :=
⟨λ y, (1, y), rfl, λ _ _, prod.ext (one_mul 1).symm rfl⟩

variables {M N}

@[simp, to_additive] lemma coe_fst : ⇑(fst M N) = prod.fst := rfl
@[simp, to_additive] lemma coe_snd : ⇑(snd M N) = prod.snd := rfl

@[simp, to_additive] lemma inl_apply (x) : inl M N x = (x, 1) := rfl
@[simp, to_additive] lemma inr_apply (y) : inr M N y = (1, y) := rfl

@[simp, to_additive] lemma fst_comp_inl : (fst M N).comp (inl M N) = id M := rfl
@[simp, to_additive] lemma snd_comp_inl : (snd M N).comp (inl M N) = 1 := rfl
@[simp, to_additive] lemma fst_comp_inr : (fst M N).comp (inr M N) = 1 := rfl
@[simp, to_additive] lemma snd_comp_inr : (snd M N).comp (inr M N) = id N := rfl

section prod

variable [mul_one_class P]

/-- Combine two `monoid_hom`s `f : M →* N`, `g : M →* P` into `f.prod g : M →* N × P`
given by `(f.prod g) x = (f x, g x)` -/
@[to_additive prod "Combine two `add_monoid_hom`s `f : M →+ N`, `g : M →+ P` into
`f.prod g : M →+ N × P` given by `(f.prod g) x = (f x, g x)`"]
protected def prod (f : M →* N) (g : M →* P) : M →* N × P :=
{ to_fun := λ x, (f x, g x),
  map_one' := prod.ext f.map_one g.map_one,
  map_mul' := λ x y, prod.ext (f.map_mul x y) (g.map_mul x y) }

@[simp, to_additive prod_apply]

@[simp, to_additive fst_comp_prod]
lemma fst_comp_prod (f : M →* N) (g : M →* P) : (fst N P).comp (f.prod g) = f :=
ext $ λ x, rfl

@[simp, to_additive snd_comp_prod]
lemma snd_comp_prod (f : M →* N) (g : M →* P) : (snd N P).comp (f.prod g) = g :=
ext $ λ x, rfl

@[simp, to_additive prod_unique]
lemma prod_unique (f : M →* N × P) :
  ((fst N P).comp f).prod ((snd N P).comp f) = f :=
ext $ λ x, by simp only [prod_apply, coe_fst, coe_snd, comp_apply, prod.mk.eta]

end prod

section prod_map

variables {M' : Type*} {N' : Type*} [mul_one_class M'] [mul_one_class N'] [mul_one_class P]
  (f : M →* M') (g : N →* N')

/-- `prod.map` as a `monoid_hom`. -/
@[to_additive prod_map "`prod.map` as an `add_monoid_hom`"]
def prod_map : M × N →* M' × N' := (f.comp (fst M N)).prod (g.comp (snd M N))

@[to_additive prod_map_def]
lemma prod_map_def : prod_map f g = (f.comp (fst M N)).prod (g.comp (snd M N)) := rfl

@[simp, to_additive coe_prod_map]
lemma coe_prod_map : ⇑(prod_map f g) = prod.map f g := rfl

@[to_additive prod_comp_prod_map]
lemma prod_comp_prod_map (f : P →* M) (g : P →* N) (f' : M →* M') (g' : N →* N') :
  (f'.prod_map g').comp (f.prod g) = (f'.comp f).prod (g'.comp g) :=
rfl

end prod_map

section coprod

variables [comm_monoid P] (f : M →* P) (g : N →* P)

/-- Coproduct of two `monoid_hom`s with the same codomain:
`f.coprod g (p : M × N) = f p.1 * g p.2`. -/
@[to_additive "Coproduct of two `add_monoid_hom`s with the same codomain:
`f.coprod g (p : M × N) = f p.1 + g p.2`."]
def coprod : M × N →* P := f.comp (fst M N) * g.comp (snd M N)

@[simp, to_additive]
lemma coprod_apply (p : M × N) : f.coprod g p = f p.1 * g p.2 := rfl

@[simp, to_additive]
lemma coprod_comp_inl : (f.coprod g).comp (inl M N) = f :=
ext $ λ x, by simp [coprod_apply]

@[simp, to_additive]
lemma coprod_comp_inr : (f.coprod g).comp (inr M N) = g :=
ext $ λ x, by simp [coprod_apply]

@[simp, to_additive] lemma coprod_unique (f : M × N →* P) :
  (f.comp (inl M N)).coprod (f.comp (inr M N)) = f :=
ext $ λ x, by simp [coprod_apply, inl_apply, inr_apply, ← map_mul]

@[simp, to_additive] lemma coprod_inl_inr {M N : Type*} [comm_monoid M] [comm_monoid N] :
  (inl M N).coprod (inr M N) = id (M × N) :=
coprod_unique (id $ M × N)

lemma comp_coprod {Q : Type*} [comm_monoid Q] (h : P →* Q) (f : M →* P) (g : N →* P) :
  h.comp (f.coprod g) = (h.comp f).coprod (h.comp g) :=
ext $ λ x, by simp

end coprod

end monoid_hom

namespace mul_equiv

section
variables {M N} [mul_one_class M] [mul_one_class N]

/-- The equivalence between `M × N` and `N × M` given by swapping the components
is multiplicative. -/
@[to_additive prod_comm "The equivalence between `M × N` and `N × M` given by swapping the
components is additive."]
def prod_comm : M × N ≃* N × M :=
{ map_mul' := λ ⟨x₁, y₁⟩ ⟨x₂, y₂⟩, rfl, ..equiv.prod_comm M N }

@[simp, to_additive coe_prod_comm] lemma coe_prod_comm :
  ⇑(prod_comm : M × N ≃* N × M) = prod.swap := rfl

@[simp, to_additive coe_prod_comm_symm] lemma coe_prod_comm_symm :
  ⇑((prod_comm : M × N ≃* N × M).symm) = prod.swap := rfl

end

section
variables {M N} [monoid M] [monoid N]

/-- The monoid equivalence between units of a product of two monoids, and the product of the
    units of each monoid. -/
@[to_additive prod_add_units "The additive monoid equivalence between additive units of a product
of two additive monoids, and the product of the additive units of each additive monoid."]
def prod_units : units (M × N) ≃* units M × units N :=
{ to_fun := (units.map (monoid_hom.fst M N)).prod (units.map (monoid_hom.snd M N)),
  inv_fun := λ u, ⟨(u.1, u.2), (↑u.1⁻¹, ↑u.2⁻¹), by simp, by simp⟩,
  left_inv := λ u, by simp,
  right_inv := λ ⟨u₁, u₂⟩, by simp [units.map],
  map_mul' := monoid_hom.map_mul _ }

end

end mul_equiv

section units

open opposite

/-- Canonical homomorphism of monoids from `units α` into `α × αᵒᵖ`.
Used mainly to define the natural topology of `units α`. -/
def embed_product (α : Type*) [monoid α] : units α →* α × αᵒᵖ :=
{ to_fun := λ x, ⟨x, op ↑x⁻¹⟩,
  map_one' := by simp only [one_inv, eq_self_iff_true, units.coe_one, op_one, prod.mk_eq_one,
    and_self],
  map_mul' := λ x y, by simp only [mul_inv_rev, op_mul, units.coe_mul, prod.mk_mul_mk] }

end units


/-
Copyright (c) 2018 Jeremy Avigad. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Jeremy Avigad

Multivariate quotients of polynomial functors.
-/
import ..mvpfunctor.W
universe u

class mvqpf {n : ℕ} (F : typevec.{u} n → Type*) [mvfunctor F] :=
(P         : mvpfunctor.{u} n)
(abs       : Π {α}, P.apply α → F α)
(repr'     : Π {α}, F α → P.apply α)
(abs_repr' : ∀ {α} (x : F α), abs (repr' x) = x)
(abs_map   : ∀ {α β} (f : α ⟹ β) (p : P.apply α), abs (f <$$> p) = f <$$> abs p)

namespace mvqpf
variables {n : ℕ} {F : typevec.{u} n → Type*} [mvfunctor F] [q : mvqpf F]
include q
open mvfunctor (liftp liftr)

def repr {α : typevec n} (x : F α) := repr' n x

theorem abs_repr {α : typevec n} (x : F α) : abs (repr x) = x :=
abs_repr' n x

/-
Show that every mvqpf is a lawful mvfunctor.
-/

theorem id_map {α : typevec n} (x : F α) : typevec.id <$$> x = x :=
by { rw ←abs_repr x, cases repr x with a f, rw [←abs_map], reflexivity }

theorem comp_map {α β γ : typevec n} (f : α ⟹ β) (g : β ⟹ γ) (x : F α) :
  (g ⊚ f) <$$> x = g <$$> f <$$> x :=
by { rw ←abs_repr x, cases repr x with a f, rw [←abs_map, ←abs_map, ←abs_map], reflexivity }

instance is_lawful_mvfunctor : mvfunctor.is_lawful F :=
{ id_map := @id_map n F _ _,
  comp_map := @comp_map n F _ _ }

/- Lifting predicates and relations -/

theorem liftp_iff {α : typevec n} (p : Π ⦃i⦄, α i → Prop) (x : F α) :
  liftp p x ↔ ∃ a f, x = abs ⟨a, f⟩ ∧ ∀ i j, p (f i j) :=
begin
  split,
  { rintros ⟨y, hy⟩, cases h : repr y with a f,
    use [a, λ i j, (f i j).val], split,
    { rw [←hy, ←abs_repr y, h, ←abs_map], reflexivity },
    intros i j, apply (f i j).property },
  rintros ⟨a, f, h₀, h₁⟩, dsimp at *,
  use abs (⟨a, λ i j, ⟨f i j, h₁ i j⟩⟩),
  rw [←abs_map, h₀], reflexivity
end

theorem liftr_iff {α : typevec n} (r : Π ⦃i⦄, α i → α i → Prop) (x y : F α) :
  liftr r x y ↔ ∃ a f₀ f₁, x = abs ⟨a, f₀⟩ ∧ y = abs ⟨a, f₁⟩ ∧ ∀ i j, r (f₀ i j) (f₁ i j) :=
begin
  split,
  { rintros ⟨u, xeq, yeq⟩, cases h : repr u with a f,
    use [a, λ i j, (f i j).val.fst, λ i j, (f i j).val.snd],
    split, { rw [←xeq, ←abs_repr u, h, ←abs_map], refl },
    split, { rw [←yeq, ←abs_repr u, h, ←abs_map], refl },
    intros i j, exact (f i j).property },
  rintros ⟨a, f₀, f₁, xeq, yeq, h⟩,
  use abs ⟨a, λ i j, ⟨(f₀ i j, f₁ i j), h i j⟩⟩,
  dsimp, split,
  { rw [xeq, ←abs_map], refl },
  rw [yeq, ←abs_map], refl
end

end mvqpf


/-
Copyright (c) 2017 Johannes Hölzl. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Johannes Hölzl, Mario Carneiro, Yury Kudryashov
-/
import topology.algebra.ordered.basic
import order.liminf_limsup

/-!
# Lemmas about liminf and limsup in an order topology.
-/

open filter
open_locale topological_space classical

universes u v
variables {α : Type u} {β : Type v}

section liminf_limsup

section order_closed_topology
variables [semilattice_sup α] [topological_space α] [order_topology α]

lemma is_bounded_le_nhds (a : α) : (𝓝 a).is_bounded (≤) :=
match forall_le_or_exists_lt_sup a with
| or.inl h := ⟨a, eventually_of_forall h⟩
| or.inr ⟨b, hb⟩ := ⟨b, ge_mem_nhds hb⟩
end

lemma filter.tendsto.is_bounded_under_le {f : filter β} {u : β → α} {a : α}
  (h : tendsto u f (𝓝 a)) : f.is_bounded_under (≤) u :=
(is_bounded_le_nhds a).mono h

lemma filter.tendsto.bdd_above_range_of_cofinite {u : β → α} {a : α}
  (h : tendsto u cofinite (𝓝 a)) : bdd_above (set.range u) :=
h.is_bounded_under_le.bdd_above_range_of_cofinite

lemma filter.tendsto.bdd_above_range {u : ℕ → α} {a : α}
  (h : tendsto u at_top (𝓝 a)) : bdd_above (set.range u) :=
h.is_bounded_under_le.bdd_above_range

lemma is_cobounded_ge_nhds (a : α) : (𝓝 a).is_cobounded (≥) :=
(is_bounded_le_nhds a).is_cobounded_flip

lemma filter.tendsto.is_cobounded_under_ge {f : filter β} {u : β → α} {a : α}
  [ne_bot f] (h : tendsto u f (𝓝 a)) : f.is_cobounded_under (≥) u :=
h.is_bounded_under_le.is_cobounded_flip

end order_closed_topology

section order_closed_topology
variables [semilattice_inf α] [topological_space α] [order_topology α]

lemma is_bounded_ge_nhds (a : α) : (𝓝 a).is_bounded (≥) :=
@is_bounded_le_nhds (order_dual α) _ _ _ a

lemma filter.tendsto.is_bounded_under_ge {f : filter β} {u : β → α} {a : α}
  (h : tendsto u f (𝓝 a)) : f.is_bounded_under (≥) u :=
(is_bounded_ge_nhds a).mono h

lemma filter.tendsto.bdd_below_range_of_cofinite {u : β → α} {a : α}
  (h : tendsto u cofinite (𝓝 a)) : bdd_below (set.range u) :=
h.is_bounded_under_ge.bdd_below_range_of_cofinite

lemma filter.tendsto.bdd_below_range {u : ℕ → α} {a : α}
  (h : tendsto u at_top (𝓝 a)) : bdd_below (set.range u) :=
h.is_bounded_under_ge.bdd_below_range

lemma is_cobounded_le_nhds (a : α) : (𝓝 a).is_cobounded (≤) :=
(is_bounded_ge_nhds a).is_cobounded_flip

lemma filter.tendsto.is_cobounded_under_le {f : filter β} {u : β → α} {a : α}
  [ne_bot f] (h : tendsto u f (𝓝 a)) : f.is_cobounded_under (≤) u :=
h.is_bounded_under_ge.is_cobounded_flip

end order_closed_topology

section conditionally_complete_linear_order
variables [conditionally_complete_linear_order α]

theorem lt_mem_sets_of_Limsup_lt {f : filter α} {b} (h : f.is_bounded (≤)) (l : f.Limsup < b) :
  ∀ᶠ a in f, a < b :=
let ⟨c, (h : ∀ᶠ a in f, a ≤ c), hcb⟩ := exists_lt_of_cInf_lt h l in
mem_of_superset h $ assume a hac, lt_of_le_of_lt hac hcb

theorem gt_mem_sets_of_Liminf_gt : ∀ {f : filter α} {b}, f.is_bounded (≥) → b < f.Liminf →
  ∀ᶠ a in f, b < a :=
@lt_mem_sets_of_Limsup_lt (order_dual α) _

variables [topological_space α] [order_topology α]

/-- If the liminf and the limsup of a filter coincide, then this filter converges to
their common value, at least if the filter is eventually bounded above and below. -/
theorem le_nhds_of_Limsup_eq_Liminf {f : filter α} {a : α}
  (hl : f.is_bounded (≤)) (hg : f.is_bounded (≥)) (hs : f.Limsup = a) (hi : f.Liminf = a) :
  f ≤ 𝓝 a :=
tendsto_order.2 $ and.intro
  (assume b hb, gt_mem_sets_of_Liminf_gt hg $ hi.symm ▸ hb)
  (assume b hb, lt_mem_sets_of_Limsup_lt hl $ hs.symm ▸ hb)

theorem Limsup_nhds (a : α) : Limsup (𝓝 a) = a :=
cInf_eq_of_forall_ge_of_forall_gt_exists_lt (is_bounded_le_nhds a)
  (assume a' (h : {n : α | n ≤ a'} ∈ 𝓝 a), show a ≤ a', from @mem_of_mem_nhds α _ a _ h)
  (assume b (hba : a < b), show ∃c (h : {n : α | n ≤ c} ∈ 𝓝 a), c < b, from
    match dense_or_discrete a b with
    | or.inl ⟨c, hac, hcb⟩ := ⟨c, ge_mem_nhds hac, hcb⟩
    | or.inr ⟨_, h⟩        := ⟨a, (𝓝 a).sets_of_superset (gt_mem_nhds hba) h, hba⟩
    end)

theorem Liminf_nhds : ∀ (a : α), Liminf (𝓝 a) = a :=
@Limsup_nhds (order_dual α) _ _ _

/-- If a filter is converging, its limsup coincides with its limit. -/
theorem Liminf_eq_of_le_nhds {f : filter α} {a : α} [ne_bot f] (h : f ≤ 𝓝 a) : f.Liminf = a :=
have hb_ge : is_bounded (≥) f, from (is_bounded_ge_nhds a).mono h,
have hb_le : is_bounded (≤) f, from (is_bounded_le_nhds a).mono h,
le_antisymm
  (calc f.Liminf ≤ f.Limsup : Liminf_le_Limsup hb_le hb_ge
    ... ≤ (𝓝 a).Limsup :
      Limsup_le_Limsup_of_le h hb_ge.is_cobounded_flip (is_bounded_le_nhds a)
    ... = a : Limsup_nhds a)
  (calc a = (𝓝 a).Liminf : (Liminf_nhds a).symm
    ... ≤ f.Liminf :
      Liminf_le_Liminf_of_le h (is_bounded_ge_nhds a) hb_le.is_cobounded_flip)

/-- If a filter is converging, its liminf coincides with its limit. -/
theorem Limsup_eq_of_le_nhds : ∀ {f : filter α} {a : α} [ne_bot f], f ≤ 𝓝 a → f.Limsup = a :=
@Liminf_eq_of_le_nhds (order_dual α) _ _ _

/-- If a function has a limit, then its limsup coincides with its limit. -/
theorem filter.tendsto.limsup_eq {f : filter β} {u : β → α} {a : α} [ne_bot f]
  (h : tendsto u f (𝓝 a)) : limsup f u = a :=
Limsup_eq_of_le_nhds h

/-- If a function has a limit, then its liminf coincides with its limit. -/
theorem filter.tendsto.liminf_eq {f : filter β} {u : β → α} {a : α} [ne_bot f]
  (h : tendsto u f (𝓝 a)) : liminf f u = a :=
Liminf_eq_of_le_nhds h

/-- If the liminf and the limsup of a function coincide, then the limit of the function
exists and has the same value -/
theorem tendsto_of_liminf_eq_limsup {f : filter β} {u : β → α} {a : α}
  (hinf : liminf f u = a) (hsup : limsup f u = a)
  (h : f.is_bounded_under (≤) u . is_bounded_default)
  (h' : f.is_bounded_under (≥) u . is_bounded_default) :
  tendsto u f (𝓝 a) :=
le_nhds_of_Limsup_eq_Liminf h h' hsup hinf

/-- If a number `a` is less than or equal to the `liminf` of a function `f` at some filter
and is greater than or equal to the `limsup` of `f`, then `f` tends to `a` along this filter. -/
theorem tendsto_of_le_liminf_of_limsup_le {f : filter β} {u : β → α} {a : α}
  (hinf : a ≤ liminf f u) (hsup : limsup f u ≤ a)
  (h : f.is_bounded_under (≤) u . is_bounded_default)
  (h' : f.is_bounded_under (≥) u . is_bounded_default) :
  tendsto u f (𝓝 a) :=
if hf : f = ⊥ then hf.symm ▸ tendsto_bot
else by haveI : ne_bot f := ⟨hf⟩; exact tendsto_of_liminf_eq_limsup
  (le_antisymm (le_trans (liminf_le_limsup h h') hsup) hinf)
  (le_antisymm hsup (le_trans hinf (liminf_le_limsup h h'))) h h'

/-- Assume that, for any `a < b`, a sequence can not be infinitely many times below `a` and
above `b`. If it is also ultimately bounded above and below, then it has to converge. This even
works if `a` and `b` are restricted to a dense subset.
-/
lemma tendsto_of_no_upcrossings [densely_ordered α]
  {f : filter β} {u : β → α} {s : set α} (hs : dense s)
  (H : ∀ (a ∈ s) (b ∈ s), a < b → ¬((∃ᶠ n in f, u n < a) ∧ (∃ᶠ n in f, b < u n)))
  (h : f.is_bounded_under (≤) u . is_bounded_default)
  (h' : f.is_bounded_under (≥) u . is_bounded_default) :
  ∃ (c : α), tendsto u f (𝓝 c) :=
begin
  by_cases hbot : f = ⊥, { rw hbot, exact ⟨Inf ∅, tendsto_bot⟩ },
  haveI : ne_bot f := ⟨hbot⟩,
  refine ⟨limsup f u, _⟩,
  apply tendsto_of_le_liminf_of_limsup_le _ le_rfl h h',
  by_contra hlt,
  push_neg at hlt,
  obtain ⟨a, ⟨⟨la, au⟩, as⟩⟩ : ∃ a, (f.liminf u < a ∧ a < f.limsup u) ∧ a ∈ s :=
    dense_iff_inter_open.1 hs (set.Ioo (f.liminf u) (f.limsup u)) is_open_Ioo
    (set.nonempty_Ioo.2 hlt),
  obtain ⟨b, ⟨⟨ab, bu⟩, bs⟩⟩ : ∃ b, (a < b ∧ b < f.limsup u) ∧ b ∈ s :=
    dense_iff_inter_open.1 hs (set.Ioo a (f.limsup u)) is_open_Ioo
    (set.nonempty_Ioo.2 au),
  have A : ∃ᶠ n in f, u n < a :=
    frequently_lt_of_liminf_lt (is_bounded.is_cobounded_ge h) la,
  have B : ∃ᶠ n in f, b < u n :=
    frequently_lt_of_lt_limsup (is_bounded.is_cobounded_le h') bu,
  exact H a as b bs ab ⟨A, B⟩,
end

end conditionally_complete_linear_order

end liminf_limsup


/-
Copyright (c) 2021 Rémy Degenne. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Rémy Degenne
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.measure_theory.measure_space
import Mathlib.order.filter.ennreal
import Mathlib.PostPort

universes u_1 u_2 u_3

namespace Mathlib

/-!
# Essential supremum and infimum
We define the essential supremum and infimum of a function `f : α → β` with respect to a measure
`μ` on `α`. The essential supremum is the infimum of the constants `c : β` such that `f x ≤ c`
almost everywhere.

TODO: The essential supremum of functions `α → ennreal` is used in particular to define the norm in
the `L∞` space (see measure_theory/lp_space.lean).

There is a different quantity which is sometimes also called essential supremum: the least
upper-bound among measurable functions of a family of measurable functions (in an almost-everywhere
sense). We do not define that quantity here, which is simply the supremum of a map with values in
`α →ₘ[μ] β` (see measure_theory/ae_eq_fun.lean).

## Main definitions

* `ess_sup f μ := μ.ae.limsup f`
* `ess_inf f μ := μ.ae.liminf f`
-/

/-- Essential supremum of `f` with respect to measure `μ`: the smallest `c : β` such that
`f x ≤ c` a.e. -/
def ess_sup {α : Type u_1} {β : Type u_2} [measurable_space α] [conditionally_complete_lattice β] (f : α → β) (μ : measure_theory.measure α) : β :=
  filter.limsup (measure_theory.measure.ae μ) f

/-- Essential infimum of `f` with respect to measure `μ`: the greatest `c : β` such that
`c ≤ f x` a.e. -/
def ess_inf {α : Type u_1} {β : Type u_2} [measurable_space α] [conditionally_complete_lattice β] (f : α → β) (μ : measure_theory.measure α) : β :=
  filter.liminf (measure_theory.measure.ae μ) f

theorem ess_sup_congr_ae {α : Type u_1} {β : Type u_2} [measurable_space α] {μ : measure_theory.measure α} [conditionally_complete_lattice β] {f : α → β} {g : α → β} (hfg : filter.eventually_eq (measure_theory.measure.ae μ) f g) : ess_sup f μ = ess_sup g μ :=
  filter.limsup_congr hfg

theorem ess_inf_congr_ae {α : Type u_1} {β : Type u_2} [measurable_space α] {μ : measure_theory.measure α} [conditionally_complete_lattice β] {f : α → β} {g : α → β} (hfg : filter.eventually_eq (measure_theory.measure.ae μ) f g) : ess_inf f μ = ess_inf g μ :=
  ess_sup_congr_ae hfg

@[simp] theorem ess_sup_measure_zero {α : Type u_1} {β : Type u_2} [measurable_space α] [complete_lattice β] {f : α → β} : ess_sup f 0 = ⊥ := sorry

@[simp] theorem ess_inf_measure_zero {α : Type u_1} {β : Type u_2} [measurable_space α] [complete_lattice β] {f : α → β} : ess_inf f 0 = ⊤ :=
  ess_sup_measure_zero

theorem ess_sup_mono_ae {α : Type u_1} {β : Type u_2} [measurable_space α] {μ : measure_theory.measure α} [complete_lattice β] {f : α → β} {g : α → β} (hfg : filter.eventually_le (measure_theory.measure.ae μ) f g) : ess_sup f μ ≤ ess_sup g μ :=
  filter.limsup_le_limsup hfg

theorem ess_inf_mono_ae {α : Type u_1} {β : Type u_2} [measurable_space α] {μ : measure_theory.measure α} [complete_lattice β] {f : α → β} {g : α → β} (hfg : filter.eventually_le (measure_theory.measure.ae μ) f g) : ess_inf f μ ≤ ess_inf g μ :=
  filter.liminf_le_liminf hfg

theorem ess_sup_const {α : Type u_1} {β : Type u_2} [measurable_space α] {μ : measure_theory.measure α} [complete_lattice β] (c : β) (hμ : μ ≠ 0) : ess_sup (fun (x : α) => c) μ = c :=
  filter.limsup_const c

theorem ess_inf_const {α : Type u_1} {β : Type u_2} [measurable_space α] {μ : measure_theory.measure α} [complete_lattice β] (c : β) (hμ : μ ≠ 0) : ess_inf (fun (x : α) => c) μ = c :=
  ess_sup_const c hμ

theorem ess_sup_const_bot {α : Type u_1} {β : Type u_2} [measurable_space α] {μ : measure_theory.measure α} [complete_lattice β] : ess_sup (fun (x : α) => ⊥) μ = ⊥ :=
  filter.limsup_const_bot

theorem ess_inf_const_top {α : Type u_1} {β : Type u_2} [measurable_space α] {μ : measure_theory.measure α} [complete_lattice β] : ess_inf (fun (x : α) => ⊤) μ = ⊤ :=
  filter.liminf_const_top

theorem order_iso.ess_sup_apply {α : Type u_1} {β : Type u_2} [measurable_space α] [complete_lattice β] {γ : Type u_3} [complete_lattice γ] (f : α → β) (μ : measure_theory.measure α) (g : β ≃o γ) : coe_fn g (ess_sup f μ) = ess_sup (fun (x : α) => coe_fn g (f x)) μ :=
  order_iso.limsup_apply g

theorem order_iso.ess_inf_apply {α : Type u_1} {β : Type u_2} [measurable_space α] [complete_lattice β] {γ : Type u_3} [complete_lattice γ] (f : α → β) (μ : measure_theory.measure α) (g : β ≃o γ) : coe_fn g (ess_inf f μ) = ess_inf (fun (x : α) => coe_fn g (f x)) μ :=
  order_iso.ess_sup_apply f μ (order_iso.dual g)

theorem ae_lt_of_ess_sup_lt {α : Type u_1} {β : Type u_2} [measurable_space α] {μ : measure_theory.measure α} [complete_linear_order β] {f : α → β} {x : β} (hf : ess_sup f μ < x) : filter.eventually (fun (y : α) => f y < x) (measure_theory.measure.ae μ) :=
  filter.eventually_lt_of_limsup_lt hf

theorem ae_lt_of_lt_ess_inf {α : Type u_1} {β : Type u_2} [measurable_space α] {μ : measure_theory.measure α} [complete_linear_order β] {f : α → β} {x : β} (hf : x < ess_inf f μ) : filter.eventually (fun (y : α) => x < f y) (measure_theory.measure.ae μ) :=
  ae_lt_of_ess_sup_lt hf

namespace ennreal

theorem ae_le_ess_sup {α : Type u_1} [measurable_space α] {μ : measure_theory.measure α} (f : α → ennreal) : filter.eventually (fun (y : α) => f y ≤ ess_sup f μ) (measure_theory.measure.ae μ) :=
  eventually_le_limsup f

theorem ess_sup_eq_zero_iff {α : Type u_1} [measurable_space α] {μ : measure_theory.measure α} {f : α → ennreal} : ess_sup f μ = 0 ↔ filter.eventually_eq (measure_theory.measure.ae μ) f 0 :=
  limsup_eq_zero_iff

theorem ess_sup_const_mul {α : Type u_1} [measurable_space α] {μ : measure_theory.measure α} {f : α → ennreal} {a : ennreal} : ess_sup (fun (x : α) => a * f x) μ = a * ess_sup f μ :=
  limsup_const_mul

theorem ess_sup_add_le {α : Type u_1} [measurable_space α] {μ : measure_theory.measure α} (f : α → ennreal) (g : α → ennreal) : ess_sup (f + g) μ ≤ ess_sup f μ + ess_sup g μ :=
  limsup_add_le f g


import week_8.Part_B_H0
import group_theory.quotient_group

/-

# A crash course in H¹(G,M)

We stick to the conventions that `G` is a group (or even
a monoid, we never use inversion) and that `M` is a `G`-module,
that is, an additive abelian group with a `G`-action.

A key concept here is that of a cocycle, or a twisted homomorphism.
These things were later renamed 1-cocycles when people realised that higher
cocycles existed; today whenever I say "cocycle" I mean 1-cocycle).
A cocycle is a function `f : G → M` satisfying the axiom
`∀ (g h : G), f (g * h) = f g + g • f h`. These things
naturally form an abelian group under pointwise addition
and negation, by which I mean "operate on the target":
`(f₁ + f₂) g = f₁ g + f₂ g`.

Let `Z1 G M` denote the abelian group of cocycles.
There is a subgroup `B1 G M` of coboundaries, consisting
of the functions `f` for which there exists `m : M`
such that `f g = g • m - m` (note that it is at this point where we
crucially use the fact that `M` is an abelian group and not just an abelian
monoid). One easily checks that all coboundaries are cocycles, and that
coboundaries are a subgroup (you will be doing this below). The
quotient group `H1 G M`, written `H¹(G,M)` by mathematicians, is the main
definition in this file. The first two theorems we shall prove about it here
are that it is functorial (i.e. a map `φ : M →+[G] N` gives
rise to a map `φ.H1_hom : H1 G M →+ H1 G N`), and exact in the
middle (i.e. if `0 → A → B → C → 0` is a short exact sequence
of `G`-modules then the sequence `H1 G A →+ H1 G B →+ H1 G C`
is exact).

Further work would be to verify "inf-res", otherwise known
as the beginning of the long exact
sequence of terms of low degree in the Hochschild-Serre
spectral sequence for group cohomology (i.e.
`0 → H¹(G/N, Aᴺ) → H¹(G, A) → H¹(N, A)` ) and of course one
could go on to define n-cocycles and n-coboundaries (please
get in touch if you're interested in doing this -- I have
ideas about how to set it all up) and to
construct the Hochschild-Serre spectral sequence itself.
I have no doubt that these kinds of results could be turned
into a research paper.

Let's start with a definition of `H1 G M`. First we need
to define cocycles and coboundaries.
-/

-- 1-cocycles as an additive subgroup of the group `Hom(G,M)`
-- a.k.a. `G → M` of functions from `G` to `M`, with group
-- law induced from `M`.
def Z1_subgroup (G M : Type)
  [monoid G] [add_comm_group M] [distrib_mul_action G M] : add_subgroup (G → M) :=
{ carrier := { f : G → M | ∀ (g h : G), f (g * h) = f g + g • f h },
  zero_mem' := begin
    -- the zero map is a cocycle
    sorry
  end,
  add_mem' := begin
    sorry,
  end,
  neg_mem' := begin
    sorry,
  end }

-- Just like `H0 G M`, we promote this term to a type
structure Z1 (G M : Type)
  [monoid G] [add_comm_group M] [distrib_mul_action G M] : Type :=
(to_fun : G → M)
(is_cocycle : ∀ (g h : G), to_fun (g * h) = to_fun g + g • to_fun h)

-- This is a definition so we need to make an API
namespace Z1

-- let G be a group (or a monoid) and let M be a G-module.
variables {G M : Type}
  [monoid G] [add_comm_group M] [distrib_mul_action G M]

-- add a coercion from a cocycle to the function G → M
instance : has_coe_to_fun (Z1 G M) :=
{ F := λ _, G → M,
  coe := to_fun }

@[simp] lemma coe_apply (to_fun : G → M)
  (is_cocycle : ∀ (g h : G), to_fun (g * h) = to_fun g + g • to_fun h) (g : G) :
({ to_fun := to_fun, is_cocycle := is_cocycle } : Z1 G M) g = to_fun g := rfl

-- add a specification for the coercion

lemma spec (a : Z1 G M) : ∀ (g h : G), a (g * h) = a g + g • a h :=
-- this is the last time we'll see `a.is_cocycle`: we'll
-- use `a.spec` from now on because it applies to `⇑a` and not `a.to_fun`.
a.is_cocycle

-- add an extensionality lemma
@[ext] lemma ext (a b : Z1 G M) (h : ∀ g, a g = b g) : a = b :=
begin
  cases a, cases b, simp, ext g, exact h g,
end

-- can you prove addition of two cocycles is a cocycle
def add (a b : Z1 G M) : Z1 G M :=
{ to_fun := λ g, a g + b g,
  is_cocycle
 := begin
   sorry,
  end }

instance : has_add (Z1 G M) := ⟨add⟩

@[simp] lemma coe_add (a b : Z1 G M) (g : G) : (a + b) g = a g + b g := rfl

-- the zero cocycle is a cocycle
def zero : Z1 G M :=
{ to_fun := λ g, 0,
  is_cocycle
 := begin
    sorry,
  end
}

instance : has_zero (Z1 G M) := ⟨zero⟩

@[simp] lemma coe_zero (g : G) : (0 : Z1 G M) g = 0 := rfl

-- negation of a cocycle is a cocycle
def neg (a : Z1 G M) : Z1 G M :=
{ to_fun := λ g, -(a g),
  is_cocycle
 := begin
   sorry
  end
}

instance : has_neg (Z1 G M) := ⟨neg⟩

@[simp] lemma coe_neg (a : Z1 G M) (g : G) : (-a) g = -(a g) := rfl

def sub (a b : Z1 G M) : Z1 G M := a + -b

instance : has_sub (Z1 G M) := ⟨sub⟩

-- make the cocycles into a group
instance : add_comm_group (Z1 G M) :=
begin
  refine_struct {
    add := (+),
    zero := (0 : Z1 G M),
    neg := has_neg.neg,
    sub := has_sub.sub,
    -- ignore this, we have to fill in this proof for technical reasons
    sub_eq_add_neg := λ _ _, rfl };
  -- we now have five goals. Let's use the semicolon trick to work on
  -- all of them at once. I'll show you what happens to the proof
  -- of associativity, the others are the same mutatis mutandis
  -- (but harder to see)
  -- *TODO* could documentstring commutativity and remark that
  -- they can see associativity using the cursor.
  -- ⊢ ∀ (a b c : Z1 G M), a + b + c = a + (b + c)
  intros;
  -- ⊢ a + b + c = a + (b + c)
  ext;
  -- ⊢ ⇑(a + b + c) g = ⇑(a + (b + c)) g
  simp;
  -- ⊢ ⇑a g + ⇑b g + ⇑c g = ⇑a g + (⇑b g + ⇑c g)
  abel
  -- general additive abelian group tactic which solves
  -- goals which are (absolute) identities in every abelian group.
  -- Hypotheses are not looked at though. See Chris Hughes' forthcoming
  -- Imperial MSc thesis for a new group theory tactic which is to `abel`
  -- what `nlinarith` is to `ring`.
end

end Z1

namespace distrib_mul_action_hom

-- The Z1 construction is functorial in the module `M`. Let's construct
-- the relevant function, showing that if `φ : M →+[G] N` then
-- composition induces an additive group homomorphism `Z1 G M → Z1 G N`.
-- Just like `H0` we first define the auxiliary bare function,
-- and then beef it up to an abelian group homomorphism.

variables {G M N : Type} [monoid G]
  [add_comm_group M] [distrib_mul_action G M]
  [add_comm_group N] [distrib_mul_action G N]

def Z1_hom_underlying_function (φ : M →+[G] N) (f : Z1 G M) : Z1 G N :=
⟨λ g, φ (f g), begin
  -- need to prove that this function obtained by composing the cocycle
  -- f with the G-module homomorphism φ is also a cocycle.
  sorry
end⟩

@[norm_cast]
lemma Z1_hom_underlying_function_coe_comp (φ : M →+[G] N) (f : Z1 G M) (g : G) :
  (Z1_hom_underlying_function φ f g : N) = φ (f g) := rfl

def Z1 (φ : M →+[G] N) : Z1 G M →+ Z1 G N :=
-- to make a term of type `X →+ Y` (a group homomorphism) from a function
-- `f : X → Y` and
-- a proof that it preserves addition we use the following constructor:
add_monoid_hom.mk'
-- We now throw in the bare function
(Z1_hom_underlying_function φ)
-- (or could try direct definition:)
-- (λ f, ⟨λ g, φ (f g), begin
--   -- need to prove that this function obtained by composing the cocycle
--   -- f with the G-module homomorphism φ is also a cocycle.
--   intros g h,
--   rw ←φ.map_smul,
--   rw f.spec,
--   simp,
-- end⟩)
-- and now the proof that it preserves addition
begin
  intros e f,
  ext g,
  simp [φ.Z1_hom_underlying_function_coe_comp],
end

-- it's a functor
variables {P : Type} [add_comm_group P] [distrib_mul_action G P]

def map_comp (φ: M →+[G] N) (ψ : N →+[G] P) (z : _root_.Z1 G M) :
  (ψ.Z1) ((φ.Z1) z) = (ψ ∘ᵍ φ).Z1 z :=
begin
  -- what do you think?
  sorry
end

@[simp] lemma Z1_spec (φ : M →+[G] N) (a : _root_.Z1 G M) (g : G) :
  φ.Z1 a g = φ (a g) := rfl

@[simp] lemma Z1_spec' (φ : M →+[G] N) (a : _root_.Z1 G M) (g : G) :
  (φ.Z1 a : G → N) = ((φ : M → N) ∘ a) := rfl

end distrib_mul_action_hom

section cochain_map

variables (G M : Type) [monoid G] [add_comm_group M]
  [distrib_mul_action G M]

def cochain_map : M →+ Z1 G M :=
{ to_fun := λ m, { to_fun := λ g, g • m - m, is_cocycle := begin
  simp [mul_smul, smul_sub],
end},
  map_zero' := begin
    sorry
  end,
  map_add' := begin
    sorry,
  end }

@[simp] lemma cochain_map_apply (m : M) (g : G) :
  cochain_map G M m g = g • m - m := rfl

end cochain_map

-- question : do we have cokernels? If A B are abelian groups and
-- `f : A → B` is a group hom, how do I make the type coker f`

-- Lean has inbuilt quotients of additive abelian groups by subgroups
-- so we just take the quotient by the range
@[derive add_comm_group]
def H1 (G M : Type) [monoid G] [add_comm_group M]
  [distrib_mul_action G M] : Type :=
quotient_add_group.quotient ((cochain_map G M).range)
--quotient_add_group.quotient (B1 G M)

section quotient_stuff

variables {G M : Type} [monoid G] [add_comm_group M]
  [distrib_mul_action G M]

def Z1.quotient : Z1 G M →+ H1 G M :=
quotient_add_group.mk' _

lemma ab_H1.ker_quotient : (Z1.quotient).ker = (cochain_map G M).range :=
quotient_add_group.ker_mk _

end quotient_stuff

namespace H1

variables {G M : Type} [monoid G] [add_comm_group M]
  [distrib_mul_action G M]

@[elab_as_eliminator]
def induction_on {p : H1 G M → Prop}
  (IH : ∀ z : Z1 G M, p (z.quotient)) (h : H1 G M) : p h :=
quot.induction_on h IH

end H1

/-
We have just defined `H1 G M` as a quotient group, and told Lean
to figure out (or "derive") the obvious abelian group structure
on it, which it did.

If you want to go any further, check out the `ideas` directory.

In there we show that if `φ : M →+[G] N` is a `G`-module
hom then `φ` induces a map `H1 G M → H1 G N`. To prove this we will
need to figure out how to define maps from and to quotient group structures.
Just like last week, this is simply a matter of learning the API for the
definition `quotient_add_group.quotient`.

-/


import topology.subset_properties

variables (X Y : Type) [topological_space X] [topological_space Y] (f : X → Y)

open filter set

open_locale filter -- for 𝓟
open_locale topological_space -- for 𝓝

/-

## Neighbourhood filters

If `α` is a topological space and `a : α` then `𝓝 a` is the following
filter on `α`: `X ∈ 𝓝 a` if and only if `X` contains an open neighbourhood
of `a`, or equivalently if `a` is in the interior of `X`. You should think
of `𝓝 a` as the "generalised subset" of `X` corresponding to an infinitesimally
small open neighbourhood of `a`.

Let's use the API for interior and closure, and check that `𝓝 a` is a filter.

Useful stuff from the topological space API:
`interior_univ : interior univ = univ`
`mem_univ x : x ∈ univ`
`interior_mono : s ⊆ t → interior s ⊆ interior t`
and guess what this is called:
`??? : interior (s ∩ t) = interior s ∩ interior t`
If you don't know how to #check your guess, ask me!
-/

variables {α : Type*} [topological_space α]

open set

-- neighbourhood filter 𝓝 a on α
example (a : α): filter α :=
{ sets := {X : set α | a ∈ interior X},
  univ_sets := begin
    sorry,
  end,
  sets_of_superset := begin
    sorry,
  end,
  inter_sets := begin
    sorry,
  end }

/-

## Cluster points.

A cluster point `a : α` of a filter `F : filter α` on a topological
space should be thought of as a point in the closure of the "generalised set"
corresponding to `F`. Here's the formal definition.

A cluster point of a filter `F : filter α` (also known as an accumulation
point or a limit point) is `x : α` such that `𝓝 x ⊓ F ≠ ⊥`. The picture
is that the intersection of the generalised set `F` and the infinitesimal
open neighbourhood `𝓝 x` of `x` is nonempty, or in other words that `x`
is in some kind of "closure" of `F`. Let's go through the notation more carefully
though, to try and figure out what it means. Recall that the order on filters is
upside-down, so `𝓝 x ⊓ F` means the filter generated by `F` and the
neighbourhoods of `x`, and `⊥` is the filter which contains every subset.
So this boils down to saying that there do not exist sets `A ∈ 𝓝 x` and `B ∈ F`
such that `A ∩ B = ∅`, or, in other words, every element of the filter
intersects every neighbourhood of `x`. To give an example, if `S` is any subset
of `α` then the cluster points of `𝓟 S` are just the points `x` such that any
open set containing `x` meets `S`, or equivalently that `x` is in the
closure of `S`.

The below lemma is called `cluster_pt.mono` in mathlib. The picture is
that if `F` and `G` are generalised subsets of a topological space
and `F ⊆ G`, then `closure F ⊆ closure G`. You can prove it by
using `cluster_pt.mono` of course, but why not give a direct proof
yourself? Start by rewriting `cluster_pt_iff`, which translates down
the definition of `cluster_pt` to a purely set-theoretic one not
involving `⊓`.

-/

example {x : α} {F G : filter α} (hxF : cluster_pt x F) (hFG : F ≤ G) :
  cluster_pt x G :=
begin
  sorry,
end

/-

## Compactness

The actual definition of `is_compact` in mathlib: A subset `S` of a topological
space `α` is *compact* if for every filter `F ≠ ⊥` such that `S ∈ F`,
there exists `a : α` such that every set of `F` also meets every
neighborhood of `a`. In pictures -- `S` is compact iff the closure of every
non-empty generalised subset `F ⊆ S` contains an element of `S`. I'm not
too sure this picture helps much (at least, it doesn't help me too much).
Somehow noncompactness results in generalised subsets which are
"on the boundary of `S`" but which don't intersect a small neighbourhood of
any elements of `S`. Perhaps it's best not to worry about this exotic
definition right now -- or perhaps one of you can explain it to me. Of course
it's equivalent to the usual definition of compactness, but we won't prove this.

So here is another proof that a closed subset of a compact space is compact.
As before, we prove the more general assertion that if `α` is any topological
space then the intersection of a compact subset of `α` and a closed subset
of `α` is a compact subset of `α`.

Here's the actual definition in mathlib:

`def is_compact (s : set α) := ∀ ⦃f⦄ [ne_bot f], f ≤ 𝓟 s → ∃a∈s, cluster_pt a f`

Note that `ne_bot f` is in square brackets, which means that the type
class inference system is supposed to supply it. We will explicitly
add this fact into the type class inference system with `haveI` below.

Now here's a suggestion for a proof. Say `S` is compact and `C` is closed.
Say `F` is a non-bot filter with `F ≤ 𝓟 (S ∩ C)`.
First show that by compactness of `S`, we can find a cluster point
`a` for `F` in `S`. Now show that this cluster point is in `C` too,
because `C` is closed. You might find

`is_closed.closure_eq : is_closed C → closure C = C`

useful, and also

`mem_closure_iff_cluster_pt : a ∈ closure S ↔ cluster_pt a (𝓟 S)`

-/

lemma closed_of_compact (S : set X) (hS : is_compact S)
  (C : set X) (hC : is_closed C) : is_compact (S ∩ C) :=
begin
  -- assume `F` is a filter which is not `⊥`, and `≤` is the principal
  -- filter on `S ∩ C` (i.e. which contains `S ∩ C`). We need to find a
  -- cluster point for `F` which is in `S ∩ C`.
  intros F hnF hFSC,
  -- Let's tell the type class inference system about `hnf : f.ne_bot`
  haveI := hnF,
  -- see if you can take it from here.
  sorry,
end


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

! This file was ported from Lean 3 source module analysis.normed_space.basic
! leanprover-community/mathlib commit d3af0609f6db8691dffdc3e1fb7feb7da72698f2
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Algebra.Pi
import Mathbin.Algebra.Algebra.RestrictScalars
import Mathbin.Analysis.Normed.Field.Basic
import Mathbin.Data.Real.Sqrt
import Mathbin.Topology.Algebra.Module.Basic

/-!
# Normed spaces

In this file we define (semi)normed spaces and algebras. We also prove some theorems
about these definitions.
-/

variable {α : Type _} {β : Type _} {γ : Type _} {ι : Type _}

open Filter Metric Function Set

open Topology BigOperators NNReal ENNReal uniformity Pointwise

section SeminormedAddCommGroup

section Prio

/- ./././Mathport/Syntax/Translate/Basic.lean:334:40: warning: unsupported option extends_priority -/
set_option extends_priority 920

-- Here, we set a rather high priority for the instance `[normed_space α β] : module α β`
-- to take precedence over `semiring.to_module` as this leads to instance paths with better
-- unification properties.
/-- A normed space over a normed field is a vector space endowed with a norm which satisfies the
equality `‖c • x‖ = ‖c‖ ‖x‖`. We require only `‖c • x‖ ≤ ‖c‖ ‖x‖` in the definition, then prove
`‖c • x‖ = ‖c‖ ‖x‖` in `norm_smul`.

Note that since this requires `seminormed_add_comm_group` and not `normed_add_comm_group`, this
typeclass can be used for "semi normed spaces" too, just as `module` can be used for
"semi modules". -/
class NormedSpace (α : Type _) (β : Type _) [NormedField α] [SeminormedAddCommGroup β] extends
  Module α β where
  norm_smul_le : ∀ (a : α) (b : β), ‖a • b‖ ≤ ‖a‖ * ‖b‖
#align normed_space NormedSpace

end Prio

variable [NormedField α] [SeminormedAddCommGroup β]

-- note: while these are currently strictly weaker than the versions without `le`, they will cease
-- to be if we eventually generalize `normed_space` from `normed_field α` to `normed_ring α`.
section Le

theorem norm_smul_le [NormedSpace α β] (r : α) (x : β) : ‖r • x‖ ≤ ‖r‖ * ‖x‖ :=
  NormedSpace.norm_smul_le _ _
#align norm_smul_le norm_smul_le

theorem nnnorm_smul_le [NormedSpace α β] (s : α) (x : β) : ‖s • x‖₊ ≤ ‖s‖₊ * ‖x‖₊ :=
  norm_smul_le s x
#align nnnorm_smul_le nnnorm_smul_le

theorem dist_smul_le [NormedSpace α β] (s : α) (x y : β) : dist (s • x) (s • y) ≤ ‖s‖ * dist x y :=
  by simpa only [dist_eq_norm, ← smul_sub] using norm_smul_le _ _
#align dist_smul_le dist_smul_le

theorem nndist_smul_le [NormedSpace α β] (s : α) (x y : β) :
    nndist (s • x) (s • y) ≤ ‖s‖₊ * nndist x y :=
  dist_smul_le s x y
#align nndist_smul_le nndist_smul_le

end Le

-- see Note [lower instance priority]
instance (priority := 100) NormedSpace.boundedSMul [NormedSpace α β] : BoundedSMul α β
    where
  dist_smul_pair' x y₁ y₂ := by simpa [dist_eq_norm, smul_sub] using norm_smul_le x (y₁ - y₂)
  dist_pair_smul' x₁ x₂ y := by simpa [dist_eq_norm, sub_smul] using norm_smul_le (x₁ - x₂) y
#align normed_space.has_bounded_smul NormedSpace.boundedSMul

-- Shortcut instance, as otherwise this will be found by `normed_space.to_module` and be
-- noncomputable.
instance : Module ℝ ℝ := by infer_instance

instance NormedField.toNormedSpace : NormedSpace α α where norm_smul_le a b := norm_mul_le a b
#align normed_field.to_normed_space NormedField.toNormedSpace

theorem norm_smul [NormedSpace α β] (s : α) (x : β) : ‖s • x‖ = ‖s‖ * ‖x‖ :=
  by
  by_cases h : s = 0
  · simp [h]
  · refine' le_antisymm (norm_smul_le s x) _
    calc
      ‖s‖ * ‖x‖ = ‖s‖ * ‖s⁻¹ • s • x‖ := by rw [inv_smul_smul₀ h]
      _ ≤ ‖s‖ * (‖s⁻¹‖ * ‖s • x‖) := (mul_le_mul_of_nonneg_left (norm_smul_le _ _) (norm_nonneg _))
      _ = ‖s • x‖ := by rw [norm_inv, ← mul_assoc, mul_inv_cancel (mt norm_eq_zero.1 h), one_mul]

#align norm_smul norm_smul

theorem norm_zsmul (α) [NormedField α] [NormedSpace α β] (n : ℤ) (x : β) :
    ‖n • x‖ = ‖(n : α)‖ * ‖x‖ := by rw [← norm_smul, ← Int.smul_one_eq_coe, smul_assoc, one_smul]
#align norm_zsmul norm_zsmul

@[simp]
theorem abs_norm_eq_norm (z : β) : |‖z‖| = ‖z‖ :=
  (abs_eq (norm_nonneg z)).mpr (Or.inl rfl)
#align abs_norm_eq_norm abs_norm_eq_norm

theorem inv_norm_smul_mem_closed_unit_ball [NormedSpace ℝ β] (x : β) :
    ‖x‖⁻¹ • x ∈ closedBall (0 : β) 1 := by
  simp only [mem_closedBall_zero_iff, norm_smul, norm_inv, norm_norm, ← div_eq_inv_mul,
    div_self_le_one]
#align inv_norm_smul_mem_closed_unit_ball inv_norm_smul_mem_closed_unit_ball

theorem dist_smul₀ [NormedSpace α β] (s : α) (x y : β) : dist (s • x) (s • y) = ‖s‖ * dist x y := by
  simp only [dist_eq_norm, (norm_smul _ _).symm, smul_sub]
#align dist_smul₀ dist_smul₀

theorem nnnorm_smul [NormedSpace α β] (s : α) (x : β) : ‖s • x‖₊ = ‖s‖₊ * ‖x‖₊ :=
  NNReal.eq <| norm_smul s x
#align nnnorm_smul nnnorm_smul

theorem nndist_smul₀ [NormedSpace α β] (s : α) (x y : β) :
    nndist (s • x) (s • y) = ‖s‖₊ * nndist x y :=
  NNReal.eq <| dist_smul₀ s x y
#align nndist_smul₀ nndist_smul₀

theorem lipschitzWith_smul [NormedSpace α β] (s : α) : LipschitzWith ‖s‖₊ ((· • ·) s : β → β) :=
  lipschitzWith_iff_dist_le_mul.2 fun x y => by rw [dist_smul₀, coe_nnnorm]
#align lipschitz_with_smul lipschitzWith_smul

theorem norm_smul_of_nonneg [NormedSpace ℝ β] {t : ℝ} (ht : 0 ≤ t) (x : β) : ‖t • x‖ = t * ‖x‖ := by
  rw [norm_smul, Real.norm_eq_abs, abs_of_nonneg ht]
#align norm_smul_of_nonneg norm_smul_of_nonneg

variable {E : Type _} [SeminormedAddCommGroup E] [NormedSpace α E]

variable {F : Type _} [SeminormedAddCommGroup F] [NormedSpace α F]

theorem eventually_nhds_norm_smul_sub_lt (c : α) (x : E) {ε : ℝ} (h : 0 < ε) :
    ∀ᶠ y in 𝓝 x, ‖c • (y - x)‖ < ε :=
  have : Tendsto (fun y => ‖c • (y - x)‖) (𝓝 x) (𝓝 0) :=
    ((continuous_id.sub continuous_const).const_smul _).norm.tendsto' _ _ (by simp)
  this.Eventually (gt_mem_nhds h)
#align eventually_nhds_norm_smul_sub_lt eventually_nhds_norm_smul_sub_lt

theorem Filter.Tendsto.zero_smul_isBoundedUnder_le {f : ι → α} {g : ι → E} {l : Filter ι}
    (hf : Tendsto f l (𝓝 0)) (hg : IsBoundedUnder (· ≤ ·) l (norm ∘ g)) :
    Tendsto (fun x => f x • g x) l (𝓝 0) :=
  hf.op_zero_isBoundedUnder_le hg (· • ·) norm_smul_le
#align filter.tendsto.zero_smul_is_bounded_under_le Filter.Tendsto.zero_smul_isBoundedUnder_le

theorem Filter.IsBoundedUnder.smul_tendsto_zero {f : ι → α} {g : ι → E} {l : Filter ι}
    (hf : IsBoundedUnder (· ≤ ·) l (norm ∘ f)) (hg : Tendsto g l (𝓝 0)) :
    Tendsto (fun x => f x • g x) l (𝓝 0) :=
  hg.op_zero_isBoundedUnder_le hf (flip (· • ·)) fun x y =>
    (norm_smul_le y x).trans_eq (mul_comm _ _)
#align filter.is_bounded_under.smul_tendsto_zero Filter.IsBoundedUnder.smul_tendsto_zero

theorem closure_ball [NormedSpace ℝ E] (x : E) {r : ℝ} (hr : r ≠ 0) :
    closure (ball x r) = closedBall x r :=
  by
  refine' subset.antisymm closure_ball_subset_closed_ball fun y hy => _
  have : ContinuousWithinAt (fun c : ℝ => c • (y - x) + x) (Ico 0 1) 1 :=
    ((continuous_id.smul continuous_const).add continuous_const).ContinuousWithinAt
  convert this.mem_closure _ _
  · rw [one_smul, sub_add_cancel]
  · simp [closure_Ico zero_ne_one, zero_le_one]
  · rintro c ⟨hc0, hc1⟩
    rw [mem_ball, dist_eq_norm, add_sub_cancel, norm_smul, Real.norm_eq_abs, abs_of_nonneg hc0,
      mul_comm, ← mul_one r]
    rw [mem_closed_ball, dist_eq_norm] at hy
    replace hr : 0 < r
    exact ((norm_nonneg _).trans hy).lt_of_ne hr.symm
    apply mul_lt_mul' <;> assumption
#align closure_ball closure_ball

theorem frontier_ball [NormedSpace ℝ E] (x : E) {r : ℝ} (hr : r ≠ 0) :
    frontier (ball x r) = sphere x r :=
  by
  rw [frontier, closure_ball x hr, is_open_ball.interior_eq]
  ext x; exact (@eq_iff_le_not_lt ℝ _ _ _).symm
#align frontier_ball frontier_ball

theorem interior_closedBall [NormedSpace ℝ E] (x : E) {r : ℝ} (hr : r ≠ 0) :
    interior (closedBall x r) = ball x r :=
  by
  cases' hr.lt_or_lt with hr hr
  · rw [closed_ball_eq_empty.2 hr, ball_eq_empty.2 hr.le, interior_empty]
  refine' subset.antisymm _ ball_subset_interior_closed_ball
  intro y hy
  rcases(mem_closed_ball.1 <| interior_subset hy).lt_or_eq with (hr | rfl)
  · exact hr
  set f : ℝ → E := fun c : ℝ => c • (y - x) + x
  suffices f ⁻¹' closed_ball x (dist y x) ⊆ Icc (-1) 1
    by
    have hfc : Continuous f := (continuous_id.smul continuous_const).add continuous_const
    have hf1 : (1 : ℝ) ∈ f ⁻¹' interior (closed_ball x <| dist y x) := by simpa [f]
    have h1 : (1 : ℝ) ∈ interior (Icc (-1 : ℝ) 1) :=
      interior_mono this (preimage_interior_subset_interior_preimage hfc hf1)
    contrapose h1
    simp
  intro c hc
  rw [mem_Icc, ← abs_le, ← Real.norm_eq_abs, ← mul_le_mul_right hr]
  simpa [f, dist_eq_norm, norm_smul] using hc
#align interior_closed_ball interior_closedBall

theorem frontier_closedBall [NormedSpace ℝ E] (x : E) {r : ℝ} (hr : r ≠ 0) :
    frontier (closedBall x r) = sphere x r := by
  rw [frontier, closure_closed_ball, interior_closedBall x hr, closed_ball_diff_ball]
#align frontier_closed_ball frontier_closedBall

instance {E : Type _} [NormedAddCommGroup E] [NormedSpace ℚ E] (e : E) :
    DiscreteTopology <| AddSubgroup.zmultiples e :=
  by
  rcases eq_or_ne e 0 with (rfl | he)
  · rw [AddSubgroup.zmultiples_zero_eq_bot]
    infer_instance
  · rw [discreteTopology_iff_open_singleton_zero, isOpen_induced_iff]
    refine' ⟨Metric.ball 0 ‖e‖, Metric.isOpen_ball, _⟩
    ext ⟨x, hx⟩
    obtain ⟨k, rfl⟩ := add_subgroup.mem_zmultiples_iff.mp hx
    rw [mem_preimage, mem_ball_zero_iff, AddSubgroup.coe_mk, mem_singleton_iff, Subtype.ext_iff,
      AddSubgroup.coe_mk, AddSubgroup.coe_zero, norm_zsmul ℚ k e, Int.norm_cast_rat,
      Int.norm_eq_abs, ← Int.cast_abs, mul_lt_iff_lt_one_left (norm_pos_iff.mpr he), ←
      @Int.cast_one ℝ _, Int.cast_lt, Int.abs_lt_one_iff, smul_eq_zero, or_iff_left he]

/-- A (semi) normed real vector space is homeomorphic to the unit ball in the same space.
This homeomorphism sends `x : E` to `(1 + ‖x‖²)^(- ½) • x`.

In many cases the actual implementation is not important, so we don't mark the projection lemmas
`homeomorph_unit_ball_apply_coe` and `homeomorph_unit_ball_symm_apply` as `@[simp]`.

See also `cont_diff_homeomorph_unit_ball` and `cont_diff_on_homeomorph_unit_ball_symm` for
smoothness properties that hold when `E` is an inner-product space. -/
@[simps (config := { attrs := [] })]
noncomputable def homeomorphUnitBall [NormedSpace ℝ E] : E ≃ₜ ball (0 : E) 1
    where
  toFun x :=
    ⟨(1 + ‖x‖ ^ 2).sqrt⁻¹ • x, by
      have : 0 < 1 + ‖x‖ ^ 2 := by positivity
      rw [mem_ball_zero_iff, norm_smul, Real.norm_eq_abs, abs_inv, ← div_eq_inv_mul,
        div_lt_one (abs_pos.mpr <| real.sqrt_ne_zero'.mpr this), ← abs_norm_eq_norm x, ← sq_lt_sq,
        abs_norm_eq_norm, Real.sq_sqrt this.le]
      exact lt_one_add _⟩
  invFun y := (1 - ‖(y : E)‖ ^ 2).sqrt⁻¹ • (y : E)
  left_inv x := by
    field_simp [norm_smul, smul_smul, (zero_lt_one_add_norm_sq x).ne',
      Real.sq_sqrt (zero_lt_one_add_norm_sq x).le, ← Real.sqrt_div (zero_lt_one_add_norm_sq x).le]
  right_inv y :=
    by
    have : 0 < 1 - ‖(y : E)‖ ^ 2 := by
      nlinarith [norm_nonneg (y : E), (mem_ball_zero_iff.1 y.2 : ‖(y : E)‖ < 1)]
    field_simp [norm_smul, smul_smul, this.ne', Real.sq_sqrt this.le, ← Real.sqrt_div this.le]
  continuous_toFun := by
    suffices : Continuous fun x => (1 + ‖x‖ ^ 2).sqrt⁻¹;
    exact (this.smul continuous_id).subtype_mk _
    refine' Continuous.inv₀ _ fun x => real.sqrt_ne_zero'.mpr (by positivity)
    continuity
  continuous_invFun :=
    by
    suffices ∀ y : ball (0 : E) 1, (1 - ‖(y : E)‖ ^ 2).sqrt ≠ 0 by continuity
    intro y
    rw [Real.sqrt_ne_zero']
    nlinarith [norm_nonneg (y : E), (mem_ball_zero_iff.1 y.2 : ‖(y : E)‖ < 1)]
#align homeomorph_unit_ball homeomorphUnitBall

@[simp]
theorem coe_homeomorphUnitBall_apply_zero [NormedSpace ℝ E] :
    (homeomorphUnitBall (0 : E) : E) = 0 := by simp [homeomorphUnitBall]
#align coe_homeomorph_unit_ball_apply_zero coe_homeomorphUnitBall_apply_zero

open NormedField

instance : NormedSpace α (ULift E) :=
  { ULift.normedAddCommGroup, ULift.module' with
    norm_smul_le := fun s x => (norm_smul_le s x.down : _) }

/-- The product of two normed spaces is a normed space, with the sup norm. -/
instance Prod.normedSpace : NormedSpace α (E × F) :=
  { Prod.normedAddCommGroup, Prod.module with
    norm_smul_le := fun s x => by simp [Prod.norm_def, norm_smul_le, mul_max_of_nonneg] }
#align prod.normed_space Prod.normedSpace

/-- The product of finitely many normed spaces is a normed space, with the sup norm. -/
instance Pi.normedSpace {E : ι → Type _} [Fintype ι] [∀ i, SeminormedAddCommGroup (E i)]
    [∀ i, NormedSpace α (E i)] : NormedSpace α (∀ i, E i)
    where norm_smul_le a f :=
    by
    simp_rw [← coe_nnnorm, ← NNReal.coe_mul, NNReal.coe_le_coe, Pi.nnnorm_def,
      NNReal.mul_finset_sup]
    exact Finset.sup_mono_fun fun _ _ => norm_smul_le _ _
#align pi.normed_space Pi.normedSpace

instance MulOpposite.normedSpace : NormedSpace α Eᵐᵒᵖ :=
  { MulOpposite.normedAddCommGroup, MulOpposite.module _ with
    norm_smul_le := fun s x => norm_smul_le s x.unop }
#align mul_opposite.normed_space MulOpposite.normedSpace

/-- A subspace of a normed space is also a normed space, with the restriction of the norm. -/
instance Submodule.normedSpace {𝕜 R : Type _} [SMul 𝕜 R] [NormedField 𝕜] [Ring R] {E : Type _}
    [SeminormedAddCommGroup E] [NormedSpace 𝕜 E] [Module R E] [IsScalarTower 𝕜 R E]
    (s : Submodule R E) : NormedSpace 𝕜 s where norm_smul_le c x := norm_smul_le c (x : E)
#align submodule.normed_space Submodule.normedSpace

/-- If there is a scalar `c` with `‖c‖>1`, then any element with nonzero norm can be
moved by scalar multiplication to any shell of width `‖c‖`. Also recap information on the norm of
the rescaling element that shows up in applications. -/
theorem rescale_to_shell_semi_normed_zpow {c : α} (hc : 1 < ‖c‖) {ε : ℝ} (εpos : 0 < ε) {x : E}
    (hx : ‖x‖ ≠ 0) :
    ∃ n : ℤ, c ^ n ≠ 0 ∧ ‖c ^ n • x‖ < ε ∧ ε / ‖c‖ ≤ ‖c ^ n • x‖ ∧ ‖c ^ n‖⁻¹ ≤ ε⁻¹ * ‖c‖ * ‖x‖ :=
  by
  have xεpos : 0 < ‖x‖ / ε := div_pos ((Ne.symm hx).le_iff_lt.1 (norm_nonneg x)) εpos
  rcases exists_mem_Ico_zpow xεpos hc with ⟨n, hn⟩
  have cpos : 0 < ‖c‖ := lt_trans (zero_lt_one : (0 : ℝ) < 1) hc
  have cnpos : 0 < ‖c ^ (n + 1)‖ := by
    rw [norm_zpow]
    exact lt_trans xεpos hn.2
  refine' ⟨-(n + 1), _, _, _, _⟩
  show c ^ (-(n + 1)) ≠ 0; exact zpow_ne_zero _ (norm_pos_iff.1 cpos)
  show ‖c ^ (-(n + 1)) • x‖ < ε
  · rw [norm_smul, zpow_neg, norm_inv, ← div_eq_inv_mul, div_lt_iff cnpos, mul_comm, norm_zpow]
    exact (div_lt_iff εpos).1 hn.2
  show ε / ‖c‖ ≤ ‖c ^ (-(n + 1)) • x‖
  · rw [zpow_neg, div_le_iff cpos, norm_smul, norm_inv, norm_zpow, zpow_add₀ (ne_of_gt cpos),
      zpow_one, mul_inv_rev, mul_comm, ← mul_assoc, ← mul_assoc, mul_inv_cancel (ne_of_gt cpos),
      one_mul, ← div_eq_inv_mul, le_div_iff (zpow_pos_of_pos cpos _), mul_comm]
    exact (le_div_iff εpos).1 hn.1
  show ‖c ^ (-(n + 1))‖⁻¹ ≤ ε⁻¹ * ‖c‖ * ‖x‖
  · rw [zpow_neg, norm_inv, inv_inv, norm_zpow, zpow_add₀ cpos.ne', zpow_one, mul_right_comm, ←
      div_eq_inv_mul]
    exact mul_le_mul_of_nonneg_right hn.1 (norm_nonneg _)
#align rescale_to_shell_semi_normed_zpow rescale_to_shell_semi_normed_zpow

/-- If there is a scalar `c` with `‖c‖>1`, then any element with nonzero norm can be
moved by scalar multiplication to any shell of width `‖c‖`. Also recap information on the norm of
the rescaling element that shows up in applications. -/
theorem rescale_to_shell_semi_normed {c : α} (hc : 1 < ‖c‖) {ε : ℝ} (εpos : 0 < ε) {x : E}
    (hx : ‖x‖ ≠ 0) : ∃ d : α, d ≠ 0 ∧ ‖d • x‖ < ε ∧ ε / ‖c‖ ≤ ‖d • x‖ ∧ ‖d‖⁻¹ ≤ ε⁻¹ * ‖c‖ * ‖x‖ :=
  let ⟨n, hn⟩ := rescale_to_shell_semi_normed_zpow hc εpos hx
  ⟨_, hn⟩
#align rescale_to_shell_semi_normed rescale_to_shell_semi_normed

end SeminormedAddCommGroup

/-- A linear map from a `module` to a `normed_space` induces a `normed_space` structure on the
domain, using the `seminormed_add_comm_group.induced` norm.

See note [reducible non-instances] -/
@[reducible]
def NormedSpace.induced {F : Type _} (α β γ : Type _) [NormedField α] [AddCommGroup β] [Module α β]
    [SeminormedAddCommGroup γ] [NormedSpace α γ] [LinearMapClass F α β γ] (f : F) :
    @NormedSpace α β _ (SeminormedAddCommGroup.induced β γ f)
    where norm_smul_le a b := by
    unfold norm
    exact (map_smul f a b).symm ▸ norm_smul_le a (f b)
#align normed_space.induced NormedSpace.induced

section NormedAddCommGroup

variable [NormedField α]

variable {E : Type _} [NormedAddCommGroup E] [NormedSpace α E]

variable {F : Type _} [NormedAddCommGroup F] [NormedSpace α F]

open NormedField

/-- While this may appear identical to `normed_space.to_module`, it contains an implicit argument
involving `normed_add_comm_group.to_seminormed_add_comm_group` that typeclass inference has trouble
inferring.

Specifically, the following instance cannot be found without this `normed_space.to_module'`:
```lean
example
  (𝕜 ι : Type*) (E : ι → Type*)
  [normed_field 𝕜] [Π i, normed_add_comm_group (E i)] [Π i, normed_space 𝕜 (E i)] :
  Π i, module 𝕜 (E i) := by apply_instance
```

[This Zulip thread](https://leanprover.zulipchat.com/#narrow/stream/113488-general/topic/Typeclass.20resolution.20under.20binders/near/245151099)
gives some more context. -/
instance (priority := 100) NormedSpace.toModule' : Module α F :=
  NormedSpace.toModule
#align normed_space.to_module' NormedSpace.toModule'

section Surj

variable (E) [NormedSpace ℝ E] [Nontrivial E]

theorem exists_norm_eq {c : ℝ} (hc : 0 ≤ c) : ∃ x : E, ‖x‖ = c :=
  by
  rcases exists_ne (0 : E) with ⟨x, hx⟩
  rw [← norm_ne_zero_iff] at hx
  use c • ‖x‖⁻¹ • x
  simp [norm_smul, Real.norm_of_nonneg hc, hx]
#align exists_norm_eq exists_norm_eq

@[simp]
theorem range_norm : range (norm : E → ℝ) = Ici 0 :=
  Subset.antisymm (range_subset_iff.2 norm_nonneg) fun _ => exists_norm_eq E
#align range_norm range_norm

theorem nnnorm_surjective : Surjective (nnnorm : E → ℝ≥0) := fun c =>
  (exists_norm_eq E c.coe_nonneg).imp fun x h => NNReal.eq h
#align nnnorm_surjective nnnorm_surjective

@[simp]
theorem range_nnnorm : range (nnnorm : E → ℝ≥0) = univ :=
  (nnnorm_surjective E).range_eq
#align range_nnnorm range_nnnorm

end Surj

/-- If `E` is a nontrivial topological module over `ℝ`, then `E` has no isolated points.
This is a particular case of `module.punctured_nhds_ne_bot`. -/
instance Real.punctured_nhds_module_neBot {E : Type _} [AddCommGroup E] [TopologicalSpace E]
    [ContinuousAdd E] [Nontrivial E] [Module ℝ E] [ContinuousSMul ℝ E] (x : E) : NeBot (𝓝[≠] x) :=
  Module.punctured_nhds_neBot ℝ E x
#align real.punctured_nhds_module_ne_bot Real.punctured_nhds_module_neBot

theorem interior_closed_ball' [NormedSpace ℝ E] [Nontrivial E] (x : E) (r : ℝ) :
    interior (closedBall x r) = ball x r :=
  by
  rcases eq_or_ne r 0 with (rfl | hr)
  · rw [closed_ball_zero, ball_zero, interior_singleton]
  · exact interior_closedBall x hr
#align interior_closed_ball' interior_closed_ball'

theorem frontier_closed_ball' [NormedSpace ℝ E] [Nontrivial E] (x : E) (r : ℝ) :
    frontier (closedBall x r) = sphere x r := by
  rw [frontier, closure_closed_ball, interior_closed_ball' x r, closed_ball_diff_ball]
#align frontier_closed_ball' frontier_closed_ball'

variable {α}

theorem rescale_to_shell_zpow {c : α} (hc : 1 < ‖c‖) {ε : ℝ} (εpos : 0 < ε) {x : E} (hx : x ≠ 0) :
    ∃ n : ℤ, c ^ n ≠ 0 ∧ ‖c ^ n • x‖ < ε ∧ ε / ‖c‖ ≤ ‖c ^ n • x‖ ∧ ‖c ^ n‖⁻¹ ≤ ε⁻¹ * ‖c‖ * ‖x‖ :=
  rescale_to_shell_semi_normed_zpow hc εpos (mt norm_eq_zero.1 hx)
#align rescale_to_shell_zpow rescale_to_shell_zpow

/-- If there is a scalar `c` with `‖c‖>1`, then any element can be moved by scalar multiplication to
any shell of width `‖c‖`. Also recap information on the norm of the rescaling element that shows
up in applications. -/
theorem rescale_to_shell {c : α} (hc : 1 < ‖c‖) {ε : ℝ} (εpos : 0 < ε) {x : E} (hx : x ≠ 0) :
    ∃ d : α, d ≠ 0 ∧ ‖d • x‖ < ε ∧ ε / ‖c‖ ≤ ‖d • x‖ ∧ ‖d‖⁻¹ ≤ ε⁻¹ * ‖c‖ * ‖x‖ :=
  rescale_to_shell_semi_normed hc εpos (mt norm_eq_zero.1 hx)
#align rescale_to_shell rescale_to_shell

end NormedAddCommGroup

section NontriviallyNormedSpace

variable (𝕜 E : Type _) [NontriviallyNormedField 𝕜] [NormedAddCommGroup E] [NormedSpace 𝕜 E]
  [Nontrivial E]

include 𝕜

/-- If `E` is a nontrivial normed space over a nontrivially normed field `𝕜`, then `E` is unbounded:
for any `c : ℝ`, there exists a vector `x : E` with norm strictly greater than `c`. -/
theorem NormedSpace.exists_lt_norm (c : ℝ) : ∃ x : E, c < ‖x‖ :=
  by
  rcases exists_ne (0 : E) with ⟨x, hx⟩
  rcases NormedField.exists_lt_norm 𝕜 (c / ‖x‖) with ⟨r, hr⟩
  use r • x
  rwa [norm_smul, ← div_lt_iff]
  rwa [norm_pos_iff]
#align normed_space.exists_lt_norm NormedSpace.exists_lt_norm

protected theorem NormedSpace.unbounded_univ : ¬Bounded (univ : Set E) := fun h =>
  let ⟨R, hR⟩ := bounded_iff_forall_norm_le.1 h
  let ⟨x, hx⟩ := NormedSpace.exists_lt_norm 𝕜 E R
  hx.not_le (hR x trivial)
#align normed_space.unbounded_univ NormedSpace.unbounded_univ

/-- A normed vector space over a nontrivially normed field is a noncompact space. This cannot be
an instance because in order to apply it, Lean would have to search for `normed_space 𝕜 E` with
unknown `𝕜`. We register this as an instance in two cases: `𝕜 = E` and `𝕜 = ℝ`. -/
protected theorem NormedSpace.noncompactSpace : NoncompactSpace E :=
  ⟨fun h => NormedSpace.unbounded_univ 𝕜 _ h.Bounded⟩
#align normed_space.noncompact_space NormedSpace.noncompactSpace

instance (priority := 100) NontriviallyNormedField.noncompactSpace : NoncompactSpace 𝕜 :=
  NormedSpace.noncompactSpace 𝕜 𝕜
#align nontrivially_normed_field.noncompact_space NontriviallyNormedField.noncompactSpace

omit 𝕜

instance (priority := 100) RealNormedSpace.noncompactSpace [NormedSpace ℝ E] : NoncompactSpace E :=
  NormedSpace.noncompactSpace ℝ E
#align real_normed_space.noncompact_space RealNormedSpace.noncompactSpace

end NontriviallyNormedSpace

section NormedAlgebra

/-- A normed algebra `𝕜'` over `𝕜` is normed module that is also an algebra.

See the implementation notes for `algebra` for a discussion about non-unital algebras. Following
the strategy there, a non-unital *normed* algebra can be written as:
```lean
variables [normed_field 𝕜] [non_unital_semi_normed_ring 𝕜']
variables [normed_module 𝕜 𝕜'] [smul_comm_class 𝕜 𝕜' 𝕜'] [is_scalar_tower 𝕜 𝕜' 𝕜']
```
-/
class NormedAlgebra (𝕜 : Type _) (𝕜' : Type _) [NormedField 𝕜] [SeminormedRing 𝕜'] extends
  Algebra 𝕜 𝕜' where
  norm_smul_le : ∀ (r : 𝕜) (x : 𝕜'), ‖r • x‖ ≤ ‖r‖ * ‖x‖
#align normed_algebra NormedAlgebra

variable {𝕜 : Type _} (𝕜' : Type _) [NormedField 𝕜] [SeminormedRing 𝕜'] [NormedAlgebra 𝕜 𝕜']

instance (priority := 100) NormedAlgebra.toNormedSpace : NormedSpace 𝕜 𝕜'
    where norm_smul_le := NormedAlgebra.norm_smul_le
#align normed_algebra.to_normed_space NormedAlgebra.toNormedSpace

/-- While this may appear identical to `normed_algebra.to_normed_space`, it contains an implicit
argument involving `normed_ring.to_semi_normed_ring` that typeclass inference has trouble inferring.

Specifically, the following instance cannot be found without this `normed_space.to_module'`:
```lean
example
  (𝕜 ι : Type*) (E : ι → Type*)
  [normed_field 𝕜] [Π i, normed_ring (E i)] [Π i, normed_algebra 𝕜 (E i)] :
  Π i, module 𝕜 (E i) := by apply_instance
```

See `normed_space.to_module'` for a similar situation. -/
instance (priority := 100) NormedAlgebra.toNormedSpace' {𝕜'} [NormedRing 𝕜'] [NormedAlgebra 𝕜 𝕜'] :
    NormedSpace 𝕜 𝕜' := by infer_instance
#align normed_algebra.to_normed_space' NormedAlgebra.toNormedSpace'

theorem norm_algebraMap (x : 𝕜) : ‖algebraMap 𝕜 𝕜' x‖ = ‖x‖ * ‖(1 : 𝕜')‖ :=
  by
  rw [Algebra.algebraMap_eq_smul_one]
  exact norm_smul _ _
#align norm_algebra_map norm_algebraMap

theorem nnnorm_algebraMap (x : 𝕜) : ‖algebraMap 𝕜 𝕜' x‖₊ = ‖x‖₊ * ‖(1 : 𝕜')‖₊ :=
  Subtype.ext <| norm_algebraMap 𝕜' x
#align nnnorm_algebra_map nnnorm_algebraMap

@[simp]
theorem norm_algebra_map' [NormOneClass 𝕜'] (x : 𝕜) : ‖algebraMap 𝕜 𝕜' x‖ = ‖x‖ := by
  rw [norm_algebraMap, norm_one, mul_one]
#align norm_algebra_map' norm_algebra_map'

@[simp]
theorem nnnorm_algebra_map' [NormOneClass 𝕜'] (x : 𝕜) : ‖algebraMap 𝕜 𝕜' x‖₊ = ‖x‖₊ :=
  Subtype.ext <| norm_algebra_map' _ _
#align nnnorm_algebra_map' nnnorm_algebra_map'

section NNReal

variable [NormOneClass 𝕜'] [NormedAlgebra ℝ 𝕜']

@[simp]
theorem norm_algebraMap_nNReal (x : ℝ≥0) : ‖algebraMap ℝ≥0 𝕜' x‖ = x :=
  (norm_algebra_map' 𝕜' (x : ℝ)).symm ▸ Real.norm_of_nonneg x.Prop
#align norm_algebra_map_nnreal norm_algebraMap_nNReal

@[simp]
theorem nnnorm_algebraMap_nNReal (x : ℝ≥0) : ‖algebraMap ℝ≥0 𝕜' x‖₊ = x :=
  Subtype.ext <| norm_algebraMap_nNReal 𝕜' x
#align nnnorm_algebra_map_nnreal nnnorm_algebraMap_nNReal

end NNReal

variable (𝕜 𝕜')

/-- In a normed algebra, the inclusion of the base field in the extended field is an isometry. -/
theorem algebraMap_isometry [NormOneClass 𝕜'] : Isometry (algebraMap 𝕜 𝕜') :=
  by
  refine' Isometry.of_dist_eq fun x y => _
  rw [dist_eq_norm, dist_eq_norm, ← RingHom.map_sub, norm_algebra_map']
#align algebra_map_isometry algebraMap_isometry

instance NormedAlgebra.id : NormedAlgebra 𝕜 𝕜 :=
  { NormedField.toNormedSpace, Algebra.id 𝕜 with }
#align normed_algebra.id NormedAlgebra.id

/-- Any normed characteristic-zero division ring that is a normed_algebra over the reals is also a
normed algebra over the rationals.

Phrased another way, if `𝕜` is a normed algebra over the reals, then `algebra_rat` respects that
norm. -/
instance normedAlgebraRat {𝕜} [NormedDivisionRing 𝕜] [CharZero 𝕜] [NormedAlgebra ℝ 𝕜] :
    NormedAlgebra ℚ 𝕜
    where norm_smul_le q x := by
    rw [← smul_one_smul ℝ q x, Rat.smul_one_eq_coe, norm_smul, Rat.norm_cast_real]
#align normed_algebra_rat normedAlgebraRat

instance PUnit.normedAlgebra : NormedAlgebra 𝕜 PUnit
    where norm_smul_le q x := by simp only [PUnit.norm_eq_zero, MulZeroClass.mul_zero]
#align punit.normed_algebra PUnit.normedAlgebra

instance : NormedAlgebra 𝕜 (ULift 𝕜') :=
  { ULift.normedSpace with }

/-- The product of two normed algebras is a normed algebra, with the sup norm. -/
instance Prod.normedAlgebra {E F : Type _} [SeminormedRing E] [SeminormedRing F] [NormedAlgebra 𝕜 E]
    [NormedAlgebra 𝕜 F] : NormedAlgebra 𝕜 (E × F) :=
  { Prod.normedSpace with }
#align prod.normed_algebra Prod.normedAlgebra

/-- The product of finitely many normed algebras is a normed algebra, with the sup norm. -/
instance Pi.normedAlgebra {E : ι → Type _} [Fintype ι] [∀ i, SeminormedRing (E i)]
    [∀ i, NormedAlgebra 𝕜 (E i)] : NormedAlgebra 𝕜 (∀ i, E i) :=
  { Pi.normedSpace, Pi.algebra _ E with }
#align pi.normed_algebra Pi.normedAlgebra

instance MulOpposite.normedAlgebra {E : Type _} [SeminormedRing E] [NormedAlgebra 𝕜 E] :
    NormedAlgebra 𝕜 Eᵐᵒᵖ :=
  { MulOpposite.normedSpace with }
#align mul_opposite.normed_algebra MulOpposite.normedAlgebra

end NormedAlgebra

/-- A non-unital algebra homomorphism from an `algebra` to a `normed_algebra` induces a
`normed_algebra` structure on the domain, using the `semi_normed_ring.induced` norm.

See note [reducible non-instances] -/
@[reducible]
def NormedAlgebra.induced {F : Type _} (α β γ : Type _) [NormedField α] [Ring β] [Algebra α β]
    [SeminormedRing γ] [NormedAlgebra α γ] [NonUnitalAlgHomClass F α β γ] (f : F) :
    @NormedAlgebra α β _ (SeminormedRing.induced β γ f)
    where norm_smul_le a b := by
    unfold norm
    exact (map_smul f a b).symm ▸ norm_smul_le a (f b)
#align normed_algebra.induced NormedAlgebra.induced

instance Subalgebra.toNormedAlgebra {𝕜 A : Type _} [SeminormedRing A] [NormedField 𝕜]
    [NormedAlgebra 𝕜 A] (S : Subalgebra 𝕜 A) : NormedAlgebra 𝕜 S :=
  @NormedAlgebra.induced _ 𝕜 S A _ (SubringClass.toRing S) S.Algebra _ _ _ S.val
#align subalgebra.to_normed_algebra Subalgebra.toNormedAlgebra

section RestrictScalars

variable (𝕜 : Type _) (𝕜' : Type _) [NormedField 𝕜] [NormedField 𝕜'] [NormedAlgebra 𝕜 𝕜']
  (E : Type _) [SeminormedAddCommGroup E] [NormedSpace 𝕜' E]

instance {𝕜 : Type _} {𝕜' : Type _} {E : Type _} [I : SeminormedAddCommGroup E] :
    SeminormedAddCommGroup (RestrictScalars 𝕜 𝕜' E) :=
  I

instance {𝕜 : Type _} {𝕜' : Type _} {E : Type _} [I : NormedAddCommGroup E] :
    NormedAddCommGroup (RestrictScalars 𝕜 𝕜' E) :=
  I

/-- If `E` is a normed space over `𝕜'` and `𝕜` is a normed algebra over `𝕜'`, then
`restrict_scalars.module` is additionally a `normed_space`. -/
instance : NormedSpace 𝕜 (RestrictScalars 𝕜 𝕜' E) :=
  { RestrictScalars.module 𝕜 𝕜' E with
    norm_smul_le := fun c x =>
      (norm_smul_le (algebraMap 𝕜 𝕜' c) (_ : E)).trans_eq <| by rw [norm_algebra_map'] }

-- If you think you need this, consider instead reproducing `restrict_scalars.lsmul`
-- appropriately modified here.
/-- The action of the original normed_field on `restrict_scalars 𝕜 𝕜' E`.
This is not an instance as it would be contrary to the purpose of `restrict_scalars`.
-/
def Module.RestrictScalars.normedSpaceOrig {𝕜 : Type _} {𝕜' : Type _} {E : Type _} [NormedField 𝕜']
    [SeminormedAddCommGroup E] [I : NormedSpace 𝕜' E] : NormedSpace 𝕜' (RestrictScalars 𝕜 𝕜' E) :=
  I
#align module.restrict_scalars.normed_space_orig Module.RestrictScalars.normedSpaceOrig

/-- Warning: This declaration should be used judiciously.
Please consider using `is_scalar_tower` and/or `restrict_scalars 𝕜 𝕜' E` instead.

This definition allows the `restrict_scalars.normed_space` instance to be put directly on `E`
rather on `restrict_scalars 𝕜 𝕜' E`. This would be a very bad instance; both because `𝕜'` cannot be
inferred, and because it is likely to create instance diamonds.
-/
def NormedSpace.restrictScalars : NormedSpace 𝕜 E :=
  RestrictScalars.normedSpace _ 𝕜' _
#align normed_space.restrict_scalars NormedSpace.restrictScalars

end RestrictScalars


import order
import data.finset
import data.pfun
import data.set.finite
import data.list.alist
import data.vector

open classical
open alist

noncomputable theory

-- Sadly, lean does not support good inductive types.
-- Hence we won't have arbitrary arity functions and relations.
structure Signature : Type :=
(consts : ℕ)
(funcs : ℕ)
(ops : ℕ)
(rels : ℕ)

@[derive [decidable_eq]]
structure Const (S : Signature) : Type :=
(const : ℕ)
(const_le : const < S.consts)

@[derive [decidable_eq]]
structure Func (S : Signature) : Type :=
(func : ℕ)
(func_le : func < S.funcs)

@[derive [decidable_eq]]
structure Op (S : Signature) : Type :=
(op : ℕ)
(op_le : op < S.ops)

@[derive [decidable_eq]]
structure Rel (S : Signature) : Type :=
(rel : ℕ)
(rel_le : rel < S.rels)

@[derive [decidable_eq, has_zero, has_one]]
def var := ℕ

@[derive [decidable_eq]]
inductive Term (S : Signature) : Type
| Var : var → Term
| ConstT : Const S → Term
| FuncT : Func S → Term → Term
| OpT : Op S → Term → Term → Term

instance var_has_coe {S : Signature} : has_coe var (Term S) :=
⟨λ v, Term.Var v⟩

instance const_has_coe {S : Signature} : has_coe (Const S) (Term S) :=
⟨λ c, Term.ConstT c⟩

instance func_has_coe {S : Signature} : has_coe_to_fun (Func S) (λ _, Term S → Term S) :=
⟨λ f, Term.FuncT f⟩

instance op_has_coe {S : Signature} : has_coe_to_fun (Op S) (λ _, Term S → Term S → Term S) :=
⟨λ o, Term.OpT o⟩

instance {S : Signature} : inhabited (Term S) :=
⟨Term.Var 0⟩

def vars (S : Signature) : Term S → set var :=
λ t, begin
  induction t with v c f t st o t₁ t₂ st₁ st₂,
  exact {v},
  exact ∅,
  exact st,
  exact st₁ ∪ st₂,
end

@[derive decidable_eq]
inductive LogicalOp : Type
| To : LogicalOp

@[derive decidable_eq]
inductive Quantifier : Type
| All : Quantifier

@[derive [decidable_eq]]
inductive Formula (S : Signature) : Type
| Eq : Term S → Term S → Formula
| RelF : Rel S → Term S → Term S → Formula
| Not : Formula → Formula
| OpL  : LogicalOp → Formula → Formula → Formula
| QuantifierL : Quantifier → var → Formula → Formula

instance {S : Signature} : inhabited (Formula S) :=
⟨Formula.Eq (Term.Var 0) (Term.Var 0)⟩

def free (S : Signature) : Formula S → set var :=
λ φ,
begin
  induction φ with t₁ t₂ r t₁ t₂ φ sφ o φ₁ φ₂ sφ₁ sφ₂ q v φ sφ,
  exact vars S t₁ ∪ vars S t₂,
  exact vars S t₁ ∪ vars S t₂,
  exact sφ,
  exact sφ₁ ∪ sφ₂,
  exact sφ \ {v},
end

def sentence {S : Signature} (φ : Formula S) : Prop := free S φ = ∅

namespace language

variable {S : Signature}

section term

end term

section vars

lemma vars_var {v : var} : vars S (Term.Var v) = {v} := rfl

lemma vars_const {c : Const S} : vars S (Term.ConstT c) = ∅ := rfl

lemma vars_func {f : Func S} {t : Term S} : vars S (Term.FuncT f t) = vars S t := rfl

lemma vars_op {o : Op S} {t₁ t₂ : Term S} :
vars S (Term.OpT o t₁ t₂) = vars S t₁ ∪ vars S t₂ := rfl

end vars

section formula

end formula

section free

lemma free_eq {t₁ t₂ : Term S} :
free S (Formula.Eq t₁ t₂) = vars S t₁ ∪ vars S t₂ := rfl

lemma free_rel {r : Rel S} {t₁ t₂ : Term S} :
free S (Formula.RelF r t₁ t₂) = vars S t₁ ∪ vars S t₂ := rfl

lemma free_not {φ : Formula S} :
free S (Formula.Not φ) = free S φ := rfl

lemma free_opl {o : LogicalOp} {φ₁ φ₂ : Formula S} :
free S (Formula.OpL o φ₁ φ₂) = free S φ₁ ∪ free S φ₂ := rfl

lemma free_quantifier {q : Quantifier} {v : var} {φ : Formula S} :
free S (Formula.QuantifierL q v φ) = free S φ \ {v} := rfl

end free

end language

-- @[derive [has_mem, has_singleton Formula, has_union, has_emptyc, has_subset, complete_lattice]]
def Theory (S : Signature) := set (Formula S)


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

! This file was ported from Lean 3 source module linear_algebra.clifford_algebra.grading
! leanprover-community/mathlib commit 34020e531ebc4e8aac6d449d9eecbcd1508ea8d0
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.LinearAlgebra.CliffordAlgebra.Basic
import Mathbin.Data.Zmod.Basic
import Mathbin.RingTheory.GradedAlgebra.Basic

/-!
# Results about the grading structure of the clifford algebra

The main result is `clifford_algebra.graded_algebra`, which says that the clifford algebra is a
ℤ₂-graded algebra (or "superalgebra").
-/

namespace CliffordAlgebra

variable {R M : Type _} [CommRing R] [AddCommGroup M] [Module R M]

variable {Q : QuadraticForm R M}

open DirectSum

variable (Q)

/-- The even or odd submodule, defined as the supremum of the even or odd powers of
`(ι Q).range`. `even_odd 0` is the even submodule, and `even_odd 1` is the odd submodule. -/
def evenOdd (i : ZMod 2) : Submodule R (CliffordAlgebra Q) :=
  ⨆ j : { n : ℕ // ↑n = i }, (ι Q).range ^ (j : ℕ)
#align clifford_algebra.even_odd CliffordAlgebra.evenOdd

theorem one_le_evenOdd_zero : 1 ≤ evenOdd Q 0 :=
  by
  refine' le_trans _ (le_supᵢ _ ⟨0, Nat.cast_zero⟩)
  exact (pow_zero _).ge
#align clifford_algebra.one_le_even_odd_zero CliffordAlgebra.one_le_evenOdd_zero

theorem range_ι_le_evenOdd_one : (ι Q).range ≤ evenOdd Q 1 :=
  by
  refine' le_trans _ (le_supᵢ _ ⟨1, Nat.cast_one⟩)
  exact (pow_one _).ge
#align clifford_algebra.range_ι_le_even_odd_one CliffordAlgebra.range_ι_le_evenOdd_one

theorem ι_mem_evenOdd_one (m : M) : ι Q m ∈ evenOdd Q 1 :=
  range_ι_le_evenOdd_one Q <| LinearMap.mem_range_self _ m
#align clifford_algebra.ι_mem_even_odd_one CliffordAlgebra.ι_mem_evenOdd_one

theorem ι_mul_ι_mem_evenOdd_zero (m₁ m₂ : M) : ι Q m₁ * ι Q m₂ ∈ evenOdd Q 0 :=
  Submodule.mem_supᵢ_of_mem ⟨2, rfl⟩
    (by
      rw [Subtype.coe_mk, pow_two]
      exact
        Submodule.mul_mem_mul (LinearMap.mem_range_self (ι Q) m₁)
          (LinearMap.mem_range_self (ι Q) m₂))
#align clifford_algebra.ι_mul_ι_mem_even_odd_zero CliffordAlgebra.ι_mul_ι_mem_evenOdd_zero

theorem evenOdd_mul_le (i j : ZMod 2) : evenOdd Q i * evenOdd Q j ≤ evenOdd Q (i + j) :=
  by
  simp_rw [even_odd, Submodule.supᵢ_eq_span, Submodule.span_mul_span]
  apply Submodule.span_mono
  intro z hz
  obtain ⟨x, y, hx, hy, rfl⟩ := hz
  obtain ⟨xi, hx'⟩ := set.mem_Union.mp hx
  obtain ⟨yi, hy'⟩ := set.mem_Union.mp hy
  refine' set.mem_Union.mpr ⟨⟨xi + yi, by simp only [Nat.cast_add, xi.prop, yi.prop]⟩, _⟩
  simp only [Subtype.coe_mk, Nat.cast_add, pow_add]
  exact Submodule.mul_mem_mul hx' hy'
#align clifford_algebra.even_odd_mul_le CliffordAlgebra.evenOdd_mul_le

instance evenOdd.gradedMonoid : SetLike.GradedMonoid (evenOdd Q)
    where
  one_mem := Submodule.one_le.mp (one_le_evenOdd_zero Q)
  mul_mem i j p q hp hq := Submodule.mul_le.mp (evenOdd_mul_le Q _ _) _ hp _ hq
#align clifford_algebra.even_odd.graded_monoid CliffordAlgebra.evenOdd.gradedMonoid

/-- A version of `clifford_algebra.ι` that maps directly into the graded structure. This is
primarily an auxiliary construction used to provide `clifford_algebra.graded_algebra`. -/
def GradedAlgebra.ι : M →ₗ[R] ⨁ i : ZMod 2, evenOdd Q i :=
  DirectSum.lof R (ZMod 2) (fun i => ↥(evenOdd Q i)) 1 ∘ₗ (ι Q).codRestrict _ (ι_mem_evenOdd_one Q)
#align clifford_algebra.graded_algebra.ι CliffordAlgebra.GradedAlgebra.ι

theorem GradedAlgebra.ι_apply (m : M) :
    GradedAlgebra.ι Q m = DirectSum.of (fun i => ↥(evenOdd Q i)) 1 ⟨ι Q m, ι_mem_evenOdd_one Q m⟩ :=
  rfl
#align clifford_algebra.graded_algebra.ι_apply CliffordAlgebra.GradedAlgebra.ι_apply

theorem GradedAlgebra.ι_sq_scalar (m : M) :
    GradedAlgebra.ι Q m * GradedAlgebra.ι Q m = algebraMap R _ (Q m) :=
  by
  rw [graded_algebra.ι_apply Q, DirectSum.of_mul_of, DirectSum.algebraMap_apply]
  refine' DirectSum.of_eq_of_gradedMonoid_eq (Sigma.subtype_ext rfl <| ι_sq_scalar _ _)
#align clifford_algebra.graded_algebra.ι_sq_scalar CliffordAlgebra.GradedAlgebra.ι_sq_scalar

theorem GradedAlgebra.lift_ι_eq (i' : ZMod 2) (x' : evenOdd Q i') :
    lift Q ⟨by apply graded_algebra.ι Q, GradedAlgebra.ι_sq_scalar Q⟩ x' =
      DirectSum.of (fun i => evenOdd Q i) i' x' :=
  by
  cases' x' with x' hx'
  dsimp only [Subtype.coe_mk, DirectSum.lof_eq_of]
  refine' Submodule.supᵢ_induction' _ (fun i x hx => _) _ (fun x y hx hy ihx ihy => _) hx'
  · obtain ⟨i, rfl⟩ := i
    dsimp only [Subtype.coe_mk] at hx
    refine'
      Submodule.pow_induction_on_left' _ (fun r => _) (fun x y i hx hy ihx ihy => _)
        (fun m hm i x hx ih => _) hx
    · rw [AlgHom.commutes, DirectSum.algebraMap_apply]
      rfl
    · rw [AlgHom.map_add, ihx, ihy, ← map_add]
      rfl
    · obtain ⟨_, rfl⟩ := hm
      rw [AlgHom.map_mul, ih, lift_ι_apply, graded_algebra.ι_apply Q, DirectSum.of_mul_of]
      refine' DirectSum.of_eq_of_gradedMonoid_eq (Sigma.subtype_ext _ _) <;>
        dsimp only [GradedMonoid.mk, Subtype.coe_mk]
      · rw [Nat.succ_eq_add_one, add_comm, Nat.cast_add, Nat.cast_one]
      rfl
  · rw [AlgHom.map_zero]
    apply Eq.symm
    apply dfinsupp.single_eq_zero.mpr
    rfl
  · rw [AlgHom.map_add, ihx, ihy, ← map_add]
    rfl
#align clifford_algebra.graded_algebra.lift_ι_eq CliffordAlgebra.GradedAlgebra.lift_ι_eq

/-- The clifford algebra is graded by the even and odd parts. -/
instance gradedAlgebra : GradedAlgebra (evenOdd Q) :=
  GradedAlgebra.ofAlgHom (evenOdd Q)
    (-- while not necessary, the `by apply` makes this elaborate faster
      lift
      Q ⟨by apply graded_algebra.ι Q, GradedAlgebra.ι_sq_scalar Q⟩)
    (-- the proof from here onward is mostly similar to the `tensor_algebra` case, with some extra
    -- handling for the `supr` in `even_odd`.
    by
      ext m
      dsimp only [LinearMap.comp_apply, AlgHom.toLinearMap_apply, AlgHom.comp_apply,
        AlgHom.id_apply]
      rw [lift_ι_apply, graded_algebra.ι_apply Q, DirectSum.coeAlgHom_of, Subtype.coe_mk])
    (by apply graded_algebra.lift_ι_eq Q)
#align clifford_algebra.graded_algebra CliffordAlgebra.gradedAlgebra

theorem supᵢ_ι_range_eq_top : (⨆ i : ℕ, (ι Q).range ^ i) = ⊤ :=
  by
  rw [← (DirectSum.Decomposition.isInternal (even_odd Q)).submodule_supᵢ_eq_top, eq_comm]
  calc
    (⨆ (i : ZMod 2) (j : { n // ↑n = i }), (ι Q).range ^ ↑j) =
        ⨆ i : Σi : ZMod 2, { n : ℕ // ↑n = i }, (ι Q).range ^ (i.2 : ℕ) :=
      by rw [supᵢ_sigma]
    _ = ⨆ i : ℕ, (ι Q).range ^ i :=
      Function.Surjective.supᵢ_congr (fun i => i.2) (fun i => ⟨⟨_, i, rfl⟩, rfl⟩) fun _ => rfl

#align clifford_algebra.supr_ι_range_eq_top CliffordAlgebra.supᵢ_ι_range_eq_top

theorem evenOdd_isCompl : IsCompl (evenOdd Q 0) (evenOdd Q 1) :=
  (DirectSum.Decomposition.isInternal (evenOdd Q)).IsCompl zero_ne_one <|
    by
    have : (Finset.univ : Finset (ZMod 2)) = {0, 1} := rfl
    simpa using congr_arg (coe : Finset (ZMod 2) → Set (ZMod 2)) this
#align clifford_algebra.even_odd_is_compl CliffordAlgebra.evenOdd_isCompl

/-- To show a property is true on the even or odd part, it suffices to show it is true on the
scalars or vectors (respectively), closed under addition, and under left-multiplication by a pair
of vectors. -/
@[elab_as_elim]
theorem evenOddInduction (n : ZMod 2) {P : ∀ x, x ∈ evenOdd Q n → Prop}
    (hr :
      ∀ (v) (h : v ∈ (ι Q).range ^ n.val),
        P v (Submodule.mem_supᵢ_of_mem ⟨n.val, n.nat_cast_zmod_val⟩ h))
    (hadd : ∀ {x y hx hy}, P x hx → P y hy → P (x + y) (Submodule.add_mem _ hx hy))
    (hιι_mul :
      ∀ (m₁ m₂) {x hx},
        P x hx →
          P (ι Q m₁ * ι Q m₂ * x)
            (zero_add n ▸ SetLike.mul_mem_graded (ι_mul_ι_mem_evenOdd_zero Q m₁ m₂) hx))
    (x : CliffordAlgebra Q) (hx : x ∈ evenOdd Q n) : P x hx :=
  by
  apply Submodule.supᵢ_induction' _ _ (hr 0 (Submodule.zero_mem _)) @hadd
  refine' Subtype.rec _
  simp_rw [Subtype.coe_mk, ZMod.nat_coe_zmod_eq_iff, add_comm n.val]
  rintro n' ⟨k, rfl⟩ xv
  simp_rw [pow_add, pow_mul]
  refine' Submodule.mul_induction_on' _ _
  · intro a ha b hb
    refine' Submodule.pow_induction_on_left' ((ι Q).range ^ 2) _ _ _ ha
    · intro r
      simp_rw [← Algebra.smul_def]
      exact hr _ (Submodule.smul_mem _ _ hb)
    · intro x y n hx hy
      simp_rw [add_mul]
      apply hadd
    · intro x hx n y hy ihy
      revert hx
      simp_rw [pow_two]
      refine' Submodule.mul_induction_on' _ _
      · simp_rw [LinearMap.mem_range]
        rintro _ ⟨m₁, rfl⟩ _ ⟨m₂, rfl⟩
        simp_rw [mul_assoc _ y b]
        refine' hιι_mul _ _ ihy
      · intro x hx y hy ihx ihy
        simp_rw [add_mul]
        apply hadd ihx ihy
  · intro x y hx hy
    apply hadd
#align clifford_algebra.even_odd_induction CliffordAlgebra.evenOddInduction

/-- To show a property is true on the even parts, it suffices to show it is true on the
scalars, closed under addition, and under left-multiplication by a pair of vectors. -/
@[elab_as_elim]
theorem evenInduction {P : ∀ x, x ∈ evenOdd Q 0 → Prop}
    (hr : ∀ r : R, P (algebraMap _ _ r) (SetLike.algebraMap_mem_graded _ _))
    (hadd : ∀ {x y hx hy}, P x hx → P y hy → P (x + y) (Submodule.add_mem _ hx hy))
    (hιι_mul :
      ∀ (m₁ m₂) {x hx},
        P x hx →
          P (ι Q m₁ * ι Q m₂ * x)
            (zero_add 0 ▸ SetLike.mul_mem_graded (ι_mul_ι_mem_evenOdd_zero Q m₁ m₂) hx))
    (x : CliffordAlgebra Q) (hx : x ∈ evenOdd Q 0) : P x hx :=
  by
  refine' even_odd_induction Q 0 (fun rx => _) (@hadd) hιι_mul x hx
  simp_rw [ZMod.val_zero, pow_zero]
  rintro ⟨r, rfl⟩
  exact hr r
#align clifford_algebra.even_induction CliffordAlgebra.evenInduction

/-- To show a property is true on the odd parts, it suffices to show it is true on the
vectors, closed under addition, and under left-multiplication by a pair of vectors. -/
@[elab_as_elim]
theorem oddInduction {P : ∀ x, x ∈ evenOdd Q 1 → Prop} (hι : ∀ v, P (ι Q v) (ι_mem_evenOdd_one _ _))
    (hadd : ∀ {x y hx hy}, P x hx → P y hy → P (x + y) (Submodule.add_mem _ hx hy))
    (hιι_mul :
      ∀ (m₁ m₂) {x hx},
        P x hx →
          P (ι Q m₁ * ι Q m₂ * x)
            (zero_add (1 : ZMod 2) ▸ SetLike.mul_mem_graded (ι_mul_ι_mem_evenOdd_zero Q m₁ m₂) hx))
    (x : CliffordAlgebra Q) (hx : x ∈ evenOdd Q 1) : P x hx :=
  by
  refine' even_odd_induction Q 1 (fun ιv => _) (@hadd) hιι_mul x hx
  simp_rw [ZMod.val_one, pow_one]
  rintro ⟨v, rfl⟩
  exact hι v
#align clifford_algebra.odd_induction CliffordAlgebra.oddInduction

end CliffordAlgebra