/-
Copyright (c) 2021 Scott Morrison. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Scott Morrison
-/
import logic.small
import category_theory.skeletal

/-!
# Essentially small categories.

A category given by `(C : Type u) [category.{v} C]` is `w`-essentially small
if there exists a `small_model C : Type w` equipped with `[small_category (small_model C)]`.

A category is `w`-locally small if every hom type is `w`-small.

The main theorem here is that a category is `w`-essentially small iff
the type `skeleton C` is `w`-small, and `C` is `w`-locally small.
-/

universes w v v' u u'

open category_theory

variables (C : Type u) [category.{v} C]

namespace category_theory

/-- A category is `essentially_small.{w}` if there exists
an equivalence to some `S : Type w` with `[small_category S]`. -/
class essentially_small (C : Type u) [category.{v} C] : Prop :=
(equiv_small_category : ∃ (S : Type w) (_ : small_category S), by exactI nonempty (C ≌ S))

/-- Constructor for `essentially_small C` from an explicit small category witness. -/
lemma essentially_small.mk' {C : Type u} [category.{v} C] {S : Type w} [small_category S]
  (e : C ≌ S) : essentially_small.{w} C :=
⟨⟨S, _, ⟨e⟩⟩⟩

/--
An arbitrarily chosen small model for an essentially small category.
-/
@[nolint has_inhabited_instance]
def small_model (C : Type u) [category.{v} C] [essentially_small.{w} C] : Type w :=
classical.some (@essentially_small.equiv_small_category C _ _)

noncomputable
instance small_category_small_model
  (C : Type u) [category.{v} C] [essentially_small.{w} C] : small_category (small_model C) :=
classical.some (classical.some_spec (@essentially_small.equiv_small_category C _ _))

/--
The (noncomputable) categorical equivalence between
an essentially small category and its small model.
-/
noncomputable
def equiv_small_model (C : Type u) [category.{v} C] [essentially_small.{w} C] : C ≌ small_model C :=
nonempty.some (classical.some_spec (classical.some_spec
  (@essentially_small.equiv_small_category C _ _)))

lemma essentially_small_congr {C : Type u} [category.{v} C] {D : Type u'} [category.{v'} D]
  (e : C ≌ D) : essentially_small.{w} C ↔ essentially_small.{w} D :=
begin
  fsplit,
  { rintro ⟨S, 𝒮, ⟨f⟩⟩,
    resetI,
    exact essentially_small.mk' (e.symm.trans f), },
  { rintro ⟨S, 𝒮, ⟨f⟩⟩,
    resetI,
    exact essentially_small.mk' (e.trans f), },
end

/--
A category is `w`-locally small if every hom set is `w`-small.

See `shrink_homs C` for a category instance where every hom set has been replaced by a small model.
-/
class locally_small (C : Type u) [category.{v} C] : Prop :=
(hom_small : ∀ X Y : C, small.{w} (X ⟶ Y) . tactic.apply_instance)

instance (C : Type u) [category.{v} C] [locally_small.{w} C] (X Y : C) :
  small (X ⟶ Y) :=
locally_small.hom_small X Y

lemma locally_small_congr {C : Type u} [category.{v} C] {D : Type u'} [category.{v'} D]
  (e : C ≌ D) : locally_small.{w} C ↔ locally_small.{w} D :=
begin
  fsplit,
  { rintro ⟨L⟩,
    fsplit,
    intros X Y,
    specialize L (e.inverse.obj X) (e.inverse.obj Y),
    refine (small_congr _).mpr L,
    exact equiv_of_fully_faithful e.inverse, },
  { rintro ⟨L⟩,
    fsplit,
    intros X Y,
    specialize L (e.functor.obj X) (e.functor.obj Y),
    refine (small_congr _).mpr L,
    exact equiv_of_fully_faithful e.functor, },
end

@[priority 100]
instance locally_small_self (C : Type u) [category.{v} C] : locally_small.{v} C := {}

@[priority 100]
instance locally_small_of_essentially_small
  (C : Type u) [category.{v} C] [essentially_small.{w} C] : locally_small.{w} C :=
(locally_small_congr (equiv_small_model C)).mpr (category_theory.locally_small_self _)

/--
We define a type alias `shrink_homs C` for `C`. When we have `locally_small.{w} C`,
we'll put a `category.{w}` instance on `shrink_homs C`.
-/
@[nolint has_inhabited_instance]
def shrink_homs (C : Type u) := C

namespace shrink_homs

section
variables {C' : Type*} -- a fresh variable with no category instance attached

/-- Help the typechecker by explicitly translating from `C` to `shrink_homs C`. -/
def to_shrink_homs {C' : Type*} (X : C') : shrink_homs C' := X
/-- Help the typechecker by explicitly translating from `shrink_homs C` to `C`. -/
def from_shrink_homs {C' : Type*} (X : shrink_homs C') : C' := X

@[simp] lemma to_from (X : C') : from_shrink_homs (to_shrink_homs X) = X := rfl
@[simp] lemma from_to (X : shrink_homs C') : to_shrink_homs (from_shrink_homs X) = X := rfl

end

variables (C) [locally_small.{w} C]

@[simps]
noncomputable
instance : category.{w} (shrink_homs C) :=
{ hom := λ X Y, shrink (from_shrink_homs X ⟶ from_shrink_homs Y),
  id := λ X, equiv_shrink _ (𝟙 (from_shrink_homs X)),
  comp := λ X Y Z f g,
    equiv_shrink _ (((equiv_shrink _).symm f) ≫ ((equiv_shrink _).symm g)), }.

/-- Implementation of `shrink_homs.equivalence`. -/
@[simps]
noncomputable
def functor : C ⥤ shrink_homs C :=
{ obj := λ X, to_shrink_homs X,
  map := λ X Y f, equiv_shrink (X ⟶ Y) f, }

/-- Implementation of `shrink_homs.equivalence`. -/
@[simps]
noncomputable
def inverse : shrink_homs C ⥤ C :=
{ obj := λ X, from_shrink_homs X,
  map := λ X Y f, (equiv_shrink (from_shrink_homs X ⟶ from_shrink_homs Y)).symm f, }

/--
The categorical equivalence between `C` and `shrink_homs C`, when `C` is locally small.
-/
@[simps]
noncomputable
def equivalence : C ≌ shrink_homs C :=
equivalence.mk (functor C) (inverse C)
  (nat_iso.of_components (λ X, iso.refl X) (by tidy))
  (nat_iso.of_components (λ X, iso.refl X) (by tidy))

end shrink_homs

/--
A category is essentially small if and only if
the underlying type of its skeleton (i.e. the "set" of isomorphism classes) is small,
and it is locally small.
-/
theorem essentially_small_iff (C : Type u) [category.{v} C] :
  essentially_small.{w} C ↔ small.{w} (skeleton C) ∧ locally_small.{w} C :=
begin
  -- This theorem is the only bit of real work in this file.
  fsplit,
  { intro h,
    fsplit,
    { rcases h with ⟨S, 𝒮, ⟨e⟩⟩,
      resetI,
      refine ⟨⟨skeleton S, ⟨_⟩⟩⟩,
      exact e.skeleton_equiv, },
    { resetI, apply_instance, }, },
  { rintro ⟨⟨S, ⟨e⟩⟩, L⟩,
    resetI,
    let e' := (shrink_homs.equivalence C).skeleton_equiv.symm,
    refine ⟨⟨S, _, ⟨_⟩⟩⟩,
    apply induced_category.category (e'.trans e).symm,
    refine (shrink_homs.equivalence C).trans
      ((skeleton_equivalence _).symm.trans
      ((induced_functor (e'.trans e).symm).as_equivalence.symm)), },
end

/--
Any thin category is locally small.
-/
@[priority 100]
instance locally_small_of_thin {C : Type u} [category.{v} C] [∀ X Y : C, subsingleton (X ⟶ Y)] :
  locally_small.{w} C := {}

/--
A thin category is essentially small if and only if the underlying type of its skeleton is small.
-/
theorem essentially_small_iff_of_thin
  {C : Type u} [category.{v} C] [∀ X Y : C, subsingleton (X ⟶ Y)] :
  essentially_small.{w} C ↔ small.{w} (skeleton C) :=
by simp [essentially_small_iff, category_theory.locally_small_of_thin]

end category_theory


/-
Copyright (c) 2018 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import group_theory.group_action
import group_theory.quotient_group
import group_theory.order_of_element
import data.zmod.basic
import data.fintype.card
import data.list.rotate

/-!
# Sylow theorems

The Sylow theorems are the following results for every finite group `G` and every prime number `p`.

* There exists a Sylow `p`-subgroup of `G`.
* All Sylow `p`-subgroups of `G` are conjugate to each other.
* Let `nₚ` be the number of Sylow `p`-subgroups of `G`, then `nₚ` divides the index of the Sylow
  `p`-subgroup, `nₚ ≡ 1 [MOD p]`, and `nₚ` is equal to the index of the normalizer of the Sylow
  `p`-subgroup in `G`.

In this file, currently only the first of these results is proven.

## Main statements

* `exists_prime_order_of_dvd_card`: For every prime `p` dividing the order of `G` there exists an
  element of order `p` in `G`. This is known as Cauchy`s theorem.
* `exists_subgroup_card_pow_prime`: A generalisation of the first of the Sylow theorems: For every
  prime power `pⁿ` dividing `G`, there exists a subgroup of `G` of order `pⁿ`.

## TODO

* Prove the second and third of the Sylow theorems.
* Sylow theorems for infinite groups
-/

open equiv fintype finset mul_action function
open equiv.perm subgroup list quotient_group
open_locale big_operators
universes u v w
variables {G : Type u} {α : Type v} {β : Type w} [group G]

local attribute [instance, priority 10] subtype.fintype set_fintype classical.prop_decidable

namespace mul_action
variables [mul_action G α]

lemma mem_fixed_points_iff_card_orbit_eq_one {a : α}
  [fintype (orbit G a)] : a ∈ fixed_points G α ↔ card (orbit G a) = 1 :=
begin
  rw [fintype.card_eq_one_iff, mem_fixed_points],
  split,
  { exact λ h, ⟨⟨a, mem_orbit_self _⟩, λ ⟨b, ⟨x, hx⟩⟩, subtype.eq $ by simp [h x, hx.symm]⟩ },
  { assume h x,
    rcases h with ⟨⟨z, hz⟩, hz₁⟩,
    exact calc x • a = z : subtype.mk.inj (hz₁ ⟨x • a, mem_orbit _ _⟩)
      ... = a : (subtype.mk.inj (hz₁ ⟨a, mem_orbit_self _⟩)).symm }
end

lemma card_modeq_card_fixed_points [fintype α] [fintype G] [fintype (fixed_points G α)]
  (p : ℕ) {n : ℕ} [hp : fact p.prime] (h : card G = p ^ n) :
  card α ≡ card (fixed_points G α) [MOD p] :=
calc card α = card (Σ y : quotient (orbit_rel G α), {x // quotient.mk' x = y}) :
  card_congr (sigma_preimage_equiv (@quotient.mk' _ (orbit_rel G α))).symm
... = ∑ a : quotient (orbit_rel G α), card {x // quotient.mk' x = a} : card_sigma _
... ≡ ∑ a : fixed_points G α, 1 [MOD p] :
begin
  rw [← zmod.eq_iff_modeq_nat p, sum_nat_cast, sum_nat_cast],
  refine eq.symm (sum_bij_ne_zero (λ a _ _, quotient.mk' a.1)
    (λ _ _ _, mem_univ _)
    (λ a₁ a₂ _ _ _ _ h,
      subtype.eq ((mem_fixed_points' α).1 a₂.2 a₁.1 (quotient.exact' h)))
      (λ b, _)
      (λ a ha _, by rw [← mem_fixed_points_iff_card_orbit_eq_one.1 a.2];
        simp only [quotient.eq']; congr)),
  { refine quotient.induction_on' b (λ b _ hb, _),
    have : card (orbit G b) ∣ p ^ n,
    { rw [← h, fintype.card_congr (orbit_equiv_quotient_stabilizer G b)],
      exact card_quotient_dvd_card _ },
    rcases (nat.dvd_prime_pow hp.1).1 this with ⟨k, _, hk⟩,
    have hb' :¬ p ^ 1 ∣ p ^ k,
    { rw [pow_one, ← hk, ← nat.modeq.modeq_zero_iff, ← zmod.eq_iff_modeq_nat,
        nat.cast_zero, ← ne.def],
      exact eq.mpr (by simp only [quotient.eq']; congr) hb },
    have : k = 0 := nat.le_zero_iff.1 (nat.le_of_lt_succ (lt_of_not_ge (mt (pow_dvd_pow p) hb'))),
    refine ⟨⟨b, mem_fixed_points_iff_card_orbit_eq_one.2 $ by rw [hk, this, pow_zero]⟩,
      mem_univ _, _, rfl⟩,
    rw [nat.cast_one], exact one_ne_zero }
end
... = _ : by simp; refl

end mul_action

lemma quotient_group.card_preimage_mk [fintype G] (s : subgroup G)
  (t : set (quotient s)) : fintype.card (quotient_group.mk ⁻¹' t) =
  fintype.card s * fintype.card t :=
by rw [← fintype.card_prod, fintype.card_congr
  (preimage_mk_equiv_subgroup_times_set _ _)]

namespace sylow

/-- Given a vector `v` of length `n`, make a vector of length `n+1` whose product is `1`,
by consing the the inverse of the product of `v`. -/
def mk_vector_prod_eq_one (n : ℕ) (v : vector G n) : vector G (n+1) :=
v.to_list.prod⁻¹ ::ᵥ v

lemma mk_vector_prod_eq_one_injective (n : ℕ) : injective (@mk_vector_prod_eq_one G _ n) :=
λ ⟨v, _⟩ ⟨w, _⟩ h, subtype.eq (show v = w, by injection h with h; injection h)

/-- The type of vectors with terms from `G`, length `n`, and product equal to `1:G`. -/
def vectors_prod_eq_one (G : Type*) [group G] (n : ℕ) : set (vector G n) :=
{v | v.to_list.prod = 1}

lemma mem_vectors_prod_eq_one {n : ℕ} (v : vector G n) :
  v ∈ vectors_prod_eq_one G n ↔ v.to_list.prod = 1 := iff.rfl

lemma mem_vectors_prod_eq_one_iff {n : ℕ} (v : vector G (n + 1)) :
  v ∈ vectors_prod_eq_one G (n + 1) ↔ v ∈ set.range (@mk_vector_prod_eq_one G _ n) :=
⟨λ (h : v.to_list.prod = 1), ⟨v.tail,
  begin
    unfold mk_vector_prod_eq_one,
    conv {to_rhs, rw ← vector.cons_head_tail v},
    suffices : (v.tail.to_list.prod)⁻¹ = v.head,
    { rw this },
    rw [← mul_left_inj v.tail.to_list.prod, inv_mul_self, ← list.prod_cons,
      ← vector.to_list_cons, vector.cons_head_tail, h]
  end⟩,
  λ ⟨w, hw⟩, by rw [mem_vectors_prod_eq_one, ← hw, mk_vector_prod_eq_one,
    vector.to_list_cons, list.prod_cons, inv_mul_self]⟩

/-- The rotation action of `zmod n` (viewed as multiplicative group) on
`vectors_prod_eq_one G n`, where `G` is a multiplicative group. -/
def rotate_vectors_prod_eq_one (G : Type*) [group G] (n : ℕ)
  (m : multiplicative (zmod n)) (v : vectors_prod_eq_one G n) : vectors_prod_eq_one G n :=
⟨⟨v.1.to_list.rotate m.val, by simp⟩, prod_rotate_eq_one_of_prod_eq_one v.2 _⟩

instance rotate_vectors_prod_eq_one.mul_action (n : ℕ) [fact (0 < n)] :
  mul_action (multiplicative (zmod n)) (vectors_prod_eq_one G n) :=
{ smul := (rotate_vectors_prod_eq_one G n),
  one_smul :=
  begin
    intro v, apply subtype.eq, apply vector.eq _ _,
    show rotate _ (0 : zmod n).val = _, rw zmod.val_zero,
    exact rotate_zero v.1.to_list
  end,
  mul_smul := λ a b ⟨⟨v, hv₁⟩, hv₂⟩, subtype.eq $ vector.eq _ _ $
    show v.rotate ((a + b : zmod n).val) = list.rotate (list.rotate v (b.val)) (a.val),
    by rw [zmod.val_add, rotate_rotate, ← rotate_mod _ (b.val + a.val), add_comm, hv₁] }

lemma one_mem_vectors_prod_eq_one (n : ℕ) : vector.repeat (1 : G) n ∈ vectors_prod_eq_one G n :=
by simp [vector.repeat, vectors_prod_eq_one]

lemma one_mem_fixed_points_rotate (n : ℕ) [fact (0 < n)] :
  (⟨vector.repeat (1 : G) n, one_mem_vectors_prod_eq_one n⟩ : vectors_prod_eq_one G n) ∈
  fixed_points (multiplicative (zmod n)) (vectors_prod_eq_one G n) :=
λ m, subtype.eq $ vector.eq _ _ $
rotate_eq_self_iff_eq_repeat.2 ⟨(1 : G),
  show list.repeat (1 : G) n = list.repeat 1 (list.repeat (1 : G) n).length, by simp⟩ _

/-- Cauchy's theorem -/
lemma exists_prime_order_of_dvd_card [fintype G] (p : ℕ) [hp : fact p.prime]
  (hdvd : p ∣ card G) : ∃ x : G, order_of x = p :=
let n : ℕ+ := ⟨p - 1, nat.sub_pos_of_lt hp.1.one_lt⟩ in
have hn : p = n + 1 := nat.succ_sub hp.1.pos,
have hcard : card (vectors_prod_eq_one G (n + 1)) = card G ^ (n : ℕ),
  by rw [set.ext mem_vectors_prod_eq_one_iff,
    set.card_range_of_injective (mk_vector_prod_eq_one_injective _), card_vector],
have hzmod : fintype.card (multiplicative (zmod p)) = p ^ 1,
  by { rw pow_one p, exact zmod.card p },
have hmodeq : _ = _ := @mul_action.card_modeq_card_fixed_points
  (multiplicative (zmod p)) (vectors_prod_eq_one G p) _ _ _ _ _ _ 1 hp hzmod,
have hdvdcard : p ∣ fintype.card (vectors_prod_eq_one G (n + 1)) :=
  calc p ∣ card G ^ 1 : by rwa pow_one
  ... ∣ card G ^ (n : ℕ) : pow_dvd_pow _ n.2
  ... = card (vectors_prod_eq_one G (n + 1)) : hcard.symm,
have hdvdcard₂ : p ∣ card (fixed_points (multiplicative (zmod p)) (vectors_prod_eq_one G p)),
  by { rw nat.dvd_iff_mod_eq_zero at hdvdcard ⊢, rwa [← hn, hmodeq] at hdvdcard },
have hcard_pos : 0 < card (fixed_points (multiplicative (zmod p)) (vectors_prod_eq_one G p)) :=
  fintype.card_pos_iff.2 ⟨⟨⟨vector.repeat 1 p, one_mem_vectors_prod_eq_one _⟩,
    one_mem_fixed_points_rotate _⟩⟩,
have hlt : 1 < card (fixed_points (multiplicative (zmod p)) (vectors_prod_eq_one G p)) :=
  calc (1 : ℕ) < p : hp.1.one_lt
  ... ≤ _ : nat.le_of_dvd hcard_pos hdvdcard₂,
let ⟨⟨⟨⟨x, hx₁⟩, hx₂⟩, hx₃⟩, hx₄⟩ := fintype.exists_ne_of_one_lt_card hlt
  ⟨_, one_mem_fixed_points_rotate p⟩ in
have hx : x ≠ list.repeat (1 : G) p, from λ h, by simpa [h, vector.repeat] using hx₄,
have ∃ a, x = list.repeat a x.length := by exactI rotate_eq_self_iff_eq_repeat.1 (λ n,
  have list.rotate x (n : zmod p).val = x :=
    subtype.mk.inj (subtype.mk.inj (hx₃ (n : zmod p))),
  by rwa [zmod.val_nat_cast, ← hx₁, rotate_mod] at this),
let ⟨a, ha⟩ := this in
⟨a, have hx1 : x.prod = 1 := hx₂,
  have ha1: a ≠ 1, from λ h, hx (ha.symm ▸ h ▸ hx₁ ▸ rfl),
  have a ^ p = 1, by rwa [ha, list.prod_repeat, hx₁] at hx1,
  (hp.1.2 _ (order_of_dvd_of_pow_eq_one this)).resolve_left
    (λ h, ha1 (order_of_eq_one_iff.1 h))⟩

open subgroup submonoid is_group_hom mul_action

lemma mem_fixed_points_mul_left_cosets_iff_mem_normalizer {H : subgroup G}
  [fintype ((H : set G) : Type u)] {x : G} :
  (x : quotient H) ∈ fixed_points H (quotient H) ↔ x ∈ normalizer H :=
⟨λ hx, have ha : ∀ {y : quotient H}, y ∈ orbit H (x : quotient H) → y = x,
  from λ _, ((mem_fixed_points' _).1 hx _),
  (inv_mem_iff _).1 (@mem_normalizer_fintype _ _ _ _inst_2 _ (λ n (hn : n ∈ H),
    have (n⁻¹ * x)⁻¹ * x ∈ H := quotient_group.eq.1 (ha (mem_orbit _ ⟨n⁻¹, H.inv_mem hn⟩)),
    show _ ∈ H, by {rw [mul_inv_rev, inv_inv] at this, convert this, rw inv_inv}
    )),
λ (hx : ∀ (n : G), n ∈ H ↔ x * n * x⁻¹ ∈ H),
(mem_fixed_points' _).2 $ λ y, quotient.induction_on' y $ λ y hy, quotient_group.eq.2
  (let ⟨⟨b, hb₁⟩, hb₂⟩ := hy in
  have hb₂ : (b * x)⁻¹ * y ∈ H := quotient_group.eq.1 hb₂,
  (inv_mem_iff H).1 $ (hx _).2 $ (mul_mem_cancel_left H (H.inv_mem hb₁)).1
  $ by rw hx at hb₂;
    simpa [mul_inv_rev, mul_assoc] using hb₂)⟩

def fixed_points_mul_left_cosets_equiv_quotient (H : subgroup G) [fintype (H : set G)] :
  mul_action.fixed_points H (quotient H) ≃
  quotient (subgroup.comap ((normalizer H).subtype : normalizer H →* G) H) :=
@subtype_quotient_equiv_quotient_subtype G (normalizer H : set G) (id _) (id _) (fixed_points _ _)
  (λ a, (@mem_fixed_points_mul_left_cosets_iff_mem_normalizer _ _ _ _inst_2 _).symm)
  (by intros; refl)

/-- The first of the Sylow theorems. -/
theorem exists_subgroup_card_pow_prime [fintype G] (p : ℕ) : ∀ {n : ℕ} [hp : fact p.prime]
  (hdvd : p ^ n ∣ card G), ∃ H : subgroup G, fintype.card H = p ^ n
| 0 := λ _ _, ⟨(⊥ : subgroup G), by convert card_bot⟩
| (n+1) := λ hp hdvd,
let ⟨H, hH2⟩ := @exists_subgroup_card_pow_prime _ hp
  (dvd.trans (pow_dvd_pow _ (nat.le_succ _)) hdvd) in
let ⟨s, hs⟩ := exists_eq_mul_left_of_dvd hdvd in
have hcard : card (quotient H) = s * p :=
  (nat.mul_left_inj (show card H > 0, from fintype.card_pos_iff.2
      ⟨⟨1, H.one_mem⟩⟩)).1
    (by rwa [← card_eq_card_quotient_mul_card_subgroup H, hH2, hs,
      pow_succ', mul_assoc, mul_comm p]),
have hm : s * p % p =
  card (quotient (subgroup.comap ((normalizer H).subtype : normalizer H →* G) H)) % p :=
  card_congr (fixed_points_mul_left_cosets_equiv_quotient H) ▸ hcard ▸
    @card_modeq_card_fixed_points _ _ _ _ _ _ _ p _ hp hH2,
have hm' : p ∣ card (quotient (subgroup.comap ((normalizer H).subtype : normalizer H →* G) H)) :=
  nat.dvd_of_mod_eq_zero
    (by rwa [nat.mod_eq_zero_of_dvd (dvd_mul_left _ _), eq_comm] at hm),
let ⟨x, hx⟩ := @exists_prime_order_of_dvd_card _ (quotient_group.quotient.group _) _ _ hp hm' in
have hequiv : H ≃ (subgroup.comap ((normalizer H).subtype : normalizer H →* G) H) :=
  ⟨λ a, ⟨⟨a.1, le_normalizer a.2⟩, a.2⟩, λ a, ⟨a.1.1, a.2⟩,
    λ ⟨_, _⟩, rfl, λ ⟨⟨_, _⟩, _⟩, rfl⟩,
-- begin proof of ∃ H : subgroup G, fintype.card H = p ^ n
⟨subgroup.map ((normalizer H).subtype) (subgroup.comap
  (quotient_group.mk' (comap H.normalizer.subtype H)) (gpowers x)),
begin
  show card ↥(map H.normalizer.subtype
    (comap (mk' (comap H.normalizer.subtype H)) (subgroup.gpowers x))) = p ^ (n + 1),
  suffices : card ↥(subtype.val '' ((subgroup.comap (mk' (comap H.normalizer.subtype H))
    (gpowers x)) : set (↥(H.normalizer)))) = p^(n+1),
  { convert this using 2 },
  rw [set.card_image_of_injective
        (subgroup.comap (mk' (comap H.normalizer.subtype H)) (gpowers x) : set (H.normalizer))
        subtype.val_injective,
      pow_succ', ← hH2, fintype.card_congr hequiv, ← hx, order_eq_card_gpowers,
      ← fintype.card_prod],
  exact @fintype.card_congr _ _ (id _) (id _) (preimage_mk_equiv_subgroup_times_set _ _)
end⟩

end sylow


/-
Copyright © 2020 Nicolò Cavalleri. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Nicolò Cavalleri.
-/

/-

THIS FILE CONTAINS SCATTERED RESULTS TO BE CORRECTLY PLACED IN MATHLIB

-/

import .times_cont_mdiff
import tactic
import topology.algebra.module
import topology.algebra.continuous_functions

noncomputable theory

section prod

/-
To be placed into topology/contructions
-/

universes u v w x
variables {α : Type u} {β : Type v} {γ : Type w} {δ : Type x}

variables [topological_space α] [topological_space β] [topological_space γ] [topological_space δ]

@[inline, reducible] def map_diag (A : Type*) : (A → A×A) := (λ a : A, (a, a))

lemma continuous.map_diag : continuous (map_diag α) :=
continuous_id.prod_mk continuous_id

end prod

section

/-
To be placed into topology/local_homemorph
-/

namespace local_homeomorph

variables {α : Type*} {β : Type*} {γ : Type*} {δ : Type*} {η : Type*} {ε : Type*}
[topological_space α] [topological_space β] [topological_space γ]
[topological_space δ] [topological_space η] [topological_space ε]
(e : local_homeomorph α β) (f : local_homeomorph β γ)
(e' : local_homeomorph δ η) (f' : local_homeomorph η ε)

end local_homeomorph

end

section preamble_results

section times_cont_diff

/-
To be placed into analysis/calculus/times_cont_diff
-/

variables  {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
{E : Type*} [normed_group E] [normed_space 𝕜 E]
{F : Type*} [normed_group F] [normed_space 𝕜 F]
{G : Type*} [normed_group G] [normed_space 𝕜 G]
{T : Type*} [normed_group T] [normed_space 𝕜 T]

end times_cont_diff

section

/-
To be placed into geometry/manifold/manifold
-/

variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
  {E : Type*} [normed_group E] [normed_space 𝕜 E]
  {E' : Type*} [normed_group E'] [normed_space 𝕜 E']
  {H : Type*} [topological_space H]
  {H' : Type*} [topological_space H']

section smooth

/-
Not really sure where this should go. Either on geometry/manifold/times_cont_mdiff
or on a new file.
-/

/-- Smooth means C^∞. I truly believe this definition should exists as writing
`times_cont_mdiff I I' ⊤ f` makes everything unreadable and harder to understand for someone
who does not know Mathlib well. -/
def smooth (I : model_with_corners 𝕜 E H) (I' : model_with_corners 𝕜 E' H')
{M : Type*} [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M]
{N : Type*} [topological_space N] [charted_space H' N] [smooth_manifold_with_corners I' N]
(f: M → N) := times_cont_mdiff I I' ⊤ f

def smooth_on (I : model_with_corners 𝕜 E H) (I' : model_with_corners 𝕜 E' H')
{M : Type*} [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M]
{N : Type*} [topological_space N] [charted_space H' N] [smooth_manifold_with_corners I' N]
(f: M → N) (s : set M) := times_cont_mdiff_on I I' ⊤ f s

def smooth_in_charts (I : model_with_corners 𝕜 E H) (I' : model_with_corners 𝕜 E' H')
{M : Type*} [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M]
{N : Type*} [topological_space N] [charted_space H' N] [smooth_manifold_with_corners I' N]
(f: M → N) := times_cont_mdiff_in_charts I I' ⊤ f

def smooth_in_charts_on (I : model_with_corners 𝕜 E H) (I' : model_with_corners 𝕜 E' H')
{M : Type*} [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M]
{N : Type*} [topological_space N] [charted_space H' N] [smooth_manifold_with_corners I' N]
(f: M → N) (s : set M) := times_cont_mdiff_in_charts_on I I' ⊤ f s

variables {I : model_with_corners 𝕜 E H} {I' : model_with_corners 𝕜 E' H'}
{M : Type*} [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M]
{N : Type*} [topological_space N] [charted_space H' N] [smooth_manifold_with_corners I' N]

lemma smooth_in_charts_id : smooth_in_charts I I (id : M → M) :=
begin
  intros x y,
  rw [function.comp.left_id, set.preimage_id],
  unfold ext_chart_at,
  simp only [model_with_corners.to_local_equiv_coe_symm, local_homeomorph.coe_coe_symm, local_homeomorph.coe_coe,
    local_equiv.coe_trans, local_equiv.coe_trans_symm, model_with_corners.to_local_equiv_coe],
  have h1 := (has_groupoid.compatible (times_cont_diff_groupoid ⊤ I) (chart_mem_atlas H x) (chart_mem_atlas H y)).1,
  simp only [local_homeomorph.trans_to_local_equiv, local_homeomorph.coe_trans, local_homeomorph.symm_to_local_equiv] at h1,
  convert h1 using 1,
  unfold function.comp,
  ext1 z,
  rw set.mem_inter_eq,
  fsplit;
  simp only [local_equiv.trans_source, local_equiv.trans_target, and_imp, model_with_corners.to_local_equiv_coe_symm,
    set.mem_preimage, set.mem_range, local_homeomorph.coe_coe_symm, set.mem_inter_eq, local_equiv.symm_source,
    set.preimage_univ, model_with_corners.target, model_with_corners.source_eq, exists_imp_distrib, set.inter_univ],
  { intros w hw h2 h3, exact ⟨⟨h2, h3⟩, ⟨w, hw⟩⟩, },
  { intros h2 h3 w hw, use w, exacts [hw, h2, h3], }
end

lemma smooth_in_charts_const {n : N} : smooth_in_charts I I' (λ x : M, n) :=
begin
  intros x y,
  unfold function.comp,
  exact times_cont_diff_on_const,
end

lemma tangent_bundle_proj_smooth : smooth_in_charts I.tangent I (tangent_bundle.proj I M) :=
begin
  intros x y,
  simp only [function.comp] with mfld_simps,
  sorry,
end

end smooth

section composition

variables {E'' : Type*} [normed_group E''] [normed_space 𝕜 E'']
{H'' : Type*} [topological_space H''] {I'' : model_with_corners 𝕜 E'' H''}
{I : model_with_corners 𝕜 E H}
{I' : model_with_corners 𝕜 E' H'}
{M : Type*} [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M]
{M' : Type*} [topological_space M'] [charted_space H' M'] [smooth_manifold_with_corners I' M']
{M'' : Type*} [topological_space M''] [charted_space H'' M''] [smooth_manifold_with_corners I'' M'']

lemma smooth_on.comp {s : set M} {t : set M'} {f : M → M'} {g : M' → M''}
  (hg : smooth_on I' I'' g t) (hf : smooth_on I I' f s)
  (st : s ⊆ f ⁻¹' t) : smooth_on I I'' (g ∘ f) s :=
times_cont_mdiff_on.comp hg hf st

lemma times_cont_mdiff.comp {n : with_top ℕ} {f : M → M'} {g : M' → M''}
  (hg : times_cont_mdiff I' I'' n g) (hf : times_cont_mdiff I I' n f) :
  times_cont_mdiff I I'' n (g ∘ f) :=
begin
  have hs : (set.univ ⊆ f ⁻¹' set.univ), by rw set.preimage_univ,
  have h := (times_cont_mdiff_on_univ.2 hg).comp (times_cont_mdiff_on_univ.2 hf) hs,
  exact times_cont_mdiff_on_univ.1 h,
end

lemma smooth.comp {f : M → M'} {g : M' → M''}
  (hg : smooth I' I'' g) (hf : smooth I I' f) :
  smooth I I'' (g ∘ f) := times_cont_mdiff.comp hg hf

lemma smooth_in_charts.comp {f : M → M'} {g : M' → M''}
  (hg : smooth_in_charts I' I'' g) (hf : smooth_in_charts I I' f) :
  smooth_in_charts I I'' (g ∘ f) := sorry

end composition

end

end preamble_results


/-
Copyright (c) 2017 Simon Hudon. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Simon Hudon

! This file was ported from Lean 3 source module control.functor
! leanprover-community/mathlib commit 70d50ecfd4900dd6d328da39ab7ebd516abe4025
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathlib.Control.Basic
import Mathlib.Init.Set
import Std.Tactic.Lint

/-!
# Functors

This module provides additional lemmas, definitions, and instances for `Functor`s.

## Main definitions

* `Functor.Const α` is the functor that sends all types to `α`.
* `Functor.AddConst α` is `Functor.Const α` but for when `α` has an additive structure.
* `Functor.Comp F G` for functors `F` and `G` is the functor composition of `F` and `G`.
* `Liftp` and `Liftr` respectively lift predicates and relations on a type `α`
  to `F α`.  Terms of `F α` are considered to, in some sense, contain values of type `α`.

## Tags

functor, applicative
-/

attribute [functor_norm] seq_assoc pure_seq map_pure seq_map_assoc map_seq

universe u v w

section Functor

variable {F : Type u → Type v}

variable {α β γ : Type u}

variable [Functor F] [LawfulFunctor F]

theorem Functor.map_id : (· <$> ·) id = (id : F α → F α) := by apply funext <;> apply id_map
#align functor.map_id Functor.map_id

theorem Functor.map_comp_map (f : α → β) (g : β → γ) :
    ((· <$> ·) g ∘ (· <$> ·) f : F α → F γ) = (· <$> ·) (g ∘ f) :=
  funext <| fun _ => (comp_map _ _ _).symm
  -- porting note: was `apply funext <;> intro <;> rw [comp_map]` but `rw` failed?
#align functor.map_comp_map Functor.map_comp_map

theorem Functor.ext {F} :
    ∀ {F1 : Functor F} {F2 : Functor F} [@LawfulFunctor F F1] [@LawfulFunctor F F2],
    (∀ (α β) (f : α → β) (x : F α), @Functor.map _ F1 _ _ f x = @Functor.map _ F2 _ _ f x) →
    F1 = F2
  | ⟨m, mc⟩, ⟨m', mc'⟩, H1, H2, H => by
    cases show @m = @m' by funext α β f x; apply H
    congr
    funext α β
    have E1 := @map_const _ ⟨@m, @mc⟩ H1
    have E2 := @map_const _ ⟨@m, @mc'⟩ H2
    exact E1.trans E2.symm
#align functor.ext Functor.ext

end Functor

/-- Introduce `id` as a quasi-functor. (Note that where a lawful `Monad` or
`Applicative` or `Functor` is needed, `Id` is the correct definition). -/
def id.mk {α : Sort u} : α → id α :=
  id
#align id.mk id.mk

namespace Functor

/-- `Const α` is the constant functor, mapping every type to `α`. When
`α` has a monoid structure, `Const α` has an `Applicative` instance.
(If `α` has an additive monoid structure, see `Functor.AddConst`.) -/
@[nolint unusedArguments]
def Const (α : Type _) (_β : Type _) :=
  α
#align functor.const Functor.Const

/-- `Const.mk` is the canonical map `α → Const α β` (the identity), and
it can be used as a pattern to extract this value. -/
@[match_pattern]
def Const.mk {α β} (x : α) : Const α β :=
  x
#align functor.const.mk Functor.Const.mk

/-- `Const.mk'` is `Const.mk` but specialized to map `α` to
`Const α PUnit`, where `PUnit` is the terminal object in `Type _`. -/
def Const.mk' {α} (x : α) : Const α PUnit :=
  x
#align functor.const.mk' Functor.Const.mk'

/-- Extract the element of `α` from the `Const` functor. -/
def Const.run {α β} (x : Const α β) : α :=
  x
#align functor.const.run Functor.Const.run

namespace Const

protected theorem ext {α β} {x y : Const α β} (h : x.run = y.run) : x = y :=
  h
#align functor.const.ext Functor.Const.ext

/-- The map operation of the `Const γ` functor. -/
@[nolint unusedArguments]
protected def map {γ α β} (_f : α → β) (x : Const γ β) : Const γ α :=
  x
#align functor.const.map Functor.Const.map

instance functor {γ} : Functor (Const γ) where map := @Const.map γ

instance lawfulFunctor {γ} : LawfulFunctor (Const γ) := by constructor <;> intros <;> rfl

instance {α β} [Inhabited α] : Inhabited (Const α β) :=
  ⟨(default : α)⟩

end Const

/-- `AddConst α` is a synonym for constant functor `Const α`, mapping
every type to `α`. When `α` has a additive monoid structure,
`AddConst α` has an `Applicative` instance. (If `α` has a
multiplicative monoid structure, see `Functor.Const`.) -/
def AddConst (α : Type _) :=
  Const α
#align functor.add_const Functor.AddConst

/-- `AddConst.mk` is the canonical map `α → AddConst α β`, which is the identity,
where `AddConst α β = Const α β`. It can be used as a pattern to extract this value. -/
@[match_pattern]
def AddConst.mk {α β} (x : α) : AddConst α β :=
  x
#align functor.add_const.mk Functor.AddConst.mk

/-- Extract the element of `α` from the constant functor. -/
def AddConst.run {α β} : AddConst α β → α :=
  id
#align functor.add_const.run Functor.AddConst.run

instance AddConst.functor {γ} : Functor (AddConst γ) :=
  @Const.functor γ
#align functor.add_const.functor Functor.AddConst.functor

instance AddConst.lawfulFunctor {γ} : LawfulFunctor (AddConst γ) :=
  @Const.lawfulFunctor γ
#align functor.add_const.is_lawful_functor Functor.AddConst.lawfulFunctor

instance {α β} [Inhabited α] : Inhabited (AddConst α β) :=
  ⟨(default : α)⟩

/-- `Functor.Comp` is a wrapper around `Function.Comp` for types.
    It prevents Lean's type class resolution mechanism from trying
    a `Functor (Comp F id)` when `Functor F` would do. -/
def Comp (F : Type u → Type w) (G : Type v → Type u) (α : Type v) : Type w :=
  F <| G α
#align functor.comp Functor.Comp

/-- Construct a term of `Comp F G α` from a term of `F (G α)`, which is the same type.
Can be used as a pattern to extract a term of `F (G α)`. -/
@[match_pattern]
def Comp.mk {F : Type u → Type w} {G : Type v → Type u} {α : Type v} (x : F (G α)) : Comp F G α :=
  x
#align functor.comp.mk Functor.Comp.mk

/-- Extract a term of `F (G α)` from a term of `Comp F G α`, which is the same type. -/
def Comp.run {F : Type u → Type w} {G : Type v → Type u} {α : Type v} (x : Comp F G α) : F (G α) :=
  x
#align functor.comp.run Functor.Comp.run

namespace Comp

variable {F : Type u → Type w} {G : Type v → Type u}

protected theorem ext {α} {x y : Comp F G α} : x.run = y.run → x = y :=
  id
#align functor.comp.ext Functor.Comp.ext

instance {α} [Inhabited (F (G α))] : Inhabited (Comp F G α) :=
  ⟨(default : F (G α))⟩

variable [Functor F] [Functor G]

/-- The map operation for the composition `Comp F G` of functors `F` and `G`. -/
protected def map {α β : Type v} (h : α → β) : Comp F G α → Comp F G β
  | Comp.mk x => Comp.mk ((· <$> ·) h <$> x)
#align functor.comp.map Functor.Comp.map

instance functor : Functor (Comp F G) where map := @Comp.map F G _ _

@[functor_norm]
theorem map_mk {α β} (h : α → β) (x : F (G α)) : h <$> Comp.mk x = Comp.mk ((· <$> ·) h <$> x) :=
  rfl
#align functor.comp.map_mk Functor.Comp.map_mk

@[simp]
protected theorem run_map {α β} (h : α → β) (x : Comp F G α) :
    (h <$> x).run = (· <$> ·) h <$> x.run :=
  rfl
#align functor.comp.run_map Functor.Comp.run_map

variable [LawfulFunctor F] [LawfulFunctor G]

variable {α β γ : Type v}

protected theorem id_map : ∀ x : Comp F G α, Comp.map id x = x
  | Comp.mk x => by simp [Comp.map, Functor.map_id]; rfl
  -- porting note: `rfl` wasn't needed in mathlib3
#align functor.comp.id_map Functor.Comp.id_map

protected theorem comp_map (g' : α → β) (h : β → γ) :
    ∀ x : Comp F G α, Comp.map (h ∘ g') x = Comp.map h (Comp.map g' x)
  | Comp.mk x => by simp [Comp.map, Comp.mk, Functor.map_comp_map, functor_norm]
  -- porting note: `Comp.mk` wasn't needed in mathlib3
#align functor.comp.comp_map Functor.Comp.comp_map

instance lawfulFunctor : LawfulFunctor (Comp F G) where
  map_const := rfl
  id_map := @Comp.id_map F G _ _ _ _
  comp_map := @Comp.comp_map F G _ _ _ _

-- porting note: had to use switch to `Id` from `id` because this has the `Functor` instance.
theorem functor_comp_id {F} [AF : Functor F] [LawfulFunctor F] :
    @Comp.functor F Id _ _ = AF :=
  @Functor.ext F _ AF (@Comp.lawfulFunctor F Id _ _ _ _) _ fun _ _ _ _ => rfl
#align functor.comp.functor_comp_id Functor.Comp.functor_comp_id

-- porting note: had to use switch to `Id` from `id` because this has the `Functor` instance.
theorem functor_id_comp {F} [AF : Functor F] [LawfulFunctor F] : @Comp.functor Id F _ _ = AF :=
  @Functor.ext F _ AF (@Comp.lawfulFunctor Id F _ _ _ _) _ fun _ _ _ _ => rfl
#align functor.comp.functor_id_comp Functor.Comp.functor_id_comp

end Comp

namespace Comp

open Function hiding comp

open Functor

variable {F : Type u → Type w} {G : Type v → Type u}

variable [Applicative F] [Applicative G]

/-- The `<*>` operation for the composition of applicative functors. -/
protected def seq {α β : Type v} : Comp F G (α → β) → (Unit → Comp F G α) → Comp F G β
  | Comp.mk f, g => match g () with
    | Comp.mk x => Comp.mk <| (· <*> ·) <$> f <*> x
#align functor.comp.seq Functor.Comp.seqₓ
-- `ₓ` because the type of `Seq.seq` doesn't match `has_seq.seq`

instance : Pure (Comp F G) :=
  ⟨fun x => Comp.mk <| pure <| pure x⟩

instance : Seq (Comp F G) :=
  ⟨fun f x => Comp.seq f x⟩

@[simp]
protected theorem run_pure {α : Type v} : ∀ x : α, (pure x : Comp F G α).run = pure (pure x)
  | _ => rfl
#align functor.comp.run_pure Functor.Comp.run_pure

@[simp]
protected theorem run_seq {α β : Type v} (f : Comp F G (α → β)) (x : Comp F G α) :
    (f <*> x).run = (· <*> ·) <$> f.run <*> x.run :=
  rfl
#align functor.comp.run_seq Functor.Comp.run_seq

instance : Applicative (Comp F G) :=
  { instPureComp with map := @Comp.map F G _ _, seq := @Comp.seq F G _ _ }

end Comp

variable {F : Type u → Type u} [Functor F]

/-- If we consider `x : F α` to, in some sense, contain values of type `α`,
predicate `Liftp p x` holds iff every value contained by `x` satisfies `p`. -/
def Liftp {α : Type u} (p : α → Prop) (x : F α) : Prop :=
  ∃ u : F (Subtype p), Subtype.val <$> u = x
#align functor.liftp Functor.Liftp

/-- If we consider `x : F α` to, in some sense, contain values of type `α`, then
`Liftr r x y` relates `x` and `y` iff (1) `x` and `y` have the same shape and
(2) we can pair values `a` from `x` and `b` from `y` so that `r a b` holds. -/
def Liftr {α : Type u} (r : α → α → Prop) (x y : F α) : Prop :=
  ∃ u : F { p : α × α // r p.fst p.snd },
    (fun t : { p : α × α // r p.fst p.snd } => t.val.fst) <$> u = x ∧
      (fun t : { p : α × α // r p.fst p.snd } => t.val.snd) <$> u = y
#align functor.liftr Functor.Liftr

/-- If we consider `x : F α` to, in some sense, contain values of type `α`, then
`supp x` is the set of values of type `α` that `x` contains. -/
def supp {α : Type u} (x : F α) : Set α :=
  { y : α | ∀ ⦃p⦄, Liftp p x → p y }
#align functor.supp Functor.supp

theorem of_mem_supp {α : Type u} {x : F α} {p : α → Prop} (h : Liftp p x) : ∀ y ∈ supp x, p y :=
  fun _ hy => hy h
#align functor.of_mem_supp Functor.of_mem_supp

/-- If `f` is a functor, if `fb : f β` and `a : α`, then `mapConstRev fb a` is the result of
  applying `f.map` to the constant function `β → α` sending everything to `a`, and then
  evaluating at `fb`. In other words it's `const a <$> fb`. -/
@[reducible] def mapConstRev {f : Type u → Type v} [Functor f] {α β : Type u} :
    f β → α → f α :=
  fun a b => Functor.mapConst b a
#align functor.map_const_rev Functor.mapConstRev
/-- If `f` is a functor, if `fb : f β` and `a : α`, then `mapConstRev fb a` is the result of
  applying `f.map` to the constant function `β → α` sending everything to `a`, and then
  evaluating at `fb`. In other words it's `const a <$> fb`. -/
infix:100 " $> " => Functor.mapConstRev

end Functor


namespace list

variables {α β γ : Type}

def map_witness : ∀ (l : list α), (Π x ∈ l, β) → list β
| [] _ := []
| (x :: xs) f
  := f x (mem_cons_self x xs)
  :: map_witness xs (λ x' mem, f x' (mem_cons_of_mem x mem))

lemma map_witness_mem :
  ∀ {l : list α} {x : α} (f : Π x ∈ l, β) (mem : x ∈ l)
  , f x mem ∈ map_witness l f
| [] x f mem := not_mem_nil x mem
| (x :: xs) x' f mem :=
  match mem with
  | or.inl here := by simp [map_witness, here]
  | or.inr there := begin
      simp [map_witness],
      from or.inr (map_witness_mem _ there)
    end
  end

lemma map_witness_to_map (f : α → β) :
  ∀ (l : list α), map_witness l (λ x _, f x) = map f l
| [] := rfl
| (x :: xs) := by { simp [map_witness], from map_witness_to_map xs }

@[simp]
lemma map_witness_id (l : list α) : map_witness l (λ x _, x) = l := begin
  have h : (λ (x : α), x) = id := rfl,
  rw [map_witness_to_map _ l, h],
  simp
end

@[simp]
lemma map_witness_map :
  ∀ (l : list α) (f : (Π x ∈ l, β)) (g : β → γ)
  , map g (map_witness l f) = map_witness l (λ a mem, g (f a mem))
| [] _ _ := rfl
| (x :: xs) f g := by { simp [map_witness, map], from map_witness_map xs _ g }

lemma map_witness_length :
  ∀ (l : list α) (f : (Π x ∈ l, β))
  , length (map_witness l f) = length l
| [] _ := rfl
| (x :: xs) f := by { unfold map_witness length, rw map_witness_length xs }

end list


import ..time.time
import tactic.ext

universes u

variables   {tf : time_frame} (ts : time_space tf) (V : Type u)
  [inhabited V] /-Questionable whether to use inhabited.default as a default value-/
/-
structure timestamped :=
  (timestamp : time ts)

@[class]
structure has_timestamp (V : Type u) :=
  (get_timestamp : V → time ts)

instance : has_timestamp ts (timestamped ts) := ⟨λts, ts.timestamp⟩
-/
structure timestamped :=
(timestamp : time ts)
(value : V)

@[simp]
noncomputable def mk_default_timestamped : timestamped ts V :=
  ⟨inhabited.default (time ts), inhabited.default V⟩

noncomputable instance : inhabited (timestamped ts V) := ⟨mk_default_timestamped ts V⟩

@[simp]
lemma nathelper :  ∀ (a b : ℕ), a + b < a → false :=
begin
  intros a b c,
  cases b,
  suffices : ¬a < a, from by contradiction, exact irrefl _,
  let h1 : 0 < b.succ := by simp *,
  let h2 : a + 0 < a + b.succ := by simp *,
  let h3 : a + 0 < a := by exact lt_trans h2 c,
  suffices : ¬a < a, from by contradiction, exact irrefl _,

end

@[simp]
lemma nathelper2 :  ∀ (a b : ℕ), b + a < a → false :=
begin
  intros a b c,
  rw ←(nat.add_comm a b) at c,
  exact nathelper _ _ c,
end
/-

    let ht :  i_val + 1 = i_val.succ := by repeat { apply nat.add_one _ },
          rw ←ht at i_property,
          let : false := by exact eznat2 _ _ i_property,
    contradiction,
-/
instance timelt : has_lt (time ts) := ⟨
  λt1 t2, t1.coord < t2.coord
⟩
instance timele : has_le (time ts) := ⟨
  λt1 t2, t1.coord ≤ t2.coord
⟩
instance durationlt : has_lt (duration ts) := ⟨
  λt1 t2, t1.coord < t2.coord
⟩
instance durationle : has_le (duration ts) := ⟨
  λt1 t2, t1.coord ≤ t2.coord
⟩

instance [has_le (time ts)] [has_lt (time ts)]: preorder (time ts) := ⟨
  --has_le.le, has_lt.lt,
  λt1 t2, t1.coord ≤ t2.coord,
  λt1 t2, t1.coord < t2.coord,
  begin
    intros,
    simp *,
  end,
  begin
    simp *,
    intros a b c d e,
    transitivity,
    apply d,
    apply e,
    --simp
  end,
  begin
    simp *,
    intros a b,
    split,
    assume h,
    split,
    exact (le_not_le_of_lt h).1,
    apply h,
    assume h,
    exact h.2,
  end
⟩

noncomputable instance eqd {t1 t2 : time ts} : decidable (t1 = t2) :=
  if eqc:t1.coord=t2.coord then
    begin
      --cases t1, cases t2, cases t1, cases t2,
      unfold time.coord at eqc,
      cases t1,cases t2,
      let h : ∀i, t1.coords i = t2.coords i := begin
        intros,
        cases i,
        cases i_val,
        ext,
        exact eqc,
        let ht :  i_val + 1 = i_val.succ := by repeat { apply nat.add_one _ },rw ←ht at i_property,
        let : false := by exact nathelper2 _ _ i_property,
        contradiction,
      end,
      let h1 : t1 = t2 := begin ext,
        let h := h x,
        simp [h],
      end,
      simp [h1],
      exact decidable.is_true true.intro,
    end
  else
    begin
      --cases t1, cases t2, cases t1, cases t2,
      unfold time.coord at eqc,
      cases t1,cases t2,
      let h : ∀i, ¬t1.coords i = t2.coords i := begin
        intros,
        cases i,
        cases i_val,
        cases (t1.coords ⟨0, i_property⟩),
        cases (t2.coords ⟨0, i_property⟩),
        simp [eqc],

        --ext,
        let ht :  i_val + 1 = i_val.succ := by repeat { apply nat.add_one _ },rw ←ht at i_property,
        let : false := by exact nathelper2 _ _ i_property,
        contradiction,
      end,
      let h1 : ¬t1 = t2 := begin assume teq,
        let : (({to_point := t1} : time _).to_point.coords 0).coord =
              (({to_point := t2} : time _).to_point.coords 0).coord :=
          by rw ←teq,
        contradiction
      end,
      --simp [h1],
      exact decidable.is_false (by simp [h1]),
    end

--instance ltd {t1 t2 : time ts} : decidable (t1 < t2) := sorry
--instance leqd {t1 t2 : time ts} : decidable (t1 ≤ t2) := sorry

abbreviation time_series := time ts → V

abbreviation time_series.Icc (min_t max_t : time ts) :=
  set.Icc min_t max_t → V

abbreviation time_series.Ici (min_t : time ts) :=
  set.Ici min_t → V

def time_series.mk_empty {tf : time_frame} {ts : time_space tf} {V : Type u}
  [inhabited V]
  : time_series ts V := λi, inhabited.default V

noncomputable def time_series.update {tf : time_frame} {ts : time_space tf} {V : Type u}
  [inhabited V] :
  time_series ts V → time ts → V → time_series ts V
| ser t_ val_ := --λt, if t = t_ then val_ else ser t
  function.update ser t_ val_

def time_series.sample {tf : time_frame} {ts : time_space tf} {V : Type u}
  [inhabited V]
  : time_series ts V → time ts → V :=
  λser tm , ser tm

def time_series.Icc.sample
  {tf : time_frame} {ts : time_space tf} {V : Type u} [inhabited V] {min_t max_t : time ts}
  : time_series.Icc ts V min_t max_t → set.Icc min_t max_t → V :=
  λser tm , ser tm

def time_series.Ici.sample
  {tf : time_frame} {ts : time_space tf} {V : Type u} [inhabited V] {min_t : time ts}
  : time_series.Ici ts V min_t → set.Ici min_t → V :=
  λser tm , ser tm

abbreviation discrete_series {tf : time_frame} (ts : time_space tf) (V : Type u) [inhabited V] :=
  list (timestamped ts V)

def discrete_series.mk_empty {tf : time_frame} {ts : time_space tf} {V : Type u}
  [inhabited V] : discrete_series ts V := []

#check list.range
#check set.mem

def discrete_series.domain {tf : time_frame} {ts : time_space tf} {V : Type u}
  [inhabited V] :
  discrete_series ts V → list (time ts) :=
  λser, list.map (λtsv : timestamped ts V, tsv.timestamp) ser

def discrete_series.update {tf : time_frame} {ts : time_space tf} {V : Type u}
  [inhabited V] :
  discrete_series ts V → timestamped ts V → discrete_series ts V
--| [] ts_ val_ := [(ts_, val_)]
--| (h::t) ts_ val_ := (h::t ++ [(ts_, val_)] :  list (timestamped ts V))
| ser tsv := ser.cons tsv

@[simp, reducible]
noncomputable def discrete_series.latest_helper {tf : time_frame} {ts : time_space tf} {V : Type u}
  [inhabited V] :
  discrete_series ts V → (timestamped ts V) → (timestamped ts V)
| (h::t) v := if h.timestamp > v.timestamp then discrete_series.latest_helper t h else discrete_series.latest_helper t v
| [] v := v

@[simp, reducible]
noncomputable def discrete_series.latest {tf : time_frame} {ts : time_space tf} {V : Type u}
  [inhabited V] :
  discrete_series ts V → (timestamped ts V)
| (h::t) := discrete_series.latest_helper t h
| [] :=  ⟨inhabited.default (time ts), inhabited.default V⟩

abbreviation discrete_series.Icc {tf : time_frame} (ts : time_space tf) (V : Type u) [inhabited V]
  (min_t max_t : time ts) :=
  list (set.Icc min_t max_t × V)

abbreviation discrete_series.Ici {tf : time_frame} (ts : time_space tf) (V : Type u) [inhabited V]
  (min_t : time ts) :=
  list (set.Ici min_t × V)

noncomputable def discrete_series.sample  {tf : time_frame} {ts : time_space tf} {V : Type u}
  [inhabited V]
  : discrete_series ts V → time ts → V
| [] t_ := inhabited.default V
| (h::t) t_ := if h.timestamp = t_ then h.value else discrete_series.sample t t_

noncomputable def discrete_series.sample_floor_helper {tf : time_frame} {ts : time_space tf} {V : Type u} [inhabited V]
  (v : time ts) : discrete_series ts V → option (timestamped ts V) → V
| [] (none) := inhabited.default V
| [] (some t_) := t_.value
| (h::t) (some t_) :=
  if t_.timestamp < h.timestamp ∧ h.timestamp ≤ v
  then discrete_series.sample_floor_helper t (some h)
  else discrete_series.sample_floor_helper t (some t_)
| (h::t) (none) :=
  if h.timestamp ≤ v
  then discrete_series.sample_floor_helper t (some h)
  else discrete_series.sample_floor_helper t none

noncomputable def discrete_series.sample_floor {tf : time_frame} {ts : time_space tf} {V : Type u} [inhabited V]
  : discrete_series ts V → time ts → V :=
  λser t, discrete_series.sample_floor_helper t ser none

noncomputable def discrete_series.sample_ceil_helper {tf : time_frame} {ts : time_space tf} {V : Type u} [inhabited V]
  (v : time ts) : discrete_series ts V → option (timestamped ts V) → V
| [] (none) := inhabited.default V
| [] (some t_) := t_.value
| (h::t) (some t_) :=
  if h.timestamp < t_.timestamp ∧ v ≤ h.timestamp
  then discrete_series.sample_ceil_helper t (some h)
  else discrete_series.sample_ceil_helper t (some t_)
| (h::t) (none) :=
  if v ≤ h.timestamp
  then discrete_series.sample_ceil_helper t (some h)
  else discrete_series.sample_ceil_helper t none

noncomputable def discrete_series.sample_ceil {tf : time_frame} {ts : time_space tf} {V : Type u} [inhabited V]
  : discrete_series ts V → time ts → V :=
  λser t, discrete_series.sample_ceil_helper t ser none

noncomputable def discrete_series.Icc.sample {min_t max_t : time ts}
  : discrete_series.Icc ts V min_t max_t → time ts → V
| [] t_ := inhabited.default V
| (h::t) t_ := if h.timestamp.1 = t_ then h.value else discrete_series.Icc.sample t t_

noncomputable def discrete_series.Icc.sample_floor_helper {tf : time_frame} {ts : time_space tf} {V : Type u} [inhabited V] {min_t max_t : time ts}
  (v : set.Icc min_t max_t) : discrete_series.Icc ts V min_t max_t → option (set.Icc min_t max_t × V) → V
| [] (none) := inhabited.default V
| [] (some t_) := t_.value
| (h::t) (some t_) :=
  if t_.timestamp.val < h.timestamp ∧ h.timestamp.val ≤ v
  then discrete_series.Icc.sample_floor_helper t (some h)
  else discrete_series.Icc.sample_floor_helper t (some t_)
| (h::t) (none) :=
  if h.timestamp.val ≤ v
  then discrete_series.Icc.sample_floor_helper t (some h)
  else discrete_series.Icc.sample_floor_helper t none

def discrete_series.Icc.sample_floor
  {tf : time_frame} {ts : time_space tf} {V : Type u} [inhabited V] {min_t max_t : time ts}
  : discrete_series.Icc ts V min_t max_t → set.Icc min_t max_t → V :=
  λser t, discrete_series.Icc.sample_floor_helper t ser none

def discrete_series.Icc.sample_ceil_helper {tf : time_frame} {ts : time_space tf} {V : Type u} [inhabited V] {min_t max_t : time ts}
  (v : set.Icc min_t max_t) : discrete_series.Icc ts V min_t max_t → option (set.Icc min_t max_t × V) → V
| [] (none) := inhabited.default V
| [] (some t_) := t_.value
| (h::t) (some t_) :=
  if h.timestamp.val < t_.timestamp.val ∧ v.val ≤ h.timestamp.val
  then discrete_series.Icc.sample_ceil_helper t (some h)
  else discrete_series.Icc.sample_ceil_helper t (some t_)
| (h::t) (none) :=
  if v.val ≤ h.timestamp.val
  then discrete_series.Icc.sample_ceil_helper t (some h)
  else discrete_series.Icc.sample_ceil_helper t none

def discrete_series.Icc.sample_ceil {tf : time_frame} {ts : time_space tf} {V : Type u} [inhabited V] {min_t max_t : time ts}
  : discrete_series.Icc ts V min_t max_t → set.Icc min_t max_t → V :=
  λser t, discrete_series.Icc.sample_ceil_helper t ser none

def discrete_series.Ici.sample {min_t : time ts}
  : discrete_series.Ici ts V min_t → time ts → V
| [] t_ := inhabited.default V
| (h::t) t_ := if h.timestamp.1 = t_ then h.value else discrete_series.Ici.sample t t_

def discrete_series.Ici.sample_floor_helper {tf : time_frame} {ts : time_space tf} {V : Type u} [inhabited V] {min_t : time ts}
  (v : set.Ici min_t) : discrete_series.Ici ts V min_t → option (set.Ici min_t × V) → V
| [] (none) := inhabited.default V
| [] (some t_) := t_.value
| (h::t) (some t_) :=
  if t_.timestamp.val < h.timestamp ∧ h.timestamp.val ≤ v
  then discrete_series.Ici.sample_floor_helper t (some h)
  else discrete_series.Ici.sample_floor_helper t (some t_)
| (h::t) (none) :=
  if h.timestamp.val ≤ v
  then discrete_series.Ici.sample_floor_helper t (some h)
  else discrete_series.Ici.sample_floor_helper t none

def discrete_series.Ici.sample_floor
  {tf : time_frame} {ts : time_space tf} {V : Type u} [inhabited V] {min_t : time ts}
  : discrete_series.Ici ts V min_t → set.Ici min_t → V :=
  λser t, discrete_series.Ici.sample_floor_helper t ser none

def discrete_series.Ici.sample_ceil_helper {tf : time_frame} {ts : time_space tf} {V : Type u} [inhabited V] {min_t : time ts}
  (v : set.Ici min_t) : discrete_series.Ici ts V min_t → option (set.Ici min_t × V) → V
| [] (none) := inhabited.default V
| [] (some t_) := t_.value
| (h::t) (some t_) :=
  if h.timestamp.val < t_.timestamp.val ∧ v.val ≤ h.timestamp.val
  then discrete_series.Ici.sample_ceil_helper t (some h)
  else discrete_series.Ici.sample_ceil_helper t (some t_)
| (h::t) (none) :=
  if v.val ≤ h.timestamp.val
  then discrete_series.Ici.sample_ceil_helper t (some h)
  else discrete_series.Ici.sample_ceil_helper t none

def discrete_series.Ici.sample_ceil {tf : time_frame} {ts : time_space tf} {V : Type u} [inhabited V] {min_t : time ts}
  : discrete_series.Ici ts V min_t → set.Ici min_t → V :=
  λser t, discrete_series.Ici.sample_ceil_helper t ser none

/-
abbreviation discrete_timestamped_series {tf : time_frame} (ts : time_space tf) (V : Type u) [inhabited V] :=
  list (timestamped ts V)

def discrete_timestamped_series.mk_empty {tf : time_frame} {ts : time_space tf} {V : Type u}
  [inhabited V] : discrete_timestamped_series ts V := []

def discrete_timestamped_series.update {tf : time_frame} {ts : time_space tf} {V : Type u}
  [inhabited V] :
  discrete_timestamped_series ts V → time ts → V → discrete_timestamped_series ts V
--| [] ts_ val_ := [(ts_, val_)]
--| (h::t) ts_ val_ := (h::t ++ [(ts_, val_)] :  list (timestamped ts V))
| ser ts_ val_ := ser.cons (ts_, val_)

def discrete_timestamped_series.latest_helper {tf : time_frame} {ts : time_space tf} {V : Type u}
  [inhabited V] :
  discrete_timestamped_series ts V → (timestamped ts V) → V
| (h::t) v := if h.timestamp > v.timestamp then discrete_timestamped_series.latest_helper t h else discrete_timestamped_series.latest_helper t v
| [] v := v.value

def discrete_timestamped_series.latest {tf : time_frame} {ts : time_space tf} {V : Type u}
  [inhabited V] :
  discrete_timestamped_series ts V → V
| (h::t) := discrete_timestamped_series.latest_helper t h
| [] :=  inhabited.default V

abbreviation discrete_timestamped_series.Icc {tf : time_frame} (ts : time_space tf) (V : Type u) [inhabited V]
  (min_t max_t : time ts) :=
  list (set.Icc min_t max_t × V)

abbreviation discrete_timestamped_series.Ici {tf : time_frame} (ts : time_space tf) (V : Type u) [inhabited V]
  (min_t : time ts) :=
  list (set.Ici min_t × V)

def discrete_timestamped_series.sample  {tf : time_frame} {ts : time_space tf} {V : Type u}
  [inhabited V]
  : discrete_timestamped_series ts V → time ts → V
| [] t_ := inhabited.default V
| (h::t) t_ := if h.timestamp = t_ then h.value else discrete_timestamped_series.sample t t_

def discrete_timestamped_series.sample_floor_helper {tf : time_frame} {ts : time_space tf} {V : Type u} [inhabited V]
  (v : time ts) : discrete_timestamped_series ts V → option (timestamped ts V) → V
| [] (none) := inhabited.default V
| [] (some t_) := t_.value
| (h::t) (some t_) :=
  if t_.timestamp < h.timestamp ∧ h.timestamp ≤ v
  then discrete_timestamped_series.sample_floor_helper t (some h)
  else discrete_timestamped_series.sample_floor_helper t (some t_)
| (h::t) (none) :=
  if h.timestamp ≤ v
  then discrete_timestamped_series.sample_floor_helper t (some h)
  else discrete_timestamped_series.sample_floor_helper t none

def discrete_timestamped_series.sample_floor {tf : time_frame} {ts : time_space tf} {V : Type u} [inhabited V]
  : discrete_timestamped_series ts V → time ts → V :=
  λser t, discrete_timestamped_series.sample_floor_helper t ser none

def discrete_timestamped_series.sample_ceil_helper {tf : time_frame} {ts : time_space tf} {V : Type u} [inhabited V]
  (v : time ts) : discrete_timestamped_series ts V → option (timestamped ts V) → V
| [] (none) := inhabited.default V
| [] (some t_) := t_.value
| (h::t) (some t_) :=
  if h.timestamp < t_.timestamp ∧ v ≤ h.timestamp
  then discrete_timestamped_series.sample_ceil_helper t (some h)
  else discrete_timestamped_series.sample_ceil_helper t (some t_)
| (h::t) (none) :=
  if v ≤ h.timestamp
  then discrete_timestamped_series.sample_ceil_helper t (some h)
  else discrete_timestamped_series.sample_ceil_helper t none

def discrete_timestamped_series.sample_ceil {tf : time_frame} {ts : time_space tf} {V : Type u} [inhabited V]
  : discrete_timestamped_series ts V → time ts → V :=
  λser t, discrete_timestamped_series.sample_ceil_helper t ser none

def discrete_timestamped_series.Icc.sample {min_t max_t : time ts}
  : discrete_timestamped_series.Icc ts V min_t max_t → time ts → V
| [] t_ := inhabited.default V
| (h::t) t_ := if h.timestamp.1 = t_ then h.value else discrete_timestamped_series.Icc.sample t t_

def discrete_timestamped_series.Icc.sample_floor_helper {tf : time_frame} {ts : time_space tf} {V : Type u} [inhabited V] {min_t max_t : time ts}
  (v : set.Icc min_t max_t) : discrete_timestamped_series.Icc ts V min_t max_t → option (set.Icc min_t max_t × V) → V
| [] (none) := inhabited.default V
| [] (some t_) := t_.value
| (h::t) (some t_) :=
  if t_.timestamp.val < h.timestamp ∧ h.timestamp.val ≤ v
  then discrete_timestamped_series.Icc.sample_floor_helper t (some h)
  else discrete_timestamped_series.Icc.sample_floor_helper t (some t_)
| (h::t) (none) :=
  if h.timestamp.val ≤ v
  then discrete_timestamped_series.Icc.sample_floor_helper t (some h)
  else discrete_timestamped_series.Icc.sample_floor_helper t none

def discrete_timestamped_series.Icc.sample_floor
  {tf : time_frame} {ts : time_space tf} {V : Type u} [inhabited V] {min_t max_t : time ts}
  : discrete_timestamped_series.Icc ts V min_t max_t → set.Icc min_t max_t → V :=
  λser t, discrete_timestamped_series.Icc.sample_floor_helper t ser none

def discrete_timestamped_series.Icc.sample_ceil_helper {tf : time_frame} {ts : time_space tf} {V : Type u} [inhabited V] {min_t max_t : time ts}
  (v : set.Icc min_t max_t) : discrete_timestamped_series.Icc ts V min_t max_t → option (set.Icc min_t max_t × V) → V
| [] (none) := inhabited.default V
| [] (some t_) := t_.value
| (h::t) (some t_) :=
  if h.timestamp.val < t_.timestamp.val ∧ v.val ≤ h.timestamp.val
  then discrete_timestamped_series.Icc.sample_ceil_helper t (some h)
  else discrete_timestamped_series.Icc.sample_ceil_helper t (some t_)
| (h::t) (none) :=
  if v.val ≤ h.timestamp.val
  then discrete_timestamped_series.Icc.sample_ceil_helper t (some h)
  else discrete_timestamped_series.Icc.sample_ceil_helper t none

def discrete_timestamped_series.Icc.sample_ceil {tf : time_frame} {ts : time_space tf} {V : Type u} [inhabited V] {min_t max_t : time ts}
  : discrete_timestamped_series.Icc ts V min_t max_t → set.Icc min_t max_t → V :=
  λser t, discrete_timestamped_series.Icc.sample_ceil_helper t ser none

def discrete_timestamped_series.Ici.sample {min_t : time ts}
  : discrete_timestamped_series.Ici ts V min_t → time ts → V
| [] t_ := inhabited.default V
| (h::t) t_ := if h.timestamp.1 = t_ then h.value else discrete_timestamped_series.Ici.sample t t_

def discrete_timestamped_series.Ici.sample_floor_helper {tf : time_frame} {ts : time_space tf} {V : Type u} [inhabited V] {min_t : time ts}
  (v : set.Ici min_t) : discrete_timestamped_series.Ici ts V min_t → option (set.Ici min_t × V) → V
| [] (none) := inhabited.default V
| [] (some t_) := t_.value
| (h::t) (some t_) :=
  if t_.timestamp.val < h.timestamp ∧ h.timestamp.val ≤ v
  then discrete_timestamped_series.Ici.sample_floor_helper t (some h)
  else discrete_timestamped_series.Ici.sample_floor_helper t (some t_)
| (h::t) (none) :=
  if h.timestamp.val ≤ v
  then discrete_timestamped_series.Ici.sample_floor_helper t (some h)
  else discrete_timestamped_series.Ici.sample_floor_helper t none

def discrete_timestamped_series.Ici.sample_floor
  {tf : time_frame} {ts : time_space tf} {V : Type u} [inhabited V] {min_t : time ts}
  : discrete_timestamped_series.Ici ts V min_t → set.Ici min_t → V :=
  λser t, discrete_timestamped_series.Ici.sample_floor_helper t ser none

def discrete_timestamped_series.Ici.sample_ceil_helper {tf : time_frame} {ts : time_space tf} {V : Type u} [inhabited V] {min_t : time ts}
  (v : set.Ici min_t) : discrete_timestamped_series.Ici ts V min_t → option (set.Ici min_t × V) → V
| [] (none) := inhabited.default V
| [] (some t_) := t_.value
| (h::t) (some t_) :=
  if h.timestamp.val < t_.timestamp.val ∧ v.val ≤ h.timestamp.val
  then discrete_timestamped_series.Ici.sample_ceil_helper t (some h)
  else discrete_timestamped_series.Ici.sample_ceil_helper t (some t_)
| (h::t) (none) :=
  if v.val ≤ h.timestamp.val
  then discrete_timestamped_series.Ici.sample_ceil_helper t (some h)
  else discrete_timestamped_series.Ici.sample_ceil_helper t none

def discrete_timestamped_series.Ici.sample_ceil {tf : time_frame} {ts : time_space tf} {V : Type u} [inhabited V] {min_t : time ts}
  : discrete_timestamped_series.Ici ts V min_t → set.Ici min_t → V :=
  λser t, discrete_timestamped_series.Ici.sample_ceil_helper t ser none
-/


/-
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, Patrick Massot
-/
import topology.order

/-!
# Specific classes of maps between topological spaces

This file introduces the following properties of a map `f : X → Y` between topological spaces:

* `is_open_map f` means the image of an open set under `f` is open.
* `is_closed_map f` means the image of a closed set under `f` is closed.

(Open and closed maps need not be continuous.)

* `inducing f` means the topology on `X` is the one induced via `f` from the topology on `Y`.
  These behave like embeddings except they need not be injective. Instead, points of `X` which
  are identified by `f` are also indistinguishable in the topology on `X`.
* `embedding f` means `f` is inducing and also injective. Equivalently, `f` identifies `X` with
  a subspace of `Y`.
* `open_embedding f` means `f` is an embedding with open image, so it identifies `X` with an
  open subspace of `Y`. Equivalently, `f` is an embedding and an open map.
* `closed_embedding f` similarly means `f` is an embedding with closed image, so it identifies
  `X` with a closed subspace of `Y`. Equivalently, `f` is an embedding and a closed map.

* `quotient_map f` is the dual condition to `embedding f`: `f` is surjective and the topology
  on `Y` is the one coinduced via `f` from the topology on `X`. Equivalently, `f` identifies
  `Y` with a quotient of `X`. Quotient maps are also sometimes known as identification maps.

## References

* <https://en.wikipedia.org/wiki/Open_and_closed_maps>
* <https://en.wikipedia.org/wiki/Embedding#General_topology>
* <https://en.wikipedia.org/wiki/Quotient_space_(topology)#Quotient_map>

## Tags

open map, closed map, embedding, quotient map, identification map

-/

open set filter
open_locale topological_space filter

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

section inducing

/-- A function `f : α → β` between topological spaces is inducing if the topology on `α` is induced
by the topology on `β` through `f`, meaning that a set `s : set α` is open iff it is the preimage
under `f` of some open set `t : set β`. -/
structure inducing [tα : topological_space α] [tβ : topological_space β] (f : α → β) : Prop :=
(induced : tα = tβ.induced f)

variables [topological_space α] [topological_space β] [topological_space γ] [topological_space δ]

lemma inducing_id : inducing (@id α) :=
⟨induced_id.symm⟩

protected lemma inducing.comp {g : β → γ} {f : α → β} (hg : inducing g) (hf : inducing f) :
  inducing (g ∘ f) :=
⟨by rw [hf.induced, hg.induced, induced_compose]⟩

lemma inducing_of_inducing_compose {f : α → β} {g : β → γ} (hf : continuous f) (hg : continuous g)
  (hgf : inducing (g ∘ f)) : inducing f :=
⟨le_antisymm
    (by rwa ← continuous_iff_le_induced)
    (by { rw [hgf.induced, ← continuous_iff_le_induced], apply hg.comp continuous_induced_dom })⟩

lemma inducing.nhds_eq_comap {f : α → β} (hf : inducing f) :
  ∀ (a : α), 𝓝 a = comap f (𝓝 $ f a) :=
(induced_iff_nhds_eq f).1 hf.induced

lemma inducing.map_nhds_eq {f : α → β} (hf : inducing f) (a : α) :
  (𝓝 a).map f = 𝓝[range f] (f a) :=
hf.induced.symm ▸ map_nhds_induced_eq a

lemma inducing.map_nhds_of_mem {f : α → β} (hf : inducing f) (a : α) (h : range f ∈ 𝓝 (f a)) :
  (𝓝 a).map f = 𝓝 (f a) :=
hf.induced.symm ▸ map_nhds_induced_of_mem h

lemma inducing.tendsto_nhds_iff {ι : Type*}
  {f : ι → β} {g : β → γ} {a : filter ι} {b : β} (hg : inducing g) :
  tendsto f a (𝓝 b) ↔ tendsto (g ∘ f) a (𝓝 (g b)) :=
by rw [tendsto, tendsto, hg.induced, nhds_induced, ← map_le_iff_le_comap, filter.map_map]

lemma inducing.continuous_at_iff {f : α → β} {g : β → γ} (hg : inducing g) {x : α} :
  continuous_at f x ↔ continuous_at (g ∘ f) x :=
by simp_rw [continuous_at, inducing.tendsto_nhds_iff hg]

lemma inducing.continuous_iff {f : α → β} {g : β → γ} (hg : inducing g) :
  continuous f ↔ continuous (g ∘ f) :=
by simp_rw [continuous_iff_continuous_at, hg.continuous_at_iff]

lemma inducing.continuous_at_iff' {f : α → β} {g : β → γ} (hf : inducing f) {x : α}
  (h : range f ∈ 𝓝 (f x)) : continuous_at (g ∘ f) x ↔ continuous_at g (f x) :=
by { simp_rw [continuous_at, filter.tendsto, ← hf.map_nhds_of_mem _ h, filter.map_map] }

lemma inducing.continuous {f : α → β} (hf : inducing f) : continuous f :=
hf.continuous_iff.mp continuous_id

lemma inducing.closure_eq_preimage_closure_image {f : α → β} (hf : inducing f) (s : set α) :
  closure s = f ⁻¹' closure (f '' s) :=
by { ext x, rw [set.mem_preimage, ← closure_induced, hf.induced] }

lemma inducing.is_closed_iff {f : α → β} (hf : inducing f) {s : set α} :
  is_closed s ↔ ∃ t, is_closed t ∧ f ⁻¹' t = s :=
by rw [hf.induced, is_closed_induced_iff]

lemma inducing.is_open_iff {f : α → β} (hf : inducing f) {s : set α} :
  is_open s ↔ ∃ t, is_open t ∧ f ⁻¹' t = s :=
by rw [hf.induced, is_open_induced_iff]

end inducing

section embedding

/-- A function between topological spaces is an embedding if it is injective,
  and for all `s : set α`, `s` is open iff it is the preimage of an open set. -/
structure embedding [tα : topological_space α] [tβ : topological_space β] (f : α → β)
  extends inducing f : Prop :=
(inj : function.injective f)

variables [topological_space α] [topological_space β] [topological_space γ]

lemma embedding.mk' (f : α → β) (inj : function.injective f)
  (induced : ∀a, comap f (𝓝 (f a)) = 𝓝 a) : embedding f :=
⟨⟨(induced_iff_nhds_eq f).2 (λ a, (induced a).symm)⟩, inj⟩

lemma embedding_id : embedding (@id α) :=
⟨inducing_id, assume a₁ a₂ h, h⟩

lemma embedding.comp {g : β → γ} {f : α → β} (hg : embedding g) (hf : embedding f) :
  embedding (g ∘ f) :=
{ inj:= assume a₁ a₂ h, hf.inj $ hg.inj h,
  ..hg.to_inducing.comp hf.to_inducing }

lemma embedding_of_embedding_compose {f : α → β} {g : β → γ} (hf : continuous f) (hg : continuous g)
  (hgf : embedding (g ∘ f)) : embedding f :=
{ induced := (inducing_of_inducing_compose hf hg hgf.to_inducing).induced,
  inj := assume a₁ a₂ h, hgf.inj $ by simp [h, (∘)] }

protected lemma function.left_inverse.embedding {f : α → β} {g : β → α}
  (h : function.left_inverse f g) (hf : continuous f) (hg : continuous g) :
  embedding g :=
embedding_of_embedding_compose hg hf $ h.comp_eq_id.symm ▸ embedding_id

lemma embedding.map_nhds_eq {f : α → β} (hf : embedding f) (a : α) :
  (𝓝 a).map f = 𝓝[range f] (f a) :=
hf.1.map_nhds_eq a

lemma embedding.map_nhds_of_mem {f : α → β}
  (hf : embedding f) (a : α) (h : range f ∈ 𝓝 (f a)) : (𝓝 a).map f = 𝓝 (f a) :=
hf.1.map_nhds_of_mem a h

lemma embedding.tendsto_nhds_iff {ι : Type*}
  {f : ι → β} {g : β → γ} {a : filter ι} {b : β} (hg : embedding g) :
  tendsto f a (𝓝 b) ↔ tendsto (g ∘ f) a (𝓝 (g b)) :=
hg.to_inducing.tendsto_nhds_iff

lemma embedding.continuous_iff {f : α → β} {g : β → γ} (hg : embedding g) :
  continuous f ↔ continuous (g ∘ f) :=
inducing.continuous_iff hg.1

lemma embedding.continuous {f : α → β} (hf : embedding f) : continuous f :=
inducing.continuous hf.1

lemma embedding.closure_eq_preimage_closure_image {e : α → β} (he : embedding e) (s : set α) :
  closure s = e ⁻¹' closure (e '' s) :=
he.1.closure_eq_preimage_closure_image s

end embedding

/-- A function between topological spaces is a quotient map if it is surjective,
  and for all `s : set β`, `s` is open iff its preimage is an open set. -/
def quotient_map {α : Type*} {β : Type*} [tα : topological_space α] [tβ : topological_space β]
  (f : α → β) : Prop :=
function.surjective f ∧ tβ = tα.coinduced f

lemma quotient_map_iff {α β : Type*} [topological_space α] [topological_space β] {f : α → β} :
  quotient_map f ↔ function.surjective f ∧ ∀ s : set β, is_open s ↔ is_open (f ⁻¹' s) :=
and_congr iff.rfl topological_space_eq_iff

namespace quotient_map
variables [topological_space α] [topological_space β] [topological_space γ] [topological_space δ]

protected lemma id : quotient_map (@id α) :=
⟨assume a, ⟨a, rfl⟩, coinduced_id.symm⟩

protected lemma comp {g : β → γ} {f : α → β} (hg : quotient_map g) (hf : quotient_map f) :
  quotient_map (g ∘ f) :=
⟨hg.left.comp hf.left, by rw [hg.right, hf.right, coinduced_compose]⟩

protected lemma of_quotient_map_compose {f : α → β} {g : β → γ}
  (hf : continuous f) (hg : continuous g)
  (hgf : quotient_map (g ∘ f)) : quotient_map g :=
⟨assume b, let ⟨a, h⟩ := hgf.left b in ⟨f a, h⟩,
  le_antisymm
    (by rw [hgf.right, ← continuous_iff_coinduced_le];
        apply continuous_coinduced_rng.comp hf)
    (by rwa ← continuous_iff_coinduced_le)⟩

protected lemma continuous_iff {f : α → β} {g : β → γ} (hf : quotient_map f) :
  continuous g ↔ continuous (g ∘ f) :=
by rw [continuous_iff_coinduced_le, continuous_iff_coinduced_le, hf.right, coinduced_compose]

protected lemma continuous {f : α → β} (hf : quotient_map f) : continuous f :=
hf.continuous_iff.mp continuous_id

protected lemma surjective {f : α → β} (hf : quotient_map f) : function.surjective f := hf.1

protected lemma is_open_preimage {f : α → β} (hf : quotient_map f) {s : set β} :
  is_open (f ⁻¹' s) ↔ is_open s :=
((quotient_map_iff.1 hf).2 s).symm

end quotient_map

/-- A map `f : α → β` is said to be an *open map*, if the image of any open `U : set α`
is open in `β`. -/
def is_open_map [topological_space α] [topological_space β] (f : α → β) :=
∀ U : set α, is_open U → is_open (f '' U)

namespace is_open_map
variables [topological_space α] [topological_space β] [topological_space γ] {f : α → β}
open function

protected lemma id : is_open_map (@id α) := assume s hs, by rwa [image_id]

protected lemma comp
  {g : β → γ} {f : α → β} (hg : is_open_map g) (hf : is_open_map f) : is_open_map (g ∘ f) :=
by intros s hs; rw [image_comp]; exact hg _ (hf _ hs)

lemma is_open_range (hf : is_open_map f) : is_open (range f) :=
by { rw ← image_univ, exact hf _ is_open_univ }

lemma image_mem_nhds (hf : is_open_map f) {x : α} {s : set α} (hx : s ∈ 𝓝 x) :
  f '' s ∈ 𝓝 (f x) :=
let ⟨t, hts, ht, hxt⟩ := mem_nhds_iff.1 hx in
mem_of_superset (is_open.mem_nhds (hf t ht) (mem_image_of_mem _ hxt)) (image_subset _ hts)

lemma image_interior_subset (hf : is_open_map f) (s : set α) :
  f '' interior s ⊆ interior (f '' s) :=
interior_maximal (image_subset _ interior_subset) (hf _ is_open_interior)

lemma nhds_le (hf : is_open_map f) (a : α) : 𝓝 (f a) ≤ (𝓝 a).map f :=
le_map $ λ s, hf.image_mem_nhds

lemma of_nhds_le (hf : ∀ a, 𝓝 (f a) ≤ map f (𝓝 a)) : is_open_map f :=
λ s hs, is_open_iff_mem_nhds.2 $ λ b ⟨a, has, hab⟩,
  hab ▸ hf _ (image_mem_map $ is_open.mem_nhds hs has)

lemma of_inverse {f : α → β} {f' : β → α}
  (h : continuous f') (l_inv : left_inverse f f') (r_inv : right_inverse f f') :
  is_open_map f :=
begin
  assume s hs,
  rw [image_eq_preimage_of_inverse r_inv l_inv],
  exact hs.preimage h
end

lemma to_quotient_map {f : α → β}
  (open_map : is_open_map f) (cont : continuous f) (surj : function.surjective f) :
  quotient_map f :=
⟨ surj,
  begin
    ext s,
    show is_open s ↔ is_open (f ⁻¹' s),
    split,
    { exact continuous_def.1 cont s },
    { assume h,
      rw ← surj.image_preimage s,
      exact open_map _ h }
  end⟩

lemma interior_preimage_subset_preimage_interior {s : set β} (hf : is_open_map f) :
  interior (f⁻¹' s) ⊆ f⁻¹' (interior s) :=
begin
  rw ← set.image_subset_iff,
  refine interior_maximal _ (hf _ is_open_interior),
  rw set.image_subset_iff,
  exact interior_subset,
end

lemma preimage_interior_eq_interior_preimage {s : set β}
  (hf₁ : continuous f) (hf₂ : is_open_map f) :
  f⁻¹' (interior s) = interior (f⁻¹' s) :=
subset.antisymm
  (preimage_interior_subset_interior_preimage hf₁)
  (interior_preimage_subset_preimage_interior hf₂)

end is_open_map

lemma is_open_map_iff_nhds_le [topological_space α] [topological_space β] {f : α → β} :
  is_open_map f ↔ ∀(a:α), 𝓝 (f a) ≤ (𝓝 a).map f :=
⟨λ hf, hf.nhds_le, is_open_map.of_nhds_le⟩

lemma is_open_map_iff_interior [topological_space α] [topological_space β] {f : α → β} :
  is_open_map f ↔ ∀ s, f '' (interior s) ⊆ interior (f '' s) :=
⟨is_open_map.image_interior_subset, λ hs u hu, subset_interior_iff_open.mp $
  calc f '' u = f '' (interior u) : by rw hu.interior_eq
          ... ⊆ interior (f '' u) : hs u⟩

lemma inducing.is_open_map [topological_space α] [topological_space β] {f : α → β}
  (hi : inducing f) (ho : is_open (range f)) :
  is_open_map f :=
is_open_map.of_nhds_le $ λ x, (hi.map_nhds_of_mem _ $ is_open.mem_nhds ho $ mem_range_self _).ge

section is_closed_map
variables [topological_space α] [topological_space β]

/-- A map `f : α → β` is said to be a *closed map*, if the image of any closed `U : set α`
is closed in `β`. -/
def is_closed_map (f : α → β) := ∀ U : set α, is_closed U → is_closed (f '' U)

end is_closed_map

namespace is_closed_map

variables [topological_space α] [topological_space β] [topological_space γ]
open function

protected lemma id : is_closed_map (@id α) := assume s hs, by rwa image_id

protected lemma comp {g : β → γ} {f : α → β} (hg : is_closed_map g) (hf : is_closed_map f) :
  is_closed_map (g ∘ f) :=
by { intros s hs, rw image_comp, exact hg _ (hf _ hs) }

lemma closure_image_subset {f : α → β} (hf : is_closed_map f) (s : set α) :
  closure (f '' s) ⊆ f '' closure s :=
closure_minimal (image_subset _ subset_closure) (hf _ is_closed_closure)

lemma of_inverse {f : α → β} {f' : β → α}
  (h : continuous f') (l_inv : left_inverse f f') (r_inv : right_inverse f f') :
  is_closed_map f :=
assume s hs,
have f' ⁻¹' s = f '' s, by ext x; simp [mem_image_iff_of_inverse r_inv l_inv],
this ▸ hs.preimage h

lemma of_nonempty {f : α → β} (h : ∀ s, is_closed s → s.nonempty → is_closed (f '' s)) :
  is_closed_map f :=
begin
  intros s hs, cases eq_empty_or_nonempty s with h2s h2s,
  { simp_rw [h2s, image_empty, is_closed_empty] },
  { exact h s hs h2s }
end

lemma closed_range {f : α → β} (hf : is_closed_map f) : is_closed (range f) :=
@image_univ _ _ f ▸ hf _ is_closed_univ

end is_closed_map

lemma inducing.is_closed_map [topological_space α] [topological_space β]
  {f : α → β} (hf : inducing f) (h : is_closed (range f)) : is_closed_map f :=
begin
  intros s hs,
  rcases hf.is_closed_iff.1 hs with ⟨t, ht, rfl⟩,
  rw image_preimage_eq_inter_range,
  exact is_closed.inter ht h
end

lemma is_closed_map_iff_closure_image [topological_space α] [topological_space β] {f : α → β} :
  is_closed_map f ↔ ∀ s, closure (f '' s) ⊆ f '' closure s :=
⟨is_closed_map.closure_image_subset, λ hs c hc, is_closed_of_closure_subset $
  calc closure (f '' c) ⊆ f '' (closure c) : hs c
                    ... = f '' c : by rw hc.closure_eq⟩

section open_embedding
variables [topological_space α] [topological_space β] [topological_space γ]

/-- An open embedding is an embedding with open image. -/
structure open_embedding (f : α → β) extends embedding f : Prop :=
(open_range : is_open $ range f)

lemma open_embedding.is_open_map {f : α → β} (hf : open_embedding f) : is_open_map f :=
hf.to_embedding.to_inducing.is_open_map hf.open_range

lemma open_embedding.map_nhds_eq {f : α → β} (hf : open_embedding f) (a : α) :
  map f (𝓝 a) = 𝓝 (f a) :=
hf.to_embedding.map_nhds_of_mem _ $ is_open.mem_nhds hf.open_range $ mem_range_self _

lemma open_embedding.open_iff_image_open {f : α → β} (hf : open_embedding f)
  {s : set α} : is_open s ↔ is_open (f '' s) :=
⟨hf.is_open_map s,
 λ h, begin
   convert ← h.preimage hf.to_embedding.continuous,
   apply preimage_image_eq _ hf.inj
 end⟩

lemma open_embedding.tendsto_nhds_iff {ι : Type*}
  {f : ι → β} {g : β → γ} {a : filter ι} {b : β} (hg : open_embedding g) :
  tendsto f a (𝓝 b) ↔ tendsto (g ∘ f) a (𝓝 (g b)) :=
hg.to_embedding.tendsto_nhds_iff

lemma open_embedding.continuous {f : α → β} (hf : open_embedding f) : continuous f :=
hf.to_embedding.continuous

lemma open_embedding.open_iff_preimage_open {f : α → β} (hf : open_embedding f)
  {s : set β} (hs : s ⊆ range f) : is_open s ↔ is_open (f ⁻¹' s) :=
begin
  convert ←hf.open_iff_image_open.symm,
  rwa [image_preimage_eq_inter_range, inter_eq_self_of_subset_left]
end

lemma open_embedding_of_embedding_open {f : α → β} (h₁ : embedding f)
  (h₂ : is_open_map f) : open_embedding f :=
⟨h₁, h₂.is_open_range⟩

lemma open_embedding_of_continuous_injective_open {f : α → β} (h₁ : continuous f)
  (h₂ : function.injective f) (h₃ : is_open_map f) : open_embedding f :=
begin
  refine open_embedding_of_embedding_open ⟨⟨_⟩, h₂⟩ h₃,
  apply le_antisymm (continuous_iff_le_induced.mp h₁) _,
  intro s,
  change is_open _ → is_open _,
  rw is_open_induced_iff,
  refine λ hs, ⟨f '' s, h₃ s hs, _⟩,
  rw preimage_image_eq _ h₂
end

lemma open_embedding_id : open_embedding (@id α) :=
⟨embedding_id, by convert is_open_univ; apply range_id⟩

lemma open_embedding.comp {g : β → γ} {f : α → β}
  (hg : open_embedding g) (hf : open_embedding f) : open_embedding (g ∘ f) :=
⟨hg.1.comp hf.1, show is_open (range (g ∘ f)),
 by rw [range_comp, ←hg.open_iff_image_open]; exact hf.2⟩

end open_embedding

section closed_embedding
variables [topological_space α] [topological_space β] [topological_space γ]

/-- A closed embedding is an embedding with closed image. -/
structure closed_embedding (f : α → β) extends embedding f : Prop :=
(closed_range : is_closed $ range f)

variables {f : α → β}

lemma closed_embedding.tendsto_nhds_iff {ι : Type*}
  {g : ι → α} {a : filter ι} {b : α} (hf : closed_embedding f) :
  tendsto g a (𝓝 b) ↔ tendsto (f ∘ g) a (𝓝 (f b)) :=
hf.to_embedding.tendsto_nhds_iff

lemma closed_embedding.continuous (hf : closed_embedding f) : continuous f :=
hf.to_embedding.continuous

lemma closed_embedding.is_closed_map (hf : closed_embedding f) : is_closed_map f :=
hf.to_embedding.to_inducing.is_closed_map hf.closed_range

lemma closed_embedding.closed_iff_image_closed (hf : closed_embedding f)
  {s : set α} : is_closed s ↔ is_closed (f '' s) :=
⟨hf.is_closed_map s,
 λ h, begin
   convert ←continuous_iff_is_closed.mp hf.continuous _ h,
   apply preimage_image_eq _ hf.inj
 end⟩

lemma closed_embedding.closed_iff_preimage_closed (hf : closed_embedding f)
  {s : set β} (hs : s ⊆ range f) : is_closed s ↔ is_closed (f ⁻¹' s) :=
begin
  convert ←hf.closed_iff_image_closed.symm,
  rwa [image_preimage_eq_inter_range, inter_eq_self_of_subset_left]
end

lemma closed_embedding_of_embedding_closed (h₁ : embedding f)
  (h₂ : is_closed_map f) : closed_embedding f :=
⟨h₁, by convert h₂ univ is_closed_univ; simp⟩

lemma closed_embedding_of_continuous_injective_closed (h₁ : continuous f)
  (h₂ : function.injective f) (h₃ : is_closed_map f) : closed_embedding f :=
begin
  refine closed_embedding_of_embedding_closed ⟨⟨_⟩, h₂⟩ h₃,
  apply le_antisymm (continuous_iff_le_induced.mp h₁) _,
  intro s',
  change is_open _ ≤ is_open _,
  rw [←is_closed_compl_iff, ←is_closed_compl_iff],
  generalize : s'ᶜ = s,
  rw is_closed_induced_iff,
  refine λ hs, ⟨f '' s, h₃ s hs, _⟩,
  rw preimage_image_eq _ h₂
end

lemma closed_embedding_id : closed_embedding (@id α) :=
⟨embedding_id, by convert is_closed_univ; apply range_id⟩

lemma closed_embedding.comp {g : β → γ} {f : α → β}
  (hg : closed_embedding g) (hf : closed_embedding f) : closed_embedding (g ∘ f) :=
⟨hg.to_embedding.comp hf.to_embedding, show is_closed (range (g ∘ f)),
 by rw [range_comp, ←hg.closed_iff_image_closed]; exact hf.closed_range⟩

end closed_embedding