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

import category_theory.abelian.homology
import category_theory.functor.left_derived
import category_theory.abelian.projective
import category_theory.limits.constructions.epi_mono

/-!
# Zeroth left derived functors

If `F : C ⥤ D` is an additive right exact functor between abelian categories, where `C` has enough
projectives, we provide the natural isomorphism `F.left_derived 0 ≅ F`.

## Main definitions

* `category_theory.abelian.functor.left_derived_zero_iso_self`: the natural isomorphism
  `(F.left_derived 0) ≅ F`.

## Main results
* `preserves_exact_of_preserves_finite_colimits_of_epi`: if `preserves_finite_colimits F` and
  `epi g`, then `exact (F.map f) (F.map g)` if `exact f g`.

-/

noncomputable theory

universes w v u

open category_theory.limits category_theory category_theory.functor

variables {C : Type u} [category.{w} C] {D : Type u} [category.{w} D]
variables (F : C ⥤ D) {X Y Z : C} {f : X ⟶ Y} {g : Y ⟶ Z}

namespace category_theory.abelian.functor

open category_theory.preadditive

variables [abelian C] [abelian D] [additive F]

/-- If `preserves_finite_colimits F` and `epi g`, then `exact (F.map f) (F.map g)` if
`exact f g`. -/
lemma preserves_exact_of_preserves_finite_colimits_of_epi [preserves_finite_colimits F] [epi g]
  (ex : exact f g) : exact (F.map f) (F.map g) :=
abelian.exact_of_is_cokernel _ _ (by simp [← functor.map_comp, ex.w])
  $ limits.is_colimit_cofork_map_of_is_colimit' _ ex.w (abelian.is_colimit_of_exact_of_epi _ _ ex)

lemma exact_of_map_projective_resolution (P: ProjectiveResolution X) [preserves_finite_colimits F] :
  exact (((F.map_homological_complex (complex_shape.down ℕ)).obj P.complex).d_to 0)
  (F.map (P.π.f 0)) :=
preadditive.exact_of_iso_of_exact' (F.map (P.complex.d 1 0)) (F.map (P.π.f 0)) _ _
    (homological_complex.X_prev_iso ((F.map_homological_complex _).obj P.complex) rfl).symm
    (iso.refl _) (iso.refl _) (by simp) (by simp)
    (preserves_exact_of_preserves_finite_colimits_of_epi _ (P.exact₀))

/-- Given `P : ProjectiveResolution X`, a morphism `(F.left_derived 0).obj X ⟶ F.obj X`. -/
@[nolint unused_arguments]
def left_derived_zero_to_self_app [enough_projectives C] {X : C}
  (P : ProjectiveResolution X) : (F.left_derived 0).obj X ⟶ F.obj X :=
(left_derived_obj_iso F 0 P).hom ≫ homology.desc' _ _ _ (kernel.ι _ ≫ (F.map (P.π.f 0)))
begin
  rw [kernel.lift_ι_assoc, homological_complex.d_to_eq _ (by simp : (complex_shape.down ℕ).rel 1 0),
    map_homological_complex_obj_d, category.assoc, ← functor.map_comp],
  simp
end

/-- Given `P : ProjectiveResolution X`, a morphism `F.obj X ⟶ (F.left_derived 0).obj X` given
`preserves_finite_colimits F`. -/
def left_derived_zero_to_self_app_inv [enough_projectives C] [preserves_finite_colimits F] {X : C}
  (P : ProjectiveResolution X) : F.obj X ⟶ (F.left_derived 0).obj X :=
begin
  refine ((as_iso (cokernel.desc _ _ (exact_of_map_projective_resolution F P).w)).inv) ≫ _ ≫
    (homology_iso_cokernel_lift _ _ _).inv ≫ (left_derived_obj_iso F 0 P).inv,
  exact cokernel.map _ _ (𝟙 _) (kernel.lift _ (𝟙 _) (by simp)) (by { ext, simp }),
end

lemma left_derived_zero_to_self_app_comp_inv [enough_projectives C] [preserves_finite_colimits F]
  {X : C} (P : ProjectiveResolution X) : left_derived_zero_to_self_app F P ≫
  left_derived_zero_to_self_app_inv F P = 𝟙 _ :=
begin
  dsimp [left_derived_zero_to_self_app, left_derived_zero_to_self_app_inv],
  rw [← category.assoc, ← category.assoc, ← category.assoc, iso.comp_inv_eq, category.id_comp,
    category.assoc, category.assoc, category.assoc],
  convert category.comp_id _,
  rw [← category.assoc, ← category.assoc, iso.comp_inv_eq, category.id_comp],
  ext,
  rw [← category.assoc, ← category.assoc, homology.π'_desc', category.assoc, category.assoc,
    ← category.assoc (F.map _), abelian.cokernel.desc.inv, cokernel.π_desc, homology.π',
    category.assoc, iso.inv_hom_id, category.comp_id, ← category.assoc],
  convert category.id_comp _ using 2,
  ext,
  rw [category.id_comp, category.assoc, equalizer_as_kernel, kernel.lift_ι, category.comp_id],
end

lemma left_derived_zero_to_self_app_inv_comp [enough_projectives C] [preserves_finite_colimits F]
  {X : C} (P : ProjectiveResolution X) : left_derived_zero_to_self_app_inv F P ≫
  left_derived_zero_to_self_app F P = 𝟙 _ :=
begin
  dsimp [left_derived_zero_to_self_app, left_derived_zero_to_self_app_inv],
  rw [category.assoc, category.assoc, category.assoc,
    ← category.assoc (F.left_derived_obj_iso 0 P).inv, iso.inv_hom_id, category.id_comp,
    is_iso.inv_comp_eq, category.comp_id],
  ext,
  simp only [cokernel.π_desc_assoc, category.assoc, cokernel.π_desc, homology.desc'],
  rw [← category.assoc, ← category.assoc (homology_iso_cokernel_lift _ _ _).inv, iso.inv_hom_id,
    category.id_comp],
  simp only [category.assoc, cokernel.π_desc, kernel.lift_ι_assoc, category.id_comp],
end

/-- Given `P : ProjectiveResolution X`, the isomorphism `(F.left_derived 0).obj X ≅ F.obj X` if
`preserves_finite_colimits F`. -/
def left_derived_zero_to_self_app_iso [enough_projectives C] [preserves_finite_colimits F]
  {X : C} (P : ProjectiveResolution X) : (F.left_derived 0).obj X ≅ F.obj X :=
{ hom := left_derived_zero_to_self_app _ P,
  inv := left_derived_zero_to_self_app_inv _ P,
  hom_inv_id' := left_derived_zero_to_self_app_comp_inv _ P,
  inv_hom_id' := left_derived_zero_to_self_app_inv_comp _ P }

/-- Given `P : ProjectiveResolution X` and `Q : ProjectiveResolution Y` and a morphism `f : X ⟶ Y`,
naturality of the square given by `left_derived_zero_to_self_obj_hom. -/
lemma left_derived_zero_to_self_natural [enough_projectives C] {X : C} {Y : C} (f : X ⟶ Y)
  (P : ProjectiveResolution X) (Q : ProjectiveResolution Y) :
  (F.left_derived 0).map f ≫ left_derived_zero_to_self_app F Q =
  left_derived_zero_to_self_app F P ≫ F.map f :=
begin
  dsimp only [left_derived_zero_to_self_app],
  rw [functor.left_derived_map_eq F 0 f (ProjectiveResolution.lift f P Q) (by simp),
    category.assoc, category.assoc, ← category.assoc _ (F.left_derived_obj_iso 0 Q).hom,
    iso.inv_hom_id, category.id_comp, category.assoc, whisker_eq],
  dsimp only [homology_functor_map],
  ext,
  simp only [homological_complex.hom.sq_to_right, map_homological_complex_map_f,
    homology.π'_map_assoc, homology.π'_desc', kernel.lift_ι_assoc, category.assoc,
    homology.π'_desc'_assoc, ← map_comp, show (ProjectiveResolution.lift f P Q).f 0 ≫ _ = _ ≫ f,
    from homological_complex.congr_hom (ProjectiveResolution.lift_commutes f P Q) 0],
end

/-- Given `preserves_finite_colimits F`, the natural isomorphism `(F.left_derived 0) ≅ F`. -/
def left_derived_zero_iso_self [enough_projectives C] [preserves_finite_colimits F] :
  (F.left_derived 0) ≅ F :=
nat_iso.of_components (λ X, left_derived_zero_to_self_app_iso _ (ProjectiveResolution.of X))
  (λ X Y f, left_derived_zero_to_self_natural _ _ _ _)

end category_theory.abelian.functor


import ontology math.fuzzy
open set topological_space classical
local attribute [instance] prop_decidable

-- THIS FILE IS VERY MUCH A WORK IN PROGRESS.

namespace ontology

-- TODO: consider redefining events as observables
-- later, and changing notation to support it.
-- This would be a major refactoring, but one
-- which does not change the essence of the system,
-- so we defer it to after the project is close
-- to the end.

  variables (ω : ontology)

  abbreviation observable (α : Sort*)
                [topological_space α]
                [has_none α]
                := ω.world → α

  abbreviation event' := ω.observable Prop

  @[simp]
  lemma event'_eq_event : ω.event' = ω.event :=
  by simp [ontology.event, set]

  abbreviation quantity := ω.observable (option ℝ)

section observables

  variables {ω} {α : Type*} [topological_space α]
            [has_none α] (o : ω.observable α)

  abbreviation observable.perfect := continuous o

  /- observables are coerced to their domain of definition -/
  instance has_coe_observable_event : has_coe (ω.observable α) ω.event := ⟨λ f x, f x ≠ has_none.none⟩

end observables

  -- We now talk about analogical (fuzzy) events, or "aevents" TODO: revise this comment.
  abbreviation aevent :=  ω.observable fuzzy

namespace aevent

  variables {ω} (ae : ω.aevent)

  abbreviation aevent.possible := (↑ae : ω.event).possible

  /-- Use `⋄ae` for "`ae` is possible" -/
  instance has_diamond_aevent : has_diamond ω.aevent := ⟨aevent.possible⟩

end aevent

end ontology


/-
Copyright (c) 2020 Chris Hughes. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Chris Hughes
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.data.equiv.mul_add_aut
import Mathlib.logic.function.basic
import Mathlib.group_theory.subgroup
import Mathlib.PostPort

universes u_1 u_2 l u_3 u_4 u_5

namespace Mathlib

/-!
# Semidirect product

This file defines semidirect products of groups, and the canonical maps in and out of the
semidirect product. The semidirect product of `N` and `G` given a hom `φ` from
`φ` from `G` to the automorphism group of `N` is the product of sets with the group
`⟨n₁, g₁⟩ * ⟨n₂, g₂⟩ = ⟨n₁ * φ g₁ n₂, g₁ * g₂⟩`

## Key definitions

There are two homs into the semidirect product `inl : N →* N ⋊[φ] G` and
`inr : G →* N ⋊[φ] G`, and `lift` can be used to define maps `N ⋊[φ] G →* H`
out of the semidirect product given maps `f₁ : N →* H` and `f₂ : G →* H` that satisfy the
condition `∀ n g, f₁ (φ g n) = f₂ g * f₁ n * f₂ g⁻¹`

## Notation

This file introduces the global notation `N ⋊[φ] G` for `semidirect_product N G φ`

## Tags
group, semidirect product
-/

/-- The semidirect product of groups `N` and `G`, given a map `φ` from `G` to the automorphism
  group of `N`. It the product of sets with the group operation
  `⟨n₁, g₁⟩ * ⟨n₂, g₂⟩ = ⟨n₁ * φ g₁ n₂, g₁ * g₂⟩` -/
structure semidirect_product (N : Type u_1) (G : Type u_2) [group N] [group G] (φ : G →* mul_aut N)
where
  left : N
  right : G

namespace semidirect_product

protected instance group {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} : group (semidirect_product N G φ) :=
  group.mk mul_aux mul_assoc_aux one_aux one_mul_aux mul_one_aux inv_aux
    (div_inv_monoid.div._default mul_aux mul_assoc_aux one_aux one_mul_aux mul_one_aux inv_aux) mul_left_inv_aux

protected instance inhabited {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} : Inhabited (semidirect_product N G φ) :=
  { default := 1 }

@[simp] theorem one_left {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} : left 1 = 1 :=
  rfl

@[simp] theorem one_right {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} : right 1 = 1 :=
  rfl

@[simp] theorem inv_left {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} (a : semidirect_product N G φ) : left (a⁻¹) = coe_fn (coe_fn φ (right a⁻¹)) (left a⁻¹) :=
  rfl

@[simp] theorem inv_right {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} (a : semidirect_product N G φ) : right (a⁻¹) = (right a⁻¹) :=
  rfl

@[simp] theorem mul_left {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} (a : semidirect_product N G φ) (b : semidirect_product N G φ) : left (a * b) = left a * coe_fn (coe_fn φ (right a)) (left b) :=
  rfl

@[simp] theorem mul_right {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} (a : semidirect_product N G φ) (b : semidirect_product N G φ) : right (a * b) = right a * right b :=
  rfl

/-- The canonical map `N →* N ⋊[φ] G` sending `n` to `⟨n, 1⟩` -/
def inl {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} : N →* semidirect_product N G φ :=
  monoid_hom.mk (fun (n : N) => mk n 1) sorry sorry

@[simp] theorem left_inl {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} (n : N) : left (coe_fn inl n) = n :=
  rfl

@[simp] theorem right_inl {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} (n : N) : right (coe_fn inl n) = 1 :=
  rfl

theorem inl_injective {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} : function.injective ⇑inl :=
  iff.mpr function.injective_iff_has_left_inverse (Exists.intro left left_inl)

@[simp] theorem inl_inj {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} {n₁ : N} {n₂ : N} : coe_fn inl n₁ = coe_fn inl n₂ ↔ n₁ = n₂ :=
  function.injective.eq_iff inl_injective

/-- The canonical map `G →* N ⋊[φ] G` sending `g` to `⟨1, g⟩` -/
def inr {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} : G →* semidirect_product N G φ :=
  monoid_hom.mk (fun (g : G) => mk 1 g) sorry sorry

@[simp] theorem left_inr {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} (g : G) : left (coe_fn inr g) = 1 :=
  rfl

@[simp] theorem right_inr {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} (g : G) : right (coe_fn inr g) = g :=
  rfl

theorem inr_injective {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} : function.injective ⇑inr :=
  iff.mpr function.injective_iff_has_left_inverse (Exists.intro right right_inr)

@[simp] theorem inr_inj {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} {g₁ : G} {g₂ : G} : coe_fn inr g₁ = coe_fn inr g₂ ↔ g₁ = g₂ :=
  function.injective.eq_iff inr_injective

theorem inl_aut {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} (g : G) (n : N) : coe_fn inl (coe_fn (coe_fn φ g) n) = coe_fn inr g * coe_fn inl n * coe_fn inr (g⁻¹) := sorry

theorem inl_aut_inv {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} (g : G) (n : N) : coe_fn inl (coe_fn (coe_fn φ g⁻¹) n) = coe_fn inr (g⁻¹) * coe_fn inl n * coe_fn inr g := sorry

@[simp] theorem mk_eq_inl_mul_inr {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} (g : G) (n : N) : mk n g = coe_fn inl n * coe_fn inr g := sorry

@[simp] theorem inl_left_mul_inr_right {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} (x : semidirect_product N G φ) : coe_fn inl (left x) * coe_fn inr (right x) = x := sorry

/-- The canonical projection map `N ⋊[φ] G →* G`, as a group hom. -/
def right_hom {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} : semidirect_product N G φ →* G :=
  monoid_hom.mk right sorry sorry

@[simp] theorem right_hom_eq_right {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} : ⇑right_hom = right :=
  rfl

@[simp] theorem right_hom_comp_inl {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} : monoid_hom.comp right_hom inl = 1 := sorry

@[simp] theorem right_hom_comp_inr {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} : monoid_hom.comp right_hom inr = monoid_hom.id G := sorry

@[simp] theorem right_hom_inl {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} (n : N) : coe_fn right_hom (coe_fn inl n) = 1 := sorry

@[simp] theorem right_hom_inr {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} (g : G) : coe_fn right_hom (coe_fn inr g) = g := sorry

theorem right_hom_surjective {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} : function.surjective ⇑right_hom :=
  iff.mpr function.surjective_iff_has_right_inverse (Exists.intro (⇑inr) right_hom_inr)

theorem range_inl_eq_ker_right_hom {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} : monoid_hom.range inl = monoid_hom.ker right_hom := sorry

/-- Define a group hom `N ⋊[φ] G →* H`, by defining maps `N →* H` and `G →* H`  -/
def lift {N : Type u_1} {G : Type u_2} {H : Type u_3} [group N] [group G] [group H] {φ : G →* mul_aut N} (f₁ : N →* H) (f₂ : G →* H) (h : ∀ (g : G),
  monoid_hom.comp f₁ (mul_equiv.to_monoid_hom (coe_fn φ g)) =
    monoid_hom.comp (mul_equiv.to_monoid_hom (coe_fn mul_aut.conj (coe_fn f₂ g))) f₁) : semidirect_product N G φ →* H :=
  monoid_hom.mk (fun (a : semidirect_product N G φ) => coe_fn f₁ (left a) * coe_fn f₂ (right a)) sorry sorry

@[simp] theorem lift_inl {N : Type u_1} {G : Type u_2} {H : Type u_3} [group N] [group G] [group H] {φ : G →* mul_aut N} (f₁ : N →* H) (f₂ : G →* H) (h : ∀ (g : G),
  monoid_hom.comp f₁ (mul_equiv.to_monoid_hom (coe_fn φ g)) =
    monoid_hom.comp (mul_equiv.to_monoid_hom (coe_fn mul_aut.conj (coe_fn f₂ g))) f₁) (n : N) : coe_fn (lift f₁ f₂ h) (coe_fn inl n) = coe_fn f₁ n := sorry

@[simp] theorem lift_comp_inl {N : Type u_1} {G : Type u_2} {H : Type u_3} [group N] [group G] [group H] {φ : G →* mul_aut N} (f₁ : N →* H) (f₂ : G →* H) (h : ∀ (g : G),
  monoid_hom.comp f₁ (mul_equiv.to_monoid_hom (coe_fn φ g)) =
    monoid_hom.comp (mul_equiv.to_monoid_hom (coe_fn mul_aut.conj (coe_fn f₂ g))) f₁) : monoid_hom.comp (lift f₁ f₂ h) inl = f₁ := sorry

@[simp] theorem lift_inr {N : Type u_1} {G : Type u_2} {H : Type u_3} [group N] [group G] [group H] {φ : G →* mul_aut N} (f₁ : N →* H) (f₂ : G →* H) (h : ∀ (g : G),
  monoid_hom.comp f₁ (mul_equiv.to_monoid_hom (coe_fn φ g)) =
    monoid_hom.comp (mul_equiv.to_monoid_hom (coe_fn mul_aut.conj (coe_fn f₂ g))) f₁) (g : G) : coe_fn (lift f₁ f₂ h) (coe_fn inr g) = coe_fn f₂ g := sorry

@[simp] theorem lift_comp_inr {N : Type u_1} {G : Type u_2} {H : Type u_3} [group N] [group G] [group H] {φ : G →* mul_aut N} (f₁ : N →* H) (f₂ : G →* H) (h : ∀ (g : G),
  monoid_hom.comp f₁ (mul_equiv.to_monoid_hom (coe_fn φ g)) =
    monoid_hom.comp (mul_equiv.to_monoid_hom (coe_fn mul_aut.conj (coe_fn f₂ g))) f₁) : monoid_hom.comp (lift f₁ f₂ h) inr = f₂ := sorry

theorem lift_unique {N : Type u_1} {G : Type u_2} {H : Type u_3} [group N] [group G] [group H] {φ : G →* mul_aut N} (F : semidirect_product N G φ →* H) : F =
  lift (monoid_hom.comp F inl) (monoid_hom.comp F inr)
    fun (_x : G) =>
      monoid_hom.ext
        fun (x : N) =>
          eq.mpr
            (id
              (Eq.trans
                (Eq.trans
                  (Eq.trans
                    ((fun (a a_1 : H) (e_1 : a = a_1) (ᾰ ᾰ_1 : H) (e_2 : ᾰ = ᾰ_1) => congr (congr_arg Eq e_1) e_2)
                      (coe_fn (monoid_hom.comp (monoid_hom.comp F inl) (mul_equiv.to_monoid_hom (coe_fn φ _x))) x)
                      (coe_fn F (coe_fn inr _x) * coe_fn F (coe_fn inl x) * (coe_fn F (coe_fn inr _x)⁻¹))
                      (Eq.trans
                        (Eq.trans
                          (Eq.trans
                            (Eq.trans
                              (Eq.trans
                                (Eq.trans
                                  (congr_fun
                                    (monoid_hom.coe_comp (monoid_hom.comp F inl)
                                      (mul_equiv.to_monoid_hom (coe_fn φ _x)))
                                    x)
                                  ((fun (f f_1 : N → H) (e_1 : f = f_1) (g g_1 : N → N) (e_2 : g = g_1) (ᾰ ᾰ_1 : N)
                                      (e_3 : ᾰ = ᾰ_1) => congr (congr (congr_arg function.comp e_1) e_2) e_3)
                                    (⇑(monoid_hom.comp F inl)) (⇑F ∘ ⇑inl) (monoid_hom.coe_comp F inl)
                                    (⇑(mul_equiv.to_monoid_hom (coe_fn φ _x))) (⇑(coe_fn φ _x))
                                    (mul_equiv.coe_to_monoid_hom (coe_fn φ _x)) x x (Eq.refl x)))
                                (function.comp_app (⇑F ∘ ⇑inl) (⇑(coe_fn φ _x)) x))
                              (function.comp_app (⇑F) (⇑inl) (coe_fn (coe_fn φ _x) x)))
                            ((fun (x x_1 : semidirect_product N G φ →* H) (e_1 : x = x_1)
                                (ᾰ ᾰ_1 : semidirect_product N G φ) (e_2 : ᾰ = ᾰ_1) => congr (congr_arg coe_fn e_1) e_2)
                              F F (Eq.refl F) (coe_fn inl (coe_fn (coe_fn φ _x) x))
                              (coe_fn inr _x * coe_fn inl x * (coe_fn inr _x⁻¹))
                              (Eq.trans (inl_aut _x x)
                                ((fun (ᾰ ᾰ_1 : semidirect_product N G φ) (e_2 : ᾰ = ᾰ_1)
                                    (ᾰ_2 ᾰ_3 : semidirect_product N G φ) (e_3 : ᾰ_2 = ᾰ_3) =>
                                    congr (congr_arg Mul.mul e_2) e_3)
                                  (coe_fn inr _x * coe_fn inl x) (coe_fn inr _x * coe_fn inl x)
                                  (Eq.refl (coe_fn inr _x * coe_fn inl x)) (coe_fn inr (_x⁻¹)) (coe_fn inr _x⁻¹)
                                  (monoid_hom.map_inv inr _x)))))
                          (monoid_hom.map_mul_inv F (coe_fn inr _x * coe_fn inl x) (coe_fn inr _x)))
                        ((fun (ᾰ ᾰ_1 : H) (e_2 : ᾰ = ᾰ_1) (ᾰ_2 ᾰ_3 : H) (e_3 : ᾰ_2 = ᾰ_3) =>
                            congr (congr_arg Mul.mul e_2) e_3)
                          (coe_fn F (coe_fn inr _x * coe_fn inl x)) (coe_fn F (coe_fn inr _x) * coe_fn F (coe_fn inl x))
                          (monoid_hom.map_mul F (coe_fn inr _x) (coe_fn inl x)) (coe_fn F (coe_fn inr _x)⁻¹)
                          (coe_fn F (coe_fn inr _x)⁻¹) (Eq.refl (coe_fn F (coe_fn inr _x)⁻¹))))
                      (coe_fn
                        (monoid_hom.comp
                          (mul_equiv.to_monoid_hom (coe_fn mul_aut.conj (coe_fn (monoid_hom.comp F inr) _x)))
                          (monoid_hom.comp F inl))
                        x)
                      (coe_fn F (coe_fn inr _x) * coe_fn F (coe_fn inl x) * (coe_fn F (coe_fn inr _x)⁻¹))
                      (Eq.trans
                        (Eq.trans
                          (Eq.trans
                            (Eq.trans
                              (Eq.trans
                                ((fun (x x_1 : N →* H) (e_1 : x = x_1) (ᾰ ᾰ_1 : N) (e_2 : ᾰ = ᾰ_1) =>
                                    congr (congr_arg coe_fn e_1) e_2)
                                  (monoid_hom.comp
                                    (mul_equiv.to_monoid_hom (coe_fn mul_aut.conj (coe_fn (monoid_hom.comp F inr) _x)))
                                    (monoid_hom.comp F inl))
                                  (monoid_hom.comp
                                    (mul_equiv.to_monoid_hom (coe_fn mul_aut.conj (coe_fn F (coe_fn inr _x))))
                                    (monoid_hom.comp F inl))
                                  ((fun (hnp hnp_1 : H →* H) (e_1 : hnp = hnp_1) (hmn hmn_1 : N →* H)
                                      (e_2 : hmn = hmn_1) => congr (congr_arg monoid_hom.comp e_1) e_2)
                                    (mul_equiv.to_monoid_hom (coe_fn mul_aut.conj (coe_fn (monoid_hom.comp F inr) _x)))
                                    (mul_equiv.to_monoid_hom (coe_fn mul_aut.conj (coe_fn F (coe_fn inr _x))))
                                    ((fun (h h_1 : H ≃* H) (e_1 : h = h_1) => congr_arg mul_equiv.to_monoid_hom e_1)
                                      (coe_fn mul_aut.conj (coe_fn (monoid_hom.comp F inr) _x))
                                      (coe_fn mul_aut.conj (coe_fn F (coe_fn inr _x)))
                                      ((fun (x x_1 : H →* mul_aut H) (e_1 : x = x_1) (ᾰ ᾰ_1 : H) (e_2 : ᾰ = ᾰ_1) =>
                                          congr (congr_arg coe_fn e_1) e_2)
                                        mul_aut.conj mul_aut.conj (Eq.refl mul_aut.conj)
                                        (coe_fn (monoid_hom.comp F inr) _x) (coe_fn F (coe_fn inr _x))
                                        (Eq.trans (congr_fun (monoid_hom.coe_comp F inr) _x)
                                          (function.comp_app (⇑F) (⇑inr) _x))))
                                    (monoid_hom.comp F inl) (monoid_hom.comp F inl) (Eq.refl (monoid_hom.comp F inl)))
                                  x x (Eq.refl x))
                                (congr_fun
                                  (monoid_hom.coe_comp
                                    (mul_equiv.to_monoid_hom (coe_fn mul_aut.conj (coe_fn F (coe_fn inr _x))))
                                    (monoid_hom.comp F inl))
                                  x))
                              ((fun (f f_1 : H → H) (e_1 : f = f_1) (g g_1 : N → H) (e_2 : g = g_1) (ᾰ ᾰ_1 : N)
                                  (e_3 : ᾰ = ᾰ_1) => congr (congr (congr_arg function.comp e_1) e_2) e_3)
                                (⇑(mul_equiv.to_monoid_hom (coe_fn mul_aut.conj (coe_fn F (coe_fn inr _x)))))
                                (⇑(coe_fn mul_aut.conj (coe_fn F (coe_fn inr _x))))
                                (mul_equiv.coe_to_monoid_hom (coe_fn mul_aut.conj (coe_fn F (coe_fn inr _x))))
                                (⇑(monoid_hom.comp F inl)) (⇑F ∘ ⇑inl) (monoid_hom.coe_comp F inl) x x (Eq.refl x)))
                            (function.comp_app (⇑(coe_fn mul_aut.conj (coe_fn F (coe_fn inr _x)))) (⇑F ∘ ⇑inl) x))
                          ((fun (x x_1 : H ≃* H) (e_1 : x = x_1) (ᾰ ᾰ_1 : H) (e_2 : ᾰ = ᾰ_1) =>
                              congr (congr_arg coe_fn e_1) e_2)
                            (coe_fn mul_aut.conj (coe_fn F (coe_fn inr _x)))
                            (coe_fn mul_aut.conj (coe_fn F (coe_fn inr _x)))
                            (Eq.refl (coe_fn mul_aut.conj (coe_fn F (coe_fn inr _x)))) (function.comp (⇑F) (⇑inl) x)
                            (coe_fn F (coe_fn inl x)) (function.comp_app (⇑F) (⇑inl) x)))
                        (mul_aut.conj_apply (coe_fn F (coe_fn inr _x)) (coe_fn F (coe_fn inl x)))))
                    (propext (mul_left_inj (coe_fn F (coe_fn inr _x)⁻¹))))
                  (propext (mul_left_inj (coe_fn F (coe_fn inl x)))))
                (propext (eq_self_iff_true (coe_fn F (coe_fn inr _x))))))
            trivial := sorry

/-- Two maps out of the semidirect product are equal if they're equal after composition
  with both `inl` and `inr` -/
theorem hom_ext {N : Type u_1} {G : Type u_2} {H : Type u_3} [group N] [group G] [group H] {φ : G →* mul_aut N} {f : semidirect_product N G φ →* H} {g : semidirect_product N G φ →* H} (hl : monoid_hom.comp f inl = monoid_hom.comp g inl) (hr : monoid_hom.comp f inr = monoid_hom.comp g inr) : f = g := sorry

/-- Define a map from `N ⋊[φ] G` to `N₁ ⋊[φ₁] G₁` given maps `N →* N₁` and `G →* G₁` that
  satisfy a commutativity condition `∀ n g, f₁ (φ g n) = φ₁ (f₂ g) (f₁ n)`.  -/
def map {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} {N₁ : Type u_4} {G₁ : Type u_5} [group N₁] [group G₁] {φ₁ : G₁ →* mul_aut N₁} (f₁ : N →* N₁) (f₂ : G →* G₁) (h : ∀ (g : G),
  monoid_hom.comp f₁ (mul_equiv.to_monoid_hom (coe_fn φ g)) =
    monoid_hom.comp (mul_equiv.to_monoid_hom (coe_fn φ₁ (coe_fn f₂ g))) f₁) : semidirect_product N G φ →* semidirect_product N₁ G₁ φ₁ :=
  monoid_hom.mk (fun (x : semidirect_product N G φ) => mk (coe_fn f₁ (left x)) (coe_fn f₂ (right x))) sorry sorry

@[simp] theorem map_left {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} {N₁ : Type u_4} {G₁ : Type u_5} [group N₁] [group G₁] {φ₁ : G₁ →* mul_aut N₁} (f₁ : N →* N₁) (f₂ : G →* G₁) (h : ∀ (g : G),
  monoid_hom.comp f₁ (mul_equiv.to_monoid_hom (coe_fn φ g)) =
    monoid_hom.comp (mul_equiv.to_monoid_hom (coe_fn φ₁ (coe_fn f₂ g))) f₁) (g : semidirect_product N G φ) : left (coe_fn (map f₁ f₂ h) g) = coe_fn f₁ (left g) :=
  rfl

@[simp] theorem map_right {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} {N₁ : Type u_4} {G₁ : Type u_5} [group N₁] [group G₁] {φ₁ : G₁ →* mul_aut N₁} (f₁ : N →* N₁) (f₂ : G →* G₁) (h : ∀ (g : G),
  monoid_hom.comp f₁ (mul_equiv.to_monoid_hom (coe_fn φ g)) =
    monoid_hom.comp (mul_equiv.to_monoid_hom (coe_fn φ₁ (coe_fn f₂ g))) f₁) (g : semidirect_product N G φ) : right (coe_fn (map f₁ f₂ h) g) = coe_fn f₂ (right g) :=
  rfl

@[simp] theorem right_hom_comp_map {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} {N₁ : Type u_4} {G₁ : Type u_5} [group N₁] [group G₁] {φ₁ : G₁ →* mul_aut N₁} (f₁ : N →* N₁) (f₂ : G →* G₁) (h : ∀ (g : G),
  monoid_hom.comp f₁ (mul_equiv.to_monoid_hom (coe_fn φ g)) =
    monoid_hom.comp (mul_equiv.to_monoid_hom (coe_fn φ₁ (coe_fn f₂ g))) f₁) : monoid_hom.comp right_hom (map f₁ f₂ h) = monoid_hom.comp f₂ right_hom :=
  rfl

@[simp] theorem map_inl {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} {N₁ : Type u_4} {G₁ : Type u_5} [group N₁] [group G₁] {φ₁ : G₁ →* mul_aut N₁} (f₁ : N →* N₁) (f₂ : G →* G₁) (h : ∀ (g : G),
  monoid_hom.comp f₁ (mul_equiv.to_monoid_hom (coe_fn φ g)) =
    monoid_hom.comp (mul_equiv.to_monoid_hom (coe_fn φ₁ (coe_fn f₂ g))) f₁) (n : N) : coe_fn (map f₁ f₂ h) (coe_fn inl n) = coe_fn inl (coe_fn f₁ n) := sorry

@[simp] theorem map_comp_inl {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} {N₁ : Type u_4} {G₁ : Type u_5} [group N₁] [group G₁] {φ₁ : G₁ →* mul_aut N₁} (f₁ : N →* N₁) (f₂ : G →* G₁) (h : ∀ (g : G),
  monoid_hom.comp f₁ (mul_equiv.to_monoid_hom (coe_fn φ g)) =
    monoid_hom.comp (mul_equiv.to_monoid_hom (coe_fn φ₁ (coe_fn f₂ g))) f₁) : monoid_hom.comp (map f₁ f₂ h) inl = monoid_hom.comp inl f₁ := sorry

@[simp] theorem map_inr {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} {N₁ : Type u_4} {G₁ : Type u_5} [group N₁] [group G₁] {φ₁ : G₁ →* mul_aut N₁} (f₁ : N →* N₁) (f₂ : G →* G₁) (h : ∀ (g : G),
  monoid_hom.comp f₁ (mul_equiv.to_monoid_hom (coe_fn φ g)) =
    monoid_hom.comp (mul_equiv.to_monoid_hom (coe_fn φ₁ (coe_fn f₂ g))) f₁) (g : G) : coe_fn (map f₁ f₂ h) (coe_fn inr g) = coe_fn inr (coe_fn f₂ g) := sorry

@[simp] theorem map_comp_inr {N : Type u_1} {G : Type u_2} [group N] [group G] {φ : G →* mul_aut N} {N₁ : Type u_4} {G₁ : Type u_5} [group N₁] [group G₁] {φ₁ : G₁ →* mul_aut N₁} (f₁ : N →* N₁) (f₂ : G →* G₁) (h : ∀ (g : G),
  monoid_hom.comp f₁ (mul_equiv.to_monoid_hom (coe_fn φ g)) =
    monoid_hom.comp (mul_equiv.to_monoid_hom (coe_fn φ₁ (coe_fn f₂ g))) f₁) : monoid_hom.comp (map f₁ f₂ h) inr = monoid_hom.comp inr f₂ := sorry


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

import Mathlib.Tactic.Use
import Mathlib.Tactic.Basic

example : ∃ x : Nat, x = x := by use 42

example : ∃ x : Nat, ∃ y : Nat, x = y := by use 42, 42

example : ∃ x : String × String, x.1 = x.2 := by use ("a", "a")

example : ∃ x : Nat, x = x := by
  use ?_
  exact 42
  rfl

example (α : Type) : ∃ S : List α, S = S := by use ∅

example : ∃ x : Int, x = x := by use 42

example : ∃ a b c : Int, a + b + c = 6 := by
  use 1, 2, 3
  rfl

example : ∃ p : Int × Int, p.1 = 1 := by use ⟨1, 42⟩

example : ∃ n : Int, n * 3 = 3 * 2 := by
  use 2
  rfl

-- FIXME Failing tests ported from mathlib3

-- example : ∃ (n : Nat) (h : n > 0), n = n :=
-- by
--   use 1
--   -- goal should now be `1 > 0 ∧ 1 = 1`, whereas it would be `∃ (H : 1 > 0), 1 = 1` after existsi 1.
--   guard_target = 1 > 0 ∧ 1 = 1
--   exact ⟨Nat.zero_lt_one, rfl⟩

-- example : Σ x y : Int, (Int × Int) × Int :=
-- by use 1, 2, 3, 4, 5

-- inductive foo
-- | mk : Nat → Bool × Nat → Nat → foo

-- example : foo :=
-- by use 100, true, 4, 3


/-
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, Jeremy Avigad, Yury Kudryashov
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.order.filter.cofinite
import Mathlib.PostPort

universes u_1 l u v

namespace Mathlib

/-!
# Ultrafilters

An ultrafilter is a minimal (maximal in the set order) proper filter.
In this file we define

* `ultrafilter.of`: an ultrafilter that is less than or equal to a given filter;
* `ultrafilter`: subtype of ultrafilters;
* `ultrafilter.pure`: `pure x` as an `ultrafiler`;
* `ultrafilter.map`, `ultrafilter.bind`, `ultrafilter.comap` : operations on ultrafilters;
* `hyperfilter`: the ultrafilter extending the cofinite filter.
-/

/-- An ultrafilter is a minimal (maximal in the set order) proper filter. -/
structure ultrafilter (α : Type u_1) extends filter α where
  ne_bot' : filter.ne_bot _to_filter
  le_of_le : ∀ (g : filter α), filter.ne_bot g → g ≤ _to_filter → _to_filter ≤ g

namespace ultrafilter

protected instance filter.has_coe_t {α : Type u} : has_coe_t (ultrafilter α) (filter α) :=
  has_coe_t.mk ultrafilter.to_filter

protected instance has_mem {α : Type u} : has_mem (set α) (ultrafilter α) :=
  has_mem.mk fun (s : set α) (f : ultrafilter α) => s ∈ ↑f

theorem unique {α : Type u} (f : ultrafilter α) {g : filter α} (h : g ≤ ↑f)
    (hne :
      autoParam (filter.ne_bot g)
        (Lean.Syntax.ident Lean.SourceInfo.none (String.toSubstring "Mathlib.tactic.apply_instance")
          (Lean.Name.mkStr
            (Lean.Name.mkStr (Lean.Name.mkStr Lean.Name.anonymous "Mathlib") "tactic")
            "apply_instance")
          [])) :
    g = ↑f :=
  le_antisymm h (ultrafilter.le_of_le f g hne h)

protected instance ne_bot {α : Type u} (f : ultrafilter α) : filter.ne_bot ↑f :=
  ultrafilter.ne_bot' f

@[simp] theorem mem_coe {α : Type u} {f : ultrafilter α} {s : set α} : s ∈ ↑f ↔ s ∈ f := iff.rfl

theorem coe_injective {α : Type u} : function.injective coe := sorry

@[simp] theorem coe_le_coe {α : Type u} {f : ultrafilter α} {g : ultrafilter α} : ↑f ≤ ↑g ↔ f = g :=
  { mp := fun (h : ↑f ≤ ↑g) => coe_injective (unique g h), mpr := fun (h : f = g) => h ▸ le_rfl }

@[simp] theorem coe_inj {α : Type u} {f : ultrafilter α} {g : ultrafilter α} : ↑f = ↑g ↔ f = g :=
  function.injective.eq_iff coe_injective

theorem ext {α : Type u} {f : ultrafilter α} {g : ultrafilter α}
    (h : ∀ (s : set α), s ∈ f ↔ s ∈ g) : f = g :=
  coe_injective (filter.ext h)

theorem le_of_inf_ne_bot {α : Type u} (f : ultrafilter α) {g : filter α}
    (hg : filter.ne_bot (↑f ⊓ g)) : ↑f ≤ g :=
  le_of_inf_eq (unique f inf_le_left)

theorem le_of_inf_ne_bot' {α : Type u} (f : ultrafilter α) {g : filter α}
    (hg : filter.ne_bot (g ⊓ ↑f)) : ↑f ≤ g :=
  le_of_inf_ne_bot f (eq.mpr (id (Eq._oldrec (Eq.refl (filter.ne_bot (↑f ⊓ g))) inf_comm)) hg)

@[simp] theorem compl_not_mem_iff {α : Type u} {f : ultrafilter α} {s : set α} : ¬sᶜ ∈ f ↔ s ∈ f :=
  sorry

@[simp] theorem frequently_iff_eventually {α : Type u} {f : ultrafilter α} {p : α → Prop} :
    filter.frequently (fun (x : α) => p x) ↑f ↔ filter.eventually (fun (x : α) => p x) ↑f :=
  compl_not_mem_iff

theorem Mathlib.filter.frequently.eventually {α : Type u} {f : ultrafilter α} {p : α → Prop} :
    filter.frequently (fun (x : α) => p x) ↑f → filter.eventually (fun (x : α) => p x) ↑f :=
  iff.mp frequently_iff_eventually

theorem compl_mem_iff_not_mem {α : Type u} {f : ultrafilter α} {s : set α} : sᶜ ∈ f ↔ ¬s ∈ f :=
  eq.mpr (id (Eq._oldrec (Eq.refl (sᶜ ∈ f ↔ ¬s ∈ f)) (Eq.symm (propext compl_not_mem_iff))))
    (eq.mpr (id (Eq._oldrec (Eq.refl (¬sᶜᶜ ∈ f ↔ ¬s ∈ f)) (compl_compl s))) (iff.refl (¬s ∈ f)))

/-- If `sᶜ ∉ f ↔ s ∈ f`, then `f` is an ultrafilter. The other implication is given by
`ultrafilter.compl_not_mem_iff`.  -/
def of_compl_not_mem_iff {α : Type u} (f : filter α) (h : ∀ (s : set α), ¬sᶜ ∈ f ↔ s ∈ f) :
    ultrafilter α :=
  mk f sorry sorry

theorem nonempty_of_mem {α : Type u} {f : ultrafilter α} {s : set α} (hs : s ∈ f) :
    set.nonempty s :=
  filter.nonempty_of_mem_sets hs

theorem ne_empty_of_mem {α : Type u} {f : ultrafilter α} {s : set α} (hs : s ∈ f) : s ≠ ∅ :=
  set.nonempty.ne_empty (nonempty_of_mem hs)

@[simp] theorem empty_not_mem {α : Type u} {f : ultrafilter α} : ¬∅ ∈ f := filter.empty_nmem_sets ↑f

theorem mem_or_compl_mem {α : Type u} (f : ultrafilter α) (s : set α) : s ∈ f ∨ sᶜ ∈ f :=
  iff.mpr or_iff_not_imp_left (iff.mpr compl_mem_iff_not_mem)

protected theorem em {α : Type u} (f : ultrafilter α) (p : α → Prop) :
    filter.eventually (fun (x : α) => p x) ↑f ∨ filter.eventually (fun (x : α) => ¬p x) ↑f :=
  mem_or_compl_mem f (set_of fun (x : α) => p x)

theorem eventually_or {α : Type u} {f : ultrafilter α} {p : α → Prop} {q : α → Prop} :
    filter.eventually (fun (x : α) => p x ∨ q x) ↑f ↔
        filter.eventually (fun (x : α) => p x) ↑f ∨ filter.eventually (fun (x : α) => q x) ↑f :=
  sorry

theorem union_mem_iff {α : Type u} {f : ultrafilter α} {s : set α} {t : set α} :
    s ∪ t ∈ f ↔ s ∈ f ∨ t ∈ f :=
  eventually_or

theorem eventually_not {α : Type u} {f : ultrafilter α} {p : α → Prop} :
    filter.eventually (fun (x : α) => ¬p x) ↑f ↔ ¬filter.eventually (fun (x : α) => p x) ↑f :=
  compl_mem_iff_not_mem

theorem eventually_imp {α : Type u} {f : ultrafilter α} {p : α → Prop} {q : α → Prop} :
    filter.eventually (fun (x : α) => p x → q x) ↑f ↔
        filter.eventually (fun (x : α) => p x) ↑f → filter.eventually (fun (x : α) => q x) ↑f :=
  sorry

theorem finite_sUnion_mem_iff {α : Type u} {f : ultrafilter α} {s : set (set α)}
    (hs : set.finite s) : ⋃₀s ∈ f ↔ ∃ (t : set α), ∃ (H : t ∈ s), t ∈ f :=
  sorry

theorem finite_bUnion_mem_iff {α : Type u} {β : Type v} {f : ultrafilter α} {is : set β}
    {s : β → set α} (his : set.finite is) :
    (set.Union fun (i : β) => set.Union fun (H : i ∈ is) => s i) ∈ f ↔
        ∃ (i : β), ∃ (H : i ∈ is), s i ∈ f :=
  sorry

/-- Pushforward for ultrafilters. -/
def map {α : Type u} {β : Type v} (m : α → β) (f : ultrafilter α) : ultrafilter β :=
  of_compl_not_mem_iff (filter.map m ↑f) sorry

@[simp] theorem coe_map {α : Type u} {β : Type v} (m : α → β) (f : ultrafilter α) :
    ↑(map m f) = filter.map m ↑f :=
  rfl

@[simp] theorem mem_map {α : Type u} {β : Type v} {m : α → β} {f : ultrafilter α} {s : set β} :
    s ∈ map m f ↔ m ⁻¹' s ∈ f :=
  iff.rfl

/-- The pullback of an ultrafilter along an injection whose range is large with respect to the given
ultrafilter. -/
def comap {α : Type u} {β : Type v} {m : α → β} (u : ultrafilter β) (inj : function.injective m)
    (large : set.range m ∈ u) : ultrafilter α :=
  mk (filter.comap m ↑u) sorry sorry

/-- The principal ultrafilter associated to a point `x`. -/
protected instance has_pure : Pure ultrafilter :=
  { pure := fun (α : Type u_1) (a : α) => of_compl_not_mem_iff (pure a) sorry }

@[simp] theorem mem_pure_sets {α : Type u} {a : α} {s : set α} : s ∈ pure a ↔ a ∈ s := iff.rfl

protected instance inhabited {α : Type u} [Inhabited α] : Inhabited (ultrafilter α) :=
  { default := pure Inhabited.default }

/-- Monadic bind for ultrafilters, coming from the one on filters
defined in terms of map and join.-/
def bind {α : Type u} {β : Type v} (f : ultrafilter α) (m : α → ultrafilter β) : ultrafilter β :=
  of_compl_not_mem_iff (filter.bind ↑f fun (x : α) => ↑(m x)) sorry

protected instance ultrafilter.has_bind : Bind ultrafilter := { bind := bind }

protected instance ultrafilter.functor : Functor ultrafilter :=
  { map := map, mapConst := fun (α β : Type u_1) => map ∘ function.const β }

protected instance ultrafilter.monad : Monad ultrafilter := sorry

protected instance ultrafilter.is_lawful_monad : is_lawful_monad ultrafilter :=
  is_lawful_monad.mk
    (fun (α β : Type u_1) (a : α) (f : α → ultrafilter β) =>
      coe_injective (filter.pure_bind a (coe ∘ f)))
    fun (α β γ : Type u_1) (f : ultrafilter α) (m₁ : α → ultrafilter β) (m₂ : β → ultrafilter γ) =>
      coe_injective (filter.filter_eq rfl)

/-- The ultrafilter lemma: Any proper filter is contained in an ultrafilter. -/
theorem exists_le {α : Type u} (f : filter α) [h : filter.ne_bot f] :
    ∃ (u : ultrafilter α), ↑u ≤ f :=
  sorry

theorem Mathlib.filter.exists_ultrafilter_le {α : Type u} (f : filter α) [h : filter.ne_bot f] :
    ∃ (u : ultrafilter α), ↑u ≤ f :=
  exists_le

/-- Construct an ultrafilter extending a given filter.
  The ultrafilter lemma is the assertion that such a filter exists;
  we use the axiom of choice to pick one. -/
def of {α : Type u} (f : filter α) [filter.ne_bot f] : ultrafilter α := classical.some (exists_le f)

theorem of_le {α : Type u} (f : filter α) [filter.ne_bot f] : ↑(of f) ≤ f :=
  classical.some_spec (exists_le f)

theorem of_coe {α : Type u} (f : ultrafilter α) : of ↑f = f := iff.mp coe_inj (unique f (of_le ↑f))

theorem exists_ultrafilter_of_finite_inter_nonempty {α : Type u} (S : set (set α))
    (cond : ∀ (T : finset (set α)), ↑T ⊆ S → set.nonempty (⋂₀↑T)) :
    ∃ (F : ultrafilter α), S ⊆ filter.sets (ultrafilter.to_filter F) :=
  sorry

end ultrafilter

namespace filter

theorem mem_iff_ultrafilter {α : Type u} {s : set α} {f : filter α} :
    s ∈ f ↔ ∀ (g : ultrafilter α), ↑g ≤ f → s ∈ g :=
  sorry

theorem le_iff_ultrafilter {α : Type u} {f₁ : filter α} {f₂ : filter α} :
    f₁ ≤ f₂ ↔ ∀ (g : ultrafilter α), ↑g ≤ f₁ → ↑g ≤ f₂ :=
  sorry

/-- A filter equals the intersection of all the ultrafilters which contain it. -/
theorem supr_ultrafilter_le_eq {α : Type u} (f : filter α) :
    (supr fun (g : ultrafilter α) => supr fun (hg : ↑g ≤ f) => ↑g) = f :=
  sorry

/-- The `tendsto` relation can be checked on ultrafilters. -/
theorem tendsto_iff_ultrafilter {α : Type u} {β : Type v} (f : α → β) (l₁ : filter α)
    (l₂ : filter β) : tendsto f l₁ l₂ ↔ ∀ (g : ultrafilter α), ↑g ≤ l₁ → tendsto f (↑g) l₂ :=
  sorry

theorem exists_ultrafilter_iff {α : Type u} {f : filter α} :
    (∃ (u : ultrafilter α), ↑u ≤ f) ↔ ne_bot f :=
  sorry

theorem forall_ne_bot_le_iff {α : Type u} {g : filter α} {p : filter α → Prop} (hp : monotone p) :
    (∀ (f : filter α), ne_bot f → f ≤ g → p f) ↔ ∀ (f : ultrafilter α), ↑f ≤ g → p ↑f :=
  sorry

/-- The ultrafilter extending the cofinite filter. -/
def hyperfilter (α : Type u) [infinite α] : ultrafilter α := ultrafilter.of cofinite

theorem hyperfilter_le_cofinite {α : Type u} [infinite α] : ↑(hyperfilter α) ≤ cofinite :=
  ultrafilter.of_le cofinite

@[simp] theorem bot_ne_hyperfilter {α : Type u} [infinite α] : ⊥ ≠ ↑(hyperfilter α) :=
  ne.symm ((fun (this : ne_bot ↑(hyperfilter α)) => this) (ultrafilter.ne_bot (hyperfilter α)))

theorem nmem_hyperfilter_of_finite {α : Type u} [infinite α] {s : set α} (hf : set.finite s) :
    ¬s ∈ hyperfilter α :=
  fun (hy : s ∈ hyperfilter α) =>
    compl_not_mem_sets hy (hyperfilter_le_cofinite (set.finite.compl_mem_cofinite hf))

theorem Mathlib.set.finite.nmem_hyperfilter {α : Type u} [infinite α] {s : set α}
    (hf : set.finite s) : ¬s ∈ hyperfilter α :=
  nmem_hyperfilter_of_finite

theorem compl_mem_hyperfilter_of_finite {α : Type u} [infinite α] {s : set α} (hf : set.finite s) :
    sᶜ ∈ hyperfilter α :=
  iff.mpr ultrafilter.compl_mem_iff_not_mem (set.finite.nmem_hyperfilter hf)

theorem Mathlib.set.finite.compl_mem_hyperfilter {α : Type u} [infinite α] {s : set α}
    (hf : set.finite s) : sᶜ ∈ hyperfilter α :=
  compl_mem_hyperfilter_of_finite

theorem mem_hyperfilter_of_finite_compl {α : Type u} [infinite α] {s : set α}
    (hf : set.finite (sᶜ)) : s ∈ hyperfilter α :=
  compl_compl s ▸ set.finite.compl_mem_hyperfilter hf

end Mathlib


/-
Copyright (c) 2020 Markus Himmel. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Markus Himmel
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.category_theory.abelian.exact
import Mathlib.category_theory.over
import Mathlib.PostPort

universes v u

namespace Mathlib

/-!
# Pseudoelements in abelian categories

A *pseudoelement* of an object `X` in an abelian category `C` is an equivalence class of arrows
ending in `X`, where two arrows are considered equivalent if we can find two epimorphisms with a
common domain making a commutative square with the two arrows. While the construction shows that
pseudoelements are actually subobjects of `X` rather than "elements", it is possible to chase these
pseudoelements through commutative diagrams in an abelian category to prove exactness properties.
This is done using some "diagram-chasing metatheorems" proved in this file. In many cases, a proof
in the category of abelian groups can more or less directly be converted into a proof using
pseudoelements.

A classic application of pseudoelements are diagram lemmas like the four lemma or the snake lemma.

Pseudoelements are in some ways weaker than actual elements in a concrete category. The most
important limitation is that there is no extensionality principle: If `f g : X ⟶ Y`, then
`∀ x ∈ X, f x = g x` does not necessarily imply that `f = g` (however, if `f = 0` or `g = 0`,
it does). A corollary of this is that we can not define arrows in abelian categories by dictating
their action on pseudoelements. Thus, a usual style of proofs in abelian categories is this:
First, we construct some morphism using universal properties, and then we use diagram chasing
of pseudoelements to verify that is has some desirable property such as exactness.

It should be noted that the Freyd-Mitchell embedding theorem gives a vastly stronger notion of
pseudoelement (in particular one that gives extensionality). However, this theorem is quite
difficult to prove and probably out of reach for a formal proof for the time being.

## Main results

We define the type of pseudoelements of an object and, in particular, the zero pseudoelement.

We prove that every morphism maps the zero pseudoelement to the zero pseudoelement (`apply_zero`)
and that a zero morphism maps every pseudoelement to the zero pseudoelement (`zero_apply`)

Here are the metatheorems we provide:
* A morphism `f` is zero if and only if it is the zero function on pseudoelements.
* A morphism `f` is an epimorphism if and only if it is surjective on pseudoelements.
* A morphism `f` is a monomorphism if and only if it is injective on pseudoelements
  if and only if `∀ a, f a = 0 → f = 0`.
* A sequence `f, g` of morphisms is exact if and only if
  `∀ a, g (f a) = 0` and `∀ b, g b = 0 → ∃ a, f a = b`.
* If `f` is a morphism and `a, a'` are such that `f a = f a'`, then there is some
  pseudoelement `a''` such that `f a'' = 0` and for every `g` we have
  `g a' = 0 → g a = g a''`. We can think of `a''` as `a - a'`, but don't get too carried away
  by that: pseudoelements of an object do not form an abelian group.

## Notations

We introduce coercions from an object of an abelian category to the set of its pseudoelements
and from a morphism to the function it induces on pseudoelements.

These coercions must be explicitly enabled via local instances:
`local attribute [instance] object_to_sort hom_to_fun`

## Implementation notes

It appears that sometimes the coercion from morphisms to functions does not work, i.e.,
writing `g a` raises a "function expected" error. This error can be fixed by writing
`(g : X ⟶ Y) a`.

## References

* [F. Borceux, *Handbook of Categorical Algebra 2*][borceux-vol2]
-/

namespace category_theory.abelian

/-- This is just composition of morphisms in `C`. Another way to express this would be
    `(over.map f).obj a`, but our definition has nicer definitional properties. -/
def app {C : Type u} [category C] {P : C} {Q : C} (f : P ⟶ Q) (a : over P) : over Q :=
  ↑(comma.hom a ≫ f)

@[simp] theorem app_hom {C : Type u} [category C] {P : C} {Q : C} (f : P ⟶ Q) (a : over P) :
    comma.hom (app f a) = comma.hom a ≫ f :=
  rfl

/-- Two arrows `f : X ⟶ P` and `g : Y ⟶ P are called pseudo-equal if there is some object
    `R` and epimorphisms `p : R ⟶ X` and `q : R ⟶ Y` such that `p ≫ f = q ≫ g`. -/
def pseudo_equal {C : Type u} [category C] (P : C) (f : over P) (g : over P) :=
  ∃ (R : C),
    ∃ (p : R ⟶ comma.left f),
      ∃ (q : R ⟶ comma.left g), Exists (Exists (p ≫ comma.hom f = q ≫ comma.hom g))

theorem pseudo_equal_refl {C : Type u} [category C] {P : C} : reflexive (pseudo_equal P) := sorry

theorem pseudo_equal_symm {C : Type u} [category C] {P : C} : symmetric (pseudo_equal P) := sorry

/-- Pseudoequality is transitive: Just take the pullback. The pullback morphisms will
    be epimorphisms since in an abelian category, pullbacks of epimorphisms are epimorphisms. -/
theorem pseudo_equal_trans {C : Type u} [category C] [abelian C] {P : C} :
    transitive (pseudo_equal P) :=
  sorry

/-- The arrows with codomain `P` equipped with the equivalence relation of being pseudo-equal. -/
def pseudoelement.setoid {C : Type u} [category C] [abelian C] (P : C) : setoid (over P) :=
  setoid.mk (pseudo_equal P) sorry

/-- A `pseudoelement` of `P` is just an equivalence class of arrows ending in `P` by being
    pseudo-equal. -/
def pseudoelement {C : Type u} [category C] [abelian C] (P : C) := quotient sorry

namespace pseudoelement

/-- A coercion from an object of an abelian category to its pseudoelements. -/
def object_to_sort {C : Type u} [category C] [abelian C] : has_coe_to_sort C :=
  has_coe_to_sort.mk (Type (max u v)) fun (P : C) => pseudoelement P

/-- A coercion from an arrow with codomain `P` to its associated pseudoelement. -/
def over_to_sort {C : Type u} [category C] [abelian C] {P : C} :
    has_coe (over P) (pseudoelement P) :=
  has_coe.mk (Quot.mk (pseudo_equal P))

theorem over_coe_def {C : Type u} [category C] [abelian C] {P : C} {Q : C} (a : Q ⟶ P) :
    ↑a = quotient.mk ↑a :=
  rfl

/-- If two elements are pseudo-equal, then their composition with a morphism is, too. -/
theorem pseudo_apply_aux {C : Type u} [category C] [abelian C] {P : C} {Q : C} (f : P ⟶ Q)
    (a : over P) (b : over P) : a ≈ b → app f a ≈ app f b :=
  sorry

/-- A morphism `f` induces a function `pseudo_apply f` on pseudoelements. -/
def pseudo_apply {C : Type u} [category C] [abelian C] {P : C} {Q : C} (f : P ⟶ Q) : ↥P → ↥Q :=
  quotient.map (fun (g : over P) => app f g) (pseudo_apply_aux f)

/-- A coercion from morphisms to functions on pseudoelements -/
def hom_to_fun {C : Type u} [category C] [abelian C] {P : C} {Q : C} : has_coe_to_fun (P ⟶ Q) :=
  has_coe_to_fun.mk (fun (x : P ⟶ Q) => ↥P → ↥Q) pseudo_apply

theorem pseudo_apply_mk {C : Type u} [category C] [abelian C] {P : C} {Q : C} (f : P ⟶ Q)
    (a : over P) : coe_fn f (quotient.mk a) = quotient.mk ↑(comma.hom a ≫ f) :=
  rfl

/-- Applying a pseudoelement to a composition of morphisms is the same as composing
    with each morphism. Sadly, this is not a definitional equality, but at least it is
    true. -/
theorem comp_apply {C : Type u} [category C] [abelian C] {P : C} {Q : C} {R : C} (f : P ⟶ Q)
    (g : Q ⟶ R) (a : ↥P) : coe_fn (f ≫ g) a = coe_fn g (coe_fn f a) :=
  sorry

/-- Composition of functions on pseudoelements is composition of morphisms. -/
theorem comp_comp {C : Type u} [category C] [abelian C] {P : C} {Q : C} {R : C} (f : P ⟶ Q)
    (g : Q ⟶ R) : ⇑g ∘ ⇑f = ⇑(f ≫ g) :=
  funext fun (x : ↥P) => Eq.symm (comp_apply f g x)

/-!
In this section we prove that for every `P` there is an equivalence class that contains
precisely all the zero morphisms ending in `P` and use this to define *the* zero
pseudoelement.
-/

/-- The arrows pseudo-equal to a zero morphism are precisely the zero morphisms -/
theorem pseudo_zero_aux {C : Type u} [category C] [abelian C] {P : C} (Q : C) (f : over P) :
    f ≈ ↑0 ↔ comma.hom f = 0 :=
  sorry

theorem zero_eq_zero' {C : Type u} [category C] [abelian C] {P : C} {Q : C} {R : C} :
    quotient.mk ↑0 = quotient.mk ↑0 :=
  quotient.sound (iff.mpr (pseudo_zero_aux R ↑0) rfl)

/-- The zero pseudoelement is the class of a zero morphism -/
def pseudo_zero {C : Type u} [category C] [abelian C] {P : C} : ↥P := quotient.mk ↑0

protected instance has_zero {C : Type u} [category C] [abelian C] {P : C} : HasZero ↥P :=
  { zero := pseudo_zero }

protected instance inhabited {C : Type u} [category C] [abelian C] {P : C} :
    Inhabited (pseudoelement P) :=
  { default := 0 }

theorem pseudo_zero_def {C : Type u} [category C] [abelian C] {P : C} : 0 = quotient.mk ↑0 := rfl

@[simp] theorem zero_eq_zero {C : Type u} [category C] [abelian C] {P : C} {Q : C} :
    quotient.mk ↑0 = 0 :=
  zero_eq_zero'

/-- The pseudoelement induced by an arrow is zero precisely when that arrow is zero -/
theorem pseudo_zero_iff {C : Type u} [category C] [abelian C] {P : C} (a : over P) :
    ↑a = 0 ↔ comma.hom a = 0 :=
  eq.mpr
    (id (Eq._oldrec (Eq.refl (↑a = 0 ↔ comma.hom a = 0)) (Eq.symm (propext (pseudo_zero_aux P a)))))
    quotient.eq

/-- Morphisms map the zero pseudoelement to the zero pseudoelement -/
@[simp] theorem apply_zero {C : Type u} [category C] [abelian C] {P : C} {Q : C} (f : P ⟶ Q) :
    coe_fn f 0 = 0 :=
  sorry

/-- The zero morphism maps every pseudoelement to 0. -/
@[simp] theorem zero_apply {C : Type u} [category C] [abelian C] {P : C} (Q : C) (a : ↥P) :
    coe_fn 0 a = 0 :=
  sorry

/-- An extensionality lemma for being the zero arrow. -/
theorem zero_morphism_ext {C : Type u} [category C] [abelian C] {P : C} {Q : C} (f : P ⟶ Q) :
    (∀ (a : ↥P), coe_fn f a = 0) → f = 0 :=
  fun (h : ∀ (a : ↥P), coe_fn f a = 0) =>
    eq.mpr (id (Eq._oldrec (Eq.refl (f = 0)) (Eq.symm (category.id_comp f))))
      (iff.mp (pseudo_zero_iff ↑(𝟙 ≫ f)) (h ↑𝟙))

theorem zero_morphism_ext' {C : Type u} [category C] [abelian C] {P : C} {Q : C} (f : P ⟶ Q) :
    (∀ (a : ↥P), coe_fn f a = 0) → 0 = f :=
  Eq.symm ∘ zero_morphism_ext f

theorem eq_zero_iff {C : Type u} [category C] [abelian C] {P : C} {Q : C} (f : P ⟶ Q) :
    f = 0 ↔ ∀ (a : ↥P), coe_fn f a = 0 :=
  sorry

/-- A monomorphism is injective on pseudoelements. -/
theorem pseudo_injective_of_mono {C : Type u} [category C] [abelian C] {P : C} {Q : C} (f : P ⟶ Q)
    [mono f] : function.injective ⇑f :=
  sorry

/-- A morphism that is injective on pseudoelements only maps the zero element to zero. -/
theorem zero_of_map_zero {C : Type u} [category C] [abelian C] {P : C} {Q : C} (f : P ⟶ Q) :
    function.injective ⇑f → ∀ (a : ↥P), coe_fn f a = 0 → a = 0 :=
  fun (h : function.injective ⇑f) (a : ↥P) (ha : coe_fn f a = 0) =>
    h (eq.mp (Eq._oldrec (Eq.refl (coe_fn f a = 0)) (Eq.symm (apply_zero f))) ha)

/-- A morphism that only maps the zero pseudoelement to zero is a monomorphism. -/
theorem mono_of_zero_of_map_zero {C : Type u} [category C] [abelian C] {P : C} {Q : C} (f : P ⟶ Q) :
    (∀ (a : ↥P), coe_fn f a = 0 → a = 0) → mono f :=
  sorry

/-- An epimorphism is surjective on pseudoelements. -/
theorem pseudo_surjective_of_epi {C : Type u} [category C] [abelian C] {P : C} {Q : C} (f : P ⟶ Q)
    [epi f] : function.surjective ⇑f :=
  sorry

/-- A morphism that is surjective on pseudoelements is an epimorphism. -/
theorem epi_of_pseudo_surjective {C : Type u} [category C] [abelian C] {P : C} {Q : C} (f : P ⟶ Q) :
    function.surjective ⇑f → epi f :=
  sorry

/-- Two morphisms in an exact sequence are exact on pseudoelements. -/
theorem pseudo_exact_of_exact {C : Type u} [category C] [abelian C] {P : C} {Q : C} {R : C}
    {f : P ⟶ Q} {g : Q ⟶ R} [exact f g] :
    (∀ (a : ↥P), coe_fn g (coe_fn f a) = 0) ∧
        ∀ (b : ↥Q), coe_fn g b = 0 → ∃ (a : ↥P), coe_fn f a = b :=
  sorry

theorem apply_eq_zero_of_comp_eq_zero {C : Type u} [category C] [abelian C] {P : C} {Q : C} {R : C}
    (f : Q ⟶ R) (a : P ⟶ Q) : a ≫ f = 0 → coe_fn f ↑a = 0 :=
  sorry

/-- If two morphisms are exact on pseudoelements, they are exact. -/
theorem exact_of_pseudo_exact {C : Type u} [category C] [abelian C] {P : C} {Q : C} {R : C}
    (f : P ⟶ Q) (g : Q ⟶ R) :
    ((∀ (a : ↥P), coe_fn g (coe_fn f a) = 0) ∧
          ∀ (b : ↥Q), coe_fn g b = 0 → ∃ (a : ↥P), coe_fn f a = b) →
        exact f g :=
  sorry

/-- If two pseudoelements `x` and `y` have the same image under some morphism `f`, then we can form
    their "difference" `z`. This pseudoelement has the properties that `f z = 0` and for all
    morphisms `g`, if `g y = 0` then `g z = g x`. -/
theorem sub_of_eq_image {C : Type u} [category C] [abelian C] {P : C} {Q : C} (f : P ⟶ Q) (x : ↥P)
    (y : ↥P) :
    coe_fn f x = coe_fn f y →
        ∃ (z : ↥P),
          coe_fn f z = 0 ∧ ∀ (R : C) (g : P ⟶ R), coe_fn g y = 0 → coe_fn g z = coe_fn g x :=
  sorry

/-- If `f : P ⟶ R` and `g : Q ⟶ R` are morphisms and `p : P` and `q : Q` are pseudoelements such
    that `f p = g q`, then there is some `s : pullback f g` such that `fst s = p` and `snd s = q`.

    Remark: Borceux claims that `s` is unique. I was unable to transform his proof sketch into
    a pen-and-paper proof of this fact, so naturally I was not able to formalize the proof. -/
theorem pseudo_pullback {C : Type u} [category C] [abelian C] [limits.has_pullbacks C] {P : C}
    {Q : C} {R : C} {f : P ⟶ R} {g : Q ⟶ R} {p : ↥P} {q : ↥Q} :
    coe_fn f p = coe_fn g q →
        ∃ (s : ↥(limits.pullback f g)),
          coe_fn limits.pullback.fst s = p ∧ coe_fn limits.pullback.snd s = q :=
  sorry

end Mathlib


/-
Copyright (c) 2019 Koundinya Vajjha. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Koundinya Vajjha

A meta def called `#depends` which gives the names of all the theorems (the statement of) a given definition/theorem depends on.
-/

import data.pfun

open tactic expr interactive nat native name list lean.parser environment

/--Takes an expr and spits out a list of all the names in that expr -/
meta def list_names (e : expr): list name :=
e.fold [] (λ e _ es, if is_constant e then insert e.const_name es else es)

/-- Takes an environment and naively lists all declarations in it.-/
meta def list_all_decls (env : environment) : list name :=
env.fold [] $ (λ d ns, d.to_name :: ns)

/-- Takes an environment and lists all declarations in it, much faster. -/
meta def list_all_decls' (env : environment) : rb_set name :=
env.fold (mk_rb_set) $ (λ d ns, ns.insert d.to_name)

/-- Traces all declarations with prefix `namesp` in the current environment. -/
/-TODO : optimize using rb_set filters and maps(?)-/
meta def trace_all_decls (namesp : name) : tactic unit :=
do e ← get_env,
   let l := list_all_decls' e,
   let k := l.to_list,
   let m := list.map (λ h:name, h.get_prefix) k,
   let f := k.filter (λ h, is_prefix_of namesp h),
   tactic.trace $ take 150 f,
   skip

/- TODO : modify this to take structures into account -/
@[user_command] meta def depends_cmd (meta_info : decl_meta_info) ( _ : parse $ tk "#depends")
 : lean.parser unit
:= do given_name ← ident,
    resolved ← resolve_constant given_name,
    d ← get_decl resolved <|> fail ("declaration " ++ to_string given_name ++ " not found"),
    tactic.trace $ list_names d.type

/-- Return the direct dependencies of the *type* of a declaration. -/
meta def name_dir_deps (n : name) : tactic(list name) :=
do env ← get_env,
    l ← get_decl n,
    if is_structure env n then
    do fields ← returnopt $ structure_fields env n,
        let res := map (λ h, name.append n h) fields,
        k ← mmap (λ h, do l ← get_decl h, pure $ list_names l.type) res,
        let clean := list.erase_dup (list.join k),
        let final := list.filter (λ h, ¬ name.is_prefix_of n h) clean,
        pure $ final
    else
    pure $ list_names l.type

/-- Return the direct dependencies of the *value* of a declaration.-/
meta def name_dir_deps_val (n : name) : tactic(list name) :=
do env ← get_env,
    l ← get_decl n,
    if is_structure env n then
    do fields ← returnopt $ structure_fields env n,
        let res := map (λ h, name.append n h) fields,
        k ← mmap (λ h, do l ← get_decl h, pure $ list_names l.value) res,
        let clean := list.erase_dup (list.join k),
        let final := list.filter (λ h, ¬ name.is_prefix_of n h) clean,
        pure $ final
    else
    pure $ list_names l.value

/-- Recursively return a joint list of the m-th sub-dependencies of the type of given name.-/
meta def name_dir_deps_depth (n : name) : ℕ → tactic(list name)
| 0 := name_dir_deps n
| (succ m) :=
 do l ← name_dir_deps_depth m <|> name_dir_deps n,
    l' ← mmap (λ h, name_dir_deps h) l,
    let k := list.erase_dup $
    list.join (l :: l'),
    -- tactic.trace k.length,
    pure $ k

/-- Recursively return a joint list of the m-th sub-dependencies of the type of given name.-/
meta def name_dir_deps_depth_val (n : name) : ℕ → tactic(list name)
| 0 := name_dir_deps_val n
| (succ m) :=
 do l ← name_dir_deps_depth_val m <|> name_dir_deps_val n,
    l' ← mmap (λ h, name_dir_deps h) l,
    let k := list.erase_dup $
    list.join (l :: l'),
    -- tactic.trace k.length,
    pure $ k

theorem foo' : 2+2 = 4 :=
begin
  simp,
end

/- Tests -/
-- #depends nat.has_one
-- #depends group.equiv
-- #depends J4
-- #depends nat.add._main
-- #depends mclaughlin.McL
-- #depends sends_identity_to_1

-- set_option profiler true
-- run_cmd (name_dir_deps_depth_val `mathieu_group.Aut 10) >>= tactic.trace


import GMLInit.Data.Basic
import GMLInit.Data.Bool
import GMLInit.Data.Fin.Basic
import GMLInit.Data.Nat
import GMLInit.Logic.ListConnectives
import GMLInit.Meta.Basic

namespace List

instance {α} : (xs : List α) → Decidable (xs = [])
| [] => isTrue rfl
| _::_ => isFalse List.noConfusion

instance {α} : (xs : List α) → Decidable ([] = xs)
| [] => isTrue rfl
| _::_ => isFalse List.noConfusion

protected def ext'Aux {α} : (as₁ as₂ : List α) → List Prop
| [], [] => []
| [], _::_ => [False]
| _::_, [] => [False]
| a₁::as₁, a₂::as₂ => (a₁ = a₂) :: List.ext'Aux as₁ as₂

protected theorem ext' {α} : (as₁ as₂ : List α) → All (List.ext'Aux as₁ as₂) → as₁ = as₂
| [], [], _ => rfl
| [], _::_, All.cons h _ => False.elim h
| _::_₁, [], All.cons h _ => False.elim h
| _::as₁, _::as₂, All.cons h hs => h ▸ List.ext' as₁ as₂ hs ▸ rfl

protected theorem ext'Iff {α} (as₁ as₂ : List α) : All (List.ext'Aux as₁ as₂) ↔ as₁ = as₂ := by
  constr
  exact List.ext' as₁ as₂
  intro h
  cases h
  induction as₁ with
  | nil => exact All.nil
  | cons _ _ H => exact All.cons rfl H

protected theorem ext'Eq {α} (as₁ as₂ : List α) : All (List.ext'Aux as₁ as₂) = (as₁ = as₂) :=
  propext (List.ext'Iff as₁ as₂)

instance (x : α) (xs : List α) : Nat.IsPos (List.length (x :: xs)) := ⟨Nat.zero_lt_succ _⟩

lemma map_pure {α β} (f : α → β) (a : α) : [a].map f = [f a] := rfl

lemma map_comp {α β γ} (f : α → β) (g : β → γ) (as : List α) : as.map (g ∘ f) = (as.map f).map g := by
  symmetry
  exact map_map ..

@[simp] lemma pure_bind {α β} (f : α → List β) (a : α) : [a].bind f = f a := by rw [cons_bind, nil_bind, append_nil]

lemma bind_assoc {α β γ} (f : α → List β) (g : β → List γ) (as : List α) : (as.bind f).bind g = as.bind (λ a => (f a).bind g) := by
  induction as with
  | nil => rfl
  | cons a as H => rw [cons_bind, cons_bind, append_bind, H]

lemma all_eq_true_iff_all_true {α} (p : α → Bool) (xs : List α) : xs.all p = true ↔ All (xs.map λ x => p x = true) := by
  induction xs generalizing p with
  | nil => rw [all_nil, map_nil]; simp
  | cons x xs H => rw [all_cons, map_cons, All.cons_eq, ←H, Bool.and_eq_true_iff]

lemma all_eq_false_iff_any_false {α} (p : α → Bool) (xs : List α) : xs.all p = false ↔ Any (xs.map λ x => p x = false) := by
  induction xs generalizing p with
  | nil => rw [all_nil, map_nil]; simp
  | cons x xs H => rw [all_cons, map_cons, Any.cons_eq, ←H, Bool.and_eq_false_iff]

lemma any_eq_true_iff_any_true {α} (p : α → Bool) (xs : List α) : xs.any p = true ↔ Any (xs.map λ x => p x = true) := by
  induction xs generalizing p with
  | nil => rw [any_nil, map_nil, Any.nil_eq]; simp
  | cons x xs H => rw [any_cons, map_cons, Any.cons_eq, ←H, Bool.or_eq_true_iff]

lemma any_eq_false_iff_all_false {α} (p : α → Bool) (xs : List α) : xs.any p = false ↔ All (xs.map λ x => p x = false) := by
  induction xs generalizing p with
  | nil => rw [any_nil, map_nil, All.nil_eq]; simp
  | cons x xs H => rw [any_cons, map_cons, All.cons_eq, ←H, Bool.or_eq_false_iff]

/- take -/

theorem take_nil {α} (n : Nat) : take n [] = ([] : List α) := by cases n <;> rfl

theorem take_cons {α} (a : α) (as : List α) (n : Nat) : take (n+1) (a :: as) = a :: take n as := rfl

theorem take_zero {α} (as : List α) : take 0 as = [] := rfl

theorem take_all {α} (as : List α) : take as.length as = as := by
  induction as with
  | nil => rfl
  | cons a as ih =>
    rw [length_cons]
    rw [take_cons]
    rw [ih]

/- drop -/

theorem drop_cons {α} (a : α) (as : List α) (n : Nat) : drop (n+1) (a :: as) = drop n as := rfl

theorem drop_zero {α} (as : List α) : drop 0 as = as := rfl

theorem drop_all {α} (as : List α) : as.drop as.length = [] := by
  induction as with
  | nil =>
    rw [drop_nil]
  | cons a as ih =>
    rw [length_cons]
    rw [drop_cons]
    rw [ih]

theorem drop_get {α} (as : List α) (n : Nat) (hn : n < as.length) : drop n as = as[n] :: drop (n+1) as := by
  induction as generalizing n with
  | nil => absurd hn; exact Nat.not_lt_zero n
  | cons a as ih =>
    match n with
    | 0 =>
      rw [drop_cons]
      rw [drop]
      rw [getElem_eq_get]
      rw [get_cons_zero]
      rw [drop]
    | n+1 =>
      rw [drop_cons]
      rw [drop_cons]
      rw [getElem_eq_get]
      rw [get_cons_succ]
      rw [←getElem_eq_get]
      exact ih ..

/- extract -/

def extract (as : List α) (start stop : Nat) := (as.drop start).take (stop - start)

theorem extract_stop (as : List α) (stop : Nat) : as.extract stop stop = [] := by
  unfold extract
  rw [Nat.sub_self]
  rw [take_zero]

theorem extract_step (as : List α) (start stop : Nat) (hstart : start < stop) (hstop : stop ≤ as.length) :
  as.extract start stop = as.get ⟨start, Nat.lt_of_lt_of_le hstart hstop⟩ :: as.extract (start+1) stop := by
  unfold extract
  induction start, stop using Nat.recDiag generalizing as with
  | zero_zero => contradiction
  | succ_zero start => contradiction
  | zero_succ stop => match as with | a :: as => simp
  | succ_succ start stop ih =>
    match as with
    | a :: as =>
      simp
      rw [ih]
      exact Nat.lt_of_succ_lt_succ hstart
      exact Nat.le_of_succ_le_succ hstop

theorem extract_all (as : List α) : as.extract 0 as.length = as := by
  unfold extract
  rw [Nat.sub_zero]
  rw [List.drop]
  rw [List.take_all]

/- replicate -/

theorem replicate_zero {α} (a : α) : replicate 0 a = [] := rfl

theorem replicate_add {α} (a : α) : (m n : Nat) → replicate n a ++ replicate m a = replicate (m + n) a
| _, 0 => rfl
| _, _+1 => congrArg (a :: .) (replicate_add ..)

/- dropLast -/

theorem length_dropLast (as : List α) : as.dropLast.length = as.length - 1 := by
  cases as <;> simp

private theorem get_dropLast.aux {as : List α} {i : Nat} : i < as.dropLast.length → i < as.length :=
  fun h => Nat.lt_of_lt_of_le h (length_dropLast as ▸ Nat.pred_le as.length)

theorem get_dropLast (as : List α) (i : Fin as.dropLast.length) :
  as.dropLast.get i = as.get ⟨i.val, get_dropLast.aux i.isLt⟩ := by
  induction as with
  | nil => exact nomatch i
  | cons a as ih =>
    match as, i with
    | [], i => exact nomatch i
    | _ :: _, ⟨0, _⟩ => simp [dropLast]
    | _ :: _, ⟨i+1, hi⟩ => simp [dropLast, ih]

/- all/any -/

@[specialize] def allTR : List α → (α → Bool) → Bool
| [], _ => true
| x :: xs, p => p x && allTR xs p

@[csimp] theorem all_eq_allTR : @List.all = @List.allTR := by
  funext α xs p
  induction xs with
  | nil => rfl
  | cons _ _ ih => exact congrArg _ ih

@[specialize] def anyTR : List α → (α → Bool) → Bool
| [], _ => false
| x :: xs, p => p x || anyTR xs p

@[csimp] theorem any_eq_anyTR : @List.any = @List.anyTR := by
  funext α xs p
  induction xs with
  | nil => rfl
  | cons _ _ ih => exact congrArg _ ih

theorem not_all_eq_any_not (p : α → Bool) (as : List α) : (!as.all p) = as.any fun a => !p a := by
  induction as with
  | nil => rfl
  | cons a as ih =>
    rw [all_cons]
    rw [any_cons]
    rw [Bool.not_and]
    rw [ih]

theorem not_any_eq_all_not (p : α → Bool) (as : List α) : (!as.any p) = as.all fun a => !p a := by
  induction as with
  | nil => rfl
  | cons a as ih =>
    rw [any_cons]
    rw [all_cons]
    rw [Bool.not_or]
    rw [ih]

theorem or_all_distrib_left (p : α → Bool) (q : Bool) (as : List α) : (q || as.all p) = as.all fun a => q || p a := by
  induction as with
  | nil =>
    rw [all_nil]
    rw [all_nil]
    rw [Bool.or_true]
  | cons a as ih =>
    rw [all_cons]
    rw [all_cons]
    rw [Bool.or_and_distrib_left]
    rw [ih]

theorem or_all_distrib_right (p : α → Bool) (q : Bool) (as : List α) : (as.all p || q) = as.all fun a => p a || q := by
  induction as with
  | nil =>
    rw [all_nil]
    rw [all_nil]
    rw [Bool.true_or]
  | cons a as ih =>
    rw [all_cons]
    rw [all_cons]
    rw [Bool.or_and_distrib_right]
    rw [ih]

theorem and_any_distrib_left (p : α → Bool) (q : Bool) (as : List α) : (q && as.any p) = as.any fun a => q && p a := by
  induction as with
  | nil =>
    rw [any_nil]
    rw [any_nil]
    rw [Bool.and_false]
  | cons a as ih =>
    rw [any_cons]
    rw [any_cons]
    rw [Bool.and_or_distrib_left]
    rw [ih]

theorem and_any_distrib_right (p : α → Bool) (q : Bool) (as : List α) : (as.any p && q) = as.any fun a => p a && q := by
  induction as with
  | nil =>
    rw [any_nil]
    rw [any_nil]
    rw [Bool.false_and]
  | cons a as ih =>
    rw [any_cons]
    rw [any_cons]
    rw [Bool.and_or_distrib_right]
    rw [ih]

/- ofFun -/

@[inline]
def ofFunTR {α n} (f : Fin n → α) : List α :=
  let rec loop : Fin (n+1) → List α → List α
  | ⟨0, _⟩, xs => xs
  | ⟨i+1, hi⟩, xs => loop ⟨i, Nat.lt_trans (Nat.lt_succ_self i) hi⟩ (f ⟨i, Nat.lt_of_succ_lt_succ hi⟩ :: xs)
  loop ⟨n, Nat.lt_succ_self n⟩ []

@[implemented_by List.ofFunTR]
protected def ofFun {α} : {n : Nat} → (f : Fin n → α) → List α
| 0, _ => []
| n+1, f => f ⟨0, Nat.zero_lt_succ n⟩ :: List.ofFun fun i => f i.succ

theorem ofFun_length {α n} (f : Fin n → α) : (List.ofFun f).length = n := by
  induction n with
  | zero => rfl
  | succ n ih =>
    unfold List.ofFun
    rw [List.length_cons]
    rw [ih]

theorem ofFun_get {α n} (f : Fin n → α) (i : Fin (List.ofFun f).length) : (List.ofFun f).get i = f (ofFun_length f ▸ i) := by
  induction n with
  | zero =>
    match i with
    | ⟨_,_⟩ => contradiction
  | succ n ih =>
    match i with
    | ⟨0, _⟩ =>
      transitivity (f ⟨0, Nat.zero_lt_succ n⟩)
      · simp only [List.ofFun]
        rfl
      · congr 1
        apply Fin.eq
        rw [Fin.val_ndrec]
    | ⟨i+1, hi⟩ =>
      simp only [List.ofFun, getElem]
      rw [List.get_cons_succ]
      rw [ih]
      congr 1
      apply Fin.eq
      simp only [Fin.succ, Fin.val_ndrec]

end List