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

import .lie_group
import .local_diffeomorph

noncomputable theory

section

variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
{E : Type*} [normed_group E] [normed_space 𝕜 E]
{E' : Type*} [normed_group E'] [normed_space 𝕜 E']
{F : Type*} [normed_group F] [normed_space 𝕜 F]
{F' : Type*} [normed_group F'] [normed_space 𝕜 F']
{H : Type*} [topological_space H]
{H' : Type*} [topological_space H']
{G : Type*} [topological_space G]
{G' : Type*} [topological_space G']
(I : model_with_corners 𝕜 E H) (I' : model_with_corners 𝕜 E' H')
(J : model_with_corners 𝕜 F G) (J' : model_with_corners 𝕜 F' G')

variables {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']

/- The most general definition of immersion, for functions that are not necessarily smooth. -/
structure immersion (f : M → M') : Prop :=
  (mdifferentiable : mdifferentiable I I' f)
  (injetive_mdiff_at_each_point : ∀ x : M, function.injective (mfderiv I I' f x))

structure times_cont_mdiff_immersion (n : with_top ℕ) (f : M → M') : Prop :=
  (times_cont_mdiff: times_cont_mdiff I I' n f)
  (injetive_mdiff_at_each_point : ∀ x : M, function.injective (mfderiv I I' f x))

structure smooth_immersion (f : M → M') : Prop :=
  (smooth : smooth I I' f)
  (injetive_mdiff_at_each_point : ∀ x : M, function.injective (mfderiv I I' f x))

structure times_cont_mdiff_embedding (n : with_top ℕ) (f : M → M')
  extends embedding f : Prop :=
  (times_cont_mdiff_immersion: times_cont_mdiff_immersion I I' n f)

structure smooth_embedding (f : M → M')
  extends embedding f : Prop :=
  (smooth_immersion : smooth_immersion I I' f)

/- Is it true that C^1 → mdifferentiable? -/
lemma smooth_immersion_is_immersion (f : M → M') :
  (smooth_immersion I I' f) → (immersion I I' f) :=
sorry

end

section

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

/- Note that the following definition is not the standard definition of submanifold, but it
is the definition of subobject in the category of manifolds. -/
class is_times_cont_mdiff_submanifold {n : with_top ℕ} (s : set M) : Prop :=
(smooth_times_cont_mdiff_image : ∃ E' [normed_group E'] [normed_space 𝕜 E'], (∃ H' [topological_space H'], (∃ I' : model_with_corners 𝕜 E' H',
(∃ N [topological_space N] [charted_space H' N] [smooth_manifold_with_corners I' N],
(∃ f : N → M, times_cont_mdiff I' I n f ∧ set.image f set.univ = s)))))

class is_smooth_submanifold (s : set M) : Prop :=
(smooth_image : ∃ E' [normed_group E'] [normed_space 𝕜 E'], (∃ H' [topological_space H'], (∃ I' : model_with_corners 𝕜 E' H',
(∃ N [topological_space N] [charted_space H' N] [smooth_manifold_with_corners I' N],
(∃ f : N → M, (smooth I' I f) ∧ set.image f set.univ = s)))))

class is_immersed_submanifold (s : set M) : Prop :=
(immersed_image : ∃ E' [normed_group E'] [normed_space 𝕜 E'], (∃ H' [topological_space H'], (∃ I' : model_with_corners 𝕜 E' H',
(∃ N [topological_space N] [charted_space H' N] [smooth_manifold_with_corners I' N],
(∃ f : N → M, immersion I' I f ∧ set.image f set.univ = s)))))

class is_times_cont_mdiff_immersed_submanifold {n : with_top ℕ} (s : set M) : Prop :=
(immersed_image : ∃ E' [normed_group E'] [normed_space 𝕜 E'], (∃ H' [topological_space H'], (∃ I' : model_with_corners 𝕜 E' H',
(∃ N [topological_space N] [charted_space H' N] [smooth_manifold_with_corners I' N],
(∃ f : N → M, times_cont_mdiff_immersion I' I n f ∧ set.image f set.univ = s)))))

class is_smooth_immersed_submanifold (s : set M) : Prop :=
(immersed_image : ∃ E' [normed_group E'] [normed_space 𝕜 E'], (∃ H' [topological_space H'], (∃ I' : model_with_corners 𝕜 E' H',
(∃ N [topological_space N] [charted_space H' N] [smooth_manifold_with_corners I' N],
(∃ f : N → M, smooth_immersion I' I f ∧ set.image f set.univ = s)))))

class is_times_cont_mdiff_emedded_submanifold {n : with_top ℕ} (s : set M) : Prop :=
(embedded_image : ∃ E' [normed_group E'] [normed_space 𝕜 E'], (∃ H' [topological_space H'], (∃ I' : model_with_corners 𝕜 E' H',
(∃ N [topological_space N] [charted_space H' N] [smooth_manifold_with_corners I' N],
(∃ f : N → M, times_cont_mdiff_embedding I' I n f ∧ set.image f set.univ = s)))))

class is_smooth_embedded_submanifold (s : set M) : Prop :=
(embedded_image : ∃ E' [normed_group E'] [normed_space 𝕜 E'], (∃ H' [topological_space H'], (∃ I' : model_with_corners 𝕜 E' H',
(∃ N [topological_space N] [charted_space H' N] [smooth_manifold_with_corners I' N],
(∃ f : N → M, smooth_embedding I' I f ∧ set.image f set.univ = s)))))

end

section

/- smooth subgroups -/

variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
{E : Type*} [normed_group E] [normed_space 𝕜 E]
{E' : Type*} [normed_group E'] [normed_space 𝕜 E']
(I : model_with_corners 𝕜 E E) (I' : model_with_corners 𝕜 E' E')
{G : Type*} [topological_space G] [charted_space E G] [smooth_manifold_with_corners I G] [group G] [Lie_group I G]
{G' : Type*} [topological_space G'] [charted_space E' G'] [smooth_manifold_with_corners I' G'] [group G'] [Lie_group I' G']
{A : Type*} [topological_space A] [charted_space E A] [smooth_manifold_with_corners I A] [add_group A] [Lie_add_group I A]
{A' : Type*} [topological_space A'] [charted_space E' A'] [smooth_manifold_with_corners I' A'] [add_group A'] [Lie_add_group I' A']

class is_smooth_add_subgroup (s : set A) extends is_add_subgroup s, is_smooth_submanifold I s : Prop

class is_smooth_immersed_add_subgroup (s : set A) extends is_add_subgroup s, is_smooth_immersed_submanifold I s : Prop

class is_smooth_embedded_add_subgroup (s : set A) extends is_add_subgroup s, is_smooth_embedded_submanifold I s : Prop

@[to_additive is_smooth_add_subgroup]
class is_smooth_subgroup (s : set G) extends is_subgroup s, is_smooth_submanifold I s : Prop

@[to_additive is_smooth_immersed_add_subgroup]
class is_smooth_immersed_subgroup (s : set G) extends is_subgroup s, is_smooth_immersed_submanifold I s : Prop

@[to_additive is_smooth_embedded_add_subgroup]
class is_smooth_embedded_subgroup (s : set G) extends is_subgroup s, is_smooth_embedded_submanifold I s : Prop

/- lemma additive.is_smooth_add_subgroup
  {G : Type*} [topological_space G] [charted_space E G] [smooth_manifold_with_corners I G] [add_group G] [Lie_add_group I G]
  (s : set G) : ∀ [is_smooth_subgroup I s], @is_smooth_add_subgroup 𝕜 _ E _ _ I (additive G) _ _ _ _ _ s
| ⟨h₁, h₂⟩ := ⟨h₁, @h₂⟩-/

/-@[to_additive]-/
lemma smooth_subgroup_is_immersed (s : set G) [is_smooth_subgroup I s] : is_smooth_immersed_subgroup I s :=
begin
  sorry,
end

lemma subgroup_smooth_iff_closed (s : set G) [is_subgroup s] :
  is_smooth_embedded_subgroup I s ↔ is_closed s :=
begin
  sorry,
end

lemma nhd_of_one_generates_connected_Lie_group [connected_space G] (U : set G) [is_open U] :
  set.mem 1 U → subgroup.closure U = ⊤ :=
begin
  sorry,
end

def connected_component_of_id (G : Type*) [topological_space G] [group G] [topological_group G] :=
 connected_component (1 : G)

lemma connected_component_of_id_is_normal_subgroup [charted_space E G] [smooth_manifold_with_corners I G] [group G] [Lie_group I G] :
normal_subgroup (connected_component_of_id G) :=
begin
  sorry,
end

lemma Lie_group_hom_surj_at_id_imp_surj [connected_space G'] (f : Lie_group_morphism I I' G G') :
  function.surjective (mfderiv I I' f (1 : G)) → function.surjective f :=
begin
  sorry,
end

end

section

def continuous_sections {B : Type*} [topological_space B] {E : Type*} [topological_space E]
(F : Type*) [topological_space F] (p : E → B) /-[is_topological_fiber_bundle F p]-/ :=
{f : B → E // p ∘ f = id ∧ continuous f}

open set

variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
{E_B : Type*} [normed_group E_B] [normed_space 𝕜 E_B]
{E_F : Type*} [normed_group E_F] [normed_space 𝕜 E_F]
{E_Z : Type*} [normed_group E_Z] [normed_space 𝕜 E_Z]
{H_B : Type*} [topological_space H_B] (I_B : model_with_corners 𝕜 E_B H_B)
{H_F : Type*} [topological_space H_F] (I_F : model_with_corners 𝕜 E_F H_F)
{H_Z : Type*} [topological_space H_Z] (I_Z : model_with_corners 𝕜 E_Z H_Z)
{B : Type*} [topological_space B] [charted_space H_B B] [smooth_manifold_with_corners I_B B]
{Z : Type*} [topological_space Z] [charted_space H_Z Z] [smooth_manifold_with_corners I_Z Z]
{F : Type*} [topological_space F] [charted_space H_F F] [smooth_manifold_with_corners I_F F]
(proj : Z → B)

variable (F)

/--
A structure extending local homeomorphisms, defining a local trivialization of a projection
`proj : Z → B` with fiber `F`, as a local homeomorphism between `Z` and `B × F` defined between two
sets of the form `proj ⁻¹' base_set` and `base_set × F`, acting trivially on the first coordinate.
-/
structure smooth_bundle_trivialization extends local_times_diffeomorph I_Z (I_B.prod I_F) Z (B × F) ⊤ :=
(base_set      : set B)
(open_base_set : is_open base_set)
(source_eq     : source = proj ⁻¹' base_set)
(target_eq     : target = set.prod base_set univ)
(proj_to_fun   : ∀ p ∈ source, (to_fun p).1 = proj p)

instance : has_coe_to_fun (smooth_bundle_trivialization I_B I_F I_Z F proj) := ⟨_, λ e, e.to_fun⟩

@[simp, mfld_simps] lemma smooth_bundle_trivialization.coe_coe (e : smooth_bundle_trivialization I_B I_F I_Z F proj) (x : Z) :
  e.to_local_diffeomorph x = e x := rfl

@[simp, mfld_simps] lemma smooth_bundle_trivialization.coe_mk (e : local_diffeomorph I_Z (I_B.prod I_F) Z (B × F)) (i j k l m) (x : Z) :
  (bundle_trivialization.mk e i j k l m : bundle_trivialization F proj) x = e x := rfl

variables {I_B} {I_F} {I_Z} {F} {proj}

def smooth_bundle_trivialization.to_bundle_trivialization (e : smooth_bundle_trivialization I_B I_F I_Z F proj) : bundle_trivialization F proj :=
{ base_set := e.base_set,
  open_base_set := e.open_base_set,
  source_eq := e.source_eq,
  target_eq := e.target_eq,
  proj_to_fun := e.proj_to_fun,
  .. e.to_local_diffeomorph.to_local_homeomorph }

instance smooth_bundle_triv_to_bunlde_triv : has_coe (smooth_bundle_trivialization I_B I_F I_Z F proj) (bundle_trivialization F proj) :=
⟨λ e, e.to_bundle_trivialization⟩

variables (I_B) (I_F) (I_Z) (F) (proj)

/-- A smooth fiber bundle with fiber F over a base B is a space projecting on B for which the
fibers are all diffeomorphic to F, such that the local situation around each point is a direct
product. -/
def is_smooth_fiber_bundle : Prop :=
∀ x : Z, ∃e : smooth_bundle_trivialization I_B I_F I_Z F proj, x ∈ e.source

instance smooth_fiber_bundle_is_topological_fiber_bundle : has_coe (is_smooth_fiber_bundle I_B I_F I_Z F proj) (is_topological_fiber_bundle F proj) :=
⟨λ h,
begin
  intro x,
  cases h x with e h_e,
  use [e, h_e],
end ⟩

variables {I_F} {F}

def smooth_sections /-[is_topological_fiber_bundle F proj]-/ :=
  {f : B → Z // proj ∘ f = id ∧ smooth I_B I_Z f}

instance : has_coe_to_fun (smooth_sections I_B I_Z proj) := ⟨_, subtype.val⟩

variables {f g : smooth_sections I_B I_Z proj}

namespace smooth_sections

variables {I_B} {I_F} {I_Z} {F} {proj}

@[ext] lemma ext (H : ∀x, f x = g x) : f = g :=
subtype.eq $ funext H

lemma ext_iff : f = g ↔ ∀ x, f x = g x :=
⟨λ h, λ x, h ▸ rfl, ext⟩

end smooth_sections

end

section

open topological_space set

namespace basic_smooth_bundle_core

variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
{E : Type*} [normed_group E] [normed_space 𝕜 E]
{H : Type*} [topological_space H] {I : model_with_corners 𝕜 E H}
{M : Type*} [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M]
{F : Type*} [normed_group F] [normed_space 𝕜 F]
(Z : basic_smooth_bundle_core I M F)

/-- Local diffeomorphism version of the trivialization change. -/
def triv_change (i j : atlas H M) : local_diffeomorph (I.prod (model_with_corners_self 𝕜 F)) (I.prod (model_with_corners_self 𝕜 F)) (M × F) (M × F) :=
{ source      := set.prod (Z.to_topological_fiber_bundle_core.base_set i ∩ Z.to_topological_fiber_bundle_core.base_set j) univ,
  target      := set.prod (Z.to_topological_fiber_bundle_core.base_set i ∩ Z.to_topological_fiber_bundle_core.base_set j) univ,
  to_fun      := λp, ⟨p.1, Z.to_topological_fiber_bundle_core.coord_change i j p.1 p.2⟩,
  inv_fun     := λp, ⟨p.1, Z.to_topological_fiber_bundle_core.coord_change j i p.1 p.2⟩,
  map_source' := λp hp, by simpa using hp,
  map_target' := λp hp, by simpa using hp,
  left_inv'   := begin
    rintros ⟨x, v⟩ hx,
    simp only [prod_mk_mem_set_prod_eq, mem_inter_eq, and_true, mem_univ] at hx,
    rw [Z.to_topological_fiber_bundle_core.coord_change_comp, Z.to_topological_fiber_bundle_core.coord_change_self],
    { exact hx.1 },
    { simp only [mem_inter_eq, base_set, subtype.val_eq_coe],
      cases hx, cases j, cases i, fsplit, work_on_goal 0 { fsplit, work_on_goal 0 { assumption }, assumption }, assumption, }
  end,
  right_inv'  := begin
    rintros ⟨x, v⟩ hx,
    simp only [prod_mk_mem_set_prod_eq, mem_inter_eq, and_true, mem_univ] at hx,
    rw [Z.to_topological_fiber_bundle_core.coord_change_comp, Z.to_topological_fiber_bundle_core.coord_change_self],
    { exact hx.2 },
    { simp only [mem_inter_eq, base_set, subtype.val_eq_coe],
      cases hx, cases j, cases i, dsimp at *, fsplit, work_on_goal 0 { fsplit, work_on_goal 0 { assumption }, assumption }, assumption, },
  end,
  open_source :=
    is_open_prod (is_open_inter (Z.to_topological_fiber_bundle_core.is_open_base_set i) (Z.to_topological_fiber_bundle_core.is_open_base_set j)) is_open_univ,
  open_target :=
    is_open_prod (is_open_inter (Z.to_topological_fiber_bundle_core.is_open_base_set i) (Z.to_topological_fiber_bundle_core.is_open_base_set j)) is_open_univ,
  continuous_to_fun  :=
    continuous_on.prod continuous_fst.continuous_on (Z.to_topological_fiber_bundle_core.coord_change_continuous i j),
  continuous_inv_fun := by simpa [inter_comm]
    using continuous_on.prod continuous_fst.continuous_on (Z.to_topological_fiber_bundle_core.coord_change_continuous j i),
  smooth_to_fun := sorry,
  smooth_inv_fun := sorry,}

/-- Local trivialization of a smooth bundle created from core, as a local diffeomorphism. -/
def local_triv (i : atlas H M) : local_homeomorph Z.to_topological_fiber_bundle_core.total_space (M × F) := sorry

/-- Extended version of the local trivialization of a fiber bundle constructed from core,
registering additionally in its type that it is a local bundle trivialization. -/
def local_triv_ext (i :  atlas H M) : smooth_bundle_trivialization I (model_with_corners_self 𝕜 F) (I.prod (model_with_corners_self 𝕜 F)) F Z.to_topological_fiber_bundle_core.proj := sorry

end basic_smooth_bundle_core

section

variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
{E : Type*} [normed_group E] [normed_space 𝕜 E]
{H : Type*} [topological_space H] {I : model_with_corners 𝕜 E H}
{M : Type*} [topological_space M] [charted_space H M] [smooth_manifold_with_corners I M]
(F : Type*) [normed_group F] [normed_space 𝕜 F]
(Z : basic_smooth_bundle_core I M F)

def basic_smooth_bundle_core.total_space := Z.to_topological_fiber_bundle_core.total_space /- Not working! -/
def basic_smooth_bundle_core.proj : Z.to_topological_fiber_bundle_core.total_space → M := Z.to_topological_fiber_bundle_core.proj /- Not working! -/

/-- A smooth fiber bundle constructed from core is indeed a smooth fiber bundle. -/
theorem is_smooth_fiber_bundle_from_core : is_smooth_fiber_bundle I (model_with_corners_self 𝕜 F) (I.prod (model_with_corners_self 𝕜 F)) F Z.to_topological_fiber_bundle_core.proj :=
λx, ⟨Z.local_triv_ext (Z.to_topological_fiber_bundle_core.index_at (Z.to_topological_fiber_bundle_core.proj x)), by sorry⟩

end

section

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

lemma tangent_bundle_is_smooth_fiber_bundle :
  is_smooth_fiber_bundle I (model_with_corners_self 𝕜 E) I.tangent E (tangent_bundle.proj I M) :=
  is_smooth_fiber_bundle_from_core E _

end

section

namespace vector_bundle

variables (𝕜 : Type*) {B : Type*} (F : Type*) {Z : Type*}
  [topological_space B] [topological_space Z] [normed_field 𝕜]
  [topological_space F] [add_comm_group F] [module 𝕜 F] [topological_module 𝕜 F] (proj : Z → B)
  [∀ (x : B), add_comm_group {y : Z // proj y = x}] [∀ (x : B), module 𝕜 {y : Z // proj y = x}]
  [∀ (x : B), topological_module 𝕜 {y : Z // proj y = x}]

structure vector_bundle_trivialization extends bundle_trivialization F proj :=
(linear : ∀ x ∈ base_set, is_linear_map 𝕜 (λ (y : {y : Z // proj y = x}), (to_fun y).2))

def is_topological_vector_bundle : Prop :=
∀ x : Z, ∃e : vector_bundle_trivialization 𝕜 F proj, x ∈ e.source

variables {𝕜} {F} {proj}

def topological_vector_bundle.to_topological_fiber_bundle (V : is_topological_vector_bundle 𝕜 F proj)
: is_topological_fiber_bundle F proj :=
begin
  intro x,
  have V_triv := V x,
  cases V_triv with T h_T,
  use T.to_bundle_trivialization,
  exact h_T,
end

instance topological_vector_bundle_to_topological_bundle :
  has_coe (is_topological_vector_bundle 𝕜 F proj) (is_topological_fiber_bundle F proj) :=
⟨λ V, topological_vector_bundle.to_topological_fiber_bundle V⟩

end vector_bundle

end

section

variables {𝕜 : Type*} [nondiscrete_normed_field 𝕜]
{E_B : Type*} [normed_group E_B] [normed_space 𝕜 E_B]
{E_Z : Type*} [normed_group E_Z] [normed_space 𝕜 E_Z]
{H_B : Type*} [topological_space H_B] (I_B : model_with_corners 𝕜 E_B H_B)
{H_Z : Type*} [topological_space H_Z] (I_Z : model_with_corners 𝕜 E_Z H_Z)
{B : Type*} [topological_space B] [charted_space H_B B] [smooth_manifold_with_corners I_B B]
(F : Type*) [normed_group F] [normed_space 𝕜 F]
{Z : Type*} [topological_space Z] [charted_space H_Z Z] [smooth_manifold_with_corners I_Z Z]
(proj : Z → B)
[∀ (x : B), add_comm_group {y : Z // proj y = x}] [∀ (x : B), module 𝕜 {y : Z // proj y = x}]
[∀ (x : B), topological_module 𝕜 {y : Z // proj y = x}]

structure smooth_vector_bundle_trivialization extends smooth_bundle_trivialization I_B (model_with_corners_self 𝕜 F) I_Z F proj :=
(linear : ∀ x ∈ base_set, is_linear_map 𝕜 (λ (y : {y : Z // proj y = x}), (to_fun y).2))

def is_smooth_vector_bundle : Prop :=
∀ x : Z, ∃ e : smooth_vector_bundle_trivialization I_B I_Z F proj, x ∈ e.source

instance add_comm_group_section_of_vector_bundle [h : ∀ (x : B), add_comm_group {y : Z // proj y = x}] : add_comm_group (smooth_sections I_B I_Z proj) :=
{ add := λ f g, ⟨λ x, by exact
  ((⟨f x, congr_fun f.property.1 x⟩ : {y : Z // proj y = x}) + (⟨g x, congr_fun g.property.1 x⟩ : {y : Z // proj y = x}) : {y : Z // proj y = x}),
    begin
      ext,
      let sum := ((⟨f x, congr_fun f.property.1 x⟩ : {y : Z // proj y = x}) + (⟨g x, congr_fun g.property.1 x⟩ : {y : Z // proj y = x}) : {y : Z // proj y = x}),
      exact sum.property,
    end,
    begin
      sorry,
    end⟩,
  add_assoc :=
  begin
    sorry,
  end,
  zero := ⟨λ x : B, (h x).zero, by { ext, exact (h x).zero.property, },
  begin
    simp only [smooth, times_cont_mdiff],
    split,
    {
      sorry,
    },
    {
      sorry,
    }

  end⟩,
  zero_add := sorry,
  add_zero := sorry,
  neg := sorry,
  add_left_neg := sorry,
  add_comm := sorry, }
end

section

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

def F : Π x : M, {y : tangent_bundle I M // tangent_bundle.proj I M y = x} → tangent_space I x :=
begin
  intro x,
  intro y,
  have f := (tangent_bundle_core I M).to_topological_fiber_bundle_core.local_triv,
  unfold tangent_space,
end

def G : Π x : M, tangent_space I x → {y : tangent_bundle I M // tangent_bundle.proj I M y = x} :=
sorry,

instance add_comm_group_fiber_tangent_bundle : ∀ (x : M), add_comm_group {y : tangent_bundle I M // tangent_bundle.proj I M y = x} :=
λ x,
{ add := λ a b, G x (F x a + F x b),
  add_assoc := sorry,
  zero := sorry,
  zero_add := sorry,
  add_zero := sorry,
  neg := sorry,
  add_left_neg := sorry,
  add_comm := sorry, }

#check distrib_mul_action

instance vector_space_fiber_tangent_bundle : ∀ (x : M), module 𝕜 {y : tangent_bundle I M // tangent_bundle.proj I M y = x} :=
λ x,
{ smul := sorry,
  smul_zero := sorry,
  smul_add := sorry,
  one_smul := sorry,
  mul_smul := sorry,
  add_smul := sorry,
  zero_smul := sorry, }

instance topological_vector_space_fiber_tangent_bundle : ∀ (x : M), topological_module 𝕜 {y : tangent_bundle I M // tangent_bundle.proj I M y = x} :=
λ x,
{ continuous_smul := sorry, }

lemma tangent_bundle_is_smooth_vector_bundle :
  is_smooth_vector_bundle I I.tangent E (tangent_bundle.proj I M) :=
begin
  intro x,
  sorry,
end

end

end


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

universes w w₁ v u

namespace Mathlib

/-!
# Direct sums of Lie algebras and Lie modules

Direct sums of Lie algebras and Lie modules carry natural algbebra and module structures.

## Tags

lie algebra, lie module, direct sum
-/

namespace direct_sum

/-! The direct sum of Lie modules over a fixed Lie algebra carries a natural Lie module
structure. -/

protected instance lie_ring_module {ι : Type v} {L : Type w₁} {M : ι → Type w} [lie_ring L]
    [(i : ι) → add_comm_group (M i)] [(i : ι) → lie_ring_module L (M i)] :
    lie_ring_module L (direct_sum ι fun (i : ι) => M i) :=
  lie_ring_module.mk sorry sorry sorry

@[simp] theorem lie_module_bracket_apply {ι : Type v} {L : Type w₁} {M : ι → Type w} [lie_ring L]
    [(i : ι) → add_comm_group (M i)] [(i : ι) → lie_ring_module L (M i)] (x : L)
    (m : direct_sum ι fun (i : ι) => M i) (i : ι) :
    coe_fn (has_bracket.bracket x m) i = has_bracket.bracket x (coe_fn m i) :=
  dfinsupp.map_range_apply (fun (i : ι) (m' : M i) => has_bracket.bracket x m')
    (lie_ring_module._proof_1 x) m i

protected instance lie_module {R : Type u} {ι : Type v} [comm_ring R] {L : Type w₁} {M : ι → Type w}
    [lie_ring L] [lie_algebra R L] [(i : ι) → add_comm_group (M i)] [(i : ι) → module R (M i)]
    [(i : ι) → lie_ring_module L (M i)] [(i : ι) → lie_module R L (M i)] :
    lie_module R L (direct_sum ι fun (i : ι) => M i) :=
  lie_module.mk sorry sorry

/-- The inclusion of each component into a direct sum as a morphism of Lie modules. -/
def lie_module_of (R : Type u) (ι : Type v) [comm_ring R] (L : Type w₁) (M : ι → Type w)
    [lie_ring L] [lie_algebra R L] [(i : ι) → add_comm_group (M i)] [(i : ι) → module R (M i)]
    [(i : ι) → lie_ring_module L (M i)] [(i : ι) → lie_module R L (M i)] [DecidableEq ι] (j : ι) :
    lie_module_hom R L (M j) (direct_sum ι fun (i : ι) => M i) :=
  lie_module_hom.mk (linear_map.to_fun (lof R ι M j)) sorry sorry sorry

/-- The projection map onto one component, as a morphism of Lie modules. -/
def lie_module_component (R : Type u) (ι : Type v) [comm_ring R] (L : Type w₁) (M : ι → Type w)
    [lie_ring L] [lie_algebra R L] [(i : ι) → add_comm_group (M i)] [(i : ι) → module R (M i)]
    [(i : ι) → lie_ring_module L (M i)] [(i : ι) → lie_module R L (M i)] (j : ι) :
    lie_module_hom R L (direct_sum ι fun (i : ι) => M i) (M j) :=
  lie_module_hom.mk (linear_map.to_fun (component R ι M j)) sorry sorry sorry

/-! The direct sum of Lie algebras carries a natural Lie algebra structure. -/

protected instance lie_ring {ι : Type v} {L : ι → Type w} [(i : ι) → lie_ring (L i)] :
    lie_ring (direct_sum ι fun (i : ι) => L i) :=
  lie_ring.mk sorry sorry sorry sorry

@[simp] theorem bracket_apply {ι : Type v} {L : ι → Type w} [(i : ι) → lie_ring (L i)]
    (x : direct_sum ι fun (i : ι) => L i) (y : direct_sum ι fun (i : ι) => L i) (i : ι) :
    coe_fn (has_bracket.bracket x y) i = has_bracket.bracket (coe_fn x i) (coe_fn y i) :=
  dfinsupp.zip_with_apply (fun (i : ι) (x y : L i) => has_bracket.bracket x y) lie_ring._proof_7 x y
    i

protected instance lie_algebra {R : Type u} {ι : Type v} [comm_ring R] {L : ι → Type w}
    [(i : ι) → lie_ring (L i)] [(i : ι) → lie_algebra R (L i)] :
    lie_algebra R (direct_sum ι fun (i : ι) => L i) :=
  lie_algebra.mk sorry

/-- The inclusion of each component into the direct sum as morphism of Lie algebras. -/
def lie_algebra_of (R : Type u) (ι : Type v) [comm_ring R] (L : ι → Type w)
    [(i : ι) → lie_ring (L i)] [(i : ι) → lie_algebra R (L i)] [DecidableEq ι] (j : ι) :
    lie_algebra.morphism R (L j) (direct_sum ι fun (i : ι) => L i) :=
  lie_algebra.morphism.mk (linear_map.to_fun (lof R ι L j)) sorry sorry sorry

/-- The projection map onto one component, as a morphism of Lie algebras. -/
def lie_algebra_component (R : Type u) (ι : Type v) [comm_ring R] (L : ι → Type w)
    [(i : ι) → lie_ring (L i)] [(i : ι) → lie_algebra R (L i)] (j : ι) :
    lie_algebra.morphism R (direct_sum ι fun (i : ι) => L i) (L j) :=
  lie_algebra.morphism.mk (linear_map.to_fun (component R ι L j)) sorry sorry sorry

end Mathlib


theorem t1 (p q : Prop) (hp : p) (hq : q) : p := hp

#check t1


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

import algebra.algebra.operations
import algebra.direct_sum.algebra

/-!
# Internally graded rings and algebras

This module provides `gsemiring` and `gcomm_semiring` instances for a collection of subobjects `A`
when a `set_like.graded_monoid` instance is available:

* on `add_submonoid R`s: `add_submonoid.gsemiring`, `add_submonoid.gcomm_semiring`.
* on `add_subgroup R`s: `add_subgroup.gsemiring`, `add_subgroup.gcomm_semiring`.
* on `submodule S R`s: `submodule.gsemiring`, `submodule.gcomm_semiring`.

With these instances in place, it provides the bundled canonical maps out of a direct sum of
subobjects into their carrier type:

* `direct_sum.add_submonoid_coe_ring_hom` (a `ring_hom` version of `direct_sum.add_submonoid_coe`)
* `direct_sum.add_subgroup_coe_ring_hom` (a `ring_hom` version of `direct_sum.add_subgroup_coe`)
* `direct_sum.submodule_coe_alg_hom` (an `alg_hom` version of `direct_sum.submodule_coe`)

Strictly the definitions in this file are not sufficient to fully define an "internal" direct sum;
to represent this case, `(h : direct_sum.submodule_is_internal A) [set_like.graded_monoid A]` is
needed. In the future there will likely be a data-carrying, constructive, typeclass version of
`direct_sum.submodule_is_internal` for providing an explicit decomposition function.

When `complete_lattice.independent (set.range A)` (a weaker condition than
`direct_sum.submodule_is_internal A`), these provide a grading of `⨆ i, A i`, and the
mapping `⨁ i, A i →+ ⨆ i, A i` can be obtained as
`direct_sum.to_monoid (λ i, add_submonoid.inclusion $ le_supr A i)`.

## tags

internally graded ring
-/

open_locale direct_sum big_operators

variables {ι : Type*} {S R : Type*} [decidable_eq ι]

/-! #### From `add_submonoid`s -/

namespace add_submonoid

/-- Build a `gsemiring` instance for a collection of `add_submonoid`s. -/
instance gsemiring [add_monoid ι] [semiring R]
  (A : ι → add_submonoid R) [set_like.graded_monoid A] :
  direct_sum.gsemiring (λ i, A i) :=
{ mul_zero := λ i j _, subtype.ext (mul_zero _),
  zero_mul := λ i j _, subtype.ext (zero_mul _),
  mul_add := λ i j _ _ _, subtype.ext (mul_add _ _ _),
  add_mul := λ i j _ _ _, subtype.ext (add_mul _ _ _),
  ..set_like.gmonoid A }

/-- Build a `gcomm_semiring` instance for a collection of `add_submonoid`s. -/
instance gcomm_semiring [add_comm_monoid ι] [comm_semiring R]
  (A : ι → add_submonoid R) [set_like.graded_monoid A] :
  direct_sum.gcomm_semiring (λ i, A i) :=
{ ..set_like.gcomm_monoid A,
  ..add_submonoid.gsemiring A, }

end add_submonoid

/-- The canonical ring isomorphism between `⨁ i, A i` and `R`-/
def direct_sum.submonoid_coe_ring_hom [add_monoid ι] [semiring R]
  (A : ι → add_submonoid R) [h : set_like.graded_monoid A] : (⨁ i, A i) →+* R :=
direct_sum.to_semiring (λ i, (A i).subtype) rfl (λ _ _ _ _, rfl)

/-- The canonical ring isomorphism between `⨁ i, A i` and `R`-/
@[simp] lemma direct_sum.submonoid_coe_ring_hom_of [add_monoid ι] [semiring R]
  (A : ι → add_submonoid R) [h : set_like.graded_monoid A] (i : ι) (x : A i) :
  direct_sum.submonoid_coe_ring_hom A (direct_sum.of (λ i, A i) i x) = x :=
direct_sum.to_semiring_of _ _ _ _ _

lemma direct_sum.coe_mul_apply_add_submonoid [add_monoid ι] [semiring R]
  (A : ι → add_submonoid R) [set_like.graded_monoid A]
  [Π (i : ι) (x : A i), decidable (x ≠ 0)] (r r' : ⨁ i, A i) (i : ι) :
  ((r * r') i : R) =
    ∑ ij in finset.filter (λ ij : ι × ι, ij.1 + ij.2 = i) (r.support.product r'.support),
      r ij.1 * r' ij.2 :=
begin
  rw [direct_sum.mul_eq_sum_support_ghas_mul, dfinsupp.finset_sum_apply,
    add_submonoid.coe_finset_sum],
  simp_rw [direct_sum.coe_of_add_submonoid_apply, ←finset.sum_filter, set_like.coe_ghas_mul],
end

/-! #### From `add_subgroup`s -/

namespace add_subgroup

/-- Build a `gsemiring` instance for a collection of `add_subgroup`s. -/
instance gsemiring [add_monoid ι] [ring R]
  (A : ι → add_subgroup R) [h : set_like.graded_monoid A] :
  direct_sum.gsemiring (λ i, A i) :=
have i' : set_like.graded_monoid (λ i, (A i).to_add_submonoid) := {..h},
by exactI add_submonoid.gsemiring (λ i, (A i).to_add_submonoid)

/-- Build a `gcomm_semiring` instance for a collection of `add_subgroup`s. -/
instance gcomm_semiring [add_comm_group ι] [comm_ring R]
  (A : ι → add_subgroup R) [h : set_like.graded_monoid A] :
  direct_sum.gsemiring (λ i, A i) :=
have i' : set_like.graded_monoid (λ i, (A i).to_add_submonoid) := {..h},
by exactI add_submonoid.gsemiring (λ i, (A i).to_add_submonoid)

end add_subgroup

/-- The canonical ring isomorphism between `⨁ i, A i` and `R`. -/
def direct_sum.subgroup_coe_ring_hom [add_monoid ι] [ring R]
  (A : ι → add_subgroup R) [set_like.graded_monoid A] : (⨁ i, A i) →+* R :=
direct_sum.to_semiring (λ i, (A i).subtype) rfl (λ _ _ _ _, rfl)

@[simp] lemma direct_sum.subgroup_coe_ring_hom_of [add_monoid ι] [ring R]
  (A : ι → add_subgroup R) [set_like.graded_monoid A] (i : ι) (x : A i) :
  direct_sum.subgroup_coe_ring_hom A (direct_sum.of (λ i, A i) i x) = x :=
direct_sum.to_semiring_of _ _ _ _ _

lemma direct_sum.coe_mul_apply_add_subgroup [add_monoid ι] [ring R]
  (A : ι → add_subgroup R) [set_like.graded_monoid A] [Π (i : ι) (x : A i), decidable (x ≠ 0)]
  (r r' : ⨁ i, A i) (i : ι) :
  ((r * r') i : R) =
    ∑ ij in finset.filter (λ ij : ι × ι, ij.1 + ij.2 = i) (r.support.product r'.support),
      r ij.1 * r' ij.2 :=
begin
  rw [direct_sum.mul_eq_sum_support_ghas_mul, dfinsupp.finset_sum_apply,
    add_subgroup.coe_finset_sum],
  simp_rw [direct_sum.coe_of_add_subgroup_apply, ←finset.sum_filter, set_like.coe_ghas_mul],
end

/-! #### From `submodules`s -/

namespace submodule

/-- Build a `gsemiring` instance for a collection of `submodule`s. -/
instance gsemiring [add_monoid ι]
  [comm_semiring S] [semiring R] [algebra S R]
  (A : ι → submodule S R) [h : set_like.graded_monoid A] :
  direct_sum.gsemiring (λ i, A i) :=
have i' : set_like.graded_monoid (λ i, (A i).to_add_submonoid) := {..h},
by exactI add_submonoid.gsemiring (λ i, (A i).to_add_submonoid)

/-- Build a `gsemiring` instance for a collection of `submodule`s. -/
instance gcomm_semiring [add_comm_monoid ι]
  [comm_semiring S] [comm_semiring R] [algebra S R]
  (A : ι → submodule S R) [h : set_like.graded_monoid A] :
  direct_sum.gcomm_semiring (λ i, A i) :=
have i' : set_like.graded_monoid (λ i, (A i).to_add_submonoid) := {..h},
by exactI add_submonoid.gcomm_semiring (λ i, (A i).to_add_submonoid)

/-- Build a `galgebra` instance for a collection of `submodule`s. -/
instance galgebra [add_monoid ι]
  [comm_semiring S] [semiring R] [algebra S R]
  (A : ι → submodule S R) [h : set_like.graded_monoid A] :
  direct_sum.galgebra S (λ i, A i) :=
{ to_fun := begin
    refine ((algebra.linear_map S R).cod_restrict (A 0) $ λ r, _).to_add_monoid_hom,
    exact submodule.one_le.mpr set_like.has_graded_one.one_mem (submodule.algebra_map_mem _),
  end,
  map_one := subtype.ext $ by exact (algebra_map S R).map_one,
  map_mul := λ x y, sigma.subtype_ext (add_zero 0).symm $ (algebra_map S R).map_mul _ _,
  commutes := λ r ⟨i, xi⟩,
    sigma.subtype_ext ((zero_add i).trans (add_zero i).symm) $ algebra.commutes _ _,
  smul_def := λ r ⟨i, xi⟩, sigma.subtype_ext (zero_add i).symm $ algebra.smul_def _ _ }

@[simp] lemma set_like.coe_galgebra_to_fun [add_monoid ι]
  [comm_semiring S] [semiring R] [algebra S R]
  (A : ι → submodule S R) [h : set_like.graded_monoid A] (s : S) :
    ↑(@direct_sum.galgebra.to_fun _ S (λ i, A i) _ _ _ _ _ _ _ s) = (algebra_map S R s : R) := rfl

/-- A direct sum of powers of a submodule of an algebra has a multiplicative structure. -/
instance nat_power_graded_monoid
  [comm_semiring S] [semiring R] [algebra S R] (p : submodule S R) :
  set_like.graded_monoid (λ i : ℕ, p ^ i) :=
{ one_mem := by { rw [←one_le, pow_zero], exact le_rfl },
  mul_mem := λ i j p q hp hq, by { rw pow_add, exact submodule.mul_mem_mul hp hq } }

end submodule

/-- The canonical algebra isomorphism between `⨁ i, A i` and `R`. -/
def direct_sum.submodule_coe_alg_hom [add_monoid ι]
  [comm_semiring S] [semiring R] [algebra S R]
  (A : ι → submodule S R) [h : set_like.graded_monoid A] : (⨁ i, A i) →ₐ[S] R :=
direct_sum.to_algebra S _ (λ i, (A i).subtype) rfl (λ _ _ _ _, rfl) (λ _, rfl)

@[simp] lemma direct_sum.submodule_coe_alg_hom_of [add_monoid ι]
  [comm_semiring S] [semiring R] [algebra S R]
  (A : ι → submodule S R) [h : set_like.graded_monoid A] (i : ι) (x : A i) :
  direct_sum.submodule_coe_alg_hom A (direct_sum.of (λ i, A i) i x) = x :=
direct_sum.to_semiring_of _ rfl (λ _ _ _ _, rfl) _ _

lemma direct_sum.coe_mul_apply_submodule [add_monoid ι]
  [comm_semiring S] [semiring R] [algebra S R]
  (A : ι → submodule S R) [Π (i : ι) (x : A i), decidable (x ≠ 0)]
  [set_like.graded_monoid A] (r r' : ⨁ i, A i) (i : ι) :
  ((r * r') i : R) =
    ∑ ij in finset.filter (λ ij : ι × ι, ij.1 + ij.2 = i) (r.support.product r'.support),
      r ij.1 * r' ij.2 :=
begin
  rw [direct_sum.mul_eq_sum_support_ghas_mul, dfinsupp.finset_sum_apply, submodule.coe_sum],
  simp_rw [direct_sum.coe_of_submodule_apply, ←finset.sum_filter, set_like.coe_ghas_mul],
end


/-
Copyright (c) 2021 Henry Swanson. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Henry Swanson
-/
import dynamics.fixed_points.basic
import group_theory.perm.option
import logic.equiv.defs
import logic.equiv.option

/-!
# Derangements on types

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

In this file we define `derangements α`, the set of derangements on a type `α`.

We also define some equivalences involving various subtypes of `perm α` and `derangements α`:
* `derangements_option_equiv_sigma_at_most_one_fixed_point`: An equivalence between
  `derangements (option α)` and the sigma-type `Σ a : α, {f : perm α // fixed_points f ⊆ a}`.
* `derangements_recursion_equiv`: An equivalence between `derangements (option α)` and the
  sigma-type `Σ a : α, (derangements (({a}ᶜ : set α) : Type _) ⊕ derangements α)` which is later
  used to inductively count the number of derangements.

In order to prove the above, we also prove some results about the effect of `equiv.remove_none`
on derangements: `remove_none.fiber_none` and `remove_none.fiber_some`.
-/

open equiv function

/-- A permutation is a derangement if it has no fixed points. -/
def derangements (α : Type*) : set (perm α) := {f : perm α | ∀ x : α, f x ≠ x}

variables {α β : Type*}

lemma mem_derangements_iff_fixed_points_eq_empty {f : perm α} :
  f ∈ derangements α ↔ fixed_points f = ∅ :=
set.eq_empty_iff_forall_not_mem.symm

/-- If `α` is equivalent to `β`, then `derangements α` is equivalent to `derangements β`. -/
def equiv.derangements_congr (e : α ≃ β) : (derangements α ≃ derangements β) :=
e.perm_congr.subtype_equiv $ λ f, e.forall_congr $ by simp

namespace derangements

/-- Derangements on a subtype are equivalent to permutations on the original type where points are
fixed iff they are not in the subtype. -/
protected def subtype_equiv (p : α → Prop) [decidable_pred p] :
  derangements (subtype p) ≃ {f : perm α // ∀ a, ¬p a ↔ a ∈ fixed_points f} :=
calc
  derangements (subtype p)
      ≃ {f : {f : perm α // ∀ a, ¬p a → a ∈ fixed_points f} // ∀ a, a ∈ fixed_points f → ¬p a}
      : begin
        refine (perm.subtype_equiv_subtype_perm p).subtype_equiv (λ f, ⟨λ hf a hfa ha, _, _⟩),
        { refine hf ⟨a, ha⟩ (subtype.ext _),
          rwa [mem_fixed_points, is_fixed_pt, perm.subtype_equiv_subtype_perm, @coe_fn_coe_base',
               equiv.coe_fn_mk, subtype.coe_mk, equiv.perm.of_subtype_apply_of_mem]
            at hfa },
        rintro hf ⟨a, ha⟩ hfa,
        refine hf _ _ ha,
        change perm.subtype_equiv_subtype_perm p f a = a,
        rw [perm.subtype_equiv_subtype_perm_apply_of_mem f ha, hfa, subtype.coe_mk],
      end
  ... ≃ {f : perm α // ∃ (h : ∀ a, ¬p a → a ∈ fixed_points f), ∀ a, a ∈ fixed_points f → ¬p a}
      : subtype_subtype_equiv_subtype_exists _ _
  ... ≃ {f : perm α // ∀ a, ¬p a ↔ a ∈ fixed_points f}
      : subtype_equiv_right (λ f, by simp_rw [exists_prop, ←forall_and_distrib,
        ←iff_iff_implies_and_implies])

/-- The set of permutations that fix either `a` or nothing is equivalent to the sum of:
    - derangements on `α`
    - derangements on `α` minus `a`. -/
def at_most_one_fixed_point_equiv_sum_derangements [decidable_eq α] (a : α) :
  {f : perm α // fixed_points f ⊆ {a}} ≃ (derangements ({a}ᶜ : set α)) ⊕ derangements α :=
calc
  {f : perm α // fixed_points f ⊆ {a}}
      ≃ {f : {f : perm α // fixed_points f ⊆ {a}} // a ∈ fixed_points f}
        ⊕ {f : {f : perm α // fixed_points f ⊆ {a}} // a ∉ fixed_points f}
      : (equiv.sum_compl _).symm
  ... ≃ {f : perm α // fixed_points f ⊆ {a} ∧ a ∈ fixed_points f}
        ⊕ {f : perm α // fixed_points f ⊆ {a} ∧ a ∉ fixed_points f}
      : begin
        refine equiv.sum_congr _ _;
        { convert subtype_subtype_equiv_subtype_inter _ _, ext f, refl }
      end
  ... ≃ {f : perm α // fixed_points f = {a}} ⊕ {f : perm α // fixed_points f = ∅}
      : begin
        refine equiv.sum_congr (subtype_equiv_right $ λ f, _) (subtype_equiv_right $ λ f, _),
        { rw [set.eq_singleton_iff_unique_mem, and_comm],
          refl },
        { rw set.eq_empty_iff_forall_not_mem,
          refine ⟨λ h x hx, h.2 (h.1 hx ▸ hx), λ h, ⟨λ x hx, (h _ hx).elim, h _⟩⟩ }
      end
  ... ≃ (derangements ({a}ᶜ : set α)) ⊕ derangements α
      : begin
        refine equiv.sum_congr ((derangements.subtype_equiv _).trans $ subtype_equiv_right $ λ x,
          _).symm (subtype_equiv_right $ λ f, mem_derangements_iff_fixed_points_eq_empty.symm),
        rw [eq_comm, set.ext_iff],
        simp_rw [set.mem_compl_iff, not_not],
      end

namespace equiv
variables [decidable_eq α]

/-- The set of permutations `f` such that the preimage of `(a, f)` under
    `equiv.perm.decompose_option` is a derangement. -/
def remove_none.fiber (a : option α) : set (perm α) :=
  {f : perm α | (a, f) ∈ equiv.perm.decompose_option '' derangements (option α)}

lemma remove_none.mem_fiber (a : option α) (f : perm α) :
  f ∈ remove_none.fiber a ↔
  ∃ F : perm (option α), F ∈ derangements (option α) ∧ F none = a ∧ remove_none F = f :=
by simp [remove_none.fiber, derangements]

lemma remove_none.fiber_none : remove_none.fiber (@none α) = ∅ :=
begin
  rw set.eq_empty_iff_forall_not_mem,
  intros f hyp,
  rw remove_none.mem_fiber at hyp,
  rcases hyp with ⟨F, F_derangement, F_none, _⟩,
  exact F_derangement none F_none
end

/-- For any `a : α`, the fiber over `some a` is the set of permutations
    where `a` is the only possible fixed point. -/
lemma remove_none.fiber_some (a : α) :
  (remove_none.fiber (some a)) = {f : perm α | fixed_points f ⊆ {a}} :=
begin
  ext f,
  split,
  { rw remove_none.mem_fiber,
    rintro ⟨F, F_derangement, F_none, rfl⟩ x x_fixed,
    rw mem_fixed_points_iff at x_fixed,
    apply_fun some at x_fixed,
    cases Fx : F (some x) with y,
    { rwa [remove_none_none F Fx, F_none, option.some_inj, eq_comm] at x_fixed },
    { exfalso, rw remove_none_some F ⟨y, Fx⟩ at x_fixed, exact F_derangement _ x_fixed } },
  { intro h_opfp,
    use equiv.perm.decompose_option.symm (some a, f),
    split,
    { intro x,
      apply_fun (swap none (some a)),
      simp only [perm.decompose_option_symm_apply, swap_apply_self, perm.coe_mul],
      cases x,
      { simp },
      simp only [equiv.option_congr_apply, option.map_some'],
      by_cases x_vs_a : x = a,
      { rw [x_vs_a, swap_apply_right], apply option.some_ne_none },
      have ne_1 : some x ≠ none := option.some_ne_none _,
      have ne_2 : some x ≠ some a := (option.some_injective α).ne_iff.mpr x_vs_a,
      rw [swap_apply_of_ne_of_ne ne_1 ne_2, (option.some_injective α).ne_iff],
      intro contra,
      exact x_vs_a (h_opfp contra) },
    { rw apply_symm_apply } }
end

end equiv

section option
variables [decidable_eq α]

/-- The set of derangements on `option α` is equivalent to the union over `a : α`
    of "permutations with `a` the only possible fixed point". -/
def derangements_option_equiv_sigma_at_most_one_fixed_point :
  derangements (option α) ≃ Σ a : α, {f : perm α | fixed_points f ⊆ {a}} :=
begin
  have fiber_none_is_false : (equiv.remove_none.fiber (@none α)) -> false,
  { rw equiv.remove_none.fiber_none, exact is_empty.false },

  calc derangements (option α)
      ≃ equiv.perm.decompose_option '' derangements (option α) : equiv.image _ _
  ... ≃ Σ (a : option α), ↥(equiv.remove_none.fiber a)         : set_prod_equiv_sigma _
  ... ≃ Σ (a : α), ↥(equiv.remove_none.fiber (some a))
          : sigma_option_equiv_of_some _ fiber_none_is_false
  ... ≃ Σ (a : α), {f : perm α | fixed_points f ⊆ {a}}
          : by simp_rw equiv.remove_none.fiber_some,
end

/-- The set of derangements on `option α` is equivalent to the union over all `a : α` of
    "derangements on `α` ⊕ derangements on `{a}ᶜ`". -/
def derangements_recursion_equiv :
  derangements (option α) ≃ Σ a : α, (derangements (({a}ᶜ : set α) : Type _) ⊕ derangements α) :=
derangements_option_equiv_sigma_at_most_one_fixed_point.trans (sigma_congr_right
  at_most_one_fixed_point_equiv_sum_derangements)

end option

end derangements