/-
Copyright (c) 2020 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/

import category_theory.limits.preserves.shapes.equalizers
import category_theory.limits.shapes.reflexive
import category_theory.monad.coequalizer
import category_theory.monad.limits

/-!
# Monadicity theorems

We prove monadicity theorems which can establish a given functor is monadic. In particular, we
show three versions of Beck's monadicity theorem, and the reflexive (crude) monadicity theorem:

`G` is a monadic right adjoint if it has a right adjoint, and:

* `D` has, `G` preserves and reflects `G`-split coequalizers, see
  `category_theory.monad.monadic_of_has_preserves_reflects_G_split_coequalizers`
* `G` creates `G`-split coequalizers, see
  `category_theory.monad.monadic_of_creates_G_split_coequalizers`
  (The converse of this is also shown, see
   `category_theory.monad.creates_G_split_coequalizers_of_monadic`)
* `D` has and `G` preserves `G`-split coequalizers, and `G` reflects isomorphisms, see
  `category_theory.monad.monadic_of_has_preserves_G_split_coequalizers_of_reflects_isomorphisms`
* `D` has and `G` preserves reflexive coequalizers, and `G` reflects isomorphisms, see
  `category_theory.monad.monadic_of_has_preserves_reflexive_coequalizers_of_reflects_isomorphisms`

## Tags

Beck, monadicity, descent

## TODO

Dualise to show comonadicity theorems.
-/
universes v₁ v₂ u₁ u₂

namespace category_theory
namespace monad
open limits

noncomputable theory
-- Hide the implementation details in this namespace.
namespace monadicity_internal

section

-- We use these parameters and notations to simplify the statements of internal constructions
-- here.
parameters {C : Type u₁} {D : Type u₂}
parameters [category.{v₁} C] [category.{v₁} D]
parameters {G : D ⥤ C} [is_right_adjoint G]

-- An unfortunate consequence of the local notation is that it is only recognised if there is an
-- extra space after the reference.
local notation `F` := left_adjoint G
local notation `adj` := adjunction.of_right_adjoint G

/--
The "main pair" for an algebra `(A, α)` is the pair of morphisms `(F α, ε_FA)`. It is always a
reflexive pair, and will be used to construct the left adjoint to the comparison functor and show it
is an equivalence.
-/
instance main_pair_reflexive (A : adj .to_monad.algebra) :
  is_reflexive_pair (F .map A.a) (adj .counit.app (F .obj A.A)) :=
begin
  apply is_reflexive_pair.mk' (F .map (adj .unit.app _)) _ _,
  { rw [← F .map_comp, ← F .map_id],
    exact congr_arg (λ _, F .map _) A.unit },
  { rw adj .left_triangle_components,
    refl },
end

/--
The "main pair" for an algebra `(A, α)` is the pair of morphisms `(F α, ε_FA)`. It is always a
`G`-split pair, and will be used to construct the left adjoint to the comparison functor and show it
is an equivalence.
-/
instance main_pair_G_split (A : adj .to_monad.algebra) :
  G.is_split_pair (F .map A.a) (adj .counit.app (F .obj A.A)) :=
{ splittable := ⟨_, _, ⟨beck_split_coequalizer A⟩⟩ }

/-- The object function for the left adjoint to the comparison functor. -/
def comparison_left_adjoint_obj
  (A : adj .to_monad.algebra) [has_coequalizer (F .map A.a) (adj .counit.app _)] : D :=
coequalizer (F .map A.a) (adj .counit.app _)

/--
We have a bijection of homsets which will be used to construct the left adjoint to the comparison
functor.
-/
@[simps]
def comparison_left_adjoint_hom_equiv (A : adj .to_monad.algebra) (B : D)
  [has_coequalizer (F .map A.a) (adj .counit.app (F .obj A.A))] :
  (comparison_left_adjoint_obj A ⟶ B) ≃ (A ⟶ (comparison adj).obj B) :=
calc (comparison_left_adjoint_obj A ⟶ B) ≃ {f : F .obj A.A ⟶ B // _} :
        cofork.is_colimit.hom_iso (colimit.is_colimit _) B
     ... ≃ {g : A.A ⟶ G.obj B // G.map (F .map g) ≫ G.map (adj .counit.app B) = A.a ≫ g} :
      begin
        refine (adj .hom_equiv _ _).subtype_equiv _,
        intro f,
        rw [← (adj .hom_equiv _ _).injective.eq_iff, adjunction.hom_equiv_naturality_left,
            adj .hom_equiv_unit, adj .hom_equiv_unit, G.map_comp],
        dsimp,
        rw [adj .right_triangle_components_assoc, ← G.map_comp, F .map_comp, category.assoc,
            adj .counit_naturality, adj .left_triangle_components_assoc],
        apply eq_comm,
      end
     ... ≃ (A ⟶ (comparison adj).obj B) :
     { to_fun := λ g, { f := _, h' := g.prop },
       inv_fun := λ f, ⟨f.f, f.h⟩,
       left_inv := λ g, begin ext, refl end,
       right_inv := λ f, begin ext, refl end }

/--
Construct the adjunction to the comparison functor.
-/
def left_adjoint_comparison
  [∀ (A : adj .to_monad.algebra), has_coequalizer (F .map A.a) (adj .counit.app (F .obj A.A))] :
  adj .to_monad.algebra ⥤ D :=
begin
  refine @adjunction.left_adjoint_of_equiv _ _ _ _
              (comparison adj) (λ A, comparison_left_adjoint_obj A) (λ A B, _) _,
  { apply comparison_left_adjoint_hom_equiv },
  { intros A B B' g h,
    ext1,
    dsimp [comparison_left_adjoint_hom_equiv],
    rw [← adj .hom_equiv_naturality_right, category.assoc] },
end

/--
Provided we have the appropriate coequalizers, we have an adjunction to the comparison functor.
-/
@[simps counit]
def comparison_adjunction
  [∀ (A : adj .to_monad.algebra), has_coequalizer (F .map A.a) (adj .counit.app (F .obj A.A))] :
  left_adjoint_comparison ⊣ comparison adj :=
adjunction.adjunction_of_equiv_left _ _

lemma comparison_adjunction_unit_f_aux
  [∀ (A : adj .to_monad.algebra), has_coequalizer (F .map A.a) (adj .counit.app (F .obj A.A))]
  (A : adj .to_monad.algebra) :
  (comparison_adjunction.unit.app A).f =
    adj .hom_equiv A.A _ (coequalizer.π (F .map A.a) (adj .counit.app (F .obj A.A))) :=
congr_arg (adj .hom_equiv _ _) (category.comp_id _)

/--
This is a cofork which is helpful for establishing monadicity: the morphism from the Beck
coequalizer to this cofork is the unit for the adjunction on the comparison functor.
-/
@[simps X]
def unit_cofork (A : adj .to_monad.algebra)
  [has_coequalizer (F .map A.a) (adj .counit.app (F .obj A.A))] :
  cofork (G.map (F .map A.a)) (G.map (adj .counit.app (F .obj A.A))) :=
cofork.of_π (G.map (coequalizer.π (F .map A.a) (adj .counit.app (F .obj A.A))))
begin
  change _ = G.map _ ≫ _,
  rw [← G.map_comp, coequalizer.condition, G.map_comp],
end

@[simp] lemma unit_cofork_π (A : adj .to_monad.algebra)
  [has_coequalizer (F .map A.a) (adj .counit.app (F .obj A.A))] :
  (unit_cofork A).π = G.map (coequalizer.π (F .map A.a) (adj .counit.app (F .obj A.A))) := rfl

lemma comparison_adjunction_unit_f
  [∀ (A : adj .to_monad.algebra), has_coequalizer (F .map A.a) (adj .counit.app (F .obj A.A))]
  (A : adj .to_monad.algebra) :
  (comparison_adjunction.unit.app A).f =
    (beck_coequalizer A).desc (unit_cofork A) :=
begin
  apply limits.cofork.is_colimit.hom_ext (beck_coequalizer A),
  rw [cofork.is_colimit.π_desc],
  dsimp only [beck_cofork_π, unit_cofork_π],
  rw [comparison_adjunction_unit_f_aux, ← adj .hom_equiv_naturality_left A.a, coequalizer.condition,
      adj .hom_equiv_naturality_right, adj .hom_equiv_unit, category.assoc],
  apply adj .right_triangle_components_assoc,
end

/--
The cofork which describes the counit of the adjunction: the morphism from the coequalizer of
this pair to this morphism is the counit.
-/
@[simps]
def counit_cofork (B : D) :
  cofork (F .map (G.map (adj .counit.app B))) (adj .counit.app (F .obj (G.obj B))) :=
cofork.of_π (adj .counit.app B) (adj .counit_naturality _)

/-- The unit cofork is a colimit provided `G` preserves it.  -/
def unit_colimit_of_preserves_coequalizer
  (A : adj .to_monad.algebra) [has_coequalizer (F .map A.a) (adj .counit.app (F .obj A.A))]
  [preserves_colimit (parallel_pair (F .map A.a) (adj .counit.app (F .obj A.A))) G] :
  is_colimit (unit_cofork A) :=
is_colimit_of_has_coequalizer_of_preserves_colimit G _ _

/-- The counit cofork is a colimit provided `G` reflects it. -/
def counit_coequalizer_of_reflects_coequalizer (B : D)
  [reflects_colimit (parallel_pair
                          (F .map (G.map (adj .counit.app B)))
                          (adj .counit.app (F .obj (G.obj B)))) G] :
  is_colimit (counit_cofork B) :=
is_colimit_of_is_colimit_cofork_map G _ (beck_coequalizer ((comparison adj).obj B))

lemma comparison_adjunction_counit_app
  [∀ (A : adj .to_monad.algebra), has_coequalizer (F .map A.a) (adj .counit.app (F .obj A.A))]
  (B : D) :
  comparison_adjunction.counit.app B = colimit.desc _ (counit_cofork B) :=
begin
  apply coequalizer.hom_ext,
  change coequalizer.π _ _ ≫ coequalizer.desc ((adj .hom_equiv _ B).symm (𝟙 _)) _ =
         coequalizer.π _ _ ≫ coequalizer.desc _ _,
  simp,
end

end
end monadicity_internal

open category_theory.adjunction
open monadicity_internal
variables {C : Type u₁} {D : Type u₂}
variables [category.{v₁} C] [category.{v₁} D]
variables (G : D ⥤ C)

/--
If `G` is monadic, it creates colimits of `G`-split pairs. This is the "boring" direction of Beck's
monadicity theorem, the converse is given in `monadic_of_creates_G_split_coequalizers`.
-/
def creates_G_split_coequalizers_of_monadic [monadic_right_adjoint G] ⦃A B⦄ (f g : A ⟶ B)
  [G.is_split_pair f g] :
  creates_colimit (parallel_pair f g) G :=
begin
  apply monadic_creates_colimit_of_preserves_colimit _ _,
  apply_instance,
  { apply preserves_colimit_of_iso_diagram _ (diagram_iso_parallel_pair.{v₁} _).symm,
    dsimp,
    apply_instance },
  { apply preserves_colimit_of_iso_diagram _ (diagram_iso_parallel_pair.{v₁} _).symm,
    dsimp,
    apply_instance }
end

variables [is_right_adjoint G]

section beck_monadicity

/--
To show `G` is a monadic right adjoint, we can show it preserves and reflects `G`-split
coequalizers, and `C` has them.
-/
def monadic_of_has_preserves_reflects_G_split_coequalizers
  [∀ ⦃A B⦄ (f g : A ⟶ B) [G.is_split_pair f g], has_coequalizer f g]
  [∀ ⦃A B⦄ (f g : A ⟶ B) [G.is_split_pair f g], preserves_colimit (parallel_pair f g) G]
  [∀ ⦃A B⦄ (f g : A ⟶ B) [G.is_split_pair f g], reflects_colimit (parallel_pair f g) G] :
  monadic_right_adjoint G :=
begin
  let L : (adjunction.of_right_adjoint G).to_monad.algebra ⥤ D := left_adjoint_comparison,
  letI i : is_right_adjoint (comparison (of_right_adjoint G)) :=
    ⟨_, comparison_adjunction⟩,
  constructor,
  let : Π (X : (of_right_adjoint G).to_monad.algebra),
    is_iso ((of_right_adjoint (comparison (of_right_adjoint G))).unit.app X),
  { intro X,
    apply is_iso_of_reflects_iso _ (monad.forget (of_right_adjoint G).to_monad),
    { change is_iso (comparison_adjunction.unit.app X).f,
      rw comparison_adjunction_unit_f,
      change
        is_iso
          (is_colimit.cocone_point_unique_up_to_iso
            (beck_coequalizer X)
            (unit_colimit_of_preserves_coequalizer X)).hom,
      refine is_iso.of_iso (is_colimit.cocone_point_unique_up_to_iso _ _) } },
  let : Π (Y : D),
    is_iso ((of_right_adjoint (comparison (of_right_adjoint G))).counit.app Y),
  { intro Y,
    change is_iso (comparison_adjunction.counit.app Y),
    rw comparison_adjunction_counit_app,
    change is_iso (is_colimit.cocone_point_unique_up_to_iso _ _).hom,
    apply_instance,
    apply counit_coequalizer_of_reflects_coequalizer _,
    letI : G.is_split_pair
            ((left_adjoint G).map (G.map ((adjunction.of_right_adjoint G).counit.app Y)))
            ((adjunction.of_right_adjoint G).counit.app ((left_adjoint G).obj (G.obj Y))) :=
      monadicity_internal.main_pair_G_split ((comparison (adjunction.of_right_adjoint G)).obj Y),
    apply_instance },
  exactI adjunction.is_right_adjoint_to_is_equivalence,
end

/--
Beck's monadicity theorem. If `G` has a right adjoint and creates coequalizers of `G`-split pairs,
then it is monadic.
This is the converse of `creates_G_split_of_monadic`.
-/
def monadic_of_creates_G_split_coequalizers
  [∀ ⦃A B⦄ (f g : A ⟶ B) [G.is_split_pair f g], creates_colimit (parallel_pair f g) G] :
  monadic_right_adjoint G :=
begin
  letI : ∀ ⦃A B⦄ (f g : A ⟶ B) [G.is_split_pair f g], has_colimit (parallel_pair f g ⋙ G),
  { introsI A B f g i,
    apply has_colimit_of_iso (diagram_iso_parallel_pair.{v₁} _),
    change has_coequalizer (G.map f) (G.map g),
    apply_instance },
  apply monadic_of_has_preserves_reflects_G_split_coequalizers _,
  { apply_instance },
  { introsI A B f g i,
    apply has_colimit_of_created (parallel_pair f g) G },
  { introsI A B f g i,
    apply_instance },
  { introsI A B f g i,
    apply_instance }
end

/--
An alternate version of Beck's monadicity theorem. If `G` reflects isomorphisms, preserves
coequalizers of `G`-split pairs and `C` has coequalizers of `G`-split pairs, then it is monadic.
-/
def monadic_of_has_preserves_G_split_coequalizers_of_reflects_isomorphisms
  [reflects_isomorphisms G]
  [∀ ⦃A B⦄ (f g : A ⟶ B) [G.is_split_pair f g], has_coequalizer f g]
  [∀ ⦃A B⦄ (f g : A ⟶ B) [G.is_split_pair f g], preserves_colimit (parallel_pair f g) G] :
  monadic_right_adjoint G :=
begin
  apply monadic_of_has_preserves_reflects_G_split_coequalizers _,
  { apply_instance },
  { assumption },
  { assumption },
  { introsI A B f g i,
    apply reflects_colimit_of_reflects_isomorphisms },
end

end beck_monadicity

section reflexive_monadicity

variables [has_reflexive_coequalizers D] [reflects_isomorphisms G]
variables [∀ ⦃A B⦄ (f g : A ⟶ B) [is_reflexive_pair f g], preserves_colimit (parallel_pair f g) G]

/--
Reflexive (crude) monadicity theorem. If `G` has a right adjoint, `D` has and `G` preserves
reflexive coequalizers and `G` reflects isomorphisms, then `G` is monadic.
-/
def monadic_of_has_preserves_reflexive_coequalizers_of_reflects_isomorphisms :
  monadic_right_adjoint G :=
begin
  let L : (adjunction.of_right_adjoint G).to_monad.algebra ⥤ D := left_adjoint_comparison,
  letI i : is_right_adjoint (comparison (adjunction.of_right_adjoint G)) :=
    ⟨_, comparison_adjunction⟩,
  constructor,
  let : Π (X : (adjunction.of_right_adjoint G).to_monad.algebra),
    is_iso ((adjunction.of_right_adjoint (comparison (adjunction.of_right_adjoint G))).unit.app X),
  { intro X,
    apply is_iso_of_reflects_iso _ (monad.forget (adjunction.of_right_adjoint G).to_monad),
    { change is_iso (comparison_adjunction.unit.app X).f,
      rw comparison_adjunction_unit_f,
      change
        is_iso
          (is_colimit.cocone_point_unique_up_to_iso
            (beck_coequalizer X)
            (unit_colimit_of_preserves_coequalizer X)).hom,
      apply is_iso.of_iso (is_colimit.cocone_point_unique_up_to_iso _ _) } },
  let : Π (Y : D),
    is_iso ((of_right_adjoint (comparison (adjunction.of_right_adjoint G))).counit.app Y),
  { intro Y,
    change is_iso (comparison_adjunction.counit.app Y),
    rw comparison_adjunction_counit_app,
    change is_iso (is_colimit.cocone_point_unique_up_to_iso _ _).hom,
    apply_instance,
    apply counit_coequalizer_of_reflects_coequalizer _,
    apply reflects_colimit_of_reflects_isomorphisms },
  exactI adjunction.is_right_adjoint_to_is_equivalence,
end

end reflexive_monadicity

end monad

end category_theory


/-
Copyright (c) 2021 Bhavik Mehta. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Bhavik Mehta
-/
import category_theory.limits.shapes.pullbacks
import category_theory.limits.shapes.binary_products
import category_theory.limits.preserves.shapes.pullbacks

/-!
# Relating monomorphisms and epimorphisms to limits and colimits

If `F` preserves (resp. reflects) pullbacks, then it preserves (resp. reflects) monomorphisms.

## TODO

Dualise and apply to functor categories.

-/

universes v₁ v₂ u₁ u₂

namespace category_theory
open category limits

variables {C : Type u₁} {D : Type u₂} [category.{v₁} C] [category.{v₂} D]
variables (F : C ⥤ D)

/-- If `F` preserves pullbacks, then it preserves monomorphisms. -/
instance preserves_mono {X Y : C} (f : X ⟶ Y) [preserves_limit (cospan f f) F] [mono f] :
  mono (F.map f) :=
begin
  have := is_limit_pullback_cone_map_of_is_limit F _ (pullback_cone.is_limit_mk_id_id f),
  simp_rw [F.map_id] at this,
  apply pullback_cone.mono_of_is_limit_mk_id_id _ this,
end

/-- If `F` reflects pullbacks, then it reflects monomorphisms. -/
lemma reflects_mono {X Y : C} (f : X ⟶ Y) [reflects_limit (cospan f f) F] [mono (F.map f)] :
  mono f :=
begin
  have := pullback_cone.is_limit_mk_id_id (F.map f),
  simp_rw [←F.map_id] at this,
  apply pullback_cone.mono_of_is_limit_mk_id_id _ (is_limit_of_is_limit_pullback_cone_map F _ this),
end

end category_theory


/-
Copyright (c) 2022 Andrew Yang. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Authors: Andrew Yang
-/
import category_theory.limits.shapes.comm_sq
import category_theory.limits.shapes.strict_initial
import category_theory.limits.shapes.types
import topology.category.Top.limits
import category_theory.limits.functor_category

/-!

# Extensive categories

## Main definitions
- `category_theory.is_van_kampen_colimit`: A (colimit) cocone over a diagram `F : J ⥤ C` is van
  Kampen if for every cocone `c'` over the pullback of the diagram `F' : J ⥤ C'`,
  `c'` is colimiting iff `c'` is the pullback of `c`.
- `category_theory.finitary_extensive`: A category is (finitary) extensive if it has finite
  coproducts, and binary coproducts are van Kampen.

## Main Results
- `category_theory.has_strict_initial_objects_of_finitary_extensive`: The initial object
  in extensive categories is strict.
- `category_theory.finitary_extensive.mono_inr_of_is_colimit`: Coproduct injections are monic in
  extensive categories.
- `category_theory.binary_cofan.is_pullback_initial_to_of_is_van_kampen`: In extensive categories,
  sums are disjoint, i.e. the pullback of `X ⟶ X ⨿ Y` and `Y ⟶ X ⨿ Y` is the initial object.
- `category_theory.types.finitary_extensive`: The category of types is extensive.

## TODO

Show that the following are finitary extensive:
- the categories of sheaves over a site
- `Scheme`
- `AffineScheme` (`CommRingᵒᵖ`)

## References
- https://ncatlab.org/nlab/show/extensive+category
- [Carboni et al, Introduction to extensive and distributive categories][CARBONI1993145]

-/

open category_theory.limits

namespace category_theory

universes v' u' v u

variables {J : Type v'} [category.{u'} J] {C : Type u} [category.{v} C]

/-- A natural transformation is equifibered if every commutative square of the following form is
a pullback.
```
F(X) → F(Y)
 ↓      ↓
G(X) → G(Y)
```
-/
def nat_trans.equifibered {F G : J ⥤ C} (α : F ⟶ G) : Prop :=
∀ ⦃i j : J⦄ (f : i ⟶ j), is_pullback (F.map f) (α.app i) (α.app j) (G.map f)

lemma nat_trans.equifibered_of_is_iso {F G : J ⥤ C} (α : F ⟶ G) [is_iso α] : α.equifibered :=
λ _ _ f, is_pullback.of_vert_is_iso ⟨nat_trans.naturality _ f⟩

lemma nat_trans.equifibered.comp {F G H : J ⥤ C} {α : F ⟶ G} {β : G ⟶ H}
  (hα : α.equifibered) (hβ : β.equifibered) : (α ≫ β).equifibered :=
λ i j f, (hα f).paste_vert (hβ f)

/-- A (colimit) cocone over a diagram `F : J ⥤ C` is universal if it is stable under pullbacks. -/
def is_universal_colimit {F : J ⥤ C} (c : cocone F) : Prop :=
∀ ⦃F' : J ⥤ C⦄ (c' : cocone F') (α : F' ⟶ F) (f : c'.X ⟶ c.X)
  (h : α ≫ c.ι = c'.ι ≫ (functor.const J).map f) (hα : α.equifibered),
  (∀ j : J, is_pullback (c'.ι.app j) (α.app j) f (c.ι.app j)) → nonempty (is_colimit c')

/-- A (colimit) cocone over a diagram `F : J ⥤ C` is van Kampen if for every cocone `c'` over the
pullback of the diagram `F' : J ⥤ C'`, `c'` is colimiting iff `c'` is the pullback of `c`.

TODO: Show that this is iff the functor `C ⥤ Catᵒᵖ` sending `x` to `C/x` preserves it.
TODO: Show that this is iff the inclusion functor `C ⥤ Span(C)` preserves it.
-/
def is_van_kampen_colimit {F : J ⥤ C} (c : cocone F) : Prop :=
∀ ⦃F' : J ⥤ C⦄ (c' : cocone F') (α : F' ⟶ F) (f : c'.X ⟶ c.X)
  (h : α ≫ c.ι = c'.ι ≫ (functor.const J).map f) (hα : α.equifibered),
  nonempty (is_colimit c') ↔ ∀ j : J, is_pullback (c'.ι.app j) (α.app j) f (c.ι.app j)

lemma is_van_kampen_colimit.is_universal {F : J ⥤ C} {c : cocone F} (H : is_van_kampen_colimit c) :
  is_universal_colimit c :=
λ _ c' α f h hα, (H c' α f h hα).mpr

/-- A van Kampen colimit is a colimit. -/
noncomputable
def is_van_kampen_colimit.is_colimit {F : J ⥤ C} {c : cocone F} (h : is_van_kampen_colimit c) :
  is_colimit c :=
begin
  refine ((h c (𝟙 F) (𝟙 c.X : _) (by rw [functor.map_id, category.comp_id, category.id_comp])
    (nat_trans.equifibered_of_is_iso _)).mpr $ λ j, _).some,
  haveI : is_iso (𝟙 c.X) := infer_instance,
  exact is_pullback.of_vert_is_iso ⟨by erw [nat_trans.id_app, category.comp_id, category.id_comp]⟩,
end

lemma is_initial.is_van_kampen_colimit [has_strict_initial_objects C] {X : C} (h : is_initial X) :
  is_van_kampen_colimit (as_empty_cocone X) :=
begin
  intros F' c' α f hf hα,
  have : F' = functor.empty C := by apply functor.hext; rintro ⟨⟨⟩⟩,
  subst this,
  haveI := h.is_iso_to f,
  refine ⟨by rintro _ ⟨⟨⟩⟩, λ _,
    ⟨is_colimit.of_iso_colimit h (cocones.ext (as_iso f).symm $ by rintro ⟨⟨⟩⟩)⟩⟩
end

section extensive

variables {X Y : C}

/--
A category is (finitary) extensive if it has finite coproducts,
and binary coproducts are van Kampen.

TODO: Show that this is iff all finite coproducts are van Kampen. -/
class finitary_extensive (C : Type u) [category.{v} C] : Prop :=
[has_finite_coproducts : has_finite_coproducts C]
(van_kampen' : ∀ {X Y : C} (c : binary_cofan X Y), is_colimit c → is_van_kampen_colimit c)

attribute [priority 100, instance] finitary_extensive.has_finite_coproducts

lemma finitary_extensive.van_kampen [finitary_extensive C] {F : discrete walking_pair ⥤ C}
  (c : cocone F) (hc : is_colimit c) : is_van_kampen_colimit c :=
begin
  let X := F.obj ⟨walking_pair.left⟩, let Y := F.obj ⟨walking_pair.right⟩,
  have : F = pair X Y,
  { apply functor.hext, { rintros ⟨⟨⟩⟩; refl }, { rintros ⟨⟨⟩⟩ ⟨j⟩ ⟨⟨rfl : _ = j⟩⟩; simpa } },
  clear_value X Y, subst this,
  exact finitary_extensive.van_kampen' c hc
end

lemma map_pair_equifibered {F F' : discrete walking_pair ⥤ C} (α : F ⟶ F') : α.equifibered :=
begin
  rintros ⟨⟨⟩⟩ ⟨j⟩ ⟨⟨rfl : _ = j⟩⟩,
  all_goals { dsimp, simp only [discrete.functor_map_id],
    exact is_pullback.of_horiz_is_iso ⟨by simp only [category.comp_id, category.id_comp]⟩ }
end

lemma binary_cofan.is_van_kampen_iff (c : binary_cofan X Y) :
  is_van_kampen_colimit c ↔
  ∀ {X' Y' : C} (c' : binary_cofan X' Y') (αX : X' ⟶ X) (αY : Y' ⟶ Y)
    (f : c'.X ⟶ c.X) (hαX : αX ≫ c.inl = c'.inl ≫ f) (hαY : αY ≫ c.inr = c'.inr ≫ f),
    nonempty (is_colimit c') ↔ is_pullback c'.inl αX f c.inl ∧ is_pullback c'.inr αY f c.inr :=
begin
  split,
  { introv H hαX hαY,
    rw H c' (map_pair αX αY) f (by ext ⟨⟨⟩⟩; dsimp; assumption) (map_pair_equifibered _),
    split, { intro H, exact ⟨H _, H _⟩ }, { rintros H ⟨⟨⟩⟩, exacts [H.1, H.2] } },
  { introv H F' hα h,
    let X' := F'.obj ⟨walking_pair.left⟩, let Y' := F'.obj ⟨walking_pair.right⟩,
    have : F' = pair X' Y',
    { apply functor.hext, { rintros ⟨⟨⟩⟩; refl }, { rintros ⟨⟨⟩⟩ ⟨j⟩ ⟨⟨rfl : _ = j⟩⟩; simpa } },
    clear_value X' Y', subst this, change binary_cofan X' Y' at c',
    rw H c' _ _ _ (nat_trans.congr_app hα ⟨walking_pair.left⟩)
      (nat_trans.congr_app hα ⟨walking_pair.right⟩),
    split, { rintros H ⟨⟨⟩⟩, exacts [H.1, H.2] }, { intro H, exact ⟨H _, H _⟩ } }
end

lemma binary_cofan.is_van_kampen_mk {X Y : C} (c : binary_cofan X Y)
  (cofans : ∀ (X Y : C), binary_cofan X Y) (colimits : ∀ X Y, is_colimit (cofans X Y))
  (cones : ∀ {X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z), pullback_cone f g)
  (limits : ∀ {X Y Z : C} (f : X ⟶ Z) (g : Y ⟶ Z),  is_limit (cones f g))
  (h₁ : ∀ {X' Y' : C} (αX : X' ⟶ X) (αY : Y' ⟶ Y) (f : (cofans X' Y').X ⟶ c.X)
    (hαX : αX ≫ c.inl = (cofans X' Y').inl ≫ f) (hαY : αY ≫ c.inr = (cofans X' Y').inr ≫ f),
    is_pullback (cofans X' Y').inl αX f c.inl ∧ is_pullback (cofans X' Y').inr αY f c.inr)
  (h₂ : ∀ {Z : C} (f : Z ⟶ c.X),
    is_colimit (binary_cofan.mk (cones f c.inl).fst (cones f c.inr).fst)) :
  is_van_kampen_colimit c :=
begin
  rw binary_cofan.is_van_kampen_iff,
  introv hX hY,
  split,
  { rintros ⟨h⟩,
    let e := h.cocone_point_unique_up_to_iso (colimits _ _),
    obtain ⟨hl, hr⟩ := h₁ αX αY (e.inv ≫ f) (by simp [hX]) (by simp [hY]),
    split,
    { rw [← category.id_comp αX, ← iso.hom_inv_id_assoc e f],
      have : c'.inl ≫ e.hom = 𝟙 X' ≫ (cofans X' Y').inl := by { dsimp, simp },
      haveI : is_iso (𝟙 X') := infer_instance,
      exact (is_pullback.of_vert_is_iso ⟨this⟩).paste_vert hl },
    { rw [← category.id_comp αY, ← iso.hom_inv_id_assoc e f],
      have : c'.inr ≫ e.hom = 𝟙 Y' ≫ (cofans X' Y').inr := by { dsimp, simp },
      haveI : is_iso (𝟙 Y') := infer_instance,
      exact (is_pullback.of_vert_is_iso ⟨this⟩).paste_vert hr } },
  { rintro ⟨H₁, H₂⟩,
    refine ⟨is_colimit.of_iso_colimit _ $ (iso_binary_cofan_mk _).symm⟩,
    let e₁ : X' ≅ _ := H₁.is_limit.cone_point_unique_up_to_iso (limits _ _),
    let e₂ : Y' ≅ _ := H₂.is_limit.cone_point_unique_up_to_iso (limits _ _),
    have he₁ : c'.inl = e₁.hom ≫ (cones f c.inl).fst := by simp,
    have he₂ : c'.inr = e₂.hom ≫ (cones f c.inr).fst := by simp,
    rw [he₁, he₂],
    apply binary_cofan.is_colimit_comp_right_iso (binary_cofan.mk _ _),
    apply binary_cofan.is_colimit_comp_left_iso (binary_cofan.mk _ _),
    exact h₂ f }
end
.
lemma binary_cofan.mono_inr_of_is_van_kampen [has_initial C] {X Y : C} {c : binary_cofan X Y}
  (h : is_van_kampen_colimit c) : mono c.inr :=
begin
  refine pullback_cone.mono_of_is_limit_mk_id_id _ (is_pullback.is_limit _),
  refine (h (binary_cofan.mk (initial.to Y) (𝟙 Y))
    (map_pair (initial.to X) (𝟙 Y)) c.inr _ (map_pair_equifibered _)).mp ⟨_⟩ ⟨walking_pair.right⟩,
  { ext ⟨⟨⟩⟩; dsimp; simp },
  { exact ((binary_cofan.is_colimit_iff_is_iso_inr initial_is_initial _).mpr
      (by { dsimp, apply_instance })).some }
end

lemma finitary_extensive.mono_inr_of_is_colimit [finitary_extensive C]
  {c : binary_cofan X Y} (hc : is_colimit c) : mono c.inr :=
binary_cofan.mono_inr_of_is_van_kampen (finitary_extensive.van_kampen c hc)

lemma finitary_extensive.mono_inl_of_is_colimit [finitary_extensive C]
  {c : binary_cofan X Y} (hc : is_colimit c) : mono c.inl :=
finitary_extensive.mono_inr_of_is_colimit (binary_cofan.is_colimit_flip hc)

instance [finitary_extensive C] (X Y : C) : mono (coprod.inl : X ⟶ X ⨿ Y) :=
(finitary_extensive.mono_inl_of_is_colimit (coprod_is_coprod X Y) : _)

instance [finitary_extensive C] (X Y : C) : mono (coprod.inr : Y ⟶ X ⨿ Y) :=
(finitary_extensive.mono_inr_of_is_colimit (coprod_is_coprod X Y) : _)

lemma binary_cofan.is_pullback_initial_to_of_is_van_kampen [has_initial C]
  {c : binary_cofan X Y}
  (h : is_van_kampen_colimit c) : is_pullback (initial.to _) (initial.to _) c.inl c.inr :=
begin
  refine ((h (binary_cofan.mk (initial.to Y) (𝟙 Y)) (map_pair (initial.to X) (𝟙 Y)) c.inr _
    (map_pair_equifibered _)).mp ⟨_⟩ ⟨walking_pair.left⟩).flip,
  { ext ⟨⟨⟩⟩; dsimp; simp },
  { exact ((binary_cofan.is_colimit_iff_is_iso_inr initial_is_initial _).mpr
      (by { dsimp, apply_instance })).some }
end

lemma finitary_extensive.is_pullback_initial_to_binary_cofan [finitary_extensive C]
  {c : binary_cofan X Y} (hc : is_colimit c) :
  is_pullback (initial.to _) (initial.to _) c.inl c.inr :=
binary_cofan.is_pullback_initial_to_of_is_van_kampen (finitary_extensive.van_kampen c hc)

lemma has_strict_initial_of_is_universal [has_initial C]
  (H : is_universal_colimit (binary_cofan.mk (𝟙 (⊥_ C)) (𝟙 (⊥_ C)))) :
  has_strict_initial_objects C :=
has_strict_initial_objects_of_initial_is_strict
begin
  intros A f,
  suffices : is_colimit (binary_cofan.mk (𝟙 A) (𝟙 A)),
  { obtain ⟨l, h₁, h₂⟩ := limits.binary_cofan.is_colimit.desc' this (f ≫ initial.to A) (𝟙 A),
    rcases (category.id_comp _).symm.trans h₂ with rfl,
    exact ⟨⟨_, ((category.id_comp _).symm.trans h₁).symm, initial_is_initial.hom_ext _ _⟩⟩ },
  refine (H (binary_cofan.mk (𝟙 _) (𝟙 _)) (map_pair f f) f (by ext ⟨⟨⟩⟩; dsimp; simp)
    (map_pair_equifibered _) _).some,
  rintro ⟨⟨⟩⟩; dsimp;
    exact is_pullback.of_horiz_is_iso ⟨(category.id_comp _).trans (category.comp_id _).symm⟩
end

@[priority 100]
instance has_strict_initial_objects_of_finitary_extensive [finitary_extensive C] :
  has_strict_initial_objects C :=
has_strict_initial_of_is_universal (finitary_extensive.van_kampen _
  ((binary_cofan.is_colimit_iff_is_iso_inr initial_is_initial _).mpr
    (by { dsimp, apply_instance })).some).is_universal

lemma finitary_extensive_iff_of_is_terminal (C : Type u) [category.{v} C] [has_finite_coproducts C]
  (T : C) (HT : is_terminal T) (c₀ : binary_cofan T T) (hc₀ : is_colimit c₀) :
  finitary_extensive C ↔ is_van_kampen_colimit c₀ :=
begin
  refine ⟨λ H, H.2 c₀ hc₀, λ H, _⟩,
  constructor,
  simp_rw binary_cofan.is_van_kampen_iff at H ⊢,
  intros X Y c hc X' Y' c' αX αY f hX hY,
  obtain ⟨d, hd, hd'⟩ := limits.binary_cofan.is_colimit.desc' hc
    (HT.from _ ≫ c₀.inl) (HT.from _ ≫ c₀.inr),
  rw H c' (αX ≫ HT.from _) (αY ≫ HT.from _) (f ≫ d)
    (by rw [← reassoc_of hX, hd, category.assoc])
    (by rw [← reassoc_of hY, hd', category.assoc]),
  obtain ⟨hl, hr⟩ := (H c (HT.from _) (HT.from _) d hd.symm hd'.symm).mp ⟨hc⟩,
  rw [hl.paste_vert_iff hX.symm, hr.paste_vert_iff hY.symm]
end

instance types.finitary_extensive : finitary_extensive (Type u) :=
begin
  rw [finitary_extensive_iff_of_is_terminal (Type u) punit types.is_terminal_punit _
    (types.binary_coproduct_colimit _ _)],
  apply binary_cofan.is_van_kampen_mk _ _ (λ X Y, types.binary_coproduct_colimit X Y) _
    (λ X Y Z f g, (limits.types.pullback_limit_cone f g).2),
  { intros,
    split,
    { refine ⟨⟨hαX.symm⟩, ⟨pullback_cone.is_limit_aux' _ _⟩⟩,
      intro s,
      have : ∀ x, ∃! y, s.fst x = sum.inl y,
      { intro x,
        cases h : s.fst x,
        { simp_rw sum.inl_injective.eq_iff, exact exists_unique_eq' },
        { apply_fun f at h,
          cases ((congr_fun s.condition x).symm.trans h).trans (congr_fun hαY val : _).symm } },
      delta exists_unique at this,
      choose l hl hl',
      exact ⟨l, (funext hl).symm, types.is_terminal_punit.hom_ext _ _,
        λ l' h₁ h₂, funext $ λ x, hl' x (l' x) (congr_fun h₁ x).symm⟩ },
    { refine ⟨⟨hαY.symm⟩, ⟨pullback_cone.is_limit_aux' _ _⟩⟩,
      intro s, dsimp,
      have : ∀ x, ∃! y, s.fst x = sum.inr y,
      { intro x,
        cases h : s.fst x,
        { apply_fun f at h,
          cases ((congr_fun s.condition x).symm.trans h).trans (congr_fun hαX val : _).symm },
        { simp_rw sum.inr_injective.eq_iff, exact exists_unique_eq' } },
      delta exists_unique at this,
      choose l hl hl',
      exact ⟨l, (funext hl).symm, types.is_terminal_punit.hom_ext _ _,
        λ l' h₁ h₂, funext $ λ x, hl' x (l' x) (congr_fun h₁ x).symm⟩ } },
  { intros Z f,
    dsimp [limits.types.binary_coproduct_cocone],
    delta types.pullback_obj,
    have : ∀ x, f x = sum.inl punit.star ∨ f x = sum.inr punit.star,
    { intro x, rcases f x with (⟨⟨⟩⟩|⟨⟨⟩⟩), exacts [or.inl rfl, or.inr rfl] },
    let eX : {p : Z × punit // f p.fst = sum.inl p.snd} ≃ {x : Z // f x = sum.inl punit.star } :=
      ⟨λ p, ⟨p.1.1, by convert p.2⟩, λ x, ⟨⟨_, _⟩, x.2⟩, λ _, by ext; refl, λ _, by ext; refl⟩,
    let eY : {p : Z × punit // f p.fst = sum.inr p.snd} ≃ {x : Z // f x = sum.inr punit.star } :=
      ⟨λ p, ⟨p.1.1, p.2.trans (congr_arg sum.inr $ subsingleton.elim _ _)⟩,
        λ x, ⟨⟨_, _⟩, x.2⟩, λ _, by ext; refl, λ _, by ext; refl⟩,
    fapply binary_cofan.is_colimit_mk,
    { exact λ s x, dite _ (λ h, s.inl $ eX.symm ⟨x, h⟩)
        (λ h, s.inr $ eY.symm ⟨x, (this x).resolve_left h⟩) },
    { intro s, ext ⟨⟨x, ⟨⟩⟩, _⟩, dsimp, split_ifs; refl },
    { intro s, ext ⟨⟨x, ⟨⟩⟩, hx⟩, dsimp, split_ifs, { cases h.symm.trans hx }, { refl } },
    { intros s m e₁ e₂, ext x, split_ifs, { rw ← e₁, refl }, { rw ← e₂, refl } } }
end

section Top

/-- (Implementation) An auxiliary lemma for the proof that `Top` is finitary extensive. -/
def finitary_extensive_Top_aux (Z : Top.{u}) (f : Z ⟶ Top.of (punit.{u+1} ⊕ punit.{u+1})) :
  is_colimit (binary_cofan.mk
    (Top.pullback_fst f (Top.binary_cofan (Top.of punit) (Top.of punit)).inl)
    (Top.pullback_fst f (Top.binary_cofan (Top.of punit) (Top.of punit)).inr)) :=
begin
  have : ∀ x, f x = sum.inl punit.star ∨ f x = sum.inr punit.star,
  { intro x, rcases f x with (⟨⟨⟩⟩|⟨⟨⟩⟩), exacts [or.inl rfl, or.inr rfl] },
  let eX : {p : Z × punit // f p.fst = sum.inl p.snd} ≃ { x : Z // f x = sum.inl punit.star } :=
    ⟨λ p, ⟨p.1.1, p.2.trans (congr_arg sum.inl $ subsingleton.elim _ _)⟩,
      λ x, ⟨⟨_, _⟩, x.2⟩, λ _, by ext; refl, λ _, by ext; refl⟩,
  let eY : {p : Z × punit // f p.fst = sum.inr p.snd} ≃ { x : Z // f x = sum.inr punit.star } :=
    ⟨λ p, ⟨p.1.1, p.2.trans (congr_arg sum.inr $ subsingleton.elim _ _)⟩,
      λ x, ⟨⟨_, _⟩, x.2⟩, λ _, by ext; refl, λ _, by ext; refl⟩,
  fapply binary_cofan.is_colimit_mk,
  { refine λ s, ⟨λ x, dite _ (λ h, s.inl $ eX.symm ⟨x, h⟩)
      (λ h, s.inr $ eY.symm ⟨x, (this x).resolve_left h⟩), _⟩,
    rw continuous_iff_continuous_at,
    intro x,
    by_cases f x = sum.inl punit.star,
    { revert h x,
      apply (is_open.continuous_on_iff _).mp,
      { rw continuous_on_iff_continuous_restrict,
        convert_to continuous (λ x : {x|f x = sum.inl punit.star}, s.inl ⟨(x, punit.star), x.2⟩),
        { ext ⟨x, hx⟩, exact dif_pos hx },
        continuity },
      { convert f.2.1 _ (open_embedding_inl).open_range, ext x, exact ⟨λ h, ⟨_, h.symm⟩,
          λ ⟨e, h⟩, h.symm.trans (congr_arg sum.inl $ subsingleton.elim _ _)⟩ } },
    { revert h x,
      apply (is_open.continuous_on_iff _).mp,
      { rw continuous_on_iff_continuous_restrict,
        convert_to continuous (λ x : {x|f x ≠ sum.inl punit.star},
          s.inr ⟨(x, punit.star), (this _).resolve_left x.2⟩),
        { ext ⟨x, hx⟩, exact dif_neg hx },
        continuity },
      { convert f.2.1 _ (open_embedding_inr).open_range, ext x,
        change f x ≠ sum.inl punit.star ↔ f x ∈ set.range sum.inr,
        transitivity f x = sum.inr punit.star,
        { rcases f x with (⟨⟨⟩⟩|⟨⟨⟩⟩);
            simp only [iff_self, eq_self_iff_true, not_true, ne.def, not_false_iff] },
        { exact ⟨λ h, ⟨_, h.symm⟩, λ ⟨e, h⟩,
            h.symm.trans (congr_arg sum.inr $ subsingleton.elim _ _)⟩ } } } },
  { intro s, ext ⟨⟨x, ⟨⟩⟩, _⟩, change dite _ _ _ = _, split_ifs; refl },
  { intro s, ext ⟨⟨x, ⟨⟩⟩, hx⟩, change dite _ _ _ = _,
    split_ifs, { cases h.symm.trans hx }, { refl } },
  { intros s m e₁ e₂, ext x, change m x = dite _ _ _,
    split_ifs, { rw ← e₁, refl }, { rw ← e₂, refl } }
end

instance : finitary_extensive Top.{u} :=
begin
  rw [finitary_extensive_iff_of_is_terminal Top.{u} _ Top.is_terminal_punit _
    (Top.binary_cofan_is_colimit _ _)],
  apply binary_cofan.is_van_kampen_mk _ _ (λ X Y, Top.binary_cofan_is_colimit X Y) _
    (λ X Y Z f g, Top.pullback_cone_is_limit f g),
  { intros,
    split,
    { refine ⟨⟨hαX.symm⟩, ⟨pullback_cone.is_limit_aux' _ _⟩⟩,
      intro s,
      have : ∀ x, ∃! y, s.fst x = sum.inl y,
      { intro x,
        cases h : s.fst x,
        { simp_rw sum.inl_injective.eq_iff, exact exists_unique_eq' },
        { apply_fun f at h,
          cases ((concrete_category.congr_hom s.condition x).symm.trans h).trans
            (concrete_category.congr_hom hαY val : _).symm } },
      delta exists_unique at this,
      choose l hl hl',
      refine ⟨⟨l, _⟩, continuous_map.ext (λ a, (hl a).symm), Top.is_terminal_punit.hom_ext _ _,
        λ l' h₁ h₂, continuous_map.ext $ λ x,
          hl' x (l' x) (concrete_category.congr_hom h₁ x).symm⟩,
      apply embedding_inl.to_inducing.continuous_iff.mpr,
      convert s.fst.2 using 1, exact (funext hl).symm },
    { refine ⟨⟨hαY.symm⟩, ⟨pullback_cone.is_limit_aux' _ _⟩⟩,
      intro s, dsimp,
      have : ∀ x, ∃! y, s.fst x = sum.inr y,
      { intro x,
        cases h : s.fst x,
        { apply_fun f at h,
          cases ((concrete_category.congr_hom s.condition x).symm.trans h).trans
            (concrete_category.congr_hom hαX val : _).symm },
        { simp_rw sum.inr_injective.eq_iff, exact exists_unique_eq' } },
      delta exists_unique at this,
      choose l hl hl',
      refine ⟨⟨l, _⟩, continuous_map.ext (λ a, (hl a).symm), Top.is_terminal_punit.hom_ext _ _,
        λ l' h₁ h₂, continuous_map.ext $
          λ x, hl' x (l' x) (concrete_category.congr_hom h₁ x).symm⟩,
      apply embedding_inr.to_inducing.continuous_iff.mpr,
      convert s.fst.2 using 1, exact (funext hl).symm } },
  { intros Z f, exact finitary_extensive_Top_aux Z f }
end

end Top

section functor

universes v'' u''

variables {D : Type u''} [category.{v''} D]

lemma nat_trans.equifibered.whisker_right {F G : J ⥤ C} {α : F ⟶ G} (hα : α.equifibered)
  (H : C ⥤ D) [preserves_limits_of_shape walking_cospan H] : (whisker_right α H).equifibered :=
λ i j f, (hα f).map H

lemma is_van_kampen_colimit.of_iso {F : J ⥤ C} {c c' : cocone F} (H : is_van_kampen_colimit c)
  (e : c ≅ c') : is_van_kampen_colimit c' :=
begin
  intros F' c'' α f h hα,
  have : c'.ι ≫ (functor.const J).map e.inv.hom = c.ι,
  { ext j, exact e.inv.2 j },
  rw H c'' α (f ≫ e.inv.1) (by rw [functor.map_comp, ← reassoc_of h, this]) hα,
  apply forall_congr,
  intro j,
  conv_lhs { rw [← category.comp_id (α.app j)] },
  haveI : is_iso e.inv.hom := functor.map_is_iso (cocones.forget _) e.inv,
  exact (is_pullback.of_vert_is_iso ⟨by simp⟩).paste_vert_iff (nat_trans.congr_app h j).symm
end

lemma is_van_kampen_colimit.of_map {D : Type*} [category D] (G : C ⥤ D) {F : J ⥤ C} {c : cocone F}
  [preserves_limits_of_shape walking_cospan G] [reflects_limits_of_shape walking_cospan G]
    [preserves_colimits_of_shape J G] [reflects_colimits_of_shape J G]
   (H : is_van_kampen_colimit (G.map_cocone c)) : is_van_kampen_colimit c :=
begin
  intros F' c' α f h hα,
  refine (iff.trans _ (H (G.map_cocone c') (whisker_right α G) (G.map f)
    (by { ext j, simpa using G.congr_map (nat_trans.congr_app h j) })
    (hα.whisker_right G))).trans (forall_congr $ λ j, _),
  { exact ⟨λ h, ⟨is_colimit_of_preserves G h.some⟩, λ h, ⟨is_colimit_of_reflects G h.some⟩⟩ },
  { exact is_pullback.map_iff G (nat_trans.congr_app h.symm j) }
end

lemma is_van_kampen_colimit_of_evaluation [has_pullbacks D] [has_colimits_of_shape J D]
  (F : J ⥤ C ⥤ D) (c : cocone F)
  (hc : ∀ x : C, is_van_kampen_colimit (((evaluation C D).obj x).map_cocone c)) :
  is_van_kampen_colimit c :=
begin
  intros F' c' α f e hα,
  have := λ x, hc x (((evaluation C D).obj x).map_cocone c') (whisker_right α _)
    (((evaluation C D).obj x).map f)
    (by { ext y, dsimp, exact nat_trans.congr_app (nat_trans.congr_app e y) x })
    (hα.whisker_right _),
  split,
  { rintros ⟨hc'⟩ j,
    refine ⟨⟨(nat_trans.congr_app e j).symm⟩, ⟨evaluation_jointly_reflects_limits _ _⟩⟩,
    refine λ x, (is_limit_map_cone_pullback_cone_equiv _ _).symm _,
    exact ((this x).mp ⟨preserves_colimit.preserves hc'⟩ _).is_limit },
  { exact λ H, ⟨evaluation_jointly_reflects_colimits _
      (λ x, ((this x).mpr (λ j, (H j).map ((evaluation C D).obj x))).some)⟩ }
end

instance [has_pullbacks C] [finitary_extensive C] : finitary_extensive (D ⥤ C) :=
begin
  haveI : has_finite_coproducts (D ⥤ C) := ⟨λ n, limits.functor_category_has_colimits_of_shape⟩,
  exact ⟨λ X Y c hc, is_van_kampen_colimit_of_evaluation _ c
    (λ x, finitary_extensive.van_kampen _ $ preserves_colimit.preserves hc)⟩
end

lemma finitary_extensive_of_preserves_and_reflects (F : C ⥤ D)
  [finitary_extensive D] [has_finite_coproducts C]
    [preserves_limits_of_shape walking_cospan F]
    [reflects_limits_of_shape walking_cospan F]
    [preserves_colimits_of_shape (discrete walking_pair) F]
    [reflects_colimits_of_shape (discrete walking_pair) F] :
  finitary_extensive C :=
⟨λ X Y c hc, (finitary_extensive.van_kampen _ (is_colimit_of_preserves F hc)).of_map F⟩

lemma finitary_extensive_of_preserves_and_reflects_isomorphism (F : C ⥤ D)
  [finitary_extensive D] [has_finite_coproducts C] [has_pullbacks C]
    [preserves_limits_of_shape walking_cospan F]
    [preserves_colimits_of_shape (discrete walking_pair) F]
    [reflects_isomorphisms F] :
  finitary_extensive C :=
begin
  haveI : reflects_limits_of_shape walking_cospan F :=
    reflects_limits_of_shape_of_reflects_isomorphisms,
  haveI : reflects_colimits_of_shape (discrete walking_pair) F :=
    reflects_colimits_of_shape_of_reflects_isomorphisms,
  exact finitary_extensive_of_preserves_and_reflects F,
end

end functor

end extensive

end category_theory


-- Copyright (c) 2017 Scott Morrison. All rights reserved.
-- Released under Apache 2.0 license as described in the file LICENSE.
-- Authors: Stephen Morgan, Scott Morrison, Johannes Hölzl

import category_theory.functor_category category_theory.embedding

namespace category_theory

universes u v u' v' w

instance types : large_category (Type u) :=
{ hom     := λ a b, (a → b),
  id      := λ a, id,
  comp    := λ _ _ _ f g, g ∘ f }

@[simp] lemma types_hom {α β : Type u} : (α ⟶ β) = (α → β) := rfl
@[simp] lemma types_id {α : Type u} (a : α) : (𝟙 α : α → α) a = a := rfl
@[simp] lemma types_comp {α β γ : Type u} (f : α → β) (g : β → γ) (a : α) : (((f : α ⟶ β) ≫ (g : β ⟶ γ)) : α ⟶ γ) a = g (f a) := rfl

@[simp] lemma types.iso_mk_coe (α β : Type u) (f : α → β) (g : β → α) (hom_inv_id) (inv_hom_id) (a : α) :
(({ iso . hom := f, inv := g, hom_inv_id' := hom_inv_id, inv_hom_id' := inv_hom_id } : α ≅ β) : α ⟶ β) a = f a := rfl

namespace functor_to_types
variables {C : Type u} [𝒞 : category.{u v} C] (F G H : C ⥤ (Type w)) {X Y Z : C}
include 𝒞
variables (σ : F ⟹ G) (τ : G ⟹ H)

@[simp] lemma map_comp (f : X ⟶ Y) (g : Y ⟶ Z) (a : F X) : (F.map (f ≫ g)) a = (F.map g) ((F.map f) a) :=
by simp

@[simp] lemma map_id (a : F X) : (F.map (𝟙 X)) a = a :=
by simp

lemma naturality (f : X ⟶ Y) (x : F X) : σ Y ((F.map f) x) = (G.map f) (σ X x) :=
congr_fun (σ.naturality f) x

@[simp] lemma vcomp (x : F X) : (σ ⊟ τ) X x = τ X (σ X x) := rfl

variables {D : Type u'} [𝒟 : category.{u' v'} D] (I J : D ⥤ C) (ρ : I ⟹ J) {W : D}

@[simp] lemma hcomp (x : (I ⋙ F) W) : (ρ ◫ σ) W x = (G.map (ρ W)) (σ (I W) x) := rfl

end functor_to_types

def ulift_functor : (Type u) ⥤ (Type (max u v)) :=
{ obj      := λ X, ulift.{v} X,
  map'     := λ X Y f, λ x : ulift.{v} X, ulift.up (f x.down) }

section forget
variables (C : Type u → Type v) {hom : ∀α β, C α → C β → (α → β) → Prop} [i : concrete_category hom]
include i

/-- The forgetful functor from a bundled category to `Type`. -/
def forget : bundled C ⥤ Type u := { obj := bundled.α, map' := λa b h, h.1 }

instance forget.faithful : faithful (forget C) := {}

end forget

end category_theory


import Duper.Tactic
import Duper.TPTP

set_option inhabitationReasoning true
set_option trace.typeInhabitationReasoning.debug true

theorem optionTest1 (t : Type) (f : Option t) : ∃ x : Option t, True := by duper

theorem optionTest2 : ∀ t : Type, ∃ x : Option t, True := by duper

theorem nonemptyHypTest (t : Type) (eh : Nonempty t = True ∧ True) (h : ∀ x : t, False ≠ False) : False := by duper

-- Needs to synthesize Inhabited (Fin x)
theorem finTest (x : Nat) (f : Fin x → Fin x)
  (h : ∃ y : Fin x, ∀ z : Fin x, (f y ≠ y) ∧ (f z = y)) : False := by duper

-- Needs to synthesize Inhabited (Fin default)
theorem finTest2
  (h : ∀ x : Nat, ∃ f : Fin x → Fin x, ∃ y : Fin x, ∀ z : Fin x, (f y ≠ y) ∧ (f z = y)) : False := by duper

-- Needs to synthesize Inhabited (Fin [anonymous]) (pretty sure [anonymous] is a skolem var)
theorem finTest3 (mult_Nats : ∃ y : Nat, y ≠ 0)
  (h : ∀ x : Nat, x ≠ 0 → ∃ f : Fin x → Fin x, ∃ y : Fin x, ∀ z : Fin x, (f y ≠ y) ∧ (f z = y)) : False := by duper

-- Needs to synthesize Inhabited person
set_option trace.ProofReconstruction true in
theorem barber_paradox1 {person : Type} {shaves : person → person → Prop}
  (h : ∃ b : person, ∀ p : person, (shaves b p ↔ (¬ shaves p p))) : False :=
  by duper

-- Currently causes the output: "(kernel) let-declaration type mismatch 'clause.5.0'"
theorem letDecBug {t : Type} (h : (∀ p : t, p = p) = False) : False :=
  by duper

-- Interesting type inhabited examples (they require more advanced reasoning about type inhabitation)
example : ((∃ (A B : Type) (f : B → A) (x : B), f x = f x) = True) :=
  by duper -- Fails because we currently do not infer that A is nonempty from the fact that B and B → A are nonempty

example : ∃ (A : Type) (B : A → Type) (f : ∀ (a : A), B a) (x : A), (f x = f x) = True :=
  by duper

set_option trace.ProofReconstruction true in
example : ((∀ (A : Type) (f : Nat → A) (x : Nat), f x = f x) = True) :=
  by duper


import divpolys

noncomputable theory
open_locale classical

open polynomial
open nat

variables {R : Type*} [field R] -- should work with comm_ring but some lemmas used for simp won't work
variables (A B : R)

local notation `ψ'` := psi' A B
local notation `ψ2` := psisq A B
local notation `φ` := phi A B
local notation `ω'` := omega' A B
local notation `ω2` := omega_sq A B

-- Prove that Pn + Pn = P2n

-- This has been checked by Sage for n = 2 and 3
lemma phi_bit0 {n : ℕ} (hn : 2 ≤ n)
(hc : (ω2 n * (ite (even n) 1 (4 * (X ^ 3 + A • X + B • 1)))) = φ n^3 + A • φ n * ψ2 n ^ 2 + B • ψ2 n ^ 3 ) :
 φ (2*n) = (φ n)^4  - 2 * A • (φ n)^2 * (ψ2 n)^2 - 8 * B•(φ n)*(ψ2 n)^3 + A^2•(ψ2 n)^4 :=
begin
  unfold phi,
  have ht : even (2*n) := sorry,
  by_cases he : even n,
  {
    simp [he, ht] at hc ⊢,
    rw psisq_bit0_even A B hn he hc,
    rw psi_bit1 _ _ (le_of_succ_le hn),
    rw psi_bit1' _ _ hn,
    simp [he],
    rw ←hc,
    rw psisq_def _ _ he,
    rw omega_sq_def,
    rw omega'_def,
    simp [he, ht],

    sorry
  },
  {
    sorry
  }
end
/-
-- This proves that x(2P) is given by the corresponding division polynomials
lemma main_theorem (n : ℕ) :
(ω' n * (ite (even n) 1 (4 * (X ^ 3 + A • X + B • 1))))^2 =
 φ n^3 + A • φ n * ψ2 n ^ 2 + B • ψ2 n ^ 3 ∧
  φ(2*n) * 4 * ψ2 n * ((φ n)^3 + A • φ n * (ψ2 n)^2 + B • (ψ2 n)^3)
   = (ψ2 (2*n)) * ((φ n)^4 - 2*A•(φ n)^2*(ψ2 n)^2 - 8*B•(φ n)*(ψ2 n)^3 + A^2•(ψ2 n)^4) :=
begin
  apply induction_ppl_bit n,
  { split;
    simp [omega', psi', phi, psisq] },
  {
    intros m hm,
    obtain ⟨hm1, hm2⟩ := hm,
    have hemt : even (2 * m) := even.mul_left (nat.even_bit0 1) _,
    simp [hemt],
    split,
    {
      sorry
    },
    {
      by_cases hm0 : 2 ≤ 2 * m,
      {
        rw phi_bit0 _ _ hm0 hm1,
      },
      {
        -- should be easy
        sorry
      }

    }
  },
  {
    sorry
  }
end
 -/
/- begin
    simp [psisq_bit0 A B hn, phi_bit0 A B hn],
    ring,
    /-
    apply induction_ppl,
    {
      unfold psi',
      simp [psi', psisq],
      ring_poly,
    },
    intros n hn H,
    have two_leq_n : 2 ≤ n,
    { sorry },
    have two_leq_np1 : 2 ≤ n+1,
    { sorry },
    have htwon : even (2*n),
    {sorry},
    have htwon' : ¬ even (2*n+1),
    {sorry},
    have htwon'' : even (2*(n+1)),
    {sorry},
    have htwon''' : ¬ even (2*(n+1)+1),
    {sorry},
    simp [htwon, htwon', htwon'',htwon'''] at H ⊢,
    by_cases hev : even n,
    {
      have hev' : ¬ even (n+1),
      {sorry},
      unfold psisq,
      simp [hev, htwon, htwon', htwon'', htwon''', hev', psisq, psi'] at H ⊢,
      rw psi_bit0 _ _ two_leq_n at H,
      rw psi_bit0 _ _ two_leq_np1,
      rw psi_bit1 _ _ two_leq_np1,
      simp [hev, htwon, htwon', htwon'', htwon''', hev', psisq, psi', psi_simp] at ⊢,
      rw psi_bit1 _ _ two_leq_n,
      simp [hev, htwon, htwon', htwon'', htwon''', hev', psisq, psi'] at ⊢,
      simp only [psi_simp'],
      simp only [psi_simp''],
      simp only [psi_simp'],
      generalize hn : psi' A B (n-1) = xn,
      generalize hn0 : psi' A B n = xn0,
      generalize hn1 : psi' A B (n+1) = xn1,
      generalize hn2 : psi' A B (n+2) = xn2,
      generalize hn3 : psi' A B (n+3) = xn3,
      apply polynomial.eq_of_subs,
      simp,
      --simp only [psi_simp, psi_simp', psi_simp''],

      --norm_num,

      sorry
    },
    {
      have hev' : even (n+1),
      {sorry},
      simp [psi', psisq],
      sorry
    } -/
end
 -/

/- example (n : ℕ) (h : n = 2):
φ(2*n) * 4 * ψ2 n * ((φ n)^3 + A • φ n * (ψ2 n)^2 + B • (ψ2 n)^3)
   = (ψ2 (2*n)) * ((φ n)^4 - 2*A•(φ n)^2*(ψ2 n)^2 - 8*B•(φ n)*(ψ2 n)^3 + A^2•(ψ2 n)^4) :=
begin
  subst h,
  have h4e : even (2*2) := sorry,
  have h1 : 2 * 2 = 4 := sorry,
  have h2 : 2 * 2 + 1 = 5 := sorry,
  simp [phi, psi', psisq, h4e, h1, h2],
  apply polynomial.eq_of_subs,
  intro r,
  simp,
  ring,
end
 -/
/- example (n : ℕ) (h : n = 3):
φ(2*n) * 4 * ψ2 n * ((φ n)^3 + A • φ n * (ψ2 n)^2 + B • (ψ2 n)^3)
   = (ψ2 (2*n)) * ((φ n)^4 - 2*A•(φ n)^2*(ψ2 n)^2 - 8*B•(φ n)*(ψ2 n)^3 + A^2•(ψ2 n)^4) :=
begin
  subst h,
  have h4e : even (2*2) := sorry,
  have h1 : 2 * 3 = 6 := sorry,
  have h2 : 2 * 3 + 1 = 7 := sorry,
  simp [phi, psi', psisq, h4e, h1, h2],
  apply polynomial.eq_of_subs,
  intro r,
  simp,
  -- SAGE checks it!
  sorry
  --ring_exp,
  --ring_poly,
end
 -/

--R.<A,B> = PolynomialRing(QQ)
-- E = EllipticCurve([A,B])
-- x = E.division_polynomial_0(2).parent().gen()
--psip = lambda n : (E.division_polynomial_0(n) if n > 0 else 0)
--psisq = lambda n : psip(n)**2 * ( (4 * (x^3+A*x+B)) if n % 2 == 0 else 1)
--omega = lambda n : psip(n+2) *psip(n-1)**2 - psip(n-2)*psip(n+1)**2
-- phi = lambda n : x * psisq(n) - psip(n+1)*psip(n-1)*(1 if n % 2 == 0 else (4*(x^3+A*x+B)))

-- n = 2
-- pn = phi(n)
-- dn = psisq(n)
-- LHS = (pn^4 - phi(2*n)) // psisq(n)^2
-- RHS = (2*A*pn^2*dn^2 + 8*B*pn*dn^3 - A^2 *dn^4) // psisq(n)^2
-- Can show: Res(x^4-2*A*x^2-8*B*x+A^2, x^3+A*x+B) = (4*A^3+27*B^2)^2
--


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

! This file was ported from Lean 3 source module number_theory.class_number.admissible_abs
! leanprover-community/mathlib commit 23aa88e32dcc9d2a24cca7bc23268567ed4cd7d6
! Please do not edit these lines, except to modify the commit id
! if you have ported upstream changes.
-/
import Mathbin.Algebra.Algebra.Basic
import Mathbin.NumberTheory.ClassNumber.AdmissibleAbsoluteValue

/-!
# Admissible absolute value on the integers

> THIS FILE IS SYNCHRONIZED WITH MATHLIB4.
> Any changes to this file require a corresponding PR to mathlib4.
This file defines an admissible absolute value `absolute_value.abs_is_admissible`
which we use to show the class number of the ring of integers of a number field
is finite.

## Main results

 * `absolute_value.abs_is_admissible` shows the "standard" absolute value on `ℤ`,
   mapping negative `x` to `-x`, is admissible.
-/

namespace AbsoluteValue

open Int

/- warning: absolute_value.exists_partition_int -> AbsoluteValue.exists_partition_int is a dubious translation:
lean 3 declaration is
  forall (n : Nat) {ε : Real}, (LT.lt.{0} Real Real.hasLt (OfNat.ofNat.{0} Real 0 (OfNat.mk.{0} Real 0 (Zero.zero.{0} Real Real.hasZero))) ε) -> (forall {b : Int}, (Ne.{1} Int b (OfNat.ofNat.{0} Int 0 (OfNat.mk.{0} Int 0 (Zero.zero.{0} Int Int.hasZero)))) -> (forall (A : (Fin n) -> Int), Exists.{1} ((Fin n) -> (Fin (Nat.ceil.{0} Real Real.orderedSemiring (FloorRing.toFloorSemiring.{0} Real Real.linearOrderedRing Real.floorRing) (HDiv.hDiv.{0, 0, 0} Real Real Real (instHDiv.{0} Real (DivInvMonoid.toHasDiv.{0} Real (DivisionRing.toDivInvMonoid.{0} Real Real.divisionRing))) (OfNat.ofNat.{0} Real 1 (OfNat.mk.{0} Real 1 (One.one.{0} Real Real.hasOne))) ε)))) (fun (t : (Fin n) -> (Fin (Nat.ceil.{0} Real Real.orderedSemiring (FloorRing.toFloorSemiring.{0} Real Real.linearOrderedRing Real.floorRing) (HDiv.hDiv.{0, 0, 0} Real Real Real (instHDiv.{0} Real (DivInvMonoid.toHasDiv.{0} Real (DivisionRing.toDivInvMonoid.{0} Real Real.divisionRing))) (OfNat.ofNat.{0} Real 1 (OfNat.mk.{0} Real 1 (One.one.{0} Real Real.hasOne))) ε)))) => forall (i₀ : Fin n) (i₁ : Fin n), (Eq.{1} (Fin (Nat.ceil.{0} Real Real.orderedSemiring (FloorRing.toFloorSemiring.{0} Real Real.linearOrderedRing Real.floorRing) (HDiv.hDiv.{0, 0, 0} Real Real Real (instHDiv.{0} Real (DivInvMonoid.toHasDiv.{0} Real (DivisionRing.toDivInvMonoid.{0} Real Real.divisionRing))) (OfNat.ofNat.{0} Real 1 (OfNat.mk.{0} Real 1 (One.one.{0} Real Real.hasOne))) ε))) (t i₀) (t i₁)) -> (LT.lt.{0} Real Real.hasLt ((fun (a : Type) (b : Type) [self : HasLiftT.{1, 1} a b] => self.0) Int Real (HasLiftT.mk.{1, 1} Int Real (CoeTCₓ.coe.{1, 1} Int Real (Int.castCoe.{0} Real Real.hasIntCast))) (Abs.abs.{0} Int (Neg.toHasAbs.{0} Int Int.hasNeg (SemilatticeSup.toHasSup.{0} Int (Lattice.toSemilatticeSup.{0} Int (LinearOrder.toLattice.{0} Int Int.linearOrder)))) (HSub.hSub.{0, 0, 0} Int Int Int (instHSub.{0} Int Int.hasSub) (HMod.hMod.{0, 0, 0} Int Int Int (instHMod.{0} Int Int.hasMod) (A i₁) b) (HMod.hMod.{0, 0, 0} Int Int Int (instHMod.{0} Int Int.hasMod) (A i₀) b)))) (SMul.smul.{0, 0} Int Real (SubNegMonoid.SMulInt.{0} Real (AddGroup.toSubNegMonoid.{0} Real Real.addGroup)) (Abs.abs.{0} Int (Neg.toHasAbs.{0} Int Int.hasNeg (SemilatticeSup.toHasSup.{0} Int (Lattice.toSemilatticeSup.{0} Int (LinearOrder.toLattice.{0} Int Int.linearOrder)))) b) ε)))))
but is expected to have type
  forall (n : Nat) {ε : Real}, (LT.lt.{0} Real Real.instLTReal (OfNat.ofNat.{0} Real 0 (Zero.toOfNat0.{0} Real Real.instZeroReal)) ε) -> (forall {b : Int}, (Ne.{1} Int b (OfNat.ofNat.{0} Int 0 (instOfNatInt 0))) -> (forall (A : (Fin n) -> Int), Exists.{1} ((Fin n) -> (Fin (Nat.ceil.{0} Real Real.orderedSemiring (FloorRing.toFloorSemiring.{0} Real Real.instLinearOrderedRingReal Real.instFloorRingRealInstLinearOrderedRingReal) (HDiv.hDiv.{0, 0, 0} Real Real Real (instHDiv.{0} Real (LinearOrderedField.toDiv.{0} Real Real.instLinearOrderedFieldReal)) (OfNat.ofNat.{0} Real 1 (One.toOfNat1.{0} Real Real.instOneReal)) ε)))) (fun (t : (Fin n) -> (Fin (Nat.ceil.{0} Real Real.orderedSemiring (FloorRing.toFloorSemiring.{0} Real Real.instLinearOrderedRingReal Real.instFloorRingRealInstLinearOrderedRingReal) (HDiv.hDiv.{0, 0, 0} Real Real Real (instHDiv.{0} Real (LinearOrderedField.toDiv.{0} Real Real.instLinearOrderedFieldReal)) (OfNat.ofNat.{0} Real 1 (One.toOfNat1.{0} Real Real.instOneReal)) ε)))) => forall (i₀ : Fin n) (i₁ : Fin n), (Eq.{1} (Fin (Nat.ceil.{0} Real Real.orderedSemiring (FloorRing.toFloorSemiring.{0} Real Real.instLinearOrderedRingReal Real.instFloorRingRealInstLinearOrderedRingReal) (HDiv.hDiv.{0, 0, 0} Real Real Real (instHDiv.{0} Real (LinearOrderedField.toDiv.{0} Real Real.instLinearOrderedFieldReal)) (OfNat.ofNat.{0} Real 1 (One.toOfNat1.{0} Real Real.instOneReal)) ε))) (t i₀) (t i₁)) -> (LT.lt.{0} Real Real.instLTReal (Int.cast.{0} Real Real.intCast (Abs.abs.{0} Int (Neg.toHasAbs.{0} Int Int.instNegInt (SemilatticeSup.toSup.{0} Int (Lattice.toSemilatticeSup.{0} Int (DistribLattice.toLattice.{0} Int (instDistribLattice.{0} Int Int.instLinearOrderInt))))) (HSub.hSub.{0, 0, 0} Int Int Int (instHSub.{0} Int Int.instSubInt) (HMod.hMod.{0, 0, 0} Int Int Int (instHMod.{0} Int Int.instModInt_1) (A i₁) b) (HMod.hMod.{0, 0, 0} Int Int Int (instHMod.{0} Int Int.instModInt_1) (A i₀) b)))) (HSMul.hSMul.{0, 0, 0} Int Real Real (instHSMul.{0, 0} Int Real (SubNegMonoid.SMulInt.{0} Real (AddGroup.toSubNegMonoid.{0} Real Real.instAddGroupReal))) (Abs.abs.{0} Int (Neg.toHasAbs.{0} Int Int.instNegInt (SemilatticeSup.toSup.{0} Int (Lattice.toSemilatticeSup.{0} Int (DistribLattice.toLattice.{0} Int (instDistribLattice.{0} Int Int.instLinearOrderInt))))) b) ε)))))
Case conversion may be inaccurate. Consider using '#align absolute_value.exists_partition_int AbsoluteValue.exists_partition_intₓ'. -/
/-- We can partition a finite family into `partition_card ε` sets, such that the remainders
in each set are close together. -/
theorem exists_partition_int (n : ℕ) {ε : ℝ} (hε : 0 < ε) {b : ℤ} (hb : b ≠ 0) (A : Fin n → ℤ) :
    ∃ t : Fin n → Fin ⌈1 / ε⌉₊, ∀ i₀ i₁, t i₀ = t i₁ → ↑(abs (A i₁ % b - A i₀ % b)) < abs b • ε :=
  by
  have hb' : (0 : ℝ) < ↑(abs b) := int.cast_pos.mpr (abs_pos.mpr hb)
  have hbε : 0 < abs b • ε := by
    rw [Algebra.smul_def]
    exact mul_pos hb' hε
  have hfloor : ∀ i, 0 ≤ floor ((A i % b : ℤ) / abs b • ε : ℝ) :=
    by
    intro i
    exact floor_nonneg.mpr (div_nonneg (cast_nonneg.mpr (mod_nonneg _ hb)) hbε.le)
  refine' ⟨fun i => ⟨nat_abs (floor ((A i % b : ℤ) / abs b • ε : ℝ)), _⟩, _⟩
  · rw [← coe_nat_lt, nat_abs_of_nonneg (hfloor i), floor_lt]
    apply lt_of_lt_of_le _ (Nat.le_ceil _)
    rw [Algebra.smul_def, eq_intCast, ← div_div, div_lt_div_right hε, div_lt_iff hb', one_mul,
      cast_lt]
    exact Int.emod_lt _ hb
  intro i₀ i₁ hi
  have hi : (⌊↑(A i₀ % b) / abs b • ε⌋.natAbs : ℤ) = ⌊↑(A i₁ % b) / abs b • ε⌋.natAbs :=
    congr_arg (coe : ℕ → ℤ) (fin.mk_eq_mk.mp hi)
  rw [nat_abs_of_nonneg (hfloor i₀), nat_abs_of_nonneg (hfloor i₁)] at hi
  have hi := abs_sub_lt_one_of_floor_eq_floor hi
  rw [abs_sub_comm, ← sub_div, abs_div, abs_of_nonneg hbε.le, div_lt_iff hbε, one_mul] at hi
  rwa [Int.cast_abs, Int.cast_sub]
#align absolute_value.exists_partition_int AbsoluteValue.exists_partition_int

#print AbsoluteValue.absIsAdmissible /-
/-- `abs : ℤ → ℤ` is an admissible absolute value -/
noncomputable def absIsAdmissible : IsAdmissible AbsoluteValue.abs :=
  { AbsoluteValue.abs_isEuclidean with
    card := fun ε => ⌈1 / ε⌉₊
    exists_partition' := fun n ε hε b hb => exists_partition_int n hε hb }
#align absolute_value.abs_is_admissible AbsoluteValue.absIsAdmissible
-/

noncomputable instance : Inhabited (IsAdmissible AbsoluteValue.abs) :=
  ⟨absIsAdmissible⟩

end AbsoluteValue


/-
Copyright (c) 2020 Joseph Myers. All rights reserved.
Released under Apache 2.0 license as described in the file LICENSE.
Author: Joseph Myers.
-/
import Mathlib.PrePort
import Mathlib.Lean3Lib.init.default
import Mathlib.linear_algebra.affine_space.basic
import Mathlib.linear_algebra.tensor_product
import Mathlib.data.set.intervals.unordered_interval
import Mathlib.PostPort

universes u_1 u_2 u_3 u_4 u_5 l u_6 u_7 u_8 u_9 u_10 u_11 u_12

namespace Mathlib

/-!
# Affine maps

This file defines affine maps.

## Main definitions

* `affine_map` is the type of affine maps between two affine spaces with the same ring `k`.  Various
  basic examples of affine maps are defined, including `const`, `id`, `line_map` and `homothety`.

## Notations

* `P1 →ᵃ[k] P2` is a notation for `affine_map k P1 P2`;
* `affine_space V P`: a localized notation for `add_torsor V P` defined in
  `linear_algebra.affine_space.basic`.

## Implementation notes

`out_param` is used in the definition of `[add_torsor V P]` to make `V` an implicit argument
(deduced from `P`) in most cases; `include V` is needed in many cases for `V`, and type classes
using it, to be added as implicit arguments to individual lemmas.  As for modules, `k` is an
explicit argument rather than implied by `P` or `V`.

This file only provides purely algebraic definitions and results. Those depending on analysis or
topology are defined elsewhere; see `analysis.normed_space.add_torsor` and
`topology.algebra.affine`.

## References

* https://en.wikipedia.org/wiki/Affine_space
* https://en.wikipedia.org/wiki/Principal_homogeneous_space
-/

/-- An `affine_map k P1 P2` (notation: `P1 →ᵃ[k] P2`) is a map from `P1` to `P2` that
induces a corresponding linear map from `V1` to `V2`. -/
structure affine_map (k : Type u_1) {V1 : Type u_2} (P1 : Type u_3) {V2 : Type u_4} (P2 : Type u_5)
    [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2]
    [add_torsor V2 P2]
    where
  to_fun : P1 → P2
  linear : linear_map k V1 V2
  map_vadd' : ∀ (p : P1) (v : V1), to_fun (v +ᵥ p) = coe_fn linear v +ᵥ to_fun p

protected instance affine_map.has_coe_to_fun (k : Type u_1) {V1 : Type u_2} (P1 : Type u_3)
    {V2 : Type u_4} (P2 : Type u_5) [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1]
    [add_comm_group V2] [module k V2] [add_torsor V2 P2] : has_coe_to_fun (affine_map k P1 P2) :=
  has_coe_to_fun.mk (fun (x : affine_map k P1 P2) => P1 → P2) affine_map.to_fun

namespace linear_map

/-- Reinterpret a linear map as an affine map. -/
def to_affine_map {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} [ring k] [add_comm_group V₁]
    [module k V₁] [add_comm_group V₂] [module k V₂] (f : linear_map k V₁ V₂) : affine_map k V₁ V₂ :=
  affine_map.mk (⇑f) f sorry

@[simp] theorem coe_to_affine_map {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} [ring k]
    [add_comm_group V₁] [module k V₁] [add_comm_group V₂] [module k V₂] (f : linear_map k V₁ V₂) :
    ⇑(to_affine_map f) = ⇑f :=
  rfl

@[simp] theorem to_affine_map_linear {k : Type u_1} {V₁ : Type u_2} {V₂ : Type u_3} [ring k]
    [add_comm_group V₁] [module k V₁] [add_comm_group V₂] [module k V₂] (f : linear_map k V₁ V₂) :
    affine_map.linear (to_affine_map f) = f :=
  rfl

end linear_map

namespace affine_map

/-- Constructing an affine map and coercing back to a function
produces the same map. -/
@[simp] theorem coe_mk {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4}
    {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1]
    [add_comm_group V2] [module k V2] [add_torsor V2 P2] (f : P1 → P2) (linear : linear_map k V1 V2)
    (add : ∀ (p : P1) (v : V1), f (v +ᵥ p) = coe_fn linear v +ᵥ f p) : ⇑(mk f linear add) = f :=
  rfl

/-- `to_fun` is the same as the result of coercing to a function. -/
@[simp] theorem to_fun_eq_coe {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4}
    {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1]
    [add_comm_group V2] [module k V2] [add_torsor V2 P2] (f : affine_map k P1 P2) : to_fun f = ⇑f :=
  rfl

/-- An affine map on the result of adding a vector to a point produces
the same result as the linear map applied to that vector, added to the
affine map applied to that point. -/
@[simp] theorem map_vadd {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4}
    {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1]
    [add_comm_group V2] [module k V2] [add_torsor V2 P2] (f : affine_map k P1 P2) (p : P1)
    (v : V1) : coe_fn f (v +ᵥ p) = coe_fn (linear f) v +ᵥ coe_fn f p :=
  map_vadd' f p v

/-- The linear map on the result of subtracting two points is the
result of subtracting the result of the affine map on those two
points. -/
@[simp] theorem linear_map_vsub {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4}
    {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1]
    [add_comm_group V2] [module k V2] [add_torsor V2 P2] (f : affine_map k P1 P2) (p1 : P1)
    (p2 : P1) : coe_fn (linear f) (p1 -ᵥ p2) = coe_fn f p1 -ᵥ coe_fn f p2 :=
  sorry

/-- Two affine maps are equal if they coerce to the same function. -/
theorem ext {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} {P2 : Type u_5} [ring k]
    [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2]
    [add_torsor V2 P2] {f : affine_map k P1 P2} {g : affine_map k P1 P2}
    (h : ∀ (p : P1), coe_fn f p = coe_fn g p) : f = g :=
  sorry

theorem ext_iff {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} {P2 : Type u_5}
    [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2]
    [add_torsor V2 P2] {f : affine_map k P1 P2} {g : affine_map k P1 P2} :
    f = g ↔ ∀ (p : P1), coe_fn f p = coe_fn g p :=
  { mp := fun (h : f = g) (p : P1) => h ▸ rfl, mpr := ext }

theorem injective_coe_fn {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4}
    {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1]
    [add_comm_group V2] [module k V2] [add_torsor V2 P2] :
    function.injective fun (f : affine_map k P1 P2) (x : P1) => coe_fn f x :=
  sorry

protected theorem congr_arg {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4}
    {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1]
    [add_comm_group V2] [module k V2] [add_torsor V2 P2] (f : affine_map k P1 P2) {x : P1} {y : P1}
    (h : x = y) : coe_fn f x = coe_fn f y :=
  congr_arg (⇑f) h

protected theorem congr_fun {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4}
    {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1]
    [add_comm_group V2] [module k V2] [add_torsor V2 P2] {f : affine_map k P1 P2}
    {g : affine_map k P1 P2} (h : f = g) (x : P1) : coe_fn f x = coe_fn g x :=
  h ▸ rfl

/-- Constant function as an `affine_map`. -/
def const (k : Type u_1) {V1 : Type u_2} (P1 : Type u_3) {V2 : Type u_4} {P2 : Type u_5} [ring k]
    [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2]
    [add_torsor V2 P2] (p : P2) : affine_map k P1 P2 :=
  mk (function.const P1 p) 0 sorry

@[simp] theorem coe_const (k : Type u_1) {V1 : Type u_2} (P1 : Type u_3) {V2 : Type u_4}
    {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1]
    [add_comm_group V2] [module k V2] [add_torsor V2 P2] (p : P2) :
    ⇑(const k P1 p) = function.const P1 p :=
  rfl

@[simp] theorem const_linear (k : Type u_1) {V1 : Type u_2} (P1 : Type u_3) {V2 : Type u_4}
    {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1]
    [add_comm_group V2] [module k V2] [add_torsor V2 P2] (p : P2) : linear (const k P1 p) = 0 :=
  rfl

protected instance nonempty {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4}
    {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1]
    [add_comm_group V2] [module k V2] [add_torsor V2 P2] : Nonempty (affine_map k P1 P2) :=
  nonempty.elim add_torsor.nonempty fun (p : P2) => Nonempty.intro (const k P1 p)

/-- Construct an affine map by verifying the relation between the map and its linear part at one
base point. Namely, this function takes a map `f : P₁ → P₂`, a linear map `f' : V₁ →ₗ[k] V₂`, and
a point `p` such that for any other point `p'` we have `f p' = f' (p' -ᵥ p) +ᵥ f p`. -/
def mk' {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} {P2 : Type u_5} [ring k]
    [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2]
    [add_torsor V2 P2] (f : P1 → P2) (f' : linear_map k V1 V2) (p : P1)
    (h : ∀ (p' : P1), f p' = coe_fn f' (p' -ᵥ p) +ᵥ f p) : affine_map k P1 P2 :=
  mk f f' sorry

@[simp] theorem coe_mk' {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4}
    {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1]
    [add_comm_group V2] [module k V2] [add_torsor V2 P2] (f : P1 → P2) (f' : linear_map k V1 V2)
    (p : P1) (h : ∀ (p' : P1), f p' = coe_fn f' (p' -ᵥ p) +ᵥ f p) : ⇑(mk' f f' p h) = f :=
  rfl

@[simp] theorem mk'_linear {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4}
    {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1]
    [add_comm_group V2] [module k V2] [add_torsor V2 P2] (f : P1 → P2) (f' : linear_map k V1 V2)
    (p : P1) (h : ∀ (p' : P1), f p' = coe_fn f' (p' -ᵥ p) +ᵥ f p) : linear (mk' f f' p h) = f' :=
  rfl

/-- The set of affine maps to a vector space is an additive commutative group. -/
protected instance add_comm_group {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4}
    [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2]
    [module k V2] : add_comm_group (affine_map k P1 V2) :=
  add_comm_group.mk (fun (f g : affine_map k P1 V2) => mk (⇑f + ⇑g) (linear f + linear g) sorry)
    sorry (mk 0 0 sorry) sorry sorry (fun (f : affine_map k P1 V2) => mk (-⇑f) (-linear f) sorry)
    (add_group.sub._default
      (fun (f g : affine_map k P1 V2) => mk (⇑f + ⇑g) (linear f + linear g) sorry) sorry
      (mk 0 0 sorry) sorry sorry fun (f : affine_map k P1 V2) => mk (-⇑f) (-linear f) sorry)
    sorry sorry

@[simp] theorem coe_zero {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} [ring k]
    [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] :
    ⇑0 = 0 :=
  rfl

@[simp] theorem zero_linear {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} [ring k]
    [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] :
    linear 0 = 0 :=
  rfl

@[simp] theorem coe_add {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} [ring k]
    [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2]
    (f : affine_map k P1 V2) (g : affine_map k P1 V2) : ⇑(f + g) = ⇑f + ⇑g :=
  rfl

@[simp] theorem add_linear {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} [ring k]
    [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2]
    (f : affine_map k P1 V2) (g : affine_map k P1 V2) : linear (f + g) = linear f + linear g :=
  rfl

/-- The space of affine maps from `P1` to `P2` is an affine space over the space of affine maps
from `P1` to the vector space `V2` corresponding to `P2`. -/
protected instance add_torsor {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4}
    {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1]
    [add_comm_group V2] [module k V2] [add_torsor V2 P2] :
    add_torsor (affine_map k P1 V2) (affine_map k P1 P2) :=
  add_torsor.mk
    (fun (f : affine_map k P1 V2) (g : affine_map k P1 P2) =>
      mk (fun (p : P1) => coe_fn f p +ᵥ coe_fn g p) (linear f + linear g) sorry)
    sorry sorry
    (fun (f g : affine_map k P1 P2) =>
      mk (fun (p : P1) => coe_fn f p -ᵥ coe_fn g p) (linear f - linear g) sorry)
    sorry sorry

@[simp] theorem vadd_apply {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4}
    {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1]
    [add_comm_group V2] [module k V2] [add_torsor V2 P2] (f : affine_map k P1 V2)
    (g : affine_map k P1 P2) (p : P1) : coe_fn (f +ᵥ g) p = coe_fn f p +ᵥ coe_fn g p :=
  rfl

@[simp] theorem vsub_apply {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4}
    {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1]
    [add_comm_group V2] [module k V2] [add_torsor V2 P2] (f : affine_map k P1 P2)
    (g : affine_map k P1 P2) (p : P1) : coe_fn (f -ᵥ g) p = coe_fn f p -ᵥ coe_fn g p :=
  rfl

/-- `prod.fst` as an `affine_map`. -/
def fst {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} {P2 : Type u_5} [ring k]
    [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2]
    [add_torsor V2 P2] : affine_map k (P1 × P2) P1 :=
  mk prod.fst (linear_map.fst k V1 V2) sorry

@[simp] theorem coe_fst {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4}
    {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1]
    [add_comm_group V2] [module k V2] [add_torsor V2 P2] : ⇑fst = prod.fst :=
  rfl

@[simp] theorem fst_linear {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4}
    {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1]
    [add_comm_group V2] [module k V2] [add_torsor V2 P2] : linear fst = linear_map.fst k V1 V2 :=
  rfl

/-- `prod.snd` as an `affine_map`. -/
def snd {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} {P2 : Type u_5} [ring k]
    [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2]
    [add_torsor V2 P2] : affine_map k (P1 × P2) P2 :=
  mk prod.snd (linear_map.snd k V1 V2) sorry

@[simp] theorem coe_snd {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4}
    {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1]
    [add_comm_group V2] [module k V2] [add_torsor V2 P2] : ⇑snd = prod.snd :=
  rfl

@[simp] theorem snd_linear {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4}
    {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1]
    [add_comm_group V2] [module k V2] [add_torsor V2 P2] : linear snd = linear_map.snd k V1 V2 :=
  rfl

/-- Identity map as an affine map. -/
def id (k : Type u_1) {V1 : Type u_2} (P1 : Type u_3) [ring k] [add_comm_group V1] [module k V1]
    [add_torsor V1 P1] : affine_map k P1 P1 :=
  mk id linear_map.id sorry

/-- The identity affine map acts as the identity. -/
@[simp] theorem coe_id (k : Type u_1) {V1 : Type u_2} (P1 : Type u_3) [ring k] [add_comm_group V1]
    [module k V1] [add_torsor V1 P1] : ⇑(id k P1) = id :=
  rfl

@[simp] theorem id_linear (k : Type u_1) {V1 : Type u_2} (P1 : Type u_3) [ring k]
    [add_comm_group V1] [module k V1] [add_torsor V1 P1] : linear (id k P1) = linear_map.id :=
  rfl

/-- The identity affine map acts as the identity. -/
theorem id_apply (k : Type u_1) {V1 : Type u_2} {P1 : Type u_3} [ring k] [add_comm_group V1]
    [module k V1] [add_torsor V1 P1] (p : P1) : coe_fn (id k P1) p = p :=
  rfl

protected instance inhabited {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [ring k]
    [add_comm_group V1] [module k V1] [add_torsor V1 P1] : Inhabited (affine_map k P1 P1) :=
  { default := id k P1 }

/-- Composition of affine maps. -/
def comp {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} {P2 : Type u_5}
    {V3 : Type u_6} {P3 : Type u_7} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1]
    [add_comm_group V2] [module k V2] [add_torsor V2 P2] [add_comm_group V3] [module k V3]
    [add_torsor V3 P3] (f : affine_map k P2 P3) (g : affine_map k P1 P2) : affine_map k P1 P3 :=
  mk (⇑f ∘ ⇑g) (linear_map.comp (linear f) (linear g)) sorry

/-- Composition of affine maps acts as applying the two functions. -/
@[simp] theorem coe_comp {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4}
    {P2 : Type u_5} {V3 : Type u_6} {P3 : Type u_7} [ring k] [add_comm_group V1] [module k V1]
    [add_torsor V1 P1] [add_comm_group V2] [module k V2] [add_torsor V2 P2] [add_comm_group V3]
    [module k V3] [add_torsor V3 P3] (f : affine_map k P2 P3) (g : affine_map k P1 P2) :
    ⇑(comp f g) = ⇑f ∘ ⇑g :=
  rfl

/-- Composition of affine maps acts as applying the two functions. -/
theorem comp_apply {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} {P2 : Type u_5}
    {V3 : Type u_6} {P3 : Type u_7} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1]
    [add_comm_group V2] [module k V2] [add_torsor V2 P2] [add_comm_group V3] [module k V3]
    [add_torsor V3 P3] (f : affine_map k P2 P3) (g : affine_map k P1 P2) (p : P1) :
    coe_fn (comp f g) p = coe_fn f (coe_fn g p) :=
  rfl

@[simp] theorem comp_id {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4}
    {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1]
    [add_comm_group V2] [module k V2] [add_torsor V2 P2] (f : affine_map k P1 P2) :
    comp f (id k P1) = f :=
  ext fun (p : P1) => rfl

@[simp] theorem id_comp {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4}
    {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1]
    [add_comm_group V2] [module k V2] [add_torsor V2 P2] (f : affine_map k P1 P2) :
    comp (id k P2) f = f :=
  ext fun (p : P1) => rfl

theorem comp_assoc {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4} {P2 : Type u_5}
    {V3 : Type u_6} {P3 : Type u_7} {V4 : Type u_8} {P4 : Type u_9} [ring k] [add_comm_group V1]
    [module k V1] [add_torsor V1 P1] [add_comm_group V2] [module k V2] [add_torsor V2 P2]
    [add_comm_group V3] [module k V3] [add_torsor V3 P3] [add_comm_group V4] [module k V4]
    [add_torsor V4 P4] (f₃₄ : affine_map k P3 P4) (f₂₃ : affine_map k P2 P3)
    (f₁₂ : affine_map k P1 P2) : comp (comp f₃₄ f₂₃) f₁₂ = comp f₃₄ (comp f₂₃ f₁₂) :=
  rfl

protected instance monoid {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [ring k]
    [add_comm_group V1] [module k V1] [add_torsor V1 P1] : monoid (affine_map k P1 P1) :=
  monoid.mk comp comp_assoc (id k P1) id_comp comp_id

@[simp] theorem coe_mul {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [ring k] [add_comm_group V1]
    [module k V1] [add_torsor V1 P1] (f : affine_map k P1 P1) (g : affine_map k P1 P1) :
    ⇑(f * g) = ⇑f ∘ ⇑g :=
  rfl

@[simp] theorem coe_one {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [ring k] [add_comm_group V1]
    [module k V1] [add_torsor V1 P1] : ⇑1 = id :=
  rfl

/-! ### Definition of `affine_map.line_map` and lemmas about it -/

/-- The affine map from `k` to `P1` sending `0` to `p₀` and `1` to `p₁`. -/
def line_map {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [ring k] [add_comm_group V1]
    [module k V1] [add_torsor V1 P1] (p₀ : P1) (p₁ : P1) : affine_map k k P1 :=
  linear_map.to_affine_map (linear_map.smul_right linear_map.id (p₁ -ᵥ p₀)) +ᵥ const k k p₀

theorem coe_line_map {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [ring k] [add_comm_group V1]
    [module k V1] [add_torsor V1 P1] (p₀ : P1) (p₁ : P1) :
    ⇑(line_map p₀ p₁) = fun (c : k) => c • (p₁ -ᵥ p₀) +ᵥ p₀ :=
  rfl

theorem line_map_apply {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [ring k] [add_comm_group V1]
    [module k V1] [add_torsor V1 P1] (p₀ : P1) (p₁ : P1) (c : k) :
    coe_fn (line_map p₀ p₁) c = c • (p₁ -ᵥ p₀) +ᵥ p₀ :=
  rfl

theorem line_map_apply_module' {k : Type u_1} {V1 : Type u_2} [ring k] [add_comm_group V1]
    [module k V1] (p₀ : V1) (p₁ : V1) (c : k) : coe_fn (line_map p₀ p₁) c = c • (p₁ - p₀) + p₀ :=
  rfl

theorem line_map_apply_module {k : Type u_1} {V1 : Type u_2} [ring k] [add_comm_group V1]
    [module k V1] (p₀ : V1) (p₁ : V1) (c : k) : coe_fn (line_map p₀ p₁) c = (1 - c) • p₀ + c • p₁ :=
  sorry

theorem line_map_apply_ring' {k : Type u_1} [ring k] (a : k) (b : k) (c : k) :
    coe_fn (line_map a b) c = c * (b - a) + a :=
  rfl

theorem line_map_apply_ring {k : Type u_1} [ring k] (a : k) (b : k) (c : k) :
    coe_fn (line_map a b) c = (1 - c) * a + c * b :=
  line_map_apply_module a b c

theorem line_map_vadd_apply {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [ring k]
    [add_comm_group V1] [module k V1] [add_torsor V1 P1] (p : P1) (v : V1) (c : k) :
    coe_fn (line_map p (v +ᵥ p)) c = c • v +ᵥ p :=
  eq.mpr
    (id
      (Eq._oldrec (Eq.refl (coe_fn (line_map p (v +ᵥ p)) c = c • v +ᵥ p))
        (line_map_apply p (v +ᵥ p) c)))
    (eq.mpr (id (Eq._oldrec (Eq.refl (c • (v +ᵥ p -ᵥ p) +ᵥ p = c • v +ᵥ p)) (vadd_vsub v p)))
      (Eq.refl (c • v +ᵥ p)))

@[simp] theorem line_map_linear {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [ring k]
    [add_comm_group V1] [module k V1] [add_torsor V1 P1] (p₀ : P1) (p₁ : P1) :
    linear (line_map p₀ p₁) = linear_map.smul_right linear_map.id (p₁ -ᵥ p₀) :=
  add_zero (linear (linear_map.to_affine_map (linear_map.smul_right linear_map.id (p₁ -ᵥ p₀))))

theorem line_map_same_apply {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [ring k]
    [add_comm_group V1] [module k V1] [add_torsor V1 P1] (p : P1) (c : k) :
    coe_fn (line_map p p) c = p :=
  sorry

@[simp] theorem line_map_same {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [ring k]
    [add_comm_group V1] [module k V1] [add_torsor V1 P1] (p : P1) : line_map p p = const k k p :=
  ext (line_map_same_apply p)

@[simp] theorem line_map_apply_zero {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [ring k]
    [add_comm_group V1] [module k V1] [add_torsor V1 P1] (p₀ : P1) (p₁ : P1) :
    coe_fn (line_map p₀ p₁) 0 = p₀ :=
  sorry

@[simp] theorem line_map_apply_one {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [ring k]
    [add_comm_group V1] [module k V1] [add_torsor V1 P1] (p₀ : P1) (p₁ : P1) :
    coe_fn (line_map p₀ p₁) 1 = p₁ :=
  sorry

@[simp] theorem apply_line_map {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4}
    {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1]
    [add_comm_group V2] [module k V2] [add_torsor V2 P2] (f : affine_map k P1 P2) (p₀ : P1)
    (p₁ : P1) (c : k) :
    coe_fn f (coe_fn (line_map p₀ p₁) c) = coe_fn (line_map (coe_fn f p₀) (coe_fn f p₁)) c :=
  sorry

@[simp] theorem comp_line_map {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4}
    {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1]
    [add_comm_group V2] [module k V2] [add_torsor V2 P2] (f : affine_map k P1 P2) (p₀ : P1)
    (p₁ : P1) : comp f (line_map p₀ p₁) = line_map (coe_fn f p₀) (coe_fn f p₁) :=
  ext (apply_line_map f p₀ p₁)

@[simp] theorem fst_line_map {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4}
    {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1]
    [add_comm_group V2] [module k V2] [add_torsor V2 P2] (p₀ : P1 × P2) (p₁ : P1 × P2) (c : k) :
    prod.fst (coe_fn (line_map p₀ p₁) c) = coe_fn (line_map (prod.fst p₀) (prod.fst p₁)) c :=
  apply_line_map fst p₀ p₁ c

@[simp] theorem snd_line_map {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4}
    {P2 : Type u_5} [ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1]
    [add_comm_group V2] [module k V2] [add_torsor V2 P2] (p₀ : P1 × P2) (p₁ : P1 × P2) (c : k) :
    prod.snd (coe_fn (line_map p₀ p₁) c) = coe_fn (line_map (prod.snd p₀) (prod.snd p₁)) c :=
  apply_line_map snd p₀ p₁ c

theorem line_map_symm {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [ring k] [add_comm_group V1]
    [module k V1] [add_torsor V1 P1] (p₀ : P1) (p₁ : P1) :
    line_map p₀ p₁ = comp (line_map p₁ p₀) (line_map 1 0) :=
  sorry

theorem line_map_apply_one_sub {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [ring k]
    [add_comm_group V1] [module k V1] [add_torsor V1 P1] (p₀ : P1) (p₁ : P1) (c : k) :
    coe_fn (line_map p₀ p₁) (1 - c) = coe_fn (line_map p₁ p₀) c :=
  sorry

@[simp] theorem line_map_vsub_left {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [ring k]
    [add_comm_group V1] [module k V1] [add_torsor V1 P1] (p₀ : P1) (p₁ : P1) (c : k) :
    coe_fn (line_map p₀ p₁) c -ᵥ p₀ = c • (p₁ -ᵥ p₀) :=
  vadd_vsub (coe_fn (linear_map.to_affine_map (linear_map.smul_right linear_map.id (p₁ -ᵥ p₀))) c)
    (coe_fn (const k k p₀) c)

@[simp] theorem left_vsub_line_map {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [ring k]
    [add_comm_group V1] [module k V1] [add_torsor V1 P1] (p₀ : P1) (p₁ : P1) (c : k) :
    p₀ -ᵥ coe_fn (line_map p₀ p₁) c = c • (p₀ -ᵥ p₁) :=
  sorry

@[simp] theorem line_map_vsub_right {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [ring k]
    [add_comm_group V1] [module k V1] [add_torsor V1 P1] (p₀ : P1) (p₁ : P1) (c : k) :
    coe_fn (line_map p₀ p₁) c -ᵥ p₁ = (1 - c) • (p₀ -ᵥ p₁) :=
  sorry

@[simp] theorem right_vsub_line_map {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [ring k]
    [add_comm_group V1] [module k V1] [add_torsor V1 P1] (p₀ : P1) (p₁ : P1) (c : k) :
    p₁ -ᵥ coe_fn (line_map p₀ p₁) c = (1 - c) • (p₁ -ᵥ p₀) :=
  sorry

theorem line_map_vadd_line_map {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [ring k]
    [add_comm_group V1] [module k V1] [add_torsor V1 P1] (v₁ : V1) (v₂ : V1) (p₁ : P1) (p₂ : P1)
    (c : k) :
    coe_fn (line_map v₁ v₂) c +ᵥ coe_fn (line_map p₁ p₂) c =
        coe_fn (line_map (v₁ +ᵥ p₁) (v₂ +ᵥ p₂)) c :=
  apply_line_map (fst +ᵥ snd) (v₁, p₁) (v₂, p₂) c

theorem line_map_vsub_line_map {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [ring k]
    [add_comm_group V1] [module k V1] [add_torsor V1 P1] (p₁ : P1) (p₂ : P1) (p₃ : P1) (p₄ : P1)
    (c : k) :
    coe_fn (line_map p₁ p₂) c -ᵥ coe_fn (line_map p₃ p₄) c =
        coe_fn (line_map (p₁ -ᵥ p₃) (p₂ -ᵥ p₄)) c :=
  apply_line_map (fst -ᵥ snd) (p₁, p₃) (p₂, p₄) c

-- Why Lean fails to find this instance without a hint?

/-- Decomposition of an affine map in the special case when the point space and vector space
are the same. -/
theorem decomp {k : Type u_1} {V1 : Type u_2} {V2 : Type u_4} [ring k] [add_comm_group V1]
    [module k V1] [add_comm_group V2] [module k V2] (f : affine_map k V1 V2) :
    ⇑f = ⇑(linear f) + fun (z : V1) => coe_fn f 0 :=
  sorry

/-- Decomposition of an affine map in the special case when the point space and vector space
are the same. -/
theorem decomp' {k : Type u_1} {V1 : Type u_2} {V2 : Type u_4} [ring k] [add_comm_group V1]
    [module k V1] [add_comm_group V2] [module k V2] (f : affine_map k V1 V2) :
    ⇑(linear f) = ⇑f - fun (z : V1) => coe_fn f 0 :=
  sorry

theorem image_interval {k : Type u_1} [linear_ordered_field k] (f : affine_map k k k) (a : k)
    (b : k) : ⇑f '' set.interval a b = set.interval (coe_fn f a) (coe_fn f b) :=
  sorry

/-- Evaluation at a point as an affine map. -/
def proj {k : Type u_1} [ring k] {ι : Type u_10} {V : ι → Type u_11} {P : ι → Type u_12}
    [(i : ι) → add_comm_group (V i)] [(i : ι) → semimodule k (V i)]
    [(i : ι) → add_torsor (V i) (P i)] (i : ι) : affine_map k ((i : ι) → P i) (P i) :=
  mk (fun (f : (i : ι) → P i) => f i) (linear_map.proj i) sorry

@[simp] theorem proj_apply {k : Type u_1} [ring k] {ι : Type u_10} {V : ι → Type u_11}
    {P : ι → Type u_12} [(i : ι) → add_comm_group (V i)] [(i : ι) → semimodule k (V i)]
    [(i : ι) → add_torsor (V i) (P i)] (i : ι) (f : (i : ι) → P i) : coe_fn (proj i) f = f i :=
  rfl

@[simp] theorem proj_linear {k : Type u_1} [ring k] {ι : Type u_10} {V : ι → Type u_11}
    {P : ι → Type u_12} [(i : ι) → add_comm_group (V i)] [(i : ι) → semimodule k (V i)]
    [(i : ι) → add_torsor (V i) (P i)] (i : ι) : linear (proj i) = linear_map.proj i :=
  rfl

theorem pi_line_map_apply {k : Type u_1} [ring k] {ι : Type u_10} {V : ι → Type u_11}
    {P : ι → Type u_12} [(i : ι) → add_comm_group (V i)] [(i : ι) → semimodule k (V i)]
    [(i : ι) → add_torsor (V i) (P i)] (f : (i : ι) → P i) (g : (i : ι) → P i) (c : k) (i : ι) :
    coe_fn (line_map f g) c i = coe_fn (line_map (f i) (g i)) c :=
  apply_line_map (proj i) f g c

end affine_map

namespace affine_map

/-- If `k` is a commutative ring, then the set of affine maps with codomain in a `k`-module
is a `k`-module. -/
protected instance module {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4}
    [comm_ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2]
    [module k V2] : module k (affine_map k P1 V2) :=
  semimodule.mk sorry sorry

@[simp] theorem coe_smul {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} {V2 : Type u_4}
    [comm_ring k] [add_comm_group V1] [module k V1] [add_torsor V1 P1] [add_comm_group V2]
    [module k V2] (c : k) (f : affine_map k P1 V2) : ⇑(c • f) = c • ⇑f :=
  rfl

/-- `homothety c r` is the homothety about `c` with scale factor `r`. -/
def homothety {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [comm_ring k] [add_comm_group V1]
    [module k V1] [add_torsor V1 P1] (c : P1) (r : k) : affine_map k P1 P1 :=
  r • (id k P1 -ᵥ const k P1 c) +ᵥ const k P1 c

theorem homothety_def {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [comm_ring k]
    [add_comm_group V1] [module k V1] [add_torsor V1 P1] (c : P1) (r : k) :
    homothety c r = r • (id k P1 -ᵥ const k P1 c) +ᵥ const k P1 c :=
  rfl

theorem homothety_apply {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [comm_ring k]
    [add_comm_group V1] [module k V1] [add_torsor V1 P1] (c : P1) (r : k) (p : P1) :
    coe_fn (homothety c r) p = r • (p -ᵥ c) +ᵥ c :=
  rfl

theorem homothety_eq_line_map {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [comm_ring k]
    [add_comm_group V1] [module k V1] [add_torsor V1 P1] (c : P1) (r : k) (p : P1) :
    coe_fn (homothety c r) p = coe_fn (line_map c p) r :=
  rfl

@[simp] theorem homothety_one {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [comm_ring k]
    [add_comm_group V1] [module k V1] [add_torsor V1 P1] (c : P1) : homothety c 1 = id k P1 :=
  sorry

theorem homothety_mul {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [comm_ring k]
    [add_comm_group V1] [module k V1] [add_torsor V1 P1] (c : P1) (r₁ : k) (r₂ : k) :
    homothety c (r₁ * r₂) = comp (homothety c r₁) (homothety c r₂) :=
  sorry

@[simp] theorem homothety_zero {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [comm_ring k]
    [add_comm_group V1] [module k V1] [add_torsor V1 P1] (c : P1) : homothety c 0 = const k P1 c :=
  sorry

@[simp] theorem homothety_add {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [comm_ring k]
    [add_comm_group V1] [module k V1] [add_torsor V1 P1] (c : P1) (r₁ : k) (r₂ : k) :
    homothety c (r₁ + r₂) = r₁ • (id k P1 -ᵥ const k P1 c) +ᵥ homothety c r₂ :=
  sorry

/-- `homothety` as a multiplicative monoid homomorphism. -/
def homothety_hom {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [comm_ring k] [add_comm_group V1]
    [module k V1] [add_torsor V1 P1] (c : P1) : k →* affine_map k P1 P1 :=
  monoid_hom.mk (homothety c) (homothety_one c) (homothety_mul c)

@[simp] theorem coe_homothety_hom {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [comm_ring k]
    [add_comm_group V1] [module k V1] [add_torsor V1 P1] (c : P1) :
    ⇑(homothety_hom c) = homothety c :=
  rfl

/-- `homothety` as an affine map. -/
def homothety_affine {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [comm_ring k]
    [add_comm_group V1] [module k V1] [add_torsor V1 P1] (c : P1) :
    affine_map k k (affine_map k P1 P1) :=
  mk (homothety c)
    (coe_fn (linear_map.flip (linear_map.lsmul k (affine_map k P1 V1))) (id k P1 -ᵥ const k P1 c))
    sorry

@[simp] theorem coe_homothety_affine {k : Type u_1} {V1 : Type u_2} {P1 : Type u_3} [comm_ring k]
    [add_comm_group V1] [module k V1] [add_torsor V1 P1] (c : P1) :
    ⇑(homothety_affine c) = homothety c :=
  rfl

end Mathlib


section
  variables (x y z : ℕ)
  variables (h₁ : x = y) (h₂ : y = z)

  section include_hs
    include h₁ h₂

    theorem foo : x = z :=
    begin
      rw [h₁, h₂]
    end
  end include_hs
end


import topology.basic
import topology.compact_open
import data.nat.prime
import data.real.basic
import data.real.irrational
import data.complex.basic
import data.fin.basic
import geometry.euclidean.basic
import analysis.inner_product_space.pi_L2
import algebra.group.defs
import algebra.field.basic
import combinatorics.configuration
import ring_theory.polynomial.basic
import group_theory.free_group
import combinatorics.simple_graph.basic
import ring_theory.integral_closure
import data.fintype.card
import category_theory.category.basic
import ring_theory.discrete_valuation_ring
import group_theory.torsion
import linear_algebra.matrix.charpoly.basic
import algebra.order.absolute_value
import analysis.convex.basic
import topology.uniform_space.uniform_convergence_topology
import topology.sequences
import analysis.normed.group.infinite_sum
import data.nat.choose.sum
import group_theory.specific_groups.cyclic
import group_theory.order_of_element
import analysis.mean_inequalities
import analysis.normed_space.banach
import topology.algebra.continuous_monoid_hom
import linear_algebra.matrix.symmetric
import analysis.inner_product_space.spectrum
import ring_theory.class_group
import ring_theory.dedekind_domain.basic
import ring_theory.principal_ideal_domain
import model_theory.satisfiability
import probability.integration
import ring_theory.simple_module
import category_theory.preadditive.schur
import representation_theory.maschke
import topology.paracompact
import combinatorics.simple_graph.coloring
--Prove that Contraction mapping  in Lean mathlib

--OUTPUT 1
theorem contraction_mapping_theorem (f : E → E) (x y : E) (H : ∀ x y : E, dist (f x) (f y) ≤ λ * dist x y) :
  ∃! x : E, f x = x :=
begin
  let x₀ := f x,
  have : ∀ n : ℕ, ∃ x : E, f x = f (f^[n] x),
  { intro n,
    induction n with n Hn,
    { existsi x₀,
      exact rfl },
    { rcases Hn with ⟨x, hx⟩,
      existsi f x,
      rw [hx, pow_succ] } },
  have : ∀ n : ℕ, ∃ x : E, f x = f^[n + 1] x,
  { intro n,
    rcases this n with ⟨x, hx⟩,
    existsi x,
    rw [hx, pow_succ] },
  let x₁ : ℕ → E := λ n, classical.some (this n),
  have : ∀ n : ℕ, f (x₁ n) = f^[n + 1] (x₁ n),
  { intro n,
    rw [x₁, classical.some_spec (this n)] },
  let x₂ := λ n : ℕ, (f^[n] x) - (x₁ n),
  have : ∀ n : ℕ, f (x₁ n) - x₁ n = x₂ n,
  { intro n,
    rw [x₂, sub_eq_add_neg, this] },
  have : ∀ n : ℕ, dist (x₁ n) (x₁ (n + 1)) ≤ λ * dist (x₁ n) (x₁ n),
  { intro n,
    rw [dist_comm, dist_comm (x₁ n) (x₁ (n + 1))],
    have : dist (x₁ n) (x₁ (n + 1)) = dist (f (x₁ n) - x₁ n) (f (x₁ (n + 1)) - x₁ (n + 1)),
    { rw [this, this (n + 1), sub_eq_add_neg, sub_eq_add_neg] },
    rw [this, dist_comm (f (x₁ n) - x₁ n) (f (x₁ (n + 1)) - x₁ (n + 1))],
    rw [dist_comm, dist_comm (f (x₁ n)) (f (x₁ (n + 1)))],
    have : dist (f (x₁ n) - x₁ n) (f (x₁ (n + 1)) - x₁ (n + 1)) ≤ λ * dist (x₁ n) (x₁ (n + 1)),
    { apply H },
    rw [dist_comm (f (x₁ n)) (f (x₁ (n + 1))), dist_comm (f (x₁ n) - x₁ n) (f (x₁ (n + 1)) - x₁ (n + 1))],
    exact this },
  have : ∀ n : ℕ, dist (x₁ n) (x₁ (n + 1)) ≤ λ^(n + 1) * dist x x₀,
  { intro n,
    induction n with n Hn,
    { rw [pow_one, mul_one],
      have : dist x x₀ = dist (x₁ 0) (x₁ 1),
      { rw [x₁, x₁, sub_eq_add_neg] },
      rw [this],
      exact this 0 },
    { have : λ^(n + 1) * dist x x₀ = λ * (λ^n * dist x x₀),
      { rw [mul_assoc, mul_comm λ^n, mul_assoc, pow_succ] },
      rw [this],
      apply le_trans Hn,
      rw [mul_assoc, mul_comm λ, mul_assoc],
      apply mul_le_mul_of_nonneg_left Hn (le_of_lt (lt_of_le_of_lt (dist_nonneg (x₁ n) (x₁ (n + 1))) (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_of_ne (ne.symm (ne_of_lt (dist_pos_

--OUTPUT 2
theorem contraction_mapping_thm (f : α → α) (x y : α) (h : x ≠ y) (hf : is_contraction f) :
  f x = f y :=
begin
  have hf' := hf.contraction,
  have hx' : f x ≠ f y,
    intro hfx,
    have hfx' : x = y,
      apply hf'.eq_of_sub_lt_self,
      rw ← hfx,
      rw ← hfx,
      exact hf'.sub_self_lt_of_pos hf.pos,
    rw hfx' at h,
    exact h rfl,
  exact hx',

--OUTPUT 3
theorem contraction_mapping_theorem {X : Type} [metric_space X] (f : X → X) (x : X)
  (c : ℝ) (h : 0 ≤ c ∧ c < 1) (hf : continuous f) (hfx : f x = x) :
  unique_fixed_point f x :=
begin
  let δ := 1 - c,
  let δ' := δ / 2,
  have hδ : 0 < δ,
    by linarith,
  have hδ' : 0 < δ',
    by linarith,
  let b := ball x δ',
  have hb : ∀ x y, x ∈ b → y ∈ b → dist (f x) (f y) ≤ c * dist x y,
  {
    intros x y hx hy,
    have hfx : f x ∈ closure b,
      by { apply continuous_closure_image, exact hf, exact hx },
    have hfy : f y ∈ closure b,
      by { apply continuous_closure_image, exact hf, exact hy },
    have h : dist (f x) (f y) ≤ c * dist (f x) x,
      by { apply le_of_lt, apply dist_ball_lt_dist_closure, exact hδ', exact hfx },
    rw dist_comm at h,
    have h' : dist (f x) (f y) ≤ c * dist y x,
      by { rw dist_comm, exact h },
    linarith
  },
  have hb' : ∀ x y, x ∈ b → y ∈ b → dist (f x) (f y) < dist x y,
  {
    intros x y hx hy,
    have h : dist (f x) (f y) ≤ c * dist x y,
      by { apply hb, exact hx, exact hy },
    have h' : c * dist x y < dist x y,
      by { apply mul_lt_mul_of_pos_left, exact hδ, exact dist_pos_of_ne_zero hx },
    linarith
  },
  have hb'' : ∀ x y, x ∈ b → y ∈ b → dist (f x) (f y) ≤ dist x y,
  {
    intros x y hx hy,
    have h : dist (f x) (f y) < dist x y,
      by { apply hb', exact hx, exact hy },
    linarith
  },
  have hb''' : ∀ x y, x ∈ b → y ∈ b → dist (f x) (f y) < dist x y,
  {
    intros x y hx hy,
    have h : dist (f x) (f y) ≤ dist x y,
      by { apply hb'', exact hx, exact hy },
    linarith
  },
  have hbiv : ∀ x y, x ∈ b → y ∈ b → dist (f x) (f y) ≤ c * dist x y,
  {
    intros x y hx hy,
    have h : dist (f x) (f y) < dist x y,
      by { apply hb''', exact hx, exact hy },
    have h' : c * dist x y < dist x y,
      by { apply mul_lt_mul_of_pos_left, exact hδ, exact dist_pos_of_ne_zero hx },
    linarith
  },
  let g : X → X := λ z, (f z) + ((x - f z) / 2),
  have hg : ∀ z, z ∈ b → g z ∈ b,
  {
    intros z hz,
    have h : dist (g z) x ≤ dist (f z) x + dist (x - f z) x,
      by { apply dist_triangle },
    have h' : dist (g z) x ≤ dist (f z) x + dist (f z) x,
      by { rw dist_comm, apply dist_triangle },
    have h'' : dist (g z) x ≤ 2 * dist (f z) x,
      by { linarith },
    have h''' : dist (g z) x ≤ δ',
      by { rw ← dist_comm, apply dist_ball_le, exact hfx, exact h'' },
    have h'''' : dist (g z) x < δ,
      by { linarith },
    have h''''' : dist (g z) x < dist x x,
      by { rw dist_self, exact h'''' },
    have h'''''' : dist (g z) x < dist x (g z),
      by { rw dist_comm, exact h''''' },
    have h''''''' : dist (g z) x < dist (g z) x,
      by { rw dist_comm, exact h'''''' },
    linarith
  },
  have hgf : ∀ z, z ∈ b → g (f z) = f (g z),
  {
    intros z hz,
    rw ← add_assoc,
    rw ← sub_add_cancel,
    rw add_comm,
    rw sub_add_cancel,
    rw add_comm,
    rw add_assoc,
    rw sub_add_cancel,
    rw add_comm,
    rw add_assoc,
    rw sub_add_cancel,
    rw add_comm,
    rw add_assoc,
    rw sub_add_cancel,
    rw add_comm,
    rw add_assoc,
    rw sub_add_cancel,
    rw add_comm,
    rw add_assoc,
    rw sub_add_cancel,
    rw add_comm,
    rw add_assoc,
    rw sub_add_cancel,
    rw add_comm,
    rw add_assoc,
    rw sub_add_cancel,
    rw add_comm,
    rw add_assoc,
    rw sub_add_cancel,
    rw add_comm,
    rw add_assoc,
    rw sub_add_cancel,
    rw add_comm,
    rw add_assoc,
    rw sub_add_cancel,
    rw add_comm,
    rw add_assoc,
    rw sub_add_cancel,
    rw add_comm,
    rw add_assoc,
    rw sub_add_cancel,
    rw add_comm,
    rw add_assoc,
    rw sub_add_cancel,
    rw add_comm,
    rw add_assoc,
    rw sub_add_cancel,
    rw add_comm,
    rw add_assoc,
    rw sub_add_cancel,
    rw add_comm,
    rw add_assoc,
    rw sub_add_cancel,
    rw add_comm,
    rw add_assoc,
    rw sub_add_cancel,
    rw add_comm,
    rw add_assoc,
    rw sub_add_cancel,
    rw add_comm,
    rw add_assoc,
    rw sub_add_cancel,
    rw add_comm,
    rw add_assoc,
    rw sub_add_cancel,
    rw add_comm,
    rw add_assoc,
    rw sub_add_cancel,
    rw add_comm,
    rw add_assoc,
    rw sub_add_cancel,
    rw add_comm,
    rw add_assoc,
    rw sub_add_cancel,
    rw add_comm,
    rw add_assoc,
    rw sub_add_cancel,
    rw add_comm,
    rw add_assoc,
    rw sub_add_cancel,
    rw add_comm,
    rw add_assoc,
    rw


import Hw7
import Lean.Elab.Print
import Lean.Elab.Command

theorem desiredType : ∀ (α : Type) (D : Prop), α → (α → D ↔ D):= sorry

open Lean
open Lean.Meta
open Lean.Elab.Command

def collectAxiomsOf (constName : Name) : MetaM (List String) := do
  let env ← getEnv
  let (_, s) := ((CollectAxioms.collect constName).run env).run {}
  let a := s.axioms.toList.map toString
  return a

#eval isDefEq (Expr.const ``desiredType []) (Expr.const ``problem5 [])
#eval collectAxiomsOf ``problem5